From 0657fcb3408f87c2df83c4978f848bc89e47e360 Mon Sep 17 00:00:00 2001 From: tomo Date: Mon, 16 Feb 1998 15:54:40 +0000 Subject: [PATCH] This commit was manufactured by cvs2svn to create branch 'unlabeled-1.11.6'. --- ChangeLog | 390 - GNUS-NEWS | 65 - Makefile | 36 - README.semi | 66 - etc/gnus-tut.txt | 294 - lisp/ChangeLog | 1163 --- lisp/Makefile | 40 - lisp/dgnushack.el | 88 - lisp/earcon.el | 241 - lisp/gnus-agent.el | 1279 ---- lisp/gnus-art.el | 3305 --------- lisp/gnus-async.el | 325 - lisp/gnus-audio.el | 131 - lisp/gnus-bcklg.el | 155 - lisp/gnus-cache.el | 666 -- lisp/gnus-cite.el | 924 --- lisp/gnus-cus.el | 654 -- lisp/gnus-demon.el | 326 - lisp/gnus-draft.el | 183 - lisp/gnus-dup.el | 160 - lisp/gnus-eform.el | 130 - lisp/gnus-ems.el | 267 - lisp/gnus-gl.el | 859 --- lisp/gnus-group.el | 3372 --------- lisp/gnus-i18n.el | 95 - lisp/gnus-int.el | 476 -- lisp/gnus-kill.el | 715 -- lisp/gnus-load.el | 103 - lisp/gnus-logic.el | 229 - lisp/gnus-mh.el | 105 - lisp/gnus-move.el | 178 - lisp/gnus-nocem.el | 352 - lisp/gnus-picon.el | 754 -- lisp/gnus-range.el | 283 - lisp/gnus-salt.el | 1014 --- lisp/gnus-score.el | 2875 -------- lisp/gnus-setup.el | 217 - lisp/gnus-soup.el | 566 -- lisp/gnus-spec.el | 542 -- lisp/gnus-srvr.el | 766 -- lisp/gnus-start.el | 2528 ------- lisp/gnus-sum.el | 9016 ----------------------- lisp/gnus-topic.el | 1421 ---- lisp/gnus-undo.el | 174 - lisp/gnus-util.el | 913 --- lisp/gnus-uu.el | 2042 ------ lisp/gnus-vm.el | 105 - lisp/gnus-win.el | 554 -- lisp/gnus-xmas.el | 826 --- lisp/gnus.el | 2722 ------- lisp/lpath.el | 67 - lisp/mailheader.el | 182 - lisp/md5.el | 409 -- lisp/message.el | 4101 ----------- lisp/messagexmas.el | 124 - lisp/messcompat.el | 87 - lisp/nnagent.el | 122 - lisp/nnbabyl.el | 652 -- lisp/nndb.el | 332 - lisp/nndir.el | 99 - lisp/nndoc.el | 634 -- lisp/nndraft.el | 246 - lisp/nneething.el | 352 - lisp/nnfolder.el | 792 -- lisp/nngateway.el | 82 - lisp/nnheader.el | 854 --- lisp/nnheaderxm.el | 41 - lisp/nnkiboze.el | 356 - lisp/nnlistserv.el | 156 - lisp/nnmail.el | 1782 ----- lisp/nnmbox.el | 552 -- lisp/nnmh.el | 565 -- lisp/nnml.el | 825 --- lisp/nnoo.el | 307 - lisp/nnsoup.el | 811 --- lisp/nnspool.el | 470 -- lisp/nntp.el | 1209 ---- lisp/nnvirtual.el | 784 -- lisp/nnweb.el | 710 -- lisp/parse-time.el | 199 - lisp/pop3.el | 448 -- lisp/score-mode.el | 109 - lisp/smiley.el | 318 - lisp/smtp.el | 457 -- lisp/smtpmail.el | 285 - readme | 52 - texi/ChangeLog | 752 -- texi/Makefile | 161 - texi/custom.texi | 695 -- texi/gnus-faq.texi | 659 -- texi/gnus.texi |19257 ------------------------------------------------- texi/gnuslogo.refcard | 243 - texi/gnusref.tex | 687 -- texi/message.texi | 1283 ---- texi/postamble.tex | 49 - texi/refcard.tex | 65 - texi/widget.texi | 1432 ---- 97 files changed, 89544 deletions(-) delete mode 100644 ChangeLog delete mode 100644 GNUS-NEWS delete mode 100644 Makefile delete mode 100644 README.semi delete mode 100644 etc/gnus-tut.txt delete mode 100644 lisp/ChangeLog delete mode 100644 lisp/Makefile delete mode 100644 lisp/dgnushack.el delete mode 100644 lisp/earcon.el delete mode 100644 lisp/gnus-agent.el delete mode 100644 lisp/gnus-art.el delete mode 100644 lisp/gnus-async.el delete mode 100644 lisp/gnus-audio.el delete mode 100644 lisp/gnus-bcklg.el delete mode 100644 lisp/gnus-cache.el delete mode 100644 lisp/gnus-cite.el delete mode 100644 lisp/gnus-cus.el delete mode 100644 lisp/gnus-demon.el delete mode 100644 lisp/gnus-draft.el delete mode 100644 lisp/gnus-dup.el delete mode 100644 lisp/gnus-eform.el delete mode 100644 lisp/gnus-ems.el delete mode 100644 lisp/gnus-gl.el delete mode 100644 lisp/gnus-group.el delete mode 100644 lisp/gnus-i18n.el delete mode 100644 lisp/gnus-int.el delete mode 100644 lisp/gnus-kill.el delete mode 100644 lisp/gnus-load.el delete mode 100644 lisp/gnus-logic.el delete mode 100644 lisp/gnus-mh.el delete mode 100644 lisp/gnus-move.el delete mode 100644 lisp/gnus-nocem.el delete mode 100644 lisp/gnus-picon.el delete mode 100644 lisp/gnus-range.el delete mode 100644 lisp/gnus-salt.el delete mode 100644 lisp/gnus-score.el delete mode 100644 lisp/gnus-setup.el delete mode 100644 lisp/gnus-soup.el delete mode 100644 lisp/gnus-spec.el delete mode 100644 lisp/gnus-srvr.el delete mode 100644 lisp/gnus-start.el delete mode 100644 lisp/gnus-sum.el delete mode 100644 lisp/gnus-topic.el delete mode 100644 lisp/gnus-undo.el delete mode 100644 lisp/gnus-util.el delete mode 100644 lisp/gnus-uu.el delete mode 100644 lisp/gnus-vm.el delete mode 100644 lisp/gnus-win.el delete mode 100644 lisp/gnus-xmas.el delete mode 100644 lisp/gnus.el delete mode 100644 lisp/lpath.el delete mode 100644 lisp/mailheader.el delete mode 100644 lisp/md5.el delete mode 100644 lisp/message.el delete mode 100644 lisp/messagexmas.el delete mode 100644 lisp/messcompat.el delete mode 100644 lisp/nnagent.el delete mode 100644 lisp/nnbabyl.el delete mode 100644 lisp/nndb.el delete mode 100644 lisp/nndir.el delete mode 100644 lisp/nndoc.el delete mode 100644 lisp/nndraft.el delete mode 100644 lisp/nneething.el delete mode 100644 lisp/nnfolder.el delete mode 100644 lisp/nngateway.el delete mode 100644 lisp/nnheader.el delete mode 100644 lisp/nnheaderxm.el delete mode 100644 lisp/nnkiboze.el delete mode 100644 lisp/nnlistserv.el delete mode 100644 lisp/nnmail.el delete mode 100644 lisp/nnmbox.el delete mode 100644 lisp/nnmh.el delete mode 100644 lisp/nnml.el delete mode 100644 lisp/nnoo.el delete mode 100644 lisp/nnsoup.el delete mode 100644 lisp/nnspool.el delete mode 100644 lisp/nntp.el delete mode 100644 lisp/nnvirtual.el delete mode 100644 lisp/nnweb.el delete mode 100644 lisp/parse-time.el delete mode 100644 lisp/pop3.el delete mode 100644 lisp/score-mode.el delete mode 100644 lisp/smiley.el delete mode 100644 lisp/smtp.el delete mode 100644 lisp/smtpmail.el delete mode 100644 readme delete mode 100644 texi/ChangeLog delete mode 100644 texi/Makefile delete mode 100644 texi/custom.texi delete mode 100644 texi/dir delete mode 100644 texi/gnus-faq.texi delete mode 100644 texi/gnus.texi delete mode 100644 texi/gnuslogo.refcard delete mode 100644 texi/gnusref.tex delete mode 100644 texi/message.texi delete mode 100644 texi/postamble.tex delete mode 100644 texi/refcard.tex delete mode 100644 texi/widget.texi diff --git a/ChangeLog b/ChangeLog deleted file mode 100644 index db0ec98..0000000 --- a/ChangeLog +++ /dev/null @@ -1,390 +0,0 @@ -1998-02-16 MORIOKA Tomohiko - - * lisp/nnheader.el: Use original. - - * lisp/gnus.el, lisp/pop3.el, lisp/message.el, lisp/gnus-sum.el, - lisp/gnus-msg.el, lisp/gnus-draft.el, lisp/gnus-art.el: Sync up - with qgnus-0.26. - -1998-02-15 MORIOKA Tomohiko - - * lisp/nnmail.el, lisp/nnmh.el: Use original. - - * lisp/gnus.el, lisp/gnus-draft.el, lisp/gnus-sum.el, - lisp/message.el, lisp/gnus-art.el: Sync up with qgnus-0.25. - -1998-02-11 Shuhei Kobayashi - - * texi/message.texi, texi/gnus.texi, texi/ChangeLog, - lisp/message.el, lisp/gnus.el, lisp/gnus-uu.el, - lisp/gnus-topic.el, lisp/gnus-sum.el, lisp/gnus-start.el, - lisp/gnus-score.el, lisp/gnus-group.el, lisp/gnus-art.el, - lisp/gnus-agent.el, lisp/ChangeLog: Importing qgnus-0.24 - -1998-02-10 MORIOKA Tomohiko - - * lisp/gnus-art.el (gnus-article-prepare): Don't bind coding - systems. - - * lisp/gnus.el (gnus-version-number): Update to 6.0.4. - (gnus-version): Sync with qgnus-0.23. - - * lisp/pop3.el, lisp/nnmh.el, lisp/nnheader.el, lisp/message.el, - lisp/gnus-sum.el, lisp/gnus-msg.el, lisp/gnus-draft.el, - lisp/gnus-art.el: Merge qgnus-0.23. - -1998-02-09 Shuhei Kobayashi - - * texi/message.texi, texi/gnus.texi, texi/ChangeLog, lisp/nntp.el, - lisp/nnheader.el, lisp/message.el, lisp/gnus.el, - lisp/gnus-xmas.el, lisp/gnus-sum.el, lisp/gnus-start.el, - lisp/gnus-msg.el, lisp/gnus-group.el, lisp/gnus-draft.el, - lisp/gnus-art.el, lisp/gnus-agent.el, lisp/ChangeLog: Importing - qgnus-0.23 - -1998-02-04 MORIOKA Tomohiko - - * lisp/message.el (message-references-generator): New variable. - (message-generate-filled-references): New function. - (message-generate-folded-references): New function. - (message-generate-unfolded-references): New function. - (message-reply): Refer `message-references-generator'. - (message-followup): Refer `message-references-generator'. - -1998-01-17 MORIOKA Tomohiko - - * lisp/message.el (message-send-mail-with-sendmail): Guard - `coding-system-for-write' by binary. - (message-send-mail-with-qmail): Likewise. - -1998-01-16 MORIOKA Tomohiko - - * lisp/lpath.el: Require path-util; add load-path of APEL, MEL and - SEMI. - -1998-01-12 MORIOKA Tomohiko - - * lisp/message.el: Require smtp.el when compile. - - * lisp/message.el (message-send-mail-with-smtp): Use - `(current-buffer)' instead of `tembuf'; rename - `smtp-recipient-address-list' -> `recipient-address-list'. - -1998-01-12 MORIOKA Tomohiko - - * lisp/smtp.el (smtp-deduce-address-list): Don't use - `smtp-recipient-address-list' as global variable. - - * lisp/message.el (message-send-mail-with-smtp): Don't use - `smtp-recipient-address-list' as global variable. - - * lisp/smtpmail.el (smtpmail-recipient-address-list): New - variable; renamed from `smtp-recipient-address-list'. - (smtpmail-send-it): Remove `(not (null ...))'. - (smtpmail-send-queued-mail): Likewise. - -1998-01-12 MORIOKA Tomohiko - - * lisp/message.el (message-send-mail-with-smtp): Don't generate - temporary buffer for message; don't generate and kill - `smtp-address-buffer' for `smtp-deduce-address-list'. - - * lisp/smtpmail.el (smtpmail-send-it): Don't generate and kill - `smtp-address-buffer' for `smtp-deduce-address-list'. - - * lisp/smtp.el (smtp-deduce-address-list): Bind and generate - `smtp-address-buffer' in itself. - -1998-01-12 MORIOKA Tomohiko - - * lisp/gnus.el (gnus-version-number): Update to version 6.0.3. - -1998-01-11 MORIOKA Tomohiko - - * lisp/smtp.el: New file. - - * lisp/smtpmail.el: Split basic features into smtp.el. - - * lisp/message.el (message-send-mail-function): Add - `message-send-mail-with-smtp' as an item. - (message-send-mail-with-smtp): New function. - - * ChangeLog: New file. - -1998-01-08 MORIOKA Tomohiko - - * lisp/smtpmail.el (smtpmail-via-smtp): Bind - `coding-system-for-read' by `smtpmail-coding-system' to avoid - dead-locking in Emacs 20. - - * lisp/gnus.el: gnus.el (gnus-version-number): Update to version - 6.0.2. - -1998-01-07 MORIOKA Tomohiko - - * lisp/nnmail.el, lisp/message.el: Sync with Quassia Gnus v0.22. - - * lisp/gnus.el: Delete autoload setting for `metamail-buffer'. - - * lisp/gnus.el, lisp/gnus-sum.el: Sync with Quassia Gnus v0.22. - - * lisp/gnus-msg.el: Abolish function - `gnus-inews-insert-mime-headers'. - - * lisp/gnus-msg.el, lisp/gnus-draft.el, lisp/gnus-art.el: Sync - with Quassia Gnus v0.22. - - * lisp/smtpmail.el (smtpmail-coding-system): New variable; abolish - `smtpmail-code-conv-from'. - (smtpmail-via-smtp): Guard `coding-system-for-write' by - `smtpmail-coding-system'. - - * lisp/smtpmail.el: Imported from Emacs 20.2. - - * lisp/pop3.el (pop3-movemail-file-coding-system): Change default - value to `binary'. - (pop3-open-server): Guard `coding-system-for-read' by `binary'. - -1998-01-06 Shuhei Kobayashi - - * texi/message.texi, texi/gnus.texi, texi/ChangeLog, lisp/nnoo.el, - lisp/nnml.el, lisp/message.el, lisp/gnus.el, lisp/gnus-sum.el, - lisp/gnus-start.el, lisp/gnus-ems.el, lisp/gnus-draft.el, - lisp/gnus-agent.el, lisp/ChangeLog: Importing qgnus-0.22 - - * texi/message.texi, texi/gnus.texi, lisp/gnus.el, lisp/ChangeLog: - Importing qgnus-0.21 - - * texi/message.texi, texi/gnus.texi, texi/ChangeLog, - lisp/nnvirtual.el, lisp/nnsoup.el, lisp/nnoo.el, lisp/nnmh.el, - lisp/nnmail.el, lisp/nndraft.el, lisp/gnus.el, lisp/gnus-xmas.el, - lisp/gnus-sum.el, lisp/gnus-start.el, lisp/gnus-score.el, - lisp/gnus-msg.el, lisp/gnus-group.el, lisp/gnus-draft.el, - lisp/gnus-art.el, lisp/ChangeLog: Importing qgnus-0.20 - - * texi/message.texi, texi/gnus.texi, texi/ChangeLog, lisp/pop3.el, - lisp/nntp.el, lisp/nnml.el, lisp/nnmail.el, lisp/nndoc.el, - lisp/message.el, lisp/gnus.el, lisp/gnus-uu.el, - lisp/gnus-topic.el, lisp/gnus-sum.el, lisp/gnus-start.el, - lisp/gnus-score.el, lisp/gnus-group.el, lisp/gnus-cache.el, - lisp/gnus-agent.el, lisp/ChangeLog: Importing qgnus-0.19 - -1997-12-27 MORIOKA Tomohiko - - * lisp/gnus.el (gnus-version-number): Update to version 6.0.1. - - * lisp/message.el (message-resend): Enclose `message-setup' with - `(let (message-setup-hook) ...)' to avoid to `turn-on-mime-edit'; - must setup `message-encoding-buffer' and `message-edit-buffer' for - `message-send-mail'. - -1997-12-08 Shuhei Kobayashi - - * lisp/pop3.el, lisp/message.el, lisp/gnus.el, lisp/gnus-sum.el, - lisp/gnus-art.el, lisp/ChangeLog: Synch'ed up to qgnus-0.18. - - * texi/message.texi, texi/gnus.texi, texi/ChangeLog, - lisp/smiley.el, lisp/pop3.el, lisp/nnweb.el, lisp/nntp.el, - lisp/nnml.el, lisp/nnmail.el, lisp/nnheader.el, lisp/nndraft.el, - lisp/message.el, lisp/lpath.el, lisp/gnus.el, lisp/gnus-util.el, - lisp/gnus-sum.el, lisp/gnus-start.el, lisp/gnus-picon.el, - lisp/gnus-nocem.el, lisp/gnus-mh.el, lisp/gnus-group.el, - lisp/gnus-ems.el, lisp/gnus-cite.el, lisp/gnus-art.el, - lisp/gnus-agent.el, lisp/dgnushack.el, lisp/ChangeLog: Importing - qgnus-0.18 - -1997-11-29 MORIOKA Tomohiko - - * README.semi: New file. - - * lisp/gnus.el (gnus-version): Rename to "Semi-gnus". - -1997-11-28 MORIOKA Tomohiko - - * lisp/gnus-draft.el (gnus-draft-decoding-function): New variable. - (gnus-draft-setup): Use `gnus-draft-decoding-function'. - -1997-11-27 MORIOKA Tomohiko - - * lisp/nnmail.el, lisp/nnheader.el, lisp/message.el, lisp/gnus.el, - lisp/gnus-sum.el, lisp/gnus-msg.el, lisp/gnus-art.el: sync with - qgnus-0.17. - - * texi/message.texi, texi/gnus.texi, lisp/smiley.el, lisp/nnoo.el, - lisp/nnml.el, lisp/nnmail.el, lisp/nnheader.el, - lisp/messagexmas.el, lisp/message.el, lisp/gnus.el, - lisp/gnus-xmas.el, lisp/gnus-util.el, lisp/gnus-sum.el, - lisp/gnus-start.el, lisp/gnus-spec.el, lisp/gnus-score.el, - lisp/gnus-picon.el, lisp/gnus-move.el, lisp/gnus-msg.el, - lisp/gnus-kill.el, lisp/gnus-group.el, lisp/gnus-draft.el, - lisp/gnus-demon.el, lisp/gnus-cite.el, lisp/gnus-art.el, - lisp/ChangeLog: Quassia Gnus v0.17. - - * lisp/gnus-i18n.el: New file. - - * lisp/nnmail.el (nnmail-file-coding-system): Use `raw-text' in - default. - - * lisp/nnheader.el (nnheader-file-coding-system): Use `raw-text' - in default. - - * lisp/message.el (message-encode-function): New variable. - (message-forward-start-separator): Modify for mime-edit. - (message-forward-end-separator): Modify for mime-edit. - (message-setup-hook): Use `(message-maybe-setup-default-charset - turn-on-mime-edit)' in default. - (message-header-hook): Use `(eword-encode-header)' in default. - - (message-send): Use local variable `message-encoding-buffer', - `message-edit-buffer' and `message-mime-mode' as public variables; - use `message-encode-function'. - (message-send-mail): Use `message-encoding-buffer' to get contents - of body; abolish `message-encode-mail-hook'; use - `mime-edit-maybe-split-and-send'; use `message-edit-buffer' to - refer original editing buffer. - (message-send-news): Use `message-encoding-buffer' to get contents - of body; abolish `message-encode-news-hook'; use - `mime-edit-maybe-split-and-send'; use `message-edit-buffer' to - refer original editing buffer. - (message-check-news-syntax): Call `message-check-news-body-syntax' - in `mime-edit-buffer'. - (message-do-fcc): Use `message-encoding-buffer' to get contents; - run `message-header-hook'. - (message-cancel-news): Use `std11-extract-address-components' - instead of `mail-extract-address-components'; bind - `message-encoding-buffer' and `message-edit-buffer'. - - (message-maybe-setup-default-charset): New function. - (message-maybe-encode): New function. - (message-mime-insert-article): New function. - Add setting for mime-view. - - * lisp/gnus.el (gnus-version-number): for version number for Open - gnus. - (gnus-version): Modify for Open gnus. - - * lisp/gnus-sum.el: Autoload gnus-i18n. - - (gnus-show-mime): `t' in default. - (gnus-structured-field-decoder): Use - `eword-decode-structured-field-body' in default. - (gnus-unstructured-field-decoder): Use - `eword-decode-unstructured-field-body' in default. - - (gnus-parse-headers-hook): Use - `(gnus-set-summary-default-charset)' in default. - - (gnus-summary-mode-map): Add binding for - `gnus-summary-scroll-down' and - `gnus-summary-preview-mime-message'. - - (gnus-summary-preview-mime-message): New function. - (gnus-mime-partial-preview-function): New function. - Add setting for mime-view. - - * lisp/gnus-msg.el (gnus-summary-cancel-article): Display - `gnus-article-buffer' instead ofb `gnus-original-article-buffer'. - (gnus-extended-version): Don't return version of emacsen. - (gnus-inews-do-gcc): Refer `message-encoding-buffer'. - - * lisp/gnus-art.el (gnus-show-mime-method): Use - `gnus-article-preview-mime-message' instead of `metamail-buffer' - in default. - (gnus-decode-encoded-word-method): Use - `gnus-article-decode-encoded-word' instead of - `gnus-article-de-quoted-unreadable' in default. - - Abolish `gnus-hack-decode-rfc1522', `gnus-decode-rfc1522', - `article-decode-rfc1522', `article-de-quoted-unreadable', - `article-mime-decode-quoted-printable-buffer' and - `article-mime-decode-quoted-printable'. - (gnus-article-decode-rfc1522): New implementation (use - `eword-decode-header'). - - (gnus-article-preview-mime-message): New function. - (gnus-article-decode-encoded-word): New function. - (gnus-content-header-filter): New function. - (mime-view-quitting-method-for-gnus): New function. - Add setting for mime-view. - - * lisp/message.el: Abolish `message-max-size' because it is not - used. - - * lisp/message.el: sync with qgnus-0.16. - - * texi/Makefile, texi/message.texi, texi/gnus.texi, lisp/nnweb.el, - lisp/nnmh.el, lisp/nnheader.el, lisp/nnfolder.el, lisp/message.el, - lisp/gnus.el, lisp/gnus-xmas.el, lisp/gnus-uu.el, - lisp/gnus-sum.el, lisp/gnus-srvr.el, lisp/gnus-picon.el, - lisp/gnus-group.el, lisp/gnus-cite.el, lisp/gnus-art.el: Quassia - Gnus v0.16. - - * lisp/nnmh.el (nnmh-request-list-1): fix maybe. - - * lisp/message.el (message-do-fcc): Guard - `coding-system-for-write' by `raw-text'; run - `message-before-do-fcc-hook'. - - * lisp/gnus-msg.el (gnus-inews-do-gcc): Guard - `coding-system-for-write' by `raw-text'; run - `gnus-before-do-gcc-hook'. - - * texi/message.texi, texi/gnus.texi, texi/ChangeLog, lisp/nntp.el, - lisp/nnoo.el, lisp/nnml.el, lisp/nndraft.el, lisp/nnbabyl.el, - lisp/message.el, lisp/gnus.el, lisp/gnus-xmas.el, lisp/gnus-uu.el, - lisp/gnus-util.el, lisp/gnus-sum.el, lisp/gnus-start.el, - lisp/gnus-spec.el, lisp/gnus-soup.el, lisp/gnus-score.el, - lisp/gnus-msg.el, lisp/gnus-gl.el, lisp/gnus-ems.el, - lisp/gnus-draft.el, lisp/gnus-cache.el, lisp/gnus-audio.el, - lisp/gnus-art.el, lisp/gnus-agent.el, lisp/ChangeLog: Quassia Gnus - v0.15. - - * lisp/message.el, lisp/ChangeLog: sync with qgnus-0.14. - - * texi/Makefile, texi/gnus.texi: Quassia Gnus v0.14. - - * texi/dir: New file. - - * texi/dir, lisp/pop3.el, lisp/nntp.el, lisp/nnml.el, - lisp/nnmail.el, lisp/nnfolder.el, lisp/message.el, lisp/lpath.el, - lisp/gnus.el, lisp/gnus-win.el, lisp/gnus-util.el, - lisp/gnus-topic.el, lisp/gnus-sum.el, lisp/gnus-start.el, - lisp/gnus-score.el, lisp/gnus-msg.el, lisp/gnus-mh.el, - lisp/gnus-cus.el, lisp/gnus-art.el, lisp/gnus-agent.el, - lisp/ChangeLog: Quassia Gnus v0.14. - - * lisp/message.el, lisp/ChangeLog: sync with qgnus-0.13. - - * texi/gnus.texi, texi/ChangeLog, lisp/pop3.el, lisp/nnweb.el, - lisp/nnmail.el: Quassia Gnus v0.13. - - * lisp/nnlistserv.el: New file. - - * lisp/nnlistserv.el, lisp/message.el, lisp/md5.el, lisp/lpath.el, - lisp/gnus.el, lisp/gnus-topic.el, lisp/gnus-sum.el, - lisp/gnus-score.el, lisp/gnus-picon.el, lisp/gnus-msg.el, - lisp/gnus-group.el, lisp/gnus-art.el, lisp/gnus-agent.el, - lisp/dgnushack.el, lisp/ChangeLog, GNUS-NEWS: Quassia Gnus v0.13. - - * lisp/message.el: sync with qgnus-0.12. - - * texi/message.texi, texi/gnus.texi, texi/gnus-faq.texi, - texi/ChangeLog, lisp/nntp.el, lisp/nnmh.el, lisp/nnmail.el, - lisp/nndraft.el, lisp/messcompat.el, lisp/message.el, - lisp/gnus.el, lisp/gnus-xmas.el, lisp/gnus-uu.el, - lisp/gnus-sum.el, lisp/gnus-score.el, lisp/gnus-salt.el, - lisp/gnus-msg.el, lisp/gnus-int.el, lisp/gnus-group.el, - lisp/gnus-demon.el, lisp/gnus-cache.el, lisp/gnus-art.el, - lisp/gnus-agent.el, lisp/ChangeLog, GNUS-NEWS: Quassia Gnus v0.12. - - * lisp/message.el (message-send-news-function): Use - `message-send-news-with-gnus' in default. - (message-send-via-news): Use `message-send-news' instead of - `message-send-news-function'. - (message-send-mail): Don't avoid text properties; run - `message-encode-mail-hook'. - (message-send-news): Don't avoid text properties; run - `message-encode-news-hook'; use `message-send-news-function'. - (message-send-news-with-gnus): New function. - (message-cancel-news): Use `message-send-news' instead of - `message-send-news-function'. diff --git a/GNUS-NEWS b/GNUS-NEWS deleted file mode 100644 index e4a0a67..0000000 --- a/GNUS-NEWS +++ /dev/null @@ -1,65 +0,0 @@ -** Gnus changes. - -*** The Gnus alpha distribution no longer bundles Custom and Widget. -If your Emacs doesn't come with these libraries, fetch them from -. You also then need to -add the following to the lisp/dgnushack.el file: - - (push "~/lisp/custom" load-path) - -Modify to suit your needs. - -*** New functionality for using Gnus as an offline newsreader has been -added. A plethora of new commands and modes have been added. See the -Gnus manual for the full story. - -*** The nndraft backend has returned, but works differently than -before. All Message buffers are now also articles in the nndraft -group, which is created automatically. - -*** `gnus-alter-header-function' can now be used to alter header -values. - -*** `gnus-summary-goto-article' now accept Message-ID's. - -*** A new Message command for deleting text in the body of a message -outside the region: `C-c C-v'. - -*** You can now post to component group in nnvirtual groups with -`C-u C-c C-c'. - -*** `nntp-rlogin-program' -- new variable to ease customization. - -*** `C-u C-c C-c' in `gnus-article-edit-mode' will now inhibit -re-highlighting of the article buffer. - -*** New element in `gnus-boring-article-headers' -- `long-to'. - -*** `M-i' symbolic prefix command. See the section "Symbolic -Prefixes" in the Gnus manual for details. - -*** `L' and `I' in the summary buffer now take the symbolic prefix -`a' to add the score rule to the "all.SCORE" file. - -*** `gnus-simplify-subject-functions' variable to allow greater -control over simplification. - -*** `A T' -- new command for fetching the current thread. - -*** `/ T' -- new command for including the current thread in the -limit. - -*** `M-RET' is a new Message command for breaking cited text. - -*** \\1-expressions are now valid in `nnmail-split-methods'. - -*** The `custom-face-lookup' function has been removed. -If you used this function in your initialization files, you must -rewrite them to use `face-spec-set' instead. - -*** Cancelling now uses the current select method. Symbolic prefix -`a' forces normal posting method. - -*** New command to translate M******** sm*rtq**t*s into proper text --- `W d'. - diff --git a/Makefile b/Makefile deleted file mode 100644 index 05503f4..0000000 --- a/Makefile +++ /dev/null @@ -1,36 +0,0 @@ -EMACS=emacs -XEMACS=xemacs - -all: lick info - -lick: - cd lisp; $(MAKE) EMACS=$(EMACS) all - -# Rule for Lars and nobody else. -some: - cd lisp; $(MAKE) EMACS=$(EMACS) some -l: - cd lisp; $(MAKE) EMACS=$(EMACS) clever - -info: - cd texi; $(MAKE) EMACS=$(EMACS) all - -clean: - rm -f */*.orig */*.rej *.orig *.rej - -xsome: - cd lisp; $(MAKE) EMACS=$(XEMACS) some - -elclean: - rm lisp/*.elc - -x: - make EMACS=xemacs - -distclean: - make clean - rm -r *~ - for i in lisp texi; do (cd $$i; make distclean); done - -osome: - make EMACS=emacs-19.34 some diff --git a/README.semi b/README.semi deleted file mode 100644 index 1dd8d52..0000000 --- a/README.semi +++ /dev/null @@ -1,66 +0,0 @@ -This package contains Semi-gnus. - -What is Semi-gnus? -================== - - Semi-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. - - It requires SEMI package, so please get and install SEMI package -before to install it. - - -How to get? -=========== - -(0) cvs login - - % cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \ - login - - CVS password: [CR] # NULL string - -(1) checkout - - Please do following in a directory to extract (ex. site-lisp): - - % cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \ - co gnus - -(2) compile - - ;; as same as Gnus - - % cd gnus - - % make EMACS= - -(3) update - - Please do following in your Open gnus directory: - - % cvs update - - -How to join development -======================= - - If you write bug-reports and/or suggestions for improvement, please -send them to the tm Mailing List: - - bug-tm-en@chamonix.jaist.ac.jp (English) - bug-tm-ja@chamonix.jaist.ac.jp (Japanese) - - Via the tm ML, you can report SEMI related bugs, obtain the latest -release of SEMI, and discuss future enhancements to SEMI. To join the -tm ML, send e-mail to - - tm-ja-admin@chamonix.jaist.ac.jp (Japanese) - tm-en-admin@chamonix.jaist.ac.jp (English) - - Since the user registration is done manually, please write the mail -body in human-recognizable language (^_^). - - In addition, we need developers. If you would like to develop it, -please send mail to cvs@chamonix.jaist.ac.jp. diff --git a/etc/gnus-tut.txt b/etc/gnus-tut.txt deleted file mode 100644 index 94e9500..0000000 --- a/etc/gnus-tut.txt +++ /dev/null @@ -1,294 +0,0 @@ -From lars Thu Feb 23 23:20:38 1995 -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: - -Actually, since you are reading this, chances are you are already -using the new Gnus. Congratulations. - -This entire newsgroup you are reading is, in fact, no real newsgroup -at all, in the traditional sense. It is an example of one of the -"foreign" select methods that Gnus may use. - -The text you are now reading is stored in the "etc" directory with the -rest of the Emacs sources. You are using the "nndoc" backend for -accessing it. Scary, isn't it? - -This isn't the real documentation. `M-x info', `m gnus ' to read -that. This "newsgroup" is intended as a kinder, gentler way of getting -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 . - -;; Copyright (C) 1995 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@ifi.uio.no (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: Starting up -Message-ID: - -If you are having problems with Gnus not finding your server, you have -to set `gnus-select-method'. A "method" is a way of specifying *how* -the news is to be found, and from *where*. - -Say you want to read news from you local, friendly nntp server -"news.my.local.server". - -(setq gnus-select-method '(nntp "news.my.local.server")) - -Quite easy, huh? - -From the news spool: - -(setq gnus-select-method '(nnspool "")) - -From your mh-e spool: - -(setq gnus-select-method '(nnmh "")) - -There's a whole bunch of other methods for reading mail and news, see -the "Foreign groups" article for that. - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@ifi.uio.no (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: Where are all the groups, then? -Message-ID: - -If this is the first time you have used a newsreader, you won't have a -.newsrc file. This means that Gnus will think that all the newsgroups -on the server are "new", and kill them all. - -If you have a .newsrc file, the new groups will be processed with the -function in the `gnus-subscribe-newsgroup-method' variable, which is -`gnus-subscribe-zombies' by default. - -This means that all the groups have been made into "zombies" - not -quite dead, but not exactly alive, either. - -Jump back to the *Group* buffer, and type `A z' to list all the zombie -groups. Look though the list, and subscribe to the groups you want to -read by pressing `u' on the one you think look interesting. - -If all the groups have been killed, type `A k' to list all the killed -groups. Subscribe to them the same way. - -When you are satisfied, press `S z' to kill all the zombie groups. - -Now you should have a nice list of all groups you are interested in. - -(If you later want to subscribe to more groups, press `A k' to -list all the kill groups, and repeat. You can also type `U' and be -prompted for groups to subscribe to.) - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@ifi.uio.no (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: I want to read my mail! -Message-ID: - -Yes, Virginia, you can read mail with Gnus. - -First you have to decide which mail backend you want to use. You have -nnml, which is a one-file-one-mail backend, which is quite nice, but -apt to make your systems administrator go crazy and come after you -with a shotgun. - -nnmbox uses a Unix mail box to store mail. Nice, but slow. - -nnmh uses mh-e folders, which is also a one-file-one-mail thingie, but -slower than nnml. (It doesn't support NOV files.) - -So if you want to go with nnmbox, you can simply say: - -(setq gnus-secondary-select-methods '((nnmbox ""))) - -(The same for the other methods, kind of.) - -You should also set `nnmail-split-methods' to something sensible: - -(setq nnmail-split-methods - '(("mail.junk" "From:.*Lars") - ("mail.misc ""))) - -This will put all mail from me in you junk mail group, and the rest in -"mail.misc". - -These groups will be subscribe the same way as the normal groups, so -you will probably find them among the zombie groups after you set -these variables and re-start Gnus. - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@ifi.uio.no (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: Foreign newsgroups -Message-ID: - -These are groups that do not come from `gnus-select-method'. - -Say you want to read "alt.furniture.couches" from "news.funet.fi". You -can then either type `B news.funet.fi ' to browse that server and -subscribe to that group, or you can type -`G m alt.furniture.couchesnntpnews.funet.fi', if you -like to type a lot. - -If you want to read a directory as a newsgroup, you can create an -nndir group, much the same way. There's a shorthand for that, -though. If, for instance, you want to read the (ding) list archives, -you could type `G d /ftp '. - -There's lots more to know about foreign groups, but you have to read -the info pages to find out more. - - -From lars Thu Feb 23 23:20:38 1995 -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: - -Gnus really isn't GNUS, even though it looks like it. If you scrape -the surface, you'll find that most things have changed. - -This means that old code that relies on GNUS internals will fail. - -In particular, `gnus-newsrc-hashtb', `gnus-newsrc-assoc', -`gnus-killed-list', the `nntp-header-' macros and the display formats -have all changed. If you have some code lying around that depend on -these, or change these, you'll have to re-write your code. - -Old hilit19 code does not work at all. In fact, you should probably -remove all hilit code from all the Gnus hooks -(`gnus-group-prepare-hook', `gnus-summary-prepare-hook' and -`gnus-summary-article-hook'). (Well, at the very least the first -two.) Gnus provides various integrated functions for highlighting, -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. - - -From lars Thu Feb 23 23:20:38 1995 -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: - -Reading the active file from the nntp server is a drag. - -Just press `M-g' on the mail groups, and they will be re-scanned. - -You can also re-scan all the mail groups by putting them on level 1 -(`S l 1'), and saying `1 g' to re-scan all level 1 groups. - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@ifi.uio.no (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: How do I set up virtual newsgroups? -Message-ID: - -Virtual newsgroups are collections of other newsgroups. Why people -want this is beyond me, but here goes: - -Create the group by saying - -`M-a 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" -hierarchy. - -If you want to edit the regular expression, just type `M-e' on the -group line. - -Note that all the groups that are part of the virtual group have to be -alive. This means that the cannot, absolutely not, be zombie or -killed. They can be unsubscribed; that's no problem. - -You can combine groups from different servers in the same virtual -newsgroup, something that may actually be useful. Say you have the -group "comp.headers" on the server "news.server.no" and the same group -on "news.server.edu". If people have posted articles with Distribution -headers that stop propagation of their articles, combining these two -newsgroups into one virtual newsgroup should give you a better view of -what's going on. - -One caveat, though: The virtual group article numbers from the first -source group (group A) will always be lower than the article numbers -from the second (group B). This means that Gnus will believe that -articles from group A are older than articles from group B. Threading -will lessen these problems, but it might be a good idea to sort the -threads over the date of the articles to get a correct feel for the -flow of the groups: - -(setq gnus-thread-sort-functions '(gnus-thread-sort-by-date)) - -If you only want this in virtual groups, you could say something along -the lines of: - -(setq gnus-select-group-hook - (lambda () - (if (eq 'nnvirtual (car (gnus-find-method-for-group - gnus-newsgroup-name))) - (progn - (make-local-variable 'gnus-thread-sort-functions) - (setq gnus-thread-sort-functions '(gnus-thread-sort-by-date)))))) - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@ifi.uio.no (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: Bugs & stuff -Message-ID: - -If you want to report a bug, please type `M-x gnus-bug'. This will -give me a precise overview of your Gnus and Emacs version numbers, -along with a look at all Gnus variables you have changed. - -Du not expect a reply back, but your bug should be fixed in the next -version. If the bug persists, please re-submit your bug report. - -When a bug occurs, I need a recipe for how to trigger the bug. You -have to tell me exactly what you do to uncover the bug, and you should -(setq debug-on-error t) and send me the backtrace along with the bug -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. - -If you have any questions on usage, the "ding@ifi.uio.no" mailing list -is where to post the questions. - - diff --git a/lisp/ChangeLog b/lisp/ChangeLog deleted file mode 100644 index b8d4bdb..0000000 --- a/lisp/ChangeLog +++ /dev/null @@ -1,1163 +0,0 @@ -Tue Jan 6 07:45:39 1998 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.22 is released. - -Tue Jan 6 07:32:02 1998 Lars Magne Ingebrigtsen - - * message.el (message-kill-to-signature): Don't use mark. - -Tue Jan 6 07:30:46 1998 Russ Allbery - - * message.el (message-kill-to-signature): New command and keystroke. - -Tue Jan 6 06:39:29 1998 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-print-article): New defaults for - headers and stuff. - - * gnus-agent.el (gnus-agent-batch): New command. - - * nnoo.el (nnoo-execute): Copy vars from parent into child. - (nnoo-parent-function): Ditto. - - * gnus-draft.el (gnus-draft-setup): Removed message. - - * gnus-start.el (gnus-read-descriptions-file): Naked muleism. - -Mon Jan 5 05:20:16 1998 Lars Magne Ingebrigtsen - - * nnml.el (nnml-generate-nov-databases-1): Fix lower bound on - empty groups. - -Sun Jan 4 14:38:36 1998 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.21 is released. - -Sun Jan 4 14:28:35 1998 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.20 is released. - -1997-12-10 Per Abrahamsen - - * gnus/gnus-msg.el (gnus-inews-insert-mime-headers): Added - documentation. - (gnus-inews-insert-mime-headers): Made it work with Emacs MULE. - (gnus-inews-insert-mime-headers): Added as option to - `message-header-hook'. - -1997-12-22 Per Abrahamsen - - * gnus/gnus-art.el (gnus-button-alist): Assume msg-id after "in - message". - -1997-12-22 Simon Josefsson - - * nnmail.el (nnmail-get-new-mail): Make nnmail-tmp-directory - -1997-12-28 Per Abrahamsen - - * gnus/gnus-group.el (gnus-group-fetch-faq): Convert `.' in group - name to `/'. - -Sun Jan 4 13:35:14 1998 Lars Magne Ingebrigtsen - - * nndraft.el (nndraft-request-associate-buffer): Open the damn - server first. Sheesh. - - * gnus-draft.el (gnus-draft-send): Bind message-send-hook to nil. - - * gnus-sum.el (gnus-summary-catchup): Don't nix out downloadable. - (gnus-summary-highlight): Highlight down/un as unread. - -Sun Jan 4 13:27:31 1998 Kim-Minh Kaplan - - * gnus-start.el (gnus-strip-killed-list): Fix syntax. - -Sun Jan 4 13:18:04 1998 Lars Magne Ingebrigtsen - - * nnsoup.el (nnsoup-store-reply): Bind mail-header-separator to - "". - - * gnus-xmas.el (gnus-xmas-agent-server-menu-add): New. - - * nnoo.el (nnoo-change-server): Get the right values. - -1998-01-04 Aki Vehtari - - * gnus-art.el (gnus-signature-limit): Add default values for - choices suggested by Per Abrahamsen . - (gnus-prompt-before-saving): Add :value t for sexp tag. - (gnus-split-methods): Add default values for choices. - - * gnus-score.el (gnus-home-score-file): Add non-nil default for - function. - (gnus-home-adapt-file): Ditto. - - * gnus-sum.el (gnus-move-split-methods): Add default values for - choices. - - * nnmail.el (nnmail-list-identifiers): Add default values for - choices suggested by Per Abrahamsen . - -Sun Jan 4 11:31:42 1998 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.19 is released. - -Sun Jan 4 10:42:53 1998 Felix Lee - - * nntp.el (nntp-open-rlogin): Use a list of parameters. - -Sun Jan 4 10:25:05 1998 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-fetch-groups): New command. - - * gnus-sum.el (gnus-summary-print-article): Changed order of - parameters. - -Sun Jan 4 10:24:07 1998 Michael R. Cook - - * gnus-sum.el (gnus-summary-print-article): Use process/prefix. - -Sun Jan 4 05:29:38 1998 Lars Magne Ingebrigtsen - - * gnus-uu.el: Changed spurious defconsts to defvars. - - * nnmail.el (nnmail-get-spool-files): Quote group name. - - * gnus-agent.el (gnus-agent-fetch-group-1): Fetch ticked articles. - (gnus-agent-fetch-group-1): Never mind. - -Sat Dec 20 22:33:17 1997 Pete Ware - - * message.el (message-rename-buffer): Check for nil dirs. - -Fri Dec 19 21:45:59 1997 Lars Magne Ingebrigtsen - - * nnml.el (nnml-request-create-group): Check for files. - -Fri Dec 19 21:39:43 1997 Hrvoje Niksic - - * message.el (message-mode): Fixed font-lock. - -Fri Dec 19 21:26:08 1997 Lars Magne Ingebrigtsen - - * gnus-cache.el (gnus-cache-read-active): Check for empty files. - -Sun Dec 14 11:46:50 1997 Lars Magne Ingebrigtsen - - * gnus-uu.el (gnus-uu-save-article): Quote all lines beginning - with a dash. - -1997-12-10 SL Baur - - * gnus-start.el (gnus-read-descriptions-file): Really bind and gag - Mule. - -Fri Dec 5 15:15:05 1997 Danny Siu - - * nndoc.el (nndoc-babyl-body-begin): quote the regexp for the - string "*** EOOH ***" properly. - (nndoc-babyl-head-begin): Same as above. - -Sun Dec 14 11:11:22 1997 Lars Magne Ingebrigtsen - - * gnus-uu.el (gnus-uu-pre-uudecode-hook): New hook. - - * gnus-sum.el (gnus-summary-read-group-1): Set mode line after - configuring. - -Sun Dec 14 11:03:26 1997 Wes Hardaker - - * gnus-score.el (gnus-adaptive-word-minimum): New variable. - (gnus-score-adaptive): Use it. - -Sun Dec 14 09:19:18 1997 Roland B. Roberts - - * gnus-group.el: Fixed hardcoded levels. - -Sat Dec 6 17:40:33 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.18 is released. - -Sat Dec 6 17:27:04 1997 Kim-Minh Kaplan - - * gnus-picon.el (gnus-picons-remove): Race condition. - -Sat Dec 6 17:23:26 1997 Christian von Roques - - * gnus-start.el (gnus-read-descriptions-file): Fix - enable-multibyte-characters. - -1997-12-05 Dave Love - - * gnus-nocem.el (gnus-nocem-message-wanted-p): Fix paren typpo. - (gnus-nocem-issuers): Allow sexp alternative in :type for alists. - -1997-12-05 Dave Love - - * gnus-art.el (gnus-visible-headers): Add X-sent:. - -Sat Dec 6 17:16:28 1997 Lars Balker Rasmussen - - * gnus-art.el (article-make-date-line): Don't add extra newlines. - -1997-11-27 MORIOKA Tomohiko - - * nnmail.el (nnmail-file-coding-system): Use `raw-text' in - default. - - * nnheader.el (nnheader-file-coding-system): Use `raw-text' in - default. - -Sat Dec 6 17:04:40 1997 Kim-Minh Kaplan - - * nnml.el (nnml-parse-head): Out-of-bounds fix. - - * nndraft.el (nndraft-request-associate-buffer): Get proper file - name. - -Sat Dec 6 15:35:37 1997 Gary D. Foster - - * gnus-group.el: Added backspace. - -Thu Nov 27 19:56:59 1997 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-summary-set-agent-mark): Remove marks - properly. - -1997-11-27 Christoph Wedler - - * smiley.el (smiley-buffer): Provide `help-echo'. - -Thu Nov 27 17:33:45 1997 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-output-to-rmail): Always save buffer. - - * nntp.el (nntp-close-server): Don't sleep for me, Argentina. - (nntp-request-close): You neither. - -1997-11-19 Per Abrahamsen - - * message.el (message-header-lines): New widget. - (message-default-headers): Use it. - (message-default-mail-headers): Use it. - (message-default-news-headers): Use it. - -1997-11-24 Andreas Jaeger - - * gnus-start.el (gnus-read-descriptions-file): Add missing quote. - -Wed Nov 26 18:19:29 1997 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-type-definition): Rescued dejanewsold. - - * gnus-mh.el (gnus-summary-save-in-folder): Reverted to old - version. - - * gnus-sum.el (gnus-kill-or-deaden-summary): Save excursion. - - * gnus.el: Only require gnus-load in Emacsen 19. - - * gnus-start.el (gnus-setup-news): Always push archive server. - - * gnus-sum.el (gnus-read-header): Would bug out on sparse - articles. - -Wed Nov 26 17:50:41 1997 Kurt Swanson - - * gnus-ems.el (gnus-mule-cite-add-face): Work. - -Wed Nov 26 17:40:57 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.17 is released. - -Wed Nov 26 16:04:25 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-move-article): Don't work on canceled - articles. - - * gnus-start.el (gnus-subscribe-hierarchical-interactive): Use - `read-char-exclusive'. - - * gnus-sum.el (gnus-summary-mode): Localize - gnus-summary-dummy-line-format. - - * nnml.el (nnml-open-nov): Check that the file exists before - inserting it. - - * gnus-art.el (article-date-ut): Insert a newline if needed. - - * gnus-score.el (gnus-score-edit-current-scores): Protect against - nil score files. - - * gnus-start.el (gnus-newsrc-parse-options): Be more correct -- - match only hierarchies. - (gnus-gnus-to-quick-newsrc-format): Changed warning. - -Wed Nov 26 15:47:40 1997 Greg Klanderman - - * messagexmas.el (message-xmas-maybe-fontify): New definition. - -Wed Nov 26 15:43:53 1997 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-setup-news): Protect against nil - gnus-message-archive-method. - -1997-11-26 Christoph Wedler - - * gnus-art.el (gnus-article-edit-done): Update headers "Lines:", - "Content-Length:" and "X-Content-Length:" when present. - -Wed Nov 26 15:08:17 1997 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-process-unix-mail-format): Pop to the right - buffer on error. - (nnmail-process-mmdf-mail-format): Ditto. - -Wed Nov 26 13:54:04 1997 Joe Reiss - - * gnus-art.el (gnus-summary-save-in-rmail): Return the name of the - file. - -Wed Nov 26 13:50:01 1997 Alastair Burt - - * smiley.el: Balloon help, etc. - -Wed Nov 26 13:45:35 1997 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-kill-all-overlays): Remove check for XEmacs. - -1997-09-30 Dave Love - - * message.el: Don't require rmail. - -Wed Nov 26 13:37:50 1997 Kurt Swanson - - * gnus-group.el (gnus-group-setup-buffer): set-buffer. - -Wed Nov 26 13:31:54 1997 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-load-file): Don't create empty score - files when doing decays. - -Wed Nov 26 13:28:04 1997 Renaud Rioboo - - * nnmail.el (nnmail-move-inbox): Only bind default-directory when - calling external function. - -Wed Nov 26 13:03:45 1997 IWAMURO Motonori - - * gnus-kill.el (gnus-batch-score): Newsrc thinko. - -Wed Nov 26 10:31:17 1997 Lars Magne Ingebrigtsen - - * nnheader.el (nnheader-parse-head): Would break on Message-ID's - that spanned several lines. - - * gnus-util.el (gnus-date-iso8601): Didn't pick out the date - header. - - * gnus-demon.el (gnus-demon-scan-mail): Clean inboxes. - -1997-11-25 Christoph Wedler - - * gnus-picon.el (gnus-picons-x-face-sentinel): Would bug out in - headers with two X-Face lines. - -Wed Nov 26 08:54:26 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-update-info): Would use wrong group - name. - -1997-11-26 Hrvoje Niksic - - * gnus-spec.el (gnus-compile): Avoid multiple `c*addr's. - (gnus-compile): Require `bytecomp'. - -1997-11-25 Hrvoje Niksic - - * gnus-util.el (gnus-prin1): Bind `print-readably' to t. - - * gnus-xmas.el (gnus-xmas-kill-all-overlays): New function. - (gnus-xmas-define): Use it. - - * gnus-art.el (gnus-stop-date-timer): Use `nnheader-cancel-timer'. - - * message.el (message-header-lines): Specify format. - - * gnus-xmas.el (gnus-xmas-move-overlay): Use BUFFER. - (gnus-byte-code): Use `indirect-function'. - - * gnus-cite.el (gnus-cite-add-face): Would assign free variable. - -Wed Nov 26 08:31:28 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-stop-date-timer): Cancel instead of delete. - (gnus-start-date-timer): Use the numerical prefix. - -Tue Nov 25 20:03:34 1997 Lars Magne Ingebrigtsen - - * gnus-draft.el (gnus-group-send-drafts): Activate group first. - -Tue Nov 25 19:57:55 1997 Dan Christensen - - * gnus-group.el (gnus-group-process-prefix): Skip topics. - -Tue Nov 25 19:54:00 1997 Lars Magne Ingebrigtsen - - * gnus-move.el (gnus-move-group-to-server): Protect agains - nil-ness. - -Tue Nov 25 19:03:38 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.16 is released. - -Tue Nov 25 16:05:01 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-read-header): Remove thread entry before - rebuilding. - - * gnus-cite.el (gnus-cite-add-face): Keep track of all overlays. - - * gnus-art.el (article-update-date-lapsed): New function. - (gnus-start-date-timer): New command. - (article-date-ut): Put the face in the right place. - (article-date-ut): Would move around. - - * gnus-group.el (gnus-group-read-ephemeral-group): Accept server - names. - - * gnus-srvr.el (gnus-browse-foreign-server): Use proper server - names. - - * gnus.el (gnus-group-prefixed-name): Give the right result for - native groups. - - * nnheader.el (nnheader-directory-files): New function. - - * nnmh.el (nnmh-request-list-1): Reversed check. - - * nnfolder.el (nnfolder-delete-mail): Would skip backwards one - line too much. - -Tue Nov 25 14:44:02 1997 SeokChan LEE - - * message.el (message-ignored-supersedes-headers): Typo. - -Mon Nov 24 18:46:37 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.15 is released. - -Mon Nov 24 18:07:21 1997 Lars Magne Ingebrigtsen - - * gnus-ems.el: Also check major version names. - -1997-10-05 SL Baur - - * message.el (require 'rmail): Put guard around. - * nnbabyl.el (require 'rmail): Ditto. - -Mon Nov 24 17:36:00 1997 Lars Magne Ingebrigtsen - - * message.el (message-reply): Respect Mail-Copies-To even when - `to-address'. - -Mon Nov 24 17:32:47 1997 Thor Kristoffersen - - * nntp.el (nntp-request-close): Sleep one second. - -Mon Nov 24 16:18:19 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-read-group-1): Update marks when not - entering group. - - * gnus-start.el (gnus-setup-news): Get correct value of archive - server. - -Wed Oct 8 20:29:35 1997 Robert Bihlmeyer - - * message.el (message-make-organization): Don't let the - environment variable override a user-set organization. - -Mon Nov 24 14:09:00 1997 Lars Magne Ingebrigtsen - - * nnml.el (nnml-open-nov): Don't use find-file. - - * gnus-sum.el (gnus-last-newsgroup-variables-set): New variable. - (gnus-set-global-variables): Don't do to much; gets run off of - pre-command-hook. - Got rid of gnus-set-global-variables throughout. - (gnus-summary-exit): Update adaptive scoring here. - (gnus-summary-isearch-article): Widen. - - * nnml.el (nnml-parse-head): Work in empty buffers. - -1997-10-14 Hrvoje Niksic - - * gnus-xmas.el (gnus-xmas-group-startup-message): Check for image - formats correctly. - (gnus-xmas-modeline-glyph): Ditto. - -Mon Nov 24 13:58:12 1997 Hrvoje Niksic - - * gnus-spec.el (gnus-compile): Work under XEmacs. - -Mon Nov 24 07:15:45 1997 Lars Magne Ingebrigtsen - - * nnoo.el (nnoo-change-server): Push the right parent packend onto - the alist. - -Sun Nov 23 16:21:41 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.14 is released. - -Sun Nov 23 14:04:07 1997 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-read-descriptions-file): Make sure Mule is - bound. And gagged. - - * message.el (message-send-mail-with-mh): Use - `mh-new-draft-name'. - - * nnfolder.el (nnfolder-read-folder): Save new buffers. - - * gnus-sum.el (gnus-summary-make-menu-bar): Removed "write to - file". - - * gnus-util.el (gnus-byte-code): Use indirect-function. - - * nntp.el (nntp-open-telnet): Also accept 201. - - * gnus-sum.el (gnus-summary-reparent-thread): Update thread. - - * gnus-score.el (gnus-all-score-files): Don't do anything unless - GROUP. - - * nnmail.el (nnmail-split-it): Save-excursion. - (nnmail-group-pathname): Translate file chars. - -Sun Nov 23 13:41:10 1997 Gunnar Horrigmo - - * gnus-sum.el (gnus-summary-exit): Don't skip if group - disappeared. - -Sun Nov 23 13:32:55 1997 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-normalize-buffer): New function. - (nnfolder-save-mail): Use it. - (nnfolder-request-replace-article): Ditto. - -1997-11-19 Per Abrahamsen - - * message.el (message-header-lines): New widget. - (message-default-headers): Use it. - (message-default-mail-headers): Use it. - (message-default-news-headers): Use it. - -Sun Nov 23 12:44:38 1997 Lars Magne Ingebrigtsen - - * gnus-win.el (gnus-remove-some-windows): Also delete dead summary - windows. - - * gnus-score.el (gnus-score-adaptive): Check whether functions are - bound. - -Sun Nov 23 12:15:00 1997 Hallvard B. Furuseth - - * gnus-sum.el (gnus-summary-limit-include-thread): Interactive - fix. - -Sun Nov 23 07:06:58 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-reparent-thread): Insert Message-ID in - proper place. - -Sat Nov 22 18:30:33 1997 Lars Magne Ingebrigtsen - - * gnus-cus.el (gnus-group-parameters): Add visible. - -Sat Nov 22 18:19:39 1997 Kim-Minh Kaplan - - * message.el (message-setup): Add a newline, if necessary. - -Sat Nov 22 18:04:34 1997 Lars Magne Ingebrigtsen - - * gnus-mh.el (gnus-summary-save-in-folder): Fix for default. - -Sat Nov 22 18:01:26 1997 Didier Verna - - * gnus-sum.el (gnus-summary-remove-bookmark): Interactive spec. - -Mon Nov 17 23:50:51 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (article-display-x-face): Fold case. - -Thu Nov 13 22:57:23 1997 Kenichi Handa - - * gnus/gnus-start.el (gnus-read-descriptions-file): Decode - description if necessary. - - * gnus/nntp.el (nntp-coding-system-for-read): Set default value to - binary. - (nntp-coding-system-for-write): Likewise. - -Thu Nov 13 22:30:19 1997 seokchan lee - - * message.el (message-ignored-supersedes-headers): Ignore more - headers. - -Thu Nov 13 22:28:13 1997 Lars Magne Ingebrigtsen - - * message.el (message-separator-face): Lightened up. - (message-header-other-face): Ditto. - -Thu Nov 13 22:22:11 1997 jari aalto - - * nnmail.el (nnmail-process-mmdf-mail-format): Pop to buffer. - -Thu Nov 13 22:09:39 1997 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-start-draft-setup): Always create group. - - * gnus-agent.el (gnus-agent-fetch-headers): Translate file chars. - -Thu Nov 6 20:43:05 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.13 is released. - -Thu Nov 6 20:30:14 1997 Lars Magne Ingebrigtsen - - * nnlistserv.el: New backend. - -Thu Nov 6 01:53:51 1997 Stefan Waldherr - - * nnweb.el (nnweb-dejanewsold-search): New function. - -Thu Nov 6 01:52:43 1997 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-change-level): Really delete multiple - instances. - -Wed Nov 5 14:04:54 1997 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-update-topic-line): Possibly fix nil - numbers. - - * gnus-sum.el (gnus-summary-show-article): New command and - keystroke. - -Tue Nov 4 06:29:58 1997 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-adaptive): Use the home score file. - -Sat Oct 25 05:52:22 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-save): Hide headers in the right - buffer. - - * gnus-picon.el (gnus-picons-xbm-face): New face. - -Sat Oct 25 00:39:42 1997 Lars Balker Rasmussen - - * gnus-art.el (gnus-article-fill-paragraph): New command and - keystroke. - -1997-10-16 Colin Rafferty - - * message.el (message-make-fqdn): Made certain that user-mail is - not nil. - -Sat Oct 25 00:18:32 1997 David S. Goldberg - - * gnus-art.el (article-hide-boring-headers): Use many-to. - -Fri Oct 24 23:48:39 1997 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-display-pairs): Don't add two bars. - (gnus-picons-try-face): Set the foreground color on the bar. - (gnus-picons-group-exluded-groups): New variable. - (gnus-group-display-picons): Use it. - -Mon Oct 13 00:01:35 1997 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-group-path): Translate file chars. - (gnus-agent-batch-fetch): New command. - (gnus-agent-fetch-group): Message. - -Sun Oct 12 23:54:55 1997 ISO-2022-JP - - * gnus-agent.el (gnus-agent-article-file-coding-system): New - variable. - -Sun Oct 12 16:46:11 1997 Lars Magne Ingebrigtsen - - * dgnushack.el (lpath): Reversed. - - * gnus-msg.el (gnus-summary-cancel-article): Use sym prefix. - - * gnus-art.el (article-translate-characters): New function. - (article-treat-dumbquotes): New command and keystroke. - -Sun Oct 5 20:09:31 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-button-alist): No ' and " in News:. - - * gnus-msg.el (gnus-inews-insert-archive-gcc): Comp warn. - -Sat Oct 4 00:53:55 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.12 is released. - -Sat Oct 4 00:16:39 1997 Lars Magne Ingebrigtsen - - * gnus.el (gnus-plugged): Moved here. - - * nnmail.el (nnmail-delete-incoming): Changed default to nil. - - * gnus-int.el (gnus-request-scan): Don't do anything if - unplugged. - -Fri Oct 3 21:09:19 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-ignored-headers): Doc fix. - - * gnus-demon.el (gnus-demon-add-nntp-close-connection): New - function. - (gnus-demon-nntp-close-connection): Ditto. - - * nntp.el (nntp-last-command-time): New variable. - (nntp-retrieve-data): Use it. - - * message.el (message-news-p): Messages with Posted-To aren't - news. - (message-mode): Heed message-yank-prefix when filling. - - * nndraft.el (nndraft-request-restore-buffer): Remove Xrefs and - Lines headers. - - * nntp.el (nntp-encode-text): Encode according to RFC977. - -Wed Oct 1 18:27:26 1997 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-inews-insert-archive-gcc): gcc-self didn't - work if `gnus-message-archive-method' was nil. - - * nnmail.el (nnmail-article-group): Allow \\1 substitution. - -Sat Sep 27 12:57:44 1997 Lars Magne Ingebrigtsen - - * gnus-salt.el (gnus-pick-mouse-pick-region): Use it. - - * gnus-xmas.el (gnus-xmas-window-edges): New function. - - * gnus-score.el (gnus-score-edit-current-scores): Don't select - window. - -Sat Sep 27 12:52:31 1997 Hallvard B. Furuseth - - * messcompat.el ((boundp 'mail-mode-hook)): Check. - -Sat Sep 27 09:22:15 1997 Lars Magne Ingebrigtsen - - * nndraft.el (nndraft-possibly-change-group): Always open server. - - * gnus-sum.el (gnus-summary-pop-article): Force. - - * gnus-art.el (gnus-article-prepare): Push the article onto the - history. - - * gnus-sum.el (gnus-summary-pop-article): Pop to the right - article. - - * gnus-demon.el (gnus-demon-scan-news): Save excursion. - -Sat Sep 27 09:06:55 1997 Hallvard B. Furuseth - - * gnus-cache.el (gnus-summary-limit-include-cached): New command - and keystroke. - -Sat Sep 27 06:45:58 1997 Lars Magne Ingebrigtsen - - * gnus-uu.el (gnus-uu-invert-processable): Make interactive. - -Sat Sep 27 06:43:38 1997 Kim-Minh Kaplan - - * gnus-picon.el: Doc fixes. - -1997-09-23 Hrvoje Niksic - - * gnus.el: Removed definition of `custom-face-lookup'. - -Sat Sep 27 05:36:11 1997 Lars Magne Ingebrigtsen - - * nndraft.el: Would block nnmh. - - * gnus-sum.el (gnus-mark-article-as-unread): Don't allow marking - negative articles. - - * gnus-group.el (gnus-fetch-group): Use `gnus-no-server'. - - * gnus-agent.el (gnus-agent-with-fetch): Moved. - - * gnus-sum.el (gnus-nov-read-integer): Really skip to next field. - -Sat Sep 27 04:32:45 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.11 is released. - -Sat Sep 27 03:50:12 1997 Lars Magne Ingebrigtsen - - * message.el (message-send): Post without asking. - (message-mode): Modify paragraphs-start and paragraph-separate. - (message-newline-and-reformat): New command and keystroke. - -Thu Sep 25 00:13:41 1997 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-activate): Init server buffer. - -Wed Sep 24 04:11:59 1997 Lars Magne Ingebrigtsen - - * gnus-draft.el (gnus-draft-setup): Inexplicable binding problem - worked around. - - * nnsoup.el (nnsoup-always-save): Renamed. - -Wed Sep 24 04:11:02 1997 Nelson Jose dos Santos Ferreira - - * nnsoup.el (nnsoup-commit-reply-now): New variable. - (nnsoup-store-reply): Use it. - -Wed Sep 24 02:30:44 1997 Lars Magne Ingebrigtsen - - * gnus-ems.el (gnus-deactivate-mark): New alias. - -Tue Sep 23 07:56:07 1997 Lars Magne Ingebrigtsen - - * gnus.el: Win-away! - - * gnus-msg.el (gnus-setup-message): Don't trust make-symbol. - -Tue Sep 23 07:45:11 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.10 is released. - -Tue Sep 23 01:41:04 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-read-all-headers): New function. - (gnus-select-newsgroup): Use it. - (gnus-summary-refer-thread): Ditto. - (gnus-refer-thread-limit): New variable. - (gnus-summary-refer-thread): Use it. - - * gnus-nocem.el (gnus-nocem-message-wanted-p): New function. - (gnus-nocem-check-article): Use it. - (gnus-nocem-issuers): Dox ofx. - - * dgnushack.el (dgnushack-compile): Check for cus-edit. - - * message.el (message-included-forward-headers): Include Mime - headers. - (message-send): Allow posting without confirming from Agent. - -Mon Sep 22 05:43:14 1997 Lars Magne Ingebrigtsen - - * dgnushack.el (byte-compile-warnings): Don't warn about obsolete - variables. - - * gnus-sum.el (gnus-summary-refer-thread): New command and - keystroke. - (gnus-summary-limit-include-thread): New command and keystroke. - (gnus-summary-articles-in-thread): New function. - (gnus-articles-in-thread): Renamed. - -Sun Sep 21 23:54:50 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.9 is released. - -Sun Sep 21 23:38:46 1997 Lars Magne Ingebrigtsen - - * gnus.el (gnus-splash-face): ForestGreen everywhere. - - * gnus-sum.el (gnus-simplify-subject-fully): Use new variable. - (gnus-general-simplify-subject): Ditto. - -Sun Sep 21 23:34:13 1997 Kurt Swanson - - * gnus-sum.el (gnus-simplify-subject-functions): New variable. - (gnus-simplify-whitespace): New function. - - * gnus-util.el (gnus-map-function): New function. - -Sun Sep 21 23:22:04 1997 Michelangelo Grigni - - * gnus-score.el (gnus-score-regexp-bad-p): New function. - -Sun Sep 21 00:14:40 1997 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-summary-lower-score): Use sym pref. - (gnus-summary-increase-score): Use it. - - * gnus.el (gnus-current-prefix-symbol): New variable. - (gnus-current-prefix-symbols): New variable. - - * gnus-score.el (gnus-summary-increase-score): Take symbolic - prefix. - - * gnus.el (gnus-interactive): Removed. - (gnus-interactive): Renamed from gnus-interactive-1. - (gnus-symbolic-argument): New command. - - * gnus-draft.el (gnus-draft-send-message): Disable message - checks. - (gnus-draft-send): Ditto. - (gnus-draft-setup): Don't save buffer. - - * dgnushack.el (dgnushack-compile): Warn people about Custom. - - * gnus-group.el (gnus-group-iterate): Use gensymmed variables. - - * pop3.el (pop3-md5): `with-temp-buffer' doesn't exist in Emacs - 19.34. - - * nneething.el (nneething-directory): Defvarred. - - * message.el: Autoloaded nndraft things. - (message-set-auto-save-file-name): Use it. - - * dgnushack.el (dgnushack-compile): Warn about things. - - * gnus-art.el: Autoload w3-region. - - * gnus-vm.el (gnus-summary-save-in-vm): Simplified. - - * gnus.el: Changed `compiled-function-p' to `byte-code-function-p' - throughout. - - * gnus-sum.el (gnus-summary-edit-article): Supply additional - param. - - * gnus-group.el (gnus-group-iterate): Undo bogus change. - - * gnus-agent.el (gnus-agentize): Just call gnus-open-agent - directly. - - * gnus.el (gnus-interactive): New macro. - (gnus-interactive-1): New function. - - * gnus-sum.el (gnus-fetch-old-headers): Allow `invisible'. - (gnus-cut-thread): Use it. - (gnus-cut-threads): Ditto. - (gnus-summary-initial-limit): Ditto. - (gnus-summary-limit-children): Ditto. - - * gnus-art.el (gnus-article-edit-done): Accept a prefix arg. - (gnus-boring-article-headers): Allow `long-to' param. - (article-hide-boring-headers): Use it. - - * gnus-sum.el (gnus-summary-edit-article-done): Accept a - no-highlight param. - - * nntp.el (nntp-rlogin-program): New variable. - (nntp-open-rlogin): Use it. - - * nnvirtual.el (nnvirtual-request-post): New function. - - * gnus-msg.el (gnus-message-group-art): New variable. - - * gnus-draft.el (gnus-draft-setup): Don't use message-setup. - - * nndraft.el (nndraft): Allow editing articles. - - * gnus-ems.el (gnus-x-splash): Ditto. - - * gnus.el (gnus-splash-face): Darker face. - - * gnus-draft.el (gnus-draft-setup): Clobbered variables. - -Sat Sep 20 23:23:49 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.8 is released. - -Sat Sep 20 20:41:16 1997 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-setup-news-hook): New hook. - - * gnus-agent.el (gnus-agentize): Really set up queue group. - (gnus-open-agent): Setup queue here. - -Sat Sep 20 20:23:07 1997 Matt Simmons - - * message.el (message-set-auto-save-file-name): Make things work - without drafts. - -Sat Sep 20 18:32:02 1997 Lars Magne Ingebrigtsen - - * nnmh.el (nnmh-request-list-1): Check for links to ".". - - * nndraft.el (nndraft-possibly-change-group): New function. - - * gnus-agent.el (gnus-agent-queue-setup): New function. - -Thu Sep 18 04:54:59 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.7 is released. - -Thu Sep 18 03:33:54 1997 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-setup-message): Slap a progn around forms. - - * nndraft.el (nndraft-articles): Make sure directory exists. - - * message.el (message-mode): Don't delete article. - - * nnmh.el (nnmh-request-accept-article): Don't save when - noinsert. - -Wed Sep 17 03:37:59 1997 Lars Magne Ingebrigtsen - - * nndraft.el (nndraft-directory): Changed defaults. - - * gnus-agent.el (gnus-agent-fetch-session): Bind command method. - -Wed Sep 17 03:28:36 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.6 is released. - -1997-08-17 SL Baur - - * dgnushack.el (dgnushack-compile): Ignore .el files beginning - with an `=' character. - -Wed Sep 17 02:30:04 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-build-sparse-threads): Allow display of looped - References. - - * gnus-agent.el (gnus-agent-fetch-group-1): Separated out into - function. - - * message.el (message-delete-not-region): New command and - keystroke. - -Tue Sep 16 00:58:26 1997 Lars Magne Ingebrigtsen - - * nndraft.el (nndraft-directory): Changed value. - - * message.el (message-kill-buffer): Disassociate draft. - (message-mode): Use kill hook to disassociate. - (message-disassociate-draft): Double-check. - - * gnus-agent.el (gnus-agentize): Don't set twice. - - * gnus-art.el (gnus-article-prepare): Go to the right line before - marking. - - * gnus-start.el: Renamed the drafts group. - - * gnus-agent.el (gnus-agent-lib-file): Changed name of directory. - - * gnus-draft.el (gnus-draft-mode): Simplify. - -Tue Sep 16 00:18:11 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.5 is released. - -Mon Sep 15 00:53:50 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-alter-header-function): New variable. - (gnus-nov-parse-line): Use it. - (gnus-get-newsgroup-headers): Ditto. - - * gnus-draft.el (gnus-group-send-drafts): Don't send when - unplugged. - - * gnus-sum.el (gnus-summary-read-group): Don't show-all when - skipping groups. - - * gnus-start.el (gnus-start-draft-setup): Changed name. - -Mon Sep 15 00:40:09 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.4 is released. - -Mon Sep 15 00:19:07 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-goto-article): Accept Message-ID's. - -Sun Sep 14 21:41:35 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-group-make-articles-read): No params. - - * nndraft.el (nndraft-status-string): Fix. - - * gnus-draft.el (gnus-group-send-drafts): New command. - - * gnus-sum.el (gnus-compute-read-articles): Separated. - (gnus-update-read-articles): Allow computation. - - * nndraft.el (nndraft-articles): New function. - - * message.el (message-send): Disabled test. - -Sun Sep 14 21:17:34 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.3 is released. - -Sun Sep 14 01:51:45 1997 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-short-article): New variables. - - * message.el (message-set-auto-save-file-name): Use drafts. - - * nndraft.el (nndraft-request-expire-articles): Use it. - - * nnmh.el (nnmh-deletable-article-p): Change. - (nnmh-allow-delete-final): New variable. - - * gnus-msg.el (gnus-summary-send-draft): Removed. - - * gnus.el (gnus-article-mark-lists): Save unsendable marks. - - * gnus-sum.el (gnus-newsgroup-unsendable): New variable. - - * gnus-draft.el: New file. - - * gnus-sum.el (gnus-unsendable-mark): New variable. - - * nndraft.el (nndraft-execute-nnmh-command): Cleanup. - - * message.el (message-send-news): Use `gnus-request-post'. - - * gnus-agent.el (gnus-agentize): New command. - - * gnus-bcklg.el (gnus-backlog-remove-article): Remove the ident - from the list. - -Sun Sep 14 00:26:47 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.2 is released. - -Sun Sep 14 00:24:52 1997 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-headers): Make sure the summary buffer - exists. - -Sat Sep 13 23:35:28 1997 Greg Stark - - * gnus-ems.el (gnus-x-splash): New function. - -Sat Sep 13 22:46:16 1997 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-1): Use it. - - * gnus-ems.el (gnus-decode-coding-string): New alias. - - * message.el (message-unix-mail-delimiter): Dox fox. - - * nnmh.el (nnmh-request-list-1): Don't use coding system. - - * gnus-sum.el (gnus-summary-catchup): Reverse logic. - -Sat Sep 13 21:21:38 1997 Lars Magne Ingebrigtsen - - * gnus.el: Quassia Gnus v0.1 is released. diff --git a/lisp/Makefile b/lisp/Makefile deleted file mode 100644 index b949400..0000000 --- a/lisp/Makefile +++ /dev/null @@ -1,40 +0,0 @@ -SHELL = /bin/sh -EMACS=emacs -FLAGS=-batch -q -no-site-file -l ./dgnushack.el - -total: - rm -f *.elc ; $(EMACS) $(FLAGS) -f dgnushack-compile - -all: - rm -f *.elc ; $(EMACS) $(FLAGS) -f dgnushack-compile - -clever: - $(EMACS) $(FLAGS) -f dgnushack-compile - -some: - $(EMACS) $(FLAGS) -f dgnushack-compile - -tags: - etags *.el - -separately: - rm -f *.elc ; for i in *.el; do $(EMACS) $(FLAGS) -f batch-byte-compile $$i; done - -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 - -distclean: - rm -f *.orig *.rej *.elc *~ - diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el deleted file mode 100644 index 264ac6b..0000000 --- a/lisp/dgnushack.el +++ /dev/null @@ -1,88 +0,0 @@ -;;; dgnushack.el --- a hack to set the load path for byte-compiling -;; Copyright (C) 1994,95,96,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Version: 4.19 -;; Keywords: news, path - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(fset 'facep 'ignore) - -(require 'cl) -(require 'bytecomp) -(push "~/lisp/custom" load-path) -(push "." load-path) -(load "./lpath.el") - -(defalias 'device-sound-enabled-p 'ignore) -(defalias 'play-sound-file 'ignore) -(defalias 'nndb-request-article 'ignore) -(defalias 'efs-re-read-dir 'ignore) -(defalias 'ange-ftp-re-read-dir 'ignore) -(defalias 'define-mail-user-agent 'ignore) - -(eval-and-compile - (unless (string-match "XEmacs" emacs-version) - (fset 'get-popup-menu-response 'ignore) - (fset 'event-object 'ignore) - (fset 'x-defined-colors 'ignore) - (fset 'read-color 'ignore))) - -(setq byte-compile-warnings - '(free-vars unresolved callargs redefine)) - -(defun dgnushack-compile () - ;;(setq byte-compile-dynamic t) - (unless (locate-library "cus-edit") - (error "You do not seem to have Custom installed. -Fetch it from . -You also then need to add the following to the lisp/dgnushack.el file: - - (push \"~/lisp/custom\" load-path) - -Modify to suit your needs.")) - (let ((files (directory-files "." nil "^[^=].*\\.el$")) - (xemacs (string-match "XEmacs" emacs-version)) - ;;(byte-compile-generate-call-tree t) - file elc) - (condition-case () - (require 'w3-forms) - (error (setq files (delete "nnweb.el" (delete "nnlistserv.el" files))))) - (while (setq file (pop files)) - (when (or (and (not xemacs) - (not (member file '("gnus-xmas.el" "gnus-picon.el" - "messagexmas.el" "nnheaderxm.el" - "smiley.el" "x-overlay.el")))) - (and xemacs - (not (member file '("md5.el"))))) - (when (or (not (file-exists-p (setq elc (concat file "c")))) - (file-newer-than-file-p file elc)) - (ignore-errors - (byte-compile-file file))))))) - -(defun dgnushack-recompile () - (require 'gnus) - (byte-recompile-directory "." 0)) - -;;; dgnushack.el ends here - diff --git a/lisp/earcon.el b/lisp/earcon.el deleted file mode 100644 index 9bd6651..0000000 --- a/lisp/earcon.el +++ /dev/null @@ -1,241 +0,0 @@ -;;; earcon.el --- Sound effects for messages -;; Copyright (C) 1996 Free Software Foundation - -;; Author: Steven L. Baur -;; 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 provides access to sound effects in Gnus. - -;;; Code: - -(if (null (boundp 'running-xemacs)) - (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))) - -(eval-when-compile (require 'cl)) -(require 'gnus) -(require 'gnus-audio) -(require 'gnus-art) - -(defgroup earcon nil - "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 - :group 'earcon) - -(defcustom earcon-suffix "**" - "*String denoting the end of an earcon." - :type 'string - :group 'earcon) - -(defcustom earcon-regexp-alist - '(("boring" 1 "Boring.au") - ("evil[ \t]+laugh" 1 "Evil_Laugh.au") - ("gag\\|puke" 1 "Puke.au") - ("snicker" 1 "Snicker.au") - ("meow" 1 "catmeow.au") - ("sob\\|boohoo" 1 "cry.wav") - ("drum[ \t]*roll" 1 "drumroll.au") - ("blast" 1 "explosion.au") - ("flush\\|plonk!*" 1 "flush.au") - ("kiss" 1 "kiss.wav") - ("tee[ \t]*hee" 1 "laugh.au") - ("shoot" 1 "shotgun.wav") - ("yawn" 1 "snore.wav") - ("cackle" 1 "witch.au") - ("yell\\|roar" 1 "yell2.au") - ("whoop-de-doo" 1 "whistle.au")) - "*A list of regexps to map earcons to real sounds." - :type '(repeat (list regexp - (integer :tag "Match") - (string :tag "Sound"))) - :group 'earcon) - -(defvar earcon-button-marker-list nil) -(make-variable-buffer-local 'earcon-button-marker-list) - - - -;;; FIXME!! clone of code from gnus-vis.el FIXME!! -(defun earcon-article-push-button (event) - "Check text under the mouse pointer for a callback function. -If the text under the mouse pointer has a `earcon-callback' property, -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)) - (fun (get-text-property pos 'earcon-callback))) - (if fun (funcall fun data)))) - -(defun earcon-article-press-button () - "Check text at point for a callback function. -If the text at point has a `earcon-callback' property, -call it with the value of the `earcon-data' text property." - (interactive) - (let* ((data (get-text-property (point) 'earcon-data)) - (fun (get-text-property (point) 'earcon-callback))) - (if fun (funcall fun data)))) - -(defun earcon-article-prev-button (n) - "Move point to N buttons backward. -If N is negative, move forward instead." - (interactive "p") - (earcon-article-next-button (- n))) - -(defun earcon-article-next-button (n) - "Move point to N buttons forward. -If N is negative, move backward instead." - (interactive "p") - (let ((function (if (< n 0) 'previous-single-property-change - 'next-single-property-change)) - (inhibit-point-motion-hooks t) - (backward (< n 0)) - (limit (if (< n 0) (point-min) (point-max)))) - (setq n (abs n)) - (while (and (not (= limit (point))) - (> n 0)) - ;; Skip past the current button. - (when (get-text-property (point) 'earcon-callback) - (goto-char (funcall function (point) 'earcon-callback nil limit))) - ;; Go to the next (or previous) button. - (gnus-goto-char (funcall function (point) 'earcon-callback nil limit)) - ;; Put point at the start of the button. - (when (and backward (not (get-text-property (point) 'earcon-callback))) - (goto-char (funcall function (point) 'earcon-callback nil limit))) - ;; Skip past intangible buttons. - (when (get-text-property (point) 'intangible) - (incf n)) - (decf n)) - (unless (zerop n) - (gnus-message 5 "No more buttons")) - n)) - -(defun earcon-article-add-button (from to fun &optional data) - "Create a button between FROM and TO with callback FUN and data DATA." - (and (boundp gnus-article-button-face) - gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay from to) - 'face gnus-article-button-face)) - (gnus-add-text-properties - from to - (nconc (and gnus-article-mouse-face - (list gnus-mouse-face-prop gnus-article-mouse-face)) - (list 'gnus-callback fun) - (and data (list 'gnus-data data))))) - -(defun earcon-button-entry () - ;; Return the first entry in `gnus-button-alist' matching this place. - (let ((alist earcon-regexp-alist) - (case-fold-search t) - (entry nil)) - (while alist - (setq entry (pop alist)) - (if (looking-at (car entry)) - (setq alist nil) - (setq entry nil))) - entry)) - - -(defun earcon-button-push (marker) - ;; Push button starting at MARKER. - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char marker) - (let* ((entry (earcon-button-entry)) - (inhibit-point-motion-hooks t) - (fun 'gnus-audio-play) - (args (list (nth 2 entry)))) - (cond - ((fboundp fun) - (apply fun args)) - ((and (boundp fun) - (fboundp (symbol-value fun))) - (apply (symbol-value fun) args)) - (t - (gnus-message 1 "You must define `%S' to use this button" - (cons fun args))))))) - -;;; FIXME!! clone of code from gnus-vis.el FIXME!! - -;;;###interactive -(defun earcon-region (beg end) - "Play Sounds in the region between point and mark." - (interactive "r") - (earcon-buffer (current-buffer) beg end)) - -;;;###interactive -(defun earcon-buffer (&optional buffer st nd) - (interactive) - (save-excursion - ;; clear old markers. - (if (boundp 'earcon-button-marker-list) - (while earcon-button-marker-list - (set-marker (pop earcon-button-marker-list) nil)) - (setq earcon-button-marker-list nil)) - (and buffer (set-buffer buffer)) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (case-fold-search t) - (alist earcon-regexp-alist) - beg entry regexp) - (goto-char (point-min)) - (setq beg (point)) - (while (setq entry (pop alist)) - (setq regexp (concat (regexp-quote earcon-prefix) - ".*\\(" - (car entry) - "\\).*" - (regexp-quote earcon-suffix))) - (goto-char beg) - (while (re-search-forward regexp nil t) - (let* ((start (and entry (match-beginning 1))) - (end (and entry (match-end 1))) - (from (match-beginning 1))) - (earcon-article-add-button - start end 'earcon-button-push - (car (push (set-marker (make-marker) from) - earcon-button-marker-list))) - (gnus-audio-play (caddr entry)))))))) - -;;;###autoload -(defun gnus-earcon-display () - "Play sounds in message buffers." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - ;; Skip headers - (unless (search-forward "\n\n" nil t) - (goto-char (point-max))) - (sit-for 0) - (earcon-buffer (current-buffer) (point)))) - -;;;*** - -(provide 'earcon) - -(run-hooks 'earcon-load-hook) - -;;; earcon.el ends here diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el deleted file mode 100644 index f6ce18c..0000000 --- a/lisp/gnus-agent.el +++ /dev/null @@ -1,1279 +0,0 @@ -;;; gnus-agent.el --- unplugged support for Gnus -;; Copyright (C) 1997,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-cache) -(require 'nnvirtual) -(require 'gnus-sum) -(eval-when-compile (require 'cl)) - -(defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/") - "*Where the Gnus agent will store its files." - :group 'gnus-agent - :type 'directory) - -(defcustom gnus-agent-plugged-hook nil - "*Hook run when plugging into the network." - :group 'gnus-agent - :type 'hook) - -(defcustom gnus-agent-unplugged-hook nil - "*Hook run when unplugging from the network." - :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) - -;;; Internal variables - -(defvar gnus-agent-history-buffers nil) -(defvar gnus-agent-buffer-alist nil) -(defvar gnus-agent-article-alist nil) -(defvar gnus-agent-group-alist nil) -(defvar gnus-agent-covered-methods nil) -(defvar gnus-category-alist nil) -(defvar gnus-agent-current-history nil) -(defvar gnus-agent-overview-buffer nil) -(defvar gnus-category-predicate-cache nil) -(defvar gnus-category-group-cache nil) -(defvar gnus-agent-spam-hashtb nil) -(defvar gnus-agent-file-name nil) -(defvar gnus-agent-send-mail-function nil) -(defvar gnus-agent-article-file-coding-system 'no-conversion) - -;; Dynamic variables -(defvar gnus-headers) -(defvar gnus-score) - -;;; -;;; Setup -;;; - -(defun gnus-open-agent () - (setq gnus-agent t) - (gnus-agent-read-servers) - (gnus-category-read) - (setq gnus-agent-overview-buffer - (get-buffer-create " *Gnus agent overview*")) - (add-hook 'gnus-group-mode-hook 'gnus-agent-mode) - (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode) - (add-hook 'gnus-server-mode-hook 'gnus-agent-mode)) - -(gnus-add-shutdown 'gnus-close-agent 'gnus) - -(defun gnus-close-agent () - (setq gnus-agent-covered-methods nil - gnus-category-predicate-cache nil - gnus-category-group-cache nil - gnus-agent-spam-hashtb nil) - (gnus-kill-buffer gnus-agent-overview-buffer)) - -;;; -;;; Utility functions -;;; - -(defun gnus-agent-read-file (file) - "Load FILE and do a `read' there." - (nnheader-temp-write nil - (ignore-errors - (insert-file-contents file) - (goto-char (point-min)) - (read (current-buffer))))) - -(defsubst gnus-agent-method () - (concat (symbol-name (car gnus-command-method)) "/" - (if (equal (cadr gnus-command-method) "") - "unnamed" - (cadr gnus-command-method)))) - -(defsubst gnus-agent-directory () - "Path 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)) - -;;; 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))) - -(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) - (widen))) - -(defmacro gnus-agent-with-fetch (&rest forms) - "Do FORMS safely." - `(unwind-protect - (progn - (gnus-agent-start-fetch) - ,@forms) - (gnus-agent-stop-fetch))) - -(put 'gnus-agent-with-fetch 'lisp-indent-function 0) -(put 'gnus-agent-with-fetch 'edebug-form-spec '(body)) - -;;; -;;; Mode infestation -;;; - -(defvar gnus-agent-mode-hook nil - "Hook run when installing agent mode.") - -(defvar gnus-agent-mode nil) -(defvar gnus-agent-mode-status '(gnus-agent-mode " Plugged")) - -(defun gnus-agent-mode () - "Minor mode for providing a agent support in Gnus buffers." - (let* ((buffer (progn (string-match "^gnus-\\(.*\\)-mode$" - (symbol-name major-mode)) - (match-string 1 (symbol-name major-mode)))) - (mode (intern (format "gnus-agent-%s-mode" buffer)))) - (set (make-local-variable 'gnus-agent-mode) t) - (set mode nil) - (set (make-local-variable mode) t) - ;; Set up the menu. - (when (gnus-visual-p 'agent-menu 'menu) - (funcall (intern (format "gnus-agent-%s-make-menu-bar" buffer)))) - (unless (assq 'gnus-agent-mode minor-mode-alist) - (push gnus-agent-mode-status minor-mode-alist)) - (unless (assq mode minor-mode-map-alist) - (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map" - buffer)))) - minor-mode-map-alist)) - (gnus-agent-toggle-plugged gnus-plugged) - (gnus-run-hooks 'gnus-agent-mode-hook))) - -(defvar gnus-agent-group-mode-map (make-sparse-keymap)) -(gnus-define-keys gnus-agent-group-mode-map - "Ju" gnus-agent-fetch-groups - "Jc" gnus-enter-category-buffer - "Jj" gnus-agent-toggle-plugged - "Js" gnus-agent-fetch-session - "JS" gnus-group-send-drafts - "Ja" gnus-agent-add-group) - -(defun gnus-agent-group-make-menu-bar () - (unless (boundp 'gnus-agent-group-menu) - (easy-menu-define - gnus-agent-group-menu gnus-agent-group-mode-map "" - '("Agent" - ["Toggle plugged" gnus-agent-toggle-plugged t] - ["List categories" gnus-enter-category-buffer t] - ["Send drafts" gnus-group-send-drafts gnus-plugged] - ("Fetch" - ["All" gnus-agent-fetch-session gnus-plugged] - ["Group" gnus-agent-fetch-group gnus-plugged]))))) - -(defvar gnus-agent-summary-mode-map (make-sparse-keymap)) -(gnus-define-keys gnus-agent-summary-mode-map - "Jj" gnus-agent-toggle-plugged - "J#" gnus-agent-mark-article - "J\M-#" gnus-agent-unmark-article - "@" gnus-agent-toggle-mark - "Jc" gnus-agent-catchup) - -(defun gnus-agent-summary-make-menu-bar () - (unless (boundp 'gnus-agent-summary-menu) - (easy-menu-define - gnus-agent-summary-menu gnus-agent-summary-mode-map "" - '("Agent" - ["Toggle plugged" gnus-agent-toggle-plugged t] - ["Mark as downloadable" gnus-agent-mark-article t] - ["Unmark as downloadable" gnus-agent-unmark-article t] - ["Toggle mark" gnus-agent-toggle-mark t] - ["Catchup undownloaded" gnus-agent-catchup t])))) - -(defvar gnus-agent-server-mode-map (make-sparse-keymap)) -(gnus-define-keys gnus-agent-server-mode-map - "Jj" gnus-agent-toggle-plugged - "Ja" gnus-agent-add-server - "Jr" gnus-agent-remove-server) - -(defun gnus-agent-server-make-menu-bar () - (unless (boundp 'gnus-agent-server-menu) - (easy-menu-define - gnus-agent-server-menu gnus-agent-server-mode-map "" - '("Agent" - ["Toggle plugged" gnus-agent-toggle-plugged t] - ["Add" gnus-agent-add-server t] - ["Remove" gnus-agent-remove-server t])))) - -(defun gnus-agent-toggle-plugged (plugged) - "Toggle whether Gnus is unplugged or not." - (interactive (list (not gnus-plugged))) - (setq gnus-plugged plugged) - (if plugged - (progn - (gnus-run-hooks 'gnus-agent-plugged-hook) - (setcar (cdr gnus-agent-mode-status) " Plugged")) - (gnus-agent-close-connections) - (gnus-run-hooks 'gnus-agent-unplugged-hook) - (setcar (cdr gnus-agent-mode-status) " Unplugged")) - (set-buffer-modified-p t)) - -(defun gnus-agent-close-connections () - "Close all methods covered by the Gnus agent." - (let ((methods gnus-agent-covered-methods)) - (while methods - (gnus-close-server (pop methods))))) - -;;;###autoload -(defun gnus-unplugged () - "Start Gnus unplugged." - (interactive) - (setq gnus-plugged nil) - (gnus)) - -;;;###autoload -(defun gnus-agentize () - "Allow Gnus to be an offline newsreader. -The normal usage of this command is to put the following as the -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." - (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)))) - -(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 "")) - (let ((gnus-level-default-subscribed 1)) - (gnus-subscribe-group "nndraft:queue" nil '(nndraft ""))) - (gnus-group-set-parameter - "nndraft:queue" 'gnus-dummy '((gnus-draft-mode))))) - -(defun gnus-agent-send-mail () - (if gnus-plugged - (funcall gnus-agent-send-mail-function) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (gnus-request-accept-article "nndraft:queue"))) - -;;; -;;; Group mode commands -;;; - -(defun gnus-agent-fetch-groups (n) - "Put all new articles in the current groups into the agent." - (interactive "P") - (gnus-group-iterate n 'gnus-agent-fetch-group)) - -(defun gnus-agent-fetch-group (group) - "Put all new articles in GROUP into the agent." - (interactive (list (gnus-group-group-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)))) - -(defun gnus-agent-add-group (category arg) - "Add the current group to an agent category." - (interactive - (list - (intern - (completing-read - "Add to category: " - (mapcar (lambda (cat) (list (symbol-name (car cat)))) - gnus-category-alist) - nil t)) - current-prefix-arg)) - (let ((cat (assq category gnus-category-alist)) - c groups) - (gnus-group-iterate arg - (lambda (group) - (when (cadddr (setq c (gnus-group-category group))) - (setf (cadddr c) (delete group (cadddr c)))) - (push group groups))) - (setf (cadddr cat) (nconc (cadddr cat) groups)) - (gnus-category-write))) - -;;; -;;; Server mode commands -;;; - -(defun gnus-agent-add-server (server) - "Enroll SERVER in the agent program." - (interactive (list (gnus-server-server-name))) - (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) - (error "Server already in the agent program")) - (push method gnus-agent-covered-methods) - (gnus-agent-write-servers) - (message "Entered %s into the agent" server))) - -(defun gnus-agent-remove-server (server) - "Remove SERVER from the agent program." - (interactive (list (gnus-server-server-name))) - (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) - (error "Server not in the agent program")) - (setq gnus-agent-covered-methods - (delete method gnus-agent-covered-methods)) - (gnus-agent-write-servers) - (message "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")))) - -(defun gnus-agent-write-servers () - "Write the alist of covered servers." - (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/servers") - (prin1 gnus-agent-covered-methods (current-buffer)))) - -;;; -;;; Summary commands -;;; - -(defun gnus-agent-mark-article (n &optional unmark) - "Mark the next N articles as downloadable. -If N is negative, mark backward instead. If UNMARK is non-nil, remove -the 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) - (progn - (gnus-summary-set-agent-mark - (gnus-summary-article-number) unmark) - (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-agent-unmark-article (n) - "Remove the downloadable 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") - (gnus-agent-mark-article n t)) - -(defun gnus-agent-toggle-mark (n) - "Toggle the downloadable mark from the next N articles. -If N is negative, toggle backward instead. The difference between N and -the actual number of articles toggled is returned." - (interactive "p") - (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))) - -(defun gnus-agent-get-undownloaded-list () - "Mark all unfetched articles as read." - (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) - (when (and (not gnus-plugged) - (gnus-agent-method-p gnus-command-method)) - (gnus-agent-load-alist gnus-newsgroup-name) - (let ((articles gnus-newsgroup-unreads) - article) - (while (setq article (pop articles)) - (unless (or (cdr (assq article gnus-agent-article-alist)) - (memq article gnus-newsgroup-downloadable)) - (push article gnus-newsgroup-undownloaded))))))) - -(defun gnus-agent-catchup () - "Mark all undownloaded articles as read." - (interactive) - (save-excursion - (while gnus-newsgroup-undownloaded - (gnus-summary-mark-article - (pop gnus-newsgroup-undownloaded) gnus-catchup-mark))) - (gnus-summary-position-point)) - -;;; -;;; Internal functions -;;; - -(defun gnus-agent-save-active (method) - (when (gnus-agent-method-p method) - (let* ((gnus-command-method method) - (file (gnus-agent-lib-file "active"))) - (gnus-make-directory (file-name-directory file)) - (let ((coding-system-for-write gnus-agent-article-file-coding-system)) - (write-region (point-min) (point-max) file nil 'silent)) - (when (file-exists-p (gnus-agent-lib-file "groups")) - (delete-file (gnus-agent-lib-file "groups")))))) - -(defun gnus-agent-save-groups (method) - (let* ((gnus-command-method method) - (file (gnus-agent-lib-file "groups"))) - (gnus-make-directory (file-name-directory file)) - (write-region (point-min) (point-max) file nil 'silent)) - (when (file-exists-p (gnus-agent-lib-file "active")) - (delete-file (gnus-agent-lib-file "active")))) - -(defun gnus-agent-group-path (group) - "Translate GROUP into a path." - (if nnmail-use-long-file-names - group - (nnheader-translate-file-chars - (nnheader-replace-chars-in-string group ?. ?/)))) - - - -(defun gnus-agent-method-p (method) - "Say whether METHOD is covered by the agent." - (member method gnus-agent-covered-methods)) - -(defun gnus-agent-get-function (method) - (if (and (not gnus-plugged) - (gnus-agent-method-p method)) - (progn - (require 'nnagent) - 'nnagent) - (car method))) - -;;; History functions - -(defun gnus-agent-history-buffer () - (cdr (assoc (gnus-agent-method) gnus-agent-history-buffers))) - -(defun gnus-agent-open-history () - (save-excursion - (push (cons (gnus-agent-method) - (set-buffer (get-buffer-create - (format " *Gnus agent %s history*" - (gnus-agent-method))))) - gnus-agent-history-buffers) - (erase-buffer) - (insert "\n") - (let ((file (gnus-agent-lib-file "history"))) - (when (file-exists-p file) - (insert-file 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 (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) - (setq gnus-agent-history-buffers - (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)) - (insert id "\t" (number-to-string date) "\t") - (while group-arts - (insert (caar group-arts) "/" (number-to-string (cdr (pop group-arts))) - " ")) - (insert "\n"))) - -(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 -;;; - -(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 (gnus-time-to-day (current-time))) - (case-fold-search t) - pos alists crosses id elem) - (gnus-make-directory dir) - (gnus-message 7 "Fetching articles for %s..." group) - ;; Fetch the articles from the backend. - (if (gnus-check-backend-function 'retrieve-articles group) - (setq pos (gnus-retrieve-articles articles group)) - (nnheader-temp-write nil - (let ((buf (current-buffer)) - article) - (while (setq article (pop articles)) - (when (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)))) - (let ((coding-system-for-write gnus-agent-article-file-coding-system)) - (write-region (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) - (let (gnus-agent-article-alist group alist beg end) - (save-excursion - (set-buffer gnus-agent-overview-buffer) - (when (nnheader-find-nov-line article) - (forward-word 1) - (setq beg (point)) - (setq end (progn (forward-line 1) (point))))) - (while crosses - (setq group (caar crosses)) - (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))) - (save-excursion - (set-buffer (get-buffer-create (format " *Gnus agent overview %s*" - group))) - (when (= (point-max) (point-min)) - (push (cons group (current-buffer)) gnus-agent-buffer-alist) - (ignore-errors - (insert-file-contents - (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)))) - -(defun gnus-agent-flush-cache () - (save-excursion - (while gnus-agent-buffer-alist - (set-buffer (cdar gnus-agent-buffer-alist)) - (write-region (point-min) (point-max) - (gnus-agent-article-name ".overview" - (caar gnus-agent-buffer-alist)) - nil 'silent) - (pop gnus-agent-buffer-alist)) - (while gnus-agent-group-alist - (nnheader-temp-write (caar gnus-agent-group-alist) - (princ (cdar gnus-agent-group-alist)) - (insert "\n")) - (pop gnus-agent-group-alist)))) - -(defun gnus-agent-fetch-headers (group articles &optional force) - (gnus-agent-load-alist group) - ;; Find out what headers we need to retrieve. - (when articles - (while (and articles - (assq (car articles) gnus-agent-article-alist)) - (pop articles)) - (let ((arts articles)) - (while (cdr arts) - (if (assq (cadr arts) gnus-agent-article-alist) - (setcdr arts (cddr arts)) - (setq arts (cdr arts))))) - ;; Fetch them. - (when articles - (gnus-message 7 "Fetching headers for %s..." group) - (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)) - (let (file) - (when (file-exists-p - (setq file (gnus-agent-article-name ".overview" group))) - (gnus-agent-braid-nov group articles file)) - (gnus-make-directory (nnheader-translate-file-chars - (file-name-directory file))) - (write-region (point-min) (point-max) file nil 'silent) - (gnus-agent-save-alist group articles nil)) - t)))) - -(defsubst gnus-agent-copy-nov-line (article) - (let (b e) - (set-buffer gnus-agent-overview-buffer) - (setq b (point)) - (if (eq article (read (current-buffer))) - (setq e (progn (forward-line 1) (point))) - (setq e b)) - (set-buffer nntp-server-buffer) - (insert-buffer-substring gnus-agent-overview-buffer b e))) - -(defun gnus-agent-braid-nov (group articles file) - (let (beg end) - (set-buffer gnus-agent-overview-buffer) - (goto-char (point-min)) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-file-contents file) - (goto-char (point-min)) - (if (or (= (point-min) (point-max)) - (progn - (forward-line -1) - (< (read (current-buffer)) (car articles)))) - ;; We have only headers that are after the older headers, - ;; so we just append them. - (progn - (goto-char (point-max)) - (insert-buffer-substring gnus-agent-overview-buffer)) - ;; We do it the hard way. - (nnheader-find-nov-line (car articles)) - (gnus-agent-copy-nov-line (car articles)) - (pop articles) - (while (and articles - (not (eobp))) - (while (and (not (eobp)) - (< (read (current-buffer)) (car articles))) - (forward-line 1)) - (beginning-of-line) - (unless (eobp) - (gnus-agent-copy-nov-line (car articles)) - (setq articles (cdr articles)))) - (when articles - (let (b e) - (set-buffer gnus-agent-overview-buffer) - (setq b (point) - e (point-max)) - (set-buffer nntp-server-buffer) - (insert-buffer-substring gnus-agent-overview-buffer b e)))))) - -(defun gnus-agent-load-alist (group &optional dir) - "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))))) - -(defun gnus-agent-save-alist (group &optional articles state dir) - "Load the article-state alist for GROUP." - (nnheader-temp-write (if dir - (concat dir ".agentview") - (gnus-agent-article-name ".agentview" group)) - (princ (setq gnus-agent-article-alist - (nconc gnus-agent-article-alist - (mapcar (lambda (article) (cons article state)) - articles))) - (current-buffer)) - (insert "\n"))) - -(defun gnus-agent-article-name (article group) - (concat (gnus-agent-directory) (gnus-agent-group-path group) "/" - (if (stringp article) article (string-to-number article)))) - -;;;###autoload -(defun gnus-agent-batch-fetch () - "Start Gnus and fetch session." - (interactive) - (gnus) - (gnus-agent-fetch-session) - (gnus-group-exit)) - -(defun gnus-agent-fetch-session () - "Fetch all articles and headers that are eligible for fetching." - (interactive) - (unless gnus-agent-covered-methods - (error "No servers are covered by the Gnus agent")) - (unless gnus-plugged - (error "Can't fetch articles while Gnus is unplugged")) - (let ((methods gnus-agent-covered-methods) - groups group gnus-command-method) - (save-excursion - (while methods - (setq gnus-command-method (car methods) - groups (gnus-groups-from-server (pop 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))))) - (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-dependencies gnus-newsgroup-headers - gnus-newsgroup-scored gnus-headers gnus-score - gnus-use-cache articles score arts - category predicate info marks score-param) - ;; Fetch headers. - (when (and (setq articles (gnus-list-of-unread-articles group)) - (gnus-agent-fetch-headers group articles)) - ;; 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)) - (setq category (gnus-group-category group)) - (setq predicate - (gnus-get-predicate - (or (gnus-group-get-parameter group 'agent-predicate) - (cadr category)))) - (setq score-param - (or (gnus-group-get-parameter group 'agent-score) - (caddr category))) - (when score-param - (gnus-score-headers (list (list score-param)))) - (setq arts nil) - (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)))) - -;;; -;;; Agent Category Mode -;;; - -(defvar gnus-category-mode-hook nil - "Hook run in `gnus-category-mode' buffers.") - -(defvar gnus-category-line-format " %(%20c%): %g\n" - "Format of category lines.") - -(defvar gnus-category-mode-line-format "Gnus: %%b" - "The format specification for the category mode line.") - -(defvar gnus-agent-short-article 100 - "Articles that have fewer lines than this are short.") - -(defvar gnus-agent-long-article 200 - "Articles that have more lines than this are long.") - -(defvar gnus-agent-low-score 0 - "Articles that have a score lower than this have a low score.") - -(defvar gnus-agent-high-score 0 - "Articles that have a score higher than this have a high score.") - - -;;; Internal variables. - -(defvar gnus-category-buffer "*Agent Category*") - -(defvar gnus-category-line-format-alist - `((?c name ?s) - (?g groups ?d))) - -(defvar gnus-category-mode-line-format-alist - `((?u user-defined ?s))) - -(defvar gnus-category-line-format-spec nil) -(defvar gnus-category-mode-line-format-spec nil) - -(defvar gnus-category-mode-map nil) -(put 'gnus-category-mode 'mode-class 'special) - -(unless gnus-category-mode-map - (setq gnus-category-mode-map (make-sparse-keymap)) - (suppress-keymap gnus-category-mode-map) - - (gnus-define-keys gnus-category-mode-map - "q" gnus-category-exit - "k" gnus-category-kill - "c" gnus-category-copy - "a" gnus-category-add - "p" gnus-category-edit-predicate - "g" gnus-category-edit-groups - "s" gnus-category-edit-score - "l" gnus-category-list - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) - -(defvar gnus-category-menu-hook nil - "*Hook run after the creation of the menu.") - -(defun gnus-category-make-menu-bar () - (gnus-turn-off-edit-menu 'category) - (unless (boundp 'gnus-category-menu) - (easy-menu-define - gnus-category-menu gnus-category-mode-map "" - '("Categories" - ["Add" gnus-category-add t] - ["Kill" gnus-category-kill t] - ["Copy" gnus-category-copy t] - ["Edit predicate" gnus-category-edit-predicate t] - ["Edit score" gnus-category-edit-score t] - ["Edit groups" gnus-category-edit-groups t] - ["Exit" gnus-category-exit t])) - - (gnus-run-hooks 'gnus-category-menu-hook))) - -(defun gnus-category-mode () - "Major mode for listing and editing agent categories. - -All normal editing commands are switched off. -\\ -For more in-depth information on this mode, read the manual -(`\\[gnus-info-find-node]'). - -The following commands are available: - -\\{gnus-category-mode-map}" - (interactive) - (when (gnus-visual-p 'category-menu 'menu) - (gnus-category-make-menu-bar)) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-category-mode) - (setq mode-name "Category") - (gnus-set-default-directory) - (setq mode-line-process nil) - (use-local-map gnus-category-mode-map) - (buffer-disable-undo (current-buffer)) - (setq truncate-lines t) - (setq buffer-read-only t) - (gnus-run-hooks 'gnus-category-mode-hook)) - -(defalias 'gnus-category-position-point 'gnus-goto-colon) - -(defun gnus-category-insert-line (category) - (let* ((name (car category)) - (groups (length (cadddr category)))) - (beginning-of-line) - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - ;; Insert the text. - (eval gnus-category-line-format-spec)) - (list 'gnus-category name)))) - -(defun gnus-enter-category-buffer () - "Go to the Category buffer." - (interactive) - (gnus-category-setup-buffer) - (gnus-configure-windows 'category) - (gnus-category-prepare)) - -(defun gnus-category-setup-buffer () - (unless (get-buffer gnus-category-buffer) - (save-excursion - (set-buffer (get-buffer-create gnus-category-buffer)) - (gnus-add-current-to-buffer-list) - (gnus-category-mode)))) - -(defun gnus-category-prepare () - (gnus-set-format 'category-mode) - (gnus-set-format 'category t) - (let ((alist gnus-category-alist) - (buffer-read-only nil)) - (erase-buffer) - (while alist - (gnus-category-insert-line (pop alist))) - (goto-char (point-min)) - (gnus-category-position-point))) - -(defun gnus-category-name () - (or (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))))) - -(defun gnus-category-write () - "Write the category alist." - (setq gnus-category-predicate-cache nil - gnus-category-group-cache nil) - (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/categories") - (prin1 gnus-category-alist (current-buffer)))) - -(defun gnus-category-edit-predicate (category) - "Edit the predicate for CATEGORY." - (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) - `(lambda (predicate) - (setf (cadr (assq ',category gnus-category-alist)) predicate) - (gnus-category-write) - (gnus-category-list))))) - -(defun gnus-category-edit-score (category) - "Edit the score expression for CATEGORY." - (interactive (list (gnus-category-name))) - (let ((info (assq category gnus-category-alist))) - (gnus-edit-form - (caddr info) - (format "Editing the score expression for category %s" category) - `(lambda (groups) - (setf (caddr (assq ',category gnus-category-alist)) groups) - (gnus-category-write) - (gnus-category-list))))) - -(defun gnus-category-edit-groups (category) - "Edit the group list for CATEGORY." - (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) - `(lambda (groups) - (setf (cadddr (assq ',category gnus-category-alist)) groups) - (gnus-category-write) - (gnus-category-list))))) - -(defun gnus-category-kill (category) - "Kill the current category." - (interactive (list (gnus-category-name))) - (let ((info (assq category gnus-category-alist)) - (buffer-read-only nil)) - (gnus-delete-line) - (gnus-category-write) - (setq gnus-category-alist (delq info gnus-category-alist)))) - -(defun gnus-category-copy (category to) - "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) - gnus-category-alist) - (gnus-category-write) - (gnus-category-list))) - -(defun gnus-category-add (category) - "Create a new category." - (interactive "SCategory name: ") - (when (assq category gnus-category-alist) - (error "Category %s already exists" category)) - (push (list category 'true nil nil) - gnus-category-alist) - (gnus-category-write) - (gnus-category-list)) - -(defun gnus-category-list () - "List all categories." - (interactive) - (gnus-category-prepare)) - -(defun gnus-category-exit () - "Return to the group buffer." - (interactive) - (kill-buffer (current-buffer)) - (gnus-configure-windows 'group t)) - -;; To avoid having 8-bit characters in the source file. -(defvar gnus-category-not (list '! 'not (intern (format "%c" 172)))) - -(defvar gnus-category-predicate-alist - '((spam . gnus-agent-spam-p) - (short . gnus-agent-short-p) - (long . gnus-agent-long-p) - (low . gnus-agent-low-scored-p) - (high . gnus-agent-high-scored-p) - (true . gnus-agent-true) - (false . gnus-agent-false)) - "Mapping from short score predicate symbols to predicate functions.") - -(defun gnus-agent-spam-p () - "Say whether an article is spam or not." - (unless gnus-agent-spam-hashtb - (setq gnus-agent-spam-hashtb (gnus-make-hashtable 1000))) - (if (not (equal (mail-header-references gnus-headers) "")) - nil - (let ((string (gnus-simplify-subject (mail-header-subject gnus-headers)))) - (prog1 - (gnus-gethash string gnus-agent-spam-hashtb) - (gnus-sethash string t gnus-agent-spam-hashtb))))) - -(defun gnus-agent-short-p () - "Say whether an article is short or not." - (< (mail-header-lines gnus-headers) gnus-agent-short-article)) - -(defun gnus-agent-long-p () - "Say whether an article is long or not." - (> (mail-header-lines gnus-headers) gnus-agent-long-article)) - -(defun gnus-agent-low-scored-p () - "Say whether an article has a low score or not." - (< gnus-score gnus-agent-low-score)) - -(defun gnus-agent-high-scored-p () - "Say whether an article has a high score or not." - (> gnus-score gnus-agent-low-score)) - -(defun gnus-category-make-function (cat) - "Make a function from category CAT." - `(lambda () ,(gnus-category-make-function-1 cat))) - -(defun gnus-agent-true () - "Return t." - t) - -(defun gnus-agent-false () - "Return nil." - nil) - -(defun gnus-category-make-function-1 (cat) - "Make a function from category CAT." - (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) - `(,(cond - ((memq (car cat) '(& and)) - 'and) - ((memq (car cat) '(| or)) - 'or) - ((memq (car cat) gnus-category-not) - 'not)) - ,@(mapcar 'gnus-category-make-function-1 (cdr cat)))) - (t - (error "Unknown category type: %s" cat)))) - -(defun gnus-get-predicate (predicate) - "Return the predicate for CATEGORY." - (or (cdr (assoc predicate gnus-category-predicate-cache)) - (cdar (push (cons predicate - (gnus-category-make-function predicate)) - gnus-category-predicate-cache)))) - -(defun gnus-group-category (group) - "Return the category GROUP belongs to." - (unless gnus-category-group-cache - (setq gnus-category-group-cache (gnus-make-hashtable 1000)) - (let ((cs gnus-category-alist) - groups cat) - (while (setq cat (pop cs)) - (setq groups (cadddr 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." - (interactive) - (let ((methods gnus-agent-covered-methods) - (alist (cdr gnus-newsrc-alist)) - gnus-command-method ofiles info method file group) - (while (setq gnus-command-method (pop methods)) - (setq ofiles (nconc ofiles (gnus-agent-expire-directory - (gnus-agent-directory))))) - (while (setq info (pop alist)) - (when (and (gnus-agent-method-p - (setq gnus-command-method - (gnus-find-method-for-group - (setq group (gnus-info-group info))))) - (member - (setq file - (concat - (gnus-agent-directory) - (gnus-agent-group-path group) "/.overview")) - ofiles)) - (setq ofiles (delete file ofiles)) - (gnus-agent-expire-group file group))) - (while ofiles - (gnus-agent-expire-group (pop ofiles))))) - -(defun gnus-agent-expire-directory (dir) - "Expire all groups in DIR recursively." - (when (file-directory-p dir) - (let ((files (directory-files dir t)) - file ofiles) - (while (setq file (pop files)) - (cond - ((member (file-name-nondirectory file) '("." "..")) - ;; Do nothing. - ) - ((file-directory-p file) - ;; Recurse. - (setq ofiles (nconc ofiles (gnus-agent-expire-directory file)))) - ((string-match "\\.overview$" file) - ;; Expire group. - (push file ofiles)))) - ofiles))) - -(defun gnus-agent-expire-group (overview &optional group) - "Expire articles in OVERVIEW." - (gnus-message 5 "Expiring %s..." overview) - (let ((odate (- (gnus-time-to-day (current-time)) 4)) - (dir (file-name-directory overview)) - (info (when group (gnus-get-info group))) - headers article file point unreads) - (gnus-agent-load-alist nil dir) - (when info - (setq unreads - (nconc - (gnus-list-of-unread-articles group) - (gnus-uncompress-range - (cdr (assq 'tick (gnus-info-marks info)))) - (gnus-uncompress-range - (cdr (assq 'dormant (gnus-info-marks info))))))) - (nnheader-temp-write overview - (insert-file-contents overview) - (goto-char (point-min)) - (while (not (eobp)) - (setq point (point)) - (condition-case () - (setq headers (inline (nnheader-parse-nov))) - (error - (goto-char point) - (gnus-delete-line) - (setq headers nil))) - (when headers - (unless (memq (setq article (mail-header-number headers)) unreads) - (if (not (< (inline - (gnus-time-to-day - (inline (nnmail-date-to-time - (mail-header-date headers))))) - odate)) - (forward-line 1) - (gnus-delete-line) - (setq gnus-agent-article-alist - (delq (assq article gnus-agent-article-alist) - gnus-agent-article-alist)) - (when (file-exists-p - (setq file (concat dir (number-to-string article)))) - (delete-file file)))))) - (gnus-agent-save-alist nil nil nil dir)))) - -;;;###autoload -(defun gnus-agent-batch () - (interactive) - (let ((init-file-user "") - (gnus-always-read-dribble-file t)) - (gnus)) - (gnus-group-send-drafts) - (gnus-agent-fetch-session)) - -(provide 'gnus-agent) - -;;; gnus-agent.el ends here diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el deleted file mode 100644 index bab415b..0000000 --- a/lisp/gnus-art.el +++ /dev/null @@ -1,3305 +0,0 @@ -;;; gnus-art.el --- article mode commands for Semi-gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko -;; Keywords: mail, news, MIME - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'custom) -(require 'gnus) -(require 'gnus-sum) -(require 'gnus-spec) -(require 'gnus-int) -(require 'browse-url) -(require 'alist) -(require 'mime-view) - -(defgroup gnus-article nil - "Article display." - :link '(custom-manual "(gnus)The Article Buffer") - :group 'gnus) - -(defgroup gnus-article-hiding nil - "Hiding article parts." - :link '(custom-manual "(gnus)Article Hiding") - :group 'gnus-article) - -(defgroup gnus-article-highlight nil - "Article highlighting." - :link '(custom-manual "(gnus)Article Highlighting") - :group 'gnus-article - :group 'gnus-visual) - -(defgroup gnus-article-signature nil - "Article signatures." - :link '(custom-manual "(gnus)Article Signature") - :group 'gnus-article) - -(defgroup gnus-article-headers nil - "Article headers." - :link '(custom-manual "(gnus)Hiding Headers") - :group 'gnus-article) - -(defgroup gnus-article-washing nil - "Special commands on articles." - :link '(custom-manual "(gnus)Article Washing") - :group 'gnus-article) - -(defgroup gnus-article-emphasis nil - "Fontisizing articles." - :link '(custom-manual "(gnus)Article Fontisizing") - :group 'gnus-article) - -(defgroup gnus-article-saving nil - "Saving articles." - :link '(custom-manual "(gnus)Saving Articles") - :group 'gnus-article) - -(defgroup gnus-article-mime nil - "Worshiping the MIME wonder." - :link '(custom-manual "(gnus)Using MIME") - :group 'gnus-article) - -(defgroup gnus-article-buttons nil - "Pushable buttons in the article buffer." - :link '(custom-manual "(gnus)Article Buttons") - :group 'gnus-article) - -(defgroup gnus-article-various nil - "Other article options." - :link '(custom-manual "(gnus)Misc Article") - :group 'gnus-article) - -(defcustom gnus-ignored-headers - '("^Path:" "^Posting-Version:" "^Article-I.D.:" "^Expires:" - "^Date-Received:" "^References:" "^Control:" "^Xref:" "^Lines:" - "^Posted:" "^Relay-Version:" "^Message-ID:" "^Nf-ID:" "^Nf-From:" - "^Approved:" "^Sender:" "^Received:" "^Mail-from:") - "*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." - :type '(choice :custom-show nil - regexp - (repeat regexp)) - :group 'gnus-article-hiding) - -(defcustom gnus-visible-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|X-Sent:" - "*All headers that do not match this regexp will be hidden. -This variable can also be a list of regexp of headers to remain visible. -If this variable is non-nil, `gnus-ignored-headers' will be ignored." - :type '(repeat :value-to-internal (lambda (widget value) - (custom-split-regexp-maybe value)) - :match (lambda (widget value) - (or (stringp value) - (widget-editable-list-match widget value))) - regexp) - :group 'gnus-article-hiding) - -(defcustom gnus-sorted-header-list - '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" - "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:") - "*This variable is a list of regular expressions. -If it is non-nil, headers that match the regular expressions will -be placed first in the article buffer in the sequence specified by -this list." - :type '(repeat regexp) - :group 'gnus-article-hiding) - -(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'." - :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 "Date less than four days old." date) - (const :tag "Very long To header." long-to) - (const :tag "Multiple To headers." many-to)) - :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 -from head to tail looking for a separator. Searches will be done from -the end of the buffer." - :type '(repeat string) - :group 'gnus-article-signature) - -(defcustom gnus-signature-limit nil - "*Provide a limit to what is considered a signature. -If it is a number, no signature may not be longer (in characters) than -that number. If it is a floating point number, no signature may be -longer (in lines) than that number. If it is a function, the function -will be called without any parameters, and if it returns nil, there is -no signature in the buffer. If it is a string, it will be used as a -regexp. If it matches, the text in question is not a signature." - :type '(choice (integer :value 200) - (number :value 4.0) - (function :value fun) - (regexp :value ".*")) - :group 'gnus-article-signature) - -(defcustom gnus-hidden-properties '(invisible t intangible t) - "*Property list to use for hiding text." - :type 'sexp - :group 'gnus-article-hiding) - -(defcustom gnus-article-x-face-command - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -" - "*String or function to be executed to display an X-Face header. -If it is a string, the command will be executed in a sub-shell -asynchronously. The compressed face will be piped to this command." - :type 'string ;Leave function case to Lisp. - :group 'gnus-article-washing) - -(defcustom gnus-article-x-face-too-ugly nil - "*Regexp matching posters whose face shouldn't be shown automatically." - :type '(choice regexp (const nil)) - :group 'gnus-article-washing) - -(defcustom gnus-emphasis-alist - (let ((format - "\\(\\s-\\|^\\|[-\"]\\|\\s(\\|\\s)\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-?!.,;:\"]\\|\\s(\\|\\s)\\)") - (types - '(("_" "_" underline) - ("/" "/" italic) - ("\\*" "\\*" bold) - ("_/" "/_" underline-italic) - ("_\\*" "\\*_" underline-bold) - ("\\*/" "/\\*" bold-italic) - ("_\\*/" "/\\*_" underline-bold-italic)))) - `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" - 2 3 gnus-emphasis-underline) - ,@(mapcar - (lambda (spec) - (list - (format format (car spec) (cadr spec)) - 2 3 (intern (format "gnus-emphasis-%s" (caddr spec))))) - types))) - "*Alist that says how to fontify certain phrases. -Each item looks like this: - - (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline) - -The first element is a regular expression to be matched. The second -is a number that says what regular expression grouping used to find -the entire emphasized word. The third is a number that says what -regexp grouping should be displayed and highlighted. The fourth -is the face used for highlighting." - :type '(repeat (list :value ("" 0 0 default) - regexp - (integer :tag "Match group") - (integer :tag "Emphasize group") - face)) - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-bold '((t (:bold t))) - "Face used for displaying strong emphasized text (*word*)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-italic '((t (:italic t))) - "Face used for displaying italic emphasized text (/word/)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-underline '((t (:underline t))) - "Face used for displaying underlined emphasized text (_word_)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-underline-bold '((t (:bold t :underline t))) - "Face used for displaying underlined bold emphasized text (_*word*_)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-underline-italic '((t (:italic t :underline t))) - "Face used for displaying underlined italic emphasized text (_*word*_)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-bold-italic '((t (:bold t :italic t))) - "Face used for displaying bold italic emphasized text (/*word*/)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-underline-bold-italic - '((t (:bold t :italic t :underline t))) - "Face used for displaying underlined bold italic emphasized text. -Esample: (_/*word*/_)." - :group 'gnus-article-emphasis) - -(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z" - "*Format for display of Date headers in article bodies. -See `format-time-string' for the possible values. - -The variable can also be function, which should return a complete Date -header. The function is called with one argument, the time, which can -be fed to `format-time-string'." - :type '(choice string symbol) - :link '(custom-manual "(gnus)Article Date") - :group 'gnus-article-washing) - -(eval-and-compile - (autoload 'hexl-hex-string-to-integer "hexl") - (autoload 'timezone-make-date-arpa-standard "timezone") - (autoload 'mail-extract-address-components "mail-extr")) - -(defcustom gnus-save-all-headers t - "*If non-nil, don't remove any headers before saving." - :group 'gnus-article-saving - :type 'boolean) - -(defcustom gnus-prompt-before-saving 'always - "*This variable says how much prompting is to be done when saving articles. -If it is nil, no prompting will be done, and the articles will be -saved to the default files. If this variable is `always', each and -every article that is saved will be preceded by a prompt, even when -saving large batches of articles. If this variable is neither nil not -`always', there the user will be prompted once for a file name for -each invocation of the saving commands." - :group 'gnus-article-saving - :type '(choice (item always) - (item :tag "never" nil) - (sexp :tag "once" :format "%t\n" :value t))) - -(defcustom gnus-saved-headers gnus-visible-headers - "*Headers to keep if `gnus-save-all-headers' is nil. -If `gnus-save-all-headers' is non-nil, this variable will be ignored. -If that variable is nil, however, all headers that match this regexp -will be kept while the rest will be deleted before saving." - :group 'gnus-article-saving - :type 'regexp) - -(defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail - "*A function to save articles in your favourite format. -The function must be interactively callable (in other words, it must -be an Emacs command). - -Gnus provides the following functions: - -* gnus-summary-save-in-rmail (Rmail format) -* 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-in-vm (use VM's folder format) -* gnus-summary-write-to-file (article format -- overwrite)." - :group 'gnus-article-saving - :type '(radio (function-item gnus-summary-save-in-rmail) - (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-in-vm) - (function-item gnus-summary-write-to-file))) - -(defcustom gnus-rmail-save-name 'gnus-plain-save-name - "*A function generating a file name to save articles in Rmail format. -The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE." - :group 'gnus-article-saving - :type 'function) - -(defcustom gnus-mail-save-name 'gnus-plain-save-name - "*A function generating a file name to save articles in Unix mail format. -The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE." - :group 'gnus-article-saving - :type 'function) - -(defcustom gnus-folder-save-name 'gnus-folder-save-name - "*A function generating a file name to save articles in MH folder. -The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER." - :group 'gnus-article-saving - :type 'function) - -(defcustom gnus-file-save-name 'gnus-numeric-save-name - "*A function generating a file name to save articles in article format. -The function is called with NEWSGROUP, HEADERS, and optional -LAST-FILE." - :group 'gnus-article-saving - :type 'function) - -(defcustom gnus-split-methods - '((gnus-article-archive-name) - (gnus-article-nndoc-name)) - "*Variable used to suggest where articles are to be saved. -For instance, if you would like to save articles related to Gnus in -the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\", -you could set this variable to something like: - - '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") - (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\")) - -This variable is an alist where the where the key is the match and the -value is a list of possible files to save in if the match is non-nil. - -If the match is a string, it is used as a regexp match on the -article. If the match is a symbol, that symbol will be funcalled -from the buffer of the article to be saved with the newsgroup as the -parameter. If it is a list, it will be evaled in the same buffer. - -If this form or function returns a string, this string will be used as -a possible file name; and if it returns a non-nil list, that list will -be used as possible file names." - :group 'gnus-article-saving - :type '(repeat (choice (list :value (fun) function) - (cons :value ("" "") regexp (repeat string)) - (sexp :value nil)))) - -(defcustom gnus-strict-mime t - "*If nil, MIME-decode even if there is no Mime-Version header." - :group 'gnus-article-mime - :type 'boolean) - -(defcustom gnus-show-mime-method 'gnus-article-preview-mime-message - "*Function to process a MIME message. -The function is called from the article buffer." - :group 'gnus-article-mime - :type 'function) - -(defcustom gnus-decode-encoded-word-method 'gnus-article-decode-encoded-word - "*Function to decode MIME encoded words. -The function is called from the article buffer." - :group 'gnus-article-mime - :type 'function) - -(defcustom gnus-page-delimiter "^\^L" - "*Regexp describing what to use as article page delimiters. -The default value is \"^\^L\", which is a form linefeed at the -beginning of a line." - :type 'regexp - :group 'gnus-article-various) - -(defcustom gnus-article-mode-line-format "Gnus: %%b %S" - "*The format specification for the article mode line. -See `gnus-summary-mode-line-format' for a closer description." - :type 'string - :group 'gnus-article-various) - -(defcustom gnus-article-mode-hook nil - "*A hook for Gnus article mode." - :type 'hook - :group 'gnus-article-various) - -(defcustom gnus-article-menu-hook nil - "*Hook run after the creation of the article mode menu." - :type 'hook - :group 'gnus-article-various) - -(defcustom gnus-article-prepare-hook nil - "*A hook called after an article has been prepared in the article buffer. -If you want to run a special decoding program like nkf, use this hook." - :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) - -(defcustom gnus-article-button-face 'bold - "*Face used for highlighting buttons in the article buffer. - -An article button is a piece of text that you can activate by pressing -`RET' or `mouse-2' above it." - :type 'face - :group 'gnus-article-buttons) - -(defcustom gnus-article-mouse-face 'highlight - "*Face used for mouse highlighting in the article buffer. - -Article buttons will be displayed in this face when the cursor is -above them." - :type 'face - :group 'gnus-article-buttons) - -(defcustom gnus-signature-face 'gnus-signature-face - "*Face used for highlighting a signature in the article buffer. -Obsolete; use the face `gnus-signature-face' for customizations instead." - :type 'face - :group 'gnus-article-highlight - :group 'gnus-article-signature) - -(defface gnus-signature-face - '((((type x)) - (:italic t))) - "Face used for highlighting a signature in the article buffer." - :group 'gnus-article-highlight - :group 'gnus-article-signature) - -(defface gnus-header-from-face - '((((class color) - (background dark)) - (:foreground "spring green" :bold t)) - (((class color) - (background light)) - (:foreground "red3" :bold t)) - (t - (:bold t :italic t))) - "Face used for displaying from headers." - :group 'gnus-article-headers - :group 'gnus-article-highlight) - -(defface gnus-header-subject-face - '((((class color) - (background dark)) - (:foreground "SeaGreen3" :bold t)) - (((class color) - (background light)) - (:foreground "red4" :bold t)) - (t - (:bold t :italic t))) - "Face used for displaying subject headers." - :group 'gnus-article-headers - :group 'gnus-article-highlight) - -(defface gnus-header-newsgroups-face - '((((class color) - (background dark)) - (:foreground "yellow" :bold t :italic t)) - (((class color) - (background light)) - (:foreground "MidnightBlue" :bold t :italic t)) - (t - (:bold t :italic t))) - "Face used for displaying newsgroups headers." - :group 'gnus-article-headers - :group 'gnus-article-highlight) - -(defface gnus-header-name-face - '((((class color) - (background dark)) - (:foreground "SeaGreen")) - (((class color) - (background light)) - (:foreground "maroon")) - (t - (:bold t))) - "Face used for displaying header names." - :group 'gnus-article-headers - :group 'gnus-article-highlight) - -(defface gnus-header-content-face - '((((class color) - (background dark)) - (:foreground "forest green" :italic t)) - (((class color) - (background light)) - (:foreground "indianred4" :italic t)) - (t - (:italic t))) "Face used for displaying header content." - :group 'gnus-article-headers - :group 'gnus-article-highlight) - -(defcustom gnus-header-face-alist - '(("From" nil gnus-header-from-face) - ("Subject" nil gnus-header-subject-face) - ("Newsgroups:.*," nil gnus-header-newsgroups-face) - ("" gnus-header-name-face gnus-header-content-face)) - "*Controls highlighting of article header. - -An alist of the form (HEADER NAME CONTENT). - -HEADER is a regular expression which should match the name of an -header header and NAME and CONTENT are either face names or nil. - -The name of each header field will be displayed using the face -specified by the first element in the list where HEADER match the -header name and NAME is non-nil. Similarly, the content will be -displayed by the first non-nil matching CONTENT face." - :group 'gnus-article-headers - :group 'gnus-article-highlight - :type '(repeat (list (regexp :tag "Header") - (choice :tag "Name" - (item :tag "skip" nil) - (face :value default)) - (choice :tag "Content" - (item :tag "skip" nil) - (face :value default))))) - -;;; Internal variables - -(defvar article-lapsed-timer nil) -(defvar gnus-article-current-summary nil) - -(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) - table) - "Syntax table used in article mode buffers. -Initialized from `text-mode-syntax-table.") - -(defvar gnus-save-article-buffer nil) - -(defvar gnus-article-mode-line-format-alist - (nconc '((?w (gnus-article-wash-status) ?s)) - gnus-summary-mode-line-format-alist)) - -(defvar gnus-number-of-articles-to-be-saved nil) - -(defvar gnus-inhibit-hiding nil) - -(defsubst gnus-article-hide-text (b e props) - "Set text PROPS on the B to E region, extending `intangible' 1 past B." - (add-text-properties b e props) - (when (memq 'intangible props) - (put-text-property - (max (1- b) (point-min)) - b 'intangible (cddr (memq 'intangible props))))) - -(defsubst gnus-article-unhide-text (b e) - "Remove hidden text properties from region between B and E." - (remove-text-properties b e gnus-hidden-properties) - (when (memq 'intangible gnus-hidden-properties) - (put-text-property (max (1- b) (point-min)) - b 'intangible nil))) - -(defun gnus-article-hide-text-type (b e type) - "Hide text of TYPE between B and E." - (gnus-article-hide-text - b e (cons 'article-type (cons type gnus-hidden-properties)))) - -(defun gnus-article-unhide-text-type (b e type) - "Hide text of TYPE between B and E." - (remove-text-properties - b e (cons 'article-type (cons type gnus-hidden-properties))) - (when (memq 'intangible gnus-hidden-properties) - (put-text-property (max (1- b) (point-min)) - b 'intangible nil))) - -(defun gnus-article-hide-text-of-type (type) - "Hide text of TYPE in the current buffer." - (save-excursion - (let ((b (point-min)) - (e (point-max))) - (while (setq b (text-property-any b e 'article-type type)) - (add-text-properties b (incf b) gnus-hidden-properties))))) - -(defun gnus-article-delete-text-of-type (type) - "Delete text of TYPE in the current buffer." - (save-excursion - (let ((b (point-min))) - (while (setq b (text-property-any b (point-max) 'article-type type)) - (delete-region - b (or (text-property-not-all b (point-max) 'article-type type) - (point-max))))))) - -(defun gnus-article-delete-invisible-text () - "Delete all invisible text in the current buffer." - (save-excursion - (let ((b (point-min))) - (while (setq b (text-property-any b (point-max) 'invisible t)) - (delete-region - b (or (text-property-not-all b (point-max) 'invisible t) - (point-max))))))) - -(defun gnus-article-text-type-exists-p (type) - "Say whether any text of type TYPE exists in the buffer." - (text-property-any (point-min) (point-max) 'article-type type)) - -(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)) - (while list - (when (looking-at (car list)) - (setq list nil)) - (setq list (cdr list)) - (incf i)) - i)) - -(defun article-hide-headers (&optional arg delete) - "Toggle whether to hide unwanted headers and possibly sort them as well. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-article-hidden-arg)) - (current-buffer) - (if (gnus-article-check-hidden-text 'headers arg) - ;; Show boring headers as well. - (gnus-article-show-hidden-text 'boring-headers) - ;; This function might be inhibited. - (unless gnus-inhibit-hiding - (save-excursion - (save-restriction - (let ((buffer-read-only nil) - (props (nconc (list 'article-type 'headers) - gnus-hidden-properties)) - (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) - want-list beg) - ;; First we narrow to just the headers. - (widen) - (goto-char (point-min)) - ;; 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) props))) - ;; Then treat the rest of the header lines. - (narrow-to-region - (point) - (if (search-forward "\n\n" nil t) ; if there's a body - (progn (forward-line -1) (point)) - (point-max))) - ;; 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. - (goto-char (point-min)) - (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 make the unwanted headers invisible. - (if delete - (delete-region beg (point-max)) - ;; Suggested by Sudish Joseph . - (gnus-article-hide-text-type beg (point-max) 'headers)) - ;; Work around XEmacs lossage. - (put-text-property (point-min) beg 'invisible nil)))))))) - -(defun article-hide-boring-headers (&optional arg) - "Toggle hiding of headers that aren't very interesting. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-article-hidden-arg)) - (when (and (not (gnus-article-check-hidden-text 'boring-headers arg)) - (not gnus-show-all-headers)) - (save-excursion - (save-restriction - (let ((buffer-read-only nil) - (list gnus-boring-article-headers) - (inhibit-point-motion-hooks t) - elem) - (nnheader-narrow-to-headers) - (while list - (setq elem (pop list)) - (goto-char (point-min)) - (cond - ;; Hide empty headers. - ((eq elem 'empty) - (while (re-search-forward "^[^:]+:[ \t]*\n[^ \t]" nil t) - (forward-line -1) - (gnus-article-hide-text-type - (progn (beginning-of-line) (point)) - (progn - (end-of-line) - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (point-max))) - '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 - ""))) - (gnus-article-hide-header "newsgroups"))) - ((eq elem 'followup-to) - (when (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 (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 - (< (gnus-days-between (current-time-string) date) - 4)) - (gnus-article-hide-header "date")))) - ((eq elem 'long-to) - (let ((to (message-fetch-field "to"))) - (when (> (length to) 1024) - (gnus-article-hide-header "to")))) - ((eq elem 'many-to) - (let ((to-count 0)) - (goto-char (point-min)) - (while (re-search-forward "^to:" nil t) - (setq to-count (1+ to-count))) - (when (> to-count 1) - (while (> to-count 0) - (goto-char (point-min)) - (save-restriction - (re-search-forward "^to:" nil nil to-count) - (forward-line -1) - (narrow-to-region (point) (point-max)) - (gnus-article-hide-header "to")) - (setq to-count (1- to-count))))))))))))) - -(defun gnus-article-hide-header (header) - (save-excursion - (goto-char (point-min)) - (when (re-search-forward (concat "^" header ":") nil t) - (gnus-article-hide-text-type - (progn (beginning-of-line) (point)) - (progn - (end-of-line) - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (point-max))) - 'boring-headers)))) - -(defun article-treat-dumbquotes () - "Translate M******** sm*rtq**t*s into proper text." - (interactive) - (article-translate-characters "\221\222\223\223" "`'\"\"")) - -(defun article-translate-characters (from to) - "Translate all characters in the body of the article according to FROM and TO. -FROM is a string of characters to translate from; to is a string of -characters to translate to." - (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (let ((buffer-read-only nil) - (x (make-string 225 ?x)) - (i -1)) - (while (< (incf i) (length x)) - (aset x i i)) - (setq i 0) - (while (< i (length from)) - (aset x (aref from i) (aref to i)) - (incf i)) - (translate-region (point) (point-max) x))))) - -(defun article-treat-overstrike () - "Translate overstrikes into bold text." - (interactive) - (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (let ((buffer-read-only nil)) - (while (search-forward "\b" nil t) - (let ((next (following-char)) - (previous (char-after (- (point) 2)))) - ;; We do the boldification/underlining by hiding the - ;; overstrikes and putting the proper text property - ;; on the letters. - (cond - ((eq next previous) - (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike) - (put-text-property (point) (1+ (point)) 'face 'bold)) - ((eq next ?_) - (gnus-article-hide-text-type - (1- (point)) (1+ (point)) 'overstrike) - (put-text-property - (- (point) 2) (1- (point)) 'face 'underline)) - ((eq previous ?_) - (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike) - (put-text-property - (point) (1+ (point)) 'face 'underline))))))))) - -(defun article-fill () - "Format too long lines." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (widen) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (end-of-line 1) - (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$") - (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?") - (adaptive-fill-mode t)) - (while (not (eobp)) - (and (>= (current-column) (min fill-column (window-width))) - (/= (preceding-char) ?:) - (fill-paragraph nil)) - (end-of-line 2)))))) - -(defun article-remove-cr () - "Remove carriage returns from an article." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (replace-match "" t t))))) - -(defun article-remove-trailing-blank-lines () - "Remove all trailing blank lines from the article." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (goto-char (point-max)) - (delete-region - (point) - (progn - (while (and (not (bobp)) - (looking-at "^[ \t]*$")) - (forward-line -1)) - (forward-line 1) - (point)))))) - -(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) - (save-restriction - (nnheader-narrow-to-headers) - (setq from (message-fetch-field "from")) - (goto-char (point-min)) - (while (and 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)))) - ;; Has to be present. - (re-search-forward "^X-Face: " nil t)) - ;; We now have the area of the buffer where the X-Face is stored. - (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")))))))))) - -(defun gnus-article-decode-rfc1522 () - "Decode MIME encoded-words in header fields." - (let (buffer-read-only) - (eword-decode-header) - )) - -(defun article-hide-pgp (&optional arg) - "Toggle hiding of any PGP headers and signatures in the current article. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-article-hidden-arg)) - (unless (gnus-article-check-hidden-text 'pgp arg) - (save-excursion - (let ((inhibit-point-motion-hooks t) - buffer-read-only beg end) - (widen) - (goto-char (point-min)) - ;; Hide the "header". - (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) - (gnus-article-hide-text-type (1+ (match-beginning 0)) - (match-end 0) 'pgp) - (setq beg (point)) - ;; Hide the actual signature. - (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) - (setq end (1+ (match-beginning 0))) - (gnus-article-hide-text-type - end - (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) - (match-end 0) - ;; Perhaps we shouldn't hide to the end of the buffer - ;; if there is no end to the signature? - (point-max)) - 'pgp)) - ;; Hide "- " PGP quotation markers. - (when (and beg end) - (narrow-to-region beg end) - (goto-char (point-min)) - (while (re-search-forward "^- " nil t) - (gnus-article-hide-text-type - (match-beginning 0) (match-end 0) 'pgp)) - (widen)) - (gnus-run-hooks 'gnus-article-hide-pgp-hook)))))) - -(defun article-hide-pem (&optional arg) - "Toggle hiding of any PEM headers and signatures in the current article. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-article-hidden-arg)) - (unless (gnus-article-check-hidden-text 'pem arg) - (save-excursion - (let (buffer-read-only end) - (widen) - (goto-char (point-min)) - ;; hide the horrendously ugly "header". - (and (search-forward "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" - nil - t) - (setq end (1+ (match-beginning 0))) - (gnus-article-hide-text-type - end - (if (search-forward "\n\n" nil t) - (match-end 0) - (point-max)) - 'pem)) - ;; hide the trailer as well - (and (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n" - nil - t) - (gnus-article-hide-text-type - (match-beginning 0) (match-end 0) 'pem)))))) - -(defun article-hide-signature (&optional arg) - "Hide the signature in the current article. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-article-hidden-arg)) - (unless (gnus-article-check-hidden-text 'signature arg) - (save-excursion - (save-restriction - (let ((buffer-read-only nil)) - (when (gnus-article-narrow-to-signature) - (gnus-article-hide-text-type - (point-min) (point-max) 'signature))))))) - -(defun article-strip-leading-blank-lines () - "Remove all blank lines from the beginning of the article." - (interactive) - (save-excursion - (let ((inhibit-point-motion-hooks t) - buffer-read-only) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (while (and (not (eobp)) - (looking-at "[ \t]*$")) - (gnus-delete-line)))))) - -(defun article-strip-multiple-blank-lines () - "Replace consecutive blank lines with one empty line." - (interactive) - (save-excursion - (let ((inhibit-point-motion-hooks t) - buffer-read-only) - ;; First make all blank lines empty. - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (while (re-search-forward "^[ \t]+$" nil t) - (replace-match "" nil t)) - ;; Then replace multiple empty lines with a single empty line. - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (while (re-search-forward "\n\n\n+" nil t) - (replace-match "\n\n" t t))))) - -(defun article-strip-leading-space () - "Remove all white space from the beginning of the lines in the article." - (interactive) - (save-excursion - (let ((inhibit-point-motion-hooks t) - buffer-read-only) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (while (re-search-forward "^[ \t]+" nil t) - (replace-match "" t t))))) - -(defun article-strip-blank-lines () - "Strip leading, trailing and multiple blank lines." - (interactive) - (article-strip-leading-blank-lines) - (article-remove-trailing-blank-lines) - (article-strip-multiple-blank-lines)) - -(defun article-strip-all-blank-lines () - "Strip all blank lines." - (interactive) - (save-excursion - (let ((inhibit-point-motion-hooks t) - buffer-read-only) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (while (re-search-forward "^[ \t]*\n" nil t) - (replace-match "" t t))))) - -(defvar mime::preview/content-list) -(defvar mime::preview-content-info/point-min) -(defun gnus-article-narrow-to-signature () - "Narrow to the signature; return t if a signature is found, else nil." - (widen) - (when (and (boundp 'mime::preview/content-list) - mime::preview/content-list) - ;; We have a MIMEish article, so we use the MIME data to narrow. - (let ((pcinfo (car (last mime::preview/content-list)))) - (ignore-errors - (narrow-to-region - (funcall (intern "mime::preview-content-info/point-min") pcinfo) - (point-max))))) - - (when (gnus-article-search-signature) - (forward-line 1) - ;; Check whether we have some limits to what we consider - ;; to be a signature. - (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit - (list gnus-signature-limit))) - limit limited) - (while (setq limit (pop limits)) - (if (or (and (integerp limit) - (< (- (point-max) (point)) limit)) - (and (floatp limit) - (< (count-lines (point) (point-max)) limit)) - (and (gnus-functionp limit) - (funcall limit)) - (and (stringp limit) - (not (re-search-forward limit nil t)))) - () ; This limit did not succeed. - (setq limited t - limits nil))) - (unless limited - (narrow-to-region (point) (point-max)) - t)))) - -(defun gnus-article-search-signature () - "Search the current buffer for the signature separator. -Put point at the beginning of the signature separator." - (let ((cur (point))) - (goto-char (point-max)) - (if (if (stringp gnus-signature-separator) - (re-search-backward gnus-signature-separator nil t) - (let ((seps gnus-signature-separator)) - (while (and seps - (not (re-search-backward (car seps) nil t))) - (pop seps)) - seps)) - t - (goto-char cur) - nil))) - -(eval-and-compile - (autoload 'w3-display "w3-parse") - (autoload 'w3-do-setup "w3" "" t) - (autoload 'w3-region "w3-display" "" t)) - -(defun gnus-article-treat-html () - "Render HTML." - (interactive) - (let ((cbuf (current-buffer))) - (set-buffer gnus-article-buffer) - (let (buf buffer-read-only b e) - (w3-do-setup) - (goto-char (point-min)) - (narrow-to-region - (if (search-forward "\n\n" nil t) - (setq b (point)) - (point-max)) - (setq e (point-max))) - (nnheader-temp-write nil - (insert-buffer-substring gnus-article-buffer b e) - (require 'url) - (save-window-excursion - (w3-region (point-min) (point-max)) - (setq buf (buffer-substring-no-properties (point-min) (point-max))))) - (when buf - (delete-region (point-min) (point-max)) - (insert buf)) - (widen) - (goto-char (point-min)) - (set-window-start (get-buffer-window (current-buffer)) (point-min)) - (set-buffer cbuf)))) - -(defun gnus-article-hidden-arg () - "Return the current prefix arg as a number, or 0 if no prefix." - (list (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - 0))) - -(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 -means show, 0 means toggle." - (save-excursion - (save-restriction - (widen) - (let ((hide (gnus-article-hidden-text-p type))) - (cond - ((or (null arg) - (> arg 0)) - nil) - ((< arg 0) - (gnus-article-show-hidden-text type)) - (t - (if (eq hide 'hidden) - (gnus-article-show-hidden-text type) - nil))))))) - -(defun gnus-article-hidden-text-p (type) - "Say whether the current buffer contains hidden text of type TYPE." - (let ((start (point-min)) - (pos (text-property-any (point-min) (point-max) 'article-type type))) - (while (and pos - (not (get-text-property pos 'invisible))) - (setq pos - (text-property-any (1+ pos) (point-max) 'article-type type))) - (if pos - 'hidden - 'shown))) - -(defun gnus-article-show-hidden-text (type &optional hide) - "Show all hidden text of type TYPE. -If HIDE, hide the text instead." - (save-excursion - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (end (point-min)) - beg) - (while (setq beg (text-property-any end (point-max) 'article-type type)) - (goto-char beg) - (setq end (or - (text-property-not-all beg (point-max) 'article-type type) - (point-max))) - (if hide - (gnus-article-hide-text beg end gnus-hidden-properties) - (gnus-article-unhide-text beg end)) - (goto-char end)) - t))) - -(defconst article-time-units - `((year . ,(* 365.25 24 60 60)) - (week . ,(* 7 24 60 60)) - (day . ,(* 24 60 60)) - (hour . ,(* 60 60)) - (minute . 60) - (second . 1)) - "Mapping from time units to seconds.") - -(defun article-date-ut (&optional type highlight header) - "Convert DATE date to universal time in the current article. -If TYPE is `local', convert to local time; if it is `lapsed', output -how much time has lapsed since DATE." - (interactive (list 'ut t)) - (let* ((header (or header - (mail-header-date gnus-current-headers) - (message-fetch-field "date") - "")) - (date (if (vectorp header) (mail-header-date header) - header)) - (date-regexp "^Date:[ \t]\\|^X-Sent:[ \t]") - (inhibit-point-motion-hooks t) - bface eface newline) - (when (and date (not (string= date ""))) - (save-excursion - (save-restriction - (nnheader-narrow-to-headers) - (let ((buffer-read-only nil)) - ;; Delete any old Date headers. - (if (re-search-forward date-regexp nil t) - (progn - (setq bface (get-text-property (gnus-point-at-bol) 'face) - eface (get-text-property (1- (gnus-point-at-eol)) - 'face)) - (delete-region (progn (beginning-of-line) (point)) - (progn (end-of-line) (point))) - (beginning-of-line)) - (goto-char (point-max)) - (setq newline t)) - (insert (article-make-date-line date type)) - ;; Do highlighting. - (beginning-of-line) - (when (looking-at "\\([^:]+\\): *\\(.*\\)$") - (put-text-property (match-beginning 1) (1+ (match-end 1)) - 'face bface) - (put-text-property (match-beginning 2) (match-end 2) - 'face eface)) - (when newline - (end-of-line) - (insert "\n")))))))) - -(defun article-make-date-line (date type) - "Return a DATE line of TYPE." - (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) - (concat "Date: " (condition-case () - (timezone-make-date-arpa-standard date) - (error date)))) - ;; Convert to Universal Time. - ((eq type 'ut) - (concat "Date: " - (condition-case () - (timezone-make-date-arpa-standard date nil "UT") - (error date)))) - ;; Get the original date from the article. - ((eq type 'original) - (concat "Date: " date)) - ;; Let the user define the format. - ((eq type 'user) - (if (gnus-functionp gnus-article-time-format) - (funcall - gnus-article-time-format - (ignore-errors - (gnus-encode-date - (timezone-make-date-arpa-standard - date nil "UT")))) - (concat - "Date: " - (format-time-string gnus-article-time-format - (ignore-errors - (gnus-encode-date - (timezone-make-date-arpa-standard - date nil "UT"))))))) - ;; ISO 8601. - ((eq type 'iso8601) - (concat - "Date: " - (format-time-string "%Y%M%DT%h%m%s" - (ignore-errors - (gnus-encode-date - (timezone-make-date-arpa-standard - date nil "UT")))))) - ;; 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 - (ignore-errors - (gnus-time-minus - (gnus-encode-date - (timezone-make-date-arpa-standard - (current-time-string now) - (current-time-zone now) "UT")) - (gnus-encode-date - (timezone-make-date-arpa-standard - date nil "UT"))))) - (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")))))) - (t - (error "Unknown conversion type: %s" type)))) - -(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-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 -function and want to see what the date was before converting." - (interactive (list t)) - (article-date-ut 'original highlight)) - -(defun article-date-lapsed (&optional highlight) - "Convert the current article date to time lapsed since it was sent." - (interactive (list t)) - (article-date-ut 'lapsed highlight)) - -(defun article-update-date-lapsed () - "Function to be run from a timer to update the lapsed time line." - (save-excursion - (ignore-errors - (when (gnus-buffer-live-p gnus-article-buffer) - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (when (re-search-forward "^X-Sent:" nil t) - (article-date-lapsed t)))))) - -(defun gnus-start-date-timer (&optional n) - "Start a timer to update the X-Sent header in the article buffers. -The numerical prefix says how frequently (in seconds) the function -is to run." - (interactive "p") - (unless n - (setq n 1)) - (gnus-stop-date-timer) - (setq article-lapsed-timer - (nnheader-run-at-time 1 n 'article-update-date-lapsed))) - -(defun gnus-stop-date-timer () - "Stop the X-Sent timer." - (interactive) - (when article-lapsed-timer - (nnheader-cancel-timer article-lapsed-timer) - (setq article-lapsed-timer nil))) - -(defun article-date-user (&optional highlight) - "Convert the current article date to the user-defined format. -This format is defined by the `gnus-article-time-format' variable." - (interactive (list t)) - (article-date-ut 'user highlight)) - -(defun article-date-iso8601 (&optional highlight) - "Convert the current article date to ISO8601." - (interactive (list t)) - (article-date-ut 'iso8601 highlight)) - -(defun article-show-all () - "Show all hidden text in the article buffer." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (gnus-article-unhide-text (point-min) (point-max))))) - -(defun article-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 gnus-emphasis-alist) - (buffer-read-only nil) - (props (append '(article-type emphasis) - gnus-hidden-properties)) - regexp elem beg invisible visible face) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (setq beg (point)) - (while (setq elem (pop alist)) - (goto-char beg) - (setq regexp (car elem) - invisible (nth 1 elem) - visible (nth 2 elem) - face (nth 3 elem)) - (while (re-search-forward regexp nil t) - (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-text-property-excluding-newlines - (match-beginning visible) (match-end visible) 'face face) - (goto-char (match-end invisible))))))))) - -(defvar gnus-summary-article-menu) -(defvar gnus-summary-post-menu) - -;;; Saving functions. - -(defun gnus-article-save (save-buffer file &optional num) - "Save the currently selected article." - (unless gnus-save-all-headers - ;; Remove headers according to `gnus-saved-headers'. - (let ((gnus-visible-headers - (or gnus-saved-headers gnus-visible-headers)) - (gnus-article-buffer save-buffer)) - (save-excursion - (set-buffer save-buffer) - (article-hide-headers 1 t)))) - (save-window-excursion - (if (not gnus-default-article-saver) - (error "No default saver is defined") - ;; !!! Magic! The saving functions all save - ;; `gnus-original-article-buffer' (or so they think), but we - ;; bind that variable to our save-buffer. - (set-buffer gnus-article-buffer) - (let* ((gnus-save-article-buffer save-buffer) - (filename - (cond - ((not gnus-prompt-before-saving) 'default) - ((eq gnus-prompt-before-saving 'always) nil) - (t file))) - (gnus-number-of-articles-to-be-saved - (when (eq gnus-prompt-before-saving t) - num))) ; Magic - (set-buffer gnus-article-current-summary) - (funcall gnus-default-article-saver filename))))) - -(defun gnus-read-save-file-name (prompt &optional filename - function group headers variable) - (let ((default-name - (funcall function group headers (symbol-value variable))) - result) - (setq - result - (cond - ((eq filename 'default) - default-name) - ((eq filename t) - default-name) - (filename filename) - (t - (let* ((split-name (gnus-get-split-value gnus-split-methods)) - (prompt - (format prompt - (if (and gnus-number-of-articles-to-be-saved - (> gnus-number-of-articles-to-be-saved 1)) - (format "these %d articles" - gnus-number-of-articles-to-be-saved) - "this article"))) - (file - ;; Let the split methods have their say. - (cond - ;; No split name was found. - ((null split-name) - (read-file-name - (concat prompt " (default " - (file-name-nondirectory default-name) ") ") - (file-name-directory default-name) - default-name)) - ;; A single group name is returned. - ((stringp split-name) - (setq default-name - (funcall function split-name headers - (symbol-value variable))) - (read-file-name - (concat prompt " (default " - (file-name-nondirectory default-name) ") ") - (file-name-directory default-name) - default-name)) - ;; A single split name was found - ((= 1 (length split-name)) - (let* ((name (expand-file-name - (car split-name) gnus-article-save-directory)) - (dir (cond ((file-directory-p name) - (file-name-as-directory name)) - ((file-exists-p name) name) - (t gnus-article-save-directory)))) - (read-file-name - (concat prompt " (default " name ") ") - dir name))) - ;; A list of splits was found. - (t - (setq split-name (nreverse split-name)) - (let (result) - (let ((file-name-history - (nconc split-name file-name-history))) - (setq result - (expand-file-name - (read-file-name - (concat prompt " (`M-p' for defaults) ") - gnus-article-save-directory - (car split-name)) - gnus-article-save-directory))) - (car (push result file-name-history))))))) - ;; Create the directory. - (gnus-make-directory (file-name-directory file)) - ;; If we have read a directory, we append the default file name. - (when (file-directory-p file) - (setq file (concat (file-name-as-directory file) - (file-name-nondirectory default-name)))) - ;; Possibly translate some characters. - (nnheader-translate-file-chars file))))) - (gnus-make-directory (file-name-directory result)) - (set variable result))) - -(defun gnus-article-archive-name (group) - "Return the first instance of an \"Archive-name\" in the current buffer." - (let ((case-fold-search t)) - (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t) - (nnheader-concat gnus-article-save-directory - (match-string 1))))) - -(defun gnus-article-nndoc-name (group) - "If GROUP is an nndoc group, return the name of the parent group." - (when (eq (car (gnus-find-method-for-group group)) 'nndoc) - (gnus-group-get-parameter group 'save-article-group))) - -(defun gnus-summary-save-in-rmail (&optional filename) - "Append this article to Rmail file. -Optional argument FILENAME specifies file name. -Directory to save to is default to `gnus-article-save-directory'." - (interactive) - (setq filename (gnus-read-save-file-name - "Save %s in rmail file:" filename - gnus-rmail-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-rmail)) - (gnus-eval-in-buffer-window gnus-save-article-buffer - (save-excursion - (save-restriction - (widen) - (gnus-output-to-rmail filename)))) - filename) - -(defun gnus-summary-save-in-mail (&optional filename) - "Append this article to Unix mail file. -Optional argument FILENAME specifies file name. -Directory to save to is default to `gnus-article-save-directory'." - (interactive) - (setq filename (gnus-read-save-file-name - "Save %s in Unix mail file:" filename - gnus-mail-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-mail)) - (gnus-eval-in-buffer-window gnus-save-article-buffer - (save-excursion - (save-restriction - (widen) - (if (and (file-readable-p filename) - (mail-file-babyl-p filename)) - (gnus-output-to-rmail filename t) - (gnus-output-to-mail filename))))) - filename) - -(defun gnus-summary-save-in-file (&optional filename overwrite) - "Append this article to file. -Optional argument FILENAME specifies file name. -Directory to save to is default to `gnus-article-save-directory'." - (interactive) - (setq filename (gnus-read-save-file-name - "Save %s in file:" filename - gnus-file-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-file)) - (gnus-eval-in-buffer-window gnus-save-article-buffer - (save-excursion - (save-restriction - (widen) - (when (and overwrite - (file-exists-p filename)) - (delete-file filename)) - (gnus-output-to-file filename)))) - filename) - -(defun gnus-summary-write-to-file (&optional filename) - "Write this article to a file. -Optional argument FILENAME specifies file name. -The directory to save in defaults to `gnus-article-save-directory'." - (interactive) - (gnus-summary-save-in-file nil t)) - -(defun gnus-summary-save-body-in-file (&optional filename) - "Append this article body to a file. -Optional argument FILENAME specifies file name. -The directory to save in defaults to `gnus-article-save-directory'." - (interactive) - (setq filename (gnus-read-save-file-name - "Save %s body in file:" filename - gnus-file-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-file)) - (gnus-eval-in-buffer-window gnus-save-article-buffer - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (narrow-to-region (point) (point-max))) - (gnus-output-to-file filename)))) - filename) - -(defun gnus-summary-save-in-pipe (&optional command) - "Pipe this article to subprocess." - (interactive) - (setq command - (cond ((eq command 'default) - gnus-last-shell-command) - (command command) - (t (read-string - (format - "Shell command on %s: " - (if (and gnus-number-of-articles-to-be-saved - (> gnus-number-of-articles-to-be-saved 1)) - (format "these %d articles" - gnus-number-of-articles-to-be-saved) - "this article")) - gnus-last-shell-command)))) - (when (string-equal command "") - (setq command gnus-last-shell-command)) - (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)) - -;;; Article file names when saving. - -(defun gnus-capitalize-newsgroup (newsgroup) - "Capitalize NEWSGROUP name." - (when (not (zerop (length newsgroup))) - (concat (char-to-string (upcase (aref newsgroup 0))) - (substring newsgroup 1)))) - -(defun gnus-Numeric-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is non-nil, it is ~/News/News.group/num. -Otherwise, it is like ~/News/news/group/num." - (let ((default - (expand-file-name - (concat (if (gnus-use-long-file-name 'not-save) - (gnus-capitalize-newsgroup newsgroup) - (gnus-newsgroup-directory-form newsgroup)) - "/" (int-to-string (mail-header-number headers))) - gnus-article-save-directory))) - (if (and last-file - (string-equal (file-name-directory default) - (file-name-directory last-file)) - (string-match "^[0-9]+$" (file-name-nondirectory last-file))) - default - (or last-file default)))) - -(defun gnus-numeric-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is non-nil, it is -~/News/news.group/num. Otherwise, it is like ~/News/news/group/num." - (let ((default - (expand-file-name - (concat (if (gnus-use-long-file-name 'not-save) - newsgroup - (gnus-newsgroup-directory-form newsgroup)) - "/" (int-to-string (mail-header-number headers))) - gnus-article-save-directory))) - (if (and last-file - (string-equal (file-name-directory default) - (file-name-directory last-file)) - (string-match "^[0-9]+$" (file-name-nondirectory last-file))) - default - (or last-file default)))) - -(defun gnus-Plain-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is non-nil, it is -~/News/News.group. Otherwise, it is like ~/News/news/group/news." - (or last-file - (expand-file-name - (if (gnus-use-long-file-name 'not-save) - (gnus-capitalize-newsgroup newsgroup) - (concat (gnus-newsgroup-directory-form newsgroup) "/news")) - gnus-article-save-directory))) - -(defun gnus-plain-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is non-nil, it is -~/News/news.group. Otherwise, it is like ~/News/news/group/news." - (or last-file - (expand-file-name - (if (gnus-use-long-file-name 'not-save) - newsgroup - (concat (gnus-newsgroup-directory-form newsgroup) "/news")) - gnus-article-save-directory))) - -(eval-and-compile - (mapcar - (lambda (func) - (let (afunc gfunc) - (if (consp func) - (setq afunc (car func) - gfunc (cdr func)) - (setq afunc func - gfunc (intern (format "gnus-%s" func)))) - (fset gfunc - (if (not (fboundp afunc)) - nil - `(lambda (&optional interactive &rest args) - ,(documentation afunc t) - (interactive (list t)) - (save-excursion - (set-buffer gnus-article-buffer) - (if interactive - (call-interactively ',afunc) - (apply ',afunc args)))))))) - '(article-hide-headers - article-hide-boring-headers - article-treat-overstrike - (article-fill . gnus-article-word-wrap) - article-remove-cr - article-display-x-face - article-de-quoted-unreadable - article-mime-decode-quoted-printable - article-hide-pgp - article-hide-pem - article-hide-signature - article-remove-trailing-blank-lines - article-strip-leading-blank-lines - article-strip-multiple-blank-lines - article-strip-leading-space - article-strip-blank-lines - article-strip-all-blank-lines - article-date-local - article-date-iso8601 - article-date-original - article-date-ut - article-date-user - article-date-lapsed - article-emphasize - article-treat-dumbquotes - (article-show-all . gnus-article-show-all-headers)))) - -;;; -;;; Gnus article mode -;;; - -(put 'gnus-article-mode 'mode-class 'special) - -(gnus-define-keys gnus-article-mode-map - " " gnus-article-goto-next-page - "\177" gnus-article-goto-prev-page - [delete] gnus-article-goto-prev-page - "\C-c^" gnus-article-refer-article - "h" gnus-article-show-summary - "s" gnus-article-show-summary - "\C-c\C-m" gnus-article-mail - "?" gnus-article-describe-briefly - gnus-mouse-2 gnus-article-push-button - "\r" gnus-article-press-button - "\t" gnus-article-next-button - "\M-\t" gnus-article-prev-button - "e" gnus-article-edit - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug - - "\C-d" gnus-article-read-summary-keys - "\M-*" gnus-article-read-summary-keys - "\M-#" gnus-article-read-summary-keys - "\M-^" gnus-article-read-summary-keys - "\M-g" gnus-article-read-summary-keys) - -(substitute-key-definition - 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) - -(defun gnus-article-make-menu-bar () - (gnus-turn-off-edit-menu 'article) - (unless (boundp 'gnus-article-article-menu) - (easy-menu-define - gnus-article-article-menu gnus-article-mode-map "" - '("Article" - ["Scroll forwards" gnus-article-goto-next-page t] - ["Scroll backwards" gnus-article-goto-prev-page t] - ["Show summary" gnus-article-show-summary t] - ["Fetch Message-ID at point" gnus-article-refer-article t] - ["Mail to address at point" gnus-article-mail t])) - - (easy-menu-define - gnus-article-treatment-menu gnus-article-mode-map "" - '("Treatment" - ["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 quoted-unreadable" gnus-article-de-quoted-unreadable t])) - - (when nil - (when (boundp 'gnus-summary-article-menu) - (define-key gnus-article-mode-map [menu-bar commands] - (cons "Commands" gnus-summary-article-menu)))) - - (when (boundp 'gnus-summary-post-menu) - (define-key gnus-article-mode-map [menu-bar post] - (cons "Post" gnus-summary-post-menu))) - - (gnus-run-hooks 'gnus-article-menu-hook))) - -(defun gnus-article-mode () - "Major mode for displaying an article. - -All normal editing commands are switched off. - -The following commands are available in addition to all summary mode -commands: -\\ -\\[gnus-article-next-page]\t Scroll the article one page forwards -\\[gnus-article-prev-page]\t Scroll the article one page backwards -\\[gnus-article-refer-article]\t Go to the article referred to by an article id near point -\\[gnus-article-show-summary]\t Display the summary buffer -\\[gnus-article-mail]\t Send a reply to the address near point -\\[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)) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq mode-name "Article") - (setq major-mode 'gnus-article-mode) - (make-local-variable 'minor-mode-alist) - (unless (assq 'gnus-show-mime minor-mode-alist) - (push (list 'gnus-show-mime " MIME") minor-mode-alist)) - (use-local-map gnus-article-mode-map) - (gnus-update-format-specifications nil 'article-mode) - (set (make-local-variable 'page-delimiter) gnus-page-delimiter) - (set (make-local-variable 'gnus-page-broken) nil) - (set (make-local-variable 'gnus-button-marker-list) nil) - (set (make-local-variable 'gnus-article-current-summary) nil) - (gnus-set-default-directory) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) - (set-syntax-table gnus-article-mode-syntax-table) - (gnus-run-hooks 'gnus-article-mode-hook)) - -(defun gnus-article-setup-buffer () - "Initialize the article buffer." - (let* ((name (if gnus-single-article-buffer "*Article*" - (concat "*Article " gnus-newsgroup-name "*"))) - (original - (progn (string-match "\\*Article" name) - (concat " *Original Article" - (substring name (match-end 0)))))) - (setq gnus-article-buffer name) - (setq gnus-original-article-buffer original) - ;; This might be a variable local to the summary buffer. - (unless gnus-single-article-buffer - (save-excursion - (set-buffer gnus-summary-buffer) - (setq gnus-article-buffer name) - (setq gnus-original-article-buffer original) - (gnus-set-global-variables))) - ;; Init original article buffer. - (save-excursion - (set-buffer (get-buffer-create gnus-original-article-buffer)) - (buffer-disable-undo (current-buffer)) - (setq major-mode 'gnus-original-article-mode) - (gnus-add-current-to-buffer-list) - (make-local-variable 'gnus-original-article)) - (if (get-buffer name) - (save-excursion - (set-buffer name) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) - (gnus-add-current-to-buffer-list) - (unless (eq major-mode 'gnus-article-mode) - (gnus-article-mode)) - (current-buffer)) - (save-excursion - (set-buffer (get-buffer-create name)) - (gnus-add-current-to-buffer-list) - (gnus-article-mode) - (make-local-variable 'gnus-summary-buffer) - (current-buffer))))) - -;; Set article window start at LINE, where LINE is the number of lines -;; from the head of the article. -(defun gnus-article-set-window-start (&optional line) - (set-window-start - (get-buffer-window gnus-article-buffer t) - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (if (not line) - (point-min) - (gnus-message 6 "Moved to bookmark") - (search-forward "\n\n" nil t) - (forward-line line) - (point))))) - -;;; @@ article filters -;;; -(defun gnus-article-preview-mime-message () - (make-local-variable 'mime-button-mother-dispatcher) - (setq mime-button-mother-dispatcher - (function gnus-article-push-button)) - (let ((default-mime-charset - (save-excursion - (set-buffer gnus-summary-buffer) - default-mime-charset)) - ) - (save-excursion - (mime-view-mode nil nil nil gnus-original-article-buffer - gnus-article-buffer - gnus-article-mode-map) - )) - (run-hooks 'gnus-mime-article-prepare-hook) - ) - -(defun gnus-article-decode-encoded-word () - "Header filter for gnus-article-mode. -It is registered to variable `mime-view-content-header-filter-alist'." - (goto-char (point-min)) - (let ((charset (save-excursion - (set-buffer gnus-summary-buffer) - default-mime-charset))) - (save-restriction - (std11-narrow-to-header) - (goto-char (point-min)) - (while (re-search-forward "^[^ \t:]+:" nil t) - (let ((start (match-beginning 0)) - (end (std11-field-end)) - ) - (save-restriction - (narrow-to-region start end) - (decode-mime-charset-region start end charset) - (goto-char (point-max)) - ))) - (eword-decode-header) - ) - (decode-mime-charset-region (point) (point-max) charset) - (mime-maybe-hide-echo-buffer) - ) - (run-hooks 'gnus-mime-article-prepare-hook) - ) - -(defun gnus-article-prepare (article &optional all-headers header) - "Prepare ARTICLE in article mode buffer. -ARTICLE should either be an article number or a Message-ID. -If ARTICLE is an id, HEADER should be the article headers. -If ALL-HEADERS is non-nil, no headers are hidden." - (save-excursion - ;; Make sure we start in a summary buffer. - (unless (eq major-mode 'gnus-summary-mode) - (set-buffer gnus-summary-buffer)) - (setq gnus-summary-buffer (current-buffer)) - ;; Make sure the connection to the server is alive. - (unless (gnus-server-opened - (gnus-find-method-for-group gnus-newsgroup-name)) - (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) - (gnus-request-group gnus-newsgroup-name t)) - (let* ((gnus-article (if header (mail-header-number header) article)) - (summary-buffer (current-buffer)) - (internal-hook gnus-article-internal-prepare-hook) - (group gnus-newsgroup-name) - result) - (save-excursion - (gnus-article-setup-buffer) - (set-buffer gnus-article-buffer) - ;; Deactivate active regions. - (when (and (boundp 'transient-mark-mode) - transient-mark-mode) - (setq mark-active nil)) - (if (not (setq result (let ((buffer-read-only nil)) - (gnus-request-article-this-buffer - article group)))) - ;; There is no such article. - (save-excursion - (when (and (numberp article) - (not (memq article gnus-newsgroup-sparse))) - (setq gnus-article-current - (cons gnus-newsgroup-name article)) - (set-buffer gnus-summary-buffer) - (setq gnus-current-article article) - (gnus-summary-mark-article article gnus-canceled-mark)) - (unless (memq article gnus-newsgroup-sparse) - (gnus-error - 1 "No such article (may have expired or been canceled)"))) - (if (or (eq result 'pseudo) (eq result 'nneething)) - (progn - (save-excursion - (set-buffer summary-buffer) - (push article gnus-newsgroup-history) - (setq gnus-last-article gnus-current-article - gnus-current-article 0 - gnus-current-headers nil - gnus-article-current nil) - (if (eq result 'nneething) - (gnus-configure-windows 'summary) - (gnus-configure-windows 'article)) - (gnus-set-global-variables)) - (gnus-set-mode-line 'article)) - ;; The result from the `request' was an actual article - - ;; or at least some text that is now displayed in the - ;; article buffer. - (when (and (numberp article) - (not (eq article gnus-current-article))) - ;; Seems like a new article has been selected. - ;; `gnus-current-article' must be an article number. - (save-excursion - (set-buffer summary-buffer) - (push article gnus-newsgroup-history) - (setq gnus-last-article gnus-current-article - gnus-current-article article - gnus-current-headers - (gnus-summary-article-header gnus-current-article) - gnus-article-current - (cons gnus-newsgroup-name gnus-current-article)) - (unless (vectorp gnus-current-headers) - (setq gnus-current-headers nil)) - (gnus-summary-goto-subject gnus-current-article) - (gnus-summary-show-thread) - (gnus-run-hooks 'gnus-mark-article-hook) - (gnus-set-mode-line 'summary) - (when (gnus-visual-p 'article-highlight 'highlight) - (gnus-run-hooks 'gnus-visual-mark-article-hook)) - ;; Set the global newsgroup variables here. - ;; Suggested by Jim Sisolak - ;; . - (gnus-set-global-variables) - (setq gnus-have-all-headers - (or all-headers gnus-show-all-headers)) - (and gnus-use-cache - (vectorp (gnus-summary-article-header article)) - (gnus-cache-possibly-enter-article - group article - (gnus-summary-article-header article) - (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (memq article gnus-newsgroup-unreads))))) - (when (or (numberp article) - (stringp article)) - ;; Hooks for getting information from the article. - ;; This hook must be called before being narrowed. - (let (buffer-read-only) - (gnus-run-hooks 'internal-hook) - (gnus-run-hooks 'gnus-article-prepare-hook) - ;; Decode MIME message. - (when gnus-show-mime - (if (or (not gnus-strict-mime) - (gnus-fetch-field "Mime-Version")) - (funcall gnus-show-mime-method) - (funcall gnus-decode-encoded-word-method))) - ;; Perform the article display hooks. - (gnus-run-hooks 'gnus-article-display-hook)) - ;; Do page break. - (goto-char (point-min)) - (setq gnus-page-broken - (when gnus-break-pages - (gnus-narrow-to-page) - t))) - (gnus-set-mode-line 'article) - (gnus-configure-windows 'article) - (goto-char (point-min)) - t)))))) - -(defun gnus-article-wash-status () - "Return a string which display status of article washing." - (save-excursion - (set-buffer gnus-article-buffer) - (let ((cite (gnus-article-hidden-text-p 'cite)) - (headers (gnus-article-hidden-text-p 'headers)) - (boring (gnus-article-hidden-text-p 'boring-headers)) - (pgp (gnus-article-hidden-text-p 'pgp)) - (pem (gnus-article-hidden-text-p 'pem)) - (signature (gnus-article-hidden-text-p 'signature)) - (overstrike (gnus-article-hidden-text-p 'overstrike)) - (emphasis (gnus-article-hidden-text-p 'emphasis)) - (mime gnus-show-mime)) - (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 mime ?m ? ) - (if emphasis ?e ? ))))) - -(defun gnus-article-hide-headers-if-wanted () - "Hide unwanted headers if `gnus-have-all-headers' is nil. -Provided for backwards compatibility." - (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers) - gnus-inhibit-hiding - (gnus-article-hide-headers))) - -;;; Article savers. - -(defun gnus-output-to-file (file-name) - "Append the current article to a file named FILE-NAME." - (let ((artbuf (current-buffer))) - (nnheader-temp-write nil - (insert-buffer-substring artbuf) - ;; Append newline at end of the buffer as separator, and then - ;; save it to file. - (goto-char (point-max)) - (insert "\n") - (append-to-file (point-min) (point-max) file-name) - t))) - -(defun gnus-narrow-to-page (&optional arg) - "Narrow the article buffer to a page. -If given a numerical ARG, move forward ARG pages." - (interactive "P") - (setq arg (if arg (prefix-numeric-value arg) 0)) - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (widen) - ;; Remove any old next/prev buttons. - (when (gnus-visual-p 'page-marker) - (let ((buffer-read-only nil)) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next))) - (when - (cond ((< arg 0) - (re-search-backward page-delimiter nil 'move (1+ (abs arg)))) - ((> arg 0) - (re-search-forward page-delimiter nil 'move arg))) - (goto-char (match-end 0))) - (narrow-to-region - (point) - (if (re-search-forward page-delimiter nil 'move) - (match-beginning 0) - (point))) - (when (and (gnus-visual-p 'page-marker) - (not (= (point-min) 1))) - (save-excursion - (goto-char (point-min)) - (gnus-insert-prev-page-button))) - (when (and (gnus-visual-p 'page-marker) - (< (+ (point-max) 2) (buffer-size))) - (save-excursion - (goto-char (point-max)) - (gnus-insert-next-page-button))))) - -;; Article mode commands - -(defun gnus-article-goto-next-page () - "Show the next page of the article." - (interactive) - (when (gnus-article-next-page) - (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)) - (gnus-article-prev-page nil))) - -(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") - (move-to-window-line -1) - (if (save-excursion - (end-of-line) - (and (pos-visible-in-window-p) ;Not continuation line. - (eobp))) - ;; Nothing in this page. - (if (or (not gnus-page-broken) - (save-excursion - (save-restriction - (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer? - t ;Nothing more. - (gnus-narrow-to-page 1) ;Go to next page. - nil) - ;; More in this page. - (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) - nil)) - -(defun gnus-article-prev-page (&optional lines) - "Show previous page of current article. -Argument LINES specifies lines to be scrolled down." - (interactive "p") - (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-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) - (set-buffer gnus-summary-buffer) - (gnus-summary-refer-article message-id)) - (goto-char (point)) - (error "No references around point")))) - -(defun gnus-article-show-summary () - "Reconfigure windows to show summary buffer." - (interactive) - (if (not (gnus-buffer-live-p gnus-summary-buffer)) - (error "There is no summary buffer for this article buffer") - (gnus-article-set-globals) - (gnus-configure-windows 'article) - (gnus-summary-goto-subject gnus-current-article))) - -(defun gnus-article-describe-briefly () - "Describe article mode commands briefly." - (interactive) - (gnus-message 6 - (substitute-command-keys "\\\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) - -(defun gnus-article-summary-command () - "Execute the last keystroke in the summary buffer." - (interactive) - (let ((obuf (current-buffer)) - (owin (current-window-configuration)) - func) - (switch-to-buffer gnus-article-current-summary 'norecord) - (setq func (lookup-key (current-local-map) (this-command-keys))) - (call-interactively func) - (set-buffer obuf) - (set-window-configuration owin) - (set-window-point (get-buffer-window (current-buffer)) (point)))) - -(defun gnus-article-summary-command-nosave () - "Execute the last keystroke in the summary buffer." - (interactive) - (let (func) - (pop-to-buffer gnus-article-current-summary 'norecord) - (setq func (lookup-key (current-local-map) (this-command-keys))) - (call-interactively func))) - -(defun gnus-article-read-summary-keys (&optional arg key not-restore-window) - "Read a summary buffer key sequence and execute it from the article buffer." - (interactive "P") - (let ((nosaves - '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" - "Zc" "ZC" "ZE" "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) - (save-excursion - (set-buffer gnus-article-current-summary) - (let (gnus-pick-mode) - (push (or key last-command-event) unread-command-events) - (setq keys (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 (not func) - (ding) - (unless (member keys nosave-in-article) - (set-buffer gnus-article-current-summary)) - (call-interactively func)) - (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)) - func in-buffer) - (if not-restore-window - (pop-to-buffer gnus-article-current-summary 'norecord) - (switch-to-buffer gnus-article-current-summary 'norecord)) - (setq in-buffer (current-buffer)) - ;; We disable the pick minor mode commands. - (if (setq func (let (gnus-pick-mode) - (lookup-key (current-local-map) keys))) - (call-interactively func) - (ding)) - (when (eq in-buffer (current-buffer)) - (set-buffer obuf) - (unless not-restore-window - (set-window-configuration owin)) - (unless (member keys up-to-top) - (set-window-point (get-buffer-window (current-buffer)) - opoint))))))) - -(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. -If given a prefix, show the hidden text instead." - (interactive (list current-prefix-arg 'force)) - (gnus-article-hide-headers arg) - (gnus-article-hide-pgp arg) - (gnus-article-hide-citation-maybe arg force) - (gnus-article-hide-signature arg)) - -(defun gnus-article-maybe-highlight () - "Do some article highlighting if `article-visual' is non-nil." - (when (gnus-visual-p 'article-highlight 'highlight) - (gnus-article-highlight-some))) - -(defun gnus-request-article-this-buffer (article group) - "Get an article and insert it into this buffer." - (let (do-update-line) - (prog1 - (save-excursion - (erase-buffer) - (gnus-kill-all-overlays) - (setq group (or group gnus-newsgroup-name)) - - ;; Open server if it has closed. - (gnus-check-server (gnus-find-method-for-group group)) - - ;; Using `gnus-request-article' directly will insert the article into - ;; `nntp-server-buffer' - so we'll save some time by not having to - ;; copy it from the server buffer into the article buffer. - - ;; We only request an article by message-id when we do not have the - ;; headers for it, so we'll have to get those. - (when (stringp article) - (let ((gnus-override-method gnus-refer-article-method)) - (gnus-read-header article))) - - ;; If the article number is negative, that means that this article - ;; doesn't belong in this newsgroup (possibly), so we find its - ;; message-id and request it by id instead of number. - (when (and (numberp article) - gnus-summary-buffer - (get-buffer gnus-summary-buffer) - (buffer-name (get-buffer gnus-summary-buffer))) - (save-excursion - (set-buffer gnus-summary-buffer) - (let ((header (gnus-summary-article-header article))) - (when (< article 0) - (cond - ((memq article gnus-newsgroup-sparse) - ;; This is a sparse gap article. - (setq do-update-line article) - (setq article (mail-header-id header)) - (let ((gnus-override-method gnus-refer-article-method)) - (gnus-read-header article)) - (setq gnus-newsgroup-sparse - (delq article gnus-newsgroup-sparse))) - ((vectorp header) - ;; It's a real article. - (setq article (mail-header-id header))) - (t - ;; It is an extracted pseudo-article. - (setq article 'pseudo) - (gnus-request-pseudo-article header)))) - - (let ((method (gnus-find-method-for-group - gnus-newsgroup-name))) - (if (not (eq (car method) 'nneething)) - () - (let ((dir (concat (file-name-as-directory (nth 1 method)) - (mail-header-subject header)))) - (when (file-directory-p dir) - (setq article 'nneething) - (gnus-group-enter-directory dir)))))))) - - (cond - ;; Refuse to select canceled articles. - ((and (numberp article) - gnus-summary-buffer - (get-buffer gnus-summary-buffer) - (buffer-name (get-buffer gnus-summary-buffer)) - (eq (cdr (save-excursion - (set-buffer gnus-summary-buffer) - (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))) - 'article) - ;; Check asynchronous pre-fetch. - ((gnus-async-request-fetched-article group article (current-buffer)) - (gnus-async-prefetch-next group article gnus-summary-buffer) - (when (and (numberp article) gnus-keep-backlog) - (gnus-backlog-enter-article group article (current-buffer))) - 'article) - ;; Check the cache. - ((and gnus-use-cache - (numberp article) - (gnus-cache-request-article article group)) - 'article) - ;; Get the article and put into the article buffer. - ((or (stringp article) (numberp article)) - (let ((gnus-override-method - (and (stringp article) gnus-refer-article-method)) - (buffer-read-only nil)) - (erase-buffer) - (gnus-kill-all-overlays) - (when (gnus-request-article article group (current-buffer)) - (when (numberp article) - (gnus-async-prefetch-next group article gnus-summary-buffer) - (when gnus-keep-backlog - (gnus-backlog-enter-article - group article (current-buffer)))) - 'article))) - ;; It was a pseudo. - (t article))) - - ;; Associate this article with the current summary buffer. - (setq gnus-article-current-summary gnus-summary-buffer) - - ;; Take the article from the original article buffer - ;; and place it in the buffer it's supposed to be in. - (when (and (get-buffer gnus-article-buffer) - (equal (buffer-name (current-buffer)) - (buffer-name (get-buffer gnus-article-buffer)))) - (save-excursion - (if (get-buffer gnus-original-article-buffer) - (set-buffer (get-buffer gnus-original-article-buffer)) - (set-buffer (get-buffer-create gnus-original-article-buffer)) - (buffer-disable-undo (current-buffer)) - (setq major-mode 'gnus-original-article-mode) - (setq buffer-read-only t) - (gnus-add-current-to-buffer-list)) - (let (buffer-read-only) - (erase-buffer) - (insert-buffer-substring gnus-article-buffer)) - (setq gnus-original-article (cons group article)))) - - ;; Update sparse articles. - (when (and do-update-line - (or (numberp article) - (stringp article))) - (let ((buf (current-buffer))) - (set-buffer gnus-summary-buffer) - (gnus-summary-update-article do-update-line) - (gnus-summary-goto-subject do-update-line nil t) - (set-window-point (get-buffer-window (current-buffer) t) - (point)) - (set-buffer buf)))))) - -;;; -;;; Article editing -;;; - -(defcustom gnus-article-edit-mode-hook nil - "*Hook run in article edit mode buffers." - :group 'gnus-article-various - :type 'hook) - -(defvar gnus-article-edit-done-function nil) - -(defvar gnus-article-edit-mode-map nil) - -(unless gnus-article-edit-mode-map - (setq gnus-article-edit-mode-map (copy-keymap text-mode-map)) - - (gnus-define-keys gnus-article-edit-mode-map - "\C-c\C-c" gnus-article-edit-done - "\C-c\C-k" gnus-article-edit-exit) - - (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 () - "Major mode for editing articles. -This is an extended text-mode. - -\\{gnus-article-edit-mode-map}" - (interactive) - (kill-all-local-variables) - (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) - (setq buffer-read-only nil) - (buffer-enable-undo) - (widen) - (gnus-run-hooks 'text-mode-hook 'gnus-article-edit-mode-hook)) - -(defun gnus-article-edit (&optional force) - "Edit the current article. -This will have permanent effect only in mail groups. -If FORCE is non-nil, allow editing of articles even in read-only -groups." - (interactive "P") - (when (and (not force) - (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing")) - (gnus-article-date-original) - (gnus-article-edit-article - `(lambda (no-highlight) - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))) - -(defun gnus-article-edit-article (exit-func) - "Start editing the contents of the current article buffer." - (let ((winconf (current-window-configuration))) - (set-buffer gnus-article-buffer) - (gnus-article-edit-mode) - (gnus-set-text-properties (point-min) (point-max) nil) - (gnus-configure-windows 'edit-article) - (setq gnus-article-edit-done-function exit-func) - (setq gnus-prev-winconf winconf) - (gnus-message 6 "C-c C-c to end edits"))) - -(defun gnus-article-edit-done (&optional arg) - "Update the article edits and exit." - (interactive "P") - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (when (search-forward "\n\n" nil 1) - (let ((lines (count-lines (point) (point-max))) - (length (- (point-max) (point))) - (case-fold-search t) - (body (copy-marker (point)))) - (goto-char (point-min)) - (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t) - (delete-region (match-beginning 1) (match-end 1)) - (insert (number-to-string length))) - (goto-char (point-min)) - (when (re-search-forward - "^x-content-length:[ \t]\\([0-9]+\\)" body t) - (delete-region (match-beginning 1) (match-end 1)) - (insert (number-to-string length))) - (goto-char (point-min)) - (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t) - (delete-region (match-beginning 1) (match-end 1)) - (insert (number-to-string lines))))))) - (let ((func gnus-article-edit-done-function) - (buf (current-buffer)) - (start (window-start))) - (gnus-article-edit-exit) - (save-excursion - (set-buffer buf) - (let ((buffer-read-only nil)) - (funcall func arg))) - (set-buffer buf) - (set-window-start (get-buffer-window buf) start) - (set-window-point (get-buffer-window buf) (point)))) - -(defun gnus-article-edit-exit () - "Exit the article editing without updating." - (interactive) - ;; We remove all text props from the article buffer. - (let ((buf (format "%s" (buffer-string))) - (curbuf (current-buffer)) - (p (point)) - (window-start (window-start))) - (erase-buffer) - (insert buf) - (let ((winconf gnus-prev-winconf)) - (gnus-article-mode) - ;; The cache and backlog have to be flushed somewhat. - (when gnus-use-cache - (gnus-cache-update-article - (car gnus-article-current) (cdr gnus-article-current))) - (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))) - (set-window-configuration winconf) - ;; Tippy-toe some to make sure that point remains where it was. - (let ((buf (current-buffer))) - (set-buffer curbuf) - (set-window-start (get-buffer-window (current-buffer)) window-start) - (goto-char p) - (set-buffer buf))))) - -(defun gnus-article-edit-full-stops () - "Interactively repair spacing at end of sentences." - (interactive) - (save-excursion - (goto-char (point-min)) - (search-forward-regexp "^$" nil t) - (let ((case-fold-search nil)) - (query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2")))) - -;;; -;;; Article highlights -;;; - -;; Written by Per Abrahamsen . - -;;; Internal Variables: - -(defcustom gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)" - "*Regular expression that matches URLs." - :group 'gnus-article-buttons - :type 'regexp) - -(defcustom gnus-button-alist - `(("<\\(url: ?\\)?news:\\([^>\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: ?\\)?news:\\(//\\)?\\([^>\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) - ("\\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) - ;; Raw URLs. - (,gnus-button-url-regexp 0 t gnus-button-url 0)) - "*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, -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, -CALLBACK: is the function to call when the user push this button, and each -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 - (integer :tag "Button") - (sexp :tag "Form") - (function :tag "Callback") - (repeat :tag "Par" - :inline t - (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) - ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" - 0 t gnus-button-mailto 0) - ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0) - ("^Subject:" ,gnus-button-url-regexp 0 t gnus-button-url 0) - ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0) - ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t - gnus-button-message-id 3)) - "*Alist of headers and regexps to match buttons in article heads. - -This alist is very similar to `gnus-button-alist', except that each -alist has an additional HEADER element first in each entry: - -\(HEADER REGEXP BUTTON FORM CALLBACK PAR) - -HEADER is a regexp to match a header. For a fuller explanation, see -`gnus-button-alist'." - :group 'gnus-article-buttons - :group 'gnus-article-headers - :type '(repeat (list (regexp :tag "Header") - regexp - (integer :tag "Button") - (sexp :tag "Form") - (function :tag "Callback") - (repeat :tag "Par" - :inline t - (integer :tag "Regexp group"))))) - -(defvar gnus-button-regexp nil) -(defvar gnus-button-marker-list nil) -;; Regexp matching any of the regexps from `gnus-button-alist'. - -(defvar gnus-button-last nil) -;; The value of `gnus-button-alist' when `gnus-button-regexp' was build. - -;;; Commands: - -(defun gnus-article-push-button (event) - "Check text under the mouse pointer for a callback function. -If the text under the mouse pointer has a `gnus-callback' property, -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)) - (fun (get-text-property pos 'gnus-callback))) - (when fun - (funcall fun data)))) - -(defun gnus-article-press-button () - "Check text at point for a callback function. -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))) - (when fun - (funcall fun data)))) - -(defun gnus-article-prev-button (n) - "Move point to N buttons backward. -If N is negative, move forward instead." - (interactive "p") - (gnus-article-next-button (- n))) - -(defun gnus-article-next-button (n) - "Move point to N buttons forward. -If N is negative, move backward instead." - (interactive "p") - (let ((function (if (< n 0) 'previous-single-property-change - 'next-single-property-change)) - (inhibit-point-motion-hooks t) - (backward (< n 0)) - (limit (if (< n 0) (point-min) (point-max)))) - (setq n (abs n)) - (while (and (not (= limit (point))) - (> n 0)) - ;; Skip past the current button. - (when (get-text-property (point) 'gnus-callback) - (goto-char (funcall function (point) 'gnus-callback nil limit))) - ;; Go to the next (or previous) button. - (gnus-goto-char (funcall function (point) 'gnus-callback nil limit)) - ;; Put point at the start of the button. - (when (and backward (not (get-text-property (point) 'gnus-callback))) - (goto-char (funcall function (point) 'gnus-callback nil limit))) - ;; Skip past intangible buttons. - (when (get-text-property (point) 'intangible) - (incf n)) - (decf n)) - (unless (zerop n) - (gnus-message 5 "No more buttons")) - n)) - -(defun gnus-article-highlight (&optional force) - "Highlight current article. -This function calls `gnus-article-highlight-headers', -`gnus-article-highlight-citation', -`gnus-article-highlight-signature', and `gnus-article-add-buttons' to -do the highlighting. See the documentation for those functions." - (interactive (list 'force)) - (gnus-article-highlight-headers) - (gnus-article-highlight-citation force) - (gnus-article-highlight-signature) - (gnus-article-add-buttons force) - (gnus-article-add-buttons-to-head)) - -(defun gnus-article-highlight-some (&optional force) - "Highlight current article. -This function calls `gnus-article-highlight-headers', -`gnus-article-highlight-signature', and `gnus-article-add-buttons' to -do the highlighting. See the documentation for those functions." - (interactive (list 'force)) - (gnus-article-highlight-headers) - (gnus-article-highlight-signature) - (gnus-article-add-buttons)) - -(defun gnus-article-highlight-headers () - "Highlight article headers as specified by `gnus-header-face-alist'." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (let ((alist gnus-header-face-alist) - (buffer-read-only nil) - (case-fold-search t) - (inhibit-point-motion-hooks t) - entry regexp header-face field-face from hpoints fpoints) - (message-narrow-to-head) - (while (setq entry (pop alist)) - (goto-char (point-min)) - (setq regexp (concat "^\\(" - (if (string-equal "" (nth 0 entry)) - "[^\t ]" - (nth 0 entry)) - "\\)") - header-face (nth 1 entry) - field-face (nth 2 entry)) - (while (and (re-search-forward regexp nil t) - (not (eobp))) - (beginning-of-line) - (setq from (point)) - (unless (search-forward ":" nil t) - (forward-char 1)) - (when (and header-face - (not (memq (point) hpoints))) - (push (point) hpoints) - (gnus-put-text-property from (point) 'face header-face)) - (when (and field-face - (not (memq (setq from (point)) fpoints))) - (push from fpoints) - (if (re-search-forward "^[^ \t]" nil t) - (forward-char -2) - (goto-char (point-max))) - (gnus-put-text-property from (point) 'face field-face)))))))) - -(defun gnus-article-highlight-signature () - "Highlight the signature in an article. -It does this by highlighting everything after -`gnus-signature-separator' using `gnus-signature-face'." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t)) - (save-restriction - (when (and gnus-signature-face - (gnus-article-narrow-to-signature)) - (gnus-overlay-put (gnus-make-overlay (point-min) (point-max)) - 'face gnus-signature-face) - (widen) - (gnus-article-search-signature) - (let ((start (match-beginning 0)) - (end (set-marker (make-marker) (1+ (match-end 0))))) - (gnus-article-add-button start (1- end) 'gnus-signature-toggle - end))))))) - -(defun gnus-button-in-region-p (b e prop) - "Say whether PROP exists in the region." - (text-property-not-all b e prop nil)) - -(defun gnus-article-add-buttons (&optional force) - "Find external references in the article and make buttons of them. -\"External references\" are things like Message-IDs and URLs, as -specified by `gnus-button-alist'." - (interactive (list 'force)) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (case-fold-search t) - (alist gnus-button-alist) - beg entry regexp) - ;; Remove all old markers. - (let (marker entry) - (while (setq marker (pop gnus-button-marker-list)) - (goto-char marker) - (when (setq entry (gnus-button-entry)) - (put-text-property (match-beginning (nth 1 entry)) - (match-end (nth 1 entry)) - 'gnus-callback nil)) - (set-marker marker nil))) - ;; We skip the headers. - (goto-char (point-min)) - (unless (search-forward "\n\n" nil t) - (goto-char (point-max))) - (setq beg (point)) - (while (setq entry (pop alist)) - (setq regexp (car entry)) - (goto-char beg) - (while (re-search-forward regexp nil t) - (let* ((start (and entry (match-beginning (nth 1 entry)))) - (end (and entry (match-end (nth 1 entry)))) - (from (match-beginning 0))) - (when (and (or (eq t (nth 2 entry)) - (eval (nth 2 entry))) - (not (gnus-button-in-region-p - start end 'gnus-callback))) - ;; That optional form returned non-nil, so we add the - ;; button. - (gnus-article-add-button - start end 'gnus-button-push - (car (push (set-marker (make-marker) from) - gnus-button-marker-list)))))))))) - -;; Add buttons to the head of an article. -(defun gnus-article-add-buttons-to-head () - "Add buttons to the head of the article." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (case-fold-search t) - (alist gnus-header-button-alist) - entry beg end) - (nnheader-narrow-to-headers) - (while alist - ;; Each alist entry. - (setq entry (car alist) - alist (cdr alist)) - (goto-char (point-min)) - (while (re-search-forward (car entry) nil t) - ;; Each header matching the entry. - (setq beg (match-beginning 0)) - (setq end (or (and (re-search-forward "^[^ \t]" nil t) - (match-beginning 0)) - (point-max))) - (goto-char beg) - (while (re-search-forward (nth 1 entry) end t) - ;; Each match within a header. - (let* ((entry (cdr entry)) - (start (match-beginning (nth 1 entry))) - (end (match-end (nth 1 entry))) - (form (nth 2 entry))) - (goto-char (match-end 0)) - (when (eval form) - (gnus-article-add-button - start end (nth 3 entry) - (buffer-substring (match-beginning (nth 4 entry)) - (match-end (nth 4 entry))))))) - (goto-char end)))) - (widen))) - -;;; External functions: - -(defun gnus-article-add-button (from to fun &optional data) - "Create a button between FROM and TO with callback FUN and data DATA." - (when gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay from to) - 'face gnus-article-button-face)) - (gnus-add-text-properties - from to - (nconc (and gnus-article-mouse-face - (list gnus-mouse-face-prop gnus-article-mouse-face)) - (list 'gnus-callback fun) - (and data (list 'gnus-data data))))) - -;;; Internal functions: - -(defun gnus-article-set-globals () - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-set-global-variables))) - -(defun gnus-signature-toggle (end) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t)) - (if (get-text-property end 'invisible) - (gnus-article-unhide-text end (point-max)) - (gnus-article-hide-text end (point-max) gnus-hidden-properties))))) - -(defun gnus-button-entry () - ;; Return the first entry in `gnus-button-alist' matching this place. - (let ((alist gnus-button-alist) - (entry nil)) - (while alist - (setq entry (pop alist)) - (if (looking-at (car entry)) - (setq alist nil) - (setq entry nil))) - entry)) - -(defun gnus-button-push (marker) - ;; Push button starting at MARKER. - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char marker) - (let* ((entry (gnus-button-entry)) - (inhibit-point-motion-hooks t) - (fun (nth 3 entry)) - (args (mapcar (lambda (group) - (let ((string (match-string group))) - (gnus-set-text-properties - 0 (length string) nil string) - string)) - (nthcdr 4 entry)))) - (cond - ((fboundp fun) - (apply fun args)) - ((and (boundp fun) - (fboundp (symbol-value fun))) - (apply (symbol-value fun) args)) - (t - (gnus-message 1 "You must define `%S' to use this button" - (cons fun args))))))) - -(defun gnus-button-message-id (message-id) - "Fetch MESSAGE-ID." - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-refer-article message-id))) - -(defun gnus-button-fetch-group (address) - "Fetch GROUP specified by ADDRESS." - (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)) - (error "Can't parse %s" address) - (gnus-group-read-ephemeral-group - (match-string 4 address) - `(nntp ,(match-string 1 address) - (nntp-address ,(match-string 1 address)) - (nntp-port-number ,(if (match-end 3) - (match-string 3 address) - "nntp"))))))) - -(defun gnus-split-string (string pattern) - "Return a list of substrings of STRING which are separated by PATTERN." - (let (parts (start 0)) - (while (string-match pattern string start) - (setq parts (cons (substring string start (match-beginning 0)) parts) - start (match-end 0))) - (nreverse (cons (substring string start) parts)))) - -(defun gnus-url-parse-query-string (query &optional downcase) - (let (retval pairs cur key val) - (setq pairs (gnus-split-string query "&")) - (while pairs - (setq cur (car 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))))) - 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 source-url 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 url))) - (setq args (cons (list "to" to) args) - subject (cdr-safe (assoc "subject" args))) - (message-mail) - (while args - (setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) - (if (fboundp func) - (funcall func) - (message-position-on-field (caar args))) - (insert (mapconcat 'identity (cdar args) ", ")) - (setq args (cdr args))) - (if subject - (message-goto-body) - (message-goto-subject)))) - -(defun gnus-button-mailto (address) - ;; Mail to ADDRESS. - (set-buffer (gnus-copy-article-buffer)) - (message-reply address)) - -(defun gnus-button-reply (address) - ;; Reply to ADDRESS. - (message-reply address)) - -(defun gnus-button-url (address) - "Browse ADDRESS." - ;; In Emacs 20, `browse-url-browser-function' may be an alist. - (if (listp browse-url-browser-function) - (browse-url address) - (funcall browse-url-browser-function address))) - -(defun gnus-button-embedded-url (address) - "Browse ADDRESS." - ;; In Emacs 20, `browse-url-browser-function' may be an alist. - (if (listp browse-url-browser-function) - (browse-url (gnus-strip-whitespace address)) - (funcall browse-url-browser-function (gnus-strip-whitespace address)))) - -;;; 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)) - -(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)))) - -(defvar gnus-next-page-map nil) -(unless gnus-next-page-map - (setq gnus-next-page-map (make-keymap)) - (suppress-keymap gnus-prev-page-map) - (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page) - (define-key gnus-next-page-map "\r" 'gnus-button-next-page)) - -(defun gnus-button-next-page () - "Go to the next page." - (interactive) - (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) - (gnus-article-next-page) - (select-window win))) - -(defun gnus-button-prev-page () - "Go to the prev page." - (interactive) - (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) - (gnus-article-prev-page) - (select-window win))) - -(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)))) - -(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)) - (gnus-article-next-page) - (select-window win))) - -(defun gnus-article-button-prev-page (arg) - "Go to the prev page." - (interactive "P") - (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) - (gnus-article-prev-page) - (select-window win))) - - -;;; @ for mime-view -;;; - -(defun gnus-content-header-filter () - "Header filter for mime-view. -It is registered to variable `mime-view-content-header-filter-alist'." - (goto-char (point-min)) - (while (re-search-forward "^[^ \t:]+:" nil t) - (let ((start (match-beginning 0)) - (end (std11-field-end)) - ) - (save-restriction - (narrow-to-region start end) - (decode-mime-charset-region start end default-mime-charset) - (goto-char (point-max)) - ))) - (eword-decode-header) - ) - -(defun mime-view-quitting-method-for-gnus () - (if (not gnus-show-mime) - (mime-view-kill-buffer)) - (delete-other-windows) - (gnus-article-show-summary) - (if (or (not gnus-show-mime) - (null gnus-have-all-headers)) - (gnus-summary-select-article nil t) - )) - -(set-alist 'mime-view-content-header-filter-alist - 'gnus-original-article-mode - (function gnus-content-header-filter)) - -(set-alist 'mime-text-decoder-alist - 'gnus-original-article-mode - (function mime-text-decode-buffer)) - -(set-alist 'mime-view-quitting-method-alist - 'gnus-original-article-mode - (function mime-view-quitting-method-for-gnus)) - -(set-alist 'mime-view-show-summary-method - 'gnus-original-article-mode - (function mime-view-quitting-method-for-gnus)) - - -;;; @ end -;;; - -(gnus-ems-redefine) - -(provide 'gnus-art) - -(run-hooks 'gnus-art-load-hook) - -;;; gnus-art.el ends here diff --git a/lisp/gnus-async.el b/lisp/gnus-async.el deleted file mode 100644 index 755d55c..0000000 --- a/lisp/gnus-async.el +++ /dev/null @@ -1,325 +0,0 @@ -;;; gnus-async.el --- asynchronous support for Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-sum) -(require 'nntp) - -(defgroup gnus-asynchronous nil - "Support for asynchronous operations." - :group 'gnus) - -(defcustom gnus-asynchronous t - "*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; -if t, prefetch as many articles as possible." - :group 'gnus-asynchronous - :type '(choice (const :tag "off" nil) - (const :tag "all" t) - (integer :tag "some" 0))) - -(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 -articles are removed as they are read, and `exit', which means -that all articles belonging to a group are removed on exit -from that group." - :group 'gnus-asynchronous - :type '(set (const read) (const exit))) - -(defcustom gnus-use-header-prefetch nil - "*If non-nil, prefetch the headers to the next group." - :group 'gnus-asynchronous - :type 'boolean) - -(defcustom gnus-async-prefetch-article-p 'gnus-async-unread-p - "*Function called to say whether an article should be prefetched or not. -The function is called with one parameter -- the article data. -It should return non-nil if the article is to be prefetched." - :group 'gnus-asynchronous - :type 'function) - -;;; Internal variables. - -(defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*") -(defvar gnus-async-article-alist nil) -(defvar gnus-async-article-semaphore '(nil)) -(defvar gnus-async-fetch-list nil) -(defvar gnus-asynch-obarray nil) - -(defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*") -(defvar gnus-async-header-prefetched nil) - -;;; Utility functions. - -(defun gnus-group-asynchronous-p (group) - "Say whether GROUP is fetched from a server that supports asynchronicity." - (gnus-asynchronous-p (gnus-find-method-for-group group))) - -;;; Somewhat bogus semaphores. - -(defun gnus-async-get-semaphore (semaphore) - "Wait until SEMAPHORE is released." - (while (/= (length (nconc (symbol-value semaphore) (list nil))) 2) - (sleep-for 1))) - -(defun gnus-async-release-semaphore (semaphore) - "Release SEMAPHORE." - (setcdr (symbol-value semaphore) nil)) - -(defmacro gnus-async-with-semaphore (&rest forms) - `(unwind-protect - (progn - (gnus-async-get-semaphore 'gnus-async-article-semaphore) - ,@forms) - (gnus-async-release-semaphore 'gnus-async-article-semaphore))) - -(put 'gnus-asynch-with-semaphore 'lisp-indent-function 0) -(put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body)) - -;;; -;;; Article prefetch -;;; - -(gnus-add-shutdown 'gnus-async-close 'gnus) -(defun gnus-async-close () - (gnus-kill-buffer gnus-async-prefetch-article-buffer) - (gnus-kill-buffer gnus-async-prefetch-headers-buffer) - (setq gnus-async-article-alist nil - gnus-async-header-prefetched nil)) - -(defun gnus-async-set-buffer () - (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t) - (unless gnus-asynch-obarray - (set (make-local-variable 'gnus-asynch-obarray) - (gnus-make-hashtable 1023)))) - -(defun gnus-async-halt-prefetch () - "Stop prefetching." - (setq gnus-async-fetch-list nil)) - -(defun gnus-async-prefetch-next (group article summary) - "Possibly prefetch several articles starting with the article after ARTICLE." - (when (and (gnus-buffer-live-p summary) - gnus-asynchronous - (gnus-group-asynchronous-p group)) - (save-excursion - (set-buffer gnus-summary-buffer) - (let ((next (caadr (gnus-data-find-list article)))) - (when next - (if (not (fboundp 'run-with-idle-timer)) - ;; This is either an older Emacs or XEmacs, so we - ;; do this, which leads to slightly slower article - ;; buffer display. - (gnus-async-prefetch-article group next summary) - (run-with-idle-timer - 0.1 nil 'gnus-async-prefetch-article group next summary))))))) - -(defun gnus-async-prefetch-article (group article summary &optional next) - "Possibly prefetch several articles starting with ARTICLE." - (if (not (gnus-buffer-live-p summary)) - (gnus-async-with-semaphore - (setq gnus-async-fetch-list nil)) - (when (and gnus-asynchronous - (gnus-alive-p)) - (when next - (gnus-async-with-semaphore - (pop gnus-async-fetch-list))) - (let ((do-fetch next) - (do-message t)) ;(eq major-mode 'gnus-summary-mode))) - (when (and (gnus-group-asynchronous-p group) - (gnus-buffer-live-p summary) - (or (not next) - gnus-async-fetch-list)) - (gnus-async-with-semaphore - (unless next - (setq do-fetch (not gnus-async-fetch-list)) - ;; Nix out any outstanding requests. - (setq gnus-async-fetch-list nil) - ;; Fill in the new list. - (let ((n gnus-use-article-prefetch) - (data (gnus-data-find-list article)) - d) - (while (and (setq d (pop data)) - (if (numberp n) - (natnump (decf n)) - n)) - (unless (or (gnus-async-prefetched-article-entry - group (setq article (gnus-data-number d))) - (not (natnump article)) - (not (funcall gnus-async-prefetch-article-p d))) - ;; Not already fetched -- so we add it to the list. - (push article gnus-async-fetch-list))) - (setq gnus-async-fetch-list - (nreverse gnus-async-fetch-list)))) - - (when do-fetch - (setq article (car gnus-async-fetch-list)))) - - (when (and do-fetch article) - ;; We want to fetch some more articles. - (save-excursion - (set-buffer summary) - (let (mark) - (gnus-async-set-buffer) - (goto-char (point-max)) - (setq mark (point-marker)) - (let ((nnheader-callback-function - (gnus-make-async-article-function - group article mark summary next)) - (nntp-server-buffer - (get-buffer gnus-async-prefetch-article-buffer))) - (when do-message - (gnus-message 9 "Prefetching article %d in group %s" - article group)) - (gnus-request-article article group)))))))))) - -(defun gnus-make-async-article-function (group article mark summary next) - "Return a callback function." - `(lambda (arg) - (save-excursion - (when arg - (gnus-async-set-buffer) - (gnus-async-with-semaphore - (push (list ',(intern (format "%s-%d" group article) - gnus-asynch-obarray) - ,mark (set-marker (make-marker) (point-max)) - ,group ,article) - gnus-async-article-alist))) - (if (not (gnus-buffer-live-p ,summary)) - (gnus-async-with-semaphore - (setq gnus-async-fetch-list nil)) - (gnus-async-prefetch-article ,group ,next ,summary t))))) - -(defun gnus-async-unread-p (data) - "Return non-nil if DATA represents an unread article." - (gnus-data-unread-p data)) - -(defun gnus-async-request-fetched-article (group article buffer) - "See whether we have ARTICLE from GROUP and put it in BUFFER." - (when (numberp article) - (let ((entry (gnus-async-prefetched-article-entry group article))) - (when entry - (save-excursion - (gnus-async-set-buffer) - (copy-to-buffer buffer (cadr entry) (caddr entry)) - ;; Remove the read article from the prefetch buffer. - (when (memq 'read gnus-prefetched-article-deletion-strategy) - (gnus-async-delete-prefected-entry entry)) - t))))) - -(defun gnus-async-delete-prefected-entry (entry) - "Delete ENTRY from buffer and alist." - (ignore-errors - (delete-region (cadr entry) (caddr entry)) - (set-marker (cadr entry) nil) - (set-marker (caddr entry) nil)) - (gnus-async-with-semaphore - (setq gnus-async-article-alist - (delq entry gnus-async-article-alist)))) - -(defun gnus-async-prefetch-remove-group (group) - "Remove all articles belonging to GROUP from the prefetch buffer." - (when (and (gnus-group-asynchronous-p group) - (memq 'exit gnus-prefetched-article-deletion-strategy)) - (let ((alist gnus-async-article-alist)) - (save-excursion - (gnus-async-set-buffer) - (while alist - (when (equal group (nth 3 (car alist))) - (gnus-async-delete-prefected-entry (car alist))) - (pop alist)))))) - -(defun gnus-async-prefetched-article-entry (group article) - "Return the entry for ARTICLE in GROUP iff it has been prefetched." - (let ((entry (save-excursion - (gnus-async-set-buffer) - (assq (intern (format "%s-%d" group article) - gnus-asynch-obarray) - gnus-async-article-alist)))) - ;; Perhaps something has emptied the buffer? - (if (and entry - (= (cadr entry) (caddr entry))) - (progn - (ignore-errors - (set-marker (cadr entry) nil) - (set-marker (caddr entry) nil)) - (setq gnus-async-article-alist - (delq entry gnus-async-article-alist)) - nil) - entry))) - -;;; -;;; Header prefetch -;;; - -(defun gnus-async-prefetch-headers (group) - "Prefetch the headers for group GROUP." - (save-excursion - (let (unread) - (when (and gnus-use-header-prefetch - gnus-asynchronous - (gnus-group-asynchronous-p group) - (listp gnus-async-header-prefetched) - (setq unread (gnus-list-of-unread-articles group))) - ;; Mark that a fetch is in progress. - (setq gnus-async-header-prefetched t) - (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t) - (erase-buffer) - (let ((nntp-server-buffer (current-buffer)) - (nnheader-callback-function - `(lambda (arg) - (setq gnus-async-header-prefetched - ,(cons group unread))))) - (gnus-retrieve-headers unread group gnus-fetch-old-headers)))))) - -(defun gnus-async-retrieve-fetched-headers (articles group) - "See whether we have prefetched headers." - (when (and gnus-use-header-prefetch - (gnus-group-asynchronous-p group) - (listp gnus-async-header-prefetched) - (equal group (car gnus-async-header-prefetched)) - (equal articles (cdr gnus-async-header-prefetched))) - (save-excursion - (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t) - (nntp-decode-text) - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) - (erase-buffer) - (setq gnus-async-header-prefetched nil) - t))) - -(provide 'gnus-async) - -;;; gnus-async.el ends here diff --git a/lisp/gnus-audio.el b/lisp/gnus-audio.el deleted file mode 100644 index f3bb686..0000000 --- a/lisp/gnus-audio.el +++ /dev/null @@ -1,131 +0,0 @@ -;;; gnus-audio.el --- Sound effects for Gnus -;; Copyright (C) 1996 Free Software Foundation - -;; Author: Steven L. Baur - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; 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 provides access to sound effects in Gnus. -;; Prerelease: This file is partially stripped to support earcons.el -;; You can safely ignore most of it until Red Gnus. **Evil Laugh** -;;; Code: - -(when (null (boundp 'running-xemacs)) - (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))) - -(require 'nnheader) -(eval-when-compile (require 'cl)) - -(defvar gnus-audio-inline-sound - (and (fboundp 'device-sound-enabled-p) - (device-sound-enabled-p)) - "When t, we will not spawn a subprocess to play sounds.") - -(defvar gnus-audio-directory (nnheader-find-etc-directory "sounds") - "The directory containing the Sound Files.") - -(defvar gnus-audio-au-player "/usr/bin/showaudio" - "Executable program for playing sun AU format sound files.") - -(defvar gnus-audio-wav-player "/usr/local/bin/play" - "Executable program for playing WAV files.") - -;;; The following isn't implemented yet. Wait for Millennium Gnus. -;(defvar gnus-audio-effects-enabled t -; "When t, Gnus will use sound effects.") -;(defvar gnus-audio-enable-hooks nil -; "Functions run when enabling sound effects.") -;(defvar gnus-audio-disable-hooks nil -; "Functions run when disabling sound effects.") -;(defvar gnus-audio-theme-song nil -; "Theme song for Gnus.") -;(defvar gnus-audio-enter-group nil -; "Sound effect played when selecting a group.") -;(defvar gnus-audio-exit-group nil -; "Sound effect played when exiting a group.") -;(defvar gnus-audio-score-group nil -; "Sound effect played when scoring a group.") -;(defvar gnus-audio-busy-sound nil -; "Sound effect played when going into a ... sequence.") - - -;;;###autoload - ;(defun gnus-audio-enable-sound () -; "Enable Sound Effects for Gnus." -; (interactive) -; (setq gnus-audio-effects-enabled t) -; (gnus-run-hooks gnus-audio-enable-hooks)) - -;;;###autoload - ;(defun gnus-audio-disable-sound () -; "Disable Sound Effects for Gnus." -; (interactive) -; (setq gnus-audio-effects-enabled nil) -; (gnus-run-hooks gnus-audio-disable-hooks)) - -;;;###autoload -(defun gnus-audio-play (file) - "Play a sound through the speaker." - (interactive) - (let ((sound-file (if (file-exists-p file) - file - (concat gnus-audio-directory file)))) - (when (file-exists-p sound-file) - (if gnus-audio-inline-sound - (play-sound-file sound-file) - (cond ((string-match "\\.wav$" sound-file) - (call-process gnus-audio-wav-player - sound-file - 0 - nil - sound-file)) - ((string-match "\\.au$" sound-file) - (call-process gnus-audio-au-player - sound-file - 0 - nil - sound-file))))))) - - -;;; The following isn't implemented yet, wait for Red Gnus - ;(defun gnus-audio-startrek-sounds () -; "Enable sounds from Star Trek the original series." -; (interactive) -; (setq gnus-audio-busy-sound "working.au") -; (setq gnus-audio-enter-group "bulkhead_door.au") -; (setq gnus-audio-exit-group "bulkhead_door.au") -; (setq gnus-audio-score-group "ST_laser.au") -; (setq gnus-audio-theme-song "startrek.au") -; (add-hook 'gnus-select-group-hook 'gnus-audio-startrek-select-group) -; (add-hook 'gnus-exit-group-hook 'gnus-audio-startrek-exit-group)) -;;;*** - -(defvar gnus-startup-jingle "Tuxedomoon.Jingle4.au" - "Name of the Gnus startup jingle file.") - -(defun gnus-play-jingle () - "Play the Gnus startup jingle, unless that's inhibited." - (interactive) - (gnus-audio-play gnus-startup-jingle)) - -(provide 'gnus-audio) - -(run-hooks 'gnus-audio-load-hook) - -;;; gnus-audio.el ends here diff --git a/lisp/gnus-bcklg.el b/lisp/gnus-bcklg.el deleted file mode 100644 index 457770f..0000000 --- a/lisp/gnus-bcklg.el +++ /dev/null @@ -1,155 +0,0 @@ -;;; gnus-bcklg.el --- backlog functions for Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) - -;;; -;;; Buffering of read articles. -;;; - -(defvar gnus-backlog-buffer " *Gnus Backlog*") -(defvar gnus-backlog-articles nil) -(defvar gnus-backlog-hashtb nil) - -(defun gnus-backlog-buffer () - "Return the backlog buffer." - (or (get-buffer gnus-backlog-buffer) - (save-excursion - (set-buffer (get-buffer-create gnus-backlog-buffer)) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) - (gnus-add-current-to-buffer-list) - (get-buffer gnus-backlog-buffer)))) - -(defun gnus-backlog-setup () - "Initialize backlog variables." - (unless gnus-backlog-hashtb - (setq gnus-backlog-hashtb (gnus-make-hashtable 1024)))) - -(gnus-add-shutdown 'gnus-backlog-shutdown 'gnus) - -(defun gnus-backlog-shutdown () - "Clear all backlog variables and buffers." - (when (get-buffer gnus-backlog-buffer) - (kill-buffer gnus-backlog-buffer)) - (setq gnus-backlog-hashtb nil - gnus-backlog-articles nil)) - -(defun gnus-backlog-enter-article (group number buffer) - (gnus-backlog-setup) - (let ((ident (intern (concat group ":" (int-to-string number)) - gnus-backlog-hashtb)) - b) - (if (memq ident gnus-backlog-articles) - () ; It's already kept. - ;; Remove the oldest article, if necessary. - (and (numberp gnus-keep-backlog) - (>= (length gnus-backlog-articles) gnus-keep-backlog) - (gnus-backlog-remove-oldest-article)) - (push ident gnus-backlog-articles) - ;; Insert the new article. - (save-excursion - (set-buffer (gnus-backlog-buffer)) - (let (buffer-read-only) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (setq b (point)) - (insert-buffer-substring buffer) - ;; Tag the beginning of the article with the ident. - (gnus-put-text-property b (1+ b) 'gnus-backlog ident)))))) - -(defun gnus-backlog-remove-oldest-article () - (save-excursion - (set-buffer (gnus-backlog-buffer)) - (goto-char (point-min)) - (if (zerop (buffer-size)) - () ; The buffer is empty. - (let ((ident (get-text-property (point) 'gnus-backlog)) - buffer-read-only) - ;; Remove the ident from the list of articles. - (when ident - (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) - ;; Delete the article itself. - (delete-region - (point) (next-single-property-change - (1+ (point)) 'gnus-backlog nil (point-max))))))) - -(defun gnus-backlog-remove-article (group number) - "Remove article NUMBER in GROUP from the backlog." - (when (numberp number) - (gnus-backlog-setup) - (let ((ident (intern (concat group ":" (int-to-string number)) - gnus-backlog-hashtb)) - beg end) - (when (memq ident gnus-backlog-articles) - ;; It was in the backlog. - (save-excursion - (set-buffer (gnus-backlog-buffer)) - (let (buffer-read-only) - (when (setq beg (text-property-any - (point-min) (point-max) 'gnus-backlog - ident)) - ;; Find the end (i. e., the beginning of the next article). - (setq end - (next-single-property-change - (1+ beg) 'gnus-backlog (current-buffer) (point-max))) - (delete-region beg end) - ;; Return success. - t)) - (setq gnus-backlog-articles (delq ident gnus-backlog-articles))))))) - -(defun gnus-backlog-request-article (group number buffer) - (when (numberp number) - (gnus-backlog-setup) - (let ((ident (intern (concat group ":" (int-to-string number)) - gnus-backlog-hashtb)) - beg end) - (when (memq ident gnus-backlog-articles) - ;; It was in the backlog. - (save-excursion - (set-buffer (gnus-backlog-buffer)) - (if (not (setq beg (text-property-any - (point-min) (point-max) 'gnus-backlog - ident))) - ;; It wasn't in the backlog after all. - (ignore - (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) - ;; Find the end (i. e., the beginning of the next article). - (setq end - (next-single-property-change - (1+ beg) 'gnus-backlog (current-buffer) (point-max))))) - (let ((buffer-read-only nil)) - (erase-buffer) - (insert-buffer-substring gnus-backlog-buffer beg end) - t))))) - -(provide 'gnus-bcklg) - -;;; gnus-bcklg.el ends here diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el deleted file mode 100644 index ea61f5d..0000000 --- a/lisp/gnus-cache.el +++ /dev/null @@ -1,666 +0,0 @@ -;;; gnus-cache.el --- cache interface for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-int) -(require 'gnus-range) -(require 'gnus-start) -(eval-when-compile - (require 'gnus-sum)) - -(defgroup gnus-cache nil - "Cache interface." - :group 'gnus) - -(defcustom gnus-cache-directory - (nnheader-concat gnus-directory "cache/") - "*The directory where cached articles will be stored." - :group 'gnus-cache - :type 'directory) - -(defcustom gnus-cache-active-file - (concat (file-name-as-directory gnus-cache-directory) "active") - "*The cache active file." - :group 'gnus-cache - :type 'file) - -(defcustom gnus-cache-enter-articles '(ticked dormant) - "*Classes of articles to enter into the cache." - :group 'gnus-cache - :type '(set (const ticked) (const dormant) (const unread) (const read))) - -(defcustom gnus-cache-remove-articles '(read) - "*Classes of articles to remove from the cache." - :group 'gnus-cache - :type '(set (const ticked) (const dormant) (const unread) (const read))) - -(defcustom gnus-uncacheable-groups nil - "*Groups that match this regexp will not be cached. - -If you want to avoid caching your nnml groups, you could set this -variable to \"^nnml\"." - :group 'gnus-cache - :type '(choice (const :tag "off" nil) - regexp)) - - - -;;; Internal variables. - -(defvar gnus-cache-removable-articles nil) -(defvar gnus-cache-buffer nil) -(defvar gnus-cache-active-hashtb nil) -(defvar gnus-cache-active-altered nil) - -(eval-and-compile - (autoload 'nnml-generate-nov-databases-1 "nnml") - (autoload 'nnvirtual-find-group-art "nnvirtual")) - - - -;;; Functions called from Gnus. - -(defun gnus-cache-open () - "Initialize the cache." - (when (or (file-exists-p gnus-cache-directory) - (and gnus-use-cache - (not (eq gnus-use-cache 'passive)))) - (gnus-cache-read-active))) - -;; Complexities of byte-compiling make this kludge necessary. Eeek. -(ignore-errors - (gnus-add-shutdown 'gnus-cache-close 'gnus)) - -(defun gnus-cache-close () - "Shut down the cache." - (gnus-cache-write-active) - (gnus-cache-save-buffers) - (setq gnus-cache-active-hashtb nil)) - -(defun gnus-cache-save-buffers () - ;; save the overview buffer if it exists and has been modified - ;; delete empty cache subdirectories - (when gnus-cache-buffer - (let ((buffer (cdr gnus-cache-buffer)) - (overview-file (gnus-cache-file-name - (car gnus-cache-buffer) ".overview"))) - ;; write the overview only if it was modified - (when (buffer-modified-p buffer) - (save-excursion - (set-buffer buffer) - (if (> (buffer-size) 0) - ;; Non-empty overview, write it to a file. - (gnus-write-buffer overview-file) - ;; Empty overview file, remove it - (when (file-exists-p overview-file) - (delete-file overview-file)) - ;; If possible, remove group's cache subdirectory. - (condition-case nil - ;; FIXME: we can detect the error type and warn the user - ;; of any inconsistencies (articles w/o nov entries?). - ;; for now, just be conservative...delete only if safe -- sj - (delete-directory (file-name-directory overview-file)) - (error nil))))) - ;; Kill the buffer -- it's either unmodified or saved. - (gnus-kill-buffer buffer) - (setq gnus-cache-buffer nil)))) - -(defun gnus-cache-possibly-enter-article - (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. - ;; If this is a virtual group, we find the real group. - (when (gnus-virtual-group-p group) - (let ((result (nnvirtual-find-group-art - (gnus-group-real-name group) article))) - (setq group (car result) - headers (copy-sequence headers)) - (mail-header-set-number headers (cdr result)))) - (let ((number (mail-header-number headers)) - file dir) - (when (and number - (> number 0) ; Reffed article. - (or force - (and (or (not gnus-uncacheable-groups) - (not (string-match - gnus-uncacheable-groups group))) - (gnus-cache-member-of-class - gnus-cache-enter-articles ticked dormant unread))) - (not (file-exists-p (setq file (gnus-cache-file-name - group number))))) - ;; Possibly create the cache directory. - (gnus-make-directory (setq dir (file-name-directory file))) - ;; Save the article in the cache. - (if (file-exists-p file) - t ; The article already is saved. - (save-excursion - (set-buffer nntp-server-buffer) - (let ((gnus-use-cache nil)) - (gnus-request-article-this-buffer number group)) - (when (> (buffer-size) 0) - (gnus-write-buffer file) - (gnus-cache-change-buffer group) - (set-buffer (cdr gnus-cache-buffer)) - (goto-char (point-max)) - (forward-line -1) - (while (condition-case () - (when (not (bobp)) - (> (read (current-buffer)) number)) - (error - ;; The line was malformed, so we just remove it!! - (gnus-delete-line) - t)) - (forward-line -1)) - (if (bobp) - (if (not (eobp)) - (progn - (beginning-of-line) - (when (< (read (current-buffer)) number) - (forward-line 1))) - (beginning-of-line)) - (forward-line 1)) - (beginning-of-line) - ;; [number subject from date id references chars lines xref] - (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n" - (mail-header-number headers) - (mail-header-subject headers) - (mail-header-from headers) - (mail-header-date headers) - (mail-header-id headers) - (or (mail-header-references headers) "") - (or (mail-header-chars headers) "") - (or (mail-header-lines headers) "") - (or (mail-header-xref headers) ""))) - ;; Update the active info. - (set-buffer gnus-summary-buffer) - (gnus-cache-update-active group number) - (push article gnus-newsgroup-cached) - (gnus-summary-update-secondary-mark article)) - t)))))) - -(defun gnus-cache-enter-remove-article (article) - "Mark ARTICLE for later possible removal." - (when article - (push article gnus-cache-removable-articles))) - -(defun gnus-cache-possibly-remove-articles () - "Possibly remove some of the removable articles." - (if (not (gnus-virtual-group-p gnus-newsgroup-name)) - (gnus-cache-possibly-remove-articles-1) - (let ((arts gnus-cache-removable-articles) - ga) - (while arts - (when (setq ga (nnvirtual-find-group-art - (gnus-group-real-name gnus-newsgroup-name) (pop arts))) - (let ((gnus-cache-removable-articles (list (cdr ga))) - (gnus-newsgroup-name (car ga))) - (gnus-cache-possibly-remove-articles-1))))) - (setq gnus-cache-removable-articles nil))) - -(defun gnus-cache-possibly-remove-articles-1 () - "Possibly remove some of the removable articles." - (unless (eq gnus-use-cache 'passive) - (let ((articles gnus-cache-removable-articles) - (cache-articles gnus-newsgroup-cached) - article) - (gnus-cache-change-buffer gnus-newsgroup-name) - (while articles - (when (memq (setq article (pop articles)) cache-articles) - ;; The article was in the cache, so we see whether we are - ;; supposed to remove it from the cache. - (gnus-cache-possibly-remove-article - article (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (or (memq article gnus-newsgroup-unreads) - (memq article gnus-newsgroup-unselected)))))) - ;; The overview file might have been modified, save it - ;; safe because we're only called at group exit anyway. - (gnus-cache-save-buffers))) - -(defun gnus-cache-request-article (article group) - "Retrieve ARTICLE in GROUP from the cache." - (let ((file (gnus-cache-file-name group article)) - (buffer-read-only nil)) - (when (file-exists-p file) - (erase-buffer) - (gnus-kill-all-overlays) - (insert-file-contents file) - t))) - -(defun gnus-cache-possibly-alter-active (group active) - "Alter the ACTIVE info for GROUP to reflect the articles in the cache." - (when gnus-cache-active-hashtb - (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) - (when cache-active - (when (< (car cache-active) (car active)) - (setcar active (car cache-active))) - (when (> (cdr cache-active) (cdr active)) - (setcdr active (cdr cache-active))))))) - -(defun gnus-cache-retrieve-headers (articles group &optional fetch-old) - "Retrieve the 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-headers articles group fetch-old)) - (let ((uncached-articles (gnus-sorted-intersection - (gnus-sorted-complement articles cached) - articles)) - (cache-file (gnus-cache-file-name group ".overview")) - type) - ;; We first retrieve all the headers that we don't have in - ;; the cache. - (let ((gnus-use-cache nil)) - (when uncached-articles - (setq type (and articles - (gnus-retrieve-headers - uncached-articles group fetch-old))))) - (gnus-cache-save-buffers) - ;; Then we insert the cached headers. - (save-excursion - (cond - ((not (file-exists-p cache-file)) - ;; There are no cached headers. - type) - ((null type) - ;; There were no uncached headers (or retrieval was - ;; unsuccessful), so we use the cached headers exclusively. - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-file-contents cache-file) - 'nov) - ((eq type 'nov) - ;; We have both cached and uncached NOV headers, so we - ;; braid them. - (gnus-cache-braid-nov group cached) - type) - (t - ;; We braid HEADs. - (gnus-cache-braid-heads group (gnus-sorted-intersection - cached articles)) - type))))))) - -(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. -Returns the list of articles entered." - (interactive "P") - (let ((articles (gnus-summary-work-articles n)) - article out) - (while (setq article (pop articles)) - (if (natnump article) - (when (gnus-cache-possibly-enter-article - gnus-newsgroup-name article - (gnus-summary-article-header article) - nil nil nil t) - (push article out)) - (gnus-message 2 "Can't cache article %d" article)) - (gnus-summary-remove-process-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) - "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." - (interactive "P") - (gnus-cache-change-buffer gnus-newsgroup-name) - (let ((articles (gnus-summary-work-articles n)) - article out) - (while articles - (setq article (pop articles)) - (when (gnus-cache-possibly-remove-article article nil nil nil t) - (push article out)) - (gnus-summary-remove-process-mark article) - (gnus-summary-update-secondary-mark article)) - (gnus-summary-next-subject 1) - (gnus-summary-position-point) - (nreverse out))) - -(defun gnus-cached-article-p (article) - "Say whether ARTICLE is cached in the current group." - (memq article gnus-newsgroup-cached)) - -(defun gnus-summary-insert-cached-articles () - "Insert all the articles cached for this group into the current buffer." - (interactive) - (let ((cached 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)))) - -(defalias 'gnus-summary-limit-include-cached - 'gnus-summary-insert-cached-articles) - -;;; Internal functions. - -(defun gnus-cache-change-buffer (group) - (and gnus-cache-buffer - ;; See if the current group's overview cache has been loaded. - (or (string= group (car gnus-cache-buffer)) - ;; Another overview cache is current, save it. - (gnus-cache-save-buffers))) - ;; if gnus-cache buffer is nil, create it - (unless gnus-cache-buffer - ;; Create cache buffer - (save-excursion - (setq gnus-cache-buffer - (cons group - (set-buffer (get-buffer-create " *gnus-cache-overview*")))) - (buffer-disable-undo (current-buffer)) - ;; Insert the contents of this group's cache overview. - (erase-buffer) - (let ((file (gnus-cache-file-name group ".overview"))) - (when (file-exists-p file) - (nnheader-insert-file-contents file))) - ;; We have a fresh (empty/just loaded) buffer, - ;; mark it as unmodified to save a redundant write later. - (set-buffer-modified-p nil)))) - -;; Return whether an article is a member of a class. -(defun gnus-cache-member-of-class (class ticked dormant unread) - (or (and ticked (memq 'ticked class)) - (and dormant (memq 'dormant class)) - (and unread (memq 'unread class)) - (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-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 ?. ?/))))) - (if (stringp article) article (int-to-string article)))) - -(defun gnus-cache-update-article (group article) - "If ARTICLE is in the cache, remove it and re-enter it." - (when (gnus-cache-possibly-remove-article article nil nil nil t) - (let ((gnus-use-cache nil)) - (gnus-cache-possibly-enter-article - gnus-newsgroup-name article (gnus-summary-article-header article) - nil nil nil t)))) - -(defun gnus-cache-possibly-remove-article (article ticked dormant unread - &optional force) - "Possibly remove ARTICLE from the cache." - (let ((group gnus-newsgroup-name) - (number article) - file) - ;; If this is a virtual group, we find the real group. - (when (gnus-virtual-group-p group) - (let ((result (nnvirtual-find-group-art - (gnus-group-real-name group) article))) - (setq group (car result) - number (cdr result)))) - (setq file (gnus-cache-file-name group number)) - (when (and (file-exists-p file) - (or force - (gnus-cache-member-of-class - gnus-cache-remove-articles ticked dormant unread))) - (save-excursion - (delete-file file) - (set-buffer (cdr gnus-cache-buffer)) - (goto-char (point-min)) - (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-summary-update-secondary-mark article) - t))) - -(defun gnus-cache-articles-in-group (group) - "Return a sorted list of cached articles in GROUP." - (let ((dir (file-name-directory (gnus-cache-file-name group 1))) - articles) - (when (file-exists-p dir) - (setq articles - (sort (mapcar (lambda (name) (string-to-int name)) - (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)))) - articles))) - -(defun gnus-cache-braid-nov (group cached &optional file) - (let ((cache-buf (get-buffer-create " *gnus-cache*")) - beg end) - (gnus-cache-save-buffers) - (save-excursion - (set-buffer cache-buf) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-file-contents (or file (gnus-cache-file-name group ".overview"))) - (goto-char (point-min)) - (insert "\n") - (goto-char (point-min))) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while cached - (while (and (not (eobp)) - (< (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))) - (when beg - (insert-buffer-substring cache-buf beg end) - (insert "\n")) - (setq cached (cdr cached))) - (kill-buffer cache-buf))) - -(defun gnus-cache-braid-heads (group cached) - (let ((cache-buf (get-buffer-create " *gnus-cache*"))) - (save-excursion - (set-buffer cache-buf) - (buffer-disable-undo (current-buffer)) - (erase-buffer)) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while cached - (while (and (not (eobp)) - (looking-at "2.. +\\([0-9]+\\) ") - (< (progn (goto-char (match-beginning 1)) - (read (current-buffer))) - (car cached))) - (search-forward "\n.\n" nil 'move)) - (beginning-of-line) - (save-excursion - (set-buffer cache-buf) - (erase-buffer) - (insert-file-contents (gnus-cache-file-name group (car cached))) - (goto-char (point-min)) - (insert "220 ") - (princ (car cached) (current-buffer)) - (insert " Article retrieved.\n") - (search-forward "\n\n" nil 'move) - (delete-region (point) (point-max)) - (forward-char -1) - (insert ".")) - (insert-buffer-substring cache-buf) - (setq cached (cdr cached))) - (kill-buffer cache-buf))) - -;;;###autoload -(defun gnus-jog-cache () - "Go through all groups and put the articles into the cache. - -Usage: -$ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" - (interactive) - (let ((gnus-mark-article-hook nil) - (gnus-expert-user t) - (nnmail-spool-file nil) - (gnus-use-dribble-file nil) - (gnus-novice-user nil) - (gnus-large-newsgroup nil)) - ;; Start Gnus. - (gnus) - ;; Go through all groups... - (gnus-group-mark-buffer) - (gnus-group-iterate nil - (lambda (group) - (let (gnus-auto-select-next) - (gnus-summary-read-group group nil t) - ;; ... and enter the articles into the cache. - (when (eq major-mode 'gnus-summary-mode) - (gnus-uu-mark-buffer) - (gnus-cache-enter-article) - (kill-buffer (current-buffer)))))))) - -(defun gnus-cache-read-active (&optional force) - "Read the cache active file." - (gnus-make-directory gnus-cache-directory) - (if (or (not (file-exists-p gnus-cache-active-file)) - (not (zerop (nth 7 (file-attributes gnus-cache-active-file)))) - force) - ;; There is no active file, so we generate one. - (gnus-cache-generate-active) - ;; We simply read the active file. - (save-excursion - (gnus-set-work-buffer) - (insert-file-contents gnus-cache-active-file) - (gnus-active-to-gnus-format - nil (setq gnus-cache-active-hashtb - (gnus-make-hashtable - (count-lines (point-min) (point-max))))) - (setq gnus-cache-active-altered nil)))) - -(defun gnus-cache-write-active (&optional force) - "Write the active hashtb to the active file." - (when (or force - (and gnus-cache-active-hashtb - gnus-cache-active-altered)) - (nnheader-temp-write gnus-cache-active-file - (mapatoms - (lambda (sym) - (when (and sym (boundp sym)) - (insert (format "%s %d %d y\n" - (symbol-name sym) (cdr (symbol-value sym)) - (car (symbol-value sym)))))) - gnus-cache-active-hashtb)) - ;; Mark the active hashtb as unaltered. - (setq gnus-cache-active-altered nil))) - -(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." - (let ((active (gnus-gethash group gnus-cache-active-hashtb))) - (if (null active) - ;; We just create a new active entry for this group. - (gnus-sethash group (cons number number) gnus-cache-active-hashtb) - ;; Update the lower or upper bound. - (if low - (setcar active number) - (setcdr active number))) - ;; Mark the active hashtb as altered. - (setq gnus-cache-active-altered t))) - -;;;###autoload -(defun gnus-cache-generate-active (&optional directory) - "Generate the cache active file." - (interactive) - (let* ((top (null directory)) - (directory (expand-file-name (or directory gnus-cache-directory))) - (files (directory-files directory 'full)) - (group - (if top - "" - (string-match - (concat "^" (file-name-as-directory - (expand-file-name gnus-cache-directory))) - (directory-file-name directory)) - (nnheader-replace-chars-in-string - (substring (directory-file-name directory) (match-end 0)) - ?/ ?.))) - nums alphs) - (when top - (gnus-message 5 "Generating the cache active file...") - (setq gnus-cache-active-hashtb (gnus-make-hashtable 123))) - ;; Separate articles from all other files and directories. - (while files - (if (string-match "^[0-9]+$" (file-name-nondirectory (car files))) - (push (string-to-int (file-name-nondirectory (pop files))) nums) - (push (pop files) alphs))) - ;; If we have nums, then this is probably a valid group. - (when (setq nums (sort nums '<)) - (gnus-sethash group (cons (car nums) (gnus-last-element nums)) - gnus-cache-active-hashtb)) - ;; Go through all the other files. - (while alphs - (when (and (file-directory-p (car alphs)) - (not (string-match "^\\.\\.?$" - (file-name-nondirectory (car alphs))))) - ;; We descend directories. - (gnus-cache-generate-active (car alphs))) - (setq alphs (cdr alphs))) - ;; Write the new active file. - (when top - (gnus-cache-write-active t) - (gnus-message 5 "Generating the cache active file...done")))) - -;;;###autoload -(defun gnus-cache-generate-nov-databases (dir) - "Generate NOV files recursively starting in DIR." - (interactive (list gnus-cache-directory)) - (gnus-cache-close) - (let ((nnml-generate-active-function 'identity)) - (nnml-generate-nov-databases-1 dir))) - -(defun gnus-cache-move-cache (dir) - "Move the cache tree to somewhere else." - (interactive "FMove the cache tree to: ") - (rename-file gnus-cache-directory dir)) - -(provide 'gnus-cache) - -;;; gnus-cache.el ends here diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el deleted file mode 100644 index 7086f8b..0000000 --- a/lisp/gnus-cite.el +++ /dev/null @@ -1,924 +0,0 @@ -;;; gnus-cite.el --- parse citations in articles for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; 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: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-art) -(require 'gnus-range) - -;;; Customization: - -(defgroup gnus-cite nil - "Citation." - :prefix "gnus-cite-" - :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-text-button-line-format "%(%{[...]%}%)\n" - "*Format of cited text buttons." - :group 'gnus-cite - :type 'string) - -(defcustom gnus-cited-lines-visible nil - "*The number of lines of hidden cited text to remain visible." - :group 'gnus-cite - :type '(choice (const :tag "none" nil) - integer)) - -(defcustom gnus-cite-parse-max-size 25000 - "*Maximum article size (in bytes) where parsing citations is allowed. -Set it to nil to parse all articles." - :group 'gnus-cite - :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 "\\)? *" - ">>>>> +\"\\([^\"\n]+\\)\" +==") - "*Regexp matching normal Supercite attribution lines. -The first grouping must match prefixes added by other packages." - :group 'gnus-cite - :type 'regexp) - -(defcustom gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +==" - "*Regexp matching mangled Supercite attribution lines. -The first regexp group should match the Supercite attribution." - :group 'gnus-cite - :type 'regexp) - -(defcustom gnus-cite-minimum-match-count 2 - "*Minimum number of identical prefixes before we believe it's a citation." - :group 'gnus-cite - :type 'integer) - -(defcustom gnus-cite-attribution-prefix - "in article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\)," - "*Regexp matching the beginning of an attribution line." - :group 'gnus-cite - :type 'regexp) - -(defcustom gnus-cite-attribution-suffix - "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\)[ \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) - -(defface gnus-cite-attribution-face '((t - (:underline t))) - "Face used for attribution lines.") - -(defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face - "*Face used for attribution lines. -It is merged with the face for the cited text belonging to the attribution." - :group 'gnus-cite - :type 'face) - -(defface gnus-cite-face-1 '((((class color) - (background dark)) - (:foreground "light blue")) - (((class color) - (background light)) - (:foreground "MidnightBlue")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-2 '((((class color) - (background dark)) - (:foreground "light cyan")) - (((class color) - (background light)) - (:foreground "firebrick")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-3 '((((class color) - (background dark)) - (:foreground "light yellow")) - (((class color) - (background light)) - (:foreground "dark green")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-4 '((((class color) - (background dark)) - (:foreground "light pink")) - (((class color) - (background light)) - (:foreground "OrangeRed")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-5 '((((class color) - (background dark)) - (:foreground "pale green")) - (((class color) - (background light)) - (:foreground "dark khaki")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-6 '((((class color) - (background dark)) - (:foreground "beige")) - (((class color) - (background light)) - (:foreground "dark violet")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-7 '((((class color) - (background dark)) - (:foreground "orange")) - (((class color) - (background light)) - (:foreground "SteelBlue4")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-8 '((((class color) - (background dark)) - (:foreground "magenta")) - (((class color) - (background light)) - (:foreground "magenta")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-9 '((((class color) - (background dark)) - (:foreground "violet")) - (((class color) - (background light)) - (:foreground "violet")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-10 '((((class color) - (background dark)) - (:foreground "medium purple")) - (((class color) - (background light)) - (:foreground "medium purple")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-11 '((((class color) - (background dark)) - (:foreground "turquoise")) - (((class color) - (background light)) - (:foreground "turquoise")) - (t - (:italic t))) - "Citation face.") - -(defcustom gnus-cite-face-list - '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4 - gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8 - gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11) - "*List of faces used for highlighting citations. - -When there are citations from multiple articles in the same message, -Gnus will try to give each citation from each article its own face. -This should make it easier to see who wrote what." - :group 'gnus-cite - :type '(repeat face)) - -(defcustom gnus-cite-hide-percentage 50 - "*Only hide excess citation if above this percentage of the body." - :group 'gnus-cite - :type 'number) - -(defcustom gnus-cite-hide-absolute 10 - "*Only hide excess citation if above this number of lines in the body." - :group 'gnus-cite - :type 'integer) - -;;; Internal Variables: - -(defvar gnus-cite-article nil) -(defvar gnus-cite-overlay-list nil) - -(defvar gnus-cite-prefix-alist nil) -;; Alist of citation prefixes. -;; The cdr is a list of lines with that prefix. - -(defvar gnus-cite-attribution-alist nil) -;; Alist of attribution lines. -;; The car is a line number. -;; The cdr is the prefix for the citation started by that line. - -(defvar gnus-cite-loose-prefix-alist nil) -;; Alist of citation prefixes that have no matching attribution. -;; The cdr is a list of lines with that prefix. - -(defvar gnus-cite-loose-attribution-alist nil) -;; Alist of attribution lines that have no matching citation. -;; Each member has the form (WROTE IN PREFIX TAG), where -;; WROTE: is the attribution line number -;; IN: is the line number of the previous line if part of the same attribution, -;; PREFIX: Is the citation prefix of the attribution line(s), and -;; TAG: Is a Supercite tag, if any. - -(defvar gnus-cited-text-button-line-format-alist - `((?b (marker-position beg) ?d) - (?e (marker-position end) ?d) - (?l (- end beg) ?d))) -(defvar gnus-cited-text-button-line-format-spec nil) - -;;; Commands: - -(defun gnus-article-highlight-citation (&optional force) - "Highlight cited text. -Each citation in the article will be highlighted with a different face. -The faces are taken from `gnus-cite-face-list'. -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 matching `gnus-cite-attribution-suffix' and perhaps -`gnus-cite-attribution-prefix' are considered attribution lines." - (interactive (list 'force)) - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe force) - (let ((buffer-read-only nil) - (alist gnus-cite-prefix-alist) - (faces gnus-cite-face-list) - (inhibit-point-motion-hooks t) - face entry prefix skip numbers number face-alist) - ;; Loop through citation prefixes. - (while alist - (setq entry (car alist) - alist (cdr alist) - prefix (car entry) - numbers (cdr entry) - face (car faces) - faces (or (cdr faces) gnus-cite-face-list) - face-alist (cons (cons prefix face) face-alist)) - (while numbers - (setq number (car numbers) - numbers (cdr numbers)) - (and (not (assq number gnus-cite-attribution-alist)) - (not (assq number gnus-cite-loose-attribution-alist)) - (gnus-cite-add-face number prefix face)))) - ;; Loop through attribution lines. - (setq alist gnus-cite-attribution-alist) - (while alist - (setq entry (car alist) - alist (cdr alist) - number (car entry) - prefix (cdr entry) - skip (gnus-cite-find-prefix number) - face (cdr (assoc prefix face-alist))) - ;; Add attribution button. - (goto-line number) - (when (re-search-forward gnus-cite-attribution-suffix - (save-excursion (end-of-line 1) (point)) - t) - (gnus-article-add-button (match-beginning 1) (match-end 1) - 'gnus-cite-toggle prefix)) - ;; Highlight attribution line. - (gnus-cite-add-face number skip face) - (gnus-cite-add-face number skip gnus-cite-attribution-face)) - ;; Loop through attribution lines. - (setq alist gnus-cite-loose-attribution-alist) - (while alist - (setq entry (car alist) - alist (cdr alist) - number (car entry) - skip (gnus-cite-find-prefix number)) - (gnus-cite-add-face number skip gnus-cite-attribution-face))))) - -(defun gnus-dissect-cited-text () - "Dissect the article buffer looking for cited text." - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe) - (let ((alist gnus-cite-prefix-alist) - prefix numbers number marks m) - ;; Loop through citation prefixes. - (while alist - (setq numbers (pop alist) - prefix (pop numbers)) - (while numbers - (setq number (pop numbers)) - (goto-char (point-min)) - (forward-line number) - (push (cons (point-marker) "") marks) - (while (and numbers - (= (1- number) (car numbers))) - (setq number (pop numbers))) - (goto-char (point-min)) - (forward-line (1- number)) - (push (cons (point-marker) prefix) marks))) - ;; Skip to the beginning of the body. - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (push (cons (point-marker) "") marks) - ;; Find the end of the body. - (goto-char (point-max)) - (gnus-article-search-signature) - (push (cons (point-marker) "") marks) - ;; Sort the marks. - (setq marks (sort marks 'car-less-than-car)) - (let ((omarks marks)) - (setq marks nil) - (while (cdr omarks) - (if (= (caar omarks) (caadr omarks)) - (progn - (unless (equal (cdar omarks) "") - (push (car omarks) marks)) - (unless (equal (cdadr omarks) "") - (push (cadr omarks) marks)) - (unless (and (equal (cdar omarks) "") - (equal (cdadr omarks) "") - (not (cddr omarks))) - (setq omarks (cdr omarks)))) - (push (car omarks) marks)) - (setq omarks (cdr omarks))) - (when (car omarks) - (push (car omarks) marks)) - (setq marks (setq m (nreverse marks))) - (while (cddr m) - (if (and (equal (cdadr m) "") - (equal (cdar m) (cdaddr m)) - (goto-char (caadr m)) - (forward-line 1) - (= (point) (caaddr m))) - (setcdr m (cdddr m)) - (setq m (cdr m)))) - marks)))) - -(defun gnus-article-fill-cited-article (&optional force width) - "Do word wrapping in the current article. -If WIDTH (the numerical prefix), use that text width when filling." - (interactive (list t current-prefix-arg)) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (marks (gnus-dissect-cited-text)) - (adaptive-fill-mode nil) - (filladapt-mode nil) - (fill-column (if width (prefix-numeric-value width) fill-column))) - (save-restriction - (while (cdr marks) - (widen) - (narrow-to-region (caar marks) (caadr marks)) - (let ((adaptive-fill-regexp - (concat "^" (regexp-quote (cdar marks)) " *")) - (fill-prefix (cdar marks))) - (fill-region (point-min) (point-max))) - (set-marker (caar marks) nil) - (setq marks (cdr marks))) - (when marks - (set-marker (caar marks) nil)) - ;; All this information is now incorrect. - (setq gnus-cite-prefix-alist nil - gnus-cite-attribution-alist nil - gnus-cite-loose-prefix-alist nil - gnus-cite-loose-attribution-alist nil - gnus-cite-article nil))))) - -(defun gnus-article-hide-citation (&optional arg force) - "Toggle hiding of all cited text except attribution lines. -See the documentation for `gnus-article-highlight-citation'. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (append (gnus-article-hidden-arg) (list 'force))) - (gnus-set-format 'cited-text-button t) - (save-excursion - (set-buffer gnus-article-buffer) - (cond - ((gnus-article-check-hidden-text 'cite arg) - t) - ((gnus-article-text-type-exists-p 'cite) - (let ((buffer-read-only nil)) - (gnus-article-hide-text-of-type 'cite))) - (t - (let ((buffer-read-only nil) - (marks (gnus-dissect-cited-text)) - (inhibit-point-motion-hooks t) - (props (nconc (list 'article-type 'cite) - gnus-hidden-properties)) - beg end) - (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 gnus-cited-lines-visible) - (if (>= (point) end) - (setq beg nil) - (setq beg (point-marker)))) - (when (and beg end) - (gnus-add-text-properties beg end props) - (goto-char beg) - (unless (save-excursion (search-backward "\n\n" nil t)) - (insert "\n")) - (put-text-property - (point) - (progn - (gnus-article-add-button - (point) - (progn (eval gnus-cited-text-button-line-format-spec) (point)) - `gnus-article-toggle-cited-text (cons beg end)) - (point)) - 'article-type 'annotation) - (set-marker beg (point))))))))) - -(defun gnus-article-toggle-cited-text (region) - "Toggle hiding the text in REGION." - (let (buffer-read-only) - (funcall - (if (text-property-any - (car region) (1- (cdr region)) - (car gnus-hidden-properties) (cadr gnus-hidden-properties)) - 'remove-text-properties 'gnus-add-text-properties) - (car region) (cdr region) gnus-hidden-properties))) - -(defun gnus-article-hide-citation-maybe (&optional arg force) - "Toggle hiding of cited text that has an attribution line. -If given a negative prefix, always show; if given a positive prefix, -always hide. -This will do nothing unless at least `gnus-cite-hide-percentage' -percent and at least `gnus-cite-hide-absolute' lines of the body is -cited text with attributions. When called interactively, these two -variables are ignored. -See also the documentation for `gnus-article-highlight-citation'." - (interactive (append (gnus-article-hidden-arg) (list 'force))) - (unless (gnus-article-check-hidden-text 'cite arg) - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe force) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (let ((start (point)) - (atts gnus-cite-attribution-alist) - (buffer-read-only nil) - (inhibit-point-motion-hooks t) - (hiden 0) - total) - (goto-char (point-max)) - (gnus-article-search-signature) - (setq total (count-lines start (point))) - (while atts - (setq hiden (+ hiden (length (cdr (assoc (cdar atts) - gnus-cite-prefix-alist)))) - atts (cdr atts))) - (when (or force - (and (> (* 100 hiden) (* gnus-cite-hide-percentage total)) - (> hiden gnus-cite-hide-absolute))) - (setq atts gnus-cite-attribution-alist) - (while atts - (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist)) - atts (cdr atts)) - (while total - (setq hiden (car total) - total (cdr total)) - (goto-line hiden) - (unless (assq hiden gnus-cite-attribution-alist) - (gnus-add-text-properties - (point) (progn (forward-line 1) (point)) - (nconc (list 'article-type 'cite) - gnus-hidden-properties)))))))))) - -(defun gnus-article-hide-citation-in-followups () - "Hide cited text in non-root articles." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((article (cdr gnus-article-current))) - (unless (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-article-displayed-root-p article)) - (gnus-article-hide-citation))))) - -;;; Internal functions: - -(defun gnus-cite-parse-maybe (&optional force) - ;; Parse if the buffer has changes since last time. - (if (and (not force) - (equal gnus-cite-article gnus-article-current)) - () - (gnus-cite-localize) - ;;Reset parser information. - (setq gnus-cite-prefix-alist nil - gnus-cite-attribution-alist nil - gnus-cite-loose-prefix-alist nil - gnus-cite-loose-attribution-alist nil) - (while gnus-cite-overlay-list - (gnus-delete-overlay (pop gnus-cite-overlay-list))) - ;; Parse if not too large. - (if (and (not force) - gnus-cite-parse-max-size - (> (buffer-size) gnus-cite-parse-max-size)) - () - (setq gnus-cite-article (cons (car gnus-article-current) - (cdr gnus-article-current))) - (gnus-cite-parse-wrapper)))) - -(defun gnus-cite-parse-wrapper () - ;; Wrap chopped gnus-cite-parse - (goto-char (point-min)) - (unless (search-forward "\n\n" nil t) - (goto-char (point-max))) - (save-excursion - (gnus-cite-parse-attributions)) - ;; Try to avoid check citation if there is no reason to believe - ;; that article has citations - (if (or gnus-cite-always-check - (save-excursion - (re-search-backward gnus-cite-reply-regexp nil t)) - gnus-cite-loose-attribution-alist) - (progn (save-excursion - (gnus-cite-parse)) - (save-excursion - (gnus-cite-connect-attributions))))) - -(defun gnus-cite-parse () - ;; Parse and connect citation prefixes and attribution lines. - - ;; Parse current buffer searching for citation prefixes. - (let ((line (1+ (count-lines (point-min) (point)))) - (case-fold-search t) - (max (save-excursion - (goto-char (point-max)) - (gnus-article-search-signature) - (point))) - alist entry start begin end numbers prefix) - ;; Get all potential prefixes in `alist'. - (while (< (point) max) - ;; Each line. - (setq begin (point) - end (progn (beginning-of-line 2) (point)) - start end) - (goto-char begin) - ;; Ignore standard Supercite attribution prefix. - (when (looking-at gnus-supercite-regexp) - (if (match-end 1) - (setq end (1+ (match-end 1))) - (setq end (1+ begin)))) - ;; Ignore very long prefixes. - (when (> end (+ (point) gnus-cite-max-prefix)) - (setq end (+ (point) gnus-cite-max-prefix))) - (while (re-search-forward gnus-cite-prefix-regexp (1- end) t) - ;; Each prefix. - (setq end (match-end 0) - prefix (buffer-substring begin end)) - (gnus-set-text-properties 0 (length prefix) nil prefix) - (setq entry (assoc prefix alist)) - (if entry - (setcdr entry (cons line (cdr entry))) - (push (list prefix line) alist)) - (goto-char begin)) - (goto-char start) - (setq line (1+ line))) - ;; 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 - ;; times. First sort them by length. Longer is older. - (setq alist (sort alist (lambda (a b) - (> (length (car a)) (length (car b)))))) - (while alist - (setq entry (car alist) - prefix (car entry) - numbers (cdr entry) - alist (cdr alist)) - (cond ((null numbers) - ;; No lines with this prefix that wasn't also part of - ;; a longer prefix. - ) - ((< (length numbers) gnus-cite-minimum-match-count) - ;; Too few lines with this prefix. We keep it a bit - ;; longer in case it is an exact match for an attribution - ;; line, but we don't remove the line from other - ;; prefixes. - (push entry gnus-cite-prefix-alist)) - (t - (push entry - gnus-cite-prefix-alist) - ;; Remove articles from other prefixes. - (let ((loop alist) - current) - (while loop - (setq current (car loop) - loop (cdr loop)) - (setcdr current - (gnus-set-difference (cdr current) numbers))))))))) - -(defun gnus-cite-parse-attributions () - (let (al-alist) - ;; Parse attributions - (while (re-search-forward gnus-cite-attribution-suffix (point-max) t) - (let* ((start (match-beginning 0)) - (end (match-end 0)) - (wrote (count-lines (point-min) end)) - (prefix (gnus-cite-find-prefix wrote)) - ;; Check previous line for an attribution leader. - (tag (progn - (beginning-of-line 1) - (when (looking-at gnus-supercite-secondary-regexp) - (buffer-substring (match-beginning 1) - (match-end 1))))) - (in (progn - (goto-char start) - (and (re-search-backward gnus-cite-attribution-prefix - (save-excursion - (beginning-of-line 0) - (point)) - t) - (not (re-search-forward gnus-cite-attribution-suffix - start t)) - (count-lines (point-min) (1+ (point))))))) - (when (eq wrote in) - (setq in nil)) - (goto-char end) - ;; don't add duplicates - (let ((al (buffer-substring (save-excursion (beginning-of-line 0) - (1+ (point))) - end))) - (if (not (assoc al al-alist)) - (progn - (push (list wrote in prefix tag) - gnus-cite-loose-attribution-alist) - (push (cons al t) al-alist)))))))) - -(defun gnus-cite-connect-attributions () - ;; Connect attributions to citations - - ;; No citations have been connected to attribution lines yet. - (setq gnus-cite-loose-prefix-alist (append gnus-cite-prefix-alist nil)) - - ;; Parse current buffer searching for attribution lines. - ;; Find exact supercite citations. - (gnus-cite-match-attributions 'small nil - (lambda (prefix tag) - (when tag - (concat "\\`" - (regexp-quote prefix) "[ \t]*" - (regexp-quote tag) ">")))) - ;; Find loose supercite citations after attributions. - (gnus-cite-match-attributions 'small t - (lambda (prefix tag) - (when tag - (concat "\\<" - (regexp-quote tag) - "\\>")))) - ;; Find loose supercite citations anywhere. - (gnus-cite-match-attributions 'small nil - (lambda (prefix tag) - (when tag - (concat "\\<" - (regexp-quote tag) - "\\>")))) - ;; Find nested citations after attributions. - (gnus-cite-match-attributions 'small-if-unique t - (lambda (prefix tag) - (concat "\\`" (regexp-quote prefix) ".+"))) - ;; Find nested citations anywhere. - (gnus-cite-match-attributions 'small nil - (lambda (prefix tag) - (concat "\\`" (regexp-quote prefix) ".+"))) - ;; Remove loose prefixes with too few lines. - (let ((alist gnus-cite-loose-prefix-alist) - entry) - (while alist - (setq entry (car alist) - alist (cdr alist)) - (when (< (length (cdr entry)) gnus-cite-minimum-match-count) - (setq gnus-cite-prefix-alist - (delq entry gnus-cite-prefix-alist) - gnus-cite-loose-prefix-alist - (delq entry gnus-cite-loose-prefix-alist))))) - ;; Find flat attributions. - (gnus-cite-match-attributions 'first t nil) - ;; Find any attributions (are we getting desperate yet?). - (gnus-cite-match-attributions 'first nil nil)) - -(defun gnus-cite-match-attributions (sort after fun) - ;; Match all loose attributions and citations (SORT AFTER FUN) . - ;; - ;; If SORT is `small', the citation with the shortest prefix will be - ;; used, if it is `first' the first prefix will be used, if it is - ;; `small-if-unique' the shortest prefix will be used if the - ;; attribution line does not share its own prefix with other - ;; loose attribution lines, otherwise the first prefix will be used. - ;; - ;; If AFTER is non-nil, only citations after the attribution line - ;; will be considered. - ;; - ;; If FUN is non-nil, it will be called with the arguments (WROTE - ;; PREFIX TAG) and expected to return a regular expression. Only - ;; citations whose prefix matches the regular expression will be - ;; considered. - ;; - ;; WROTE is the attribution line number. - ;; PREFIX is the attribution line prefix. - ;; TAG is the Supercite tag on the attribution line. - (let ((atts gnus-cite-loose-attribution-alist) - (case-fold-search t) - att wrote in prefix tag regexp limit smallest best size) - (while atts - (setq att (car atts) - atts (cdr atts) - wrote (nth 0 att) - in (nth 1 att) - prefix (nth 2 att) - tag (nth 3 att) - regexp (if fun (funcall fun prefix tag) "") - size (cond ((eq sort 'small) t) - ((eq sort 'first) nil) - (t (< (length (gnus-cite-find-loose prefix)) 2))) - limit (if after wrote -1) - smallest 1000000 - best nil) - (let ((cites gnus-cite-loose-prefix-alist) - cite candidate numbers first compare) - (while cites - (setq cite (car cites) - cites (cdr cites) - candidate (car cite) - numbers (cdr cite) - first (apply 'min numbers) - compare (if size (length candidate) first)) - (and (> first limit) - regexp - (string-match regexp candidate) - (< compare smallest) - (setq best cite - smallest compare)))) - (if (null best) - () - (setq gnus-cite-loose-attribution-alist - (delq att gnus-cite-loose-attribution-alist)) - (push (cons wrote (car best)) gnus-cite-attribution-alist) - (when in - (push (cons in (car best)) gnus-cite-attribution-alist)) - (when (memq best gnus-cite-loose-prefix-alist) - (let ((loop gnus-cite-prefix-alist) - (numbers (cdr best)) - current) - (setq gnus-cite-loose-prefix-alist - (delq best gnus-cite-loose-prefix-alist)) - (while loop - (setq current (car loop) - loop (cdr loop)) - (if (eq current best) - () - (setcdr current (gnus-set-difference (cdr current) numbers)) - (when (null (cdr current)) - (setq gnus-cite-loose-prefix-alist - (delq current gnus-cite-loose-prefix-alist) - atts (delq current atts))))))))))) - -(defun gnus-cite-find-loose (prefix) - ;; Return a list of loose attribution lines prefixed by PREFIX. - (let* ((atts gnus-cite-loose-attribution-alist) - att line lines) - (while atts - (setq att (car atts) - line (car att) - atts (cdr atts)) - (when (string-equal (gnus-cite-find-prefix line) prefix) - (push line lines))) - lines)) - -(defun gnus-cite-add-face (number prefix face) - ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. - (when face - (let ((inhibit-point-motion-hooks t) - from to overlay) - (goto-line number) - (unless (eobp) ; Sometimes things become confused. - (forward-char (length prefix)) - (skip-chars-forward " \t") - (setq from (point)) - (end-of-line 1) - (skip-chars-backward " \t") - (setq to (point)) - (when (< from to) - (push (setq overlay (gnus-make-overlay from to)) - gnus-cite-overlay-list) - (gnus-overlay-put overlay 'face face)))))) - -(defun gnus-cite-toggle (prefix) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (numbers (cdr (assoc prefix gnus-cite-prefix-alist))) - (inhibit-point-motion-hooks t) - number) - (while numbers - (setq number (car numbers) - numbers (cdr numbers)) - (goto-line number) - (cond ((get-text-property (point) 'invisible) - (remove-text-properties (point) (progn (forward-line 1) (point)) - gnus-hidden-properties)) - ((assq number gnus-cite-attribution-alist)) - (t - (gnus-add-text-properties - (point) (progn (forward-line 1) (point)) - (nconc (list 'article-type 'cite) - gnus-hidden-properties)))))))) - -(defun gnus-cite-find-prefix (line) - ;; Return citation prefix for LINE. - (let ((alist gnus-cite-prefix-alist) - (prefix "") - entry) - (while alist - (setq entry (car alist) - alist (cdr alist)) - (when (memq line (cdr entry)) - (setq prefix (car entry)))) - prefix)) - -(defun gnus-cite-localize () - "Make the citation variables local to the article buffer." - (let ((vars '(gnus-cite-article - gnus-cite-overlay-list gnus-cite-prefix-alist - gnus-cite-attribution-alist gnus-cite-loose-prefix-alist - gnus-cite-loose-attribution-alist))) - (while vars - (make-local-variable (pop vars))))) - -(gnus-ems-redefine) - -(provide 'gnus-cite) - -;;; gnus-cite.el ends here diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el deleted file mode 100644 index 4416895..0000000 --- a/lisp/gnus-cus.el +++ /dev/null @@ -1,654 +0,0 @@ -;;; gnus-cus.el --- customization commands for Gnus -;; -;; Copyright (C) 1996 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'wid-edit) -(require 'gnus-score) - -;;; 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. - -The following commands are available: - -\\[widget-forward] Move to next button or editable field. -\\[widget-backward] Move to previous button or editable field. -\\[widget-button-click] Activate button under the mouse pointer. -\\[widget-button-press] Activate button under point. - -Entry to this mode calls the value of `gnus-custom-mode-hook' -if that value is non-nil." - (kill-all-local-variables) - (setq major-mode 'gnus-custom-mode - mode-name "Gnus Customize") - (use-local-map widget-keymap) - (gnus-run-hooks 'gnus-custom-mode-hook)) - -;;; 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.") - - (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'.") - - (broken-reply-to (const :tag "Broken Reply To" t) "\ -Ignore `Reply-To' headers in this group. - -That can be useful if you're reading a mailing list group where the -listserv has inserted `Reply-To' headers that point back to the -listserv itself. This is broken behavior. So there!") - - (to-group (string :tag "To Group") "\ -All posts will be send to the specified group.") - - (gcc-self (choice :tag "GCC" - :value t - (const t) - (const none) - (string :format "%v" :hide-front-space t)) "\ -Specify default value for GCC header. - -If this symbol is present in the group parameter list and set to `t', -new composed messages will be `Gcc''d to the current group. If it is -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).") - - (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) - (const immediate) - (number :hide-front-space t - :format "%v")) "\ -When to expire. - -Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function' -when expiring expirable messages. The value can either be a number of -days (not necessarily an integer) or the symbols `never' or -`immediate'.") - - (score-file (file :tag "Score File") "\ -Make the specified file into the current score file. -This means that all score commands you issue will end up in this file.") - - (adapt-file (file :tag "Adapt File") "\ -Make the specified file into the current adaptive file. -All adaptive score entries will be put into this file.") - - (admin-address (gnus-email-address :tag "Admin Address") "\ -Administration address for a mailing list. - -When unsubscribing to a mailing list you should never send the -unsubscription notice to the mailing list itself. Instead, you'd -send messages to the administrative address. This parameter allows -you to put the admin address somewhere convenient.") - - (display (choice :tag "Display" - :value default - (const all) - (const default)) "\ -Which articles to display on entering the group. - -`all' - Display all articles, both read and unread. - -`default' - Display the default visible articles, which normally includes - unread and ticked articles.") - - (comment (string :tag "Comment") "\ -An arbitrary comment on the group.") - - (visible (const :tag "Permanently visible" t) "\ -Always display this group, even when there are no unread articles -in it..")) - "Alist of valid group 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) - -(defun gnus-group-customize (group &optional part) - "Edit the group on the current line." - (interactive (list (gnus-group-group-name))) - (let ((part (or part 'info)) - info - (types (mapcar (lambda (entry) - `(cons :format "%v%h\n" - :doc ,(nth 2 entry) - (const :format "" ,(nth 0 entry)) - ,(nth 1 entry))) - gnus-group-parameters))) - (unless group - (error "No group on current line")) - (unless (setq info (gnus-get-info group)) - (error "Killed group; can't be edited")) - ;; Ready. - (kill-buffer (get-buffer-create "*Gnus Customize*")) - (switch-to-buffer (get-buffer-create "*Gnus Customize*")) - (gnus-custom-mode) - (make-local-variable 'gnus-custom-group) - (setq gnus-custom-group group) - (widget-insert "Customize the ") - (widget-create 'info-link - :help-echo "Push me to learn more." - :tag "group parameters" - "(gnus)Group Parameters") - (widget-insert " for <") - (widget-insert group) - (widget-insert "> and press ") - (widget-create 'push-button - :tag "done" - :help-echo "Push me when done customizing." - :action 'gnus-group-customize-done) - (widget-insert ".\n\n") - (make-local-variable 'gnus-custom-params) - (setq gnus-custom-params - (widget-create 'group - :value (gnus-info-params info) - `(set :inline t - :greedy t - :tag "Parameters" - :format "%t:\n%h%v" - :doc "\ -These special paramerters are recognized by Gnus. -Check the [ ] for the parameters you want to apply to this group, then -edit the value to suit your taste." - ,@types) - '(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. - -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?" - (group :value (nil nil) - (symbol :tag "Variable") - (sexp :tag - "Value"))) - - '(repeat :inline t - :tag "Unknown entries" - sexp))) - (widget-insert "\n\nYou can also edit the ") - (widget-create 'info-link - :tag "select method" - :help-echo "Push me to learn more about select methods." - "(gnus)Select Methods") - (widget-insert " for the group.\n") - (setq gnus-custom-method - (widget-create 'sexp - :tag "Method" - :value (gnus-info-method info))) - (use-local-map widget-keymap) - (widget-setup))) - -(defun gnus-group-customize-done (&rest ignore) - "Apply changes and bury the buffer." - (interactive) - (gnus-group-edit-group-done 'params gnus-custom-group - (widget-value gnus-custom-params)) - (gnus-group-edit-group-done 'method gnus-custom-group - (widget-value gnus-custom-method)) - (bury-buffer)) - -;;; Score Customization: - -(defconst gnus-score-parameters - '((mark (number :tag "Mark") "\ -The value of this entry should be a number. -Any articles with a score lower than this number will be marked as read.") - - (expunge (number :tag "Expunge") "\ -The value of this entry should be a number. -Any articles with a score lower than this number will be removed from -the summary buffer.") - - (mark-and-expunge (number :tag "Mark-and-expunge") "\ -The value of this entry should be a number. -Any articles with a score lower than this number will be marked as -read and removed from the summary buffer.") - - (thread-mark-and-expunge (number :tag "Thread-mark-and-expunge") "\ -The value of this entry should be a number. -All articles that belong to a thread that has a total score below this -number will be marked as read and removed from the summary buffer. -`gnus-thread-score-function' says how to compute the total score -for a thread.") - - (files (repeat :inline t :tag "Files" file) "\ -The value of this entry should be any number of file names. -These files are assumed to be score files as well, and will be loaded -the same way this one was.") - - (exclude-files (repeat :inline t :tag "Exclude-files" file) "\ -The clue of this entry should be any number of files. -These files will not be loaded, even though they would normally be so, -for some reason or other.") - - (eval (sexp :tag "Eval" :value nil) "\ -The value of this entry will be `eval'el. -This element will be ignored when handling global score files.") - - (read-only (boolean :tag "Read-only" :value t) "\ -Read-only score files will not be updated or saved. -Global score files should feature this atom.") - - (orphan (number :tag "Orphan") "\ -The value of this entry should be a number. -Articles that do not have parents will get this number added to their -scores. Imagine you follow some high-volume newsgroup, like -`comp.lang.c'. Most likely you will only follow a few of the threads, -also want to see any new threads. - -You can do this with the following two score file entries: - - (orphan -500) - (mark-and-expunge -100) - -When you enter the group the first time, you will only see the new -threads. You then raise the score of the threads that you find -interesting (with `I T' or `I S'), and ignore (`C y') the rest. -Next time you enter the group, you will see new articles in the -interesting threads, plus any new threads. - -I.e.---the orphan score atom is for high-volume groups where there -exist a few interesting threads which can't be found automatically -by ordinary scoring rules.") - - (adapt (choice :tag "Adapt" - (const t) - (const ignore) - (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 -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 -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 -want adaptive scoring. If you only want adaptive scoring in a few -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") "\ -All adaptive score entries will go to the file named by this entry. -It will also be applied when entering the group. This atom might -be handy if you want to adapt on several groups at once, using the -same adaptive file for a number of groups.") - - (local (repeat :tag "Local" - (group :value (nil nil) - (symbol :tag "Variable") - (sexp :tag "Value"))) "\ -The value of this entry should be a list of `(VAR VALUE)' pairs. -Each VAR will be made buffer-local to the current summary buffer, -and set to the value specified. This is a convenient, if somewhat -strange, way of setting variables in some groups if you don't like -hooks much.") - (touched (sexp :format "Touched\n") "Internal variable.")) - "Alist of valid symbolic score 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.") - -(define-widget 'gnus-score-string 'group - "Edit score entries for string-valued headers." - :convert-widget 'gnus-score-string-convert) - -(defun gnus-score-string-convert (widget) - ;; Set args appropriately. - (let* ((tag (widget-get widget :tag)) - (item `(const :format "" :value ,(downcase tag))) - (match '(string :tag "Match")) - (score '(choice :tag "Score" - (const :tag "default" nil) - (integer :format "%v" - :hide-front-space t))) - (expire '(choice :tag "Expire" - (const :tag "off" nil) - (integer :format "%v" - :hide-front-space t))) - (type '(choice :tag "Type" - :value s - ;; I should really create a forgiving :match - ;; function for each type below, that only - ;; looked at the first letter. - (const :tag "Regexp" r) - (const :tag "Regexp (fixed case)" R) - (const :tag "Substring" s) - (const :tag "Substring (fixed case)" S) - (const :tag "Exact" e) - (const :tag "Exact (fixed case)" E) - (const :tag "Word" w) - (const :tag "Word (fixed case)" W) - (const :tag "default" nil))) - (group `(group ,match ,score ,expire ,type)) - (doc (concat (or (widget-get widget :doc) - (concat "Change score based on the " tag - " header.\n")) - " -You can have an arbitrary number of score entries for this header, -each score entry has four elements: - -1. The \"match element\". This should be the string to look for in the - header. - -2. The \"score element\". This number should be an integer in the - neginf to posinf interval. This number is added to the score - of the article if the match is successful. If this element is - not present, the `gnus-score-interactive-default-score' number - will be used instead. This is 1000 by default. - -3. The \"date element\". This date says when the last time this score - entry matched, which provides a mechanism for expiring the - score entries. It this element is not present, the score - entry is permanent. The date is represented by the number of - days since December 31, 1 ce. - -4. The \"type element\". This element specifies what function should - be used to see whether this score entry matches the article. - - There are the regexp, as well as substring types, and exact match, - and word match types. If this element is not present, Gnus will - assume that substring matching should be used. There is case - sensitive variants of all match types."))) - (widget-put widget :args `(,item - (repeat :inline t - :indent 0 - :tag ,tag - :doc ,doc - :format "%t:\n%h%v%i\n\n" - (choice :format "%v" - :value ("" nil nil s) - ,group - sexp))))) - widget) - -(define-widget 'gnus-score-integer 'group - "Edit score entries for integer-valued headers." - :convert-widget 'gnus-score-integer-convert) - -(defun gnus-score-integer-convert (widget) - ;; Set args appropriately. - (let* ((tag (widget-get widget :tag)) - (item `(const :format "" :value ,(downcase tag))) - (match '(integer :tag "Match")) - (score '(choice :tag "Score" - (const :tag "default" nil) - (integer :format "%v" - :hide-front-space t))) - (expire '(choice :tag "Expire" - (const :tag "off" nil) - (integer :format "%v" - :hide-front-space t))) - (type '(choice :tag "Type" - :value < - (const <) - (const >) - (const =) - (const >=) - (const <=))) - (group `(group ,match ,score ,expire ,type)) - (doc (concat (or (widget-get widget :doc) - (concat "Change score based on the " tag - " header."))))) - (widget-put widget :args `(,item - (repeat :inline t - :indent 0 - :tag ,tag - :doc ,doc - :format "%t:\n%h%v%i\n\n" - ,group)))) - widget) - -(define-widget 'gnus-score-date 'group - "Edit score entries for date-valued headers." - :convert-widget 'gnus-score-date-convert) - -(defun gnus-score-date-convert (widget) - ;; Set args appropriately. - (let* ((tag (widget-get widget :tag)) - (item `(const :format "" :value ,(downcase tag))) - (match '(string :tag "Match")) - (score '(choice :tag "Score" - (const :tag "default" nil) - (integer :format "%v" - :hide-front-space t))) - (expire '(choice :tag "Expire" - (const :tag "off" nil) - (integer :format "%v" - :hide-front-space t))) - (type '(choice :tag "Type" - :value regexp - (const regexp) - (const before) - (const at) - (const after))) - (group `(group ,match ,score ,expire ,type)) - (doc (concat (or (widget-get widget :doc) - (concat "Change score based on the " tag - " header.")) - " -For the Date header we have three kinda silly match types: `before', -`at' and `after'. I can't really imagine this ever being useful, but, -like, it would feel kinda silly not to provide this function. Just in -case. You never know. Better safe than sorry. Once burnt, twice -shy. Don't judge a book by its cover. Never not have sex on a first -date. (I have been told that at least one person, and I quote, -\"found this function indispensable\", however.) - -A more useful match type is `regexp'. With it, you can match the date -string using a regular expression. The date is normalized to ISO8601 -compact format first---`YYYYMMDDTHHMMSS'. If you want to match all -articles that have been posted on April 1st in every year, you could -use `....0401.........' as a match string, for instance. (Note that -the date is kept in its original time zone, so this will match -articles that were posted when it was April 1st where the article was -posted from. Time zones are such wholesome fun for the whole family, -eh?"))) - (widget-put widget :args `(,item - (repeat :inline t - :indent 0 - :tag ,tag - :doc ,doc - :format "%t:\n%h%v%i\n\n" - ,group)))) - widget) - -(defvar gnus-custom-scores) -(defvar gnus-custom-score-alist) - -(defun gnus-score-customize (file) - "Customize score file FILE." - (interactive (list gnus-current-score-file)) - (let ((scores (gnus-score-load file)) - (types (mapcar (lambda (entry) - `(group :format "%v%h\n" - :doc ,(nth 2 entry) - (const :format "" ,(nth 0 entry)) - ,(nth 1 entry))) - gnus-score-parameters))) - ;; Ready. - (kill-buffer (get-buffer-create "*Gnus Customize*")) - (switch-to-buffer (get-buffer-create "*Gnus Customize*")) - (gnus-custom-mode) - (make-local-variable 'gnus-custom-score-alist) - (setq gnus-custom-score-alist scores) - (widget-insert "Customize the ") - (widget-create 'info-link - :help-echo "Push me to learn more." - :tag "score entries" - "(gnus)Score File Format") - (widget-insert " for\n\t") - (widget-insert file) - (widget-insert "\nand press ") - (widget-create 'push-button - :tag "done" - :help-echo "Push me when done customizing." - :action 'gnus-score-customize-done) - (widget-insert ".\n -Check the [ ] for the entries you want to apply to this score file, then -edit the value to suit your taste. Don't forget to mark the checkbox, -if you do all your changes will be lost. ") - (widget-create 'push-button - :action (lambda (&rest ignore) - (require 'gnus-audio) - (gnus-audio-play "Evil_Laugh.au")) - "Bhahahah!") - (widget-insert "\n\n") - (make-local-variable 'gnus-custom-scores) - (setq gnus-custom-scores - (widget-create 'group - :value scores - `(checklist :inline t - :greedy t - (gnus-score-string :tag "From") - (gnus-score-string :tag "Subject") - (gnus-score-string :tag "References") - (gnus-score-string :tag "Xref") - (gnus-score-string :tag "Message-ID") - (gnus-score-integer :tag "Lines") - (gnus-score-integer :tag "Chars") - (gnus-score-date :tag "Date") - (gnus-score-string :tag "Head" - :doc "\ -Match all headers in the article. - -Using one of `Head', `Body', `All' will slow down scoring considerable. -") - (gnus-score-string :tag "Body" - :doc "\ -Match the body sans header of the article. - -Using one of `Head', `Body', `All' will slow down scoring considerable. -") - (gnus-score-string :tag "All" - :doc "\ -Match the entire article, including both headers and body. - -Using one of `Head', `Body', `All' will slow down scoring -considerable. -") - (gnus-score-string :tag - "Followup" - :doc "\ -Score all followups to the specified authors. - -This entry is somewhat special, in that it will match the `From:' -header, and affect the score of not only the matching articles, but -also all followups to the matching articles. This allows you -e.g. increase the score of followups to your own articles, or decrease -the score of followups to the articles of some known trouble-maker. -") - (gnus-score-string :tag "Thread" - :doc "\ -Add a score entry on all articles that are part of a thread. - -This match key works along the same lines as the `Followup' match key. -If you say that you want to score on a (sub-)thread that is started by -an article with a `Message-ID' X, then you add a `thread' match. This -will add a new `thread' match for each article that has X in its -`References' header. (These new `thread' matches will use the -`Message-ID's of these matching articles.) This will ensure that you -can raise/lower the score of an entire thread, even though some -articles in the thread may not have complete `References' headers. -Note that using this may lead to undeterministic scores of the -articles in the thread. -") - ,@types) - '(repeat :inline t - :tag "Unknown entries" - sexp))) - (use-local-map widget-keymap) - (widget-setup))) - -(defun gnus-score-customize-done (&rest ignore) - "Reset the score alist with the present value." - (let ((alist gnus-custom-score-alist) - (value (widget-value gnus-custom-scores))) - (setcar alist (car value)) - (setcdr alist (cdr value)) - (gnus-score-set 'touched '(t) alist)) - (bury-buffer)) - -;;; The End: - -(provide 'gnus-cus) - -;;; gnus-cus.el ends here - diff --git a/lisp/gnus-demon.el b/lisp/gnus-demon.el deleted file mode 100644 index 6c882ca..0000000 --- a/lisp/gnus-demon.el +++ /dev/null @@ -1,326 +0,0 @@ -;;; gnus-demon.el --- daemonic Gnus behaviour -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-int) -(require 'nnheader) -(require 'nntp) -(eval-and-compile - (if (string-match "XEmacs" (emacs-version)) - (require 'itimer) - (require 'timer))) - -(defgroup gnus-demon nil - "Demonic behaviour." - :group 'gnus) - -(defcustom gnus-demon-handlers nil - "*Alist of daemonic handlers to be run at intervals. -Each handler is a list on the form - -\(FUNCTION TIME IDLE) - -FUNCTION is the function to be called. -TIME is the number of `gnus-demon-timestep's between each call. -If nil, never call. If t, call each `gnus-demon-timestep'. -If IDLE is t, only call if Emacs has been idle for a while. If IDLE -is a number, only call when Emacs has been idle more than this number -of `gnus-demon-timestep's. If IDLE is nil, don't care about -idleness. If IDLE is a number and TIME is nil, then call once each -time Emacs has been idle for IDLE `gnus-demon-timestep's." - :group 'gnus-demon - :type '(repeat (list function - (choice :tag "Time" - (const :tag "never" nil) - (const :tag "one" t) - (integer :tag "steps" 1)) - (choice :tag "Idle" - (const :tag "don't care" nil) - (const :tag "for a while" t) - (integer :tag "steps" 1))))) - -(defcustom gnus-demon-timestep 60 - "*Number of seconds in each demon timestep." - :group 'gnus-demon - :type 'integer) - -;;; Internal variables. - -(defvar gnus-demon-timer nil) -(defvar gnus-demon-idle-has-been-called nil) -(defvar gnus-demon-idle-time 0) -(defvar gnus-demon-handler-state nil) -(defvar gnus-demon-last-keys nil) -(defvar gnus-inhibit-demon nil - "*If non-nil, no daemonic function will be run.") - -(eval-and-compile - (autoload 'timezone-parse-date "timezone") - (autoload 'timezone-make-arpa-date "timezone")) - -;;; Functions. - -(defun gnus-demon-add-handler (function time idle) - "Add the handler FUNCTION to be run at TIME and IDLE." - ;; First remove any old handlers that use this function. - (gnus-demon-remove-handler function) - ;; Then add the new one. - (push (list function time idle) gnus-demon-handlers) - (gnus-demon-init)) - -(defun gnus-demon-remove-handler (function &optional no-init) - "Remove the handler FUNCTION from the list of handlers." - (setq gnus-demon-handlers - (delq (assq function gnus-demon-handlers) - gnus-demon-handlers)) - (unless no-init - (gnus-demon-init))) - -(defun gnus-demon-init () - "Initialize the Gnus daemon." - (interactive) - (gnus-demon-cancel) - (when gnus-demon-handlers - ;; Set up the timer. - (setq gnus-demon-timer - (nnheader-run-at-time - gnus-demon-timestep gnus-demon-timestep 'gnus-demon)) - ;; Reset control variables. - (setq gnus-demon-handler-state - (mapcar - (lambda (handler) - (list (car handler) (gnus-demon-time-to-step (nth 1 handler)) - (nth 2 handler))) - gnus-demon-handlers)) - (setq gnus-demon-idle-time 0) - (setq gnus-demon-idle-has-been-called nil) - (setq gnus-use-demon t))) - -(gnus-add-shutdown 'gnus-demon-cancel 'gnus) - -(defun gnus-demon-cancel () - "Cancel any Gnus daemons." - (interactive) - (when gnus-demon-timer - (nnheader-cancel-timer gnus-demon-timer)) - (setq gnus-demon-timer nil - gnus-use-demon nil - gnus-demon-idle-has-been-called nil) - (condition-case () - (nnheader-cancel-function-timers 'gnus-demon) - (error t))) - -(defun gnus-demon-is-idle-p () - "Whether Emacs is idle or not." - ;; We do this simply by comparing the 100 most recent keystrokes - ;; with the ones we had last time. If they are the same, one might - ;; guess that Emacs is indeed idle. This only makes sense if one - ;; calls this function seldom -- like once a minute, which is what - ;; we do here. - (let ((keys (recent-keys))) - (or (equal keys gnus-demon-last-keys) - (progn - (setq gnus-demon-last-keys keys) - nil)))) - -(defun gnus-demon-time-to-step (time) - "Find out how many seconds to TIME, which is on the form \"17:43\"." - (if (not (stringp time)) - time - (let* ((now (current-time)) - ;; obtain NOW as discrete components -- make a vector for speed - (nowParts (apply 'vector (decode-time now))) - ;; obtain THEN as discrete components - (thenParts (timezone-parse-time time)) - (thenHour (string-to-int (elt thenParts 0))) - (thenMin (string-to-int (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))))) - -(defun gnus-demon () - "The Gnus daemon that takes care of running all Gnus handlers." - ;; Increase or reset the time Emacs has been idle. - (if (gnus-demon-is-idle-p) - (incf gnus-demon-idle-time) - (setq gnus-demon-idle-time 0) - (setq gnus-demon-idle-has-been-called nil)) - ;; Disable all daemonic stuff if we're in the minibuffer - (when (and (not (window-minibuffer-p (selected-window))) - (not gnus-inhibit-demon)) - ;; Then we go through all the handler and call those that are - ;; sufficiently ripe. - (let ((handlers gnus-demon-handler-state) - (gnus-inhibit-demon t) - handler time idle) - (while handlers - (setq handler (pop handlers)) - (cond - ((numberp (setq time (nth 1 handler))) - ;; These handlers use a regular timeout mechanism. We decrease - ;; the timer if it hasn't reached zero yet. - (unless (zerop time) - (setcar (nthcdr 1 handler) (decf time))) - (and (zerop time) ; If the timer now is zero... - ;; Test for appropriate idleness - (progn - (setq idle (nth 2 handler)) - (cond - ((null idle) t) ; Don't care about idle. - ((numberp idle) ; Numerical idle... - (< idle gnus-demon-idle-time)) ; Idle timed out. - (t (< 0 gnus-demon-idle-time)))) ; Or just need to be idle. - ;; So we call the handler. - (progn - (ignore-errors (funcall (car handler))) - ;; And reset the timer. - (setcar (nthcdr 1 handler) - (gnus-demon-time-to-step - (nth 1 (assq (car handler) gnus-demon-handlers))))))) - ;; These are only supposed to be called when Emacs is idle. - ((null (setq idle (nth 2 handler))) - ;; We do nothing. - ) - ((and (not (numberp idle)) - (gnus-demon-is-idle-p)) - ;; We want to call this handler each and every time that - ;; Emacs is idle. - (ignore-errors (funcall (car handler)))) - (t - ;; We want to call this handler only if Emacs has been idle - ;; for a specified number of timesteps. - (and (not (memq (car handler) gnus-demon-idle-has-been-called)) - (< idle gnus-demon-idle-time) - (gnus-demon-is-idle-p) - (progn - (ignore-errors (funcall (car handler))) - ;; Make sure the handler won't be called once more in - ;; this idle-cycle. - (push (car handler) gnus-demon-idle-has-been-called))))))))) - -(defun gnus-demon-add-nocem () - "Add daemonic NoCeM handling to Gnus." - (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 30)) - -(defun gnus-demon-scan-nocem () - "Scan NoCeM groups for NoCeM messages." - (save-window-excursion - (gnus-nocem-scan-groups))) - -(defun gnus-demon-add-disconnection () - "Add daemonic server disconnection to Gnus." - (gnus-demon-add-handler 'gnus-demon-close-connections nil 30)) - -(defun gnus-demon-close-connections () - (save-window-excursion - (gnus-close-backends))) - -(defun gnus-demon-add-nntp-close-connection () - "Add daemonic nntp server disconnection to Gnus. -If no commands have gone out via nntp during the last five -minutes, the connection is closed." - (gnus-demon-add-handler 'gnus-demon-close-connections 5 nil)) - -(defun gnus-demon-nntp-close-connection () - (save-window-excursion - (when (nnmail-time-less '(0 300) - (nnmail-time-since nntp-last-command-time)) - (nntp-close-server)))) - -(defun gnus-demon-add-scanmail () - "Add daemonic scanning of mail from the mail backends." - (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60)) - -(defun gnus-demon-scan-mail () - (save-window-excursion - (let ((servers gnus-opened-servers) - server) - (gnus-clear-inboxes-moved) - (while (setq server (car (pop servers))) - (and (gnus-check-backend-function 'request-scan (car server)) - (or (gnus-server-opened server) - (gnus-open-server server)) - (gnus-request-scan nil server)))))) - -(defun gnus-demon-add-rescan () - "Add daemonic scanning of new articles from all backends." - (gnus-demon-add-handler 'gnus-demon-scan-news 120 60)) - -(defun gnus-demon-scan-news () - (let ((win (current-window-configuration))) - (unwind-protect - (save-window-excursion - (save-excursion - (when (gnus-alive-p) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-get-new-news))))) - (set-window-configuration win)))) - -(defun gnus-demon-add-scan-timestamps () - "Add daemonic updating of timestamps in empty newgroups." - (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30)) - -(defun gnus-demon-scan-timestamps () - "Set the timestamp on all newsgroups with no unread and no ticked articles." - (when (gnus-alive-p) - (let ((cur-time (current-time)) - (newsrc (cdr gnus-newsrc-alist)) - info group unread has-ticked) - (while (setq info (pop newsrc)) - (setq group (gnus-info-group info) - unread (gnus-group-unread group) - has-ticked (cdr (assq 'tick (gnus-info-marks info)))) - (when (and (numberp unread) - (= unread 0) - (not has-ticked)) - (gnus-group-set-parameter group 'timestamp cur-time)))))) - -(provide 'gnus-demon) - -;;; gnus-demon.el ends here diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el deleted file mode 100644 index 912af8e..0000000 --- a/lisp/gnus-draft.el +++ /dev/null @@ -1,183 +0,0 @@ -;;; gnus-draft.el --- draft message support for Semi-gnus -;; Copyright (C) 1997,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko -;; Keywords: mail, news, MIME, offline - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-sum) -(require 'message) -(require 'gnus-msg) -(require 'nndraft) -(eval-when-compile (require 'cl)) - -;;; Draft minor mode - -(defvar gnus-draft-mode nil - "Minor mode for providing a draft summary buffers.") - -(defvar gnus-draft-mode-map nil) - -(unless gnus-draft-mode-map - (setq gnus-draft-mode-map (make-sparse-keymap)) - - (gnus-define-keys gnus-draft-mode-map - "Dt" gnus-draft-toggle-sending - "De" gnus-draft-edit-message - "Ds" gnus-draft-send-message - "DS" gnus-draft-send-all-messages)) - -(defun gnus-draft-make-menu-bar () - (unless (boundp 'gnus-draft-menu) - (easy-menu-define - gnus-draft-menu gnus-draft-mode-map "" - '("Drafts" - ["Toggle whether to send" gnus-draft-toggle-sending t] - ["Edit" gnus-draft-edit-message t] - ["Send selected message(s)" gnus-draft-send-message t] - ["Send all messages" gnus-draft-send-all-messages t] - ["Delete draft" gnus-summary-delete-article t])))) - -(defun gnus-draft-mode (&optional arg) - "Minor mode for providing a draft summary buffers. - -\\{gnus-draft-mode-map}" - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (when (set (make-local-variable 'gnus-draft-mode) - (if (null arg) (not gnus-draft-mode) - (> (prefix-numeric-value arg) 0))) - ;; Set up the menu. - (when (gnus-visual-p 'draft-menu 'menu) - (gnus-draft-make-menu-bar)) - (gnus-add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map) - (gnus-run-hooks 'gnus-draft-mode-hook)))) - -;;; Commands - -(defun gnus-draft-toggle-sending (article) - "Toggle whether to send an article or not." - (interactive (list (gnus-summary-article-number))) - (if (gnus-draft-article-sendable-p article) - (progn - (push article gnus-newsgroup-unsendable) - (gnus-summary-mark-article article gnus-unsendable-mark)) - (setq gnus-newsgroup-unsendable - (delq article gnus-newsgroup-unsendable)) - (gnus-summary-mark-article article gnus-unread-mark)) - (gnus-summary-position-point)) - -(defun gnus-draft-edit-message () - "Enter a mail/post buffer to edit and send the draft." - (interactive) - (let ((article (gnus-summary-article-number))) - (gnus-summary-mark-as-read article gnus-canceled-mark) - (gnus-draft-setup article gnus-newsgroup-name) - (push - `((lambda () - (when (buffer-name (get-buffer ,gnus-summary-buffer)) - (save-excursion - (set-buffer (get-buffer ,gnus-summary-buffer)) - (gnus-cache-possibly-remove-article ,article nil nil nil t))))) - message-send-actions))) - -(defun gnus-draft-send-message (&optional n) - "Send the current draft." - (interactive "P") - (let ((articles (gnus-summary-work-articles n)) - article) - (while (setq article (pop articles)) - (gnus-summary-remove-process-mark article) - (unless (memq article gnus-newsgroup-unsendable) - (gnus-draft-send article gnus-newsgroup-name) - (gnus-summary-mark-article article gnus-canceled-mark))))) - -(defun gnus-draft-send (article &optional group) - "Send message ARTICLE." - (gnus-draft-setup article (or group "nndraft:queue")) - (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me) - message-send-hook) - (message-send-and-exit))) - -(defun gnus-draft-send-all-messages () - "Send all the sendable drafts." - (interactive) - (gnus-uu-mark-buffer) - (gnus-draft-send-message)) - -(defun gnus-group-send-drafts () - "Send all sendable articles from the queue group." - (interactive) - (gnus-activate-group "nndraft:queue") - (save-excursion - (let ((articles (nndraft-articles)) - (unsendable (gnus-uncompress-range - (cdr (assq 'unsend - (gnus-info-marks - (gnus-get-info "nndraft:queue")))))) - article) - (while (setq article (pop articles)) - (unless (memq article unsendable) - (gnus-draft-send article)))))) - -;;; Utility functions - -(defcustom gnus-draft-decoding-function - (function - (lambda () - (mime-edit-decode-buffer nil) - (eword-decode-header) - )) - "*Function called to decode the message from network representation." - :group 'gnus-agent - :type 'function) - -;;;!!!If this is byte-compiled, it fails miserably. -;;;!!!I have no idea why. - -(progn -(defun gnus-draft-setup (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") - ;; Insert the separator. - (funcall gnus-draft-decoding-function) - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (insert mail-header-separator) - (forward-line 1) - (message-set-auto-save-file-name)))))) - -(defun gnus-draft-article-sendable-p (article) - "Say whether ARTICLE is sendable." - (not (memq article gnus-newsgroup-unsendable))) - -(provide 'gnus-draft) - -;;; gnus-draft.el ends here diff --git a/lisp/gnus-dup.el b/lisp/gnus-dup.el deleted file mode 100644 index 3fd5795..0000000 --- a/lisp/gnus-dup.el +++ /dev/null @@ -1,160 +0,0 @@ -;;; gnus-dup.el --- suppression of duplicate articles in Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This package tries to mark articles as read the second time the -;; user reads a copy. This is useful if the server doesn't support -;; Xref properly, or if the user reads the same group from several -;; servers. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-art) - -(defgroup gnus-duplicate nil - "Suppression of duplicate articles." - :group 'gnus) - -(defcustom gnus-save-duplicate-list nil - "*If non-nil, save the duplicate list when shutting down Gnus. -If nil, duplicate suppression will only work on duplicates -seen in the same session." - :group 'gnus-duplicate - :type 'boolean) - -(defcustom gnus-duplicate-list-length 10000 - "*The number of Message-IDs to keep in the duplicate suppression list." - :group 'gnus-duplicate - :type 'integer) - -(defcustom gnus-duplicate-file (nnheader-concat gnus-directory "suppression") - "*The name of the file to store the duplicate suppression list." - :group 'gnus-duplicate - :type 'file) - -;;; Internal variables - -(defvar gnus-dup-list nil) -(defvar gnus-dup-hashtb nil) - -(defvar gnus-dup-list-dirty nil) - -;;; -;;; Starting and stopping -;;; - -(gnus-add-shutdown 'gnus-dup-close 'gnus) - -(defun gnus-dup-close () - "Possibly save the duplicate suppression list and shut down the subsystem." - (gnus-dup-save) - (setq gnus-dup-list nil - gnus-dup-hashtb nil - gnus-dup-list-dirty nil)) - -(defun gnus-dup-open () - "Possibly read the duplicate suppression list and start the subsystem." - (if gnus-save-duplicate-list - (gnus-dup-read) - (setq gnus-dup-list nil)) - (setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length)) - ;; Enter all Message-IDs into the hash table. - (let ((list gnus-dup-list) - (obarray gnus-dup-hashtb)) - (while list - (intern (pop list))))) - -(defun gnus-dup-read () - "Read the duplicate suppression list." - (setq gnus-dup-list nil) - (when (file-exists-p gnus-duplicate-file) - (load gnus-duplicate-file t t t))) - -(defun gnus-dup-save () - "Save the duplicate suppression list." - (when (and gnus-save-duplicate-list - gnus-dup-list-dirty) - (nnheader-temp-write gnus-duplicate-file - (gnus-prin1 `(setq gnus-dup-list ',gnus-dup-list)))) - (setq gnus-dup-list-dirty nil)) - -;;; -;;; Interface functions -;;; - -(defun gnus-dup-enter-articles () - "Enter articles from the current group for future duplicate suppression." - (unless gnus-dup-list - (gnus-dup-open)) - (setq gnus-dup-list-dirty t) ; mark list for saving - (let ((data gnus-newsgroup-data) - datum msgid) - ;; Enter the Message-IDs of all read articles into the list - ;; and hash table. - (while (setq datum (pop data)) - (when (and (not (gnus-data-pseudo-p datum)) - (> (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))) - (push msgid gnus-dup-list) - (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 - (setcdr end nil)))) - -(defun gnus-dup-suppress-articles () - "Mark duplicate articles as read." - (unless gnus-dup-list - (gnus-dup-open)) - (gnus-message 6 "Suppressing duplicates...") - (let ((headers gnus-newsgroup-headers) - number header) - (while (setq header (pop headers)) - (when (and (intern-soft (mail-header-id header) gnus-dup-hashtb) - (gnus-summary-article-unread-p (mail-header-number header))) - (setq gnus-newsgroup-unreads - (delq (setq number (mail-header-number header)) - gnus-newsgroup-unreads)) - (push (cons number gnus-duplicate-mark) - gnus-newsgroup-reads)))) - (gnus-message 6 "Suppressing duplicates...done")) - -(defun gnus-dup-unsuppress-article (article) - "Stop suppression of ARTICLE." - (let ((id (mail-header-id (gnus-data-header (gnus-data-find article))))) - (when id - (setq gnus-dup-list-dirty t) - (setq gnus-dup-list (delete id gnus-dup-list)) - (unintern id gnus-dup-hashtb)))) - -(provide 'gnus-dup) - -;;; gnus-dup.el ends here diff --git a/lisp/gnus-eform.el b/lisp/gnus-eform.el deleted file mode 100644 index 3e49eb2..0000000 --- a/lisp/gnus-eform.el +++ /dev/null @@ -1,130 +0,0 @@ -;;; gnus-eform.el --- a mode for editing forms for Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-win) - -;;; -;;; Editing forms -;;; - -(defgroup gnus-edit-form nil - "A mode for editing forms." - :group 'gnus) - -(defcustom gnus-edit-form-mode-hook nil - "*Hook run in `gnus-edit-form-mode' buffers." - :group 'gnus-edit-form - :type 'hook) - -(defcustom gnus-edit-form-menu-hook nil - "*Hook run when creating menus in `gnus-edit-form-mode' buffers." - :group 'gnus-edit-form - :type 'hook) - -;;; Internal variables - -(defvar gnus-edit-form-done-function nil) -(defvar gnus-edit-form-buffer "*Gnus edit form*") - -(defvar gnus-edit-form-mode-map nil) -(unless gnus-edit-form-mode-map - (setq gnus-edit-form-mode-map (copy-keymap emacs-lisp-mode-map)) - (gnus-define-keys gnus-edit-form-mode-map - "\C-c\C-c" gnus-edit-form-done - "\C-c\C-k" gnus-edit-form-exit)) - -(defun gnus-edit-form-make-menu-bar () - (unless (boundp 'gnus-edit-form-menu) - (easy-menu-define - gnus-edit-form-menu gnus-edit-form-mode-map "" - '("Edit Form" - ["Exit and save changes" gnus-edit-form-done t] - ["Exit" gnus-edit-form-exit t])) - (gnus-run-hooks 'gnus-edit-form-menu-hook))) - -(defun gnus-edit-form-mode () - "Major mode for editing forms. -It is a slightly enhanced emacs-lisp-mode. - -\\{gnus-edit-form-mode-map}" - (interactive) - (when (gnus-visual-p 'group-menu 'menu) - (gnus-edit-form-make-menu-bar)) - (kill-all-local-variables) - (setq major-mode 'gnus-edit-form-mode) - (setq mode-name "Edit Form") - (use-local-map gnus-edit-form-mode-map) - (make-local-variable 'gnus-edit-form-done-function) - (make-local-variable 'gnus-prev-winconf) - (gnus-run-hooks 'gnus-edit-form-mode-hook)) - -(defun gnus-edit-form (form documentation exit-func) - "Edit FORM in a new buffer. -Call EXIT-FUNC on exit. Display DOCUMENTATION in the beginning -of the buffer." - (let ((winconf (current-window-configuration))) - (set-buffer (get-buffer-create gnus-edit-form-buffer)) - (gnus-configure-windows 'edit-form) - (gnus-add-current-to-buffer-list) - (gnus-edit-form-mode) - (setq gnus-prev-winconf winconf) - (setq gnus-edit-form-done-function exit-func) - (erase-buffer) - (insert documentation) - (unless (bolp) - (insert "\n")) - (goto-char (point-min)) - (while (not (eobp)) - (insert ";;; ") - (forward-line 1)) - (insert ";; Type `C-c C-c' after you've finished editing.\n") - (insert "\n") - (let ((p (point))) - (pp form (current-buffer)) - (insert "\n") - (goto-char p)))) - -(defun gnus-edit-form-done () - "Update changes and kill the current buffer." - (interactive) - (goto-char (point-min)) - (let ((form (read (current-buffer))) - (func gnus-edit-form-done-function)) - (gnus-edit-form-exit) - (funcall func form))) - -(defun gnus-edit-form-exit () - "Kill the current buffer." - (interactive) - (let ((winconf gnus-prev-winconf)) - (kill-buffer (current-buffer)) - (set-window-configuration winconf))) - -(provide 'gnus-eform) - -;;; gnus-eform.el ends here diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el deleted file mode 100644 index ec43267..0000000 --- a/lisp/gnus-ems.el +++ /dev/null @@ -1,267 +0,0 @@ -;;; gnus-ems.el --- functions for making Gnus work under different Emacsen -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -;;; Function aliases later to be redefined for XEmacs usage. - -(defvar gnus-xemacs (string-match "XEmacs\\|Lucid" emacs-version) - "Non-nil if running under XEmacs.") - -(defvar gnus-mouse-2 [mouse-2]) -(defvar gnus-down-mouse-2 [down-mouse-2]) -(defvar gnus-mode-line-modified - (if (or gnus-xemacs - (< emacs-major-version 20)) - '("--**-" . "-----") - '("**" "--"))) - -(eval-and-compile - (autoload 'gnus-xmas-define "gnus-xmas") - (autoload 'gnus-xmas-redefine "gnus-xmas") - (autoload 'appt-select-lowest-window "appt")) - -(or (fboundp 'mail-file-babyl-p) - (fset 'mail-file-babyl-p 'rmail-file-p)) - -;;; Mule functions. - -(defun gnus-mule-cite-add-face (number prefix face) - ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. - (when face - (let ((inhibit-point-motion-hooks t) - from to) - (goto-line number) - (unless (eobp) ; Sometimes things become confused (broken). - (if (boundp 'MULE) - (forward-char (chars-in-string prefix)) - (forward-char (length prefix))) - (skip-chars-forward " \t") - (setq from (point)) - (end-of-line 1) - (skip-chars-backward " \t") - (setq to (point)) - (when (< from to) - (push (setq overlay (gnus-make-overlay from to)) - gnus-cite-overlay-list) - (gnus-overlay-put (gnus-make-overlay from to) 'face face)))))) - -(defun gnus-mule-max-width-function (el max-width) - (` (let* ((val (eval (, el))) - (valstr (if (numberp val) - (int-to-string val) val))) - (if (> (length valstr) (, max-width)) - (truncate-string valstr (, max-width)) - valstr)))) - -(defun gnus-encode-coding-string (string system) - string) - -(defun gnus-decode-coding-string (string system) - string) - -(eval-and-compile - (if (string-match "XEmacs\\|Lucid" emacs-version) - nil - - (defvar gnus-mouse-face-prop 'mouse-face - "Property used for highlighting mouse regions.")) - - (cond - ((string-match "XEmacs\\|Lucid" emacs-version) - (gnus-xmas-define)) - - ((or (not (boundp 'emacs-minor-version)) - (and (< emacs-major-version 20) - (< emacs-minor-version 30))) - ;; Remove the `intangible' prop. - (let ((props (and (boundp 'gnus-hidden-properties) - gnus-hidden-properties))) - (while (and props (not (eq (car (cdr props)) 'intangible))) - (setq props (cdr props))) - (when props - (setcdr props (cdr (cdr (cdr props)))))) - (unless (fboundp 'buffer-substring-no-properties) - (defun buffer-substring-no-properties (beg end) - (format "%s" (buffer-substring beg end))))) - - ((boundp 'MULE) - (provide 'gnusutil)))) - -(eval-and-compile - (cond - ((not window-system) - (defun gnus-dummy-func (&rest args)) - (let ((funcs '(mouse-set-point set-face-foreground - set-face-background x-popup-menu))) - (while funcs - (unless (fboundp (car funcs)) - (fset (car funcs) 'gnus-dummy-func)) - (setq funcs (cdr funcs)))))) - (unless (fboundp 'file-regular-p) - (defun file-regular-p (file) - (and (not (file-directory-p file)) - (not (file-symlink-p file)) - (file-exists-p file)))) - (unless (fboundp 'face-list) - (defun face-list (&rest args)))) - -(eval-and-compile - (let ((case-fold-search t)) - (cond - ((string-match "windows-nt\\|os/2\\|emx" (format "%s" system-type)) - (setq nnheader-file-name-translation-alist - (append nnheader-file-name-translation-alist - '((?: . ?_) - (?+ . ?-)))))))) - -(defvar gnus-tmp-unread) -(defvar gnus-tmp-replied) -(defvar gnus-tmp-score-char) -(defvar gnus-tmp-indentation) -(defvar gnus-tmp-opening-bracket) -(defvar gnus-tmp-lines) -(defvar gnus-tmp-name) -(defvar gnus-tmp-closing-bracket) -(defvar gnus-tmp-subject-or-nil) - -(defun gnus-ems-redefine () - (cond - ((string-match "XEmacs\\|Lucid" emacs-version) - (gnus-xmas-redefine)) - - ((featurep 'mule) - ;; Mule and new Emacs definitions - - ;; [Note] Now there are three kinds of mule implementations, - ;; original MULE, XEmacs/mule and beta version of Emacs including - ;; some mule features. Unfortunately these API are different. In - ;; particular, Emacs (including original MULE) and XEmacs are - ;; quite different. - ;; Predicates to check are following: - ;; (boundp 'MULE) is t only if MULE (original; anything older than - ;; Mule 2.3) is running. - ;; (featurep 'mule) is t when every mule variants are running. - - ;; These implementations may be able to share between original - ;; MULE and beta version of new Emacs. In addition, it is able to - ;; detect XEmacs/mule by (featurep 'mule) and to check variable - ;; `emacs-version'. In this case, implementation for XEmacs/mule - ;; may be able to share between XEmacs and XEmacs/mule. - - (defalias 'gnus-truncate-string 'truncate-string) - - (defvar gnus-summary-display-table nil - "Display table used in summary mode buffers.") - (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face) - (fset 'gnus-max-width-function 'gnus-mule-max-width-function) - (fset 'gnus-summary-set-display-table 'ignore) - (fset 'gnus-encode-coding-string 'encode-coding-string) - (fset 'gnus-decode-coding-string 'decode-coding-string) - - (when (boundp 'gnus-check-before-posting) - (setq gnus-check-before-posting - (delq 'long-lines - (delq 'control-chars gnus-check-before-posting)))) - - (defun gnus-summary-line-format-spec () - (insert gnus-tmp-unread gnus-tmp-replied - gnus-tmp-score-char gnus-tmp-indentation) - (put-text-property - (point) - (progn - (insert - gnus-tmp-opening-bracket - (format "%4d: %-20s" - gnus-tmp-lines - (if (> (length gnus-tmp-name) 20) - (truncate-string gnus-tmp-name 20) - gnus-tmp-name)) - gnus-tmp-closing-bracket) - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject-or-nil "\n")) - ))) - -(defun gnus-region-active-p () - "Say whether the region is active." - (and (boundp 'transient-mark-mode) - transient-mark-mode - (boundp 'mark-active) - mark-active)) - -(defun gnus-add-minor-mode (mode name map) - (if (fboundp 'add-minor-mode) - (add-minor-mode mode name map) - (unless (assq mode minor-mode-alist) - (push `(,mode ,name) minor-mode-alist)) - (unless (assq mode minor-mode-map-alist) - (push (cons mode map) - minor-mode-map-alist)))) - -(defun gnus-x-splash () - "Show a splash screen using a pixmap in the current buffer." - (let ((dir (nnheader-find-etc-directory "gnus")) - pixmap file height beg i) - (save-excursion - (switch-to-buffer (get-buffer-create gnus-group-buffer)) - (let ((buffer-read-only nil)) - (erase-buffer) - (when (and dir - (file-exists-p (setq file (concat dir "x-splash")))) - (nnheader-temp-write nil - (insert-file-contents file) - (goto-char (point-min)) - (ignore-errors - (setq pixmap (read (current-buffer)))))) - (when pixmap - (erase-buffer) - (unless (facep 'gnus-splash) - (make-face 'gnus-splash)) - (setq height (/ (car pixmap) (frame-char-height)) - width (/ (cadr pixmap) (frame-char-width))) - (set-face-foreground 'gnus-splash "ForestGreen") - (set-face-stipple 'gnus-splash pixmap) - (insert-char ?\n (* (/ (window-height) 2 height) height)) - (setq i height) - (while (> i 0) - (insert-char ? (* (+ (/ (window-width) 2 width) 1) width)) - (setq beg (point)) - (insert-char ? width) - (set-text-properties beg (point) '(face gnus-splash)) - (insert "\n") - (decf i)) - (goto-char (point-min)) - (sit-for 0)))))) - -(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 deleted file mode 100644 index 7d1b7de..0000000 --- a/lisp/gnus-gl.el +++ /dev/null @@ -1,859 +0,0 @@ -;;; gnus-gl.el --- an interface to GroupLens for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Brad Miller -;; Keywords: news, score - -;; 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: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; GroupLens software and documentation is copyright (c) 1995 by Paul -;; Resnick (Massachusetts Institute of Technology); Brad Miller, John -;; Riedl, Jon Herlocker, and Joseph Konstan (University of Minnesota), -;; and David Maltz (Carnegie-Mellon University). -;; -;; Permission to use, copy, modify, and distribute this documentation -;; for non-commercial and commercial purposes without fee is hereby -;; granted provided that this copyright notice and permission notice -;; appears in all copies and that the names of the individuals and -;; institutions holding this copyright are not used in advertising or -;; publicity pertaining to this software without specific, written -;; prior permission. The copyright holders make no representations -;; about the suitability of this software and documentation for any -;; purpose. It is provided ``as is'' without express or implied -;; warranty. -;; -;; The copyright holders request that they be notified of -;; modifications of this code. Please send electronic mail to -;; grouplens@cs.umn.edu for more information or to announce derived -;; works. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Author: Brad Miller -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; User Documentation: -;; To use GroupLens you must load this file. -;; You must also register a pseudonym with the Better Bit Bureau. -;; http://www.cs.umn.edu/Research/GroupLens -;; -;; ---------------- For your .emacs or .gnus file ---------------- -;; -;; As of version 2.5, grouplens now works as a minor mode of -;; gnus-summary-mode. To get make that work you just need a couple of -;; hooks. -;; (setq gnus-use-grouplens t) -;; (setq grouplens-pseudonym "") -;; (setq grouplens-bbb-host "grouplens.cs.umn.edu") -;; -;; (setq gnus-summary-default-score 0) -;; -;; USING GROUPLENS -;; How do I Rate an article?? -;; Before you type n to go to the next article, hit a number from 1-5 -;; Type r in the summary buffer and you will be prompted. -;; Note that when you're in grouplens-minor-mode 'r' masks the -;; usual reply binding for 'r' -;; -;; What if, Gasp, I find a bug??? -;; Please type M-x gnus-gl-submit-bug-report. This will set up a -;; mail buffer with the state of variables and buffers that will help -;; me debug the problem. A short description up front would help too! -;; -;; How do I display the prediction for an article: -;; If you set the gnus-summary-line-format as shown above, the score -;; (prediction) will be shown automatically. -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Programmer Notes -;; 10/9/95 -;; gnus-scores-articles contains the articles -;; When scoring is done, the call tree looks something like: -;; gnus-possibly-score-headers -;; ==> gnus-score-headers -;; ==> gnus-score-load-file -;; ==> get-all-mids (from the eval form) -;; -;; it would be nice to have one that gets called after all the other -;; headers have been scored. -;; we may want a variable gnus-grouplens-scale-factor -;; and gnus-grouplens-offset this would probably be either -3 or 0 -;; to make the scores centered around zero or not. -;; Notes 10/12/95 -;; According to Lars, Norse god of gnus, the simple way to insert a -;; call to an external function is to have a function added to the -;; variable gnus-score-find-files-function This new function -;; gnus-grouplens-score-alist will return a core alist that -;; has (("message-id" ("" score) ("" score)) -;; This seems like it would be pretty inefficient, though workable. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; TODO -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; 3. Add some more ways to rate messages -;; 4. Better error handling for token timeouts. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; bugs -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus-score) -(require 'gnus) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; User variables -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar gnus-summary-grouplens-line-format - "%U\%R\%z%l%I\%(%[%4L: %-20,20n%]%) %s\n" - "*The line format spec in summary GroupLens mode buffers.") - -(defvar grouplens-pseudonym "" - "User's pseudonym. -This pseudonym is obtained during the registration process") - -(defvar grouplens-bbb-host "grouplens.cs.umn.edu" - "Host where the bbbd is running" ) - -(defvar grouplens-bbb-port 9000 - "Port where the bbbd is listening" ) - -(defvar grouplens-newsgroups - '("comp.groupware" "comp.human-factors" "comp.lang.c++" - "comp.lang.java" "comp.os.linux.admin" "comp.os.linux.advocacy" - "comp.os.linux.announce" "comp.os.linux.answers" - "comp.os.linux.development" "comp.os.linux.development.apps" - "comp.os.linux.development.system" "comp.os.linux.hardware" - "comp.os.linux.help" "comp.os.linux.m68k" "comp.os.linux.misc" - "comp.os.linux.networking" "comp.os.linux.setup" "comp.os.linux.x" - "mn.general" "rec.arts.movies" "rec.arts.movies.current-films" - "rec.food.recipes" "rec.humor") - "*Groups that are part of the GroupLens experiment.") - -(defvar grouplens-prediction-display 'prediction-spot - "valid values are: - prediction-spot -- an * corresponding to the prediction between 1 and 5, - confidence-interval -- a numeric confidence interval - prediction-bar -- |##### | the longer the bar, the better the article, - confidence-bar -- | ----- } the prediction is in the middle of the bar, - confidence-spot -- ) * | the spot gets bigger with more confidence, - prediction-num -- plain-old numeric value, - confidence-plus-minus -- prediction +/i confidence") - -(defvar grouplens-score-offset 0 - "Offset the prediction by this value. -Setting this variable to -2 would have the following effect on -GroupLens scores: - - 1 --> -2 - 2 --> -1 - 3 --> 0 - 4 --> 1 - 5 --> 2 - -The reason is that a user might want to do this is to combine -GroupLens predictions with scores calculated by other score methods.") - -(defvar grouplens-score-scale-factor 1 - "This variable allows the user to magnify the effect of GroupLens scores. -The scale factor is applied after the offset.") - -(defvar gnus-grouplens-override-scoring 'override - "Tell GroupLens to override the normal Gnus scoring mechanism. -GroupLens scores can be combined with gnus scores in one of three ways. -'override -- just use grouplens predictions for grouplens groups -'combine -- combine grouplens scores with gnus scores -'separate -- treat grouplens scores completely separate from gnus") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Program global variables -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar grouplens-bbb-token nil - "Current session token number") - -(defvar grouplens-bbb-process nil - "Process Id of current bbbd network stream process") - -(defvar grouplens-bbb-buffer nil - "Buffer associated with the BBBD process") - -(defvar grouplens-rating-alist nil - "Current set of message-id rating pairs") - -(defvar grouplens-current-hashtable nil - "A hashtable to hold predictions from the BBB") - -(defvar grouplens-current-group nil) - -;;(defvar bbb-alist nil) - -(defvar bbb-timeout-secs 10 - "Number of seconds to wait for some response from the BBB. -If this times out we give up and assume that something has died..." ) - -(defvar grouplens-previous-article nil - "Message-ID of the last article read.") - -(defvar bbb-read-point) -(defvar bbb-response-point) - -(defun bbb-renew-hash-table () - (setq grouplens-current-hashtable (make-vector 100 0))) - -(bbb-renew-hash-table) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Utility Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun bbb-connect-to-bbbd (host port) - (unless grouplens-bbb-buffer - (setq grouplens-bbb-buffer - (get-buffer-create (format " *BBBD trace: %s*" host))) - (save-excursion - (set-buffer grouplens-bbb-buffer) - (make-local-variable 'bbb-read-point) - (make-local-variable 'bbb-response-point) - (setq bbb-read-point (point-min)))) - - ;; if an old process is still running for some reason, kill it - (when grouplens-bbb-process - (ignore-errors - (when (eq 'open (process-status grouplens-bbb-process)) - (set-process-buffer grouplens-bbb-process nil) - (delete-process grouplens-bbb-process)))) - - ;; clear the trace buffer of old output - (save-excursion - (set-buffer grouplens-bbb-buffer) - (erase-buffer)) - - ;; open the connection to the server - (catch 'done - (condition-case error - (setq grouplens-bbb-process - (open-network-stream "BBBD" grouplens-bbb-buffer host port)) - (error (gnus-message 3 "Error: Failed to connect to BBB") - nil)) - (and (null grouplens-bbb-process) - (throw 'done nil)) - (save-excursion - (set-buffer grouplens-bbb-buffer) - (setq bbb-read-point (point-min)) - (or (bbb-read-response grouplens-bbb-process) - (throw 'done nil)))) - - ;; return the process - grouplens-bbb-process) - -(defun bbb-send-command (process command) - (goto-char (point-max)) - (insert command) - (insert "\r\n") - (setq bbb-read-point (point)) - (setq bbb-response-point (point)) - (set-marker (process-mark process) (point)) ; process output also comes here - (process-send-string process command) - (process-send-string process "\r\n") - (process-send-eof process)) - -(defun bbb-read-response (process) - "This function eats the initial response of OK or ERROR from the BBB." - (let ((case-fold-search nil) - match-end) - (goto-char bbb-read-point) - (while (and (not (search-forward "\r\n" nil t)) - (accept-process-output process bbb-timeout-secs)) - (goto-char bbb-read-point)) - (setq match-end (point)) - (goto-char bbb-read-point) - (setq bbb-read-point match-end) - (looking-at "OK"))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Login Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun bbb-login () - "return the token number if login is successful, otherwise return nil" - (interactive) - (setq grouplens-bbb-token nil) - (if (not (equal grouplens-pseudonym "")) - (let ((bbb-process - (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) - (if bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process - (concat "login " grouplens-pseudonym)) - (if (bbb-read-response bbb-process) - (setq grouplens-bbb-token (bbb-extract-token-number)) - (gnus-message 3 "Error: GroupLens login failed"))))) - (gnus-message 3 "Error: you must set a pseudonym")) - grouplens-bbb-token) - -(defun bbb-extract-token-number () - (let ((token-pos (search-forward "token=" nil t))) - (when (looking-at "[0-9]+") - (buffer-substring token-pos (match-end 0))))) - -(gnus-add-shutdown 'bbb-logout 'gnus) - -(defun bbb-logout () - "logout of bbb session" - (when grouplens-bbb-token - (let ((bbb-process - (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) - (when bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process (concat "logout " grouplens-bbb-token)) - (bbb-read-response bbb-process)))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Get Predictions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(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. - -*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 -recommend using both scores and grouplens predictions together." - (setq grouplens-current-group groupname) - (when (member groupname grouplens-newsgroups) - (setq grouplens-previous-article nil) - ;; scores-alist should be a list of lists: - ;; ((("message-id" ("" score1 nil s) (" score2 nil s)))) - ;;`((("message-id" . ,predict-list))) ; Yes, this is the return value - (list - (list - (list (append (list "message-id") - (bbb-get-predictions (bbb-get-all-mids) groupname))))))) - -(defun bbb-get-predictions (midlist groupname) - "Ask the bbb for predictions, and build up the score alist." - (gnus-message 5 "Fetching Predictions...") - (if grouplens-bbb-token - (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host - grouplens-bbb-port))) - (when bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process - (bbb-build-predict-command midlist groupname - grouplens-bbb-token)) - (if (bbb-read-response bbb-process) - (bbb-get-prediction-response bbb-process) - (gnus-message 1 "Invalid Token, login and try again") - (ding))))) - (gnus-message 3 "Error: You are not logged in to a BBB") - (ding))) - -(defun bbb-get-all-mids () - (mapcar (function (lambda (x) (mail-header-id x))) gnus-newsgroup-headers)) - -(defun bbb-build-predict-command (mlist grpname token) - (concat "getpredictions " token " " grpname "\r\n" - (mapconcat 'identity mlist "\r\n") "\r\n.\r\n")) - -(defun bbb-get-prediction-response (process) - (let ((case-fold-search nil)) - (goto-char bbb-read-point) - (while (and (not (search-forward ".\r\n" nil t)) - (accept-process-output process bbb-timeout-secs)) - (goto-char bbb-read-point)) - (goto-char (+ bbb-response-point 4));; we ought to be right before OK - (bbb-build-response-alist))) - -;; build-response-alist assumes that the cursor has been positioned at -;; the first line of the list of mid/rating pairs. -(defun bbb-build-response-alist () - (let (resp mid pred) - (while - (cond - ((looking-at "\\(<.*>\\) :nopred=") - ;;(push `(,(bbb-get-mid) ,gnus-summary-default-score nil s) resp) - (forward-line 1) - t) - ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)") - (setq mid (bbb-get-mid) - pred (bbb-get-pred)) - (push `(,mid ,pred nil s) resp) - (gnus-sethash mid (list pred (bbb-get-confl) (bbb-get-confh)) - grouplens-current-hashtable) - (forward-line 1) - t) - ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)") - (setq mid (bbb-get-mid) - pred (bbb-get-pred)) - (push `(,mid ,pred nil s) resp) - (gnus-sethash mid (list pred 0 0) grouplens-current-hashtable) - (forward-line 1) - t) - (t nil))) - resp)) - -;; these "get" functions assume that there is an active match lying -;; around. Where the first parenthesized expression is the -;; message-id, and the second is the prediction, the third and fourth -;; are the confidence interval -;; -;; Since gnus assumes that scores are integer values?? we round the -;; prediction. -(defun bbb-get-mid () - (buffer-substring (match-beginning 1) (match-end 1))) - -(defun bbb-get-pred () - (let ((tpred (string-to-number (buffer-substring (match-beginning 2) - (match-end 2))))) - (if (> tpred 0) - (round (* grouplens-score-scale-factor - (+ grouplens-score-offset tpred))) - 1))) - -(defun bbb-get-confl () - (string-to-number (buffer-substring (match-beginning 4) (match-end 4)))) - -(defun bbb-get-confh () - (string-to-number (buffer-substring (match-beginning 4) (match-end 4)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Prediction Display -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst grplens-rating-range 4.0) -(defconst grplens-maxrating 5) -(defconst grplens-minrating 1) -(defconst grplens-predstringsize 12) - -(defvar gnus-tmp-score) -(defun bbb-grouplens-score (header) - (if (eq gnus-grouplens-override-scoring 'separate) - (bbb-grouplens-other-score header) - (let* ((rate-string (make-string 12 ?\ )) - (mid (mail-header-id header)) - (hashent (gnus-gethash mid grouplens-current-hashtable)) - (iscore gnus-tmp-score) - (low (car (cdr hashent))) - (high (car (cdr (cdr hashent))))) - (aset rate-string 0 ?|) - (aset rate-string 11 ?|) - (unless (member grouplens-current-group grouplens-newsgroups) - (unless (equal grouplens-prediction-display 'prediction-num) - (cond ((< iscore 0) - (setq iscore 1)) - ((> iscore 5) - (setq iscore 5)))) - (setq low 0) - (setq high 0)) - (if (and (bbb-valid-score iscore) - (not (null mid))) - (cond - ;; prediction-spot - ((equal grouplens-prediction-display 'prediction-spot) - (setq rate-string (bbb-fmt-prediction-spot rate-string iscore))) - ;; confidence-interval - ((equal grouplens-prediction-display 'confidence-interval) - (setq rate-string (bbb-fmt-confidence-interval iscore low high))) - ;; prediction-bar - ((equal grouplens-prediction-display 'prediction-bar) - (setq rate-string (bbb-fmt-prediction-bar rate-string iscore))) - ;; confidence-bar - ((equal grouplens-prediction-display 'confidence-bar) - (setq rate-string (format "| %4.2f |" iscore))) - ;; confidence-spot - ((equal grouplens-prediction-display 'confidence-spot) - (setq rate-string (format "| %4.2f |" iscore))) - ;; prediction-num - ((equal grouplens-prediction-display 'prediction-num) - (setq rate-string (bbb-fmt-prediction-num iscore))) - ;; confidence-plus-minus - ((equal grouplens-prediction-display 'confidence-plus-minus) - (setq rate-string (bbb-fmt-confidence-plus-minus iscore low high)) - ) - (t (gnus-message 3 "Invalid prediction display type"))) - (aset rate-string 5 ?N) (aset rate-string 6 ?A)) - rate-string))) - -;; Gnus user format function that doesn't depend on -;; bbb-build-mid-scores-alist being used as the score function, but is -;; instead called from gnus-select-group-hook. -- LAB -(defun bbb-grouplens-other-score (header) - (if (not (member grouplens-current-group grouplens-newsgroups)) - ;; 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))) - ;; Init rate-string - (aset rate-string 0 ?|) - (aset rate-string 11 ?|) - (unless (equal grouplens-prediction-display 'prediction-num) - (cond ((< pred 0) - (setq pred 1)) - ((> pred 5) - (setq pred 5)))) - ;; If no entry in BBB hash mark rate string as NA and return - (cond - ((null hashent) - (aset rate-string 5 ?N) - (aset rate-string 6 ?A) - rate-string) - - ((equal grouplens-prediction-display 'prediction-spot) - (bbb-fmt-prediction-spot rate-string pred)) - - ((equal grouplens-prediction-display 'confidence-interval) - (bbb-fmt-confidence-interval pred low high)) - - ((equal grouplens-prediction-display 'prediction-bar) - (bbb-fmt-prediction-bar rate-string pred)) - - ((equal grouplens-prediction-display 'confidence-bar) - (format "| %4.2f |" pred)) - - ((equal grouplens-prediction-display 'confidence-spot) - (format "| %4.2f |" pred)) - - ((equal grouplens-prediction-display 'prediction-num) - (bbb-fmt-prediction-num pred)) - - ((equal grouplens-prediction-display 'confidence-plus-minus) - (bbb-fmt-confidence-plus-minus pred low high)) - - (t - (gnus-message 3 "Invalid prediction display type") - (aset rate-string 0 ?|) - (aset rate-string 11 ?|) - rate-string))))) - -(defun bbb-valid-score (score) - (or (equal grouplens-prediction-display 'prediction-num) - (and (>= score grplens-minrating) - (<= score grplens-maxrating)))) - -(defun bbb-requires-confidence (format-type) - (or (equal format-type 'confidence-plus-minus) - (equal format-type 'confidence-spot) - (equal format-type 'confidence-interval))) - -(defun bbb-have-confidence (clow chigh) - (not (or (null clow) - (null chigh)))) - -(defun bbb-fmt-prediction-spot (rate-string score) - (aset rate-string - (round (* (/ (- score grplens-minrating) grplens-rating-range) - (+ (- grplens-predstringsize 4) 1.49))) - ?*) - rate-string) - -(defun bbb-fmt-confidence-interval (score low high) - (if (bbb-have-confidence low high) - (format "|%4.2f-%4.2f |" low high) - (bbb-fmt-prediction-num score))) - -(defun bbb-fmt-confidence-plus-minus (score low high) - (if (bbb-have-confidence low high) - (format "|%3.1f+/-%4.2f|" score (/ (- high low) 2.0)) - (bbb-fmt-prediction-num score))) - -(defun bbb-fmt-prediction-bar (rate-string score) - (let* ((i 1) - (step (/ grplens-rating-range (- grplens-predstringsize 4))) - (half-step (/ step 2)) - (loc (- grplens-minrating half-step))) - (while (< i (- grplens-predstringsize 2)) - (if (> score loc) - (aset rate-string i ?#) - (aset rate-string i ?\ )) - (setq i (+ i 1)) - (setq loc (+ loc step))) - ) - rate-string) - -(defun bbb-fmt-prediction-num (score) - (format "| %4.2f |" score)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Put Ratings -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun bbb-put-ratings () - (if (and grouplens-bbb-token - grouplens-rating-alist - (member gnus-newsgroup-name grouplens-newsgroups)) - (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host - grouplens-bbb-port)) - (rate-command (bbb-build-rate-command grouplens-rating-alist))) - (if bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (gnus-message 5 "Sending Ratings...") - (bbb-send-command bbb-process rate-command) - (if (bbb-read-response bbb-process) - (setq grouplens-rating-alist nil) - (gnus-message 1 - "Token timed out: call bbb-login and quit again") - (ding)) - (gnus-message 5 "Sending Ratings...Done")) - (gnus-message 3 "No BBB connection"))) - (setq grouplens-rating-alist nil))) - -(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))) - rate-alist "\r\n") - "\r\n.\r\n")) - -;; Interactive rating functions. -(defun bbb-summary-rate-article (rating &optional midin) - (interactive "nRating: ") - (when (member gnus-newsgroup-name grouplens-newsgroups) - (let ((mid (or midin (bbb-get-current-id)))) - (if (and rating - (>= rating grplens-minrating) - (<= rating grplens-maxrating) - mid) - (let ((oldrating (assoc mid grouplens-rating-alist))) - (if oldrating - (setcdr oldrating (cons rating 0)) - (push `(,mid . (,rating . 0)) grouplens-rating-alist)) - (gnus-summary-mark-article nil (int-to-string rating))) - (gnus-message 3 "Invalid rating"))))) - -(defun grouplens-next-unread-article (rating) - "Select unread article after current one." - (interactive "P") - (when rating - (bbb-summary-rate-article rating)) - (gnus-summary-next-unread-article)) - -(defun grouplens-best-unread-article (rating) - "Select unread article after current one." - (interactive "P") - (when rating - (bbb-summary-rate-article rating)) - (gnus-summary-best-unread-article)) - -(defun grouplens-summary-catchup-and-exit (rating) - "Mark all articles not marked as unread in this newsgroup as read, - then exit. If prefix argument ALL is non-nil, all articles are - marked as read." - (interactive "P") - (when rating - (bbb-summary-rate-article rating)) - (if (numberp rating) - (gnus-summary-catchup-and-exit) - (gnus-summary-catchup-and-exit rating))) - -(defun grouplens-score-thread (score) - "Raise the score of the articles in the current thread with SCORE." - (interactive "nRating: ") - (let (e) - (save-excursion - (let ((articles (gnus-summary-articles-in-thread)) - article) - (while (setq article (pop articles)) - (gnus-summary-goto-subject article) - (bbb-summary-rate-article score - (mail-header-id - (gnus-summary-article-header article))))) - (setq e (point))) - (let ((gnus-summary-check-current t)) - (or (zerop (gnus-summary-next-subject 1 t)) - (goto-char e)))) - (gnus-summary-recenter) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary)) - -(defun bbb-exit-group () - (bbb-put-ratings) - (bbb-renew-hash-table)) - -(defun bbb-get-current-id () - (if gnus-current-headers - (mail-header-id gnus-current-headers) - (gnus-message 3 "You must select an article before you rate it"))) - -(defun bbb-grouplens-group-p (group) - "Say whether GROUP is a GroupLens group." - (if (member group grouplens-newsgroups) " (GroupLens Enhanced)" "")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; TIME SPENT READING -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar grouplens-current-starting-time nil) - -(defun grouplens-start-timer () - (setq grouplens-current-starting-time (current-time))) - -(defun grouplens-elapsed-time () - (let ((et (bbb-time-float (current-time)))) - (- et (bbb-time-float grouplens-current-starting-time)))) - -(defun bbb-time-float (timeval) - (+ (* (car timeval) 65536) - (cadr timeval))) - -(defun grouplens-do-time () - (when (member gnus-newsgroup-name grouplens-newsgroups) - (when grouplens-previous-article - (let ((elapsed-time (grouplens-elapsed-time)) - (oldrating (assoc grouplens-previous-article - grouplens-rating-alist))) - (if (not oldrating) - (push `(,grouplens-previous-article . (0 . ,elapsed-time)) - grouplens-rating-alist) - (setcdr oldrating (cons (cadr oldrating) elapsed-time))))) - (grouplens-start-timer) - (setq grouplens-previous-article (bbb-get-current-id)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; BUG REPORTING -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst gnus-gl-version "gnus-gl.el 2.50") -(defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu") -(defun gnus-gl-submit-bug-report () - "Submit via mail a bug report on gnus-gl" - (interactive) - (require 'reporter) - (reporter-submit-bug-report gnus-gl-maintainer-address - (concat "gnus-gl.el " gnus-gl-version) - (list 'grouplens-pseudonym - 'grouplens-bbb-host - 'grouplens-bbb-port - 'grouplens-newsgroups - 'grouplens-bbb-token - 'grouplens-bbb-process - 'grouplens-current-group - 'grouplens-previous-article) - nil - 'gnus-gl-get-trace)) - -(defun gnus-gl-get-trace () - "Insert the contents of the BBBD trace buffer" - (when grouplens-bbb-buffer - (insert-buffer grouplens-bbb-buffer))) - -;; -;; GroupLens minor mode -;; - -(defvar gnus-grouplens-mode nil - "Minor mode for providing a GroupLens interface in Gnus summary buffers.") - -(defvar gnus-grouplens-mode-map nil) - -(unless gnus-grouplens-mode-map - (setq gnus-grouplens-mode-map (make-keymap)) - (gnus-define-keys - gnus-grouplens-mode-map - "n" grouplens-next-unread-article - "r" bbb-summary-rate-article - "k" grouplens-score-thread - "c" grouplens-summary-catchup-and-exit - "," grouplens-best-unread-article)) - -(defun gnus-grouplens-make-menu-bar () - (unless (boundp 'gnus-grouplens-menu) - (easy-menu-define - gnus-grouplens-menu gnus-grouplens-mode-map "" - '("GroupLens" - ["Login" bbb-login t] - ["Rate" bbb-summary-rate-article t] - ["Next article" grouplens-next-unread-article t] - ["Best article" grouplens-best-unread-article t] - ["Raise thread" grouplens-score-thread t] - ["Report bugs" gnus-gl-submit-bug-report t])))) - -(defun gnus-grouplens-mode (&optional arg) - "Minor mode for providing a GroupLens interface in Gnus summary buffers." - (interactive "P") - (when (and (eq major-mode 'gnus-summary-mode) - (member gnus-newsgroup-name grouplens-newsgroups)) - (make-local-variable 'gnus-grouplens-mode) - (setq gnus-grouplens-mode - (if (null arg) (not gnus-grouplens-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-grouplens-mode - (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) - (add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local) - (make-local-variable 'gnus-score-find-score-files-function) - - (cond - ((eq gnus-grouplens-override-scoring 'combine) - ;; either add bbb-buld-mid-scores-alist to a list - ;; or make a list - (if (listp gnus-score-find-score-files-function) - (setq gnus-score-find-score-files-function - (append 'bbb-build-mid-scores-alist - gnus-score-find-score-files-function)) - (setq gnus-score-find-score-files-function - (list gnus-score-find-score-files-function - 'bbb-build-mid-scores-alist)))) - ;; leave the gnus-score-find-score-files variable alone - ((eq gnus-grouplens-override-scoring 'separate) - (add-hook 'gnus-select-group-hook - (lambda () - (bbb-get-predictions (bbb-get-all-mids) - gnus-newsgroup-name)))) - ;; default is to override - (t - (setq gnus-score-find-score-files-function - 'bbb-build-mid-scores-alist))) - - ;; Change how summary lines look - (make-local-variable 'gnus-summary-line-format) - (make-local-variable 'gnus-summary-line-format-spec) - (setq gnus-summary-line-format gnus-summary-grouplens-line-format) - (setq gnus-summary-line-format-spec nil) - (gnus-update-format-specifications nil 'summary) - (gnus-update-summary-mark-positions) - - ;; Set up the menu. - (when (and menu-bar-mode - (gnus-visual-p 'grouplens-menu 'menu)) - (gnus-grouplens-make-menu-bar)) - (gnus-add-minor-mode - 'gnus-grouplens-mode " GroupLens" gnus-grouplens-mode-map) - (gnus-run-hooks 'gnus-grouplens-mode-hook)))) - -(provide 'gnus-gl) - -;;; gnus-gl.el ends here diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el deleted file mode 100644 index 98f59c0..0000000 --- a/lisp/gnus-group.el +++ /dev/null @@ -1,3372 +0,0 @@ -;;; gnus-group.el --- group mode commands for Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-start) -(require 'nnmail) -(require 'gnus-spec) -(require 'gnus-int) -(require 'gnus-range) -(require 'gnus-win) -(require 'gnus-undo) - -(defcustom gnus-group-archive-directory - "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" - "*The address of the (ding) archives." - :group 'gnus-group-foreign - :type 'directory) - -(defcustom gnus-group-recent-archive-directory - "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" - "*The address of the most recent (ding) articles." - :group 'gnus-group-foreign - :type 'directory) - -(defcustom gnus-no-groups-message "No news is no news" - "*Message displayed by Gnus when no groups are available." - :group 'gnus-start - :type 'string) - -(defcustom gnus-keep-same-level nil - "*Non-nil means that the next newsgroup after the current will be on the same level. -When you type, for instance, `n' after reading the last article in the -current newsgroup, you will go to the next newsgroup. If this variable -is nil, the next newsgroup will be the next from the group -buffer. -If this variable is non-nil, Gnus will either put you in the -next newsgroup with the same level, or, if no such newsgroup is -available, the next newsgroup with the lowest possible level higher -than the current level. -If this variable is `best', Gnus will make the next newsgroup the one -with the best level." - :group 'gnus-group-levels - :type '(choice (const nil) - (const best) - (sexp :tag "other" t))) - -(defcustom gnus-group-goto-unread t - "*If non-nil, movement commands will go to the next unread and subscribed group." - :link '(custom-manual "(gnus)Group Maneuvering") - :group 'gnus-group-various - :type 'boolean) - -(defcustom gnus-goto-next-group-when-activating t - "*If non-nil, the \\\\[gnus-group-get-new-news-this-group] command will advance point to the next group." - :link '(custom-manual "(gnus)Scanning New Messages") - :group 'gnus-group-various - :type 'boolean) - -(defcustom gnus-permanently-visible-groups nil - "*Regexp to match groups that should always be listed in the group buffer. -This means that they will still be listed even when there are no -unread articles in the groups. - -If nil, no groups are permanently visible." - :group 'gnus-group-listing - :type 'regexp) - -(defcustom gnus-list-groups-with-ticked-articles t - "*If non-nil, list groups that have only ticked articles. -If nil, only list groups that have unread articles." - :group 'gnus-group-listing - :type 'boolean) - -(defcustom gnus-group-default-list-level gnus-level-subscribed - "*Default listing level. -Ignored if `gnus-group-use-permanent-levels' is non-nil." - :group 'gnus-group-listing - :type 'integer) - -(defcustom gnus-group-list-inactive-groups t - "*If non-nil, inactive groups will be listed." - :group 'gnus-group-listing - :group 'gnus-group-levels - :type 'boolean) - -(defcustom gnus-group-sort-function 'gnus-group-sort-by-alphabet - "*Function used for sorting the group buffer. -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'. - -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" - "*Format of group lines. -It works along the same lines as a normal formatting string, -with some simple extensions. - -%M Only marked articles (character, \"*\" or \" \") -%S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \") -%L Level of subscribedness (integer) -%N Number of unread articles (integer) -%I Number of dormant articles (integer) -%i Number of ticked and dormant (integer) -%T Number of ticked articles (integer) -%R Number of read 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) -%D Group description (string) -%s Select method (string) -%o Moderated group (char, \"m\") -%p Process mark (char) -%O Moderated group (string, \"(m)\" or \"\") -%P Topic indentation (string) -%m Whether there is new(ish) mail in the group (char, \"%\") -%l Whether there are GroupLens predictions for this group (string) -%n Select from where (string) -%z A string that look like `<%s:%n>' if a foreign select method is used -%d The date the group was last entered. -%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. - -Note that this format specification is not always respected. For -reasons of efficiency, when listing killed groups, this specification -is ignored altogether. If the spec is changed considerably, your -output may end up looking strange when listing both alive and killed -groups. - -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." - :group 'gnus-group-visual - :type 'string) - -(defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}" - "*The format specification for the group mode line. -It works along the same lines as a normal formatting string, -with some simple extensions: - -%S The native news server. -%M The native select method. -%: \":\" if %S isn't \"\"." - :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) - -(defcustom gnus-group-menu-hook nil - "*Hook run after the creation of the group mode menu." - :group 'gnus-group-various - :type 'hook) - -(defcustom gnus-group-catchup-group-hook nil - "*Hook run when catching up a group from the group buffer." - :group 'gnus-group-various - :link '(custom-manual "(gnus)Group Data") - :type 'hook) - -(defcustom gnus-group-update-group-hook nil - "*Hook called when updating group lines." - :group 'gnus-group-visual - :type 'hook) - -(defcustom gnus-group-prepare-function 'gnus-group-prepare-flat - "*A function that is called to generate the group buffer. -The function is called with three arguments: The first is a number; -all group with a level less or equal to that number should be listed, -if the second is non-nil, empty groups should also be displayed. If -the third is non-nil, it is a number. No groups with a level lower -than this number should be displayed. - -The only current function implemented is `gnus-group-prepare-flat'." - :group 'gnus-group-listing - :type 'function) - -(defcustom gnus-group-prepare-hook nil - "*Hook called after the group buffer has been generated. -If you want to modify the group buffer, you can use this hook." - :group 'gnus-group-listing - :type 'hook) - -(defcustom gnus-suspend-gnus-hook nil - "*Hook called when suspending (not exiting) Gnus." - :group 'gnus-exit - :type 'hook) - -(defcustom gnus-exit-gnus-hook nil - "*Hook called when exiting Gnus." - :group 'gnus-exit - :type 'hook) - -(defcustom gnus-after-exiting-gnus-hook nil - "*Hook called after exiting Gnus." - :group 'gnus-exit - :type 'hook) - -(defcustom gnus-group-update-hook '(gnus-group-highlight-line) - "*Hook called when a group line is changed. -The hook will not be called if `gnus-visual' is nil. - -The default function `gnus-group-highlight-line' will -highlight the line according to the `gnus-group-highlight' -variable." - :group 'gnus-group-visual - :type 'hook) - -(defcustom gnus-useful-groups - `(("(ding) mailing list mirrored at sunsite.auc.dk" - "emacs.ding" - (nntp "sunsite.auc.dk" - (nntp-address "sunsite.auc.dk"))) - ("Gnus help group" - "gnus-help" - (nndoc "gnus-help" - (nndoc-article-type mbox) - (eval `(nndoc-address - ,(let ((file (nnheader-find-etc-directory - "gnus-tut.txt" t))) - (unless file - (error "Couldn't find doc group")) - file)))))) - "*Alist of useful group-server pairs." - :group 'gnus-group-listing - :type '(repeat (list (string :tag "Description") - (string :tag "Name") - (sexp :tag "Method")))) - -(defcustom gnus-group-highlight - '(;; News. - ((and (= unread 0) (not mailp) (eq level 1)) . - gnus-group-news-1-empty-face) - ((and (not mailp) (eq level 1)) . - gnus-group-news-1-face) - ((and (= unread 0) (not mailp) (eq level 2)) . - gnus-group-news-2-empty-face) - ((and (not mailp) (eq level 2)) . - gnus-group-news-2-face) - ((and (= unread 0) (not mailp) (eq level 3)) . - gnus-group-news-3-empty-face) - ((and (not mailp) (eq level 3)) . - gnus-group-news-3-face) - ((and (= unread 0) (not mailp)) . - 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)) - "*Controls the highlighting of group buffer lines. - -Below is a list of `Form'/`Face' pairs. When deciding how a a -particular group line should be displayed, each form is -evaluated. The content of the face field after the first true form is -used. You can change how those group lines are displayed by -editing the face field. - -It is also possible to change and add form fields, but currently that -requires an understanding of Lisp expressions. Hopefully this will -change in a future release. For now, you can use the following -variables in the Lisp expression: - -group: The name of the group. -unread: The number of unread articles in the group. -method: The select method used. -mailp: Whether it's a mail group or not. -level: The level of the group. -score: The score of the group. -ticked: The number of ticked articles." - :group 'gnus-group-visual - :type '(repeat (cons (sexp :tag "Form") face))) - -(defcustom gnus-new-mail-mark ?% - "*Mark used for groups with new mail." - :group 'gnus-group-visual - :type 'character) - -;;; Internal variables - -(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat - "Function for sorting the group buffer.") - -(defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat - "Function for sorting the selected groups in the group buffer.") - -(defvar gnus-group-indentation-function nil) -(defvar gnus-goto-missing-group-function nil) -(defvar gnus-group-update-group-function nil) -(defvar gnus-group-goto-next-group-function nil - "Function to override finding the next group after listing groups.") - -(defvar gnus-group-edit-buffer nil) - -(defvar gnus-group-line-format-alist - `((?M gnus-tmp-marked-mark ?c) - (?S gnus-tmp-subscribed ?c) - (?L gnus-tmp-level ?d) - (?N (cond ((eq number t) "*" ) - ((numberp number) - (int-to-string - (+ number - (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) - (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) - (t number)) ?s) - (?R gnus-tmp-number-of-read ?s) - (?t gnus-tmp-number-total ?d) - (?y gnus-tmp-number-of-unread ?s) - (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) - (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) - (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) - (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) - (?g gnus-tmp-group ?s) - (?G gnus-tmp-qualified-group ?s) - (?c (gnus-short-group-name gnus-tmp-group) ?s) - (?D gnus-tmp-newsgroup-description ?s) - (?o gnus-tmp-moderated ?c) - (?O gnus-tmp-moderated-string ?s) - (?p gnus-tmp-process-marked ?c) - (?s gnus-tmp-news-server ?s) - (?n gnus-tmp-news-method ?s) - (?P gnus-group-indentation ?s) - (?l gnus-tmp-grouplens ?s) - (?z gnus-tmp-news-method-string ?s) - (?m (gnus-group-new-mail gnus-tmp-group) ?c) - (?d (gnus-group-timestamp-string gnus-tmp-group) ?s) - (?u gnus-tmp-user-defined ?s))) - -(defvar gnus-group-mode-line-format-alist - `((?S gnus-tmp-news-server ?s) - (?M gnus-tmp-news-method ?s) - (?u gnus-tmp-user-defined ?s) - (?: gnus-tmp-colon ?s))) - -(defvar gnus-topic-topology nil - "The complete topic hierarchy.") - -(defvar gnus-topic-alist nil - "The complete topic-group alist.") - -(defvar gnus-group-marked nil) - -(defvar gnus-group-list-mode nil) - -;;; -;;; Gnus group mode -;;; - -(put 'gnus-group-mode 'mode-class 'special) - -(when t - (gnus-define-keys gnus-group-mode-map - " " gnus-group-read-group - "=" gnus-group-select-group - "\r" gnus-group-select-group - "\M-\r" gnus-group-quick-select-group - [(meta control return)] gnus-group-select-group-ephemerally - "j" gnus-group-jump-to-group - "n" gnus-group-next-unread-group - "p" gnus-group-prev-unread-group - "\177" gnus-group-prev-unread-group - [delete] gnus-group-prev-unread-group - [backspace] gnus-group-prev-unread-group - "N" gnus-group-next-group - "P" gnus-group-prev-group - "\M-n" gnus-group-next-unread-group-same-level - "\M-p" gnus-group-prev-unread-group-same-level - "," gnus-group-best-unread-group - "." gnus-group-first-unread-group - "u" gnus-group-unsubscribe-current-group - "U" gnus-group-unsubscribe-group - "c" gnus-group-catchup-current - "C" gnus-group-catchup-current-all - "\M-c" gnus-group-clear-data - "l" gnus-group-list-groups - "L" gnus-group-list-all-groups - "m" gnus-group-mail - "g" gnus-group-get-new-news - "\M-g" gnus-group-get-new-news-this-group - "R" gnus-group-restart - "r" gnus-group-read-init-file - "B" gnus-group-browse-foreign-server - "b" gnus-group-check-bogus-groups - "F" gnus-group-find-new-groups - "\C-c\C-d" gnus-group-describe-group - "\M-d" gnus-group-describe-all-groups - "\C-c\C-a" gnus-group-apropos - "\C-c\M-\C-a" gnus-group-description-apropos - "a" gnus-group-post-news - "\ek" gnus-group-edit-local-kill - "\eK" gnus-group-edit-global-kill - "\C-k" gnus-group-kill-group - "\C-y" gnus-group-yank-group - "\C-w" gnus-group-kill-region - "\C-x\C-t" gnus-group-transpose-groups - "\C-c\C-l" gnus-group-list-killed - "\C-c\C-x" gnus-group-expire-articles - "\C-c\M-\C-x" gnus-group-expire-all-groups - "V" gnus-version - "s" gnus-group-save-newsrc - "z" gnus-group-suspend - "q" gnus-group-exit - "Q" gnus-group-quit - "?" gnus-group-describe-briefly - "\C-c\C-i" gnus-info-find-node - "\M-e" gnus-group-edit-group-method - "^" gnus-group-enter-server-mode - gnus-mouse-2 gnus-mouse-pick-group - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-b" gnus-bug - "\C-c\C-s" gnus-group-sort-groups - "t" gnus-topic-mode - "\C-c\M-g" gnus-activate-all-groups - "\M-&" gnus-group-universal-argument - "#" gnus-group-mark-group - "\M-#" gnus-group-unmark-group) - - (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) - "m" gnus-group-mark-group - "u" gnus-group-unmark-group - "w" gnus-group-mark-region - "b" gnus-group-mark-buffer - "r" gnus-group-mark-regexp - "U" gnus-group-unmark-all-groups) - - (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) - "d" gnus-group-make-directory-group - "h" gnus-group-make-help-group - "u" gnus-group-make-useful-group - "a" gnus-group-make-archive-group - "k" gnus-group-make-kiboze-group - "m" gnus-group-make-group - "E" gnus-group-edit-group - "e" gnus-group-edit-group-method - "p" gnus-group-edit-group-parameters - "v" gnus-group-add-to-virtual - "V" gnus-group-make-empty-virtual - "D" gnus-group-enter-directory - "f" gnus-group-make-doc-group - "w" gnus-group-make-web-group - "r" gnus-group-rename-group - "c" gnus-group-customize - "\177" gnus-group-delete-group - [delete] gnus-group-delete-group) - - (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map) - "b" gnus-group-brew-soup - "w" gnus-soup-save-areas - "s" gnus-soup-send-replies - "p" gnus-soup-pack-packet - "r" nnsoup-pack-replies) - - (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) - "s" gnus-group-sort-groups - "a" gnus-group-sort-groups-by-alphabet - "u" gnus-group-sort-groups-by-unread - "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) - - (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map) - "s" gnus-group-sort-selected-groups - "a" gnus-group-sort-selected-groups-by-alphabet - "u" gnus-group-sort-selected-groups-by-unread - "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) - - (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) - "k" gnus-group-list-killed - "z" gnus-group-list-zombies - "s" gnus-group-list-groups - "u" gnus-group-list-all-groups - "A" gnus-group-list-active - "a" gnus-group-apropos - "d" gnus-group-description-apropos - "m" gnus-group-list-matching - "M" gnus-group-list-all-matching - "l" gnus-group-list-level) - - (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) - "d" gnus-group-describe-group - "f" gnus-group-fetch-faq - "v" gnus-version) - - (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) - "l" gnus-group-set-current-level - "t" gnus-group-unsubscribe-current-group - "s" gnus-group-unsubscribe-group - "k" gnus-group-kill-group - "y" gnus-group-yank-group - "w" gnus-group-kill-region - "\C-k" gnus-group-kill-level - "z" gnus-group-kill-all-zombies)) - -(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)] - ["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 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)] - ["Toggle subscription" gnus-group-unsubscribe-current-group - (gnus-group-group-name)] - ["Kill" gnus-group-kill-group (gnus-group-group-name)] - ["Yank" gnus-group-yank-group gnus-list-of-killed-groups] - ["Describe" gnus-group-describe-group (gnus-group-group-name)] - ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] - ;; Actually one should check, if any of the marked groups gives t for - ;; (gnus-check-backend-function 'request-expire-articles ...) - ["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 - (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)] - ["Select method" gnus-group-edit-group-method - (gnus-group-group-name)] - ["Info" gnus-group-edit-group (gnus-group-group-name)] - ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)] - ["Global kill file" gnus-group-edit-global-kill t]))) - - (easy-menu-define - gnus-group-group-menu gnus-group-mode-map "" - '("Groups" - ("Listing" - ["List unread subscribed groups" gnus-group-list-groups t] - ["List (un)subscribed groups" gnus-group-list-all-groups t] - ["List killed groups" gnus-group-list-killed gnus-killed-list] - ["List zombie groups" gnus-group-list-zombies gnus-zombie-list] - ["List level..." gnus-group-list-level t] - ["Describe all groups" gnus-group-describe-all-groups t] - ["Group apropos..." gnus-group-apropos t] - ["Group and description apropos..." gnus-group-description-apropos t] - ["List groups matching..." gnus-group-list-matching t] - ["List all groups matching..." gnus-group-list-all-matching t] - ["List active file" gnus-group-list-active t]) - ("Sort" - ["Default sort" gnus-group-sort-groups t] - ["Sort by method" gnus-group-sort-groups-by-method t] - ["Sort by rank" gnus-group-sort-groups-by-rank t] - ["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 process/prefixed" - ["Default sort" gnus-group-sort-selected-groups - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by method" gnus-group-sort-selected-groups-by-method - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by rank" gnus-group-sort-selected-groups-by-rank - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by score" gnus-group-sort-selected-groups-by-score - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by level" gnus-group-sort-selected-groups-by-level - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by unread" gnus-group-sort-selected-groups-by-unread - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by name" gnus-group-sort-selected-groups-by-alphabet - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]) - ("Mark" - ["Mark group" gnus-group-mark-group - (and (gnus-group-group-name) - (not (memq (gnus-group-group-name) gnus-group-marked)))] - ["Unmark group" gnus-group-unmark-group - (and (gnus-group-group-name) - (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 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] - ["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] - ["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 - (gnus-check-backend-function - 'request-rename-group (gnus-group-group-name))] - ["Delete group" gnus-group-delete-group - (gnus-check-backend-function - 'request-delete-group (gnus-group-group-name))]) - ("Move" - ["Next" gnus-group-next-group t] - ["Previous" gnus-group-prev-group t] - ["Next unread" gnus-group-next-unread-group t] - ["Previous unread" gnus-group-prev-unread-group t] - ["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] - ["First unread group" gnus-group-first-unread-group t] - ["Best unread group" gnus-group-best-unread-group t]) - ["Delete bogus groups" gnus-group-check-bogus-groups t] - ["Find new newsgroups" gnus-group-find-new-groups t] - ["Transpose" gnus-group-transpose-groups - (gnus-group-group-name)] - ["Read a directory as a group..." gnus-group-enter-directory t])) - - (easy-menu-define - gnus-group-misc-menu gnus-group-mode-map "" - '("Misc" - ("SOUP" - ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] - ["Send replies" gnus-soup-send-replies - (fboundp 'gnus-soup-pack-packet)] - ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)] - ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] - ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)]) - ["Send a bug report" gnus-bug t] - ["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] - ["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] - ["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] - ["Gnus version" gnus-version t] - ["Save .newsrc files" gnus-group-save-newsrc t] - ["Suspend Gnus" gnus-group-suspend t] - ["Clear dribble buffer" gnus-group-clear-dribble t] - ["Read manual" gnus-info-find-node t] - ["Flush score cache" gnus-score-flush-cache t] - ["Toggle topics" gnus-topic-mode t] - ["Exit from Gnus" gnus-group-exit t] - ["Exit without saving" gnus-group-quit t])) - - (gnus-run-hooks 'gnus-group-menu-hook))) - -(defun gnus-group-mode () - "Major mode for reading news. - -All normal editing commands are switched off. -\\ -The group buffer lists (some of) the groups available. For instance, -`\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]' -lists all zombie groups. - -Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe -to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. - -For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). - -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) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-group-mode) - (setq mode-name "Group") - (gnus-group-set-mode-line) - (setq mode-line-process nil) - (use-local-map gnus-group-mode-map) - (buffer-disable-undo (current-buffer)) - (setq truncate-lines t) - (setq buffer-read-only t) - (gnus-set-default-directory) - (gnus-update-format-specifications nil 'group 'group-mode) - (gnus-update-group-mark-positions) - (make-local-hook 'post-command-hook) - (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) - (when gnus-use-undo - (gnus-undo-mode 1)) - (gnus-run-hooks 'gnus-group-mode-hook)) - -(defun gnus-update-group-mark-positions () - (save-excursion - (let ((gnus-process-mark 128) - (gnus-group-marked '("dummy.group")) - (gnus-active-hashtb (make-vector 10 0)) - (topic "")) - (gnus-set-active "dummy.group" '(0 . 0)) - (gnus-set-work-buffer) - (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) - (goto-char (point-min)) - (setq gnus-group-mark-positions - (list (cons 'process (and (search-forward "\200" nil t) - (- (point) 2)))))))) - -(defun gnus-clear-inboxes-moved () - (setq nnmail-moved-inboxes nil)) - -(defun gnus-mouse-pick-group (e) - "Enter the group under the mouse pointer." - (interactive "e") - (mouse-set-point e) - (gnus-group-read-group nil)) - -;; Look at LEVEL and find out what the level is really supposed to be. -;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens -;; will depend on whether `gnus-group-use-permanent-levels' is used. -(defun gnus-group-default-level (&optional level number-or-nil) - (cond - (gnus-group-use-permanent-levels - (or (setq gnus-group-use-permanent-levels - (or level (if (numberp gnus-group-use-permanent-levels) - gnus-group-use-permanent-levels - (or gnus-group-default-list-level - gnus-level-subscribed)))) - gnus-group-default-list-level gnus-level-subscribed)) - (number-or-nil - level) - (t - (or level gnus-group-default-list-level gnus-level-subscribed)))) - -(defun gnus-group-setup-buffer () - (set-buffer (get-buffer-create gnus-group-buffer)) - (unless (eq major-mode 'gnus-group-mode) - (gnus-add-current-to-buffer-list) - (gnus-group-mode) - (when gnus-carpal - (gnus-carpal-setup-buffer 'group)))) - -(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. -If argument UNREAD is non-nil, groups with no unread articles are also -listed. - -Also see the `gnus-group-use-permanent-levels' variable." - (interactive - (list (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - (or - (gnus-group-default-level nil t) - gnus-group-default-list-level - gnus-level-subscribed)))) - ;; Just do this here, for no particular good reason. - (gnus-clear-inboxes-moved) - (unless level - (setq level (car gnus-group-list-mode) - unread (cdr gnus-group-list-mode))) - (setq level (gnus-group-default-level level)) - (gnus-group-setup-buffer) - (gnus-update-format-specifications nil 'group 'group-mode) - (let ((case-fold-search nil) - (props (text-properties-at (gnus-point-at-bol))) - (empty (= (point-min) (point-max))) - (group (gnus-group-group-name)) - number) - (set-buffer gnus-group-buffer) - (setq number (funcall gnus-group-prepare-function level unread lowest)) - (when (or (and (numberp number) - (zerop number)) - (zerop (buffer-size))) - ;; No groups in the buffer. - (gnus-message 5 gnus-no-groups-message)) - ;; We have some groups displayed. - (goto-char (point-max)) - (when (or (not gnus-group-goto-next-group-function) - (not (funcall gnus-group-goto-next-group-function - group props))) - (cond - (empty - (goto-char (point-min))) - ((not group) - ;; Go to the first group with unread articles. - (gnus-group-search-forward t)) - (t - ;; Find the right group to put point on. If the current group - ;; has disappeared in the new listing, try to find the next - ;; one. If no next one can be found, just leave point at the - ;; first newsgroup in the buffer. - (when (not (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe - group gnus-active-hashtb)))) - (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb)))) - (while (and newsrc - (not (gnus-goto-char - (text-property-any - (point-min) (point-max) 'gnus-group - (gnus-intern-safe - (caar newsrc) gnus-active-hashtb))))) - (setq newsrc (cdr newsrc))) - (unless newsrc - (goto-char (point-max)) - (forward-line -1))))))) - ;; Adjust cursor point. - (gnus-group-position-point))) - -(defun gnus-group-list-level (level &optional all) - "List groups on LEVEL. -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) - "List all newsgroups with unread articles of level LEVEL or lower. -If ALL is non-nil, 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." - (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) - (when (< lowest gnus-level-zombie) - ;; 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 bogus - (or (not regexp) - (string-match regexp group)) - (<= (setq clevel (gnus-info-level info)) level) - (>= clevel lowest) - (or all ; We list all groups? - (if (eq unread t) ; Unactivated? - gnus-group-list-inactive-groups ; We list unactivated - (> unread 0)) ; We list groups with unread articles - (and gnus-list-groups-with-ticked-articles - (cdr (assq 'tick (gnus-info-marks info)))) - ; 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))))) - - ;; 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)) - - (gnus-group-set-mode-line) - (setq gnus-group-list-mode (cons level all)) - (gnus-run-hooks 'gnus-group-prepare-hook) - t)) - -(defun gnus-group-prepare-flat-list-dead (groups level mark regexp) - ;; List zombies and killed lists somewhat faster, which was - ;; suggested by Jack Vinson . It does - ;; this by ignoring the group format specification altogether. - (let (group) - (if regexp - ;; This loop is used when listing groups that match some - ;; regexp. - (while groups - (setq group (pop groups)) - (when (string-match regexp group) - (gnus-add-text-properties - (point) (prog1 (1+ (point)) - (insert " " mark " *: " group "\n")) - (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) - 'gnus-unread t - 'gnus-level level)))) - ;; This loop is used when listing all groups. - (while groups - (gnus-add-text-properties - (point) (prog1 (1+ (point)) - (insert " " mark " *: " - (setq group (pop groups)) "\n")) - (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) - 'gnus-unread t - 'gnus-level level)))))) - -(defun gnus-group-update-group-line () - "Update the current line in the group buffer." - (let* ((buffer-read-only nil) - (group (gnus-group-group-name)) - (entry (and group (gnus-gethash group gnus-newsrc-hashtb))) - gnus-group-indentation) - (when group - (and entry - (not (gnus-ephemeral-group-p group)) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (nth 2 entry)) - ")"))) - (setq gnus-group-indentation (gnus-group-group-indentation)) - (gnus-delete-line) - (gnus-group-insert-group-line-info group) - (forward-line -1) - (gnus-group-position-point)))) - -(defun gnus-group-insert-group-line-info (group) - "Insert GROUP on the current line." - (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) - (gnus-group-indentation (gnus-group-group-indentation)) - active info) - (if entry - (progn - ;; (Un)subscribed group. - (setq info (nth 2 entry)) - (gnus-group-insert-group-line - group (gnus-info-level info) (gnus-info-marks info) - (or (car entry) t) (gnus-info-method info))) - ;; This group is dead. - (gnus-group-insert-group-line - group - (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed) - nil - (if (setq active (gnus-active group)) - (if (zerop (cdr active)) - 0 - (- (1+ (cdr active)) (car active))) - nil) - nil)))) - -(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level - gnus-tmp-marked number - gnus-tmp-method) - "Insert a group line in the group buffer." - (let* ((gnus-tmp-active (gnus-active gnus-tmp-group)) - (gnus-tmp-number-total - (if gnus-tmp-active - (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active))) - 0)) - (gnus-tmp-number-of-unread - (if (numberp number) (int-to-string (max 0 number)) - "*")) - (gnus-tmp-number-of-read - (if (numberp number) - (int-to-string (max 0 (- gnus-tmp-number-total number))) - "*")) - (gnus-tmp-subscribed - (cond ((<= gnus-tmp-level gnus-level-subscribed) ? ) - ((<= gnus-tmp-level gnus-level-unsubscribed) ?U) - ((= gnus-tmp-level gnus-level-zombie) ?Z) - (t ?K))) - (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group)) - (gnus-tmp-newsgroup-description - (if gnus-description-hashtb - (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "") - "")) - (gnus-tmp-moderated - (if (and gnus-moderated-hashtb - (gnus-gethash gnus-tmp-group gnus-moderated-hashtb)) - ?m ? )) - (gnus-tmp-moderated-string - (if (eq gnus-tmp-moderated ?m) "(m)" "")) - (gnus-tmp-method - (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) ; - (gnus-tmp-news-server (or (cadr gnus-tmp-method) "")) - (gnus-tmp-news-method (or (car gnus-tmp-method) "")) - (gnus-tmp-news-method-string - (if gnus-tmp-method - (format "(%s:%s)" (car gnus-tmp-method) - (cadr gnus-tmp-method)) "")) - (gnus-tmp-marked-mark - (if (and (numberp number) - (zerop number) - (cdr (assq 'tick gnus-tmp-marked))) - ?* ? )) - (gnus-tmp-process-marked - (if (member gnus-tmp-group gnus-group-marked) - gnus-process-mark ? )) - (gnus-tmp-grouplens - (or (and gnus-use-grouplens - (bbb-grouplens-group-p gnus-tmp-group)) - "")) - (buffer-read-only nil) - header gnus-tmp-header) ; passed as parameter to user-funcs. - (beginning-of-line) - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - ;; Insert the text. - (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) - t) - gnus-marked ,gnus-tmp-marked-mark - gnus-indentation ,gnus-group-indentation - gnus-level ,gnus-tmp-level)) - (when (inline (gnus-visual-p 'group-highlight 'highlight)) - (forward-line -1) - (gnus-run-hooks 'gnus-group-update-hook) - (forward-line)) - ;; Allow XEmacs to remove front-sticky text properties. - (gnus-group-remove-excess-properties))) - -(defun gnus-group-highlight-line () - "Highlight the current line according to `gnus-group-highlight'." - (let* ((list gnus-group-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))) - (group (gnus-group-group-name)) - (entry (gnus-group-entry group)) - (unread (if (numberp (car entry)) (car entry) 0)) - (active (gnus-active group)) - (total (if active (1+ (- (cdr active) (car active))) 0)) - (info (nth 2 entry)) - (method (gnus-server-get-method group (gnus-info-method info))) - (marked (gnus-info-marks info)) - (mailp (memq 'mail (assoc (symbol-name - (car (or method gnus-select-method))) - gnus-valid-select-methods))) - (level (or (gnus-info-level info) gnus-level-killed)) - (score (or (gnus-info-score info) 0)) - (ticked (gnus-range-length (cdr (assq 'tick marked)))) - (group-age (gnus-group-timestamp-delta group)) - (inhibit-read-only t)) - ;; Eval the cars of the lists until we find a match. - (while (and list - (not (eval (caar list)))) - (setq list (cdr list))) - (let ((face (cdar list))) - (unless (eq face (get-text-property beg 'face)) - (gnus-put-text-property - beg end 'face - (setq face (if (boundp face) (symbol-value face) face))) - (gnus-extent-start-open beg))) - (goto-char p))) - -(defun gnus-group-update-group (group &optional visible-only) - "Update all lines where GROUP appear. -If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't -already." - ;; Can't use `save-excursion' here, so we do it manually. - (let ((buf (current-buffer)) - mark) - (set-buffer gnus-group-buffer) - (setq mark (point-marker)) - ;; The buffer may be narrowed. - (save-restriction - (widen) - (let ((ident (gnus-intern-safe group gnus-active-hashtb)) - (loc (point-min)) - found buffer-read-only) - ;; Enter the current status into the dribble buffer. - (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) - (when (and entry (not (gnus-ephemeral-group-p group))) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (nth 2 entry)) - ")")))) - ;; Find all group instances. If topics are in use, each group - ;; may be listed in more than once. - (while (setq loc (text-property-any - loc (point-max) 'gnus-group ident)) - (setq found t) - (goto-char loc) - (let ((gnus-group-indentation (gnus-group-group-indentation))) - (gnus-delete-line) - (gnus-group-insert-group-line-info group) - (save-excursion - (forward-line -1) - (gnus-run-hooks 'gnus-group-update-group-hook))) - (setq loc (1+ loc))) - (unless (or found visible-only) - ;; No such line in the buffer, find out where it's supposed to - ;; go, and insert it there (or at the end of the buffer). - (if gnus-goto-missing-group-function - (funcall gnus-goto-missing-group-function group) - (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb)))) - (while (and entry (car entry) - (not - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe - (caar entry) gnus-active-hashtb))))) - (setq entry (cdr entry))) - (or entry (goto-char (point-max))))) - ;; Finally insert the line. - (let ((gnus-group-indentation (gnus-group-group-indentation))) - (gnus-group-insert-group-line-info group) - (save-excursion - (forward-line -1) - (gnus-run-hooks 'gnus-group-update-group-hook)))) - (when gnus-group-update-group-function - (funcall gnus-group-update-group-function group)) - (gnus-group-set-mode-line))) - (goto-char mark) - (set-marker mark nil) - (set-buffer buf))) - -(defun gnus-group-set-mode-line () - "Update the mode line in the group buffer." - (when (memq 'group gnus-updated-mode-lines) - ;; Yes, we want to keep this mode line updated. - (save-excursion - (set-buffer gnus-group-buffer) - (let* ((gformat (or gnus-group-mode-line-format-spec - (gnus-set-format 'group-mode))) - (gnus-tmp-news-server (cadr gnus-select-method)) - (gnus-tmp-news-method (car gnus-select-method)) - (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":")) - (max-len 60) - gnus-tmp-header ;Dummy binding for user-defined formats - ;; Get the resulting string. - (modified - (and gnus-dribble-buffer - (buffer-name gnus-dribble-buffer) - (buffer-modified-p gnus-dribble-buffer) - (save-excursion - (set-buffer gnus-dribble-buffer) - (not (zerop (buffer-size)))))) - (mode-string (eval gformat))) - ;; Say whether the dribble buffer has been modified. - (setq mode-line-modified - (if modified (car gnus-mode-line-modified) - (cdr gnus-mode-line-modified))) - ;; If the line is too long, we chop it off. - (when (> (length mode-string) max-len) - (setq mode-string (substring mode-string 0 (- max-len 4)))) - (prog1 - (setq mode-line-buffer-identification - (gnus-mode-line-buffer-identification - (list mode-string))) - (set-buffer-modified-p modified)))))) - -(defun gnus-group-group-name () - "Get the name of the newsgroup on the current line." - (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group))) - (and group (symbol-name group)))) - -(defun gnus-group-group-level () - "Get the level of the newsgroup on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-level)) - -(defun gnus-group-group-indentation () - "Get the indentation of the newsgroup on the current line." - (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) - (and gnus-group-indentation-function - (funcall gnus-group-indentation-function)) - "")) - -(defun gnus-group-group-unread () - "Get the number of unread articles of the newsgroup on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-unread)) - -(defun gnus-group-new-mail (group) - (if (nnmail-new-mail-p (gnus-group-real-name group)) - gnus-new-mail-mark - ? )) - -(defun gnus-group-level (group) - "Return the estimated level of GROUP." - (or (gnus-info-level (gnus-get-info group)) - (and (member group gnus-zombie-list) gnus-level-zombie) - gnus-level-killed)) - -(defun gnus-group-search-forward (&optional backward all level first-too) - "Find the next newsgroup with unread articles. -If BACKWARD is non-nil, find the previous newsgroup instead. -If ALL is non-nil, just find any newsgroup. -If LEVEL is non-nil, find group with level LEVEL, or higher if no such -group exists. -If FIRST-TOO, the current line is also eligible as a target." - (let ((way (if backward -1 1)) - (low gnus-level-killed) - (beg (point)) - pos found lev) - (if (and backward (progn (beginning-of-line)) (bobp)) - nil - (unless first-too - (forward-line way)) - (while (and - (not (eobp)) - (not (setq - found - (and - (get-text-property (point) 'gnus-group) - (or all - (and - (let ((unread - (get-text-property (point) 'gnus-unread))) - (and (numberp unread) (> unread 0))) - (setq lev (get-text-property (point) - 'gnus-level)) - (<= lev gnus-level-subscribed))) - (or (not level) - (and (setq lev (get-text-property (point) - 'gnus-level)) - (or (= lev level) - (and (< lev low) - (< level lev) - (progn - (setq low lev) - (setq pos (point)) - nil)))))))) - (zerop (forward-line way))))) - (if found - (progn (gnus-group-position-point) t) - (goto-char (or pos beg)) - (and pos t)))) - -;;; Gnus group mode commands - -;; Group marking. - -(defun gnus-group-mark-group (n &optional unmark no-advance) - "Mark the current group." - (interactive "p") - (let ((buffer-read-only nil) - group) - (while (and (> n 0) - (not (eobp))) - (when (setq group (gnus-group-group-name)) - ;; Go to the mark position. - (beginning-of-line) - (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) - (subst-char-in-region - (point) (1+ (point)) (following-char) - (if unmark - (progn - (setq gnus-group-marked (delete group gnus-group-marked)) - ? ) - (setq gnus-group-marked - (cons group (delete group gnus-group-marked))) - gnus-process-mark))) - (unless no-advance - (gnus-group-next-group 1)) - (decf n)) - (gnus-summary-position-point) - n)) - -(defun gnus-group-unmark-group (n) - "Remove the mark from the current group." - (interactive "p") - (gnus-group-mark-group n 'unmark) - (gnus-group-position-point)) - -(defun gnus-group-unmark-all-groups () - "Unmark all groups." - (interactive) - (let ((groups gnus-group-marked)) - (save-excursion - (while groups - (gnus-group-remove-mark (pop groups))))) - (gnus-group-position-point)) - -(defun gnus-group-mark-region (unmark beg end) - "Mark all groups between point and mark. -If UNMARK, remove the mark instead." - (interactive "P\nr") - (let ((num (count-lines beg end))) - (save-excursion - (goto-char beg) - (- num (gnus-group-mark-group num unmark))))) - -(defun gnus-group-mark-buffer (&optional unmark) - "Mark all groups in the buffer. -If UNMARK, remove the mark instead." - (interactive "P") - (gnus-group-mark-region unmark (point-min) (point-max))) - -(defun gnus-group-mark-regexp (regexp) - "Mark all groups that match some regexp." - (interactive "sMark (regexp): ") - (let ((alist (cdr gnus-newsrc-alist)) - group) - (while alist - (when (string-match regexp (setq group (gnus-info-group (pop alist)))) - (gnus-group-set-mark group)))) - (gnus-group-position-point)) - -(defun gnus-group-remove-mark (group) - "Remove the process mark from GROUP and move point there. -Return nil if the group isn't displayed." - (if (gnus-group-goto-group group) - (save-excursion - (gnus-group-mark-group 1 'unmark t) - t) - (setq gnus-group-marked - (delete group gnus-group-marked)) - nil)) - -(defun gnus-group-set-mark (group) - "Set the process mark on GROUP." - (if (gnus-group-goto-group group) - (save-excursion - (gnus-group-mark-group 1 nil t)) - (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) - -(defun gnus-group-universal-argument (arg &optional groups func) - "Perform any command on all groups according to the process/prefix convention." - (interactive "P") - (if (eq (setq func (or func - (key-binding - (read-key-sequence - (substitute-command-keys - "\\\\[gnus-group-universal-argument]"))))) - 'undefined) - (gnus-error 1 "Undefined key") - (gnus-group-iterate arg - (lambda (group) - (command-execute func)))) - (gnus-group-position-point)) - -(defun gnus-group-process-prefix (n) - "Return a list of groups to work on. -Take into consideration N (the prefix) and the list of marked groups." - (cond - (n - (setq n (prefix-numeric-value n)) - ;; There is a prefix, so we return a list of the N next - ;; groups. - (let ((way (if (< n 0) -1 1)) - (n (abs n)) - group groups) - (save-excursion - (while (> n 0) - (if (setq group (gnus-group-group-name)) - (push group groups)) - (setq n (1- n)) - (gnus-group-next-group way))) - (nreverse groups))) - ((gnus-region-active-p) - ;; Work on the region between point and mark. - (let ((max (max (point) (mark))) - groups) - (save-excursion - (goto-char (min (point) (mark))) - (while - (and - (push (gnus-group-group-name) groups) - (zerop (gnus-group-next-group 1)) - (< (point) max))) - (nreverse groups)))) - (gnus-group-marked - ;; No prefix, but a list of marked articles. - (reverse gnus-group-marked)) - (t - ;; Neither marked articles or a prefix, so we return the - ;; current group. - (let ((group (gnus-group-group-name))) - (and group (list group)))))) - -;;; !!!Surely gnus-group-iterate should be a macro instead? I can't -;;; imagine why I went through these contortions... -(eval-and-compile - (let ((function (make-symbol "gnus-group-iterate-function")) - (window (make-symbol "gnus-group-iterate-window")) - (groups (make-symbol "gnus-group-iterate-groups")) - (group (make-symbol "gnus-group-iterate-group"))) - (eval - `(defun gnus-group-iterate (arg ,function) - "Iterate FUNCTION over all process/prefixed groups. -FUNCTION will be called with the group name as the paremeter -and with point over the group in question." - (let ((,groups (gnus-group-process-prefix arg)) - (,window (selected-window)) - ,group) - (while (setq ,group (pop ,groups)) - (select-window ,window) - (gnus-group-remove-mark ,group) - (save-selected-window - (save-excursion - (funcall ,function ,group))))))))) - -(put 'gnus-group-iterate 'lisp-indent-function 1) - -;; Selecting groups. - -(defun gnus-group-read-group (&optional all no-article group) - "Read news in this newsgroup. -If the prefix argument ALL is non-nil, already read articles become -readable. IF ALL is a number, fetch this number of articles. If the -optional argument NO-ARTICLE is non-nil, no article will be -auto-selected upon group entry. If GROUP is non-nil, fetch that -group." - (interactive "P") - (let ((no-display (eq all 0)) - (group (or group (gnus-group-group-name))) - number active marked entry) - (when (eq all 0) - (setq all nil)) - (unless group - (error "No group on current line")) - (setq marked (gnus-info-marks - (nth 2 (setq entry (gnus-gethash - group gnus-newsrc-hashtb))))) - ;; This group might be a dead group. In that case we have to get - ;; the number of unread articles from `gnus-active-hashtb'. - (setq number - (cond ((numberp all) all) - (entry (car entry)) - ((setq active (gnus-active group)) - (- (1+ (cdr active)) (car active))))) - (gnus-summary-read-group - group (or all (and (numberp number) - (zerop (+ number (gnus-range-length - (cdr (assq 'tick marked))) - (gnus-range-length - (cdr (assq 'dormant marked))))))) - no-article nil no-display))) - -(defun gnus-group-select-group (&optional all) - "Select this newsgroup. -No article is selected automatically. -If ALL is non-nil, already read articles become readable. -If ALL is a number, fetch this number of articles." - (interactive "P") - (gnus-group-read-group all t)) - -(defun gnus-group-quick-select-group (&optional all) - "Select the current group \"quickly\". -This means that no highlighting or scoring will be performed. -If ALL (the prefix argument) is 0, don't even generate the summary -buffer. - -This might be useful if you want to toggle threading -before entering the group." - (interactive "P") - (require 'gnus-score) - (let (gnus-visual - gnus-score-find-score-files-function - gnus-home-score-file - gnus-apply-kill-hook - gnus-summary-expunge-below) - (gnus-group-read-group all t))) - -(defun gnus-group-visible-select-group (&optional all) - "Select the current group without hiding any articles." - (interactive "P") - (let ((gnus-inhibit-limiting t)) - (gnus-group-read-group all t))) - -(defun gnus-group-select-group-ephemerally () - "Select the current group without doing any processing whatsoever. -You will actually be entered into a group that's a copy of -the current group; no changes you make while in this group will -be permanent." - (interactive) - (require 'gnus-score) - (let* (gnus-visual - gnus-score-find-score-files-function gnus-apply-kill-hook - gnus-summary-expunge-below gnus-show-threads gnus-suppress-duplicates - gnus-summary-mode-hook gnus-select-group-hook - (group (gnus-group-group-name)) - (method (gnus-find-method-for-group group))) - (setq method - `(,(car method) ,(concat (cadr method) "-ephemeral") - (,(intern (format "%s-address" (car method))) ,(cadr method)) - ,@(cddr method))) - (gnus-group-read-ephemeral-group - (gnus-group-prefixed-name group method) method))) - -;;;###autoload -(defun gnus-fetch-group (group) - "Start Gnus if necessary and enter GROUP. -Returns whether the fetching was successful or not." - (interactive "sGroup name: ") - (unless (get-buffer gnus-group-buffer) - (gnus-no-server)) - (gnus-group-read-group nil nil group)) - -(defvar gnus-ephemeral-group-server 0) - -;; Enter a group that is not in the group buffer. Non-nil is returned -;; if selection was successful. -(defun gnus-group-read-ephemeral-group (group method &optional activate - quit-config request-only) - "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. - -Return the name of the group is selection was successful." - ;; Transform the select method into a unique server. - (when (stringp method) - (setq method (gnus-server-to-method method))) - (let ((saddr (intern (format "%s-address" (car method))))) - (setq method (gnus-copy-sequence method)) - (require (car method)) - (when (boundp saddr) - (unless (assq saddr method) - (nconc method `((,saddr ,(cadr method)))) - (setf (cadr method) (format "%s-%d" (cadr method) - (incf gnus-ephemeral-group-server)))))) - (let ((group (if (gnus-group-foreign-p group) group - (gnus-group-prefixed-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)))))) - gnus-newsrc-hashtb) - (push method gnus-ephemeral-servers) - (set-buffer gnus-group-buffer) - (unless (gnus-check-server method) - (error "Unable to contact server: %s" (gnus-status-message method))) - (when activate - (gnus-activate-group group 'scan) - (unless (gnus-request-group group) - (error "Couldn't request group: %s" - (nnheader-get-report (car method))))) - (if request-only - group - (condition-case () - (when (gnus-group-read-group t t group) - group) - ;;(error nil) - (quit nil))))) - -(defun gnus-group-jump-to-group (group) - "Jump to newsgroup GROUP." - (interactive - (list (completing-read - "Group: " gnus-active-hashtb nil - (gnus-read-active-file-p) - nil - 'gnus-group-history))) - - (when (equal group "") - (error "Empty group name")) - - (unless (gnus-ephemeral-group-p group) - ;; Either go to the line in the group buffer... - (unless (gnus-group-goto-group group) - ;; ... or insert the line. - (gnus-group-update-group group) - (gnus-group-goto-group group))) - ;; Adjust cursor point. - (gnus-group-position-point)) - -(defun gnus-group-goto-group (group &optional far) - "Goto to newsgroup GROUP. -If FAR, it is likely that the group is not on the current line." - (when group - (if far - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb))) - (beginning-of-line) - (cond - ;; It's quite likely that we are on the right line, so - ;; we check the current line first. - ((eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb)) - (point)) - ;; Previous and next line are also likely, so we check them as well. - ((save-excursion - (forward-line -1) - (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb))) - (forward-line -1) - (point)) - ((save-excursion - (forward-line 1) - (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb))) - (forward-line 1) - (point)) - (t - ;; Search through the entire buffer. - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))) - -(defun gnus-group-next-group (n &optional silent) - "Go to next N'th newsgroup. -If N is negative, search backward instead. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group n t nil silent)) - -(defun gnus-group-next-unread-group (n &optional all level silent) - "Go to next N'th unread newsgroup. -If N is negative, search backward instead. -If ALL is non-nil, choose any newsgroup, unread or not. -If LEVEL is non-nil, choose the next group with level LEVEL, or, if no -such group can be found, the next group with a level higher than -LEVEL. -Returns the difference between N and the number of skips actually -made." - (interactive "p") - (let ((backward (< n 0)) - (n (abs n))) - (while (and (> n 0) - (gnus-group-search-forward - backward (or (not gnus-group-goto-unread) all) level)) - (setq n (1- n))) - (when (and (/= 0 n) - (not silent)) - (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread") - (if level " on this level or higher" ""))) - n)) - -(defun gnus-group-prev-group (n) - "Go to previous N'th newsgroup. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group (- n) t)) - -(defun gnus-group-prev-unread-group (n) - "Go to previous N'th unread newsgroup. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group (- n))) - -(defun gnus-group-next-unread-group-same-level (n) - "Go to next N'th unread newsgroup on the same level. -If N is negative, search backward instead. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group n t (gnus-group-group-level)) - (gnus-group-position-point)) - -(defun gnus-group-prev-unread-group-same-level (n) - "Go to next N'th unread newsgroup on the same level. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group (- n) t (gnus-group-group-level)) - (gnus-group-position-point)) - -(defun gnus-group-best-unread-group (&optional exclude-group) - "Go to the group with the highest level. -If EXCLUDE-GROUP, do not go to that group." - (interactive) - (goto-char (point-min)) - (let ((best 100000) - unread best-point) - (while (not (eobp)) - (setq unread (get-text-property (point) 'gnus-unread)) - (when (and (numberp unread) (> unread 0)) - (when (and (get-text-property (point) 'gnus-level) - (< (get-text-property (point) 'gnus-level) best) - (or (not exclude-group) - (not (equal exclude-group (gnus-group-group-name))))) - (setq best (get-text-property (point) 'gnus-level)) - (setq best-point (point)))) - (forward-line 1)) - (when best-point - (goto-char best-point)) - (gnus-summary-position-point) - (and best-point (gnus-group-group-name)))) - -(defun gnus-group-first-unread-group () - "Go to the first group with unread articles." - (interactive) - (prog1 - (let ((opoint (point)) - unread) - (goto-char (point-min)) - (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active. - (and (numberp unread) ; Not a topic. - (not (zerop unread))) ; Has unread articles. - (zerop (gnus-group-next-unread-group 1))) ; Next unread group. - (point) ; Success. - (goto-char opoint) - nil)) ; Not success. - (gnus-group-position-point))) - -(defun gnus-group-enter-server-mode () - "Jump to the server buffer." - (interactive) - (gnus-enter-server-buffer)) - -(defun gnus-group-make-group (name &optional method address args) - "Add a new newsgroup. -The user will be prompted for a NAME, for a select METHOD, and an -ADDRESS." - (interactive - (list - (gnus-read-group "Group name: ") - (gnus-read-method "From method: "))) - - (let* ((meth (when (and method - (not (gnus-server-equal method gnus-select-method))) - (if address (list (intern method) address) - method))) - (nname (if method (gnus-group-prefixed-name name meth) name)) - backend info) - (when (gnus-gethash nname gnus-newsrc-hashtb) - (error "Group %s already exists" nname)) - ;; Subscribe to the new group. - (gnus-group-change-level - (setq info (list t nname gnus-level-default-subscribed nil nil meth)) - gnus-level-default-subscribed gnus-level-killed - (and (gnus-group-group-name) - (gnus-gethash (gnus-group-group-name) - gnus-newsrc-hashtb)) - t) - ;; Make it active. - (gnus-set-active nname (cons 1 0)) - (unless (gnus-ephemeral-group-p name) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (cdr info)) ")"))) - ;; Insert the line. - (gnus-group-insert-group-line-info nname) - (forward-line -1) - (gnus-group-position-point) - - ;; Load the backend and try to make the backend create - ;; the group as well. - (when (assoc (symbol-name (setq backend (car (gnus-server-get-method - nil meth)))) - gnus-valid-select-methods) - (require backend)) - (gnus-check-server meth) - (when (gnus-check-backend-function 'request-create-group nname) - (gnus-request-create-group nname nil args)) - t)) - -(defun gnus-group-delete-group (group &optional force) - "Delete the current group. Only meaningful with mail groups. -If FORCE (the prefix) is non-nil, all the articles in the group will -be deleted. This is \"deleted\" as in \"removed forever from the face -of the Earth\". There is no undo. The user will be prompted before -doing the deletion." - (interactive - (list (gnus-group-group-name) - current-prefix-arg)) - (unless group - (error "No group to rename")) - (unless (gnus-check-backend-function 'request-delete-group group) - (error "This backend does not support group deletion")) - (prog1 - (if (not (gnus-yes-or-no-p - (format - "Do you really want to delete %s%s? " - group (if force " and all its contents" "")))) - () ; Whew! - (gnus-message 6 "Deleting group %s..." group) - (if (not (gnus-request-delete-group group force)) - (gnus-error 3 "Couldn't delete group %s" group) - (gnus-message 6 "Deleting group %s...done" group) - (gnus-group-goto-group group) - (gnus-group-kill-group 1 t) - (gnus-sethash group nil gnus-active-hashtb) - t)) - (gnus-group-position-point))) - -(defun gnus-group-rename-group (group new-name) - "Rename group from GROUP to NEW-NAME. -When used interactively, GROUP is the group under point -and NEW-NAME will be prompted for." - (interactive - (list - (gnus-group-group-name) - (progn - (unless (gnus-check-backend-function - 'request-rename-group (gnus-group-group-name)) - (error "This backend does not support renaming groups")) - (gnus-read-group "Rename group to: " - (gnus-group-real-name (gnus-group-group-name)))))) - - (unless (gnus-check-backend-function 'request-rename-group group) - (error "This backend does not support renaming groups")) - (unless group - (error "No group to rename")) - (when (equal (gnus-group-real-name group) new-name) - (error "Can't rename to the same name")) - - ;; We find the proper prefixed name. - (setq new-name - (if (gnus-group-native-p group) - ;; Native group. - new-name - ;; Foreign group. - (gnus-group-prefixed-name - (gnus-group-real-name new-name) - (gnus-info-method (gnus-get-info group))))) - - (gnus-message 6 "Renaming group %s to %s..." group new-name) - (prog1 - (if (not (gnus-request-rename-group group new-name)) - (gnus-error 3 "Couldn't rename group %s to %s" group new-name) - ;; We rename the group internally by killing it... - (gnus-group-goto-group group) - (gnus-group-kill-group) - ;; ... changing its name ... - (setcar (cdar gnus-list-of-killed-groups) new-name) - ;; ... and then yanking it. Magic! - (gnus-group-yank-group) - (gnus-set-active new-name (gnus-active group)) - (gnus-message 6 "Renaming group %s to %s...done" group new-name) - new-name) - (gnus-dribble-touch) - (gnus-group-position-point))) - -(defun gnus-group-edit-group (group &optional part) - "Edit the group on the current line." - (interactive (list (gnus-group-group-name))) - (let ((part (or part 'info)) - info) - (unless group - (error "No group on current line")) - (unless (setq info (gnus-get-info group)) - (error "Killed group; can't be edited")) - (ignore-errors - (gnus-close-group group)) - (gnus-edit-form - ;; Find the proper form to edit. - (cond ((eq part 'method) - (or (gnus-info-method info) "native")) - ((eq part 'params) - (gnus-info-params info)) - (t info)) - ;; The proper documentation. - (format - "Editing the %s for `%s'." - (cond - ((eq part 'method) "select method") - ((eq part 'params) "group parameters") - (t "group info")) - group) - `(lambda (form) - (gnus-group-edit-group-done ',part ,group form))))) - -(defun gnus-group-edit-group-method (group) - "Edit the select method of GROUP." - (interactive (list (gnus-group-group-name))) - (gnus-group-edit-group group 'method)) - -(defun gnus-group-edit-group-parameters (group) - "Edit the group parameters of GROUP." - (interactive (list (gnus-group-group-name))) - (gnus-group-edit-group group 'params)) - -(defun gnus-group-edit-group-done (part group form) - "Update variables." - (let* ((method (cond ((eq part 'info) (nth 4 form)) - ((eq part 'method) form) - (t nil))) - (info (cond ((eq part 'info) form) - ((eq part 'method) (gnus-get-info group)) - (t nil))) - (new-group (if info - (if (or (not method) - (gnus-server-equal - gnus-select-method method)) - (gnus-group-real-name (car info)) - (gnus-group-prefixed-name - (gnus-group-real-name (car info)) method)) - nil))) - (when (and new-group - (not (equal new-group group))) - (when (gnus-group-goto-group group) - (gnus-group-kill-group 1)) - (gnus-activate-group new-group)) - ;; Set the info. - (if (not (and info new-group)) - (gnus-group-set-info form (or new-group group) part) - (setq info (gnus-copy-sequence info)) - (setcar info new-group) - (unless (gnus-server-equal method "native") - (unless (nthcdr 3 info) - (nconc info (list nil nil))) - (unless (nthcdr 4 info) - (nconc info (list nil))) - (gnus-info-set-method info method)) - (gnus-group-set-info info)) - (gnus-group-update-group (or new-group group)) - (gnus-group-position-point))) - -(defun gnus-group-make-useful-group (group method) - (interactive - (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups - nil t) - gnus-useful-groups))) - (list (cadr entry) (caddr entry)))) - (setq method (gnus-copy-sequence method)) - (let (entry) - (while (setq entry (memq (assq 'eval method) method)) - (setcar entry (eval (cadar entry))))) - (gnus-group-make-group group method)) - -(defun gnus-group-make-help-group () - "Create the Gnus documentation group." - (interactive) - (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) - (file (nnheader-find-etc-directory "gnus-tut.txt" t)) - dir) - (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))))) - (gnus-group-position-point)) - -(defun gnus-group-make-doc-group (file type) - "Create a group that uses a single file as the source." - (interactive - (list (read-file-name "File name: ") - (and current-prefix-arg 'ask))) - (when (eq type 'ask) - (let ((err "") - char found) - (while (not found) - (message - "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [mbdfag]: " - err) - (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) - ((= char ?b) 'babyl) - ((= char ?d) 'digest) - ((= char ?f) 'forward) - ((= char ?a) 'mmfd) - (t (setq err (format "%c unknown. " char)) - nil)))) - (setq type found))) - (let* ((file (expand-file-name file)) - (name (gnus-generate-new-group-name - (gnus-group-prefixed-name - (file-name-nondirectory file) '(nndoc ""))))) - (gnus-group-make-group - (gnus-group-real-name name) - (list 'nndoc file - (list 'nndoc-address file) - (list 'nndoc-article-type (or type 'guess)))))) - -(defvar nnweb-type-definition) -(defvar gnus-group-web-type-history nil) -(defvar gnus-group-web-search-history nil) -(defun gnus-group-make-web-group (&optional solid) - "Create an ephemeral nnweb group. -If SOLID (the prefix), create a solid group." - (interactive "P") - (require 'nnweb) - (let* ((group - (if solid (gnus-read-group "Group name: ") - (message-unique-id))) - (default-type (or (car gnus-group-web-type-history) - (symbol-name (caar nnweb-type-definition)))) - (type - (gnus-string-or - (completing-read - (format "Search engine type (default %s): " default-type) - (mapcar (lambda (elem) (list (symbol-name (car elem)))) - nnweb-type-definition) - nil t nil 'gnus-group-web-type-history) - default-type)) - (search - (read-string - "Search string: " - (cons (or (car gnus-group-web-search-history) "") 0) - 'gnus-group-web-search-history)) - (method - `(nnweb ,group (nnweb-search ,search) - (nnweb-type ,(intern type)) - (nnweb-ephemeral-p t)))) - (if solid - (gnus-group-make-group group "nnweb" "" `(,(intern type) ,search)) - (gnus-group-read-ephemeral-group - group method t - (cons (current-buffer) - (if (eq major-mode 'gnus-summary-mode) 'summary 'group)))))) - -(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." - (interactive "P") - (let ((group (gnus-group-prefixed-name - (if all "ding.archives" "ding.recent") '(nndir "")))) - (when (gnus-gethash group gnus-newsrc-hashtb) - (error "Archive group already exists")) - (gnus-group-make-group - (gnus-group-real-name group) - (list 'nndir (if all "hpc" "edu") - (list 'nndir-directory - (if all gnus-group-archive-directory - gnus-group-recent-archive-directory)))) - (gnus-group-add-parameter group (cons 'to-address "ding@gnus.org")))) - -(defun gnus-group-make-directory-group (dir) - "Create an nndir group. -The user will be prompted for a directory. The contents of this -directory will be used as a newsgroup. The directory should contain -mail messages or news articles in files that have numeric names." - (interactive - (list (read-file-name "Create group from directory: "))) - (unless (file-exists-p dir) - (error "No such directory")) - (unless (file-directory-p dir) - (error "Not a directory")) - (let ((ext "") - (i 0) - group) - (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb)) - (setq group - (gnus-group-prefixed-name - (concat (file-name-as-directory (directory-file-name dir)) - ext) - '(nndir ""))) - (setq ext (format "<%d>" (setq i (1+ i))))) - (gnus-group-make-group - (gnus-group-real-name group) - (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) - -(defun gnus-group-make-kiboze-group (group address scores) - "Create an nnkiboze group. -The user will be prompted for a name, a regexp to match groups, and -score file entries for articles to include in the group." - (interactive - (list - (read-string "nnkiboze group name: ") - (read-string "Source groups (regexp): ") - (let ((headers (mapcar (lambda (group) (list group)) - '("subject" "from" "number" "date" "message-id" - "references" "chars" "lines" "xref" - "followup" "all" "body" "head"))) - scores header regexp regexps) - (while (not (equal "" (setq header (completing-read - "Match on header: " headers nil t)))) - (setq regexps nil) - (while (not (equal "" (setq regexp (read-string - (format "Match on %s (string): " - header))))) - (push (list regexp nil nil 'r) regexps)) - (push (cons header regexps) scores)) - scores))) - (gnus-group-make-group group "nnkiboze" address) - (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group)) - (let (emacs-lisp-mode-hook) - (pp scores (current-buffer))))) - -(defun gnus-group-add-to-virtual (n vgroup) - "Add the current group to a virtual group." - (interactive - (list current-prefix-arg - (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t - "nnvirtual:"))) - (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) - (error "%s is not an nnvirtual group" vgroup)) - (gnus-close-group vgroup) - (let* ((groups (gnus-group-process-prefix n)) - (method (gnus-info-method (gnus-get-info vgroup)))) - (setcar (cdr method) - (concat - (nth 1 method) "\\|" - (mapconcat - (lambda (s) - (gnus-group-remove-mark s) - (concat "\\(^" (regexp-quote s) "$\\)")) - groups "\\|")))) - (gnus-group-position-point)) - -(defun gnus-group-make-empty-virtual (group) - "Create a new, fresh, empty virtual group." - (interactive "sCreate new, empty virtual group: ") - (let* ((method (list 'nnvirtual "^$")) - (pgroup (gnus-group-prefixed-name group method))) - ;; Check whether it exists already. - (when (gnus-gethash pgroup gnus-newsrc-hashtb) - (error "Group %s already exists" pgroup)) - ;; Subscribe the new group after the group on the current line. - (gnus-subscribe-group pgroup (gnus-group-group-name) method) - (gnus-group-update-group pgroup) - (forward-line -1) - (gnus-group-position-point))) - -(defun gnus-group-enter-directory (dir) - "Enter an ephemeral nneething group." - (interactive "DDirectory to read: ") - (let* ((method (list 'nneething dir '(nneething-read-only t))) - (leaf (gnus-group-prefixed-name - (file-name-nondirectory (directory-file-name dir)) - method)) - (name (gnus-generate-new-group-name leaf))) - (unless (gnus-group-read-ephemeral-group - name method t - (cons (current-buffer) - (if (eq major-mode 'gnus-summary-mode) - 'summary 'group))) - (error "Couldn't enter %s" dir)))) - -;; Group sorting commands -;; Suggested by Joe Hildebrand . - -(defun gnus-group-sort-groups (func &optional reverse) - "Sort the group buffer according to FUNC. -When used interactively, the sorting function used will be -determined by the `gnus-group-sort-function' variable. -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-list-groups) - (gnus-dribble-touch)) - -(defun gnus-group-sort-flat (func reverse) - ;; We peel off the dummy group from the alist. - (when func - (when (equal (gnus-info-group (car gnus-newsrc-alist)) "dummy.group") - (pop gnus-newsrc-alist)) - ;; Do the sorting. - (setq gnus-newsrc-alist - (sort gnus-newsrc-alist func)) - (when reverse - (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))) - ;; Regenerate the hash table. - (gnus-make-hashtable-from-newsrc-alist))) - -(defun gnus-group-sort-groups-by-alphabet (&optional reverse) - "Sort the group buffer alphabetically by group name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-alphabet 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." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse)) - -(defun gnus-group-sort-groups-by-level (&optional reverse) - "Sort the group buffer by group level. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-level reverse)) - -(defun gnus-group-sort-groups-by-score (&optional reverse) - "Sort the group buffer by group score. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-score reverse)) - -(defun gnus-group-sort-groups-by-rank (&optional reverse) - "Sort the group buffer by group rank. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) - -(defun gnus-group-sort-groups-by-method (&optional reverse) - "Sort the group buffer alphabetically by backend name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) - -;;; Selected group sorting. - -(defun gnus-group-sort-selected-groups (n func &optional reverse) - "Sort the process/prefixed groups." - (interactive (list current-prefix-arg gnus-group-sort-function)) - (let ((groups (gnus-group-process-prefix n))) - (funcall gnus-group-sort-selected-function - groups (gnus-make-sort-function func) reverse) - (gnus-group-list-groups))) - -(defun gnus-group-sort-selected-flat (groups func reverse) - (let (entries infos) - ;; First find all the group entries for these groups. - (while groups - (push (nthcdr 2 (gnus-gethash (pop groups) gnus-newsrc-hashtb)) - entries)) - ;; Then sort the infos. - (setq infos - (sort - (mapcar - (lambda (entry) (car entry)) - (setq entries (nreverse entries))) - func)) - (when reverse - (setq infos (nreverse infos))) - ;; Go through all the infos and replace the old entries - ;; with the new infos. - (while infos - (setcar entries (pop infos)) - (pop entries)) - ;; Update the hashtable. - (gnus-make-hashtable-from-newsrc-alist))) - -(defun gnus-group-sort-selected-groups-by-alphabet (&optional reverse) - "Sort the group buffer alphabetically by group name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-alphabet reverse)) - -(defun gnus-group-sort-selected-groups-by-unread (&optional reverse) - "Sort the group buffer by number of unread articles. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-unread reverse)) - -(defun gnus-group-sort-selected-groups-by-level (&optional reverse) - "Sort the group buffer by group level. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-level reverse)) - -(defun gnus-group-sort-selected-groups-by-score (&optional reverse) - "Sort the group buffer by group score. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-score reverse)) - -(defun gnus-group-sort-selected-groups-by-rank (&optional reverse) - "Sort the group buffer by group rank. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-rank reverse)) - -(defun gnus-group-sort-selected-groups-by-method (&optional reverse) - "Sort the group buffer alphabetically by backend name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-method reverse)) - -;;; Sorting predicates. - -(defun gnus-group-sort-by-alphabet (info1 info2) - "Sort alphabetically." - (string< (gnus-info-group info1) (gnus-info-group info2))) - -(defun gnus-group-sort-by-real-name (info1 info2) - "Sort alphabetically on real (unprefixed) names." - (string< (gnus-group-real-name (gnus-info-group info1)) - (gnus-group-real-name (gnus-info-group info2)))) - -(defun gnus-group-sort-by-unread (info1 info2) - "Sort by number of unread articles." - (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb))) - (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb)))) - (< (or (and (numberp n1) n1) 0) - (or (and (numberp n2) n2) 0)))) - -(defun gnus-group-sort-by-level (info1 info2) - "Sort by level." - (< (gnus-info-level info1) (gnus-info-level info2))) - -(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))))) - -(defun gnus-group-sort-by-score (info1 info2) - "Sort by group score." - (< (gnus-info-score info1) (gnus-info-score info2))) - -(defun gnus-group-sort-by-rank (info1 info2) - "Sort by level and score." - (let ((level1 (gnus-info-level info1)) - (level2 (gnus-info-level info2))) - (or (< level1 level2) - (and (= level1 level2) - (> (gnus-info-score info1) (gnus-info-score info2)))))) - -;;; Clearing data - -(defun gnus-group-clear-data (&optional arg) - "Clear all marks and read ranges from the current group." - (interactive "P") - (gnus-group-iterate arg - (lambda (group) - (let (info) - (gnus-info-clear-data (setq info (gnus-get-info group))) - (gnus-get-unread-articles-in-group info (gnus-active group) t) - (when (gnus-group-goto-group group) - (gnus-group-update-group-line)))))) - -(defun gnus-group-clear-data-on-native-groups () - "Clear all marks and read ranges from all native groups." - (interactive) - (when (gnus-yes-or-no-p "Really clear all data from almost all groups? ") - (let ((alist (cdr gnus-newsrc-alist)) - info) - (while (setq info (pop alist)) - (when (gnus-group-native-p (gnus-info-group info)) - (gnus-info-clear-data info))) - (gnus-get-unread-articles) - (gnus-dribble-enter "") - (when (gnus-y-or-n-p - "Move the cache away to avoid problems in the future? ") - (call-interactively 'gnus-cache-move-cache))))) - -(defun gnus-info-clear-data (info) - "Clear all marks and read ranges from INFO." - (let ((group (gnus-info-group info))) - (gnus-undo-register - `(progn - (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-group-update-group-line)))) - (gnus-info-set-read info nil) - (when (gnus-info-marks info) - (gnus-info-set-marks info nil)))) - -;; Group catching up. - -(defun gnus-group-catchup-current (&optional n all) - "Mark all articles not marked as unread in current newsgroup as read. -If prefix argument N is numeric, the next N newsgroups will be -caught up. If ALL is non-nil, marked articles will also be marked as -read. Cross references (Xref: header) of articles are ignored. -The number of newsgroups that this function was unable to catch -up is returned." - (interactive "P") - (let ((groups (gnus-group-process-prefix n)) - (ret 0)) - (unless groups (error "No groups selected")) - (if (not - (or (not gnus-interactive-catchup) ;Without confirmation? - gnus-expert-user - (gnus-y-or-n-p - (format - (if all - "Do you really want to mark all articles in %s as read? " - "Mark all unread articles in %s as read? ") - (if (= (length groups) 1) - (car groups) - (format "these %d groups" (length groups))))))) - n - (while groups - ;; Virtual groups have to be given special treatment. - (let ((method (gnus-find-method-for-group (car groups)))) - (when (eq 'nnvirtual (car method)) - (nnvirtual-catchup-group - (gnus-group-real-name (car groups)) (nth 1 method) all))) - (gnus-group-remove-mark (car groups)) - (if (>= (gnus-group-group-level) gnus-level-zombie) - (gnus-message 2 "Dead groups can't be caught up") - (if (prog1 - (gnus-group-goto-group (car groups)) - (gnus-group-catchup (car groups) all)) - (gnus-group-update-group-line) - (setq ret (1+ ret)))) - (setq groups (cdr groups))) - (gnus-group-next-unread-group 1) - ret))) - -(defun gnus-group-catchup-current-all (&optional n) - "Mark all articles in current newsgroup as read. -Cross references (Xref: header) of articles are ignored." - (interactive "P") - (gnus-group-catchup-current n 'all)) - -(defun gnus-group-catchup (group &optional all) - "Mark all articles in GROUP as read. -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))) - ;; 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) - ;; 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)))) - -(defun gnus-group-expire-articles (&optional n) - "Expire all expirable articles in the current newsgroup." - (interactive "P") - (let ((groups (gnus-group-process-prefix n)) - group) - (unless groups - (error "No groups to expire")) - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - (when (gnus-check-backend-function 'request-expire-articles group) - (gnus-message 6 "Expiring articles in %s..." group) - (let* ((info (gnus-get-info group)) - (expirable (if (gnus-group-total-expirable-p group) - (cons nil (gnus-list-of-read-articles group)) - (assq 'expire (gnus-info-marks info)))) - (expiry-wait (gnus-group-find-parameter group 'expiry-wait))) - (when expirable - (setcdr - expirable - (gnus-compress-sequence - (if expiry-wait - ;; We set the expiry variables to the group - ;; parameter. - (let ((nnmail-expiry-wait-function nil) - (nnmail-expiry-wait expiry-wait)) - (gnus-request-expire-articles - (gnus-uncompress-sequence (cdr expirable)) group)) - ;; Just expire using the normal expiry values. - (gnus-request-expire-articles - (gnus-uncompress-sequence (cdr expirable)) group)))) - (gnus-close-group group)) - (gnus-message 6 "Expiring articles in %s...done" group))) - (gnus-dribble-touch) - (gnus-group-position-point)))) - -(defun gnus-group-expire-all-groups () - "Expire all expirable articles in all newsgroups." - (interactive) - (save-excursion - (gnus-message 5 "Expiring...") - (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info)) - (cdr gnus-newsrc-alist)))) - (gnus-group-expire-articles nil))) - (gnus-group-position-point) - (gnus-message 5 "Expiring...done")) - -(defun gnus-group-set-current-level (n level) - "Set the level of the next N groups to LEVEL." - (interactive - (list - current-prefix-arg - (string-to-int - (let ((s (read-string - (format "Level (default %s): " - (or (gnus-group-group-level) - gnus-level-default-subscribed))))) - (if (string-match "^\\s-*$" s) - (int-to-string (or (gnus-group-group-level) - gnus-level-default-subscribed)) - s))))) - (unless (and (>= level 1) (<= level gnus-level-killed)) - (error "Illegal level: %d" level)) - (let ((groups (gnus-group-process-prefix n)) - group) - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - (gnus-message 6 "Changed level of %s from %d to %d" - group (or (gnus-group-group-level) gnus-level-killed) - level) - (gnus-group-change-level - group level (or (gnus-group-group-level) gnus-level-killed)) - (gnus-group-update-group-line))) - (gnus-group-position-point)) - -(defun gnus-group-unsubscribe (&optional n) - "Unsubscribe the current group." - (interactive "P") - (gnus-group-unsubscribe-current-group n 'unsubscribe)) - -(defun gnus-group-subscribe (&optional n) - "Subscribe the current group." - (interactive "P") - (gnus-group-unsubscribe-current-group n 'subscribe)) - -(defun gnus-group-unsubscribe-current-group (&optional n do-sub) - "Toggle subscription of the current group. -If given numerical prefix, toggle the N next groups." - (interactive "P") - (let ((groups (gnus-group-process-prefix n)) - group) - (while groups - (setq group (car groups) - groups (cdr groups)) - (gnus-group-remove-mark group) - (gnus-group-unsubscribe-group - group - (cond - ((eq do-sub 'unsubscribe) - gnus-level-default-unsubscribed) - ((eq do-sub 'subscribe) - gnus-level-default-subscribed) - ((<= (gnus-group-group-level) gnus-level-subscribed) - gnus-level-default-unsubscribed) - (t - gnus-level-default-subscribed)) - t) - (gnus-group-update-group-line)) - (gnus-group-next-group 1))) - -(defun gnus-group-unsubscribe-group (group &optional level silent) - "Toggle subscription to GROUP. -Killed newsgroups are subscribed. If SILENT, don't try to update the -group line." - (interactive - (list (completing-read - "Group: " gnus-active-hashtb nil - (gnus-read-active-file-p) - nil - 'gnus-group-history))) - (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) - (cond - ((string-match "^[ \t]*$" group) - (error "Empty group name")) - (newsrc - ;; Toggle subscription flag. - (gnus-group-change-level - newsrc (if level level (if (<= (gnus-info-level (nth 2 newsrc)) - gnus-level-subscribed) - (1+ gnus-level-subscribed) - gnus-level-default-subscribed))) - (unless silent - (gnus-group-update-group group))) - ((and (stringp group) - (or (not (gnus-read-active-file-p)) - (gnus-active group))) - ;; Add new newsgroup. - (gnus-group-change-level - group - (if level level gnus-level-default-subscribed) - (or (and (member group gnus-zombie-list) - gnus-level-zombie) - gnus-level-killed) - (when (gnus-group-group-name) - (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) - (unless silent - (gnus-group-update-group group))) - (t (error "No such newsgroup: %s" group))) - (gnus-group-position-point))) - -(defun gnus-group-transpose-groups (n) - "Move the current newsgroup up N places. -If given a negative prefix, move down instead. The difference between -N and the number of steps taken is returned." - (interactive "p") - (unless (gnus-group-group-name) - (error "No group on current line")) - (gnus-group-kill-group 1) - (prog1 - (forward-line (- n)) - (gnus-group-yank-group) - (gnus-group-position-point))) - -(defun gnus-group-kill-all-zombies () - "Kill all zombie newsgroups." - (interactive) - (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) - (setq gnus-zombie-list nil) - (gnus-dribble-touch) - (gnus-group-list-groups)) - -(defun gnus-group-kill-region (begin end) - "Kill newsgroups in current region (excluding current point). -The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." - (interactive "r") - (let ((lines - ;; Count lines. - (save-excursion - (count-lines - (progn - (goto-char begin) - (beginning-of-line) - (point)) - (progn - (goto-char end) - (beginning-of-line) - (point)))))) - (goto-char begin) - (beginning-of-line) ;Important when LINES < 1 - (gnus-group-kill-group lines))) - -(defun gnus-group-kill-group (&optional n discard) - "Kill the next N groups. -The killed newsgroups can be yanked by using \\[gnus-group-yank-group]. -However, only groups that were alive can be yanked; already killed -groups or zombie groups can't be yanked. -The return value is the name of the group that was killed, or a list -of groups killed." - (interactive "P") - (let ((buffer-read-only nil) - (groups (gnus-group-process-prefix n)) - group entry level out) - (if (< (length groups) 10) - ;; This is faster when there are few groups. - (while groups - (push (setq group (pop groups)) out) - (gnus-group-remove-mark group) - (setq level (gnus-group-group-level)) - (gnus-delete-line) - (when (and (not discard) - (setq entry (gnus-gethash group gnus-newsrc-hashtb))) - (gnus-undo-register - `(progn - (gnus-group-goto-group ,(gnus-group-group-name)) - (gnus-group-yank-group))) - (push (cons (car entry) (nth 2 entry)) - gnus-list-of-killed-groups)) - (gnus-group-change-level - (if entry entry group) gnus-level-killed (if entry nil level))) - ;; If there are lots and lots of groups to be killed, we use - ;; this thing instead. - (let (entry) - (setq groups (nreverse groups)) - (while groups - (gnus-group-remove-mark (setq group (pop groups))) - (gnus-delete-line) - (push group gnus-killed-list) - (setq gnus-newsrc-alist - (delq (assoc group gnus-newsrc-alist) - gnus-newsrc-alist)) - (when gnus-group-change-level-function - (funcall gnus-group-change-level-function group gnus-level-killed 3)) - (cond - ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) - (push (cons (car entry) (nth 2 entry)) - gnus-list-of-killed-groups) - (setcdr (cdr entry) (cdddr entry))) - ((member group gnus-zombie-list) - (setq gnus-zombie-list (delete group gnus-zombie-list)))) - ;; There may be more than one instance displayed. - (while (gnus-group-goto-group group) - (gnus-delete-line))) - (gnus-make-hashtable-from-newsrc-alist))) - - (gnus-group-position-point) - (if (< (length out) 2) (car out) (nreverse out)))) - -(defun gnus-group-yank-group (&optional arg) - "Yank the last newsgroups killed with \\[gnus-group-kill-group], -inserting it before the current newsgroup. The numeric ARG specifies -how many newsgroups are to be yanked. The name of the newsgroup yanked -is returned, or (if several groups are yanked) a list of yanked groups -is returned." - (interactive "p") - (setq arg (or arg 1)) - (let (info group prev out) - (while (>= (decf arg) 0) - (when (not (setq info (pop gnus-list-of-killed-groups))) - (error "No more newsgroups to yank")) - (push (setq group (nth 1 info)) out) - ;; Find which newsgroup to insert this one before - search - ;; backward until something suitable is found. If there are no - ;; other newsgroups in this buffer, just make this newsgroup the - ;; first newsgroup. - (setq prev (gnus-group-group-name)) - (gnus-group-change-level - info (gnus-info-level (cdr info)) gnus-level-killed - (and prev (gnus-gethash prev gnus-newsrc-hashtb)) - t) - (gnus-group-insert-group-line-info group) - (gnus-undo-register - `(when (gnus-group-goto-group ,group) - (gnus-group-kill-group 1)))) - (forward-line -1) - (gnus-group-position-point) - (if (< (length out) 2) (car out) (nreverse out)))) - -(defun gnus-group-kill-level (level) - "Kill all groups that is on a certain LEVEL." - (interactive "nKill all groups on level: ") - (cond - ((= level gnus-level-zombie) - (setq gnus-killed-list - (nconc gnus-zombie-list gnus-killed-list)) - (setq gnus-zombie-list nil)) - ((and (< level gnus-level-zombie) - (> level 0) - (or gnus-expert-user - (gnus-yes-or-no-p - (format - "Do you really want to kill all groups on level %d? " - level)))) - (let* ((prev gnus-newsrc-alist) - (alist (cdr prev))) - (while alist - (if (= (gnus-info-level (car alist)) level) - (progn - (push (gnus-info-group (car alist)) gnus-killed-list) - (setcdr prev (cdr alist))) - (setq prev alist)) - (setq alist (cdr alist))) - (gnus-make-hashtable-from-newsrc-alist) - (gnus-group-list-groups))) - (t - (error "Can't kill; illegal level: %d" level)))) - -(defun gnus-group-list-all-groups (&optional arg) - "List all newsgroups with level ARG or lower. -Default is gnus-level-unsubscribed, which lists all subscribed and most -unsubscribed groups." - (interactive "P") - (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) - -;; Redefine this to list ALL killed groups if prefix arg used. -;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom). -(defun gnus-group-list-killed (&optional arg) - "List all killed newsgroups in the group buffer. -If ARG is non-nil, list ALL killed groups known to Gnus. This may -entail asking the server for the groups." - (interactive "P") - ;; Find all possible killed newsgroups if arg. - (when arg - (gnus-get-killed-groups)) - (if (not gnus-killed-list) - (gnus-message 6 "No killed groups") - (let (gnus-group-list-mode) - (funcall gnus-group-prepare-function - gnus-level-killed t gnus-level-killed)) - (goto-char (point-min))) - (gnus-group-position-point)) - -(defun gnus-group-list-zombies () - "List all zombie newsgroups in the group buffer." - (interactive) - (if (not gnus-zombie-list) - (gnus-message 6 "No zombie groups") - (let (gnus-group-list-mode) - (funcall gnus-group-prepare-function - gnus-level-zombie t gnus-level-zombie)) - (goto-char (point-min))) - (gnus-group-position-point)) - -(defun gnus-group-list-active () - "List all groups that are available from the server(s)." - (interactive) - ;; First we make sure that we have really read the active file. - (unless (gnus-read-active-file-p) - (let ((gnus-read-active-file t)) - (gnus-read-active-file))) - ;; Find all groups and sort them. - (let ((groups - (sort - (let (list) - (mapatoms - (lambda (sym) - (and (boundp sym) - (symbol-value sym) - (push (symbol-name sym) list))) - gnus-active-hashtb) - list) - 'string<)) - (buffer-read-only nil) - group) - (erase-buffer) - (while groups - (gnus-add-text-properties - (point) (prog1 (1+ (point)) - (insert " *: " - (setq group (pop groups)) "\n")) - (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) - 'gnus-unread t - 'gnus-level (inline (gnus-group-level group))))) - (goto-char (point-min)))) - -(defun gnus-activate-all-groups (level) - "Activate absolutely all groups." - (interactive (list gnus-level-unsubscribed)) - (let ((gnus-activate-level level) - (gnus-activate-foreign-newsgroups level)) - (gnus-group-get-new-news))) - -(defun gnus-group-get-new-news (&optional arg) - "Get newly arrived articles. -If ARG is a number, it specifies which levels you are interested in -re-scanning. If ARG is non-nil and not a number, this will force -\"hard\" re-reading of the active files from all servers." - (interactive "P") - (let ((gnus-inhibit-demon t)) - (gnus-run-hooks 'gnus-get-new-news-hook) - - ;; Read any slave files. - (unless gnus-slave - (gnus-master-read-slave-newsrc)) - - ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem - (null arg)) - (gnus-nocem-scan-groups)) - ;; If ARG is not a number, then we read the active file. - (when (and arg (not (numberp arg))) - (let ((gnus-read-active-file t)) - (gnus-read-active-file)) - (setq arg nil) - - ;; If the user wants it, we scan for new groups. - (when (eq gnus-check-new-newsgroups 'always) - (gnus-find-new-newsgroups))) - - (setq arg (gnus-group-default-level arg t)) - (if (and gnus-read-active-file (not arg)) - (progn - (gnus-read-active-file) - (gnus-get-unread-articles arg)) - (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) - (gnus-get-unread-articles arg))) - (gnus-run-hooks 'gnus-after-getting-new-news-hook) - (gnus-group-list-groups (and (numberp arg) - (max (car gnus-group-list-mode) arg))))) - -(defun gnus-group-get-new-news-this-group (&optional n dont-scan) - "Check for newly arrived news in the current group (and the N-1 next groups). -The difference between N and the number of newsgroup checked is returned. -If N is negative, this group and the N-1 previous groups will be checked." - (interactive "P") - (let* ((groups (gnus-group-process-prefix n)) - (ret (if (numberp n) (- n (length groups)) 0)) - (beg (unless n - (point))) - group) - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - ;; Bypass any previous denials from the server. - (gnus-remove-denial (gnus-find-method-for-group group)) - (if (gnus-activate-group group (if dont-scan nil 'scan)) - (progn - (gnus-get-unread-articles-in-group - (gnus-get-info group) (gnus-active group) t) - (unless (gnus-virtual-group-p group) - (gnus-close-group group)) - (gnus-group-update-group group)) - (if (eq (gnus-server-status (gnus-find-method-for-group group)) - 'denied) - (gnus-error 3 "Server denied access") - (gnus-error 3 "%s error: %s" group (gnus-status-message group))))) - (when beg - (goto-char beg)) - (when gnus-goto-next-group-when-activating - (gnus-group-next-unread-group 1 t)) - (gnus-summary-position-point) - ret)) - -(defun gnus-group-fetch-faq (group &optional faq-dir) - "Fetch the FAQ for the current group. -If given a prefix argument, prompt for the FAQ dir -to use." - (interactive - (list - (gnus-group-group-name) - (when current-prefix-arg - (completing-read - "Faq dir: " (and (listp gnus-group-faq-directory) - (mapcar (lambda (file) (list file)) - gnus-group-faq-directory)))))) - (unless group - (error "No group name given")) - (let ((dirs (or faq-dir gnus-group-faq-directory)) - dir found file) - (unless (listp dirs) - (setq dirs (list dirs))) - (while (and (not found) - (setq dir (pop dirs))) - (let ((name (gnus-group-real-name group))) - (while (string-match "\\." name) - (setq name (replace-match "/" t t name))) - (setq file (concat (file-name-as-directory dir) name))) - (if (not (file-exists-p file)) - (gnus-message 1 "No such file: %s" file) - (let ((enable-local-variables nil)) - (find-file file) - (setq found t)))))) - -(defun gnus-group-describe-group (force &optional group) - "Display a description of the current newsgroup." - (interactive (list current-prefix-arg (gnus-group-group-name))) - (let* ((method (gnus-find-method-for-group group)) - (mname (gnus-group-prefixed-name "" method)) - desc) - (when (and force - gnus-description-hashtb) - (gnus-sethash mname nil gnus-description-hashtb)) - (unless group - (error "No group name given")) - (when (or (and gnus-description-hashtb - ;; We check whether this group's method has been - ;; queried for a description file. - (gnus-gethash mname gnus-description-hashtb)) - (setq desc (gnus-group-get-description group)) - (gnus-read-descriptions-file method)) - (gnus-message 1 - (or desc (gnus-gethash group gnus-description-hashtb) - "No description available"))))) - -;; Suggested by Per Abrahamsen . -(defun gnus-group-describe-all-groups (&optional force) - "Pop up a buffer with descriptions of all newsgroups." - (interactive "P") - (when force - (setq gnus-description-hashtb nil)) - (when (not (or gnus-description-hashtb - (gnus-read-all-descriptions-files))) - (error "Couldn't request descriptions file")) - (let ((buffer-read-only nil) - b) - (erase-buffer) - (mapatoms - (lambda (group) - (setq b (point)) - (insert (format " *: %-20s %s\n" (symbol-name group) - (symbol-value group))) - (gnus-add-text-properties - b (1+ b) (list 'gnus-group group - 'gnus-unread t 'gnus-marked nil - 'gnus-level (1+ gnus-level-subscribed)))) - gnus-description-hashtb) - (goto-char (point-min)) - (gnus-group-position-point))) - -;; Suggested by Daniel Quinlan . -(defun gnus-group-apropos (regexp &optional search-description) - "List all newsgroups that have names that match a regexp." - (interactive "sGnus apropos (regexp): ") - (let ((prev "") - (obuf (current-buffer)) - groups des) - ;; Go through all newsgroups that are known to Gnus. - (mapatoms - (lambda (group) - (and (symbol-name group) - (string-match regexp (symbol-name group)) - (push (symbol-name group) groups))) - gnus-active-hashtb) - ;; Also go through all descriptions that are known to Gnus. - (when search-description - (mapatoms - (lambda (group) - (and (string-match regexp (symbol-value group)) - (gnus-active (symbol-name group)) - (push (symbol-name group) groups))) - gnus-description-hashtb)) - (if (not groups) - (gnus-message 3 "No groups matched \"%s\"." regexp) - ;; Print out all the groups. - (save-excursion - (pop-to-buffer "*Gnus Help*") - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (setq groups (sort groups 'string<)) - (while groups - ;; Groups may be entered twice into the list of groups. - (when (not (string= (car groups) prev)) - (insert (setq prev (car groups)) "\n") - (when (and gnus-description-hashtb - (setq des (gnus-gethash (car groups) - gnus-description-hashtb))) - (insert " " des "\n"))) - (setq groups (cdr groups))) - (goto-char (point-min)))) - (pop-to-buffer obuf))) - -(defun gnus-group-description-apropos (regexp) - "List all newsgroups that have names or descriptions that match a regexp." - (interactive "sGnus description apropos (regexp): ") - (when (not (or gnus-description-hashtb - (gnus-read-all-descriptions-files))) - (error "Couldn't request descriptions file")) - (gnus-group-apropos regexp t)) - -;; Suggested by Per Abrahamsen . -(defun gnus-group-list-matching (level regexp &optional all lowest) - "List all groups with unread articles that match REGEXP. -If the prefix LEVEL is non-nil, it should be a number that says which -level to cut off listing groups. -If ALL, also list groups with no unread articles. -If LOWEST, don't list groups with level lower than LOWEST. - -This command may read the active file." - (interactive "P\nsList newsgroups matching: ") - ;; First make sure active file has been read. - (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) - (goto-char (point-min)) - (gnus-group-position-point)) - -(defun gnus-group-list-all-matching (level regexp &optional lowest) - "List all groups that match REGEXP. -If the prefix LEVEL is non-nil, it should be a number that says which -level to cut off listing groups. -If LOWEST, don't list groups with level lower than LOWEST." - (interactive "P\nsList newsgroups matching: ") - (when level - (setq level (prefix-numeric-value level))) - (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest)) - -;; Suggested by Jack Vinson . -(defun gnus-group-save-newsrc (&optional force) - "Save the Gnus startup files. -If FORCE, force saving whether it is necessary or not." - (interactive "P") - (gnus-save-newsrc-file force)) - -(defun gnus-group-restart (&optional arg) - "Force Gnus to read the .newsrc file." - (interactive "P") - (when (gnus-yes-or-no-p - (format "Are you sure you want to restart Gnus? ")) - (gnus-save-newsrc-file) - (gnus-clear-system) - (gnus))) - -(defun gnus-group-read-init-file () - "Read the Gnus elisp init file." - (interactive) - (gnus-read-init-file) - (gnus-message 5 "Read %s" gnus-init-file)) - -(defun gnus-group-check-bogus-groups (&optional silent) - "Check bogus newsgroups. -If given a prefix, don't ask for confirmation before removing a bogus -group." - (interactive "P") - (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user))) - (gnus-group-list-groups)) - -(defun gnus-group-find-new-groups (&optional arg) - "Search for new groups and add them. -Each new group will be treated with `gnus-subscribe-newsgroup-method.' -If ARG (the prefix), use the `ask-server' method to query -the server for new groups." - (interactive "P") - (gnus-find-new-newsgroups arg) - (gnus-group-list-groups)) - -(defun gnus-group-edit-global-kill (&optional article group) - "Edit the global kill file. -If GROUP, edit that local kill file instead." - (interactive "P") - (setq gnus-current-kill-article article) - (gnus-kill-file-edit-file group) - (gnus-message - 6 - (substitute-command-keys - (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)" - (if group "local" "global"))))) - -(defun gnus-group-edit-local-kill (article group) - "Edit a local kill file." - (interactive (list nil (gnus-group-group-name))) - (gnus-group-edit-global-kill article group)) - -(defun gnus-group-force-update () - "Update `.newsrc' file." - (interactive) - (gnus-save-newsrc-file)) - -(defun gnus-group-suspend () - "Suspend the current Gnus session. -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) - ;; Kill Gnus buffers except for group mode buffer. - (let* ((group-buf (get-buffer gnus-group-buffer)) - ;; Do this on a separate list in case the user does a ^G before we finish - (gnus-buffer-list - (delete group-buf (delete gnus-dribble-buffer - (append gnus-buffer-list nil))))) - (while gnus-buffer-list - (gnus-kill-buffer (pop gnus-buffer-list))) - (gnus-kill-gnus-frames) - (when group-buf - (setq gnus-buffer-list (list group-buf)) - (bury-buffer group-buf) - (delete-windows-on group-buf t)))) - -(defun gnus-group-clear-dribble () - "Clear all information from the dribble buffer." - (interactive) - (gnus-dribble-clear) - (gnus-message 7 "Cleared dribble buffer")) - -(defun gnus-group-exit () - "Quit reading news after updating .newsrc.eld and .newsrc. -The hook `gnus-exit-gnus-hook' is called before actually exiting." - (interactive) - (when - (or noninteractive ;For gnus-batch-kill - (not gnus-interactive-exit) ;Without confirmation - gnus-expert-user - (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) - (gnus-run-hooks 'gnus-exit-gnus-hook) - ;; Offer to save data from non-quitted summary buffers. - (gnus-offer-save-summaries) - ;; Save the newsrc file(s). - (gnus-save-newsrc-file) - ;; Kill-em-all. - (gnus-close-backends) - ;; Reset everything. - (gnus-clear-system) - ;; Allow the user to do things after cleaning up. - (gnus-run-hooks 'gnus-after-exiting-gnus-hook))) - -(defun gnus-group-quit () - "Quit reading news without updating .newsrc.eld or .newsrc. -The hook `gnus-exit-gnus-hook' is called before actually exiting." - (interactive) - (when (or noninteractive ;For gnus-batch-kill - (zerop (buffer-size)) - (not (gnus-server-opened gnus-select-method)) - gnus-expert-user - (not gnus-current-startup-file) - (gnus-yes-or-no-p - (format "Quit reading news without saving %s? " - (file-name-nondirectory gnus-current-startup-file)))) - (gnus-run-hooks 'gnus-exit-gnus-hook) - (gnus-configure-windows 'group t) - (gnus-dribble-save) - (gnus-close-backends) - (gnus-clear-system) - (gnus-kill-buffer gnus-group-buffer) - ;; Allow the user to do things after cleaning up. - (gnus-run-hooks 'gnus-after-exiting-gnus-hook))) - -(defun gnus-group-describe-briefly () - "Give a one line description of the group mode commands." - (interactive) - (gnus-message 7 (substitute-command-keys "\\\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help"))) - -(defun gnus-group-browse-foreign-server (method) - "Browse a foreign news server. -If called interactively, this function will ask for a select method - (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). -If not, METHOD should be a list where the first element is the method -and the second element is the address." - (interactive - (list (let ((how (completing-read - "Which backend: " - (append gnus-valid-select-methods gnus-server-alist) - nil t (cons "nntp" 0) 'gnus-method-history))) - ;; We either got a backend name or a virtual server name. - ;; If the first, we also need an address. - (if (assoc how gnus-valid-select-methods) - (list (intern how) - ;; Suggested by mapjph@bath.ac.uk. - (completing-read - "Address: " - (mapcar (lambda (server) (list server)) - gnus-secondary-servers))) - ;; We got a server name. - how)))) - (gnus-browse-foreign-server method)) - -(defun gnus-group-set-info (info &optional method-only-group part) - (let* ((entry (gnus-gethash - (or method-only-group (gnus-info-group info)) - gnus-newsrc-hashtb)) - (part-info info) - (info (if method-only-group (nth 2 entry) info)) - method) - (when method-only-group - (unless entry - (error "Trying to change non-existent group %s" method-only-group)) - ;; We have received parts of the actual group info - either the - ;; select method or the group parameters. We first check - ;; whether we have to extend the info, and if so, do that. - (let ((len (length info)) - (total (if (eq part 'method) 5 6))) - (when (< len total) - (setcdr (nthcdr (1- len) info) - (make-list (- total len) nil))) - ;; Then we enter the new info. - (setcar (nthcdr (1- total) info) part-info))) - (unless entry - ;; This is a new group, so we just create it. - (save-excursion - (set-buffer gnus-group-buffer) - (setq method (gnus-info-method info)) - (when (gnus-server-equal method "native") - (setq method nil)) - (save-excursion - (set-buffer gnus-group-buffer) - (if method - ;; It's a foreign group... - (gnus-group-make-group - (gnus-group-real-name (gnus-info-group info)) - (if (stringp method) method - (prin1-to-string (car method))) - (and (consp method) - (nth 1 (gnus-info-method info)))) - ;; It's a native group. - (gnus-group-make-group (gnus-info-group info)))) - (gnus-message 6 "Note: New group created") - (setq entry - (gnus-gethash (gnus-group-prefixed-name - (gnus-group-real-name (gnus-info-group info)) - (or (gnus-info-method info) gnus-select-method)) - gnus-newsrc-hashtb)))) - ;; Whether it was a new group or not, we now have the entry, so we - ;; can do the update. - (if entry - (progn - (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)))))) - (error "No such group: %s" (gnus-info-group info))))) - -(defun gnus-group-set-method-info (group select-method) - (gnus-group-set-info select-method group 'method)) - -(defun gnus-group-set-params-info (group params) - (gnus-group-set-info params group 'params)) - -(defun gnus-add-marked-articles (group type articles &optional info force) - ;; Add ARTICLES of TYPE to the info of GROUP. - ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't - ;; add, but replace marked articles of TYPE with ARTICLES. - (let ((info (or info (gnus-get-info group))) - (uncompressed '(score bookmark killed)) - marked m) - (or (not info) - (and (not (setq marked (nthcdr 3 info))) - (or (null articles) - (setcdr (nthcdr 2 info) - (list (list (cons type (gnus-compress-sequence - articles t))))))) - (and (not (setq m (assq type (car marked)))) - (or (null articles) - (setcar marked - (cons (cons type (gnus-compress-sequence articles t) ) - (car marked))))) - (if force - (if (null articles) - (setcar (nthcdr 3 info) - (delq (assq type (car marked)) (car marked))) - (setcdr m (gnus-compress-sequence articles t))) - (setcdr m (gnus-compress-sequence - (sort (nconc (gnus-uncompress-range (cdr m)) - (copy-sequence articles)) '<) t)))))) - -;;; -;;; Group timestamps -;;; - -(defun gnus-group-set-timestamp () - "Change the timestamp of the current group to the current time. -This function can be used in hooks like `gnus-select-group-hook' -or `gnus-group-catchup-group-hook'." - (when gnus-newsgroup-name - (let ((time (current-time))) - (setcdr (cdr time) nil) - (gnus-group-set-parameter gnus-newsgroup-name 'timestamp time)))) - -(defsubst gnus-group-timestamp (group) - "Return the timestamp for GROUP." - (gnus-group-get-parameter group 'timestamp)) - -(defun gnus-group-timestamp-delta (group) - "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number." - (let* ((time (or (gnus-group-timestamp group) - (list 0 0))) - (delta (gnus-time-minus (current-time) time))) - (+ (* (nth 0 delta) 65536.0) - (nth 1 delta)))) - -(defun gnus-group-timestamp-string (group) - "Return a string of the timestamp for GROUP." - (let ((time (gnus-group-timestamp group))) - (if (not time) - "" - (gnus-time-iso8601 time)))) - -(provide 'gnus-group) - -;;; gnus-group.el ends here diff --git a/lisp/gnus-i18n.el b/lisp/gnus-i18n.el deleted file mode 100644 index 3737fb9..0000000 --- a/lisp/gnus-i18n.el +++ /dev/null @@ -1,95 +0,0 @@ -;;; gnus-i18n.el --- Internationalization for Gnus - -;; Copyright (C) 1996,1997 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Created: 1997/11/27 -;; Keywords: internationalization, news, mail - -;; This file is not part of GNU Emacs yet. - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -;;; @ newsgroup default charset -;;; - -(defvar gnus-newsgroup-default-charset-alist - '(("^\\(fj\\|tnn\\|japan\\)\\." . iso-2022-jp-2) - ("^han\\." . euc-kr) - ("^relcom\\." . koi8-r) - ("^alt\\.chinese\\.text\\.big5" . cn-big5) - ("^hk\\(star\\)?\\." . cn-big5) - ("^tw\\." . cn-big5) - ("^alt\\.chinese" . hz-gb-2312) - ) - "Alist of newsgroup patterns vs. corresponding default MIME charset. -Each element looks like (REGEXP . SYMBOL). REGEXP is pattern for -newsgroup name. SYMBOL is MIME charset or coding-system.") - -(defun gnus-set-newsgroup-default-charset (newsgroup charset) - "Set CHARSET for the NEWSGROUP as default MIME charset." - (let* ((ng-regexp (concat "^" (regexp-quote newsgroup) "\\($\\|\\.\\)")) - (pair (assoc ng-regexp gnus-newsgroup-default-charset-alist)) - ) - (if pair - (setcdr pair charset) - (setq gnus-newsgroup-default-charset-alist - (cons (cons ng-regexp charset) - gnus-newsgroup-default-charset-alist)) - ))) - - -;;; @ localization -;;; - -(defun gnus-set-summary-default-charset () - "Set up `default-mime-charset' of summary buffer. -It is specified by variable `gnus-newsgroup-default-charset-alist' -\(cf. function `gnus-set-newsgroup-default-charset')." - (if (buffer-live-p gnus-summary-buffer) - (let ((charset - (catch 'found - (let ((group - (save-excursion - (set-buffer gnus-summary-buffer) - gnus-newsgroup-name)) - (alist gnus-newsgroup-default-charset-alist)) - (while alist - (let ((pair (car alist))) - (if (string-match (car pair) group) - (throw 'found (cdr pair)) - )) - (setq alist (cdr alist))) - )))) - (when charset - (save-excursion - (set-buffer gnus-summary-buffer) - (make-local-variable 'default-mime-charset) - (setq default-mime-charset charset) - ) - (make-local-variable 'default-mime-charset) - (setq default-mime-charset charset) - )))) - - -;;; @ end -;;; - -(provide 'gnus-i18n) - -;;; gnus-i18n.el ends here diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el deleted file mode 100644 index 9d31183..0000000 --- a/lisp/gnus-int.el +++ /dev/null @@ -1,476 +0,0 @@ -;;; gnus-int.el --- backend interface functions for Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) - -(defcustom gnus-open-server-hook nil - "*Hook called just before opening connection to the news server." - :group 'gnus-start - :type 'hook) - -;;; -;;; Server Communication -;;; - -(defun gnus-start-news-server (&optional confirm) - "Open a method for getting news. -If CONFIRM is non-nil, the user will be asked for an NNTP server." - (let (how) - (if gnus-current-select-method - ;; Stream is already opened. - nil - ;; Open NNTP server. - (unless gnus-nntp-service - (setq gnus-nntp-server nil)) - (when confirm - ;; Read server name with completion. - (setq gnus-nntp-server - (completing-read "NNTP server: " - (mapcar (lambda (server) (list server)) - (cons (list gnus-nntp-server) - gnus-secondary-servers)) - nil nil gnus-nntp-server))) - - (when (and gnus-nntp-server - (stringp gnus-nntp-server) - (not (string= gnus-nntp-server ""))) - (setq gnus-select-method - (cond ((or (string= gnus-nntp-server "") - (string= gnus-nntp-server "::")) - (list 'nnspool (system-name))) - ((string-match "^:" gnus-nntp-server) - (list 'nnmh gnus-nntp-server - (list 'nnmh-directory - (file-name-as-directory - (expand-file-name - (concat "~/" (substring - gnus-nntp-server 1))))) - (list 'nnmh-get-new-mail nil))) - (t - (list 'nntp gnus-nntp-server))))) - - (setq how (car gnus-select-method)) - (cond - ((eq how 'nnspool) - (require 'nnspool) - (gnus-message 5 "Looking up local news spool...")) - ((eq how 'nnmh) - (require 'nnmh) - (gnus-message 5 "Looking up mh spool...")) - (t - (require 'nntp))) - (setq gnus-current-select-method gnus-select-method) - (gnus-run-hooks 'gnus-open-server-hook) - (or - ;; gnus-open-server-hook might have opened it - (gnus-server-opened gnus-select-method) - (gnus-open-server gnus-select-method) - (gnus-y-or-n-p - (format - "%s (%s) open error: '%s'. Continue? " - (car gnus-select-method) (cadr gnus-select-method) - (gnus-status-message gnus-select-method))) - (gnus-error 1 "Couldn't open server on %s" - (nth 1 gnus-select-method)))))) - -(defun gnus-check-group (group) - "Try to make sure that the server where GROUP exists is alive." - (let ((method (gnus-find-method-for-group group))) - (or (gnus-server-opened method) - (gnus-open-server method)))) - -(defun gnus-check-server (&optional method silent) - "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))) - ;; Transform virtual server names into select methods. - (when (stringp method) - (setq method (gnus-server-to-method method))) - (if (gnus-server-opened method) - ;; The stream is already opened. - t - ;; Open the server. - (unless silent - (gnus-message 5 "Opening %s server%s..." (car method) - (if (equal (nth 1 method) "") "" - (format " on %s" (nth 1 method))))) - (gnus-run-hooks 'gnus-open-server-hook) - (prog1 - (gnus-open-server method) - (unless silent - (message "")))))) - -(defun gnus-get-function (method function &optional noerror) - "Return a function symbol based on METHOD and FUNCTION." - ;; Translate server names into methods. - (unless method - (error "Attempted use of a nil select method")) - (when (stringp method) - (setq method (gnus-server-to-method method))) - (let ((func (intern (format "%s-%s" (if gnus-agent - (gnus-agent-get-function method) - (car method)) - function)))) - ;; If the functions isn't bound, we require the backend in - ;; question. - (unless (fboundp func) - (require (car method)) - (when (and (not (fboundp func)) - (not noerror)) - ;; This backend doesn't implement this function. - (error "No such function: %s" func))) - func)) - - -;;; -;;; Interface functions to the backends. -;;; - -(defun gnus-open-server (gnus-command-method) - "Open a connection to GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (let ((elem (assoc gnus-command-method gnus-opened-servers))) - ;; If this method was previously denied, we just return nil. - (if (eq (nth 1 elem) 'denied) - (progn - (gnus-message 1 "Denied server") - 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)))) - ;; 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)) - ;; Return the result from the "open" call. - result)))) - -(defun gnus-close-server (gnus-command-method) - "Close the connection to GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'close-server) - (nth 1 gnus-command-method))) - -(defun gnus-request-list (gnus-command-method) - "Request the active file from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-list) - (nth 1 gnus-command-method))) - -(defun gnus-request-list-newsgroups (gnus-command-method) - "Request the newsgroups file from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-list-newsgroups) - (nth 1 gnus-command-method))) - -(defun gnus-request-newgroups (date gnus-command-method) - "Request all new groups since DATE from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (let ((func (gnus-get-function gnus-command-method 'request-newgroups t))) - (when func - (funcall func date (nth 1 gnus-command-method))))) - -(defun gnus-server-opened (gnus-command-method) - "Check whether a connection to GNUS-COMMAND-METHOD has been opened." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (inline (gnus-get-function gnus-command-method 'server-opened)) - (nth 1 gnus-command-method))) - -(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 -this group uses will be queried." - (let ((gnus-command-method - (if (stringp gnus-command-method) - (gnus-find-method-for-group gnus-command-method) - gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'status-message) - (nth 1 gnus-command-method)))) - -(defun gnus-request-regenerate (gnus-command-method) - "Request a data generation from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-regenerate) - (nth 1 gnus-command-method))) - -(defun gnus-request-group (group &optional dont-check gnus-command-method) - "Request GROUP. If DONT-CHECK, no information is required." - (let ((gnus-command-method - (or gnus-command-method (inline (gnus-find-method-for-group group))))) - (when (stringp gnus-command-method) - (setq gnus-command-method - (inline (gnus-server-to-method gnus-command-method)))) - (funcall (inline (gnus-get-function gnus-command-method 'request-group)) - (gnus-group-real-name group) (nth 1 gnus-command-method) - dont-check))) - -(defun gnus-list-active-group (group) - "Request active information on GROUP." - (let ((gnus-command-method (gnus-find-method-for-group group)) - (func 'list-active-group)) - (when (gnus-check-backend-function func group) - (funcall (gnus-get-function gnus-command-method func) - (gnus-group-real-name group) (nth 1 gnus-command-method))))) - -(defun gnus-request-group-description (group) - "Request a description of GROUP." - (let ((gnus-command-method (gnus-find-method-for-group group)) - (func 'request-group-description)) - (when (gnus-check-backend-function func group) - (funcall (gnus-get-function gnus-command-method func) - (gnus-group-real-name group) (nth 1 gnus-command-method))))) - -(defun gnus-close-group (group) - "Request the GROUP be closed." - (let ((gnus-command-method (inline (gnus-find-method-for-group group)))) - (funcall (gnus-get-function gnus-command-method 'close-group) - (gnus-group-real-name group) (nth 1 gnus-command-method)))) - -(defun gnus-retrieve-headers (articles group &optional fetch-old) - "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) - (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-articles (articles group) - "Request ARTICLES in GROUP." - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'retrieve-articles) - articles (gnus-group-real-name group) - (nth 1 gnus-command-method)))) - -(defun gnus-retrieve-groups (groups gnus-command-method) - "Request active information on GROUPS from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'retrieve-groups) - groups (nth 1 gnus-command-method))) - -(defun gnus-request-type (group &optional article) - "Return the type (`post' or `mail') of GROUP (and ARTICLE)." - (let ((gnus-command-method (gnus-find-method-for-group group))) - (if (not (gnus-check-backend-function - 'request-type (car gnus-command-method))) - 'unknown - (funcall (gnus-get-function gnus-command-method 'request-type) - (gnus-group-real-name group) article)))) - -(defun gnus-request-update-mark (group article mark) - "Return the type (`post' or `mail') of GROUP (and ARTICLE)." - (let ((gnus-command-method (gnus-find-method-for-group group))) - (if (not (gnus-check-backend-function - 'request-update-mark (car gnus-command-method))) - mark - (funcall (gnus-get-function gnus-command-method 'request-update-mark) - (gnus-group-real-name group) article mark)))) - -(defun gnus-request-article (article group &optional buffer) - "Request the ARTICLE in GROUP. -ARTICLE can either be an article number or an article Message-ID. -If BUFFER, insert the article in that group." - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-article) - article (gnus-group-real-name group) - (nth 1 gnus-command-method) buffer))) - -(defun gnus-request-head (article group) - "Request the head of ARTICLE in GROUP." - (let* ((gnus-command-method (gnus-find-method-for-group group)) - (head (gnus-get-function gnus-command-method 'request-head t)) - res clean-up) - (cond - ;; Check the cache. - ((and gnus-use-cache - (numberp article) - (gnus-cache-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) - (nth 1 gnus-command-method)))) - ;; Use `article' function. - (t - (setq res (gnus-request-article article group) - clean-up t))) - (when clean-up - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (1- (point)) (point-max))) - (nnheader-fold-continuation-lines))) - res)) - -(defun gnus-request-body (article group) - "Request the body of ARTICLE in GROUP." - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-body) - article (gnus-group-real-name group) - (nth 1 gnus-command-method)))) - -(defun gnus-request-post (gnus-command-method) - "Post the current buffer using GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-post) - (nth 1 gnus-command-method))) - -(defun gnus-request-scan (group gnus-command-method) - "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD. -If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." - (when gnus-plugged - (let ((gnus-command-method - (if group (gnus-find-method-for-group group) gnus-command-method)) - (gnus-inhibit-demon t)) - (funcall (gnus-get-function gnus-command-method 'request-scan) - (and group (gnus-group-real-name group)) - (nth 1 gnus-command-method))))) - -(defsubst gnus-request-update-info (info gnus-command-method) - "Request that GNUS-COMMAND-METHOD update INFO." - (when (stringp gnus-command-method) - (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)))) - -(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))) - -(defun gnus-request-accept-article (group &optional gnus-command-method last) - ;; Make sure there's a newline at the end of the article. - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (when (and (not gnus-command-method) - (stringp group)) - (setq gnus-command-method (gnus-group-name-to-method group))) - (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)) - (if (stringp group) (gnus-group-real-name group) group) - (cadr gnus-command-method) - last))) - -(defun gnus-request-replace-article (article group buffer) - (let ((func (car (gnus-group-name-to-method group)))) - (funcall (intern (format "%s-request-replace-article" func)) - article (gnus-group-real-name group) buffer))) - -(defun gnus-request-associate-buffer (group) - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-associate-buffer) - (gnus-group-real-name group)))) - -(defun gnus-request-restore-buffer (article group) - "Request a new buffer restored to the state of ARTICLE." - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-restore-buffer) - article (gnus-group-real-name group) - (nth 1 gnus-command-method)))) - -(defun gnus-request-create-group (group &optional gnus-command-method args) - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (let ((gnus-command-method - (or gnus-command-method (gnus-find-method-for-group group)))) - (funcall (gnus-get-function gnus-command-method 'request-create-group) - (gnus-group-real-name group) (nth 1 gnus-command-method) args))) - -(defun gnus-request-delete-group (group &optional force) - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-delete-group) - (gnus-group-real-name group) force (nth 1 gnus-command-method)))) - -(defun gnus-request-rename-group (group new-name) - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-rename-group) - (gnus-group-real-name group) - (gnus-group-real-name new-name) (nth 1 gnus-command-method)))) - -(defun gnus-close-backends () - ;; Send a close request to all backends that support such a request. - (let ((methods gnus-valid-select-methods) - (gnus-inhibit-demon t) - func gnus-command-method) - (while (setq gnus-command-method (pop methods)) - (when (fboundp (setq func (intern - (concat (car gnus-command-method) - "-request-close")))) - (funcall func))))) - -(defun gnus-asynchronous-p (gnus-command-method) - (let ((func (gnus-get-function gnus-command-method 'asynchronous-p t))) - (when (fboundp func) - (funcall func)))) - -(defun gnus-remove-denial (gnus-command-method) - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (let* ((elem (assoc gnus-command-method gnus-opened-servers)) - (status (cadr elem))) - ;; If this hasn't been opened before, we add it to the list. - (when (eq status 'denied) - ;; Set the status of this server. - (setcar (cdr elem) 'closed)))) - -(provide 'gnus-int) - -;;; gnus-int.el ends here diff --git a/lisp/gnus-kill.el b/lisp/gnus-kill.el deleted file mode 100644 index faddfdd..0000000 --- a/lisp/gnus-kill.el +++ /dev/null @@ -1,715 +0,0 @@ -;;; gnus-kill.el --- kill commands for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-art) -(require 'gnus-range) - -(defcustom gnus-kill-file-mode-hook nil - "*Hook for Gnus kill file mode." - :group 'gnus-score-kill - :type 'hook) - -(defcustom gnus-kill-expiry-days 7 - "*Number of days before expiring unused kill file entries." - :group 'gnus-score-kill - :group 'gnus-score-expire - :type 'integer) - -(defcustom gnus-kill-save-kill-file nil - "*If non-nil, will save kill files after processing them." - :group 'gnus-score-kill - :type 'boolean) - -(defcustom gnus-winconf-kill-file nil - "*What does this do, Lars?" - :group 'gnus-score-kill - :type 'sexp) - -(defcustom gnus-kill-killed t - "*If non-nil, Gnus will apply kill files to already killed articles. -If it is nil, Gnus will never apply kill files to articles that have -already been through the scoring process, which might very well save lots -of time." - :group 'gnus-score-kill - :type 'boolean) - - - -(defmacro gnus-raise (field expression level) - `(gnus-kill ,field ,expression - (function (gnus-summary-raise-score ,level)) t)) - -(defmacro gnus-lower (field expression level) - `(gnus-kill ,field ,expression - (function (gnus-summary-raise-score (- ,level))) t)) - -;;; -;;; Gnus Kill File Mode -;;; - -(defvar gnus-kill-file-mode-map nil) - -(unless gnus-kill-file-mode-map - (gnus-define-keymap (setq gnus-kill-file-mode-map - (copy-keymap emacs-lisp-mode-map)) - "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject - "\C-c\C-k\C-a" gnus-kill-file-kill-by-author - "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread - "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref - "\C-c\C-a" gnus-kill-file-apply-buffer - "\C-c\C-e" gnus-kill-file-apply-last-sexp - "\C-c\C-c" gnus-kill-file-exit)) - -(defun gnus-kill-file-mode () - "Major mode for editing kill files. - -If you are using this mode - you probably shouldn't. Kill files -perform badly and paint with a pretty broad brush. Score files, on -the other hand, are vastly faster (40x speedup) and give you more -control over what to do. - -In addition to Emacs-Lisp Mode, the following commands are available: - -\\{gnus-kill-file-mode-map} - - A kill file contains Lisp expressions to be applied to a selected -newsgroup. The purpose is to mark articles as read on the basis of -some set of regexps. A global kill file is applied to every newsgroup, -and a local kill file is applied to a specified newsgroup. Since a -global kill file is applied to every newsgroup, for better performance -use a local one. - - A kill file can contain any kind of Emacs Lisp expressions expected -to be evaluated in the Summary buffer. Writing Lisp programs for this -purpose is not so easy because the internal working of Gnus must be -well-known. For this reason, Gnus provides a general function which -does this easily for non-Lisp programmers. - - The `gnus-kill' function executes commands available in Summary Mode -by their key sequences. `gnus-kill' should be called with FIELD, -REGEXP and optional COMMAND and ALL. FIELD is a string representing -the header field or an empty string. If FIELD is an empty string, the -entire article body is searched for. REGEXP is a string which is -compared with FIELD value. COMMAND is a string representing a valid -key sequence in Summary mode or Lisp expression. COMMAND defaults to -'(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is -executed in the Summary buffer. If the second optional argument ALL -is non-nil, the COMMAND is applied to articles which are already -marked as read or unread. Articles which are marked are skipped over -by default. - - For example, if you want to mark articles of which subjects contain -the string `AI' as read, a possible kill file may look like: - - (gnus-kill \"Subject\" \"AI\") - - If you want to mark articles with `D' instead of `X', you can use -the following expression: - - (gnus-kill \"Subject\" \"AI\" \"d\") - -In this example it is assumed that the command -`gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode. - - It is possible to delete unnecessary headers which are marked with -`X' in a kill file as follows: - - (gnus-expunge \"X\") - - If the Summary buffer is empty after applying kill files, Gnus will -exit the selected newsgroup normally. If headers which are marked -with `D' are deleted in a kill file, it is impossible to read articles -which are marked as read in the previous Gnus sessions. Marks other -than `D' should be used for articles which should really be deleted. - -Entry to this mode calls emacs-lisp-mode-hook and -gnus-kill-file-mode-hook with no arguments, if that value is non-nil." - (interactive) - (kill-all-local-variables) - (use-local-map gnus-kill-file-mode-map) - (set-syntax-table emacs-lisp-mode-syntax-table) - (setq major-mode 'gnus-kill-file-mode) - (setq mode-name "Kill") - (lisp-mode-variables nil) - (gnus-run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook)) - -(defun gnus-kill-file-edit-file (newsgroup) - "Begin editing a kill file for NEWSGROUP. -If NEWSGROUP is nil, the global kill file is selected." - (interactive "sNewsgroup: ") - (let ((file (gnus-newsgroup-kill-file newsgroup))) - (gnus-make-directory (file-name-directory file)) - ;; Save current window configuration if this is first invocation. - (or (and (get-file-buffer file) - (get-buffer-window (get-file-buffer file))) - (setq gnus-winconf-kill-file (current-window-configuration))) - ;; Hack windows. - (let ((buffer (find-file-noselect file))) - (cond ((get-buffer-window buffer) - (pop-to-buffer buffer)) - ((eq major-mode 'gnus-group-mode) - (gnus-configure-windows 'group) ;Take all windows. - (pop-to-buffer buffer)) - ((eq major-mode 'gnus-summary-mode) - (gnus-configure-windows 'article) - (pop-to-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer) - (switch-to-buffer buffer)) - (t ;No good rules. - (find-file-other-window file)))) - (gnus-kill-file-mode))) - -;; Fix by Sudish Joseph . -(defun gnus-kill-set-kill-buffer () - (let* ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)) - (buffer (find-file-noselect file))) - (set-buffer buffer) - (gnus-kill-file-mode) - (bury-buffer buffer))) - -(defun gnus-kill-file-enter-kill (field regexp &optional dont-move) - ;; Enter kill file entry. - ;; FIELD: String containing the name of the header field to kill. - ;; REGEXP: The string to kill. - (save-excursion - (let (string) - (unless (eq major-mode 'gnus-kill-file-mode) - (gnus-kill-set-kill-buffer)) - (unless dont-move - (goto-char (point-max))) - (insert (setq string (format "(gnus-kill %S %S)\n" field regexp))) - (gnus-kill-file-apply-string string)))) - -(defun gnus-kill-file-kill-by-subject () - "Kill by subject." - (interactive) - (gnus-kill-file-enter-kill - "Subject" - (if (vectorp gnus-current-headers) - (regexp-quote - (gnus-simplify-subject (mail-header-subject gnus-current-headers))) - "") - t)) - -(defun gnus-kill-file-kill-by-author () - "Kill by author." - (interactive) - (gnus-kill-file-enter-kill - "From" - (if (vectorp gnus-current-headers) - (regexp-quote (mail-header-from gnus-current-headers)) - "") t)) - -(defun gnus-kill-file-kill-by-thread () - "Kill by author." - (interactive) - (gnus-kill-file-enter-kill - "References" - (if (vectorp gnus-current-headers) - (regexp-quote (mail-header-id gnus-current-headers)) - ""))) - -(defun gnus-kill-file-kill-by-xref () - "Kill by Xref." - (interactive) - (let ((xref (and (vectorp gnus-current-headers) - (mail-header-xref gnus-current-headers))) - (start 0) - group) - (if xref - (while (string-match " \\([^ \t]+\\):" xref start) - (setq start (match-end 0)) - (when (not (string= - (setq group - (substring xref (match-beginning 1) (match-end 1))) - gnus-newsgroup-name)) - (gnus-kill-file-enter-kill - "Xref" (concat " " (regexp-quote group) ":") t))) - (gnus-kill-file-enter-kill "Xref" "" t)))) - -(defun gnus-kill-file-raise-followups-to-author (level) - "Raise score for all followups to the current author." - (interactive "p") - (let ((name (mail-header-from gnus-current-headers)) - string) - (save-excursion - (gnus-kill-set-kill-buffer) - (goto-char (point-min)) - (setq name (read-string (concat "Add " level - " to followup articles to: ") - (regexp-quote name))) - (setq - string - (format - "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n" - "From" name level)) - (insert string) - (gnus-kill-file-apply-string string)) - (gnus-message - 6 "Added temporary score file entry for followups to %s." name))) - -(defun gnus-kill-file-apply-buffer () - "Apply current buffer to current newsgroup." - (interactive) - (if (and gnus-current-kill-article - (get-buffer gnus-summary-buffer)) - ;; Assume newsgroup is selected. - (gnus-kill-file-apply-string (buffer-string)) - (ding) (gnus-message 2 "No newsgroup is selected."))) - -(defun gnus-kill-file-apply-string (string) - "Apply STRING to current newsgroup." - (interactive) - (let ((string (concat "(progn \n" string "\n)"))) - (save-excursion - (save-window-excursion - (pop-to-buffer gnus-summary-buffer) - (eval (car (read-from-string string))))))) - -(defun gnus-kill-file-apply-last-sexp () - "Apply sexp before point in current buffer to current newsgroup." - (interactive) - (if (and gnus-current-kill-article - (get-buffer gnus-summary-buffer)) - ;; Assume newsgroup is selected. - (let ((string - (buffer-substring - (save-excursion (forward-sexp -1) (point)) (point)))) - (save-excursion - (save-window-excursion - (pop-to-buffer gnus-summary-buffer) - (eval (car (read-from-string string)))))) - (ding) (gnus-message 2 "No newsgroup is selected."))) - -(defun gnus-kill-file-exit () - "Save a kill file, then return to the previous buffer." - (interactive) - (save-buffer) - (let ((killbuf (current-buffer))) - ;; We don't want to return to article buffer. - (when (get-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer)) - ;; Delete the KILL file windows. - (delete-windows-on killbuf) - ;; Restore last window configuration if available. - (when gnus-winconf-kill-file - (set-window-configuration gnus-winconf-kill-file)) - (setq gnus-winconf-kill-file nil) - ;; Kill the KILL file buffer. Suggested by tale@pawl.rpi.edu. - (kill-buffer killbuf))) - -;; For kill files - -(defun gnus-Newsgroup-kill-file (newsgroup) - "Return the name of a kill file for NEWSGROUP. -If NEWSGROUP is nil, return the global kill file instead." - (cond ((or (null newsgroup) - (string-equal newsgroup "")) - ;; The global kill file is placed at top of the directory. - (expand-file-name gnus-kill-file-name gnus-kill-files-directory)) - (gnus-use-long-file-name - ;; Append ".KILL" to capitalized newsgroup name. - (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup) - "." gnus-kill-file-name) - gnus-kill-files-directory)) - (t - ;; Place "KILL" under the hierarchical directory. - (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) - "/" gnus-kill-file-name) - gnus-kill-files-directory)))) - -(defun gnus-expunge (marks) - "Remove lines marked with MARKS." - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-limit-to-marks marks 'reverse))) - -(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)) - (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))) - -(defun gnus-apply-kill-file-internal () - "Apply a kill file to the current newsgroup. -Returns the number of articles marked as read." - (let* ((kill-files (list (gnus-newsgroup-kill-file nil) - (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (unreads (length gnus-newsgroup-unreads)) - (gnus-summary-inhibit-highlight t) - beg) - (setq gnus-newsgroup-kill-headers nil) - ;; If there are any previously scored articles, we remove these - ;; from the `gnus-newsgroup-headers' list that the score functions - ;; will see. This is probably pretty wasteful when it comes to - ;; conses, but is, I think, faster than having to assq in every - ;; single score function. - (let ((files kill-files)) - (while files - (if (file-exists-p (car files)) - (let ((headers gnus-newsgroup-headers)) - (if gnus-kill-killed - (setq gnus-newsgroup-kill-headers - (mapcar (lambda (header) (mail-header-number header)) - headers)) - (while headers - (unless (gnus-member-of-range - (mail-header-number (car headers)) - gnus-newsgroup-killed) - (push (mail-header-number (car headers)) - gnus-newsgroup-kill-headers)) - (setq headers (cdr headers)))) - (setq files nil)) - (setq files (cdr files))))) - (if (not gnus-newsgroup-kill-headers) - () - (save-window-excursion - (save-excursion - (while kill-files - (if (not (file-exists-p (car kill-files))) - () - (gnus-message 6 "Processing kill file %s..." (car kill-files)) - (find-file (car kill-files)) - (gnus-add-current-to-buffer-list) - (goto-char (point-min)) - - (if (consp (ignore-errors (read (current-buffer)))) - (gnus-kill-parse-gnus-kill-file) - (gnus-kill-parse-rn-kill-file)) - - (gnus-message - 6 "Processing kill file %s...done" (car kill-files))) - (setq kill-files (cdr kill-files))))) - - (gnus-set-mode-line 'summary) - - (if beg - (let ((nunreads (- unreads (length gnus-newsgroup-unreads)))) - (or (eq nunreads 0) - (gnus-message 6 "Marked %d articles as read" nunreads)) - nunreads) - 0)))) - -;; Parse a Gnus killfile. -(defun gnus-score-insert-help (string alist idx) - (save-excursion - (pop-to-buffer "*Score Help*") - (buffer-disable-undo (current-buffer)) - (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) - (let (beg form) - (while (progn - (setq beg (point)) - (setq form (ignore-errors (read (current-buffer))))) - (unless (listp form) - (error "Illegal kill entry (possibly rn kill file?): %s" form)) - (if (or (eq (car form) 'gnus-kill) - (eq (car form) 'gnus-raise) - (eq (car form) 'gnus-lower)) - (progn - (delete-region beg (point)) - (insert (or (eval form) ""))) - (save-excursion - (set-buffer gnus-summary-buffer) - (ignore-errors (eval form))))) - (and (buffer-modified-p) - gnus-kill-save-kill-file - (save-buffer)) - (set-buffer-modified-p nil))) - -;; Parse an rn killfile. -(defun gnus-kill-parse-rn-kill-file () - (goto-char (point-min)) - (gnus-kill-file-mode) - (let ((mod-to-header - '((?a . "") - (?h . "") - (?f . "from") - (?: . "subject"))) - (com-to-com - '((?m . " ") - (?j . "X"))) - pattern modifier commands) - (while (not (eobp)) - (if (not (looking-at "[ \t]*/\\([^/]*\\)/\\([ahfcH]\\)?:\\([a-z=:]*\\)")) - () - (setq pattern (buffer-substring (match-beginning 1) (match-end 1))) - (setq modifier (if (match-beginning 2) (char-after (match-beginning 2)) - ?s)) - (setq commands (buffer-substring (match-beginning 3) (match-end 3))) - - ;; The "f:+" command marks everything *but* the matches as read, - ;; so we simply first match everything as read, and then unmark - ;; PATTERN later. - (when (string-match "\\+" commands) - (gnus-kill "from" ".") - (setq commands "m")) - - (gnus-kill - (or (cdr (assq modifier mod-to-header)) "subject") - pattern - (if (string-match "m" commands) - '(gnus-summary-mark-as-unread nil " ") - '(gnus-summary-mark-as-read nil "X")) - nil t)) - (forward-line 1)))) - -;; Kill changes and new format by suggested by JWZ and Sudish Joseph -;; . -(defun gnus-kill (field regexp &optional exe-command all silent) - "If FIELD of an article matches REGEXP, execute COMMAND. -Optional 1st argument COMMAND is default to - (gnus-summary-mark-as-read nil \"X\"). -If optional 2nd argument ALL is non-nil, articles marked are also applied to. -If FIELD is an empty string (or nil), entire article body is searched for. -COMMAND must be a lisp expression or a string representing a key sequence." - ;; We don't want to change current point nor window configuration. - (let ((old-buffer (current-buffer))) - (save-excursion - (save-window-excursion - ;; Selected window must be summary buffer to execute keyboard - ;; macros correctly. See command_loop_1. - (switch-to-buffer gnus-summary-buffer 'norecord) - (goto-char (point-min)) ;From the beginning. - (let ((kill-list regexp) - (date (current-time-string)) - (command (or exe-command '(gnus-summary-mark-as-read - nil gnus-kill-file-mark))) - kill kdate prev) - (if (listp kill-list) - ;; It is a list. - (if (not (consp (cdr kill-list))) - ;; It's on the form (regexp . date). - (if (zerop (gnus-execute field (car kill-list) - command nil (not all))) - (when (> (gnus-days-between date (cdr kill-list)) - gnus-kill-expiry-days) - (setq regexp nil)) - (setcdr kill-list date)) - (while (setq kill (car kill-list)) - (if (consp kill) - ;; It's a temporary kill. - (progn - (setq kdate (cdr kill)) - (if (zerop (gnus-execute - field (car kill) command nil (not all))) - (when (> (gnus-days-between date kdate) - gnus-kill-expiry-days) - ;; Time limit has been exceeded, so we - ;; remove the match. - (if prev - (setcdr prev (cdr kill-list)) - (setq regexp (cdr regexp)))) - ;; Successful kill. Set the date to today. - (setcdr kill date))) - ;; It's a permanent kill. - (gnus-execute field kill command nil (not all))) - (setq prev kill-list) - (setq kill-list (cdr kill-list)))) - (gnus-execute field kill-list command nil (not all)))))) - (switch-to-buffer old-buffer) - (when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent)) - (gnus-pp-gnus-kill - (nconc (list 'gnus-kill field - (if (consp regexp) (list 'quote regexp) regexp)) - (when (or exe-command all) - (list (list 'quote exe-command))) - (if all (list t) nil)))))) - -(defun gnus-pp-gnus-kill (object) - (if (or (not (consp (nth 2 object))) - (not (consp (cdr (nth 2 object)))) - (and (eq 'quote (car (nth 2 object))) - (not (consp (cdadr (nth 2 object)))))) - (concat "\n" (gnus-prin1-to-string object)) - (save-excursion - (set-buffer (get-buffer-create "*Gnus PP*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object))) - (let ((klist (cadr (nth 2 object))) - (first t)) - (while klist - (insert (if first (progn (setq first nil) "") "\n ") - (gnus-prin1-to-string (car klist))) - (setq klist (cdr klist)))) - (insert ")") - (and (nth 3 object) - (insert "\n " - (if (and (consp (nth 3 object)) - (not (eq 'quote (car (nth 3 object))))) - "'" "") - (gnus-prin1-to-string (nth 3 object)))) - (when (nth 4 object) - (insert "\n t")) - (insert ")") - (prog1 - (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer)))))) - -(defun gnus-execute-1 (function regexp form header) - (save-excursion - (let (did-kill) - (if (null header) - nil ;Nothing to do. - (if function - ;; Compare with header field. - (let (value) - (and header - (progn - (setq value (funcall function header)) - ;; Number (Lines:) or symbol must be converted to string. - (unless (stringp value) - (setq value (gnus-prin1-to-string value))) - (setq did-kill (string-match regexp value))) - (cond ((stringp form) ;Keyboard macro. - (execute-kbd-macro form)) - ((gnus-functionp form) - (funcall form)) - (t - (eval form))))) - ;; Search article body. - (let ((gnus-current-article nil) ;Save article pointer. - (gnus-last-article nil) - (gnus-break-pages nil) ;No need to break pages. - (gnus-mark-article-hook nil)) ;Inhibit marking as read. - (gnus-message - 6 "Searching for article: %d..." (mail-header-number header)) - (gnus-article-setup-buffer) - (gnus-article-prepare (mail-header-number header) t) - (when (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (setq did-kill (re-search-forward regexp nil t))) - (cond ((stringp form) ;Keyboard macro. - (execute-kbd-macro form)) - ((gnus-functionp form) - (funcall form)) - (t - (eval form))))))) - did-kill))) - -(defun gnus-execute (field regexp form &optional backward unread) - "If FIELD of article header matches REGEXP, execute lisp FORM (or a string). -If FIELD is an empty string (or nil), entire article body is searched for. -If optional 1st argument BACKWARD is non-nil, do backward instead. -If optional 2nd argument UNREAD is non-nil, articles which are -marked as read or ticked are ignored." - (save-excursion - (let ((killed-no 0) - function article header) - (cond - ;; Search body. - ((or (null field) - (string-equal field "")) - (setq function nil)) - ;; Get access function of header field. - ((fboundp - (setq function - (intern-soft - (concat "mail-header-" (downcase field))))) - (setq function `(lambda (h) (,function h)))) - ;; Signal error. - (t - (error "Unknown header field: \"%s\"" field))) - ;; Starting from the current article. - (while (or - ;; First article. - (and (not article) - (setq article (gnus-summary-article-number))) - ;; Find later articles. - (setq article - (gnus-summary-search-forward unread nil backward))) - (and (or (null gnus-newsgroup-kill-headers) - (memq article gnus-newsgroup-kill-headers)) - (vectorp (setq header (gnus-summary-article-header article))) - (gnus-execute-1 function regexp form header) - (setq killed-no (1+ killed-no)))) - ;; Return the number of killed articles. - killed-no))) - -;;;###autoload -(defalias 'gnus-batch-kill 'gnus-batch-score) -;;;###autoload -(defun gnus-batch-score () - "Run batched scoring. -Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score" - (interactive) - (let* ((gnus-newsrc-options-n - (gnus-newsrc-parse-options - (concat "options -n " - (mapconcat 'identity command-line-args-left " ")))) - (gnus-expert-user t) - (nnmail-spool-file nil) - (gnus-use-dribble-file nil) - (gnus-batch-mode t) - info group newsrc entry - ;; Disable verbose message. - gnus-novice-user gnus-large-newsgroup - gnus-options-subscribe gnus-auto-subscribed-groups - gnus-options-not-subscribe) - ;; Eat all arguments. - (setq command-line-args-left nil) - (gnus-slave) - ;; Apply kills to specified newsgroups in command line arguments. - (setq newsrc (cdr gnus-newsrc-alist)) - (while (setq info (pop newsrc)) - (setq group (gnus-info-group info) - entry (gnus-gethash group gnus-newsrc-hashtb)) - (when (and (<= (gnus-info-level info) gnus-level-subscribed) - (and (car entry) - (or (eq (car entry) t) - (not (zerop (car entry)))))) - (gnus-summary-read-group group nil t nil t) - (when (eq (current-buffer) (get-buffer gnus-summary-buffer)) - (gnus-summary-exit)))) - ;; Exit Emacs. - (switch-to-buffer gnus-group-buffer) - (gnus-group-save-newsrc))) - -(provide 'gnus-kill) - -;;; gnus-kill.el ends here diff --git a/lisp/gnus-load.el b/lisp/gnus-load.el deleted file mode 100644 index 978f272..0000000 --- a/lisp/gnus-load.el +++ /dev/null @@ -1,103 +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 'gnus-treading 'custom-loads '("gnus-sum")) -(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-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 deleted file mode 100644 index 8405e19..0000000 --- a/lisp/gnus-logic.el +++ /dev/null @@ -1,229 +0,0 @@ -;;; gnus-logic.el --- advanced scoring code for Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-score) -(require 'gnus-util) - -;;; Internal variables. - -(defvar gnus-advanced-headers nil) - -;; To avoid having 8-bit characters in the source file. -(defvar gnus-advanced-not (intern (format "%c" 172))) - -(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) - ("head" nil gnus-advanced-body) - ("body" nil gnus-advanced-body) - ("all" nil gnus-advanced-body))) - -(eval-and-compile - (autoload 'parse-time-string "parse-time")) - -(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. - (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))) - (push (cons (mail-header-number gnus-advanced-headers) - (or (nth 1 rule) - gnus-score-interactive-default-score)) - gnus-newsgroup-scored) - (when trace - (push (cons "A file" rule) - gnus-score-trace))))))) - -(defun gnus-advanced-score-rule (rule) - "Apply RULE to `gnus-advanced-headers'." - (let ((type (car rule))) - (cond - ;; "And" rule. - ((or (eq type '&) (eq type 'and)) - (pop rule) - (if (not rule) - t ; Empty rule is true. - (while (and rule - (gnus-advanced-score-rule (car rule))) - (pop rule)) - ;; If all the rules were true, then `rule' should be nil. - (not rule))) - ;; "Or" rule. - ((or (eq type '|) (eq type 'or)) - (pop rule) - (if (not rule) - nil - (while (and rule - (not (gnus-advanced-score-rule (car rule)))) - (pop rule)) - ;; If one of the rules returned true, then `rule' should be non-nil. - rule)) - ;; "Not" rule. - ((or (eq type '!) (eq type 'not) (eq type gnus-advanced-not)) - (not (gnus-advanced-score-rule (nth 1 rule)))) - ;; This is a `1-'-type redirection rule. - ((and (symbolp type) - (string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type))) - (let ((gnus-advanced-headers - (gnus-parent-headers - gnus-advanced-headers - (if (string-match "^\\([0-9]+\\)-$" (symbol-name type)) - ;; 1- type redirection. - (string-to-number - (substring (symbol-name type) - (match-beginning 0) (match-end 0))) - ;; ^^^ type redirection. - (length (symbol-name type)))))) - (when gnus-advanced-headers - (gnus-advanced-score-rule (nth 1 rule))))) - ;; Plain scoring rule. - ((stringp type) - (gnus-advanced-score-article rule)) - ;; Bug-out time! - (t - (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. - (let* ((header (car rule)) - (func (assoc (downcase header) gnus-advanced-index))) - (if (not func) - (error "No such header: %s" rule) - ;; Call the score function. - (funcall (caddr func) (or (cadr func) header) - (cadr rule) (caddr rule))))) - -(defun gnus-advanced-string (index match type) - "See whether string MATCH of TYPE matches `gnus-advanced-headers' in INDEX." - (let* ((type (or type 's)) - (case-fold-search (not (eq (downcase (symbol-name type)) - (symbol-name type)))) - (header (aref gnus-advanced-headers index))) - (cond - ((memq type '(r R regexp Regexp)) - (string-match match header)) - ((memq type '(s S string String)) - (string-match (regexp-quote match) header)) - ((memq type '(e E exact Exact)) - (string= match header)) - ((memq type '(f F fuzzy Fuzzy)) - (string-match (regexp-quote (gnus-simplify-subject-fuzzy match)) - header)) - (t - (error "No such string match type: %s" type))))) - -(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)))) - -(defun gnus-advanced-date (index match type) - (let ((date (encode-time (parse-time-string - (aref gnus-advanced-headers index)))) - (match (encode-time (parse-time-string match)))) - (cond - ((eq type 'at) - (equal date match)) - ((eq type 'before) - (gnus-time-less match date)) - ((eq type 'after) - (gnus-time-less date match)) - (t - (error "No such date score type: %s" type))))) - -(defun gnus-advanced-body (header match type) - (when (string= header "all") - (setq header "article")) - (save-excursion - (set-buffer nntp-server-buffer) - (let* ((request-func (cond ((string= "head" header) - 'gnus-request-head) - ((string= "body" header) - 'gnus-request-body) - (t 'gnus-request-article))) - ofunc 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) - (setq ofunc request-func) - (setq request-func 'gnus-request-article)) - (setq article (mail-header-number gnus-advanced-headers)) - (gnus-message 7 "Scoring article %s..." article) - (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. - (when ofunc - (if (eq ofunc 'gnus-request-head) - (narrow-to-region - (point) - (or (search-forward "\n\n" nil t) (point-max))) - (narrow-to-region - (or (search-forward "\n\n" nil t) (point)) - (point-max)))) - (let* ((case-fold-search (not (eq (downcase (symbol-name type)) - (symbol-name type)))) - (search-func - (cond ((memq type '(r R regexp Regexp)) - 're-search-forward) - ((memq type '(s S string String)) - 'search-forward) - (t - (error "Illegal match type: %s" type))))) - (goto-char (point-min)) - (prog1 - (funcall search-func match nil t) - (widen))))))) - -(provide 'gnus-logic) - -;;; gnus-logic.el ends here. diff --git a/lisp/gnus-mh.el b/lisp/gnus-mh.el deleted file mode 100644 index 84487f9..0000000 --- a/lisp/gnus-mh.el +++ /dev/null @@ -1,105 +0,0 @@ -;;; gnus-mh.el --- mh-e interface for Gnus -;; Copyright (C) 1994,95,96,97,98 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Send mail using mh-e. - -;; The following mh-e interface is all cooperative works of -;; tanaka@flab.fujitsu.CO.JP (TANAKA Hiroshi), kawabe@sra.CO.JP -;; (Yoshikatsu Kawabe), and shingu@casund.cpr.canon.co.jp (Toshiaki -;; SHINGU). - -;;; Code: - -(require 'gnus) -(require 'mh-e) -(require 'mh-comp) -(require 'gnus-msg) -(require 'gnus-sum) - -(defun gnus-summary-save-article-folder (&optional arg) - "Append the current article to an mh folder. -If N is a positive number, save the N next articles. -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") - (let ((gnus-default-article-saver 'gnus-summary-save-in-folder)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-in-folder (&optional folder) - "Save this article to MH folder (using `rcvstore' in MH library). -Optional argument FOLDER specifies folder name." - ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet. - (mh-find-path) - (let ((folder - (cond ((and (eq folder 'default) - gnus-newsgroup-last-folder) - gnus-newsgroup-last-folder) - (folder folder) - (t (mh-prompt-for-folder - "Save article in" - (funcall gnus-folder-save-name gnus-newsgroup-name - gnus-current-headers gnus-newsgroup-last-folder) - t)))) - (errbuf (get-buffer-create " *Gnus rcvstore*")) - ;; Find the rcvstore program. - (exec-path (if mh-lib (cons mh-lib exec-path) exec-path))) - (gnus-eval-in-buffer-window gnus-original-article-buffer - (save-restriction - (widen) - (unwind-protect - (call-process-region - (point-min) (point-max) "rcvstore" nil errbuf nil folder) - (set-buffer errbuf) - (if (zerop (buffer-size)) - (message "Article saved in folder: %s" folder) - (message "%s" (buffer-string))) - (kill-buffer errbuf)))) - (setq gnus-newsgroup-last-folder folder))) - -(defun gnus-Folder-save-name (newsgroup headers &optional last-folder) - "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. -If variable `gnus-use-long-file-name' is nil, it is +News.group. -Otherwise, it is like +news/group." - (or last-folder - (concat "+" - (if gnus-use-long-file-name - (gnus-capitalize-newsgroup newsgroup) - (gnus-newsgroup-directory-form newsgroup))))) - -(defun gnus-folder-save-name (newsgroup headers &optional last-folder) - "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. -If variable `gnus-use-long-file-name' is nil, it is +news.group. -Otherwise, it is like +news/group." - (or last-folder - (concat "+" - (if gnus-use-long-file-name - newsgroup - (gnus-newsgroup-directory-form newsgroup))))) - -(provide 'gnus-mh) - -;;; gnus-mh.el ends here diff --git a/lisp/gnus-move.el b/lisp/gnus-move.el deleted file mode 100644 index ef39c59..0000000 --- a/lisp/gnus-move.el +++ /dev/null @@ -1,178 +0,0 @@ -;;; gnus-move.el --- commands for moving Gnus from one server to another -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-start) -(require 'gnus-int) -(require 'gnus-range) - -;;; -;;; Moving by comparing Message-ID's. -;;; - -;;;###autoload -(defun gnus-change-server (from-server to-server) - "Move from FROM-SERVER to TO-SERVER. -Update the .newsrc.eld file to reflect the change of nntp server." - (interactive - (list gnus-select-method (gnus-read-method "Move to method: "))) - - ;; First start Gnus. - (let ((gnus-activate-level 0) - (nnmail-spool-file nil)) - (gnus)) - - (save-excursion - ;; Go through all groups and translate. - (let ((newsrc gnus-newsrc-alist) - (nntp-nov-gap nil) - info) - (while (setq info (pop newsrc)) - (when (gnus-group-native-p (gnus-info-group info)) - (gnus-move-group-to-server info from-server to-server)))))) - -(defun gnus-move-group-to-server (info from-server to-server) - "Move group INFO from FROM-SERVER to TO-SERVER." - (let ((group (gnus-info-group info)) - to-active hashtb type mark marks - to-article to-reads to-marks article - act-articles) - (gnus-message 7 "Translating %s..." group) - (when (gnus-request-group group nil to-server) - (setq to-active (gnus-parse-active) - hashtb (gnus-make-hashtable 1024) - act-articles (gnus-uncompress-range to-active)) - ;; Fetch the headers from the `to-server'. - (when (and to-active - act-articles - (setq type (gnus-retrieve-headers - act-articles - group to-server))) - ;; Convert HEAD headers. I don't care. - (when (eq type 'headers) - (nnvirtual-convert-headers)) - ;; Create a mapping from Message-ID to article number. - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (looking-at - "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") - (gnus-sethash - (buffer-substring (match-beginning 1) (match-end 1)) - (read (current-buffer)) - hashtb) - (forward-line 1)) - ;; Then we read the headers from the `from-server'. - (when (and (gnus-request-group group nil from-server) - (gnus-active group) - (setq type (gnus-retrieve-headers - (gnus-uncompress-range - (gnus-active group)) - group from-server))) - ;; Make it easier to map marks. - (let ((mark-lists (gnus-info-marks info)) - ms type m) - (while mark-lists - (setq type (caar mark-lists) - ms (gnus-uncompress-range (cdr (pop mark-lists)))) - (while ms - (if (setq m (assq (car ms) marks)) - (setcdr m (cons type (cdr m))) - (push (list (car ms) type) marks)) - (pop ms)))) - ;; Convert. - (when (eq type 'headers) - (nnvirtual-convert-headers)) - ;; Go through the headers and map away. - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (looking-at - "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") - (when (setq to-article - (gnus-gethash - (buffer-substring (match-beginning 1) (match-end 1)) - hashtb)) - ;; Add this article to the list of read articles. - (push to-article to-reads) - ;; See if there are any marks and then add them. - (when (setq mark (assq (read (current-buffer)) marks)) - (setq marks (delq mark marks)) - (setcar mark to-article) - (push mark to-marks)) - (forward-line 1))) - ;; Now we know what the read articles are and what the - ;; article marks are. We transform the information - ;; into the Gnus info format. - (setq to-reads - (gnus-range-add - (gnus-compress-sequence (and to-reads (sort to-reads '<)) t) - (cons 1 (1- (car to-active))))) - (gnus-info-set-read info to-reads) - ;; Do the marks. I'm sure y'all understand what's - ;; going on down below, so I won't bother with any - ;; further comments. - (let ((mlists gnus-article-mark-lists) - lists ms a) - (while mlists - (push (list (cdr (pop mlists))) lists)) - (while (setq ms (pop marks)) - (setq article (pop ms)) - (while ms - (setcdr (setq a (assq (pop ms) lists)) - (cons article (cdr a))))) - (setq a lists) - (while a - (setcdr (car a) (gnus-compress-sequence - (and (cdar a) (sort (cdar a) '<)))) - (pop a)) - (gnus-info-set-marks info lists t))))) - (gnus-message 7 "Translating %s...done" group))) - -(defun gnus-group-move-group-to-server (info from-server to-server) - "Move the group on the current line from FROM-SERVER to TO-SERVER." - (interactive - (let ((info (gnus-get-info (gnus-group-group-name)))) - (list info (gnus-find-method-for-group (gnus-info-group info)) - (gnus-read-method (format "Move group %s to method: " - (gnus-info-group info)))))) - (save-excursion - (gnus-move-group-to-server info from-server to-server) - ;; We have to update the group info to point use the right server. - (gnus-info-set-method info to-server t) - ;; We also have to change the name of the group and stuff. - (let* ((group (gnus-info-group info)) - (new-name (gnus-group-prefixed-name - (gnus-group-real-name group) to-server))) - (gnus-info-set-group info new-name) - (gnus-sethash new-name (gnus-gethash group gnus-newsrc-hashtb) - gnus-newsrc-hashtb) - (gnus-sethash group nil gnus-newsrc-hashtb)))) - -(provide 'gnus-move) - -;;; gnus-move.el ends here diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el deleted file mode 100644 index a3c5ebc..0000000 --- a/lisp/gnus-nocem.el +++ /dev/null @@ -1,352 +0,0 @@ -;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'nnmail) -(require 'gnus-art) -(require 'gnus-sum) -(require 'gnus-range) - -(defgroup gnus-nocem nil - "NoCeM pseudo-cancellation treatment" - :group 'gnus-score) - -(defcustom gnus-nocem-groups - '("news.lists.filters" "news.admin.net-abuse.bulletins" - "alt.nocem.misc" "news.admin.net-abuse.announce") - "*List of groups that will be searched for NoCeM messages." - :group 'gnus-nocem - :type '(repeat (string :tag "Group"))) - -(defcustom gnus-nocem-issuers - '("AutoMoose-1" "Automoose-1" ; CancelMoose[tm] - "rbraver@ohww.norman.ok.us" ; Robert Braver - "clewis@ferret.ocunix.on.ca" ; Chris Lewis - "jem@xpat.com" ; Despammer from Korea - "snowhare@xmission.com" ; Benjamin "Snowhare" Franz - "red@redpoll.mrfs.oh.us (Richard E. Depew)" ; ARMM! ARMM! - ) - "*List of NoCeM issuers to pay attention to. - -This can also be a list of `(ISSUER CONDITIONS)' elements." - :group 'gnus-nocem - :type '(repeat (choice string sexp))) - -(defcustom gnus-nocem-directory - (nnheader-concat gnus-article-save-directory "NoCeM/") - "*Directory where NoCeM files will be stored." - :group 'gnus-nocem - :type 'directory) - -(defcustom gnus-nocem-expiry-wait 15 - "*Number of days to keep NoCeM headers in the cache." - :group 'gnus-nocem - :type 'integer) - -(defcustom gnus-nocem-verifyer 'mc-verify - "*Function called to verify that the NoCeM message is valid. -One likely value is `mc-verify'. If the function in this variable -isn't bound, the message will be used unconditionally." - :group 'gnus-nocem - :type '(radio (function-item mc-verify) - (function :tag "other"))) - -(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." - :group 'gnus-nocem - :type 'boolean) - -;;; Internal variables - -(defvar gnus-nocem-active nil) -(defvar gnus-nocem-alist nil) -(defvar gnus-nocem-touched-alist nil) -(defvar gnus-nocem-hashtb nil) -(defvar gnus-nocem-seen-message-ids nil) - -;;; Functions - -(defun gnus-nocem-active-file () - (concat (file-name-as-directory gnus-nocem-directory) "active")) - -(defun gnus-nocem-cache-file () - (concat (file-name-as-directory gnus-nocem-directory) "cache")) - -;; -;; faster lookups for group names: -;; - -(defvar gnus-nocem-real-group-hashtb nil - "Real-name mappings of subscribed groups.") - -(defun gnus-fill-real-hashtb () - "Fill up a hash table with the real-name mappings from the user's -active file." - (setq gnus-nocem-real-group-hashtb (gnus-make-hashtable - (length gnus-newsrc-alist))) - (mapcar (lambda (group) - (setq group (gnus-group-real-name (car group))) - (gnus-sethash group t gnus-nocem-real-group-hashtb)) - gnus-newsrc-alist)) - -(defun gnus-nocem-scan-groups () - "Scan all NoCeM groups for new NoCeM messages." - (interactive) - (let ((groups gnus-nocem-groups) - (gnus-inhibit-demon t) - group active gactive articles) - (gnus-make-directory gnus-nocem-directory) - ;; Load any previous NoCeM headers. - (gnus-nocem-load-cache) - ;; Get the group name mappings: - (gnus-fill-real-hashtb) - ;; Read the active file if it hasn't been read yet. - (and (file-exists-p (gnus-nocem-active-file)) - (not gnus-nocem-active) - (ignore-errors - (load (gnus-nocem-active-file) t t t))) - ;; Go through all groups and see whether new articles have - ;; arrived. - (while (setq group (pop groups)) - (if (not (setq gactive (gnus-activate-group group))) - () ; This group doesn't exist. - (setq active (nth 1 (assoc group gnus-nocem-active))) - (when (and (not (< (cdr gactive) (car gactive))) ; Empty group. - (or (not active) - (< (cdr active) (cdr gactive)))) - ;; Ok, there are new articles in this group, se we fetch the - ;; headers. - (save-excursion - (let ((dependencies (make-vector 10 nil)) - headers header) - (nnheader-temp-write nil - (setq headers - (if (eq 'nov - (gnus-retrieve-headers - (setq articles - (gnus-uncompress-range - (cons - (if active (1+ (cdr active)) - (car gactive)) - (cdr gactive)))) - group)) - (gnus-get-newsgroup-headers-xover - articles nil dependencies) - (gnus-get-newsgroup-headers dependencies))) - (while (setq header (pop headers)) - ;; We take a closer look on all articles that have - ;; "@@NCM" in the subject. Unless we already read - ;; this cross posted message. Nocem messages - ;; are not allowed to have references, so we can - ;; ignore scanning followups. - (and (string-match "@@NCM" (mail-header-subject header)) - (or gnus-nocem-liberal-fetch - (and (or (string= "" (mail-header-references - header)) - (null (mail-header-references header))) - (not (member (mail-header-message-id header) - gnus-nocem-seen-message-ids)))) - (gnus-nocem-check-article group header))))))) - (setq gnus-nocem-active - (cons (list group gactive) - (delq (assoc group gnus-nocem-active) - gnus-nocem-active))))) - ;; Save the results, if any. - (gnus-nocem-save-cache) - (gnus-nocem-save-active))) - -(defun gnus-nocem-check-article (group header) - "Check whether the current article is an NCM article and that we want it." - ;; Get the article. - (gnus-message 7 "Checking article %d in %s for NoCeM..." - (mail-header-number header) group) - (let ((date (mail-header-date header)) - issuer b e type) - (when (or (not date) - (nnmail-time-less - (nnmail-time-since (nnmail-date-to-time date)) - (nnmail-days-to-time gnus-nocem-expiry-wait))) - (gnus-request-article-this-buffer (mail-header-number header) group) - (goto-char (point-min)) - (when (re-search-forward "-----BEGIN PGP MESSAGE-----" nil t) - (delete-region (point-min) (match-beginning 0))) - (when (re-search-forward "-----END PGP MESSAGE-----\n?" nil t) - (delete-region (match-end 0) (point-max))) - (goto-char (point-min)) - ;; The article has to have proper NoCeM headers. - (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t)) - (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t))) - ;; We get the name of the issuer. - (narrow-to-region b e) - (setq issuer (mail-fetch-field "issuer") - type (mail-fetch-field "issuer")) - (widen) - (if (not (gnus-nocem-message-wanted-p issuer type)) - (message "invalid NoCeM issuer: %s" issuer) - (and (gnus-nocem-verify-issuer issuer) ; She is who she says she is. - (gnus-nocem-enter-article) ; We gobble the message. - (push (mail-header-message-id header) ; But don't come back for - gnus-nocem-seen-message-ids))))))) ; second helpings. - -(defun gnus-nocem-message-wanted-p (issuer type) - (let ((issuers gnus-nocem-issuers) - wanted conditions condition) - (cond - ;; Do the quick check first. - ((member issuer issuers) - t) - ((setq conditions (cdr (assoc issuer issuers))) - ;; Check whether we want this type. - (while (setq condition (pop conditions)) - (cond - ((stringp condition) - (setq wanted (string-match condition type))) - ((and (consp condition) - (eq (car condition) 'not) - (stringp (cadr condition))) - (setq wanted (not (string-match (cadr condition) type)))) - (t - (error "Invalid NoCeM condition: %S" condition)))) - wanted)))) - -(defun gnus-nocem-verify-issuer (person) - "Verify using PGP that the canceler is who she says she is." - (if (fboundp gnus-nocem-verifyer) - (ignore-errors - (funcall gnus-nocem-verifyer)) - ;; If we don't have Mailcrypt, then we use the message anyway. - t)) - -(defun gnus-nocem-enter-article () - "Enter the current article into the NoCeM cache." - (goto-char (point-min)) - (let ((b (search-forward "\n@@BEGIN NCM BODY\n" nil t)) - (e (search-forward "\n@@END NCM BODY\n" nil t)) - (buf (current-buffer)) - ncm id group) - (when (and b e) - (narrow-to-region b (1+ (match-beginning 0))) - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (cond - ((not (ignore-errors - (setq group (let ((obarray gnus-active-hashtb)) (read buf))))) - ;; An error. - ) - ((not (symbolp group)) - ;; Ignore invalid entries. - ) - ((not (boundp group)) - ;; Make sure all entries in the hashtb are bound. - (set group nil)) - (t - (when (gnus-gethash (gnus-group-real-name (symbol-name group)) - gnus-nocem-real-group-hashtb) - ;; Valid group. - (beginning-of-line) - (while (= (following-char) ?\t) - (forward-line -1)) - (setq id (buffer-substring (point) (1- (search-forward "\t")))) - (unless (gnus-gethash id gnus-nocem-hashtb) - ;; only store if not already present - (gnus-sethash id t gnus-nocem-hashtb) - (push id ncm)) - (forward-line 1) - (while (= (following-char) ?\t) - (forward-line 1)))))) - (when ncm - (setq gnus-nocem-touched-alist t) - (push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time) - ncm) - gnus-nocem-alist)) - t))) - -(defun gnus-nocem-load-cache () - "Load the NoCeM cache." - (interactive) - (unless gnus-nocem-alist - ;; The buffer doesn't exist, so we create it and load the NoCeM - ;; cache. - (when (file-exists-p (gnus-nocem-cache-file)) - (load (gnus-nocem-cache-file) t t t) - (gnus-nocem-alist-to-hashtb)))) - -(defun gnus-nocem-save-cache () - "Save the NoCeM cache." - (when (and gnus-nocem-alist - gnus-nocem-touched-alist) - (nnheader-temp-write (gnus-nocem-cache-file) - (gnus-prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist))) - (setq gnus-nocem-touched-alist nil))) - -(defun gnus-nocem-save-active () - "Save the NoCeM active file." - (nnheader-temp-write (gnus-nocem-active-file) - (gnus-prin1 `(setq gnus-nocem-active ',gnus-nocem-active)))) - -(defun gnus-nocem-alist-to-hashtb () - "Create a hashtable from the Message-IDs we have." - (let* ((alist gnus-nocem-alist) - (pprev (cons nil alist)) - (prev pprev) - (expiry (nnmail-days-to-time gnus-nocem-expiry-wait)) - entry) - (setq gnus-nocem-hashtb (gnus-make-hashtable (* (length alist) 51))) - (while (setq entry (car alist)) - (if (not (nnmail-time-less (nnmail-time-since (car entry)) expiry)) - ;; This entry has expired, so we remove it. - (setcdr prev (cdr alist)) - (setq prev alist) - ;; This is ok, so we enter it into the hashtable. - (setq entry (cdr entry)) - (while entry - (gnus-sethash (car entry) t gnus-nocem-hashtb) - (setq entry (cdr entry)))) - (setq alist (cdr alist))))) - -(gnus-add-shutdown 'gnus-nocem-close 'gnus) - -(defun gnus-nocem-close () - "Clear internal NoCeM variables." - (setq gnus-nocem-alist nil - gnus-nocem-hashtb nil - gnus-nocem-active nil - gnus-nocem-touched-alist nil - gnus-nocem-seen-message-ids nil - gnus-nocem-real-group-hashtb nil)) - -(defun gnus-nocem-unwanted-article-p (id) - "Say whether article ID in the current group is wanted." - (gnus-gethash id gnus-nocem-hashtb)) - -(provide 'gnus-nocem) - -;;; gnus-nocem.el ends here diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el deleted file mode 100644 index 5737f28..0000000 --- a/lisp/gnus-picon.el +++ /dev/null @@ -1,754 +0,0 @@ -;;; gnus-picon.el --- displaying pretty icons in Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Wes Hardaker -;; Keywords: news xpm annotation glyph faces - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(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 add gnus-group-display-picons to the -gnus-summary-display-hook or to the gnus-article-display-hook -depending on what gnus-picons-display-where is set to. You must -also add gnus-article-display-picons to gnus-article-display-hook." - :group 'gnus-visual) - -(defcustom gnus-picons-display-where 'picons - "*Where to display the group and article icons. -Legal values are `article' and `picons'." - :type '(choice symbol string) - :group 'picons) - -(defcustom gnus-picons-has-modeline-p t - "*Wether 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") - "*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) - -(defcustom gnus-picons-user-directories '("local" "users" "usenix" "misc") - "*List of directories to search for user faces." - :type '(repeat string) - :group 'picons) - -(defcustom gnus-picons-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-x-face-file-name - (format "/tmp/picon-xface.%s.xbm" (user-login-name)) - "*The name of the file in which to store the converted X-face header." - :type 'string - :group 'picons) - -(defcustom gnus-picons-convert-x-face (format "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | pbmtoxbm > %s" gnus-picons-x-face-file-name) - "*Command to convert the x-face header into a xbm file." - :type 'string - :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)) - "*List of suffixes on picon file names to try." - :type '(repeat string) - :group 'picons) - -(defcustom gnus-picons-display-article-move-p t - "*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 X face" - :group 'picons) - -;;; Internal variables: - -(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.") - -(defvar gnus-group-annotations nil - "List of annotations added/removed when selecting/exiting a group") -(defvar gnus-article-annotations nil - "List of annotations added/removed when selecting an article") -(defvar gnus-x-face-annotations nil - "List of annotations added/removed when selecting an article with an X-Face.") - -(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.") - -(defvar gnus-picons-job-already-running nil - "Lock to ensure only one stream of http requests is running.") - -;;; Functions: - -(defun gnus-picons-remove (symbol) - "Remove all annotations in variable named SYMBOL. -This function is careful to set it to nil before removing anything so that -asynchronous process don't get crazy." - (setq gnus-picons-jobs-alist (remassq symbol gnus-picons-jobs-alist)) - ;; notify running job that it may have been preempted - (if (and (listp gnus-picons-job-already-running) - (eq (car gnus-picons-job-already-running) symbol)) - (setq gnus-picons-job-already-running t)) - ;; clear all annotations - (mapc (function (lambda (item) - (if (annotationp item) - (delete-annotation item)))) - (prog1 (symbol-value symbol) - (set symbol nil)))) - -(defun gnus-picons-remove-all () - "Removes all picons from the Gnus display(s)." - (interactive) - (gnus-picons-remove 'gnus-article-annotations) - (gnus-picons-remove 'gnus-group-annotations) - (gnus-picons-remove 'gnus-x-face-annotations)) - -(defun gnus-get-buffer-name (variable) - "Returns the buffer name associated with the contents of a variable." - (cond ((symbolp variable) (let ((newvar (cdr (assq variable - gnus-window-to-buffer)))) - (cond ((symbolp newvar) - (symbol-value newvar)) - ((stringp newvar) newvar)))) - ((stringp variable) variable))) - -(defun gnus-picons-set-buffer () - (set-buffer - (get-buffer-create (gnus-get-buffer-name gnus-picons-display-where))) - (gnus-add-current-to-buffer-list) - (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 (annotations) - "Prepare picons buffer for puting annotations memorized in ANNOTATIONS. -ANNOTATIONS should be a symbol naming a variable wich contains a list of -annotations. Sets buffer to `gnus-picons-display-where'." - ;; let drawing catch up - (when gnus-picons-refresh-before-display - (sit-for 0)) - (gnus-picons-set-buffer) - (gnus-picons-remove annotations)) - -(defsubst gnus-picons-make-annotation (&rest args) - (let ((annot (apply 'make-annotation args))) - (set-extent-property annot 'duplicable nil) - annot)) - -(defun gnus-picons-article-display-x-face () - "Display the x-face header bitmap in the 'gnus-picons-display-where buffer." - ;; delete any old ones. - ;; This is needed here because gnus-picons-display-x-face will not - ;; be called if there is no X-Face header - (gnus-picons-remove 'gnus-x-face-annotations) - ;; display the new one. - (let ((gnus-article-x-face-command 'gnus-picons-display-x-face)) - (gnus-article-display-x-face))) - -(defun gnus-picons-x-face-sentinel (process event) - (let* ((env (assq process gnus-picons-processes-alist)) - (annot (cdr env))) - (setq gnus-picons-processes-alist - (remassq process gnus-picons-processes-alist)) - (when (annotationp annot) - (set-annotation-glyph annot - (make-glyph gnus-picons-x-face-file-name)) - (if (memq annot gnus-x-face-annotations) - (delete-file gnus-picons-x-face-file-name))))) - -(defun gnus-picons-display-x-face (beg end) - "Function to display the x-face header in the picons window. -To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" - (interactive) - (if (featurep 'xface) - ;; Use builtin support - (let ((buf (current-buffer))) - (save-excursion - (gnus-picons-prepare-for-annotations 'gnus-x-face-annotations) - (setq gnus-x-face-annotations - (cons (gnus-picons-make-annotation - (vector 'xface - :data (concat "X-Face: " - (buffer-substring beg end buf))) - nil 'text) - gnus-x-face-annotations)))) - ;; convert the x-face header to a .xbm file - (let* ((process-connection-type nil) - (annot (save-excursion - (gnus-picons-prepare-for-annotations - 'gnus-x-face-annotations) - (gnus-picons-make-annotation nil nil 'text))) - (process (start-process-shell-command "gnus-x-face" nil - gnus-picons-convert-x-face))) - (push annot gnus-x-face-annotations) - (push (cons process annot) gnus-picons-processes-alist) - (process-kill-without-query process) - (set-process-sentinel process 'gnus-picons-x-face-sentinel) - (process-send-region process beg end) - (process-send-eof process)))) - -(defun gnus-article-display-picons () - "Display faces for an author and her domain in gnus-picons-display-where." - (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-article-annotations) - ;; if display in article buffer, the group annotations - ;; wrongly placed. Move them here - (if (eq gnus-picons-display-where 'article) - (dolist (ext gnus-group-annotations) - (set-extent-endpoints ext (point) (point)))) - (if (null gnus-picons-piconsearch-url) - (setq gnus-article-annotations - (nconc gnus-article-annotations - (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) - (list (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) - gnus-picons-jobs-alist) - (gnus-picons-next-job)) - - (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))))) - -(defun gnus-group-display-picons () - "Display icons for the group in the gnus-picons-display-where buffer." - (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)))) - (save-excursion - (gnus-picons-prepare-for-annotations 'gnus-group-annotations) - (if (null gnus-picons-piconsearch-url) - (setq gnus-group-annotations - (gnus-picons-display-pairs - (gnus-picons-lookup-pairs - (reverse (message-tokenize-header - (gnus-group-real-name gnus-newsgroup-name) - ".")) - gnus-picons-news-directories) - t ".")) - (push (list 'gnus-group-annotations 'search nil - (message-tokenize-header - (gnus-group-real-name gnus-newsgroup-name) ".") - (if (listp gnus-picons-news-directories) - gnus-picons-news-directories - (list gnus-picons-news-directories)) - nil) - gnus-picons-jobs-alist) - (gnus-picons-next-job)) - - (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))) - -(defsubst 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) - (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)) - (when (equal suf "xbm") - (set-glyph-face glyph 'gnus-picons-xbm-face)) - (push (cons key glyph) gnus-picons-glyph-alist))) - glyph)) - -(defun gnus-picons-display-glyph (glyph &optional part rightp) - (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" - (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 ! - -(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)) - (re-search-forward (concat "" - (regexp-quote name) - " *= * *\\([^ <][^<]*\\) *")) - (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 - (concat - ;; dbs - "^\\(" (mapconcat 'identity dbs "\\|") "\\)/" - ;; host - "\\(\\(" (replace-in-string host "\\." "/\\|" t) "/\\|MISC/\\)*\\)" - ;; user - "\\(" (regexp-quote user) "\\|unknown\\)/" - "face\\.")) - cur-db cur-host cur-user types res) - ;; now point will be somewhere in the header. Find beginning of - ;; entries - (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 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -;;; List and range functions - -(defun gnus-last-element (list) - "Return last element of LIST." - (while (cdr list) - (setq list (cdr list))) - (car list)) - -(defun gnus-copy-sequence (list) - "Do a complete, total copy of a list." - (let (out) - (while (consp list) - (if (consp (car list)) - (push (gnus-copy-sequence (pop list)) out) - (push (pop list) out))) - (if list - (nconc (nreverse out) list) - (nreverse out)))) - -(defun gnus-set-difference (list1 list2) - "Return a list of elements of LIST1 that do not appear in LIST2." - (let ((list1 (copy-sequence list1))) - (while list2 - (setq list1 (delq (car list2) list1)) - (setq list2 (cdr list2))) - list1)) - -(defun gnus-sorted-complement (list1 list2) - "Return a list of elements of LIST1 that do not appear in LIST2. -Both lists have to be sorted over <." - (let (out) - (if (or (null list1) (null list2)) - (or list1 list2) - (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 out (cons (car list2) out)) - (setq list2 (cdr list2))))) - (nconc (nreverse out) (or list1 list2))))) - -(defun gnus-intersection (list1 list2) - (let ((result nil)) - (while list2 - (when (memq (car list2) list1) - (setq result (cons (car list2) result))) - (setq list2 (cdr list2))) - result)) - -(defun gnus-sorted-intersection (list1 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 list1 (cdr list1))) - (t - (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. - (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)) - (setcdr prev (cdr list1)) - (setq list1 (cdr list1))) - (t - (setq list2 (cdr list2))))) - (setcdr prev nil) - (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 -ranges." - (let* ((first (car numbers)) - (last (car numbers)) - result) - (if (null numbers) - nil - (if (not (listp (cdr numbers))) - numbers - (while numbers - (cond ((= last (car numbers)) nil) ;Omit duplicated number - ((= (1+ last) (car numbers)) ;Still in sequence - (setq last (car numbers))) - (t ;End of one sequence - (setq result - (cons (if (= first last) first - (cons first last)) - result)) - (setq first (car numbers)) - (setq last (car numbers)))) - (setq numbers (cdr numbers))) - (if (and (not always-list) (null result)) - (if (= first last) (list first) (cons first last)) - (nreverse (cons (if (= first last) first (cons first last)) - result))))))) - -(defalias 'gnus-uncompress-sequence 'gnus-uncompress-range) -(defun gnus-uncompress-range (ranges) - "Expand a list of ranges into a list of numbers. -RANGES is either a single range on the form `(num . num)' or a list of -these ranges." - (let (first last result) - (cond - ((null ranges) - nil) - ((not (listp (cdr ranges))) - (setq first (car ranges)) - (setq last (cdr ranges)) - (while (<= first last) - (setq result (cons first result)) - (setq first (1+ first))) - (nreverse result)) - (t - (while ranges - (if (atom (car ranges)) - (when (numberp (car ranges)) - (setq result (cons (car ranges) result))) - (setq first (caar ranges)) - (setq last (cdar ranges)) - (while (<= first last) - (setq result (cons first result)) - (setq first (1+ first)))) - (setq ranges (cdr ranges))) - (nreverse result))))) - -(defun gnus-add-to-range (ranges list) - "Return a list of ranges that has all articles from both RANGES and LIST. -Note: LIST has to be sorted over `<'." - (if (not ranges) - (gnus-compress-sequence list t) - (setq list (copy-sequence list)) - (unless (listp (cdr ranges)) - (setq ranges (list ranges))) - (let ((out ranges) - ilist lowest highest temp) - (while (and ranges list) - (setq ilist list) - (setq lowest (or (and (atom (car ranges)) (car ranges)) - (caar ranges))) - (while (and list (cdr list) (< (cadr list) lowest)) - (setq list (cdr list))) - (when (< (car ilist) lowest) - (setq temp list) - (setq list (cdr list)) - (setcdr temp nil) - (setq out (nconc (gnus-compress-sequence ilist t) out))) - (setq highest (or (and (atom (car ranges)) (car ranges)) - (cdar ranges))) - (while (and list (<= (car list) highest)) - (setq list (cdr list))) - (setq ranges (cdr ranges))) - (when list - (setq out (nconc (gnus-compress-sequence list t) out))) - (setq out (sort out (lambda (r1 r2) - (< (or (and (atom r1) r1) (car r1)) - (or (and (atom r2) r2) (car r2)))))) - (setq ranges out) - (while ranges - (if (atom (car ranges)) - (when (cdr ranges) - (if (atom (cadr ranges)) - (when (= (1+ (car ranges)) (cadr ranges)) - (setcar ranges (cons (car ranges) - (cadr ranges))) - (setcdr ranges (cddr ranges))) - (when (= (1+ (car ranges)) (caadr ranges)) - (setcar (cadr ranges) (car ranges)) - (setcar ranges (cadr ranges)) - (setcdr ranges (cddr ranges))))) - (when (cdr ranges) - (if (atom (cadr ranges)) - (when (= (1+ (cdar ranges)) (cadr ranges)) - (setcdr (car ranges) (cadr ranges)) - (setcdr ranges (cddr ranges))) - (when (= (1+ (cdar ranges)) (caadr ranges)) - (setcdr (car ranges) (cdadr ranges)) - (setcdr ranges (cddr ranges)))))) - (setq ranges (cdr ranges))) - out))) - -(defun gnus-remove-from-range (ranges list) - "Return a list of ranges that has all articles from LIST removed from RANGES. -Note: LIST has to be sorted over `<'." - ;; !!! This function shouldn't look like this, but I've got a headache. - (gnus-compress-sequence - (gnus-sorted-complement - (gnus-uncompress-range ranges) list))) - -(defun gnus-member-of-range (number ranges) - (if (not (listp (cdr ranges))) - (and (>= number (car ranges)) - (<= number (cdr ranges))) - (let ((not-stop t)) - (while (and ranges - (if (numberp (car ranges)) - (>= number (car ranges)) - (>= number (caar ranges))) - not-stop) - (when (if (numberp (car ranges)) - (= number (car ranges)) - (and (>= number (caar ranges)) - (<= number (cdar ranges)))) - (setq not-stop nil)) - (setq ranges (cdr ranges))) - (not not-stop)))) - -(defun gnus-range-length (range) - "Return the length RANGE would have if uncompressed." - (length (gnus-uncompress-range range))) - -(defun gnus-sublist-p (list sublist) - "Test whether all elements in SUBLIST are members of LIST." - (let ((sublistp t)) - (while sublist - (unless (memq (pop sublist) list) - (setq sublistp nil - sublist nil))) - sublistp)) - -(defun gnus-range-add (range1 range2) - "Add RANGE2 to RANGE1 destructively." - (cond - ;; If either are nil, then the job is quite easy. - ((or (null range1) (null range2)) - (or range1 range2)) - (t - ;; I don't like thinking. - (gnus-compress-sequence - (sort - (nconc - (gnus-uncompress-range range1) - (gnus-uncompress-range range2)) - '<))))) - -(provide 'gnus-range) - -;;; gnus-range.el ends here diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el deleted file mode 100644 index 8c201ba..0000000 --- a/lisp/gnus-salt.el +++ /dev/null @@ -1,1014 +0,0 @@ -;;; gnus-salt.el --- alternate summary mode interfaces for Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-sum) - -;;; -;;; gnus-pick-mode -;;; - -(defvar gnus-pick-mode nil - "Minor mode for providing a pick-and-read interface in Gnus summary buffers.") - -(defcustom gnus-pick-display-summary nil - "*Display summary while reading." - :type 'boolean - :group 'gnus-summary-pick) - -(defcustom gnus-pick-mode-hook nil - "*Hook run in summary pick mode buffers." - :type 'hook - :group 'gnus-summary-pick) - -(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 will run 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" - "*The format specification of the lines in pick buffers. -It accepts the same format specs that `gnus-summary-line-format' does." - :type 'string - :group 'gnus-summary-pick) - -;;; Internal variables. - -(defvar gnus-pick-mode-map nil) - -(unless gnus-pick-mode-map - (setq gnus-pick-mode-map (make-sparse-keymap)) - - (gnus-define-keys gnus-pick-mode-map - "t" gnus-uu-mark-thread - "T" gnus-uu-unmark-thread - " " gnus-pick-next-page - "u" gnus-summary-unmark-as-processable - "U" gnus-summary-unmark-all-processable - "v" gnus-uu-mark-over - "r" gnus-uu-mark-region - "R" gnus-uu-unmark-region - "e" gnus-uu-mark-by-regexp - "E" gnus-uu-mark-by-regexp - "b" gnus-uu-mark-buffer - "B" gnus-uu-unmark-buffer - "." gnus-pick-article - gnus-down-mouse-2 gnus-pick-mouse-pick-region - ;;gnus-mouse-2 gnus-pick-mouse-pick - "X" gnus-pick-start-reading - "\r" gnus-pick-start-reading)) - -(defun gnus-pick-make-menu-bar () - (unless (boundp 'gnus-pick-menu) - (easy-menu-define - gnus-pick-menu gnus-pick-mode-map "" - '("Pick" - ("Pick" - ["Article" gnus-summary-mark-as-processable t] - ["Thread" gnus-uu-mark-thread t] - ["Region" gnus-uu-mark-region t] - ["Regexp" gnus-uu-mark-regexp t] - ["Buffer" gnus-uu-mark-buffer t]) - ("Unpick" - ["Article" gnus-summary-unmark-as-processable t] - ["Thread" gnus-uu-unmark-thread t] - ["Region" gnus-uu-unmark-region t] - ["Regexp" gnus-uu-unmark-regexp t] - ["Buffer" gnus-uu-unmark-buffer t]) - ["Start reading" gnus-pick-start-reading t] - ["Switch pick mode off" gnus-pick-mode gnus-pick-mode])))) - -(defun gnus-pick-mode (&optional arg) - "Minor mode for providing a pick-and-read interface in Gnus summary buffers. - -\\{gnus-pick-mode-map}" - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (if (not (set (make-local-variable 'gnus-pick-mode) - (if (null arg) (not gnus-pick-mode) - (> (prefix-numeric-value arg) 0)))) - (remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message) - ;; Make sure that we don't select any articles upon group entry. - (set (make-local-variable 'gnus-auto-select-first) nil) - ;; Change line format. - (setq gnus-summary-line-format gnus-summary-pick-line-format) - (setq gnus-summary-line-format-spec nil) - (gnus-update-format-specifications nil 'summary) - (gnus-update-summary-mark-positions) - (add-hook 'gnus-message-setup-hook 'gnus-pick-setup-message) - (set (make-local-variable 'gnus-summary-goto-unread) 'never) - ;; Set up the menu. - (when (gnus-visual-p 'pick-menu 'menu) - (gnus-pick-make-menu-bar)) - (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map) - (gnus-run-hooks 'gnus-pick-mode-hook)))) - -(defun gnus-pick-setup-message () - "Make Message do the right thing on exit." - (when (and (gnus-buffer-live-p gnus-summary-buffer) - (save-excursion - (set-buffer gnus-summary-buffer) - gnus-pick-mode)) - (message-add-action - '(gnus-configure-windows 'pick t) 'send 'exit 'postpone 'kill))) - -(defvar gnus-pick-line-number 1) -(defun gnus-pick-line-number () - "Return the current line number." - (if (bobp) - (setq gnus-pick-line-number 1) - (incf gnus-pick-line-number))) - -(defun gnus-pick-start-reading (&optional catch-up) - "Start reading the picked articles. -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-mark-excluded-as-read)) - (gnus-summary-first-article) - (gnus-configure-windows - (if gnus-pick-display-summary 'article 'pick) t)) - (if gnus-pick-elegant-flow - (progn - (when (or catch-up gnus-mark-unpicked-articles-as-read) - (gnus-summary-catchup nil t)) - (if (gnus-group-quit-config gnus-newsgroup-name) - (gnus-summary-exit) - (gnus-summary-next-group))) - (error "No articles have been picked")))) - -(defun gnus-pick-article (&optional arg) - "Pick the article on the current line. -If ARG, pick the article on that line instead." - (interactive "P") - (when arg - (let (pos) - (save-excursion - (goto-char (point-min)) - (when (zerop (forward-line (1- (prefix-numeric-value arg)))) - (setq pos (point)))) - (if (not pos) - (gnus-error 2 "No such line: %s" arg) - (goto-char pos)))) - (gnus-summary-mark-as-processable 1)) - -(defun gnus-pick-mouse-pick (e) - (interactive "e") - (mouse-set-point e) - (save-excursion - (gnus-summary-mark-as-processable 1))) - -(defun gnus-pick-mouse-pick-region (start-event) - "Pick articles that the mouse is dragged over. -This must be bound to a button-down mouse event." - (interactive "e") - (mouse-minibuffer-check start-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-window (posn-window start-posn)) - (start-frame (window-frame start-window)) - (bounds (gnus-window-edges start-window)) - (top (nth 1 bounds)) - (bottom (if (window-minibuffer-p start-window) - (nth 3 bounds) - ;; Don't count the mode line. - (1- (nth 3 bounds)))) - (click-count (1- (event-click-count start-event)))) - (setq mouse-selection-click-count click-count) - (setq mouse-selection-click-count-buffer (current-buffer)) - (mouse-set-point start-event) - ;; In case the down click is in the middle of some intangible text, - ;; use the end of that text, and put it in START-POINT. - (when (< (point) start-point) - (goto-char start-point)) - (gnus-pick-article) - (setq start-point (point)) - ;; end-of-range is used only in the single-click case. - ;; It is the place where the drag has reached so far - ;; (but not outside the window where the drag started). - (let (event end end-point last-end-point (end-of-range (point))) - (track-mouse - (while (progn - (setq event (read-event)) - (or (mouse-movement-p event) - (eq (car-safe event) 'switch-frame))) - (if (eq (car-safe event) 'switch-frame) - nil - (setq end (event-end event) - end-point (posn-point end)) - (when end-point - (setq last-end-point end-point)) - - (cond - ;; Are we moving within the original window? - ((and (eq (posn-window end) start-window) - (integer-or-marker-p end-point)) - ;; Go to START-POINT first, so that when we move to END-POINT, - ;; if it's in the middle of intangible text, - ;; point jumps in the direction away from START-POINT. - (goto-char start-point) - (goto-char end-point) - (gnus-pick-article) - ;; In case the user moved his mouse really fast, pick - ;; articles on the line between this one and the last one. - (let* ((this-line (1+ (count-lines 1 end-point))) - (min-line (min this-line start-line)) - (max-line (max this-line start-line))) - (while (< min-line max-line) - (goto-line min-line) - (gnus-pick-article) - (setq min-line (1+ min-line))) - (setq start-line this-line)) - (when (zerop (% click-count 3)) - (setq end-of-range (point)))) - (t - (let ((mouse-row (cdr (cdr (mouse-position))))) - (cond - ((null mouse-row)) - ((< mouse-row top) - (mouse-scroll-subr start-window (- mouse-row top))) - ((>= mouse-row bottom) - (mouse-scroll-subr start-window - (1+ (- mouse-row bottom))))))))))) - (when (consp event) - (let ((fun (key-binding (vector (car event))))) - ;; Run the binding of the terminating up-event, if possible. - ;; In the case of a multiple click, it gives the wrong results, - ;; because it would fail to set up a region. - (when nil - ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun)) - ;; In this case, we can just let the up-event execute normally. - (let ((end (event-end event))) - ;; Set the position in the event before we replay it, - ;; because otherwise it may have a position in the wrong - ;; buffer. - (setcar (cdr end) end-of-range) - ;; Delete the overlay before calling the function, - ;; because delete-overlay increases buffer-modified-tick. - (push event unread-command-events)))))))) - -(defun gnus-pick-next-page () - "Go to the next page. If at the end of the buffer, start reading articles." - (interactive) - (let ((scroll-in-place nil)) - (condition-case nil - (scroll-up) - (end-of-buffer (gnus-pick-start-reading))))) - -;;; -;;; gnus-binary-mode -;;; - -(defvar gnus-binary-mode nil - "Minor mode for providing a binary group interface in Gnus summary buffers.") - -(defvar gnus-binary-mode-hook nil - "Hook run in summary binary mode buffers.") - -(defvar gnus-binary-mode-map nil) - -(unless gnus-binary-mode-map - (setq gnus-binary-mode-map (make-sparse-keymap)) - - (gnus-define-keys - gnus-binary-mode-map - "g" gnus-binary-show-article)) - -(defun gnus-binary-make-menu-bar () - (unless (boundp 'gnus-binary-menu) - (easy-menu-define - gnus-binary-menu gnus-binary-mode-map "" - '("Pick" - ["Switch binary mode off" gnus-binary-mode t])))) - -(defun gnus-binary-mode (&optional arg) - "Minor mode for providing a binary group interface in Gnus summary buffers." - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (make-local-variable 'gnus-binary-mode) - (setq gnus-binary-mode - (if (null arg) (not gnus-binary-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-binary-mode - ;; Make sure that we don't select any articles upon group entry. - (make-local-variable 'gnus-auto-select-first) - (setq gnus-auto-select-first nil) - (make-local-variable 'gnus-summary-display-article-function) - (setq gnus-summary-display-article-function 'gnus-binary-display-article) - ;; Set up the menu. - (when (gnus-visual-p 'binary-menu 'menu) - (gnus-binary-make-menu-bar)) - (gnus-add-minor-mode 'gnus-binary-mode " Binary" gnus-binary-mode-map) - (gnus-run-hooks 'gnus-binary-mode-hook)))) - -(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)) - (gnus-uu-decode-uu)))) - -(defun gnus-binary-show-article (&optional arg) - "Bypass the binary functions and show the article." - (interactive "P") - (let (gnus-summary-display-article-function) - (gnus-summary-show-article arg))) - -;;; -;;; gnus-tree-mode -;;; - -(defcustom gnus-tree-line-format "%(%[%3,3n%]%)" - "*Format of tree elements." - :type 'string - :group 'gnus-summary-tree) - -(defcustom gnus-tree-minimize-window t - "*If non-nil, minimize the tree buffer window. -If a number, never let the tree buffer grow taller than that number of -lines." - :type 'boolean - :group 'gnus-summary-tree) - -(defcustom gnus-selected-tree-face 'modeline - "*Face used for highlighting selected articles in the thread tree." - :type 'face - :group 'gnus-summary-tree) - -(defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\)) - (?\{ . ?\}) (?< . ?>)) - "Brackets used in tree nodes.") - -(defvar gnus-tree-parent-child-edges '(?- ?\\ ?|) - "Characters used to connect parents with children.") - -(defcustom gnus-tree-mode-line-format "Gnus: %%b %S %Z" - "*The format specification for the tree mode line." - :type 'string - :group 'gnus-summary-tree) - -(defcustom gnus-generate-tree-function 'gnus-generate-vertical-tree - "*Function for generating a thread tree. -Two predefined functions are available: -`gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'." - :type '(radio (function-item gnus-generate-vertical-tree) - (function-item gnus-generate-horizontal-tree) - (function :tag "Other" nil)) - :group 'gnus-summary-tree) - -(defcustom gnus-tree-mode-hook nil - "*Hook run in tree mode buffers." - :type 'hook - :group 'gnus-summary-tree) - -;;; Internal variables. - -(defvar gnus-tree-line-format-alist - `((?n gnus-tmp-name ?s) - (?f gnus-tmp-from ?s) - (?N gnus-tmp-number ?d) - (?\[ gnus-tmp-open-bracket ?c) - (?\] gnus-tmp-close-bracket ?c) - (?s gnus-tmp-subject ?s))) - -(defvar gnus-tree-mode-line-format-alist gnus-summary-mode-line-format-alist) - -(defvar gnus-tree-mode-line-format-spec nil) -(defvar gnus-tree-line-format-spec nil) - -(defvar gnus-tree-node-length nil) -(defvar gnus-selected-tree-overlay nil) - -(defvar gnus-tree-displayed-thread nil) - -(defvar gnus-tree-mode-map nil) -(put 'gnus-tree-mode 'mode-class 'special) - -(unless gnus-tree-mode-map - (setq gnus-tree-mode-map (make-keymap)) - (suppress-keymap gnus-tree-mode-map) - (gnus-define-keys - gnus-tree-mode-map - "\r" gnus-tree-select-article - gnus-mouse-2 gnus-tree-pick-article - "\C-?" gnus-tree-read-summary-keys - "h" gnus-tree-show-summary - - "\C-c\C-i" gnus-info-find-node) - - (substitute-key-definition - 'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map)) - -(defun gnus-tree-make-menu-bar () - (unless (boundp 'gnus-tree-menu) - (easy-menu-define - gnus-tree-menu gnus-tree-mode-map "" - '("Tree" - ["Select article" gnus-tree-select-article t])))) - -(defun gnus-tree-mode () - "Major mode for displaying thread trees." - (interactive) - (gnus-set-format 'tree-mode) - (gnus-set-format 'tree t) - (when (gnus-visual-p 'tree-menu 'menu) - (gnus-tree-make-menu-bar)) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq mode-name "Tree") - (setq major-mode 'gnus-tree-mode) - (use-local-map gnus-tree-mode-map) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) - (setq truncate-lines t) - (save-excursion - (gnus-set-work-buffer) - (gnus-tree-node-insert (make-mail-header "") nil) - (setq gnus-tree-node-length (1- (point)))) - (gnus-run-hooks 'gnus-tree-mode-hook)) - -(defun gnus-tree-read-summary-keys (&optional arg) - "Read a summary buffer key sequence and execute it." - (interactive "P") - (let ((buf (current-buffer)) - win) - (gnus-article-read-summary-keys arg nil t) - (when (setq win (get-buffer-window buf)) - (select-window win) - (when gnus-selected-tree-overlay - (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) - (gnus-tree-minimize)))) - -(defun gnus-tree-show-summary () - "Reconfigure windows to show summary buffer." - (interactive) - (if (not (gnus-buffer-live-p gnus-summary-buffer)) - (error "There is no summary buffer for this tree buffer") - (gnus-configure-windows 'article) - (gnus-summary-goto-subject gnus-current-article))) - -(defun gnus-tree-select-article (article) - "Select the article under point, if any." - (interactive (list (gnus-tree-article-number))) - (let ((buf (current-buffer))) - (when article - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-goto-article article)) - (select-window (get-buffer-window buf))))) - -(defun gnus-tree-pick-article (e) - "Select the article under the mouse pointer." - (interactive "e") - (mouse-set-point e) - (gnus-tree-select-article (gnus-tree-article-number))) - -(defun gnus-tree-article-number () - (get-text-property (point) 'gnus-number)) - -(defun gnus-tree-article-region (article) - "Return a cons with BEG and END of the article region." - (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article))) - (when pos - (cons pos (next-single-property-change pos 'gnus-number))))) - -(defun gnus-tree-goto-article (article) - (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article))) - (when pos - (goto-char pos)))) - -(defun gnus-tree-recenter () - "Center point in the tree window." - (let ((selected (selected-window)) - (tree-window (get-buffer-window gnus-tree-buffer t))) - (when tree-window - (select-window tree-window) - (when gnus-selected-tree-overlay - (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) - (let* ((top (cond ((< (window-height) 4) 0) - ((< (window-height) 7) 1) - (t 2))) - (height (1- (window-height))) - (bottom (save-excursion (goto-char (point-max)) - (forward-line (- height)) - (point)))) - ;; 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 - tree-window (min bottom (save-excursion - (forward-line (- top)) (point))))) - (select-window selected)))) - -(defun gnus-get-tree-buffer () - "Return the tree buffer properly initialized." - (save-excursion - (set-buffer (get-buffer-create gnus-tree-buffer)) - (unless (eq major-mode 'gnus-tree-mode) - (gnus-add-current-to-buffer-list) - (gnus-tree-mode)) - (current-buffer))) - -(defun gnus-tree-minimize () - (when (and gnus-tree-minimize-window - (not (one-window-p))) - (let ((windows 0) - tot-win-height) - (walk-windows (lambda (window) (incf windows))) - (setq tot-win-height - (- (frame-height) - (* window-min-height (1- windows)) - 2)) - (let* ((window-min-height 2) - (height (count-lines (point-min) (point-max))) - (min (max (1- window-min-height) height)) - (tot (if (numberp gnus-tree-minimize-window) - (min gnus-tree-minimize-window min) - min)) - (win (get-buffer-window (current-buffer))) - (wh (and win (1- (window-height win))))) - (setq tot (min tot tot-win-height)) - (when (and win - (not (eq tot wh))) - (let ((selected (selected-window))) - (when (ignore-errors (select-window win)) - (enlarge-window (- tot wh)) - (select-window selected)))))))) - -;;; Generating the tree. - -(defun gnus-tree-node-insert (header sparse &optional adopted) - (let* ((dummy (stringp header)) - (header (if (vectorp header) header - (progn - (setq header (make-mail-header "*****")) - (mail-header-set-number header 0) - (mail-header-set-lines header 0) - (mail-header-set-chars header 0) - header))) - (gnus-tmp-from (mail-header-from header)) - (gnus-tmp-subject (mail-header-subject header)) - (gnus-tmp-number (mail-header-number header)) - (gnus-tmp-name - (cond - ((string-match "(.+)" gnus-tmp-from) - (substring gnus-tmp-from - (1+ (match-beginning 0)) (1- (match-end 0)))) - ((string-match "<[^>]+> *$" gnus-tmp-from) - (let ((beg (match-beginning 0))) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) - (substring gnus-tmp-from 0 beg)))) - ((memq gnus-tmp-number sparse) - "***") - (t gnus-tmp-from))) - (gnus-tmp-open-bracket - (cond ((memq gnus-tmp-number sparse) - (caadr gnus-tree-brackets)) - (dummy (caaddr gnus-tree-brackets)) - (adopted (car (nth 3 gnus-tree-brackets))) - (t (caar gnus-tree-brackets)))) - (gnus-tmp-close-bracket - (cond ((memq gnus-tmp-number sparse) - (cdadr gnus-tree-brackets)) - (adopted (cdr (nth 3 gnus-tree-brackets))) - (dummy - (cdaddr gnus-tree-brackets)) - (t (cdar gnus-tree-brackets)))) - (buffer-read-only nil) - beg end) - (gnus-add-text-properties - (setq beg (point)) - (setq end (progn (eval gnus-tree-line-format-spec) (point))) - (list 'gnus-number gnus-tmp-number)) - (when (or t (gnus-visual-p 'tree-highlight 'highlight)) - (gnus-tree-highlight-node gnus-tmp-number beg end)))) - -(defun gnus-tree-highlight-node (article beg end) - "Highlight current line according to `gnus-summary-highlight'." - (let ((list gnus-summary-highlight) - face) - (save-excursion - (set-buffer gnus-summary-buffer) - (let* ((score (or (cdr (assq article gnus-newsgroup-scored)) - gnus-summary-default-score 0)) - (default gnus-summary-default-score) - (mark (or (gnus-summary-article-mark article) gnus-unread-mark))) - ;; Eval the cars of the lists until we find a match. - (while (and list - (not (eval (caar list)))) - (setq list (cdr list))))) - (unless (eq (setq face (cdar list)) (get-text-property beg 'face)) - (gnus-put-text-property - beg end 'face - (if (boundp face) (symbol-value face) face))))) - -(defun gnus-tree-indent (level) - (insert (make-string (1- (* (1+ gnus-tree-node-length) level)) ? ))) - -(defvar gnus-tmp-limit) -(defvar gnus-tmp-sparse) -(defvar gnus-tmp-indent) - -(defun gnus-generate-tree (thread) - "Generate a thread tree for THREAD." - (save-excursion - (set-buffer (gnus-get-tree-buffer)) - (let ((buffer-read-only nil) - (gnus-tmp-indent 0)) - (erase-buffer) - (funcall gnus-generate-tree-function thread 0) - (gnus-set-mode-line 'tree) - (goto-char (point-min)) - (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)) - (gnus-horizontal-recenter) - (select-window selected)))))) - -(defun gnus-generate-horizontal-tree (thread level &optional dummyp adopted) - "Generate a horizontal tree." - (let* ((dummy (stringp (car thread))) - (do (or dummy - (and (car thread) - (memq (mail-header-number (car thread)) - gnus-tmp-limit)))) - col beg) - (if (not do) - ;; We don't want this article. - (setq thread (cdr thread)) - (if (not (bolp)) - ;; Not the first article on the line, so we insert a "-". - (insert (car gnus-tree-parent-child-edges)) - ;; If the level isn't zero, then we insert some indentation. - (unless (zerop level) - (gnus-tree-indent level) - (insert (cadr gnus-tree-parent-child-edges)) - (setq col (- (setq beg (point)) (gnus-point-at-bol) 1)) - ;; Draw "|" lines upwards. - (while (progn - (forward-line -1) - (forward-char col) - (= (following-char) ? )) - (delete-char 1) - (insert (caddr gnus-tree-parent-child-edges))) - (goto-char beg))) - (setq dummyp nil) - ;; Insert the article node. - (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted)) - (if (null thread) - ;; End of the thread, so we go to the next line. - (unless (bolp) - (insert "\n")) - ;; Recurse downwards in all children of this article. - (while thread - (gnus-generate-horizontal-tree - (pop thread) (if do (1+ level) level) - (or dummyp dummy) dummy))))) - -(defsubst gnus-tree-indent-vertical () - (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) - (- (point) (gnus-point-at-bol))))) - (when (> len 0) - (insert (make-string len ? ))))) - -(defsubst gnus-tree-forward-line (n) - (while (>= (decf n) 0) - (unless (zerop (forward-line 1)) - (end-of-line) - (insert "\n"))) - (end-of-line)) - -(defun gnus-generate-vertical-tree (thread level &optional dummyp adopted) - "Generate a vertical tree." - (let* ((dummy (stringp (car thread))) - (do (or dummy - (and (car thread) - (memq (mail-header-number (car thread)) - gnus-tmp-limit)))) - beg) - (if (not do) - ;; We don't want this article. - (setq thread (cdr thread)) - (if (not (save-excursion (beginning-of-line) (bobp))) - ;; Not the first article on the line, so we insert a "-". - (progn - (gnus-tree-indent-vertical) - (insert (make-string (/ gnus-tree-node-length 2) ? )) - (insert (caddr gnus-tree-parent-child-edges)) - (gnus-tree-forward-line 1)) - ;; If the level isn't zero, then we insert some indentation. - (unless (zerop gnus-tmp-indent) - (gnus-tree-forward-line (1- (* 2 level))) - (gnus-tree-indent-vertical) - (delete-char -1) - (insert (cadr gnus-tree-parent-child-edges)) - (setq beg (point)) - (forward-char -1) - ;; Draw "-" lines leftwards. - (while (= (char-after (1- (point))) ? ) - (delete-char -1) - (insert (car gnus-tree-parent-child-edges)) - (forward-char -1)) - (goto-char beg) - (gnus-tree-forward-line 1))) - (setq dummyp nil) - ;; Insert the article node. - (gnus-tree-indent-vertical) - (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted) - (gnus-tree-forward-line 1)) - (if (null thread) - ;; End of the thread, so we go to the next line. - (progn - (goto-char (point-min)) - (end-of-line) - (incf gnus-tmp-indent)) - ;; Recurse downwards in all children of this article. - (while thread - (gnus-generate-vertical-tree - (pop thread) (if do (1+ level) level) - (or dummyp dummy) dummy))))) - -;;; Interface functions. - -(defun gnus-possibly-generate-tree (article &optional force) - "Generate the thread tree for ARTICLE if it isn't displayed already." - (when (save-excursion - (set-buffer gnus-summary-buffer) - (and gnus-use-trees - gnus-show-threads - (vectorp (gnus-summary-article-header article)))) - (save-excursion - (let ((top (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-cut-thread - (gnus-remove-thread - (mail-header-id - (gnus-summary-article-header article)) - t)))) - (gnus-tmp-limit gnus-newsgroup-limit) - (gnus-tmp-sparse gnus-newsgroup-sparse)) - (when (or force - (not (eq top gnus-tree-displayed-thread))) - (gnus-generate-tree top) - (setq gnus-tree-displayed-thread top)))))) - -(defun gnus-tree-open (group) - (gnus-get-tree-buffer)) - -(defun gnus-tree-close (group) - (gnus-kill-buffer gnus-tree-buffer)) - -(defun gnus-highlight-selected-tree (article) - "Highlight the selected article in the tree." - (let ((buf (current-buffer)) - region) - (set-buffer gnus-tree-buffer) - (when (setq region (gnus-tree-article-region article)) - (when (or (not gnus-selected-tree-overlay) - (gnus-extent-detached-p gnus-selected-tree-overlay)) - ;; Create a new overlay. - (gnus-overlay-put - (setq gnus-selected-tree-overlay (gnus-make-overlay 1 2)) - 'face gnus-selected-tree-face)) - ;; Move the overlay to the article. - (gnus-move-overlay - gnus-selected-tree-overlay (goto-char (car region)) (cdr region)) - (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)) - (gnus-horizontal-recenter) - (select-window selected)))) - ;; If we remove this save-excursion, it updates the wrong mode lines?!? - (save-excursion - (set-buffer gnus-tree-buffer) - (gnus-set-mode-line 'tree)) - (set-buffer buf))) - -(defun gnus-tree-highlight-article (article face) - (save-excursion - (set-buffer (gnus-get-tree-buffer)) - (let (region) - (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-carpal -;;; - -(defvar gnus-carpal-group-buffer-buttons - '(("next" . gnus-group-next-unread-group) - ("prev" . gnus-group-prev-unread-group) - ("read" . gnus-group-read-group) - ("select" . gnus-group-select-group) - ("catch-up" . gnus-group-catchup-current) - ("new-news" . gnus-group-get-new-news-this-group) - ("toggle-sub" . gnus-group-unsubscribe-current-group) - ("subscribe" . gnus-group-unsubscribe-group) - ("kill" . gnus-group-kill-group) - ("yank" . gnus-group-yank-group) - ("describe" . gnus-group-describe-group) - "list" - ("subscribed" . gnus-group-list-groups) - ("all" . gnus-group-list-all-groups) - ("killed" . gnus-group-list-killed) - ("zombies" . gnus-group-list-zombies) - ("matching" . gnus-group-list-matching) - ("post" . gnus-group-post-news) - ("mail" . gnus-group-mail) - ("rescan" . gnus-group-get-new-news) - ("browse-foreign" . gnus-group-browse-foreign) - ("exit" . gnus-group-exit))) - -(defvar gnus-carpal-summary-buffer-buttons - '("mark" - ("read" . gnus-summary-mark-as-read-forward) - ("tick" . gnus-summary-tick-article-forward) - ("clear" . gnus-summary-clear-mark-forward) - ("expirable" . gnus-summary-mark-as-expirable) - "move" - ("scroll" . gnus-summary-next-page) - ("next-unread" . gnus-summary-next-unread-article) - ("prev-unread" . gnus-summary-prev-unread-article) - ("first" . gnus-summary-first-unread-article) - ("best" . gnus-summary-best-unread-article) - "article" - ("headers" . gnus-summary-toggle-header) - ("uudecode" . gnus-uu-decode-uu) - ("enter-digest" . gnus-summary-enter-digest-group) - ("fetch-parent" . gnus-summary-refer-parent-article) - "mail" - ("move" . gnus-summary-move-article) - ("copy" . gnus-summary-copy-article) - ("respool" . gnus-summary-respool-article) - "threads" - ("lower" . gnus-summary-lower-thread) - ("kill" . gnus-summary-kill-thread) - "post" - ("post" . gnus-summary-post-news) - ("mail" . gnus-summary-mail) - ("followup" . gnus-summary-followup-with-original) - ("reply" . gnus-summary-reply-with-original) - ("cancel" . gnus-summary-cancel-article) - "misc" - ("exit" . gnus-summary-exit) - ("fed-up" . gnus-summary-catchup-and-goto-next-group))) - -(defvar gnus-carpal-server-buffer-buttons - '(("add" . gnus-server-add-server) - ("browse" . gnus-server-browse-server) - ("list" . gnus-server-list-servers) - ("kill" . gnus-server-kill-server) - ("yank" . gnus-server-yank-server) - ("copy" . gnus-server-copy-server) - ("exit" . gnus-server-exit))) - -(defvar gnus-carpal-browse-buffer-buttons - '(("subscribe" . gnus-browse-unsubscribe-current-group) - ("exit" . gnus-browse-exit))) - -(defvar gnus-carpal-group-buffer "*Carpal Group*") -(defvar gnus-carpal-summary-buffer "*Carpal Summary*") -(defvar gnus-carpal-server-buffer "*Carpal Server*") -(defvar gnus-carpal-browse-buffer "*Carpal Browse*") - -(defvar gnus-carpal-attached-buffer nil) - -(defvar gnus-carpal-mode-hook nil - "*Hook run in carpal mode buffers.") - -(defvar gnus-carpal-button-face 'bold - "*Face used on carpal buttons.") - -(defvar gnus-carpal-header-face 'bold-italic - "*Face used on carpal buffer headers.") - -(defvar gnus-carpal-mode-map nil) -(put 'gnus-carpal-mode 'mode-class 'special) - -(if gnus-carpal-mode-map - nil - (setq gnus-carpal-mode-map (make-keymap)) - (suppress-keymap gnus-carpal-mode-map) - (define-key gnus-carpal-mode-map " " 'gnus-carpal-select) - (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select) - (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select)) - -(defun gnus-carpal-mode () - "Major mode for clicking buttons. - -All normal editing commands are switched off. -\\ -The following commands are available: - -\\{gnus-carpal-mode-map}" - (interactive) - (kill-all-local-variables) - (setq mode-line-modified (cdr gnus-mode-line-modified)) - (setq major-mode 'gnus-carpal-mode) - (setq mode-name "Gnus Carpal") - (setq mode-line-process nil) - (use-local-map gnus-carpal-mode-map) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) - (make-local-variable 'gnus-carpal-attached-buffer) - (gnus-run-hooks 'gnus-carpal-mode-hook)) - -(defun gnus-carpal-setup-buffer (type) - (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type))))) - (if (get-buffer buffer) - () - (save-excursion - (set-buffer (get-buffer-create buffer)) - (gnus-carpal-mode) - (setq gnus-carpal-attached-buffer - (intern (format "gnus-%s-buffer" type))) - (gnus-add-current-to-buffer-list) - (let ((buttons (symbol-value - (intern (format "gnus-carpal-%s-buffer-buttons" - type)))) - (buffer-read-only nil) - button) - (while buttons - (setq button (car buttons) - buttons (cdr buttons)) - (if (stringp button) - (gnus-set-text-properties - (point) - (prog2 (insert button) (point) (insert " ")) - (list 'face gnus-carpal-header-face)) - (gnus-set-text-properties - (point) - (prog2 (insert (car button)) (point) (insert " ")) - (list 'gnus-callback (cdr button) - 'face gnus-carpal-button-face - gnus-mouse-face-prop 'highlight)))) - (let ((fill-column (- (window-width) 2))) - (fill-region (point-min) (point-max))) - (set-window-point (get-buffer-window (current-buffer)) - (point-min))))))) - -(defun gnus-carpal-select () - "Select the button under point." - (interactive) - (let ((func (get-text-property (point) 'gnus-callback))) - (if (null func) - () - (pop-to-buffer (symbol-value gnus-carpal-attached-buffer)) - (call-interactively func)))) - -(defun gnus-carpal-mouse-select (event) - "Select the button under the mouse pointer." - (interactive "e") - (mouse-set-point event) - (gnus-carpal-select)) - -;;; Allow redefinition of functions. -(gnus-ems-redefine) - -(provide 'gnus-salt) - -;;; gnus-salt.el ends here diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el deleted file mode 100644 index bab7f9e..0000000 --- a/lisp/gnus-score.el +++ /dev/null @@ -1,2875 +0,0 @@ -;;; gnus-score.el --- scoring code for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-sum) -(require 'gnus-range) -(require 'message) - -(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 -for each score file or each score file directory. Gnus will decide -by itself what score files are applicable to which group. - -Say you want to use the single score file -\"/ftp.gnus.org@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all -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\"))" - :group 'gnus-score-files - :type '(repeat file)) - -(defcustom gnus-score-file-single-match-alist nil - "*Alist mapping regexps to lists of score files. -Each element of this alist should be of the form - (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... ) - -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). - -These score files are loaded in addition to any files returned by -gnus-score-find-score-files-function (which see)." - :group 'gnus-score-files - :type '(repeat (cons regexp (repeat file)))) - -(defcustom gnus-score-file-multiple-match-alist nil - "*Alist mapping regexps to lists of score files. -Each element of this alist should be of the form - (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... ) - -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). - -These score files are loaded in addition to any files returned by -gnus-score-find-score-files-function (which see)." - :group 'gnus-score-files - :type '(repeat (cons regexp (repeat file)))) - -(defcustom gnus-score-file-suffix "SCORE" - "*Suffix of the score files." - :group 'gnus-score-files - :type 'string) - -(defcustom gnus-adaptive-file-suffix "ADAPT" - "*Suffix of the adaptive score files." - :group 'gnus-score-files - :group 'gnus-score-adapt - :type 'string) - -(defcustom gnus-score-find-score-files-function 'gnus-score-find-bnews - "*Function used to find score files. -The function will be called with the group name as the argument, and -should return a list of score files to apply to that group. The score -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. - -See the documentation to these functions for more information. - -This variable can also be a list of functions to be called. Each -function should either return a list of score files, or a list of -score alists." - :group 'gnus-score-files - :type '(radio (function-item gnus-score-find-single) - (function-item gnus-score-find-hierarchical) - (function-item gnus-score-find-bnews) - (function :tag "Other"))) - -(defcustom gnus-score-interactive-default-score 1000 - "*Scoring commands will raise/lower the score with this number as the default." - :group 'gnus-score-default - :type 'integer) - -(defcustom gnus-score-expiry-days 7 - "*Number of days before unused score file entries are expired. -If this variable is nil, no score file entries will be expired." - :group 'gnus-score-expire - :type '(choice (const :tag "never" nil) - number)) - -(defcustom gnus-update-score-entry-dates t - "*In non-nil, update matching score entry dates. -If this variable is nil, then score entries that provide matches -will be expired along with non-matching score entries." - :group 'gnus-score-expire - :type 'boolean) - -(defcustom gnus-orphan-score nil - "*All orphans get this score added. Set in the score file." - :group 'gnus-score-default - :type '(choice (const nil) - integer)) - -(defcustom gnus-decay-scores nil - "*If non-nil, decay non-permanent scores." - :group 'gnus-score-decay - :type 'boolean) - -(defcustom gnus-decay-score-function 'gnus-decay-score - "*Function called to decay a score. -It is called with one parameter -- the score to be decayed." - :group 'gnus-score-decay - :type '(radio (function-item gnus-decay-score) - (function :tag "Other"))) - -(defcustom gnus-score-decay-constant 3 - "*Decay all \"small\" scores with this amount." - :group 'gnus-score-decay - :type 'integer) - -(defcustom gnus-score-decay-scale .05 - "*Decay all \"big\" scores with this factor." - :group 'gnus-score-decay - :type 'number) - -(defcustom gnus-home-score-file nil - "*Variable to control where interactive score entries are to go. -It can be: - - * A string - This file file will be used as the home score file. - - * A function - The result of this function will be used as the home score file. - The function will be passed the name of the group as its - parameter. - - * A list - The elements in this list can be: - - * `(regexp file-name ...)' - If the `regexp' matches the group name, the first `file-name' will - will be used as the home score file. (Multiple filenames are - allowed so that one may use gnus-score-file-single-match-alist to - set this variable.) - - * A function. - If the function returns non-nil, the result will be used - as the home score file. The function will be passed the - name of the group as its parameter. - - * A string. Use the string as the home score file. - - The list will be traversed from the beginning towards the end looking - for matches." - :group 'gnus-score-files - :type '(choice string - (repeat (choice string - (cons regexp (repeat file)) - (function :value fun))) - (function :value fun))) - -(defcustom gnus-home-adapt-file nil - "*Variable to control where new adaptive score entries are to go. -This variable allows the same syntax as `gnus-home-score-file'." - :group 'gnus-score-adapt - :group 'gnus-score-files - :type '(choice string - (repeat (choice string - (cons regexp (repeat file)) - (function :value fun))) - (function :value fun))) - -(defcustom gnus-default-adaptive-score-alist - '((gnus-kill-file-mark) - (gnus-unread-mark) - (gnus-read-mark (from 3) (subject 30)) - (gnus-catchup-mark (subject -10)) - (gnus-killed-mark (from -1) (subject -20)) - (gnus-del-mark (from -2) (subject -15))) -"*Alist of marks and scores." -:group 'gnus-score-adapt -:type '(repeat (cons (symbol :tag "Mark") - (repeat (list (choice :tag "Header" - (const from) - (const subject) - (symbol :tag "other")) - (integer :tag "Score")))))) - -(defcustom gnus-ignored-adaptive-words nil - "*List of words to be ignored when doing adaptive word scoring." - :group 'gnus-score-adapt - :type '(repeat string)) - -(defcustom gnus-default-ignored-adaptive-words - '("a" "i" "the" "to" "of" "and" "in" "is" "it" "for" "that" "if" "you" - "this" "be" "on" "with" "not" "have" "are" "or" "as" "from" "can" - "but" "by" "at" "an" "will" "no" "all" "was" "do" "there" "my" "one" - "so" "we" "they" "what" "would" "any" "which" "about" "get" "your" - "use" "some" "me" "then" "name" "like" "out" "when" "up" "time" - "other" "more" "only" "just" "end" "also" "know" "how" "new" "should" - "been" "than" "them" "he" "who" "make" "may" "people" "these" "now" - "their" "here" "into" "first" "could" "way" "had" "see" "work" "well" - "were" "two" "very" "where" "while" "us" "because" "good" "same" - "even" "much" "most" "many" "such" "long" "his" "over" "last" "since" - "right" "before" "our" "without" "too" "those" "why" "must" "part" - "being" "current" "back" "still" "go" "point" "value" "each" "did" - "both" "true" "off" "say" "another" "state" "might" "under" "start" - "try" "re") - "*Default list of words to be ignored when doing adaptive word scoring." - :group 'gnus-score-adapt - :type '(repeat string)) - -(defcustom gnus-default-adaptive-word-score-alist - `((,gnus-read-mark . 30) - (,gnus-catchup-mark . -10) - (,gnus-killed-mark . -20) - (,gnus-del-mark . -15)) -"*Alist of marks and scores." -:group 'gnus-score-adapt -:type '(repeat (cons (character :tag "Mark") - (integer :tag "Score")))) - -(defcustom gnus-adaptive-word-minimum nil - "*If a number, this is the minimum score value that can be assigned to a word." - :group 'gnus-score-adapt - :type '(choice (const nil) integer)) - -(defcustom gnus-score-mimic-keymap nil - "*Have the score entry functions pretend that they are a keymap." - :group 'gnus-score-default - :type 'boolean) - -(defcustom gnus-score-exact-adapt-limit 10 - "*Number that says how long a match has to be before using substring matching. -When doing adaptive scoring, one normally uses fuzzy or substring -matching. However, if the header one matches is short, the possibility -for false positives is great, so if the length of the match is less -than this variable, exact matching will be used. - -If this variable is nil, exact matching will always be used." - :group 'gnus-score-adapt - :type '(choice (const nil) integer)) - -(defcustom gnus-score-uncacheable-files "ADAPT$" - "*All score files that match this regexp will not be cached." - :group 'gnus-score-adapt - :group 'gnus-score-files - :type 'regexp) - -(defcustom gnus-score-default-header nil - "*Default header when entering new scores. - -Should be one of the following symbols. - - a: from - s: subject - b: body - h: head - i: message-id - t: references - x: xref - l: lines - d: date - f: followup - -If nil, the user will be asked for a header." - :group 'gnus-score-default - :type '(choice (const :tag "from" a) - (const :tag "subject" s) - (const :tag "body" b) - (const :tag "head" h) - (const :tag "message-id" i) - (const :tag "references" t) - (const :tag "xref" x) - (const :tag "lines" l) - (const :tag "date" d) - (const :tag "followup" f) - (const :tag "ask" nil))) - -(defcustom gnus-score-default-type nil - "*Default match type when entering new scores. - -Should be one of the following symbols. - - s: substring - e: exact string - f: fuzzy string - r: regexp string - b: before date - a: at date - n: this date - <: less than number - >: greater than number - =: equal to number - -If nil, the user will be asked for a match type." - :group 'gnus-score-default - :type '(choice (const :tag "substring" s) - (const :tag "exact string" e) - (const :tag "fuzzy string" f) - (const :tag "regexp string" r) - (const :tag "before date" b) - (const :tag "at date" a) - (const :tag "this date" n) - (const :tag "less than number" <) - (const :tag "greater than number" >) - (const :tag "equal than number" =) - (const :tag "ask" nil))) - -(defcustom gnus-score-default-fold nil - "*Use case folding for new score file entries iff not nil." - :group 'gnus-score-default - :type 'boolean) - -(defcustom gnus-score-default-duration nil - "*Default duration of effect when entering new scores. - -Should be one of the following symbols. - - t: temporary - p: permanent - i: immediate - -If nil, the user will be asked for a duration." - :group 'gnus-score-default - :type '(choice (const :tag "temporary" t) - (const :tag "permanent" p) - (const :tag "immediate" i) - (const :tag "ask" nil))) - -(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) - -(defcustom gnus-score-thread-simplify nil - "*If non-nil, subjects will simplified as in threading." - :group 'gnus-score-various - :type 'boolean) - - - -;; Internal variables. - -(defvar gnus-adaptive-word-syntax-table - (let ((table (copy-syntax-table (standard-syntax-table))) - (numbers '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))) - (while numbers - (modify-syntax-entry (pop numbers) " " table)) - (modify-syntax-entry ?' "w" table) - table) - "Syntax table used when doing adaptive word scoring.") - -(defvar gnus-scores-exclude-files nil) -(defvar gnus-internal-global-score-files nil) -(defvar gnus-score-file-list nil) - -(defvar gnus-short-name-score-file-cache nil) - -(defvar gnus-score-help-winconf nil) -(defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist) -(defvar gnus-adaptive-word-score-alist gnus-default-adaptive-word-score-alist) -(defvar gnus-score-trace nil) -(defvar gnus-score-edit-buffer nil) - -(defvar gnus-score-alist nil - "Alist containing score information. -The keys can be symbols or strings. The following symbols are defined. - -touched: If this alist has been modified. -mark: Automatically mark articles below this. -expunge: Automatically expunge articles below this. -files: List of other score files to load when loading this one. -eval: Sexp to be evaluated when the score file is loaded. - -String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...) -where HEADER is the header being scored, MATCH is the string we are -looking for, TYPE is a flag indicating whether it should use regexp or -substring matching, SCORE is the score to add and DATE is the date -of the last successful match.") - -(defvar gnus-score-cache nil) -(defvar gnus-scores-articles nil) -(defvar gnus-score-index nil) - - -(defconst gnus-header-index - ;; Name to index alist. - '(("number" 0 gnus-score-integer) - ("subject" 1 gnus-score-string) - ("from" 2 gnus-score-string) - ("date" 3 gnus-score-date) - ("message-id" 4 gnus-score-string) - ("references" 5 gnus-score-string) - ("chars" 6 gnus-score-integer) - ("lines" 7 gnus-score-integer) - ("xref" 8 gnus-score-string) - ("head" -1 gnus-score-body) - ("body" -1 gnus-score-body) - ("all" -1 gnus-score-body) - ("followup" 2 gnus-score-followup) - ("thread" 5 gnus-score-thread))) - -;;; Summary mode score maps. - -(gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map) - "s" gnus-summary-set-score - "a" gnus-summary-score-entry - "S" gnus-summary-current-score - "c" gnus-score-change-score-file - "C" gnus-score-customize - "m" gnus-score-set-mark-below - "x" gnus-score-set-expunge-below - "R" gnus-summary-rescore - "e" gnus-score-edit-current-scores - "f" gnus-score-edit-file - "F" gnus-score-flush-cache - "t" gnus-score-find-trace - "w" gnus-score-find-favourite-words) - -;; Summary score file commands - -;; Much modification of the kill (ahem, score) code and lots of the -;; functions are written by Per Abrahamsen . - -(defun gnus-summary-lower-score (&optional score symp) - "Make a score entry based on the current article. -The user will be prompted for header to score on, match type, -permanence, and the string to be used. The numerical prefix will be -used as score." - (interactive (gnus-interactive "P\ny")) - (gnus-summary-increase-score (- (gnus-score-default score)) symp)) - -(defun gnus-score-kill-help-buffer () - (when (get-buffer "*Score Help*") - (kill-buffer "*Score Help*") - (when gnus-score-help-winconf - (set-window-configuration gnus-score-help-winconf)))) - -(defun gnus-summary-increase-score (&optional score symp) - "Make a score entry based on the current article. -The user will be prompted for header to score on, match type, -permanence, and the string to be used. The numerical prefix will be -used as score." - (interactive (gnus-interactive "P\ny")) - (let* ((nscore (gnus-score-default score)) - (prefix (if (< nscore 0) ?L ?I)) - (increase (> nscore 0)) - (char-to-header - '((?a "from" nil nil string) - (?s "subject" nil nil string) - (?b "body" "" nil body-string) - (?h "head" "" nil body-string) - (?i "message-id" nil t string) - (?t "references" "message-id" nil string) - (?x "xref" nil nil string) - (?l "lines" nil nil number) - (?d "date" nil nil date) - (?f "followup" nil nil string) - (?T "thread" nil nil string))) - (char-to-type - '((?s s "substring" string) - (?e e "exact string" string) - (?f f "fuzzy string" string) - (?r r "regexp string" string) - (?z s "substring" body-string) - (?p r "regexp string" body-string) - (?b before "before date" date) - (?a at "at date" date) - (?n now "this date" date) - (?< < "less than number" number) - (?> > "greater than number" number) - (?= = "equal to number" number))) - (current-score-file gnus-current-score-file) - (char-to-perm - (list (list ?t (current-time-string) "temporary") - '(?p perm "permanent") '(?i now "immediate"))) - (mimic gnus-score-mimic-keymap) - (hchar (and gnus-score-default-header - (aref (symbol-name gnus-score-default-header) 0))) - (tchar (and gnus-score-default-type - (aref (symbol-name gnus-score-default-type) 0))) - (pchar (and gnus-score-default-duration - (aref (symbol-name gnus-score-default-duration) 0))) - entry temporary type match) - - (unwind-protect - (progn - - ;; First we read the header to score. - (while (not hchar) - (if mimic - (progn - (sit-for 1) - (message "%c-" prefix)) - (message "%s header (%s?): " (if increase "Increase" "Lower") - (mapconcat (lambda (s) (char-to-string (car s))) - char-to-header ""))) - (setq hchar (read-char)) - (when (or (= hchar ??) (= hchar ?\C-h)) - (setq hchar nil) - (gnus-score-insert-help "Match on header" char-to-header 1))) - - (gnus-score-kill-help-buffer) - (unless (setq entry (assq (downcase hchar) char-to-header)) - (if mimic (error "%c %c" prefix hchar) - (error "Illegal header type"))) - - (when (/= (downcase hchar) hchar) - ;; This was a majuscule, so we end reading and set the defaults. - (if mimic (message "%c %c" prefix hchar) (message "")) - (setq tchar (or tchar ?s) - pchar (or pchar ?t))) - - (let ((legal-types - (delq nil - (mapcar (lambda (s) - (if (eq (nth 4 entry) - (nth 3 s)) - s nil)) - char-to-type)))) - ;; We continue reading - the type. - (while (not tchar) - (if mimic - (progn - (sit-for 1) (message "%c %c-" prefix hchar)) - (message "%s header '%s' with match type (%s?): " - (if increase "Increase" "Lower") - (nth 1 entry) - (mapconcat (lambda (s) (char-to-string (car s))) - legal-types ""))) - (setq tchar (read-char)) - (when (or (= tchar ??) (= tchar ?\C-h)) - (setq tchar nil) - (gnus-score-insert-help "Match type" legal-types 2))) - - (gnus-score-kill-help-buffer) - (unless (setq type (nth 1 (assq (downcase tchar) legal-types))) - (if mimic (error "%c %c" prefix hchar) - (error "Illegal match type")))) - - (when (/= (downcase tchar) tchar) - ;; It was a majuscule, so we end reading and use the default. - (if mimic (message "%c %c %c" prefix hchar tchar) - (message "")) - (setq pchar (or pchar ?p))) - - ;; We continue reading. - (while (not pchar) - (if mimic - (progn - (sit-for 1) (message "%c %c %c-" prefix hchar tchar)) - (message "%s permanence (%s?): " (if increase "Increase" "Lower") - (mapconcat (lambda (s) (char-to-string (car s))) - char-to-perm ""))) - (setq pchar (read-char)) - (when (or (= pchar ??) (= pchar ?\C-h)) - (setq pchar nil) - (gnus-score-insert-help "Match permanence" char-to-perm 2))) - - (gnus-score-kill-help-buffer) - (if mimic (message "%c %c %c" prefix hchar tchar pchar) - (message "")) - (unless (setq temporary (cadr (assq pchar char-to-perm))) - ;; Deal with der(r)ided superannuated paradigms. - (when (and (eq (1+ prefix) 77) - (eq (+ hchar 12) 109) - (eq tchar 114) - (eq (- pchar 4) 111)) - (error "You rang?")) - (if mimic - (error "%c %c %c %c" prefix hchar tchar pchar) - (error "Illegal match duration")))) - ;; Always kill the score help buffer. - (gnus-score-kill-help-buffer)) - - ;; We have all the data, so we enter this score. - (setq match (if (string= (nth 2 entry) "") "" - (gnus-summary-header (or (nth 2 entry) (nth 1 entry))))) - - ;; Modify the match, perhaps. - (cond - ((equal (nth 1 entry) "xref") - (when (string-match "^Xref: *" match) - (setq match (substring match (match-end 0)))) - (when (string-match "^[^:]* +" match) - (setq match (substring match (match-end 0)))))) - - (when (memq type '(r R regexp Regexp)) - (setq match (regexp-quote match))) - - ;; Change score file to the "all.SCORE" file. - (when (eq symp 'a) - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file - ;; This is a kludge; yes... - (cond - ((eq gnus-score-find-score-files-function - 'gnus-score-find-hierarchical) - (gnus-score-file-name "")) - ((eq gnus-score-find-score-files-function 'gnus-score-find-single) - current-score-file) - (t - (gnus-score-file-name "all")))))) - - (gnus-summary-score-entry - (nth 1 entry) ; Header - match ; Match - type ; Type - (if (eq score 's) nil score) ; Score - (if (eq temporary 'perm) ; Temp - nil - temporary) - (not (nth 3 entry))) ; Prompt - - (when (eq symp 'a) - ;; We change the score file back to the previous one. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file current-score-file))))) - -(defun gnus-score-insert-help (string alist idx) - (setq gnus-score-help-winconf (current-window-configuration)) - (save-excursion - (set-buffer (get-buffer-create "*Score Help*")) - (buffer-disable-undo (current-buffer)) - (delete-windows-on (current-buffer)) - (erase-buffer) - (insert string ":\n\n") - (let ((max -1) - (list alist) - (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)))) - ;; display ourselves in a small window at the bottom - (gnus-appt-select-lowest-window) - (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)))) - -(defun gnus-summary-header (header &optional no-err) - ;; Return HEADER for current articles, or error. - (let ((article (gnus-summary-article-number)) - headers) - (if article - (if (and (setq headers (gnus-summary-article-header article)) - (vectorp headers)) - (aref headers (nth 1 (assoc header gnus-header-index))) - (if no-err - nil - (error "Pseudo-articles can't be scored"))) - (if no-err - (error "No article on current line") - nil)))) - -(defun gnus-newsgroup-score-alist () - (or - (let ((param-file (gnus-group-find-parameter - gnus-newsgroup-name 'score-file))) - (when param-file - (gnus-score-load param-file))) - (gnus-score-load - (gnus-score-file-name gnus-newsgroup-name))) - gnus-score-alist) - -(defsubst gnus-score-get (symbol &optional alist) - ;; Get SYMBOL's definition in ALIST. - (cdr (assoc symbol - (or alist - gnus-score-alist - (gnus-newsgroup-score-alist))))) - -(defun gnus-summary-score-entry (header match type score date - &optional prompt silent) - "Enter score file entry. -HEADER is the header being scored. -MATCH is the string we are looking for. -TYPE is the match type: substring, regexp, exact, fuzzy. -SCORE is the score to add. -DATE is the expire date, or nil for no expire, or 'now for immediate expire. -If optional argument `PROMPT' is non-nil, allow user to edit match. -If optional argument `SILENT' is nil, show effect of score entry." - (interactive - (list (completing-read "Header: " - gnus-header-index - (lambda (x) (fboundp (nth 2 x))) - t) - (read-string "Match: ") - (if (y-or-n-p "Use regexp match? ") 'r 's) - (and current-prefix-arg - (prefix-numeric-value current-prefix-arg)) - (cond ((not (y-or-n-p "Add to score file? ")) - 'now) - ((y-or-n-p "Expire kill? ") - (current-time-string)) - (t nil)))) - ;; Regexp is the default type. - (when (eq type t) - (setq type 'r)) - ;; Simplify matches... - (cond ((or (eq type 'r) (eq type 's) (eq type nil)) - (setq match (if match (gnus-simplify-subject-re match) ""))) - ((eq type 'f) - (setq match (gnus-simplify-subject-fuzzy match)))) - (let ((score (gnus-score-default score)) - (header (format "%s" (downcase header))) - new) - (when prompt - (setq match (read-string - (format "Match %s on %s, %s: " - (cond ((eq date 'now) - "now") - ((stringp date) - "temp") - (t "permanent")) - header - (if (< score 0) "lower" "raise")) - (if (numberp match) - (int-to-string match) - match)))) - - ;; Get rid of string props. - (setq match (format "%s" 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))) - - (unless (eq date 'now) - ;; Add the score entry to the score file. - (when (= score gnus-score-interactive-default-score) - (setq score nil)) - (let ((old (gnus-score-get header)) - elem) - (setq new - (cond - (type - (list match score - (and date (if (numberp date) date - (gnus-day-number date))) - type)) - (date (list match score (gnus-day-number date))) - (score (list match score)) - (t (list match)))) - ;; We see whether we can collapse some score entries. - ;; This isn't quite correct, because there may be more elements - ;; later on with the same key that have matching elems... Hm. - (if (and old - (setq elem (assoc match old)) - (eq (nth 3 elem) (nth 3 new)) - (or (and (numberp (nth 2 elem)) (numberp (nth 2 new))) - (and (not (nth 2 elem)) (not (nth 2 new))))) - ;; Yup, we just add this new score to the old elem. - (setcar (cdr elem) (+ (or (nth 1 elem) - gnus-score-interactive-default-score) - (or (nth 1 new) - gnus-score-interactive-default-score))) - ;; Nope, we have to add a new elem. - (gnus-score-set header (if old (cons new old) (list new)))) - (gnus-score-set 'touched '(t)))) - - ;; Score the current buffer. - (unless silent - (if (and (>= (nth 1 (assoc header gnus-header-index)) 0) - (eq (nth 2 (assoc header gnus-header-index)) - 'gnus-score-string)) - (gnus-summary-score-effect header match type score) - (gnus-summary-rescore))) - - ;; Return the new scoring rule. - new)) - -(defun gnus-summary-score-effect (header match type score) - "Simulate the effect of a score file entry. -HEADER is the header being scored. -MATCH is the string we are looking for. -TYPE is the score type. -SCORE is the score to add." - (interactive (list (completing-read "Header: " - gnus-header-index - (lambda (x) (fboundp (nth 2 x))) - t) - (read-string "Match: ") - (y-or-n-p "Use regexp match? ") - (prefix-numeric-value current-prefix-arg))) - (save-excursion - (unless (and (stringp match) (> (length match) 0)) - (error "No match")) - (goto-char (point-min)) - (let ((regexp (cond ((eq type 'f) - (gnus-simplify-subject-fuzzy match)) - ((eq type 'r) - match) - ((eq type 'e) - (concat "\\`" (regexp-quote match) "\\'")) - (t - (regexp-quote match))))) - (while (not (eobp)) - (let ((content (gnus-summary-header header 'noerr)) - (case-fold-search t)) - (and content - (when (if (eq type 'f) - (string-equal (gnus-simplify-subject-fuzzy content) - regexp) - (string-match regexp content)) - (gnus-summary-raise-score score)))) - (beginning-of-line 2)))) - (gnus-set-mode-line 'summary)) - -(defun gnus-summary-score-crossposting (score date) - ;; Enter score file entry for current crossposting. - ;; SCORE is the score to add. - ;; DATE is the expire date. - (let ((xref (gnus-summary-header "xref")) - (start 0) - group) - (unless xref - (error "This article is not crossposted")) - (while (string-match " \\([^ \t]+\\):" xref start) - (setq start (match-end 0)) - (when (not (string= - (setq group - (substring xref (match-beginning 1) (match-end 1))) - gnus-newsgroup-name)) - (gnus-summary-score-entry - "xref" (concat " " group ":") nil score date t))))) - - -;;; -;;; Gnus Score Files -;;; - -;; 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 - (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-int (read-string "Mark below: "))))) - (setq score (or score gnus-summary-default-score 0)) - (gnus-score-set 'mark (list score)) - (gnus-score-set 'touched '(t)) - (setq gnus-summary-mark-below score) - (gnus-score-update-lines)) - -(defun gnus-score-update-lines () - "Update all lines in the summary buffer." - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (gnus-summary-update-line) - (forward-line 1)))) - -(defun gnus-score-update-all-lines () - "Update all lines in the summary buffer, even the hidden ones." - (save-excursion - (goto-char (point-min)) - (let (hidden) - (while (not (eobp)) - (when (gnus-summary-show-thread) - (push (point) hidden)) - (gnus-summary-update-line) - (forward-line 1)) - ;; Re-hide the hidden threads. - (while hidden - (goto-char (pop hidden)) - (gnus-summary-hide-thread))))) - -(defun gnus-score-set-expunge-below (score) - "Automatically expunge articles with score below SCORE." - (interactive - (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-int (read-string "Set expunge below: "))))) - (setq score (or score gnus-summary-default-score 0)) - (gnus-score-set 'expunge (list score)) - (gnus-score-set 'touched '(t))) - -(defun gnus-score-followup-article (&optional score) - "Add SCORE to all followups to the article in the current buffer." - (interactive "P") - (setq score (gnus-score-default score)) - (when (gnus-buffer-live-p gnus-summary-buffer) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (let ((id (mail-fetch-field "message-id"))) - (when id - (set-buffer gnus-summary-buffer) - (gnus-summary-score-entry - "references" (concat id "[ \t]*$") 'r - score (current-time-string) nil t))))))) - -(defun gnus-score-followup-thread (&optional score) - "Add SCORE to all later articles in the thread the current buffer is part of." - (interactive "P") - (setq score (gnus-score-default score)) - (when (gnus-buffer-live-p gnus-summary-buffer) - (save-excursion - (save-restriction - (goto-char (point-min)) - (let ((id (mail-fetch-field "message-id"))) - (when id - (set-buffer gnus-summary-buffer) - (gnus-summary-score-entry - "references" id 's - score (current-time-string)))))))) - -(defun gnus-score-set (symbol value &optional alist) - ;; Set SYMBOL to VALUE in ALIST. - (let* ((alist - (or alist - gnus-score-alist - (gnus-newsgroup-score-alist))) - (entry (assoc symbol alist))) - (cond ((gnus-score-get 'read-only alist) - ;; This is a read-only score file, so we do nothing. - ) - (entry - (setcdr entry value)) - ((null alist) - (error "Empty alist")) - (t - (setcdr alist - (cons (cons symbol value) (cdr alist))))))) - -(defun gnus-summary-raise-score (n) - "Raise the score of the current article by N." - (interactive "p") - (gnus-summary-set-score (+ (gnus-summary-article-score) - (or n gnus-score-interactive-default-score )))) - -(defun gnus-summary-set-score (n) - "Set the score of the current article to N." - (interactive "p") - (save-excursion - (gnus-summary-show-thread) - (let ((buffer-read-only nil)) - ;; Set score. - (gnus-summary-update-mark - (if (= n (or gnus-summary-default-score 0)) ? - (if (< n (or gnus-summary-default-score 0)) - gnus-score-below-mark gnus-score-over-mark)) - 'score)) - (let* ((article (gnus-summary-article-number)) - (score (assq article gnus-newsgroup-scored))) - (if score (setcdr score n) - (push (cons article n) gnus-newsgroup-scored))) - (gnus-summary-update-line))) - -(defun gnus-summary-current-score () - "Return the score of the current article." - (interactive) - (gnus-message 1 "%s" (gnus-summary-article-score))) - -(defun gnus-score-change-score-file (file) - "Change current score alist." - (interactive - (list (read-file-name "Change to score file: " gnus-kill-files-directory))) - (gnus-score-load-file file) - (gnus-set-mode-line 'summary)) - -(defvar gnus-score-edit-exit-function) -(defun gnus-score-edit-current-scores (file) - "Edit the current score alist." - (interactive (list gnus-current-score-file)) - (if (not gnus-current-score-file) - (error "No current score file") - (let ((winconf (current-window-configuration))) - (when (buffer-name gnus-summary-buffer) - (gnus-score-save)) - (gnus-make-directory (file-name-directory file)) - (setq gnus-score-edit-buffer (find-file-noselect file)) - (gnus-configure-windows 'edit-score) - (gnus-score-mode) - (setq gnus-score-edit-exit-function 'gnus-score-edit-done) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf)) - (gnus-message - 4 (substitute-command-keys - "\\\\[gnus-score-edit-exit] to save edits")))) - -(defun gnus-score-edit-file (file) - "Edit a score file." - (interactive - (list (read-file-name "Edit score file: " gnus-kill-files-directory))) - (gnus-make-directory (file-name-directory file)) - (when (buffer-name gnus-summary-buffer) - (gnus-score-save)) - (let ((winconf (current-window-configuration))) - (setq gnus-score-edit-buffer (find-file-noselect file)) - (gnus-configure-windows 'edit-score) - (gnus-score-mode) - (setq gnus-score-edit-exit-function 'gnus-score-edit-done) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf)) - (gnus-message - 4 (substitute-command-keys - "\\\\[gnus-score-edit-exit] to save edits"))) - -(defun gnus-score-load-file (file) - ;; Load score file FILE. Returns a list a retrieved score-alists. - (let* ((file (expand-file-name - (or (and (string-match - (concat "^" (expand-file-name - gnus-kill-files-directory)) - (expand-file-name file)) - file) - (concat (file-name-as-directory gnus-kill-files-directory) - file)))) - (cached (assoc file gnus-score-cache)) - (global (member file gnus-internal-global-score-files)) - lists alist) - (if cached - ;; The score file was already loaded. - (setq alist (cdr cached)) - ;; We load the score file. - (setq gnus-score-alist nil) - (setq alist (gnus-score-load-score-alist file)) - ;; We add '(touched) to the alist to signify that it hasn't been - ;; touched (yet). - (unless (assq 'touched alist) - (push (list 'touched nil) alist)) - ;; If it is a global score file, we make it read-only. - (and global - (not (assq 'read-only alist)) - (push (list 'read-only t) alist)) - (push (cons file alist) gnus-score-cache)) - (let ((a alist) - found) - (while a - ;; Downcase all header names. - (when (stringp (caar a)) - (setcar (car a) (downcase (caar a))) - (setq found t)) - (pop a)) - ;; If there are actual scores in the alist, we add it to the - ;; return value of this function. - (when found - (setq lists (list alist)))) - ;; Treat the other possible atoms in the score alist. - (let ((mark (car (gnus-score-get 'mark alist))) - (expunge (car (gnus-score-get 'expunge alist))) - (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))) - (adapt (gnus-score-get 'adapt alist)) - (thread-mark-and-expunge - (car (gnus-score-get 'thread-mark-and-expunge alist))) - (adapt-file (car (gnus-score-get 'adapt-file alist))) - (local (gnus-score-get 'local alist)) - (decay (car (gnus-score-get 'decay alist))) - (eval (car (gnus-score-get 'eval alist)))) - ;; Perform possible decays. - (when (and gnus-decay-scores - (or cached (file-exists-p file)) - (or (not decay) - (gnus-decay-scores alist decay))) - (gnus-score-set 'touched '(t) alist) - (gnus-score-set 'decay (list (gnus-time-to-day (current-time))))) - ;; We do not respect eval and files atoms from global score - ;; files. - (when (and files (not global)) - (setq lists (apply 'append lists - (mapcar (lambda (file) - (gnus-score-load-file file)) - (if adapt-file (cons adapt-file files) - files))))) - (when (and eval (not global)) - (eval eval)) - ;; We then expand any exclude-file directives. - (setq gnus-scores-exclude-files - (nconc - (apply - 'nconc - (mapcar - (lambda (sfile) - (list - (expand-file-name sfile (file-name-directory file)) - (expand-file-name sfile gnus-kill-files-directory))) - exclude-files)) - gnus-scores-exclude-files)) - (unless local - (save-excursion - (set-buffer gnus-summary-buffer) - (while local - (and (consp (car local)) - (symbolp (caar local)) - (progn - (make-local-variable (caar local)) - (set (caar local) (nth 1 (car local))))) - (setq local (cdr local))))) - (when orphan - (setq gnus-orphan-score orphan)) - (setq gnus-adaptive-score-alist - (cond ((equal adapt '(t)) - (setq gnus-newsgroup-adaptive t) - gnus-default-adaptive-score-alist) - ((equal adapt '(ignore)) - (setq gnus-newsgroup-adaptive nil)) - ((consp adapt) - (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)) - (setq gnus-summary-mark-below - (or mark mark-and-expunge gnus-summary-mark-below)) - (setq gnus-summary-expunge-below - (or expunge mark-and-expunge gnus-summary-expunge-below)) - (setq gnus-newsgroup-adaptive-score-file - (or adapt-file gnus-newsgroup-adaptive-score-file))) - (setq gnus-current-score-file file) - (setq gnus-score-alist alist) - lists)) - -(defun gnus-score-load (file) - ;; Load score FILE. - (let ((cache (assoc file gnus-score-cache))) - (if cache - (setq gnus-score-alist (cdr cache)) - (setq gnus-score-alist nil) - (gnus-score-load-score-alist file) - (unless gnus-score-alist - (setq gnus-score-alist (copy-alist '((touched nil))))) - (push (cons file gnus-score-alist) gnus-score-cache)))) - -(defun gnus-score-remove-from-cache (file) - (setq gnus-score-cache - (delq (assoc file gnus-score-cache) gnus-score-cache))) - -(defun gnus-score-load-score-alist (file) - "Read score FILE." - (let (alist) - (if (not (file-readable-p file)) - ;; Couldn't read file. - (setq gnus-score-alist nil) - ;; Read file. - (save-excursion - (gnus-set-work-buffer) - (insert-file-contents file) - (goto-char (point-min)) - ;; Only do the loading if the score file isn't empty. - (when (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t)) - (setq alist - (condition-case () - (read (current-buffer)) - (error - (gnus-error 3.2 "Problem with score file %s" file)))))) - (if (eq (car alist) 'setq) - ;; This is an old-style score file. - (setq gnus-score-alist (gnus-score-transform-old-to-new alist)) - (setq gnus-score-alist alist)) - ;; Check the syntax of the score file. - (setq gnus-score-alist - (gnus-score-check-syntax gnus-score-alist file))))) - -(defun gnus-score-check-syntax (alist file) - "Check the syntax of the score ALIST." - (cond - ((null alist) - nil) - ((not (consp alist)) - (gnus-message 1 "Score file is not a list: %s" file) - (ding) - nil) - (t - (let ((a alist) - sr err s type) - (while (and a (not err)) - (setq - err - (cond - ((not (listp (car a))) - (format "Illegal score element %s in %s" (car a) file)) - ((stringp (caar a)) - (cond - ((not (listp (setq sr (cdar a)))) - (format "Illegal header match %s in %s" (nth 1 (car a)) file)) - (t - (setq type (caar a)) - (while (and sr (not err)) - (setq s (pop sr)) - (setq - err - (cond - ((if (member (downcase type) '("lines" "chars")) - (not (numberp (car s))) - (not (stringp (car s)))) - (format "Illegal match %s in %s" (car s) file)) - ((and (cadr s) (not (integerp (cadr s)))) - (format "Non-integer score %s in %s" (cadr s) file)) - ((and (caddr s) (not (integerp (caddr s)))) - (format "Non-integer date %s in %s" (caddr s) file)) - ((and (cadddr s) (not (symbolp (cadddr s)))) - (format "Non-symbol match type %s in %s" (cadddr s) file))))) - err))))) - (setq a (cdr a))) - (if err - (progn - (ding) - (gnus-message 3 err) - (sit-for 2) - nil) - alist))))) - -(defun gnus-score-transform-old-to-new (alist) - (let* ((alist (nth 2 alist)) - out entry) - (when (eq (car alist) 'quote) - (setq alist (nth 1 alist))) - (while alist - (setq entry (car alist)) - (if (stringp (car entry)) - (let ((scor (cdr entry))) - (push entry out) - (while scor - (setcar scor - (list (caar scor) (nth 2 (car scor)) - (and (nth 3 (car scor)) - (gnus-day-number (nth 3 (car scor)))) - (if (nth 1 (car scor)) 'r 's))) - (setq scor (cdr scor)))) - (push (if (not (listp (cdr entry))) - (list (car entry) (cdr entry)) - entry) - out)) - (setq alist (cdr alist))) - (cons (list 'touched t) (nreverse out)))) - -(defun gnus-score-save () - ;; Save all score information. - (let ((cache gnus-score-cache) - entry score file) - (save-excursion - (setq gnus-score-alist nil) - (nnheader-set-temp-buffer " *Gnus Scores*") - (while cache - (current-buffer) - (setq entry (pop cache) - file (car entry) - score (cdr entry)) - (if (or (not (equal (gnus-score-get 'touched score) '(t))) - (gnus-score-get 'read-only score) - (and (file-exists-p file) - (not (file-writable-p file)))) - () - (setq score (setcdr entry (delq (assq 'touched score) score))) - (erase-buffer) - (let (emacs-lisp-mode-hook) - (if (string-match - (concat (regexp-quote gnus-adaptive-file-suffix) "$") - file) - ;; This is an adaptive score file, so we do not run - ;; it through `pp'. These files can get huge, and - ;; are not meant to be edited by human hands. - (gnus-prin1 score) - ;; This is a normal score file, so we print it very - ;; prettily. - (pp score (current-buffer)))) - (gnus-make-directory (file-name-directory file)) - ;; If the score file is empty, we delete it. - (if (zerop (buffer-size)) - (delete-file file) - ;; There are scores, so we write the file. - (when (file-writable-p file) - (gnus-write-buffer file) - (when gnus-score-after-write-file-function - (funcall gnus-score-after-write-file-function file))))) - (and gnus-score-uncacheable-files - (string-match gnus-score-uncacheable-files file) - (gnus-score-remove-from-cache file))) - (kill-buffer (current-buffer))))) - -(defun gnus-score-load-files (score-files) - "Load all score files in SCORE-FILES." - ;; Load the score files. - (let (scores) - (while score-files - (if (stringp (car score-files)) - ;; It is a string, which means that it's a score file name, - ;; so we load the score file and add the score alist to - ;; the list of alists. - (setq scores (nconc (gnus-score-load-file (car score-files)) scores)) - ;; It is an alist, so we just add it to the list directly. - (setq scores (nconc (car score-files) scores))) - (setq score-files (cdr score-files))) - ;; Prune the score files that are to be excluded, if any. - (when gnus-scores-exclude-files - (let ((s scores) - c) - (while s - (and (setq c (rassq (car s) gnus-score-cache)) - (member (car c) gnus-scores-exclude-files) - (setq scores (delq (car s) scores))) - (setq s (cdr s))))) - scores)) - -(defun gnus-score-headers (score-files &optional trace) - ;; Score `gnus-newsgroup-headers'. - (let (scores news) - ;; PLM: probably this is not the best place to clear orphan-score - (setq gnus-orphan-score nil - gnus-scores-articles nil - gnus-scores-exclude-files nil - scores (gnus-score-load-files score-files)) - (setq news scores) - ;; Do the scoring. - (while news - (setq scores news - news nil) - (when (and gnus-summary-default-score - scores) - (let* ((entries gnus-header-index) - (now (gnus-day-number (current-time-string))) - (expire (and gnus-score-expiry-days - (- now gnus-score-expiry-days))) - (headers gnus-newsgroup-headers) - (current-score-file gnus-current-score-file) - entry header new) - (gnus-message 5 "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 - ;; be written as O(N+S), where N is (length gnus-newsgroup-headers) - ;; and S is (length gnus-newsgroup-scored). - (unless (assq (mail-header-number header) gnus-newsgroup-scored) - (setq gnus-scores-articles ;Total of 2 * N cons-cells used. - (cons (cons header (or gnus-summary-default-score 0)) - gnus-scores-articles)))) - - (save-excursion - (set-buffer (get-buffer-create "*Headers*")) - (buffer-disable-undo (current-buffer)) - (when (gnus-buffer-live-p gnus-summary-buffer) - (message-clone-locals gnus-summary-buffer)) - - ;; Set the global variant of this variable. - (setq gnus-current-score-file current-score-file) - ;; score orphans - (when gnus-orphan-score - (setq gnus-score-index - (nth 1 (assoc "references" gnus-header-index))) - (gnus-score-orphans gnus-orphan-score)) - ;; Run each header through the score process. - (while entries - (setq entry (pop entries) - header (nth 0 entry) - gnus-score-index (nth 1 (assoc header gnus-header-index))) - (when (< 0 (apply 'max (mapcar - (lambda (score) - (length (gnus-score-get header score))) - scores))) - ;; Call the scoring function for this type of "header". - (when (setq new (funcall (nth 2 entry) scores header - now expire trace)) - (push new news)))) - ;; Remove the buffer. - (kill-buffer (current-buffer))) - - ;; Add articles to `gnus-newsgroup-scored'. - (while gnus-scores-articles - (when (or (/= gnus-summary-default-score - (cdar gnus-scores-articles)) - gnus-save-score) - (push (cons (mail-header-number (caar gnus-scores-articles)) - (cdar gnus-scores-articles)) - gnus-newsgroup-scored)) - (setq gnus-scores-articles (cdr gnus-scores-articles))) - - (let (score) - (while (setq score (pop scores)) - (while score - (when (listp (caar score)) - (gnus-score-advanced (car score) trace)) - (pop score)))) - - (gnus-message 5 "Scoring...done")))))) - - -(defun gnus-get-new-thread-ids (articles) - (let ((index (nth 1 (assoc "message-id" gnus-header-index))) - (refind gnus-score-index) - id-list art this tref) - (while articles - (setq art (car articles) - this (aref (car art) index) - tref (aref (car art) refind) - articles (cdr articles)) - (when (string-equal tref "") ;no references line - (push this id-list))) - id-list)) - -;; Orphan functions written by plm@atcmp.nl (Peter Mutsaers). -(defun gnus-score-orphans (score) - (let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles)) - alike articles art arts this last this-id) - - (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) - articles gnus-scores-articles) - - ;;more or less the same as in gnus-score-string - (erase-buffer) - (while articles - (setq art (car articles) - this (aref (car art) gnus-score-index) - articles (cdr articles)) - ;;completely skip if this is empty (not a child, so not an orphan) - (when (not (string= this "")) - (if (equal last this) - ;; O(N*H) cons-cells used here, where H is the number of - ;; headers. - (push art alike) - (when last - ;; Insert the line, with a text property on the - ;; terminating newline referring to the articles with - ;; this line. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - (setq alike (list art) - last this)))) - (when last ; Bwadr, duplicate code. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - - ;; PLM: now delete those lines that contain an entry from new-thread-ids - (while new-thread-ids - (setq this-id (car new-thread-ids) - new-thread-ids (cdr new-thread-ids)) - (goto-char (point-min)) - (while (search-forward this-id nil t) - ;; found a match. remove this line - (beginning-of-line) - (kill-line 1))) - - ;; now for each line: update its articles with score by moving to - ;; every end-of-line in the buffer and read the articles property - (goto-char (point-min)) - (while (eq 0 (progn - (end-of-line) - (setq arts (get-text-property (point) 'articles)) - (while arts - (setq art (car arts) - arts (cdr arts)) - (setcdr art (+ score (cdr art)))) - (forward-line)))))) - - -(defun gnus-score-integer (scores header now expire &optional trace) - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - entries alist) - - ;; Find matches. - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) '>)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (match-func (if (or (eq type '>) (eq type '<) (eq type '<=) - (eq type '>=) (eq type '=)) - type - (error "Illegal match type: %s" type))) - (articles gnus-scores-articles)) - ;; Instead of doing all the clever stuff that - ;; `gnus-score-string' does to minimize searches and stuff, - ;; I will assume that people generally will put so few - ;; matches on numbers that any cleverness will take more - ;; time than one would gain. - (while articles - (when (funcall match-func - (or (aref (caar articles) gnus-score-index) 0) - match) - (when trace - (push (cons (car-safe (rassq alist gnus-score-cache)) kill) - gnus-score-trace)) - (setq found t) - (setcdr (car articles) (+ score (cdar articles)))) - (setq articles (cdr articles))) - ;; Update expire date - (cond ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries))) - (setq entries rest))))) - nil) - -(defun gnus-score-date (scores header now expire &optional trace) - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - entries alist match match-func article) - - ;; Find matches. - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (type (or (nth 3 kill) 'before)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (articles gnus-scores-articles) - l) - (cond - ((eq type 'after) - (setq match-func 'string< - match (gnus-date-iso8601 (nth 0 kill)))) - ((eq type 'before) - (setq match-func 'gnus-string> - match (gnus-date-iso8601 (nth 0 kill)))) - ((eq type 'at) - (setq match-func 'string= - match (gnus-date-iso8601 (nth 0 kill)))) - ((eq type 'regexp) - (setq match-func 'string-match - match (nth 0 kill))) - (t (error "Illegal match type: %s" type))) - ;; Instead of doing all the clever stuff that - ;; `gnus-score-string' does to minimize searches and stuff, - ;; I will assume that people generally will put so few - ;; matches on numbers that any cleverness will take more - ;; time than one would gain. - (while (setq article (pop articles)) - (when (and - (setq l (aref (car article) gnus-score-index)) - (funcall match-func match (gnus-date-iso8601 l))) - (when trace - (push (cons (car-safe (rassq alist gnus-score-cache)) kill) - gnus-score-trace)) - (setq found t) - (setcdr article (+ score (cdr article))))) - ;; Update expire date - (cond ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries))) - (setq entries rest))))) - nil) - -(defun gnus-score-body (scores header now expire &optional trace) - (save-excursion - (setq gnus-scores-articles - (sort gnus-scores-articles - (lambda (a1 a2) - (< (mail-header-number (car a1)) - (mail-header-number (car a2)))))) - (set-buffer nntp-server-buffer) - (save-restriction - (let* ((buffer-read-only nil) - (articles gnus-scores-articles) - (all-scores scores) - (request-func (cond ((string= "head" header) - 'gnus-request-head) - ((string= "body" header) - 'gnus-request-body) - (t 'gnus-request-article))) - entries alist ofunc article last) - (when articles - (setq last (mail-header-number (caar (last articles)))) - ;; Not all backends support partial fetching. In that case, - ;; we just fetch the entire article. - (unless (gnus-check-backend-function - (and (string-match "^gnus-" (symbol-name request-func)) - (intern (substring (symbol-name request-func) - (match-end 0)))) - gnus-newsgroup-name) - (setq ofunc request-func) - (setq request-func 'gnus-request-article)) - (while articles - (setq article (mail-header-number (caar articles))) - (gnus-message 7 "Scoring on article %s of %s..." article last) - (when (funcall request-func article gnus-newsgroup-name) - (widen) - (goto-char (point-min)) - ;; If just parts of the article is to be searched, but the - ;; backend didn't support partial fetching, we just narrow - ;; to the relevant parts. - (when ofunc - (if (eq ofunc 'gnus-request-head) - (narrow-to-region - (point) - (or (search-forward "\n\n" nil t) (point-max))) - (narrow-to-region - (or (search-forward "\n\n" nil t) (point)) - (point-max)))) - (setq scores all-scores) - ;; Find matches. - (while scores - (setq alist (pop scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) - gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (case-fold-search - (not (or (eq type 'R) (eq type 'S) - (eq type 'Regexp) (eq type 'String)))) - (search-func - (cond ((or (eq type 'r) (eq type 'R) - (eq type 'regexp) (eq type 'Regexp)) - 're-search-forward) - ((or (eq type 's) (eq type 'S) - (eq type 'string) (eq type 'String)) - 'search-forward) - (t - (error "Illegal match type: %s" type))))) - (goto-char (point-min)) - (when (funcall search-func match nil t) - ;; Found a match, update scores. - (setcdr (car articles) (+ score (cdar articles))) - (setq found t) - (when trace - (push - (cons (car-safe (rassq alist gnus-score-cache)) kill) - gnus-score-trace))) - ;; Update expire date - (unless trace - (cond - ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) - ;; Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries)))) - (setq entries rest))))) - (setq articles (cdr articles))))))) - nil) - -(defun gnus-score-thread (scores header now expire &optional trace) - (gnus-score-followup scores header now expire trace t)) - -(defun gnus-score-followup (scores header now expire &optional trace thread) - ;; Insert the unique article headers in the buffer. - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - (current-score-file gnus-current-score-file) - (all-scores scores) - ;; gnus-score-index is used as a free variable. - alike last this art entries alist articles - new news) - - ;; Change score file to the adaptive score file. All entries that - ;; this function makes will be put into this file. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file - (or gnus-newsgroup-adaptive-score-file - (gnus-score-file-name - gnus-newsgroup-name gnus-adaptive-file-suffix)))) - - (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) - articles gnus-scores-articles) - - (erase-buffer) - (while articles - (setq art (car articles) - this (aref (car art) gnus-score-index) - articles (cdr articles)) - (if (equal last this) - (push art alike) - (when last - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - (setq alike (list art) - last this))) - (when last ; Bwadr, duplicate code. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - - ;; Find matches. - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (mt (aref (symbol-name type) 0)) - (case-fold-search - (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) - (dmt (downcase mt)) - (search-func - (cond ((= dmt ?r) 're-search-forward) - ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) - (t (error "Illegal match type: %s" type)))) - arts art) - (goto-char (point-min)) - (if (= dmt ?e) - (while (funcall search-func match nil t) - (and (= (progn (beginning-of-line) (point)) - (match-beginning 0)) - (= (progn (end-of-line) (point)) - (match-end 0)) - (progn - (setq found (setq arts (get-text-property - (point) 'articles))) - ;; Found a match, update scores. - (while arts - (setq art (car arts) - arts (cdr arts)) - (gnus-score-add-followups - (car art) score all-scores thread)))) - (end-of-line)) - (while (funcall search-func match nil t) - (end-of-line) - (setq found (setq arts (get-text-property (point) 'articles))) - ;; Found a match, update scores. - (while (setq art (pop arts)) - (when (setq new (gnus-score-add-followups - (car art) score all-scores thread)) - (push new news))))) - ;; Update expire date - (cond ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries))) - (setq entries rest)))) - ;; We change the score file back to the previous one. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file current-score-file)) - (list (cons "references" news)))) - -(defun gnus-score-add-followups (header score scores &optional thread) - "Add a score entry to the adapt file." - (save-excursion - (set-buffer gnus-summary-buffer) - (let* ((id (mail-header-id header)) - (scores (car scores)) - entry dont) - ;; Don't enter a score if there already is one. - (while (setq entry (pop scores)) - (and (equal "references" (car entry)) - (or (null (nth 3 (cadr entry))) - (eq 's (nth 3 (cadr entry)))) - (assoc id entry) - (setq dont t))) - (unless dont - (gnus-summary-score-entry - (if thread "thread" "references") - id 's score (current-time-string) nil t))))) - -(defun gnus-score-string (score-list header now expire &optional trace) - ;; Score ARTICLES according to HEADER in SCORE-LIST. - ;; Update matching entries to NOW and remove unmatched entries older - ;; than EXPIRE. - - ;; 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))) - alike last this art entries alist articles - fuzzies arts words kill) - - ;; Sorting the articles costs os O(N*log N) but will allow us to - ;; only match with each unique header. Thus the actual matching - ;; will be O(M*U) where M is the number of strings to match with, - ;; and U is the number of unique headers. It is assumed (but - ;; untested) this will be a net win because of the large constant - ;; factor involved with string matching. - (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) - articles gnus-scores-articles) - - (erase-buffer) - (while (setq art (pop articles)) - (setq this (aref (car art) gnus-score-index)) - (if simplify - (setq this (gnus-map-function gnus-simplify-subject-functions this))) - (if (equal last this) - ;; O(N*H) cons-cells used here, where H is the number of - ;; headers. - (push art alike) - (when last - ;; Insert the line, with a text property on the - ;; terminating newline referring to the articles with - ;; this line. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - (setq alike (list art) - last this))) - (when last ; Bwadr, duplicate code. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - - ;; Go through all the score alists and pick out the entries - ;; for this header. - (while score-list - (setq alist (pop score-list) - ;; There's only one instance of this header for - ;; each score alist. - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((kill (cadr entries)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (mt (aref (symbol-name type) 0)) - (case-fold-search (not (memq mt '(?R ?S ?E ?F)))) - (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))) - (search-func - (cond ((= dmt ?r) 're-search-forward) - ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) - ((= dmt ?w) nil) - (t (error "Illegal match type: %s" type))))) - (cond - ;; Fuzzy matches. We save these for later. - ((= dmt ?f) - (push (cons entries alist) fuzzies)) - ;; Word matches. Save these for even later. - ((= dmt ?w) - (push (cons entries alist) words)) - ;; Exact matches. - ((= dmt ?e) - ;; Do exact matching. - (goto-char (point-min)) - (while (and (not (eobp)) - (funcall search-func match nil t)) - ;; Is it really exact? - (and (eolp) - (= (gnus-point-at-bol) (match-beginning 0)) - ;; Yup. - (progn - (setq found (setq arts (get-text-property - (point) 'articles))) - ;; Found a match, update scores. - (if trace - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))) - (push - (cons - (car-safe (rassq alist gnus-score-cache)) - kill) - gnus-score-trace)) - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))))))) - (forward-line 1))) - ;; Regexp and substring matching. - (t - (goto-char (point-min)) - (when (string= match "") - (setq match "\n")) - (while (and (not (eobp)) - (funcall search-func match nil t)) - (goto-char (match-beginning 0)) - (end-of-line) - (setq found (setq arts (get-text-property (point) 'articles))) - ;; Found a match, update scores. - (if trace - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))) - (push (cons (car-safe (rassq alist gnus-score-cache)) kill) - gnus-score-trace)) - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))))) - (forward-line 1)))) - ;; Update expiry date - (if trace - (setq entries (cdr entries)) - (cond - ;; Permanent entry. - ((null date) - (setq entries (cdr entries))) - ;; We have a match, so we update the date. - ((and found gnus-update-score-entry-dates) - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now) - (setq entries (cdr entries))) - ;; This entry has expired, so we remove it. - ((and expire (< date expire)) - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cddr entries))) - ;; No match; go to next entry. - (t - (setq entries (cdr entries)))))))) - - ;; Find fuzzy matches. - (when fuzzies - ;; Simplify the entire buffer for easy matching. - (gnus-simplify-buffer-fuzzy) - (while (setq kill (cadaar fuzzies)) - (let* ((match (nth 0 kill)) - (type (nth 3 kill)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (mt (aref (symbol-name type) 0)) - (case-fold-search (not (= mt ?F))) - found) - (goto-char (point-min)) - (while (and (not (eobp)) - (search-forward match nil t)) - (when (and (= (gnus-point-at-bol) (match-beginning 0)) - (eolp)) - (setq found (setq arts (get-text-property (point) 'articles))) - (if trace - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))) - (push (cons - (car-safe (rassq (cdar fuzzies) gnus-score-cache)) - kill) - gnus-score-trace)) - ;; Found a match, update scores. - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art)))))) - (forward-line 1)) - ;; Update expiry date - (cond - ;; Permanent. - ((null date) - ) - ;; Match, update date. - ((and found gnus-update-score-entry-dates) - (gnus-score-set 'touched '(t) (cdar fuzzies)) - (setcar (nthcdr 2 kill) now)) - ;; Old entry, remove. - ((and expire (< date expire)) - (gnus-score-set 'touched '(t) (cdar fuzzies)) - (setcdr (caar fuzzies) (cddaar fuzzies)))) - (setq fuzzies (cdr fuzzies))))) - - (when words - ;; Enter all words into the hashtb. - (let ((hashtb (gnus-make-hashtable - (* 10 (count-lines (point-min) (point-max)))))) - (gnus-enter-score-words-into-hashtb hashtb) - (while (setq kill (cadaar words)) - (let* ((score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - found) - (when (setq arts (intern-soft (nth 0 kill) hashtb)) - (setq arts (symbol-value arts)) - (setq found t) - (if trace - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))) - (push (cons - (car-safe (rassq (cdar words) gnus-score-cache)) - kill) - gnus-score-trace)) - ;; Found a match, update scores. - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art)))))) - ;; Update expiry date - (cond - ;; Permanent. - ((null date) - ) - ;; Match, update date. - ((and found gnus-update-score-entry-dates) - (gnus-score-set 'touched '(t) (cdar words)) - (setcar (nthcdr 2 kill) now)) - ;; Old entry, remove. - ((and expire (< date expire)) - (gnus-score-set 'touched '(t) (cdar words)) - (setcdr (caar words) (cddaar words)))) - (setq words (cdr words)))))) - nil)) - -(defun gnus-enter-score-words-into-hashtb (hashtb) - ;; Find all the words in the buffer and enter them into - ;; the hashtable. - (let ((syntab (syntax-table)) - word val) - (goto-char (point-min)) - (unwind-protect - (progn - (set-syntax-table gnus-adaptive-word-syntax-table) - (while (re-search-forward "\\b\\w+\\b" nil t) - (setq val - (gnus-gethash - (setq word (downcase (buffer-substring - (match-beginning 0) (match-end 0)))) - hashtb)) - (gnus-sethash - word - (append (get-text-property (gnus-point-at-eol) 'articles) val) - hashtb))) - (set-syntax-table syntab)) - ;; Make all the ignorable words ignored. - (let ((ignored (append gnus-ignored-adaptive-words - gnus-default-ignored-adaptive-words))) - (while ignored - (gnus-sethash (pop ignored) nil hashtb))))) - -(defun gnus-score-string< (a1 a2) - ;; Compare headers in articles A2 and A2. - ;; The header index used is the free variable `gnus-score-index'. - (string-lessp (aref (car a1) gnus-score-index) - (aref (car a2) gnus-score-index))) - -(defun gnus-current-score-file-nondirectory (&optional score-file) - (let ((score-file (or score-file gnus-current-score-file))) - (if score-file - (gnus-short-group-name (file-name-nondirectory score-file)) - "none"))) - -(defun gnus-score-adaptive () - "Create adaptive score rules for this newsgroup." - (when gnus-newsgroup-adaptive - ;; We change the score file to the adaptive score file. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file - (or gnus-newsgroup-adaptive-score-file - (gnus-home-score-file gnus-newsgroup-name t) - (gnus-score-file-name - gnus-newsgroup-name gnus-adaptive-file-suffix)))) - ;; Perform ordinary line scoring. - (when (or (not (listp gnus-newsgroup-adaptive)) - (memq 'line gnus-newsgroup-adaptive)) - (save-excursion - (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist)) - (alist malist) - (date (current-time-string)) - (data gnus-newsgroup-data) - elem headers match func) - ;; First we transform the adaptive rule alist into something - ;; that's faster to process. - (while malist - (setq elem (car malist)) - (when (symbolp (car elem)) - (setcar elem (symbol-value (car elem)))) - (setq elem (cdr elem)) - (while elem - (when (fboundp - (setq func - (intern - (concat "mail-header-" - (if (eq (caar elem) 'followup) - "message-id" - (downcase (symbol-name (caar elem)))))))) - (setcdr (car elem) - (cons (if (eq (caar elem) 'followup) - "references" - (symbol-name (caar elem))) - (cdar elem))) - (setcar (car elem) - `(lambda (h) - (,func h)))) - (setq elem (cdr elem))) - (setq malist (cdr malist))) - ;; Then we score away. - (while data - (setq elem (cdr (assq (gnus-data-mark (car data)) alist))) - (if (or (not elem) - (gnus-data-pseudo-p (car data))) - () - (when (setq headers (gnus-data-header (car data))) - (while elem - (setq match (funcall (caar elem) headers)) - (gnus-summary-score-entry - (nth 1 (car elem)) match - (cond - ((numberp match) - '=) - ((equal (nth 1 (car elem)) "date") - 'a) - (t - ;; Whether we use substring or exact matches is - ;; controlled here. - (if (or (not gnus-score-exact-adapt-limit) - (< (length match) gnus-score-exact-adapt-limit)) - 'e - (if (equal (nth 1 (car elem)) "subject") - 'f 's)))) - (nth 2 (car elem)) date nil t) - (setq elem (cdr elem))))) - (setq data (cdr data)))))) - - ;; Perform adaptive word scoring. - (when (and (listp gnus-newsgroup-adaptive) - (memq 'word gnus-newsgroup-adaptive)) - (nnheader-temp-write nil - (let* ((hashtb (gnus-make-hashtable 1000)) - (date (gnus-day-number (current-time-string))) - (data gnus-newsgroup-data) - (syntab (syntax-table)) - word d score val) - (unwind-protect - (progn - (set-syntax-table gnus-adaptive-word-syntax-table) - ;; Go through all articles. - (while (setq d (pop data)) - (when (and - (not (gnus-data-pseudo-p d)) - (setq score - (cdr (assq - (gnus-data-mark d) - gnus-adaptive-word-score-alist)))) - ;; This article has a mark that should lead to - ;; adaptive word rules, so we insert the subject - ;; and find all words in that string. - (insert (mail-header-subject (gnus-data-header d))) - (downcase-region (point-min) (point-max)) - (goto-char (point-min)) - (while (re-search-forward "\\b\\w+\\b" nil t) - ;; 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)) - (erase-buffer)))) - (set-syntax-table syntab)) - ;; Make all the ignorable words ignored. - (let ((ignored (append gnus-ignored-adaptive-words - gnus-default-ignored-adaptive-words))) - (while ignored - (gnus-sethash (pop ignored) nil hashtb))) - ;; Now we have all the words and scores, so we - ;; add these rules to the ADAPT file. - (set-buffer gnus-summary-buffer) - (mapatoms - (lambda (word) - (when (symbol-value word) - (gnus-summary-score-entry - "subject" (symbol-name word) 'w (symbol-value word) - date nil t))) - hashtb)))))) - -(defun gnus-score-edit-done () - (let ((bufnam (buffer-file-name (current-buffer))) - (winconf gnus-prev-winconf)) - (when winconf - (set-window-configuration winconf)) - (gnus-score-remove-from-cache bufnam) - (gnus-score-load-file bufnam))) - -(defun gnus-score-find-trace () - "Find all score rules that applies to the current article." - (interactive) - (let ((old-scored gnus-newsgroup-scored)) - (let ((gnus-newsgroup-headers - (list (gnus-summary-article-header))) - (gnus-newsgroup-scored nil) - trace) - (save-excursion - (nnheader-set-temp-buffer "*Score Trace*")) - (setq gnus-score-trace nil) - (gnus-possibly-score-headers 'trace) - (if (not (setq trace gnus-score-trace)) - (gnus-error - 1 "No score rules apply to the current article (default score %d)." - gnus-summary-default-score) - (set-buffer "*Score Trace*") - (gnus-add-current-to-buffer-list) - (while trace - (insert (format "%S -> %s\n" (cdar trace) - (if (caar trace) - (file-name-nondirectory (caar trace)) - "(non-file rule)"))) - (setq trace (cdr trace))) - (goto-char (point-min)) - (gnus-configure-windows 'score-trace))) - (set-buffer gnus-summary-buffer) - (setq gnus-newsgroup-scored old-scored))) - -(defun gnus-score-find-favourite-words () - "List words used in scoring." - (interactive) - (let ((alists (gnus-score-load-files (gnus-all-score-files))) - alist rule rules kill) - ;; Go through all the score alists for this group - ;; and find all `w' rules. - (while (setq alist (pop alists)) - (while (setq rule (pop alist)) - (when (and (stringp (car rule)) - (equal "subject" (downcase (pop rule)))) - (while (setq kill (pop rule)) - (when (memq (nth 3 kill) '(w W word Word)) - (push (cons (or (nth 1 kill) - gnus-score-interactive-default-score) - (car kill)) - rules)))))) - (setq rules (sort rules (lambda (r1 r2) - (string-lessp (cdr r1) (cdr r2))))) - ;; Add up words that have appeared several times. - (let ((r rules)) - (while (cdr r) - (if (equal (cdar r) (cdadr r)) - (progn - (setcar (car r) (+ (caar r) (caadr r))) - (setcdr r (cddr r))) - (pop r)))) - ;; Insert the words. - (nnheader-set-temp-buffer "*Score Words*") - (if (not (setq rules (sort rules (lambda (r1 r2) (> (car r1) (car r2)))))) - (gnus-error 3 "No word score rules") - (while rules - (insert (format "%-5d: %s\n" (caar rules) (cdar rules))) - (pop rules)) - (gnus-add-current-to-buffer-list) - (goto-char (point-min)) - (gnus-configure-windows 'score-words)))) - -(defun gnus-summary-rescore () - "Redo the entire scoring process in the current summary." - (interactive) - (gnus-score-save) - (setq gnus-score-cache nil) - (setq gnus-newsgroup-scored nil) - (gnus-possibly-score-headers) - (gnus-score-update-all-lines)) - -(defun gnus-score-flush-cache () - "Flush the cache of score files." - (interactive) - (gnus-score-save) - (setq gnus-score-cache nil - gnus-score-alist nil - gnus-short-name-score-file-cache nil) - (gnus-message 6 "The score cache is now flushed")) - -(gnus-add-shutdown 'gnus-score-close 'gnus) - -(defvar gnus-score-file-alist-cache nil) - -(defun gnus-score-close () - "Clear all internal score variables." - (setq gnus-score-cache nil - gnus-internal-global-score-files nil - gnus-score-file-list nil - gnus-score-file-alist-cache nil)) - -;; Summary score marking commands. - -(defun gnus-summary-raise-same-subject-and-select (score) - "Raise articles which has the same subject with SCORE and select the next." - (interactive "p") - (let ((subject (gnus-summary-article-subject))) - (gnus-summary-raise-score score) - (while (gnus-summary-find-subject subject) - (gnus-summary-raise-score score)) - (gnus-summary-next-article t))) - -(defun gnus-summary-raise-same-subject (score) - "Raise articles which has the same subject with SCORE." - (interactive "p") - (let ((subject (gnus-summary-article-subject))) - (gnus-summary-raise-score score) - (while (gnus-summary-find-subject subject) - (gnus-summary-raise-score score)) - (gnus-summary-next-subject 1 t))) - -(defun gnus-score-default (level) - (if level (prefix-numeric-value level) - gnus-score-interactive-default-score)) - -(defun gnus-summary-raise-thread (&optional score) - "Raise the score of the articles in the current thread with SCORE." - (interactive "P") - (setq score (gnus-score-default score)) - (let (e) - (save-excursion - (let ((articles (gnus-summary-articles-in-thread))) - (while articles - (gnus-summary-goto-subject (car articles)) - (gnus-summary-raise-score score) - (setq articles (cdr articles)))) - (setq e (point))) - (let ((gnus-summary-check-current t)) - (unless (zerop (gnus-summary-next-subject 1 t)) - (goto-char e)))) - (gnus-summary-recenter) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary)) - -(defun gnus-summary-lower-same-subject-and-select (score) - "Raise articles which has the same subject with SCORE and select the next." - (interactive "p") - (gnus-summary-raise-same-subject-and-select (- score))) - -(defun gnus-summary-lower-same-subject (score) - "Raise articles which has the same subject with SCORE." - (interactive "p") - (gnus-summary-raise-same-subject (- 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-default score))))) - -;;; Finding score files. - -(defun gnus-score-score-files (group) - "Return a list of all possible score files." - ;; Search and set any global score files. - (when gnus-global-score-files - (unless gnus-internal-global-score-files - (gnus-score-search-global-directories gnus-global-score-files))) - ;; Fix the kill-file dir variable. - (setq gnus-kill-files-directory - (file-name-as-directory gnus-kill-files-directory)) - ;; If we can't read it, there are no score files. - (if (not (file-exists-p (expand-file-name gnus-kill-files-directory))) - (setq gnus-score-file-list nil) - (if (not (gnus-use-long-file-name 'not-score)) - ;; We do not use long file names, so we have to do some - ;; directory traversing. - (setq gnus-score-file-list - (cons nil - (or gnus-short-name-score-file-cache - (prog2 - (gnus-message 6 "Finding all score files...") - (setq gnus-short-name-score-file-cache - (gnus-score-score-files-1 - gnus-kill-files-directory)) - (gnus-message 6 "Finding all score files...done"))))) - ;; We want long file names. - (when (or (not gnus-score-file-list) - (not (car gnus-score-file-list)) - (gnus-file-newer-than gnus-kill-files-directory - (car gnus-score-file-list))) - (setq gnus-score-file-list - (cons (nth 5 (file-attributes gnus-kill-files-directory)) - (nreverse - (directory-files - gnus-kill-files-directory t - (gnus-score-file-regexp))))))) - (cdr gnus-score-file-list))) - -(defun gnus-score-score-files-1 (dir) - "Return all possible score files under DIR." - (let ((files (list (expand-file-name dir))) - (regexp (gnus-score-file-regexp)) - (case-fold-search nil) - seen out file) - (while (setq file (pop files)) - (cond - ;; Ignore "." and "..". - ((member (file-name-nondirectory file) '("." "..")) - nil) - ;; Add subtrees of directory to also be searched. - ((and (file-directory-p file) - (not (member (file-truename file) seen))) - (push (file-truename file) seen) - (setq files (nconc (directory-files file t nil t) files))) - ;; Add files to the list of score files. - ((string-match regexp file) - (push file out)))) - (or out - ;; Return a dummy value. - (list "~/News/this.file.does.not.exist.SCORE")))) - -(defun gnus-score-file-regexp () - "Return a regexp that match all score files." - (concat "\\(" (regexp-quote gnus-score-file-suffix ) - "\\|" (regexp-quote gnus-adaptive-file-suffix) "\\)\\'")) - -(defun gnus-score-find-bnews (group) - "Return a list of score files for GROUP. -The score files are those files in the ~/News/ directory which matches -GROUP using BNews sys file syntax." - (let* ((sfiles (append (gnus-score-score-files group) - gnus-internal-global-score-files)) - (kill-dir (file-name-as-directory - (expand-file-name gnus-kill-files-directory))) - (klen (length kill-dir)) - (score-regexp (gnus-score-file-regexp)) - (trans (cdr (assq ?: nnheader-file-name-translation-alist))) - ofiles not-match regexp) - (save-excursion - (set-buffer (get-buffer-create "*gnus score files*")) - (buffer-disable-undo (current-buffer)) - ;; Go through all score file names and create regexp with them - ;; as the source. - (while sfiles - (erase-buffer) - (insert (car sfiles)) - (goto-char (point-min)) - ;; First remove the suffix itself. - (when (re-search-forward (concat "." score-regexp) nil t) - (replace-match "" t t) - (goto-char (point-min)) - (if (looking-at (regexp-quote kill-dir)) - ;; If the file name was just "SCORE", `klen' is one character - ;; too much. - (delete-char (min (1- (point-max)) klen)) - (goto-char (point-max)) - (search-backward "/") - (delete-region (1+ (point)) (point-min))) - ;; If short file names were used, we have to translate slashes. - (goto-char (point-min)) - (let ((regexp (concat - "[/:" (if trans (char-to-string trans) "") "]"))) - (while (re-search-forward regexp nil t) - (replace-match "." t t))) - ;; Kludge to get rid of "nntp+" problems. - (goto-char (point-min)) - (when (looking-at "nn[a-z]+\\+") - (search-forward "+") - (forward-char -1) - (insert "\\") - (forward-char 1)) - ;; Kludge to deal with "++". - (while (search-forward "+" nil t) - (replace-match "\\+" t t)) - ;; Translate "all" to ".*". - (goto-char (point-min)) - (while (search-forward "all" nil t) - (replace-match ".*" t t)) - (goto-char (point-min)) - ;; Deal with "not."s. - (if (looking-at "not.") - (progn - (setq not-match t) - (setq regexp (concat "^" (buffer-substring 5 (point-max)) "$"))) - (setq regexp (concat "^" (buffer-substring 1 (point-max)) "$")) - (setq not-match nil)) - ;; Finally - if this resulting regexp matches the group name, - ;; we add this score file to the list of score files - ;; applicable to this group. - (when (or (and not-match - (not (string-match regexp group))) - (and (not not-match) - (string-match regexp group))) - (push (car sfiles) ofiles))) - (setq sfiles (cdr sfiles))) - (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 - ;; file, and not end up in some global score file. - (let ((localscore (gnus-score-file-name group))) - (setq ofiles (cons localscore (delete localscore ofiles)))) - (gnus-sort-score-files (nreverse ofiles))))) - -(defun gnus-score-find-single (group) - "Return list containing the score file for GROUP." - (list (or gnus-newsgroup-adaptive-score-file - (gnus-score-file-name group gnus-adaptive-file-suffix)) - (gnus-score-file-name group))) - -(defun gnus-score-find-hierarchical (group) - "Return list of score files for GROUP. -This includes the score file for the group and all its parents." - (let* ((prefix (gnus-group-real-prefix group)) - (all (list nil)) - (group (gnus-group-real-name group)) - (start 0)) - (while (string-match "\\." group (1+ start)) - (setq start (match-beginning 0)) - (push (substring group 0 start) all)) - (push group all) - (setq all - (nconc - (mapcar (lambda (group) - (gnus-score-file-name group gnus-adaptive-file-suffix)) - (setq all (nreverse all))) - (mapcar 'gnus-score-file-name all))) - (if (equal prefix "") - all - (mapcar - (lambda (file) - (nnheader-translate-file-chars - (concat (file-name-directory file) prefix - (file-name-nondirectory file)))) - all)))) - -(defun gnus-score-file-rank (file) - "Return a number that says how specific score FILE is. -Destroys the current buffer." - (if (member file gnus-internal-global-score-files) - 0 - (when (string-match - (concat "^" (regexp-quote - (expand-file-name - (file-name-as-directory gnus-kill-files-directory)))) - file) - (setq file (substring file (match-end 0)))) - (insert file) - (goto-char (point-min)) - (let ((beg (point)) - elems) - (while (re-search-forward "[./]" nil t) - (push (buffer-substring beg (1- (point))) - elems)) - (erase-buffer) - (setq elems (delete "all" elems)) - (length elems)))) - -(defun gnus-sort-score-files (files) - "Sort FILES so that the most general files come first." - (nnheader-temp-write nil - (let ((alist - (mapcar - (lambda (file) - (cons (inline (gnus-score-file-rank file)) file)) - files))) - (mapcar - (lambda (f) (cdr f)) - (sort alist 'car-less-than-car))))) - -(defun gnus-score-find-alist (group) - "Return list of score files for GROUP. -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 - (if (setq score-files (assoc group gnus-score-file-alist-cache)) - (cdr score-files) ;ensures caching groups with no matches - ;; handle the multiple match alist - (while alist - (when (string-match (caar alist) group) - (setq score-files - (nconc score-files (copy-sequence (cdar alist))))) - (setq alist (cdr alist))) - (setq alist gnus-score-file-single-match-alist) - ;; handle the single match alist - (while alist - (when (string-match (caar alist) group) - ;; progn used just in case ("regexp") has no files - ;; and score-files is still nil. -sj - ;; this can be construed as a "stop searching here" feature :> - ;; and used to simplify regexps in the single-alist - (setq score-files - (nconc score-files (copy-sequence (cdar alist)))) - (setq alist nil)) - (setq alist (cdr alist))) - ;; cache the score files - (push (cons group score-files) gnus-score-file-alist-cache) - score-files))) - -(defun gnus-all-score-files (&optional group) - "Return a list of all score files for the current group." - (let ((funcs gnus-score-find-score-files-function) - (group (or group gnus-newsgroup-name)) - score-files) - (when group - ;; Make sure funcs is a list. - (and funcs - (not (listp funcs)) - (setq funcs (list funcs))) - ;; Get the initial score files for this group. - (when funcs - (setq score-files (nreverse (gnus-score-find-alist group)))) - ;; Add any home adapt files. - (let ((home (gnus-home-score-file group t))) - (when home - (push home score-files) - (setq gnus-newsgroup-adaptive-score-file home))) - ;; Check whether there is a `adapt-file' group parameter. - (let ((param-file (gnus-group-find-parameter group 'adapt-file))) - (when param-file - (push param-file score-files) - (setq gnus-newsgroup-adaptive-score-file param-file))) - ;; 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)) - (setq score-files - (nconc score-files (nreverse (funcall (car funcs) group))))) - (setq funcs (cdr funcs))) - ;; Add any home score files. - (let ((home (gnus-home-score-file group))) - (when home - (push home score-files))) - ;; Check whether there is a `score-file' group parameter. - (let ((param-file (gnus-group-find-parameter group 'score-file))) - (when param-file - (push param-file score-files))) - ;; Expand all files names. - (let ((files score-files)) - (while files - (when (stringp (car files)) - (setcar files (expand-file-name - (car files) gnus-kill-files-directory))) - (pop files))) - (setq score-files (nreverse score-files)) - ;; Remove any duplicate score files. - (while (and score-files - (member (car score-files) (cdr score-files))) - (pop score-files)) - (let ((files score-files)) - (while (cdr files) - (if (member (cadr files) (cddr files)) - (setcdr files (cddr files)) - (pop files)))) - ;; Do the scoring if there are any score files for this group. - score-files))) - -(defun gnus-possibly-score-headers (&optional trace) - "Do scoring if scoring is required." - (let ((score-files (gnus-all-score-files))) - (when score-files - (gnus-score-headers score-files trace)))) - -(defun gnus-score-file-name (newsgroup &optional suffix) - "Return the name of a score file for NEWSGROUP." - (let ((suffix (or suffix gnus-score-file-suffix))) - (nnheader-translate-file-chars - (cond - ((or (null newsgroup) - (string-equal newsgroup "")) - ;; The global score file is placed at top of the directory. - (expand-file-name suffix gnus-kill-files-directory)) - ((gnus-use-long-file-name 'not-score) - ;; Append ".SCORE" to newsgroup name. - (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) - "." suffix) - gnus-kill-files-directory)) - (t - ;; Place "SCORE" under the hierarchical directory. - (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) - "/" suffix) - gnus-kill-files-directory)))))) - -(defun gnus-score-search-global-directories (files) - "Scan all global score directories for score files." - ;; Set the variable `gnus-internal-global-score-files' to all - ;; available global score files. - (interactive (list gnus-global-score-files)) - (let (out) - (while files - (if (string-match "/$" (car files)) - (setq out (nconc (directory-files - (car files) t - (concat (gnus-score-file-regexp) "$")))) - (push (car files) out)) - (setq files (cdr files))) - (setq gnus-internal-global-score-files out))) - -(defun gnus-score-default-fold-toggle () - "Toggle folding for new score file entries." - (interactive) - (setq gnus-score-default-fold (not gnus-score-default-fold)) - (if gnus-score-default-fold - (gnus-message 1 "New score file entries will be case insensitive.") - (gnus-message 1 "New score file entries will be case sensitive."))) - -;;; Home score file. - -(defun gnus-home-score-file (group &optional adapt) - "Return the home score file for GROUP. -If ADAPT, return the home adaptive file instead." - (let ((list (if adapt gnus-home-adapt-file gnus-home-score-file)) - elem found) - ;; Make sure we have a list. - (unless (listp list) - (setq list (list list))) - ;; Go through the list and look for matches. - (while (and (not found) - (setq elem (pop list))) - (setq found - (cond - ;; Simple string. - ((stringp elem) - elem) - ;; Function. - ((gnus-functionp elem) - (funcall elem group)) - ;; Regexp-file cons - ((consp elem) - (when (string-match (car elem) group) - (cadr elem)))))) - (when 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." - (if (string-match "^[^.]+\\." group) - (concat (match-string 0 group) gnus-score-file-suffix) - ;; Group name without any dots. - (concat group (if (gnus-use-long-file-name 'not-score) "." "/") - gnus-score-file-suffix))) - -(defun gnus-hierarchial-home-adapt-file (group) - "Return the adapt file of the top-level hierarchy of GROUP." - (if (string-match "^[^.]+\\." group) - (concat (match-string 0 group) gnus-adaptive-file-suffix) - ;; Group name without any dots. - (concat group (if (gnus-use-long-file-name 'not-score) "." "/") - gnus-adaptive-file-suffix))) - -;;; -;;; Score decays -;;; - -(defun gnus-decay-score (score) - "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'." - (floor - (- score - (* (if (< score 0) -1 1) - (min (abs score) - (max gnus-score-decay-constant - (* (abs score) - gnus-score-decay-scale))))))) - -(defun gnus-decay-scores (alist day) - "Decay non-permanent scores in ALIST." - (let ((times (- (gnus-time-to-day (current-time)) day)) - kill entry updated score n) - (unless (zerop times) ;Done decays today already? - (while (setq entry (pop alist)) - (when (stringp (car entry)) - (setq entry (cdr entry)) - (while (setq kill (pop entry)) - (when (nth 2 kill) - (setq updated t) - (setq score (or (nth 1 kill) - gnus-score-interactive-default-score) - n times) - (while (natnump (decf n)) - (setq score (funcall gnus-decay-score-function score))) - (setcdr kill (cons score - (cdr (cdr kill))))))))) - ;; Return whether this score file needs to be saved. By Je-haysuss! - updated)) - -(defun gnus-score-regexp-bad-p (regexp) - "Test whether REGEXP is safe for Gnus scoring. -A regexp is unsafe if it matches newline or a buffer boundary. - -If the regexp is good, return nil. If the regexp is bad, return a -cons cell (SYM . STRING), where the symbol SYM is `new' or `bad'. -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." - (let (case-fold-search) - (and - ;; First, try a relatively fast necessary condition. - ;; Notice ranges (like [^:] or [\t-\r]), \s>, \Sw, \W, \', \`: - (string-match "\n\\|\\\\[SsW`']\\|\\[\\^\\|[\0-\n]-" regexp) - ;; Now break the regexp into tokens, and check each: - (let ((tail regexp) ; remaining regexp to check - tok ; current token - bad ; nil, or bad subexpression - new ; nil, or replacement regexp so far - end) ; length of current token - (while (and (not bad) - (string-match - "\\`\\(\\\\[sS]?.\\|\\[\\^?]?[^]]*]\\|[^\\]\\)" - tail)) - (setq end (match-end 0) - tok (substring tail 0 end) - tail (substring tail end)) - (if;; Is token `bad' (matching newline or buffer ends)? - (or (member tok '("\n" "\\W" "\\`" "\\'")) - ;; This next handles "[...]", "\\s.", and "\\S.": - (and (> end 2) (string-match tok "\n"))) - (let ((newtok - ;; Try to suggest a replacement for tok ... - (cond ((string-equal tok "\\`") "^") ; or "\\(^\\)" - ((string-equal tok "\\'") "$") ; or "\\($\\)" - ((string-match "\\[\\^" tok) ; very common - (concat (substring tok 0 -1) "\n]"))))) - (if newtok - (setq new - (concat - (or new - ;; good prefix so far: - (substring regexp 0 (- (+ (length tail) end)))) - newtok)) - ;; No replacement idea, so give up: - (setq bad tok))) - ;; tok is good, may need to extend new - (and new (setq new (concat new tok))))) - ;; Now return a value: - (cond - (bad (cons 'bad bad)) - (new (cons 'new new)) - ;; or nil - ))))) - -(provide 'gnus-score) - -;;; gnus-score.el ends here diff --git a/lisp/gnus-setup.el b/lisp/gnus-setup.el deleted file mode 100644 index ae9909b..0000000 --- a/lisp/gnus-setup.el +++ /dev/null @@ -1,217 +0,0 @@ -;;; gnus-setup.el --- Initialization & Setup for Gnus 5 -;; Copyright (C) 1995, 96 Free Software Foundation, Inc. - -;; Author: Steven L. Baur -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: -;; My head is starting to spin with all the different mail/news packages. -;; Stop The Madness! - -;; Given that Emacs Lisp byte codes may be diverging, it is probably best -;; not to byte compile this, and just arrange to have the .el loaded out -;; of .emacs. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)) - -(defvar gnus-use-installed-gnus t - "*If non-nil Use installed version of Gnus.") - -(defvar gnus-use-installed-tm running-xemacs - "*If non-nil use installed version of tm.") - -(defvar gnus-use-installed-mailcrypt running-xemacs - "*If non-nil use installed version of mailcrypt.") - -(defvar gnus-emacs-lisp-directory (if running-xemacs - "/usr/local/lib/xemacs/" - "/usr/local/share/emacs/") - "Directory where Emacs site lisp is located.") - -(defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory - "gnus-5.0.15/lisp/") - "Directory where Gnus Emacs lisp is found.") - -(defvar gnus-tm-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/") - "Directory where TM Emacs lisp is found.") - -(defvar gnus-mailcrypt-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/mailcrypt-3.4/") - "Directory where Mailcrypt Emacs Lisp is found.") - -(defvar gnus-bbdb-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/bbdb-1.51/") - "Directory where Big Brother Database is found.") - -(defvar gnus-use-tm running-xemacs - "Set this if you want MIME support for Gnus") -(defvar gnus-use-mhe nil - "Set this if you want to use MH-E for mail reading") -(defvar gnus-use-rmail nil - "Set this if you want to use RMAIL for mail reading") -(defvar gnus-use-sendmail t - "Set this if you want to use SENDMAIL for mail reading") -(defvar gnus-use-vm nil - "Set this if you want to use the VM package for mail reading") -(defvar gnus-use-sc nil - "Set this if you want to use Supercite") -(defvar gnus-use-mailcrypt t - "Set this if you want to use Mailcrypt for dealing with PGP messages") -(defvar gnus-use-bbdb nil - "Set this if you want to use the Big Brother DataBase") - -(when (and (not gnus-use-installed-gnus) - (null (member gnus-gnus-lisp-directory load-path))) - (push gnus-gnus-lisp-directory load-path)) - -;;; We can't do this until we know where Gnus is. -(require 'message) - -;;; Tools for MIME by -;;; UMEDA Masanobu -;;; MORIOKA Tomohiko - -(when gnus-use-tm - (when (and (not gnus-use-installed-tm) - (null (member gnus-tm-lisp-directory load-path))) - (setq load-path (cons gnus-tm-lisp-directory load-path))) - ;; tm may or may not be dumped with XEmacs. In Sunpro it is, otherwise - ;; it isn't. - (unless (featurep 'mime-setup) - (load "mime-setup"))) - -;;; Mailcrypt by -;;; Jin Choi -;;; Patrick LoPresti - -(when gnus-use-mailcrypt - (when (and (not gnus-use-installed-mailcrypt) - (null (member gnus-mailcrypt-lisp-directory load-path))) - (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) - (when gnus-use-mhe - (add-hook 'mh-folder-mode-hook 'mc-install-read-mode) - (add-hook 'mh-letter-mode-hook 'mc-install-write-mode))) - -;;; BBDB by -;;; Jamie Zawinski - -(when gnus-use-bbdb - ;; bbdb will never be installed with emacs. - (when (null (member gnus-bbdb-lisp-directory load-path)) - (setq load-path (cons gnus-bbdb-lisp-directory load-path))) - (autoload 'bbdb "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-name "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-company "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-net "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-notes "bbdb-com" - "Insidious Big Brother Database" t) - - (when gnus-use-vm - (autoload 'bbdb-insinuate-vm "bbdb-vm" - "Hook BBDB into VM" t)) - - (when gnus-use-rmail - (autoload 'bbdb-insinuate-rmail "bbdb-rmail" - "Hook BBDB into RMAIL" t) - (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)) - - (when gnus-use-mhe - (autoload 'bbdb-insinuate-mh "bbdb-mh" - "Hook BBDB into MH-E" t) - (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh)) - - (autoload 'bbdb-insinuate-gnus "bbdb-gnus" - "Hook BBDB into Gnus" t) - (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) - - (when gnus-use-sendmail - (autoload 'bbdb-insinuate-sendmail "bbdb" - "Insidious Big Brother Database" t) - (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail) - (add-hook 'message-setup-hook 'bbdb-insinuate-sendmail))) - -(when gnus-use-sc - (add-hook 'mail-citation-hook 'sc-cite-original) - (setq message-cite-function 'sc-cite-original) - (autoload 'sc-cite-original "supercite")) - -;;;### (autoloads (gnus gnus-slave gnus-no-server) "gnus" "lisp/gnus.el" (12473 2137)) -;;; Generated autoloads from lisp/gnus.el - -;; Don't redo this if autoloads already exist -(unless (fboundp 'gnus) - (autoload 'gnus-slave-no-server "gnus" "\ -Read network news as a slave without connecting to local server." t nil) - - (autoload 'gnus-no-server "gnus" "\ -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." t nil) - - (autoload 'gnus-slave "gnus" "\ -Read news as a slave." t nil) - - (autoload 'gnus "gnus" "\ -Read network news. -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." t nil) - -;;;*** - -;;; These have moved out of gnus.el into other files. -;;; FIX FIX FIX: should other things be in gnus-setup? or these not in it? - (autoload 'gnus-update-format "gnus-spec" "\ -Update the format specification near point." t nil) - - (autoload 'gnus-fetch-group "gnus-group" "\ -Start Gnus if necessary and enter GROUP. -Returns whether the fetching was successful or not." t nil) - - (defalias 'gnus-batch-kill 'gnus-batch-score) - - (autoload 'gnus-batch-score "gnus-kill" "\ -Run batched scoring. -Usage: emacs -batch -l gnus -f gnus-batch-score ... -Newsgroups is a list of strings in Bnews format. If you want to score -the comp hierarchy, you'd say \"comp.all\". If you would not like to -score the alt hierarchy, you'd say \"!alt.all\"." t nil)) - -(provide 'gnus-setup) - -(run-hooks 'gnus-setup-load-hook) - -;;; gnus-setup.el ends here diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el deleted file mode 100644 index 3b593ca..0000000 --- a/lisp/gnus-soup.el +++ /dev/null @@ -1,566 +0,0 @@ -;;; gnus-soup.el --- SOUP packet writing support for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Lars Magne Ingebrigtsen -;; 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: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-art) -(require 'message) -(require 'gnus-start) -(require 'gnus-range) - -;;; User Variables: - -(defvar gnus-soup-directory (nnheader-concat gnus-home-directory "SoupBrew/") - "*Directory containing an unpacked SOUP packet.") - -(defvar gnus-soup-replies-directory - (nnheader-concat gnus-soup-directory "SoupReplies/") - "*Directory where Gnus will do processing of replies.") - -(defvar gnus-soup-prefix-file "gnus-prefix" - "*Name of the file where Gnus stores the last used prefix.") - -(defvar gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz" - "Format string command for packing a SOUP packet. -The SOUP files will be inserted where the %s is in the string. -This string MUST contain both %s and %d. The file number will be -inserted where %d appears.") - -(defvar gnus-soup-unpacker "gunzip -c %s | tar xvf -" - "*Format string command for unpacking a SOUP packet. -The SOUP packet file name will be inserted at the %s.") - -(defvar gnus-soup-packet-directory gnus-home-directory - "*Where gnus-soup will look for REPLIES packets.") - -(defvar gnus-soup-packet-regexp "Soupin" - "*Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'.") - -(defvar gnus-soup-ignored-headers "^Xref:" - "*Regexp to match headers to be removed when brewing SOUP packets.") - -;;; Internal Variables: - -(defvar gnus-soup-encoding-type ?n - "*Soup encoding type. -`n' is news format, `m' is Unix mbox format, and `M' is MMDF mailbox -format.") - -(defvar gnus-soup-index-type ?c - "*Soup index type. -`n' means no index file and `c' means standard Cnews overview -format.") - -(defvar gnus-soup-areas nil) -(defvar gnus-soup-last-prefix nil) -(defvar gnus-soup-prev-prefix nil) -(defvar gnus-soup-buffers nil) - -;;; Access macros: - -(defmacro gnus-soup-area-prefix (area) - `(aref ,area 0)) -(defmacro gnus-soup-set-area-prefix (area prefix) - `(aset ,area 0 ,prefix)) -(defmacro gnus-soup-area-name (area) - `(aref ,area 1)) -(defmacro gnus-soup-area-encoding (area) - `(aref ,area 2)) -(defmacro gnus-soup-area-description (area) - `(aref ,area 3)) -(defmacro gnus-soup-area-number (area) - `(aref ,area 4)) -(defmacro gnus-soup-area-set-number (area value) - `(aset ,area 4 ,value)) - -(defmacro gnus-soup-encoding-format (encoding) - `(aref ,encoding 0)) -(defmacro gnus-soup-encoding-index (encoding) - `(aref ,encoding 1)) -(defmacro gnus-soup-encoding-kind (encoding) - `(aref ,encoding 2)) - -(defmacro gnus-soup-reply-prefix (reply) - `(aref ,reply 0)) -(defmacro gnus-soup-reply-kind (reply) - `(aref ,reply 1)) -(defmacro gnus-soup-reply-encoding (reply) - `(aref ,reply 2)) - -;;; Commands: - -(defun gnus-soup-send-replies () - "Unpack and send all replies in the reply packet." - (interactive) - (let ((packets (directory-files - gnus-soup-packet-directory t gnus-soup-packet-regexp))) - (while packets - (when (gnus-soup-send-packet (car packets)) - (delete-file (car packets))) - (setq packets (cdr packets))))) - -(defun gnus-soup-add-article (n) - "Add the current article to SOUP packet. -If N is a positive number, add the N next articles. -If N is a negative number, add the N previous articles. -If N is nil and any articles have been marked with the process mark, -move those articles instead." - (interactive "P") - (let* ((articles (gnus-summary-work-articles n)) - (tmp-buf (get-buffer-create "*soup work*")) - (area (gnus-soup-area gnus-newsgroup-name)) - (prefix (gnus-soup-area-prefix area)) - headers) - (buffer-disable-undo tmp-buf) - (save-excursion - (while articles - ;; Find the header of the article. - (set-buffer gnus-summary-buffer) - (when (setq headers (gnus-summary-article-header (car articles))) - ;; Put the article in a buffer. - (set-buffer tmp-buf) - (when (gnus-request-article-this-buffer - (car articles) gnus-newsgroup-name) - (save-restriction - (message-narrow-to-head) - (message-remove-header gnus-soup-ignored-headers t)) - (gnus-soup-store gnus-soup-directory prefix headers - 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) - (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))) - -(defun gnus-soup-pack-packet () - "Make a SOUP packet from the SOUP areas." - (interactive) - (gnus-soup-read-areas) - (unless (file-exists-p gnus-soup-directory) - (message "No such directory: %s" gnus-soup-directory)) - (when (null (directory-files gnus-soup-directory nil "\\.MSG$")) - (message "No files to pack.")) - (gnus-soup-pack gnus-soup-directory gnus-soup-packer)) - -(defun gnus-group-brew-soup (n) - "Make a soup packet from the current group. -Uses the process/prefix convention." - (interactive "P") - (let ((groups (gnus-group-process-prefix n))) - (while groups - (gnus-group-remove-mark (car groups)) - (gnus-soup-group-brew (car groups) t) - (setq groups (cdr groups))) - (gnus-soup-save-areas))) - -(defun gnus-brew-soup (&optional level) - "Go through all groups on LEVEL or less and make a soup packet." - (interactive "P") - (let ((level (or level gnus-level-subscribed)) - (newsrc (cdr gnus-newsrc-alist))) - (while newsrc - (when (<= (nth 1 (car newsrc)) level) - (gnus-soup-group-brew (caar newsrc) t)) - (setq newsrc (cdr newsrc))) - (gnus-soup-save-areas))) - -;;;###autoload -(defun gnus-batch-brew-soup () - "Brew a SOUP packet from groups mention on the command line. -Will use the remaining command line arguments as regular expressions -for matching on group names. - -For instance, if you want to brew on all the nnml groups, as well as -groups with \"emacs\" in the name, you could say something like: - -$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"" - (interactive) - nil) - -;;; Internal Functions: - -;; Store the current buffer. -(defun gnus-soup-store (directory prefix headers format index) - ;; Create the directory, if needed. - (gnus-make-directory directory) - (let* ((msg-buf (nnheader-find-file-noselect - (concat directory prefix ".MSG"))) - (idx-buf (if (= index ?n) - nil - (nnheader-find-file-noselect - (concat directory prefix ".IDX")))) - (article-buf (current-buffer)) - from head-line beg type) - (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers))) - (buffer-disable-undo msg-buf) - (when idx-buf - (push idx-buf gnus-soup-buffers) - (buffer-disable-undo idx-buf)) - (save-excursion - ;; Make sure the last char in the buffer is a newline. - (goto-char (point-max)) - (unless (= (current-column) 0) - (insert "\n")) - ;; Find the "from". - (goto-char (point-min)) - (setq from - (gnus-mail-strip-quoted-names - (or (mail-fetch-field "from") - (mail-fetch-field "really-from") - (mail-fetch-field "sender")))) - (goto-char (point-min)) - ;; Depending on what encoding is supposed to be used, we make - ;; a soup header. - (setq head-line - (cond - ((= gnus-soup-encoding-type ?n) - (format "#! rnews %d\n" (buffer-size))) - ((= gnus-soup-encoding-type ?m) - (while (search-forward "\nFrom " nil t) - (replace-match "\n>From " t t)) - (concat "From " (or from "unknown") - " " (current-time-string) "\n")) - ((= gnus-soup-encoding-type ?M) - "\^a\^a\^a\^a\n") - (t (error "Unsupported type: %c" gnus-soup-encoding-type)))) - ;; Insert the soup header and the article in the MSG buf. - (set-buffer msg-buf) - (goto-char (point-max)) - (insert head-line) - (setq beg (point)) - (insert-buffer-substring article-buf) - ;; Insert the index in the IDX buf. - (cond ((= index ?c) - (set-buffer idx-buf) - (gnus-soup-insert-idx beg headers)) - ((/= index ?n) - (error "Unknown index type: %c" type))) - ;; Return the MSG buf. - msg-buf))) - -(defun gnus-soup-group-brew (group &optional not-all) - "Enter GROUP and add all articles to a SOUP package. -If NOT-ALL, don't pack ticked articles." - (let ((gnus-expert-user t) - (gnus-large-newsgroup nil) - (entry (gnus-gethash group gnus-newsrc-hashtb))) - (when (or (null entry) - (eq (car entry) t) - (and (car entry) - (> (car entry) 0)) - (and (not not-all) - (gnus-range-length (cdr (assq 'tick (gnus-info-marks - (nth 2 entry))))))) - (when (gnus-summary-read-group group nil t) - (setq gnus-newsgroup-processable - (reverse - (if (not not-all) - (append gnus-newsgroup-marked gnus-newsgroup-unreads) - gnus-newsgroup-unreads))) - (gnus-soup-add-article nil) - (gnus-summary-exit))))) - -(defun gnus-soup-insert-idx (offset header) - ;; [number subject from date id references chars lines xref] - (goto-char (point-max)) - (insert - (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n" - offset - (or (mail-header-subject header) "(none)") - (or (mail-header-from header) "(nobody)") - (or (mail-header-date header) "") - (or (mail-header-id header) - (concat "soup-dummy-id-" - (mapconcat - (lambda (time) (int-to-string time)) - (current-time) "-"))) - (or (mail-header-references header) "") - (or (mail-header-chars header) 0) - (or (mail-header-lines header) "0")))) - -(defun gnus-soup-save-areas () - (gnus-soup-write-areas) - (save-excursion - (let (buf) - (while gnus-soup-buffers - (setq buf (car gnus-soup-buffers) - gnus-soup-buffers (cdr gnus-soup-buffers)) - (if (not (buffer-name buf)) - () - (set-buffer buf) - (when (buffer-modified-p) - (save-buffer)) - (kill-buffer (current-buffer))))) - (gnus-soup-write-prefixes))) - -(defun gnus-soup-write-prefixes () - (let ((prefixes gnus-soup-last-prefix) - prefix) - (save-excursion - (gnus-set-work-buffer) - (while (setq prefix (pop prefixes)) - (erase-buffer) - (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix))) - (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file)))))) - -(defun gnus-soup-pack (dir packer) - (let* ((files (mapconcat 'identity - '("AREAS" "*.MSG" "*.IDX" "INFO" - "LIST" "REPLIES" "COMMANDS" "ERRORS") - " ")) - (packer (if (< (string-match "%s" packer) - (string-match "%d" packer)) - (format packer files - (string-to-int (gnus-soup-unique-prefix dir))) - (format packer - (string-to-int (gnus-soup-unique-prefix dir)) - files))) - (dir (expand-file-name dir))) - (gnus-make-directory dir) - (setq gnus-soup-areas nil) - (gnus-message 4 "Packing %s..." packer) - (if (zerop (call-process shell-file-name - nil nil nil shell-command-switch - (concat "cd " dir " ; " packer))) - (progn - (call-process shell-file-name nil nil nil shell-command-switch - (concat "cd " dir " ; rm " files)) - (gnus-message 4 "Packing...done" packer)) - (error "Couldn't pack packet")))) - -(defun gnus-soup-parse-areas (file) - "Parse soup area file FILE. -The result is a of vectors, each containing one entry from the AREA file. -The vector contain five strings, - [prefix name encoding description number] -though the two last may be nil if they are missing." - (let (areas) - (save-excursion - (set-buffer (nnheader-find-file-noselect file 'force)) - (buffer-disable-undo (current-buffer)) - (goto-char (point-min)) - (while (not (eobp)) - (push (vector (gnus-soup-field) - (gnus-soup-field) - (gnus-soup-field) - (and (eq (preceding-char) ?\t) - (gnus-soup-field)) - (and (eq (preceding-char) ?\t) - (string-to-int (gnus-soup-field)))) - areas) - (when (eq (preceding-char) ?\t) - (beginning-of-line 2))) - (kill-buffer (current-buffer))) - areas)) - -(defun gnus-soup-parse-replies (file) - "Parse soup REPLIES file FILE. -The result is a of vectors, each containing one entry from the REPLIES -file. The vector contain three strings, [prefix name encoding]." - (let (replies) - (save-excursion - (set-buffer (nnheader-find-file-noselect file)) - (buffer-disable-undo (current-buffer)) - (goto-char (point-min)) - (while (not (eobp)) - (push (vector (gnus-soup-field) (gnus-soup-field) - (gnus-soup-field)) - replies) - (when (eq (preceding-char) ?\t) - (beginning-of-line 2))) - (kill-buffer (current-buffer))) - replies)) - -(defun gnus-soup-field () - (prog1 - (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point))) - (forward-char 1))) - -(defun gnus-soup-read-areas () - (or gnus-soup-areas - (setq gnus-soup-areas - (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS"))))) - -(defun gnus-soup-write-areas () - "Write the AREAS file." - (interactive) - (when gnus-soup-areas - (nnheader-temp-write (concat gnus-soup-directory "AREAS") - (let ((areas gnus-soup-areas) - area) - (while (setq area (pop areas)) - (insert - (format - "%s\t%s\t%s%s\n" - (gnus-soup-area-prefix area) - (gnus-soup-area-name area) - (gnus-soup-area-encoding area) - (if (or (gnus-soup-area-description area) - (gnus-soup-area-number area)) - (concat "\t" (or (gnus-soup-area-description - area) "") - (if (gnus-soup-area-number area) - (concat "\t" (int-to-string - (gnus-soup-area-number area))) - "")) "")))))))) - -(defun gnus-soup-write-replies (dir areas) - "Write a REPLIES file in DIR containing AREAS." - (nnheader-temp-write (concat dir "REPLIES") - (let (area) - (while (setq area (pop areas)) - (insert (format "%s\t%s\t%s\n" - (gnus-soup-reply-prefix area) - (gnus-soup-reply-kind area) - (gnus-soup-reply-encoding area))))))) - -(defun gnus-soup-area (group) - (gnus-soup-read-areas) - (let ((areas gnus-soup-areas) - (real-group (gnus-group-real-name group)) - area result) - (while areas - (setq area (car areas) - areas (cdr areas)) - (when (equal (gnus-soup-area-name area) real-group) - (setq result area))) - (unless result - (setq result - (vector (gnus-soup-unique-prefix) - real-group - (format "%c%c%c" - gnus-soup-encoding-type - gnus-soup-index-type - (if (gnus-member-of-valid 'mail group) ?m ?n)) - nil nil) - gnus-soup-areas (cons result gnus-soup-areas))) - result)) - -(defun gnus-soup-unique-prefix (&optional dir) - (let* ((dir (file-name-as-directory (or dir gnus-soup-directory))) - (entry (assoc dir gnus-soup-last-prefix)) - gnus-soup-prev-prefix) - (if entry - () - (when (file-exists-p (concat dir gnus-soup-prefix-file)) - (ignore-errors - (load (concat dir gnus-soup-prefix-file) nil t t))) - (push (setq entry (cons dir (or gnus-soup-prev-prefix 0))) - gnus-soup-last-prefix)) - (setcdr entry (1+ (cdr entry))) - (gnus-soup-write-prefixes) - (int-to-string (cdr entry)))) - -(defun gnus-soup-unpack-packet (dir unpacker packet) - "Unpack PACKET into DIR using UNPACKER. -Return whether the unpacking was successful." - (gnus-make-directory dir) - (gnus-message 4 "Unpacking: %s" (format unpacker packet)) - (prog1 - (zerop (call-process - shell-file-name nil nil nil shell-command-switch - (format "cd %s ; %s" (expand-file-name dir) - (format unpacker packet)))) - (gnus-message 4 "Unpacking...done"))) - -(defun gnus-soup-send-packet (packet) - (gnus-soup-unpack-packet - gnus-soup-replies-directory gnus-soup-unpacker packet) - (let ((replies (gnus-soup-parse-replies - (concat gnus-soup-replies-directory "REPLIES")))) - (save-excursion - (while replies - (let* ((msg-file (concat gnus-soup-replies-directory - (gnus-soup-reply-prefix (car replies)) - ".MSG")) - (msg-buf (and (file-exists-p msg-file) - (nnheader-find-file-noselect msg-file))) - (tmp-buf (get-buffer-create " *soup send*")) - beg end) - (cond - ((/= (gnus-soup-encoding-format - (gnus-soup-reply-encoding (car replies))) - ?n) - (error "Unsupported encoding")) - ((null msg-buf) - t) - (t - (buffer-disable-undo msg-buf) - (buffer-disable-undo tmp-buf) - (set-buffer msg-buf) - (goto-char (point-min)) - (while (not (eobp)) - (unless (looking-at "#! *rnews +\\([0-9]+\\)") - (error "Bad header")) - (forward-line 1) - (setq beg (point) - end (+ (point) (string-to-int - (buffer-substring - (match-beginning 1) (match-end 1))))) - (switch-to-buffer tmp-buf) - (erase-buffer) - (insert-buffer-substring msg-buf beg end) - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (insert mail-header-separator) - (setq message-newsreader (setq message-mailer - (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))) - ((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)) - (t - (error "Unknown reply kind"))) - (set-buffer msg-buf) - (goto-char end)) - (delete-file (buffer-file-name)) - (kill-buffer msg-buf) - (kill-buffer tmp-buf) - (gnus-message 4 "Sent packet")))) - (setq replies (cdr replies))) - t))) - -(provide 'gnus-soup) - -;;; gnus-soup.el ends here diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el deleted file mode 100644 index 60be10f..0000000 --- a/lisp/gnus-spec.el +++ /dev/null @@ -1,542 +0,0 @@ -;;; gnus-spec.el --- format spec functions for Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) - -;;; Internal variables. - -(defvar gnus-summary-mark-positions nil) -(defvar gnus-group-mark-positions nil) -(defvar gnus-group-indentation "") - -;; Format specs. The chunks below are the machine-generated forms -;; that are to be evaled as the result of the default format strings. -;; We write them in here to get them byte-compiled. That way the -;; default actions will be quite fast, while still retaining the full -;; flexibility of the user-defined format specs. - -;; First we have lots of dummy defvars to let the compiler know these -;; are really dynamic variables. - -(defvar gnus-tmp-unread) -(defvar gnus-tmp-replied) -(defvar gnus-tmp-score-char) -(defvar gnus-tmp-indentation) -(defvar gnus-tmp-opening-bracket) -(defvar gnus-tmp-lines) -(defvar gnus-tmp-name) -(defvar gnus-tmp-closing-bracket) -(defvar gnus-tmp-subject-or-nil) -(defvar gnus-tmp-subject) -(defvar gnus-tmp-marked) -(defvar gnus-tmp-marked-mark) -(defvar gnus-tmp-subscribed) -(defvar gnus-tmp-process-marked) -(defvar gnus-tmp-number-of-unread) -(defvar gnus-tmp-group-name) -(defvar gnus-tmp-group) -(defvar gnus-tmp-article-number) -(defvar gnus-tmp-unread-and-unselected) -(defvar gnus-tmp-news-method) -(defvar gnus-tmp-news-server) -(defvar gnus-tmp-article-number) -(defvar gnus-mouse-face) -(defvar gnus-mouse-face-prop) - -(defun gnus-summary-line-format-spec () - (insert gnus-tmp-unread gnus-tmp-replied - gnus-tmp-score-char gnus-tmp-indentation) - (gnus-put-text-property - (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) - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject-or-nil "\n")) - -(defvar gnus-summary-line-format-spec - (gnus-byte-code 'gnus-summary-line-format-spec)) - -(defun gnus-summary-dummy-line-format-spec () - (insert "* ") - (gnus-put-text-property - (point) - (progn - (insert ": :") - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject "\n")) - -(defvar gnus-summary-dummy-line-format-spec - (gnus-byte-code 'gnus-summary-dummy-line-format-spec)) - -(defun gnus-group-line-format-spec () - (insert gnus-tmp-marked-mark gnus-tmp-subscribed - gnus-tmp-process-marked - gnus-group-indentation - (format "%5s: " gnus-tmp-number-of-unread)) - (gnus-put-text-property - (point) - (progn - (insert gnus-tmp-group "\n") - (1- (point))) - gnus-mouse-face-prop gnus-mouse-face)) -(defvar gnus-group-line-format-spec - (gnus-byte-code 'gnus-group-line-format-spec)) - -(defvar gnus-format-specs - `((version . ,emacs-version) - (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec) - (summary-dummy "* %(: :%) %S\n" - ,gnus-summary-dummy-line-format-spec) - (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" - ,gnus-summary-line-format-spec)) - "Alist of format specs.") - -(defvar gnus-article-mode-line-format-spec nil) -(defvar gnus-summary-mode-line-format-spec nil) -(defvar gnus-group-mode-line-format-spec nil) - -;;; Phew. All that gruft is over, fortunately. - -;;;###autoload -(defun gnus-update-format (var) - "Update the format specification near point." - (interactive - (list - (save-excursion - (eval-defun nil) - ;; Find the end of the current word. - (re-search-forward "[ \t\n]" nil t) - ;; Search backward. - (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t) - (match-string 1))))) - (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var) - (match-string 1 var)))) - (entry (assq type gnus-format-specs)) - value spec) - (when entry - (setq gnus-format-specs (delq entry gnus-format-specs))) - (set - (intern (format "%s-spec" var)) - (gnus-parse-format (setq value (symbol-value (intern var))) - (symbol-value (intern (format "%s-alist" var))) - (not (string-match "mode" var)))) - (setq spec (symbol-value (intern (format "%s-spec" var)))) - (push (list type value spec) gnus-format-specs) - - (pop-to-buffer "*Gnus Format*") - (erase-buffer) - (lisp-interaction-mode) - (insert (pp-to-string spec)))) - -(defun gnus-update-format-specifications (&optional force &rest types) - "Update all (necessary) format specifications." - ;; Make the indentation array. - ;; See whether all the stored info needs to be flushed. - (when (or force - (not (equal emacs-version - (cdr (assq 'version gnus-format-specs))))) - (setq gnus-format-specs nil)) - - ;; Go through all the formats and see whether they need updating. - (let (new-format entry type val) - (while (setq type (pop types)) - ;; Jump to the proper buffer to find out the value of - ;; the variable, if possible. (It may be buffer-local.) - (save-excursion - (let ((buffer (intern (format "gnus-%s-buffer" type))) - val) - (when (and (boundp buffer) - (setq val (symbol-value buffer)) - (get-buffer val) - (buffer-name (get-buffer val))) - (set-buffer (get-buffer val))) - (setq new-format (symbol-value - (intern (format "gnus-%s-line-format" type))))) - (setq entry (cdr (assq type gnus-format-specs))) - (if (and (car entry) - (equal (car entry) new-format)) - ;; Use the old format. - (set (intern (format "gnus-%s-line-format-spec" type)) - (cadr entry)) - ;; This is a new format. - (setq val - (if (not (stringp new-format)) - ;; This is a function call or something. - new-format - ;; This is a "real" format. - (gnus-parse-format - new-format - (symbol-value - (intern (format "gnus-%s-line-format-alist" - (if (eq type 'article-mode) - 'summary-mode type)))) - (not (string-match "mode$" (symbol-name type)))))) - ;; Enter the new format spec into the list. - (if entry - (progn - (setcar (cdr entry) val) - (setcar entry new-format)) - (push (list type new-format val) gnus-format-specs)) - (set (intern (format "gnus-%s-line-format-spec" type)) val))))) - - (unless (assq 'version gnus-format-specs) - (push (cons 'version emacs-version) gnus-format-specs))) - -(defvar gnus-mouse-face-0 'highlight) -(defvar gnus-mouse-face-1 'highlight) -(defvar gnus-mouse-face-2 'highlight) -(defvar gnus-mouse-face-3 'highlight) -(defvar gnus-mouse-face-4 'highlight) - -(defun gnus-mouse-face-function (form type) - `(gnus-put-text-property - (point) (progn ,@form (point)) - gnus-mouse-face-prop - ,(if (equal type 0) - 'gnus-mouse-face - `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type))))))) - -(defvar gnus-face-0 'bold) -(defvar gnus-face-1 'italic) -(defvar gnus-face-2 'bold-italic) -(defvar gnus-face-3 'bold) -(defvar gnus-face-4 'bold) - -(defun gnus-face-face-function (form type) - `(gnus-put-text-property - (point) (progn ,@form (point)) - 'face ',(symbol-value (intern (format "gnus-face-%d" type))))) - -(defun gnus-tilde-max-form (el max-width) - "Return a form that limits EL to MAX-WIDTH." - (let ((max (abs max-width))) - (if (symbolp el) - `(if (> (length ,el) ,max) - ,(if (< max-width 0) - `(substring ,el (- (length el) ,max)) - `(substring ,el 0 ,max)) - ,el) - `(let ((val (eval ,el))) - (if (> (length val) ,max) - ,(if (< max-width 0) - `(substring val (- (length val) ,max)) - `(substring 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))) - (if (symbolp el) - `(if (> (length ,el) ,cut) - ,(if (< cut-width 0) - `(substring ,el 0 (- (length el) ,cut)) - `(substring ,el ,cut)) - ,el) - `(let ((val (eval ,el))) - (if (> (length val) ,cut) - ,(if (< cut-width 0) - `(substring val 0 (- (length val) ,cut)) - `(substring val ,cut)) - val))))) - -(defun gnus-tilde-ignore-form (el ignore-value) - "Return a form that is blank when EL is IGNORE-VALUE." - (if (symbolp el) - `(if (equal ,el ,ignore-value) - "" ,el) - `(let ((val (eval ,el))) - (if (equal val ,ignore-value) - "" 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 - ;; string. If the FORMAT string contains the specifiers %( and %) - ;; the text between them will have the mouse-face 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))) - -(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 ?\{)) - (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face") - " " 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))))) - -(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) - (funcall (intern (format "gnus-%s-face-function" (car sform))) - (gnus-complex-form-to-spec (cddr sform) spec-alist) - (nth 1 sform)))) - form))) - -(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 ((max-width 0) - spec flist fstring elem result dontinsert user-defined - type value pad-width spec-beg cut-width ignore-value - tilde-form tilde elem-type) - (save-excursion - (gnus-set-work-buffer) - (insert format) - (goto-char (point-min)) - (while (re-search-forward "%" nil t) - (setq user-defined nil - spec-beg nil - pad-width nil - max-width nil - cut-width nil - ignore-value nil - tilde-form nil) - (setq spec-beg (1- (point))) - - ;; Parse this spec fully. - (while - (cond - ((looking-at "\\([-.0-9]+\\)\\(,[-0-9]+\\)?") - (setq pad-width (string-to-number (match-string 1))) - (when (match-beginning 2) - (setq max-width (string-to-number (buffer-substring - (1+ (match-beginning 2)) - (match-end 2))))) - (goto-char (match-end 0))) - ((looking-at "~") - (forward-char 1) - (setq tilde (read (current-buffer)) - type (car tilde) - value (cadr tilde)) - (cond - ((memq type '(pad pad-left)) - (setq pad-width value)) - ((eq type 'pad-right) - (setq pad-width (- value))) - ((memq type '(max-right max)) - (setq max-width value)) - ((eq type 'max-left) - (setq max-width (- value))) - ((memq type '(cut cut-left)) - (setq cut-width value)) - ((eq type 'cut-right) - (setq cut-width (- value))) - ((eq type 'ignore) - (setq ignore-value - (if (stringp value) value (format "%s" value)))) - ((eq type 'form) - (setq tilde-form value)) - (t - (error "Unknown tilde type: %s" tilde))) - t) - (t - nil))) - ;; User-defined spec -- find the spec name. - (when (= (setq spec (following-char)) ?u) - (forward-char 1) - (setq user-defined (following-char))) - (forward-char 1) - (delete-region spec-beg (point)) - - ;; Now we have all the relevant data on this spec, so - ;; we start doing stuff. - (insert "%") - (if (eq spec ?%) - ;; "%%" just results in a "%". - (insert "%") - (cond - ;; Do tilde forms. - ((eq spec ?@) - (setq elem (list tilde-form ?s))) - ;; Treat user defined format specifiers specially. - (user-defined - (setq elem - (list - (list (intern (format "gnus-user-format-function-%c" - user-defined)) - 'gnus-tmp-header) - ?s))) - ;; Find the specification from `spec-alist'. - ((setq elem (cdr (assq spec spec-alist)))) - (t - (setq elem '("*" ?s)))) - (setq elem-type (cadr elem)) - ;; Insert the new format elements. - (when pad-width - (insert (number-to-string pad-width))) - ;; Create the form to be evaled. - (if (or max-width cut-width ignore-value) - (progn - (insert ?s) - (let ((el (car elem))) - (cond ((= (cadr elem) ?c) - (setq el (list 'char-to-string el))) - ((= (cadr elem) ?d) - (setq el (list 'int-to-string el)))) - (when ignore-value - (setq el (gnus-tilde-ignore-form el ignore-value))) - (when cut-width - (setq el (gnus-tilde-cut-form el cut-width))) - (when max-width - (setq el (gnus-tilde-max-form el max-width))) - (push el flist))) - (insert elem-type) - (push (car elem) flist)))) - (setq fstring (buffer-string))) - - ;; Do some postprocessing to increase efficiency. - (setq - result - (cond - ;; Emptyness. - ((string= fstring "") - nil) - ;; Not a format string. - ((not (string-match "%" fstring)) - (list fstring)) - ;; A format string with just a single string spec. - ((string= fstring "%s") - (list (car flist))) - ;; A single character. - ((string= fstring "%c") - (list (car flist))) - ;; A single number. - ((string= fstring "%d") - (setq dontinsert) - (if insert - (list `(princ ,(car flist))) - (list `(int-to-string ,(car flist))))) - ;; Just lots of chars and strings. - ((string-match "\\`\\(%[cs]\\)+\\'" fstring) - (nreverse flist)) - ;; A single string spec at the beginning of the spec. - ((string-match "\\`%[sc][^%]+\\'" fstring) - (list (car flist) (substring fstring 2))) - ;; A single string spec in the middle of the spec. - ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring) - (list (match-string 1 fstring) (car flist) (match-string 2 fstring))) - ;; A single string spec in the end of the spec. - ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring) - (list (match-string 1 fstring) (car flist))) - ;; A more complex spec. - (t - (list (cons 'format (cons fstring (nreverse flist))))))) - - (if insert - (when result - (if dontinsert - result - (cons 'insert result))) - (cond ((stringp result) - result) - ((consp result) - (cons 'concat result)) - (t ""))))) - -(defun gnus-eval-format (format &optional alist props) - "Eval the format variable FORMAT, using ALIST. -If PROPS, insert the result." - (let ((form (gnus-parse-format format alist props))) - (if props - (gnus-add-text-properties (point) (progn (eval form) (point)) props) - (eval form)))) - -(defun gnus-compile () - "Byte-compile the user-defined format specs." - (interactive) - (require 'bytecomp) - (let ((entries gnus-format-specs) - (byte-compile-warnings '(unresolved callargs redefine)) - entry gnus-tmp-func) - (save-excursion - (gnus-message 7 "Compiling format specs...") - - (while entries - (setq entry (pop entries)) - (if (eq (car entry) 'version) - (setq gnus-format-specs (delq entry gnus-format-specs)) - (let ((form (caddr entry))) - (when (and (listp form) - ;; Under GNU Emacs, it's (byte-code ...) - (not (eq 'byte-code (car form))) - ;; Under XEmacs, it's (funcall #) - (not (and (eq 'funcall (car form)) - (compiled-function-p (cadr form))))) - (fset 'gnus-tmp-func `(lambda () ,form)) - (byte-compile 'gnus-tmp-func) - (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))) - - (push (cons 'version emacs-version) gnus-format-specs) - ;; Mark the .newsrc.eld file as "dirty". - (gnus-dribble-enter " ") - (gnus-message 7 "Compiling user specs...done")))) - -(defun gnus-set-format (type &optional insertable) - (set (intern (format "gnus-%s-line-format-spec" type)) - (gnus-parse-format - (symbol-value (intern (format "gnus-%s-line-format" type))) - (symbol-value (intern (format "gnus-%s-line-format-alist" type))) - insertable))) - - -(provide 'gnus-spec) - -;;; gnus-spec.el ends here diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el deleted file mode 100644 index 32b2ade..0000000 --- a/lisp/gnus-srvr.el +++ /dev/null @@ -1,766 +0,0 @@ -;;; gnus-srvr.el --- virtual server support for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-spec) -(require 'gnus-group) -(require 'gnus-int) -(require 'gnus-range) - -(defvar gnus-server-mode-hook nil - "Hook run in `gnus-server-mode' buffers.") - -(defconst gnus-server-line-format " {%(%h:%w%)} %s\n" - "Format of server lines. -It works along the same lines as a normal formatting string, -with some simple extensions. - -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.") - -;;; Internal variables. - -(defvar gnus-inserted-opened-servers nil) - -(defvar gnus-server-line-format-alist - `((?h how ?s) - (?n name ?s) - (?w where ?s) - (?s status ?s))) - -(defvar gnus-server-mode-line-format-alist - `((?S news-server ?s) - (?M news-method ?s) - (?u user-defined ?s))) - -(defvar gnus-server-line-format-spec nil) -(defvar gnus-server-mode-line-format-spec nil) -(defvar gnus-server-killed-servers nil) - -(defvar gnus-server-mode-map) - -(defvar gnus-server-menu-hook nil - "*Hook run after the creation of the server mode menu.") - -(defun gnus-server-make-menu-bar () - (gnus-turn-off-edit-menu 'server) - (unless (boundp 'gnus-server-server-menu) - (easy-menu-define - gnus-server-server-menu gnus-server-mode-map "" - '("Server" - ["Add" gnus-server-add-server t] - ["Browse" gnus-server-read-server t] - ["Scan" gnus-server-scan-server t] - ["List" gnus-server-list-servers t] - ["Kill" gnus-server-kill-server t] - ["Yank" gnus-server-yank-server t] - ["Copy" gnus-server-copy-server t] - ["Edit" gnus-server-edit-server t] - ["Regenerate" gnus-server-regenerate-server t] - ["Exit" gnus-server-exit t])) - - (easy-menu-define - gnus-server-connections-menu gnus-server-mode-map "" - '("Connections" - ["Open" gnus-server-open-server t] - ["Close" gnus-server-close-server t] - ["Deny" gnus-server-deny-server t] - "---" - ["Open All" gnus-server-open-all-servers t] - ["Close All" gnus-server-close-all-servers t] - ["Reset All" gnus-server-remove-denials t])) - - (gnus-run-hooks 'gnus-server-menu-hook))) - -(defvar gnus-server-mode-map nil) -(put 'gnus-server-mode 'mode-class 'special) - -(unless gnus-server-mode-map - (setq gnus-server-mode-map (make-sparse-keymap)) - (suppress-keymap gnus-server-mode-map) - - (gnus-define-keys gnus-server-mode-map - " " gnus-server-read-server - "\r" gnus-server-read-server - gnus-mouse-2 gnus-server-pick-server - "q" gnus-server-exit - "l" gnus-server-list-servers - "k" gnus-server-kill-server - "y" gnus-server-yank-server - "c" gnus-server-copy-server - "a" gnus-server-add-server - "e" gnus-server-edit-server - "s" gnus-server-scan-server - - "O" gnus-server-open-server - "\M-o" gnus-server-open-all-servers - "C" gnus-server-close-server - "\M-c" gnus-server-close-all-servers - "D" gnus-server-deny-server - "R" gnus-server-remove-denials - - "g" gnus-server-regenerate-server - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) - -(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]'). - -The following commands are available: - -\\{gnus-server-mode-map}" - (interactive) - (when (gnus-visual-p 'server-menu 'menu) - (gnus-server-make-menu-bar)) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-server-mode) - (setq mode-name "Server") - (gnus-set-default-directory) - (setq mode-line-process nil) - (use-local-map gnus-server-mode-map) - (buffer-disable-undo (current-buffer)) - (setq truncate-lines t) - (setq buffer-read-only t) - (gnus-run-hooks 'gnus-server-mode-hook)) - -(defun gnus-server-insert-server-line (name method) - (let* ((how (car method)) - (where (nth 1 method)) - (elem (assoc method gnus-opened-servers)) - (status (cond ((eq (nth 1 elem) 'denied) - "(denied)") - ((or (gnus-server-opened method) - (eq (nth 1 elem) 'ok)) - "(opened)") - (t - "(closed)")))) - (beginning-of-line) - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - ;; Insert the text. - (eval gnus-server-line-format-spec)) - (list 'gnus-server (intern name))))) - -(defun gnus-enter-server-buffer () - "Set up the server buffer." - (gnus-server-setup-buffer) - (gnus-configure-windows 'server) - (gnus-server-prepare)) - -(defun gnus-server-setup-buffer () - "Initialize the server buffer." - (unless (get-buffer gnus-server-buffer) - (save-excursion - (set-buffer (get-buffer-create gnus-server-buffer)) - (gnus-server-mode) - (when gnus-carpal - (gnus-carpal-setup-buffer 'server))))) - -(defun gnus-server-prepare () - (gnus-set-format 'server-mode) - (gnus-set-format 'server t) - (let ((alist gnus-server-alist) - (buffer-read-only nil) - (opened gnus-opened-servers) - done server op-ser) - (erase-buffer) - (setq gnus-inserted-opened-servers nil) - ;; First we do the real list of servers. - (while alist - (unless (member (cdar alist) done) - (push (cdar alist) done) - (cdr (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) - (pop alist))) - ;; Then we insert the list of servers that have been opened in - ;; this session. - (while opened - (when (and (not (member (caar opened) done)) - ;; Just ignore ephemeral servers. - (not (member (caar opened) gnus-ephemeral-servers))) - (push (caar opened) done) - (gnus-server-insert-server-line - (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened)))) - (caar opened)) - (push (list op-ser (caar opened)) gnus-inserted-opened-servers)) - (setq opened (cdr opened)))) - (goto-char (point-min)) - (gnus-server-position-point)) - -(defun gnus-server-server-name () - (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server))) - (and server (symbol-name server)))) - -(defalias 'gnus-server-position-point 'gnus-goto-colon) - -(defconst gnus-server-edit-buffer "*Gnus edit server*") - -(defun gnus-server-update-server (server) - (save-excursion - (set-buffer gnus-server-buffer) - (let* ((buffer-read-only nil) - (entry (assoc server gnus-server-alist)) - (oentry (assoc (gnus-server-to-method server) - gnus-opened-servers))) - (when entry - (gnus-dribble-enter - (concat "(gnus-server-set-info \"" server "\" '" - (prin1-to-string (cdr entry)) ")\n"))) - (when (or entry oentry) - ;; Buffer may be narrowed. - (save-restriction - (widen) - (when (gnus-server-goto-server server) - (gnus-delete-line)) - (if entry - (gnus-server-insert-server-line (car entry) (cdr entry)) - (gnus-server-insert-server-line - (format "%s:%s" (caar oentry) (nth 1 (car oentry))) - (car oentry))) - (gnus-server-position-point)))))) - -(defun gnus-server-set-info (server info) - ;; Enter a select method into the virtual server alist. - (when (and server info) - (gnus-dribble-enter - (concat "(gnus-server-set-info \"" server "\" '" - (prin1-to-string info) ")")) - (let* ((server (nth 1 info)) - (entry (assoc server gnus-server-alist))) - (if entry (setcdr entry info) - (setq gnus-server-alist - (nconc gnus-server-alist (list (cons server info)))))))) - -;;; Interactive server functions. - -(defun gnus-server-kill-server (server) - "Kill the server on the current line." - (interactive (list (gnus-server-server-name))) - (unless (gnus-server-goto-server server) - (if server (error "No such server: %s" server) - (error "No server on the current line"))) - (unless (assoc server gnus-server-alist) - (error "Read-only server %s" server)) - (gnus-dribble-enter "") - (let ((buffer-read-only nil)) - (gnus-delete-line)) - (push (assoc server gnus-server-alist) gnus-server-killed-servers) - (setq gnus-server-alist (delq (car gnus-server-killed-servers) - gnus-server-alist)) - (gnus-server-position-point)) - -(defun gnus-server-yank-server () - "Yank the previously killed server." - (interactive) - (unless gnus-server-killed-servers - (error "No killed servers to be yanked")) - (let ((alist gnus-server-alist) - (server (gnus-server-server-name)) - (killed (car gnus-server-killed-servers))) - (if (not server) - (setq gnus-server-alist (nconc gnus-server-alist (list killed))) - (if (string= server (caar gnus-server-alist)) - (push killed gnus-server-alist) - (while (and (cdr alist) - (not (string= server (caadr alist)))) - (setq alist (cdr alist))) - (if alist - (setcdr alist (cons killed (cdr alist))) - (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))) - -(defun gnus-server-exit () - "Return to the group buffer." - (interactive) - (gnus-run-hooks 'gnus-server-exit-hook) - (kill-buffer (current-buffer)) - (gnus-configure-windows 'group t)) - -(defun gnus-server-list-servers () - "List all available servers." - (interactive) - (let ((cur (gnus-server-server-name))) - (gnus-server-prepare) - (if cur (gnus-server-goto-server cur) - (goto-char (point-max)) - (forward-line -1)) - (gnus-server-position-point))) - -(defun gnus-server-set-status (method status) - "Make METHOD have STATUS." - (let ((entry (assoc method gnus-opened-servers))) - (if entry - (setcar (cdr entry) status) - (push (list method status) gnus-opened-servers)))) - -(defun gnus-opened-servers-remove (method) - "Remove METHOD from the list of opened servers." - (setq gnus-opened-servers (delq (assoc method gnus-opened-servers) - gnus-opened-servers))) - -(defun gnus-server-open-server (server) - "Force an open of SERVER." - (interactive (list (gnus-server-server-name))) - (let ((method (gnus-server-to-method server))) - (unless method - (error "No such server: %s" server)) - (gnus-server-set-status method 'ok) - (prog1 - (or (gnus-open-server method) - (progn (message "Couldn't open %s" server) nil)) - (gnus-server-update-server server) - (gnus-server-position-point)))) - -(defun gnus-server-open-all-servers () - "Open all servers." - (interactive) - (let ((servers gnus-inserted-opened-servers)) - (while servers - (gnus-server-open-server (car (pop servers)))))) - -(defun gnus-server-close-server (server) - "Close SERVER." - (interactive (list (gnus-server-server-name))) - (let ((method (gnus-server-to-method server))) - (unless method - (error "No such server: %s" server)) - (gnus-server-set-status method 'closed) - (prog1 - (gnus-close-server method) - (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)))))) - -(defun gnus-server-deny-server (server) - "Make sure SERVER will never be attempted opened." - (interactive (list (gnus-server-server-name))) - (let ((method (gnus-server-to-method server))) - (unless method - (error "No such server: %s" server)) - (gnus-server-set-status method 'denied)) - (gnus-server-update-server server) - (gnus-server-position-point) - t) - -(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)))) - (gnus-server-list-servers)) - -(defun gnus-server-copy-server (from to) - (interactive - (list - (or (gnus-server-server-name) - (error "No server on the current line")) - (read-string "Copy to: "))) - (unless from - (error "No server on current line")) - (unless (and to (not (string= to ""))) - (error "No name to copy to")) - (when (assoc to gnus-server-alist) - (error "%s already exists" to)) - (unless (gnus-server-to-method from) - (error "%s: no such server" from)) - (let ((to-entry (cons from (gnus-copy-sequence - (gnus-server-to-method from))))) - (setcar to-entry to) - (setcar (nthcdr 2 to-entry) to) - (push to-entry gnus-server-killed-servers) - (gnus-server-yank-server))) - -(defun gnus-server-add-server (how where) - (interactive - (list (intern (completing-read "Server method: " - gnus-valid-select-methods nil t)) - (read-string "Server name: "))) - (when (assq where gnus-server-alist) - (error "Server with that name already defined")) - (push (list where how where) gnus-server-killed-servers) - (gnus-server-yank-server)) - -(defun gnus-server-goto-server (server) - "Jump to a server line." - (interactive - (list (completing-read "Goto server: " gnus-server-alist nil t))) - (let ((to (text-property-any (point-min) (point-max) - 'gnus-server (intern server)))) - (when to - (goto-char to) - (gnus-server-position-point)))) - -(defun gnus-server-edit-server (server) - "Edit the server on the current line." - (interactive (list (gnus-server-server-name))) - (unless server - (error "No server on current line")) - (unless (assoc server gnus-server-alist) - (error "This server can't be edited")) - (let ((info (cdr (assoc server gnus-server-alist)))) - (gnus-close-server info) - (gnus-edit-form - info "Editing the server." - `(lambda (form) - (gnus-server-set-info ,server form) - (gnus-server-list-servers) - (gnus-server-position-point))))) - -(defun gnus-server-scan-server (server) - "Request a scan from the current server." - (interactive (list (gnus-server-server-name))) - (gnus-message 3 "Scanning %s...done" server) - (gnus-request-scan nil (gnus-server-to-method server)) - (gnus-message 3 "Scanning %s...done" server)) - -(defun gnus-server-read-server (server) - "Browse a server." - (interactive (list (gnus-server-server-name))) - (let ((buf (current-buffer))) - (prog1 - (gnus-browse-foreign-server server buf) - (save-excursion - (set-buffer buf) - (gnus-server-update-server (gnus-server-server-name)) - (gnus-server-position-point))))) - -(defun gnus-server-pick-server (e) - (interactive "e") - (mouse-set-point e) - (gnus-server-read-server (gnus-server-server-name))) - - -;;; -;;; Browse Server Mode -;;; - -(defvar gnus-browse-menu-hook nil - "*Hook run after the creation of the browse mode menu.") - -(defvar gnus-browse-mode-hook nil) -(defvar gnus-browse-mode-map nil) -(put 'gnus-browse-mode 'mode-class 'special) - -(unless gnus-browse-mode-map - (setq gnus-browse-mode-map (make-keymap)) - (suppress-keymap gnus-browse-mode-map) - - (gnus-define-keys - gnus-browse-mode-map - " " gnus-browse-read-group - "=" gnus-browse-select-group - "n" gnus-browse-next-group - "p" gnus-browse-prev-group - "\177" gnus-browse-prev-group - [delete] gnus-browse-prev-group - "N" gnus-browse-next-group - "P" gnus-browse-prev-group - "\M-n" gnus-browse-next-group - "\M-p" gnus-browse-prev-group - "\r" gnus-browse-select-group - "u" gnus-browse-unsubscribe-current-group - "l" gnus-browse-exit - "L" gnus-browse-exit - "q" gnus-browse-exit - "Q" gnus-browse-exit - "\C-c\C-c" gnus-browse-exit - "?" gnus-browse-describe-briefly - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) - -(defun gnus-browse-make-menu-bar () - (gnus-turn-off-edit-menu 'browse) - (unless (boundp 'gnus-browse-menu) - (easy-menu-define - gnus-browse-menu gnus-browse-mode-map "" - '("Browse" - ["Subscribe" gnus-browse-unsubscribe-current-group t] - ["Read" gnus-browse-read-group t] - ["Select" gnus-browse-read-group t] - ["Next" gnus-browse-next-group t] - ["Prev" gnus-browse-next-group t] - ["Exit" gnus-browse-exit t])) - (gnus-run-hooks 'gnus-browse-menu-hook))) - -(defvar gnus-browse-current-method nil) -(defvar gnus-browse-return-buffer nil) - -(defvar gnus-browse-buffer "*Gnus Browse Server*") - -(defun gnus-browse-foreign-server (server &optional return-buffer) - "Browse the server SERVER." - (setq gnus-browse-current-method server) - (setq gnus-browse-return-buffer return-buffer) - (let* ((method (gnus-server-to-method server)) - (gnus-select-method method) - groups group) - (gnus-message 5 "Connecting to %s..." (nth 1 method)) - (cond - ((not (gnus-check-server method)) - (gnus-message - 1 "Unable to contact server %s: %s" (nth 1 method) - (gnus-status-message method)) - nil) - ((not - (prog2 - (gnus-message 6 "Reading active file...") - (gnus-request-list method) - (gnus-message 6 "Reading active file...done"))) - (gnus-message - 1 "Couldn't request list: %s" (gnus-status-message method)) - nil) - (t - (get-buffer-create gnus-browse-buffer) - (gnus-add-current-to-buffer-list) - (when gnus-carpal - (gnus-carpal-setup-buffer 'browse)) - (gnus-configure-windows 'browse) - (buffer-disable-undo (current-buffer)) - (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 (re-search-forward - "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t) - (goto-char (match-end 1)) - (push (cons (match-string 1) - (max 0 (- (1+ (read cur)) (read cur)))) - groups)))) - (setq groups (sort groups - (lambda (l1 l2) - (string< (car l1) (car l2))))) - (let ((buffer-read-only nil)) - (while groups - (setq group (car groups)) - (insert - (format "K%7d: %s\n" (cdr group) (car group))) - (setq groups (cdr groups)))) - (switch-to-buffer (current-buffer)) - (goto-char (point-min)) - (gnus-group-position-point) - (gnus-message 5 "Connecting to %s...done" (nth 1 method)) - t)))) - -(defun gnus-browse-mode () - "Major mode for browsing a foreign server. - -All normal editing commands are switched off. - -\\ -The only things you can do in this buffer is - -1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group. -The group will be inserted into the group buffer upon exit from this -buffer. - -2) `\\[gnus-browse-read-group]' to read a group ephemerally. - -3) `\\[gnus-browse-exit]' to return to the group buffer." - (interactive) - (kill-all-local-variables) - (when (gnus-visual-p 'browse-menu 'menu) - (gnus-browse-make-menu-bar)) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-browse-mode) - (setq mode-name "Browse Server") - (setq mode-line-process nil) - (use-local-map gnus-browse-mode-map) - (buffer-disable-undo (current-buffer)) - (setq truncate-lines t) - (gnus-set-default-directory) - (setq buffer-read-only t) - (gnus-run-hooks 'gnus-browse-mode-hook)) - -(defun gnus-browse-read-group (&optional no-article) - "Enter the group at the current line." - (interactive) - (let ((group (gnus-browse-group-name))) - (unless (gnus-group-read-ephemeral-group - group gnus-browse-current-method nil - (cons (current-buffer) 'browse)) - (error "Couldn't enter %s" group)))) - -(defun gnus-browse-select-group () - "Select the current group." - (interactive) - (gnus-browse-read-group 'no)) - -(defun gnus-browse-next-group (n) - "Go to the next group." - (interactive "p") - (prog1 - (forward-line n) - (gnus-group-position-point))) - -(defun gnus-browse-prev-group (n) - "Go to the next group." - (interactive "p") - (gnus-browse-next-group (- n))) - -(defun gnus-browse-unsubscribe-current-group (arg) - "(Un)subscribe to the next ARG groups." - (interactive "p") - (when (eobp) - (error "No group at current line")) - (let ((ward (if (< arg 0) -1 1)) - (arg (abs arg))) - (while (and (> arg 0) - (not (eobp)) - (gnus-browse-unsubscribe-group) - (zerop (gnus-browse-next-group ward))) - (decf arg)) - (gnus-group-position-point) - (when (/= 0 arg) - (gnus-message 7 "No more newsgroups")) - arg)) - -(defun gnus-browse-group-name () - (save-excursion - (beginning-of-line) - (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) - (gnus-group-prefixed-name - ;; Remove text props. - (format "%s" (match-string 1)) - gnus-browse-current-method)))) - -(defun gnus-browse-unsubscribe-group () - "Toggle subscription of the current group in the browse buffer." - (let ((sub nil) - (buffer-read-only nil) - group) - (save-excursion - (beginning-of-line) - ;; If this group it killed, then we want to subscribe it. - (when (= (following-char) ?K) - (setq sub t)) - (when (cadr (gnus-gethash (setq group (gnus-browse-group-name)) - gnus-newsrc-hashtb)) - (error "Group already subscribed")) - ;; Make sure the group has been properly removed before we - ;; subscribe to it. - (gnus-kill-ephemeral-group group) - (delete-char 1) - (if sub - (progn - (gnus-group-change-level - (list t group gnus-level-default-subscribed - nil nil (if (gnus-server-equal - gnus-browse-current-method "native") - nil - gnus-browse-current-method)) - gnus-level-default-subscribed gnus-level-killed - (and (car (nth 1 gnus-newsrc-alist)) - (gnus-gethash (car (nth 1 gnus-newsrc-alist)) - gnus-newsrc-hashtb)) - t) - (insert ? )) - (gnus-group-change-level - group gnus-level-killed gnus-level-default-subscribed) - (insert ?K))) - 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))) - ;; Insert the newly subscribed groups in the group buffer. - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-list-groups nil)) - (if gnus-browse-return-buffer - (gnus-configure-windows 'server 'force) - (gnus-configure-windows 'group 'force))) - -(defun gnus-browse-describe-briefly () - "Give a one line description of the group mode commands." - (interactive) - (gnus-message 6 - (substitute-command-keys "\\\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"))) - -(defun gnus-server-regenerate-server () - "Issue a command to the server to regenerate all its data structures." - (interactive) - (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))))) - -(provide 'gnus-srvr) - -;;; gnus-srvr.el ends here. diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el deleted file mode 100644 index 66bb153..0000000 --- a/lisp/gnus-start.el +++ /dev/null @@ -1,2528 +0,0 @@ -;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-win) -(require 'gnus-int) -(require 'gnus-spec) -(require 'gnus-range) -(require 'gnus-util) -(require 'message) -(eval-when-compile (require 'cl)) - -(defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc") - "*Your `.newsrc' file. -`.newsrc-SERVER' will be used instead if that exists." - :group 'gnus-start - :type 'file) - -(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." - :group 'gnus-start - :type 'file) - -(defcustom gnus-site-init-file - (condition-case nil - (concat (file-name-directory - (directory-file-name installation-directory)) - "site-lisp/gnus-init") - (error nil)) - "*The site-wide Gnus Emacs-Lisp startup file name, or nil if none. -If a file with the `.el' or `.elc' suffixes exists, it will be read instead." - :group 'gnus-start - :type '(choice file (const nil))) - -(defcustom gnus-default-subscribed-newsgroups nil - "*List of newsgroups to subscribe, when a user runs Gnus the first time. -The value should be a list of strings. -If it is t, Gnus will not do anything special the first time it is -started; it'll just use the normal newsgroups subscription methods." - :group 'gnus-start - :type '(choice (repeat string) (const :tag "Nothing special" t))) - -(defcustom gnus-use-dribble-file t - "*Non-nil means that Gnus will use a dribble file to store user updates. -If Emacs should crash without saving the .newsrc files, complete -information can be restored from the dribble file." - :group 'gnus-dribble-file - :type 'boolean) - -(defcustom gnus-dribble-directory nil - "*The directory where dribble files will be saved. -If this variable is nil, the directory where the .newsrc files are -saved will be used." - :group 'gnus-dribble-file - :type '(choice directory (const nil))) - -(defcustom gnus-check-new-newsgroups 'ask-server - "*Non-nil means that Gnus will run `gnus-find-new-newsgroups' at startup. -This normally finds new newsgroups by comparing the active groups the -servers have already reported with those Gnus already knows, either alive -or killed. - -When any of the following are true, `gnus-find-new-newsgroups' will instead -ask the servers (primary, secondary, and archive servers) to list new -groups since the last time it checked: - 1. This variable is `ask-server'. - 2. This variable is a list of select methods (see below). - 3. `gnus-read-active-file' is nil or `some'. - 4. A prefix argument is given to `gnus-find-new-newsgroups' interactively. - -Thus, if this variable is `ask-server' or a list of select methods or -`gnus-read-active-file' is nil or `some', then the killed list is no -longer necessary, so you could safely set `gnus-save-killed-list' to nil. - -This variable can be a list of select methods which Gnus will query with -the `ask-server' method in addition to the primary, secondary, and archive -servers. - -Eg. - (setq gnus-check-new-newsgroups - '((nntp \"some.server\") (nntp \"other.server\"))) - -If this variable is nil, then you have to tell Gnus explicitly to -check for new newsgroups with \\\\[gnus-find-new-newsgroups]." - :group 'gnus-start - :type '(choice (const :tag "no" nil) - (const :tag "by brute force" t) - (const :tag "ask servers" ask-server) - (repeat :menu-tag "ask additional servers" - :tag "ask additional servers" - :value ((nntp "")) - (sexp :format "%v")))) - -(defcustom gnus-check-bogus-newsgroups nil - "*Non-nil means that Gnus will check and remove bogus newsgroup at startup. -If this variable is nil, then you have to tell Gnus explicitly to -check for bogus newsgroups with \\\\[gnus-group-check-bogus-groups]." - :group 'gnus-start-server - :type 'boolean) - -(defcustom gnus-read-active-file 'some - "*Non-nil means that Gnus will read the entire active file at startup. -If this variable is nil, Gnus will only know about the groups in your -`.newsrc' file. - -If this variable is `some', Gnus will try to only read the relevant -parts of the active file from the server. Not all servers support -this, and it might be quite slow with other servers, but this should -generally be faster than both the t and nil value. - -If you set this variable to nil or `some', you probably still want to -be told about new newsgroups that arrive. To do that, set -`gnus-check-new-newsgroups' to `ask-server'. This may not work -properly with all servers." - :group 'gnus-start-server - :type '(choice (const nil) - (const some) - (const t))) - -(defcustom gnus-level-subscribed 5 - "*Groups with levels less than or equal to this variable are subscribed." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-level-unsubscribed 7 - "*Groups with levels less than or equal to this variable are unsubscribed. -Groups with levels less than `gnus-level-subscribed', which should be -less than this variable, are subscribed." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-level-zombie 8 - "*Groups with this level are zombie groups." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-level-killed 9 - "*Groups with this level are killed." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-level-default-subscribed 3 - "*New subscribed groups will be subscribed at this level." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-level-default-unsubscribed 6 - "*New unsubscribed groups will be unsubscribed at this level." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-activate-level (1+ gnus-level-subscribed) - "*Groups higher than this level won't be activated on startup. -Setting this variable to something low might save lots of time when -you have many groups that you aren't interested in." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-activate-foreign-newsgroups 4 - "*If nil, Gnus will not check foreign newsgroups at startup. -If it is non-nil, it should be a number between one and nine. Foreign -newsgroups that have a level lower or equal to this number will be -activated on startup. For instance, if you want to active all -subscribed newsgroups, but not the rest, you'd set this variable to -`gnus-level-subscribed'. - -If you subscribe to lots of newsgroups from different servers, startup -might take a while. By setting this variable to nil, you'll save time, -but you won't be told how many unread articles there are in the -groups." - :group 'gnus-group-levels - :type '(choice integer - (const :tag "none" nil))) - -(defcustom gnus-save-newsrc-file t - "*Non-nil means that Gnus will save the `.newsrc' file. -Gnus always saves its own startup file, which is called -\".newsrc.eld\". The file called \".newsrc\" is in a format that can -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 -exit." - :group 'gnus-newsrc - :type 'boolean) - -(defcustom gnus-save-killed-list t - "*If non-nil, save the list of killed groups to the startup file. -If you set this variable to nil, you'll save both time (when starting -and quitting) and space (both memory and disk), but it will also mean -that Gnus has no record of which groups are new and which are old, so -the automatic new newsgroups subscription methods become meaningless. - -You should always set `gnus-check-new-newsgroups' to `ask-server' or -nil if you set this variable to nil. - -This variable can also be a regexp. In that case, all groups that do -not match this regexp will be removed before saving the list." - :group 'gnus-newsrc - :type 'boolean) - -(defcustom gnus-ignored-newsgroups - (purecopy (mapconcat 'identity - '("^to\\." ; not "real" groups - "^[0-9. \t]+ " ; all digits in name - "[][\"#'()]" ; bogus characters - ) - "\\|")) - "*A regexp to match uninteresting newsgroups in the active file. -Any lines in the active file matching this regular expression are -removed from the newsgroup list before anything else is done to it, -thus making them effectively non-existent." - :group 'gnus-group-new - :type 'regexp) - -(defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies - "*Function 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 -alphabetic order; `gnus-subscribe-hierarchically' inserts new groups -in hierarchical newsgroup order; `gnus-subscribe-interactively' asks -for your decision; `gnus-subscribe-killed' kills all new groups; -`gnus-subscribe-zombies' will make all new groups into zombies." - :group 'gnus-group-new - :type '(radio (function-item gnus-subscribe-randomly) - (function-item gnus-subscribe-alphabetically) - (function-item gnus-subscribe-hierarchically) - (function-item gnus-subscribe-interactively) - (function-item gnus-subscribe-killed) - (function-item gnus-subscribe-zombies) - function)) - -;; Suggested by a bug report by Hallvard B Furuseth. -;; . -(defcustom gnus-subscribe-options-newsgroup-method - 'gnus-subscribe-alphabetically - "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines. -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: - -options -n no.all alt.all - -Gnus will the subscribe all new newsgroups in these hierarchies with -the subscription method in this variable." - :group 'gnus-group-new - :type '(radio (function-item gnus-subscribe-randomly) - (function-item gnus-subscribe-alphabetically) - (function-item gnus-subscribe-hierarchically) - (function-item gnus-subscribe-interactively) - (function-item gnus-subscribe-killed) - (function-item gnus-subscribe-zombies) - function)) - -(defcustom gnus-subscribe-hierarchical-interactive nil - "*If non-nil, Gnus will offer to subscribe hierarchically. -When a new hierarchy appears, Gnus will ask the user: - -'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys): - -If the user pressed `d', Gnus will descend the hierarchy, `y' will -subscribe to all newsgroups in the hierarchy and `s' will skip this -hierarchy in its entirety." - :group 'gnus-group-new - :type 'boolean) - -(defcustom gnus-auto-subscribed-groups - "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl" - "*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. - -New groups that match this regexp will not be handled by -`gnus-subscribe-newsgroup-method'. Instead, they will -be subscribed using `gnus-subscribe-options-newsgroup-method'." - :group 'gnus-group-new - :type 'regexp) - -(defcustom gnus-options-subscribe nil - "*All new groups matching this regexp will be subscribed unconditionally. -Note that this variable deals only with new newsgroups. This variable -does not affect old newsgroups. - -New groups that match this regexp will not be handled by -`gnus-subscribe-newsgroup-method'. Instead, they will -be subscribed using `gnus-subscribe-options-newsgroup-method'." - :group 'gnus-group-new - :type '(choice regexp - (const :tag "none" nil))) - -(defcustom gnus-options-not-subscribe nil - "*All new groups matching this regexp will be ignored. -Note that this variable deals only with new newsgroups. This variable -does not affect old (already subscribed) newsgroups." - :group 'gnus-group-new - :type '(choice regexp - (const :tag "none" nil))) - -(defcustom gnus-modtime-botch nil - "*Non-nil means .newsrc should be deleted prior to save. -Its use is due to the bogus appearance that .newsrc was modified on -disc." - :group 'gnus-newsrc - :type 'boolean) - -(defcustom gnus-check-bogus-groups-hook nil - "*A hook run after removing bogus groups." - :group 'gnus-start-server - :type 'hook) - -(defcustom gnus-startup-hook nil - "*A hook called at startup. -This hook is called after Gnus is connected to the NNTP server." - :group 'gnus-start - :type 'hook) - -(defcustom gnus-before-startup-hook nil - "*A hook called at before startup. -This hook is called as the first thing when Gnus is started." - :group 'gnus-start - :type 'hook) - -(defcustom gnus-started-hook nil - "*A hook called as the last thing after startup." - :group 'gnus-start - :type 'hook) - -(defcustom gnus-setup-news-hook nil - "*A hook after reading the .newsrc file, but before generating the buffer." - :group 'gnus-start - :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)) - "*A hook run after Gnus checks for new news." - :group 'gnus-group-new - :type 'hook) - -(defcustom gnus-save-newsrc-hook nil - "*A hook called before saving any of the newsrc files." - :group 'gnus-newsrc - :type 'hook) - -(defcustom gnus-save-quick-newsrc-hook nil - "*A hook called just before saving the quick newsrc file. -Can be used to turn version control on or off." - :group 'gnus-newsrc - :type 'hook) - -(defcustom gnus-save-standard-newsrc-hook nil - "*A hook called just before saving the standard newsrc file. -Can be used to turn version control on or off." - :group 'gnus-newsrc - :type 'hook) - -;;; Internal variables - -(defvar gnus-always-read-dribble-file nil - "Uncoditionally read the dribble file.") - -(defvar gnus-newsrc-file-version nil) -(defvar gnus-override-subscribe-method nil) -(defvar gnus-dribble-buffer nil) -(defvar gnus-newsrc-options nil - "Options line in the .newsrc file.") - -(defvar gnus-newsrc-options-n nil - "List of regexps representing groups to be subscribed/ignored unconditionally.") - -(defvar gnus-newsrc-last-checked-date nil - "Date Gnus last asked server for new newsgroups.") - -(defvar gnus-current-startup-file nil - "Startup file for the current host.") - -;; Byte-compiler warning. -(defvar gnus-group-line-format) - -;; Suggested by Brian Edmonds . -(defvar gnus-init-inhibit nil) -(defun gnus-read-init-file (&optional inhibit-next) - ;; Don't load .gnus if the -q option was used. - (when init-file-user - (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))))))))) - -;; For subscribing new newsgroup - -(defun gnus-subscribe-hierarchical-interactive (groups) - (let ((groups (sort groups 'string<)) - prefixes prefix start ans group starts) - (while groups - (setq prefixes (list "^")) - (while (and groups prefixes) - (while (not (string-match (car prefixes) (car groups))) - (setq prefixes (cdr prefixes))) - (setq prefix (car prefixes)) - (setq start (1- (length prefix))) - (if (and (string-match "[^\\.]\\." (car groups) start) - (cdr groups) - (setq prefix - (concat "^" (substring (car groups) 0 (match-end 0)))) - (string-match prefix (cadr groups))) - (progn - (push prefix prefixes) - (message "Descend hierarchy %s? ([y]nsq): " - (substring prefix 1 (1- (length prefix)))) - (while (not (memq (setq ans (read-char-exclusive)) - '(?y ?\n ?\r ?n ?s ?q))) - (ding) - (message "Descend hierarchy %s? ([y]nsq): " - (substring prefix 1 (1- (length prefix))))) - (cond ((= ans ?n) - (while (and groups - (string-match prefix - (setq group (car groups)))) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups))) - (setq starts (cdr starts))) - ((= ans ?s) - (while (and groups - (string-match prefix - (setq group (car groups)))) - (gnus-sethash group group gnus-killed-hashtb) - (gnus-subscribe-alphabetically (car groups)) - (setq groups (cdr groups))) - (setq starts (cdr starts))) - ((= ans ?q) - (while groups - (setq group (car groups)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups)))) - (t nil))) - (message "Subscribe %s? ([n]yq)" (car groups)) - (while (not (memq (setq ans (read-char-exclusive)) - '(?y ?\n ?\r ?q ?n))) - (ding) - (message "Subscribe %s? ([n]yq)" (car groups))) - (setq group (car groups)) - (cond ((= ans ?y) - (gnus-subscribe-alphabetically (car groups)) - (gnus-sethash group group gnus-killed-hashtb)) - ((= ans ?q) - (while groups - (setq group (car groups)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups)))) - (t - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb))) - (setq groups (cdr groups))))))) - -(defun gnus-subscribe-randomly (newsgroup) - "Subscribe new NEWSGROUP by making it the first newsgroup." - (gnus-subscribe-newsgroup newsgroup)) - -(defun gnus-subscribe-alphabetically (newgroup) - "Subscribe new NEWSGROUP and insert it in alphabetical order." - (let ((groups (cdr gnus-newsrc-alist)) - before) - (while (and (not before) groups) - (if (string< newgroup (caar groups)) - (setq before (caar groups)) - (setq groups (cdr groups)))) - (gnus-subscribe-newsgroup newgroup before))) - -(defun gnus-subscribe-hierarchically (newgroup) - "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order." - ;; 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)))) - -(defun gnus-subscribe-interactively (group) - "Subscribe the new GROUP interactively. -It is inserted in hierarchical newsgroup order if subscribed. If not, -it is killed." - (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group)) - (gnus-subscribe-hierarchically group) - (push group gnus-killed-list))) - -(defun gnus-subscribe-zombies (group) - "Make the new GROUP into a zombie group." - (push group gnus-zombie-list)) - -(defun gnus-subscribe-killed (group) - "Make the new GROUP a killed group." - (push group gnus-killed-list)) - -(defun gnus-subscribe-newsgroup (newsgroup &optional next) - "Subscribe new NEWSGROUP. -If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made -the first newsgroup." - (save-excursion - (goto-char (point-min)) - ;; We subscribe the group by changing its level to `subscribed'. - (gnus-group-change-level - newsgroup gnus-level-default-subscribed - gnus-level-killed (gnus-gethash (or next "dummy.group") - gnus-newsrc-hashtb)) - (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))) - -(defun gnus-read-active-file-p () - "Say whether the active file has been read from `gnus-select-method'." - (memq gnus-select-method gnus-have-read-active-file)) - -;;; 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) -(defun gnus-clear-system () - "Clear all variables and buffers." - ;; Clear Gnus variables. - (let ((variables gnus-variable-list)) - (while variables - (set (car variables) nil) - (setq variables (cdr variables)))) - ;; Clear other internal variables. - (setq gnus-list-of-killed-groups nil - gnus-have-read-active-file nil - gnus-newsrc-alist nil - gnus-newsrc-hashtb nil - gnus-killed-list nil - gnus-zombie-list nil - gnus-killed-hashtb nil - gnus-active-hashtb nil - gnus-moderated-hashtb nil - gnus-description-hashtb nil - gnus-current-headers nil - gnus-thread-indent-array nil - gnus-newsgroup-headers nil - gnus-newsgroup-name nil - gnus-server-alist nil - gnus-group-list-mode nil - gnus-opened-servers nil - gnus-group-mark-positions nil - gnus-newsgroup-data nil - gnus-newsgroup-unreads nil - nnoo-state-alist nil - gnus-current-select-method nil - gnus-ephemeral-servers nil) - (gnus-shutdown 'gnus) - ;; Kill the startup file. - (and gnus-current-startup-file - (get-file-buffer gnus-current-startup-file) - (kill-buffer (get-file-buffer gnus-current-startup-file))) - ;; Clear the dribble buffer. - (gnus-dribble-clear) - ;; Kill global KILL file buffer. - (when (get-file-buffer (gnus-newsgroup-kill-file nil)) - (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) - (gnus-kill-buffer nntp-server-buffer) - ;; Kill Gnus buffers. - (while gnus-buffer-list - (gnus-kill-buffer (pop gnus-buffer-list))) - ;; Remove Gnus frames. - (gnus-kill-gnus-frames)) - -(defun gnus-no-server-1 (&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." - (interactive "P") - (let ((val (or arg (1- gnus-level-default-subscribed)))) - (gnus val t slave) - (make-local-variable 'gnus-group-use-permanent-levels) - (setq gnus-group-use-permanent-levels val))) - -(defun gnus-1 (&optional arg dont-connect slave) - "Read network news. -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") - - (if (gnus-alive-p) - (progn - (switch-to-buffer gnus-group-buffer) - (gnus-group-get-new-news - (and (numberp arg) - (> arg 0) - (max (car gnus-group-list-mode) arg)))) - - (gnus-splash) - (gnus-clear-system) - (gnus-run-hooks 'gnus-before-startup-hook) - (nnheader-init-server-buffer) - (setq gnus-slave slave) - (gnus-read-init-file) - - (when gnus-simple-splash - (setq gnus-simple-splash nil) - (cond - (gnus-xemacs - (gnus-xmas-splash)) - ((and (eq window-system 'x) - (= (frame-height) (1+ (window-height)))) - (gnus-x-splash)))) - - (let ((level (and (numberp arg) (> arg 0) arg)) - did-connect) - (unwind-protect - (progn - (unless dont-connect - (setq did-connect - (gnus-start-news-server (and arg (not level)))))) - (if (and (not dont-connect) - (not did-connect)) - (gnus-group-quit) - (gnus-run-hooks 'gnus-startup-hook) - ;; NNTP server is successfully open. - - ;; Find the current startup file name. - (setq gnus-current-startup-file - (gnus-make-newsrc-file gnus-startup-file)) - - ;; Read the dribble file. - (when (or gnus-slave gnus-use-dribble-file) - (gnus-dribble-read-file)) - - ;; Allow using GroupLens predictions. - (when gnus-use-grouplens - (bbb-login) - (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)) - - ;; Do the actual startup. - (gnus-setup-news nil level dont-connect) - (gnus-run-hooks 'gnus-setup-news-hook) - (gnus-start-draft-setup) - ;; Generate the group buffer. - (gnus-group-list-groups level) - (gnus-group-first-unread-group) - (gnus-configure-windows 'group) - (gnus-group-set-mode-line) - (gnus-run-hooks 'gnus-started-hook)))))) - -(defun gnus-start-draft-setup () - "Make sure the draft group exists." - (gnus-request-create-group "drafts" '(nndraft "")) - (unless (gnus-gethash "nndraft:drafts" gnus-newsrc-hashtb) - (let ((gnus-level-default-subscribed 1)) - (gnus-subscribe-group "nndraft:drafts" nil '(nndraft ""))) - (gnus-group-set-parameter - "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode))))) - -;;;###autoload -(defun gnus-unload () - "Unload all Gnus features." - (interactive) - (unless (boundp 'load-history) - (error "Sorry, `gnus-unload' is not implemented in this Emacs version")) - (let ((history load-history) - feature) - (while history - (and (string-match "^\\(gnus\\|nn\\)" (caar history)) - (setq feature (cdr (assq 'provide (car history)))) - (unload-feature feature 'force)) - (setq history (cdr history))))) - - -;;; -;;; Dribble file -;;; - -(defvar gnus-dribble-ignore nil) -(defvar gnus-dribble-eval-file nil) - -(defun gnus-dribble-file-name () - "Return the dribble file for the current .newsrc." - (concat - (if gnus-dribble-directory - (concat (file-name-as-directory gnus-dribble-directory) - (file-name-nondirectory gnus-current-startup-file)) - gnus-current-startup-file) - "-dribble")) - -(defun gnus-dribble-enter (string) - "Enter STRING into the dribble buffer." - (when (and (not gnus-dribble-ignore) - gnus-dribble-buffer - (buffer-name gnus-dribble-buffer)) - (let ((obuf (current-buffer))) - (set-buffer gnus-dribble-buffer) - (goto-char (point-max)) - (insert string "\n") - (set-window-point (get-buffer-window (current-buffer)) (point-max)) - (bury-buffer gnus-dribble-buffer) - (set-buffer obuf)))) - -(defun gnus-dribble-touch () - "Touch the dribble buffer." - (gnus-dribble-enter "")) - -(defun gnus-dribble-read-file () - "Read the dribble file from disk." - (let ((dribble-file (gnus-dribble-file-name))) - (save-excursion - (set-buffer (setq gnus-dribble-buffer - (get-buffer-create - (file-name-nondirectory dribble-file)))) - (gnus-add-current-to-buffer-list) - (erase-buffer) - (setq buffer-file-name dribble-file) - (auto-save-mode t) - (buffer-disable-undo (current-buffer)) - (bury-buffer (current-buffer)) - (set-buffer-modified-p nil) - (let ((auto (make-auto-save-file-name)) - (gnus-dribble-ignore t) - modes) - (when (or (file-exists-p auto) (file-exists-p dribble-file)) - ;; Load whichever file is newest -- the auto save file - ;; or the "real" file. - (if (file-newer-than-file-p auto dribble-file) - (nnheader-insert-file-contents auto) - (nnheader-insert-file-contents dribble-file)) - (unless (zerop (buffer-size)) - (set-buffer-modified-p t)) - ;; Set the file modes to reflect the .newsrc file modes. - (save-buffer) - (when (and (file-exists-p gnus-current-startup-file) - (file-exists-p dribble-file) - (setq modes (file-modes gnus-current-startup-file))) - (set-file-modes dribble-file modes)) - ;; 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? ")) - (setq gnus-dribble-eval-file t))))))) - -(defun gnus-dribble-eval-file () - (when gnus-dribble-eval-file - (setq gnus-dribble-eval-file nil) - (save-excursion - (let ((gnus-dribble-ignore t)) - (set-buffer gnus-dribble-buffer) - (eval-buffer (current-buffer)))))) - -(defun gnus-dribble-delete-file () - (when (file-exists-p (gnus-dribble-file-name)) - (delete-file (gnus-dribble-file-name))) - (when gnus-dribble-buffer - (save-excursion - (set-buffer gnus-dribble-buffer) - (let ((auto (make-auto-save-file-name))) - (when (file-exists-p auto) - (delete-file auto)) - (erase-buffer) - (set-buffer-modified-p nil))))) - -(defun gnus-dribble-save () - (when (and gnus-dribble-buffer - (buffer-name gnus-dribble-buffer)) - (save-excursion - (set-buffer gnus-dribble-buffer) - (save-buffer)))) - -(defun gnus-dribble-clear () - (when (gnus-buffer-exists-p gnus-dribble-buffer) - (save-excursion - (set-buffer gnus-dribble-buffer) - (erase-buffer) - (set-buffer-modified-p nil) - (setq buffer-saved-size (buffer-size))))) - - -;;; -;;; Active & Newsrc File Handling -;;; - -(defun gnus-setup-news (&optional rawfile level dont-connect) - "Setup news information. -If RAWFILE is non-nil, the .newsrc file will also be read. -If LEVEL is non-nil, the news will be set up at level LEVEL." - (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))) - - (when init - ;; Clear some variables to re-initialize news information. - (setq gnus-newsrc-alist nil - gnus-active-hashtb nil) - ;; Read the newsrc file and create `gnus-newsrc-hashtb'. - (gnus-read-newsrc-file rawfile)) - - ;; 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)) - - ;; If we don't read the complete active file, we fill in the - ;; hashtb here. - (when (or (null gnus-read-active-file) - (eq gnus-read-active-file 'some)) - (gnus-update-active-hashtb-from-killed)) - - ;; Read the active file and create `gnus-active-hashtb'. - ;; If `gnus-read-active-file' is nil, then we just create an empty - ;; hash table. The partial filling out of the hash table will be - ;; done in `gnus-get-unread-articles'. - (and gnus-read-active-file - (not level) - (gnus-read-active-file nil dont-connect)) - - (unless gnus-active-hashtb - (setq gnus-active-hashtb (gnus-make-hashtable 4096))) - - ;; Initialize the cache. - (when gnus-use-cache - (gnus-cache-open)) - - ;; Possibly eval the dribble file. - (and init - (or gnus-use-dribble-file gnus-slave) - (gnus-dribble-eval-file)) - - ;; Slave Gnusii should then clear the dribble buffer. - (when (and init gnus-slave) - (gnus-dribble-clear)) - - (gnus-update-format-specifications) - - ;; See whether we need to read the description file. - (when (and (boundp 'gnus-group-line-format) - (let ((case-fold-search nil)) - (string-match "%[-,0-9]*D" gnus-group-line-format)) - (not gnus-description-hashtb) - (not dont-connect) - gnus-read-active-file) - (gnus-read-all-descriptions-files)) - - ;; Find new newsgroups and treat them. - (when (and init gnus-check-new-newsgroups (not level) - (gnus-check-server gnus-select-method) - (not gnus-slave) - gnus-plugged) - (gnus-find-new-newsgroups)) - - ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem - (not level) - (not dont-connect)) - (gnus-nocem-scan-groups)) - - ;; Read any slave files. - (gnus-master-read-slave-newsrc) - - ;; 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)))) - -(defun gnus-find-new-newsgroups (&optional arg) - "Search for new newsgroups and add them. -Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.' -The `-n' option line from .newsrc is respected. -If ARG (the prefix), use the `ask-server' method to query the server -for new groups." - (interactive "P") - (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups))) - (null gnus-read-active-file) - (eq gnus-read-active-file 'some)) - 'ask-server gnus-check-new-newsgroups))) - (unless (gnus-check-first-time-used) - (if (or (consp check) - (eq check 'ask-server)) - ;; Ask the server for new groups. - (gnus-ask-server-for-new-groups) - ;; Go through the active hashtb and look for new groups. - (let ((groups 0) - group new-newsgroups) - (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)) - (unless gnus-killed-hashtb - (gnus-make-hashtable-from-killed)) - ;; Go though every newsgroup in `gnus-active-hashtb' and compare - ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. - (mapatoms - (lambda (sym) - (if (or (null (setq group (symbol-name sym))) - (not (boundp sym)) - (null (symbol-value sym)) - (gnus-gethash group gnus-killed-hashtb) - (gnus-gethash group gnus-newsrc-hashtb)) - () - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) - (funcall gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) - (if gnus-subscribe-hierarchical-interactive - (push group new-newsgroups) - (funcall gnus-subscribe-newsgroup-method group))))))) - gnus-active-hashtb) - (when new-newsgroups - (gnus-subscribe-hierarchical-interactive new-newsgroups)) - (if (> groups 0) - (gnus-message 5 "%d new newsgroup%s arrived." - groups (if (> groups 1) "s have" " has")) - (gnus-message 5 "No new newsgroups."))))))) - -(defun gnus-matches-options-n (group) - ;; Returns `subscribe' if the group is to be unconditionally - ;; subscribed, `ignore' if it is to be ignored, and nil if there is - ;; no match for the group. - - ;; First we check the two user variables. - (cond - ((and gnus-options-subscribe - (string-match gnus-options-subscribe group)) - 'subscribe) - ((and gnus-auto-subscribed-groups - (string-match gnus-auto-subscribed-groups group)) - 'subscribe) - ((and gnus-options-not-subscribe - (string-match gnus-options-not-subscribe group)) - 'ignore) - ;; Then we go through the list that was retrieved from the .newsrc - ;; file. This list has elements on the form - ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list - ;; is in the reverse order of the options line) is returned. - (t - (let ((regs gnus-newsrc-options-n)) - (while (and regs - (not (string-match (caar regs) group))) - (setq regs (cdr regs))) - (and regs (cdar regs)))))) - -(defun gnus-ask-server-for-new-groups () - (let* ((date (or gnus-newsrc-last-checked-date (current-time-string))) - (methods (cons gnus-select-method - (nconc - (when (gnus-archive-server-wanted-p) - (list "archive")) - (append - (and (consp gnus-check-new-newsgroups) - 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) - ;; Go through both primary and secondary select methods and - ;; request new newsgroups. - (while (setq method (gnus-server-get-method nil (pop methods))) - (setq new-newsgroups nil) - (setq gnus-override-subscribe-method method) - (when (and (gnus-check-server method) - (gnus-request-newgroups date method)) - (save-excursion - (setq got-new t) - (setq hashtb (gnus-make-hashtable 100)) - (set-buffer nntp-server-buffer) - ;; Enter all the new groups into a hashtable. - (gnus-active-to-gnus-format method hashtb 'ignore)) - ;; Now all new groups from `method' are in `hashtb'. - (mapatoms - (lambda (group-sym) - (if (or (null (setq group (symbol-name group-sym))) - (not (boundp group-sym)) - (null (symbol-value group-sym)) - (gnus-gethash group gnus-newsrc-hashtb) - (member group gnus-zombie-list) - (member group gnus-killed-list)) - ;; The group is already known. - () - ;; Make this group active. - (when (symbol-value group-sym) - (gnus-set-active group (symbol-value group-sym))) - ;; Check whether we want it or not. - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (incf groups) - (gnus-sethash group group gnus-killed-hashtb) - (funcall gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (incf groups) - (gnus-sethash group group gnus-killed-hashtb) - (if gnus-subscribe-hierarchical-interactive - (push group new-newsgroups) - (funcall gnus-subscribe-newsgroup-method group))))))) - hashtb)) - (when new-newsgroups - (gnus-subscribe-hierarchical-interactive new-newsgroups))) - (when (> groups 0) - (gnus-message 6 "%d new newsgroup%s arrived." - groups (if (> groups 1) "s have" " has"))) - (when got-new - (setq gnus-newsrc-last-checked-date new-date)) - got-new)) - -(defun gnus-check-first-time-used () - (if (or (> (length gnus-newsrc-alist) 1) - (file-exists-p gnus-startup-file) - (file-exists-p (concat gnus-startup-file ".el")) - (file-exists-p (concat gnus-startup-file ".eld"))) - nil - (gnus-message 6 "First time user; subscribing you to default groups") - (unless (gnus-read-active-file-p) - (let ((gnus-read-active-file t)) - (gnus-read-active-file))) - (setq gnus-newsrc-last-checked-date (current-time-string)) - (let ((groups gnus-default-subscribed-newsgroups) - group) - (if (eq groups t) - nil - (setq groups (or groups gnus-backup-default-subscribed-newsgroups)) - (mapatoms - (lambda (sym) - (if (null (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) - (while groups - (when (gnus-active (car groups)) - (gnus-group-change-level - (car groups) gnus-level-default-subscribed gnus-level-killed)) - (setq groups (cdr groups))) - (gnus-group-make-help-group) - (when gnus-novice-user - (gnus-message 7 "`A k' to list killed groups")))))) - -(defun gnus-subscribe-group (group previous &optional method) - (gnus-group-change-level - (if method - (list t group gnus-level-default-subscribed nil nil method) - group) - gnus-level-default-subscribed gnus-level-killed previous t)) - -;; `gnus-group-change-level' is the fundamental function for changing -;; subscription levels of newsgroups. This might mean just changing -;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back -;; again, which subscribes/unsubscribes a group, which is equally -;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and -;; from 8-9 to 1-7 means that you remove the group from the list of -;; killed (or zombie) groups and add them to the (kinda) subscribed -;; groups. And last but not least, moving from 8 to 9 and 9 to 8, -;; which is trivial. -;; ENTRY can either be a string (newsgroup name) or a list (if -;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST), -;; otherwise it's a list in the format of the `gnus-newsrc-hashtb' -;; entries. -;; LEVEL is the new level of the group, OLDLEVEL is the old level and -;; PREVIOUS is the group (in hashtb entry format) to insert this group -;; after. -(defun gnus-group-change-level (entry level &optional oldlevel - previous fromkilled) - (let (group info active num) - ;; Glean what info we can from the arguments - (if (consp entry) - (if fromkilled (setq group (nth 1 entry)) - (setq group (car (nth 2 entry)))) - (setq group entry)) - (when (and (stringp entry) - oldlevel - (< oldlevel gnus-level-zombie)) - (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) - (if (and (not oldlevel) - (consp entry)) - (setq oldlevel (gnus-info-level (nth 2 entry))) - (setq oldlevel (or oldlevel gnus-level-killed))) - (when (stringp previous) - (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) - - (if (and (>= oldlevel gnus-level-zombie) - (gnus-gethash group gnus-newsrc-hashtb)) - ;; We are trying to subscribe a group that is already - ;; subscribed. - () ; Do nothing. - - (unless (gnus-ephemeral-group-p group) - (gnus-dribble-enter - (format "(gnus-group-change-level %S %S %S %S %S)" - group level oldlevel (car (nth 2 previous)) fromkilled))) - - ;; Then we remove the newgroup from any old structures, if needed. - ;; If the group was killed, we remove it from the killed or zombie - ;; list. If not, and it is in fact going to be killed, we remove - ;; 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)))) - (t - (when (and (>= level gnus-level-zombie) - entry) - (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) - (when (nth 3 entry) - (setcdr (gnus-gethash (car (nth 3 entry)) - gnus-newsrc-hashtb) - (cdr entry))) - (setcdr (cdr entry) (cdddr entry))))) - - ;; Finally we enter (if needed) the list where it is supposed to - ;; go, and change the subscription level. If it is to be killed, - ;; we enter it into the killed or zombie list. - (cond - ((>= level gnus-level-zombie) - ;; Remove from the hash table. - (gnus-sethash group nil gnus-newsrc-hashtb) - ;; We do not enter foreign groups into the list of dead - ;; groups. - (unless (gnus-group-foreign-p group) - (if (= level gnus-level-zombie) - (push group gnus-zombie-list) - (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 - ;; hashtb format and fix the pointers in the newsrc assoc. - (if (< oldlevel gnus-level-zombie) - ;; It was alive, and it is going to stay alive, so we - ;; just change the level and don't change any pointers or - ;; hash table entries. - (setcar (cdaddr entry) level) - (if (listp entry) - (setq info (cdr entry) - num (car entry)) - (setq active (gnus-active group)) - (setq num - (if active (- (1+ (cdr active)) (car active)) t)) - ;; Check whether the group is foreign. If so, the - ;; foreign select method has to be entered into the - ;; info. - (let ((method (or gnus-override-subscribe-method - (gnus-group-method group)))) - (if (eq method gnus-select-method) - (setq info (list group level nil)) - (setq info (list group level nil nil method))))) - (unless previous - (setq previous - (let ((p gnus-newsrc-alist)) - (while (cddr p) - (setq p (cdr p))) - p))) - (setq entry (cons info (cddr previous))) - (if (cdr previous) - (progn - (setcdr (cdr previous) entry) - (gnus-sethash group (cons num (cdr previous)) - gnus-newsrc-hashtb)) - (setcdr previous entry) - (gnus-sethash group (cons num previous) - gnus-newsrc-hashtb)) - (when (cdr entry) - (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry)) - (gnus-dribble-enter - (format - "(gnus-group-set-info '%S)" info))))) - (when gnus-group-change-level-function - (funcall gnus-group-change-level-function - group level oldlevel previous))))) - -(defun gnus-kill-newsgroup (newsgroup) - "Obsolete function. Kills a newsgroup." - (gnus-group-change-level - (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed)) - -(defun gnus-check-bogus-newsgroups (&optional confirm) - "Remove bogus newsgroups. -If CONFIRM is non-nil, the user has to confirm the deletion of every -newsgroup." - (let ((newsrc (cdr gnus-newsrc-alist)) - bogus group entry info) - (gnus-message 5 "Checking bogus newsgroups...") - (unless (gnus-read-active-file-p) - (gnus-read-active-file t)) - (when (gnus-read-active-file-p) - ;; Find all bogus newsgroup that are subscribed. - (while newsrc - (setq info (pop newsrc) - group (gnus-info-group info)) - (unless (or (gnus-active group) ; Active - (gnus-info-method info)) ; Foreign - ;; Found a bogus newsgroup. - (push group bogus))) - (if confirm - (map-y-or-n-p - "Remove bogus group %s? " - (lambda (group) - ;; Remove all bogus subscribed groups by first killing them, and - ;; then removing them from the list of killed groups. - (when (setq entry (gnus-gethash group gnus-newsrc-hashtb)) - (gnus-group-change-level entry gnus-level-killed) - (setq gnus-killed-list (delete group gnus-killed-list)))) - bogus '("group" "groups" "remove")) - (while (setq group (pop bogus)) - ;; Remove all bogus subscribed groups by first killing them, and - ;; then removing them from the list of killed groups. - (when (setq entry (gnus-gethash group gnus-newsrc-hashtb)) - (gnus-group-change-level entry gnus-level-killed) - (setq gnus-killed-list (delete group gnus-killed-list))))) - ;; Then we remove all bogus groups from the list of killed and - ;; zombie groups. They are removed without confirmation. - (let ((dead-lists '(gnus-killed-list gnus-zombie-list)) - killed) - (while dead-lists - (setq killed (symbol-value (car dead-lists))) - (while killed - (unless (gnus-active (setq group (pop killed))) - ;; The group is bogus. - ;; !!!Slow as hell. - (set (car dead-lists) - (delete group (symbol-value (car dead-lists)))))) - (setq dead-lists (cdr dead-lists)))) - (gnus-run-hooks 'gnus-check-bogus-groups-hook) - (gnus-message 5 "Checking bogus newsgroups...done")))) - -(defun gnus-check-duplicate-killed-groups () - "Remove duplicates from the list of killed groups." - (interactive) - (let ((killed gnus-killed-list)) - (while killed - (gnus-message 9 "%d" (length killed)) - (setcdr killed (delete (car killed) (cdr killed))) - (setq killed (cdr killed))))) - -;; We want to inline a function from gnus-cache, so we cheat here: -(eval-when-compile - (defvar gnus-cache-active-hashtb) - (defun gnus-cache-possibly-alter-active (group active) - "Alter the ACTIVE info for GROUP to reflect the articles in the cache." - (when gnus-cache-active-hashtb - (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) - (when cache-active - (when (< (car cache-active) (car active)) - (setcar active (car cache-active))) - (when (> (cdr cache-active) (cdr active)) - (setcdr active (cdr cache-active)))))))) - -(defun gnus-activate-group (group &optional scan dont-check method) - ;; Check whether a group has been activated or not. - ;; If SCAN, request a scan of that group as well. - (let ((method (or method (inline (gnus-find-method-for-group group)))) - active) - (and (inline (gnus-check-server method)) - ;; We escape all bugs and quit here to make it possible to - ;; continue if a group is so out-there that it reports bugs - ;; and stuff. - (progn - (and scan - (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan group method)) - t) - (condition-case () - (inline (gnus-request-group group dont-check method)) - (error nil) - (quit 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)))) - -(defun gnus-get-unread-articles-in-group (info active &optional update) - (when active - ;; Allow the backend to update the info in the group. - (when (and update - (gnus-request-update-info - info (inline (gnus-find-method-for-group - (gnus-info-group info))))) - (gnus-activate-group (gnus-info-group info) nil t)) - (let* ((range (gnus-info-read info)) - (num 0)) - ;; If a cache is present, we may have to alter the active info. - (when (and gnus-use-cache info) - (inline (gnus-cache-possibly-alter-active - (gnus-info-group info) active))) - ;; Modify the list of read articles according to what articles - ;; are available; then tally the unread articles and add the - ;; number to the group hash table entry. - (cond - ((zerop (cdr active)) - (setq num 0)) - ((not range) - (setq num (- (1+ (cdr active)) (car active)))) - ((not (listp (cdr range))) - ;; Fix a single (num . num) range according to the - ;; active hash table. - ;; Fix by Carsten Bormann . - (and (< (cdr range) (car active)) (setcdr range (1- (car active)))) - (and (> (cdr range) (cdr active)) (setcdr range (cdr active))) - ;; Compute number of unread articles. - (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range)))))) - (t - ;; The read list is a list of ranges. Fix them according to - ;; the active hash table. - ;; First peel off any elements that are below the lower - ;; active limit. - (while (and (cdr range) - (>= (car active) - (or (and (atom (cadr range)) (cadr range)) - (caadr range)))) - (if (numberp (car range)) - (setcar range - (cons (car range) - (or (and (numberp (cadr range)) - (cadr range)) - (cdadr range)))) - (setcdr (car range) - (or (and (numberp (nth 1 range)) (nth 1 range)) - (cdadr range)))) - (setcdr range (cddr range))) - ;; Adjust the first element to be the same as the lower limit. - (when (and (not (atom (car range))) - (< (cdar range) (car active))) - (setcdr (car range) (1- (car active)))) - ;; Then we want to peel off any elements that are higher - ;; than the upper active limit. - (let ((srange range)) - ;; Go past all legal elements. - (while (and (cdr srange) - (<= (or (and (atom (cadr srange)) - (cadr srange)) - (caadr srange)) - (cdr active))) - (setq srange (cdr srange))) - (when (cdr srange) - ;; Nuke all remaining illegal elements. - (setcdr srange nil)) - - ;; Adjust the final element. - (when (and (not (atom (car srange))) - (> (cdar srange) (cdr active))) - (setcdr (car srange) (cdr active)))) - ;; Compute the number of unread articles. - (while range - (setq num (+ num (- (1+ (or (and (atom (car range)) (car range)) - (cdar range))) - (or (and (atom (car range)) (car range)) - (caar range))))) - (setq range (cdr range))) - (setq num (max 0 (- (cdr active) num))))) - ;; Set the number of unread articles. - (when info - (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) - (let* ((newsrc (cdr gnus-newsrc-alist)) - (level (or level gnus-activate-level (1+ gnus-level-subscribed))) - (foreign-level - (min - (cond ((and gnus-activate-foreign-newsgroups - (not (numberp gnus-activate-foreign-newsgroups))) - (1+ gnus-level-subscribed)) - ((numberp gnus-activate-foreign-newsgroups) - gnus-activate-foreign-newsgroups) - (t 0)) - level)) - info group active method) - (gnus-message 5 "Checking new news...") - - (while newsrc - (setq active (gnus-active (setq group (gnus-info-group - (setq info (pop newsrc)))))) - - ;; Check newsgroups. If the user doesn't want to check them, or - ;; they can't be checked (for instance, if the news server can't - ;; be reached) we just set the number of unread articles in this - ;; newsgroup to t. This means that Gnus thinks that there are - ;; unread articles, but it has no idea how many. - (if (and (setq method (gnus-info-method info)) - (not (inline - (gnus-server-equal - gnus-select-method - (setq method (gnus-server-get-method nil method))))) - (not (gnus-secondary-method-p method))) - ;; These groups are foreign. Check the level. - (when (<= (gnus-info-level info) foreign-level) - (setq active (gnus-activate-group group 'scan)) - (unless (inline (gnus-virtual-group-p group)) - (inline (gnus-close-group group))) - (when (fboundp (intern (concat (symbol-name (car method)) - "-request-update-info"))) - (inline (gnus-request-update-info info method)))) - ;; These groups are native or secondary. - (when (and (<= (gnus-info-level info) level) - (not gnus-read-active-file)) - (setq active (gnus-activate-group group 'scan)) - (inline (gnus-close-group group)))) - - ;; Get the number of unread articles in the group. - (if active - (inline (gnus-get-unread-articles-in-group info active 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"))) - -;; Create a hash table out of the newsrc alist. The `car's of the -;; alist elements are used as keys. -(defun gnus-make-hashtable-from-newsrc-alist () - (let ((alist gnus-newsrc-alist) - (ohashtb gnus-newsrc-hashtb) - prev) - (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) - (setq alist - (setq prev (setq gnus-newsrc-alist - (if (equal (caar gnus-newsrc-alist) - "dummy.group") - gnus-newsrc-alist - (cons (list "dummy.group" 0 nil) alist))))) - (while alist - (gnus-sethash - (caar alist) - ;; Preserve number of unread articles in groups. - (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb))) - prev) - gnus-newsrc-hashtb) - (setq prev alist - alist (cdr alist))))) - -(defun gnus-make-hashtable-from-killed () - "Create a hash table from the killed and zombie lists." - (let ((lists '(gnus-killed-list gnus-zombie-list)) - list) - (setq gnus-killed-hashtb - (gnus-make-hashtable - (+ (length gnus-killed-list) (length gnus-zombie-list)))) - (while lists - (setq list (symbol-value (pop lists))) - (while list - (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) - -(defun gnus-parse-active () - "Parse active info in the nntp server buffer." - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - ;; Parse the result we got from `gnus-request-group'. - (when (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+") - (goto-char (match-beginning 1)) - (cons (read (current-buffer)) - (read (current-buffer)))))) - -(defun gnus-make-articles-unread (group articles) - "Mark ARTICLES in GROUP as unread." - (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb) - (gnus-gethash (gnus-group-real-name group) - gnus-newsrc-hashtb)))) - (ranges (gnus-info-read info)) - news article) - (while articles - (when (gnus-member-of-range - (setq article (pop articles)) ranges) - (push article news))) - (when news - (gnus-info-set-read - info (gnus-remove-from-range (gnus-info-read info) (nreverse news))) - (gnus-group-update-group group t)))) - -;; Enter all dead groups into the hashtb. -(defun gnus-update-active-hashtb-from-killed () - (let ((hashtb (setq gnus-active-hashtb (gnus-make-hashtable 4096))) - (lists (list gnus-killed-list gnus-zombie-list)) - killed) - (while lists - (setq killed (car lists)) - (while killed - (gnus-sethash (car killed) nil hashtb) - (setq killed (cdr killed))) - (setq lists (cdr lists))))) - -(defun gnus-get-killed-groups () - "Go through the active hashtb and mark all unknown groups as killed." - ;; First make sure active file has been read. - (unless (gnus-read-active-file-p) - (let ((gnus-read-active-file t)) - (gnus-read-active-file))) - (unless gnus-killed-hashtb - (gnus-make-hashtable-from-killed)) - ;; Go through all newsgroups that are known to Gnus - enlarge kill list. - (mapatoms - (lambda (sym) - (let ((groups 0) - (group (symbol-name sym))) - (if (or (null group) - (gnus-gethash group gnus-killed-hashtb) - (gnus-gethash group gnus-newsrc-hashtb)) - () - (let ((do-sub (gnus-matches-options-n group))) - (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore)) - () - (setq groups (1+ groups)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb)))))) - gnus-active-hashtb) - (gnus-dribble-touch)) - -;; Get the active file(s) from the backend(s). -(defun gnus-read-active-file (&optional force not-native) - (gnus-group-set-mode-line) - (let ((methods - (append - (if (and (not not-native) - (gnus-check-server gnus-select-method)) - ;; The native server is available. - (cons gnus-select-method gnus-secondary-select-methods) - ;; The native server is down, so we just do the - ;; secondary ones. - gnus-secondary-select-methods) - ;; Also read from the archive server. - (when (gnus-archive-server-wanted-p) - (list "archive")))) - list-type) - (setq gnus-have-read-active-file nil) - (save-excursion - (set-buffer nntp-server-buffer) - (while methods - (let* ((method (if (stringp (car methods)) - (gnus-server-get-method nil (car methods)) - (car methods))) - (where (nth 1 method)) - (mesg (format "Reading active file%s via %s..." - (if (and where (not (zerop (length where)))) - (concat " from " where) "") - (car method)))) - (gnus-message 5 mesg) - (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)) - (cond - ((and (eq gnus-read-active-file 'some) - (gnus-check-backend-function 'retrieve-groups (car method)) - (not force)) - (let ((newsrc (cdr gnus-newsrc-alist)) - (gmethod (gnus-server-get-method nil method)) - groups info) - (while (setq info (pop newsrc)) - (when (inline - (gnus-server-equal - (inline - (gnus-find-method-for-group - (gnus-info-group info) info)) - gmethod)) - (push (gnus-group-real-name (gnus-info-group info)) - groups))) - (when groups - (gnus-check-server method) - (setq list-type (gnus-retrieve-groups groups method)) - (cond - ((not list-type) - (gnus-error - 1.2 "Cannot read partial active file from %s server." - (car method))) - ((eq list-type 'active) - (gnus-active-to-gnus-format - method gnus-active-hashtb nil t)) - (t - (gnus-groups-to-gnus-format - method gnus-active-hashtb t)))))) - ((null method) - t) - (t - (if (not (gnus-request-list method)) - (unless (equal method gnus-message-archive-method) - (gnus-error 1 "Cannot read active file from %s server" - (car method))) - (gnus-message 5 mesg) - (gnus-active-to-gnus-format method gnus-active-hashtb nil t) - ;; We mark this active file as read. - (push method gnus-have-read-active-file) - (gnus-message 5 "%sdone" mesg)))))) - (setq methods (cdr methods)))))) - - -(defun gnus-ignored-newsgroups-has-to-p () - "T only when gnus-ignored-newsgroups includes \"^to\\\\.\" as an element." - ;; note this regexp is the same as: - ;; (concat (regexp-quote "^to\\.") "\\($\\|" (regexp-quote "\\|") "\\)") - (string-match "\\^to\\\\\\.\\($\\|\\\\|\\)" - gnus-ignored-newsgroups)) - -;; Read an active file and place the results in `gnus-active-hashtb'. -(defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors - real-active) - (unless method - (setq method gnus-select-method)) - (let ((cur (current-buffer)) - (hashtb (or hashtb - (if (and gnus-active-hashtb - (not (equal method gnus-select-method))) - gnus-active-hashtb - (setq gnus-active-hashtb - (if (equal method gnus-select-method) - (gnus-make-hashtable - (count-lines (point-min) (point-max))) - (gnus-make-hashtable 4096))))))) - ;; Delete unnecessary lines. - (goto-char (point-min)) - (cond ((gnus-ignored-newsgroups-has-to-p) - (delete-matching-lines gnus-ignored-newsgroups)) - ((string= gnus-ignored-newsgroups "") - (delete-matching-lines "^to\\.")) - (t - (delete-matching-lines (concat "^to\\.\\|" - gnus-ignored-newsgroups)))) - - ;; Make the group names readable as a lisp expression even if they - ;; contain special characters. - (goto-char (point-max)) - (while (re-search-backward "[][';?()#]" nil t) - (insert ?\\)) - - ;; Let the Gnus agent save the active file. - (when (and gnus-agent real-active) - (gnus-agent-save-active method)) - - ;; If these are groups from a foreign select method, we insert the - ;; group prefix in front of the group names. - (when (not (gnus-server-equal - (gnus-server-get-method nil method) - (gnus-server-get-method nil gnus-select-method))) - (let ((prefix (gnus-group-prefixed-name "" method))) - (goto-char (point-min)) - (while (and (not (eobp)) - (progn (insert prefix) - (zerop (forward-line 1))))))) - ;; Store the active file in a hash table. - (goto-char (point-min)) - (let (group max min) - (while (not (eobp)) - (condition-case () - (progn - (narrow-to-region (point) (gnus-point-at-eol)) - ;; group gets set to a symbol interned in the hash table - ;; (what a hack!!) - jwz - (setq group (let ((obarray hashtb)) (read cur))) - (if (and (numberp (setq max (read cur))) - (numberp (setq min (read cur))) - (progn - (skip-chars-forward " \t") - (not - (or (= (following-char) ?=) - (= (following-char) ?x) - (= (following-char) ?j))))) - (progn - (set group (cons min max)) - ;; if group is moderated, stick in moderation table - (when (= (following-char) ?m) - (unless gnus-moderated-hashtb - (setq gnus-moderated-hashtb (gnus-make-hashtable))) - (gnus-sethash (symbol-name group) t - gnus-moderated-hashtb))) - (set group nil))) - (error - (and group - (symbolp group) - (set group nil)) - (unless ignore-errors - (gnus-message 3 "Warning - illegal active: %s" - (buffer-substring - (gnus-point-at-bol) (gnus-point-at-eol)))))) - (widen) - (forward-line 1))))) - -(defun gnus-groups-to-gnus-format (method &optional hashtb real-active) - ;; Parse a "groups" active file. - (let ((cur (current-buffer)) - (hashtb (or hashtb - (if (and method gnus-active-hashtb) - gnus-active-hashtb - (setq gnus-active-hashtb - (gnus-make-hashtable - (count-lines (point-min) (point-max))))))) - (prefix (and method - (not (gnus-server-equal - (gnus-server-get-method nil method) - (gnus-server-get-method nil gnus-select-method))) - (gnus-group-prefixed-name "" method)))) - - ;; Let the Gnus agent save the active file. - (when (and gnus-agent real-active) - (gnus-agent-save-groups method)) - - (goto-char (point-min)) - ;; We split this into to separate loops, one with the prefix - ;; and one without to speed the reading up somewhat. - (if prefix - (let (min max opoint group) - (while (not (eobp)) - (condition-case () - (progn - (read cur) (read cur) - (setq min (read cur) - max (read cur) - opoint (point)) - (skip-chars-forward " \t") - (insert prefix) - (goto-char opoint) - (set (let ((obarray hashtb)) (read cur)) - (cons min max))) - (error (and group (symbolp group) (set group nil)))) - (forward-line 1))) - (let (min max group) - (while (not (eobp)) - (condition-case () - (when (= (following-char) ?2) - (read cur) (read cur) - (setq min (read cur) - max (read cur)) - (set (setq group (let ((obarray hashtb)) (read cur))) - (cons min max))) - (error (and group (symbolp group) (set group nil)))) - (forward-line 1)))))) - -(defun gnus-read-newsrc-file (&optional force) - "Read startup file. -If FORCE is non-nil, the .newsrc file is read." - ;; Reset variables that might be defined in the .newsrc.eld file. - (let ((variables gnus-variable-list)) - (while variables - (set (car variables) nil) - (setq variables (cdr variables)))) - (let* ((newsrc-file gnus-current-startup-file) - (quick-file (concat newsrc-file ".el"))) - (save-excursion - ;; We always load the .newsrc.eld file. If always contains - ;; much information that can not be gotten from the .newsrc - ;; file (ticked articles, killed groups, foreign methods, etc.) - (gnus-read-newsrc-el-file quick-file) - - (when (and (file-exists-p gnus-current-startup-file) - (or force - (and (file-newer-than-file-p newsrc-file quick-file) - (file-newer-than-file-p newsrc-file - (concat quick-file "d"))) - (not gnus-newsrc-alist))) - ;; We read the .newsrc file. Note that if there if a - ;; .newsrc.eld file exists, it has already been read, and - ;; the `gnus-newsrc-hashtb' has been created. While reading - ;; the .newsrc file, Gnus will only use the information it - ;; can find there for changing the data already read - - ;; i. e., reading the .newsrc file will not trash the data - ;; already read (except for read articles). - (save-excursion - (gnus-message 5 "Reading %s..." newsrc-file) - (set-buffer (nnheader-find-file-noselect newsrc-file)) - (buffer-disable-undo (current-buffer)) - (gnus-newsrc-to-gnus-format) - (kill-buffer (current-buffer)) - (gnus-message 5 "Reading %s...done" newsrc-file))) - - ;; Convert old to new. - (gnus-convert-old-newsrc)))) - -(defun gnus-convert-old-newsrc () - "Convert old newsrc into the new format, if needed." - (let ((fcv (and gnus-newsrc-file-version - (gnus-continuum-version gnus-newsrc-file-version)))) - (cond - ;; No .newsrc.eld file was loaded. - ((null fcv) nil) - ;; Gnus 5 .newsrc.eld was loaded. - ((< fcv (gnus-continuum-version "September Gnus v0.1")) - (gnus-convert-old-ticks))))) - -(defun gnus-convert-old-ticks () - (let ((newsrc (cdr gnus-newsrc-alist)) - marks info dormant ticked) - (while (setq info (pop newsrc)) - (when (setq marks (gnus-info-marks info)) - (setq dormant (cdr (assq 'dormant marks)) - ticked (cdr (assq 'tick marks))) - (when (or dormant ticked) - (gnus-info-set-read - info - (gnus-add-to-range - (gnus-info-read info) - (nconc (gnus-uncompress-range dormant) - (gnus-uncompress-range ticked))))))))) - -(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) - (condition-case nil - (load ding-file t t t) - (error - (ding) - (unless (gnus-yes-or-no-p - (format "Error in %s; continue? " ding-file)) - (error "Error in %s" ding-file)))) - (when gnus-newsrc-assoc - (setq gnus-newsrc-alist gnus-newsrc-assoc))) - (gnus-make-hashtable-from-newsrc-alist) - (when (file-newer-than-file-p file ding-file) - ;; Old format quick file - (gnus-message 5 "Reading %s..." file) - ;; The .el file is newer than the .eld file, so we read that one - ;; as well. - (gnus-read-old-newsrc-el-file file)))) - -;; Parse the old-style quick startup file -(defun gnus-read-old-newsrc-el-file (file) - (let (newsrc killed marked group m info) - (prog1 - (let ((gnus-killed-assoc nil) - gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc) - (prog1 - (ignore-errors - (load file t t t)) - (setq newsrc gnus-newsrc-assoc - killed gnus-killed-assoc - marked gnus-marked-assoc))) - (setq gnus-newsrc-alist nil) - (while (setq group (pop newsrc)) - (if (setq info (gnus-get-info (car group))) - (progn - (gnus-info-set-read info (cddr group)) - (gnus-info-set-level - info (if (nth 1 group) gnus-level-default-subscribed - gnus-level-default-unsubscribed)) - (push info gnus-newsrc-alist)) - (push (setq info - (list (car group) - (if (nth 1 group) gnus-level-default-subscribed - gnus-level-default-unsubscribed) - (cddr group))) - gnus-newsrc-alist)) - ;; Copy marks into info. - (when (setq m (assoc (car group) marked)) - (unless (nthcdr 3 info) - (nconc info (list nil))) - (gnus-info-set-marks - info (list (cons 'tick (gnus-compress-sequence - (sort (cdr m) '<) t)))))) - (setq newsrc killed) - (while newsrc - (setcar newsrc (caar newsrc)) - (setq newsrc (cdr newsrc))) - (setq gnus-killed-list killed)) - ;; The .el file version of this variable does not begin with - ;; "options", while the .eld version does, so we just add it if it - ;; isn't there. - (when - gnus-newsrc-options - (when (not (string-match "^ *options" gnus-newsrc-options)) - (setq gnus-newsrc-options (concat "options " gnus-newsrc-options))) - (when (not (string-match "\n$" gnus-newsrc-options)) - (setq gnus-newsrc-options (concat gnus-newsrc-options "\n"))) - ;; Finally, if we read some options lines, we parse them. - (unless (string= gnus-newsrc-options "") - (gnus-newsrc-parse-options gnus-newsrc-options))) - - (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)) - (gnus-make-hashtable-from-newsrc-alist))) - -(defun gnus-make-newsrc-file (file) - "Make server dependent file name by catenating FILE and server host name." - (let* ((file (expand-file-name file nil)) - (real-file (concat file "-" (nth 1 gnus-select-method)))) - (if (or (file-exists-p real-file) - (file-exists-p (concat real-file ".el")) - (file-exists-p (concat real-file ".eld"))) - real-file file))) - -(defun gnus-newsrc-to-gnus-format () - (setq gnus-newsrc-options "") - (setq gnus-newsrc-options-n nil) - - (unless gnus-active-hashtb - (setq gnus-active-hashtb (gnus-make-hashtable 4096))) - (let ((buf (current-buffer)) - (already-read (> (length gnus-newsrc-alist) 1)) - group subscribed options-symbol newsrc Options-symbol - symbol reads num1) - (goto-char (point-min)) - ;; We intern the symbol `options' in the active hashtb so that we - ;; can `eq' against it later. - (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil) - (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil) - - (while (not (eobp)) - ;; We first read the first word on the line by narrowing and - ;; then reading into `gnus-active-hashtb'. Most groups will - ;; already exist in that hashtb, so this will save some string - ;; space. - (narrow-to-region - (point) - (progn (skip-chars-forward "^ \t!:\n") (point))) - (goto-char (point-min)) - (setq symbol - (and (/= (point-min) (point-max)) - (let ((obarray gnus-active-hashtb)) (read buf)))) - (widen) - ;; Now, the symbol we have read is either `options' or a group - ;; name. If it is an options line, we just add it to a string. - (cond - ((or (eq symbol options-symbol) - (eq symbol Options-symbol)) - (setq gnus-newsrc-options - ;; This concating is quite inefficient, but since our - ;; thorough studies show that approx 99.37% of all - ;; .newsrc files only contain a single options line, we - ;; don't give a damn, frankly, my dear. - (concat gnus-newsrc-options - (buffer-substring - (gnus-point-at-bol) - ;; Options may continue on the next line. - (or (and (re-search-forward "^[^ \t]" nil 'move) - (progn (beginning-of-line) (point))) - (point))))) - (forward-line -1)) - (symbol - ;; Group names can be just numbers. - (when (numberp symbol) - (setq symbol (intern (int-to-string symbol) gnus-active-hashtb))) - (unless (boundp symbol) - (set symbol nil)) - ;; It was a group name. - (setq subscribed (= (following-char) ?:) - group (symbol-name symbol) - reads nil) - (if (eolp) - ;; If the line ends here, this is clearly a buggy line, so - ;; we put point a the beginning of line and let the cond - ;; below do the error handling. - (beginning-of-line) - ;; We skip to the beginning of the ranges. - (skip-chars-forward "!: \t")) - ;; We are now at the beginning of the list of read articles. - ;; We read them range by range. - (while - (cond - ((looking-at "[0-9]+") - ;; We narrow and read a number instead of buffer-substring/ - ;; string-to-int because it's faster. narrow/widen is - ;; faster than save-restriction/narrow, and save-restriction - ;; produces a garbage object. - (setq num1 (progn - (narrow-to-region (match-beginning 0) (match-end 0)) - (read buf))) - (widen) - ;; If the next character is a dash, then this is a range. - (if (= (following-char) ?-) - (progn - ;; We read the upper bound of the range. - (forward-char 1) - (if (not (looking-at "[0-9]+")) - ;; This is a buggy line, by we pretend that - ;; it's kinda OK. Perhaps the user should be - ;; dinged? - (push num1 reads) - (push - (cons num1 - (progn - (narrow-to-region (match-beginning 0) - (match-end 0)) - (read buf))) - reads) - (widen))) - ;; It was just a simple number, so we add it to the - ;; list of ranges. - (push num1 reads)) - ;; If the next char in ?\n, then we have reached the end - ;; of the line and return nil. - (/= (following-char) ?\n)) - ((= (following-char) ?\n) - ;; End of line, so we end. - nil) - (t - ;; Not numbers and not eol, so this might be a buggy - ;; line... - (unless (eobp) - ;; If it was eob instead of ?\n, we allow it. - ;; The line was buggy. - (setq group nil) - (gnus-error 3.1 "Mangled line: %s" - (buffer-substring (gnus-point-at-bol) - (gnus-point-at-eol)))) - nil)) - ;; Skip past ", ". Spaces are illegal in these ranges, but - ;; we allow them, because it's a common mistake to put a - ;; space after the comma. - (skip-chars-forward ", ")) - - ;; We have already read .newsrc.eld, so we gently update the - ;; data in the hash table with the information we have just - ;; read. - (when group - (let ((info (gnus-get-info group)) - level) - (if info - ;; There is an entry for this file in the alist. - (progn - (gnus-info-set-read info (nreverse reads)) - ;; We update the level very gently. In fact, we - ;; only change it if there's been a status change - ;; from subscribed to unsubscribed, or vice versa. - (setq level (gnus-info-level info)) - (cond ((and (<= level gnus-level-subscribed) - (not subscribed)) - (setq level (if reads - gnus-level-default-unsubscribed - (1+ gnus-level-default-unsubscribed)))) - ((and (> level gnus-level-subscribed) subscribed) - (setq level gnus-level-default-subscribed))) - (gnus-info-set-level info level)) - ;; This is a new group. - (setq info (list group - (if subscribed - gnus-level-default-subscribed - (if reads - (1+ gnus-level-subscribed) - gnus-level-default-unsubscribed)) - (nreverse reads)))) - (push info newsrc))))) - (forward-line 1)) - - (setq newsrc (nreverse newsrc)) - - (if (not already-read) - () - ;; We now have two newsrc lists - `newsrc', which is what we - ;; have read from .newsrc, and `gnus-newsrc-alist', which is - ;; what we've read from .newsrc.eld. We have to merge these - ;; lists. We do this by "attaching" any (foreign) groups in the - ;; gnus-newsrc-alist to the (native) group that precedes them. - (let ((rc (cdr gnus-newsrc-alist)) - (prev gnus-newsrc-alist) - entry mentry) - (while rc - (or (null (nth 4 (car rc))) ; It's a native group. - (assoc (caar rc) newsrc) ; It's already in the alist. - (if (setq entry (assoc (caar prev) newsrc)) - (setcdr (setq mentry (memq entry newsrc)) - (cons (car rc) (cdr mentry))) - (push (car rc) newsrc))) - (setq prev rc - rc (cdr rc))))) - - (setq gnus-newsrc-alist newsrc) - ;; We make the newsrc hashtb. - (gnus-make-hashtable-from-newsrc-alist) - - ;; Finally, if we read some options lines, we parse them. - (unless (string= gnus-newsrc-options "") - (gnus-newsrc-parse-options gnus-newsrc-options)))) - -;; Parse options lines to find "options -n !all rec.all" and stuff. -;; The return value will be a list on the form -;; ((regexp1 . ignore) -;; (regexp2 . subscribe)...) -;; When handling new newsgroups, groups that match a `ignore' regexp -;; will be ignored, and groups that match a `subscribe' regexp will be -;; subscribed. A line like -;; options -n !all rec.all -;; will lead to a list that looks like -;; (("^rec\\..+" . subscribe) -;; ("^.+" . ignore)) -;; So all "rec.*" groups will be subscribed, while all the other -;; groups will be ignored. Note that "options -n !all rec.all" is very -;; different from "options -n rec.all !all". -(defun gnus-newsrc-parse-options (options) - (let (out eol) - (save-excursion - (gnus-set-work-buffer) - (insert (regexp-quote options)) - ;; First we treat all continuation lines. - (goto-char (point-min)) - (while (re-search-forward "\n[ \t]+" nil t) - (replace-match " " t t)) - ;; Then we transform all "all"s into ".+"s. - (goto-char (point-min)) - (while (re-search-forward "\\ball\\b" nil t) - (replace-match ".+" t t)) - (goto-char (point-min)) - ;; We remove all other options than the "-n" ones. - (while (re-search-forward "[ \t]-[^n][^-]*" nil t) - (replace-match " ") - (forward-char -1)) - (goto-char (point-min)) - - ;; We are only interested in "options -n" lines - we - ;; ignore the other option lines. - (while (re-search-forward "[ \t]-n" nil t) - (setq eol - (or (save-excursion - (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t) - (- (point) 2))) - (gnus-point-at-eol))) - ;; Search for all "words"... - (while (re-search-forward "[^ \t,\n]+" eol t) - (if (= (char-after (match-beginning 0)) ?!) - ;; If the word begins with a bang (!), this is a "not" - ;; spec. We put this spec (minus the bang) and the - ;; symbol `ignore' into the list. - (push (cons (concat - "^" (buffer-substring - (1+ (match-beginning 0)) - (match-end 0)) - "\\($\\|\\.\\)") - 'ignore) - out) - ;; There was no bang, so this is a "yes" spec. - (push (cons (concat "^" (match-string 0) "\\($\\|\\.\\)") - 'subscribe) - out)))) - - (setq gnus-newsrc-options-n out)))) - -(defun gnus-save-newsrc-file (&optional force) - "Save .newsrc file." - ;; Note: We cannot save .newsrc file if all newsgroups are removed - ;; from the variable gnus-newsrc-alist. - (when (and (or gnus-newsrc-alist gnus-killed-list) - gnus-current-startup-file) - (save-excursion - (if (and (or gnus-use-dribble-file gnus-slave) - (not force) - (or (not gnus-dribble-buffer) - (not (buffer-name gnus-dribble-buffer)) - (zerop (save-excursion - (set-buffer gnus-dribble-buffer) - (buffer-size))))) - (gnus-message 4 "(No changes need to be saved)") - (gnus-run-hooks 'gnus-save-newsrc-hook) - (if gnus-slave - (gnus-slave-save-newsrc) - ;; Save .newsrc. - (when gnus-save-newsrc-file - (gnus-message 8 "Saving %s..." gnus-current-startup-file) - (gnus-gnus-to-newsrc-format) - (gnus-message 8 "Saving %s...done" gnus-current-startup-file)) - ;; Save .newsrc.eld. - (set-buffer (get-buffer-create " *Gnus-newsrc*")) - (make-local-variable 'version-control) - (setq version-control 'never) - (setq buffer-file-name - (concat gnus-current-startup-file ".eld")) - (setq default-directory (file-name-directory buffer-file-name)) - (gnus-add-current-to-buffer-list) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) - (gnus-gnus-to-quick-newsrc-format) - (gnus-run-hooks 'gnus-save-quick-newsrc-hook) - (save-buffer) - (kill-buffer (current-buffer)) - (gnus-message - 5 "Saving %s.eld...done" gnus-current-startup-file)) - (gnus-dribble-delete-file) - (gnus-group-set-mode-line))))) - -(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 "\ -;; 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 - (if (and gnus-save-killed-list - (stringp gnus-save-killed-list)) - (gnus-strip-killed-list) - gnus-killed-list)) - (variables - (if gnus-save-killed-list gnus-variable-list - ;; Remove the `gnus-killed-list' from the list of variables - ;; to be saved, if required. - (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))) - ;; Peel off the "dummy" group. - (gnus-newsrc-alist (cdr gnus-newsrc-alist)) - variable) - ;; Insert the variables into the file. - (while variables - (when (and (boundp (setq variable (pop variables))) - (symbol-value variable)) - (insert "(setq " (symbol-name variable) " '") - (gnus-prin1 (symbol-value variable)) - (insert ")\n")))))) - -(defun gnus-strip-killed-list () - "Return the killed list minus the groups that match `gnus-save-killed-list'." - (let ((list gnus-killed-list) - olist) - (while list - (when (string-match gnus-save-killed-list (car list)) - (push (car list) olist)) - (pop list)) - (nreverse olist))) - -(defun gnus-gnus-to-newsrc-format () - ;; Generate and save the .newsrc file. - (save-excursion - (set-buffer (create-file-buffer gnus-current-startup-file)) - (let ((newsrc (cdr gnus-newsrc-alist)) - (standard-output (current-buffer)) - info ranges range method) - (setq buffer-file-name gnus-current-startup-file) - (setq default-directory (file-name-directory buffer-file-name)) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - ;; Write options. - (when gnus-newsrc-options - (insert gnus-newsrc-options)) - ;; Write subscribed and unsubscribed. - (while (setq info (pop newsrc)) - ;; Don't write foreign groups to .newsrc. - (when (or (null (setq method (gnus-info-method info))) - (equal method "native") - (inline (gnus-server-equal method gnus-select-method))) - (insert (gnus-info-group info) - (if (> (gnus-info-level info) gnus-level-subscribed) - "!" ":")) - (when (setq ranges (gnus-info-read info)) - (insert " ") - (if (not (listp (cdr ranges))) - (if (= (car ranges) (cdr ranges)) - (princ (car ranges)) - (princ (car ranges)) - (insert "-") - (princ (cdr ranges))) - (while (setq range (pop ranges)) - (if (or (atom range) (= (car range) (cdr range))) - (princ (or (and (atom range) range) (car range))) - (princ (car range)) - (insert "-") - (princ (cdr range))) - (when ranges - (insert ","))))) - (insert "\n"))) - (make-local-variable 'version-control) - (setq version-control 'never) - ;; It has been reported that sometime the modtime on the .newsrc - ;; file seems to be off. We really do want to overwrite it, so - ;; we clear the modtime here before saving. It's a bit odd, - ;; though... - ;; sometimes the modtime clear isn't sufficient. most brute force: - ;; delete the silly thing entirely first. but this fails to provide - ;; such niceties as .newsrc~ creation. - (if gnus-modtime-botch - (delete-file gnus-startup-file) - (clear-visited-file-modtime)) - (gnus-run-hooks 'gnus-save-standard-newsrc-hook) - (save-buffer) - (kill-buffer (current-buffer))))) - - -;;; -;;; Slave functions. -;;; - -(defun gnus-slave-save-newsrc () - (save-excursion - (set-buffer gnus-dribble-buffer) - (let ((slave-name - (make-temp-name (concat gnus-current-startup-file "-slave-"))) - (modes (ignore-errors - (file-modes (concat gnus-current-startup-file ".eld"))))) - (gnus-write-buffer slave-name) - (when modes - (set-file-modes slave-name modes))))) - -(defun gnus-master-read-slave-newsrc () - (let ((slave-files - (directory-files - (file-name-directory gnus-current-startup-file) - t (concat - "^" (regexp-quote - (concat - (file-name-nondirectory gnus-current-startup-file) - "-slave-"))) - t)) - file) - (if (not slave-files) - () ; There are no slave files to read. - (gnus-message 7 "Reading slave newsrcs...") - (save-excursion - (set-buffer (get-buffer-create " *gnus slave*")) - (buffer-disable-undo (current-buffer)) - (setq slave-files - (sort (mapcar (lambda (file) - (list (nth 5 (file-attributes file)) file)) - slave-files) - (lambda (f1 f2) - (or (< (caar f1) (caar f2)) - (< (nth 1 (car f1)) (nth 1 (car f2))))))) - (while slave-files - (erase-buffer) - (setq file (nth 1 (car slave-files))) - (insert-file-contents file) - (when (condition-case () - (progn - (eval-buffer (current-buffer)) - t) - (error - (gnus-error 3.2 "Possible error in %s" file) - nil)) - (unless gnus-slave ; Slaves shouldn't delete these files. - (ignore-errors - (delete-file file)))) - (setq slave-files (cdr slave-files)))) - (gnus-dribble-touch) - (gnus-message 7 "Reading slave newsrcs...done")))) - - -;;; -;;; Group description. -;;; - -(defun gnus-read-all-descriptions-files () - (let ((methods (cons gnus-select-method - (nconc - (when (gnus-archive-server-wanted-p) - (list "archive")) - gnus-secondary-select-methods)))) - (while methods - (gnus-read-descriptions-file (car methods)) - (setq methods (cdr methods))) - t)) - -(defun gnus-read-descriptions-file (&optional method) - (let ((method (or method gnus-select-method)) - group) - (when (stringp method) - (setq method (gnus-server-to-method method))) - ;; We create the hashtable whether we manage to read the desc file - ;; to avoid trying to re-read after a failed read. - (unless gnus-description-hashtb - (setq gnus-description-hashtb - (gnus-make-hashtable (length gnus-active-hashtb)))) - ;; Mark this method's desc file as read. - (gnus-sethash (gnus-group-prefixed-name "" method) "Has read" - gnus-description-hashtb) - - (gnus-message 5 "Reading descriptions file via %s..." (car method)) - (cond - ((not (gnus-check-server method)) - (gnus-message 1 "Couldn't open server") - nil) - ((not (gnus-request-list-newsgroups method)) - (gnus-message 1 "Couldn't read newsgroups descriptions") - nil) - (t - (save-excursion - (save-restriction - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (or (search-forward "\n.\n" nil t) - (goto-char (point-max))) - (beginning-of-line) - (narrow-to-region (point-min) (point))) - ;; If these are groups from a foreign select method, we insert the - ;; group prefix in front of the group names. - (and method (not (inline - (gnus-server-equal - (gnus-server-get-method nil method) - (gnus-server-get-method - nil gnus-select-method)))) - (let ((prefix (gnus-group-prefixed-name "" method))) - (goto-char (point-min)) - (while (and (not (eobp)) - (progn (insert prefix) - (zerop (forward-line 1))))))) - (goto-char (point-min)) - (while (not (eobp)) - ;; If we get an error, we set group to 0, which is not a - ;; symbol... - (setq group - (condition-case () - (let ((obarray gnus-description-hashtb)) - ;; Group is set to a symbol interned in this - ;; hash table. - (read nntp-server-buffer)) - (error 0))) - (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 (boundp 'enable-multibyte-characters) - enable-multibyte-characters - (fboundp 'gnus-mule-get-coding-system) - (gnus-mule-get-coding-system (symbol-name group))))) - (if coding - (setq str (gnus-decode-coding-string str (car coding)))) - (set group str))) - (forward-line 1)))) - (gnus-message 5 "Reading descriptions file...done") - t)))) - -(defun gnus-group-get-description (group) - "Get the description of a group by sending XGTITLE to the server." - (when (gnus-request-group-description group) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (looking-at "[^ \t]+[ \t]+\\(.*\\)") - (match-string 1))))) - -;;;###autoload -(defun gnus-declare-backend (name &rest abilities) - "Declare backend NAME with ABILITIES as a Gnus backend." - (setq gnus-valid-select-methods - (nconc gnus-valid-select-methods - (list (apply 'list name abilities))))) - -(defun gnus-set-default-directory () - "Set the default directory in the current buffer to `gnus-default-directory'. -If this variable is nil, don't do anything." - (setq default-directory - (if (and gnus-default-directory - (file-exists-p gnus-default-directory)) - (file-name-as-directory (expand-file-name gnus-default-directory)) - default-directory))) - -(provide 'gnus-start) - -;;; gnus-start.el ends here diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el deleted file mode 100644 index 1db55dd..0000000 --- a/lisp/gnus-sum.el +++ /dev/null @@ -1,9016 +0,0 @@ -;;; gnus-sum.el --- summary mode commands for Semi-gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko -;; Keywords: mail, news, MIME - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-group) -(require 'gnus-spec) -(require 'gnus-range) -(require 'gnus-int) -(require 'gnus-undo) -(require 'std11) -(require 'mime-view) -(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) -(autoload 'gnus-set-summary-default-charset "gnus-i18n" nil t) - -(defcustom gnus-kill-summary-on-exit t - "*If non-nil, kill the summary buffer when you exit from it. -If nil, the summary will become a \"*Dead Summary*\" buffer, and -it will be killed sometime later." - :group 'gnus-summary-exit - :type 'boolean) - -(defcustom gnus-fetch-old-headers nil - "*Non-nil means that Gnus will try to build threads by grabbing old headers. -If an unread article in the group refers to an older, already read (or -just marked as read) article, the old article will not normally be -displayed in the Summary buffer. If this variable is non-nil, Gnus -will attempt to grab the headers to the old articles, and thereby -build complete threads. If it has the value `some', only enough -headers to connect otherwise loose threads will be displayed. This -variable can also be a number. In that case, no more than that number -of old headers will be fetched. If it has the value `invisible', all -old headers will be fetched, but none will be displayed. - -The server has to support NOV for any of this to work." - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const some) - number - (sexp :menu-tag "other" t))) - -(defcustom gnus-refer-thread-limit 200 - "*The number of old headers to fetch when doing \\\\[gnus-summary-refer-thread]. -If t, fetch all the available old headers." - :group 'gnus-thread - :type '(choice number - (sexp :menu-tag "other" t))) - -(defcustom gnus-summary-make-false-root 'adopt - "*nil means that Gnus won't gather loose threads. -If the root of a thread has expired or been read in a previous -session, the information necessary to build a complete thread has been -lost. Instead of having many small sub-threads from this original thread -scattered all over the summary buffer, Gnus can gather them. - -If non-nil, Gnus will try to gather all loose sub-threads from an -original thread into one large thread. - -If this variable is non-nil, it should be one of `none', `adopt', -`dummy' or `empty'. - -If this variable is `none', Gnus will not make a false root, but just -present the sub-threads after another. -If this variable is `dummy', Gnus will create a dummy root that will -have all the sub-threads as children. -If this variable is `adopt', Gnus will make one of the \"children\" -the parent and mark all the step-children as such. -If this variable is `empty', the \"children\" are printed with empty -subject fields. (Or rather, they will be printed with a string -given by the `gnus-summary-same-subject' variable.)" - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const none) - (const dummy) - (const adopt) - (const empty))) - -(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 -there can be many false gatherings performed. By rooting out certain -common subjects, gathering might become saner." - :group 'gnus-thread - :type 'regexp) - -(defcustom gnus-summary-gather-subject-limit nil - "*Maximum length of subject comparisons when gathering loose threads. -Use nil to compare full subjects. Setting this variable to a low -number will help gather threads that have been corrupted by -newsreaders chopping off subject lines, but it might also mean that -unrelated articles that have subject that happen to begin with the -same few characters will be incorrectly gathered. - -If this variable is `fuzzy', Gnus will use a fuzzy algorithm when -comparing subjects." - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const fuzzy) - (sexp :menu-tag "on" t))) - -(defcustom gnus-simplify-subject-functions nil - "*List of functions taking a string argument that simplify subjects. -The functions are applied recursively." - :group 'gnus-thread - :type '(repeat (list function))) - -(defcustom gnus-simplify-ignored-prefixes nil - "*Regexp, matches for which are removed from subject lines when simplifying fuzzily." - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - regexp)) - -(defcustom gnus-build-sparse-threads nil - "*If non-nil, fill in the gaps in threads. -If `some', only fill in the gaps that are needed to tie loose threads -together. If `more', fill in all leaf nodes that Gnus can find. If -non-nil and non-`some', fill in all gaps that Gnus manages to guess." - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const some) - (const more) - (sexp :menu-tag "all" t))) - -(defcustom gnus-summary-thread-gathering-function - 'gnus-gather-threads-by-subject - "*Function used for gathering loose threads. -There are two pre-defined functions: `gnus-gather-threads-by-subject', -which only takes Subjects into consideration; and -`gnus-gather-threads-by-references', which compared the References -headers of the articles to find matches." - :group 'gnus-thread - :type '(radio (function-item gnus-gather-threads-by-subject) - (function-item gnus-gather-threads-by-references) - (function :tag "other"))) - -(defcustom gnus-summary-same-subject "" - "*String indicating that the current article has the same subject as the previous. -This variable will only be used if the value of -`gnus-summary-make-false-root' is `empty'." - :group 'gnus-summary-format - :type 'string) - -(defcustom gnus-summary-goto-unread t - "*If t, marking commands will go to the next unread article. -If `never', commands that usually go to the next unread article, will -go to the next article, whether it is read or not. -If nil, only the marking commands will go to the next (un)read article." - :group 'gnus-summary-marks - :link '(custom-manual "(gnus)Setting Marks") - :type '(choice (const :tag "off" nil) - (const never) - (sexp :menu-tag "on" t))) - -(defcustom gnus-summary-default-score 0 - "*Default article score level. -All scores generated by the score files will be added to this score. -If this variable is nil, scoring will be disabled." - :group 'gnus-score-default - :type '(choice (const :tag "disable") - 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' -will not be marked." - :group 'gnus-summary-format - :type 'integer) - -(defcustom gnus-simplify-subject-fuzzy-regexp nil - "*Strings to be removed when doing fuzzy matches. -This can either be a regular expression or list of regular expressions -that will be removed from subject strings if fuzzy subject -simplification is selected." - :group 'gnus-thread - :type '(repeat regexp)) - -(defcustom gnus-show-threads t - "*If non-nil, display threads in summary mode." - :group 'gnus-thread - :type 'boolean) - -(defcustom gnus-thread-hide-subtree nil - "*If non-nil, hide all threads initially. -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." - :group 'gnus-thread - :type 'boolean) - -(defcustom gnus-thread-hide-killed t - "*If non-nil, hide killed threads automatically." - :group 'gnus-thread - :type 'boolean) - -(defcustom gnus-thread-ignore-subject nil - "*If non-nil, ignore subjects and do all threading based on the Reference header. -If nil, which is the default, articles that have different subjects -from their parents will start separate threads." - :group 'gnus-thread - :type 'boolean) - -(defcustom gnus-thread-operation-ignore-subject t - "*If non-nil, subjects will be ignored when doing thread commands. -This affects commands like `gnus-summary-kill-thread' and -`gnus-summary-lower-thread'. - -If this variable is nil, articles in the same thread with different -subjects will not be included in the operation in question. If this -variable is `fuzzy', only articles that have subjects that are fuzzily -equal will be included." - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const fuzzy) - (sexp :tag "on" t))) - -(defcustom gnus-thread-indent-level 4 - "*Number that says how much each sub-thread should be indented." - :group 'gnus-thread - :type 'integer) - -(defcustom gnus-auto-extend-newsgroup t - "*If non-nil, extend newsgroup forward and backward when requested." - :group 'gnus-summary-choose - :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 neither nil nor `best', select the first 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'." - :group 'gnus-group-select - :type '(choice (const :tag "none" nil) - (const best) - (sexp :menu-tag "first" t))) - -(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 -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 -will go to the next group without confirmation." - :group 'gnus-summary-maneuvering - :type '(choice (const :tag "off" nil) - (const quietly) - (const almost-quietly) - (const slightly-quietly) - (sexp :menu-tag "on" t))) - -(defcustom gnus-auto-select-same nil - "*If non-nil, select the next article with the same subject." - :group 'gnus-summary-maneuvering - :type 'boolean) - -(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 -current article is unread." - :group 'gnus-summary-maneuvering - :type 'boolean) - -(defcustom gnus-auto-center-summary t - "*If non-nil, always center the current summary buffer. -In particular, if `vertical' do only vertical recentering. If non-nil -and non-`vertical', do both horizontal and vertical recentering." - :group 'gnus-summary-maneuvering - :type '(choice (const :tag "none" nil) - (const vertical) - (sexp :menu-tag "both" t))) - -(defcustom gnus-show-all-headers nil - "*If non-nil, don't hide any headers." - :group 'gnus-article-hiding - :group 'gnus-article-headers - :type 'boolean) - -(defcustom gnus-summary-ignore-duplicates nil - "*If non-nil, ignore articles with identical Message-ID headers." - :group 'gnus-summary - :type 'boolean) - -(defcustom gnus-single-article-buffer t - "*If non-nil, display all articles in the same buffer. -If nil, each group will get its own article buffer." - :group 'gnus-article-various - :type 'boolean) - -(defcustom gnus-break-pages t - "*If non-nil, do page breaking on articles. -The page delimiter is specified by the `gnus-page-delimiter' -variable." - :group 'gnus-article-various - :type 'boolean) - -(defcustom gnus-show-mime t - "*If non-nil, do mime processing of articles. -The articles will simply be fed to the function given by -`gnus-show-mime-method'." - :group 'gnus-article-mime - :type 'boolean) - -(defcustom gnus-move-split-methods nil - "*Variable used to suggest where articles are to be moved to. -It uses the same syntax as the `gnus-split-methods' variable." - :group 'gnus-summary-mail - :type '(repeat (choice (list :value (fun) function) - (cons :value ("" "") regexp (repeat string)) - (sexp :value nil)))) - -(defcustom gnus-unread-mark ? - "*Mark used for unread articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-ticked-mark ?! - "*Mark used for ticked articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-dormant-mark ?? - "*Mark used for dormant articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-del-mark ?r - "*Mark used for del'd articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-read-mark ?R - "*Mark used for read articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-expirable-mark ?E - "*Mark used for expirable articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-killed-mark ?K - "*Mark used for killed articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-souped-mark ?F - "*Mark used for killed articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-kill-file-mark ?X - "*Mark used for articles killed by kill files." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-low-score-mark ?Y - "*Mark used for articles with a low score." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-catchup-mark ?C - "*Mark used for articles that are caught up." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-replied-mark ?A - "*Mark used for articles that have been replied to." - :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." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-ancient-mark ?O - "*Mark used for ancient articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-sparse-mark ?Q - "*Mark used for sparsely reffed articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-canceled-mark ?G - "*Mark used for canceled articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-duplicate-mark ?M - "*Mark used for duplicate articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-undownloaded-mark ?@ - "*Mark used for articles that weren't downloaded." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-downloadable-mark ?% - "*Mark used for articles that are to be downloaded." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-unsendable-mark ?= - "*Mark used for articles that won't be sent." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-score-over-mark ?+ - "*Score mark used for articles with high scores." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-score-below-mark ?- - "*Score mark used for articles with low scores." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-empty-thread-mark ? - "*There is no thread under the article." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-not-empty-thread-mark ?= - "*There is a thread under the article." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-view-pseudo-asynchronously nil - "*If non-nil, Gnus will view pseudo-articles asynchronously." - :group 'gnus-extract-view - :type 'boolean) - -(defcustom gnus-view-pseudos nil - "*If `automatic', pseudo-articles will be viewed automatically. -If `not-confirm', pseudos will be viewed automatically, and the user -will not be asked to confirm the command." - :group 'gnus-extract-view - :type '(choice (const :tag "off" nil) - (const automatic) - (const not-confirm))) - -(defcustom gnus-view-pseudos-separately t - "*If non-nil, one pseudo-article will be created for each file to be viewed. -If nil, all files that use the same viewing command will be given as a -list of parameters to that command." - :group 'gnus-extract-view - :type 'boolean) - -(defcustom gnus-insert-pseudo-articles t - "*If non-nil, insert pseudo-articles when decoding articles." - :group 'gnus-extract-view - :type 'boolean) - -(defcustom gnus-summary-dummy-line-format - "* %(: :%) %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" - :group 'gnus-threading - :type 'string) - -(defcustom gnus-summary-mode-line-format "Gnus: %%b [%A] %Z" - "*The format specification for the summary mode line. -It works along the same lines as a normal formatting string, -with some simple extensions: - -%G Group name -%p Unprefixed group name -%A Current article number -%V Gnus version -%U Number of unread articles in the group -%e Number of unselected articles in the group -%Z A string with unread/unselected article counts -%g Shortish group name -%S Subject of the current article -%u User-defined spec -%s Current score file name -%d Number of dormant articles -%r Number of articles that have been marked as read in this session -%E Number of articles expunged by the score files" - :group 'gnus-summary-format - :type 'string) - -(defcustom gnus-summary-mark-below 0 - "*Mark all articles with a score below this variable as read. -This variable is local to each summary buffer and usually set by the -score file." - :group 'gnus-score-default - :type 'integer) - -(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." - :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 :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. - -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')." - :group 'gnus-summary-sort - :type '(repeat (choice (function-item gnus-thread-sort-by-number) - (function-item gnus-thread-sort-by-author) - (function-item gnus-thread-sort-by-subject) - (function-item gnus-thread-sort-by-date) - (function-item gnus-thread-sort-by-score) - (function-item gnus-thread-sort-by-total-score) - (function :tag "other")))) - -(defcustom gnus-thread-score-function '+ - "*Function used for calculating the total score of a thread. - -The function is called with the scores of the article and each -subthread and should then return the score of the thread. - -Some functions you can use are `+', `max', or `min'." - :group 'gnus-summary-sort - :type 'function) - -(defcustom gnus-summary-expunge-below nil - "*All articles that have a score less than this variable will be expunged. -This variable is local to the summary buffers." - :group 'gnus-score-default - :type '(choice (const :tag "off" nil) - integer)) - -(defcustom gnus-thread-expunge-below nil - "*All threads that have a total score less than this variable will be expunged. -See `gnus-thread-score-function' for en explanation of what a -\"thread score\" is. - -This variable is local to the summary buffers." - :group 'gnus-treading - :group 'gnus-score-default - :type '(choice (const :tag "off" nil) - integer)) - -(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." - :group 'gnus-summary-various - :type 'hook) - -(defcustom gnus-summary-menu-hook nil - "*Hook run after the creation of the summary mode menu." - :group 'gnus-summary-visual - :type 'hook) - -(defcustom gnus-summary-exit-hook nil - "*A hook called on exit from the summary buffer. -It will be called with point in the group buffer." - :group 'gnus-summary-exit - :type 'hook) - -(defcustom gnus-summary-prepare-hook nil - "*A hook called after the summary buffer has been generated. -If you want to modify the summary buffer, you can use this hook." - :group 'gnus-summary-various - :type 'hook) - -(defcustom gnus-summary-prepared-hook nil - "*A hook called as the last thing after the summary buffer has been generated." - :group 'gnus-summary-various - :type 'hook) - -(defcustom gnus-summary-generate-hook nil - "*A hook run just before generating the summary buffer. -This hook is commonly used to customize threading variables and the -like." - :group 'gnus-summary-various - :type 'hook) - -(defcustom gnus-select-group-hook nil - "*A hook called when a newsgroup is selected. - -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))))" - :group 'gnus-group-select - :type 'hook) - -(defcustom gnus-select-article-hook nil - "*A hook called when an article is selected." - :group 'gnus-summary-choose - :type 'hook) - -(defcustom gnus-visual-mark-article-hook - (list 'gnus-highlight-selected-summary) - "*Hook run after selecting an article in the summary buffer. -It is meant to be used for highlighting the article in some way. It -is not run if `gnus-visual' is nil." - :group 'gnus-summary-visual - :type 'hook) - -;; 1997/5/4 by MORIOKA Tomohiko -(defcustom gnus-structured-field-decoder - (function - (lambda (string) - (eword-decode-structured-field-body - (std11-unfold-string string) 'must-unfold) - )) - "*Function to decode non-ASCII characters in structured field for summary." - :group 'gnus-various - :type 'function) - -(defcustom gnus-unstructured-field-decoder - (function - (lambda (string) - (eword-decode-unstructured-field-body - (std11-unfold-string string) 'must-unfold) - )) - "*Function to decode non-ASCII characters in unstructured field for summary." - :group 'gnus-various - :type 'function) - -(defcustom gnus-parse-headers-hook - '(gnus-set-summary-default-charset) - "*A hook called before parsing the headers." - :group 'gnus-various - :type 'hook) - -(defcustom gnus-exit-group-hook nil - "*A hook called when exiting (not quitting) summary mode." - :group 'gnus-various - :type 'hook) - -(defcustom gnus-summary-update-hook - (list 'gnus-summary-highlight-line) - "*A hook called when a summary line is changed. -The hook will not be called if `gnus-visual' is nil. - -The default function `gnus-summary-highlight-line' will -highlight the line according to the `gnus-summary-highlight' -variable." - :group 'gnus-summary-visual - :type 'hook) - -(defcustom gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read) - "*A hook called when an article is selected for the first time. -The hook is intended to mark an article as read (or unread) -automatically when it is selected." - :group 'gnus-summary-choose - :type 'hook) - -(defcustom gnus-group-no-more-groups-hook nil - "*A hook run when returning to group mode having no more (unread) groups." - :group 'gnus-group-select - :type 'hook) - -(defcustom gnus-ps-print-hook nil - "*A hook run before ps-printing something from Gnus." - :group 'gnus-summary - :type 'hook) - -(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) - -(defcustom gnus-summary-highlight - '(((= mark gnus-canceled-mark) - . gnus-summary-cancelled-face) - ((and (> score default) - (or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark))) - . gnus-summary-high-ticked-face) - ((and (< score default) - (or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark))) - . gnus-summary-low-ticked-face) - ((or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark)) - . gnus-summary-normal-ticked-face) - ((and (> score default) (= mark gnus-ancient-mark)) - . gnus-summary-high-ancient-face) - ((and (< score default) (= mark gnus-ancient-mark)) - . gnus-summary-low-ancient-face) - ((= mark gnus-ancient-mark) - . gnus-summary-normal-ancient-face) - ((and (> score default) (= mark gnus-unread-mark)) - . gnus-summary-high-unread-face) - ((and (< score default) (= mark gnus-unread-mark)) - . gnus-summary-low-unread-face) - ((memq mark (list gnus-unread-mark gnus-downloadable-mark - gnus-undownloaded-mark)) - . gnus-summary-normal-unread-face) - ((> score default) - . gnus-summary-high-read-face) - ((< score default) - . gnus-summary-low-read-face) - (t - . gnus-summary-normal-read-face)) - "*Controls the highlighting of summary buffer lines. - -A list of (FORM . FACE) pairs. When deciding how a a particular -summary line should be displayed, each form is evaluated. The content -of the face field after the first true form is used. You can change -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." - :group 'gnus-summary-visual - :type '(repeat (cons (sexp :tag "Form" nil) - face))) - -(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.") - -;;; Internal variables - -(defvar gnus-scores-exclude-files nil) -(defvar gnus-page-broken nil) - -(defvar gnus-original-article nil) -(defvar gnus-article-internal-prepare-hook nil) -(defvar gnus-newsgroup-process-stack nil) - -(defvar gnus-thread-indent-array nil) -(defvar gnus-thread-indent-array-level gnus-thread-indent-level) - -;; Avoid highlighting in kill files. -(defvar gnus-summary-inhibit-highlight nil) -(defvar gnus-newsgroup-selected-overlay nil) -(defvar gnus-inhibit-limiting nil) -(defvar gnus-newsgroup-adaptive-score-file nil) -(defvar gnus-current-score-file nil) -(defvar gnus-current-move-group nil) -(defvar gnus-current-copy-group nil) -(defvar gnus-current-crosspost-group nil) - -(defvar gnus-newsgroup-dependencies nil) -(defvar gnus-newsgroup-adaptive nil) -(defvar gnus-summary-display-article-function nil) -(defvar gnus-summary-highlight-line-function nil - "Function called after highlighting a summary line.") - -(defvar gnus-summary-line-format-alist - `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d) - (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s) - (?s gnus-tmp-subject-or-nil ?s) - (?n gnus-tmp-name ?s) - (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from))) - ?s) - (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) - gnus-tmp-from) ?s) - (?F gnus-tmp-from ?s) - (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) - (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s) - (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s) - (?o (gnus-date-iso8601 gnus-tmp-header) ?s) - (?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) - (?I gnus-tmp-indentation ?s) - (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) - (?R gnus-tmp-replied ?c) - (?\[ gnus-tmp-opening-bracket ?c) - (?\] gnus-tmp-closing-bracket ?c) - (?\> (make-string gnus-tmp-level ? ) ?s) - (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s) - (?i gnus-tmp-score ?d) - (?z gnus-tmp-score-char ?c) - (?l (bbb-grouplens-score gnus-tmp-header) ?s) - (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d) - (?U gnus-tmp-unread ?c) - (?t (gnus-summary-number-of-articles-in-thread - (and (boundp 'thread) (car thread)) gnus-tmp-level) - ?d) - (?e (gnus-summary-number-of-articles-in-thread - (and (boundp 'thread) (car thread)) gnus-tmp-level t) - ?c) - (?u gnus-tmp-user-defined ?s) - (?P (gnus-pick-line-number) ?d)) - "An alist of format specifications that can appear in summary lines, -and what variables they correspond with, along with the type of the -variable (string, integer, character, etc).") - -(defvar gnus-summary-dummy-line-format-alist - `((?S gnus-tmp-subject ?s) - (?N gnus-tmp-number ?d) - (?u gnus-tmp-user-defined ?s))) - -(defvar gnus-summary-mode-line-format-alist - `((?G gnus-tmp-group-name ?s) - (?g (gnus-short-group-name gnus-tmp-group-name) ?s) - (?p (gnus-group-real-name gnus-tmp-group-name) ?s) - (?A gnus-tmp-article-number ?d) - (?Z gnus-tmp-unread-and-unselected ?s) - (?V gnus-version ?s) - (?U gnus-tmp-unread-and-unticked ?d) - (?S gnus-tmp-subject ?s) - (?e gnus-tmp-unselected ?d) - (?u gnus-tmp-user-defined ?s) - (?d (length gnus-newsgroup-dormant) ?d) - (?t (length gnus-newsgroup-marked) ?d) - (?r (length gnus-newsgroup-reads) ?d) - (?E gnus-newsgroup-expunged-tally ?d) - (?s (gnus-current-score-file-nondirectory) ?s))) - -(defvar gnus-last-search-regexp nil - "Default regexp for article search command.") - -(defvar gnus-last-shell-command nil - "Default shell command on article.") - -(defvar gnus-newsgroup-begin nil) -(defvar gnus-newsgroup-end nil) -(defvar gnus-newsgroup-last-rmail nil) -(defvar gnus-newsgroup-last-mail nil) -(defvar gnus-newsgroup-last-folder nil) -(defvar gnus-newsgroup-last-file nil) -(defvar gnus-newsgroup-auto-expire nil) -(defvar gnus-newsgroup-active nil) - -(defvar gnus-newsgroup-data nil) -(defvar gnus-newsgroup-data-reverse nil) -(defvar gnus-newsgroup-limit nil) -(defvar gnus-newsgroup-limits nil) - -(defvar gnus-newsgroup-unreads nil - "List of unread articles in the current newsgroup.") - -(defvar gnus-newsgroup-unselected nil - "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.") - -(defvar gnus-newsgroup-expunged-tally nil) - -(defvar gnus-newsgroup-marked nil - "List of ticked articles in the current newsgroup (a subset of unread art).") - -(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.") - -(defvar gnus-newsgroup-saved nil - "List of articles that have been saved.") - -(defvar gnus-newsgroup-kill-headers nil) - -(defvar gnus-newsgroup-replied nil - "List of articles that have been replied to in the current newsgroup.") - -(defvar gnus-newsgroup-expirable nil - "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.") - -(defvar gnus-newsgroup-undownloaded nil - "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.") - -(defvar gnus-newsgroup-bookmarks nil - "List of articles in the current newsgroup that have bookmarks.") - -(defvar gnus-newsgroup-dormant nil - "List of dormant articles in the current newsgroup.") - -(defvar gnus-newsgroup-scored nil - "List of scored articles in the current newsgroup.") - -(defvar gnus-newsgroup-headers nil - "List of article headers in the current newsgroup.") - -(defvar gnus-newsgroup-threads nil) - -(defvar gnus-newsgroup-prepared nil - "Whether the current group has been prepared properly.") - -(defvar gnus-newsgroup-ancient nil - "List of `gnus-fetch-old-headers' articles in the current newsgroup.") - -(defvar gnus-newsgroup-sparse nil) - -(defvar gnus-current-article nil) -(defvar gnus-article-current nil) -(defvar gnus-current-headers nil) -(defvar gnus-have-all-headers nil) -(defvar gnus-last-article nil) -(defvar gnus-newsgroup-history nil) - -(defconst 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-reads gnus-newsgroup-saved - gnus-newsgroup-replied gnus-newsgroup-expirable - gnus-newsgroup-processable gnus-newsgroup-killed - gnus-newsgroup-downloadable gnus-newsgroup-undownloaded - gnus-newsgroup-unsendable - gnus-newsgroup-bookmarks gnus-newsgroup-dormant - gnus-newsgroup-headers gnus-newsgroup-threads - gnus-newsgroup-prepared gnus-summary-highlight-line-function - gnus-current-article gnus-current-headers gnus-have-all-headers - gnus-last-article gnus-article-internal-prepare-hook - gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay - gnus-newsgroup-scored gnus-newsgroup-kill-headers - gnus-thread-expunge-below - gnus-score-alist gnus-current-score-file gnus-summary-expunge-below - (gnus-summary-mark-below . global) - gnus-newsgroup-active gnus-scores-exclude-files - gnus-newsgroup-history gnus-newsgroup-ancient - gnus-newsgroup-sparse gnus-newsgroup-process-stack - (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring) - gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1) - (gnus-newsgroup-expunged-tally . 0) - gnus-cache-removable-articles gnus-newsgroup-cached - gnus-newsgroup-data gnus-newsgroup-data-reverse - gnus-newsgroup-limit gnus-newsgroup-limits) - "Variables that are buffer-local to the summary buffers.") - -;; Byte-compiler warning. -(defvar gnus-article-mode-map) - -;; Subject simplification. - -(defun gnus-simplify-whitespace (str) - "Remove excessive whitespace." - (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)) - -(defsubst gnus-simplify-subject-re (subject) - "Remove \"Re:\" from subject lines." - (if (string-match "^[Rr][Ee]: *" subject) - (substring subject (match-end 0)) - subject)) - -(defun gnus-simplify-subject (subject &optional re-only) - "Remove `Re:' and words in parentheses. -If RE-ONLY is non-nil, strip leading `Re:'s only." - (let ((case-fold-search t)) ;Ignore case. - ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'. - (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject) - (setq subject (substring subject (match-end 0)))) - ;; Remove uninteresting prefixes. - (when (and (not re-only) - gnus-simplify-ignored-prefixes - (string-match gnus-simplify-ignored-prefixes subject)) - (setq subject (substring subject (match-end 0)))) - ;; Remove words in parentheses from end. - (unless re-only - (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject) - (setq subject (substring subject 0 (match-beginning 0))))) - ;; Return subject string. - subject)) - -;; Remove any leading "re:"s, any trailing paren phrases, and simplify -;; all whitespace. -(defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (replace-match (or newtext "")))) - -(defun gnus-simplify-buffer-fuzzy () - "Simplify string in the buffer fuzzily. -The string in the accessible portion of the current buffer is simplified. -It is assumed to be a single-line subject. -Whitespace is generally cleaned up, and miscellaneous leading/trailing -matter is removed. Additional things can be deleted by setting -gnus-simplify-subject-fuzzy-regexp." - (let ((case-fold-search t) - (modified-tick)) - (gnus-simplify-buffer-fuzzy-step "\t" " ") - - (while (not (eq modified-tick (buffer-modified-tick))) - (setq modified-tick (buffer-modified-tick)) - (cond - ((listp gnus-simplify-subject-fuzzy-regexp) - (mapcar 'gnus-simplify-buffer-fuzzy-step - gnus-simplify-subject-fuzzy-regexp)) - (gnus-simplify-subject-fuzzy-regexp - (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp))) - (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *") - (gnus-simplify-buffer-fuzzy-step - "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *") - (gnus-simplify-buffer-fuzzy-step "^[[].*:\\( .*\\)[]]$" "\\1")) - - (gnus-simplify-buffer-fuzzy-step " *[[{(][^()\n]*[]})] *$") - (gnus-simplify-buffer-fuzzy-step " +" " ") - (gnus-simplify-buffer-fuzzy-step " $") - (gnus-simplify-buffer-fuzzy-step "^ +"))) - -(defun gnus-simplify-subject-fuzzy (subject) - "Simplify a subject string fuzzily. -See `gnus-simplify-buffer-fuzzy' for details." - (save-excursion - (gnus-set-work-buffer) - (let ((case-fold-search t)) - ;; Remove uninteresting prefixes. - (when (and gnus-simplify-ignored-prefixes - (string-match gnus-simplify-ignored-prefixes subject)) - (setq subject (substring subject (match-end 0)))) - (insert subject) - (inline (gnus-simplify-buffer-fuzzy)) - (buffer-string)))) - -(defsubst gnus-simplify-subject-fully (subject) - "Simplify a subject string according to gnus-summary-gather-subject-limit." - (cond - (gnus-simplify-subject-functions - (gnus-map-function gnus-simplify-subject-functions subject)) - ((null gnus-summary-gather-subject-limit) - (gnus-simplify-subject-re subject)) - ((eq gnus-summary-gather-subject-limit 'fuzzy) - (gnus-simplify-subject-fuzzy subject)) - ((numberp gnus-summary-gather-subject-limit) - (gnus-limit-string (gnus-simplify-subject-re subject) - gnus-summary-gather-subject-limit)) - (t - subject))) - -(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 -simplified." - (cond - ((null simple-first) - (equal (gnus-simplify-subject-fully s1) - (gnus-simplify-subject-fully s2))) - (t - (equal s1 - (gnus-simplify-subject-fully s2))))) - -(defun gnus-summary-bubble-group () - "Increase the score of the current group. -This is a handy function to add to `gnus-summary-exit-hook' to -increase the score of each group you read." - (gnus-group-add-score gnus-newsgroup-name)) - - -;;; -;;; Gnus summary mode -;;; - -(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 - "\e\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 - "\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-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-hide-headers - "g" gnus-summary-show-article - "l" gnus-summary-goto-last-article - "v" gnus-summary-preview-mime-message - "\C-c\C-v\C-v" gnus-uu-decode-uu-view - "\C-d" gnus-summary-enter-digest-group - "\M-\C-d" gnus-summary-read-document - "\M-\C-e" gnus-summary-edit-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) - - ;; 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 - "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 - "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 - "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 - "<" 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 - "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) - - (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 - "c" gnus-article-remove-cr - "q" gnus-article-de-quoted-unreadable - "f" gnus-article-display-x-face - "l" gnus-summary-stop-page-breaking - "r" gnus-summary-caesar-message - "t" gnus-article-hide-headers - "v" gnus-summary-verbose-headers - "m" gnus-summary-toggle-mime - "h" gnus-article-treat-html - "d" gnus-article-treat-dumbquotes) - - (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 - "p" gnus-article-hide-pgp - "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) - - (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 - "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 - "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)) - -(defun gnus-summary-make-menu-bar () - (gnus-turn-off-edit-menu 'summary) - - (unless (boundp 'gnus-summary-misc-menu) - - (easy-menu-define - gnus-summary-kill-menu gnus-summary-mode-map "" - (cons - "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) - '(("Mark" - ["Kill below" gnus-summary-kill-below t] - ["Mark above" gnus-summary-mark-above t] - ["Tick above" gnus-summary-tick-above t] - ["Clear above" gnus-summary-clear-above t]) - ["Current score" gnus-summary-current-score t] - ["Set score" gnus-summary-set-score t] - ["Switch current score file..." gnus-score-change-score-file t] - ["Set mark below..." gnus-score-set-mark-below t] - ["Set expunge below..." gnus-score-set-expunge-below t] - ["Edit current score file" gnus-score-edit-current-scores t] - ["Edit score file" gnus-score-edit-file t] - ["Trace score" gnus-score-find-trace t] - ["Find words" gnus-score-find-favourite-words t] - ["Rescore buffer" gnus-summary-rescore t] - ["Increase score..." gnus-summary-increase-score t] - ["Lower score..." gnus-summary-lower-score t])))) - - '(("Default header" - ["Ask" (gnus-score-set-default 'gnus-score-default-header nil) - :style radio - :selected (null gnus-score-default-header)] - ["From" (gnus-score-set-default 'gnus-score-default-header 'a) - :style radio - :selected (eq gnus-score-default-header 'a)] - ["Subject" (gnus-score-set-default 'gnus-score-default-header 's) - :style radio - :selected (eq gnus-score-default-header 's)] - ["Article body" - (gnus-score-set-default 'gnus-score-default-header 'b) - :style radio - :selected (eq gnus-score-default-header 'b )] - ["All headers" - (gnus-score-set-default 'gnus-score-default-header 'h) - :style radio - :selected (eq gnus-score-default-header 'h )] - ["Message-ID" (gnus-score-set-default 'gnus-score-default-header 'i) - :style radio - :selected (eq gnus-score-default-header 'i )] - ["Thread" (gnus-score-set-default 'gnus-score-default-header 't) - :style radio - :selected (eq gnus-score-default-header 't )] - ["Crossposting" - (gnus-score-set-default 'gnus-score-default-header 'x) - :style radio - :selected (eq gnus-score-default-header 'x )] - ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l) - :style radio - :selected (eq gnus-score-default-header 'l )] - ["Date" (gnus-score-set-default 'gnus-score-default-header 'd) - :style radio - :selected (eq gnus-score-default-header 'd )] - ["Followups to author" - (gnus-score-set-default 'gnus-score-default-header 'f) - :style radio - :selected (eq gnus-score-default-header 'f )]) - ("Default type" - ["Ask" (gnus-score-set-default 'gnus-score-default-type nil) - :style radio - :selected (null gnus-score-default-type)] - ;; The `:active' key is commented out in the following, - ;; because the GNU Emacs hack to support radio buttons use - ;; active to indicate which button is selected. - ["Substring" (gnus-score-set-default 'gnus-score-default-type 's) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 's)] - ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 'r)] - ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 'e)] - ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 'f)] - ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b) - :style radio - ;; :active (eq (gnus-score-default-header 'd)) - :selected (eq gnus-score-default-type 'b)] - ["At date" (gnus-score-set-default 'gnus-score-default-type 'n) - :style radio - ;; :active (eq (gnus-score-default-header 'd)) - :selected (eq gnus-score-default-type 'n)] - ["After date" (gnus-score-set-default 'gnus-score-default-type 'a) - :style radio - ;; :active (eq (gnus-score-default-header 'd)) - :selected (eq gnus-score-default-type 'a)] - ["Less than number" - (gnus-score-set-default 'gnus-score-default-type '<) - :style radio - ;; :active (eq (gnus-score-default-header 'l)) - :selected (eq gnus-score-default-type '<)] - ["Equal to number" - (gnus-score-set-default 'gnus-score-default-type '=) - :style radio - ;; :active (eq (gnus-score-default-header 'l)) - :selected (eq gnus-score-default-type '=)] - ["Greater than number" - (gnus-score-set-default 'gnus-score-default-type '>) - :style radio - ;; :active (eq (gnus-score-default-header 'l)) - :selected (eq gnus-score-default-type '>)]) - ["Default fold" gnus-score-default-fold-toggle - :style toggle - :selected gnus-score-default-fold] - ("Default duration" - ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil) - :style radio - :selected (null gnus-score-default-duration)] - ["Permanent" - (gnus-score-set-default 'gnus-score-default-duration 'p) - :style radio - :selected (eq gnus-score-default-duration 'p)] - ["Temporary" - (gnus-score-set-default 'gnus-score-default-duration 't) - :style radio - :selected (eq gnus-score-default-duration 't)] - ["Immediate" - (gnus-score-set-default 'gnus-score-default-duration 'i) - :style radio - :selected (eq gnus-score-default-duration 'i)])) - - (easy-menu-define - gnus-summary-article-menu gnus-summary-mode-map "" - '("Article" - ("Hide" - ["All" gnus-article-hide t] - ["Headers" gnus-article-hide-headers t] - ["Signature" gnus-article-hide-signature t] - ["Citation" gnus-article-hide-citation t] - ["PGP" gnus-article-hide-pgp 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]) - ["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] - ["CR" gnus-article-remove-cr t] - ["Show X-Face" gnus-article-display-x-face t] - ["Quoted-Printable" gnus-article-de-quoted-unreadable t] - ["UnHTMLize" gnus-article-treat-html t] - ["Rot 13" gnus-summary-caesar-message t] - ["Unix pipe" gnus-summary-pipe-message t] - ["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]) - ("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] - ["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]) - ["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] - ["Redisplay" gnus-summary-show-article t])) - - (easy-menu-define - gnus-summary-thread-menu gnus-summary-mode-map "" - '("Threads" - ["Toggle threading" gnus-summary-toggle-threads t] - ["Hide threads" gnus-summary-hide-all-threads t] - ["Show threads" gnus-summary-show-all-threads t] - ["Hide thread" gnus-summary-hide-thread t] - ["Show thread" gnus-summary-show-thread t] - ["Go to next thread" gnus-summary-next-thread t] - ["Go to previous thread" gnus-summary-prev-thread t] - ["Go down thread" gnus-summary-down-thread t] - ["Go up thread" gnus-summary-up-thread t] - ["Top of thread" gnus-summary-top-thread t] - ["Mark thread as read" gnus-summary-kill-thread t] - ["Lower thread score" gnus-summary-lower-thread t] - ["Raise thread score" gnus-summary-raise-thread t] - ["Rethread current" gnus-summary-rethread-current t] - )) - - (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] - ["Supersede article" gnus-summary-supersede-article t] - ["Cancel article" gnus-summary-cancel-article t] - ["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] - ["Mail forward" gnus-summary-mail-forward t] - ["Post forward" gnus-summary-post-forward t] - ["Digest and mail" gnus-uu-digest-mail-forward t] - ["Digest and post" gnus-uu-digest-post-forward t] - ["Resend message" gnus-summary-resend-message t] - ["Send bounced mail" gnus-summary-resend-bounced-mail t] - ["Send a mail" gnus-summary-mail-other-window t] - ["Uuencode and post" gnus-uu-post-news t] - ["Followup via news" gnus-summary-followup-to-mail t] - ["Followup via news and yank" - gnus-summary-followup-to-mail-with-original t] - ;;("Draft" - ;;["Send" gnus-summary-send-draft t] - ;;["Send bounced" gnus-resend-bounced-mail t]) - )) - - (easy-menu-define - gnus-summary-misc-menu gnus-summary-mode-map "" - '("Misc" - ("Mark Read" - ["Mark as read" gnus-summary-mark-as-read-forward t] - ["Mark same subject and select" - gnus-summary-kill-same-subject-and-select t] - ["Mark same subject" gnus-summary-kill-same-subject t] - ["Catchup" gnus-summary-catchup t] - ["Catchup all" gnus-summary-catchup-all t] - ["Catchup to here" gnus-summary-catchup-to-here t] - ["Catchup region" gnus-summary-mark-region-as-read t] - ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t]) - ("Mark Various" - ["Tick" gnus-summary-tick-article-forward t] - ["Mark as dormant" gnus-summary-mark-as-dormant t] - ["Remove marks" gnus-summary-clear-mark-forward t] - ["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" - ["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] - ["Score" gnus-summary-limit-to-score t] - ["Unread" gnus-summary-limit-to-unread t] - ["Non-dormant" gnus-summary-limit-exclude-dormant t] - ["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] - ["Show expunged" gnus-summary-show-all-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] - ["Mark by regexp..." gnus-uu-mark-by-regexp t] - ["Mark all" gnus-uu-mark-all t] - ["Mark buffer" gnus-uu-mark-buffer t] - ["Mark sparse" gnus-uu-mark-sparse t] - ["Mark thread" gnus-uu-mark-thread t] - ["Unmark thread" gnus-uu-unmark-thread t] - ("Process Mark Sets" - ["Kill" gnus-summary-kill-process-mark t] - ["Yank" gnus-summary-yank-process-mark - gnus-newsgroup-process-stack] - ["Save" gnus-summary-save-process-mark t])) - ("Scroll article" - ["Page forward" gnus-summary-next-page t] - ["Page backward" gnus-summary-prev-page t] - ["Line forward" gnus-summary-scroll-up t]) - ("Move" - ["Next unread article" gnus-summary-next-unread-article t] - ["Previous unread article" gnus-summary-prev-unread-article t] - ["Next article" gnus-summary-next-article t] - ["Previous article" gnus-summary-prev-article t] - ["Next unread subject" gnus-summary-next-unread-subject t] - ["Previous unread subject" gnus-summary-prev-unread-subject t] - ["Next article same subject" gnus-summary-next-same-subject t] - ["Previous article same subject" gnus-summary-prev-same-subject t] - ["First unread article" gnus-summary-first-unread-article t] - ["Best unread article" gnus-summary-best-unread-article t] - ["Go to subject number..." gnus-summary-goto-subject t] - ["Go to article number..." gnus-summary-goto-article t] - ["Go to the last article" gnus-summary-goto-last-article t] - ["Pop article off history" gnus-summary-pop-article t]) - ("Sort" - ["Sort by number" gnus-summary-sort-by-number t] - ["Sort by author" gnus-summary-sort-by-author t] - ["Sort by subject" gnus-summary-sort-by-subject t] - ["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]) - ("Help" - ["Fetch group FAQ" gnus-summary-fetch-faq t] - ["Describe group" gnus-summary-describe-group t] - ["Read manual" gnus-info-find-node t]) - ("Modes" - ["Pick and read" gnus-pick-mode t] - ["Binary" gnus-binary-mode t]) - ("Regeneration" - ["Regenerate" gnus-summary-prepare t] - ["Insert cached articles" gnus-summary-insert-cached-articles t] - ["Toggle threading" gnus-summary-toggle-threads t]) - ["Filter articles..." gnus-summary-execute-command t] - ["Run command on subjects..." 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] - ["Expand window" gnus-summary-expand-window t] - ["Expire expirable articles" gnus-summary-expire-articles - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)] - ["Edit local kill file" gnus-summary-edit-local-kill t] - ["Edit main kill file" gnus-summary-edit-global-kill t] - ["Edit group parameters" gnus-summary-edit-parameters t] - ("Exit" - ["Catchup and exit" gnus-summary-catchup-and-exit t] - ["Catchup all and exit" gnus-summary-catchup-and-exit t] - ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] - ["Exit group" gnus-summary-exit t] - ["Exit group without updating" gnus-summary-exit-no-update t] - ["Exit and goto next group" gnus-summary-next-group t] - ["Exit and goto prev group" gnus-summary-prev-group t] - ["Reselect group" gnus-summary-reselect-current-group t] - ["Rescan group" gnus-summary-rescan-group t] - ["Update dribble" gnus-summary-save-newsrc t]))) - - (gnus-run-hooks 'gnus-summary-menu-hook))) - -(defun gnus-score-set-default (var value) - "A version of set that updates the GNU Emacs menu-bar." - (set var value) - ;; It is the message that forces the active status to be updated. - (message "")) - -(defun gnus-make-score-map (type) - "Make a summary score map of type TYPE." - (if t - nil - (let ((headers '(("author" "from" string) - ("subject" "subject" string) - ("article body" "body" string) - ("article head" "head" string) - ("xref" "xref" string) - ("lines" "lines" number) - ("followups to author" "followup" string))) - (types '((number ("less than" <) - ("greater than" >) - ("equal" =)) - (string ("substring" s) - ("exact string" e) - ("fuzzy string" f) - ("regexp" r)))) - (perms '(("temporary" (current-time-string)) - ("permanent" nil) - ("immediate" now))) - header) - (list - (apply - 'nconc - (list - (if (eq type 'lower) - "Lower score" - "Increase score")) - (let (outh) - (while headers - (setq header (car headers)) - (setq outh - (cons - (apply - 'nconc - (list (car header)) - (let ((ts (cdr (assoc (nth 2 header) types))) - outt) - (while ts - (setq outt - (cons - (apply - 'nconc - (list (caar ts)) - (let ((ps perms) - outp) - (while ps - (setq outp - (cons - (vector - (caar ps) - (list - 'gnus-summary-score-entry - (nth 1 header) - (if (or (string= (nth 1 header) - "head") - (string= (nth 1 header) - "body")) - "" - (list 'gnus-summary-header - (nth 1 header))) - (list 'quote (nth 1 (car ts))) - (list 'gnus-score-default nil) - (nth 1 (car ps)) - t) - t) - outp)) - (setq ps (cdr ps))) - (list (nreverse outp)))) - outt)) - (setq ts (cdr ts))) - (list (nreverse outt)))) - outh)) - (setq headers (cdr headers))) - (list (nreverse outh)))))))) - - - -(defun gnus-summary-mode (&optional group) - "Major mode for reading articles. - -All normal editing commands are switched off. -\\ -Each line in this buffer represents one article. To read an -article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards -and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', -respectively. - -You can also post articles and send mail from this buffer. To -follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author -of an article, type `\\[gnus-summary-reply]'. - -There are approx. one gazillion commands you can execute in this -buffer; read the info pages for more information (`\\[gnus-info-find-node]'). - -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) - (gnus-summary-make-local-variables) - (gnus-make-thread-indent-array) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-summary-mode) - (setq mode-name "Summary") - (make-local-variable 'minor-mode-alist) - (use-local-map gnus-summary-mode-map) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) ;Disable modification - (setq truncate-lines t) - (setq selective-display t) - (setq selective-display-ellipses t) ;Display `...' - (gnus-summary-set-display-table) - (gnus-set-default-directory) - (setq gnus-newsgroup-name group) - (make-local-variable 'gnus-summary-line-format) - (make-local-variable 'gnus-summary-line-format-spec) - (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 'post-command-hook) - (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) - (make-local-hook 'pre-command-hook) - (add-hook 'pre-command-hook 'gnus-set-global-variables nil t) - (gnus-run-hooks 'gnus-summary-mode-hook) - (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) - (gnus-update-summary-mark-positions)) - -(defun gnus-summary-make-local-variables () - "Make all the local summary buffer variables." - (let ((locals gnus-summary-local-variables) - global local) - (while (setq local (pop locals)) - (if (consp local) - (progn - (if (eq (cdr local) 'global) - ;; Copy the global value of the variable. - (setq global (symbol-value (car local))) - ;; Use the value from the list. - (setq global (eval (cdr local)))) - (make-local-variable (car local)) - (set (car local) global)) - ;; Simple nil-valued local variable. - (make-local-variable local) - (set local nil))))) - -(defun gnus-summary-clear-local-variables () - (let ((locals gnus-summary-local-variables)) - (while locals - (if (consp (car locals)) - (and (vectorp (caar locals)) - (set (caar locals) nil)) - (and (vectorp (car locals)) - (set (car locals) nil))) - (setq locals (cdr locals))))) - -;; Summary data functions. - -(defmacro gnus-data-number (data) - `(car ,data)) - -(defmacro gnus-data-set-number (data number) - `(setcar ,data ,number)) - -(defmacro gnus-data-mark (data) - `(nth 1 ,data)) - -(defmacro gnus-data-set-mark (data mark) - `(setcar (nthcdr 1 ,data) ,mark)) - -(defmacro gnus-data-pos (data) - `(nth 2 ,data)) - -(defmacro gnus-data-set-pos (data pos) - `(setcar (nthcdr 2 ,data) ,pos)) - -(defmacro gnus-data-header (data) - `(nth 3 ,data)) - -(defmacro gnus-data-set-header (data header) - `(setf (nth 3 ,data) ,header)) - -(defmacro gnus-data-level (data) - `(nth 4 ,data)) - -(defmacro gnus-data-unread-p (data) - `(= (nth 1 ,data) gnus-unread-mark)) - -(defmacro gnus-data-read-p (data) - `(/= (nth 1 ,data) gnus-unread-mark)) - -(defmacro gnus-data-pseudo-p (data) - `(consp (nth 3 ,data))) - -(defmacro gnus-data-find (number) - `(assq ,number gnus-newsgroup-data)) - -(defmacro gnus-data-find-list (number &optional data) - `(let ((bdata ,(or data 'gnus-newsgroup-data))) - (memq (assq ,number bdata) - bdata))) - -(defmacro gnus-data-make (number mark pos header level) - `(list ,number ,mark ,pos ,header ,level)) - -(defun gnus-data-enter (after-article number mark pos header level offset) - (let ((data (gnus-data-find-list after-article))) - (unless data - (error "No such article: %d" after-article)) - (setcdr data (cons (gnus-data-make number mark pos header level) - (cdr data))) - (setq gnus-newsgroup-data-reverse nil) - (gnus-data-update-list (cddr data) offset))) - -(defun gnus-data-enter-list (after-article list &optional offset) - (when list - (let ((data (and after-article (gnus-data-find-list after-article))) - (ilist list)) - (or data (not after-article) (error "No such article: %d" after-article)) - ;; Find the last element in the list to be spliced into the main - ;; list. - (while (cdr list) - (setq list (cdr list))) - (if (not data) - (progn - (setcdr list gnus-newsgroup-data) - (setq gnus-newsgroup-data ilist) - (when offset - (gnus-data-update-list (cdr list) offset))) - (setcdr list (cdr data)) - (setcdr data ilist) - (when offset - (gnus-data-update-list (cdr list) offset))) - (setq gnus-newsgroup-data-reverse nil)))) - -(defun gnus-data-remove (article &optional offset) - (let ((data gnus-newsgroup-data)) - (if (= (gnus-data-number (car data)) article) - (progn - (setq gnus-newsgroup-data (cdr gnus-newsgroup-data) - gnus-newsgroup-data-reverse nil) - (when offset - (gnus-data-update-list gnus-newsgroup-data offset))) - (while (cdr data) - (when (= (gnus-data-number (cadr data)) article) - (setcdr data (cddr data)) - (when offset - (gnus-data-update-list (cdr data) offset)) - (setq data nil - gnus-newsgroup-data-reverse nil)) - (setq data (cdr data)))))) - -(defmacro gnus-data-list (backward) - `(if ,backward - (or gnus-newsgroup-data-reverse - (setq gnus-newsgroup-data-reverse - (reverse gnus-newsgroup-data))) - gnus-newsgroup-data)) - -(defun gnus-data-update-list (data offset) - "Add OFFSET to the POS of all data entries in DATA." - (while data - (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data)))) - (setq data (cdr data)))) - -(defun gnus-data-compute-positions () - "Compute the positions of all articles." - (let ((data gnus-newsgroup-data) - pos) - (while data - (when (setq pos (text-property-any - (point-min) (point-max) - 'gnus-number (gnus-data-number (car data)))) - (gnus-data-set-pos (car data) (+ pos 3))) - (setq data (cdr data))))) - -(defun gnus-summary-article-pseudo-p (article) - "Say whether this article is a pseudo article or not." - (not (vectorp (gnus-data-header (gnus-data-find article))))) - -(defmacro gnus-summary-article-sparse-p (article) - "Say whether this article is a sparse article or not." - `(memq ,article gnus-newsgroup-sparse)) - -(defmacro gnus-summary-article-ancient-p (article) - "Say whether this article is a sparse article or not." - `(memq ,article gnus-newsgroup-ancient)) - -(defun gnus-article-parent-p (number) - "Say whether this article is a parent or not." - (let ((data (gnus-data-find-list number))) - (and (cdr data) ; There has to be an article after... - (< (gnus-data-level (car data)) ; And it has to have a higher level. - (gnus-data-level (nth 1 data)))))) - -(defun gnus-article-children (number) - "Return a list of all children to NUMBER." - (let* ((data (gnus-data-find-list number)) - (level (gnus-data-level (car data))) - children) - (setq data (cdr data)) - (while (and data - (= (gnus-data-level (car data)) (1+ level))) - (push (gnus-data-number (car data)) children) - (setq data (cdr data))) - children)) - -(defmacro gnus-summary-skip-intangible () - "If the current article is intangible, then jump to a different article." - '(let ((to (get-text-property (point) 'gnus-intangible))) - (and to (gnus-summary-goto-subject to)))) - -(defmacro gnus-summary-article-intangible-p () - "Say whether this article is intangible or not." - '(get-text-property (point) 'gnus-intangible)) - -(defun gnus-article-read-p (article) - "Say whether ARTICLE is read or not." - (not (or (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-unreads) - (memq article gnus-newsgroup-unselected) - (memq article gnus-newsgroup-dormant)))) - -;; Some summary mode macros. - -(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 -article number." - '(progn - (gnus-summary-skip-intangible) - (or (get-text-property (point) 'gnus-number) - (gnus-summary-last-subject)))) - -(defmacro gnus-summary-article-header (&optional number) - "Return the header of article NUMBER." - `(gnus-data-header (gnus-data-find - ,(or number '(gnus-summary-article-number))))) - -(defmacro gnus-summary-thread-level (&optional number) - "Return the level of thread that starts with article NUMBER." - `(if (and (eq gnus-summary-make-false-root 'dummy) - (get-text-property (point) 'gnus-intangible)) - 0 - (gnus-data-level (gnus-data-find - ,(or number '(gnus-summary-article-number)))))) - -(defmacro gnus-summary-article-mark (&optional number) - "Return the mark of article NUMBER." - `(gnus-data-mark (gnus-data-find - ,(or number '(gnus-summary-article-number))))) - -(defmacro gnus-summary-article-pos (&optional number) - "Return the position of the line of article NUMBER." - `(gnus-data-pos (gnus-data-find - ,(or number '(gnus-summary-article-number))))) - -(defalias 'gnus-summary-subject-string 'gnus-summary-article-subject) -(defmacro gnus-summary-article-subject (&optional number) - "Return current subject string or nil if nothing." - `(let ((headers - ,(if number - `(gnus-data-header (assq ,number gnus-newsgroup-data)) - '(gnus-data-header (assq (gnus-summary-article-number) - gnus-newsgroup-data))))) - (and headers - (vectorp headers) - (mail-header-subject headers)))) - -(defmacro gnus-summary-article-score (&optional number) - "Return current article score." - `(or (cdr (assq ,(or number '(gnus-summary-article-number)) - gnus-newsgroup-scored)) - gnus-summary-default-score 0)) - -(defun gnus-summary-article-children (&optional number) - "Return a list of article numbers that are children of article NUMBER." - (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)))) - (level (gnus-data-level (car data))) - l children) - (while (and (setq data (cdr data)) - (> (setq l (gnus-data-level (car data))) level)) - (and (= (1+ level) l) - (push (gnus-data-number (car data)) - children))) - (nreverse children))) - -(defun gnus-summary-article-parent (&optional number) - "Return the article number of the parent of article NUMBER." - (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)) - (gnus-data-list t))) - (level (gnus-data-level (car data)))) - (if (zerop level) - () ; This is a root. - ;; We search until we find an article with a level less than - ;; this one. That function has to be the parent. - (while (and (setq data (cdr data)) - (not (< (gnus-data-level (car data)) level)))) - (and data (gnus-data-number (car data)))))) - -(defun gnus-unread-mark-p (mark) - "Say whether MARK is the unread mark." - (= mark gnus-unread-mark)) - -(defun gnus-read-mark-p (mark) - "Say whether MARK is one of the marks that mark as read. -This is all marks except unread, ticked, dormant, and expirable." - (not (or (= mark gnus-unread-mark) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark) - (= mark gnus-expirable-mark)))) - -(defmacro gnus-article-mark (number) - "Return the MARK of article NUMBER. -This macro should only be used when computing the mark the \"first\" -time; i.e., when generating the summary lines. After that, -`gnus-summary-article-mark' should be used to examine the -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-dormant) gnus-dormant-mark) - ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark) - (t (or (cdr (assq ,number gnus-newsgroup-reads)) - gnus-ancient-mark)))) - -;; 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"))) - `(let ((,config (gnus-hidden-threads-configuration))) - (unwind-protect - (save-excursion - ,@forms) - (gnus-restore-hidden-threads-configuration ,config))))) - -(defun gnus-hidden-threads-configuration () - "Return the current hidden threads configuration." - (save-excursion - (let (config) - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (push (1- (point)) config)) - config))) - -(defun gnus-restore-hidden-threads-configuration (config) - "Restore hidden threads configuration from CONFIG." - (let (point buffer-read-only) - (while (setq point (pop config)) - (when (and (< point (point-max)) - (goto-char point) - (= (following-char) ?\n)) - (subst-char-in-region point (1+ point) ?\n ?\r))))) - -;; Various summary mode internalish functions. - -(defun gnus-mouse-pick-article (e) - (interactive "e") - (mouse-set-point e) - (gnus-summary-next-page nil t)) - -(defun gnus-summary-set-display-table () - ;; Change the display table. Odd characters have a tendency to mess - ;; up nicely formatted displays - we make all possible glyphs - ;; display only a single character. - - ;; We start from the standard display table, if any. - (let ((table (or (copy-sequence standard-display-table) - (make-display-table))) - (i 32)) - ;; Nix out all the control chars... - (while (>= (setq i (1- i)) 0) - (aset table i [??])) - ;; ... but not newline and cr, of course. (cr is necessary for the - ;; selective display). - (aset table ?\n nil) - (aset table ?\r nil) - ;; We keep TAB as well. - (aset table ?\t nil) - ;; We nix out any glyphs over 126 that are not set already. - (let ((i 256)) - (while (>= (setq i (1- i)) 127) - ;; Only modify if the entry is nil. - (unless (aref table i) - (aset table i [??])))) - (setq buffer-display-table table))) - -(defun gnus-summary-setup-buffer (group) - "Initialize summary buffer." - (let ((buffer (concat "*Summary " group "*"))) - (if (get-buffer buffer) - (progn - (set-buffer buffer) - (setq gnus-summary-buffer (current-buffer)) - (not gnus-newsgroup-prepared)) - ;; Fix by Sudish Joseph - (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer))) - (gnus-add-current-to-buffer-list) - (gnus-summary-mode group) - (when gnus-carpal - (gnus-carpal-setup-buffer 'summary)) - (unless gnus-single-article-buffer - (make-local-variable 'gnus-article-buffer) - (make-local-variable 'gnus-article-current) - (make-local-variable 'gnus-original-article-buffer)) - (setq gnus-newsgroup-name group) - t))) - -(defun gnus-set-global-variables () - ;; Set the global equivalents of the summary buffer-local variables - ;; to the latest values they had. These reflect the summary buffer - ;; that was in action when the last article was fetched. - (when (eq major-mode 'gnus-summary-mode) - (setq gnus-summary-buffer (current-buffer)) - (let ((name gnus-newsgroup-name) - (marked gnus-newsgroup-marked) - (unread gnus-newsgroup-unreads) - (headers gnus-current-headers) - (data gnus-newsgroup-data) - (summary gnus-summary-buffer) - (article-buffer gnus-article-buffer) - (original gnus-original-article-buffer) - (gac gnus-article-current) - (reffed gnus-reffed-article-number) - (score-file gnus-current-score-file)) - (save-excursion - (set-buffer gnus-group-buffer) - (setq gnus-newsgroup-name name - gnus-newsgroup-marked marked - gnus-newsgroup-unreads unread - gnus-current-headers headers - gnus-newsgroup-data data - gnus-article-current gac - gnus-summary-buffer summary - gnus-article-buffer article-buffer - gnus-original-article-buffer original - gnus-reffed-article-number reffed - gnus-current-score-file score-file) - ;; The article buffer also has local variables. - (when (gnus-buffer-live-p gnus-article-buffer) - (set-buffer gnus-article-buffer) - (setq gnus-summary-buffer summary)))))) - -(defun gnus-summary-article-unread-p (article) - "Say whether ARTICLE is unread or not." - (memq article gnus-newsgroup-unreads)) - -(defun gnus-summary-first-article-p (&optional article) - "Return whether ARTICLE is the first article in the buffer." - (if (not (setq article (or article (gnus-summary-article-number)))) - nil - (eq article (caar gnus-newsgroup-data)))) - -(defun gnus-summary-last-article-p (&optional article) - "Return whether ARTICLE is the last article in the buffer." - (if (not (setq article (or article (gnus-summary-article-number)))) - t ; All non-existent numbers are the last article. :-) - (not (cdr (gnus-data-find-list article))))) - -(defun gnus-make-thread-indent-array () - (let ((n 200)) - (unless (and gnus-thread-indent-array - (= gnus-thread-indent-level gnus-thread-indent-array-level)) - (setq gnus-thread-indent-array (make-vector 201 "") - gnus-thread-indent-array-level gnus-thread-indent-level) - (while (>= n 0) - (aset gnus-thread-indent-array n - (make-string (* n gnus-thread-indent-level) ? )) - (setq n (1- n)))))) - -(defun gnus-update-summary-mark-positions () - "Compute where the summary marks are to go." - (save-excursion - (when (and gnus-summary-buffer - (get-buffer gnus-summary-buffer) - (buffer-name (get-buffer gnus-summary-buffer))) - (set-buffer gnus-summary-buffer)) - (let ((gnus-replied-mark 129) - (gnus-score-below-mark 130) - (gnus-score-over-mark 130) - (gnus-download-mark 131) - (spec gnus-summary-line-format-spec) - thread gnus-visual pos) - (save-excursion - (gnus-set-work-buffer) - (let ((gnus-summary-line-format-spec spec) - (gnus-newsgroup-downloadable '((0 . t)))) - (gnus-summary-insert-line - [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) - (goto-char (point-min)) - (setq pos (list (cons 'unread (and (search-forward "\200" nil t) - (- (point) 2))))) - (goto-char (point-min)) - (push (cons 'replied (and (search-forward "\201" nil t) - (- (point) 2))) - pos) - (goto-char (point-min)) - (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2))) - pos) - (goto-char (point-min)) - (push (cons 'download - (and (search-forward "\203" nil t) (- (point) 2))) - pos))) - (setq gnus-summary-mark-positions pos)))) - -(defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number) - "Insert a dummy root in the summary buffer." - (beginning-of-line) - (gnus-add-text-properties - (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) - (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) - -(defun gnus-summary-insert-line (gnus-tmp-header - gnus-tmp-level gnus-tmp-current - gnus-tmp-unread gnus-tmp-replied - gnus-tmp-expirable gnus-tmp-subject-or-nil - &optional gnus-tmp-dummy gnus-tmp-score - gnus-tmp-process) - (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) - (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) - (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0)) - (gnus-tmp-score-char - (if (or (null gnus-summary-default-score) - (<= (abs (- gnus-tmp-score gnus-summary-default-score)) - gnus-summary-zcore-fuzz)) - ? - (if (< gnus-tmp-score gnus-summary-default-score) - gnus-score-below-mark gnus-score-over-mark))) - (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-saved) - gnus-saved-mark) - (t gnus-unread-mark))) - (gnus-tmp-from (mail-header-from gnus-tmp-header)) - (gnus-tmp-name - (cond - ((string-match "<[^>]+> *$" gnus-tmp-from) - (let ((beg (match-beginning 0))) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) - (substring gnus-tmp-from 0 beg)))) - ((string-match "(.+)" gnus-tmp-from) - (substring gnus-tmp-from - (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)) - (gnus-put-text-property - (point) - (progn (eval gnus-summary-line-format-spec) (point)) - 'gnus-number gnus-tmp-number) - (when (gnus-visual-p 'summary-highlight 'highlight) - (forward-line -1) - (gnus-run-hooks 'gnus-summary-update-hook) - (forward-line 1)))) - -(defun gnus-summary-update-line (&optional dont-update) - ;; Update summary line after change. - (when (and gnus-summary-default-score - (not gnus-summary-inhibit-highlight)) - (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion. - (article (gnus-summary-article-number)) - (score (gnus-summary-article-score article))) - (unless dont-update - (if (and gnus-summary-mark-below - (< (gnus-summary-article-score) - gnus-summary-mark-below)) - ;; This article has a low score, so we mark it as read. - (when (memq article gnus-newsgroup-unreads) - (gnus-summary-mark-article-as-read gnus-low-score-mark)) - (when (eq (gnus-summary-article-mark) gnus-low-score-mark) - ;; This article was previously marked as read on account - ;; of a low score, but now it has risen, so we mark it as - ;; unread. - (gnus-summary-mark-article-as-unread gnus-unread-mark))) - (gnus-summary-update-mark - (if (or (null gnus-summary-default-score) - (<= (abs (- score gnus-summary-default-score)) - gnus-summary-zcore-fuzz)) - ? - (if (< score gnus-summary-default-score) - gnus-score-below-mark gnus-score-over-mark)) - 'score)) - ;; Do visual highlighting. - (when (gnus-visual-p 'summary-highlight 'highlight) - (gnus-run-hooks 'gnus-summary-update-hook))))) - -(defvar gnus-tmp-new-adopts nil) - -(defun gnus-summary-number-of-articles-in-thread (thread &optional level char) - "Return the number of articles in THREAD. -This may be 0 in some cases -- if none of the articles in -the thread are to be displayed." - (let* ((number - ;; Fix by Luc Van Eycken . - (cond - ((not (listp thread)) - 1) - ((and (consp thread) (cdr thread)) - (apply - '+ 1 (mapcar - 'gnus-summary-number-of-articles-in-thread (cdr thread)))) - ((null thread) - 1) - ((memq (mail-header-number (car thread)) gnus-newsgroup-limit) - 1) - (t 0)))) - (when (and level (zerop level) gnus-tmp-new-adopts) - (incf number - (apply '+ (mapcar - 'gnus-summary-number-of-articles-in-thread - gnus-tmp-new-adopts)))) - (if char - (if (> number 1) gnus-not-empty-thread-mark - gnus-empty-thread-mark) - number))) - -(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)) - elem) - (while params - (setq elem (car params) - params (cdr params)) - (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 to-address to-list to-group))) - (ignore-errors ; So we set it. - (make-local-variable (car elem)) - (set (car elem) (eval (nth 1 elem)))))))) - -(defun gnus-summary-read-group (group &optional show-all no-article - kill-buffer no-display) - "Start reading news in newsgroup GROUP. -If SHOW-ALL is non-nil, already read articles are also listed. -If NO-ARTICLE is non-nil, no article is selected initially. -If NO-DISPLAY, don't generate a summary buffer." - (let (result) - (while (and group - (null (setq result - (let ((gnus-auto-select-next nil)) - (or (gnus-summary-read-group-1 - group show-all no-article - kill-buffer no-display) - (setq show-all nil))))) - (eq gnus-auto-select-next 'quietly)) - (set-buffer gnus-group-buffer) - (if (not (equal group (gnus-group-group-name))) - (setq group (gnus-group-group-name)) - (setq group nil))) - result)) - -(defun gnus-summary-read-group-1 (group show-all no-article - kill-buffer no-display) - ;; 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) - (let* ((new-group (gnus-summary-setup-buffer group)) - (quit-config (gnus-group-quit-config group)) - (did-select (and new-group (gnus-select-newsgroup group show-all)))) - (cond - ;; This summary buffer exists already, so we just select it. - ((not new-group) - (gnus-set-global-variables) - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - (gnus-configure-windows 'summary 'force) - (gnus-set-mode-line 'summary) - (gnus-summary-position-point) - (message "") - t) - ;; We couldn't select this group. - ((null did-select) - (when (and (eq major-mode 'gnus-summary-mode) - (not (equal (current-buffer) kill-buffer))) - (kill-buffer (current-buffer)) - (if (not quit-config) - (progn - ;; Update the info -- marks might need to be removed, - ;; for instance. - (gnus-summary-update-info) - (set-buffer gnus-group-buffer) - (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") - nil) - ;; The user did a `C-g' while prompting for number of articles, - ;; so we exit this group. - ((eq did-select 'quit) - (and (eq major-mode 'gnus-summary-mode) - (not (equal (current-buffer) kill-buffer)) - (kill-buffer (current-buffer))) - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - (if (not quit-config) - (progn - (set-buffer gnus-group-buffer) - (gnus-group-jump-to-group group) - (gnus-group-next-unread-group 1) - (gnus-configure-windows 'group 'force)) - (gnus-handle-ephemeral-exit quit-config)) - ;; Finally signal the quit. - (signal 'quit nil)) - ;; The group was successfully selected. - (t - (gnus-set-global-variables) - ;; Save the active value in effect when the group was entered. - (setq gnus-newsgroup-active - (gnus-copy-sequence - (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) - ;; Do score processing. - (when gnus-use-scoring - (gnus-possibly-score-headers)) - ;; Check whether to fill in the gaps in the threads. - (when gnus-build-sparse-threads - (gnus-build-sparse-threads)) - ;; Find the initial limit. - (if gnus-show-threads - (if show-all - (let ((gnus-newsgroup-dormant nil)) - (gnus-summary-initial-limit show-all)) - (gnus-summary-initial-limit show-all)) - (setq gnus-newsgroup-limit - (mapcar - (lambda (header) (mail-header-number header)) - gnus-newsgroup-headers))) - ;; Generate the summary buffer. - (unless no-display - (gnus-summary-prepare)) - (when gnus-use-trees - (gnus-tree-open group) - (setq gnus-summary-highlight-line-function - 'gnus-tree-highlight-article)) - ;; If the summary buffer is empty, but there are some low-scored - ;; articles or some excluded dormants, we include these in the - ;; buffer. - (when (and (zerop (buffer-size)) - (not no-display)) - (cond (gnus-newsgroup-dormant - (gnus-summary-limit-include-dormant)) - ((and gnus-newsgroup-scored show-all) - (gnus-summary-limit-include-expunged t)))) - ;; Function `gnus-apply-kill-file' must be called in this hook. - (gnus-run-hooks 'gnus-apply-kill-hook) - (if (and (zerop (buffer-size)) - (not no-display)) - (progn - ;; This newsgroup is empty. - (gnus-summary-catchup-and-exit nil t) - (gnus-message 6 "No unread news") - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - ;; Return nil from this function. - nil) - ;; 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)) - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - ;; Show first unread article if requested. - (if (and (not no-article) - (not no-display) - gnus-newsgroup-unreads - gnus-auto-select-first) - (unless (if (eq gnus-auto-select-first 'best) - (gnus-summary-best-unread-article) - (gnus-summary-first-unread-article)) - (gnus-configure-windows 'summary)) - ;; Don't select any articles, just move point to the first - ;; article in the group. - (goto-char (point-min)) - (gnus-summary-position-point) - (gnus-configure-windows 'summary 'force) - (gnus-set-mode-line 'summary)) - (when (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))) - (select-window (get-buffer-window gnus-group-buffer t)) - (when (gnus-group-goto-group group) - (recenter)) - (select-window owin))) - ;; Mark this buffer as "prepared". - (setq gnus-newsgroup-prepared t) - (gnus-run-hooks 'gnus-summary-prepared-hook) - t))))) - -(defun gnus-summary-prepare () - "Generate the summary buffer." - (interactive) - (let ((buffer-read-only nil)) - (erase-buffer) - (setq gnus-newsgroup-data nil - gnus-newsgroup-data-reverse nil) - (gnus-run-hooks 'gnus-summary-generate-hook) - ;; Generate the buffer, either with threads or without. - (when gnus-newsgroup-headers - (gnus-summary-prepare-threads - (if gnus-show-threads - (gnus-sort-gathered-threads - (funcall gnus-summary-thread-gathering-function - (gnus-sort-threads - (gnus-cut-threads (gnus-make-threads))))) - ;; Unthreaded display. - (gnus-sort-articles gnus-newsgroup-headers)))) - (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data)) - ;; Call hooks for modifying summary buffer. - (goto-char (point-min)) - (gnus-run-hooks 'gnus-summary-prepare-hook))) - -(defsubst gnus-general-simplify-subject (subject) - "Simply subject by the same rules as gnus-gather-threads-by-subject." - (setq subject - (cond - ;; Truncate the subject. - (gnus-simplify-subject-functions - (gnus-map-function gnus-simplify-subject-functions subject)) - ((numberp gnus-summary-gather-subject-limit) - (setq subject (gnus-simplify-subject-re subject)) - (if (> (length subject) gnus-summary-gather-subject-limit) - (substring subject 0 gnus-summary-gather-subject-limit) - subject)) - ;; Fuzzily simplify it. - ((eq 'fuzzy gnus-summary-gather-subject-limit) - (gnus-simplify-subject-fuzzy subject)) - ;; Just remove the leading "Re:". - (t - (gnus-simplify-subject-re subject)))) - - (if (and gnus-summary-gather-exclude-subject - (string-match gnus-summary-gather-exclude-subject subject)) - nil ; This article shouldn't be gathered - subject)) - -(defun gnus-summary-simplify-subject-query () - "Query where the respool algorithm would put this article." - (interactive) - (gnus-summary-select-article) - (message (gnus-general-simplify-subject (gnus-summary-article-subject)))) - -(defun gnus-gather-threads-by-subject (threads) - "Gather threads by looking at Subject headers." - (if (not gnus-summary-make-false-root) - threads - (let ((hashtb (gnus-make-hashtable 1024)) - (prev threads) - (result threads) - subject hthread whole-subject) - (while threads - (setq subject (gnus-general-simplify-subject - (setq whole-subject (mail-header-subject - (caar threads))))) - (when subject - (if (setq hthread (gnus-gethash subject hashtb)) - (progn - ;; We enter a dummy root into the thread, if we - ;; haven't done that already. - (unless (stringp (caar hthread)) - (setcar hthread (list whole-subject (car hthread)))) - ;; We add this new gathered thread to this gathered - ;; thread. - (setcdr (car hthread) - (nconc (cdar hthread) (list (car threads)))) - ;; Remove it from the list of threads. - (setcdr prev (cdr threads)) - (setq threads prev)) - ;; Enter this thread into the hash table. - (gnus-sethash subject threads hashtb))) - (setq prev threads) - (setq threads (cdr threads))) - result))) - -(defun gnus-gather-threads-by-references (threads) - "Gather threads by looking at References headers." - (let ((idhashtb (gnus-make-hashtable 1024)) - (thhashtb (gnus-make-hashtable 1024)) - (prev threads) - (result threads) - ids references id gthread gid entered ref) - (while threads - (when (setq references (mail-header-references (caar threads))) - (setq id (mail-header-id (caar threads)) - ids (gnus-split-references references) - entered nil) - (while (setq ref (pop ids)) - (setq ids (delete ref ids)) - (if (not (setq gid (gnus-gethash ref idhashtb))) - (progn - (gnus-sethash ref id idhashtb) - (gnus-sethash id threads thhashtb)) - (setq gthread (gnus-gethash gid thhashtb)) - (unless entered - ;; We enter a dummy root into the thread, if we - ;; haven't done that already. - (unless (stringp (caar gthread)) - (setcar gthread (list (mail-header-subject (caar gthread)) - (car gthread)))) - ;; We add this new gathered thread to this gathered - ;; thread. - (setcdr (car gthread) - (nconc (cdar gthread) (list (car threads))))) - ;; Add it into the thread hash table. - (gnus-sethash id gthread thhashtb) - (setq entered t) - ;; Remove it from the list of threads. - (setcdr prev (cdr threads)) - (setq threads prev)))) - (setq prev threads) - (setq threads (cdr threads))) - result)) - -(defun gnus-sort-gathered-threads (threads) - "Sort subtreads inside each gathered thread by article number." - (let ((result threads)) - (while threads - (when (stringp (caar threads)) - (setcdr (car threads) - (sort (cdar threads) 'gnus-thread-sort-by-number))) - (setq threads (cdr threads))) - result)) - -(defun gnus-thread-loop-p (root thread) - "Say whether ROOT is in THREAD." - (let ((stack (list thread)) - (infloop 0) - th) - (while (setq thread (pop stack)) - (setq th (cdr thread)) - (while (and th - (not (eq (caar th) root))) - (pop th)) - (if th - ;; We have found a loop. - (let (ref-dep) - (setcdr thread (delq (car th) (cdr thread))) - (if (boundp (setq ref-dep (intern "none" - gnus-newsgroup-dependencies))) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) - (list (car th)))) - (set ref-dep (list nil (car th)))) - (setq infloop 1 - stack nil)) - ;; Push all the subthreads onto the stack. - (push (cdr thread) stack))) - infloop)) - -(defun gnus-make-threads () - "Go through the dependency hashtb and find the roots. Return all threads." - (let (threads) - (while (catch 'infloop - (mapatoms - (lambda (refs) - ;; Deal with self-referencing References loops. - (when (and (car (symbol-value refs)) - (not (zerop - (apply - '+ - (mapcar - (lambda (thread) - (gnus-thread-loop-p - (car (symbol-value refs)) thread)) - (cdr (symbol-value refs))))))) - (setq threads nil) - (throw 'infloop t)) - (unless (car (symbol-value refs)) - ;; These threads do not refer back to any other articles, - ;; so they're roots. - (setq threads (append (cdr (symbol-value refs)) threads)))) - gnus-newsgroup-dependencies))) - threads)) - -(defun gnus-build-sparse-threads () - (let ((headers gnus-newsgroup-headers) - (deps gnus-newsgroup-dependencies) - header references generation relations - cthread subject child end pthread relation new-child) - ;; First we create an alist of generations/relations, where - ;; generations is how much we trust the relation, and the relation - ;; is parent/child. - (gnus-message 7 "Making sparse threads...") - (save-excursion - (nnheader-set-temp-buffer " *gnus sparse threads*") - (while (setq header (pop headers)) - (when (and (setq references (mail-header-references header)) - (not (string= references ""))) - (insert references) - (setq child (mail-header-id header) - subject (mail-header-subject header)) - (setq generation 0) - (while (search-backward ">" nil t) - (setq end (1+ (point))) - (when (search-backward "<" nil t) - (unless (string= (setq new-child (buffer-substring (point) end)) - child) - (push (list (incf generation) - child (setq child new-child) - subject) - relations)))) - (push (list (1+ generation) child nil subject) relations) - (erase-buffer))) - (kill-buffer (current-buffer))) - ;; Sort over trustworthiness. - (setq relations (sort relations 'car-less-than-car)) - (while (setq relation (pop relations)) - (when (if (boundp (setq cthread (intern (cadr relation) deps))) - (unless (car (symbol-value cthread)) - ;; Make this article the parent of these threads. - (setcar (symbol-value cthread) - (vector gnus-reffed-article-number - (cadddr relation) - "" "" - (cadr relation) - (or (caddr relation) "") 0 0 ""))) - (set cthread (list (vector gnus-reffed-article-number - (cadddr relation) - "" "" (cadr relation) - (or (caddr relation) "") 0 0 "")))) - (push gnus-reffed-article-number gnus-newsgroup-limit) - (push gnus-reffed-article-number gnus-newsgroup-sparse) - (push (cons gnus-reffed-article-number gnus-sparse-mark) - gnus-newsgroup-reads) - (decf gnus-reffed-article-number) - ;; Make this new thread the child of its parent. - (if (boundp (setq pthread (intern (or (caddr relation) "none") deps))) - (setcdr (symbol-value pthread) - (nconc (cdr (symbol-value pthread)) - (list (symbol-value cthread)))) - (set pthread (list nil (symbol-value cthread)))))) - (gnus-message 7 "Making sparse threads...done"))) - -(defun gnus-build-old-threads () - ;; Look at all the articles that refer back to old articles, and - ;; fetch the headers for the articles that aren't there. This will - ;; build complete threads - if the roots haven't been expired by the - ;; server, that is. - (let (id heads) - (mapatoms - (lambda (refs) - (when (not (car (symbol-value refs))) - (setq heads (cdr (symbol-value refs))) - (while heads - (if (memq (mail-header-number (caar heads)) - gnus-newsgroup-dormant) - (setq heads (cdr heads)) - (setq id (symbol-name refs)) - (while (and (setq id (gnus-build-get-header id)) - (not (car (gnus-gethash - id gnus-newsgroup-dependencies))))) - (setq heads nil))))) - gnus-newsgroup-dependencies))) - -(defun gnus-build-get-header (id) - ;; Look through the buffer of NOV lines and find the header to - ;; ID. Enter this line into the dependencies hash table, and return - ;; the id of the parent article (if any). - (let ((deps gnus-newsgroup-dependencies) - found header) - (prog1 - (save-excursion - (set-buffer nntp-server-buffer) - (let ((case-fold-search nil)) - (goto-char (point-min)) - (while (and (not found) - (search-forward id nil t)) - (beginning-of-line) - (setq found (looking-at - (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" - (regexp-quote id)))) - (or found (beginning-of-line 2))) - (when found - (beginning-of-line) - (and - (setq header (gnus-nov-parse-line - (read (current-buffer)) deps)) - (gnus-parent-id (mail-header-references header)))))) - (when header - (let ((number (mail-header-number header))) - (push number gnus-newsgroup-limit) - (push header gnus-newsgroup-headers) - (if (memq number gnus-newsgroup-unselected) - (progn - (push number gnus-newsgroup-unreads) - (setq gnus-newsgroup-unselected - (delq number gnus-newsgroup-unselected))) - (push number gnus-newsgroup-ancient))))))) - -(defun gnus-build-all-threads () - "Read all the headers." - (let ((deps gnus-newsgroup-dependencies) - (gnus-summary-ignore-duplicates t) - found header article) - (save-excursion - (set-buffer nntp-server-buffer) - (let ((case-fold-search nil)) - (goto-char (point-min)) - (while (not (eobp)) - (ignore-errors - (setq article (read (current-buffer))) - (setq header (gnus-nov-parse-line article deps))) - (when header - (push header gnus-newsgroup-headers) - (if (memq (setq article (mail-header-number header)) - gnus-newsgroup-unselected) - (progn - (push article gnus-newsgroup-unreads) - (setq gnus-newsgroup-unselected - (delq article gnus-newsgroup-unselected))) - (push article gnus-newsgroup-ancient)) - (forward-line 1))))))) - -(defun gnus-summary-update-article-line (article header) - "Update the line for ARTICLE using HEADERS." - (let* ((id (mail-header-id header)) - (thread (gnus-id-to-thread id))) - (unless thread - (error "Article in no thread")) - ;; Update the thread. - (setcar thread header) - (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 (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)))))))) - -(defun gnus-summary-update-article (article &optional iheader) - "Update ARTICLE in the summary buffer." - (set-buffer gnus-summary-buffer) - (let* ((header (or iheader (gnus-summary-article-header article))) - (id (mail-header-id header)) - (data (gnus-data-find article)) - (thread (gnus-id-to-thread id)) - (references (mail-header-references header)) - (parent - (gnus-id-to-thread - (or (gnus-parent-id - (when (and references - (not (equal "" references))) - references)) - "none"))) - (buffer-read-only nil) - (old (car thread)) - (number (mail-header-number header)) - pos) - (when thread - ;; !!! Should this be in or not? - (unless iheader - (setcar thread nil)) - (when parent - (delq thread parent)) - (if (gnus-summary-insert-subject id header iheader) - ;; Set the (possibly) new article number in the data structure. - (gnus-data-set-number data (gnus-id-to-article id)) - (setcar thread old) - nil)))) - -(defun gnus-rebuild-thread (id) - "Rebuild the thread containing ID." - (let ((buffer-read-only nil) - old-pos current thread data) - (if (not gnus-show-threads) - (setq thread (list (car (gnus-id-to-thread id)))) - ;; Get the thread this article is part of. - (setq thread (gnus-remove-thread id))) - (setq old-pos (gnus-point-at-bol)) - (setq current (save-excursion - (and (zerop (forward-line -1)) - (gnus-summary-article-number)))) - ;; If this is a gathered thread, we have to go some re-gathering. - (when (stringp (car thread)) - (let ((subject (car thread)) - roots thr) - (setq thread (cdr thread)) - (while thread - (unless (memq (setq thr (gnus-id-to-thread - (gnus-root-id - (mail-header-id (caar thread))))) - roots) - (push thr roots)) - (setq thread (cdr thread))) - ;; We now have all (unique) roots. - (if (= (length roots) 1) - ;; All the loose roots are now one solid root. - (setq thread (car roots)) - (setq thread (cons subject (gnus-sort-threads roots)))))) - (let (threads) - ;; We then insert this thread into the summary buffer. - (let (gnus-newsgroup-data gnus-newsgroup-threads) - (if gnus-show-threads - (gnus-summary-prepare-threads (gnus-cut-threads (list thread))) - (gnus-summary-prepare-unthreaded thread)) - (setq data (nreverse gnus-newsgroup-data)) - (setq threads gnus-newsgroup-threads)) - ;; We splice the new data into the data structure. - (gnus-data-enter-list current data (- (point) old-pos)) - (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads))))) - -(defun gnus-number-to-header (number) - "Return the header for article NUMBER." - (let ((headers gnus-newsgroup-headers)) - (while (and headers - (not (= number (mail-header-number (car headers))))) - (pop headers)) - (when headers - (car headers)))) - -(defun gnus-parent-headers (headers &optional generation) - "Return the headers of the GENERATIONeth parent of HEADERS." - (unless generation - (setq generation 1)) - (let ((parent t) - references) - (while (and parent headers (not (zerop generation))) - (setq references (mail-header-references headers)) - (when (and references - (setq parent (gnus-parent-id references)) - (setq headers (car (gnus-id-to-thread parent)))) - (decf generation))) - headers)) - -(defun gnus-id-to-thread (id) - "Return the (sub-)thread where ID appears." - (gnus-gethash id gnus-newsgroup-dependencies)) - -(defun gnus-id-to-article (id) - "Return the article number of ID." - (let ((thread (gnus-id-to-thread id))) - (when (and thread - (car thread)) - (mail-header-number (car thread))))) - -(defun gnus-id-to-header (id) - "Return the article headers of ID." - (car (gnus-id-to-thread id))) - -(defun gnus-article-displayed-root-p (article) - "Say whether ARTICLE is a root(ish) article." - (let ((level (gnus-summary-thread-level article)) - (refs (mail-header-references (gnus-summary-article-header article))) - particle) - (cond - ((null level) nil) - ((zerop level) t) - ((null refs) t) - ((null (gnus-parent-id refs)) t) - ((and (= 1 level) - (null (setq particle (gnus-id-to-article - (gnus-parent-id refs)))) - (null (gnus-summary-thread-level particle))))))) - -(defun gnus-root-id (id) - "Return the id of the root of the thread where ID appears." - (let (last-id prev) - (while (and id (setq prev (car (gnus-gethash - id gnus-newsgroup-dependencies)))) - (setq last-id id - id (gnus-parent-id (mail-header-references prev)))) - last-id)) - -(defun gnus-articles-in-thread (thread) - "Return the list of articles in THREAD." - (cons (mail-header-number (car thread)) - (apply 'nconc (mapcar 'gnus-articles-in-thread (cdr thread))))) - -(defun gnus-remove-thread (id &optional dont-remove) - "Remove the thread that has ID in it." - (let ((dep gnus-newsgroup-dependencies) - headers thread last-id) - ;; First go up in this thread until we find the root. - (setq last-id (gnus-root-id id)) - (setq headers (list (car (gnus-id-to-thread last-id)) - (caadr (gnus-id-to-thread last-id)))) - ;; We have now found the real root of this thread. It might have - ;; been gathered into some loose thread, so we have to search - ;; through the threads to find the thread we wanted. - (let ((threads gnus-newsgroup-threads) - sub) - (while threads - (setq sub (car threads)) - (if (stringp (car sub)) - ;; This is a gathered thread, so we look at the roots - ;; below it to find whether this article is in this - ;; gathered root. - (progn - (setq sub (cdr sub)) - (while sub - (when (member (caar sub) headers) - (setq thread (car threads) - threads nil - sub nil)) - (setq sub (cdr sub)))) - ;; It's an ordinary thread, so we check it. - (when (eq (car sub) (car headers)) - (setq thread sub - threads nil))) - (setq threads (cdr threads))) - ;; If this article is in no thread, then it's a root. - (if thread - (unless dont-remove - (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads))) - (setq thread (gnus-gethash last-id dep))) - (when thread - (prog1 - thread ; We return this thread. - (unless dont-remove - (if (stringp (car thread)) - (progn - ;; If we use dummy roots, then we have to remove the - ;; dummy root as well. - (when (eq gnus-summary-make-false-root 'dummy) - (gnus-delete-line) - (gnus-data-compute-positions)) - (setq thread (cdr thread)) - (while thread - (gnus-remove-thread-1 (car thread)) - (setq thread (cdr thread)))) - (gnus-remove-thread-1 thread)))))))) - -(defun gnus-remove-thread-1 (thread) - "Remove the thread THREAD recursively." - (let ((number (mail-header-number (pop thread))) - d) - (setq thread (reverse thread)) - (while thread - (gnus-remove-thread-1 (pop thread))) - (when (setq d (gnus-data-find number)) - (goto-char (gnus-data-pos d)) - (gnus-data-remove - number - (- (gnus-point-at-bol) - (prog1 - (1+ (gnus-point-at-eol)) - (gnus-delete-line))))))) - -(defun gnus-sort-threads (threads) - "Sort THREADS." - (if (not gnus-thread-sort-functions) - threads - (gnus-message 7 "Sorting threads...") - (prog1 - (sort threads (gnus-make-sort-function gnus-thread-sort-functions)) - (gnus-message 7 "Sorting threads...done")))) - -(defun gnus-sort-articles (articles) - "Sort ARTICLES." - (when gnus-article-sort-functions - (gnus-message 7 "Sorting articles...") - (prog1 - (setq gnus-newsgroup-headers - (sort articles (gnus-make-sort-function - gnus-article-sort-functions))) - (gnus-message 7 "Sorting articles...done")))) - -;; Written by Hallvard B Furuseth . -(defmacro gnus-thread-header (thread) - ;; Return header of first article in THREAD. - ;; Note that THREAD must never, ever be anything else than a variable - - ;; using some other form will lead to serious barfage. - (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) - ;; (8% speedup to gnus-summary-prepare, just for fun :-) - (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; - (vector thread) 2)) - -(defsubst gnus-article-sort-by-number (h1 h2) - "Sort articles by article number." - (< (mail-header-number h1) - (mail-header-number h2))) - -(defun gnus-thread-sort-by-number (h1 h2) - "Sort threads by root article number." - (gnus-article-sort-by-number - (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) - (mail-header-lines h2))) - -(defun gnus-thread-sort-by-lines (h1 h2) - "Sort threads by root article Lines header." - (gnus-article-sort-by-lines - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-author (h1 h2) - "Sort articles by root author." - (string-lessp - (let ((extract (funcall - gnus-extract-address-components - (mail-header-from h1)))) - (or (car extract) (cadr extract) "")) - (let ((extract (funcall - gnus-extract-address-components - (mail-header-from h2)))) - (or (car extract) (cadr extract) "")))) - -(defun gnus-thread-sort-by-author (h1 h2) - "Sort threads by root author." - (gnus-article-sort-by-author - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-subject (h1 h2) - "Sort articles by root subject." - (string-lessp - (downcase (gnus-simplify-subject-re (mail-header-subject h1))) - (downcase (gnus-simplify-subject-re (mail-header-subject h2))))) - -(defun gnus-thread-sort-by-subject (h1 h2) - "Sort threads by root subject." - (gnus-article-sort-by-subject - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-date (h1 h2) - "Sort articles by root article date." - (gnus-time-less - (gnus-date-get-time (mail-header-date h1)) - (gnus-date-get-time (mail-header-date h2)))) - -(defun gnus-thread-sort-by-date (h1 h2) - "Sort threads by root article date." - (gnus-article-sort-by-date - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-score (h1 h2) - "Sort articles by root article score. -Unscored articles will be counted as having a score of zero." - (> (or (cdr (assq (mail-header-number h1) - gnus-newsgroup-scored)) - gnus-summary-default-score 0) - (or (cdr (assq (mail-header-number h2) - gnus-newsgroup-scored)) - gnus-summary-default-score 0))) - -(defun gnus-thread-sort-by-score (h1 h2) - "Sort threads by root article score." - (gnus-article-sort-by-score - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defun gnus-thread-sort-by-total-score (h1 h2) - "Sort threads by the sum of all scores in the thread. -Unscored articles will be counted as having a score of zero." - (> (gnus-thread-total-score h1) (gnus-thread-total-score h2))) - -(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))))) - -(defun gnus-thread-total-score-1 (root) - ;; This function find the total score of the thread below ROOT. - (setq root (car root)) - (apply gnus-thread-score-function - (or (append - (mapcar 'gnus-thread-total-score - (cdr (gnus-gethash (mail-header-id root) - gnus-newsgroup-dependencies))) - (when (> (mail-header-number root) 0) - (list (or (cdr (assq (mail-header-number root) - gnus-newsgroup-scored)) - gnus-summary-default-score 0)))) - (list gnus-summary-default-score) - '(0)))) - -;; Added by Per Abrahamsen . -(defvar gnus-tmp-prev-subject nil) -(defvar gnus-tmp-false-parent nil) -(defvar gnus-tmp-root-expunged nil) -(defvar gnus-tmp-dummy-line nil) - -(defun gnus-summary-prepare-threads (threads) - "Prepare summary buffer from THREADS and indentation LEVEL. -THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' -or a straight list of headers." - (gnus-message 7 "Generating summary...") - - (setq gnus-newsgroup-threads threads) - (beginning-of-line) - - (let ((gnus-tmp-level 0) - (default-score (or gnus-summary-default-score 0)) - (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight)) - thread number subject stack state gnus-tmp-gathered beg-match - new-roots gnus-tmp-new-adopts thread-end - gnus-tmp-header gnus-tmp-unread - 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) - - (setq gnus-tmp-prev-subject nil) - - (if (vectorp (car threads)) - ;; If this is a straight (sic) list of headers, then a - ;; threaded summary display isn't required, so we just create - ;; an unthreaded one. - (gnus-summary-prepare-unthreaded threads) - - ;; Do the threaded display. - - (while (or threads stack gnus-tmp-new-adopts new-roots) - - (if (and (= gnus-tmp-level 0) - (not (setq gnus-tmp-dummy-line nil)) - (or (not stack) - (= (caar stack) 0)) - (not gnus-tmp-false-parent) - (or gnus-tmp-new-adopts new-roots)) - (if gnus-tmp-new-adopts - (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1) - thread (list (car gnus-tmp-new-adopts)) - gnus-tmp-header (caar thread) - gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts)) - (when new-roots - (setq thread (list (car new-roots)) - gnus-tmp-header (caar thread) - new-roots (cdr new-roots)))) - - (if threads - ;; If there are some threads, we do them before the - ;; threads on the stack. - (setq thread threads - gnus-tmp-header (caar thread)) - ;; There were no current threads, so we pop something off - ;; the stack. - (setq state (car stack) - gnus-tmp-level (car state) - thread (cdr state) - stack (cdr stack) - gnus-tmp-header (caar thread)))) - - (setq gnus-tmp-false-parent nil) - (setq gnus-tmp-root-expunged nil) - (setq thread-end nil) - - (if (stringp gnus-tmp-header) - ;; The header is a dummy root. - (cond - ((eq gnus-summary-make-false-root 'adopt) - ;; We let the first article adopt the rest. - (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts - (cddar thread))) - (setq gnus-tmp-gathered - (nconc (mapcar - (lambda (h) (mail-header-number (car h))) - (cddar thread)) - gnus-tmp-gathered)) - (setq thread (cons (list (caar thread) - (cadar thread)) - (cdr thread))) - (setq gnus-tmp-level -1 - gnus-tmp-false-parent t)) - ((eq gnus-summary-make-false-root 'empty) - ;; We print adopted articles with empty subject fields. - (setq gnus-tmp-gathered - (nconc (mapcar - (lambda (h) (mail-header-number (car h))) - (cddar thread)) - gnus-tmp-gathered)) - (setq gnus-tmp-level -1)) - ((eq gnus-summary-make-false-root 'dummy) - ;; We remember that we probably want to output a dummy - ;; root. - (setq gnus-tmp-dummy-line gnus-tmp-header) - (setq gnus-tmp-prev-subject gnus-tmp-header)) - (t - ;; We do not make a root for the gathered - ;; sub-threads at all. - (setq gnus-tmp-level -1))) - - (setq number (mail-header-number gnus-tmp-header) - subject (mail-header-subject gnus-tmp-header)) - - (cond - ;; If the thread has changed subject, we might want to make - ;; this subthread into a root. - ((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)))) - (setq new-roots (nconc new-roots (list (car thread))) - thread-end t - gnus-tmp-header nil)) - ;; If the article lies outside the current limit, - ;; then we do not display it. - ((not (memq number gnus-newsgroup-limit)) - (setq gnus-tmp-gathered - (nconc (mapcar - (lambda (h) (mail-header-number (car h))) - (cdar thread)) - gnus-tmp-gathered)) - (setq gnus-tmp-new-adopts (if (cdar thread) - (append gnus-tmp-new-adopts - (cdar thread)) - gnus-tmp-new-adopts) - thread-end t - gnus-tmp-header nil) - (when (zerop gnus-tmp-level) - (setq gnus-tmp-root-expunged t))) - ;; Perhaps this article is to be marked as read? - ((and gnus-summary-mark-below - (< (or (cdr (assq number gnus-newsgroup-scored)) - default-score) - gnus-summary-mark-below) - ;; Don't touch sparse articles. - (not (gnus-summary-article-sparse-p number)) - (not (gnus-summary-article-ancient-p number))) - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads)))) - - (when gnus-tmp-header - ;; We may have an old dummy line to output before this - ;; article. - (when gnus-tmp-dummy-line - (gnus-summary-insert-dummy-line - gnus-tmp-dummy-line (mail-header-number gnus-tmp-header)) - (setq gnus-tmp-dummy-line nil)) - - ;; Compute the mark. - (setq gnus-tmp-unread (gnus-article-mark number)) - - (push (gnus-data-make number gnus-tmp-unread (1+ (point)) - gnus-tmp-header gnus-tmp-level) - gnus-newsgroup-data) - - ;; Actually insert the line. - (setq - gnus-tmp-subject-or-nil - (cond - ((and gnus-thread-ignore-subject - gnus-tmp-prev-subject - (not (inline (gnus-subject-equal - gnus-tmp-prev-subject 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))) - gnus-summary-same-subject - subject)) - (t gnus-summary-same-subject))) - (if (and (eq gnus-summary-make-false-root 'adopt) - (= gnus-tmp-level 1) - (memq number gnus-tmp-gathered)) - (setq gnus-tmp-opening-bracket ?\< - gnus-tmp-closing-bracket ?\>) - (setq gnus-tmp-opening-bracket ?\[ - gnus-tmp-closing-bracket ?\])) - (setq - gnus-tmp-indentation - (aref gnus-thread-indent-array gnus-tmp-level) - gnus-tmp-lines (mail-header-lines gnus-tmp-header) - gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored)) - gnus-summary-default-score 0) - gnus-tmp-score-char - (if (or (null gnus-summary-default-score) - (<= (abs (- gnus-tmp-score gnus-summary-default-score)) - gnus-summary-zcore-fuzz)) - ? - (if (< gnus-tmp-score gnus-summary-default-score) - gnus-score-below-mark gnus-score-over-mark)) - gnus-tmp-replied - (cond ((memq number gnus-newsgroup-processable) - gnus-process-mark) - ((memq number gnus-newsgroup-cached) - gnus-cached-mark) - ((memq number gnus-newsgroup-replied) - gnus-replied-mark) - ((memq number gnus-newsgroup-saved) - gnus-saved-mark) - (t gnus-unread-mark)) - gnus-tmp-from (mail-header-from gnus-tmp-header) - gnus-tmp-name - (cond - ((string-match "<[^>]+> *$" gnus-tmp-from) - (setq beg-match (match-beginning 0)) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) - (substring gnus-tmp-from 0 beg-match))) - ((string-match "(.+)" gnus-tmp-from) - (substring gnus-tmp-from - (1+ (match-beginning 0)) (1- (match-end 0)))) - (t gnus-tmp-from))) - (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 - (point) - (progn (eval gnus-summary-line-format-spec) (point)) - '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))) - - (when (nth 1 thread) - (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack)) - (incf gnus-tmp-level) - (setq threads (if thread-end nil (cdar thread))) - (unless threads - (setq gnus-tmp-level 0))))) - (gnus-message 7 "Generating summary...done")) - -(defun gnus-summary-prepare-unthreaded (headers) - "Generate an unthreaded summary buffer based on HEADERS." - (let (header number mark) - - (beginning-of-line) - - (while headers - ;; We may have to root out some bad articles... - (when (memq (setq number (mail-header-number - (setq header (pop headers)))) - gnus-newsgroup-limit) - ;; Mark article as read when it has a low score. - (when (and gnus-summary-mark-below - (< (or (cdr (assq number gnus-newsgroup-scored)) - gnus-summary-default-score 0) - gnus-summary-mark-below) - (not (gnus-summary-article-ancient-p number))) - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads))) - - (setq mark (gnus-article-mark number)) - (push (gnus-data-make number mark (1+ (point)) header 0) - gnus-newsgroup-data) - (gnus-summary-insert-line - header 0 number - mark (memq number gnus-newsgroup-replied) - (memq number gnus-newsgroup-expirable) - (mail-header-subject header) nil - (cdr (assq number gnus-newsgroup-scored)) - (memq number gnus-newsgroup-processable)))))) - -(defun gnus-select-newsgroup (group &optional read-all) - "Select newsgroup GROUP. -If READ-ALL is non-nil, all articles in the group are selected." - (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) - 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))) - (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))) - (error "Couldn't request 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))) - (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)) - - ;; Adjust and set lists of article marks. - (when info - (gnus-adjust-marked-articles info)) - - ;; Kludge to avoid having cached articles nixed out in virtual groups. - (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-newsgroup-dormant)) - - (setq gnus-newsgroup-processable nil) - - (gnus-update-read-articles group gnus-newsgroup-unreads) - (unless (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-group-update-group group)) - - (setq articles (gnus-articles-to-read group read-all)) - - (cond - ((null articles) - ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display") - 'quit) - ((eq articles 0) nil) - (t - ;; Init the dependencies hash table. - (setq gnus-newsgroup-dependencies - (gnus-make-hashtable (length articles))) - ;; Retrieve the headers and read them in. - (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) - (setq gnus-newsgroup-headers - (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 gnus-fetch-old-headers - (or (and - (not (eq gnus-fetch-old-headers 'some)) - (not (numberp gnus-fetch-old-headers))) - (> (length articles) 1)))))) - (gnus-get-newsgroup-headers-xover - articles nil nil gnus-newsgroup-name t) - (gnus-get-newsgroup-headers))) - (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name) - - ;; Kludge to avoid having cached articles nixed out in virtual groups. - (when cached - (setq gnus-newsgroup-cached cached)) - - ;; Suppress duplicates? - (when gnus-suppress-duplicates - (gnus-dup-suppress-articles)) - - ;; Set the initial limit. - (setq gnus-newsgroup-limit (copy-sequence articles)) - ;; Remove canceled articles from the list of unread 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)))) - ;; Removed marked articles that do not exist. - (gnus-update-missing-marks - (gnus-sorted-complement fetched-articles articles)) - ;; Let the Gnus agent mark articles as read. - (when gnus-agent - (gnus-agent-get-undownloaded-list)) - ;; We might want to build some more threads first. - (when (and gnus-fetch-old-headers - (eq gnus-headers-retrieved-by 'nov)) - (if (eq gnus-fetch-old-headers 'invisible) - (gnus-build-all-threads) - (gnus-build-old-threads))) - ;; Check whether auto-expire is to be done in this group. - (setq gnus-newsgroup-auto-expire - (gnus-group-auto-expirable-p group)) - ;; Set up the article buffer now, if necessary. - (unless gnus-single-article-buffer - (gnus-article-setup-buffer)) - ;; 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)))) - ;; GROUP is successfully selected. - (or gnus-newsgroup-headers t))))) - -(defun gnus-articles-to-read (group &optional read-all) - ;; Find out what articles the user wants to read. - (let* ((articles - ;; Select all articles if `read-all' is non-nil, or if there - ;; are no unread articles. - (if (or read-all - (and (zerop (length gnus-newsgroup-marked)) - (zerop (length gnus-newsgroup-unreads))) - (eq (gnus-group-find-parameter group 'display) - 'all)) - (gnus-uncompress-range (gnus-active group)) - (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked - (copy-sequence gnus-newsgroup-unreads)) - '<))) - (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) - (scored (length scored-list)) - (number (length articles)) - (marked (+ (length gnus-newsgroup-marked) - (length gnus-newsgroup-dormant))) - (select - (cond - ((numberp read-all) - read-all) - (t - (condition-case () - (cond - ((and (or (<= scored marked) (= scored number)) - (numberp gnus-large-newsgroup) - (> number gnus-large-newsgroup)) - (let ((input - (read-string - (format - "How many articles from %s (default %d): " - (gnus-limit-string gnus-newsgroup-name 35) - number)))) - (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)))) - (if (string-match "^[ \t]*$" input) - number input))) - (t number)) - (quit nil)))))) - (setq select (if (stringp select) (string-to-number select) select)) - (if (or (null select) (zerop select)) - select - (if (and (not (zerop scored)) (<= (abs select) scored)) - (progn - (setq articles (sort scored-list '<)) - (setq number (length articles))) - (setq articles (copy-sequence articles))) - - (when (< (abs select) number) - (if (< select 0) - ;; Select the N oldest articles. - (setcdr (nthcdr (1- (abs select)) articles) nil) - ;; 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))) - articles))) - -(defun gnus-killed-articles (killed articles) - (let (out) - (while articles - (when (inline (gnus-member-of-range (car articles) killed)) - (push (car articles) out)) - (setq articles (cdr articles))) - out)) - -(defun gnus-uncompress-marks (marks) - "Uncompress the mark ranges in MARKS." - (let ((uncompressed '(score bookmark)) - out) - (while marks - (if (memq (caar marks) uncompressed) - (push (car marks) out) - (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out)) - (setq marks (cdr marks))) - out)) - -(defun gnus-adjust-marked-articles (info) - "Set all article lists and remove all marks that are no longer legal." - (let* ((marked-lists (gnus-info-marks info)) - (active (gnus-active (gnus-info-group info))) - (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)))) - - (setq articles (symbol-value var)) - - ;; All articles have to be subsets 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)))))) - ;; Adjust assocs. - ((memq mark uncompressed) - (when (not (listp (cdr (symbol-value var)))) - (set var (list (symbol-value var)))) - (when (not (listp (cdr articles))) - (setq articles (list articles))) - (while articles - (when (or (not (consp (setq article (pop articles)))) - (< (car article) min) - (> (car article) max)) - (set var (delq article (symbol-value var)))))))))) - -(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) - ;; 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))))))))) - -(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) - (when info - ;; Add all marks lists that are non-nil to the list of marks lists. - (while (setq type (pop types)) - (when (setq list (symbol-value - (setq symbol - (intern (format "gnus-newsgroup-%s" - (car type)))))) - - ;; Get rid of the entries of the articles that have the - ;; default score. - (when (and (eq (cdr type) 'score) - gnus-save-score - list) - (let* ((arts list) - (prev (cons nil list)) - (all prev)) - (while arts - (if (or (not (consp (car arts))) - (= (cdar arts) gnus-summary-default-score)) - (setcdr prev (cdr arts)) - (setq prev arts)) - (setq arts (cdr arts))) - (setq list (cdr all)))) - - (push (cons (cdr type) - (if (memq (cdr type) uncompressed) list - (gnus-compress-sequence - (set symbol (sort list '<)) t))) - newmarked))) - - ;; Enter these new marks into the info of the group. - (if (nthcdr 3 info) - (setcar (nthcdr 3 info) newmarked) - ;; Add the marks lists to the end of the info. - (when newmarked - (setcdr (nthcdr 2 info) (list newmarked)))) - - ;; Cut off the end of the info if there's nothing else there. - (let ((i 5)) - (while (and (> i 2) - (not (nth i info))) - (when (nthcdr (decf i) info) - (setcdr (nthcdr i info) nil))))))) - -(defun gnus-set-mode-line (where) - "This function sets the mode line of the article or summary buffers. -If WHERE is `summary', the summary mode line format will be used." - ;; Is this mode line one we keep updated? - (when (memq where gnus-updated-mode-lines) - (let (mode-string) - (save-excursion - ;; We evaluate this in the summary buffer since these - ;; variables are buffer-local to that buffer. - (set-buffer gnus-summary-buffer) - ;; We bind all these variables that are used in the `eval' form - ;; below. - (let* ((mformat (symbol-value - (intern - (format "gnus-%s-mode-line-format-spec" where)))) - (gnus-tmp-group-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)) - (gnus-tmp-unselected (length gnus-newsgroup-unselected)) - (gnus-tmp-unread-and-unselected - (cond ((and (zerop gnus-tmp-unread-and-unticked) - (zerop gnus-tmp-unselected)) - "") - ((zerop gnus-tmp-unselected) - (format "{%d more}" gnus-tmp-unread-and-unticked)) - (t (format "{%d(+%d) more}" - gnus-tmp-unread-and-unticked - gnus-tmp-unselected)))) - (gnus-tmp-subject - (if (and gnus-current-headers - (vectorp gnus-current-headers)) - (gnus-mode-string-quote - (mail-header-subject gnus-current-headers)) - "")) - bufname-length max-len - gnus-tmp-header);; passed as argument to any user-format-funcs - (setq mode-string (eval mformat)) - (setq bufname-length (if (string-match "%b" mode-string) - (- (length - (buffer-name - (if (eq where 'summary) - nil - (get-buffer gnus-article-buffer)))) - 2) - 0)) - (setq max-len (max 4 (if gnus-mode-non-string-length - (- (window-width) - gnus-mode-non-string-length - bufname-length) - (length mode-string)))) - ;; We might have to chop a bit of the string off... - (when (> (length mode-string) max-len) - (setq mode-string - (concat (gnus-truncate-string mode-string (- max-len 3)) - "..."))) - ;; Pad the mode string a bit. - (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) - ;; Update the mode line. - (setq mode-line-buffer-identification - (gnus-mode-line-buffer-identification (list mode-string))) - (set-buffer-modified-p t)))) - -(defun gnus-create-xref-hashtb (from-newsgroup headers unreads) - "Go through the HEADERS list and add all Xrefs to a hash table. -The resulting hash table is returned, or nil if no Xrefs were found." - (let* ((virtual (gnus-virtual-group-p from-newsgroup)) - (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup))) - (xref-hashtb (gnus-make-hashtable)) - start group entry number xrefs header) - (while headers - (setq header (pop headers)) - (when (and (setq xrefs (mail-header-xref header)) - (not (memq (setq number (mail-header-number header)) - unreads))) - (setq start 0) - (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start) - (setq start (match-end 0)) - (setq group (if prefix - (concat prefix (substring xrefs (match-beginning 1) - (match-end 1))) - (substring xrefs (match-beginning 1) (match-end 1)))) - (setq number - (string-to-int (substring xrefs (match-beginning 2) - (match-end 2)))) - (if (setq entry (gnus-gethash group xref-hashtb)) - (setcdr entry (cons number (cdr entry))) - (gnus-sethash group (cons number nil) xref-hashtb))))) - (and start xref-hashtb))) - -(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads) - "Look through all the headers and mark the Xrefs as read." - (let ((virtual (gnus-virtual-group-p from-newsgroup)) - name entry info xref-hashtb idlist method nth4) - (save-excursion - (set-buffer gnus-group-buffer) - (when (setq xref-hashtb - (gnus-create-xref-hashtb from-newsgroup headers unreads)) - (mapatoms - (lambda (group) - (unless (string= from-newsgroup (setq name (symbol-name group))) - (setq idlist (symbol-value group)) - ;; Dead groups are not updated. - (and (prog1 - (setq entry (gnus-gethash name gnus-newsrc-hashtb) - info (nth 2 entry)) - (when (stringp (setq nth4 (gnus-info-method info))) - (setq nth4 (gnus-server-to-method nth4)))) - ;; Only do the xrefs if the group has the same - ;; select method as the group we have just read. - (or (gnus-methods-equal-p - nth4 (gnus-find-method-for-group from-newsgroup)) - virtual - (equal nth4 (setq method (gnus-find-method-for-group - from-newsgroup))) - (and (equal (car nth4) (car method)) - (equal (nth 1 nth4) (nth 1 method)))) - gnus-use-cross-reference - (or (not (eq gnus-use-cross-reference t)) - virtual - ;; Only do cross-references on subscribed - ;; groups, if that is what is wanted. - (<= (gnus-info-level info) gnus-level-subscribed)) - (gnus-group-make-articles-read name idlist)))) - xref-hashtb))))) - -(defun gnus-compute-read-articles (group articles) - (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) - (info (nth 2 entry)) - (active (gnus-active group)) - ninfo) - (when entry - ;; First peel off all illegal article numbers. - (when active - (let ((ids articles) - id first) - (while (setq id (pop ids)) - (when (and first (> id (cdr active))) - ;; We'll end up in this situation in one particular - ;; obscure situation. If you re-scan a group and get - ;; a new article that is cross-posted to a different - ;; group that has not been re-scanned, you might get - ;; crossposted article that has a higher number than - ;; Gnus believes possible. So we re-activate this - ;; group as well. This might mean doing the - ;; crossposting thingy will *increase* the number - ;; of articles in some groups. Tsk, tsk. - (setq active (or (gnus-activate-group group) active))) - (when (or (> id (cdr active)) - (< id (car active))) - (setq articles (delq id articles)))))) - ;; If the read list is nil, we init it. - (if (and active - (null (gnus-info-read info)) - (> (car active) 1)) - (setq ninfo (cons 1 (1- (car active)))) - (setq ninfo (gnus-info-read info))) - ;; Then we add the read articles to the range. - (gnus-add-to-range - ninfo (setq articles (sort articles '<)))))) - -(defun gnus-group-make-articles-read (group articles) - "Update the info of GROUP to say that ARTICLES are read." - (let* ((num 0) - (entry (gnus-gethash group gnus-newsrc-hashtb)) - (info (nth 2 entry)) - (active (gnus-active group)) - range) - (when entry - (setq range (gnus-compute-read-articles group articles)) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-undo-register - `(progn - (gnus-info-set-marks ',info ',(gnus-info-marks info) t) - (gnus-info-set-read ',info ',(gnus-info-read info)) - (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) - (gnus-group-update-group ,group t)))) - ;; Add the read articles to the range. - (gnus-info-set-read info range) - ;; Then we have to re-compute how many unread - ;; articles there are in this group. - (when active - (cond - ((not range) - (setq num (- (1+ (cdr active)) (car active)))) - ((not (listp (cdr range))) - (setq num (- (cdr active) (- (1+ (cdr range)) - (car range))))) - (t - (while range - (if (numberp (car range)) - (setq num (1+ num)) - (setq num (+ num (- (1+ (cdar range)) (caar range))))) - (setq range (cdr range))) - (setq num (- (cdr active) num)))) - ;; Update the number of unread articles. - (setcar entry num) - ;; Update the group buffer. - (gnus-group-update-group group t))))) - -(defun gnus-methods-equal-p (m1 m2) - (let ((m1 (or m1 gnus-select-method)) - (m2 (or m2 gnus-select-method))) - (or (equal m1 m2) - (and (eq (car m1) (car m2)) - (or (not (memq 'address (assoc (symbol-name (car m1)) - gnus-valid-select-methods))) - (equal (nth 1 m1) (nth 1 m2))))))) - -(defvar gnus-newsgroup-none-id 0) - -(defun gnus-get-newsgroup-headers (&optional dependencies force-new) - (let ((cur nntp-server-buffer) - (dependencies - (or dependencies - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-dependencies))) - headers id id-dep ref-dep end ref) - (save-excursion - (set-buffer nntp-server-buffer) - ;; Translate all TAB characters into SPACE characters. - (subst-char-in-region (point-min) (point-max) ?\t ? t) - (gnus-run-hooks 'gnus-parse-headers-hook) - (let ((case-fold-search t) - in-reply-to header p lines) - (goto-char (point-min)) - ;; Search to the beginning of the next header. Error messages - ;; do not begin with 2 or 3. - (while (re-search-forward "^[23][0-9]+ " nil t) - (setq id nil - ref nil) - ;; 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 - ;; doesn't always go hand in hand. - (setq - header - (vector - ;; Number. - (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) - (funcall - gnus-unstructured-field-decoder (nnheader-header-value)) - "(none)")) - ;; From. - (progn - (goto-char p) - (if (search-forward "\nfrom: " nil t) - (funcall - gnus-structured-field-decoder (nnheader-header-value)) - "(nobody)")) - ;; Date. - (progn - (goto-char p) - (if (search-forward "\ndate: " nil t) - (nnheader-header-value) "")) - ;; Message-ID. - (progn - (goto-char p) - (setq id (if (search-forward "\nmessage-id:" nil t) - (buffer-substring - (1- (or (search-forward "<" nil t) (point))) - (or (search-forward ">" nil 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) - (progn - (setq end (point)) - (prog1 - (nnheader-header-value) - (setq ref - (buffer-substring - (progn - (end-of-line) - (search-backward ">" end t) - (1+ (point))) - (progn - (search-backward "<" end t) - (point)))))) - ;; 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 "<[^>]+>" in-reply-to)) - (let (ref2) - (setq ref (substring in-reply-to (match-beginning 0) - (match-end 0))) - (while (string-match "<[^>]+>" 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)))) - (setq ref nil)))) - ;; Chars. - 0 - ;; Lines. - (progn - (goto-char p) - (if (search-forward "\nlines: " nil t) - (if (numberp (setq lines (ignore-errors (read cur)))) - lines 0) - 0)) - ;; Xref. - (progn - (goto-char p) - (and (search-forward "\nxref: " nil t) - (nnheader-header-value))))) - (when (equal id ref) - (setq ref nil)) - - (when gnus-alter-header-function - (funcall gnus-alter-header-function header) - (setq id (mail-header-id header) - ref (gnus-parent-id (mail-header-references header)))) - - ;; We do the threading while we read the headers. The - ;; message-id and the last reference are both entered into - ;; the same hash table. Some tippy-toeing around has to be - ;; done in case an article has arrived before the article - ;; which it refers to. - (if (boundp (setq id-dep (intern id dependencies))) - (if (and (car (symbol-value id-dep)) - (not force-new)) - ;; An article with this Message-ID has already been seen. - (if gnus-summary-ignore-duplicates - ;; We ignore this one, except we add - ;; any additional Xrefs (in case the two articles - ;; came from different servers). - (progn - (mail-header-set-xref - (car (symbol-value id-dep)) - (concat (or (mail-header-xref - (car (symbol-value id-dep))) - "") - (or (mail-header-xref header) ""))) - (setq header nil)) - ;; We rename the Message-ID. - (set - (setq id-dep (intern (setq id (nnmail-message-id)) - dependencies)) - (list header)) - (mail-header-set-id header id)) - (setcar (symbol-value id-dep) header)) - (set id-dep (list header))) - (when header - (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) - (list (symbol-value id-dep)))) - (set ref-dep (list nil (symbol-value id-dep)))) - (push header headers)) - (goto-char (point-max)) - (widen)) - (nreverse headers))))) - -;; The following macros and functions were written by Felix Lee -;; . - -(defmacro gnus-nov-read-integer () - '(prog1 - (if (= (following-char) ?\t) - 0 - (let ((num (ignore-errors (read buffer)))) - (if (numberp num) num 0))) - (unless (eobp) - (search-forward "\t" eol 'move)))) - -(defmacro gnus-nov-skip-field () - '(search-forward "\t" eol 'move)) - -(defmacro gnus-nov-field () - '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) - -;; (defvar gnus-nov-none-counter 0) - -;; This function has to be called with point after the article number -;; on the beginning of the line. -(defun gnus-nov-parse-line (number dependencies &optional force-new) - (let ((eol (gnus-point-at-eol)) - (buffer (current-buffer)) - header ref id id-dep ref-dep) - - ;; overview: [num subject from date id refs chars lines misc] - (unwind-protect - (progn - (narrow-to-region (point) eol) - (unless (eobp) - (forward-char)) - - (setq header - (vector - number ; number - (funcall - gnus-unstructured-field-decoder (gnus-nov-field)) ; subject - (funcall - gnus-structured-field-decoder (gnus-nov-field)) ; from - (gnus-nov-field) ; date - (setq id (or (gnus-nov-field) - (nnheader-generate-fake-message-id))) ; id - (progn - (let ((beg (point))) - (search-forward "\t" eol) - (if (search-backward ">" beg t) - (setq ref - (buffer-substring - (1+ (point)) - (or (search-backward "<" beg t) beg))) - (setq ref nil)) - (goto-char beg)) - (gnus-nov-field)) ; refs - (gnus-nov-read-integer) ; chars - (gnus-nov-read-integer) ; lines - (if (= (following-char) ?\n) - nil - (gnus-nov-field))))) ; misc - - (widen)) - - (when gnus-alter-header-function - (funcall gnus-alter-header-function header) - (setq id (mail-header-id header) - ref (gnus-parent-id (mail-header-references header)))) - - ;; We build the thread tree. - (when (equal id ref) - ;; This article refers back to itself. Naughty, naughty. - (setq ref nil)) - (if (boundp (setq id-dep (intern id dependencies))) - (if (and (car (symbol-value id-dep)) - (not force-new)) - ;; An article with this Message-ID has already been seen. - (if gnus-summary-ignore-duplicates - ;; We ignore this one, except we add any additional - ;; Xrefs (in case the two articles came from different - ;; servers. - (progn - (mail-header-set-xref - (car (symbol-value id-dep)) - (concat (or (mail-header-xref - (car (symbol-value id-dep))) - "") - (or (mail-header-xref header) ""))) - (setq header nil)) - ;; We rename the Message-ID. - (set - (setq id-dep (intern (setq id (nnmail-message-id)) - dependencies)) - (list header)) - (mail-header-set-id header id)) - (setcar (symbol-value id-dep) header)) - (set id-dep (list header))) - (when header - (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) - (list (symbol-value id-dep)))) - (set ref-dep (list nil (symbol-value id-dep))))) - header)) - -;; Goes through the xover lines and returns a list of vectors -(defun gnus-get-newsgroup-headers-xover (sequence &optional - force-new dependencies - group also-fetch-heads) - "Parse the news overview data in the server buffer, and return a -list of headers that match SEQUENCE (see `nntp-retrieve-headers')." - ;; Get the Xref when the users reads the articles since most/some - ;; NNTP servers do not include Xrefs when using XOVER. - (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) - (let ((cur nntp-server-buffer) - (dependencies (or dependencies gnus-newsgroup-dependencies)) - number headers header) - (save-excursion - (set-buffer nntp-server-buffer) - ;; 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)) - ;; 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 - ;; article may not have been generated yet, so this may fail. - ;; We work around this problem by retrieving the last few - ;; headers using HEAD. - (if (or (not also-fetch-heads) - (not sequence)) - ;; We (probably) got all the headers. - (nreverse headers) - (let ((gnus-nov-is-evil t)) - (nconc - (nreverse headers) - (when (gnus-retrieve-headers sequence group) - (gnus-get-newsgroup-headers)))))))) - -(defun gnus-article-get-xrefs () - "Fill in the Xref value in `gnus-current-headers', if necessary. -This is meant to be called in `gnus-article-internal-prepare-hook'." - (let ((headers (save-excursion (set-buffer gnus-summary-buffer) - gnus-current-headers))) - (or (not gnus-use-cross-reference) - (not headers) - (and (mail-header-xref headers) - (not (string= (mail-header-xref headers) ""))) - (let ((case-fold-search t) - xref) - (save-restriction - (nnheader-narrow-to-headers) - (goto-char (point-min)) - (when (or (and (eq (downcase (following-char)) ?x) - (looking-at "Xref:")) - (search-forward "\nXref:" nil t)) - (goto-char (1+ (match-end 0))) - (setq xref (buffer-substring (point) - (progn (end-of-line) (point)))) - (mail-header-set-xref headers xref))))))) - -(defun gnus-summary-insert-subject (id &optional old-header use-old-header) - "Find article ID and insert the summary line for that article." - (let ((header (if (and old-header use-old-header) - old-header (gnus-read-header id))) - (number (and (numberp id) id)) - pos d) - (when header - ;; Rebuild the thread that this article is part of and go to the - ;; article we have fetched. - (when (and (not gnus-show-threads) - old-header) - (when (setq d (gnus-data-find (mail-header-number old-header))) - (goto-char (gnus-data-pos d)) - (gnus-data-remove - number - (- (gnus-point-at-bol) - (prog1 - (1+ (gnus-point-at-eol)) - (gnus-delete-line)))))) - (when old-header - (mail-header-set-number header (mail-header-number old-header))) - (setq gnus-newsgroup-sparse - (delq (setq number (mail-header-number header)) - gnus-newsgroup-sparse)) - (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient)) - (gnus-rebuild-thread (mail-header-id header)) - (gnus-summary-goto-subject number nil t)) - (when (and (numberp number) - (> number 0)) - ;; We have to update the boundaries even if we can't fetch the - ;; article if ID is a number -- so that the next `P' or `N' - ;; command will fetch the previous (or next) article even - ;; if the one we tried to fetch this time has been canceled. - (when (> number gnus-newsgroup-end) - (setq gnus-newsgroup-end number)) - (when (< number gnus-newsgroup-begin) - (setq gnus-newsgroup-begin number)) - (setq gnus-newsgroup-unselected - (delq number gnus-newsgroup-unselected))) - ;; Report back a success? - (and header (mail-header-number header)))) - -;;; Process/prefix in the summary buffer - -(defun gnus-summary-work-articles (n) - "Return a list of articles to be worked upon. The prefix argument, -the list of process marked articles, and the current article will be -taken into consideration." - (save-excursion - (set-buffer gnus-summary-buffer) - (cond - (n - ;; A numerical prefix has been given. - (setq n (prefix-numeric-value n)) - (let ((backward (< n 0)) - (n (abs (prefix-numeric-value n))) - articles article) - (save-excursion - (while - (and (> n 0) - (push (setq article (gnus-summary-article-number)) - articles) - (if backward - (gnus-summary-find-prev nil article) - (gnus-summary-find-next nil article))) - (decf n))) - (nreverse articles))) - ((and (gnus-region-active-p) (mark)) - (message "region active") - ;; Work on the region between point and mark. - (let ((max (max (point) (mark))) - articles article) - (save-excursion - (goto-char (min (point) (mark))) - (while - (and - (push (setq article (gnus-summary-article-number)) articles) - (gnus-summary-find-next nil article) - (< (point) max))) - (nreverse articles)))) - (gnus-newsgroup-processable - ;; There are process-marked articles present. - ;; Save current state. - (gnus-summary-save-process-mark) - ;; Return the list. - (reverse gnus-newsgroup-processable)) - (t - ;; Just return the current article. - (list (gnus-summary-article-number)))))) - -(defun gnus-summary-save-process-mark () - "Push the current set of process marked articles on the stack." - (interactive) - (push (copy-sequence gnus-newsgroup-processable) - gnus-newsgroup-process-stack)) - -(defun gnus-summary-kill-process-mark () - "Push the current set of process marked articles on the stack and unmark." - (interactive) - (gnus-summary-save-process-mark) - (gnus-summary-unmark-all-processable)) - -(defun gnus-summary-yank-process-mark () - "Pop the last process mark state off the stack and restore it." - (interactive) - (unless gnus-newsgroup-process-stack - (error "Empty mark stack")) - (gnus-summary-process-mark-set (pop gnus-newsgroup-process-stack))) - -(defun gnus-summary-process-mark-set (set) - "Make SET into the current process marked articles." - (gnus-summary-unmark-all-processable) - (while set - (gnus-summary-set-process-mark (pop set)))) - -;;; Searching and stuff - -(defun gnus-summary-search-group (&optional backward use-level) - "Search for next unread newsgroup. -If optional argument BACKWARD is non-nil, search backward instead." - (save-excursion - (set-buffer gnus-group-buffer) - (when (gnus-group-search-forward - backward nil (if use-level (gnus-group-group-level) nil)) - (gnus-group-group-name)))) - -(defun gnus-summary-best-group (&optional exclude-group) - "Find the name of the best unread group. -If EXCLUDE-GROUP, do not go to this group." - (save-excursion - (set-buffer gnus-group-buffer) - (save-excursion - (gnus-group-best-unread-group exclude-group)))) - -(defun gnus-summary-find-next (&optional unread article backward) - (if backward (gnus-summary-find-prev) - (let* ((dummy (gnus-summary-article-intangible-p)) - (article (or article (gnus-summary-article-number))) - (arts (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))) - (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))) - result) - (car arts))) - (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))) - result) - (when (and (not eobp) - (or (not gnus-summary-check-current) - (not unread) - (not (gnus-data-unread-p (car arts))))) - (setq arts (cdr arts))) - (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))) - result) - (car arts))) - (goto-char (gnus-data-pos result)) - (gnus-data-number result)))) - -(defun gnus-summary-find-subject (subject &optional unread backward article) - (let* ((simp-subject (gnus-simplify-subject-fully subject)) - (article (or article (gnus-summary-article-number))) - (articles (gnus-data-list backward)) - (arts (gnus-data-find-list article articles)) - result) - (when (or (not gnus-summary-check-current) - (not unread) - (not (gnus-data-unread-p (car arts)))) - (setq arts (cdr arts))) - (while arts - (and (or (not unread) - (gnus-data-unread-p (car arts))) - (vectorp (gnus-data-header (car arts))) - (gnus-subject-equal - simp-subject (mail-header-subject (gnus-data-header (car arts))) t) - (setq result (car arts) - arts nil)) - (setq arts (cdr arts))) - (and result - (goto-char (gnus-data-pos result)) - (gnus-data-number result)))) - -(defun gnus-summary-search-forward (&optional unread subject backward) - "Search forward for an article. -If UNREAD, look for unread articles. If SUBJECT, look for -articles with that subject. If BACKWARD, search backward instead." - (cond (subject (gnus-summary-find-subject subject unread backward)) - (backward (gnus-summary-find-prev unread)) - (t (gnus-summary-find-next unread)))) - -(defun gnus-recenter (&optional n) - "Center point in window and redisplay frame. -Also do horizontal recentering." - (interactive "P") - (when (and gnus-auto-center-summary - (not (eq gnus-auto-center-summary 'vertical))) - (gnus-horizontal-recenter)) - (recenter n)) - -(defun gnus-summary-recenter () - "Center point in the summary window. -If `gnus-auto-center-summary' is nil, or the article buffer isn't -displayed, no centering will be performed." - ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). - ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. - (let* ((top (cond ((< (window-height) 4) 0) - ((< (window-height) 7) 1) - (t 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 - (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))))) - ;; Do horizontal recentering while we're at it. - (when (and (get-buffer-window (current-buffer) t) - (not (eq gnus-auto-center-summary 'vertical))) - (let ((selected (selected-window))) - (select-window (get-buffer-window (current-buffer) t)) - (gnus-summary-position-point) - (gnus-horizontal-recenter) - (select-window selected)))))) - -(defun gnus-summary-jump-to-group (newsgroup) - "Move point to NEWSGROUP in group mode buffer." - ;; Keep update point of group mode buffer if visible. - (if (eq (current-buffer) (get-buffer gnus-group-buffer)) - (save-window-excursion - ;; Take care of tree window mode. - (when (get-buffer-window gnus-group-buffer) - (pop-to-buffer gnus-group-buffer)) - (gnus-group-jump-to-group newsgroup)) - (save-excursion - ;; Take care of tree window mode. - (if (get-buffer-window gnus-group-buffer) - (pop-to-buffer gnus-group-buffer) - (set-buffer gnus-group-buffer)) - (gnus-group-jump-to-group newsgroup)))) - -;; This function returns a list of article numbers based on the -;; difference between the ranges of read articles in this group and -;; the range of active articles. -(defun gnus-list-of-unread-articles (group) - (let* ((read (gnus-info-read (gnus-get-info group))) - (active (or (gnus-active group) (gnus-activate-group group))) - (last (cdr active)) - first nlast unread) - ;; If none are read, then all are unread. - (if (not read) - (setq first (car active)) - ;; If the range of read articles is a single range, then the - ;; first unread article is the article after the last read - ;; article. Sounds logical, doesn't it? - (if (not (listp (cdr read))) - (setq first (1+ (cdr read))) - ;; `read' is a list of ranges. - (when (/= (setq nlast (or (and (numberp (car read)) (car read)) - (caar read))) - 1) - (setq first 1)) - (while read - (when first - (while (< first nlast) - (push first unread) - (setq first (1+ first)))) - (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) - (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) - (setq read (cdr read))))) - ;; And add the last unread articles. - (while (<= first last) - (push first unread) - (setq first (1+ first))) - ;; Return the list of unread articles. - (delq 0 (nreverse unread)))) - -(defun gnus-list-of-read-articles (group) - "Return a list of unread, unticked and non-dormant articles." - (let* ((info (gnus-get-info group)) - (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)))))))) - -;; Various summary commands - -(defun gnus-summary-select-article-buffer () - "Reconfigure windows to show article buffer." - (interactive) - (if (not (gnus-buffer-live-p gnus-article-buffer)) - (error "There is no article buffer for this summary buffer") - (gnus-configure-windows 'article) - (select-window (get-buffer-window gnus-article-buffer)))) - -(defun gnus-summary-universal-argument (arg) - "Perform any operation on all articles that are process/prefixed." - (interactive "P") - (let ((articles (gnus-summary-work-articles arg)) - func article) - (if (eq - (setq - func - (key-binding - (read-key-sequence - (substitute-command-keys - "\\\\[gnus-summary-universal-argument]" - )))) - 'undefined) - (gnus-error 1 "Undefined key") - (save-excursion - (while articles - (gnus-summary-goto-subject (setq article (pop articles))) - (let (gnus-newsgroup-processable) - (command-execute func)) - (gnus-summary-remove-process-mark article))))) - (gnus-summary-position-point)) - -(defun gnus-summary-toggle-truncation (&optional arg) - "Toggle truncation of summary lines. -With arg, turn line truncation on iff arg is positive." - (interactive "P") - (setq truncate-lines - (if (null arg) (not truncate-lines) - (> (prefix-numeric-value arg) 0))) - (redraw-display)) - -(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)) - (group gnus-newsgroup-name)) - (setq gnus-newsgroup-begin nil) - (gnus-summary-exit) - ;; We have to adjust the point of group mode buffer because - ;; point was moved to the next unread newsgroup by exiting. - (gnus-summary-jump-to-group group) - (when rescan - (save-excursion - (gnus-group-get-new-news-this-group 1))) - (gnus-group-read-group all t) - (gnus-summary-goto-subject current-subject nil t))) - -(defun gnus-summary-rescan-group (&optional all) - "Exit the newsgroup, ask for new articles, and select the newsgroup." - (interactive "P") - (gnus-summary-reselect-current-group all t)) - -(defun gnus-summary-update-info (&optional non-destructive) - (save-excursion - (let ((group gnus-newsgroup-name)) - (when group - (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 '<))) - t))) - (unless (listp (cdr gnus-newsgroup-killed)) - (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) - (let ((headers gnus-newsgroup-headers)) - (when (and (not gnus-save-score) - (not non-destructive)) - (setq gnus-newsgroup-scored nil)) - ;; Set the new ranges of read articles. - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-undo-force-boundary)) - (gnus-update-read-articles - group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) - ;; Set the current article marks. - (gnus-update-marks) - ;; Do the cross-ref thing. - (when gnus-use-cross-reference - (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads)) - ;; Do not switch windows but change the buffer to work. - (set-buffer gnus-group-buffer) - (unless (gnus-ephemeral-group-p group) - (gnus-group-update-group group))))))) - -(defun gnus-summary-save-newsrc (&optional force) - "Save the current number of read/marked articles in the dribble buffer. -The dribble buffer will then be saved. -If FORCE (the prefix), also save the .newsrc file(s)." - (interactive "P") - (gnus-summary-update-info t) - (if force - (gnus-save-newsrc-file) - (gnus-dribble-save))) - -(defun gnus-summary-exit (&optional temporary) - "Exit reading current newsgroup, and then return to group selection mode. -gnus-exit-group-hook is called with no arguments if that value is non-nil." - (interactive) - (gnus-kill-save-kill-buffer) - (let* ((group gnus-newsgroup-name) - (quit-config (gnus-group-quit-config gnus-newsgroup-name)) - (mode major-mode) - (group-point nil) - (buf (current-buffer))) - (gnus-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-original-article-buffer) - (setq gnus-article-current nil)) - (when gnus-use-cache - (gnus-cache-possibly-remove-articles) - (gnus-cache-save-buffers)) - (gnus-async-prefetch-remove-group group) - (when gnus-suppress-duplicates - (gnus-dup-enter-articles)) - (when gnus-use-trees - (gnus-tree-close group)) - ;; Remove entries for this group. - (nnmail-purge-split-history group) - ;; Make all changes in this group permanent. - (unless quit-config - (gnus-run-hooks 'gnus-exit-group-hook) - (gnus-summary-update-info) - ;; Do adaptive scoring, and possibly save score files. - (when gnus-newsgroup-adaptive - (gnus-score-adaptive)) - (when gnus-use-scoring - (gnus-score-save))) - (gnus-close-group group) - ;; Make sure where we were, and go to next newsgroup. - (set-buffer gnus-group-buffer) - (unless quit-config - (gnus-group-jump-to-group group)) - (gnus-run-hooks 'gnus-summary-exit-hook) - (unless (or quit-config - ;; If this group has disappeared from the summary - ;; buffer, don't skip forwards. - (not (string= group (gnus-group-group-name)))) - (gnus-group-next-unread-group 1)) - (setq group-point (point)) - (if temporary - nil ;Nothing to do. - ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer - (gnus-kill-buffer gnus-article-buffer) - (gnus-kill-buffer gnus-original-article-buffer) - (setq gnus-article-current nil)) - (set-buffer buf) - (if (not gnus-kill-summary-on-exit) - (gnus-deaden-summary) - ;; 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) - (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) - ;; Return to group mode buffer. - (when (eq mode 'gnus-summary-mode) - (gnus-kill-buffer buf))) - (setq gnus-current-select-method gnus-select-method) - (pop-to-buffer gnus-group-buffer) - ;; Clear the current group name. - (if (not quit-config) - (progn - (goto-char group-point) - (gnus-configure-windows 'group 'force)) - (gnus-handle-ephemeral-exit quit-config)) - (unless quit-config - (setq gnus-newsgroup-name nil))))) - -(defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) -(defun gnus-summary-exit-no-update (&optional no-questions) - "Quit reading current newsgroup without updating read article info." - (interactive) - (let* ((group gnus-newsgroup-name) - (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? ")) - ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer - (gnus-kill-buffer gnus-article-buffer) - (gnus-kill-buffer gnus-original-article-buffer) - (setq gnus-article-current nil)) - (if (not gnus-kill-summary-on-exit) - (gnus-deaden-summary) - (gnus-close-group group) - (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))) - (unless gnus-single-article-buffer - (setq gnus-article-current nil)) - (when gnus-use-trees - (gnus-tree-close group)) - (gnus-async-prefetch-remove-group group) - (when (get-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer)) - ;; Return to the group buffer. - (gnus-configure-windows 'group 'force) - ;; Clear the current group name. - (setq gnus-newsgroup-name nil) - (when (equal (gnus-group-group-name) group) - (gnus-group-next-unread-group 1)) - (when quit-config - (gnus-handle-ephemeral-exit quit-config))))) - -(defun gnus-handle-ephemeral-exit (quit-config) - "Handle movement when leaving an ephemeral group. The state -which existed when entering the ephemeral is reset." - (if (not (buffer-name (car quit-config))) - (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)))) - (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))) - (gnus-configure-windows (cdr quit-config) 'force)) - (when (eq major-mode 'gnus-summary-mode) - (gnus-summary-next-subject 1 nil t) - (gnus-summary-recenter) - (gnus-summary-position-point)))) - -(defun gnus-summary-preview-mime-message (arg) - "MIME decode and play this message." - (interactive "P") - (let ((gnus-break-pages nil)) - (gnus-summary-select-article t t) - ) - (pop-to-buffer gnus-original-article-buffer t) - (let (buffer-read-only) - (if (text-property-any (point-min) (point-max) 'invisible t) - (remove-text-properties (point-min) (point-max) - gnus-hidden-properties) - )) - (mime-view-mode nil nil nil gnus-original-article-buffer - gnus-article-buffer) - ) - -(defun gnus-summary-scroll-down () - "Scroll down one line current article." - (interactive) - (gnus-summary-scroll-up -1) - ) - -;;; Dead summaries. - -(defvar gnus-dead-summary-mode-map nil) - -(unless gnus-dead-summary-mode-map - (setq gnus-dead-summary-mode-map (make-keymap)) - (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)))) - -(defvar gnus-dead-summary-mode nil - "Minor mode for Gnus summary buffers.") - -(defun gnus-dead-summary-mode (&optional arg) - "Minor mode for Gnus summary buffers." - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (make-local-variable 'gnus-dead-summary-mode) - (setq gnus-dead-summary-mode - (if (null arg) (not gnus-dead-summary-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-dead-summary-mode - (gnus-add-minor-mode - 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map)))) - -(defun gnus-deaden-summary () - "Make the current summary buffer into a dead summary buffer." - ;; Kill any previous dead summary buffer. - (when (and gnus-dead-summary - (buffer-name gnus-dead-summary)) - (save-excursion - (set-buffer gnus-dead-summary) - (when gnus-dead-summary-mode - (kill-buffer (current-buffer))))) - ;; Make this the current dead summary. - (setq gnus-dead-summary (current-buffer)) - (gnus-dead-summary-mode 1) - (let ((name (buffer-name))) - (when (string-match "Summary" name) - (rename-buffer - (concat (substring name 0 (match-beginning 0)) "Dead " - (substring name (match-beginning 0))) - t)))) - -(defun gnus-kill-or-deaden-summary (buffer) - "Kill or deaden the summary BUFFER." - (save-excursion - (when (and (buffer-name buffer) - (not gnus-single-article-buffer)) - (save-excursion - (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 - (and (get-buffer buffer) - (buffer-name (get-buffer buffer)))) - (save-excursion - (set-buffer (get-buffer buffer)) - (gnus-tree-close gnus-newsgroup-name))) - (gnus-kill-buffer buffer)) - ((and (get-buffer buffer) - (buffer-name (get-buffer buffer))) - (save-excursion - (set-buffer buffer) - (gnus-deaden-summary)))))) - -(defun gnus-summary-wake-up-the-dead (&rest args) - "Wake up the dead summary buffer." - (interactive) - (gnus-dead-summary-mode -1) - (let ((name (buffer-name))) - (when (string-match "Dead " name) - (rename-buffer - (concat (substring name 0 (match-beginning 0)) - (substring name (match-end 0))) - t))) - (gnus-message 3 "This dead summary is now alive again")) - -;; Suggested by Andrew Eskilsson . -(defun gnus-summary-fetch-faq (&optional faq-dir) - "Fetch the FAQ for the current group. -If FAQ-DIR (the prefix), prompt for a directory to search for the faq -in." - (interactive - (list - (when current-prefix-arg - (completing-read - "Faq dir: " (and (listp gnus-group-faq-directory) - (mapcar (lambda (file) (list file)) - gnus-group-faq-directory)))))) - (let (gnus-faq-buffer) - (when (setq gnus-faq-buffer - (gnus-group-fetch-faq gnus-newsgroup-name faq-dir)) - (gnus-configure-windows 'summary-faq)))) - -;; Suggested by Per Abrahamsen . -(defun gnus-summary-describe-group (&optional force) - "Describe the current newsgroup." - (interactive "P") - (gnus-group-describe-group force gnus-newsgroup-name)) - -(defun gnus-summary-describe-briefly () - "Describe summary mode commands briefly." - (interactive) - (gnus-message 6 - (substitute-command-keys "\\\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"))) - -;; Walking around group mode buffer from summary mode. - -(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 -previous group instead." - (interactive "P") - ;; Stop pre-fetching. - (gnus-async-halt-prefetch) - (let ((current-group gnus-newsgroup-name) - (current-buffer (current-buffer)) - entered) - ;; First we semi-exit this group to update Xrefs and all variables. - ;; We can't do a real exit, because the window conf must remain - ;; the same in case the user is prompted for info, and we don't - ;; want the window conf to change before that... - (gnus-summary-exit t) - (while (not entered) - ;; Then we find what group we are supposed to enter. - (set-buffer gnus-group-buffer) - (gnus-group-jump-to-group current-group) - (setq target-group - (or target-group - (if (eq gnus-keep-same-level 'best) - (gnus-summary-best-group gnus-newsgroup-name) - (gnus-summary-search-group backward gnus-keep-same-level)))) - (if (not target-group) - ;; There are no further groups, so we return to the group - ;; buffer. - (progn - (gnus-message 5 "Returning to the group buffer") - (setq entered t) - (when (gnus-buffer-live-p current-buffer) - (set-buffer current-buffer) - (gnus-summary-exit)) - (gnus-run-hooks 'gnus-group-no-more-groups-hook)) - ;; We try to enter the target group. - (gnus-group-jump-to-group target-group) - (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))) - (setq entered t) - (setq current-group target-group - target-group nil))))))) - -(defun gnus-summary-prev-group (&optional no-article) - "Exit current newsgroup and then select previous unread newsgroup. -If prefix argument NO-ARTICLE is non-nil, no article is selected initially." - (interactive "P") - (gnus-summary-next-group no-article nil t)) - -;; Walking around summary lines. - -(defun gnus-summary-first-subject (&optional unread) - "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." - (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 - (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))) - -(defun gnus-summary-next-subject (n &optional unread dont-display) - "Go to next N'th summary line. -If N is negative, go to the previous N'th subject line. -If UNREAD is non-nil, only unread articles are selected. -The difference between N and the actual number of steps taken is -returned." - (interactive "p") - (let ((backward (< n 0)) - (n (abs n))) - (while (and (> n 0) - (if backward - (gnus-summary-find-prev unread) - (gnus-summary-find-next unread))) - (setq n (1- n))) - (when (/= 0 n) - (gnus-message 7 "No more%s articles" - (if unread " unread" ""))) - (unless dont-display - (gnus-summary-recenter) - (gnus-summary-position-point)) - n)) - -(defun gnus-summary-next-unread-subject (n) - "Go to next N'th unread summary line." - (interactive "p") - (gnus-summary-next-subject n t)) - -(defun gnus-summary-prev-subject (n &optional unread) - "Go to previous N'th summary line. -If optional argument UNREAD is non-nil, only unread article is selected." - (interactive "p") - (gnus-summary-next-subject (- n) unread)) - -(defun gnus-summary-prev-unread-subject (n) - "Go to previous N'th unread summary line." - (interactive "p") - (gnus-summary-next-subject (- n) t)) - -(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: ") - (let ((b (point)) - (data (gnus-data-find article))) - ;; We read in the article if we have to. - (and (not data) - force - (gnus-summary-insert-subject article (and (vectorp force) force) t) - (setq data (gnus-data-find article))) - (goto-char b) - (if (not data) - (progn - (unless silent - (gnus-message 3 "Can't find article %d" article)) - nil) - (goto-char (gnus-data-pos data)) - article))) - -;; Walking around summary lines with displaying articles. - -(defun gnus-summary-expand-window (&optional arg) - "Make the summary buffer take up the entire Emacs frame. -Given a prefix, will force an `article' buffer configuration." - (interactive "P") - (if arg - (gnus-configure-windows 'article 'force) - (gnus-configure-windows 'summary 'force))) - -(defun gnus-summary-display-article (article &optional all-header) - "Display ARTICLE in article buffer." - (gnus-set-global-variables) - (if (null article) - nil - (prog1 - (if gnus-summary-display-article-function - (funcall gnus-summary-display-article-function article all-header) - (gnus-article-prepare article all-header)) - (gnus-run-hooks 'gnus-select-article-hook) - (when (and gnus-current-article - (not (zerop gnus-current-article))) - (gnus-summary-goto-subject gnus-current-article)) - (gnus-summary-recenter) - (when (and gnus-use-trees gnus-show-threads) - (gnus-possibly-generate-tree article) - (gnus-highlight-selected-tree article)) - ;; Successfully display article. - (gnus-article-set-window-start - (cdr (assq article gnus-newsgroup-bookmarks)))))) - -(defun gnus-summary-select-article (&optional all-headers force pseudo article) - "Select the current article. -If ALL-HEADERS is non-nil, show all header fields. If FORCE is -non-nil, the article will be re-fetched even if it already present in -the article buffer. If PSEUDO is non-nil, pseudo-articles will also -be displayed." - ;; Make sure we are in the summary buffer to work around bbdb bug. - (unless (eq major-mode 'gnus-summary-mode) - (set-buffer gnus-summary-buffer)) - (let ((article (or article (gnus-summary-article-number))) - (all-headers (not (not all-headers))) ;Must be T or NIL. - gnus-summary-display-article-function - did) - (and (not pseudo) - (gnus-summary-article-pseudo-p article) - (error "This is a pseudo-article")) - (prog1 - (save-excursion - (set-buffer gnus-summary-buffer) - (if (or (and gnus-single-article-buffer - (or (null gnus-current-article) - (null gnus-article-current) - (null (get-buffer gnus-article-buffer)) - (not (eq article (cdr gnus-article-current))) - (not (equal (car gnus-article-current) - gnus-newsgroup-name)))) - (and (not gnus-single-article-buffer) - (or (null gnus-current-article) - (not (eq gnus-current-article article)))) - force) - ;; The requested article is different from the current article. - (prog1 - (gnus-summary-display-article article all-headers) - (setq did article)) - (when (or all-headers gnus-show-all-headers) - (gnus-article-show-all-headers)) - 'old)) - (when did - (gnus-article-set-window-start - (cdr (assq article gnus-newsgroup-bookmarks))))))) - -(defun gnus-summary-set-current-mark (&optional current-mark) - "Obsolete function." - nil) - -(defun gnus-summary-next-article (&optional unread subject backward push) - "Select the next article. -If UNREAD, only unread articles are selected. -If SUBJECT, only articles with SUBJECT are selected. -If BACKWARD, the previous article is selected instead of the next." - (interactive "P") - (cond - ;; Is there such an article? - ((and (gnus-summary-search-forward unread subject backward) - (or (gnus-summary-display-article (gnus-summary-article-number)) - (eq (gnus-summary-article-mark) gnus-canceled-mark))) - (gnus-summary-position-point)) - ;; If not, we try the first unread, if that is wanted. - ((and subject - gnus-auto-select-same - (gnus-summary-first-unread-article)) - (gnus-summary-position-point) - (gnus-message 6 "Wrapped")) - ;; Try to get next/previous article not displayed in this group. - ((and gnus-auto-extend-newsgroup - (not unread) (not subject)) - (gnus-summary-goto-article - (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end)) - nil t)) - ;; Go to next/previous group. - (t - (unless (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-summary-jump-to-group gnus-newsgroup-name)) - (let ((cmd last-command-char) - (point - (save-excursion - (set-buffer gnus-group-buffer) - (point))) - (group - (if (eq gnus-keep-same-level 'best) - (gnus-summary-best-group gnus-newsgroup-name) - (gnus-summary-search-group backward gnus-keep-same-level)))) - ;; For some reason, the group window gets selected. We change - ;; it back. - (select-window (get-buffer-window (current-buffer))) - ;; Select next unread newsgroup automagically. - (cond - ((or (not gnus-auto-select-next) - (not cmd)) - (gnus-message 7 "No more%s articles" (if unread " unread" ""))) - ((or (eq gnus-auto-select-next 'quietly) - (and (eq gnus-auto-select-next 'slightly-quietly) - push) - (and (eq gnus-auto-select-next 'almost-quietly) - (gnus-summary-last-article-p))) - ;; Select quietly. - (if (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-summary-exit) - (gnus-message 7 "No more%s articles (%s)..." - (if unread " unread" "") - (if group (concat "selecting " group) - "exiting")) - (gnus-summary-next-group nil group backward))) - (t - (when (gnus-key-press-event-p last-input-event) - (gnus-summary-walk-group-buffer - gnus-newsgroup-name cmd unread backward point)))))))) - -(defun gnus-summary-walk-group-buffer (from-group cmd unread backward start) - (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) - (save-excursion - (set-buffer gnus-group-buffer) - (goto-char start) - (setq group - (if (eq gnus-keep-same-level 'best) - (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))) - ;; Confirm auto selection. - (setq key (car (setq keve (gnus-read-event-char)))) - (setq ended t) - (cond - ((assq key keystrokes) - (let ((obuf (current-buffer))) - (switch-to-buffer gnus-group-buffer) - (when group - (gnus-group-jump-to-group group)) - (eval (cadr (assq key keystrokes))) - (setq group (gnus-group-group-name)) - (switch-to-buffer obuf)) - (setq ended nil)) - ((equal key cmd) - (if (or (not group) - (gnus-ephemeral-group-p gnus-newsgroup-name)) - (gnus-summary-exit) - (gnus-summary-next-group nil group backward))) - (t - (push (cdr keve) unread-command-events)))))) - -(defun gnus-summary-next-unread-article () - "Select unread article after current one." - (interactive) - (gnus-summary-next-article - (or (not (eq gnus-summary-goto-unread 'never)) - (gnus-summary-last-article-p (gnus-summary-article-number))) - (and gnus-auto-select-same - (gnus-summary-article-subject)))) - -(defun gnus-summary-prev-article (&optional unread subject) - "Select the article after the current one. -If UNREAD is non-nil, only unread articles are selected." - (interactive "P") - (gnus-summary-next-article unread subject t)) - -(defun gnus-summary-prev-unread-article () - "Select unread article before current one." - (interactive) - (gnus-summary-prev-article - (or (not (eq gnus-summary-goto-unread 'never)) - (gnus-summary-first-article-p (gnus-summary-article-number))) - (and gnus-auto-select-same - (gnus-summary-article-subject)))) - -(defun gnus-summary-next-page (&optional lines circular) - "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." - (interactive "P") - (setq gnus-summary-buffer (current-buffer)) - (gnus-set-global-variables) - (let ((article (gnus-summary-article-number)) - (article-window (get-buffer-window gnus-article-buffer t)) - endp) - (gnus-configure-windows 'article) - (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark) - (if (and (eq gnus-summary-goto-unread 'never) - (not (gnus-summary-last-article-p article))) - (gnus-summary-next-article) - (gnus-summary-next-unread-article)) - (if (or (null gnus-current-article) - (null gnus-article-current) - (/= article (cdr gnus-article-current)) - (not (equal (car gnus-article-current) gnus-newsgroup-name))) - ;; Selected subject is different from current article's. - (gnus-summary-display-article article) - (when article-window - (gnus-eval-in-buffer-window gnus-article-buffer - (setq endp (gnus-article-next-page lines))) - (when endp - (cond (circular - (gnus-summary-beginning-of-article)) - (lines - (gnus-message 3 "End of message")) - ((null lines) - (if (and (eq gnus-summary-goto-unread 'never) - (not (gnus-summary-last-article-p article))) - (gnus-summary-next-article) - (gnus-summary-next-unread-article)))))))) - (gnus-summary-recenter) - (gnus-summary-position-point))) - -(defun gnus-summary-prev-page (&optional lines move) - "Show previous page of selected article. -Argument LINES specifies lines to be scrolled down. -If MOVE, move to the previous unread article if point is at -the beginning of the buffer." - (interactive "P") - (let ((article (gnus-summary-article-number)) - (article-window (get-buffer-window gnus-article-buffer t)) - endp) - (gnus-configure-windows 'article) - (if (or (null gnus-current-article) - (null gnus-article-current) - (/= article (cdr gnus-article-current)) - (not (equal (car gnus-article-current) gnus-newsgroup-name))) - ;; Selected subject is different from current article's. - (gnus-summary-display-article article) - (gnus-summary-recenter) - (when article-window - (gnus-eval-in-buffer-window gnus-article-buffer - (setq endp (gnus-article-prev-page lines))) - (when (and move endp) - (cond (lines - (gnus-message 3 "Beginning of message")) - ((null lines) - (if (and (eq gnus-summary-goto-unread 'never) - (not (gnus-summary-first-article-p article))) - (gnus-summary-prev-article) - (gnus-summary-prev-unread-article)))))))) - (gnus-summary-position-point)) - -(defun gnus-summary-prev-page-or-article (&optional lines) - "Show previous page of selected article. -Argument LINES specifies lines to be scrolled down. -If at the beginning of the article, go to the next article." - (interactive "P") - (gnus-summary-prev-page lines t)) - -(defun gnus-summary-scroll-up (lines) - "Scroll up (or down) one line current article. -Argument LINES specifies lines to be scrolled up (or down if negative)." - (interactive "p") - (gnus-configure-windows 'article) - (gnus-summary-show-thread) - (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old) - (gnus-eval-in-buffer-window gnus-article-buffer - (cond ((> lines 0) - (when (gnus-article-next-page lines) - (gnus-message 3 "End of message"))) - ((< lines 0) - (gnus-article-prev-page (- lines)))))) - (gnus-summary-recenter) - (gnus-summary-position-point)) - -(defun gnus-summary-next-same-subject () - "Select next article which has the same subject as current one." - (interactive) - (gnus-summary-next-article nil (gnus-summary-article-subject))) - -(defun gnus-summary-prev-same-subject () - "Select previous article which has the same subject as current one." - (interactive) - (gnus-summary-prev-article nil (gnus-summary-article-subject))) - -(defun gnus-summary-next-unread-same-subject () - "Select next unread article which has the same subject as current one." - (interactive) - (gnus-summary-next-article t (gnus-summary-article-subject))) - -(defun gnus-summary-prev-unread-same-subject () - "Select previous unread article which has the same subject as current one." - (interactive) - (gnus-summary-prev-article t (gnus-summary-article-subject))) - -(defun gnus-summary-first-unread-article () - "Select the first unread article. -Return nil if there are no unread articles." - (interactive) - (prog1 - (when (gnus-summary-first-subject t) - (gnus-summary-show-thread) - (gnus-summary-first-subject t) - (gnus-summary-display-article (gnus-summary-article-number))) - (gnus-summary-position-point))) - -(defun gnus-summary-first-article () - "Select the first article. -Return nil if there are no articles." - (interactive) - (prog1 - (when (gnus-summary-first-subject) - (gnus-summary-show-thread) - (gnus-summary-first-subject) - (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." - (interactive) - (let ((best -1000000) - (data gnus-newsgroup-data) - article score) - (while data - (and (gnus-data-unread-p (car data)) - (> (setq score - (gnus-summary-article-score (gnus-data-number (car data)))) - best) - (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)))) - -(defun gnus-summary-last-subject () - "Go to the last displayed subject line in the group." - (let ((article (gnus-data-number (car (gnus-data-list t))))) - (when article - (gnus-summary-goto-subject article)))) - -(defun gnus-summary-goto-article (article &optional all-headers force) - "Fetch ARTICLE (article number or Message-ID) and display it if it exists. -If ALL-HEADERS is non-nil, no header lines are hidden." - (interactive - (list - (completing-read - "Article number or Message-ID: " - (mapcar (lambda (number) (list (int-to-string number))) - gnus-newsgroup-limit)) - current-prefix-arg - t)) - (prog1 - (if (and (stringp article) - (string-match "@" article)) - (gnus-summary-refer-article article) - (when (stringp article) - (setq article (string-to-number article))) - (if (gnus-summary-goto-subject article force) - (gnus-summary-display-article article all-headers) - (gnus-message 4 "Couldn't go to article %s" article) nil)) - (gnus-summary-position-point))) - -(defun gnus-summary-goto-last-article () - "Go to the previously read article." - (interactive) - (prog1 - (when gnus-last-article - (gnus-summary-goto-article gnus-last-article nil t)) - (gnus-summary-position-point))) - -(defun gnus-summary-pop-article (number) - "Pop one article off the history and go to the previous. -NUMBER articles will be popped off." - (interactive "p") - (let (to) - (setq gnus-newsgroup-history - (cdr (setq to (nthcdr number gnus-newsgroup-history)))) - (if to - (gnus-summary-goto-article (car to) nil t) - (error "Article history empty"))) - (gnus-summary-position-point)) - -;; Summary commands and functions for limiting the summary buffer. - -(defun gnus-summary-limit-to-articles (n) - "Limit the summary buffer to the next N articles. -If not given a prefix, use the process marked articles instead." - (interactive "P") - (prog1 - (let ((articles (gnus-summary-work-articles n))) - (setq gnus-newsgroup-processable nil) - (gnus-summary-limit articles)) - (gnus-summary-position-point))) - -(defun gnus-summary-pop-limit (&optional total) - "Restore the previous limit. -If given a prefix, remove all limits." - (interactive "P") - (when total - (setq gnus-newsgroup-limits - (list (mapcar (lambda (h) (mail-header-number h)) - gnus-newsgroup-headers)))) - (unless gnus-newsgroup-limits - (error "No limit to pop")) - (prog1 - (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): ") - (unless header - (setq header "subject")) - (when (not (equal "" subject)) - (prog1 - (let ((articles (gnus-summary-find-matching - (or header "subject") subject 'all))) - (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-age (age &optional younger-p) - "Limit the summary buffer to articles that are older than (or equal) AGE days. -If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to -articles that are younger than AGE days." - (interactive "nTime in days: \nP") - (prog1 - (let ((data gnus-newsgroup-data) - (cutoff (nnmail-days-to-time age)) - articles d date is-younger) - (while (setq d (pop data)) - (when (and (vectorp (gnus-data-header d)) - (setq date (mail-header-date (gnus-data-header d)))) - (setq is-younger (nnmail-time-less - (nnmail-time-since (nnmail-date-to-time date)) - cutoff)) - (when (if younger-p is-younger (not is-younger)) - (push (gnus-data-number d) articles)))) - (gnus-summary-limit (nreverse 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) - -(defun gnus-summary-limit-to-unread (&optional all) - "Limit the summary buffer to articles that are not marked as read. -If ALL is non-nil, limit strictly to unread articles." - (interactive "P") - (if all - (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark)) - (gnus-summary-limit-to-marks - ;; 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-low-score-mark gnus-expirable-mark - gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark - gnus-duplicate-mark gnus-souped-mark) - 'reverse))) - -(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks) -(make-obsolete 'gnus-summary-delete-marked-with - 'gnus-summary-limit-exlude-marks) - -(defun gnus-summary-limit-exclude-marks (marks &optional reverse) - "Exclude articles that are marked with MARKS (e.g. \"DK\"). -If REVERSE, limit the summary buffer to articles that are marked -with MARKS. MARKS can either be a string of marks or a list of marks. -Returns how many articles were removed." - (interactive "sMarks: ") - (gnus-summary-limit-to-marks marks t)) - -(defun gnus-summary-limit-to-marks (marks &optional reverse) - "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\"). -If REVERSE (the prefix), limit the summary buffer to articles that are -not marked with MARKS. MARKS can either be a string of marks or a -list of marks. -Returns how many articles were removed." - (interactive "sMarks: \nP") - (prog1 - (let ((data gnus-newsgroup-data) - (marks (if (listp marks) marks - (append marks nil))) ; Transform to list. - articles) - (while data - (when (if reverse (not (memq (gnus-data-mark (car data)) marks)) - (memq (gnus-data-mark (car data)) marks)) - (push (gnus-data-number (car data)) articles)) - (setq data (cdr data))) - (gnus-summary-limit articles)) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-to-score (&optional 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))) - (let ((data gnus-newsgroup-data) - articles) - (while data - (when (>= (gnus-summary-article-score (gnus-data-number (car data))) - score) - (push (gnus-data-number (car data)) articles)) - (setq data (cdr data))) - (prog1 - (gnus-summary-limit articles) - (gnus-summary-position-point)))) - -(defun gnus-summary-limit-include-thread (id) - "Display all the hidden articles that in the current thread." - (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-position-point)))) - -(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 -fetched for this group." - (interactive) - (unless gnus-newsgroup-dormant - (error "There are no dormant articles in this group")) - (prog1 - (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit)) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-exclude-dormant () - "Hide all dormant articles." - (interactive) - (prog1 - (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-exclude-childless-dormant () - "Hide all dormant articles that have no children." - (interactive) - (let ((data (gnus-data-list t)) - articles d children) - ;; Find all articles that are either not dormant or have - ;; children. - (while (setq d (pop data)) - (when (or (not (= (gnus-data-mark d) gnus-dormant-mark)) - (and (setq children - (gnus-article-children (gnus-data-number d))) - (let (found) - (while children - (when (memq (car children) articles) - (setq children nil - found t)) - (pop children)) - found))) - (push (gnus-data-number d) articles))) - ;; Do the limiting. - (prog1 - (gnus-summary-limit articles) - (gnus-summary-position-point)))) - -(defun gnus-summary-limit-mark-excluded-as-read (&optional all) - "Mark all unread excluded articles as read. -If ALL, mark even excluded ticked and dormants as read." - (interactive "P") - (let ((articles (gnus-sorted-complement - (sort - (mapcar (lambda (h) (mail-header-number h)) - gnus-newsgroup-headers) - '<) - (sort gnus-newsgroup-limit '<))) - article) - (setq gnus-newsgroup-unreads gnus-newsgroup-limit) - (if all - (setq gnus-newsgroup-dormant nil - gnus-newsgroup-marked nil - gnus-newsgroup-reads - (nconc - (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles) - gnus-newsgroup-reads)) - (while (setq article (pop articles)) - (unless (or (memq article gnus-newsgroup-dormant) - (memq article gnus-newsgroup-marked)) - (push (cons article gnus-catchup-mark) gnus-newsgroup-reads)))))) - -(defun gnus-summary-limit (articles &optional pop) - (if pop - ;; We pop the previous limit off the stack and use that. - (setq articles (car gnus-newsgroup-limits) - gnus-newsgroup-limits (cdr gnus-newsgroup-limits)) - ;; We use the new limit, so we push the old limit on the stack. - (push gnus-newsgroup-limit gnus-newsgroup-limits)) - ;; Set the limit. - (setq gnus-newsgroup-limit articles) - (let ((total (length gnus-newsgroup-data)) - (data (gnus-data-find-list (gnus-summary-article-number))) - (gnus-summary-mark-below nil) ; Inhibit this. - found) - ;; This will do all the work of generating the new summary buffer - ;; 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)) - ;; Try to return to the article you were at, or one in the - ;; neighborhood. - (when data - ;; We try to find some article after the current one. - (while data - (when (gnus-summary-goto-subject (gnus-data-number (car data)) nil t) - (setq data nil - found t)) - (setq data (cdr data)))) - (unless found - ;; If there is no data, that means that we were after the last - ;; article. The same goes when we can't find any articles - ;; after the current one. - (goto-char (point-max)) - (gnus-summary-find-prev)) - ;; We return how many articles were removed from the summary - ;; buffer as a result of the new limit. - (- total (length gnus-newsgroup-data)))) - -(defsubst gnus-invisible-cut-children (threads) - (let ((num 0)) - (while threads - (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit) - (incf num)) - (pop threads)) - (< num 2))) - -(defsubst gnus-cut-thread (thread) - "Go forwards in the thread until we find an article that we want to display." - (when (or (eq gnus-fetch-old-headers 'some) - (eq gnus-fetch-old-headers 'invisible) - (eq gnus-build-sparse-threads 'some) - (eq gnus-build-sparse-threads 'more)) - ;; Deal with old-fetched headers and sparse threads. - (while (and - thread - (or - (gnus-summary-article-sparse-p (mail-header-number (car thread))) - (gnus-summary-article-ancient-p - (mail-header-number (car thread)))) - (if (or (<= (length (cdr thread)) 1) - (eq gnus-fetch-old-headers 'invisible)) - (setq gnus-newsgroup-limit - (delq (mail-header-number (car thread)) - gnus-newsgroup-limit) - thread (cadr thread)) - (when (gnus-invisible-cut-children (cdr thread)) - (let ((th (cdr thread))) - (while th - (if (memq (mail-header-number (caar th)) - gnus-newsgroup-limit) - (setq thread (car th) - th nil) - (setq th (cdr th)))))))))) - thread) - -(defun gnus-cut-threads (threads) - "Cut off all uninteresting articles from the beginning of threads." - (when (or (eq gnus-fetch-old-headers 'some) - (eq gnus-fetch-old-headers 'invisible) - (eq gnus-build-sparse-threads 'some) - (eq gnus-build-sparse-threads 'more)) - (let ((th threads)) - (while th - (setcar th (gnus-cut-thread (car th))) - (setq th (cdr th))))) - ;; Remove nixed out threads. - (delq nil threads)) - -(defun gnus-summary-initial-limit (&optional show-if-empty) - "Figure out what the initial limit is supposed to be on group entry. -This entails weeding out unwanted dormants, low-scored articles, -fetch-old-headers verbiage, and so on." - ;; Most groups have nothing to remove. - (if (or gnus-inhibit-limiting - (and (null gnus-newsgroup-dormant) - (not (eq gnus-fetch-old-headers 'some)) - (not (eq gnus-fetch-old-headers 'invisible)) - (null gnus-summary-expunge-below) - (not (eq gnus-build-sparse-threads 'some)) - (not (eq gnus-build-sparse-threads 'more)) - (null gnus-thread-expunge-below) - (not gnus-use-nocem))) - () ; Do nothing. - (push gnus-newsgroup-limit gnus-newsgroup-limits) - (setq gnus-newsgroup-limit nil) - (mapatoms - (lambda (node) - (unless (car (symbol-value node)) - ;; These threads have no parents -- they are roots. - (let ((nodes (cdr (symbol-value node))) - thread) - (while nodes - (if (and gnus-thread-expunge-below - (< (gnus-thread-total-score (car nodes)) - gnus-thread-expunge-below)) - (gnus-expunge-thread (pop nodes)) - (setq thread (pop nodes)) - (gnus-summary-limit-children thread)))))) - gnus-newsgroup-dependencies) - ;; If this limitation resulted in an empty group, we might - ;; pop the previous limit and use it instead. - (when (and (not gnus-newsgroup-limit) - show-if-empty) - (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits))) - gnus-newsgroup-limit)) - -(defun gnus-summary-limit-children (thread) - "Return 1 if this subthread is visible and 0 if it is not." - ;; First we get the number of visible children to this thread. This - ;; is done by recursing down the thread using this function, so this - ;; will really go down to a leaf article first, before slowly - ;; working its way up towards the root. - (when thread - (let ((children - (if (cdr thread) - (apply '+ (mapcar 'gnus-summary-limit-children - (cdr thread))) - 0)) - (number (mail-header-number (car thread))) - score) - (if (and - (not (memq number gnus-newsgroup-marked)) - (or - ;; If this article is dormant and has absolutely no visible - ;; children, then this article isn't visible. - (and (memq number gnus-newsgroup-dormant) - (zerop children)) - ;; If this is "fetch-old-headered" and there is no - ;; visible children, then we don't want this article. - (and (eq gnus-fetch-old-headers 'some) - (gnus-summary-article-ancient-p number) - (zerop children)) - ;; If this is "fetch-old-headered" and `invisible', then - ;; we don't want this article. - (and (eq gnus-fetch-old-headers 'invisible) - (gnus-summary-article-ancient-p number)) - ;; If this is a sparsely inserted article with no children, - ;; we don't want it. - (and (eq gnus-build-sparse-threads 'some) - (gnus-summary-article-sparse-p number) - (zerop children)) - ;; If we use expunging, and this article is really - ;; low-scored, then we don't want this article. - (when (and gnus-summary-expunge-below - (< (setq score - (or (cdr (assq number gnus-newsgroup-scored)) - gnus-summary-default-score)) - gnus-summary-expunge-below)) - ;; We increase the expunge-tally here, but that has - ;; nothing to do with the limits, really. - (incf gnus-newsgroup-expunged-tally) - ;; We also mark as read here, if that's wanted. - (when (and gnus-summary-mark-below - (< score gnus-summary-mark-below)) - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads))) - t) - ;; Check NoCeM things. - (if (and gnus-use-nocem - (gnus-nocem-unwanted-article-p - (mail-header-id (car thread)))) - (progn - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - t)))) - ;; Nope, invisible article. - 0 - ;; Ok, this article is to be visible, so we add it to the limit - ;; and return 1. - (push number gnus-newsgroup-limit) - 1)))) - -(defun gnus-expunge-thread (thread) - "Mark all articles in THREAD as read." - (let* ((number (mail-header-number (car thread)))) - (incf gnus-newsgroup-expunged-tally) - ;; We also mark as read here, if that's wanted. - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads))) - ;; Go recursively through all subthreads. - (mapcar 'gnus-expunge-thread (cdr thread))) - -;; Summary article oriented commands - -(defun gnus-summary-refer-parent-article (n) - "Refer parent article N times. -If N is negative, go to ancestor -N instead. -The difference between N and the number of articles fetched is returned." - (interactive "p") - (let ((skip 1) - error header ref) - (when (not (natnump n)) - (setq skip (abs n) - n 1)) - (while (and (> n 0) - (not error)) - (setq header (gnus-summary-article-header)) - (if (and (eq (mail-header-number header) - (cdr gnus-article-current)) - (equal gnus-newsgroup-name - (car gnus-article-current))) - ;; If we try to find the parent of the currently - ;; displayed article, then we take a look at the actual - ;; References header, since this is slightly more - ;; reliable than the References field we got from the - ;; server. - (save-excursion - (set-buffer gnus-original-article-buffer) - (nnheader-narrow-to-headers) - (unless (setq ref (message-fetch-field "references")) - (setq ref (message-fetch-field "in-reply-to"))) - (widen)) - (setq ref - ;; It's not the current article, so we take a bet on - ;; the value we got from the server. - (mail-header-references header))) - (if (and ref - (not (equal ref ""))) - (unless (gnus-summary-refer-article (gnus-parent-id ref skip)) - (gnus-message 1 "Couldn't find parent")) - (gnus-message 1 "No references in article %d" - (gnus-summary-article-number)) - (setq error t)) - (decf n)) - (gnus-summary-position-point) - n)) - -(defun gnus-summary-refer-references () - "Fetch all articles mentioned in the References header. -Return the number of articles fetched." - (interactive) - (let ((ref (mail-header-references (gnus-summary-article-header))) - (current (gnus-summary-article-number)) - (n 0)) - (if (or (not ref) - (equal ref "")) - (error "No References in the current article") - ;; For each Message-ID in the References header... - (while (string-match "<[^>]*>" ref) - (incf n) - ;; ... fetch that article. - (gnus-summary-refer-article - (prog1 (match-string 0 ref) - (setq ref (substring ref (match-end 0)))))) - (gnus-summary-goto-subject current) - (gnus-summary-position-point) - n))) - -(defun gnus-summary-refer-thread (&optional limit) - "Fetch all articles in the current thread. -If LIMIT (the numerical prefix), fetch that many old headers instead -of what's specified by the `gnus-refer-thread-limit' variable." - (interactive "P") - (let ((id (mail-header-id (gnus-summary-article-header))) - (limit (if limit (prefix-numeric-value limit) - gnus-refer-thread-limit)) - fmethod root) - ;; 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) - 'nov) - (gnus-build-all-threads) - (error "Can't fetch thread from backends that don't support NOV")) - (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)) - (gnus-summary-limit-include-thread id))) - -(defun gnus-summary-refer-article (message-id &optional arg) - "Fetch an article specified by MESSAGE-ID. -If ARG (the prefix), fetch the article using `gnus-refer-article-method' -or `gnus-select-method', no matter what backend the article comes from." - (interactive "sMessage-ID: \nP") - (when (and (stringp message-id) - (not (zerop (length message-id)))) - ;; Construct the correct Message-ID if necessary. - ;; Suggested by tale@pawl.rpi.edu. - (unless (string-match "^<" message-id) - (setq message-id (concat "<" message-id))) - (unless (string-match ">$" message-id) - (setq message-id (concat message-id ">"))) - (let* ((header (gnus-id-to-header message-id)) - (sparse (and header - (gnus-summary-article-sparse-p - (mail-header-number header)) - (memq (mail-header-number header) - gnus-newsgroup-limit))) - h) - (cond - ;; If the article is present in the buffer we just go to it. - ((and header - (or (not (gnus-summary-article-sparse-p - (mail-header-number header))) - sparse)) - (prog1 - (gnus-summary-goto-article - (mail-header-number header) nil t) - (when sparse - (gnus-summary-update-article (mail-header-number header))))) - (t - ;; We fetch the article - (let ((gnus-override-method - (cond ((gnus-news-group-p gnus-newsgroup-name) - gnus-refer-article-method) - (arg - (or gnus-refer-article-method gnus-select-method)) - (t nil))) - number) - ;; Start the special refer-article method, if necessary. - (when (and gnus-refer-article-method - (gnus-news-group-p gnus-newsgroup-name)) - (gnus-check-server gnus-refer-article-method)) - ;; Fetch the header, and display the article. - (if (setq number (gnus-summary-insert-subject message-id)) - (gnus-summary-select-article nil nil nil number) - (gnus-message 3 "Couldn't fetch article %s" message-id)))))))) - -(defun gnus-summary-edit-parameters () - "Edit the group parameters of the current group." - (gnus-group-edit-group gnus-newsgroup-name 'params)) - -(defun gnus-summary-enter-digest-group (&optional force) - "Enter an nndoc group based on the current article. -If FORCE, force a digest interpretation. If not, try -to guess what the document format is." - (interactive "P") - (let ((conf gnus-current-window-configuration)) - (save-excursion - (gnus-summary-select-article)) - (setq gnus-current-window-configuration conf) - (let* ((name (format "%s-%d" - (gnus-group-prefixed-name - gnus-newsgroup-name (list 'nndoc "")) - (save-excursion - (set-buffer gnus-summary-buffer) - gnus-current-article))) - (ogroup gnus-newsgroup-name) - (params (append (gnus-info-params (gnus-get-info ogroup)) - (list (cons 'to-group ogroup)) - (list (cons 'save-article-group ogroup)))) - (case-fold-search t) - (buf (current-buffer)) - dig) - (save-excursion - (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) - (insert-buffer-substring gnus-original-article-buffer) - ;; Remove lines that may lead nndoc to misinterpret the - ;; document type. - (narrow-to-region - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point))) - (goto-char (point-min)) - (delete-matching-lines "^\\(Path\\):\\|^From ") - (widen)) - (unwind-protect - (if (gnus-group-read-ephemeral-group - name `(nndoc ,name (nndoc-address ,(get-buffer dig)) - (nndoc-article-type - ,(if force 'digest 'guess))) t) - ;; 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?")) - (kill-buffer dig))))) - -(defun gnus-summary-read-document (n) - "Open a new group based on the current article(s). -This will allow you to read digests and other similar -documents as newsgroups. -Obeys the standard process/prefix convention." - (interactive "P") - (let* ((articles (gnus-summary-work-articles n)) - (ogroup gnus-newsgroup-name) - (params (append (gnus-info-params (gnus-get-info ogroup)) - (list (cons 'to-group ogroup)))) - article group egroup groups vgroup) - (while (setq article (pop articles)) - (setq group (format "%s-%d" gnus-newsgroup-name article)) - (gnus-summary-remove-process-mark article) - (when (gnus-summary-display-article article) - (save-excursion - (nnheader-temp-write nil - (insert-buffer-substring gnus-original-article-buffer) - ;; Remove some headers that may lead nndoc to make - ;; the wrong guess. - (message-narrow-to-head) - (goto-char (point-min)) - (delete-matching-lines "^\\(Path\\):\\|^From ") - (widen) - (if (setq egroup - (gnus-group-read-ephemeral-group - group `(nndoc ,group (nndoc-address ,(current-buffer)) - (nndoc-article-type guess)) - t nil t)) - (progn - ;; Make all postings to this group go to the parent group. - (nconc (gnus-info-params (gnus-get-info egroup)) - params) - (push egroup groups)) - ;; Couldn't select this doc group. - (gnus-error 3 "Article couldn't be entered")))))) - ;; Now we have selected all the documents. - (cond - ((not groups) - (error "None of the articles could be interpreted as documents")) - ((gnus-group-read-ephemeral-group - (setq vgroup (format - "nnvirtual:%s-%s" gnus-newsgroup-name - (format-time-string "%Y%m%dT%H%M%S" (current-time)))) - `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups)) - t - (cons (current-buffer) 'summary))) - (t - (error "Couldn't select virtual nndoc group"))))) - -(defun gnus-summary-isearch-article (&optional regexp-p) - "Do incremental search forward on the current article. -If REGEXP-P (the prefix) is non-nil, do regexp isearch." - (interactive "P") - (gnus-summary-select-article) - (gnus-configure-windows 'article) - (gnus-eval-in-buffer-window gnus-article-buffer - (save-restriction - (widen) - (isearch-forward regexp-p)))) - -(defun gnus-summary-search-article-forward (regexp &optional backward) - "Search for an article containing REGEXP forward. -If BACKWARD, search backward instead." - (interactive - (list (read-string - (format "Search article %s (regexp%s): " - (if current-prefix-arg "backward" "forward") - (if gnus-last-search-regexp - (concat ", default " gnus-last-search-regexp) - ""))) - 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))) - -(defun gnus-summary-search-article-backward (regexp) - "Search for an article containing REGEXP backward." - (interactive - (list (read-string - (format "Search article backward (regexp%s): " - (if gnus-last-search-regexp - (concat ", default " gnus-last-search-regexp) - ""))))) - (gnus-summary-search-article-forward regexp 'backward)) - -(defun gnus-summary-search-article (regexp &optional backward) - "Search for an article containing REGEXP. -Optional argument BACKWARD means do search for backward. -`gnus-select-article-hook' is not called during the search." - ;; We have to require this here to make sure that the following - ;; dynamic binding isn't shadowed by autoloading. - (require 'gnus-async) - (let ((gnus-select-article-hook nil) ;Disable hook. - (gnus-article-display-hook nil) - (gnus-mark-article-hook nil) ;Inhibit marking as read. - (gnus-use-article-prefetch nil) - (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay. - (gnus-use-trees nil) ;Inhibit updating tree buffer. - (sum (current-buffer)) - (found nil) - point) - (gnus-save-hidden-threads - (gnus-summary-select-article) - (set-buffer gnus-article-buffer) - (when backward - (forward-line -1)) - (while (not found) - (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current)) - (if (if backward - (re-search-backward regexp nil t) - (re-search-forward regexp nil t)) - ;; We found the regexp. - (progn - (setq found 'found) - (beginning-of-line) - (set-window-start - (get-buffer-window (current-buffer)) - (point)) - (forward-line 1) - (set-buffer sum) - (setq point (point))) - ;; We didn't find it, so we go to the next article. - (set-buffer sum) - (setq found 'not) - (while (eq found 'not) - (if (not (if backward (gnus-summary-find-prev) - (gnus-summary-find-next))) - ;; No more articles. - (setq found t) - ;; Select the next article and adjust point. - (unless (gnus-summary-article-sparse-p - (gnus-summary-article-number)) - (setq found nil) - (gnus-summary-select-article) - (set-buffer gnus-article-buffer) - (widen) - (goto-char (if backward (point-max) (point-min)))))))) - (gnus-message 7 "")) - ;; Return whether we found the regexp. - (when (eq found 'found) - (goto-char point) - (gnus-summary-show-thread) - (gnus-summary-goto-subject gnus-current-article) - (gnus-summary-position-point) - t))) - -(defun gnus-summary-find-matching (header regexp &optional backward unread - not-case-fold) - "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)))) - (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) - (case-fold-search (not not-case-fold)) - articles d) - (unless (fboundp (intern (concat "mail-header-" header))) - (error "%s is not a valid header" header)) - (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))) - (nreverse articles))) - -(defun gnus-summary-execute-command (header regexp command &optional backward) - "Search forward for an article whose HEADER matches REGEXP and execute COMMAND. -If HEADER is an empty string (or nil), the match is done on the entire -article. If BACKWARD (the prefix) is non-nil, search backward instead." - (interactive - (list (let ((completion-ignore-case t)) - (completing-read - "Header name: " - (mapcar (lambda (string) (list string)) - '("Number" "Subject" "From" "Lines" "Date" - "Message-ID" "Xref" "References" "Body")) - nil 'require-match)) - (read-string "Regexp: ") - (read-key-sequence "Command: ") - current-prefix-arg)) - (when (equal header "Body") - (setq header "")) - ;; Hidden thread subtrees must be searched as well. - (gnus-summary-show-all-threads) - ;; 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))))) - -(defun gnus-summary-beginning-of-article () - "Scroll the article back to the beginning." - (interactive) - (gnus-summary-select-article) - (gnus-configure-windows 'article) - (gnus-eval-in-buffer-window gnus-article-buffer - (widen) - (goto-char (point-min)) - (when gnus-page-broken - (gnus-narrow-to-page)))) - -(defun gnus-summary-end-of-article () - "Scroll to the end of the article." - (interactive) - (gnus-summary-select-article) - (gnus-configure-windows 'article) - (gnus-eval-in-buffer-window gnus-article-buffer - (widen) - (goto-char (point-max)) - (recenter -3) - (when gnus-page-broken - (gnus-narrow-to-page)))) - -(defun gnus-summary-print-article (&optional filename n) - "Generate and print a PostScript image of the N next (mail) articles. - -If N is negative, print the N previous articles. If N is nil and articles -have been marked with the process mark, print these instead. - -If the optional second 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)) - (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) - (ps-print-buffer-with-faces filename))) - (kill-buffer buffer)))))) - -(defun gnus-summary-show-article (&optional arg) - "Force re-fetching of the current article. -If ARG (the prefix) is non-nil, show the raw article without any -article massaging functions being run." - (interactive "P") - (if (not arg) - ;; Select the article the normal way. - (gnus-summary-select-article nil 'force) - ;; Bind the article treatment functions to nil. - (let ((gnus-have-all-headers t) - gnus-article-display-hook - gnus-article-prepare-hook - gnus-break-pages - gnus-show-mime - gnus-visual) - (gnus-summary-select-article nil 'force))) - (gnus-summary-goto-subject gnus-current-article) - (gnus-summary-position-point)) - -(defun gnus-summary-verbose-headers (&optional arg) - "Toggle permanent full header display. -If ARG is a positive number, turn header display on. -If ARG is a negative number, turn header display off." - (interactive "P") - (setq gnus-show-all-headers - (cond ((or (not (numberp arg)) - (zerop arg)) - (not gnus-show-all-headers)) - ((natnump arg) - t))) - (gnus-summary-show-article)) - -(defun gnus-summary-toggle-header (&optional arg) - "Show the headers if they are hidden, or hide them if they are shown. -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) - (let* ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (hidden (text-property-any - (goto-char (point-min)) (search-forward "\n\n") - 'invisible t)) - e) - (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) - (let ((article-inhibit-hiding t)) - (gnus-run-hooks 'gnus-article-display-hook)) - (when (or (not hidden) (and (numberp arg) (< arg 0))) - (gnus-article-hide-headers))))) - -(defun gnus-summary-show-all-headers () - "Make all header lines visible." - (interactive) - (gnus-article-show-all-headers)) - -(defun gnus-summary-toggle-mime (&optional arg) - "Toggle MIME processing. -If ARG is a positive number, turn MIME processing on." - (interactive "P") - (setq gnus-show-mime - (if (null arg) (not gnus-show-mime) - (> (prefix-numeric-value arg) 0))) - (gnus-summary-select-article t 'force)) - -(defun gnus-summary-caesar-message (&optional arg) - "Caesar rotate the current article by 13. -The numerical prefix specifies how many places to rotate each letter -forward." - (interactive "P") - (gnus-summary-select-article) - (let ((mail-header-separator "")) - (gnus-eval-in-buffer-window gnus-article-buffer - (save-restriction - (widen) - (let ((start (window-start)) - buffer-read-only) - (message-caesar-buffer-body arg) - (set-window-start (get-buffer-window (current-buffer)) start)))))) - -(defun gnus-summary-stop-page-breaking () - "Stop page breaking in the current article." - (interactive) - (gnus-summary-select-article) - (gnus-eval-in-buffer-window gnus-article-buffer - (widen) - (when (gnus-visual-p 'page-marker) - (let ((buffer-read-only nil)) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next))))) - -(defun gnus-summary-move-article (&optional n to-newsgroup - select-method action) - "Move the current article to a different newsgroup. -If N is a positive number, move the N next articles. -If N is a negative number, move the N previous articles. -If N is nil and any articles have been marked with the process mark, -move those articles instead. -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. - -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." - (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 - 'request-move-article gnus-newsgroup-name))) - (error "The current group does not support article moving")) - ((and (eq action 'crosspost) - (not (gnus-check-backend-function - 'request-replace-article gnus-newsgroup-name))) - (error "The current group does not support article editing"))) - (let ((articles (gnus-summary-work-articles n)) - (prefix (gnus-group-real-prefix gnus-newsgroup-name)) - (names '((move "Move" "Moving") - (copy "Copy" "Copying") - (crosspost "Crosspost" "Crossposting"))) - (copy-buf (save-excursion - (nnheader-set-temp-buffer " *copy article*"))) - art-group to-method new-xref article to-groups) - (unless (assq action names) - (error "Unknown action %s" action)) - ;; Read the newsgroup name. - (when (and (not to-newsgroup) - (not select-method)) - (setq to-newsgroup - (gnus-read-move-group-name - (cadr (assq action names)) - (symbol-value (intern (format "gnus-current-%s-group" action))) - articles prefix)) - (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) - (setq to-method (or select-method - (gnus-group-name-to-method to-newsgroup))) - ;; Check the method we are to move this article to... - (unless (gnus-check-backend-function - 'request-accept-article (car to-method)) - (error "%s does not support article copying" (car to-method))) - (unless (gnus-check-server to-method) - (error "Can't open server %s" (car to-method))) - (gnus-message 6 "%s to %s: %s..." - (caddr (assq action names)) - (or (car select-method) to-newsgroup) articles) - (while articles - (setq article (pop articles)) - (setq - art-group - (cond - ;; Move the article. - ((eq action 'move) - ;; Remove this article from future suppression. - (gnus-dup-unsuppress-article article) - (gnus-request-move-article - article ; Article to move - gnus-newsgroup-name ; From newsgroup - (nth 1 (gnus-find-method-for-group - gnus-newsgroup-name)) ; Server - (list 'gnus-request-accept-article - to-newsgroup (list 'quote select-method) - (not articles)) ; Accept form - (not articles))) ; Only save nov last time - ;; Copy the article. - ((eq action 'copy) - (save-excursion - (set-buffer copy-buf) - (when (gnus-request-article-this-buffer article gnus-newsgroup-name) - (gnus-request-accept-article - to-newsgroup select-method (not articles))))) - ;; Crosspost the article. - ((eq action 'crosspost) - (let ((xref (message-tokenize-header - (mail-header-xref (gnus-summary-article-header article)) - " "))) - (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name) - ":" article)) - (unless xref - (setq xref (list (system-name)))) - (setq new-xref - (concat - (mapconcat 'identity - (delete "Xref:" (delete new-xref xref)) - " ") - " " new-xref)) - (save-excursion - (set-buffer copy-buf) - ;; First put the article in the destination group. - (gnus-request-article-this-buffer article gnus-newsgroup-name) - (when (consp (setq art-group - (gnus-request-accept-article - to-newsgroup select-method (not articles)))) - (setq new-xref (concat new-xref " " (car art-group) - ":" (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) - (gnus-request-replace-article - (cdr art-group) to-newsgroup (current-buffer)) - art-group)))))) - (cond - ((not art-group) - (gnus-message 1 "Couldn't %s article %s" - (cadr (assq action names)) article)) - ((and (eq art-group 'junk) - (eq action 'move)) - (gnus-summary-mark-article article gnus-canceled-mark) - (gnus-message 4 "Deleted article %s" article)) - (t - (let* ((entry - (or - (gnus-gethash (car art-group) gnus-newsrc-hashtb) - (gnus-gethash - (gnus-group-prefixed-name - (car art-group) - (or select-method - (gnus-find-method-for-group to-newsgroup))) - gnus-newsrc-hashtb))) - (info (nth 2 entry)) - (to-group (gnus-info-group info))) - ;; Update the group that has been moved to. - (when (and info - (memq action '(move copy))) - (unless (member to-group to-groups) - (push to-group to-groups)) - - (unless (memq article gnus-newsgroup-unreads) - (gnus-info-set-read - info (gnus-add-to-range (gnus-info-read info) - (list (cdr art-group))))) - - ;; Copy any marks over to the new group. - (let ((marks gnus-article-mark-lists) - (to-article (cdr art-group))) - - ;; See whether the article is to be put in the cache. - (when gnus-use-cache - (gnus-cache-possibly-enter-article - to-group to-article - (let ((header (copy-sequence - (gnus-summary-article-header article)))) - (mail-header-set-number header to-article) - header) - (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (memq article gnus-newsgroup-unreads))) - - (when (and (equal to-group gnus-newsgroup-name) - (not (memq article gnus-newsgroup-unreads))) - ;; Mark this article as read in this group. - (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) - (setcdr (gnus-active to-group) to-article) - (setcdr gnus-newsgroup-active to-article)) - - (while marks - (when (memq article (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))) - ;; 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-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (gnus-get-info to-group)) - ")")))) - - ;; Update the Xref header in this article to point to - ;; the new crossposted article we have just created. - (when (eq action 'crosspost) - (save-excursion - (set-buffer copy-buf) - (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))))) - - ;;;!!!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))) - - (gnus-kill-buffer copy-buf) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary))) - -(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. -If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but -re-spool using this method." - (interactive "P") - (gnus-summary-move-article n to-newsgroup select-method 'copy)) - -(defun gnus-summary-crosspost-article (&optional n) - "Crosspost the current article to some other group." - (interactive "P") - (gnus-summary-move-article n nil nil 'crosspost)) - -(defcustom gnus-summary-respool-default-method nil - "*Default method for respooling an article. -If nil, use to the current newsgroup method." - :type `(choice (gnus-select-method :value (nnml "")) - (const nil)) - :group 'gnus-summary-mail) - -(defun gnus-summary-respool-article (&optional n method) - "Respool the current article. -The article will be squeezed through the mail spooling process again, -which means that it will be put in some mail newsgroup or other -depending on `nnmail-split-methods'. -If N is a positive number, respool the N next articles. -If N is a negative number, respool the N previous articles. -If N is nil and any articles have been marked with the process mark, -respool those articles instead. - -Respooling can be done both from mail groups and \"real\" newsgroups. -In the former case, the articles in question will be moved from the -current group into whatever groups they are destined to. In the -latter case, they will be copied into the relevant groups." - (interactive - (list current-prefix-arg - (let* ((methods (gnus-methods-using 'respool)) - (methname - (symbol-name (or gnus-summary-respool-default-method - (car (gnus-find-method-for-group - gnus-newsgroup-name))))) - (method - (gnus-completing-read - methname "What backend do you want to use when respooling?" - methods nil t nil 'gnus-mail-method-history)) - ms) - (cond - ((zerop (length (setq ms (gnus-servers-using-backend - (intern method))))) - (list (intern method) "")) - ((= 1 (length ms)) - (car ms)) - (t - (let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms))) - (cdr (assoc (completing-read "Server name: " ms-alist nil t) - ms-alist)))))))) - (unless method - (error "No method given for respooling")) - (if (assoc (symbol-name - (car (gnus-find-method-for-group gnus-newsgroup-name))) - (gnus-methods-using 'respool)) - (gnus-summary-move-article n nil method) - (gnus-summary-copy-article n nil method))) - -(defun gnus-summary-import-article (file) - "Import a random file into a mail newsgroup." - (interactive "fImport file: ") - (let ((group gnus-newsgroup-name) - (now (current-time)) - atts lines) - (unless (gnus-check-backend-function 'request-accept-article group) - (error "%s does not support article importing" group)) - (or (file-readable-p file) - (not (file-regular-p file)) - (error "Can't read %s" file)) - (save-excursion - (set-buffer (get-buffer-create " *import file*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-file-contents file) - (goto-char (point-min)) - (unless (nnheader-article-p) - ;; 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: " (timezone-make-date-arpa-standard - (current-time-string (nth 5 atts)) - (current-time-zone now) - (current-time-zone now)) - "\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))))) - -(defun gnus-summary-article-posted-p () - "Say whether the current (mail) article is available from `gnus-select-method' as well. -This will be the case if the article has both been mailed and posted." - (interactive) - (let ((id (mail-header-references (gnus-summary-article-header))) - (gnus-override-method - (or gnus-refer-article-method gnus-select-method))) - (if (gnus-request-head id "") - (gnus-message 2 "The current message was found on %s" - gnus-override-method) - (gnus-message 2 "The current message couldn't be found on %s" - gnus-override-method) - nil))) - -(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) - ;; This backend supports expiry. - (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) - (expirable (if total - (progn - ;; We need to update the info for - ;; this group for `gnus-list-of-read-articles' - ;; to give us the right answer. - (gnus-run-hooks 'gnus-exit-group-hook) - (gnus-summary-update-info) - (gnus-list-of-read-articles gnus-newsgroup-name)) - (setq gnus-newsgroup-expirable - (sort gnus-newsgroup-expirable '<)))) - (expiry-wait (if now 'immediate - (gnus-group-find-parameter - gnus-newsgroup-name 'expiry-wait))) - es) - (when expirable - ;; There are expirable articles in this group, so we run them - ;; through the expiry process. - (gnus-message 6 "Expiring articles...") - ;; The list of articles that weren't expired is returned. - (save-excursion - (if expiry-wait - (let ((nnmail-expiry-wait-function nil) - (nnmail-expiry-wait expiry-wait)) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name))) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name)))) - (unless total - (setq gnus-newsgroup-expirable es)) - ;; We go through the old list of expirable, and mark all - ;; really expired articles as nonexistent. - (unless (eq es expirable) ;If nothing was expired, we don't mark. - (let ((gnus-use-cache nil)) - (while expirable - (unless (memq (car expirable) es) - (when (gnus-data-find (car expirable)) - (gnus-summary-mark-article - (car expirable) gnus-canceled-mark))) - (setq expirable (cdr expirable))))) - (gnus-message 6 "Expiring articles...done"))))) - -(defun gnus-summary-expire-articles-now () - "Expunge all expirable articles in the current group. -This means that *all* articles that are marked as expirable will be -deleted forever, right now." - (interactive) - (unless gnus-expert-user - (gnus-yes-or-no-p - "Are you really, really, really sure you want to delete all these messages? ") - (error "Phew!")) - (gnus-summary-expire-articles t)) - -;; Suggested by Jack Vinson . -(defun gnus-summary-delete-article (&optional n) - "Delete the N next (mail) articles. -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." - (interactive "P") - (unless (gnus-check-backend-function 'request-expire-articles - gnus-newsgroup-name) - (error "The current newsgroup does not support article deletion")) - ;; Compute the list of articles to delete. - (let ((articles (gnus-summary-work-articles n)) - not-deleted) - (if (and gnus-novice-user - (not (gnus-yes-or-no-p - (format "Do you really want to delete %s forever? " - (if (> (length articles) 1) - (format "these %s articles" (length articles)) - "this article"))))) - () - ;; Delete the articles. - (setq not-deleted (gnus-request-expire-articles - articles gnus-newsgroup-name 'force)) - (while articles - (gnus-summary-remove-process-mark (car articles)) - ;; The backend might not have been able to delete the article - ;; after all. - (unless (memq (car articles) not-deleted) - (gnus-summary-mark-article (car articles) gnus-canceled-mark)) - (setq articles (cdr articles))) - (when not-deleted - (gnus-message 4 "Couldn't delete articles %s" not-deleted))) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary) - not-deleted)) - -(defun gnus-summary-edit-article (&optional force) - "Edit the current article. -This will have permanent effect only in mail groups. -If FORCE is non-nil, allow editing of articles even in read-only -groups." - (interactive "P") - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-set-global-variables) - (when (and (not force) - (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing")) - ;; Select article if needed. - (unless (eq (gnus-summary-article-number) - gnus-current-article) - (gnus-summary-select-article t)) - (gnus-article-date-original) - (gnus-article-edit-article - `(lambda (no-highlight) - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))) - -(defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit) - -(defun gnus-summary-edit-article-done (&optional references read-only buffer - no-highlight) - "Make edits to the current article permanent." - (interactive) - ;; Replace the article. - (if (and (not read-only) - (not (gnus-request-replace-article - (cdr gnus-article-current) (car gnus-article-current) - (current-buffer)))) - (error "Couldn't replace article") - ;; Update the summary buffer. - (if (and references - (equal (message-tokenize-header references " ") - (message-tokenize-header - (or (message-fetch-field "references") "") " "))) - ;; We only have to update this line. - (save-excursion - (save-restriction - (message-narrow-to-head) - (let ((head (buffer-string)) - header) - (nnheader-temp-write nil - (insert (format "211 %d Article retrieved.\n" - (cdr gnus-article-current))) - (insert head) - (insert ".\n") - (let ((nntp-server-buffer (current-buffer))) - (setq header (car (gnus-get-newsgroup-headers - (save-excursion - (set-buffer gnus-summary-buffer) - gnus-newsgroup-dependencies) - 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)))))) - ;; Update threads. - (set-buffer (or buffer gnus-summary-buffer)) - (gnus-summary-update-article (cdr gnus-article-current))) - ;; Prettify the article buffer again. - (unless no-highlight - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-run-hooks 'gnus-article-display-hook) - (set-buffer gnus-original-article-buffer) - (gnus-request-article - (cdr gnus-article-current) - (car gnus-article-current) (current-buffer)))) - ;; Prettify the summary buffer line. - (when (gnus-visual-p 'summary-highlight 'highlight) - (gnus-run-hooks 'gnus-visual-mark-article-hook)))) - -(defun gnus-summary-edit-wash (key) - "Perform editing command in the article buffer." - (interactive - (list - (progn - (message "%s" (concat (this-command-keys) "- ")) - (read-char)))) - (message "") - (gnus-summary-edit-article) - (execute-kbd-macro (concat (this-command-keys) key)) - (gnus-article-edit-done)) - -;;; Respooling - -(defun gnus-summary-respool-query (&optional silent) - "Query where the respool algorithm would put this article." - (interactive) - (let (gnus-mark-article-hook) - (gnus-summary-select-article) - (save-excursion - (set-buffer gnus-original-article-buffer) - (save-restriction - (message-narrow-to-head) - (let ((groups (nnmail-article-group 'identity))) - (unless silent - (if groups - (message "This message would go to %s" - (mapconcat 'car groups ", ")) - (message "This message would go to no groups")) - groups)))))) - -;; Summary marking commands. - -(defun gnus-summary-kill-same-subject-and-select (&optional unmark) - "Mark articles which has the same subject as read, and then select the next. -If UNMARK is positive, remove any kind of mark. -If UNMARK is negative, tick articles." - (interactive "P") - (when unmark - (setq unmark (prefix-numeric-value unmark))) - (let ((count - (gnus-summary-mark-same-subject - (gnus-summary-article-subject) unmark))) - ;; Select next unread article. If auto-select-same mode, should - ;; select the first unread article. - (gnus-summary-next-article t (and gnus-auto-select-same - (gnus-summary-article-subject))) - (gnus-message 7 "%d article%s marked as %s" - count (if (= count 1) " is" "s are") - (if unmark "unread" "read")))) - -(defun gnus-summary-kill-same-subject (&optional unmark) - "Mark articles which has the same subject as read. -If UNMARK is positive, remove any kind of mark. -If UNMARK is negative, tick articles." - (interactive "P") - (when unmark - (setq unmark (prefix-numeric-value unmark))) - (let ((count - (gnus-summary-mark-same-subject - (gnus-summary-article-subject) unmark))) - ;; If marked as read, go to next unread subject. - (when (null unmark) - ;; Go to next unread subject. - (gnus-summary-next-subject 1 t)) - (gnus-message 7 "%d articles are marked as %s" - count (if unmark "unread" "read")))) - -(defun gnus-summary-mark-same-subject (subject &optional unmark) - "Mark articles with same SUBJECT as read, and return marked number. -If optional argument UNMARK is positive, remove any kinds of marks. -If optional argument UNMARK is negative, mark articles as unread instead." - (let ((count 1)) - (save-excursion - (cond - ((null unmark) ; Mark as read. - (while (and - (progn - (gnus-summary-mark-article-as-read gnus-killed-mark) - (gnus-summary-show-thread) t) - (gnus-summary-find-subject subject)) - (setq count (1+ count)))) - ((> unmark 0) ; Tick. - (while (and - (progn - (gnus-summary-mark-article-as-unread gnus-ticked-mark) - (gnus-summary-show-thread) t) - (gnus-summary-find-subject subject)) - (setq count (1+ count)))) - (t ; Mark as unread. - (while (and - (progn - (gnus-summary-mark-article-as-unread gnus-unread-mark) - (gnus-summary-show-thread) t) - (gnus-summary-find-subject subject)) - (setq count (1+ count))))) - (gnus-set-mode-line 'summary) - ;; Return the number of marked articles. - count))) - -(defun gnus-summary-mark-as-processable (n &optional unmark) - "Set the process mark on the next N articles. -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)) - -(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") - (gnus-summary-mark-as-processable n t)) - -(defun gnus-summary-unmark-all-processable () - "Remove the process mark from all articles." - (interactive) - (save-excursion - (while gnus-newsgroup-processable - (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) - (gnus-summary-position-point)) - -(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 -the actual number of articles marked is returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-expirable-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) - (gnus-summary-update-secondary-mark article)))) - -(defun gnus-summary-set-bookmark (article) - "Set a bookmark in current article." - (interactive (list (gnus-summary-article-number))) - (when (or (not (get-buffer gnus-article-buffer)) - (not gnus-current-article) - (not gnus-article-current) - (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)))) - ;; Set the new bookmark, which is on the form - ;; (article-number . line-number-in-body). - (push - (cons article - (save-excursion - (set-buffer gnus-article-buffer) - (count-lines - (min (point) - (save-excursion - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (point))) - (point)))) - gnus-newsgroup-bookmarks) - (gnus-message 6 "A bookmark has been added to the current article.")) - -(defun gnus-summary-remove-bookmark (article) - "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.")))) - -;; Suggested by Daniel Quinlan . -(defun gnus-summary-mark-as-dormant (n) - "Mark N articles forward as dormant. -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-dormant-mark)) - -(defun gnus-summary-set-process-mark (article) - "Set the process mark on ARTICLE and update the summary line." - (setq gnus-newsgroup-processable - (cons article - (delq article gnus-newsgroup-processable))) - (when (gnus-summary-goto-subject article) - (gnus-summary-show-thread) - (gnus-summary-update-secondary-mark article))) - -(defun gnus-summary-remove-process-mark (article) - "Remove the process mark from ARTICLE and update the summary line." - (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) - (when (gnus-summary-goto-subject article) - (gnus-summary-show-thread) - (gnus-summary-update-secondary-mark article))) - -(defun gnus-summary-set-saved-mark (article) - "Set the process mark on ARTICLE and update the summary line." - (push article gnus-newsgroup-saved) - (when (gnus-summary-goto-subject article) - (gnus-summary-update-secondary-mark article))) - -(defun gnus-summary-mark-forward (n &optional mark no-expire) - "Mark N articles as read forwards. -If N is negative, mark backwards instead. Mark with MARK, ?r by default. -The difference between N and the actual number of articles marked is -returned." - (interactive "p") - (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 - gnus-ticked-mark gnus-dormant-mark))))) - (n (abs n)) - (mark (or mark gnus-del-mark))) - (while (and (> n 0) - (gnus-summary-mark-article nil mark no-expire) - (zerop (gnus-summary-next-subject - (if backward -1 1) - (and gnus-summary-goto-unread - (not (eq gnus-summary-goto-unread 'never))) - t))) - (setq n (1- n))) - (when (/= 0 n) - (gnus-message 7 "No more %sarticles" (if mark "" "unread "))) - (gnus-summary-recenter) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary) - n)) - -(defun gnus-summary-mark-article-as-read (mark) - "Mark the current article quickly as read with MARK." - (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-dormant (delq article gnus-newsgroup-dormant)) - (push (cons article mark) gnus-newsgroup-reads) - ;; Possibly remove from cache, if that is used. - (when gnus-use-cache - (gnus-cache-enter-remove-article article)) - ;; Allow the backend to change the mark. - (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) - ;; Check for auto-expiry. - (when (and gnus-newsgroup-auto-expire - (or (= mark gnus-killed-mark) (= mark gnus-del-mark) - (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) - (= mark gnus-ancient-mark) - (= mark gnus-read-mark) (= mark gnus-souped-mark) - (= mark gnus-duplicate-mark))) - (setq mark gnus-expirable-mark) - (push article gnus-newsgroup-expirable)) - ;; Set the mark in the buffer. - (gnus-summary-update-mark mark 'unread) - t)) - -(defun gnus-summary-mark-article-as-unread (mark) - "Mark the current article quickly as unread with MARK." - (let* ((article (gnus-summary-article-number)) - (old-mark (gnus-summary-article-mark article))) - (if (eq mark old-mark) - t - (if (<= article 0) - (progn - (gnus-error 1 "Can't mark negative article numbers") - nil) - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-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)) - ((= mark gnus-dormant-mark) - (push article gnus-newsgroup-dormant)) - (t - (push article gnus-newsgroup-unreads))) - (setq gnus-newsgroup-reads - (delq (assq article gnus-newsgroup-reads) - gnus-newsgroup-reads)) - - ;; See whether the article is to be put in the cache. - (and gnus-use-cache - (vectorp (gnus-summary-article-header article)) - (save-excursion - (gnus-cache-possibly-enter-article - gnus-newsgroup-name article - (gnus-summary-article-header article) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) - - ;; Fix the mark. - (gnus-summary-update-mark mark 'unread) - t)))) - -(defun gnus-summary-mark-article (&optional article mark no-expire) - "Mark ARTICLE with MARK. MARK can be any character. -Four MARK strings are reserved: `? ' (unread), `?!' (ticked), -`??' (dormant) and `?E' (expirable). -If MARK is nil, then the default character `?D' is used. -If ARTICLE is nil, then the article on the current line will be -marked." - ;; The mark might be a string. - (when (stringp mark) - (setq mark (aref mark 0))) - ;; If no mark is given, then we check auto-expiring. - (and (not no-expire) - gnus-newsgroup-auto-expire - (or (not mark) - (and (gnus-characterp mark) - (or (= mark gnus-killed-mark) (= mark gnus-del-mark) - (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) - (= mark gnus-read-mark) (= mark gnus-souped-mark) - (= mark gnus-duplicate-mark)))) - (setq mark gnus-expirable-mark)) - (let* ((mark (or mark gnus-del-mark)) - (article (or article (gnus-summary-article-number)))) - (unless article - (error "No article on current line")) - (if (not (if (or (= mark gnus-unread-mark) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark)) - (gnus-mark-article-as-unread article mark) - (gnus-mark-article-as-read article mark))) - t - ;; See whether the article is to be put in the cache. - (and gnus-use-cache - (not (= mark gnus-canceled-mark)) - (vectorp (gnus-summary-article-header article)) - (save-excursion - (gnus-cache-possibly-enter-article - gnus-newsgroup-name article - (gnus-summary-article-header article) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) - - (when (gnus-summary-goto-subject article nil t) - (let ((buffer-read-only nil)) - (gnus-summary-show-thread) - ;; Fix the mark. - (gnus-summary-update-mark mark 'unread) - t))))) - -(defun gnus-summary-update-secondary-mark (article) - "Update the secondary (read, process, cache) mark." - (gnus-summary-update-mark - (cond ((memq article gnus-newsgroup-processable) - gnus-process-mark) - ((memq article gnus-newsgroup-cached) - gnus-cached-mark) - ((memq article gnus-newsgroup-replied) - gnus-replied-mark) - ((memq article gnus-newsgroup-saved) - gnus-saved-mark) - (t gnus-unread-mark)) - 'replied) - (when (gnus-visual-p 'summary-highlight 'highlight) - (gnus-run-hooks 'gnus-summary-update-hook)) - t) - -(defun gnus-summary-update-mark (mark type) - (let ((forward (cdr (assq type gnus-summary-mark-positions))) - (buffer-read-only nil)) - (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit) - (when (looking-at "\r") - (incf forward)) - (when (and forward - (<= (+ forward (point)) (point-max))) - ;; Go to the right position on the line. - (goto-char (+ forward (point))) - ;; Replace the old mark with the new mark. - (subst-char-in-region (point) (1+ (point)) (following-char) mark) - ;; Optionally update the marks by some user rule. - (when (eq type 'unread) - (gnus-data-set-mark - (gnus-data-find (gnus-summary-article-number)) mark) - (gnus-summary-update-line (eq mark gnus-unread-mark)))))) - -(defun gnus-mark-article-as-read (article &optional mark) - "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))) - ;; 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-dormant (delq article gnus-newsgroup-dormant)) - (push (cons article mark) gnus-newsgroup-reads) - ;; Possibly remove from cache, if that is used. - (when gnus-use-cache - (gnus-cache-enter-remove-article article)) - t)) - -(defun gnus-mark-article-as-unread (article &optional mark) - "Enter ARTICLE in the pertinent lists and remove it from others." - (let ((mark (or mark gnus-ticked-mark))) - (if (<= article 0) - (progn - (gnus-error 1 "Can't mark negative article numbers") - nil) - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-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)) - - ;; Unsuppress duplicates? - (when gnus-suppress-duplicates - (gnus-dup-unsuppress-article article)) - - (cond ((= mark gnus-ticked-mark) - (push article gnus-newsgroup-marked)) - ((= mark gnus-dormant-mark) - (push article gnus-newsgroup-dormant)) - (t - (push article gnus-newsgroup-unreads))) - (setq gnus-newsgroup-reads - (delq (assq article gnus-newsgroup-reads) - gnus-newsgroup-reads)) - t))) - -(defalias 'gnus-summary-mark-as-unread-forward - 'gnus-summary-tick-article-forward) -(make-obsolete 'gnus-summary-mark-as-unread-forward - 'gnus-summary-tick-article-forward) -(defun gnus-summary-tick-article-forward (n) - "Tick N articles forwards. -If N is negative, tick backwards instead. -The difference between N and the number of articles ticked is returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-ticked-mark)) - -(defalias 'gnus-summary-mark-as-unread-backward - 'gnus-summary-tick-article-backward) -(make-obsolete 'gnus-summary-mark-as-unread-backward - 'gnus-summary-tick-article-backward) -(defun gnus-summary-tick-article-backward (n) - "Tick N articles backwards. -The difference between N and the number of articles ticked is returned." - (interactive "p") - (gnus-summary-mark-forward (- n) gnus-ticked-mark)) - -(defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) -(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) -(defun gnus-summary-tick-article (&optional article clear-mark) - "Mark current article as unread. -Optional 1st argument ARTICLE specifies article number to be marked as unread. -Optional 2nd argument CLEAR-MARK remove any kinds of mark." - (interactive) - (gnus-summary-mark-article article (if clear-mark gnus-unread-mark - gnus-ticked-mark))) - -(defun gnus-summary-mark-as-read-forward (n) - "Mark N articles as read forwards. -If N is negative, mark backwards instead. -The difference between N and the actual number of articles marked is -returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-del-mark t)) - -(defun gnus-summary-mark-as-read-backward (n) - "Mark the N articles as read backwards. -The difference between N and the actual number of articles marked is -returned." - (interactive "p") - (gnus-summary-mark-forward (- n) gnus-del-mark t)) - -(defun gnus-summary-mark-as-read (&optional article mark) - "Mark current article as read. -ARTICLE specifies the article to be marked as read. -MARK specifies a string to be inserted at the beginning of the line." - (gnus-summary-mark-article article mark)) - -(defun gnus-summary-clear-mark-forward (n) - "Clear marks from N articles forward. -If N is negative, clear backward instead. -The difference between N and the number of marks cleared is returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-unread-mark)) - -(defun gnus-summary-clear-mark-backward (n) - "Clear marks from N articles backward. -The difference between N and the number of marks cleared is returned." - (interactive "p") - (gnus-summary-mark-forward (- n) gnus-unread-mark)) - -(defun gnus-summary-mark-unread-as-read () - "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-read-mark))) - -(defun gnus-summary-mark-read-and-unread-as-read () - "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)))) - -(defun gnus-summary-mark-region-as-read (point mark all) - "Mark all unread articles between point and mark as read. -If given a prefix, mark all articles between point and mark as read, -even ticked and dormant ones." - (interactive "r\nP") - (save-excursion - (let (article) - (goto-char point) - (beginning-of-line) - (while (and - (< (point) mark) - (progn - (when (or all - (memq (setq article (gnus-summary-article-number)) - gnus-newsgroup-unreads)) - (gnus-summary-mark-article article gnus-del-mark)) - t) - (gnus-summary-find-next)))))) - -(defun gnus-summary-mark-below (score mark) - "Mark articles with score less than SCORE with MARK." - (interactive "P\ncMark: ") - (setq score (if score - (prefix-numeric-value score) - (or gnus-summary-default-score 0))) - (save-excursion - (set-buffer gnus-summary-buffer) - (goto-char (point-min)) - (while - (progn - (and (< (gnus-summary-article-score) score) - (gnus-summary-mark-article nil mark)) - (gnus-summary-find-next))))) - -(defun gnus-summary-kill-below (&optional score) - "Mark articles with score below SCORE as read." - (interactive "P") - (gnus-summary-mark-below score gnus-killed-mark)) - -(defun gnus-summary-clear-above (&optional score) - "Clear all marks from articles with score above SCORE." - (interactive "P") - (gnus-summary-mark-above score gnus-unread-mark)) - -(defun gnus-summary-tick-above (&optional score) - "Tick all articles with score above SCORE." - (interactive "P") - (gnus-summary-mark-above score gnus-ticked-mark)) - -(defun gnus-summary-mark-above (score mark) - "Mark articles with score over SCORE with MARK." - (interactive "P\ncMark: ") - (setq score (if score - (prefix-numeric-value score) - (or gnus-summary-default-score 0))) - (save-excursion - (set-buffer gnus-summary-buffer) - (goto-char (point-min)) - (while (and (progn - (when (> (gnus-summary-article-score) score) - (gnus-summary-mark-article nil mark)) - t) - (gnus-summary-find-next))))) - -;; Suggested by Daniel Quinlan . -(defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged) -(defun gnus-summary-limit-include-expunged (&optional no-error) - "Display all the hidden articles that were expunged for low scores." - (interactive) - (let ((buffer-read-only nil)) - (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))) - (< (cdar scored) gnus-summary-expunge-below) - (push h headers))) - (setq scored (cdr scored))) - (if (not headers) - (when (not no-error) - (error "No expunged articles hidden")) - (goto-char (point-min)) - (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) - "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. -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." - (interactive "P") - (prog1 - (save-excursion - (when (or quietly - (not gnus-interactive-catchup) ;Without confirmation? - gnus-expert-user - (gnus-y-or-n-p - (if all - "Mark absolutely all articles as read? " - "Mark all unread articles as read? "))) - (if (and not-mark - (not gnus-newsgroup-adaptive) - (not gnus-newsgroup-auto-expire) - (not gnus-suppress-duplicates) - (or (not gnus-use-cache) - (eq gnus-use-cache 'passive))) - (progn - (when all - (setq gnus-newsgroup-marked nil - gnus-newsgroup-dormant nil)) - (setq gnus-newsgroup-unreads gnus-newsgroup-downloadable)) - ;; 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)) - (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))) - -(defun gnus-summary-catchup-to-here (&optional all) - "Mark all unticked articles before 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-prev)) - (gnus-summary-catchup all t beg))))) - (gnus-summary-position-point)) - -(defun gnus-summary-catchup-all (&optional quietly) - "Mark all articles in this newsgroup as read." - (interactive "P") - (gnus-summary-catchup t quietly)) - -(defun gnus-summary-catchup-and-exit (&optional all quietly) - "Mark all articles not marked as unread in this newsgroup as read, then exit. -If prefix argument ALL is non-nil, all articles are marked as read." - (interactive "P") - (when (gnus-summary-catchup all quietly nil 'fast) - ;; Select next newsgroup or exit. - (if (eq gnus-auto-select-next 'quietly) - (gnus-summary-next-group nil) - (gnus-summary-exit)))) - -(defun gnus-summary-catchup-all-and-exit (&optional quietly) - "Mark all articles in this newsgroup as read, and then exit." - (interactive "P") - (gnus-summary-catchup-and-exit t quietly)) - -;; Suggested by "Arne Eofsson" . -(defun gnus-summary-catchup-and-goto-next-group (&optional all) - "Mark all articles in this group as read and select the next group. -If given a prefix, mark all articles, unread as well as ticked, as -read." - (interactive "P") - (save-excursion - (gnus-summary-catchup all)) - (gnus-summary-next-article t nil nil t)) - -;; Thread-based commands. - -(defun gnus-summary-articles-in-thread (&optional article) - "Return a list of all articles in the current thread. -If ARTICLE is non-nil, return all articles in the thread that starts -with that article." - (let* ((article (or article (gnus-summary-article-number))) - (data (gnus-data-find-list article)) - (top-level (gnus-data-level (car data))) - (top-subject - (cond ((null gnus-thread-operation-ignore-subject) - (gnus-simplify-subject-re - (mail-header-subject (gnus-data-header (car data))))) - ((eq gnus-thread-operation-ignore-subject 'fuzzy) - (gnus-simplify-subject-fuzzy - (mail-header-subject (gnus-data-header (car data))))) - (t nil))) - (end-point (save-excursion - (if (gnus-summary-go-to-next-thread) - (point) (point-max)))) - articles) - (while (and data - (< (gnus-data-pos (car data)) end-point)) - (when (or (not top-subject) - (string= top-subject - (if (eq gnus-thread-operation-ignore-subject 'fuzzy) - (gnus-simplify-subject-fuzzy - (mail-header-subject - (gnus-data-header (car data)))) - (gnus-simplify-subject-re - (mail-header-subject - (gnus-data-header (car data))))))) - (push (gnus-data-number (car data)) articles)) - (unless (and (setq data (cdr data)) - (> (gnus-data-level (car data)) top-level)) - (setq data nil))) - ;; Return the list of articles. - (nreverse articles))) - -(defun gnus-summary-rethread-current () - "Rethread the thread the current article is part of." - (interactive) - (let* ((gnus-show-threads t) - (article (gnus-summary-article-number)) - (id (mail-header-id (gnus-summary-article-header))) - (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id))))) - (unless id - (error "No article on the current line")) - (gnus-rebuild-thread id) - (gnus-summary-goto-subject article))) - -(defun gnus-summary-reparent-thread () - "Make the current article child of the marked (or previous) article. - -Note that the re-threading will only work if `gnus-thread-ignore-subject' -is non-nil or the Subject: of both articles are the same." - (interactive) - (unless (not (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing")) - (unless (<= (length gnus-newsgroup-processable) 1) - (error "No more than one article may be marked")) - (save-window-excursion - (let ((gnus-article-buffer " *reparent*") - (current-article (gnus-summary-article-number)) - ;; First grab the marked article, otherwise one line up. - (parent-article (if (not (null gnus-newsgroup-processable)) - (car gnus-newsgroup-processable) - (save-excursion - (if (eq (forward-line -1) 0) - (gnus-summary-article-number) - (error "Beginning of summary buffer")))))) - (unless (not (eq current-article parent-article)) - (error "An article may not be self-referential")) - (let ((message-id (mail-header-id - (gnus-summary-article-header parent-article)))) - (unless (and message-id (not (equal message-id ""))) - (error "No message-id in desired parent")) - (gnus-summary-select-article t t nil current-article) - (set-buffer gnus-original-article-buffer) - (let ((buf (format "%s" (buffer-string)))) - (nnheader-temp-write nil - (insert buf) - (goto-char (point-min)) - (if (re-search-forward "^References: " nil t) - (progn - (re-search-forward "^[^ \t]" nil t) - (forward-line -1) - (end-of-line) - (insert " " message-id)) - (insert "References: " message-id "\n")) - (unless (gnus-request-replace-article - current-article (car gnus-article-current) - (current-buffer)) - (error "Couldn't replace article")))) - (set-buffer gnus-summary-buffer) - (gnus-summary-unmark-all-processable) - (gnus-summary-update-article current-article) - (gnus-summary-rethread-current) - (gnus-message 3 "Article %d is now the child of article %d" - current-article parent-article))))) - -(defun gnus-summary-toggle-threads (&optional arg) - "Toggle showing conversation threads. -If ARG is positive number, turn showing conversation threads on." - (interactive "P") - (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end))) - (setq gnus-show-threads - (if (null arg) (not gnus-show-threads) - (> (prefix-numeric-value arg) 0))) - (gnus-summary-prepare) - (gnus-summary-goto-subject current) - (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off")) - (gnus-summary-position-point))) - -(defun gnus-summary-show-all-threads () - "Show all threads." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))) - (gnus-summary-position-point)) - -(defun gnus-summary-show-thread () - "Show thread subtrees. -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))) - (beg (progn (beginning-of-line) (point)))) - (prog1 - ;; Any hidden lines here? - (search-forward "\r" end t) - (subst-char-in-region beg end ?\^M ?\n t) - (goto-char orig) - (gnus-summary-position-point)))) - -(defun gnus-summary-hide-all-threads () - "Hide all thread subtrees." - (interactive) - (save-excursion - (goto-char (point-min)) - (gnus-summary-hide-thread) - (while (zerop (gnus-summary-next-thread 1 t)) - (gnus-summary-hide-thread))) - (gnus-summary-position-point)) - -(defun gnus-summary-hide-thread () - "Hide thread subtrees. -Returns nil if no threads were there to be hidden." - (interactive) - (let ((buffer-read-only nil) - (start (point)) - (article (gnus-summary-article-number))) - (goto-char start) - ;; Go forward until either the buffer ends or the subthread - ;; ends. - (when (and (not (eobp)) - (or (zerop (gnus-summary-next-thread 1 t)) - (goto-char (point-max)))) - (prog1 - (if (and (> (point) start) - (search-backward "\n" start t)) - (progn - (subst-char-in-region start (point) ?\n ?\^M) - (gnus-summary-goto-subject article)) - (goto-char start) - nil) - ;;(gnus-summary-position-point) - )))) - -(defun gnus-summary-go-to-next-thread (&optional previous) - "Go to the same level (or less) next thread. -If PREVIOUS is non-nil, go to previous thread instead. -Return the article number moved to, or nil if moving was impossible." - (let ((level (gnus-summary-thread-level)) - (way (if previous -1 1)) - (beg (point))) - (forward-line way) - (while (and (not (eobp)) - (< level (gnus-summary-thread-level))) - (forward-line way)) - (if (eobp) - (progn - (goto-char beg) - nil) - (setq beg (point)) - (prog1 - (gnus-summary-article-number) - (goto-char beg))))) - -(defun gnus-summary-next-thread (n &optional silent) - "Go to the same level next N'th thread. -If N is negative, search backward instead. -Returns the difference between N and the number of skips actually -done. - -If SILENT, don't output messages." - (interactive "p") - (let ((backward (< n 0)) - (n (abs n))) - (while (and (> n 0) - (gnus-summary-go-to-next-thread backward)) - (decf n)) - (unless silent - (gnus-summary-position-point)) - (when (and (not silent) (/= 0 n)) - (gnus-message 7 "No more threads")) - n)) - -(defun gnus-summary-prev-thread (n) - "Go to the same level previous N'th thread. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-summary-next-thread (- n))) - -(defun gnus-summary-go-down-thread () - "Go down one level in the current thread." - (let ((children (gnus-summary-article-children))) - (when children - (gnus-summary-goto-subject (car children))))) - -(defun gnus-summary-go-up-thread () - "Go up one level in the current thread." - (let ((parent (gnus-summary-article-parent))) - (when parent - (gnus-summary-goto-subject parent)))) - -(defun gnus-summary-down-thread (n) - "Go down thread N steps. -If N is negative, go up instead. -Returns the difference between N and how many steps down that were -taken." - (interactive "p") - (let ((up (< n 0)) - (n (abs n))) - (while (and (> n 0) - (if up (gnus-summary-go-up-thread) - (gnus-summary-go-down-thread))) - (setq n (1- n))) - (gnus-summary-position-point) - (when (/= 0 n) - (gnus-message 7 "Can't go further")) - n)) - -(defun gnus-summary-up-thread (n) - "Go up thread N steps. -If N is negative, go up instead. -Returns the difference between N and how many steps down that were -taken." - (interactive "p") - (gnus-summary-down-thread (- n))) - -(defun gnus-summary-top-thread () - "Go to the top of the thread." - (interactive) - (while (gnus-summary-go-up-thread)) - (gnus-summary-article-number)) - -(defun gnus-summary-kill-thread (&optional unmark) - "Mark articles under current thread as read. -If the prefix argument is positive, remove any kinds of marks. -If the prefix argument is negative, tick articles instead." - (interactive "P") - (when unmark - (setq unmark (prefix-numeric-value unmark))) - (let ((articles (gnus-summary-articles-in-thread))) - (save-excursion - ;; Expand the thread. - (gnus-summary-show-thread) - ;; Mark all the articles. - (while articles - (gnus-summary-goto-subject (car articles)) - (cond ((null unmark) - (gnus-summary-mark-article-as-read gnus-killed-mark)) - ((> unmark 0) - (gnus-summary-mark-article-as-unread gnus-unread-mark)) - (t - (gnus-summary-mark-article-as-unread gnus-ticked-mark))) - (setq articles (cdr articles)))) - ;; Hide killed subtrees. - (and (null unmark) - gnus-thread-hide-killed - (gnus-summary-hide-thread)) - ;; If marked as read, go to next unread subject. - (when (null unmark) - ;; Go to next unread subject. - (gnus-summary-next-subject 1 t))) - (gnus-set-mode-line 'summary)) - -;; Summary sorting commands - -(defun gnus-summary-sort-by-number (&optional reverse) - "Sort the summary buffer by article number. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'number 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. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'author reverse)) - -(defun gnus-summary-sort-by-subject (&optional reverse) - "Sort the summary buffer by subject alphabetically. `Re:'s are ignored. -If case-fold-search is non-nil, case of letters is ignored. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'subject reverse)) - -(defun gnus-summary-sort-by-date (&optional reverse) - "Sort the summary buffer by date. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'date reverse)) - -(defun gnus-summary-sort-by-score (&optional reverse) - "Sort the summary buffer by score. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'score reverse)) - -(defun gnus-summary-sort-by-lines (&optional reverse) - "Sort the summary buffer by article length. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'lines reverse)) - -(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))) - (article (intern (format "gnus-article-sort-by-%s" predicate))) - (gnus-thread-sort-functions - (list - (if (not reverse) - thread - `(lambda (t1 t2) - (,thread t2 t1))))) - (gnus-article-sort-functions - (list - (if (not reverse) - article - `(lambda (t1 t2) - (,article t2 t1))))) - (buffer-read-only) - (gnus-summary-prepare-hook nil)) - ;; 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)))) - -;; Summary saving commands. - -(defun gnus-summary-save-article (&optional n not-saved) - "Save the current article using the default saver function. -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. -The variable `gnus-default-article-saver' specifies the saver function." - (interactive "P") - (let* ((articles (gnus-summary-work-articles n)) - (save-buffer (save-excursion - (nnheader-set-temp-buffer " *Gnus Save*"))) - (num (length articles)) - header article file) - (while articles - (setq header (gnus-summary-article-header - (setq article (pop articles)))) - (if (not (vectorp header)) - ;; This is a pseudo-article. - (if (assq 'name header) - (gnus-copy-file (cdr (assq 'name header))) - (gnus-message 1 "Article %d is unsaveable" article)) - ;; This is a real article. - (save-window-excursion - (gnus-summary-select-article t nil nil article)) - (save-excursion - (set-buffer save-buffer) - (erase-buffer) - (insert-buffer-substring gnus-original-article-buffer)) - (setq file (gnus-article-save save-buffer file num)) - (gnus-summary-remove-process-mark article) - (unless not-saved - (gnus-summary-set-saved-mark article)))) - (gnus-kill-buffer save-buffer) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary) - n)) - -(defun gnus-summary-pipe-output (&optional arg) - "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") - (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)) - (gnus-summary-save-article arg t)) - (gnus-configure-windows 'pipe)) - -(defun gnus-summary-save-article-mail (&optional arg) - "Append the current article to an mail file. -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") - (let ((gnus-default-article-saver 'gnus-summary-save-in-mail)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-article-rmail (&optional arg) - "Append the current article to an rmail file. -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") - (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-article-file (&optional arg) - "Append the current article to a file. -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") - (let ((gnus-default-article-saver 'gnus-summary-save-in-file)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-write-article-file (&optional arg) - "Write the current article to a file, deleting the previous file. -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") - (let ((gnus-default-article-saver 'gnus-summary-write-to-file)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-article-body-file (&optional arg) - "Append the current article body to a file. -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") - (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-pipe-message (program) - "Pipe the current article through PROGRAM." - (interactive "sProgram: ") - (gnus-summary-select-article) - (let ((mail-header-separator "") - (art-buf (get-buffer gnus-article-buffer))) - (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)))))) - -(defun gnus-get-split-value (methods) - "Return a value based on the split METHODS." - (let (split-name method result match) - (when methods - (save-excursion - (set-buffer gnus-original-article-buffer) - (save-restriction - (nnheader-narrow-to-headers) - (while methods - (goto-char (point-min)) - (setq method (pop methods)) - (setq match (car method)) - (when (cond - ((stringp match) - ;; Regular expression. - (ignore-errors - (re-search-forward match nil t))) - ((gnus-functionp match) - ;; Function. - (save-restriction - (widen) - (setq result (funcall match gnus-newsgroup-name)))) - ((consp match) - ;; Form. - (save-restriction - (widen) - (setq result (eval match))))) - (setq split-name (append (cdr method) split-name)) - (cond ((stringp result) - (push (expand-file-name - result gnus-article-save-directory) - split-name)) - ((consp result) - (setq split-name (append result split-name))))))))) - split-name)) - -(defun gnus-valid-move-group-p (group) - (and (boundp group) - (symbol-name group) - (memq 'respool - (assoc (symbol-name - (car (gnus-find-method-for-group - (symbol-name group)))) - gnus-valid-select-methods)))) - -(defun gnus-read-move-group-name (prompt default articles prefix) - "Read a group name." - (let* ((split-name (gnus-get-split-value gnus-move-split-methods)) - (minibuffer-confirm-incomplete nil) ; XEmacs - (prom - (format "%s %s to:" - prompt - (if (> (length articles) 1) - (format "these %d articles" (length articles)) - "this article"))) - (to-newsgroup - (cond - ((null split-name) - (gnus-completing-read 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)) - (t - (gnus-completing-read nil prom - (mapcar (lambda (el) (list el)) - (nreverse split-name)) - nil nil nil - 'gnus-group-history))))) - (when to-newsgroup - (if (or (string= to-newsgroup "") - (string= to-newsgroup prefix)) - (setq to-newsgroup default)) - (unless to-newsgroup - (error "No group name entered")) - (or (gnus-active to-newsgroup) - (gnus-activate-group to-newsgroup) - (if (gnus-y-or-n-p (format "No such group: %s. Create it? " - to-newsgroup)) - (or (and (gnus-request-create-group - to-newsgroup (gnus-group-name-to-method to-newsgroup)) - (gnus-activate-group to-newsgroup nil nil - (gnus-group-name-to-method - to-newsgroup))) - (error "Couldn't create group %s" to-newsgroup))) - (error "No such group: %s" to-newsgroup))) - to-newsgroup)) - -;; Summary extract commands - -(defun gnus-summary-insert-pseudos (pslist &optional not-view) - (let ((buffer-read-only nil) - (article (gnus-summary-article-number)) - after-article b e) - (unless (gnus-summary-goto-subject article) - (error "No such article: %d" article)) - (gnus-summary-position-point) - ;; If all commands are to be bunched up on one line, we collect - ;; them here. - (unless gnus-view-pseudos-separately - (let ((ps (setq pslist (sort pslist 'gnus-pseudos<))) - files action) - (while ps - (setq action (cdr (assq 'action (car ps)))) - (setq files (list (cdr (assq 'name (car ps))))) - (while (and ps (cdr ps) - (string= (or action "1") - (or (cdr (assq 'action (cadr ps))) "2"))) - (push (cdr (assq 'name (cadr ps))) files) - (setcdr ps (cddr ps))) - (when files - (when (not (string-match "%s" action)) - (push " " files)) - (push " " files) - (when (assq 'execute (car ps)) - (setcdr (assq 'execute (car ps)) - (funcall (if (string-match "%s" action) - 'format 'concat) - action - (mapconcat - (lambda (f) - (if (equal f " ") - f - (gnus-quote-arg-for-sh-or-csh f))) - files " "))))) - (setq ps (cdr ps))))) - (if (and gnus-view-pseudos (not not-view)) - (while pslist - (when (assq 'execute (car pslist)) - (gnus-execute-command (cdr (assq 'execute (car pslist))) - (eq gnus-view-pseudos 'not-confirm))) - (setq pslist (cdr pslist))) - (save-excursion - (while pslist - (setq after-article (or (cdr (assq 'article (car pslist))) - (gnus-summary-article-number))) - (gnus-summary-goto-subject after-article) - (forward-line 1) - (setq b (point)) - (insert " " (file-name-nondirectory - (cdr (assq 'name (car pslist)))) - ": " (or (cdr (assq 'execute (car pslist))) "") "\n") - (setq e (point)) - (forward-line -1) ; back to `b' - (gnus-add-text-properties - b (1- e) (list 'gnus-number gnus-reffed-article-number - gnus-mouse-face-prop gnus-mouse-face)) - (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-reffed-article-number (1- gnus-reffed-article-number)) - (setq pslist (cdr pslist))))))) - -(defun gnus-pseudos< (p1 p2) - (let ((c1 (cdr (assq 'action p1))) - (c2 (cdr (assq 'action p2)))) - (and c1 c2 (string< c1 c2)))) - -(defun gnus-request-pseudo-article (props) - (cond ((assq 'execute props) - (gnus-execute-command (cdr (assq 'execute props))))) - (let ((gnus-current-article (gnus-summary-article-number))) - (gnus-run-hooks 'gnus-mark-article-hook))) - -(defun gnus-execute-command (command &optional automatic) - (save-excursion - (gnus-article-setup-buffer) - (set-buffer gnus-article-buffer) - (setq buffer-read-only nil) - (let ((command (if automatic command - (read-string "Command: " (cons command 0))))) - (erase-buffer) - (insert "$ " command "\n\n") - (if gnus-view-pseudo-asynchronously - (start-process "gnus-execute" (current-buffer) shell-file-name - shell-command-switch command) - (call-process shell-file-name nil t nil - shell-command-switch command))))) - -;; Summary kill commands. - -(defun gnus-summary-edit-global-kill (article) - "Edit the \"global\" kill file." - (interactive (list (gnus-summary-article-number))) - (gnus-group-edit-global-kill article)) - -(defun gnus-summary-edit-local-kill () - "Edit a local kill file applied to the current newsgroup." - (interactive) - (setq gnus-current-headers (gnus-summary-article-header)) - (gnus-group-edit-local-kill - (gnus-summary-article-number) gnus-newsgroup-name)) - -;;; Header reading. - -(defun gnus-read-header (id &optional header) - "Read the headers of article ID and enter them into the Gnus system." - (let ((group gnus-newsgroup-name) - (gnus-override-method - (and (gnus-news-group-p gnus-newsgroup-name) - gnus-refer-article-method)) - where) - ;; First we check to see whether the header in question is already - ;; fetched. - (if (stringp id) - ;; This is a Message-ID. - (setq header (or header (gnus-id-to-header id))) - ;; This is an article number. - (setq header (or header (gnus-summary-article-header id)))) - (if (and header - (not (gnus-summary-article-sparse-p (mail-header-number header)))) - ;; We have found the header. - header - ;; If this is a sparse article, we have to nix out its - ;; previous entry in the thread hashtb. - (when (and header - (gnus-summary-article-sparse-p (mail-header-number header))) - (let* ((parent (gnus-parent-id (mail-header-references header))) - (thread - (and parent - (gnus-gethash parent gnus-newsgroup-dependencies)))) - (when thread - (delq (assq header thread) thread)))) - ;; We have to really fetch the header to this article. - (save-excursion - (set-buffer nntp-server-buffer) - (when (setq where (gnus-request-head id group)) - (nnheader-fold-continuation-lines) - (goto-char (point-max)) - (insert ".\n") - (goto-char (point-min)) - (insert "211 ") - (princ (cond - ((numberp id) id) - ((cdr where) (cdr where)) - (header (mail-header-number header)) - (t gnus-reffed-article-number)) - (current-buffer)) - (insert " Article retrieved.\n")) - (if (or (not where) - (not (setq header (car (gnus-get-newsgroup-headers nil t))))) - () ; Malformed head. - (unless (gnus-summary-article-sparse-p (mail-header-number header)) - (when (and (stringp id) - (not (string= (gnus-group-real-name group) - (car where)))) - ;; If we fetched by Message-ID and the article came - ;; from a different group, we fudge some bogus article - ;; numbers for this article. - (mail-header-set-number header gnus-reffed-article-number)) - (save-excursion - (set-buffer gnus-summary-buffer) - (decf gnus-reffed-article-number) - (gnus-remove-header (mail-header-number header)) - (push header gnus-newsgroup-headers) - (setq gnus-current-headers header) - (push (mail-header-number header) gnus-newsgroup-limit))) - header))))) - -(defun gnus-remove-header (number) - "Remove header NUMBER from `gnus-newsgroup-headers'." - (if (and gnus-newsgroup-headers - (= number (mail-header-number (car gnus-newsgroup-headers)))) - (pop gnus-newsgroup-headers) - (let ((headers gnus-newsgroup-headers)) - (while (and (cdr headers) - (not (= number (mail-header-number (cadr headers))))) - (pop headers)) - (when (cdr headers) - (setcdr headers (cddr headers)))))) - -;;; -;;; summary highlights -;;; - -(defun gnus-highlight-selected-summary () - ;; Added by Per Abrahamsen . - ;; Highlight selected article in summary buffer - (when gnus-summary-selected-face - (save-excursion - (let* ((beg (progn (beginning-of-line) (point))) - (end (progn (end-of-line) (point))) - ;; Fix by Mike Dugan . - (from (if (get-text-property beg gnus-mouse-face-prop) - beg - (or (next-single-property-change - beg gnus-mouse-face-prop nil end) - beg))) - (to - (if (= from end) - (- from 2) - (or (next-single-property-change - from gnus-mouse-face-prop nil end) - end)))) - ;; If no mouse-face prop on line we will have to = from = end, - ;; so we highlight the entire line instead. - (when (= (+ to 2) from) - (setq from beg) - (setq to end)) - (if gnus-newsgroup-selected-overlay - ;; Move old overlay. - (gnus-move-overlay - gnus-newsgroup-selected-overlay from to (current-buffer)) - ;; Create new overlay. - (gnus-overlay-put - (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to)) - 'face gnus-summary-selected-face)))))) - -;; New implementation by Christian Limpach . -(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) - 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))) - (unless (eq face (get-text-property beg 'face)) - (gnus-put-text-property - beg end '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))) - -(defun gnus-update-read-articles (group unread &optional compute) - "Update the list of read articles in GROUP." - (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, - ;; killed. Gnus stores no information on killed groups, so - ;; there's nothing to be done. - ;; One could store the information somewhere temporarily, - ;; perhaps... Hmmm... - () - ;; Remove any negative articles numbers. - (while (and unread (< (car unread) 0)) - (setq unread (cdr unread))) - ;; Remove any expired article numbers - (while (and unread (< (car unread) (car active))) - (setq unread (cdr unread))) - ;; Compute the ranges of read articles by looking at the list of - ;; unread articles. - (while unread - (when (/= (car unread) prev) - (push (if (= prev (1- (car unread))) prev - (cons prev (1- (car unread)))) - read)) - (setq prev (1+ (car unread))) - (setq unread (cdr unread))) - (when (<= prev (cdr active)) - (push (cons prev (cdr active)) read)) - (if compute - (if (> (length read) 1) (nreverse read) read) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-undo-register - `(progn - (gnus-info-set-marks ',info ',(gnus-info-marks info) t) - (gnus-info-set-read ',info ',(gnus-info-read info)) - (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) - (gnus-group-update-group ,group t)))) - ;; Enter this list into the group info. - (gnus-info-set-read - info (if (> (length read) 1) (nreverse read) read)) - ;; Set the number of unread articles in gnus-newsrc-hashtb. - (gnus-get-unread-articles-in-group info (gnus-active group)) - t)))) - -(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 - (map-y-or-n-p - "Update summary buffer %s? " - (lambda (buf) (switch-to-buffer buf) (gnus-summary-exit)) - buffers))))) - - -;;; @ for mime-partial -;;; - -(defun gnus-mime-partial-preview-function () - (gnus-summary-preview-mime-message (gnus-summary-article-number)) - ) - -(autoload 'mime-combine-message/partials-automatically - "mime-partial" - "Internal method to combine message/partial messages automatically.") - -(set-atype 'mime-acting-condition - '((type . "message/partial") - (method . mime-combine-message/partials-automatically) - (major-mode . gnus-original-article-mode) - (summary-buffer-exp . gnus-summary-buffer) - )) - -(set-alist 'mime-view-partial-message-method-alist - 'gnus-original-article-mode - 'gnus-mime-partial-preview-function) - - -;;; @ end -;;; - -(gnus-ems-redefine) - -(provide 'gnus-sum) - -(run-hooks 'gnus-sum-load-hook) - -;;; gnus-sum.el ends here diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el deleted file mode 100644 index 9a989b0..0000000 --- a/lisp/gnus-topic.el +++ /dev/null @@ -1,1421 +0,0 @@ -;;; gnus-topic.el --- a folding minor mode for Gnus group buffers -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Ilja Weis -;; Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-group) -(require 'gnus-start) - -(defgroup gnus-topic nil - "Group topics." - :group 'gnus-group) - -(defvar gnus-topic-mode nil - "Minor mode for Gnus group buffers.") - -(defcustom gnus-topic-mode-hook nil - "*Hook run in topic mode buffers." - :type 'hook - :group 'gnus-topic) - -(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, -with some simple extensions. - -%i Indentation based on topic level. -%n Topic name. -%v Nothing if the topic is visible, \"...\" otherwise. -%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. -" - :type 'string - :group 'gnus-topic) - -(defcustom gnus-topic-indent-level 2 - "*How much each subtopic should be indented." - :type 'integer - :group 'gnus-topic) - -(defcustom gnus-topic-display-empty-topics t - "*If non-nil, display the topic lines even of topics that have no unread articles." - :type 'boolean - :group 'gnus-topic) - -;; Internal variables. - -(defvar gnus-topic-active-topology nil) -(defvar gnus-topic-active-alist nil) - -(defvar gnus-topology-checked-p nil - "Whether the topology has been checked in this session.") - -(defvar gnus-topic-killed-topics nil) -(defvar gnus-topic-inhibit-change-level nil) - -(defconst gnus-topic-line-format-alist - `((?n name ?s) - (?v visible ?s) - (?i indentation ?s) - (?g number-of-groups ?d) - (?a (gnus-topic-articles-in-topic entries) ?d) - (?A total-number-of-articles ?d) - (?l level ?d))) - -(defvar gnus-topic-line-format-spec nil) - -;;; Utility functions - -(defun gnus-group-topic-name () - "The name of the topic on the current line." - (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic))) - (and topic (symbol-name topic)))) - -(defun gnus-group-topic-level () - "The level of the topic on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-topic-level)) - -(defun gnus-group-topic-unread () - "The number of unread articles in topic on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-topic-unread)) - -(defun gnus-topic-unread (topic) - "Return the number of unread articles in TOPIC." - (or (save-excursion - (and (gnus-topic-goto-topic topic) - (gnus-group-topic-unread))) - 0)) - -(defun gnus-group-topic-p () - "Return non-nil if the current line is a topic." - (gnus-group-topic-name)) - -(defun gnus-topic-visible-p () - "Return non-nil if the current topic is visible." - (get-text-property (gnus-point-at-bol) 'gnus-topic-visible)) - -(defun gnus-topic-articles-in-topic (entries) - (let ((total 0) - number) - (while entries - (when (numberp (setq number (car (pop entries)))) - (incf total number))) - total)) - -(defun gnus-group-topic (group) - "Return the topic GROUP is a member of." - (let ((alist gnus-topic-alist) - out) - (while alist - (when (member group (cdar alist)) - (setq out (caar alist) - alist nil)) - (setq alist (cdr alist))) - out)) - -(defun gnus-group-parent-topic (group) - "Return the topic GROUP is member of by looking at the group buffer." - (save-excursion - (set-buffer gnus-group-buffer) - (if (gnus-group-goto-group group) - (gnus-current-topic) - (gnus-group-topic group)))) - -(defun gnus-topic-goto-topic (topic) - "Go to TOPIC." - (when topic - (gnus-goto-char (text-property-any (point-min) (point-max) - 'gnus-topic (intern topic))))) - -(defun gnus-current-topic () - "Return the name of the current topic." - (let ((result - (or (get-text-property (point) 'gnus-topic) - (save-excursion - (and (gnus-goto-char (previous-single-property-change - (point) 'gnus-topic)) - (get-text-property (max (1- (point)) (point-min)) - 'gnus-topic)))))) - (when result - (symbol-name result)))) - -(defun gnus-current-topics () - "Return a list of all current topics, lowest in hierarchy first." - (let ((topic (gnus-current-topic)) - topics) - (while topic - (push topic topics) - (setq topic (gnus-topic-parent-topic topic))) - (nreverse topics))) - -(defun gnus-group-active-topic-p () - "Say whether the current topic comes from the active topics." - (save-excursion - (beginning-of-line) - (get-text-property (point) 'gnus-active))) - -(defun gnus-topic-find-groups (topic &optional level all lowest) - "Return entries for all visible groups in TOPIC." - (let ((groups (cdr (assoc topic gnus-topic-alist))) - 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. - (while groups - (when (setq group (pop groups)) - (setq entry (gnus-gethash group gnus-newsrc-hashtb) - info (nth 2 entry) - params (gnus-info-params info) - active (gnus-active group) - unread (or (car entry) - (and (not (equal group "dummy.group")) - active - (- (1+ (cdr active)) (car active)))) - clevel (or (gnus-info-level info) - (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)))) - (and - unread ; nil means that the group is dead. - (<= clevel level) - (>= clevel lowest) ; Is inside the level we want. - (or all - (if (eq unread t) - gnus-group-list-inactive-groups - (> unread 0)) - (and gnus-list-groups-with-ticked-articles - (cdr (assq 'tick (gnus-info-marks info)))) - ; Has right readedness. - ;; Check for permanent visibility. - (and gnus-permanently-visible-groups - (string-match gnus-permanently-visible-groups group)) - (memq 'visible params) - (cdr (assq 'visible params))) - ;; Add this group to the list of visible groups. - (push (or entry group) visible-groups))) - (nreverse visible-groups))) - -(defun gnus-topic-previous-topic (topic) - "Return the previous topic on the same level as TOPIC." - (let ((top (cddr (gnus-topic-find-topology - (gnus-topic-parent-topic topic))))) - (unless (equal topic (caaar top)) - (while (and top (not (equal (caaadr top) topic))) - (setq top (cdr top))) - (caaar top)))) - -(defun gnus-topic-parent-topic (topic &optional topology) - "Return the parent of TOPIC." - (unless topology - (setq topology gnus-topic-topology)) - (let ((parent (car (pop topology))) - result found) - (while (and topology - (not (setq found (equal (caaar topology) topic))) - (not (setq result (gnus-topic-parent-topic - topic (car topology))))) - (setq topology (cdr topology))) - (or result (and found parent)))) - -(defun gnus-topic-next-topic (topic &optional previous) - "Return the next sibling of TOPIC." - (let ((parentt (cddr (gnus-topic-find-topology - (gnus-topic-parent-topic topic)))) - prev) - (while (and parentt - (not (equal (caaar parentt) topic))) - (setq prev (caaar parentt) - parentt (cdr parentt))) - (if previous - prev - (caaadr parentt)))) - -(defun gnus-topic-forward-topic (num) - "Go to the next topic on the same level as the current one." - (let* ((topic (gnus-current-topic)) - (way (if (< num 0) 'gnus-topic-previous-topic - 'gnus-topic-next-topic)) - (num (abs num))) - (while (and (not (zerop num)) - (setq topic (funcall way topic))) - (when (gnus-topic-goto-topic topic) - (decf num))) - (unless (zerop num) - (goto-char (point-max))) - num)) - -(defun gnus-topic-find-topology (topic &optional topology level remove) - "Return the topology of TOPIC." - (unless topology - (setq topology gnus-topic-topology) - (setq level 0)) - (let ((top topology) - result) - (if (equal (caar topology) topic) - (progn - (when remove - (delq topology remove)) - (cons level topology)) - (setq topology (cdr topology)) - (while (and topology - (not (setq result (gnus-topic-find-topology - topic (car topology) (1+ level) - (and remove top))))) - (setq topology (cdr topology))) - result))) - -(defvar gnus-tmp-topics nil) -(defun gnus-topic-list (&optional topology) - "Return a list of all topics in the topology." - (unless topology - (setq topology gnus-topic-topology - gnus-tmp-topics nil)) - (push (caar topology) gnus-tmp-topics) - (mapcar 'gnus-topic-list (cdr topology)) - gnus-tmp-topics) - -;;; Topic parameter jazz - -(defun gnus-topic-parameters (topic) - "Return the parameters for TOPIC." - (let ((top (gnus-topic-find-topology topic))) - (when top - (nth 3 (cadr top))))) - -(defun gnus-topic-set-parameters (topic parameters) - "Set the topic parameters of TOPIC to PARAMETERS." - (let ((top (gnus-topic-find-topology topic))) - (unless top - (error "No such topic: %s" topic)) - ;; We may have to extend if there is no parameters here - ;; to begin with. - (unless (nthcdr 2 (cadr top)) - (nconc (cadr top) (list nil))) - (unless (nthcdr 3 (cadr top)) - (nconc (cadr top) (list nil))) - (setcar (nthcdr 3 (cadr top)) parameters) - (gnus-dribble-enter - (format "(gnus-topic-set-parameters %S '%S)" topic parameters)))) - -(defun gnus-group-topic-parameters (group) - "Compute the group parameters for GROUP taking into account inheritance from topics." - (let ((params-list (list (gnus-group-get-parameter group))) - topics params param out) - (save-excursion - (gnus-group-goto-group group) - (setq topics (gnus-current-topics)) - (while topics - (push (gnus-topic-parameters (pop topics)) params-list)) - ;; We probably have lots of nil elements here, so - ;; we remove them. Probably faster than doing this "properly". - (setq params-list (delq nil params-list)) - ;; Now we have all the parameters, so we go through them - ;; and do inheritance in the obvious way. - (while (setq params (pop params-list)) - (while (setq param (pop params)) - (when (atom param) - (setq param (cons param t))) - ;; Override any old versions of this param. - (setq out (delq (assq (car param) out) out)) - (push param out))) - ;; Return the resulting parameter list. - out))) - -;;; General utility functions - -(defun gnus-topic-enter-dribble () - (gnus-dribble-enter - (format "(setq gnus-topic-topology '%S)" gnus-topic-topology))) - -;;; Generating group buffers - -(defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic topic-level) - "List all newsgroups with unread articles of level LEVEL or lower, and -use the `gnus-group-topics' to sort the groups. -If ALL is non-nil, 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))) - - (when (or (not gnus-topic-alist) - (not gnus-topology-checked-p)) - (gnus-topic-check-topology)) - - (unless list-topic - (erase-buffer)) - - ;; List dead groups? - (when (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)) - (gnus-group-prepare-flat-list-dead - (setq gnus-killed-list (sort gnus-killed-list 'string<)) - gnus-level-killed ?K - regexp)) - - ;; Use topics. - (prog1 - (when (< lowest gnus-level-zombie) - (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)) - (gnus-topic-prepare-topic gnus-topic-topology 0 - (or topic-level level) all - nil lowest))) - - (gnus-group-set-mode-line) - (setq gnus-group-list-mode (cons level all)) - (gnus-run-hooks 'gnus-group-prepare-hook)))) - -(defun gnus-topic-prepare-topic (topicl level &optional list-level all silent - lowest) - "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 all lowest)) - (visiblep (and (eq (nth 1 type) 'visible) (not silent))) - (gnus-group-indentation - (make-string (* gnus-topic-indent-level level) ? )) - (beg (progn (beginning-of-line) (point))) - (topicl (reverse topicl)) - (all-entries entries) - (point-max (point-max)) - (unread 0) - (topic (car type)) - info entry end active tick) - ;; Insert any sub-topics. - (while topicl - (incf unread - (gnus-topic-prepare-topic - (pop topicl) (1+ level) list-level all - (not visiblep) lowest))) - (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))) - (goto-char beg) - ;; Insert the topic line. - (when (and (not silent) - (or gnus-topic-display-empty-topics ;We want empty topics - (not (zerop unread)) ;Non-empty - tick ;Ticked articles - (/= point-max (point-max)))) ;Unactivated groups - (gnus-extent-start-open (point)) - (gnus-topic-insert-topic-line - (car type) visiblep - (not (eq (nth 2 type) 'hidden)) - level all-entries unread)) - (goto-char end) - unread)) - -(defun gnus-topic-remove-topic (&optional insert total-remove hide in-level) - "Remove the current topic." - (let ((topic (gnus-group-topic-name)) - (level (gnus-group-topic-level)) - (beg (progn (beginning-of-line) (point))) - buffer-read-only) - (when topic - (while (and (zerop (forward-line 1)) - (> (or (gnus-group-topic-level) (1+ level)) level))) - (delete-region beg (point)) - ;; Do the change in this rather odd manner because it has been - ;; reported that some topics share parts of some lists, for some - ;; reason. I have been unable to determine why this is the - ;; case, but this hack seems to take care of things. - (let ((data (cadr (gnus-topic-find-topology topic)))) - (setcdr data - (list (if insert 'visible 'invisible) - (if hide 'hide nil) - (cadddr data)))) - (if total-remove - (setq gnus-topic-alist - (delq (assoc topic gnus-topic-alist) gnus-topic-alist)) - (gnus-topic-insert-topic topic in-level))))) - -(defun gnus-topic-insert-topic (topic &optional level) - "Insert TOPIC." - (gnus-group-prepare-topics - (car gnus-group-list-mode) (cdr gnus-group-list-mode) - nil nil topic level)) - -(defun gnus-topic-fold (&optional insert) - "Remove/insert the current topic." - (let ((topic (gnus-group-topic-name))) - (when topic - (save-excursion - (if (not (gnus-group-active-topic-p)) - (gnus-topic-remove-topic - (or insert (not (gnus-topic-visible-p)))) - (let ((gnus-topic-topology gnus-topic-active-topology) - (gnus-topic-alist gnus-topic-active-alist) - (gnus-group-list-mode (cons 5 t))) - (gnus-topic-remove-topic - (or insert (not (gnus-topic-visible-p))) nil nil 9) - (gnus-topic-enter-dribble))))))) - -(defun gnus-topic-insert-topic-line (name visiblep shownp level entries - &optional unread) - (let* ((visible (if visiblep "" "...")) - (indentation (make-string (* gnus-topic-indent-level level) ? )) - (total-number-of-articles unread) - (number-of-groups (length entries)) - (active-topic (eq gnus-topic-alist gnus-topic-active-alist)) - gnus-tmp-header) - (beginning-of-line) - ;; Insert the text. - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - (eval gnus-topic-line-format-spec)) - (list 'gnus-topic (intern name) - 'gnus-topic-level level - 'gnus-topic-unread unread - 'gnus-active active-topic - 'gnus-topic-visible visiblep)))) - -(defun gnus-topic-update-topics-containing-group (group) - "Update all topics that have GROUP as a member." - (when (and (eq major-mode 'gnus-group-mode) - gnus-topic-mode) - (save-excursion - (let ((alist gnus-topic-alist)) - ;; This is probably not entirely correct. If a topic - ;; isn't shown, then it's not updated. But the updating - ;; should be performed in any case, since the topic's - ;; parent should be updated. Pfft. - (while alist - (when (and (member group (cdar alist)) - (gnus-topic-goto-topic (caar alist))) - (gnus-topic-update-topic-line (caar alist))) - (pop alist)))))) - -(defun gnus-topic-update-topic () - "Update all parent topics to the current group." - (when (and (eq major-mode 'gnus-group-mode) - gnus-topic-mode) - (let ((group (gnus-group-group-name)) - (m (point-marker)) - (buffer-read-only nil)) - (when (and group - (gnus-get-info group) - (gnus-topic-goto-topic (gnus-current-topic))) - (gnus-topic-update-topic-line (gnus-group-topic-name)) - (goto-char m) - (set-marker m nil) - (gnus-group-position-point))))) - -(defun gnus-topic-goto-missing-group (group) - "Place point where GROUP is supposed to be inserted." - (let* ((topic (gnus-group-topic group)) - (groups (cdr (assoc topic gnus-topic-alist))) - (g (cdr (member group groups))) - (unfound t)) - ;; Try to jump to a visible group. - (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) - (setq g (cdr (member group (reverse groups)))) - (while (and g unfound) - (when (gnus-group-goto-group (pop g) t) - (forward-line 1) - (setq unfound nil))) - (when (and unfound - topic - (not (gnus-topic-goto-missing-topic topic))) - (gnus-topic-insert-topic-line - topic t t (car (gnus-topic-find-topology topic)) nil 0))))) - -(defun gnus-topic-goto-missing-topic (topic) - (if (gnus-topic-goto-topic topic) - (forward-line 1) - ;; Topic not displayed. - (let* ((top (gnus-topic-find-topology - (gnus-topic-parent-topic topic))) - (tp (reverse (cddr top)))) - (while (not (equal (caaar tp) topic)) - (setq tp (cdr tp))) - (pop tp) - (while (and tp - (not (gnus-topic-goto-topic (caaar tp)))) - (pop tp)) - (if tp - (gnus-topic-forward-topic 1) - (gnus-topic-goto-missing-topic (caadr top)))) - nil)) - -(defun gnus-topic-update-topic-line (topic-name &optional reads) - (let* ((top (gnus-topic-find-topology topic-name)) - (type (cadr top)) - (children (cddr top)) - (entries (gnus-topic-find-groups - (car type) (car gnus-group-list-mode) - (cdr gnus-group-list-mode))) - (parent (gnus-topic-parent-topic topic-name)) - (all-entries entries) - (unread 0) - old-unread entry) - (when (gnus-topic-goto-topic (car type)) - ;; Tally all the groups that belong in this topic. - (if reads - (setq unread (- (gnus-group-topic-unread) reads)) - (while children - (incf unread (gnus-topic-unread (caar (pop children))))) - (while (setq entry (pop entries)) - (when (numberp (car entry)) - (incf unread (car entry))))) - (setq old-unread (gnus-group-topic-unread)) - ;; Insert the topic line. - (gnus-topic-insert-topic-line - (car type) (gnus-topic-visible-p) - (not (eq (nth 2 type) 'hidden)) - (gnus-group-topic-level) all-entries unread) - (gnus-delete-line)) - (when parent - (forward-line -1) - (gnus-topic-update-topic-line - parent (- (or old-unread 0) (or (gnus-group-topic-unread) 0)))) - unread)) - -(defun gnus-topic-group-indentation () - (make-string - (* gnus-topic-indent-level - (or (save-excursion - (forward-line -1) - (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-group-topic-level)) - 0)) - ? )) - -;;; Initialization - -(gnus-add-shutdown 'gnus-topic-close 'gnus) - -(defun gnus-topic-close () - (setq gnus-topic-active-topology nil - gnus-topic-active-alist nil - gnus-topic-killed-topics nil - gnus-topology-checked-p nil)) - -(defun gnus-topic-check-topology () - ;; The first time we set the topology to whatever we have - ;; gotten here, which can be rather random. - (unless gnus-topic-alist - (gnus-topic-init-alist)) - - (setq gnus-topology-checked-p t) - ;; Go through the topic alist and make sure that all topics - ;; are in the topic topology. - (let ((topics (gnus-topic-list)) - (alist gnus-topic-alist) - changed) - (while alist - (unless (member (caar alist) topics) - (nconc gnus-topic-topology - (list (list (list (caar alist) 'visible)))) - (setq changed t)) - (setq alist (cdr alist))) - (when changed - (gnus-topic-enter-dribble)) - ;; Conversely, go through the topology and make sure that all - ;; topologies have alists. - (while topics - (unless (assoc (car topics) gnus-topic-alist) - (push (list (car topics)) gnus-topic-alist)) - (pop topics))) - ;; Go through all living groups and make sure that - ;; they belong to some topic. - (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry)) - gnus-topic-alist))) - (entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist))) - (newsrc (cdr gnus-newsrc-alist)) - group) - (while newsrc - (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups) - (setcdr entry (list group)) - (setq entry (cdr entry))))) - ;; Go through all topics and make sure they contain only living groups. - (let ((alist gnus-topic-alist) - topic) - (while (setq topic (pop alist)) - (while (cdr topic) - (if (and (cadr topic) - (gnus-gethash (cadr topic) gnus-newsrc-hashtb)) - (setq topic (cdr topic)) - (setcdr topic (cddr topic))))))) - -(defun gnus-topic-init-alist () - "Initialize the topic structures." - (setq gnus-topic-topology - (cons (list "Gnus" 'visible) - (mapcar (lambda (topic) - (list (list (car topic) 'visible))) - '(("misc"))))) - (setq gnus-topic-alist - (list (cons "misc" - (mapcar (lambda (info) (gnus-info-group info)) - (cdr gnus-newsrc-alist))) - (list "Gnus"))) - (gnus-topic-enter-dribble)) - -;;; Maintenance - -(defun gnus-topic-clean-alist () - "Remove bogus groups from the topic alist." - (let ((topic-alist gnus-topic-alist) - result topic) - (unless gnus-killed-hashtb - (gnus-make-hashtable-from-killed)) - (while (setq topic (pop topic-alist)) - (let ((topic-name (pop topic)) - group filtered-topic) - (while (setq group (pop topic)) - (when (and (or (gnus-gethash group gnus-active-hashtb) - (gnus-info-method (gnus-get-info group))) - (not (gnus-gethash group gnus-killed-hashtb))) - (push group filtered-topic))) - (push (cons topic-name (nreverse filtered-topic)) result))) - (setq gnus-topic-alist (nreverse result)))) - -(defun gnus-topic-change-level (group level oldlevel &optional previous) - "Run when changing levels to enter/remove groups from topics." - (save-excursion - (set-buffer gnus-group-buffer) - (unless gnus-topic-inhibit-change-level - (gnus-group-goto-group (or (car (nth 2 previous)) group)) - (when (and gnus-topic-mode - gnus-topic-alist - (not gnus-topic-inhibit-change-level)) - ;; Remove the group from the topics. - (if (and (< oldlevel gnus-level-zombie) - (>= level gnus-level-zombie)) - (let ((alist gnus-topic-alist)) - (while (gnus-group-goto-group group) - (gnus-delete-line)) - (while alist - (when (member group (car alist)) - (setcdr (car alist) (delete group (cdar alist)))) - (pop alist))) - ;; If the group is subscribed we enter it into the topics. - (when (and (< level gnus-level-zombie) - (>= oldlevel gnus-level-zombie)) - (let* ((prev (gnus-group-group-name)) - (gnus-topic-inhibit-change-level t) - (gnus-group-indentation - (make-string - (* gnus-topic-indent-level - (or (save-excursion - (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-group-topic-level)) - 0)) - ? )) - (yanked (list group)) - alist talist end) - ;; Then we enter the yanked groups into the topics they belong - ;; to. - (when (setq alist (assoc (save-excursion - (forward-line -1) - (or - (gnus-current-topic) - (caar gnus-topic-topology))) - gnus-topic-alist)) - (setq talist alist) - (when (stringp yanked) - (setq yanked (list yanked))) - (if (not prev) - (nconc alist yanked) - (if (not (cdr alist)) - (setcdr alist (nconc yanked (cdr alist))) - (while (and (not end) (cdr alist)) - (when (equal (cadr alist) prev) - (setcdr alist (nconc yanked (cdr alist))) - (setq end t)) - (setq alist (cdr alist))) - (unless end - (nconc talist yanked)))))) - (gnus-topic-update-topic))))))) - -(defun gnus-topic-goto-next-group (group props) - "Go to group or the next group after group." - (if (not group) - (if (not (memq 'gnus-topic props)) - (goto-char (point-max)) - (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props))))) - (if (gnus-group-goto-group group) - t - ;; The group is no longer visible. - (let* ((list (assoc (gnus-group-topic group) gnus-topic-alist)) - (after (cdr (member group (cdr list))))) - ;; First try to put point on a group after the current one. - (while (and after - (not (gnus-group-goto-group (car after)))) - (setq after (cdr after))) - ;; Then try to put point on a group before point. - (unless after - (setq after (cdr (member group (reverse (cdr list))))) - (while (and after - (not (gnus-group-goto-group (car after)))) - (setq after (cdr after)))) - ;; Finally, just put point on the topic. - (if (not (car list)) - (goto-char (point-min)) - (unless after - (gnus-topic-goto-topic (car list)) - (setq after nil))) - t)))) - -;;; Topic-active functions - -(defun gnus-topic-grok-active (&optional force) - "Parse all active groups and create topic structures for them." - ;; First we make sure that we have really read the active file. - (when (or force - (not gnus-topic-active-alist)) - (let (groups) - ;; Get a list of all groups available. - (mapatoms (lambda (g) (when (symbol-value g) - (push (symbol-name g) groups))) - gnus-active-hashtb) - (setq groups (sort groups 'string<)) - ;; Init the variables. - (setq gnus-topic-active-topology (list (list "" 'visible))) - (setq gnus-topic-active-alist nil) - ;; Descend the top-level hierarchy. - (gnus-topic-grok-active-1 gnus-topic-active-topology groups) - ;; Set the top-level topic names to something nice. - (setcar (car gnus-topic-active-topology) "Gnus active") - (setcar (car gnus-topic-active-alist) "Gnus active")))) - -(defun gnus-topic-grok-active-1 (topology groups) - (let* ((name (caar topology)) - (prefix (concat "^" (regexp-quote name))) - tgroups ntopology group) - (while (and groups - (string-match prefix (setq group (car groups)))) - (if (not (string-match "\\." group (match-end 0))) - ;; There are no further hierarchies here, so we just - ;; enter this group into the list belonging to this - ;; topic. - (push (pop groups) tgroups) - ;; New sub-hierarchy, so we add it to the topology. - (nconc topology (list (setq ntopology - (list (list (substring - group 0 (match-end 0)) - 'invisible))))) - ;; Descend the hierarchy. - (setq groups (gnus-topic-grok-active-1 ntopology groups)))) - ;; We remove the trailing "." from the topic name. - (setq name - (if (string-match "\\.$" name) - (substring name 0 (match-beginning 0)) - name)) - ;; Add this topic and its groups to the topic alist. - (push (cons name (nreverse tgroups)) gnus-topic-active-alist) - (setcar (car topology) name) - ;; We return the rest of the groups that didn't belong - ;; to this topic. - groups)) - -;;; Topic mode, commands and keymap. - -(defvar gnus-topic-mode-map nil) -(defvar gnus-group-topic-map nil) - -(unless gnus-topic-mode-map - (setq gnus-topic-mode-map (make-sparse-keymap)) - - ;; Override certain group mode keys. - (gnus-define-keys gnus-topic-mode-map - "=" gnus-topic-select-group - "\r" gnus-topic-select-group - " " gnus-topic-read-group - "\C-k" gnus-topic-kill-group - "\C-y" gnus-topic-yank-group - "\M-g" gnus-topic-get-new-news-this-topic - "AT" gnus-topic-list-active - "Gp" gnus-topic-edit-parameters - "#" gnus-topic-mark-topic - "\M-#" gnus-topic-unmark-topic - gnus-mouse-2 gnus-mouse-pick-topic) - - ;; Define a new submap. - (gnus-define-keys (gnus-group-topic-map "T" gnus-group-mode-map) - "#" gnus-topic-mark-topic - "\M-#" gnus-topic-unmark-topic - "n" gnus-topic-create-topic - "m" gnus-topic-move-group - "D" gnus-topic-remove-group - "c" gnus-topic-copy-group - "h" gnus-topic-hide-topic - "s" gnus-topic-show-topic - "M" gnus-topic-move-matching - "C" gnus-topic-copy-matching - "\C-i" gnus-topic-indent - [tab] gnus-topic-indent - "r" gnus-topic-rename - "\177" gnus-topic-delete - [delete] gnus-topic-delete - "h" gnus-topic-toggle-display-empty-topics) - - (gnus-define-keys (gnus-topic-sort-map "S" gnus-group-topic-map) - "s" gnus-topic-sort-groups - "a" gnus-topic-sort-groups-by-alphabet - "u" gnus-topic-sort-groups-by-unread - "l" gnus-topic-sort-groups-by-level - "v" gnus-topic-sort-groups-by-score - "r" gnus-topic-sort-groups-by-rank - "m" gnus-topic-sort-groups-by-method)) - -(defun gnus-topic-make-menu-bar () - (unless (boundp 'gnus-topic-menu) - (easy-menu-define - gnus-topic-menu gnus-topic-mode-map "" - '("Topics" - ["Toggle topics" gnus-topic-mode t] - ("Groups" - ["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]) - ("Topics" - ["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] - ["Mark" gnus-topic-mark-topic t] - ["Indent" gnus-topic-indent 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])))) - -(defun gnus-topic-mode (&optional arg redisplay) - "Minor mode for topicsifying Gnus group buffers." - (interactive (list current-prefix-arg t)) - (when (eq major-mode 'gnus-group-mode) - (make-local-variable 'gnus-topic-mode) - (setq gnus-topic-mode - (if (null arg) (not gnus-topic-mode) - (> (prefix-numeric-value arg) 0))) - ;; Infest Gnus with topics. - (if (not gnus-topic-mode) - (setq gnus-goto-missing-group-function nil) - (when (gnus-visual-p 'topic-menu 'menu) - (gnus-topic-make-menu-bar)) - (gnus-set-format 'topic t) - (gnus-add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map) - (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) - (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) - (set (make-local-variable 'gnus-group-prepare-function) - 'gnus-group-prepare-topics) - (set (make-local-variable 'gnus-group-get-parameter-function) - 'gnus-group-topic-parameters) - (set (make-local-variable 'gnus-group-goto-next-group-function) - 'gnus-topic-goto-next-group) - (set (make-local-variable 'gnus-group-indentation-function) - 'gnus-topic-group-indentation) - (set (make-local-variable 'gnus-group-update-group-function) - 'gnus-topic-update-topics-containing-group) - (set (make-local-variable 'gnus-group-sort-alist-function) - '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) - (setq gnus-topology-checked-p nil) - ;; We check the topology. - (when gnus-newsrc-alist - (gnus-topic-check-topology)) - (gnus-run-hooks 'gnus-topic-mode-hook)) - ;; Remove topic infestation. - (unless gnus-topic-mode - (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) - (remove-hook 'gnus-group-change-level-function - 'gnus-topic-change-level) - (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist) - (setq gnus-group-prepare-function 'gnus-group-prepare-flat) - (setq gnus-group-sort-alist-function 'gnus-group-sort-flat)) - (when redisplay - (gnus-group-list-groups)))) - -(defun gnus-topic-select-group (&optional all) - "Select this newsgroup. -No article is selected automatically. -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") - (if (gnus-group-topic-p) - (let ((gnus-group-list-mode - (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) - (gnus-topic-fold all)) - (gnus-group-select-group all))) - -(defun gnus-mouse-pick-topic (e) - "Select the group or topic under the mouse pointer." - (interactive "e") - (mouse-set-point e) - (gnus-topic-read-group nil)) - -(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 -readable. IF ALL is a number, fetch this number of articles. If the -optional argument NO-ARTICLE is non-nil, no article will be -auto-selected upon group entry. If GROUP is non-nil, fetch that -group. - -If performed over a topic line, toggle folding the topic." - (interactive "P") - (if (gnus-group-topic-p) - (let ((gnus-group-list-mode - (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) - (gnus-topic-fold all)) - (gnus-group-read-group all no-article group))) - -(defun gnus-topic-create-topic (topic parent &optional previous full-topic) - "Create a new TOPIC under PARENT. -When used interactively, PARENT will be the topic under point." - (interactive - (list - (read-string "New topic: ") - (gnus-current-topic))) - ;; Check whether this topic already exists. - (when (gnus-topic-find-topology topic) - (error "Topic already exists")) - (unless parent - (setq parent (caar gnus-topic-topology))) - (let ((top (cdr (gnus-topic-find-topology parent))) - (full-topic (or full-topic `((,topic visible))))) - (unless top - (error "No such parent topic: %s" parent)) - (if previous - (progn - (while (and (cdr top) - (not (equal (caaadr top) previous))) - (setq top (cdr top))) - (setcdr top (cons full-topic (cdr top)))) - (nconc top (list full-topic))) - (unless (assoc topic gnus-topic-alist) - (push (list topic) gnus-topic-alist))) - (gnus-topic-enter-dribble) - (gnus-group-list-groups) - (gnus-topic-goto-topic topic)) - -(defun gnus-topic-move-group (n topic &optional copyp) - "Move the next N groups to TOPIC. -If COPYP, copy the groups instead." - (interactive - (list current-prefix-arg - (completing-read "Move to topic: " gnus-topic-alist nil t))) - (let ((groups (gnus-group-process-prefix n)) - (topicl (assoc topic gnus-topic-alist)) - (start-group (progn (forward-line 1) (gnus-group-group-name))) - (start-topic (gnus-group-topic-name)) - entry) - (mapcar - (lambda (g) - (gnus-group-remove-mark g) - (when (and - (setq entry (assoc (gnus-current-topic) gnus-topic-alist)) - (not copyp)) - (setcdr entry (gnus-delete-first g (cdr entry)))) - (nconc topicl (list g))) - groups) - (gnus-topic-enter-dribble) - (if start-group - (gnus-group-goto-group start-group) - (gnus-topic-goto-topic start-topic)) - (gnus-group-list-groups))) - -(defun gnus-topic-remove-group (&optional arg) - "Remove the current group from the topic." - (interactive "P") - (gnus-group-iterate arg - (lambda (group) - (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) - (buffer-read-only nil)) - (when (and topicl group) - (gnus-delete-line) - (gnus-delete-first group topicl)) - (gnus-topic-update-topic) - (gnus-group-position-point))))) - -(defun gnus-topic-copy-group (n topic) - "Copy the current group to a topic." - (interactive - (list current-prefix-arg - (completing-read "Copy to topic: " gnus-topic-alist nil t))) - (gnus-topic-move-group n topic t)) - -(defun gnus-topic-kill-group (&optional n discard) - "Kill the next N groups." - (interactive "P") - (if (gnus-group-topic-p) - (let ((topic (gnus-group-topic-name))) - (push (cons - (gnus-topic-find-topology topic) - (assoc topic gnus-topic-alist)) - gnus-topic-killed-topics) - (gnus-topic-remove-topic nil t) - (gnus-topic-find-topology topic nil nil gnus-topic-topology) - (gnus-topic-enter-dribble)) - (gnus-group-kill-group n discard) - (gnus-topic-update-topic))) - -(defun gnus-topic-yank-group (&optional arg) - "Yank the last topic." - (interactive "p") - (if gnus-topic-killed-topics - (let* ((previous - (or (gnus-group-topic-name) - (gnus-topic-next-topic (gnus-current-topic)))) - (data (pop gnus-topic-killed-topics)) - (alist (cdr data)) - (item (cdar data))) - (push alist gnus-topic-alist) - (gnus-topic-create-topic - (caar item) (gnus-topic-parent-topic previous) previous - item) - (gnus-topic-enter-dribble) - (gnus-topic-goto-topic (caar item))) - (let* ((prev (gnus-group-group-name)) - (gnus-topic-inhibit-change-level t) - (gnus-group-indentation - (make-string - (* gnus-topic-indent-level - (or (save-excursion - (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-group-topic-level)) - 0)) - ? )) - yanked alist) - ;; We first yank the groups the normal way... - (setq yanked (gnus-group-yank-group arg)) - ;; Then we enter the yanked groups into the topics they belong - ;; to. - (setq alist (assoc (save-excursion - (forward-line -1) - (gnus-current-topic)) - gnus-topic-alist)) - (when (stringp yanked) - (setq yanked (list yanked))) - (if (not prev) - (nconc alist yanked) - (if (not (cdr alist)) - (setcdr alist (nconc yanked (cdr alist))) - (while (cdr alist) - (when (equal (cadr alist) prev) - (setcdr alist (nconc yanked (cdr alist))) - (setq alist nil)) - (setq alist (cdr alist)))))) - (gnus-topic-update-topic))) - -(defun gnus-topic-hide-topic () - "Hide the current topic." - (interactive) - (when (gnus-current-topic) - (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-topic-remove-topic nil nil 'hidden))) - -(defun gnus-topic-show-topic () - "Show the hidden topic." - (interactive) - (when (gnus-group-topic-p) - (gnus-topic-remove-topic t nil 'shown))) - -(defun gnus-topic-mark-topic (topic &optional unmark) - "Mark all groups in the topic with the process mark." - (interactive (list (gnus-group-topic-name))) - (if (not topic) - (call-interactively 'gnus-group-mark-group) - (save-excursion - (let ((groups (gnus-topic-find-groups topic gnus-level-killed t))) - (while groups - (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) - (gnus-info-group (nth 2 (pop groups))))))))) - -(defun gnus-topic-unmark-topic (topic &optional unmark) - "Remove the process mark from all groups in the topic." - (interactive (list (gnus-group-topic-name))) - (if (not topic) - (call-interactively 'gnus-group-unmark-group) - (gnus-topic-mark-topic topic t))) - -(defun gnus-topic-get-new-news-this-topic (&optional n) - "Check for new news in the current topic." - (interactive "P") - (if (not (gnus-group-topic-p)) - (gnus-group-get-new-news-this-group n) - (gnus-topic-mark-topic (gnus-group-topic-name)) - (gnus-group-get-new-news-this-group))) - -(defun gnus-topic-move-matching (regexp topic &optional copyp) - "Move all groups that match REGEXP to some topic." - (interactive - (let (topic) - (nreverse - (list - (setq topic (completing-read "Move to topic: " gnus-topic-alist nil t)) - (read-string (format "Move to %s (regexp): " topic)))))) - (gnus-group-mark-regexp regexp) - (gnus-topic-move-group nil topic copyp)) - -(defun gnus-topic-copy-matching (regexp topic &optional copyp) - "Copy all groups that match REGEXP to some topic." - (interactive - (let (topic) - (nreverse - (list - (setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t)) - (read-string (format "Copy to %s (regexp): " topic)))))) - (gnus-topic-move-matching regexp topic t)) - -(defun gnus-topic-delete (topic) - "Delete a topic." - (interactive (list (gnus-group-topic-name))) - (unless topic - (error "No topic to be deleted")) - (let ((entry (assoc topic gnus-topic-alist)) - (buffer-read-only nil)) - (when (cdr entry) - (error "Topic not empty")) - ;; Delete if visible. - (when (gnus-topic-goto-topic topic) - (gnus-delete-line)) - ;; Remove from alist. - (setq gnus-topic-alist (delq entry gnus-topic-alist)) - ;; Remove from topology. - (gnus-topic-find-topology topic nil nil 'delete) - (gnus-dribble-touch))) - -(defun gnus-topic-rename (old-name new-name) - "Rename a topic." - (interactive - (let ((topic (gnus-current-topic))) - (list topic - (read-string (format "Rename %s to: " topic))))) - ;; Check whether the new name exists. - (when (gnus-topic-find-topology new-name) - (error "Topic '%s' already exists")) - ;; Do the renaming. - (let ((top (gnus-topic-find-topology old-name)) - (entry (assoc old-name gnus-topic-alist))) - (when top - (setcar (cadr top) new-name)) - (when entry - (setcar entry new-name)) - (forward-line -1) - (gnus-dribble-touch) - (gnus-group-list-groups))) - -(defun gnus-topic-indent (&optional unindent) - "Indent a topic -- make it a sub-topic of the previous topic. -If UNINDENT, remove an indentation." - (interactive "P") - (if unindent - (gnus-topic-unindent) - (let* ((topic (gnus-current-topic)) - (parent (gnus-topic-previous-topic topic)) - (buffer-read-only nil)) - (unless parent - (error "Nothing to indent %s into" topic)) - (when topic - (gnus-topic-goto-topic topic) - (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)) - (pop gnus-topic-killed-topics) - (or (gnus-topic-goto-topic topic) - (gnus-topic-goto-topic parent)))))) - -(defun gnus-topic-unindent () - "Unindent a topic." - (interactive) - (let* ((topic (gnus-current-topic)) - (parent (gnus-topic-parent-topic topic)) - (grandparent (gnus-topic-parent-topic parent))) - (unless grandparent - (error "Nothing to indent %s into" topic)) - (when topic - (gnus-topic-goto-topic topic) - (gnus-topic-kill-group) - (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)) - (pop gnus-topic-killed-topics) - (gnus-topic-goto-topic topic)))) - -(defun gnus-topic-list-active (&optional force) - "List all groups that Gnus knows about in a topicsified fashion. -If FORCE, always re-read the active file." - (interactive "P") - (when force - (gnus-get-killed-groups)) - (gnus-topic-grok-active force) - (let ((gnus-topic-topology gnus-topic-active-topology) - (gnus-topic-alist gnus-topic-active-alist) - gnus-killed-list gnus-zombie-list) - (gnus-group-list-groups gnus-level-killed nil 1))) - -(defun gnus-topic-toggle-display-empty-topics () - "Show/hide topics that have no unread articles." - (interactive) - (setq gnus-topic-display-empty-topics - (not gnus-topic-display-empty-topics)) - (gnus-group-list-groups) - (message "%s empty topics" - (if gnus-topic-display-empty-topics - "Showing" "Hiding"))) - -;;; Topic sorting functions - -(defun gnus-topic-edit-parameters (group) - "Edit the group parameters of GROUP. -If performed on a topic, edit the topic parameters instead." - (interactive (list (gnus-group-group-name))) - (if group - (gnus-group-edit-group-parameters group) - (if (not (gnus-group-topic-p)) - (error "Nothing to edit on the current line") - (let ((topic (gnus-group-topic-name))) - (gnus-edit-form - (gnus-topic-parameters topic) - (format "Editing the topic parameters for `%s'." - (or group topic)) - `(lambda (form) - (gnus-topic-set-parameters ,topic form))))))) - -(defun gnus-group-sort-topic (func reverse) - "Sort groups in the topics according to FUNC and REVERSE." - (let ((alist gnus-topic-alist)) - (while alist - ;; !!!Sometimes nil elements sneak into the alist, - ;; for some reason or other. - (setcar alist (delq nil (car alist))) - (setcar alist (delete "dummy.group" (car alist))) - (gnus-topic-sort-topic (pop alist) func reverse)))) - -(defun gnus-topic-sort-topic (topic func reverse) - ;; Each topic only lists the name of the group, while - ;; the sort predicates expect group infos as inputs. - ;; So we first transform the group names into infos, - ;; then sort, and then transform back into group names. - (setcdr - topic - (mapcar - (lambda (info) (gnus-info-group info)) - (sort - (mapcar - (lambda (group) (gnus-get-info group)) - (cdr topic)) - func))) - ;; Do the reversal, if necessary. - (when reverse - (setcdr topic (nreverse (cdr topic))))) - -(defun gnus-topic-sort-groups (func &optional reverse) - "Sort the current topic according to FUNC. -If REVERSE, reverse the sorting order." - (interactive (list gnus-group-sort-function current-prefix-arg)) - (let ((topic (assoc (gnus-current-topic) gnus-topic-alist))) - (gnus-topic-sort-topic - topic (gnus-make-sort-function func) reverse) - (gnus-group-list-groups))) - -(defun gnus-topic-sort-groups-by-alphabet (&optional reverse) - "Sort the current topic alphabetically by group name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-alphabet reverse)) - -(defun gnus-topic-sort-groups-by-unread (&optional reverse) - "Sort the current topic by number of unread articles. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-unread reverse)) - -(defun gnus-topic-sort-groups-by-level (&optional reverse) - "Sort the current topic by group level. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-level reverse)) - -(defun gnus-topic-sort-groups-by-score (&optional reverse) - "Sort the current topic by group score. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-score reverse)) - -(defun gnus-topic-sort-groups-by-rank (&optional reverse) - "Sort the current topic by group rank. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-rank reverse)) - -(defun gnus-topic-sort-groups-by-method (&optional reverse) - "Sort the current topic alphabetically by backend name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-method reverse)) - -(provide 'gnus-topic) - -;;; gnus-topic.el ends here diff --git a/lisp/gnus-undo.el b/lisp/gnus-undo.el deleted file mode 100644 index 5321f3a..0000000 --- a/lisp/gnus-undo.el +++ /dev/null @@ -1,174 +0,0 @@ -;;; gnus-undo.el --- minor mode for undoing in Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This package allows arbitrary undoing in Gnus buffers. As all the -;; Gnus buffers aren't very text-oriented (what is in the buffers is -;; just some random representation of the actual data), normal Emacs -;; undoing doesn't work at all for Gnus. -;; -;; This package works by letting Gnus register functions for reversing -;; actions, and then calling these functions when the user pushes the -;; `undo' key. As with normal `undo', there it is possible to set -;; undo boundaries and so on. -;; -;; Internally, the undo sequence is represented by the -;; `gnus-undo-actions' list, where each element is a list of functions -;; to be called, in sequence, to undo some action. (An "action" is a -;; collection of functions.) -;; -;; For instance, a function for killing a group will call -;; `gnus-undo-register' with a function that un-kills the group. This -;; package will put that function into an action. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus-util) -(require 'gnus) - -(defvar gnus-undo-mode nil - "Minor mode for undoing in Gnus buffers.") - -(defvar gnus-undo-mode-hook nil - "Hook called in all `gnus-undo-mode' buffers.") - -;;; Internal variables. - -(defvar gnus-undo-actions nil) -(defvar gnus-undo-boundary t) -(defvar gnus-undo-last nil) -(defvar gnus-undo-boundary-inhibit nil) - -;;; Minor mode definition. - -(defvar gnus-undo-mode-map nil) - -(unless gnus-undo-mode-map - (setq gnus-undo-mode-map (make-sparse-keymap)) - - (gnus-define-keys gnus-undo-mode-map - "\M-\C-_" gnus-undo - "\C-_" gnus-undo - "\C-xu" gnus-undo - ;; many people are used to type `C-/' on X terminals and get `C-_'. - [(control /)] gnus-undo)) - -(defun gnus-undo-make-menu-bar () - ;; This is disabled for the time being. - (when nil - (define-key-after (current-local-map) [menu-bar file gnus-undo] - (cons "Undo" 'gnus-undo-actions) - [menu-bar file whatever]))) - -(defun gnus-undo-mode (&optional arg) - "Minor mode for providing `undo' in Gnus buffers. - -\\{gnus-undo-mode-map}" - (interactive "P") - (set (make-local-variable 'gnus-undo-mode) - (if (null arg) (not gnus-undo-mode) - (> (prefix-numeric-value arg) 0))) - (set (make-local-variable 'gnus-undo-actions) nil) - (set (make-local-variable 'gnus-undo-boundary) t) - (when gnus-undo-mode - ;; Set up the menu. - (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) - (add-hook 'post-command-hook 'gnus-undo-boundary nil t) - (gnus-run-hooks 'gnus-undo-mode-hook))) - -;;; Interface functions. - -(defun gnus-disable-undo (&optional buffer) - "Disable undoing in the current buffer." - (interactive) - (save-excursion - (when buffer - (set-buffer buffer)) - (gnus-undo-mode -1))) - -(defun gnus-undo-boundary () - "Set Gnus undo boundary." - (if gnus-undo-boundary-inhibit - (setq gnus-undo-boundary-inhibit nil) - (setq gnus-undo-boundary t))) - -(defun gnus-undo-force-boundary () - "Set Gnus undo boundary." - (setq gnus-undo-boundary-inhibit nil - gnus-undo-boundary t)) - -(defun gnus-undo-register (form) - "Register FORMS as something to be performed to undo a change. -FORMS may use backtick quote syntax." - (when gnus-undo-mode - (gnus-undo-register-1 - `(lambda () - ,form)))) - -(put 'gnus-undo-register 'lisp-indent-function 0) -(put 'gnus-undo-register 'edebug-form-spec '(body)) - -(defun gnus-undo-register-1 (function) - "Register FUNCTION as something to be performed to undo a change." - (when gnus-undo-mode - (cond - ;; We are on a boundary, so we create a new action. - (gnus-undo-boundary - (push (list function) gnus-undo-actions) - (setq gnus-undo-boundary nil)) - ;; Prepend the function to an old action. - (gnus-undo-actions - (setcar gnus-undo-actions (cons function (car gnus-undo-actions)))) - ;; Initialize list. - (t - (setq gnus-undo-actions (list (list function))))) - (setq gnus-undo-boundary-inhibit t))) - -(defun gnus-undo (n) - "Undo some previous changes in Gnus buffers. -Repeat this command to undo more changes. -A numeric argument serves as a repeat count." - (interactive "p") - (unless gnus-undo-mode - (error "Undoing is not enabled in this buffer")) - (message "%s" last-command) - (when (or (not (eq last-command 'gnus-undo)) - (not gnus-undo-last)) - (setq gnus-undo-last gnus-undo-actions)) - (let ((action (pop gnus-undo-last))) - (unless action - (error "Nothing further to undo")) - (setq gnus-undo-actions (delq action gnus-undo-actions)) - (setq gnus-undo-boundary t) - (while action - (funcall (pop action))))) - -(provide 'gnus-undo) - -;;; gnus-undo.el ends here diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el deleted file mode 100644 index cfdfa73..0000000 --- a/lisp/gnus-util.el +++ /dev/null @@ -1,913 +0,0 @@ -;;; gnus-util.el --- utility functions for Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Nothing in this file depends on any other parts of Gnus -- all -;; functions and macros in this file are utility functions that are -;; used by Gnus and may be used by any other package without loading -;; Gnus first. - -;;; Code: - -(require 'custom) -(eval-when-compile (require 'cl)) -(require 'nnheader) -(require 'timezone) -(require 'message) - -(eval-and-compile - (autoload 'nnmail-date-to-time "nnmail")) - -(defun gnus-boundp (variable) - "Return non-nil if VARIABLE is bound and non-nil." - (and (boundp variable) - (symbol-value variable))) - -(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"))) - `(let* ((,tempvar (selected-window)) - (,buf ,buffer) - (,w (get-buffer-window ,buf 'visible))) - (unwind-protect - (progn - (if ,w - (progn - (select-window ,w) - (set-buffer (window-buffer ,w))) - (pop-to-buffer ,buf)) - ,@forms) - (select-window ,tempvar))))) - -(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) -(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) - -(defmacro gnus-intern-safe (string hashtable) - "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." - `(let ((symbol (intern ,string ,hashtable))) - (or (boundp symbol) - (set symbol nil)) - symbol)) - -(defun gnus-truncate-string (str width) - (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". -(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))) - -(defmacro gnus-buffer-exists-p (buffer) - `(let ((buffer ,buffer)) - (when buffer - (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)))) - -(if (fboundp 'point-at-bol) - (fset 'gnus-point-at-bol 'point-at-bol) - (defun gnus-point-at-bol () - "Return point at the beginning of the line." - (let ((p (point))) - (beginning-of-line) - (prog1 - (point) - (goto-char p))))) - -(if (fboundp 'point-at-eol) - (fset 'gnus-point-at-eol 'point-at-eol) - (defun gnus-point-at-eol () - "Return point at the end of the line." - (let ((p (point))) - (end-of-line) - (prog1 - (point) - (goto-char p))))) - -(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) - (cdr list) - (let ((total list)) - (while (and (cdr list) - (not (equal (cadr list) elt))) - (setq list (cdr list))) - (when (cdr list) - (setcdr list (cddr list))) - total))) - -;; Delete the current line (and the next N lines). -(defmacro gnus-delete-line (&optional n) - `(delete-region (progn (beginning-of-line) (point)) - (progn (forward-line ,(or n 1)) (point)))) - -(defun gnus-byte-code (func) - "Return a form that can be `eval'ed based on FUNC." - (let ((fval (indirect-function func))) - (if (byte-code-function-p fval) - (let ((flist (append fval nil))) - (setcar flist 'byte-code) - flist) - (cons 'progn (cddr fval))))) - -(defun gnus-extract-address-components (from) - (let (name address) - ;; First find the address - the thing with the @ in it. This may - ;; not be accurate in mail addresses, but does the trick most of - ;; the time in news messages. - (when (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) - (setq address (substring from (match-beginning 0) (match-end 0)))) - ;; Then we check whether the "name

" format is used. - (and address - ;; Linear white space is not required. - (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) - (setq name (substring name 1 (1- (match-end 0)))))) - ;; If not, then "address (name)" is used. - (or name - (and (string-match "(.+)" from) - (setq name (substring from (1+ (match-beginning 0)) - (1- (match-end 0))))) - (and (string-match "()" from) - (setq name address)) - ;; XOVER might not support folded From headers. - (and (string-match "(.*" from) - (setq name (substring from (1+ (match-beginning 0)) - (match-end 0))))) - ;; Fix by Hallvard B Furuseth . - (list (or name from) (or address from)))) - -(defun gnus-fetch-field (field) - "Return the value of the header FIELD of current article." - (save-excursion - (save-restriction - (let ((case-fold-search t) - (inhibit-point-motion-hooks t)) - (nnheader-narrow-to-headers) - (message-fetch-field field))))) - -(defun gnus-goto-colon () - (beginning-of-line) - (search-forward ":" (gnus-point-at-eol) t)) - -(defun gnus-remove-text-with-property (prop) - "Delete all text in the current buffer with text property PROP." - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (while (get-text-property (point) prop) - (delete-char 1)) - (goto-char (next-single-property-change (point) prop nil (point-max)))))) - -(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)) - -(defun gnus-newsgroup-savable-name (group) - ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group) - ;; with dots. - (nnheader-replace-chars-in-string group ?/ ?.)) - -(defun gnus-string> (s1 s2) - (not (or (string< s1 s2) - (string= s1 s2)))) - -;;; Time functions. - -(defun gnus-days-between (date1 date2) - ;; Return the number of days between date1 and date2. - (- (gnus-day-number date1) (gnus-day-number date2))) - -(defun gnus-day-number (date) - (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) ) - (timezone-parse-date date)))) - (timezone-absolute-from-gregorian - (nth 1 dat) (nth 2 dat) (car dat)))) - -(defun gnus-time-to-day (time) - "Convert TIME to day number." - (let ((tim (decode-time time))) - (timezone-absolute-from-gregorian - (nth 4 tim) (nth 3 tim) (nth 5 tim)))) - -(defun gnus-encode-date (date) - "Convert DATE to internal time." - (let* ((parse (timezone-parse-date date)) - (date (mapcar (lambda (d) (and d (string-to-int d))) parse)) - (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3))))) - (encode-time (caddr time) (cadr time) (car time) - (caddr date) (cadr date) (car date) - (* 60 (timezone-zone-to-minute (nth 4 date)))))) - -(defun gnus-time-minus (t1 t2) - "Subtract two internal times." - (let ((borrow (< (cadr t1) (cadr t2)))) - (list (- (car t1) (car t2) (if borrow 1 0)) - (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) - -(defun gnus-time-less (t1 t2) - "Say whether time T1 is less than time T2." - (or (< (car t1) (car t2)) - (and (= (car t1) (car t2)) - (< (nth 1 t1) (nth 1 t2))))) - -(defun gnus-file-newer-than (file date) - (let ((fdate (nth 5 (file-attributes file)))) - (or (> (car fdate) (car date)) - (and (= (car fdate) (car date)) - (> (nth 1 fdate) (nth 1 date)))))) - -;;; Keymap macros. - -(defmacro gnus-local-set-keys (&rest plist) - "Set the keys in PLIST in the current keymap." - `(gnus-define-keys-1 (current-local-map) ',plist)) - -(defmacro gnus-define-keys (keymap &rest plist) - "Define all keys in PLIST in KEYMAP." - `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) - -(defmacro gnus-define-keys-safe (keymap &rest plist) - "Define all keys in PLIST in KEYMAP without overwriting previous definitions." - `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t)) - -(put 'gnus-define-keys 'lisp-indent-function 1) -(put 'gnus-define-keys-safe 'lisp-indent-function 1) -(put 'gnus-local-set-keys 'lisp-indent-function 1) - -(defmacro gnus-define-keymap (keymap &rest plist) - "Define all keys in PLIST in KEYMAP." - `(gnus-define-keys-1 ,keymap (quote ,plist))) - -(put 'gnus-define-keymap 'lisp-indent-function 1) - -(defun gnus-define-keys-1 (keymap plist &optional safe) - (when (null keymap) - (error "Can't set keys in a null keymap")) - (cond ((symbolp keymap) - (setq keymap (symbol-value keymap))) - ((keymapp keymap)) - ((listp keymap) - (set (car keymap) nil) - (define-prefix-command (car keymap)) - (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap)) - (setq keymap (symbol-value (car keymap))))) - (let (key) - (while plist - (when (symbolp (setq key (pop plist))) - (setq key (symbol-value key))) - (if (or (not safe) - (eq (lookup-key keymap key) 'undefined)) - (define-key keymap key (pop plist)) - (pop plist))))) - -(defun gnus-completing-read (default prompt &rest args) - ;; Like `completing-read', except that DEFAULT is the default argument. - (let* ((prompt (if default - (concat prompt " (default " default ") ") - (concat prompt " "))) - (answer (apply 'completing-read prompt args))) - (if (or (null answer) (zerop (length answer))) - default - answer))) - -;; Two silly functions to ensure that all `y-or-n-p' questions clear -;; the echo area. -(defun gnus-y-or-n-p (prompt) - (prog1 - (y-or-n-p prompt) - (message ""))) - -(defun gnus-yes-or-no-p (prompt) - (prog1 - (yes-or-no-p prompt) - (message ""))) - -;; I suspect there's a better way, but I haven't taken the time to do -;; it yet. -erik selberg@cs.washington.edu -(defun gnus-dd-mmm (messy-date) - "Return a string like DD-MMM from a big messy string" - (let ((datevec (ignore-errors (timezone-parse-date messy-date)))) - (if (not datevec) - "??-???" - (format "%2s-%s" - (condition-case () - ;; Make sure leading zeroes are stripped. - (number-to-string (string-to-number (aref datevec 2))) - (error "??")) - (capitalize - (or (car - (nth (1- (string-to-number (aref datevec 1))) - timezone-months-assoc)) - "???")))))) - -(defmacro gnus-date-get-time (date) - "Convert DATE string to Emacs time. -Cache the result as a text property stored in DATE." - ;; Either return the cached value... - `(let ((d ,date)) - (if (equal "" d) - '(0 0) - (or (get-text-property 0 'gnus-time d) - ;; or compute the value... - (let ((time (nnmail-date-to-time d))) - ;; and store it back in the string. - (put-text-property 0 1 'gnus-time time d) - time))))) - -(defsubst gnus-time-iso8601 (time) - "Return a string of TIME in YYMMDDTHHMMSS format." - (format-time-string "%Y%m%dT%H%M%S" time)) - -(defun gnus-date-iso8601 (header) - "Convert the date field in HEADER to YYMMDDTHHMMSS" - (condition-case () - (gnus-time-iso8601 (gnus-date-get-time (mail-header-date header))) - (error ""))) - -(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))) - -;; Make a hash table (default and minimum size is 256). -;; Optional argument HASHSIZE specifies the table size. -(defun gnus-make-hashtable (&optional hashsize) - (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 256) 256) 0)) - -;; Make a number that is suitable for hashing; bigger than MIN and -;; equal to some 2^x. Many machines (such as sparcs) do not have a -;; hardware modulo operation, so they implement it in software. On -;; many sparcs over 50% of the time to intern is spent in the modulo. -;; Yes, it's slower than actually computing the hash from the string! -;; So we use powers of 2 so people can optimize the modulo to a mask. -(defun gnus-create-hash-size (min) - (let ((i 1)) - (while (< i min) - (setq i (* 2 i))) - i)) - -(defcustom gnus-verbose 7 - "*Integer that says how verbose Gnus should be. -The higher the number, the more messages Gnus will flash to say what -it's doing. At zero, Gnus will be totally mute; at five, Gnus will -display most important messages; and at ten, Gnus will keep on -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 gnus-verbose) - (apply 'message args) - ;; We have to do this format thingy here even if the result isn't - ;; shown - the return value has to be the same as the return value - ;; from `message'. - (apply 'format args))) - -(defun gnus-error (level &rest args) - "Beep an error if LEVEL is equal to or less than `gnus-verbose'." - (when (<= (floor level) gnus-verbose) - (apply 'message args) - (ding) - (let (duration) - (when (and (floatp level) - (not (zerop (setq duration (* 10 (- level (floor level))))))) - (sit-for duration)))) - nil) - -(defun gnus-split-references (references) - "Return a list of Message-IDs in REFERENCES." - (let ((beg 0) - ids) - (while (string-match "<[^>]+>" references beg) - (push (substring references (match-beginning 0) (setq beg (match-end 0))) - ids)) - (nreverse ids))) - -(defun 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) - "Say whether BUFFER is alive or not." - (and buffer - (get-buffer buffer) - (buffer-name (get-buffer buffer)))) - -(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) - (let* ((orig (point)) - (end (window-end (get-buffer-window (current-buffer) t))) - (max 0)) - ;; Find the longest line currently displayed in the window. - (goto-char (window-start)) - (while (and (not (eobp)) - (< (point) end)) - (end-of-line) - (setq max (max max (current-column))) - (forward-line 1)) - (goto-char orig) - ;; Scroll horizontally to center (sort of) the point. - (if (> max (window-width)) - (set-window-hscroll - (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)) - max))) - -(defun gnus-read-event-char () - "Get the next event." - (let ((event (read-event))) - ;; should be gnus-characterp, but this can't be called in XEmacs anyway - (cons (and (numberp event) event) event))) - -(defun gnus-sortable-date (date) - "Make sortable string by string-lessp from DATE. -Timezone package is used." - (condition-case () - (progn - (setq date (inline (timezone-fix-time - date nil - (aref (inline (timezone-parse-date date)) 4)))) - (inline - (timezone-make-sortable-date - (aref date 0) (aref date 1) (aref date 2) - (inline - (timezone-make-time-string - (aref date 3) (aref date 4) (aref date 5)))))) - (error ""))) - -(defun gnus-copy-file (file &optional to) - "Copy FILE to TO." - (interactive - (list (read-file-name "Copy file: " default-directory) - (read-file-name "Copy file to: " default-directory))) - (unless to - (setq to (read-file-name "Copy file to: " default-directory))) - (when (file-directory-p to) - (setq to (concat (file-name-as-directory to) - (file-name-nondirectory file)))) - (copy-file file to)) - -(defun gnus-kill-all-overlays () - "Delete all overlays in the current buffer." - (let* ((overlayss (overlay-lists)) - (buffer-read-only nil) - (overlays (delq nil (nconc (car overlayss) (cdr overlayss))))) - (while overlays - (delete-overlay (pop overlays))))) - -(defvar gnus-work-buffer " *gnus work*") - -(defun gnus-set-work-buffer () - "Put point in the empty Gnus work buffer." - (if (get-buffer gnus-work-buffer) - (progn - (set-buffer gnus-work-buffer) - (erase-buffer)) - (set-buffer (get-buffer-create gnus-work-buffer)) - (kill-all-local-variables) - (buffer-disable-undo (current-buffer)))) - -(defmacro gnus-group-real-name (group) - "Find the real name of a foreign newsgroup." - `(let ((gname ,group)) - (if (string-match "^[^:]+:" gname) - (substring gname (match-end 0)) - gname))) - -(defun gnus-make-sort-function (funs) - "Return a composite sort condition based on the functions in FUNC." - (cond - ((not (listp funs)) funs) - ((null funs) funs) - ((cdr funs) - `(lambda (t1 t2) - ,(gnus-make-sort-function-1 (reverse funs)))) - (t - (car funs)))) - -(defun gnus-make-sort-function-1 (funs) - "Return a composite sort condition based on the functions in FUNC." - (if (cdr funs) - `(or (,(car funs) t1 t2) - (and (not (,(car funs) t2 t1)) - ,(gnus-make-sort-function-1 (cdr funs)))) - `(,(car funs) t1 t2))) - -(defun gnus-turn-off-edit-menu (type) - "Turn off edit menu in `gnus-TYPE-mode-map'." - (define-key (symbol-value (intern (format "gnus-%s-mode-map" type))) - [menu-bar edit] 'undefined)) - -(defun gnus-prin1 (form) - "Use `prin1' on FORM in the current buffer. -Bind `print-quoted' and `print-readably' to t while printing." - (let ((print-quoted t) - (print-readably t) - print-level print-length) - (prin1 form (current-buffer)))) - -(defun gnus-prin1-to-string (form) - "The same as `prin1', but bind `print-quoted' and `print-readably' to t." - (let ((print-quoted t) - (print-readably t)) - (prin1-to-string form))) - -(defun gnus-make-directory (directory) - "Make DIRECTORY (and all its parents) if it doesn't exist." - (when (and directory - (not (file-exists-p directory))) - (make-directory directory t)) - t) - -(defun gnus-write-buffer (file) - "Write the current buffer's contents to FILE." - ;; Make sure the directory exists. - (gnus-make-directory (file-name-directory file)) - ;; Write the buffer. - (write-region (point-min) (point-max) file nil 'quietly)) - -(defmacro gnus-delete-assq (key list) - `(let ((listval (eval ,list))) - (setq ,list (delq (assq ,key listval) listval)))) - -(defmacro gnus-delete-assoc (key list) - `(let ((listval ,list)) - (setq ,list (delq (assoc ,key listval) listval)))) - -(defun gnus-delete-file (file) - "Delete FILE if it exists." - (when (file-exists-p file) - (delete-file file))) - -(defun gnus-strip-whitespace (string) - "Return STRING stripped of all whitespace." - (while (string-match "[\r\n\t ]+" string) - (setq string (replace-match "" t t string))) - string) - -(defun gnus-put-text-property-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 "[ \t]*\n" end 'move) - (put-text-property beg (match-beginning 0) prop val) - (setq beg (point))) - (put-text-property beg (point) prop val))))) - -;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996 -;;; The primary idea here is to try to protect internal datastructures -;;; from becoming corrupted when the user hits C-g, or if a hook or -;;; similar blows up. Often in Gnus multiple tables/lists need to be -;;; updated at the same time, or information can be lost. - -(defvar gnus-atomic-be-safe t - "If t, certain operations will be protected from interruption by C-g.") - -(defmacro gnus-atomic-progn (&rest forms) - "Evaluate FORMS atomically, which means to protect the evaluation -from being interrupted by the user. An error from the forms themselves -will return without finishing the operation. Since interrupts from -the user are disabled, it is recommended that only the most minimal -operations are performed by FORMS. If you wish to assign many -complicated values atomically, compute the results into temporary -variables and then do only the assignment atomically." - `(let ((inhibit-quit gnus-atomic-be-safe)) - ,@forms)) - -(put 'gnus-atomic-progn 'lisp-indent-function 0) - -(defmacro gnus-atomic-progn-assign (protect &rest forms) - "Evaluate FORMS, but insure that the variables listed in PROTECT -are not changed if anything in FORMS signals an error or otherwise -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 -non-local exit, it will still be unbound." - (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol - (concat (symbol-name x) - "-tmp")) - x)) - protect)) - (sym-temp-map (mapcar (lambda (x) (list (cadr x) (car x))) - temp-sym-map)) - (temp-sym-let (mapcar (lambda (x) (list (car x) - `(and (boundp ',(cadr x)) - ,(cadr x)))) - temp-sym-map)) - (sym-temp-let sym-temp-map) - (temp-sym-assign (apply 'append temp-sym-map)) - (sym-temp-assign (apply 'append sym-temp-map)) - (result (make-symbol "result-tmp"))) - `(let (,@temp-sym-let - ,result) - (let ,sym-temp-let - (setq ,result (progn ,@forms)) - (setq ,@temp-sym-assign)) - (let ((inhibit-quit gnus-atomic-be-safe)) - (setq ,@sym-temp-assign)) - ,result))) - -(put 'gnus-atomic-progn-assign 'lisp-indent-function 1) -;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body)) - -(defmacro gnus-atomic-setq (&rest pairs) - "Similar to setq, except that the real symbols are only assigned when -there are no errors. And when the real symbols are assigned, they are -done so atomically. If other variables might be changed via side-effect, -see gnus-atomic-progn-assign. It is safe to use gnus-atomic-setq -with potentially long computations." - (let ((tpairs pairs) - syms) - (while tpairs - (push (car tpairs) syms) - (setq tpairs (cddr tpairs))) - `(gnus-atomic-progn-assign ,syms - (setq ,@pairs)))) - -;(put 'gnus-atomic-setq 'edebug-form-spec '(body)) - - -;;; Functions for saving to babyl/mail files. - -(defvar rmail-default-rmail-file) -(defun gnus-output-to-rmail (filename &optional ask) - "Append the current article to an Rmail file named FILENAME." - (require 'rmail) - ;; Most of these codes are borrowed from rmailout.el. - (setq filename (expand-file-name filename)) - (setq rmail-default-rmail-file filename) - (let ((artbuf (current-buffer)) - (tmpbuf (get-buffer-create " *Gnus-output*"))) - (save-excursion - (or (get-file-buffer filename) - (file-exists-p filename) - (if (or (not ask) - (gnus-yes-or-no-p - (concat "\"" filename "\" does not exist, create it? "))) - (let ((file-buffer (create-file-buffer filename))) - (save-excursion - (set-buffer file-buffer) - (rmail-insert-rmail-file-header) - (let ((require-final-newline nil)) - (gnus-write-buffer filename))) - (kill-buffer file-buffer)) - (error "Output file does not exist"))) - (set-buffer tmpbuf) - (erase-buffer) - (insert-buffer-substring artbuf) - (gnus-convert-article-to-rmail) - ;; Decide whether to append to a file or to an Emacs buffer. - (let ((outbuf (get-file-buffer filename))) - (if (not outbuf) - (append-to-file (point-min) (point-max) filename) - ;; File has been visited, in buffer OUTBUF. - (set-buffer outbuf) - (let ((buffer-read-only nil) - (msg (and (boundp 'rmail-current-message) - (symbol-value 'rmail-current-message)))) - ;; If MSG is non-nil, buffer is in RMAIL mode. - (when msg - (widen) - (narrow-to-region (point-max) (point-max))) - (insert-buffer-substring tmpbuf) - (when msg - (goto-char (point-min)) - (widen) - (search-backward "\^_") - (narrow-to-region (point) (point-max)) - (goto-char (1+ (point-min))) - (rmail-count-new-messages t) - (rmail-show-message msg)) - (save-buffer))))) - (kill-buffer tmpbuf))) - -(defun gnus-output-to-mail (filename &optional ask) - "Append the current article to a mail file named FILENAME." - (setq filename (expand-file-name filename)) - (let ((artbuf (current-buffer)) - (tmpbuf (get-buffer-create " *Gnus-output*"))) - (save-excursion - ;; Create the file, if it doesn't exist. - (when (and (not (get-file-buffer filename)) - (not (file-exists-p filename))) - (if (or (not ask) - (gnus-y-or-n-p - (concat "\"" filename "\" does not exist, create it? "))) - (let ((file-buffer (create-file-buffer filename))) - (save-excursion - (set-buffer file-buffer) - (let ((require-final-newline nil)) - (gnus-write-buffer filename))) - (kill-buffer file-buffer)) - (error "Output file does not exist"))) - (set-buffer tmpbuf) - (erase-buffer) - (insert-buffer-substring artbuf) - (goto-char (point-min)) - (if (looking-at "From ") - (forward-line 1) - (insert "From nobody " (current-time-string) "\n")) - (let (case-fold-search) - (while (re-search-forward "^From " nil t) - (beginning-of-line) - (insert ">"))) - ;; Decide whether to append to a file or to an Emacs buffer. - (let ((outbuf (get-file-buffer filename))) - (if (not outbuf) - (let ((buffer-read-only nil)) - (save-excursion - (goto-char (point-max)) - (forward-char -2) - (unless (looking-at "\n\n") - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (insert "\n")) - (goto-char (point-max)) - (append-to-file (point-min) (point-max) filename))) - ;; File has been visited, in buffer OUTBUF. - (set-buffer outbuf) - (let ((buffer-read-only nil)) - (goto-char (point-max)) - (unless (eobp) - (insert "\n")) - (insert "\n") - (insert-buffer-substring tmpbuf))))) - (kill-buffer tmpbuf))) - -(defun gnus-convert-article-to-rmail () - "Convert article in current buffer to Rmail message format." - (let ((buffer-read-only nil)) - ;; Convert article directly into Babyl format. - (goto-char (point-min)) - (insert "\^L\n0, unseen,,\n*** EOOH ***\n") - (while (search-forward "\n\^_" nil t) ;single char - (replace-match "\n^_" t t)) ;2 chars: "^" and "_" - (goto-char (point-max)) - (insert "\^_"))) - -(defun gnus-map-function (funs arg) - "Applies the result of the first function in FUNS to the second, and so on. -ARG is passed to the first function." - (let ((myfuns funs) - (myarg arg)) - (while myfuns - (setq arg (funcall (pop myfuns) arg))) - arg)) - -(defun gnus-run-hooks (&rest funcs) - "Does the same as `run-hooks', but saves excursion." - (save-excursion - (apply 'run-hooks funcs))) - -;;; -;;; .netrc and .authinforc parsing -;;; - -(defvar gnus-netrc-syntax-table - (let ((table (copy-syntax-table text-mode-syntax-table))) - (modify-syntax-entry ?- "w" table) - (modify-syntax-entry ?_ "w" table) - (modify-syntax-entry ?! "w" table) - (modify-syntax-entry ?. "w" table) - (modify-syntax-entry ?, "w" table) - (modify-syntax-entry ?: "w" table) - (modify-syntax-entry ?\; "w" table) - (modify-syntax-entry ?% "w" table) - (modify-syntax-entry ?) "w" table) - (modify-syntax-entry ?( "w" table) - table) - "Syntax table when parsing .netrc files.") - -(defun gnus-parse-netrc (file) - "Parse FILE and return an list of all entries in the file." - (if (not (file-exists-p file)) - () - (save-excursion - (let ((tokens '("machine" "default" "login" - "password" "account" "macdef")) - alist elem result pair) - (nnheader-set-temp-buffer " *netrc*") - (set-syntax-table gnus-netrc-syntax-table) - (insert-file-contents file) - (goto-char (point-min)) - ;; Go through the file, line by line. - (while (not (eobp)) - (narrow-to-region (point) (gnus-point-at-eol)) - ;; For each line, get the tokens and values. - (while (not (eobp)) - (skip-chars-forward "\t ") - (unless (eobp) - (setq elem (buffer-substring - (point) (progn (forward-sexp 1) (point)))) - (if (member elem tokens) - (progn - ;; Tokens that don't have a following value are ignored. - (when (and pair (cdr pair)) - (push pair alist)) - (setq pair (list elem))) - ;; Values that haven't got a preceding token are ignored. - (when pair - (setcdr pair elem) - (push pair alist) - (setq pair nil))))) - (push alist result) - (setq alist nil - pair nil) - (widen) - (forward-line 1)) - result)))) - -(defun gnus-netrc-machine (list machine) - "Return the netrc values from LIST for MACHINE." - (while (and list - (not (equal (cdr (assoc "machine" (car list))) machine))) - (pop list)) - (when list - (car list))) - -(defun gnus-netrc-get (alist type) - "Return the value of token TYPE from ALIST." - (cdr (assoc type alist))) - -(provide 'gnus-util) - -;;; gnus-util.el ends here diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el deleted file mode 100644 index 8ef81dc..0000000 --- a/lisp/gnus-uu.el +++ /dev/null @@ -1,2042 +0,0 @@ -;;; gnus-uu.el --- extract (uu)encoded files in Gnus -;; Copyright (C) 1985,86,87,93,94,95,96,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Created: 2 Oct 1993 -;; Keyword: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-art) -(require 'message) -(require 'gnus-msg) - -(defgroup gnus-extract nil - "Extracting encoded files." - :prefix "gnus-uu-" - :group 'gnus) - -(defgroup gnus-extract-view nil - "Viewwing extracted files." - :group 'gnus-extract) - -(defgroup gnus-extract-archive nil - "Extracting encoded archives." - :group 'gnus-extract) - -(defgroup gnus-extract-post nil - "Extracting encoded archives." - :prefix "gnus-uu-post" - :group 'gnus-extract) - -;; Default viewing action rules - -(defcustom gnus-uu-default-view-rules - '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g") - ("\\.pas$" "cat %s | sed s/\r//g") - ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") - ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") - ("\\.tga$" "tgatoppm %s | xv -") - ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" - "sox -v .5 %s -t .au -u - > /dev/audio") - ("\\.au$" "cat %s > /dev/audio") - ("\\.midi?$" "playmidi -f") - ("\\.mod$" "str32") - ("\\.ps$" "ghostview") - ("\\.dvi$" "xdvi") - ("\\.html$" "xmosaic") - ("\\.mpe?g$" "mpeg_play") - ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") - ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" - "gnus-uu-archive")) - "*Default actions to be taken when the user asks to view a file. -To change the behaviour, you can either edit this variable or set -`gnus-uu-user-view-rules' to something useful. - -For example: - -To make gnus-uu use 'xli' to display JPEG and GIF files, put the -following in your .emacs file: - - (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\"))) - -Both these variables are lists of lists with two string elements. The -first string is a regular expression. If the file name matches this -regular expression, the command in the second string is executed with -the file as an argument. - -If the command string contains \"%s\", the file name will be inserted -at that point in the command string. If there's no \"%s\" in the -command string, the file name will be appended to the command string -before executing. - -There are several user variables to tailor the behaviour of gnus-uu to -your needs. First we have `gnus-uu-user-view-rules', which is the -variable gnus-uu first consults when trying to decide how to view a -file. If this variable contains no matches, gnus-uu examines the -default rule variable provided in this package. If gnus-uu finds no -match here, it uses `gnus-uu-user-view-rules-end' to try to make a -match." - :group 'gnus-extract-view - :type '(repeat (group regexp (string :tag "Command")))) - -(defcustom gnus-uu-user-view-rules nil - "*What actions are to be taken to view a file. -See the documentation on the `gnus-uu-default-view-rules' variable for -details." - :group 'gnus-extract-view - :type '(repeat (group regexp (string :tag "Command")))) - -(defcustom gnus-uu-user-view-rules-end - '(("" "file")) - "*What actions are to be taken if no rule matched the file name. -See the documentation on the `gnus-uu-default-view-rules' variable for -details." - :group 'gnus-extract-view - :type '(repeat (group regexp (string :tag "Command")))) - -;; Default unpacking commands - -(defcustom gnus-uu-default-archive-rules - '(("\\.tar$" "tar xf") - ("\\.zip$" "unzip -o") - ("\\.ar$" "ar x") - ("\\.arj$" "unarj x") - ("\\.zoo$" "zoo -e") - ("\\.\\(lzh\\|lha\\)$" "lha x") - ("\\.Z$" "uncompress") - ("\\.gz$" "gunzip") - ("\\.arc$" "arc -x")) - "*See `gnus-uu-user-archive-rules'." - :group 'gnus-extract-archive - :type '(repeat (group regexp (string :tag "Command")))) - -(defvar gnus-uu-destructive-archivers - (list "uncompress" "gunzip")) - -(defcustom gnus-uu-user-archive-rules nil - "*A list that can be set to override the default archive unpacking commands. -To use, for instance, 'untar' to unpack tar files and 'zip -x' to -unpack zip files, say the following: - (setq gnus-uu-user-archive-rules - '((\"\\\\.tar$\" \"untar\") - (\"\\\\.zip$\" \"zip -x\")))" - :group 'gnus-extract-archive - :type '(repeat (group regexp (string :tag "Command")))) - -(defcustom gnus-uu-ignore-files-by-name nil - "*A regular expression saying what files should not be viewed based on name. -If, for instance, you want gnus-uu to ignore all .au and .wav files, -you could say something like - - (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\") - -Note that this variable can be used in conjunction with the -`gnus-uu-ignore-files-by-type' variable." - :group 'gnus-extract - :type '(choice (const :tag "off" nil) - (regexp :format "%v"))) - -(defcustom gnus-uu-ignore-files-by-type nil - "*A regular expression saying what files that shouldn't be viewed, based on MIME file type. -If, for instance, you want gnus-uu to ignore all audio files and all mpegs, -you could say something like - - (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\") - -Note that this variable can be used in conjunction with the -`gnus-uu-ignore-files-by-name' variable." - :group 'gnus-extract - :type '(choice (const :tag "off" nil) - (regexp :format "%v"))) - -;; Pseudo-MIME support - -(defconst gnus-uu-ext-to-mime-list - '(("\\.gif$" "image/gif") - ("\\.jpe?g$" "image/jpeg") - ("\\.tiff?$" "image/tiff") - ("\\.xwd$" "image/xwd") - ("\\.pbm$" "image/pbm") - ("\\.pgm$" "image/pgm") - ("\\.ppm$" "image/ppm") - ("\\.xbm$" "image/xbm") - ("\\.pcx$" "image/pcx") - ("\\.tga$" "image/tga") - ("\\.ps$" "image/postscript") - ("\\.fli$" "video/fli") - ("\\.wav$" "audio/wav") - ("\\.aiff$" "audio/aiff") - ("\\.hcom$" "audio/hcom") - ("\\.voc$" "audio/voc") - ("\\.smp$" "audio/smp") - ("\\.mod$" "audio/mod") - ("\\.dvi$" "image/dvi") - ("\\.mpe?g$" "video/mpeg") - ("\\.au$" "audio/basic") - ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain") - ("\\.\\(c\\|h\\)$" "text/source") - ("read.*me" "text/plain") - ("\\.html$" "text/html") - ("\\.bat$" "text/bat") - ("\\.[1-6]$" "text/man") - ("\\.flc$" "video/flc") - ("\\.rle$" "video/rle") - ("\\.pfx$" "video/pfx") - ("\\.avi$" "video/avi") - ("\\.sme$" "video/sme") - ("\\.rpza$" "video/prza") - ("\\.dl$" "video/dl") - ("\\.qt$" "video/qt") - ("\\.rsrc$" "video/rsrc") - ("\\..*$" "unknown/unknown"))) - -;; Various variables users may set - -(defcustom gnus-uu-tmp-dir "/tmp/" - "*Variable saying where gnus-uu is to do its work. -Default is \"/tmp/\"." - :group 'gnus-extract - :type 'directory) - -(defcustom gnus-uu-do-not-unpack-archives nil - "*Non-nil means that gnus-uu won't peek inside archives looking for files to display. -Default is nil." - :group 'gnus-extract-archive - :type 'boolean) - -(defcustom gnus-uu-ignore-default-view-rules nil - "*Non-nil means that gnus-uu will ignore the default viewing rules. -Only the user viewing rules will be consulted. Default is nil." - :group 'gnus-extract-view - :type 'boolean) - -(defcustom gnus-uu-grabbed-file-functions nil - "*Functions run on each file after successful decoding. -They will be called with the name of the file as the argument. -Likely functions you can use in this list are `gnus-uu-grab-view' -and `gnus-uu-grab-move'." - :group 'gnus-extract - :options '(gnus-uu-grab-view gnus-uu-grab-move) - :type 'hook) - -(defcustom gnus-uu-ignore-default-archive-rules nil - "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. -Only the user unpacking commands will be consulted. Default is nil." - :group 'gnus-extract-archive - :type 'boolean) - -(defcustom gnus-uu-kill-carriage-return t - "*Non-nil means that gnus-uu will strip all carriage returns from articles. -Default is t." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-view-with-metamail nil - "*Non-nil means that files will be viewed with metamail. -The gnus-uu viewing functions will be ignored and gnus-uu will try -to guess at a content-type based on file name suffixes. Default -it nil." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-unmark-articles-not-decoded nil - "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. -Default is nil." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-correct-stripped-uucode nil - "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. -Default is nil." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-save-in-digest nil - "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. -If this variable is nil, gnus-uu will just save everything in a -file without any embellishments. The digesting almost conforms to RFC1153 - -no easy way to specify any meaningful volume and issue numbers were found, -so I simply dropped them." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-pre-uudecode-hook nil - "*Hook run before sending a message to uudecode." - :group 'gnus-extract - :type 'hook) - -(defcustom gnus-uu-digest-headers - '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" - "^Summary:" "^References:") - "*List of regexps to match headers included in digested messages. -The headers will be included in the sequence they are matched." - :group 'gnus-extract - :type '(repeat regexp)) - -(defcustom gnus-uu-save-separate-articles nil - "*Non-nil means that gnus-uu will save articles in separate files." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-be-dangerous 'ask - "*Specifies what to do if unusual situations arise during decoding. -If nil, be as conservative as possible. If t, ignore things that -didn't work, and overwrite existing files. Otherwise, ask each time." - :group 'gnus-extract - :type '(choice (const :tag "conservative" nil) - (const :tag "ask" ask) - (const :tag "liberal" t))) - -;; Internal variables - -(defvar gnus-uu-saved-article-name nil) - -(defvar gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") -(defvar gnus-uu-end-string "^end[ \t]*$") - -(defvar gnus-uu-body-line "^M") -(let ((i 61)) - (while (> (setq i (1- i)) 0) - (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]"))) - (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$"))) - -;"^M.............................................................?$" - -(defvar gnus-uu-shar-begin-string "^#! */bin/sh") - -(defvar gnus-uu-shar-file-name nil) -(defvar gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)") - -(defvar gnus-uu-postscript-begin-string "^%!PS-") -(defvar gnus-uu-postscript-end-string "^%%EOF$") - -(defvar gnus-uu-file-name nil) -(defvar gnus-uu-uudecode-process nil) -(defvar gnus-uu-binhex-article-name nil) - -(defvar gnus-uu-work-dir nil) - -(defvar gnus-uu-output-buffer-name " *Gnus UU Output*") - -(defvar gnus-uu-default-dir gnus-article-save-directory) -(defvar gnus-uu-digest-from-subject 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 - "R" gnus-uu-mark-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-uu-extract-mime - "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) - "Uudecodes the current article." - (interactive "P") - (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n)) - -(defun gnus-uu-decode-uu-and-save (n dir) - "Decodes and saves the resulting file." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Uudecode and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t)) - -(defun gnus-uu-decode-unshar (&optional n) - "Unshars the current article." - (interactive "P") - (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t)) - -(defun gnus-uu-decode-unshar-and-save (n dir) - "Unshars and saves the current article." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Unshar and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan t)) - -(defun gnus-uu-decode-save (n file) - "Saves the current article." - (interactive - (list current-prefix-arg - (read-file-name - (if gnus-uu-save-separate-articles - "Save articles is dir: " - "Save articles in file: ") - gnus-uu-default-dir - gnus-uu-default-dir))) - (setq gnus-uu-saved-article-name file) - (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t)) - -(defun gnus-uu-decode-binhex (n dir) - "Unbinhexes the current article." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Unbinhex 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"))) - (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) - -(defun gnus-uu-decode-uu-view (&optional n) - "Uudecodes and views the current article." - (interactive "P") - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-uu n))) - -(defun gnus-uu-decode-uu-and-save-view (n dir) - "Decodes, views and saves the resulting file." - (interactive - (list current-prefix-arg - (read-file-name "Uudecode, view and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-uu-and-save n dir))) - -(defun gnus-uu-decode-unshar-view (&optional n) - "Unshars and views the current article." - (interactive "P") - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-unshar n))) - -(defun gnus-uu-decode-unshar-and-save-view (n dir) - "Unshars and saves the current article." - (interactive - (list current-prefix-arg - (read-file-name "Unshar, view and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-unshar-and-save n dir))) - -(defun gnus-uu-decode-save-view (n file) - "Saves and views the current article." - (interactive - (list current-prefix-arg - (read-file-name (if gnus-uu-save-separate-articles - "Save articles is dir: " - "Save articles in file: ") - gnus-uu-default-dir gnus-uu-default-dir))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-save n file))) - -(defun gnus-uu-decode-binhex-view (n file) - "Unbinhexes and views the current article." - (interactive - (list current-prefix-arg - (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"))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-binhex n file))) - - -;; Digest and forward articles - -(defun gnus-uu-digest-mail-forward (&optional n post) - "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"))) - buf subject from newsgroups) - (gnus-setup-message 'forward - (setq gnus-uu-digest-from-subject nil) - (gnus-uu-decode-save n file) - (setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*"))) - (gnus-add-current-to-buffer-list) - (erase-buffer) - (insert-file file) - (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)) - (message-forward post)) - (delete-file file) - (kill-buffer buf) - (setq gnus-uu-digest-from-subject nil))) - -(defun gnus-uu-digest-post-forward (&optional n) - "Digest and forward to a newsgroup." - (interactive "P") - (gnus-uu-digest-mail-forward n t)) - -;; Process marking. - -(defun gnus-uu-mark-by-regexp (regexp &optional unmark) - "Ask for a regular expression and set the process mark on all articles that match." - (interactive (list (read-from-minibuffer "Mark (regexp): "))) - (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 "")) - (gnus-summary-position-point)) - -(defun gnus-uu-unmark-by-regexp (regexp &optional unmark) - "Ask for a regular expression and remove the process mark on all articles that match." - (interactive (list (read-from-minibuffer "Mark (regexp): "))) - (gnus-uu-mark-by-regexp regexp t)) - -(defun gnus-uu-mark-series () - "Mark the current series with the process mark." - (interactive) - (let ((articles (gnus-uu-find-articles-matching))) - (while articles - (gnus-summary-set-process-mark (car articles)) - (setq articles (cdr articles))) - (message "")) - (gnus-summary-position-point)) - -(defun gnus-uu-mark-region (beg end &optional unmark) - "Set the process mark on all articles between point and mark." - (interactive "r") - (save-excursion - (goto-char beg) - (while (< (point) end) - (if unmark - (gnus-summary-remove-process-mark (gnus-summary-article-number)) - (gnus-summary-set-process-mark (gnus-summary-article-number))) - (forward-line 1))) - (gnus-summary-position-point)) - -(defun gnus-uu-unmark-region (beg end) - "Remove the process mark from all articles between point and mark." - (interactive "r") - (gnus-uu-mark-region beg end t)) - -(defun gnus-uu-mark-buffer () - "Set the process mark on all articles in the buffer." - (interactive) - (gnus-uu-mark-region (point-min) (point-max))) - -(defun gnus-uu-unmark-buffer () - "Remove the process mark on all articles in the buffer." - (interactive) - (gnus-uu-mark-region (point-min) (point-max) t)) - -(defun gnus-uu-mark-thread () - "Marks all articles downwards in this thread." - (interactive) - (let ((level (gnus-summary-thread-level))) - (while (and (gnus-summary-set-process-mark (gnus-summary-article-number)) - (zerop (gnus-summary-next-subject 1)) - (> (gnus-summary-thread-level) level)))) - (gnus-summary-position-point)) - -(defun gnus-uu-unmark-thread () - "Unmarks all articles downwards in this thread." - (interactive) - (let ((level (gnus-summary-thread-level))) - (while (and (gnus-summary-remove-process-mark - (gnus-summary-article-number)) - (zerop (gnus-summary-next-subject 1)) - (> (gnus-summary-thread-level) level)))) - (gnus-summary-position-point)) - -(defun gnus-uu-invert-processable () - "Invert the list of process-marked articles." - (interactive) - (let ((data gnus-newsgroup-data) - d number) - (save-excursion - (while data - (if (memq (setq number (gnus-data-number (pop data))) - gnus-newsgroup-processable) - (gnus-summary-remove-process-mark number) - (gnus-summary-set-process-mark number))))) - (gnus-summary-position-point)) - -(defun gnus-uu-mark-over (&optional score) - "Mark all articles with a score over SCORE (the prefix.)" - (interactive "P") - (let ((score (gnus-score-default score)) - (data gnus-newsgroup-data)) - (save-excursion - (while data - (when (> (or (cdr (assq (gnus-data-number (car data)) - gnus-newsgroup-scored)) - gnus-summary-default-score 0) - score) - (gnus-summary-set-process-mark (caar data))) - (setq data (cdr data)))) - (gnus-summary-position-point))) - -(defun gnus-uu-mark-sparse () - "Mark all series that have some articles marked." - (interactive) - (let ((marked (nreverse gnus-newsgroup-processable)) - subject articles total headers) - (unless marked - (error "No articles marked with the process mark")) - (setq gnus-newsgroup-processable nil) - (save-excursion - (while marked - (and (vectorp (setq headers - (gnus-summary-article-header (car marked)))) - (setq subject (mail-header-subject headers) - articles (gnus-uu-find-articles-matching - (gnus-uu-reginize-string subject)) - total (nconc total articles))) - (while articles - (gnus-summary-set-process-mark (car articles)) - (setcdr marked (delq (car articles) (cdr marked))) - (setq articles (cdr articles))) - (setq marked (cdr marked))) - (setq gnus-newsgroup-processable (nreverse total))) - (gnus-summary-position-point))) - -(defun gnus-uu-mark-all () - "Mark all articles in \"series\" order." - (interactive) - (setq gnus-newsgroup-processable nil) - (save-excursion - (let ((data gnus-newsgroup-data) - number) - (while data - (when (and (not (memq (setq number (gnus-data-number (car data))) - gnus-newsgroup-processable)) - (vectorp (gnus-data-header (car data)))) - (gnus-summary-goto-subject number) - (gnus-uu-mark-series)) - (setq data (cdr data))))) - (gnus-summary-position-point)) - -;; All PostScript functions written by Erik Selberg . - -(defun gnus-uu-decode-postscript (&optional n) - "Gets postscript of the current article." - (interactive "P") - (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n)) - -(defun gnus-uu-decode-postscript-view (&optional n) - "Gets and views the current article." - (interactive "P") - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-postscript n))) - -(defun gnus-uu-decode-postscript-and-save (n dir) - "Extracts postscript and saves the current article." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article - n dir nil nil t)) - -(defun gnus-uu-decode-postscript-and-save-view (n dir) - "Decodes, views and saves the resulting file." - (interactive - (list current-prefix-arg - (read-file-name "Where do you want to save the file(s)? " - gnus-uu-default-dir - gnus-uu-default-dir t))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-postscript-and-save n dir))) - - -;; Internal functions. - -(defun gnus-uu-decode-with-method (method n &optional save not-insert - scan cdir) - (gnus-uu-initialize scan) - (when save - (setq gnus-uu-default-dir save)) - ;; Create the directory we save to. - (when (and scan cdir save - (not (file-exists-p save))) - (make-directory save t)) - (let ((articles (gnus-uu-get-list-of-articles n)) - files) - (setq files (gnus-uu-grab-articles articles method t)) - (let ((gnus-current-article (car articles))) - (when scan - (setq files (gnus-uu-scan-directory gnus-uu-work-dir)))) - (when save - (gnus-uu-save-files files save)) - (when (eq gnus-uu-do-not-unpack-archives nil) - (setq files (gnus-uu-unpack-files files))) - (setq files (nreverse (gnus-uu-get-actions files))) - (or not-insert (not gnus-insert-pseudo-articles) - (gnus-summary-insert-pseudos files save)))) - -(defun gnus-uu-scan-directory (dir &optional rec) - "Return a list of all files under DIR." - (let ((files (directory-files dir t)) - out file) - (while (setq file (pop files)) - (unless (member (file-name-nondirectory file) '("." "..")) - (push (list (cons 'name file) - (cons 'article gnus-current-article)) - out) - (when (file-directory-p file) - (setq out (nconc (gnus-uu-scan-directory file t) out))))) - (if rec - out - (nreverse out)))) - -(defun gnus-uu-save-files (files dir) - "Save FILES in DIR." - (let ((len (length files)) - (reg (concat "^" (regexp-quote gnus-uu-work-dir))) - to-file file fromdir) - (while (setq file (cdr (assq 'name (pop files)))) - (when (file-exists-p file) - (string-match reg file) - (setq fromdir (substring file (match-end 0))) - (if (file-directory-p file) - (gnus-make-directory (concat dir fromdir)) - (setq to-file (concat dir fromdir)) - (when (or (not (file-exists-p to-file)) - (eq gnus-uu-be-dangerous t) - (and gnus-uu-be-dangerous - (gnus-y-or-n-p (format "%s exists; overwrite? " - to-file)))) - (copy-file file to-file t t))))) - (gnus-message 5 "Saved %d file%s" len (if (= len 1) "" "s")))) - -;; Functions for saving and possibly digesting articles without -;; any decoding. - -;; Function called by gnus-uu-grab-articles to treat each article. -(defun gnus-uu-save-article (buffer in-state) - (cond - (gnus-uu-save-separate-articles - (save-excursion - (set-buffer buffer) - (gnus-write-buffer - (concat gnus-uu-saved-article-name gnus-current-article)) - (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) - ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name - 'begin 'end)) - ((eq in-state 'last) (list 'end)) - (t (list 'middle))))) - ((not gnus-uu-save-in-digest) - (save-excursion - (set-buffer buffer) - (write-region (point-min) (point-max) gnus-uu-saved-article-name t) - (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) - ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name - 'begin 'end)) - ((eq in-state 'last) (list 'end)) - (t (list 'middle))))) - (t - (let ((header (gnus-summary-article-header))) - (push (cons (mail-header-from header) - (mail-header-subject header)) - gnus-uu-digest-from-subject)) - (let ((name (file-name-nondirectory gnus-uu-saved-article-name)) - (delim (concat "^" (make-string 30 ?-) "$")) - beg subj headers headline sorthead body end-string state) - (if (or (eq in-state 'first) - (eq in-state 'first-and-last)) - (progn - (setq state (list 'begin)) - (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*")) - (erase-buffer)) - (save-excursion - (set-buffer (get-buffer-create "*gnus-uu-pre*")) - (erase-buffer) - (insert (format - "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" - (current-time-string) name name)))) - (when (not (eq in-state 'end)) - (setq state (list 'middle)))) - (save-excursion - (set-buffer (get-buffer "*gnus-uu-body*")) - (goto-char (setq beg (point-max))) - (save-excursion - (save-restriction - (set-buffer buffer) - (let (buffer-read-only) - (gnus-set-text-properties (point-min) (point-max) nil) - ;; These two are necessary for XEmacs 19.12 fascism. - (put-text-property (point-min) (point-max) 'invisible nil) - (put-text-property (point-min) (point-max) 'intangible nil)) - (goto-char (point-min)) - (re-search-forward "\n\n") - ;; Quote all 30-dash lines. - (save-excursion - (while (re-search-forward "^-" nil t) - (beginning-of-line) - (delete-char 1) - (insert "- "))) - (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))) - (while headers - (setq headline (car headers)) - (setq headers (cdr headers)) - (goto-char (point-min)) - (while (re-search-forward headline nil t) - (setq sorthead - (concat sorthead - (buffer-substring - (match-beginning 0) - (or (and (re-search-forward "^[^ \t]" nil t) - (1- (point))) - (progn (forward-line 1) (point))))))))) - (widen))) - (insert sorthead) (goto-char (point-max)) - (insert body) (goto-char (point-max)) - (insert (concat "\n" (make-string 30 ?-) "\n\n")) - (goto-char beg) - (when (re-search-forward "^Subject: \\(.*\\)$" nil t) - (setq subj (buffer-substring (match-beginning 1) (match-end 1))) - (save-excursion - (set-buffer (get-buffer "*gnus-uu-pre*")) - (insert (format " %s\n" subj))))) - (when (or (eq in-state 'last) - (eq in-state 'first-and-last)) - (save-excursion - (set-buffer (get-buffer "*gnus-uu-pre*")) - (insert (format "\n\n%s\n\n" (make-string 70 ?-))) - (gnus-write-buffer gnus-uu-saved-article-name)) - (save-excursion - (set-buffer (get-buffer "*gnus-uu-body*")) - (goto-char (point-max)) - (insert - (concat (setq end-string (format "End of %s Digest" name)) - "\n")) - (insert (concat (make-string (length end-string) ?*) "\n")) - (write-region - (point-min) (point-max) gnus-uu-saved-article-name t)) - (kill-buffer (get-buffer "*gnus-uu-pre*")) - (kill-buffer (get-buffer "*gnus-uu-body*")) - (push 'end state)) - (if (memq 'begin state) - (cons gnus-uu-saved-article-name state) - state))))) - -;; Binhex treatment - not very advanced. - -(defvar gnus-uu-binhex-body-line - "^[^:]...............................................................$") -(defvar gnus-uu-binhex-begin-line - "^:...............................................................$") -(defvar gnus-uu-binhex-end-line - ":$") - -(defun gnus-uu-binhex-article (buffer in-state) - (let (state start-char) - (save-excursion - (set-buffer buffer) - (widen) - (goto-char (point-min)) - (when (not (re-search-forward gnus-uu-binhex-begin-line nil t)) - (when (not (re-search-forward gnus-uu-binhex-body-line nil t)) - (setq state (list 'wrong-type)))) - - (if (memq 'wrong-type state) - () - (beginning-of-line) - (setq start-char (point)) - (if (looking-at gnus-uu-binhex-begin-line) - (progn - (setq state (list 'begin)) - (write-region 1 1 gnus-uu-binhex-article-name)) - (setq state (list 'middle))) - (goto-char (point-max)) - (re-search-backward (concat gnus-uu-binhex-body-line "\\|" - gnus-uu-binhex-end-line) - nil t) - (when (looking-at gnus-uu-binhex-end-line) - (setq state (if (memq 'begin state) - (cons 'end state) - (list 'end)))) - (beginning-of-line) - (forward-line 1) - (when (file-exists-p gnus-uu-binhex-article-name) - (append-to-file start-char (point) gnus-uu-binhex-article-name)))) - (if (memq 'begin state) - (cons gnus-uu-binhex-article-name state) - state))) - -;; PostScript - -(defun gnus-uu-decode-postscript-article (process-buffer in-state) - (let ((state (list 'ok)) - start-char end-char file-name) - (save-excursion - (set-buffer process-buffer) - (goto-char (point-min)) - (if (not (re-search-forward gnus-uu-postscript-begin-string nil t)) - (setq state (list 'wrong-type)) - (beginning-of-line) - (setq start-char (point)) - (if (not (re-search-forward gnus-uu-postscript-end-string nil t)) - (setq state (list 'wrong-type)) - (setq end-char (point)) - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (insert-buffer-substring process-buffer start-char end-char) - (setq file-name (concat gnus-uu-work-dir - (cdr gnus-article-current) ".ps")) - (write-region (point-min) (point-max) file-name) - (setq state (list file-name 'begin 'end))))) - state)) - - -;; Find actions. - -(defun gnus-uu-get-actions (files) - (let ((ofiles files) - action name) - (while files - (setq name (cdr (assq 'name (car files)))) - (and - (setq action (gnus-uu-get-action name)) - (setcar files (nconc (list (if (string= action "gnus-uu-archive") - (cons 'action "file") - (cons 'action action)) - (cons 'execute (gnus-uu-command - action name))) - (car files)))) - (setq files (cdr files))) - ofiles)) - -(defun gnus-uu-get-action (file-name) - (let (action) - (setq action - (gnus-uu-choose-action - file-name - (append - gnus-uu-user-view-rules - (if gnus-uu-ignore-default-view-rules - nil - gnus-uu-default-view-rules) - gnus-uu-user-view-rules-end))) - (when (and (not (string= (or action "") "gnus-uu-archive")) - gnus-uu-view-with-metamail) - (when (setq action - (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)) - (setq action (format "metamail -d -b -c \"%s\"" action)))) - action)) - - -;; Functions for treating subjects and collecting series. - -(defun gnus-uu-reginize-string (string) - ;; Takes a string and puts a \ in front of every special character; - ;; ignores any leading "version numbers" thingies that they use in - ;; the comp.binaries groups, and either replaces anything that looks - ;; like "2/3" with "[0-9]+/[0-9]+" or, if it can't find something - ;; like that, replaces the last two numbers with "[0-9]+". This, in - ;; my experience, should get most postings of a series. - (let ((count 2) - (vernum "v[0-9]+[a-z][0-9]+:") - beg) - (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert (regexp-quote string)) - (setq beg 1) - - (setq case-fold-search nil) - (goto-char (point-min)) - (when (looking-at vernum) - (replace-match vernum t t) - (setq beg (length vernum))) - - (goto-char beg) - (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t) - (replace-match " [0-9]+/[0-9]+") - - (goto-char beg) - (if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t) - (replace-match "[0-9]+ of [0-9]+") - - (end-of-line) - (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+" - nil t) - (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil)))) - - (goto-char beg) - (while (re-search-forward "[ \t]+" nil t) - (replace-match "[ \t]*" t t)) - - (buffer-substring 1 (point-max))))) - -(defun gnus-uu-get-list-of-articles (n) - ;; If N is non-nil, the article numbers of the N next articles - ;; will be returned. - ;; If any articles have been marked as processable, they will be - ;; returned. - ;; Failing that, articles that have subjects that are part of the - ;; same "series" as the current will be returned. - (let (articles) - (cond - (n - (setq n (prefix-numeric-value n)) - (let ((backward (< n 0)) - (n (abs n))) - (save-excursion - (while (and (> n 0) - (push (gnus-summary-article-number) - articles) - (gnus-summary-search-forward nil nil backward)) - (setq n (1- n)))) - (nreverse articles))) - (gnus-newsgroup-processable - (reverse gnus-newsgroup-processable)) - (t - (gnus-uu-find-articles-matching))))) - -(defun gnus-uu-string< (l1 l2) - (string< (car l1) (car l2))) - -(defun gnus-uu-find-articles-matching - (&optional subject only-unread do-not-translate) - ;; Finds all articles that matches the regexp SUBJECT. If it is - ;; nil, the current article name will be used. If ONLY-UNREAD is - ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is - ;; non-nil, article names are not equalized before sorting. - (let ((subject (or subject - (gnus-uu-reginize-string (gnus-summary-article-subject)))) - list-of-subjects) - (save-excursion - (if (not subject) - () - ;; Collect all subjects matching subject. - (let ((case-fold-search t) - (data gnus-newsgroup-data) - subj mark d) - (while data - (setq d (pop data)) - (and (not (gnus-data-pseudo-p d)) - (or (not only-unread) - (= (setq mark (gnus-data-mark d)) - gnus-unread-mark) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark)) - (setq subj (mail-header-subject (gnus-data-header d))) - (string-match subject subj) - (push (cons subj (gnus-data-number d)) - list-of-subjects)))) - - ;; Expand numbers, sort, and return the list of article - ;; numbers. - (mapcar (lambda (sub) (cdr sub)) - (sort (gnus-uu-expand-numbers - list-of-subjects - (not do-not-translate)) - 'gnus-uu-string<)))))) - -(defun gnus-uu-expand-numbers (string-list &optional translate) - ;; Takes a list of strings and "expands" all numbers in all the - ;; strings. That is, this function makes all numbers equal length by - ;; prepending lots of zeroes before each number. This is to ease later - ;; sorting to find out what sequence the articles are supposed to be - ;; decoded in. Returns the list of expanded strings. - (let ((out-list string-list) - string) - (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (buffer-disable-undo (current-buffer)) - (while string-list - (erase-buffer) - (insert (caar string-list)) - ;; Translate multiple spaces to one space. - (goto-char (point-min)) - (while (re-search-forward "[ \t]+" nil t) - (replace-match " ")) - ;; Translate all characters to "a". - (goto-char (point-min)) - (when translate - (while (re-search-forward "[A-Za-z]" nil t) - (replace-match "a" t t))) - ;; 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)))))) - (setq string (buffer-substring 1 (point-max))) - (setcar (car string-list) string) - (setq string-list (cdr string-list)))) - out-list)) - - -;; `gnus-uu-grab-articles' is the general multi-article treatment -;; function. It takes a list of articles to be grabbed and a function -;; to apply to each article. -;; -;; The function to be called should take two parameters. The first -;; parameter is the article buffer. The function should leave the -;; result, if any, in this buffer. Most treatment functions will just -;; generate files... -;; -;; The second parameter is the state of the list of articles, and can -;; have four values: `first', `middle', `last' and `first-and-last'. -;; -;; The function should return a list. The list may contain the -;; following symbols: -;; `error' if an error occurred -;; `begin' if the beginning of an encoded file has been received -;; If the list returned contains a `begin', the first element of -;; the list *must* be a string with the file name of the decoded -;; file. -;; `end' if the end of an encoded file has been received -;; `middle' if the article was a body part of an encoded file -;; `wrong-type' if the article was not a part of an encoded file -;; `ok', which can be used everything is ok - -(defvar gnus-uu-has-been-grabbed nil) - -(defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article) - (let (art) - (if (not (and gnus-uu-has-been-grabbed - gnus-uu-unmark-articles-not-decoded)) - () - (when dont-unmark-last-article - (setq art (car gnus-uu-has-been-grabbed)) - (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) - (while gnus-uu-has-been-grabbed - (gnus-summary-tick-article (car gnus-uu-has-been-grabbed) t) - (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) - (when dont-unmark-last-article - (setq gnus-uu-has-been-grabbed (list art)))))) - -;; This function takes a list of articles and a function to apply to -;; each article grabbed. -;; -;; This function returns a list of files decoded if the grabbing and -;; the process-function has been successful and nil otherwise. -(defun gnus-uu-grab-articles (articles process-function - &optional sloppy limit no-errors) - (let ((state 'first) - (gnus-asynchronous nil) - has-been-begin article result-file result-files process-state - gnus-summary-display-article-function - gnus-article-display-hook gnus-article-prepare-hook - article-series files) - - (while (and articles - (not (memq 'error process-state)) - (or sloppy - (not (memq 'end process-state)))) - - (setq article (pop articles)) - (push article article-series) - - (unless articles - (if (eq state 'first) - (setq state 'first-and-last) - (setq state 'last))) - - (let ((part (gnus-uu-part-number article))) - (gnus-message 6 "Getting article %d%s..." - article (if (string= part "") "" (concat ", " part)))) - (gnus-summary-display-article article) - - ;; Push the article to the processing function. - (save-excursion - (set-buffer gnus-original-article-buffer) - (let ((buffer-read-only nil)) - (save-excursion - (set-buffer gnus-summary-buffer) - (setq process-state - (funcall process-function - gnus-original-article-buffer state))))) - - (gnus-summary-remove-process-mark article) - - ;; If this is the beginning of a decoded file, we push it - ;; on to a list. - (when (or (memq 'begin process-state) - (and (or (eq state 'first) - (eq state 'first-and-last)) - (memq 'ok process-state))) - (when has-been-begin - ;; If there is a `result-file' here, that means that the - ;; file was unsuccessfully decoded, so we delete it. - (when (and result-file - (file-exists-p result-file) - (not gnus-uu-be-dangerous) - (or (eq gnus-uu-be-dangerous t) - (gnus-y-or-n-p - (format "Delete unsuccessfully decoded file %s" - result-file)))) - (delete-file result-file))) - (when (memq 'begin process-state) - (setq result-file (car process-state))) - (setq has-been-begin t)) - - ;; Check whether we have decoded one complete file. - (when (memq 'end process-state) - (setq article-series nil) - (setq has-been-begin nil) - (if (stringp result-file) - (setq files (list result-file)) - (setq files result-file)) - (setq result-file (car files)) - (while files - (push (list (cons 'name (pop files)) - (cons 'article article)) - result-files)) - ;; Allow user-defined functions to be run on this file. - (when gnus-uu-grabbed-file-functions - (let ((funcs gnus-uu-grabbed-file-functions)) - (unless (listp funcs) - (setq funcs (list funcs))) - (while funcs - (funcall (pop funcs) result-file)))) - (setq result-file nil) - ;; Check whether we have decoded enough articles. - (and limit (= (length result-files) limit) - (setq articles nil))) - - ;; If this is the last article to be decoded, and - ;; we still haven't reached the end, then we delete - ;; the partially decoded file. - (and (or (eq state 'last) (eq state 'first-and-last)) - (not (memq 'end process-state)) - result-file - (file-exists-p result-file) - (not gnus-uu-be-dangerous) - (or (eq gnus-uu-be-dangerous t) - (gnus-y-or-n-p (format "Delete incomplete file %s? " result-file))) - (delete-file result-file)) - - ;; If this was a file of the wrong sort, then - (when (and (or (memq 'wrong-type process-state) - (memq 'error process-state)) - gnus-uu-unmark-articles-not-decoded) - (gnus-summary-tick-article article t)) - - ;; Set the new series state. - (if (and (not has-been-begin) - (not sloppy) - (or (memq 'end process-state) - (memq 'middle process-state))) - (progn - (setq process-state (list 'error)) - (gnus-message 2 "No begin part at the beginning") - (sleep-for 2)) - (setq state 'middle))) - - ;; When there are no result-files, then something must be wrong. - (if result-files - (message "") - (cond - ((not has-been-begin) - (gnus-message 2 "Wrong type file")) - ((memq 'error process-state) - (gnus-message 2 "An error occurred during decoding")) - ((not (or (memq 'ok process-state) - (memq 'end process-state))) - (gnus-message 2 "End of articles reached before end of file"))) - ;; Make unsuccessfully decoded articles unread. - (when gnus-uu-unmark-articles-not-decoded - (while article-series - (gnus-summary-tick-article (pop article-series) t)))) - - result-files)) - -(defun gnus-uu-grab-view (file) - "View FILE using the gnus-uu methods." - (let ((action (gnus-uu-get-action file))) - (gnus-execute-command - (if (string-match "%" action) - (format action file) - (concat action " " file)) - (eq gnus-view-pseudos 'not-confirm)))) - -(defun gnus-uu-grab-move (file) - "Move FILE to somewhere." - (when gnus-uu-default-dir - (let ((to-file (concat (file-name-as-directory gnus-uu-default-dir) - (file-name-nondirectory file)))) - (rename-file file to-file) - (unless (file-exists-p file) - (make-symbolic-link to-file file))))) - -(defun gnus-uu-part-number (article) - (let* ((header (gnus-summary-article-header article)) - (subject (and header (mail-header-subject header)))) - (if (and subject - (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject)) - (match-string 0 subject) - ""))) - -(defun gnus-uu-uudecode-sentinel (process event) - (delete-process (get-process process))) - -(defun gnus-uu-uustrip-article (process-buffer in-state) - ;; Uudecodes a file asynchronously. - (save-excursion - (set-buffer process-buffer) - (let ((state (list 'wrong-type)) - process-connection-type case-fold-search buffer-read-only - files start-char) - (goto-char (point-min)) - - ;; Deal with ^M at the end of the lines. - (when gnus-uu-kill-carriage-return - (save-excursion - (while (search-forward "\r" nil t) - (delete-backward-char 1)))) - - (while (or (re-search-forward gnus-uu-begin-string nil t) - (re-search-forward gnus-uu-body-line nil t)) - (setq state (list 'ok)) - ;; Ok, we are at the first uucoded line. - (beginning-of-line) - (setq start-char (point)) - - (if (not (looking-at gnus-uu-begin-string)) - (setq state (list 'middle)) - ;; This is the beginning of a uuencoded article. - ;; We replace certain characters that could make things messy. - (setq gnus-uu-file-name - (let ((nnheader-file-name-translation-alist - '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) - (nnheader-translate-file-chars (match-string 1)))) - (replace-match (concat "begin 644 " gnus-uu-file-name) t t) - - ;; Remove any non gnus-uu-body-line right after start. - (forward-line 1) - (while (and (not (eobp)) - (not (looking-at gnus-uu-body-line))) - (gnus-delete-line)) - - ;; If a process is running, we kill it. - (when (and gnus-uu-uudecode-process - (memq (process-status gnus-uu-uudecode-process) - '(run stop))) - (delete-process gnus-uu-uudecode-process) - (gnus-uu-unmark-list-of-grabbed t)) - - ;; Start a new uudecoding process. - (let ((cdir default-directory)) - (unwind-protect - (progn - (cd gnus-uu-work-dir) - (setq gnus-uu-uudecode-process - (start-process - "*uudecode*" - (get-buffer-create gnus-uu-output-buffer-name) - shell-file-name shell-command-switch - (format "cd %s %s uudecode" gnus-uu-work-dir - gnus-shell-command-separator)))) - (cd cdir))) - (set-process-sentinel - gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) - (setq state (list 'begin)) - (push (concat gnus-uu-work-dir gnus-uu-file-name) files)) - - ;; We look for the end of the thing to be decoded. - (if (re-search-forward gnus-uu-end-string nil t) - (push 'end state) - (goto-char (point-max)) - (re-search-backward gnus-uu-body-line nil t)) - - (forward-line 1) - - (when gnus-uu-uudecode-process - (when (memq (process-status gnus-uu-uudecode-process) '(run stop)) - ;; Try to correct mishandled uucode. - (when gnus-uu-correct-stripped-uucode - (gnus-uu-check-correct-stripped-uucode start-char (point))) - (gnus-run-hooks 'gnus-uu-pre-uudecode-hook) - - ;; Send the text to the process. - (condition-case nil - (process-send-region - gnus-uu-uudecode-process start-char (point)) - (error - (progn - (delete-process gnus-uu-uudecode-process) - (gnus-message 2 "gnus-uu: Couldn't uudecode") - (setq state (list 'wrong-type))))) - - (if (memq 'end state) - (progn - ;; Send an EOF, just in case. - (ignore-errors - (process-send-eof gnus-uu-uudecode-process)) - (while (memq (process-status gnus-uu-uudecode-process) - '(open run)) - (accept-process-output gnus-uu-uudecode-process 1))) - (when (or (not gnus-uu-uudecode-process) - (not (memq (process-status gnus-uu-uudecode-process) - '(run stop)))) - (setq state (list 'wrong-type))))))) - - (if (memq 'begin state) - (cons (if (= (length files) 1) (car files) files) state) - state)))) - -;; This function is used by `gnus-uu-grab-articles' to treat -;; a shared article. -(defun gnus-uu-unshar-article (process-buffer in-state) - (let ((state (list 'ok)) - start-char) - (save-excursion - (set-buffer process-buffer) - (goto-char (point-min)) - (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) - (setq state (list 'wrong-type)) - (beginning-of-line) - (setq start-char (point)) - (call-process-region - start-char (point-max) shell-file-name nil - (get-buffer-create gnus-uu-output-buffer-name) nil - shell-command-switch - (concat "cd " gnus-uu-work-dir " " - gnus-shell-command-separator " sh")))) - state)) - -;; Returns the name of what the shar file is going to unpack. -(defun gnus-uu-find-name-in-shar () - (let ((oldpoint (point)) - res) - (goto-char (point-min)) - (when (re-search-forward gnus-uu-shar-name-marker nil t) - (setq res (buffer-substring (match-beginning 1) (match-end 1)))) - (goto-char oldpoint) - res)) - -;; `gnus-uu-choose-action' chooses what action to perform given the name -;; and `gnus-uu-file-action-list'. Returns either nil if no action is -;; found, or the name of the command to run if such a rule is found. -(defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore) - (let ((action-list (copy-sequence file-action-list)) - (case-fold-search t) - rule action) - (and - (unless no-ignore - (and (not - (and gnus-uu-ignore-files-by-name - (string-match gnus-uu-ignore-files-by-name file-name))) - (not - (and gnus-uu-ignore-files-by-type - (string-match gnus-uu-ignore-files-by-type - (or (gnus-uu-choose-action - file-name gnus-uu-ext-to-mime-list t) - "")))))) - (while (not (or (eq action-list ()) action)) - (setq rule (car action-list)) - (setq action-list (cdr action-list)) - (when (string-match (car rule) file-name) - (setq action (cadr rule))))) - action)) - -(defun gnus-uu-treat-archive (file-path) - ;; Unpacks an archive. Returns t if unpacking is successful. - (let ((did-unpack t) - action command dir) - (setq action (gnus-uu-choose-action - file-path (append gnus-uu-user-archive-rules - (if gnus-uu-ignore-default-archive-rules - nil - gnus-uu-default-archive-rules)))) - - (when (not action) - (error "No unpackers for the file %s" file-path)) - - (string-match "/[^/]*$" file-path) - (setq dir (substring file-path 0 (match-beginning 0))) - - (when (member action gnus-uu-destructive-archivers) - (copy-file file-path (concat file-path "~") t)) - - (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path))) - - (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (erase-buffer)) - - (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) - - (if (= 0 (call-process shell-file-name nil - (get-buffer-create gnus-uu-output-buffer-name) - nil shell-command-switch command)) - (message "") - (gnus-message 2 "Error during unpacking of archive") - (setq did-unpack nil)) - - (when (member action gnus-uu-destructive-archivers) - (rename-file (concat file-path "~") file-path t)) - - did-unpack)) - -(defun gnus-uu-dir-files (dir) - (let ((dirs (directory-files dir t "[^/][^\\.][^\\.]?$")) - files file) - (while dirs - (if (file-directory-p (setq file (car dirs))) - (setq files (append files (gnus-uu-dir-files file))) - (push file files)) - (setq dirs (cdr dirs))) - files)) - -(defun gnus-uu-unpack-files (files &optional ignore) - ;; Go through FILES and look for files to unpack. - (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir)) - (ofiles files) - file did-unpack) - (while files - (setq file (cdr (assq 'name (car files)))) - (when (and (not (member file ignore)) - (equal (gnus-uu-get-action (file-name-nondirectory file)) - "gnus-uu-archive")) - (push file did-unpack) - (unless (gnus-uu-treat-archive file) - (gnus-message 2 "Error during unpacking of %s" file)) - (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir)) - (nfiles newfiles)) - (while nfiles - (unless (member (car nfiles) totfiles) - (push (list (cons 'name (car nfiles)) - (cons 'original file)) - ofiles)) - (setq nfiles (cdr nfiles))) - (setq totfiles newfiles))) - (setq files (cdr files))) - (if did-unpack - (gnus-uu-unpack-files ofiles (append did-unpack ignore)) - ofiles))) - -(defun gnus-uu-ls-r (dir) - (let* ((files (gnus-uu-directory-files dir t)) - (ofiles files)) - (while files - (when (file-directory-p (car files)) - (setq ofiles (delete (car files) ofiles)) - (setq ofiles (append ofiles (gnus-uu-ls-r (car files))))) - (setq files (cdr files))) - ofiles)) - -;; Various stuff - -(defun gnus-uu-directory-files (dir &optional full) - (let (files out file) - (setq files (directory-files dir full)) - (while files - (setq file (car files)) - (setq files (cdr files)) - (unless (member (file-name-nondirectory file) '("." "..")) - (push file out))) - (setq out (nreverse out)) - out)) - -(defun gnus-uu-check-correct-stripped-uucode (start end) - (save-excursion - (let (found beg length) - (if (not gnus-uu-correct-stripped-uucode) - () - (goto-char start) - - (if (re-search-forward " \\|`" end t) - (progn - (goto-char start) - (while (not (eobp)) - (progn - (when (looking-at "\n") - (replace-match "")) - (forward-line 1)))) - - (while (not (eobp)) - (if (looking-at (concat gnus-uu-begin-string "\\|" - gnus-uu-end-string)) - () - (when (not found) - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (setq length (- (point) beg))) - (setq found t) - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (when (not (= length (- (point) beg))) - (insert (make-string (- length (- (point) beg)) ? )))) - (forward-line 1))))))) - -(defvar gnus-uu-tmp-alist nil) - -(defun gnus-uu-initialize (&optional scan) - (let (entry) - (if (and (not scan) - (when (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist)) - (if (file-exists-p (cdr entry)) - (setq gnus-uu-work-dir (cdr entry)) - (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist)) - nil))) - t - (setq gnus-uu-tmp-dir (file-name-as-directory - (expand-file-name gnus-uu-tmp-dir))) - (if (not (file-directory-p gnus-uu-tmp-dir)) - (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir) - (when (not (file-writable-p gnus-uu-tmp-dir)) - (error "Temp directory %s can't be written to" - 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) - (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) - gnus-uu-tmp-alist)))) - - -;; Kills the temporary uu buffers, kills any processes, etc. -(defun gnus-uu-clean-up () - (let (buf) - (and gnus-uu-uudecode-process - (memq (process-status (or gnus-uu-uudecode-process "nevair")) - '(stop run)) - (delete-process gnus-uu-uudecode-process)) - (when (setq buf (get-buffer gnus-uu-output-buffer-name)) - (kill-buffer buf)))) - -(defun gnus-quote-arg-for-sh-or-csh (arg) - (let ((pos 0) new-pos accum) - ;; *** bug: we don't handle newline characters properly - (while (setq new-pos (string-match "[!`\"$\\& \t{}]" arg pos)) - (push (substring arg pos new-pos) accum) - (push "\\" accum) - (push (list (aref arg new-pos)) accum) - (setq pos (1+ new-pos))) - (if (= pos 0) - arg - (apply 'concat (nconc (nreverse accum) (list (substring arg pos))))))) - -;; Inputs an action and a filename and returns a full command, making sure -;; that the filename will be treated as a single argument when the shell -;; executes the command. -(defun gnus-uu-command (action file) - (let ((quoted-file (gnus-quote-arg-for-sh-or-csh file))) - (if (string-match "%s" action) - (format action quoted-file) - (concat action " " quoted-file)))) - -(defun gnus-uu-delete-work-dir (&optional dir) - "Delete recursively all files and directories under `gnus-uu-work-dir'." - (if dir - (gnus-message 7 "Deleting directory %s..." dir) - (setq dir gnus-uu-work-dir)) - (when (and dir - (file-exists-p dir)) - (let ((files (directory-files dir t nil t)) - file) - (while (setq file (pop files)) - (unless (member (file-name-nondirectory file) '("." "..")) - (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 "")) - -;; Initializing - -(add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up) -(add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir) - - - -;;; -;;; uuencoded posting -;;; - -;; Any function that is to be used as and encoding method will take two -;; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg" -;; and "spiral.jpg", respectively.) The function should return nil if -;; the encoding wasn't successful. -(defcustom gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode - "*Function used for encoding binary files. -There are three functions supplied with gnus-uu for encoding files: -`gnus-uu-post-encode-uuencode', which does straight uuencoding; -`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME -headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with -uuencode and adds MIME headers." - :group 'gnus-extract-post - :type '(radio (function-item gnus-uu-post-encode-uuencode) - (function-item gnus-uu-post-encode-mime) - (function-item gnus-uu-post-encode-mime-uuencode) - (function :tag "Other"))) - -(defcustom gnus-uu-post-include-before-composing nil - "*Non-nil means that gnus-uu will ask for a file to encode before you compose the article. -If this variable is t, you can either include an encoded file with -\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article." - :group 'gnus-extract-post - :type 'boolean) - -(defcustom gnus-uu-post-length 990 - "*Maximum length of an article. -The encoded file will be split into how many articles it takes to -post the entire file." - :group 'gnus-extract-post - :type 'integer) - -(defcustom gnus-uu-post-threaded nil - "*Non-nil means that gnus-uu will post the encoded file in a thread. -This may not be smart, as no other decoder I have seen are able to -follow threads when collecting uuencoded articles. (Well, I have seen -one package that does that - gnus-uu, but somehow, I don't think that -counts...) The default is nil." - :group 'gnus-extract-post - :type 'boolean) - -(defcustom gnus-uu-post-separate-description t - "*Non-nil means that the description will be posted in a separate article. -The first article will typically be numbered (0/x). If this variable -is nil, the description the user enters will be included at the -beginning of the first article, which will be numbered (1/x). Default -is t." - :group 'gnus-extract-post - :type 'boolean) - -(defvar gnus-uu-post-binary-separator "--binary follows this line--") -(defvar gnus-uu-post-message-id nil) -(defvar gnus-uu-post-inserted-file-name nil) -(defvar gnus-uu-winconf-post-news nil) - -(defun gnus-uu-post-news () - "Compose an article and post an encoded file." - (interactive) - (setq gnus-uu-post-inserted-file-name nil) - (setq gnus-uu-winconf-post-news (current-window-configuration)) - - (gnus-summary-post-news) - - (use-local-map (copy-keymap (current-local-map))) - (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) - (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) - (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) - (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) - - (when gnus-uu-post-include-before-composing - (save-excursion (setq gnus-uu-post-inserted-file-name - (gnus-uu-post-insert-binary))))) - -(defun gnus-uu-post-insert-binary-in-article () - "Inserts an encoded file in the buffer. -The user will be asked for a file name." - (interactive) - (save-excursion - (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) - -;; Encodes with uuencode and substitutes all spaces with backticks. -(defun gnus-uu-post-encode-uuencode (path file-name) - (when (gnus-uu-post-encode-file "uuencode" path file-name) - (goto-char (point-min)) - (forward-line 1) - (while (re-search-forward " " nil t) - (replace-match "`")) - t)) - -;; Encodes with uuencode and adds MIME headers. -(defun gnus-uu-post-encode-mime-uuencode (path file-name) - (when (gnus-uu-post-encode-uuencode path file-name) - (gnus-uu-post-make-mime file-name "x-uue") - t)) - -;; Encodes with base64 and adds MIME headers -(defun gnus-uu-post-encode-mime (path file-name) - (when (zerop (call-process shell-file-name nil t nil shell-command-switch - (format "%s %s -o %s" "mmencode" path file-name))) - (gnus-uu-post-make-mime file-name "base64") - t)) - -;; Adds MIME headers. -(defun gnus-uu-post-make-mime (file-name encoding) - (goto-char (point-min)) - (insert (format "Content-Type: %s; name=\"%s\"\n" - (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) - file-name)) - (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) - (save-restriction - (set-buffer gnus-message-buffer) - (goto-char (point-min)) - (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line -1) - (narrow-to-region 1 (point)) - (unless (mail-fetch-field "mime-version") - (widen) - (insert "MIME-Version: 1.0\n")) - (widen))) - -;; Encodes a file PATH with COMMAND, leaving the result in the -;; current buffer. -(defun gnus-uu-post-encode-file (command path file-name) - (= 0 (call-process shell-file-name nil t nil shell-command-switch - (format "%s %s %s" command path file-name)))) - -(defun gnus-uu-post-news-inews () - "Posts the composed news article and encoded file. -If no file has been included, the user will be asked for a file." - (interactive) - - (let (file-name) - - (if gnus-uu-post-inserted-file-name - (setq file-name gnus-uu-post-inserted-file-name) - (setq file-name (gnus-uu-post-insert-binary))) - - (gnus-uu-post-encoded file-name gnus-uu-post-threaded)) - (setq gnus-uu-post-inserted-file-name nil) - (when gnus-uu-winconf-post-news - (set-window-configuration gnus-uu-winconf-post-news))) - -;; Asks for a file to encode, encodes it and inserts the result in -;; the current buffer. Returns the file name the user gave. -(defun gnus-uu-post-insert-binary () - (let ((uuencode-buffer-name "*uuencode buffer*") - file-path uubuf file-name) - - (setq file-path (read-file-name - "What file do you want to encode? ")) - (when (not (file-exists-p file-path)) - (error "%s: No such file" file-path)) - - (goto-char (point-max)) - (insert (format "\n%s\n" gnus-uu-post-binary-separator)) - - (when (string-match "^~/" file-path) - (setq file-path (concat "$HOME" (substring file-path 1)))) - (if (string-match "/[^/]*$" file-path) - (setq file-name (substring file-path (1+ (match-beginning 0)))) - (setq file-name file-path)) - - (unwind-protect - (if (save-excursion - (set-buffer (setq uubuf - (get-buffer-create uuencode-buffer-name))) - (erase-buffer) - (funcall gnus-uu-post-encode-method file-path file-name)) - (insert-buffer-substring uubuf) - (error "Encoding unsuccessful")) - (kill-buffer uubuf)) - file-name)) - -;; Posts the article and all of the encoded file. -(defun gnus-uu-post-encoded (file-name &optional threaded) - (let ((send-buffer-name "*uuencode send buffer*") - (encoded-buffer-name "*encoded buffer*") - (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]") - (separator (concat mail-header-separator "\n\n")) - uubuf length parts header i end beg - beg-line minlen buf post-buf whole-len beg-binary end-binary) - - (setq post-buf (current-buffer)) - - (goto-char (point-min)) - (when (not (re-search-forward - (if gnus-uu-post-separate-description - (concat "^" (regexp-quote gnus-uu-post-binary-separator) - "$") - (concat "^" (regexp-quote mail-header-separator) "$")) - nil t)) - (error "Internal error: No binary/header separator")) - (beginning-of-line) - (forward-line 1) - (setq beg-binary (point)) - (setq end-binary (point-max)) - - (save-excursion - (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name))) - (erase-buffer) - (insert-buffer-substring post-buf beg-binary end-binary) - (goto-char (point-min)) - (setq length (count-lines 1 (point-max))) - (setq parts (/ length gnus-uu-post-length)) - (unless (< (% length gnus-uu-post-length) 4) - (incf parts))) - - (when gnus-uu-post-separate-description - (forward-line -1)) - (delete-region (point) (point-max)) - - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (beginning-of-line) - (setq header (buffer-substring 1 (point))) - - (goto-char (point-min)) - (when gnus-uu-post-separate-description - (when (re-search-forward "^Subject: " nil t) - (end-of-line) - (insert (format " (0/%d)" parts))) - (save-excursion - (message-send)) - (setq gnus-uu-post-message-id (message-fetch-field "message-id"))) - - (save-excursion - (setq i 1) - (setq beg 1) - (while (not (> i parts)) - (set-buffer (get-buffer-create send-buffer-name)) - (erase-buffer) - (insert header) - (when (and threaded gnus-uu-post-message-id) - (insert "References: " gnus-uu-post-message-id "\n")) - (insert separator) - (setq whole-len - (- 62 (length (format top-string "" file-name i parts "")))) - (when (> 1 (setq minlen (/ whole-len 2))) - (setq minlen 1)) - (setq - beg-line - (format top-string - (make-string minlen ?-) - file-name i parts - (make-string - (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) - - (goto-char (point-min)) - (when (re-search-forward "^Subject: " nil t) - (end-of-line) - (insert (format " (%d/%d)" i parts))) - - (goto-char (point-max)) - (save-excursion - (set-buffer uubuf) - (goto-char beg) - (if (= i parts) - (goto-char (point-max)) - (forward-line gnus-uu-post-length)) - (when (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4)) - (forward-line -4)) - (setq end (point))) - (insert-buffer-substring uubuf beg end) - (insert beg-line "\n") - (setq beg end) - (incf i) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (beginning-of-line) - (forward-line 2) - (when (re-search-forward - (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") - nil t) - (replace-match "") - (forward-line 1)) - (insert beg-line) - (insert "\n") - (let (message-sent-message-via) - (save-excursion - (message-send)) - (setq gnus-uu-post-message-id - (concat (message-fetch-field "references") " " - (message-fetch-field "message-id")))))) - - (gnus-kill-buffer send-buffer-name) - (gnus-kill-buffer encoded-buffer-name) - - (when (not gnus-uu-post-separate-description) - (set-buffer-modified-p nil) - (when (fboundp 'bury-buffer) - (bury-buffer))))) - -(provide 'gnus-uu) - -;; gnus-uu.el ends here diff --git a/lisp/gnus-vm.el b/lisp/gnus-vm.el deleted file mode 100644 index bbefaac..0000000 --- a/lisp/gnus-vm.el +++ /dev/null @@ -1,105 +0,0 @@ -;;; gnus-vm.el --- vm interface for Gnus -;; Copyright (C) 1994,95,96,97,98 Free Software Foundation, Inc. - -;; Author: Per Persson -;; 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: - -;; Major contributors: -;; Christian Limpach -;; Some code stolen from: -;; Rick Sladkey - -;;; Code: - -(require 'sendmail) -(require 'message) -(require 'gnus) -(require 'gnus-msg) - -(eval-when-compile - (autoload 'vm-mode "vm") - (autoload 'vm-save-message "vm") - (autoload 'vm-forward-message "vm") - (autoload 'vm-reply "vm") - (autoload 'vm-mail "vm")) - -(defvar gnus-vm-inhibit-window-system nil - "Inhibit loading `win-vm' if using a window-system. -Has to be set before gnus-vm is loaded.") - -(or gnus-vm-inhibit-window-system - (condition-case nil - (when window-system - (require 'win-vm)) - (error nil))) - -(when (not (featurep 'vm)) - (load "vm")) - -(defun gnus-vm-make-folder (&optional buffer) - (let ((article (or buffer (current-buffer))) - (tmp-folder (generate-new-buffer " *tmp-folder*")) - (start (point-min)) - (end (point-max))) - (set-buffer tmp-folder) - (insert-buffer-substring article start end) - (goto-char (point-min)) - (if (looking-at "^\\(From [^ ]+ \\).*$") - (replace-match (concat "\\1" (current-time-string))) - (insert "From " gnus-newsgroup-name " " - (current-time-string) "\n")) - (while (re-search-forward "\n\nFrom " nil t) - (replace-match "\n\n>From ")) - ;; insert a newline, otherwise the last line gets lost - (goto-char (point-max)) - (insert "\n") - (vm-mode) - tmp-folder)) - -(defun gnus-summary-save-article-vm (&optional arg) - "Append the current article to a vm folder. -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") - (let ((gnus-default-article-saver 'gnus-summary-save-in-vm)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-in-vm (&optional folder) - (interactive) - (setq folder - (gnus-read-save-file-name - "Save %s in VM folder:" folder - gnus-mail-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-mail)) - (gnus-eval-in-buffer-window gnus-original-article-buffer - (save-excursion - (save-restriction - (widen) - (let ((vm-folder (gnus-vm-make-folder))) - (vm-save-message folder) - (kill-buffer vm-folder)))))) - -(provide 'gnus-vm) - -;;; gnus-vm.el ends here. diff --git a/lisp/gnus-win.el b/lisp/gnus-win.el deleted file mode 100644 index e6a2037..0000000 --- a/lisp/gnus-win.el +++ /dev/null @@ -1,554 +0,0 @@ -;;; gnus-win.el --- window configuration functions for Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) - -(defgroup gnus-windows nil - "Window configuration." - :group 'gnus) - -(defcustom gnus-use-full-window t - "*If non-nil, use the entire Emacs screen." - :group 'gnus-windows - :type 'boolean) - -(defvar gnus-window-configuration nil - "Obsolete variable. See `gnus-buffer-configuration'.") - -(defcustom gnus-window-min-width 2 - "*Minimum width of Gnus buffers." - :group 'gnus-windows - :type 'integer) - -(defcustom gnus-window-min-height 1 - "*Minimum height of Gnus buffers." - :group 'gnus-windows - :type 'integer) - -(defcustom gnus-always-force-window-configuration nil - "*If non-nil, always force the Gnus window configurations." - :group 'gnus-windows - :type 'boolean) - -(defvar gnus-buffer-configuration - '((group - (vertical 1.0 - (group 1.0 point) - (if gnus-carpal '(group-carpal 4)))) - (summary - (vertical 1.0 - (summary 1.0 point) - (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) - (tree 0.25) - (article 1.0))) - (t - '(vertical 1.0 - (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) - (article 1.0))))) - (server - (vertical 1.0 - (server 1.0 point) - (if gnus-carpal '(server-carpal 2)))) - (browse - (vertical 1.0 - (browse 1.0 point) - (if gnus-carpal '(browse-carpal 2)))) - (message - (vertical 1.0 - (message 1.0 point))) - (pick - (vertical 1.0 - (article 1.0 point))) - (info - (vertical 1.0 - (info 1.0 point))) - (summary-faq - (vertical 1.0 - (summary 0.25) - (faq 1.0 point))) - (edit-article - (vertical 1.0 - (article 1.0 point))) - (edit-form - (vertical 1.0 - (group 0.5) - (edit-form 1.0 point))) - (edit-score - (vertical 1.0 - (summary 0.25) - (edit-score 1.0 point))) - (post - (vertical 1.0 - (post 1.0 point))) - (reply - (vertical 1.0 - (article-copy 0.5) - (message 1.0 point))) - (forward - (vertical 1.0 - (message 1.0 point))) - (reply-yank - (vertical 1.0 - (message 1.0 point))) - (mail-bounce - (vertical 1.0 - (article 0.5) - (message 1.0 point))) - (pipe - (vertical 1.0 - (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) - ("*Shell Command Output*" 1.0))) - (bug - (vertical 1.0 - ("*Gnus Help Bug*" 0.5) - ("*Gnus Bug*" 1.0 point))) - (score-trace - (vertical 1.0 - (summary 0.5 point) - ("*Score Trace*" 1.0))) - (score-words - (vertical 1.0 - (summary 0.5 point) - ("*Score Words*" 1.0))) - (category - (vertical 1.0 - (category 1.0))) - (compose-bounce - (vertical 1.0 - (article 0.5) - (message 1.0 point)))) - "Window configuration for all possible Gnus buffers. -See the Gnus manual for an explanation of the syntax used.") - -(defvar gnus-window-to-buffer - '((group . gnus-group-buffer) - (summary . gnus-summary-buffer) - (article . gnus-article-buffer) - (server . gnus-server-buffer) - (browse . "*Gnus Browse Server*") - (edit-group . gnus-group-edit-buffer) - (edit-form . gnus-edit-form-buffer) - (edit-server . gnus-server-edit-buffer) - (group-carpal . gnus-carpal-group-buffer) - (summary-carpal . gnus-carpal-summary-buffer) - (server-carpal . gnus-carpal-server-buffer) - (browse-carpal . gnus-carpal-browse-buffer) - (edit-score . gnus-score-edit-buffer) - (message . gnus-message-buffer) - (mail . gnus-message-buffer) - (post-news . gnus-message-buffer) - (faq . gnus-faq-buffer) - (picons . "*Picons*") - (tree . gnus-tree-buffer) - (score-trace . "*Score Trace*") - (info . gnus-info-buffer) - (category . gnus-category-buffer) - (article-copy . gnus-article-copy) - (draft . gnus-draft-buffer)) - "Mapping from short symbols to buffer names or buffer variables.") - -;;; Internal variables. - -(defvar gnus-current-window-configuration nil - "The most recently set window configuration.") - -(defvar gnus-created-frames nil) - -(defun gnus-kill-gnus-frames () - "Kill all frames Gnus has created." - (while gnus-created-frames - (when (frame-live-p (car gnus-created-frames)) - ;; We slap a condition-case around this `delete-frame' to ensure - ;; against errors if we try do delete the single frame that's left. - (ignore-errors - (delete-frame (car gnus-created-frames)))) - (pop gnus-created-frames))) - -(defun gnus-window-configuration-element (list) - (while (and list - (not (assq (car list) gnus-window-configuration))) - (pop list)) - (cadr (assq (car list) gnus-window-configuration))) - -(defun gnus-windows-old-to-new (setting) - ;; First we take care of the really, really old Gnus 3 actions. - (when (symbolp setting) - (setq setting - ;; Take care of ooold GNUS 3.x values. - (cond ((eq setting 'SelectArticle) 'article) - ((memq setting '(SelectNewsgroup SelectSubject ExpandSubject)) - 'summary) - ((memq setting '(ExitNewsgroup)) 'group) - (t setting)))) - (if (or (listp setting) - (not (and gnus-window-configuration - (memq setting '(group summary article))))) - setting - (let* ((elem - (cond - ((eq setting 'group) - (gnus-window-configuration-element - '(group newsgroups ExitNewsgroup))) - ((eq setting 'summary) - (gnus-window-configuration-element - '(summary SelectNewsgroup SelectSubject ExpandSubject))) - ((eq setting 'article) - (gnus-window-configuration-element - '(article SelectArticle))))) - (total (apply '+ elem)) - (types '(group summary article)) - (pbuf (if (eq setting 'newsgroups) 'group 'summary)) - (i 0) - perc out) - (while (< i 3) - (or (not (numberp (nth i elem))) - (zerop (nth i elem)) - (progn - (setq perc (if (= i 2) - 1.0 - (/ (float (nth i elem)) total))) - (push (if (eq pbuf (nth i types)) - (list (nth i types) perc 'point) - (list (nth i types) perc)) - out))) - (incf i)) - `(vertical 1.0 ,@(nreverse out))))) - -;;;###autoload -(defun gnus-add-configuration (conf) - "Add the window configuration CONF to `gnus-buffer-configuration'." - (setq gnus-buffer-configuration - (cons conf (delq (assq (car conf) gnus-buffer-configuration) - gnus-buffer-configuration)))) - -(defvar gnus-frame-list nil) - -(defun gnus-configure-frame (split &optional window) - "Split WINDOW according to SPLIT." - (unless window - (setq window (get-buffer-window (current-buffer)))) - (select-window window) - ;; This might be an old-stylee buffer config. - (when (vectorp split) - (setq split (append split nil))) - (when (or (consp (car split)) - (vectorp (car split))) - (push 1.0 split) - (push 'vertical split)) - ;; The SPLIT might be something that is to be evaled to - ;; return a new SPLIT. - (while (and (not (assq (car split) gnus-window-to-buffer)) - (gnus-functionp (car split))) - (setq split (eval split))) - (let* ((type (car split)) - (subs (cddr split)) - (len (if (eq type 'horizontal) (window-width) (window-height))) - (total 0) - (window-min-width (or gnus-window-min-width window-min-width)) - (window-min-height (or gnus-window-min-height window-min-height)) - s result new-win rest comp-subs size sub) - (cond - ;; Nothing to do here. - ((null split)) - ;; Don't switch buffers. - ((null type) - (and (memq 'point split) window)) - ;; This is a buffer to be selected. - ((not (memq type '(frame horizontal vertical))) - (let ((buffer (cond ((stringp type) type) - (t (cdr (assq type gnus-window-to-buffer))))) - buf) - (unless buffer - (error "Illegal buffer type: %s" type)) - (unless (setq buf (get-buffer (if (symbolp buffer) - (symbol-value buffer) buffer))) - (setq buf (get-buffer-create (if (symbolp buffer) - (symbol-value buffer) buffer)))) - (switch-to-buffer buf) - ;; We return the window if it has the `point' spec. - (and (memq 'point split) window))) - ;; This is a frame split. - ((eq type 'frame) - (unless gnus-frame-list - (setq gnus-frame-list (list (window-frame - (get-buffer-window (current-buffer)))))) - (let ((i 0) - params frame fresult) - (while (< i (length subs)) - ;; Frame parameter is gotten from the sub-split. - (setq params (cadr (elt subs i))) - ;; It should be a list. - (unless (listp params) - (setq params nil)) - ;; Create a new frame? - (unless (setq frame (elt gnus-frame-list i)) - (nconc gnus-frame-list (list (setq frame (make-frame params)))) - (push frame gnus-created-frames)) - ;; Is the old frame still alive? - (unless (frame-live-p frame) - (setcar (nthcdr i gnus-frame-list) - (setq frame (make-frame params)))) - ;; Select the frame in question and do more splits there. - (select-frame frame) - (setq fresult (or (gnus-configure-frame (elt subs i)) fresult)) - (incf i)) - ;; Select the frame that has the selected buffer. - (when fresult - (select-frame (window-frame fresult))))) - ;; This is a normal split. - (t - (when (> (length subs) 0) - ;; First we have to compute the sizes of all new windows. - (while subs - (setq sub (append (pop subs) nil)) - (while (and (not (assq (car sub) gnus-window-to-buffer)) - (gnus-functionp (car sub))) - (setq sub (eval sub))) - (when sub - (push sub comp-subs) - (setq size (cadar comp-subs)) - (cond ((equal size 1.0) - (setq rest (car comp-subs)) - (setq s 0)) - ((floatp size) - (setq s (floor (* size len)))) - ((integerp size) - (setq s size)) - (t - (error "Illegal size: %s" size))) - ;; Try to make sure that we are inside the safe limits. - (cond ((zerop s)) - ((eq type 'horizontal) - (setq s (max s window-min-width))) - ((eq type 'vertical) - (setq s (max s window-min-height)))) - (setcar (cdar comp-subs) s) - (incf total s))) - ;; Take care of the "1.0" spec. - (if rest - (setcar (cdr rest) (- len total)) - (error "No 1.0 specs in %s" split)) - ;; The we do the actual splitting in a nice recursive - ;; fashion. - (setq comp-subs (nreverse comp-subs)) - (while comp-subs - (if (null (cdr comp-subs)) - (setq new-win window) - (setq new-win - (split-window window (cadar comp-subs) - (eq type 'horizontal)))) - (setq result (or (gnus-configure-frame - (car comp-subs) window) - result)) - (select-window new-win) - (setq window new-win) - (setq comp-subs (cdr comp-subs)))) - ;; Return the proper window, if any. - (when result - (select-window result)))))) - -(defvar gnus-frame-split-p nil) - -(defun gnus-configure-windows (setting &optional force) - (setq gnus-current-window-configuration setting) - (setq force (or force gnus-always-force-window-configuration)) - (setq setting (gnus-windows-old-to-new setting)) - (let ((split (if (symbolp setting) - (cadr (assq setting gnus-buffer-configuration)) - setting)) - all-visible) - - (setq gnus-frame-split-p nil) - - (unless split - (error "No such setting: %s" setting)) - - (if (and (setq all-visible (gnus-all-windows-visible-p split)) - (not force)) - ;; All the windows mentioned are already visible, so we just - ;; put point in the assigned buffer, and do not touch the - ;; winconf. - (select-window all-visible) - - ;; Either remove all windows or just remove all Gnus windows. - (let ((frame (selected-frame))) - (unwind-protect - (if gnus-use-full-window - ;; We want to remove all other windows. - (if (not gnus-frame-split-p) - ;; 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 - ;; on all frames. - (gnus-delete-windows-in-gnusey-frames)) - ;; Just remove some windows. - (gnus-remove-some-windows) - (switch-to-buffer nntp-server-buffer)) - (select-frame frame))) - - (switch-to-buffer nntp-server-buffer) - (gnus-configure-frame split (get-buffer-window (current-buffer)))))) - -(defun gnus-delete-windows-in-gnusey-frames () - "Do a `delete-other-windows' in all frames that have Gnus windows." - (let ((buffers - (mapcar - (lambda (elem) - (if (symbolp (cdr elem)) - (when (and (boundp (cdr elem)) - (symbol-value (cdr elem))) - (get-buffer (symbol-value (cdr elem)))) - (when (cdr elem) - (get-buffer (cdr elem))))) - gnus-window-to-buffer))) - (mapcar - (lambda (frame) - (unless (eq (cdr (assq 'minibuffer - (frame-parameters frame))) - 'only) - (select-frame frame) - (let (do-delete) - (walk-windows - (lambda (window) - (when (memq (window-buffer window) buffers) - (setq do-delete t)))) - (when do-delete - (delete-other-windows))))) - (frame-list)))) - -(defun gnus-all-windows-visible-p (split) - "Say whether all buffers in SPLIT are currently visible. -In particular, the value returned will be the window that -should have point." - (let ((stack (list split)) - (all-visible t) - type buffer win buf) - (while (and (setq split (pop stack)) - all-visible) - ;; Be backwards compatible. - (when (vectorp split) - (setq split (append split nil))) - (when (or (consp (car split)) - (vectorp (car split))) - (push 1.0 split) - (push 'vertical split)) - ;; The SPLIT might be something that is to be evaled to - ;; return a new SPLIT. - (while (and (not (assq (car split) gnus-window-to-buffer)) - (gnus-functionp (car split))) - (setq split (eval split))) - - (setq type (elt split 0)) - (cond - ;; Nothing here. - ((null split) t) - ;; A buffer. - ((not (memq type '(horizontal vertical frame))) - (setq buffer (cond ((stringp type) type) - (t (cdr (assq type gnus-window-to-buffer))))) - (unless buffer - (error "Illegal buffer type: %s" type)) - (when (setq buf (get-buffer (if (symbolp buffer) - (symbol-value buffer) - buffer))) - (setq win (get-buffer-window buf t))) - (if win - (when (memq 'point split) - (setq all-visible win)) - (setq all-visible nil))) - (t - (when (eq type 'frame) - (setq gnus-frame-split-p t)) - (setq stack (append (cddr split) stack))))) - (unless (eq all-visible t) - all-visible))) - -(defun gnus-window-top-edge (&optional window) - (nth 1 (window-edges window))) - -(defun gnus-remove-some-windows () - (let ((buffers gnus-window-to-buffer) - buf bufs lowest-buf lowest) - (save-excursion - ;; Remove windows on all known Gnus buffers. - (while buffers - (setq buf (cdar buffers)) - (when (symbolp buf) - (setq buf (and (boundp buf) (symbol-value buf)))) - (and buf - (get-buffer-window buf) - (progn - (push buf bufs) - (pop-to-buffer buf) - (when (or (not lowest) - (< (gnus-window-top-edge) lowest)) - (setq lowest (gnus-window-top-edge)) - (setq lowest-buf buf)))) - (setq buffers (cdr buffers))) - ;; Remove windows on *all* summary buffers. - (walk-windows - (lambda (win) - (let ((buf (window-buffer win))) - (when (string-match "^\\*\\(Dead \\)?Summary" (buffer-name buf)) - (push buf bufs) - (pop-to-buffer buf) - (when (or (not lowest) - (< (gnus-window-top-edge) lowest)) - (setq lowest-buf buf) - (setq lowest (gnus-window-top-edge))))))) - (when lowest-buf - (pop-to-buffer lowest-buf) - (switch-to-buffer nntp-server-buffer)) - (while bufs - (when (not (eq (car bufs) lowest-buf)) - (delete-windows-on (car bufs))) - (setq bufs (cdr bufs)))))) - -(provide 'gnus-win) - -;;; gnus-win.el ends here diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el deleted file mode 100644 index 7f7917f..0000000 --- a/lisp/gnus-xmas.el +++ /dev/null @@ -1,826 +0,0 @@ -;;; gnus-xmas.el --- Gnus functions for XEmacs -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'text-props) -(defvar menu-bar-mode (featurep 'menubar)) -(require 'messagexmas) - -(defgroup gnus-xmas nil - "XEmacsoid support for Gnus" - :group 'gnus) - -(defcustom gnus-xmas-glyph-directory nil - "*Directory where Gnus logos and icons are located. -If this variable is nil, Gnus will try to locate the directory -automatically." - :type '(choice (const :tag "autodetect" nil) - directory) - :group 'gnus-xmas) - -(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") - (neutral "#b4b4b4" "#878787") - (september "#bf9900" "#ffcc00")) - "Color alist used for the Gnus logo.") - -(defcustom gnus-xmas-logo-color-style 'moss - "*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)) - :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 | xv -quit -") - "*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)) - -;;; 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) -(defvar gnus-auto-center-summary) -(defvar gnus-buffer-list) -(defvar gnus-current-headers) -(defvar gnus-level-killed) -(defvar gnus-level-zombie) -(defvar gnus-newsgroup-bookmarks) -(defvar gnus-newsgroup-dependencies) -(defvar gnus-newsgroup-selected-overlay) -(defvar gnus-newsrc-hashtb) -(defvar gnus-read-mark) -(defvar gnus-refer-article-method) -(defvar gnus-reffed-article-number) -(defvar gnus-unread-mark) -(defvar gnus-version) -(defvar gnus-view-pseudos) -(defvar gnus-view-pseudos-separately) -(defvar gnus-visual) -(defvar gnus-zombie-list) -;;defined in gnus-msg.el -(defvar gnus-article-copy) -(defvar gnus-check-before-posting) -;;defined in gnus-vis.el -(defvar gnus-article-button-face) -(defvar gnus-article-mouse-face) -(defvar gnus-summary-selected-face) -(defvar gnus-group-reading-menu) -(defvar gnus-group-group-menu) -(defvar gnus-group-misc-menu) -(defvar gnus-summary-article-menu) -(defvar gnus-summary-thread-menu) -(defvar gnus-summary-misc-menu) -(defvar gnus-summary-post-menu) -(defvar gnus-summary-kill-menu) -(defvar gnus-article-article-menu) -(defvar gnus-article-treatment-menu) -(defvar gnus-mouse-2) -(defvar standard-display-table) -(defvar gnus-tree-minimize-window) - -(defun gnus-xmas-set-text-properties (start end props &optional buffer) - "You should NEVER use this function. It is ideologically blasphemous. -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) - nil) - buffer start end nil nil 'text-prop) - (gnus-add-text-properties start end props buffer))) - -(defun gnus-xmas-highlight-selected-summary () - ;; Highlight selected article in summary buffer - (when gnus-summary-selected-face - (when gnus-newsgroup-selected-overlay - (delete-extent gnus-newsgroup-selected-overlay)) - (setq gnus-newsgroup-selected-overlay - (make-extent (gnus-point-at-bol) (gnus-point-at-eol))) - (set-extent-face gnus-newsgroup-selected-overlay - gnus-summary-selected-face))) - -(defcustom gnus-xmas-force-redisplay nil - "*If non-nil, force a redisplay before recentering the summary buffer. -This is ugly, but it works around a bug in `window-displayed-height'." - :type 'boolean - :group 'gnus-xmas) - -(defun gnus-xmas-switch-horizontal-scrollbar-off () - (when (featurep 'scrollbar) - (set-specifier scrollbar-height (cons (current-buffer) 0)))) - -(defun gnus-xmas-summary-recenter () - "\"Center\" point in the summary window. -If `gnus-auto-center-summary' is nil, or the article buffer isn't -displayed, no centering will be performed." - ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). - ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. - ;; Force redisplay to get properly computed window height. - (when gnus-xmas-force-redisplay - (sit-for 0)) - (when gnus-auto-center-summary - (let* ((height (if (fboundp 'window-displayed-height) - (window-displayed-height) - (- (window-height) 2))) - (top (cond ((< height 4) 0) - ((< height 7) 1) - (t 2))) - (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))))) - ;; Do horizontal recentering while we're at it. - (when (and (get-buffer-window (current-buffer) t) - (not (eq gnus-auto-center-summary 'vertical))) - (let ((selected (selected-window))) - (select-window (get-buffer-window (current-buffer) t)) - (gnus-summary-position-point) - (gnus-horizontal-recenter) - (select-window selected)))))) - -(defun gnus-xmas-summary-set-display-table () - ;; Setup the display table -- like `gnus-summary-setup-display-table', - ;; but done in an XEmacsish way. - (let ((table (make-display-table)) - (i 32)) - ;; Nix out all the control chars... - (while (>= (setq i (1- i)) 0) - (aset table i [??])) - ;; ... but not newline and cr, of course. (cr is necessary for the - ;; selective display). - (aset table ?\n nil) - (aset table ?\r nil) - ;; We keep TAB as well. - (aset table ?\t nil) - ;; We nix out any glyphs over 126 below ctl-arrow. - (let ((i (if (integerp ctl-arrow) ctl-arrow 160))) - (while (>= (setq i (1- i)) 127) - (unless (aref table i) - (aset table i [??])))) - ;; Can't use `set-specifier' because of a bug in 19.14 and earlier - (add-spec-to-specifier current-display-table table (current-buffer) nil))) - -(defun gnus-xmas-add-text-properties (start end props &optional object) - (add-text-properties start end props object) - (put-text-property start end 'start-closed nil object)) - -(defun gnus-xmas-put-text-property (start end prop value &optional object) - (put-text-property start end prop value object) - (put-text-property start end 'start-closed nil object)) - -(defun gnus-xmas-extent-start-open (point) - (map-extents (lambda (extent arg) - (set-extent-property extent 'start-open t)) - nil point (min (1+ (point)) (point-max)))) - -(defun gnus-xmas-article-push-button (event) - "Check text under the mouse pointer for a callback function. -If the text under the mouse pointer has a `gnus-callback' property, -call it with the value of the `gnus-data' text property." - (interactive "e") - (set-buffer (window-buffer (event-window event))) - (let* ((pos (event-closest-point event)) - (data (get-text-property pos 'gnus-data)) - (fun (get-text-property pos 'gnus-callback))) - (when fun - (funcall fun data)))) - -(defun gnus-xmas-move-overlay (extent start end &optional buffer) - (set-extent-endpoints extent start end buffer)) - -(defun gnus-xmas-kill-all-overlays () - "Delete all extents in the current buffer." - (map-extents (lambda (extent ignore) - (delete-extent extent) - nil))) - -;; Fixed by Christopher Davis . -(defun gnus-xmas-article-add-button (from to fun &optional data) - "Create a button between FROM and TO with callback FUN and data DATA." - (when gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay from to) - 'face gnus-article-button-face)) - (gnus-add-text-properties - from to - (nconc - (and gnus-article-mouse-face - (list 'mouse-face gnus-article-mouse-face)) - (list 'gnus-callback fun) - (and data (list 'gnus-data data)) - (list 'highlight t)))) - -(defun gnus-xmas-window-top-edge (&optional window) - (nth 1 (window-pixel-edges window))) - -(defun gnus-xmas-tree-minimize () - (when (and gnus-tree-minimize-window - (not (one-window-p))) - (let* ((window-min-height 2) - (height (1+ (count-lines (point-min) (point-max)))) - (min (max (1- window-min-height) height)) - (tot (if (numberp gnus-tree-minimize-window) - (min gnus-tree-minimize-window min) - min)) - (win (get-buffer-window (current-buffer))) - (wh (and win (1- (window-height win))))) - (when (and win - (not (eq tot wh))) - (let ((selected (selected-window))) - (select-window win) - (enlarge-window (- tot wh)) - (select-window selected)))))) - -;; Select the lowest window on the frame. -(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)) - (while window-search - (let* ((this-window (next-window)) - (next-bottom-edge (car (cdr (cdr (cdr - (window-pixel-edges - this-window))))))) - (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 lowest-window) - (setq window-search nil)))))) - -(defmacro gnus-xmas-menu-add (type &rest menus) - `(gnus-xmas-menu-add-1 ',type ',menus)) -(put 'gnus-xmas-menu-add 'lisp-indent-function 1) - -(defun gnus-xmas-menu-add-1 (type menus) - (when (and menu-bar-mode - (gnus-visual-p (intern (format "%s-menu" type)) 'menu)) - (while menus - (easy-menu-add (symbol-value (pop menus)))))) - -(defun gnus-xmas-group-menu-add () - (gnus-xmas-menu-add group - gnus-group-reading-menu gnus-group-group-menu gnus-group-misc-menu)) - -(defun gnus-xmas-summary-menu-add () - (gnus-xmas-menu-add summary - gnus-summary-misc-menu gnus-summary-kill-menu - gnus-summary-article-menu gnus-summary-thread-menu - gnus-summary-post-menu )) - -(defun gnus-xmas-article-menu-add () - (gnus-xmas-menu-add article - gnus-article-article-menu gnus-article-treatment-menu)) - -(defun gnus-xmas-score-menu-add () - (gnus-xmas-menu-add score - gnus-score-menu)) - -(defun gnus-xmas-pick-menu-add () - (gnus-xmas-menu-add pick - gnus-pick-menu)) - -(defun gnus-xmas-topic-menu-add () - (gnus-xmas-menu-add topic - gnus-topic-menu)) - -(defun gnus-xmas-binary-menu-add () - (gnus-xmas-menu-add binary - gnus-binary-menu)) - -(defun gnus-xmas-agent-summary-menu-add () - (gnus-xmas-menu-add agent-summary - gnus-agent-summary-menu)) - -(defun gnus-xmas-agent-group-menu-add () - (gnus-xmas-menu-add agent-group - gnus-agent-group-menu)) - -(defun gnus-xmas-agent-server-menu-add () - (gnus-xmas-menu-add agent-server - gnus-agent-server-menu)) - -(defun gnus-xmas-tree-menu-add () - (gnus-xmas-menu-add tree - gnus-tree-menu)) - -(defun gnus-xmas-server-menu-add () - (gnus-xmas-menu-add menu - gnus-server-server-menu gnus-server-connections-menu)) - -(defun gnus-xmas-browse-menu-add () - (gnus-xmas-menu-add browse - gnus-browse-menu)) - -(defun gnus-xmas-grouplens-menu-add () - (gnus-xmas-menu-add grouplens - gnus-grouplens-menu)) - -(defun gnus-xmas-read-event-char () - "Get the next event." - (let ((event (next-command-event))) - (sit-for 0) - ;; We junk all non-key events. Is this naughty? - (while (not (or (key-press-event-p event) - (button-press-event-p event))) - (dispatch-event event) - (setq event (next-command-event))) - (cons (and (key-press-event-p event) - (event-to-character event)) - event))) - -(defun gnus-xmas-seconds-since-epoch (date) - "Return a floating point number that says how many seconds have lapsed between Jan 1 12:00:00 1970 and DATE." - (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti))) - (timezone-parse-date date))) - (ttime (mapcar (lambda (ti) (and ti (string-to-int ti))) - (timezone-parse-time - (aref (timezone-parse-date date) 3)))) - (edate (mapcar (lambda (ti) (and ti (string-to-int ti))) - (timezone-parse-date "Jan 1 12:00:00 1970"))) - (tday (- (timezone-absolute-from-gregorian - (nth 1 tdate) (nth 2 tdate) (nth 0 tdate)) - (timezone-absolute-from-gregorian - (nth 1 edate) (nth 2 edate) (nth 0 edate))))) - (+ (nth 2 ttime) - (* (nth 1 ttime) 60) - (* (float (nth 0 ttime)) 60 60) - (* (float tday) 60 60 24)))) - -(defun gnus-xmas-define () - (setq gnus-mouse-2 [button2]) - - (unless (memq 'underline (face-list)) - (and (fboundp 'make-face) - (funcall (intern "make-face") 'underline))) - ;; Must avoid calling set-face-underline-p directly, because it - ;; is a defsubst in emacs19, and will make the .elc files non - ;; portable! - (unless (face-differs-from-default-p 'underline) - (funcall (intern "set-face-underline-p") 'underline t)) - - (cond - ((fboundp 'char-or-char-int-p) - ;; Handle both types of marks for XEmacs-20.x. - (fset 'gnus-characterp 'char-or-char-int-p)) - ;; V19 of XEmacs, probably. - (t - (fset 'gnus-characterp 'characterp))) - - (fset 'gnus-make-overlay 'make-extent) - (fset 'gnus-delete-overlay 'delete-extent) - (fset 'gnus-overlay-put 'set-extent-property) - (fset 'gnus-move-overlay 'gnus-xmas-move-overlay) - (fset 'gnus-overlay-end 'extent-end-position) - (fset 'gnus-kill-all-overlays 'gnus-xmas-kill-all-overlays) - (fset 'gnus-extent-detached-p 'extent-detached-p) - (fset 'gnus-add-text-properties 'gnus-xmas-add-text-properties) - (fset 'gnus-put-text-property 'gnus-xmas-put-text-property) - (fset 'gnus-deactivate-mark 'ignore) - (fset 'gnus-window-edges 'window-pixel-edges) - - (if (and (<= emacs-major-version 19) - (< emacs-minor-version 14)) - (fset '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)) - - (defvar gnus-mouse-face-prop 'highlight) - - (unless (fboundp 'encode-time) - (defun encode-time (sec minute hour day month year &optional zone) - (let ((seconds - (gnus-xmas-seconds-since-epoch - (timezone-make-arpa-date - year month day (timezone-make-time-string hour minute sec) - zone)))) - (list (floor (/ seconds (expt 2 16))) - (round (mod seconds (expt 2 16))))))) - - (defun gnus-byte-code (func) - "Return a form that can be `eval'ed based on FUNC." - (let ((fval (indirect-function func))) - (if (compiled-function-p fval) - (list 'funcall fval) - (cons 'progn (cdr (cdr fval)))))) - - (fset 'gnus-x-color-values - (if (fboundp 'x-color-values) - 'x-color-values - (lambda (color) - (color-instance-rgb-components - (make-color-instance color)))))) - -(defun gnus-xmas-redefine () - "Redefine lots of Gnus functions for XEmacs." - (fset 'gnus-summary-set-display-table 'gnus-xmas-summary-set-display-table) - (fset 'gnus-visual-turn-off-edit-menu 'identity) - (fset 'gnus-summary-recenter 'gnus-xmas-summary-recenter) - (fset 'gnus-extent-start-open 'gnus-xmas-extent-start-open) - (fset 'gnus-article-push-button 'gnus-xmas-article-push-button) - (fset 'gnus-article-add-button 'gnus-xmas-article-add-button) - (fset 'gnus-window-top-edge 'gnus-xmas-window-top-edge) - (fset 'gnus-read-event-char 'gnus-xmas-read-event-char) - (fset 'gnus-group-startup-message 'gnus-xmas-group-startup-message) - (fset 'gnus-tree-minimize 'gnus-xmas-tree-minimize) - (fset 'gnus-appt-select-lowest-window - 'gnus-xmas-appt-select-lowest-window) - (fset 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names) - (fset 'gnus-character-to-event 'character-to-event) - (fset 'gnus-mode-line-buffer-identification - 'gnus-xmas-mode-line-buffer-identification) - (fset 'gnus-key-press-event-p 'key-press-event-p) - (fset 'gnus-region-active-p 'region-active-p) - - (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) - (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-summary-mode-hook - 'gnus-xmas-switch-horizontal-scrollbar-off) - (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off)) - - -;;; 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) - (or (featurep 'xpm) - (featurep 'xbm))) - (let* ((logo-xpm (expand-file-name "gnus.xpm" gnus-xmas-glyph-directory)) - (logo-xbm (expand-file-name "gnus.xbm" gnus-xmas-glyph-directory)) - (glyph (make-glyph - (cond ((featurep 'xpm) - `[xpm - :file ,logo-xpm - :color-symbols - (("thing" . ,(car gnus-xmas-logo-colors)) - ("shadow" . ,(cadr gnus-xmas-logo-colors)) - ("background" . ,(face-background 'default)))]) - ((featurep 'xbm) - `[xbm :file ,logo-xbm]) - (t [nothing]))))) - (insert " ") - (set-extent-begin-glyph (make-extent (point) (point)) glyph) - (goto-char (point-min)) - (while (not (eobp)) - (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2) - ?\ )) - (forward-line 1))) - (goto-char (point-min)) - (let* ((pheight (+ 20 (count-lines (point-min) (point-max)))) - (wheight (window-height)) - (rest (- wheight pheight))) - (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))) - (t - (insert - (format " %s - _ ___ _ _ - _ ___ __ ___ __ _ ___ - __ _ ___ __ ___ - _ ___ _ - _ _ __ _ - ___ __ _ - __ _ - _ _ _ - _ _ _ - _ _ _ - __ ___ - _ _ _ _ - _ _ - _ _ - _ _ - _ - __ - -" - "")) - ;; And then hack it. - (gnus-indent-rigidly (point-min) (point-max) - (/ (max (- (window-width) (or x 46)) 0) 2)) - (goto-char (point-min)) - (forward-line 1) - (let* ((pheight (count-lines (point-min) (point-max))) - (wheight (window-height)) - (rest (- wheight pheight))) - (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) - ;; Paint it. - (put-text-property (point-min) (point-max) 'face 'gnus-splash-face))) - (setq modeline-buffer-identification - (list (concat gnus-version ": *Group*"))) - (set-buffer-modified-p t)) - - -;;; The toolbar. - -(defcustom gnus-use-toolbar (if (featurep 'toolbar) - 'default-toolbar - nil) - "*If nil, do not use a toolbar. -If it is non-nil, it must be a toolbar. The five legal values are -`default-toolbar', `top-toolbar', `bottom-toolbar', -`right-toolbar', and `left-toolbar'." - :type '(choice (const default-toolbar) - (const top-toolbar) (const bottom-toolbar) - (const left-toolbar) (const right-toolbar) - (const :tag "no toolbar" nil)) - :group 'gnus-xmas) - -(defvar gnus-group-toolbar - '([gnus-group-get-new-news gnus-group-get-new-news t "Get new news"] - [gnus-group-get-new-news-this-group - gnus-group-get-new-news-this-group t "Get new news in this group"] - [gnus-group-catchup-current - gnus-group-catchup-current t "Catchup group"] - [gnus-group-describe-group - gnus-group-describe-group t "Describe group"] - [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-group-exit gnus-group-exit t "Exit Gnus"] - ) - "The group buffer toolbar.") - -(defvar gnus-summary-toolbar - '([gnus-summary-prev-unread - gnus-summary-prev-page-or-article t "Page up"] - [gnus-summary-next-unread - gnus-summary-next-page t "Page down"] - [gnus-summary-post-news - gnus-summary-post-news t "Post an article"] - [gnus-summary-followup-with-original - gnus-summary-followup-with-original t - "Post a followup and yank the original"] - [gnus-summary-followup - gnus-summary-followup t "Post a followup"] - [gnus-summary-reply-with-original - gnus-summary-reply-with-original t "Mail a reply and yank the original"] - [gnus-summary-reply - gnus-summary-reply t "Mail a reply"] - [gnus-summary-caesar-message - gnus-summary-caesar-message t "Rot 13"] - [gnus-uu-decode-uu - gnus-uu-decode-uu t "Decode uuencoded articles"] - [gnus-summary-save-article-file - gnus-summary-save-article-file t "Save article in file"] - [gnus-summary-save-article - gnus-summary-save-article t "Save article"] - [gnus-uu-post-news - gnus-uu-post-news t "Post a uuencoded article"] - [gnus-summary-cancel-article - gnus-summary-cancel-article t "Cancel article"] - [gnus-summary-catchup - gnus-summary-catchup t "Catchup"] - [gnus-summary-catchup-and-exit - gnus-summary-catchup-and-exit t "Catchup and exit"] - [gnus-summary-exit gnus-summary-exit t "Exit this summary"] - ) - "The summary buffer toolbar.") - -(defvar gnus-summary-mail-toolbar - '( - [gnus-summary-prev-unread - gnus-summary-prev-unread-article t "Prev unread article"] - [gnus-summary-next-unread - gnus-summary-next-unread-article t "Next unread article"] - [gnus-summary-mail-reply gnus-summary-reply t "Reply"] -; [gnus-summary-mail-get gnus-mail-get t "Message get"] - [gnus-summary-mail-originate gnus-summary-post-news t "Originate"] - [gnus-summary-mail-save gnus-summary-save-article t "Save"] - [gnus-summary-mail-copy gnus-summary-copy-article t "Copy message"] -; [gnus-summary-mail-delete gnus-summary-delete-article t "Delete message"] - [gnus-summary-mail-forward gnus-summary-mail-forward t "Forward message"] -; [gnus-summary-mail-spell gnus-mail-spell t "Spell"] -; [gnus-summary-mail-help gnus-mail-help t "Message help"] - [gnus-summary-caesar-message - gnus-summary-caesar-message t "Rot 13"] - [gnus-uu-decode-uu - gnus-uu-decode-uu t "Decode uuencoded articles"] - [gnus-summary-save-article-file - gnus-summary-save-article-file t "Save article in file"] - [gnus-summary-save-article - gnus-summary-save-article t "Save article"] - [gnus-summary-catchup - gnus-summary-catchup t "Catchup"] - [gnus-summary-catchup-and-exit - gnus-summary-catchup-and-exit t "Catchup and exit"] - [gnus-summary-exit gnus-summary-exit t "Exit this summary"] - ) - "The summary buffer mail toolbar.") - -(defun gnus-xmas-setup-group-toolbar () - (and gnus-use-toolbar - (message-xmas-setup-toolbar gnus-group-toolbar nil "gnus") - (set-specifier (symbol-value gnus-use-toolbar) - (cons (current-buffer) gnus-group-toolbar)))) - -(defun gnus-xmas-setup-summary-toolbar () - (let ((bar (if (gnus-news-group-p gnus-newsgroup-name) - gnus-summary-toolbar gnus-summary-mail-toolbar))) - (and gnus-use-toolbar - (message-xmas-setup-toolbar bar nil "gnus") - (set-specifier (symbol-value gnus-use-toolbar) - (cons (current-buffer) bar))))) - -(defun gnus-xmas-mail-strip-quoted-names (address) - "Protect mail-strip-quoted-names from NIL input. -XEmacs compatibility workaround." - (if (null address) - nil - (mail-strip-quoted-names address))) - -(defun gnus-xmas-call-region (command &rest args) - (apply - '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 (format "%s" (buffer-substring beg end cur))) - (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-pointer-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" -;; gnus-xmas-glyph-directory))) -;; (make-pointer-glyph -;; (list (vector 'xpm ':file file-xpm) -;; (vector 'xbm ':file file-xbm)))))) - -(defvar gnus-xmas-modeline-left-extent - (let ((ext (copy-extent modeline-buffer-id-left-extent))) -; (set-extent-property ext 'pointer gnus-xmas-pointer-glyph) - ext)) - -(defvar gnus-xmas-modeline-right-extent - (let ((ext (copy-extent modeline-buffer-id-right-extent))) -; (set-extent-property ext 'pointer gnus-xmas-pointer-glyph) - ext)) - -(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" - gnus-xmas-glyph-directory)) - (glyph (make-glyph - ;; Gag gag gag. - (cond ((featurep 'xpm) - ;; Let's try a nifty XPM - `[xpm :file ,file-xpm]) - ((featurep 'xbm) - ;; Then a not-so-nifty XBM - [xbm :file ,file-xbm]) - ;; Then the simple string - (t [string :data "Gnus:"]))))) - (set-glyph-face glyph 'modeline-buffer-id) - glyph))) - -(defun gnus-xmas-mode-line-buffer-identification (line) - (let ((line (car line)) - chop) - (cond - ;; This is some weird type of id. - ((not (stringp line)) - (list line)) - ;; This is non-standard, so we just pass it through. - ((not (string-match "^Gnus:" line)) - (list line)) - ;; We have a standard line, so we colorize and glyphize it a bit. - (t - (setq chop (match-end 0)) - (list - (if gnus-xmas-modeline-glyph - (cons gnus-xmas-modeline-left-extent gnus-xmas-modeline-glyph) - (cons gnus-xmas-modeline-left-extent (substring line 0 chop))) - (cons gnus-xmas-modeline-right-extent (substring line chop))))))) - -(defun gnus-xmas-splash () - (when (eq (device-type) 'x) - (gnus-splash))) - -(provide 'gnus-xmas) - -;;; gnus-xmas.el ends here diff --git a/lisp/gnus.el b/lisp/gnus.el deleted file mode 100644 index 4e74441..0000000 --- a/lisp/gnus.el +++ /dev/null @@ -1,2722 +0,0 @@ -;;; gnus.el --- a newsreader for GNU Emacs -;; Copyright (C) 1987,88,89,90,93,94,95,96,97,98 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; 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: - -;;; Code: - -(eval '(run-hooks 'gnus-load-hook)) - -(eval-when-compile (require 'cl)) - -(require 'custom) -(eval-and-compile - (if (< emacs-major-version 20) - (require 'gnus-load))) -(require 'message) - -(defgroup gnus nil - "The coffee-brewing, all singing, all dancing, kitchen sink newsreader." - :group 'news - :group 'mail) - -(defgroup gnus-start nil - "Starting your favorite newsreader." - :group 'gnus) - -(defgroup gnus-start-server nil - "Server options at startup." - :group 'gnus-start) - -;; These belong to gnus-group.el. -(defgroup gnus-group nil - "Group buffers." - :link '(custom-manual "(gnus)The Group Buffer") - :group 'gnus) - -(defgroup gnus-group-foreign nil - "Foreign groups." - :link '(custom-manual "(gnus)Foreign Groups") - :group 'gnus-group) - -(defgroup gnus-group-new nil - "Automatic subscription of new groups." - :group 'gnus-group) - -(defgroup gnus-group-levels nil - "Group levels." - :link '(custom-manual "(gnus)Group Levels") - :group 'gnus-group) - -(defgroup gnus-group-select nil - "Selecting a Group." - :link '(custom-manual "(gnus)Selecting a Group") - :group 'gnus-group) - -(defgroup gnus-group-listing nil - "Showing slices of the group list." - :link '(custom-manual "(gnus)Listing Groups") - :group 'gnus-group) - -(defgroup gnus-group-visual nil - "Sorting the group buffer." - :link '(custom-manual "(gnus)Group Buffer Format") - :group 'gnus-group - :group 'gnus-visual) - -(defgroup gnus-group-various nil - "Various group options." - :link '(custom-manual "(gnus)Scanning New Messages") - :group 'gnus-group) - -;; These belong to gnus-sum.el. -(defgroup gnus-summary nil - "Summary buffers." - :link '(custom-manual "(gnus)The Summary Buffer") - :group 'gnus) - -(defgroup gnus-summary-exit nil - "Leaving summary buffers." - :link '(custom-manual "(gnus)Exiting the Summary Buffer") - :group 'gnus-summary) - -(defgroup gnus-summary-marks nil - "Marks used in summary buffers." - :link '(custom-manual "(gnus)Marking Articles") - :group 'gnus-summary) - -(defgroup gnus-thread nil - "Ordering articles according to replies." - :link '(custom-manual "(gnus)Threading") - :group 'gnus-summary) - -(defgroup gnus-summary-format nil - "Formatting of the summary buffer." - :link '(custom-manual "(gnus)Summary Buffer Format") - :group 'gnus-summary) - -(defgroup gnus-summary-choose nil - "Choosing Articles." - :link '(custom-manual "(gnus)Choosing Articles") - :group 'gnus-summary) - -(defgroup gnus-summary-maneuvering nil - "Summary movement commands." - :link '(custom-manual "(gnus)Summary Maneuvering") - :group 'gnus-summary) - -(defgroup gnus-summary-mail nil - "Mail group commands." - :link '(custom-manual "(gnus)Mail Group Commands") - :group 'gnus-summary) - -(defgroup gnus-summary-sort nil - "Sorting the summary buffer." - :link '(custom-manual "(gnus)Sorting") - :group 'gnus-summary) - -(defgroup gnus-summary-visual nil - "Highlighting and menus in the summary buffer." - :link '(custom-manual "(gnus)Summary Highlighting") - :group 'gnus-visual - :group 'gnus-summary) - -(defgroup gnus-summary-various nil - "Various summary buffer options." - :link '(custom-manual "(gnus)Various Summary Stuff") - :group 'gnus-summary) - -(defgroup gnus-summary-pick nil - "Pick mode in the summary buffer." - :link '(custom-manual "(gnus)Pick and Read") - :prefix "gnus-pick-" - :group 'gnus-summary) - -(defgroup gnus-summary-tree nil - "Tree display of threads in the summary buffer." - :link '(custom-manual "(gnus)Tree Display") - :prefix "gnus-tree-" - :group 'gnus-summary) - -;; Belongs to gnus-uu.el -(defgroup gnus-extract-view nil - "Viewing extracted files." - :link '(custom-manual "(gnus)Viewing Files") - :group 'gnus-extract) - -;; Belongs to gnus-score.el -(defgroup gnus-score nil - "Score and kill file handling." - :group 'gnus) - -(defgroup gnus-score-kill nil - "Kill files." - :group 'gnus-score) - -(defgroup gnus-score-adapt nil - "Adaptive score files." - :group 'gnus-score) - -(defgroup gnus-score-default nil - "Default values for score files." - :group 'gnus-score) - -(defgroup gnus-score-expire nil - "Expiring score rules." - :group 'gnus-score) - -(defgroup gnus-score-decay nil - "Decaying score rules." - :group 'gnus-score) - -(defgroup gnus-score-files nil - "Score and kill file names." - :group 'gnus-score - :group 'gnus-files) - -(defgroup gnus-score-various nil - "Various scoring and killing options." - :group 'gnus-score) - -;; Other -(defgroup gnus-visual nil - "Options controling the visual fluff." - :group 'gnus - :group 'faces) - -(defgroup gnus-agent nil - "Offline support for Gnus." - :group 'gnus) - -(defgroup gnus-files nil - "Files used by Gnus." - :group 'gnus) - -(defgroup gnus-dribble-file nil - "Auto save file." - :link '(custom-manual "(gnus)Auto Save") - :group 'gnus-files) - -(defgroup gnus-newsrc nil - "Storing Gnus state." - :group 'gnus-files) - -(defgroup gnus-server nil - "Options related to newsservers and other servers used by Gnus." - :group 'gnus) - -(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. -In general, modifying these variables does not take affect until Gnus -is restarted, and sometimes reloaded." - :group 'gnus) - -(defgroup gnus-various nil - "Other Gnus options." - :link '(custom-manual "(gnus)Various Various") - :group 'gnus) - -(defgroup gnus-exit nil - "Exiting gnus." - :link '(custom-manual "(gnus)Exiting Gnus") - :group 'gnus) - -(defconst gnus-version-number "6.0.4" - "Version number for this version of gnus.") - -(defconst gnus-version - (format "Semi-gnus %s (based on Quassia Gnus v0.27)" gnus-version-number) - "Version string for this version of gnus.") - -(defcustom gnus-inhibit-startup-message nil - "*If non-nil, the startup message will not be displayed. -This variable is used before `.gnus.el' is loaded, so it should -be set in `.emacs' instead." - :group 'gnus-start - :type 'boolean) - -(defcustom gnus-play-startup-jingle nil - "*If non-nil, play the Gnus jingle at startup." - :group 'gnus-start - :type 'boolean) - -;;; Kludges to help the transition from the old `custom.el'. - -(unless (featurep 'gnus-xmas) - (defalias 'gnus-make-overlay 'make-overlay) - (defalias 'gnus-delete-overlay 'delete-overlay) - (defalias 'gnus-overlay-put 'overlay-put) - (defalias 'gnus-move-overlay 'move-overlay) - (defalias 'gnus-overlay-end 'overlay-end) - (defalias 'gnus-extent-detached-p 'ignore) - (defalias 'gnus-extent-start-open 'ignore) - (defalias 'gnus-set-text-properties 'set-text-properties) - (defalias 'gnus-group-remove-excess-properties 'ignore) - (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window) - (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) - (defalias 'gnus-character-to-event 'identity) - (defalias 'gnus-add-text-properties 'add-text-properties) - (defalias 'gnus-put-text-property 'put-text-property) - (defalias 'gnus-mode-line-buffer-identification 'identity) - (defalias 'gnus-characterp 'numberp) - (defalias 'gnus-deactivate-mark 'deactivate-mark) - (defalias 'gnus-window-edges 'window-edges) - (defalias 'gnus-key-press-event-p 'numberp)) - -;; We define these group faces here to avoid the display -;; update forced when creating new faces. - -(defface gnus-group-news-1-face - '((((class color) - (background dark)) - (:foreground "PaleTurquoise" :bold t)) - (((class color) - (background light)) - (:foreground "ForestGreen" :bold t)) - (t - ())) - "Level 1 newsgroup face.") - -(defface gnus-group-news-1-empty-face - '((((class color) - (background dark)) - (:foreground "PaleTurquoise")) - (((class color) - (background light)) - (:foreground "ForestGreen")) - (t - ())) - "Level 1 empty newsgroup face.") - -(defface gnus-group-news-2-face - '((((class color) - (background dark)) - (:foreground "turquoise" :bold t)) - (((class color) - (background light)) - (:foreground "CadetBlue4" :bold t)) - (t - ())) - "Level 2 newsgroup face.") - -(defface gnus-group-news-2-empty-face - '((((class color) - (background dark)) - (:foreground "turquoise")) - (((class color) - (background light)) - (:foreground "CadetBlue4")) - (t - ())) - "Level 2 empty newsgroup face.") - -(defface gnus-group-news-3-face - '((((class color) - (background dark)) - (:bold t)) - (((class color) - (background light)) - (:bold t)) - (t - ())) - "Level 3 newsgroup face.") - -(defface gnus-group-news-3-empty-face - '((((class color) - (background dark)) - ()) - (((class color) - (background light)) - ()) - (t - ())) - "Level 3 empty newsgroup face.") - -(defface gnus-group-news-low-face - '((((class color) - (background dark)) - (:foreground "DarkTurquoise" :bold t)) - (((class color) - (background light)) - (:foreground "DarkGreen" :bold t)) - (t - ())) - "Low level newsgroup face.") - -(defface gnus-group-news-low-empty-face - '((((class color) - (background dark)) - (:foreground "DarkTurquoise")) - (((class color) - (background light)) - (:foreground "DarkGreen")) - (t - ())) - "Low level empty newsgroup face.") - -(defface gnus-group-mail-1-face - '((((class color) - (background dark)) - (:foreground "aquamarine1" :bold t)) - (((class color) - (background light)) - (:foreground "DeepPink3" :bold t)) - (t - (:bold t))) - "Level 1 mailgroup face.") - -(defface gnus-group-mail-1-empty-face - '((((class color) - (background dark)) - (:foreground "aquamarine1")) - (((class color) - (background light)) - (:foreground "DeepPink3")) - (t - (:italic t :bold t))) - "Level 1 empty mailgroup face.") - -(defface gnus-group-mail-2-face - '((((class color) - (background dark)) - (:foreground "aquamarine2" :bold t)) - (((class color) - (background light)) - (:foreground "HotPink3" :bold t)) - (t - (:bold t))) - "Level 2 mailgroup face.") - -(defface gnus-group-mail-2-empty-face - '((((class color) - (background dark)) - (:foreground "aquamarine2")) - (((class color) - (background light)) - (:foreground "HotPink3")) - (t - (:bold t))) - "Level 2 empty mailgroup face.") - -(defface gnus-group-mail-3-face - '((((class color) - (background dark)) - (:foreground "aquamarine3" :bold t)) - (((class color) - (background light)) - (:foreground "magenta4" :bold t)) - (t - (:bold t))) - "Level 3 mailgroup face.") - -(defface gnus-group-mail-3-empty-face - '((((class color) - (background dark)) - (:foreground "aquamarine3")) - (((class color) - (background light)) - (:foreground "magenta4")) - (t - ())) - "Level 3 empty mailgroup face.") - -(defface gnus-group-mail-low-face - '((((class color) - (background dark)) - (:foreground "aquamarine4" :bold t)) - (((class color) - (background light)) - (:foreground "DeepPink4" :bold t)) - (t - (:bold t))) - "Low level mailgroup face.") - -(defface gnus-group-mail-low-empty-face - '((((class color) - (background dark)) - (:foreground "aquamarine4")) - (((class color) - (background light)) - (:foreground "DeepPink4")) - (t - (:bold t))) - "Low level empty mailgroup face.") - -;; Summary mode faces. - -(defface gnus-summary-selected-face '((t - (:underline t))) - "Face used for selected articles.") - -(defface gnus-summary-cancelled-face - '((((class color)) - (:foreground "yellow" :background "black"))) - "Face used for cancelled articles.") - -(defface gnus-summary-high-ticked-face - '((((class color) - (background dark)) - (:foreground "pink" :bold t)) - (((class color) - (background light)) - (:foreground "firebrick" :bold t)) - (t - (:bold t))) - "Face used for high interest ticked articles.") - -(defface gnus-summary-low-ticked-face - '((((class color) - (background dark)) - (:foreground "pink" :italic t)) - (((class color) - (background light)) - (:foreground "firebrick" :italic t)) - (t - (:italic t))) - "Face used for low interest ticked articles.") - -(defface gnus-summary-normal-ticked-face - '((((class color) - (background dark)) - (:foreground "pink")) - (((class color) - (background light)) - (:foreground "firebrick")) - (t - ())) - "Face used for normal interest ticked articles.") - -(defface gnus-summary-high-ancient-face - '((((class color) - (background dark)) - (:foreground "SkyBlue" :bold t)) - (((class color) - (background light)) - (:foreground "RoyalBlue" :bold t)) - (t - (:bold t))) - "Face used for high interest ancient articles.") - -(defface gnus-summary-low-ancient-face - '((((class color) - (background dark)) - (:foreground "SkyBlue" :italic t)) - (((class color) - (background light)) - (:foreground "RoyalBlue" :italic t)) - (t - (:italic t))) - "Face used for low interest ancient articles.") - -(defface gnus-summary-normal-ancient-face - '((((class color) - (background dark)) - (:foreground "SkyBlue")) - (((class color) - (background light)) - (:foreground "RoyalBlue")) - (t - ())) - "Face used for normal interest ancient articles.") - -(defface gnus-summary-high-unread-face - '((t - (:bold t))) - "Face used for high interest unread articles.") - -(defface gnus-summary-low-unread-face - '((t - (:italic t))) - "Face used for low interest unread articles.") - -(defface gnus-summary-normal-unread-face - '((t - ())) - "Face used for normal interest unread articles.") - -(defface gnus-summary-high-read-face - '((((class color) - (background dark)) - (:foreground "PaleGreen" - :bold t)) - (((class color) - (background light)) - (:foreground "DarkGreen" - :bold t)) - (t - (:bold t))) - "Face used for high interest read articles.") - -(defface gnus-summary-low-read-face - '((((class color) - (background dark)) - (:foreground "PaleGreen" - :italic t)) - (((class color) - (background light)) - (:foreground "DarkGreen" - :italic t)) - (t - (:italic t))) - "Face used for low interest read articles.") - -(defface gnus-summary-normal-read-face - '((((class color) - (background dark)) - (:foreground "PaleGreen")) - (((class color) - (background light)) - (:foreground "DarkGreen")) - (t - ())) - "Face used for normal interest read articles.") - - -;;; Splash screen. - -(defvar gnus-group-buffer "*Group*") - -(eval-and-compile - (autoload 'gnus-play-jingle "gnus-audio")) - -(defface gnus-splash-face - '((((class color) - (background dark)) - (:foreground "ForestGreen")) - (((class color) - (background light)) - (:foreground "ForestGreen")) - (t - ())) - "Level 1 newsgroup face.") - -(defun gnus-splash () - (save-excursion - (switch-to-buffer (get-buffer-create gnus-group-buffer)) - (let ((buffer-read-only nil)) - (erase-buffer) - (unless gnus-inhibit-startup-message - (gnus-group-startup-message) - (sit-for 0) - (when gnus-play-startup-jingle - (gnus-play-jingle)))))) - -(defun gnus-indent-rigidly (start end arg) - "Indent rigidly using only spaces and no tabs." - (save-excursion - (save-restriction - (narrow-to-region start end) - (let ((tab-width 8)) - (indent-rigidly start end arg) - ;; We translate tabs into spaces -- not everybody uses - ;; an 8-character tab. - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (replace-match " " t t)))))) - -(defvar gnus-simple-splash nil) - -(defun gnus-group-startup-message (&optional x y) - "Insert startup message in current buffer." - ;; Insert the message. - (erase-buffer) - (insert - (format " %s - _ ___ _ _ - _ ___ __ ___ __ _ ___ - __ _ ___ __ ___ - _ ___ _ - _ _ __ _ - ___ __ _ - __ _ - _ _ _ - _ _ _ - _ _ _ - __ ___ - _ _ _ _ - _ _ - _ _ - _ _ - _ - __ - -" - "")) - ;; And then hack it. - (gnus-indent-rigidly (point-min) (point-max) - (/ (max (- (window-width) (or x 46)) 0) 2)) - (goto-char (point-min)) - (forward-line 1) - (let* ((pheight (count-lines (point-min) (point-max))) - (wheight (window-height)) - (rest (- wheight pheight))) - (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) - ;; Fontify some. - (put-text-property (point-min) (point-max) 'face 'gnus-splash-face) - (goto-char (point-min)) - (setq mode-line-buffer-identification (concat " " gnus-version)) - (setq gnus-simple-splash t) - (set-buffer-modified-p t)) - -(eval-when (load) - (let ((command (format "%s" this-command))) - (when (and (string-match "gnus" command) - (not (string-match "gnus-other-frame" command))) - (gnus-splash)))) - -;;; Do the rest. - -(require 'custom) -(require 'gnus-util) -(require 'nnheader) - -(defcustom gnus-home-directory "~/" - "*Directory variable that specifies the \"home\" directory. -All other Gnus path variables are initialized from this variable." - :group 'gnus-files - :type 'directory) - -(defcustom gnus-directory (or (getenv "SAVEDIR") - (nnheader-concat gnus-home-directory "News/")) - "*Directory variable from which all other Gnus file variables are derived." - :group 'gnus-files - :type 'directory) - -(defcustom gnus-default-directory nil - "*Default directory for all Gnus buffers." - :group 'gnus-files - :type '(choice (const :tag "current" nil) - directory)) - -;; Site dependent variables. These variables should be defined in -;; paths.el. - -(defvar gnus-default-nntp-server nil - "Specify a default NNTP server. -This variable should be defined in paths.el, and should never be set -by the user. -If you want to change servers, you should use `gnus-select-method'. -See the documentation to that variable.") - -;; Don't touch this variable. -(defvar gnus-nntp-service "nntp" - "NNTP service name (\"nntp\" or 119). -This is an obsolete variable, which is scarcely used. If you use an -nntp server for your newsgroup and want to change the port number -used to 899, you would say something along these lines: - - (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))") - -(defcustom gnus-nntpserver-file "/etc/nntpserver" - "*A file with only the name of the nntp server in it." - :group 'gnus-files - :group 'gnus-server - :type 'file) - -;; This function is used to check both the environment variable -;; NNTPSERVER and the /etc/nntpserver file to see whether one can find -;; an nntp server name default. -(defun gnus-getenv-nntpserver () - (or (getenv "NNTPSERVER") - (and (file-readable-p gnus-nntpserver-file) - (save-excursion - (set-buffer (get-buffer-create " *gnus nntp*")) - (buffer-disable-undo (current-buffer)) - (insert-file-contents gnus-nntpserver-file) - (let ((name (buffer-string))) - (prog1 - (if (string-match "^[ \t\n]*$" name) - nil - name) - (kill-buffer (current-buffer)))))))) - -(defcustom gnus-select-method - (condition-case nil - (nconc - (list 'nntp (or (condition-case nil - (gnus-getenv-nntpserver) - (error nil)) - (when (and gnus-default-nntp-server - (not (string= gnus-default-nntp-server ""))) - gnus-default-nntp-server) - "news")) - (if (or (null gnus-nntp-service) - (equal gnus-nntp-service "nntp")) - nil - (list gnus-nntp-service))) - (error nil)) - "*Default method for selecting a newsgroup. -This variable should be a list, where the first element is how the -news is to be fetched, the second is the address. - -For instance, if you want to get your news via NNTP from -\"flab.flab.edu\", you could say: - -\(setq gnus-select-method '(nntp \"flab.flab.edu\")) - -If you want to use your local spool, say: - -\(setq gnus-select-method (list 'nnspool (system-name))) - -If you use this variable, you must set `gnus-nntp-server' to nil. - -There is a lot more to know about select methods and virtual servers - -see the manual for details." - :group 'gnus-server - :type 'gnus-select-method) - -(defcustom gnus-message-archive-method - `(nnfolder - "archive" - (nnfolder-directory ,(nnheader-concat message-directory "archive")) - (nnfolder-active-file - ,(nnheader-concat message-directory "archive/active")) - (nnfolder-get-new-mail nil) - (nnfolder-inhibit-expiry t)) - "*Method used for archiving messages you've sent. -This should be a mail method. - -It's probably not a very effective to change this variable once you've -run Gnus once. After doing that, you must edit this server from the -server buffer." - :group 'gnus-server - :group 'gnus-message - :type 'gnus-select-method) - -(defcustom gnus-message-archive-group nil - "*Name of the group in which to save the messages you've written. -This can either be a string; a list of strings; or an alist -of regexps/functions/forms to be evaluated to return a string (or a list -of strings). The functions are called with the name of the current -group (or nil) as a parameter. - -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\"))) - -Normally the group names returned by this variable should be -unprefixed -- which implicitly means \"store on the archive server\". -However, you may wish to store the message on some other server. In -that case, just return a fully prefixed name of the group -- -\"nnml+private:mail.misc\", for instance." - :group 'gnus-message - :type '(choice (const :tag "none" nil) - string)) - -(defcustom gnus-secondary-servers nil - "*List of NNTP servers that the user can choose between interactively. -To make Gnus query you for a server, you have to give `gnus' a -non-numeric prefix - `C-u M-x gnus', in short." - :group 'gnus-server - :type '(repeat string)) - -(defcustom gnus-nntp-server nil - "*The name of the host running the NNTP server. -This variable is semi-obsolete. Use the `gnus-select-method' -variable instead." - :group 'gnus-server - :type '(choice (const :tag "disable" nil) - string)) - -(defcustom gnus-secondary-select-methods nil - "*A list of secondary methods that will be used for reading news. -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, -you could set this variable: - -\(setq gnus-secondary-select-methods '((nnml \"\")))" -:group 'gnus-server -:type '(repeat gnus-select-method)) - -(defvar gnus-backup-default-subscribed-newsgroups - '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus") - "Default default new newsgroups the first time Gnus is run. -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 -no need to set this variable." - :group 'gnus-message - :type '(choice (const :tag "default" nil) - string)) - -(defvar gnus-local-organization nil - "String with a description of what organization (if any) the user belongs to. -Obsolete variable; use `message-user-organization' instead.") - -;; Customization variables - -(defcustom gnus-refer-article-method nil - "*Preferred method for fetching an article by Message-ID. -If you are reading news from the local spool (with nnspool), fetching -articles by Message-ID is painfully slow. By setting this method to an -nntp method, you might get acceptable results. - -The value of this variable must be a valid select method as discussed -in the documentation of `gnus-select-method'." - :group 'gnus-server - :type '(choice (const :tag "default" nil) - 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@rtfm.mit.edu:/pub/usenet/" - "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" - "/ftp@ftp.sunet.se:/pub/usenet/" - "/ftp@nctuccca.edu.tw:/USENET/FAQ/" - "/ftp@hwarang.postech.ac.kr:/pub/usenet/" - "/ftp@ftp.hk.super.net:/mirror/faqs/") - "*Directory where the group FAQs are stored. -This will most commonly be on a remote machine, and the file will be -fetched by ange-ftp. - -This variable can also be a list of directories. In that case, the -first element in the list will be used by default. The others can -be used when being prompted for a site. - -Note that Gnus uses an aol machine as the default directory. If this -feels fundamentally unclean, just think of it as a way to finally get -something of value back from them. - -If the default site is too slow, try one of these: - - North America: mirrors.aol.com /pub/rtfm/usenet - 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 - ftp.sunet.se /pub/usenet - sunsite.auc.dk /pub/usenet - Asia: nctuccca.edu.tw /USENET/FAQ - hwarang.postech.ac.kr /pub/usenet - ftp.hk.super.net /mirror/faqs" - :group 'gnus-group-various - :type '(choice directory - (repeat directory))) - -(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 -subscribed newsgroups. If neither t nor nil, mark as read in all -newsgroups." - :group 'gnus-server - :type '(choice (const :tag "off" nil) - (const :tag "subscribed" t) - (sexp :format "all" - :value always))) - -(defcustom gnus-process-mark ?# - "*Process mark." - :group 'gnus-group-visual - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-asynchronous nil - "*If non-nil, Gnus will supply backends with data needed for async article fetching." - :group 'gnus-asynchronous - :type 'boolean) - -(defcustom gnus-large-newsgroup 200 - "*The number of articles which indicates a large newsgroup. -If the number of articles in a newsgroup is greater than this value, -confirmation is required for selecting the newsgroup." - :group 'gnus-group-select - :type '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. -If it's nil, the directory form of the group name is used instead. - -If this variable is a list, and the list contains the element -`not-score', long file names will not be used for score files; if it -contains the element `not-save', long file names will not be used for -saving; and if it contains the element `not-kill', long file names -will not be used for kill files. - -Note that the default for this variable varies according to what system -type you're using. On `usg-unix-v' and `xenix' this variable defaults -to nil while on all other systems it defaults to t." - :group 'gnus-start - :type 'boolean) - -(defcustom gnus-kill-files-directory gnus-directory - "*Name of the directory where kill files will be stored (default \"~/News\")." - :group 'gnus-score-files - :group 'gnus-score-kill - :type 'directory) - -(defcustom gnus-save-score nil - "*If non-nil, save group scoring info." - :group 'gnus-score-various - :group 'gnus-start - :type 'boolean) - -(defcustom gnus-use-undo t - "*If non-nil, allow undoing in Gnus group mode buffers." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-use-adaptive-scoring nil - "*If non-nil, use some adaptive scoring scheme. -If a list, then the values `word' and `line' are meaningful. The -former will perform adaption on individual words in the subject -header while `line' will perform adaption on several headers." - :group 'gnus-meta - :group 'gnus-score-adapt - :type '(set (const word) (const line))) - -(defcustom gnus-use-cache 'passive - "*If nil, Gnus will ignore the article cache. -If `passive', it will allow entering (and reading) articles -explicitly entered into the cache. If anything else, use the -cache to the full extent of the law." - :group 'gnus-meta - :group 'gnus-cache - :type '(choice (const :tag "off" nil) - (const :tag "passive" passive) - (const :tag "active" t))) - -(defcustom gnus-use-trees nil - "*If non-nil, display a thread tree buffer." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-use-grouplens nil - "*If non-nil, use GroupLens ratings." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-keep-backlog nil - "*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 -articles. This is not a good idea." - :group 'gnus-meta - :type '(choice (const :tag "off" nil) - integer - (sexp :format "all" - :value t))) - -(defcustom gnus-use-nocem nil - "*If non-nil, Gnus will read NoCeM cancel messages." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-suppress-duplicates nil - "*If non-nil, Gnus will mark duplicate copies of the same article as read." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-use-demon nil - "*If non-nil, Gnus might use some demons." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-use-scoring t - "*If non-nil, enable scoring." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-use-picons nil - "*If non-nil, display picons." - :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. -It calls `gnus-summary-expire-articles' by default." - :group 'gnus-summary-exit - :type 'hook) - -(defcustom gnus-novice-user t - "*Non-nil means that you are a usenet novice. -If non-nil, verbose messages may be displayed and confirmations may be -required." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-expert-user nil - "*Non-nil means that you will never be asked for confirmation about anything. -That doesn't mean *anything* anything; particularly destructive -commands will still require prompting." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-interactive-catchup t - "*If non-nil, require your confirmation when catching up a group." - :group 'gnus-group-select - :type 'boolean) - -(defcustom gnus-interactive-exit t - "*If non-nil, require your confirmation when exiting Gnus." - :group 'gnus-exit - :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 -`mail-extract-address-components', which works much better, but is -slower." - :group 'gnus-summary-format - :type '(radio (function-item gnus-extract-address-components) - (function-item mail-extract-address-components) - (function :tag "Other"))) - -(defcustom gnus-carpal nil - "*If non-nil, display clickable icons." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-shell-command-separator ";" - "*String used to separate to shell commands." - :group 'gnus-files - :type 'string) - -(defcustom gnus-valid-select-methods - '(("nntp" post address prompt-address physical-address) - ("nnspool" post address) - ("nnvirtual" post-mail virtual prompt-address) - ("nnmbox" mail respool address) - ("nnml" mail respool address) - ("nnmh" mail respool address) - ("nndir" post-mail prompt-address physical-address) - ("nneething" none address prompt-address physical-address) - ("nndoc" none address prompt-address) - ("nnbabyl" mail address respool) - ("nnkiboze" post virtual) - ("nnsoup" post-mail address) - ("nndraft" post-mail) - ("nnfolder" mail respool address) - ("nngateway" none address prompt-address physical-address) - ("nnweb" none) - ("nnagent" post-mail)) - "*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 -this method (i. e., `post', `mail', `none' or whatever) or other -properties that this method has (like being respoolable). -If you implement a new select method, all you should have to change is -this variable. I think." - :group 'gnus-server - :type '(repeat (group (string :tag "Name") - (radio-button-choice (const :format "%v " post) - (const :format "%v " mail) - (const :format "%v " none) - (const post-mail)) - (checklist :inline t - (const :format "%v " address) - (const :format "%v " prompt-address) - (const :format "%v " physical-address) - (const :format "%v " virtual) - (const respool))))) - -(define-widget 'gnus-select-method 'list - "Widget for entering a select method." - :args `((choice :tag "Method" - ,@(mapcar (lambda (entry) - (list 'const :format "%v\n" - (intern (car entry)))) - gnus-valid-select-methods)) - (string :tag "Address") - (editable-list :inline t - (list :format "%v" - variable - (sexp :tag "Value"))))) - -(defcustom gnus-updated-mode-lines '(group article summary tree) - "*List of buffers that should update their mode lines. -The list may contain the symbols `group', `article', `tree' and -`summary'. If the corresponding symbol is present, Gnus will keep -that mode line updated with information that may be pertinent. -If this variable is nil, screen refresh may be quicker." - :group 'gnus-various - :type '(set (const group) - (const article) - (const summary) - (const tree))) - -;; Added by Keinonen Kari . -(defcustom gnus-mode-non-string-length nil - "*Max length of mode-line non-string contents. -If this is nil, Gnus will take space as is needed, leaving the rest -of the modeline intact. Note that the default of nil is unlikely -to be desirable; see the manual for further details." - :group 'gnus-various - :type '(choice (const nil) - integer)) - -(defcustom gnus-auto-expirable-newsgroups nil - "*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. -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)) - -(defcustom gnus-group-uncollapsed-levels 1 - "*Number of group name elements to leave alone when making a short group name." - :group 'gnus-group-visual - :type 'integer) - -(defcustom gnus-group-use-permanent-levels nil - "*If non-nil, once you set a level, Gnus will use this level." - :group 'gnus-group-levels - :type 'boolean) - -;; Hooks. - -(defcustom gnus-load-hook nil - "*A hook run while Gnus is loaded." - :group 'gnus-start - :type 'hook) - -(defcustom gnus-apply-kill-hook '(gnus-apply-kill-file) - "*A hook called to apply kill files to a group. -This hook is intended to apply a kill file to the selected newsgroup. -The function `gnus-apply-kill-file' is called by default. - -Since a general kill file is too heavy to use only for a few -newsgroups, I recommend you to use a lighter hook function. For -example, if you'd like to apply a kill file to articles which contains -a string `rmgroup' in subject in newsgroup `control', you can use the -following hook: - - (setq gnus-apply-kill-hook - (list - (lambda () - (cond ((string-match \"control\" gnus-newsgroup-name) - (gnus-kill \"Subject\" \"rmgroup\") - (gnus-expunge \"X\"))))))" - :group 'gnus-score-kill - :options '(gnus-apply-kill-file) - :type 'hook) - -(defcustom gnus-group-change-level-function nil - "*Function run when a group level is changed. -It is called with three parameters -- GROUP, LEVEL and OLDLEVEL." - :group 'gnus-group-level - :type 'function) - -;;; Face thingies. - -(defcustom gnus-visual - '(summary-highlight group-highlight article-highlight - mouse-face - summary-menu group-menu article-menu - tree-highlight menu highlight - browse-menu server-menu - page-marker tree-menu binary-menu pick-menu - grouplens-menu) - "*Enable visual features. -If `visual' is disabled, there will be no menus and few faces. Most of -the visual customization options below will be ignored. Gnus will use -less space and be faster as a result. - -This variable can also be a list of visual elements to switch on. For -instance, to switch off all visual things except menus, you can say: - - (setq gnus-visual '(menu)) - -Valid elements include `summary-highlight', `group-highlight', -`article-highlight', `mouse-face', `summary-menu', `group-menu', -`article-menu', `tree-highlight', `menu', `highlight', `browse-menu', -`server-menu', `page-marker', `tree-menu', `binary-menu', `pick-menu', -and `grouplens-menu'." - :group 'gnus-meta - :group 'gnus-visual - :type '(set (const summary-highlight) - (const group-highlight) - (const article-highlight) - (const mouse-face) - (const summary-menu) - (const group-menu) - (const article-menu) - (const tree-highlight) - (const menu) - (const highlight) - (const browse-menu) - (const server-menu) - (const page-marker) - (const tree-menu) - (const binary-menu) - (const pick-menu) - (const grouplens-menu))) - -(defcustom gnus-mouse-face - (condition-case () - (if (gnus-visual-p 'mouse-face 'highlight) - (if (boundp 'gnus-mouse-face) - (or gnus-mouse-face 'highlight) - 'highlight) - 'default) - (error 'highlight)) - "*Face used for group or summary buffer mouse highlighting. -The line beneath the mouse pointer will be highlighted with this -face." - :group 'gnus-visual - :type 'face) - -(defcustom gnus-article-display-hook - (if (and (string-match "XEmacs" emacs-version) - (featurep 'xface)) - '(gnus-article-hide-headers-if-wanted - gnus-article-hide-boring-headers - gnus-article-treat-overstrike - gnus-article-maybe-highlight - gnus-article-display-x-face) - '(gnus-article-hide-headers-if-wanted - gnus-article-hide-boring-headers - gnus-article-treat-overstrike - gnus-article-maybe-highlight)) - "*Controls how the article buffer will look. - -If you leave the list empty, the article will appear exactly as it is -stored on the disk. The list entries will hide or highlight various -parts of the article, making it easier to find the information you -want." - :group 'gnus-article-highlight - :group 'gnus-visual - :type 'hook - :options '(gnus-article-add-buttons - gnus-article-add-buttons-to-head - gnus-article-emphasize - gnus-article-fill-cited-article - gnus-article-remove-cr - gnus-article-de-quoted-unreadable - gnus-summary-stop-page-breaking - ;; gnus-summary-caesar-message - ;; gnus-summary-verbose-headers - gnus-summary-toggle-mime - gnus-article-hide - gnus-article-hide-headers - gnus-article-hide-boring-headers - gnus-article-hide-signature - gnus-article-hide-citation - gnus-article-hide-pgp - gnus-article-hide-pem - gnus-article-highlight - gnus-article-highlight-headers - gnus-article-highlight-citation - gnus-article-highlight-signature - gnus-article-date-ut - gnus-article-date-local - gnus-article-date-lapsed - gnus-article-date-original - gnus-article-remove-trailing-blank-lines - gnus-article-strip-leading-blank-lines - gnus-article-strip-multiple-blank-lines - gnus-article-strip-blank-lines - gnus-article-treat-overstrike - gnus-article-display-x-face - gnus-smiley-display)) - -(defcustom gnus-article-save-directory gnus-directory - "*Name of the directory articles will be saved in (default \"~/News\")." - :group 'gnus-article-saving - :type 'directory) - -(defvar gnus-plugged t - "Whether Gnus is plugged or not.") - - -;;; Internal variables - -(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-command-method nil - "Dynamically bound variable that says what the current backend is.") - -(defvar gnus-current-select-method nil - "The current method for selecting a newsgroup.") - -(defvar gnus-tree-buffer "*Tree*" - "Buffer where Gnus thread trees are displayed.") - -;; Dummy variable. -(defvar gnus-use-generic-from nil) - -;; Variable holding the user answers to all method prompts. -(defvar gnus-method-history nil) -(defvar gnus-group-history nil) - -;; Variable holding the user answers to all mail method prompts. -(defvar gnus-mail-method-history nil) - -;; Variable holding the user answers to all group prompts. -(defvar gnus-group-history nil) - -(defvar gnus-server-alist nil - "List of available servers.") - -(defvar gnus-predefined-server-alist - `(("cache" - (nnspool "cache" - (nnspool-spool-directory "~/News/cache/") - (nnspool-nov-directory "~/News/cache/") - (nnspool-active-file "~/News/cache/active")))) - "List of predefined (convenience) servers.") - -(defvar gnus-topic-indentation "") ;; Obsolete variable. - -(defconst gnus-article-mark-lists - '((marked . tick) (replied . reply) - (expirable . expire) (killed . killed) - (bookmarks . bookmark) (dormant . dormant) - (scored . score) (saved . save) - (cached . cache) (downloadable . download) - (unsendable . unsend))) - -(defvar gnus-headers-retrieved-by nil) -(defvar gnus-article-reply nil) -(defvar gnus-override-method nil) -(defvar gnus-article-check-size nil) -(defvar gnus-opened-servers nil) - -(defvar gnus-current-kill-article nil) - -(defvar gnus-have-read-active-file nil) - -(defconst gnus-maintainer - "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)" - "The mail address of the Gnus maintainers.") - -(defvar gnus-info-nodes - '((gnus-group-mode "(gnus)The Group Buffer") - (gnus-summary-mode "(gnus)The Summary Buffer") - (gnus-article-mode "(gnus)The Article Buffer") - (mime/viewer-mode "(gnus)The Article Buffer") - (gnus-server-mode "(gnus)The Server Buffer") - (gnus-browse-mode "(gnus)Browse Foreign Server") - (gnus-tree-mode "(gnus)Tree Display")) - "Alist of major modes and related Info nodes.") - -(defvar gnus-group-buffer "*Group*") -(defvar gnus-summary-buffer "*Summary*") -(defvar gnus-article-buffer "*Article*") -(defvar gnus-server-buffer "*Server*") - -(defvar gnus-buffer-list nil - "Gnus buffers that should be killed on exit.") - -(defvar gnus-slave nil - "Whether this Gnus is a slave or not.") - -(defvar gnus-batch-mode nil - "Whether this Gnus is running in batch mode or not.") - -(defvar gnus-variable-list - '(gnus-newsrc-options gnus-newsrc-options-n - gnus-newsrc-last-checked-date - gnus-newsrc-alist gnus-server-alist - gnus-killed-list gnus-zombie-list - gnus-topic-topology gnus-topic-alist - gnus-format-specs) - "Gnus variables saved in the quick startup file.") - -(defvar gnus-newsrc-alist nil - "Assoc list of read articles. -gnus-newsrc-hashtb should be kept so that both hold the same information.") - -(defvar gnus-newsrc-hashtb nil - "Hashtable of gnus-newsrc-alist.") - -(defvar gnus-killed-list nil - "List of killed newsgroups.") - -(defvar gnus-killed-hashtb nil - "Hash table equivalent of gnus-killed-list.") - -(defvar gnus-zombie-list nil - "List of almost dead newsgroups.") - -(defvar gnus-description-hashtb nil - "Descriptions of newsgroups.") - -(defvar gnus-list-of-killed-groups nil - "List of newsgroups that have recently been killed by the user.") - -(defvar gnus-active-hashtb nil - "Hashtable of active articles.") - -(defvar gnus-moderated-hashtb nil - "Hashtable of moderated newsgroups.") - -;; Save window configuration. -(defvar gnus-prev-winconf nil) - -(defvar gnus-reffed-article-number nil) - -;;; Let the byte-compiler know that we know about this variable. -(defvar rmail-default-rmail-file) - -(defvar gnus-dead-summary nil) - -;;; End of variables. - -;; Define some autoload functions Gnus might use. -(eval-and-compile - - ;; This little mapcar goes through the list below and marks the - ;; symbols in question as autoloaded functions. - (mapcar - (lambda (package) - (let ((interactive (nth 1 (memq ':interactive package)))) - (mapcar - (lambda (function) - (let (keymap) - (when (consp function) - (setq keymap (car (memq 'keymap function))) - (setq function (car function))) - (autoload function (car package) nil interactive keymap))) - (if (eq (nth 1 package) ':interactive) - (cdddr package) - (cdr package))))) - '(("info" Info-goto-node) - ("hexl" hexl-hex-string-to-integer) - ("pp" pp pp-to-string pp-eval-expression) - ("ps-print" ps-print-preprint) - ("mail-extr" mail-extract-address-components) - ("browse-url" browse-url) - ("message" :interactive t - message-send-and-exit message-yank-original) - ("nnmail" nnmail-split-fancy nnmail-article-group nnmail-date-to-time) - ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers) - ("timezone" timezone-make-date-arpa-standard timezone-fix-time - timezone-make-sortable-date timezone-make-time-string) - ("rmailout" rmail-output) - ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages - rmail-show-message) - ("gnus-audio" :interactive t gnus-audio-play) - ("gnus-xmas" gnus-xmas-splash) - ("gnus-soup" :interactive t - gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article - gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet) - ("nnsoup" nnsoup-pack-replies) - ("score-mode" :interactive t gnus-score-mode) - ("gnus-mh" gnus-summary-save-article-folder - gnus-Folder-save-name gnus-folder-save-name) - ("gnus-mh" :interactive t gnus-summary-save-in-folder) - ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail - gnus-demon-add-rescan gnus-demon-add-scan-timestamps - gnus-demon-add-disconnection gnus-demon-add-handler - gnus-demon-remove-handler) - ("gnus-demon" :interactive t - gnus-demon-init gnus-demon-cancel) - ("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 - gnus-nocem-unwanted-article-p) - ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info - gnus-server-server-name) - ("gnus-srvr" gnus-browse-foreign-server) - ("gnus-cite" :interactive t - gnus-article-highlight-citation gnus-article-hide-citation-maybe - gnus-article-hide-citation gnus-article-fill-cited-article - gnus-article-hide-citation-in-followups) - ("gnus-kill" gnus-kill gnus-apply-kill-file-internal - gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author - gnus-execute gnus-expunge) - ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers - gnus-cache-possibly-remove-articles gnus-cache-request-article - gnus-cache-retrieve-headers gnus-cache-possibly-alter-active - gnus-cache-enter-remove-article gnus-cached-article-p - gnus-cache-open gnus-cache-close gnus-cache-update-article) - ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article - gnus-cache-remove-article gnus-summary-insert-cached-articles) - ("gnus-score" :interactive t - gnus-summary-increase-score gnus-summary-set-score - gnus-summary-raise-thread gnus-summary-raise-same-subject - gnus-summary-raise-score gnus-summary-raise-same-subject-and-select - gnus-summary-lower-thread gnus-summary-lower-same-subject - gnus-summary-lower-score gnus-summary-lower-same-subject-and-select - gnus-summary-current-score gnus-score-default - gnus-score-flush-cache gnus-score-close - gnus-possibly-score-headers gnus-score-followup-article - gnus-score-followup-thread) - ("gnus-score" - (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers - gnus-current-score-file-nondirectory gnus-score-adaptive - gnus-score-find-trace gnus-score-file-name) - ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize) - ("gnus-topic" :interactive t gnus-topic-mode) - ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters) - ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode) - ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap)) - ("gnus-uu" :interactive t - gnus-uu-digest-mail-forward gnus-uu-digest-post-forward - gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer - gnus-uu-mark-by-regexp gnus-uu-mark-all - gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu - gnus-uu-decode-uu-and-save gnus-uu-decode-unshar - gnus-uu-decode-unshar-and-save gnus-uu-decode-save - gnus-uu-decode-binhex gnus-uu-decode-uu-view - gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view - gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view - gnus-uu-decode-binhex-view) - ("gnus-uu" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh) - ("gnus-msg" (gnus-summary-send-map keymap) - gnus-article-mail gnus-copy-article-buffer gnus-extended-version) - ("gnus-msg" :interactive t - gnus-group-post-news gnus-group-mail gnus-summary-post-news - 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 - gnus-summary-mail-forward gnus-summary-mail-other-window - gnus-summary-resend-message gnus-summary-resend-bounced-mail - gnus-bug) - ("gnus-picon" :interactive t gnus-article-display-picons - gnus-group-display-picons gnus-picons-article-display-x-face - gnus-picons-display-x-face) - ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p - gnus-grouplens-mode) - ("smiley" :interactive t gnus-smiley-display) - ("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 - gnus-offer-save-summaries gnus-make-thread-indent-array - gnus-summary-exit gnus-update-read-articles) - ("gnus-group" gnus-group-insert-group-line gnus-group-quit - gnus-group-list-groups gnus-group-first-unread-group - gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc - gnus-group-setup-buffer gnus-group-get-new-news - gnus-group-make-help-group gnus-group-update-group) - ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article - gnus-backlog-remove-article) - ("gnus-art" gnus-article-read-summary-keys gnus-article-save - gnus-article-prepare gnus-article-set-window-start - gnus-article-next-page gnus-article-prev-page - gnus-request-article-this-buffer gnus-article-mode - gnus-article-setup-buffer gnus-narrow-to-page - gnus-article-delete-invisible-text gnus-hack-decode-rfc1522) - ("gnus-art" :interactive t - gnus-article-hide-headers gnus-article-hide-boring-headers - gnus-article-treat-overstrike gnus-article-word-wrap - gnus-article-remove-cr gnus-article-remove-trailing-blank-lines - gnus-article-display-x-face gnus-article-de-quoted-unreadable - gnus-article-mime-decode-quoted-printable gnus-article-hide-pgp - gnus-article-hide-pem gnus-article-hide-signature - gnus-article-strip-leading-blank-lines gnus-article-date-local - gnus-article-date-original gnus-article-date-lapsed - gnus-article-show-all-headers - gnus-article-edit-mode gnus-article-edit-article - gnus-article-edit-done gnus-decode-rfc1522 article-decode-rfc1522 - 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-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article - gnus-dup-enter-articles) - ("gnus-range" gnus-copy-sequence) - ("gnus-eform" gnus-edit-form) - ("gnus-move" :interactive t - gnus-group-move-group-to-server gnus-change-server) - ("gnus-logic" gnus-score-advanced) - ("gnus-undo" gnus-undo-mode gnus-undo-register) - ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next - gnus-async-prefetch-article gnus-async-prefetch-remove-group - gnus-async-halt-prefetch) - ("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-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)))) - -;;; gnus-sum.el thingies - - -(defcustom gnus-summary-line-format "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" - "*The format specification of the lines in the summary buffer. - -It works along the same lines as a normal formatting string, -with some simple extensions. - -%N Article number, left padded with spaces (string) -%S Subject (string) -%s Subject if it is at the root of a thread, and \"\" otherwise (string) -%n Name of the poster (string) -%a Extracted name of the poster (string) -%A Extracted address of the poster (string) -%F Contents of the From: header (string) -%x Contents of the Xref: header (string) -%D Date of the article (string) -%d Date of the article (string) in DD-MMM format -%M Message-id of the article (string) -%r References of the article (string) -%c Number of characters in the article (integer) -%L Number of lines in the article (integer) -%I Indentation based on thread level (a string of spaces) -%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) -%U Status of this article (character, \"R\", \"K\", \"-\" or \" \") -%[ Opening bracket (character, \"[\" or \"<\") -%] Closing bracket (character, \"]\" or \">\") -%> Spaces of length thread-level (string) -%< Spaces of length (- 20 thread-level) (string) -%i Article score (number) -%z Article zcore (character) -%t Number of articles under the current thread (number). -%e Whether the thread is empty or not (character). -%l GroupLens score (string). -%V Total thread score (number). -%P The line number (number). -%O Download mark (character). -%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 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 -it is illegal 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 -possible. - -This restriction may disappear in later versions of Gnus." - :type 'string - :group 'gnus-summary-format) - -;;; -;;; Skeleton keymaps -;;; - -(defun gnus-suppress-keymap (keymap) - (suppress-keymap keymap) - (let ((keys `([backspace] [delete] "\177" "\M-u"))) ;gnus-mouse-2 - (while keys - (define-key keymap (pop keys) 'undefined)))) - -(defvar gnus-article-mode-map - (let ((keymap (make-keymap))) - (gnus-suppress-keymap keymap) - keymap)) -(defvar gnus-summary-mode-map - (let ((keymap (make-keymap))) - (gnus-suppress-keymap keymap) - keymap)) -(defvar gnus-group-mode-map - (let ((keymap (make-keymap))) - (gnus-suppress-keymap keymap) - keymap)) - - - -;; Fix by Hallvard B Furuseth . -;; If you want the cursor to go somewhere else, set these two -;; functions in some startup hook to whatever you want. -(defalias 'gnus-summary-position-point 'gnus-goto-colon) -(defalias 'gnus-group-position-point 'gnus-goto-colon) - -;;; Various macros and substs. - -(defun gnus-header-from (header) - (mail-header-from header)) - -(defmacro gnus-gethash (string hashtable) - "Get hash value of STRING in HASHTABLE." - `(symbol-value (intern-soft ,string ,hashtable))) - -(defmacro gnus-sethash (string value hashtable) - "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." - `(set (intern ,string ,hashtable) ,value)) -(put 'gnus-sethash 'edebug-form-spec '(form form form)) - -(defmacro gnus-group-unread (group) - "Get the currently computed number of unread articles in GROUP." - `(car (gnus-gethash ,group gnus-newsrc-hashtb))) - -(defmacro gnus-group-entry (group) - "Get the newsrc entry for GROUP." - `(gnus-gethash ,group gnus-newsrc-hashtb)) - -(defmacro gnus-active (group) - "Get active info on GROUP." - `(gnus-gethash ,group gnus-active-hashtb)) - -(defmacro gnus-set-active (group active) - "Set GROUP's active info." - `(gnus-sethash ,group ,active gnus-active-hashtb)) - -(defun gnus-alive-p () - "Say whether Gnus is running or not." - (and gnus-group-buffer - (get-buffer gnus-group-buffer) - (save-excursion - (set-buffer gnus-group-buffer) - (eq major-mode 'gnus-group-mode)))) - -;; Info access macros. - -(defmacro gnus-info-group (info) - `(nth 0 ,info)) -(defmacro gnus-info-rank (info) - `(nth 1 ,info)) -(defmacro gnus-info-read (info) - `(nth 2 ,info)) -(defmacro gnus-info-marks (info) - `(nth 3 ,info)) -(defmacro gnus-info-method (info) - `(nth 4 ,info)) -(defmacro gnus-info-params (info) - `(nth 5 ,info)) - -(defmacro gnus-info-level (info) - `(let ((rank (gnus-info-rank ,info))) - (if (consp rank) - (car rank) - rank))) -(defmacro gnus-info-score (info) - `(let ((rank (gnus-info-rank ,info))) - (or (and (consp rank) (cdr rank)) 0))) - -(defmacro gnus-info-set-group (info group) - `(setcar ,info ,group)) -(defmacro gnus-info-set-rank (info rank) - `(setcar (nthcdr 1 ,info) ,rank)) -(defmacro gnus-info-set-read (info read) - `(setcar (nthcdr 2 ,info) ,read)) -(defmacro gnus-info-set-marks (info marks &optional extend) - (if extend - `(gnus-info-set-entry ,info ,marks 3) - `(setcar (nthcdr 3 ,info) ,marks))) -(defmacro gnus-info-set-method (info method &optional extend) - (if extend - `(gnus-info-set-entry ,info ,method 4) - `(setcar (nthcdr 4 ,info) ,method))) -(defmacro gnus-info-set-params (info params &optional extend) - (if extend - `(gnus-info-set-entry ,info ,params 5) - `(setcar (nthcdr 5 ,info) ,params))) - -(defun gnus-info-set-entry (info entry number) - ;; Extend the info until we have enough elements. - (while (<= (length info) number) - (nconc info (list nil))) - ;; Set the entry. - (setcar (nthcdr number info) entry)) - -(defmacro gnus-info-set-level (info level) - `(let ((rank (cdr ,info))) - (if (consp (car rank)) - (setcar (car rank) ,level) - (setcar rank ,level)))) -(defmacro gnus-info-set-score (info score) - `(let ((rank (cdr ,info))) - (if (consp (car rank)) - (setcdr (car rank) ,score) - (setcar rank (cons (car rank) ,score))))) - -(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. - -(require 'gnus-ems) - - -;;; -;;; Shutdown -;;; - -(defvar gnus-shutdown-alist nil) - -(defun gnus-add-shutdown (function &rest symbols) - "Run FUNCTION whenever one of SYMBOLS is shut down." - (push (cons function symbols) gnus-shutdown-alist)) - -(defun gnus-shutdown (symbol) - "Shut down everything that waits for SYMBOL." - (let ((alist gnus-shutdown-alist) - entry) - (while (setq entry (pop alist)) - (when (memq symbol (cdr entry)) - (funcall (car entry)))))) - - -;;; -;;; Gnus Utility Functions -;;; - -(defmacro gnus-string-or (&rest strings) - "Return the first element of STRINGS that is a non-blank string. -STRINGS will be evaluated in normal `or' order." - `(gnus-string-or-1 ',strings)) - -(defun gnus-string-or-1 (strings) - (let (string) - (while strings - (setq string (eval (pop strings))) - (if (string-match "^[ \t]*$" string) - (setq string nil) - (setq strings nil))) - string)) - -;; Add the current buffer to the list of buffers to be killed on exit. -(defun gnus-add-current-to-buffer-list () - (or (memq (current-buffer) gnus-buffer-list) - (push (current-buffer) gnus-buffer-list))) - -(defun gnus-version (&optional arg) - "Version number of this version of Gnus. -If ARG, insert string at point." - (interactive "P") - (let ((methods gnus-valid-select-methods) - (mess gnus-version) - meth) - ;; Go through all the legal select methods and add their version - ;; numbers to the total version string. Only the backends that are - ;; currently in use will have their message numbers taken into - ;; consideration. - (while methods - (setq meth (intern (concat (caar methods) "-version"))) - (and (boundp meth) - (stringp (symbol-value meth)) - (setq mess (concat mess "; " (symbol-value meth)))) - (setq methods (cdr methods))) - (if arg - (insert (message mess)) - (message mess)))) - -(defun gnus-continuum-version (version) - "Return VERSION as a floating point number." - (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) - (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) - (let* ((alpha (and (match-beginning 1) (match-string 1 version))) - (number (match-string 2 version)) - major minor least) - (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number) - (setq major (string-to-number (match-string 1 number))) - (setq minor (string-to-number (match-string 2 number))) - (setq least (if (match-beginning 3) - (string-to-number (match-string 3 number)) - 0)) - (string-to-number - (if (zerop major) - (format "%s00%02d%02d" - (cond - ((member alpha '("(ding)" "d")) "4.99") - ((member alpha '("September" "s")) "5.01") - ((member alpha '("Red" "r")) "5.03")) - minor least) - (format "%d.%02d%02d" major minor least)))))) - -(defun gnus-info-find-node () - "Find Info documentation of Gnus." - (interactive) - ;; Enlarge info window if needed. - (let (gnus-info-buffer) - (Info-goto-node (cadr (assq major-mode gnus-info-nodes))) - (setq gnus-info-buffer (current-buffer)) - (gnus-configure-windows 'info))) - -;;; -;;; gnus-interactive -;;; - -(defvar gnus-current-prefix-symbol nil - "Current prefix symbol.") - -(defvar gnus-current-prefix-symbols nil - "List of current prefix symbols.") - -(defun gnus-interactive (string &optional params) - "Return a list that can be fed to `interactive'. -See `interactive' for full documentation. - -Adds the following specs: - -y -- The current symbolic prefix. -Y -- A list of the current symbolic prefix(es). -A -- Article number. -H -- Article header. -g -- Group name." - (let ((i 0) - out c prompt) - (while (< i (length string)) - (string-match ".\\([^\n]*\\)\n?" string i) - (setq c (aref string i)) - (when (match-end 1) - (setq prompt (match-string 1 string))) - (setq i (match-end 0)) - ;; We basically emulate just about everything that - ;; `interactive' does, but adds the "g" and "G" specs. - (push - (cond - ((= c ?a) - (completing-read prompt obarray 'fboundp t)) - ((= c ?b) - (read-buffer prompt (current-buffer) t)) - ((= c ?B) - (read-buffer prompt (other-buffer (current-buffer)))) - ((= c ?c) - (read-char)) - ((= c ?C) - (completing-read prompt obarray 'commandp t)) - ((= c ?d) - (point)) - ((= c ?D) - (read-file-name prompt nil default-directory 'lambda)) - ((= c ?f) - (read-file-name prompt nil nil 'lambda)) - ((= c ?F) - (read-file-name prompt)) - ((= c ?k) - (read-key-sequence prompt)) - ((= c ?K) - (error "Not implemented spec")) - ((= c ?e) - (error "Not implemented spec")) - ((= c ?m) - (mark)) - ((= c ?N) - (error "Not implemented spec")) - ((= c ?n) - (string-to-number (read-from-minibuffer prompt))) - ((= c ?p) - (prefix-numeric-value current-prefix-arg)) - ((= c ?P) - current-prefix-arg) - ((= c ?r) - 'gnus-prefix-nil) - ((= c ?s) - (read-string prompt)) - ((= c ?S) - (intern (read-string prompt))) - ((= c ?v) - (read-variable prompt)) - ((= c ?x) - (read-minibuffer prompt)) - ((= c ?x) - (eval-minibuffer prompt)) - ;; And here the new specs come. - ((= c ?y) - gnus-current-prefix-symbol) - ((= c ?Y) - gnus-current-prefix-symbols) - ((= c ?g) - (gnus-group-group-name)) - ((= c ?A) - (gnus-summary-article-number)) - ((= c ?H) - (gnus-summary-article-header)) - (t - (error "Not implemented spec"))) - out) - (cond - ((= c ?r) - (push (if (< (point) (mark) (point) (mark))) out) - (push (if (> (point) (mark) (point) (mark))) out)))) - (setq out (delq 'gnus-prefix-nil out)) - (nreverse out))) - -(defun gnus-symbolic-argument (&optional arg) - "Read a symbolic argument and a command, and then execute command." - (interactive "P") - (let* ((in-command (this-command-keys)) - (command in-command) - gnus-current-prefix-symbols - gnus-current-prefix-symbol - syms) - (while (equal in-command command) - (message "%s-" (key-description (this-command-keys))) - (push (intern (char-to-string (read-char))) syms) - (setq command (read-key-sequence nil t))) - (setq gnus-current-prefix-symbols (nreverse syms) - gnus-current-prefix-symbol (car gnus-current-prefix-symbols)) - (call-interactively (key-binding command t)))) - -;;; More various functions. - -(defsubst gnus-check-backend-function (func group) - "Check whether GROUP supports function FUNC. -GROUP can either be a string (a group name) or a select method." - (ignore-errors - (let ((method (if (stringp group) - (car (gnus-find-method-for-group group)) - group))) - (unless (featurep method) - (require method)) - (fboundp (intern (format "%s-%s" method func)))))) - -(defun gnus-group-read-only-p (&optional group) - "Check whether GROUP supports editing or not. -If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note -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))) - gnus-valid-select-methods))) - -(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. - (eq (gnus-request-type group article) 'news)))) - -;; Returns a list of writable groups. -(defun gnus-writable-groups () - (let ((alist gnus-newsrc-alist) - groups group) - (while (setq group (car (pop alist))) - (unless (gnus-group-read-only-p group) - (push group groups))) - (nreverse groups))) - -;; Check whether to use long file names. -(defun gnus-use-long-file-name (symbol) - ;; The variable has to be set... - (and gnus-use-long-file-name - ;; If it isn't a list, then we return t. - (or (not (listp gnus-use-long-file-name)) - ;; If it is a list, and the list contains `symbol', we - ;; return nil. - (not (memq symbol gnus-use-long-file-name))))) - -;; Generate a unique new group name. -(defun gnus-generate-new-group-name (leaf) - (let ((name leaf) - (num 0)) - (while (gnus-gethash name gnus-newsrc-hashtb) - (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">"))) - name)) - -(defun gnus-ephemeral-group-p (group) - "Say whether GROUP is ephemeral or not." - (gnus-group-get-parameter group 'quit-config)) - -(defun gnus-group-quit-config (group) - "Return the quit-config of GROUP." - (gnus-group-get-parameter group 'quit-config)) - -(defun gnus-kill-ephemeral-group (group) - "Remove ephemeral GROUP from relevant structures." - (gnus-sethash group nil gnus-newsrc-hashtb)) - -(defun gnus-simplify-mode-line () - "Make mode lines a bit simpler." - (setq mode-line-modified (cdr gnus-mode-line-modified)) - (when (listp mode-line-format) - (make-local-variable 'mode-line-format) - (setq mode-line-format (copy-sequence mode-line-format)) - (when (equal (nth 3 mode-line-format) " ") - (setcar (nthcdr 3 mode-line-format) " ")))) - -;;; Servers and groups. - -(defsubst gnus-server-add-address (method) - (let ((method-name (symbol-name (car method)))) - (if (and (memq 'address (assoc method-name gnus-valid-select-methods)) - (not (assq (intern (concat method-name "-address")) method)) - (memq 'physical-address (assq (car method) - gnus-valid-select-methods))) - (append method (list (list (intern (concat method-name "-address")) - (nth 1 method)))) - method))) - -(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. - (cond ((stringp method) - (gnus-server-to-method method)) - ((equal method gnus-select-method) - gnus-select-method) - ((and (stringp (car method)) group) - (gnus-server-extend-method group method)) - ((and method (not group) - (equal (cadr method) "")) - method) - (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)))) - -(defmacro gnus-method-equal (ss1 ss2) - "Say whether two servers are equal." - `(let ((s1 ,ss1) - (s2 ,ss2)) - (or (equal s1 s2) - (and (= (length s1) (length s2)) - (progn - (while (and s1 (member (car s1) s2)) - (setq s1 (cdr s1))) - (null s1)))))) - -(defun gnus-server-equal (m1 m2) - "Say whether two methods are equal." - (let ((m1 (cond ((null m1) gnus-select-method) - ((stringp m1) (gnus-server-to-method m1)) - (t m1))) - (m2 (cond ((null m2) gnus-select-method) - ((stringp m2) (gnus-server-to-method m2)) - (t m2)))) - (gnus-method-equal m1 m2))) - -(defun gnus-servers-using-backend (backend) - "Return a list of known servers using BACKEND." - (let ((opened gnus-opened-servers) - out) - (while opened - (when (eq backend (caaar opened)) - (push (caar opened) out)) - (pop opened)) - out)) - -(defun gnus-archive-server-wanted-p () - "Say whether the user wants to use the archive server." - (cond - ((or (not gnus-message-archive-method) - (not gnus-message-archive-group)) - nil) - ((and gnus-message-archive-method gnus-message-archive-group) - t) - (t - (let ((active (cadr (assq 'nnfolder-active-file - gnus-message-archive-method)))) - (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))) - (if (or (not method) - (gnus-server-equal method "native")) - 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))) - -(defun gnus-group-real-prefix (group) - "Return the prefix of the current group name." - (if (string-match "^[^:]+:" group) - (substring group 0 (match-end 0)) - "")) - -(defun gnus-group-method (group) - "Return the server or method used for selecting GROUP. -You should probably use `gnus-find-method-for-group' instead." - (let ((prefix (gnus-group-real-prefix group))) - (if (equal prefix "") - gnus-select-method - (let ((servers gnus-opened-servers) - (server "") - backend possible found) - (if (string-match "^[^\\+]+\\+" prefix) - (setq backend (intern (substring prefix 0 (1- (match-end 0)))) - server (substring prefix (match-end 0) (1- (length prefix)))) - (setq backend (intern (substring prefix 0 (1- (length prefix)))))) - (while servers - (when (eq (caaar servers) backend) - (setq possible (caar servers)) - (when (equal (cadaar servers) server) - (setq found (caar servers)))) - (pop servers)) - (or (car (rassoc found gnus-server-alist)) - found - (car (rassoc possible gnus-server-alist)) - possible - (list backend server)))))) - -(defsubst gnus-secondary-method-p (method) - "Return whether METHOD is a secondary select method." - (let ((methods gnus-secondary-select-methods) - (gmethod (gnus-server-get-method nil method))) - (while (and methods - (not (equal (gnus-server-get-method nil (car methods)) - gmethod))) - (setq methods (cdr methods))) - methods)) - -(defun gnus-groups-from-server (server) - "Return a list of all groups that are fetched from SERVER." - (let ((alist (cdr gnus-newsrc-alist)) - info groups) - (while (setq info (pop alist)) - (when (gnus-server-equal (gnus-info-method info) server) - (push (gnus-info-group info) groups))) - (sort groups 'string<))) - -(defun gnus-group-foreign-p (group) - "Say whether a group is foreign or not." - (and (not (gnus-group-native-p group)) - (not (gnus-group-secondary-p group)))) - -(defun gnus-group-native-p (group) - "Say whether the group is native or not." - (not (string-match ":" group))) - -(defun gnus-group-secondary-p (group) - "Say whether the group is secondary or not." - (gnus-secondary-method-p (gnus-find-method-for-group group))) - -(defun gnus-group-find-parameter (group &optional symbol) - "Return the group parameters for GROUP. -If SYMBOL, return the value of that symbol in the group parameters." - (save-excursion - (set-buffer gnus-group-buffer) - (let ((parameters (funcall gnus-group-get-parameter-function group))) - (if symbol - (gnus-group-parameter-value parameters symbol) - parameters)))) - -(defun gnus-group-get-parameter (group &optional symbol) - "Return the group parameters for GROUP. -If SYMBOL, return the value of that symbol in the group parameters. -Most functions should use `gnus-group-find-parameter', which -also examines the topic parameters." - (let ((params (gnus-info-params (gnus-get-info group)))) - (if symbol - (gnus-group-parameter-value params symbol) - params))) - -(defun gnus-group-parameter-value (params symbol) - "Return the value of SYMBOL in group PARAMS." - (or (car (memq symbol params)) ; It's either a simple symbol - (cdr (assq symbol params)))) ; or a cons. - -(defun gnus-group-add-parameter (group param) - "Add parameter PARAM to GROUP." - (let ((info (gnus-get-info group))) - (when info - (gnus-group-remove-parameter group (if (consp param) (car param) param)) - ;; Cons the new param to the old one and update. - (gnus-group-set-info (cons param (gnus-info-params info)) - group 'params)))) - -(defun gnus-group-set-parameter (group name value) - "Set parameter NAME to VALUE in GROUP." - (let ((info (gnus-get-info group))) - (when info - (gnus-group-remove-parameter group name) - (let ((old-params (gnus-info-params info)) - (new-params (list (cons name value)))) - (while old-params - (when (or (not (listp (car old-params))) - (not (eq (caar old-params) name))) - (setq new-params (append new-params (list (car old-params))))) - (setq old-params (cdr old-params))) - (gnus-group-set-info new-params group 'params))))) - -(defun gnus-group-remove-parameter (group name) - "Remove parameter NAME from GROUP." - (let ((info (gnus-get-info group))) - (when info - (let ((params (gnus-info-params info))) - (when params - (setq params (delq name params)) - (while (assq name params) - (setq params (delq (assq name params) params))) - (gnus-info-set-params info params)))))) - -(defun gnus-group-add-score (group &optional score) - "Add SCORE to the GROUP score. -If SCORE is nil, add 1 to the score of GROUP." - (let ((info (gnus-get-info group))) - (when info - (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))) - -;; Function written by Stainless Steel Rat -(defun gnus-short-group-name (group &optional levels) - "Collapse GROUP name LEVELS. -Select methods are stripped and any remote host name is stripped down to -just the host name." - (let* ((name "") (foreign "") (depth -1) (skip 1) - (levels (or levels - (progn - (while (string-match "\\." group skip) - (setq skip (match-end 0) - depth (+ depth 1))) - depth)))) - ;; separate foreign select method from group name and collapse. - ;; if method contains a server, collapse to non-domain server name, - ;; otherwise collapse to select method - (when (string-match ":" group) - (cond ((string-match "+" group) - (let* ((plus (string-match "+" group)) - (colon (string-match ":" group (or plus 0))) - (dot (string-match "\\." group))) - (setq foreign (concat - (substring group (+ 1 plus) - (cond ((null dot) colon) - ((< colon dot) colon) - ((< dot colon) dot))) - ":") - group (substring group (+ 1 colon))))) - (t - (let* ((colon (string-match ":" group))) - (setq foreign (concat (substring group 0 (+ 1 colon))) - group (substring group (+ 1 colon))))))) - ;; collapse group name leaving LEVELS uncollapsed elements - (while group - (if (and (string-match "\\." group) (> levels 0)) - (setq name (concat name (substring group 0 1)) - group (substring group (match-end 0)) - levels (- levels 1) - name (concat name ".")) - (setq name (concat foreign name group) - group nil))) - name)) - -(defun gnus-narrow-to-body () - "Narrow to the body of an article." - (narrow-to-region - (progn - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) - (point-max))) - (point-max))) - - -;;; -;;; Kill file handling. -;;; - -(defun gnus-apply-kill-file () - "Apply a kill file to the current newsgroup. -Returns the number of articles marked as read." - (if (or (file-exists-p (gnus-newsgroup-kill-file nil)) - (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (gnus-apply-kill-file-internal) - 0)) - -(defun gnus-kill-save-kill-buffer () - (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (when (get-file-buffer file) - (save-excursion - (set-buffer (get-file-buffer file)) - (when (buffer-modified-p) - (save-buffer)) - (kill-buffer (current-buffer)))))) - -(defcustom gnus-kill-file-name "KILL" - "*Suffix of the kill files." - :group 'gnus-score-kill - :group 'gnus-score-files - :type 'string) - -(defun gnus-newsgroup-kill-file (newsgroup) - "Return the name of a kill file name for NEWSGROUP. -If NEWSGROUP is nil, return the global kill file name instead." - (cond - ;; The global KILL file is placed at top of the directory. - ((or (null newsgroup) - (string-equal newsgroup "")) - (expand-file-name gnus-kill-file-name - gnus-kill-files-directory)) - ;; Append ".KILL" to newsgroup name. - ((gnus-use-long-file-name 'not-kill) - (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) - "." gnus-kill-file-name) - gnus-kill-files-directory)) - ;; Place "KILL" under the hierarchical directory. - (t - (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) - "/" gnus-kill-file-name) - gnus-kill-files-directory)))) - -;;; Server things. - -(defun gnus-member-of-valid (symbol group) - "Find out if GROUP has SYMBOL as part of its \"valid\" spec." - (memq symbol (assoc - (symbol-name (car (gnus-find-method-for-group group))) - gnus-valid-select-methods))) - -(defun gnus-method-option-p (method option) - "Return non-nil if select METHOD has OPTION as a parameter." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (memq option (assoc (format "%s" (car method)) - gnus-valid-select-methods))) - -(defun gnus-similar-server-opened (method) - (let ((opened gnus-opened-servers)) - (while (and method opened) - (when (and (equal (cadr method) (cadaar opened)) - (not (equal method (caar opened)))) - (setq method nil)) - (pop opened)) - (not method))) - -(defun gnus-server-extend-method (group method) - ;; This function "extends" a virtual server. If the server is - ;; "hello", and the select method is ("hello" (my-var "something")) - ;; in the group "alt.alt", this will result in a new virtual server - ;; called "hello+alt.alt". - (if (or (not (inline (gnus-similar-server-opened method))) - (not (cddr method))) - method - `(,(car method) ,(concat (cadr method) "+" group) - (,(intern (format "%s-address" (car method))) ,(cadr method)) - ,@(cddr method)))) - -(defun gnus-server-status (method) - "Return the status of METHOD." - (nth 1 (assoc method gnus-opened-servers))) - -(defun gnus-group-name-to-method (group) - "Guess a select method based on GROUP." - (if (string-match ":" group) - (let ((server (substring group 0 (match-beginning 0)))) - (if (string-match "\\+" server) - (list (intern (substring server 0 (match-beginning 0))) - (substring server (match-end 0))) - (list (intern server) ""))) - gnus-select-method)) - -(defun gnus-find-method-for-group (group &optional info) - "Find the select method that GROUP uses." - (or gnus-override-method - (and (not group) - gnus-select-method) - (let ((info (or info (gnus-get-info group))) - method) - (if (or (not info) - (not (setq method (gnus-info-method info))) - (equal method "native")) - gnus-select-method - (setq method - (cond ((stringp method) - (inline (gnus-server-to-method method))) - ((stringp (cadr method)) - (inline (gnus-server-extend-method group method))) - (t - method))) - (cond ((equal (cadr method) "") - method) - ((null (cadr method)) - (list (car method) "")) - (t - (gnus-server-add-address method))))))) - -(defun gnus-methods-using (feature) - "Find all methods that have FEATURE." - (let ((valids gnus-valid-select-methods) - outs) - (while valids - (when (memq feature (car valids)) - (push (car valids) outs)) - (setq valids (cdr valids))) - outs)) - -(defun gnus-read-group (prompt &optional default) - "Prompt the user for a group name. -Disallow illegal group names." - (let ((prefix "") - group) - (while (not group) - (when (string-match - "[: `'\"/]\\|^$" - (setq group (read-string (concat prefix prompt) - (cons (or default "") 0) - 'gnus-group-history))) - (setq prefix (format "Illegal group name: \"%s\". " group) - group nil))) - group)) - -(defun gnus-read-method (prompt) - "Prompt the user for a method. -Allow completion over sensible values." - (let ((method - (completing-read - prompt (append gnus-valid-select-methods gnus-predefined-server-alist - gnus-server-alist) - nil t nil 'gnus-method-history))) - (cond - ((equal method "") - (setq method gnus-select-method)) - ((assoc method gnus-valid-select-methods) - (list (intern method) - (if (memq 'prompt-address - (assoc method gnus-valid-select-methods)) - (read-string "Address: ") - ""))) - ((assoc method gnus-server-alist) - method) - (t - (list (intern method) ""))))) - -;;; User-level commands. - -;;;###autoload -(defun gnus-slave-no-server (&optional arg) - "Read network news as a slave, without connecting to 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." - (interactive "P") - (gnus-no-server-1 arg slave)) - -;;;###autoload -(defun gnus-slave (&optional arg) - "Read news as a slave." - (interactive "P") - (gnus arg nil 'slave)) - -;;;###autoload -(defun gnus-other-frame (&optional arg) - "Pop up a frame to read news." - (interactive "P") - (let ((window (get-buffer-window gnus-group-buffer))) - (cond (window - (select-frame (window-frame window))) - ((= (length (frame-list)) 1) - (select-frame (make-frame))) - (t - (other-frame 1)))) - (gnus arg)) - -;;;###autoload -(defun gnus (&optional arg dont-connect slave) - "Read network news. -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") - (gnus-1 arg dont-connect slave)) - -;; Allow redefinition of Gnus functions. - -(gnus-ems-redefine) - -(provide 'gnus) - -;;; gnus.el ends here diff --git a/lisp/lpath.el b/lisp/lpath.el deleted file mode 100644 index 7d92912..0000000 --- a/lisp/lpath.el +++ /dev/null @@ -1,67 +0,0 @@ -;; Shut up. - -(defvar byte-compile-default-warnings) - -(or (featurep 'path-util) - (load "apel/path-util")) -(add-path "apel") -(add-path "mel") -(add-path "semi") - -(defun maybe-fbind (args) - (while args - (or (fboundp (car args)) - (fset (car args) 'ignore)) - (setq args (cdr args)))) - -(defun maybe-bind (args) - (mapcar (lambda (var) (unless (boundp var) (set var nil))) args)) - -(if (string-match "XEmacs" emacs-version) - (progn - (defvar track-mouse nil) - (maybe-fbind '(posn-point - event-start x-popup-menu - facemenu-get-face window-at coordinates-in-window-p - compute-motion x-defined-colors easy-menu-create-keymaps - read-event internal-find-face internal-next-face-id - make-face-internal set-frame-face-alist frame-face-alist - facemenu-add-new-face make-face-x-resource-internal - set-font-size set-font-family posn-window - run-with-idle-timer mouse-minibuffer-check window-edges - event-click-count track-mouse read-event mouse-movement-p - event-end mouse-scroll-subr overlay-lists delete-overlay - set-face-stipple mail-abbrevs-setup char-int - make-char-table set-char-table-range font-create-object - x-color-values widget-make-intangible error-message-string - w3-form-encode-xwfu gnus-mule-get-coding-system - decode-coding-string)) - (maybe-bind '(global-face-data - mark-active transient-mark-mode mouse-selection-click-count - mouse-selection-click-count-buffer buffer-display-table - font-lock-defaults user-full-name user-login-name - gnus-newsgroup-name gnus-article-x-face-too-ugly - mail-mode-hook enable-multibyte-characters))) - (maybe-bind '(mail-mode-hook - enable-multibyte-characters browse-url-browser-function)) - (maybe-fbind '(color-instance-rgb-components - make-color-instance color-instance-name specifier-instance - device-type device-class get-popup-menu-response event-object - x-defined-colors read-color add-submenu set-font-family - font-create-object set-font-size frame-device find-face - set-extent-property make-extent characterp display-error - set-face-doc-string frame-property face-doc-string - button-press-event-p next-command-event - widget-make-intangible glyphp make-glyph set-glyph-image - set-glyph-property event-glyph glyph-property event-point - device-on-window-system-p make-gui-button Info-goto-node - pp-to-string color-name - gnus-mule-get-coding-system decode-coding-string))) - -(setq load-path (cons "." load-path)) -(require 'custom) - -(defun md5 (a &optional b c) - ) - -(provide 'lpath) diff --git a/lisp/mailheader.el b/lisp/mailheader.el deleted file mode 100644 index 5e2b097..0000000 --- a/lisp/mailheader.el +++ /dev/null @@ -1,182 +0,0 @@ -;;; mail-header.el --- Mail header parsing, merging, formatting - -;; Copyright (C) 1996 by Free Software Foundation, Inc. - -;; Author: Erik Naggum -;; Keywords: tools, mail, news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This package provides an abstraction to RFC822-style messages, used in -;; mail news, and some other systems. The simple syntactic rules for such -;; headers, such as quoting and line folding, are routinely reimplemented -;; in many individual packages. This package removes the need for this -;; redundancy by representing message headers as association lists, -;; offering functions to extract the set of headers from a message, to -;; parse individual headers, to merge sets of headers, and to format a set -;; of headers. - -;; The car of each element in the message-header alist is a symbol whose -;; print name is the name of the header, in all lower-case. The cdr of an -;; element depends on the operation. After extracting headers from a -;; message, it is a string, the value of the header. An extracted set of -;; headers may be parsed further, which may turn it into a list, whose car -;; is the original value and whose subsequent elements depend on the -;; header. For formatting, it is evaluated to obtain the strings to be -;; inserted. For merging, one set of headers consists of strings, while -;; the other set will be evaluated with the symbols in the first set of -;; headers bound to their respective values. - -;;; Code: - -(require 'cl) - -;; Make the byte-compiler shut up. -(defvar headers) - -(defun mail-header-extract () - "Extract headers from current buffer after point. -Returns a header alist, where each element is a cons cell (name . value), -where NAME is a symbol, and VALUE is the string value of the header having -that name." - (let ((message-headers ()) (top (point)) - start end) - (while (and (setq start (point)) - (> (skip-chars-forward "^\0- :") 0) - (= (following-char) ?:) - (setq end (point)) - (progn (forward-char) - (> (skip-chars-forward " \t") 0))) - (let ((header (intern (downcase (buffer-substring start end)))) - (value (list (buffer-substring - (point) (progn (end-of-line) (point)))))) - (while (progn (forward-char) (> (skip-chars-forward " \t") 0)) - (push (buffer-substring (point) (progn (end-of-line) (point))) - value)) - (push (if (cdr value) - (cons header (mapconcat #'identity (nreverse value) " ")) - (cons header (car value))) - message-headers))) - (goto-char top) - (nreverse message-headers))) - -(defun mail-header-extract-no-properties () - "Extract headers from current buffer after point, without properties. -Returns a header alist, where each element is a cons cell (name . value), -where NAME is a symbol, and VALUE is the string value of the header having -that name." - (mapcar - (lambda (elt) - (set-text-properties 0 (length (cdr elt)) nil (cdr elt)) - elt) - (mail-header-extract))) - -(defun mail-header-parse (parsing-rules headers) - "Apply PARSING-RULES to HEADERS. -PARSING-RULES is an alist whose keys are header names (symbols) and whose -value is a parsing function. The function takes one argument, a string, -and return a list of values, which will destructively replace the value -associated with the key in HEADERS, after being prepended with the original -value." - (dolist (rule parsing-rules) - (let ((header (assq (car rule) headers))) - (when header - (if (consp (cdr header)) - (setf (cddr header) (funcall (cdr rule) (cadr header))) - (setf (cdr header) - (cons (cdr header) (funcall (cdr rule) (cdr header)))))))) - headers) - -(defsubst mail-header (header &optional header-alist) - "Return the value associated with header HEADER in HEADER-ALIST. -If the value is a string, it is the original value of the header. If the -value is a list, its first element is the original value of the header, -with any subsequent elements being the result of parsing the value. -If HEADER-ALIST is nil, the dynamically bound variable `headers' is used." - (cdr (assq header (or header-alist headers)))) - -(defun mail-header-set (header value &optional header-alist) - "Set the value associated with header HEADER to VALUE in HEADER-ALIST. -HEADER-ALIST defaults to the dynamically bound variable `headers' if nil. -See `mail-header' for the semantics of VALUE." - (let* ((alist (or header-alist headers)) - (entry (assq header alist))) - (if entry - (setf (cdr entry) value) - (nconc alist (list (cons header value))))) - value) - -(defsetf mail-header (header &optional header-alist) (value) - `(mail-header-set ,header ,value ,header-alist)) - -(defun mail-header-merge (merge-rules headers) - "Return a new header alist with MERGE-RULES applied to HEADERS. -MERGE-RULES is an alist whose keys are header names (symbols) and whose -values are forms to evaluate, the results of which are the new headers. It -should be a string or a list of string. The first element may be nil to -denote that the formatting functions must use the remaining elements, or -skip the header altogether if there are no other elements. - The macro `mail-header' can be used to access headers in HEADERS." - (mapcar - (lambda (rule) - (cons (car rule) (eval (cdr rule)))) - merge-rules)) - -(defvar mail-header-format-function - (lambda (header value) - "Function to format headers without a specified formatting function." - (insert (capitalize (symbol-name header)) - ": " - (if (consp value) (car value) value) - "\n"))) - -(defun mail-header-format (format-rules headers) - "Use FORMAT-RULES to format HEADERS and insert into current buffer. -FORMAT-RULES is an alist whose keys are header names (symbols), and whose -values are functions that format the header, the results of which are -inserted, unless it is nil. The function takes two arguments, the header -symbol, and the value of that header. If the function itself is nil, the -default action is to insert the value of the header, unless it is nil. -The headers are inserted in the order of the FORMAT-RULES. -A key of t represents any otherwise unmentioned headers. -A key of nil has as its value a list of defaulted headers to ignore." - (let ((ignore (append (cdr (assq nil format-rules)) - (mapcar #'car format-rules)))) - (dolist (rule format-rules) - (let* ((header (car rule)) - (value (mail-header header))) - (cond ((null header) 'ignore) - ((eq header t) - (dolist (defaulted headers) - (unless (memq (car defaulted) ignore) - (let* ((header (car defaulted)) - (value (cdr defaulted))) - (if (cdr rule) - (funcall (cdr rule) header value) - (funcall mail-header-format-function header value)))))) - (value - (if (cdr rule) - (funcall (cdr rule) header value) - (funcall mail-header-format-function header value)))))) - (insert "\n"))) - -(provide 'mailheader) - -;;; mail-header.el ends here diff --git a/lisp/md5.el b/lisp/md5.el deleted file mode 100644 index 3fabf29..0000000 --- a/lisp/md5.el +++ /dev/null @@ -1,409 +0,0 @@ -;;; 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/lisp/message.el b/lisp/message.el deleted file mode 100644 index 6e0ad3e..0000000 --- a/lisp/message.el +++ /dev/null @@ -1,4101 +0,0 @@ -;;; message.el --- composing mail and news messages -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko -;; Keywords: mail, news, MIME - -;; 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 mode provides mail-sending facilities from within Emacs. It -;; consists mainly of large chunks of code from the sendmail.el, -;; gnus-msg.el and rnewspost.el files. - -;;; Code: - -(eval-when-compile - (require 'cl) - (require 'smtp) - ) - -(require 'mailheader) -(require 'nnheader) -(require 'timezone) -(require 'easymenu) -(require 'custom) -(if (string-match "XEmacs\\|Lucid" emacs-version) - (require 'mail-abbrevs) - (require 'mailabbrev)) -(require 'mime-edit) - -(defgroup message '((user-mail-address custom-variable) - (user-full-name custom-variable)) - "Mail and news message composing." - :link '(custom-manual "(message)Top") - :group 'mail - :group 'news) - -(put 'user-mail-address 'custom-type 'string) -(put 'user-full-name 'custom-type 'string) - -(defgroup message-various nil - "Various Message Variables" - :link '(custom-manual "(message)Various Message Variables") - :group 'message) - -(defgroup message-buffers nil - "Message Buffers" - :link '(custom-manual "(message)Message Buffers") - :group 'message) - -(defgroup message-sending nil - "Message Sending" - :link '(custom-manual "(message)Sending Variables") - :group 'message) - -(defgroup message-interface nil - "Message Interface" - :link '(custom-manual "(message)Interface") - :group 'message) - -(defgroup message-forwarding nil - "Message Forwarding" - :link '(custom-manual "(message)Forwarding") - :group 'message-interface) - -(defgroup message-insertion nil - "Message Insertion" - :link '(custom-manual "(message)Insertion") - :group 'message) - -(defgroup message-headers nil - "Message Headers" - :link '(custom-manual "(message)Message Headers") - :group 'message) - -(defgroup message-news nil - "Composing News Messages" - :group 'message) - -(defgroup message-mail nil - "Composing Mail Messages" - :group 'message) - -(defgroup message-faces nil - "Faces used for message composing." - :group 'message - :group 'faces) - -(defcustom message-directory "~/Mail/" - "*Directory from which all other mail file variables are derived." - :group 'message-various - :type 'directory) - -(defcustom message-max-buffers 10 - "*How many buffers to keep before starting to kill them off." - :group 'message-buffers - :type 'integer) - -(defcustom message-send-rename-function nil - "*Function called to rename the buffer after sending it." - :group 'message-buffers - :type 'function) - -(defcustom message-fcc-handler-function 'message-output - "*A function called to save outgoing articles. -This function will be called with the name of the file to store the -article in. The default function is `message-output' which saves in Unix -mailbox format." - :type '(radio (function-item message-output) - (function :tag "Other")) - :group 'message-sending) - -(defcustom message-encode-function 'message-maybe-encode - "*A function called to encode messages." - :group 'message-sending - :type 'function) - -(defcustom message-courtesy-message - "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n" - "*This is inserted at the start of a mailed copy of a posted message. -If the string contains the format spec \"%s\", the Newsgroups -the article has been posted to will be inserted there. -If this variable is nil, no such courtesy message will be added." - :group 'message-sending - :type 'string) - -(defcustom message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):" - "*Regexp that matches headers to be removed in resent bounced mail." - :group 'message-interface - :type 'regexp) - -;;;###autoload -(defcustom message-from-style 'default - "*Specifies how \"From\" headers look. - -If `nil', they contain just the return address like: - king@grassland.com -If `parens', they look like: - king@grassland.com (Elvis Parsley) -If `angles', they look like: - Elvis Parsley - -Otherwise, most addresses look like `angles', but they look like -`parens' if `angles' would need quoting and `parens' would not." - :type '(choice (const :tag "simple" nil) - (const parens) - (const angles) - (const default)) - :group 'message-headers) - -(defcustom message-references-generator - (if (fboundp 'std11-fill-msg-id-list-string) - (function message-generate-filled-references) - (function message-generate-folded-references)) - "*Function to generate \"References\" field." - :type '(radio (function-item message-generate-filled-references) - (function-item message-generate-folded-references) - (function-item message-generate-unfolded-references) - (function :tag "Other")) - :group 'message-headers) - -(defcustom message-syntax-checks 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 - `(signature . disabled)' to this list. - -Don't touch this variable unless you really know what you're doing. - -Checks include subject-cmsg multiple-headers sendsys message-id from -long-lines control-chars size new-text redirected-followup signature -approved sender empty empty-headers message-id from subject -shorten-followup-to existing-newsgroups buffer-file-name unchanged." - :group 'message-news) - -(defcustom message-required-news-headers - '(From Newsgroups Subject Date Message-ID - (optional . Organization) Lines - (optional . X-Newsreader)) - "*Headers to be generated or prompted for when posting an article. -RFC977 and RFC1036 require From, Date, Newsgroups, Subject, -Message-ID. Organization, Lines, In-Reply-To, Expires, and -X-Newsreader are optional. If don't you want message to insert some -header, remove it from this list." - :group 'message-news - :group 'message-headers - :type '(repeat sexp)) - -(defcustom message-required-mail-headers - '(From Subject Date (optional . In-Reply-To) Message-ID Lines - (optional . X-Mailer)) - "*Headers to be generated or prompted for when mailing a message. -RFC822 required that From, Date, To, Subject and Message-ID be -included. Organization, Lines and X-Mailer are optional." - :group 'message-mail - :group 'message-headers - :type '(repeat sexp)) - -(defcustom message-deletable-headers '(Message-ID Date Lines) - "*Headers to be deleted if they already exist and were generated by message previously." - :group 'message-headers - :type 'sexp) - -(defcustom message-ignored-news-headers - "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:" - "*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:" - "*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:" - "*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." - :group 'message-interface - :type 'regexp) - -;;;###autoload -(defcustom message-signature-separator "^-- *$" - "*Regexp matching the signature separator." - :type 'regexp - :group 'message-various) - -(defcustom message-elide-elipsis "\n[...]\n\n" - "*The string which is inserted for elided text.") - -(defcustom message-interactive nil - "*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 - :group 'message-mail - :type 'boolean) - -(defcustom message-generate-new-buffers t - "*Non-nil means that a new message buffer will be created whenever `mail-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." - :group 'message-buffers - :type '(choice (const :tag "off" nil) - (const :tag "on" t) - (function fun))) - -(defcustom message-kill-buffer-on-exit nil - "*Non-nil means that the message buffer will be killed after sending a message." - :group 'message-buffers - :type 'boolean) - -(defvar gnus-local-organization) -(defcustom message-user-organization - (or (and (boundp 'gnus-local-organization) - (stringp gnus-local-organization) - gnus-local-organization) - (getenv "ORGANIZATION") - t) - "*String to be used as an Organization header. -If t, use `message-user-organization-file'." - :group 'message-headers - :type '(choice string - (const :tag "consult file" t))) - -;;;###autoload -(defcustom message-user-organization-file "/usr/lib/news/organization" - "*Local news organization file." - :type 'file - :group 'message-headers) - -(defcustom message-autosave-directory - (nnheader-concat message-directory "drafts/") - "*Directory where Message autosaves buffers. -If nil, Message won't autosave." - :group 'message-buffers - :type 'directory) - -(defcustom message-forward-start-separator - (concat (mime-make-tag "message" "rfc822") "\n") - "*Delimiter inserted before forwarded messages." - :group 'message-forwarding - :type 'string) - -(defcustom message-forward-end-separator - "" - "*Delimiter inserted after forwarded messages." - :group 'message-forwarding - :type 'string) - -(defcustom message-signature-before-forwarded-message t - "*If non-nil, put the signature before any included forwarded message." - :group 'message-forwarding - :type 'boolean) - -(defcustom message-included-forward-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" - "*Regexp matching headers to be included in forwarded messages." - :group 'message-forwarding - :type 'regexp) - -(defcustom message-ignored-resent-headers "^Return-receipt" - "*All headers that match this regexp will be deleted when resending a message." - :group 'message-interface - :type 'regexp) - -(defcustom message-ignored-cited-headers "." - "*Delete these headers from the messages you yank." - :group 'message-insertion - :type 'regexp) - -(defcustom message-cancel-message "I am canceling my own article." - "*Message to be inserted in the cancel message." - :group 'message-interface - :type 'string) - -;; Useful to set in site-init.el -;;;###autoload -(defcustom message-send-mail-function 'message-send-mail-with-sendmail - "*Function to call to send the current buffer as mail. -The headers should be delimited by a line whose contents match the -variable `mail-header-separator'. - -Legal 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'." - :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 :tag "Other")) - :group 'message-sending - :group 'message-mail) - -;; 1997-09-29 by MORIOKA Tomohiko -(defcustom message-send-news-function 'message-send-news-with-gnus - "*Function to call to send the current buffer as news. -The headers should be delimited by a line whose contents match the -variable `mail-header-separator'." - :group 'message-sending - :group 'message-news - :type 'function) - -(defcustom message-reply-to-function 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) - -(defcustom message-wide-reply-to-function 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) - -(defcustom message-followup-to-function 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) - -(defcustom message-use-followup-to 'ask - "*Specifies what to do with Followup-To header. -If nil, always ignore the header. If it is t, use its value, but -query before using the \"poster\" value. If it is the symbol `ask', -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 use) - (const ask))) - -;; stuff relating to broken sendmail in MMDF -(defcustom message-sendmail-f-is-evil nil - "*Non-nil means that \"-f username\" should not be added to the sendmail -command line, because it is even more evil than leaving it out." - :group 'message-sending - :type 'boolean) - -;; qmail-related stuff -(defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject" - "*Location of the qmail-inject program." - :group 'message-sending - :type 'file) - -(defcustom message-qmail-inject-args nil - "*Arguments passed to qmail-inject programs. -This should be a list of strings, one string for each argument. - -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)) - -(defvar gnus-post-method) -(defvar gnus-select-method) -(defcustom message-post-method - (cond ((and (boundp 'gnus-post-method) - gnus-post-method) - gnus-post-method) - ((boundp 'gnus-select-method) - gnus-select-method) - (t '(nnspool ""))) - "*Method used to post news." - :group 'message-news - :group 'message-sending - ;; This should be the `gnus-select-method' widget, but that might - ;; create a dependence to `gnus.el'. - :type 'sexp) - -(defcustom message-generate-headers-first nil - "*If non-nil, generate all possible headers before composing." - :group 'message-headers - :type 'boolean) - -(defcustom message-setup-hook - '(message-maybe-setup-default-charset turn-on-mime-edit) - "*Normal hook, run each time a new outgoing message is initialized. -The function `message-setup' runs this hook." - :group 'message-various - :type 'hook) - -(defcustom message-signature-setup-hook nil - "*Normal hook, run each time a new outgoing message is initialized. -It is run after the headers have been inserted and before -the signature is inserted." - :group 'message-various - :type 'hook) - -(defcustom message-mode-hook nil - "*Hook run in message mode buffers." - :group 'message-various - :type 'hook) - -(defcustom message-header-hook '(eword-encode-header) - "*Hook run in a message mode buffer narrowed to the headers." - :group 'message-various - :type 'hook) - -(defcustom message-header-setup-hook nil - "*Hook called narrowed to the headers when setting up a message -buffer." - :group 'message-various - :type 'hook) - -;;;###autoload -(defcustom message-citation-line-function 'message-insert-citation-line - "*Function called to insert the \"Whomever writes:\" line." - :type 'function - :group 'message-insertion) - -;;;###autoload -(defcustom message-yank-prefix "> " - "*Prefix inserted on the lines of yanked messages. -nil means use indentation." - :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'." - :group 'message-insertion - :type 'integer) - -;;;###autoload -(defcustom message-cite-function - (if (and (boundp 'mail-citation-hook) - mail-citation-hook) - mail-citation-hook - 'message-cite-original) - "*Function for citing an original message. -Pre-defined functions include `message-cite-original' and -`message-cite-original-without-signature'." - :type '(radio (function-item message-cite-original) - (function-item message-cite-original-without-signature) - (function-item sc-cite-original) - (function :tag "Other")) - :group 'message-insertion) - -;;;###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 -citation between (point) and (mark t). And each function should leave -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. -If t, the `message-signature-file' file will be inserted instead. -If a function, the result from the function will be used instead. -If a form, the result from the form will be used instead." - :type 'sexp - :group 'message-insertion) - -;;;###autoload -(defcustom message-signature-file "~/.signature" - "*File containing the text inserted at end of message buffer." - :type 'file - :group 'message-insertion) - -(defcustom message-distribution-function nil - "*Function called to return a Distribution header." - :group 'message-news - :group 'message-headers - :type 'function) - -(defcustom message-expires 14 - "*Number of days before your article expires." - :group 'message-news - :group 'message-headers - :link '(custom-manual "(message)News Headers") - :type 'integer) - -(defcustom message-user-path nil - "*If nil, use the NNTP server name in the Path header. -If stringp, use this; if non-nil, use no host name (user name only)." - :group 'message-news - :group 'message-headers - :link '(custom-manual "(message)News Headers") - :type '(choice (const :tag "nntp" nil) - (string :tag "name") - (sexp :tag "none" :format "%t" t))) - -(defvar message-reply-buffer nil) -(defvar message-reply-headers nil) -(defvar message-newsreader nil) -(defvar message-mailer nil) -(defvar message-sent-message-via nil) -(defvar message-checksum nil) -(defvar message-send-actions nil - "A list of actions to be performed upon successful sending of a message.") -(defvar message-exit-actions nil - "A list of actions to be performed upon exiting after sending a message.") -(defvar message-kill-actions nil - "A list of actions to be performed before killing a message buffer.") -(defvar message-postpone-actions nil - "A list of actions to be performed after postponing a message.") - -(define-widget 'message-header-lines 'text - "All header lines must be LFD terminated." - :valid-regexp "^\\'" - :error "All header lines must be newline terminated") - -(defcustom message-default-headers "" - "*A string containing header lines to be inserted in outgoing messages. -It is inserted before you edit the message, so you can edit or delete -these lines." - :group 'message-headers - :type 'message-header-lines) - -(defcustom message-default-mail-headers "" - "*A string of header lines to be inserted in outgoing mails." - :group 'message-headers - :group 'message-mail - :type 'message-header-lines) - -(defcustom message-default-news-headers "" - "*A string of header lines to be inserted in outgoing news -articles." - :group 'message-headers - :group 'message-news - :type 'message-header-lines) - -;; Note: could use /usr/ucb/mail instead of sendmail; -;; options -t, and -v if not interactive. -(defcustom message-mailer-swallows-blank-line - (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" - system-configuration) - (file-readable-p "/etc/sendmail.cf") - (let ((buffer (get-buffer-create " *temp*"))) - (unwind-protect - (save-excursion - (set-buffer buffer) - (insert-file-contents "/etc/sendmail.cf") - (goto-char (point-min)) - (let ((case-fold-search nil)) - (re-search-forward "^OR\\>" nil t))) - (kill-buffer buffer)))) - ;; According to RFC822, "The field-name must be composed of printable - ;; ASCII characters (i. e., characters that have decimal values between - ;; 33 and 126, except colon)", i. e., any chars except ctl chars, - ;; space, or colon. - '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) - "*Set this non-nil if the system's mailer runs the header and body together. -\(This problem exists on Sunos 4 when sendmail is run in remote mode.) -The value should be an expression to test whether the problem will -actually occur." - :group 'message-sending - :type 'sexp) - -;; Ignore errors in case this is used in Emacs 19. -;; Don't use ignore-errors because this is copied into loaddefs.el. -;;;###autoload -(condition-case nil - (define-mail-user-agent 'message-user-agent - 'message-mail 'message-send-and-exit - 'message-kill-buffer 'message-send-hook) - (error nil)) - -(defvar message-mh-deletable-headers '(Message-ID Date Lines Sender) - "If non-nil, delete the deletable headers before feeding to mh.") - -(defvar message-send-method-alist - '((news message-news-p message-send-via-news) - (mail message-mail-p message-send-via-mail)) - "Alist of ways to send outgoing messages. -Each element has the form - - \(TYPE PREDICATE FUNCTION) - -where TYPE is a symbol that names the method; PREDICATE is a function -called without any parameters to determine whether the message is -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 - "*What alias expansion type to use in Message buffers. -The default is `abbrev', which uses mailabbrev. nil switches -mail aliases off.") - -;;; Internal variables. -;;; Well, not really internal. - -(defvar message-mode-syntax-table - (let ((table (copy-syntax-table text-mode-syntax-table))) - (modify-syntax-entry ?% ". " table) - 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)) - (:foreground "green2" :bold t)) - (((class color) - (background light)) - (:foreground "MidnightBlue" :bold t)) - (t - (:bold t :italic t))) - "Face used for displaying From headers." - :group 'message-faces) - -(defface message-header-cc-face - '((((class color) - (background dark)) - (:foreground "green4" :bold t)) - (((class color) - (background light)) - (:foreground "MidnightBlue")) - (t - (:bold t))) - "Face used for displaying Cc headers." - :group 'message-faces) - -(defface message-header-subject-face - '((((class color) - (background dark)) - (:foreground "green3")) - (((class color) - (background light)) - (:foreground "navy blue" :bold t)) - (t - (:bold t))) - "Face used for displaying subject headers." - :group 'message-faces) - -(defface message-header-newsgroups-face - '((((class color) - (background dark)) - (:foreground "yellow" :bold t :italic t)) - (((class color) - (background light)) - (:foreground "blue4" :bold t :italic t)) - (t - (:bold t :italic t))) - "Face used for displaying newsgroups headers." - :group 'message-faces) - -(defface message-header-other-face - '((((class color) - (background dark)) - (:foreground "#b00000")) - (((class color) - (background light)) - (:foreground "steel blue")) - (t - (:bold t :italic t))) - "Face used for displaying newsgroups headers." - :group 'message-faces) - -(defface message-header-name-face - '((((class color) - (background dark)) - (:foreground "DarkGreen")) - (((class color) - (background light)) - (:foreground "cornflower blue")) - (t - (:bold t))) - "Face used for displaying header names." - :group 'message-faces) - -(defface message-header-xheader-face - '((((class color) - (background dark)) - (:foreground "blue")) - (((class color) - (background light)) - (:foreground "blue")) - (t - (:bold t))) - "Face used for displaying X-Header headers." - :group 'message-faces) - -(defface message-separator-face - '((((class color) - (background dark)) - (:foreground "blue3")) - (((class color) - (background light)) - (:foreground "brown")) - (t - (:bold t))) - "Face used for displaying the separator." - :group 'message-faces) - -(defface message-cited-text-face - '((((class color) - (background dark)) - (:foreground "red")) - (((class color) - (background light)) - (:foreground "red")) - (t - (:bold t))) - "Face used for displaying cited text names." - :group 'message-faces) - -(defvar message-font-lock-keywords - (let* ((cite-prefix "A-Za-z") - (cite-suffix (concat cite-prefix "0-9_.@-")) - (content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)")) - `((,(concat "^\\([Tt]o:\\)" content) - (1 'message-header-name-face) - (2 'message-header-to-face nil t)) - (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content) - (1 'message-header-name-face) - (2 'message-header-cc-face nil t)) - (,(concat "^\\([Ss]ubject:\\)" content) - (1 'message-header-name-face) - (2 'message-header-subject-face nil t)) - (,(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) - (1 'message-header-name-face) - (2 'message-header-other-face nil t)) - (,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content) - (1 'message-header-name-face) - (2 'message-header-name-face)) - (,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$") - 1 'message-separator-face) - (,(concat "^[ \t]*" - "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" - "[:>|}].*") - (0 'message-cited-text-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 t)) - -(defvar message-face-alist - '((bold . bold-region) - (underline . underline-region) - (default . (lambda (b e) - (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.") - -(defcustom message-send-hook nil - "*Hook run before sending messages." - :group 'message-various - :options '(ispell-message) - :type 'hook) - -(defcustom message-send-mail-hook nil - "*Hook run before sending mail messages." - :group 'message-various - :type 'hook) - -(defcustom message-send-news-hook nil - "*Hook run before sending news messages." - :group 'message-various - :type 'hook) - -(defcustom message-sent-hook nil - "*Hook run after sending messages." - :group 'message-various - :type 'hook) - -;;; Internal variables. - -(defvar message-buffer-list nil) -(defvar message-this-is-news nil) -(defvar message-this-is-mail nil) -(defvar message-draft-article nil) - -;; Byte-compiler warning -(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 -;;; of rmail.el's rmail-unix-mail-delimiter. -(defvar message-unix-mail-delimiter - (let ((time-zone-regexp - (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" - "\\|[-+]?[0-9][0-9][0-9][0-9]" - "\\|" - "\\) *"))) - (concat - "From " - - ;; Many things can happen to an RFC 822 mailbox before it is put into - ;; a `From' line. The leading phrase can be stripped, e.g. - ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g. - ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF - ;; 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 - ;; From: Joe User - ;; - ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'. - ;; The mailbox can be removed or be replaced by white space, e.g. - ;; From: "Joe User"{space}{tab} - ;; - ;; can yield `From {space}{tab} Fri Mar 22 08:11:15 1996', - ;; where {space} and {tab} represent the Ascii space and tab characters. - ;; 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\^?].*\\)? " - - ;; The time the message was sent. - "\\([^\0-\r \^?]+\\) +" ; day of the week - "\\([^\0-\r \^?]+\\) +" ; month - "\\([0-3]?[0-9]\\) +" ; day of month - "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day - - ;; Perhaps a time zone, specified by an abbreviation, or by a - ;; numeric offset. - time-zone-regexp - - ;; The year. - " \\([0-9][0-9]+\\) *" - - ;; On some systems the time zone can appear after the year, too. - time-zone-regexp - - ;; Old uucp cruft. - "\\(remote from .*\\)?" - - "\n")) - "Regexp matching the delimiter of messages in UNIX mail format.") - -(defvar message-unsent-separator - (concat "^ *---+ +Unsent message follows +---+ *$\\|" - "^ *---+ +Returned message +---+ *$\\|" - "^Start of returned message$\\|" - "^ *---+ +Original message +---+ *$\\|" - "^ *--+ +begin message +--+ *$\\|" - "^ *---+ +Original message follows +---+ *$\\|" - "^|? *---+ +Message text follows: +---+ *|?$") - "A regexp that matches the separator before the text of a failed message.") - -(defvar message-header-format-alist - `((Newsgroups) - (To . message-fill-address) - (Cc . message-fill-address) - (Subject) - (In-Reply-To) - (Fcc) - (Bcc) - (Date) - (Organization) - (Distribution) - (Lines) - (Expires) - (Message-ID) - (References . message-fill-header) - (X-Mailer) - (X-Newsreader)) - "Alist used for formatting headers.") - -(eval-and-compile - (autoload 'message-setup-toolbar "messagexmas") - (autoload 'mh-new-draft-name "mh-comp") - (autoload 'mh-send-letter "mh-comp") - (autoload 'gnus-point-at-eol "gnus-util") - (autoload 'gnus-point-at-bol "gnus-util") - (autoload 'gnus-output-to-mail "gnus-util") - (autoload 'gnus-output-to-rmail "gnus-util") - (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev") - (autoload 'nndraft-request-associate-buffer "nndraft") - (autoload 'nndraft-request-expire-articles "nndraft")) - - - -;;; -;;; Utility functions. -;;; - -(defmacro message-y-or-n-p (question show &rest text) - "Ask QUESTION, displaying the rest of the arguments in a temp. 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-region (progn (beginning-of-line) (point)) - (progn (forward-line ,(or n 1)) (point)))) - -(defun message-tokenize-header (header &optional separator) - "Split HEADER into a list of header elements. -\",\" is used as the separator." - (if (not header) - nil - (let ((regexp (format "[%s]+" (or separator ","))) - (beg 1) - (first t) - quoted elems paren) - (save-excursion - (message-set-work-buffer) - (insert header) - (goto-char (point-min)) - (while (not (eobp)) - (if first - (setq first nil) - (forward-char 1)) - (cond ((and (> (point) beg) - (or (eobp) - (and (looking-at regexp) - (not quoted) - (not paren)))) - (push (buffer-substring beg (point)) elems) - (setq beg (match-end 0))) - ((= (following-char) ?\") - (setq quoted (not quoted))) - ((and (= (following-char) ?\() - (not quoted)) - (setq paren t)) - ((and (= (following-char) ?\)) - (not quoted)) - (setq paren nil)))) - (nreverse elems))))) - -(defun message-mail-file-mbox-p (file) - "Say whether FILE looks like a Unix mbox file." - (when (and (file-exists-p file) - (file-readable-p file) - (file-regular-p file)) - (nnheader-temp-write nil - (nnheader-insert-file-contents file) - (goto-char (point-min)) - (looking-at message-unix-mail-delimiter)))) - -(defun message-fetch-field (header &optional not-all) - "The same as `mail-fetch-field', only remove all newlines." - (let ((value (mail-fetch-field header nil (not not-all)))) - (when value - (nnheader-replace-chars-in-string value ?\n ? )))) - -(defun message-add-header (&rest headers) - "Add the HEADERS to the message header, skipping those already present." - (while headers - (let (hclean) - (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car headers)) - (error "Invalid header `%s'" (car headers))) - (setq hclean (match-string 1 (car headers))) - (save-restriction - (message-narrow-to-headers) - (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t) - (insert (car headers) ?\n)))) - (setq headers (cdr headers)))) - -(defun message-fetch-reply-field (header) - "Fetch FIELD from the message we're replying to." - (when (and message-reply-buffer - (buffer-name message-reply-buffer)) - (save-excursion - (set-buffer message-reply-buffer) - (message-fetch-field header)))) - -(defun message-set-work-buffer () - (if (get-buffer " *message work*") - (progn - (set-buffer " *message work*") - (erase-buffer)) - (set-buffer (get-buffer-create " *message work*")) - (kill-all-local-variables) - (buffer-disable-undo (current-buffer)))) - -(defun message-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))) - -(defun message-strip-subject-re (subject) - "Remove \"Re:\" from subject lines." - (if (string-match "^[Rr][Ee]: *" subject) - (substring subject (match-end 0)) - subject)) - -(defun message-remove-header (header &optional is-regexp first reverse) - "Remove HEADER in the narrowed buffer. -If 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)) - (let ((regexp (if is-regexp header (concat "^" header ":"))) - (number 0) - (case-fold-search t) - last) - (while (and (not (eobp)) - (not last)) - (if (if reverse - (not (looking-at regexp)) - (looking-at regexp)) - (progn - (incf number) - (when first - (setq last t)) - (delete-region - (point) - ;; There might be a continuation header, so we have to search - ;; until we find a new non-continuation line. - (progn - (forward-line 1) - (if (re-search-forward "^[^ \t]" nil t) - (goto-char (match-beginning 0)) - (point-max))))) - (forward-line 1) - (if (re-search-forward "^[^ \t]" nil t) - (goto-char (match-beginning 0)) - (point-max)))) - number)) - -(defun message-narrow-to-headers () - "Narrow the buffer to the head of the message." - (widen) - (narrow-to-region - (goto-char (point-min)) - (if (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n") nil t) - (match-beginning 0) - (point-max))) - (goto-char (point-min))) - -(defun message-narrow-to-head () - "Narrow the buffer to the head of the message." - (widen) - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil 1) - (1- (point)) - (point-max))) - (goto-char (point-min))) - -(defun message-news-p () - "Say whether the current buffer contains a news message." - (or message-this-is-news - (save-excursion - (save-restriction - (message-narrow-to-headers) - (and (message-fetch-field "newsgroups") - (not (message-fetch-field "posted-to"))))))) - -(defun message-mail-p () - "Say whether the current buffer contains a mail message." - (or message-this-is-mail - (save-excursion - (save-restriction - (message-narrow-to-headers) - (or (message-fetch-field "to") - (message-fetch-field "cc") - (message-fetch-field "bcc")))))) - -(defun message-next-header () - "Go to the beginning of the next header." - (beginning-of-line) - (or (eobp) (forward-char 1)) - (not (if (re-search-forward "^[^ \t]" nil t) - (beginning-of-line) - (goto-char (point-max))))) - -(defun message-sort-headers-1 () - "Sort the buffer as headers using `message-rank' text props." - (goto-char (point-min)) - (sort-subr - nil 'message-next-header - (lambda () - (message-next-header) - (unless (bobp) - (forward-char -1))) - (lambda () - (or (get-text-property (point) 'message-rank) - 10000)))) - -(defun message-sort-headers () - "Sort the headers of the current message according to `message-header-format-alist'." - (interactive) - (save-excursion - (save-restriction - (let ((max (1+ (length message-header-format-alist))) - rank) - (message-narrow-to-headers) - (while (re-search-forward "^[^ \n]+:" nil t) - (put-text-property - (match-beginning 0) (1+ (match-beginning 0)) - 'message-rank - (if (setq rank (length (memq (assq (intern (buffer-substring - (match-beginning 0) - (1- (match-end 0)))) - message-header-format-alist) - message-header-format-alist))) - (- max rank) - (1+ max))))) - (message-sort-headers-1)))) - - - -;;; -;;; Message mode -;;; - -;;; Set up keymap. - -(defvar message-mode-map nil) - -(unless message-mode-map - (setq message-mode-map (copy-keymap text-mode-map)) - (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-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) - (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject) - (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to) - (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-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-b" 'message-goto-body) - (define-key message-mode-map "\C-c\C-i" 'message-goto-signature) - - (define-key message-mode-map "\C-c\C-t" 'message-insert-to) - (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) - - (define-key message-mode-map "\C-c\C-y" 'message-yank-original) - (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) - (define-key message-mode-map "\C-c\C-w" 'message-insert-signature) - (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body) - (define-key message-mode-map "\C-c\C-o" 'message-sort-headers) - (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer) - - (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit) - (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\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 "\t" 'message-tab)) - -(easy-menu-define - message-mode-menu message-mode-map "Message Menu." - '("Message" - ["Sort Headers" message-sort-headers t] - ["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)] - ["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] - "----" - ["Send Message" message-send-and-exit t] - ["Abort Message" message-dont-send t])) - -(easy-menu-define - message-mode-field-menu message-mode-map "" - '("Field" - ["Fetch To" message-insert-to t] - ["Fetch Newsgroups" message-insert-newsgroups t] - "----" - ["To" message-goto-to 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] - ["Distribution" message-goto-distribution t] - ["Body" message-goto-body t] - ["Signature" message-goto-signature t])) - -(defvar facemenu-add-face-function) -(defvar facemenu-remove-face-function) - -;;;###autoload -(defun message-mode () - "Major mode for editing mail and news to be sent. -Like Text Mode but with these additional commands: -C-c C-s message-send (send the message) C-c C-c message-send-and-exit -C-c C-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-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-r message-caesar-buffer-body (rot13 the message body)." - (interactive) - (kill-all-local-variables) - (make-local-variable 'message-reply-buffer) - (setq 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 'paragraph-separate) - (make-local-variable 'paragraph-start) - (setq paragraph-start - (concat (regexp-quote mail-header-separator) - "$\\|[ \t]*[-_][-_][-_]+$\\|" - "-- $\\|" - ;;!!! Uhm... shurely this can't be right. - "[> " (regexp-quote message-yank-prefix) "]+$\\|" - paragraph-start)) - (setq paragraph-separate - (concat (regexp-quote mail-header-separator) - "$\\|[ \t]*[-_][-_][-_]+$\\|" - "-- $\\|" - "[> " (regexp-quote message-yank-prefix) "]+$\\|" - paragraph-separate)) - (make-local-variable 'message-reply-headers) - (setq message-reply-headers nil) - (make-local-variable 'message-newsreader) - (make-local-variable 'message-mailer) - (make-local-variable 'message-post-method) - (make-local-variable 'message-sent-message-via) - (setq message-sent-message-via nil) - (make-local-variable 'message-checksum) - (setq message-checksum nil) - ;;(when (fboundp 'mail-hist-define-keys) - ;; (mail-hist-define-keys)) - (when (string-match "XEmacs\\|Lucid" emacs-version) - (message-setup-toolbar)) - (easy-menu-add message-mode-menu message-mode-map) - (easy-menu-add message-mode-field-menu message-mode-map) - ;; Allow mail alias things. - (when (eq message-mail-alias-type 'abbrev) - (if (fboundp 'mail-abbrevs-setup) - (mail-abbrevs-setup) - (funcall (intern "mail-aliases-setup")))) - (message-set-auto-save-file-name) - (unless (string-match "XEmacs" emacs-version) - (set (make-local-variable 'font-lock-defaults) - '(message-font-lock-keywords t))) - (gnus-run-hooks 'text-mode-hook 'message-mode-hook)) - - - -;;; -;;; Message mode commands -;;; - -;;; Movement commands - -(defun message-goto-to () - "Move point to the To header." - (interactive) - (message-position-on-field "To")) - -(defun message-goto-subject () - "Move point to the Subject header." - (interactive) - (message-position-on-field "Subject")) - -(defun message-goto-cc () - "Move point to the Cc header." - (interactive) - (message-position-on-field "Cc" "To")) - -(defun message-goto-bcc () - "Move point to the Bcc header." - (interactive) - (message-position-on-field "Bcc" "Cc" "To")) - -(defun message-goto-fcc () - "Move point to the Fcc header." - (interactive) - (message-position-on-field "Fcc" "To" "Newsgroups")) - -(defun message-goto-reply-to () - "Move point to the Reply-To header." - (interactive) - (message-position-on-field "Reply-To" "Subject")) - -(defun message-goto-newsgroups () - "Move point to the Newsgroups header." - (interactive) - (message-position-on-field "Newsgroups")) - -(defun message-goto-distribution () - "Move point to the Distribution header." - (interactive) - (message-position-on-field "Distribution")) - -(defun message-goto-followup-to () - "Move point to the Followup-To header." - (interactive) - (message-position-on-field "Followup-To" "Newsgroups")) - -(defun message-goto-keywords () - "Move point to the Keywords header." - (interactive) - (message-position-on-field "Keywords" "Subject")) - -(defun message-goto-summary () - "Move point to the Summary header." - (interactive) - (message-position-on-field "Summary" "Subject")) - -(defun message-goto-body () - "Move point to the beginning of the message body." - (interactive) - (if (looking-at "[ \t]*\n") (expand-abbrev)) - (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n") nil t)) - -(defun message-goto-signature () - "Move point to the beginning of the message signature." - (interactive) - (goto-char (point-min)) - (if (re-search-forward message-signature-separator nil t) - (forward-line 1) - (goto-char (point-max)))) - - - -(defun message-insert-to (&optional force) - "Insert a To header that points to the author of the article being replied to. -If the original author requested not to be sent mail, the function signals -an error. -With the prefix argument FORCE, insert the header anyway." - (interactive "P") - (let ((co (message-fetch-reply-field "mail-copies-to"))) - (when (and (null force) - co - (equal (downcase co) "never")) - (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 "reply-to") - (message-fetch-reply-field "from") ""))) - -(defun message-insert-newsgroups () - "Insert the Newsgroups header from the article being replied to." - (interactive) - (when (and (message-position-on-field "Newsgroups") - (mail-fetch-field "newsgroups") - (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups")))) - (insert ",")) - (insert (or (message-fetch-reply-field "newsgroups") ""))) - - - -;;; Various commands - -(defun message-delete-not-region (beg end) - "Delete everything in the body of the current message that is outside of the region." - (interactive "r") - (save-excursion - (goto-char end) - (delete-region (point) (progn (message-goto-signature) - (forward-line -2) - (point))) - (insert "\n") - (goto-char beg) - (delete-region beg (progn (message-goto-body) - (forward-line 2) - (point)))) - (message-goto-signature) - (forward-line -2)) - -(defun message-kill-to-signature () - "Deletes all text up to the signature." - (interactive) - (let ((point (point))) - (message-goto-signature) - (forward-line -2) - (kill-region point (point)) - (unless (bolp) - (insert "\n")))) - -(defun message-newline-and-reformat () - "Insert four newlines, and then reformat if inside quoted text." - (interactive) - (let ((point (point)) - quoted) - (save-excursion - (beginning-of-line) - (setq quoted (looking-at (regexp-quote message-yank-prefix)))) - (insert "\n\n\n\n") - (when quoted - (insert message-yank-prefix)) - (fill-paragraph nil) - (goto-char point) - (forward-line 2))) - -(defun message-insert-signature (&optional force) - "Insert a signature. See documentation for the `message-signature' variable." - (interactive (list 0)) - (let* ((signature - (cond - ((and (null message-signature) - (eq force 0)) - (save-excursion - (goto-char (point-max)) - (not (re-search-backward - message-signature-separator nil t)))) - ((and (null message-signature) - force) - t) - ((message-functionp message-signature) - (funcall message-signature)) - ((listp message-signature) - (eval message-signature)) - (t message-signature))) - (signature - (cond ((stringp signature) - signature) - ((and (eq t signature) - message-signature-file - (file-exists-p message-signature-file)) - signature)))) - (when signature - (goto-char (point-max)) - ;; Insert the signature. - (unless (bolp) - (insert "\n")) - (insert "\n-- \n") - (if (eq signature t) - (insert-file-contents message-signature-file) - (insert signature)) - (goto-char (point-max)) - (or (bolp) (insert "\n"))))) - -(defun message-elide-region (b e) - "Elide the text between point and mark. An ellipsis (from -message-elide-elipsis) will be inserted where the text was killed." - (interactive "r") - (kill-region b e) - (unless (bolp) - (insert "\n")) - (insert message-elide-elipsis)) - -(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." - (interactive - (list - (min (point) (or (mark t) (point))) - (max (point) (or (mark t) (point))) - (when current-prefix-arg - (prefix-numeric-value current-prefix-arg)))) - - (setq n (if (numberp n) (mod n 26) 13)) ;canonize N - (unless (or (zerop n) ; no action needed for a rot of 0 - (= b e)) ; no region to rotate - ;; We build the table, if necessary. - (when (or (not message-caesar-translation-table) - (/= (aref message-caesar-translation-table ?a) (+ ?a n))) - (setq message-caesar-translation-table - (message-make-caesar-translation-table n))) - ;; Then we translate the region. Do it this way to retain - ;; text properties. - (while (< b e) - (subst-char-in-region - b (1+ b) (char-after b) - (aref message-caesar-translation-table (char-after b))) - (incf b)))) - -(defun message-make-caesar-translation-table (n) - "Create a rot table with offset N." - (let ((i -1) - (table (make-string 256 0))) - (while (< (incf i) 256) - (aset table i i)) - (concat - (substring table 0 ?A) - (substring table (+ ?A n) (+ ?A n (- 26 n))) - (substring table ?A (+ ?A n)) - (substring table (+ ?A 26) ?a) - (substring table (+ ?a n) (+ ?a n (- 26 n))) - (substring table ?a (+ ?a n)) - (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). -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 - (list (prefix-numeric-value current-prefix-arg)) - (list nil))) - (save-excursion - (save-restriction - (when (message-goto-body) - (narrow-to-region (point) (point-max))) - (message-caesar-region (point-min) (point-max) rotnum)))) - -(defun message-pipe-buffer-body (program) - "Pipe the message body in the current buffer through PROGRAM." - (save-excursion - (save-restriction - (when (message-goto-body) - (narrow-to-region (point) (point-max))) - (let ((body (buffer-substring (point-min) (point-max)))) - (unless (equal 0 (call-process-region - (point-min) (point-max) program t t)) - (insert body) - (message "%s failed." program)))))) - -(defun message-rename-buffer (&optional enter-string) - "Rename the *message* buffer to \"*message* RECIPIENT\". -If the function is run with a prefix, it will ask for a new buffer -name, rather than giving an automatic name." - (interactive "Pbuffer name: ") - (save-excursion - (save-restriction - (goto-char (point-min)) - (narrow-to-region (point) - (search-forward mail-header-separator nil 'end)) - (let* ((mail-to (or - (if (message-news-p) (message-fetch-field "Newsgroups") - (message-fetch-field "To")) - "")) - (mail-trimmed-to - (if (string-match "," mail-to) - (concat (substring mail-to 0 (match-beginning 0)) ", ...") - mail-to)) - (name-default (concat "*message* " mail-trimmed-to)) - (name (if enter-string - (read-string "New buffer name: " name-default) - name-default)) - (default-directory - (if message-autosave-directory - (file-name-as-directory message-autosave-directory) - default-directory))) - (rename-buffer name t))))) - -(defun message-fill-yanked-message (&optional justifyp) - "Fill the paragraphs of a message yanked into this one. -Numeric argument means justify as well." - (interactive "P") - (save-excursion - (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n") nil t) - (let ((fill-prefix message-yank-prefix)) - (fill-individual-paragraphs (point) (point-max) justifyp t)))) - -(defun message-indent-citation () - "Modify text just inserted from a message to be cited. -The inserted text should be the region. -When this function returns, the region is again around the modified text. - -Normally, indent each nonblank line `message-indentation-spaces' spaces. -However, if `message-yank-prefix' is non-nil, insert that prefix on each line." - (let ((start (point))) - ;; Remove unwanted headers. - (when message-ignored-cited-headers - (let (all-removed) - (save-restriction - (narrow-to-region - (goto-char start) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point))) - (message-remove-header message-ignored-cited-headers t) - (when (= (point-min) (point-max)) - (setq all-removed t)) - (goto-char (point-max))) - (if all-removed - (goto-char start) - (forward-line 1)))) - ;; Delete blank lines at the start of the buffer. - (while (and (point-min) - (eolp) - (not (eobp))) - (message-delete-line)) - ;; Delete blank lines at the end of the buffer. - (goto-char (point-max)) - (unless (eolp) - (insert "\n")) - (while (and (zerop (forward-line -1)) - (looking-at "$")) - (message-delete-line)) - ;; Do the indentation. - (if (null message-yank-prefix) - (indent-rigidly start (mark t) message-indentation-spaces) - (save-excursion - (goto-char start) - (while (< (point) (mark t)) - (insert message-yank-prefix) - (forward-line 1)))) - (goto-char start))) - -(defun message-yank-original (&optional arg) - "Insert the message being replied to, if any. -Puts point before the text and mark after. -Normally indents each nonblank line ARG spaces (default 3). However, -if `message-yank-prefix' is non-nil, insert that prefix on each line. - -This function uses `message-cite-function' to do the actual citing. - -Just \\[universal-argument] as argument means don't indent, insert no -prefix, and don't delete any headers." - (interactive "P") - (let ((modified (buffer-modified-p))) - (when (and message-reply-buffer - message-cite-function) - (delete-windows-on message-reply-buffer t) - (insert-buffer message-reply-buffer) - (funcall message-cite-function) - (message-exchange-point-and-mark) - (unless (bolp) - (insert ?\n)) - (unless modified - (setq message-checksum (cons (message-checksum) (buffer-size))))))) - -(defun message-cite-original-without-signature () - "Cite function in the standard Message manner." - (let ((start (point)) - (end (mark t)) - (functions - (when message-indent-citation-function - (if (listp message-indent-citation-function) - message-indent-citation-function - (list message-indent-citation-function))))) - (goto-char end) - (when (re-search-backward "^-- $" start t) - (delete-region (point) end)) - (goto-char start) - (while functions - (funcall (pop functions))) - (when message-citation-line-function - (unless (bolp) - (insert "\n")) - (funcall message-citation-line-function)))) - -(defun message-cite-original () - "Cite function in the standard Message manner." - (let ((start (point)) - (functions - (when message-indent-citation-function - (if (listp message-indent-citation-function) - message-indent-citation-function - (list message-indent-citation-function))))) - (goto-char start) - (while functions - (funcall (pop functions))) - (when message-citation-line-function - (unless (bolp) - (insert "\n")) - (funcall message-citation-line-function)))) - -(defun message-insert-citation-line () - "Function that inserts a simple citation line." - (when message-reply-headers - (insert (mail-header-from message-reply-headers) " writes:\n\n"))) - -(defun message-position-on-field (header &rest afters) - (let ((case-fold-search t)) - (save-restriction - (narrow-to-region - (goto-char (point-min)) - (progn - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (match-beginning 0))) - (goto-char (point-min)) - (if (re-search-forward (concat "^" (regexp-quote header) ":") nil t) - (progn - (re-search-forward "^[^ \t]" nil 'move) - (beginning-of-line) - (skip-chars-backward "\n") - t) - (while (and afters - (not (re-search-forward - (concat "^" (regexp-quote (car afters)) ":") - nil t))) - (pop afters)) - (when afters - (re-search-forward "^[^ \t]" nil 'move) - (beginning-of-line)) - (insert header ": \n") - (forward-char -1) - nil)))) - -(defun message-remove-signature () - "Remove the signature from the text between point and mark. -The text will also be indented the normal way." - (save-excursion - (let ((start (point)) - mark) - (if (not (re-search-forward message-signature-separator (mark t) t)) - ;; No signature here, so we just indent the cited text. - (message-indent-citation) - ;; Find the last non-empty line. - (forward-line -1) - (while (looking-at "[ \t]*$") - (forward-line -1)) - (forward-line 1) - (setq mark (set-marker (make-marker) (point))) - (goto-char start) - (message-indent-citation) - ;; Enable undoing the deletion. - (undo-boundary) - (delete-region mark (mark t)) - (set-marker mark nil))))) - - - -;;; -;;; Sending messages -;;; - -(defun message-send-and-exit (&optional arg) - "Send message like `message-send', then, if no errors, exit from mail buffer." - (interactive "P") - (let ((buf (current-buffer)) - (actions message-exit-actions)) - (when (and (message-send arg) - (buffer-name buf)) - (if message-kill-buffer-on-exit - (kill-buffer buf) - (bury-buffer buf) - (when (eq buf (current-buffer)) - (message-bury buf))) - (message-do-actions actions)))) - -(defun message-dont-send () - "Don't send the message you have been editing." - (interactive) - (save-buffer) - (let ((actions message-postpone-actions)) - (message-bury (current-buffer)) - (message-do-actions actions))) - -(defun message-kill-buffer () - "Kill the current buffer." - (interactive) - (when (or (not (buffer-modified-p)) - (yes-or-no-p "Message modified; kill anyway? ")) - (let ((actions message-kill-actions)) - (setq buffer-file-name nil) - (kill-buffer (current-buffer)) - (message-do-actions actions)))) - -(defun message-bury (buffer) - "Bury this mail buffer." - (let ((newbuf (other-buffer buffer))) - (bury-buffer buffer) - (if (and (fboundp 'frame-parameters) - (cdr (assq 'dedicated (frame-parameters))) - (not (null (delq (selected-frame) (visible-frame-list))))) - (delete-frame (selected-frame)) - (switch-to-buffer newbuf)))) - -(defun message-send (&optional arg) - "Send the message in the current buffer. -If `message-interactive' is non-nil, wait for success indication -or error messages, and inform user. -Otherwise any failure is reported in a message back to -the user from the mailer." - (interactive "P") - ;; Disabled test. - (when (or (buffer-modified-p) - (message-check-element 'unchanged) - (y-or-n-p "No changes in the buffer; really send? ")) - ;; Make it possible to undo the coming changes. - (undo-boundary) - (let ((inhibit-read-only t)) - (put-text-property (point-min) (point-max) 'read-only nil)) - (message-fix-before-sending) - (gnus-run-hooks 'message-send-hook) - (message "Sending...") - (let ((message-encoding-buffer - (message-generate-new-buffer-clone-locals " message encoding")) - (message-edit-buffer (current-buffer)) - (message-mime-mode mime-edit-mode-flag) - (alist message-send-method-alist) - (success t) - elem sent) - (save-excursion - (set-buffer message-encoding-buffer) - (erase-buffer) - (insert-buffer message-edit-buffer) - (funcall message-encode-function) - (while (and success - (setq elem (pop alist))) - (when (and (or (not (funcall (cadr elem))) - (and (or (not (memq (car elem) - message-sent-message-via)) - (y-or-n-p - (format - "Already sent message via %s; resend? " - (car elem)))) - (setq success (funcall (caddr elem) arg))))) - (setq sent t)))) - (when (and success sent) - (message-do-fcc) - ;;(when (fboundp 'mail-hist-put-headers-into-history) - ;; (mail-hist-put-headers-into-history)) - (gnus-run-hooks 'message-sent-hook) - (message "Sending...done") - ;; Mark the buffer as unmodified and delete autosave. - (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)))) - -(defun message-send-via-mail (arg) - "Send the current message via mail." - (message-send-mail arg)) - -(defun message-send-via-news (arg) - "Send the current message via news." - (message-send-news arg)) - -(defun message-fix-before-sending () - "Do various things to make the message nice before sending it." - ;; Make sure there's a newline at the end of the message. - (goto-char (point-max)) - (unless (bolp) - (insert "\n"))) - -(defun message-add-action (action &rest types) - "Add ACTION to be 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)))))) - -(defun message-do-actions (actions) - "Perform all actions in ACTIONS." - ;; Now perform actions on successful sending. - (while actions - (ignore-errors - (cond - ;; A simple function. - ((message-functionp (car actions)) - (funcall (car actions))) - ;; Something to be evaled. - (t - (eval (car actions))))) - (pop actions))) - -(defun message-send-mail (&optional arg) - (require 'mail-utils) - (let ((tembuf (message-generate-new-buffer-clone-locals " message temp")) - (case-fold-search nil) - (news (message-news-p))) - (save-restriction - (message-narrow-to-headers) - ;; Insert some headers. - (let ((message-deletable-headers - (if news nil message-deletable-headers))) - (message-generate-headers message-required-mail-headers)) - ;; Let the user do all of the above. - (gnus-run-hooks 'message-header-hook)) - (unwind-protect - (save-excursion - (set-buffer tembuf) - (erase-buffer) - (insert-buffer message-encoding-buffer) - ;; Remove some headers. - (save-restriction - (message-narrow-to-headers) - ;; Remove some headers. - (message-remove-header message-ignored-mail-headers t)) - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - (when (and news - (or (message-fetch-field "cc") - (message-fetch-field "to"))) - (message-insert-courtesy-copy)) - (mime-edit-maybe-split-and-send - (function - (lambda () - (interactive) - (funcall message-send-mail-function) - ))) - (funcall message-send-mail-function)) - (kill-buffer tembuf)) - (set-buffer message-edit-buffer) - (push 'mail message-sent-message-via))) - -(defun message-send-mail-with-sendmail () - "Send off the prepared buffer with sendmail." - (let ((errbuf (if message-interactive - (generate-new-buffer " 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)) - (gnus-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 "/") - (coding-system-for-write 'binary)) - (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" (user-login-name))) - ;; 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))))) - (when (bufferp errbuf) - (kill-buffer errbuf))))) - -(defun message-send-mail-with-qmail () - "Pass the prepared message buffer to qmail-inject. -Refer to the documentation for the variable `message-send-mail-function' -to find out how to use this." - ;; replace the header delimiter with a blank line - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (gnus-run-hooks 'message-send-mail-hook) - ;; send the message - (case - (let ((coding-system-for-write 'binary)) - (apply - 'call-process-region 1 (point-max) message-qmail-inject-program - nil nil nil - ;; qmail-inject's default behaviour is to look for addresses on the - ;; command line; if there're none, it scans the headers. - ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin. - ;; - ;; in general, ALL of qmail-inject's defaults are perfect for simply - ;; reading a formatted (i. e., at least a To: or Resent-To header) - ;; message from stdin. - ;; - ;; qmail also has the advantage of not having been raped by - ;; various vendors, so we don't have to allow for that, either -- - ;; compare this with message-send-mail-with-sendmail and weep - ;; for sendmail's lost innocence. - ;; - ;; all this is way cool coz it lets us keep the arguments entirely - ;; 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)) - ;; 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")) - (111 (error "qmail-inject reported transient failure")) - ;; should never happen - (t (error "qmail-inject reported unknown failure")))) - -(defun message-send-mail-with-mh () - "Send the prepared message buffer with mh." - (let ((mh-previous-window-config nil) - (name (mh-new-draft-name))) - (setq buffer-file-name name) - ;; MH wants to generate these headers itself. - (when message-mh-deletable-headers - (let ((headers message-mh-deletable-headers)) - (while headers - (goto-char (point-min)) - (and (re-search-forward - (concat "^" (symbol-name (car headers)) ": *") nil t) - (message-delete-line)) - (pop headers)))) - (gnus-run-hooks 'message-send-mail-hook) - ;; Pass it on to mh. - (mh-send-letter))) - -(defun message-send-mail-with-smtp () - "Send the prepared message buffer with SMTP." - (require 'smtp) - (let ((errbuf (if mail-interactive - (generate-new-buffer " smtp errors") - 0)) - (case-fold-search nil) - resend-to-addresses - delimline) - (unwind-protect - (save-excursion - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - ;; 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) - ;; (sendmail-synch-aliases) - ;; (if mail-aliases - ;; (expand-mail-aliases (point-min) delimline)) - (goto-char (point-min)) - ;; ignore any blank lines in the header - (while (and (re-search-forward "\n\n\n*" delimline t) - (< (point) delimline)) - (replace-match "\n")) - (let ((case-fold-search t)) - (goto-char (point-min)) - (goto-char (point-min)) - (while (re-search-forward "^Resent-to:" delimline t) - (setq resend-to-addresses - (save-restriction - (narrow-to-region (point) - (save-excursion - (end-of-line) - (point))) - (append (mail-parse-comma-list) - resend-to-addresses)))) -;;; Apparently this causes a duplicate Sender. -;;; ;; If the From is different than current user, insert Sender. -;;; (goto-char (point-min)) -;;; (and (re-search-forward "^From:" delimline t) -;;; (progn -;;; (require 'mail-utils) -;;; (not (string-equal -;;; (mail-strip-quoted-names -;;; (save-restriction -;;; (narrow-to-region (point-min) delimline) -;;; (mail-fetch-field "From"))) -;;; (user-login-name)))) -;;; (progn -;;; (forward-line 1) -;;; (insert "Sender: " (user-login-name) "\n"))) - ;; Don't send out a blank subject line - (goto-char (point-min)) - (if (re-search-forward "^Subject:[ \t]*\n" delimline t) - (replace-match "")) - ;; Put the "From:" field in unless for some odd reason - ;; they put one in themselves. - (goto-char (point-min)) - (if (not (re-search-forward "^From:" delimline t)) - (let* ((login user-mail-address) - (fullname (user-full-name))) - (cond ((eq mail-from-style 'angles) - (insert "From: " fullname) - (let ((fullname-start (+ (point-min) 6)) - (fullname-end (point-marker))) - (goto-char fullname-start) - ;; Look for a character that cannot appear unquoted - ;; according to RFC 822. - (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" - fullname-end 1) - (progn - ;; Quote fullname, escaping specials. - (goto-char fullname-start) - (insert "\"") - (while (re-search-forward "[\"\\]" - fullname-end 1) - (replace-match "\\\\\\&" t)) - (insert "\"")))) - (insert " <" login ">\n")) - ((eq mail-from-style 'parens) - (insert "From: " login " (") - (let ((fullname-start (point))) - (insert fullname) - (let ((fullname-end (point-marker))) - (goto-char fullname-start) - ;; RFC 822 says \ and nonmatching parentheses - ;; must be escaped in comments. - ;; Escape every instance of ()\ ... - (while (re-search-forward "[()\\]" fullname-end 1) - (replace-match "\\\\\\&" t)) - ;; ... then undo escaping of matching parentheses, - ;; including matching nested parentheses. - (goto-char fullname-start) - (while (re-search-forward - "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" - fullname-end 1) - (replace-match "\\1(\\3)" t) - (goto-char fullname-start)))) - (insert ")\n")) - ((null mail-from-style) - (insert "From: " login "\n"))))) - ;; Insert an extra newline if we need it to work around - ;; Sun's bug that swallows newlines. - (goto-char (1+ delimline)) - (if (eval mail-mailer-swallows-blank-line) - (newline)) - ;; Find and handle any FCC fields. - (goto-char (point-min)) - (if (re-search-forward "^FCC:" delimline t) - (mail-do-fcc delimline)) - (if mail-interactive - (save-excursion - (set-buffer errbuf) - (erase-buffer)))) - ;; - ;; - ;; - (let ((recipient-address-list - (or resend-to-addresses - (smtp-deduce-address-list (current-buffer) - (point-min) delimline)))) - (smtp-do-bcc delimline) - - (if recipient-address-list - (if (not (smtp-via-smtp recipient-address-list - (current-buffer))) - (error "Sending failed; SMTP protocol error")) - (error "Sending failed; no recipients")) - )) - (if (bufferp errbuf) - (kill-buffer errbuf))))) - -(defun message-send-news (&optional arg) - (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*")) - (case-fold-search nil) - (method (if (message-functionp message-post-method) - (funcall message-post-method arg) - message-post-method)) - (message-syntax-checks - (if arg - (cons '(existing-newsgroups . disabled) - message-syntax-checks) - message-syntax-checks)) - result) - (save-restriction - (message-narrow-to-headers) - ;; Insert some headers. - (message-generate-headers message-required-news-headers) - ;; Let the user do all of the above. - (gnus-run-hooks 'message-header-hook)) - (message-cleanup-headers) - (if (not (message-check-news-syntax)) - (progn - ;;(message "Posting not performed") - nil) - (unwind-protect - (save-excursion - (set-buffer tembuf) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-buffer message-encoding-buffer) - ;; Remove some headers. - (save-restriction - (message-narrow-to-headers) - ;; Remove some headers. - (message-remove-header message-ignored-news-headers t)) - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - (mime-edit-maybe-split-and-send - (function - (lambda () - (interactive) - (save-restriction - (std11-narrow-to-header mail-header-separator) - (goto-char (point-min)) - (when (re-search-forward "^Message-Id:" nil t) - (delete-region (match-end 0)(std11-field-end)) - (insert (concat " " (message-make-message-id))) - )) - (funcall message-send-news-function method) - ))) - (setq result (funcall message-send-news-function method))) - (kill-buffer tembuf)) - (set-buffer message-edit-buffer) - (if result - (push 'news message-sent-message-via) - (message "Couldn't send message via news: %s" - (nnheader-get-report (car method))) - nil)))) - -;; 1997-09-29 by MORIOKA Tomohiko -(defun message-send-news-with-gnus (method) - (let ((case-fold-search t)) - ;; Remove the delimiter. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1) - (run-hooks 'message-send-news-hook) - ;;(require (car method)) - ;;(funcall (intern (format "%s-open-server" (car method))) - ;;(cadr method) (cddr method)) - ;;(setq result - ;; (funcall (intern (format "%s-request-post" (car method))) - ;; (cadr method))) - (gnus-open-server method) - (gnus-request-post method) - )) - -;;; -;;; Header generation & syntax checking. -;;; - -(defmacro message-check (type &rest forms) - "Eval FORMS if TYPE is to be checked." - `(or (message-check-element ,type) - (save-excursion - ,@forms))) - -(put 'message-check 'lisp-indent-function 1) -(put 'message-check 'edebug-form-spec '(form body)) - -(defun message-check-element (type) - "Returns 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))) - (and (consp able) - (eq (cdr able) 'disabled))))) - -(defun message-check-news-syntax () - "Check the syntax of the message." - (save-excursion - (save-restriction - (widen) - (and - ;; We narrow to the headers and check them first. - (save-excursion - (save-restriction - (message-narrow-to-headers) - (message-check-news-header-syntax))) - ;; Check the body. - (save-excursion - (set-buffer message-edit-buffer) - (message-check-news-body-syntax)))))) - -(defun message-check-news-header-syntax () - (and - ;; Check the Subject header. - (message-check 'subject - (let* ((case-fold-search t) - (subject (message-fetch-field "subject"))) - (or - (and subject - (not (string-match "\\`[ \t]*\\'" subject))) - (ignore - (message - "The subject field is empty or missing. Posting is denied."))))) - ;; Check for commands in Subject. - (message-check 'subject-cmsg - (if (string-match "^cmsg " (message-fetch-field "subject")) - (y-or-n-p - "The control code \"cmsg\" is in the subject. Really post? ") - t)) - ;; Check for multiple identical headers. - (message-check 'multiple-headers - (let (found) - (while (and (not found) - (re-search-forward "^[^ \t:]+: " nil t)) - (save-excursion - (or (re-search-forward - (concat "^" - (regexp-quote - (setq found - (buffer-substring - (match-beginning 0) (- (match-end 0) 2)))) - ":") - nil t) - (setq found nil)))) - (if found - (y-or-n-p (format "Multiple %s headers. Really post? " found)) - t))) - ;; Check for Version and Sendsys. - (message-check 'sendsys - (if (re-search-forward "^Sendsys:\\|^Version:" nil t) - (y-or-n-p - (format "The article contains a %s command. Really post? " - (buffer-substring (match-beginning 0) - (1- (match-end 0))))) - t)) - ;; See whether we can shorten Followup-To. - (message-check 'shorten-followup-to - (let ((newsgroups (message-fetch-field "newsgroups")) - (followup-to (message-fetch-field "followup-to")) - to) - (when (and newsgroups - (string-match "," newsgroups) - (not followup-to) - (not - (zerop - (length - (setq to (completing-read - "Followups to: (default all groups) " - (mapcar (lambda (g) (list g)) - (cons "poster" - (message-tokenize-header - newsgroups))))))))) - (goto-char (point-min)) - (insert "Followup-To: " to "\n")) - t)) - ;; Check "Shoot me". - (message-check 'shoot - (if (re-search-forward - "Message-ID.*.i-did-not-set--mail-host-address--so-shoot-me" nil t) - (y-or-n-p "You appear to have a misconfigured system. Really post? ") - t)) - ;; Check for Approved. - (message-check 'approved - (if (re-search-forward "^Approved:" nil t) - (y-or-n-p "The article contains an Approved header. Really post? ") - t)) - ;; Check the Message-ID header. - (message-check 'message-id - (let* ((case-fold-search t) - (message-id (message-fetch-field "message-id" t))) - (or (not message-id) - ;; Is there an @ in the ID? - (and (string-match "@" message-id) - ;; Is there a dot in the ID? - (string-match "@[^.]*\\." message-id) - ;; Does the ID end with a dot? - (not (string-match "\\.>" message-id))) - (y-or-n-p - (format "The Message-ID looks strange: \"%s\". Really post? " - message-id))))) - ;; Check the Newsgroups & Followup-To headers. - (message-check 'existing-newsgroups - (let* ((case-fold-search t) - (newsgroups (message-fetch-field "newsgroups")) - (followup-to (message-fetch-field "followup-to")) - (groups (message-tokenize-header - (if followup-to - (concat newsgroups "," followup-to) - newsgroups))) - (hashtb (and (boundp 'gnus-active-hashtb) - gnus-active-hashtb)) - 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 ", "))))))) - ;; Check the Newsgroups & Followup-To headers for syntax errors. - (message-check 'valid-newsgroups - (let ((case-fold-search t) - (headers '("Newsgroups" "Followup-To")) - header error) - (while (and headers (not error)) - (when (setq header (mail-fetch-field (car headers))) - (if (or - (not - (string-match - "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'" - header)) - (memq - nil (mapcar - (lambda (g) - (not (string-match "\\.\\'\\|\\.\\." g))) - (message-tokenize-header header ",")))) - (setq error t))) - (unless error - (pop headers))) - (if (not error) - t - (y-or-n-p - (format "The %s header looks odd: \"%s\". Really post? " - (car headers) header))))) - (message-check 'repeated-newsgroups - (let ((case-fold-search t) - (headers '("Newsgroups" "Followup-To")) - header error groups group) - (while (and headers - (not error)) - (when (setq header (mail-fetch-field (pop headers))) - (setq groups (message-tokenize-header header ",")) - (while (setq group (pop groups)) - (when (member group groups) - (setq error group - groups nil))))) - (if (not error) - t - (y-or-n-p - (format "Group %s is repeated in headers. Really post? " error))))) - ;; Check the From header. - (message-check 'from - (let* ((case-fold-search t) - (from (message-fetch-field "from")) - (ad (nth 1 (mail-extract-address-components from)))) - (cond - ((not from) - (message "There is no From line. Posting is denied.") - nil) - ((or (not (string-match "@[^\\.]*\\." ad)) ;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 "(.*).*(.*)" from)) ;(lars) (lars) - (message - "Denied posting -- the From looks strange: \"%s\"." from) - nil) - (t t)))))) - -(defun message-check-news-body-syntax () - (and - ;; Check for long lines. - (message-check 'long-lines - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (while (and - (progn - (end-of-line) - (< (current-column) 80)) - (zerop (forward-line 1)))) - (or (bolp) - (eobp) - (y-or-n-p - "You have lines longer than 79 characters. Really post? "))) - ;; Check whether the article is empty. - (message-check 'empty - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (let ((b (point))) - (goto-char (point-max)) - (re-search-backward message-signature-separator nil t) - (beginning-of-line) - (or (re-search-backward "[^ \n\t]" b t) - (y-or-n-p "Empty article. Really post? ")))) - ;; Check for control characters. - (message-check 'control-chars - (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t) - (y-or-n-p - "The article contains control characters. Really post? ") - t)) - ;; Check excessive size. - (message-check 'size - (if (> (buffer-size) 60000) - (y-or-n-p - (format "The article is %d octets long. Really post? " - (buffer-size))) - t)) - ;; Check whether any new text has been added. - (message-check 'new-text - (or - (not message-checksum) - (not (and (eq (message-checksum) (car message-checksum)) - (eq (buffer-size) (cdr message-checksum)))) - (y-or-n-p - "It looks like no new text has been added. Really post? "))) - ;; Check the length of the signature. - (message-check 'signature - (goto-char (point-max)) - (if (or (not (re-search-backward message-signature-separator nil t)) - (search-forward message-forward-end-separator nil t)) - t - (if (> (count-lines (point) (point-max)) 5) - (y-or-n-p - (format - "Your .sig is %d lines; it should be max 4. Really post? " - (1- (count-lines (point) (point-max))))) - t))))) - -(defun message-checksum () - "Return a \"checksum\" for the current buffer." - (let ((sum 0)) - (save-excursion - (goto-char (point-min)) - (re-search-forward - (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) - (following-char)))) - (forward-char 1))) - sum)) - -(defun message-do-fcc () - "Process Fcc headers in the current buffer." - (let ((case-fold-search t) - (coding-system-for-write 'raw-text) - list file) - (save-excursion - (set-buffer (get-buffer-create " *message temp*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-buffer-substring 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))) - (gnus-run-hooks 'message-header-hook 'message-before-do-fcc-hook) - (goto-char (point-min)) - (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) - (replace-match "" t t) - ;; 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.." - (if (and (file-readable-p filename) - (mail-file-babyl-p filename)) - (gnus-output-to-rmail filename t) - (gnus-output-to-mail filename t))) - -(defun message-cleanup-headers () - "Do various automatic cleanups of the headers." - ;; Remove empty lines in the header. - (save-restriction - (message-narrow-to-headers) - ;; Remove blank lines. - (while (re-search-forward "^[ \t]*\n" nil t) - (replace-match "" t t)) - - ;; Correct Newsgroups and Followup-To headers: Change sequence of - ;; spaces to comma and eliminate spaces around commas. Eliminate - ;; embedded line breaks. - (goto-char (point-min)) - (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t) - (save-restriction - (narrow-to-region - (point) - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (forward-line 1) - (point))) - (goto-char (point-min)) - (while (re-search-forward "\n[ \t]+" nil t) - (replace-match " " t t)) ;No line breaks (too confusing) - (goto-char (point-min)) - (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t) - (replace-match "," t t)) - (goto-char (point-min)) - ;; Remove trailing commas. - (when (re-search-forward ",+$" nil t) - (replace-match "" t t)))))) - -(defun message-make-date () - "Make a valid data header." - (let ((now (current-time))) - (timezone-make-date-arpa-standard - (current-time-string now) (current-time-zone now)))) - -(defun message-make-message-id () - "Make a unique Message-ID." - (concat "<" (message-unique-id) - (let ((psubject (save-excursion (message-fetch-field "subject"))) - (psupersedes - (save-excursion (message-fetch-field "supersedes")))) - (if (or - (and message-reply-headers - (mail-header-references message-reply-headers) - (mail-header-subject message-reply-headers) - psubject - (mail-header-subject message-reply-headers) - (not (string= - (message-strip-subject-re - (mail-header-subject message-reply-headers)) - (message-strip-subject-re psubject)))) - (and psupersedes - (string-match "_-_@" psupersedes))) - "_-_" "")) - "@" (message-make-fqdn) ">")) - -(defvar message-unique-id-char nil) - -;; If you ever change this function, make sure the new version -;; cannot generate IDs that the old version could. -;; You might for example insert a "." somewhere (not next to another dot -;; or string boundary), or modify the "fsf" string. -(defun message-unique-id () - ;; Don't use microseconds from (current-time), they may be unsupported. - ;; Instead we use this randomly inited counter. - (setq message-unique-id-char - (% (1+ (or message-unique-id-char (logand (random t) (1- (lsh 1 20))))) - ;; (current-time) returns 16-bit ints, - ;; and 2^16*25 just fits into 4 digits i base 36. - (* 25 25))) - (let ((tm (current-time))) - (concat - (if (memq system-type '(ms-dos emx vax-vms)) - (let ((user (downcase (user-login-name)))) - (while (string-match "[^a-z0-9_]" user) - (aset user (match-beginning 0) ?_)) - user) - (message-number-base36 (user-uid) -1)) - (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. - ".fsf"))) - -(defun message-number-base36 (num len) - (if (if (< len 0) - (<= num 0) - (= len 0)) - "" - (concat (message-number-base36 (/ num 36) (1- len)) - (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" - (% num 36)))))) - -(defun message-make-organization () - "Make an Organization header." - (let* ((organization - (when message-user-organization - (if (message-functionp message-user-organization) - (funcall message-user-organization) - message-user-organization)))) - (save-excursion - (message-set-work-buffer) - (cond ((stringp organization) - (insert organization)) - ((and (eq t organization) - message-user-organization-file - (file-exists-p message-user-organization-file)) - (insert-file-contents message-user-organization-file))) - (goto-char (point-min)) - (while (re-search-forward "[\t\n]+" nil t) - (replace-match "" t t)) - (unless (zerop (buffer-size)) - (buffer-string))))) - -(defun message-make-lines () - "Count the number of lines and return numeric string." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (int-to-string (count-lines (point) (point-max)))))) - -(defun message-make-in-reply-to () - "Return the In-Reply-To header for this message." - (when message-reply-headers - (let ((from (mail-header-from message-reply-headers)) - (date (mail-header-date message-reply-headers))) - (when from - (let ((stop-pos - (string-match " *at \\| *@ \\| *(\\| *<" from))) - (concat (if stop-pos (substring from 0 stop-pos) from) - "'s message of \"" - (if (or (not date) (string= date "")) - "(unknown date)" date) - "\"")))))) - -(defun message-make-distribution () - "Make a Distribution header." - (let ((orig-distribution (message-fetch-reply-field "distribution"))) - (cond ((message-functionp message-distribution-function) - (funcall message-distribution-function)) - (t orig-distribution)))) - -(defun message-make-expires () - "Return an Expires header based on `message-expires'." - (let ((current (current-time)) - (future (* 1.0 message-expires 60 60 24))) - ;; Add the future to current. - (setcar current (+ (car current) (round (/ future (expt 2 16))))) - (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16)))) - ;; Return the date in the future in UT. - (timezone-make-date-arpa-standard - (current-time-string current) (current-time-zone current) '(0 "UT")))) - -(defun message-make-path () - "Return uucp path." - (let ((login-name (user-login-name))) - (cond ((null message-user-path) - (concat (system-name) "!" login-name)) - ((stringp message-user-path) - ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. - (concat message-user-path "!" login-name)) - (t login-name)))) - -(defun message-make-from () - "Make a From header." - (let* ((style message-from-style) - (login (message-make-address)) - (fullname - (or (and (boundp 'user-full-name) - user-full-name) - (user-full-name)))) - (when (string= fullname "&") - (setq fullname (user-login-name))) - (save-excursion - (message-set-work-buffer) - (cond - ((or (null style) - (equal fullname "")) - (insert login)) - ((or (eq style 'angles) - (and (not (eq style 'parens)) - ;; Use angles if no quoting is needed, or if parens would - ;; need quoting too. - (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname)) - (let ((tmp (concat fullname nil))) - (while (string-match "([^()]*)" tmp) - (aset tmp (match-beginning 0) ?-) - (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 " (") - (let ((fullname-start (point))) - (insert fullname) - (goto-char fullname-start) - ;; RFC 822 says \ and nonmatching parentheses - ;; must be escaped in comments. - ;; Escape every instance of ()\ ... - (while (re-search-forward "[()\\]" nil 1) - (replace-match "\\\\\\&" t)) - ;; ... then undo escaping of matching parentheses, - ;; including matching nested parentheses. - (goto-char fullname-start) - (while (re-search-forward - "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" - nil 1) - (replace-match "\\1(\\3)" t) - (goto-char fullname-start))) - (insert ")"))) - (buffer-string)))) - -(defun message-make-sender () - "Return the \"real\" user address. -This function tries to ignore all user modifications, and -give as trustworthy answer as possible." - (concat (user-login-name) "@" (system-name))) - -(defun message-make-address () - "Make the address of the user." - (or (message-user-mail-address) - (concat (user-login-name) "@" (message-make-domain)))) - -(defun message-user-mail-address () - "Return the pertinent part of `user-mail-address'." - (when user-mail-address - (if (string-match " " user-mail-address) - (nth 1 (mail-extract-address-components user-mail-address)) - user-mail-address))) - -(defun message-make-fqdn () - "Return user's fully qualified domain name." - (let ((system-name (system-name)) - (user-mail (message-user-mail-address))) - (cond - ((string-match "[^.]\\.[^.]" 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)) - 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)) - ;; Default to this bogus thing. - (t - (concat system-name ".i-did-not-set--mail-host-address--so-shoot-me"))))) - -(defun message-make-host-name () - "Return the name of the host." - (let ((fqdn (message-make-fqdn))) - (string-match "^[^.]+\\." fqdn) - (substring fqdn 0 (1- (match-end 0))))) - -(defun message-make-domain () - "Return the domain name." - (or mail-host-address - (message-make-fqdn))) - -(defun message-generate-filled-references (references message-id) - "Return filled References field from REFERENCES and MESSAGE-ID." - (std11-fill-msg-id-list-string (concat references message-id))) - -(defun message-generate-folded-references (references message-id) - "Return folded References field from REFERENCES and MESSAGE-ID." - (if references - (let (quote) - (setq references - (mapconcat (function - (lambda (char) - (cond ((eq char ?\\) - (setq quote t) - "\\") - ((memq char '(?\ ?\t)) - (prog1 - (if quote - (char-to-string char) - (concat "\n" (char-to-string char))) - (setq quote nil))) - (t - (setq quote nil) - (char-to-string char) - )))) - references "")) - (if message-id - (concat references "\n " message-id) - references)) - message-id)) - -(defun message-generate-unfolded-references (references message-id) - "Return folded References field from REFERENCES and MESSAGE-ID." - (if references - (if message-id - (concat references " " message-id) - references) - message-id)) - -(defun message-generate-headers (headers) - "Prepare article HEADERS. -Headers already prepared in the buffer are not modified." - (save-restriction - (message-narrow-to-headers) - (let* ((Date (message-make-date)) - (Message-ID (message-make-message-id)) - (Organization (message-make-organization)) - (From (message-make-from)) - (Path (message-make-path)) - (Subject nil) - (Newsgroups nil) - (In-Reply-To (message-make-in-reply-to)) - (To nil) - (Distribution (message-make-distribution)) - (Lines (message-make-lines)) - (X-Newsreader message-newsreader) - (X-Mailer (and (not (message-fetch-field "X-Newsreader")) - message-mailer)) - (Expires (message-make-expires)) - (case-fold-search t) - header value elem) - ;; First we remove any old generated headers. - (let ((headers message-deletable-headers)) - (unless (buffer-modified-p) - (setq headers (delq 'Message-ID (copy-sequence headers)))) - (while headers - (goto-char (point-min)) - (and (re-search-forward - (concat "^" (symbol-name (car headers)) ": *") nil t) - (get-text-property (1+ (match-beginning 0)) 'message-deletable) - (message-delete-line)) - (pop headers))) - ;; Go through all the required headers and see if they are in the - ;; articles already. If they are not, or are empty, they are - ;; inserted automatically - except for Subject, Newsgroups and - ;; Distribution. - (while headers - (goto-char (point-min)) - (setq elem (pop headers)) - (if (consp elem) - (if (eq (car elem) 'optional) - (setq header (cdr elem)) - (setq header (car elem))) - (setq header elem)) - (when (or (not (re-search-forward - (concat "^" (downcase (symbol-name header)) ":") - nil t)) - (progn - ;; The header was found. We insert a space after the - ;; colon, if there is none. - (if (/= (following-char) ? ) (insert " ") (forward-char 1)) - ;; Find out whether the header is empty... - (looking-at "[ \t]*$"))) - ;; So we find out what value we should insert. - (setq value - (cond - ((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))))) - ((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)) - ;; The element is a symbol. We insert the value - ;; of this symbol, if any. - (symbol-value header)) - (t - ;; We couldn't generate a value for this header, - ;; so we just ask the user. - (read-from-minibuffer - (format "Empty header for %s; enter value: " header))))) - ;; Finally insert the header. - (when (and value - (not (equal value ""))) - (save-excursion - (if (bolp) - (progn - ;; This header didn't exist, so we insert it. - (goto-char (point-max)) - (insert (symbol-name header) ": " value "\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)) - ;; Add the deletable property to the headers that require it. - (and (memq header message-deletable-headers) - (progn (beginning-of-line) (looking-at "[^:]+: ")) - (add-text-properties - (point) (match-end 0) - '(message-deletable t face italic) (current-buffer))))))) - ;; Insert new Sender if the From is strange. - (let ((from (message-fetch-field "from")) - (sender (message-fetch-field "sender")) - (secure-sender (message-make-sender))) - (when (and from - (not (message-check-element 'sender)) - (not (string= - (downcase - (cadr (mail-extract-address-components from))) - (downcase secure-sender))) - (or (null sender) - (not - (string= - (downcase - (cadr (mail-extract-address-components sender))) - (downcase secure-sender))))) - (goto-char (point-min)) - ;; Rename any old Sender headers to Original-Sender. - (when (re-search-forward "^\\(Original-\\)*Sender:" nil t) - (beginning-of-line) - (insert "Original-") - (beginning-of-line)) - (when (or (message-news-p) - (string-match "^[^@]@.+\\..+" secure-sender)) - (insert "Sender: " secure-sender "\n"))))))) - -(defun message-insert-courtesy-copy () - "Insert a courtesy message in mail copies of combined messages." - (let (newsgroups) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (when (setq newsgroups (message-fetch-field "newsgroups")) - (goto-char (point-max)) - (insert "Posted-To: " newsgroups "\n"))) - (forward-line 1) - (when message-courtesy-message - (cond - ((string-match "%s" message-courtesy-message) - (insert (format message-courtesy-message newsgroups))) - (t - (insert message-courtesy-message))))))) - -;;; -;;; Setting up a message buffer -;;; - -(defun message-fill-address (header value) - (save-restriction - (narrow-to-region (point) (point)) - (insert (capitalize (symbol-name header)) - ": " - (if (consp value) (car value) value) - "\n") - (narrow-to-region (point-min) (1- (point-max))) - (let (quoted last) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward "^,\"" (point-max)) - (if (or (= (following-char) ?,) - (eobp)) - (when (not quoted) - (if (and (> (current-column) 78) - last) - (progn - (save-excursion - (goto-char last) - (insert "\n\t")) - (setq last (1+ (point)))) - (setq last (1+ (point))))) - (setq quoted (not quoted))) - (unless (eobp) - (forward-char 1)))) - (goto-char (point-max)) - (widen) - (forward-line 1))) - -(defun message-fill-header (header value) - (let ((begin (point)) - (fill-column 990) - (fill-prefix "\t")) - (insert (capitalize (symbol-name header)) - ": " - (if (consp value) (car value) value) - "\n") - (save-restriction - (narrow-to-region begin (point)) - (fill-region-as-paragraph begin (point)) - ;; Tapdance around looong Message-IDs. - (forward-line -1) - (when (looking-at "[ \t]*$") - (message-delete-line)) - (goto-char begin) - (re-search-forward ":" nil t) - (when (looking-at "\n[ \t]+") - (replace-match " " t t)) - (goto-char (point-max))))) - -(defun message-position-point () - "Move point to where the user probably wants to find it." - (message-narrow-to-headers) - (cond - ((re-search-forward "^[^:]+:[ \t]*$" nil t) - (search-backward ":" ) - (widen) - (forward-char 1) - (if (= (following-char) ? ) - (forward-char 1) - (insert " "))) - (t - (goto-char (point-max)) - (widen) - (forward-line 1) - (unless (looking-at "$") - (forward-line 2))) - (sit-for 0))) - -(defun message-buffer-name (type &optional to group) - "Return a new (unique) buffer name based on TYPE and TO." - (cond - ;; Check whether `message-generate-new-buffers' is a function, - ;; and if so, call it. - ((message-functionp message-generate-new-buffers) - (funcall message-generate-new-buffers type to group)) - ;; Generate a new buffer name The Message Way. - (message-generate-new-buffers - (generate-new-buffer-name - (concat "*" type - (if to - (concat " to " - (or (car (mail-extract-address-components to)) - to) "") - "") - (if (and group (not (string= group ""))) (concat " on " group) "") - "*"))) - ;; Use standard name. - (t - (format "*%s message*" type)))) - -(defun message-pop-to-buffer (name) - "Pop to buffer NAME, and warn if it already exists and is modified." - (let ((buffer (get-buffer name))) - (if (and buffer - (buffer-name buffer)) - (progn - (set-buffer (pop-to-buffer buffer)) - (when (and (buffer-modified-p) - (not (y-or-n-p - "Message already being composed; erase? "))) - (error "Message being composed"))) - (set-buffer (pop-to-buffer name)))) - (erase-buffer) - (message-mode)) - -(defun message-do-send-housekeeping () - "Kill old message buffers." - ;; We might have sent this buffer already. Delete it from the - ;; list of buffers. - (setq message-buffer-list (delq (current-buffer) message-buffer-list)) - (while (and message-max-buffers - 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))) - (when (and (buffer-name buffer) - (not (buffer-modified-p buffer))) - (kill-buffer buffer)))) - ;; Rename the buffer. - (if message-send-rename-function - (funcall message-send-rename-function) - (when (string-match "\\`\\*" (buffer-name)) - (rename-buffer - (concat "*sent " (substring (buffer-name) (match-end 0))) 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)) - (setq message-reply-buffer replybuffer) - (goto-char (point-min)) - ;; Insert all the headers. - (mail-header-format - (let ((h headers) - (alist message-header-format-alist)) - (while h - (unless (assq (caar h) message-header-format-alist) - (push (list (caar h)) alist)) - (pop h)) - alist) - headers) - (delete-region (point) (progn (forward-line -1) (point))) - (when message-default-headers - (insert message-default-headers) - (or (bolp) (insert ?\n))) - (put-text-property - (point) - (progn - (insert mail-header-separator "\n") - (1- (point))) - 'read-only nil) - (forward-line -1) - (when (message-news-p) - (when message-default-news-headers - (insert message-default-news-headers) - (or (bolp) (insert ?\n))) - (when message-generate-headers-first - (message-generate-headers - (delq 'Lines - (delq 'Subject - (copy-sequence message-required-news-headers)))))) - (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)))))) - (gnus-run-hooks 'message-signature-setup-hook) - (message-insert-signature) - (save-restriction - (message-narrow-to-headers) - (gnus-run-hooks 'message-header-setup-hook)) - (set-buffer-modified-p nil) - (setq buffer-undo-list nil) - (gnus-run-hooks 'message-setup-hook) - (message-position-point) - (undo-boundary)) - -(defun message-set-auto-save-file-name () - "Associate the message buffer with a file in the drafts directory." - (when message-autosave-directory - (setq message-draft-article (nndraft-request-associate-buffer "drafts")) - (clear-visited-file-modtime))) - -(defun message-disassociate-draft () - "Disassociate the message buffer from the drafts directory." - (when message-draft-article - (nndraft-request-expire-articles - (list message-draft-article) "drafts" nil t))) - - - -;;; -;;; Commands for interfacing with message -;;; - -;;;###autoload -(defun message-mail (&optional to subject - other-headers continue switch-function - yank-action send-actions) - "Start editing a mail message to be sent." - (interactive) - (let ((message-this-is-mail t)) - (message-pop-to-buffer (message-buffer-name "mail" to)) - (message-setup - (nconc - `((To . ,(or to "")) (Subject . ,(or subject ""))) - (when other-headers other-headers))))) - -;;;###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-setup `((Newsgroups . ,(or newsgroups "")) - (Subject . ,(or subject "")))))) - -;;;###autoload -(defun message-reply (&optional to-address wide ignore-reply-to) - "Start editing a reply to the article in the current buffer." - (interactive) - (let ((cur (current-buffer)) - from subject date reply-to to cc - references message-id follow-to - (inhibit-point-motion-hooks t) - mct never-mct gnus-warning) - (save-restriction - (message-narrow-to-head) - ;; Allow customizations to have their say. - (if (not wide) - ;; This is a regular reply. - (if (message-functionp message-reply-to-function) - (setq follow-to (funcall message-reply-to-function))) - ;; This is a followup. - (if (message-functionp message-wide-reply-to-function) - (save-excursion - (setq follow-to - (funcall message-wide-reply-to-function))))) - ;; Find all relevant headers we need. - (setq from (message-fetch-field "from") - date (message-fetch-field "date") - subject (or (message-fetch-field "subject") "none") - to (message-fetch-field "to") - cc (message-fetch-field "cc") - mct (message-fetch-field "mail-copies-to") - reply-to (unless ignore-reply-to (message-fetch-field "reply-to")) - references (message-fetch-field "references") - message-id (message-fetch-field "message-id" t)) - ;; Remove any (buggy) Re:'s that are present and make a - ;; proper one. - (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject) - (setq subject (substring subject (match-end 0)))) - (setq subject (concat "Re: " subject)) - - (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) - (string-match "<[^>]+>" gnus-warning)) - (setq message-id (match-string 0 gnus-warning))) - - ;; Handle special values of Mail-Copies-To. - (when mct - (cond ((equal (downcase mct) "never") - (setq never-mct t) - (setq mct nil)) - ((equal (downcase mct) "always") - (setq mct (or reply-to from))))) - - (unless follow-to - (if (or (not wide) - to-address) - (progn - (setq follow-to (list (cons 'To (or to-address reply-to from)))) - (when (and wide mct) - (push (cons 'Cc mct) follow-to))) - (let (ccalist) - (save-excursion - (message-set-work-buffer) - (unless never-mct - (insert (or 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'. - (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 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)))))) - (widen)) - - (message-pop-to-buffer (message-buffer-name - (if wide "wide reply" "reply") from - (if wide to-address nil))) - - (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")) - - (message-setup - `((Subject . ,subject) - ,@follow-to - ,@(if (or references message-id) - `((References . ,(funcall message-references-generator - references message-id)))) - ) - cur))) - -;;;###autoload -(defun message-wide-reply (&optional to-address ignore-reply-to) - "Make a \"wide\" reply to the message in the current buffer." - (interactive) - (message-reply to-address t ignore-reply-to)) - -;;;###autoload -(defun message-followup (&optional to-newsgroups) - "Follow up to the message in the current buffer. -If TO-NEWSGROUPS, use that as the new Newsgroups line." - (interactive) - (let ((cur (current-buffer)) - from subject date reply-to mct - references message-id follow-to - (inhibit-point-motion-hooks t) - (message-this-is-news t) - followup-to distribution newsgroups gnus-warning posted-to) - (save-restriction - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) - (when (message-functionp message-followup-to-function) - (setq follow-to - (funcall message-followup-to-function))) - (setq from (message-fetch-field "from") - date (message-fetch-field "date") - subject (or (message-fetch-field "subject") "none") - references (message-fetch-field "references") - message-id (message-fetch-field "message-id" t) - followup-to (message-fetch-field "followup-to") - newsgroups (message-fetch-field "newsgroups") - posted-to (message-fetch-field "posted-to") - reply-to (message-fetch-field "reply-to") - distribution (message-fetch-field "distribution") - mct (message-fetch-field "mail-copies-to")) - (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) - (string-match "<[^>]+>" gnus-warning)) - (setq message-id (match-string 0 gnus-warning))) - ;; Remove bogus distribution. - (when (and (stringp distribution) - (let ((case-fold-search t)) - (string-match "world" distribution))) - (setq distribution nil)) - ;; Remove any (buggy) Re:'s that are present and make a - ;; proper one. - (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject) - (setq subject (substring subject (match-end 0)))) - (setq subject (concat "Re: " subject)) - (widen)) - - (message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) - - (message-setup - `((Subject . ,subject) - ,@(cond - (to-newsgroups - (list (cons 'Newsgroups to-newsgroups))) - (follow-to follow-to) - ((and followup-to message-use-followup-to) - (list - (cond - ((equal (downcase followup-to) "poster") - (if (or (eq message-use-followup-to 'use) - (message-y-or-n-p "Obey Followup-To: poster? " t "\ -You should normally obey the Followup-To: header. - -`Followup-To: poster' sends your response via e-mail instead of news. - -A typical situation where `Followup-To: poster' is used is when the poster -does not read the newsgroup, so he wouldn't see any replies sent to it.")) - (progn - (setq message-this-is-news nil) - (cons 'To (or reply-to from ""))) - (cons 'Newsgroups newsgroups))) - (t - (if (or (equal followup-to newsgroups) - (not (eq message-use-followup-to 'ask)) - (message-y-or-n-p - (concat "Obey Followup-To: " followup-to "? ") t "\ -You should normally obey the Followup-To: header. - - `Followup-To: " followup-to "' -directs your response to " (if (string-match "," followup-to) - "the specified newsgroups" - "that newsgroup only") ". - -If a message is posted to several newsgroups, Followup-To is often -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; -responses here are directed to other newsgroups.")) - (cons 'Newsgroups followup-to) - (cons 'Newsgroups newsgroups)))))) - (posted-to - `((Newsgroups . ,posted-to))) - (t - `((Newsgroups . ,newsgroups)))) - ,@(and distribution (list (cons 'Distribution distribution))) - ,@(if (or references message-id) - `((References . ,(funcall message-references-generator - references message-id)))) - ,@(when (and mct - (not (equal (downcase mct) "never"))) - (list (cons 'Cc (if (equal (downcase mct) "always") - (or reply-to from "") - mct))))) - - cur) - - (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")))) - - -;;;###autoload -(defun message-cancel-news () - "Cancel an article you posted." - (interactive) - (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) - (save-excursion - ;; Get header info. from original article. - (save-restriction - (message-narrow-to-head) - (setq from (message-fetch-field "from") - 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 (string-equal - (downcase (cadr (std11-extract-address-components from))) - (downcase (message-make-address))) - (error "This article is not yours")) - ;; Make control message. - (setq buf (set-buffer (get-buffer-create " *message cancel*"))) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert "Newsgroups: " newsgroups "\n" - "From: " (message-make-from) "\n" - "Subject: cmsg cancel " message-id "\n" - "Control: cancel " message-id "\n" - (if distribution - (concat "Distribution: " distribution "\n") - "") - mail-header-separator "\n" - message-cancel-message) - (message "Canceling your article...") - (if (let ((message-syntax-checks - 'dont-check-for-anything-just-trust-me) - (message-encoding-buffer (current-buffer)) - (message-edit-buffer (current-buffer))) - (message-send-news)) - (message "Canceling your article...done")) - (kill-buffer buf))))) - -;;;###autoload -(defun message-supersede () - "Start composing a message to supersede the current message. -This is done simply by taking the old article and adding a Supersedes -header line with the old Message-ID." - (interactive) - (let ((cur (current-buffer))) - ;; Check whether the user owns the article that is to be superseded. - (unless (string-equal - (downcase (cadr (mail-extract-address-components - (message-fetch-field "from")))) - (downcase (message-make-address))) - (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) - ;; Remove unwanted headers. - (when message-ignored-supersedes-headers - (message-remove-header message-ignored-supersedes-headers t)) - (goto-char (point-min)) - (if (not (re-search-forward "^Message-ID: " nil t)) - (error "No Message-ID in this article") - (replace-match "Supersedes: " t t)) - (goto-char (point-max)) - (insert mail-header-separator) - (widen) - (forward-line 1))) - -;;;###autoload -(defun message-recover () - "Reread contents of current buffer from its last auto-save file." - (interactive) - (let ((file-name (make-auto-save-file-name))) - (cond ((save-window-excursion - (if (not (eq system-type 'vax-vms)) - (with-output-to-temp-buffer "*Directory*" - (buffer-disable-undo standard-output) - (let ((default-directory "/")) - (call-process - "ls" nil standard-output nil "-l" file-name)))) - (yes-or-no-p (format "Recover auto save file %s? " file-name))) - (let ((buffer-read-only nil)) - (erase-buffer) - (insert-file-contents file-name nil))) - (t (error "message-recover cancelled"))))) - -;;; Forwarding messages. - -(defun message-make-forward-subject () - "Return a Subject header suitable for the message in the current buffer." - (save-excursion - (save-restriction - (current-buffer) - (message-narrow-to-head) - (concat "[" (or (message-fetch-field - (if (message-news-p) "newsgroups" "from")) - "(nowhere)") - "] " (or (message-fetch-field "Subject") ""))))) - -;;;###autoload -(defun message-forward (&optional news) - "Forward the current message via mail. -Optional NEWS will use news to forward instead of mail." - (interactive "P") - (let ((cur (current-buffer)) - (subject (message-make-forward-subject)) - art-beg) - (if news (message-news nil subject) (message-mail nil subject)) - ;; Put point where we want it before inserting the forwarded - ;; message. - (if message-signature-before-forwarded-message - (goto-char (point-max)) - (message-goto-body)) - ;; Make sure we're at the start of the line. - (unless (eolp) - (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) - (goto-char (point-max)) - (insert message-forward-end-separator) - (set-text-properties (point-min) (point-max) nil) - ;; Remove all unwanted headers. - (goto-char art-beg) - (narrow-to-region (point) (if (search-forward "\n\n" nil t) - (1- (point)) - (point))) - (goto-char (point-min)) - (message-remove-header message-included-forward-headers t nil t) - (widen) - (message-position-point))) - -;;;###autoload -(defun message-resend (address) - "Resend the current article to ADDRESS." - (interactive "sResend message to: ") - (message "Resending message to %s..." address) - (save-excursion - (let ((cur (current-buffer)) - beg) - ;; We first set up a normal mail buffer. - (set-buffer (get-buffer-create " *message resend*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - ;; avoid to turn-on-mime-edit - (let (message-setup-hook) - (message-setup `((To . ,address))) - ) - ;; Insert our usual headers. - (message-generate-headers '(From Date To)) - (message-narrow-to-headers) - ;; Rename them all to "Resent-*". - (while (re-search-forward "^[A-Za-z]" nil t) - (forward-char -1) - (insert "Resent-")) - (widen) - (forward-line) - (delete-region (point) (point-max)) - (setq beg (point)) - ;; Insert the message to be resent. - (insert-buffer-substring cur) - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (save-restriction - (narrow-to-region beg (point)) - (message-remove-header message-ignored-resent-headers t) - (goto-char (point-max))) - (insert mail-header-separator) - ;; Rename all old ("Also-")Resent headers. - (while (re-search-backward "^\\(Also-\\)?Resent-" beg t) - (beginning-of-line) - (insert "Also-")) - ;; Quote any "From " lines at the beginning. - (goto-char beg) - (when (looking-at "From ") - (replace-match "X-From-Line: ")) - ;; Send it. - (let ((message-encoding-buffer (current-buffer)) - (message-edit-buffer (current-buffer))) - (message-send-mail)) - (kill-buffer (current-buffer))) - (message "Resending message to %s...done" address))) - -;;;###autoload -(defun message-bounce () - "Re-mail the current message. -This only makes sense if the current message is a bounce message than -contains some mail you have written which has been bounced back to -you." - (interactive) - (let ((cur (current-buffer)) - boundary) - (message-pop-to-buffer (message-buffer-name "bounce")) - (insert-buffer-substring cur) - (undo-boundary) - (message-narrow-to-head) - (if (and (message-fetch-field "Mime-Version") - (setq boundary (message-fetch-field "Content-Type"))) - (if (string-match "boundary=\"\\([^\"]+\\)\"" boundary) - (setq boundary (concat (match-string 1 boundary) " *\n" - "Content-Type: message/rfc822")) - (setq boundary nil))) - (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))) - (save-restriction - (message-narrow-to-head) - (message-remove-header message-ignored-bounced-headers t) - (goto-char (point-max)) - (insert mail-header-separator)) - (message-position-point))) - -;;; -;;; Interactive entry points for new message buffers. -;;; - -;;;###autoload -(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))) - (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))) - -;;;###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))) - (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))) - -;;;###autoload -(defun message-news-other-window (&optional newsgroups subject) - "Start editing a news article to be sent." - (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 "news" nil newsgroups))) - (message-setup `((Newsgroups . ,(or newsgroups "")) - (Subject . ,(or subject ""))))) - -;;;###autoload -(defun message-news-other-frame (&optional newsgroups subject) - "Start editing a news article to be sent." - (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 "news" nil newsgroups))) - (message-setup `((Newsgroups . ,(or newsgroups "")) - (Subject . ,(or subject ""))))) - -;;; underline.el - -;; This code should be moved to underline.el (from which it is stolen). - -;;;###autoload -(defun bold-region (start end) - "Bold all nonblank characters in the region. -Works by overstriking characters. -Called from program, takes two arguments START and END -which specify the range to operate on." - (interactive "r") - (save-excursion - (let ((end1 (make-marker))) - (move-marker end1 (max start end)) - (goto-char (min start end)) - (while (< (point) end1) - (or (looking-at "[_\^@- ]") - (insert (following-char) "\b")) - (forward-char 1))))) - -;;;###autoload -(defun unbold-region (start end) - "Remove all boldness (overstruck characters) in the region. -Called from program, takes two arguments START and END -which specify the range to operate on." - (interactive "r") - (save-excursion - (let ((end1 (make-marker))) - (move-marker end1 (max start end)) - (goto-char (min start end)) - (while (re-search-forward "\b" end1 t) - (if (eq (following-char) (char-after (- (point) 2))) - (delete-char -2)))))) - -(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark) - -;; Support for toolbar -(when (string-match "XEmacs\\|Lucid" emacs-version) - (require 'messagexmas)) - -;;; Group name completion. - -(defvar message-newgroups-header-regexp - "^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):" - "Regexp that match headers that lists groups.") - -(defun message-tab () - "Expand group names in Newsgroups and Followup-To headers. -Do a `tab-to-tab-stop' if 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))) - -(defvar gnus-active-hashtb) -(defun message-expand-group () - "Expand the group name under point." - (let* ((b (save-excursion - (save-restriction - (narrow-to-region - (save-excursion - (beginning-of-line) - (skip-chars-forward "^:") - (1+ (point))) - (point)) - (skip-chars-backward "^, \t\n") (point)))) - (completion-ignore-case t) - (string (buffer-substring b (point))) - (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb)) - (completions (all-completions string hashtb)) - (cur (current-buffer)) - comp) - (delete-region b (point)) - (cond - ((= (length completions) 1) - (if (string= (car completions) string) - (progn - (insert string) - (message "Only matching group")) - (insert (car completions)))) - ((and (setq comp (try-completion string hashtb)) - (not (string= comp string))) - (insert comp)) - (t - (insert string) - (if (not comp) - (message "No matching groups") - (save-selected-window - (pop-to-buffer "*Completions*") - (buffer-disable-undo (current-buffer)) - (let ((buffer-read-only nil)) - (erase-buffer) - (let ((standard-output (current-buffer))) - (display-completion-list (sort completions 'string<))) - (goto-char (point-min)) - (delete-region (point) (progn (forward-line 3) (point)))))))))) - -;;; Help stuff. - -(defun message-talkative-question (ask question show &rest text) - "Call FUNCTION with argument QUESTION; optionally display TEXT... args. -If SHOW is non-nil, the arguments TEXT... are displayed in a temp buffer. -The following arguments may contain lists of values." - (if (and show - (setq text (message-flatten-list text))) - (save-window-excursion - (save-excursion - (with-output-to-temp-buffer " *MESSAGE information message*" - (set-buffer " *MESSAGE information message*") - (mapcar 'princ text) - (goto-char (point-min)))) - (funcall ask question)) - (funcall ask question))) - -(defun message-flatten-list (list) - "Return a new, flat list that contains all elements of LIST. - -\(message-flatten-list '(1 (2 3 (4 5 (6))) 7)) -=> (1 2 3 4 5 6 7)" - (cond ((consp list) - (apply 'append (mapcar 'message-flatten-list list))) - (list - (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. -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." - (let ((oldbuf (current-buffer))) - (save-excursion - (set-buffer (generate-new-buffer name)) - (message-clone-locals oldbuf) - (current-buffer)))) - -(defun message-clone-locals (buffer) - "Clone the local variables from BUFFER to the current buffer." - (let ((locals (save-excursion - (set-buffer buffer) - (buffer-local-variables))) - (regexp "^gnus\\|^nn\\|^message")) - (mapcar - (lambda (local) - (when (and (consp local) - (car local) - (string-match regexp (symbol-name (car local)))) - (ignore-errors - (set (make-local-variable (car local)) - (cdr local))))) - locals))) - - -;;; @ for MIME Edit mode -;;; - -(defun message-maybe-setup-default-charset () - (let ((charset - (and (boundp 'gnus-summary-buffer) - (buffer-live-p gnus-summary-buffer) - (save-excursion - (set-buffer gnus-summary-buffer) - default-mime-charset)))) - (if charset - (progn - (make-local-variable 'default-mime-charset) - (setq default-mime-charset charset) - )))) - -(defun message-maybe-encode () - (when message-mime-mode - (run-hooks 'mime-edit-translate-hook) - (if (catch 'mime-edit-error - (save-excursion - (mime-edit-translate-body) - )) - (error "Translation error!") - ) - (end-of-invisible) - (run-hooks 'mime-edit-exit-hook) - )) - -(defun message-mime-insert-article (&optional message) - (interactive) - (let ((message-cite-function 'mime-edit-inserted-message-filter) - (message-reply-buffer gnus-original-article-buffer) - ) - (message-yank-original nil) - )) - -(set-alist 'mime-edit-message-inserter-alist - 'message-mode (function message-mime-insert-article)) - -;;; Miscellaneous functions - -;; stolen (and renamed) from nnheader.el -(defun message-replace-chars-in-string (string from to) - "Replace characters in STRING from FROM to TO." - (let ((string (substring string 0)) ;Copy string. - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (when (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string)) - -(run-hooks 'message-load-hook) - -(provide 'message) - -;;; message.el ends here diff --git a/lisp/messagexmas.el b/lisp/messagexmas.el deleted file mode 100644 index 73f4cd4..0000000 --- a/lisp/messagexmas.el +++ /dev/null @@ -1,124 +0,0 @@ -;;; messagexmas.el --- XEmacs extensions to message -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: mail, news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) - -(defvar message-xmas-dont-activate-region t - "If t, don't activate region after yanking.") - -(defvar message-xmas-glyph-directory nil - "*Directory where Message logos and icons are located. -If this variable is nil, Message will try to locate the directory -automatically.") - -(defvar message-use-toolbar (if (featurep 'toolbar) - 'default-toolbar - nil) - "*If nil, do not use a toolbar. -If it is non-nil, it must be a toolbar. The five legal values are -`default-toolbar', `top-toolbar', `bottom-toolbar', -`right-toolbar', and `left-toolbar'.") - -(defvar message-toolbar - '([message-spell ispell-message t "Spell"] - [message-help (Info-goto-node "(Message)Top") t "Message help"]) - "The message buffer toolbar.") - -(defun message-xmas-find-glyph-directory (&optional package) - (setq package (or package "message")) - (let ((dir (symbol-value - (intern-soft (concat package "-xmas-glyph-directory"))))) - (if (and (stringp dir) (file-directory-p dir)) - dir - (nnheader-find-etc-directory package)))) - -(defun message-xmas-setup-toolbar (bar &optional force package) - (let ((dir (message-xmas-find-glyph-directory package)) - (xpm (if (featurep 'xpm) "xpm" "xbm")) - icon up down disabled name) - (unless package - (setq message-xmas-glyph-directory dir)) - (when dir - (while bar - (setq icon (aref (car bar) 0) - name (symbol-name icon) - bar (cdr bar)) - (when (or force - (not (boundp icon))) - (setq up (concat dir name "-up." xpm)) - (setq down (concat dir name "-down." xpm)) - (setq disabled (concat dir name "-disabled." xpm)) - (if (not (file-exists-p up)) - (setq bar nil - dir nil) - (set icon (toolbar-make-button-list - up (and (file-exists-p down) down) - (and (file-exists-p disabled) disabled))))))) - dir)) - -(defun message-setup-toolbar () - (and message-use-toolbar - (message-xmas-setup-toolbar message-toolbar) - (set-specifier (symbol-value message-use-toolbar) - (cons (current-buffer) message-toolbar)))) - -(defun message-xmas-exchange-point-and-mark () - "Exchange point and mark, but allow for XEmacs' optional argument." - (exchange-point-and-mark message-xmas-dont-activate-region)) - -(fset 'message-exchange-point-and-mark 'message-xmas-exchange-point-and-mark) - -(defun message-xmas-maybe-fontify () - (when (featurep 'font-lock) - (font-lock-set-defaults))) - -(defun message-xmas-make-caesar-translation-table (n) - "Create a rot table with offset N." - (let ((i -1) - (table (make-string 256 0)) - (a (char-int ?a)) - (A (char-int ?A))) - (while (< (incf i) 256) - (aset table i i)) - (concat - (substring table 0 A) - (substring table (+ A n) (+ A n (- 26 n))) - (substring table A (+ A n)) - (substring table (+ A 26) a) - (substring table (+ a n) (+ a n (- 26 n))) - (substring table a (+ a n)) - (substring table (+ a 26) 255)))) - -(when (>= emacs-major-version 20) - (fset 'message-make-caesar-translation-table - 'message-xmas-make-caesar-translation-table)) - -(add-hook 'message-mode-hook 'message-xmas-maybe-fontify) - -(provide 'messagexmas) - -;;; messagexmas.el ends here diff --git a/lisp/messcompat.el b/lisp/messcompat.el deleted file mode 100644 index d363700..0000000 --- a/lisp/messcompat.el +++ /dev/null @@ -1,87 +0,0 @@ -;;; messcompat.el --- making message mode compatible with mail mode -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: mail, news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This file tries to provide backward compatability with sendmail.el -;; for Message mode. It should be used by simply adding -;; -;; (require 'messcompat) -;; -;; to the .emacs file. Loading it after Message mode has been -;; loaded will have no effect. - -;;; Code: - -(require 'sendmail) - -(defvar message-from-style mail-from-style - "*Specifies how \"From\" headers look. - -If `nil', they contain just the return address like: - king@grassland.com -If `parens', they look like: - king@grassland.com (Elvis Parsley) -If `angles', they look like: - Elvis Parsley - -Otherwise, most addresses look like `angles', but they look like -`parens' if `angles' would need quoting and `parens' would not.") - -(defvar message-interactive mail-interactive - "Non-nil means when sending a message wait for and display errors. -nil means let mailer mail back a message to report errors.") - -(defvar message-setup-hook mail-setup-hook - "Normal hook, run each time a new outgoing message is initialized. -The function `message-setup' runs this hook.") - -(if (boundp 'mail-mode-hook) - (defvar message-mode-hook mail-mode-hook - "Hook run in message mode buffers.")) - -(defvar message-indentation-spaces mail-indentation-spaces - "*Number of spaces to insert at the beginning of each cited line. -Used by `message-yank-original' via `message-yank-cite'.") - -(defvar message-signature mail-signature - "*String to be inserted at the end of the message buffer. -If t, the `message-signature-file' file will be inserted instead. -If a function, the result from the function will be used instead. -If a form, the result from the form will be used instead.") - -;; Deleted the autoload cookie because this crashes in loaddefs.el. -(defvar message-signature-file mail-signature-file - "*File containing the text inserted at end of message. buffer.") - -(defvar message-default-headers mail-default-headers - "*A string containing header lines to be inserted in outgoing messages. -It is inserted before you edit the message, so you can edit or delete -these lines.") - -(defvar message-send-hook mail-send-hook - "Hook run before sending messages.") - -(provide 'messcompat) - -;;; messcompat.el ends here diff --git a/lisp/nnagent.el b/lisp/nnagent.el deleted file mode 100644 index 76d4390..0000000 --- a/lisp/nnagent.el +++ /dev/null @@ -1,122 +0,0 @@ -;;; nnagent.el --- offline backend for Gnus -;; Copyright (C) 1997,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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: - -;;; Code: - -(require 'nnheader) -(require 'nnoo) -(require 'cl) -(require 'gnus-agent) -(require 'nnml) - -(nnoo-declare nnagent - nnml) - - - -(defconst nnagent-version "nnagent 1.0") - -(defvoo nnagent-directory nil - "Internal variable." - nnml-directory) - -(defvoo nnagent-active-file nil - "Internal variable." - nnml-active-file) - -(defvoo nnagent-newsgroups-file nil - "Internal variable." - nnml-newsgroups-file) - -(defvoo nnagent-get-new-mail nil - "Internal variable." - nnml-get-new-mail) - -;;; Interface functions. - -(nnoo-define-basics nnagent) - -(deffoo nnagent-open-server (server &optional defs) - (setq defs - `((nnagent-directory ,(gnus-agent-directory)) - (nnagent-active-file ,(gnus-agent-lib-file "active")) - (nnagent-newsgroups-file ,(gnus-agent-lib-file "newsgroups")) - (nnagent-get-new-mail nil))) - (nnoo-change-server 'nnagent server defs) - (let ((dir (gnus-agent-directory)) - err) - (cond - ((not (condition-case arg - (file-exists-p dir) - (ftp-error (setq err (format "%s" arg))))) - (nnagent-close-server) - (nnheader-report - 'nnagent (or err "No such file or directory: %s" dir))) - ((not (file-directory-p (file-truename dir))) - (nnagent-close-server) - (nnheader-report 'nnagent "Not a directory: %s" dir)) - (t - (nnheader-report 'nnagent "Opened server %s using directory %s" - server dir) - t)))) - -(deffoo nnagent-retrieve-groups (groups &optional server) - (save-excursion - (cond - ((file-exists-p (gnus-agent-lib-file "groups")) - (nnmail-find-file (gnus-agent-lib-file "groups")) - 'groups) - ((file-exists-p (gnus-agent-lib-file "active")) - (nnmail-find-file (gnus-agent-lib-file "active")) - 'active) - (t nil)))) - -(defun nnagent-request-type (group article) - (let ((gnus-plugged t)) - (if (not (gnus-check-backend-function - 'request-type (car gnus-command-method))) - 'unknown - (funcall (gnus-get-function gnus-command-method 'request-type) - (gnus-group-real-name group) article)))) - -(deffoo nnagent-request-newgroups (date server) - nil) - -(deffoo nnagent-request-update-info (group info &optional server) - nil) - -(deffoo nnagent-request-post (&optional server) - (gnus-request-accept-article "nndraft:queue")) - -;; Use nnml functions for just about everything. -(nnoo-import nnagent - (nnml)) - - -;;; Internal functions. - -(provide 'nnagent) - -;;; nnagent.el ends here diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el deleted file mode 100644 index 34f3c2c..0000000 --- a/lisp/nnbabyl.el +++ /dev/null @@ -1,652 +0,0 @@ -;;; nnbabyl.el --- rmail mbox access for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; 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: - -;; For an overview of what the interface functions do, please see the -;; Gnus sources. - -;;; Code: - -(require 'nnheader) -(condition-case nil - (require 'rmail) - (t (message "Ignore rmail errors from this file, you don't have rmail"))) -(require 'nnmail) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnbabyl) - -(defvoo nnbabyl-mbox-file (expand-file-name "~/RMAIL") - "The name of the rmail box file in the users home directory.") - -(defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active") - "The name of the active file for the rmail box.") - -(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.") - - - -(defvar nnbabyl-mail-delimiter "\^_") - -(defconst nnbabyl-version "nnbabyl 1.0" - "nnbabyl version.") - -(defvoo nnbabyl-mbox-buffer nil) -(defvoo nnbabyl-current-group nil) -(defvoo nnbabyl-status-string "") -(defvoo nnbabyl-group-alist nil) -(defvoo nnbabyl-active-timestamp nil) - -(defvoo nnbabyl-previous-buffer-mode nil) - -(eval-and-compile - (autoload 'gnus-set-text-properties "gnus-ems")) - - - -;;; Interface functions - -(nnoo-define-basics nnbabyl) - -(deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((number (length articles)) - (count 0) - (delim (concat "^" nnbabyl-mail-delimiter)) - article art-string start stop) - (nnbabyl-possibly-change-newsgroup group server) - (while (setq article (pop articles)) - (setq art-string (nnbabyl-article-string article)) - (set-buffer nnbabyl-mbox-buffer) - (end-of-line) - (when (or (search-forward art-string nil t) - (search-backward art-string nil t)) - (unless (re-search-backward delim nil t) - (goto-char (point-min))) - (while (and (not (looking-at ".+:")) - (zerop (forward-line 1)))) - (setq start (point)) - (search-forward "\n\n" nil t) - (setq stop (1- (point))) - (set-buffer nntp-server-buffer) - (insert "221 ") - (princ article (current-buffer)) - (insert " Article retrieved.\n") - (insert-buffer-substring nnbabyl-mbox-buffer start stop) - (goto-char (point-max)) - (insert ".\n")) - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (zerop (% (incf count) 20)) - (nnheader-message 5 "nnbabyl: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (nnheader-message 5 "nnbabyl: Receiving headers...done")) - - (set-buffer nntp-server-buffer) - (nnheader-fold-continuation-lines) - 'headers))) - -(deffoo nnbabyl-open-server (server &optional defs) - (nnoo-change-server 'nnbabyl server defs) - (nnbabyl-create-mbox) - (cond - ((not (file-exists-p nnbabyl-mbox-file)) - (nnbabyl-close-server) - (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file)) - ((file-directory-p nnbabyl-mbox-file) - (nnbabyl-close-server) - (nnheader-report 'nnbabyl "Not a regular file: %s" nnbabyl-mbox-file)) - (t - (nnheader-report 'nnbabyl "Opened server %s using mbox %s" server - nnbabyl-mbox-file) - t))) - -(deffoo nnbabyl-close-server (&optional server) - ;; Restore buffer mode. - (when (and (nnbabyl-server-opened) - nnbabyl-previous-buffer-mode) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (narrow-to-region - (caar nnbabyl-previous-buffer-mode) - (cdar nnbabyl-previous-buffer-mode)) - (funcall (cdr nnbabyl-previous-buffer-mode)))) - (nnoo-close-server 'nnbabyl server) - (setq nnbabyl-mbox-buffer nil) - t) - -(deffoo nnbabyl-server-opened (&optional server) - (and (nnoo-current-server-p 'nnbabyl server) - nnbabyl-mbox-buffer - (buffer-name nnbabyl-mbox-buffer) - nntp-server-buffer - (buffer-name nntp-server-buffer))) - -(deffoo nnbabyl-request-article (article &optional newsgroup server buffer) - (nnbabyl-possibly-change-newsgroup newsgroup server) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (when (search-forward (nnbabyl-article-string article) nil t) - (let (start stop summary-line) - (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) - (goto-char (point-min)) - (end-of-line)) - (while (and (not (looking-at ".+:")) - (zerop (forward-line 1)))) - (setq start (point)) - (or (when (re-search-forward - (concat "^" nnbabyl-mail-delimiter) nil t) - (beginning-of-line) - t) - (goto-char (point-max))) - (setq stop (point)) - (let ((nntp-server-buffer (or buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring nnbabyl-mbox-buffer start stop) - (goto-char (point-min)) - ;; If there is an EOOH header, then we have to remove some - ;; duplicated headers. - (setq summary-line (looking-at "Summary-line:")) - (when (search-forward "\n*** EOOH ***" nil t) - (if summary-line - ;; The headers to be deleted are located before the - ;; EOOH line... - (delete-region (point-min) (progn (forward-line 1) - (point))) - ;; ...or after. - (delete-region (progn (beginning-of-line) (point)) - (or (search-forward "\n\n" nil t) - (point))))) - (if (numberp article) - (cons nnbabyl-current-group article) - (nnbabyl-article-group-number))))))) - -(deffoo nnbabyl-request-group (group &optional server dont-check) - (let ((active (cadr (assoc group nnbabyl-group-alist)))) - (save-excursion - (cond - ((or (null active) - (null (nnbabyl-possibly-change-newsgroup group server))) - (nnheader-report 'nnbabyl "No such group: %s" group)) - (dont-check - (nnheader-report 'nnbabyl "Selected group %s" group) - (nnheader-insert "")) - (t - (nnheader-report 'nnbabyl "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" - (1+ (- (cdr active) (car active))) - (car active) (cdr active) group)))))) - -(deffoo nnbabyl-request-scan (&optional group server) - (nnbabyl-possibly-change-newsgroup group server) - (nnbabyl-read-mbox) - (nnmail-get-new-mail - 'nnbabyl - (lambda () - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (save-buffer))) - (file-name-directory nnbabyl-mbox-file) - group - (lambda () - (save-excursion - (let ((in-buf (current-buffer))) - (goto-char (point-min)) - (while (search-forward "\n\^_\n" nil t) - (delete-char -1)) - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-max)) - (search-backward "\n\^_" nil t) - (goto-char (match-end 0)) - (insert-buffer-substring in-buf))) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))) - -(deffoo nnbabyl-close-group (group &optional server) - t) - -(deffoo nnbabyl-request-create-group (group &optional server args) - (nnmail-activate 'nnbabyl) - (unless (assoc group nnbabyl-group-alist) - (push (list group (cons 1 0)) - nnbabyl-group-alist) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) - t) - -(deffoo nnbabyl-request-list (&optional server) - (save-excursion - (nnmail-find-file nnbabyl-active-file) - (setq nnbabyl-group-alist (nnmail-get-active)) - t)) - -(deffoo nnbabyl-request-newgroups (date &optional server) - (nnbabyl-request-list server)) - -(deffoo nnbabyl-request-list-newsgroups (&optional server) - (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented.")) - -(deffoo nnbabyl-request-expire-articles - (articles newsgroup &optional server force) - (nnbabyl-possibly-change-newsgroup newsgroup server) - (let* ((is-old t) - rest) - (nnmail-activate 'nnbabyl) - - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (gnus-set-text-properties (point-min) (point-max) nil) - (while (and articles is-old) - (goto-char (point-min)) - (when (search-forward (nnbabyl-article-string (car articles)) nil t) - (if (setq is-old - (nnmail-expired-article-p - newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) force)) - (progn - (nnheader-message 5 "Deleting article %d in %s..." - (car articles) newsgroup) - (nnbabyl-delete-mail)) - (push (car articles) rest))) - (setq articles (cdr articles))) - (save-buffer) - ;; Find the lowest active article in this group. - (let ((active (nth 1 (assoc newsgroup nnbabyl-group-alist)))) - (goto-char (point-min)) - (while (and (not (search-forward - (nnbabyl-article-string (car active)) nil t)) - (<= (car active) (cdr active))) - (setcar active (1+ (car active))) - (goto-char (point-min)))) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - (nconc rest articles)))) - -(deffoo nnbabyl-request-move-article - (article group server accept-form &optional last) - (let ((buf (get-buffer-create " *nnbabyl move*")) - result) - (and - (nnbabyl-request-article article group server) - (save-excursion - (set-buffer buf) - (insert-buffer-substring nntp-server-buffer) - (goto-char (point-min)) - (while (re-search-forward - "^X-Gnus-Newsgroup:" - (save-excursion (search-forward "\n\n" nil t) (point)) t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (save-excursion - (nnbabyl-possibly-change-newsgroup group server) - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (if (search-forward (nnbabyl-article-string article) nil t) - (nnbabyl-delete-mail)) - (and last (save-buffer)))) - result)) - -(deffoo nnbabyl-request-accept-article (group &optional server last) - (nnbabyl-possibly-change-newsgroup group server) - (nnmail-check-syntax) - (let ((buf (current-buffer)) - result beg) - (and - (nnmail-activate 'nnbabyl) - (save-excursion - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-line -1) - (save-excursion - (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"))) - (setq result - (if (stringp group) - (list (cons group (nnbabyl-active-number group))) - (nnmail-article-group 'nnbabyl-active-number))) - (if (and (null result) - (yes-or-no-p "Moved to `junk' group; delete article? ")) - (setq result 'junk) - (setq result (car (nnbabyl-save-mail result)))) - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-max)) - (search-backward "\n\^_") - (goto-char (match-end 0)) - (insert-buffer-substring buf) - (when last - (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) - (save-buffer) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) - result)))) - -(deffoo nnbabyl-request-replace-article (article group buffer) - (nnbabyl-possibly-change-newsgroup group) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (if (not (search-forward (nnbabyl-article-string article) nil t)) - nil - (nnbabyl-delete-mail t t) - (insert-buffer-substring buffer) - (save-buffer) - t))) - -(deffoo nnbabyl-request-delete-group (group &optional force server) - (nnbabyl-possibly-change-newsgroup group server) - ;; Delete all articles in GROUP. - (if (not force) - () ; Don't delete the articles. - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - ;; Delete all articles in this group. - (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":")) - found) - (while (search-forward ident nil t) - (setq found t) - (nnbabyl-delete-mail)) - (when found - (save-buffer))))) - ;; Remove the group from all structures. - (setq nnbabyl-group-alist - (delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist) - nnbabyl-current-group nil) - ;; Save the active file. - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - t) - -(deffoo nnbabyl-request-rename-group (group new-name &optional server) - (nnbabyl-possibly-change-newsgroup group server) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":")) - (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":")) - found) - (while (search-forward ident nil t) - (replace-match new-ident t t) - (setq found t)) - (when found - (save-buffer)))) - (let ((entry (assoc group nnbabyl-group-alist))) - (and entry (setcar entry new-name)) - (setq nnbabyl-current-group nil) - ;; Save the new group alist. - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - t)) - - -;;; Internal functions. - -;; If FORCE, delete article no matter how many X-Gnus-Newsgroup -;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox -;; delimiter line. -(defun nnbabyl-delete-mail (&optional force leave-delim) - ;; Delete the current X-Gnus-Newsgroup line. - (unless force - (delete-region - (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - ;; Beginning of the article. - (save-excursion - (save-restriction - (widen) - (narrow-to-region - (save-excursion - (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) - (goto-char (point-min)) - (end-of-line)) - (if leave-delim (progn (forward-line 1) (point)) - (match-beginning 0))) - (progn - (forward-line 1) - (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter) - nil t) - (match-beginning 0)) - (point-max)))) - (goto-char (point-min)) - ;; Only delete the article if no other groups owns it as well. - (when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) - (delete-region (point-min) (point-max)))))) - -(defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server) - (when (and server - (not (nnbabyl-server-opened server))) - (nnbabyl-open-server server)) - (when (or (not nnbabyl-mbox-buffer) - (not (buffer-name nnbabyl-mbox-buffer))) - (save-excursion (nnbabyl-read-mbox))) - (unless nnbabyl-group-alist - (nnmail-activate 'nnbabyl)) - (if newsgroup - (if (assoc newsgroup nnbabyl-group-alist) - (setq nnbabyl-current-group newsgroup) - (nnheader-report 'nnbabyl "No such group in file")) - t)) - -(defun nnbabyl-article-string (article) - (if (numberp article) - (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" - (int-to-string article) " ") - (concat "\nMessage-ID: " article))) - -(defun nnbabyl-article-group-number () - (save-excursion - (goto-char (point-min)) - (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " - nil t) - (cons (buffer-substring (match-beginning 1) (match-end 1)) - (string-to-int - (buffer-substring (match-beginning 2) (match-end 2))))))) - -(defun nnbabyl-insert-lines () - "Insert how many lines and chars there are in the body of the mail." - (let (lines chars) - (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - ;; There may be an EOOH line here... - (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*") - (search-forward "\n\n" nil t)) - (setq chars (- (point-max) (point)) - lines (max (- (count-lines (point) (point-max)) 1) 0)) - ;; Move back to the end of the headers. - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-char -1) - (save-excursion - (when (re-search-backward "^Lines: " nil t) - (delete-region (point) (progn (forward-line 1) (point))))) - (insert (format "Lines: %d\n" lines)) - chars)))) - -(defun nnbabyl-save-mail (group-art) - ;; Called narrowed to an article. - (nnbabyl-insert-lines) - (nnmail-insert-xref group-art) - (nnbabyl-insert-newsgroup-line group-art) - (gnus-run-hooks 'nnbabyl-prepare-save-mail-hook) - group-art) - -(defun nnbabyl-insert-newsgroup-line (group-art) - (save-excursion - (goto-char (point-min)) - (while (looking-at "From ") - (replace-match "Mail-from: From " t t) - (forward-line 1)) - ;; If there is a C-l at the beginning of the narrowed region, this - ;; isn't really a "save", but rather a "scan". - (goto-char (point-min)) - (unless (looking-at "\^L") - (save-excursion - (insert "\^L\n0, unseen,,\n*** EOOH ***\n") - (goto-char (point-max)) - (insert "\^_\n"))) - (when (search-forward "\n\n" nil t) - (forward-char -1) - (while group-art - (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" - (caar group-art) (cdar group-art) - (current-time-string))) - (setq group-art (cdr group-art)))) - t)) - -(defun nnbabyl-active-number (group) - ;; Find the next article number in GROUP. - (let ((active (cadr (assoc group nnbabyl-group-alist)))) - (if active - (setcdr active (1+ (cdr active))) - ;; This group is new, so we create a new entry for it. - ;; This might be a bit naughty... creating groups on the drop of - ;; a hat, but I don't know... - (push (list group (setq active (cons 1 1))) - nnbabyl-group-alist)) - (cdr active))) - -(defun nnbabyl-create-mbox () - (unless (file-exists-p nnbabyl-mbox-file) - ;; Create a new, empty RMAIL mbox file. - (save-excursion - (set-buffer (setq nnbabyl-mbox-buffer - (create-file-buffer nnbabyl-mbox-file))) - (setq buffer-file-name nnbabyl-mbox-file) - (insert "BABYL OPTIONS:\n\n\^_") - (nnmail-write-region - (point-min) (point-max) nnbabyl-mbox-file t 'nomesg)))) - -(defun nnbabyl-read-mbox () - (nnmail-activate 'nnbabyl) - (nnbabyl-create-mbox) - - (unless (and nnbabyl-mbox-buffer - (buffer-name nnbabyl-mbox-buffer) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file)))) - ;; This buffer has changed since we read it last. Possibly. - (save-excursion - (let ((delim (concat "^" nnbabyl-mail-delimiter)) - (alist nnbabyl-group-alist) - start end number) - (set-buffer (setq nnbabyl-mbox-buffer - (nnheader-find-file-noselect - nnbabyl-mbox-file nil 'raw))) - ;; Save previous buffer mode. - (setq nnbabyl-previous-buffer-mode - (cons (cons (point-min) (point-max)) - major-mode)) - - (buffer-disable-undo (current-buffer)) - (widen) - (setq buffer-read-only nil) - (fundamental-mode) - - ;; Go through the group alist and compare against - ;; the rmail file. - (while alist - (goto-char (point-max)) - (when (and (re-search-backward - (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) " - (caar alist)) - nil t) - (> (setq number - (string-to-number - (buffer-substring - (match-beginning 1) (match-end 1)))) - (cdadar alist))) - (setcdr (cadar alist) number)) - (setq alist (cdr alist))) - - ;; We go through the mbox and make sure that each and - ;; every mail belongs to some group or other. - (goto-char (point-min)) - (if (looking-at "\^L") - (setq start (point)) - (re-search-forward delim nil t) - (setq start (match-end 0))) - (while (re-search-forward delim nil t) - (setq end (match-end 0)) - (unless (search-backward "\nX-Gnus-Newsgroup: " start t) - (goto-char end) - (save-excursion - (save-restriction - (narrow-to-region (goto-char start) end) - (nnbabyl-save-mail - (nnmail-article-group 'nnbabyl-active-number)) - (setq end (point-max))))) - (goto-char (setq start end))) - (when (buffer-modified-p (current-buffer)) - (save-buffer)) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))) - -(defun nnbabyl-remove-incoming-delims () - (goto-char (point-min)) - (while (search-forward "\^_" nil t) - (replace-match "?" t t))) - -(defun nnbabyl-check-mbox () - "Go through the nnbabyl mbox and make sure that no article numbers are reused." - (interactive) - (let ((idents (make-vector 1000 0)) - id) - (save-excursion - (when (or (not nnbabyl-mbox-buffer) - (not (buffer-name nnbabyl-mbox-buffer))) - (nnbabyl-read-mbox)) - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (while (re-search-forward "^X-Gnus-Newsgroup: \\([^ ]+\\) " nil t) - (if (intern-soft (setq id (match-string 1)) idents) - (progn - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))) - (nnheader-message 7 "Moving %s..." id) - (nnbabyl-save-mail - (nnmail-article-group 'nnbabyl-active-number))) - (intern id idents))) - (when (buffer-modified-p (current-buffer)) - (save-buffer)) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - (message "")))) - -(provide 'nnbabyl) - -;;; nnbabyl.el ends here diff --git a/lisp/nndb.el b/lisp/nndb.el deleted file mode 100644 index 088b5c6..0000000 --- a/lisp/nndb.el +++ /dev/null @@ -1,332 +0,0 @@ -;;; nndb.el --- nndb access for Gnus -;; Copyright (C) 1997,98 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Kai Grossjohann -;; Joe Hildebrand -;; David Blacka -;; Keywords: news - -;; This file is NOT 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 was based upon Kai Grossjohan's shamessly snarfed code and -;;; further modified by Joe Hildebrand. It has been updated for Red -;;; Gnus. - -;; TODO: -;; -;; * Fix bug where server connection can be lost and impossible to regain -;; This hasn't happened to me in a while; think it was fixed in Rgnus -;; -;; * make it handle different nndb servers seemlessly -;; -;; * Optimize expire if FORCE -;; -;; * Optimize move (only expire once) -;; -;; * Deal with add/deletion of groups -;; -;; * make the backend TOUCH an article when marked as expireable (will -;; make article expire 'expiry' days after that moment). - -;;- -;; Register nndb with known select methods. - -(gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address) - -;;; Code: - -(require 'nnmail) -(require 'nnheader) -(require 'nntp) -(eval-when-compile (require 'cl)) - -(eval-and-compile - (unless (fboundp 'open-network-stream) - (require 'tcp))) - -(eval-when-compile (require 'cl)) - -(eval-and-compile - (autoload 'news-setup "rnewspost") - (autoload 'news-reply-mode "rnewspost") - (autoload 'cancel-timer "timer") - (autoload 'telnet "telnet" nil t) - (autoload 'telnet-send-input "telnet" nil t) - (autoload 'timezone-parse-date "timezone")) - -;; Declare nndb as derived from nntp - -(nnoo-declare nndb nntp) - -;; Variables specific to nndb - -;;- currently not used but just in case... -(defvoo nndb-deliver-program "nndel" - "*The program used to put a message in an NNDB group.") - -(defvoo nndb-server-side-expiry nil - "If t, expiry calculation will occur on the server side") - -(defvoo nndb-set-expire-date-on-mark nil - "If t, the expiry date for a given article will be set to the time -it was marked as expireable; otherwise the date will be the time the -article was posted to nndb") - -;; Variables copied from nntp - -(defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file) - "Like nntp-server-opened-hook." - nntp-server-opened-hook) - -(defvoo nndb-address "localhost" - "*The name of the NNDB server." - nntp-address) - -(defvoo nndb-port-number 9000 - "*Port number to connect to." - nntp-port-number) - -;; change to 'news if you are actually using nndb for news -(defvoo nndb-article-type 'mail) - -(defvoo nndb-status-string nil "" nntp-status-string) - - - -(defconst nndb-version "nndb 0.7" - "Version numbers of this version of NNDB.") - - -;;; Interface functions. - -(nnoo-define-basics nndb) - -;;------------------------------------------------------------------ - -;; this function turns the lisp list into a string list. There is -;; probably a more efficient way to do this. -(defun nndb-build-article-string (articles) - (let (art-string art) - (while articles - (setq art (pop articles)) - (setq art-string (concat art-string art " "))) - art-string)) - -(defun nndb-build-expire-rest-list (total expire) - (let (art rest) - (while total - (setq art (pop total)) - (if (memq art expire) - () - (push art rest))) - rest)) - - -;; -(deffoo nndb-request-type (group &optional article) - nndb-article-type) - -;; nndb-request-update-info does not exist and is not needed - -;; nndb-request-update-mark does not exist; it should be used to TOUCH -;; articles as they are marked exipirable -(defun nndb-touch-article (group article) - (nntp-send-command nil "X-TOUCH" article)) - -(deffoo nndb-request-update-mark - (group article mark) - "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'" - (if (and nndb-set-expire-date-on-mark (string-equal mark "E")) - (nndb-touch-article group article)) - mark) - -;; nndb-request-create-group -- currently this isn't necessary; nndb -;; creates groups on demand. - -;; todo -- use some other time than the creation time of the article -;; best is time since article has been marked as expirable - -(defun nndb-request-expire-articles-local - (articles &optional group server force) - "Let gnus do the date check and issue the delete commands." - (let (msg art delete-list (num-delete 0) rest) - (nntp-possibly-change-group group server) - (while articles - (setq art (pop articles)) - (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)) - (if (nnmail-expired-article-p - group - (gnus-encode-date - (substring msg (match-beginning 1) (match-end 1))) - force) - (progn - (setq delete-list (concat delete-list " " (int-to-string art))) - (setq num-delete (1+ num-delete))) - (push art rest)))) - (if (> (length delete-list) 0) - (progn - (nnheader-message 5 "Deleting %s article(s) from %s" - (int-to-string num-delete) group) - (nntp-send-command "^[23].*\n" "X-DELETE" delete-list)) - ) - - (message "") - (nconc rest articles))) - -(defun nndb-get-remote-expire-response () - (let (list) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (if (looking-at "^[34]") - ;; x-expire returned error--presume no articles were expirable) - (setq list nil) - ;; otherwise, pull all of the following numbers into the list - (re-search-forward "follows\r?\n?" nil t) - (while (re-search-forward "^[0-9]+$" nil t) - (push (string-to-int (match-string 0)) list))) - list)) - -(defun nndb-request-expire-articles-remote - (articles &optional group server force) - "Let the nndb backend expire articles" - (let (days art-string delete-list (num-delete 0)) - (nntp-possibly-change-group group server) - - ;; first calculate the wait period in days - (setq days (or (and nnmail-expiry-wait-function - (funcall nnmail-expiry-wait-function group)) - nnmail-expiry-wait)) - ;; now handle the special cases - (cond (force - (setq days 0)) - ((eq days 'never) - ;; This isn't an expirable group. - (setq days -1)) - ((eq days 'immediate) - (setq days 0))) - - - ;; build article string - (setq art-string (concat days " " (nndb-build-article-string articles))) - (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string) - - (setq delete-list (nndb-get-remote-expire-response)) - (setq num-delete (length delete-list)) - (if (> num-delete 0) - (nnheader-message 5 "Deleting %s article(s) from %s" - (int-to-string num-delete) group)) - - (nndb-build-expire-rest-list articles delete-list))) - -(deffoo nndb-request-expire-articles - (articles &optional group server force) - "Expires ARTICLES from GROUP on SERVER. -If FORCE, delete regardless of exiration date, otherwise use normal -expiry mechanism." - (if nndb-server-side-expiry - (nndb-request-expire-articles-remote articles group server force) - (nndb-request-expire-articles-local articles group server force))) - -(deffoo nndb-request-move-article - (article group server accept-form &optional last) - "Move ARTICLE (a number) from GROUP on SERVER. -Evals ACCEPT-FORM in current buffer, where the article is. -Optional LAST is ignored." - ;; we guess that the second arg in accept-form is the new group, - ;; which it will be for nndb, which is all that matters anyway - (let ((new-group (nth 1 accept-form)) result) - (nntp-possibly-change-group group server) - - ;; use the move command for nndb-to-nndb moves - (if (string-match "^nndb" new-group) - (let ((new-group-name (gnus-group-real-name new-group))) - (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name) - (cons new-group article)) - ;; else move normally - (let ((artbuf (get-buffer-create " *nndb move*"))) - (and - (nndb-request-article article group server artbuf) - (save-excursion - (set-buffer artbuf) - (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (nndb-request-expire-articles (list article) - group - server - t)) - result) - ))) - -(deffoo nndb-request-accept-article (group server &optional last) - "The article in the current buffer is put into GROUP." - (nntp-possibly-change-group group server) - (let (art msg) - (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group) - (nnheader-insert "") - (nntp-send-buffer "^[23].*\n")) - - (set-buffer nntp-server-buffer) - (setq msg (buffer-string (point-min) (point-max))) - (or (string-match "^\\([0-9]+\\)" msg) - (error "nndb: %s" msg)) - (setq art (substring msg (match-beginning 1) (match-end 1))) - (message "nndb: accepted %s" art) - (list art))) - -(deffoo nndb-request-replace-article (article group buffer) - "ARTICLE is the number of the article in GROUP to be replaced -with the contents of the BUFFER." - (set-buffer buffer) - (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article)) - (nnheader-insert "") - (nntp-send-buffer "^[23.*\n") - (list (int-to-string article)))) - -; nndb-request-delete-group does not exist -; todo -- maybe later - -; nndb-request-rename-group does not exist -; todo -- maybe later - -;; -- standard compatability functions - -(deffoo nndb-status-message (&optional server) - "Return server status as a string." - (set-buffer nntp-server-buffer) - (buffer-string (point-min) (point-max))) - -;; Import stuff from nntp - -(nnoo-import nndb - (nntp)) - -(provide 'nndb) - - - diff --git a/lisp/nndir.el b/lisp/nndir.el deleted file mode 100644 index 968637d..0000000 --- a/lisp/nndir.el +++ /dev/null @@ -1,99 +0,0 @@ -;;; nndir.el --- single directory newsgroup access for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnmh) -(require 'nnml) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nndir - nnml nnmh) - -(defvoo nndir-directory nil - "Where nndir will look for groups." - nnml-current-directory nnmh-current-directory) - -(defvoo nndir-nov-is-evil nil - "*Non-nil means that nndir will never retrieve NOV headers." - nnml-nov-is-evil) - - - -(defvoo nndir-current-group "" nil nnml-current-group nnmh-current-group) -(defvoo nndir-top-directory nil nil nnml-directory nnmh-directory) -(defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail) - -(defvoo nndir-status-string "" nil nnmh-status-string) -(defconst nndir-version "nndir 1.0") - - - -;;; Interface functions. - -(nnoo-define-basics nndir) - -(deffoo nndir-open-server (server &optional defs) - (setq nndir-directory - (or (cadr (assq 'nndir-directory defs)) - server)) - (unless (assq 'nndir-directory defs) - (push `(nndir-directory ,server) defs)) - (push `(nndir-current-group - ,(file-name-nondirectory (directory-file-name nndir-directory))) - defs) - (push `(nndir-top-directory - ,(file-name-directory (directory-file-name nndir-directory))) - defs) - (nnoo-change-server 'nndir server defs) - (let (err) - (cond - ((not (condition-case arg - (file-exists-p nndir-directory) - (ftp-error (setq err (format "%s" arg))))) - (nndir-close-server) - (nnheader-report - 'nndir (or err "No such file or directory: %s" nndir-directory))) - ((not (file-directory-p (file-truename nndir-directory))) - (nndir-close-server) - (nnheader-report 'nndir "Not a directory: %s" nndir-directory)) - (t - (nnheader-report 'nndir "Opened server %s using directory %s" - server nndir-directory) - t)))) - -(nnoo-map-functions nndir - (nnml-retrieve-headers 0 nndir-current-group 0 0) - (nnmh-request-article 0 nndir-current-group 0 0) - (nnmh-request-group nndir-current-group 0 0) - (nnml-close-group nndir-current-group 0) - (nnmh-request-list (nnoo-current-server 'nndir) nndir-directory) - (nnmh-request-newsgroups (nnoo-current-server 'nndir) nndir-directory)) - -(provide 'nndir) - -;;; nndir.el ends here diff --git a/lisp/nndoc.el b/lisp/nndoc.el deleted file mode 100644 index e823ead..0000000 --- a/lisp/nndoc.el +++ /dev/null @@ -1,634 +0,0 @@ -;;; nndoc.el --- single file access for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'message) -(require 'nnmail) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nndoc) - -(defvoo nndoc-article-type 'guess - "*Type of the file. -One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', -`rfc934', `rfc822-forward', `mime-digest', `standard-digest', -`slack-digest', `clari-briefs' or `guess'.") - -(defvoo nndoc-post-type 'mail - "*Whether the nndoc group is `mail' or `post'.") - -(defvoo nndoc-open-document-hook 'nnheader-ms-strip-cr - "Hook run after opening a document. -The default function removes all trailing carriage returns -from the document.") - -(defvar nndoc-type-alist - `((mmdf - (article-begin . "^\^A\^A\^A\^A\n") - (body-end . "^\^A\^A\^A\^A\n")) - (news - (article-begin . "^Path:")) - (rnews - (article-begin . "^#! *rnews +\\([0-9]+\\) *\n") - (body-end-function . nndoc-rnews-body-end)) - (mbox - (article-begin-function . nndoc-mbox-article-begin) - (body-end-function . nndoc-mbox-body-end)) - (babyl - (article-begin . "\^_\^L *\n") - (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)) - (rfc934 - (article-begin . "^--.*\n+") - (body-end . "^--.*$") - (prepare-body-function . nndoc-unquote-dashes)) - (clari-briefs - (article-begin . "^ \\*") - (body-end . "^\t------*[ \t]^*\n^ \\*") - (body-begin . "^\t") - (head-end . "^\t") - (generate-head-function . nndoc-generate-clari-briefs-head) - (article-transform-function . nndoc-transform-clari-briefs)) - (mime-digest - (article-begin . "") - (head-end . "^ ?$") - (body-end . "") - (file-end . "") - (subtype digest guess)) - (standard-digest - (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+")) - (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n\n+")) - (prepare-body-function . nndoc-unquote-dashes) - (body-end-function . nndoc-digest-body-end) - (head-end . "^ *$") - (body-begin . "^ *\n") - (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$") - (subtype digest guess)) - (slack-digest - (article-begin . "^------------------------------*[\n \t]+") - (head-end . "^ ?$") - (body-end-function . nndoc-digest-body-end) - (body-begin . "^ ?$") - (file-end . "^End of") - (prepare-body-function . nndoc-unquote-dashes) - (subtype digest guess)) - (lanl-gov-announce - (article-begin . "^\\\\\\\\\n") - (head-begin . "^Paper.*:") - (head-end . "\\(^\\\\\\\\.*\n\\|-----------------\\)") - (body-begin . "") - (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)) - (rfc822-forward - (article-begin . "^\n") - (body-end-function . nndoc-rfc822-forward-body-end-function)) - (guess - (guess . t) - (subtype nil)) - (digest - (guess . t) - (subtype nil)) - (preprints - (guess . t) - (subtype nil)))) - - - -(defvoo nndoc-file-begin nil) -(defvoo nndoc-first-article nil) -(defvoo nndoc-article-end nil) -(defvoo nndoc-article-begin nil) -(defvoo nndoc-head-begin nil) -(defvoo nndoc-head-end nil) -(defvoo nndoc-file-end nil) -(defvoo nndoc-body-begin nil) -(defvoo nndoc-body-end-function nil) -(defvoo nndoc-body-begin-function nil) -(defvoo nndoc-head-begin-function nil) -(defvoo nndoc-body-end nil) -(defvoo nndoc-dissection-alist nil) -(defvoo nndoc-prepare-body-function nil) -(defvoo nndoc-generate-head-function nil) -(defvoo nndoc-article-transform-function nil) -(defvoo nndoc-article-begin-function nil) - -(defvoo nndoc-status-string "") -(defvoo nndoc-group-alist nil) -(defvoo nndoc-current-buffer nil - "Current nndoc news buffer.") -(defvoo nndoc-address nil) - -(defconst nndoc-version "nndoc 1.0" - "nndoc version.") - - - -;;; Interface functions - -(nnoo-define-basics nndoc) - -(deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old) - (when (nndoc-possibly-change-buffer newsgroup server) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let (article entry) - (if (stringp (car articles)) - 'headers - (while articles - (when (setq entry (cdr (assq (setq article (pop articles)) - nndoc-dissection-alist))) - (insert (format "221 %d Article retrieved.\n" article)) - (if nndoc-generate-head-function - (funcall nndoc-generate-head-function article) - (insert-buffer-substring - nndoc-current-buffer (car entry) (nth 1 entry))) - (goto-char (point-max)) - (unless (= (char-after (1- (point))) ?\n) - (insert "\n")) - (insert (format "Lines: %d\n" (nth 4 entry))) - (insert ".\n"))) - - (nnheader-fold-continuation-lines) - 'headers))))) - -(deffoo nndoc-request-article (article &optional newsgroup server buffer) - (nndoc-possibly-change-buffer newsgroup server) - (save-excursion - (let ((buffer (or buffer nntp-server-buffer)) - (entry (cdr (assq article nndoc-dissection-alist))) - beg) - (set-buffer buffer) - (erase-buffer) - (when entry - (if (stringp article) - nil - (insert-buffer-substring - nndoc-current-buffer (car entry) (nth 1 entry)) - (insert "\n") - (setq beg (point)) - (insert-buffer-substring - nndoc-current-buffer (nth 2 entry) (nth 3 entry)) - (goto-char beg) - (when nndoc-prepare-body-function - (funcall nndoc-prepare-body-function)) - (when nndoc-article-transform-function - (funcall nndoc-article-transform-function article)) - t))))) - -(deffoo nndoc-request-group (group &optional server dont-check) - "Select news GROUP." - (let (number) - (cond - ((not (nndoc-possibly-change-buffer group server)) - (nnheader-report 'nndoc "No such file or buffer: %s" - nndoc-address)) - (dont-check - (nnheader-report 'nndoc "Selected group %s" group) - t) - ((zerop (setq number (length nndoc-dissection-alist))) - (nndoc-close-group group) - (nnheader-report 'nndoc "No articles in group %s" group)) - (t - (nnheader-insert "211 %d %d %d %s\n" number 1 number group))))) - -(deffoo nndoc-request-type (group &optional article) - (cond ((not article) 'unknown) - (nndoc-post-type nndoc-post-type) - (t 'unknown))) - -(deffoo nndoc-close-group (group &optional server) - (nndoc-possibly-change-buffer group server) - (and nndoc-current-buffer - (buffer-name nndoc-current-buffer) - (kill-buffer nndoc-current-buffer)) - (setq nndoc-group-alist (delq (assoc group nndoc-group-alist) - nndoc-group-alist)) - (setq nndoc-current-buffer nil) - (nnoo-close-server 'nndoc server) - (setq nndoc-dissection-alist nil) - t) - -(deffoo nndoc-request-list (&optional server) - nil) - -(deffoo nndoc-request-newgroups (date &optional server) - nil) - -(deffoo nndoc-request-list-newsgroups (&optional server) - nil) - - -;;; Internal functions. - -(defun nndoc-possibly-change-buffer (group source) - (let (buf) - (cond - ;; The current buffer is this group's buffer. - ((and nndoc-current-buffer - (buffer-name nndoc-current-buffer) - (eq nndoc-current-buffer - (setq buf (cdr (assoc group nndoc-group-alist)))))) - ;; We change buffers by taking an old from the group alist. - ;; `source' is either a string (a file name) or a buffer object. - (buf - (setq nndoc-current-buffer buf)) - ;; It's a totally new group. - ((or (and (bufferp nndoc-address) - (buffer-name nndoc-address)) - (and (stringp nndoc-address) - (file-exists-p nndoc-address) - (not (file-directory-p nndoc-address)))) - (push (cons group (setq nndoc-current-buffer - (get-buffer-create - (concat " *nndoc " group "*")))) - nndoc-group-alist) - (setq nndoc-dissection-alist nil) - (save-excursion - (set-buffer nndoc-current-buffer) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (if (stringp nndoc-address) - (nnheader-insert-file-contents nndoc-address) - (insert-buffer-substring nndoc-address)) - (gnus-run-hooks 'nndoc-open-document-hook)))) - ;; Initialize the nndoc structures according to this new document. - (when (and nndoc-current-buffer - (not nndoc-dissection-alist)) - (save-excursion - (set-buffer nndoc-current-buffer) - (nndoc-set-delims) - (nndoc-dissect-buffer))) - (unless nndoc-current-buffer - (nndoc-close-server)) - ;; Return whether we managed to select a file. - nndoc-current-buffer)) - -;;; -;;; Deciding what document type we have -;;; - -(defun nndoc-set-delims () - "Set the nndoc delimiter variables according to the type of the document." - (let ((vars '(nndoc-file-begin - nndoc-first-article - nndoc-article-end nndoc-head-begin nndoc-head-end - nndoc-file-end nndoc-article-begin - 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))) - (while vars - (set (pop vars) nil))) - (let (defs) - ;; Guess away until we find the real file type. - (while (assq 'guess (setq defs (cdr (assq nndoc-article-type - nndoc-type-alist)))) - (setq nndoc-article-type (nndoc-guess-type nndoc-article-type))) - ;; Set the nndoc variables. - (while defs - (set (intern (format "nndoc-%s" (caar defs))) - (cdr (pop defs)))))) - -(defun nndoc-guess-type (subtype) - (let ((alist nndoc-type-alist) - results result entry) - (while (and (not result) - (setq entry (pop alist))) - (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess))) - (goto-char (point-min)) - (when (numberp (setq result (funcall (intern - (format "nndoc-%s-type-p" - (car entry)))))) - (push (cons result entry) results) - (setq result nil)))) - (unless (or result results) - (error "Document is not of any recognized type")) - (if result - (car entry) - (cadar (sort results 'car-less-than-car))))) - -;;; -;;; Built-in type predicates and functions -;;; - -(defun nndoc-mbox-type-p () - (when (looking-at message-unix-mail-delimiter) - t)) - -(defun nndoc-mbox-article-begin () - (when (re-search-forward (concat "^" message-unix-mail-delimiter) nil t) - (goto-char (match-beginning 0)))) - -(defun nndoc-mbox-body-end () - (let ((beg (point)) - len end) - (when - (save-excursion - (and (re-search-backward - (concat "^" message-unix-mail-delimiter) nil t) - (setq end (point)) - (search-forward "\n\n" beg t) - (re-search-backward - "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t) - (setq len (string-to-int (match-string 1))) - (search-forward "\n\n" beg t) - (unless (= (setq len (+ (point) len)) (point-max)) - (and (< len (point-max)) - (goto-char len) - (looking-at message-unix-mail-delimiter))))) - (goto-char len)))) - -(defun nndoc-mmdf-type-p () - (when (looking-at "\^A\^A\^A\^A$") - t)) - -(defun nndoc-news-type-p () - (when (looking-at "^Path:.*\n") - t)) - -(defun nndoc-rnews-type-p () - (when (looking-at "#! *rnews") - t)) - -(defun nndoc-rnews-body-end () - (and (re-search-backward nndoc-article-begin nil t) - (forward-line 1) - (goto-char (+ (point) (string-to-int (match-string 1)))))) - -(defun nndoc-babyl-type-p () - (when (re-search-forward "\^_\^L *\n" nil t) - t)) - -(defun nndoc-babyl-body-begin () - (re-search-forward "^\n" nil t) - (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*") - (let ((next (or (save-excursion - (re-search-forward nndoc-article-begin nil t)) - (point-max)))) - (unless (re-search-forward "^\n" next t) - (goto-char next) - (forward-line -1) - (insert "\n") - (forward-line -1))))) - -(defun nndoc-babyl-head-begin () - (when (re-search-forward "^[0-9].*\n" nil t) - (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*") - (forward-line 1)) - t)) - -(defun nndoc-forward-type-p () - (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))) - t)) - -(defun nndoc-rfc934-type-p () - (when (and (re-search-forward "^-+ Start of forwarded.*\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))) - t)) - -(defun nndoc-rfc822-forward-type-p () - (save-restriction - (message-narrow-to-head) - (when (re-search-forward "^Content-Type: *message/rfc822" nil t) - t))) - -(defun nndoc-rfc822-forward-body-end-function () - (goto-char (point-max))) - -(defun nndoc-clari-briefs-type-p () - (when (let ((case-fold-search nil)) - (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t)) - t)) - -(defun nndoc-transform-clari-briefs (article) - (goto-char (point-min)) - (when (looking-at " *\\*\\(.*\\)\n") - (replace-match "" t t)) - (nndoc-generate-clari-briefs-head article)) - -(defun nndoc-generate-clari-briefs-head (article) - (let ((entry (cdr (assq article nndoc-dissection-alist))) - subject from) - (save-excursion - (set-buffer nndoc-current-buffer) - (save-restriction - (narrow-to-region (car entry) (nth 3 entry)) - (goto-char (point-min)) - (when (looking-at " *\\*\\(.*\\)$") - (setq subject (match-string 1)) - (when (string-match "[ \t]+$" subject) - (setq subject (substring subject 0 (match-beginning 0))))) - (when - (let ((case-fold-search nil)) - (re-search-forward - "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t)) - (setq from (match-string 1))))) - (insert "From: " "clari@clari.net (" (or from "unknown") ")" - "\nSubject: " (or subject "(no subject)") "\n"))) - -(defun nndoc-mime-digest-type-p () - (let ((case-fold-search t) - boundary-id b-delimiter entry) - (when (and - (re-search-forward - (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]" - "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"") - nil t) - (match-beginning 1)) - (setq boundary-id (match-string 1) - b-delimiter (concat "\n--" boundary-id "[\n \t]+")) - (setq entry (assq 'mime-digest nndoc-type-alist)) - (setcdr entry - (list - (cons 'head-end "^ ?$") - (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]*$")))) - t))) - -(defun nndoc-standard-digest-type-p () - (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t) - (re-search-forward - (concat "\n\n" (make-string 30 ?-) "\n\n") nil t)) - t)) - -(defun nndoc-digest-body-end () - (and (re-search-forward nndoc-article-begin nil t) - (goto-char (match-beginning 0)))) - -(defun nndoc-slack-digest-type-p () - 0) - -(defun nndoc-lanl-gov-announce-type-p () - (when (let ((case-fold-search nil)) - (re-search-forward "^\\\\\\\\\nPaper: [a-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 "" t t)) - ) - -(defun nndoc-generate-lanl-gov-head (article) - (let ((entry (cdr (assq article nndoc-dissection-alist))) - (e-mail "no address given") - subject from) - (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 ">")))) - )) - (while (and from (string-match "(\[^)\]*)" from)) - (setq from (replace-match "" t t from))) - (insert "From: " (or from "unknown") - "\nSubject: " (or subject "(no subject)") "\n"))) - - - -;;; -;;; Functions for dissecting the documents -;;; - -(defun nndoc-search (regexp) - (prog1 - (re-search-forward regexp nil t) - (beginning-of-line))) - -(defun nndoc-dissect-buffer () - "Go through the document and partition it into heads/bodies/articles." - (let ((i 0) - (first t) - head-begin head-end body-begin body-end) - (setq nndoc-dissection-alist nil) - (save-excursion - (set-buffer nndoc-current-buffer) - (goto-char (point-min)) - ;; 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 (>= (point) (point-max)) - (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 - (funcall nndoc-article-begin-function) - (ignore-errors - (nndoc-search nndoc-article-begin)))) - -(defun nndoc-unquote-dashes () - "Unquote quoted non-separators in digests." - (while (re-search-forward "^- -"nil t) - (replace-match "-" t t))) - -;;;###autoload -(defun nndoc-add-type (definition &optional position) - "Add document DEFINITION to the list of nndoc document definitions. -If POSITION is nil or `last', the definition will be added -as the last checked definition, if t or `first', add as the -first definition, and if any other symbol, add after that -symbol in the alist." - ;; First remove any old instances. - (setq nndoc-type-alist - (delq (assq (car definition) nndoc-type-alist) - nndoc-type-alist)) - ;; Then enter the new definition in the proper place. - (cond - ((or (null position) (eq position 'last)) - (setq nndoc-type-alist (nconc nndoc-type-alist (list definition)))) - ((or (eq position t) (eq position 'first)) - (push definition nndoc-type-alist)) - (t - (let ((list (memq (assq position nndoc-type-alist) - nndoc-type-alist))) - (unless list - (error "No such position: %s" position)) - (setcdr list (cons definition (cdr list))))))) - -(provide 'nndoc) - -;;; nndoc.el ends here diff --git a/lisp/nndraft.el b/lisp/nndraft.el deleted file mode 100644 index be653df..0000000 --- a/lisp/nndraft.el +++ /dev/null @@ -1,246 +0,0 @@ -;;; nndraft.el --- draft article access for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnmail) -(require 'gnus-start) -(require 'nnmh) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nndraft - nnmh) - -(defvoo nndraft-directory (nnheader-concat gnus-directory "drafts/") - "Where nndraft will store its files." - nnmh-directory) - - - -(defvoo nndraft-current-group "" nil nnmh-current-group) -(defvoo nndraft-get-new-mail nil nil nnmh-get-new-mail) -(defvoo nndraft-current-directory nil nil nnmh-current-directory) - -(defconst nndraft-version "nndraft 1.0") -(defvoo nndraft-status-string "" nil nnmh-status-string) - - - -;;; Interface functions. - -(nnoo-define-basics nndraft) - -(deffoo nndraft-open-server (server &optional defs) - (nnoo-change-server 'nndraft server defs) - (cond - ((not (file-exists-p nndraft-directory)) - (nndraft-close-server) - (nnheader-report 'nndraft "No such file or directory: %s" - nndraft-directory)) - ((not (file-directory-p (file-truename nndraft-directory))) - (nndraft-close-server) - (nnheader-report 'nndraft "Not a directory: %s" nndraft-directory)) - (t - (nnheader-report 'nndraft "Opened server %s using directory %s" - server nndraft-directory) - t))) - -(deffoo nndraft-retrieve-headers (articles &optional group server fetch-old) - (nndraft-possibly-change-group group) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let* ((buf (get-buffer-create " *draft headers*")) - article) - (set-buffer buf) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - ;; We don't support fetching by Message-ID. - (if (stringp (car articles)) - 'headers - (while articles - (set-buffer buf) - (when (nndraft-request-article - (setq article (pop articles)) group server (current-buffer)) - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (forward-line -1) - (goto-char (point-max))) - (delete-region (point) (point-max)) - (set-buffer nntp-server-buffer) - (goto-char (point-max)) - (insert (format "221 %d Article retrieved.\n" article)) - (insert-buffer-substring buf) - (insert ".\n"))) - - (nnheader-fold-continuation-lines) - 'headers)))) - -(deffoo nndraft-request-article (id &optional group server buffer) - (nndraft-possibly-change-group group) - (when (numberp id) - ;; We get the newest file of the auto-saved file and the - ;; "real" file. - (let* ((file (nndraft-article-filename id)) - (auto (nndraft-auto-save-file-name file)) - (newest (if (file-newer-than-file-p file auto) file auto)) - (nntp-server-buffer (or buffer nntp-server-buffer))) - (when (and (file-exists-p newest) - (nnmail-find-file newest)) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - ;; If there's a mail header separator in this file, - ;; we remove it. - (when (re-search-forward - (concat "^" mail-header-separator "$") nil t) - (replace-match "" t t))) - t)))) - -(deffoo nndraft-request-restore-buffer (article &optional group server) - "Request a new buffer that is restored to the state of ARTICLE." - (nndraft-possibly-change-group group) - (when (nndraft-request-article article group server (current-buffer)) - (message-remove-header "xrefs") - (message-remove-header "lines") - (let ((gnus-verbose-backends nil)) - (nndraft-request-expire-articles (list article) group server t)) - t)) - -(deffoo nndraft-request-update-info (group info &optional server) - (nndraft-possibly-change-group group) - (gnus-info-set-read - info - (gnus-update-read-articles (gnus-group-prefixed-name group '(nndraft "")) - (nndraft-articles) t)) - (let (marks) - (when (setq marks (nth 3 info)) - (setcar (nthcdr 3 info) - (if (assq 'unsend marks) - (list (assq 'unsend marks)) - nil)))) - t) - -(deffoo nndraft-request-associate-buffer (group) - "Associate the current buffer with some article in the draft group." - (nndraft-open-server "") - (nndraft-request-group group) - (nndraft-possibly-change-group group) - (let ((gnus-verbose-backends nil) - (buf (current-buffer)) - article file) - (nnheader-temp-write nil - (insert-buffer buf) - (setq article (nndraft-request-accept-article - group (nnoo-current-server 'nndraft) t 'noinsert)) - (setq file (nndraft-article-filename article))) - (setq buffer-file-name (expand-file-name file)) - (setq buffer-auto-save-file-name (make-auto-save-file-name)) - (clear-visited-file-modtime) - article)) - -(deffoo nndraft-request-expire-articles (articles group &optional server force) - (nndraft-possibly-change-group group) - (let* ((nnmh-allow-delete-final t) - (res (nnoo-parent-function 'nndraft - 'nnmh-request-expire-articles - (list articles group server force))) - article) - ;; Delete all the "state" files of articles that have been expired. - (while articles - (unless (memq (setq article (pop articles)) res) - (let ((auto (nndraft-auto-save-file-name - (nndraft-article-filename article)))) - (when (file-exists-p auto) - (funcall nnmail-delete-file-function auto))))) - res)) - -(deffoo nndraft-request-accept-article (group &optional server last noinsert) - (nndraft-possibly-change-group group) - (let ((gnus-verbose-backends nil)) - (nnoo-parent-function 'nndraft 'nnmh-request-accept-article - (list group server last noinsert)))) - -(deffoo nndraft-request-create-group (group &optional server args) - (nndraft-possibly-change-group group) - (if (file-exists-p nndraft-current-directory) - (if (file-directory-p nndraft-current-directory) - t - nil) - (condition-case () - (progn - (gnus-make-directory nndraft-current-directory) - t) - (file-error nil)))) - - -;;; Low-Level Interface - -(defun nndraft-possibly-change-group (group) - (when (and group - (not (equal group nndraft-current-group))) - (nndraft-open-server "") - (setq nndraft-current-group group) - (setq nndraft-current-directory - (nnheader-concat nndraft-directory group)))) - -(defun nndraft-article-filename (article &rest args) - (apply 'concat - (file-name-as-directory nndraft-current-directory) - (int-to-string article) - args)) - -(defun nndraft-auto-save-file-name (file) - (save-excursion - (prog1 - (progn - (set-buffer (get-buffer-create " *draft tmp*")) - (setq buffer-file-name file) - (make-auto-save-file-name)) - (kill-buffer (current-buffer))))) - -(defun nndraft-articles () - "Return the list of messages in the group." - (gnus-make-directory nndraft-current-directory) - (sort - (mapcar 'string-to-int - (directory-files nndraft-current-directory nil "\\`[0-9]+\\'" t)) - '<)) - -(nnoo-import nndraft - (nnmh - nnmh-retrieve-headers - nnmh-request-group - nnmh-close-group - nnmh-request-list - nnmh-request-newsgroups - nnmh-request-move-article - nnmh-request-replace-article)) - -(provide 'nndraft) - -;;; nndraft.el ends here diff --git a/lisp/nneething.el b/lisp/nneething.el deleted file mode 100644 index be3bcbd..0000000 --- a/lisp/nneething.el +++ /dev/null @@ -1,352 +0,0 @@ -;;; nneething.el --- random file access for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; 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: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'nnheader) -(require 'nnmail) -(require 'nnoo) -(require 'gnus-util) - -(nnoo-declare nneething) - -(defvoo nneething-map-file-directory "~/.nneething/" - "Where nneething stores the map files.") - -(defvoo nneething-map-file ".nneething" - "Name of the map files.") - -(defvoo nneething-exclude-files nil - "Regexp saying what files to exclude from the group. -If this variable is nil, no files will be excluded.") - - - -;;; Internal variables. - -(defconst nneething-version "nneething 1.0" - "nneething version.") - -(defvoo nneething-current-directory nil - "Current news group directory.") - -(defvoo nneething-status-string "") - -(defvoo nneething-message-id-number 0) -(defvoo nneething-work-buffer " *nneething work*") - -(defvoo nneething-group nil) -(defvoo nneething-map nil) -(defvoo nneething-read-only nil) -(defvoo nneething-active nil) -(defvoo nneething-directory nil) - - - -;;; Interface functions. - -(nnoo-define-basics nneething) - -(deffoo nneething-retrieve-headers (articles &optional group server fetch-old) - (nneething-possibly-change-directory group) - - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let* ((number (length articles)) - (count 0) - (large (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup))) - article file) - - (if (stringp (car articles)) - 'headers - - (while (setq article (pop articles)) - (setq file (nneething-file-name article)) - - (when (and (file-exists-p file) - (or (file-directory-p file) - (not (zerop (nnheader-file-size file))))) - (insert (format "221 %d Article retrieved.\n" article)) - (nneething-insert-head file) - (insert ".\n")) - - (incf count) - - (and large - (zerop (% count 20)) - (message "nneething: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (when large - (message "nneething: Receiving headers...done")) - - (nnheader-fold-continuation-lines) - 'headers)))) - -(deffoo nneething-request-article (id &optional group server buffer) - (nneething-possibly-change-directory group) - (let ((file (unless (stringp id) - (nneething-file-name id))) - (nntp-server-buffer (or buffer nntp-server-buffer))) - (and (stringp file) ; We did not request by Message-ID. - (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. - (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. - (insert "\n")) - t)))) - -(deffoo nneething-request-group (group &optional server dont-check) - (nneething-possibly-change-directory group server) - (unless dont-check - (nneething-create-mapping) - (if (> (car nneething-active) (cdr nneething-active)) - (nnheader-insert "211 0 1 0 %s\n" group) - (nnheader-insert - "211 %d %d %d %s\n" - (- (1+ (cdr nneething-active)) (car nneething-active)) - (car nneething-active) (cdr nneething-active) - group))) - t) - -(deffoo nneething-request-list (&optional server dir) - (nnheader-report 'nneething "LIST is not implemented.")) - -(deffoo nneething-request-newgroups (date &optional server) - (nnheader-report 'nneething "NEWSGROUPS is not implemented.")) - -(deffoo nneething-request-type (group &optional article) - 'unknown) - -(deffoo nneething-close-group (group &optional server) - (setq nneething-current-directory nil) - t) - -(deffoo nneething-open-server (server &optional defs) - (nnheader-init-server-buffer) - (if (nneething-server-opened server) - t - (unless (assq 'nneething-directory defs) - (setq defs (append defs (list (list 'nneething-directory server))))) - (nnoo-change-server 'nneething server defs))) - - -;;; Internal functions. - -(defun nneething-possibly-change-directory (group &optional server) - (when (and server - (not (nneething-server-opened server))) - (nneething-open-server server)) - (when (and group - (not (equal nneething-group group))) - (setq nneething-group group) - (setq nneething-map nil) - (setq nneething-active (cons 1 0)) - (nneething-create-mapping))) - -(defun nneething-map-file () - ;; We make sure that the .nneething directory exists. - (gnus-make-directory nneething-map-file-directory) - ;; We store it in a special directory under the user's home dir. - (concat (file-name-as-directory nneething-map-file-directory) - nneething-group nneething-map-file)) - -(defun nneething-create-mapping () - ;; Read nneething-active and nneething-map. - (when (file-exists-p nneething-directory) - (let ((map-file (nneething-map-file)) - (files (directory-files nneething-directory)) - touched map-files) - (when (file-exists-p map-file) - (ignore-errors - (load map-file nil t t))) - (unless nneething-active - (setq nneething-active (cons 1 0))) - ;; Old nneething had a different map format. - (when (and (cdar nneething-map) - (atom (cdar nneething-map))) - (setq nneething-map - (mapcar (lambda (n) - (list (cdr n) (car n) - (nth 5 (file-attributes - (nneething-file-name (car n)))))) - nneething-map))) - ;; Remove files matching the exclusion regexp. - (when nneething-exclude-files - (let ((f files) - prev) - (while f - (if (string-match nneething-exclude-files (car f)) - (if prev (setcdr prev (cdr f)) - (setq files (cdr files))) - (setq prev f)) - (setq f (cdr f))))) - ;; Remove deleted files from the map. - (let ((map nneething-map) - prev) - (while map - (if (and (member (cadar map) files) - ;; We also remove files that have changed mod times. - (equal (nth 5 (file-attributes - (nneething-file-name (cadar map)))) - (caddar map))) - (progn - (push (cadar map) map-files) - (setq prev map)) - (setq touched t) - (if prev - (setcdr prev (cdr map)) - (setq nneething-map (cdr nneething-map)))) - (setq map (cdr map)))) - ;; Find all new files and enter them into the map. - (while files - (unless (member (car files) map-files) - ;; This file is not in the map, so we enter it. - (setq touched t) - (setcdr nneething-active (1+ (cdr nneething-active))) - (push (list (cdr nneething-active) (car files) - (nth 5 (file-attributes - (nneething-file-name (car files))))) - nneething-map)) - (setq files (cdr files))) - (when (and touched - (not nneething-read-only)) - (nnheader-temp-write map-file - (insert "(setq nneething-map '") - (gnus-prin1 nneething-map) - (insert ")\n(setq nneething-active '") - (gnus-prin1 nneething-active) - (insert ")\n")))))) - -(defun nneething-insert-head (file) - "Insert the head of FILE." - (when (nneething-get-head file) - (insert-buffer-substring nneething-work-buffer) - (goto-char (point-max)))) - -(defun nneething-make-head (file &optional buffer) - "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")) - (or (when buffer - (save-excursion - (set-buffer buffer) - (when (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t) - (concat "From: " (match-string 0) "\n")))) - (nneething-from-line (nth 2 atts) file)) - (if (> (string-to-int (int-to-string (nth 7 atts))) 0) - (concat "Chars: " (int-to-string (nth 7 atts)) "\n") - "") - (if buffer - (save-excursion - (set-buffer buffer) - (concat "Lines: " (int-to-string - (count-lines (point-min) (point-max))) - "\n")) - "") - ))) - -(defun nneething-from-line (uid &optional file) - "Return a From header based of UID." - (let* ((login (condition-case nil - (user-login-name uid) - (error - (cond ((= uid (user-uid)) (user-login-name)) - ((zerop uid) "root") - (t (int-to-string uid)))))) - (name (condition-case nil - (user-full-name uid) - (error - (cond ((= uid (user-uid)) (user-full-name)) - ((zerop uid) "Ms. Root"))))) - (host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file) - (prog1 - (substring file - (match-beginning 1) - (match-end 1)) - (when (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file) - (setq login (substring file - (match-beginning 2) - (match-end 2)) - name nil))) - (system-name)))) - (concat "From: " login "@" host - (if name (concat " (" name ")") "") "\n"))) - -(defun nneething-get-head (file) - "Either find the head in FILE or make a head for FILE." - (save-excursion - (set-buffer (get-buffer-create nneething-work-buffer)) - (setq case-fold-search nil) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (cond - ((not (file-exists-p file)) - ;; The file do not exist. - nil) - ((or (file-directory-p file) - (file-symlink-p file)) - ;; It's a dir, so we fudge a head. - (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))) - t)))) - -(defun nneething-file-name (article) - "Return the file name of ARTICLE." - (concat (file-name-as-directory nneething-directory) - (if (numberp article) - (cadr (assq article nneething-map)) - article))) - -(provide 'nneething) - -;;; nneething.el ends here diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el deleted file mode 100644 index 9945b2f..0000000 --- a/lisp/nnfolder.el +++ /dev/null @@ -1,792 +0,0 @@ -;;; nnfolder.el --- mail folder access for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Scott Byer -;; Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'message) -(require 'nnmail) -(require 'nnoo) -(require 'cl) -(require 'gnus-util) - -(nnoo-declare nnfolder) - -(defvoo nnfolder-directory (expand-file-name message-directory) - "The name of the nnfolder directory.") - -(defvoo nnfolder-active-file - (nnheader-concat nnfolder-directory "active") - "The name of the active file.") - -;; I renamed this variable to something more in keeping with the general GNU -;; style. -SLB - -(defvoo nnfolder-ignore-active-file nil - "If non-nil, causes nnfolder to do some extra work in order to determine -the true active ranges of an mbox file. Note that the active file is still -saved, but it's values are not used. This costs some extra time when -scanning an mbox when opening it.") - -(defvoo nnfolder-distrust-mbox nil - "If non-nil, causes nnfolder to not trust the user with respect to -inserting unaccounted for mail in the middle of an mbox file. This can greatly -slow down scans, which now must scan the entire file for unmarked messages. -When nil, scans occur forward from the last marked message, a huge -time saver for large mailboxes.") - -(defvoo nnfolder-newsgroups-file - (concat (file-name-as-directory nnfolder-directory) "newsgroups") - "Mail newsgroups description file.") - -(defvoo nnfolder-get-new-mail t - "If non-nil, nnfolder will check the incoming mail file and split the mail.") - -(defvoo nnfolder-prepare-save-mail-hook nil - "Hook run narrowed to an article before saving.") - -(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" - "nnfolder version.") - -(defconst nnfolder-article-marker "X-Gnus-Article-Number: " - "String used to demarcate what the article number for a message is.") - -(defvoo nnfolder-current-group nil) -(defvoo nnfolder-current-buffer nil) -(defvoo nnfolder-status-string "") -(defvoo nnfolder-group-alist nil) -(defvoo nnfolder-buffer-alist nil) -(defvoo nnfolder-scantime-alist nil) -(defvoo nnfolder-active-timestamp nil) - - - -;;; Interface functions - -(nnoo-define-basics nnfolder) - -(deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let (article art-string start stop) - (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 articles - (setq article (car articles)) - (setq art-string (nnfolder-article-string article)) - (set-buffer nnfolder-current-buffer) - (when (or (search-forward art-string nil t) - ;; Don't search the whole file twice! Also, articles - ;; probably have some locality by number, so searching - ;; backwards will be faster. Especially if we're at the - ;; beginning of the buffer :-). -SLB - (search-backward art-string nil t)) - (nnmail-search-unix-mail-delim-backward) - (setq start (point)) - (search-forward "\n\n" nil t) - (setq stop (1- (point))) - (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")) - (setq articles (cdr articles))) - - (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) - (cond - ((not (file-exists-p nnfolder-directory)) - (nnfolder-close-server) - (nnheader-report 'nnfolder "Couldn't create directory: %s" - nnfolder-directory)) - ((not (file-directory-p (file-truename nnfolder-directory))) - (nnfolder-close-server) - (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory)) - (t - (nnmail-activate 'nnfolder) - (nnheader-report 'nnfolder "Opened server %s using directory %s" - server nnfolder-directory) - t))) - -(deffoo nnfolder-request-close () - (let ((alist nnfolder-buffer-alist)) - (while alist - (nnfolder-close-group (caar alist) nil t) - (setq alist (cdr alist)))) - (nnoo-close-server 'nnfolder) - (setq nnfolder-buffer-alist nil - nnfolder-group-alist nil)) - -(deffoo nnfolder-request-article (article &optional group server buffer) - (nnfolder-possibly-change-group group server) - (save-excursion - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (when (search-forward (nnfolder-article-string article) nil t) - (let (start stop) - (nnmail-search-unix-mail-delim-backward) - (setq start (point)) - (forward-line 1) - (unless (and (nnmail-search-unix-mail-delim) - (forward-line -1)) - (goto-char (point-max))) - (setq stop (point)) - (let ((nntp-server-buffer (or buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring nnfolder-current-buffer start stop) - (goto-char (point-min)) - (while (looking-at "From ") - (delete-char 5) - (insert "X-From-Line: ") - (forward-line 1)) - (if (numberp article) - (cons nnfolder-current-group article) - (goto-char (point-min)) - (search-forward (concat "\n" nnfolder-article-marker)) - (cons nnfolder-current-group - (string-to-int - (buffer-substring - (point) (progn (end-of-line) (point))))))))))) - -(deffoo nnfolder-request-group (group &optional server dont-check) - (nnfolder-possibly-change-group group server t) - (save-excursion - (if (not (assoc group nnfolder-group-alist)) - (nnheader-report 'nnfolder "No such group: %s" group) - (if dont-check - (progn - (nnheader-report 'nnfolder "Selected group %s" group) - t) - (let* ((active (assoc group nnfolder-group-alist)) - (group (car active)) - (range (cadr active))) - (cond - ((null active) - (nnheader-report 'nnfolder "No such group: %s" group)) - ((null nnfolder-current-group) - (nnheader-report 'nnfolder "Empty group: %s" group)) - (t - (nnheader-report 'nnfolder "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" - (1+ (- (cdr range) (car range))) - (car range) (cdr range) group)))))))) - -(deffoo nnfolder-request-scan (&optional group server) - (nnfolder-possibly-change-group nil server) - (when nnfolder-get-new-mail - (nnfolder-possibly-change-group group server) - (nnmail-get-new-mail - 'nnfolder - (lambda () - (let ((bufs nnfolder-buffer-alist)) - (save-excursion - (while bufs - (if (not (gnus-buffer-live-p (nth 1 (car bufs)))) - (setq nnfolder-buffer-alist - (delq (car bufs) nnfolder-buffer-alist)) - (set-buffer (nth 1 (car bufs))) - (nnfolder-save-buffer) - (kill-buffer (current-buffer))) - (setq bufs (cdr bufs)))))) - nnfolder-directory - group))) - -;; Don't close the buffer if we're not shutting down the server. This way, -;; we can keep the buffer in the group buffer cache, and not have to grovel -;; over the buffer again unless we add new mail to it or modify it in some -;; way. - -(deffoo nnfolder-close-group (group &optional server force) - ;; Make sure we _had_ the group open. - (when (or (assoc group nnfolder-buffer-alist) - (equal group nnfolder-current-group)) - (let ((inf (assoc group nnfolder-buffer-alist))) - (when inf - (when (and nnfolder-current-group - nnfolder-current-buffer) - (push (list nnfolder-current-group nnfolder-current-buffer) - nnfolder-buffer-alist)) - (setq nnfolder-buffer-alist - (delq inf nnfolder-buffer-alist)) - (setq nnfolder-current-buffer (cadr inf) - nnfolder-current-group (car inf)))) - (when (and nnfolder-current-buffer - (buffer-name nnfolder-current-buffer)) - (save-excursion - (set-buffer nnfolder-current-buffer) - ;; If the buffer was modified, write the file out now. - (nnfolder-save-buffer) - ;; If we're shutting the server down, we need to kill the - ;; buffer and remove it from the open buffer list. Or, of - ;; course, if we're trying to minimize our space impact. - (kill-buffer (current-buffer)) - (setq nnfolder-buffer-alist (delq (assoc group nnfolder-buffer-alist) - nnfolder-buffer-alist))))) - (setq nnfolder-current-group nil - nnfolder-current-buffer nil) - t) - -(deffoo nnfolder-request-create-group (group &optional server args) - (nnfolder-possibly-change-group nil server) - (nnmail-activate 'nnfolder) - (when group - (unless (assoc group nnfolder-group-alist) - (push (list group (cons 1 0)) nnfolder-group-alist) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - (nnfolder-read-folder group))) - t) - -(deffoo nnfolder-request-list (&optional server) - (nnfolder-possibly-change-group nil server) - (save-excursion - (let ((nnmail-file-coding-system nnmail-active-file-coding-system) - (pathname-coding-system 'binary)) - (nnmail-find-file nnfolder-active-file) - (setq nnfolder-group-alist (nnmail-get-active))) - t)) - -(deffoo nnfolder-request-newgroups (date &optional server) - (nnfolder-possibly-change-group nil server) - (nnfolder-request-list server)) - -(deffoo nnfolder-request-list-newsgroups (&optional server) - (nnfolder-possibly-change-group nil server) - (save-excursion - (nnmail-find-file nnfolder-newsgroups-file))) - -(deffoo nnfolder-request-expire-articles - (articles newsgroup &optional server force) - (nnfolder-possibly-change-group newsgroup server) - (let* ((is-old t) - rest) - (nnmail-activate 'nnfolder) - - (save-excursion - (set-buffer nnfolder-current-buffer) - (while (and articles is-old) - (goto-char (point-min)) - (when (search-forward (nnfolder-article-string (car articles)) nil t) - (if (setq is-old - (nnmail-expired-article-p - newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) - force nnfolder-inhibit-expiry)) - (progn - (nnheader-message 5 "Deleting article %d..." - (car articles) newsgroup) - (nnfolder-delete-mail)) - (push (car articles) rest))) - (setq articles (cdr articles))) - (unless nnfolder-inhibit-expiry - (nnheader-message 5 "Deleting articles...done")) - (nnfolder-save-buffer) - (nnfolder-adjust-min-active newsgroup) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - (nconc rest articles)))) - -(deffoo nnfolder-request-move-article (article group server - accept-form &optional last) - (save-excursion - (let ((buf (get-buffer-create " *nnfolder move*")) - result) - (and - (nnfolder-request-article article group server) - (save-excursion - (set-buffer buf) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-buffer-substring nntp-server-buffer) - (goto-char (point-min)) - (while (re-search-forward - (concat "^" nnfolder-article-marker) - (save-excursion (search-forward "\n\n" nil t) (point)) t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - (setq result (eval accept-form)) - (kill-buffer buf) - result) - (save-excursion - (nnfolder-possibly-change-group group server) - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (when (search-forward (nnfolder-article-string article) nil t) - (nnfolder-delete-mail)) - (when last - (nnfolder-save-buffer) - (nnfolder-adjust-min-active group) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file)))) - result))) - -(deffoo nnfolder-request-accept-article (group &optional server last) - (save-excursion - (nnfolder-possibly-change-group group server) - (nnmail-check-syntax) - (let ((buf (current-buffer)) - 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)) - (search-forward "\n\n" nil t) - (forward-line -1) - (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))))) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - (unless result - (nnheader-report 'nnfolder "Couldn't store article")) - result))) - -(deffoo nnfolder-request-replace-article (article group buffer) - (nnfolder-possibly-change-group group) - (save-excursion - (set-buffer buffer) - (nnfolder-normalize-buffer) - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (if (not (search-forward (nnfolder-article-string article) nil t)) - nil - (nnfolder-delete-mail t t) - (insert-buffer-substring buffer) - (nnfolder-save-buffer) - t))) - -(deffoo nnfolder-request-delete-group (group &optional force server) - (nnfolder-close-group group server t) - ;; Delete all articles in GROUP. - (if (not force) - () ; Don't delete the articles. - ;; Delete the file that holds the group. - (ignore-errors - (delete-file (nnfolder-group-pathname group)))) - ;; Remove the group from all structures. - (setq nnfolder-group-alist - (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) - nnfolder-current-group nil - nnfolder-current-buffer nil) - ;; Save the active file. - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - t) - -(deffoo nnfolder-request-rename-group (group new-name &optional server) - (nnfolder-possibly-change-group group server) - (save-excursion - (set-buffer nnfolder-current-buffer) - (and (file-writable-p buffer-file-name) - (ignore-errors - (rename-file - buffer-file-name - (nnfolder-group-pathname new-name)) - t) - ;; That went ok, so we change the internal structures. - (let ((entry (assoc group nnfolder-group-alist))) - (and entry (setcar entry new-name)) - (setq nnfolder-current-buffer nil - nnfolder-current-group nil) - ;; Save the new group alist. - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - ;; We kill the buffer instead of renaming it and stuff. - (kill-buffer (current-buffer)) - t)))) - -(defun nnfolder-request-regenerate (server) - (nnfolder-possibly-change-group nil server) - (nnfolder-generate-active-file) - t) - - -;;; Internal functions. - -(defun nnfolder-adjust-min-active (group) - ;; Find the lowest active article in this group. - (let* ((active (cadr (assoc group nnfolder-group-alist))) - (marker (concat "\n" nnfolder-article-marker)) - (number "[0-9]+") - (activemin (cdr active))) - (save-excursion - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (while (and (search-forward marker nil t) - (re-search-forward number nil t)) - (setq activemin (min activemin - (string-to-number (buffer-substring - (match-beginning 0) - (match-end 0)))))) - (setcar active activemin)))) - -(defun nnfolder-article-string (article) - (if (numberp article) - (concat "\n" nnfolder-article-marker (int-to-string article) " ") - (concat "\nMessage-ID: " article))) - -(defun nnfolder-delete-mail (&optional force leave-delim) - "Delete the message that point is in." - (save-excursion - (delete-region - (save-excursion - (nnmail-search-unix-mail-delim-backward) - (if leave-delim (progn (forward-line 1) (point)) - (point))) - (progn - (forward-line 1) - (if (nnmail-search-unix-mail-delim) - (point) - (point-max)))))) - -(defun nnfolder-possibly-change-group (group &optional server dont-check) - ;; Change servers. - (when (and server - (not (nnfolder-server-opened server))) - (nnfolder-open-server server)) - (unless (gnus-buffer-live-p nnfolder-current-buffer) - (setq nnfolder-current-buffer nil - nnfolder-current-group nil)) - ;; Change group. - (when (and group - (not (equal group nnfolder-current-group))) - (let ((pathname-coding-system 'binary)) - (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) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file)) - - (if dont-check - (setq nnfolder-current-group group - nnfolder-current-buffer nil) - (let (inf file) - ;; If we have to change groups, see if we don't already have the - ;; folder in memory. If we do, verify the modtime and destroy - ;; the folder if needed so we can rescan it. - (setq nnfolder-current-buffer - (nth 1 (assoc group nnfolder-buffer-alist))) - - ;; If the buffer is not live, make sure it isn't in the alist. If it - ;; is live, verify that nobody else has touched the file since last - ;; time. - (when (and nnfolder-current-buffer - (not (gnus-buffer-live-p nnfolder-current-buffer))) - (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist) - nnfolder-current-buffer nil)) - - (setq nnfolder-current-group group) - - (when (or (not nnfolder-current-buffer) - (not (verify-visited-file-modtime - nnfolder-current-buffer))) - (save-excursion - (setq file (nnfolder-group-pathname group)) - ;; See whether we need to create the new file. - (unless (file-exists-p file) - (gnus-make-directory (file-name-directory file)) - (nnmail-write-region 1 1 file t 'nomesg)) - (when (setq nnfolder-current-buffer (nnfolder-read-folder group)) - (set-buffer nnfolder-current-buffer) - (push (list group nnfolder-current-buffer) - nnfolder-buffer-alist))))))))) - -(defun nnfolder-save-mail (group-art-list) - "Called narrowed to an article." - (let* (save-list group-art) - (goto-char (point-min)) - ;; The From line may have been quoted by movemail. - (when (looking-at (concat ">" message-unix-mail-delimiter)) - (delete-char 1)) - ;; This might come from somewhere else. - (unless (looking-at message-unix-mail-delimiter) - (insert "From nobody " (current-time-string) "\n") - (goto-char (point-min))) - ;; Quote all "From " lines in the article. - (forward-line 1) - (let (case-fold-search) - (while (re-search-forward "^From " nil t) - (beginning-of-line) - (insert "> "))) - (setq save-list group-art-list) - (nnmail-insert-lines) - (nnmail-insert-xref group-art-list) - (gnus-run-hooks 'nnmail-prepare-save-mail-hook) - (gnus-run-hooks 'nnfolder-prepare-save-mail-hook) - - ;; Insert the mail into each of the destination groups. - (while (setq group-art (pop group-art-list)) - ;; Kill any previous newsgroup markers. - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-line -1) - (while (search-backward (concat "\n" nnfolder-article-marker) nil t) - (delete-region (1+ (point)) (progn (forward-line 2) (point)))) - - ;; Insert the new newsgroup marker. - (nnfolder-insert-newsgroup-line group-art) - - (save-excursion - (let ((beg (point-min)) - (end (point-max)) - (obuf (current-buffer))) - (nnfolder-possibly-change-folder (car group-art)) - (let ((buffer-read-only nil)) - (nnfolder-normalize-buffer) - (insert-buffer-substring obuf beg end))))) - - ;; Did we save it anywhere? - save-list)) - -(defun nnfolder-normalize-buffer () - "Make sure there are two newlines at the end of the buffer." - (goto-char (point-max)) - (skip-chars-backward "\n") - (delete-region (point) (point-max)) - (insert "\n\n")) - -(defun nnfolder-insert-newsgroup-line (group-art) - (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (forward-char -1) - (insert (format (concat nnfolder-article-marker "%d %s\n") - (cdr group-art) (current-time-string)))))) - -(defun nnfolder-active-number (group) - ;; Find the next article number in GROUP. - (let ((active (cadr (assoc group nnfolder-group-alist)))) - (if active - (setcdr active (1+ (cdr active))) - ;; This group is new, so we create a new entry for it. - ;; This might be a bit naughty... creating groups on the drop of - ;; a hat, but I don't know... - (push (list group (setq active (cons 1 1))) - nnfolder-group-alist)) - (cdr active))) - -(defun nnfolder-possibly-change-folder (group) - (let ((inf (assoc group nnfolder-buffer-alist))) - (if (and inf - (gnus-buffer-live-p (cadr inf))) - (set-buffer (cadr inf)) - (when inf - (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist))) - (when nnfolder-group-alist - (nnmail-save-active nnfolder-group-alist nnfolder-active-file)) - (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. - -(defun nnfolder-read-folder (group) - (let* ((file (nnfolder-group-pathname group)) - (buffer (set-buffer (nnheader-find-file-noselect file)))) - (if (equal (cadr (assoc group nnfolder-scantime-alist)) - (nth 5 (file-attributes file))) - ;; This looks up-to-date, so we don't do any scanning. - (if (file-exists-p file) - buffer - (push (list group buffer) nnfolder-buffer-alist) - (set-buffer-modified-p t) - (save-buffer)) - ;; Parse the damn thing. - (save-excursion - (nnmail-activate 'nnfolder) - ;; Read in the file. - (let ((delim (concat "^" message-unix-mail-delimiter)) - (marker (concat "\n" nnfolder-article-marker)) - (number "[0-9]+") - (active (or (cadr (assoc group nnfolder-group-alist)) - (cons 1 0))) - (scantime (assoc group nnfolder-scantime-alist)) - (minid (lsh -1 -1)) - maxid start end newscantime - buffer-read-only) - (buffer-disable-undo (current-buffer)) - (setq maxid (cdr active)) - (goto-char (point-min)) - - ;; Anytime the active number is 1 or 0, it is suspect. In that - ;; case, search the file manually to find the active number. Or, - ;; of course, if we're being paranoid. (This would also be the - ;; place to build other lists from the header markers, such as - ;; expunge lists, etc., if we ever desired to abandon the active - ;; file entirely for mboxes.) - (when (or nnfolder-ignore-active-file - (< maxid 2)) - (while (and (search-forward marker nil t) - (re-search-forward number nil t)) - (let ((newnum (string-to-number (match-string 0)))) - (setq maxid (max maxid newnum)) - (setq minid (min minid newnum)))) - (setcar active (max 1 (min minid maxid))) - (setcdr active (max maxid (cdr active))) - (goto-char (point-min))) - - ;; As long as we trust that the user will only insert unmarked mail - ;; at the end, go to the end and search backwards for the last - ;; marker. Find the start of that message, and begin to search for - ;; unmarked messages from there. - (when (not (or nnfolder-distrust-mbox - (< maxid 2))) - (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)))) - - ;; 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 - ;; cut down on the number of searches we do. - (unless (nnmail-search-unix-mail-delim) - (goto-char (point-max))) - (setq end (point-marker)) - (while (not (= end (point-max))) - (setq start (marker-position end)) - (goto-char end) - ;; There may be more than one "From " line, so we skip past - ;; them. - (while (looking-at delim) - (forward-line 1)) - (set-marker end (if (nnmail-search-unix-mail-delim) - (point) - (point-max))) - (goto-char start) - (when (not (search-forward marker end t)) - (narrow-to-region start end) - (nnmail-insert-lines) - (nnfolder-insert-newsgroup-line - (cons nil (nnfolder-active-number nnfolder-current-group))) - (widen))) - - (set-marker end nil) - ;; Make absolutely sure that the active list reflects reality! - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - ;; Set the scantime for this group. - (setq newscantime (visited-file-modtime)) - (if scantime - (setcdr scantime (list newscantime)) - (push (list nnfolder-current-group newscantime) - nnfolder-scantime-alist)) - (current-buffer)))))) - -;;;###autoload -(defun nnfolder-generate-active-file () - "Look for mbox folders in the nnfolder directory and make them into groups." - (interactive) - (nnmail-activate 'nnfolder) - (let ((files (directory-files nnfolder-directory)) - file) - (while (setq file (pop files)) - (when (and (not (backup-file-name-p file)) - (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)) - (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)))) - (message ""))) - -(defun nnfolder-group-pathname (group) - "Make pathname for GROUP." - (setq group (gnus-encode-coding-string group nnmail-pathname-coding-system)) - (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) - ;; If this file exists, we use it directly. - (if (or nnmail-use-long-file-names - (file-exists-p (concat dir group))) - (concat dir group) - ;; If not, we translate dots into slashes. - (concat dir (nnheader-replace-chars-in-string group ?. ?/))))) - -(defun nnfolder-save-buffer () - "Save the buffer." - (when (buffer-modified-p) - (gnus-run-hooks 'nnfolder-save-buffer-hook) - (gnus-make-directory (file-name-directory (buffer-file-name))) - (save-buffer))) - -(provide 'nnfolder) - -;;; nnfolder.el ends here diff --git a/lisp/nngateway.el b/lisp/nngateway.el deleted file mode 100644 index 6dd6361..0000000 --- a/lisp/nngateway.el +++ /dev/null @@ -1,82 +0,0 @@ -;;; nngateway.el --- posting news via mail gateways -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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: - -;;; Code: - -(require 'nnoo) -(require 'message) - -(nnoo-declare nngateway) - -(defvoo nngateway-address nil - "Address of the mail-to-news gateway.") - -(defvoo nngateway-header-transformation 'nngateway-simple-header-transformation - "Function to be called to rewrite the news headers into mail headers. -It is called narrowed to the headers to be transformed with one -parameter -- the gateway address.") - -;;; Interface functions - -(nnoo-define-basics nngateway) - -(deffoo nngateway-open-server (server &optional defs) - (if (nngateway-server-opened server) - t - (unless (assq 'nngateway-address defs) - (setq defs (append defs (list (list 'nngateway-address server))))) - (nnoo-change-server 'nngateway server defs))) - -(deffoo nngateway-request-post (&optional server) - (when (or (nngateway-server-opened server) - (nngateway-open-server server)) - ;; Rewrite the header. - (let ((buf (current-buffer))) - (nnheader-temp-write nil - (insert-buffer-substring buf) - (message-narrow-to-head) - (funcall nngateway-header-transformation nngateway-address) - (goto-char (point-max)) - (insert mail-header-separator "\n") - (widen) - (let (message-required-mail-headers) - (funcall message-send-mail-function)))))) - -;;; Internal functions - -(defun nngateway-simple-header-transformation (gateway) - "Transform the headers to use GATEWAY." - (let ((newsgroups (mail-fetch-field "newsgroups"))) - (message-remove-header "to") - (message-remove-header "cc") - (goto-char (point-min)) - (insert "To: " (nnheader-replace-chars-in-string newsgroups ?. ?-) - "@" gateway "\n"))) - -(nnoo-define-skeleton nngateway) - -(provide 'nngateway) - -;;; nngateway.el ends here diff --git a/lisp/nnheader.el b/lisp/nnheader.el deleted file mode 100644 index c16bdef..0000000 --- a/lisp/nnheader.el +++ /dev/null @@ -1,854 +0,0 @@ -;;; nnheader.el --- header access macros for Gnus and its backends -;; Copyright (C) 1987,88,89,90,93,94,95,96,97,98 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; Keywords: news - -;; 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: - -;; These macros may look very much like the ones in GNUS 4.1. They -;; are, in a way, but you should note that the indices they use have -;; been changed from the internal GNUS format to the NOV format. The -;; makes it possible to read headers from XOVER much faster. -;; -;; The format of a header is now: -;; [number subject from date id references chars lines xref] -;; -;; (That last entry is defined as "misc" in the NOV format, but Gnus -;; uses it for xrefs.) - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'mail-utils) - -(defvar nnheader-max-head-length 4096 - "*Max length of the head of articles.") - -(defvar nnheader-head-chop-length 2048 - "*Length of each read operation when trying to fetch HEAD headers.") - -(defvar nnheader-file-name-translation-alist nil - "*Alist that says how to translate characters in file names. -For instance, if \":\" is illegal as a file character in file names -on your system, you could say something like: - -\(setq nnheader-file-name-translation-alist '((?: . ?_)))") - -(eval-and-compile - (autoload 'nnmail-message-id "nnmail") - (autoload 'mail-position-on-field "sendmail") - (autoload 'message-remove-header "message") - (autoload 'cancel-function-timers "timers") - (autoload 'gnus-point-at-eol "gnus-util")) - -;;; Header access macros. - -(defmacro mail-header-number (header) - "Return article number in HEADER." - `(aref ,header 0)) - -(defmacro mail-header-set-number (header number) - "Set article number of HEADER to NUMBER." - `(aset ,header 0 ,number)) - -(defmacro mail-header-subject (header) - "Return subject string in HEADER." - `(aref ,header 1)) - -(defmacro mail-header-set-subject (header subject) - "Set article subject of HEADER to SUBJECT." - `(aset ,header 1 ,subject)) - -(defmacro mail-header-from (header) - "Return author string in HEADER." - `(aref ,header 2)) - -(defmacro mail-header-set-from (header from) - "Set article author of HEADER to FROM." - `(aset ,header 2 ,from)) - -(defmacro mail-header-date (header) - "Return date in HEADER." - `(aref ,header 3)) - -(defmacro mail-header-set-date (header date) - "Set article date of HEADER to DATE." - `(aset ,header 3 ,date)) - -(defalias 'mail-header-message-id 'mail-header-id) -(defmacro mail-header-id (header) - "Return Id in HEADER." - `(aref ,header 4)) - -(defalias 'mail-header-set-message-id 'mail-header-set-id) -(defmacro mail-header-set-id (header id) - "Set article Id of HEADER to ID." - `(aset ,header 4 ,id)) - -(defmacro mail-header-references (header) - "Return references in HEADER." - `(aref ,header 5)) - -(defmacro mail-header-set-references (header ref) - "Set article references of HEADER to REF." - `(aset ,header 5 ,ref)) - -(defmacro mail-header-chars (header) - "Return number of chars of article in HEADER." - `(aref ,header 6)) - -(defmacro mail-header-set-chars (header chars) - "Set number of chars in article of HEADER to CHARS." - `(aset ,header 6 ,chars)) - -(defmacro mail-header-lines (header) - "Return lines in HEADER." - `(aref ,header 7)) - -(defmacro mail-header-set-lines (header lines) - "Set article lines of HEADER to LINES." - `(aset ,header 7 ,lines)) - -(defmacro mail-header-xref (header) - "Return xref string in HEADER." - `(aref ,header 8)) - -(defmacro mail-header-set-xref (header xref) - "Set article xref of HEADER to xref." - `(aset ,header 8 ,xref)) - -(defun make-mail-header (&optional init) - "Create a new mail header structure initialized with INIT." - (make-vector 9 init)) - -(defun make-full-mail-header (&optional number subject from date id - references chars lines xref) - "Create a new mail header structure initialized with the parameters given." - (vector number subject from date id references chars lines xref)) - -;; fake message-ids: generation and detection - -(defvar nnheader-fake-message-id 1) - -(defsubst nnheader-generate-fake-message-id () - (concat "fake+none+" (int-to-string (incf nnheader-fake-message-id)))) - -(defsubst nnheader-fake-message-id-p (id) - (save-match-data ; regular message-id's are <.*> - (string-match "\\`fake\\+none\\+[0-9]+\\'" id))) - -;; Parsing headers and NOV lines. - -(defsubst nnheader-header-value () - (buffer-substring (match-end 0) (gnus-point-at-eol))) - -(defun nnheader-parse-head (&optional naked) - (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. - (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. - (vector - ;; 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 (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 "<[^>]+>" in-reply-to)) - (let (ref2) - (setq ref (substring in-reply-to (match-beginning 0) - (match-end 0))) - (while (string-match "<[^>]+>" 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)))) - ""))) - ;; 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))))) - (when naked - (goto-char (point-min)) - (delete-char 1))))) - -(defmacro nnheader-nov-skip-field () - '(search-forward "\t" eol 'move)) - -(defmacro nnheader-nov-field () - '(buffer-substring (point) (if (nnheader-nov-skip-field) (1- (point)) eol))) - -(defmacro nnheader-nov-read-integer () - '(prog1 - (if (= (following-char) ?\t) - 0 - (let ((num (ignore-errors (read (current-buffer))))) - (if (numberp num) num 0))) - (or (eobp) (forward-char 1)))) - -;; (defvar nnheader-none-counter 0) - -(defun nnheader-parse-nov () - (let ((eol (gnus-point-at-eol))) - (vector - (nnheader-nov-read-integer) ; number - (nnheader-nov-field) ; subject - (nnheader-nov-field) ; from - (nnheader-nov-field) ; date - (or (nnheader-nov-field) - (nnheader-generate-fake-message-id)) ; id - (nnheader-nov-field) ; refs - (nnheader-nov-read-integer) ; chars - (nnheader-nov-read-integer) ; lines - (if (= (following-char) ?\n) - nil - (nnheader-nov-field)) ; misc - ))) - -(defun nnheader-insert-nov (header) - (princ (mail-header-number header) (current-buffer)) - (insert - "\t" - (or (mail-header-subject header) "(none)") "\t" - (or (mail-header-from header) "(nobody)") "\t" - (or (mail-header-date header) "") "\t" - (or (mail-header-id header) - (nnmail-message-id)) - "\t" - (or (mail-header-references header) "") "\t") - (princ (or (mail-header-chars header) 0) (current-buffer)) - (insert "\t") - (princ (or (mail-header-lines header) 0) (current-buffer)) - (insert "\t") - (when (mail-header-xref header) - (insert "Xref: " (mail-header-xref header) "\t")) - (insert "\n")) - -(defun nnheader-insert-article-line (article) - (goto-char (point-min)) - (insert "220 ") - (princ article (current-buffer)) - (insert " Article retrieved.\n") - (search-forward "\n\n" nil 'move) - (delete-region (point) (point-max)) - (forward-char -1) - (insert ".")) - -(defun nnheader-nov-delete-outside-range (beg end) - "Delete all NOV lines that lie outside the BEG to END range." - ;; First we find the first wanted line. - (nnheader-find-nov-line beg) - (delete-region (point-min) (point)) - ;; Then we find the last wanted line. - (when (nnheader-find-nov-line end) - (forward-line 1)) - (delete-region (point) (point-max))) - -(defun nnheader-find-nov-line (article) - "Put point at the NOV line that start with ARTICLE. -If ARTICLE doesn't exist, put point where that line -would have been. The function will return non-nil if -the line could be found." - ;; This function basically does a binary search. - (let ((max (point-max)) - (min (goto-char (point-min))) - (cur (current-buffer)) - (prev (point-min)) - num found) - (while (not found) - (goto-char (/ (+ max min) 2)) - (beginning-of-line) - (if (or (= (point) prev) - (eobp)) - (setq found t) - (setq prev (point)) - (while (and (not (numberp (setq num (read cur)))) - (not (eobp))) - (gnus-delete-line)) - (cond ((> num article) - (setq max (point))) - ((< num article) - (setq min (point))) - (t - (setq found 'yes))))) - ;; We may be at the first line. - (when (and (not num) - (not (eobp))) - (setq num (read cur))) - ;; Now we may have found the article we're looking for, or we - ;; may be somewhere near it. - (when (and (not (eq found 'yes)) - (not (eq num article))) - (setq found (point)) - (while (and (< (point) max) - (or (not (numberp num)) - (< num article))) - (forward-line 1) - (setq found (point)) - (or (eobp) - (= (setq num (read cur)) article))) - (unless (eq num article) - (goto-char found))) - (beginning-of-line) - (eq num article))) - -;; Various cruft the backends and Gnus need to communicate. - -(defvar nntp-server-buffer 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) - -(defvar nnheader-callback-function nil) - -(defun nnheader-init-server-buffer () - "Initialize the Gnus-backend communication buffer." - (save-excursion - (unless (gnus-buffer-live-p nntp-server-buffer) - (setq nntp-server-buffer (get-buffer-create " *nntpd*"))) - (set-buffer nntp-server-buffer) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (kill-all-local-variables) - (setq case-fold-search t) ;Should ignore case. - t)) - -;;; Various functions the backends use. - -(defun nnheader-file-error (file) - "Return a string that says what is wrong with FILE." - (format - (cond - ((not (file-exists-p file)) - "%s does not exist") - ((file-directory-p file) - "%s is a directory") - ((not (file-readable-p file)) - "%s is not readable")) - file)) - -(defun nnheader-insert-head (file) - "Insert the head of the article." - (when (file-exists-p file) - (if (eq nnheader-max-head-length t) - ;; Just read the entire file. - (nnheader-insert-file-contents file) - ;; Read 1K blocks until we find a separator. - (let ((beg 0) - format-alist) - (while (and (eq nnheader-head-chop-length - (nth 1 (nnheader-insert-file-contents - file nil beg - (incf beg nnheader-head-chop-length)))) - (prog1 (not (search-forward "\n\n" nil t)) - (goto-char (point-max))) - (or (null nnheader-max-head-length) - (< beg nnheader-max-head-length)))))) - t)) - -(defun nnheader-article-p () - "Say whether the current buffer looks like an article." - (goto-char (point-min)) - (if (not (search-forward "\n\n" nil t)) - nil - (narrow-to-region (point-min) (1- (point))) - (goto-char (point-min)) - (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n") - (goto-char (match-end 0))) - (prog1 - (eobp) - (widen)))) - -(defun nnheader-insert-references (references message-id) - "Insert a References header based on REFERENCES and MESSAGE-ID." - (if (and (not references) (not message-id)) - () ; This is illegal, but not all articles have Message-IDs. - (mail-position-on-field "References") - (let ((begin (save-excursion (beginning-of-line) (point))) - (fill-column 78) - (fill-prefix "\t")) - (when references - (insert references)) - (when (and references message-id) - (insert " ")) - (when message-id - (insert message-id)) - ;; Fold long References lines to conform to RFC1036 (sort of). - ;; The region must end with a newline to fill the region - ;; without inserting extra newline. - (fill-region-as-paragraph begin (1+ (point)))))) - -(defun nnheader-replace-header (header new-value) - "Remove HEADER and insert the NEW-VALUE." - (save-excursion - (save-restriction - (nnheader-narrow-to-headers) - (prog1 - (message-remove-header header) - (goto-char (point-max)) - (insert header ": " new-value "\n"))))) - -(defun nnheader-narrow-to-headers () - "Narrow to the head of an article." - (widen) - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) - (goto-char (point-min))) - -(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)) - (buffer-disable-undo (current-buffer)) - (unless noerase - (erase-buffer)) - (current-buffer)) - -(defmacro nnheader-temp-write (file &rest forms) - "Create a new buffer, evaluate FORMS there, and write the buffer to FILE. -Return the value of FORMS. -If FILE is nil, just evaluate FORMS and don't save anything. -If FILE is t, return the buffer contents as a string." - (let ((temp-file (make-symbol "temp-file")) - (temp-buffer (make-symbol "temp-buffer")) - (temp-results (make-symbol "temp-results"))) - `(save-excursion - (let* ((,temp-file ,file) - (default-major-mode 'fundamental-mode) - (,temp-buffer - (set-buffer - (get-buffer-create - (generate-new-buffer-name " *nnheader temp*")))) - ,temp-results) - (unwind-protect - (progn - (setq ,temp-results (progn ,@forms)) - (cond - ;; Don't save anything. - ((null ,temp-file) - ,temp-results) - ;; Return the buffer contents. - ((eq ,temp-file t) - (set-buffer ,temp-buffer) - (buffer-string)) - ;; Save a file. - (t - (set-buffer ,temp-buffer) - ;; Make sure the directory where this file is - ;; to be saved exists. - (when (not (file-directory-p - (file-name-directory ,temp-file))) - (make-directory (file-name-directory ,temp-file) t)) - ;; Save the file. - (write-region (point-min) (point-max) - ,temp-file nil 'nomesg) - ,temp-results))) - ;; Kill the buffer. - (when (buffer-name ,temp-buffer) - (kill-buffer ,temp-buffer))))))) - -(put 'nnheader-temp-write 'lisp-indent-function 1) -(put 'nnheader-temp-write 'edebug-form-spec '(form body)) - -(defvar jka-compr-compression-info-list) -(defvar nnheader-numerical-files - (if (boundp 'jka-compr-compression-info-list) - (concat "\\([0-9]+\\)\\(" - (mapconcat (lambda (i) (aref i 0)) - jka-compr-compression-info-list "\\|") - "\\)?") - "[0-9]+$") - "Regexp that match numerical files.") - -(defvar nnheader-numerical-short-files (concat "^" nnheader-numerical-files) - "Regexp that matches numerical file names.") - -(defvar nnheader-numerical-full-files (concat "/" nnheader-numerical-files) - "Regexp that matches numerical full file paths.") - -(defsubst nnheader-file-to-number (file) - "Take a file name and return the article number." - (if (not (boundp 'jka-compr-compression-info-list)) - (string-to-int file) - (string-match nnheader-numerical-short-files file) - (string-to-int (match-string 0 file)))) - -(defun nnheader-directory-files-safe (&rest args) - ;; It has been reported numerous times that `directory-files' - ;; fails with an alarming frequency on NFS mounted file systems. - ;; This function executes that function twice and returns - ;; the longest result. - (let ((first (apply 'directory-files args)) - (second (apply 'directory-files args))) - (if (> (length first) (length second)) - first - second))) - -(defun nnheader-directory-articles (dir) - "Return a list of all article files in a directory." - (mapcar 'nnheader-file-to-number - (nnheader-directory-files-safe - dir nil nnheader-numerical-short-files t))) - -(defun nnheader-article-to-file-alist (dir) - "Return an alist of article/file pairs in DIR." - (mapcar (lambda (file) (cons (nnheader-file-to-number file) file)) - (nnheader-directory-files-safe - dir nil nnheader-numerical-short-files t))) - -(defun nnheader-fold-continuation-lines () - "Fold continuation lines in the current buffer." - (nnheader-replace-regexp "\\(\r?\n[ \t]+\\)+" " ")) - -(defun nnheader-translate-file-chars (file) - (if (null nnheader-file-name-translation-alist) - ;; No translation is necessary. - file - ;; We translate -- but only the file name. We leave the directory - ;; alone. - (let* ((i 0) - trans leaf path len) - (if (string-match "/[^/]+\\'" file) - ;; This is needed on NT's and stuff. - (setq leaf (substring file (1+ (match-beginning 0))) - path (substring file 0 (1+ (match-beginning 0)))) - ;; Fall back on this. - (setq leaf (file-name-nondirectory file) - path (file-name-directory file))) - (setq len (length leaf)) - (while (< i len) - (when (setq trans (cdr (assq (aref leaf i) - nnheader-file-name-translation-alist))) - (aset leaf i trans)) - (incf i)) - (concat path leaf)))) - -(defun nnheader-report (backend &rest args) - "Report an error from the BACKEND. -The first string in ARGS can be a format string." - (set (intern (format "%s-status-string" backend)) - (if (< (length args) 2) - (car args) - (apply 'format args))) - nil) - -(defun nnheader-get-report (backend) - "Get the most recent report from BACKEND." - (condition-case () - (message "%s" (symbol-value (intern (format "%s-status-string" - backend)))) - (error (message "")))) - -(defun nnheader-insert (format &rest args) - "Clear the communication buffer and insert FORMAT and ARGS into the buffer. -If FORMAT isn't a format string, it and all ARGS will be inserted -without formatting." - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if (string-match "%" format) - (insert (apply 'format format args)) - (apply 'insert format args)) - t)) - -(defun nnheader-replace-chars-in-string (string from to) - "Replace characters in STRING from FROM to TO." - (let ((string (substring string 0)) ;Copy string. - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (when (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string)) - -(defun nnheader-file-to-group (file &optional top) - "Return a group name based on FILE and TOP." - (nnheader-replace-chars-in-string - (if (not top) - file - (condition-case () - (substring (expand-file-name file) - (length - (expand-file-name - (file-name-as-directory top)))) - (error ""))) - ?/ ?.)) - -(defun nnheader-message (level &rest args) - "Message if the Gnus backends are talkative." - (if (or (not (numberp gnus-verbose-backends)) - (<= level gnus-verbose-backends)) - (apply 'message args) - (apply 'format args))) - -(defun nnheader-be-verbose (level) - "Return whether the backends should be verbose on LEVEL." - (or (not (numberp gnus-verbose-backends)) - (<= level gnus-verbose-backends))) - -(defvar nnheader-pathname-coding-system 'iso-8859-1 - "*Coding system for pathname.") - -(defun nnheader-group-pathname (group dir &optional file) - "Make pathname for GROUP." - (concat - (let ((dir (file-name-as-directory (expand-file-name dir)))) - ;; If this directory exists, we use it directly. - (if (file-directory-p (concat dir group)) - (concat dir group "/") - ;; If not, we translate dots into slashes. - (concat dir - (gnus-encode-coding-string - (nnheader-replace-chars-in-string group ?. ?/) - nnheader-pathname-coding-system) - "/"))) - (cond ((null file) "") - ((numberp file) (int-to-string file)) - (t file)))) - -(defun nnheader-functionp (form) - "Return non-nil if FORM is funcallable." - (or (and (symbolp form) (fboundp form)) - (and (listp form) (eq (car form) 'lambda)))) - -(defun nnheader-concat (dir &rest files) - "Concat DIR as directory to FILE." - (apply 'concat (file-name-as-directory dir) files)) - -(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)))) - -(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. -If FILE, find the \".../etc/PACKAGE\" file instead." - (let ((path load-path) - dir result) - ;; We try to find the dir by looking at the load path, - ;; stripping away the last component and adding "etc/". - (while path - (if (and (car path) - (file-exists-p - (setq dir (concat - (file-name-directory - (directory-file-name (car path))) - "etc/" package - (if file "" "/")))) - (or file (file-directory-p dir))) - (setq result dir - path nil) - (setq path (cdr path)))) - result)) - -(defvar ange-ftp-path-format) -(defvar efs-path-regexp) -(defun nnheader-re-read-dir (path) - "Re-read directory PATH if PATH is on a remote system." - (if (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp)) - (when (string-match efs-path-regexp path) - (efs-re-read-dir path)) - (when (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format)) - (when (string-match (car ange-ftp-path-format) path) - (ange-ftp-re-read-dir path))))) - -(defvar nnheader-file-coding-system 'raw-text - "Coding system used in file backends of Gnus.") - -(defun nnheader-insert-file-contents (filename &optional visit beg end replace) - "Like `insert-file-contents', q.v., but only reads in the file. -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. - This function ensures that none of these modifications will take place." - (let ((format-alist nil) - (auto-mode-alist (nnheader-auto-mode-alist)) - (default-major-mode 'fundamental-mode) - (after-insert-file-functions nil) - (coding-system-for-read nnheader-file-coding-system)) - (insert-file-contents filename visit beg end replace))) - -(defun nnheader-find-file-noselect (&rest args) - (let ((format-alist nil) - (auto-mode-alist (nnheader-auto-mode-alist)) - (default-major-mode 'fundamental-mode) - (enable-local-variables nil) - (after-insert-file-functions nil) - (coding-system-for-read nnheader-file-coding-system)) - (apply 'find-file-noselect args))) - -(defun nnheader-auto-mode-alist () - "Return an `auto-mode-alist' with only the .gz (etc) thingies." - (let ((alist auto-mode-alist) - out) - (while alist - (when (listp (cdar alist)) - (push (car alist) out)) - (pop alist)) - (nreverse out))) - -(defun nnheader-directory-regular-files (dir) - "Return a list of all regular files in DIR." - (let ((files (directory-files dir t)) - out) - (while files - (when (file-regular-p (car files)) - (push (car files) out)) - (pop files)) - (nreverse out))) - -(defun nnheader-directory-files (&rest args) - "Same as `directory-files', but prune \".\" and \"..\"." - (let ((files (apply 'directory-files args)) - out) - (while files - (unless (member (file-name-nondirectory (car files)) '("." "..")) - (push (car files) out)) - (pop files)) - (nreverse out))) - -(defmacro nnheader-skeleton-replace (from &optional to regexp) - `(let ((new (generate-new-buffer " *nnheader replace*")) - (cur (current-buffer)) - (start (point-min))) - (set-buffer new) - (buffer-disable-undo (current-buffer)) - (set-buffer cur) - (goto-char (point-min)) - (while (,(if regexp 're-search-forward 'search-forward) - ,from nil t) - (insert-buffer-substring - cur start (prog1 (match-beginning 0) (set-buffer new))) - (goto-char (point-max)) - ,(when to `(insert ,to)) - (set-buffer cur) - (setq start (point))) - (insert-buffer-substring - cur start (prog1 (point-max) (set-buffer new))) - (copy-to-buffer cur (point-min) (point-max)) - (kill-buffer (current-buffer)) - (set-buffer cur))) - -(defun nnheader-replace-string (from to) - "Do a fast replacement of FROM to TO from point to point-max." - (nnheader-skeleton-replace from to)) - -(defun nnheader-replace-regexp (from to) - "Do a fast regexp replacement of FROM to TO from point to point-max." - (nnheader-skeleton-replace from to t)) - -(defun nnheader-strip-cr () - "Strip all \r's from the current buffer." - (nnheader-skeleton-replace "\r")) - -(fset 'nnheader-run-at-time 'run-at-time) -(fset 'nnheader-cancel-timer 'cancel-timer) -(fset 'nnheader-cancel-function-timers 'cancel-function-timers) - -(when (string-match "XEmacs\\|Lucid" emacs-version) - (require 'nnheaderxm)) - -(run-hooks 'nnheader-load-hook) - -(provide 'nnheader) - -;;; nnheader.el ends here diff --git a/lisp/nnheaderxm.el b/lisp/nnheaderxm.el deleted file mode 100644 index 869ed69..0000000 --- a/lisp/nnheaderxm.el +++ /dev/null @@ -1,41 +0,0 @@ -;;; nnheaderxm.el --- making Gnus backends work under XEmacs -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(defun nnheader-xmas-run-at-time (time repeat function &rest args) - (start-itimer - "nnheader-run-at-time" - `(lambda () - (,function ,@args)) - time repeat)) - -(fset 'nnheader-run-at-time 'nnheader-xmas-run-at-time) -(fset 'nnheader-cancel-timer 'delete-itimer) -(fset 'nnheader-cancel-function-timers 'ignore) - -(provide 'nnheaderxm) - -;;; nnheaderxm.el ends here. diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el deleted file mode 100644 index 54c3ee0..0000000 --- a/lisp/nnkiboze.el +++ /dev/null @@ -1,356 +0,0 @@ -;;; nnkiboze.el --- select virtual news access for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; The other access methods (nntp, nnspool, etc) are general news -;; access methods. This module relies on Gnus and can't be used -;; separately. - -;;; Code: - -(require 'nntp) -(require 'nnheader) -(require 'gnus) -(require 'gnus-score) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnkiboze) -(defvoo nnkiboze-directory (nnheader-concat gnus-directory "kiboze/") - "nnkiboze will put its files in this directory.") - -(defvoo nnkiboze-level 9 - "The maximum level to be searched for articles.") - -(defvoo nnkiboze-remove-read-articles t - "If non-nil, nnkiboze will remove read articles from the kiboze group.") - -(defvoo nnkiboze-ephemeral nil - "If non-nil, don't store any data anywhere.") - -(defvoo nnkiboze-scores nil - "Score rules for generating the nnkiboze group.") - -(defvoo nnkiboze-regexp nil - "Regexp for matching component groups.") - - - -(defconst nnkiboze-version "nnkiboze 1.0") - -(defvoo nnkiboze-current-group nil) -(defvoo nnkiboze-status-string "") - -(defvoo nnkiboze-headers nil) - - - -;;; Interface functions. - -(nnoo-define-basics nnkiboze) - -(deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old) - (nnkiboze-possibly-change-group group) - (unless gnus-nov-is-evil - (if (stringp (car articles)) - 'headers - (let ((nov (nnkiboze-nov-file-name))) - (when (file-exists-p nov) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (nnheader-insert-file-contents nov) - (nnheader-nov-delete-outside-range - (car articles) (car (last articles))) - 'nov)))))) - -(deffoo nnkiboze-request-article (article &optional newsgroup server buffer) - (nnkiboze-possibly-change-group newsgroup) - (if (not (numberp article)) - ;; This is a real kludge. It might not work at times, but it - ;; does no harm I think. The only alternative is to offer no - ;; article fetching by message-id at all. - (nntp-request-article article newsgroup gnus-nntp-server buffer) - (let* ((header (gnus-summary-article-header article)) - (xref (mail-header-xref header))) - (unless xref - (error "nnkiboze: No xref")) - (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref) - (error "nnkiboze: Malformed xref")) - (gnus-request-article (string-to-int (match-string 2 xref)) - (match-string 1 xref) - buffer)))) - -(deffoo nnkiboze-request-scan (&optional group server) - (nnkiboze-generate-group (concat "nnkiboze:" group))) - -(deffoo nnkiboze-request-group (group &optional server dont-check) - "Make GROUP the current newsgroup." - (nnkiboze-possibly-change-group group) - (if dont-check - t - (let ((nov-file (nnkiboze-nov-file-name)) - beg end total) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if (not (file-exists-p nov-file)) - (nnheader-report 'nnkiboze "Can't select group %s" group) - (nnheader-insert-file-contents nov-file) - (if (zerop (buffer-size)) - (nnheader-insert "211 0 0 0 %s\n" group) - (goto-char (point-min)) - (when (looking-at "[0-9]+") - (setq beg (read (current-buffer)))) - (goto-char (point-max)) - (when (re-search-backward "^[0-9]" nil t) - (setq end (read (current-buffer)))) - (setq total (count-lines (point-min) (point-max))) - (nnheader-insert "211 %d %d %d %s\n" total beg end group))))))) - -(deffoo nnkiboze-close-group (group &optional server) - (nnkiboze-possibly-change-group group) - ;; Remove NOV lines of articles that are marked as read. - (when (and (file-exists-p (nnkiboze-nov-file-name)) - nnkiboze-remove-read-articles) - (nnheader-temp-write (nnkiboze-nov-file-name) - (let ((cur (current-buffer))) - (nnheader-insert-file-contents (nnkiboze-nov-file-name)) - (goto-char (point-min)) - (while (not (eobp)) - (if (not (gnus-article-read-p (read cur))) - (forward-line 1) - (gnus-delete-line)))))) - (setq nnkiboze-current-group nil)) - -(deffoo nnkiboze-open-server (server &optional defs) - (unless (assq 'nnkiboze-regexp defs) - (push `(nnkiboze-regexp ,server) - defs)) - (nnoo-change-server 'nnkiboze server defs)) - -(deffoo nnkiboze-request-delete-group (group &optional force server) - (nnkiboze-possibly-change-group group) - (when force - (let ((files (list (nnkiboze-nov-file-name) - (concat nnkiboze-directory - (nnheader-translate-file-chars - (concat group ".newsrc"))) - (nnkiboze-score-file group)))) - (while files - (and (file-exists-p (car files)) - (file-writable-p (car files)) - (delete-file (car files))) - (setq files (cdr files))))) - (setq nnkiboze-current-group nil)) - -(nnoo-define-skeleton nnkiboze) - - -;;; Internal functions. - -(defun nnkiboze-possibly-change-group (group) - (setq nnkiboze-current-group group)) - -(defun nnkiboze-prefixed-name (group) - (gnus-group-prefixed-name group '(nnkiboze ""))) - -;;;###autoload -(defun nnkiboze-generate-groups () - "Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups -Finds out what articles are to be part of the nnkiboze groups." - (interactive) - (let ((nnmail-spool-file nil) - (gnus-use-dribble-file nil) - (gnus-read-active-file t) - (gnus-expert-user t)) - (gnus)) - (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist)) - (newsrc (cdr gnus-newsrc-alist)) - gnus-newsrc-hashtb info) - (gnus-make-hashtable-from-newsrc-alist) - ;; We have copied all the newsrc alist info over to local copies - ;; so that we can mess all we want with these lists. - (while (setq info (pop newsrc)) - (when (string-match "nnkiboze" (gnus-info-group info)) - ;; For each kiboze group, we call this function to generate - ;; it. - (nnkiboze-generate-group (gnus-info-group info)))))) - -(defun nnkiboze-score-file (group) - (list (expand-file-name - (concat (file-name-as-directory gnus-kill-files-directory) - (nnheader-translate-file-chars - (concat (nnkiboze-prefixed-name nnkiboze-current-group) - "." gnus-score-file-suffix)))))) - -(defun nnkiboze-generate-group (group) - (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) - (newsrc-file (concat nnkiboze-directory - (nnheader-translate-file-chars - (concat group ".newsrc")))) - (nov-file (concat nnkiboze-directory - (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. - (gnus-expert-user t) - (gnus-large-newsgroup nil) - (gnus-score-find-score-files-function 'nnkiboze-score-file) - (gnus-verbose (min gnus-verbose 3)) - gnus-select-group-hook gnus-summary-prepare-hook - gnus-thread-sort-functions gnus-show-threads - gnus-visual gnus-suppress-duplicates) - (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)) - (nnheader-temp-write nov-file - (when (file-exists-p nov-file) - (insert-file-contents nov-file)) - (setq nov-buffer (current-buffer)) - ;; Go through the active hashtb and add new all groups that match the - ;; 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)) - (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. - (gnus-summary-exit-no-update))) - ;; Restore the proper info. - (when ginfo - (setcdr ginfo (cdr orig-info))))) - (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. - (nnheader-temp-write newsrc-file - (insert "(setq nnkiboze-newsrc '") - (gnus-prin1 nnkiboze-newsrc) - (insert ")\n")) - t)) - -(defun nnkiboze-enter-nov (buffer header group) - (save-excursion - (set-buffer buffer) - (goto-char (point-max)) - (let ((xref (mail-header-xref header)) - (prefix (gnus-group-real-prefix group)) - (oheader (copy-sequence header)) - (first t) - article) - (if (zerop (forward-line -1)) - (progn - (setq article (1+ (read (current-buffer)))) - (forward-line 1)) - (setq article 1)) - (mail-header-set-number oheader article) - (nnheader-insert-nov oheader) - (search-backward "\t" nil t 2) - (if (re-search-forward " [^ ]+:[0-9]+" nil t) - (goto-char (match-beginning 0)) - (forward-char 1)) - ;; The first Xref has to be the group this article - ;; really came for - this is the article nnkiboze - ;; will request when it is asked for the article. - (insert group ":" - (int-to-string (mail-header-number header)) " ") - (while (re-search-forward " [^ ]+:[0-9]+" nil t) - (goto-char (1+ (match-beginning 0))) - (insert prefix))))) - -(defun nnkiboze-nov-file-name () - (concat (file-name-as-directory nnkiboze-directory) - (nnheader-translate-file-chars - (concat (nnkiboze-prefixed-name nnkiboze-current-group) ".nov")))) - -(provide 'nnkiboze) - -;;; nnkiboze.el ends here diff --git a/lisp/nnlistserv.el b/lisp/nnlistserv.el deleted file mode 100644 index e74b6a2..0000000 --- a/lisp/nnlistserv.el +++ /dev/null @@ -1,156 +0,0 @@ -;;; nnlistserv.el --- retrieving articles via web mailing list archives -;; Copyright (C) 1997,98 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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: - -;; Note: You need to have `url' and `w3' installed for this -;; backend to work. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(push '("nnlistserv" none) gnus-valid-select-methods) - -(require 'nnoo) -(require 'nnweb) - -(nnoo-declare nnlistserv - nnweb) - -(defvoo nnlistserv-directory (nnheader-concat gnus-directory "nnlistserv/") - "Where nnlistserv will save its files." - nnweb-directory) - -(defvoo nnlistserv-name 'kk - "What search engine type is being used." - nnweb-type) - -(defvoo nnlistserv-type-definition - '((kk - (article . nnlistserv-kk-wash-article) - (map . nnlistserv-kk-create-mapping) - (search . nnlistserv-kk-search) - (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/") - (pages "fra160396" "fra160796" "fra061196" "fra160197" - "fra090997" "fra040797" "fra130397" "nye") - (index . "date.html") - (identifier . nnlistserv-kk-identity))) - "Type-definition alist." - nnweb-type-definition) - -(defvoo nnlistserv-search nil - "Search string to feed to DejaNews." - nnweb-search) - -(defvoo nnlistserv-ephemeral-p nil - "Whether this nnlistserv server is ephemeral." - nnweb-ephemeral-p) - -;;; Internal variables - -;;; Interface functions - -(nnoo-define-basics nnlistserv) - -(nnoo-import nnlistserv - (nnweb)) - -;;; Internal functions - -;;; -;;; KK functions. -;;; - -(defun nnlistserv-kk-create-mapping () - "Perform the search and create an number-to-url alist." - (save-excursion - (set-buffer nnweb-buffer) - (let ((case-fold-search t) - (active (or (cadr (assoc nnweb-group nnweb-group-alist)) - (cons 1 0))) - (pages (nnweb-definition 'pages)) - map url page subject from ) - (while (setq page (pop pages)) - (erase-buffer) - (when (funcall (nnweb-definition 'search) page) - ;; Go through all the article hits on this page. - (goto-char (point-min)) - (nnweb-decode-entities) - (goto-char (point-min)) - (while (re-search-forward "^
  • *\\([^\\>]+\\) *<[^>]+>\\([^>]+\\)<" nil t) - (setq url (match-string 1) - subject (match-string 2) - from (match-string 3)) - (setq url (concat (format (nnweb-definition 'address) page) url)) - (unless (nnweb-get-hashtb url) - (push - (list - (incf (cdr active)) - (make-full-mail-header - (cdr active) subject from "" - (concat "<" (nnweb-identifier url) "@kk>") - nil 0 0 url)) - map) - (nnweb-set-hashtb (cadar map) (car map)) - (message "%s %s %s" (cdr active) (point) pages) - )))) - ;; Return the articles in the right order. - (setq nnweb-articles - (sort (nconc nnweb-articles map) 'car-less-than-car))))) - -(defun nnlistserv-kk-wash-article () - (let ((case-fold-search t) - (headers '(sent name email subject id)) - sent name email subject id) - (nnweb-decode-entities) - (while headers - (goto-char (point-min)) - (re-search-forward (format "" nil t) - (point-max)))) - (goto-char (point-min)) - (while (re-search-forward "<[^>]+>" nil t) - (replace-match "" t t))) - -;;; -;;; DejaNews functions. -;;; - -(defun nnweb-dejanews-create-mapping () - "Perform the search and create an number-to-url alist." - (save-excursion - (set-buffer nnweb-buffer) - (erase-buffer) - (when (funcall (nnweb-definition 'search) nnweb-search) - (let ((i 0) - (more t) - (case-fold-search t) - (active (or (cadr (assoc nnweb-group nnweb-group-alist)) - (cons 1 0))) - Subject Score Date Newsgroup Author - map url) - (while more - ;; Go through all the article hits on this page. - (goto-char (point-min)) - (nnweb-decode-entities) - (goto-char (point-min)) - (while (re-search-forward "^ +[0-9]+\\." nil t) - (narrow-to-region - (point) - (cond ((re-search-forward "^ +[0-9]+\\." nil t) - (match-beginning 0)) - ((search-forward "\n\n" nil t) - (point)) - (t - (point-max)))) - (goto-char (point-min)) - (when (looking-at ".*HREF=\"\\([^\"]+\\)\"") - (setq url (match-string 1))) - (nnweb-remove-markup) - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (replace-match " ")) - (goto-char (point-min)) - (while (re-search-forward "^ +\\([^:]+\\): +\\(.*\\)$" nil t) - (set (intern (match-string 1)) (match-string 2))) - (widen) - (when (string-match "#[0-9]+/[0-9]+ *$" Subject) - (setq Subject (substring Subject 0 (match-beginning 0)))) - (incf i) - (unless (nnweb-get-hashtb url) - (push - (list - (incf (cdr active)) - (make-full-mail-header - (cdr active) (concat "(" Newsgroup ") " Subject) Author Date - (concat "<" (nnweb-identifier url) "@dejanews>") - nil 0 (string-to-int Score) url)) - map) - (nnweb-set-hashtb (cadar map) (car map)))) - ;; See whether there is a "Get next 20 hits" button here. - (if (or (not (re-search-forward - "HREF=\"\\([^\"]+\\)\">Get next" nil t)) - (>= i nnweb-max-hits)) - (setq more nil) - ;; Yup -- fetch it. - (setq more (match-string 1)) - (erase-buffer) - (url-insert-file-contents more))) - ;; Return the articles in the right order. - (setq nnweb-articles - (sort (nconc nnweb-articles map) 'car-less-than-car)))))) - -(defun nnweb-dejanews-wash-article () - (let ((case-fold-search t)) - (goto-char (point-min)) - (re-search-forward "
    " nil t)
-    (delete-region (point-min) (point))
-    (re-search-forward "
    " nil t) - (delete-region (point) (point-max)) - (nnweb-remove-markup) - (goto-char (point-min)) - (while (and (looking-at " *$") - (not (eobp))) - (gnus-delete-line)) - (while (looking-at "\\(^[^ ]+:\\) *") - (replace-match "\\1 " t) - (forward-line 1)) - (when (re-search-forward "\n\n+" nil t) - (replace-match "\n" t t)) - (goto-char (point-min)) - (when (search-forward "[More Headers]" nil t) - (replace-match "" t t)))) - -(defun nnweb-dejanews-search (search) - (nnweb-fetch-form - (nnweb-definition 'address) - `(("query" . ,search) - ("defaultOp" . "AND") - ("svcclass" . "dncurrent") - ("maxhits" . "100") - ("format" . "verbose") - ("threaded" . "0") - ("showsort" . "score") - ("agesign" . "1") - ("ageweight" . "1"))) - t) - -(defun nnweb-dejanewsold-search (search) - (nnweb-fetch-form - (nnweb-definition 'address) - `(("query" . ,search) - ("defaultOp" . "AND") - ("svcclass" . "dnold") - ("maxhits" . "100") - ("format" . "verbose") - ("threaded" . "0") - ("showsort" . "score") - ("agesign" . "1") - ("ageweight" . "1"))) - t) - -(defun nnweb-dejanews-identity (url) - "Return an unique identifier based on URL." - (if (string-match "recnum=\\([0-9]+\\)" url) - (match-string 1 url) - url)) - -;;; -;;; InReference -;;; - -(defun nnweb-reference-create-mapping () - "Perform the search and create an number-to-url alist." - (save-excursion - (set-buffer nnweb-buffer) - (erase-buffer) - (when (funcall (nnweb-definition 'search) nnweb-search) - (let ((i 0) - (more t) - (case-fold-search t) - (active (or (cadr (assoc nnweb-group nnweb-group-alist)) - (cons 1 0))) - Subject Score Date Newsgroups From Message-ID - map url) - (while more - ;; Go through all the article hits on this page. - (goto-char (point-min)) - (search-forward "
    " nil t) - (delete-region (point-min) (point)) - ;(nnweb-decode-entities) - (goto-char (point-min)) - (while (re-search-forward "^ +[0-9]+\\." nil t) - (narrow-to-region - (point) - (if (re-search-forward "^$" nil t) - (match-beginning 0) - (point-max))) - (goto-char (point-min)) - (when (looking-at ".*href=\"\\([^\"]+\\)\"") - (setq url (match-string 1))) - (nnweb-remove-markup) - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (replace-match " ")) - (goto-char (point-min)) - (while (re-search-forward "^\\([^:]+\\): \\(.*\\)$" nil t) - (set (intern (match-string 1)) (match-string 2))) - (widen) - (search-forward "" nil t) - (incf i) - (unless (nnweb-get-hashtb url) - (push - (list - (incf (cdr active)) - (make-full-mail-header - (cdr active) (concat "(" Newsgroups ") " Subject) From Date - Message-ID - nil 0 (string-to-int Score) url)) - map) - (nnweb-set-hashtb (cadar map) (car map)))) - (setq more nil)) - ;; Return the articles in the right order. - (setq nnweb-articles - (sort (nconc nnweb-articles map) 'car-less-than-car)))))) - -(defun nnweb-reference-wash-article () - (let ((case-fold-search t)) - (goto-char (point-min)) - (re-search-forward "^
    " nil t) - (delete-region (point-min) (point)) - (search-forward "
    " nil t)
-    (forward-line -1)
-    (let ((body (point-marker)))
-      (search-forward "
    " nil t) - (delete-region (point) (point-max)) - (nnweb-remove-markup) - (goto-char (point-min)) - (while (looking-at " *$") - (gnus-delete-line)) - (narrow-to-region (point-min) body) - (while (and (re-search-forward "^$" nil t) - (not (eobp))) - (gnus-delete-line)) - (goto-char (point-min)) - (while (looking-at "\\(^[^ ]+:\\) *") - (replace-match "\\1 " t) - (forward-line 1)) - (goto-char (point-min)) - (when (re-search-forward "^References:" nil t) - (narrow-to-region - (point) (if (re-search-forward "^$\\|^[^:]+:" nil t) - (match-beginning 0) - (point-max))) - (goto-char (point-min)) - (while (not (eobp)) - (unless (looking-at "References") - (insert "\t") - (forward-line 1))) - (goto-char (point-min)) - (while (search-forward "," nil t) - (replace-match " " t t))) - (widen) - (set-marker body nil)))) - -(defun nnweb-reference-search (search) - (url-insert-file-contents - (concat - (nnweb-definition 'address) - "?" - (nnweb-encode-www-form-urlencoded - `(("search" . "advanced") - ("querytext" . ,search) - ("subj" . "") - ("name" . "") - ("login" . "") - ("host" . "") - ("organization" . "") - ("groups" . "") - ("keywords" . "") - ("choice" . "Search") - ("startmonth" . "Jul") - ("startday" . "25") - ("startyear" . "1996") - ("endmonth" . "Aug") - ("endday" . "24") - ("endyear" . "1996") - ("mode" . "Quick") - ("verbosity" . "Verbose") - ("ranking" . "Relevance") - ("first" . "1") - ("last" . "25") - ("score" . "50"))))) - (setq buffer-file-name nil) - t) - -;;; -;;; Alta Vista -;;; - -(defun nnweb-altavista-create-mapping () - "Perform the search and create an number-to-url alist." - (save-excursion - (set-buffer nnweb-buffer) - (erase-buffer) - (let ((part 0)) - (when (funcall (nnweb-definition 'search) nnweb-search part) - (let ((i 0) - (more t) - (case-fold-search t) - (active (or (cadr (assoc nnweb-group nnweb-group-alist)) - (cons 1 0))) - subject date from id group - map url) - (while more - ;; Go through all the article hits on this page. - (goto-char (point-min)) - (search-forward "
    " nil t) - (delete-region (point-min) (match-beginning 0)) - (goto-char (point-min)) - (while (search-forward "
    " nil t) - (replace-match "\n")) - (nnweb-decode-entities) - (goto-char (point-min)) - (while (re-search-forward ".*href=\"\\([^\"]+\\)\">\\([^>]*\\)
    \\([^-]+\\)- \\([^<]+\\)<.*href=\"news:\\([^\"]+\\)\">.*\">\\(.+\\)

    " - nil t) - (setq url (match-string 1) - subject (match-string 2) - date (match-string 3) - group (match-string 4) - id (concat "<" (match-string 5) ">") - from (match-string 6)) - (incf i) - (unless (nnweb-get-hashtb url) - (push - (list - (incf (cdr active)) - (make-full-mail-header - (cdr active) (concat "(" group ") " subject) from date - id nil 0 0 url)) - map) - (nnweb-set-hashtb (cadar map) (car map)))) - ;; See if we want more. - (when (or (not nnweb-articles) - (>= i nnweb-max-hits) - (not (funcall (nnweb-definition 'search) - nnweb-search (incf part)))) - (setq more nil))) - ;; Return the articles in the right order. - (setq nnweb-articles - (sort (nconc nnweb-articles map) 'car-less-than-car))))))) - -(defun nnweb-altavista-wash-article () - (goto-char (point-min)) - (let ((case-fold-search t)) - (when (re-search-forward "^" nil t) - (delete-region (point-min) (match-beginning 0))) - (goto-char (point-min)) - (while (looking-at "\\([^ ]+\\) + +\\(.*\\)$") - (replace-match "\\1: \\2" t) - (forward-line 1)) - (when (re-search-backward "^References:" nil t) - (narrow-to-region (point) (progn (forward-line 1) (point))) - (goto-char (point-min)) - (while (re-search-forward "[0-9]+" nil t) - (replace-match "<\\1> " t))) - (widen) - (nnweb-remove-markup))) - -(defun nnweb-altavista-search (search &optional part) - (url-insert-file-contents - (concat - (nnweb-definition 'address) - "?" - (nnweb-encode-www-form-urlencoded - `(("pg" . "aq") - ("what" . "news") - ,@(when part `(("stq" . ,(int-to-string (* part 30))))) - ("fmt" . "d") - ("q" . ,search) - ("r" . "") - ("d0" . "") - ("d1" . ""))))) - (setq buffer-file-name nil) - t) - -(provide 'nnweb) - -;;; nnweb.el ends here diff --git a/lisp/parse-time.el b/lisp/parse-time.el deleted file mode 100644 index e25abbb..0000000 --- a/lisp/parse-time.el +++ /dev/null @@ -1,199 +0,0 @@ -;;; parse-time.el --- Parsing time strings - -;; Copyright (C) 1996 by Free Software Foundation, Inc. - -;; Author: Erik Naggum -;; Keywords: util - -;; 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: - -;; With the introduction of the `encode-time', `decode-time', and -;; `format-time-string' functions, dealing with time became simpler in -;; Emacs. However, parsing time strings is still largely a matter of -;; heuristics and no common interface has been designed. - -;; `parse-time-string' parses a time in a string and returns a list of 9 -;; values, just like `decode-time', where unspecified elements in the -;; string are returned as nil. `encode-time' may be applied on these -;; valuse to obtain an internal time value. - -;;; Code: - -(eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it - -(put 'parse-time-syntax 'char-table-extra-slots 0) - -(defvar parse-time-syntax (make-char-table 'parse-time-syntax)) -(defvar parse-time-digits (make-char-table 'parse-time-syntax)) - -;; Byte-compiler warnings -(defvar elt) -(defvar val) - -(unless (aref parse-time-digits ?0) - (loop for i from ?0 to ?9 - do (set-char-table-range parse-time-digits i (- i ?0)))) - -(unless (aref parse-time-syntax ?0) - (loop for i from ?0 to ?9 - do (set-char-table-range parse-time-syntax i ?0)) - (loop for i from ?A to ?Z - do (set-char-table-range parse-time-syntax i ?A)) - (loop for i from ?a to ?z - do (set-char-table-range parse-time-syntax i ?a)) - (set-char-table-range parse-time-syntax ?+ 1) - (set-char-table-range parse-time-syntax ?- -1) - (set-char-table-range parse-time-syntax ?: ?d) - ) - -(defsubst digit-char-p (char) - (aref parse-time-digits char)) - -(defsubst parse-time-string-chars (char) - (aref parse-time-syntax char)) - -(put 'parse-error 'error-conditions '(parse-error error)) -(put 'parse-error 'error-message "Parsing error") - -(defsubst parse-integer (string &optional start end) - "[CL] Parse and return the integer in STRING, or nil if none." - (let ((integer 0) - (digit 0) - (index (or start 0)) - (end (or end (length string)))) - (when (< index end) - (let ((sign (aref string index))) - (if (or (eq sign ?+) (eq sign ?-)) - (setq sign (parse-time-string-chars sign) - index (1+ index)) - (setq sign 1)) - (while (and (< index end) - (setq digit (digit-char-p (aref string index)))) - (setq integer (+ (* integer 10) digit) - index (1+ index))) - (if (/= index end) - (signal 'parse-error `("not an integer" ,(substring string (or start 0) end))) - (* sign integer)))))) - -(defun parse-time-tokenize (string) - "Tokenize STRING into substrings." - (let ((start nil) - (end (length string)) - (all-digits nil) - (list ()) - (index 0) - (c nil)) - (while (< index end) - (while (and (< index end) ;skip invalid characters - (not (setq c (parse-time-string-chars (aref string index))))) - (incf index)) - (setq start index all-digits (eq c ?0)) - (while (and (< (incf index) end) ;scan valid characters - (setq c (parse-time-string-chars (aref string index)))) - (setq all-digits (and all-digits (eq c ?0)))) - (if (<= index end) - (push (if all-digits (parse-integer string start index) - (substring string start index)) - list))) - (nreverse list))) - -(defvar parse-time-months '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) - ("Apr" . 4) ("May" . 5) ("Jun" . 6) - ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) - ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))) -(defvar parse-time-weekdays '(("Sun" . 0) ("Mon" . 1) ("Tue" . 2) - ("Wed" . 3) ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))) -(defvar parse-time-zoneinfo `(("Z" 0) ("UT" 0) ("GMT" 0) - ("PST" ,(* -8 3600)) ("PDT" ,(* -7 3600) t) - ("MST" ,(* -7 3600)) ("MDT" ,(* -6 3600) t) - ("CST" ,(* -6 3600)) ("CDT" ,(* -5 3600) t) - ("EST" ,(* -5 3600)) ("EDT" ,(* -4 3600) t)) - "(zoneinfo seconds-off daylight-savings-time-p)") - -(defvar parse-time-rules - `(((6) parse-time-weekdays) - ((3) (1 31)) - ((4) parse-time-months) - ((5) (1970 2038)) - ((2 1 0) - ,#'(lambda () (and (stringp elt) - (= (length elt) 8) - (= (aref elt 2) ?:) - (= (aref elt 5) ?:))) - [0 2] [3 5] [6 8]) - ((8 7) parse-time-zoneinfo - ,#'(lambda () (car val)) - ,#'(lambda () (cadr val))) - ((8) - ,#'(lambda () - (and (stringp elt) - (= 5 (length elt)) - (or (= (aref elt 0) ?+) (= (aref elt 0) ?-)))) - ,#'(lambda () (* 60 (+ (parse-integer elt 3 5) - (* 60 (parse-integer elt 1 3))) - (if (= (aref elt 0) ?-) -1 1)))) - ((5 4 3) - ,#'(lambda () (and (stringp elt) (= (length elt) 10) (= (aref elt 4) ?-) (= (aref elt 7) ?-))) - [0 4] [5 7] [8 10]) - ((2 1) - ,#'(lambda () (and (stringp elt) (= (length elt) 5) (= (aref elt 2) ?:))) - [0 2] [3 5]) - ((5) (70 99) ,#'(lambda () (+ 1900 elt)))) - "(slots predicate extractor...)") - -(defun parse-time-string (string) - "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). -The values are identical to those of `decode-time', but any values that are -unknown are returned as nil." - (let ((time (list nil nil nil nil nil nil nil nil nil nil)) - (temp (parse-time-tokenize string))) - (while temp - (let ((elt (pop temp)) - (rules parse-time-rules) - (exit nil)) - (while (and (not (null rules)) (not exit)) - (let* ((rule (pop rules)) - (slots (pop rule)) - (predicate (pop rule)) - (val)) - (if (and (not (nth (car slots) time)) ;not already set - (setq val (cond ((and (consp predicate) - (not (eq (car predicate) 'lambda))) - (and (numberp elt) - (<= (car predicate) elt) - (<= elt (cadr predicate)) - elt)) - ((symbolp predicate) - (cdr (assoc elt (symbol-value predicate)))) - ((funcall predicate))))) - (progn - (setq exit t) - (while slots - (let ((new-val (and rule - (let ((this (pop rule))) - (if (vectorp this) - (parse-integer elt (aref this 0) (aref this 1)) - (funcall this)))))) - (rplaca (nthcdr (pop slots) time) (or new-val val)))))))))) - time)) - -(provide 'parse-time) - -;;; parse-time.el ends here diff --git a/lisp/pop3.el b/lisp/pop3.el deleted file mode 100644 index 5358d94..0000000 --- a/lisp/pop3.el +++ /dev/null @@ -1,448 +0,0 @@ -;;; pop3.el --- Post Office Protocol (RFC 1460) interface - -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Richard L. Pieri -;; Keywords: mail, pop3 -;; Version: 1.3k - -;; 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: - -;; Most of the standard Post Office Protocol version 3 (RFC 1460) commands -;; are implemented. The LIST command has not been implemented due to lack -;; of actual usefulness. -;; The optional POP3 command TOP has not been implemented. - -;; This program was inspired by Kyle E. Jones's vm-pop program. - -;;; Code: - -(require 'mail-utils) -(provide 'pop3) - -(defconst pop3-version "1.3k") - -(defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil) - "*POP3 maildrop.") -(defvar pop3-mailhost (or (getenv "MAILHOST") nil) - "*POP3 mailhost.") -(defvar pop3-port 110 - "*POP3 port.") - -(defvar pop3-password-required t - "*Non-nil if a password is required when connecting to POP server.") -(defvar pop3-password nil - "*Password to use when connecting to POP server.") - -(defvar pop3-authentication-scheme 'pass - "*POP3 authentication scheme. -Defaults to 'pass, for the standard USER/PASS authentication. Other valid -values are 'apop.") - -(defvar pop3-timestamp nil - "Timestamp returned when initially connected to the POP server. -Used for APOP authentication.") - -(defvar pop3-movemail-file-coding-system 'binary - "Crashbox made by pop3-movemail with this coding system.") - -(defvar pop3-read-point nil) -(defvar pop3-debug nil) - -(defun pop3-movemail (&optional crashbox) - "Transfer contents of a maildrop to the specified CRASHBOX." - (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) - (let* ((process (pop3-open-server pop3-mailhost pop3-port)) - (crashbuf (get-buffer-create " *pop3-retr*")) - (n 1) - message-count - (pop3-password pop3-password) - ) - ;; for debugging only - (if pop3-debug (switch-to-buffer (process-buffer process))) - ;; query for password - (if (and pop3-password-required (not pop3-password)) - (setq pop3-password - (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) - (cond ((equal 'apop pop3-authentication-scheme) - (pop3-apop process pop3-maildrop)) - ((equal 'pass pop3-authentication-scheme) - (pop3-user process pop3-maildrop) - (pop3-pass process)) - (t (error "Invalid POP3 authentication scheme."))) - (setq message-count (car (pop3-stat process))) - (while (<= n message-count) - (message (format "Retrieving message %d of %d from %s..." - n message-count pop3-mailhost)) - (pop3-retr process n crashbuf) - (save-excursion - (set-buffer crashbuf) - (let ((coding-system-for-write pop3-movemail-file-coding-system)) - (append-to-file (point-min) (point-max) crashbox)) - (set-buffer (process-buffer process)) - (while (> (buffer-size) 5000) - (goto-char (point-min)) - (forward-line 50) - (delete-region (point-min) (point)))) - (pop3-dele process n) - (setq n (+ 1 n)) - (if pop3-debug (sit-for 1) (sit-for 0.1)) - ) - (pop3-quit process) - (kill-buffer crashbuf) - ) - ) - -(defun pop3-open-server (mailhost port) - "Open TCP connection to MAILHOST. -Returns the process associated with the connection." - (let ((process-buffer - (get-buffer-create (format "trace of POP session to %s" mailhost))) - (process) - (coding-system-for-read 'binary)) - (save-excursion - (set-buffer process-buffer) - (erase-buffer) - (setq pop3-read-point (point-min)) - ) - (setq process - (open-network-stream "POP" process-buffer mailhost port)) - (let ((response (pop3-read-response process t))) - (setq pop3-timestamp - (substring response (or (string-match "<" response) 0) - (+ 1 (or (string-match ">" response) -1))))) - process)) - -;; Support functions - -(defun pop3-process-filter (process output) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (insert output))) - -(defun pop3-send-command (process command) - (set-buffer (process-buffer process)) - (goto-char (point-max)) -;; (if (= (aref command 0) ?P) -;; (insert "PASS \r\n") -;; (insert command "\r\n")) - (setq pop3-read-point (point)) - (goto-char (point-max)) - (process-send-string process command) - (process-send-string process "\r\n") - ) - -(defun pop3-read-response (process &optional return) - "Read the response from the server. -Return the response string if optional second argument is non-nil." - (let ((case-fold-search nil) - match-end) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char pop3-read-point) - (while (not (search-forward "\r\n" nil t)) - (accept-process-output process 3) - (goto-char pop3-read-point)) - (setq match-end (point)) - (goto-char pop3-read-point) - (if (looking-at "-ERR") - (error (buffer-substring (point) (- match-end 2))) - (if (not (looking-at "+OK")) - (progn (setq pop3-read-point match-end) nil) - (setq pop3-read-point match-end) - (if return - (buffer-substring (point) match-end) - t) - ))))) - -(defun pop3-string-to-list (string &optional regexp) - "Chop up a string into a list." - (let ((list) - (regexp (or regexp " ")) - (string (if (string-match "\r" string) - (substring string 0 (match-beginning 0)) - string))) - (store-match-data nil) - (while string - (if (string-match regexp string) - (setq list (cons (substring string 0 (- (match-end 0) 1)) list) - string (substring string (match-end 0))) - (setq list (cons string list) - string nil))) - (nreverse list))) - -(defvar pop3-read-passwd nil) -(defun pop3-read-passwd (prompt) - (if (not pop3-read-passwd) - (if (load "passwd" t) - (setq pop3-read-passwd 'read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp") - (setq pop3-read-passwd 'ange-ftp-read-passwd))) - (funcall pop3-read-passwd prompt)) - -(defun pop3-clean-region (start end) - (setq end (set-marker (make-marker) end)) - (save-excursion - (goto-char start) - (while (and (< (point) end) (search-forward "\r\n" end t)) - (replace-match "\n" t t)) - (goto-char start) - (while (and (< (point) end) (re-search-forward "^\\." end t)) - (replace-match "" t t) - (forward-char))) - (set-marker end nil)) - -(defun pop3-munge-message-separator (start end) - "Check to see if a message separator exists. If not, generate one." - (if (not (fboundp 'message-make-date)) (autoload 'message-make-date "message")) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (if (not (or (looking-at "From .?") ; Unix mail - (looking-at "\001\001\001\001\n") ; MMDF - (looking-at "BABYL OPTIONS:") ; Babyl - )) - (let ((from (mail-strip-quoted-names (mail-fetch-field "From"))) - (date (pop3-string-to-list (or (mail-fetch-field "Date") - (message-make-date)))) - (From_)) - ;; sample date formats I have seen - ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT) - ;; Date: 08 Jul 1996 23:22:24 -0400 - ;; should be - ;; Tue Jul 9 09:04:21 1996 - (setq date - (cond ((string-match "[A-Z]" (nth 0 date)) - (format "%s %s %s %s %s" - (nth 0 date) (nth 2 date) (nth 1 date) - (nth 4 date) (nth 3 date))) - (t - ;; this really needs to be better but I don't feel - ;; like writing a date to day converter. - (format "Sun %s %s %s %s" - (nth 1 date) (nth 0 date) - (nth 3 date) (nth 2 date))) - )) - (setq From_ (format "\nFrom %s %s\n" from date)) - (while (string-match "," From_) - (setq From_ (concat (substring From_ 0 (match-beginning 0)) - (substring From_ (match-end 0))))) - (goto-char (point-min)) - (insert From_)))))) - -;; The Command Set - -;; AUTHORIZATION STATE - -(defun pop3-user (process user) - "Send USER information to POP3 server." - (pop3-send-command process (format "USER %s" user)) - (let ((response (pop3-read-response process t))) - (if (not (and response (string-match "+OK" response))) - (error (format "USER %s not valid." user))))) - -(defun pop3-pass (process) - "Send authentication information to the server." - (pop3-send-command process (format "PASS %s" pop3-password)) - (let ((response (pop3-read-response process t))) - (if (not (and response (string-match "+OK" response))) - (pop3-quit process)))) - -(defun pop3-apop (process user) - "Send alternate authentication information to the server." - (if (not (fboundp 'md5)) (autoload 'md5 "md5")) - (let ((hash (md5 (concat pop3-timestamp pop3-password)))) - (pop3-send-command process (format "APOP %s %s" user hash)) - (let ((response (pop3-read-response process t))) - (if (not (and response (string-match "+OK" response))) - (pop3-quit process))))) - -;; TRANSACTION STATE - -(defun pop3-stat (process) - "Return the number of messages in the maildrop and the maildrop's size." - (pop3-send-command process "STAT") - (let ((response (pop3-read-response process t))) - (list (string-to-int (nth 1 (pop3-string-to-list response))) - (string-to-int (nth 2 (pop3-string-to-list response)))) - )) - -(defun pop3-list (process &optional msg) - "Scan listing of available messages. -This function currently does nothing.") - -(defun pop3-retr (process msg crashbuf) - "Retrieve message-id MSG to buffer CRASHBUF." - (pop3-send-command process (format "RETR %s" msg)) - (pop3-read-response process) - (let ((start pop3-read-point) end) - (save-excursion - (set-buffer (process-buffer process)) - (while (not (re-search-forward "^\\.\r\n" nil t)) - (accept-process-output process 3) - ;; bill@att.com ... to save wear and tear on the heap - ;; uncommented because the condensed version below is a problem for - ;; some. - (if (> (buffer-size) 20000) (sleep-for 1)) - (if (> (buffer-size) 50000) (sleep-for 1)) - (if (> (buffer-size) 100000) (sleep-for 1)) - (if (> (buffer-size) 200000) (sleep-for 1)) - (if (> (buffer-size) 500000) (sleep-for 1)) - ;; bill@att.com - ;; condensed into: - ;; (sometimes causes problems for really large messages.) -; (if (> (buffer-size) 20000) (sleep-for (/ (buffer-size) 20000))) - (goto-char start)) - (setq pop3-read-point (point-marker)) -;; this code does not seem to work for some POP servers... -;; and I cannot figure out why not. -; (goto-char (match-beginning 0)) -; (backward-char 2) -; (if (not (looking-at "\r\n")) -; (insert "\r\n")) -; (re-search-forward "\\.\r\n") - (goto-char (match-beginning 0)) - (setq end (point-marker)) - (pop3-clean-region start end) - (pop3-munge-message-separator start end) - (save-excursion - (set-buffer crashbuf) - (erase-buffer)) - (copy-to-buffer crashbuf start end) - (delete-region start end) - ))) - -(defun pop3-dele (process msg) - "Mark message-id MSG as deleted." - (pop3-send-command process (format "DELE %s" msg)) - (pop3-read-response process)) - -(defun pop3-noop (process msg) - "No-operation." - (pop3-send-command process "NOOP") - (pop3-read-response process)) - -(defun pop3-last (process) - "Return highest accessed message-id number for the session." - (pop3-send-command process "LAST") - (let ((response (pop3-read-response process t))) - (string-to-int (nth 1 (pop3-string-to-list response))) - )) - -(defun pop3-rset (process) - "Remove all delete marks from current maildrop." - (pop3-send-command process "RSET") - (pop3-read-response process)) - -;; UPDATE - -(defun pop3-quit (process) - "Close connection to POP3 server. -Tell server to remove all messages marked as deleted, unlock the maildrop, -and close the connection." - (pop3-send-command process "QUIT") - (pop3-read-response process t) - (if process - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (delete-process process)))) - -;; Summary of POP3 (Post Office Protocol version 3) commands and responses - -;;; AUTHORIZATION STATE - -;; Initial TCP connection -;; Arguments: none -;; Restrictions: none -;; Possible responses: -;; +OK [POP3 server ready] - -;; USER name -;; Arguments: a server specific user-id (required) -;; Restrictions: authorization state [after unsuccessful USER or PASS -;; Possible responses: -;; +OK [valid user-id] -;; -ERR [invalid user-id] - -;; PASS string -;; Arguments: a server/user-id specific password (required) -;; Restrictions: authorization state, after successful USER -;; Possible responses: -;; +OK [maildrop locked and ready] -;; -ERR [invalid password] -;; -ERR [unable to lock maildrop] - -;;; TRANSACTION STATE - -;; STAT -;; Arguments: none -;; Restrictions: transaction state -;; Possible responses: -;; +OK nn mm [# of messages, size of maildrop] - -;; LIST [msg] -;; Arguments: a message-id (optional) -;; Restrictions: transaction state; msg must not be deleted -;; Possible responses: -;; +OK [scan listing follows] -;; -ERR [no such message] - -;; RETR msg -;; Arguments: a message-id (required) -;; Restrictions: transaction state; msg must not be deleted -;; Possible responses: -;; +OK [message contents follow] -;; -ERR [no such message] - -;; DELE msg -;; Arguments: a message-id (required) -;; Restrictions: transaction state; msg must not be deleted -;; Possible responses: -;; +OK [message deleted] -;; -ERR [no such message] - -;; NOOP -;; Arguments: none -;; Restrictions: transaction state -;; Possible responses: -;; +OK - -;; LAST -;; Arguments: none -;; Restrictions: transaction state -;; Possible responses: -;; +OK nn [highest numbered message accessed] - -;; RSET -;; Arguments: none -;; Restrictions: transaction state -;; Possible responses: -;; +OK [all delete marks removed] - -;;; UPDATE STATE - -;; QUIT -;; Arguments: none -;; Restrictions: none -;; Possible responses: -;; +OK [TCP connection closed] diff --git a/lisp/score-mode.el b/lisp/score-mode.el deleted file mode 100644 index c0b475b..0000000 --- a/lisp/score-mode.el +++ /dev/null @@ -1,109 +0,0 @@ -;;; score-mode.el --- mode for editing Gnus score files -;; Copyright (C) 1996 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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: - -;;; Code: - -(require 'easymenu) -(require 'timezone) -(eval-when-compile (require 'cl)) - -(defvar gnus-score-mode-hook nil - "*Hook run in score mode buffers.") - -(defvar gnus-score-menu-hook nil - "*Hook run after creating the score mode menu.") - -(defvar gnus-score-edit-exit-function nil - "Function run on exit from the score buffer.") - -(defvar gnus-score-mode-map nil) -(unless gnus-score-mode-map - (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map)) - (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit) - (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date) - (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print)) - -;;;###autoload -(defun gnus-score-mode () - "Mode for editing Gnus score files. -This mode is an extended emacs-lisp mode. - -\\{gnus-score-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map gnus-score-mode-map) - (gnus-score-make-menu-bar) - (set-syntax-table emacs-lisp-mode-syntax-table) - (setq major-mode 'gnus-score-mode) - (setq mode-name "Score") - (lisp-mode-variables nil) - (make-local-variable 'gnus-score-edit-exit-function) - (gnus-run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook)) - -(defun gnus-score-make-menu-bar () - (unless (boundp 'gnus-score-menu) - (easy-menu-define - gnus-score-menu gnus-score-mode-map "" - '("Score" - ["Exit" gnus-score-edit-exit t] - ["Insert date" gnus-score-edit-insert-date t] - ["Format" gnus-score-pretty-print t])) - (gnus-run-hooks 'gnus-score-menu-hook))) - -(defun gnus-score-edit-insert-date () - "Insert date in numerical format." - (interactive) - (princ (gnus-score-day-number (current-time)) (current-buffer))) - -(defun gnus-score-pretty-print () - "Format the current score file." - (interactive) - (goto-char (point-min)) - (let ((form (read (current-buffer)))) - (erase-buffer) - (pp form (current-buffer))) - (goto-char (point-min))) - -(defun gnus-score-edit-exit () - "Stop editing the score file." - (interactive) - (unless (file-exists-p (file-name-directory (buffer-file-name))) - (make-directory (file-name-directory (buffer-file-name)) t)) - (save-buffer) - (bury-buffer (current-buffer)) - (let ((buf (current-buffer))) - (when gnus-score-edit-exit-function - (funcall gnus-score-edit-exit-function)) - (when (eq buf (current-buffer)) - (switch-to-buffer (other-buffer (current-buffer)))))) - -(defun gnus-score-day-number (time) - (let ((dat (decode-time time))) - (timezone-absolute-from-gregorian - (nth 4 dat) (nth 3 dat) (nth 5 dat)))) - -(provide 'score-mode) - -;;; score-mode.el ends here diff --git a/lisp/smiley.el b/lisp/smiley.el deleted file mode 100644 index f82ac2d..0000000 --- a/lisp/smiley.el +++ /dev/null @@ -1,318 +0,0 @@ -;;; smiley.el --- displaying smiley faces -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. - -;; Author: Wes Hardaker -;; Keywords: fun - -;; 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: - -;; -;; comments go here. -;; - -;;; Test smileys: :-] :-o :-) ;-) :-\ :-| :-d :-P 8-| :-( - -;; To use: -;; (require 'smiley) -;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t) - -;; The smilies were drawn by Joe Reiss . - -(require 'annotations) -(require 'messagexmas) -(require 'cl) -(require 'custom) - -(defgroup smiley nil - "Turn :-)'s into real images (XEmacs)." - :group 'gnus-visual) - -(defcustom smiley-data-directory (message-xmas-find-glyph-directory "smilies") - "*Location of the smiley faces files." - :type 'directory - :group 'smiley) - -;; Notice the subtle differences in the regular expressions in the -;; two alists below. - -(defcustom smiley-deformed-regexp-alist - '(("\\(\\^_?\\^;;;\\)\\W" 1 "WideFaceAse3.xbm") - ("\\(\\^_?\\^;;\\)\\W" 1 "WideFaceAse2.xbm") - ("\\(\\^_?\\^;\\)\\W" 1 "WideFaceAse1.xbm") - ("\\(\\^_?\\^\\)\\W" 1 "WideFaceSmile.xbm") - ("\\(;_;\\)\\W" 1 "WideFaceWeep.xbm") - ("\\(T_T\\)\\W" 1 "WideFaceWeep.xbm") - ("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm") - ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") - ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm") - ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(=[)>»]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-*[/\\\"]\\)[^/]\\W" 1 "FaceIronic.xpm") - ("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm") - ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm") - ("\\(:-*[({]+\\)\\W" 1 "FaceSad.xpm") - ("\\(=[({]+\\)\\W" 1 "FaceSad.xpm") - ("\\(:-*[Oo\*]\\)\\W" 1 "FaceStartled.xpm") - ("\\(:-*|\\)\\W" 1 "FaceStraight.xpm") - ("\\(:-*p\\)\\W" 1 "FaceTalking.xpm") - ("\\(:-*d\\)\\W" 1 "FaceTasty.xpm") - ("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm") - ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm") - ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm")) - "*Normal and deformed faces for smilies." - :type '(repeat (list regexp - (integer :tag "Match") - (string :tag "Image"))) - :group 'smiley) - -(defcustom smiley-nosey-regexp-alist - '(("\\(:-+[<«]+\\)\\W" 1 "FaceAngry.xpm") - ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") - ("\\(:-+D\\)\\W" 1 "FaceGrinning.xpm") - ("\\(:-+[}»]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-*)+\\)\\W" 1 "FaceHappy.xpm") - ("\\(=[)>]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-+[/\\\"]+\\)\\W" 1 "FaceIronic.xpm") - ("\\([8|]-+[|Oo%]\\)\\W" 1 "FaceKOed.xpm") - ("\\([:|]-+#+\\)\\W" 1 "FaceNyah.xpm") - ("\\(:-+[({]+\\)\\W" 1 "FaceSad.xpm") - ("\\(=[({]+\\)\\W" 1 "FaceSad.xpm") - ("\\(:-+[Oo\*]\\)\\W" 1 "FaceStartled.xpm") - ("\\(:-+|\\)\\W" 1 "FaceStraight.xpm") - ("\\(:-+p\\)\\W" 1 "FaceTalking.xpm") - ("\\(:-+d\\)\\W" 1 "FaceTasty.xpm") - ("\\(;-+[>)}»]+\\)\\W" 1 "FaceWinking.xpm") - ("\\(:-+[Vvµ]\\)\\W" 1 "FaceWry.xpm") - ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm") - ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm")) - "*Smileys with noses. These get less false matches." - :type '(repeat (list regexp - (integer :tag "Match") - (string :tag "Image"))) - :group 'smiley) - -(defcustom smiley-regexp-alist smiley-deformed-regexp-alist - "*A list of regexps to map smilies to real images. -Defaults to the contents of `smiley-deformed-regexp-alist'. -An alternative is `smiley-nosey-regexp-alist' that matches less -aggressively. -If this is a symbol, take its value." - :type '(radio (variable-item smiley-deformed-regexp-alist) - (variable-item smiley-nosey-regexp-alist) - symbol - (repeat (list regexp - (integer :tag "Match") - (string :tag "Image")))) - :group 'smiley) - -(defcustom smiley-flesh-color "yellow" - "*Flesh color." - :type 'string - :group 'smiley) - -(defcustom smiley-features-color "black" - "*Features color." - :type 'string - :group 'smiley) - -(defcustom smiley-tongue-color "red" - "*Tongue color." - :type 'string - :group 'smiley) - -(defcustom smiley-circle-color "black" - "*Circle color." - :type 'string - :group 'smiley) - -(defcustom smiley-mouse-face 'highlight - "*Face used for mouse highlighting in the smiley buffer. - -Smiley buttons will be displayed in this face when the cursor is -above them." - :type 'face - :group 'smiley) - -(defvar smiley-glyph-cache nil) -(defvar smiley-running-xemacs (string-match "XEmacs" emacs-version)) - -(defvar smiley-map (make-sparse-keymap "smiley-keys") - "Keymap to toggle smiley states.") - -(define-key smiley-map [(button2)] 'smiley-toggle-extent) -(define-key smiley-map [(button3)] 'smiley-popup-menu) - -(defun smiley-popup-menu (e) - (interactive "e") - (popup-menu - `("Smilies" - ["Toggle This Smiley" (smiley-toggle-extent ,e) t] - ["Toggle All Smilies" (smiley-toggle-extents ,e) t]))) - -(defun smiley-create-glyph (smiley pixmap) - (and - smiley-running-xemacs - (or - (cdr-safe (assoc pixmap smiley-glyph-cache)) - (let* ((xpm-color-symbols - (and (featurep 'xpm) - (append `(("flesh" ,smiley-flesh-color) - ("features" ,smiley-features-color) - ("tongue" ,smiley-tongue-color)) - xpm-color-symbols))) - (glyph (make-glyph - (list - (cons 'x (expand-file-name pixmap smiley-data-directory)) - (cons 'tty smiley))))) - (setq smiley-glyph-cache (cons (cons pixmap glyph) smiley-glyph-cache)) - (set-glyph-face glyph 'default) - glyph)))) - -;;;###autoload -(defun smiley-region (beg end) - "Smilify the region between point and mark." - (interactive "r") - (smiley-buffer (current-buffer) beg end)) - -(defun smiley-toggle-extent (event) - "Toggle smiley at given point" - (interactive "e") - (let* ((ant (event-glyph-extent event)) - (pt (event-closest-point event)) - ext) - (if (annotationp ant) - (when (extentp (setq ext (extent-property ant 'smiley-extent))) - (set-extent-property ext 'invisible nil) - (hide-annotation ant)) - (when pt - (while (setq ext (extent-at pt (event-buffer event) nil ext 'at)) - (when (annotationp (setq ant - (extent-property ext 'smiley-annotation))) - (reveal-annotation ant) - (set-extent-property ext 'invisible t))))))) - -(defun smiley-toggle-extents (e) - (interactive "e") - (map-extents - '(lambda (e void) - (let (ant) - (if (annotationp (setq ant (extent-property e 'smiley-annotation))) - (progn - (if (eq (extent-property e 'invisible) nil) - (progn - (reveal-annotation ant) - (set-extent-property e 'invisible t) - ) - (hide-annotation ant) - (set-extent-property e 'invisible nil)))) - nil)) - (event-buffer e))) - -;;;###autoload -(defun smiley-buffer (&optional buffer st nd) - (interactive) - (when (featurep 'x) - (save-excursion - (when buffer - (set-buffer buffer)) - (let ((buffer-read-only nil) - (alist (if (symbolp smiley-regexp-alist) - (symbol-value smiley-regexp-alist) - smiley-regexp-alist)) - (case-fold-search nil) - entry regexp beg group file) - (map-extents - '(lambda (e void) - (when (or (extent-property e 'smiley-extent) - (extent-property e 'smiley-annotation)) - (delete-extent e))) - buffer st nd) - (goto-char (or st (point-min))) - (setq beg (point)) - ;; loop through alist - (while (setq entry (pop alist)) - (setq regexp (car entry) - group (cadr entry) - file (caddr entry)) - (goto-char beg) - (while (re-search-forward regexp nd t) - (let* ((start (match-beginning group)) - (end (match-end group)) - (glyph (smiley-create-glyph (buffer-substring start end) - file))) - (when glyph - (mapcar 'delete-annotation (annotations-at end)) - (let ((ext (make-extent start end)) - (ant (make-annotation glyph end 'text))) - ;; set text extent params - (set-extent-property ext 'end-open t) - (set-extent-property ext 'start-open t) - (set-extent-property ext 'invisible t) - (set-extent-property ext 'keymap smiley-map) - (set-extent-property ext 'mouse-face smiley-mouse-face) - (set-extent-property ext 'intangible t) - ;; set annotation params - (set-extent-property ant 'mouse-face smiley-mouse-face) - (set-extent-property ant 'keymap smiley-map) - ;; remember each other - (set-extent-property ant 'smiley-extent ext) - (set-extent-property ext 'smiley-annotation ant) - ;; Help - (set-extent-property ext 'help-echo - "button2 toggles smiley, button3 pops up menu") - (set-extent-property ant 'help-echo - "button2 toggles smiley, button3 pops up menu") - (set-extent-property ext 'balloon-help - "Mouse button2 - toggle smiley -Mouse button3 - menu") - (set-extent-property ant 'balloon-help - "Mouse button2 - toggle smiley -Mouse button3 - menu")) - (when (smiley-end-paren-p start end) - (make-annotation ")" end 'text)) - (goto-char end))))))))) - -(defun smiley-end-paren-p (start end) - "Try to guess whether the current smiley is an end-paren smiley." - (save-excursion - (goto-char start) - (when (and (re-search-backward "[()]" nil t) - (= (following-char) ?\() - (goto-char end) - (or (not (re-search-forward "[()]" nil t)) - (= (char-after (1- (point))) ?\())) - t))) - -(defvar gnus-article-buffer) -;;;###autoload -(defun gnus-smiley-display () - "Display \"smileys\" as small graphical icons." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - ;; We skip the headers. - (unless (search-forward "\n\n" nil t) - (goto-char (point-max))) - (smiley-buffer (current-buffer) (point)))) - -(provide 'smiley) - -;;; smiley.el ends here diff --git a/lisp/smtp.el b/lisp/smtp.el deleted file mode 100644 index 7dde447..0000000 --- a/lisp/smtp.el +++ /dev/null @@ -1,457 +0,0 @@ -;;; smtp.el --- basic functions to send mail with SMTP server - -;; Copyright (C) 1995, 1996, 1998 Free Software Foundation, Inc. - -;; Author: Tomoji Kagatani -;; ESMTP support: Simon Leinen -;; Keywords: SMTP, 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. - -;;; Code: - -(defgroup smtp nil - "SMTP protocol for sending mail." - :group 'mail) - -(defcustom smtp-default-server nil - "*Specify default SMTP server." - :type '(choice (const nil) string) - :group 'smtp) - -(defcustom smtp-server - (or (getenv "SMTPSERVER") smtp-default-server) - "*The name of the host running SMTP server." - :type '(choice (const nil) string) - :group 'smtp) - -(defcustom smtp-service 25 - "*SMTP service port number. smtp or 25 ." - :type 'integer - :group 'smtp) - -(defcustom smtp-local-domain nil - "*Local domain name without a host name. -If the function (system-name) returns the full internet address, -don't define this value." - :type '(choice (const nil) string) - :group 'smtp) - -(defcustom smtp-debug-info nil - "*smtp debug info printout. messages and process buffer." - :type 'boolean - :group 'smtp) - -(defcustom smtp-coding-system 'binary - "*Coding-system for SMTP output." - :type 'coding-system - :group 'smtp) - - -(defun smtp-fqdn () - (if smtp-local-domain - (concat (system-name) "." smtp-local-domain) - (system-name))) - -(defun smtp-via-smtp (recipient smtp-text-buffer) - (let ((process nil) - (host smtp-server) - (port smtp-service) - response-code - greeting - process-buffer - (supported-extensions '()) - (coding-system-for-read smtp-coding-system) - (coding-system-for-write smtp-coding-system)) - (unwind-protect - (catch 'done - ;; get or create the trace buffer - (setq process-buffer - (get-buffer-create - (format "*trace of SMTP session to %s*" host))) - - ;; clear the trace buffer of old output - (save-excursion - (set-buffer process-buffer) - (erase-buffer)) - - ;; open the connection to the server - (setq process (open-network-stream "SMTP" process-buffer host port)) - (and (null process) (throw 'done nil)) - - ;; set the send-filter - (set-process-filter process 'smtp-process-filter) - - (save-excursion - (set-buffer process-buffer) - (make-local-variable 'smtp-read-point) - (setq smtp-read-point (point-min)) - - (if (or (null (car (setq greeting (smtp-read-response process)))) - (not (integerp (car greeting))) - (>= (car greeting) 400)) - (throw 'done nil) - ) - - ;; EHLO - (smtp-send-command process (format "EHLO %s" (smtp-fqdn))) - - (if (or (null (car (setq response-code (smtp-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (progn - ;; HELO - (smtp-send-command process (format "HELO %s" (smtp-fqdn))) - - (if (or (null (car (setq response-code (smtp-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil))) - (let ((extension-lines (cdr (cdr response-code)))) - (while extension-lines - (let ((name (intern (downcase (substring (car extension-lines) 4))))) - (and name - (cond ((memq name '(verb xvrb 8bitmime onex xone - expn size dsn etrn - help xusr)) - (setq supported-extensions - (cons name supported-extensions))) - (t (message "unknown extension %s" - name))))) - (setq extension-lines (cdr extension-lines))))) - - (if (or (member 'onex supported-extensions) - (member 'xone supported-extensions)) - (progn - (smtp-send-command process (format "ONEX")) - (if (or (null (car (setq response-code (smtp-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil)))) - - (if (and smtp-debug-info - (or (member 'verb supported-extensions) - (member 'xvrb supported-extensions))) - (progn - (smtp-send-command process (format "VERB")) - (if (or (null (car (setq response-code (smtp-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil)))) - - (if (member 'xusr supported-extensions) - (progn - (smtp-send-command process (format "XUSR")) - (if (or (null (car (setq response-code (smtp-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil)))) - - ;; MAIL FROM: - (let ((size-part - (if (member 'size supported-extensions) - (format " SIZE=%d" - (save-excursion - (set-buffer smtp-text-buffer) - ;; size estimate: - (+ (- (point-max) (point-min)) - ;; Add one byte for each change-of-line - ;; because or CR-LF representation: - (count-lines (point-min) (point-max)) - ;; For some reason, an empty line is - ;; added to the message. Maybe this - ;; is a bug, but it can't hurt to add - ;; those two bytes anyway: - 2))) - "")) - (body-part - (if (member '8bitmime supported-extensions) - ;; FIXME: - ;; Code should be added here that transforms - ;; the contents of the message buffer into - ;; something the receiving SMTP can handle. - ;; For a receiver that supports 8BITMIME, this - ;; may mean converting BINARY to BASE64, or - ;; adding Content-Transfer-Encoding and the - ;; other MIME headers. The code should also - ;; return an indication of what encoding the - ;; message buffer is now, i.e. ASCII or - ;; 8BITMIME. - (if nil - " BODY=8BITMIME" - "") - ""))) -; (smtp-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtp-fqdn))) - (smtp-send-command process (format "MAIL FROM: <%s>%s%s" - user-mail-address - size-part - body-part)) - - (if (or (null (car (setq response-code (smtp-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil) - )) - - ;; RCPT TO: - (let ((n 0)) - (while (not (null (nth n recipient))) - (smtp-send-command process (format "RCPT TO: <%s>" (nth n recipient))) - (setq n (1+ n)) - - (setq response-code (smtp-read-response process)) - (if (or (null (car response-code)) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil) - ) - )) - - ;; DATA - (smtp-send-command process "DATA") - - (if (or (null (car (setq response-code (smtp-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil) - ) - - ;; Mail contents - (smtp-send-data process smtp-text-buffer) - - ;;DATA end "." - (smtp-send-command process ".") - - (if (or (null (car (setq response-code (smtp-read-response process)))) - (not (integerp (car response-code))) - (>= (car response-code) 400)) - (throw 'done nil) - ) - - ;;QUIT -; (smtp-send-command process "QUIT") -; (and (null (car (smtp-read-response process))) -; (throw 'done nil)) - t )) - (if process - (save-excursion - (set-buffer (process-buffer process)) - (smtp-send-command process "QUIT") - (smtp-read-response process) - -; (if (or (null (car (setq response-code (smtp-read-response process)))) -; (not (integerp (car response-code))) -; (>= (car response-code) 400)) -; (throw 'done nil) -; ) - (delete-process process)))))) - -(defun smtp-process-filter (process output) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (insert output))) - -(defun smtp-read-response (process) - (let ((case-fold-search nil) - (response-strings nil) - (response-continue t) - (return-value '(nil ())) - match-end) - - (while response-continue - (goto-char smtp-read-point) - (while (not (search-forward "\r\n" nil t)) - (accept-process-output process) - (goto-char smtp-read-point)) - - (setq match-end (point)) - (setq response-strings - (cons (buffer-substring smtp-read-point (- match-end 2)) - response-strings)) - - (goto-char smtp-read-point) - (if (looking-at "[0-9]+ ") - (let ((begin (match-beginning 0)) - (end (match-end 0))) - (if smtp-debug-info - (message "%s" (car response-strings))) - - (setq smtp-read-point match-end) - - ;; ignore lines that start with "0" - (if (looking-at "0[0-9]+ ") - nil - (setq response-continue nil) - (setq return-value - (cons (string-to-int - (buffer-substring begin end)) - (nreverse response-strings))))) - - (if (looking-at "[0-9]+-") - (progn (if smtp-debug-info - (message "%s" (car response-strings))) - (setq smtp-read-point match-end) - (setq response-continue t)) - (progn - (setq smtp-read-point match-end) - (setq response-continue nil) - (setq return-value - (cons nil (nreverse response-strings))) - ) - ))) - (setq smtp-read-point match-end) - return-value)) - -(defun smtp-send-command (process command) - (goto-char (point-max)) - (if (= (aref command 0) ?P) - (insert "PASS \r\n") - (insert command "\r\n")) - (setq smtp-read-point (point)) - (process-send-string process command) - (process-send-string process "\r\n")) - -(defun smtp-send-data-1 (process data) - (goto-char (point-max)) - - (if smtp-debug-info - (insert data "\r\n")) - - (setq smtp-read-point (point)) - ;; Escape "." at start of a line - (if (eq (string-to-char data) ?.) - (process-send-string process ".")) - (process-send-string process data) - (process-send-string process "\r\n") - ) - -(defun smtp-send-data (process buffer) - (let - ((data-continue t) - (sending-data nil) - this-line - this-line-end) - - (save-excursion - (set-buffer buffer) - (goto-char (point-min))) - - (while data-continue - (save-excursion - (set-buffer buffer) - (beginning-of-line) - (setq this-line (point)) - (end-of-line) - (setq this-line-end (point)) - (setq sending-data nil) - (setq sending-data (buffer-substring this-line this-line-end)) - (if (/= (forward-line 1) 0) - (setq data-continue nil))) - - (smtp-send-data-1 process sending-data) - ) - ) - ) - -(defun smtp-deduce-address-list (smtp-text-buffer header-start header-end) - "Get address list suitable for smtp RCPT TO:

    ." - (require 'mail-utils) ;; pick up mail-strip-quoted-names - (let ((case-fold-search t) - (simple-address-list "") - this-line - this-line-end - addr-regexp - (smtp-address-buffer (generate-new-buffer " *smtp-mail*"))) - (unwind-protect - (save-excursion - ;; - (set-buffer smtp-address-buffer) - (erase-buffer) - (insert-buffer-substring smtp-text-buffer - header-start header-end) - (goto-char (point-min)) - ;; RESENT-* fields should stop processing of regular fields. - (save-excursion - (if (re-search-forward "^RESENT-TO:" header-end t) - (setq addr-regexp - "^\\(RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)") - (setq addr-regexp "^\\(TO:\\|CC:\\|BCC:\\)"))) - - (while (re-search-forward addr-regexp header-end t) - (replace-match "") - (setq this-line (match-beginning 0)) - (forward-line 1) - ;; get any continuation lines - (while (and (looking-at "^[ \t]+") (< (point) header-end)) - (forward-line 1)) - (setq this-line-end (point-marker)) - (setq simple-address-list - (concat simple-address-list " " - (mail-strip-quoted-names - (buffer-substring this-line this-line-end)))) - ) - (erase-buffer) - (insert-string " ") - (insert-string simple-address-list) - (insert-string "\n") - ;; newline --> blank - (subst-char-in-region (point-min) (point-max) 10 ? t) - ;; comma --> blank - (subst-char-in-region (point-min) (point-max) ?, ? t) - ;; tab --> blank - (subst-char-in-region (point-min) (point-max) 9 ? t) - - (goto-char (point-min)) - ;; tidyness in case hook is not robust when it looks at this - (while (re-search-forward "[ \t]+" header-end t) (replace-match " ")) - - (goto-char (point-min)) - (let (recipient-address-list) - (while (re-search-forward " \\([^ ]+\\) " (point-max) t) - (backward-char 1) - (setq recipient-address-list - (cons (buffer-substring (match-beginning 1) (match-end 1)) - recipient-address-list)) - ) - recipient-address-list) - ) - (kill-buffer smtp-address-buffer)) - )) - -(defun smtp-do-bcc (header-end) - "Delete BCC: and their continuation lines from the header area. -There may be multiple BCC: lines, and each may have arbitrarily -many continuation lines." - (let ((case-fold-search t)) - (save-excursion - (goto-char (point-min)) - ;; iterate over all BCC: lines - (while (re-search-forward "^BCC:" header-end t) - (delete-region (match-beginning 0) (progn (forward-line 1) (point))) - ;; get rid of any continuation lines - (while (and (looking-at "^[ \t].*\n") (< (point) header-end)) - (replace-match "")) - ) - ) ;; save-excursion - ) ;; let - ) - -(provide 'smtp) - -;;; smtp.el ends here diff --git a/lisp/smtpmail.el b/lisp/smtpmail.el deleted file mode 100644 index 77a5947..0000000 --- a/lisp/smtpmail.el +++ /dev/null @@ -1,285 +0,0 @@ -;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail - -;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. - -;; Author: Tomoji Kagatani -;; Maintainer: Brian D. Carlstrom -;; ESMTP support: Simon Leinen -;; Keywords: mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Send Mail to smtp host from smtpmail temp buffer. - -;; Please add these lines in your .emacs(_emacs). -;; -;;(setq send-mail-function 'smtpmail-send-it) -;;(setq smtp-default-server "YOUR SMTP HOST") -;;(setq smtp-service "smtp") -;;(setq smtp-local-domain "YOUR DOMAIN NAME") -;;(setq smtp-debug-info t) -;;(autoload 'smtpmail-send-it "smtpmail") -;;(setq user-full-name "YOUR NAME HERE") - -;; To queue mail, set smtpmail-queue-mail to t and use -;; smtpmail-send-queued-mail to send. - - -;;; Code: - -(require 'smtp) -(require 'sendmail) -(require 'time-stamp) - -;;; - -(defcustom smtpmail-queue-mail nil - "*Specify if mail is queued (if t) or sent immediately (if nil). -If queued, it is stored in the directory `smtpmail-queue-dir' -and sent with `smtpmail-send-queued-mail'." - :type 'boolean - :group 'smtp) - -(defcustom smtpmail-queue-dir "~/Mail/queued-mail/" - "*Directory where `smtpmail.el' stores queued mail." - :type 'directory - :group 'smtp) - -(defvar smtpmail-queue-index-file "index" - "File name of queued mail index, -This is relative to `smtpmail-queue-dir'.") - -(defvar smtpmail-queue-index (concat smtpmail-queue-dir - smtpmail-queue-index-file)) - -(defvar smtpmail-recipient-address-list nil) - - -;;; -;;; -;;; - -(defun smtpmail-send-it () - (require 'mail-utils) - (let ((errbuf (if mail-interactive - (generate-new-buffer " smtpmail errors") - 0)) - (tembuf (generate-new-buffer " smtpmail temp")) - (case-fold-search nil) - resend-to-addresses - delimline - (mailbuf (current-buffer))) - (unwind-protect - (save-excursion - (set-buffer tembuf) - (erase-buffer) - (insert-buffer-substring mailbuf) - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - ;; 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)) -;; (sendmail-synch-aliases) - (if mail-aliases - (expand-mail-aliases (point-min) delimline)) - (goto-char (point-min)) - ;; ignore any blank lines in the header - (while (and (re-search-forward "\n\n\n*" delimline t) - (< (point) delimline)) - (replace-match "\n")) - (let ((case-fold-search t)) - (goto-char (point-min)) - (goto-char (point-min)) - (while (re-search-forward "^Resent-to:" delimline t) - (setq resend-to-addresses - (save-restriction - (narrow-to-region (point) - (save-excursion - (end-of-line) - (point))) - (append (mail-parse-comma-list) - resend-to-addresses)))) -;;; Apparently this causes a duplicate Sender. -;;; ;; If the From is different than current user, insert Sender. -;;; (goto-char (point-min)) -;;; (and (re-search-forward "^From:" delimline t) -;;; (progn -;;; (require 'mail-utils) -;;; (not (string-equal -;;; (mail-strip-quoted-names -;;; (save-restriction -;;; (narrow-to-region (point-min) delimline) -;;; (mail-fetch-field "From"))) -;;; (user-login-name)))) -;;; (progn -;;; (forward-line 1) -;;; (insert "Sender: " (user-login-name) "\n"))) - ;; Don't send out a blank subject line - (goto-char (point-min)) - (if (re-search-forward "^Subject:[ \t]*\n" delimline t) - (replace-match "")) - ;; Put the "From:" field in unless for some odd reason - ;; they put one in themselves. - (goto-char (point-min)) - (if (not (re-search-forward "^From:" delimline t)) - (let* ((login user-mail-address) - (fullname (user-full-name))) - (cond ((eq mail-from-style 'angles) - (insert "From: " fullname) - (let ((fullname-start (+ (point-min) 6)) - (fullname-end (point-marker))) - (goto-char fullname-start) - ;; Look for a character that cannot appear unquoted - ;; according to RFC 822. - (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" - fullname-end 1) - (progn - ;; Quote fullname, escaping specials. - (goto-char fullname-start) - (insert "\"") - (while (re-search-forward "[\"\\]" - fullname-end 1) - (replace-match "\\\\\\&" t)) - (insert "\"")))) - (insert " <" login ">\n")) - ((eq mail-from-style 'parens) - (insert "From: " login " (") - (let ((fullname-start (point))) - (insert fullname) - (let ((fullname-end (point-marker))) - (goto-char fullname-start) - ;; RFC 822 says \ and nonmatching parentheses - ;; must be escaped in comments. - ;; Escape every instance of ()\ ... - (while (re-search-forward "[()\\]" fullname-end 1) - (replace-match "\\\\\\&" t)) - ;; ... then undo escaping of matching parentheses, - ;; including matching nested parentheses. - (goto-char fullname-start) - (while (re-search-forward - "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" - fullname-end 1) - (replace-match "\\1(\\3)" t) - (goto-char fullname-start)))) - (insert ")\n")) - ((null mail-from-style) - (insert "From: " login "\n"))))) - ;; Insert an extra newline if we need it to work around - ;; Sun's bug that swallows newlines. - (goto-char (1+ delimline)) - (if (eval mail-mailer-swallows-blank-line) - (newline)) - ;; Find and handle any FCC fields. - (goto-char (point-min)) - (if (re-search-forward "^FCC:" delimline t) - (mail-do-fcc delimline)) - (if mail-interactive - (save-excursion - (set-buffer errbuf) - (erase-buffer)))) - ;; - ;; - ;; - (setq smtpmail-recipient-address-list - (or resend-to-addresses - (smtp-deduce-address-list tembuf (point-min) delimline))) - - (smtp-do-bcc delimline) - ; Send or queue - (if (not smtpmail-queue-mail) - (if smtpmail-recipient-address-list - (if (not (smtp-via-smtp - smtpmail-recipient-address-list tembuf)) - (error "Sending failed; SMTP protocol error")) - (error "Sending failed; no recipients")) - (let* ((file-data (concat - smtpmail-queue-dir - (time-stamp-strftime - "%02y%02m%02d-%02H%02M%02S"))) - (file-elisp (concat file-data ".el")) - (buffer-data (create-file-buffer file-data)) - (buffer-elisp (create-file-buffer file-elisp)) - (buffer-scratch "*queue-mail*")) - (save-excursion - (set-buffer buffer-data) - (erase-buffer) - (insert-buffer tembuf) - (write-file file-data) - (set-buffer buffer-elisp) - (erase-buffer) - (insert (concat - "(setq smtpmail-recipient-address-list '" - (prin1-to-string smtpmail-recipient-address-list) - ")\n")) - (write-file file-elisp) - (set-buffer (generate-new-buffer buffer-scratch)) - (insert (concat file-data "\n")) - (append-to-file (point-min) - (point-max) - smtpmail-queue-index) - ) - (kill-buffer buffer-scratch) - (kill-buffer buffer-data) - (kill-buffer buffer-elisp)))) - (kill-buffer tembuf) - (if (bufferp errbuf) - (kill-buffer errbuf))))) - -(defun smtpmail-send-queued-mail () - "Send mail that was queued as a result of setting `smtpmail-queue-mail'." - (interactive) - ;;; Get index, get first mail, send it, get second mail, etc... - (let ((buffer-index (find-file-noselect smtpmail-queue-index)) - (file-msg "") - (tembuf nil)) - (save-excursion - (set-buffer buffer-index) - (beginning-of-buffer) - (while (not (eobp)) - (setq file-msg (buffer-substring (point) (save-excursion - (end-of-line) - (point)))) - (load file-msg) - (setq tembuf (find-file-noselect file-msg)) - (if smtpmail-recipient-address-list - (if (not (smtp-via-smtp smtpmail-recipient-address-list tembuf)) - (error "Sending failed; SMTP protocol error")) - (error "Sending failed; no recipients")) - (delete-file file-msg) - (delete-file (concat file-msg ".el")) - (kill-buffer tembuf) - (kill-line 1)) - (set-buffer buffer-index) - (save-buffer smtpmail-queue-index) - (kill-buffer buffer-index) - ))) - - -;;; - -(provide 'smtpmail) - -;;; smtpmail.el ends here diff --git a/readme b/readme deleted file mode 100644 index c8249c2..0000000 --- a/readme +++ /dev/null @@ -1,52 +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 "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.4.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.4.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: - - (setq Info-default-directory-list - (cons "~/gnus-5.4.53/texi" Info-default-directory-list)) - -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 19.33 or -XEmacs 19.14. So you definitely need a new Emacs. - -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 -`bugs@gnus.org'. diff --git a/texi/ChangeLog b/texi/ChangeLog deleted file mode 100644 index a3f2538..0000000 --- a/texi/ChangeLog +++ /dev/null @@ -1,752 +0,0 @@ -Sat Feb 14 17:46:33 1998 Lars Magne Ingebrigtsen - - * gnus.texi (Virtual Groups): Fix. - (NNTP): Addition. - (Really Various Summary Commands): Addition. - -Fri Feb 13 18:23:19 1998 Lars Magne Ingebrigtsen - - * gnus.texi (Mail Group Commands): Typo. - (NNTP): Addition. - (Mail and Procmail): Addition. - -Mon Feb 9 16:30:30 1998 Lars Magne Ingebrigtsen - - * gnus.texi (Article Date): Addition. - -Sun Feb 8 16:28:35 1998 Lars Magne Ingebrigtsen - - * gnus.texi (Newest Features): Addition. - -Mon Feb 2 19:21:43 1998 Lars Magne Ingebrigtsen - - * gnus.texi (Agent Variables): Addition. - -Sun Feb 1 18:08:45 1998 Lars Magne Ingebrigtsen - - * gnus.texi (Using MIME): Addition. - -Tue Jan 6 07:22:41 1998 Lars Magne Ingebrigtsen - - * gnus.texi (Batching Agents): New. - -1998-01-04 Christoph Wedler - - * gnus.texi (Newest Features): Delete spaces after @end example. - In XEmacs, `texinfo-format-buffer' would bug out. - -Sun Jan 4 12:04:45 1998 Lars Magne Ingebrigtsen - - * gnus.texi (Conformity): Removed GNKSA. - -Sun Dec 14 11:06:23 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Adaptive Scoring): Addition. - -1997-11-26 SL Baur - - * message.texi (Insertion): Fix typo. - (Responses): Ditto. - (Reply): Ditto. - -Wed Nov 26 12:57:00 1997 Lars Magne Ingebrigtsen - - * message.texi (Insertion): Addition. - -Wed Nov 26 12:55:15 1997 Hallvard B. Furuseth - - * message.texi (Insertion): Addition. - -Wed Nov 26 12:36:08 1997 Lars Magne Ingebrigtsen - - * message.texi (Responses): New. - (Appendices): New. - - * gnus.texi (Group Info): Fix. - -Tue Nov 25 17:53:55 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Article Date): Addition. - -Mon Nov 24 16:01:20 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Faces & Fonts): New. - -Mon Oct 13 00:08:06 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Agent Commands): Addition. - -Sun Oct 12 16:50:23 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Article Washing): Addition. - (Group Highlighting): New. - (Canceling and Superseding): Addition. - -Wed Oct 1 18:37:55 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Startup Files): Addition. - -Sat Sep 27 09:37:17 1997 Lars Magne Ingebrigtsen - - * message.texi (Sending Variables): Fix. - - * gnus.texi (Choosing Commands): Addition. - -Sat Sep 27 05:56:44 1997 Hallvard B. Furuseth - - * gnus.texi: Various fixes. - -Sat Sep 27 04:24:41 1997 Lars Magne Ingebrigtsen - - * message.texi (Various Commands): Addition. - -Wed Sep 24 02:38:21 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Example Setup): Wrong info. - (SOUP Groups): Addition. - (Contributors): Addition. - -1997-09-22 SL Baur - - * gnus.texi (Finding the Parent): Fix typo. - (NoCeM): Fix typos. - -Tue Sep 23 07:05:48 1997 Lars Magne Ingebrigtsen - - * gnus.texi (NoCeM): Addition. - (Finding the Parent): Addition. - -Mon Sep 22 06:13:00 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Filling In Threads): Addition. - (Finding the Parent): Addition. - -Sun Sep 21 04:35:56 1997 Lars Magne Ingebrigtsen - - * gnus.texi (NNTP): Addition. - (Hiding Headers): Addition. - (Symbolic Prefixes): New. - (Extended Interactive): New. - (Summary Score Commands): Addition. - -Sat Sep 20 20:53:43 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Startup Variables): Addition. - -1997-09-16 SL Baur - - * gnus.texi: Correct typo. - -Wed Sep 17 02:32:56 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Customizing Threading): Broken up into five nodes. - (Article Washing): Addition. - - * message.texi (Various Commands): Add. - -Tue Sep 16 04:04:03 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Example Setup): New. - -Mon Sep 15 23:10:05 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Customizing Threading): Addition. - -Sun Sep 14 21:59:07 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Outgoing Messages): New. - (Score File Format): Note. - (Subscription Methods): Fix. - (Starting Up): Fix. - (Threading): Add. - -Sat Jul 19 23:02:03 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Followups To Yourself): \\(_-_\\)? - -Sat Jul 12 16:29:35 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Picon Configuration): Moved Picons to under XEmacs. - (Smileys): New section. - -Fri Jul 11 11:58:20 1997 Lars Magne Ingebrigtsen - - * gnus.texi (NNTP): Addition. - -Tue Jun 17 23:52:17 1997 Justin Sheehy - - * gnus.texi (Group Parameters): Addition. - -Sun May 25 14:40:17 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Expiring Mail): Addition. - -Sat May 24 05:26:17 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Score File Format): Update. - -Tue May 20 21:56:03 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Document Server Internals): Typo. - -Sun May 18 05:59:24 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Topic Commands): Addition. - -Sun May 11 20:09:24 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Article Hiding): Change. - -Thu May 8 23:48:36 1997 James Troup - - * gnus.texi (Saving Articles): Typo. - -Wed May 7 19:00:48 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Saving Articles): Addition. - -Wed May 7 19:00:43 1997 Mark Boyns - - * gnus.texi (Saving Articles): Addition. - -Thu May 1 14:06:57 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Score File Format): Fix. - -Sun Apr 27 11:11:43 1997 Lars Magne Ingebrigtsen - - * gnus.texi (NNTP): Addition. - -Sat Apr 12 16:51:32 1997 Robert Bihlmeyer - - * gnus.texi (Thwarting Email Spam): Addition. - -Tue Apr 15 16:11:38 1997 Lars Magne Ingebrigtsen - - * message.texi (Various Message Variables): Addition. - - * gnus.texi (Thwarting Email Spam): Addition. - -Sat Apr 12 00:26:47 1997 Francois Felix Ingrand - - * gnus.texi (NoCeM): Addition. - -Thu Apr 10 21:25:14 1997 Hrvoje Niksic - - * gnus.texi (Emacs/XEmacs Code): Addition. - -Thu Apr 10 20:45:47 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Group Information): Fix. - -Wed Apr 2 11:48:44 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Sorting): Use total score. - -Tue Apr 1 11:44:57 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Subscription Methods): Addition. - (Group Info): Addition. - (Gnus Utility Functions): New. - (Thwarting Email Spam): Addition. - -Mon Mar 31 16:15:54 1997 Lars Magne Ingebrigtsen - - * message.texi (Various Message Variables): Addition. - -Sun Mar 23 02:16:19 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Thwarting Email Spam): New. - (Unavailable Servers): Fix. - -Wed Mar 19 15:45:17 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Various Summary Stuff): Addition. - (Mail Backend Variables): Addition. - -Tue Mar 18 14:43:32 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Article Washing): Not addition. - -Mon Mar 17 16:15:54 1997 Philippe Schnoebelen - - * Makefile (install): Install properly. - -Fri Mar 14 21:00:33 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Group Parameters): Addition. - (Expiring Mail): Addition. - -Wed Mar 12 06:57:14 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Various Various): Addition. - -Sat Mar 8 03:41:47 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Group Parameters): Added example. - (Duplicates): Fix. - -Fri Mar 7 10:49:43 1997 Lars Magne Ingebrigtsen - - * Makefile: New "install" target. - -Thu Mar 6 08:01:37 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Mail and Procmail): Fix. - -Sun Mar 2 02:08:40 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Startup Files): Addition. - (Score File Format): Fix. - -Fri Feb 28 23:23:31 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Archived Messages): Clarify. - (Fuzzy Matching): New. - -Mon Feb 24 23:41:57 1997 Lars Magne Ingebrigtsen - - * message.texi (Compatibility): New. - -Thu Feb 20 03:29:17 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Foreign Groups): Addition. - -Wed Feb 19 02:57:51 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Server Variables): New. - -Sun Feb 16 15:43:34 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Mail Backend Variables): Fix. - - * message.texi (Various Message Variables): Addition. - -Mon Feb 10 07:18:16 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Article Commands): Addition. - -Mon Feb 3 19:59:10 1997 Paul Franklin - - * gnus-group.el (gnus-group-edit-group): Allow editing of bad - groups. - -Wed Feb 5 02:00:46 1997 Lars Magne Ingebrigtsen - - * message.texi (Mail Variables): Change. - -Tue Feb 4 02:33:31 1997 Lars Magne Ingebrigtsen - - * message.texi (Mail Aliases): New. - - * gnus.texi (Splitting Mail): Addition. - -Mon Feb 3 07:31:47 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Mode Lines): Addition. - -Mon Jan 27 17:51:29 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Highlighting and Menus): Removed - `gnus-display-type'. - -Sat Jan 25 08:09:30 1997 Lars Magne Ingebrigtsen - - * gnus.texi (The Active File): Addition. - -Fri Jan 24 05:07:28 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Summary Mail Commands): Addition. - (Required Backend Functions): Deletia. - (Article Washing): Addition. - (Summary Mail Commands): Addition. - -Mon Jan 20 22:19:40 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Followups To Yourself): Fix. - -Fri Jan 17 00:55:51 1997 Lars Magne Ingebrigtsen - - * gnus.texi (NoCeM): Update. - -Wed Jan 15 02:23:03 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Mail Group Commands): Fix. - -Tue Jan 7 09:36:36 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Summary Buffer Lines): Correction. - -Mon Jan 6 22:49:12 1997 Lars Magne Ingebrigtsen - - * gnus.texi (NoCeM): Addition. - -Fri Jan 3 18:13:02 1997 Lars Magne Ingebrigtsen - - * message.texi (Various Commands): Addition. - -Thu Jan 2 16:12:27 1997 Lars Magne Ingebrigtsen - - * gnus.texi (Optional Backend Functions): Fix. - -Mon Dec 16 13:53:28 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Exiting the Summary Buffer): Update. - -Fri Dec 13 01:04:41 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Limiting): Addition. - -Sat Dec 7 21:10:23 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Example Methods): Addition. - -Fri Dec 6 12:38:14 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Group Parameters): Update. - -1996-11-30 Lars Magne Ingebrigtsen - - * gnus.texi (Terminology): Addition. - -Wed Nov 27 03:13:05 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Selecting a Group): Addition. - -Tue Nov 26 12:42:47 1996 Martin Buchholz - - * message.texi: Typo fixes and stuff. - -Thu Nov 21 17:45:57 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Canceling and Superseding): Fix. - -Wed Nov 20 15:42:36 1996 Lars Magne Ingebrigtsen - - * gnus.texi (New Groups): Addition. - (Summary Sorting): Addition. - -Tue Nov 19 20:54:16 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Scanning New Messages): Addition. - -Sat Nov 9 06:04:22 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Group Parameters): Addition. - -Fri Nov 8 04:01:06 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Article Fontisizing): New. - (Fancy Mail Splitting): Addition. - (Summary Post Commands): Addition. - (Mail Spool): Addition. - (Server Commands): Addition. - (Fancy Mail Splitting): Addition. - -Wed Nov 6 06:39:44 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Misc Article): Addition. - (Emacsen): Updated. - -Wed Nov 6 03:52:05 1996 C. R. Oldham - - * Makefile (.texi.dvi): Fix rule. - -Tue Nov 5 10:45:39 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Other Decode Variables): Addition. - (Mail-like Backends): New. - -Tue Nov 5 06:41:46 1996 Hrvoje Niksic - - * gnus.texi (Score File Format): Added warning. - -Mon Oct 28 15:50:08 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Startup Variables): Addition. - -Fri Oct 25 09:04:59 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Summary Mail Commands): Addition. - -Wed Oct 23 08:28:29 1996 Hrvoje Niksic - - * gnus.texi (Fancy Mail Splitting): Removed trailing garbage. - -Tue Oct 22 07:36:02 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Converting Kill Files): New. - -Sat Oct 19 07:17:28 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Saving Articles): Addition. - - * message.texi (Various Message Variables): Addition. - -Thu Oct 17 06:53:04 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Contributors): Added names. - -Fri Oct 11 12:38:59 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Adaptive Scoring): Addition. - -Tue Oct 8 13:16:41 1996 Lars Magne Ingebrigtsen - - * Makefile (all): Make custom. - -Wed Oct 2 01:32:49 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Group Timestamps): New. - -Tue Oct 1 01:34:45 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Expiring Mail): Addition. - (Group Line Specification): Addition. - -Sat Sep 28 21:36:40 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Foreign Groups): Addition. - -Mon Sep 23 22:17:44 1996 Lars Magne Ingebrigtsen - - * gnus.texi (The Summary Buffer): Addition. - -Mon Sep 23 18:25:38 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Thread Commands): Correction. - (Group Information): Correction. - -Sat Sep 21 08:11:43 1996 Lars Magne Ingebrigtsen - - * gnus.texi (New Groups): Split into three nodes. - (Group Parameters): Shortened. - (Browse Foreign Server): Corrected. - -Thu Sep 19 18:45:15 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Mail and Procmail): Addition. - -Wed Sep 18 07:33:11 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Other Marks): Edited. - (The Manual): New. - (Contributors): Updated. - (Asynchronous Fetching): Addition. - (New Features): Split. - ((ding) Gnus): Renamed. - (September Gnus): New. - (Red Gnus): New, - (Undo): New. - -Thu Sep 12 23:55:53 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Archived Messages): Fix. - -Sat Sep 7 12:14:23 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Various Various): Addition. - -Fri Sep 6 07:57:26 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Startup Files): Addition. - (Splitting Mail): Addition. - (Sorting Groups): Addition. - (Topic Sorting): New. - (Really Various Summary Commands): Deletia. - (Summary Generation Commands): New. - (Setting Process Marks): Addition. - -Thu Sep 5 07:34:27 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Terminology): Addition. - (Web Searches): Fix. - (Windows Configuration): Addition. - -Sun Sep 1 11:07:09 1996 Lars Magne Ingebrigtsen - - * gnus.texi (XEmacs Enhancements): New. - -Sat Aug 31 02:55:50 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Washing Mail): Addition. - -Fri Aug 30 09:10:17 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Washing Mail): New. - (Fancy Mail Splitting): Change. - -Fri Aug 30 00:21:59 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Foreign Groups): Change. - -Thu Aug 29 23:51:45 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Daemons): Addition. - -Thu Aug 29 02:09:24 1996 François Pinard - - * gnus.texi (Web Searches): Typo. - -Wed Aug 28 08:21:36 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Server Commands): Addition. - (Really Various Summary Commands): Addition. - -Mon Aug 26 18:29:23 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Optional Backend Functions): Deletia. - (Asynchronous Fetching): Deletia and addition. - -Sun Aug 25 23:39:03 1996 Lars Magne Ingebrigtsen - - * gnus.texi: Include the version number. - -Sun Aug 25 21:31:33 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Really Various Summary Commands): Addition. - -Sat Aug 17 22:24:34 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Startup Files): Addition. - (Anything Groups): Addition. - -Thu Aug 22 17:27:31 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Adaptive Scoring): Addition. - (Adaptive Scoring): Addition. - -Mon Aug 19 00:30:07 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Fancy Mail Splitting): Addition. - (Splitting Mail): Addition. - (Group Parameters): Addition. - (Topic Variables): Addition. - (Mail Group Commands): Addition. - (Group Information): Addition. - (Article Washing): Addition. - -Sun Aug 18 18:06:49 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Web Searches): Change and addition. - -Sat Aug 17 22:24:34 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Startup Files): Addition. - (Anything Groups): Addition. - -Thu Aug 15 17:59:12 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Followups To Yourself): Addition. - (Setting Process Marks): Addition. - (Process/Prefix): Addition. - (Startup Files): Addition. - (Mail-To-News Gateways): New. - -Wed Aug 14 15:02:14 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Home Score File): Fix. - (Various Various): New. - -Tue Aug 13 10:38:47 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Error Messaging): New. - (Mail Backend Variables): Fix. - (Foreign Groups): Added references. - (Sorting Groups): Addition. - -Sun Aug 11 02:52:37 1996 Lars Magne Ingebrigtsen - - * gnus.texi (User-Defined Specs): Correction. - (Unavailable Servers): Addition. - (Moderation): New. - (Summary Mail Commands): Addition. - (Crosspost Handling): Addition. - -Sat Aug 10 00:13:39 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Summary Buffer Lines): Correction. - (Top): Name fix. - (Compilation ): Addition. - (Group Parameters): Addition. - (Troubleshooting): Addition. - -Fri Aug 9 07:17:59 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Selecting a Group): Addition. - (Score Decays): New. - (Score File Format): Addition. - (Changing Servers): Addition. - (Selecting a Group): Addition. - (Really Various Summary Commands): Addition. - -Thu Aug 8 05:39:31 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Read Articles): Addition. - (Foreign Groups): Addition. - (User-Defined Specs): Separated. - (Formatting Fonts): Ditto. - (Advanced Formatting): New. - (Formatting Basics): Addition. - (Formatting Variables): Split. - -Wed Aug 7 22:00:56 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Hooking New Backends Into Gnus): New node. - -Wed Aug 7 01:02:08 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Setting Marks): Addition. - (Formatting Variables): Addition. - -Mon Aug 5 20:20:42 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Formatting Variables): Addition. - -Sun Aug 4 07:15:28 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Score File Format): Addition. - (Adaptive Scoring): Addition. - -Sat Aug 3 17:35:36 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Group Parameters): Addition. - (Home Score File): New. - (Topic Parameters): New. - -Wed Jul 31 15:34:12 1996 Lars Magne Ingebrigtsen - - * gnus.texi (are): Fix. - -Wed Jul 31 15:32:57 1996 David S. Goldberg - - * gnus.texi (buffer-name): Addition. - -Fri Aug 2 00:32:39 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Pick and Read): Addition. - (Article Hiding): Addition. - (Article Signature): Made into own node. - -Thu Aug 1 00:25:41 1996 Lars Magne Ingebrigtsen - - * message.texi (Wide Reply): Addition. - (Bouncing): Addition. - - * gnus.texi (Crosspost Handling): Made into own node. - (Duplicate Suppression): New. - (Document Server Internals): New. - (Changing Servers): New. - -Wed Jul 31 15:37:44 1996 Lars Magne Ingebrigtsen - - * gnus.texi: Fix - -Mon Jul 29 10:12:24 1996 Lars Magne Ingebrigtsen - - * gnus.texi (Misc Article): Addition. - (Advanced Scoring Tips): New. - (Advanced Scoring Example): New. - (Advanced Scoring Syntax): New. - (Advanced Scoring): New. - diff --git a/texi/Makefile b/texi/Makefile deleted file mode 100644 index ea5ef8f..0000000 --- a/texi/Makefile +++ /dev/null @@ -1,161 +0,0 @@ -TEXI2DVI=texi2dvi -EMACS=emacs -MAKEINFO=$(EMACS) -batch -q -no-site-file -INFOSWI=-l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer -XINFOSWI=-l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer -LATEX=latex -DVIPS=dvips -PERL=perl -INFODIR=/usr/local/info - -all: gnus message - -most: texi2latex.elc latex latexps - -.SUFFIXES: .texi .dvi .ps - -.texi: - $(MAKEINFO) -eval '(find-file "$<")' $(XINFOSWI) - -dvi: gnus.dvi message.dvi - -.texi.dvi : - $(PERL) -n -e 'print unless (/\@iflatex/ .. /\@end iflatex/)' $< > gnustmp.texi - $(TEXI2DVI) gnustmp.texi - cp gnustmp.dvi $*.dvi - rm gnustmp.* - -refcard.dvi: refcard.tex gnuslogo.refcard gnusref.tex - $(LATEX) refcard.tex - -clean: - rm -f gnus.*.bak *.ky *.cp *.fn *.cps *.kys *.log *.aux *.dvi *.vr \ - *.tp *.toc *.pg gnus.latexi *.aux *.[cgk]idx \ - gnus.ilg gnus.ind gnus.[cgk]ind gnus.idx \ - gnus.tmptexi *.tmplatexi gnus.tmplatexi1 texput.log *.orig *.rej \ - gnus.latexi*~* tmp/*.ps xface.tex picons.tex smiley.tex *.latexi - -makeinfo: - makeinfo -o gnus gnus.texi - makeinfo -o message message.texi - -texi2latex.elc: texi2latex.el - $(EMACS) -batch -l bytecomp --eval '(byte-compile-file "texi2latex.el")' - -latex: gnus.texi texi2latex.elc - $(EMACS) -batch -q -no-site-file gnus.texi -l ./texi2latex.elc -f latexi-translate - -latexps: - make texi2latex.elc - rm -f gnus.aux - egrep -v "label.*Index|chapter.*Index" gnus.latexi > gnus.tmplatexi1 - $(LATEX) gnus.tmplatexi1 - ./splitindex - makeindex -o gnus.kind gnus.kidx - makeindex -o gnus.cind gnus.cidx - makeindex -o gnus.gind gnus.gidx - sed 's/\\char 5E\\relax {}/\\symbol{"5E}/' < gnus.kind > gnus.tmpkind - mv gnus.tmpkind gnus.kind - egrep -v "end{document}" gnus.tmplatexi1 > gnus.tmplatexi - cat postamble.tex >> gnus.tmplatexi - $(LATEX) gnus.tmplatexi - $(LATEX) gnus.tmplatexi - $(DVIPS) -f gnus.dvi > gnus.ps - -pss: - make latex - make latexps - -psout: - make latex - make latexboth - make out - -latexboth: - rm -f gnus-manual-a4.ps.gz gnus-manual-standard.ps.gz - make latexps - mv /local/tmp/larsi/gnus.ps /local/tmp/larsi/gnus-manual-a4.ps - gzip /local/tmp/larsi/gnus-manual-a4.ps - sed 's/,a4paper//' gnus.latexi > gnus-standard.latexi - mv gnus-standard.latexi gnus.latexi - make latexps - mv /local/tmp/larsi/gnus.ps /local/tmp/larsi/gnus-manual-standard.ps - gzip /local/tmp/larsi/gnus-manual-standard.ps - -out: - cp /local/tmp/larsi/gnus-manual-standard.ps.gz \ - /local/tmp/larsi/gnus-manual-a4.ps.gz \ - /local/ftp/pub/emacs/gnus/manual - mv /local/tmp/larsi/gnus-manual-standard.ps.gz \ - /local/tmp/larsi/gnus-manual-a4.ps.gz \ - /hom/larsi/www_docs/www.gnus.org/documents - -veryclean: - make clean - rm -f gnus.dvi gnus.ps - -distclean: - make clean - rm -f *.orig *.rej *.elc *~ gnus gnus-[0-9] gnus-[0-9][0-9] - rm -f message message-[0-9] - -install: - cp gnus gnus-[0-9] gnus-[0-9][0-9] $(INFODIR) - cp message $(INFODIR) - - -tmps: - if [ ! -e tmp ]; then mkdir tmp; fi - make screens - make herdss - make etcs - make piconss - make xfaces - make smiley - make miscs - -herdss: - cd herds ; for i in new-herd-[0-9]*.gif; do echo $$i; giftopnm $$i | pnmcrop -white | pnmmargin -white 9 | pnmscale 2 | pnmconvol convol5.pnm | ppmtopgm | pnmdepth 255 | pnmtops -width 100 -height 100 -noturn > ../tmp/`basename $$i .gif`.ps; done - cd herds ; giftopnm new-herd-section.gif | pnmscale 4 | pnmconvol convol11.pnm | ppmtopgm | pnmdepth 255 | pnmtops -noturn -width 100 -height 100 > ../tmp/new-herd-section.ps - - -screens: - cd screen ; for i in *.gif; do echo $$i; giftopnm $$i | pnmmargin -black 1 | ppmtopgm | pnmtops -width 100 -height 100 -noturn > ../tmp/`basename $$i .gif`.ps; done - -miscs: - giftopnm misc/larsi.gif | ppmtopgm | pnmtops -noturn > tmp/larsi.ps - tifftopnm misc/eseptember.tif | pnmscale 4 | ppmtopgm | pnmtops -noturn -width 100 -height 100 > tmp/september.ps - tifftopnm misc/fseptember.tif | pnmscale 2 | ppmtopgm | pnmtops -noturn -width 100 -height 100 > tmp/fseptember.ps - tifftopnm misc/fred.tif | pnmscale 2 | ppmtopgm | pnmtops -noturn -width 100 -height 100 > tmp/fred.ps - tifftopnm misc/ered.tif | pnmscale 2 | ppmtopgm | pnmtops -noturn -width 100 -height 100 > tmp/red.ps - -etcs: - cd etc; for i in gnus-*.xpm; do echo $$i; xpmtoppm $$i | ppmtopgm | pnmdepth 255 | pnmtops -noturn > ../tmp/`basename $$i .xpm`.ps; done - -piconss: - cd picons; for i in *.xbm; do echo $$i; xbmtopbm $$i | pnmtops -noturn > ../tmp/picons-`basename $$i .xbm`.ps; done - cd picons; for i in *.gif; do echo $$i; giftopnm $$i | ppmtopgm | pnmtops -noturn > ../tmp/picons-`basename $$i .gif`.ps; done - for i in tmp/picons-*.ps; do echo "\\gnuspicon{$$i}"; done > picons.tex - -xfaces: - cd xface; for i in *.gif; do echo $$i; giftopnm $$i | ppmtopgm | pnmtops -noturn > ../tmp/xface-`basename $$i .gif`.ps; done - for i in tmp/xface-*.ps; do \ - if [ -n "$$a" ]; then a=""; echo "{$$i}"; else \ - a="h"; echo -n "\\gnusxface{$$i}"; fi done > xface.tex; \ - if [ -n "$$a" ]; then echo "{$$i}" >> xface.tex; fi - -smiley: - cd smilies; tifftopnm BigFace.tif | ppmtopgm | pnmtops > ../tmp/BigFace.ps - cd smilies; for i in *.xpm; do echo $$i; sed "s/none/#FFFFFF/" $$i | xpmtoppm | ppmtopgm | pnmdepth 255 | pnmtops > ../tmp/smiley-`basename $$i .xpm`.ps; done - for i in tmp/smiley-*.ps; do \ - if [ -n "$$a" ]; then a=""; echo "{$$i}"; else \ - a="h"; echo -n "\\gnussmiley{$$i}"; fi done > smiley.tex; \ - if [ -n "$$a" ]; then echo "{$$i}" >> smiley.tex; fi - -pspackage: - tar czvf pspackage.tar.gz gnus-faq.texi gnus.texi herds misc pagestyle.sty picons pixidx.sty postamble.tex ps screen smilies splitindex texi2latex.el xface Makefile README etc - -complete: - make texi2latex.elc - make tmps - make pss diff --git a/texi/custom.texi b/texi/custom.texi deleted file mode 100644 index 5b6fe4a..0000000 --- a/texi/custom.texi +++ /dev/null @@ -1,695 +0,0 @@ -\input texinfo.tex - -@c %**start of header -@setfilename custom -@settitle The Customization Library -@iftex -@afourpaper -@headings double -@end iftex -@c %**end of header - -@node Top, Introduction, (dir), (dir) -@comment node-name, next, previous, up -@top The Customization Library - -Version: 1.82 - -@menu -* Introduction:: -* User Commands:: -* The Customization Buffer:: -* Declarations:: -* Utilities:: -* The Init File:: -* Wishlist:: -@end menu - -@node Introduction, User Commands, Top, Top -@comment node-name, next, previous, up -@section Introduction - -This library allows customization of @dfn{user options}. Currently two -types of user options are supported, namely @dfn{variables} and -@dfn{faces}. Each user option can have four different values -simultaneously: -@table @dfn -@item factory setting -The value specified by the programmer. -@item saved value -The value saved by the user as the default for this variable. This -overwrites the factory setting when starting a new emacs. -@item current value -The value used by Emacs. This will not be remembered next time you -run Emacs. -@item widget value -The value entered by the user in a customization buffer, but not yet -applied. -@end table - -Variables also have a @dfn{type}, which specifies what kind of values -the variable can hold, and how the value is presented in a customization -buffer. By default a variable can hold any valid expression, but the -programmer can specify a more limited type when declaring the variable. - -The user options are organized in a number of @dfn{groups}. Each group -can contain a number user options, as well as other groups. The groups -allows the user to concentrate on a specific part of emacs. - -@node User Commands, The Customization Buffer, Introduction, Top -@comment node-name, next, previous, up -@section User Commands - -The following commands will create a customization buffer: - -@table @code -@item customize -Create a customization buffer containing a specific group, by default -the @code{emacs} group. - -@item customize-variable -Create a customization buffer containing a single variable. - -@item customize-face -Create a customization buffer containing a single face. - -@item customize-apropos -Create a customization buffer containing all variables, faces, and -groups that match a user specified regular expression. -@end table - -@node The Customization Buffer, Declarations, User Commands, Top -@comment node-name, next, previous, up -@section The Customization Buffer. - -The customization buffer allows the user to make temporary or permanent -changes to how specific aspects of emacs works, by setting and editing -user options. - -The customization buffer contains three types of text: - -@table @dfn -@item informative text -where the normal editing commands are disabled. - -@item editable fields -where you can edit with the usual emacs commands. Editable fields are -usually displayed with a grey background if your terminal supports -colors, or an italic font otherwise. - -@item buttons -which can be activated by either pressing the @kbd{@key{ret}} while -point is located on the text, or pushing @kbd{mouse-2} while the mouse -pointer is above the tex. Buttons are usually displayed in a bold -font. -@end table - -You can move to the next the next editable field or button by pressing -@kbd{@key{tab}} or the previous with @kbd{M-@key{tab}}. Some buttons -have a small helpful message about their purpose, which will be -displayed when you move to it with the @key{tab} key. - -The buffer is divided into three part, an introductory text, a list of -customization options, and a line of customization buttons. Each part -will be described in the following. - -@menu -* The Introductory Text:: -* The Customization Options:: -* The Variable Options:: -* The Face Options:: -* The Group Options:: -* The State Button:: -* The Customization Buttons:: -@end menu - -@node The Introductory Text, The Customization Options, The Customization Buffer, The Customization Buffer -@comment node-name, next, previous, up -@subsection The Introductory Text - -The start of the buffer contains a short explanation of what it is, and -how to get help. It will typically look like this: - -@example -This is a customization buffer. -Push RET or click mouse-2 on the word _help_ for more information. -@end example - -Rather boring. It is mostly just informative text, but the word -@samp{help} is a button that will bring up this document when -activated. - -@node The Customization Options, The Variable Options, The Introductory Text, The Customization Buffer -@comment node-name, next, previous, up -@subsection The Customization Options - -Each customization option looks similar to the following text: - -@example - *** custom-background-mode: default - State: this item is unchanged from its factory setting. - [ ] [?] The brightness of the background. -@end example - -The option contains the parts described below. - -@table @samp -@item *** -The Level Button. The customization options in the buffer are organized -in a hierarchy, which is indicated by the number of stars in the level -button. The top level options will be shown as @samp{*}. When they are -expanded, the suboptions will be shown as @samp{**}. The example option -is thus a subsuboption. - -Activating the level buttons will toggle between hiding and exposing the -content of that option. The content can either be the value of the -option, as in this example, or a list of suboptions. - -@item custom-background-mode -This is the tag of the the option. The tag is a name of a variable, a -face, or customization group. Activating the tag has an effect that -depends on the exact type of the option. In this particular case, -activating the tag will bring up a menu that will allow you to choose -from the three possible values of the `custom-background-mode' -variable. - -@item default -After the tag, the options value is shown. Depending on its type, you -may be able to edit the value directly. If an option should contain a -file name, it is displayed in an editable field, i.e. you can edit it -using the standard emacs editing commands. - -@item State: this item is unchanged from its factory setting. -The state line. This line will explain the state of the option, -e.g. whether it is currently hidden, or whether it has been modified or -not. Activating the button will allow you to change the state, e.g. set -or reset the changes you have made. This is explained in detail in the -following sections. - -@item [ ] -The magic button. This is an abbreviated version of the state line. - -@item [?] -The documentation button. If the documentation is more than one line, -this button will be present. Activating the button will toggle whether -the complete documentation is shown, or only the first line. - -@item The brightness of the background. -This is a documentation string explaining the purpose of this particular -customization option. - -@end table - -@node The Variable Options, The Face Options, The Customization Options, The Customization Buffer -@comment node-name, next, previous, up -@subsection The Variable Options - -The most common customization options are emacs lisp variables. The -actual editing of these variables depend on what type values the -variable is expected to contain. For example, a lisp variable whose -value should be a string will typically be represented with an editable -text field in the buffer, where you can change the string directly. If -the value is a list, each item in the list will be presented in the -buffer buffer on a separate line, with buttons to insert new items in -the list, or delete existing items from the list. You may want to see -@ref{User Interface,,, widget, The Widget Library}, where some examples -of editing are discussed. - -You can either choose to edit the value directly, or edit the lisp -value for that variable. The lisp value is a lisp expression that -will be evaluated when you start emacs. The result of the evaluation -will be used as the initial value for that variable. Editing the -lisp value is for experts only, but if the current value of the -variable is of a wrong type (i.e. a symbol where a string is expected), -the `edit lisp' mode will always be selected. - -You can see what mode is currently selected by looking at the state -button. If it uses parenthesises (like @samp{( )}) it is in edit lisp -mode, with square brackets (like @samp{[ ]}) it is normal edit mode. -You can switch mode by activating the state button, and select either -@samp{Edit} or @samp{Edit lisp} from the menu. - -You can change the state of the variable with the other menu items: - -@table @samp -@item Set -When you have made your modifications in the buffer, you need to -activate this item to make the modifications take effect. The -modifications will be forgotten next time you run emacs. - -@item Save -Unless you activate this item instead! This will mark the modification -as permanent, i.e. the changes will be remembered in the next emacs -session. - -@item Reset -If you have made some modifications and not yet applied them, you can -undo the modification by activating this item. - -@item Reset to Saved -Activating this item will reset the value of the variable to the last -value you marked as permanent with `Save'. - -@item Reset to Factory Settings -Activating this item will undo all modifications you have made, and -reset the value to the initial value specified by the program itself. -@end table - -By default, the value of large or complicated variables are hidden. You -can show the value by clicking on the level button. - -@node The Face Options, The Group Options, The Variable Options, The Customization Buffer -@comment node-name, next, previous, up -@subsection The Face Options - -A face is an object that controls the appearance of some buffer text. -The face has a number of possible attributes, such as boldness, -foreground color, and more. For each attribute you can specify whether -this attribute is controlled by the face, and if so, what the value is. -For example, if the attribute bold is not controlled by a face, using -that face on some buffer text will not affect its boldness. If the bold -attribute is controlled by the face, it can be turned either on or of. - -It is possible to specify that a face should have different attributes -on different device types. For example, a face may make text red on a -color device, and bold on a monochrome device. You do this by -activating `Edit All' in the state menu. - -The way this is presented in the customization buffer is to have a list -of display specifications, and for each display specification a list of -face attributes. For each face attribute, there is a checkbox -specifying whether this attribute has effect and what the value is. -Here is an example: - -@example - *** custom-invalid-face: (sample) - State: this item is unchanged from its factory setting. - [ ] Face used when the customize item is invalid. - [INS] [DEL] Display: [ ] Type: [ ] X [ ] PM [ ] Win32 [ ] DOS [ ] TTY - [X] Class: [X] Color [ ] Grayscale [ ] Monochrome - [ ] Background: [ ] Light [ ] Dark - Attributes: [ ] Bold: off - [ ] Italic: off - [ ] Underline: off - [X] Foreground: yellow (sample) - [X] Background: red (sample) - [ ] Stipple: - [INS] [DEL] Display: all - Attributes: [X] Bold: on - [X] Italic: on - [X] Underline: on - [ ] Foreground: default (sample) - [ ] Background: default (sample) - [ ] Stipple: - [INS] -@end example - -This has two display specifications. The first will match all color -displays, independently on what window system the device belongs to, and -whether background color is dark or light. For devices matching this -specification, @samp{custom-invalid-face} will force text to be -displayed in yellow on red, but leave all other attributes alone. - -The second display will simply match everything. Since the list is -prioritised, this means that it will match all non-color displays. For -these, the face will not affect the foreground or background color, but -force the font to be both bold, italic, and underline. - -You can add or delete display specifications by activating the -@samp{[INS]} and @samp{[DEL]} buttons, and modify them by clicking on -the check boxes. The first checkbox in each line in the display -specification is special. It specify whether this particular property -will even be relevant. By not checking the box in the first display, we -match all device types, also device types other than those listed. - -After modifying the face, you can activate the state button to make the -changes take effect. The menu items in the state button menu is similar -to the state menu items for variables described in the previous section. - -@node The Group Options, The State Button, The Face Options, The Customization Buffer -@comment node-name, next, previous, up -@subsection The Group Options - -Since Emacs has approximately a zillion configuration options, they have -been organized in groups. Each group can contain other groups, thus -creating a customization hierarchy. The nesting of the customization -within the visible part of this hierarchy is indicated by the number of -stars in the level button. - -Since there is really no customization needed for the group itself, the -menu items in the groups state button will affect all modified group -members recursively. Thus, if you activate the @samp{Set} menu item, -all variables and faces that have been modified and belong to that group -will be applied. For those members that themselves are groups, it will -work as if you had activated the @samp{Set} menu item on them as well. - -@node The State Button, The Customization Buttons, The Group Options, The Customization Buffer -@comment node-name, next, previous, up -@subsection The State Line and The Magic Button - -The state line has two purposes. The first is to hold the state menu, -as described in the previous sections. The second is to indicate the -state of each customization item. - -For the magic button, this is done by the character inside the brackets. -The following states have been defined, the first that applies to the -current item will be used: - -@table @samp -@item - -The option is currently hidden. For group options that means the -members are not shown, for variables and faces that the value is not -shown. You cannot perform any of the state change operations on a -hidden customization option. - -@item * -The value if this option has been modified in the buffer, but not yet -applied. - -@item + -The item has has been set by the user. - -@item : -The current value of this option is different from the saved value. - -@item ! -The saved value of this option is different from the factory setting. - -@item @@ -The factory setting of this option is not known. This occurs when you -try to customize variables or faces that have not been explicitly -declared as customizable. - -@item SPC -The factory setting is still in effect. - -@end table - -For non-hidden group options, the state shown is the most severe state -of its members, where more severe means that it appears earlier in the -list above (except hidden members, which are ignored). - -@node The Customization Buttons, , The State Button, The Customization Buffer -@comment node-name, next, previous, up -@subsection The Customization Buttons - -The last part of the customization buffer looks like this: - -@example -[Set] [Save] [Reset] [Done] -@end example - -Activating the @samp{[Set]}, @samp{[Save]}, or @samp{[Reset]} -button will affect all modified customization items that are visible in -the buffer. @samp{[Done]} will bury the buffer. - -@node Declarations, Utilities, The Customization Buffer, Top -@comment node-name, next, previous, up -@section Declarations - -This section describes how to declare customization groups, variables, -and faces. It doesn't contain any examples, but please look at the file -@file{cus-edit.el} which contains many declarations you can learn from. - -@menu -* Declaring Groups:: -* Declaring Variables:: -* Declaring Faces:: -* Usage for Package Authors:: -@end menu - -All the customization declarations can be changes by keyword arguments. -Groups, variables, and faces all share these common keywords: - -@table @code -@item :group -@var{value} should be a customization group. -Add @var{symbol} to that group. -@item :link -@var{value} should be a widget type. -Add @var{value} to the extrenal links for this customization option. -Useful widget types include @code{custom-manual}, @code{info-link}, and -@code{url-link}. -@item :load -Add @var{value} to the files that should be loaded nefore displaying -this customization option. The value should be iether a string, which -should be a string which will be loaded with @code{load-library} unless -present in @code{load-history}, or a symbol which will be loaded with -@code{require}. -@item :tag -@var{Value} should be a short string used for identifying the option in -customization menus and buffers. By default the tag will be -automatically created from the options name. -@end table - -@node Declaring Groups, Declaring Variables, Declarations, Declarations -@comment node-name, next, previous, up -@subsection Declaring Groups - -Use @code{defgroup} to declare new customization groups. - -@defun defgroup symbol members doc [keyword value]... -Declare @var{symbol} as a customization group containing @var{members}. -@var{symbol} does not need to be quoted. - -@var{doc} is the group documentation. - -@var{members} should be an alist of the form ((@var{name} -@var{widget})...) where @var{name} is a symbol and @var{widget} is a -widget for editing that symbol. Useful widgets are -@code{custom-variable} for editing variables, @code{custom-face} for -editing faces, and @code{custom-group} for editing groups.@refill - -Internally, custom uses the symbol property @code{custom-group} to keep -track of the group members, and @code{group-documentation} for the -documentation string. - -The following additional @var{keyword}'s are defined: - -@table @code -@item :prefix -@var{value} should be a string. If the string is a prefix for the name -of a member of the group, that prefix will be ignored when creating a -tag for that member. -@end table -@end defun - -@node Declaring Variables, Declaring Faces, Declaring Groups, Declarations -@comment node-name, next, previous, up -@subsection Declaring Variables - -Use @code{defcustom} to declare user editable variables. - -@defun defcustom symbol value doc [keyword value]... -Declare @var{symbol} as a customizable variable that defaults to @var{value}. -Neither @var{symbol} nor @var{value} needs to be quoted. -If @var{symbol} is not already bound, initialize it to @var{value}. - -@var{doc} is the variable documentation. - -The following additional @var{keyword}'s are defined: - -@table @code -@item :type -@var{value} should be a widget type. -@item :options -@var{value} should be a list of possible members of the specified type. -For hooks, this is a list of function names. -@end table - -@xref{Sexp Types,,,widget,The Widget Library}, for information about -widgets to use together with the @code{:type} keyword. -@end defun - -Internally, custom uses the symbol property @code{custom-type} to keep -track of the variables type, @code{factory-value} for the program -specified default value, @code{saved-value} for a value saved by the -user, and @code{variable-documentation} for the documentation string. - -Use @code{custom-add-option} to specify that a specific function is -useful as an meber of a hook. - -@defun custom-add-option symbol option -To the variable @var{symbol} add @var{option}. - -If @var{symbol} is a hook variable, @var{option} should be a hook -member. For other types variables, the effect is undefined." -@end defun - -@node Declaring Faces, Usage for Package Authors, Declaring Variables, Declarations -@comment node-name, next, previous, up -@subsection Declaring Faces - -Faces are declared with @code{defface}. - -@defun defface face spec doc [keyword value]... - -Declare @var{face} as a customizable face that defaults to @var{spec}. -@var{face} does not need to be quoted. - -If @var{face} has been set with `custom-set-face', set the face attributes -as specified by that function, otherwise set the face attributes -according to @var{spec}. - -@var{doc} is the face documentation. - -@var{spec} should be an alist of the form @samp{((@var{display} @var{atts})...)}. - -@var{atts} is a list of face attributes and their values. The possible -attributes are defined in the variable `custom-face-attributes'. -Alternatively, @var{atts} can be a face in which case the attributes of -that face is used. - -The @var{atts} of the first entry in @var{spec} where the @var{display} -matches the frame should take effect in that frame. @var{display} can -either be the symbol `t', which will match all frames, or an alist of -the form @samp{((@var{req} @var{item}...)...)}@refill - -For the @var{display} to match a FRAME, the @var{req} property of the -frame must match one of the @var{item}. The following @var{req} are -defined:@refill - -@table @code -@item type -(the value of (window-system))@* -Should be one of @code{x} or @code{tty}. - -@item class -(the frame's color support)@* -Should be one of @code{color}, @code{grayscale}, or @code{mono}. - -@item background -(what color is used for the background text)@* -Should be one of @code{light} or @code{dark}. -@end table - -Internally, custom uses the symbol property @code{factory-face} for the -program specified default face properties, @code{saved-face} for -properties saved by the user, and @code{face-doc-string} for the -documentation string.@refill - -@end defun - -@node Usage for Package Authors, , Declaring Faces, Declarations -@comment node-name, next, previous, up -@subsection Usage for Package Authors - -The recommended usage for the author of a typical emacs lisp package is -to create one group identifying the package, and make all user options -and faces members of that group. If the package has more than around 20 -such options, they should be divided into a number of subgroups, with -each subgroup being member of the top level group. - -The top level group for the package should itself be member of one or -more of the standard customization groups. There exists a group for -each @emph{finder} keyword. Press @kbd{C-c p} to see a list of finder -keywords, and add you group to each of them, using the @code{:group} -keyword. - -@node Utilities, The Init File, Declarations, Top -@comment node-name, next, previous, up -@section Utilities - -These utilities can come in handy when adding customization support. - -@deffn Widget custom-manual -Widget type for specifying the info manual entry for a customization -option. It takes one argument, an info address. -@end deffn - -@defun custom-add-to-group group member widget -To existing @var{group} add a new @var{member} of type @var{widget}, -If there already is an entry for that member, overwrite it. -@end defun - -@defun custom-add-link symbol widget -To the custom option @var{symbol} add the link @var{widget}. -@end defun - -@defun custom-add-load symbol load -To the custom option @var{symbol} add the dependency @var{load}. -@var{load} should be either a library file name, or a feature name. -@end defun - -@defun custom-menu-create symbol &optional name -Create menu for customization group @var{symbol}. -If optional @var{name} is given, use that as the name of the menu. -Otherwise make up a name from @var{symbol}. -The menu is in a format applicable to @code{easy-menu-define}. -@end defun - -@node The Init File, Wishlist, Utilities, Top -@comment node-name, next, previous, up -@section The Init File - -When you save the customizations, call to @code{custom-set-variables}, -@code{custom-set-faces} are inserted into the file specified by -@code{custom-file}. By default @code{custom-file} is your @file{.emacs} -file. If you use another file, you must explicitly load it yourself. -The two functions will initialize variables and faces as you have -specified. - -@node Wishlist, , The Init File, Top -@comment node-name, next, previous, up -@section Wishlist - -@itemize @bullet -@item -The menu items should be grayed out when the information is -missing. I.e. if a variable doesn't have a factory setting, the user -should not be allowed to select the @samp{Factory} menu item. - -@item -Better support for keyboard operations in the customize buffer. - -@item -Integrate with @file{w3} so you can customization buffers with much -better formatting. I'm thinking about adding a name -tag. The latest w3 have some support for this, so come up with a -convincing example. - -@item -Add an `examples' section, with explained examples of custom type -definitions. - -@item -Support selectable color themes. I.e., change many faces by setting one -variable. - -@item -Support undo using lmi's @file{gnus-undo.el}. - -@item -Make it possible to append to `choice', `radio', and `set' options. - -@item -Make it possible to customize code, for example to enable or disable a -global minor mode. - -@item -Ask whether set or modified variables should be saved in -@code{kill-buffer-hook}. - -Ditto for @code{kill-emacs-query-functions}. - -@item -Command to check if there are any customization options that -does not belong to an existing group. - -@item -Optionally disable the point-cursor and instead highlight the selected -item in XEmacs. This is like the *Completions* buffer in XEmacs. -Suggested by Jens Lautenbacher -@samp{}.@refill - -@item -Empty customization groups should start open (harder than it looks). - -@item -Make it possible to include a comment/remark/annotation when saving an -option. - -@end itemize - -@contents -@bye diff --git a/texi/dir b/texi/dir deleted file mode 100644 index e69de29..0000000 diff --git a/texi/gnus-faq.texi b/texi/gnus-faq.texi deleted file mode 100644 index abc9054..0000000 --- a/texi/gnus-faq.texi +++ /dev/null @@ -1,659 +0,0 @@ -@c Insert "\input texinfo" at 1st line before texing this file alone. -@c -*-texinfo-*- -@c Copyright (C) 1995 Free Software Foundation, Inc. -@setfilename gnus-faq.info - -@node Frequently Asked Questions -@section Frequently Asked Questions - -This is the Gnus Frequently Asked Questions list. -If you have a Web browser, the official hypertext version is at -@file{http://www.ccs.neu.edu/software/gnus/}, and has -probably been updated since you got this manual. - -@menu -* Installation FAQ:: Installation of Gnus. -* Customization FAQ:: Customizing Gnus. -* Reading News FAQ:: News Reading Questions. -* Reading Mail FAQ:: Mail Reading Questions. -@end menu - - -@node Installation FAQ -@subsection Installation - -@itemize @bullet -@item -Q1.1 What is the latest version of Gnus? - -The latest (and greatest) version is 5.0.10. You might also run -across something called @emph{September Gnus}. September Gnus -is the alpha version of the next major release of Gnus. It is currently -not stable enough to run unless you are prepared to debug lisp. - -@item -Q1.2 Where do I get Gnus? - -Any of the following locations: - -@itemize @minus -@item -@file{ftp://ftp.ifi.uio.no/pub/emacs/gnus/gnus.tar.gz} - -@item -@file{ftp://ftp.pilgrim.umass.edu/pub/misc/ding/} - -@item -@file{gopher://gopher.pilgrim.umass.edu/11/pub/misc/ding/} - -@item -@file{ftp://aphrodite.nectar.cs.cmu.edu/pub/ding-gnus/} - -@item -@file{ftp://ftp.solace.mh.se:/pub/gnu/elisp/} - -@end itemize - -@item -Q1.3 Which version of Emacs do I need? - -At least GNU Emacs 19.28, or XEmacs 19.12 is recommended. GNU Emacs -19.25 has been reported to work under certain circumstances, but it -doesn't @emph{officially} work on it. 19.27 has also been reported to -work. Gnus has been reported to work under OS/2 as well as Unix. - - -@item -Q1.4 Where is timezone.el? - -Upgrade to XEmacs 19.13. In earlier versions of XEmacs this file was -placed with Gnus 4.1.3, but that has been corrected. - - -@item -Q1.5 When I run Gnus on XEmacs 19.13 I get weird error messages. - -You're running an old version of Gnus. Upgrade to at least version -5.0.4. - - -@item -Q1.6 How do I unsubscribe from the Mailing List? - -Send an e-mail message to @file{ding-request@@ifi.uio.no} with the magic word -@emph{unsubscribe} somewhere in it, and you will be removed. - -If you are reading the digest version of the list, send an e-mail message -to @* -@file{ding-rn-digests-d-request@@moe.shore.net} -with @emph{unsubscribe} as the subject and you will be removed. - - -@item -Q1.7 How do I run Gnus on both Emacs and XEmacs? - -The basic answer is to byte-compile under XEmacs, and then you can -run under either Emacsen. There is, however, a potential version -problem with easymenu.el with Gnu Emacs prior to 19.29. - -Per Abrahamsen writes :@* -The internal easymenu.el interface changed between 19.28 and 19.29 in -order to make it possible to create byte compiled files that can be -shared between Gnu Emacs and XEmacs. The change is upward -compatible, but not downward compatible. -This gives the following compatibility table: - -@example -Compiled with: | Can be used with: -----------------+-------------------------------------- -19.28 | 19.28 19.29 -19.29 | 19.29 XEmacs -XEmacs | 19.29 XEmacs -@end example - -If you have Gnu Emacs 19.28 or earlier, or XEmacs 19.12 or earlier, get -a recent version of auc-menu.el from -@file{ftp://ftp.iesd.auc.dk/pub/emacs-lisp/auc-menu.el}, and install it -under the name easymenu.el somewhere early in your load path. - - -@item -Q1.8 What resources are available? - -There is the newsgroup Gnu.emacs.gnus. Discussion of Gnus 5.x is now -taking place there. There is also a mailing list, send mail to -@file{ding-request@@ifi.uio.no} with the magic word @emph{subscribe} -somewhere in it. - -@emph{NOTE:} the traffic on this list is heavy so you may not want to be -on it (unless you use Gnus as your mailer reader, that is). The mailing -list is mainly for developers and testers. - -Gnus has a home World Wide Web page at@* -@file{http://www.ifi.uio.no/~larsi/ding.html}. - -Gnus has a write up in the X Windows Applications FAQ at@* -@file{http://www.ee.ryerson.ca:8080/~elf/xapps/Q-III.html}. - -The Gnus manual is also available on the World Wide Web. The canonical -source is in Norway at@* -@file{http://www.ifi.uio.no/~larsi/ding-manual/gnus_toc.html}. - -There are three mirrors in the United States: -@enumerate -@item -@file{http://www.miranova.com/gnus-man/} - -@item -@file{http://www.pilgrim.umass.edu/pub/misc/ding/manual/gnus_toc.html} - -@item -@file{http://www.rtd.com/~woo/gnus/} - -@end enumerate - -PostScript copies of the Gnus Reference card are available from@* -@file{ftp://ftp.cs.ualberta.ca/pub/oolog/gnus/}. They are mirrored at@* -@file{ftp://ftp.pilgrim.umass.edu/pub/misc/ding/refcard/} in the -United States. And@* -@file{ftp://marvin.fkphy.uni-duesseldorf.de/pub/gnus/} -in Germany. - -An online version of the Gnus FAQ is available at@* -@file{http://www.miranova.com/~steve/gnus-faq.html}. Off-line formats -are also available:@* -ASCII: @file{ftp://ftp.miranova.com/pub/gnus/gnus-faq}@* -PostScript: @file{ftp://ftp.miranova.com/pub/gnus/gnus-faq.ps}. - - -@item -Q1.9 Gnus hangs on connecting to NNTP server - -I am running XEmacs on SunOS and Gnus prints a message about Connecting -to NNTP server and then just hangs. - -Ben Wing writes :@* -I wonder if you're hitting the infamous @emph{libresolv} problem. -The basic problem is that under SunOS you can compile either -with DNS or NIS name lookup libraries but not both. Try -substituting the IP address and see if that works; if so, you -need to download the sources and recompile. - - -@item -Q1.10 Mailcrypt 3.4 doesn't work - -This problem is verified to still exist in Gnus 5.0.9 and Mailcrypt 3.4. -The answer comes from Peter Arius -. - -I found out that mailcrypt uses -@code{gnus-eval-in-buffer-window}, which is a macro. -It seems as if you have -compiled mailcrypt with plain old GNUS in load path, and the XEmacs byte -compiler has inserted that macro definition into -@file{mc-toplev.elc}. -The solution is to recompile @file{mc-toplev.el} with Gnus 5 in -load-path, and it works fine. - -Steve Baur adds :@* -The problem also manifests itself if neither GNUS 4 nor Gnus 5 is in the -load-path. - - -@item -Q1.11 What other packages work with Gnus? - -@itemize @minus -@item -Mailcrypt. - -Mailcrypt is an Emacs interface to PGP. It works, it installs -without hassle, and integrates very easily. Mailcrypt can be -obtained from@* -@file{ftp://cag.lcs.mit.edu/pub/patl/mailcrypt-3.4.tar.gz}. - -@item -Tools for Mime. - -Tools for Mime is an Emacs MUA interface to MIME. Installation is -a two-step process unlike most other packages, so you should -be prepared to move the byte-compiled code somewhere. There -are currently two versions of this package available. It can -be obtained from@* -@file{ftp://ftp.jaist.ac.jp/pub/GNU/elisp/}. -Be sure to apply the supplied patch. It works with Gnus through -version 5.0.9. In order for all dependencies to work correctly -the load sequence is as follows: -@lisp - (load "tm-setup") - (load "gnus") - (load "mime-compose") -@end lisp - -@emph{NOTE:} Loading the package disables citation highlighting by -default. To get the old behavior back, use the @kbd{M-t} command. - -@end itemize - -@end itemize - - -@node Customization FAQ -@subsection Customization - -@itemize @bullet -@item -Q2.1 Custom Edit does not work under XEmacs - -The custom package has not been ported to XEmacs. - - -@item -Q2.2 How do I quote messages? - -I see lots of messages with quoted material in them. I am wondering -how to have Gnus do it for me. - -This is Gnus, so there are a number of ways of doing this. You can use -the built-in commands to do this. There are the @kbd{F} and @kbd{R} -keys from the summary buffer which automatically include the article -being responded to. These commands are also selectable as @i{Followup -and Yank} and @i{Reply and Yank} in the Post menu. - -@kbd{C-c C-y} grabs the previous message and prefixes each line with -@code{ail-indentation-spaces} spaces or @code{mail-yank-prefix} if that is -non-nil, unless you have set your own @code{mail-citation-hook}, which will -be called to do the job. - -You might also consider the Supercite package, which allows for pretty -arbitrarily complex quoting styles. Some people love it, some people -hate it. - - -@item -Q2.3 How can I keep my nnvirtual:* groups sorted? - -How can I most efficiently arrange matters so as to keep my nnvirtual:* -(etc) groups at the top of my group selection buffer, whilst keeping -everything sorted in alphabetical order. - -If you don't subscribe often to new groups then the easiest way is to -first sort the groups and then manually kill and yank the virtuals -wherever you want them. - - -@item -Q2.4 Any good suggestions on stuff for an all.SCORE file? - -Here is a collection of suggestions from the Gnus mailing list. - -@enumerate -@item -From ``Dave Disser'' @* -I like blasting anything without lowercase letters. Weeds out most of -the make $$ fast, as well as the lame titles like ``IBM'' and ``HP-UX'' -with no further description. -@lisp - (("Subject" - ("^\\(Re: \\)?[^a-z]*$" -200 nil R))) -@end lisp - -@item -From ``Peter Arius'' @* -The most vital entries in my (still young) all.SCORE: -@lisp -(("xref" - ("alt.fan.oj-simpson" -1000 nil s)) - ("subject" - ("\\<\\(make\\|fast\\|big\\)\\s-*\\(money\\|cash\\|bucks?\\)\\>" -1000 nil r) - ("$$$$" -1000 nil s))) -@end lisp - -@item -From ``Per Abrahamsen'' @* -@lisp -(("subject" - ;; CAPS OF THE WORLD, UNITE - ("^..[^a-z]+$" -1 nil R) - ;; $$$ Make Money $$$ (Try work) - ("$" -1 nil s) - ;; I'm important! And I have exclamation marks to prove it! - ("!" -1 nil s))) -@end lisp - -@item -From ``heddy boubaker'' @* -I would like to contribute with mine. -@lisp -( - (read-only t) - ("subject" - ;; ALL CAPS SUBJECTS - ("^\\([Rr][Ee]: +\\)?[^a-z]+$" -1 nil R) - ;; $$$ Make Money $$$ - ("$$" -10 nil s) - ;; Empty subjects are worthless! - ("^ *\\([(<]none[>)]\\|(no subject\\( given\\)?)\\)? *$" -10 nil r) - ;; Sometimes interesting announces occur! - ("ANN?OU?NC\\(E\\|ING\\)" +10 nil r) - ;; Some people think they're on mailing lists - ("\\(un\\)?sub?scribe" -100 nil r) - ;; Stop Micro$oft NOW!! - ("\\(m\\(icro\\)?[s$]\\(oft\\|lot\\)?-?\\)?wind?\\(ows\\|aube\\|oze\\)?[- ]*\\('?95\\|NT\\|3[.]1\\|32\\)" -1001 nil r) - ;; I've nothing to buy - ("\\(for\\|4\\)[- ]*sale" -100 nil r) - ;; SELF-DISCIPLINED people - ("\\[[^a-z0-9 \t\n][^a-z0-9 \t\n]\\]" +100 nil r) - ) - ("from" - ;; To keep track of posters from my site - (".dgac.fr" +1000 nil s)) - ("followup" - ;; Keep track of answers to my posts - ("boubaker" +1000 nil s)) - ("lines" - ;; Some people have really nothing to say!! - (1 -10 nil <=)) - (mark -100) - (expunge -1000) - ) -@end lisp - -@item -From ``Christopher Jones'' @* -The sample @file{all.SCORE} files from Per and boubaker could be -augmented with: -@lisp - (("subject" - ;; No junk mail please! - ("please ignore" -500 nil s) - ("test" -500 nil e)) - ) -@end lisp - -@item -From ``Brian Edmonds'' @* -Augment any of the above with a fast method of scoring down -excessively cross posted articles. -@lisp - ("xref" - ;; the more cross posting, the exponentially worse the article - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+" -1 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -2 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -4 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -8 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -16 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -32 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -64 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -128 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -256 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -512 nil r)) -@end lisp - -@end enumerate - - -@item -Q2.5 What do I use to yank-through when replying? - -You should probably reply and followup with @kbd{R} and @kbd{F}, instead -of @kbd{r} and @kbd{f}, which solves your problem. But you could try -something like: - -@example -(defconst mail-yank-ignored-headers - "^.*:" - "Delete these headers from old message when it's inserted in a reply.") -@end example - - -@item -Q2.6 I don't like the default WWW browser - -Now when choosing an URL Gnus starts up a W3 buffer, I would like it -to always use Netscape (I don't browse in text-mode ;-). - -@enumerate -@item -Activate `Customize...' from the `Help' menu. - -@item -Scroll down to the `WWW Browser' field. - -@item -Click `mouse-2' on `WWW Browser'. - -@item -Select `Netscape' from the pop up menu. - -@item -Press `C-c C-c' - -@end enumerate - -If you are using XEmacs then to specify Netscape do -@lisp - (setq gnus-button-url 'gnus-netscape-open-url) -@end lisp - - -@item -Q2.7 What, if any, relation is between ``ask-server'' and ``(setq -gnus-read-active-file 'some)''? - -In order for Gnus to show you the complete list of newsgroups, it will -either have to either store the list locally, or ask the server to -transmit the list. You enable the first with - -@lisp - (setq gnus-save-killed-list t) -@end lisp - -and the second with - -@lisp - (setq gnus-read-active-file t) -@end lisp - -If both are disabled, Gnus will not know what newsgroups exists. There -is no option to get the list by casting a spell. - - -@item -Q2.8 Moving between groups is slow. - -Per Abrahamsen writes:@* - -Do you call @code{define-key} or something like that in one of the -summary mode hooks? This would force Emacs to recalculate the keyboard -shortcuts. Removing the call should speed up @kbd{M-x gnus-summary-mode -RET} by a couple of orders of magnitude. You can use - -@lisp -(define-key gnus-summary-mode-map KEY COMMAND) -@end lisp - -in your @file{.gnus} instead. - -@end itemize - - -@node Reading News FAQ -@subsection Reading News - -@itemize @bullet -@item -Q3.1 How do I convert my kill files to score files? - -A kill-to-score translator was written by Ethan Bradford -. It is available from@* -@file{http://baugi.ifi.uio.no/~larsi/ding-various/gnus-kill-to-score.el}. - - -@item -Q3.2 My news server has a lot of groups, and killing groups is painfully -slow. - -Don't do that then. The best way to get rid of groups that should be -dead is to edit your newsrc directly. This problem will be addressed -in the near future. - - -@item -Q3.3 How do I use an NNTP server with authentication? - -Put the following into your .gnus: -@lisp - (add-hook 'nntp-server-opened-hook 'nntp-send-authinfo) -@end lisp - - -@item -Q3.4 Not reading the first article. - -How do I avoid reading the first article when a group is selected? - -@enumerate -@item -Use @kbd{RET} to select the group instead of @kbd{SPC}. - -@item -@code{(setq gnus-auto-select first nil)} - -@item -Luis Fernandes writes:@* -This is what I use...customize as necessary... - -@lisp -;;; Don't auto-select first article if reading sources, or archives or -;;; jobs postings, etc. and just display the summary buffer -(add-hook 'gnus-select-group-hook - (function - (lambda () - (cond ((string-match "sources" gnus-newsgroup-name) - (setq gnus-auto-select-first nil)) - ((string-match "jobs" gnus-newsgroup-name) - (setq gnus-auto-select-first nil)) - ((string-match "comp\\.archives" gnus-newsgroup-name) - (setq gnus-auto-select-first nil)) - ((string-match "reviews" gnus-newsgroup-name) - (setq gnus-auto-select-first nil)) - ((string-match "announce" gnus-newsgroup-name) - (setq gnus-auto-select-first nil)) - ((string-match "binaries" gnus-newsgroup-name) - (setq gnus-auto-select-first nil)) - (t - (setq gnus-auto-select-first t)))))) -@end lisp - -@item -Per Abrahamsen writes:@* -Another possibility is to create an @file{all.binaries.all.SCORE} file -like this: - -@lisp -((local - (gnus-auto-select-first nil))) -@end lisp - -and insert -@lisp - (setq gnus-auto-select-first t) -@end lisp - -in your @file{.gnus}. - -@end enumerate - -@item -Q3.5 Why aren't BBDB known posters marked in the summary buffer? - -Brian Edmonds writes:@* -Due to changes in Gnus 5.0, @file{bbdb-gnus.el} no longer marks known -posters in the summary buffer. An updated version, @file{gnus-bbdb.el} -is available at the locations listed below. This package also supports -autofiling of incoming mail to folders specified in the BBDB. Extensive -instructions are included as comments in the file. - -Send mail to @file{majordomo@@edmonds.home.cs.ubc.ca} with the following -line in the body of the message: @emph{get misc gnus-bbdb.el}. - -Or get it from the World Wide Web:@* -@file{http://www.cs.ubc.ca/spider/edmonds/gnus-bbdb.el}. - -@end itemize - - -@node Reading Mail FAQ -@subsection Reading Mail - -@itemize @bullet -@item -Q4.1 What does the message ``Buffer has changed on disk'' mean in a mail -group? - -Your filter program should not deliver mail directly to your folders, -instead it should put the mail into spool files. Gnus will then move -the mail safely from the spool files into the folders. This will -eliminate the problem. Look it up in the manual, in the section -entitled ``Mail & Procmail''. - - -@item -Q4.2 How do you make articles un-expirable? - -I am using nnml to read news and have used -@code{gnus-auto-expirable-newsgroups} to automagically expire articles -in some groups (Gnus being one of them). Sometimes there are -interesting articles in these groups that I want to keep. Is there any -way of explicitly marking an article as un-expirable - that is mark it -as read but not expirable? - -Use @kbd{u}, @kbd{!}, @kbd{d} or @kbd{M-u} in the summary buffer. You -just remove the @kbd{E} mark by setting some other mark. It's not -necessary to tick the articles. - - -@item -Q4.3 How do I delete bogus nnml: groups? - -My problem is that I have various mail (nnml) groups generated while -experimenting with Gnus. How do I remove them now? Setting the level to -9 does not help. Also @code{gnus-group-check-bogus-groups} does not -recognize them. - -Removing mail groups is tricky at the moment. (It's on the to-do list, -though.) You basically have to kill the groups in Gnus, shut down Gnus, -edit the active file to exclude these groups, and probably remove the -nnml directories that contained these groups as well. Then start Gnus -back up again. - - -@item -Q4.4 What happened to my new mail groups? - -I got new mail, but I have -never seen the groups they should have been placed in. - -They are probably there, but as zombies. Press @kbd{A z} to list -zombie groups, and then subscribe to the groups you want with @kbd{u}. -This is all documented quite nicely in the user's manual. - - -@item -Q4.5 Not scoring mail groups - -How do you @emph{totally} turn off scoring in mail groups? - -Use an nnbabyl:all.SCORE (or nnmh, or nnml, or whatever) file containing: - -@example -((adapt ignore) - (local (gnus-use-scoring nil)) - (exclude-files "all.SCORE")) -@end example - -@end itemize - - diff --git a/texi/gnus.texi b/texi/gnus.texi deleted file mode 100644 index 9248064..0000000 --- a/texi/gnus.texi +++ /dev/null @@ -1,19257 +0,0 @@ -\input texinfo @c -*-texinfo-*- - -@setfilename gnus -@settitle Quassia Gnus 0.27 Manual -@synindex fn cp -@synindex vr cp -@synindex pg cp -@iftex -@finalout -@end iftex -@setchapternewpage odd - -@iftex -@iflatex -\documentclass[twoside,a4paper,openright,11pt]{book} -\usepackage[latin1]{inputenc} -\usepackage{pagestyle} -\usepackage{epsfig} -\usepackage{bembo} -\usepackage{pixidx} - -\makeindex -\begin{document} - -\newcommand{\gnuschaptername}{} -\newcommand{\gnussectionname}{} - -\newcommand{\gnusbackslash}{/} - -\newcommand{\gnusxref}[1]{See ``#1'' on page \pageref{#1}} -\newcommand{\gnuspxref}[1]{see ``#1'' on page \pageref{#1}} - -\newcommand{\gnuskindex}[1]{\index{#1}} -\newcommand{\gnusindex}[1]{\index{#1}} - -\newcommand{\gnustt}[1]{{\fontfamily{pfu}\fontsize{10pt}{10}\selectfont #1}} -\newcommand{\gnuscode}[1]{\gnustt{#1}} -\newcommand{\gnussamp}[1]{``{\fontencoding{OT1}\fontfamily{pfu}\fontsize{10pt}{10}\selectfont #1}''} -\newcommand{\gnuslisp}[1]{\gnustt{#1}} -\newcommand{\gnuskbd}[1]{`\gnustt{#1}'} -\newcommand{\gnusfile}[1]{`\gnustt{#1}'} -\newcommand{\gnusdfn}[1]{\textit{#1}} -\newcommand{\gnusi}[1]{\textit{#1}} -\newcommand{\gnusstrong}[1]{\textbf{#1}} -\newcommand{\gnusemph}[1]{\textit{#1}} -\newcommand{\gnusvar}[1]{{\fontsize{10pt}{10}\selectfont\textsl{\textsf{#1}}}} -\newcommand{\gnussc}[1]{\textsc{#1}} -\newcommand{\gnustitle}[1]{{\huge\textbf{#1}}} -\newcommand{\gnusauthor}[1]{{\large\textbf{#1}}} - -\newcommand{\gnusbullet}{{${\bullet}$}} -\newcommand{\gnusdollar}{\$} -\newcommand{\gnusampersand}{\&} -\newcommand{\gnuspercent}{\%} -\newcommand{\gnushash}{\#} -\newcommand{\gnushat}{\symbol{"5E}} -\newcommand{\gnusunderline}{\symbol{"5F}} -\newcommand{\gnusnot}{$\neg$} -\newcommand{\gnustilde}{\symbol{"7E}} -\newcommand{\gnusless}{{$<$}} -\newcommand{\gnusgreater}{{$>$}} - -\newcommand{\gnushead}{\raisebox{-1cm}{\epsfig{figure=ps/gnus-head.eps,height=1cm}}} -\newcommand{\gnusinteresting}{ -\marginpar[\mbox{}\hfill\gnushead]{\gnushead} -} - -\newcommand{\gnuscleardoublepage}{\ifodd\count0\mbox{}\clearpage\thispagestyle{empty}\mbox{}\clearpage\else\clearpage\fi} - -\newcommand{\gnuspagechapter}[1]{ -{\mbox{}} -} - -\newdimen{\gnusdimen} -\gnusdimen 0pt - -\newcommand{\gnuschapter}[2]{ -\gnuscleardoublepage -\ifdim \gnusdimen = 0pt\setcounter{page}{1}\pagestyle{gnus}\pagenumbering{arabic} \gnusdimen 1pt\fi -\chapter{#2} -\renewcommand{\gnussectionname}{} -\renewcommand{\gnuschaptername}{#2} -\thispagestyle{empty} -\hspace*{-2cm} -\begin{picture}(500,500)(0,0) -\put(480,350){\makebox(0,0)[tr]{#1}} -\put(40,300){\makebox(500,50)[bl]{{\Huge\bf{#2}}}} -\end{picture} -\clearpage -} - -\newcommand{\gnusfigure}[3]{ -\begin{figure} -\mbox{}\ifodd\count0\hspace*{-0.8cm}\else\hspace*{-3cm}\fi\begin{picture}(440,#2) -#3 -\end{picture} -\caption{#1} -\end{figure} -} - -\newcommand{\gnusicon}[1]{ -\marginpar[\mbox{}\hfill\raisebox{-1.5cm}{\epsfig{figure=tmp/#1-up.ps,height=1.5cm}}]{\raisebox{-1cm}{\epsfig{figure=tmp/#1-up.ps,height=1cm}}} -} - -\newcommand{\gnuspicon}[1]{ -\margindex{\epsfig{figure=#1,width=2cm}} -} - -\newcommand{\gnusxface}[2]{ -\margindex{\epsfig{figure=#1,width=1cm}\epsfig{figure=#2,width=1cm}} -} - -\newcommand{\gnussmiley}[2]{ -\margindex{\makebox[2cm]{\hfill\epsfig{figure=#1,width=0.5cm}\hfill\epsfig{figure=#2,width=0.5cm}\hfill}} -} - -\newcommand{\gnusitemx}[1]{\mbox{}\vspace*{-\itemsep}\vspace*{-\parsep}\item#1} - -\newcommand{\gnussection}[1]{ -\renewcommand{\gnussectionname}{#1} -\section{#1} -} - -\newenvironment{codelist}% -{\begin{list}{}{ -} -}{\end{list}} - -\newenvironment{kbdlist}% -{\begin{list}{}{ -\labelwidth=0cm -} -}{\end{list}} - -\newenvironment{dfnlist}% -{\begin{list}{}{ -} -}{\end{list}} - -\newenvironment{stronglist}% -{\begin{list}{}{ -} -}{\end{list}} - -\newenvironment{samplist}% -{\begin{list}{}{ -} -}{\end{list}} - -\newenvironment{varlist}% -{\begin{list}{}{ -} -}{\end{list}} - -\newenvironment{emphlist}% -{\begin{list}{}{ -} -}{\end{list}} - -\newlength\gnusheadtextwidth -\setlength{\gnusheadtextwidth}{\headtextwidth} -\addtolength{\gnusheadtextwidth}{1cm} - -\newpagestyle{gnuspreamble}% -{ -{ -\ifodd\count0 -{ -\hspace*{-0.23cm}\underline{\makebox[\gnusheadtextwidth]{\mbox{}}\textbf{\hfill\roman{page}}} -} -\else -{ -\hspace*{-3.25cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\roman{page}\hfill\mbox{}}} -} -} -\fi -} -} -{ -\ifodd\count0 -\mbox{} \hfill -\raisebox{-0.5cm}{\epsfig{figure=ps/gnus-big-logo.eps,height=1cm}} -\else -\raisebox{-0.5cm}{\epsfig{figure=ps/gnus-big-logo.eps,height=1cm}} -\hfill \mbox{} -\fi -} - -\newpagestyle{gnusindex}% -{ -{ -\ifodd\count0 -{ -\hspace*{-0.23cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\gnuschaptername\hfill\arabic{page}}}} -} -\else -{ -\hspace*{-3.25cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\arabic{page}\hfill\gnuschaptername}}} -} -\fi -} -} -{ -\ifodd\count0 -\mbox{} \hfill -\raisebox{-0.5cm}{\epsfig{figure=ps/gnus-big-logo.eps,height=1cm}} -\else -\raisebox{-0.5cm}{\epsfig{figure=ps/gnus-big-logo.eps,height=1cm}} -\hfill \mbox{} -\fi -} - -\newpagestyle{gnus}% -{ -{ -\ifodd\count0 -{ -\makebox[12cm]{\hspace*{3.1cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\arabic{chapter}.\arabic{section}} \textbf{\gnussectionname\hfill\arabic{page}}}}} -} -\else -{ -\makebox[12cm]{\hspace*{-2.95cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\arabic{page}\hfill\gnuschaptername}}}} -} -\fi -} -} -{ -\ifodd\count0 -\mbox{} \hfill -\raisebox{-0.5cm}{\epsfig{figure=ps/gnus-big-logo.eps,height=1cm}} -\else -\raisebox{-0.5cm}{\epsfig{figure=ps/gnus-big-logo.eps,height=1cm}} -\hfill \mbox{} -\fi -} - -\pagenumbering{roman} -\pagestyle{gnuspreamble} - -@end iflatex -@end iftex - -@iftex -@iflatex -\begin{titlepage} -{ - -%\addtolength{\oddsidemargin}{-5cm} -%\addtolength{\evensidemargin}{-5cm} -\parindent=0cm -\addtolength{\textheight}{2cm} - -\gnustitle{\gnustitlename}\\ -\rule{15cm}{1mm}\\ -\vfill -\hspace*{0cm}\epsfig{figure=ps/gnus-big-logo.eps,height=15cm} -\vfill -\rule{15cm}{1mm}\\ -\gnusauthor{by Lars Magne Ingebrigtsen} -\newpage -} - -\mbox{} -\vfill - -\thispagestyle{empty} - -Copyright \copyright{} 1995,96,97 Free Software Foundation, Inc. - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions. - -\newpage -\end{titlepage} -@end iflatex -@end iftex - -@ifinfo - -This file documents Gnus, the GNU Emacs newsreader. - -Copyright (C) 1995,96 Free Software Foundation, Inc. - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -@ignore -Permission is granted to process this file through Tex and print the -results, provided the printed document carries copying permission -notice identical to this one except for the removal of this paragraph -(this paragraph not being relevant to the printed manual). - -@end ignore -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided also that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions. -@end ifinfo - -@tex - -@titlepage -@title Quassia Gnus 0.27 Manual - -@author by Lars Magne Ingebrigtsen -@page - -@vskip 0pt plus 1filll -Copyright @copyright{} 1995,96,97 Free Software Foundation, Inc. - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions. - -@end titlepage -@page - -@end tex - - -@node Top -@top The Gnus Newsreader - -@ifinfo - -You can read news (and mail) from within Emacs by using Gnus. The news -can be gotten by any nefarious means you can think of---@sc{nntp}, local -spool or your mbox file. All at the same time, if you want to push your -luck. - -This manual corresponds to Quassia Gnus 0.27. - -@end ifinfo - -@iftex - -@iflatex -\tableofcontents -\gnuscleardoublepage -@end iflatex - -Gnus is the advanced, self-documenting, customizable, extensible -unreal-time newsreader for GNU Emacs. - -Oops. That sounds oddly familiar, so let's start over again to avoid -being accused of plagiarism: - -Gnus is a message-reading laboratory. It will let you look at just -about anything as if it were a newsgroup. You can read mail with it, -you can browse directories with it, you can @code{ftp} with it---you can -even read news with it! - -Gnus tries to empower people who read news the same way Emacs empowers -people who edit text. Gnus sets no limits to what the user should be -allowed to do. Users are encouraged to extend Gnus to make it behave -like they want it to behave. A program should not control people; -people should be empowered to do what they want by using (or abusing) -the program. - -@end iftex - - -@menu -* Starting Up:: Finding news can be a pain. -* The Group Buffer:: Selecting, subscribing and killing groups. -* The Summary Buffer:: Reading, saving and posting articles. -* The Article Buffer:: Displaying and handling articles. -* Composing Messages:: Information on sending mail and news. -* Select Methods:: Gnus reads all messages from various select methods. -* Scoring:: Assigning values to articles. -* Various:: General purpose settings. -* The End:: Farewell and goodbye. -* Appendices:: Terminology, Emacs intro, FAQ, History, Internals. -* Index:: Variable, function and concept index. -* Key Index:: Key Index. -@end menu - -@node Starting Up -@chapter Starting Gnus -@cindex starting up - -@kindex M-x gnus -@findex gnus -If your system administrator has set things up properly, starting Gnus -and reading news is extremely easy---you just type @kbd{M-x gnus} in -your Emacs. - -@findex gnus-other-frame -@kindex M-x gnus-other-frame -If you want to start Gnus in a different frame, you can use the command -@kbd{M-x gnus-other-frame} instead. - -If things do not go smoothly at startup, you have to twiddle some -variables in your @file{~/.gnus} file. This file is similar to -@file{~/.emacs}, but is read when gnus starts. - -If you puzzle at any terms used in this manual, please refer to the -terminology section (@pxref{Terminology}). - -@menu -* Finding the News:: Choosing a method for getting news. -* The First Time:: What does Gnus do the first time you start it? -* The Server is Down:: How can I read my mail then? -* Slave Gnusae:: You can have more than one Gnus active at a time. -* Fetching a Group:: Starting Gnus just to read a group. -* New Groups:: What is Gnus supposed to do with new groups? -* Startup Files:: Those pesky startup files---@file{.newsrc}. -* Auto Save:: Recovering from a crash. -* The Active File:: Reading the active file over a slow line Takes Time. -* Changing Servers:: You may want to move from one server to another. -* Startup Variables:: Other variables you might change. -@end menu - - -@node Finding the News -@section Finding the News -@cindex finding news - -@vindex gnus-select-method -@c @head -The @code{gnus-select-method} variable says where Gnus should look for -news. This variable should be a list where the first element says -@dfn{how} and the second element says @dfn{where}. This method is your -native method. All groups not fetched with this method are -foreign groups. - -For instance, if the @samp{news.somewhere.edu} @sc{nntp} server is where -you want to get your daily dosage of news from, you'd say: - -@lisp -(setq gnus-select-method '(nntp "news.somewhere.edu")) -@end lisp - -If you want to read directly from the local spool, say: - -@lisp -(setq gnus-select-method '(nnspool "")) -@end lisp - -If you can use a local spool, you probably should, as it will almost -certainly be much faster. - -@vindex gnus-nntpserver-file -@cindex NNTPSERVER -@cindex @sc{nntp} server -If this variable is not set, Gnus will take a look at the -@code{NNTPSERVER} environment variable. If that variable isn't set, -Gnus will see whether @code{gnus-nntpserver-file} -(@file{/etc/nntpserver} by default) has any opinions on the matter. If -that fails as well, Gnus will try to use the machine running Emacs as an @sc{nntp} server. That's a long shot, though. - -@vindex gnus-nntp-server -If @code{gnus-nntp-server} is set, this variable will override -@code{gnus-select-method}. You should therefore set -@code{gnus-nntp-server} to @code{nil}, which is what it is by default. - -@vindex gnus-secondary-servers -You can also make Gnus prompt you interactively for the name of an -@sc{nntp} server. If you give a non-numerical prefix to @code{gnus} -(i.e., @kbd{C-u M-x gnus}), Gnus will let you choose between the servers -in the @code{gnus-secondary-servers} list (if any). You can also just -type in the name of any server you feel like visiting. - -@findex gnus-group-browse-foreign-server -@kindex B (Group) -However, if you use one @sc{nntp} server regularly and are just -interested in a couple of groups from a different server, you would be -better served by using the @kbd{B} command in the group buffer. It will -let you have a look at what groups are available, and you can subscribe -to any of the groups you want to. This also makes @file{.newsrc} -maintenance much tidier. @xref{Foreign Groups}. - -@vindex gnus-secondary-select-methods -@c @head -A slightly different approach to foreign groups is to set the -@code{gnus-secondary-select-methods} variable. The select methods -listed in this variable are in many ways just as native as the -@code{gnus-select-method} server. They will also be queried for active -files during startup (if that's required), and new newsgroups that -appear on these servers will be subscribed (or not) just as native -groups are. - -For instance, if you use the @code{nnmbox} backend to read your mail, you -would typically set this variable to - -@lisp -(setq gnus-secondary-select-methods '((nnmbox ""))) -@end lisp - - -@node The First Time -@section The First Time -@cindex first time usage - -If no startup files exist, Gnus will try to determine what groups should -be subscribed by default. - -@vindex gnus-default-subscribed-newsgroups -If the variable @code{gnus-default-subscribed-newsgroups} is set, Gnus -will subscribe you to just those groups in that list, leaving the rest -killed. Your system administrator should have set this variable to -something useful. - -Since she hasn't, Gnus will just subscribe you to a few arbitrarily -picked groups (i.e., @samp{*.newusers}). (@dfn{Arbitrary} is defined -here as @dfn{whatever Lars thinks you should read}.) - -You'll also be subscribed to the Gnus documentation group, which should -help you with most common problems. - -If @code{gnus-default-subscribed-newsgroups} is @code{t}, Gnus will just -use the normal functions for handling new groups, and not do anything -special. - - -@node The Server is Down -@section The Server is Down -@cindex server errors - -If the default server is down, Gnus will understandably have some -problems starting. However, if you have some mail groups in addition to -the news groups, you may want to start Gnus anyway. - -Gnus, being the trusting sort of program, will ask whether to proceed -without a native select method if that server can't be contacted. This -will happen whether the server doesn't actually exist (i.e., you have -given the wrong address) or the server has just momentarily taken ill -for some reason or other. If you decide to continue and have no foreign -groups, you'll find it difficult to actually do anything in the group -buffer. But, hey, that's your problem. Blllrph! - -@findex gnus-no-server -@kindex M-x gnus-no-server -@c @head -If you know that the server is definitely down, or you just want to read -your mail without bothering with the server at all, you can use the -@code{gnus-no-server} command to start Gnus. That might come in handy -if you're in a hurry as well. This command will not attempt to contact -your primary server---instead, it will just activate all groups on level -1 and 2. (You should preferably keep no native groups on those two -levels.) - - -@node Slave Gnusae -@section Slave Gnusae -@cindex slave - -You might want to run more than one Emacs with more than one Gnus at the -same time. If you are using different @file{.newsrc} files (e.g., if you -are using the two different Gnusae to read from two different servers), -that is no problem whatsoever. You just do it. - -The problem appears when you want to run two Gnusae that use the same -@code{.newsrc} file. - -To work around that problem some, we here at the Think-Tank at the Gnus -Towers have come up with a new concept: @dfn{Masters} and -@dfn{slaves}. (We have applied for a patent on this concept, and have -taken out a copyright on those words. If you wish to use those words in -conjunction with each other, you have to send $1 per usage instance to -me. Usage of the patent (@dfn{Master/Slave Relationships In Computer -Applications}) will be much more expensive, of course.) - -Anyways, you start one Gnus up the normal way with @kbd{M-x gnus} (or -however you do it). Each subsequent slave Gnusae should be started with -@kbd{M-x gnus-slave}. These slaves won't save normal @file{.newsrc} -files, but instead save @dfn{slave files} that contain information only -on what groups have been read in the slave session. When a master Gnus -starts, it will read (and delete) these slave files, incorporating all -information from them. (The slave files will be read in the sequence -they were created, so the latest changes will have precedence.) - -Information from the slave files has, of course, precedence over the -information in the normal (i.e., master) @code{.newsrc} file. - - -@node Fetching a Group -@section Fetching a Group -@cindex fetching a group - -@findex gnus-fetch-group -It is sometimes convenient to be able to just say ``I want to read this -group and I don't care whether Gnus has been started or not''. This is -perhaps more useful for people who write code than for users, but the -command @code{gnus-fetch-group} provides this functionality in any case. -It takes the group name as a parameter. - - -@node New Groups -@section New Groups -@cindex new groups -@cindex subscription - -@vindex gnus-check-new-newsgroups -If you are satisfied that you really never want to see any new groups, -you can set @code{gnus-check-new-newsgroups} to @code{nil}. This will -also save you some time at startup. Even if this variable is -@code{nil}, you can always subscribe to the new groups just by pressing -@kbd{U} in the group buffer (@pxref{Group Maintenance}). This variable -is @code{ask-server} by default. If you set this variable to -@code{always}, then Gnus will query the backends for new groups even -when you do the @kbd{g} command (@pxref{Scanning New Messages}). - -@menu -* Checking New Groups:: Determining what groups are new. -* Subscription Methods:: What Gnus should do with new groups. -* Filtering New Groups:: Making Gnus ignore certain new groups. -@end menu - - -@node Checking New Groups -@subsection Checking New Groups - -Gnus normally determines whether a group is new or not by comparing the -list of groups from the active file(s) with the lists of subscribed and -dead groups. This isn't a particularly fast method. If -@code{gnus-check-new-newsgroups} is @code{ask-server}, Gnus will ask the -server for new groups since the last time. This is both faster and -cheaper. This also means that you can get rid of the list of killed -groups altogether, so you may set @code{gnus-save-killed-list} to -@code{nil}, which will save time both at startup, at exit, and all over. -Saves disk space, too. Why isn't this the default, then? -Unfortunately, not all servers support this command. - -I bet I know what you're thinking now: How do I find out whether my -server supports @code{ask-server}? No? Good, because I don't have a -fail-safe answer. I would suggest just setting this variable to -@code{ask-server} and see whether any new groups appear within the next -few days. If any do, then it works. If none do, then it doesn't -work. I could write a function to make Gnus guess whether the server -supports @code{ask-server}, but it would just be a guess. So I won't. -You could @code{telnet} to the server and say @code{HELP} and see -whether it lists @samp{NEWGROUPS} among the commands it understands. If -it does, then it might work. (But there are servers that lists -@samp{NEWGROUPS} without supporting the function properly.) - -This variable can also be a list of select methods. If so, Gnus will -issue an @code{ask-server} command to each of the select methods, and -subscribe them (or not) using the normal methods. This might be handy -if you are monitoring a few servers for new groups. A side effect is -that startup will take much longer, so you can meditate while waiting. -Use the mantra ``dingnusdingnusdingnus'' to achieve permanent bliss. - - -@node Subscription Methods -@subsection Subscription Methods - -@vindex gnus-subscribe-newsgroup-method -What Gnus does when it encounters a new group is determined by the -@code{gnus-subscribe-newsgroup-method} variable. - -This variable should contain a function. This function will be called -with the name of the new group as the only parameter. - -Some handy pre-fab functions are: - -@table @code - -@item gnus-subscribe-zombies -@vindex gnus-subscribe-zombies -Make all new groups zombies. This is the default. You can browse the -zombies later (with @kbd{A z}) and either kill them all off properly -(with @kbd{S z}), or subscribe to them (with @kbd{u}). - -@item gnus-subscribe-randomly -@vindex gnus-subscribe-randomly -Subscribe all new groups in arbitrary order. This really means that all -new groups will be added at ``the top'' of the group buffer. - -@item gnus-subscribe-alphabetically -@vindex gnus-subscribe-alphabetically -Subscribe all new groups in alphabetical order. - -@item gnus-subscribe-hierarchically -@vindex gnus-subscribe-hierarchically -Subscribe all new groups hierarchically. The difference between this -function and @code{gnus-subscribe-alphabetically} is slight. -@code{gnus-subscribe-alphabetically} will subscribe new groups in a strictly -alphabetical fashion, while this function will enter groups into it's -hierarchy. So if you want to have the @samp{rec} hierarchy before the -@samp{comp} hierarchy, this function will not mess that configuration -up. Or something like that. - -@item gnus-subscribe-interactively -@vindex gnus-subscribe-interactively -Subscribe new groups interactively. This means that Gnus will ask -you about @strong{all} new groups. The groups you choose to subscribe -to will be subscribed hierarchically. - -@item gnus-subscribe-killed -@vindex gnus-subscribe-killed -Kill all new groups. - -@end table - -@vindex gnus-subscribe-hierarchical-interactive -A closely related variable is -@code{gnus-subscribe-hierarchical-interactive}. (That's quite a -mouthful.) If this variable is non-@code{nil}, Gnus will ask you in a -hierarchical fashion whether to subscribe to new groups or not. Gnus -will ask you for each sub-hierarchy whether you want to descend the -hierarchy or not. - -One common mistake is to set the variable a few paragraphs above -(@code{gnus-subscribe-newsgroup-method}) to -@code{gnus-subscribe-hierarchical-interactive}. This is an error. This -will not work. This is ga-ga. So don't do it. - - -@node Filtering New Groups -@subsection Filtering New Groups - -A nice and portable way to control which new newsgroups should be -subscribed (or ignored) is to put an @dfn{options} line at the start of -the @file{.newsrc} file. Here's an example: - -@example -options -n !alt.all !rec.all sci.all -@end example - -@vindex gnus-subscribe-options-newsgroup-method -This line obviously belongs to a serious-minded intellectual scientific -person (or she may just be plain old boring), because it says that all -groups that have names beginning with @samp{alt} and @samp{rec} should -be ignored, and all groups with names beginning with @samp{sci} should -be subscribed. Gnus will not use the normal subscription method for -subscribing these groups. -@code{gnus-subscribe-options-newsgroup-method} is used instead. This -variable defaults to @code{gnus-subscribe-alphabetically}. - -@vindex gnus-options-not-subscribe -@vindex gnus-options-subscribe -If you don't want to mess with your @file{.newsrc} file, you can just -set the two variables @code{gnus-options-subscribe} and -@code{gnus-options-not-subscribe}. These two variables do exactly the -same as the @file{.newsrc} @samp{options -n} trick. Both are regexps, -and if the new group matches the former, it will be unconditionally -subscribed, and if it matches the latter, it will be ignored. - -@vindex gnus-auto-subscribed-groups -Yet another variable that meddles here is -@code{gnus-auto-subscribed-groups}. It works exactly like -@code{gnus-options-subscribe}, and is therefore really superfluous, but I -thought it would be nice to have two of these. This variable is more -meant for setting some ground rules, while the other variable is used -more for user fiddling. By default this variable makes all new groups -that come from mail backends (@code{nnml}, @code{nnbabyl}, -@code{nnfolder}, @code{nnmbox}, and @code{nnmh}) subscribed. If you -don't like that, just set this variable to @code{nil}. - -New groups that match this regexp are subscribed using -@code{gnus-subscribe-options-newsgroup-method}. - - -@node Changing Servers -@section Changing Servers -@cindex changing servers - -Sometimes it is necessary to move from one @sc{nntp} server to another. -This happens very rarely, but perhaps you change jobs, or one server is -very flaky and you want to use another. - -Changing the server is pretty easy, right? You just change -@code{gnus-select-method} to point to the new server? - -@emph{Wrong!} - -Article numbers are not (in any way) kept synchronized between different -@sc{nntp} servers, and the only way Gnus keeps track of what articles -you have read is by keeping track of article numbers. So when you -change @code{gnus-select-method}, your @file{.newsrc} file becomes -worthless. - -Gnus provides a few functions to attempt to translate a @file{.newsrc} -file from one server to another. They all have one thing in -common---they take a looong time to run. You don't want to use these -functions more than absolutely necessary. - -@kindex M-x gnus-change-server -@findex gnus-change-server -If you have access to both servers, Gnus can request the headers for all -the articles you have read and compare @code{Message-ID}s and map the -article numbers of the read articles and article marks. The @kbd{M-x -gnus-change-server} command will do this for all your native groups. It -will prompt for the method you want to move to. - -@kindex M-x gnus-group-move-group-to-server -@findex gnus-group-move-group-to-server -You can also move individual groups with the @kbd{M-x -gnus-group-move-group-to-server} command. This is useful if you want to -move a (foreign) group from one server to another. - -@kindex M-x gnus-group-clear-data-on-native-groups -@findex gnus-group-clear-data-on-native-groups -If you don't have access to both the old and new server, all your marks -and read ranges have become worthless. You can use the @kbd{M-x -gnus-group-clear-data-on-native-groups} command to clear out all data -that you have on your native groups. Use with caution. - - -@node Startup Files -@section Startup Files -@cindex startup files -@cindex .newsrc -@cindex .newsrc.el -@cindex .newsrc.eld - -Now, you all know about the @file{.newsrc} file. All subscription -information is traditionally stored in this file. - -Things got a bit more complicated with @sc{gnus}. In addition to -keeping the @file{.newsrc} file updated, it also used a file called -@file{.newsrc.el} for storing all the information that didn't fit into -the @file{.newsrc} file. (Actually, it also duplicated everything in -the @file{.newsrc} file.) @sc{gnus} would read whichever one of these -files was the most recently saved, which enabled people to swap between -@sc{gnus} and other newsreaders. - -That was kinda silly, so Gnus went one better: In addition to the -@file{.newsrc} and @file{.newsrc.el} files, Gnus also has a file called -@file{.newsrc.eld}. It will read whichever of these files that are most -recent, but it will never write a @file{.newsrc.el} file. You should -never delete the @file{.newsrc.eld} file---it contains much information -not stored in the @file{.newsrc} file. - -@vindex gnus-save-newsrc-file -You can turn off writing the @file{.newsrc} file by setting -@code{gnus-save-newsrc-file} to @code{nil}, which means you can delete -the file and save some space, as well as making exit from Gnus faster. -However, this will make it impossible to use other newsreaders than -Gnus. But hey, who would want to, right? - -@vindex gnus-save-killed-list -If @code{gnus-save-killed-list} (default @code{t}) is @code{nil}, Gnus -will not save the list of killed groups to the startup file. This will -save both time (when starting and quitting) and space (on disk). It -will also mean that Gnus has no record of what groups are new or old, -so the automatic new groups subscription methods become meaningless. -You should always set @code{gnus-check-new-newsgroups} to @code{nil} or -@code{ask-server} if you set this variable to @code{nil} (@pxref{New -Groups}). This variable can also be a regular expression. If that's -the case, remove all groups that do not match this regexp before -saving. This can be useful in certain obscure situations that involve -several servers where not all servers support @code{ask-server}. - -@vindex gnus-startup-file -The @code{gnus-startup-file} variable says where the startup files are. -The default value is @file{~/.newsrc}, with the Gnus (El Dingo) startup -file being whatever that one is, with a @samp{.eld} appended. - -@vindex gnus-save-newsrc-hook -@vindex gnus-save-quick-newsrc-hook -@vindex gnus-save-standard-newsrc-hook -@code{gnus-save-newsrc-hook} is called before saving any of the newsrc -files, while @code{gnus-save-quick-newsrc-hook} is called just before -saving the @file{.newsrc.eld} file, and -@code{gnus-save-standard-newsrc-hook} is called just before saving the -@file{.newsrc} file. The latter two are commonly used to turn version -control on or off. Version control is on by default when saving the -startup files. If you want to turn backup creation off, say something like: - -@lisp -(defun turn-off-backup () - (set (make-local-variable 'backup-inhibited) t)) - -(add-hook 'gnus-save-quick-newsrc-hook 'turn-off-backup) -(add-hook 'gnus-save-standard-newsrc-hook 'turn-off-backup) -@end lisp - -@vindex gnus-init-file -When Gnus starts, it will read the @code{gnus-site-init-file} -(@file{.../site-lisp/gnus} by default) and @code{gnus-init-file} -(@file{~/.gnus} by default) files. These are normal Emacs Lisp files -and can be used to avoid cluttering your @file{~/.emacs} and -@file{site-init} files with Gnus stuff. Gnus will also check for files -with the same names as these, but with @file{.elc} and @file{.el} -suffixes. In other words, if you have set @code{gnus-init-file} to -@file{~/.gnus}, it will look for @file{~/.gnus.elc}, @file{~/.gnus.el}, -and finally @file{~/.gnus} (in this order). - - - -@node Auto Save -@section Auto Save -@cindex dribble file -@cindex auto-save - -Whenever you do something that changes the Gnus data (reading articles, -catching up, killing/subscribing groups), the change is added to a -special @dfn{dribble buffer}. This buffer is auto-saved the normal -Emacs way. If your Emacs should crash before you have saved the -@file{.newsrc} files, all changes you have made can be recovered from -this file. - -If Gnus detects this file at startup, it will ask the user whether to -read it. The auto save file is deleted whenever the real startup file is -saved. - -@vindex gnus-use-dribble-file -If @code{gnus-use-dribble-file} is @code{nil}, Gnus won't create and -maintain a dribble buffer. The default is @code{t}. - -@vindex gnus-dribble-directory -Gnus will put the dribble file(s) in @code{gnus-dribble-directory}. If -this variable is @code{nil}, which it is by default, Gnus will dribble -into the directory where the @file{.newsrc} file is located. (This is -normally the user's home directory.) The dribble file will get the same -file permissions as the @code{.newsrc} file. - - -@node The Active File -@section The Active File -@cindex active file -@cindex ignored groups - -When Gnus starts, or indeed whenever it tries to determine whether new -articles have arrived, it reads the active file. This is a very large -file that lists all the active groups and articles on the server. - -@vindex gnus-ignored-newsgroups -Before examining the active file, Gnus deletes all lines that match the -regexp @code{gnus-ignored-newsgroups}. This is done primarily to reject -any groups with bogus names, but you can use this variable to make Gnus -ignore hierarchies you aren't ever interested in. However, this is not -recommended. In fact, it's highly discouraged. Instead, @pxref{New -Groups} for an overview of other variables that can be used instead. - -@c This variable is -@c @code{nil} by default, and will slow down active file handling somewhat -@c if you set it to anything else. - -@vindex gnus-read-active-file -@c @head -The active file can be rather Huge, so if you have a slow network, you -can set @code{gnus-read-active-file} to @code{nil} to prevent Gnus from -reading the active file. This variable is @code{some} by default. - -Gnus will try to make do by getting information just on the groups that -you actually subscribe to. - -Note that if you subscribe to lots and lots of groups, setting this -variable to @code{nil} will probably make Gnus slower, not faster. At -present, having this variable @code{nil} will slow Gnus down -considerably, unless you read news over a 2400 baud modem. - -This variable can also have the value @code{some}. Gnus will then -attempt to read active info only on the subscribed groups. On some -servers this is quite fast (on sparkling, brand new INN servers that -support the @code{LIST ACTIVE group} command), on others this isn't fast -at all. In any case, @code{some} should be faster than @code{nil}, and -is certainly faster than @code{t} over slow lines. - -If this variable is @code{nil}, Gnus will ask for group info in total -lock-step, which isn't very fast. If it is @code{some} and you use an -@sc{nntp} server, Gnus will pump out commands as fast as it can, and -read all the replies in one swoop. This will normally result in better -performance, but if the server does not support the aforementioned -@code{LIST ACTIVE group} command, this isn't very nice to the server. - -In any case, if you use @code{some} or @code{nil}, you should definitely -kill all groups that you aren't interested in to speed things up. - -Note that this variable also affects active file retrieval from -secondary select methods. - - -@node Startup Variables -@section Startup Variables - -@table @code - -@item gnus-load-hook -@vindex gnus-load-hook -A hook run while Gnus is being loaded. Note that this hook will -normally be run just once in each Emacs session, no matter how many -times you start Gnus. - -@item gnus-before-startup-hook -@vindex gnus-before-startup-hook -A hook run after starting up Gnus successfully. - -@item gnus-startup-hook -@vindex gnus-startup-hook -A hook run as the very last thing after starting up Gnus - -@item gnus-started-hook -@vindex gnus-started-hook -A hook that is run as the very last thing after starting up Gnus -successfully. - -@item gnus-started-hook -@vindex gnus-started-hook -A hook that is run after reading the @file{.newsrc} file(s), but before -generating the group buffer. - -@item gnus-check-bogus-newsgroups -@vindex gnus-check-bogus-newsgroups -If non-@code{nil}, Gnus will check for and delete all bogus groups at -startup. A @dfn{bogus group} is a group that you have in your -@file{.newsrc} file, but doesn't exist on the news server. Checking for -bogus groups can take quite a while, so to save time and resources it's -best to leave this option off, and do the checking for bogus groups once -in a while from the group buffer instead (@pxref{Group Maintenance}). - -@item gnus-inhibit-startup-message -@vindex gnus-inhibit-startup-message -If non-@code{nil}, the startup message won't be displayed. That way, -your boss might not notice as easily that you are reading news instead -of doing your job. Note that this variable is used before -@file{.gnus.el} is loaded, so it should be set in @code{.emacs} instead. - -@item gnus-no-groups-message -@vindex gnus-no-groups-message -Message displayed by Gnus when no groups are available. - -@item gnus-play-startup-jingle -@vindex gnus-play-startup-jingle -If non-@code{nil}, play the Gnus jingle at startup. - -@item gnus-startup-jingle -@vindex gnus-startup-jingle -Jingle to be played if the above variable is non-@code{nil}. The -default is @samp{Tuxedomoon.Jingle4.au}. - -@end table - - -@node The Group Buffer -@chapter The Group Buffer -@cindex group buffer - -The @dfn{group buffer} lists all (or parts) of the available groups. It -is the first buffer shown when Gnus starts, and will never be killed as -long as Gnus is active. - -@iftex -@iflatex -\gnusfigure{The Group Buffer}{320}{ -\put(75,50){\epsfig{figure=tmp/group.ps,height=9cm}} -\put(120,37){\makebox(0,0)[t]{Buffer name}} -\put(120,38){\vector(1,2){10}} -\put(40,60){\makebox(0,0)[r]{Mode line}} -\put(40,58){\vector(1,0){30}} -\put(200,28){\makebox(0,0)[t]{Native select method}} -\put(200,26){\vector(-1,2){15}} -} -@end iflatex -@end iftex - -@menu -* Group Buffer Format:: Information listed and how you can change it. -* Group Maneuvering:: Commands for moving in the group buffer. -* Selecting a Group:: Actually reading news. -* Group Data:: Changing the info for a group. -* Subscription Commands:: Unsubscribing, killing, subscribing. -* Group Levels:: Levels? What are those, then? -* Group Score:: A mechanism for finding out what groups you like. -* Marking Groups:: You can mark groups for later processing. -* Foreign Groups:: Creating and editing groups. -* Group Parameters:: Each group may have different parameters set. -* Listing Groups:: Gnus can list various subsets of the groups. -* Sorting Groups:: Re-arrange the group order. -* Group Maintenance:: Maintaining a tidy @file{.newsrc} file. -* Browse Foreign Server:: You can browse a server. See what it has to offer. -* Exiting Gnus:: Stop reading news and get some work done. -* Group Topics:: A folding group mode divided into topics. -* Misc Group Stuff:: Other stuff that you can to do. -@end menu - - -@node Group Buffer Format -@section Group Buffer Format - -@menu -* Group Line Specification:: Deciding how the group buffer is to look. -* Group Modeline Specification:: The group buffer modeline. -* Group Highlighting:: Having nice colors in the group buffer. -@end menu - - -@node Group Line Specification -@subsection Group Line Specification -@cindex group buffer format - -The default format of the group buffer is nice and dull, but you can -make it as exciting and ugly as you feel like. - -Here's a couple of example group lines: - -@example - 25: news.announce.newusers - * 0: alt.fan.andrea-dworkin -@end example - -Quite simple, huh? - -You can see that there are 25 unread articles in -@samp{news.announce.newusers}. There are no unread articles, but some -ticked articles, in @samp{alt.fan.andrea-dworkin} (see that little -asterisk at the beginning of the line?). - -@vindex gnus-group-line-format -You can change that format to whatever you want by fiddling with the -@code{gnus-group-line-format} variable. This variable works along the -lines of a @code{format} specification, which is pretty much the same as -a @code{printf} specifications, for those of you who use (feh!) C. -@xref{Formatting Variables}. - -@samp{%M%S%5y: %(%g%)\n} is the value that produced those lines above. - -There should always be a colon on the line; the cursor always moves to -the colon after performing an operation. Nothing else is required---not -even the group name. All displayed text is just window dressing, and is -never examined by Gnus. Gnus stores all real information it needs using -text properties. - -(Note that if you make a really strange, wonderful, spreadsheet-like -layout, everybody will believe you are hard at work with the accounting -instead of wasting time reading news.) - -Here's a list of all available format characters: - -@table @samp - -@item M -An asterisk if the group only has marked articles. - -@item S -Whether the group is subscribed. - -@item L -Level of subscribedness. - -@item N -Number of unread articles. - -@item I -Number of dormant articles. - -@item T -Number of ticked articles. - -@item R -Number of read articles. - -@item t -Estimated total number of articles. (This is really @var{max-number} -minus @var{min-number} plus 1.) - -@item y -Number of unread, unticked, non-dormant articles. - -@item i -Number of ticked and dormant articles. - -@item g -Full group name. - -@item G -Group name. - -@item D -Newsgroup description. - -@item o -@samp{m} if moderated. - -@item O -@samp{(m)} if moderated. - -@item s -Select method. - -@item n -Select from where. - -@item z -A string that looks like @samp{<%s:%n>} if a foreign select method is -used. - -@item P -Indentation based on the level of the topic (@pxref{Group Topics}). - -@item c -@vindex gnus-group-uncollapsed-levels -Short (collapsed) group name. The @code{gnus-group-uncollapsed-levels} -variable says how many levels to leave at the end of the group name. -The default is 1---this will mean that group names like -@samp{gnu.emacs.gnus} will be shortened to @samp{g.emacs.gnus}. - -@item m -@vindex gnus-new-mail-mark -@cindex % -@samp{%} (@code{gnus-new-mail-mark}) if there has arrived new mail to -the group lately. - -@item d -A string that says when you last read the group (@pxref{Group -Timestamp}). - -@item u -User defined specifier. The next character in the format string should -be a letter. Gnus will call the function -@code{gnus-user-format-function-}@samp{X}, where @samp{X} is the letter -following @samp{%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 -specifier. -@end table - -@cindex * -All the ``number-of'' specs will be filled with an asterisk (@samp{*}) -if no info is available---for instance, if it is a non-activated foreign -group, or a bogus native group. - - -@node Group Modeline Specification -@subsection Group Modeline Specification -@cindex group modeline - -@vindex gnus-group-mode-line-format -The mode line can be changed by setting -@code{gnus-group-mode-line-format} (@pxref{Formatting Variables}). It -doesn't understand that many format specifiers: - -@table @samp -@item S -The native news server. -@item M -The native select method. -@end table - - -@node Group Highlighting -@subsection Group Highlighting -@cindex highlighting -@cindex group highlighting - -@vindex gnus-group-highlight -Highlighting in the group buffer is controlled by the -@code{gnus-group-highlight} variable. This is an alist with elements -that look like @var{(form . face)}. If @var{form} evaluates to -something non-@code{nil}, the @var{face} will be used on the line. - -Here's an example value for this variable that might look nice if the -background is dark: - -@lisp -(face-spec-set 'my-group-face-1 '((t (:foreground "Red" :bold t)))) -(face-spec-set 'my-group-face-2 '((t (:foreground "SeaGreen" :bold t)))) -(face-spec-set 'my-group-face-3 '((t (:foreground "SpringGreen" :bold t)))) -(face-spec-set 'my-group-face-4 '((t (:foreground "SteelBlue" :bold t)))) -(face-spec-set 'my-group-face-5 '((t (:foreground "SkyBlue" :bold t)))) - -(setq gnus-group-highlight - '(((> unread 200) . my-group-face-1) - ((and (< level 3) (zerop unread)) . my-group-face-2) - ((< level 3) . my-group-face-3) - ((zerop unread) . my-group-face-4) -(setq gnus-group-highlight - `(((> unread 200) . - ,(custom-face-lookup "Red" nil nil t nil nil)) - ((and (< level 3) (zerop unread)) . - ,(custom-face-lookup "SeaGreen" nil nil t nil nil)) - ((< level 3) . - ,(custom-face-lookup "SpringGreen" nil nil t nil nil)) - ((zerop unread) . - ,(custom-face-lookup "SteelBlue" nil nil t nil nil)) - (t . - ,(custom-face-lookup "SkyBlue" nil nil t nil nil)))) - (t . my-group-face-5))) -@end lisp - -Also @pxref{Faces and Fonts}. - -Variables that are dynamically bound when the forms are evaluated -include: - -@table @code -@item group -The group name. -@item unread -The number of unread articles in the group. -@item method -The select method. -@item mailp -Whether the group is a mail group. -@item level -The level of the group. -@item score -The score of the group. -@item ticked -The number of ticked articles in the group. -@item total -The total number of articles in the group. Or rather, MAX-NUMBER minus -MIN-NUMBER plus one. -@item topic -When using the topic minor mode, this variable is bound to the current -topic being inserted. -@end table - -When the forms are @code{eval}ed, point is at the beginning of the line -of the group in question, so you can use many of the normal Gnus -functions for snarfing info on the group. - -@vindex gnus-group-update-hook -@findex gnus-group-highlight-line -@code{gnus-group-update-hook} is called when a group line is changed. -It will not be called when @code{gnus-visual} is @code{nil}. This hook -calls @code{gnus-group-highlight-line} by default. - - -@node Group Maneuvering -@section Group Maneuvering -@cindex group movement - -All movement commands understand the numeric prefix and will behave as -expected, hopefully. - -@table @kbd - -@item n -@kindex n (Group) -@findex gnus-group-next-unread-group -Go to the next group that has unread articles -(@code{gnus-group-next-unread-group}). - -@item p -@itemx DEL -@kindex DEL (Group) -@kindex p (Group) -@findex gnus-group-prev-unread-group -Go to the previous group that has unread articles -(@code{gnus-group-prev-unread-group}). - -@item N -@kindex N (Group) -@findex gnus-group-next-group -Go to the next group (@code{gnus-group-next-group}). - -@item P -@kindex P (Group) -@findex gnus-group-prev-group -Go to the previous group (@code{gnus-group-prev-group}). - -@item M-p -@kindex M-p (Group) -@findex gnus-group-next-unread-group-same-level -Go to the next unread group on the same (or lower) level -(@code{gnus-group-next-unread-group-same-level}). - -@item M-n -@kindex M-n (Group) -@findex gnus-group-prev-unread-group-same-level -Go to the previous unread group on the same (or lower) level -(@code{gnus-group-prev-unread-group-same-level}). -@end table - -Three commands for jumping to groups: - -@table @kbd - -@item j -@kindex j (Group) -@findex gnus-group-jump-to-group -Jump to a group (and make it visible if it isn't already) -(@code{gnus-group-jump-to-group}). Killed groups can be jumped to, just -like living groups. - -@item , -@kindex , (Group) -@findex gnus-group-best-unread-group -Jump to the unread group with the lowest level -(@code{gnus-group-best-unread-group}). - -@item . -@kindex . (Group) -@findex gnus-group-first-unread-group -Jump to the first group with unread articles -(@code{gnus-group-first-unread-group}). -@end table - -@vindex gnus-group-goto-unread -If @code{gnus-group-goto-unread} is @code{nil}, all the movement -commands will move to the next group, not the next unread group. Even -the commands that say they move to the next unread group. The default -is @code{t}. - - -@node Selecting a Group -@section Selecting a Group -@cindex group selection - -@table @kbd - -@item SPACE -@kindex SPACE (Group) -@findex gnus-group-read-group -Select the current group, switch to the summary buffer and display the -first unread article (@code{gnus-group-read-group}). If there are no -unread articles in the group, or if you give a non-numerical prefix to -this command, Gnus will offer to fetch all the old articles in this -group from the server. If you give a numerical prefix @var{N}, @var{N} -determines the number of articles Gnus will fetch. If @var{N} is -positive, Gnus fetches the @var{N} newest articles, if @var{N} is -negative, Gnus fetches the @var{abs(N)} oldest articles. - -@item RET -@kindex RET (Group) -@findex gnus-group-select-group -Select the current group and switch to the summary buffer -(@code{gnus-group-select-group}). Takes the same arguments as -@code{gnus-group-read-group}---the only difference is that this command -does not display the first unread article automatically upon group -entry. - -@item M-RET -@kindex M-RET (Group) -@findex gnus-group-quick-select-group -This does the same as the command above, but tries to do it with the -minimum amount of fuzz (@code{gnus-group-quick-select-group}). No -scoring/killing will be performed, there will be no highlights and no -expunging. This might be useful if you're in a real hurry and have to -enter some humongous group. If you give a 0 prefix to this command -(i.e., @kbd{0 M-RET}), Gnus won't even generate the summary buffer, -which is useful if you want to toggle threading before generating the -summary buffer (@pxref{Summary Generation Commands}). - -@item M-SPACE -@kindex M-SPACE (Group) -@findex gnus-group-visible-select-group -This is yet one more command that does the same as the @kbd{RET} -command, but this one does it without expunging and hiding dormants -(@code{gnus-group-visible-select-group}). - -@item M-C-RET -@kindex M-C-RET (Group) -@findex gnus-group-select-group-ephemerally -Finally, this command selects the current group ephemerally without -doing any processing of its contents -(@code{gnus-group-select-group-ephemerally}). Even threading has been -turned off. Everything you do in the group after selecting it in this -manner will have no permanent effects. - -@end table - -@vindex gnus-large-newsgroup -The @code{gnus-large-newsgroup} variable says what Gnus should consider -to be a big group. This is 200 by default. If the group has more -(unread and/or ticked) articles than this, Gnus will query the user -before entering the group. The user can then specify how many articles -should be fetched from the server. If the user specifies a negative -number (@code{-n}), the @code{n} oldest articles will be fetched. If it -is positive, the @code{n} articles that have arrived most recently will -be fetched. - -@vindex gnus-select-group-hook -@vindex gnus-auto-select-first -@code{gnus-auto-select-first} control whether any articles are selected -automatically when entering a group with the @kbd{SPACE} command. - -@table @code - -@item nil -Don't select any articles when entering the group. Just display the -full summary buffer. - -@item t -Select the first unread article when entering the group. - -@item best -Select the most high-scored article in the group when entering the -group. -@end table - -If you want to prevent automatic selection in some group (say, in a -binary group with Huge articles) you can set this variable to @code{nil} -in @code{gnus-select-group-hook}, which is called when a group is -selected. - - -@node Subscription Commands -@section Subscription Commands -@cindex subscription - -@table @kbd - -@item S t -@itemx u -@kindex S t (Group) -@kindex u (Group) -@findex gnus-group-unsubscribe-current-group -@c @icon{gnus-group-unsubscribe} -Toggle subscription to the current group -(@code{gnus-group-unsubscribe-current-group}). - -@item S s -@itemx U -@kindex S s (Group) -@kindex U (Group) -@findex gnus-group-unsubscribe-group -Prompt for a group to subscribe, and then subscribe it. If it was -subscribed already, unsubscribe it instead -(@code{gnus-group-unsubscribe-group}). - -@item S k -@itemx C-k -@kindex S k (Group) -@kindex C-k (Group) -@findex gnus-group-kill-group -@c @icon{gnus-group-kill-group} -Kill the current group (@code{gnus-group-kill-group}). - -@item S y -@itemx C-y -@kindex S y (Group) -@kindex C-y (Group) -@findex gnus-group-yank-group -Yank the last killed group (@code{gnus-group-yank-group}). - -@item C-x C-t -@kindex C-x C-t (Group) -@findex gnus-group-transpose-groups -Transpose two groups (@code{gnus-group-transpose-groups}). This isn't -really a subscription command, but you can use it instead of a -kill-and-yank sequence sometimes. - -@item S w -@itemx C-w -@kindex S w (Group) -@kindex C-w (Group) -@findex gnus-group-kill-region -Kill all groups in the region (@code{gnus-group-kill-region}). - -@item S z -@kindex S z (Group) -@findex gnus-group-kill-all-zombies -Kill all zombie groups (@code{gnus-group-kill-all-zombies}). - -@item S C-k -@kindex S C-k (Group) -@findex gnus-group-kill-level -Kill all groups on a certain level (@code{gnus-group-kill-level}). -These groups can't be yanked back after killing, so this command should -be used with some caution. The only time where this command comes in -really handy is when you have a @file{.newsrc} with lots of unsubscribed -groups that you want to get rid off. @kbd{S C-k} on level 7 will -kill off all unsubscribed groups that do not have message numbers in the -@file{.newsrc} file. - -@end table - -Also @pxref{Group Levels}. - - -@node Group Data -@section Group Data - -@table @kbd - -@item c -@kindex c (Group) -@findex gnus-group-catchup-current -@vindex gnus-group-catchup-group-hook -@c @icon{gnus-group-catchup-current} -Mark all unticked articles in this group as read -(@code{gnus-group-catchup-current}). -@code{gnus-group-catchup-group-hook} is called when catching up a group from -the group buffer. - -@item C -@kindex C (Group) -@findex gnus-group-catchup-current-all -Mark all articles in this group, even the ticked ones, as read -(@code{gnus-group-catchup-current-all}). - -@item M-c -@kindex M-c (Group) -@findex gnus-group-clear-data -Clear the data from the current group---nix out marks and the list of -read articles (@code{gnus-group-clear-data}). - -@item M-x gnus-group-clear-data-on-native-groups -@kindex M-x gnus-group-clear-data-on-native-groups -@findex gnus-group-clear-data-on-native-groups -If you have switched from one @sc{nntp} server to another, all your marks -and read ranges have become worthless. You can use this command to -clear out all data that you have on your native groups. Use with -caution. - -@end table - - -@node Group Levels -@section Group Levels -@cindex group level -@cindex level - -All groups have a level of @dfn{subscribedness}. For instance, if a -group is on level 2, it is more subscribed than a group on level 5. You -can ask Gnus to just list groups on a given level or lower -(@pxref{Listing Groups}), or to just check for new articles in groups on -a given level or lower (@pxref{Scanning New Messages}). - -Remember: The higher the level of the group, the less important it is. - -@table @kbd - -@item S l -@kindex S l (Group) -@findex gnus-group-set-current-level -Set the level of the current group. If a numeric prefix is given, the -next @var{n} groups will have their levels set. The user will be -prompted for a level. -@end table - -@vindex gnus-level-killed -@vindex gnus-level-zombie -@vindex gnus-level-unsubscribed -@vindex gnus-level-subscribed -Gnus considers groups from levels 1 to -@code{gnus-level-subscribed} (inclusive) (default 5) to be subscribed, -@code{gnus-level-subscribed} (exclusive) and -@code{gnus-level-unsubscribed} (inclusive) (default 7) to be -unsubscribed, @code{gnus-level-zombie} to be zombies (walking dead) -(default 8) and @code{gnus-level-killed} to be killed (completely dead) -(default 9). Gnus treats subscribed and unsubscribed groups exactly the -same, but zombie and killed groups have no information on what articles -you have read, etc, stored. This distinction between dead and living -groups isn't done because it is nice or clever, it is done purely for -reasons of efficiency. - -It is recommended that you keep all your mail groups (if any) on quite -low levels (e.g. 1 or 2). - -If you want to play with the level variables, you should show some care. -Set them once, and don't touch them ever again. Better yet, don't touch -them at all unless you know exactly what you're doing. - -@vindex gnus-level-default-unsubscribed -@vindex gnus-level-default-subscribed -Two closely related variables are @code{gnus-level-default-subscribed} -(default 3) and @code{gnus-level-default-unsubscribed} (default 6), -which are the levels that new groups will be put on if they are -(un)subscribed. These two variables should, of course, be inside the -relevant valid ranges. - -@vindex gnus-keep-same-level -If @code{gnus-keep-same-level} is non-@code{nil}, some movement commands -will only move to groups of the same level (or lower). In -particular, going from the last article in one group to the next group -will go to the next group of the same level (or lower). This might be -handy if you want to read the most important groups before you read the -rest. - -@vindex gnus-group-default-list-level -All groups with a level less than or equal to -@code{gnus-group-default-list-level} will be listed in the group buffer -by default. - -@vindex gnus-group-list-inactive-groups -If @code{gnus-group-list-inactive-groups} is non-@code{nil}, non-active -groups will be listed along with the unread groups. This variable is -@code{t} by default. If it is @code{nil}, inactive groups won't be -listed. - -@vindex gnus-group-use-permanent-levels -If @code{gnus-group-use-permanent-levels} is non-@code{nil}, once you -give a level prefix to @kbd{g} or @kbd{l}, all subsequent commands will -use this level as the ``work'' level. - -@vindex gnus-activate-level -Gnus will normally just activate (i. e., query the server about) groups -on level @code{gnus-activate-level} or less. If you don't want to -activate unsubscribed groups, for instance, you might set this variable -to 5. The default is 6. - - -@node Group Score -@section Group Score -@cindex group score -@cindex group rank -@cindex rank - -You would normally keep important groups on high levels, but that scheme -is somewhat restrictive. Don't you wish you could have Gnus sort the -group buffer according to how often you read groups, perhaps? Within -reason? - -This is what @dfn{group score} is for. You can assign a score to each -group. You can then sort the group buffer based on this score. -Alternatively, you can sort on score and then level. (Taken together, -the level and the score is called the @dfn{rank} of the group. A group -that is on level 4 and has a score of 1 has a higher rank than a group -on level 5 that has a score of 300. (The level is the most significant -part and the score is the least significant part.)) - -@findex gnus-summary-bubble-group -If you want groups you read often to get higher scores than groups you -read seldom you can add the @code{gnus-summary-bubble-group} function to -the @code{gnus-summary-exit-hook} hook. This will result (after -sorting) in a bubbling sort of action. If you want to see that in -action after each summary exit, you can add -@code{gnus-group-sort-groups-by-rank} or -@code{gnus-group-sort-groups-by-score} to the same hook, but that will -slow things down somewhat. - - -@node Marking Groups -@section Marking Groups -@cindex marking groups - -If you want to perform some command on several groups, and they appear -subsequently in the group buffer, you would normally just give a -numerical prefix to the command. Most group commands will then do your -bidding on those groups. - -However, if the groups are not in sequential order, you can still -perform a command on several groups. You simply mark the groups first -with the process mark and then execute the command. - -@table @kbd - -@item # -@kindex # (Group) -@itemx M m -@kindex M m (Group) -@findex gnus-group-mark-group -Set the mark on the current group (@code{gnus-group-mark-group}). - -@item M-# -@kindex M-# (Group) -@itemx M u -@kindex M u (Group) -@findex gnus-group-unmark-group -Remove the mark from the current group -(@code{gnus-group-unmark-group}). - -@item M U -@kindex M U (Group) -@findex gnus-group-unmark-all-groups -Remove the mark from all groups (@code{gnus-group-unmark-all-groups}). - -@item M w -@kindex M w (Group) -@findex gnus-group-mark-region -Mark all groups between point and mark (@code{gnus-group-mark-region}). - -@item M b -@kindex M b (Group) -@findex gnus-group-mark-buffer -Mark all groups in the buffer (@code{gnus-group-mark-buffer}). - -@item M r -@kindex M r (Group) -@findex gnus-group-mark-regexp -Mark all groups that match some regular expression -(@code{gnus-group-mark-regexp}). -@end table - -Also @pxref{Process/Prefix}. - -@findex gnus-group-universal-argument -If you want to execute some command on all groups that have been marked -with the process mark, you can use the @kbd{M-&} -(@code{gnus-group-universal-argument}) command. It will prompt you for -the command to be executed. - - -@node Foreign Groups -@section Foreign Groups -@cindex foreign groups - -Below are some group mode commands for making and editing general foreign -groups, as well as commands to ease the creation of a few -special-purpose groups. All these commands insert the newly created -groups under point---@code{gnus-subscribe-newsgroup-method} is not -consulted. - -@table @kbd - -@item G m -@kindex G m (Group) -@findex gnus-group-make-group -@cindex making groups -Make a new group (@code{gnus-group-make-group}). Gnus will prompt you -for a name, a method and possibly an @dfn{address}. For an easier way -to subscribe to @sc{nntp} groups, @pxref{Browse Foreign Server}. - -@item G r -@kindex G r (Group) -@findex gnus-group-rename-group -@cindex renaming groups -Rename the current group to something else -(@code{gnus-group-rename-group}). This is valid only on some -groups---mail groups mostly. This command might very well be quite slow -on some backends. - -@item G c -@kindex G c (Group) -@cindex customizing -@findex gnus-group-customize -Customize the group parameters (@code{gnus-group-customize}). - -@item G e -@kindex G e (Group) -@findex gnus-group-edit-group-method -@cindex renaming groups -Enter a buffer where you can edit the select method of the current -group (@code{gnus-group-edit-group-method}). - -@item G p -@kindex G p (Group) -@findex gnus-group-edit-group-parameters -Enter a buffer where you can edit the group parameters -(@code{gnus-group-edit-group-parameters}). - -@item G E -@kindex G E (Group) -@findex gnus-group-edit-group -Enter a buffer where you can edit the group info -(@code{gnus-group-edit-group}). - -@item G d -@kindex G d (Group) -@findex gnus-group-make-directory-group -@cindex nndir -Make a directory group (@pxref{Directory Groups}). You will be prompted -for a directory name (@code{gnus-group-make-directory-group}). - -@item G h -@kindex G h (Group) -@cindex help group -@findex gnus-group-make-help-group -Make the Gnus help group (@code{gnus-group-make-help-group}). - -@item G a -@kindex G a (Group) -@cindex (ding) archive -@cindex archive group -@findex gnus-group-make-archive-group -@vindex gnus-group-archive-directory -@vindex gnus-group-recent-archive-directory -Make a Gnus archive group (@code{gnus-group-make-archive-group}). By -default a group pointing to the most recent articles will be created -(@code{gnus-group-recent-archive-directory}), but given a prefix, a full -group will be created from @code{gnus-group-archive-directory}. - -@item G k -@kindex G k (Group) -@findex gnus-group-make-kiboze-group -@cindex nnkiboze -Make a kiboze group. You will be prompted for a name, for a regexp to -match groups to be ``included'' in the kiboze group, and a series of -strings to match on headers (@code{gnus-group-make-kiboze-group}). -@xref{Kibozed Groups}. - -@item G D -@kindex G D (Group) -@findex gnus-group-enter-directory -@cindex nneething -Read an arbitrary directory as if it were a newsgroup with the -@code{nneething} backend (@code{gnus-group-enter-directory}). -@xref{Anything Groups}. - -@item G f -@kindex G f (Group) -@findex gnus-group-make-doc-group -@cindex ClariNet Briefs -@cindex nndoc -Make a group based on some file or other -(@code{gnus-group-make-doc-group}). If you give a prefix to this -command, you will be prompted for a file name and a file type. -Currently supported types are @code{babyl}, @code{mbox}, @code{digest}, -@code{mmdf}, @code{news}, @code{rnews}, @code{clari-briefs}, -@code{rfc934}, @code{rfc822-forward}, and @code{forward}. If you run -this command without a prefix, Gnus will guess at the file type. -@xref{Document Groups}. - -@item G w -@kindex G w (Group) -@findex gnus-group-make-web-group -@cindex DejaNews -@cindex Alta Vista -@cindex InReference -@cindex nnweb -Make an ephemeral group based on a web search -(@code{gnus-group-make-web-group}). If you give a prefix to this -command, make a solid group instead. You will be prompted for the -search engine type and the search string. Valid search engine types -include @code{dejanews}, @code{altavista} and @code{reference}. -@xref{Web Searches}. - -@item G DEL -@kindex G DEL (Group) -@findex gnus-group-delete-group -This function will delete the current group -(@code{gnus-group-delete-group}). If given a prefix, this function will -actually delete all the articles in the group, and forcibly remove the -group itself from the face of the Earth. Use a prefix only if you are -absolutely sure of what you are doing. This command can't be used on -read-only groups (like @code{nntp} group), though. - -@item G V -@kindex G V (Group) -@findex gnus-group-make-empty-virtual -Make a new, fresh, empty @code{nnvirtual} group -(@code{gnus-group-make-empty-virtual}). @xref{Virtual Groups}. - -@item G v -@kindex G v (Group) -@findex gnus-group-add-to-virtual -Add the current group to an @code{nnvirtual} group -(@code{gnus-group-add-to-virtual}). Uses the process/prefix convention. -@end table - -@xref{Select Methods} for more information on the various select -methods. - -@vindex gnus-activate-foreign-newsgroups -If @code{gnus-activate-foreign-newsgroups} is a positive number, -Gnus will check all foreign groups with this level or lower at startup. -This might take quite a while, especially if you subscribe to lots of -groups from different @sc{nntp} servers. - - -@node Group Parameters -@section Group Parameters -@cindex group parameters - -The group parameters store information local to a particular group: - -@table @code -@item to-address -@cindex to-address -If the group parameter list contains an element that looks like -@code{(to-address . "some@@where.com")}, that address will be used by -the backend 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 @code{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 -@samp{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. - -@item to-list -@cindex to-list -If the group parameter list has an element that looks like -@code{(to-list . "some@@where.com")}, that address will be used when -doing a @kbd{a} in that 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 @kbd{f}. - -If you do an @kbd{a} command in a mail group and you don't have a -@code{to-list} group parameter, one will be added automatically upon -sending the message. - -@item visible -@cindex visible -If the group parameter list has the element @code{(visible . t)}, -that group will always be visible in the Group buffer, regardless -of whether it has any unread articles. - -@item broken-reply-to -@cindex broken-reply-to -Elements like @code{(broken-reply-to . t)} signals that @code{Reply-To} -headers in this group are to be ignored. This can be useful if you're -reading a mailing list group where the listserv has inserted -@code{Reply-To} headers that point back to the listserv itself. This is -broken behavior. So there! - -@item to-group -@cindex to-group -Elements like @code{(to-group . "some.group.name")} means that all -posts in that group will be sent to @code{some.group.name}. - -@item newsgroup -@cindex newsgroup -If this symbol is present in the group parameter list, Gnus will treat -all responses as if they were responses to news articles. This can be -useful if you have a mail group that's really a mirror of a news group. - -@item gcc-self -@cindex gcc-self -If this symbol is present in the group parameter list and set to -@code{t}, newly composed messages will be @code{Gcc}'d to the current -group. If it is present and set to @code{none}, no @code{Gcc:} header -will be generated, if it is present and a string, this string will be -inserted literally as a @code{gcc} header (this symbol takes precedence -over any default @code{Gcc} rules as described later). @xref{Archived -Messages} - -@item auto-expire -@cindex auto-expire -If the group parameter has an element that looks like @code{(auto-expire -. t)}, all articles read will be marked as expirable. For an -alternative approach, @pxref{Expiring Mail}. - -@item total-expire -@cindex total-expire -If the group parameter has an element that looks like -@code{(total-expire . t)}, all read articles will be put through the -expiry process, even if they are not marked as expirable. Use with -caution. Unread, ticked and dormant articles are not eligible for -expiry. - -@item expiry-wait -@cindex expiry-wait -@vindex nnmail-expiry-wait-function -If the group parameter has an element that looks like @code{(expiry-wait -. 10)}, this value will override any @code{nnmail-expiry-wait} and -@code{nnmail-expiry-wait-function} when expiring expirable messages. -The value can either be a number of days (not necessarily an integer) or -the symbols @code{never} or @code{immediate}. - -@item score-file -@cindex score file group parameter -Elements that look like @code{(score-file . "file")} will make -@file{file} into the current adaptive score file for the group in -question. All adaptive score entries will be put into this file. - -@item adapt-file -@cindex adapt file group parameter -Elements that look like @code{(adapt-file . "file")} will make -@file{file} into the current adaptive file for the group in question. -All adaptive score entries will be put into this file. - -@item admin-address -When unsubscribing from a mailing list you should never send the -unsubscription notice to the mailing list itself. Instead, you'd send -messages to the administrative address. This parameter allows you to -put the admin address somewhere convenient. - -@item display -Elements that look like @code{(display . MODE)} say which articles to -display on entering the group. Valid values are: - -@table @code -@item all -Display all articles, both read and unread. - -@item default -Display the default visible articles, which normally includes unread and -ticked articles. -@end table - -@item comment -Elements that look like @code{(comment . "This is a comment")} -are arbitrary comments on the group. They are currently ignored by -Gnus, but provide a place for you to store information on particular -groups. - -@item @var{(variable form)} -You can use the group parameters to set variables local to the group you -are entering. If you want to turn threading off in @samp{news.answers}, -you could put @code{(gnus-show-threads nil)} in the group parameters of -that group. @code{gnus-show-threads} will be made into a local variable -in the summary buffer you enter, and the form @code{nil} will be -@code{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 @code{(dummy-variable (ding))} in the parameters of that -group. @code{dummy-variable} will be set to the result of the -@code{(ding)} form, but who cares? - -@end table - -Use the @kbd{G p} command to edit group parameters of a group. - -@pxref{Topic Parameters}. - -Here's an example group parameter list: - -@example -((to-address . "ding@@gnus.org") - (auto-expiry . t)) -@end example - - -@node Listing Groups -@section Listing Groups -@cindex group listing - -These commands all list various slices of the groups available. - -@table @kbd - -@item l -@itemx A s -@kindex A s (Group) -@kindex l (Group) -@findex gnus-group-list-groups -List all groups that have unread articles -(@code{gnus-group-list-groups}). If the numeric prefix is used, this -command will list only groups of level ARG and lower. By default, it -only lists groups of level five (i. e., -@code{gnus-group-default-list-level}) or lower (i.e., just subscribed -groups). - -@item L -@itemx A u -@kindex A u (Group) -@kindex L (Group) -@findex gnus-group-list-all-groups -List all groups, whether they have unread articles or not -(@code{gnus-group-list-all-groups}). If the numeric prefix is used, -this command will list only groups of level ARG and lower. By default, -it lists groups of level seven or lower (i.e., just subscribed and -unsubscribed groups). - -@item A l -@kindex A l (Group) -@findex gnus-group-list-level -List all unread groups on a specific level -(@code{gnus-group-list-level}). If given a prefix, also list the groups -with no unread articles. - -@item A k -@kindex A k (Group) -@findex gnus-group-list-killed -List all killed groups (@code{gnus-group-list-killed}). If given a -prefix argument, really list all groups that are available, but aren't -currently (un)subscribed. This could entail reading the active file -from the server. - -@item A z -@kindex A z (Group) -@findex gnus-group-list-zombies -List all zombie groups (@code{gnus-group-list-zombies}). - -@item A m -@kindex A m (Group) -@findex gnus-group-list-matching -List all unread, subscribed groups with names that match a regexp -(@code{gnus-group-list-matching}). - -@item A M -@kindex A M (Group) -@findex gnus-group-list-all-matching -List groups that match a regexp (@code{gnus-group-list-all-matching}). - -@item A A -@kindex A A (Group) -@findex gnus-group-list-active -List absolutely all groups in the active file(s) of the -server(s) you are connected to (@code{gnus-group-list-active}). This -might very well take quite a while. It might actually be a better idea -to do a @kbd{A M} to list all matching, and just give @samp{.} as the -thing to match on. Also note that this command may list groups that -don't exist (yet)---these will be listed as if they were killed groups. -Take the output with some grains of salt. - -@item A a -@kindex A a (Group) -@findex gnus-group-apropos -List all groups that have names that match a regexp -(@code{gnus-group-apropos}). - -@item A d -@kindex A d (Group) -@findex gnus-group-description-apropos -List all groups that have names or descriptions that match a regexp -(@code{gnus-group-description-apropos}). - -@end table - -@vindex gnus-permanently-visible-groups -@cindex visible group parameter -Groups that match the @code{gnus-permanently-visible-groups} regexp will -always be shown, whether they have unread articles or not. You can also -add the @code{visible} element to the group parameters in question to -get the same effect. - -@vindex gnus-list-groups-with-ticked-articles -Groups that have just ticked articles in it are normally listed in the -group buffer. If @code{gnus-list-groups-with-ticked-articles} is -@code{nil}, these groups will be treated just like totally empty -groups. It is @code{t} by default. - - -@node Sorting Groups -@section Sorting Groups -@cindex sorting groups - -@kindex C-c C-s (Group) -@findex gnus-group-sort-groups -@vindex gnus-group-sort-function -The @kbd{C-c C-s} (@code{gnus-group-sort-groups}) command sorts the -group buffer according to the function(s) given by the -@code{gnus-group-sort-function} variable. Available sorting functions -include: - -@table @code - -@item gnus-group-sort-by-alphabet -@findex gnus-group-sort-by-alphabet -Sort the group names alphabetically. This is the default. - -@item gnus-group-sort-by-real-name -@findex gnus-group-sort-by-real-name -Sort the group alphabetically on the real (unprefixed) group names. - -@item gnus-group-sort-by-level -@findex gnus-group-sort-by-level -Sort by group level. - -@item gnus-group-sort-by-score -@findex gnus-group-sort-by-score -Sort by group score. @xref{Group Score}. - -@item gnus-group-sort-by-rank -@findex gnus-group-sort-by-rank -Sort by group score and then the group level. The level and the score -are, when taken together, the group's @dfn{rank}. @xref{Group Score}. - -@item gnus-group-sort-by-unread -@findex gnus-group-sort-by-unread -Sort by number of unread articles. - -@item gnus-group-sort-by-method -@findex gnus-group-sort-by-method -Sort alphabetically on the select method. - - -@end table - -@code{gnus-group-sort-function} can also be a list of sorting -functions. In that case, the most significant sort key function must be -the last one. - - -There are also a number of commands for sorting directly according to -some sorting criteria: - -@table @kbd -@item G S a -@kindex G S a (Group) -@findex gnus-group-sort-groups-by-alphabet -Sort the group buffer alphabetically by group name -(@code{gnus-group-sort-groups-by-alphabet}). - -@item G S u -@kindex G S u (Group) -@findex gnus-group-sort-groups-by-unread -Sort the group buffer by the number of unread articles -(@code{gnus-group-sort-groups-by-unread}). - -@item G S l -@kindex G S l (Group) -@findex gnus-group-sort-groups-by-level -Sort the group buffer by group level -(@code{gnus-group-sort-groups-by-level}). - -@item G S v -@kindex G S v (Group) -@findex gnus-group-sort-groups-by-score -Sort the group buffer by group score -(@code{gnus-group-sort-groups-by-score}). @xref{Group Score}. - -@item G S r -@kindex G S r (Group) -@findex gnus-group-sort-groups-by-rank -Sort the group buffer by group rank -(@code{gnus-group-sort-groups-by-rank}). @xref{Group Score}. - -@item G S m -@kindex G S m (Group) -@findex gnus-group-sort-groups-by-method -Sort the group buffer alphabetically by backend name -(@code{gnus-group-sort-groups-by-method}). - -@end table - -When given a prefix, all these commands will sort in reverse order. - -You can also sort a subset of the groups: - -@table @kbd -@item G P a -@kindex G P a (Group) -@findex gnus-group-sort-selected-groups-by-alphabet -Sort the process/prefixed groups in the group buffer alphabetically by -group name (@code{gnus-group-sort-selected-groups-by-alphabet}). - -@item G P u -@kindex G P u (Group) -@findex gnus-group-sort-selected-groups-by-unread -Sort the process/prefixed groups in the group buffer by the number of -unread articles (@code{gnus-group-sort-selected-groups-by-unread}). - -@item G P l -@kindex G P l (Group) -@findex gnus-group-sort-selected-groups-by-level -Sort the process/prefixed groups in the group buffer by group level -(@code{gnus-group-sort-selected-groups-by-level}). - -@item G P v -@kindex G P v (Group) -@findex gnus-group-sort-selected-groups-by-score -Sort the process/prefixed groups in the group buffer by group score -(@code{gnus-group-sort-selected-groups-by-score}). @xref{Group Score}. - -@item G P r -@kindex G P r (Group) -@findex gnus-group-sort-selected-groups-by-rank -Sort the process/prefixed groups in the group buffer by group rank -(@code{gnus-group-sort-selected-groups-by-rank}). @xref{Group Score}. - -@item G P m -@kindex G P m (Group) -@findex gnus-group-sort-selected-groups-by-method -Sort the process/prefixed groups in the group buffer alphabetically by -backend name (@code{gnus-group-sort-selected-groups-by-method}). - -@end table - - - -@node Group Maintenance -@section Group Maintenance -@cindex bogus groups - -@table @kbd -@item b -@kindex b (Group) -@findex gnus-group-check-bogus-groups -Find bogus groups and delete them -(@code{gnus-group-check-bogus-groups}). - -@item F -@kindex F (Group) -@findex gnus-group-find-new-groups -Find new groups and process them (@code{gnus-group-find-new-groups}). -If given a prefix, use the @code{ask-server} method to query the server -for new groups. - -@item C-c C-x -@kindex C-c C-x (Group) -@findex gnus-group-expire-articles -Run all expirable articles in the current group through the expiry -process (if any) (@code{gnus-group-expire-articles}). - -@item C-c M-C-x -@kindex C-c M-C-x (Group) -@findex gnus-group-expire-all-groups -Run all articles in all groups through the expiry process -(@code{gnus-group-expire-all-groups}). - -@end table - - -@node Browse Foreign Server -@section Browse Foreign Server -@cindex foreign servers -@cindex browsing servers - -@table @kbd -@item B -@kindex B (Group) -@findex gnus-group-browse-foreign-server -You will be queried for a select method and a server name. Gnus will -then attempt to contact this server and let you browse the groups there -(@code{gnus-group-browse-foreign-server}). -@end table - -@findex gnus-browse-mode -A new buffer with a list of available groups will appear. This buffer -will use the @code{gnus-browse-mode}. This buffer looks a bit (well, -a lot) like a normal group buffer. - -Here's a list of keystrokes available in the browse mode: - -@table @kbd -@item n -@kindex n (Browse) -@findex gnus-group-next-group -Go to the next group (@code{gnus-group-next-group}). - -@item p -@kindex p (Browse) -@findex gnus-group-prev-group -Go to the previous group (@code{gnus-group-prev-group}). - -@item SPACE -@kindex SPACE (Browse) -@findex gnus-browse-read-group -Enter the current group and display the first article -(@code{gnus-browse-read-group}). - -@item RET -@kindex RET (Browse) -@findex gnus-browse-select-group -Enter the current group (@code{gnus-browse-select-group}). - -@item u -@kindex u (Browse) -@findex gnus-browse-unsubscribe-current-group -Unsubscribe to the current group, or, as will be the case here, -subscribe to it (@code{gnus-browse-unsubscribe-current-group}). - -@item l -@itemx q -@kindex q (Browse) -@kindex l (Browse) -@findex gnus-browse-exit -Exit browse mode (@code{gnus-browse-exit}). - -@item ? -@kindex ? (Browse) -@findex gnus-browse-describe-briefly -Describe browse mode briefly (well, there's not much to describe, is -there) (@code{gnus-browse-describe-briefly}). -@end table - - -@node Exiting Gnus -@section Exiting Gnus -@cindex exiting Gnus - -Yes, Gnus is ex(c)iting. - -@table @kbd -@item z -@kindex z (Group) -@findex gnus-group-suspend -Suspend Gnus (@code{gnus-group-suspend}). This doesn't really exit Gnus, -but it kills all buffers except the Group buffer. I'm not sure why this -is a gain, but then who am I to judge? - -@item q -@kindex q (Group) -@findex gnus-group-exit -@c @icon{gnus-group-exit} -Quit Gnus (@code{gnus-group-exit}). - -@item Q -@kindex Q (Group) -@findex gnus-group-quit -Quit Gnus without saving the @file{.newsrc} files (@code{gnus-group-quit}). -The dribble file will be saved, though (@pxref{Auto Save}). -@end table - -@vindex gnus-exit-gnus-hook -@vindex gnus-suspend-gnus-hook -@code{gnus-suspend-gnus-hook} is called when you suspend Gnus and -@code{gnus-exit-gnus-hook} is called when you quit Gnus, while -@code{gnus-after-exiting-gnus-hook} is called as the final item when -exiting Gnus. - -@findex gnus-unload -@cindex unloading -If you wish to completely unload Gnus and all its adherents, you can use -the @code{gnus-unload} command. This command is also very handy when -trying to customize meta-variables. - -Note: - -@quotation -Miss Lisa Cannifax, while sitting in English class, felt her feet go -numbly heavy and herself fall into a hazy trance as the boy sitting -behind her drew repeated lines with his pencil across the back of her -plastic chair. -@end quotation - - -@node Group Topics -@section Group Topics -@cindex topics - -If you read lots and lots of groups, it might be convenient to group -them hierarchically according to topics. You put your Emacs groups over -here, your sex groups over there, and the rest (what, two groups or so?) -you put in some misc section that you never bother with anyway. You can -even group the Emacs sex groups as a sub-topic to either the Emacs -groups or the sex groups---or both! Go wild! - -@iftex -@iflatex -\gnusfigure{Group Topics}{400}{ -\put(75,50){\epsfig{figure=tmp/group-topic.ps,height=9cm}} -} -@end iflatex -@end iftex - -Here's an example: - -@example -Gnus - Emacs -- I wuw it! - 3: comp.emacs - 2: alt.religion.emacs - Naughty Emacs - 452: alt.sex.emacs - 0: comp.talk.emacs.recovery - Misc - 8: comp.binaries.fractals - 13: comp.sources.unix -@end example - -@findex gnus-topic-mode -@kindex t (Group) -To get this @emph{fab} functionality you simply turn on (ooh!) the -@code{gnus-topic} minor mode---type @kbd{t} in the group buffer. (This -is a toggling command.) - -Go ahead, just try it. I'll still be here when you get back. La de -dum... Nice tune, that... la la la... What, you're back? Yes, and now -press @kbd{l}. There. All your groups are now listed under -@samp{misc}. Doesn't that make you feel all warm and fuzzy? Hot and -bothered? - -If you want this permanently enabled, you should add that minor mode to -the hook for the group mode: - -@lisp -(add-hook 'gnus-group-mode-hook 'gnus-topic-mode) -@end lisp - -@menu -* Topic Variables:: How to customize the topics the Lisp Way. -* Topic Commands:: Interactive E-Z commands. -* Topic Sorting:: Sorting each topic individually. -* Topic Topology:: A map of the world. -* Topic Parameters:: Parameters that apply to all groups in a topic. -@end menu - - -@node Topic Variables -@subsection Topic Variables -@cindex topic variables - -Now, if you select a topic, it will fold/unfold that topic, which is -really neat, I think. - -@vindex gnus-topic-line-format -The topic lines themselves are created according to the -@code{gnus-topic-line-format} variable (@pxref{Formatting Variables}). -Valid elements are: - -@table @samp -@item i -Indentation. -@item n -Topic name. -@item v -Visibility. -@item l -Level. -@item g -Number of groups in the topic. -@item a -Number of unread articles in the topic. -@item A -Number of unread articles in the topic and all its subtopics. -@end table - -@vindex gnus-topic-indent-level -Each sub-topic (and the groups in the sub-topics) will be indented with -@code{gnus-topic-indent-level} times the topic level number of spaces. -The default is 2. - -@vindex gnus-topic-mode-hook -@code{gnus-topic-mode-hook} is called in topic minor mode buffers. - -@vindex gnus-topic-display-empty-topics -The @code{gnus-topic-display-empty-topics} says whether to display even -topics that have no unread articles in them. The default is @code{t}. - - -@node Topic Commands -@subsection Topic Commands -@cindex topic commands - -When the topic minor mode is turned on, a new @kbd{T} submap will be -available. In addition, a few of the standard keys change their -definitions slightly. - -@table @kbd - -@item T n -@kindex T n (Topic) -@findex gnus-topic-create-topic -Prompt for a new topic name and create it -(@code{gnus-topic-create-topic}). - -@item T m -@kindex T m (Topic) -@findex gnus-topic-move-group -Move the current group to some other topic -(@code{gnus-topic-move-group}). This command uses the process/prefix -convention (@pxref{Process/Prefix}). - -@item T c -@kindex T c (Topic) -@findex gnus-topic-copy-group -Copy the current group to some other topic -(@code{gnus-topic-copy-group}). This command uses the process/prefix -convention (@pxref{Process/Prefix}). - -@item T D -@kindex T D (Topic) -@findex gnus-topic-remove-group -Remove a group from the current topic (@code{gnus-topic-remove-group}). -This command uses the process/prefix convention -(@pxref{Process/Prefix}). - -@item T M -@kindex T M (Topic) -@findex gnus-topic-move-matching -Move all groups that match some regular expression to a topic -(@code{gnus-topic-move-matching}). - -@item T C -@kindex T C (Topic) -@findex gnus-topic-copy-matching -Copy all groups that match some regular expression to a topic -(@code{gnus-topic-copy-matching}). - -@item T h -@kindex T h (Topic) -@findex gnus-topic-toggle-display-empty-topics -Toggle hiding empty topics -(@code{gnus-topic-toggle-display-empty-topics}). - -@item T # -@kindex T # (Topic) -@findex gnus-topic-mark-topic -Mark all groups in the current topic with the process mark -(@code{gnus-topic-mark-topic}). - -@item T M-# -@kindex T M-# (Topic) -@findex gnus-topic-unmark-topic -Remove the process mark from all groups in the current topic -(@code{gnus-topic-unmark-topic}). - -@item RET -@kindex RET (Topic) -@findex gnus-topic-select-group -@itemx SPACE -Either select a group or fold a topic (@code{gnus-topic-select-group}). -When you perform this command on a group, you'll enter the group, as -usual. When done on a topic line, the topic will be folded (if it was -visible) or unfolded (if it was folded already). So it's basically a -toggling command on topics. In addition, if you give a numerical -prefix, group on that level (and lower) will be displayed. - -@item T TAB -@kindex T TAB (Topic) -@findex gnus-topic-indent -``Indent'' the current topic so that it becomes a sub-topic of the -previous topic (@code{gnus-topic-indent}). If given a prefix, -``un-indent'' the topic instead. - -@item C-k -@kindex C-k (Topic) -@findex gnus-topic-kill-group -Kill a group or topic (@code{gnus-topic-kill-group}). All groups in the -topic will be removed along with the topic. - -@item C-y -@kindex C-y (Topic) -@findex gnus-topic-yank-group -Yank the previously killed group or topic -(@code{gnus-topic-yank-group}). Note that all topics will be yanked -before all groups. - -@item T r -@kindex T r (Topic) -@findex gnus-topic-rename -Rename a topic (@code{gnus-topic-rename}). - -@item T DEL -@kindex T DEL (Topic) -@findex gnus-topic-delete -Delete an empty topic (@code{gnus-topic-delete}). - -@item A T -@kindex A T (Topic) -@findex gnus-topic-list-active -List all groups that Gnus knows about in a topics-ified way -(@code{gnus-topic-list-active}). - -@item G p -@kindex G p (Topic) -@findex gnus-topic-edit-parameters -@cindex group parameters -@cindex topic parameters -@cindex parameters -Edit the topic parameters (@code{gnus-topic-edit-parameters}). -@xref{Topic Parameters}. - -@end table - - -@node Topic Sorting -@subsection Topic Sorting -@cindex topic sorting - -You can sort the groups in each topic individually with the following -commands: - - -@table @kbd -@item T S a -@kindex T S a (Topic) -@findex gnus-topic-sort-groups-by-alphabet -Sort the current topic alphabetically by group name -(@code{gnus-topic-sort-groups-by-alphabet}). - -@item T S u -@kindex T S u (Topic) -@findex gnus-topic-sort-groups-by-unread -Sort the current topic by the number of unread articles -(@code{gnus-topic-sort-groups-by-unread}). - -@item T S l -@kindex T S l (Topic) -@findex gnus-topic-sort-groups-by-level -Sort the current topic by group level -(@code{gnus-topic-sort-groups-by-level}). - -@item T S v -@kindex T S v (Topic) -@findex gnus-topic-sort-groups-by-score -Sort the current topic by group score -(@code{gnus-topic-sort-groups-by-score}). @xref{Group Score}. - -@item T S r -@kindex T S r (Topic) -@findex gnus-topic-sort-groups-by-rank -Sort the current topic by group rank -(@code{gnus-topic-sort-groups-by-rank}). @xref{Group Score}. - -@item T S m -@kindex T S m (Topic) -@findex gnus-topic-sort-groups-by-method -Sort the current topic alphabetically by backend name -(@code{gnus-topic-sort-groups-by-method}). - -@end table - -@xref{Sorting Groups} for more information about group sorting. - - -@node Topic Topology -@subsection Topic Topology -@cindex topic topology -@cindex topology - -So, let's have a look at an example group buffer: - -@example -Gnus - Emacs -- I wuw it! - 3: comp.emacs - 2: alt.religion.emacs - Naughty Emacs - 452: alt.sex.emacs - 0: comp.talk.emacs.recovery - Misc - 8: comp.binaries.fractals - 13: comp.sources.unix -@end example - -So, here we have one top-level topic (@samp{Gnus}), two topics under -that, and one sub-topic under one of the sub-topics. (There is always -just one (1) top-level topic). This topology can be expressed as -follows: - -@lisp -(("Gnus" visible) - (("Emacs -- I wuw it!" visible) - (("Naughty Emacs" visible))) - (("Misc" visible))) -@end lisp - -@vindex gnus-topic-topology -This is in fact how the variable @code{gnus-topic-topology} would look -for the display above. That variable is saved in the @file{.newsrc.eld} -file, and shouldn't be messed with manually---unless you really want -to. Since this variable is read from the @file{.newsrc.eld} file, -setting it in any other startup files will have no effect. - -This topology shows what topics are sub-topics of what topics (right), -and which topics are visible. Two settings are currently -allowed---@code{visible} and @code{invisible}. - - -@node Topic Parameters -@subsection Topic Parameters -@cindex topic parameters - -All groups in a topic will inherit group parameters from the parent (and -ancestor) topic parameters. All valid group parameters are valid topic -parameters (@pxref{Group Parameters}). - -Group parameters (of course) override topic parameters, and topic -parameters in sub-topics override topic parameters in super-topics. You -know. Normal inheritance rules. (@dfn{Rules} is here a noun, not a -verb, although you may feel free to disagree with me here.) - -@example -Gnus - Emacs - 3: comp.emacs - 2: alt.religion.emacs - 452: alt.sex.emacs - Relief - 452: alt.sex.emacs - 0: comp.talk.emacs.recovery - Misc - 8: comp.binaries.fractals - 13: comp.sources.unix - 452: alt.sex.emacs -@end example - -The @samp{Emacs} topic has the topic parameter @code{(score-file -. "emacs.SCORE")}; the @samp{Relief} topic has the topic parameter -@code{(score-file . "relief.SCORE")}; and the @samp{Misc} topic has the -topic parameter @code{(score-file . "emacs.SCORE")}. In addition, -@samp{alt.religion.emacs} has the group parameter @code{(score-file -. "religion.SCORE")}. - -Now, when you enter @samp{alt.sex.emacs} in the @samp{Relief} topic, you -will get the @file{relief.SCORE} home score file. If you enter the same -group in the @samp{Emacs} topic, you'll get the @file{emacs.SCORE} home -score file. If you enter the group @samp{alt.religion.emacs}, you'll -get the @file{religion.SCORE} home score file. - -This seems rather simple and self-evident, doesn't it? Well, yes. But -there are some problems, especially with the @code{total-expiry} -parameter. Say you have a mail group in two topics; one with -@code{total-expiry} and one without. What happens when you do @kbd{M-x -gnus-expire-all-expirable-groups}? Gnus has no way of telling which one -of these topics you mean to expire articles from, so anything may -happen. In fact, I hereby declare that it is @dfn{undefined} what -happens. You just have to be careful if you do stuff like that. - - -@node Misc Group Stuff -@section Misc Group Stuff - -@menu -* Scanning New Messages:: Asking Gnus to see whether new messages have arrived. -* Group Information:: Information and help on groups and Gnus. -* Group Timestamp:: Making Gnus keep track of when you last read a group. -* File Commands:: Reading and writing the Gnus files. -@end menu - -@table @kbd - -@item ^ -@kindex ^ (Group) -@findex gnus-group-enter-server-mode -Enter the server buffer (@code{gnus-group-enter-server-mode}). -@xref{The Server Buffer}. - -@item a -@kindex a (Group) -@findex gnus-group-post-news -Post an article to a group (@code{gnus-group-post-news}). If given a -prefix, the current group name will be used as the default. - -@item m -@kindex m (Group) -@findex gnus-group-mail -Mail a message somewhere (@code{gnus-group-mail}). - -@end table - -Variables for the group buffer: - -@table @code - -@item gnus-group-mode-hook -@vindex gnus-group-mode-hook -is called after the group buffer has been -created. - -@item gnus-group-prepare-hook -@vindex gnus-group-prepare-hook -is called after the group buffer is -generated. It may be used to modify the buffer in some strange, -unnatural way. - -@item gnus-group-prepared-hook -@vindex gnus-group-prepare-hook -is called as the very last thing after the group buffer has been -generated. It may be used to move point around, for instance. - -@item gnus-permanently-visible-groups -@vindex gnus-permanently-visible-groups -Groups matching this regexp will always be listed in the group buffer, -whether they are empty or not. - -@end table - - -@node Scanning New Messages -@subsection Scanning New Messages -@cindex new messages -@cindex scanning new news - -@table @kbd - -@item g -@kindex g (Group) -@findex gnus-group-get-new-news -@c @icon{gnus-group-get-new-news} -Check the server(s) for new articles. If the numerical prefix is used, -this command will check only groups of level @var{arg} and lower -(@code{gnus-group-get-new-news}). If given a non-numerical prefix, this -command will force a total re-reading of the active file(s) from the -backend(s). - -@item M-g -@kindex M-g (Group) -@findex gnus-group-get-new-news-this-group -@vindex gnus-goto-next-group-when-activating -@c @icon{gnus-group-get-new-news-this-group} -Check whether new articles have arrived in the current group -(@code{gnus-group-get-new-news-this-group}). -@code{gnus-goto-next-group-when-activating} says whether this command is -to move point to the next group or not. It is @code{t} by default. - -@findex gnus-activate-all-groups -@cindex activating groups -@item C-c M-g -@kindex C-c M-g (Group) -Activate absolutely all groups (@code{gnus-activate-all-groups}). - -@item R -@kindex R (Group) -@cindex restarting -@findex gnus-group-restart -Restart Gnus (@code{gnus-group-restart}). This saves the @file{.newsrc} -file(s), closes the connection to all servers, clears up all run-time -Gnus variables, and then starts Gnus all over again. - -@end table - -@vindex gnus-get-new-news-hook -@code{gnus-get-new-news-hook} is run just before checking for new news. - -@vindex gnus-after-getting-new-news-hook -@code{gnus-after-getting-new-news-hook} is run after checking for new -news. - - -@node Group Information -@subsection Group Information -@cindex group information -@cindex information on groups - -@table @kbd - - -@item H f -@kindex H f (Group) -@findex gnus-group-fetch-faq -@vindex gnus-group-faq-directory -@cindex FAQ -@cindex ange-ftp -Try to fetch the FAQ for the current group -(@code{gnus-group-fetch-faq}). Gnus will try to get the FAQ from -@code{gnus-group-faq-directory}, which is usually a directory on a -remote machine. This variable can also be a list of directories. In -that case, giving a prefix to this command will allow you to choose -between the various sites. @code{ange-ftp} (or @code{efs}) will be used -for fetching the file. - -If fetching from the first site is unsuccessful, Gnus will attempt to go -through @code{gnus-group-faq-directory} and try to open them one by one. - -@item H d -@itemx C-c C-d -@c @icon{gnus-group-describe-group} -@kindex H d (Group) -@kindex C-c C-d (Group) -@cindex describing groups -@cindex group description -@findex gnus-group-describe-group -Describe the current group (@code{gnus-group-describe-group}). If given -a prefix, force Gnus to re-read the description from the server. - -@item M-d -@kindex M-d (Group) -@findex gnus-group-describe-all-groups -Describe all groups (@code{gnus-group-describe-all-groups}). If given a -prefix, force Gnus to re-read the description file from the server. - -@item H v -@itemx V -@kindex V (Group) -@kindex H v (Group) -@cindex version -@findex gnus-version -Display current Gnus version numbers (@code{gnus-version}). - -@item ? -@kindex ? (Group) -@findex gnus-group-describe-briefly -Give a very short help message (@code{gnus-group-describe-briefly}). - -@item C-c C-i -@kindex C-c C-i (Group) -@cindex info -@cindex manual -@findex gnus-info-find-node -Go to the Gnus info node (@code{gnus-info-find-node}). -@end table - - -@node Group Timestamp -@subsection Group Timestamp -@cindex timestamps -@cindex group timestamps - -It can be convenient to let Gnus keep track of when you last read a -group. To set the ball rolling, you should add -@code{gnus-group-set-timestamp} to @code{gnus-select-group-hook}: - -@lisp -(add-hook 'gnus-select-group-hook 'gnus-group-set-timestamp) -@end lisp - -After doing this, each time you enter a group, it'll be recorded. - -This information can be displayed in various ways---the easiest is to -use the @samp{%d} spec in the group line format: - -@lisp -(setq gnus-group-line-format - "%M\%S\%p\%P\%5y: %(%-40,40g%) %d\n") -@end lisp - -This will result in lines looking like: - -@example -* 0: mail.ding 19961002T012943 - 0: custom 19961002T012713 -@end example - -As you can see, the date is displayed in compact ISO 8601 format. This -may be a bit too much, so to just display the date, you could say -something like: - -@lisp -(setq gnus-group-line-format - "%M\%S\%p\%P\%5y: %(%-40,40g%) %6,6~(cut 2)d\n") -@end lisp - - -@node File Commands -@subsection File Commands -@cindex file commands - -@table @kbd - -@item r -@kindex r (Group) -@findex gnus-group-read-init-file -@vindex gnus-init-file -@cindex reading init file -Re-read the init file (@code{gnus-init-file}, which defaults to -@file{~/.gnus}) (@code{gnus-group-read-init-file}). - -@item s -@kindex s (Group) -@findex gnus-group-save-newsrc -@cindex saving .newsrc -Save the @file{.newsrc.eld} file (and @file{.newsrc} if wanted) -(@code{gnus-group-save-newsrc}). If given a prefix, force saving the -file(s) whether Gnus thinks it is necessary or not. - -@c @item Z -@c @kindex Z (Group) -@c @findex gnus-group-clear-dribble -@c Clear the dribble buffer (@code{gnus-group-clear-dribble}). - -@end table - - -@node The Summary Buffer -@chapter The Summary Buffer -@cindex summary buffer - -A line for each article is displayed in the summary buffer. You can -move around, read articles, post articles and reply to articles. - -The most common way to a summary buffer is to select a group from the -group buffer (@pxref{Selecting a Group}). - -You can have as many summary buffers open as you wish. - -@menu -* Summary Buffer Format:: Deciding how the summary buffer is to look. -* Summary Maneuvering:: Moving around the summary buffer. -* Choosing Articles:: Reading articles. -* Paging the Article:: Scrolling the current article. -* Reply Followup and Post:: Posting articles. -* Canceling and Superseding:: ``Whoops, I shouldn't have called him that.'' -* Marking Articles:: Marking articles as read, expirable, etc. -* Limiting:: You can limit the summary buffer. -* Threading:: How threads are made. -* Sorting:: How articles and threads are sorted. -* Asynchronous Fetching:: Gnus might be able to pre-fetch articles. -* Article Caching:: You may store articles in a cache. -* Persistent Articles:: Making articles expiry-resistant. -* Article Backlog:: Having already read articles hang around. -* Saving Articles:: Ways of customizing article saving. -* Decoding Articles:: Gnus can treat series of (uu)encoded articles. -* Article Treatment:: The article buffer can be mangled at will. -* Article Commands:: Doing various things with the article buffer. -* Summary Sorting:: Sorting the summary buffer in various ways. -* Finding the Parent:: No child support? Get the parent. -* Alternative Approaches:: Reading using non-default summaries. -* Tree Display:: A more visual display of threads. -* Mail Group Commands:: Some commands can only be used in mail groups. -* Various Summary Stuff:: What didn't fit anywhere else. -* Exiting the Summary Buffer:: Returning to the Group buffer. -* Crosspost Handling:: How crossposted articles are dealt with. -* Duplicate Suppression:: An alternative when crosspost handling fails. -@end menu - - -@node Summary Buffer Format -@section Summary Buffer Format -@cindex summary buffer format - -@iftex -@iflatex -\gnusfigure{The Summary Buffer}{180}{ -\put(0,0){\epsfig{figure=tmp/summary.ps,width=7.5cm}} -\put(445,0){\makebox(0,0)[br]{\epsfig{figure=tmp/summary-article.ps,width=7.5cm}}} -} -@end iflatex -@end iftex - -@menu -* Summary Buffer Lines:: You can specify how summary lines should look. -* Summary Buffer Mode Line:: You can say how the mode line should look. -* Summary Highlighting:: Making the summary buffer all pretty and nice. -@end menu - -@findex mail-extract-address-components -@findex gnus-extract-address-components -@vindex gnus-extract-address-components -Gnus will use the value of the @code{gnus-extract-address-components} -variable as a function for getting the name and address parts of a -@code{From} header. Two pre-defined functions exist: -@code{gnus-extract-address-components}, which is the default, quite -fast, and too simplistic solution; and -@code{mail-extract-address-components}, which works very nicely, but is -slower. The default function will return the wrong answer in 5% of the -cases. If this is unacceptable to you, use the other function instead. - -@vindex gnus-summary-same-subject -@code{gnus-summary-same-subject} is a string indicating that the current -article has the same subject as the previous. This string will be used -with those specs that require it. The default is @code{""}. - - -@node Summary Buffer Lines -@subsection Summary Buffer Lines - -@vindex gnus-summary-line-format -You can change the format of the lines in the summary buffer by changing -the @code{gnus-summary-line-format} variable. It works along the same -lines as a normal @code{format} string, with some extensions -(@pxref{Formatting Variables}). - -The default string is @samp{%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n}. - -The following format specification characters are understood: - -@table @samp -@item N -Article number. -@item S -Subject string. -@item s -Subject if the article is the root of the thread or the previous article -had a different subject, @code{gnus-summary-same-subject} otherwise. -(@code{gnus-summary-same-subject} defaults to @code{""}.) -@item F -Full @code{From} header. -@item n -The name (from the @code{From} header). -@item a -The name (from the @code{From} header). This differs from the @code{n} -spec in that it uses the function designated by the -@code{gnus-extract-address-components} variable, which is slower, but -may be more thorough. -@item A -The address (from the @code{From} header). This works the same way as -the @code{a} spec. -@item L -Number of lines in the article. -@item c -Number of characters in the article. -@item I -Indentation based on thread level (@pxref{Customizing Threading}). -@item T -Nothing if the article is a root and lots of spaces if it isn't (it -pushes everything after it off the screen). -@item [ -Opening bracket, which is normally @samp{[}, but can also be @samp{<} -for adopted articles (@pxref{Customizing Threading}). -@item ] -Closing bracket, which is normally @samp{]}, but can also be @samp{>} -for adopted articles. -@item > -One space for each thread level. -@item < -Twenty minus thread level spaces. -@item U -Unread. -@item R -Replied. -@item i -Score as a number (@pxref{Scoring}). -@item z -@vindex gnus-summary-zcore-fuzz -Zcore, @samp{+} if above the default level and @samp{-} if below the -default level. If the difference between -@code{gnus-summary-default-level} and the score is less than -@code{gnus-summary-zcore-fuzz}, this spec will not be used. -@item V -Total thread score. -@item x -@code{Xref}. -@item D -@code{Date}. -@item d -The @code{Date} in @code{DD-MMM} format. -@item o -The @code{Date} in @var{YYYYMMDD}@code{T}@var{HHMMSS} format. -@item M -@code{Message-ID}. -@item r -@code{References}. -@item t -Number of articles in the current sub-thread. Using this spec will slow -down summary buffer generation somewhat. -@item e -An @samp{=} (@code{gnus-not-empty-thread-mark}) will be displayed if the -article has any children. -@item P -The line number. -@item O -Download mark. -@item u -User defined specifier. The next character in the format string should -be a letter. Gnus will call the function -@code{gnus-user-format-function-}@samp{X}, where @samp{X} is the letter -following @samp{%u}. The function will be passed the current header as -argument. The function should return a string, which will be inserted -into the summary just like information from any other summary specifier. -@end table - -The @samp{%U} (status), @samp{%R} (replied) and @samp{%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 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 far to the left as possible. -(Isn't that the case with everything, though? But I digress.) - -This restriction may disappear in later versions of Gnus. - - -@node Summary Buffer Mode Line -@subsection Summary Buffer Mode Line - -@vindex gnus-summary-mode-line-format -You can also change the format of the summary mode bar. Set -@code{gnus-summary-mode-line-format} to whatever you like. The default -is @samp{Gnus: %%b [%A] %Z}. - -Here are the elements you can play with: - -@table @samp -@item G -Group name. -@item p -Unprefixed group name. -@item A -Current article number. -@item V -Gnus version. -@item U -Number of unread articles in this group. -@item e -Number of unread articles in this group that aren't displayed in the -summary buffer. -@item Z -A string with the number of unread and unselected articles represented -either as @samp{<%U(+%e) more>} if there are both unread and unselected -articles, and just as @samp{<%U more>} if there are just unread articles -and no unselected ones. -@item g -Shortish group name. For instance, @samp{rec.arts.anime} will be -shortened to @samp{r.a.anime}. -@item S -Subject of the current article. -@item u -User-defined spec (@pxref{User-Defined Specs}). -@item s -Name of the current score file (@pxref{Scoring}). -@item d -Number of dormant articles (@pxref{Unread Articles}). -@item t -Number of ticked articles (@pxref{Unread Articles}). -@item r -Number of articles that have been marked as read in this session. -@item E -Number of articles expunged by the score files. -@end table - - -@node Summary Highlighting -@subsection Summary Highlighting - -@table @code - -@item gnus-visual-mark-article-hook -@vindex gnus-visual-mark-article-hook -This hook is run after selecting an article. It is meant to be used for -highlighting the article in some way. It is not run if -@code{gnus-visual} is @code{nil}. - -@item gnus-summary-update-hook -@vindex gnus-summary-update-hook -This hook is called when a summary line is changed. It is not run if -@code{gnus-visual} is @code{nil}. - -@item gnus-summary-selected-face -@vindex gnus-summary-selected-face -This is the face (or @dfn{font} as some people call it) used to -highlight the current article in the summary buffer. - -@item gnus-summary-highlight -@vindex gnus-summary-highlight -Summary lines are highlighted according to this variable, which is a -list where the elements are of the format @var{(FORM . FACE)}. If you -would, for instance, like ticked articles to be italic and high-scored -articles to be bold, you could set this variable to something like -@lisp -(((eq mark gnus-ticked-mark) . italic) - ((> score default) . bold)) -@end lisp -As you may have guessed, if @var{FORM} returns a non-@code{nil} value, -@var{FACE} will be applied to the line. -@end table - - -@node Summary Maneuvering -@section Summary Maneuvering -@cindex summary movement - -All the straight movement commands understand the numeric prefix and -behave pretty much as you'd expect. - -None of these commands select articles. - -@table @kbd -@item G M-n -@itemx M-n -@kindex M-n (Summary) -@kindex G M-n (Summary) -@findex gnus-summary-next-unread-subject -Go to the next summary line of an unread article -(@code{gnus-summary-next-unread-subject}). - -@item G M-p -@itemx M-p -@kindex M-p (Summary) -@kindex G M-p (Summary) -@findex gnus-summary-prev-unread-subject -Go to the previous summary line of an unread article -(@code{gnus-summary-prev-unread-subject}). - -@item G j -@itemx j -@kindex j (Summary) -@kindex G j (Summary) -@findex gnus-summary-goto-article -Ask for an article number or @code{Message-ID}, and then go to that -article (@code{gnus-summary-goto-article}). - -@item G g -@kindex G g (Summary) -@findex gnus-summary-goto-subject -Ask for an article number and then go to the summary line of that article -without displaying the article (@code{gnus-summary-goto-subject}). -@end table - -If Gnus asks you to press a key to confirm going to the next group, you -can use the @kbd{C-n} and @kbd{C-p} keys to move around the group -buffer, searching for the next group to read without actually returning -to the group buffer. - -Variables related to summary movement: - -@table @code - -@vindex gnus-auto-select-next -@item gnus-auto-select-next -If you issue one of the movement commands (like @kbd{n}) and there are -no more unread articles after the current one, Gnus will offer to go to -the next group. If this variable is @code{t} and the next group is -empty, Gnus will exit summary mode and return to the group buffer. If -this variable is neither @code{t} nor @code{nil}, Gnus will select the -next group, no matter whether it has any unread articles or not. As a -special case, if this variable is @code{quietly}, Gnus will select the -next group without asking for confirmation. If this variable is -@code{almost-quietly}, the same will happen only if you are located on -the last article in the group. Finally, if this variable is -@code{slightly-quietly}, the @kbd{Z n} command will go to the next group -without confirmation. Also @pxref{Group Levels}. - -@item gnus-auto-select-same -@vindex gnus-auto-select-same -If non-@code{nil}, all the movement commands will try to go to the next -article with the same subject as the current. (@dfn{Same} here might -mean @dfn{roughly equal}. See @code{gnus-summary-gather-subject-limit} -for details (@pxref{Customizing Threading}).) This variable is not -particularly useful if you use a threaded display. - -@item gnus-summary-check-current -@vindex gnus-summary-check-current -If non-@code{nil}, all the ``unread'' movement commands will not proceed -to the next (or previous) article if the current article is unread. -Instead, they will choose the current article. - -@item gnus-auto-center-summary -@vindex gnus-auto-center-summary -If non-@code{nil}, Gnus will keep the point in the summary buffer -centered at all times. This makes things quite tidy, but if you have a -slow network connection, or simply do not like this un-Emacsism, you can -set this variable to @code{nil} to get the normal Emacs scrolling -action. This will also inhibit horizontal re-centering of the summary -buffer, which might make it more inconvenient to read extremely long -threads. - -@end table - - -@node Choosing Articles -@section Choosing Articles -@cindex selecting articles - -@menu -* Choosing Commands:: Commands for choosing articles. -* Choosing Variables:: Variables that influence these commands. -@end menu - - -@node Choosing Commands -@subsection Choosing Commands - -None of the following movement commands understand the numeric prefix, -and they all select and display an article. - -@table @kbd -@item SPACE -@kindex SPACE (Summary) -@findex gnus-summary-next-page -Select the current article, or, if that one's read already, the next -unread article (@code{gnus-summary-next-page}). - -@item G n -@itemx n -@kindex n (Summary) -@kindex G n (Summary) -@findex gnus-summary-next-unread-article -@c @icon{gnus-summary-next-unread} -Go to next unread article (@code{gnus-summary-next-unread-article}). - -@item G p -@itemx p -@kindex p (Summary) -@findex gnus-summary-prev-unread-article -@c @icon{gnus-summary-prev-unread} -Go to previous unread article (@code{gnus-summary-prev-unread-article}). - -@item G N -@itemx N -@kindex N (Summary) -@kindex G N (Summary) -@findex gnus-summary-next-article -Go to the next article (@code{gnus-summary-next-article}). - -@item G P -@itemx P -@kindex P (Summary) -@kindex G P (Summary) -@findex gnus-summary-prev-article -Go to the previous article (@code{gnus-summary-prev-article}). - -@item G C-n -@kindex G C-n (Summary) -@findex gnus-summary-next-same-subject -Go to the next article with the same subject -(@code{gnus-summary-next-same-subject}). - -@item G C-p -@kindex G C-p (Summary) -@findex gnus-summary-prev-same-subject -Go to the previous article with the same subject -(@code{gnus-summary-prev-same-subject}). - -@item G f -@itemx . -@kindex G f (Summary) -@kindex . (Summary) -@findex gnus-summary-first-unread-article -Go to the first unread article -(@code{gnus-summary-first-unread-article}). - -@item G b -@itemx , -@kindex G b (Summary) -@kindex , (Summary) -@findex gnus-summary-best-unread-article -Go to the article with the highest score -(@code{gnus-summary-best-unread-article}). - -@item G l -@itemx l -@kindex l (Summary) -@kindex G l (Summary) -@findex gnus-summary-goto-last-article -Go to the previous article read (@code{gnus-summary-goto-last-article}). - -@item G o -@kindex G o (Summary) -@findex gnus-summary-pop-article -@cindex history -@cindex article history -Pop an article off the summary history and go to this article -(@code{gnus-summary-pop-article}). This command differs from the -command above in that you can pop as many previous articles off the -history as you like, while @kbd{l} toggles the two last read articles. -For a somewhat related issue (if you use these commands a lot), -@pxref{Article Backlog}. -@end table - - -@node Choosing Variables -@subsection Choosing Variables - -Some variables relevant for moving and selecting articles: - -@table @code -@item gnus-auto-extend-newsgroup -@vindex gnus-auto-extend-newsgroup -All the movement commands will try to go to the previous (or next) -article, even if that article isn't displayed in the Summary buffer if -this variable is non-@code{nil}. Gnus will then fetch the article from -the server and display it in the article buffer. - -@item gnus-select-article-hook -@vindex gnus-select-article-hook -This hook is called whenever an article is selected. By default it -exposes any threads hidden under the selected article. - -@item gnus-mark-article-hook -@vindex gnus-mark-article-hook -@findex gnus-summary-mark-unread-as-read -@findex gnus-summary-mark-read-and-unread-as-read -@findex gnus-unread-mark -This hook is called whenever an article is selected. It is intended to -be used for marking articles as read. The default value is -@code{gnus-summary-mark-read-and-unread-as-read}, and will change the -mark of almost any article you read to @code{gnus-unread-mark}. The -only articles not affected by this function are ticked, dormant, and -expirable articles. If you'd instead like to just have unread articles -marked as read, you can use @code{gnus-summary-mark-unread-as-read} -instead. It will leave marks like @code{gnus-low-score-mark}, -@code{gnus-del-mark} (and so on) alone. - -@end table - - -@node Paging the Article -@section Scrolling the Article -@cindex article scrolling - -@table @kbd - -@item SPACE -@kindex SPACE (Summary) -@findex gnus-summary-next-page -Pressing @kbd{SPACE} will scroll the current article forward one page, -or, if you have come to the end of the current article, will choose the -next article (@code{gnus-summary-next-page}). - -@item DEL -@kindex DEL (Summary) -@findex gnus-summary-prev-page -Scroll the current article back one page (@code{gnus-summary-prev-page}). - -@item RET -@kindex RET (Summary) -@findex gnus-summary-scroll-up -Scroll the current article one line forward -(@code{gnus-summary-scroll-up}). - -@item A g -@itemx g -@kindex A g (Summary) -@kindex g (Summary) -@findex gnus-summary-show-article -(Re)fetch the current article (@code{gnus-summary-show-article}). If -given a prefix, fetch the current article, but don't run any of the -article treatment functions. This will give you a ``raw'' article, just -the way it came from the server. - -@item A < -@itemx < -@kindex < (Summary) -@kindex A < (Summary) -@findex gnus-summary-beginning-of-article -Scroll to the beginning of the article -(@code{gnus-summary-beginning-of-article}). - -@item A > -@itemx > -@kindex > (Summary) -@kindex A > (Summary) -@findex gnus-summary-end-of-article -Scroll to the end of the article (@code{gnus-summary-end-of-article}). - -@item A s -@itemx s -@kindex A s (Summary) -@kindex s (Summary) -@findex gnus-summary-isearch-article -Perform an isearch in the article buffer -(@code{gnus-summary-isearch-article}). - -@item h -@kindex h (Summary) -@findex gnus-summary-select-article-buffer -Select the article buffer (@code{gnus-summary-select-article-buffer}). - -@end table - - -@node Reply Followup and Post -@section Reply, Followup and Post - -@menu -* Summary Mail Commands:: Sending mail. -* Summary Post Commands:: Sending news. -@end menu - - -@node Summary Mail Commands -@subsection Summary Mail Commands -@cindex mail -@cindex composing mail - -Commands for composing a mail message: - -@table @kbd - -@item S r -@itemx r -@kindex S r (Summary) -@kindex r (Summary) -@findex gnus-summary-reply -@c @icon{gnus-summary-mail-reply} -@c @icon{gnus-summary-reply} -Mail a reply to the author of the current article -(@code{gnus-summary-reply}). - -@item S R -@itemx R -@kindex R (Summary) -@kindex S R (Summary) -@findex gnus-summary-reply-with-original -@c @icon{gnus-summary-reply-with-original} -Mail a reply to the author of the current article and include the -original message (@code{gnus-summary-reply-with-original}). This -command uses the process/prefix convention. - -@item S w -@kindex S w (Summary) -@findex gnus-summary-wide-reply -Mail a wide reply to the author of the current article -(@code{gnus-summary-wide-reply}). A @dfn{wide reply} is a reply that -goes out to all people listed in the @code{To}, @code{From} (or -@code{Reply-to}) and @code{Cc} headers. - -@item S W -@kindex S W (Summary) -@findex gnus-summary-wide-reply-with-original -Mail a wide reply to the current article and include the original -message (@code{gnus-summary-reply-with-original}). This command uses -the process/prefix convention. - -@item S o m -@kindex S o m (Summary) -@findex gnus-summary-mail-forward -@c @icon{gnus-summary-mail-forward} -Forward the current article to some other person -(@code{gnus-summary-mail-forward}). If given a prefix, include the full -headers of the forwarded article. - -@item S m -@itemx m -@kindex m (Summary) -@kindex S m (Summary) -@findex gnus-summary-mail-other-window -@c @icon{gnus-summary-mail-originate} -Send a mail to some other person -(@code{gnus-summary-mail-other-window}). - -@item S D b -@kindex S D b (Summary) -@findex gnus-summary-resend-bounced-mail -@cindex bouncing mail -If you have sent a mail, but the mail was bounced back to you for some -reason (wrong address, transient failure), you can use this command to -resend that bounced mail (@code{gnus-summary-resend-bounced-mail}). You -will be popped into a mail buffer where you can edit the headers before -sending the mail off again. If you give a prefix to this command, and -the bounced mail is a reply to some other mail, Gnus will try to fetch -that mail and display it for easy perusal of its headers. This might -very well fail, though. - -@item S D r -@kindex S D r (Summary) -@findex gnus-summary-resend-message -Not to be confused with the previous command, -@code{gnus-summary-resend-message} will prompt you for an address to -send the current message off to, and then send it to that place. The -headers of the message won't be altered---but lots of headers that say -@code{Resent-To}, @code{Resent-From} and so on will be added. This -means that you actually send a mail to someone that has a @code{To} -header that (probably) points to yourself. This will confuse people. -So, natcherly you'll only do that if you're really eVIl. - -This command is mainly used if you have several accounts and want to -ship a mail to a different account of yours. (If you're both -@code{root} and @code{postmaster} and get a mail for @code{postmaster} -to the @code{root} account, you may want to resend it to -@code{postmaster}. Ordnung muß sein! - -This command understands the process/prefix convention -(@pxref{Process/Prefix}). - -@item S O m -@kindex S O m (Summary) -@findex gnus-uu-digest-mail-forward -Digest the current series (@pxref{Decoding Articles}) and forward the -result using mail (@code{gnus-uu-digest-mail-forward}). This command -uses the process/prefix convention (@pxref{Process/Prefix}). - -@item S M-c -@kindex S M-c (Summary) -@findex gnus-summary-mail-crosspost-complaint -@cindex crossposting -@cindex excessive crossposting -Send a complaint about excessive crossposting to the author of the -current article (@code{gnus-summary-mail-crosspost-complaint}). - -@findex gnus-crosspost-complaint -This command is provided as a way to fight back agains the current -crossposting pandemic that's sweeping Usenet. It will compose a reply -using the @code{gnus-crosspost-complaint} variable as a preamble. This -command understands the process/prefix convention -(@pxref{Process/Prefix}) and will prompt you before sending each mail. - -@end table - - -@node Summary Post Commands -@subsection Summary Post Commands -@cindex post -@cindex composing news - -Commands for posting a news article: - -@table @kbd -@item S p -@itemx a -@kindex a (Summary) -@kindex S p (Summary) -@findex gnus-summary-post-news -@c @icon{gnus-summary-post-news} -Post an article to the current group -(@code{gnus-summary-post-news}). - -@item S f -@itemx f -@kindex f (Summary) -@kindex S f (Summary) -@findex gnus-summary-followup -@c @icon{gnus-summary-followup} -Post a followup to the current article (@code{gnus-summary-followup}). - -@item S F -@itemx F -@kindex S F (Summary) -@kindex F (Summary) -@c @icon{gnus-summary-followup-with-original} -@findex gnus-summary-followup-with-original -Post a followup to the current article and include the original message -(@code{gnus-summary-followup-with-original}). This command uses the -process/prefix convention. - -@item S n -@kindex S n (Summary) -@findex gnus-summary-followup-to-mail -Post a followup to the current article via news, even if you got the -message through mail (@code{gnus-summary-followup-to-mail}). - -@item S n -@kindex S n (Summary) -@findex gnus-summary-followup-to-mail -Post a followup to the current article via news, even if you got the -message through mail and include the original message -(@code{gnus-summary-followup-to-mail-with-original}). This command uses -the process/prefix convention. - -@item S o p -@kindex S o p (Summary) -@findex gnus-summary-post-forward -Forward the current article to a newsgroup -(@code{gnus-summary-post-forward}). If given a prefix, include the full -headers of the forwarded article. - -@item S O p -@kindex S O p (Summary) -@findex gnus-uu-digest-post-forward -@cindex digests -@cindex making digests -Digest the current series and forward the result to a newsgroup -(@code{gnus-uu-digest-mail-forward}). This command uses the -process/prefix convention. - -@item S u -@kindex S u (Summary) -@findex gnus-uu-post-news -@c @icon{gnus-uu-post-news} -Uuencode a file, split it into parts, and post it as a series -(@code{gnus-uu-post-news}). (@pxref{Uuencoding and Posting}). -@end table - - -@node Canceling and Superseding -@section Canceling Articles -@cindex canceling articles -@cindex superseding articles - -Have you ever written something, and then decided that you really, -really, really wish you hadn't posted that? - -Well, you can't cancel mail, but you can cancel posts. - -@findex gnus-summary-cancel-article -@kindex C (Summary) -@c @icon{gnus-summary-cancel-article} -Find the article you wish to cancel (you can only cancel your own -articles, so don't try any funny stuff). Then press @kbd{C} or @kbd{S -c} (@code{gnus-summary-cancel-article}). Your article will be -canceled---machines all over the world will be deleting your article. -This command uses the process/prefix convention (@pxref{Process/Prefix}). - -Be aware, however, that not all sites honor cancels, so your article may -live on here and there, while most sites will delete the article in -question. - -Gnus will use the ``current'' select method when cancelling. If you -want to use the standard posting method, use the @samp{a} symbolic -prefix (@pxref{Symbolic Prefixes}). - -If you discover that you have made some mistakes and want to do some -corrections, you can post a @dfn{superseding} article that will replace -your original article. - -@findex gnus-summary-supersede-article -@kindex S (Summary) -Go to the original article and press @kbd{S s} -(@code{gnus-summary-supersede-article}). You will be put in a buffer -where you can edit the article all you want before sending it off the -usual way. - -The same goes for superseding as for canceling, only more so: Some -sites do not honor superseding. On those sites, it will appear that you -have posted almost the same article twice. - -If you have just posted the article, and change your mind right away, -there is a trick you can use to cancel/supersede the article without -waiting for the article to appear on your site first. You simply return -to the post buffer (which is called @code{*sent ...*}). There you will -find the article you just posted, with all the headers intact. Change -the @code{Message-ID} header to a @code{Cancel} or @code{Supersedes} -header by substituting one of those words for the word -@code{Message-ID}. Then just press @kbd{C-c C-c} to send the article as -you would do normally. The previous article will be -canceled/superseded. - -Just remember, kids: There is no 'c' in 'supersede'. - - -@node Marking Articles -@section Marking Articles -@cindex article marking -@cindex article ticking -@cindex marks - -There are several marks you can set on an article. - -You have marks that decide the @dfn{readedness} (whoo, neato-keano -neologism ohoy!) of the article. Alphabetic marks generally mean -@dfn{read}, while non-alphabetic characters generally mean @dfn{unread}. - -In addition, you also have marks that do not affect readedness. - -@menu -* Unread Articles:: Marks for unread articles. -* Read Articles:: Marks for read articles. -* Other Marks:: Marks that do not affect readedness. -@end menu - -@ifinfo -There's a plethora of commands for manipulating these marks: -@end ifinfo - -@menu -* Setting Marks:: How to set and remove marks. -* Setting Process Marks:: How to mark articles for later processing. -@end menu - - -@node Unread Articles -@subsection Unread Articles - -The following marks mark articles as (kinda) unread, in one form or -other. - -@table @samp -@item ! -@vindex gnus-ticked-mark -Marked as ticked (@code{gnus-ticked-mark}). - -@dfn{Ticked articles} are articles that will remain visible always. If -you see an article that you find interesting, or you want to put off -reading it, or replying to it, until sometime later, you'd typically -tick it. However, articles can be expired, so if you want to keep an -article forever, you'll have to make it persistent (@pxref{Persistent -Articles}). - -@item ? -@vindex gnus-dormant-mark -Marked as dormant (@code{gnus-dormant-mark}). - -@dfn{Dormant articles} will only appear in the summary buffer if there -are followups to it. If you want to see them even if they don't have -followups, you can use the @kbd{/ D} command (@pxref{Limiting}). - -@item SPACE -@vindex gnus-unread-mark -Markes as unread (@code{gnus-unread-mark}). - -@dfn{Unread articles} are articles that haven't been read at all yet. -@end table - - -@node Read Articles -@subsection Read Articles -@cindex expirable mark - -All the following marks mark articles as read. - -@table @samp - -@item r -@vindex gnus-del-mark -These are articles that the user has marked as read with the @kbd{d} -command manually, more or less (@code{gnus-del-mark}). - -@item R -@vindex gnus-read-mark -Articles that have actually been read (@code{gnus-read-mark}). - -@item O -@vindex gnus-ancient-mark -Articles that were marked as read in previous sessions and are now -@dfn{old} (@code{gnus-ancient-mark}). - -@item K -@vindex gnus-killed-mark -Marked as killed (@code{gnus-killed-mark}). - -@item X -@vindex gnus-kill-file-mark -Marked as killed by kill files (@code{gnus-kill-file-mark}). - -@item Y -@vindex gnus-low-score-mark -Marked as read by having too low a score (@code{gnus-low-score-mark}). - -@item C -@vindex gnus-catchup-mark -Marked as read by a catchup (@code{gnus-catchup-mark}). - -@item G -@vindex gnus-canceled-mark -Canceled article (@code{gnus-canceled-mark}) - -@item F -@vindex gnus-souped-mark -@sc{SOUP}ed article (@code{gnus-souped-mark}). @xref{SOUP}. - -@item Q -@vindex gnus-sparse-mark -Sparsely reffed article (@code{gnus-sparse-mark}). @xref{Customizing -Threading}. - -@item M -@vindex gnus-duplicate-mark -Article marked as read by duplicate suppression -(@code{gnus-duplicated-mark}). @xref{Duplicate Suppression}. - -@end table - -All these marks just mean that the article is marked as read, really. -They are interpreted differently when doing adaptive scoring, though. - -One more special mark, though: - -@table @samp -@item E -@vindex gnus-expirable-mark -Marked as expirable (@code{gnus-expirable-mark}). - -Marking articles as @dfn{expirable} (or have them marked as such -automatically) doesn't make much sense in normal groups---a user doesn't -control expiring of news articles, but in mail groups, for instance, -articles marked as @dfn{expirable} can be deleted by Gnus at -any time. -@end table - - -@node Other Marks -@subsection Other Marks -@cindex process mark -@cindex bookmarks - -There are some marks that have nothing to do with whether the article is -read or not. - -@itemize @bullet - -@item -You can set a bookmark in the current article. Say you are reading a -long thesis on cats' urinary tracts, and have to go home for dinner -before you've finished reading the thesis. You can then set a bookmark -in the article, and Gnus will jump to this bookmark the next time it -encounters the article. @xref{Setting Marks} - -@item -@vindex gnus-replied-mark -All articles that you have replied to or made a followup to (i.e., have -answered) will be marked with an @samp{A} in the second column -(@code{gnus-replied-mark}). - -@item -@vindex gnus-cached-mark -Articles stored in the article cache will be marked with an @samp{*} in -the second column (@code{gnus-cached-mark}). @xref{Article Caching} - -@item -@vindex gnus-saved-mark -Articles ``saved'' (in some manner or other; not necessarily -religiously) are marked with an @samp{S} in the second column -(@code{gnus-saved-mark}). - -@item -@vindex gnus-not-empty-thread-mark -@vindex gnus-empty-thread-mark -If the @samp{%e} spec is used, the presence of threads or not will be -marked with @code{gnus-not-empty-thread-mark} and -@code{gnus-empty-thread-mark} in the third column, respectively. - -@item -@vindex gnus-process-mark -Finally we have the @dfn{process mark} (@code{gnus-process-mark}). A -variety of commands react to the presence of the process mark. For -instance, @kbd{X u} (@code{gnus-uu-decode-uu}) will uudecode and view -all articles that have been marked with the process mark. Articles -marked with the process mark have a @samp{#} in the second column. - -@end itemize - -You might have noticed that most of these ``non-readedness'' marks -appear in the second column by default. So if you have a cached, saved, -replied article that you have process-marked, what will that look like? - -Nothing much. The precedence rules go as follows: process -> cache -> -replied -> saved. So if the article is in the cache and is replied, -you'll only see the cache mark and not the replied mark. - - -@node Setting Marks -@subsection Setting Marks -@cindex setting marks - -All the marking commands understand the numeric prefix. - -@table @kbd -@item M c -@itemx M-u -@kindex M c (Summary) -@kindex M-u (Summary) -@findex gnus-summary-clear-mark-forward -@cindex mark as unread -Clear all readedness-marks from the current article -(@code{gnus-summary-clear-mark-forward}). In other words, mark the -article as unread. - -@item M t -@itemx ! -@kindex ! (Summary) -@kindex M t (Summary) -@findex gnus-summary-tick-article-forward -Tick the current article (@code{gnus-summary-tick-article-forward}). -@xref{Article Caching} - -@item M ? -@itemx ? -@kindex ? (Summary) -@kindex M ? (Summary) -@findex gnus-summary-mark-as-dormant -Mark the current article as dormant -(@code{gnus-summary-mark-as-dormant}). @xref{Article Caching} - -@item M d -@itemx d -@kindex M d (Summary) -@kindex d (Summary) -@findex gnus-summary-mark-as-read-forward -Mark the current article as read -(@code{gnus-summary-mark-as-read-forward}). - -@item D -@kindex D (Summary) -@findex gnus-summary-mark-as-read-backward -Mark the current article as read and move point to the previous line -(@code{gnus-summary-mark-as-read-backward}). - -@item M k -@itemx k -@kindex k (Summary) -@kindex M k (Summary) -@findex gnus-summary-kill-same-subject-and-select -Mark all articles that have the same subject as the current one as read, -and then select the next unread article -(@code{gnus-summary-kill-same-subject-and-select}). - -@item M K -@itemx C-k -@kindex M K (Summary) -@kindex C-k (Summary) -@findex gnus-summary-kill-same-subject -Mark all articles that have the same subject as the current one as read -(@code{gnus-summary-kill-same-subject}). - -@item M C -@kindex M C (Summary) -@findex gnus-summary-catchup -@c @icon{gnus-summary-catchup} -Mark all unread articles as read (@code{gnus-summary-catchup}). - -@item M C-c -@kindex M C-c (Summary) -@findex gnus-summary-catchup-all -Mark all articles in the group as read---even the ticked and dormant -articles (@code{gnus-summary-catchup-all}). - -@item M H -@kindex M H (Summary) -@findex gnus-summary-catchup-to-here -Catchup the current group to point -(@code{gnus-summary-catchup-to-here}). - -@item C-w -@kindex C-w (Summary) -@findex gnus-summary-mark-region-as-read -Mark all articles between point and mark as read -(@code{gnus-summary-mark-region-as-read}). - -@item M V k -@kindex M V k (Summary) -@findex gnus-summary-kill-below -Kill all articles with scores below the default score (or below the -numeric prefix) (@code{gnus-summary-kill-below}). - -@item M e -@itemx E -@kindex M e (Summary) -@kindex E (Summary) -@findex gnus-summary-mark-as-expirable -Mark the current article as expirable -(@code{gnus-summary-mark-as-expirable}). - -@item M b -@kindex M b (Summary) -@findex gnus-summary-set-bookmark -Set a bookmark in the current article -(@code{gnus-summary-set-bookmark}). - -@item M B -@kindex M B (Summary) -@findex gnus-summary-remove-bookmark -Remove the bookmark from the current article -(@code{gnus-summary-remove-bookmark}). - -@item M V c -@kindex M V c (Summary) -@findex gnus-summary-clear-above -Clear all marks from articles with scores over the default score (or -over the numeric prefix) (@code{gnus-summary-clear-above}). - -@item M V u -@kindex M V u (Summary) -@findex gnus-summary-tick-above -Tick all articles with scores over the default score (or over the -numeric prefix) (@code{gnus-summary-tick-above}). - -@item M V m -@kindex M V m (Summary) -@findex gnus-summary-mark-above -Prompt for a mark, and mark all articles with scores over the default -score (or over the numeric prefix) with this mark -(@code{gnus-summary-clear-above}). -@end table - -@vindex gnus-summary-goto-unread -The @code{gnus-summary-goto-unread} variable controls what action should -be taken after setting a mark. If non-@code{nil}, point will move to -the next/previous unread article. If @code{nil}, point will just move -one line up or down. As a special case, if this variable is -@code{never}, all the marking commands as well as other commands (like -@kbd{SPACE}) will move to the next article, whether it is unread or not. -The default is @code{t}. - - -@node Setting Process Marks -@subsection Setting Process Marks -@cindex setting process marks - -@table @kbd - -@item M P p -@itemx # -@kindex # (Summary) -@kindex M P p (Summary) -@findex gnus-summary-mark-as-processable -Mark the current article with the process mark -(@code{gnus-summary-mark-as-processable}). -@findex gnus-summary-unmark-as-processable - -@item M P u -@itemx M-# -@kindex M P u (Summary) -@kindex M-# (Summary) -Remove the process mark, if any, from the current article -(@code{gnus-summary-unmark-as-processable}). - -@item M P U -@kindex M P U (Summary) -@findex gnus-summary-unmark-all-processable -Remove the process mark from all articles -(@code{gnus-summary-unmark-all-processable}). - -@item M P i -@kindex M P i (Summary) -@findex gnus-uu-invert-processable -Invert the list of process marked articles -(@code{gnus-uu-invert-processable}). - -@item M P R -@kindex M P R (Summary) -@findex gnus-uu-mark-by-regexp -Mark articles by a regular expression (@code{gnus-uu-mark-by-regexp}). - -@item M P r -@kindex M P r (Summary) -@findex gnus-uu-mark-region -Mark articles in region (@code{gnus-uu-mark-region}). - -@item M P t -@kindex M P t (Summary) -@findex gnus-uu-mark-thread -Mark all articles in the current (sub)thread -(@code{gnus-uu-mark-thread}). - -@item M P T -@kindex M P T (Summary) -@findex gnus-uu-unmark-thread -Unmark all articles in the current (sub)thread -(@code{gnus-uu-unmark-thread}). - -@item M P v -@kindex M P v (Summary) -@findex gnus-uu-mark-over -Mark all articles that have a score above the prefix argument -(@code{gnus-uu-mark-over}). - -@item M P s -@kindex M P s (Summary) -@findex gnus-uu-mark-series -Mark all articles in the current series (@code{gnus-uu-mark-series}). - -@item M P S -@kindex M P S (Summary) -@findex gnus-uu-mark-sparse -Mark all series that have already had some articles marked -(@code{gnus-uu-mark-sparse}). - -@item M P a -@kindex M P a (Summary) -@findex gnus-uu-mark-all -Mark all articles in series order (@code{gnus-uu-mark-series}). - -@item M P b -@kindex M P b (Summary) -@findex gnus-uu-mark-buffer -Mark all articles in the buffer in the order they appear -(@code{gnus-uu-mark-buffer}). - -@item M P k -@kindex M P k (Summary) -@findex gnus-summary-kill-process-mark -Push the current process mark set onto the stack and unmark all articles -(@code{gnus-summary-kill-process-mark}). - -@item M P y -@kindex M P y (Summary) -@findex gnus-summary-yank-process-mark -Pop the previous process mark set from the stack and restore it -(@code{gnus-summary-yank-process-mark}). - -@item M P w -@kindex M P w (Summary) -@findex gnus-summary-save-process-mark -Push the current process mark set onto the stack -(@code{gnus-summary-save-process-mark}). - -@end table - - -@node Limiting -@section Limiting -@cindex limiting - -It can be convenient to limit the summary buffer to just show some -subset of the articles currently in the group. The effect most limit -commands have is to remove a few (or many) articles from the summary -buffer. - -All limiting commands work on subsets of the articles already fetched -from the servers. None of these commands query the server for -additional articles. - -@table @kbd - -@item / / -@itemx / s -@kindex / / (Summary) -@findex gnus-summary-limit-to-subject -Limit the summary buffer to articles that match some subject -(@code{gnus-summary-limit-to-subject}). - -@item / a -@kindex / a (Summary) -@findex gnus-summary-limit-to-author -Limit the summary buffer to articles that match some author -(@code{gnus-summary-limit-to-author}). - -@item / u -@itemx x -@kindex / u (Summary) -@kindex x (Summary) -@findex gnus-summary-limit-to-unread -Limit the summary buffer to articles not marked as read -(@code{gnus-summary-limit-to-unread}). If given a prefix, limit the -buffer to articles strictly unread. This means that ticked and -dormant articles will also be excluded. - -@item / m -@kindex / m (Summary) -@findex gnus-summary-limit-to-marks -Ask for a mark and then limit to all articles that have not been marked -with that mark (@code{gnus-summary-limit-to-marks}). - -@item / t -@kindex / t (Summary) -@findex gnus-summary-limit-to-age -Ask for a number and then limit the summary buffer to articles older than (or equal to) that number of days -(@code{gnus-summary-limit-to-marks}). If given a prefix, limit to -articles younger than that number of days. - -@item / n -@kindex / n (Summary) -@findex gnus-summary-limit-to-articles -Limit the summary buffer to the current article -(@code{gnus-summary-limit-to-articles}). Uses the process/prefix -convention (@pxref{Process/Prefix}). - -@item / w -@kindex / w (Summary) -@findex gnus-summary-pop-limit -Pop the previous limit off the stack and restore it -(@code{gnus-summary-pop-limit}). If given a prefix, pop all limits off -the stack. - -@item / v -@kindex / v (Summary) -@findex gnus-summary-limit-to-score -Limit the summary buffer to articles that have a score at or above some -score (@code{gnus-summary-limit-to-score}). - -@item / E -@itemx M S -@kindex M S (Summary) -@kindex / E (Summary) -@findex gnus-summary-limit-include-expunged -Display all expunged articles -(@code{gnus-summary-limit-include-expunged}). - -@item / D -@kindex / D (Summary) -@findex gnus-summary-limit-include-dormant -Display all dormant articles (@code{gnus-summary-limit-include-dormant}). - -@item / d -@kindex / d (Summary) -@findex gnus-summary-limit-exclude-dormant -Hide all dormant articles (@code{gnus-summary-limit-exclude-dormant}). - -@item / T -@kindex / T (Summary) -@findex gnus-summary-limit-include-thread -Include all the articles in the current thread. - -@item / c -@kindex / c (Summary) -@findex gnus-summary-limit-exclude-childless-dormant -Hide all dormant articles that have no children -(@code{gnus-summary-limit-exclude-childless-dormant}). - -@item / C -@kindex / C (Summary) -@findex gnus-summary-limit-mark-excluded-as-read -Mark all excluded unread articles as read -(@code{gnus-summary-limit-mark-excluded-as-read}). If given a prefix, -also mark excluded ticked and dormant articles as read. - -@end table - - -@node Threading -@section Threading -@cindex threading -@cindex article threading - -Gnus threads articles by default. @dfn{To thread} is to put responses -to articles directly after the articles they respond to---in a -hierarchical fashion. - -Threading is done by looking at the @code{References} headers of the -articles. In a perfect world, this would be enough to build pretty -trees, but unfortunately, the @code{References} header is often broken -or simply missing. Weird news propagration excarcerbates the problem, -so one has to employ other heuristics to get pleasing results. A -plethora of approaches exists, as detailed in horrible detail in -@pxref{Customizing Threading}. - -First, a quick overview of the concepts: - -@table @dfn -@item root -The top-most article in a thread; the first article in the thread. - -@item thread -A tree-like article structure. - -@item sub-thread -A small(er) section of this tree-like structure. - -@item loose threads -Threads often lose their roots due to article expiry, or due to the root -already having been read in a previous session, and not displayed in the -summary buffer. We then typicall have many sub-threads that really -belong to one thread, but are without connecting roots. These are -called loose threads. - -@item thread gathering -An attempt to gather loose threads into bigger threads. - -@item sparse threads -A thread where the missing articles have been ``guessed'' at, and are -displayed as empty lines in the summary buffer. - -@end table - - -@menu -* Customizing Threading:: Variables you can change to affect the threading. -* Thread Commands:: Thread based commands in the summary buffer. -@end menu - - -@node Customizing Threading -@subsection Customizing Threading -@cindex customizing threading - -@menu -* Loose Threads:: How Gnus gathers loose threads into bigger threads. -* Filling In Threads:: Making the threads displayed look fuller. -* More Threading:: Even more variables for fiddling with threads. -* Low-Level Threading:: You thought it was over... but you were wrong! -@end menu - - -@node Loose Threads -@subsubsection Loose Threads -@cindex < -@cindex > -@cindex loose threads - -@table @code -@item gnus-summary-make-false-root -@vindex gnus-summary-make-false-root -If non-@code{nil}, Gnus will gather all loose subtrees into one big tree -and create a dummy root at the top. (Wait a minute. Root at the top? -Yup.) Loose subtrees occur when the real root has expired, or you've -read or killed the root in a previous session. - -When there is no real root of a thread, Gnus will have to fudge -something. This variable says what fudging method Gnus should use. -There are four possible values: - -@iftex -@iflatex -\gnusfigure{The Summary Buffer}{390}{ -\put(0,0){\epsfig{figure=tmp/summary-adopt.ps,width=7.5cm}} -\put(445,0){\makebox(0,0)[br]{\epsfig{figure=tmp/summary-empty.ps,width=7.5cm}}} -\put(0,400){\makebox(0,0)[tl]{\epsfig{figure=tmp/summary-none.ps,width=7.5cm}}} -\put(445,400){\makebox(0,0)[tr]{\epsfig{figure=tmp/summary-dummy.ps,width=7.5cm}}} -} -@end iflatex -@end iftex - -@cindex adopting articles - -@table @code - -@item adopt -Gnus will make the first of the orphaned articles the parent. This -parent will adopt all the other articles. The adopted articles will be -marked as such by pointy brackets (@samp{<>}) instead of the standard -square brackets (@samp{[]}). This is the default method. - -@item dummy -@vindex gnus-summary-dummy-line-format -Gnus will create a dummy summary line that will pretend to be the -parent. This dummy line does not correspond to any real article, so -selecting it will just select the first real article after the dummy -article. @code{gnus-summary-dummy-line-format} is used to specify the -format of the dummy roots. It accepts only one format spec: @samp{S}, -which is the subject of the article. @xref{Formatting Variables}. - -@item empty -Gnus won't actually make any article the parent, but simply leave the -subject field of all orphans except the first empty. (Actually, it will -use @code{gnus-summary-same-subject} as the subject (@pxref{Summary -Buffer Format}).) - -@item none -Don't make any article parent at all. Just gather the threads and -display them after one another. - -@item nil -Don't gather loose threads. -@end table - -@item gnus-summary-gather-subject-limit -@vindex gnus-summary-gather-subject-limit -Loose threads are gathered by comparing subjects of articles. If this -variable is @code{nil}, Gnus requires an exact match between the -subjects of the loose threads before gathering them into one big -super-thread. This might be too strict a requirement, what with the -presence of stupid newsreaders that chop off long subject lines. If -you think so, set this variable to, say, 20 to require that only the -first 20 characters of the subjects have to match. If you set this -variable to a really low number, you'll find that Gnus will gather -everything in sight into one thread, which isn't very helpful. - -@cindex fuzzy article gathering -If you set this variable to the special value @code{fuzzy}, Gnus will -use a fuzzy string comparison algorithm on the subjects (@pxref{Fuzzy -Matching}). - -@item gnus-simplify-subject-fuzzy-regexp -@vindex gnus-simplify-subject-fuzzy-regexp -This can either be a regular expression or list of regular expressions -that match strings that will be removed from subjects if fuzzy subject -simplification is used. - -@item gnus-simplify-ignored-prefixes -@vindex gnus-simplify-ignored-prefixes -If you set @code{gnus-summary-gather-subject-limit} to something as low -as 10, you might consider setting this variable to something sensible: - -@c Written by Michael Ernst -@lisp -(setq gnus-simplify-ignored-prefixes - (concat - "\\`\\[?\\(" - (mapconcat - 'identity - '("looking" - "wanted" "followup" "summary\\( of\\)?" - "help" "query" "problem" "question" - "answer" "reference" "announce" - "How can I" "How to" "Comparison of" - ;; ... - ) - "\\|") - "\\)\\s *\\(" - (mapconcat 'identity - '("for" "for reference" "with" "about") - "\\|") - "\\)?\\]?:?[ \t]*")) -@end lisp - -All words that match this regexp will be removed before comparing two -subjects. - -@item gnus-simplify-subject-functions -@vindex gnus-simplify-subject-functions -If non-@code{nil}, this variable overrides -@code{gnus-summary-gather-subject-limit}. This variable should be a -list of functions to apply to the @code{Subject} string iteratively to -arrive at the simplified version of the string. - -Useful functions to put in this list include: - -@table @code -@item gnus-simplify-subject-re -@findex gnus-simplify-subject-re -Strip the leading @samp{Re:}. - -@item gnus-simplify-subject-fuzzy -@findex gnus-simplify-subject-fuzzy -Simplify fuzzily. - -@item gnus-simplify-whitespace -@findex gnus-simplify-whitespace -Remove excessive whitespace. -@end table - -You may also write your own functions, of course. - - -@item gnus-summary-gather-exclude-subject -@vindex gnus-summary-gather-exclude-subject -Since loose thread gathering is done on subjects only, that might lead -to many false hits, especially with certain common subjects like -@samp{} and @samp{(none)}. To make the situation slightly better, -you can use the regexp @code{gnus-summary-gather-exclude-subject} to say -what subjects should be excluded from the gathering process.@* -The default is @samp{^ *$\\|^(none)$}. - -@item gnus-summary-thread-gathering-function -@vindex gnus-summary-thread-gathering-function -Gnus gathers threads by looking at @code{Subject} headers. This means -that totally unrelated articles may end up in the same ``thread'', which -is confusing. An alternate approach is to look at all the -@code{Message-ID}s in all the @code{References} headers to find matches. -This will ensure that no gathered threads ever include unrelated -articles, but it also means that people who have posted with broken -newsreaders won't be gathered properly. The choice is yours---plague or -cholera: - -@table @code -@item gnus-gather-threads-by-subject -@findex gnus-gather-threads-by-subject -This function is the default gathering function and looks at -@code{Subject}s exclusively. - -@item gnus-gather-threads-by-references -@findex gnus-gather-threads-by-references -This function looks at @code{References} headers exclusively. -@end table - -If you want to test gathering by @code{References}, you could say -something like: - -@lisp -(setq gnus-summary-thread-gathering-function - 'gnus-gather-threads-by-references) -@end lisp - -@end table - - -@node Filling In Threads -@subsubsection Filling In Threads - -@table @code -@item gnus-fetch-old-headers -@vindex gnus-fetch-old-headers -If non-@code{nil}, Gnus will attempt to build old threads by fetching -more old headers---headers to articles marked as read. If you -would like to display as few summary lines as possible, but still -connect as many loose threads as possible, you should set this variable -to @code{some} or a number. If you set it to a number, no more than -that number of extra old headers will be fetched. In either case, -fetching old headers only works if the backend you are using carries -overview files---this would normally be @code{nntp}, @code{nnspool} and -@code{nnml}. Also remember that if the root of the thread has been -expired by the server, there's not much Gnus can do about that. - -This variable can also be set to @code{invisible}. This won't have any -visible effects, but is useful if you use the @kbd{A T} command a lot -(@pxref{Finding the Parent}). - -@item gnus-build-sparse-threads -@vindex gnus-build-sparse-threads -Fetching old headers can be slow. A low-rent similar effect can be -gotten by setting this variable to @code{some}. Gnus will then look at -the complete @code{References} headers of all articles and try to string -together articles that belong in the same thread. This will leave -@dfn{gaps} in the threading display where Gnus guesses that an article -is missing from the thread. (These gaps appear like normal summary -lines. If you select a gap, Gnus will try to fetch the article in -question.) If this variable is @code{t}, Gnus will display all these -``gaps'' without regard for whether they are useful for completing the -thread or not. Finally, if this variable is @code{more}, Gnus won't cut -off sparse leaf nodes that don't lead anywhere. This variable is -@code{nil} by default. - -@end table - - -@node More Threading -@subsubsection More Threading - -@table @code -@item gnus-show-threads -@vindex gnus-show-threads -If this variable is @code{nil}, no threading will be done, and all of -the rest of the variables here will have no effect. Turning threading -off will speed group selection up a bit, but it is sure to make reading -slower and more awkward. - -@item gnus-thread-hide-subtree -@vindex gnus-thread-hide-subtree -If non-@code{nil}, all threads will be hidden when the summary buffer is -generated. - -@item gnus-thread-expunge-below -@vindex gnus-thread-expunge-below -All threads that have a total score (as defined by -@code{gnus-thread-score-function}) less than this number will be -expunged. This variable is @code{nil} by default, which means that no -threads are expunged. - -@item gnus-thread-hide-killed -@vindex gnus-thread-hide-killed -if you kill a thread and this variable is non-@code{nil}, the subtree -will be hidden. - -@item gnus-thread-ignore-subject -@vindex gnus-thread-ignore-subject -Sometimes somebody changes the subject in the middle of a thread. If -this variable is non-@code{nil}, the subject change is ignored. If it -is @code{nil}, which is the default, a change in the subject will result -in a new thread. - -@item gnus-thread-indent-level -@vindex gnus-thread-indent-level -This is a number that says how much each sub-thread should be indented. -The default is 4. - -@end table - - -@node Low-Level Threading -@subsubsection Low-Level Threading - -@table @code - -@item gnus-parse-headers-hook -@vindex gnus-parse-headers-hook -Hook run before parsing any headers. The default value is -@code{(gnus-decode-rfc1522)}, which means that QPized headers will be -slightly decoded in a hackish way. This is likely to change in the -future when Gnus becomes @sc{MIME}ified. - -@item gnus-alter-header-function -@vindex gnus-alter-header-function -If non-@code{nil}, this function will be 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. For instance, -if you have a mail-to-news gateway which alters the @code{Message-ID}s -in systematic ways (by adding prefixes and such), you can use this -variable to un-scramble the @code{Message-ID}s so that they are more -meaningful. Here's one example: - -@lisp -(setq gnus-alter-header-function 'my-alter-message-id) - -(defun my-alter-message-id (header) - (let ((id (mail-header-id header))) - (when (string-match - "\\(<[^<>@@]*\\)\\.?cygnus\\..*@@\\([^<>@@]*>\\)" id) - (mail-header-set-id - (concat (match-string 1 id) "@@" (match-string 2 id)) - header)))) -@end lisp - -@end table - - -@node Thread Commands -@subsection Thread Commands -@cindex thread commands - -@table @kbd - -@item T k -@itemx M-C-k -@kindex T k (Summary) -@kindex M-C-k (Summary) -@findex gnus-summary-kill-thread -Mark all articles in the current (sub-)thread as read -(@code{gnus-summary-kill-thread}). If the prefix argument is positive, -remove all marks instead. If the prefix argument is negative, tick -articles instead. - -@item T l -@itemx M-C-l -@kindex T l (Summary) -@kindex M-C-l (Summary) -@findex gnus-summary-lower-thread -Lower the score of the current (sub-)thread -(@code{gnus-summary-lower-thread}). - -@item T i -@kindex T i (Summary) -@findex gnus-summary-raise-thread -Increase the score of the current (sub-)thread -(@code{gnus-summary-raise-thread}). - -@item T # -@kindex T # (Summary) -@findex gnus-uu-mark-thread -Set the process mark on the current (sub-)thread -(@code{gnus-uu-mark-thread}). - -@item T M-# -@kindex T M-# (Summary) -@findex gnus-uu-unmark-thread -Remove the process mark from the current (sub-)thread -(@code{gnus-uu-unmark-thread}). - -@item T T -@kindex T T (Summary) -@findex gnus-summary-toggle-threads -Toggle threading (@code{gnus-summary-toggle-threads}). - -@item T s -@kindex T s (Summary) -@findex gnus-summary-show-thread -Expose the (sub-)thread hidden under the current article, if any -(@code{gnus-summary-show-thread}). - -@item T h -@kindex T h (Summary) -@findex gnus-summary-hide-thread -Hide the current (sub-)thread (@code{gnus-summary-hide-thread}). - -@item T S -@kindex T S (Summary) -@findex gnus-summary-show-all-threads -Expose all hidden threads (@code{gnus-summary-show-all-threads}). - -@item T H -@kindex T H (Summary) -@findex gnus-summary-hide-all-threads -Hide all threads (@code{gnus-summary-hide-all-threads}). - -@item T t -@kindex T t (Summary) -@findex gnus-summary-rethread-current -Re-thread the current article's thread -(@code{gnus-summary-rethread-current}). This works even when the -summary buffer is otherwise unthreaded. - -@item T ^ -@kindex T ^ (Summary) -@findex gnus-summary-reparent-thread -Make the current article the child of the marked (or previous) article -(@code{gnus-summary-reparent-thread}). - -@end table - -The following commands are thread movement commands. They all -understand the numeric prefix. - -@table @kbd - -@item T n -@kindex T n (Summary) -@findex gnus-summary-next-thread -Go to the next thread (@code{gnus-summary-next-thread}). - -@item T p -@kindex T p (Summary) -@findex gnus-summary-prev-thread -Go to the previous thread (@code{gnus-summary-prev-thread}). - -@item T d -@kindex T d (Summary) -@findex gnus-summary-down-thread -Descend the thread (@code{gnus-summary-down-thread}). - -@item T u -@kindex T u (Summary) -@findex gnus-summary-up-thread -Ascend the thread (@code{gnus-summary-up-thread}). - -@item T o -@kindex T o (Summary) -@findex gnus-summary-top-thread -Go to the top of the thread (@code{gnus-summary-top-thread}). -@end table - -@vindex gnus-thread-operation-ignore-subject -If you ignore subject while threading, you'll naturally end up with -threads that have several different subjects in them. If you then issue -a command like `T k' (@code{gnus-summary-kill-thread}) you might not -wish to kill the entire thread, but just those parts of the thread that -have the same subject as the current article. If you like this idea, -you can fiddle with @code{gnus-thread-operation-ignore-subject}. If it -is non-@code{nil} (which it is by default), subjects will be ignored -when doing thread commands. If this variable is @code{nil}, articles in -the same thread with different subjects will not be included in the -operation in question. If this variable is @code{fuzzy}, only articles -that have subjects fuzzily equal will be included (@pxref{Fuzzy -Matching}). - - -@node Sorting -@section Sorting - -@findex gnus-thread-sort-by-total-score -@findex gnus-thread-sort-by-date -@findex gnus-thread-sort-by-score -@findex gnus-thread-sort-by-subject -@findex gnus-thread-sort-by-author -@findex gnus-thread-sort-by-number -@vindex gnus-thread-sort-functions -If you are using a threaded summary display, you can sort the threads by -setting @code{gnus-thread-sort-functions}, which is a list of functions. -By default, sorting is done on article numbers. Ready-made sorting -predicate functions include @code{gnus-thread-sort-by-number}, -@code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-subject}, -@code{gnus-thread-sort-by-date}, @code{gnus-thread-sort-by-score}, and -@code{gnus-thread-sort-by-total-score}. - -Each function takes two threads and returns non-@code{nil} if the first -thread should be sorted before the other. Note that sorting really is -normally done by looking only at the roots of each thread. If you use -more than one function, the primary sort key should be the last function -in the list. You should probably always include -@code{gnus-thread-sort-by-number} in the list of sorting -functions---preferably first. This will ensure that threads that are -equal with respect to the other sort criteria will be displayed in -ascending article order. - -If you would like to sort by score, then by subject, and finally by -number, you could do something like: - -@lisp -(setq gnus-thread-sort-functions - '(gnus-thread-sort-by-number - gnus-thread-sort-by-subject - gnus-thread-sort-by-total-score)) -@end lisp - -The threads that have highest score will be displayed first in the -summary buffer. When threads have the same score, they will be sorted -alphabetically. The threads that have the same score and the same -subject will be sorted by number, which is (normally) the sequence in -which the articles arrived. - -If you want to sort by score and then reverse arrival order, you could -say something like: - -@lisp -(setq gnus-thread-sort-functions - '((lambda (t1 t2) - (not (gnus-thread-sort-by-number t2 t1))) - gnus-thread-sort-by-score)) -@end lisp - -@vindex gnus-thread-score-function -The function in the @code{gnus-thread-score-function} variable (default -@code{+}) is used for calculating the total score of a thread. Useful -functions might be @code{max}, @code{min}, or squared means, or whatever -tickles your fancy. - -@findex gnus-article-sort-functions -@findex gnus-article-sort-by-date -@findex gnus-article-sort-by-score -@findex gnus-article-sort-by-subject -@findex gnus-article-sort-by-author -@findex gnus-article-sort-by-number -If you are using an unthreaded display for some strange reason or other, -you have to fiddle with the @code{gnus-article-sort-functions} variable. -It is very similar to the @code{gnus-thread-sort-functions}, except that -it uses slightly different functions for article comparison. Available -sorting predicate functions are @code{gnus-article-sort-by-number}, -@code{gnus-article-sort-by-author}, @code{gnus-article-sort-by-subject}, -@code{gnus-article-sort-by-date}, and @code{gnus-article-sort-by-score}. - -If you want to sort an unthreaded summary display by subject, you could -say something like: - -@lisp -(setq gnus-article-sort-functions - '(gnus-article-sort-by-number - gnus-article-sort-by-subject)) -@end lisp - - - -@node Asynchronous Fetching -@section Asynchronous Article Fetching -@cindex asynchronous article fetching -@cindex article pre-fetch -@cindex pre-fetch - -If you read your news from an @sc{nntp} server that's far away, the -network latencies may make reading articles a chore. You have to wait -for a while after pressing @kbd{n} to go to the next article before the -article appears. Why can't Gnus just go ahead and fetch the article -while you are reading the previous one? Why not, indeed. - -First, some caveats. There are some pitfalls to using asynchronous -article fetching, especially the way Gnus does it. - -Let's say you are reading article 1, which is short, and article 2 is -quite long, and you are not interested in reading that. Gnus does not -know this, so it goes ahead and fetches article 2. You decide to read -article 3, but since Gnus is in the process of fetching article 2, the -connection is blocked. - -To avoid these situations, Gnus will open two (count 'em two) -connections to the server. Some people may think this isn't a very nice -thing to do, but I don't see any real alternatives. Setting up that -extra connection takes some time, so Gnus startup will be slower. - -Gnus will fetch more articles than you will read. This will mean that -the link between your machine and the @sc{nntp} server will become more -loaded than if you didn't use article pre-fetch. The server itself will -also become more loaded---both with the extra article requests, and the -extra connection. - -Ok, so now you know that you shouldn't really use this thing... unless -you really want to. - -@vindex gnus-asynchronous -Here's how: Set @code{gnus-asynchronous} to @code{t}. The rest should -happen automatically. - -@vindex gnus-use-article-prefetch -You can control how many articles are to be pre-fetched by setting -@code{gnus-use-article-prefetch}. This is 30 by default, which means -that when you read an article in the group, the backend will pre-fetch -the next 30 articles. If this variable is @code{t}, the backend will -pre-fetch all the articles it can without bound. If it is -@code{nil}, no pre-fetching will be done. - -@vindex gnus-async-prefetch-article-p -@findex gnus-async-read-p -There are probably some articles that you don't want to pre-fetch---read -articles, for instance. The @code{gnus-async-prefetch-article-p} variable controls whether an article is to be pre-fetched. This function should -return non-@code{nil} when the article in question is to be -pre-fetched. The default is @code{gnus-async-read-p}, which returns -@code{nil} on read articles. The function is called with an article -data structure as the only parameter. - -If, for instance, you wish to pre-fetch only unread articles shorter than 100 lines, you could say something like: - -@lisp -(defun my-async-short-unread-p (data) - "Return non-nil for short, unread articles." - (and (gnus-data-unread-p data) - (< (mail-header-lines (gnus-data-header data)) - 100))) - -(setq gnus-async-prefetch-article-p 'my-async-short-unread-p) -@end lisp - -These functions will be called many, many times, so they should -preferably be short and sweet to avoid slowing down Gnus too much. -It's probably a good idea to byte-compile things like this. - -@vindex gnus-prefetched-article-deletion-strategy -Articles have to be removed from the asynch buffer sooner or later. The -@code{gnus-prefetched-article-deletion-strategy} says when to remove -articles. This is a list that may contain the following elements: - -@table @code -@item read -Remove articles when they are read. - -@item exit -Remove articles when exiting the group. -@end table - -The default value is @code{(read exit)}. - -@vindex gnus-use-header-prefetch -If @code{gnus-use-header-prefetch} is non-@code{nil}, prefetch articles -from the next group. - - -@node Article Caching -@section Article Caching -@cindex article caching -@cindex caching - -If you have an @emph{extremely} slow @sc{nntp} connection, you may -consider turning article caching on. Each article will then be stored -locally under your home directory. As you may surmise, this could -potentially use @emph{huge} amounts of disk space, as well as eat up all -your inodes so fast it will make your head swim. In vodka. - -Used carefully, though, it could be just an easier way to save articles. - -@vindex gnus-use-long-file-name -@vindex gnus-cache-directory -@vindex gnus-use-cache -To turn caching on, set @code{gnus-use-cache} to @code{t}. By default, -all articles ticked or marked as dormant will then be copied -over to your local cache (@code{gnus-cache-directory}). Whether this -cache is flat or hierarchal is controlled by the -@code{gnus-use-long-file-name} variable, as usual. - -When re-selecting a ticked or dormant article, it will be fetched from the -cache instead of from the server. As articles in your cache will never -expire, this might serve as a method of saving articles while still -keeping them where they belong. Just mark all articles you want to save -as dormant, and don't worry. - -When an article is marked as read, is it removed from the cache. - -@vindex gnus-cache-remove-articles -@vindex gnus-cache-enter-articles -The entering/removal of articles from the cache is controlled by the -@code{gnus-cache-enter-articles} and @code{gnus-cache-remove-articles} -variables. Both are lists of symbols. The first is @code{(ticked -dormant)} by default, meaning that ticked and dormant articles will be -put in the cache. The latter is @code{(read)} by default, meaning that -articles marked as read are removed from the cache. Possibly -symbols in these two lists are @code{ticked}, @code{dormant}, -@code{unread} and @code{read}. - -@findex gnus-jog-cache -So where does the massive article-fetching and storing come into the -picture? The @code{gnus-jog-cache} command will go through all -subscribed newsgroups, request all unread articles, score them, and -store them in the cache. You should only ever, ever ever ever, use this -command if 1) your connection to the @sc{nntp} server is really, really, -really slow and 2) you have a really, really, really huge disk. -Seriously. One way to cut down on the number of articles downloaded is -to score unwanted articles down and have them marked as read. They will -not then be downloaded by this command. - -@vindex gnus-uncacheable-groups -It is likely that you do not want caching on some groups. For instance, -if your @code{nnml} mail is located under your home directory, it makes no -sense to cache it somewhere else under your home directory. Unless you -feel that it's neat to use twice as much space. To limit the caching, -you could set the @code{gnus-uncacheable-groups} regexp to -@samp{^nnml}, for instance. This variable is @code{nil} by -default. - -@findex gnus-cache-generate-nov-databases -@findex gnus-cache-generate-active -@vindex gnus-cache-active-file -The cache stores information on what articles it contains in its active -file (@code{gnus-cache-active-file}). If this file (or any other parts -of the cache) becomes all messed up for some reason or other, Gnus -offers two functions that will try to set things right. @kbd{M-x -gnus-cache-generate-nov-databases} will (re)build all the @sc{nov} -files, and @kbd{gnus-cache-generate-active} will (re)generate the active -file. - - -@node Persistent Articles -@section Persistent Articles -@cindex persistent articles - -Closely related to article caching, we have @dfn{persistent articles}. -In fact, it's just a different way of looking at caching, and much more -useful in my opinion. - -Say you're reading a newsgroup, and you happen on to some valuable gem -that you want to keep and treasure forever. You'd normally just save it -(using one of the many saving commands) in some file. The problem with -that is that it's just, well, yucky. Ideally you'd prefer just having -the article remain in the group where you found it forever; untouched by -the expiry going on at the news server. - -This is what a @dfn{persistent article} is---an article that just won't -be deleted. It's implemented using the normal cache functions, but -you use two explicit commands for managing persistent articles: - -@table @kbd - -@item * -@kindex * (Summary) -@findex gnus-cache-enter-article -Make the current article persistent (@code{gnus-cache-enter-article}). - -@item M-* -@kindex M-* (Summary) -@findex gnus-cache-remove-article -Remove the current article from the persistent articles -(@code{gnus-cache-remove-article}). This will normally delete the -article. -@end table - -Both these commands understand the process/prefix convention. - -To avoid having all ticked articles (and stuff) entered into the cache, -you should set @code{gnus-use-cache} to @code{passive} if you're just -interested in persistent articles: - -@lisp -(setq gnus-use-cache 'passive) -@end lisp - - -@node Article Backlog -@section Article Backlog -@cindex backlog -@cindex article backlog - -If you have a slow connection, but the idea of using caching seems -unappealing to you (and it is, really), you can help the situation some -by switching on the @dfn{backlog}. This is where Gnus will buffer -already read articles so that it doesn't have to re-fetch articles -you've already read. This only helps if you are in the habit of -re-selecting articles you've recently read, of course. If you never do -that, turning the backlog on will slow Gnus down a little bit, and -increase memory usage some. - -@vindex gnus-keep-backlog -If you set @code{gnus-keep-backlog} to a number @var{n}, Gnus will store -at most @var{n} old articles in a buffer for later re-fetching. If this -variable is non-@code{nil} and is not a number, Gnus will store -@emph{all} read articles, which means that your Emacs will grow without -bound before exploding and taking your machine down with you. I put -that in there just to keep y'all on your toes. - -This variable is @code{nil} by default. - - -@node Saving Articles -@section Saving Articles -@cindex saving articles - -Gnus can save articles in a number of ways. Below is the documentation -for saving articles in a fairly straight-forward fashion (i.e., little -processing of the article is done before it is saved). For a different -approach (uudecoding, unsharing) you should use @code{gnus-uu} -(@pxref{Decoding Articles}). - -@vindex gnus-save-all-headers -If @code{gnus-save-all-headers} is non-@code{nil}, Gnus will not delete -unwanted headers before saving the article. - -@vindex gnus-saved-headers -If the preceding variable is @code{nil}, all headers that match the -@code{gnus-saved-headers} regexp will be kept, while the rest will be -deleted before saving. - -@table @kbd - -@item O o -@itemx o -@kindex O o (Summary) -@kindex o (Summary) -@findex gnus-summary-save-article -@c @icon{gnus-summary-save-article} -Save the current article using the default article saver -(@code{gnus-summary-save-article}). - -@item O m -@kindex O m (Summary) -@findex gnus-summary-save-article-mail -Save the current article in mail format -(@code{gnus-summary-save-article-mail}). - -@item O r -@kindex O r (Summary) -@findex gnus-summary-save-article-rmail -Save the current article in rmail format -(@code{gnus-summary-save-article-rmail}). - -@item O f -@kindex O f (Summary) -@findex gnus-summary-save-article-file -@c @icon{gnus-summary-save-article-file} -Save the current article in plain file format -(@code{gnus-summary-save-article-file}). - -@item O F -@kindex O F (Summary) -@findex gnus-summary-write-article-file -Write the current article in plain file format, overwriting any previous -file contents (@code{gnus-summary-write-article-file}). - -@item O b -@kindex O b (Summary) -@findex gnus-summary-save-article-body-file -Save the current article body in plain file format -(@code{gnus-summary-save-article-body-file}). - -@item O h -@kindex O h (Summary) -@findex gnus-summary-save-article-folder -Save the current article in mh folder format -(@code{gnus-summary-save-article-folder}). - -@item O v -@kindex O v (Summary) -@findex gnus-summary-save-article-vm -Save the current article in a VM folder -(@code{gnus-summary-save-article-vm}). - -@item O p -@kindex O p (Summary) -@findex gnus-summary-pipe-output -Save the current article in a pipe. Uhm, like, what I mean is---Pipe -the current article to a process (@code{gnus-summary-pipe-output}). -@end table - -@vindex gnus-prompt-before-saving -All these commands use the process/prefix convention -(@pxref{Process/Prefix}). If you save bunches of articles using these -functions, you might get tired of being prompted for files to save each -and every article in. The prompting action is controlled by -the @code{gnus-prompt-before-saving} variable, which is @code{always} by -default, giving you that excessive prompting action you know and -loathe. If you set this variable to @code{t} instead, you'll be prompted -just once for each series of articles you save. If you like to really -have Gnus do all your thinking for you, you can even set this variable -to @code{nil}, which means that you will never be prompted for files to -save articles in. Gnus will simply save all the articles in the default -files. - - -@vindex gnus-default-article-saver -You can customize the @code{gnus-default-article-saver} variable to make -Gnus do what you want it to. You can use any of the four ready-made -functions below, or you can create your own. - -@table @code - -@item gnus-summary-save-in-rmail -@findex gnus-summary-save-in-rmail -@vindex gnus-rmail-save-name -@findex gnus-plain-save-name -This is the default format, @dfn{babyl}. Uses the function in the -@code{gnus-rmail-save-name} variable to get a file name to save the -article in. The default is @code{gnus-plain-save-name}. - -@item gnus-summary-save-in-mail -@findex gnus-summary-save-in-mail -@vindex gnus-mail-save-name -Save in a Unix mail (mbox) file. Uses the function in the -@code{gnus-mail-save-name} variable to get a file name to save the -article in. The default is @code{gnus-plain-save-name}. - -@item gnus-summary-save-in-file -@findex gnus-summary-save-in-file -@vindex gnus-file-save-name -@findex gnus-numeric-save-name -Append the article straight to an ordinary file. Uses the function in -the @code{gnus-file-save-name} variable to get a file name to save the -article in. The default is @code{gnus-numeric-save-name}. - -@item gnus-summary-save-body-in-file -@findex gnus-summary-save-body-in-file -Append the article body to an ordinary file. Uses the function in the -@code{gnus-file-save-name} variable to get a file name to save the -article in. The default is @code{gnus-numeric-save-name}. - -@item gnus-summary-save-in-folder -@findex gnus-summary-save-in-folder -@findex gnus-folder-save-name -@findex gnus-Folder-save-name -@vindex gnus-folder-save-name -@cindex rcvstore -@cindex MH folders -Save the article to an MH folder using @code{rcvstore} from the MH -library. Uses the function in the @code{gnus-folder-save-name} variable -to get a file name to save the article in. The default is -@code{gnus-folder-save-name}, but you can also use -@code{gnus-Folder-save-name}, which creates capitalized names. - -@item gnus-summary-save-in-vm -@findex gnus-summary-save-in-vm -Save the article in a VM folder. You have to have the VM mail -reader to use this setting. -@end table - -@vindex gnus-article-save-directory -All of these functions, except for the last one, will save the article -in the @code{gnus-article-save-directory}, which is initialized from the -@code{SAVEDIR} environment variable. This is @file{~/News/} by -default. - -As you can see above, the functions use different functions to find a -suitable name of a file to save the article in. Below is a list of -available functions that generate names: - -@table @code - -@item gnus-Numeric-save-name -@findex gnus-Numeric-save-name -File names like @file{~/News/Alt.andrea-dworkin/45}. - -@item gnus-numeric-save-name -@findex gnus-numeric-save-name -File names like @file{~/News/alt.andrea-dworkin/45}. - -@item gnus-Plain-save-name -@findex gnus-Plain-save-name -File names like @file{~/News/Alt.andrea-dworkin}. - -@item gnus-plain-save-name -@findex gnus-plain-save-name -File names like @file{~/News/alt.andrea-dworkin}. -@end table - -@vindex gnus-split-methods -You can have Gnus suggest where to save articles by plonking a regexp into -the @code{gnus-split-methods} alist. For instance, if you would like to -save articles related to Gnus in the file @file{gnus-stuff}, and articles -related to VM in @code{vm-stuff}, you could set this variable to something -like: - -@lisp -(("^Subject:.*gnus\\|^Newsgroups:.*gnus" "gnus-stuff") - ("^Subject:.*vm\\|^Xref:.*vm" "vm-stuff") - (my-choosing-function "../other-dir/my-stuff") - ((equal gnus-newsgroup-name "mail.misc") "mail-stuff")) -@end lisp - -We see that this is a list where each element is a list that has two -elements---the @dfn{match} and the @dfn{file}. The match can either be -a string (in which case it is used as a regexp to match on the article -head); it can be a symbol (which will be called as a function with the -group name as a parameter); or it can be a list (which will be -@code{eval}ed). If any of these actions have a non-@code{nil} result, -the @dfn{file} will be used as a default prompt. In addition, the -result of the operation itself will be used if the function or form -called returns a string or a list of strings. - -You basically end up with a list of file names that might be used when -saving the current article. (All ``matches'' will be used.) You will -then be prompted for what you really want to use as a name, with file -name completion over the results from applying this variable. - -This variable is @code{((gnus-article-archive-name))} by default, which -means that Gnus will look at the articles it saves for an -@code{Archive-name} line and use that as a suggestion for the file -name. - -Here's an example function to clean up file names somewhat. If you have -lots of mail groups called things like -@samp{nnml:mail.whatever}, you may want to chop off the beginning of -these group names before creating the file name to save to. The -following will do just that: - -@lisp -(defun my-save-name (group) - (when (string-match "^nnml:mail." group) - (substring group (match-end 0)))) - -(setq gnus-split-methods - '((gnus-article-archive-name) - (my-save-name))) -@end lisp - - -@vindex gnus-use-long-file-name -Finally, you have the @code{gnus-use-long-file-name} variable. If it is -@code{nil}, all the preceding functions will replace all periods -(@samp{.}) in the group names with slashes (@samp{/})---which means that -the functions will generate hierarchies of directories instead of having -all the files in the toplevel directory -(@file{~/News/alt/andrea-dworkin} instead of -@file{~/News/alt.andrea-dworkin}.) This variable is @code{t} by default -on most systems. However, for historical reasons, this is @code{nil} on -Xenix and usg-unix-v machines by default. - -This function also affects kill and score file names. If this variable -is a list, and the list contains the element @code{not-score}, long file -names will not be used for score files, if it contains the element -@code{not-save}, long file names will not be used for saving, and if it -contains the element @code{not-kill}, long file names will not be used -for kill files. - -If you'd like to save articles in a hierarchy that looks something like -a spool, you could - -@lisp -(setq gnus-use-long-file-name '(not-save)) ; to get a hierarchy -(setq gnus-default-article-saver 'gnus-summary-save-in-file) ; no encoding -@end lisp - -Then just save with @kbd{o}. You'd then read this hierarchy with -ephemeral @code{nneething} groups---@kbd{G D} in the group buffer, and -the toplevel directory as the argument (@file{~/News/}). Then just walk -around to the groups/directories with @code{nneething}. - - -@node Decoding Articles -@section Decoding Articles -@cindex decoding articles - -Sometime users post articles (or series of articles) that have been -encoded in some way or other. Gnus can decode them for you. - -@menu -* Uuencoded Articles:: Uudecode articles. -* Shell Archives:: Unshar articles. -* PostScript Files:: Split PostScript. -* Other Files:: Plain save and binhex. -* Decoding Variables:: Variables for a happy decoding. -* Viewing Files:: You want to look at the result of the decoding? -@end menu - -@cindex series -@cindex article series -All these functions use the process/prefix convention -(@pxref{Process/Prefix}) for finding out what articles to work on, with -the extension that a ``single article'' means ``a single series''. Gnus -can find out by itself what articles belong to a series, decode all the -articles and unpack/view/save the resulting file(s). - -Gnus guesses what articles are in the series according to the following -simplish rule: The subjects must be (nearly) identical, except for the -last two numbers of the line. (Spaces are largely ignored, however.) - -For example: If you choose a subject called @samp{cat.gif (2/3)}, Gnus -will find all the articles that match the regexp @samp{^cat.gif -([0-9]+/[0-9]+).*$}. - -Subjects that are non-standard, like @samp{cat.gif (2/3) Part 6 of a -series}, will not be properly recognized by any of the automatic viewing -commands, and you have to mark the articles manually with @kbd{#}. - - -@node Uuencoded Articles -@subsection Uuencoded Articles -@cindex uudecode -@cindex uuencoded articles - -@table @kbd - -@item X u -@kindex X u (Summary) -@findex gnus-uu-decode-uu -@c @icon{gnus-uu-decode-uu} -Uudecodes the current series (@code{gnus-uu-decode-uu}). - -@item X U -@kindex X U (Summary) -@findex gnus-uu-decode-uu-and-save -Uudecodes and saves the current series -(@code{gnus-uu-decode-uu-and-save}). - -@item X v u -@kindex X v u (Summary) -@findex gnus-uu-decode-uu-view -Uudecodes and views the current series (@code{gnus-uu-decode-uu-view}). - -@item X v U -@kindex X v U (Summary) -@findex gnus-uu-decode-uu-and-save-view -Uudecodes, views and saves the current series -(@code{gnus-uu-decode-uu-and-save-view}). - -@end table - -Remember that these all react to the presence of articles marked with -the process mark. If, for instance, you'd like to decode and save an -entire newsgroup, you'd typically do @kbd{M P a} -(@code{gnus-uu-mark-all}) and then @kbd{X U} -(@code{gnus-uu-decode-uu-and-save}). - -All this is very much different from how @code{gnus-uu} worked with -@sc{gnus 4.1}, where you had explicit keystrokes for everything under -the sun. This version of @code{gnus-uu} generally assumes that you mark -articles in some way (@pxref{Setting Process Marks}) and then press -@kbd{X u}. - -@vindex gnus-uu-notify-files -Note: When trying to decode articles that have names matching -@code{gnus-uu-notify-files}, which is hard-coded to -@samp{[Cc][Ii][Nn][Dd][Yy][0-9]+.\\(gif\\|jpg\\)}, @code{gnus-uu} will -automatically post an article on @samp{comp.unix.wizards} saying that -you have just viewed the file in question. This feature can't be turned -off. - - -@node Shell Archives -@subsection Shell Archives -@cindex unshar -@cindex shell archives -@cindex shared articles - -Shell archives (``shar files'') used to be a popular way to distribute -sources, but it isn't used all that much today. In any case, we have -some commands to deal with these: - -@table @kbd - -@item X s -@kindex X s (Summary) -@findex gnus-uu-decode-unshar -Unshars the current series (@code{gnus-uu-decode-unshar}). - -@item X S -@kindex X S (Summary) -@findex gnus-uu-decode-unshar-and-save -Unshars and saves the current series (@code{gnus-uu-decode-unshar-and-save}). - -@item X v s -@kindex X v s (Summary) -@findex gnus-uu-decode-unshar-view -Unshars and views the current series (@code{gnus-uu-decode-unshar-view}). - -@item X v S -@kindex X v S (Summary) -@findex gnus-uu-decode-unshar-and-save-view -Unshars, views and saves the current series -(@code{gnus-uu-decode-unshar-and-save-view}). -@end table - - -@node PostScript Files -@subsection PostScript Files -@cindex PostScript - -@table @kbd - -@item X p -@kindex X p (Summary) -@findex gnus-uu-decode-postscript -Unpack the current PostScript series (@code{gnus-uu-decode-postscript}). - -@item X P -@kindex X P (Summary) -@findex gnus-uu-decode-postscript-and-save -Unpack and save the current PostScript series -(@code{gnus-uu-decode-postscript-and-save}). - -@item X v p -@kindex X v p (Summary) -@findex gnus-uu-decode-postscript-view -View the current PostScript series -(@code{gnus-uu-decode-postscript-view}). - -@item X v P -@kindex X v P (Summary) -@findex gnus-uu-decode-postscript-and-save-view -View and save the current PostScript series -(@code{gnus-uu-decode-postscript-and-save-view}). -@end table - - -@node Other Files -@subsection Other Files - -@table @kbd -@item X o -@kindex X o (Summary) -@findex gnus-uu-decode-save -Save the current series -(@code{gnus-uu-decode-save}). - -@item X b -@kindex X b (Summary) -@findex gnus-uu-decode-binhex -Unbinhex the current series (@code{gnus-uu-decode-binhex}). This -doesn't really work yet. -@end table - - -@node Decoding Variables -@subsection Decoding Variables - -Adjective, not verb. - -@menu -* Rule Variables:: Variables that say how a file is to be viewed. -* Other Decode Variables:: Other decode variables. -* Uuencoding and Posting:: Variables for customizing uuencoding. -@end menu - - -@node Rule Variables -@subsubsection Rule Variables -@cindex rule variables - -Gnus uses @dfn{rule variables} to decide how to view a file. All these -variables are of the form - -@lisp - (list '(regexp1 command2) - '(regexp2 command2) - ...) -@end lisp - -@table @code - -@item gnus-uu-user-view-rules -@vindex gnus-uu-user-view-rules -@cindex sox -This variable is consulted first when viewing files. If you wish to use, -for instance, @code{sox} to convert an @samp{.au} sound file, you could -say something like: -@lisp -(setq gnus-uu-user-view-rules - (list '(\"\\\\.au$\" \"sox %s -t .aiff > /dev/audio\"))) -@end lisp - -@item gnus-uu-user-view-rules-end -@vindex gnus-uu-user-view-rules-end -This variable is consulted if Gnus couldn't make any matches from the -user and default view rules. - -@item gnus-uu-user-archive-rules -@vindex gnus-uu-user-archive-rules -This variable can be used to say what commands should be used to unpack -archives. -@end table - - -@node Other Decode Variables -@subsubsection Other Decode Variables - -@table @code -@vindex gnus-uu-grabbed-file-functions - -@item gnus-uu-grabbed-file-functions -All functions in this list will be called right after each file has been -successfully decoded---so that you can move or view files right away, -and don't have to wait for all files to be decoded before you can do -anything. Ready-made functions you can put in this list are: - -@table @code - -@item gnus-uu-grab-view -@findex gnus-uu-grab-view -View the file. - -@item gnus-uu-grab-move -@findex gnus-uu-grab-move -Move the file (if you're using a saving function.) -@end table - -@item gnus-uu-be-dangerous -@vindex gnus-uu-be-dangerous -Specifies what to do if unusual situations arise during decoding. If -@code{nil}, be as conservative as possible. If @code{t}, ignore things -that didn't work, and overwrite existing files. Otherwise, ask each -time. - -@item gnus-uu-ignore-files-by-name -@vindex gnus-uu-ignore-files-by-name -Files with name matching this regular expression won't be viewed. - -@item gnus-uu-ignore-files-by-type -@vindex gnus-uu-ignore-files-by-type -Files with a @sc{mime} type matching this variable won't be viewed. -Note that Gnus tries to guess what type the file is based on the name. -@code{gnus-uu} is not a @sc{mime} package (yet), so this is slightly -kludgey. - -@item gnus-uu-tmp-dir -@vindex gnus-uu-tmp-dir -Where @code{gnus-uu} does its work. - -@item gnus-uu-do-not-unpack-archives -@vindex gnus-uu-do-not-unpack-archives -Non-@code{nil} means that @code{gnus-uu} won't peek inside archives -looking for files to display. - -@item gnus-uu-view-and-save -@vindex gnus-uu-view-and-save -Non-@code{nil} means that the user will always be asked to save a file -after viewing it. - -@item gnus-uu-ignore-default-view-rules -@vindex gnus-uu-ignore-default-view-rules -Non-@code{nil} means that @code{gnus-uu} will ignore the default viewing -rules. - -@item gnus-uu-ignore-default-archive-rules -@vindex gnus-uu-ignore-default-archive-rules -Non-@code{nil} means that @code{gnus-uu} will ignore the default archive -unpacking commands. - -@item gnus-uu-kill-carriage-return -@vindex gnus-uu-kill-carriage-return -Non-@code{nil} means that @code{gnus-uu} will strip all carriage returns -from articles. - -@item gnus-uu-unmark-articles-not-decoded -@vindex gnus-uu-unmark-articles-not-decoded -Non-@code{nil} means that @code{gnus-uu} will mark unsuccessfully -decoded articles as unread. - -@item gnus-uu-correct-stripped-uucode -@vindex gnus-uu-correct-stripped-uucode -Non-@code{nil} means that @code{gnus-uu} will @emph{try} to fix -uuencoded files that have had trailing spaces deleted. - -@item gnus-uu-pre-uudecode-hook -@vindex gnus-uu-pre-uudecode-hook -Hook run before sending a message to @code{uudecode}. - -@item gnus-uu-view-with-metamail -@vindex gnus-uu-view-with-metamail -@cindex metamail -Non-@code{nil} means that @code{gnus-uu} will ignore the viewing -commands defined by the rule variables and just fudge a @sc{mime} -content type based on the file name. The result will be fed to -@code{metamail} for viewing. - -@item gnus-uu-save-in-digest -@vindex gnus-uu-save-in-digest -Non-@code{nil} means that @code{gnus-uu}, when asked to save without -decoding, will save in digests. If this variable is @code{nil}, -@code{gnus-uu} will just save everything in a file without any -embellishments. The digesting almost conforms to RFC1153---no easy way -to specify any meaningful volume and issue numbers were found, so I -simply dropped them. - -@end table - - -@node Uuencoding and Posting -@subsubsection Uuencoding and Posting - -@table @code - -@item gnus-uu-post-include-before-composing -@vindex gnus-uu-post-include-before-composing -Non-@code{nil} means that @code{gnus-uu} will ask for a file to encode -before you compose the article. If this variable is @code{t}, you can -either include an encoded file with @kbd{C-c C-i} or have one included -for you when you post the article. - -@item gnus-uu-post-length -@vindex gnus-uu-post-length -Maximum length of an article. The encoded file will be split into how -many articles it takes to post the entire file. - -@item gnus-uu-post-threaded -@vindex gnus-uu-post-threaded -Non-@code{nil} means that @code{gnus-uu} will post the encoded file in a -thread. This may not be smart, as no other decoder I have seen is able -to follow threads when collecting uuencoded articles. (Well, I have -seen one package that does that---@code{gnus-uu}, but somehow, I don't -think that counts...) Default is @code{nil}. - -@item gnus-uu-post-separate-description -@vindex gnus-uu-post-separate-description -Non-@code{nil} means that the description will be posted in a separate -article. The first article will typically be numbered (0/x). If this -variable is @code{nil}, the description the user enters will be included -at the beginning of the first article, which will be numbered (1/x). -Default is @code{t}. - -@end table - - -@node Viewing Files -@subsection Viewing Files -@cindex viewing files -@cindex pseudo-articles - -After decoding, if the file is some sort of archive, Gnus will attempt -to unpack the archive and see if any of the files in the archive can be -viewed. For instance, if you have a gzipped tar file @file{pics.tar.gz} -containing the files @file{pic1.jpg} and @file{pic2.gif}, Gnus will -uncompress and de-tar the main file, and then view the two pictures. -This unpacking process is recursive, so if the archive contains archives -of archives, it'll all be unpacked. - -Finally, Gnus will normally insert a @dfn{pseudo-article} for each -extracted file into the summary buffer. If you go to these -``articles'', you will be prompted for a command to run (usually Gnus -will make a suggestion), and then the command will be run. - -@vindex gnus-view-pseudo-asynchronously -If @code{gnus-view-pseudo-asynchronously} is @code{nil}, Emacs will wait -until the viewing is done before proceeding. - -@vindex gnus-view-pseudos -If @code{gnus-view-pseudos} is @code{automatic}, Gnus will not insert -the pseudo-articles into the summary buffer, but view them -immediately. If this variable is @code{not-confirm}, the user won't even -be asked for a confirmation before viewing is done. - -@vindex gnus-view-pseudos-separately -If @code{gnus-view-pseudos-separately} is non-@code{nil}, one -pseudo-article will be created for each file to be viewed. If -@code{nil}, all files that use the same viewing command will be given as -a list of parameters to that command. - -@vindex gnus-insert-pseudo-articles -If @code{gnus-insert-pseudo-articles} is non-@code{nil}, insert -pseudo-articles when decoding. It is @code{t} by default. - -So; there you are, reading your @emph{pseudo-articles} in your -@emph{virtual newsgroup} from the @emph{virtual server}; and you think: -Why isn't anything real anymore? How did we get here? - - -@node Article Treatment -@section Article Treatment - -Reading through this huge manual, you may have quite forgotten that the -object of newsreaders is to actually, like, read what people have -written. Reading articles. Unfortunately, people are quite bad at -writing, so there are tons of functions and variables to make reading -these articles easier. - -@menu -* Article Highlighting:: You want to make the article look like fruit salad. -* Article Fontisizing:: Making emphasized text look niced. -* Article Hiding:: You also want to make certain info go away. -* Article Washing:: Lots of way-neat functions to make life better. -* Article Buttons:: Click on URLs, Message-IDs, addresses and the like. -* Article Date:: Grumble, UT! -* Article Signature:: What is a signature? -@end menu - - -@node Article Highlighting -@subsection Article Highlighting -@cindex highlight - -Not only do you want your article buffer to look like fruit salad, but -you want it to look like technicolor fruit salad. - -@table @kbd - -@item W H a -@kindex W H a (Summary) -@findex gnus-article-highlight -Highlight the current article (@code{gnus-article-highlight}). - -@item W H h -@kindex W H h (Summary) -@findex gnus-article-highlight-headers -@vindex gnus-header-face-alist -Highlight the headers (@code{gnus-article-highlight-headers}). The -highlighting will be done according to the @code{gnus-header-face-alist} -variable, which is a list where each element has the form @var{(regexp -name content)}. @var{regexp} is a regular expression for matching the -header, @var{name} is the face used for highlighting the header name -(@pxref{Faces and Fonts}) and @var{content} is the face for highlighting -the header value. The first match made will be used. Note that -@var{regexp} shouldn't have @samp{^} prepended---Gnus will add one. - -@item W H c -@kindex W H c (Summary) -@findex gnus-article-highlight-citation -Highlight cited text (@code{gnus-article-highlight-citation}). - -Some variables to customize the citation highlights: - -@table @code -@vindex gnus-cite-parse-max-size - -@item gnus-cite-parse-max-size -If the article size if bigger than this variable (which is 25000 by -default), no citation highlighting will be performed. - -@item gnus-cite-prefix-regexp -@vindex gnus-cite-prefix-regexp -Regexp matching the longest possible citation prefix on a line. - -@item gnus-cite-max-prefix -@vindex gnus-cite-max-prefix -Maximum possible length for a citation prefix (default 20). - -@item gnus-cite-face-list -@vindex gnus-cite-face-list -List of faces used for highlighting citations (@pxref{Faces and Fonts}). -When there are citations from multiple articles in the same message, -Gnus will try to give each citation from each article its own face. -This should make it easier to see who wrote what. - -@item gnus-supercite-regexp -@vindex gnus-supercite-regexp -Regexp matching normal Supercite attribution lines. - -@item gnus-supercite-secondary-regexp -@vindex gnus-supercite-secondary-regexp -Regexp matching mangled Supercite attribution lines. - -@item gnus-cite-minimum-match-count -@vindex gnus-cite-minimum-match-count -Minimum number of identical prefixes we have to see before we believe -that it's a citation. - -@item gnus-cite-attribution-prefix -@vindex gnus-cite-attribution-prefix -Regexp matching the beginning of an attribution line. - -@item gnus-cite-attribution-suffix -@vindex gnus-cite-attribution-suffix -Regexp matching the end of an attribution line. - -@item gnus-cite-attribution-face -@vindex gnus-cite-attribution-face -Face used for attribution lines. It is merged with the face for the -cited text belonging to the attribution. - -@end table - - -@item W H s -@kindex W H s (Summary) -@vindex gnus-signature-separator -@vindex gnus-signature-face -@findex gnus-article-highlight-signature -Highlight the signature (@code{gnus-article-highlight-signature}). -Everything after @code{gnus-signature-separator} (@pxref{Article -Signature}) in an article will be considered a signature and will be -highlighted with @code{gnus-signature-face}, which is @code{italic} by -default. - -@end table - - -@node Article Fontisizing -@subsection Article Fontisizing -@cindex emphasis -@cindex article emphasis - -@findex gnus-article-emphasize -@kindex W e (Summary) -People commonly add emphasis to words in news articles by writing things -like @samp{_this_} or @samp{*this*}. Gnus can make this look nicer by -running the article through the @kbd{W e} -(@code{gnus-article-emphasize}) command. - -@vindex gnus-article-emphasis -How the emphasis is computed is controlled by the -@code{gnus-article-emphasis} variable. This is an alist where the first -element is a regular expression to be matched. The second is a number -that says what regular expression grouping is used to find the entire -emphasized word. The third is a number that says what regexp grouping -should be displayed and highlighted. (The text between these two -groupings will be hidden.) The fourth is the face used for -highlighting. - -@lisp -(setq gnus-article-emphasis - '(("_\\(\\w+\\)_" 0 1 gnus-emphasis-underline) - ("\\*\\(\\w+\\)\\*" 0 1 gnus-emphasis-bold))) -@end lisp - -@vindex gnus-emphasis-underline -@vindex gnus-emphasis-bold -@vindex gnus-emphasis-italic -@vindex gnus-emphasis-underline-bold -@vindex gnus-emphasis-underline-italic -@vindex gnus-emphasis-bold-italic -@vindex gnus-emphasis-underline-bold-italic -By default, there are seven rules, and they use the following faces: -@code{gnus-emphasis-bold}, @code{gnus-emphasis-italic}, -@code{gnus-emphasis-underline}, @code{gnus-emphasis-bold-italic}, -@code{gnus-emphasis-underline-italic}, -@code{gnus-emphasis-underline-bold}, and -@code{gnus-emphasis-underline-bold-italic}. - -If you want to change these faces, you can either use @kbd{M-x -customize}, or you can use @code{copy-face}. For instance, if you want -to make @code{gnus-emphasis-italic} use a red face instead, you could -say something like: - -@lisp -(copy-face 'red 'gnus-emphasis-italic) -@end lisp - - -@node Article Hiding -@subsection Article Hiding -@cindex article hiding - -Or rather, hiding certain things in each article. There usually is much -too much cruft in most articles. - -@table @kbd - -@item W W a -@kindex W W a (Summary) -@findex gnus-article-hide -Do maximum hiding on the summary buffer (@kbd{gnus-article-hide}). - -@item W W h -@kindex W W h (Summary) -@findex gnus-article-hide-headers -Hide headers (@code{gnus-article-hide-headers}). @xref{Hiding -Headers}. - -@item W W b -@kindex W W b (Summary) -@findex gnus-article-hide-boring-headers -Hide headers that aren't particularly interesting -(@code{gnus-article-hide-boring-headers}). @xref{Hiding Headers}. - -@item W W s -@kindex W W s (Summary) -@findex gnus-article-hide-signature -Hide signature (@code{gnus-article-hide-signature}). @xref{Article -Signature}. - -@item W W p -@kindex W W p (Summary) -@findex gnus-article-hide-pgp -@vindex gnus-article-hide-pgp-hook -Hide @sc{pgp} signatures (@code{gnus-article-hide-pgp}). The -@code{gnus-article-hide-pgp-hook} hook will be run after a @sc{pgp} -signature has been hidden. - -@item W W P -@kindex W W P (Summary) -@findex gnus-article-hide-pem -Hide @sc{pem} (privacy enhanced messages) cruft -(@code{gnus-article-hide-pem}). - -@item W W c -@kindex W W c (Summary) -@findex gnus-article-hide-citation -Hide citation (@code{gnus-article-hide-citation}). Some variables for -customizing the hiding: - -@table @code - -@item gnus-cite-hide-percentage -@vindex gnus-cite-hide-percentage -If the cited text is of a bigger percentage than this variable (default -50), hide the cited text. - -@item gnus-cite-hide-absolute -@vindex gnus-cite-hide-absolute -The cited text must have at least this length (default 10) before it -is hidden. - -@item gnus-cited-text-button-line-format -@vindex gnus-cited-text-button-line-format -Gnus adds buttons to show where the cited text has been hidden, and to -allow toggle hiding the text. The format of the variable is specified -by this format-like variable (@pxref{Formatting Variables}). These -specs are valid: - -@table @samp -@item b -Start point of the hidden text. -@item e -End point of the hidden text. -@item l -Length of the hidden text. -@end table - -@item gnus-cited-lines-visible -@vindex gnus-cited-lines-visible -The number of lines at the beginning of the cited text to leave shown. - -@end table - -@item W W C -@kindex W W C (Summary) -@findex gnus-article-hide-citation-in-followups -Hide cited text in articles that aren't roots -(@code{gnus-article-hide-citation-in-followups}). This isn't very -useful as an interactive command, but might be a handy function to stick -in @code{gnus-article-display-hook} (@pxref{Customizing Articles}). - -@end table - -All these ``hiding'' commands are toggles, but if you give a negative -prefix to these commands, they will show what they have previously -hidden. If you give a positive prefix, they will always hide. - -Also @pxref{Article Highlighting} for further variables for -citation customization. - - -@node Article Washing -@subsection Article Washing -@cindex washing -@cindex article washing - -We call this ``article washing'' for a really good reason. Namely, the -@kbd{A} key was taken, so we had to use the @kbd{W} key instead. - -@dfn{Washing} is defined by us as ``changing something from something to -something else'', but normally results in something looking better. -Cleaner, perhaps. - -@table @kbd - -@item W l -@kindex W l (Summary) -@findex gnus-summary-stop-page-breaking -Remove page breaks from the current article -(@code{gnus-summary-stop-page-breaking}). - -@item W r -@kindex W r (Summary) -@findex gnus-summary-caesar-message -@c @icon{gnus-summary-caesar-message} -Do a Caesar rotate (rot13) on the article buffer -(@code{gnus-summary-caesar-message}). -Unreadable articles that tell you to read them with Caesar rotate or rot13. -(Typically offensive jokes and such.) - -It's commonly called ``rot13'' because each letter is rotated 13 -positions in the alphabet, e. g. @samp{B} (letter #2) -> @samp{O} (letter -#15). It is sometimes referred to as ``Caesar rotate'' because Caesar -is rumoured to have employed this form of, uh, somewhat weak encryption. - -@item W t -@kindex W t (Summary) -@findex gnus-summary-toggle-header -Toggle whether to display all headers in the article buffer -(@code{gnus-summary-toggle-header}). - -@item W v -@kindex W v (Summary) -@findex gnus-summary-verbose-header -Toggle whether to display all headers in the article buffer permanently -(@code{gnus-summary-verbose-header}). - -@item W m -@kindex W m (Summary) -@findex gnus-summary-toggle-mime -Toggle whether to run the article through @sc{mime} before displaying -(@code{gnus-summary-toggle-mime}). - -@item W o -@kindex W o (Summary) -@findex gnus-article-treat-overstrike -Treat overstrike (@code{gnus-article-treat-overstrike}). - -@item W d -@kindex W d (Summary) -@findex gnus-article-treat-dumbquotes -Treat M******** sm*rtq**t*s (@code{gnus-article-treat-dumbquotes}). - -@item W w -@kindex W w (Summary) -@findex gnus-article-fill-cited-article -Do word wrap (@code{gnus-article-fill-cited-article}). If you use this -function in @code{gnus-article-display-hook}, it should be run fairly -late and certainly after any highlighting. - -You can give the command a numerical prefix to specify the width to use -when filling. - -@item W c -@kindex W c (Summary) -@findex gnus-article-remove-cr -Remove CR (i. e., @samp{^M}s on the end of the lines) -(@code{gnus-article-remove-cr}). - -@item W q -@kindex W q (Summary) -@findex gnus-article-de-quoted-unreadable -Treat quoted-printable (@code{gnus-article-de-quoted-unreadable}). -Quoted-Printable is one common @sc{mime} encoding employed when sending -non-ASCII (i. e., 8-bit) articles. It typically makes strings like -@samp{déjà vu} look like @samp{d=E9j=E0 vu}, which doesn't look very -readable to me. - -@item W f -@kindex W f (Summary) -@cindex x-face -@findex gnus-article-display-x-face -@findex gnus-article-x-face-command -@vindex gnus-article-x-face-command -@vindex gnus-article-x-face-too-ugly -@iftex -@iflatex -\include{xface} -@end iflatex -@end iftex -Look for and display any X-Face headers -(@code{gnus-article-display-x-face}). The command executed by this -function is given by the @code{gnus-article-x-face-command} variable. -If this variable is a string, this string will be executed in a -sub-shell. If it is a function, this function will be called with the -face as the argument. If the @code{gnus-article-x-face-too-ugly} (which -is a regexp) matches the @code{From} header, the face will not be shown. -The default action under Emacs is to fork off an @code{xv} to view the -face; under XEmacs the default action is to display the face before the -@code{From} header. (It's nicer if XEmacs has been compiled with X-Face -support---that will make display somewhat faster. If there's no native -X-Face support, Gnus will try to convert the @code{X-Face} header using -external programs from the @code{pbmplus} package and friends.) If you -want to have this function in the display hook, it should probably come -last. - -@item W b -@kindex W b (Summary) -@findex gnus-article-add-buttons -Add clickable buttons to the article (@code{gnus-article-add-buttons}). -@xref{Article Buttons} - -@item W B -@kindex W B (Summary) -@findex gnus-article-add-buttons-to-head -Add clickable buttons to the article headers -(@code{gnus-article-add-buttons-to-head}). - -@item W E l -@kindex W E l (Summary) -@findex gnus-article-strip-leading-blank-lines -Remove all blank lines from the beginning of the article -(@code{gnus-article-strip-leading-blank-lines}). - -@item W E m -@kindex W E m (Summary) -@findex gnus-article-strip-multiple-blank-lines -Replace all blank lines with empty lines and then all multiple empty -lines with a single empty line. -(@code{gnus-article-strip-multiple-blank-lines}). - -@item W E t -@kindex W E t (Summary) -@findex gnus-article-remove-trailing-blank-lines -Remove all blank lines at the end of the article -(@code{gnus-article-remove-trailing-blank-lines}). - -@item W E a -@kindex W E a (Summary) -@findex gnus-article-strip-blank-lines -Do all the three commands above -(@code{gnus-article-strip-blank-lines}). - -@item W E A -@kindex W E A (Summary) -@findex gnus-article-strip-all-blank-lines -Remove all blank lines -(@code{gnus-article-strip-all-blank-lines}). - -@item W E s -@kindex W E s (Summary) -@findex gnus-article-strip-leading-space -Remove all white space from the beginning of all lines of the article -body (@code{gnus-article-strip-leading-space}). - -@end table - - -@node Article Buttons -@subsection Article Buttons -@cindex buttons - -People often include references to other stuff in articles, and it would -be nice if Gnus could just fetch whatever it is that people talk about -with the minimum of fuzz when you hit @kbd{RET} or use the middle mouse -button on these references. - -Gnus adds @dfn{buttons} to certain standard references by default: -Well-formed URLs, mail addresses and Message-IDs. This is controlled by -two variables, one that handles article bodies and one that handles -article heads: - -@table @code - -@item gnus-button-alist -@vindex gnus-button-alist -This is an alist where each entry has this form: - -@lisp -(REGEXP BUTTON-PAR USE-P FUNCTION DATA-PAR) -@end lisp - -@table @var - -@item regexp -All text that match this regular expression will be considered an -external reference. Here's a typical regexp that matches embedded URLs: -@samp{]*\\)>}. - -@item button-par -Gnus has to know which parts of the matches is to be highlighted. This -is a number that says what sub-expression of the regexp is to be -highlighted. If you want it all highlighted, you use 0 here. - -@item use-p -This form will be @code{eval}ed, and if the result is non-@code{nil}, -this is considered a match. This is useful if you want extra sifting to -avoid false matches. - -@item function -This function will be called when you click on this button. - -@item data-par -As with @var{button-par}, this is a sub-expression number, but this one -says which part of the match is to be sent as data to @var{function}. - -@end table - -So the full entry for buttonizing URLs is then - -@lisp -("]*\\)>" 0 t gnus-button-url 1) -@end lisp - -@item gnus-header-button-alist -@vindex gnus-header-button-alist -This is just like the other alist, except that it is applied to the -article head only, and that each entry has an additional element that is -used to say what headers to apply the buttonize coding to: - -@lisp -(HEADER REGEXP BUTTON-PAR USE-P FUNCTION DATA-PAR) -@end lisp - -@var{HEADER} is a regular expression. - -@item gnus-button-url-regexp -@vindex gnus-button-url-regexp -A regular expression that matches embedded URLs. It is used in the -default values of the variables above. - -@item gnus-article-button-face -@vindex gnus-article-button-face -Face used on buttons. - -@item gnus-article-mouse-face -@vindex gnus-article-mouse-face -Face used when the mouse cursor is over a button. - -@end table - - -@node Article Date -@subsection Article Date - -The date is most likely generated in some obscure timezone you've never -heard of, so it's quite nice to be able to find out what the time was -when the article was sent. - -@table @kbd - -@item W T u -@kindex W T u (Summary) -@findex gnus-article-date-ut -Display the date in UT (aka. GMT, aka ZULU) -(@code{gnus-article-date-ut}). - -@item W T i -@kindex W T i (Summary) -@findex gnus-article-date-iso8601 -@cindex ISO 8601 -Display the date in international format, aka. ISO 8601 -(@code{gnus-article-date-iso8601}). - -@item W T l -@kindex W T l (Summary) -@findex gnus-article-date-local -Display the date in the local timezone (@code{gnus-article-date-local}). - -@item W T s -@kindex W T s (Summary) -@vindex gnus-article-time-format -@findex gnus-article-date-user -@findex format-time-string -Display the date using a user-defined format -(@code{gnus-article-date-user}). The format is specified by the -@code{gnus-article-time-format} variable, and is a string that's passed -to @code{format-time-string}. See the documentation of that variable -for a list of possible format specs. - -@item W T e -@kindex W T e (Summary) -@findex gnus-article-date-lapsed -@findex gnus-start-date-timer -@findex gnus-stop-date-timer -Say how much time has elapsed between the article was posted and now -(@code{gnus-article-date-lapsed}). If you want to have this line -updated continually, you can put - -@lisp -(gnus-start-date-timer) -@end lisp - -in your @file{.gnus.el} file, or you can run it off of some hook. If -you want to stop the timer, you can use the @code{gnus-stop-date-timer} -command. - -@item W T o -@kindex W T o (Summary) -@findex gnus-article-date-original -Display the original date (@code{gnus-article-date-original}). This can -be useful if you normally use some other conversion function and are -worried that it might be doing something totally wrong. Say, claiming -that the article was posted in 1854. Although something like that is -@emph{totally} impossible. Don't you trust me? *titter* - -@end table - - -@node Article Signature -@subsection Article Signature -@cindex signatures -@cindex article signature - -@vindex gnus-signature-separator -Each article is divided into two parts---the head and the body. The -body can be divided into a signature part and a text part. The variable -that says what is to be considered a signature is -@code{gnus-signature-separator}. This is normally the standard -@samp{^-- $} as mandated by son-of-RFC 1036. However, many people use -non-standard signature separators, so this variable can also be a list -of regular expressions to be tested, one by one. (Searches are done -from the end of the body towards the beginning.) One likely value is: - -@lisp -(setq gnus-signature-separator - '("^-- $" ; The standard - "^-- *$" ; A common mangling - "^-------*$" ; Many people just use a looong - ; line of dashes. Shame! - "^ *--------*$" ; Double-shame! - "^________*$" ; Underscores are also popular - "^========*$")) ; Pervert! -@end lisp - -The more permissive you are, the more likely it is that you'll get false -positives. - -@vindex gnus-signature-limit -@code{gnus-signature-limit} provides a limit to what is considered a -signature. - -@enumerate -@item -If it is an integer, no signature may be longer (in characters) than -that integer. -@item -If it is a floating point number, no signature may be longer (in lines) -than that number. -@item -If it is a function, the function will be called without any parameters, -and if it returns @code{nil}, there is no signature in the buffer. -@item -If it is a string, it will be used as a regexp. If it matches, the text -in question is not a signature. -@end enumerate - -This variable can also be a list where the elements may be of the types -listed above. Here's an example: - -@lisp -(setq gnus-signature-limit - '(200.0 "^---*Forwarded article")) -@end lisp - -This means that if there are more than 200 lines after the signature -separator, or the text after the signature separator is matched by -the regular expression @samp{^---*Forwarded article}, then it isn't a -signature after all. - - -@node Article Commands -@section Article Commands - -@table @kbd - -@item A P -@cindex PostScript -@cindex printing -@kindex A P (Summary) -@vindex gnus-ps-print-hook -@findex gnus-summary-print-article -Generate and print a PostScript image of the article buffer -(@code{gnus-summary-print-article}). @code{gnus-ps-print-hook} will be -run just before printing the buffer. - -@end table - - -@node Summary Sorting -@section Summary Sorting -@cindex summary sorting - -You can have the summary buffer sorted in various ways, even though I -can't really see why you'd want that. - -@table @kbd - -@item C-c C-s C-n -@kindex C-c C-s C-n (Summary) -@findex gnus-summary-sort-by-number -Sort by article number (@code{gnus-summary-sort-by-number}). - -@item C-c C-s C-a -@kindex C-c C-s C-a (Summary) -@findex gnus-summary-sort-by-author -Sort by author (@code{gnus-summary-sort-by-author}). - -@item C-c C-s C-s -@kindex C-c C-s C-s (Summary) -@findex gnus-summary-sort-by-subject -Sort by subject (@code{gnus-summary-sort-by-subject}). - -@item C-c C-s C-d -@kindex C-c C-s C-d (Summary) -@findex gnus-summary-sort-by-date -Sort by date (@code{gnus-summary-sort-by-date}). - -@item C-c C-s C-l -@kindex C-c C-s C-l (Summary) -@findex gnus-summary-sort-by-lines -Sort by lines (@code{gnus-summary-sort-by-lines}). - -@item C-c C-s C-i -@kindex C-c C-s C-i (Summary) -@findex gnus-summary-sort-by-score -Sort by score (@code{gnus-summary-sort-by-score}). -@end table - -These functions will work both when you use threading and when you don't -use threading. In the latter case, all summary lines will be sorted, -line by line. In the former case, sorting will be done on a -root-by-root basis, which might not be what you were looking for. To -toggle whether to use threading, type @kbd{T T} (@pxref{Thread -Commands}). - - -@node Finding the Parent -@section Finding the Parent -@cindex parent articles -@cindex referring articles - -@table @kbd -@item ^ -@kindex ^ (Summary) -@findex gnus-summary-refer-parent-article -If you'd like to read the parent of the current article, and it is not -displayed in the summary buffer, you might still be able to. That is, -if the current group is fetched by @sc{nntp}, the parent hasn't expired -and the @code{References} in the current article are not mangled, you -can just press @kbd{^} or @kbd{A r} -(@code{gnus-summary-refer-parent-article}). If everything goes well, -you'll get the parent. If the parent is already displayed in the -summary buffer, point will just move to this article. - -If given a positive numerical prefix, fetch that many articles back into -the ancestry. If given a negative numerical prefix, fetch just that -ancestor. So if you say @kbd{3 ^}, Gnus will fetch the parent, the -grandparent and the grandgrandparent of the current article. If you say -@kbd{-3 ^}, Gnus will only fetch the grandgrandparent of the current -article. - -@item A R (Summary) -@findex gnus-summary-refer-references -@kindex A R (Summary) -Fetch all articles mentioned in the @code{References} header of the -article (@code{gnus-summary-refer-references}). - -@item A T (Summary) -@findex gnus-summary-refer-thread -@kindex A T (Summary) -Display the full thread where the current article appears -(@code{gnus-summary-refer-thread}). This command has to fetch all the -headers in the current group to work, so it usually takes a while. If -you do it often, you may consider setting @code{gnus-fetch-old-headers} -to @code{invisible} (@pxref{Filling In Threads}). This won't have any -visible effects normally, but it'll make this command work a whole lot -faster. Of course, it'll make group entry somewhat slow. - -@vindex gnus-refer-thread-limit -The @code{gnus-refer-thread-limit} variable says how many old (i. e., -articles before the first displayed in the current group) headers to -fetch when doing this command. The default is 200. If @code{t}, all -the available headers will be fetched. This variable can be overridden -by giving the @kbd{A T} command a numerical prefix. - -@item M-^ (Summary) -@findex gnus-summary-refer-article -@kindex M-^ (Summary) -@cindex Message-ID -@cindex fetching by Message-ID -You can also ask the @sc{nntp} server for an arbitrary article, no -matter what group it belongs to. @kbd{M-^} -(@code{gnus-summary-refer-article}) will ask you for a -@code{Message-ID}, which is one of those long, hard-to-read thingies -that look something like @samp{<38o6up$6f2@@hymir.ifi.uio.no>}. You -have to get it all exactly right. No fuzzy searches, I'm afraid. -@end table - -The current select method will be used when fetching by -@code{Message-ID} from non-news select method, but you can override this -by giving this command a prefix. - -@vindex gnus-refer-article-method -If the group you are reading is located on a backend that does not -support fetching by @code{Message-ID} very well (like @code{nnspool}), -you can set @code{gnus-refer-article-method} to an @sc{nntp} method. It -would, perhaps, be best if the @sc{nntp} server you consult is the one -updating the spool you are reading from, but that's not really -necessary. - -Most of the mail backends support fetching by @code{Message-ID}, but do -not do a particularly excellent job at it. That is, @code{nnmbox} and -@code{nnbabyl} are able to locate articles from any groups, while -@code{nnml} and @code{nnfolder} are only able to locate articles that -have been posted to the current group. (Anything else would be too time -consuming.) @code{nnmh} does not support this at all. - - -@node Alternative Approaches -@section Alternative Approaches - -Different people like to read news using different methods. This being -Gnus, we offer a small selection of minor modes for the summary buffers. - -@menu -* Pick and Read:: First mark articles and then read them. -* Binary Groups:: Auto-decode all articles. -@end menu - - -@node Pick and Read -@subsection Pick and Read -@cindex pick and read - -Some newsreaders (like @code{nn} and, uhm, @code{Netnews} on VM/CMS) use -a two-phased reading interface. The user first marks in a summary -buffer the articles she wants to read. Then she starts reading the -articles with just an article buffer displayed. - -@findex gnus-pick-mode -@kindex M-x gnus-pick-mode -Gnus provides a summary buffer minor mode that allows -this---@code{gnus-pick-mode}. This basically means that a few process -mark commands become one-keystroke commands to allow easy marking, and -it provides one additional command for switching to the summary buffer. - -Here are the available keystrokes when using pick mode: - -@table @kbd -@item . -@kindex . (Pick) -@findex gnus-summary-mark-as-processable -Pick the article on the current line -(@code{gnus-summary-mark-as-processable}). If given a numerical prefix, -go to that article and pick it. (The line number is normally displayed -at the beginning of the summary pick lines.) - -@item SPACE -@kindex SPACE (Pick) -@findex gnus-pick-next-page -Scroll the summary buffer up one page (@code{gnus-pick-next-page}). If -at the end of the buffer, start reading the picked articles. - -@item u -@kindex u (Pick) -@findex gnus-summary-unmark-as-processable -Unpick the article (@code{gnus-summary-unmark-as-processable}). - -@item U -@kindex U (Pick) -@findex gnus-summary-unmark-all-processable -Unpick all articles (@code{gnus-summary-unmark-all-processable}). - -@item t -@kindex t (Pick) -@findex gnus-uu-mark-thread -Pick the thread (@code{gnus-uu-mark-thread}). - -@item T -@kindex T (Pick) -@findex gnus-uu-unmark-thread -Unpick the thread (@code{gnus-uu-unmark-thread}). - -@item r -@kindex r (Pick) -@findex gnus-uu-mark-region -Pick the region (@code{gnus-uu-mark-region}). - -@item R -@kindex R (Pick) -@findex gnus-uu-unmark-region -Unpick the region (@code{gnus-uu-unmark-region}). - -@item e -@kindex e (Pick) -@findex gnus-uu-mark-by-regexp -Pick articles that match a regexp (@code{gnus-uu-mark-by-regexp}). - -@item E -@kindex E (Pick) -@findex gnus-uu-unmark-by-regexp -Unpick articles that match a regexp (@code{gnus-uu-unmark-by-regexp}). - -@item b -@kindex b (Pick) -@findex gnus-uu-mark-buffer -Pick the buffer (@code{gnus-uu-mark-buffer}). - -@item B -@kindex B (Pick) -@findex gnus-uu-unmark-buffer -Unpick the buffer (@code{gnus-uu-unmark-buffer}). - -@item RET -@kindex RET (Pick) -@findex gnus-pick-start-reading -@vindex gnus-pick-display-summary -Start reading the picked articles (@code{gnus-pick-start-reading}). If -given a prefix, mark all unpicked articles as read first. If -@code{gnus-pick-display-summary} is non-@code{nil}, the summary buffer -will still be visible when you are reading. - -@end table - -If this sounds like a good idea to you, you could say: - -@lisp -(add-hook 'gnus-summary-mode-hook 'gnus-pick-mode) -@end lisp - -@vindex gnus-pick-mode-hook -@code{gnus-pick-mode-hook} is run in pick minor mode buffers. - -@vindex gnus-mark-unpicked-articles-as-read -If @code{gnus-mark-unpicked-articles-as-read} is non-@code{nil}, mark -all unpicked articles as read. The default is @code{nil}. - -@vindex gnus-summary-pick-line-format -The summary line format in pick mode is slightly different from the -standard format. At the beginning of each line the line number is -displayed. The pick mode line format is controlled by the -@code{gnus-summary-pick-line-format} variable (@pxref{Formatting -Variables}). It accepts the same format specs that -@code{gnus-summary-line-format} does (@pxref{Summary Buffer Lines}). - - -@node Binary Groups -@subsection Binary Groups -@cindex binary groups - -@findex gnus-binary-mode -@kindex M-x gnus-binary-mode -If you spend much time in binary groups, you may grow tired of hitting -@kbd{X u}, @kbd{n}, @kbd{RET} all the time. @kbd{M-x gnus-binary-mode} -is a minor mode for summary buffers that makes all ordinary Gnus article -selection functions uudecode series of articles and display the result -instead of just displaying the articles the normal way. - -@kindex g (Binary) -@findex gnus-binary-show-article -The only way, in fact, to see the actual articles is the @kbd{g} -command, when you have turned on this mode -(@code{gnus-binary-show-article}). - -@vindex gnus-binary-mode-hook -@code{gnus-binary-mode-hook} is called in binary minor mode buffers. - - -@node Tree Display -@section Tree Display -@cindex trees - -@vindex gnus-use-trees -If you don't like the normal Gnus summary display, you might try setting -@code{gnus-use-trees} to @code{t}. This will create (by default) an -additional @dfn{tree buffer}. You can execute all summary mode commands -in the tree buffer. - -There are a few variables to customize the tree display, of course: - -@table @code -@item gnus-tree-mode-hook -@vindex gnus-tree-mode-hook -A hook called in all tree mode buffers. - -@item gnus-tree-mode-line-format -@vindex gnus-tree-mode-line-format -A format string for the mode bar in the tree mode buffers. The default -is @samp{Gnus: %%b %S %Z}. For a list of valid specs, @pxref{Summary -Buffer Mode Line}. - -@item gnus-selected-tree-face -@vindex gnus-selected-tree-face -Face used for highlighting the selected article in the tree buffer. The -default is @code{modeline}. - -@item gnus-tree-line-format -@vindex gnus-tree-line-format -A format string for the tree nodes. The name is a bit of a misnomer, -though---it doesn't define a line, but just the node. The default value -is @samp{%(%[%3,3n%]%)}, which displays the first three characters of -the name of the poster. It is vital that all nodes are of the same -length, so you @emph{must} use @samp{%4,4n}-like specifiers. - -Valid specs are: - -@table @samp -@item n -The name of the poster. -@item f -The @code{From} header. -@item N -The number of the article. -@item [ -The opening bracket. -@item ] -The closing bracket. -@item s -The subject. -@end table - -@xref{Formatting Variables}. - -Variables related to the display are: - -@table @code -@item gnus-tree-brackets -@vindex gnus-tree-brackets -This is used for differentiating between ``real'' articles and -``sparse'' articles. The format is @var{((real-open . real-close) -(sparse-open . sparse-close) (dummy-open . dummy-close))}, and the -default is @code{((?[ . ?]) (?( . ?)) (?@{ . ?@}) (?< . ?>))}. - -@item gnus-tree-parent-child-edges -@vindex gnus-tree-parent-child-edges -This is a list that contains the characters used for connecting parent -nodes to their children. The default is @code{(?- ?\\ ?|)}. - -@end table - -@item gnus-tree-minimize-window -@vindex gnus-tree-minimize-window -If this variable is non-@code{nil}, Gnus will try to keep the tree -buffer as small as possible to allow more room for the other Gnus -windows. If this variable is a number, the tree buffer will never be -higher than that number. The default is @code{t}. Note that if you -have several windows displayed side-by-side in a frame and the tree -buffer is one of these, minimizing the tree window will also resize all -other windows displayed next to it. - -@item gnus-generate-tree-function -@vindex gnus-generate-tree-function -@findex gnus-generate-horizontal-tree -@findex gnus-generate-vertical-tree -The function that actually generates the thread tree. Two predefined -functions are available: @code{gnus-generate-horizontal-tree} and -@code{gnus-generate-vertical-tree} (which is the default). - -@end table - -Here's an example from a horizontal tree buffer: - -@example -@{***@}-(***)-[odd]-[Gun] - | \[Jan] - | \[odd]-[Eri] - | \(***)-[Eri] - | \[odd]-[Paa] - \[Bjo] - \[Gun] - \[Gun]-[Jor] -@end example - -Here's the same thread displayed in a vertical tree buffer: - -@example -@{***@} - |--------------------------\-----\-----\ -(***) [Bjo] [Gun] [Gun] - |--\-----\-----\ | -[odd] [Jan] [odd] (***) [Jor] - | | |--\ -[Gun] [Eri] [Eri] [odd] - | - [Paa] -@end example - -If you're using horizontal trees, it might be nice to display the trees -side-by-side with the summary buffer. You could add something like the -following to your @file{.gnus.el} file: - -@lisp -(setq gnus-use-trees t - gnus-generate-tree-function 'gnus-generate-horizontal-tree - gnus-tree-minimize-window nil) -(gnus-add-configuration - '(article - (vertical 1.0 - (horizontal 0.25 - (summary 0.75 point) - (tree 1.0)) - (article 1.0)))) -@end lisp - -@xref{Windows Configuration}. - - -@node Mail Group Commands -@section Mail Group Commands -@cindex mail group commands - -Some commands only make sense in mail groups. If these commands are -invalid in the current group, they will raise a hell and let you know. - -All these commands (except the expiry and edit commands) use the -process/prefix convention (@pxref{Process/Prefix}). - -@table @kbd - -@item B e -@kindex B e (Summary) -@findex gnus-summary-expire-articles -Expire all expirable articles in the group -(@code{gnus-summary-expire-articles}). - -@item B M-C-e -@kindex B M-C-e (Summary) -@findex gnus-summary-expire-articles-now -Delete all the expirable articles in the group -(@code{gnus-summary-expire-articles-now}). This means that @strong{all} -articles eligible for expiry in the current group will -disappear forever into that big @file{/dev/null} in the sky. - -@item B DEL -@kindex B DEL (Summary) -@findex gnus-summary-delete-article -@c @icon{gnus-summary-mail-delete} -Delete the mail article. This is ``delete'' as in ``delete it from your -disk forever and ever, never to return again.'' Use with caution. -(@code{gnus-summary-delete-article}). - -@item B m -@kindex B m (Summary) -@cindex move mail -@findex gnus-summary-move-article -Move the article from one mail group to another -(@code{gnus-summary-move-article}). - -@item B c -@kindex B c (Summary) -@cindex copy mail -@findex gnus-summary-copy-article -@c @icon{gnus-summary-mail-copy} -Copy the article from one group (mail group or not) to a mail group -(@code{gnus-summary-copy-article}). - -@item B B -@kindex B B (Summary) -@cindex crosspost mail -@findex gnus-summary-crosspost-article -Crosspost the current article to some other group -(@code{gnus-summary-crosspost-article}). This will create a new copy of -the article in the other group, and the Xref headers of the article will -be properly updated. - -@item B i -@kindex B i (Summary) -@findex gnus-summary-import-article -Import an arbitrary file into the current mail newsgroup -(@code{gnus-summary-import-article}). You will be prompted for a file -name, a @code{From} header and a @code{Subject} header. - -@item B r -@kindex B r (Summary) -@findex gnus-summary-respool-article -Respool the mail article (@code{gnus-summary-move-article}). -@code{gnus-summary-respool-default-method} will be used as the default -select method when respooling. This variable is @code{nil} by default, -which means that the current group select method will be used instead. - -@item B w -@itemx e -@kindex B w (Summary) -@kindex e (Summary) -@findex gnus-summary-edit-article -@kindex C-c C-c (Article) -Edit the current article (@code{gnus-summary-edit-article}). To finish -editing and make the changes permanent, type @kbd{C-c C-c} -(@kbd{gnus-summary-edit-article-done}). If you give a prefix to the -@kbd{C-c C-c} command, Gnus won't re-highlight the article. - -@item B q -@kindex B q (Summary) -@findex gnus-summary-respool-query -If you want to re-spool an article, you might be curious as to what group -the article will end up in before you do the re-spooling. This command -will tell you (@code{gnus-summary-respool-query}). - -@item B p -@kindex B p (Summary) -@findex gnus-summary-article-posted-p -Some people have a tendency to send you "courtesy" copies when they -follow up to articles you have posted. These usually have a -@code{Newsgroups} header in them, but not always. This command -(@code{gnus-summary-article-posted-p}) will try to fetch the current -article from your news server (or rather, from -@code{gnus-refer-article-method} or @code{gnus-select-method}) and will -report back whether it found the article or not. Even if it says that -it didn't find the article, it may have been posted anyway---mail -propagation is much faster than news propagation, and the news copy may -just not have arrived yet. - -@end table - -@vindex gnus-move-split-methods -@cindex moving articles -If you move (or copy) articles regularly, you might wish to have Gnus -suggest where to put the articles. @code{gnus-move-split-methods} is a -variable that uses the same syntax as @code{gnus-split-methods} -(@pxref{Saving Articles}). You may customize that variable to create -suggestions you find reasonable. - -@lisp -(setq gnus-move-split-methods - '(("^From:.*Lars Magne" "nnml:junk") - ("^Subject:.*gnus" "nnfolder:important") - (".*" "nnml:misc"))) -@end lisp - - -@node Various Summary Stuff -@section Various Summary Stuff - -@menu -* Summary Group Information:: Information oriented commands. -* Searching for Articles:: Multiple article commands. -* Summary Generation Commands:: (Re)generating the summary buffer. -* Really Various Summary Commands:: Those pesky non-conformant commands. -@end menu - -@table @code -@vindex gnus-summary-mode-hook -@item gnus-summary-mode-hook -This hook is called when creating a summary mode buffer. - -@vindex gnus-summary-generate-hook -@item gnus-summary-generate-hook -This is called as the last thing before doing the threading and the -generation of the summary buffer. It's quite convenient for customizing -the threading variables based on what data the newsgroup has. This hook -is called from the summary buffer after most summary buffer variables -have been set. - -@vindex gnus-summary-prepare-hook -@item gnus-summary-prepare-hook -It is called after the summary buffer has been generated. You might use -it to, for instance, highlight lines or modify the look of the buffer in -some other ungodly manner. I don't care. - -@vindex gnus-summary-ignore-duplicates -@item gnus-summary-ignore-duplicates -When Gnus discovers two articles that have the same @code{Message-ID}, -it has to do something drastic. No articles are allowed to have the -same @code{Message-ID}, but this may happen when reading mail from some -sources. Gnus allows you to customize what happens with this variable. -If it is @code{nil} (which is the default), Gnus will rename the -@code{Message-ID} (for display purposes only) and display the article as -any other article. If this variable is @code{t}, it won't display the -article---it'll be as if it never existed. - -@end table - - -@node Summary Group Information -@subsection Summary Group Information - -@table @kbd - -@item H f -@kindex H f (Summary) -@findex gnus-summary-fetch-faq -@vindex gnus-group-faq-directory -Try to fetch the FAQ (list of frequently asked questions) for the -current group (@code{gnus-summary-fetch-faq}). Gnus will try to get the -FAQ from @code{gnus-group-faq-directory}, which is usually a directory -on a remote machine. This variable can also be a list of directories. -In that case, giving a prefix to this command will allow you to choose -between the various sites. @code{ange-ftp} or @code{efs} will probably -be used for fetching the file. - -@item H d -@kindex H d (Summary) -@findex gnus-summary-describe-group -Give a brief description of the current group -(@code{gnus-summary-describe-group}). If given a prefix, force -rereading the description from the server. - -@item H h -@kindex H h (Summary) -@findex gnus-summary-describe-briefly -Give an extremely brief description of the most important summary -keystrokes (@code{gnus-summary-describe-briefly}). - -@item H i -@kindex H i (Summary) -@findex gnus-info-find-node -Go to the Gnus info node (@code{gnus-info-find-node}). -@end table - - -@node Searching for Articles -@subsection Searching for Articles - -@table @kbd - -@item M-s -@kindex M-s (Summary) -@findex gnus-summary-search-article-forward -Search through all subsequent articles for a regexp -(@code{gnus-summary-search-article-forward}). - -@item M-r -@kindex M-r (Summary) -@findex gnus-summary-search-article-backward -Search through all previous articles for a regexp -(@code{gnus-summary-search-article-backward}). - -@item & -@kindex & (Summary) -@findex gnus-summary-execute-command -This command will prompt you for a header field, a regular expression to -match on this field, and a command to be executed if the match is made -(@code{gnus-summary-execute-command}). If given a prefix, search -backward instead. - -@item M-& -@kindex M-& (Summary) -@findex gnus-summary-universal-argument -Perform any operation on all articles that have been marked with -the process mark (@code{gnus-summary-universal-argument}). -@end table - -@node Summary Generation Commands -@subsection Summary Generation Commands - -@table @kbd - -@item Y g -@kindex Y g (Summary) -@findex gnus-summary-prepare -Regenerate the current summary buffer (@code{gnus-summary-prepare}). - -@item Y c -@kindex Y c (Summary) -@findex gnus-summary-insert-cached-articles -Pull all cached articles (for the current group) into the summary buffer -(@code{gnus-summary-insert-cached-articles}). - -@end table - - -@node Really Various Summary Commands -@subsection Really Various Summary Commands - -@table @kbd - -@item C-d -@kindex C-d (Summary) -@findex gnus-summary-enter-digest-group -If the current article is a collection of other articles (for instance, -a digest), you might use this command to enter a group based on the that -article (@code{gnus-summary-enter-digest-group}). Gnus will try to -guess what article type is currently displayed unless you give a prefix -to this command, which forces a ``digest'' interpretation. Basically, -whenever you see a message that is a collection of other messages of -some format, you @kbd{C-d} and read these messages in a more convenient -fashion. - -@item M-C-d -@kindex M-C-d (Summary) -@findex gnus-summary-read-document -This command is very similar to the one above, but lets you gather -several documents into one biiig group -(@code{gnus-summary-read-document}). It does this by opening several -@code{nndoc} groups for each document, and then opening an -@code{nnvirtual} group on top of these @code{nndoc} groups. This -command understands the process/prefix convention -(@pxref{Process/Prefix}). - -@item C-t -@kindex C-t (Summary) -@findex gnus-summary-toggle-truncation -Toggle truncation of summary lines -(@code{gnus-summary-toggle-truncation}). This will probably confuse the -line centering function in the summary buffer, so it's not a good idea -to have truncation switched off while reading articles. - -@item = -@kindex = (Summary) -@findex gnus-summary-expand-window -Expand the summary buffer window (@code{gnus-summary-expand-window}). -If given a prefix, force an @code{article} window configuration. - -@item M-C-e -@kindex M-C-e (Summary) -@findex gnus-summary-edit-parameters -Edit the group parameters (@pxref{Group Parameters}) of the current -group (@code{gnus-summary-edit-parameters}). - -@end table - - -@node Exiting the Summary Buffer -@section Exiting the Summary Buffer -@cindex summary exit -@cindex exiting groups - -Exiting from the summary buffer will normally update all info on the -group and return you to the group buffer. - -@table @kbd - -@item Z Z -@itemx q -@kindex Z Z (Summary) -@kindex q (Summary) -@findex gnus-summary-exit -@vindex gnus-summary-exit-hook -@vindex gnus-summary-prepare-exit-hook -@c @icon{gnus-summary-exit} -Exit the current group and update all information on the group -(@code{gnus-summary-exit}). @code{gnus-summary-prepare-exit-hook} is -called before doing much of the exiting, which calls -@code{gnus-summary-expire-articles} by default. -@code{gnus-summary-exit-hook} is called after finishing the exit -process. @code{gnus-group-no-more-groups-hook} is run when returning to -group mode having no more (unread) groups. - -@item Z E -@itemx Q -@kindex Z E (Summary) -@kindex Q (Summary) -@findex gnus-summary-exit-no-update -Exit the current group without updating any information on the group -(@code{gnus-summary-exit-no-update}). - -@item Z c -@itemx c -@kindex Z c (Summary) -@kindex c (Summary) -@findex gnus-summary-catchup-and-exit -@c @icon{gnus-summary-catchup-and-exit} -Mark all unticked articles in the group as read and then exit -(@code{gnus-summary-catchup-and-exit}). - -@item Z C -@kindex Z C (Summary) -@findex gnus-summary-catchup-all-and-exit -Mark all articles, even the ticked ones, as read and then exit -(@code{gnus-summary-catchup-all-and-exit}). - -@item Z n -@kindex Z n (Summary) -@findex gnus-summary-catchup-and-goto-next-group -Mark all articles as read and go to the next group -(@code{gnus-summary-catchup-and-goto-next-group}). - -@item Z R -@kindex Z R (Summary) -@findex gnus-summary-reselect-current-group -Exit this group, and then enter it again -(@code{gnus-summary-reselect-current-group}). If given a prefix, select -all articles, both read and unread. - -@item Z G -@itemx M-g -@kindex Z G (Summary) -@kindex M-g (Summary) -@findex gnus-summary-rescan-group -@c @icon{gnus-summary-mail-get} -Exit the group, check for new articles in the group, and select the -group (@code{gnus-summary-rescan-group}). If given a prefix, select all -articles, both read and unread. - -@item Z N -@kindex Z N (Summary) -@findex gnus-summary-next-group -Exit the group and go to the next group -(@code{gnus-summary-next-group}). - -@item Z P -@kindex Z P (Summary) -@findex gnus-summary-prev-group -Exit the group and go to the previous group -(@code{gnus-summary-prev-group}). - -@item Z s -@kindex Z s (Summary) -@findex gnus-summary-save-newsrc -Save the current number of read/marked articles in the dribble buffer -and then save the dribble buffer (@code{gnus-summary-save-newsrc}). If -given a prefix, also save the @file{.newsrc} file(s). Using this -command will make exit without updating (the @kbd{Q} command) worthless. -@end table - -@vindex gnus-exit-group-hook -@code{gnus-exit-group-hook} is called when you exit the current -group. - -@findex gnus-summary-wake-up-the-dead -@findex gnus-dead-summary-mode -@vindex gnus-kill-summary-on-exit -If you're in the habit of exiting groups, and then changing your mind -about it, you might set @code{gnus-kill-summary-on-exit} to @code{nil}. -If you do that, Gnus won't kill the summary buffer when you exit it. -(Quelle surprise!) Instead it will change the name of the buffer to -something like @samp{*Dead Summary ... *} and install a minor mode -called @code{gnus-dead-summary-mode}. Now, if you switch back to this -buffer, you'll find that all keys are mapped to a function called -@code{gnus-summary-wake-up-the-dead}. So tapping any keys in a dead -summary buffer will result in a live, normal summary buffer. - -There will never be more than one dead summary buffer at any one time. - -@vindex gnus-use-cross-reference -The data on the current group will be updated (which articles you have -read, which articles you have replied to, etc.) when you exit the -summary buffer. If the @code{gnus-use-cross-reference} variable is -@code{t} (which is the default), articles that are cross-referenced to -this group and are marked as read, will also be marked as read in the -other subscribed groups they were cross-posted to. If this variable is -neither @code{nil} nor @code{t}, the article will be marked as read in -both subscribed and unsubscribed groups (@pxref{Crosspost Handling}). - - -@node Crosspost Handling -@section Crosspost Handling - -@cindex velveeta -@cindex spamming -Marking cross-posted articles as read ensures that you'll never have to -read the same article more than once. Unless, of course, somebody has -posted it to several groups separately. Posting the same article to -several groups (not cross-posting) is called @dfn{spamming}, and you are -by law required to send nasty-grams to anyone who perpetrates such a -heinous crime. You may want to try NoCeM handling to filter out spam -(@pxref{NoCeM}). - -Remember: Cross-posting is kinda ok, but posting the same article -separately to several groups is not. Massive cross-posting (aka. -@dfn{velveeta}) is to be avoided at all costs, and you can even use the -@code{gnus-summary-mail-crosspost-complaint} command to complain about -excessive crossposting (@pxref{Summary Mail Commands}). - -@cindex cross-posting -@cindex Xref -@cindex @sc{nov} -One thing that may cause Gnus to not do the cross-posting thing -correctly is if you use an @sc{nntp} server that supports @sc{xover} -(which is very nice, because it speeds things up considerably) which -does not include the @code{Xref} header in its @sc{nov} lines. This is -Evil, but all too common, alas, alack. Gnus tries to Do The Right Thing -even with @sc{xover} by registering the @code{Xref} lines of all -articles you actually read, but if you kill the articles, or just mark -them as read without reading them, Gnus will not get a chance to snoop -the @code{Xref} lines out of these articles, and will be unable to use -the cross reference mechanism. - -@cindex LIST overview.fmt -@cindex overview.fmt -To check whether your @sc{nntp} server includes the @code{Xref} header -in its overview files, try @samp{telnet your.nntp.server nntp}, -@samp{MODE READER} on @code{inn} servers, and then say @samp{LIST -overview.fmt}. This may not work, but if it does, and the last line you -get does not read @samp{Xref:full}, then you should shout and whine at -your news admin until she includes the @code{Xref} header in the -overview files. - -@vindex gnus-nov-is-evil -If you want Gnus to get the @code{Xref}s right all the time, you have to -set @code{gnus-nov-is-evil} to @code{t}, which slows things down -considerably. - -C'est la vie. - -For an alternative approach, @pxref{Duplicate Suppression}. - - -@node Duplicate Suppression -@section Duplicate Suppression - -By default, Gnus tries to make sure that you don't have to read the same -article more than once by utilizing the crossposting mechanism -(@pxref{Crosspost Handling}). However, that simple and efficient -approach may not work satisfactory for some users for various -reasons. - -@enumerate -@item -The @sc{nntp} server may fail to generate the @code{Xref} header. This -is evil and not very common. - -@item -The @sc{nntp} server may fail to include the @code{Xref} header in the -@file{.overview} data bases. This is evil and all too common, alas. - -@item -You may be reading the same group (or several related groups) from -different @sc{nntp} servers. - -@item -You may be getting mail that duplicates articles posted to groups. -@end enumerate - -I'm sure there are other situations where @code{Xref} handling fails as -well, but these four are the most common situations. - -If, and only if, @code{Xref} handling fails for you, then you may -consider switching on @dfn{duplicate suppression}. If you do so, Gnus -will remember the @code{Message-ID}s of all articles you have read or -otherwise marked as read, and then, as if by magic, mark them as read -all subsequent times you see them---in @emph{all} groups. Using this -mechanism is quite likely to be somewhat inefficient, but not overly -so. It's certainly preferable to reading the same articles more than -once. - -Duplicate suppression is not a very subtle instrument. It's more like a -sledge hammer than anything else. It works in a very simple -fashion---if you have marked an article as read, it adds this Message-ID -to a cache. The next time it sees this Message-ID, it will mark the -article as read with the @samp{M} mark. It doesn't care what group it -saw the article in. - -@table @code -@item gnus-suppress-duplicates -@vindex gnus-suppress-duplicates -If non-@code{nil}, suppress duplicates. - -@item gnus-save-duplicate-list -@vindex gnus-save-duplicate-list -If non-@code{nil}, save the list of duplicates to a file. This will -make startup and shutdown take longer, so the default is @code{nil}. -However, this means that only duplicate articles read in a single Gnus -session are suppressed. - -@item gnus-duplicate-list-length -@vindex gnus-duplicate-list-length -This variable says how many @code{Message-ID}s to keep in the duplicate -suppression list. The default is 10000. - -@item gnus-duplicate-file -@vindex gnus-duplicate-file -The name of the file to store the duplicate suppression list in. The -default is @file{~/News/suppression}. -@end table - -If you have a tendency to stop and start Gnus often, setting -@code{gnus-save-duplicate-list} to @code{t} is probably a good idea. If -you leave Gnus running for weeks on end, you may have it @code{nil}. On -the other hand, saving the list makes startup and shutdown much slower, -so that means that if you stop and start Gnus often, you should set -@code{gnus-save-duplicate-list} to @code{nil}. Uhm. I'll leave this up -to you to figure out, I think. - - -@node The Article Buffer -@chapter The Article Buffer -@cindex article buffer - -The articles are displayed in the article buffer, of which there is only -one. All the summary buffers share the same article buffer unless you -tell Gnus otherwise. - -@menu -* Hiding Headers:: Deciding what headers should be displayed. -* Using MIME:: Pushing articles through @sc{mime} before reading them. -* Customizing Articles:: Tailoring the look of the articles. -* Article Keymap:: Keystrokes available in the article buffer. -* Misc Article:: Other stuff. -@end menu - - -@node Hiding Headers -@section Hiding Headers -@cindex hiding headers -@cindex deleting headers - -The top section of each article is the @dfn{head}. (The rest is the -@dfn{body}, but you may have guessed that already.) - -@vindex gnus-show-all-headers -There is a lot of useful information in the head: the name of the person -who wrote the article, the date it was written and the subject of the -article. That's well and nice, but there's also lots of information -most people do not want to see---what systems the article has passed -through before reaching you, the @code{Message-ID}, the -@code{References}, etc. ad nauseum---and you'll probably want to get rid -of some of those lines. If you want to keep all those lines in the -article buffer, you can set @code{gnus-show-all-headers} to @code{t}. - -Gnus provides you with two variables for sifting headers: - -@table @code - -@item gnus-visible-headers -@vindex gnus-visible-headers -If this variable is non-@code{nil}, it should be a regular expression -that says what headers you wish to keep in the article buffer. All -headers that do not match this variable will be hidden. - -For instance, if you only want to see the name of the person who wrote -the article and the subject, you'd say: - -@lisp -(setq gnus-visible-headers "^From:\\|^Subject:") -@end lisp - -This variable can also be a list of regexps to match headers to -remain visible. - -@item gnus-ignored-headers -@vindex gnus-ignored-headers -This variable is the reverse of @code{gnus-visible-headers}. If this -variable is set (and @code{gnus-visible-headers} is @code{nil}), it -should be a regular expression that matches all lines that you want to -hide. All lines that do not match this variable will remain visible. - -For instance, if you just want to get rid of the @code{References} line -and the @code{Xref} line, you might say: - -@lisp -(setq gnus-ignored-headers "^References:\\|^Xref:") -@end lisp - -This variable can also be a list of regexps to match headers to -be removed. - -Note that if @code{gnus-visible-headers} is non-@code{nil}, this -variable will have no effect. - -@end table - -@vindex gnus-sorted-header-list -Gnus can also sort the headers for you. (It does this by default.) You -can control the sorting by setting the @code{gnus-sorted-header-list} -variable. It is a list of regular expressions that says in what order -the headers are to be displayed. - -For instance, if you want the name of the author of the article first, -and then the subject, you might say something like: - -@lisp -(setq gnus-sorted-header-list '("^From:" "^Subject:")) -@end lisp - -Any headers that are to remain visible, but are not listed in this -variable, will be displayed in random order after all the headers listed in this variable. - -@findex gnus-article-hide-boring-headers -@vindex gnus-article-display-hook -@vindex gnus-boring-article-headers -You can hide further boring headers by entering -@code{gnus-article-hide-boring-headers} into -@code{gnus-article-display-hook}. What this function does depends on -the @code{gnus-boring-article-headers} variable. It's a list, but this -list doesn't actually contain header names. Instead is lists various -@dfn{boring conditions} that Gnus can check and remove from sight. - -These conditions are: -@table @code -@item empty -Remove all empty headers. -@item newsgroups -Remove the @code{Newsgroups} header if it only contains the current group -name. -@item followup-to -Remove the @code{Followup-To} header if it is identical to the -@code{Newsgroups} header. -@item reply-to -Remove the @code{Reply-To} header if it lists the same address as the -@code{From} header. -@item date -Remove the @code{Date} header if the article is less than three days -old. -@item long-to -Remove the @code{To} header if it is very long. -@item many-to -Remove all @code{To} headers if there are more than one. -@end table - -To include the four first elements, you could say something like; - -@lisp -(setq gnus-boring-article-headers - '(empty newsgroups followup-to reply-to)) -@end lisp - -This is also the default value for this variable. - - -@node Using MIME -@section Using @sc{mime} -@cindex @sc{mime} - -Mime is a standard for waving your hands through the air, aimlessly, -while people stand around yawning. - -@sc{mime}, however, is a standard for encoding your articles, aimlessly, -while all newsreaders die of fear. - -@sc{mime} may specify what character set the article uses, the encoding -of the characters, and it also makes it possible to embed pictures and -other naughty stuff in innocent-looking articles. - -@vindex gnus-show-mime -@vindex gnus-show-mime-method -@vindex gnus-strict-mime -@findex metamail-buffer -Gnus handles @sc{mime} by pushing the articles through -@code{gnus-show-mime-method}, which is @code{metamail-buffer} by -default. This function calls the external @code{metamail} program to -actually do the work. One common problem with this program is that is -thinks that it can't display 8-bit things in the Emacs buffer. To tell -it the truth, put something like the following in your -@file{.bash_profile} file. (You do use @code{bash}, don't you?) - -@example -export MM_CHARSET="iso-8859-1" -@end example - -For more information on @code{metamail}, see its manual page. - -Set @code{gnus-show-mime} to @code{t} if you want to use -@sc{mime} all the time. However, if @code{gnus-strict-mime} is -non-@code{nil}, the @sc{mime} method will only be used if there are -@sc{mime} headers in the article. If you have @code{gnus-show-mime} -set, then you'll see some unfortunate display glitches in the article -buffer. These can't be avoided. - -It might be best to just use the toggling functions from the summary -buffer to avoid getting nasty surprises. (For instance, you enter the -group @samp{alt.sing-a-long} and, before you know it, @sc{mime} has -decoded the sound file in the article and some horrible sing-a-long song -comes screaming out your speakers, and you can't find the volume -button, because there isn't one, and people are starting to look at you, -and you try to stop the program, but you can't, and you can't find the -program to control the volume, and everybody else in the room suddenly -decides to look at you disdainfully, and you'll feel rather stupid.) - -Any similarity to real events and people is purely coincidental. Ahem. - - -@node Customizing Articles -@section Customizing Articles -@cindex article customization - -@vindex gnus-article-display-hook -The @code{gnus-article-display-hook} is called after the article has -been inserted into the article buffer. It is meant to handle all -treatment of the article before it is displayed. - -@findex gnus-article-maybe-highlight -By default this hook just contains @code{gnus-article-hide-headers}, -@code{gnus-article-treat-overstrike}, and -@code{gnus-article-maybe-highlight}, but there are thousands, nay -millions, of functions you can put in this hook. For an overview of -functions @pxref{Article Highlighting}, @pxref{Article Hiding}, -@pxref{Article Washing}, @pxref{Article Buttons} and @pxref{Article -Date}. Note that the order of functions in this hook might affect -things, so you may have to fiddle a bit to get the desired results. - -You can, of course, write your own functions. The functions are called -from the article buffer, and you can do anything you like, pretty much. -There is no information that you have to keep in the buffer---you can -change everything. However, you shouldn't delete any headers. Instead -make them invisible if you want to make them go away. - - -@node Article Keymap -@section Article Keymap - -Most of the keystrokes in the summary buffer can also be used in the -article buffer. They should behave as if you typed them in the summary -buffer, which means that you don't actually have to have a summary -buffer displayed while reading. You can do it all from the article -buffer. - -A few additional keystrokes are available: - -@table @kbd - -@item SPACE -@kindex SPACE (Article) -@findex gnus-article-next-page -Scroll forwards one page (@code{gnus-article-next-page}). - -@item DEL -@kindex DEL (Article) -@findex gnus-article-prev-page -Scroll backwards one page (@code{gnus-article-prev-page}). - -@item C-c ^ -@kindex C-c ^ (Article) -@findex gnus-article-refer-article -If point is in the neighborhood of a @code{Message-ID} and you press -@kbd{r}, Gnus will try to get that article from the server -(@code{gnus-article-refer-article}). - -@item C-c C-m -@kindex C-c C-m (Article) -@findex gnus-article-mail -Send a reply to the address near point (@code{gnus-article-mail}). If -given a prefix, include the mail. - -@item s -@kindex s (Article) -@findex gnus-article-show-summary -Reconfigure the buffers so that the summary buffer becomes visible -(@code{gnus-article-show-summary}). - -@item ? -@kindex ? (Article) -@findex gnus-article-describe-briefly -Give a very brief description of the available keystrokes -(@code{gnus-article-describe-briefly}). - -@item TAB -@kindex TAB (Article) -@findex gnus-article-next-button -Go to the next button, if any (@code{gnus-article-next-button}). This -only makes sense if you have buttonizing turned on. - -@item M-TAB -@kindex M-TAB (Article) -@findex gnus-article-prev-button -Go to the previous button, if any (@code{gnus-article-prev-button}). - -@end table - - -@node Misc Article -@section Misc Article - -@table @code - -@item gnus-single-article-buffer -@vindex gnus-single-article-buffer -If non-@code{nil}, use the same article buffer for all the groups. -(This is the default.) If @code{nil}, each group will have its own -article buffer. - -@vindex gnus-article-prepare-hook -@item gnus-article-prepare-hook -This hook is called right after the article has been inserted into the -article buffer. It is mainly intended for functions that do something -depending on the contents; it should probably not be used for changing -the contents of the article buffer. - -@vindex gnus-article-display-hook -@item gnus-article-display-hook -This hook is called as the last thing when displaying an article, and is -intended for modifying the contents of the buffer, doing highlights, -hiding headers, and the like. - -@item gnus-article-mode-hook -@vindex gnus-article-mode-hook -Hook called in article mode buffers. - -@item gnus-article-mode-syntax-table -@vindex gnus-article-mode-syntax-table -Syntax table used in article buffers. It is initialized from -@code{text-mode-syntax-table}. - -@vindex gnus-article-mode-line-format -@item gnus-article-mode-line-format -This variable is a format string along the same lines as -@code{gnus-summary-mode-line-format}. It accepts the same -format specifications as that variable, with one extension: - -@table @samp -@item w -The @dfn{wash status} of the article. This is a short string with one -character for each possible article wash operation that may have been -performed. -@end table - -@vindex gnus-break-pages - -@item gnus-break-pages -Controls whether @dfn{page breaking} is to take place. If this variable -is non-@code{nil}, the articles will be divided into pages whenever a -page delimiter appears in the article. If this variable is @code{nil}, -paging will not be done. - -@item gnus-page-delimiter -@vindex gnus-page-delimiter -This is the delimiter mentioned above. By default, it is @samp{^L} -(formfeed). -@end table - - -@node Composing Messages -@chapter Composing Messages -@cindex composing messages -@cindex messages -@cindex mail -@cindex sending mail -@cindex reply -@cindex followup -@cindex post - -@kindex C-c C-c (Post) -All commands for posting and mailing will put you in a message buffer -where you can edit the article all you like, before you send the article -by pressing @kbd{C-c C-c}. @xref{Top, , Top, message, The Message -Manual}. If you are in a foreign news group, and you wish to post the -article using the foreign server, you can give a prefix to @kbd{C-c C-c} -to make Gnus try to post using the foreign server. - -@menu -* Mail:: Mailing and replying. -* Post:: Posting and following up. -* Posting Server:: What server should you post via? -* Mail and Post:: Mailing and posting at the same time. -* Archived Messages:: Where Gnus stores the messages you've sent. -* Drafts:: Postponing messages and rejected messages. -* Rejected Articles:: What happens if the server doesn't like your article? -@end menu - -Also see @pxref{Canceling and Superseding} for information on how to -remove articles you shouldn't have posted. - - -@node Mail -@section Mail - -Variables for customizing outgoing mail: - -@table @code -@item gnus-uu-digest-headers -@vindex gnus-uu-digest-headers -List of regexps to match headers included in digested messages. The -headers will be included in the sequence they are matched. - -@item gnus-add-to-list -@vindex gnus-add-to-list -If non-@code{nil}, add a @code{to-list} group parameter to mail groups -that have none when you do a @kbd{a}. - -@end table - - -@node Post -@section Post - -Variables for composing news articles: - -@table @code -@item gnus-sent-message-ids-file -@vindex gnus-sent-message-ids-file -Gnus will keep a @code{Message-ID} history file of all the mails it has -sent. If it discovers that it has already sent a mail, it will ask the -user whether to re-send the mail. (This is primarily useful when -dealing with @sc{soup} packets and the like where one is apt to send the -same packet multiple times.) This variable says what the name of this -history file is. It is @file{~/News/Sent-Message-IDs} by default. Set -this variable to @code{nil} if you don't want Gnus to keep a history -file. - -@item gnus-sent-message-ids-length -@vindex gnus-sent-message-ids-length -This variable says how many @code{Message-ID}s to keep in the history -file. It is 1000 by default. - -@end table - - -@node Posting Server -@section Posting Server - -When you press those magical @kbd{C-c C-c} keys to ship off your latest -(extremely intelligent, of course) article, where does it go? - -Thank you for asking. I hate you. - -@vindex gnus-post-method - -It can be quite complicated. Normally, Gnus will use the same native -server. However. If your native server doesn't allow posting, just -reading, you probably want to use some other server to post your -(extremely intelligent and fabulously interesting) articles. You can -then set the @code{gnus-post-method} to some other method: - -@lisp -(setq gnus-post-method '(nnspool "")) -@end lisp - -Now, if you've done this, and then this server rejects your article, or -this server is down, what do you do then? To override this variable you -can use a non-zero prefix to the @kbd{C-c C-c} command to force using -the ``current'' server for posting. - -If you give a zero prefix (i.e., @kbd{C-u 0 C-c C-c}) to that command, -Gnus will prompt you for what method to use for posting. - -You can also set @code{gnus-post-method} to a list of select methods. -If that's the case, Gnus will always prompt you for what method to use -for posting. - - -@node Mail and Post -@section Mail and Post - -Here's a list of variables relevant to both mailing and -posting: - -@table @code -@item gnus-mailing-list-groups -@findex gnus-mailing-list-groups -@cindex mailing lists - -If your news server offers groups that are really mailing lists -gatewayed to the @sc{nntp} server, you can read those groups without -problems, but you can't post/followup to them without some difficulty. -One solution is to add a @code{to-address} to the group parameters -(@pxref{Group Parameters}). An easier thing to do is set the -@code{gnus-mailing-list-groups} to a regexp that matches the groups that -really are mailing lists. Then, at least, followups to the mailing -lists will work most of the time. Posting to these groups (@kbd{a}) is -still a pain, though. - -@end table - -You may want to do spell-checking on messages that you send out. Or, if -you don't want to spell-check by hand, you could add automatic -spell-checking via the @code{ispell} package: - -@cindex ispell -@findex ispell-message -@lisp -(add-hook 'message-send-hook 'ispell-message) -@end lisp - - -@node Archived Messages -@section Archived Messages -@cindex archived messages -@cindex sent messages - -Gnus provides a few different methods for storing the mail and news you -send. The default method is to use the @dfn{archive virtual server} to -store the messages. If you want to disable this completely, the -@code{gnus-message-archive-group} variable should be @code{nil}, which -is the default. - -@vindex gnus-message-archive-method -@code{gnus-message-archive-method} says what virtual server Gnus is to -use to store sent messages. The default is: - -@lisp -(nnfolder "archive" - (nnfolder-directory "~/Mail/archive") - (nnfolder-active-file "~/Mail/archive/active") - (nnfolder-get-new-mail nil) - (nnfolder-inhibit-expiry t)) -@end lisp - -You can, however, use any mail select method (@code{nnml}, -@code{nnmbox}, etc.). @code{nnfolder} is a quite likeable select method -for doing this sort of thing, though. If you don't like the default -directory chosen, you could say something like: - -@lisp -(setq gnus-message-archive-method - '(nnfolder "archive" - (nnfolder-inhibit-expiry t) - (nnfolder-active-file "~/News/sent-mail/active") - (nnfolder-directory "~/News/sent-mail/"))) -@end lisp - -@vindex gnus-message-archive-group -@cindex Gcc -Gnus will insert @code{Gcc} headers in all outgoing messages that point -to one or more group(s) on that server. Which group to use is -determined by the @code{gnus-message-archive-group} variable. - -This variable can be used to do the following: - -@itemize @bullet -@item a string -Messages will be saved in that group. -@item a list of strings -Messages will be saved in all those groups. -@item an alist of regexps, functions and forms -When a key ``matches'', the result is used. -@item @code{nil} -No message archiving will take place. This is the default. -@end itemize - -Let's illustrate: - -Just saving to a single group called @samp{MisK}: -@lisp -(setq gnus-message-archive-group "MisK") -@end lisp - -Saving to two groups, @samp{MisK} and @samp{safe}: -@lisp -(setq gnus-message-archive-group '("MisK" "safe")) -@end lisp - -Save to different groups based on what group you are in: -@lisp -(setq gnus-message-archive-group - '(("^alt" "sent-to-alt") - ("mail" "sent-to-mail") - (".*" "sent-to-misc"))) -@end lisp - -More complex stuff: -@lisp -(setq gnus-message-archive-group - '((if (message-news-p) - "misc-news" - "misc-mail"))) -@end lisp - -How about storing all news messages in one file, but storing all mail -messages in one file per month: - -@lisp -(setq gnus-message-archive-group - '((if (message-news-p) - "misc-news" - (concat "mail." (format-time-string - "%Y-%m" (current-time)))))) -@end lisp - -(XEmacs 19.13 doesn't have @code{format-time-string}, so you'll have to -use a different value for @code{gnus-message-archive-group} there.) - -Now, when you send a message off, it will be stored in the appropriate -group. (If you want to disable storing for just one particular message, -you can just remove the @code{Gcc} header that has been inserted.) The -archive group will appear in the group buffer the next time you start -Gnus, or the next time you press @kbd{F} in the group buffer. You can -enter it and read the articles in it just like you'd read any other -group. If the group gets really big and annoying, you can simply rename -if (using @kbd{G r} in the group buffer) to something -nice---@samp{misc-mail-september-1995}, or whatever. New messages will -continue to be stored in the old (now empty) group. - -That's the default method of archiving sent messages. Gnus offers a -different way for the people who don't like the default method. In that -case you should set @code{gnus-message-archive-group} to @code{nil}; -this will disable archiving. - -@table @code -@item gnus-outgoing-message-group -@vindex gnus-outgoing-message-group -All outgoing messages will be put in this group. If you want to store -all your outgoing mail and articles in the group @samp{nnml:archive}, -you set this variable to that value. This variable 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). - -This variable can be used instead of @code{gnus-message-archive-group}, -but the latter is the preferred method. -@end table - - -@c @node Posting Styles -@c @section Posting Styles -@c @cindex posting styles -@c @cindex styles -@c -@c All them variables, they make my head swim. -@c -@c So what if you want a different @code{Organization} and signature based -@c on what groups you post to? And you post both from your home machine -@c and your work machine, and you want different @code{From} lines, and so -@c on? -@c -@c @vindex gnus-posting-styles -@c One way to do stuff like that is to write clever hooks that change the -@c variables you need to have changed. That's a bit boring, so somebody -@c came up with the bright idea of letting the user specify these things in -@c a handy alist. Here's an example of a @code{gnus-posting-styles} -@c variable: -@c -@c @lisp -@c ((".*" -@c (signature . "Peace and happiness") -@c (organization . "What me?")) -@c ("^comp" -@c (signature . "Death to everybody")) -@c ("comp.emacs.i-love-it" -@c (organization . "Emacs is it"))) -@c @end lisp -@c -@c As you might surmise from this example, this alist consists of several -@c @dfn{styles}. Each style will be applicable if the first element -@c ``matches'', in some form or other. The entire alist will be iterated -@c over, from the beginning towards the end, and each match will be -@c applied, which means that attributes in later styles that match override -@c the same attributes in earlier matching styles. So -@c @samp{comp.programming.literate} will have the @samp{Death to everybody} -@c signature and the @samp{What me?} @code{Organization} header. -@c -@c The first element in each style is called the @code{match}. If it's a -@c string, then Gnus will try to regexp match it against the group name. -@c If it's a function symbol, that function will be called with no -@c arguments. If it's a variable symbol, then the variable will be -@c referenced. If it's a list, then that list will be @code{eval}ed. In -@c any case, if this returns a non-@code{nil} value, then the style is said -@c to @dfn{match}. -@c -@c Each style may contain a arbitrary amount of @dfn{attributes}. Each -@c attribute consists of a @var{(name . value)} pair. The attribute name -@c can be one of @code{signature}, @code{organization} or @code{from}. The -@c attribute name can also be a string. In that case, this will be used as -@c a header name, and the value will be inserted in the headers of the -@c article. -@c -@c The attribute value can be a string (used verbatim), a function (the -@c return value will be used), a variable (its value will be used) or a -@c list (it will be @code{eval}ed and the return value will be used). -@c -@c So here's a new example: -@c -@c @lisp -@c (setq gnus-posting-styles -@c '((".*" -@c (signature . "~/.signature") -@c (from . "user@@foo (user)") -@c ("X-Home-Page" . (getenv "WWW_HOME")) -@c (organization . "People's Front Against MWM")) -@c ("^rec.humor" -@c (signature . my-funny-signature-randomizer)) -@c ((equal (system-name) "gnarly") -@c (signature . my-quote-randomizer)) -@c (posting-from-work-p -@c (signature . "~/.work-signature") -@c (from . "user@@bar.foo (user)") -@c (organization . "Important Work, Inc")) -@c ("^nn.+:" -@c (signature . "~/.mail-signature")))) -@c @end lisp - -@node Drafts -@section Drafts -@cindex drafts - -If you are writing a message (mail or news) and suddenly remember that -you have a steak in the oven (or some pesto in the food processor, you -craaazy vegetarians), you'll probably wish there was a method to save -the message you are writing so that you can continue editing it some -other day, and send it when you feel its finished. - -Well, don't worry about it. Whenever you start composing a message of -some sort using the Gnus mail and post commands, the buffer you get will -automatically associate to an article in a special @dfn{draft} group. -If you save the buffer the normal way (@kbd{C-x C-s}, for instance), the -article will be saved there. (Auto-save files also go to the draft -group.) - -@cindex nndraft -@vindex nndraft-directory -The draft group is a special group (which is implemented as an -@code{nndraft} group, if you absolutely have to know) called -@samp{nndraft:drafts}. The variable @code{nndraft-directory} says where -@code{nndraft} is to store its files. What makes this group special is -that you can't tick any articles in it or mark any articles as -read---all articles in the group are permanently unread. - -If the group doesn't exist, it will be created and you'll be subscribed -to it. The only way to make it disappear from the Group buffer is to -unsubscribe it. - -@c @findex gnus-dissociate-buffer-from-draft -@c @kindex C-c M-d (Mail) -@c @kindex C-c M-d (Post) -@c @findex gnus-associate-buffer-with-draft -@c @kindex C-c C-d (Mail) -@c @kindex C-c C-d (Post) -@c If you're writing some super-secret message that you later want to -@c encode with PGP before sending, you may wish to turn the auto-saving -@c (and association with the draft group) off. You never know who might be -@c interested in reading all your extremely valuable and terribly horrible -@c and interesting secrets. The @kbd{C-c M-d} -@c (@code{gnus-dissociate-buffer-from-draft}) command does that for you. -@c If you change your mind and want to turn the auto-saving back on again, -@c @kbd{C-c C-d} (@code{gnus-associate-buffer-with-draft} does that. -@c -@c @vindex gnus-use-draft -@c To leave association with the draft group off by default, set -@c @code{gnus-use-draft} to @code{nil}. It is @code{t} by default. - -@findex gnus-draft-edit-message -@kindex D e (Draft) -When you want to continue editing the article, you simply enter the -draft group and push @kbd{D e} (@code{gnus-draft-edit-message}) to do -that. You will be placed in a buffer where you left off. - -Rejected articles will also be put in this draft group (@pxref{Rejected -Articles}). - -@findex gnus-draft-send-all-messages -@findex gnus-draft-send-message -If you have lots of rejected messages you want to post (or mail) without -doing further editing, you can use the @kbd{D s} command -(@code{gnus-draft-send-message}). This command understands the -process/prefix convention (@pxref{Process/Prefix}). The @kbd{D S} -command (@code{gnus-draft-send-all-messages}) will ship off all messages -in the buffer. - -If you have some messages that you wish not to send, you can use the -@kbd{D t} (@code{gnus-draft-toggle-sending}) command to mark the message -as unsendable. This is a toggling command. - - -@node Rejected Articles -@section Rejected Articles -@cindex rejected articles - -Sometimes a news server will reject an article. Perhaps the server -doesn't like your face. Perhaps it just feels miserable. Perhaps -@emph{there be demons}. Perhaps you have included too much cited text. -Perhaps the disk is full. Perhaps the server is down. - -These situations are, of course, totally beyond the control of Gnus. -(Gnus, of course, loves the way you look, always feels great, has angels -fluttering around inside of it, doesn't care about how much cited text -you include, never runs full and never goes down.) So Gnus saves these -articles until some later time when the server feels better. - -The rejected articles will automatically be put in a special draft group -(@pxref{Drafts}). When the server comes back up again, you'd then -typically enter that group and send all the articles off. - - -@node Select Methods -@chapter Select Methods -@cindex foreign groups -@cindex select methods - -A @dfn{foreign group} is a group not read by the usual (or -default) means. It could be, for instance, a group from a different -@sc{nntp} server, it could be a virtual group, or it could be your own -personal mail group. - -A foreign group (or any group, really) is specified by a @dfn{name} and -a @dfn{select method}. To take the latter first, a select method is a -list where the first element says what backend to use (e.g. @code{nntp}, -@code{nnspool}, @code{nnml}) and the second element is the @dfn{server -name}. There may be additional elements in the select method, where the -value may have special meaning for the backend in question. - -One could say that a select method defines a @dfn{virtual server}---so -we do just that (@pxref{The Server Buffer}). - -The @dfn{name} of the group is the name the backend will recognize the -group as. - -For instance, the group @samp{soc.motss} on the @sc{nntp} server -@samp{some.where.edu} will have the name @samp{soc.motss} and select -method @code{(nntp "some.where.edu")}. Gnus will call this group -@samp{nntp+some.where.edu:soc.motss}, even though the @code{nntp} -backend just knows this group as @samp{soc.motss}. - -The different methods all have their peculiarities, of course. - -@menu -* The Server Buffer:: Making and editing virtual servers. -* Getting News:: Reading USENET news with Gnus. -* Getting Mail:: Reading your personal mail with Gnus. -* Other Sources:: Reading directories, files, SOUP packets. -* Combined Groups:: Combining groups into one group. -* Gnus Unplugged:: Reading news and mail offline. -@end menu - - -@node The Server Buffer -@section The Server Buffer - -Traditionally, a @dfn{server} is a machine or a piece of software that -one connects to, and then requests information from. Gnus does not -connect directly to any real servers, but does all transactions through -one backend or other. But that's just putting one layer more between -the actual media and Gnus, so we might just as well say that each -backend represents a virtual server. - -For instance, the @code{nntp} backend may be used to connect to several -different actual @sc{nntp} servers, or, perhaps, to many different ports -on the same actual @sc{nntp} server. You tell Gnus which backend to -use, and what parameters to set by specifying a @dfn{select method}. - -These select method specifications can sometimes become quite -complicated---say, for instance, that you want to read from the -@sc{nntp} server @samp{news.funet.fi} on port number 13, which -hangs if queried for @sc{nov} headers and has a buggy select. Ahem. -Anyways, if you had to specify that for each group that used this -server, that would be too much work, so Gnus offers a way of naming -select methods, which is what you do in the server buffer. - -To enter the server buffer, use the @kbd{^} -(@code{gnus-group-enter-server-mode}) command in the group buffer. - -@menu -* Server Buffer Format:: You can customize the look of this buffer. -* Server Commands:: Commands to manipulate servers. -* Example Methods:: Examples server specifications. -* Creating a Virtual Server:: An example session. -* Server Variables:: Which variables to set. -* Servers and Methods:: You can use server names as select methods. -* Unavailable Servers:: Some servers you try to contact may be down. -@end menu - -@vindex gnus-server-mode-hook -@code{gnus-server-mode-hook} is run when creating the server buffer. - - -@node Server Buffer Format -@subsection Server Buffer Format -@cindex server buffer format - -@vindex gnus-server-line-format -You can change the look of the server buffer lines by changing the -@code{gnus-server-line-format} variable. This is a @code{format}-like -variable, with some simple extensions: - -@table @samp - -@item h -How the news is fetched---the backend name. - -@item n -The name of this server. - -@item w -Where the news is to be fetched from---the address. - -@item s -The opened/closed/denied status of the server. -@end table - -@vindex gnus-server-mode-line-format -The mode line can also be customized by using the -@code{gnus-server-mode-line-format} variable. The following specs are -understood: - -@table @samp -@item S -Server name. - -@item M -Server method. -@end table - -Also @pxref{Formatting Variables}. - - -@node Server Commands -@subsection Server Commands -@cindex server commands - -@table @kbd - -@item a -@kindex a (Server) -@findex gnus-server-add-server -Add a new server (@code{gnus-server-add-server}). - -@item e -@kindex e (Server) -@findex gnus-server-edit-server -Edit a server (@code{gnus-server-edit-server}). - -@item SPACE -@kindex SPACE (Server) -@findex gnus-server-read-server -Browse the current server (@code{gnus-server-read-server}). - -@item q -@kindex q (Server) -@findex gnus-server-exit -Return to the group buffer (@code{gnus-server-exit}). - -@item k -@kindex k (Server) -@findex gnus-server-kill-server -Kill the current server (@code{gnus-server-kill-server}). - -@item y -@kindex y (Server) -@findex gnus-server-yank-server -Yank the previously killed server (@code{gnus-server-yank-server}). - -@item c -@kindex c (Server) -@findex gnus-server-copy-server -Copy the current server (@code{gnus-server-copy-server}). - -@item l -@kindex l (Server) -@findex gnus-server-list-servers -List all servers (@code{gnus-server-list-servers}). - -@item s -@kindex s (Server) -@findex gnus-server-scan-server -Request that the server scan its sources for new articles -(@code{gnus-server-scan-server}). This is mainly sensible with mail -servers. - -@item g -@kindex g (Server) -@findex gnus-server-regenerate-server -Request that the server regenerate all its data structures -(@code{gnus-server-regenerate-server}). This can be useful if you have -a mail backend that has gotten out of synch. - -@end table - - -@node Example Methods -@subsection Example Methods - -Most select methods are pretty simple and self-explanatory: - -@lisp -(nntp "news.funet.fi") -@end lisp - -Reading directly from the spool is even simpler: - -@lisp -(nnspool "") -@end lisp - -As you can see, the first element in a select method is the name of the -backend, and the second is the @dfn{address}, or @dfn{name}, if you -will. - -After these two elements, there may be an arbitrary number of -@var{(variable form)} pairs. - -To go back to the first example---imagine that you want to read from -port 15 on that machine. This is what the select method should -look like then: - -@lisp -(nntp "news.funet.fi" (nntp-port-number 15)) -@end lisp - -You should read the documentation to each backend to find out what -variables are relevant, but here's an @code{nnmh} example: - -@code{nnmh} is a mail backend that reads a spool-like structure. Say -you have two structures that you wish to access: One is your private -mail spool, and the other is a public one. Here's the possible spec for -your private mail: - -@lisp -(nnmh "private" (nnmh-directory "~/private/mail/")) -@end lisp - -(This server is then called @samp{private}, but you may have guessed -that.) - -Here's the method for a public spool: - -@lisp -(nnmh "public" - (nnmh-directory "/usr/information/spool/") - (nnmh-get-new-mail nil)) -@end lisp - -If you are behind a firewall and only have access to the @sc{nntp} -server from the firewall machine, you can instruct Gnus to @code{rlogin} -on the firewall machine and telnet from there to the @sc{nntp} server. -Doing this can be rather fiddly, but your virtual server definition -should probably look something like this: - -@lisp -(nntp "firewall" - (nntp-address "the.firewall.machine") - (nntp-open-connection-function nntp-open-rlogin) - (nntp-end-of-line "\n") - (nntp-rlogin-parameters - ("telnet" "the.real.nntp.host" "nntp"))) -@end lisp - - - -@node Creating a Virtual Server -@subsection Creating a Virtual Server - -If you're saving lots of articles in the cache by using persistent -articles, you may want to create a virtual server to read the cache. - -First you need to add a new server. The @kbd{a} command does that. It -would probably be best to use @code{nnspool} to read the cache. You -could also use @code{nnml} or @code{nnmh}, though. - -Type @kbd{a nnspool RET cache RET}. - -You should now have a brand new @code{nnspool} virtual server called -@samp{cache}. You now need to edit it to have the right definitions. -Type @kbd{e} to edit the server. You'll be entered into a buffer that -will contain the following: - -@lisp -(nnspool "cache") -@end lisp - -Change that to: - -@lisp -(nnspool "cache" - (nnspool-spool-directory "~/News/cache/") - (nnspool-nov-directory "~/News/cache/") - (nnspool-active-file "~/News/cache/active")) -@end lisp - -Type @kbd{C-c C-c} to return to the server buffer. If you now press -@kbd{RET} over this virtual server, you should be entered into a browse -buffer, and you should be able to enter any of the groups displayed. - - -@node Server Variables -@subsection Server Variables - -One sticky point when defining variables (both on backends and in Emacs -in general) is that some variables are typically initialized from other -variables when the definition of the variables is being loaded. If you -change the "base" variable after the variables have been loaded, you -won't change the "derived" variables. - -This typically affects directory and file variables. For instance, -@code{nnml-directory} is @file{~/Mail/} by default, and all @code{nnml} -directory variables are initialized from that variable, so -@code{nnml-active-file} will be @file{~/Mail/active}. If you define a -new virtual @code{nnml} server, it will @emph{not} suffice to set just -@code{nnml-directory}---you have to explicitly set all the file -variables to be what you want them to be. For a complete list of -variables for each backend, see each backend's section later in this -manual, but here's an example @code{nnml} definition: - -@lisp -(nnml "public" - (nnml-directory "~/my-mail/") - (nnml-active-file "~/my-mail/active") - (nnml-newsgroups-file "~/my-mail/newsgroups")) -@end lisp - - -@node Servers and Methods -@subsection Servers and Methods - -Wherever you would normally use a select method -(e.g. @code{gnus-secondary-select-method}, in the group select method, -when browsing a foreign server) you can use a virtual server name -instead. This could potentially save lots of typing. And it's nice all -over. - - -@node Unavailable Servers -@subsection Unavailable Servers - -If a server seems to be unreachable, Gnus will mark that server as -@code{denied}. That means that any subsequent attempt to make contact -with that server will just be ignored. ``It can't be opened,'' Gnus -will tell you, without making the least effort to see whether that is -actually the case or not. - -That might seem quite naughty, but it does make sense most of the time. -Let's say you have 10 groups subscribed to on server -@samp{nephelococcygia.com}. This server is located somewhere quite far -away from you and the machine is quite slow, so it takes 1 minute just -to find out that it refuses connection to you today. If Gnus were to -attempt to do that 10 times, you'd be quite annoyed, so Gnus won't -attempt to do that. Once it has gotten a single ``connection refused'', -it will regard that server as ``down''. - -So, what happens if the machine was only feeling unwell temporarily? -How do you test to see whether the machine has come up again? - -You jump to the server buffer (@pxref{The Server Buffer}) and poke it -with the following commands: - -@table @kbd - -@item O -@kindex O (Server) -@findex gnus-server-open-server -Try to establish connection to the server on the current line -(@code{gnus-server-open-server}). - -@item C -@kindex C (Server) -@findex gnus-server-close-server -Close the connection (if any) to the server -(@code{gnus-server-close-server}). - -@item D -@kindex D (Server) -@findex gnus-server-deny-server -Mark the current server as unreachable -(@code{gnus-server-deny-server}). - -@item M-o -@kindex M-o (Server) -@findex gnus-server-open-all-servers -Open the connections to all servers in the buffer -(@code{gnus-server-open-all-servers}). - -@item M-c -@kindex M-c (Server) -@findex gnus-server-close-all-servers -Close the connections to all servers in the buffer -(@code{gnus-server-close-all-servers}). - -@item R -@kindex R (Server) -@findex gnus-server-remove-denials -Remove all marks to whether Gnus was denied connection from any servers -(@code{gnus-server-remove-denials}). - -@end table - - -@node Getting News -@section Getting News -@cindex reading news -@cindex news backends - -A newsreader is normally used for reading news. Gnus currently provides -only two methods of getting news---it can read from an @sc{nntp} server, -or it can read from a local spool. - -@menu -* NNTP:: Reading news from an @sc{nntp} server. -* News Spool:: Reading news from the local spool. -@end menu - - -@node NNTP -@subsection @sc{nntp} -@cindex nntp - -Subscribing to a foreign group from an @sc{nntp} server is rather easy. -You just specify @code{nntp} as method and the address of the @sc{nntp} -server as the, uhm, address. - -If the @sc{nntp} server is located at a non-standard port, setting the -third element of the select method to this port number should allow you -to connect to the right port. You'll have to edit the group info for -that (@pxref{Foreign Groups}). - -The name of the foreign group can be the same as a native group. In -fact, you can subscribe to the same group from as many different servers -you feel like. There will be no name collisions. - -The following variables can be used to create a virtual @code{nntp} -server: - -@table @code - -@item nntp-server-opened-hook -@vindex nntp-server-opened-hook -@cindex @sc{mode reader} -@cindex authinfo -@cindex authentification -@cindex nntp authentification -@findex nntp-send-authinfo -@findex nntp-send-mode-reader -is run after a connection has been made. It can be used to send -commands to the @sc{nntp} server after it has been contacted. By -default it sends the command @code{MODE READER} to the server with the -@code{nntp-send-mode-reader} function. This function should always be -present in this hook. - -@item nntp-authinfo-function -@vindex nntp-authinfo-function -@findex nntp-send-authinfo -@vindex nntp-netrc-file -This function will be used to send @samp{AUTHINFO} to the @sc{nntp} -server. The default function is @code{nntp-send-authinfo}, which looks -through your @file{~/.netrc} (or whatever you've set the -@code{nntp-netrc-file} variable to) for applicable entries. If none are -found, it will prompt you for a login name and a password. The format -of the @file{~/.netrc} file is defined in the @code{ftp} manual page, -but here are the salient facts: - -@enumerate -@item -The file contains one or more line, each of which define one server. - -@item -Each line may contain an arbitrary number of token/value pairs. The -valid tokens include @samp{machine}, @samp{login}, and @samp{password}. - -@end enumerate - -Here's an example file: - -@example -machine news.uio.no login larsi password geheimnis -machine nntp.ifi.uio.no login larsi -@end example - -The token/value pairs may appear in any order; @samp{machine} doesn't -have to be first, for instance. - -In this example, both login name and password have been supplied for the -former server, while the latter has only the login name listed, and the -user will be prompted for the password. - -Remember to not leave the @file{~/.netrc} world-readable. - -@item nntp-server-action-alist -@vindex nntp-server-action-alist -This is a list of regexps to match on server types and actions to be -taken when matches are made. For instance, if you want Gnus to beep -every time you connect to innd, you could say something like: - -@lisp -(setq nntp-server-action-alist - '(("innd" (ding)))) -@end lisp - -You probably don't want to do that, though. - -The default value is - -@lisp -'(("nntpd 1\\.5\\.11t" - (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader))) -@end lisp - -This ensures that Gnus doesn't send the @code{MODE READER} command to -nntpd 1.5.11t, since that command chokes that server, I've been told. - -@item nntp-maximum-request -@vindex nntp-maximum-request -If the @sc{nntp} server doesn't support @sc{nov} headers, this backend -will collect headers by sending a series of @code{head} commands. To -speed things up, the backend sends lots of these commands without -waiting for reply, and then reads all the replies. This is controlled -by the @code{nntp-maximum-request} variable, and is 400 by default. If -your network is buggy, you should set this to 1. - -@item nntp-connection-timeout -@vindex nntp-connection-timeout -If you have lots of foreign @code{nntp} groups that you connect to -regularly, you're sure to have problems with @sc{nntp} servers not -responding properly, or being too loaded to reply within reasonable -time. This is can lead to awkward problems, which can be helped -somewhat by setting @code{nntp-connection-timeout}. This is an integer -that says how many seconds the @code{nntp} backend should wait for a -connection before giving up. If it is @code{nil}, which is the default, -no timeouts are done. - -@c @item nntp-command-timeout -@c @vindex nntp-command-timeout -@c @cindex PPP connections -@c @cindex dynamic IP addresses -@c If you're running Gnus on a machine that has a dynamically assigned -@c address, Gnus may become confused. If the address of your machine -@c changes after connecting to the @sc{nntp} server, Gnus will simply sit -@c waiting forever for replies from the server. To help with this -@c unfortunate problem, you can set this command to a number. Gnus will -@c then, if it sits waiting for a reply from the server longer than that -@c number of seconds, shut down the connection, start a new one, and resend -@c the command. This should hopefully be transparent to the user. A -@c likely number is 30 seconds. -@c -@c @item nntp-retry-on-break -@c @vindex nntp-retry-on-break -@c If this variable is non-@code{nil}, you can also @kbd{C-g} if Gnus -@c hangs. This will have much the same effect as the command timeout -@c described above. - -@item nntp-server-hook -@vindex nntp-server-hook -This hook is run as the last step when connecting to an @sc{nntp} -server. - -@findex nntp-open-rlogin -@findex nntp-open-telnet -@findex nntp-open-network-stream -@item nntp-open-connection-function -@vindex nntp-open-connection-function -This function is used to connect to the remote system. Three pre-made -functions are @code{nntp-open-network-stream}, which is the default, and -simply connects to some port or other on the remote system. The other -two are @code{nntp-open-rlogin}, which does an @samp{rlogin} on the -remote system, and then does a @samp{telnet} to the @sc{nntp} server -available there, and @code{nntp-open-telnet}, which does a @samp{telnet} -to the remote system and then another @samp{telnet} to get to the -@sc{nntp} server. - -@code{nntp-open-rlogin}-related variables: - -@table @code - -@item nntp-rlogin-program -@vindex nntp-rlogin-program -Program used to log in on remote machines. The default is @samp{rsh}, -but @samp{ssh} is a popular alternative. - -@item nntp-rlogin-parameters -@vindex nntp-rlogin-parameters -This list will be used as the parameter list given to @code{rsh}. - -@item nntp-rlogin-user-name -@vindex nntp-rlogin-user-name -User name on the remote system. - -@end table - -@code{nntp-open-telnet}-related variables: - -@table @code -@item nntp-telnet-command -@vindex nntp-telnet-command -Command used to start @code{telnet}. - -@item nntp-telnet-switches -@vindex nntp-telnet-switches -List of strings to be used as the switches to the @code{telnet} command. - -@item nntp-telnet-user-name -@vindex nntp-telnet-user-name -User name for log in on the remote system. - -@item nntp-telnet-passwd -@vindex nntp-telnet-passwd -Password to use when logging in. - -@item nntp-telnet-parameters -@vindex nntp-telnet-parameters -A list of strings executed as a command after logging in -via @code{telnet}. - -@item nntp-telnet-shell-prompt -@vindex nntp-telnet-shell-prompt -Regexp matching the shell prompt on the remote machine. The default is -@samp{bash\\|\$ *\r?$\\|> *\r?}. - -@item nntp-open-telnet-envuser -@vindex nntp-open-telnet-envuser -If non-@code{nil}, the @code{telnet} session (client and server both) -will support the @code{ENVIRON} option and not prompt for login name. -This works for Solaris @code{telnet}, for instance. - -@end table - -@item nntp-end-of-line -@vindex nntp-end-of-line -String to use as end-of-line marker when talking to the @sc{nntp} -server. This is @samp{\r\n} by default, but should be @samp{\n} when -using @code{rlogin} to talk to the server. - -@item nntp-rlogin-user-name -@vindex nntp-rlogin-user-name -User name on the remote system when using the @code{rlogin} connect -function. - -@item nntp-address -@vindex nntp-address -The address of the remote system running the @sc{nntp} server. - -@item nntp-port-number -@vindex nntp-port-number -Port number to connect to when using the @code{nntp-open-network-stream} -connect function. - -@item nntp-buggy-select -@vindex nntp-buggy-select -Set this to non-@code{nil} if your select routine is buggy. - -@item nntp-nov-is-evil -@vindex nntp-nov-is-evil -If the @sc{nntp} server does not support @sc{nov}, you could set this -variable to @code{t}, but @code{nntp} usually checks automatically whether @sc{nov} -can be used. - -@item nntp-xover-commands -@vindex nntp-xover-commands -@cindex nov -@cindex XOVER -List of strings used as commands to fetch @sc{nov} lines from a -server. The default value of this variable is @code{("XOVER" -"XOVERVIEW")}. - -@item nntp-nov-gap -@vindex nntp-nov-gap -@code{nntp} normally sends just one big request for @sc{nov} lines to -the server. The server responds with one huge list of lines. However, -if you have read articles 2-5000 in the group, and only want to read -article 1 and 5001, that means that @code{nntp} will fetch 4999 @sc{nov} -lines that you will not need. This variable says how -big a gap between two consecutive articles is allowed to be before the -@code{XOVER} request is split into several request. Note that if your -network is fast, setting this variable to a really small number means -that fetching will probably be slower. If this variable is @code{nil}, -@code{nntp} will never split requests. The default is 5. - -@item nntp-prepare-server-hook -@vindex nntp-prepare-server-hook -A hook run before attempting to connect to an @sc{nntp} server. - -@item nntp-warn-about-losing-connection -@vindex nntp-warn-about-losing-connection -If this variable is non-@code{nil}, some noise will be made when a -server closes connection. - -@end table - - -@node News Spool -@subsection News Spool -@cindex nnspool -@cindex news spool - -Subscribing to a foreign group from the local spool is extremely easy, -and might be useful, for instance, to speed up reading groups that -contain very big articles---@samp{alt.binaries.pictures.furniture}, for -instance. - -Anyways, you just specify @code{nnspool} as the method and @code{""} (or -anything else) as the address. - -If you have access to a local spool, you should probably use that as the -native select method (@pxref{Finding the News}). It is normally faster -than using an @code{nntp} select method, but might not be. It depends. -You just have to try to find out what's best at your site. - -@table @code - -@item nnspool-inews-program -@vindex nnspool-inews-program -Program used to post an article. - -@item nnspool-inews-switches -@vindex nnspool-inews-switches -Parameters given to the inews program when posting an article. - -@item nnspool-spool-directory -@vindex nnspool-spool-directory -Where @code{nnspool} looks for the articles. This is normally -@file{/usr/spool/news/}. - -@item nnspool-nov-directory -@vindex nnspool-nov-directory -Where @code{nnspool} will look for @sc{nov} files. This is normally -@file{/usr/spool/news/over.view/}. - -@item nnspool-lib-dir -@vindex nnspool-lib-dir -Where the news lib dir is (@file{/usr/lib/news/} by default). - -@item nnspool-active-file -@vindex nnspool-active-file -The path to the active file. - -@item nnspool-newsgroups-file -@vindex nnspool-newsgroups-file -The path to the group descriptions file. - -@item nnspool-history-file -@vindex nnspool-history-file -The path to the news history file. - -@item nnspool-active-times-file -@vindex nnspool-active-times-file -The path to the active date file. - -@item nnspool-nov-is-evil -@vindex nnspool-nov-is-evil -If non-@code{nil}, @code{nnspool} won't try to use any @sc{nov} files -that it finds. - -@item nnspool-sift-nov-with-sed -@vindex nnspool-sift-nov-with-sed -@cindex sed -If non-@code{nil}, which is the default, use @code{sed} to get the -relevant portion from the overview file. If nil, @code{nnspool} will -load the entire file into a buffer and process it there. - -@end table - - -@node Getting Mail -@section Getting Mail -@cindex reading mail -@cindex mail - -Reading mail with a newsreader---isn't that just plain WeIrD? But of -course. - -@menu -* Getting Started Reading Mail:: A simple cookbook example. -* Splitting Mail:: How to create mail groups. -* Mail Backend Variables:: Variables for customizing mail handling. -* Fancy Mail Splitting:: Gnus can do hairy splitting of incoming mail. -* Mail and Procmail:: Reading mail groups that procmail create. -* Incorporating Old Mail:: What about the old mail you have? -* Expiring Mail:: Getting rid of unwanted mail. -* Washing Mail:: Removing gruft from the mail you get. -* Duplicates:: Dealing with duplicated mail. -* Not Reading Mail:: Using mail backends for reading other files. -* Choosing a Mail Backend:: Gnus can read a variety of mail formats. -@end menu - - -@node Getting Started Reading Mail -@subsection Getting Started Reading Mail - -It's quite easy to use Gnus to read your new mail. You just plonk the -mail backend of your choice into @code{gnus-secondary-select-methods}, -and things will happen automatically. - -For instance, if you want to use @code{nnml} (which is a "one file per -mail" backend), you could put the following in your @file{.gnus} file: - -@lisp -(setq gnus-secondary-select-methods - '((nnml "private"))) -@end lisp - -Now, the next time you start Gnus, this backend will be queried for new -articles, and it will move all the messages in your spool file to its -directory, which is @code{~/Mail/} by default. The new group that will -be created (@samp{mail.misc}) will be subscribed, and you can read it -like any other group. - -You will probably want to split the mail into several groups, though: - -@lisp -(setq nnmail-split-methods - '(("junk" "^From:.*Lars Ingebrigtsen") - ("crazy" "^Subject:.*die\\|^Organization:.*flabby") - ("other" ""))) -@end lisp - -This will result in three new @code{nnml} mail groups being created: -@samp{nnml:junk}, @samp{nnml:crazy}, and @samp{nnml:other}. All the -mail that doesn't fit into the first two groups will be placed in the -last group. - -This should be sufficient for reading mail with Gnus. You might want to -give the other sections in this part of the manual a perusal, though. -Especially @pxref{Choosing a Mail Backend} and @pxref{Expiring Mail}. - - -@node Splitting Mail -@subsection Splitting Mail -@cindex splitting mail -@cindex mail splitting - -@vindex nnmail-split-methods -The @code{nnmail-split-methods} variable says how the incoming mail is -to be split into groups. - -@lisp -(setq nnmail-split-methods - '(("mail.junk" "^From:.*Lars Ingebrigtsen") - ("mail.crazy" "^Subject:.*die\\|^Organization:.*flabby") - ("mail.other" ""))) -@end lisp - -This variable is a list of lists, where the first element of each of -these lists is the name of the mail group (they do not have to be called -something beginning with @samp{mail}, by the way), and the second -element is a regular expression used on the header of each mail to -determine if it belongs in this mail group. The first string may -contain @samp{\\1} forms, like the ones used by @code{replace-match} to -insert sub-expressions from the matched text. For instance: - -@lisp -("list.\\1" "From:.*\\(.*\\)-list@@majordomo.com") -@end lisp - -If the first element is the special symbol @code{junk}, then messages -that match the regexp will disappear into the aether. Use with -extreme caution. - -The second element can also be a function. In that case, it will be -called narrowed to the headers with the first element of the rule as the -argument. It should return a non-@code{nil} value if it thinks that the -mail belongs in that group. - -The last of these groups should always be a general one, and the regular -expression should @emph{always} be @samp{} so that it matches any mails -that haven't been matched by any of the other regexps. (These rules are -processed from the beginning of the alist toward the end. The first -rule to make a match will "win", unless you have crossposting enabled. -In that case, all matching rules will "win".) - -If you like to tinker with this yourself, you can set this variable to a -function of your choice. This function will be called without any -arguments in a buffer narrowed to the headers of an incoming mail -message. The function should return a list of group names that it -thinks should carry this mail message. - -Note that the mail backends are free to maul the poor, innocent, -incoming headers all they want to. They all add @code{Lines} headers; -some add @code{X-Gnus-Group} headers; most rename the Unix mbox -@code{From} line to something else. - -@vindex nnmail-crosspost -The mail backends all support cross-posting. If several regexps match, -the mail will be ``cross-posted'' to all those groups. -@code{nnmail-crosspost} says whether to use this mechanism or not. Note -that no articles are crossposted to the general (@samp{}) group. - -@vindex nnmail-crosspost-link-function -@cindex crosspost -@cindex links -@code{nnmh} and @code{nnml} makes crossposts by creating hard links to -the crossposted articles. However, not all file systems support hard -links. If that's the case for you, set -@code{nnmail-crosspost-link-function} to @code{copy-file}. (This -variable is @code{add-name-to-file} by default.) - -@kindex M-x nnmail-split-history -@kindex nnmail-split-history -If you wish to see where the previous mail split put the messages, you -can use the @kbd{M-x nnmail-split-history} command. - -Gnus gives you all the opportunity you could possibly want for shooting -yourself in the foot. Let's say you create a group that will contain -all the mail you get from your boss. And then you accidentally -unsubscribe from the group. Gnus will still put all the mail from your -boss in the unsubscribed group, and so, when your boss mails you ``Have -that report ready by Monday or you're fired!'', you'll never see it and, -come Tuesday, you'll still believe that you're gainfully employed while -you really should be out collecting empty bottles to save up for next -month's rent money. - - -@node Mail Backend Variables -@subsection Mail Backend Variables - -These variables are (for the most part) pertinent to all the various -mail backends. - -@table @code -@vindex nnmail-read-incoming-hook -@item nnmail-read-incoming-hook -The mail backends all call this hook after reading new mail. You can -use this hook to notify any mail watch programs, if you want to. - -@vindex nnmail-spool-file -@item nnmail-spool-file -@cindex POP mail -@cindex MAILHOST -@cindex movemail -@vindex nnmail-pop-password -@vindex nnmail-pop-password-required -The backends will look for new mail in this file. If this variable is -@code{nil}, the mail backends will never attempt to fetch mail by -themselves. If you are using a POP mail server and your name is -@samp{larsi}, you should set this variable to @samp{po:larsi}. If -your name is not @samp{larsi}, you should probably modify that -slightly, but you may have guessed that already, you smart & handsome -devil! You can also set this variable to @code{pop}, and Gnus will try -to figure out the POP mail string by itself. In any case, Gnus will -call @code{movemail} which will contact the POP server named in the -@code{MAILHOST} environment variable. If the POP server needs a -password, you can either set @code{nnmail-pop-password-required} to -@code{t} and be prompted for the password, or set -@code{nnmail-pop-password} to the password itself. - -@code{nnmail-spool-file} can also be a list of mailboxes. - -Your Emacs has to have been configured with @samp{--with-pop} before -compilation. This is the default, but some installations have it -switched off. - -When you use a mail backend, Gnus will slurp all your mail from your -inbox and plonk it down in your home directory. Gnus doesn't move any -mail if you're not using a mail backend---you have to do a lot of magic -invocations first. At the time when you have finished drawing the -pentagram, lightened the candles, and sacrificed the goat, you really -shouldn't be too surprised when Gnus moves your mail. - -@vindex nnmail-use-procmail -@vindex nnmail-procmail-suffix -@item nnmail-use-procmail -If non-@code{nil}, the mail backends will look in -@code{nnmail-procmail-directory} for incoming mail. All the files in -that directory that have names ending in @code{nnmail-procmail-suffix} -will be considered incoming mailboxes, and will be searched for new -mail. - -@vindex nnmail-crash-box -@item nnmail-crash-box -When a mail backend reads a spool file, mail is first moved to this -file, which is @file{~/.gnus-crash-box} by default. If this file -already exists, it will always be read (and incorporated) before any -other spool files. - -@vindex nnmail-prepare-incoming-hook -@item nnmail-prepare-incoming-hook -This is run in a buffer that holds all the new incoming mail, and can be -used for, well, anything, really. - -@vindex nnmail-split-hook -@item nnmail-split-hook -@findex article-decode-rfc1522 -@findex RFC1522 decoding -Hook run in the buffer where the mail headers of each message is kept -just before the splitting based on these headers is done. The hook is -free to modify the buffer contents in any way it sees fit---the buffer -is discarded after the splitting has been done, and no changes performed -in the buffer will show up in any files. @code{gnus-article-decode-rfc1522} -is one likely function to add to this hook. - -@vindex nnmail-pre-get-new-mail-hook -@vindex nnmail-post-get-new-mail-hook -@item nnmail-pre-get-new-mail-hook -@itemx nnmail-post-get-new-mail-hook -These are two useful hooks executed when treating new incoming -mail---@code{nnmail-pre-get-new-mail-hook} (is called just before -starting to handle the new mail) and -@code{nnmail-post-get-new-mail-hook} (is called when the mail handling -is done). Here's and example of using these two hooks to change the -default file modes the new mail files get: - -@lisp -(add-hook 'gnus-pre-get-new-mail-hook - (lambda () (set-default-file-modes 511))) - -(add-hook 'gnus-post-get-new-mail-hook - (lambda () (set-default-file-modes 551))) -@end lisp - -@item nnmail-tmp-directory -@vindex nnmail-tmp-directory -This variable says where to move incoming mail to -- while processing -it. This is usually done in the same directory that the mail backend -inhabits (e.g., @file{~/Mail/}), but if this variable is non-@code{nil}, -it will be used instead. - -@item nnmail-movemail-program -@vindex nnmail-movemail-program -This program is executed to move mail from the user's inbox to her home -directory. The default is @samp{movemail}. - -This can also be a function. In that case, the function will be called -with two parameters -- the name of the inbox, and the file to be moved -to. - -@item nnmail-delete-incoming -@vindex nnmail-delete-incoming -@cindex incoming mail files -@cindex deleting incoming files -If non-@code{nil}, the mail backends will delete the temporary incoming -file after splitting mail into the proper groups. This is @code{t} by -default. - -@c This is @code{nil} by -@c default for reasons of security. - -@c Since Red Gnus is an alpha release, it is to be expected to lose mail. -(No Gnus release since (ding) Gnus 0.10 (or something like that) have -lost mail, I think, but that's not the point. (Except certain versions -of Red Gnus.)) By not deleting the Incoming* files, one can be sure not -to lose mail -- if Gnus totally whacks out, one can always recover what -was lost. - -You may delete the @file{Incoming*} files at will. - -@item nnmail-use-long-file-names -@vindex nnmail-use-long-file-names -If non-@code{nil}, the mail backends will use long file and directory -names. Groups like @samp{mail.misc} will end up in directories -(assuming use of @code{nnml} backend) or files (assuming use of -@code{nnfolder} backend) like @file{mail.misc}. If it is @code{nil}, -the same group will end up in @file{mail/misc}. - -@item nnmail-delete-file-function -@vindex nnmail-delete-file-function -@findex delete-file -Function called to delete files. It is @code{delete-file} by default. - -@item nnmail-cache-accepted-message-ids -@vindex nnmail-cache-accepted-message-ids -If non-@code{nil}, put the @code{Message-ID}s of articles imported into -the backend (via @code{Gcc}, for instance) into the mail duplication -discovery cache. The default is @code{nil}. - -@end table - - -@node Fancy Mail Splitting -@subsection Fancy Mail Splitting -@cindex mail splitting -@cindex fancy mail splitting - -@vindex nnmail-split-fancy -@findex nnmail-split-fancy -If the rather simple, standard method for specifying how to split mail -doesn't allow you to do what you want, you can set -@code{nnmail-split-methods} to @code{nnmail-split-fancy}. Then you can -play with the @code{nnmail-split-fancy} variable. - -Let's look at an example value of this variable first: - -@lisp -;; Messages from the mailer daemon are not crossposted to any of -;; the ordinary groups. Warnings are put in a separate group -;; from real errors. -(| ("from" mail (| ("subject" "warn.*" "mail.warning") - "mail.misc")) - ;; Non-error messages are crossposted to all relevant - ;; groups, but we don't crosspost between the group for the - ;; (ding) list and the group for other (ding) related mail. - (& (| (any "ding@@ifi\\.uio\\.no" "ding.list") - ("subject" "ding" "ding.misc")) - ;; Other mailing lists... - (any "procmail@@informatik\\.rwth-aachen\\.de" "procmail.list") - (any "SmartList@@informatik\\.rwth-aachen\\.de" "SmartList.list") - ;; People... - (any "larsi@@ifi\\.uio\\.no" "people.Lars_Magne_Ingebrigtsen")) - ;; Unmatched mail goes to the catch all group. - "misc.misc") -@end lisp - -This variable has the format of a @dfn{split}. A split is a (possibly) -recursive structure where each split may contain other splits. Here are -the five possible split syntaxes: - -@enumerate - -@item -@samp{group}: If the split is a string, that will be taken as a group name. - -@item -@var{(FIELD VALUE SPLIT)}: If the split is a list, the first element of -which is a string, then store the message as specified by SPLIT, if -header FIELD (a regexp) contains VALUE (also a regexp). - -@item -@var{(| SPLIT...)}: If the split is a list, and the first element is -@code{|} (vertical bar), then process each SPLIT until one of them -matches. A SPLIT is said to match if it will cause the mail message to -be stored in one or more groups. - -@item -@var{(& SPLIT...)}: If the split is a list, and the first element is -@code{&}, then process all SPLITs in the list. - -@item -@code{junk}: If the split is the symbol @code{junk}, then don't save -this message. - -@item -@var{(: function arg1 arg2 ...)}: If the split is a list, and the first -element is @code{:}, then the second element will be called as a -function with @var{args} given as arguments. The function should return -a SPLIT. - -@end enumerate - -In these splits, @var{FIELD} must match a complete field name. -@var{VALUE} must match a complete word according to the fundamental mode -syntax table. You can use @code{.*} in the regexps to match partial -field names or words. In other words, all @var{VALUE}'s are wrapped in -@samp{\<} and @samp{\>} pairs. - -@vindex nnmail-split-abbrev-alist -@var{FIELD} and @var{VALUE} can also be lisp symbols, in that case they -are expanded as specified by the variable -@code{nnmail-split-abbrev-alist}. This is an alist of cons cells, where -the @code{car} of a cell contains the key, and the @code{cdr} contains the associated -value. - -@vindex nnmail-split-fancy-syntax-table -@code{nnmail-split-fancy-syntax-table} is the syntax table in effect -when all this splitting is performed. - -If you want to have Gnus create groups dynamically based on some -information in the headers (i.e., do @code{replace-match}-like -substitions in the group names), you can say things like: - -@example -(any "debian-\\(\\w*\\)@@lists.debian.org" "mail.debian.\\1") -@end example - -@node Mail and Procmail -@subsection Mail and Procmail -@cindex procmail - -@cindex slocal -@cindex elm -Many people use @code{procmail} (or some other mail filter program or -external delivery agent---@code{slocal}, @code{elm}, etc) to split -incoming mail into groups. If you do that, you should set -@code{nnmail-spool-file} to @code{procmail} to ensure that the mail -backends never ever try to fetch mail by themselves. - -If you have a combined @code{procmail}/POP/mailbox setup, you can do -something like the following: - -@vindex nnmail-use-procmail -@lisp -(setq nnmail-use-procmail t) -(setq nnmail-spool-file - '("/usr/spool/mail/my-name" "po:my-name")) -@end lisp - -This also means that you probably don't want to set -@code{nnmail-split-methods} either, which has some, perhaps, unexpected -side effects. - -When a mail backend is queried for what groups it carries, it replies -with the contents of that variable, along with any groups it has figured -out that it carries by other means. None of the backends, except -@code{nnmh}, actually go out to the disk and check what groups actually -exist. (It's not trivial to distinguish between what the user thinks is -a basis for a newsgroup and what is just a plain old file or directory.) - -This means that you have to tell Gnus (and the backends) by hand what -groups exist. - -Let's take the @code{nnmh} backend as an example: - -The folders are located in @code{nnmh-directory}, say, @file{~/Mail/}. -There are three folders, @file{foo}, @file{bar} and @file{mail.baz}. - -Go to the group buffer and type @kbd{G m}. When prompted, answer -@samp{foo} for the name and @samp{nnmh} for the method. Repeat -twice for the two other groups, @samp{bar} and @samp{mail.baz}. Be sure -to include all your mail groups. - -That's it. You are now set to read your mail. An active file for this -method will be created automatically. - -@vindex nnmail-procmail-suffix -@vindex nnmail-procmail-directory -If you use @code{nnfolder} or any other backend that store more than a -single article in each file, you should never have procmail add mails to -the file that Gnus sees. Instead, procmail should put all incoming mail -in @code{nnmail-procmail-directory}. To arrive at the file name to put -the incoming mail in, append @code{nnmail-procmail-suffix} to the group -name. The mail backends will read the mail from these files. - -@vindex nnmail-resplit-incoming -When Gnus reads a file called @file{mail.misc.spool}, this mail will be -put in the @code{mail.misc}, as one would expect. However, if you want -Gnus to split the mail the normal way, you could set -@code{nnmail-resplit-incoming} to @code{t}. - -@vindex nnmail-keep-last-article -If you use @code{procmail} to split things directly into an @code{nnmh} -directory (which you shouldn't do), you should set -@code{nnmail-keep-last-article} to non-@code{nil} to prevent Gnus from -ever expiring the final article (i.e., the article with the highest -article number) in a mail newsgroup. This is quite, quite important. - -Here's an example setup: The incoming spools are located in -@file{~/incoming/} and have @samp{""} as suffixes (i.e., the incoming -spool files have the same names as the equivalent groups). The -@code{nnfolder} backend is to be used as the mail interface, and the -@code{nnfolder} directory is @file{~/fMail/}. - -@lisp -(setq nnfolder-directory "~/fMail/") -(setq nnmail-spool-file 'procmail) -(setq nnmail-procmail-directory "~/incoming/") -(setq gnus-secondary-select-methods '((nnfolder ""))) -(setq nnmail-procmail-suffix "") -@end lisp - - -@node Incorporating Old Mail -@subsection Incorporating Old Mail - -Most people have lots of old mail stored in various file formats. If -you have set up Gnus to read mail using one of the spiffy Gnus mail -backends, you'll probably wish to have that old mail incorporated into -your mail groups. - -Doing so can be quite easy. - -To take an example: You're reading mail using @code{nnml} -(@pxref{Mail Spool}), and have set @code{nnmail-split-methods} to a -satisfactory value (@pxref{Splitting Mail}). You have an old Unix mbox -file filled with important, but old, mail. You want to move it into -your @code{nnml} groups. - -Here's how: - -@enumerate -@item -Go to the group buffer. - -@item -Type `G f' and give the path to the mbox file when prompted to create an -@code{nndoc} group from the mbox file (@pxref{Foreign Groups}). - -@item -Type `SPACE' to enter the newly created group. - -@item -Type `M P b' to process-mark all articles in this group's buffer -(@pxref{Setting Process Marks}). - -@item -Type `B r' to respool all the process-marked articles, and answer -@samp{nnml} when prompted (@pxref{Mail Group Commands}). -@end enumerate - -All the mail messages in the mbox file will now also be spread out over -all your @code{nnml} groups. Try entering them and check whether things -have gone without a glitch. If things look ok, you may consider -deleting the mbox file, but I wouldn't do that unless I was absolutely -sure that all the mail has ended up where it should be. - -Respooling is also a handy thing to do if you're switching from one mail -backend to another. Just respool all the mail in the old mail groups -using the new mail backend. - - -@node Expiring Mail -@subsection Expiring Mail -@cindex article expiry - -Traditional mail readers have a tendency to remove mail articles when -you mark them as read, in some way. Gnus takes a fundamentally -different approach to mail reading. - -Gnus basically considers mail just to be news that has been received in -a rather peculiar manner. It does not think that it has the power to -actually change the mail, or delete any mail messages. If you enter a -mail group, and mark articles as ``read'', or kill them in some other -fashion, the mail articles will still exist on the system. I repeat: -Gnus will not delete your old, read mail. Unless you ask it to, of -course. - -To make Gnus get rid of your unwanted mail, you have to mark the -articles as @dfn{expirable}. This does not mean that the articles will -disappear right away, however. In general, a mail article will be -deleted from your system if, 1) it is marked as expirable, AND 2) it is -more than one week old. If you do not mark an article as expirable, it -will remain on your system until hell freezes over. This bears -repeating one more time, with some spurious capitalizations: IF you do -NOT mark articles as EXPIRABLE, Gnus will NEVER delete those ARTICLES. - -@vindex gnus-auto-expirable-newsgroups -You do not have to mark articles as expirable by hand. Groups that -match the regular expression @code{gnus-auto-expirable-newsgroups} will -have all articles that you read marked as expirable automatically. All -articles marked as expirable have an @samp{E} in the first -column in the summary buffer. - -By default, if you have auto expiry switched on, Gnus will mark all the -articles you read as expirable, no matter if they were read or unread -before. To avoid having articles marked as read marked as expirable -automatically, you can put something like the following in your -@file{.gnus} file: - -@vindex gnus-mark-article-hook -@lisp -(remove-hook 'gnus-mark-article-hook - 'gnus-summary-mark-read-and-unread-as-read) -(add-hook 'gnus-mark-article-hook 'gnus-summary-mark-unread-as-read) -@end lisp - -Note that making a group auto-expirable doesn't mean that all read -articles are expired---only the articles marked as expirable -will be expired. Also note that using the @kbd{d} command won't make -groups expirable---only semi-automatic marking of articles as read will -mark the articles as expirable in auto-expirable groups. - -Let's say you subscribe to a couple of mailing lists, and you want the -articles you have read to disappear after a while: - -@lisp -(setq gnus-auto-expirable-newsgroups - "mail.nonsense-list\\|mail.nice-list") -@end lisp - -Another way to have auto-expiry happen is to have the element -@code{auto-expire} in the group parameters of the group. - -If you use adaptive scoring (@pxref{Adaptive Scoring}) and -auto-expiring, you'll have problems. Auto-expiring and adaptive scoring -don't really mix very well. - -@vindex nnmail-expiry-wait -The @code{nnmail-expiry-wait} variable supplies the default time an -expirable article has to live. Gnus starts counting days from when the -message @emph{arrived}, not from when it was sent. The default is seven -days. - -Gnus also supplies a function that lets you fine-tune how long articles -are to live, based on what group they are in. Let's say you want to -have one month expiry period in the @samp{mail.private} group, a one day -expiry period in the @samp{mail.junk} group, and a six day expiry period -everywhere else: - -@vindex nnmail-expiry-wait-function -@lisp -(setq nnmail-expiry-wait-function - (lambda (group) - (cond ((string= group "mail.private") - 31) - ((string= group "mail.junk") - 1) - ((string= group "important") - 'never) - (t - 6)))) -@end lisp - -The group names this function is fed are ``unadorned'' group -names---no @samp{nnml:} prefixes and the like. - -The @code{nnmail-expiry-wait} variable and -@code{nnmail-expiry-wait-function} function can either be a number (not -necessarily an integer) or one of the symbols @code{immediate} or -@code{never}. - -You can also use the @code{expiry-wait} group parameter to selectively -change the expiry period (@pxref{Group Parameters}). - -@vindex nnmail-keep-last-article -If @code{nnmail-keep-last-article} is non-@code{nil}, Gnus will never -expire the final article in a mail newsgroup. This is to make life -easier for procmail users. - -@vindex gnus-total-expirable-newsgroups -By the way: That line up there, about Gnus never expiring non-expirable -articles, is a lie. If you put @code{total-expire} in the group -parameters, articles will not be marked as expirable, but all read -articles will be put through the expiry process. Use with extreme -caution. Even more dangerous is the -@code{gnus-total-expirable-newsgroups} variable. All groups that match -this regexp will have all read articles put through the expiry process, -which means that @emph{all} old mail articles in the groups in question -will be deleted after a while. Use with extreme caution, and don't come -crying to me when you discover that the regexp you used matched the -wrong group and all your important mail has disappeared. Be a -@emph{man}! Or a @emph{woman}! Whatever you feel more comfortable -with! So there! - -Most people make most of their mail groups total-expirable, though. - - -@node Washing Mail -@subsection Washing Mail -@cindex mail washing -@cindex list server brain damage -@cindex incoming mail treatment - -Mailers and list servers are notorious for doing all sorts of really, -really stupid things with mail. ``Hey, RFC822 doesn't explicitly -prohibit us from adding the string @code{wE aRe ElItE!!!!!1!!} to the -end of all lines passing through our server, so let's do that!!!!1!'' -Yes, but RFC822 wasn't designed to be read by morons. Things that were -considered to be self-evident were not discussed. So. Here we are. - -Case in point: The German version of Microsoft Exchange adds @samp{AW: -} to the subjects of replies instead of @samp{Re: }. I could pretend to -be shocked and dismayed by this, but I haven't got the energy. It is to -laugh. - -Gnus provides a plethora of functions for washing articles while -displaying them, but it might be nicer to do the filtering before -storing the mail to disc. For that purpose, we have three hooks and -various functions that can be put in these hooks. - -@table @code -@item nnmail-prepare-incoming-hook -@vindex nnmail-prepare-incoming-hook -This hook is called before doing anything with the mail and is meant for -grand, sweeping gestures. Functions to be used include: - -@table @code -@item nnheader-ms-strip-cr -@findex nnheader-ms-strip-cr -Remove trailing carriage returns from each line. This is default on -Emacs running on MS machines. - -@end table - -@item nnmail-prepare-incoming-header-hook -@vindex nnmail-prepare-incoming-header-hook -This hook is called narrowed to each header. It can be used when -cleaning up the headers. Functions that can be used include: - -@table @code -@item nnmail-remove-leading-whitespace -@findex nnmail-remove-leading-whitespace -Clear leading white space that ``helpful'' listservs have added to the -headers to make them look nice. Aaah. - -@item nnmail-remove-list-identifiers -@findex nnmail-remove-list-identifiers -Some list servers add an identifier---for example, @samp{(idm)}---to the -beginning of all @code{Subject} headers. I'm sure that's nice for -people who use stone age mail readers. This function will remove -strings that match the @code{nnmail-list-identifiers} regexp, which can -also be a list of regexp. - -For instance, if you want to remove the @samp{(idm)} and the -@samp{nagnagnag} identifiers: - -@lisp -(setq nnmail-list-identifiers - '("(idm)" "nagnagnag")) -@end lisp - -@item nnmail-remove-tabs -@findex nnmail-remove-tabs -Translate all @samp{TAB} characters into @samp{SPACE} characters. - -@end table - -@item nnmail-prepare-incoming-message-hook -@vindex nnmail-prepare-incoming-message-hook -This hook is called narrowed to each message. Functions to be used -include: - -@table @code -@item article-de-quoted-unreadable -@findex article-de-quoted-unreadable -Decode Quoted Readable encoding. - -@end table -@end table - - -@node Duplicates -@subsection Duplicates - -@vindex nnmail-treat-duplicates -@vindex nnmail-message-id-cache-length -@vindex nnmail-message-id-cache-file -@cindex duplicate mails -If you are a member of a couple of mailing lists, you will sometimes -receive two copies of the same mail. This can be quite annoying, so -@code{nnmail} checks for and treats any duplicates it might find. To do -this, it keeps a cache of old @code{Message-ID}s--- -@code{nnmail-message-id-cache-file}, which is @file{~/.nnmail-cache} by -default. The approximate maximum number of @code{Message-ID}s stored -there is controlled by the @code{nnmail-message-id-cache-length} -variable, which is 1000 by default. (So 1000 @code{Message-ID}s will be -stored.) If all this sounds scary to you, you can set -@code{nnmail-treat-duplicates} to @code{warn} (which is what it is by -default), and @code{nnmail} won't delete duplicate mails. Instead it -will insert a warning into the head of the mail saying that it thinks -that this is a duplicate of a different message. - -This variable can also be a function. If that's the case, the function -will be called from a buffer narrowed to the message in question with -the @code{Message-ID} as a parameter. The function must return either -@code{nil}, @code{warn}, or @code{delete}. - -You can turn this feature off completely by setting the variable to -@code{nil}. - -If you want all the duplicate mails to be put into a special -@dfn{duplicates} group, you could do that using the normal mail split -methods: - -@lisp -(setq nnmail-split-fancy - '(| ;; Messages duplicates go to a separate group. - ("gnus-warning" "duplication of message" "duplicate") - ;; Message from daemons, postmaster, and the like to another. - (any mail "mail.misc") - ;; Other rules. - [ ... ] )) -@end lisp - -Or something like: -@lisp -(setq nnmail-split-methods - '(("duplicates" "^Gnus-Warning:") - ;; Other rules. - [...])) -@end lisp - -Here's a neat feature: If you know that the recipient reads her mail -with Gnus, and that she has @code{nnmail-treat-duplicates} set to -@code{delete}, you can send her as many insults as you like, just by -using a @code{Message-ID} of a mail that you know that she's already -received. Think of all the fun! She'll never see any of it! Whee! - - -@node Not Reading Mail -@subsection Not Reading Mail - -If you start using any of the mail backends, they have the annoying -habit of assuming that you want to read mail with them. This might not -be unreasonable, but it might not be what you want. - -If you set @code{nnmail-spool-file} to @code{nil}, none of the backends -will ever attempt to read incoming mail, which should help. - -@vindex nnbabyl-get-new-mail -@vindex nnmbox-get-new-mail -@vindex nnml-get-new-mail -@vindex nnmh-get-new-mail -@vindex nnfolder-get-new-mail -This might be too much, if, for instance, you are reading mail quite -happily with @code{nnml} and just want to peek at some old @sc{rmail} -file you have stashed away with @code{nnbabyl}. All backends have -variables called backend-@code{get-new-mail}. If you want to disable -the @code{nnbabyl} mail reading, you edit the virtual server for the -group to have a setting where @code{nnbabyl-get-new-mail} to @code{nil}. - -All the mail backends will call @code{nn}*@code{-prepare-save-mail-hook} -narrowed to the article to be saved before saving it when reading -incoming mail. - - -@node Choosing a Mail Backend -@subsection Choosing a Mail Backend - -Gnus will read the mail spool when you activate a mail group. The mail -file is first copied to your home directory. What happens after that -depends on what format you want to store your mail in. - -@menu -* Unix Mail Box:: Using the (quite) standard Un*x mbox. -* Rmail Babyl:: Emacs programs use the rmail babyl format. -* Mail Spool:: Store your mail in a private spool? -* MH Spool:: An mhspool-like backend. -* Mail Folders:: Having one file for each group. -@end menu - - -@node Unix Mail Box -@subsubsection Unix Mail Box -@cindex nnmbox -@cindex unix mail box - -@vindex nnmbox-active-file -@vindex nnmbox-mbox-file -The @dfn{nnmbox} backend will use the standard Un*x mbox file to store -mail. @code{nnmbox} will add extra headers to each mail article to say -which group it belongs in. - -Virtual server settings: - -@table @code -@item nnmbox-mbox-file -@vindex nnmbox-mbox-file -The name of the mail box in the user's home directory. - -@item nnmbox-active-file -@vindex nnmbox-active-file -The name of the active file for the mail box. - -@item nnmbox-get-new-mail -@vindex nnmbox-get-new-mail -If non-@code{nil}, @code{nnmbox} will read incoming mail and split it -into groups. -@end table - - -@node Rmail Babyl -@subsubsection Rmail Babyl -@cindex nnbabyl -@cindex rmail mbox - -@vindex nnbabyl-active-file -@vindex nnbabyl-mbox-file -The @dfn{nnbabyl} backend will use a babyl mail box (aka. @dfn{rmail -mbox}) to store mail. @code{nnbabyl} will add extra headers to each mail -article to say which group it belongs in. - -Virtual server settings: - -@table @code -@item nnbabyl-mbox-file -@vindex nnbabyl-mbox-file -The name of the rmail mbox file. - -@item nnbabyl-active-file -@vindex nnbabyl-active-file -The name of the active file for the rmail box. - -@item nnbabyl-get-new-mail -@vindex nnbabyl-get-new-mail -If non-@code{nil}, @code{nnbabyl} will read incoming mail. -@end table - - -@node Mail Spool -@subsubsection Mail Spool -@cindex nnml -@cindex mail @sc{nov} spool - -The @dfn{nnml} spool mail format isn't compatible with any other known -format. It should be used with some caution. - -@vindex nnml-directory -If you use this backend, Gnus will split all incoming mail into files, -one file for each mail, and put the articles into the corresponding -directories under the directory specified by the @code{nnml-directory} -variable. The default value is @file{~/Mail/}. - -You do not have to create any directories beforehand; Gnus will take -care of all that. - -If you have a strict limit as to how many files you are allowed to store -in your account, you should not use this backend. As each mail gets its -own file, you might very well occupy thousands of inodes within a few -weeks. If this is no problem for you, and it isn't a problem for you -having your friendly systems administrator walking around, madly, -shouting ``Who is eating all my inodes?! Who? Who!?!'', then you should -know that this is probably the fastest format to use. You do not have -to trudge through a big mbox file just to read your new mail. - -@code{nnml} is probably the slowest backend when it comes to article -splitting. It has to create lots of files, and it also generates -@sc{nov} databases for the incoming mails. This makes it the fastest -backend when it comes to reading mail. - -Virtual server settings: - -@table @code -@item nnml-directory -@vindex nnml-directory -All @code{nnml} directories will be placed under this directory. - -@item nnml-active-file -@vindex nnml-active-file -The active file for the @code{nnml} server. - -@item nnml-newsgroups-file -@vindex nnml-newsgroups-file -The @code{nnml} group descriptions file. @xref{Newsgroups File -Format}. - -@item nnml-get-new-mail -@vindex nnml-get-new-mail -If non-@code{nil}, @code{nnml} will read incoming mail. - -@item nnml-nov-is-evil -@vindex nnml-nov-is-evil -If non-@code{nil}, this backend will ignore any @sc{nov} files. - -@item nnml-nov-file-name -@vindex nnml-nov-file-name -The name of the @sc{nov} files. The default is @file{.overview}. - -@item nnml-prepare-save-mail-hook -@vindex nnml-prepare-save-mail-hook -Hook run narrowed to an article before saving. - -@end table - -@findex nnml-generate-nov-databases -If your @code{nnml} groups and @sc{nov} files get totally out of whack, -you can do a complete update by typing @kbd{M-x -nnml-generate-nov-databases}. This command will trawl through the -entire @code{nnml} hierarchy, looking at each and every article, so it -might take a while to complete. A better interface to this -functionality can be found in the server buffer (@pxref{Server -Commands}). - - -@node MH Spool -@subsubsection MH Spool -@cindex nnmh -@cindex mh-e mail spool - -@code{nnmh} is just like @code{nnml}, except that is doesn't generate -@sc{nov} databases and it doesn't keep an active file. This makes -@code{nnmh} a @emph{much} slower backend than @code{nnml}, but it also -makes it easier to write procmail scripts for. - -Virtual server settings: - -@table @code -@item nnmh-directory -@vindex nnmh-directory -All @code{nnmh} directories will be located under this directory. - -@item nnmh-get-new-mail -@vindex nnmh-get-new-mail -If non-@code{nil}, @code{nnmh} will read incoming mail. - -@item nnmh-be-safe -@vindex nnmh-be-safe -If non-@code{nil}, @code{nnmh} will go to ridiculous lengths to make -sure that the articles in the folder are actually what Gnus thinks they -are. It will check date stamps and stat everything in sight, so -setting this to @code{t} will mean a serious slow-down. If you never -use anything but Gnus to read the @code{nnmh} articles, you do not have -to set this variable to @code{t}. -@end table - - -@node Mail Folders -@subsubsection Mail Folders -@cindex nnfolder -@cindex mbox folders -@cindex mail folders - -@code{nnfolder} is a backend for storing each mail group in a separate -file. Each file is in the standard Un*x mbox format. @code{nnfolder} -will add extra headers to keep track of article numbers and arrival -dates. - -Virtual server settings: - -@table @code -@item nnfolder-directory -@vindex nnfolder-directory -All the @code{nnfolder} mail boxes will be stored under this directory. - -@item nnfolder-active-file -@vindex nnfolder-active-file -The name of the active file. - -@item nnfolder-newsgroups-file -@vindex nnfolder-newsgroups-file -The name of the group descriptions file. @xref{Newsgroups File Format}. - -@item nnfolder-get-new-mail -@vindex nnfolder-get-new-mail -If non-@code{nil}, @code{nnfolder} will read incoming mail. -@end table - -@findex nnfolder-generate-active-file -@kindex M-x nnfolder-generate-active-file -If you have lots of @code{nnfolder}-like files you'd like to read with -@code{nnfolder}, you can use the @kbd{M-x nnfolder-generate-active-file} -command to make @code{nnfolder} aware of all likely files in -@code{nnfolder-directory}. - - -@node Other Sources -@section Other Sources - -Gnus can do more than just read news or mail. The methods described -below allow Gnus to view directories and files as if they were -newsgroups. - -@menu -* Directory Groups:: You can read a directory as if it was a newsgroup. -* Anything Groups:: Dired? Who needs dired? -* Document Groups:: Single files can be the basis of a group. -* SOUP:: Reading @sc{SOUP} packets ``offline''. -* Web Searches:: Creating groups from articles that match a string. -* Mail-To-News Gateways:: Posting articles via mail-to-news gateways. -@end menu - - -@node Directory Groups -@subsection Directory Groups -@cindex nndir -@cindex directory groups - -If you have a directory that has lots of articles in separate files in -it, you might treat it as a newsgroup. The files have to have numerical -names, of course. - -This might be an opportune moment to mention @code{ange-ftp} (and its -successor @code{efs}), that most wonderful of all wonderful Emacs -packages. When I wrote @code{nndir}, I didn't think much about it---a -backend to read directories. Big deal. - -@code{ange-ftp} changes that picture dramatically. For instance, if you -enter the @code{ange-ftp} file name -@file{/ftp.hpc.uh.edu:/pub/emacs/ding-list/} as the directory name, -@code{ange-ftp} or @code{efs} will actually allow you to read this -directory over at @samp{sina} as a newsgroup. Distributed news ahoy! - -@code{nndir} will use @sc{nov} files if they are present. - -@code{nndir} is a ``read-only'' backend---you can't delete or expire -articles with this method. You can use @code{nnmh} or @code{nnml} for -whatever you use @code{nndir} for, so you could switch to any of those -methods if you feel the need to have a non-read-only @code{nndir}. - - -@node Anything Groups -@subsection Anything Groups -@cindex nneething - -From the @code{nndir} backend (which reads a single spool-like -directory), it's just a hop and a skip to @code{nneething}, which -pretends that any arbitrary directory is a newsgroup. Strange, but -true. - -When @code{nneething} is presented with a directory, it will scan this -directory and assign article numbers to each file. When you enter such -a group, @code{nneething} must create ``headers'' that Gnus can use. -After all, Gnus is a newsreader, in case you're -forgetting. @code{nneething} does this in a two-step process. First, it -snoops each file in question. If the file looks like an article (i.e., -the first few lines look like headers), it will use this as the head. -If this is just some arbitrary file without a head (e.g. a C source -file), @code{nneething} will cobble up a header out of thin air. It -will use file ownership, name and date and do whatever it can with these -elements. - -All this should happen automatically for you, and you will be presented -with something that looks very much like a newsgroup. Totally like a -newsgroup, to be precise. If you select an article, it will be displayed -in the article buffer, just as usual. - -If you select a line that represents a directory, Gnus will pop you into -a new summary buffer for this @code{nneething} group. And so on. You can -traverse the entire disk this way, if you feel like, but remember that -Gnus is not dired, really, and does not intend to be, either. - -There are two overall modes to this action---ephemeral or solid. When -doing the ephemeral thing (i.e., @kbd{G D} from the group buffer), Gnus -will not store information on what files you have read, and what files -are new, and so on. If you create a solid @code{nneething} group the -normal way with @kbd{G m}, Gnus will store a mapping table between -article numbers and file names, and you can treat this group like any -other groups. When you activate a solid @code{nneething} group, you will -be told how many unread articles it contains, etc., etc. - -Some variables: - -@table @code -@item nneething-map-file-directory -@vindex nneething-map-file-directory -All the mapping files for solid @code{nneething} groups will be stored -in this directory, which defaults to @file{~/.nneething/}. - -@item nneething-exclude-files -@vindex nneething-exclude-files -All files that match this regexp will be ignored. Nice to use to exclude -auto-save files and the like, which is what it does by default. - -@item nneething-map-file -@vindex nneething-map-file -Name of the map files. -@end table - - -@node Document Groups -@subsection Document Groups -@cindex nndoc -@cindex documentation group -@cindex help group - -@code{nndoc} is a cute little thing that will let you read a single file -as a newsgroup. Several files types are supported: - -@table @code -@cindex babyl -@cindex rmail mbox - -@item babyl -The babyl (rmail) mail box. -@cindex mbox -@cindex Unix mbox - -@item mbox -The standard Unix mbox file. - -@cindex MMDF mail box -@item mmdf -The MMDF mail box format. - -@item news -Several news articles appended into a file. - -@item rnews -@cindex rnews batch files -The rnews batch transport format. -@cindex forwarded messages - -@item forward -Forwarded articles. - -@item mime-digest -@cindex digest -@cindex MIME digest -@cindex 1153 digest -@cindex RFC 1153 digest -@cindex RFC 341 digest -MIME (RFC 1341) digest format. - -@item standard-digest -The standard (RFC 1153) digest format. - -@item slack-digest -Non-standard digest format---matches most things, but does it badly. -@end table - -You can also use the special ``file type'' @code{guess}, which means -that @code{nndoc} will try to guess what file type it is looking at. -@code{digest} means that @code{nndoc} should guess what digest type the -file is. - -@code{nndoc} will not try to change the file or insert any extra headers into -it---it will simply, like, let you use the file as the basis for a -group. And that's it. - -If you have some old archived articles that you want to insert into your -new & spiffy Gnus mail backend, @code{nndoc} can probably help you with -that. Say you have an old @file{RMAIL} file with mail that you now want -to split into your new @code{nnml} groups. You look at that file using -@code{nndoc} (using the @kbd{G f} command in the group buffer -(@pxref{Foreign Groups})), set the process mark on all the articles in -the buffer (@kbd{M P b}, for instance), and then re-spool (@kbd{B r}) -using @code{nnml}. If all goes well, all the mail in the @file{RMAIL} -file is now also stored in lots of @code{nnml} directories, and you can -delete that pesky @file{RMAIL} file. If you have the guts! - -Virtual server variables: - -@table @code -@item nndoc-article-type -@vindex nndoc-article-type -This should be one of @code{mbox}, @code{babyl}, @code{digest}, -@code{news}, @code{rnews}, @code{mmdf}, @code{forward}, @code{rfc934}, -@code{rfc822-forward}, @code{mime-digest}, @code{standard-digest}, -@code{slack-digest}, @code{clari-briefs} or @code{guess}. - -@item nndoc-post-type -@vindex nndoc-post-type -This variable says whether Gnus is to consider the group a news group or -a mail group. There are two valid values: @code{mail} (the default) -and @code{news}. -@end table - -@menu -* Document Server Internals:: How to add your own document types. -@end menu - - -@node Document Server Internals -@subsubsection Document Server Internals - -Adding new document types to be recognized by @code{nndoc} isn't -difficult. You just have to whip up a definition of what the document -looks like, write a predicate function to recognize that document type, -and then hook into @code{nndoc}. - -First, here's an example document type definition: - -@example -(mmdf - (article-begin . "^\^A\^A\^A\^A\n") - (body-end . "^\^A\^A\^A\^A\n")) -@end example - -The definition is simply a unique @dfn{name} followed by a series of -regexp pseudo-variable settings. Below are the possible -variables---don't be daunted by the number of variables; most document -types can be defined with very few settings: - -@table @code -@item first-article -If present, @code{nndoc} will skip past all text until it finds -something that match this regexp. All text before this will be -totally ignored. - -@item article-begin -This setting has to be present in all document type definitions. It -says what the beginning of each article looks like. - -@item head-begin-function -If present, this should be a function that moves point to the head of -the article. - -@item nndoc-head-begin -If present, this should be a regexp that matches the head of the -article. - -@item nndoc-head-end -This should match the end of the head of the article. It defaults to -@samp{^$}---the empty line. - -@item body-begin-function -If present, this function should move point to the beginning of the body -of the article. - -@item body-begin -This should match the beginning of the body of the article. It defaults -to @samp{^\n}. - -@item body-end-function -If present, this function should move point to the end of the body of -the article. - -@item body-end -If present, this should match the end of the body of the article. - -@item file-end -If present, this should match the end of the file. All text after this -regexp will be totally ignored. - -@end table - -So, using these variables @code{nndoc} is able to dissect a document -file into a series of articles, each with a head and a body. However, a -few more variables are needed since not all document types are all that -news-like---variables needed to transform the head or the body into -something that's palatable for Gnus: - -@table @code -@item prepare-body-function -If present, this function will be called when requesting an article. It -will be called with point at the start of the body, and is useful if the -document has encoded some parts of its contents. - -@item article-transform-function -If present, this function is called when requesting an article. It's -meant to be used for more wide-ranging transformation of both head and -body of the article. - -@item generate-head-function -If present, this function is called to generate a head that Gnus can -understand. It is called with the article number as a parameter, and is -expected to generate a nice head for the article in question. It is -called when requesting the headers of all articles. - -@end table - -Let's look at the most complicated example I can come up with---standard -digests: - -@example -(standard-digest - (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+")) - (article-begin . ,(concat "\n\n" (make-string 30 ?-) "\n\n+")) - (prepare-body-function . nndoc-unquote-dashes) - (body-end-function . nndoc-digest-body-end) - (head-end . "^ ?$") - (body-begin . "^ ?\n") - (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$") - (subtype digest guess)) -@end example - -We see that all text before a 70-width line of dashes is ignored; all -text after a line that starts with that @samp{^End of} is also ignored; -each article begins with a 30-width line of dashes; the line separating -the head from the body may contain a single space; and that the body is -run through @code{nndoc-unquote-dashes} before being delivered. - -To hook your own document definition into @code{nndoc}, use the -@code{nndoc-add-type} function. It takes two parameters---the first is -the definition itself and the second (optional) parameter says where in -the document type definition alist to put this definition. The alist is -traversed sequentially, and @code{nndoc-TYPE-type-p} is called for a given type @code{TYPE}. So @code{nndoc-mmdf-type-p} is called to see whether a document -is of @code{mmdf} type, and so on. These type predicates should return -@code{nil} if the document is not of the correct type; @code{t} if it is -of the correct type; and a number if the document might be of the -correct type. A high number means high probability; a low number means -low probability with @samp{0} being the lowest valid number. - - -@node SOUP -@subsection SOUP -@cindex SOUP -@cindex offline - -In the PC world people often talk about ``offline'' newsreaders. These -are thingies that are combined reader/news transport monstrosities. -With built-in modem programs. Yecchh! - -Of course, us Unix Weenie types of human beans use things like -@code{uucp} and, like, @code{nntpd} and set up proper news and mail -transport things like Ghod intended. And then we just use normal -newsreaders. - -However, it can sometimes be convenient to do something a that's a bit -easier on the brain if you have a very slow modem, and you're not really -that interested in doing things properly. - -A file format called @sc{soup} has been developed for transporting news -and mail from servers to home machines and back again. It can be a bit -fiddly. - -First some terminology: - -@table @dfn - -@item server -This is the machine that is connected to the outside world and where you -get news and/or mail from. - -@item home machine -This is the machine that you want to do the actual reading and responding -on. It is typically not connected to the rest of the world in any way. - -@item packet -Something that contains messages and/or commands. There are two kinds -of packets: - -@table @dfn -@item message packets -These are packets made at the server, and typically contain lots of -messages for you to read. These are called @file{SoupoutX.tgz} by -default, where @var{X} is a number. - -@item response packets -These are packets made at the home machine, and typically contains -replies that you've written. These are called @file{SoupinX.tgz} by -default, where @var{X} is a number. - -@end table - -@end table - - -@enumerate - -@item -You log in on the server and create a @sc{soup} packet. You can either -use a dedicated @sc{soup} thingie (like the @code{awk} program), or you -can use Gnus to create the packet with its @sc{soup} commands (@kbd{O -s} and/or @kbd{G s b}; and then @kbd{G s p}) (@pxref{SOUP Commands}). - -@item -You transfer the packet home. Rail, boat, car or modem will do fine. - -@item -You put the packet in your home directory. - -@item -You fire up Gnus on your home machine using the @code{nnsoup} backend as -the native or secondary server. - -@item -You read articles and mail and answer and followup to the things you -want (@pxref{SOUP Replies}). - -@item -You do the @kbd{G s r} command to pack these replies into a @sc{soup} -packet. - -@item -You transfer this packet to the server. - -@item -You use Gnus to mail this packet out with the @kbd{G s s} command. - -@item -You then repeat until you die. - -@end enumerate - -So you basically have a bipartite system---you use @code{nnsoup} for -reading and Gnus for packing/sending these @sc{soup} packets. - -@menu -* SOUP Commands:: Commands for creating and sending @sc{soup} packets -* SOUP Groups:: A backend for reading @sc{soup} packets. -* SOUP Replies:: How to enable @code{nnsoup} to take over mail and news. -@end menu - - -@node SOUP Commands -@subsubsection SOUP Commands - -These are commands for creating and manipulating @sc{soup} packets. - -@table @kbd -@item G s b -@kindex G s b (Group) -@findex gnus-group-brew-soup -Pack all unread articles in the current group -(@code{gnus-group-brew-soup}). This command understands the -process/prefix convention. - -@item G s w -@kindex G s w (Group) -@findex gnus-soup-save-areas -Save all @sc{soup} data files (@code{gnus-soup-save-areas}). - -@item G s s -@kindex G s s (Group) -@findex gnus-soup-send-replies -Send all replies from the replies packet -(@code{gnus-soup-send-replies}). - -@item G s p -@kindex G s p (Group) -@findex gnus-soup-pack-packet -Pack all files into a @sc{soup} packet (@code{gnus-soup-pack-packet}). - -@item G s r -@kindex G s r (Group) -@findex nnsoup-pack-replies -Pack all replies into a replies packet (@code{nnsoup-pack-replies}). - -@item O s -@kindex O s (Summary) -@findex gnus-soup-add-article -This summary-mode command adds the current article to a @sc{soup} packet -(@code{gnus-soup-add-article}). It understands the process/prefix -convention (@pxref{Process/Prefix}). - -@end table - - -There are a few variables to customize where Gnus will put all these -thingies: - -@table @code - -@item gnus-soup-directory -@vindex gnus-soup-directory -Directory where Gnus will save intermediate files while composing -@sc{soup} packets. The default is @file{~/SoupBrew/}. - -@item gnus-soup-replies-directory -@vindex gnus-soup-replies-directory -This is what Gnus will use as a temporary directory while sending our -reply packets. @file{~/SoupBrew/SoupReplies/} is the default. - -@item gnus-soup-prefix-file -@vindex gnus-soup-prefix-file -Name of the file where Gnus stores the last used prefix. The default is -@samp{gnus-prefix}. - -@item gnus-soup-packer -@vindex gnus-soup-packer -A format string command for packing a @sc{soup} packet. The default is -@samp{tar cf - %s | gzip > $HOME/Soupout%d.tgz}. - -@item gnus-soup-unpacker -@vindex gnus-soup-unpacker -Format string command for unpacking a @sc{soup} packet. The default is -@samp{gunzip -c %s | tar xvf -}. - -@item gnus-soup-packet-directory -@vindex gnus-soup-packet-directory -Where Gnus will look for reply packets. The default is @file{~/}. - -@item gnus-soup-packet-regexp -@vindex gnus-soup-packet-regexp -Regular expression matching @sc{soup} reply packets in -@code{gnus-soup-packet-directory}. - -@end table - - -@node SOUP Groups -@subsubsection @sc{soup} Groups -@cindex nnsoup - -@code{nnsoup} is the backend for reading @sc{soup} packets. It will -read incoming packets, unpack them, and put them in a directory where -you can read them at leisure. - -These are the variables you can use to customize its behavior: - -@table @code - -@item nnsoup-tmp-directory -@vindex nnsoup-tmp-directory -When @code{nnsoup} unpacks a @sc{soup} packet, it does it in this -directory. (@file{/tmp/} by default.) - -@item nnsoup-directory -@vindex nnsoup-directory -@code{nnsoup} then moves each message and index file to this directory. -The default is @file{~/SOUP/}. - -@item nnsoup-replies-directory -@vindex nnsoup-replies-directory -All replies will be stored in this directory before being packed into a -reply packet. The default is @file{~/SOUP/replies/"}. - -@item nnsoup-replies-format-type -@vindex nnsoup-replies-format-type -The @sc{soup} format of the replies packets. The default is @samp{?n} -(rnews), and I don't think you should touch that variable. I probably -shouldn't even have documented it. Drats! Too late! - -@item nnsoup-replies-index-type -@vindex nnsoup-replies-index-type -The index type of the replies packet. The default is @samp{?n}, which -means ``none''. Don't fiddle with this one either! - -@item nnsoup-active-file -@vindex nnsoup-active-file -Where @code{nnsoup} stores lots of information. This is not an ``active -file'' in the @code{nntp} sense; it's an Emacs Lisp file. If you lose -this file or mess it up in any way, you're dead. The default is -@file{~/SOUP/active}. - -@item nnsoup-packer -@vindex nnsoup-packer -Format string command for packing a reply @sc{soup} packet. The default -is @samp{tar cf - %s | gzip > $HOME/Soupin%d.tgz}. - -@item nnsoup-unpacker -@vindex nnsoup-unpacker -Format string command for unpacking incoming @sc{soup} packets. The -default is @samp{gunzip -c %s | tar xvf -}. - -@item nnsoup-packet-directory -@vindex nnsoup-packet-directory -Where @code{nnsoup} will look for incoming packets. The default is -@file{~/}. - -@item nnsoup-packet-regexp -@vindex nnsoup-packet-regexp -Regular expression matching incoming @sc{soup} packets. The default is -@samp{Soupout}. - -@item nnsoup-always-save -@vindex nnsoup-always-save -If non-@code{nil}, save the replies buffer after each posted message. - -@end table - - -@node SOUP Replies -@subsubsection SOUP Replies - -Just using @code{nnsoup} won't mean that your postings and mailings end -up in @sc{soup} reply packets automagically. You have to work a bit -more for that to happen. - -@findex nnsoup-set-variables -The @code{nnsoup-set-variables} command will set the appropriate -variables to ensure that all your followups and replies end up in the -@sc{soup} system. - -In specific, this is what it does: - -@lisp -(setq message-send-news-function 'nnsoup-request-post) -(setq message-send-mail-function 'nnsoup-request-mail) -@end lisp - -And that's it, really. If you only want news to go into the @sc{soup} -system you just use the first line. If you only want mail to be -@sc{soup}ed you use the second. - - -@node Web Searches -@subsection Web Searches -@cindex nnweb -@cindex DejaNews -@cindex Alta Vista -@cindex InReference -@cindex Usenet searches -@cindex searching the Usenet - -It's, like, too neat to search the Usenet for articles that match a -string, but it, like, totally @emph{sucks}, like, totally, to use one of -those, like, Web browsers, and you, like, have to, rilly, like, look at -the commercials, so, like, with Gnus you can do @emph{rad}, rilly, -searches without having to use a browser. - -The @code{nnweb} backend allows an easy interface to the mighty search -engine. You create an @code{nnweb} group, enter a search pattern, and -then enter the group and read the articles like you would any normal -group. The @kbd{G w} command in the group buffer (@pxref{Foreign -Groups}) will do this in an easy-to-use fashion. - -@code{nnweb} groups don't really lend themselves to being solid -groups---they have a very fleeting idea of article numbers. In fact, -each time you enter an @code{nnweb} group (not even changing the search -pattern), you are likely to get the articles ordered in a different -manner. Not even using duplicate suppression (@pxref{Duplicate -Suppression}) will help, since @code{nnweb} doesn't even know the -@code{Message-ID} of the articles before reading them using some search -engines (DejaNews, for instance). The only possible way to keep track -of which articles you've read is by scoring on the @code{Date} -header---mark all articles posted before the last date you read the -group as read. - -If the search engine changes its output substantially, @code{nnweb} -won't be able to parse it and will fail. One could hardly fault the Web -providers if they were to do this---their @emph{raison d'être} is to -make money off of advertisements, not to provide services to the -community. Since @code{nnweb} washes the ads off all the articles, one -might think that the providers might be somewhat miffed. We'll see. - -You must have the @code{url} and @code{w3} package installed to be able -to use @code{nnweb}. - -Virtual server variables: - -@table @code -@item nnweb-type -@vindex nnweb-type -What search engine type is being used. The currently supported types -are @code{dejanews}, @code{dejanewsold}, @code{altavista} and -@code{reference}. - -@item nnweb-search -@vindex nnweb-search -The search string to feed to the search engine. - -@item nnweb-max-hits -@vindex nnweb-max-hits -Advisory maximum number of hits per search to display. The default is -100. - -@item nnweb-type-definition -@vindex nnweb-type-definition -Type-to-definition alist. This alist says what @code{nnweb} should do -with the various search engine types. The following elements must be -present: - -@table @code -@item article -Function to decode the article and provide something that Gnus -understands. - -@item map -Function to create an article number to message header and URL alist. - -@item search -Function to send the search string to the search engine. - -@item address -The address the aforementioned function should send the search string -to. - -@item id -Format string URL to fetch an article by @code{Message-ID}. -@end table - -@end table - - - -@node Mail-To-News Gateways -@subsection Mail-To-News Gateways -@cindex mail-to-news gateways -@cindex gateways - -If your local @code{nntp} server doesn't allow posting, for some reason -or other, you can post using one of the numerous mail-to-news gateways. -The @code{nngateway} backend provides the interface. - -Note that you can't read anything from this backend---it can only be -used to post with. - -Server variables: - -@table @code -@item nngateway-address -@vindex nngateway-address -This is the address of the mail-to-news gateway. - -@item nngateway-header-transformation -@vindex nngateway-header-transformation -News headers often have to be transformed in some odd way or other -for the mail-to-news gateway to accept it. This variable says what -transformation should be called, and defaults to -@code{nngateway-simple-header-transformation}. The function is called -narrowed to the headers to be transformed and with one parameter---the -gateway address. - -This default function just inserts a new @code{To} header based on the -@code{Newsgroups} header and the gateway address. -For instance, an article with this @code{Newsgroups} header: - -@example -Newsgroups: alt.religion.emacs -@end example - -will get this @code{From} header inserted: - -@example -To: alt-religion-emacs@@GATEWAY -@end example - -@end table - -So, to use this, simply say something like: - -@lisp -(setq gnus-post-method '(nngateway "GATEWAY.ADDRESS")) -@end lisp - - -@node Combined Groups -@section Combined Groups - -Gnus allows combining a mixture of all the other group types into bigger -groups. - -@menu -* Virtual Groups:: Combining articles from many groups. -* Kibozed Groups:: Looking through parts of the newsfeed for articles. -@end menu - - -@node Virtual Groups -@subsection Virtual Groups -@cindex nnvirtual -@cindex virtual groups - -An @dfn{nnvirtual group} is really nothing more than a collection of -other groups. - -For instance, if you are tired of reading many small groups, you can -put them all in one big group, and then grow tired of reading one -big, unwieldy group. The joys of computing! - -You specify @code{nnvirtual} as the method. The address should be a -regexp to match component groups. - -All marks in the virtual group will stick to the articles in the -component groups. So if you tick an article in a virtual group, the -article will also be ticked in the component group from whence it came. -(And vice versa---marks from the component groups will also be shown in -the virtual group.) - -Here's an example @code{nnvirtual} method that collects all Andrea Dworkin -newsgroups into one, big, happy newsgroup: - -@lisp -(nnvirtual "^alt\\.fan\\.andrea-dworkin$\\|^rec\\.dworkin.*") -@end lisp - -The component groups can be native or foreign; everything should work -smoothly, but if your computer explodes, it was probably my fault. - -Collecting the same group from several servers might actually be a good -idea if users have set the Distribution header to limit distribution. -If you would like to read @samp{soc.motss} both from a server in Japan -and a server in Norway, you could use the following as the group regexp: - -@example -"^nntp\\+some\\.server\\.jp:soc\\.motss$\\|^nntp\\+some\\.server\\.no:soc\\.motss$" -@end example - -(Remember, though, that if you're creating the group with @kbd{G m}, you -shouldn't double the backslashes, and you should leave off the quote -characters at the beginning and the end of the string.) - -This should work kinda smoothly---all articles from both groups should -end up in this one, and there should be no duplicates. Threading (and -the rest) will still work as usual, but there might be problems with the -sequence of articles. Sorting on date might be an option here -(@pxref{Selecting a Group}). - -One limitation, however---all groups included in a virtual -group have to be alive (i.e., subscribed or unsubscribed). Killed or -zombie groups can't be component groups for @code{nnvirtual} groups. - -@vindex nnvirtual-always-rescan -If the @code{nnvirtual-always-rescan} is non-@code{nil}, -@code{nnvirtual} will always scan groups for unread articles when -entering a virtual group. If this variable is @code{nil} (which is the -default) 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. You'll also see this -effect if you have two virtual groups that have a component group in -common. If that's the case, you should set this variable to @code{t}. -Or you can just tap @code{M-g} on the virtual group every time before -you enter it---it'll have much the same effect. - - -@node Kibozed Groups -@subsection Kibozed Groups -@cindex nnkiboze -@cindex kibozing - -@dfn{Kibozing} is defined by @sc{oed} as ``grepping through (parts of) -the news feed''. @code{nnkiboze} is a backend that will do this for -you. Oh joy! Now you can grind any @sc{nntp} server down to a halt -with useless requests! Oh happiness! - -@kindex G k (Group) -To create a kibozed group, use the @kbd{G k} command in the group -buffer. - -The address field of the @code{nnkiboze} method is, as with -@code{nnvirtual}, a regexp to match groups to be ``included'' in the -@code{nnkiboze} group. That's where most similarities between @code{nnkiboze} -and @code{nnvirtual} end. - -In addition to this regexp detailing component groups, an @code{nnkiboze} group -must have a score file to say what articles are to be included in -the group (@pxref{Scoring}). - -@kindex M-x nnkiboze-generate-groups -@findex nnkiboze-generate-groups -You must run @kbd{M-x nnkiboze-generate-groups} after creating the -@code{nnkiboze} groups you want to have. This command will take time. Lots of -time. Oodles and oodles of time. Gnus has to fetch the headers from -all the articles in all the component groups and run them through the -scoring process to determine if there are any articles in the groups -that are to be part of the @code{nnkiboze} groups. - -Please limit the number of component groups by using restrictive -regexps. Otherwise your sysadmin may become annoyed with you, and the -@sc{nntp} site may throw you off and never let you back in again. -Stranger things have happened. - -@code{nnkiboze} component groups do not have to be alive---they can be dead, -and they can be foreign. No restrictions. - -@vindex nnkiboze-directory -The generation of an @code{nnkiboze} group means writing two files in -@code{nnkiboze-directory}, which is @file{~/News/} by default. One -contains the @sc{nov} header lines for all the articles in the group, -and the other is an additional @file{.newsrc} file to store information -on what groups have been searched through to find component articles. - -Articles marked as read in the @code{nnkiboze} group will have -their @sc{nov} lines removed from the @sc{nov} file. - - -@node Gnus Unplugged -@section Gnus Unplugged -@cindex offline -@cindex unplugged -@cindex Agent -@cindex Gnus Agent -@cindex Gnus Unplugged - -In olden times (ca. February '88), people used to run their newsreaders -on big machines with permanent connections to the net. News transport -was dealt with by news servers, and all the newsreaders had to do was to -read news. Believe it or not. - -Nowadays most people read news and mail at home, and use some sort of -modem to connect to the net. To avoid running up huge phone bills, it -would be nice to have a way to slurp down all the news and mail, hang up -the phone, read for several hours, and then upload any responses you -have to make. And then you repeat the procedure. - -Of course, you can use news servers for doing this as well. I've used -@code{inn} together with @code{slurp}, @code{pop} and @code{sendmail} -for some years, but doing that's a bore. Moving the news server -functionality up to the newsreader makes sense if you're the only person -reading news on a machine. - -Using Gnus as an ``offline'' newsreader is quite simple. - -@itemize @bullet -@item -First, set up Gnus as you would do if you were running it on a machine -that has full connection to the net. Go ahead. I'll still be waiting -here. - -@item -Then, put the following magical incantation at the end of your -@file{.gnus.el} file: - -@lisp -(gnus-agentize) -@end lisp -@end itemize - -That's it. Gnus is now an ``offline'' newsreader. - -Of course, to use it as such, you have to learn a few new commands. - -@menu -* Agent Basics:: How it all is supposed to work. -* Agent Categories:: How to tell the Gnus Agent what to download. -* Agent Commands:: New commands for all the buffers. -* Outgoing Messages:: What happens when you post/mail something? -* Agent Variables:: Customizing is fun. -* Example Setup:: An example @file{.gnus.el} file for offline people. -* Batching Agents:: How to fetch news from a @code{cron} job. -@end menu - - -@node Agent Basics -@subsection Agent Basics - -First, let's get some terminology out of the way. - -The Gnus Agent is said to be @dfn{unplugged} when you have severed the -connection to the net (and notified the Agent that this is the case). -When the connection to the net is up again (and Gnus knows this), the -Agent is @dfn{plugged}. - -The @dfn{local} machine is the one you're running on, and which isn't -connected to the net continously. - -@dfn{Downloading} means fetching things from the net to your local -machine. @dfn{Uploading} is doing the opposite. - -Let's take a typical Gnus session using the Agent. - -@itemize @bullet - -@item -You start Gnus with @code{gnus-unplugged}. This brings up the Gnus -Agent in a disconnected state. You can read all the news that you have -already fetched while in this mode. - -@item -You then decide to see whether any new news has arrived. You connect -your machine to the net (using PPP or whatever), and then hit @kbd{J j} -to make Gnus become @dfn{plugged}. - -@item -You can then read the new news immediately, or you can download the news -onto your local machine. If you want to do the latter, you press @kbd{J -s} to fetch all the eligible articles in all the groups. (To let Gnus -know which articles you want to download, @pxref{Agent Categories}.) - -@item -After fetching the articles, you press @kbd{J j} to make Gnus become -unplugged again, and you shut down the PPP thing (or whatever). And -then you read the news offline. - -@item -And then you go to step 2. -@end itemize - -Here are some things you should do the first time (or so) that you use -the Agent. - -@itemize @bullet - -@item -Decide which servers should be covered by the Agent. If you have a mail -backend, it would probably be nonsensical to have it covered by the -Agent. Go to the server buffer (@kbd{^} in the group buffer) and press -@kbd{J a} the server (or servers) that you wish to have covered by the -Agent (@pxref{Server Agent Commands}). This will typically be only the -primary select method, which is listed on the bottom in the buffer. - -@item -Decide on download policy. @xref{Agent Categories} - -@item -Uhm... that's it. -@end itemize - - -@node Agent Categories -@subsection Agent Categories - -One of the main reasons to integrate the news transport layer into the -newsreader is to allow greater control over what articles to download. -There's not much point in downloading huge amounts of articles, just to -find out that you're not interested in reading any of them. It's better -to be somewhat more conservative in choosing what to download, and then -mark the articles for downloading manually if it should turn out that -you're interested in the articles anyway. - -The main way to control what is to be downloaded is to create a -@dfn{category} and then assign some (or all) groups to this category. -Gnus has its own buffer for creating and managing categories. - -@menu -* Category Syntax:: What a category looks like. -* The Category Buffer:: A buffer for maintaining categories. -* Category Variables:: Customize'r'Us. -@end menu - - -@node Category Syntax -@subsubsection Category Syntax - -A category consists of two things. - -@enumerate -@item -A predicate which (generally) gives a rough outline of which articles -are eligible for downloading; and - -@item -a score rule which (generally) gives you a finer granularity when -deciding what articles to download. (Note that this @dfn{download -score} is wholly unrelated to normal scores.) -@end enumerate - -A predicate consists of predicates with logical operators sprinkled in -between. - -Perhaps some examples are in order. - -Here's a simple predicate. (It's the default predicate, in fact, used -for all groups that don't belong to any other category.) - -@lisp -short -@end lisp - -Quite simple, eh? This predicate is true if and only if the article is -short (for some value of ``short''). - -Here's a more complex predicate: - -@lisp -(or high - (and - (not low) - (not long))) -@end lisp - -This means that an article should be downloaded if it has a high score, -or if the score is not low and the article is not long. You get the -drift. - -The available logical operators are @code{or}, @code{and} and -@code{not}. (If you prefer, you can use the more ``C''-ish operators -@samp{|}, @code{&} and @code{!} instead.) - -The following predicates are pre-defined, but if none of these fit what -you want to do, you can write your own. - -@table @code -@item short -True iff the article is shorter than @code{gnus-agent-short-article} -lines; default 100. - -@item long -True iff the article is longer than @code{gnus-agent-long-article} -lines; default 200. - -@item low -True iff the article has a download score less than -@code{gnus-agent-low-score}; default 0. - -@item high -True iff the article has a download score greater than -@code{gnus-agent-high-score}; default 0. - -@item spam -True iff the Gnus Agent guesses that the article is spam. The -heuristics may change over time, but at present it just computes a -checksum and sees whether articles match. - -@item true -Always true. - -@item false -Always false. -@end table - -If you want to create your own predicate function, here's what you have -to know: The functions are called with no parameters, but the -@code{gnus-headers} and @code{gnus-score} dynamic variables are bound to -useful values. - -Now, the syntax of the download score is the same as the syntax of -normal score files, except that all elements that require actually -seeing the article itself are verboten. This means that only the -following headers can be scored on: @code{From}, @code{Subject}, -@code{Date}, @code{Xref}, @code{Lines}, @code{Chars}, @code{Message-ID}, -and @code{References}. - - -@node The Category Buffer -@subsubsection The Category Buffer - -You'd normally do all category maintenance from the category buffer. -When you enter it for the first time (with the @kbd{J c} command from -the group buffer), you'll only see the @code{default} category. - -The following commands are available in this buffer: - -@table @kbd -@item q -@kindex q (Category) -@findex gnus-category-exit -Return to the group buffer (@code{gnus-category-exit}). - -@item k -@kindex k (Category) -@findex gnus-category-kill -Kill the current category (@code{gnus-category-kill}). - -@item c -@kindex c (Category) -@findex gnus-category-copy -Copy the current category (@code{gnus-category-copy}). - -@item a -@kindex a (Category) -@findex gnus-category-add -Add a new category (@code{gnus-category-add}). - -@item p -@kindex p (Category) -@findex gnus-category-edit-predicate -Edit the predicate of the current category -(@code{gnus-category-edit-predicate}). - -@item g -@kindex g (Category) -@findex gnus-category-edit-groups -Edit the list of groups belonging to the current category -(@code{gnus-category-edit-groups}). - -@item s -@kindex s (Category) -@findex gnus-category-edit-score -Edit the download score rule of the current category -(@code{gnus-category-edit-score}). - -@item l -@kindex l (Category) -@findex gnus-category-list -List all the categories (@code{gnus-category-list}). -@end table - - -@node Category Variables -@subsubsection Category Variables - -@table @code -@item gnus-category-mode-hook -@vindex gnus-category-mode-hook -Hook run in category buffers. - -@item gnus-category-line-format -@vindex gnus-category-line-format -Format of the lines in the category buffer (@pxref{Formatting -Variables}). Legal elements are: - -@table @samp -@item c -The name of the category. - -@item g -The number of groups in the category. -@end table - -@item gnus-category-mode-line-format -@vindex gnus-category-mode-line-format -Format of the category mode line. - -@item gnus-agent-short-article -@vindex gnus-agent-short-article -Articles that have fewer lines than this are short. Default 100. - -@item gnus-agent-long-article -@vindex gnus-agent-long-article -Articles that have more lines than this are long. Default 200. - -@item gnus-agent-low-score -@vindex gnus-agent-low-score -Articles that have a score lower than this have a low score. Default -0. - -@item gnus-agent-high-score -@vindex gnus-agent-high-score -Articles that have a score higher than this have a high score. Default -0. - -@end table - - -@node Agent Commands -@subsection Agent Commands - -All the Gnus Agent commands are on the @kbd{J} submap. The @kbd{J j} -(@code{gnus-agent-toggle-plugged} command works in all modes, and -toggles the plugged/unplugged state of the Gnus Agent. - - -@menu -* Group Agent Commands:: -* Summary Agent Commands:: -* Server Agent Commands:: -@end menu - -You can run a complete batch fetch from the command line with the -following incantation: - -@cindex gnus-agent-batch-fetch -@example -$ emacs -batch -l ~/.gnus.el -f gnus-agent-batch-fetch -@end example - - - -@node Group Agent Commands -@subsubsection Group Agent Commands - -@table @kbd -@item J u -@kindex J u (Agent Group) -@findex gnus-agent-fetch-groups -Fetch all eligible articles in the current group -(@code{gnus-agent-fetch-groups}). - -@item J c -@kindex J c (Agent Group) -@findex gnus-enter-category-buffer -Enter the Agent category buffer (@code{gnus-enter-category-buffer}). - -@item J s -@kindex J s (Agent Group) -@findex gnus-agent-fetch-session -Fetch all eligible articles in all groups -(@code{gnus-agent-fetch-session}). - -@item J S -@kindex J S (Agent Group) -@findex gnus-group-send-drafts -Send all sendable messages in the draft group -(@code{gnus-agent-fetch-session}). @xref{Drafts} - -@item J a -@kindex J a (Agent Group) -@findex gnus-agent-add-group -Add the current group to an Agent category -(@code{gnus-agent-add-group}). - -@end table - - -@node Summary Agent Commands -@subsubsection Summary Agent Commands - -@table @kbd -@item J # -@kindex J # (Agent Summary) -@findex gnus-agent-mark-article -Mark the article for downloading (@code{gnus-agent-mark-article}). - -@item J M-# -@kindex J M-# (Agent Summary) -@findex gnus-agent-unmark-article -Remove the downloading mark from the article -(@code{gnus-agent-unmark-article}). - -@item @@ -@kindex @@ (Agent Summary) -@findex gnus-agent-toggle-mark -Toggle whether to download the article (@code{gnus-agent-toggle-mark}). - -@item J c -@kindex J c (Agent Summary) -@findex gnus-agent-catchup -Mark all undownloaded articles as read (@code{gnus-agent-catchup}). - -@end table - - -@node Server Agent Commands -@subsubsection Server Agent Commands - -@table @kbd -@item J a -@kindex J a (Agent Server) -@findex gnus-agent-add-server -Add the current server to the list of servers covered by the Gnus Agent -(@code{gnus-agent-add-server}). - -@item J r -@kindex J r (Agent Server) -@findex gnus-agent-remove-server -Remove the current server from the list of servers covered by the Gnus -Agent (@code{gnus-agent-remove-server}). - -@end table - - -@node Outgoing Messages -@subsection Outgoing Messages - -When Gnus is unplugged, all outgoing messages (both mail and news) are -stored in the draft groups (@pxref{Drafts}). You can view them there -after posting, and edit them at will. - -When Gnus is plugged again, you can send the messages either from the -draft group with the special commands available there, or you can use -the @kbd{J S} command in the group buffer to send all the sendable -messages in the draft group. - - - -@node Agent Variables -@subsection Agent Variables - -@table @code -@item gnus-agent-directory -@vindex gnus-agent-directory -Where the Gnus Agent will store its files. The default is -@file{~/News/agent/}. - -@item gnus-agent-handle-level -@vindex gnus-agent-handle-level -Groups on levels (@pxref{Group Levels}) higher than this variable will -be ignored by the Agent. The default is @code{gnus-level-subscribed}, -which means that only subscribed group will be considered by the Agent -by default. - -@item gnus-agent-plugged-hook -@vindex gnus-agent-plugged-hook -Hook run when connecting to the network. - -@item gnus-agent-unplugged-hook -@vindex gnus-agent-unplugged-hook -Hook run when disconnecting from the network. - -@end table - - -@node Example Setup -@subsection Example Setup - -If you don't want to read this manual, and you have a fairly standard -setup, you may be able to use something like the following as your -@file{.gnus.el} file to get started. - -@lisp -;;; Define how Gnus is to fetch news. We do this over NNTP -;;; from your ISP's server. -(setq gnus-select-method '(nntp "nntp.your-isp.com")) - -;;; Define how Gnus is to read your mail. We read mail from -;;; your ISP's POP server. -(setenv "MAILHOST" "pop.your-isp.com") -(setq nnmail-spool-file "po:username") - -;;; Say how Gnus is to store the mail. We use nnml groups. -(setq gnus-secondary-select-methods '((nnml ""))) - -;;; Make Gnus into an offline newsreader. -(gnus-agentize) -@end lisp - -That should be it, basically. Put that in your @file{~/.gnus.el} file, -edit to suit your needs, start up PPP (or whatever), and type @kbd{M-x -gnus}. - -If this is the first time you've run Gnus, you will be subscribed -automatically to a few default newsgroups. You'll probably want to -subscribe to more groups, and to do that, you have to query the -@sc{nntp} server for a complete list of groups with the @kbd{A A} -command. This usually takes quite a while, but you only have to do it -once. - -After reading and parsing a while, you'll be presented with a list of -groups. Subscribe to the ones you want to read with the @kbd{u} -command. @kbd{l} to make all the killed groups disappear after you've -subscribe to all the groups you want to read. (@kbd{A k} will bring -back all the killed groups.) - -You can now read the groups at once, or you can download the articles -with the @kbd{J s} command. And then read the rest of this manual to -find out which of the other gazillion things you want to customize. - - -@node Batching Agents -@subsection Batching Agents - -Having the Gnus Agent fetch articles (and post whatever messages you've -written) is quite easy once you've gotten things set up properly. The -following shell script will do everything that is necessary: - -@example -#!/bin/sh -emacs -batch -l ~/.emacs -f gnus-agent-batch >/dev/null -@end example - - - -@node Scoring -@chapter Scoring -@cindex scoring - -Other people use @dfn{kill files}, but we here at Gnus Towers like -scoring better than killing, so we'd rather switch than fight. They do -something completely different as well, so sit up straight and pay -attention! - -@vindex gnus-summary-mark-below -All articles have a default score (@code{gnus-summary-default-score}), -which is 0 by default. This score may be raised or lowered either -interactively or by score files. Articles that have a score lower than -@code{gnus-summary-mark-below} are marked as read. - -Gnus will read any @dfn{score files} that apply to the current group -before generating the summary buffer. - -There are several commands in the summary buffer that insert score -entries based on the current article. You can, for instance, ask Gnus to -lower or increase the score of all articles with a certain subject. - -There are two sorts of scoring entries: Permanent and temporary. -Temporary score entries are self-expiring entries. Any entries that are -temporary and have not been used for, say, a week, will be removed -silently to help keep the sizes of the score files down. - -@menu -* Summary Score Commands:: Adding score entries for the current group. -* Group Score Commands:: General score commands. -* Score Variables:: Customize your scoring. (My, what terminology). -* Score File Format:: What a score file may contain. -* Score File Editing:: You can edit score files by hand as well. -* Adaptive Scoring:: Big Sister Gnus knows what you read. -* Home Score File:: How to say where new score entries are to go. -* Followups To Yourself:: Having Gnus notice when people answer you. -* Scoring Tips:: How to score effectively. -* Reverse Scoring:: That problem child of old is not problem. -* Global Score Files:: Earth-spanning, ear-splitting score files. -* Kill Files:: They are still here, but they can be ignored. -* Converting Kill Files:: Translating kill files to score files. -* GroupLens:: Getting predictions on what you like to read. -* Advanced Scoring:: Using logical expressions to build score rules. -* Score Decays:: It can be useful to let scores wither away. -@end menu - - -@node Summary Score Commands -@section Summary Score Commands -@cindex score commands - -The score commands that alter score entries do not actually modify real -score files. That would be too inefficient. Gnus maintains a cache of -previously loaded score files, one of which is considered the -@dfn{current score file alist}. The score commands simply insert -entries into this list, and upon group exit, this list is saved. - -The current score file is by default the group's local score file, even -if no such score file actually exists. To insert score commands into -some other score file (e.g. @file{all.SCORE}), you must first make this -score file the current one. - -General score commands that don't actually change the score file: - -@table @kbd - -@item V s -@kindex V s (Summary) -@findex gnus-summary-set-score -Set the score of the current article (@code{gnus-summary-set-score}). - -@item V S -@kindex V S (Summary) -@findex gnus-summary-current-score -Display the score of the current article -(@code{gnus-summary-current-score}). - -@item V t -@kindex V t (Summary) -@findex gnus-score-find-trace -Display all score rules that have been used on the current article -(@code{gnus-score-find-trace}). - -@item V R -@kindex V R (Summary) -@findex gnus-summary-rescore -Run the current summary through the scoring process -(@code{gnus-summary-rescore}). This might be useful if you're playing -around with your score files behind Gnus' back and want to see the -effect you're having. - -@item V a -@kindex V a (Summary) -@findex gnus-summary-score-entry -Add a new score entry, and allow specifying all elements -(@code{gnus-summary-score-entry}). - -@item V c -@kindex V c (Summary) -@findex gnus-score-change-score-file -Make a different score file the current -(@code{gnus-score-change-score-file}). - -@item V e -@kindex V e (Summary) -@findex gnus-score-edit-current-scores -Edit the current score file (@code{gnus-score-edit-current-scores}). -You will be popped into a @code{gnus-score-mode} buffer (@pxref{Score -File Editing}). - -@item V f -@kindex V f (Summary) -@findex gnus-score-edit-file -Edit a score file and make this score file the current one -(@code{gnus-score-edit-file}). - -@item V F -@kindex V F (Summary) -@findex gnus-score-flush-cache -Flush the score cache (@code{gnus-score-flush-cache}). This is useful -after editing score files. - -@item V C -@kindex V C (Summary) -@findex gnus-score-customize -Customize a score file in a visually pleasing manner -(@code{gnus-score-customize}). - -@end table - -The rest of these commands modify the local score file. - -@table @kbd - -@item V m -@kindex V m (Summary) -@findex gnus-score-set-mark-below -Prompt for a score, and mark all articles with a score below this as -read (@code{gnus-score-set-mark-below}). - -@item V x -@kindex V x (Summary) -@findex gnus-score-set-expunge-below -Prompt for a score, and add a score rule to the current score file to -expunge all articles below this score -(@code{gnus-score-set-expunge-below}). -@end table - -The keystrokes for actually making score entries follow a very regular -pattern, so there's no need to list all the commands. (Hundreds of -them.) - -@findex gnus-summary-increase-score -@findex gnus-summary-lower-score - -@enumerate -@item -The first key is either @kbd{I} (upper case i) for increasing the score -or @kbd{L} for lowering the score. -@item -The second key says what header you want to score on. The following -keys are available: -@table @kbd - -@item a -Score on the author name. - -@item s -Score on the subject line. - -@item x -Score on the Xref line---i.e., the cross-posting line. - -@item t -Score on thread---the References line. - -@item d -Score on the date. - -@item l -Score on the number of lines. - -@item i -Score on the Message-ID. - -@item f -Score on followups. - -@item b -Score on the body. - -@item h -Score on the head. -@end table - -@item -The third key is the match type. Which match types are valid depends on -what headers you are scoring on. - -@table @code - -@item strings - -@table @kbd - -@item e -Exact matching. - -@item s -Substring matching. - -@item f -Fuzzy matching (@pxref{Fuzzy Matching}). - -@item r -Regexp matching -@end table - -@item date -@table @kbd - -@item b -Before date. - -@item a -At date. - -@item n -This date. -@end table - -@item number -@table @kbd - -@item < -Less than number. - -@item = -Equal to number. - -@item > -Greater than number. -@end table -@end table - -@item -The fourth and final key says whether this is a temporary (i.e., expiring) -score entry, or a permanent (i.e., non-expiring) score entry, or whether -it is to be done immediately, without adding to the score file. -@table @kbd - -@item t -Temporary score entry. - -@item p -Permanent score entry. - -@item i -Immediately scoring. -@end table - -@end enumerate - -So, let's say you want to increase the score on the current author with -exact matching permanently: @kbd{I a e p}. If you want to lower the -score based on the subject line, using substring matching, and make a -temporary score entry: @kbd{L s s t}. Pretty easy. - -To make things a bit more complicated, there are shortcuts. If you use -a capital letter on either the second or third keys, Gnus will use -defaults for the remaining one or two keystrokes. The defaults are -``substring'' and ``temporary''. So @kbd{I A} is the same as @kbd{I a s -t}, and @kbd{I a R} is the same as @kbd{I a r t}. - -These functions take both the numerical prefix and the symbolic prefix -(@pxref{Symbolic Prefixes}). A numerical prefix says how much to lower -(or increase) the score of the article. A symbolic prefix of @code{a} -says to use the @file{all.SCORE} file for the command instead of the -current score file. - -@vindex gnus-score-mimic-keymap -The @code{gnus-score-mimic-keymap} says whether these commands will -pretend they are keymaps or not. - - -@node Group Score Commands -@section Group Score Commands -@cindex group score commands - -There aren't many of these as yet, I'm afraid. - -@table @kbd - -@item W f -@kindex W f (Group) -@findex gnus-score-flush-cache -Gnus maintains a cache of score alists to avoid having to reload them -all the time. This command will flush the cache -(@code{gnus-score-flush-cache}). - -@end table - -You can do scoring from the command line by saying something like: - -@findex gnus-batch-score -@cindex batch scoring -@example -$ emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score -@end example - - -@node Score Variables -@section Score Variables -@cindex score variables - -@table @code - -@item gnus-use-scoring -@vindex gnus-use-scoring -If @code{nil}, Gnus will not check for score files, and will not, in -general, do any score-related work. This is @code{t} by default. - -@item gnus-kill-killed -@vindex gnus-kill-killed -If this variable is @code{nil}, Gnus will never apply score files to -articles that have already been through the kill process. While this -may save you lots of time, it also means that if you apply a kill file -to a group, and then change the kill file and want to run it over you -group again to kill more articles, it won't work. You have to set this -variable to @code{t} to do that. (It is @code{t} by default.) - -@item gnus-kill-files-directory -@vindex gnus-kill-files-directory -All kill and score files will be stored in this directory, which is -initialized from the @code{SAVEDIR} environment variable by default. -This is @file{~/News/} by default. - -@item gnus-score-file-suffix -@vindex gnus-score-file-suffix -Suffix to add to the group name to arrive at the score file name -(@samp{SCORE} by default.) - -@item gnus-score-uncacheable-files -@vindex gnus-score-uncacheable-files -@cindex score cache -All score files are normally cached to avoid excessive re-loading of -score files. However, if this might make you Emacs grow big and -bloated, so this regexp can be used to weed out score files unlikely to be needed again. It would be a bad idea to deny caching of -@file{all.SCORE}, while it might be a good idea to not cache -@file{comp.infosystems.www.authoring.misc.ADAPT}. In fact, this -variable is @samp{ADAPT$} by default, so no adaptive score files will -be cached. - -@item gnus-save-score -@vindex gnus-save-score -If you have really complicated score files, and do lots of batch -scoring, then you might set this variable to @code{t}. This will make -Gnus save the scores into the @file{.newsrc.eld} file. - -@item gnus-score-interactive-default-score -@vindex gnus-score-interactive-default-score -Score used by all the interactive raise/lower commands to raise/lower -score with. Default is 1000, which may seem excessive, but this is to -ensure that the adaptive scoring scheme gets enough room to play with. -We don't want the small changes from the adaptive scoring to overwrite -manually entered data. - -@item gnus-summary-default-score -@vindex gnus-summary-default-score -Default score of an article, which is 0 by default. - -@item gnus-summary-expunge-below -@vindex gnus-summary-expunge-below -Don't display the summary lines of articles that have scores lower than -this variable. This is @code{nil} by default, which means that no -articles will be hidden. This variable is local to the summary buffers, -and has to be set from @code{gnus-summary-mode-hook}. - -@item gnus-score-over-mark -@vindex gnus-score-over-mark -Mark (in the third column) used for articles with a score over the -default. Default is @samp{+}. - -@item gnus-score-below-mark -@vindex gnus-score-below-mark -Mark (in the third column) used for articles with a score below the -default. Default is @samp{-}. - -@item gnus-score-find-score-files-function -@vindex gnus-score-find-score-files-function -Function used to find score files for the current group. This function -is called with the name of the group as the argument. - -Predefined functions available are: -@table @code - -@item gnus-score-find-single -@findex gnus-score-find-single -Only apply the group's own score file. - -@item gnus-score-find-bnews -@findex gnus-score-find-bnews -Apply all score files that match, using bnews syntax. This is the -default. If the current group is @samp{gnu.emacs.gnus}, for instance, -@file{all.emacs.all.SCORE}, @file{not.alt.all.SCORE} and -@file{gnu.all.SCORE} would all apply. In short, the instances of -@samp{all} in the score file names are translated into @samp{.*}, and -then a regexp match is done. - -This means that if you have some score entries that you want to apply to -all groups, then you put those entries in the @file{all.SCORE} file. - -The score files are applied in a semi-random order, although Gnus will -try to apply the more general score files before the more specific score -files. It does this by looking at the number of elements in the score -file names---discarding the @samp{all} elements. - -@item gnus-score-find-hierarchical -@findex gnus-score-find-hierarchical -Apply all score files from all the parent groups. This means that you -can't have score files like @file{all.SCORE}, but you can have -@file{SCORE}, @file{comp.SCORE} and @file{comp.emacs.SCORE}. - -@end table -This variable can also be a list of functions. In that case, all these -functions will be called, and all the returned lists of score files will -be applied. These functions can also return lists of score alists -directly. In that case, the functions that return these non-file score -alists should probably be placed before the ``real'' score file -functions, to ensure that the last score file returned is the local -score file. Phu. - -@item gnus-score-expiry-days -@vindex gnus-score-expiry-days -This variable says how many days should pass before an unused score file -entry is expired. If this variable is @code{nil}, no score file entries -are expired. It's 7 by default. - -@item gnus-update-score-entry-dates -@vindex gnus-update-score-entry-dates -If this variable is non-@code{nil}, matching score entries will have -their dates updated. (This is how Gnus controls expiry---all -non-matching entries will become too old while matching entries will -stay fresh and young.) However, if you set this variable to @code{nil}, -even matching entries will grow old and will have to face that oh-so -grim reaper. - -@item gnus-score-after-write-file-function -@vindex gnus-score-after-write-file-function -Function called with the name of the score file just written. - -@item gnus-score-thread-simplify -@vindex gnus-score-thread-simplify -If this variable is non-@code{nil}, article subjects will be simplified -for subject scoring purposes in the same manner as with -threading---according to the current value of -gnus-simplify-subject-functions. If the scoring entry uses -@code{substring} or @code{exact} matching, the match will also be -simplified in this manner. - -@end table - - -@node Score File Format -@section Score File Format -@cindex score file format - -A score file is an @code{emacs-lisp} file that normally contains just a -single form. Casual users are not expected to edit these files; -everything can be changed from the summary buffer. - -Anyway, if you'd like to dig into it yourself, here's an example: - -@lisp -(("from" - ("Lars Ingebrigtsen" -10000) - ("Per Abrahamsen") - ("larsi\\|lmi" -50000 nil R)) - ("subject" - ("Ding is Badd" nil 728373)) - ("xref" - ("alt.politics" -1000 728372 s)) - ("lines" - (2 -100 nil <)) - (mark 0) - (expunge -1000) - (mark-and-expunge -10) - (read-only nil) - (orphan -10) - (adapt t) - (files "/hom/larsi/News/gnu.SCORE") - (exclude-files "all.SCORE") - (local (gnus-newsgroup-auto-expire t) - (gnus-summary-make-false-root empty)) - (eval (ding))) -@end lisp - -This example demonstrates most score file elements. For a different -approach, see @pxref{Advanced Scoring}. - -Even though this looks much like lisp code, nothing here is actually -@code{eval}ed. The lisp reader is used to read this form, though, so it -has to be valid syntactically, if not semantically. - -Six keys are supported by this alist: - -@table @code - -@item STRING -If the key is a string, it is the name of the header to perform the -match on. Scoring can only be performed on these eight headers: -@code{From}, @code{Subject}, @code{References}, @code{Message-ID}, -@code{Xref}, @code{Lines}, @code{Chars} and @code{Date}. In addition to -these headers, there are three strings to tell Gnus to fetch the entire -article and do the match on larger parts of the article: @code{Body} -will perform the match on the body of the article, @code{Head} will -perform the match on the head of the article, and @code{All} will -perform the match on the entire article. Note that using any of these -last three keys will slow down group entry @emph{considerably}. The -final ``header'' you can score on is @code{Followup}. These score -entries will result in new score entries being added for all follow-ups -to articles that matches these score entries. - -Following this key is a arbitrary number of score entries, where each -score entry has one to four elements. -@enumerate - -@item -The first element is the @dfn{match element}. On most headers this will -be a string, but on the Lines and Chars headers, this must be an -integer. - -@item -If the second element is present, it should be a number---the @dfn{score -element}. This number should be an integer in the neginf to posinf -interval. This number is added to the score of the article if the match -is successful. If this element is not present, the -@code{gnus-score-interactive-default-score} number will be used -instead. This is 1000 by default. - -@item -If the third element is present, it should be a number---the @dfn{date -element}. This date says when the last time this score entry matched, -which provides a mechanism for expiring the score entries. It this -element is not present, the score entry is permanent. The date is -represented by the number of days since December 31, 1 BCE. - -@item -If the fourth element is present, it should be a symbol---the @dfn{type -element}. This element specifies what function should be used to see -whether this score entry matches the article. What match types that can -be used depends on what header you wish to perform the match on. -@table @dfn - -@item From, Subject, References, Xref, Message-ID -For most header types, there are the @code{r} and @code{R} (regexp), as -well as @code{s} and @code{S} (substring) types, and @code{e} and -@code{E} (exact match), and @code{w} (word match) types. If this -element is not present, Gnus will assume that substring matching should -be used. @code{R}, @code{S}, and @code{E} differ from the others in -that the matches will be done in a case-sensitive manner. All these -one-letter types are really just abbreviations for the @code{regexp}, -@code{string}, @code{exact}, and @code{word} types, which you can use -instead, if you feel like. - -@item Lines, Chars -These two headers use different match types: @code{<}, @code{>}, -@code{=}, @code{>=} and @code{<=}. When matching on @code{Lines}, be -careful because some backends (like @code{nndir}) do not generate -@code{Lines} header, so every article ends up being marked as having 0 -lines. This can lead to strange results if you happen to lower score of -the articles with few lines. - -@item Date -For the Date header we have three kinda silly match types: -@code{before}, @code{at} and @code{after}. I can't really imagine this -ever being useful, but, like, it would feel kinda silly not to provide -this function. Just in case. You never know. Better safe than sorry. -Once burnt, twice shy. Don't judge a book by its cover. Never not have -sex on a first date. (I have been told that at least one person, and I -quote, ``found this function indispensable'', however.) - -@cindex ISO8601 -@cindex date -A more useful match type is @code{regexp}. With it, you can match the -date string using a regular expression. The date is normalized to -ISO8601 compact format first---@var{YYYYMMDD}@code{T}@var{HHMMSS}. If -you want to match all articles that have been posted on April 1st in -every year, you could use @samp{....0401.........} as a match string, -for instance. (Note that the date is kept in its original time zone, so -this will match articles that were posted when it was April 1st where -the article was posted from. Time zones are such wholesome fun for the -whole family, eh?) - -@item Head, Body, All -These three match keys use the same match types as the @code{From} (etc) -header uses. - -@item Followup -This match key is somewhat special, in that it will match the -@code{From} header, and affect the score of not only the matching -articles, but also all followups to the matching articles. This allows -you e.g. increase the score of followups to your own articles, or -decrease the score of followups to the articles of some known -trouble-maker. Uses the same match types as the @code{From} header -uses. (Using this match key will lead to creation of @file{ADAPT} -files.) - -@item Thread -This match key works along the same lines as the @code{Followup} match -key. If you say that you want to score on a (sub-)thread started by an article with a @code{Message-ID} @var{X}, then you add a -@samp{thread} match. This will add a new @samp{thread} match for each -article that has @var{X} in its @code{References} header. (These new -@samp{thread} matches will use the @code{Message-ID}s of these matching -articles.) This will ensure that you can raise/lower the score of an -entire thread, even though some articles in the thread may not have -complete @code{References} headers. Note that using this may lead to -undeterministic scores of the articles in the thread. (Using this match -key will lead to creation of @file{ADAPT} files.) -@end table -@end enumerate - -@cindex Score File Atoms -@item mark -The value of this entry should be a number. Any articles with a score -lower than this number will be marked as read. - -@item expunge -The value of this entry should be a number. Any articles with a score -lower than this number will be removed from the summary buffer. - -@item mark-and-expunge -The value of this entry should be a number. Any articles with a score -lower than this number will be marked as read and removed from the -summary buffer. - -@item thread-mark-and-expunge -The value of this entry should be a number. All articles that belong to -a thread that has a total score below this number will be marked as read -and removed from the summary buffer. @code{gnus-thread-score-function} -says how to compute the total score for a thread. - -@item files -The value of this entry should be any number of file names. These files -are assumed to be score files as well, and will be loaded the same way -this one was. - -@item exclude-files -The clue of this entry should be any number of files. These files will -not be loaded, even though they would normally be so, for some reason or -other. - -@item eval -The value of this entry will be @code{eval}el. This element will be -ignored when handling global score files. - -@item read-only -Read-only score files will not be updated or saved. Global score files -should feature this atom (@pxref{Global Score Files}). - -@item orphan -The value of this entry should be a number. Articles that do not have -parents will get this number added to their scores. Imagine you follow -some high-volume newsgroup, like @samp{comp.lang.c}. Most likely you -will only follow a few of the threads, also want to see any new threads. - -You can do this with the following two score file entries: - -@example - (orphan -500) - (mark-and-expunge -100) -@end example - -When you enter the group the first time, you will only see the new -threads. You then raise the score of the threads that you find -interesting (with @kbd{I T} or @kbd{I S}), and ignore (@kbd{C y}) the -rest. Next time you enter the group, you will see new articles in the -interesting threads, plus any new threads. - -I.e.---the orphan score atom is for high-volume groups where there -exist a few interesting threads which can't be found automatically by -ordinary scoring rules. - -@item adapt -This entry controls the adaptive scoring. If it is @code{t}, the -default adaptive scoring rules will be used. If it is @code{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 @code{t} or @code{ignore}, the default -adaptive scoring rules will be used. If you want to use adaptive -scoring on most groups, you'd set @code{gnus-use-adaptive-scoring} to -@code{t}, and insert an @code{(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 @code{gnus-use-adaptive-scoring} to @code{nil}, and -insert @code{(adapt t)} in the score files of the groups where you want -it. - -@item adapt-file -All adaptive score entries will go to the file named by this entry. It -will also be applied when entering the group. This atom might be handy -if you want to adapt on several groups at once, using the same adaptive -file for a number of groups. - -@item local -@cindex local variables -The value of this entry should be a list of @code{(VAR VALUE)} pairs. -Each @var{var} will be made buffer-local to the current summary buffer, -and set to the value specified. This is a convenient, if somewhat -strange, way of setting variables in some groups if you don't like hooks -much. Note that the @var{value} won't be evaluated. -@end table - - -@node Score File Editing -@section Score File Editing - -You normally enter all scoring commands from the summary buffer, but you -might feel the urge to edit them by hand as well, so we've supplied you -with a mode for that. - -It's simply a slightly customized @code{emacs-lisp} mode, with these -additional commands: - -@table @kbd - -@item C-c C-c -@kindex C-c C-c (Score) -@findex gnus-score-edit-done -Save the changes you have made and return to the summary buffer -(@code{gnus-score-edit-done}). - -@item C-c C-d -@kindex C-c C-d (Score) -@findex gnus-score-edit-insert-date -Insert the current date in numerical format -(@code{gnus-score-edit-insert-date}). This is really the day number, if -you were wondering. - -@item C-c C-p -@kindex C-c C-p (Score) -@findex gnus-score-pretty-print -The adaptive score files are saved in an unformatted fashion. If you -intend to read one of these files, you want to @dfn{pretty print} it -first. This command (@code{gnus-score-pretty-print}) does that for -you. - -@end table - -Type @kbd{M-x gnus-score-mode} to use this mode. - -@vindex gnus-score-mode-hook -@code{gnus-score-menu-hook} is run in score mode buffers. - -In the summary buffer you can use commands like @kbd{V f} and @kbd{V -e} to begin editing score files. - - -@node Adaptive Scoring -@section Adaptive Scoring -@cindex adaptive scoring - -If all this scoring is getting you down, Gnus has a way of making it all -happen automatically---as if by magic. Or rather, as if by artificial -stupidity, to be precise. - -@vindex gnus-use-adaptive-scoring -When you read an article, or mark an article as read, or kill an -article, you leave marks behind. On exit from the group, Gnus can sniff -these marks and add score elements depending on what marks it finds. -You turn on this ability by setting @code{gnus-use-adaptive-scoring} to -@code{t} or @code{(line)}. If you want score adaptively on separate -words appearing in the subjects, you should set this variable to -@code{(word)}. If you want to use both adaptive methods, set this -variable to @code{(word line)}. - -@vindex gnus-default-adaptive-score-alist -To give you complete control over the scoring process, you can customize -the @code{gnus-default-adaptive-score-alist} variable. For instance, it -might look something like this: - -@lisp -(defvar gnus-default-adaptive-score-alist - '((gnus-unread-mark) - (gnus-ticked-mark (from 4)) - (gnus-dormant-mark (from 5)) - (gnus-del-mark (from -4) (subject -1)) - (gnus-read-mark (from 4) (subject 2)) - (gnus-expirable-mark (from -1) (subject -1)) - (gnus-killed-mark (from -1) (subject -3)) - (gnus-kill-file-mark) - (gnus-ancient-mark) - (gnus-low-score-mark) - (gnus-catchup-mark (from -1) (subject -1)))) -@end lisp - -As you see, each element in this alist has a mark as a key (either a -variable name or a ``real'' mark---a character). Following this key is -a arbitrary number of header/score pairs. If there are no header/score -pairs following the key, no adaptive scoring will be done on articles -that have that key as the article mark. For instance, articles with -@code{gnus-unread-mark} in the example above will not get adaptive score -entries. - -Each article can have only one mark, so just a single of these rules -will be applied to each article. - -To take @code{gnus-del-mark} as an example---this alist says that all -articles that have that mark (i.e., are marked with @samp{D}) will have a -score entry added to lower based on the @code{From} header by -4, and -lowered by @code{Subject} by -1. Change this to fit your prejudices. - -If you have marked 10 articles with the same subject with -@code{gnus-del-mark}, the rule for that mark will be applied ten times. -That means that that subject will get a score of ten times -1, which -should be, unless I'm much mistaken, -10. - -If you have auto-expirable (mail) groups (@pxref{Expiring Mail}), all -the read articles will be marked with the @samp{E} mark. This'll -probably make adaptive scoring slightly impossible, so auto-expiring and -adaptive scoring doesn't really mix very well. - -The headers you can score on are @code{from}, @code{subject}, -@code{message-id}, @code{references}, @code{xref}, @code{lines}, -@code{chars} and @code{date}. In addition, you can score on -@code{followup}, which will create an adaptive score entry that matches -on the @code{References} header using the @code{Message-ID} of the -current article, thereby matching the following thread. - -You can also score on @code{thread}, which will try to score all -articles that appear in a thread. @code{thread} matches uses a -@code{Message-ID} to match on the @code{References} header of the -article. If the match is made, the @code{Message-ID} of the article is -added to the @code{thread} rule. (Think about it. I'd recommend two -aspirins afterwards.) - -If you use this scheme, you should set the score file atom @code{mark} -to something small---like -300, perhaps, to avoid having small random -changes result in articles getting marked as read. - -After using adaptive scoring for a week or so, Gnus should start to -become properly trained and enhance the authors you like best, and kill -the authors you like least, without you having to say so explicitly. - -You can control what groups the adaptive scoring is to be performed on -by using the score files (@pxref{Score File Format}). This will also -let you use different rules in different groups. - -@vindex gnus-adaptive-file-suffix -The adaptive score entries will be put into a file where the name is the -group name with @code{gnus-adaptive-file-suffix} appended. The default -is @samp{ADAPT}. - -@vindex gnus-score-exact-adapt-limit -When doing adaptive scoring, substring or fuzzy matching would probably -give you the best results in most cases. However, if the header one -matches is short, the possibility for false positives is great, so if -the length of the match is less than -@code{gnus-score-exact-adapt-limit}, exact matching will be used. If -this variable is @code{nil}, exact matching will always be used to avoid -this problem. - -@vindex gnus-default-adaptive-word-score-alist -As mentioned above, you can adapt either on individual words or entire -headers. If you adapt on words, the -@code{gnus-default-adaptive-word-score-alist} variable says what score -each instance of a word should add given a mark. - -@lisp -(setq gnus-default-adaptive-word-score-alist - `((,gnus-read-mark . 30) - (,gnus-catchup-mark . -10) - (,gnus-killed-mark . -20) - (,gnus-del-mark . -15))) -@end lisp - -This is the default value. If you have adaption on words enabled, every -word that appears in subjects of articles marked with -@code{gnus-read-mark} will result in a score rule that increase the -score with 30 points. - -@vindex gnus-default-ignored-adaptive-words -@vindex gnus-ignored-adaptive-words -Words that appear in the @code{gnus-default-ignored-adaptive-words} list -will be ignored. If you wish to add more words to be ignored, use the -@code{gnus-ignored-adaptive-words} list instead. - -@vindex gnus-adaptive-word-syntax-table -When the scoring is done, @code{gnus-adaptive-word-syntax-table} is the -syntax table in effect. It is similar to the standard syntax table, but -it considers numbers to be non-word-constituent characters. - -@vindex gnus-adaptive-word-minimum -If @code{gnus-adaptive-word-minimum} is set to a number, the adaptive -word scoring process will never bring down the score of an article to -below this number. The default is @code{nil}. - -After using this scheme for a while, it might be nice to write a -@code{gnus-psychoanalyze-user} command to go through the rules and see -what words you like and what words you don't like. Or perhaps not. - -Note that the adaptive word scoring thing is highly experimental and is -likely to change in the future. Initial impressions seem to indicate -that it's totally useless as it stands. Some more work (involving more -rigorous statistical methods) will have to be done to make this useful. - - -@node Home Score File -@section Home Score File - -The score file where new score file entries will go is called the -@dfn{home score file}. This is normally (and by default) the score file -for the group itself. For instance, the home score file for -@samp{gnu.emacs.gnus} is @file{gnu.emacs.gnus.SCORE}. - -However, this may not be what you want. It is often convenient to share -a common home score file among many groups---all @samp{emacs} groups -could perhaps use the same home score file. - -@vindex gnus-home-score-file -The variable that controls this is @code{gnus-home-score-file}. It can -be: - -@enumerate -@item -A string. Then this file will be used as the home score file for all -groups. - -@item -A function. The result of this function will be used as the home score -file. The function will be called with the name of the group as the -parameter. - -@item -A list. The elements in this list can be: - -@enumerate -@item -@var{(regexp file-name)}. If the @var{regexp} matches the group name, -the @var{file-name} will will be used as the home score file. - -@item -A function. If the function returns non-nil, the result will be used as -the home score file. - -@item -A string. Use the string as the home score file. -@end enumerate - -The list will be traversed from the beginning towards the end looking -for matches. - -@end enumerate - -So, if you want to use just a single score file, you could say: - -@lisp -(setq gnus-home-score-file - "my-total-score-file.SCORE") -@end lisp - -If you want to use @file{gnu.SCORE} for all @samp{gnu} groups and -@file{rec.SCORE} for all @samp{rec} groups (and so on), you can say: - -@lisp -(setq gnus-home-score-file - 'gnus-hierarchial-home-score-file) -@end lisp - -This is a ready-made function provided for your convenience. - -If you want to have one score file for the @samp{emacs} groups and -another for the @samp{comp} groups, while letting all other groups use -their own home score files: - -@lisp -(setq gnus-home-score-file - ;; All groups that match the regexp "\\.emacs" - '("\\.emacs" "emacs.SCORE") - ;; All the comp groups in one score file - ("^comp" "comp.SCORE")) -@end lisp - -@vindex gnus-home-adapt-file -@code{gnus-home-adapt-file} works exactly the same way as -@code{gnus-home-score-file}, but says what the home adaptive score file -is instead. All new adaptive file entries will go into the file -specified by this variable, and the same syntax is allowed. - -In addition to using @code{gnus-home-score-file} and -@code{gnus-home-adapt-file}, you can also use group parameters -(@pxref{Group Parameters}) and topic parameters (@pxref{Topic -Parameters}) to achieve much the same. Group and topic parameters take -precedence over this variable. - - -@node Followups To Yourself -@section Followups To Yourself - -Gnus offers two commands for picking out the @code{Message-ID} header in -the current buffer. Gnus will then add a score rule that scores using -this @code{Message-ID} on the @code{References} header of other -articles. This will, in effect, increase the score of all articles that -respond to the article in the current buffer. Quite useful if you want -to easily note when people answer what you've said. - -@table @code - -@item gnus-score-followup-article -@findex gnus-score-followup-article -This will add a score to articles that directly follow up your own -article. - -@item gnus-score-followup-thread -@findex gnus-score-followup-thread -This will add a score to all articles that appear in a thread ``below'' -your own article. -@end table - -@vindex message-sent-hook -These two functions are both primarily meant to be used in hooks like -@code{message-sent-hook}. - -If you look closely at your own @code{Message-ID}, you'll notice that -the first two or three characters are always the same. Here's two of -mine: - -@example - - -@end example - -So ``my'' ident on this machine is @samp{x6}. This can be -exploited---the following rule will raise the score on all followups to -myself: - -@lisp -("references" - ("" - 1000 nil r)) -@end lisp - -Whether it's the first two or first three characters that are ``yours'' -is system-dependent. - - -@node Scoring Tips -@section Scoring Tips -@cindex scoring tips - -@table @dfn - -@item Crossposts -@cindex crossposts -@cindex scoring crossposts -If you want to lower the score of crossposts, the line to match on is -the @code{Xref} header. -@lisp -("xref" (" talk.politics.misc:" -1000)) -@end lisp - -@item Multiple crossposts -If you want to lower the score of articles that have been crossposted to -more than, say, 3 groups: -@lisp -("xref" ("[^:\n]+:[0-9]+ +[^:\n]+:[0-9]+ +[^:\n]+:[0-9]+" -1000 nil r)) -@end lisp - -@item Matching on the body -This is generally not a very good idea---it takes a very long time. -Gnus actually has to fetch each individual article from the server. But -you might want to anyway, I guess. Even though there are three match -keys (@code{Head}, @code{Body} and @code{All}), you should choose one -and stick with it in each score file. If you use any two, each article -will be fetched @emph{twice}. If you want to match a bit on the -@code{Head} and a bit on the @code{Body}, just use @code{All} for all -the matches. - -@item Marking as read -You will probably want to mark articles that has a score below a certain -number as read. This is most easily achieved by putting the following -in your @file{all.SCORE} file: -@lisp -((mark -100)) -@end lisp -You may also consider doing something similar with @code{expunge}. - -@item Negated character classes -If you say stuff like @code{[^abcd]*}, you may get unexpected results. -That will match newlines, which might lead to, well, The Unknown. Say -@code{[^abcd\n]*} instead. -@end table - - -@node Reverse Scoring -@section Reverse Scoring -@cindex reverse scoring - -If you want to keep just articles that have @samp{Sex with Emacs} in the -subject header, and expunge all other articles, you could put something -like this in your score file: - -@lisp -(("subject" - ("Sex with Emacs" 2)) - (mark 1) - (expunge 1)) -@end lisp - -So, you raise all articles that match @samp{Sex with Emacs} and mark the -rest as read, and expunge them to boot. - - -@node Global Score Files -@section Global Score Files -@cindex global score files - -Sure, other newsreaders have ``global kill files''. These are usually -nothing more than a single kill file that applies to all groups, stored -in the user's home directory. Bah! Puny, weak newsreaders! - -What I'm talking about here are Global Score Files. Score files from -all over the world, from users everywhere, uniting all nations in one -big, happy score file union! Ange-score! New and untested! - -@vindex gnus-global-score-files -All you have to do to use other people's score files is to set the -@code{gnus-global-score-files} variable. One entry for each score file, -or each score file directory. Gnus will decide by itself what score -files are applicable to which group. - -Say you want to use the score file -@file{/ftp@@ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE} and -all score files in the @file{/ftp@@ftp.some-where:/pub/score} directory: - -@lisp -(setq gnus-global-score-files - '("/ftp@@ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE" - "/ftp@@ftp.some-where:/pub/score/")) -@end lisp - -@findex gnus-score-search-global-directories -Simple, eh? Directory names must end with a @samp{/}. These -directories are typically scanned only once during each Gnus session. -If you feel the need to manually re-scan the remote directories, you can -use the @code{gnus-score-search-global-directories} command. - -Note that, at present, using this option will slow down group entry -somewhat. (That is---a lot.) - -If you want to start maintaining score files for other people to use, -just put your score file up for anonymous ftp and announce it to the -world. Become a retro-moderator! Participate in the retro-moderator -wars sure to ensue, where retro-moderators battle it out for the -sympathy of the people, luring them to use their score files on false -premises! Yay! The net is saved! - -Here are some tips for the would-be retro-moderator, off the top of my -head: - -@itemize @bullet - -@item -Articles heavily crossposted are probably junk. -@item -To lower a single inappropriate article, lower by @code{Message-ID}. -@item -Particularly brilliant authors can be raised on a permanent basis. -@item -Authors that repeatedly post off-charter for the group can safely be -lowered out of existence. -@item -Set the @code{mark} and @code{expunge} atoms to obliterate the nastiest -articles completely. - -@item -Use expiring score entries to keep the size of the file down. You -should probably have a long expiry period, though, as some sites keep -old articles for a long time. -@end itemize - -... I wonder whether other newsreaders will support global score files -in the future. @emph{Snicker}. Yup, any day now, newsreaders like Blue -Wave, xrn and 1stReader are bound to implement scoring. Should we start -holding our breath yet? - - -@node Kill Files -@section Kill Files -@cindex kill files - -Gnus still supports those pesky old kill files. In fact, the kill file -entries can now be expiring, which is something I wrote before Daniel -Quinlan thought of doing score files, so I've left the code in there. - -In short, kill processing is a lot slower (and I do mean @emph{a lot}) -than score processing, so it might be a good idea to rewrite your kill -files into score files. - -Anyway, a kill file is a normal @code{emacs-lisp} file. You can put any -forms into this file, which means that you can use kill files as some -sort of primitive hook function to be run on group entry, even though -that isn't a very good idea. - -Normal kill files look like this: - -@lisp -(gnus-kill "From" "Lars Ingebrigtsen") -(gnus-kill "Subject" "ding") -(gnus-expunge "X") -@end lisp - -This will mark every article written by me as read, and remove the -marked articles from the summary buffer. Very useful, you'll agree. - -Other programs use a totally different kill file syntax. If Gnus -encounters what looks like a @code{rn} kill file, it will take a stab at -interpreting it. - -Two summary functions for editing a GNUS kill file: - -@table @kbd - -@item M-k -@kindex M-k (Summary) -@findex gnus-summary-edit-local-kill -Edit this group's kill file (@code{gnus-summary-edit-local-kill}). - -@item M-K -@kindex M-K (Summary) -@findex gnus-summary-edit-global-kill -Edit the general kill file (@code{gnus-summary-edit-global-kill}). -@end table - -Two group mode functions for editing the kill files: - -@table @kbd - -@item M-k -@kindex M-k (Group) -@findex gnus-group-edit-local-kill -Edit this group's kill file (@code{gnus-group-edit-local-kill}). - -@item M-K -@kindex M-K (Group) -@findex gnus-group-edit-global-kill -Edit the general kill file (@code{gnus-group-edit-global-kill}). -@end table - -Kill file variables: - -@table @code -@item gnus-kill-file-name -@vindex gnus-kill-file-name -A kill file for the group @samp{soc.motss} is normally called -@file{soc.motss.KILL}. The suffix appended to the group name to get -this file name is detailed by the @code{gnus-kill-file-name} variable. -The ``global'' kill file (not in the score file sense of ``global'', of -course) is just called @file{KILL}. - -@vindex gnus-kill-save-kill-file -@item gnus-kill-save-kill-file -If this variable is non-@code{nil}, Gnus will save the -kill file after processing, which is necessary if you use expiring -kills. - -@item gnus-apply-kill-hook -@vindex gnus-apply-kill-hook -@findex gnus-apply-kill-file-unless-scored -@findex gnus-apply-kill-file -A hook called to apply kill files to a group. It is -@code{(gnus-apply-kill-file)} by default. If you want to ignore the -kill file if you have a score file for the same group, you can set this -hook to @code{(gnus-apply-kill-file-unless-scored)}. If you don't want -kill files to be processed, you should set this variable to @code{nil}. - -@item gnus-kill-file-mode-hook -@vindex gnus-kill-file-mode-hook -A hook called in kill-file mode buffers. - -@end table - - -@node Converting Kill Files -@section Converting Kill Files -@cindex kill files -@cindex converting kill files - -If you have loads of old kill files, you may want to convert them into -score files. If they are ``regular'', you can use -the @file{gnus-kill-to-score.el} package; if not, you'll have to do it -by hand. - -The kill to score conversion package isn't included in Gnus by default. -You can fetch it from -@file{http://www.ifi.uio.no/~larsi/ding-other/gnus-kill-to-score}. - -If your old kill files are very complex---if they contain more -non-@code{gnus-kill} forms than not, you'll have to convert them by -hand. Or just let them be as they are. Gnus will still use them as -before. - - -@node GroupLens -@section GroupLens -@cindex GroupLens - -GroupLens is a collaborative filtering system that helps you work -together with other people to find the quality news articles out of the -huge volume of news articles generated every day. - -To accomplish this the GroupLens system combines your opinions about -articles you have already read with the opinions of others who have done -likewise and gives you a personalized prediction for each unread news -article. Think of GroupLens as a matchmaker. GroupLens watches how you -rate articles, and finds other people that rate articles the same way. -Once it has found some people you agree with it tells you, in the form -of a prediction, what they thought of the article. You can use this -prediction to help you decide whether or not you want to read the -article. - -@menu -* Using GroupLens:: How to make Gnus use GroupLens. -* Rating Articles:: Letting GroupLens know how you rate articles. -* Displaying Predictions:: Displaying predictions given by GroupLens. -* GroupLens Variables:: Customizing GroupLens. -@end menu - - -@node Using GroupLens -@subsection Using GroupLens - -To use GroupLens you must register a pseudonym with your local Better -Bit Bureau (BBB). -@samp{http://www.cs.umn.edu/Research/GroupLens/bbb.html} is the only -better bit in town at the moment. - -Once you have registered you'll need to set a couple of variables. - -@table @code - -@item gnus-use-grouplens -@vindex gnus-use-grouplens -Setting this variable to a non-@code{nil} value will make Gnus hook into -all the relevant GroupLens functions. - -@item grouplens-pseudonym -@vindex grouplens-pseudonym -This variable should be set to the pseudonym you got when registering -with the Better Bit Bureau. - -@item grouplens-newsgroups -@vindex grouplens-newsgroups -A list of groups that you want to get GroupLens predictions for. - -@end table - -That's the minimum of what you need to get up and running with GroupLens. -Once you've registered, GroupLens will start giving you scores for -articles based on the average of what other people think. But, to get -the real benefit of GroupLens you need to start rating articles -yourself. Then the scores GroupLens gives you will be personalized for -you, based on how the people you usually agree with have already rated. - - -@node Rating Articles -@subsection Rating Articles - -In GroupLens, an article is rated on a scale from 1 to 5, inclusive. -Where 1 means something like this article is a waste of bandwidth and 5 -means that the article was really good. The basic question to ask -yourself is, "on a scale from 1 to 5 would I like to see more articles -like this one?" - -There are four ways to enter a rating for an article in GroupLens. - -@table @kbd - -@item r -@kindex r (GroupLens) -@findex bbb-summary-rate-article -This function will prompt you for a rating on a scale of one to five. - -@item k -@kindex k (GroupLens) -@findex grouplens-score-thread -This function will prompt you for a rating, and rate all the articles in -the thread. This is really useful for some of those long running giant -threads in rec.humor. - -@end table - -The next two commands, @kbd{n} and @kbd{,} take a numerical prefix to be -the score of the article you're reading. - -@table @kbd - -@item 1-5 n -@kindex n (GroupLens) -@findex grouplens-next-unread-article -Rate the article and go to the next unread article. - -@item 1-5 , -@kindex , (GroupLens) -@findex grouplens-best-unread-article -Rate the article and go to the next unread article with the highest score. - -@end table - -If you want to give the current article a score of 4 and then go to the -next article, just type @kbd{4 n}. - - -@node Displaying Predictions -@subsection Displaying Predictions - -GroupLens makes a prediction for you about how much you will like a -news article. The predictions from GroupLens are on a scale from 1 to -5, where 1 is the worst and 5 is the best. You can use the predictions -from GroupLens in one of three ways controlled by the variable -@code{gnus-grouplens-override-scoring}. - -@vindex gnus-grouplens-override-scoring -There are three ways to display predictions in grouplens. You may -choose to have the GroupLens scores contribute to, or override the -regular gnus scoring mechanism. override is the default; however, some -people prefer to see the Gnus scores plus the grouplens scores. To get -the separate scoring behavior you need to set -@code{gnus-grouplens-override-scoring} to @code{'separate}. To have the -GroupLens predictions combined with the grouplens scores set it to -@code{'override} and to combine the scores set -@code{gnus-grouplens-override-scoring} to @code{'combine}. When you use -the combine option you will also want to set the values for -@code{grouplens-prediction-offset} and -@code{grouplens-score-scale-factor}. - -@vindex grouplens-prediction-display -In either case, GroupLens gives you a few choices for how you would like -to see your predictions displayed. The display of predictions is -controlled by the @code{grouplens-prediction-display} variable. - -The following are valid values for that variable. - -@table @code -@item prediction-spot -The higher the prediction, the further to the right an @samp{*} is -displayed. - -@item confidence-interval -A numeric confidence interval. - -@item prediction-bar -The higher the prediction, the longer the bar. - -@item confidence-bar -Numerical confidence. - -@item confidence-spot -The spot gets bigger with more confidence. - -@item prediction-num -Plain-old numeric value. - -@item confidence-plus-minus -Prediction +/- confidence. - -@end table - - -@node GroupLens Variables -@subsection GroupLens Variables - -@table @code - -@item gnus-summary-grouplens-line-format -The summary line format used in GroupLens-enhanced summary buffers. It -accepts the same specs as the normal summary line format (@pxref{Summary -Buffer Lines}). The default is @samp{%U%R%z%l%I%(%[%4L: %-20,20n%]%) -%s\n}. - -@item grouplens-bbb-host -Host running the bbbd server. @samp{grouplens.cs.umn.edu} is the -default. - -@item grouplens-bbb-port -Port of the host running the bbbd server. The default is 9000. - -@item grouplens-score-offset -Offset the prediction by this value. In other words, subtract the -prediction value by this number to arrive at the effective score. The -default is 0. - -@item grouplens-score-scale-factor -This variable allows the user to magnify the effect of GroupLens scores. -The scale factor is applied after the offset. The default is 1. - -@end table - - -@node Advanced Scoring -@section Advanced Scoring - -Scoring on Subjects and From headers is nice enough, but what if you're -really interested in what a person has to say only when she's talking -about a particular subject? Or what if you really don't want to -read what person A has to say when she's following up to person B, but -want to read what she says when she's following up to person C? - -By using advanced scoring rules you may create arbitrarily complex -scoring patterns. - -@menu -* Advanced Scoring Syntax:: A definition. -* Advanced Scoring Examples:: What they look like. -* Advanced Scoring Tips:: Getting the most out of it. -@end menu - - -@node Advanced Scoring Syntax -@subsection Advanced Scoring Syntax - -Ordinary scoring rules have a string as the first element in the rule. -Advanced scoring rules have a list as the first element. The second -element is the score to be applied if the first element evaluated to a -non-@code{nil} value. - -These lists may consist of three logical operators, one redirection -operator, and various match operators. - -Logical operators: - -@table @code -@item & -@itemx and -This logical operator will evaluate each of its arguments until it finds -one that evaluates to @code{false}, and then it'll stop. If all arguments -evaluate to @code{true} values, then this operator will return -@code{true}. - -@item | -@itemx or -This logical operator will evaluate each of its arguments until it finds -one that evaluates to @code{true}. If no arguments are @code{true}, -then this operator will return @code{false}. - -@item ! -@itemx not -@itemx ¬ -This logical operator only takes a single argument. It returns the -logical negation of the value of its argument. - -@end table - -There is an @dfn{indirection operator} that will make its arguments -apply to the ancestors of the current article being scored. For -instance, @code{1-} will make score rules apply to the parent of the -current article. @code{2-} will make score rules apply to the -grandparent of the current article. Alternatively, you can write -@code{^^}, where the number of @code{^}s (carets) says how far back into -the ancestry you want to go. - -Finally, we have the match operators. These are the ones that do the -real work. Match operators are header name strings followed by a match -and a match type. A typical match operator looks like @samp{("from" -"Lars Ingebrigtsen" s)}. The header names are the same as when using -simple scoring, and the match types are also the same. - - -@node Advanced Scoring Examples -@subsection Advanced Scoring Examples - -Let's say you want to increase the score of articles written by Lars -when he's talking about Gnus: - -@example -((& - ("from" "Lars Ingebrigtsen") - ("subject" "Gnus")) - 1000) -@end example - -Quite simple, huh? - -When he writes long articles, he sometimes has something nice to say: - -@example -((& - ("from" "Lars Ingebrigtsen") - (| - ("subject" "Gnus") - ("lines" 100 >))) - 1000) -@end example - -However, when he responds to things written by Reig Eigil Logge, you -really don't want to read what he's written: - -@example -((& - ("from" "Lars Ingebrigtsen") - (1- ("from" "Reig Eigir Logge"))) - -100000) -@end example - -Everybody that follows up Redmondo when he writes about disappearing -socks should have their scores raised, but only when they talk about -white socks. However, when Lars talks about socks, it's usually not -very interesting: - -@example -((& - (1- - (& - ("from" "redmondo@@.*no" r) - ("body" "disappearing.*socks" t))) - (! ("from" "Lars Ingebrigtsen")) - ("body" "white.*socks")) - 1000) -@end example - -The possibilities are endless. - - -@node Advanced Scoring Tips -@subsection Advanced Scoring Tips - -The @code{&} and @code{|} logical operators do short-circuit logic. -That is, they stop processing their arguments when it's clear what the -result of the operation will be. For instance, if one of the arguments -of an @code{&} evaluates to @code{false}, there's no point in evaluating -the rest of the arguments. This means that you should put slow matches -(@samp{body}, @samp{header}) last and quick matches (@samp{from}, -@samp{subject}) first. - -The indirection arguments (@code{1-} and so on) will make their -arguments work on previous generations of the thread. If you say -something like: - -@example -... -(1- - (1- - ("from" "lars"))) -... -@end example - -Then that means "score on the from header of the grandparent of the -current article". An indirection is quite fast, but it's better to say: - -@example -(1- - (& - ("from" "Lars") - ("subject" "Gnus"))) -@end example - -than it is to say: - -@example -(& - (1- ("from" "Lars")) - (1- ("subject" "Gnus"))) -@end example - - -@node Score Decays -@section Score Decays -@cindex score decays -@cindex decays - -You may find that your scores have a tendency to grow without -bounds, especially if you're using adaptive scoring. If scores get too -big, they lose all meaning---they simply max out and it's difficult to -use them in any sensible way. - -@vindex gnus-decay-scores -@findex gnus-decay-score -@vindex gnus-score-decay-function -Gnus provides a mechanism for decaying scores to help with this problem. -When score files are loaded and @code{gnus-decay-scores} is -non-@code{nil}, Gnus will run the score files through the decaying -mechanism thereby lowering the scores of all non-permanent score rules. -The decay itself if performed by the @code{gnus-score-decay-function} -function, which is @code{gnus-decay-score} by default. Here's the -definition of that function: - -@lisp -(defun gnus-decay-score (score) - "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'." - (floor - (- score - (* (if (< score 0) 1 -1) - (min (abs score) - (max gnus-score-decay-constant - (* (abs score) - gnus-score-decay-scale))))))) -@end lisp - -@vindex gnus-score-decay-scale -@vindex gnus-score-decay-constant -@code{gnus-score-decay-constant} is 3 by default and -@code{gnus-score-decay-scale} is 0.05. This should cause the following: - -@enumerate -@item -Scores between -3 and 3 will be set to 0 when this function is called. - -@item -Scores with magnitudes between 3 and 60 will be shrunk by 3. - -@item -Scores with magnitudes greater than 60 will be shrunk by 5% of the -score. -@end enumerate - -If you don't like this decay function, write your own. It is called -with the score to be decayed as its only parameter, and it should return -the new score, which should be an integer. - -Gnus will try to decay scores once a day. If you haven't run Gnus for -four days, Gnus will decay the scores four times, for instance. - - -@node Various -@chapter Various - -@menu -* Process/Prefix:: A convention used by many treatment commands. -* Interactive:: Making Gnus ask you many questions. -* Symbolic Prefixes:: How to supply some Gnus functions with options. -* Formatting Variables:: You can specify what buffers should look like. -* Windows Configuration:: Configuring the Gnus buffer windows. -* Faces and Fonts:: How to change how faces look. -* Compilation:: How to speed Gnus up. -* Mode Lines:: Displaying information in the mode lines. -* Highlighting and Menus:: Making buffers look all nice and cozy. -* Buttons:: Get tendonitis in ten easy steps! -* Daemons:: Gnus can do things behind your back. -* NoCeM:: How to avoid spam and other fatty foods. -* Undo:: Some actions can be undone. -* Moderation:: What to do if you're a moderator. -* XEmacs Enhancements:: There are more pictures and stuff under XEmacs. -* Fuzzy Matching:: What's the big fuzz? -* Thwarting Email Spam:: A how-to on avoiding unsolited commercial email. -* Various Various:: Things that are really various. -@end menu - - -@node Process/Prefix -@section Process/Prefix -@cindex process/prefix convention - -Many functions, among them functions for moving, decoding and saving -articles, use what is known as the @dfn{Process/Prefix convention}. - -This is a method for figuring out what articles the user wants the -command to be performed on. - -It goes like this: - -If the numeric prefix is N, perform the operation on the next N -articles, starting with the current one. If the numeric prefix is -negative, perform the operation on the previous N articles, starting -with the current one. - -@vindex transient-mark-mode -If @code{transient-mark-mode} in non-@code{nil} and the region is -active, all articles in the region will be worked upon. - -If there is no numeric prefix, but some articles are marked with the -process mark, perform the operation on the articles marked with -the process mark. - -If there is neither a numeric prefix nor any articles marked with the -process mark, just perform the operation on the current article. - -Quite simple, really, but it needs to be made clear so that surprises -are avoided. - -Commands that react to the process mark will push the current list of -process marked articles onto a stack and will then clear all process -marked articles. You can restore the previous configuration with the -@kbd{M P y} command (@pxref{Setting Process Marks}). - -@vindex gnus-summary-goto-unread -One thing that seems to shock & horrify lots of people is that, for -instance, @kbd{3 d} does exactly the same as @kbd{d} @kbd{d} @kbd{d}. -Since each @kbd{d} (which marks the current article as read) by default -goes to the next unread article after marking, this means that @kbd{3 d} -will mark the next three unread articles as read, no matter what the -summary buffer looks like. Set @code{gnus-summary-goto-unread} to -@code{nil} for a more straightforward action. - - -@node Interactive -@section Interactive -@cindex interaction - -@table @code - -@item gnus-novice-user -@vindex gnus-novice-user -If this variable is non-@code{nil}, you are either a newcomer to the -World of Usenet, or you are very cautious, which is a nice thing to be, -really. You will be given questions of the type ``Are you sure you want -to do this?'' before doing anything dangerous. This is @code{t} by -default. - -@item gnus-expert-user -@vindex gnus-expert-user -If this variable is non-@code{nil}, you will seldom be asked any -questions by Gnus. It will simply assume you know what you're doing, no -matter how strange. - -@item gnus-interactive-catchup -@vindex gnus-interactive-catchup -Require confirmation before catching up a group if non-@code{nil}. It -is @code{t} by default. - -@item gnus-interactive-exit -@vindex gnus-interactive-exit -Require confirmation before exiting Gnus. This variable is @code{t} by -default. -@end table - - -@node Symbolic Prefixes -@section Symbolic Prefixes -@cindex symbolic prefixes - -Quite a lot of Emacs commands react to the (numeric) prefix. For -instance, @kbd{C-u 4 C-f} moves point four charaters forward, and -@kbd{C-u 9 0 0 I s s p} adds a permanent @code{Subject} substring score -rule of 900 to the current article. - -This is all nice and well, but what if you want to give a command some -additional information? Well, what most commands do is interpret the -``raw'' prefix in some special way. @kbd{C-u 0 C-x C-s} means that one -doesn't want a backup file to be created when saving the current buffer, -for instance. But what if you want to save without making a backup -file, and you want Emacs to flash lights and play a nice tune at the -same time? You can't, and you're probably perfectly happy that way. - -@kindex M-i (Summary) -@findex gnus-symbolic-argument -I'm not, so I've added a second prefix---the @dfn{symbolic prefix}. The -prefix key is @kbd{M-i} (@code{gnus-symbolic-argument}), and the next -character typed in is the value. You can stack as many @kbd{M-i} -prefixes as you want. @kbd{M-i a M-C-u} means ``feed the @kbd{M-C-u} -command the symbolic prefix @code{a}''. @kbd{M-i a M-i b M-C-u} means -``feed the @kbd{M-C-u} command the symbolic prefixes @code{a} and -@code{b}''. You get the drift. - -Typing in symbolic prefixes to commands that don't accept them doesn't -hurt, but it doesn't do any good either. Currently not many Gnus -functions make use of the symbolic prefix. - -If you're interested in how Gnus implements this, @pxref{Extended -Interactive}. - - -@node Formatting Variables -@section Formatting Variables -@cindex formatting variables - -Throughout this manual you've probably noticed lots of variables called things like @code{gnus-group-line-format} and -@code{gnus-summary-mode-line-format}. These control how Gnus is to -output lines in the various buffers. There's quite a lot of them. -Fortunately, they all use the same syntax, so there's not that much to -be annoyed by. - -Here's an example format spec (from the group buffer): @samp{%M%S%5y: -%(%g%)\n}. We see that it is indeed extremely ugly, and that there are -lots of percentages everywhere. - -@menu -* Formatting Basics:: A formatting variable is basically a format string. -* Advanced Formatting:: Modifying output in various ways. -* User-Defined Specs:: Having Gnus call your own functions. -* Formatting Fonts:: Making the formatting look colorful and nice. -@end menu - -Currently Gnus uses the following formatting variables: -@code{gnus-group-line-format}, @code{gnus-summary-line-format}, -@code{gnus-server-line-format}, @code{gnus-topic-line-format}, -@code{gnus-group-mode-line-format}, -@code{gnus-summary-mode-line-format}, -@code{gnus-article-mode-line-format}, -@code{gnus-server-mode-line-format}, and -@code{gnus-summary-pick-line-format}. - -All these format variables can also be arbitrary elisp forms. In that -case, they will be @code{eval}ed to insert the required lines. - -@kindex M-x gnus-update-format -@findex gnus-update-format -Gnus includes a command to help you while creating your own format -specs. @kbd{M-x gnus-update-format} will @code{eval} the current form, -update the spec in question and pop you to a buffer where you can -examine the resulting lisp code to be run to generate the line. - - - -@node Formatting Basics -@subsection Formatting Basics - -Each @samp{%} element will be replaced by some string or other when the -buffer in question is generated. @samp{%5y} means ``insert the @samp{y} -spec, and pad with spaces to get a 5-character field''. - -As with normal C and Emacs Lisp formatting strings, the numerical -modifier between the @samp{%} and the formatting type character will -@dfn{pad} the output so that it is always at least that long. -@samp{%5y} will make the field always (at least) five characters wide by -padding with spaces to the left. If you say @samp{%-5y}, it will pad to -the right instead. - -You may also wish to limit the length of the field to protect against -particularly wide values. For that you can say @samp{%4,6y}, which -means that the field will never be more than 6 characters wide and never -less than 4 characters wide. - - -@node Advanced Formatting -@subsection Advanced Formatting - -It is frequently useful to post-process the fields in some way. -Padding, limiting, cutting off parts and suppressing certain values can -be achieved by using @dfn{tilde modifiers}. A typical tilde spec might -look like @samp{%~(cut 3)~(ignore "0")y}. - -These are the valid modifiers: - -@table @code -@item pad -@itemx pad-left -Pad the field to the left with spaces until it reaches the required -length. - -@item pad-right -Pad the field to the right with spaces until it reaches the required -length. - -@item max -@itemx max-left -Cut off characters from the left until it reaches the specified length. - -@item max-right -Cut off characters from the right until it reaches the specified -length. - -@item cut -@itemx cut-left -Cut off the specified number of characters from the left. - -@item cut-right -Cut off the specified number of characters from the right. - -@item ignore -Return an empty string if the field is equal to the specified value. - -@item form -Use the specified form as the field value when the @samp{@@} spec is -used. -@end table - -Let's take an example. The @samp{%o} spec in the summary mode lines -will return a date in compact ISO8601 format---@samp{19960809T230410}. -This is quite a mouthful, so we want to shave off the century number and -the time, leaving us with a six-character date. That would be -@samp{%~(cut-left 2)~(max-right 6)~(pad 6)o}. (Cutting is done before -maxing, and we need the padding to ensure that the date is never less -than 6 characters to make it look nice in columns.) - -Ignoring is done first; then cutting; then maxing; and then as the very -last operation, padding. - -If you use lots of these advanced thingies, you'll find that Gnus gets -quite slow. This can be helped enormously by running @kbd{M-x -gnus-compile} when you are satisfied with the look of your lines. -@xref{Compilation}. - - -@node User-Defined Specs -@subsection User-Defined Specs - -All the specs allow for inserting user defined specifiers---@samp{u}. -The next character in the format string should be a letter. Gnus -will call the function @code{gnus-user-format-function-}@samp{X}, where -@samp{X} is the letter following @samp{%u}. The function will be passed -a single parameter---what the parameter means depends on what buffer -it's being called from. The function should return a string, which will -be inserted into the buffer just like information from any other -specifier. This function may also be called with dummy values, so it -should protect against that. - -You can also use tilde modifiers (@pxref{Advanced Formatting} to achieve -much the same without defining new functions. Here's an example: -@samp{%~(form (count-lines (point-min) (point)))@@}. The form -given here will be evaluated to yield the current line number, and then -inserted. - - -@node Formatting Fonts -@subsection Formatting Fonts - -There are specs for highlighting, and these are shared by all the format -variables. Text inside the @samp{%(} and @samp{%)} specifiers will get -the special @code{mouse-face} property set, which means that it will be -highlighted (with @code{gnus-mouse-face}) when you put the mouse pointer -over it. - -Text inside the @samp{%[} and @samp{%]} specifiers will have their -normal faces set using @code{gnus-face-0}, which is @code{bold} by -default. If you say @samp{%1[}, you'll get @code{gnus-face-1} instead, -and so on. Create as many faces as you wish. The same goes for the -@code{mouse-face} specs---you can say @samp{%3(hello%)} to have -@samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}. - -Here's an alternative recipe for the group buffer: - -@lisp -;; Create three face types. -(setq gnus-face-1 'bold) -(setq gnus-face-3 'italic) - -;; We want the article count to be in -;; a bold and green face. So we create -;; a new face called `my-green-bold'. -(copy-face 'bold 'my-green-bold) -;; Set the color. -(set-face-foreground 'my-green-bold "ForestGreen") -(setq gnus-face-2 'my-green-bold) - -;; Set the new & fancy format. -(setq gnus-group-line-format - "%M%S%3@{%5y%@}%2[:%] %(%1@{%g%@}%)\n") -@end lisp - -I'm sure you'll be able to use this scheme to create totally unreadable -and extremely vulgar displays. Have fun! - -Note that the @samp{%(} specs (and friends) do not make any sense on the -mode-line variables. - - -@node Windows Configuration -@section Windows Configuration -@cindex windows configuration - -No, there's nothing here about X, so be quiet. - -@vindex gnus-use-full-window -If @code{gnus-use-full-window} non-@code{nil}, Gnus will delete all -other windows and occupy the entire Emacs screen by itself. It is -@code{t} by default. - -@vindex gnus-buffer-configuration -@code{gnus-buffer-configuration} describes how much space each Gnus -buffer should be given. Here's an excerpt of this variable: - -@lisp -((group (vertical 1.0 (group 1.0 point) - (if gnus-carpal (group-carpal 4)))) - (article (vertical 1.0 (summary 0.25 point) - (article 1.0)))) -@end lisp - -This is an alist. The @dfn{key} is a symbol that names some action or -other. For instance, when displaying the group buffer, the window -configuration function will use @code{group} as the key. A full list of -possible names is listed below. - -The @dfn{value} (i.e., the @dfn{split}) says how much space each buffer -should occupy. To take the @code{article} split as an example - - -@lisp -(article (vertical 1.0 (summary 0.25 point) - (article 1.0))) -@end lisp - -This @dfn{split} says that the summary buffer should occupy 25% of upper -half of the screen, and that it is placed over the article buffer. As -you may have noticed, 100% + 25% is actually 125% (yup, I saw y'all -reaching for that calculator there). However, the special number -@code{1.0} is used to signal that this buffer should soak up all the -rest of the space available after the rest of the buffers have taken -whatever they need. There should be only one buffer with the @code{1.0} -size spec per split. - -Point will be put in the buffer that has the optional third element -@code{point}. - -Here's a more complicated example: - -@lisp -(article (vertical 1.0 (group 4) - (summary 0.25 point) - (if gnus-carpal (summary-carpal 4)) - (article 1.0))) -@end lisp - -If the size spec is an integer instead of a floating point number, -then that number will be used to say how many lines a buffer should -occupy, not a percentage. - -If the @dfn{split} looks like something that can be @code{eval}ed (to be -precise---if the @code{car} of the split is a function or a subr), this -split will be @code{eval}ed. If the result is non-@code{nil}, it will -be used as a split. This means that there will be three buffers if -@code{gnus-carpal} is @code{nil}, and four buffers if @code{gnus-carpal} -is non-@code{nil}. - -Not complicated enough for you? Well, try this on for size: - -@lisp -(article (horizontal 1.0 - (vertical 0.5 - (group 1.0) - (gnus-carpal 4)) - (vertical 1.0 - (summary 0.25 point) - (summary-carpal 4) - (article 1.0)))) -@end lisp - -Whoops. Two buffers with the mystery 100% tag. And what's that -@code{horizontal} thingie? - -If the first element in one of the split is @code{horizontal}, Gnus will -split the window horizontally, giving you two windows side-by-side. -Inside each of these strips you may carry on all you like in the normal -fashion. The number following @code{horizontal} says what percentage of -the screen is to be given to this strip. - -For each split, there @emph{must} be one element that has the 100% tag. -The splitting is never accurate, and this buffer will eat any leftover -lines from the splits. - -To be slightly more formal, here's a definition of what a valid split -may look like: - -@example -split = frame | horizontal | vertical | buffer | form -frame = "(frame " size *split ")" -horizontal = "(horizontal " size *split ")" -vertical = "(vertical " size *split ")" -buffer = "(" buffer-name " " size *[ "point" ] ")" -size = number | frame-params -buffer-name = group | article | summary ... -@end example - -The limitations are that the @code{frame} split can only appear as the -top-level split. @var{form} should be an Emacs Lisp form that should -return a valid split. We see that each split is fully recursive, and -may contain any number of @code{vertical} and @code{horizontal} splits. - -@vindex gnus-window-min-width -@vindex gnus-window-min-height -@cindex window height -@cindex window width -Finding the right sizes can be a bit complicated. No window may be less -than @code{gnus-window-min-height} (default 1) characters high, and all -windows must be at least @code{gnus-window-min-width} (default 1) -characters wide. Gnus will try to enforce this before applying the -splits. If you want to use the normal Emacs window width/height limit, -you can just set these two variables to @code{nil}. - -If you're not familiar with Emacs terminology, @code{horizontal} and -@code{vertical} splits may work the opposite way of what you'd expect. -Windows inside a @code{horizontal} split are shown side-by-side, and -windows within a @code{vertical} split are shown above each other. - -@findex gnus-configure-frame -If you want to experiment with window placement, a good tip is to call -@code{gnus-configure-frame} directly with a split. This is the function -that does all the real work when splitting buffers. Below is a pretty -nonsensical configuration with 5 windows; two for the group buffer and -three for the article buffer. (I said it was nonsensical.) If you -@code{eval} the statement below, you can get an idea of how that would -look straight away, without going through the normal Gnus channels. -Play with it until you're satisfied, and then use -@code{gnus-add-configuration} to add your new creation to the buffer -configuration list. - -@lisp -(gnus-configure-frame - '(horizontal 1.0 - (vertical 10 - (group 1.0) - (article 0.3 point)) - (vertical 1.0 - (article 1.0) - (horizontal 4 - (group 1.0) - (article 10))))) -@end lisp - -You might want to have several frames as well. No prob---just use the -@code{frame} split: - -@lisp -(gnus-configure-frame - '(frame 1.0 - (vertical 1.0 - (summary 0.25 point) - (article 1.0)) - (vertical ((height . 5) (width . 15) - (user-position . t) - (left . -1) (top . 1)) - (picon 1.0)))) - -@end lisp - -This split will result in the familiar summary/article window -configuration in the first (or ``main'') frame, while a small additional -frame will be created where picons will be shown. As you can see, -instead of the normal @code{1.0} top-level spec, each additional split -should have a frame parameter alist as the size spec. -@xref{Frame Parameters, , Frame Parameters, elisp, The GNU Emacs Lisp -Reference Manual}. Under XEmacs, a frame property list will be -accepted, too---for instance, @code{(height 5 width 15 left -1 top 1)} -is such a plist. - -Here's a list of all possible keys for -@code{gnus-buffer-configuration}: - -@code{group}, @code{summary}, @code{article}, @code{server}, -@code{browse}, @code{message}, @code{pick}, @code{info}, -@code{summary-faq}, @code{edit-group}, @code{edit-server}, -@code{edit-score}, @code{post}, @code{reply}, @code{forward}, -@code{reply-yank}, @code{mail-bounce}, @code{draft}, @code{pipe}, -@code{bug}, @code{compose-bounce}, and @code{score-trace}. - -Note that the @code{message} key is used for both -@code{gnus-group-mail} and @code{gnus-summary-mail-other-window}. If -it is desirable to distinguish between the two, something like this -might be used: - -@lisp -(message (horizontal 1.0 - (vertical 1.0 (message 1.0 point)) - (vertical 0.24 - (if (buffer-live-p gnus-summary-buffer) - '(summary 0.5)) - (group 1.0))))) -@end lisp - -@findex gnus-add-configuration -Since the @code{gnus-buffer-configuration} variable is so long and -complicated, there's a function you can use to ease changing the config -of a single setting: @code{gnus-add-configuration}. If, for instance, -you want to change the @code{article} setting, you could say: - -@lisp -(gnus-add-configuration - '(article (vertical 1.0 - (group 4) - (summary .25 point) - (article 1.0)))) -@end lisp - -You'd typically stick these @code{gnus-add-configuration} calls in your -@file{.gnus.el} file or in some startup hook---they should be run after -Gnus has been loaded. - -@vindex gnus-always-force-window-configuration -If all windows mentioned in the configuration are already visible, Gnus -won't change the window configuration. If you always want to force the -``right'' window configuration, you can set -@code{gnus-always-force-window-configuration} to non-@code{nil}. - - -@node Faces and Fonts -@section Faces and Fonts -@cindex faces -@cindex fonts -@cindex colors - -Fiddling with fonts and faces used to be very difficult, but these days -it is very simple. You simply say @kbd{M-x customize-face}, pick out -the face you want to alter, and alter it via the standard Customize -interface. - - -@node Compilation -@section Compilation -@cindex compilation -@cindex byte-compilation - -@findex gnus-compile - -Remember all those line format specification variables? -@code{gnus-summary-line-format}, @code{gnus-group-line-format}, and so -on. Now, Gnus will of course heed whatever these variables are, but, -unfortunately, changing them will mean a quite significant slow-down. -(The default values of these variables have byte-compiled functions -associated with them, while the user-generated versions do not, of -course.) - -To help with this, you can run @kbd{M-x gnus-compile} after you've -fiddled around with the variables and feel that you're (kind of) -satisfied. This will result in the new specs being byte-compiled, and -you'll get top speed again. Gnus will save these compiled specs in the -@file{.newsrc.eld} file. (User-defined functions aren't compiled by -this function, though---you should compile them yourself by sticking -them into the @code{.gnus.el} file and byte-compiling that file.) - - -@node Mode Lines -@section Mode Lines -@cindex mode lines - -@vindex gnus-updated-mode-lines -@code{gnus-updated-mode-lines} says what buffers should keep their mode -lines updated. It is a list of symbols. Supported symbols include -@code{group}, @code{article}, @code{summary}, @code{server}, -@code{browse}, and @code{tree}. If the corresponding symbol is present, -Gnus will keep that mode line updated with information that may be -pertinent. If this variable is @code{nil}, screen refresh may be -quicker. - -@cindex display-time - -@vindex gnus-mode-non-string-length -By default, Gnus displays information on the current article in the mode -lines of the summary and article buffers. The information Gnus wishes -to display (e.g. the subject of the article) is often longer than the -mode lines, and therefore have to be cut off at some point. The -@code{gnus-mode-non-string-length} variable says how long the other -elements on the line is (i.e., the non-info part). If you put -additional elements on the mode line (e.g. a clock), you should modify -this variable: - -@c Hook written by Francesco Potorti` -@lisp -(add-hook 'display-time-hook - (lambda () (setq gnus-mode-non-string-length - (+ 21 - (if line-number-mode 5 0) - (if column-number-mode 4 0) - (length display-time-string))))) -@end lisp - -If this variable is @code{nil} (which is the default), the mode line -strings won't be chopped off, and they won't be padded either. Note -that the default is unlikely to be desirable, as even the percentage -complete in the buffer may be crowded off the mode line; the user should -configure this variable appropriately for her configuration. - - -@node Highlighting and Menus -@section Highlighting and Menus -@cindex visual -@cindex highlighting -@cindex menus - -@vindex gnus-visual -The @code{gnus-visual} variable controls most of the Gnus-prettifying -aspects. If @code{nil}, Gnus won't attempt to create menus or use fancy -colors or fonts. This will also inhibit loading the @file{gnus-vis.el} -file. - -This variable can be a list of visual properties that are enabled. The -following elements are valid, and are all included by default: - -@table @code -@item group-highlight -Do highlights in the group buffer. -@item summary-highlight -Do highlights in the summary buffer. -@item article-highlight -Do highlights in the article buffer. -@item highlight -Turn on highlighting in all buffers. -@item group-menu -Create menus in the group buffer. -@item summary-menu -Create menus in the summary buffers. -@item article-menu -Create menus in the article buffer. -@item browse-menu -Create menus in the browse buffer. -@item server-menu -Create menus in the server buffer. -@item score-menu -Create menus in the score buffers. -@item menu -Create menus in all buffers. -@end table - -So if you only want highlighting in the article buffer and menus in all -buffers, you could say something like: - -@lisp -(setq gnus-visual '(article-highlight menu)) -@end lisp - -If you want highlighting only and no menus whatsoever, you'd say: - -@lisp -(setq gnus-visual '(highlight)) -@end lisp - -If @code{gnus-visual} is @code{t}, highlighting and menus will be used -in all Gnus buffers. - -Other general variables that influence the look of all buffers include: - -@table @code -@item gnus-mouse-face -@vindex gnus-mouse-face -This is the face (i.e., font) used for mouse highlighting in Gnus. No -mouse highlights will be done if @code{gnus-visual} is @code{nil}. - -@end table - -There are hooks associated with the creation of all the different menus: - -@table @code - -@item gnus-article-menu-hook -@vindex gnus-article-menu-hook -Hook called after creating the article mode menu. - -@item gnus-group-menu-hook -@vindex gnus-group-menu-hook -Hook called after creating the group mode menu. - -@item gnus-summary-menu-hook -@vindex gnus-summary-menu-hook -Hook called after creating the summary mode menu. - -@item gnus-server-menu-hook -@vindex gnus-server-menu-hook -Hook called after creating the server mode menu. - -@item gnus-browse-menu-hook -@vindex gnus-browse-menu-hook -Hook called after creating the browse mode menu. - -@item gnus-score-menu-hook -@vindex gnus-score-menu-hook -Hook called after creating the score mode menu. - -@end table - - -@node Buttons -@section Buttons -@cindex buttons -@cindex mouse -@cindex click - -Those new-fangled @dfn{mouse} contraptions is very popular with the -young, hep kids who don't want to learn the proper way to do things -these days. Why, I remember way back in the summer of '89, when I was -using Emacs on a Tops 20 system. Three hundred users on one single -machine, and every user was running Simula compilers. Bah! - -Right. - -@vindex gnus-carpal -Well, you can make Gnus display bufferfuls of buttons you can click to -do anything by setting @code{gnus-carpal} to @code{t}. Pretty simple, -really. Tell the chiropractor I sent you. - - -@table @code - -@item gnus-carpal-mode-hook -@vindex gnus-carpal-mode-hook -Hook run in all carpal mode buffers. - -@item gnus-carpal-button-face -@vindex gnus-carpal-button-face -Face used on buttons. - -@item gnus-carpal-header-face -@vindex gnus-carpal-header-face -Face used on carpal buffer headers. - -@item gnus-carpal-group-buffer-buttons -@vindex gnus-carpal-group-buffer-buttons -Buttons in the group buffer. - -@item gnus-carpal-summary-buffer-buttons -@vindex gnus-carpal-summary-buffer-buttons -Buttons in the summary buffer. - -@item gnus-carpal-server-buffer-buttons -@vindex gnus-carpal-server-buffer-buttons -Buttons in the server buffer. - -@item gnus-carpal-browse-buffer-buttons -@vindex gnus-carpal-browse-buffer-buttons -Buttons in the browse buffer. -@end table - -All the @code{buttons} variables are lists. The elements in these list -are either cons cells where the @code{car} contains a text to be displayed and -the @code{cdr} contains a function symbol, or a simple string. - - -@node Daemons -@section Daemons -@cindex demons -@cindex daemons - -Gnus, being larger than any program ever written (allegedly), does lots -of strange stuff that you may wish to have done while you're not -present. For instance, you may want it to check for new mail once in a -while. Or you may want it to close down all connections to all servers -when you leave Emacs idle. And stuff like that. - -Gnus will let you do stuff like that by defining various -@dfn{handlers}. Each handler consists of three elements: A -@var{function}, a @var{time}, and an @var{idle} parameter. - -Here's an example of a handler that closes connections when Emacs has -been idle for thirty minutes: - -@lisp -(gnus-demon-close-connections nil 30) -@end lisp - -Here's a handler that scans for PGP headers every hour when Emacs is -idle: - -@lisp -(gnus-demon-scan-pgp 60 t) -@end lisp - -This @var{time} parameter and than @var{idle} parameter work together -in a strange, but wonderful fashion. Basically, if @var{idle} is -@code{nil}, then the function will be called every @var{time} minutes. - -If @var{idle} is @code{t}, then the function will be called after -@var{time} minutes only if Emacs is idle. So if Emacs is never idle, -the function will never be called. But once Emacs goes idle, the -function will be called every @var{time} minutes. - -If @var{idle} is a number and @var{time} is a number, the function will -be called every @var{time} minutes only when Emacs has been idle for -@var{idle} minutes. - -If @var{idle} is a number and @var{time} is @code{nil}, the function -will be called once every time Emacs has been idle for @var{idle} -minutes. - -And if @var{time} is a string, it should look like @samp{07:31}, and -the function will then be called once every day somewhere near that -time. Modified by the @var{idle} parameter, of course. - -@vindex gnus-demon-timestep -(When I say ``minute'' here, I really mean @code{gnus-demon-timestep} -seconds. This is 60 by default. If you change that variable, -all the timings in the handlers will be affected.) - -@vindex gnus-use-demon -To set the whole thing in motion, though, you have to set -@code{gnus-use-demon} to @code{t}. - -So, if you want to add a handler, you could put something like this in -your @file{.gnus} file: - -@findex gnus-demon-add-handler -@lisp -(gnus-demon-add-handler 'gnus-demon-close-connections 30 t) -@end lisp - -@findex gnus-demon-add-nocem -@findex gnus-demon-add-scanmail -@findex gnus-demon-add-rescan -@findex gnus-demon-add-scan-timestamps -@findex gnus-demon-add-disconnection -Some ready-made functions to do this have been created: -@code{gnus-demon-add-nocem}, @code{gnus-demon-add-disconnection}, -@code{gnus-demon-add-nntp-close-connection}, -@code{gnus-demon-add-scan-timestamps}, @code{gnus-demon-add-rescan}, and -@code{gnus-demon-add-scanmail}. Just put those functions in your -@file{.gnus} if you want those abilities. - -@findex gnus-demon-init -@findex gnus-demon-cancel -@vindex gnus-demon-handlers -If you add handlers to @code{gnus-demon-handlers} directly, you should -run @code{gnus-demon-init} to make the changes take hold. To cancel all -daemons, you can use the @code{gnus-demon-cancel} function. - -Note that adding daemons can be pretty naughty if you overdo it. Adding -functions that scan all news and mail from all servers every two seconds -is a sure-fire way of getting booted off any respectable system. So -behave. - - -@node NoCeM -@section NoCeM -@cindex nocem -@cindex spam - -@dfn{Spamming} is posting the same article lots and lots of times. -Spamming is bad. Spamming is evil. - -Spamming is usually canceled within a day or so by various anti-spamming -agencies. These agencies usually also send out @dfn{NoCeM} messages. -NoCeM is pronounced ``no see-'em'', and means what the name -implies---these are messages that make the offending articles, like, go -away. - -What use are these NoCeM messages if the articles are canceled anyway? -Some sites do not honor cancel messages and some sites just honor cancels -from a select few people. Then you may wish to make use of the NoCeM -messages, which are distributed in the @samp{alt.nocem.misc} newsgroup. - -Gnus can read and parse the messages in this group automatically, and -this will make spam disappear. - -There are some variables to customize, of course: - -@table @code -@item gnus-use-nocem -@vindex gnus-use-nocem -Set this variable to @code{t} to set the ball rolling. It is @code{nil} -by default. - -@item gnus-nocem-groups -@vindex gnus-nocem-groups -Gnus will look for NoCeM messages in the groups in this list. The -default is @code{("news.lists.filters" "news.admin.net-abuse.bulletins" -"alt.nocem.misc" "news.admin.net-abuse.announce")}. - -@item gnus-nocem-issuers -@vindex gnus-nocem-issuers -There are many people issuing NoCeM messages. This list says what -people you want to listen to. The default is @code{("Automoose-1" -"rbraver@@ohww.norman.ok.us" "clewis@@ferret.ocunix.on.ca" -"jem@@xpat.com" "snowhare@@xmission.com" "red@@redpoll.mrfs.oh.us -(Richard E. Depew)")}; fine, upstanding citizens all of them. - -Known despammers that you can put in this list include: - -@table @samp -@item clewis@@ferret.ocunix.on.ca; -@cindex Chris Lewis -Chris Lewis---Major Canadian despammer who has probably canceled more -usenet abuse than anybody else. - -@item Automoose-1 -@cindex CancelMoose[tm] -The CancelMoose[tm] on autopilot. The CancelMoose[tm] is reputed to be -Norwegian, and was the person(s) who invented NoCeM. - -@item jem@@xpat.com; -@cindex Jem -John Milburn---despammer located in Korea who is getting very busy these -days. - -@item red@@redpoll.mrfs.oh.us (Richard E. Depew) -Richard E. Depew---lone American despammer. He mostly cancels binary -postings to non-binary groups and removes spews (regurgitated articles). -@end table - -You do not have to heed NoCeM messages from all these people---just the -ones you want to listen to. You also don't have to accept all NoCeM -messages from the people you like. Each NoCeM message has a @dfn{type} -header that gives the message a (more or less, usually less) rigorous -definition. Common types are @samp{spam}, @samp{spew}, @samp{mmf}, -@samp{binary}, and @samp{troll}. To specify this, you have to use -@var{(issuer conditions ...)} elements in the list. Each condition is -either a string (which is a regexp that matches types you want to use) -or a list on the form @code{(not STRING)}, where @var{string} is a -regexp that matches types you don't want to use. - -For instance, if you want all NoCeM messages from Chris Lewis except his -@samp{troll} messages, you'd say: - -@lisp -("clewis@@ferret.ocunix.on.ca" ".*" (not "troll")) -@end lisp - -On the other hand, if you just want nothing but his @samp{spam} and -@samp{spew} messages, you'd say: - -@lisp -("clewis@@ferret.ocunix.on.ca" (not ".*") "spew" "spam") -@end lisp - -The specs are applied left-to-right. - - -@item gnus-nocem-verifyer -@vindex gnus-nocem-verifyer -@findex mc-verify -This should be a function for verifying that the NoCeM issuer is who she -says she is. The default is @code{mc-verify}, which is a Mailcrypt -function. If this is too slow and you don't care for verification -(which may be dangerous), you can set this variable to @code{nil}. - -If you want signed NoCeM messages to be verified and unsigned messages -not to be verified (but used anyway), you could do something like: - -@lisp -(setq gnus-nocem-verifyer 'my-gnus-mc-verify) - -(defun my-gnus-mc-verify () - (not (eq 'forged - (ignore-errors - (if (mc-verify) - t - 'forged))))) -@end lisp - -This might be dangerous, though. - -@item gnus-nocem-directory -@vindex gnus-nocem-directory -This is where Gnus will store its NoCeM cache files. The default is -@file{~/News/NoCeM/}. - -@item gnus-nocem-expiry-wait -@vindex gnus-nocem-expiry-wait -The number of days before removing old NoCeM entries from the cache. -The default is 15. If you make it shorter Gnus will be faster, but you -might then see old spam. - -@end table - -Using NoCeM could potentially be a memory hog. If you have many living -(i. e., subscribed or unsubscribed groups), your Emacs process will grow -big. If this is a problem, you should kill off all (or most) of your -unsubscribed groups (@pxref{Subscription Commands}). - - -@node Undo -@section Undo -@cindex undo - -It is very useful to be able to undo actions one has done. In normal -Emacs buffers, it's easy enough---you just push the @code{undo} button. -In Gnus buffers, however, it isn't that simple. - -The things Gnus displays in its buffer is of no value whatsoever to -Gnus---it's all just data designed to look nice to the user. -Killing a group in the group buffer with @kbd{C-k} makes the line -disappear, but that's just a side-effect of the real action---the -removal of the group in question from the internal Gnus structures. -Undoing something like that can't be done by the normal Emacs -@code{undo} function. - -Gnus tries to remedy this somewhat by keeping track of what the user -does and coming up with actions that would reverse the actions the user -takes. When the user then presses the @code{undo} key, Gnus will run -the code to reverse the previous action, or the previous actions. -However, not all actions are easily reversible, so Gnus currently offers -a few key functions to be undoable. These include killing groups, -yanking groups, and changing the list of read articles of groups. -That's it, really. More functions may be added in the future, but each -added function means an increase in data to be stored, so Gnus will -never be totally undoable. - -@findex gnus-undo-mode -@vindex gnus-use-undo -@findex gnus-undo -The undoability is provided by the @code{gnus-undo-mode} minor mode. It -is used if @code{gnus-use-undo} is non-@code{nil}, which is the -default. The @kbd{M-C-_} key performs the @code{gnus-undo} command -command, which should feel kinda like the normal Emacs @code{undo} -command. - - -@node Moderation -@section Moderation -@cindex moderation - -If you are a moderator, you can use the @file{gnus-mdrtn.el} package. -It is not included in the standard Gnus package. Write a mail to -@samp{larsi@@gnus.org} and state what group you moderate, and you'll -get a copy. - -The moderation package is implemented as a minor mode for summary -buffers. Put - -@lisp -(add-hook 'gnus-summary-mode-hook 'gnus-moderate) -@end lisp - -in your @file{.gnus.el} file. - -If you are the moderator of @samp{rec.zoofle}, this is how it's -supposed to work: - -@enumerate -@item -You split your incoming mail by matching on -@samp{Newsgroups:.*rec.zoofle}, which will put all the to-be-posted -articles in some mail group---for instance, @samp{nnml:rec.zoofle}. - -@item -You enter that group once in a while and post articles using the @kbd{e} -(edit-and-post) or @kbd{s} (just send unedited) commands. - -@item -If, while reading the @samp{rec.zoofle} newsgroup, you happen upon some -articles that weren't approved by you, you can cancel them with the -@kbd{c} command. -@end enumerate - -To use moderation mode in these two groups, say: - -@lisp -(setq gnus-moderated-list - "^nnml:rec.zoofle$\\|^rec.zoofle$") -@end lisp - - -@node XEmacs Enhancements -@section XEmacs Enhancements -@cindex XEmacs - -XEmacs is able to display pictures and stuff, so Gnus has taken -advantage of that. - -@menu -* Picons:: How to display pictures of what your reading. -* Smileys:: Show all those happy faces the way they were meant to be shown. -* Toolbar:: Click'n'drool. -* XVarious:: Other XEmacsy Gnusey variables. -@end menu - - -@node Picons -@subsection Picons - -@iftex -@iflatex -\include{picons} -@end iflatex -@end iftex - -So... You want to slow down your news reader even more! This is a -good way to do so. Its also a great way to impress people staring -over your shoulder as you read news. - -@menu -* Picon Basics:: What are picons and How do I get them. -* Picon Requirements:: Don't go further if you aren't using XEmacs. -* Easy Picons:: Displaying Picons---the easy way. -* Hard Picons:: The way you should do it. You'll learn something. -* Picon Useless Configuration:: Other variables you can trash/tweak/munge/play with. -@end menu - - -@node Picon Basics -@subsubsection Picon Basics - -What are Picons? To quote directly from the Picons Web site: - -@iftex -@iflatex -\margindex{} -@end iflatex -@end iftex - -@quotation -@dfn{Picons} is short for ``personal icons''. They're small, -constrained images used to represent users and domains on the net, -organized into databases so that the appropriate image for a given -e-mail address can be found. Besides users and domains, there are picon -databases for Usenet newsgroups and weather forecasts. The picons are -in either monochrome @code{XBM} format or color @code{XPM} and -@code{GIF} formats. -@end quotation - -@vindex gnus-picons-piconsearch-url -If you have a permanent connection to the Internet you can use Steve -Kinzler's Picons Search engine by setting -@code{gnus-picons-piconsearch-url} to the string -@file{http://www.cs.indiana.edu/picons/search.html}. - -@vindex gnus-picons-database -Otherwise you need a local copy of his database. For instructions on -obtaining and installing the picons databases, point your Web browser at -@file{http://www.cs.indiana.edu/picons/ftp/index.html}. Gnus expects -picons to be installed into a location pointed to by -@code{gnus-picons-database}. - - -@node Picon Requirements -@subsubsection Picon Requirements - -To have Gnus display Picons for you, you must be running XEmacs -19.13 or greater since all other versions of Emacs aren't yet able to -display images. - -Additionally, you must have @code{x} support compiled into XEmacs. To -display color picons which are much nicer than the black & white one, -you also need one of @code{xpm} or @code{gif} compiled into XEmacs. - -@vindex gnus-picons-convert-x-face -If you want to display faces from @code{X-Face} headers, you should have -the @code{xface} support compiled into XEmacs. Otherwise you must have -the @code{netpbm} utilities installed, or munge the -@code{gnus-picons-convert-x-face} variable to use something else. - - -@node Easy Picons -@subsubsection Easy Picons - -To enable displaying picons, simply put the following line in your -@file{~/.gnus} file and start Gnus. - -@lisp -(setq gnus-use-picons t) -(add-hook 'gnus-article-display-hook 'gnus-article-display-picons t) -(add-hook 'gnus-summary-prepare-hook 'gnus-group-display-picons t) -(add-hook 'gnus-article-display-hook 'gnus-picons-article-display-x-face) -@end lisp - -and make sure @code{gnus-picons-database} points to the directory -containing the Picons databases. - -Alternatively if you want to use the web piconsearch engine add this: - -@lisp -(setq gnus-picons-piconsearch-url "http://www.cs.indiana.edu:800/piconsearch") -@end lisp - - -@node Hard Picons -@subsubsection Hard Picons - -@iftex -@iflatex -\margindex{} -@end iflatex -@end iftex - -Gnus can display picons for you as you enter and leave groups and -articles. It knows how to interact with three sections of the picons -database. Namely, it can display the picons newsgroup pictures, -author's face picture(s), and the authors domain. To enable this -feature, you need to select where to get the picons from, and where to -display them. - -@table @code - -@item gnus-picons-database -@vindex gnus-picons-database -The location of the picons database. Should point to a directory -containing the @file{news}, @file{domains}, @file{users} (and so on) -subdirectories. This is only useful if -@code{gnus-picons-piconsearch-url} is @code{nil}. Defaults to -@file{/usr/local/faces/}. - -@item gnus-picons-piconsearch-url -@vindex gnus-picons-piconsearch-url -The URL for the web picons search engine. The only currently known -engine is @file{http://www.cs.indiana.edu:800/piconsearch}. To -workaround network delays, icons will be fetched in the background. If -this is @code{nil} 'the default), then picons are fetched from local -database indicated by @code{gnus-picons-database}. - -@item gnus-picons-display-where -@vindex gnus-picons-display-where -Where the picon images should be displayed. It is @code{picons} by -default (which by default maps to the buffer @samp{*Picons*}). Other -valid places could be @code{article}, @code{summary}, or -@samp{*scratch*} for all I care. Just make sure that you've made the -buffer visible using the standard Gnus window configuration -routines---@pxref{Windows Configuration}. - -@item gnus-picons-group-excluded-groups -@vindex gnus-picons-group-excluded-groups -Groups that are matched by this regexp won't have their group icons -displayed. - -@end table - -Note: If you set @code{gnus-use-picons} to @code{t}, it will set up your -window configuration for you to include the @code{picons} buffer. - -Now that you've made those decision, you need to add the following -functions to the appropriate hooks so these pictures will get displayed -at the right time. - -@vindex gnus-article-display-hook -@vindex gnus-picons-display-where -@table @code -@item gnus-article-display-picons -@findex gnus-article-display-picons -Looks up and displays the picons for the author and the author's domain -in the @code{gnus-picons-display-where} buffer. Should be added to the -@code{gnus-article-display-hook}. - -@item gnus-group-display-picons -@findex gnus-article-display-picons -Displays picons representing the current group. This function should -be added to the @code{gnus-summary-prepare-hook} or to the -@code{gnus-article-display-hook} if @code{gnus-picons-display-where} -is set to @code{article}. - -@item gnus-picons-article-display-x-face -@findex gnus-article-display-picons -Decodes and displays the X-Face header if present. This function -should be added to @code{gnus-article-display-hook}. - -@end table - -Note: You must append them to the hook, so make sure to specify 't' -for the append flag of @code{add-hook}: - -@lisp -(add-hook 'gnus-article-display-hook 'gnus-article-display-picons t) -@end lisp - - -@node Picon Useless Configuration -@subsubsection Picon Useless Configuration - -@iftex -@iflatex -\margindex{} -@end iflatex -@end iftex - -The following variables offer further control over how things are -done, where things are located, and other useless stuff you really -don't need to worry about. - -@table @code - -@item gnus-picons-news-directories -@vindex gnus-picons-news-directories -List of subdirectories to search in @code{gnus-picons-database} for -newsgroups faces. @code{("news")} is the default. - -@item gnus-picons-user-directories -@vindex gnus-picons-user-directories -List of subdirectories to search in @code{gnus-picons-database} for user -faces. @code{("local" "users" "usenix" "misc")} is the default. - -@item gnus-picons-domain-directories -@vindex gnus-picons-domain-directories -List of subdirectories to search in @code{gnus-picons-database} for -domain name faces. Defaults to @code{("domains")}. Some people may -want to add @samp{"unknown"} to this list. - -@item gnus-picons-convert-x-face -@vindex gnus-picons-convert-x-face -If you don't have @code{xface} support builtin XEmacs, this is the -command to use to convert the @code{X-Face} header to an X bitmap -(@code{xbm}). Defaults to @code{(format "@{ echo '/* Width=48, -Height=48 */'; uncompface; @} | icontopbm | pbmtoxbm > %s" -gnus-picons-x-face-file-name)} - -@item gnus-picons-x-face-file-name -@vindex gnus-picons-x-face-file-name -Names a temporary file to store the @code{X-Face} bitmap in. Defaults -to @code{(format "/tmp/picon-xface.%s.xbm" (user-login-name))}. - -@item gnus-picons-has-modeline-p -@vindex gnus-picons-has-modeline-p -If you have set @code{gnus-picons-display-where} to @code{picons}, your -XEmacs frame will become really cluttered. To alleviate this a bit you -can set @code{gnus-picons-has-modeline-p} to @code{nil}; this will -remove the mode line from the Picons buffer. This is only useful if -@code{gnus-picons-display-where} is @code{picons}. - -@item gnus-picons-refresh-before-display -@vindex gnus-picons-refresh-before-display -If non-nil, display the article buffer before computing the picons. -Defaults to @code{nil}. - -@item gnus-picons-display-as-address -@vindex gnus-picons-display-as-address -If @code{t} display textual email addresses along with pictures. -Defaults to @code{t}. - -@item gnus-picons-file-suffixes -@vindex gnus-picons-file-suffixes -Ordered list of suffixes on picon file names to try. Defaults to -@code{("xpm" "gif" "xbm")} minus those not builtin your XEmacs. - -@item gnus-picons-display-article-move-p -@vindex gnus-picons-display-article-move-p -Whether to move point to first empty line when displaying picons. This -has only an effect if `gnus-picons-display-where' has value `article'. - -@item gnus-picons-clear-cache-on-shutdown -@vindex gnus-picons-clear-cache-on-shutdown -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 @code{nil}, -Gnus will never clear the cache itself; you will have to manually call -@code{gnus-picons-clear-cache} to clear it. Otherwise the cache will be -cleared every time you exit Gnus. Defaults to @code{t}. - -@iftex -@iflatex -\margindex{} -@end iflatex -@end iftex - -@end table - -@node Smileys -@subsection Smileys -@cindex smileys - -@iftex -@iflatex -\gnusfig{-3cm}{0.5cm}{\epsfig{figure=tmp/BigFace.ps,height=20cm}} -\input{smiley} -@end iflatex -@end iftex - -@dfn{Smiley} is a package separate from Gnus, but since Gnus is -currently the only package that uses Smiley, it is documented here. - -In short---to use Smiley in Gnus, put the following in your -@file{.gnus.el} file: - -@lisp -(add-hook 'gnus-article-display-hook 'gnus-smiley-display t) -@end lisp - -Smiley maps text smiley faces---@samp{:-)}, @samp{:-=}, @samp{:-(} and -the like---to pictures and displays those instead of the text smiley -faces. The conversion is controlled by a list of regexps that matches -text and maps that to file names. - -@vindex smiley-nosey-regexp-alist -@vindex smiley-deformed-regexp-alist -Smiley supplies two example conversion alists by default: -@code{smiley-deformed-regexp-alist} (which matches @samp{:)}, @samp{:(} -and so on), and @code{smiley-nosey-regexp-alist} (which matches -@samp{:-)}, @samp{:-(} and so on). - -The alist used is specified by the @code{smiley-regexp-alist} variable, -which defaults to the value of @code{smiley-deformed-regexp-alist}. - -The first item in each element is the regexp to be matched; the second -element is the regexp match group that is to be replaced by the picture; -and the third element is the name of the file to be displayed. - -The following variables customize where Smiley will look for these -files, as well as the color to be used and stuff: - -@table @code - -@item smiley-data-directory -@vindex smiley-data-directory -Where Smiley will look for smiley faces files. - -@item smiley-flesh-color -@vindex smiley-flesh-color -Skin color. The default is @samp{yellow}, which is really racist. - -@item smiley-features-color -@vindex smiley-features-color -Color of the features of the face. The default is @samp{black}. - -@item smiley-tongue-color -@vindex smiley-tongue-color -Color of the tongue. The default is @samp{red}. - -@item smiley-circle-color -@vindex smiley-circle-color -Color of the circle around the face. The default is @samp{black}. - -@item smiley-mouse-face -@vindex smiley-mouse-face -Face used for mouse highlighting over the smiley face. - -@end table - - -@node Toolbar -@subsection Toolbar - -@table @code - -@iftex -@iflatex -\margindex{} -@end iflatex -@end iftex - -@item gnus-use-toolbar -@vindex gnus-use-toolbar -If @code{nil}, don't display toolbars. If non-@code{nil}, it should be -one of @code{default-toolbar}, @code{top-toolbar}, @code{bottom-toolbar}, -@code{right-toolbar}, or @code{left-toolbar}. - -@item gnus-group-toolbar -@vindex gnus-group-toolbar -The toolbar in the group buffer. - -@item gnus-summary-toolbar -@vindex gnus-summary-toolbar -The toolbar in the summary buffer. - -@item gnus-summary-mail-toolbar -@vindex gnus-summary-mail-toolbar -The toolbar in the summary buffer of mail groups. - -@end table - - -@node XVarious -@subsection Various XEmacs Variables - -@table @code -@item gnus-xmas-glyph-directory -@vindex gnus-xmas-glyph-directory -This is where Gnus will look for pictures. Gnus will normally -auto-detect this directory, but you may set it manually if you have an -unusual directory structure. - -@item gnus-xmas-logo-color-alist -@vindex gnus-xmas-logo-color-alist -This is an alist where the key is a type symbol and the values are the -foreground and background color of the splash page glyph. - -@item gnus-xmas-logo-color-style -@vindex gnus-xmas-logo-color-style -This is the key used to look up the color in the alist described above. -Legal values include @code{flame}, @code{pine}, @code{moss}, -@code{irish}, @code{sky}, @code{tin}, @code{velvet}, @code{grape}, -@code{labia}, @code{berry}, @code{neutral}, and @code{september}. - -@item gnus-xmas-modeline-glyph -@vindex gnus-xmas-modeline-glyph -A glyph displayed in all Gnus mode lines. It is a tiny gnu head by -default. - -@iftex -@iflatex -\margindex{} -@end iflatex -@end iftex - -@end table - - - - -@node Fuzzy Matching -@section Fuzzy Matching -@cindex fuzzy matching - -Gnus provides @dfn{fuzzy matching} of @code{Subject} lines when doing -things like scoring, thread gathering and thread comparison. - -As opposed to regular expression matching, fuzzy matching is very fuzzy. -It's so fuzzy that there's not even a definition of what @dfn{fuzziness} -means, and the implementation has changed over time. - -Basically, it tries to remove all noise from lines before comparing. -@samp{Re: }, parenthetical remarks, white space, and so on, are filtered -out of the strings before comparing the results. This often leads to -adequate results---even when faced with strings generated by text -manglers masquerading as newsreaders. - - -@node Thwarting Email Spam -@section Thwarting Email Spam -@cindex email spam -@cindex spam -@cindex UCE -@cindex unsolicited commercial email - -In these last days of the Usenet, commercial vultures are hanging about -and grepping through news like crazy to find email addresses they can -foist off their scams and products to. As a reaction to this, many -people have started putting nonsense addresses into their @code{From} -lines. I think this is counterproductive---it makes it difficult for -people to send you legitimate mail in response to things you write, as -well as making it difficult to see who wrote what. This rewriting may -perhaps be a bigger menace than the unsolicited commercial email itself -in the end. - -The biggest problem I have with email spam is that it comes in under -false pretenses. I press @kbd{g} and Gnus merrily informs me that I -have 10 new emails. I say ``Golly gee! Happy is me!'' and select the -mail group, only to find two pyramid schemes, seven advertisements -(``New! Miracle tonic for growing full, lustrouos hair on your toes!'') -and one mail asking me to repent and find some god. - -This is annoying. - -The way to deal with this is having Gnus split out all spam into a -@samp{spam} mail group (@pxref{Splitting Mail}). - -First, pick one (1) valid mail address that you can be reached at, and -put it in your @code{From} header of all your news articles. (I've -chosen @samp{larsi@@trym.ifi.uio.no}, but for many addresses on the form -@samp{larsi+usenet@@ifi.uio.no} will be a better choice. Ask your -sysadm whether your sendmail installation accepts keywords in the local -part of the mail address.) - -@lisp -(setq message-default-news-headers - "From: Lars Magne Ingebrigtsen \n") -@end lisp - -Then put the following split rule in @code{nnmail-split-fancy} -(@pxref{Fancy Mail Splitting}): - -@lisp -( - ... - (to "larsi@@trym.ifi.uio.no" - (| ("subject" "re:.*" "misc") - ("references" ".*@@.*" "misc") - "spam")) - ... -) -@end lisp - -This says that all mail to this address is suspect, but if it has a -@code{Subject} that starts with a @samp{Re:} or has a @code{References} -header, it's probably ok. All the rest goes to the @samp{spam} group. -(This idea probably comes from Tim Pierce.) - -In addition, many mail spammers talk directly to your @code{smtp} server -and do not include your email address explicitly in the @code{To} -header. Why they do this is unknown---perhaps it's to thwart this -twarting scheme? In any case, this is trivial to deal with---you just -put anything not addressed to you in the @samp{spam} group by ending -your fancy split rule in this way: - -@lisp -( - ... - (to "larsi" "misc") - "spam") -@end lisp - -In my experience, this will sort virtually everything into the right -group. You still have to check the @samp{spam} group from time to time to -check for legitimate mail, though. If you feel like being a good net -citizen, you can even send off complaints to the proper authorities on -each unsolicited commercial email---at your leisure. - -If you are also a lazy net citizen, you will probably prefer complaining -automatically with the @file{gnus-junk.el} package, availiable FOR FREE -at @file{}. -Since most e-mail spam is sent automatically, this may reconcile the -cosmic balance somewhat. - -This works for me. It allows people an easy way to contact me (they can -just press @kbd{r} in the usual way), and I'm not bothered at all with -spam. It's a win-win situation. Forging @code{From} headers to point -to non-existant domains is yucky, in my opinion. - - -@node Various Various -@section Various Various -@cindex mode lines -@cindex highlights - -@table @code - -@item gnus-home-directory -All Gnus path variables will be initialized from this variable, which -defaults to @file{~/}. - -@item gnus-directory -@vindex gnus-directory -Most Gnus storage path variables will be initialized from this variable, -which defaults to the @samp{SAVEDIR} environment variable, or -@file{~/News/} if that variable isn't set. - -@item gnus-default-directory -@vindex gnus-default-directory -Not related to the above variable at all---this variable says what the -default directory of all Gnus buffers should be. If you issue commands -like @kbd{C-x C-f}, the prompt you'll get starts in the current buffer's -default directory. If this variable is @code{nil} (which is the -default), the default directory will be the default directory of the -buffer you were in when you started Gnus. - -@item gnus-verbose -@vindex gnus-verbose -This variable is an integer between zero and ten. The higher the value, -the more messages will be displayed. If this variable is zero, Gnus -will never flash any messages, if it is seven (which is the default), -most important messages will be shown, and if it is ten, Gnus won't ever -shut up, but will flash so many messages it will make your head swim. - -@item gnus-verbose-backends -@vindex gnus-verbose-backends -This variable works the same way as @code{gnus-verbose}, but it applies -to the Gnus backends instead of Gnus proper. - -@item nnheader-max-head-length -@vindex nnheader-max-head-length -When the backends read straight heads of articles, they all try to read -as little as possible. This variable (default 4096) specifies -the absolute max length the backends will try to read before giving up -on finding a separator line between the head and the body. If this -variable is @code{nil}, there is no upper read bound. If it is -@code{t}, the backends won't try to read the articles piece by piece, -but read the entire articles. This makes sense with some versions of -@code{ange-ftp} or @code{efs}. - -@item nnheader-head-chop-length -@vindex nnheader-head-chop-length -This variable (default 2048) says how big a piece of each article to -read when doing the operation described above. - -@item nnheader-file-name-translation-alist -@vindex nnheader-file-name-translation-alist -@cindex file names -@cindex invalid characters in file names -@cindex characters in file names -This is an alist that says how to translate characters in file names. -For instance, if @samp{:} is invalid as a file character in file names -on your system (you OS/2 user you), you could say something like: - -@lisp -(setq nnheader-file-name-translation-alist - '((?: . ?_))) -@end lisp - -In fact, this is the default value for this variable on OS/2 and MS -Windows (phooey) systems. - -@item gnus-hidden-properties -@vindex gnus-hidden-properties -This is a list of properties to use to hide ``invisible'' text. It is -@code{(invisible t intangible t)} by default on most systems, which -makes invisible text invisible and intangible. - -@item gnus-parse-headers-hook -@vindex gnus-parse-headers-hook -A hook called before parsing headers. It can be used, for instance, to -gather statistics on the headers fetched, or perhaps you'd like to prune -some headers. I don't see why you'd want that, though. - -@item gnus-shell-command-separator -@vindex gnus-shell-command-separator -String used to separate two shell commands. The default is @samp{;}. - - -@end table - - -@node The End -@chapter The End - -Well, that's the manual---you can get on with your life now. Keep in -touch. Say hello to your cats from me. - -My @strong{ghod}---I just can't stand goodbyes. Sniffle. - -Ol' Charles Reznikoff said it pretty well, so I leave the floor to him: - -@quotation -@strong{Te Deum} - -@sp 1 -Not because of victories @* -I sing,@* -having none,@* -but for the common sunshine,@* -the breeze,@* -the largess of the spring. - -@sp 1 -Not for victory@* -but for the day's work done@* -as well as I was able;@* -not for a seat upon the dais@* -but at the common table.@* -@end quotation - - -@node Appendices -@chapter Appendices - -@menu -* History:: How Gnus got where it is today. -* Terminology:: We use really difficult, like, words here. -* Customization:: Tailoring Gnus to your needs. -* Troubleshooting:: What you might try if things do not work. -* A Programmers Guide to Gnus:: Rilly, rilly technical stuff. -* Emacs for Heathens:: A short introduction to Emacsian terms. -* Frequently Asked Questions:: A question-and-answer session. -@end menu - - -@node History -@section History - -@cindex history -@sc{gnus} was written by Masanobu @sc{Umeda}. When autumn crept up in -'94, Lars Magne Ingebrigtsen grew bored and decided to rewrite Gnus. - -If you want to investigate the person responsible for this outrage, you -can point your (feh!) web browser to -@file{http://www.ifi.uio.no/~larsi/}. This is also the primary -distribution point for the new and spiffy versions of Gnus, and is known -as The Site That Destroys Newsrcs And Drives People Mad. - -During the first extended alpha period of development, the new Gnus was -called ``(ding) Gnus''. @dfn{(ding)} is, of course, short for -@dfn{ding is not Gnus}, which is a total and utter lie, but who cares? -(Besides, the ``Gnus'' in this abbreviation should probably be -pronounced ``news'' as @sc{Umeda} intended, which makes it a more -appropriate name, don't you think?) - -In any case, after spending all that energy on coming up with a new and -spunky name, we decided that the name was @emph{too} spunky, so we -renamed it back again to ``Gnus''. But in mixed case. ``Gnus'' vs. -``@sc{gnus}''. New vs. old. - -The first ``proper'' release of Gnus 5 was done in November 1995 when it -was included in the Emacs 19.30 distribution (132 (ding) Gnus releases -plus 15 Gnus 5.0 releases). - -In May 1996 the next Gnus generation (aka. ``September Gnus'' (after 99 -releases)) was released under the name ``Gnus 5.2'' (40 releases). - -On July 28th 1996 work on Red Gnus was begun, and it was released on -January 25th 1997 (after 84 releases) as ``Gnus 5.4''. - -If you happen upon a version of Gnus that has a prefixed name -- -``(ding) Gnus'', ``September Gnus'', ``Red Gnus'', ``Quassia Gnus'' -- -don't panic. Don't let it know that you're frightened. Back away. -Slowly. Whatever you do, don't run. Walk away, calmly, until you're -out of its reach. Find a proper released version of Gnus and snuggle up -to that instead. - -@menu -* Why?:: What's the point of Gnus? -* Compatibility:: Just how compatible is Gnus with @sc{gnus}? -* Conformity:: Gnus tries to conform to all standards. -* Emacsen:: Gnus can be run on a few modern Emacsen. -* Contributors:: Oodles of people. -* New Features:: Pointers to some of the new stuff in Gnus. -* Newest Features:: Features so new that they haven't been written yet. -@end menu - - -@node Why? -@subsection Why? - -What's the point of Gnus? - -I want to provide a ``rad'', ``happening'', ``way cool'' and ``hep'' -newsreader, that lets you do anything you can think of. That was my -original motivation, but while working on Gnus, it has become clear to -me that this generation of newsreaders really belong in the stone age. -Newsreaders haven't developed much since the infancy of the net. If the -volume continues to rise with the current rate of increase, all current -newsreaders will be pretty much useless. How do you deal with -newsgroups that have thousands of new articles each day? How do you -keep track of millions of people who post? - -Gnus offers no real solutions to these questions, but I would very much -like to see Gnus being used as a testing ground for new methods of -reading and fetching news. Expanding on @sc{Umeda}-san's wise decision -to separate the newsreader from the backends, Gnus now offers a simple -interface for anybody who wants to write new backends for fetching mail -and news from different sources. I have added hooks for customizations -everywhere I could imagine it being useful. By doing so, I'm inviting -every one of you to explore and invent. - -May Gnus never be complete. @kbd{C-u 100 M-x all-hail-emacs} and -@kbd{C-u 100 M-x all-hail-xemacs}. - - -@node Compatibility -@subsection Compatibility - -@cindex compatibility -Gnus was designed to be fully compatible with @sc{gnus}. Almost all key -bindings have been kept. More key bindings have been added, of course, -but only in one or two obscure cases have old bindings been changed. - -Our motto is: -@quotation -@cartouche -@center In a cloud bones of steel. -@end cartouche -@end quotation - -All commands have kept their names. Some internal functions have changed -their names. - -The @code{gnus-uu} package has changed drastically. @xref{Decoding -Articles}. - -One major compatibility question is the presence of several summary -buffers. All variables relevant while reading a group are -buffer-local to the summary buffer they belong in. Although many -important variables have their values copied into their global -counterparts whenever a command is executed in the summary buffer, this -change might lead to incorrect values being used unless you are careful. - -All code that relies on knowledge of @sc{gnus} internals will probably -fail. To take two examples: Sorting @code{gnus-newsrc-alist} (or -changing it in any way, as a matter of fact) is strictly verboten. Gnus -maintains a hash table that points to the entries in this alist (which -speeds up many functions), and changing the alist directly will lead to -peculiar results. - -@cindex hilit19 -@cindex highlighting -Old hilit19 code does not work at all. In fact, you should probably -remove all hilit code from all Gnus hooks -(@code{gnus-group-prepare-hook} and @code{gnus-summary-prepare-hook}). -Gnus provides various integrated functions for highlighting. These are -faster and more accurate. To make life easier for everybody, Gnus will -by default remove all hilit calls from all hilit hooks. Uncleanliness! -Away! - -Packages like @code{expire-kill} will no longer work. As a matter of -fact, you should probably remove all old @sc{gnus} packages (and other -code) when you start using Gnus. More likely than not, Gnus already -does what you have written code to make @sc{gnus} do. (Snicker.) - -Even though old methods of doing things are still supported, only the -new methods are documented in this manual. If you detect a new method of -doing something while reading this manual, that does not mean you have -to stop doing it the old way. - -Gnus understands all @sc{gnus} startup files. - -@kindex M-x gnus-bug -@findex gnus-bug -@cindex reporting bugs -@cindex bugs -Overall, a casual user who hasn't written much code that depends on -@sc{gnus} internals should suffer no problems. If problems occur, -please let me know by issuing that magic command @kbd{M-x gnus-bug}. - - -@node Conformity -@subsection Conformity - -No rebels without a clue here, ma'am. We conform to all standards known -to (wo)man. Except for those standards and/or conventions we disagree -with, of course. - -@table @strong - -@item RFC 822 -@cindex RFC 822 -There are no known breaches of this standard. - -@item RFC 1036 -@cindex RFC 1036 -There are no known breaches of this standard, either. - -@item Son-of-RFC 1036 -@cindex Son-of-RFC 1036 -We do have some breaches to this one. - -@table @emph - -@item MIME -Gnus does no MIME handling, and this standard-to-be seems to think that -MIME is the bees' knees, so we have major breakage here. - -@item X-Newsreader -This is considered to be a ``vanity header'', while I consider it to be -consumer information. After seeing so many badly formatted articles -coming from @code{tin} and @code{Netscape} I know not to use either of -those for posting articles. I would not have known that if it wasn't -for the @code{X-Newsreader} header. -@end table - -@end table - -If you ever notice Gnus acting non-compliant with regards to the texts -mentioned above, don't hesitate to drop a note to Gnus Towers and let us -know. - - -@node Emacsen -@subsection Emacsen -@cindex Emacsen -@cindex XEmacs -@cindex Mule -@cindex Emacs - -Gnus should work on : - -@itemize @bullet - -@item -Emacs 19.32 and up. - -@item -XEmacs 19.14 and up. - -@item -Mule versions based on Emacs 19.32 and up. - -@end itemize - -Gnus will absolutely not work on any Emacsen older than that. Not -reliably, at least. - -There are some vague differences between Gnus on the various -platforms---XEmacs features more graphics (a logo and a toolbar)---but -other than that, things should look pretty much the same under all -Emacsen. - - -@node Contributors -@subsection Contributors -@cindex contributors - -The new Gnus version couldn't have been done without the help of all the -people on the (ding) mailing list. Every day for over a year I have -gotten billions of nice bug reports from them, filling me with joy, -every single one of them. Smooches. The people on the list have been -tried beyond endurance, what with my ``oh, that's a neat idea , yup, I'll release it right away no wait, that doesn't -work at all , yup, I'll ship that one off right away no, wait, that absolutely does not work'' policy for releases. -Micro$oft---bah. Amateurs. I'm @emph{much} worse. (Or is that -``worser''? ``much worser''? ``worsest''?) - -I would like to take this opportunity to thank the Academy for... oops, -wrong show. - -@itemize @bullet - -@item -Masanobu @sc{Umeda}---the writer of the original @sc{gnus}. - -@item -Per Abrahamsen---custom, scoring, highlighting and @sc{soup} code (as -well as numerous other things). - -@item -Luis Fernandes---design and graphics. - -@item -Erik Naggum---help, ideas, support, code and stuff. - -@item -Wes Hardaker---@file{gnus-picon.el} and the manual section on -@dfn{picons} (@pxref{Picons}). - -@item -Kim-Minh Kaplan---further work on the picon code. - -@item -Brad Miller---@file{gnus-gl.el} and the GroupLens manual section -(@pxref{GroupLens}). - -@item -Sudish Joseph---innumerable bug fixes. - -@item -Ilja Weis---@file{gnus-topic.el}. - -@item -Steven L. Baur---lots and lots and lots of bugs detections and fixes. - -@item -Vladimir Alexiev---the refcard and reference booklets. - -@item -Felix Lee & Jamie Zawinsky---I stole some pieces from the XGnus -distribution by Felix Lee and JWZ. - -@item -Scott Byer---@file{nnfolder.el} enhancements & rewrite. - -@item -Peter Mutsaers---orphan article scoring code. - -@item -Ken Raeburn---POP mail support. - -@item -Hallvard B Furuseth---various bits and pieces, especially dealing with -.newsrc files. - -@item -Brian Edmonds---@file{gnus-bbdb.el}. - -@item -David Moore---rewrite of @file{nnvirtual.el} and many other things. - -@item -Kevin Davidson---came up with the name @dfn{ding}, so blame him. - -@item -François Pinard---many, many interesting and thorough bug reports. - -@end itemize - -This manual was proof-read by Adrian Aichner, with Ricardo Nassif, Mark -Borges, and Jost Krieger proof-reading parts of the manual. - -The following people have contributed many patches and suggestions: - -Christopher Davis, -Andrew Eskilsson, -Kai Grossjohann, -David Kågedal, -Richard Pieri, -Fabrice Popineau, -Daniel Quinlan, -Jason L. Tibbitts, III, -and -Jack Vinson. - -Also thanks to the following for patches and stuff: - -Jari Aalto, -Adrian Aichner, -Russ Allbery, -Peter Arius, -Matt Armstrong, -Marc Auslander, -Robert Bihlmeyer, -Chris Bone, -Mark Borges, -Mark Boyns, -Lance A. Brown, -Kees de Bruin, -Martin Buchholz, -Kevin Buhr, -Alastair Burt, -Joao Cachopo, -Zlatko Calusic, -Massimo Campostrini, -Dan Christensen, -Michael R. Cook, -Glenn Coombs, -Frank D. Cringle, -Geoffrey T. Dairiki, -Andre Deparade, -Ulrik Dickow, -Dave Disser, -Joev Dubach, -Michael Welsh Duggan, -Dave Edmondson, -Paul Eggert, -Enami Tsugutomo, @c Enami -Michael Ernst, -Luc Van Eycken, -Sam Falkner, -Nelson Jose dos Santos Ferreira, -Sigbjorn Finne, -Gary D. Foster, -Paul Franklin, -Guy Geens, -Arne Georg Gleditsch, -David S. Goldberg, -Michelangelo Grigni, -D. Hall, -Magnus Hammerin, -Kenichi Handa, @c Handa -Raja R. Harinath, -Hisashige Kenji, @c Hisashige -Marc Horowitz, -Gunnar Horrigmo, -Richard Hoskins, -Brad Howes, -François Felix Ingrand, -Ishikawa Ichiro, @c Ishikawa -Lee Iverson, -Iwamuro Motonori, @c Iwamuro -Rajappa Iyer, -Andreas Jaeger, -Randell Jesup, -Fred Johansen, -Simon Josefsson, -Greg Klanderman, -Karl Kleinpaste, -Peter Skov Knudsen, -Shuhei Kobayashi, @c Kobayashi -Thor Kristoffersen, -Jens Lautenbacher, -Seokchan Lee, @c Lee -Carsten Leonhardt, -James LewisMoss, -Christian Limpach, -Markus Linnala, -Dave Love, -Tonny Madsen, -Shlomo Mahlab, -Nat Makarevitch, -Istvan Marko, -David Martin, -Gordon Matzigkeit, -Timo Metzemakers, -Richard Mlynarik, -Lantz Moore, -Morioka Tomohiko, @c Morioka -Erik Toubro Nielsen, -Hrvoje Niksic, -Andy Norman, -Fred Oberhauser, -C. R. Oldham, -Alexandre Oliva, -Ken Olstad, -Masaharu Onishi, @c Onishi -Hideki Ono, @c Ono -William Perry, -Stephen Peters, -Ulrich Pfeifer, -John McClary Prevost, -Colin Rafferty, -Lars Balker Rasmussen, -Joe Reiss, -Renaud Rioboo, -Roland B. Roberts, -Bart Robinson, -Christian von Roques, -Jason Rumney, -Jay Sachs, -Dewey M. Sasser, -Loren Schall, -Dan Schmidt, -Ralph Schleicher, -Philippe Schnoebelen, -Randal L. Schwartz, -Justin Sheehy, -Danny Siu, -Matt Simmons, -Paul D. Smith, -Jeff Sparkes, -Toby Speight, -Michael Sperber, -Darren Stalder, -Richard Stallman, -Greg Stark, -Paul Stodghill, -Kurt Swanson, -Samuel Tardieu, -Teddy, -Chuck Thompson, -Philippe Troin, -James Troup, -Aaron M. Ucko, -Aki Vehtari, -Didier Verna, -Jan Vroonhof, -Stefan Waldherr, -Pete Ware, -Barry A. Warsaw, -Christoph Wedler, -Joe Wells, -and -Katsumi Yamaoka. @c Yamaoka - -For a full overview of what each person has done, the ChangeLogs -included in the Gnus alpha distributions should give ample reading -(550kB and counting). - -Apologies to everybody that I've forgotten, of which there are many, I'm -sure. - -Gee, that's quite a list of people. I guess that must mean that there -actually are people who are using Gnus. Who'd'a thunk it! - - -@node New Features -@subsection New Features -@cindex new features - -@menu -* ding Gnus:: New things in Gnus 5.0/5.1, the first new Gnus. -* September Gnus:: The Thing Formally Known As Gnus 5.3/5.3. -* Red Gnus:: Third time best---Gnus 5.4/5.5. -@end menu - -These lists are, of course, just @emph{short} overviews of the -@emph{most} important new features. No, really. There are tons more. -Yes, we have feeping creaturism in full effect. - - -@node ding Gnus -@subsubsection (ding) Gnus - -New features in Gnus 5.0/5.1: - -@itemize @bullet - -@item -The look of all buffers can be changed by setting format-like variables -(@pxref{Group Buffer Format} and @pxref{Summary Buffer Format}). - -@item -Local spool and several @sc{nntp} servers can be used at once -(@pxref{Select Methods}). - -@item -You can combine groups into virtual groups (@pxref{Virtual Groups}). - -@item -You can read a number of different mail formats (@pxref{Getting Mail}). -All the mail backends implement a convenient mail expiry scheme -(@pxref{Expiring Mail}). - -@item -Gnus can use various strategies for gathering threads that have lost -their roots (thereby gathering loose sub-threads into one thread) or it -can go back and retrieve enough headers to build a complete thread -(@pxref{Customizing Threading}). - -@item -Killed groups can be displayed in the group buffer, and you can read -them as well (@pxref{Listing Groups}). - -@item -Gnus can do partial group updates---you do not have to retrieve the -entire active file just to check for new articles in a few groups -(@pxref{The Active File}). - -@item -Gnus implements a sliding scale of subscribedness to groups -(@pxref{Group Levels}). - -@item -You can score articles according to any number of criteria -(@pxref{Scoring}). You can even get Gnus to find out how to score -articles for you (@pxref{Adaptive Scoring}). - -@item -Gnus maintains a dribble buffer that is auto-saved the normal Emacs -manner, so it should be difficult to lose much data on what you have -read if your machine should go down (@pxref{Auto Save}). - -@item -Gnus now has its own startup file (@file{.gnus}) to avoid cluttering up -the @file{.emacs} file. - -@item -You can set the process mark on both groups and articles and perform -operations on all the marked items (@pxref{Process/Prefix}). - -@item -You can grep through a subset of groups and create a group from the -results (@pxref{Kibozed Groups}). - -@item -You can list subsets of groups according to, well, anything -(@pxref{Listing Groups}). - -@item -You can browse foreign servers and subscribe to groups from those -servers (@pxref{Browse Foreign Server}). - -@item -Gnus can fetch articles, asynchronously, on a second connection to the -server (@pxref{Asynchronous Fetching}). - -@item -You can cache articles locally (@pxref{Article Caching}). - -@item -The uudecode functions have been expanded and generalized -(@pxref{Decoding Articles}). - -@item -You can still post uuencoded articles, which was a little-known feature -of @sc{gnus}' past (@pxref{Uuencoding and Posting}). - -@item -Fetching parents (and other articles) now actually works without -glitches (@pxref{Finding the Parent}). - -@item -Gnus can fetch FAQs and group descriptions (@pxref{Group Information}). - -@item -Digests (and other files) can be used as the basis for groups -(@pxref{Document Groups}). - -@item -Articles can be highlighted and customized (@pxref{Customizing -Articles}). - -@item -URLs and other external references can be buttonized (@pxref{Article -Buttons}). - -@item -You can do lots of strange stuff with the Gnus window & frame -configuration (@pxref{Windows Configuration}). - -@item -You can click on buttons instead of using the keyboard -(@pxref{Buttons}). - -@end itemize - - -@node September Gnus -@subsubsection September Gnus - -@iftex -@iflatex -\gnusfig{-28cm}{0cm}{\epsfig{figure=tmp/september.ps,height=20cm}} -@end iflatex -@end iftex - -New features in Gnus 5.2/5.3: - -@itemize @bullet - -@item -A new message composition mode is used. All old customization variables -for @code{mail-mode}, @code{rnews-reply-mode} and @code{gnus-msg} are -now obsolete. - -@item -Gnus is now able to generate @dfn{sparse} threads---threads where -missing articles are represented by empty nodes (@pxref{Customizing -Threading}). - -@lisp -(setq gnus-build-sparse-threads 'some) -@end lisp - -@item -Outgoing articles are stored on a special archive server -(@pxref{Archived Messages}). - -@item -Partial thread regeneration now happens when articles are -referred. - -@item -Gnus can make use of GroupLens predictions (@pxref{GroupLens}). - -@item -Picons (personal icons) can be displayed under XEmacs (@pxref{Picons}). - -@item -A @code{trn}-like tree buffer can be displayed (@pxref{Tree Display}). - -@lisp -(setq gnus-use-trees t) -@end lisp - -@item -An @code{nn}-like pick-and-read minor mode is available for the summary -buffers (@pxref{Pick and Read}). - -@lisp -(add-hook 'gnus-summary-mode-hook 'gnus-pick-mode) -@end lisp - -@item -In binary groups you can use a special binary minor mode (@pxref{Binary -Groups}). - -@item -Groups can be grouped in a folding topic hierarchy (@pxref{Group -Topics}). - -@lisp -(add-hook 'gnus-group-mode-hook 'gnus-topic-mode) -@end lisp - -@item -Gnus can re-send and bounce mail (@pxref{Summary Mail Commands}). - -@item -Groups can now have a score, and bubbling based on entry frequency -is possible (@pxref{Group Score}). - -@lisp -(add-hook 'gnus-summary-exit-hook 'gnus-summary-bubble-group) -@end lisp - -@item -Groups can be process-marked, and commands can be performed on -groups of groups (@pxref{Marking Groups}). - -@item -Caching is possible in virtual groups. - -@item -@code{nndoc} now understands all kinds of digests, mail boxes, rnews -news batches, ClariNet briefs collections, and just about everything -else (@pxref{Document Groups}). - -@item -Gnus has a new backend (@code{nnsoup}) to create/read SOUP packets -(@pxref{SOUP}). - -@item -The Gnus cache is much faster. - -@item -Groups can be sorted according to many criteria (@pxref{Sorting -Groups}). - -@item -New group parameters have been introduced to set list-addresses and -expiry times (@pxref{Group Parameters}). - -@item -All formatting specs allow specifying faces to be used -(@pxref{Formatting Fonts}). - -@item -There are several more commands for setting/removing/acting on process -marked articles on the @kbd{M P} submap (@pxref{Setting Process Marks}). - -@item -The summary buffer can be limited to show parts of the available -articles based on a wide range of criteria. These commands have been -bound to keys on the @kbd{/} submap (@pxref{Limiting}). - -@item -Articles can be made persistent with the @kbd{*} command -(@pxref{Persistent Articles}). - -@item -All functions for hiding article elements are now toggles. - -@item -Article headers can be buttonized (@pxref{Article Washing}). - -@lisp -(add-hook 'gnus-article-display-hook - 'gnus-article-add-buttons-to-head) -@end lisp - -@item -All mail backends support fetching articles by @code{Message-ID}. - -@item -Duplicate mail can now be treated properly (@pxref{Duplicates}). - -@item -All summary mode commands are available directly from the article -buffer (@pxref{Article Keymap}). - -@item -Frames can be part of @code{gnus-buffer-configuration} (@pxref{Windows -Configuration}). - -@item -Mail can be re-scanned by a daemonic process (@pxref{Daemons}). -@iftex -@iflatex -\marginpar[\mbox{}\hfill\epsfig{figure=tmp/fseptember.ps,height=5cm}]{\epsfig{figure=tmp/fseptember.ps,height=5cm}} -@end iflatex -@end iftex - -@item -Gnus can make use of NoCeM files to weed out spam (@pxref{NoCeM}). - -@lisp -(setq gnus-use-nocem t) -@end lisp - -@item -Groups can be made permanently visible (@pxref{Listing Groups}). - -@lisp -(setq gnus-permanently-visible-groups "^nnml:") -@end lisp - -@item -Many new hooks have been introduced to make customizing easier. - -@item -Gnus respects the @code{Mail-Copies-To} header. - -@item -Threads can be gathered by looking at the @code{References} header -(@pxref{Customizing Threading}). - -@lisp -(setq gnus-summary-thread-gathering-function - 'gnus-gather-threads-by-references) -@end lisp - -@item -Read articles can be stored in a special backlog buffer to avoid -refetching (@pxref{Article Backlog}). - -@lisp -(setq gnus-keep-backlog 50) -@end lisp - -@item -A clean copy of the current article is always stored in a separate -buffer to allow easier treatment. - -@item -Gnus can suggest where to save articles (@pxref{Saving Articles}). - -@item -Gnus doesn't have to do as much prompting when saving (@pxref{Saving -Articles}). - -@lisp -(setq gnus-prompt-before-saving t) -@end lisp - -@item -@code{gnus-uu} can view decoded files asynchronously while fetching -articles (@pxref{Other Decode Variables}). - -@lisp -(setq gnus-uu-grabbed-file-functions 'gnus-uu-grab-view) -@end lisp - -@item -Filling in the article buffer now works properly on cited text -(@pxref{Article Washing}). - -@item -Hiding cited text adds buttons to toggle hiding, and how much -cited text to hide is now customizable (@pxref{Article Hiding}). - -@lisp -(setq gnus-cited-lines-visible 2) -@end lisp - -@item -Boring headers can be hidden (@pxref{Article Hiding}). - -@lisp -(add-hook 'gnus-article-display-hook - 'gnus-article-hide-boring-headers t) -@end lisp - -@item -Default scoring values can now be set from the menu bar. - -@item -Further syntax checking of outgoing articles have been added. - -@end itemize - - -@node Red Gnus -@subsubsection Red Gnus - -New features in Gnus 5.4/5.5: - -@iftex -@iflatex -\gnusfig{-5.5cm}{-4cm}{\epsfig{figure=tmp/red.ps,height=20cm}} -@end iflatex -@end iftex - -@itemize @bullet - -@item -@file{nntp.el} has been totally rewritten in an asynchronous fashion. - -@item -Article prefetching functionality has been moved up into -Gnus (@pxref{Asynchronous Fetching}). - -@item -Scoring can now be performed with logical operators like @code{and}, -@code{or}, @code{not}, and parent redirection (@pxref{Advanced -Scoring}). - -@item -Article washing status can be displayed in the -article mode line (@pxref{Misc Article}). - -@item -@file{gnus.el} has been split into many smaller files. - -@item -Suppression of duplicate articles based on Message-ID can be done -(@pxref{Duplicate Suppression}). - -@lisp -(setq gnus-suppress-duplicates t) -@end lisp - -@item -New variables for specifying what score and adapt files are to be -considered home score and adapt files (@pxref{Home Score File}) have -been added. - -@item -@code{nndoc} was rewritten to be easily extendable (@pxref{Document -Server Internals}). - -@item -Groups can inherit group parameters from parent topics (@pxref{Topic -Parameters}). - -@item -Article editing has been revamped and is now actually usable. - -@item -Signatures can be recognized in more intelligent fashions -(@pxref{Article Signature}). - -@item -Summary pick mode has been made to look more @code{nn}-like. Line -numbers are displayed and the @kbd{.} command can be used to pick -articles (@code{Pick and Read}). - -@item -Commands for moving the @file{.newsrc.eld} from one server to -another have been added (@pxref{Changing Servers}). - -@item -There's a way now to specify that ``uninteresting'' fields be suppressed -when generating lines in buffers (@pxref{Advanced Formatting}). - -@item -Several commands in the group buffer can be undone with @kbd{M-C-_} -(@pxref{Undo}). - -@item -Scoring can be done on words using the new score type @code{w} -(@pxref{Score File Format}). - -@item -Adaptive scoring can be done on a Subject word-by-word basis -(@pxref{Adaptive Scoring}). - -@lisp -(setq gnus-use-adaptive-scoring '(word)) -@end lisp - -@item -Scores can be decayed (@pxref{Score Decays}). - -@lisp -(setq gnus-decay-scores t) -@end lisp - -@item -Scoring can be performed using a regexp on the Date header. The Date is -normalized to compact ISO 8601 format first (@pxref{Score File Format}). - -@item -A new command has been added to remove all data on articles from -the native server (@pxref{Changing Servers}). - -@item -A new command for reading collections of documents -(@code{nndoc} with @code{nnvirtual} on top) has been added---@kbd{M-C-d} -(@pxref{Really Various Summary Commands}). - -@item -Process mark sets can be pushed and popped (@pxref{Setting Process -Marks}). - -@item -A new mail-to-news backend makes it possible to post even when the NNTP -server doesn't allow posting (@pxref{Mail-To-News Gateways}). - -@item -A new backend for reading searches from Web search engines -(@dfn{DejaNews}, @dfn{Alta Vista}, @dfn{InReference}) has been added -(@pxref{Web Searches}). - -@item -Groups inside topics can now be sorted using the standard sorting -functions, and each topic can be sorted independently (@pxref{Topic -Sorting}). - -@item -Subsets of the groups can be sorted independently (@code{Sorting -Groups}). - -@item -Cached articles can be pulled into the groups (@pxref{Summary Generation -Commands}). -@iftex -@iflatex -\marginpar[\mbox{}\hfill\epsfig{figure=tmp/fred.ps,width=3cm}]{\epsfig{figure=tmp/fred.ps,width=3cm}} -@end iflatex -@end iftex - -@item -Score files are now applied in a more reliable order (@pxref{Score -Variables}). - -@item -Reports on where mail messages end up can be generated (@pxref{Splitting -Mail}). - -@item -More hooks and functions have been added to remove junk from incoming -mail before saving the mail (@pxref{Washing Mail}). - -@item -Emphasized text can be properly fontisized: - -@lisp -(add-hook 'gnus-article-display-hook 'gnus-article-emphasize) -@end lisp - -@end itemize - - -@node Newest Features -@subsection Newest Features -@cindex todo - -Also known as the @dfn{todo list}. Sure to be implemented before the -next millennium. - -Be afraid. Be very afraid. - -(That a feature appears in this list doesn't necessarily mean that I've -decided to actually implement it. It just means that I think it sounds -interesting.) - -(Yes, this is the actual, up-to-the-second todo list.) - -@itemize @bullet - -@item -Native @sc{mime} support is something that should be done. - -@item -Really do unbinhexing. - -@item - I would like the zombie-page to contain an URL to the source of the -latest version of gnus or some explanation on where to find it. - -@item - A way to continue editing the latest Message composition. - -@item - http://www.sonicnet.com/feature/ari3/ - -@item - facep is not declared. - -@item - Include a section in the manual on why the number of articles -isn't the same in the group buffer and on the SPC prompt. - -@item - Interacting with rmail fcc isn't easy. - -@item -@example - Hypermail: - - - - -http://www.uwsg.indiana.edu/hypermail/linux/kernel/9610/index.html - -http://www.miranova.com/gnus-list/ - -@end example - -@item -@samp{^-- } is made into - in LaTeX. - -@item - gnus-kill is much slower than it was in GNUS 4.1.3. - -@item - when expunging articles on low score, the sparse nodes keep hanging on? -@item - starting the first time seems to hang Gnus on some systems. Does -NEWGROUPS answer too fast? -@item - nndir doesn't read gzipped files. -@item - FAQ doesn't have an up node? -@item - when moving mail from a procmail spool to the crash-box, -the crash-box is only appropriate to one specific group. -@item - `t' `t' makes X-Faces disappear. -@item - nnmh-be-safe means that crossposted articles will -be marked as unread. -@item - Orphan score entries dont show on "V t" score trace -@item - when clearing out data, the cache data should also be reset. -@item - rewrite gnus-summary-limit-children to be non-recursive -to avoid exceeding lisp nesting on huge groups. -@item - expinged articles are counted when computing scores. -@item - implement gnus-batch-brew-soup -@item - ticked articles aren't easy to read in pick mode -- `n' and -stuff just skips past them. Read articles are the same. -@item - topics that contain just groups with ticked -articles aren't displayed. -@item - nndoc should always allocate unique Message-IDs. -@item - implement gnus-score-thread -@item - If there are mail groups the first time you use Gnus, Gnus'll -make the mail groups killed. -@item - no "no news is good news" when using topics. -@item - when doing crosspost marking, the cache has to be consulted -and articles have to be removed. -@item - nnweb should fetch complete articles when they are split into several -parts. -@item - scoring on head immediate doesn't work. -@item - finding short score file names takes forever. -@item - canceling articles in foreign groups. -@item - nntp-open-rlogin no longer works. -@item - C-u C-x C-s (Summary) switches to the group buffer. -@item - move nnmail-split-history out to the backends. -@item - nnweb doesn't work properly. -@item - using a virtual server name as `gnus-select-method' doesn't work? -@item - when killing/yanking a group from one topic to another in a slave, the -master will yank it first to one topic and then add it to another. -Perhaps. - -@item - warn user about `=' redirection of a group in the active file? -@item - really unbinhex binhex files. -@item - take over the XEmacs menubar and offer a toggle between the XEmacs -bar and the Gnus bar. -@item -@example - push active file and NOV file parsing down into C code. -`(canonize-message-id id)' -`(mail-parent-message-id references n)' -`(parse-news-nov-line &optional dependency-hashtb)' -`(parse-news-nov-region beg end &optional dependency-hashtb fullp)' -`(parse-news-active-region beg end hashtb)' - -@end example - -@item - nnml .overview directory with splits. -@item - asynchronous cache -@item - postponed commands. -@item - the selected article show have its Subject displayed in its summary line. -@item - when entering groups, get the real number of unread articles from -the server? -@item - sort after gathering threads -- make false roots have the -headers of the oldest orhpan with a 0 article number? -@item - nndoc groups should inherit the score files of their parents? Also -inherit copy prompts and save files. -@item - command to start up Gnus (if not running) and enter a mail mode buffer. -@item - allow editing the group description from the group buffer -for backends that support that. -@item -gnus-hide,show-all-topics -@item - groups and sub-topics should be allowed to mingle inside each topic, -and not just list all subtopics at the end. -@item - a command to remove all read articles that are not needed to connect -threads -- `gnus-summary-limit-to-sparse-unread'? -@item - a variable to turn off limiting/cutting of threads in the tree buffer. -@item - a variable to limit how many files are uudecoded. -@item - add zombie groups to a special "New Groups" topic. -@item - server mode command: close/open all connections -@item - put a file date in gnus-score-alist and check whether the file -has been changed before using it. -@item - on exit from a digest group, go to the next article in the parent group. -@item - hide (sub)threads with low score. -@item - when expiring, remove all marks from expired articles. -@item - gnus-summary-limit-to-body -@item - a regexp alist that says what level groups are to be subscribed -on. Eg. -- `(("nnml:" . 1))'. -@item - easier interface to nnkiboze to create ephemeral groups that -contaion groups that match a regexp. -@item - allow newlines in urls, but remove them before using -the URL. -@item - If there is no From line, the mail backends should fudge one from the -"From " line. -@item - fuzzy simplifying should strip all non-alpha-numerical info -from subject lines. -@item - gnus-soup-brew-soup-with-high-scores. -@item - nntp-ping-before-connect -@item - command to check whether NOV is evil. "list overview.fmt". -@item - when entering a group, Gnus should look through the score -files very early for `local' atoms and set those local variables. -@item - message annotations. -@item - topics are always yanked before groups, and that's not good. -@item - (set-extent-property extent 'help-echo "String to display in minibuf") -to display help in the minibuffer on buttons under XEmacs. -@item - allow group line format spec to say how many articles there -are in the cache. -@item - AUTHINFO GENERIC -@item - support qmail maildir spools -@item - `run-with-idle-timer' in gnus-demon. -@item - stop using invisible text properties and start using overlays instead -@item - C-c C-f C-e to add an Expires header. -@item - go from one group to the next; everything is expunged; go to the -next group instead of going to the group buffer. -@item - gnus-renumber-cache -- to renumber the cache using "low" numbers. -@item - record topic changes in the dribble buffer. -@item - `nnfolder-generate-active-file' should look at the folders it -finds and generate proper active ranges. -@item - nneething-look-in-files-for-article-heads variable to control -whether nneething should sniff all files in the directories. -@item - gnus-fetch-article -- start Gnus, enter group, display article -@item - gnus-dont-move-articles-to-same-group variable when respooling. -@item - when messages are crossposted between several auto-expirable groups, -articles aren't properly marked as expirable. -@item - nneething should allow deletion/moving. -@item - TAB on the last button should go to the first button. -@item - if the car of an element in `mail-split-methods' is a function, -and the function returns non-nil, use that as the name of the group(s) to -save mail in. -@item - command for listing all score files that have been applied. -@item - a command in the article buffer to return to `summary' config. -@item - `gnus-always-post-using-current-server' -- variable to override -`C-c C-c' when posting. -@item - nnmail-group-spool-alist -- says where each group should use -as a spool file. -@item - when an article is crossposted to an auto-expirable group, the article -should be marker as expirable. -@item - article mode command/menu for "send region as URL to browser". -@item - on errors, jump to info nodes that explain the error. For instance, -on invalid From headers, or on error messages from the nntp server. -@item - when gathering threads, make the article that has no "Re: " the parent. -Also consult Date headers. -@item - a token in splits to call shrink-window-if-larger-than-buffer -@item - `1 0 A M' to do matches on the active hashtb. -@item - duplicates -- command to remove Gnus-Warning header, use the read -Message-ID, delete the "original". -@item - when replying to several messages at once, put the "other" message-ids -into a See-Also header. -@item - support setext: URL:http://www.bsdi.com/setext/ -@item - support ProleText: -@item - when browsing a foreign server, the groups that are already subscribed -should be listed as such and not as "K". -@item - generate font names dynamically. -@item - score file mode auto-alist. -@item - allow nndoc to change/add/delete things from documents. Implement -methods for each format for adding an article to the document. -@item - `gnus-fetch-old-headers' `all' value to incorporate -absolutely all headers there is. -@item - function like `|', but concatenate all marked articles -and pipe them to the process. -@item - cache the list of killed (or active) groups in a separate file. Update -the file whenever we read the active file or the list -of killed groups in the .eld file reaches a certain length. -@item - function for starting to edit a file to put into -the current mail group. -@item - score-find-trace should display the total score of the article. -@item - "ghettozie" -- score on Xref header and nix it out after using it -to avoid marking as read in other groups it has been crossposted to. -@item - look at procmail splitting. The backends should create -the groups automatically if a spool file exists for that group. -@item - function for backends to register themselves with Gnus. -@item - when replying to several process-marked articles, -have all the From end up in Cc headers? Variable to toggle. -@item - command to delete a crossposted mail article from all -groups it has been mailed to. -@item - `B c' and `B m' should be crosspost aware. -@item - hide-pgp should also hide PGP public key blocks. -@item - Command in the group buffer to respoll process-marked groups. -@item - `gnus-summary-find-matching' should accept -pseudo-"headers" like "body", "head" and "all" -@item - When buttifying things, all white space (including -newlines) should be ignored. -@item - Process-marking all groups in a topic should process-mark -groups in subtopics as well. -@item - Add non-native groups to the list of killed groups when killing them. -@item - nntp-suggest-kewl-config to probe the nntp server and suggest -variable settings. -@item - add edit and forward secondary marks. -@item - nnml shouldn't visit its .overview files. -@item - allow customizing sorting within gathered threads. -@item - `B q' shouldn't select the current article. -@item - nnmbox should support a newsgroups file for descriptions. -@item - allow fetching mail from several pop servers. -@item - Be able to specify whether the saving commands save the original -or the formatted article. -@item - a command to reparent with the child process-marked (cf. `T ^'.). -@item - I think the possibility to send a password with nntp-open-rlogin -should be a feature in Red Gnus. -@item - The `Z n' command should be possible to execute from a mouse click. -@item - more limiting functions -- date, etc. -@item - be able to limit on a random header; on body; using reverse matches. -@item - a group parameter (`absofucking-total-expiry') that will make Gnus expire -even unread articles. -@item - a command to print the article buffer as postscript. -@item - variable to disable password fetching when opening by nntp-open-telnet. -@item - manual: more example servers -- nntp with rlogin, telnet -@item - checking for bogus groups should clean topic alists as well. -@item - cancelling articles in foreign groups. -@item - article number in folded topics isn't properly updated by -Xref handling. -@item - Movement in the group buffer to the next unread group should go to the -next closed topic with unread messages if no group can be found. -@item - Extensive info pages generated on the fly with help everywhere -- -in the "*Gnus edit*" buffers, for instance. -@item - Topic movement commands -- like thread movement. Up, down, forward, next. -@item - a way to tick/mark as read Gcc'd articles. -@item - a way to say that all groups within a specific topic comes -from a particular server? Hm. -@item - `gnus-article-fill-if-long-lines' -- a function to fill -the article buffer if there are any looong lines there. -@item - `T h' should jump to the parent topic and fold it. -@item - a command to create an ephemeral nndoc group out of a file, -and then splitting it/moving it to some other group/backend. -@item - a group parameter for nnkiboze groups that says that -all kibozed articles should be entered into the cache. -@item - It should also probably be possible to delimit what -`gnus-jog-cache' does -- for instance, work on just some groups, or on -some levels, and entering just articles that have a score higher than -a certain number. -@item - nnfolder should append to the folder instead of re-writing -the entire folder to disk when accepting new messages. -@item - allow all backends to do the proper thing with .gz files. -@item - a backend for reading collections of babyl files nnbabylfolder? -@item - a command for making the native groups into foreign groups. -@item - server mode command for clearing read marks from all groups -from a server. -@item - when following up mulitple articles, include all To, Cc, etc headers -from all articles. -@item - a command for deciding what the total score of the current -thread is. Also a way to highlight based on this. -@item - command to show and edit group scores -@item - a gnus-tree-minimize-horizontal to minimize tree buffers -horizontally. -@item - command to generate nnml overview file for one group. -@item - `C-u C-u a' -- prompt for many crossposted groups. -@item - keep track of which mail groups have received new articles (in this session). -Be able to generate a report and perhaps do some marking in the group -buffer. -@item - gnus-build-sparse-threads to a number -- build only sparse threads -that are of that length. -@item - have nnmh respect mh's unseen sequence in .mh_profile. -@item - cache the newsgroups descriptions locally. -@item - asynchronous posting under nntp. -@item - be able to control word adaptive scoring from the score files. -@item - a variable to make `C-c C-c' post using the "current" select method. -@item - `limit-exclude-low-scored-articles'. -@item - if `gnus-summary-show-thread' is a number, hide threads that have -a score lower than this number. -@item - split newsgroup subscription variable up into "order" and "method". -@item - buttonize ange-ftp file names. -@item - a command to make a duplicate copy of the current article -so that each copy can be edited separately. -@item - nnweb should allow fetching from the local nntp server. -@item - record the sorting done in the summary buffer so that -it can be repeated when limiting/regenerating the buffer. -@item - nnml-generate-nov-databses should generate for -all nnml servers. -@item - when the user does commands in the group buffer, check -the modification time of the .newsrc.eld file and use -ask-user-about-supersession-threat. Also warn when trying -to save .newsrc.eld and it has changed. -@item - M-g on a topic will display all groups with 0 articles in -the topic. -@item - command to remove all topic stuff. -@item - allow exploding incoming digests when reading incoming mail -and splitting the resulting digests. -@item - nnsoup shouldn't set the `message-' variables. -@item - command to nix out all nnoo state information. -@item - nnmail-process-alist that calls functions if group names -matches an alist -- before saving. -@item - use buffer-invisibility-spec everywhere for hiding text. -@item - variable to activate each group before entering them -to get the (new) number of articles. `gnus-activate-before-entering'. -@item - command to fetch a Message-ID from any buffer, even -starting Gnus first if necessary. -@item - when posting and checking whether a group exists or not, just -ask the nntp server instead of relying on the active hashtb. -@item - buttonize the output of `C-c C-a' in an apropos-like way. -@item - `G p' should understand process/prefix, and allow editing -of several groups at once. -@item - command to create an ephemeral nnvirtual group that -matches some regexp(s). -@item - nndoc should understand "Content-Type: message/rfc822" forwarded messages. -@item - it should be possible to score "thread" on the From header. -@item - hitting RET on a "gnus-uu-archive" pseudo article should unpack it. -@item - `B i' should display the article at once in the summary buffer. -@item - remove the "*" mark at once when unticking an article. -@item - `M-s' should highlight the matching text. -@item - when checking for duplicated mails, use Resent-Message-ID if present. -@item - killing and yanking groups in topics should be better. If killing one copy -of a group that exists in multiple topics, only that copy should -be removed. Yanking should insert the copy, and yanking topics -should be possible to be interspersed with the other yankings. -@item - command for enter a group just to read the cached articles. A way to say -"ignore the nntp connection; just read from the cache." -@item - `X u' should decode base64 articles. -@item - a way to hide all "inner" cited text, leaving just the most -recently cited text. -@item - nnvirtual should be asynchronous. -@item - after editing an article, gnus-original-article-buffer should -be invalidated. -@item - there should probably be a way to make Gnus not connect to the -server and just read the articles in the server -@item - allow a `set-default' (or something) to change the default -value of nnoo variables. -@item - a command to import group infos from a .newsrc.eld file. -@item - groups from secondary servers have the entire select method -listed in each group info. -@item - a command for just switching from the summary buffer to the group -buffer. -@item - a way to specify that some incoming mail washing functions -should only be applied to some groups. -@item - Message `C-f C-t' should ask the user whether to heed -mail-copies-to: never. -@item - new group parameter -- `post-to-server' that says to post -using the current server. Also a variable to do the same. -@item - the slave dribble files should autosave to the slave file names. -@item - a group parameter that says what articles to display on group entry, based -on article marks. -@item - a way to visually distinguish slave Gnusae from masters. (Whip instead -of normal logo?) -@item - Use DJ Bernstein "From " quoting/dequoting, where appliccable. -@item - Why is hide-citation-maybe and hide-citation different? Also -clear up info. -@item - group user-defined meta-parameters. - - - -From: John Griffith -@item - I like the option for trying to retrieve the FAQ for a group and I was -thinking it would be great if for those newsgroups that had archives -you could also try to read the archive for that group. Part of the -problem is that archives are spread all over the net, unlike FAQs. -What would be best I suppose is to find the one closest to your site. - -In any case, there is a list of general news group archives at -ftp://ftp.neosoft.com/pub/users/claird/news.lists/newsgroup_archives.html - - - - -@item -@example -From: Jason L Tibbitts III -(add-hook 'gnus-select-group-hook - (lambda () - (gnus-group-add-parameter group - (cons 'gnus-group-date-last-entered (list (current-time-string)))))) - -(defun gnus-user-format-function-d (headers) - "Return the date the group was last read." - (cond ((car (gnus-group-get-parameter gnus-tmp-group 'gnus-group-date-last-entered))) - (t ""))) -@end example - -@item - tanken var at når du bruker `gnus-startup-file' som prefix (FOO) til å lete -opp en fil FOO-SERVER, FOO-SERVER.el, FOO-SERVER.eld, kan du la den være en -liste hvor du bruker hvert element i listen som FOO, istedet. da kunne man -hatt forskjellige serveres startup-filer forskjellige steder. - - -@item -LMI> Well, nnbabyl could alter the group info to heed labels like -LMI> answered and read, I guess. - -It could also keep them updated (the same for the Status: header of -unix mbox files). - -They could be used like this: - - -@example -`M l RET' add label to current message. -`M u RET' remove label from current message. -`/ l RET' limit summary buffer according to . - - would be a boolean expression on the labels, e.g. - - `/ l bug & !fixed RET' -@end example - -would show all the messages which are labeled `bug' but not labeled -`fixed'. - -One could also immagine the labels being used for highliting, or -affect the summary line format. - - -@item -Sender: abraham@@dina.kvl.dk - -I'd like a gnus-find-file which work like find file, except that it -would recognize things that looks like messages or folders: - -- If it is a directory containing numbered files, create an nndir -summary buffer. - -- For other directories, create a nneething summaru buffer. - -- For files matching "\\`From ", create a nndoc/mbox summary. - -- For files matching "\\`BABYL OPTIONS:", create a nndoc/baby summary. - -- For files matching "\\`[^ \t\n]+:", create an *Article* buffer. - -- For other files, just find them normally. - -I'd like `nneething' to use this function, so it would work on a -directory potentially containing mboxes or babyl files. - -@item -Please send a mail to bwarsaw@@cnri.reston.va.us (Barry A. Warsaw) and -tell him what you are doing. - -@item -Currently, I get prompted: - -decend into sci? -- type y -decend into sci.something ? -- type n -decend into ucd? - -The problem above is that since there is really only one subsection of -science, shouldn't it prompt you for only decending sci.something? If -there was a sci.somethingelse group or section, then it should prompt -for sci? first the sci.something? then sci.somethingelse?... - -@item -Ja, det burde være en måte å si slikt. Kanskje en ny variabel? -`gnus-use-few-score-files'? Så kunne score-regler legges til den -"mest" lokale score-fila. F. eks. ville no-gruppene betjenes av -"no.all.SCORE", osv. - -@item -What i want is for Gnus to treat any sequence or combination of the following -as a single spoiler warning and hide it all, replacing it with a "Next Page" -button: - - - ^L's - - more than n blank lines - - more than m identical lines - (which should be replaced with button to show them) - - any whitespace surrounding any of the above - - -@item -Well, we could allow a new value to `gnus-thread-ignore-subject' -- -`spaces', or something. (We could even default to that.) And then -subjects that differ in white space only could be considered the -"same" subject for threading purposes. - -@item -Modes to preprocess the contents (e.g. jka-compr) use the second form -"(REGEXP FUNCTION NON-NIL)" while ordinary modes (e.g. tex) use the first -form "(REGEXP . FUNCTION)", so you could use it to distinguish between -those two types of modes. (auto-modes-alist, insert-file-contents-literally.) - -@item - Under XEmacs -- do funny article marks: -tick - thumb tack -killed - skull -soup - bowl of soup -score below - dim light bulb -score over - bright light bulb - -@item -Yes. I think the algorithm is as follows: - -@example -Group-mode - - show-list-of-articles-in-group - if (key-pressed == SPACE) - if (no-more-articles-in-group-to-select) - if (articles-selected) - start-reading-selected-articles; - junk-unread-articles; - next-group; - else - show-next-page; - - else if (key-pressed = '.') - if (consolidated-menus) # same as hide-thread in Gnus - select-thread-under-cursor; - else - select-article-under-cursor; - - -Article-mode - if (key-pressed == SPACE) - if (more-pages-in-article) - next-page; - else if (more-selected-articles-to-read) - next-article; - else - next-group; -@end example - -@item -My precise need here would have been to limit files to Incoming*. -One could think of some `nneething-only-files' variable, but I guess -it would have been unacceptable if one was using many unrelated such -nneething groups. - -A more useful approach would be to, in response to the `G D' prompt, be -allowed to say something like: `~/.mail/Incoming*', somewhat limiting -the top-level directory only (in case directories would be matched by -the wildcard expression). - -@item -It would be nice if it also handled - - - -which should correspond to `B nntp RET sunsite.auc.dk' in *Group*. - - -@item - - Take a look at w3-menu.el in the Emacs-W3 distribution - this works out -really well. Each menu is 'named' by a symbol that would be on a -gnus-*-menus (where * would be whatever, but at least group, summary, and -article versions) variable. - - So for gnus-summary-menus, I would set to '(sort mark dispose ...) - - A value of '1' would just put _all_ the menus in a single 'GNUS' menu in -the main menubar. This approach works really well for Emacs-W3 and VM. - - -@item - nndoc should take care to create unique Message-IDs for all its -articles. -@item - gnus-score-followup-article only works when you have a summary buffer -active. Make it work when posting from the group buffer as well. -(message-sent-hook). -@item - rewrite gnus-demon to use run-with-idle-timers. - -@item - * Enhancements to Gnus: - - Add two commands: - - * gnus-servers (gnus-start-server-buffer?)--enters Gnus and goes - straight to the server buffer, without opening any connections to - servers first. - - * gnus-server-read-server-newsrc--produces a buffer very similar to - the group buffer, but with only groups from that server listed; - quitting this buffer returns to the server buffer. - -@item - add a command to check the integrity of an nnfolder folder -- -go through the article numbers and see that there are no duplicates, -and stuff. - -@item - `unsmileyfy-buffer' to undo smileification. - -@item - a command to give all relevant info on an article, including all -secondary marks. - -@item - when doing `-request-accept-article', the backends should do -the nnmail duplicate checking. - -@item - allow `message-signature-file' to be a function to return the -value of the signature file. - -@item - In addition, I would love it if I could configure message-tab so that it -could call `bbdb-complete-name' in other headers. So, some sort of -interface like - -(setq message-tab-alist - '((message-header-regexp message-expand-group) - ("^\\(To\\|[cC]c\\|[bB]cc\\)" bbdb-complete-name))) - -then you could run the relevant function to complete the information in -the header - -@item - cache the newsgroups file locally to avoid reloading it all the time. - -@item - a command to import a buffer into a group. - -@item - nnweb should allow fetching by Message-ID from servers. - -@item - point in the article buffer doesn't always go to the -beginning of the buffer when selecting new articles. - -@item - a command to process mark all unread articles. - -@item - `gnus-gather-threads-by-references-and-subject' -- first -do gathering by references, and then go through the dummy roots and -do more gathering by subject. - -@item - gnus-uu-mark-in-numerical-order -- process mark articles in -article numerical order. - -@item - (gnus-thread-total-score - (gnus-id-to-thread (mail-header-id (gnus-summary-article-header)))) -bind to a key. - -@item - sorting by score is wrong when using sparse threads. - -@item - a command to fetch an arbitrary article -- without having to be -in the summary buffer. - -@item - a new nncvs backend. Each group would show an article, using -version branches as threading, checkin date as the date, etc. - -@item - http://www.dejanews.com/forms/dnsetfilter_exp.html ? -This filter allows one to construct advance queries on the Dejanews -database such as specifying start and end dates, subject, author, -and/or newsgroup name. - -@item - new Date header scoring type -- older, newer - -@item - use the summary toolbar in the article buffer. - -@item - a command to fetch all articles that are less than X days old. - -@item - in pick mode, `q' should save the list of selected articles in the -group info. The next time the group is selected, these articles -will automatically get the process mark. - -@item - Isn't it possible to (also?) allow M-^ to automatically try the -default server if it fails on the current server? (controlled by a -user variable, (nil, t, 'ask)). - -@item - make it possible to cancel articles using the select method for the -current group. - -@item - `gnus-summary-select-article-on-entry' or something. It'll default -to t and will select whatever article decided by `gnus-auto-select-first'. - -@item - a new variable to control which selection commands should be unselecting. -`first', `best', `next', `prev', `next-unread', `prev-unread' are -candidates. - -@item - be able to select groups that have no articles in them -to be able to post in them (using the current select method). - -@item - be able to post via DejaNews. - -@item - `x' should retain any sortings that have been performed. - -@item - allow the user to specify the presedence of the secondary marks. Also -allow them to be displayed separately. - -@item - gnus-summary-save-in-pipe should concatenate the results from -the processes when doing a process marked pipe. - -@item - a new match type, like Followup, but which adds Thread matches on all -articles that match a certain From header. - -@item - a function that can be read from kill-emacs-query-functions to offer -saving living summary buffers. - -@item - a function for selecting a particular group which will contain -the articles listed in a list of article numbers/id's. - -@item - a battery of character translation functions to translate common -Mac, MS (etc) characters into ISO 8859-1. - -@example -(defun article-fix-m$word () - "Fix M$Word smartquotes in an article." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (while (search-forward "\221" nil t) - (replace-match "`" t t)) - (goto-char (point-min)) - (while (search-forward "\222" nil t) - (replace-match "'" t t)) - (goto-char (point-min)) - (while (search-forward "\223" nil t) - (replace-match "\"" t t)) - (goto-char (point-min)) - (while (search-forward "\224" nil t) - (replace-match "\"" t t))))) -@end example - -@item -@example - (add-hook 'gnus-exit-query-functions -'(lambda () - (if (and (file-exists-p nnmail-spool-file) - (> (nnheader-file-size nnmail-spool-file) 0)) - (yes-or-no-p "New mail has arrived. Quit Gnus anyways? ") - (y-or-n-p "Are you sure you want to quit Gnus? ")))) -@end example - -@item - allow message-default-headers to be a function. - -@item - new Date score match types -- < > = (etc) that take floating point -numbers and match on the age of the article. - -@item - gnus-cacheable-groups - -@item -@example -> > > If so, I've got one gripe: It seems that when I fire up gnus 5.2.25 -> > > under xemacs-19.14, it's creating a new frame, but is erasing the -> > > buffer in the frame that it was called from =:-O -> -> > Hm. How do you start up Gnus? From the toolbar or with -> > `M-x gnus-other-frame'? -> -> I normally start it up from the toolbar; at -> least that's the way I've caught it doing the -> deed before. -@end example - -@item - all commands that react to the process mark should push -the current process mark set onto the stack. - -@item - gnus-article-hide-pgp -Selv ville jeg nok ha valgt å slette den dersom teksten matcher -@example -"\\(This\s+\\)?[^ ]+ has been automatically signed by" -@end example -og det er maks hundre tegn mellom match-end og ----linja. Men -det- -er min type heuristikk og langt fra alles. - -@item - `gnus-subscribe-sorted' -- insert new groups where they would have been -sorted to if `gnus-group-sort-function' were run. - -@item - gnus-(group,summary)-highlight should respect any `face' text props set -on the lines. - -@item - use run-with-idle-timer for gnus-demon instead of the -home-brewed stuff for better reliability. - -@item - add a way to select which NoCeM type to apply -- spam, troll, etc. - -@item - nndraft-request-group should tally autosave files. - -@item - implement nntp-retry-on-break and nntp-command-timeout. - -@item - gnus-article-highlight-limit that says when not to highlight (long) -articles. - -@item - (nnoo-set SERVER VARIABLE VALUE) - -@item - nn*-spool-methods - -@item - interrupitng agent fetching of articles should save articles. - -@item - command to open a digest group, and copy all the articles there to the -current group. - -@item - a variable to disable article body highlights if there's more than -X characters in the body. - -@item - handle 480/381 authinfo requests separately. - -@item - include the texi/dir file in the distribution. - -@item - format spec to "tab" to a position. - -@item - Move all prompting to the new `M-n' default style. - -@item - command to display all dormant articles. - -@item - gnus-auto-select-next makeover -- list of things it should do. - -@item - a score match type that adds scores matching on From if From has replied -to something someone else has said. - -@item - Read Netscape discussion groups: -snews://secnews.netscape.com/netscape.communicator.unix - -@item -One command to edit the original version if an article, and one to edit -the displayed version. - -@item -@kbd{T v} -- make all process-marked articles the children of the -current article. - -@item -Switch from initial text to the new default text mechanism. - -@item -How about making it possible to expire local articles? Will it be -possible to make various constraints on when an article can be -expired, e.g. (read), (age > 14 days), or the more interesting (read -& age > 14 days)? - -@item -New limit command---limit to articles that have a certain string -in the head or body. - -@item -Solve the halting problem. - -@c TODO -@end itemize - -@iftex - -@page -@node The Manual -@section The Manual -@cindex colophon -@cindex manual - -This manual was generated from a TeXinfo file and then run through -either @code{texi2dvi} -@iflatex -or my own home-brewed TeXinfo to \LaTeX\ transformer, -and then run through @code{latex} and @code{dvips} -@end iflatex -to get what you hold in your hands now. - -The following conventions have been used: - -@enumerate - -@item -This is a @samp{string} - -@item -This is a @kbd{keystroke} - -@item -This is a @file{file} - -@item -This is a @code{symbol} - -@end enumerate - -So if I were to say ``set @code{flargnoze} to @samp{yes}'', that would -mean: - -@lisp -(setq flargnoze "yes") -@end lisp - -If I say ``set @code{flumphel} to @code{yes}'', that would mean: - -@lisp -(setq flumphel 'yes) -@end lisp - -@samp{yes} and @code{yes} are two @emph{very} different things---don't -ever get them confused. - -@iflatex -@c @head -Of course, everything in this manual is of vital interest, so you should -read it all. Several times. However, if you feel like skimming the -manual, look for that gnu head you should see in the margin over -there---it means that what's being discussed is of more importance than -the rest of the stuff. (On the other hand, if everything is infinitely -important, how can anything be more important than that? Just one more -of the mysteries of this world, I guess.) -@end iflatex - -@end iftex - - -@page -@node Terminology -@section Terminology - -@cindex terminology -@table @dfn - -@item news -@cindex news -This is what you are supposed to use this thing for---reading news. -News is generally fetched from a nearby @sc{nntp} server, and is -generally publicly available to everybody. If you post news, the entire -world is likely to read just what you have written, and they'll all -snigger mischievously. Behind your back. - -@item mail -@cindex mail -Everything that's delivered to you personally is mail. Some news/mail -readers (like Gnus) blur the distinction between mail and news, but -there is a difference. Mail is private. News is public. Mailing is -not posting, and replying is not following up. - -@item reply -@cindex reply -Send a mail to the person who has written what you are reading. - -@item follow up -@cindex follow up -Post an article to the current newsgroup responding to the article you -are reading. - -@item backend -@cindex backend -Gnus gets fed articles from a number of backends, both news and mail -backends. Gnus does not handle the underlying media, so to speak---this -is all done by the backends. - -@item native -@cindex native -Gnus will always use one method (and backend) as the @dfn{native}, or -default, way of getting news. - -@item foreign -@cindex foreign -You can also have any number of foreign groups active at the same time. -These are groups that use non-native non-secondary backends for getting -news. - -@item secondary -@cindex secondary -Secondary backends are somewhere half-way between being native and being -foreign, but they mostly act like they are native. - -@item article -@cindex article -A message that has been posted as news. - -@item mail message -@cindex mail message -A message that has been mailed. - -@item message -@cindex message -A mail message or news article - -@item head -@cindex head -The top part of a message, where administrative information (etc.) is -put. - -@item body -@cindex body -The rest of an article. Everything not in the head is in the -body. - -@item header -@cindex header -A line from the head of an article. - -@item headers -@cindex headers -A collection of such lines, or a collection of heads. Or even a -collection of @sc{nov} lines. - -@item @sc{nov} -@cindex nov -When Gnus enters a group, it asks the backend for the headers of all -unread articles in the group. Most servers support the News OverView -format, which is more compact and much faster to read and parse than the -normal @sc{head} format. - -@item level -@cindex levels -Each group is subscribed at some @dfn{level} or other (1-9). The ones -that have a lower level are ``more'' subscribed than the groups with a -higher level. In fact, groups on levels 1-5 are considered -@dfn{subscribed}; 6-7 are @dfn{unsubscribed}; 8 are @dfn{zombies}; and 9 -are @dfn{killed}. Commands for listing groups and scanning for new -articles will all use the numeric prefix as @dfn{working level}. - -@item killed groups -@cindex killed groups -No information on killed groups is stored or updated, which makes killed -groups much easier to handle than subscribed groups. - -@item zombie groups -@cindex zombie groups -Just like killed groups, only slightly less dead. - -@item active file -@cindex active file -The news server has to keep track of what articles it carries, and what -groups exist. All this information in stored in the active file, which -is rather large, as you might surmise. - -@item bogus groups -@cindex bogus groups -A group that exists in the @file{.newsrc} file, but isn't known to the -server (i.e., it isn't in the active file), is a @emph{bogus group}. -This means that the group probably doesn't exist (any more). - -@item activating -@cindex activating groups -The act of asking the server for info on a group and computing the -number of unread articles is called @dfn{activating the group}. -Un-activated groups are listed with @samp{*} in the group buffer. - -@item server -@cindex server -A machine one can connect to and get news (or mail) from. - -@item select method -@cindex select method -A structure that specifies the backend, the server and the virtual -server settings. - -@item virtual server -@cindex virtual server -A named select method. Since a select method defines all there is to -know about connecting to a (physical) server, taking the thing as a -whole is a virtual server. - -@item washing -@cindex washing -Taking a buffer and running it through a filter of some sort. The -result will (more often than not) be cleaner and more pleasing than the -original. - -@item ephemeral groups -@cindex ephemeral groups -Most groups store data on what articles you have read. @dfn{Ephemeral} -groups are groups that will have no data stored---when you exit the -group, it'll disappear into the aether. - -@item solid groups -@cindex solid groups -This is the opposite of ephemeral groups. All groups listed in the -group buffer are solid groups. - -@item sparse articles -@cindex sparse articles -These are article placeholders shown in the summary buffer when -@code{gnus-build-sparse-threads} has been switched on. - -@item threading -@cindex threading -To put responses to articles directly after the articles they respond -to---in a hierarchical fashion. - -@item root -@cindex root -@cindex thread root -The first article in a thread is the root. It is the ancestor of all -articles in the thread. - -@item parent -@cindex parent -An article that has responses. - -@item child -@cindex child -An article that responds to a different article---its parent. - -@item digest -@cindex digest -A collection of messages in one file. The most common digest format is -specified by RFC1153. - -@end table - - -@page -@node Customization -@section Customization -@cindex general customization - -All variables are properly documented elsewhere in this manual. This -section is designed to give general pointers on how to customize Gnus -for some quite common situations. - -@menu -* Slow/Expensive Connection:: You run a local Emacs and get the news elsewhere. -* Slow Terminal Connection:: You run a remote Emacs. -* Little Disk Space:: You feel that having large setup files is icky. -* Slow Machine:: You feel like buying a faster machine. -@end menu - - -@node Slow/Expensive Connection -@subsection Slow/Expensive @sc{nntp} Connection - -If you run Emacs on a machine locally, and get your news from a machine -over some very thin strings, you want to cut down on the amount of data -Gnus has to get from the @sc{nntp} server. - -@table @code - -@item gnus-read-active-file -Set this to @code{nil}, which will inhibit Gnus from requesting the -entire active file from the server. This file is often v. large. You -also have to set @code{gnus-check-new-newsgroups} and -@code{gnus-check-bogus-newsgroups} to @code{nil} to make sure that Gnus -doesn't suddenly decide to fetch the active file anyway. - -@item gnus-nov-is-evil -This one has to be @code{nil}. If not, grabbing article headers from -the @sc{nntp} server will not be very fast. Not all @sc{nntp} servers -support @sc{xover}; Gnus will detect this by itself. -@end table - - -@node Slow Terminal Connection -@subsection Slow Terminal Connection - -Let's say you use your home computer for dialing up the system that runs -Emacs and Gnus. If your modem is slow, you want to reduce (as much as -possible) the amount of data sent over the wires. - -@table @code - -@item gnus-auto-center-summary -Set this to @code{nil} to inhibit Gnus from re-centering the summary -buffer all the time. If it is @code{vertical}, do only vertical -re-centering. If it is neither @code{nil} nor @code{vertical}, do both -horizontal and vertical recentering. - -@item gnus-visible-headers -Cut down on the headers included in the articles to the -minimum. You can, in fact, make do without them altogether---most of the -useful data is in the summary buffer, anyway. Set this variable to -@samp{^NEVVVVER} or @samp{From:}, or whatever you feel you need. - -@item gnus-article-display-hook -Set this hook to all the available hiding commands: -@lisp -(setq gnus-article-display-hook - '(gnus-article-hide-headers gnus-article-hide-signature - gnus-article-hide-citation)) -@end lisp - -@item gnus-use-full-window -By setting this to @code{nil}, you can make all the windows smaller. -While this doesn't really cut down much generally, it means that you -have to see smaller portions of articles before deciding that you didn't -want to read them anyway. - -@item gnus-thread-hide-subtree -If this is non-@code{nil}, all threads in the summary buffer will be -hidden initially. - -@item gnus-updated-mode-lines -If this is @code{nil}, Gnus will not put information in the buffer mode -lines, which might save some time. -@end table - - -@node Little Disk Space -@subsection Little Disk Space -@cindex disk space - -The startup files can get rather large, so you may want to cut their -sizes a bit if you are running out of space. - -@table @code - -@item gnus-save-newsrc-file -If this is @code{nil}, Gnus will never save @file{.newsrc}---it will -only save @file{.newsrc.eld}. This means that you will not be able to -use any other newsreaders than Gnus. This variable is @code{t} by -default. - -@item gnus-save-killed-list -If this is @code{nil}, Gnus will not save the list of dead groups. You -should also set @code{gnus-check-new-newsgroups} to @code{ask-server} -and @code{gnus-check-bogus-newsgroups} to @code{nil} if you set this -variable to @code{nil}. This variable is @code{t} by default. - -@end table - - -@node Slow Machine -@subsection Slow Machine -@cindex slow machine - -If you have a slow machine, or are just really impatient, there are a -few things you can do to make Gnus run faster. - -Set @code{gnus-check-new-newsgroups} and -@code{gnus-check-bogus-newsgroups} to @code{nil} to make startup faster. - -Set @code{gnus-show-threads}, @code{gnus-use-cross-reference} and -@code{gnus-nov-is-evil} to @code{nil} to make entering and exiting the -summary buffer faster. - -Set @code{gnus-article-display-hook} to @code{nil} to make article -processing a bit faster. - - -@page -@node Troubleshooting -@section Troubleshooting -@cindex troubleshooting - -Gnus works @emph{so} well straight out of the box---I can't imagine any -problems, really. - -Ahem. - -@enumerate - -@item -Make sure your computer is switched on. - -@item -Make sure that you really load the current Gnus version. If you have -been running @sc{gnus}, you need to exit Emacs and start it up again before -Gnus will work. - -@item -Try doing an @kbd{M-x gnus-version}. If you get something that looks -like @samp{Gnus v5.46; nntp 4.0} you have the right files loaded. If, -on the other hand, you get something like @samp{NNTP 3.x} or @samp{nntp -flee}, you have some old @file{.el} files lying around. Delete these. - -@item -Read the help group (@kbd{G h} in the group buffer) for a FAQ and a -how-to. - -@item -@vindex max-lisp-eval-depth -Gnus works on many recursive structures, and in some extreme (and very -rare) cases Gnus may recurse down ``too deeply'' and Emacs will beep at -you. If this happens to you, set @code{max-lisp-eval-depth} to 500 or -something like that. -@end enumerate - -If all else fails, report the problem as a bug. - -@cindex bugs -@cindex reporting bugs - -@kindex M-x gnus-bug -@findex gnus-bug -If you find a bug in Gnus, you can report it with the @kbd{M-x gnus-bug} -command. @kbd{M-x set-variable RET debug-on-error RET t RET}, and send -me the backtrace. I will fix bugs, but I can only fix them if you send -me a precise description as to how to reproduce the bug. - -You really can never be too detailed in a bug report. Always use the -@kbd{M-x gnus-bug} command when you make bug reports, even if it creates -a 10Kb mail each time you use it, and even if you have sent me your -environment 500 times before. I don't care. I want the full info each -time. - -It is also important to remember that I have no memory whatsoever. If -you send a bug report, and I send you a reply, and then you just send -back ``No, it's not! Moron!'', I will have no idea what you are -insulting me about. Always over-explain everything. It's much easier -for all of us---if I don't have all the information I need, I will just -mail you and ask for more info, and everything takes more time. - -If the problem you're seeing is very visual, and you can't quite explain -it, copy the Emacs window to a file (with @code{xwd}, for instance), put -it somewhere it can be reached, and include the URL of the picture in -the bug report. - -If you just need help, you are better off asking on -@samp{gnu.emacs.gnus}. I'm not very helpful. - -@cindex gnu.emacs.gnus -@cindex ding mailing list -You can also ask on the ding mailing list---@samp{ding@@gnus.org}. -Write to @samp{ding-request@@gnus.org} to subscribe. - - -@page -@node A Programmers Guide to Gnus -@section A Programmer@'s Guide to Gnus - -It is my hope that other people will figure out smart stuff that Gnus -can do, and that other people will write those smart things as well. To -facilitate that I thought it would be a good idea to describe the inner -workings of Gnus. And some of the not-so-inner workings, while I'm at -it. - -You can never expect the internals of a program not to change, but I -will be defining (in some details) the interface between Gnus and its -backends (this is written in stone), the format of the score files -(ditto), data structures (some are less likely to change than others) -and general methods of operation. - -@menu -* Gnus Utility Functions:: Common functions and variable to use. -* Backend Interface:: How Gnus communicates with the servers. -* Score File Syntax:: A BNF definition of the score file standard. -* Headers:: How Gnus stores headers internally. -* Ranges:: A handy format for storing mucho numbers. -* Group Info:: The group info format. -* Extended Interactive:: Symbolic prefixes and stuff. -* Emacs/XEmacs Code:: Gnus can be run under all modern Emacsen. -* Various File Formats:: Formats of files that Gnus use. -@end menu - - -@node Gnus Utility Functions -@subsection Gnus Utility Functions -@cindex Gnus utility functions -@cindex utility functions -@cindex functions -@cindex internal variables - -When writing small functions to be run from hooks (and stuff), it's -vital to have access to the Gnus internal functions and variables. -Below is a list of the most common ones. - -@table @code - -@item gnus-newsgroup-name -@vindex gnus-newsgroup-name -This variable holds the name of the current newsgroup. - -@item gnus-find-method-for-group -@findex gnus-find-method-for-group -A function that returns the select method for @var{group}. - -@item gnus-group-real-name -@findex gnus-group-real-name -Takes a full (prefixed) Gnus group name, and returns the unprefixed -name. - -@item gnus-group-prefixed-name -@findex gnus-group-prefixed-name -Takes an unprefixed group name and a select method, and returns the full -(prefixed) Gnus group name. - -@item gnus-get-info -@findex gnus-get-info -Returns the group info list for @var{group}. - -@item gnus-add-current-to-buffer-list -@findex gnus-add-current-to-buffer-list -Adds the current buffer to the list of buffers to be killed on Gnus -exit. - -@item gnus-continuum-version -@findex gnus-continuum-version -Takes a Gnus version string as a parameter and returns a floating point -number. Earlier versions will always get a lower number than later -versions. - -@item gnus-group-read-only-p -@findex gnus-group-read-only-p -Says whether @var{group} is read-only or not. - -@item gnus-news-group-p -@findex gnus-news-group-p -Says whether @var{group} came from a news backend. - -@item gnus-ephemeral-group-p -@findex gnus-ephemeral-group-p -Says whether @var{group} is ephemeral or not. - -@item gnus-server-to-method -@findex gnus-server-to-method -Returns the select method corresponding to @var{server}. - -@item gnus-server-equal -@findex gnus-server-equal -Says whether two virtual servers are equal. - -@item gnus-group-native-p -@findex gnus-group-native-p -Says whether @var{group} is native or not. - -@item gnus-group-secondary-p -@findex gnus-group-secondary-p -Says whether @var{group} is secondary or not. - -@item gnus-group-foreign-p -@findex gnus-group-foreign-p -Says whether @var{group} is foreign or not. - -@item group-group-find-parameter -@findex group-group-find-parameter -Returns the parameter list of @var{group}. If given a second parameter, -returns the value of that parameter for @var{group}. - -@item gnus-group-set-parameter -@findex gnus-group-set-parameter -Takes three parameters; @var{group}, @var{parameter} and @var{value}. - -@item gnus-narrow-to-body -@findex gnus-narrow-to-body -Narrows the current buffer to the body of the article. - -@item gnus-check-backend-function -@findex gnus-check-backend-function -Takes two parameters, @var{function} and @var{group}. If the backend -@var{group} comes from supports @var{function}, return non-@code{nil}. - -@lisp -(gnus-check-backend-function "request-scan" "nnml:misc") -=> t -@end lisp - -@item gnus-read-method -@findex gnus-read-method -Prompts the user for a select method. - -@end table - - -@node Backend Interface -@subsection Backend Interface - -Gnus doesn't know anything about @sc{nntp}, spools, mail or virtual -groups. It only knows how to talk to @dfn{virtual servers}. A virtual -server is a @dfn{backend} and some @dfn{backend variables}. As examples -of the first, we have @code{nntp}, @code{nnspool} and @code{nnmbox}. As -examples of the latter we have @code{nntp-port-number} and -@code{nnmbox-directory}. - -When Gnus asks for information from a backend---say @code{nntp}---on -something, it will normally include a virtual server name in the -function parameters. (If not, the backend should use the ``current'' -virtual server.) For instance, @code{nntp-request-list} takes a virtual -server as its only (optional) parameter. If this virtual server hasn't -been opened, the function should fail. - -Note that a virtual server name has no relation to some physical server -name. Take this example: - -@lisp -(nntp "odd-one" - (nntp-address "ifi.uio.no") - (nntp-port-number 4324)) -@end lisp - -Here the virtual server name is @samp{odd-one} while the name of -the physical server is @samp{ifi.uio.no}. - -The backends should be able to switch between several virtual servers. -The standard backends implement this by keeping an alist of virtual -server environments that they pull down/push up when needed. - -There are two groups of interface functions: @dfn{required functions}, -which must be present, and @dfn{optional functions}, which Gnus will -always check for presence before attempting to call 'em. - -All these functions are expected to return data in the buffer -@code{nntp-server-buffer} (@samp{ *nntpd*}), which is somewhat -unfortunately named, but we'll have to live with it. When I talk about -@dfn{resulting data}, I always refer to the data in that buffer. When I -talk about @dfn{return value}, I talk about the function value returned by -the function call. Functions that fail should return @code{nil} as the -return value. - -Some backends could be said to be @dfn{server-forming} backends, and -some might be said not to be. The latter are backends that generally -only operate on one group at a time, and have no concept of ``server'' --- they have a group, and they deliver info on that group and nothing -more. - -In the examples and definitions I will refer to the imaginary backend -@code{nnchoke}. - -@cindex @code{nnchoke} - -@menu -* Required Backend Functions:: Functions that must be implemented. -* Optional Backend Functions:: Functions that need not be implemented. -* Error Messaging:: How to get messages and report errors. -* Writing New Backends:: Extending old backends. -* Hooking New Backends Into Gnus:: What has to be done on the Gnus end. -* Mail-like Backends:: Some tips on mail backends. -@end menu - - -@node Required Backend Functions -@subsubsection Required Backend Functions - -@table @code - -@item (nnchoke-retrieve-headers ARTICLES &optional GROUP SERVER FETCH-OLD) - -@var{articles} is either a range of article numbers or a list of -@code{Message-ID}s. Current backends do not fully support either---only -sequences (lists) of article numbers, and most backends do not support -retrieval of @code{Message-ID}s. But they should try for both. - -The result data should either be HEADs or NOV lines, and the result -value should either be @code{headers} or @code{nov} to reflect this. -This might later be expanded to @code{various}, which will be a mixture -of HEADs and NOV lines, but this is currently not supported by Gnus. - -If @var{fetch-old} is non-@code{nil} it says to try fetching "extra -headers", in some meaning of the word. This is generally done by -fetching (at most) @var{fetch-old} extra headers less than the smallest -article number in @code{articles}, and filling the gaps as well. The -presence of this parameter can be ignored if the backend finds it -cumbersome to follow the request. If this is non-@code{nil} and not a -number, do maximum fetches. - -Here's an example HEAD: - -@example -221 1056 Article retrieved. -Path: ifi.uio.no!sturles -From: sturles@@ifi.uio.no (Sturle Sunde) -Newsgroups: ifi.discussion -Subject: Re: Something very droll -Date: 27 Oct 1994 14:02:57 +0100 -Organization: Dept. of Informatics, University of Oslo, Norway -Lines: 26 -Message-ID: <38o8e1$a0o@@holmenkollen.ifi.uio.no> -References: <38jdmq$4qu@@visbur.ifi.uio.no> -NNTP-Posting-Host: holmenkollen.ifi.uio.no -. -@end example - -So a @code{headers} return value would imply that there's a number of -these in the data buffer. - -Here's a BNF definition of such a buffer: - -@example -headers = *head -head = error / valid-head -error-message = [ "4" / "5" ] 2number " " eol -valid-head = valid-message *header "." eol -valid-message = "221 " " Article retrieved." eol -header = eol -@end example - -If the return value is @code{nov}, the data buffer should contain -@dfn{network overview database} lines. These are basically fields -separated by tabs. - -@example -nov-buffer = *nov-line -nov-line = 8*9 [ field ] eol -field = -@end example - -For a closer look at what should be in those fields, -@pxref{Headers}. - - -@item (nnchoke-open-server SERVER &optional DEFINITIONS) - -@var{server} is here the virtual server name. @var{definitions} is a -list of @code{(VARIABLE VALUE)} pairs that define this virtual server. - -If the server can't be opened, no error should be signaled. The backend -may then choose to refuse further attempts at connecting to this -server. In fact, it should do so. - -If the server is opened already, this function should return a -non-@code{nil} value. There should be no data returned. - - -@item (nnchoke-close-server &optional SERVER) - -Close connection to @var{server} and free all resources connected -to it. Return @code{nil} if the server couldn't be closed for some -reason. - -There should be no data returned. - - -@item (nnchoke-request-close) - -Close connection to all servers and free all resources that the backend -have reserved. All buffers that have been created by that backend -should be killed. (Not the @code{nntp-server-buffer}, though.) This -function is generally only called when Gnus is shutting down. - -There should be no data returned. - - -@item (nnchoke-server-opened &optional SERVER) - -If @var{server} is the current virtual server, and the connection to the -physical server is alive, then this function should return a -non-@code{nil} vlue. This function should under no circumstances -attempt to reconnect to a server we have lost connection to. - -There should be no data returned. - - -@item (nnchoke-status-message &optional SERVER) - -This function should return the last error message from @var{server}. - -There should be no data returned. - - -@item (nnchoke-request-article ARTICLE &optional GROUP SERVER TO-BUFFER) - -The result data from this function should be the article specified by -@var{article}. This might either be a @code{Message-ID} or a number. -It is optional whether to implement retrieval by @code{Message-ID}, but -it would be nice if that were possible. - -If @var{to-buffer} is non-@code{nil}, the result data should be returned -in this buffer instead of the normal data buffer. This is to make it -possible to avoid copying large amounts of data from one buffer to -another, while Gnus mainly requests articles to be inserted directly -into its article buffer. - -If it is at all possible, this function should return a cons cell where -the @code{car} is the group name the article was fetched from, and the @code{cdr} is -the article number. This will enable Gnus to find out what the real -group and article numbers are when fetching articles by -@code{Message-ID}. If this isn't possible, @code{t} should be returned -on successful article retrieval. - - -@item (nnchoke-request-group GROUP &optional SERVER FAST) - -Get data on @var{group}. This function also has the side effect of -making @var{group} the current group. - -If @var{FAST}, don't bother to return useful data, just make @var{group} -the current group. - -Here's an example of some result data and a definition of the same: - -@example -211 56 1000 1059 ifi.discussion -@end example - -The first number is the status, which should be 211. Next is the -total number of articles in the group, the lowest article number, the -highest article number, and finally the group name. Note that the total -number of articles may be less than one might think while just -considering the highest and lowest article numbers, but some articles -may have been canceled. Gnus just discards the total-number, so -whether one should take the bother to generate it properly (if that is a -problem) is left as an exercise to the reader. - -@example -group-status = [ error / info ] eol -error = [ "4" / "5" ] 2 " " -info = "211 " 3* [ " " ] -@end example - - -@item (nnchoke-close-group GROUP &optional SERVER) - -Close @var{group} and free any resources connected to it. This will be -a no-op on most backends. - -There should be no data returned. - - -@item (nnchoke-request-list &optional SERVER) - -Return a list of all groups available on @var{server}. And that means -@emph{all}. - -Here's an example from a server that only carries two groups: - -@example -ifi.test 0000002200 0000002000 y -ifi.discussion 3324 3300 n -@end example - -On each line we have a group name, then the highest article number in -that group, the lowest article number, and finally a flag. - -@example -active-file = *active-line -active-line = name " " " " " " flags eol -name = -flags = "n" / "y" / "m" / "x" / "j" / "=" name -@end example - -The flag says whether the group is read-only (@samp{n}), is moderated -(@samp{m}), is dead (@samp{x}), is aliased to some other group -(@samp{=other-group}) or none of the above (@samp{y}). - - -@item (nnchoke-request-post &optional SERVER) - -This function should post the current buffer. It might return whether -the posting was successful or not, but that's not required. If, for -instance, the posting is done asynchronously, it has generally not been -completed by the time this function concludes. In that case, this -function should set up some kind of sentinel to beep the user loud and -clear if the posting could not be completed. - -There should be no result data from this function. - -@end table - - -@node Optional Backend Functions -@subsubsection Optional Backend Functions - -@table @code - -@item (nnchoke-retrieve-groups GROUPS &optional SERVER) - -@var{groups} is a list of groups, and this function should request data -on all those groups. How it does it is of no concern to Gnus, but it -should attempt to do this in a speedy fashion. - -The return value of this function can be either @code{active} or -@code{group}, which says what the format of the result data is. The -former is in the same format as the data from -@code{nnchoke-request-list}, while the latter is a buffer full of lines -in the same format as @code{nnchoke-request-group} gives. - -@example -group-buffer = *active-line / *group-status -@end example - - -@item (nnchoke-request-update-info GROUP INFO &optional SERVER) - -A Gnus group info (@pxref{Group Info}) is handed to the backend for -alterations. This comes in handy if the backend really carries all the -information (as is the case with virtual and imap groups). This -function should destructively alter the info to suit its needs, and -should return the (altered) group info. - -There should be no result data from this function. - - -@item (nnchoke-request-type GROUP &optional ARTICLE) - -When the user issues commands for ``sending news'' (@kbd{F} in the -summary buffer, for instance), Gnus has to know whether the article the -user is following up on is news or mail. This function should return -@code{news} if @var{article} in @var{group} is news, @code{mail} if it -is mail and @code{unknown} if the type can't be decided. (The -@var{article} parameter is necessary in @code{nnvirtual} groups which -might very well combine mail groups and news groups.) Both @var{group} -and @var{article} may be @code{nil}. - -There should be no result data from this function. - - -@item (nnchoke-request-update-mark GROUP ARTICLE MARK) - -If the user tries to set a mark that the backend doesn't like, this -function may change the mark. Gnus will use whatever this function -returns as the mark for @var{article} instead of the original -@var{mark}. If the backend doesn't care, it must return the original -@var{mark}, and not @code{nil} or any other type of garbage. - -The only use for this I can see is what @code{nnvirtual} does with -it---if a component group is auto-expirable, marking an article as read -in the virtual group should result in the article being marked as -expirable. - -There should be no result data from this function. - - -@item (nnchoke-request-scan &optional GROUP SERVER) - -This function may be called at any time (by Gnus or anything else) to -request that the backend check for incoming articles, in one way or -another. A mail backend will typically read the spool file or query the -POP server when this function is invoked. The @var{group} doesn't have -to be heeded---if the backend decides that it is too much work just -scanning for a single group, it may do a total scan of all groups. It -would be nice, however, to keep things local if that's practical. - -There should be no result data from this function. - - -@item (nnchoke-request-group-description GROUP &optional SERVER) - -The result data from this function should be a description of -@var{group}. - -@example -description-line = name description eol -name = -description = -@end example - -@item (nnchoke-request-list-newsgroups &optional SERVER) - -The result data from this function should be the description of all -groups available on the server. - -@example -description-buffer = *description-line -@end example - - -@item (nnchoke-request-newgroups DATE &optional SERVER) - -The result data from this function should be all groups that were -created after @samp{date}, which is in normal human-readable date -format. The data should be in the active buffer format. - - -@item (nnchoke-request-create-group GROUP &optional SERVER) - -This function should create an empty group with name @var{group}. - -There should be no return data. - - -@item (nnchoke-request-expire-articles ARTICLES &optional GROUP SERVER FORCE) - -This function should run the expiry process on all articles in the -@var{articles} range (which is currently a simple list of article -numbers.) It is left up to the backend to decide how old articles -should be before they are removed by this function. If @var{force} is -non-@code{nil}, all @var{articles} should be deleted, no matter how new -they are. - -This function should return a list of articles that it did not/was not -able to delete. - -There should be no result data returned. - - -@item (nnchoke-request-move-article ARTICLE GROUP SERVER ACCEPT-FORM -&optional LAST) - -This function should move @var{article} (which is a number) from -@var{group} by calling @var{accept-form}. - -This function should ready the article in question for moving by -removing any header lines it has added to the article, and generally -should ``tidy up'' the article. Then it should @code{eval} -@var{accept-form} in the buffer where the ``tidy'' article is. This -will do the actual copying. If this @code{eval} returns a -non-@code{nil} value, the article should be removed. - -If @var{last} is @code{nil}, that means that there is a high likelihood -that there will be more requests issued shortly, so that allows some -optimizations. - -The function should return a cons where the @code{car} is the group name and -the @code{cdr} is the article number that the article was entered as. - -There should be no data returned. - - -@item (nnchoke-request-accept-article GROUP &optional SERVER LAST) - -This function takes the current buffer and inserts it into @var{group}. -If @var{last} in @code{nil}, that means that there will be more calls to -this function in short order. - -The function should return a cons where the @code{car} is the group name and -the @code{cdr} is the article number that the article was entered as. - -There should be no data returned. - - -@item (nnchoke-request-replace-article ARTICLE GROUP BUFFER) - -This function should remove @var{article} (which is a number) from -@var{group} and insert @var{buffer} there instead. - -There should be no data returned. - - -@item (nnchoke-request-delete-group GROUP FORCE &optional SERVER) - -This function should delete @var{group}. If @var{force}, it should -really delete all the articles in the group, and then delete the group -itself. (If there is such a thing as ``the group itself''.) - -There should be no data returned. - - -@item (nnchoke-request-rename-group GROUP NEW-NAME &optional SERVER) - -This function should rename @var{group} into @var{new-name}. All -articles in @var{group} should move to @var{new-name}. - -There should be no data returned. - -@end table - - -@node Error Messaging -@subsubsection Error Messaging - -@findex nnheader-report -@findex nnheader-get-report -The backends should use the function @code{nnheader-report} to report -error conditions---they should not raise errors when they aren't able to -perform a request. The first argument to this function is the backend -symbol, and the rest are interpreted as arguments to @code{format} if -there are multiple of them, or just a string if there is one of them. -This function must always returns @code{nil}. - -@lisp -(nnheader-report 'nnchoke "You did something totally bogus") - -(nnheader-report 'nnchoke "Could not request group %s" group) -@end lisp - -Gnus, in turn, will call @code{nnheader-get-report} when it gets a -@code{nil} back from a server, and this function returns the most -recently reported message for the backend in question. This function -takes one argument---the server symbol. - -Internally, these functions access @var{backend}@code{-status-string}, -so the @code{nnchoke} backend will have its error message stored in -@code{nnchoke-status-string}. - - -@node Writing New Backends -@subsubsection Writing New Backends - -Many backends are quite similar. @code{nnml} is just like -@code{nnspool}, but it allows you to edit the articles on the server. -@code{nnmh} is just like @code{nnml}, but it doesn't use an active file, -and it doesn't maintain overview databases. @code{nndir} is just like -@code{nnml}, but it has no concept of ``groups'', and it doesn't allow -editing articles. - -It would make sense if it were possible to ``inherit'' functions from -backends when writing new backends. And, indeed, you can do that if you -want to. (You don't have to if you don't want to, of course.) - -All the backends declare their public variables and functions by using a -package called @code{nnoo}. - -To inherit functions from other backends (and allow other backends to -inherit functions from the current backend), you should use the -following macros: - -@table @code - -@item nnoo-declare -This macro declares the first parameter to be a child of the subsequent -parameters. For instance: - -@lisp -(nnoo-declare nndir - nnml nnmh) -@end lisp - -@code{nndir} has declared here that it intends to inherit functions from -both @code{nnml} and @code{nnmh}. - -@item defvoo -This macro is equivalent to @code{defvar}, but registers the variable as -a public server variable. Most state-oriented variables should be -declared with @code{defvoo} instead of @code{defvar}. - -In addition to the normal @code{defvar} parameters, it takes a list of -variables in the parent backends to map the variable to when executing -a function in those backends. - -@lisp -(defvoo nndir-directory nil - "Where nndir will look for groups." - nnml-current-directory nnmh-current-directory) -@end lisp - -This means that @code{nnml-current-directory} will be set to -@code{nndir-directory} when an @code{nnml} function is called on behalf -of @code{nndir}. (The same with @code{nnmh}.) - -@item nnoo-define-basics -This macro defines some common functions that almost all backends should -have. - -@example -(nnoo-define-basics nndir) -@end example - -@item deffoo -This macro is just like @code{defun} and takes the same parameters. In -addition to doing the normal @code{defun} things, it registers the -function as being public so that other backends can inherit it. - -@item nnoo-map-functions -This macro allows mapping of functions from the current backend to -functions from the parent backends. - -@example -(nnoo-map-functions nndir - (nnml-retrieve-headers 0 nndir-current-group 0 0) - (nnmh-request-article 0 nndir-current-group 0 0)) -@end example - -This means that when @code{nndir-retrieve-headers} is called, the first, -third, and fourth parameters will be passed on to -@code{nnml-retrieve-headers}, while the second parameter is set to the -value of @code{nndir-current-group}. - -@item nnoo-import -This macro allows importing functions from backends. It should be the -last thing in the source file, since it will only define functions that -haven't already been defined. - -@example -(nnoo-import nndir - (nnmh - nnmh-request-list - nnmh-request-newgroups) - (nnml)) -@end example - -This means that calls to @code{nndir-request-list} should just be passed -on to @code{nnmh-request-list}, while all public functions from -@code{nnml} that haven't been defined in @code{nndir} yet should be -defined now. - -@end table - -Below is a slightly shortened version of the @code{nndir} backend. - -@lisp -;;; nndir.el --- single directory newsgroup access for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;;; Code: - -(require 'nnheader) -(require 'nnmh) -(require 'nnml) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nndir - nnml nnmh) - -(defvoo nndir-directory nil - "Where nndir will look for groups." - nnml-current-directory nnmh-current-directory) - -(defvoo nndir-nov-is-evil nil - "*Non-nil means that nndir will never retrieve NOV headers." - nnml-nov-is-evil) - -(defvoo nndir-current-group "" nil nnml-current-group nnmh-current-group) -(defvoo nndir-top-directory nil nil nnml-directory nnmh-directory) -(defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail) - -(defvoo nndir-status-string "" nil nnmh-status-string) -(defconst nndir-version "nndir 1.0") - -;;; Interface functions. - -(nnoo-define-basics nndir) - -(deffoo nndir-open-server (server &optional defs) - (setq nndir-directory - (or (cadr (assq 'nndir-directory defs)) - server)) - (unless (assq 'nndir-directory defs) - (push `(nndir-directory ,server) defs)) - (push `(nndir-current-group - ,(file-name-nondirectory (directory-file-name nndir-directory))) - defs) - (push `(nndir-top-directory - ,(file-name-directory (directory-file-name nndir-directory))) - defs) - (nnoo-change-server 'nndir server defs)) - -(nnoo-map-functions nndir - (nnml-retrieve-headers 0 nndir-current-group 0 0) - (nnmh-request-article 0 nndir-current-group 0 0) - (nnmh-request-group nndir-current-group 0 0) - (nnmh-close-group nndir-current-group 0)) - -(nnoo-import nndir - (nnmh - nnmh-status-message - nnmh-request-list - nnmh-request-newgroups)) - -(provide 'nndir) -@end lisp - - -@node Hooking New Backends Into Gnus -@subsubsection Hooking New Backends Into Gnus - -@vindex gnus-valid-select-methods -Having Gnus start using your new backend is rather easy---you just -declare it with the @code{gnus-declare-backend} functions. This will -enter the backend into the @code{gnus-valid-select-methods} variable. - -@code{gnus-declare-backend} takes two parameters---the backend name and -an arbitrary number of @dfn{abilities}. - -Here's an example: - -@lisp -(gnus-declare-backend "nnchoke" 'mail 'respool 'address) -@end lisp - -The abilities can be: - -@table @code -@item mail -This is a mailish backend---followups should (probably) go via mail. -@item post -This is a newsish backend---followups should (probably) go via news. -@item post-mail -This backend supports both mail and news. -@item none -This is neither a post nor mail backend---it's something completely -different. -@item respool -It supports respooling---or rather, it is able to modify its source -articles and groups. -@item address -The name of the server should be in the virtual server name. This is -true for almost all backends. -@item prompt-address -The user should be prompted for an address when doing commands like -@kbd{B} in the group buffer. This is true for backends like -@code{nntp}, but not @code{nnmbox}, for instance. -@end table - - -@node Mail-like Backends -@subsubsection Mail-like Backends - -One of the things that separate the mail backends from the rest of the -backends is the heavy dependence by the mail backends on common -functions in @file{nnmail.el}. For instance, here's the definition of -@code{nnml-request-scan}: - -@lisp -(deffoo nnml-request-scan (&optional group server) - (setq nnml-article-file-alist nil) - (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group)) -@end lisp - -It simply calls @code{nnmail-get-new-mail} with a few parameters, -and @code{nnmail} takes care of all the moving and splitting of the -mail. - -This function takes four parameters. - -@table @var -@item method -This should be a symbol to designate which backend is responsible for -the call. - -@item exit-function -This function should be called after the splitting has been performed. - -@item temp-directory -Where the temporary files should be stored. - -@item group -This optional argument should be a group name if the splitting is to be -performed for one group only. -@end table - -@code{nnmail-get-new-mail} will call @var{backend}@code{-save-mail} to -save each article. @var{backend}@code{-active-number} will be called to -find the article number assigned to this article. - -The function also uses the following variables: -@var{backend}@code{-get-new-mail} (to see whether to get new mail for -this backend); and @var{backend}@code{-group-alist} and -@var{backend}@code{-active-file} to generate the new active file. -@var{backend}@code{-group-alist} should be a group-active alist, like -this: - -@example -(("a-group" (1 . 10)) - ("some-group" (34 . 39))) -@end example - - -@node Score File Syntax -@subsection Score File Syntax - -Score files are meant to be easily parsable, but yet extremely -mallable. It was decided that something that had the same read syntax -as an Emacs Lisp list would fit that spec. - -Here's a typical score file: - -@lisp -(("summary" - ("win95" -10000 nil s) - ("Gnus")) - ("from" - ("Lars" -1000)) - (mark -100)) -@end lisp - -BNF definition of a score file: - -@example -score-file = "" / "(" *element ")" -element = rule / atom -rule = string-rule / number-rule / date-rule -string-rule = "(" quote string-header quote space *string-match ")" -number-rule = "(" quote number-header quote space *number-match ")" -date-rule = "(" quote date-header quote space *date-match ")" -quote = -string-header = "subject" / "from" / "references" / "message-id" / - "xref" / "body" / "head" / "all" / "followup" -number-header = "lines" / "chars" -date-header = "date" -string-match = "(" quote quote [ "" / [ space score [ "" / - space date [ "" / [ space string-match-t ] ] ] ] ] ")" -score = "nil" / -date = "nil" / -string-match-t = "nil" / "s" / "substring" / "S" / "Substring" / - "r" / "regex" / "R" / "Regex" / - "e" / "exact" / "E" / "Exact" / - "f" / "fuzzy" / "F" / "Fuzzy" -number-match = "(" [ "" / [ space score [ "" / - space date [ "" / [ space number-match-t ] ] ] ] ] ")" -number-match-t = "nil" / "=" / "<" / ">" / ">=" / "<=" -date-match = "(" quote quote [ "" / [ space score [ "" / - space date [ "" / [ space date-match-t ] ] ] ] ")" -date-match-t = "nil" / "at" / "before" / "after" -atom = "(" [ required-atom / optional-atom ] ")" -required-atom = mark / expunge / mark-and-expunge / files / - exclude-files / read-only / touched -optional-atom = adapt / local / eval -mark = "mark" space nil-or-number -nil-or-number = "nil" / -expunge = "expunge" space nil-or-number -mark-and-expunge = "mark-and-expunge" space nil-or-number -files = "files" *[ space ] -exclude-files = "exclude-files" *[ space ] -read-only = "read-only" [ space "nil" / space "t" ] -adapt = "adapt" [ space "ignore" / space "t" / space adapt-rule ] -adapt-rule = "(" *[ *[ "(" ")" ] ")" -local = "local" *[ space "(" space
    ")" ] -eval = "eval" space -space = *[ " " / / ] -@end example - -Any unrecognized elements in a score file should be ignored, but not -discarded. - -As you can see, white space is needed, but the type and amount of white -space is irrelevant. This means that formatting of the score file is -left up to the programmer---if it's simpler to just spew it all out on -one looong line, then that's ok. - -The meaning of the various atoms are explained elsewhere in this -manual (@pxref{Score File Format}). - - -@node Headers -@subsection Headers - -Internally Gnus uses a format for storing article headers that -corresponds to the @sc{nov} format in a mysterious fashion. One could -almost suspect that the author looked at the @sc{nov} specification and -just shamelessly @emph{stole} the entire thing, and one would be right. - -@dfn{Header} is a severely overloaded term. ``Header'' is used in -RFC1036 to talk about lines in the head of an article (e.g., -@code{From}). It is used by many people as a synonym for -``head''---``the header and the body''. (That should be avoided, in my -opinion.) And Gnus uses a format internally that it calls ``header'', -which is what I'm talking about here. This is a 9-element vector, -basically, with each header (ouch) having one slot. - -These slots are, in order: @code{number}, @code{subject}, @code{from}, -@code{date}, @code{id}, @code{references}, @code{chars}, @code{lines}, -@code{xref}. There are macros for accessing and setting these -slots---they all have predictable names beginning with -@code{mail-header-} and @code{mail-header-set-}, respectively. - -The @code{xref} slot is really a @code{misc} slot. Any extra info will -be put in there. - - -@node Ranges -@subsection Ranges - -@sc{gnus} introduced a concept that I found so useful that I've started -using it a lot and have elaborated on it greatly. - -The question is simple: If you have a large amount of objects that are -identified by numbers (say, articles, to take a @emph{wild} example) -that you want to qualify as being ``included'', a normal sequence isn't -very useful. (A 200,000 length sequence is a bit long-winded.) - -The solution is as simple as the question: You just collapse the -sequence. - -@example -(1 2 3 4 5 6 10 11 12) -@end example - -is transformed into - -@example -((1 . 6) (10 . 12)) -@end example - -To avoid having those nasty @samp{(13 . 13)} elements to denote a -lonesome object, a @samp{13} is a valid element: - -@example -((1 . 6) 7 (10 . 12)) -@end example - -This means that comparing two ranges to find out whether they are equal -is slightly tricky: - -@example -((1 . 5) 7 8 (10 . 12)) -@end example - -and - -@example -((1 . 5) (7 . 8) (10 . 12)) -@end example - -are equal. In fact, any non-descending list is a range: - -@example -(1 2 3 4 5) -@end example - -is a perfectly valid range, although a pretty long-winded one. This is -also valid: - -@example -(1 . 5) -@end example - -and is equal to the previous range. - -Here's a BNF definition of ranges. Of course, one must remember the -semantic requirement that the numbers are non-descending. (Any number -of repetition of the same number is allowed, but apt to disappear in -range handling.) - -@example -range = simple-range / normal-range -simple-range = "(" number " . " number ")" -normal-range = "(" start-contents ")" -contents = "" / simple-range *[ " " contents ] / - number *[ " " contents ] -@end example - -Gnus currently uses ranges to keep track of read articles and article -marks. I plan on implementing a number of range operators in C if The -Powers That Be are willing to let me. (I haven't asked yet, because I -need to do some more thinking on what operators I need to make life -totally range-based without ever having to convert back to normal -sequences.) - - -@node Group Info -@subsection Group Info - -Gnus stores all permanent info on groups in a @dfn{group info} list. -This list is from three to six elements (or more) long and exhaustively -describes the group. - -Here are two example group infos; one is a very simple group while the -second is a more complex one: - -@example -("no.group" 5 (1 . 54324)) - -("nnml:my.mail" 3 ((1 . 5) 9 (20 . 55)) - ((tick (15 . 19)) (replied 3 6 (19 . 3))) - (nnml "") - (auto-expire (to-address "ding@@gnus.org"))) -@end example - -The first element is the @dfn{group name}---as Gnus knows the group, -anyway. The second element is the @dfn{subscription level}, which -normally is a small integer. (It can also be the @dfn{rank}, which is a -cons cell where the @code{car} is the level and the @code{cdr} is the -score.) The third element is a list of ranges of read articles. The -fourth element is a list of lists of article marks of various kinds. -The fifth element is the select method (or virtual server, if you like). -The sixth element is a list of @dfn{group parameters}, which is what -this section is about. - -Any of the last three elements may be missing if they are not required. -In fact, the vast majority of groups will normally only have the first -three elements, which saves quite a lot of cons cells. - -Here's a BNF definition of the group info format: - -@example -info = "(" group space ralevel space read - [ "" / [ space marks-list [ "" / [ space method [ "" / - space parameters ] ] ] ] ] ")" -group = quote quote -ralevel = rank / level -level = -rank = "(" level "." score ")" -score = -read = range -marks-lists = nil / "(" *marks ")" -marks = "(" range ")" -method = "(" *elisp-forms ")" -parameters = "(" *elisp-forms ")" -@end example - -Actually that @samp{marks} rule is a fib. A @samp{marks} is a -@samp{} consed on to a @samp{range}, but that's a bitch to say -in pseudo-BNF. - -If you have a Gnus info and want to access the elements, Gnus offers a -series of macros for getting/setting these elements. - -@table @code -@item gnus-info-group -@itemx gnus-info-set-group -@findex gnus-info-group -@findex gnus-info-set-group -Get/set the group name. - -@item gnus-info-rank -@itemx gnus-info-set-rank -@findex gnus-info-rank -@findex gnus-info-set-rank -Get/set the group rank (@pxref{Group Score}). - -@item gnus-info-level -@itemx gnus-info-set-level -@findex gnus-info-level -@findex gnus-info-set-level -Get/set the group level. - -@item gnus-info-score -@itemx gnus-info-set-score -@findex gnus-info-score -@findex gnus-info-set-score -Get/set the group score (@pxref{Group Score}). - -@item gnus-info-read -@itemx gnus-info-set-read -@findex gnus-info-read -@findex gnus-info-set-read -Get/set the ranges of read articles. - -@item gnus-info-marks -@itemx gnus-info-set-marks -@findex gnus-info-marks -@findex gnus-info-set-marks -Get/set the lists of ranges of marked articles. - -@item gnus-info-method -@itemx gnus-info-set-method -@findex gnus-info-method -@findex gnus-info-set-method -Get/set the group select method. - -@item gnus-info-params -@itemx gnus-info-set-params -@findex gnus-info-params -@findex gnus-info-set-params -Get/set the group parameters. -@end table - -All the getter functions take one parameter---the info list. The setter -functions take two parameters---the info list and the new value. - -The last three elements in the group info aren't mandatory, so it may be -necessary to extend the group info before setting the element. If this -is necessary, you can just pass on a non-@code{nil} third parameter to -the three final setter functions to have this happen automatically. - - -@node Extended Interactive -@subsection Extended Interactive -@cindex interactive -@findex gnus-interactive - -Gnus extends the standard Emacs @code{interactive} specification -slightly to allow easy use of the symbolic prefix (@pxref{Symbolic -Prefixes}). Here's an example of how this is used: - -@lisp -(defun gnus-summary-increase-score (&optional score symp) - (interactive (gnus-interactive "P\ny")) - ... - ) -@end lisp - -The best thing to do would have been to implement -@code{gnus-interactive} as a macro which would have returned an -@code{interactive} form, but this isn't possible since Emacs checks -whether a function is interactive or not by simply doing an @code{assq} -on the lambda form. So, instead we have @code{gnus-interactive} -function that takes a string and returns values that are usable to -@code{interactive}. - -This function accepts (almost) all normal @code{interactive} specs, but -adds a few more. - -@table @samp -@item y -@vindex gnus-current-prefix-symbol -The current symbolic prefix---the @code{gnus-current-prefix-symbol} -variable. - -@item Y -@vindex gnus-current-prefix-symbols -A list of the current symbolic prefixes---the -@code{gnus-current-prefix-symbol} variable. - -@item A -The current article number---the @code{gnus-summary-article-number} -function. - -@item H -The current article header---the @code{gnus-summary-article-header} -function. - -@item g -The current group name---the @code{gnus-group-group-name} -function. - -@end table - - -@node Emacs/XEmacs Code -@subsection Emacs/XEmacs Code -@cindex XEmacs -@cindex Emacsen - -While Gnus runs under Emacs, XEmacs and Mule, I decided that one of the -platforms must be the primary one. I chose Emacs. Not because I don't -like XEmacs or Mule, but because it comes first alphabetically. - -This means that Gnus will byte-compile under Emacs with nary a warning, -while XEmacs will pump out gigabytes of warnings while byte-compiling. -As I use byte-compilation warnings to help me root out trivial errors in -Gnus, that's very useful. - -I've also consistently used Emacs function interfaces, but have used -Gnusey aliases for the functions. To take an example: Emacs defines a -@code{run-at-time} function while XEmacs defines a @code{start-itimer} -function. I then define a function called @code{gnus-run-at-time} that -takes the same parameters as the Emacs @code{run-at-time}. When running -Gnus under Emacs, the former function is just an alias for the latter. -However, when running under XEmacs, the former is an alias for the -following function: - -@lisp -(defun gnus-xmas-run-at-time (time repeat function &rest args) - (start-itimer - "gnus-run-at-time" - `(lambda () - (,function ,@@args)) - time repeat)) -@end lisp - -This sort of thing has been done for bunches of functions. Gnus does -not redefine any native Emacs functions while running under XEmacs---it -does this @code{defalias} thing with Gnus equivalents instead. Cleaner -all over. - -In the cases where the XEmacs function interface was obviously cleaner, -I used it instead. For example @code{gnus-region-active-p} is an alias -for @code{region-active-p} in XEmacs, whereas in Emacs it is a function. - -Of course, I could have chosen XEmacs as my native platform and done -mapping functions the other way around. But I didn't. The performance -hit these indirections impose on Gnus under XEmacs should be slight. - - -@node Various File Formats -@subsection Various File Formats - -@menu -* Active File Format:: Information on articles and groups available. -* Newsgroups File Format:: Group descriptions. -@end menu - - -@node Active File Format -@subsubsection Active File Format - -The active file lists all groups available on the server in -question. It also lists the highest and lowest current article numbers -in each group. - -Here's an excerpt from a typical active file: - -@example -soc.motss 296030 293865 y -alt.binaries.pictures.fractals 3922 3913 n -comp.sources.unix 1605 1593 m -comp.binaries.ibm.pc 5097 5089 y -no.general 1000 900 y -@end example - -Here's a pseudo-BNF definition of this file: - -@example -active = *group-line -group-line = group space high-number space low-number space flag -group = -space = " " -high-number = -low-number = -flag = "y" / "n" / "m" / "j" / "x" / "=" group -@end example - -For a full description of this file, see the manual pages for -@samp{innd}, in particular @samp{active(5)}. - - -@node Newsgroups File Format -@subsubsection Newsgroups File Format - -The newsgroups file lists groups along with their descriptions. Not all -groups on the server have to be listed, and not all groups in the file -have to exist on the server. The file is meant purely as information to -the user. - -The format is quite simple; a group name, a tab, and the description. -Here's the definition: - -@example -newsgroups = *line -line = group tab description -group = -tab = -description = -@end example - - -@page -@node Emacs for Heathens -@section Emacs for Heathens - -Believe it or not, but some people who use Gnus haven't really used -Emacs much before they embarked on their journey on the Gnus Love Boat. -If you are one of those unfortunates whom ``@kbd{M-C-a}'', ``kill the -region'', and ``set @code{gnus-flargblossen} to an alist where the key -is a regexp that is used for matching on the group name'' are magical -phrases with little or no meaning, then this appendix is for you. If -you are already familiar with Emacs, just ignore this and go fondle your -cat instead. - -@menu -* Keystrokes:: Entering text and executing commands. -* Emacs Lisp:: The built-in Emacs programming language. -@end menu - - -@node Keystrokes -@subsection Keystrokes - -@itemize @bullet -@item -Q: What is an experienced Emacs user? - -@item -A: A person who wishes that the terminal had pedals. -@end itemize - -Yes, when you use Emacs, you are apt to use the control key, the shift -key and the meta key a lot. This is very annoying to some people -(notably @code{vi}le users), and the rest of us just love the hell out -of it. Just give up and submit. Emacs really does stand for -``Escape-Meta-Alt-Control-Shift'', and not ``Editing Macros'', as you -may have heard from other disreputable sources (like the Emacs author). - -The shift keys are normally located near your pinky fingers, and are -normally used to get capital letters and stuff. You probably use it all -the time. The control key is normally marked ``CTRL'' or something like -that. The meta key is, funnily enough, never marked as such on any -keyboard. The one I'm currently at has a key that's marked ``Alt'', -which is the meta key on this keyboard. It's usually located somewhere -to the left hand side of the keyboard, usually on the bottom row. - -Now, us Emacs people don't say ``press the meta-control-m key'', -because that's just too inconvenient. We say ``press the @kbd{M-C-m} -key''. @kbd{M-} is the prefix that means ``meta'' and ``C-'' is the -prefix that means ``control''. So ``press @kbd{C-k}'' means ``press -down the control key, and hold it down while you press @kbd{k}''. -``Press @kbd{M-C-k}'' means ``press down and hold down the meta key and -the control key and then press @kbd{k}''. Simple, ay? - -This is somewhat complicated by the fact that not all keyboards have a -meta key. In that case you can use the ``escape'' key. Then @kbd{M-k} -means ``press escape, release escape, press @kbd{k}''. That's much more -work than if you have a meta key, so if that's the case, I respectfully -suggest you get a real keyboard with a meta key. You can't live without -it. - - - -@node Emacs Lisp -@subsection Emacs Lisp - -Emacs is the King of Editors because it's really a Lisp interpreter. -Each and every key you tap runs some Emacs Lisp code snippet, and since -Emacs Lisp is an interpreted language, that means that you can configure -any key to run any arbitrary code. You just, like, do it. - -Gnus is written in Emacs Lisp, and is run as a bunch of interpreted -functions. (These are byte-compiled for speed, but it's still -interpreted.) If you decide that you don't like the way Gnus does -certain things, it's trivial to have it do something a different way. -(Well, at least if you know how to write Lisp code.) However, that's -beyond the scope of this manual, so we are simply going to talk about -some common constructs that you normally use in your @file{.emacs} file -to customize Gnus. - -If you want to set the variable @code{gnus-florgbnize} to four (4), you -write the following: - -@lisp -(setq gnus-florgbnize 4) -@end lisp - -This function (really ``special form'') @code{setq} is the one that can -set a variable to some value. This is really all you need to know. Now -you can go and fill your @code{.emacs} file with lots of these to change -how Gnus works. - -If you have put that thing in your @code{.emacs} file, it will be read -and @code{eval}ed (which is lisp-ese for ``run'') the next time you -start Emacs. If you want to change the variable right away, simply say -@kbd{C-x C-e} after the closing parenthesis. That will @code{eval} the -previous ``form'', which is a simple @code{setq} statement here. - -Go ahead---just try it, if you're located at your Emacs. After you -@kbd{C-x C-e}, you will see @samp{4} appear in the echo area, which -is the return value of the form you @code{eval}ed. - -Some pitfalls: - -If the manual says ``set @code{gnus-read-active-file} to @code{some}'', -that means: - -@lisp -(setq gnus-read-active-file 'some) -@end lisp - -On the other hand, if the manual says ``set @code{gnus-nntp-server} to -@samp{nntp.ifi.uio.no}'', that means: - -@lisp -(setq gnus-nntp-server "nntp.ifi.uio.no") -@end lisp - -So be careful not to mix up strings (the latter) with symbols (the -former). The manual is unambiguous, but it can be confusing. - -@page -@include gnus-faq.texi - -@node Index -@chapter Index -@printindex cp - -@node Key Index -@chapter Key Index -@printindex ky - -@summarycontents -@contents -@bye - -@iftex -@iflatex -\end{document} -@end iflatex -@end iftex - -@c End: - diff --git a/texi/gnuslogo.refcard b/texi/gnuslogo.refcard deleted file mode 100644 index aacf40e..0000000 --- a/texi/gnuslogo.refcard +++ /dev/null @@ -1,243 +0,0 @@ -%!PS-Adobe-2.0 EPSF-1.2 -%%Creator: Adobe Illustrator 88(TM) format generated by CorelTRACE Version 2.0C -%%Title: /home/menja/c/larsi/gnus.eps -%%BoundingBox: 0 0 924.5 907.2 -%%CreationDate: Tue Feb 20 01:51:37 1996 -%%DocumentFonts: -%%ColorUsage: B & W -%%TileBox: 0 0 924.5 907.2 -%%EndComments -%%BeginProcSet:Adobe_Illustrator_1.1 0 0 -% Copyright 1992 Corel Corporation. - -% All rights reserved. -.15 .15 scale - -/wPSMDict 150 dict def -wPSMDict begin -/bd {bind def} bind def -/ld {load def} bd -/xd {exch def} bd -/_ null def -/$c 0 def -/$m 0 def -/$y 0 def -/$k 0 def -/$t 1 def -/$n _ def -/$o 0 def -/$C 0 def -/$M 0 def -/$Y 0 def -/$K 0 def -/$T 1 def -/$N _ def -/$O 0 def -/$h false def -/$al 0 def -/$tr 0 def -/$le 0 def -/$lx 0 def -/$ly 0 def -/$ctm matrix currentmatrix def -/@cp /closepath ld -/@gs /gsave ld -/@gr /grestore ld -/@MN {2 copy le{pop}{exch pop}ifelse}bd -/setcmykcolor where {pop}{/setcmykcolor{4 1 roll -3 {3 index add 1 @MN 1 exch sub 3 1 roll} repeat -setrgbcolor -pop}bd}ifelse -/@tc{dup 1 ge{pop}{4 {dup -6 -1 roll -mul -exch}repeat -pop}ifelse}bd -/@scc{$c $m $y $k $t @tc setcmykcolor true}bd -/@SCC{$C $M $Y $K $T @tc setcmykcolor true}bd -/@sm{/$ctm $ctm currentmatrix def}bd -/x {/$t xd /$n xd -/$k xd /$y xd /$m xd /$c xd}bd -/X {/$T xd /$N xd -/$K xd /$Y xd /$M xd /$C xd}bd -/g {1 exch sub 0 0 0 -4 -1 roll -_ 1 x}bd -/G {1 exch sub 0 0 0 -4 -1 roll -_ 1 X}bd -/k {_ 1 x}bd -/K {_ 1 X}bd -/d /setdash ld -/i {dup 0 ne {setflat} {pop} ifelse}bd -/j /setlinejoin ld -/J /setlinecap ld -/M /setmiterlimit ld -/w /setlinewidth ld -/O {/$o xd}bd -/R {/$O xd}bd -/c /curveto ld -/C /c ld -/l /lineto ld -/L /l ld -/m /moveto ld -/n /newpath ld -/N /newpath ld -/F {@scc{eofill}if n} bd -/f {@cp F}bd -/S {@SCC{stroke}if n} bd -/s {@cp -S}bd -/B {@gs F @gr -S}bd -/b {@cp B }bd -/u {}bd -/U {}bd -%%EndProlog -%%BeginSetup -%%EndSetup -1 i -2 J -0 j -4 M -[]0 d - -%%Note: traced as Normal_Outline -0 g -259.2 78.2 m -327.3 178.5 L -327.8 179.0 328.3 180.0 329.7 180.4 C -373.4 241.9 L -388.8 263.5 L -389.2 264.0 390.7 264.4 391.6 265.4 C -413.7 298.0 453.6 351.8 468.0 404.6 C -467.5 405.6 467.5 407.0 467.5 407.0 C -442.0 367.6 411.3 319.2 379.2 279.3 C -372.0 267.3 366.7 265.9 361.9 254.8 C -333.1 216.0 L -323.5 207.3 311.0 185.2 302.8 175.6 C -298.0 165.6 293.2 164.1 288.9 154.0 C -282.2 147.8 282.2 139.6 276.4 132.4 C -258.2 77.7 L -258.2 77.7 259.2 78.2 259.2 78.2 C -f -0 g -470.8 211.6 m -470.8 211.6 472.3 212.1 472.3 212.1 C -518.8 305.2 L -531.3 317.2 L -537.6 314.8 539.0 300.9 548.6 301.9 C -555.8 301.9 554.8 302.8 561.6 306.2 C -595.2 357.1 L -595.6 358.0 597.6 358.5 598.5 360.0 C -615.8 398.4 650.8 450.7 657.6 483.8 C -658.0 486.2 658.0 488.1 658.0 489.6 C -654.2 489.1 656.1 485.2 650.4 479.5 C -634.5 446.8 611.5 402.2 592.8 377.2 C -588.0 370.0 581.7 365.7 577.4 358.5 C -570.2 355.6 568.3 351.3 560.1 356.6 C -554.8 360.0 553.9 364.8 550.0 370.0 C -548.1 371.5 550.0 370.5 547.2 371.0 C -541.4 365.2 L -511.2 319.6 484.3 276.0 471.8 220.3 C -470.8 215.5 471.3 215.5 469.4 212.1 C -469.4 212.1 470.8 211.6 470.8 211.6 C -f -0 g -731.0 292.8 m -756.0 351.3 751.6 407.0 771.3 468.0 C -783.3 520.8 809.7 582.2 822.2 635.0 C -829.4 684.4 855.8 732.0 825.1 789.1 C -811.6 797.7 799.6 805.4 784.8 802.0 C -757.9 792.0 732.9 743.0 726.2 712.8 C -727.6 708.4 727.2 707.0 730.0 704.6 C -731.0 704.1 732.9 704.1 734.4 704.6 C -737.2 709.9 L -754.0 747.3 L -758.8 755.0 771.8 754.0 781.9 751.2 C -788.1 748.3 791.5 745.9 797.7 744.0 C -831.8 680.1 800.6 611.0 784.3 542.8 C -765.6 478.5 748.3 431.5 739.2 370.5 C -733.9 347.5 729.1 318.7 730.0 292.8 C -730.0 292.8 731.0 292.8 731.0 292.8 C -f -0 g -434.4 462.7 m -460.3 496.8 462.2 532.8 458.4 575.5 C -456.4 588.0 451.2 599.0 445.4 609.1 C -435.3 620.1 435.3 622.5 421.9 630.7 C -411.8 619.6 398.4 604.8 391.6 586.0 C -393.6 581.7 396.4 584.1 401.7 577.9 C -403.2 577.4 404.6 576.9 404.6 576.9 C -407.0 574.5 406.0 573.6 410.4 571.2 C -414.2 564.0 418.5 558.2 424.3 545.7 C -437.2 526.5 428.1 489.6 433.9 462.2 C -433.9 462.2 434.4 462.7 434.4 462.7 C -f -0 g -226.0 482.4 m -281.7 485.7 311.0 531.3 357.1 565.9 C -362.8 572.1 364.8 574.0 368.6 580.3 C -368.6 581.7 369.1 582.7 369.6 584.6 C -370.0 585.6 371.5 587.0 372.9 588.0 C -381.6 606.2 L -377.2 605.2 374.8 602.8 371.0 597.6 C -346.0 576.4 316.8 552.0 289.9 536.1 C -288.9 535.2 288.0 534.2 288.0 534.2 C -273.6 528.0 263.5 527.5 247.6 530.8 C -242.4 535.2 239.0 536.1 238.0 544.3 C -239.5 572.1 266.8 600.0 281.2 624.9 C -293.7 637.9 300.4 650.4 311.5 668.1 C -312.0 669.1 313.9 669.6 314.8 671.0 C -319.6 679.6 L -319.6 680.1 319.6 681.6 319.2 682.0 C -285.6 649.4 258.7 601.4 229.9 555.8 C -216.4 529.9 205.4 511.2 210.2 491.0 C -212.6 483.8 218.8 484.8 226.0 482.4 C -f -0 g -624.9 600.4 m -645.1 606.2 L -676.3 622.5 694.5 658.0 710.8 698.4 C -710.4 704.1 711.3 704.6 712.3 709.4 C -696.9 685.9 693.6 667.6 662.4 653.7 C -654.7 651.3 649.4 650.4 639.3 650.8 C -633.1 654.2 625.4 659.0 621.6 670.5 C -597.6 620.6 L -600.9 612.4 604.3 607.2 613.4 603.8 C -617.2 603.3 621.1 601.4 624.9 600.4 C -f -0 g -528.4 619.2 m -548.6 617.2 564.9 629.2 578.8 645.6 C -584.1 651.8 586.5 662.8 591.8 671.0 C -593.2 681.6 603.8 690.2 601.9 704.1 C -598.5 705.1 599.0 698.8 594.7 694.0 C -581.7 679.6 L -569.7 668.6 545.7 663.8 532.8 673.9 C -487.2 697.9 467.5 754.5 413.2 772.8 C -393.1 778.0 387.3 771.8 367.2 760.3 C -360.9 755.5 357.6 744.9 351.3 740.6 C -347.0 740.6 349.9 743.5 344.6 747.3 C -344.1 748.8 343.6 750.2 343.6 750.2 C -322.5 770.8 L -312.9 775.2 300.9 784.3 287.0 779.0 C -283.6 777.1 281.7 776.1 279.3 775.2 C -250.0 750.7 229.4 705.6 181.4 697.4 C -165.6 705.1 160.3 715.2 150.7 733.9 C -130.5 685.4 L -142.5 663.3 L -147.3 661.9 147.3 660.4 151.2 655.6 C -160.8 650.4 169.9 649.4 182.8 655.2 C -212.1 676.8 L -213.1 677.7 214.0 678.7 216.0 679.2 C -238.5 695.5 250.5 727.6 279.3 735.3 C -296.1 727.2 312.4 715.6 326.8 695.5 C -330.2 688.3 331.6 684.9 335.5 681.1 C -345.1 694.5 352.8 717.6 372.9 721.9 C -423.3 726.7 453.6 670.5 498.2 631.6 C -510.7 624.4 517.4 621.1 528.4 619.2 C -f -%%Trailer -end -showpage diff --git a/texi/gnusref.tex b/texi/gnusref.tex deleted file mode 100644 index da186fe..0000000 --- a/texi/gnusref.tex +++ /dev/null @@ -1,687 +0,0 @@ -% include file for the Gnus refcard and booklet -\def\progver{5.0}\def\refver{5.0} % program and refcard versions -\def\date{16 September 1995} -\def\author{Vladimir Alexiev $<$vladimir@cs.ualberta.ca$>$} -\raggedbottom\raggedright -\newlength{\logowidth}\setlength{\logowidth}{6.861in} -\newlength{\logoheight}\setlength{\logoheight}{7.013in} -\newlength{\keycolwidth} -\newenvironment{keys}[1]% #1 is the widest key - {\nopagebreak%\noindent% - \settowidth{\keycolwidth}{#1}% - \addtolength{\keycolwidth}{\tabcolsep}% - \addtolength{\keycolwidth}{-\columnwidth}% - \begin{tabular}{@{}l@{\hspace{\tabcolsep}}p{-\keycolwidth}@{}}}% - {\end{tabular}\\} -\catcode`\^=12 % allow ^ to be typed literally -\newcommand{\B}[1]{{\bf#1})} % bold l)etter - -\def\Title{ -\begin{center} -{\bf\LARGE Gnus \progver\ Reference \Guide\\} -%{\normalsize \Guide\ version \refver} -\end{center} -} - -\newcommand\Logo[1]{\centerline{ -\makebox[\logoscale\logowidth][l]{\vbox to \logoscale\logoheight -{\vfill\special{psfile=gnuslogo.#1}}\vspace{-\baselineskip}}}} - -\def\CopyRight{ -\begin{center} -Copyright \copyright\ 1995 Free Software Foundation, Inc.\\* -Copyright \copyright\ 1995 \author.\\* -Created from the Gnus manual Copyright \copyright\ 1994 Lars Magne -Ingebrigtsen.\\* -and the Emacs Help Bindings feature (C-h b).\\* -Gnus logo copyright \copyright\ 1995 Luis Fernandes.\\* -\end{center} - -Permission is granted to make and distribute copies of this reference -\guide{} provided the copyright notice and this permission are preserved on -all copies. Please send corrections, additions and suggestions to the -above email address. \Guide{} last edited on \date. -} - -\def\Notes{ -\subsec{Notes} -{\samepage -Gnus is complex. Currently it has some 346 interactive (user-callable) -functions. Of these 279 are in the two major modes (Group and -Summary/Article). Many of these functions have more than one binding, some -have 3 or even 4 bindings. The total number of keybindings is 389. So in -order to save 40\% space, every function is listed only once on this -\guide, under the ``more logical'' binding. Alternative bindings are given -in parentheses in the beginning of the description. - -Many Gnus commands are affected by the numeric prefix. Normally you enter a -prefix by holding the Meta key and typing a number, but in most Gnus modes -you don't need to use Meta since the digits are not self-inserting. The -prefixed behavior of commands is given in [brackets]. Often the prefix is -used to specify: - -\quad [distance] How many objects to move the point over. - -\quad [scope] How many objects to operate on (including the current one). - -\quad [p/p] The ``Process/Prefix Convention'': If a prefix is given then it -determines how many objects to operate on. Else if there are some objects -marked with the process mark \#, these are operated on. Else only the -current object is affected. - -\quad [level] A group subscribedness level. Only groups with a lower or -equal level will be affected by the operation. If no prefix is given, -`gnus-group-default-list-level' is used. If -`gnus-group-use-permanent-levels', then a prefix to the `g' and `l' -commands will also set the default level. - -\quad [score] An article score. If no prefix is given, -`gnus-summary-default-score' is used. -%Some functions were not yet documented at the time of creating this -%\guide and are clearly indicated as such. -\\*[\baselineskip] -\begin{keys}{C-c C-i} -C-c C-i & Go to the Gnus online {\bf info}.\\ -C-c C-b & Send a Gnus {\bf bug} report.\\ -\end{keys} -}} - -\def\GroupLevels{ -\subsec{Group Subscribedness Levels} -The table below assumes that you use the default Gnus levels. -Fill your user-specific levels in the blank cells.\\[1\baselineskip] - -\begin{tabular}{|c|l|l|} -\hline -Level & Groups & Status \\ -\hline -1 & mail groups & \\ -2 & mail groups & \\ -3 & & subscribed \\ -4 & & \\ -5 & default list level & \\ -\hline -6 & & unsubscribed \\ -7 & & \\ -\hline -8 & & zombies \\ -\hline -9 & & killed \\ -\hline -\end{tabular} -} - -\def\Marks{ -\subsec{Mark Indication Characters} -{\samepage If a command directly sets a mark, it is shown in parentheses.\\* -\newlength{\markcolwidth} -\settowidth{\markcolwidth}{` '}% widest character -\addtolength{\markcolwidth}{4\tabcolsep} -\addtolength{\markcolwidth}{-\columnwidth} -\newlength{\markdblcolwidth} -\setlength{\markdblcolwidth}{\columnwidth} -\addtolength{\markdblcolwidth}{-2\tabcolsep} -\begin{tabular}{|c|p{-\markcolwidth}|} -\hline -\multicolumn{2}{|p{\markdblcolwidth}|}{{\bf ``Read'' Marks.} - All these marks appear in the first column of the summary line, and so - are mutually exclusive.}\\ -\hline -` ' & (M-u, M SPC, M c) Not read.\\ -! & (!, M !, M t) Ticked (interesting).\\ -? & (?, M ?) Dormant (only followups are interesting).\\ -C & (C, S c) {\bf Canceled} (only for your own articles).\\ -E & (E, M e, M x) {\bf Expirable}. Only has effect in mail groups.\\ -\hline\hline -\multicolumn{2}{|p{\markdblcolwidth}|}{The marks below mean that the article - is read (killed, uninteresting), and have more or less the same effect. - Some commands however explicitly differentiate between them (e.g.\ M - M-C-r, adaptive scoring).}\\ -\hline -r & (d, M d, M r) Deleted (marked as {\bf read}).\\ -C & (M C; M C-c; M H; c, Z c; Z n; Z C) Killed by {\bf catch-up}.\\ -O & {\bf Old} (marked read in a previous session).\\ -K & (k, M k; C-k, M K) {\bf Killed}.\\ -R & {\bf Read} (viewed in actuality).\\ -X & Killed by a kill file.\\ -Y & Killed due to low score.\\ -\hline\multicolumn{2}{c}{\vspace{1ex}}\\\hline -\multicolumn{2}{|p{\markdblcolwidth}|}{{\bf Other marks}}\\ -\hline -\# & (\#, M \#, M P p) Processable (will be affected by the next operation).\\ -A & {\bf Answered} (followed-up or replied).\\ -+ & Over default score.\\ -$-$ & Under default score.\\ -= & Has children (thread underneath it). Add `\%e' to - `gnus-summary-line-format'.\\ -\hline -\end{tabular} -}} - -\def\GroupMode{ -\sec{Group Mode} -\begin{keys}{C-c M-C-x} -RET & (=) Select this group. [Prefix: how many (read) articles to fetch. -Positive: newest articles, negative: oldest ones.]\\ -SPC & Select this group and display the first unread article. [Same -prefix as above.]\\ -? & Give a very short help message.\\ -$<$ & Go to the beginning of the Group buffer.\\ -$>$ & Go to the end of the Group buffer.\\ -, & Jump to the lowest-level group with unread articles.\\ -. & Jump to the first group with unread articles.\\ -^ & Enter the Server buffer mode.\\ -a & Post an {\bf article} to a group.\\ -b & Find {\bf bogus} groups and delete them.\\ -c & Mark all unticked articles in this group as read ({\bf catch-up}). -[p/p]\\ -g & Check the server for new articles ({\bf get}). [level]\\ -j & {\bf Jump} to a group.\\ -m & {\bf Mail} a message to someone.\\ -n & Go to the {\bf next} group with unread articles. [distance]\\ -p & (DEL) Go to the {\bf previous} group with unread articles. -[distance]\\ -q & {\bf Quit} Gnus.\\ -r & Read the init file ({\bf reset}).\\ -s & {\bf Save} the `.newsrc.eld' file (and `.newsrc' if -`gnus-save-newsrc-file').\\ -z & Suspend (kill all buffers of) Gnus.\\ -B & {\bf Browse} a foreign server.\\ -C & Mark all articles in this group as read ({\bf Catch-up}). [p/p]\\ -F & {\bf Find} new groups and process them.\\ -N & Go to the {\bf next} group. [distance]\\ -P & Go to the {\bf previous} group. [distance]\\ -Q & {\bf Quit} Gnus without saving any startup (.newsrc) files.\\ -R & {\bf Restart} Gnus.\\ -V & Display the Gnus {\bf version} number.\\ -Z & Clear the dribble buffer.\\ -C-c C-d & Show the {\bf description} of this group. [Prefix: re-read it -from the server.]\\ -C-c C-s & {\bf Sort} the groups by name, number of unread articles, or level -(depending on `gnus-group-sort-function').\\ -C-c C-x & Run all expirable articles in this group through the {\bf expiry} -process.\\ -C-c M-C-x & Run all articles in all groups through the {\bf expiry} process.\\ -C-x C-t & {\bf Transpose} two groups.\\ -M-d & {\bf Describe} ALL groups. [Prefix: re-read the description from the -server.]\\ -M-f & Fetch this group's {\bf FAQ} (using ange-ftp).\\ -M-g & Check the server for new articles in this group ({\bf get}). [p/p]\\ -M-n & Go to the {\bf previous} unread group on the same or lower level. -[distance]\\ -M-p & Go to the {\bf next} unread group on the same or lower level. -[distance]\\ -\end{keys} -} - -\def\GroupCommands{ -\subsec{List Groups} -{\samepage -\begin{keys}{A m} -A a & (C-c C-a) List all groups whose names match a regexp ({\bf -apropos}).\\ -A d & List all groups whose names or {\bf descriptions} match a regexp.\\ -A k & (C-c C-l) List all {\bf killed} groups.\\ -A m & List groups that {\bf match} a regexp and have unread articles. -[level]\\ -A s & (l) List {\bf subscribed} groups with unread articles. [level]\\ -A u & (L) List all groups (including {\bf unsubscribed}). [If no prefix -is given, level 7 is the default]\\ -A z & List the {\bf zombie} groups.\\ -A M & List groups that {\bf match} a regexp.\\ -\end{keys} -} - -\subsec{Create/Edit Foreign Groups} -{\samepage -The select methods are indicated in parentheses.\\* -\begin{keys}{G m} -G a & Make the Gnus list {\bf archive} group. (nndir over ange-ftp)\\ -G d & Make a {\bf directory} group (every file must be a posting and files -must have numeric names). (nndir)\\ -G e & (M-e) {\bf Edit} this group's select method.\\ -G f & Make a group based on a {\bf file}. (nndoc)\\ -G h & Make the Gnus {\bf help} (documentation) group. (nndoc)\\ -G k & Make a {\bf kiboze} group. (nnkiboze)\\ -G m & {\bf Make} a new group.\\ -G p & Edit this group's {\bf parameters}.\\ -G v & Add this group to a {\bf virtual} group. [p/p]\\ -G D & Enter a {\bf directory} as a (temporary) group. (nneething without -recording articles read.)\\ -G E & {\bf Edit} this group's info (select method, articles read, etc).\\ -G V & Make a new empty {\bf virtual} group. (nnvirtual)\\ -\end{keys} -You can also create mail-groups and read your mail with Gnus (very useful -if you are subscribed to any mailing lists), using one of the methods -nnmbox, nnbabyl, nnml, nnmh, or nnfolder. Read about it in the online info -(C-c C-i g Reading Mail RET). -} - -%\subsubsec{Soup Commands} -%\begin{keys}{G s w} -%G s b & gnus-group-brew-soup: not documented.\\ -%G s p & gnus-soup-pack-packet: not documented.\\ -%G s r & nnsoup-pack-replies: not documented.\\ -%G s s & gnus-soup-send-replies: not documented.\\ -%G s w & gnus-soup-save-areas: not documented.\\ -%\end{keys} - -\subsec{Mark Groups} -\begin{keys}{M m} -M m & (\#) Set the process {\bf mark} on this group. [scope]\\ -M u & (M-\#) Remove the process mark from this group ({\bf unmark}). -[scope]\\ -M w & Mark all groups in the current region.\\ -\end{keys} - -\subsec{Unsubscribe, Kill and Yank Groups} -\begin{keys}{S w} -S k & (C-k) {\bf Kill} this group.\\ -S l & Set the {\bf level} of this group. [p/p]\\ -S s & (U) Prompt for a group and toggle its {\bf subscription}.\\ -S t & (u) {\bf Toggle} subscription to this group. [p/p]\\ -S w & (C-w) Kill all groups in the region.\\ -S y & (C-y) {\bf Yank} the last killed group.\\ -S z & Kill all {\bf zombie} groups.\\ -\end{keys} -} - -\def\SummaryMode{ -\sec{Summary Mode} %{Summary and Article Modes} -\begin{keys}{SPC} -SPC & (A SPC, A n) Select an article, scroll it one page, move to the -next one.\\ -DEL & (A DEL, A p, b) Scroll this article one page back. [distance]\\ -RET & Scroll this article one line forward. [distance]\\ -= & Expand the Summary window. [Prefix: shrink it to display the -Article window]\\ -$<$ & (A $<$, A b) Scroll to the beginning of this article.\\ -$>$ & (A $>$, A e) Scroll to the end of this article.\\ -\& & Execute a command on all articles matching a regexp. -[Prefix: move backwards.]\\ -j & (G g) Ask for an article number and then {\bf jump} to that summary -line.\\ -C-t & Toggle {\bf truncation} of summary lines.\\ -M-\& & Execute a command on all articles having the process mark.\\ -M-k & Edit this group's {\bf kill} file.\\ -M-n & (G M-n) Go to the {\bf next} summary line of an unread article. -[distance]\\ -M-p & (G M-p) Go to the {\bf previous} summary line of an unread article. -[distance]\\ -M-r & Search through all previous articles for a regexp.\\ -M-s & {\bf Search} through all subsequent articles for a regexp.\\ -M-K & Edit the general {\bf kill} file.\\ -\end{keys} -} - -\def\SortSummary{ -\subsec{Sort the Summary Buffer} -\begin{keys}{C-c C-s C-a} -C-c C-s C-a & Sort the summary by {\bf author}.\\ -C-c C-s C-d & Sort the summary by {\bf date}.\\ -C-c C-s C-i & Sort the summary by article score.\\ -C-c C-s C-n & Sort the summary by article {\bf number}.\\ -C-c C-s C-s & Sort the summary by {\bf subject}.\\ -\end{keys} -} - -\def\Asubmap{ -\subsec{Article Buffer Commands} -\begin{keys}{A m} -A g & (g) (Re)fetch this article ({\bf get}). [Prefix: just show the -article.]\\ -A r & (^, A ^) Go to the parent of this article (the {\bf References} -header).\\ -M-^ & Fetch the article with a given Message-ID.\\ -A s & (s) Perform an i{\bf search} in the article buffer.\\ -A D & (C-d) Un{\bf digestify} this article into a separate group.\\ -\end{keys} -} - -\def\Bsubmap{ -\subsec{Mail-Group Commands} -{\samepage -These commands (except `B c') are only valid in a mail group.\\* -\begin{keys}{B M-C-e} -B DEL & {\bf Delete} the mail article from disk (!). [p/p]\\ -B c & {\bf Copy} this article from any group to a mail group. [p/p]\\ -B e & {\bf Expire} all expirable articles in this group. [p/p]\\ -B i & {\bf Import} a random file into this group.\\ -B m & {\bf Move} the article from one mail group to another. [p/p]\\ -B q & {\bf Query} where will the article go during fancy splitting\\ -B r & {\bf Respool} this mail article. [p/p]\\ -B w & (e) Edit this article.\\ -B M-C-e & {\bf Expunge} (delete from disk) all expirable articles in this group -(!). [p/p]\\ -\end{keys} -}} - -\def\Gsubmap{ -\subsec{Select Articles} -{\samepage -These commands select the target article. They do not understand the prefix.\\* -\begin{keys}{G C-n} -G b & (,) Go to the {\bf best} article (the one with highest score).\\ -G f & (.) Go to the {\bf first} unread article.\\ -G l & (l) Go to the {\bf last} article read.\\ -G n & (n) Go to the {\bf next} unread article.\\ -p & Go to the {\bf previous} unread article.\\ -G p & {\bf Pop} an article off the summary history and go to it.\\ -G N & (N) Go to {\bf the} next article.\\ -G P & (P) Go to the {\bf previous} article.\\ -G C-n & (M-C-n) Go to the {\bf next} article with the same subject.\\ -G C-p & (M-C-p) Go to the {\bf previous} article with the same subject.\\ -\end{keys} -}} - -\def\Hsubmap{ -\subsec{Help Commands} -\begin{keys}{H d} -H d & (C-c C-d) {\bf Describe} this group. [Prefix: re-read the description -from the server.]\\ -H f & Try to fetch the {\bf FAQ} for this group using ange-ftp.\\ -H h & Give a very short {\bf help} message.\\ -H i & (C-c C-i) Go to the Gnus online {\bf info}.\\ -H v & Display the Gnus {\bf version} number.\\ -\end{keys} -} - -\def\Msubmap{ -\subsec{Mark Articles} -\begin{keys}{M M-C-r} -d & (M d, M r) Mark this article as read and move to the next one. -[scope]\\ -D & Mark this article as read and move to the previous one. [scope]\\ -u & (!, M !, M t) Tick this article (mark it as interesting) and move -to the next one. [scope]\\ -U & Tick this article and move to the previous one. [scope]\\ -M-u & (M SPC, M c) Clear all marks from this article and move to the next -one. [scope]\\ -M-U & Clear all marks from this article and move to the previous one. -[scope]\\ -M ? & (?) Mark this article as dormant (only followups are -interesting). [scope]\\ -M b & Set a {\bf bookmark} in this article.\\ -M e & (E, M x) Mark this article as {\bf expirable}. [scope]\\ -M k & (k) {\bf Kill} all articles with the same subject then select the -next one.\\ -M B & Remove the {\bf bookmark} from this article.\\ -M C & {\bf Catch-up} the articles that are not ticked.\\ -M D & Show all {\bf dormant} articles (normally they are hidden unless they -have any followups).\\ -M H & Catch-up (mark read) this group to point ({\bf here}).\\ -M K & (C-k) {\bf Kill} all articles with the same subject as this one.\\ -C-w & Mark all articles between point and mark as read.\\ -M S & (C-c M-C-s) {\bf Show} all expunged articles.\\ -M C-c & {\bf Catch-up} all articles in this group.\\ -M M-r & (x) Expunge all {\bf read} articles from this group.\\ -M M-D & Hide all {\bf dormant} articles.\\ -M M-C-r & Expunge all articles having a given mark.\\ -\end{keys} - -\subsubsec{Mark Based on Score} -\begin{keys}{M s m} -M V c & {\bf Clear} all marks from all high-scored articles. [score]\\ -M V k & {\bf Kill} all low-scored articles. [score]\\ -M V m & Mark all high-scored articles with a given {\bf mark}. [score]\\ -M V u & Mark all high-scored articles as interesting (tick them). [score]\\ -\end{keys} - -\subsubsec{The Process Mark} -{\samepage -These commands set and remove the process mark \#. You only need to use -it if the set of articles you want to operate on is non-contiguous. Else -use a numeric prefix.\\* -\begin{keys}{M P R} -M P a & Mark {\bf all} articles (in series order).\\ -M P p & (\#, M \#) Mark this article.\\ -M P r & Mark all articles in the {\bf region}.\\ -M P s & Mark all articles in the current {\bf series}.\\ -M P t & Mark all articles in this (sub){\bf thread}.\\ -M P u & (M-\#, M M-\#) {\bf Unmark} this article.\\ -M P R & Mark all articles matching a {\bf regexp}.\\ -M P S & Mark all {\bf series} that already contain a marked article.\\ -M P U & {\bf Unmark} all articles.\\ -\end{keys} -}} - -\def\Osubmap{ -\subsec{Output Articles} -\begin{keys}{O m} -O f & Save this article in plain {\bf file} format. [p/p]\\ -O h & Save this article in {\bf mh} folder format. [p/p]\\ -O m & Save this article in {\bf mail} format. [p/p]\\ -O o & (o, C-o) Save this article using the default article saver. [p/p]\\ -O p & ($\mid$) Pipe this article to a shell command. [p/p]\\ -O r & Save this article in {\bf rmail} format. [p/p]\\ -O v & Save this article in {\bf vm} format. [p/p]\\ -\end{keys} -} - -\def\Ssubmap{ -\subsec{Post, Followup, Reply, Forward, Cancel} -{\samepage -These commands put you in a separate post or mail buffer. After -editing the article, send it by pressing C-c C-c. If you are in a -foreign group and want to post the article using the foreign server, give -a prefix to C-c C-c.\\* -\begin{keys}{S O m} -S b & {\bf Both} post a followup to this article, and send a reply.\\ -S c & (C) {\bf Cancel} this article (only works if it is your own).\\ -S f & (f) Post a {\bf followup} to this article.\\ -S m & (m) Send {\bf a} mail to some other person.\\ -S o m & (C-c C-f) Forward this article by {\bf mail} to a person.\\ -S o p & Forward this article as a {\bf post} to a newsgroup.\\ -S p & (a) {\bf Post} an article to this group.\\ -S r & (r) Mail a {\bf reply} to the author of this article.\\ -S s & {\bf Supersede} this article with a new one (only for own -articles).\\ -S u & {\bf Uuencode} a file and post it as a series.\\ -S B & {\bf Both} post a followup, send a reply, and include the -original. [p/p]\\ -S F & (F) Post a {\bf followup} and include the original. [p/p]\\ -S O m & Digest these series and forward by {\bf mail}. [p/p]\\ -S O p & Digest these series and forward as a {\bf post} to a newsgroup. -[p/p]\\ -S R & (R) Mail a {\bf reply} and include the original. [p/p]\\ -\end{keys} -If you want to cancel or supersede an article you just posted (before it -has appeared on the server), go to the *post-news* buffer, change -`Message-ID' to `Cancel' or `Supersedes' and send it again with C-c C-c. -}} - -\def\Tsubmap{ -\subsec{Thread Commands} -\begin{keys}{T \#} -T \# & Mark this thread with the process mark.\\ -T d & Move to the next article in this thread ({\bf down}). [distance]\\ -T h & {\bf Hide} this (sub)thread.\\ -T i & {\bf Increase} the score of this thread.\\ -T k & (M-C-k) {\bf Kill} the current (sub)thread. [Negative prefix: -tick it, positive prefix: unmark it.]\\ -T l & (M-C-l) {\bf Lower} the score of this thread.\\ -T n & (M-C-f) Go to the {\bf next} thread. [distance]\\ -T p & (M-C-b) Go to the {\bf previous} thread. [distance]\\ -T s & {\bf Show} the thread hidden under this article.\\ -T u & Move to the previous article in this thread ({\bf up}). [distance]\\ -T H & {\bf Hide} all threads.\\ -T S & {\bf Show} all hidden threads.\\ -T T & (M-C-t) {\bf Toggle} threading.\\ -\end{keys} -} - -\def\Vsubmap{ -\subsec{Score (Value) Commands} -{\samepage -Read about Adaptive Scoring in the online info.\\* -\begin{keys}{\bf A p m l} -V a & {\bf Add} a new score entry, specifying all elements.\\ -V c & Specify a new score file as {\bf current}.\\ -V e & {\bf Edit} the current score alist.\\ -V f & Edit a score {\bf file} and make it the current one.\\ -V m & {\bf Mark} all articles below a given score as read.\\ -V s & Set the {\bf score} of this article.\\ -V t & Display all score rules applied to this article ({\bf track}).\\ -V x & {\bf Expunge} all low-scored articles. [score]\\ -V C & {\bf Customize} the current score file through a user-friendly -interface.\\ -V S & Display the {\bf score} of this article.\\ -\bf A p m l& Make a scoring entry based on this article.\\ -\end{keys} - -The four letters stand for:\\* -\quad \B{A}ction: I)ncrease, L)ower;\\* -\quad \B{p}art: a)utor (from), s)ubject, x)refs (cross-posting), d)ate, l)ines, -message-i)d, t)references (parent), f)ollowup, b)ody, h)ead (all headers);\\* -\quad \B{m}atch type:\\* -\qquad string: s)ubstring, e)xact, r)egexp, f)uzzy,\\* -\qquad date: b)efore, a)t, n)this,\\* -\qquad number: $<$, =, $>$;\\* -\quad \B{l}ifetime: t)emporary, p)ermanent, i)mmediate. - -If you type the second letter in uppercase, the remaining two are assumed -to be s)ubstring and t)emporary. -If you type the third letter in uppercase, the last one is assumed to be -t)emporary. - -\quad Extra keys for manual editing of a score file:\\* -\begin{keys}{C-c C-c} -C-c C-c & Finish editing the score file.\\ -C-c C-d & Insert the current {\bf date} as number of days.\\ -\end{keys} -}} - -\def\Wsubmap{ -\subsec{Wash the Article Buffer} -\begin{keys}{W C-c} -W b & Make Message-IDs and URLs in the article to mouse-clickable {\bf - buttons}.\\ -W c & Remove extra {\bf CRs} (^M) from the article.\\ -W f & Look for and display any X-{\bf Face} headers.\\ -W l & (w) Remove page breaks ({\bf^L}) from the article.\\ -W m & Toggle {\bf MIME} processing.\\ -W o & Treat {\bf overstrike} or underline (^H\_) in the article.\\ -W q & Treat {\bf quoted}-printable in the article.\\ -W r & (C-c C-r) Do a Caesar {\bf rotate} (rot13) on the article.\\ -W t & (t) {\bf Toggle} the displaying of all headers.\\ -v & Toggle permanent {\bf verbose} displaying of all headers.\\ -W w & Do word {\bf wrap} in the article.\\ -W T e & Convert the article timestamp to time {\bf elapsed} since sent.\\ -W T l & Convert the article timestamp to the {\bf local} timezone.\\ -W T u & (W T z) Convert the article timestamp to {\bf UTC} ({\bf Zulu}, -GMT).\\ -\end{keys} - -\subsubsec{Hide/Highlight Parts of the Article} -\begin{keys}{W W C-c} -W W a & Hide {\bf all} unwanted parts. Calls W W h, W W s, W W C-c.\\ -W W c & Hide article {\bf citation}.\\ -W W h & Hide article {\bf headers}.\\ -W W s & Hide article {\bf signature}.\\ -W W C-c & Hide article {\bf citation} using a more intelligent algorithm.\\ -%\end{keys} -% -%\subsubsec{Highlight Parts of the Article} -%\begin{keys}{W H A} -W H a & Highlight {\bf all} parts. Calls W b, W H c, W H h, W H s.\\ -W H c & Highlight article {\bf citation}.\\ -W H h & Highlight article {\bf headers}.\\ -W H s & Highlight article {\bf signature}.\\ -\end{keys} -} - -\def\Xsubmap{ -\subsec{Extract Series (Uudecode etc)} -{\samepage -Gnus recognizes if the current article is part of a series (multipart -posting whose parts are identified by numbers in their subjects, e.g.{} -1/10\dots10/10) and processes the series accordingly. You can mark and -process more than one series at a time. If the posting contains any -archives, they are expanded and gathered in a new group.\\* -\begin{keys}{X p} -X b & Un-{\bf binhex} these series. [p/p]\\ -X o & Simply {\bf output} these series (no decoding). [p/p]\\ -X p & Unpack these {\bf postscript} series. [p/p]\\ -X s & Un-{\bf shar} these series. [p/p]\\ -X u & {\bf Uudecode} these series. [p/p]\\ -\end{keys} - -Each one of these commands has four variants:\\* -\begin{keys}{X v \bf Z} -X \bf z & Decode these series. [p/p]\\ -X \bf Z & Decode and save these series. [p/p]\\ -X v \bf z & Decode and view these series. [p/p]\\ -X v \bf Z & Decode, save and view these series. [p/p]\\ -\end{keys} -where {\bf z} or {\bf Z} identifies the decoding method (b, o, p, s, u). - -An alternative binding for the most-often used of these commands is\\* -\begin{keys}{C-c C-v C-v} -C-c C-v C-v & (X v u) Uudecode and view these series. [p/p]\\ -\end{keys} -}} - -\def\Zsubmap{ -\subsec{Exit the Current Group} -\begin{keys}{Z G} -Z c & (c) Mark all unticked articles as read ({\bf catch-up}) and exit.\\ -Z n & Mark all articles as read and go to the {\bf next} group.\\ -Z C & Mark all articles as read ({\bf catch-up}) and exit.\\ -Z E & (Q) {\bf Exit} without updating the group information.\\ -Z G & (M-g) Check for new articles in this group ({\bf get}).\\ -Z N & Exit and go to {\bf the} next group.\\ -Z P & Exit and go to the {\bf previous} group.\\ -Z R & Exit this group, and then enter it again ({\bf reenter}). -[Prefix: select all articles, read and unread.]\\ -Z Z & (q, Z Q) Exit this group.\\ -\end{keys} -} - -\def\ArticleMode{ -\sec{Article Mode} -{\samepage -% All keys for Summary mode also work in Article mode. -The normal navigation keys work in Article mode. -Some additional keys are:\\* -\begin{keys}{C-c C-m} -RET & (middle mouse button) Activate the button at point to follow -an URL or Message-ID.\\ -TAB & Move the point to the next button.\\ -h & (s) Go to the {\bf header} line of the article in the {\bf -summary} buffer.\\ -C-c ^ & Get the article with the Message-ID near point.\\ -C-c C-m & {\bf Mail} reply to the address near point (prefix: include the -original).\\ -\end{keys} -}} - -\def\ServerMode{ -\sec{Server Mode} -{\samepage -To enter this mode, press `^' while in Group mode.\\* -\begin{keys}{SPC} -SPC & (RET) Browse this server.\\ -a & {\bf Add} a new server.\\ -c & {\bf Copy} this server.\\ -e & {\bf Edit} a server.\\ -k & {\bf Kill} this server. [scope]\\ -l & {\bf List} all servers.\\ -q & Return to the group buffer ({\bf quit}).\\ -y & {\bf Yank} the previously killed server.\\ -\end{keys} -}} - -\def\BrowseServer{ -\sec{Browse Server Mode} -{\samepage -To enter this mode, press `B' while in Group mode.\\* -\begin{keys}{RET} -RET & Enter the current group.\\ -SPC & Enter the current group and display the first article.\\ -? & Give a very short help message.\\ -n & Go to the {\bf next} group. [distance]\\ -p & Go to the {\bf previous} group. [distance]\\ -q & (l) {\bf Quit} browse mode.\\ -u & Subscribe to the current group. [scope]\\ -\end{keys} -}} diff --git a/texi/message.texi b/texi/message.texi deleted file mode 100644 index b128681..0000000 --- a/texi/message.texi +++ /dev/null @@ -1,1283 +0,0 @@ -\input texinfo @c -*-texinfo-*- - -@setfilename message -@settitle Message 0.27 Manual -@synindex fn cp -@synindex vr cp -@synindex pg cp -@iftex -@finalout -@end iftex -@setchapternewpage odd - -@ifinfo - -This file documents Message, the Emacs message composition mode. - -Copyright (C) 1996 Free Software Foundation, Inc. - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -@ignore -Permission is granted to process this file through Tex and print the -results, provided the printed document carries copying permission -notice identical to this one except for the removal of this paragraph -(this paragraph not being relevant to the printed manual). - -@end ignore -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided also that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions. -@end ifinfo - -@tex - -@titlepage -@title Message 0.27 Manual - -@author by Lars Magne Ingebrigtsen -@page - -@vskip 0pt plus 1filll -Copyright @copyright{} 1996 Free Software Foundation, Inc. - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions. - -@end titlepage -@page - -@end tex - -@node Top -@top Message - -All message composition from Gnus (both mail and news) takes place in -Message mode buffers. - -@menu -* Interface:: Setting up message buffers. -* Commands:: Commands you can execute in message mode buffers. -* Variables:: Customizing the message buffers. -* Compatibility:: Making Message backwards compatible. -* Appendices:: More technical things. -* Index:: Variable, function and concept index. -* Key Index:: List of Message mode keys. -@end menu - -This manual corresponds to Message 0.27. Message is distributed with -the Gnus distribution bearing the same version number as this manual -has. - - -@node Interface -@chapter Interface - -When a program (or a person) wants to respond to a message -- reply, -follow up, forward, cancel -- the program (or person) should just put -point in the buffer where the message is and call the required command. -@code{Message} will then pop up a new @code{message} mode buffer with -appropriate headers filled out, and the user can edit the message before -sending it. - -@menu -* New Mail Message:: Editing a brand new mail message. -* New News Message:: Editing a brand new news message. -* Reply:: Replying via mail. -* Wide Reply:: Responding to all people via mail. -* Followup:: Following up via news. -* Canceling News:: Canceling a news article. -* Superseding:: Superseding a message. -* Forwarding:: Forwarding a message via news or mail. -* Resending:: Resending a mail message. -* Bouncing:: Bouncing a mail message. -@end menu - - -@node New Mail Message -@section New Mail Message - -@findex message-mail -The @code{message-mail} command pops up a new message buffer. - -Two optional parameters are accepted: The first will be used as the -@code{To} header and the second as the @code{Subject} header. If these -are @code{nil}, those two headers will be empty. - - -@node New News Message -@section New News Message - -@findex message-news -The @code{message-news} command pops up a new message buffer. - -This function accepts two optional parameters. The first will be used -as the @code{Newsgroups} header and the second as the @code{Subject} -header. If these are @code{nil}, those two headers will be empty. - - -@node Reply -@section Reply - -@findex message-reply -The @code{message-reply} function pops up a message buffer that's a -reply to the message in the current buffer. - -@vindex message-reply-to-function -Message uses the normal methods to determine where replies are to go -(@pxref{Responses}), but you can change the behavior to suit your needs -by fiddling with the @code{message-reply-to-function} variable. - -If you want the replies to go to the @code{Sender} instead of the -@code{From}, you could do something like this: - -@lisp -(setq message-reply-to-function - (lambda () - (cond ((equal (mail-fetch-field "from") "somebody") - (mail-fetch-field "sender")) - (t - nil)))) -@end lisp - -This function will be called narrowed to the head of the article that is -being replied to. - -As you can see, this function should return a string if it has an -opinion as to what the To header should be. If it does not, it should -just return @code{nil}, and the normal methods for determining the To -header will be used. - -This function can also return a list. In that case, each list element -should be a cons, where the car should be the name of an header -(eg. @code{Cc}) and the cdr should be the header value -(eg. @samp{larsi@@ifi.uio.no}). All these headers will be inserted into -the head of the outgoing mail. - - -@node Wide Reply -@section Wide Reply - -@findex message-wide-reply -The @code{message-wide-reply} pops up a message buffer that's a wide -reply to the message in the current buffer. A @dfn{wide reply} is a -reply that goes out to all people listed in the @code{To}, @code{From} -(or @code{Reply-to}) and @code{Cc} headers. - -@vindex message-wide-reply-to-function -Message uses the normal methods to determine where wide replies are to go, -but you can change the behavior to suit your needs by fiddling with the -@code{message-wide-reply-to-function}. It is used in the same way as -@code{message-reply-to-function} (@pxref{Reply}). - -@findex rmail-dont-reply-to-names -Addresses that match the @code{rmail-dont-reply-to-names} regular -expression will be removed from the @code{Cc} header. - - -@node Followup -@section Followup - -@findex message-followup -The @code{message-followup} command pops up a message buffer that's a -followup to the message in the current buffer. - -@vindex message-followup-to-function -Message uses the normal methods to determine where followups are to go, -but you can change the behavior to suit your needs by fiddling with the -@code{message-followup-to-function}. It is used in the same way as -@code{message-reply-to-function} (@pxref{Reply}). - -@vindex message-use-followup-to -The @code{message-use-followup-to} variable says what to do about -@code{Followup-To} headers. If it is @code{use}, always use the value. -If it is @code{ask} (which is the default), ask whether to use the -value. If it is @code{t}, use the value unless it is @samp{poster}. If -it is @code{nil}, don't use the value. - - -@node Canceling News -@section Canceling News - -@findex message-cancel-news -The @code{message-cancel-news} command cancels the article in the -current buffer. - - -@node Superseding -@section Superseding - -@findex message-supersede -The @code{message-supersede} command pops up a message buffer that will -supersede the message in the current buffer. - -@vindex message-ignored-supersedes-headers -Headers matching the @code{message-ignored-supersedes-headers} are -removed before popping up the new message buffer. The default is@* -@samp{^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|@* -^Received:\\|^X-From-Line:\\|Return-Path:\\|^Supersedes:}. - - - -@node Forwarding -@section Forwarding - -@findex message-forward -The @code{message-forward} command pops up a message buffer to forward -the message in the current buffer. If given a prefix, forward using -news. - -@table @code -@item message-forward-start-separator -@vindex message-forward-start-separator -Delimiter inserted before forwarded messages. The default is@* -@samp{------- Start of forwarded message -------\n}. - -@vindex message-forward-end-separator -@item message-forward-end-separator -@vindex message-forward-end-separator -Delimiter inserted after forwarded messages. The default is@* -@samp{------- End of forwarded message -------\n}. - -@item message-signature-before-forwarded-message -@vindex message-signature-before-forwarded-message -If this variable is @code{t}, which it is by default, your personal -signature will be inserted before the forwarded message. If not, the -forwarded message will be inserted first in the new mail. - -@item message-included-forward-headers -@vindex message-included-forward-headers -Regexp matching header lines to be included in forwarded messages. - -@end table - - -@node Resending -@section Resending - -@findex message-resend -The @code{message-resend} command will prompt the user for an address -and resend the message in the current buffer to that address. - -@vindex message-ignored-resent-headers -Headers that match the @code{message-ignored-resent-headers} regexp will -be removed before sending the message. The default is -@samp{^Return-receipt}. - - -@node Bouncing -@section Bouncing - -@findex message-bounce -The @code{message-bounce} command will, if the current buffer contains a -bounced mail message, pop up a message buffer stripped of the bounce -information. A @dfn{bounced message} is typically a mail you've sent -out that has been returned by some @code{mailer-daemon} as -undeliverable. - -@vindex message-ignored-bounced-headers -Headers that match the @code{message-ignored-bounced-headers} regexp -will be removed before popping up the buffer. The default is -@samp{^\\(Received\\|Return-Path\\):}. - - -@node Commands -@chapter Commands - -@menu -* Header Commands:: Commands for moving to headers. -* Movement:: Moving around in message buffers. -* Insertion:: Inserting things into message buffers. -* Various Commands:: Various things. -* Sending:: Actually sending the message. -* Mail Aliases:: How to use mail aliases. -@end menu - - -@node Header Commands -@section Header Commands - -All these commands move to the header in question. If it doesn't exist, -it will be inserted. - -@table @kbd - -@item C-c ? -@kindex C-c ? -@findex message-goto-to -Describe the message mode. - -@item C-c C-f C-t -@kindex C-c C-f C-t -@findex message-goto-to -Go to the @code{To} header (@code{message-goto-to}). - -@item C-c C-f C-b -@kindex C-c C-f C-b -@findex message-goto-bcc -Go to the @code{Bcc} header (@code{message-goto-bcc}). - -@item C-c C-f C-f -@kindex C-c C-f C-f -@findex message-goto-fcc -Go to the @code{Fcc} header (@code{message-goto-fcc}). - -@item C-c C-f C-c -@kindex C-c C-f C-c -@findex message-goto-cc -Go to the @code{Cc} header (@code{message-goto-cc}). - -@item C-c C-f C-s -@kindex C-c C-f C-s -@findex message-goto-subject -Go to the @code{Subject} header (@code{message-goto-subject}). - -@item C-c C-f C-r -@kindex C-c C-f C-r -@findex message-goto-reply-to -Go to the @code{Reply-To} header (@code{message-goto-reply-to}). - -@item C-c C-f C-n -@kindex C-c C-f C-n -@findex message-goto-newsgroups -Go to the @code{Newsgroups} header (@code{message-goto-newsgroups}). - -@item C-c C-f C-d -@kindex C-c C-f C-d -@findex message-goto-distribution -Go to the @code{Distribution} header (@code{message-goto-distribution}). - -@item C-c C-f C-o -@kindex C-c C-f C-o -@findex message-goto-followup-to -Go to the @code{Followup-To} header (@code{message-goto-followup-to}). - -@item C-c C-f C-k -@kindex C-c C-f C-k -@findex message-goto-keywords -Go to the @code{Keywords} header (@code{message-goto-keywords}). - -@item C-c C-f C-u -@kindex C-c C-f C-u -@findex message-goto-summary -Go to the @code{Summary} header (@code{message-goto-summary}). - -@end table - - -@node Movement -@section Movement - -@table @kbd -@item C-c C-b -@kindex C-c C-b -@findex message-goto-body -Move to the beginning of the body of the message -(@code{message-goto-body}). - -@item C-c C-i -@kindex C-c C-i -@findex message-goto-signature -Move to the signature of the message (@code{message-goto-signature}). - -@end table - - -@node Insertion -@section Insertion - -@table @kbd - -@item C-c C-y -@kindex C-c C-y -@findex message-yank-original -Yank the message that's being replied to into the message buffer -(@code{message-yank-original}). - -@item C-c C-q -@kindex C-c C-q -@findex message-fill-yanked-message -Fill the yanked message (@code{message-fill-yanked-message}). Warning: -Can severely mess up the yanked text if its quoting conventions are -strange. You'll quickly get a feel for when it's safe, though. Anyway, -just remember that @kbd{C-x u} (@code{undo}) is available and you'll be -all right. - - -@item C-c C-w -@kindex C-c C-w -@findex message-insert-signature -Insert a signature at the end of the buffer -(@code{message-insert-signature}). - -@end table - -@table @code -@item message-ignored-cited-headers -@vindex message-ignored-cited-headers -All headers that match this regexp will be removed from yanked -messages. The default is @samp{.}, which means that all headers will be -removed. - -@item message-citation-line-function -@vindex message-citation-line-function -Function called to insert the citation line. The default is -@code{message-insert-citation-line}, which will lead to citation lines -that look like: - -@example -Hallvard B Furuseth writes: -@end example - -Point will be at the beginning of the body of the message when this -function is called. - -@item message-yank-prefix -@vindex message-yank-prefix -@cindex yanking -@cindex quoting -When you are replying to or following up an article, you normally want -to quote the person you are answering. Inserting quoted text is done by -@dfn{yanking}, and each quoted line you yank will have -@code{message-yank-prefix} prepended to it. The default is @samp{> }. -If it is @code{nil}, just indent the message. - -@item message-indentation-spaces -@vindex message-indentation-spaces -Number of spaces to indent yanked messages. - -@item message-cite-function -@vindex message-cite-function -@findex message-cite-original -@findex sc-cite-original -@findex message-cite-original-without-signature -@cindex Supercite -Function for citing an original message. The default is -@code{message-cite-original}, which simply inserts the original message -and prepends @samp{> } to each line. -@code{message-cite-original-without-signature} does the same, but elides -the signature. You can also set it to @code{sc-cite-original} to use -Supercite. - -@item message-indent-citation-function -@vindex message-indent-citation-function -Function for modifying a citation just inserted in the mail buffer. -This can also be a list of functions. Each function can find the -citation between @code{(point)} and @code{(mark t)}. And each function -should leave point and mark around the citation text as modified. - -@item message-signature -@vindex message-signature -String to be inserted at the end of the message buffer. If @code{t} -(which is the default), the @code{message-signature-file} file will be -inserted instead. If a function, the result from the function will be -used instead. If a form, the result from the form will be used instead. -If this variable is @code{nil}, no signature will be inserted at all. - -@item message-signature-file -@vindex message-signature-file -File containing the signature to be inserted at the end of the buffer. -The default is @samp{~/.signature}. - -@end table - -Note that RFC1036bis says that a signature should be preceded by the three -characters @samp{-- } on a line by themselves. This is to make it -easier for the recipient to automatically recognize and process the -signature. So don't remove those characters, even though you might feel -that they ruin your beautiful design, like, totally. - -Also note that no signature should be more than four lines long. -Including ASCII graphics is an efficient way to get everybody to believe -that you are silly and have nothing important to say. - - - -@node Various Commands -@section Various Commands - -@table @kbd - -@item C-c C-r -@kindex C-c C-r -@findex message-caesar-buffer-body -Caesar rotate (aka. rot13) the current message -(@code{message-caesar-buffer-body}). If narrowing is in effect, just -rotate the visible portion of the buffer. A numerical prefix says how -many places to rotate the text. The default is 13. - -@item C-c C-e -@kindex C-c C-e -@findex message-elide-region -Elide the text between point and mark (@code{message-elide-region}). -The text is killed and an ellipsis (@samp{[...]}) will be inserted in -its place. - -@item C-c C-z -@kindex C-c C-x -@findex message-kill-to-signature -Kill all the text up to the signature, or if that's missing, up to the -end of the message (@code{message-kill-to-signature}). - -@item C-c C-v -@kindex C-c C-v -@findex message-delete-not-region -Delete all text in the body of the message that is outside the region -(@code{message-delete-not-region}). - -@item M-RET -@kindex M-RET -@kindex message-newline-and-reformat -Insert four newlines, and then reformat if inside quoted text. - -Here's an example: - -@example -> This is some quoted text. And here's more quoted text. -@end example - -If point is before @samp{And} and you press @kbd{M-RET}, you'll get: - -@example -> This is some quoted text. - -* - -> And here's more quoted text. -@end example - -@samp{*} says where point will be placed. - -@item C-c C-t -@kindex C-c C-t -@findex message-insert-to -Insert a @code{To} header that contains the @code{Reply-To} or -@code{From} header of the message you're following up -(@code{message-insert-to}). - -@item C-c C-n -@kindex C-c C-n -@findex message-insert-newsgroups -Insert a @code{Newsgroups} header that reflects the @code{Followup-To} -or @code{Newsgroups} header of the article you're replying to -(@code{message-insert-newsgroups}). - -@item C-c M-r -@kindex C-c M-r -@findex message-rename-buffer -Rename the buffer (@code{message-rename-buffer}). If given a prefix, -prompt for a new buffer name. - -@end table - - -@node Sending -@section Sending - -@table @kbd -@item C-c C-c -@kindex C-c C-c -@findex message-send-and-exit -Send the message and bury the current buffer -(@code{message-send-and-exit}). - -@item C-c C-s -@kindex C-c C-s -@findex message-send -Send the message (@code{message-send}). - -@item C-c C-d -@kindex C-c C-d -@findex message-dont-send -Bury the message buffer and exit (@code{message-dont-send}). - -@item C-c C-k -@kindex C-c C-k -@findex message-kill-buffer -Kill the message buffer and exit (@code{message-kill-buffer}). - -@end table - - - -@node Mail Aliases -@section Mail Aliases -@cindex mail aliases -@cindex aliases - -@vindex message-mail-alias-type -The @code{message-mail-alias-type} variable controls what type of mail -alias expansion to use. Currently only one form is supported---Message -uses @code{mailabbrev} to handle mail aliases. If this variable is -@code{nil}, no mail alias expansion will be performed. - -@code{mailabbrev} works by parsing the @file{/etc/mailrc} and -@file{~/.mailrc} files. These files look like: - -@example -alias lmi "Lars Magne Ingebrigtsen " -alias ding "ding@@ifi.uio.no (ding mailing list)" -@end example - -After adding lines like this to your @file{~/.mailrc} file, you should -be able to just write @samp{lmi} in the @code{To} or @code{Cc} (and so -on) headers and press @kbd{SPC} to expand the alias. - -No expansion will be performed upon sending of the message---all -expansions have to be done explicitly. - - - -@node Variables -@chapter Variables - -@menu -* Message Headers:: General message header stuff. -* Mail Headers:: Customizing mail headers. -* Mail Variables:: Other mail variables. -* News Headers:: Customizing news headers. -* News Variables:: Other news variables. -* Various Message Variables:: Other message variables. -* Sending Variables:: Variables for sending. -* Message Buffers:: How Message names its buffers. -* Message Actions:: Actions to be performed when exiting. -@end menu - - -@node Message Headers -@section Message Headers - -Message is quite aggressive on the message generation front. It has to -be -- it's a combined news and mail agent. To be able to send combined -messages, it has to generate all headers itself (instead of letting the -mail/news system do it) to ensure that mail and news copies of messages -look sufficiently similar. - -@table @code - -@item message-generate-headers-first -@vindex message-generate-headers-first -If non-@code{nil}, generate all headers before starting to compose the -message. - -@item message-from-style -@vindex message-from-style -Specifies how @code{From} headers should look. There are four legal -values: - -@table @code -@item nil -Just the address -- @samp{king@@grassland.com}. - -@item parens -@samp{king@@grassland.com (Elvis Parsley)}. - -@item angles -@samp{Elvis Parsley }. - -@item default -Look like @code{angles} if that doesn't require quoting, and -@code{parens} if it does. If even @code{parens} requires quoting, use -@code{angles} anyway. - -@end table - -@item message-deletable-headers -@vindex message-deletable-headers -Headers in this list that were previously generated by Message will be -deleted before posting. Let's say you post an article. Then you decide -to post it again to some other group, you naughty boy, so you jump back -to the @code{*post-buf*} buffer, edit the @code{Newsgroups} line, and -ship it off again. By default, this variable makes sure that the old -generated @code{Message-ID} is deleted, and a new one generated. If -this isn't done, the entire empire would probably crumble, anarchy would -prevail, and cats would start walking on two legs and rule the world. -Allegedly. - -@item message-default-headers -@vindex message-default-headers -This string is inserted at the end of the headers in all message -buffers. - -@end table - - -@node Mail Headers -@section Mail Headers - -@table @code -@item message-required-mail-headers -@vindex message-required-mail-headers -@xref{News Headers}, for the syntax of this variable. It is -@code{(From Date Subject (optional . In-Reply-To) Message-ID Lines -(optional . X-Mailer))} by default. - -@item message-ignored-mail-headers -@vindex message-ignored-mail-headers -Regexp of headers to be removed before mailing. The default is -@samp{^[GF]cc:\\|^Resent-Fcc:}. - -@item message-default-mail-headers -@vindex message-default-mail-headers -This string is inserted at the end of the headers in all message -buffers that are initialized as mail. - -@end table - - -@node Mail Variables -@section Mail Variables - -@table @code -@item message-send-mail-function -@vindex message-send-mail-function -Function used to send the current buffer as mail. The default is -@code{message-send-mail-with-sendmail}. If you prefer using MH -instead, set this variable to @code{message-send-mail-with-mh}. - -@item message-mh-deletable-headers -@vindex message-mh-deletable-headers -Most versions of MH doesn't like being fed messages that contain the -headers in this variable. If this variable is non-@code{nil} (which is -the default), these headers will be removed before mailing when sending -messages via MH. Set it to @code{nil} if your MH can handle these -headers. - -@end table - - -@node News Headers -@section News Headers - -@vindex message-required-news-headers -@code{message-required-news-headers} a list of header symbols. These -headers will either be automatically generated, or, if that's -impossible, they will be prompted for. The following symbols are legal: - -@table @code - -@item From -@cindex From -@findex user-full-name -@findex user-mail-address -This required header will be filled out with the result of the -@code{message-make-from} function, which depends on the -@code{message-from-style}, @code{user-full-name}, -@code{user-mail-address} variables. - -@item Subject -@cindex Subject -This required header will be prompted for if not present already. - -@item Newsgroups -@cindex Newsgroups -This required header says which newsgroups the article is to be posted -to. If it isn't present already, it will be prompted for. - -@item Organization -@cindex organization -This optional header will be filled out depending on the -@code{message-user-organization} variable. -@code{message-user-organization-file} will be used if this variable is -@code{t}. This variable can also be a string (in which case this string -will be used), or it can be a function (which will be called with no -parameters and should return a string to be used). - -@item Lines -@cindex Lines -This optional header will be computed by Message. - -@item Message-ID -@cindex Message-ID -@vindex mail-host-address -@findex system-name -@cindex Sun -This required header will be generated by Message. A unique ID will be -created based on the date, time, user name and system name. Message will -use @code{mail-host-address} as the fully qualified domain name (FQDN) -of the machine if that variable is defined. If not, it will use -@code{system-name}, which doesn't report a FQDN on some machines -- -notably Suns. - -@item X-Newsreader -@cindex X-Newsreader -This optional header will be filled out according to the -@code{message-newsreader} local variable. - -@item X-Mailer -This optional header will be filled out according to the -@code{message-mailer} local variable, unless there already is an -@code{X-Newsreader} header present. - -@item In-Reply-To -This optional header is filled out using the @code{Date} and @code{From} -header of the article being replied to. - -@item Expires -@cindex Expires -This extremely optional header will be inserted according to the -@code{message-expires} variable. It is highly deprecated and shouldn't -be used unless you know what you're doing. - -@item Distribution -@cindex Distribution -This optional header is filled out according to the -@code{message-distribution-function} variable. It is a deprecated and -much misunderstood header. - -@item Path -@cindex path -This extremely optional header should probably never be used. -However, some @emph{very} old servers require that this header is -present. @code{message-user-path} further controls how this -@code{Path} header is to look. If it is @code{nil}, use the server name -as the leaf node. If it is a string, use the string. If it is neither -a string nor @code{nil}, use the user name only. However, it is highly -unlikely that you should need to fiddle with this variable at all. -@end table - -@findex yow -@cindex Mime-Version -In addition, you can enter conses into this list. The car of this cons -should be a symbol. This symbol's name is the name of the header, and -the cdr can either be a string to be entered verbatim as the value of -this header, or it can be a function to be called. This function should -return a string to be inserted. For instance, if you want to insert -@code{Mime-Version: 1.0}, you should enter @code{(Mime-Version . "1.0")} -into the list. If you want to insert a funny quote, you could enter -something like @code{(X-Yow . yow)} into the list. The function -@code{yow} will then be called without any arguments. - -If the list contains a cons where the car of the cons is -@code{optional}, the cdr of this cons will only be inserted if it is -non-@code{nil}. - -Other variables for customizing outgoing news articles: - -@table @code - -@item message-syntax-checks -@vindex message-syntax-checks -If non-@code{nil}, Message will attempt to check the legality of the -headers, as well as some other stuff, before posting. You can control -the granularity of the check by adding or removing elements from this -list. Legal elements are: - -@table @code -@item subject-cmsg -Check the subject for commands. -@item sender -@cindex Sender -Insert a new @code{Sender} header if the @code{From} header looks odd. -@item multiple-headers -Check for the existence of multiple equal headers. -@item sendsys -@cindex sendsys -Check for the existence of version and sendsys commands. -@item message-id -Check whether the @code{Message-ID} looks ok. -@item from -Check whether the @code{From} header seems nice. -@item long-lines -@cindex long lines -Check for too long lines. -@item control-chars -Check for illegal characters. -@item size -Check for excessive size. -@item new-text -Check whether there is any new text in the messages. -@item signature -Check the length of the signature. -@item approved -@cindex approved -Check whether the article has an @code{Approved} header, which is -something only moderators should include. -@item empty -Check whether the article is empty. -@item empty-headers -Check whether any of the headers are empty. -@item existing-newsgroups -Check whether the newsgroups mentioned in the @code{Newsgroups} and -@code{Followup-To} headers exist. -@item valid-newsgroups -Check whether the @code{Newsgroups} and @code{Followup-to} headers -are valid syntactically. -@item repeated-newsgroups -Check whether the @code{Newsgroups} and @code{Followup-to} headers -contains repeated group names. -@item shorten-followup-to -Check whether to add a @code{Followup-to} header to shorten the number -of groups to post to. -@end table - -All these conditions are checked by default. - -@item message-ignored-news-headers -@vindex message-ignored-news-headers -Regexp of headers to be removed before posting. The default is@* -@samp{^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:}. - -@item message-default-news-headers -@vindex message-default-news-headers -This string is inserted at the end of the headers in all message -buffers that are initialized as news. - -@end table - - -@node News Variables -@section News Variables - -@table @code -@item message-send-news-function -@vindex message-send-news-function -Function used to send the current buffer as news. The default is -@code{message-send-news}. - -@item message-post-method -@vindex message-post-method -Gnusish @dfn{select method} (see the Gnus manual for details) used for -posting a prepared news message. - -@end table - - -@node Various Message Variables -@section Various Message Variables - -@table @code -@item message-signature-separator -@vindex message-signature-separator -Regexp matching the signature separator. It is @samp{^-- *$} by -default. - -@item mail-header-separator -@vindex mail-header-separator -String used to separate the headers from the body. It is @samp{--text -follows this line--} by default. - -@item message-directory -@vindex message-directory -Directory used by many mailey things. The default is @file{~/Mail/}. - -@item message-autosave-directory -@vindex message-autosave-directory -Directory where message buffers will be autosaved to. - -@item message-signature-setup-hook -@vindex message-signature-setup-hook -Hook run when initializing the message buffer. It is run after the -headers have been inserted but before the signature has been inserted. - -@item message-setup-hook -@vindex message-setup-hook -Hook run as the last thing when the message buffer has been initialized, -but before yanked text is inserted. - -@item message-header-setup-hook -@vindex message-header-setup-hook -Hook called narrowed to the headers after initializing the headers. - -For instance, if you're running Gnus and wish to insert a -@samp{Mail-Copies-To} header in all your news articles and all messages -you send to mailing lists, you could do something like the following: - -@lisp -(defun my-message-header-setup-hook () - (let ((group (or gnus-newsgroup-name ""))) - (when (or (message-fetch-field "newsgroups") - (gnus-group-find-parameter group 'to-address) - (gnus-group-find-parameter group 'to-list)) - (insert "Mail-Copies-To: never\n")))) - -(add-hook 'message-header-setup-hook - 'my-message-header-setup-hook) -@end lisp - -@item message-send-hook -@vindex message-send-hook -Hook run before sending messages. - -If you want to add certain headers before sending, you can use the -@code{message-add-header} function in this hook. For instance: -@findex message-add-header - -@lisp -(add-hook 'message-send-hook 'my-message-add-content) -(defun my-message-add-content () - (message-add-header - "Mime-Version: 1.0" - "Content-Type: text/plain" - "Content-Transfer-Encoding: 7bit")) -@end lisp - -This function won't add the header if the header is already present. - -@item message-send-mail-hook -@vindex message-send-mail-hook -Hook run before sending mail messages. - -@item message-send-news-hook -@vindex message-send-news-hook -Hook run before sending news messages. - -@item message-sent-hook -@vindex message-sent-hook -Hook run after sending messages. - -@item message-mode-syntax-table -@vindex message-mode-syntax-table -Syntax table used in message mode buffers. - -@item message-send-method-alist -@vindex message-send-method-alist - -Alist of ways to send outgoing messages. Each element has the form - -@lisp -(TYPE PREDICATE FUNCTION) -@end lisp - -@table @var -@item type -A symbol that names the method. - -@item predicate -A function called without any parameters to determine whether the -message is a message of type @var{type}. - -@item function -A function to be called if @var{predicate} returns non-@code{nil}. -@var{function} is called with one parameter -- the prefix. -@end table - -@lisp -((news message-news-p message-send-via-news) - (mail message-mail-p message-send-via-mail)) -@end lisp - - - -@end table - - - -@node Sending Variables -@section Sending Variables - -@table @code - -@item message-fcc-handler-function -@vindex message-fcc-handler-function -A function called to save outgoing articles. This function will be -called with the name of the file to store the article in. The default -function is @code{message-output} which saves in Unix mailbox format. - -@item message-courtesy-message -@vindex message-courtesy-message -When sending combined messages, this string is inserted at the start of -the mailed copy. If the string contains the format spec @samp{%s}, the -newsgroups the article has been posted to will be inserted there. If -this variable is @code{nil}, no such courtesy message will be added. -The default value is @samp{"The following message is a courtesy copy of -an article\nthat has been posted to %s as well.\n\n"}. - -@end table - - -@node Message Buffers -@section Message Buffers - -Message will generate new buffers with unique buffer names when you -request a message buffer. When you send the message, the buffer isn't -normally killed off. Its name is changed and a certain number of old -message buffers are kept alive. - -@table @code -@item message-generate-new-buffers -@vindex message-generate-new-buffers -If non-@code{nil}, generate new buffers. The default is @code{t}. 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 @code{nil}.) -The function should return the new buffer name. - -@item message-max-buffers -@vindex message-max-buffers -This variable says how many old message buffers to keep. If there are -more message buffers than this, the oldest buffer will be killed. The -default is 10. If this variable is @code{nil}, no old message buffers -will ever be killed. - -@item message-send-rename-function -@vindex message-send-rename-function -After sending a message, the buffer is renamed from, for instance, -@samp{*reply to Lars*} to @samp{*sent reply to Lars*}. If you don't -like this, set this variable to a function that renames the buffer in a -manner you like. If you don't want to rename the buffer at all, you can -say: - -@lisp -(setq message-send-rename-function 'ignore) -@end lisp - -@item message-kill-buffer-on-exit -@findex message-kill-buffer-on-exit -If non-@code{nil}, kill the buffer immediately on exit. - -@end table - - -@node Message Actions -@section Message Actions - -When Message is being used from a news/mail reader, the reader is likely -to want to perform some task after the message has been sent. Perhaps -return to the previous window configuration or mark an article as -replied. - -@vindex message-kill-actions -@vindex message-postpone-actions -@vindex message-exit-actions -@vindex message-send-actions -The user may exit from the message buffer in various ways. The most -common is @kbd{C-c C-c}, which sends the message and exits. Other -possibilities are @kbd{C-c C-s} which just sends the message, @kbd{C-c -C-d} which postpones the message editing and buries the message buffer, -and @kbd{C-c C-k} which kills the message buffer. Each of these actions -have lists associated with them that contains actions to be executed: -@code{message-send-actions}, @code{message-exit-actions}, -@code{message-postpone-actions}, and @code{message-kill-actions}. - -Message provides a function to interface with these lists: -@code{message-add-action}. The first parameter is the action to be -added, and the rest of the arguments are which lists to add this action -to. Here's an example from Gnus: - -@lisp - (message-add-action - `(set-window-configuration ,(current-window-configuration)) - 'exit 'postpone 'kill) -@end lisp - -This restores the Gnus window configuration when the message buffer is -killed, postponed or exited. - -An @dfn{action} can be either: a normal function, or a list where the -@code{car} is a function and the @code{cdr} is the list of arguments, or -a form to be @code{eval}ed. - - -@node Compatibility -@chapter Compatibility -@cindex compatibility - -Message uses virtually only its own variables---older @code{mail-} -variables aren't consulted. To force Message to take those variables -into account, you can put the following in your @code{.emacs} file: - -@lisp -(require 'messcompat) -@end lisp - -This will initialize many Message variables from the values in the -corresponding mail variables. - - -@node Appendices -@chapter Appendices - -@menu -* Responses:: Standard rules for determining where responses go. -@end menu - - -@node Responses -@section Responses - -To determine where a message is to go, the following algorithm is used -by default. - -@table @dfn -@item reply -A @dfn{reply} is when you want to respond @emph{just} to the person who -sent the message via mail. There will only be one recipient. To -determine who the recipient will be, the following headers are -consulted, in turn: - -@table @code -@item Reply-To - -@item From -@end table - - -@item wide reply -A @dfn{wide reply} is a mail response that includes @emph{all} entities -mentioned in the message you are responded to. All mailboxes from the -following headers will be concatenated to form the outgoing -@code{To}/@code{Cc} headers: - -@table @code -@item From -(unless there's a @code{Reply-To}, in which case that is used instead). - -@item Cc - -@item To -@end table - -If a @code{Mail-Copies-To} header is present, it will also be included -in the list of mailboxes. If this header is @samp{never}, that means -that the @code{From} (or @code{Reply-To}) mailbox will be suppressed. - - -@item followup -A @dfn{followup} is a response sent via news. The following headers -(listed in order of precedence) determine where the response is to be -sent: - -@table @code - -@item Followup-To - -@item Newsgroups - -@end table - -If a @code{Mail-Copies-To} header is present, it will be used as the -basis of the new @code{Cc} header, except if this header is -@samp{never}. - -@end table - - - -@node Index -@chapter Index -@printindex cp - -@node Key Index -@chapter Key Index -@printindex ky - -@summarycontents -@contents -@bye - -@c End: diff --git a/texi/postamble.tex b/texi/postamble.tex deleted file mode 100644 index 3b5f803..0000000 --- a/texi/postamble.tex +++ /dev/null @@ -1,49 +0,0 @@ -\gnuscleardoublepage - -\pagestyle{gnusindex} - -\renewcommand\indexname{Key Index} -\renewcommand{\gnuschaptername}{Key Index} -\input{gnus.kind} -\gnuscleardoublepage - -\renewcommand\indexname{Function and Variable Index} -\renewcommand{\gnuschaptername}{Function and Variable Index} -\input{gnus.gind} -\gnuscleardoublepage -\thispagestyle{empty} - -\renewcommand\indexname{Concept Index} -\renewcommand{\gnuschaptername}{Concept Index} -\input{gnus.cind} - -\mbox{} -%\thispagestyle{empty}\mbox{}\clearpage\thispagestyle{empty}\mbox{}\clearpage -\ifodd\count0\else\thispagestyle{empty}\clearpage\fi -\mbox{} -\thispagestyle{empty} -\vfill - -\begin{picture}(10,10) -\put(90,-10){\makebox(0,0)[tr]{\epsfig{figure=tmp/larsi.ps,height=3cm}}} -\end{picture} - -\hspace*{4cm}\parbox[t]{10cm}{ -This manual was written by Lars Magne Ingebrigtsen (b. 1968) who -resides in Oslo, Norway and poses as a student, but doesn't get much -studying done, for some strange reason or other. When not worshipping -at the altar of Emacs, he can often be found slouching on his couch -reading while bopping his head gently to some obscure music. He does -not have a cat. - -Graphics by Luis Fernandes. Set in Bembo and Futura. -} - -\clearpage -\mbox{} -\thispagestyle{empty} -\begin{picture}(500,500)(0,0) -\put(-35,325){\makebox(480,350)[tr]{\epsfig{figure=tmp/new-herd-section.ps}}} -\end{picture} - -\end{document} diff --git a/texi/refcard.tex b/texi/refcard.tex deleted file mode 100644 index a701cd4..0000000 --- a/texi/refcard.tex +++ /dev/null @@ -1,65 +0,0 @@ -% Reference Card for (ding) Gnus, 3 twocolumn pages. -% To be processed with latex 2.09 -\def\Guide{Card}\def\guide{card} -\def\logoscale{0.25} -\def\sec{\section*} -\def\subsec{\subsection*} -\def\subsubsec{\subsubsection*} -\documentstyle{article} -\textwidth 7.26in \textheight 10in \topmargin -1.0in -% the same settings work for A4, although there is a bit of space at the -% top and bottom of the page. -\oddsidemargin -0.5in \evensidemargin -0.5in -\begin{document} -\twocolumn\scriptsize\pagestyle{empty} -\input{gnusref} - -% page 1, left column -\Title -\par -\vspace{0.5\baselineskip} -\Logo{refcard} -\vspace*{\fill} -\GroupLevels -\GroupMode -\pagebreak - -% page 1, right column -\Notes -\vspace*{\fill} -\GroupCommands -\pagebreak - -% page 2, left column -\SummaryMode -\Asubmap -\Bsubmap -\Gsubmap -\Hsubmap -\Tsubmap -\pagebreak - -% page 2, right column -\Msubmap -\Marks -\pagebreak - -% page 3 -\Osubmap -\Ssubmap -\Xsubmap -\Vsubmap -\SortSummary -\Wsubmap -\Zsubmap -\ArticleMode -\ServerMode - -% page 4 -\BrowseServer -\pagebreak -\onecolumn -\vspace*{\fill} -\CopyRight - -\end{document} diff --git a/texi/widget.texi b/texi/widget.texi deleted file mode 100644 index b733a78..0000000 --- a/texi/widget.texi +++ /dev/null @@ -1,1432 +0,0 @@ -\input texinfo.tex - -@c %**start of header -@setfilename widget -@settitle The Emacs Widget Library -@iftex -@afourpaper -@headings double -@end iftex -@c %**end of header - -@node Top, Introduction, (dir), (dir) -@comment node-name, next, previous, up -@top The Emacs Widget Library - -Version: 1.82 - -@menu -* Introduction:: -* User Interface:: -* Programming Example:: -* Setting Up the Buffer:: -* Basic Types:: -* Sexp Types:: -* Widget Properties:: -* Defining New Widgets:: -* Widget Wishlist.:: -@end menu - -@node Introduction, User Interface, Top, Top -@comment node-name, next, previous, up -@section Introduction - -Most graphical user interface toolkits, such as Motif and XView, provide -a number of standard user interface controls (sometimes known as -`widgets' or `gadgets'). Emacs doesn't really support anything like -this, except for an incredible powerful text ``widget''. On the other -hand, Emacs does provide the necessary primitives to implement many -other widgets within a text buffer. The @code{widget} package -simplifies this task. - -The basic widgets are: - -@table @code -@item link -Areas of text with an associated action. Intended for hypertext links -embedded in text. -@item push-button -Like link, but intended for stand-alone buttons. -@item editable-field -An editable text field. It can be either variable or fixed length. -@item menu-choice -Allows the user to choose one of multiple options from a menu, each -option is itself a widget. Only the selected option will be visible in -the buffer. -@item radio-button-choice -Allows the user to choose one of multiple options by pushing radio -buttons. The options are implemented as widgets. All options will be -visible in the buffer. -@item item -A simple constant widget intended to be used in the @code{menu-choice} and -@code{radio-button-choice} widgets. -@item choice-item -An button item only intended for use in choices. When pushed, the user -will be asked to select another option from the choice widget. -@item toggle -A simple @samp{on}/@samp{off} switch. -@item checkbox -A checkbox (@samp{[ ]}/@samp{[X]}). -@item editable-list -Create an editable list. The user can insert or delete items in the -list. Each list item is itself a widget. -@end table - -Now of what possible use can support for widgets be in a text editor? -I'm glad you asked. The answer is that widgets are useful for -implementing forms. A @dfn{form} in emacs is a buffer where the user is -supposed to fill out a number of fields, each of which has a specific -meaning. The user is not supposed to change or delete any of the text -between the fields. Examples of forms in Emacs are the @file{forms} -package (of course), the customize buffers, the mail and news compose -modes, and the @sc{html} form support in the @file{w3} browser. - -The advantages for a programmer of using the @code{widget} package to -implement forms are: - -@enumerate -@item -More complex field than just editable text are supported. -@item -You can give the user immediate feedback if he enters invalid data in a -text field, and sometimes prevent entering invalid data. -@item -You can have fixed sized fields, thus allowing multiple field to be -lined up in columns. -@item -It is simple to query or set the value of a field. -@item -Editing happens in buffer, not in the mini-buffer. -@item -Packages using the library get a uniform look, making them easier for -the user to learn. -@item -As support for embedded graphics improve, the widget library will -extended to support it. This means that your code using the widget -library will also use the new graphic features by automatic. -@end enumerate - -In order to minimize the code that is loaded by users who does not -create any widgets, the code has been split in two files: - -@table @file -@item widget.el -This will declare the user variables, define the function -@code{widget-define}, and autoload the function @code{widget-create}. -@item wid-edit.el -Everything else is here, there is no reason to load it explicitly, as -it will be autoloaded when needed. -@end table - -@node User Interface, Programming Example, Introduction, Top -@comment node-name, next, previous, up -@section User Interface - -A form consist of read only text for documentation and some fields, -where each the fields contain two parts, as tag and a value. The tags -are used to identify the fields, so the documentation can refer to the -foo field, meaning the field tagged with @samp{Foo}. Here is an example -form: - -@example -Here is some documentation. - -Name: @i{My Name} @strong{Choose}: This option -Address: @i{Some Place -In some City -Some country.} - -See also @b{_other work_} for more information. - -Numbers: count to three below -@b{[INS]} @b{[DEL]} @i{One} -@b{[INS]} @b{[DEL]} @i{Eh, two?} -@b{[INS]} @b{[DEL]} @i{Five!} -@b{[INS]} - -Select multiple: - -@b{[X]} This -@b{[ ]} That -@b{[X]} Thus - -Select one: - -@b{(*)} One -@b{( )} Another One. -@b{( )} A Final One. - -@b{[Apply Form]} @b{[Reset Form]} -@end example - -The top level widgets in is example are tagged @samp{Name}, -@samp{Choose}, @samp{Address}, @samp{_other work_}, @samp{Numbers}, -@samp{Select multiple}, @samp{Select one}, @samp{[Apply Form]}, and -@samp{[Reset Form]}. There are basically two thing the user can do within -a form, namely editing the editable text fields and activating the -buttons. - -@subsection Editable Text Fields - -In the example, the value for the @samp{Name} is most likely displayed -in an editable text field, and so are values for each of the members of -the @samp{Numbers} list. All the normal Emacs editing operations are -available for editing these fields. The only restriction is that each -change you make must be contained within a single editable text field. -For example, capitalizing all text from the middle of one field to the -middle of another field is prohibited. - -Editing text fields are created by the @code{editable-field} widget. - -The editing text fields are highlighted with the -@code{widget-field-face} face, making them easy to find. - -@deffn Face widget-field-face -Face used for other editing fields. -@end deffn - -@subsection Buttons - -Some portions of the buffer have an associated @dfn{action}, which can -be @dfn{activated} by a standard key or mouse command. These portions -are called @dfn{buttons}. The default commands for activating a button -are: - -@table @kbd -@item @key{RET} -@deffn Command widget-button-press @var{pos} &optional @var{event} -Activate the button at @var{pos}, defaulting to point. -If point is not located on a button, activate the binding in -@code{widget-global-map} (by default the global map). -@end deffn - -@item mouse-2 -@deffn Command widget-button-click @var{event} -Activate the button at the location of the mouse pointer. If the mouse -pointer is located in an editable text field, activate the binding in -@code{widget-global-map} (by default the global map). -@end deffn -@end table - -There are several different kind of buttons, all of which are present in -the example: - -@table @emph -@item The Option Field Tags. -When you activate one of these buttons, you will be asked to choose -between a number of different options. This is how you edit an option -field. Option fields are created by the @code{menu-choice} widget. In -the example, @samp{@b{Choose}} is an option field tag. -@item The @samp{@b{[INS]}} and @samp{@b{[DEL]}} buttons. -Activating these will insert or delete elements from a editable list. -The list is created by the @code{editable-list} widget. -@item Embedded Buttons. -The @samp{@b{_other work_}} is an example of an embedded -button. Embedded buttons are not associated with a fields, but can serve -any purpose, such as implementing hypertext references. They are -usually created by the @code{link} widget. -@item The @samp{@b{[ ]}} and @samp{@b{[X]}} buttons. -Activating one of these will convert it to the other. This is useful -for implementing multiple-choice fields. You can create it wit -@item The @samp{@b{( )}} and @samp{@b{(*)}} buttons. -Only one radio button in a @code{radio-button-choice} widget can be selected at any -time. When you push one of the unselected radio buttons, it will be -selected and the previous selected radio button will become unselected. -@item The @samp{@b{[Apply Form]}} @samp{@b{[Reset Form]}} buttons. -These are explicit buttons made with the @code{push-button} widget. The main -difference from the @code{link} widget is that the buttons are will be -displayed as GUI buttons when possible. -enough. -@end table - -To make them easier to locate, buttons are emphasized in the buffer. - -@deffn Face widget-button-face -Face used for buttons. -@end deffn - -@defopt widget-mouse-face -Face used for buttons when the mouse pointer is above it. -@end defopt - -@subsection Navigation - -You can use all the normal Emacs commands to move around in a form -buffer, plus you will have these additional commands: - -@table @kbd -@item @key{TAB} -@deffn Command widget-forward &optional count -Move point @var{count} buttons or editing fields forward. -@end deffn -@item @key{M-TAB} -@deffn Command widget-backward &optional count -Move point @var{count} buttons or editing fields backward. -@end deffn -@end table - -@node Programming Example, Setting Up the Buffer, User Interface, Top -@comment node-name, next, previous, up -@section Programming Example - -Here is the code to implement the user interface example (see @ref{User -Interface}). - -@lisp -(require 'widget) - -(eval-when-compile - (require 'wid-edit)) - -(defvar widget-example-repeat) - -(defun widget-example () - "Create the widgets from the Widget manual." - (interactive) - (switch-to-buffer "*Widget Example*") - (kill-all-local-variables) - (make-local-variable 'widget-example-repeat) - (let ((inhibit-read-only t)) - (erase-buffer)) - (widget-insert "Here is some documentation.\n\nName: ") - (widget-create 'editable-field - :size 13 - "My Name") - (widget-create 'menu-choice - :tag "Choose" - :value "This" - :help-echo "Choose me, please!" - :notify (lambda (widget &rest ignore) - (message "%s is a good choice!" - (widget-value widget))) - '(item :tag "This option" :value "This") - '(choice-item "That option") - '(editable-field :menu-tag "No option" "Thus option")) - (widget-insert "Address: ") - (widget-create 'editable-field - "Some Place\nIn some City\nSome country.") - (widget-insert "\nSee also ") - (widget-create 'link - :notify (lambda (&rest ignore) - (widget-value-set widget-example-repeat - '("En" "To" "Tre")) - (widget-setup)) - "other work") - (widget-insert " for more information.\n\nNumbers: count to three below\n") - (setq widget-example-repeat - (widget-create 'editable-list - :entry-format "%i %d %v" - :notify (lambda (widget &rest ignore) - (let ((old (widget-get widget - ':example-length)) - (new (length (widget-value widget)))) - (unless (eq old new) - (widget-put widget ':example-length new) - (message "You can count to %d." new)))) - :value '("One" "Eh, two?" "Five!") - '(editable-field :value "three"))) - (widget-insert "\n\nSelect multiple:\n\n") - (widget-create 'checkbox t) - (widget-insert " This\n") - (widget-create 'checkbox nil) - (widget-insert " That\n") - (widget-create 'checkbox - :notify (lambda (&rest ignore) (message "Tickle")) - t) - (widget-insert " Thus\n\nSelect one:\n\n") - (widget-create 'radio-button-choice - :value "One" - :notify (lambda (widget &rest ignore) - (message "You selected %s" - (widget-value widget))) - '(item "One") '(item "Anthor One.") '(item "A Final One.")) - (widget-insert "\n") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (if (= (length (widget-value widget-example-repeat)) - 3) - (message "Congratulation!") - (error "Three was the count!"))) - "Apply Form") - (widget-insert " ") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (widget-example)) - "Reset Form") - (widget-insert "\n") - (use-local-map widget-keymap) - (widget-setup)) -@end lisp - -@node Setting Up the Buffer, Basic Types, Programming Example, Top -@comment node-name, next, previous, up -@section Setting Up the Buffer - -Widgets are created with @code{widget-create}, which returns a -@dfn{widget} object. This object can be queried and manipulated by -other widget functions, until it is deleted with @code{widget-delete}. -After the widgets have been created, @code{widget-setup} must be called -to enable them. - -@defun widget-create type [ keyword argument ]@dots{} -Create and return a widget of type @var{type}. -The syntax for the @var{type} argument is described in @ref{Basic Types}. - -The keyword arguments can be used to overwrite the keyword arguments -that are part of @var{type}. -@end defun - -@defun widget-delete widget -Delete @var{widget} and remove it from the buffer. -@end defun - -@defun widget-setup -Setup a buffer to support widgets. - -This should be called after creating all the widgets and before allowing -the user to edit them. -@refill -@end defun - -If you want to insert text outside the widgets in the form, the -recommended way to do that is with @code{widget-insert}. - -@defun widget-insert -Insert the arguments, either strings or characters, at point. -The inserted text will be read only. -@end defun - -There is a standard widget keymap which you might find useful. - -@defvr Const widget-keymap -A keymap with the global keymap as its parent.@* -@key{TAB} and @kbd{C-@key{TAB}} are bound to @code{widget-forward} and -@code{widget-backward}, respectively. @kbd{@key{RET}} and @kbd{mouse-2} -are bound to @code{widget-button-press} and -@code{widget-button-}.@refill -@end defvr - -@defvar widget-global-map -Keymap used by @code{widget-button-press} and @code{widget-button-click} -when not on a button. By default this is @code{global-map}. -@end defvar - -@node Basic Types, Sexp Types, Setting Up the Buffer, Top -@comment node-name, next, previous, up -@section Basic Types - -The syntax of a type specification is given below: - -@example -NAME ::= (NAME [KEYWORD ARGUMENT]... ARGS) - | NAME -@end example - -Where, @var{name} is a widget name, @var{keyword} is the name of a -property, @var{argument} is the value of the property, and @var{args} -are interpreted in a widget specific way. - -There following keyword arguments that apply to all widgets: - -@table @code -@item :value -The initial value for widgets of this type. - -@item :format -This string will be inserted in the buffer when you create a widget. -The following @samp{%} escapes are available: - -@table @samp -@item %[ -@itemx %] -The text inside will be marked as a button. - -@item %@{ -@itemx %@} -The text inside will be displayed with the face specified by -@code{:sample-face}. - -@item %v -This will be replaces with the buffer representation of the widgets -value. What this is depends on the widget type. - -@item %d -Insert the string specified by @code{:doc} here. - -@item %h -Like @samp{%d}, with the following modifications: If the documentation -string is more than one line, it will add a button which will toggle -between showing only the first line, and showing the full text. -Furthermore, if there is no @code{:doc} property in the widget, it will -instead examine the @code{:documentation-property} property. If it is a -lambda expression, it will be called with the widget's value as an -argument, and the result will be used as the documentation text. - -@item %t -Insert the string specified by @code{:tag} here, or the @code{princ} -representation of the value if there is no tag. - -@item %% -Insert a literal @samp{%}. -@end table - -@item :button-face -Face used to highlight text inside %[ %] in the format. - -@item :doc -The string inserted by the @samp{%d} escape in the format -string. - -@item :tag -The string inserted by the @samp{%t} escape in the format -string. - -@item :tag-glyph -Name of image to use instead of the string specified by `:tag' on -Emacsen that supports it. - -@item :help-echo -Message displayed whenever you move to the widget with either -@code{widget-forward} or @code{widget-backward}. - -@item :indent -An integer indicating the absolute number of spaces to indent children -of this widget. - -@item :offset -An integer indicating how many extra spaces to add to the widget's -grandchildren compared to this widget. - -@item :extra-offset -An integer indicating how many extra spaces to add to the widget's -children compared to this widget. - -@item :notify -A function called each time the widget or a nested widget is changed. -The function is called with two or three arguments. The first argument -is the widget itself, the second argument is the widget that was -changed, and the third argument is the event leading to the change, if -any. - -@item :menu-tag -Tag used in the menu when the widget is used as an option in a -@code{menu-choice} widget. - -@item :menu-tag-get -Function used for finding the tag when the widget is used as an option -in a @code{menu-choice} widget. By default, the tag used will be either the -@code{:menu-tag} or @code{:tag} property if present, or the @code{princ} -representation of the @code{:value} property if not. - -@item :match -Should be a function called with two arguments, the widget and a value, -and returning non-nil if the widget can represent the specified value. - -@item :validate -A function which takes a widget as an argument, and return nil if the -widgets current value is valid for the widget. Otherwise, it should -return the widget containing the invalid data, and set that widgets -@code{:error} property to a string explaining the error. - -@item :tab-order -Specify the order in which widgets are traversed with -@code{widget-forward} or @code{widget-backward}. This is only partially -implemented. - -@enumerate a -@item -Widgets with tabbing order @code{-1} are ignored. - -@item -(Unimplemented) When on a widget with tabbing order @var{n}, go to the -next widget in the buffer with tabbing order @var{n+1} or @code{nil}, -whichever comes first. - -@item -When on a widget with no tabbing order specified, go to the next widget -in the buffer with a positive tabbing order, or @code{nil} -@end enumerate - -@item :parent -The parent of a nested widget (e.g. a @code{menu-choice} item or an -element of a @code{editable-list} widget). - -@item :sibling-args -This keyword is only used for members of a @code{radio-button-choice} or -@code{checklist}. The value should be a list of extra keyword -arguments, which will be used when creating the @code{radio-button} or -@code{checkbox} associated with this item. - -@end table - -@deffn {User Option} widget-glyph-directory -Directory where glyphs are found. -Widget will look here for a file with the same name as specified for the -image, with either a @samp{.xpm} (if supported) or @samp{.xbm} extension. -@end deffn - -@deffn{User Option} widget-glyph-enable -If non-nil, allow glyphs to appear on displayes where they are supported. -@end deffn - - -@menu -* link:: -* url-link:: -* info-link:: -* push-button:: -* editable-field:: -* text:: -* menu-choice:: -* radio-button-choice:: -* item:: -* choice-item:: -* toggle:: -* checkbox:: -* checklist:: -* editable-list:: -@end menu - -@node link, url-link, Basic Types, Basic Types -@comment node-name, next, previous, up -@subsection The @code{link} Widget - -Syntax: - -@example -TYPE ::= (link [KEYWORD ARGUMENT]... [ VALUE ]) -@end example - -The @var{value}, if present, is used to initialize the @code{:value} -property. The value should be a string, which will be inserted in the -buffer. - -@node url-link, info-link, link, Basic Types -@comment node-name, next, previous, up -@subsection The @code{url-link} Widget - -Syntax: - -@example -TYPE ::= (url-link [KEYWORD ARGUMENT]... URL) -@end example - -When this link is activated, the @sc{www} browser specified by -@code{browse-url-browser-function} will be called with @var{url}. - -@node info-link, push-button, url-link, Basic Types -@comment node-name, next, previous, up -@subsection The @code{info-link} Widget - -Syntax: - -@example -TYPE ::= (info-link [KEYWORD ARGUMENT]... ADDRESS) -@end example - -When this link is activated, the build-in info browser is started on -@var{address}. - -@node push-button, editable-field, info-link, Basic Types -@comment node-name, next, previous, up -@subsection The @code{push-button} Widget - -Syntax: - -@example -TYPE ::= (push-button [KEYWORD ARGUMENT]... [ VALUE ]) -@end example - -The @var{value}, if present, is used to initialize the @code{:value} -property. The value should be a string, which will be inserted in the -buffer. - -The following extra properties are recognized. - -@table @code -@item :text-format -The format string used when the push button cannot be displayed -graphically. There are two escapes, @code{%s}, which must be present -exactly once, will be substituted with the tag, and @code{%%} will be -substituted with a singe @samp{%}. -@end table - -By default the tag will be shown in brackets. - -@node editable-field, text, push-button, Basic Types -@comment node-name, next, previous, up -@subsection The @code{editable-field} Widget - -Syntax: - -@example -TYPE ::= (editable-field [KEYWORD ARGUMENT]... [ VALUE ]) -@end example - -The @var{value}, if present, is used to initialize the @code{:value} -property. The value should be a string, which will be inserted in -field. This widget will match all string values. - -The following extra properties are recognized. - -@table @code -@item :size -The width of the editable field.@* -By default the field will reach to the end of the line. - -@item :value-face -Face used for highlighting the editable field. Default is -@code{widget-field-face}. - -@item :secret -Character used to display the value. You can set this to e.g. @code{?*} -if the field contains a password or other secret information. By -default, the value is not secret. - -@item :valid-regexp -By default the @code{:validate} function will match the content of the -field with the value of this attribute. The default value is @code{""} -which matches everything. - -@item :keymap -Keymap used in the editable field. The default value is -@code{widget-field-keymap}, which allows you to use all the normal -editing commands, even if the buffers major mode supress some of them. -Pressing return activates the function specified by @code{:activate}. - -@item :hide-front-space -@itemx :hide-rear-space -In order to keep track of the editable field, emacs places an invisible -space character in front of the field, and for fixed sized fields also -in the rear end of the field. For fields that extent to the end of the -line, the terminating linefeed serves that purpose instead. - -Emacs will try to make the spaces intangible when it is safe to do so. -Intangible means that the cursor motion commands will skip over the -character as if it didn't exist. This is safe to do when the text -preceding or following the widget cannot possible change during the -lifetime of the @code{editable-field} widget. The preferred way to tell -Emacs this, is to add text to the @code{:format} property around the -value. For example @code{:format "Tag: %v "}. - -You can overwrite the internal safety check by setting the -@code{:hide-front-space} or @code{:hide-rear-space} properties to -non-nil. This is not recommended. For example, @emph{all} text that -belongs to a widget (i.e. is created from its @code{:format} string) will -change whenever the widget changes its value. - -@end table - -@node text, menu-choice, editable-field, Basic Types -@comment node-name, next, previous, up -@subsection The @code{text} Widget - -This is just like @code{editable-field}, but intended for multiline text -fields. The default @code{:keymap} is @code{widget-text-keymap}, which -does not rebind the return key. - -@node menu-choice, radio-button-choice, text, Basic Types -@comment node-name, next, previous, up -@subsection The @code{menu-choice} Widget - -Syntax: - -@example -TYPE ::= (menu-choice [KEYWORD ARGUMENT]... TYPE ... ) -@end example - -The @var{type} arguments represents each possible choice. The widgets -value of will be the value of the chosen @var{type} argument. This -widget will match any value that matches at least one of the specified -@var{type} arguments. - -@table @code -@item :void -Widget type used as a fallback when the value does not match any of the -specified @var{type} arguments. - -@item :case-fold -Set this to nil if you don't want to ignore case when prompting for a -choice through the minibuffer. - -@item :children -A list whose car is the widget representing the currently chosen type in -the buffer. - -@item :choice -The current chosen type - -@item :args -The list of types. -@end table - -@node radio-button-choice, item, menu-choice, Basic Types -@comment node-name, next, previous, up -@subsection The @code{radio-button-choice} Widget - -Syntax: - -@example -TYPE ::= (radio-button-choice [KEYWORD ARGUMENT]... TYPE ... ) -@end example - -The @var{type} arguments represents each possible choice. The widgets -value of will be the value of the chosen @var{type} argument. This -widget will match any value that matches at least one of the specified -@var{type} arguments. - -The following extra properties are recognized. - -@table @code -@item :entry-format -This string will be inserted for each entry in the list. -The following @samp{%} escapes are available: -@table @samp -@item %v -Replaced with the buffer representation of the @var{type} widget. -@item %b -Replace with the radio button. -@item %% -Insert a literal @samp{%}. -@end table - -@item button-args -A list of keywords to pass to the radio buttons. Useful for setting -e.g. the @samp{:help-echo} for each button. - -@item :buttons -The widgets representing the radio buttons. - -@item :children -The widgets representing each type. - -@item :choice -The current chosen type - -@item :args -The list of types. -@end table - -You can add extra radio button items to a @code{radio-button-choice} -widget after it has been created with the function -@code{widget-radio-add-item}. - -@defun widget-radio-add-item widget type -Add to @code{radio-button-choice} widget @var{widget} a new radio button item of type -@var{type}. -@end defun - -Please note that such items added after the @code{radio-button-choice} -widget has been created will @strong{not} be properly destructed when -you call @code{widget-delete}. - -@node item, choice-item, radio-button-choice, Basic Types -@comment node-name, next, previous, up -@subsection The @code{item} Widget - -Syntax: - -@example -ITEM ::= (item [KEYWORD ARGUMENT]... VALUE) -@end example - -The @var{value}, if present, is used to initialize the @code{:value} -property. The value should be a string, which will be inserted in the -buffer. This widget will only match the specified value. - -@node choice-item, toggle, item, Basic Types -@comment node-name, next, previous, up -@subsection The @code{choice-item} Widget - -Syntax: - -@example -ITEM ::= (choice-item [KEYWORD ARGUMENT]... VALUE) -@end example - -The @var{value}, if present, is used to initialize the @code{:value} -property. The value should be a string, which will be inserted in the -buffer as a button. Activating the button of a @code{choice-item} is -equivalent to activating the parent widget. This widget will only match -the specified value. - -@node toggle, checkbox, choice-item, Basic Types -@comment node-name, next, previous, up -@subsection The @code{toggle} Widget - -Syntax: - -@example -TYPE ::= (toggle [KEYWORD ARGUMENT]...) -@end example - -The widget has two possible states, `on' and `off', which corresponds to -a @code{t} or @code{nil} value. - -The following extra properties are recognized. - -@table @code -@item :on -String representing the `on' state. By default the string @samp{on}. -@item :off -String representing the `off' state. By default the string @samp{off}. -@item :on-glyph -Name of a glyph to be used instead of the `:on' text string, on emacsen -that supports it. -@item :off-glyph -Name of a glyph to be used instead of the `:off' text string, on emacsen -that supports it. -@end table - -@node checkbox, checklist, toggle, Basic Types -@comment node-name, next, previous, up -@subsection The @code{checkbox} Widget - -The widget has two possible states, `selected' and `unselected', which -corresponds to a @code{t} or @code{nil} value. - -Syntax: - -@example -TYPE ::= (checkbox [KEYWORD ARGUMENT]...) -@end example - -@node checklist, editable-list, checkbox, Basic Types -@comment node-name, next, previous, up -@subsection The @code{checklist} Widget - -Syntax: - -@example -TYPE ::= (checklist [KEYWORD ARGUMENT]... TYPE ... ) -@end example - -The @var{type} arguments represents each checklist item. The widgets -value of will be a list containing the value of each ticked @var{type} -argument. The checklist widget will match a list whose elements all -matches at least one of the specified @var{type} arguments. - -The following extra properties are recognized. - -@table @code -@item :entry-format -This string will be inserted for each entry in the list. -The following @samp{%} escapes are available: -@table @samp -@item %v -Replaced with the buffer representation of the @var{type} widget. -@item %b -Replace with the checkbox. -@item %% -Insert a literal @samp{%}. -@end table - -@item button-args -A list of keywords to pass to the checkboxes. Useful for setting -e.g. the @samp{:help-echo} for each checkbox. - -@item :buttons -The widgets representing the checkboxes. - -@item :children -The widgets representing each type. - -@item :args -The list of types. -@end table - -@node editable-list, , checklist, Basic Types -@comment node-name, next, previous, up -@subsection The @code{editable-list} Widget - -Syntax: - -@example -TYPE ::= (editable-list [KEYWORD ARGUMENT]... TYPE) -@end example - -The value is a list, where each member represent one widget of type -@var{type}. - -The following extra properties are recognized. - -@table @code -@item :entry-format -This string will be inserted for each entry in the list. -The following @samp{%} escapes are available: -@table @samp -@item %v -This will be replaced with the buffer representation of the @var{type} -widget. -@item %i -Insert the @b{[INS]} button. -@item %d -Insert the @b{[DEL]} button. -@item %% -Insert a literal @samp{%}. -@end table - -@item :insert-button-args -A list of keyword arguments to pass to the insert buttons. - -@item :delete-button-args -A list of keyword arguments to pass to the delete buttons. - -@item :append-button-args -A list of keyword arguments to pass to the trailing insert button. - - -@item :buttons -The widgets representing the insert and delete buttons. - -@item :children -The widgets representing the elements of the list. - -@item :args -List whose car is the type of the list elements. - -@end table - -@node Sexp Types, Widget Properties, Basic Types, Top -@comment -@section Sexp Types - -A number of widgets for editing s-expressions (lisp types) are also -available. These basically fall in three categories: @dfn{atoms}, -@dfn{composite types}, and @dfn{generic}. - -@menu -* generic:: -* atoms:: -* composite:: -@end menu - -@node generic, atoms, Sexp Types, Sexp Types -@comment node-name, next, previous, up -@subsection The Generic Widget. - -The @code{const} and @code{sexp} widgets can contain any lisp -expression. In the case of the @code{const} widget the user is -prohibited from editing edit it, which is mainly useful as a component -of one of the composite widgets. - -The syntax for the generic widgets is - -@example -TYPE ::= (const [KEYWORD ARGUMENT]... [ VALUE ]) -@end example - -The @var{value}, if present, is used to initialize the @code{:value} -property and can be any s-expression. - -@deffn Widget const -This will display any valid s-expression in an immutable part of the -buffer. -@end deffn - -@deffn Widget sexp -This will allow you to edit any valid s-expression in an editable buffer -field. - -The @code{sexp} widget takes the same keyword arguments as the -@code{editable-field} widget. -@end deffn - -@node atoms, composite, generic, Sexp Types -@comment node-name, next, previous, up -@subsection Atomic Sexp Widgets. - -The atoms are s-expressions that does not consist of other -s-expressions. A string is an atom, while a list is a composite type. -You can edit the value of an atom with the following widgets. - -The syntax for all the atoms are - -@example -TYPE ::= (NAME [KEYWORD ARGUMENT]... [ VALUE ]) -@end example - -The @var{value}, if present, is used to initialize the @code{:value} -property and must be an expression of the same type as the widget. -I.e. the string widget can only be initialized with a string. - -All the atom widgets take the same keyword arguments as the @code{editable-field} -widget. - -@deffn Widget string -Allows you to edit a string in an editable field. -@end deffn - -@deffn Widget file -Allows you to edit a file name in an editable field. You you activate -the tag button, you can edit the file name in the mini-buffer with -completion. - -Keywords: -@table @code -@item :must-match -If this is set to non-nil, only existing file names will be allowed in -the minibuffer. -@end table -@end deffn - -@deffn Widget directory -Allows you to edit a directory name in an editable field. -Similar to the @code{file} widget. -@end deffn - -@deffn Widget symbol -Allows you to edit a lisp symbol in an editable field. -@end deffn - -@deffn Widget integer -Allows you to edit an integer in an editable field. -@end deffn - -@deffn Widget number -Allows you to edit a number in an editable field. -@end deffn - -@deffn Widget boolean -Allows you to edit a boolean. In lisp this means a variable which is -either nil meaning false, or non-nil meaning true. -@end deffn - - -@node composite, , atoms, Sexp Types -@comment node-name, next, previous, up -@subsection Composite Sexp Widgets. - -The syntax for the composite are - -@example -TYPE ::= (NAME [KEYWORD ARGUMENT]... COMPONENT...) -@end example - -Where each @var{component} must be a widget type. Each component widget -will be displayed in the buffer, and be editable to the user. - -@deffn Widget cons -The value of a @code{cons} widget is a cons-cell where the car is the -value of the first component and the cdr is the value of the second -component. There must be exactly two components. -@end deffn - -@deffn Widget lisp -The value of a @code{lisp} widget is a list containing the value of -each of its component. -@end deffn - -@deffn Widget vector -The value of a @code{vector} widget is a vector containing the value of -each of its component. -@end deffn - -The above suffice for specifying fixed size lists and vectors. To get -variable length lists and vectors, you can use a @code{choice}, -@code{set} or @code{repeat} widgets together with the @code{:inline} -keywords. If any component of a composite widget has the @code{:inline} -keyword set, its value must be a list which will then be spliced into -the composite. For example, to specify a list whose first element must -be a file name, and whose remaining arguments should either by the -symbol @code{t} or two files, you can use the following widget -specification: - -@example -(list file - (choice (const t) - (list :inline t - :value ("foo" "bar") - string string))) -@end example - -The value of a widget of this type will either have the form -@samp{(file t)} or @code{(file string string)}. - -This concept of inline is probably hard to understand. It was certainly -hard to implement so instead of confuse you more by trying to explain it -here, I'll just suggest you meditate over it for a while. - -@deffn Widget choice -Allows you to edit a sexp which may have one of fixed set of types. It -is currently implemented with the @code{choice-menu} basic widget, and -has a similar syntax. -@end deffn - -@deffn Widget set -Allows you to specify a type which must be a list whose elements all -belong to given set. The elements of the list is not significant. This -is implemented on top of the @code{checklist} basic widget, and has a -similar syntax. -@end deffn - -@deffn Widget repeat -Allows you to specify a variable length list whose members are all of -the same type. Implemented on top of the `editable-list' basic widget, -and has a similar syntax. -@end deffn - -@node Widget Properties, Defining New Widgets, Sexp Types, Top -@comment node-name, next, previous, up -@section Properties - -You can examine or set the value of a widget by using the widget object -that was returned by @code{widget-create}. - -@defun widget-value widget -Return the current value contained in @var{widget}. -It is an error to call this function on an uninitialized widget. -@end defun - -@defun widget-value-set widget value -Set the value contained in @var{widget} to @var{value}. -It is an error to call this function with an invalid @var{value}. -@end defun - -@strong{Important:} You @emph{must} call @code{widget-setup} after -modifying the value of a widget before the user is allowed to edit the -widget again. It is enough to call @code{widget-setup} once if you -modify multiple widgets. This is currently only necessary if the widget -contains an editing field, but may be necessary for other widgets in the -future. - -If your application needs to associate some information with the widget -objects, for example a reference to the item being edited, it can be -done with @code{widget-put} and @code{widget-get}. The property names -must begin with a @samp{:}. - -@defun widget-put widget property value -In @var{widget} set @var{property} to @var{value}. -@var{property} should be a symbol, while @var{value} can be anything. -@end defun - -@defun widget-get widget property -In @var{widget} return the value for @var{property}. -@var{property} should be a symbol, the value is what was last set by -@code{widget-put} for @var{property}. -@end defun - -@defun widget-member widget property -Non-nil if @var{widget} has a value (even nil) for property @var{property}. -@end defun - -Occasionally it can be useful to know which kind of widget you have, -i.e. the name of the widget type you gave when the widget was created. - -@defun widget-type widget -Return the name of @var{widget}, a symbol. -@end defun - -Widgets can be in two states: active, which means they are modifiable by -the user, or inactive, which means they cannot be modified by the user. -You can query or set the state with the following code: - -@lisp -;; Examine if @var{widget} is active or not. -(if (widget-apply @var{widget} :active) - (message "Widget is active.") - (message "Widget is inactive.") - -;; Make @var{widget} inactive. -(widget-apply @var{widget} :deactivate) - -;; Make @var{widget} active. -(widget-apply @var{widget} :activate) -@end lisp - -A widget is inactive if itself, or any of its ancestors (found by -following the @code{:parent} link) have been deactivated. To make sure -a widget is really active, you must therefore activate both itself, and -all its ancestors. - -@lisp -(while widget - (widget-apply widget :activate) - (setq widget (widget-get widget :parent))) -@end lisp - -You can check if a widget has been made inactive by examining the value -of @code{:inactive} keyword. If this is non-nil, the widget itself has -been deactivated. This is different from using the @code{:active} -keyword, in that the later tell you if the widget @strong{or} any of its -ancestors have been deactivated. Do not attempt to set the -@code{:inactive} keyword directly. Use the @code{:activate} -@code{:deactivated} keywords instead. - - -@node Defining New Widgets, Widget Wishlist., Widget Properties, Top -@comment node-name, next, previous, up -@section Defining New Widgets - -You can define specialized widgets with @code{define-widget}. It allows -you to create a shorthand for more complex widgets, including specifying -component widgets and default new default values for the keyword -arguments. - -@defun widget-define name class doc &rest args -Define a new widget type named @var{name} from @code{class}. - -@var{name} and class should both be symbols, @code{class} should be one -of the existing widget types. - -The third argument @var{DOC} is a documentation string for the widget. - -After the new widget has been defined, the following two calls will -create identical widgets: - -@itemize @bullet -@item -@lisp -(widget-create @var{name}) -@end lisp - -@item -@lisp -(apply widget-create @var{class} @var{args}) -@end lisp -@end itemize - -@end defun - -Using @code{widget-define} does just store the definition of the widget -type in the @code{widget-type} property of @var{name}, which is what -@code{widget-create} uses. - -If you just want to specify defaults for keywords with no complex -conversions, you can use @code{identity} as your conversion function. - -The following additional keyword arguments are useful when defining new -widgets: -@table @code -@item :convert-widget -Function to convert a widget type before creating a widget of that -type. It takes a widget type as an argument, and returns the converted -widget type. When a widget is created, this function is called for the -widget type and all the widgets parent types, most derived first. - -@item :value-to-internal -Function to convert the value to the internal format. The function -takes two arguments, a widget and an external value, and returns the -internal value. The function is called on the present @code{:value} -when the widget is created, and on any value set later with -@code{widget-value-set}. - -@item :value-to-external -Function to convert the value to the external format. The function -takes two arguments, a widget and an internal value, and returns the -internal value. The function is called on the present @code{:value} -when the widget is created, and on any value set later with -@code{widget-value-set}. - -@item :create -Function to create a widget from scratch. The function takes one -argument, a widget type, and create a widget of that type, insert it in -the buffer, and return a widget object. - -@item :delete -Function to delete a widget. The function takes one argument, a widget, -and should remove all traces of the widget from the buffer. - -@item :value-create -Function to expand the @samp{%v} escape in the format string. It will -be called with the widget as its argument. Should -insert a representation of the widgets value in the buffer. - -@item :value-delete -Should remove the representation of the widgets value from the buffer. -It will be called with the widget as its argument. It doesn't have to -remove the text, but it should release markers and delete nested widgets -if such has been used. - -@item :format-handler -Function to handle unknown @samp{%} escapes in the format string. It -will be called with the widget and the escape character as arguments. -You can set this to allow your widget to handle non-standard escapes. - -You should end up calling @code{widget-default-format-handler} to handle -unknown escape sequences, which will handle the @samp{%h} and any future -escape sequences, as well as give an error for unknown escapes. -@end table - -If you want to define a new widget from scratch, use the @code{default} -widget as its base. - -@deffn Widget default [ keyword argument ] -Widget used as a base for other widgets. - -It provides most of the functionality that is referred to as ``by -default'' in this text. -@end deffn - -@node Widget Wishlist., , Defining New Widgets, Top -@comment node-name, next, previous, up -@section Wishlist. - -@itemize @bullet -@item -It should be possible to add or remove items from a list with @kbd{C-k} -and @kbd{C-o} (suggested by @sc{rms}). - -@item -The @samp{[INS]} and @samp{[DEL]} buttons should be replaced by a single -dash (@samp{-}). The dash should be a button that, when activated, ask -whether you want to add or delete an item (@sc{rms} wanted to git rid of -the ugly buttons, the dash is my idea). - -@item -Widgets such as @code{file} and @code{symbol} should prompt with completion. - -@item -The @code{menu-choice} tag should be prettier, something like the abbreviated -menus in Open Look. - -@item -The functions used in many widgets, like -@code{widget-item-convert-widget}, should not have names that are -specific to the first widget where I happended to use them. - -@item -Flag to make @code{widget-move} skip a specified button. - -@item -Document `helper' functions for defining new widgets. - -@item -Activate the item this is below the mouse when the button is -released, not the item this is below the mouse when the button is -pressed. Dired and grep gets this right. Give feedback if possible. - -@item -Use @samp{@@deffn Widget} to document widgets. - -@item -Document global keywords in one place. - -Document keywords particular to a specific widget in the widget -definition. - -Document the `default' widget first. - -Split, when needed, keywords into those useful for normal -customization, those primarily useful when deriving, and those who -represent runtime information. - -@item -Figure out terminology and @sc{api} for the class/type/object/super -stuff. - -Perhaps the correct model is delegation? - -@item -Document @code{widget-browse}. - -@item -Make indentation work with glyphs and propertional fonts. - -@item -Add object and class hierarchies to the browser. - -@end itemize - -@contents -@bye -- 1.7.10.4