+2002-12-05 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * etc/smilies/*.pbm: Made them binary.
+
+2002-11-13 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * etc/smilies/blink.xpm: Changed smileys and some new ones from
+ Alex Schroeder <alex@emacswiki.org>.
+
2002-04-26 Steve Youngs <youngs@xemacs.org>
* aclocal.m4 (AC_PATH_INFODIR): New. Defaults to '$prefix/info'
\f
* Changes in Oort Gnus
+** Improved anti-speam features.
+
+** Easy inclusion of X-Faces headers.
+
+** In the summary buffer, the new command / N inserts new messages and
+/ o inserts old messages.
+
+** Gnus decodes morse encoded messages if you press W m.
+
+** Unread count correct in nnimap groups.
+
+The estimated number of unread articles in the group buffer should now
+be correct for nnimap groups. This is achieved by calling
+`nnimap-fixup-unread-after-getting-new-news' from the
+`gnus-setup-news-hook' (called on startup) and
+gnus-after-getting-new-news-hook. (called after getting new mail). If
+you have modified those variables from the default, you may want to
+add n-f-u-a-g-n-n again. If you were happy with the estimate and want
+to save some (minimal) time when getting new mail, remove the
+function.
+
+** Group Carbon Copy (GCC) quoting
+
+To support groups that contains SPC and other weird characters, groups
+are quoted before they are placed in the Gcc: header. This means
+variables such as `gnus-message-archive-group' should no longer
+contain quote characters to make groups containing SPC work. Also, if
+you are using the string "nnml:foo, nnml:bar" (indicating Gcc into two
+groups) you must change it to return the list ("nnml:foo" "nnml:bar"),
+otherwise the Gcc: line will be quoted incorrectly. Note that
+returning the string "nnml:foo, nnml:bar" was incorrect earlier, it
+just didn't generate any problems since it was inserted directly.
+
+** ~/News/overview/ not used.
+
+As a result of the following change, the ~/News/overview/ directory is
+not used any more. You can safely delete the entire hierarchy.
+
** gnus-agent
-The Gnus Agent is now enabled by default. This means that, e.g.,
-headers are not downloaded from agentized servers by default (agentize
-servers by using `J a' in the server buffer). Gnus will not start to
-download articles unless you instruct it to do so, though, by using
-e.g. J u or J s from the group buffer. Revert to the old behaviour
+The Gnus Agent has seen a major updated and is now enabled by default,
+and all nntp and nnimap servers from gnus-select-method and
+gnus-secondary-select-method are agentized by default. Earlier only
+the server in gnus-select-method was agentized by the default, and the
+agent was disabled by default. When the agent is enabled, headers are
+now also retrieved from the Agent cache instead of the backends when
+possible. Earlier this only happened in the unplugged state. You can
+enroll or remove servers with `J a' and `J r' in the server buffer.
+Gnus will not download articles into the Agent cache, unless you
+instruct it to do so, though, by using `J u' or `J s' from the Group
+buffer. You revert to the old behaviour of having the Agent disabled
with `(setq gnus-agent nil)'. Note that putting (gnus-agentize) in
~/.gnus is not needed any more.
buffers. Also, each individual MIME part can be printed using p on
the MIME button.
-** Message supports the Importance: header.
+** Message supports the Importance: (RFC 2156) header.
In the message buffer, C-c C-f C-i or C-u cycles through the valid values.
("^han\\>" euc-kr) -> ("\\(^\\|:\\)han\\>" euc-kr)
** Gnus supports PGP (RFC 1991/2440), PGP/MIME (RFC 2015/3156) and
-S/MIME (RFC 2630-2633).
+** S/MIME (RFC 2630-2633).
+It needs an external S/MIME and OpenPGP implementation, but no additional
+lisp libraries.
** Gnus inlines external parts (message/external).
This change was made to avoid conflict with the standard binding of
`back-to-indentation', which is also useful in message mode.
+** Bug fixes.
+
\f
* Changes in Pterodactyl Gnus (5.8/5.9)
gnus-mdrtn.el
on-loginfo
+request-assign.future
+2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * hashcash.el: New version from Paul Foley with new
+ mail-check-payment function.
+
2002-06-22 Simon Josefsson <jas@extundo.com>
* hashcash.el: New file.
;;; hashcash.el --- Add hashcash payments to email
-;; $Revision: 1.1.1.1 $
+;; $Revision: 1.1.1.2 $
;; Copyright (C) 1997,2001 Paul E. Foley
;; Maintainer: Paul Foley <mycroft@actrix.gen.nz>
See `hashcash-payment-alist'."
:type 'integer)
-(defcustom hashcash-payment-alist nil
+(defcustom hashcash-payment-alist '()
"*An association list mapping email addresses to payment amounts.
Elements may consist of (ADDR AMOUNT) or (ADDR STRING AMOUNT), where
ADDR is the email address of the intended recipient and AMOUNT is
the value of hashcash payment to be made to that user. STRING, if
present, is the string to be hashed; if not present ADDR will be used.")
-(defcustom hashcash "hashcash"
+(defcustom hashcash-default-accept-payment 10
+ "*The default minimum number of bits to accept on incoming payments."
+ :type 'integer)
+
+(defcustom hashcash-accept-resources `((,(user-mail-address) nil))
+ "*An association list mapping hashcash resources to payment amounts.
+Resources named here are to be accepted in incoming payments. If the
+corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment'
+is used instead.")
+
+(defcustom hashcash "/usr/local/bin/hashcash"
"*The path to the hashcash binary.")
+(defcustom hashcash-double-spend-database "hashcash.db"
+ "*The path to the double-spending database.")
+
+(defcustom hashcash-in-news nil
+ "*Specifies whether or not hashcash payments should be made to newsgroups."
+ :type 'boolean)
+
(require 'mail-utils)
(defun hashcash-strip-quoted-names (addr)
(buffer-substring (point-at-bol) (point-at-eol)))
nil))
+(defun hashcash-check-payment (token str val)
+ "Check the validity of a hashcash payment."
+ (zerop (call-process hashcash nil nil nil "-c"
+ "-d" "-f" hashcash-double-spend-database
+ "-b" (number-to-string val)
+ "-r" str
+ token)))
+
+;;;###autoload
(defun hashcash-insert-payment (arg)
- "Insert an X-Hashcash header with a payment for ARG"
+ "Insert X-Payment and X-Hashcash headers with a payment for ARG"
(interactive "sPay to: ")
(let ((pay (hashcash-generate-payment (hashcash-payment-to arg)
(hashcash-payment-required arg))))
(when pay
+ (insert-before-markers "X-Payment: hashcash 1.1 " pay "\n")
(insert-before-markers "X-Hashcash: " pay "\n"))))
;;;###autoload
+(defun hashcash-verify-payment (token &optional resource amount)
+ "Verify a hashcash payment"
+ (let ((key (cadr (split-string-by-char token ?:))))
+ (cond ((null resource)
+ (let ((elt (assoc key hashcash-accept-resources)))
+ (and elt (hashcash-check-payment token (car elt)
+ (or (cadr elt) hashcash-default-accept-payment)))))
+ ((equal token key)
+ (hashcash-check-payment token resource
+ (or amount hashcash-default-accept-payment)))
+ (t nil))))
+
+;;;###autoload
(defun mail-add-payment (&optional arg)
- "Add an X-Hashcash: header with a hashcash payment for each recipient address
-Prefix arg sets default payment temporarily."
+ "Add X-Payment: and X-Hashcash: headers with a hashcash payment
+for each recipient address. Prefix arg sets default payment temporarily."
(interactive "P")
(let ((hashcash-default-payment (if arg (prefix-numeric-value arg)
hashcash-default-payment))
(narrow-to-region (point-min) (point))
(let ((to (hashcash-strip-quoted-names (mail-fetch-field "To" nil t)))
(cc (hashcash-strip-quoted-names (mail-fetch-field "Cc" nil t)))
- (ng (hashcash-strip-quoted-names
- (mail-fetch-field "Newsgroups" nil t))))
+ (ng (hashcash-strip-quoted-names (mail-fetch-field "Newsgroups"
+ nil t))))
(when to
(setq addrlist (split-string to ",[ \t\n]*")))
(when cc
(setq addrlist (nconc addrlist (split-string cc ",[ \t\n]*"))))
- (when ng
+ (when (and hashcash-in-news ng)
(setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*")))))
(when addrlist
(mapc #'hashcash-insert-payment addrlist)))))
t)
+;;;###autoload
+(defun mail-check-payment (&optional arg)
+ "Look for a valid X-Payment: or X-Hashcash: header.
+Prefix arg sets default accept amount temporarily."
+ (interactive "P")
+ (let ((hashcash-default-accept-payment (if arg (prefix-numeric-value arg)
+ hashcash-default-accept-payment)))
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward mail-header-separator)
+ (beginning-of-line)
+ (let ((end (point))
+ (ok nil))
+ (goto-char (point-min))
+ (while (and (not ok) (search-forward "X-Payment: hashcash 1.1 " end t))
+ (setq ok (hashcash-verify-payment
+ (buffer-substring (point) (point-at-eol)))))
+ (goto-char (point-min))
+ (while (and (not ok) (search-forward "X-Hashcash: " end t))
+ (setq ok (hashcash-verify-payment
+ (buffer-substring (point) (point-at-eol)))))
+ (when ok
+ (message "Payment valid"))
+ ok))))
+
(provide 'hashcash)
;;; hashcash.el ends here
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 <URL:http://www.ifi.uio.no/~larsi/larsi.html>.
+heart's delight at <URL:http://www.gnus.org/> and
+<URL:http://quimby.gnus.org/lmi/>.
;; Copyright (C) 1995 Free Software Foundation, Inc.
version
*.elc
gnus-load.el
+old
-2002-08-04 01:48:57 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+2003-01-05 01:40:09 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.08 is released.
+
+2003-01-04 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-util.el: Add mm-string-make-unibyte.
+
+ * gnus-group.el (gnus-group-jump-to-group): Make it work for
+ UTF-8 groups.
+
+2003-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-variable-list): Write gnus-format-specs last.
+
+ * gnus-sum.el (gnus-summary-goto-subjects): Fix typo.
+
+2003-01-04 Kevin Ryde <user42@zip.com.au>
+
+ * gnus-art.el (gnus-mime-jka-compr-maybe-uncompress): New
+ function.
+
+2003-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-exit): Bind gnus-group-is-exiting-p.
+ (gnus-summary-read-group-1): Update group line.
+ (gnus-summary-exit-no-update): Update group on exit.
+
+ * gnus-group.el (gnus-group-line-format): Add %*.
+ (gnus-group-line-format-alist): Ditto.
+ (gnus-group-insert-group-line): Set it.
+ (gnus-group-is-exiting-p): New variable.
+ (gnus-group-insert-group-line): Use it.
+
+2003-01-03 Teodor Zlatanov <tzz@beld.net>
+
+ * spam.el (spam-enter-ham-BBDB, spam-BBDB-register-routine):
+ enable BBDB ham processing
+ (spam-blacklist-register-routine): enable blacklist spam processing
+ (spam-whitelist-register-routine): enable whitelist ham processing
+ (spam-fetch-field-from-fast): fast fetching of the "from" field
+ from (gnus-data-list)
+ (spam-summary-prepare-exit): works completely now
+ (spam-use-blacklist): oops, should be nil by default
+ (spam-summary-prepare-exit): spam-use-PROCESSOR is only for
+ split processing now; before it was for summary exit as
+ well but that's done with the spam-contents and spam-process
+ parameters now
+
+2003-01-03 Jesper Harder <harder@ifa.au.dk>
+
+ * mml.el (mml-insert-tag): Don't quote non-ASCII unibyte
+ characters.
+
+2003-01-02 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-group-spam-contents-p, spam-group-ham-contents-p)
+ (spam-group-processor-p, spam-group-processor-bogofilter-p)
+ (spam-group-processor-ifile-p, spam-group-processor-blacklist-p)
+ (spam-group-processor-whitelist-p, spam-group-processor-BBDB-p)
+ (spam-mark-spam-as-expired-and-move-routine)
+ (spam-generic-register-routine, spam-BBDB-register-routine)
+ (spam-ifile-register-routine, spam-blacklist-register-routine)
+ (spam-whitelist-register-routine): new functions
+ (spam-summary-prepare-exit): added summary exit processing (expire
+ or move) of spam-marked articles for spam groups; added slots for
+ all the spam-*-register-routine functions
+
+2003-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * pop3.el (pop3-retr): Wait 500 msecs.
+ (pop3-read-response): Ditto.
+
+ * gnus-msg.el (gnus-setup-message): Get the evaliation order
+ right.
+ (gnus-inews-make-draft): New function.
+ (gnus-setup-message): Use it.
+
+ * message.el (message-required-headers): Add From.
+
+2003-01-02 Katsumi Yamaoka <yamaoka@jpl.org>
+ Trivial patch from Norbert Koch <nk@viteno.net>.
+
+ * gnus-msg.el (gnus-gcc-externalize-attachments): Fix typo.
+
+2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-generate-headers): Let header formatters do
+ their work.
+
+2003-01-02 Raymond Scholz <ray-2003@zonix.de>
+
+ * deuglify.el (gnus-article-outlook-deuglify-article):
+ Rehighlight, reapply treatments and call
+ `gnus-article-prepare-hook'. Suggested by Niels Olof Bouvin.
+ (gnus-outlook-repair-attribution-block): Recognize cited
+ attributions. Suggested by Niklas Morberg.
+
+2003-01-02 Pete Kazmier <pete@kazmier.com>
+
+ * gnus-art.el (gnus-treat-predicate): Check condition first.
+
+2003-01-02 Jesper Harder <harder@ifa.au.dk>
+
+ * lpath.el: Add url-http-file-exists-p.
+
+ * gnus-group.el (gnus-group-fetch-charter): Use
+ http://TLH.news-admin.org/charters/GROUPNAME as a fallback.
+
+2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-draft-headers): Also generate From to get a
+ nicer draft buffer summary.
+
+ * gnus-xmas.el (gnus-xmas-read-event-char): Take an optional
+ parameter.
+
+ * gnus-art.el (article-wash-html): Clean up.
+ (article-wash-html): Typo fix.
+
+ * gnus-msg.el (gnus-summary-mail-forward): Clean up.
+ (gnus-summary-mail-forward): To many lists of lists.
+
+ * gnus-art.el (article-wash-html): Clean up.
+
+2003-01-02 pete-temp <pete-temp-12-29-2002@kazmier.com>
+
+ * gnus-art.el (gnus-treat-wash-html): New variable.
+
+2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-check-news-header-syntax): Allow posting.
+ (message-check-news-header-syntax): Fix logic for sure, this
+ time.
+
+2003-01-02 Matthieu Moy <Matthieu.Moy@imag.fr>
+
+ * message.el (message-check-news-header-syntax): Check syntax of
+ continuation headers.
+
+2003-01-02 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-button-url-regexp,
+ (gnus-button-mid-or-mail-regexp, gnus-button-alist,
+ (gnus-header-button-alist): Regexps are case insensitive here.
+
+2003-01-02 Simon Josefsson <jas@extundo.com>
+
+ * dig.el (query-dig): Doc fix.
+
+2003-01-02 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-fetch-selected-article): Update whole
+ summary buffer line, not just the download mark.
+
+2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-goto-subjects): New function.
+ (gnus-summary-insert-dormant-articles): New command and
+ keystroke.
+
+ * gnus-cache.el (gnus-summary-insert-cached-articles): Use new
+ function for mass insertion of subjects.
+
+ * nndraft.el (nndraft-generate-headers): Don't move point.
+
+ * gnus.el (nnheader): Require nnheader.
+
+ * nndraft.el (nndraft-request-associate-buffer): Use
+ make-local-variable.
+
+2003-01-02 Michael Shields <shields@msrl.com>
+
+ * nndraft.el (nndraft-request-associate-buffer): Make
+ write-contents-hooks buffer-local before setting it.
+
+2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-group-parameter-value): Take an extra param.
+ (gnus-group-fast-parameter): Let group param results be nil.
+
+ * gnus-art.el (gnus-article-forward-header): New function.
+ (article-date-ut): Use it to remove continuation date headers.
+
+ * gnus-sum.el (gnus-summary-walk-group-buffer): Supply prompt to
+ read-event.
+ (gnus-summary-remove-bookmark): Clean up.
+ (gnus-summary-set-bookmark): Clean up.
+
+ * gnus-util.el (gnus-read-event-char): Take an optional prompt.
+
+ * gnus.el (gnus-group-startup-message): Bind data-directory to
+ the Gnus etc directory.
+
+2003-01-01 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-summary-prepare-exit): added slots for spam- and
+ ham-processing of articles; use the new
+ spam-group-(spam|ham)-contents-p functions
+ (spam-group-spam-contents-p, spam-group-ham-contents-p): new
+ convenience functions
+ (spam-mark-junk-as-spam-routine): use the new
+ spam-group-spam-contents-p function
+
+ * gnus.el (spam-process, spam-contents, spam-process-destination):
+ added new parameters with corresponding global variables
+ (gnus-group-spam-exit-processor-ifile,
+ gnus-group-spam-exit-processor-bogofilter,
+ gnus-group-spam-exit-processor-blacklist,
+ gnus-group-spam-exit-processor-whitelist,
+ gnus-group-spam-exit-processor-BBDB,
+ gnus-group-spam-classification-spam,
+ gnus-group-spam-classification-ham): added new symbols for the
+ spam-process and spam-contents parameters
+
+ * spam.el (spam-ham-marks, spam-spam-marks): changed list
+ customization and list itself to store mark symbol rather than
+ mark character.
+ (spam-bogofilter-register-routine): added logic to generate mark
+ values list from spam-ham-marks and spam-spam-marks, so (member)
+ would work.
+
+2003-01-02 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-cross-post-followup-to): Fix comment.
+
+2003-01-01 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-ham-marks, spam-spam-marks): changed list
+ customization and list itself to store mark symbol rather than
+ mark character.
+ (spam-bogofilter-register-routine): added logic to generate mark
+ values list from spam-ham-marks and spam-spam-marks, so (member)
+ would work.
+
+2003-01-01 Raymond Scholz <ray-2002@zonix.de>
+
+ * message.el (message-signature-insert-empty-line): New variable.
+
+2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el: Renamed functions and variables: "xpost" ->
+ "cross-post", "-fup2" -> "-followup-to".
+ (message-cross-post-old-target, message-cross-post-default,
+ message-cross-post-note, message-followup-to-note,
+ message-cross-post-note-function): New variables names.
+ (message-xpost-old-target, message-xpost-default,
+ message-xpost-note, message-fup2-note,
+ message-xpost-note-function): Removed variable names.
+ (message-cross-post-followup-to-header,
+ message-cross-post-insert-note, message-cross-post-followup-to):
+ New function names.
+ (message-xpost-fup2-header, message-xpost-insert-note,
+ message-xpost-fup2): Removed function names.
+
+2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-send-mail): Added message-cleanup-headers to
+ prevent newlines in headers.
+
+2003-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dns.el (dns-make-network-process): Comment.
+
+ * gnus-sum.el (gnus-summary-display-while-building): Default to
+ nil.
+
+2003-01-01 Wes Hardaker <wes@hardakers.net>
+
+ * gnus-sum.el (gnus-summary-display-while-building): New
+ variable.
+
+2003-01-01 Raymond Scholz <ray-2003@zonix.de>
+
+ * deuglify.el (gnus-outlook-rearrange-article): Kill overlays
+ before rearranging the article.
+
+2003-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nndraft.el (nndraft-generate-headers): New function.
+ (nndraft-request-associate-buffer): Use it to write headers on
+ buffer save.
+
+ * message.el (message-generate-headers): Let the function be a
+ lambda form.
+ (message-draft-headers): New variable.
+
+ * gnus-msg.el (gnus-inews-make-draft-meta-information): New
+ function.
+ (gnus-setup-message): Use it.
+
+ * message.el (message-generate-headers-first): Doc fix.
+ (message-setup-1): Use new function for getting which headers to
+ generate.
+ (message-headers-to-generate): New function.
+
+2003-01-01 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-save-alist): Make directory.
+
+2002-12-31 Reiner Steib <4uce.02.r.steib@gmx.net>
+
+ * gnus-sum.el (gnus-summary-limit-to-age): Make prompt string
+ mention negatives.
+
+2002-12-31 Raymond Scholz <ray-2002@zonix.de>
+
+ * deuglify.el (gnus-outlook-rearrange-article): Use
+ `transpose-regions' instead of tempering the kill-ring.
+ (gnus-article-outlook-deuglify-article): Rehighlight article
+ instead of a complete redisplay.
+
+2002-12-31 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: most defvars are defcustoms now
+
+ patches from Michael Shields <shields@msrl.com>
+
+ * spam.el (spam-bogofilter-articles): Select the article
+ body using gnus-summary-show-article t instead of
+ gnus-summary-select-article; this presents the raw text
+ without running any hooks.
+
+ * spam.el (spam-bogofilter-articles): Use message-remove-header
+ to remove headers; the old way incorrectly removed just the first
+ line of folded headers.
+
+2002-12-31 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-start.el (gnus-load): Replace `ding-file' with `file'.
+
+2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-start.el (gnus-load): New function.
+ (gnus-read-newsrc-el-file): Use it.
+
+2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-button-valid-fqdn-regexp): New variable.
+ (gnus-button-handle-apropos-documentation): New function.
+ (gnus-button-handle-ctan): New function.
+ (gnus-button-alist): Use them. Improve some regexps.
+ (gnus-button-prefer-mid-or-mail): Addition to doc-string.
+
+2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-subscribed-p): New function.
+ (message-send-mail): Use it.
+ * mml.el (mml-preview-insert-mft): New function.
+ (mml-preview): Use it.
+
+2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-thread-latest-date): Protect against errors
+ when sorting by date.
+
+ * gnus-art.el (gnus-article-edit-mode): New variable.
+ (gnus-article-setup-buffer): Warn user about discarding edits.
+
+ * gnus-sum.el (gnus-summary-pipe-output): Clean up.
+ (gnus-summary-pipe-output): Take a symbolic prefix to save all
+ headers.
+
+ * mm-uu.el (mm-uu-configure-list): Default to (shar . disabled).
+
+2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-completion-alist): Added "Mail-Followup-To"
+ and "Mail-Copies-To".
+
+2002-07-21 Jesper harder <harder@ifa.au.dk>
+
+ * gnus-group.el: Add key bindings for
+ gnus-group-sort-groups-by-real-name and
+ gnus-group-sort-selected-groups-by-real-name.
+
+2002-07-21 Jesper harder <harder@ifa.au.dk>
+
+ * gnus.texi (Sorting Groups): Add key bindings for
+ gnus-group-sort-groups-by-real-name and
+ gnus-group-sort-selected-groups-by-real-name.
+
+2002-12-30 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-use-dig): new variable for blackhole checking
+ through dig.el
+ (spam-check-blackholes): added dig.el checking functionality and
+ more verbose reporting; query-dig is autoloaded from dig.el
+ (spam-use-blackholes): disabled by default
+ (spam-blackhole-servers): removed rbl.maps.vix.com from the
+ blackhole servers list
+
+2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-required-headers): New variable.
+
+2002-12-30 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * dig.el (query-dig): new function
+
+2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * flow-fill.el (fill-flowed): Don't infloop on too long fill
+ prefixes.
+
+ * dns.el (query-dns): Protect against errors.
+
+ * gnus-msg.el (gnus-article-yanked-articles): New variable.
+ (gnus-inews-add-send-actions): Mark all answered messages as
+ answered.
+
+2002-08-10 Jari Aalto <jari.aalto@poboxes.com>
+
+ * nnmail.el (nnmail-split-it): Added tracing to
+ `:' split rule
+
+2002-08-13 Hrvoje Niksic <hniksic@xemacs.org>
+
+ * mm-decode.el (mm-mailcap-command): Remove the quotes around '%s'
+ and "%s" so we don't overquote them.
+
+2002-08-13 Hrvoje Niksic <hniksic@xemacs.org>
+
+ * (mm-display-external): Display the actual command that has been
+ executed in the echo area.
+
+2002-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-topic.el (gnus-topic-display-missing-topic): Bind entry.
+
+ * message.el (message-with-reply-buffer): New macro.
+ (message-fetch-reply-field): Use it.
+ (message-insert-wide-reply): New command and keystroke.
+ (message-carefully-insert-headers): New function.
+ (message-insert-to): Use new function.
+
+ * gnus-topic.el (gnus-topic-display-missing-topic): New function.
+ (gnus-topic-goto-missing-group): Use it.
+
+ * message.el (message-required-news-headers): Removed Lines.
+ (message-reply): Don't insert References first.
+ (message-followup): Ditto.
+ (message-make-references): New function.
+ (message-followup): Set message-reply-headers before generating
+ the buffer stuff.
+
+2002-12-29 Jesper Harder <harder@ifa.au.dk>
+
+ * mml.el (mml-generate-mime-1): Reverse the order of
+ encoding/flowing.
+
+2002-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnmail.el (nnmail-expiry-target-group): Mark articles as read
+ after moving them.
+
+ * gnus-sum.el (gnus-summary-dummy-line-format): Update format to
+ fit with newer standard format.
+ (gnus-summary-make-false-root-always): New variable.
+ (gnus-gather-threads-by-subject): Use it.
+
+ * message.el (message-get-reply-headers): Take an address list
+ optional argument.
+
+2002-12-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-keep-backlog): Change default to 20.
+
+ * gnus-agent.el (gnus-agent-check-overview-buffer): Start from
+ start.
+ (gnus-agent-check-overview-buffer): Remove negative article
+ numbers.
+
+ * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups): Doc fix.
+ (nnmail-cache-ignore-groups): Doc fix.
+
+ * nnimap.el (nnimap-debug): Made into a flag and defcustomed.
+ (nnimap-debug-buffer): New variable.
+ (nnimap-debug): Use it.
+
+2002-12-28 Lars Magne Ingebrigtsen <kgreiner@xpediantsolutions.com>
+
+ * gnus.el (gnus-summary-high-uncached-face): New color scheme.
+
+2002-12-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-check-overview-buffer): Sort lines if
+ they aren't already sorted.
+
+2002-12-28 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-mode-menu): Add ellipses to menu items
+ expecting user interaction.
+ (message-mode-field-menu): do.
+
+2002-12-26 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-highlight-line): Don't bind `list' --
+ it isn't used any more.
+
+2002-12-22 Jesper Harder <harder@ifa.au.dk>
+
+ * binhex.el (binhex-decoder-program): Fix docstring.
+
+2002-12-21 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * mm-decode.el (mm-mailcap-command): Do not backslash-quote
+ special chars if the mailcap file uses single quotes around %s.
+ From Laurent Martelli <laurent@bearteam.org>.
+
+2002-12-19 Paul Jarc <prj@po.cwru.edu>
+
+ * gnus-int.el (gnus-request-update-info): nnchoke-r-u-i might not
+ return the info object.
+
+2002-12-18 Paul Jarc <prj@po.cwru.edu>
+
+ * gnus-int.el (gnus-request-update-info): Artificially add
+ (1 . (1- min)) to the read range, in case the backend doesn't
+ store marks for nonexistent articles.
+
+2002-12-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * binhex.el (binhex-insert-char): Eval-and-compile.
+
+2002-12-17 Jesper Harder <harder@ifa.au.dk>
+
+ * lpath.el: Add tool-bar-local-item-from-menu.
+
+ * message.el (message-tool-bar-local-item-from-menu): New function.
+ (message-tool-bar-map): Use it.
+
+2002-12-14 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-uu.el (gnus-uu-digest-headers): Mention nil value in docstring.
+
+ * gnus-art.el (gnus-article-header-rank): Last header in
+ gnus-sorted-header-list should have higher rank than non-members.
+
+2002-12-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-close-agent): Don't blank out the list of
+ covered methods.
+
+2002-12-12 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * nntp.el (nntp-with-open-group-first-pass): Do not wrap in
+ eval-when-compile. Suggested by Kevin Greiner.
+
+2002-12-13 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-max-fetch-size): New, defcustom.
+ (gnus-agent-fetch-headers): Initialize gnus-agent-overview-buffer
+ even though no headers may have been fetched
+ (gnus-agent-fetch-group-1, and perhaps others, require this
+ behavior).
+ (gnus-agent-fetch-group-1): Fetch articles in chucks so that the
+ server buffer is constrained by gnus-agent-max-fetch-size.
+ Multiple chunks in the same group may perform arbitrarily large
+ updates.
+
+2002-12-12 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-fetch-selected-article): Added call to
+ gnus-summary-update-download-mark to update the article in the
+ summary.
+
+2002-12-11 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus.el (gnus-summary-high-uncached-face,
+ gnus-summary-normal-uncached-face, gnus-summary-low-uncached-face)
+ New faces.
+
+ * gnus-agent.el (gnus-agent-downloaded-article-face): REMOVED. I
+ added this on 2002-11-23 but it just wasn't working out as
+ intended. The idea isn't entirely dead, three new faces
+ gnus-summary-*-uncached-face are being added to gnus.el to provide
+ the basis for an improved implementation.
+ (gnus-agent-read-servers): Undo the change made on 2002-11-23. The
+ proper file to open is lib/servers.
+ (gnus-summary-set-agent-mark): Expanded documentation. Unmarking
+ (i.e. removing the article from gnus-newsgroup-downloadable) will
+ now restore the article's default mark rather than simply setting
+ no mark.
+ (gnus-agent-get-undownloaded-list): Corrected documentation.
+ Added code to set new summary local variable,
+ gnus-newsgroup-agentized. Reworked impl so that it doesn't create
+ a temporary list. No longer sets gnus-newsgroup-downloadable.
+ (gnus-agent-summary-fetch-group): Keep gnus-newsgroup-undownloaded
+ up to date. Call new gnus-summary-update-download-mark to keep
+ summary buffer up-to-date.
+ (gnus-agent-fetch-selected-article): Keep
+ gnus-newsgroup-undownloaded up to date.
+ (gnus-agent-fetch-articles): Return list of articles that were
+ successfully fetched.
+ (gnus-agent-check-overview-buffer): No more thingatpt.
+ (gnus-agent-expire): No longer deletes NOV entries of unread
+ articles.
+ (gnus-agent-unread-articles): New function.
+ (gnus-agent-regenerate-group): The article number must be
+ terminated by a tab character. Added more messages to report
+ repairs. Inhibit quits while writing changes so it is now safe
+ have to quit regeneration. Renamed gnus-tmp-downloaded back to
+ downloaded to 1) resolve the unbound references and 2) avoid
+ confusing this list with the gnus-tmp-downloaded in gnus-sum.el
+
+ * gnus-art.el (gnus-article-prepare): The agent
+ downloaded/undownloaded mark is no longer stored as the article's
+ mark.
+
+ * gnus-salt.el (gnus-tree-highlight-node): Added uncached as
+ gnus-summary-highlight may use it. Added downloaded as
+ gnus-summary-highlight was using it.
+
+ * gnus-sum.el (gnus-undownloaded-mark): Changed from ?@ to ?- as
+ the download mark now follows Kai's +/- convention.
+ (gnus-downloaded-mark): Added ?+ mark.
+ (gnus-summary-highlight): Added rules to select
+ gnus-summary-high-uncached-face,
+ gnus-summary-normal-uncached-face, and
+ gnus-summary-low-uncached-face. Removed the
+ gnus-agent-downloaded-article-face.
+ (gnus-summary-line-format-alist): Implemented the download flag
+ format (?O) as named in the manual. This implementation displays
+ either gnus-undownloaded-mark, gnus-downloaded-mark, or
+ gnus-no-mark.
+ (gnus-newsgroup-agentized): New local variable that identifies
+ which groups are agentized. While the agent is now on by default,
+ you don't have to agentize every server that you use.
+ (gnus-update-summary-mark-positions): Completed support for the
+ download type of mark.
+ (gnus-summary-insert-line): Added undownloaded to the parameters.
+ (gnus-summary-prepare-threads): Set gnus-tmp-downloaded for
+ reference by the gnus-summary-line-format-spec.
+
+ * nntp.el (nntp-with-open-group): This macro handles dropped or
+ broken connections by opening a new connection and repeating the
+ failed command.
+ (nntp-retrieve-headers-with-xover): Some NNTP servers respond to
+ XOVER commands preceeding the active articles with the nov entry
+ of the first available article. When gnus connected to such a
+ server, the unexpected nov entry would result in duplicate lines
+ in the agent's overview file. This patch fixes the duplicate
+ lines problem and improves performance by skipping over all
+ articles IDs that preceed the first nov entry in the server's
+ reply.
+
+2002-12-11 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-tmp-downloaded): New internal variable.
+ (gnus-summary-highlight): Use it instead of `downloaded'.
+ (gnus-summary-highlight-line): Ditto.
+
+ * gnus-agent.el (gnus-agent-regenerate-group): Ditto.
+
+2002-12-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-variable-list): Add gnus-agent-covered-methods.
+
+ * gnus-agent.el (gnus-agent-check-overview-buffer): Remove debug
+ calls.
+
+ * gnus-sum.el (gnus-summary-highlight-line): Don't set the
+ downloaded variable if we're in an uncovered group.
+
+ * gnus-agent.el (gnus-agent-downloaded-article-face): Change the
+ font to soemthing less noticeable.
+ (gnus-agent-group-covered-p): New function.
+
+2002-12-09 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-braid-nov): Remove corrupted lines.
+ Because of an unknown bug, the group buffer is saved in .overview
+ file.
+
+2002-12-09 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * nntp.el (nntp-send-command): Braino in last commit. Replace
+ `and' with `or'.
+
+2002-12-08 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * nntp.el (nntp-send-command): Assume that echo does not happen
+ when nntp-open-connection-function is nntp-open-network-stream.
+ Suggested by Sebastian D.B. Krause <krause@my.gnus.org>.
+
+2002-12-07 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnslashdot.el (nnslashdot-retrieve-headers-1): Update the parser.
+
+2002-12-06 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir-request-group): bugfix: don't erase
+ nntp-server-buffer if we aren't going to write to it.
+
+2002-12-04 Katsumi Yamaoka <yamaoka@jpl.org>
+ Trivial patch from Itai Zukerman <zukerman@math-hat.com>.
+
+ * mm-decode.el (mm-w3m-safe-url-regexp): Fix parenthesis.
+
+2002-12-04 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * rfc2047.el (rfc2047-decode-region): Remove newlines between
+ decoded words.
+
+2002-12-03 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus.el (fboundp): After loading mm-util, make sure it was the
+ right one.
+
+2002-11-29 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-art.el (gnus-inhibit-mime-unbuttonizing): Moved here from
+ gnus-sum. Made into a user option.
+
+ * gnus-sum.el (gnus-simplify-ignored-prefixes)
+ (gnus-summary-mark-article-as-unread)
+
+2002-11-29 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * time-date.el (date-to-time): Typo.
+
+ * parse-time.el: Typo.
+
+ * nnsoup.el (nnsoup-retrieve-headers): Typo.
+
+ * nnmail.el (nnmail-split, nnmail-process-unix-mail-format): Typos.
+
+ * nnimap.el:
+ (nnimap-split-rule, nnimap-find-minmax-uid): Typos.
+
+ * mm-encode.el (mm-safer-encoding): Typo.
+
+ * messcompat.el: Typo.
+
+ * message.el (message-face-alist): Typo.
+
+ * imap.el (imap-interactive-login, imap-open): Typos.
+
+ * ietf-drums.el (ietf-drums-text-token, ietf-drums-qtext-token): Typos.
+
+ * gnus.el: Typo.
+
+ * gnus-win.el (gnus-configure-frame): Typo.
+
+ * gnus-util.el (gnus-atomic-progn-assign): Typo.
+
+ * gnus-topic.el (gnus-topic-sort-topics): Typo.
+
+ * gnus-sum.el (gnus-summary-article-number)
+ (gnus-summary-read-group-1, gnus-summary-mark-article)
+ (gnus-summary-fetch-faq, gnus-refer-article-methods): Typos.
+
+ * gnus-mule.el (gnus-mule-add-group): Typo.
+
+ * gnus-mlspl.el (gnus-group-split-fancy): Typo.
+
+ * gnus-group.el (gnus-group-fetch-faq): Typo.
+
+ * gnus-art.el (gnus-decode-header-methods): Typo.
+
+ * flow-fill.el: Typo.
+
+2002-11-19 Stefan Monnier <monnier@cs.yale.edu>
+
+ * binhex.el (binhex-decode-region): Don't hardcode point-min == 1.
+
+2002-11-29 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-sum.el (gnus-simplify-ignored-prefixes)
+ (gnus-summary-mark-article-as-unread)
+ (gnus-mark-article-as-unread, gnus-summary-highlight-line):
+ Reformatting to avoid long lines.
+ (gnus-inhibit-mime-unbuttonizing): Moved to gnus-art.
+
+2002-11-28 Daiki Ueno <ueno@unixuser.org>
+
+ * gnus-agent.el (gnus-agent-fetch-group-1): Article numbers should
+ be accessed through `mail-header-number'.
+
+2002-11-27 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-sum.el (gnus-summary-insert-old-articles): No longer passes
+ compressed range to gnus-summary-insert-articles.
+
+2002-11-26 Kevin Ryde <user42@zip.com.au>
+
+ * gnus-art.el (gnus-mime-copy-part): Look for filename
+ parameter under content-disposition, not content-type.
+
+ * gnus-sum.el (gnus-summary-find-uncancelled): New function.
+ (gnus-summary-reselect-current-group): Use it.
+
+2002-11-26 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-uncached-articles): if
+ gnus-agent-load-alist fails, return ARTICLES.
+
+ * nnrss.el (nnrss-group-alist): Update the link of Jabber.
+
+2002-11-26 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-sum.el (gnus-summary-insert-old-articles): Remove
+ superfluous function call.
+ (gnus-summary-catchup-all, gnus-summary-catchup-all-and-exit):
+ Add warning to docstring.
+
+2002-11-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-agent.el: Autoload number-at-point instead.
+ (gnus-agent-check-overview-buffer): No warning for deactivate-mark.
+
+2002-11-26 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-check-overview-buffer): Explicitly
+ require thingatpt (for number-at-point) and protect against
+ deactivate-mark being unbound (on XEmacs).
+
+2002-11-25 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-check-overview-buffer): Make debugger
+ print message on entry.
+
+ From Kevin Greiner <kgreiner@xpediantsolutions.com>.
+
+ * gnus-range.el (gnus-range-difference): New function.
+ * gnus-sum.el (gnus-summary-insert-old-articles): Use it.
+
+2002-11-24 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-sum.el (gnus-summary-insert-old-articles): Use
+ gnus-remove-from-range instead of gnus-range-difference which
+ doesn't exist.
+
+2002-11-23 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+ From Kevin Greiner <kgreiner@xpediantsolutions.com>.
+
+ * gnus-agent.el (gnus-agent-downloaded-article-face): New face,
+ used for showing which articles have been downloaded.
+ (gnus-agent-article-alist): Format change. Add documentation.
+ (gnus-agent-summary-mode-map): New keybinding `J s' for fetching
+ process-marked articles.
+ (gnus-agent-summary-fetch-series): Command for `J s'. Articles
+ in the series are individually fetched to minimize lose of
+ content due to an error/quit.
+ (gnus-agent-synchronize-flags-server, gnus-agent-add-server): Use
+ gnus-message instead of message.
+ (gnus-agent-read-servers): Use file lib/methods instead of
+ lib/servers. TODO: Why?
+ (gnus-summary-set-agent-mark): Adapt to new agent-alist format.
+ (gnus-agent-get-undownloaded-list): Remove articles that appear to
+ come from the agent. This means that they are not downloaded.
+ (gnus-agent-fetch-selected-article): Don't use history.
+ (gnus-agent-save-history, gnus-agent-enter-history)
+ (gnus-agent-article-in-history-p, gnus-agent-history-path):
+ Removed function; history is not used anymore.
+ (gnus-agent-fetch-articles): Fix handling of crossposted articles.
+ (gnus-agent-crosspost): Started rewrite then realized that a typo
+ in gnus-agent-fetch-articles ensures that this function is never
+ called. This will need to be fixed later.
+ (gnus-agent-check-overview-buffer): Some sanity checks on the
+ agent overview buffer. This is a safety net used during
+ development.
+ (gnus-agent-flush-cache): The gnus-agent-article-alist format has
+ changed, write a number to the file indicating this.
+ (gnus-agent-fetch-headers): Rewrite to respect
+ gnus-agent-consider-all-articles without relying on the
+ `.fetched' files. Make it fast.
+ (gnus-agent-braid-nov): Change resulting from
+ gnus-agent-fetch-headers change.
+ (gnus-agent-load-alist, gnus-agent-save-alist): Don't use
+ `.fetched' files.
+ (gnus-agent-read-agentview): New function, used by
+ gnus-agent-load-alist.
+ (gnus-agent-load-fetched-headers): Remove.
+ (gnus-agent-save-alist): Rewrite to accomodate new format.
+ (gnus-agent-fetch-group-1): Make sure list of articles is in the
+ same order as in gnus-newsgroup-headers.
+ (gnus-agent-expire): Document and implement extra args ARTICLES,
+ GROUP, FORCE. Do not restrict usage.
+ (gnus-agent-uncached-articles): New function.
+ (gnus-agent-retrieve-headers): Use it.
+ (gnus-agent-regenerate-group): No longer needs to be called from
+ gnus-agent-regenerate. Individual groups may be regenerated. The
+ regeneration code now fixes duplicate, and mis-ordered, NOV entries.
+ The article fetch dates are validated in the article alist. The
+ article alist is pruned of entries that do not reference existing
+ NOV entries. All changes are computed then applied with
+ inhibit-quit bound to t. As a result, it is now safe to quit out of
+ regeneration. The optional clean parameter has been replaced with
+ an optional reread parameter. Clean is no longer necessary as
+ regeneration gets the appropriate setting from
+ gnus-agent-consider-all-articles. The new reread parameter will
+ result in fetched, or all, articles being marked as unread.
+ (gnus-agent-regenerate): Removed code to regenerate the history
+ file as it is no longer used.
+
+ * gnus-start.el (gnus-make-ascending-articles-unread): New
+ function, for efficient mass-marking.
+
+ * gnus-sum.el (gnus-summary-highlight): Use new face for
+ downloaded articles.
+ (gnus-article-mark): Prefer to indicate read/unread status over
+ downloaded status.
+ (gnus-summary-highlight-line-0): New function, maybe rehighlights
+ line.
+ (gnus-summary-highlight-line): Use new face for downloaded
+ articles.
+ (gnus-summary-insert-old-articles): Improved performance by
+ replacing the initial LIST of older articles with a compressed
+ RANGE of older articles. Some servers appear to lie about
+ their active range so the original list could contain millions
+ of article numbers. The range is not expanded into a list
+ until the optional ALL parameter has been applied.
+
+2002-11-18 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-category-mode): Typo in doc string.
+
+2002-11-21 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el:
+ added patch from Andreas Fuchs <asf@void.at> to prevent apply errors
+
+ * spam.el: added `M s t' and `M s x' key mappings
+
+2002-11-20 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-morse-message): Narrow to body.
+
+2002-11-19 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-morse-message): Load
+ morse.el (unmorse-region not autoloaded in Emacs 20 nor XEmacs).
+ (unmorse-region): Autoload it instead.
+
+2002-11-18 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-morse-message): New function.
+ (gnus-summary-wash-map): Bind to `W m'.
+ (gnus-summary-make-menu-bar): Add.
+
+ * nnimap.el (nnimap-request-expire-articles): Compress sequence
+ before storing \Deleted mark on expired articles.
+
+2002-11-17 Shenghuo Zhu <zsh@cs.rochester.edu>
+ Trivial patch from Markus Rost <rost@math.ohio-state.edu>
+
+ * gnus-sum.el (gnus-summary-goto-unread): Doc fix - escape open
+ parens in column 0.
+
+2002-11-17 Juanma Barranquero <lektu@terra.es>
+
+ * nnweb.el (nnweb-google-create-mapping): Fix typo.
+
+ * nnlistserv.el (nnlistserv-kk-create-mapping): Likewise.
+
+ * gnus-nocem.el (gnus-nocem-liberal-fetch): Likewise.
+
+2002-11-17 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-set-auto-save-file-name): Use
+ make-directory, to avoid the dependence on gnus-util.
+
+2002-11-16 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-callback-callback-function):
+ (nnimap-callback-buffer): Removed, these cannot be global but must
+ be embedded into the callback.
+ (nnimap-make-callback): New. Embedd article number, callback and
+ buffer in function.
+ (nnimap-callback, nnimap-request-article-part): Update.
+
+2002-11-15 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mml.el (mml-preview): Bind message-this-is-mail if it is mail.
+
+2002-11-13 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus.el (gnus-summary-line-format): Document %C.
+
+2002-11-11 Simon Josefsson <jas@extundo.com>
+
+ * pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify): Display
+ output when called interactively.
+
+2002-11-08 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-edit-exit): Kill local variables.
+
+ * message.el (message-draft-coding-system): Improve comment; use
+ mm-auto-save-coding-system for the default value.
+
+ * nndraft.el (nndraft-request-article): Revert to the state before
+ 2002-10-29; regexp-quote mail-header-separator.
+
+2002-11-06 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-draft.el (gnus-draft-setup): Set gnus-message-group-art to
+ allow editing of drafts from an nnvirtual group.
+
+2002-11-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nndraft.el (nndraft-request-article): Replace emacs-mule with
+ mm-auto-save-coding-system.
+
+ * message.el (message-draft-coding-system): Default to
+ iso-2022-7bit.
+
+ * mm-util.el (mm-auto-save-coding-system): Undo last change to
+ restore the default value to emacs-mule or escape-quoted.
+
+2002-11-05 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-encrypt-body): Inhibit encrypting of
+ a delayed or a queued article as well as a draft.
+
+ * gnus-sum.el (gnus-summary-edit-article): Inhibit editing of a
+ delayed or a queued article in the raw format; treat a delayed
+ article as a raw article as well as a draft.
+ (gnus-summary-setup-default-charset): Clear gnus-newsgroup-charset
+ for the delayed group.
+
+ * nndraft.el (nndraft-request-article): Ignore auto save files for
+ a delayed or a queued article; don't bother to decode a queued
+ article; don't bind nnmail-file-coding-system for a queued article.
+
+ * nnmail.el (nnmail-split-fancy-with-parent): Ignore the delayed
+ and the queue group.
+
+2002-11-04 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-group.el (gnus-group-delete-group):
+ gnus-cache-active-hashtb might be void.
+
+2002-11-02 Simon Josefsson <jas@extundo.com>
+
+ * pgg-gpg.el (pgg-gpg-encrypt-region): Makes PGG respect the
+ setting of the default user ID. From Raymond Scholz
+ <ray-2002@zonix.de>.
+
+2002-11-01 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-bodies.el (mm-body-encoding): Don't return 8bit for 7bit
+ charset.
+
+2002-10-31 Ted Zlatanov <tzz@lifelogs.com>
+ From Alex Schroeder <alex@emacswiki.org>
+ * spam-stat.el (spam-stat-process-directory): add dir to message
+ (spam-stat-reduce-size): No longer remove words
+ with values close to 0.5, because the default value is 0.2.
+
+2002-10-31 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-util.el (gnus-user-date-format-alist): Clarify and correct
+ documentation.
+
+2002-10-28 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-fetched-headers)
+ (gnus-agent-load-fetched-headers)
+ (gnus-agent-save-fetched-headers): Remove variable and two
+ functions. Kevin Greiner's version of gnus-agent-fetch-headers
+ works better.
+ (gnus-agent-fetch-headers): New implementation from Kevin
+ Greiner. Uses gnus-agent-article-alist to store information
+ about fetched messages which aren't on the server anymore. The
+ trick is to return a list of considered messages to the caller,
+ but to only fetch those which haven't been fetched yet.
+
+2002-10-30 Simon Josefsson <jas@extundo.com>
+
+ * pgg-def.el (pgg-passphrase-cache-expiry): New, defcustom.
+
+ * pgg.el (pgg-passphrase-cache-expiry): Removed.
+
+2002-10-30 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * mm-view.el (mm-w3m-local-map-property): Make it work with older
+ versions of emacs-w3m than 1.3.3.
+
+ * lpath.el: Bind w3m-minor-mode-map.
+
+ * mm-view.el (mm-w3m-mode-command-alist)
+ (mm-w3m-mode-dont-bind-keys, mm-w3m-mode-ignored-keys): Removed.
+ (mm-w3m-mode-map): Undefined for Emacs21 and XEmacs.
+ (mm-setup-w3m): Simplified.
+ (mm-w3m-local-map-property): New function.
+ (mm-inline-text-html-render-with-w3m): Use it.
+
+ * gnus-art.el (gnus-article-wash-html-with-w3m): Use
+ mm-w3m-local-map-property.
+
+2002-10-29 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-util.el (mm-auto-save-coding-system): Default to
+ iso-2022-7bit.
+
+ * nndraft.el (nndraft-request-article): Decode an article using
+ the coding-system emacs-mule if it seems to have been saved using
+ emacs-mule.
+ (nndraft-request-replace-article): Use message-draft-coding-system
+ instead of mm-auto-save-coding-system for the draft or delayed
+ group.
+
+2002-10-28 Josh <huber@alum.wpi.edu>
+
+ * mml.el (mml-mode-map): Fixed keybindings for mml-secure-*
+ functions.
+
+2002-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
+ From mah@everybody.org (Mark A. Hershberger).
+
+ * mm-url.el (mm-url-insert-file-contents): Make it return the same
+ type values ("url" size) regardless of the values of
+ mm-url-use-external.
+
+2002-10-26 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * nnimap.el (nnimap-request-article-part): Try harder to show
+ group name in debugging message.
+
+2002-10-25 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-save-fetched-headers): Create
+ directory if it doesn't exist.
+ (gnus-agent-fetch-headers): Remove old cruft that tried to
+ abstain from downloading articles more than once if
+ gnus-agent-consider-all-articles was true. This is now done
+ properly via the .fetched files.
+
+2002-10-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nndraft.el (nndraft-request-article): Treat delayed articles
+ like drafts.
+
+2002-10-24 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-agent.el (gnus-agent-load-alist): Fix parenthesis.
+
+2002-10-24 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-save-alist, gnus-agent-load-alist):
+ Remove unused optional arg DIR and corresponding code.
+
+ * nnimap.el (nnimap-request-article-part): Include group name in
+ debugging output.
+
+2002-10-24 Paul Jarc <prj@po.cwru.edu>
+
+ * gnus-agent.el (gnus-agent-fetch-headers): Add some comments.
+
+2002-10-23 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-fetched-headers): New variable,
+ contains range of headers that have been fetched by the agent
+ already. Compare gnus-agent-article-alist.
+ (gnus-agent-file-header-cache): Like
+ gnus-agent-file-loading-cache, but for gnus-agent-fetched-headers.
+ (gnus-agent-fetch-headers): Improve comment. Revert to old
+ seen/recent logic.
+ Remember which headers have been fetched before and don't fetch
+ them again the next time round.
+ (gnus-agent-load-fetched-headers)
+ (gnus-agent-save-fetched-headers): New functions, for remembering
+ which headers have been fetched before.
+
+2002-10-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lpath.el: Remove useless bindings.
+
+2002-10-22 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-execute-command): Disable visual
+ features while searching.
+
+2002-10-22 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * pgg.el (pgg-snarf-keys): Do not refer unbinded local variables.
+
+2002-10-22 Simon Josefsson <jas@extundo.com>
+
+ * pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify)
+ (pgg-snarf-keys): Add.
+
+2002-10-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lpath.el: Fbind bbdb-records.
+
+ * spam.el: Don't autoload bbdb-records.
+
+2002-10-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * spam.el: Set autoload for bbdb-records after loading bbdb-com to
+ prevent inf-loop.
+
+2002-10-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnslashdot.el: Removed some test lines.
+ More test.
+
+2002-10-21 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-agent.el (gnus-agent-fetch-headers): Remove articles that
+ are known to be downloaded already.
+
+2002-10-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-view.el (mm-text-html-renderer-alist): Add w3m-standalone.
+ (mm-text-html-washer-alist): Ditto.
+
+2002-10-19 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * nnheader.el (nnheader-remove-body): Fix an error of detecting
+ boundary between headers and body.
+ * nnml.el (nnml-parse-head): Ditto.
+
+2002-10-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnslashdot.el (nnslashdot-generate-active): Ignore any bogus
+ entries.
+
+ * gnus-group.el (gnus-fetch-group): Allow an optional
+ specification of the articles to select.
+
+ * gnus-srvr.el (gnus-server-prepare): Removed superfluous cdr.
+
+2002-10-20 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-agent.el (gnus-agent-fetch-group-1): After fetching
+ headers from the group, update variable `articles' to contain
+ only those numbers where headers exist. (When fetching all
+ articles in a group, Gnus creates lots of numbers where there is
+ no articles.)
+
+2002-10-20 Steve Youngs <youngs@xemacs.org>
+
+ * pgg-parse.el (pgg-parse-public-key-algorithm-alist): XEmacs
+ doesn't have the 'alist custom type, use cons cells instead.
+ (pgg-parse-symmetric-key-algorithm-alist): Ditto.
+ (pgg-parse-hash-algorithm-alist): Ditto.
+ (pgg-parse-compression-algorithm-alist): Ditto.
+ (pgg-parse-signature-type-alist): Ditto.
+
+ * pgg-gpg.el (pgg-gpg-extra-args): Fix custom mismatch.
+
+ * pgg-pgp5.el (pgg-pgp5-extra-args): Ditto.
+
+ * pgg-pgp.el (pgg-pgp-extra-args): Ditto.
+
+2002-10-19 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-open-server): Check imap-state in IMAP server
+ buffer.
+
+2002-10-18 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-spec.el (gnus-make-format-preserve-properties)
+ (gnus-xmas-format, gnus-parse-simple-format): Preserve text
+ properties also on XEmacs. `gnus-xmas-format' is like format but
+ preserves text properties on XEmacs (though it only understands
+ simple format specs). The variable
+ `gnus-make-format-preserve-properties' controls whether the
+ function is used, and is checked in `gnus-parse-simple-format'.
+ Patch by Paul Moore <gustav@morpheus.demon.co.uk>.
+
+ * gnus-agent.el (gnus-agent-fetch-articles): More debugging
+ output.
+ (gnus-agent-consider-all-articles): New variable.
+ (gnus-agent-get-undownloaded-list): Comment that marks todo item.
+ (gnus-agent-fetch-headers): Depending on
+ gnus-agent-consider-all-articles, maybe get all articles.
+ (gnus-category-predicate-alist, gnus-agent-read-p): New predicate
+ `read'.
+ (gnus-predicate-imples-unread): New function.
+ (gnus-agent-fetch-headers): Optimize to call
+ gnus-list-of-unread-articles if that is sufficient.
+ Check unseen and recent instead of seen and recent.
+ (gnus-agent-fetch-headers): Abstain from calling
+ gnus-list-range-intersection if range (a . b) would have (> a b).
+
+2002-10-18 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-send-mail): Make it possible to perform
+ edebug-defun.
+
+2002-10-18 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-button-man-handler): Change default to
+ `manual-entry' (defined in both emacsen).
+ (gnus-button-man-handler): Remove emacsen difference and use
+ `manual-entry'.
+
+2002-10-18 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * spam.el: Wrap autoload settings for bbdb-records,
+ executable-find and ifile-spam-filter with eval-and-compile.
+ (spam-display-buffer-contents): Remove.
+ (spam-bogofilter-score): Merge spam-display-buffer-contents.
+
+2002-10-17 Ted Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-display-buffer-contents): New function.
+ (spam-bogofilter-score): use spam-display-buffer-contents, patch
+ from Katsumi Yamaoka <yamaoka@jpl.org>.
+
+2002-10-17 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * nnheader.el (nnheader-parse-naked-head): New function.
+ (nnheader-parse-head): Use the above function, in order to handle
+ continuation lines properly.
+ (nnheader-remove-body): New function.
+ (nnheader-remove-cr-followed-by-lf): New function.
+ (nnheader-ms-strip-cr): Use the above function.
+
+ * gnus-agent.el (gnus-agent-regenerate-group): Call
+ `nnheader-remove-body'; use `nnheader-parse-naked-head' instead of
+ `nnheader-parse-head'.
+ * gnus-cache.el (gnus-cache-possibly-enter-article): Ditto.
+
+ * gnus-msg.el (gnus-inews-yank-articles): Do not unfold
+ continuation lines by itself; call `nnheader-parse-naked-head'
+ instead of `nnheader-parse-head'.
+ * nndiary.el (nndiary-parse-head): Ditto.
+ * nnfolder.el (nnfolder-parse-head): Ditto.
+ * nnimap.el (nnimap-retrieve-headers-progress): Ditto.
+ * nnmaildir.el (nnmaildir--update-nov): Ditto.
+ * nnml.el (nnml-parse-head): Ditto.
+
+2002-10-17 Steve Youngs <youngs@xemacs.org>
+
+ * gnus-art.el (gnus-button-man-handler): Add 'manual-entry' for
+ XEmacs, default to it if featurep 'xemacs.
+
+2002-10-16 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * spam-stat.el: Check for the existence of hash functions instead
+ of the Emacs version to decide whether to load cl. Suggested by
+ Kai Gro\e,A_\e(Bjohann.
+
+2002-10-15 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-agent.el (gnus-agent-fetch-selected-article): Open history
+ if it isn't open yet.
+
+2002-10-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-group.el: Require mm-url only when compiling.
+ (gnus-group-fetch-charter): Require mm-url.
+
+ * spam-stat.el: Require cl for the functions gethash,
+ hash-table-count, make-hash-table and mapc for Emacs 20.
+ (puthash): Alias to cl-puthash for Emacs 20.
+ (with-syntax-table): New macro for Emacs 20.
+
+2002-10-12 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-spec.el (gnus-pad-form): Use gnus-string-width-function.
+
+2002-10-11 Ted Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-check-ifile): added ifile as a spam checking
+ backend, and spam-use-ifle as the variable to toggle that check.
+
+2002-10-12 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-beginning-of-line): New variable.
+ (message-beginning-of-line): Use it.
+
+2002-10-11 Ted Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: more compilation fixes for BBDB
+
+ * spam-stat.el added code from Alex Schroeder <alex@gnu.org>
+ (spam-stat-reduce-size): Interactive.
+ (spam-stat-reset): New function.
+ (spam-stat-save): Interactive.
+
+2002-10-11 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el: Autoload gnus-delay-initialize.
+
+ * message.el: Autoload gnus-delay-article.
+
+2002-10-11 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-spec.el (gnus-balloon-face-function): Use the help-echo
+ text property in Emacs.
+
+2002-10-11 Simon Josefsson <jas@extundo.com>
+
+ * mml2015.el (mml2015-pgg-decrypt, mml2015-pgg-clear-decrypt)
+ (mml2015-pgg-verify, mml2015-pgg-clear-verify): Remove CR.
+
+ * mml1991.el (mml1991-pgg-sign): Remove CR.
+
+2002-10-10 Simon Josefsson <jas@extundo.com>
+
+ * mml2015.el (mml2015-pgg-decrypt): Set gnus details even when
+ decrypt failed.
+ (mml2015-trust-boundaries-alist): Removed.
+ (mml2015-gpg-extract-signature-details): Don't use it.
+ (mml2015-unabbrev-trust-alist): New.
+ (mml2015-gpg-extract-signature-details): Use it.
+
+2002-10-10 Ted Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: compilation fixes, spam-check-bbdb function is nil if no
+ BBDB installed
+
+ * spam-stat.el: added code from Alex Schroeder <alex@gnu.org> to do
+ statistical analysis of spam in Lisp only
+
+2002-10-10 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-open-server): Re-open server if it isn't in
+ auth, selected or examine state.
+
+ * pgg-gpg.el (pgg-gpg-verify-region): Filter out stuff into output
+ buffer and error buffer depending on type of information.
+
+ * mml2015.el (mml2015-gpg-extract-signature-details): Parse
+ --status-fd stuff even if gpg.el is not used (revert earlier
+ change).
+ (mml2015-pgg-{clear-,}verify): Store both output and errors as
+ gnus details.
+ (mml2015-pgg-{clear-,}verify): Extract signature info from errors
+ buffer.
+
+ * pgg.el (pgg-verify-region): Use it.
+
+ * pgg-def.el (pgg-query-keyserver): New variable.
+
+ * pgg.el (pgg-decrypt-region): Bind pgg-default-user-id to
+ key-identifier in packet. Is this a good idea?
+
+ * mml.el (mml-mode-map): Add security commands that operates on
+ MIME parts.
+ (mml-menu): And menu items for them.
+
+ * mml1991.el (mml1991-pgg-encrypt): Remove headers.
+
+ * mml.el (mml-parse-1): Support sender in #secure tags.
+
+ * mml1991.el (mml1991-pgg-sign): Only use message-sender if it is
+ defined.
+
+ * mml-sec.el (mml-smime-encrypt-buffer): Warn about combined signing.
+ (mml-pgp-encrypt-buffer): Support combined signing.
+
+ * mml1991.el (mml1991-mailcrypt-encrypt): Support combined signing.
+ (mml1991-gpg-encrypt): Ditto.
+ (mml1991-pgg-encrypt): Ditto.
+ (mml1991-encrypt): Pass sign parameter.
+
+ * mml-sec.el (mml-signencrypt-style-alist): Defcustom.
+ (mml-signencrypt-style): Mention the variable.
+
+2002-10-09 Simon Josefsson <jas@extundo.com>
+
+ * mml1991.el (mml1991-pgg-sign): Bind pgg-default-user-id, not
+ pgg-gpg-user-id.
+
+ * pgg.el (pgg-insert-url-with-w3): Ignore errors.
+ (pgg-fetch-key-function): Nil if w3 is not installed.
+
+2002-10-08 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-agent.el (gnus-agent-fetch-selected-article): Bind
+ gnus-agent-current-history.
+
+2002-10-06 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-parse-status): Don't use read to read token.
+
+2002-10-05 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-agent.el (gnus-agent-fetch-selected-article): Do nothing
+ for methods not covered by the agent, and when unplugged.
+
+2002-10-05 Simon Josefsson <jas@extundo.com>
+
+ * pgg-gpg.el (pgg-gpg-encrypt-region): Query passphrase when
+ signing.
+
+ * gnus-agent.el (gnus-agent-read-servers): If getting method from
+ a named server fails, ignore the server.
+
+ * mml1991.el (mml1991-pgg-sign): Do QP.
+
+ * pgg-gpg.el (pgg-gpg-encrypt-region): Make signencrypt really
+ work.
+
+2002-10-04 Simon Josefsson <jas@extundo.com>
+
+ * pgg-gpg.el (pgg-gpg-encrypt-region): Make signencrypt work.
+
+ * pgg-pgp.el (pgg-pgp-verify-region): Inline
+ binary-write-decoded-region from MEL.
+
+ * pgg.el (pgg-encrypt-region): Support sign.
+
+ * pgg-gpg.el (pgg-gpg-encrypt-region): Ditto.
+
+ * mml2015.el (mml2015-pgg-encrypt): Ditto.
+
+ * pgg.el, pgg-def.el, pgg-parse.el, pgg-gpg.el, pgg-pgp5.el,
+ pgg-pgp6.el: Moved from ../pgg/. Modifications compared to EMIKO
+ branch where PGG was taken from in the ChangeLog entries below.
+
+2002-10-01 Simon Josefsson <jas@extundo.com>
+
+ * pgg-pgp.el: Don't require mel. Don't use luna.
+ (pgg-scheme-pgp-instance, pgg-make-scheme-pgp): Remove.
+ (pgg-pgp-process-region): Use expand-file-name instead of concat.
+ (pgg-pgp-process-region): Don't use binary-funcall.
+
+ * pgg-pgp5.el (pgg-pgp5-process-region): Don't use binary-funcall.
+
+ * pgg-gpg.el (pgg-gpg-process-region): Use expand-file-name
+ instead of concat.
+
+ * pgg-pgp5.el (pgg-pgp5-process-region): Ditto.
+
+2002-09-29 Simon Josefsson <jas@extundo.com>
+
+ * pgg-parse.el (pgg-char-int, pgg-string-as-unibyte): Prevent byte
+ compile warnings.
+
+ * pgg.el (pgg-decrypt-region): Don't parse packet.
+
+ * pgg.el, pgg-gpg.el, pgg-pgp5.el: Don't depend on luna.el.
+
+2002-09-29 Daiki Ueno <ueno@unixuser.org>
+
+ * pgg.el: Remove dependency on calist.el.
+
+2002-09-28 Simon Josefsson <jas@extundo.com>
+
+ * pgg.el (pgg-temporary-file-directory): New variable.
+ (pgg-verify-region): Don't assume set-buffer-multibyte exists.
+
+ * pgg-pgp5.el (pgg-pgp5-process-region, pgg-scheme-verify-region)
+ (pgg-scheme-snarf-keys-region): Use pgg-temporary-file-directory.
+
+ * pgg-parse.el (pgg-char-int): Defalias.
+ (pgg-format-key-identifier, pgg-byte-after, pgg-read-byte)
+ (pgg-read-bytes, pgg-read-body): Use it.
+ (pgg-decode-packets): Don't use MEL, use base64-*.
+ (pgg-parse-armor): Don't assume set-buffer-multibyte exists.
+ (pgg-string-as-unibyte): Defalias.
+ (pgg-parse-armor-region): Use it.
+
+ * pgg-gpg.el (pgg-gpg-process-region): Use
+ pgg-temporary-file-directory.
+
+ * luna.el: Don't def-edebug.
+
+ * pgg-pgp5.el (pgg-scheme-verify-region): Inline
+ binary-write-decoded-region from MEL.
+
+ * pgg-pgp5.el, pgg-gpg.el: Don't require mel.
+
+ * alist.el, calist.el: Don't require product/APEL.
+
+ * pgg-parse.el (top-level): Remove dependency on static.el,
+ pccl.el, mel.el.
+ (pgg-parse-crc24, pgg-parse-crc24-string): Only define if
+ `define-ccl-program' is boundp, instead of using broken.
+
+2002-10-01 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-required-mail-headers): Remove Lines:.
+
+2002-10-03 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Jesper Harder.
+
+ * gnus-group.el (gnus-group-fetch-charter,
+ gnus-group-fetch-control): Prompt for group if given a prefix
+ argument.
+ * gnus-sum.el (t): Add gnus-group-fetch-charter and
+ gnus-group-fetch-control to summary key map and menu.
+
+
+2002-10-03 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir--group-maxnum-art): fix maximum article
+ number when there are no articles.
+
+2002-10-03 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-agent.el (gnus-agent-summary-fetch-group): Optional prefix
+ arg ALL means to fetch all articles, not only downloadable ones.
+ (gnus-agent-fetch-selected-article): New function for
+ gnus-select-article-hook or gnus-mark-article-hook.
+
+2002-10-02 Katsumi Yamaoka <yamaoka@jpl.org>
+ From Peter von der Ahe <nospam2159@daimi.au.dk>.
+
+ * gnus-ems.el (gnus-x-splash): Set coding-system-for-read to
+ raw-text.
+
+2002-09-30 Ted Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: merged changes from pinard@iro.umontreal.ca (Fran\e,Ag\e(Bois
+ Pinard).
+ Major revamp of the code, documentation is in comments in the file
+ for now.
+
+2002-09-30 Simon Josefsson <jas@extundo.com>
+
+ * mml2015.el (mml2015-pgg-clear-verify): Verifying in a unibyte
+ buffer seem to be needed?
+
+2002-09-29 Simon Josefsson <jas@extundo.com>
+
+ * mml1991.el (pgg-output-buffer, pgg-errors-buffer): Prevent byte
+ compile warnings.
+
+ * mml1991.el (mml1991-function-alist): Add pgg.
+ (mml1991-pgg-sign, mml1991-pgg-encrypt): New functions.
+ (mml1991-pgg-encrypt): Fix recipients querying.
+
+2002-09-28 Simon Josefsson <jas@extundo.com>
+
+ * mml2015.el (autoload): Autoload correct files. Trivial patch
+ from dme@dme.org.
+ (mml2015-pgg-decrypt, mml2015-pgg-verify): Make sure either nil or
+ handle is returned.
+
+2002-09-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-start.el (gnus-fixup-nnimap-unread-after-getting-new-news):
+ Protect against non-existent of `nnimap-mailbox-info'.
+
+2002-09-27 Simon Josefsson <jas@extundo.com>
+
+ * gnus-start.el (gnus-fixup-nnimap-unread-after-getting-new-news): New.
+ (gnus-setup-news-hook): Use it.
+ (gnus-after-getting-new-news-hook): Ditto.
+
+ * nnimap.el (nnimap-fixup-unread-after-getting-new-news): Remove.
+
+2002-09-27 Katsumi Yamaoka <yamaoka@jpl.org>
+ From Mats Lidell <matsl@contactor.se>.
+
+ * gnus-art.el (gnus-article-mode-syntax-table): Replace "-" to " ".
+
+2002-09-27 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * gnus-sum.el (gnus-nov-parse-line): When an error is signaled in
+ the part to decode encoded words, use raw words instead of decoded
+ words.
+
+2002-09-26 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnimap.el (nnimap-update-unseen): Use gnus-gethash-safe.
+
+ * mm-view.el (mm-w3m-mode-ignored-keys): New variable.
+ (mm-setup-w3m): Use it.
+
+2002-09-27 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-article-mode-syntax-table): Make M-. work in
+ article buffers.
+
+ * nnimap.el (nnimap-fixup-unread-after-getting-new-news): Autoload
+ it just in case.
+ (nnimap-update-unseen): New function; update unseen count in
+ `n-m-info'.
+ (nnimap-close-group): Call it.
+
+ * gnus-start.el (gnus-setup-news-hook): Add n-f-u-a-g-n-n.
+ (gnus-after-getting-new-news-hook): Ditto.
+
+ * nnimap.el (nnimap-retrieve-groups): Move the quick mail check
+ message into verboselevel 9. Change slow mail check message.
+ (nnimap-retrieve-groups): Use prefixed names in n-mailbox-info.
+ (nnimap-fixup-unread-after-getting-new-news): New function, to be
+ used as a hook after getting new mail.
+
+2002-09-26 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-parse-resp-text-code): The UNSEEN value in
+ SELECT/EXAMINE is first unseen article, not number of unseen
+ articles. Make them distinct by renaming the former to
+ `first-unseen' instead of `unseen'.
+
+ * nnimap.el (nnimap-retrieve-groups): Get uidvalidity and unseen
+ too.
+ (nnimap-retrieve-groups): Don't used cached data if uidvalidity
+ changed.
+ (nnimap-retrieve-groups): Store uidvalidity and unseen data too.
+
+ * gnus-int.el (gnus-server-unopen-status): Defcustom.
+
+ * mml-sec.el (mml-signencrypt-style): Docstring to font-lock
+ better.
+
+ * mml2015.el (mml2015-pgg-decrypt): Only add security information
+ if dissecting resulting buffer actually had any information.
+
+2002-09-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-group.el (gnus-group-sort-by-method): Remove `symbol-name'
+ because the function `string<' allows symbols.
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Ditto.
+
+2002-09-25 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-forward-make-body): Revert an early change
+ because 8-bit utf-8 emails.
+
+2002-09-25 Bj\e,Av\e(Brn Torkelsson <torkel@acc.umu.se>
+
+ * gnus-agent.el (gnus-category-line-format): Doc fixes (mostly added
+ links to Info)
+ * gnus-art.el (gnus-treat-highlight-signature):
+ * gnus-art.el (gnus-treat-buttonize):
+ * gnus-art.el (gnus-treat-buttonize-head):
+ * gnus-art.el (gnus-treat-emphasize):
+ * gnus-art.el (gnus-treat-strip-cr):
+ * gnus-art.el (gnus-treat-unsplit-urls):
+ * gnus-art.el (gnus-treat-leading-whitespace):
+ * gnus-art.el (gnus-treat-hide-headers):
+ * gnus-art.el (gnus-treat-hide-boring-headers):
+ * gnus-art.el (gnus-treat-hide-signature):
+ * gnus-art.el (gnus-treat-fill-article):
+ * gnus-art.el (gnus-treat-hide-citation):
+ * gnus-art.el (gnus-treat-hide-citation-maybe):
+ * gnus-art.el (gnus-treat-strip-list-identifiers):
+ * gnus-art.el (gnus-treat-strip-pgp):
+ * gnus-art.el (gnus-treat-strip-pem):
+ * gnus-art.el (gnus-treat-strip-banner):
+ * gnus-art.el (gnus-treat-highlight-headers):
+ * gnus-art.el (gnus-treat-highlight-citation):
+ * gnus-art.el (gnus-treat-date-ut):
+ * gnus-art.el (gnus-treat-date-local):
+ * gnus-art.el (gnus-treat-date-english):
+ * gnus-art.el (gnus-treat-date-lapsed):
+ * gnus-art.el (gnus-treat-date-original):
+ * gnus-art.el (gnus-treat-date-iso8601):
+ * gnus-art.el (gnus-treat-date-user-defined):
+ * gnus-art.el (gnus-treat-strip-headers-in-body):
+ * gnus-art.el (gnus-treat-strip-trailing-blank-lines):
+ * gnus-art.el (gnus-treat-strip-leading-blank-lines):
+ * gnus-art.el (gnus-treat-strip-multiple-blank-lines):
+ * gnus-art.el (gnus-treat-unfold-headers):
+ * gnus-art.el (gnus-treat-fold-headers):
+ * gnus-art.el (gnus-treat-fold-newsgroups):
+ * gnus-art.el (gnus-treat-overstrike):
+ * gnus-art.el (gnus-treat-display-xface):
+ * gnus-art.el (gnus-treat-display-smileys):
+ * gnus-art.el (gnus-treat-from-picon):
+ * gnus-art.el (gnus-treat-mail-picon):
+ * gnus-art.el (gnus-treat-newsgroups-picon):
+ * gnus-art.el (gnus-treat-body-boundary):
+ * gnus-art.el (gnus-treat-capitalize-sentences):
+ * gnus-art.el (gnus-treat-fill-long-lines):
+ * gnus-art.el (gnus-treat-play-sounds):
+ * gnus-art.el (gnus-treat-translate):
+ * gnus-art.el (gnus-treat-x-pgp-sig):
+ * gnus-art.el (gnus-mime-button-line-format):
+ * gnus-art.el (gnus-button-man-level):
+ * gnus-art.el (gnus-button-emacs-level):
+ * gnus-cus.el (gnus-group-parameters):
+ * gnus-gl.el (bbb-build-mid-scores-alist):
+ * gnus-group.el (gnus-group-line-format):
+ * gnus-mlspl.el (gnus-group-split-setup):
+ * gnus-mlspl.el (gnus-group-split):
+ * gnus-msg.el (gnus-mailing-list-groups):
+ * gnus-msg.el (gnus-posting-styles):
+ * gnus-nocem.el (gnus-nocem-issuers):
+ * gnus-score.el (gnus-score-regexp-bad-p):
+ * gnus-srvr.el (gnus-server-line-format):
+ * gnus-topic.el (gnus-topic-line-format):
+ * gnus.el (gnus-summary-line-format):
+ * mail-source.el (mail-sources):
+ * message.el (message-subscribed-address-file):
+ * nnmail.el (nnmail-split-fancy):
+
+2002-09-24 Evgeny Roubinchtein <zhenya@freeshell.org>
+
+ * mail-source.el(mail-source-run-script): use `functionp' to test
+ whether the argument `script' is in fact a function.
+ (mail-sources): adjust the defcustom to allow users to specify a
+ function or a string as the value of the `:prescript' and
+ `:postscript' arguments of the `file' and `pop3' mail sources.
+
+2002-09-25 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir--grp-add-art): fix minimum article
+ number when article 1 does not exist.
+
+2002-09-25 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-art.el (gnus-button-handle-apropos-variable): Fall back to
+ apropos if apropos-variable does not exist.
+ (gnus-button-guessed-mid-regexp)
+ (gnus-button-handle-describe-prefix, gnus-button-alist): Better
+ regexes. From Reiner Steib.
+ (gnus-button-handle-describe-function)
+ (gnus-button-handle-describe-variable): Doc fix. From Reiner Steib.
+ (gnus-button-handle-describe-key, gnus-button-handle-apropos)
+ (gnus-button-handle-apropos-command): Doc fix. From Reiner Steib.
+
+2002-09-25 Mark A. Hershberger <mah@everybody.org>
+ Trivial patch.
+
+ * nnrss.el (nnrss-save-server-data): Save nnrss-group-alist in
+ the file.
+
+2002-09-24 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-start.el (gnus-1): Create nndraft:queue, nndraft:drafts.
+
+2002-09-24 Simon Josefsson <jas@extundo.com>
+
+ * mml2015.el (top-level): Require mm-util for mm-make-temp-file.
+ (mml2015-use): Prefer PGG if installed.
+ (mml2015-function-alist): Add PGG wrappers.
+ (mml2015-gpg-extract-signature-details): Check mml2015-use too.
+ (mml2015-gpg-extract-signature-details): PGG strips "gpg: "
+ prefix, make regexp optionally skip it.
+ (mml2015-pgg-decrypt, mml2015-pgg-clear-decrypt)
+ (mml2015-pgg-verify, mml2015-pgg-clear-verify, mml2015-pgg-sign)
+ (mml2015-pgg-encrypt): New functions.
+ (defvar, autoload): Prevent byte-compile warnings.
+
+2002-09-24 Katsumi Yamaoka <yamaoka@jpl.org>
+ From TSUCHIYA Masatoshi <tsuchiya@namazu.org>.
+
+ * gnus-art.el (article-strip-banner): Check for the existence of
+ from header.
+
+2002-09-23 Kai Gro\e,b_\e(Bjohann <grossjoh@ls6.informatik.uni-dortmund.de>
+
+ * gnus-art.el (gnus-button-guessed-mid-regexp): Improved regexp.
+ (gnus-button-alist): Improved regexp for
+ gnus-button-handle-mid-or-mail (false positives), fixed
+ gnus-button-handle-man entries.
+ From Reiner Steib.
+
+2002-09-23 Paul Jarc <prj@po.cwru.edu>
+ From Josh Huber.
+
+ * nnmaildir.el (nnmaildir--update-nov): fix wrong-type error when
+ nnmail-extra-headers is non-nil.
+
+2002-09-23 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el: Store article numbers persistently. General
+ revision.
+ (nnmaildir-request-expire-articles): handle 'immediate and 'never
+ for nnmail-expiry-wait; delete instead of moving if 'force is
+ given.
+
+2002-09-23 Simon Josefsson <jas@extundo.com>
+ Trivial fix from beaker@iavmb.pl (Krzysztof J\e,Bj\e(Bdruczyk).
+
+ * smime.el (smime-sign-buffer): Get key and extra certs.
+ (smime-get-key-with-certs-by-email): Utility function.
+
+2002-09-21 ShengHuo ZHU <zsh@cs.rochester.edu>
+ Trivial patch from Micha Wiedenmann <mw-u1@gmx.de>
+
+ * gnus-soup.el (gnus-soup-add-article): Mark as read only when the
+ article exists.
+
+2002-09-20 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-next-group): Switch to the summary buffer.
+
+2002-09-20 Kai Gro\e,b_\e(Bjohann <grossjoh@ls6.informatik.uni-dortmund.de>
+ From Reiner Steib.
+
+ * gnus-art.el (gnus-button-handle-custom,
+ gnus-button-handle-mid-or-mail,
+ gnus-button-handle-describe-{function,variable,key},
+ gnus-button-handle-apropos{,command,variable}): New functions.
+ (gnus-button-prefer-mid-or-mail,gnus-button-guessed-mid-regexp,
+ gnus-button-{man,emacs,mail}-level): New variables.
+ (gnus-button-alist): Use the above to buttonize emacs and mail
+ related links.
+
+2002-09-18 Juanma Barranquero <lektu@terra.es>
+
+ * gnus-int.el (gnus-status-message): Fix spacing.
+
+ * imap.el (imap-continuation): Fix typos.
+
+2002-09-18 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-configure-posting-styles): Sort results.
+
+ * gnus-art.el (gnus-article-reply-with-original): Correct
+ with-current-buffer scope.
+
+ * message.el (message-completion-alist): Add Reply-To, From, etc.
+
+2002-09-18 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-request-expire-articles): Make flag setting
+ conditional. From Nevin Kapur <nevin@jhu.edu>.
+
+2002-09-17 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-expiry-target): Don't search for which
+ articles exists here.
+ (nnimap-request-expire-articles): Do it here instead. Only expire
+ when articles are found. Suggested by Nevin Kapur
+ <nevin@jhu.edu>.
+
+2002-09-17 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Reiner Steib <reiner.steib@gmx.de>.
+
+ * message.el (message-strip-subject-trailing-was)
+ (message-change-subject, message-add-archive-header)
+ (message-xpost-fup2-header, message-xpost-insert-note)
+ (message-xpost-fup2, message-reduce-to-to-cc): New functions
+ adopted from message-utils.el. Add functions to the keymap, mode
+ describtion and menu.
+ (message-change-subject,message-xpost-fup2): Signal error if
+ current header is empty.
+ (message-xpost-insert-note): Changed insert position.
+ (message-archive-note): Ensure to insert note in message body (not
+ in head).
+ (message-archive-header, message-archive-note)
+ (message-xpost-default, message-xpost-note, message-fup2-note)
+ (message-xpost-note-function): New variables adopted from
+ message-utils.el. Changed some doc-strings.
+ (message-mark-insert-{begin,end}): Rename from
+ message-{begin,end}-inserted-text-mark (message-utils.el), changed
+ values.
+ (message-subject-trailing-was-query)
+ (message-subject-trailing-was-ask-regexp)
+ (message-subject-trailing-was-regexp): New variables.
+ (message-to-list-only): Added doc-string and menu entry.
+
+ * message-utils.el: Removed. Functions are now in message.el.
+
+2002-09-16 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-reply-with-original,
+ gnus-article-followup-with-original): Switch to
+ gnus-summary-buffer before reply/followup.
+
+2002-09-15 John Paul Wallington <jpw@shootybangbang.com>
+
+ * gnus-sum.el (gnus-summary-toggle-header): The article window may
+ not exist. Toggle it anyway.
+
+2002-09-13 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-copy-article-buffer): Bind mail-header-separator.
+
+ * gnus-art.el (article-fill-long-lines): Fill-paragraph properly.
+ Trivial patch from Urban Engberg <ue@ccieurope.com>.
+
+ * rfc2047.el (message-posting-charset): Defvar it.
+ (rfc2047-charset-encoding-alist): Use B for iso-8859-7 and
+ iso-8859-8. Fix doc. Suggested by Dave Love <fx@gnu.org>.
+
+ * mail-source.el (mail-source-fetch): Hide password.
+
+ * gnus-sum.el (gnus-summary-next-group): Semi-exit only when needed.
+
+2002-09-12 Katsumi Yamaoka <yamaoka@jpl.org>
+ From John Paul Wallington <jpw@shootybangbang.com>.
+
+ * gnus.el (gnus-visual, gnus-meta): Fix typo.
+
+2002-09-11 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-address-banner-alist): Doc fix.
+
+2002-09-11 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-expiry-target): Only expiry-target existing articles.
+ (nnimap-split-rule): Doc fix.
+ (nnimap-request-expire-articles): Cleanup code.
+
+2002-09-11 Katsumi Yamaoka <yamaoka@jpl.org>
+ From TSUCHIYA Masatoshi <tsuchiya@namazu.org>.
+
+ * gnus-art.el (gnus-article-address-banner-alist): New option.
+ (article-strip-banner): Refer the above option to split banners of
+ free mail servers, when no group parameter is specified.
+
+2002-09-10 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nntp.el (nntp-wait-for-string): Check for a process in the
+ current buffer instead of `nntp-server-buffer'.
+
+2002-09-09 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-button-man-handler): New variable.
+ (gnus-button-alist): Use g-b-handle-man.
+ (gnus-button-handle-man): New, call g-b-man-handler.
+
+2002-09-08 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-button-alist): Buttonize man page links.
+
+2002-09-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-dumbquotes-map): Add \230.
+
+2002-09-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-srvr.el (gnus-browse-make-menu-bar): Add "d".
+
+ * gnus-sum.el (gnus-summary-limit-to-unseen): New command and
+ keystroke.
+
+ * gnus-srvr.el (gnus-browse-describe-group): New command and
+ keystroke.
+
+2002-09-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-treat-body-boundary): Don't quote a
+ value for gnus-decoration property.
+
+2002-09-06 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * nnmail.el (nnmail-cache-fetch-group): Don't return "" (empty
+ string) as group name in case we have a CRLF in the file.
+
+2002-09-04 Jesper Harder <harder@ifa.au.dk>
+
+ * rfc1843.el (rfc1843-decode-loosely): Move to mime customization
+ group.
+ (rfc1843-decode-hzp): do.
+ (rfc1843-newsgroups-regexp): do.
+
+2002-09-04 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-canlock-generate): Make sure sha1 doesn't
+ call external programs.
+
+2002-09-03 Simon Josefsson <jas@extundo.com>
+
+ * nntp.el (nntp-wait-for-string): Dont infloop if process died.
+
+ * gnus-agent.el (gnus-agent-batch): Add doc.
+
+2002-09-03 Josh Huber <huber@alum.wpi.edu>
+
+ * gnus-msg.el (gnus-summary-handle-replysign): Change the order we
+ check for signed and encrypted parts.
+ * mml.el (mml-parse-1): Correct small typo which preventing
+ setting recipients in a secure tag.
+
+2002-09-03 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-util.el (mm-coding-system-priorities): Default to a list of
+ iso-2022-jp and others for the Japanese environment.
+
+2002-09-03 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-util.el (gnus-frame-or-window-display-name): Exclude
+ invalid display names.
+
+2002-08-30 Simon Josefsson <jas@extundo.com>
+
+ * gnus-group.el (gnus-group-fetch-control): Fix typo in last
+ commit. From Reiner Steib <4uce.02.r.steib@gmx.net>.
+
+2002-08-26 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.el (gnus-group-charter-alist): New option.
+ (gnus-group-fetch-control-use-browse-url): New option.
+
+ * gnus-group.el (gnus-group-fetch-charter): New function.
+ (gnus-group-fetch-control): New function.
+ Add them to the keymap and menu. Require mm-url.
+
+2002-08-30 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-mlspl.el (gnus-group-split-fancy): Doc fix.
+ From Alex Schroeder <alex@emacswiki.org>.
+
+2002-08-29 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-group.el (gnus-group-make-menu-bar): Add ellipses to menu
+ items expecting user interaction.
+
+ * gnus-topic.el (gnus-topic-make-menu-bar): do.
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): do.
+
+ * gnus-srvr.el (gnus-server-make-menu-bar): do.
+
+ * mml.el (mml-menu): do.
+
+2002-08-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mail-source.el (mail-source-touch-pop): New function.
+
+ * message.el (message-smtpmail-send-it): New function.
+ (message-send-mail-function): Add it for a candidate.
+
+2002-08-27 Simon Josefsson <jas@extundo.com>
+
+ * gnus-msg.el (posting-charset-alist): Use
+ gnus-define-group-parameter instead of defcustom.
+ (gnus-put-message): Handle SPC in GCC.
+ (gnus-inews-insert-gcc): Ditto.
+ (gnus-inews-insert-archive-gcc): Ditto.
+
+2002-08-26 Simon Josefsson <jas@extundo.com>
+
+ * gnus-agent.el (gnus-agent-auto-agentize-methods): New variable.
+ (gnus-agentize): Auto agentize all nntp and nnimap groups.
+ (gnus-agent-possibly-save-gcc): Autoload.
+ Suggested by (KOSEKI Yoshinori) <kose@meadowy.org>.
+
+2002-08-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-other-frame-function): New user option.
+ (gnus-other-frame): Use it; add a doc-string; make it work with
+ the gnuclient program.
+
+ * gnus-util.el (gnus-frame-or-window-display-name): New function.
+
+ * lpath.el: Fbind `frame-parameter', `make-frame-on-display',
+ `device-connection' and `dfw-device'.
+
+2002-08-22 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-art.el (gnus-emphasis-alist): Strikethru had a lot of false
+ positives, make it stricter. From Jochen Hein (trivial change).
+
+2002-08-21 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-other-frame): Trivial fix.
+
+2002-08-21 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-other-frame-parameters): New user option.
+ (gnus-other-frame-object): New variable.
+ (gnus-other-frame): Make it search for existing Gnus frame; don't
+ read new news; delete frame on exit.
+
+ * gnus-util.el (gnus-select-frame-set-input-focus): New function.
+
+ * lpath.el: Fbind w32-focus-frame and x-focus-frame.
+
+2002-08-20 Katsumi Yamaoka <yamaoka@jpl.org>
+ From \e$B>.4X\e(B \e$B5HB'\e(B (KOSEKI Yoshinori) <kose@meadowy.org>.
+
+ * message.el (message-set-auto-save-file-name): Add support for
+ the Cygwin Emacs; the system-type is `cygwin'.
+ * nnheader.el (nnheader-file-name-translation-alist): Ditto.
+
+2002-08-20 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-button-url-regexp): Use POSIX regexp if possible.
+
+ * nnmh.el (nnmh-request-list-1): Use %.0f instead of %d to
+ avoid arithmetic errors.
+
+2002-08-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el: Don't fbind `gnus-article-replace-with-quoted-text'.
+
+2002-08-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-ignored-supersedes-headers): Add X-Hashcash.
+ (message-ignored-resent-headers): Add envelope From.
+
+2002-08-18 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus.el (gnus-summary-line-format): Document %k specifier.
+
+2002-08-17 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-sum.el (gnus-summary-line-message-size): New function.
+ (gnus-summary-line-format-alist): Use it.
+
+2002-08-15 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (article-make-date-line): Refer to the value for
+ `gnus-article-time-format' in the summary buffer.
+
+ * message.el (message-cite-prefix-regexp): Exclude ":" and "\e,A;\e(B".
+
+2002-08-14 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-button-alist): Use ' not ` for default value
+ quoting.
+ (gnus-button-alist): Fix doc.
+ (gnus-header-button-alist): Use ' not ` for default value quoting.
+ (gnus-header-button-alist): Don't inline gnus-button-url-regexp,
+ rationale similar to 2002-05-01 change.
+ (gnus-article-add-buttons-to-head): Evaluate expression.
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Add MIME button option.
+
+2002-08-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-font-lock-keywords): Refer to the value for
+ `message-cite-prefix-regexp' dynamically.
+
+2002-08-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-decode-header-methods): Doc fix.
+
+2002-08-12 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-shell-open): Allow non-list `imap-shell-program'.
+ (imap-shell-open): Skip initial junk before IMAP greeting.
+
+2002-08-11 Simon Josefsson <jas@extundo.com>
+
+ * message-utils.el (message-xpost-default,
+ message-xpost-fup2-header, message-xpost-fup2): Fixed
+ Typos. Trivial changes from Reiner Steib
+ <4uce.02.r.steib@gmx.net>.
+
+2002-08-09 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-canlock-password): Set
+ canlock-password-for-verify to newly generated canlock-password.
+ When Emacs is restarted, Custom makes sure this is set, but during
+ the same session we must set it manually.
+
+2002-08-07 Jesper Harder <harder@ifa.au.dk>
+
+ * yenc.el: New file.
+
+ * mm-uu.el (mm-uu-yenc-decode-function): New variable.
+ (mm-uu-type-alist): Add yenc.
+ (mm-uu-yenc-filename): New function.
+ (mm-uu-yenc-extract): New function.
+
+ * mm-bodies.el (mm-decode-content-transfer-encoding): Add yenc.
+
+2002-08-06 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * dgnushack.el (merge): Don't use coerce.
+
+2002-05-27 Jesper Harder <harder@ifa.au.dk>
+
+ * mailcap.el (mailcap-mime-data): Test window-system rather than
+ mm-device-type.
+ (mailcap-mime-data): Call xdvi and gv with "-safer".
+
+ * mm-util.el: Don't define mm-device-type.
+
+2002-08-05 Simon Josefsson <jas@extundo.com>
+
+ * mm-util.el (mm-coding-system-priorities): coding-system type not
+ supported everywhere.
+
+2002-08-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bumped version number.
+
+2002-08-04 01:48:57 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
* gnus.el: Oort Gnus v0.07 is released.
2002-07-31 Danny Siu <dsiu@adobe.com>
- * nnimap.el (nnimap-split-articles): do not call nnmail-fetch-field
+ * nnimap.el (nnimap-split-articles): do not call nnmail-fetch-field
when splitting malformed messages without message-id
2002-07-28 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
* sieve-manage.el (sieve-manage-deletescript): New function.
- * sieve.el (sieve-manage-mode-map): Fix down-mouse-2 and down-mouse-3.
+ * sieve.el (sieve-manage-mode-map): Fix down-mouse-2 and down-mouse-3.
(sieve-manage-mode): Fix menubar.
(sieve-activate): Change some messages.
(sieve-deactivate-all): New function.
(sieve-help): Fix help.
All suggested by Ned Ludd.
-2002-07-24 Katsumi Yamaoka <yamaoka@jpl.org>
+2002-07-24 Katsumi Yamaoka <yamaoka@jpl.org>
* mm-decode.el (mm-inline-text-html-with-images): Doc fix.
(mm-w3m-safe-url-regexp): New user option.
* nnimap.el (nnimap-split-to-groups): Allow group string to be a
function. From KANEMATSU Daiji <kdaiji@bea.com>.
-2002-07-09 Nevin Kapur <Nevin Kapur <nevin@jhu.edu>
+2002-07-09 Nevin Kapur <nevin@jhu.edu>
* gnus-sum.el (gnus-summary-delete-article): Respect group
parameters while expiring.
* nnsoup.el (nnsoup-retrieve-headers, nnsoup-request-type)
(nnsoup-read-active-file, nnsoup-article-to-area): Ditto.
-2002-07-05 Katsumi Yamaoka <yamaoka@jpl.org>
+2002-07-05 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-sum.el (gnus-summary-toggle-header): Show headers anyway;
don't break a narrowed article.
* gnus-msg.el (gnus-summary-resend-default-address): New user option.
(gnus-summary-resend-message): Use it.
-2002-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
+2002-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
* nntp.el (nntp-via-rlogin-command-switches): New variable.
(nntp-open-via-rlogin-and-telnet): Re-revert; use the var above.
message-font-lock-keywords.
From Katsumi Yamaoka <yamaoka@jpl.org>.
-2002-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
+2002-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
* nntp.el (nntp-open-via-rlogin-and-telnet): Revert last change.
-2002-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
+2002-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
* nntp.el (nntp-open-via-rlogin-and-telnet): Hide commandline args.
* gnus-delay.el (gnus-delay-send-queue): Delete the delay header
before sending. Suggested by Jan Rychter.
-2002-06-18 Katsumi Yamaoka <yamaoka@jpl.org>
+2002-06-18 Katsumi Yamaoka <yamaoka@jpl.org>
* dgnushack.el (remove): New compiler macro.
(last, coerce, subseq): Remove compiler macros for those built-in
* gnus-ems.el (nnheader-file-name-translation-alist): Removed.
-2002-06-14 Katsumi Yamaoka <yamaoka@jpl.org>
+2002-06-14 Katsumi Yamaoka <yamaoka@jpl.org>
* message.el (message-beginning-of-line): Keep the region active
in XEmacs. Suggested by TAKAHASHI Kaoru <kaoru@kaisei.org>.
* gnus-msg.el (gnus-summary-reply): Ditto.
* gnus-msg.el (gnus-summary-handle-replysign): New.
-2002-06-12 Katsumi Yamaoka <yamaoka@jpl.org>
+2002-06-12 Katsumi Yamaoka <yamaoka@jpl.org>
* message.el (message-send-mail-with-sendmail): Kill errbuf even
if sending failed.
style match to use data from last viewed article.
Suggested by Hrvoje Niksic.
-2002-06-04 Katsumi Yamaoka <yamaoka@jpl.org>
+2002-06-04 Katsumi Yamaoka <yamaoka@jpl.org>
* spam.el (spam-point-at-eol): New alias.
(spam-parse-whitelist): Use it.
name (makes it work with recent Cyrus timsieved).
2002-05-20 Jason <jbaker@cs.utah.edu>
+ Trivial patch.
* gnus-art.el (gnus-request-article-this-buffer): Try
reconnecting if you don't get the message.
server.
(nnimap-mailbox-info): defvar instead of defvoo.
-2002-05-01 20:09:21 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+2002-05-01 20:09:21 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
* gnus.el: Oort Gnus v0.06 is released.
* gnus.el (gnus-find-subscribed-addresses): Return nil when there
are no subscribed mail groups.
- - Strip quoted names when comparing addresses
+ - Strip quoted names when comparing addresses
2002-04-28 Jesper Harder <harder@ifa.au.dk>
* gnus-msg.el (gnus-article-mail): Use gnus-msg-mail instead.
Trivial change from Karl Pfl\e,Ad\e(Bsterer <sigurd@12move.de>.
-2002-04-27 Katsumi Yamaoka <yamaoka@jpl.org>
+2002-04-27 Katsumi Yamaoka <yamaoka@jpl.org>
* dns.el (dns-make-network-process): New macro.
(query-dns): Use it.
* nnmaildir.el: fixed some buggy invocations of nnmaildir--pgname.
2002-03-31 Andrew Cohen <cohen@andy.bu.edu>
+ Trivial patch.
* dns.el: open-network-stream under XEmacs does udp.
* lpath.el (featurep): Bind make-network-process.
-2002-03-31 Paul Jarc <prj@po.cwru.edu>
+2002-03-31 Paul Jarc <prj@po.cwru.edu>
* nnmaildir.el: Use defstruct. Use a single copy of
nnmail-extra-headers to save memory. Store server's group name
* mml-sec.el (mml-secure-message): Search after
mail-header-separator from top of message.
-2002-03-28 Paul Jarc <prj@po.cwru.edu>
+2002-03-28 Paul Jarc <prj@po.cwru.edu>
* nnmaildir.el: Cosmetic changes.
(nnmaildir--with-nntp-buffer, nnmaildir--with-work-buffer,
(gnus-summary-highlight-line): Use `gnus-point-at-bol' and
`gnus-point-at-eol'.
-2002-03-27 Paul Jarc <prj@po.cwru.edu>
+2002-03-27 Paul Jarc <prj@po.cwru.edu>
* nnmaildir.el (nnmaildir--subdir, nnmaildir--nov-dir,
nnmaildir--marks-dir): New macros. Use them.
* gnus-util.el (gnus-extract-address-components): Don't break on
names such as James "Kibo" Parry. From Francis Litterio
- <franl_removethis@world.std.com>.
+ <franl@world.std.com>.
2002-03-13 Simon Josefsson <jas@extundo.com>
(gnus-summary-save-parts-last-directory): Ditto.
Trivial change from andre@slamdunknetworks.com
-2002-03-09 Paul Jarc <prj@po.cwru.edu
+2002-03-09 Paul Jarc <prj@po.cwru.edu>
* gnus-start.el (gnus-auto-subscribed-groups): Include nnmaildir.
* nnweb.el (nnweb-type-definition): Clean up.
2002-01-21 Alastair Burt <burt@dfki.de>
+ Trivial patch.
* gnus-art.el (gnus-mm-display-part): Make sure that the summary
buffer exists before jumping to it.
* gnus.el (gnus-version-number): Bump version number.
-2002-01-20 05:33:30 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+2002-01-20 05:33:30 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
* gnus.el: Oort Gnus v0.05 is released.
* gnus.el (gnus-logo-color-alist): Added more colors from Luis.
2002-01-05 Keiichi Suzuki <keiichi@nanap.org>
+ Trivial patch.
* nntp.el (nntp-possibly-change-group): Erase contents of nntp
buffer to get rid of junk line.
* gnus-diary.el, gnus-delay.el: Fix copyright lines.
-2002-01-01 Paul Jarc <prj@po.cwru.edu>
+2002-01-01 Paul Jarc <prj@po.cwru.edu>
* nnmaildir.el (nnmaildir--update-nov): automatically parse
NOV data out of the message again if nnmail-extra-headers has
(message-fix-before-sending): Highlight invisible text and place
point there.
-2002-01-01 02:32:53 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+2002-01-01 02:32:53 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
* gnus.el: Oort Gnus v0.04 is released.
insert-before-markers.
From Jesper Harder <harder@ifa.au.dk>
-2001-12-26 Paul Jarc <prj@po.cwru.edu>
+2001-12-26 Paul Jarc <prj@po.cwru.edu>
* nnmaildir.el (nnmaildir-save-mail): create the destination
groups if they do not exist.
* gnus.el (gnus-group-prefixed-name): If group name is prefixed,
return it.
-2001-12-21 Paul Jarc <prj@po.cwru.edu>
+2001-12-21 Paul Jarc <prj@po.cwru.edu>
* gnus.el (gnus-valid-select-methods): Include nnmaildir.
* nnmaildir.el (top-level): Add commentary.
* message.el (message-mode): Use `make-local-hook' unless
obsolete.
- Patch by Katsumi Yamaoka <yamaoka@jpl.org>.
+ Patch by Katsumi Yamaoka <yamaoka@jpl.org>.
2001-11-26 Katsumi Yamaoka <yamaoka@jpl.org>
`active' to `current' and one `null' to `not'.
2001-10-16 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
- From Katsumi Yamaoka <yamaoka@jpl.org>.
+ From Katsumi Yamaoka <yamaoka@jpl.org>.
* message.el (message-setup-fill-variables): Use
`normal-auto-fill-function' instead of `auto-fill-function'.
* nnfolder.el: Ditto.
-2001-09-30 Dan Christensen <jdc+news@uwo.ca>
+2001-09-30 Dan Christensen <jdc@uwo.ca>
* gnus-sum.el (gnus-summary-extract-address-component): New function.
(gnus-summary-from-or-to-or-newsgroups): Optimize.
(gnus-parse-simple-format): Re-revert.
2001-09-16 Katsuhiro Hermit Endo <hermit@koka-in.org>
+ Trivial patch.
* gnus-spec.el (gnus-parse-complex-format): Don't fold search
case. (Thanks to Daiki Ueno <ueno@unixuser.org>.)
(nnml-generate-nov-file): Ditto.
(nnml-retrieve-headers): Ditto.
-2001-09-15 Michael Welsh Duggan <md5i@cs.cmu.edu>
+2001-09-15 Michael Welsh Duggan <md5i@cs.cmu.edu>
* gnus-spec.el (gnus-parse-format): Don't treat %c as %C.
* gnus-diary.el (message-mode-map): bind the above to `C-c D c'.
* gnus-diary.el (gnus-article-edit-mode-map): ditto.
-2001-09-10 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+2001-09-10 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
* gnus-sum.el (gnus-select-newsgroup): Make
`gnus-current-select-method' buffer-local.
* imap.el (imap-gssapi-auth-p, imap-kerberos4-auth-p): Also check
whether `imtest' is installed.
-2001-08-04 Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com>
- Committed by ShengHuo ZHU <zsh@cs.rochester.edu>
+2001-08-04 ShengHuo ZHU <zsh@cs.rochester.edu>
+ Trivial patch from Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com>
* gnus-sum.el (gnus-summary-show-article): Call
gnus-summary-update-secondary-secondary-mark.
* nnmail.el (nnmail-pathname-coding-system): Set default to nil.
-2001-08-06 Florian Weimer <fw@deneb.enyo.de>
+2001-08-06 Florian Weimer <fw@deneb.enyo.de>
* message.el (message-indent-citation): Use
`message-yank-cited-prefix' for empty lines.
-2001-08-05 Florian Weimer <fw@deneb.enyo.de>
+2001-08-05 Florian Weimer <fw@deneb.enyo.de>
* message.el (message-indent-citation): Quote only lines starting
with ">" using `message-yank-cited-prefix'.
2001-08-05 Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com>
+ Trivial patch.
* gnus-cache.el (gnus-cache-possibly-enter-article): Use
gnus-cache-fully-p.
Reported and modifications based on discussions with Nuutti
Kotivuori <nuutti.kotivuori@smarttrust.com>.
-2001-08-04 Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com>
- Committed by Simon Josefsson <jas@extundo.com>
+2001-08-04 Simon Josefsson <jas@extundo.com>
+ Trivial patch from Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com>
* gnus-cache.el (gnus-cache-possibly-update-active): New function;
calls `gnus-cache-update-active' if bounds has been extended.
* gnus-art.el (gnus-mime-view-part-as-type): Don't copy cache.
-2001-07-25 12:54:00 Danny Siu <dsiu@adobe.com>
+2001-07-25 12:54:00 Danny Siu <dsiu@adobe.com>
* gnus-sum.el (gnus-summary-prepare-threads): Shouldn't do tree
display (%B) for threads if threading is off.
* message.el (message-citation-line-function): Refer to
gnus-cite-attribution-suffix.
-2001-07-15 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
+2001-07-15 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
* gnus-art.el,...: Error convention changes.
* gnus-draft.el (gnus-draft-edit-message): Remove Date here.
(gnus-draft-setup): Remove backlog.
-2001-07-10 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
+2001-07-10 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
* gnus-logic.el, gnus-srvr.el, gnus-vm.el, nnheaderxm.el, nnoo.el:
Cleanup.
* mm-decode.el (mm-attachment-override-p): Fix typo.
-2001-03-19 05:28:00 Katsumi Yamaoka <yamaoka@jpl.org>
+2001-03-19 05:28:00 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-kill.el (gnus-execute): Work with the extra headers.
* gnus-sum.el (gnus-summary-execute-command): Ditto.
* nntp.el (nntp-send-command-and-decode): ditto.
2001-06-30 YAGI Tatsuya <yagi@is.titech.ac.jp>
+ Trivial patch.
* gnus-start.el (gnus-check-first-time-used): Use `if' instead of
`when'.
making making old `imtest's unusable. Thanks to NAGY Andras
<nagya@inf.elte.hu> for his work.
-2000-12-30 NAGY Andras <nagya@inf.elte.hu>
+2000-12-30 NAGY Andras <nagya@inf.elte.hu>
* imap.el (imap-ssl-program): Add -quiet to shut up
OpenSSL/SSLeay's internal debug talk.
-2001-06-19 Matt Armstrong <matt@lickey.com>
+2001-06-19 Matt Armstrong <matt@lickey.com>
* imap.el (imap-parse-flag-list): Workaround bug in Courier IMAP
server.
* nnweb.el (nnweb-google-parse-1): Fix Google content regexp.
(nnweb-google-wash-article): Ditto.
-2001-06-14 Ferenc Wagner <wferi@bolyai1.elte.hu>
+2001-06-14 Ferenc Wagner <wferi@bolyai1.elte.hu>
* nnweb.el (nnweb-google-parse-1): Fix Google url regexp.
* nnrss.el (nnrss-node-text): Use cddr instead xml-node-children.
-2001-06-03 Dale Hagglund <rdh@best.com>
+2001-06-03 ShengHuo ZHU <zsh@cs.rochester.edu>
+ Trivial patch from Dale Hagglund <rdh@best.com>
* gnus-mlspl.el (gnus-group-split-fancy): Fix generation of split
restrict clauses.
* message.el (message-wide-reply-confirm-recipients): New variable.
-2001-06-06 Mark Thomas <mthomas@edrc.cmu.edu>
+2001-06-06 ShengHuo ZHU <zsh@cs.rochester.edu>
+ Trivial patch from Mark Thomas <mthomas@edrc.cmu.edu>
* nnmail.el (nnmail-fix-eudora-headers): Change the In-Reply-To
fix so it works with XEmacs.
correctly.
(nnrss-check-group): Use time.
-2001-05-01 19:21:19 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+2001-05-01 19:21:19 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
* gnus.el: Oort Gnus v0.03 is released.
(smime-sign-region): Rework to bind value and use it.
(smime-decrypt-region): Ditto.
-2001-04-18 Mathias Herberts <Mathias.Herberts@iroise.net>
- Committed by Simon Josefsson <simon@josefsson.org>
+2001-04-18 Simon Josefsson <simon@josefsson.org>
+ Trivial patch from Mathias Herberts <Mathias.Herberts@iroise.net>
* smime.el (smime-ask-passphrase): New function.
(smime-sign-region): Use it.
* imap.el (imap-shell-open): Erase the buffer *after* copying it into
the log.
-2001-04-14 01:14:42 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+2001-04-14 01:14:42 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
- *gnus.el: Oort Gnus v0.02 is released.
+ * gnus.el: Oort Gnus v0.02 is released.
2001-04-14 00:48:42 Lars Magne Ingebrigtsen <larsi@quimby.gnus.org>
* gnus-sum.el (gnus-summary-insert-new-articles): Reverse the articles.
-2001-04-10 08:01:15 Katsumi Yamaoka <yamaoka@jpl.org>
+2001-04-10 08:01:15 Katsumi Yamaoka <yamaoka@jpl.org>
Committed by ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-msg.el (gnus-post-news): Fill the Newsgroups header by the
* message.el (message-options-set-recipient): Look at Cc and Bcc too.
-2001-04-10 Colin Marquardt <colin.marquardt@usa.alcatel.com>
+2001-04-10 Colin Marquardt <colin@marquardt-home.de>
* message.el (message-send-mail): Improve the interaction with the
user.
* imap.el (imap-message-copy): Work around buggy servers that
doesn't send TRYCREATE tags.
-2001-04-09 01:15:54 Katsumi Yamaoka <yamaoka@jpl.org>
+2001-04-09 01:15:54 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-start.el (gnus-read-newsrc-el-file): Work with Semi-gnusae.
* gnus-sum.el (gnus-summary-mark-article-as-replied): Make into a
command.
-2001-03-31 01:04:54 Francis Litterio <franl-removethis@world.omitthis.std.com>
+2001-03-31 01:04:54 Francis Litterio <franl@world.std.com>
* message.el (message-set-auto-save-file-name): Don't use
asterisks under nt.
* message.el (message-generate-headers-first): Update doc.
-2001-03-10 Matthias Wiehl <mwiehl@gmx.de>
+2001-03-10 Matthias Wiehl <mwiehl@gmx.de>
+ Trivial patch.
* gnus.el (gnus-summary-line-format): Typo.
* nnrss.el: New file.
-2001-03-08 02:41:36 Katsumi Yamaoka <yamaoka@jpl.org>
+2001-03-08 02:41:36 Katsumi Yamaoka <yamaoka@jpl.org>
Committed by ShengHuo ZHU <zsh@cs.rochester.edu>
* rfc2047.el (rfc2047-unfold-region): Fix arg of
* message.el (message-get-reply-headers): More fixes.
-2001-02-17 Paul Jarc <prj@po.cwru.edu>
+2001-02-17 Paul Jarc <prj@po.cwru.edu>
Committed by ShengHuo ZHU <zsh@cs.rochester.edu>
* message.el (message-get-reply-headers): Fix bug with
* gnus-range.el (gnus-range-normalize): New function.
-2001-02-15 NAGY Andras <nagya@inf.elte.hu>
+2001-02-15 NAGY Andras <nagya@inf.elte.hu>
* imap.el (imap-gssapi-open): Set imap-c-l-s-first.
server. Don't open server if it is opened.
(nnml-request-regenerate): Use it. Change to deffoo.
-2001-02-14 Katsumi Yamaoka <yamaoka@jpl.org>
+2001-02-14 Katsumi Yamaoka <yamaoka@jpl.org>
Committed by ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus.el (gnus-define-group-parameter): Fix.
* gnus-cus.el (gnus-score-customize): Doc fix.
-2001-02-11 Jesper Harder <harder@ifa.au.dk>
+2001-02-11 Jesper Harder <harder@ifa.au.dk>
* dgnushack.el (my-getenv): Typo.
* message.el (message-cancel-news): Allow to shoot foot.
(message-supersede): Ditto.
-2001-02-08 Tommi Vainikainen <thv@iki.fi>
+2001-02-08 Tommi Vainikainen <thv@iki.fi>
+ Trivial patch.
* gnus-sum.el (gnus-simplify-subject-re): Use
message-subject-re-regexp.
* gnus-agent.el (gnus-agentize): Fix doc.
-2001-02-02 Karl Kleinpaste <karl@charcoal.com>
+2001-02-02 Karl Kleinpaste <karl@charcoal.com>
* mml.el (mml-preview): Bind `q'.
* gnus-art.el (article-hide-list-identifiers): Similar.
-2001-01-31 Karl Kleinpaste <karl@charcoal.com>
+2001-01-31 Karl Kleinpaste <karl@charcoal.com>
* nnmail.el (nnmail-remove-list-identifiers): Improved.
* gnus-art.el (article-hide-boring-headers): Use it.
-2001-01-27 Karl Kleinpaste <karl@charcoal.com>
+2001-01-27 Karl Kleinpaste <karl@charcoal.com>
* gnus-art.el (gnus-article-banner-alist): eGroups new banner.
* message.el (message-ignored-news-headers): Only search beginning
of line.
-2001-01-19 Alberto Lusiani <a.lusiani@noemail.org>
+2001-01-19 ShengHuo Zhu <zsh@cs.rochester.edu>
+ Trivial patch from Alberto Lusiani <a.lusiani@noemail.org>
* message.el (message-send-mail): Content-Type may not be there.
(gnus-button-mailto): Setup message. Moved to gnus-msg.el.
(gnus-button-reply): Ditto.
-2001-01-16 Katsumi Yamaoka <yamaoka@jpl.org>
+2001-01-16 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (article-display-x-face): Fix.
* gnus-art.el (article-display-x-face): Use
gnus-original-article-buffer.
-2001-01-15 Jack Twilley <jmt@tbe.net>
+2001-01-15 Jack Twilley <jmt@tbe.net>
* message.el (message-add-header): Move to point-max.
image/x-portable-bitmap.
(mm-get-image): Grok pbm.
-2001-01-10 Paul Stevenson <p.stevenson@surrey.ac.uk>
+2001-01-10 Paul Stevenson <p.stevenson@surrey.ac.uk>
* nnvirtual.el (nnvirtual-request-expire-articles): delq nil.
* gnus-art.el (gnus-mime-view-part): Copy it.
(gnus-mime-view-part-as-type): Add into gnus-article-mime-handles.
-2001-01-09 Michael Downes <mjd@ams.org>
+2001-01-09 Michael Downes <mjd@ams.org>
* gnus-sum.el (gnus-summary-read-group-1): More useful message.
* time-date.el (time-to-number-of-days): New function.
2001-01-04 11:06:14 Gregory Chernov <greg@visiontech-dml.com>
+ Trivial patch.
* nnslashdot.el (nnslashdot-request-list): Always get the right
sid.
* nnslashdot.el (nnslashdot-request-list): Get the right year.
2001-01-01 00:52:44 Ed L. Cashin <ecashin@coe.uga.edu>
+ A revoked patch.
* gnus-sum.el (gnus-summary-expire-articles): Save excursion.
(gnus-new-processable): New function.
2000-12-28 19:21:57 Inge Frick <inge@nada.kth.se>
+ Trivial patch.
* gnus-sum.el (gnus-no-mark): New variable.
* nnwfm.el (nnwfm-create-mapping): Remove quote marks and
backslashes.
-2000-12-26 Katsumi Yamaoka <yamaoka@jpl.org>
+2000-12-26 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-article-banner-alist): Remove duplicate
definition.
* qp.el (quoted-printable-encode-region): Don't check multibyte in
XEmacs.
-2000-12-25 Lloyd Zusman <ljz@asfast.com>
+2000-12-25 Lloyd Zusman <ljz@asfast.com>
+ Trivial patch.
* mml.el (mml-read-tag): Save tag location.
* message.el (message-make-forward-subject): Don't widen. Decode.
(message-forward): Don't decode subject.
-2000-12-20 Christoph Conrad <C.Conrad@cli.de>
+2000-12-20 Christoph Conrad <C.Conrad@cli.de>
* qp.el (quoted-printable-encode-region): Upcase QP.
* gnus.el: Before merge with Emacs21.
-2000-12-19 Raymond Scholz <ray-2000@zonix.de>
+2000-12-19 Raymond Scholz <ray-2000@zonix.de>
* gnus-art.el (gnus-article-dumbquotes-map): Add EUR symbol.
* mml2015.el (mml2015-fix-micalg): Alg might be nil.
-2000-12-01 Christopher Splinter <chris@splinter.inka.de>
+2000-12-01 ShengHuo ZHU <zsh@cs.rochester.edu>
+ Trivial patch from Christopher Splinter <chris@splinter.inka.de>
* gnus-sum.el (gnus-summary-limit-to-age): Fix typo.
* gnus-art.el (gnus-mime-security-show-details): Goto beginning of
buffer.
-2000-11-23 Jens Krinke <j.krinke@gmx.de>
+2000-11-23 Jens Krinke <j.krinke@gmx.de>
* smime.el (smime-decrypt-region): Fix keyfile argument.
* message.el (message-send-mail): Use buffer-substring-no-properties.
(message-send-news): Ditto.
-2000-11-22 David Edmondson <dme@dme.org>
+2000-11-22 David Edmondson <dme@dme.org>
* imap.el (imap-wait-for-tag): Message read info.
* mml.el (mml-generate-mime-1): Ignore ascii.
-2000-11-16 Justin Sheehy <justin@iago.org>
+2000-11-16 Justin Sheehy <justin@iago.org>
* gnus-sum.el (gnus-summary-make-menu-bar): Fix menu items.
* mm-decode.el (mm-display-parts): New function.
* gnus-art.el (gnus-mime-view-all-parts): Use it. Remove parts first.
-2000-02-02 Alexandre Oliva <oliva@lsd.ic.unicamp.br>
+2000-02-02 Alexandre Oliva <oliva@lsd.ic.unicamp.br>
* gnus-mlspl.el: Documentation tweaks.
(nnultimate-table-regexp): New variable.
(nnultimate-forum-table-p): Use it.
-2000-10-30 Ed L Cashin <ecashin@coe.uga.edu>
+2000-10-30 Ed L Cashin <ecashin@coe.uga.edu>
+ Trivial patch.
* gnus-sum.el (gnus-summary-expire-articles): Save point.
* gnus-topic.el (gnus-group-prepare-topics): Accept predicate.
(gnus-topic-prepare-topic): Ditto.
-2000-10-27 Paul Jarc <prj@po.cwru.edu>
+2000-10-27 Paul Jarc <prj@po.cwru.edu>
* message.el (message-insert-to, message-get-reply-headers):
(message-reply, message-followup): Mail-{Followup,Reply}-To.
'identity)))
(defcustom binhex-decoder-program "hexbin"
- "*Non-nil value should be a string that names a uu decoder.
+ "*Non-nil value should be a string that names a binhex decoder.
The program should expect to read binhex data on its standard
input and write the converted data to its standard output."
:type 'string
((boundp 'temporary-file-directory) temporary-file-directory)
("/tmp/")))
-(if (featurep 'xemacs)
- (defalias 'binhex-insert-char 'insert-char)
- (defun binhex-insert-char (char &optional count ignored buffer)
- (if (or (null buffer) (eq buffer (current-buffer)))
- (insert-char char count)
- (with-current-buffer buffer
- (insert-char char count)))))
+(eval-and-compile
+ (defalias 'binhex-insert-char
+ (if (featurep 'xemacs)
+ 'insert-char
+ (lambda (char &optional count ignored buffer)
+ "Insert COUNT copies of CHARACTER into BUFFER."
+ (if (or (null buffer) (eq buffer (current-buffer)))
+ (insert-char char count)
+ (with-current-buffer buffer
+ (insert-char char count)))))))
(defvar binhex-crc-table
[0 4129 8258 12387 16516 20645 24774 28903
(>= (buffer-size) data-fork-start)))
(progn
(binhex-verify-crc work-buffer
- 1 data-fork-start)
+ (point-min) data-fork-start)
(setq header (binhex-header work-buffer))
(if header-only (setq tmp nil counter 0))))
(setq tmp (and tmp (not (eq inputpos end)))))
;;; User Customizable Variables:
(defgroup gnus-outlook-deuglify nil
- "Deuglify articles generated by broken user agents like MS
-Outlook (Express).")
+ "Deuglify articles generated by broken user agents like MS Outlook (Express).")
;;;###autoload
(defcustom gnus-outlook-deuglify-unwrap-min 45
:group 'gnus-outlook-deuglify)
(defcustom gnus-outlook-deuglify-unwrap-stop-chars nil ;; ".?!" or nil
- "Characters that inhibit unwrapping if they are the last one on the
-cited line above the possible wrapped line."
+ "Characters that inhibit unwrapping if they are the last one on the cited line above the possible wrapped line."
:type 'string
:group 'gnus-outlook-deuglify)
(defcustom gnus-outlook-deuglify-no-wrap-chars "`"
- "Characters that inhibit unwrapping if they are the first one in the
-possibly wrapped line."
+ "Characters that inhibit unwrapping if they are the first one in the possibly wrapped line."
:type 'string
:group 'gnus-outlook-deuglify)
(defcustom gnus-outlook-deuglify-attrib-cut-regexp
"\\(On \\|Am \\)?\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),[^,]+, "
- "Regular expression matching the beginning of an attribution line
-that should be cut off."
+ "Regular expression matching the beginning of an attribution line that should be cut off."
:type 'string
:group 'gnus-outlook-deuglify)
;; Functions
-;; TODO: don't kill MIME parts
;;;###autoload
(defun gnus-outlook-unwrap-lines ()
- "Unwrap lines that appear to be wrapped citation lines. You can
-control what lines will be unwrapped by frobbing
+ "Unwrap lines that appear to be wrapped citation lines.
+You can control what lines will be unwrapped by frobbing
`gnus-outlook-deuglify-unwrap-min' and
`gnus-outlook-deuglify-unwrap-max', indicating the miminum and maximum
length of an unwrapped citation line."
(replace-match "\\1\\2 \\3")
(goto-char (match-beginning 0))))))))))
-;; TODO: respect signatures, don't kill MIME parts
-(defun gnus-outlook-rearrange-article (from-where)
- "Put the text from `from-where' to the end of buffer at the top of
-the article buffer."
+(defun gnus-outlook-rearrange-article (attr-start)
+ "Put the text from `attr-start' to the end of buffer at the top of the article buffer."
(save-excursion
(let ((inhibit-read-only t)
(cite-marks gnus-outlook-deuglify-cite-marks))
(gnus-with-article-buffer
- (unless (search-forward-regexp
- (concat "^[ \t]*[^" cite-marks "\n]") nil t)
- (kill-region from-where (point-max))
- (article-goto-body)
- (yank)
- (insert "\n"))))))
+ (article-goto-body)
+ ;; article does not start with attribution
+ (unless (= (point) attr-start)
+ (gnus-kill-all-overlays)
+ (let ((cur (point))
+ ;; before signature or end of buffer
+ (to (if (gnus-article-search-signature)
+ (point)
+ (point-max))))
+ ;; handle the case where the full quote is below the
+ ;; signature
+ (if (< to attr-start)
+ (setq to (point-max)))
+ (transpose-regions cur attr-start attr-start to)))))))
;; John Doe <john.doe@some.domain> wrote in message
;; news:a87usw8$dklsssa$2@some.news.server...
"\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
nil t)
(progn
+ (gnus-kill-all-overlays)
(replace-match "\\1\\2\\4")
(match-beginning 0)))))))
(gnus-with-article-buffer
(article-goto-body)
(if (re-search-forward
- (concat "^----* ?[^-]+ ?----*\n"
- "[^\n]+: \\([^\n]+\\)\n"
- "[^\n]+: [^\n]+\n"
- "[^\n]+: [^\n]+\n"
- "[^\n]+: [^\n]+$")
+ (concat "^[" cite-marks " \t]*----* ?[^-]+ [^-]+ ?----*\n"
+ "[^\n:]+:[ \t]*\\([^\n]+\\)\n"
+ "\\([^\n:]+:[ \t]*[^\n]+\n\\)+")
nil t)
(progn
- (replace-match "\\1 wrote:")
+ (gnus-kill-all-overlays)
+ (replace-match "\\1 wrote:\n")
(match-beginning 0)))))))
;; On Wed, 16 Jan 2002 23:23:30 +0100, John Doe <john.doe@some.domain> wrote:
"\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
nil t)
(progn
+ (gnus-kill-all-overlays)
(replace-match "\\4 \\5\\6\\7")
(match-beginning 0)))))))
(interactive)
(gnus-outlook-deuglify-article)
(with-current-buffer (or gnus-article-buffer (current-buffer))
- (gnus-article-prepare-display)))
+ ;; "Emulate" `gnus-article-prepare-display' without calling
+ ;; it. Calling `gnus-article-prepare-display' on an already
+ ;; prepared article removes all MIME parts. I'm unsure whether
+ ;; this is a bug or not.
+ (gnus-article-highlight t)
+ (gnus-treat-article nil)
+ (gnus-run-hooks 'gnus-article-prepare-hook)))
(provide 'deuglify)
(if (funcall pred (car seq2) (car seq1))
(push (pop seq2) res)
(push (pop seq1) res)))
- (coerce (nconc (nreverse res) seq1 seq2) type)))))
+ (let ((x (nconc (nreverse res) seq1 seq2)))
+ (cond ((eq type 'list) (if (listp x) x (append x nil)))
+ ((eq type 'vector) (if (vectorp x) x (vconcat x)))
+ ((eq type 'string) (if (stringp x) x (concat x)))
+ ((eq type 'array) (if (arrayp x) x (vconcat x)))
+ ((and (eq type 'character) (stringp x) (= (length x) 1))
+ (aref x 0))
+ ((and (eq type 'character) (symbolp x))
+ (aref (symbol-name x) 0))
+ ((eq type 'float) (float x))
+ ((typep x type) x)
+ (t (error "Can't coerce %s to type %s" x type))))))))
(define-compiler-macro copy-list (&whole form list)
(if (and (fboundp 'copy-list)
(setq buffer-read-only t)
(set-buffer-modified-p nil))
+;; named for consistency with query-dns in dns.el
+(defun query-dig (domain &optional
+ query-type query-class query-option dig-option server)
+ "Query addresses of a DOMAIN using dig.
+It works by calling `dig-invoke' and `dig-extract-rr'. Optional
+arguments are passed to `dig-invoke' and `dig-extract-rr'. Returns
+nil for domain/class/type queries that results in no data."
+(let ((buffer (dig-invoke domain query-type query-class
+ query-option dig-option server)))
+ (when buffer
+ (switch-to-buffer buffer)
+ (let ((digger (dig-extract-rr domain query-type query-class)))
+ (kill-buffer buffer)
+ digger))))
+
(provide 'dig)
;;; dig.el ends here
:host server
:service "domain"
:type 'datagram)
+ ;; Older versions of Emacs doesn't have
+ ;; `make-network-process', so we fall back on opening a TCP
+ ;; connection to the DNS server.
(open-network-stream "dns" (current-buffer) server "domain")))))
(defun query-dns (name &optional type fullp)
(unless dns-servers
(error "No DNS server configuration found")))
(mm-with-unibyte-buffer
- (let ((process (dns-make-network-process (car dns-servers)))
+ (let ((process (condition-case ()
+ (dns-make-network-process (car dns-servers))
+ (error
+ (message "dns: Got an error while trying to talk to %s"
+ (car dns-servers))
+ nil)))
(tcp-p (and (not (fboundp 'make-network-process))
(not (featurep 'xemacs))))
(step 100)
(times (* dns-timeout 1000))
(id (random 65000)))
- (process-send-string
- process
- (dns-write `((id ,id)
- (opcode query)
- (queries ((,name (type ,type))))
- (recursion-desired-p t))
- tcp-p))
- (while (and (zerop (buffer-size))
- (> times 0))
- (accept-process-output process 0 step)
- (decf times step))
- (ignore-errors
- (delete-process process))
- (when tcp-p
- (goto-char (point-min))
- (delete-region (point) (+ (point) 2)))
- (unless (zerop (buffer-size))
- (let ((result (dns-read (buffer-string))))
- (if fullp
- result
- (let ((answer (car (dns-get 'answers result))))
- (when (eq type (dns-get 'type answer))
- (dns-get 'data answer)))))))))
+ (when process
+ (process-send-string
+ process
+ (dns-write `((id ,id)
+ (opcode query)
+ (queries ((,name (type ,type))))
+ (recursion-desired-p t))
+ tcp-p))
+ (while (and (zerop (buffer-size))
+ (> times 0))
+ (accept-process-output process 0 step)
+ (decf times step))
+ (ignore-errors
+ (delete-process process))
+ (when tcp-p
+ (goto-char (point-min))
+ (delete-region (point) (+ (point) 2)))
+ (unless (zerop (buffer-size))
+ (let ((result (dns-read (buffer-string))))
+ (if fullp
+ result
+ (let ((answer (car (dns-get 'answers result))))
+ (when (eq type (dns-get 'type answer))
+ (dns-get 'data answer))))))))))
(provide 'dns)
;; 2000-02-17 posted on ding mailing list
;; 2000-02-19 use `point-at-{b,e}ol' in XEmacs
;; 2000-03-11 no compile warnings for point-at-bol stuff
-;; 2000-03-26 commited to gnus cvs
+;; 2000-03-26 committed to gnus cvs
;; 2000-10-23 don't flow "-- " lines, make "quote-depth wins" rule
;; work when first line is at level 0.
;; 2002-01-12 probably incomplete encoding support
(when (save-excursion
(beginning-of-line)
(looking-at "^\\(>*\\)\\( ?\\)"))
- (let ((quote (match-string 1)) sig)
+ (let ((quote (match-string 1))
+ sig)
(if (string= quote "")
(setq quote nil))
(when (and quote (string= (match-string 2) ""))
(save-excursion
(unless (eobp)
(forward-char 1)
- (looking-at (format "^\\(%s\\)\\([^>]\\)" (or quote " ?"))))))
+ (looking-at (format "^\\(%s\\)\\([^>]\\)"
+ (or quote " ?"))))))
(save-excursion
(replace-match (if (string= (match-string 2) " ")
"" "\\2")))
(fill-column (eval fill-flowed-display-column))
filladapt-mode)
(fill-region (fill-flowed-point-at-bol)
- (min (1+ (fill-flowed-point-at-eol)) (point-max))
+ (min (1+ (fill-flowed-point-at-eol))
+ (point-max))
'left 'nosqueeze))
- (error nil))))))))
+ (error
+ (forward-line 1)
+ nil))))))))
(provide 'flow-fill)
:group 'gnus-agent
:type 'hook)
-(defcustom gnus-agent-fetched-hook nil
- "Hook run after finishing fetching articles."
- :group 'gnus-agent
- :type 'hook)
-
(defcustom gnus-agent-handle-level gnus-level-subscribed
"Groups on levels higher than this variable will be ignored by the Agent."
:group 'gnus-agent
:type '(repeat (symbol :tag "Mark"))
:group 'gnus-agent)
+(defcustom gnus-agent-consider-all-articles nil
+ "If non-nil, consider also the read articles for downloading."
+ :version "21.4"
+ :type 'boolean
+ :group 'gnus-agent)
+
+(defcustom gnus-agent-max-fetch-size 10000000 ;; 10 Mb
+ "gnus-agent-fetch-session is required to split its article fetches into chunks smaller than this limit."
+ :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-article-alist nil
+"An assoc list identifying the articles whose headers have been fetched.
+ If successfully fetched, these headers will be stored in the group's overview file.
+ The key of each assoc pair is the article ID.
+ The value of each assoc pair is a flag indicating
+ whether the identified article has been downloaded (gnus-agent-fetch-articles
+ sets the value to the day of the download).
+ NOTES:
+ 1) The last element of this list can not be expired as some
+ routines (for example, get-agent-fetch-headers) use the last
+ value to track which articles have had their headers retrieved.
+ 2) The gnus-agent-regenerate may destructively modify the value.
+")
(defvar gnus-agent-group-alist nil)
(defvar gnus-category-alist nil)
(defvar gnus-agent-current-history nil)
(defvar gnus-agent-send-mail-function nil)
(defvar gnus-agent-file-coding-system 'raw-text)
(defvar gnus-agent-file-loading-cache nil)
+(defvar gnus-agent-file-header-cache nil)
+
+(defvar gnus-agent-auto-agentize-methods '(nntp nnimap)
+ "Initially, all servers from these methods are agentized.
+The user may remove or add servers using the Server buffer. See Info
+node `(gnus)Server Buffer'.")
;; Dynamic variables
(defvar gnus-headers)
(gnus-add-shutdown 'gnus-close-agent 'gnus)
(defun gnus-close-agent ()
- (setq gnus-agent-covered-methods nil
- gnus-category-predicate-cache nil
+ (setq gnus-category-predicate-cache nil
gnus-category-group-cache nil
gnus-agent-spam-hashtb nil)
(gnus-kill-buffer gnus-agent-overview-buffer))
(defun gnus-agent-start-fetch ()
"Initialize data structures for efficient fetching."
- (gnus-agent-open-history)
- (setq gnus-agent-current-history (gnus-agent-history-buffer))
(gnus-agent-create-buffer))
(defun gnus-agent-stop-fetch ()
"Save all data structures and clean up."
- (gnus-agent-save-history)
- (gnus-agent-close-history)
(setq gnus-agent-spam-hashtb nil)
(save-excursion
(set-buffer nntp-server-buffer)
(put 'gnus-agent-with-fetch 'lisp-indent-function 0)
(put 'gnus-agent-with-fetch 'edebug-form-spec '(body))
+(defmacro gnus-agent-append-to-list (tail value)
+ `(setq ,tail (setcdr ,tail (cons ,value nil))))
+
;;;
;;; Mode infestation
;;;
(gnus-define-keys gnus-agent-summary-mode-map
"Jj" gnus-agent-toggle-plugged
"Ju" gnus-agent-summary-fetch-group
+ "Js" gnus-agent-summary-fetch-series
"J#" gnus-agent-mark-article
"J\M-#" gnus-agent-unmark-article
"@" gnus-agent-toggle-mark
message-send-mail-function)
message-send-mail-real-function 'gnus-agent-send-mail))
(unless gnus-agent-covered-methods
- (setq gnus-agent-covered-methods (list gnus-select-method))))
+ (mapcar
+ (lambda (server)
+ (if (memq (car (gnus-server-to-method server))
+ gnus-agent-auto-agentize-methods)
+ (setq gnus-agent-covered-methods
+ (cons (gnus-server-to-method server)
+ gnus-agent-covered-methods ))))
+ (append (list gnus-select-method) gnus-secondary-select-methods))))
(defun gnus-agent-queue-setup ()
"Make sure the queue group exists."
methods (cdr methods)))
covered)))
+;;;###autoload
(defun gnus-agent-possibly-save-gcc ()
"Save GCC if Gnus is unplugged."
(when (and (not gnus-plugged) (gnus-agent-any-covered-gcc))
(erase-buffer)
(nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
(if (null (gnus-check-server gnus-command-method))
- (message "Couldn't open server %s" (nth 1 gnus-command-method))
+ (gnus-message 1 "Couldn't open server %s" (nth 1 gnus-command-method))
(while (not (eobp))
(if (null (eval (read (current-buffer))))
(progn (forward-line)
(push method gnus-agent-covered-methods)
(gnus-server-update-server server)
(gnus-agent-write-servers)
- (message "Entered %s into the Agent" server)))
+ (gnus-message 1 "Entered %s into the Agent" server)))
(defun gnus-agent-remove-server (server)
"Remove SERVER from the agent program."
(delete method gnus-agent-covered-methods))
(gnus-server-update-server server)
(gnus-agent-write-servers)
- (message "Removed %s from the agent" server)))
+ (gnus-message 1 "Removed %s from the agent" server)))
(defun gnus-agent-read-servers ()
"Read the alist of covered servers."
- (setq gnus-agent-covered-methods
- (mapcar (lambda (m)
- (gnus-server-get-method
- nil
- (or m "native")))
- (gnus-agent-read-file
- (nnheader-concat gnus-agent-directory "lib/servers")))))
+ (mapcar (lambda (m)
+ (let ((method (gnus-server-get-method
+ nil
+ (or m "native"))))
+ (if method
+ (unless (member method gnus-agent-covered-methods)
+ (push method gnus-agent-covered-methods))
+ (gnus-message 1 "Ignoring disappeared server `%s'" m)
+ (sit-for 1))))
+ (gnus-agent-read-file
+ (nnheader-concat gnus-agent-directory "lib/servers"))))
(defun gnus-agent-write-servers ()
"Write the alist of covered servers."
(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)))
+ "Mark ARTICLE as downloadable. If UNMARK is nil, article is marked.
+When UNMARK is t, the article is unmarked. For any other value, the
+article's mark is toggled."
+ (let ((unmark (cond ((eq nil unmark)
+ nil)
+ ((eq t unmark)
+ t)
+ (t
+ (memq article gnus-newsgroup-downloadable)))))
+ (gnus-summary-update-mark
(if unmark
- (progn
+ (progn
(setq gnus-newsgroup-downloadable
(delq article gnus-newsgroup-downloadable))
- (push article gnus-newsgroup-undownloaded))
- (setq gnus-newsgroup-undownloaded
- (delq article gnus-newsgroup-undownloaded))
+ (gnus-article-mark article))
+ (progn
(setq gnus-newsgroup-downloadable
- (gnus-add-to-sorted-list gnus-newsgroup-downloadable article)))
- (gnus-summary-update-mark
- (if unmark gnus-undownloaded-mark gnus-downloadable-mark)
+ (gnus-add-to-sorted-list gnus-newsgroup-downloadable article))
+ gnus-downloadable-mark)
+ )
'unread)))
(defun gnus-agent-get-undownloaded-list ()
- "Mark all unfetched articles as read."
+ "Construct list of articles that have not been downloaded."
(let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
- (when (and (not (gnus-online gnus-command-method))
- (gnus-agent-method-p gnus-command-method))
- (gnus-agent-load-alist gnus-newsgroup-name)
- ;; First mark all undownloaded articles as undownloaded.
- (let ((articles (mapcar (lambda (header) (mail-header-number header))
- gnus-newsgroup-headers))
- (agent-articles gnus-agent-article-alist)
- candidates article)
- (while (setq article (pop articles))
- (while (and agent-articles
- (< (caar agent-articles) article))
- (setq agent-articles (cdr agent-articles)))
- (when (or (not (cdar agent-articles))
- (not (= (caar agent-articles) article)))
- (push article candidates)))
- (dolist (article candidates)
- (unless (or (memq article gnus-newsgroup-downloadable)
- (memq article gnus-newsgroup-cached))
- (push article gnus-newsgroup-undownloaded))))
- ;; Then mark downloaded downloadable as not-downloadable,
- ;; if you get my drift.
- (dolist (article gnus-newsgroup-downloadable)
- (when (cdr (assq article gnus-agent-article-alist))
- (setq gnus-newsgroup-downloadable
- (delq article gnus-newsgroup-downloadable)))))))
+ (when (set (make-local-variable 'gnus-newsgroup-agentized) (gnus-agent-method-p gnus-command-method))
+ (let* ((alist (gnus-agent-load-alist gnus-newsgroup-name))
+ (headers gnus-newsgroup-headers)
+ (undownloaded (list nil))
+ (tail undownloaded))
+ (while (and alist headers)
+ (let ((a (caar alist))
+ (h (mail-header-number (car headers))))
+ (cond ((< a h)
+ (pop alist)) ; ignore IDs in the alist that are not being displayed in the summary
+ ((> a h)
+ (pop headers)) ; ignore headers that are not in the alist as these should be fictious (see nnagent-retrieve-headers).
+ ((cdar alist)
+ (pop alist)
+ (pop headers)
+ nil; ignore already downloaded
+ )
+ (t
+ (pop alist)
+ (pop headers)
+ (gnus-agent-append-to-list tail a)))))
+ (setq gnus-newsgroup-undownloaded (cdr undownloaded))))))
(defun gnus-agent-catchup ()
"Mark all undownloaded articles as read."
(pop gnus-newsgroup-undownloaded) gnus-catchup-mark)))
(gnus-summary-position-point))
-(defun gnus-agent-summary-fetch-group ()
- "Fetch the downloadable articles in the group."
+(defun gnus-agent-summary-fetch-series ()
(interactive)
- (let ((articles gnus-newsgroup-downloadable)
+ (let ((dl gnus-newsgroup-downloadable))
+ (while gnus-newsgroup-processable
+ (let* ((art (car (last gnus-newsgroup-processable)))
+ (gnus-newsgroup-downloadable (list art)))
+ (gnus-summary-goto-subject art)
+ (sit-for 0)
+ (gnus-agent-summary-fetch-group)
+ (setq dl (delq art dl))
+ (gnus-summary-remove-process-mark art)
+ (sit-for 0)))
+ (setq gnus-newsgroup-downloadable dl)))
+
+(defun gnus-agent-summary-fetch-group (&optional all)
+ "Fetch the downloadable articles in the group.
+Optional arg ALL, if non-nil, means to fetch all articles."
+ (interactive "P")
+ (let ((articles
+ (if all gnus-newsgroup-articles
+ gnus-newsgroup-downloadable))
(gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))
(state gnus-plugged))
(unwind-protect
(unless articles
(error "No articles to download"))
(gnus-agent-with-fetch
- (gnus-agent-fetch-articles gnus-newsgroup-name articles))
+ (setq gnus-newsgroup-undownloaded
+ (gnus-sorted-ndifference gnus-newsgroup-undownloaded
+ (gnus-agent-fetch-articles gnus-newsgroup-name articles))))
(save-excursion
(dolist (article articles)
(setq gnus-newsgroup-downloadable
(delq article gnus-newsgroup-downloadable))
(if gnus-agent-mark-unread-after-downloaded
- (gnus-summary-mark-article article gnus-unread-mark)))))
+ (gnus-summary-mark-article article gnus-unread-mark))
+ (gnus-summary-update-download-mark article))))
(when (and (not state)
gnus-plugged)
(gnus-agent-toggle-plugged nil)))))
+(defun gnus-agent-fetch-selected-article ()
+ "Fetch the current article as it is selected.
+This can be added to `gnus-select-article-hook' or
+`gnus-mark-article-hook'."
+ (let ((gnus-command-method gnus-current-select-method))
+ (when (and gnus-plugged (gnus-agent-method-p gnus-command-method))
+ (when (gnus-agent-fetch-articles
+ gnus-newsgroup-name
+ (list gnus-current-article))
+ (setq gnus-newsgroup-undownloaded (delq gnus-current-article gnus-newsgroup-undownloaded))
+ (gnus-summary-update-article gnus-current-article)))))
+
;;;
;;; Internal functions
;;;
?. ?_)
?. ?/))))
-\f
-
(defun gnus-agent-get-function (method)
(if (gnus-online method)
(car method)
(nnheader-insert-file-contents file))
(set (make-local-variable 'gnus-agent-file-name) file))))
-(defun gnus-agent-save-history ()
- (save-excursion
- (set-buffer gnus-agent-current-history)
- (gnus-make-directory (file-name-directory gnus-agent-file-name))
- (let ((coding-system-for-write gnus-agent-file-coding-system))
- (write-region (1+ (point-min)) (point-max)
- gnus-agent-file-name nil 'silent))))
-
(defun gnus-agent-close-history ()
(when (gnus-buffer-live-p gnus-agent-current-history)
(kill-buffer gnus-agent-current-history)
(delq (assoc (gnus-agent-method) gnus-agent-history-buffers)
gnus-agent-history-buffers))))
-(defun gnus-agent-enter-history (id group-arts date)
- (save-excursion
- (set-buffer gnus-agent-current-history)
- (goto-char (point-max))
- (let ((p (point)))
- (insert id "\t" (number-to-string date) "\t")
- (while group-arts
- (insert (format "%S" (intern (caar group-arts)))
- " " (number-to-string (cdr (pop group-arts)))
- " "))
- (insert "\n")
- (while (search-backward "\\." p t)
- (delete-char 1)))))
-
-(defun gnus-agent-article-in-history-p (id)
- (save-excursion
- (set-buffer (gnus-agent-history-buffer))
- (goto-char (point-min))
- (search-forward (concat "\n" id "\t") nil t)))
-
-(defun gnus-agent-history-path (id)
- (save-excursion
- (set-buffer (gnus-agent-history-buffer))
- (goto-char (point-min))
- (when (search-forward (concat "\n" id "\t") nil t)
- (let ((method (gnus-agent-method)))
- (let (paths group)
- (while (not (numberp (setq group (read (current-buffer)))))
- (push (concat method "/" group) paths))
- (nreverse paths))))))
-
;;;
;;; Fetching
;;;
(defun gnus-agent-fetch-articles (group articles)
"Fetch ARTICLES from GROUP and put them into the Agent."
+ (gnus-agent-load-alist group)
(when articles
;; Prune off articles that we have already fetched.
(while (and articles
(setcdr arts (cddr arts))
(setq arts (cdr arts)))))
(when articles
- (let ((dir (concat
+ (let* ((fetched-articles (list nil))
+ (tail-fetched-articles fetched-articles)
+ (dir (concat
(gnus-agent-directory)
(gnus-agent-group-path group) "/"))
(date (time-to-days (current-time)))
(case-fold-search t)
- pos crosses id elem)
+ pos crosses id)
(gnus-make-directory dir)
(gnus-message 7 "Fetching articles for %s..." group)
;; Fetch the articles from the backend.
(with-temp-buffer
(let (article)
(while (setq article (pop articles))
+ (gnus-message 10 "Fetching article %s for %s..."
+ article group)
(when (or
(gnus-backlog-request-article group article
nntp-server-buffer)
(when (search-forward "\n\n" nil t)
(when (search-backward "\nXrefs: " nil t)
;; Handle cross posting.
- (skip-chars-forward "^ ")
+ (goto-char (match-end 0)) ; move to end of header name
+ (skip-chars-forward "^ ") ; skip server name
(skip-chars-forward " ")
(setq crosses nil)
- (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) +")
+ (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) *")
(push (cons (buffer-substring (match-beginning 1)
(match-end 1))
- (buffer-substring (match-beginning 2)
- (match-end 2)))
+ (string-to-int (buffer-substring (match-beginning 2)
+ (match-end 2))))
crosses)
(goto-char (match-end 0)))
- (gnus-agent-crosspost crosses (caar pos))))
+ (gnus-agent-crosspost crosses (caar pos) date)))
(goto-char (point-min))
(if (not (re-search-forward
"^Message-ID: *<\\([^>\n]+\\)>" nil t))
(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))
+
+ (gnus-agent-append-to-list tail-fetched-articles (caar pos)))
(widen)
(pop pos)))
- (gnus-agent-save-alist group)))))
-(defun gnus-agent-crosspost (crosses article)
+ (gnus-agent-save-alist group (cdr fetched-articles) date)
+ (cdr fetched-articles)))))
+
+(defun gnus-agent-crosspost (crosses article &optional date)
+ (setq date (or date t))
+
(let (gnus-agent-article-alist group alist beg end)
(save-excursion
(set-buffer gnus-agent-overview-buffer)
(unless (setq alist (assoc group gnus-agent-group-alist))
(push (setq alist (list group (gnus-agent-load-alist (caar crosses))))
gnus-agent-group-alist))
- (setcdr alist (cons (cons (cdar crosses) t) (cdr alist)))
+ (setcdr alist (cons (cons (cdar crosses) date) (cdr alist)))
(save-excursion
(set-buffer (gnus-get-buffer-create (format " *Gnus agent overview %s*"
group)))
(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))
+ (insert-buffer-substring gnus-agent-overview-buffer beg end)
+ (gnus-agent-check-overview-buffer))
(pop crosses))))
+(defun gnus-agent-check-overview-buffer (&optional buffer)
+ "Check the overview file given for sanity.
+In particular, checks that the file is sorted by article number
+and that there are no duplicates."
+ (let ((prev-num -1))
+ (save-excursion
+ (when buffer
+ (set-buffer buffer))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+
+ (while (< (point) (point-max))
+ (let ((p (point))
+ (cur (condition-case nil
+ (read (current-buffer))
+ (error nil))))
+ (cond
+ ((or (not (integerp cur))
+ (not (eq (char-after) ?\t)))
+ (gnus-message 1
+ "Overview buffer contains garbage '%s'."
+ (buffer-substring
+ p (gnus-point-at-eol))))
+ ((= cur prev-num)
+ (gnus-message 1
+ "Duplicate overview line for %d" cur)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ((< cur 0)
+ (gnus-message 1 "Junk article number %d" cur)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ((< cur prev-num)
+ (sort-numeric-fields 1 (point-min) (point-max))
+ (goto-char (point-min))
+ (setq prev-num -1)
+ (gnus-message 1 "Overview buffer not sorted!"))
+ (t
+ (setq prev-num cur)))
+ (forward-line 1)))))))
+
(defun gnus-agent-flush-cache ()
(save-excursion
(while gnus-agent-buffer-alist
nil 'silent))
(pop gnus-agent-buffer-alist))
(while gnus-agent-group-alist
- (with-temp-file (caar gnus-agent-group-alist)
+ (with-temp-file (gnus-agent-article-name ".agentview" (caar gnus-agent-group-alist))
(princ (cdar gnus-agent-group-alist))
+ (insert "\n")
+ (princ 1 (current-buffer))
(insert "\n"))
(pop gnus-agent-group-alist))))
(defun gnus-agent-fetch-headers (group &optional force)
- (let ((articles (gnus-list-of-unread-articles group))
- (gnus-decode-encoded-word-function 'identity)
- (file (gnus-agent-article-name ".overview" group))
- gnus-agent-cache)
- ;; Add article with marks to list of article headers we want to fetch.
- (dolist (arts (gnus-info-marks (gnus-get-info group)))
- (unless (memq (car arts) '(seen recent))
- (setq articles (gnus-range-add articles (cdr arts)))))
- (setq articles (sort (gnus-uncompress-sequence articles) '<))
- ;; Remove known articles.
- (when (gnus-agent-load-alist group)
- (setq articles (gnus-list-range-intersection
- articles
- (list
- (cons (1+ (caar (last gnus-agent-article-alist)))
- (cdr (gnus-active group)))))))
- ;; Fetch them.
- (gnus-make-directory (nnheader-translate-file-chars
- (file-name-directory file) t))
- (when articles
- (gnus-message 7 "Fetching headers for %s..." group)
+ "Fetch interesting headers into the agent. The group's overview
+file will be updated to include the headers while a list of available
+article numbers will be returned."
+ (let* ((fetch-all (and gnus-agent-consider-all-articles
+ ;; Do not fetch all headers if the predicate
+ ;; implies that we only consider unread articles.
+ (not (gnus-predicate-implies-unread
+ (or (gnus-group-find-parameter
+ group 'agent-predicate t)
+ (cadr (gnus-group-category group)))))))
+ (articles (if fetch-all
+ (gnus-uncompress-range (gnus-active group))
+ (gnus-list-of-unread-articles group)))
+ (gnus-decode-encoded-word-function 'identity)
+ (file (gnus-agent-article-name ".overview" group))
+ gnus-agent-cache)
+
+ (unless fetch-all
+ ;; Add articles with marks to the list of article headers we want to
+ ;; fetch. Don't fetch articles solely on the basis of a recent or seen
+ ;; mark, but do fetch recent or seen articles if they have other, more
+ ;; interesting marks. (We have to fetch articles with boring marks
+ ;; because otherwise the agent will remove their marks.)
+ (dolist (arts (gnus-info-marks (gnus-get-info group)))
+ (unless (memq (car arts) '(seen recent))
+ (setq articles (gnus-range-add articles (cdr arts)))))
+ (setq articles (sort (gnus-uncompress-sequence articles) '<)))
+
+ ;; At this point, I have the list of articles to consider for fetching.
+ ;; This is the list that I'll return to my caller. Some of these articles may have already
+ ;; been fetched. That's OK as the fetch article code will filter those out.
+ ;; Internally, I'll filter this list to just those articles whose headers need to be fetched.
+ (let ((articles articles))
+ ;; Remove known articles.
+ (when (gnus-agent-load-alist group)
+ ;; Remove articles marked as downloaded.
+ (if fetch-all
+ ;; I want to fetch all headers in the active range.
+ ;; Therefore, exclude only those headers that are in the article alist.
+ ;; NOTE: This is probably NOT what I want to do after agent expiration in this group.
+ (setq articles (gnus-agent-uncached-articles articles group))
+
+ ;; I want to only fetch those headers that have never been fetched.
+ ;; Therefore, exclude all headers that are, or WERE, in the article alist.
+ (let ((low (1+ (caar (last gnus-agent-article-alist))))
+ (high (cdr (gnus-active group))))
+ ;; Low can be greater than High when the same group is fetched twice
+ ;; in the same session {The first fetch will fill the article alist
+ ;; such that (last gnus-agent-article-alist) equals (cdr (gnus-active group))}.
+ ;; The addition of one(the 1+ above) then forces Low to be greater than High.
+ ;; When this happens, gnus-list-range-intersection returns nil which indicates
+ ;; that no headers need to be fetched. -- Kevin
+ (setq articles (gnus-list-range-intersection
+ articles (list (cons low high)))))))
(save-excursion
- (set-buffer nntp-server-buffer)
- (unless (eq 'nov (gnus-retrieve-headers articles group))
- (nnvirtual-convert-headers))
- ;; Save these headers for later processing.
- (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
- (when (file-exists-p file)
- (gnus-agent-braid-nov group articles file))
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (write-region (point-min) (point-max) file nil 'silent))
- (gnus-agent-save-alist group articles nil)
- (gnus-agent-enter-history
- "last-header-fetched-for-session"
- (list (cons group (nth (- (length articles) 1) articles)))
- (time-to-days (current-time)))
- articles))))
+ (set-buffer nntp-server-buffer)
+
+ (if articles
+ (progn
+ (gnus-message 7 "Fetching headers for %s..." group)
+
+ ;; Fetch them.
+ (gnus-make-directory (nnheader-translate-file-chars
+ (file-name-directory file) t))
+
+ (unless (eq 'nov (gnus-retrieve-headers articles group))
+ (nnvirtual-convert-headers))
+ (gnus-agent-check-overview-buffer)
+ ;; Move these headers to the overview buffer so that gnus-agent-braid-nov can merge them
+ ;; with the contents of FILE.
+ (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
+ (when (file-exists-p file)
+ (gnus-agent-braid-nov group articles file))
+ (let ((coding-system-for-write
+ gnus-agent-file-coding-system))
+ (gnus-agent-check-overview-buffer)
+ (write-region (point-min) (point-max) file nil 'silent))
+ (gnus-agent-save-alist group articles nil)
+ articles)
+ (ignore-errors
+ (erase-buffer)
+ (nnheader-insert-file-contents file))))
+ )
+ articles))
(defsubst gnus-agent-copy-nov-line (article)
(let (art b e)
(insert-buffer-substring gnus-agent-overview-buffer b e))))
(defun gnus-agent-braid-nov (group articles file)
+ "Merges the article headers identified by ARTICLES from gnus-agent-overview-buffer with the contents
+of FILE placing the combined headers in nntp-server-buffer."
(let (start last)
(set-buffer gnus-agent-overview-buffer)
(goto-char (point-min))
(erase-buffer)
(nnheader-insert-file-contents file)
(goto-char (point-max))
+ (forward-line -1)
+ (unless (looking-at "[0-9]+\t")
+ ;; Remove corrupted lines
+ (gnus-message 1 "Overview %s is corrupted. Removing corrupted lines..." file)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (looking-at "[0-9]+\t")
+ (forward-line 1)
+ (delete-region (point) (progn (forward-line 1) (point)))))
+ (forward-line -1))
(unless (or (= (point-min) (point-max))
- (progn
- (forward-line -1)
- (< (setq last (read (current-buffer))) (car articles))))
+ (< (setq last (read (current-buffer))) (car articles)))
;; We do it the hard way.
- (nnheader-find-nov-line (car articles))
+ (when (nnheader-find-nov-line (car articles))
+ ;; Replacing existing NOV entry
+ (delete-region (point) (progn (forward-line 1) (point))))
(gnus-agent-copy-nov-line (pop articles))
- (while (and articles
- (not (eobp)))
- (while (and (not (eobp))
- (< (read (current-buffer)) (car articles)))
- (forward-line 1))
- (beginning-of-line)
- (unless (eobp)
+
+ (ignore-errors
+ (while articles
+ (while (let ((art (read (current-buffer))))
+ (cond ((< art (car articles))
+ (forward-line 1)
+ t)
+ ((= art (car articles))
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point)))
+ nil)
+ (t
+ (beginning-of-line)
+ nil))))
+
(gnus-agent-copy-nov-line (pop articles)))))
+
;; Copy the rest lines
(set-buffer nntp-server-buffer)
(goto-char (point-max))
(when articles
(when last
(set-buffer gnus-agent-overview-buffer)
- (while (and (not (eobp))
- (<= (read (current-buffer)) last))
- (forward-line 1))
+ (ignore-errors
+ (while (<= (read (current-buffer)) last)
+ (forward-line 1)))
(beginning-of-line)
(setq start (point))
(set-buffer nntp-server-buffer))
(insert-buffer-substring gnus-agent-overview-buffer start))))
-(defun gnus-agent-load-alist (group &optional dir)
- "Load the article-state alist for GROUP."
- (let ((file ))
- (setq gnus-agent-article-alist
- (gnus-cache-file-contents
- (if dir
- (expand-file-name ".agentview" dir)
- (gnus-agent-article-name ".agentview" group))
- 'gnus-agent-file-loading-cache
- 'gnus-agent-read-file))))
+(eval-when-compile ; Keeps the compiler from warning about the free variable in gnus-agent-read-agentview
+ (defvar gnus-agent-read-agentview))
+
+(defun gnus-agent-load-alist (group)
+ (let ((gnus-agent-read-agentview group)) ; Binds free variable that's used in gnus-agent-read-agentview
+ "Load the article-state alist for GROUP."
+ (setq gnus-agent-article-alist
+ (gnus-cache-file-contents
+ (gnus-agent-article-name ".agentview" group)
+ 'gnus-agent-file-loading-cache
+ 'gnus-agent-read-agentview))))
+
+;; Save format may be either 1 or 2. Two is the new, compressed format that is still being tested. Format 1 is uncompressed but known to be reliable.
+(defconst gnus-agent-article-alist-save-format 2)
+
+(defun gnus-agent-read-agentview (file)
+ "Load FILE and do a `read' there."
+ (with-temp-buffer
+ (ignore-errors
+ (nnheader-insert-file-contents file)
+ (goto-char (point-min))
+ (let ((alist (read (current-buffer)))
+ (version (condition-case nil (read (current-buffer))
+ (end-of-file 0)))
+ changed-version)
+
+ (cond ((= version 0)
+ (let ((inhibit-quit t)
+ entry)
+ (gnus-agent-open-history)
+ (set-buffer (gnus-agent-history-buffer))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (and (looking-at
+ "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)")
+ (string= (match-string 2)
+ gnus-agent-read-agentview)
+ (setq entry (assoc (string-to-number (match-string 3)) alist)))
+ (setcdr entry (string-to-number (match-string 1))))
+ (forward-line 1))
+ (gnus-agent-close-history)
+ (setq changed-version t)))
+ ((= version 1)
+ (setq changed-version (not (= 1 gnus-agent-article-alist-save-format))))
+ ((= version 2)
+ (let (uncomp)
+ (mapcar (lambda (comp-list)
+ (let ((state (car comp-list))
+ (sequence (gnus-uncompress-sequence (cdr comp-list))))
+ (mapcar (lambda (article-id)
+ (setq uncomp (cons (cons article-id state) uncomp))) sequence))) alist)
+ (setq alist (sort uncomp (lambda (first second) (< (car first) (car second)))))
+ )
+ ))
+ (when changed-version
+ (let ((gnus-agent-article-alist alist))
+ (gnus-agent-save-alist gnus-agent-read-agentview)))
+ alist))))
(defun gnus-agent-save-alist (group &optional articles state dir)
"Save the article-state alist for GROUP."
print-level print-length item article)
(while (setq article (pop articles))
(while (and (cdr prev)
- (< (caadr prev) article))
+ (< (caadr prev) article))
(setq prev (cdr prev)))
(cond
((not (cdr prev))
(setcdr (cadr prev) state)))
(setq prev (cdr prev)))
(setq gnus-agent-article-alist (cdr all))
+ (if dir
+ (gnus-make-directory dir)
+ (gnus-make-directory (gnus-agent-article-name "" group)))
(with-temp-file (if dir
(expand-file-name ".agentview" dir)
(gnus-agent-article-name ".agentview" group))
- (princ gnus-agent-article-alist (current-buffer))
+ (cond ((eq gnus-agent-article-alist-save-format 1)
+ (princ gnus-agent-article-alist (current-buffer)))
+ ((eq gnus-agent-article-alist-save-format 2)
+ (let ((compressed nil))
+ (mapcar (lambda (pair)
+ (let* ((article-id (car pair))
+ (day-of-download (cdr pair))
+ (comp-list (assq day-of-download compressed)))
+ (if comp-list
+ (setcdr comp-list (cons article-id (cdr comp-list)))
+ (setq compressed (cons (list day-of-download article-id) compressed)))
+ nil)) gnus-agent-article-alist)
+ (mapcar (lambda (comp-list) (setcdr comp-list (gnus-compress-sequence (nreverse (cdr comp-list))))) compressed)
+ (princ compressed (current-buffer))
+ )
+ )
+ )
+ (insert "\n")
+ (princ gnus-agent-article-alist-save-format (current-buffer))
(insert "\n"))))
(defun gnus-agent-article-name (article group)
(when (<= (gnus-group-level group) gnus-agent-handle-level)
(gnus-agent-fetch-group-1 group gnus-command-method))))))
(error
- (unless (funcall gnus-agent-confirmation-function
- (format "Error (%s). Continue? " (cadr err)))
- (error "Cannot fetch articles into the Gnus agent")))
+ (unless (funcall gnus-agent-confirmation-function
+ (format "Error %s. Continue? " (cdr err)))
+ (error "Cannot fetch articles into the Gnus agent")))
(quit
(unless (funcall gnus-agent-confirmation-function
- (format "Quit fetching session (%s). Continue? "
- (cadr err)))
+ (format "Quit fetching session %s. Continue? "
+ (cdr err)))
(signal 'quit "Cannot fetch articles into the Gnus agent"))))
(pop methods))
(run-hooks 'gnus-agent-fetch-hook)
)
(unless (gnus-check-group group)
(error "Can't open server for %s" group))
+
;; Fetch headers.
- (when (and (or (gnus-active group)
- (gnus-activate-group group))
- (setq articles (gnus-agent-fetch-headers group))
- (let ((nntp-server-buffer gnus-agent-overview-buffer))
- ;; Parse them and see which articles we want to fetch.
- (setq gnus-newsgroup-dependencies
- (make-vector (length articles) 0))
- (setq gnus-newsgroup-headers
- (gnus-get-newsgroup-headers-xover articles nil nil
- group))
- ;; `gnus-agent-overview-buffer' may be killed for
- ;; timeout reason. If so, recreate it.
- (gnus-agent-create-buffer)))
- (setq category (gnus-group-category group))
- (setq predicate
- (gnus-get-predicate
- (or (gnus-group-find-parameter group 'agent-predicate t)
- (cadr category))))
- (if (memq predicate '(gnus-agent-true gnus-agent-false))
- ;; Simple implementation
- (setq arts (and (eq predicate 'gnus-agent-true) articles))
- (setq arts nil)
- (setq score-param
- (or (gnus-group-get-parameter group 'agent-score t)
- (caddr category)))
- ;; Translate score-param into real one
- (cond
- ((not score-param))
- ((eq score-param 'file)
- (setq score-param (gnus-all-score-files group)))
- ((stringp (car score-param)))
- (t
- (setq score-param (list (list score-param)))))
- (when score-param
- (gnus-score-headers score-param))
- (while (setq gnus-headers (pop gnus-newsgroup-headers))
- (setq gnus-score
- (or (cdr (assq (mail-header-number gnus-headers)
- gnus-newsgroup-scored))
- gnus-summary-default-score))
- (when (funcall predicate)
- (push (mail-header-number gnus-headers)
- arts))))
- ;; Fetch the articles.
- (when arts
- (gnus-agent-fetch-articles group arts)))
- ;; Perhaps we have some additional articles to fetch.
- (dolist (mark gnus-agent-download-marks)
- (setq arts (assq mark (gnus-info-marks
- (setq info (gnus-get-info group)))))
- (when (cdr arts)
- (gnus-message 8 "Agent is downloading marked articles...")
- (gnus-agent-fetch-articles
- group (gnus-uncompress-range (cdr arts)))
- (when (eq mark 'download)
- (setq marks (delq arts (gnus-info-marks info)))
- (gnus-info-set-marks info marks)
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (gnus-prin1-to-string info)
- ")")))))))
+ (when (or (gnus-active group)
+ (gnus-activate-group group))
+ (let ((marked-articles nil))
+ ;; Identify the articles marked for download
+ (dolist (mark gnus-agent-download-marks)
+ (let ((arts (cdr (assq mark (gnus-info-marks
+ (setq info (gnus-get-info group)))))))
+ (when arts
+ (setq marked-articles (nconc (gnus-uncompress-range arts)
+ marked-articles))
+ )))
+ (setq marked-articles (sort marked-articles '<))
+
+ ;; Fetch any new articles from the server
+ (setq articles (gnus-agent-fetch-headers group))
+
+ ;; Merge new articles with marked
+ (setq articles (sort (append marked-articles articles) '<))
+
+ (when articles
+ ;; Parse them and see which articles we want to fetch.
+ (setq gnus-newsgroup-dependencies
+ (make-vector (length articles) 0))
+
+ (setq gnus-newsgroup-headers
+ (gnus-get-newsgroup-headers-xover articles nil nil
+ group))
+ ;; `gnus-agent-overview-buffer' may be killed for
+ ;; timeout reason. If so, recreate it.
+ (gnus-agent-create-buffer)
+
+ ;; Figure out how to select articles in this group
+ (setq category (gnus-group-category group))
+
+ (setq predicate
+ (gnus-get-predicate
+ (or (gnus-group-find-parameter group 'agent-predicate t)
+ (cadr category))))
+
+ ;; If the selection predicate requires scoring, score each header
+ (unless (memq predicate '(gnus-agent-true gnus-agent-false))
+ (let ((score-param
+ (or (gnus-group-get-parameter group 'agent-score t)
+ (caddr category))))
+ ;; Translate score-param into real one
+ (cond
+ ((not score-param))
+ ((eq score-param 'file)
+ (setq score-param (gnus-all-score-files group)))
+ ((stringp (car score-param)))
+ (t
+ (setq score-param (list (list score-param)))))
+ (when score-param
+ (gnus-score-headers score-param))))
+
+ (unless (and (eq predicate 'gnus-agent-false)
+ (not marked-articles))
+ (let* ((arts (list nil))
+ (arts-tail arts)
+ (chunk-size 0)
+ (marked-articles marked-articles)
+ is-marked)
+ (while (setq gnus-headers (pop gnus-newsgroup-headers))
+ (let ((num (mail-header-number gnus-headers)))
+ ;; Determine if this article was marked for download.
+ (while (and marked-articles
+ (cond ((< num (car marked-articles))
+ nil)
+ ((= num (car marked-articles))
+ (setq is-marked t)
+ nil)
+ (t
+ (setq marked-articles
+ (cdr marked-articles))))))
+
+ ;; When this article is marked, or selected by the
+ ;; predicate, add it to the download list
+ (when (or is-marked
+ (let ((gnus-score
+ (or (cdr (assq num gnus-newsgroup-scored))
+ gnus-summary-default-score)))
+ (funcall predicate)))
+ (gnus-agent-append-to-list arts-tail num)
+
+ ;; When the expected size of the fetched articles
+ ;; exceeds gnus-agent-max-fetch-size, perform the
+ ;; fetch.
+ (when (< gnus-agent-max-fetch-size
+ (setq chunk-size
+ (+ chunk-size
+ (mail-header-chars gnus-headers))))
+ (gnus-agent-fetch-articles group (cdr arts))
+ (setcdr arts nil)
+ (setq arts-tail arts)
+ (setq chunk-size 0)))))
+
+ ;; Fetch all remaining articles
+ (when (cdr arts)
+ (gnus-agent-fetch-articles group (cdr arts)))))
+
+ ;; When some, or all, of the marked articles came
+ ;; from the download mark. Remove that mark. I
+ ;; didn't do this earlier as I only want to remove
+ ;; the marks after the fetch is completed.
+
+ (when marked-articles
+ (dolist (mark gnus-agent-download-marks)
+ (when (eq mark 'download)
+ (setq arts (assq mark (gnus-info-marks
+ (setq info (gnus-get-info group)))))
+ (when (cdr arts)
+ (setq marks (delq arts (gnus-info-marks info)))
+ (gnus-info-set-marks info marks)
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string info)
+ ")")))))))))))
;;;
;;; Agent Category Mode
%c Topic name (string)
%g The number of groups in the topic (integer)
-General format specifiers can also be used. See
-(gnus)Formatting Variables.")
+General format specifiers can also be used. See Info node
+`(gnus)Formatting Variables'.")
(defvar gnus-category-mode-line-format "Gnus: %%b"
"The format specification for the category mode line.")
All normal editing commands are switched off.
\\<gnus-category-mode-map>
For more in-depth information on this mode, read the manual
-(`\\[gnus-info-find-node]').
+\(`\\[gnus-info-find-node]').
The following commands are available:
(long . gnus-agent-long-p)
(low . gnus-agent-low-scored-p)
(high . gnus-agent-high-scored-p)
+ (read . gnus-agent-read-p)
(true . gnus-agent-true)
(false . gnus-agent-false))
"Mapping from short score predicate symbols to predicate functions.")
"Say whether an article has a high score or not."
(> gnus-score gnus-agent-high-score))
+(defun gnus-agent-read-p ()
+ "Say whether an article is read or not."
+ (gnus-member-of-range (mail-header-number gnus-headers)
+ (gnus-info-read (gnus-get-info gnus-newsgroup-name))))
+
(defun gnus-category-make-function (cat)
"Make a function from category CAT."
(let ((func (gnus-category-make-function-1 cat)))
(list (cons predicate func))))
func)))
+(defun gnus-predicate-implies-unread (predicate)
+ "Say whether PREDICATE implies unread articles only.
+It is okay to miss some cases, but there must be no false positives.
+That is, if this function returns true, then indeed the predicate must
+return only unread articles."
+ ;; Todo: make this work in more cases.
+ (equal predicate '(not read)))
+
(defun gnus-group-category (group)
"Return the category GROUP belongs to."
(unless gnus-category-group-cache
(defun gnus-agent-expire (&optional articles group force)
"Expire all old articles.
If you want to force expiring of certain articles, this function can
-take ARTICLES, GROUP and FORCE parameters as well. Setting ARTICLES
-and GROUP without FORCE is not supported."
+take ARTICLES, GROUP and FORCE parameters as well.
+
+The articles on which the expiration process runs are selected as follows:
+ if ARTICLES is null, all read and unmarked articles.
+ if ARTICLES is t, all articles.
+ if ARTICLES is a list, just those articles.
+Setting GROUP will limit expiration to that group.
+FORCE is equivalent to setting gnus-agent-expire-days to zero(0)."
(interactive)
- (let ((methods (if group
- (list (gnus-find-method-for-group group))
- gnus-agent-covered-methods))
- (day (if (numberp gnus-agent-expire-days)
- (- (time-to-days (current-time)) gnus-agent-expire-days)
- nil))
- (current-day (time-to-days (current-time)))
- gnus-command-method sym arts pos
- history overview file histories elem art nov-file low info
- unreads marked article orig lowest highest found days)
- (save-excursion
- (setq overview (gnus-get-buffer-create " *expire overview*"))
- (while (setq gnus-command-method (pop methods))
- (when (file-exists-p (gnus-agent-lib-file "active"))
- (with-temp-buffer
- (nnheader-insert-file-contents (gnus-agent-lib-file "active"))
- (gnus-active-to-gnus-format
- gnus-command-method
- (setq orig (gnus-make-hashtable
- (count-lines (point-min) (point-max))))))
- (let ((expiry-hashtb (gnus-make-hashtable 1023)))
- (gnus-agent-open-history)
- (set-buffer
- (setq gnus-agent-current-history
- (setq history (gnus-agent-history-buffer))))
- (goto-char (point-min))
- (if (and articles group force) ;; point usless without art+group
- (while (setq article (pop articles))
- ;; try to find history entries for articles
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^[^\t]*\t[^\t]*\t\(.* ?\)"
- (format "%S" (gnus-group-prefixed-name
- group gnus-command-method))
- " "
- (number-to-string article)
- " $")
- nil t)
- (setq pos (point))
- (setq pos nil))
- (setq sym (let ((obarray expiry-hashtb) s)
- (intern group)))
- (if (boundp sym)
- (set sym (cons (cons article pos)
- (symbol-value sym)))
- (set sym (list (cons article pos)))))
- ;; go through history file to find eligble articles
- (when (> (buffer-size) 1)
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward "^\t")
- (if (let ((fetch-date (read (current-buffer))))
- (if (numberp fetch-date)
- ;; We now have the arrival day, so we see
- ;; whether it's old enough to be expired.
- (if (numberp day)
- (> fetch-date day)
- (skip-chars-forward "\t")
- (setq found nil
- days gnus-agent-expire-days)
- (while (and (not found)
- days)
- (when (looking-at (caar days))
- (setq found (cadar days)))
- (pop days))
- (> fetch-date (- current-day found)))
- ;; History file is corrupted.
- (gnus-message
- 5
- (format "File %s is corrupted!"
- (gnus-agent-lib-file "history")))
- (sit-for 1)
- ;; Ignore it
- t))
- ;; New article; we don't expire it.
- (forward-line 1)
- ;; Old article. Schedule it for possible nuking.
- (while (not (eolp))
- (setq sym (let ((obarray expiry-hashtb) s)
- (setq s (read (current-buffer)))
- (if (stringp s) (intern s) s)))
- (if (boundp sym)
- (set sym (cons (cons (read (current-buffer)) (point))
- (symbol-value sym)))
- (set sym (list (cons (read (current-buffer))
- (point)))))
- (skip-chars-forward " "))
- (forward-line 1)))))
- ;; We now have all articles that can possibly be expired.
- (mapatoms
- (lambda (sym)
- (setq group (symbol-name sym)
- arts (sort (symbol-value sym) 'car-less-than-car)
- low (car (gnus-active group))
- info (gnus-get-info group)
- unreads (ignore-errors
- (gnus-list-of-unread-articles group))
- marked (nconc
- (gnus-uncompress-range
- (cdr (assq 'tick (gnus-info-marks info))))
- (gnus-uncompress-range
- (cdr (assq 'dormant
- (gnus-info-marks info)))))
- nov-file (gnus-agent-article-name ".overview" group)
- lowest nil
- highest nil)
- (gnus-agent-load-alist group)
- (gnus-message 5 "Expiring articles in %s" group)
- (set-buffer overview)
- (erase-buffer)
- (when (file-exists-p nov-file)
- (nnheader-insert-file-contents nov-file))
- (goto-char (point-min))
- (setq article 0)
- (while (setq elem (pop arts))
- (setq article (car elem))
- (when (or (null low)
- (< article low)
- gnus-agent-expire-all
- (and (not (memq article unreads))
- (not (memq article marked)))
- force)
- ;; Find and nuke the NOV line.
- (while (and (not (eobp))
- (or (not (numberp
- (setq art (read (current-buffer)))))
- (< art article)))
- (if (and (numberp art)
- (file-exists-p
- (gnus-agent-article-name
- (number-to-string art) group)))
- (progn
- (unless lowest
- (setq lowest art))
- (setq highest art)
- (forward-line 1))
- ;; Remove old NOV lines that have no articles.
- (gnus-delete-line)))
- (if (or (eobp)
- (/= art article))
- (beginning-of-line)
- (gnus-delete-line))
- ;; Nuke the article.
- (when (file-exists-p
- (setq file (gnus-agent-article-name
- (number-to-string article)
- group)))
- (delete-file file))
- ;; Schedule the history line for nuking.
- (if (cdr elem)
- (push (cdr elem) histories))))
- (gnus-make-directory (file-name-directory nov-file))
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (write-region (point-min) (point-max) nov-file nil 'silent))
- ;; Delete the unwanted entries in the alist.
- (setq gnus-agent-article-alist
- (sort gnus-agent-article-alist 'car-less-than-car))
- (let* ((alist gnus-agent-article-alist)
- (prev (cons nil alist))
- (first prev)
- expired)
- (while (and alist
- (<= (caar alist) article))
- (if (or (not (cdar alist))
- (not (file-exists-p
- (gnus-agent-article-name
- (number-to-string
- (caar alist))
- group))))
- (progn
- (push (caar alist) expired)
- (setcdr prev (setq alist (cdr alist))))
- (setq prev alist
- alist (cdr alist))))
- (setq gnus-agent-article-alist (cdr first))
- (gnus-agent-save-alist group)
- ;; Mark all articles up to the first article
- ;; in `gnus-agent-article-alist' as read.
- (when (and info (caar gnus-agent-article-alist))
- (setcar (nthcdr 2 info)
- (gnus-range-add
- (nth 2 info)
- (cons 1 (- (caar gnus-agent-article-alist) 1)))))
- ;; Maybe everything has been expired from
- ;; `gnus-agent-article-alist' and so the above marking as
- ;; read could not be conducted, or there are
- ;; expired article within the range of the alist.
- (when (and info
- expired
- (or (not (caar gnus-agent-article-alist))
- (> (car expired)
- (caar gnus-agent-article-alist))))
- (setcar (nthcdr 2 info)
- (gnus-add-to-range
- (nth 2 info)
- (nreverse expired))))
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (gnus-prin1-to-string info)
- ")")))
- (when lowest
- (if (gnus-gethash group orig)
- (setcar (gnus-gethash group orig) lowest)
- (gnus-sethash group (cons lowest highest) orig))))
- expiry-hashtb)
- (set-buffer history)
- (setq histories (nreverse (sort histories '<)))
- (while histories
- (goto-char (pop histories))
- (gnus-delete-line))
- (gnus-agent-save-history)
- (gnus-agent-close-history)
- (gnus-write-active-file
- (gnus-agent-lib-file "active") orig))
- (gnus-message 4 "Expiry...done"))))))
+
+ (if (or (not (eq articles t))
+ (yes-or-no-p (concat "Are you sure that you want to expire all articles in " (if group group "every agentized group") ".")))
+ (let ((methods (if group
+ (list (gnus-find-method-for-group group))
+ gnus-agent-covered-methods))
+ (day (if (numberp gnus-agent-expire-days)
+ (- (time-to-days (current-time)) gnus-agent-expire-days)
+ nil))
+ gnus-command-method sym arts pos
+ history overview file histories elem art nov-file low info
+ unreads marked article orig lowest highest found days)
+ (save-excursion
+ (setq overview (gnus-get-buffer-create " *expire overview*"))
+ (unwind-protect
+ (while (setq gnus-command-method (pop methods))
+ (when (file-exists-p (gnus-agent-lib-file "active"))
+ (with-temp-buffer
+ (nnheader-insert-file-contents (gnus-agent-lib-file "active"))
+ (gnus-active-to-gnus-format
+ gnus-command-method
+ (setq orig (gnus-make-hashtable
+ (count-lines (point-min) (point-max))))))
+ (dolist (expiring-group (gnus-groups-from-server gnus-command-method))
+ (if (or (not group)
+ (equal group expiring-group))
+ (let* ((dir (concat
+ (gnus-agent-directory)
+ (gnus-agent-group-path expiring-group) "/"))
+ (active
+ (gnus-gethash-safe expiring-group orig)))
+ (when active
+ (gnus-agent-load-alist expiring-group)
+ (gnus-message 5 "Expiring articles in %s" expiring-group)
+ (let* ((info (gnus-get-info expiring-group))
+ (alist gnus-agent-article-alist)
+ (specials (if alist
+ (list (caar (last alist)))))
+ (unreads ;; Articles that are excluded from the expiration process
+ (cond (gnus-agent-expire-all
+ ;; All articles are marked read by global decree
+ nil)
+ ((eq articles t)
+ ;; All articles are marked read by function parameter
+ nil)
+ ((not articles)
+ ;; Unread articles are marked protected from expiration
+ ;; Don't call gnus-list-of-unread-articles as it returns articles that have not been fetched into the agent.
+ (ignore-errors (gnus-agent-unread-articles expiring-group)))
+ (t
+ ;; All articles EXCEPT those named by the caller are protected from expiration
+ (gnus-sorted-difference (gnus-uncompress-range (cons (caar alist) (caar (last alist)))) (sort articles '<)))))
+ (marked ;; More articles that are exluded from the expiration process
+ (cond (gnus-agent-expire-all
+ ;; All articles are unmarked by global decree
+ nil)
+ ((eq articles t)
+ ;; All articles are unmarked by function parameter
+ nil)
+ (articles
+ ;; All articles may as well be unmarked as the unreads list already names the articles we are going to keep
+ nil)
+ (t
+ ;; Ticked and/or dormant articles are excluded from expiration
+ (nconc
+ (gnus-uncompress-range
+ (cdr (assq 'tick (gnus-info-marks info))))
+ (gnus-uncompress-range
+ (cdr (assq 'dormant
+ (gnus-info-marks info))))))))
+ (nov-file (concat dir ".overview"))
+ (cnt 0)
+ (completed -1)
+ dlist
+ type)
+
+ ;; The normal article alist contains elements that look like (article# . fetch_date)
+ ;; I need to combine other information with this list. For example, a flag indicating that a particular article MUST BE KEPT.
+ ;; To do this, I'm going to transform the elements to look like (article# fetch_date keep_flag NOV_entry_marker)
+ ;; Later, I'll reverse the process to generate the expired article alist.
+
+ ;; Convert the alist elements to (article# fetch_date nil nil).
+ (setq dlist (mapcar (lambda (e) (list (car e) (cdr e) nil nil)) alist))
+
+ ;; Convert the keep lists to elements that look like (article# nil keep_flag nil) then append it to the expanded dlist
+ ;; These statements are sorted by ascending precidence of the keep_flag.
+ (setq dlist (nconc dlist
+ (mapcar (lambda (e) (list e nil 'unread nil)) unreads)))
+ (setq dlist (nconc dlist
+ (mapcar (lambda (e) (list e nil 'marked nil)) marked)))
+ (setq dlist (nconc dlist
+ (mapcar (lambda (e) (list e nil 'special nil)) specials)))
+
+ (set-buffer overview)
+ (erase-buffer)
+ (when (file-exists-p nov-file)
+ (gnus-message 7 "gnus-agent-expire: Loading overview...")
+ (nnheader-insert-file-contents nov-file)
+ (goto-char (point-min))
+
+ (let (p)
+ (while (< (setq p (point)) (point-max))
+ (condition-case nil
+ ;; If I successfully read an integer (the plus zero ensures a numeric type), prepend a marker entry to the list
+ (push (list (+ 0 (read (current-buffer))) nil nil (set-marker (make-marker) p)) dlist)
+ (error
+ (gnus-message 1 "gnus-agent-expire: read error occurred when reading expression at %s in %s. Skipping to next line." (point) nov-file)))
+ ;; Whether I succeeded, or failed, it doesn't matter. Move to the next line then try again.
+ (forward-line 1)))
+ (gnus-message 7 "gnus-agent-expire: Loading overview... Done"))
+ (set-buffer-modified-p nil)
+
+ ;; At this point, all of the information is in dlist. The only problem is that much of it is spread across multiple entries. Sort then MERGE!!
+ (gnus-message 7 "gnus-agent-expire: Sorting entries... ")
+ (let ((special 0) ; If two entries have the same article-number then sort by ascending keep_flag.
+ (marked 1)
+ (unread 2))
+ (setq dlist
+ (sort dlist
+ (lambda (a b)
+ (cond ((< (nth 0 a) (nth 0 b))
+ t)
+ ((> (nth 0 a) (nth 0 b))
+ nil)
+ (t
+ (let ((a (or (symbol-value (nth 2 a)) 3))
+ (b (or (symbol-value (nth 2 b)) 3)))
+ (<= a b))))))))
+ (gnus-message 7 "gnus-agent-expire: Sorting entries... Done")
+ (gnus-message 7 "gnus-agent-expire: Merging entries... ")
+ (let ((dlist dlist))
+ (while (cdr dlist) ; I'm not at the end-of-list
+ (if (eq (caar dlist) (caadr dlist))
+ (let ((first (cdr (car dlist)))
+ (secnd (cdr (cadr dlist))))
+ (setcar first (or (car first) (car secnd))) ; fetch_date
+ (setq first (cdr first)
+ secnd (cdr secnd))
+ (setcar first (or (car first) (car secnd))) ; Keep_flag
+ (setq first (cdr first)
+ secnd (cdr secnd))
+ (setcar first (or (car first) (car secnd))) ; NOV_entry_marker
+
+ (setcdr dlist (cddr dlist)))
+ (setq dlist (cdr dlist)))))
+ (gnus-message 7 "gnus-agent-expire: Merging entries... Done")
+
+ (let* ((len (float (length dlist)))
+ (alist (list nil))
+ (tail-alist alist))
+ (while dlist
+ (let ((new-completed (* 100.0 (/ (setq cnt (1+ cnt)) len))))
+ (when (> new-completed completed)
+ (setq completed new-completed)
+ (gnus-message 9 "%3d%% completed..." completed)))
+ (let* ((entry (car dlist))
+ (article-number (nth 0 entry))
+ (fetch-date (nth 1 entry))
+ (keep (nth 2 entry))
+ (marker (nth 3 entry)))
+
+ (cond
+ ;; Kept articles are unread, marked, or special.
+ (keep
+ (when fetch-date
+ (unless (file-exists-p (concat dir (number-to-string article-number)))
+ (setf (nth 1 entry) nil)
+ (gnus-message 3 "gnus-agent-expire cleared download flag on article %d as the cached article file is missing." (caar dlist)))
+ (unless marker
+ (gnus-message 1 "gnus-agent-expire detected a missing NOV entry. Run gnus-agent-regenerate-group to restore it.")))
+ (gnus-agent-append-to-list tail-alist (cons article-number fetch-date)))
+
+ ;; The following articles are READ, UNMARKED, and ORDINARY.
+ ;; See if they can be EXPIRED!!!
+ ((setq type
+ (cond
+ ((not (integerp fetch-date))
+ 'read) ;; never fetched article (may expire right now)
+ ((not (file-exists-p (concat dir (number-to-string article-number))))
+ (setf (nth 1 entry) nil)
+ 'externally-expired) ;; Can't find the cached article. Handle case as though this article was never fetched.
+
+ ;; We now have the arrival day, so we see
+ ;; whether it's old enough to be expired.
+ ((< fetch-date
+ (if (numberp day)
+ day
+ (let (found
+ (days gnus-agent-expire-days))
+ (while (and (not found)
+ days)
+ (when (eq 0 (string-match (caar days) expiring-group))
+ (setq found (cadar days)))
+ (pop days))
+ found)))
+ 'expired)
+ (force
+ 'forced)))
+
+ ;; I found some reason to expire this entry.
+
+ (let ((actions nil))
+ (when (memq type '(forced expired))
+ (ignore-errors ; Just being paranoid.
+ (delete-file (concat dir (number-to-string article-number)))
+ (push "expired cached article" actions))
+ (setf (nth 1 entry) nil)
+ )
+
+ (when marker
+ (push "NOV entry removed" article)
+ (goto-char marker)
+ (gnus-delete-line))
+
+ ;; If considering all articles is set, I can only expire article IDs that are no longer in the active range.
+ (if (and gnus-agent-consider-all-articles
+ (>= article-number (car active)))
+ ;; I have to keep this ID in the alist
+ (gnus-agent-append-to-list tail-alist (cons article-number fetch-date))
+ (push (format "Removed %s article number from article alist" type) actions))
+
+ (gnus-message 7 "gnus-agent-expire: Article %d: %s" article-number (mapconcat 'identity actions ", "))))
+ )
+
+ ;; Clean up markers as I want to recycle this buffer over several groups.
+ (when marker
+ (set-marker marker nil))
+
+ (setq dlist (cdr dlist))))
+
+ (setq alist (cdr alist))
+
+ (let ((inhibit-quit t))
+ (unless (equal alist gnus-agent-article-alist)
+ (setq gnus-agent-article-alist alist)
+ (gnus-agent-save-alist expiring-group))
+
+ (when (buffer-modified-p)
+ (let ((coding-system-for-write
+ gnus-agent-file-coding-system))
+ (gnus-make-directory dir)
+ (write-region (point-min) (point-max) nov-file nil 'silent)
+ ;; clear the modified flag as that I'm not confused by its status on the next pass through this routine.
+ (set-buffer-modified-p nil)))
+
+ (when (eq articles t)
+ (gnus-summary-update-info)))))))))))
+ (kill-buffer overview)))))
+ (gnus-message 4 "Expiry...done"))
;;;###autoload
(defun gnus-agent-batch ()
+ "Start Gnus, send queue and fetch session."
(interactive)
(let ((init-file-user "")
(gnus-always-read-dribble-file t))
(gnus-group-send-queue)
(gnus-agent-fetch-session)))
+(defun gnus-agent-unread-articles (group)
+ (let* ((read (gnus-info-read (gnus-get-info group)))
+ (known (gnus-agent-load-alist group))
+ (unread (list nil))
+ (tail-unread unread))
+ (while (and known read)
+ (let ((candidate (car (pop known))))
+ (while (let* ((range (car read))
+ (min (if (numberp range) range (car range)))
+ (max (if (numberp range) range (cdr range))))
+ (cond ((or (not min)
+ (< candidate min))
+ (gnus-agent-append-to-list tail-unread candidate)
+ nil)
+ ((> candidate max)
+ (pop read)))))))
+ (while known
+ (gnus-agent-append-to-list tail-unread (car (pop known))))
+ (cdr unread)))
+
+(defun gnus-agent-uncached-articles (articles group &optional cached-header)
+ "Constructs sublist of ARTICLES that excludes those articles ids in GROUP that have already been fetched.
+ If CACHED-HEADER is nil, articles are only excluded if the article itself has been fetched."
+
+;; Logically equivalent to: (gnus-sorted-difference articles (mapcar 'car gnus-agent-article-alist))
+;; Functionally, I don't need to construct a temp list using mapcar.
+
+ (if (gnus-agent-load-alist group)
+ (let* ((ref gnus-agent-article-alist)
+ (arts articles)
+ (uncached (list nil))
+ (tail-uncached uncached))
+ (while (and ref arts)
+ (let ((v1 (car arts))
+ (v2 (caar ref)))
+ (cond ((< v1 v2) ; the article (v1) does not appear in the reference list
+ (gnus-agent-append-to-list tail-uncached v1)
+ (pop arts))
+ ((= v1 v2)
+ (unless (or cached-header (cdar ref)) ; the article (v1) is already cached
+ (gnus-agent-append-to-list tail-uncached v1))
+ (pop arts)
+ (pop ref))
+ (t ; the reference article (v2) preceeds the list being filtered
+ (pop ref)))))
+ (while arts
+ (gnus-agent-append-to-list tail-uncached (pop arts)))
+ (cdr uncached))
+ ;; if gnus-agent-load-alist fails, no articles are cached.
+ articles))
+
(defun gnus-agent-retrieve-headers (articles group &optional fetch-old)
(save-excursion
(gnus-agent-create-buffer)
cached-articles uncached-articles)
(gnus-make-directory (nnheader-translate-file-chars
(file-name-directory file) t))
+
+ ;; Populate temp buffer with known headers
(when (file-exists-p file)
(with-current-buffer gnus-agent-overview-buffer
(erase-buffer)
(let ((nnheader-file-coding-system
gnus-agent-file-coding-system))
- (nnheader-insert-nov-file file (car articles)))
- (nnheader-find-nov-line (car articles))
- (while (not (eobp))
- (when (looking-at "[0-9]")
- (push (read (current-buffer)) cached-articles))
- (forward-line 1))
- (setq cached-articles (nreverse cached-articles))))
- (if (setq uncached-articles
- (gnus-sorted-difference articles cached-articles))
+ (nnheader-insert-nov-file file (car articles)))))
+
+ (if (setq uncached-articles (gnus-agent-uncached-articles articles group t))
(progn
+ ;; Populate nntp-server-buffer with uncached headers
(set-buffer nntp-server-buffer)
(erase-buffer)
- (let (gnus-agent-cache)
- (unless (eq 'nov
- (gnus-retrieve-headers
- uncached-articles group fetch-old))
- (nnvirtual-convert-headers)))
+ (let (gnus-agent-cache) ; Turn off agent cache
+ (cond ((not (eq 'nov (gnus-retrieve-headers
+ uncached-articles group fetch-old)))
+ (nnvirtual-convert-headers))
+ ((eq 'nntp (car gnus-current-select-method))
+ ;; The author of gnus-get-newsgroup-headers-xover reports that the XOVER command
+ ;; is commonly unreliable. The problem is that recently posted articles may not
+ ;; be entered into the NOV database in time to respond to my XOVER query.
+ ;;
+ ;; I'm going to use his assumption that the NOV database is updated in order
+ ;; of ascending article ID. Therefore, a response containing article ID N
+ ;; implies that all articles from 1 to N-1 are up-to-date. Therefore,
+ ;; missing articles in that range have expired.
+
+ (set-buffer nntp-server-buffer)
+ (let* ((fetched-articles (list nil))
+ (tail-fetched-articles fetched-articles)
+ (min (cond ((numberp fetch-old)
+ (max 1 (- (car articles) fetch-old)))
+ (fetch-old
+ 1)
+ (t
+ (car articles))))
+ (max (car (last articles))))
+
+ ;; Get the list of articles that were fetched
+ (goto-char (point-min))
+ (ignore-errors
+ (while t
+ (gnus-agent-append-to-list tail-fetched-articles (read (current-buffer)))
+ (forward-line 1)))
+
+ ;; Clip this list to the headers that will actually be returned
+ (setq fetched-articles (gnus-list-range-intersection
+ (cdr fetched-articles)
+ (cons min max)))
+
+ ;; Clip the uncached articles list to exclude IDs after the last FETCHED header.
+ ;; The excluded IDs may be fetchable using HEAD.
+ (if (car tail-fetched-articles)
+ (setq uncached-articles (gnus-list-range-intersection
+ uncached-articles
+ (cons (car uncached-articles) (car tail-fetched-articles)))))
+
+ ;; Create the list of articles that were "successfully" fetched. Success, in
+ ;; this case, means that the ID should not be fetched again. In the case of
+ ;; an expired article, the header will not be fetched.
+ (setq uncached-articles (gnus-sorted-nunion fetched-articles uncached-articles))
+ ))))
+
+ ;; Erase the temp buffer
(set-buffer gnus-agent-overview-buffer)
(erase-buffer)
+
+ ;; Copy the nntp-server-buffer to the temp buffer
(set-buffer nntp-server-buffer)
(copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
+
+ ;; Merge the temp buffer with the known headers (found on disk in FILE) into the nntp-server-buffer
(when (and uncached-articles (file-exists-p file))
(gnus-agent-braid-nov group uncached-articles file))
+
+ ;; Save the new set of known headers to FILE
(set-buffer nntp-server-buffer)
(let ((coding-system-for-write
gnus-agent-file-coding-system))
+ (gnus-agent-check-overview-buffer)
(write-region (point-min) (point-max) file nil 'silent))
+
+ ;; Update the group's article alist to include the newly fetched articles.
(gnus-agent-load-alist group)
(gnus-agent-save-alist group uncached-articles nil)
- (gnus-agent-open-history)
- (setq gnus-agent-current-history (gnus-agent-history-buffer))
- (gnus-agent-enter-history
- "last-header-fetched-for-session"
- (list (cons group (nth (- (length articles) 1) articles)))
- (time-to-days (current-time)))
- (gnus-agent-save-history))
- (set-buffer nntp-server-buffer)
+ )
+
+ ;; Copy the temp buffer to the nntp-server-buffer
+ (set-buffer nntp-server-buffer)
(erase-buffer)
(insert-buffer-substring gnus-agent-overview-buffer)))
+
(if (and fetch-old
(not (numberp fetch-old)))
t ; Don't remove anything.
(car articles))
(car (last articles)))
t)
+
'nov))
(defun gnus-agent-request-article (article group)
(insert-file-contents file))
t)))
-(defun gnus-agent-regenerate-group (group &optional clean)
- "Regenerate GROUP."
- (let ((dir (concat (gnus-agent-directory)
- (gnus-agent-group-path group) "/"))
- (file (gnus-agent-article-name ".overview" group))
- n point arts alist header new-alist changed)
- (when (file-exists-p dir)
- (setq arts
- (sort (mapcar (lambda (name) (string-to-int name))
- (directory-files dir nil "^[0-9]+$" t))
- '<)))
- (gnus-make-directory (nnheader-translate-file-chars
- (file-name-directory file) t))
- (mm-with-unibyte-buffer
- (if (file-exists-p file)
- (let ((nnheader-file-coding-system
- gnus-agent-file-coding-system))
- (nnheader-insert-file-contents file)))
- (goto-char (point-min))
- (while (not (eobp))
- (while (not (or (eobp) (looking-at "[0-9]")))
- (setq point (point))
- (forward-line 1)
- (delete-region point (point)))
- (unless (eobp)
- (setq n (read (current-buffer)))
- (when (and arts (> n (car arts)))
- (beginning-of-line)
- (while (and arts (> n (car arts)))
- (message "Regenerating NOV %s %d..." group (car arts))
- (mm-with-unibyte-buffer
- (nnheader-insert-file-contents
- (concat dir (number-to-string (car arts))))
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (delete-region (point) (point-max))
- (goto-char (point-max)))
- (setq header (nnheader-parse-head t)))
- (mail-header-set-number header (car arts))
- (nnheader-insert-nov header)
- (setq changed t)
- (push (cons (car arts) t) alist)
- (pop arts)))
- (if (and arts (= n (car arts)))
- (progn
- (push (cons n t) alist)
- (pop arts))
- (push (cons n nil) alist))
- (forward-line 1)))
- (if changed
- (let ((coding-system-for-write gnus-agent-file-coding-system))
- (write-region (point-min) (point-max) file nil 'silent))))
- (setq gnus-agent-article-alist nil)
- (unless clean
- (gnus-agent-load-alist group))
- (setq alist (sort alist 'car-less-than-car))
- (setq gnus-agent-article-alist (sort gnus-agent-article-alist
- 'car-less-than-car))
- (while (and alist gnus-agent-article-alist)
- (cond
- ((< (caar alist) (caar gnus-agent-article-alist))
- (push (pop alist) new-alist))
- ((> (caar alist) (caar gnus-agent-article-alist))
- (push (list (car (pop gnus-agent-article-alist))) new-alist))
- (t
- (pop gnus-agent-article-alist)
- (while (and gnus-agent-article-alist
- (= (caar alist) (caar gnus-agent-article-alist)))
- (pop gnus-agent-article-alist))
- (push (pop alist) new-alist))))
- (while alist
- (push (pop alist) new-alist))
- (while gnus-agent-article-alist
- (push (list (car (pop gnus-agent-article-alist))) new-alist))
- (setq gnus-agent-article-alist (nreverse new-alist))
- (gnus-agent-save-alist group)))
-
-(defun gnus-agent-regenerate-history (group article)
- (let ((file (concat (gnus-agent-directory)
- (gnus-agent-group-path group) "/"
- (number-to-string article))) id)
+(defun gnus-agent-regenerate-group (group &optional reread)
+ "Regenerate GROUP. If REREAD is t, all articles in the .overview are marked as unread. If REREAD is not nil, downloaded articles are marked as unread."
+ (gnus-message 5 "Regenerating in %s" group)
+ (let* ((gnus-command-method (or gnus-command-method
+ (gnus-find-method-for-group group)))
+ (file (gnus-agent-article-name ".overview" group))
+ (dir (file-name-directory file))
+ point
+ (downloaded (if (file-exists-p dir)
+ (sort (mapcar (lambda (name) (string-to-int name))
+ (directory-files dir nil "^[0-9]+$" t))
+ '>)
+ (progn (gnus-make-directory dir) nil)))
+ dl nov-arts
+ alist header
+ regenerated)
+
(mm-with-unibyte-buffer
- (nnheader-insert-file-contents file)
- (message-narrow-to-head)
- (goto-char (point-min))
- (if (not (re-search-forward "^Message-ID: *<\\([^>\n]+\\)>" nil t))
- (setq id "No-Message-ID-in-article")
- (setq id (buffer-substring (match-beginning 1) (match-end 1))))
- (gnus-agent-enter-history
- id (list (cons group article))
- (time-to-days (nth 5 (file-attributes file)))))))
+ (if (file-exists-p file)
+ (let ((nnheader-file-coding-system
+ gnus-agent-file-coding-system))
+ (nnheader-insert-file-contents file)))
+ (set-buffer-modified-p nil)
+
+ ;; Load the article IDs found in the overview file. As a side-effect, validate the file contents.
+ (let ((load t))
+ (while load
+ (setq load nil)
+ (goto-char (point-min))
+ (while (< (point) (point-max))
+ (cond ((looking-at "[0-9]+\t")
+ (push (read (current-buffer)) nov-arts)
+ (forward-line 1)
+ (let ((l1 (car nov-arts))
+ (l2 (cadr nov-arts)))
+ (cond ((not l2)
+ nil)
+ ((< l1 l2)
+ (gnus-message 3 "gnus-agent-regenerate-group: NOV entries are NOT in ascending order.")
+ ;; Don't sort now as I haven't verified that every line begins with a number
+ (setq load t))
+ ((= l1 l2)
+ (forward-line -1)
+ (gnus-message 4 "gnus-agent-regenerate-group: NOV entries contained duplicate of article %s. Duplicate deleted." l1)
+ (gnus-delete-line)
+ (pop nov-arts)))))
+ (t
+ (gnus-message 1 "gnus-agent-regenerate-group: NOV entries contained line that did not begin with an article number. Deleted line.")
+ (gnus-delete-line))))
+ (if load
+ (progn
+ (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV entries into ascending order.")
+ (sort-numeric-fields 1 (point-min) (point-max))
+ (setq nov-arts nil)))))
+ (gnus-agent-check-overview-buffer)
+
+ ;; Construct a new article alist whose nodes match every header in the .overview file.
+ ;; As a side-effect, missing headers are reconstructed from the downloaded article file.
+ (while (or downloaded nov-arts)
+ (cond ((and downloaded
+ (or (not nov-arts)
+ (> (car downloaded) (car nov-arts))))
+ ;; This entry is missing from the overview file
+ (gnus-message 3 "Regenerating NOV %s %d..." group (car downloaded))
+ (let ((file (concat dir (number-to-string (car downloaded)))))
+ (mm-with-unibyte-buffer
+ (nnheader-insert-file-contents file)
+ (nnheader-remove-body)
+ (setq header (nnheader-parse-naked-head)))
+ (mail-header-set-number header (car downloaded))
+ (if nov-arts
+ (let ((key (concat "^" (int-to-string (car nov-arts)) "\t")))
+ (or (re-search-backward key nil t)
+ (re-search-forward key))
+ (forward-line 1))
+ (goto-char (point-min)))
+ (nnheader-insert-nov header))
+ (setq nov-arts (cons (car downloaded) nov-arts)))
+ ((eq (car downloaded) (car nov-arts))
+ ;; This entry in the overview has been downloaded
+ (push (cons (car downloaded) (time-to-days (nth 5 (file-attributes (concat dir (number-to-string (car downloaded))))))) alist)
+ (pop downloaded)
+ (pop nov-arts))
+ (t
+ ;; This entry in the overview has not been downloaded
+ (push (cons (car nov-arts) nil) alist)
+ (pop nov-arts))))
+
+ ;; When gnus-agent-consider-all-articles is set, gnus-agent-regenerate-group should NOT remove article IDs
+ ;; from the alist. Those IDs serve as markers to indicate that an attempt has been made to fetch that
+ ;; article's header.
+
+ ;; When gnus-agent-consider-all-articles is NOT set, gnus-agent-regenerate-group can remove the article
+ ;; ID of every article (with the exception of the last ID in the list - it's special) that no longer appears in the overview.
+ ;; In this situtation, the last article ID in the list implies that it, and every article ID preceeding it,
+ ;; have been fetched from the server.
+ (if gnus-agent-consider-all-articles
+ ;; Restore all article IDs that were not found in the overview file.
+ (let* ((n (cons nil alist))
+ (merged n)
+ (o (gnus-agent-load-alist group)))
+ (while o
+ (let ((nID (caadr n))
+ (oID (caar o)))
+ (cond ((not nID)
+ (setq n (setcdr n (list (list oID))))
+ (pop o))
+ ((< oID nID)
+ (setcdr n (cons (list oID) (cdr n)))
+ (pop o))
+ ((= oID nID)
+ (pop o)
+ (pop n))
+ (t
+ (pop n)))))
+ (setq alist (cdr merged)))
+ ;; Restore the last article ID if it is not already in the new alist
+ (let ((n (last alist))
+ (o (last (gnus-agent-load-alist group))))
+ (cond ((not n)
+ (when o
+ (push (cons (caar o) nil) alist)))
+ ((< (caar n) (caar o))
+ (setcdr n (list (car o)))))))
+
+ (let ((inhibit-quit t))
+ (if (setq regenerated (buffer-modified-p))
+ (let ((coding-system-for-write gnus-agent-file-coding-system))
+ (write-region (point-min) (point-max) file nil 'silent)))
+
+ (setq regenerated (or regenerated
+ (and reread gnus-agent-article-alist)
+ (not (equal alist gnus-agent-article-alist)))
+ )
+
+ (setq gnus-agent-article-alist alist)
+
+ (when regenerated
+ (gnus-agent-save-alist group)))
+ )
+
+ (when (and reread gnus-agent-article-alist)
+ (gnus-make-ascending-articles-unread
+ group
+ (delq nil (mapcar (function (lambda (c)
+ (cond ((eq reread t)
+ (car c))
+ ((cdr c)
+ (car c)))))
+ gnus-agent-article-alist)))
+
+ (when (gnus-buffer-live-p gnus-group-buffer)
+ (gnus-group-update-group group t)
+ (sit-for 0))
+ )
+
+ regenerated))
;;;###autoload
-(defun gnus-agent-regenerate (&optional clean)
+(defun gnus-agent-regenerate (&optional clean reread)
"Regenerate all agent covered files.
-If CLEAN, don't read existing active and agentview files."
+If CLEAN, don't read existing active files."
(interactive "P")
- (message "Regenerating Gnus agent files...")
- (dolist (gnus-command-method gnus-agent-covered-methods)
- (let ((active-file (gnus-agent-lib-file "active"))
- history-hashtb active-hashtb active-changed
- history-changed point)
- (gnus-make-directory (file-name-directory active-file))
- (if clean
- (setq active-hashtb (gnus-make-hashtable 1000))
- (mm-with-unibyte-buffer
- (if (file-exists-p active-file)
- (let ((nnheader-file-coding-system
- gnus-agent-file-coding-system))
- (nnheader-insert-file-contents active-file))
- (setq active-changed t))
- (gnus-active-to-gnus-format
- nil (setq active-hashtb
- (gnus-make-hashtable
- (count-lines (point-min) (point-max)))))))
- (gnus-agent-open-history)
- (setq history-hashtb (gnus-make-hashtable 1000))
- (with-current-buffer
- (setq gnus-agent-current-history (gnus-agent-history-buffer))
- (goto-char (point-min))
- (forward-line 1)
- (while (not (eobp))
- (if (looking-at
- "\\([^\t\n]+\\)\t[0-9]+\t\\([^ \n]+\\) \\([0-9]+\\)")
- (progn
- (unless (string= (match-string 1)
- "last-header-fetched-for-session")
- (gnus-sethash (match-string 2)
- (cons (string-to-number (match-string 3))
- (gnus-gethash-safe (match-string 2)
- history-hashtb))
- history-hashtb))
- (forward-line 1))
- (setq point (point))
- (forward-line 1)
- (delete-region point (point))
- (setq history-changed t))))
- (dolist (group (gnus-groups-from-server gnus-command-method))
- (gnus-agent-regenerate-group group clean)
- (let ((min (or (caar gnus-agent-article-alist) 1))
- (max (or (caar (last gnus-agent-article-alist)) 0))
- (active (gnus-gethash-safe (gnus-group-real-name group)
- active-hashtb)))
- (if (not active)
- (progn
- (setq active (cons min max)
- active-changed t)
- (gnus-sethash group active active-hashtb))
- (when (> (car active) min)
- (setcar active min)
- (setq active-changed t))
- (when (< (cdr active) max)
- (setcdr active max)
- (setq active-changed t))))
- (let ((arts (sort (gnus-gethash-safe group history-hashtb) '<))
- n)
- (gnus-sethash group arts history-hashtb)
- (while (and arts gnus-agent-article-alist)
- (cond
- ((> (car arts) (caar gnus-agent-article-alist))
- (when (cdar gnus-agent-article-alist)
- (gnus-agent-regenerate-history
- group (caar gnus-agent-article-alist))
- (setq history-changed t))
- (setq n (car (pop gnus-agent-article-alist)))
- (while (and gnus-agent-article-alist
- (= n (caar gnus-agent-article-alist)))
- (pop gnus-agent-article-alist)))
- ((< (car arts) (caar gnus-agent-article-alist))
- (setq n (pop arts))
- (while (and arts (= n (car arts)))
- (pop arts)))
- (t
- (setq n (car (pop gnus-agent-article-alist)))
- (while (and gnus-agent-article-alist
- (= n (caar gnus-agent-article-alist)))
- (pop gnus-agent-article-alist))
- (setq n (pop arts))
- (while (and arts (= n (car arts)))
- (pop arts)))))
- (while gnus-agent-article-alist
- (when (cdar gnus-agent-article-alist)
- (gnus-agent-regenerate-history
- group (caar gnus-agent-article-alist))
- (setq history-changed t))
- (pop gnus-agent-article-alist))))
- (when history-changed
- (message "Regenerate the history file of %s:%s"
- (car gnus-command-method)
- (cadr gnus-command-method))
- (gnus-agent-save-history))
- (gnus-agent-close-history)
- (when active-changed
- (message "Regenerate %s" active-file)
- (let ((nnmail-active-file-coding-system gnus-agent-file-coding-system))
- (gnus-write-active-file active-file active-hashtb)))))
- (message "Regenerating Gnus agent files...done"))
+ (let (regenerated)
+ (gnus-message 4 "Regenerating Gnus agent files...")
+ (dolist (gnus-command-method gnus-agent-covered-methods)
+ (let ((active-file (gnus-agent-lib-file "active"))
+ active-hashtb active-changed
+ point)
+ (gnus-make-directory (file-name-directory active-file))
+ (if clean
+ (setq active-hashtb (gnus-make-hashtable 1000))
+ (mm-with-unibyte-buffer
+ (if (file-exists-p active-file)
+ (let ((nnheader-file-coding-system
+ gnus-agent-file-coding-system))
+ (nnheader-insert-file-contents active-file))
+ (setq active-changed t))
+ (gnus-active-to-gnus-format
+ nil (setq active-hashtb
+ (gnus-make-hashtable
+ (count-lines (point-min) (point-max)))))))
+ (dolist (group (gnus-groups-from-server gnus-command-method))
+ (setq regenerated (or (gnus-agent-regenerate-group group reread)
+ regenerated))
+ (let ((min (or (caar gnus-agent-article-alist) 1))
+ (max (or (caar (last gnus-agent-article-alist)) 0))
+ (active (gnus-gethash-safe (gnus-group-real-name group)
+ active-hashtb))
+ (read (gnus-info-read (gnus-get-info group))))
+ (if (not active)
+ (progn
+ (setq active (cons min max)
+ active-changed t)
+ (gnus-sethash group active active-hashtb))
+ (when (> (car active) min)
+ (setcar active min)
+ (setq active-changed t))
+ (when (< (cdr active) max)
+ (setcdr active max)
+ (setq active-changed t)))))
+ (when active-changed
+ (setq regenerated t)
+ (gnus-message 4 "Regenerate %s" active-file)
+ (let ((nnmail-active-file-coding-system gnus-agent-file-coding-system))
+ (gnus-write-active-file active-file active-hashtb)))))
+ (gnus-message 4 "Regenerating Gnus agent files...done")
+ regenerated))
(defun gnus-agent-go-online (&optional force)
"Switch servers into online status."
(if (eq status 'offline) 'offline 'online)
(if (eq status 'offline) 'online 'offline))))
+(defun gnus-agent-group-covered-p (group)
+ (member (gnus-group-method group)
+ gnus-agent-covered-methods))
+
(provide 'gnus-agent)
;;; gnus-agent.el ends here
;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
"^X-Request-PGP:" "^X-Fingerprint:" "^X-WRIEnvto:" "^X-WRIEnvfrom:"
"^X-Virus-Scanned:" "^X-Delivery-Agent:" "^Posted-Date:" "^X-Gateway:"
"^X-Local-Origin:" "^X-Local-Destination:" "^X-UserInfo1:"
- "^X-Received-Date:")
+ "^X-Received-Date:" "^X-Hashcash:")
"*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."
A string is used as a regular expression to match the banner
directly.")
+(defcustom gnus-article-address-banner-alist nil
+ "Alist of mail addresses and banners.
+Each element has the form (ADDRESS . BANNER), where ADDRESS is a regexp
+to match a mail address in the From: header, BANNER is one of a symbol
+`signature', an item in `gnus-article-banner-alist', a regexp and nil.
+If ADDRESS matches author's mail address, it will remove things like
+advertisements. For example:
+
+\((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
+"
+ :type '(repeat
+ (cons
+ (regexp :tag "Address")
+ (choice :tag "Banner" :value nil
+ (const :tag "Remove signature" signature)
+ (symbol :tag "Item in `gnus-article-banner-alist'" none)
+ regexp
+ (const :tag "None" nil))))
+ :group 'gnus-article-washing)
+
(defcustom gnus-emphasis-alist
(let ((format
"\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)")
'(("\\*" "\\*" bold)
("_" "_" underline)
("/" "/" italic)
- ("-" "-" strikethru)
("_/" "/_" underline-italic)
("_\\*" "\\*_" underline-bold)
("\\*/" "/\\*" bold-italic)
(format format (car spec) (cadr spec))
2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
types)
+ ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)"
+ 2 3 gnus-emphasis-strikethru)
("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
2 3 gnus-emphasis-underline)))
"*Alist that says how to fontify certain phrases.
("\225" "*")
("\226" "-")
("\227" "--")
+ ("\230" "~")
("\231" "(TM)")
("\233" ">")
("\234" "oe")
:group 'gnus-article-mime
:type '(repeat regexp))
+(defcustom gnus-inhibit-mime-unbuttonizing nil
+ "If non-nil, all MIME parts get buttons.
+When nil (the default value), then some MIME parts do not get buttons,
+as described by the variables `gnus-buttonized-mime-types' and
+`gnus-unbuttonized-mime-types'."
+ :version "21.3"
+ :type 'boolean)
+
(defcustom gnus-body-boundary-delimiter "_"
"String used to delimit header and body.
This variable is used by `gnus-article-treat-body-boundary' which can
For information on obtaining this database of pretty pictures, please
see http://www.cs.indiana.edu/picons/ftp/index.html"
:type '(repeat directory)
- :link '(url-link :tag "download"
+ :link '(url-link :tag "download"
"http://www.cs.indiana.edu/picons/ftp/index.html")
:link '(custom-manual "(gnus)Picons")
:group 'gnus-picon)
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles'."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(put 'gnus-treat-highlight-signature 'highlight t)
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles'."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(put 'gnus-treat-buttonize 'highlight t)
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(put 'gnus-treat-buttonize-head 'highlight t)
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(put 'gnus-treat-emphasize 'highlight t)
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-unsplit-urls nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-leading-whitespace nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-hide-headers 'head
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-hide-boring-headers nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-hide-signature nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-fill-article nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-hide-citation nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-hide-citation-maybe nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-list-identifiers 'head
See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-pgp t
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-pem nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-banner t
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-highlight-headers 'head
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(put 'gnus-treat-highlight-headers 'highlight t)
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(put 'gnus-treat-highlight-citation 'highlight t)
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-local nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-english nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-lapsed nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-original nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-iso8601 nil
See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-user-defined nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-strip-headers-in-body t
See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-trailing-blank-lines nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-leading-blank-lines nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-multiple-blank-lines nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-unfold-headers 'head
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-fold-headers nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-fold-newsgroups 'head
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-overstrike t
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(put 'gnus-treat-overstrike 'highlight t)
`(gnus)X-Face' for details."
:group 'gnus-article-treat
:version "21.1"
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :link '(custom-manual "(gnus)X-Face")
:type gnus-article-treat-head-custom)
(put 'gnus-treat-display-xface 'highlight t)
`(gnus)Smileys' for details."
:group 'gnus-article-treat
:version "21.1"
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :link '(custom-manual "(gnus)Smileys")
:type gnus-article-treat-custom)
(put 'gnus-treat-display-smileys 'highlight t)
`(gnus)Picons' for details."
:group 'gnus-article-treat
:group 'gnus-picon
- :link '(info-link "(gnus)Customizing Articles")
- :link '(info-link "(gnus)Picons")
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :link '(custom-manual "(gnus)Picons")
:type gnus-article-treat-head-custom)
(put 'gnus-treat-from-picon 'highlight t)
`(gnus)Picons' for details."
:group 'gnus-article-treat
:group 'gnus-picon
- :link '(info-link "(gnus)Customizing Articles")
- :link '(info-link "(gnus)Picons")
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :link '(custom-manual "(gnus)Picons")
:type gnus-article-treat-head-custom)
(put 'gnus-treat-mail-picon 'highlight t)
`(gnus)Picons' for details."
:group 'gnus-article-treat
:group 'gnus-picon
- :link '(info-link "(gnus)Customizing Articles")
- :link '(info-link "(gnus)Picons")
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :link '(custom-manual "(gnus)Picons")
:type gnus-article-treat-head-custom)
(put 'gnus-treat-newsgroups-picon 'highlight t)
See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-capitalize-sentences nil
See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-wash-html nil
+ "Format as HTML.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-fill-long-lines nil
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-play-sounds nil
See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-translate nil
See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-x-pgp-sig nil
See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:group 'mime-security
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defvar gnus-article-encrypt-protocol-alist
(gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
(gnus-treat-display-smileys gnus-treat-smiley)
(gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
+ (gnus-treat-wash-html gnus-article-wash-html)
(gnus-treat-emphasize gnus-article-emphasize)
(gnus-treat-hide-citation gnus-article-hide-citation)
(gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
;; (modify-syntax-entry ?- "w" table)
(modify-syntax-entry ?> ")<" table)
(modify-syntax-entry ?< "(>" table)
+ ;; make M-. in article buffers work for `foo' strings
+ (modify-syntax-entry ?' " " table)
+ (modify-syntax-entry ?` " " table)
table)
"Syntax table used in article mode buffers.
Initialized from `text-mode-syntax-table.")
(defsubst gnus-article-header-rank ()
"Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
(let ((list gnus-sorted-header-list)
- (i 0))
+ (i 1))
(while list
- (when (looking-at (car list))
- (setq list nil))
- (setq list (cdr list))
- (incf i))
- i))
+ (if (looking-at (car list))
+ (setq list nil)
+ (setq list (cdr list))
+ (incf i)))
+ i))
(defun article-hide-headers (&optional arg delete)
"Hide unwanted headers and possibly sort them as well."
(setq str (concat str gnus-body-boundary-delimiter)))
(substring str 0 (1- (window-width))))
"\n")
- (gnus-add-text-properties start (point) '(gnus-decoration 'header))))))
+ (gnus-put-text-property start (point) 'gnus-decoration 'header)))))
(defun article-fill-long-lines ()
"Fill lines that are wider than the window width."
(while (not (eobp))
(end-of-line)
(when (>= (current-column) (min fill-column width))
- (narrow-to-region (point) (gnus-point-at-bol))
- (fill-paragraph nil)
- (goto-char (point-max))
+ (narrow-to-region (min (1+ (point)) (point-max)) (gnus-point-at-bol))
+ (let ((goback (point-marker)))
+ (fill-paragraph nil)
+ (goto-char (marker-position goback)))
(widen))
(forward-line 1)))))))
(defun article-wash-html (&optional read-charset)
- "Format an html article.
+ "Format an HTML article.
If READ-CHARSET, ask for a coding system."
(interactive "P")
(save-excursion
(let ((buffer-read-only nil)
charset)
- (if (gnus-buffer-live-p gnus-original-article-buffer)
- (with-current-buffer gnus-original-article-buffer
- (let* ((ct (gnus-fetch-field "content-type"))
- (ctl (and ct
- (ignore-errors
- (mail-header-parse-content-type ct)))))
- (setq charset (and ctl
- (mail-content-type-get ctl 'charset)))
- (if (stringp charset)
- (setq charset (intern (downcase charset)))))))
- (if read-charset
- (setq charset (mm-read-coding-system "Charset: " charset)))
+ (when (gnus-buffer-live-p gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
+ (let* ((ct (gnus-fetch-field "content-type"))
+ (ctl (and ct
+ (ignore-errors
+ (mail-header-parse-content-type ct)))))
+ (setq charset (and ctl
+ (mail-content-type-get ctl 'charset)))
+ (when (stringp charset)
+ (setq charset (intern (downcase charset)))))))
+ (when read-charset
+ (setq charset (mm-read-coding-system "Charset: " charset)))
(unless charset
(setq charset gnus-newsgroup-charset))
(article-goto-body)
(narrow-to-region (point) (point-max))
(let* ((func (or gnus-article-wash-function mm-text-html-renderer))
(entry (assq func mm-text-html-washer-alist)))
- (if entry
- (setq func (cdr entry)))
+ (when entry
+ (setq func (cdr entry)))
(cond
((gnus-functionp func)
(funcall func))
(when mm-inline-text-html-with-w3m-keymap
(add-text-properties
(point-min) (point-max)
- (append '(mm-inline-text-html-with-w3m t)
- (gnus-local-map-property mm-w3m-mode-map))))))
+ (nconc (mm-w3m-local-map-property)
+ '(mm-inline-text-html-with-w3m t))))))
(defun article-hide-list-identifiers ()
"Remove list identifies from the Subject header.
(banner (gnus-parameter-banner gnus-newsgroup-name))
(gnus-signature-limit nil)
buffer-read-only beg end)
+ (when (and gnus-article-address-banner-alist
+ (not banner))
+ (setq banner
+ (let ((from (save-restriction
+ (widen)
+ (article-narrow-to-head)
+ (mail-fetch-field "from"))))
+ (when (and from
+ (setq from
+ (caar (mail-header-parse-addresses from))))
+ (catch 'found
+ (dolist (pair gnus-article-address-banner-alist)
+ (when (string-match (car pair) from)
+ (throw 'found (cdr pair)))))))))
(when banner
(article-goto-body)
(cond
(second . 1))
"Mapping from time units to seconds.")
+(defun gnus-article-forward-header ()
+ "Move point to the start of the next header.
+If the current header is a continuation header, this can be several
+lines forward."
+ (let ((ended nil))
+ (while (not ended)
+ (forward-line 1)
+ (if (looking-at "[ \t]+[^ \t]")
+ (forward-line 1)
+ (setq ended t)))))
+
(defun article-date-ut (&optional type highlight header)
"Convert DATE date to universal time in the current article.
If TYPE is `local', convert to local time; if it is `lapsed', output
(while (re-search-forward date-regexp nil t)
(if pos
(delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point)))
+ (progn (gnus-article-forward-header)
+ (point)))
(delete-region (progn (beginning-of-line) (point))
- (progn (end-of-line) (point)))
+ (progn (gnus-article-forward-header)
+ (forward-char -1)
+ (point)))
(setq pos (point))))
- (when (and (not pos) (re-search-forward tdate-regexp nil t))
+ (when (and (not pos)
+ (re-search-forward tdate-regexp nil t))
(forward-line 1))
- (if pos (goto-char pos))
+ (when pos
+ (goto-char pos))
(insert (article-make-date-line date (or type 'ut)))
- (when (not pos)
+ (unless pos
(insert "\n")
(forward-line -1))
;; Do highlighting.
date)))
;; Let the user define the format.
((eq type 'user)
- (if (gnus-functionp gnus-article-time-format)
- (funcall gnus-article-time-format time)
- (concat
- "Date: "
- (format-time-string gnus-article-time-format time))))
+ (let ((format (or (condition-case nil
+ (with-current-buffer gnus-summary-buffer
+ gnus-article-time-format)
+ (error nil))
+ gnus-article-time-format)))
+ (if (gnus-functionp format)
+ (funcall format time)
+ (concat "Date: " (format-time-string format time)))))
;; ISO 8601.
((eq type 'iso8601)
(let ((tz (car (current-time-zone time))))
(format "%02d" (nth 2 dtime))
":"
(format "%02d" (nth 1 dtime)))))))
- (error
- (format "Date: %s (from Gnus)" date))))
+ (error
+ (format "Date: %s (from Gnus)" date))))
(defun article-date-local (&optional highlight)
"Convert the current article date to the local timezone."
(car (push result file-name-history)))))))
;; Create the directory.
(gnus-make-directory (file-name-directory file))
- ;; If we have read a directory, we append the default file name.
+ ;; If we have read a directory, we append the default file name.
(when (file-directory-p file)
(setq file (expand-file-name (file-name-nondirectory
default-name)
article-strip-trailing-space
article-strip-blank-lines
article-strip-all-blank-lines
- article-replace-with-quoted-text
article-date-local
article-date-english
article-date-iso8601
(if (get-buffer name)
(save-excursion
(set-buffer name)
+ (when (and gnus-article-edit-mode
+ (buffer-modified-p)
+ (not
+ (y-or-n-p "Article mode edit in progress; discard? ")))
+ (error "Action aborted"))
+ (set (make-local-variable 'gnus-article-edit-mode) nil)
(when gnus-article-mime-handles
(mm-destroy-parts gnus-article-mime-handles)
(setq gnus-article-mime-handles nil))
(cons gnus-newsgroup-name article))
(set-buffer gnus-summary-buffer)
(setq gnus-current-article article)
- (if (eq (gnus-article-mark article) gnus-undownloaded-mark)
+ (if (memq article gnus-newsgroup-undownloaded)
(progn
(gnus-summary-set-agent-mark article)
(message "Message marked for downloading"))
%p The part identifier number
%e Dots if the part isn't displayed
-General format specifiers can also be used. See
-(gnus)Formatting Variables.")
+General format specifiers can also be used. See Info node
+`(gnus)Formatting Variables'.")
(defvar gnus-mime-button-line-format-alist
'((?t gnus-tmp-type ?s)
(mm-merge-handles gnus-article-mime-handles handle))
(gnus-mm-display-part handle))))
+(eval-when-compile
+ (require 'jka-compr))
+
+;; jka-compr.el uses a "sh -c" to direct stderr to err-file, but these days
+;; emacs can do that itself.
+;;
+(defun gnus-mime-jka-compr-maybe-uncompress ()
+ "Uncompress the current buffer if `auto-compression-mode' is enabled.
+The uncompress method used is derived from `buffer-file-name'."
+ (when (and (fboundp 'jka-compr-installed-p)
+ (jka-compr-installed-p))
+ (let ((info (jka-compr-get-compression-info buffer-file-name)))
+ (when info
+ (let ((basename (file-name-nondirectory buffer-file-name))
+ (args (jka-compr-info-uncompress-args info))
+ (prog (jka-compr-info-uncompress-program info))
+ (message (jka-compr-info-uncompress-message info))
+ (err-file (jka-compr-make-temp-name)))
+ (if message
+ (message "%s %s..." message basename))
+ (unwind-protect
+ (unless (memq (apply 'call-process-region
+ (point-min) (point-max)
+ prog
+ t (list t err-file) nil
+ args)
+ jka-compr-acceptable-retval-list)
+ (jka-compr-error prog args basename message err-file))
+ (jka-compr-delete-temp-file err-file)))))))
+
(defun gnus-mime-copy-part (&optional handle)
"Put the MIME part under point into a new buffer."
(interactive)
(file-name-nondirectory
(or
(mail-content-type-get (mm-handle-type handle) 'name)
- (mail-content-type-get (mm-handle-type handle)
+ (mail-content-type-get (mm-handle-disposition handle)
'filename)
"*decoded*"))))
(buffer (and base (generate-new-buffer base))))
(unwind-protect
(progn
(setq buffer-file-name (expand-file-name base))
+ (gnus-mime-jka-compr-maybe-uncompress)
(normal-mode))
(setq buffer-file-name nil))
(goto-char (point-min)))))
(interactive "P")
(let ((article (cdr gnus-article-current)) cont)
(if (not (mark t))
- (gnus-summary-reply (list (list article)) wide)
+ (with-current-buffer gnus-summary-buffer
+ (gnus-summary-reply (list (list article)) wide))
(setq cont (buffer-substring (point) (mark t)))
;; Deactivate active regions.
(when (and (boundp 'transient-mark-mode)
transient-mark-mode)
(setq mark-active nil))
- (gnus-summary-reply
- (list (list article cont)) wide))))
+ (with-current-buffer gnus-summary-buffer
+ (gnus-summary-reply
+ (list (list article cont)) wide)))))
(defun gnus-article-followup-with-original ()
"Compose a followup to the current article.
The text in the region will be yanked. If the region isn't active,
the entire article will be yanked."
(interactive)
- (let ((article (cdr gnus-article-current))
- cont)
- (if (not (mark t))
- (gnus-summary-followup (list (list article)))
- (setq cont (buffer-substring (point) (mark t)))
- ;; Deactivate active regions.
- (when (and (boundp 'transient-mark-mode)
- transient-mark-mode)
- (setq mark-active nil))
- (gnus-summary-followup
- (list (list article cont))))))
+ (let ((article (cdr gnus-article-current)) cont)
+ (if (not (mark t))
+ (with-current-buffer gnus-summary-buffer
+ (gnus-summary-followup (list (list article))))
+ (setq cont (buffer-substring (point) (mark t)))
+ ;; Deactivate active regions.
+ (when (and (boundp 'transient-mark-mode)
+ transient-mark-mode)
+ (setq mark-active nil))
+ (with-current-buffer gnus-summary-buffer
+ (gnus-summary-followup
+ (list (list article cont)))))))
(defun gnus-article-hide (&optional arg force)
"Hide all the gruft in the current article.
(defvar gnus-article-edit-done-function nil)
(defvar gnus-article-edit-mode-map nil)
+(defvar gnus-article-edit-mode nil)
;; Should we be using derived.el for this?
(unless gnus-article-edit-mode-map
(setq gnus-article-edit-mode-map (make-keymap))
(set-keymap-parent gnus-article-edit-mode-map text-mode-map)
-
(gnus-define-keys gnus-article-edit-mode-map
"\C-c?" describe-mode
"\C-c\C-c" gnus-article-edit-done
(set (make-local-variable 'font-lock-defaults)
'(message-font-lock-keywords t))
(set (make-local-variable 'mail-header-separator) "")
+ (set (make-local-variable 'gnus-article-edit-mode) t)
(easy-menu-add message-mode-field-menu message-mode-map)
(mml-mode)
(setq buffer-read-only nil)
(if (gnus-buffer-live-p gnus-original-article-buffer)
(insert-buffer gnus-original-article-buffer))
(let ((winconf gnus-prev-winconf))
+ (kill-all-local-variables)
(gnus-article-mode)
(set-window-configuration winconf)
;; Tippy-toe some to make sure that point remains where it was.
;;; Internal Variables:
-(defcustom gnus-button-url-regexp "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)"
+(defcustom gnus-button-url-regexp
+ (if (string-match "[[:digit:]]" "1") ;; support POSIX?
+ "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~`%&*+|\\/:;.,[:word:]]+[-a-z0-9_=#$@~`%&*+|\\/[:word:]]\\)"
+ "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)")
"Regular expression that matches URLs."
:group 'gnus-article-buttons
:type 'regexp)
+(defcustom gnus-button-valid-fqdn-regexp
+ (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain.
+ ;; valid TLDs:
+ "\\([a-z][a-z]" ;; two letter country TDLs
+ "\\|biz\\|com\\|edu\\|gov\\|int\\|mil\\|net\\|org"
+ "\\|aero\\|coop\\|info\\|name\\|museum"
+ "\\|arpa\\|pro\\|uucp\\|bitnet\\|bofh" ;; old style?
+ "\\)")
+ "Regular expression that matches a valid FQDN."
+ :group 'gnus-article-buttons
+ :type 'regexp)
+
+(defcustom gnus-button-man-handler 'manual-entry
+ "Function to use for displaying man pages.
+The function must take at least one argument with a string naming the
+man page."
+ :type '(choice (function-item :tag "Man" manual-entry)
+ (function-item :tag "Woman" woman)
+ (function :tag "Other"))
+ :group 'gnus-article-buttons)
+
+(defcustom gnus-ctan-url "http://tug.ctan.org/tex-archive/"
+ "Top directory of a CTAN \(Comprehensive TeX Archive Network\) archive.
+If the default site is too slow, try to find a CTAN mirror, see
+<URL:http://tug.ctan.org/tex-archive/CTAN.sites?action=/index.html>. See also
+the variable `gnus-button-handle-ctan'."
+ :group 'gnus-article-buttons
+ :link '(custom-manual "(gnus)Group Parameters")
+ :type '(choice (const "http://www.tex.ac.uk/tex-archive/")
+ (const "http://tug.ctan.org/tex-archive/")
+ (const "http://www.dante.de/CTAN/")
+ (string :tag "Other")))
+
+(defcustom gnus-button-ctan-handler 'browse-url
+ "Function to use for displaying CTAN links.
+The function must take one argument, the string naming the URL."
+ :type '(choice (function-item :tag "Browse Url" browse-url)
+ (function :tag "Other"))
+ :group 'gnus-article-buttons)
+
+(defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/"
+ "Bogus strings removed from CTAN URLs."
+ :group 'gnus-article-buttons
+ :type '(choice (const "^/?tex-archive/\\|/")
+ (regexp :tag "Other")))
+
+(defcustom gnus-button-mid-or-mail-regexp
+ (concat "\\b\\(<?[a-z0-9][^<>\")!;:,{}\n\t ]*@"
+ gnus-button-valid-fqdn-regexp
+ ">?\\)\\b")
+ "Regular expression that matches a message ID or a mail address."
+ :group 'gnus-article-buttons
+ :type 'regexp)
+
+(defcustom gnus-button-prefer-mid-or-mail 'guess
+ "What to do when the button on a string as \"foo123@bar.com\" is pushed.
+Strings like this can be either a message ID or a mail address. If the
+variable is set to the symbol `ask', query the user what do do. If it is the
+symbol `guess', Gnus will do a guess and query the user what do do if it is
+ambiguous. See the variable `gnus-button-guessed-mid-regexp' for details
+concerning the guessing. If it is one of the sybols `mid' or `mail', Gnus
+will always assume that the string is a message ID or a mail address,
+respectivly."
+ ;; FIXME: doc-string could/should be improved.
+ :group 'gnus-article-buttons
+ :type '(choice (const ask)
+ (const guess)
+ (const mid)
+ (const mail)))
+
+(defcustom gnus-button-guessed-mid-regexp
+ (concat
+ "^<?\\(slrn\\|Pine\\.\\)"
+ "\\|\\.fsf@\\|\\.fsf_-_@\\|\\.ln@"
+ "\\|@4ax\\.com\\|@ID-[0-9]+\\.[a-zA-Z]+\\.dfncis\\.de"
+ "\\|^<?.*[0-9].*[0-9].*[0-9].*[0-9].*[0-9].*[0-9].*@")
+ "Regular expression that matches message IDs and not mail addresses."
+ ;; TODO: Incorporate more matches from
+ ;; <URL:http://piology.org/perl/id-or-mail.pl.html>. I.e. translate the
+ ;; Perl-REs to Elisp-REs.
+ :group 'gnus-article-buttons
+ :type 'regexp)
+
+(defun gnus-button-handle-mid-or-mail (mid-or-mail)
+ (let* ((pref gnus-button-prefer-mid-or-mail)
+ (url-mid (concat "news" ":" mid-or-mail))
+ (url-mailto (concat "mailto" ":" mid-or-mail)))
+ (gnus-message 9 "mid-or-mail=%s" mid-or-mail)
+ ;; If it looks like a MID (well known readers or servers) use 'mid,
+ ;; otherwise 'ask the user.
+ (if (eq pref 'guess)
+ (if (string-match gnus-button-guessed-mid-regexp mid-or-mail)
+ (setq pref 'mid)
+ (setq pref 'ask)))
+ (if (eq pref 'ask)
+ (save-window-excursion
+ (if (y-or-n-p (concat "Is <" mid-or-mail "> a mail address? "))
+ (setq pref 'mail)
+ (setq pref 'mid))))
+ (cond ((eq pref 'mid)
+ (gnus-message 9 "calling `gnus-button-handle-news' %s" url-mid)
+ (gnus-button-handle-news url-mid))
+ ((eq pref 'mail)
+ (gnus-message 9 "calling `gnus-url-mailto' %s" url-mailto)
+ (gnus-url-mailto url-mailto)))))
+
+(defun gnus-button-handle-custom (url)
+ "Follow a Custom URL."
+ (customize-apropos (gnus-url-unhex-string url)))
+
+(defvar gnus-button-handle-describe-prefix "^\\(C-h\\|<?[Ff]1>?\\)")
+
+(defun gnus-button-handle-describe-function (url)
+ "Call describe-function when pushing the corresponding URL button."
+ (describe-function
+ (intern
+ (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))))
+
+(defun gnus-button-handle-describe-variable (url)
+ "Call describe-variable when pushing the corresponding URL button."
+ (describe-variable
+ (intern
+ (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))))
+
+;; FIXME: Is is possible to implement this? Else it should be removed here
+;; and in `gnus-button-alist'.
+(defun gnus-button-handle-describe-key (url)
+ "Call describe-key when pushing the corresponding URL button."
+ (error "not implemented"))
+
+(defun gnus-button-handle-apropos (url)
+ "Call apropos when pushing the corresponding URL button."
+ (apropos (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
+
+(defun gnus-button-handle-apropos-command (url)
+ "Call apropos when pushing the corresponding URL button."
+ (apropos-command
+ (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
+
+(defun gnus-button-handle-apropos-variable (url)
+ "Call apropos when pushing the corresponding URL button."
+ (funcall
+ (if (fboundp 'apropos-variable) 'apropos-variable 'apropos)
+ (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
+
+(defun gnus-button-handle-apropos-documentation (url)
+ "Call apropos when pushing the corresponding URL button."
+ (funcall
+ (if (fboundp 'apropos-documentation) 'apropos-documentation 'apropos)
+ (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
+
+(defun gnus-button-handle-ctan (url)
+ "Call `browse-url' when pushing a CTAN URL button."
+ (funcall
+ gnus-button-ctan-handler
+ (concat
+ gnus-ctan-url
+ (gnus-replace-in-string url gnus-button-handle-ctan-bogus-regexp ""))))
+
+(defcustom gnus-button-tex-level 5
+ "*Integer that says how many TeX-related buttons Gnus will show.
+The higher the number, the more buttons will appear and the more false
+positives are possible. Note that you can set this variable local to
+specifific groups. Setting it higher in TeX groups is probably a good idea.
+See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
+how to set variables in specific groups."
+ :group 'gnus-article-buttons
+ :link '(custom-manual "(gnus)Group Parameters")
+ :type 'integer)
+
+(defcustom gnus-button-man-level 5
+ "*Integer that says how many man-related buttons Gnus will show.
+The higher the number, the more buttons will appear and the more false
+positives are possible. Note that you can set this variable local to
+specifific groups. Setting it higher in Unix groups is probably a good idea.
+See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
+how to set variables in specific groups."
+ :group 'gnus-article-buttons
+ :link '(custom-manual "(gnus)Group Parameters")
+ :type 'integer)
+
+(defcustom gnus-button-emacs-level 5
+ "*Integer that says how many emacs-related buttons Gnus will show.
+The higher the number, the more buttons will appear and the more false
+positives are possible. Note that you can set this variable local to
+specifific groups. Setting it higher in Emacs or Gnus related groups is
+probably a good idea. See Info node `(gnus)Group Parameters' and the variable
+`gnus-parameters' on how to set variables in specific groups."
+ :group 'gnus-article-buttons
+ :link '(custom-manual "(gnus)Group Parameters")
+ :type 'integer)
+
+(defcustom gnus-button-mail-level 5
+ "*Integer that says how many buttons for message IDs or mail addresses will appear.
+The higher the number, the more buttons will appear and the more false
+positives are possible."
+ :group 'gnus-article-buttons
+ :type 'integer)
+
(defcustom gnus-button-alist
- `(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>"
+ '(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>"
0 t gnus-button-handle-news 3)
("\\b\\(nntp\\|news\\):\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t
gnus-button-handle-news 2)
("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
t gnus-button-message-id 3)
("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 2)
- ("mailto:\\([-a-zA-Z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1)
+ ("mailto:\\([-a-z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1)
("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1)
+ ;; CTAN
+ ("\\bCTAN:[ \t\n]*\\([^>)!;:,\n\t ]*\\)" 0 (>= gnus-button-tex-level 1)
+ gnus-button-handle-ctan 1)
;; This is info
- ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t
- gnus-button-handle-info 2)
+ ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)" 0
+ (>= gnus-button-emacs-level 1) gnus-button-handle-info 2)
+ ;; This is custom
+ ("\\bcustom:\\(//\\)?\\([^'\">\n\t ]+\\)" 0
+ (>= gnus-button-emacs-level 5) gnus-button-handle-custom 2)
+ ("M-x[ \t\n]customize-[^ ]+[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0
+ (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1)
+ ;; Emacs help commands
+ ("M-x[ \t\n]+apropos[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ ;; regexp doesn't match arguments containing ` '.
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos 1)
+ ("M-x[ \t\n]+apropos-command[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-command 1)
+ ("M-x[ \t\n]+apropos-variable[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1)
+ ("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1)
+ ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+f[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2)
+ ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2)
+ ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+" 0
+ ;; this regexp needs to be fixed!
+ (>= gnus-button-emacs-level 9) gnus-button-handle-describe-key 2)
;; This is how URLs _should_ be embedded in text...
("<URL: *\\([^<>]*\\)>" 1 t gnus-button-embedded-url 1)
;; Raw URLs.
- (gnus-button-url-regexp 0 t browse-url 0))
+ (gnus-button-url-regexp 0 t browse-url 0)
+ ;; man pages
+ ("\\b\\([a-z][a-z]+\\)([1-9])\\W" 0
+ (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3))
+ gnus-button-handle-man 1)
+ ;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x)
+ ("\\b\\([a-z][-_.a-z0-9]+\\)([1-9])\\W" 0
+ (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5))
+ gnus-button-handle-man 1)
+ ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm),
+ ;; SoWWWAnchor(3iv), XSelectInput(3X11)
+ ("\\b\\([a-z][-_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W" 0
+ (>= gnus-button-man-level 5) gnus-button-handle-man 1)
+ ;; MID or mail: To avoid too many false positives we don't try to catch
+ ;; all kind of allowed MIDs or mail addresses. Domain part must contain
+ ;; at least one dot. TLD must contain two or three chars or be a know TLD
+ ;; (info|name|...). Put this entry near the _end_ of `gnus-button-alist'
+ ;; so that non-ambiguous entries (see above) match first.
+ (gnus-button-mid-or-mail-regexp
+ 0 (>= gnus-button-mail-level 5) gnus-button-handle-mid-or-mail 1))
"*Alist of regexps matching buttons in article bodies.
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
-REGEXP: is the string matching text around the button,
+REGEXP: is the string (case insensitive) matching text around the button (can
+also be lisp expression evaluating to a string),
BUTTON: is the number of the regexp grouping actually matching the button,
FORM: is a lisp expression which must eval to true for the button to
be added,
(integer :tag "Regexp group")))))
(defcustom gnus-header-button-alist
- `(("^\\(References\\|Message-I[Dd]\\):" "<[^<>]+>"
+ '(("^\\(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 browse-url 0)
- ("^Subject:" ,gnus-button-url-regexp 0 t browse-url 0)
- ("^[^:]+:" ,gnus-button-url-regexp 0 t browse-url 0)
- ("^[^:]+:" "\\bmailto:\\([-a-zA-Z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1)
+ ("^X-[Uu][Rr][Ll]:" gnus-button-url-regexp 0 t browse-url 0)
+ ("^Subject:" gnus-button-url-regexp 0 t browse-url 0)
+ ("^[^:]+:" gnus-button-url-regexp 0 t browse-url 0)
+ ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1)
("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
gnus-button-message-id 3))
"*Alist of headers and regexps to match buttons in article heads.
(match-beginning 0))
(point-max)))
(goto-char beg)
- (while (re-search-forward (nth 1 entry) end t)
+ (while (re-search-forward (eval (nth 1 entry)) end t)
;; Each match within a header.
(let* ((entry (cdr entry))
(start (match-beginning (nth 1 entry)))
(group
(gnus-button-fetch-group url)))))
+(defun gnus-button-handle-man (url)
+ "Fetch a man page."
+ (funcall gnus-button-man-handler url))
+
(defun gnus-button-handle-info (url)
"Fetch an info URL."
(if (string-match
This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item
is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
-(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
+\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
whose names match REGEXP.
For example:
-((\"chinese\" . gnus-decode-encoded-word-region-by-guess)
+\((\"chinese\" . gnus-decode-encoded-word-region-by-guess)
mail-decode-encoded-word-region
(\"chinese\" . rfc1843-decode-region))
")
(highlightp (gnus-visual-p 'article-highlight 'highlight))
val elem)
(gnus-run-hooks 'gnus-part-display-hook)
- (while (setq elem (pop alist))
+ (dolist (elem alist)
(setq val
(save-excursion
- (if (gnus-buffer-live-p gnus-summary-buffer)
- (set-buffer gnus-summary-buffer))
+ (when (gnus-buffer-live-p gnus-summary-buffer)
+ (set-buffer gnus-summary-buffer))
(symbol-value (car elem))))
(when (and (or (consp val)
treated-type)
(cond
((null val)
nil)
+ (condition
+ (eq condition val))
((and (listp val)
(stringp (car val)))
(apply 'gnus-or (mapcar `(lambda (s)
(equal (car val) type))
(t
(error "%S is not a valid predicate" pred)))))
- (condition
- (eq condition val))
((eq val t)
t)
((eq val 'head)
(let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist))))
(unless func
(error (format "Can't find the encrypt protocol %s" protocol)))
- (if (equal gnus-newsgroup-name "nndraft:drafts")
- (error "Can't encrypt the article in group nndraft:drafts"))
- (if (equal gnus-newsgroup-name "nndraft:queue")
- (error "Don't encrypt the article in group nndraft:queue"))
+ (if (member gnus-newsgroup-name '("nndraft:delayed"
+ "nndraft:drafts"
+ "nndraft:queue"))
+ (error "Can't encrypt the article in group %s"
+ gnus-newsgroup-name))
(gnus-summary-iterate n
(save-excursion
(set-buffer gnus-summary-buffer)
(incf tries)
(when (nntp-accept-process-output proc 1)
(setq tries 0))
- (when (and (not nntp-have-messaged) (eq 3 tries))
+ (when (and (not nntp-have-messaged)
+ (= tries 3))
(gnus-message 5 "Waiting for async article...")
(setq nntp-have-messaged t)))
(quit
;; if the user interrupted on a slow/hung connection,
;; do something friendly.
- (when (< 3 tries)
+ (when (> tries 3)
(setq gnus-async-current-prefetch-article nil))
(signal 'quit nil)))
(when nntp-have-messaged
(when (> (buffer-size) 0)
(let ((coding-system-for-write gnus-cache-coding-system))
(gnus-write-buffer file))
- (setq headers (nnheader-parse-head t))
+ (nnheader-remove-body)
+ (setq headers (nnheader-parse-naked-head))
(mail-header-set-number headers number)
(gnus-cache-change-buffer group)
(set-buffer (cdr gnus-cache-buffer))
(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)))
- (if (not cached)
+ (let ((gnus-verbose (max 6 gnus-verbose)))
+ (if (not gnus-newsgroup-cached)
(gnus-message 3 "No cached articles for this group")
- (save-excursion
- (while cached
- (gnus-summary-goto-subject (pop cached) t)))
- (gnus-summary-limit (append gnus-newsgroup-cached gnus-newsgroup-limit))
- (gnus-summary-position-point))))
+ (gnus-summary-goto-subjects gnus-newsgroup-cached))))
(defun gnus-summary-limit-include-cached ()
"Limit the summary buffer to articles that are cached."
;;; gnus-cus.el --- customization commands for Gnus
;;
-;; Copyright (C) 1996, 1999, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: news
(symbol :tag "Face"
gnus-emphasis-highlight-words))))
"highlight regexps.
-See gnus-emphasis-alist.")
+See `gnus-emphasis-alist'.")
(posting-style
(choice :tag "Posting style"
(const body))
(string :format "%v"))))
"post style.
-See gnus-posting-styles."))
+See `gnus-posting-styles'."))
"Alist of valid group or topic parameters.
Each entry has the form (NAME TYPE DOC), where NAME is the parameter
(ignore-errors (setq ga (car (read-from-string ga)))))
(setq gnus-newsgroup-name
(if (equal (car ga) "") nil (car ga)))
+ (setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga)))
(setq message-post-method
`(lambda (arg)
(gnus-post-method arg ,(car ga))))
(when (and dir
(file-exists-p (setq file
(expand-file-name "x-splash" dir))))
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (ignore-errors
- (setq pixmap (read (current-buffer))))))
+ (let ((coding-system-for-read 'raw-text)
+ default-enable-multibyte-characters)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (ignore-errors
+ (setq pixmap (read (current-buffer)))))))
(when pixmap
(make-face 'gnus-splash)
(setq height (/ (car pixmap) (frame-char-height))
;;; gnus-gl.el --- an interface to GroupLens for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Brad Miller <bmiller@cs.umn.edu>
(defun bbb-build-mid-scores-alist (groupname)
"this function can be called as part of the function to return the list of score files to use.
-See the gnus variable gnus-score-find-score-files-function.
+See the gnus variable `gnus-score-find-score-files-function'.
*Note:* If you want to use grouplens scores along with calculated scores,
you should see the offset and scale variables. At this point, I don't
;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(require 'time-date)
(require 'gnus-ems)
+(eval-when-compile (require 'mm-url))
+
(defcustom gnus-group-archive-directory
"*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
"*The address of the (ding) archives."
(function-item gnus-group-sort-by-rank)
(function :tag "other" nil))))
-(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l %O\n"
+(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%l %O\n"
"*Format of group lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
%s Select method (string)
%o Moderated group (char, \"m\")
%p Process mark (char)
+%B Whether a summary buffer for the group is open (char, \"*\")
%O Moderated group (string, \"(m)\" or \"\")
%P Topic indentation (string)
%m Whether there is new(ish) mail in the group (char, \"%\")
effect.
General format specifiers can also be used.
-See `(gnus)Formatting Variables'."
+See Info node `(gnus)Formatting Variables'."
:link '(custom-manual "(gnus)Formatting Variables")
:group 'gnus-group-visual
:type 'string)
;;; Internal variables
+(defvar gnus-group-is-exiting-p nil)
(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
"Function for sorting the group buffer.")
(?n gnus-tmp-news-method ?s)
(?P gnus-group-indentation ?s)
(?E gnus-tmp-group-icon ?s)
+ (?B gnus-tmp-summary-live ?c)
(?l gnus-tmp-grouplens ?s)
(?z gnus-tmp-news-method-string ?s)
(?m (gnus-group-new-mail gnus-tmp-group) ?c)
"l" gnus-group-sort-groups-by-level
"v" gnus-group-sort-groups-by-score
"r" gnus-group-sort-groups-by-rank
- "m" gnus-group-sort-groups-by-method)
+ "m" gnus-group-sort-groups-by-method
+ "n" gnus-group-sort-groups-by-real-name)
(gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
"s" gnus-group-sort-selected-groups
"l" gnus-group-sort-selected-groups-by-level
"v" gnus-group-sort-selected-groups-by-score
"r" gnus-group-sort-selected-groups-by-rank
- "m" gnus-group-sort-selected-groups-by-method)
+ "m" gnus-group-sort-selected-groups-by-method
+ "n" gnus-group-sort-selected-groups-by-real-name)
(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
"k" gnus-group-list-killed
"f" gnus-score-flush-cache)
(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
+ "c" gnus-group-fetch-charter
+ "C" gnus-group-fetch-control
"d" gnus-group-describe-group
"f" gnus-group-fetch-faq
"v" gnus-version)
,@(if (featurep 'xemacs) nil
'(:help "Display description of the current group"))]
["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
+ ["Fetch charter" gnus-group-fetch-charter :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Display the charter of the current group"))]
+ ["Fetch control message" gnus-group-fetch-control :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Display the archived control message for the current group"))]
;; Actually one should check, if any of the marked groups gives t for
;; (gnus-check-backend-function 'request-expire-articles ...)
["Expire articles" gnus-group-expire-articles
(gnus-check-backend-function
'request-expire-articles
(gnus-group-group-name))) gnus-group-marked)]
- ["Set group level" gnus-group-set-current-level
+ ["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)]
["Execute command" gnus-group-universal-argument
(or gnus-group-marked (gnus-group-group-name))])
("Subscribe"
- ["Subscribe to a group" gnus-group-unsubscribe-group t]
+ ["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]
+ ["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
+ ["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
["Next unread same level" gnus-group-next-unread-group-same-level t]
["Previous unread same level"
gnus-group-prev-unread-group-same-level t]
- ["Jump to group" gnus-group-jump-to-group t]
+ ["Jump to group..." gnus-group-jump-to-group t]
["First unread group" gnus-group-first-unread-group t]
["Best unread group" gnus-group-best-unread-group t])
("Sieve"
["Activate all groups" gnus-activate-all-groups t]
["Restart Gnus" gnus-group-restart t]
["Read init file" gnus-group-read-init-file t]
- ["Browse foreign server" gnus-group-browse-foreign-server t]
+ ["Browse foreign server..." gnus-group-browse-foreign-server t]
["Enter server buffer" gnus-group-enter-server-mode t]
["Expire all expirable articles" gnus-group-expire-all-groups t]
["Generate any kiboze groups" nnkiboze-generate-groups t]
params (gnus-info-params info)
newsrc (cdr newsrc)
unread (car (gnus-gethash group gnus-newsrc-hashtb)))
- (if not-in-list
- (setq not-in-list (delete group not-in-list)))
- (and
- (gnus-group-prepare-logic
- group
- (and unread ; This group might be unchecked
- (or (not (stringp regexp))
- (string-match regexp group))
- (<= (setq clevel (gnus-info-level info)) level)
- (>= clevel lowest)
- (cond
- ((functionp predicate)
- (funcall predicate info))
- (predicate t) ; We list all groups?
- (t
- (or
- (if (eq unread t) ; Unactivated?
- gnus-group-list-inactive-groups
+ (when not-in-list
+ (setq not-in-list (delete group not-in-list)))
+ (when (gnus-group-prepare-logic
+ group
+ (and unread ; This group might be unchecked
+ (or (not (stringp regexp))
+ (string-match regexp group))
+ (<= (setq clevel (gnus-info-level info)) level)
+ (>= clevel lowest)
+ (cond
+ ((functionp predicate)
+ (funcall predicate info))
+ (predicate t) ; We list all groups?
+ (t
+ (or
+ (if (eq unread t) ; Unactivated?
+ gnus-group-list-inactive-groups
; We list unactivated
- (> unread 0))
+ (> unread 0))
; We list groups with unread articles
- (and gnus-list-groups-with-ticked-articles
- (cdr (assq 'tick (gnus-info-marks info))))
+ (and gnus-list-groups-with-ticked-articles
+ (cdr (assq 'tick (gnus-info-marks info))))
; And groups with tickeds
- ;; Check for permanent visibility.
- (and gnus-permanently-visible-groups
- (string-match gnus-permanently-visible-groups group))
- (memq 'visible params)
- (cdr (assq 'visible params)))))))
- (gnus-group-insert-group-line
- group (gnus-info-level info)
- (gnus-info-marks info) unread (gnus-info-method info)))))
+ ;; Check for permanent visibility.
+ (and gnus-permanently-visible-groups
+ (string-match gnus-permanently-visible-groups
+ group))
+ (memq 'visible params)
+ (cdr (assq 'visible params)))))))
+ (gnus-group-insert-group-line
+ group (gnus-info-level info)
+ (gnus-info-marks info) unread (gnus-info-method info)))))
;; List dead groups.
- (if (or gnus-group-listed-groups
- (and (>= level gnus-level-zombie)
- (<= lowest gnus-level-zombie)))
- (gnus-group-prepare-flat-list-dead
- (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
- gnus-level-zombie ?Z
- regexp))
- (if not-in-list
- (dolist (group gnus-zombie-list)
- (setq not-in-list (delete group not-in-list))))
- (if (or gnus-group-listed-groups
- (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
- (gnus-group-prepare-flat-list-dead
- (gnus-union
- not-in-list
- (setq gnus-killed-list (sort gnus-killed-list 'string<)))
- gnus-level-killed ?K regexp))
+ (when (or gnus-group-listed-groups
+ (and (>= level gnus-level-zombie)
+ (<= lowest gnus-level-zombie)))
+ (gnus-group-prepare-flat-list-dead
+ (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
+ gnus-level-zombie ?Z
+ regexp))
+ (when not-in-list
+ (dolist (group gnus-zombie-list)
+ (setq not-in-list (delete group not-in-list))))
+ (when (or gnus-group-listed-groups
+ (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
+ (gnus-group-prepare-flat-list-dead
+ (gnus-union
+ not-in-list
+ (setq gnus-killed-list (sort gnus-killed-list 'string<)))
+ gnus-level-killed ?K regexp))
(gnus-group-set-mode-line)
(setq gnus-group-list-mode (cons level predicate))
(zerop number)
(cdr (assq 'tick gnus-tmp-marked)))
?* ? ))
+ (gnus-tmp-summary-live
+ (if (and (not gnus-group-is-exiting-p)
+ (gnus-buffer-live-p (gnus-summary-buffer-name
+ gnus-tmp-group)))
+ ?* ? ))
(gnus-tmp-process-marked
(if (member gnus-tmp-group gnus-group-marked)
gnus-process-mark ? ))
(gnus-group-prefixed-name group method) method)))
;;;###autoload
-(defun gnus-fetch-group (group)
+(defun gnus-fetch-group (group &optional articles)
"Start Gnus if necessary and enter GROUP.
Returns whether the fetching was successful or not."
(interactive (list (completing-read "Group name: " gnus-active-hashtb)))
(unless (get-buffer gnus-group-buffer)
(gnus-no-server))
- (gnus-group-read-group nil nil group))
+ (gnus-group-read-group articles nil group))
;;;###autoload
(defun gnus-fetch-group-other-frame (group)
(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)
- gnus-group-jump-to-group-prompt
- 'gnus-group-history)))
+ (list (mm-string-make-unibyte
+ (completing-read
+ "Group: " gnus-active-hashtb nil
+ (gnus-read-active-file-p)
+ gnus-group-jump-to-group-prompt
+ 'gnus-group-history))))
(when (equal group "")
(error "Empty group name"))
(gnus-group-goto-group group)
(gnus-group-kill-group 1 t)
(gnus-sethash group nil gnus-active-hashtb)
- (when gnus-cache-active-hashtb
+ (when (and (boundp 'gnus-cache-active-hashtb)
+ gnus-cache-active-hashtb)
(gnus-sethash group nil gnus-cache-active-hashtb)
(setq gnus-cache-active-altered t))
t))
(defun gnus-group-sort-by-method (info1 info2)
"Sort alphabetically by backend name."
- (string< (symbol-name (car (gnus-find-method-for-group
- (gnus-info-group info1) info1)))
- (symbol-name (car (gnus-find-method-for-group
- (gnus-info-group info2) info2)))))
+ (string< (car (gnus-find-method-for-group
+ (gnus-info-group info1) info1))
+ (car (gnus-find-method-for-group
+ (gnus-info-group info2) info2))))
(defun gnus-group-sort-by-server (info1 info2)
"Sort alphabetically by server name."
(gnus-group-group-name)
(when current-prefix-arg
(completing-read
- "Faq dir: " (and (listp gnus-group-faq-directory)
+ "FAQ dir: " (and (listp gnus-group-faq-directory)
(mapcar #'list
gnus-group-faq-directory))))))
(unless group
(find-file file)
(setq found t))))))
+(defun gnus-group-fetch-charter (group)
+ "Fetch the charter for the current group.
+If given a prefix argument, prompt for a group."
+ (interactive
+ (list (or (when current-prefix-arg
+ (completing-read "Group: " gnus-active-hashtb))
+ (gnus-group-group-name)
+ gnus-newsgroup-name)))
+ (unless group
+ (error "No group name given"))
+ (require 'mm-url)
+ (condition-case nil (require 'url-http) (error nil))
+ (let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group)))
+ url hierarchy)
+ (when (string-match "\\(^[^\\.]+\\)\\..*" name)
+ (setq hierarchy (match-string 1 name))
+ (if (and (setq url (cdr (assoc hierarchy gnus-group-charter-alist)))
+ (if (fboundp 'url-http-file-exists-p)
+ (url-http-file-exists-p (eval url))
+ t))
+ (browse-url (eval url))
+ (setq url (concat "http://" hierarchy
+ ".news-admin.org/charters/" name))
+ (if (and (fboundp 'url-http-file-exists-p)
+ (url-http-file-exists-p url))
+ (browse-url url)
+ (gnus-group-fetch-control group))))))
+
+(defun gnus-group-fetch-control (group)
+ "Fetch the archived control messages for the current group.
+If given a prefix argument, prompt for a group."
+ (interactive
+ (list (or (when current-prefix-arg
+ (completing-read "Group: " gnus-active-hashtb))
+ (gnus-group-group-name)
+ gnus-newsgroup-name)))
+ (unless group
+ (error "No group name given"))
+ (let ((name (gnus-group-real-name group))
+ hierarchy)
+ (when (string-match "\\(^[^\\.]+\\)\\..*" name)
+ (setq hierarchy (match-string 1 name))
+ (if gnus-group-fetch-control-use-browse-url
+ (browse-url (concat "ftp://ftp.isc.org/usenet/control/"
+ hierarchy "/" name ".Z"))
+ (let ((enable-local-variables nil))
+ (gnus-group-read-ephemeral-group
+ group
+ `(nndoc ,group (nndoc-address
+ ,(find-file-noselect
+ (concat "/ftp@ftp.isc.org:/usenet/control/"
+ hierarchy "/" name ".Z")))
+ (nndoc-article-type mbox)) t nil nil))))))
+
(defun gnus-group-describe-group (force &optional group)
"Display a description of the current newsgroup."
(interactive (list current-prefix-arg (gnus-group-group-name)))
(setq gnus-newsgroup-unselected
(nreverse gnus-newsgroup-unselected)))))
(gnus-activate-group group)
- (gnus-group-make-articles-read group
- (list article))
+ (gnus-group-make-articles-read group (list article))
(when (gnus-group-auto-expirable-p group)
(gnus-add-marked-articles
group 'expire (list article))))))
:group 'gnus-start
:type 'hook)
-(defvar gnus-server-unopen-status nil
+(defcustom gnus-server-unopen-status nil
"The default status if the server is not able to open.
If the server is covered by Gnus agent, the possible values are
`denied', set the server denied; `offline', set the server offline;
`nil', ask user. If the server is not covered by Gnus agent, set the
-server denied.")
+server denied."
+ :group 'gnus-start
+ :type '(choice (const :tag "Ask" nil)
+ (const :tag "Deny server" denied)
+ (const :tag "Unplugg Agent" offline)))
;;;
;;; Server Communication
(defun gnus-status-message (gnus-command-method)
"Return the status message from GNUS-COMMAND-METHOD.
-If GNUS-COMMAND-METHOD is a string, it is interpreted as a group name. The method
+If GNUS-COMMAND-METHOD is a string, it is interpreted as a group name. The method
this group uses will be queried."
(let ((gnus-command-method
(if (stringp gnus-command-method)
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(when (gnus-check-backend-function
'request-update-info (car gnus-command-method))
- (funcall (gnus-get-function gnus-command-method 'request-update-info)
- (gnus-group-real-name (gnus-info-group info))
- info (nth 1 gnus-command-method))))
+ (let ((group (gnus-info-group info)))
+ (and (funcall (gnus-get-function gnus-command-method
+ 'request-update-info)
+ (gnus-group-real-name group)
+ info (nth 1 gnus-command-method))
+ ;; If the minimum article number is greater than 1, then all
+ ;; smaller article numbers are known not to exist; we'll
+ ;; artificially add those to the 'read range.
+ (let* ((active (gnus-active group))
+ (min (car active)))
+ (when (> min 1)
+ (let* ((range (if (= min 2) 1 (cons 1 (1- min))))
+ (read (gnus-info-read info))
+ (new-read (gnus-range-add read (list range))))
+ (gnus-info-set-read info new-read)))
+ info)))))
(defun gnus-request-expire-articles (articles group &optional force)
(let* ((gnus-command-method (gnus-find-method-for-group group))
;;; gnus-mlspl.el --- a group params-based mail splitting mechanism
-;; Copyright (C) 1998, 1999, 2000, 2001
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Alexandre Oliva <oliva@lsd.ic.unicamp.br>
;; Keywords: news, mail
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; This file is part of GNU Emacs.
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
+;; GNU Emacs is 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 this program; see the file COPYING. If not, write to
uses are as simple as the name of a default mail group, but more
elaborate fancy splits may also be useful to split mail that doesn't
match any of the group-specified splitting rules. See
-gnus-group-split-fancy for details."
+`gnus-group-split-fancy' for details."
(interactive "P")
(setq nnmail-split-methods 'nnmail-split-fancy)
(when catch-all
;;;###autoload
(defun gnus-group-split ()
"Uses information from group parameters in order to split mail.
-See gnus-group-split-fancy for more information.
+See `gnus-group-split-fancy' for more information.
gnus-group-split is a valid value for nnmail-split-methods."
(let (nnmail-split-fancy)
\(: gnus-group-split-fancy GROUPS NO-CROSSPOST CATCH-ALL\)
GROUPS may be a regular expression or a list of group names, that will
-be used to select candidate groups. If it is ommited or nil, all
+be used to select candidate groups. If it is omitted or nil, all
existing groups are considered.
-if NO-CROSSPOST is ommitted or nil, a & split will be returned,
+if NO-CROSSPOST is omitted or nil, a & split will be returned,
otherwise, a | split, that does not allow crossposting, will be
returned.
nnml:mail.others:
\((split-spec . catch-all))
-Calling (gnus-group-split-fancy nil nil \"mail.misc\") returns:
+Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
\(| (& (any \"\\\\(bar@femail\\\\.com\\\\|.*@femail\\\\.com\\\\)\"
\"mail.bar\")
"*Alist of styles to use when posting.
See Info node `(gnus)Posting Styles'."
:group 'gnus-message
+ :link '(custom-manual "(gnus)Posting Styles")
:type '(repeat (cons (choice (regexp)
(variable)
(list (const header)
"Should local-file attachments be included as external parts in Gcc copies?
If it is `all', attach files as external parts;
if a regexp and matches the Gcc group name, attach files as external parts;
-If nil, attach files as normal parts."
+if nil, attach files as normal parts."
:version "21.1"
:group 'gnus-message
:type '(choice (const nil :tag "None")
(const all :tag "Any")
(string :tag "Regexp")))
-(defcustom gnus-group-posting-charset-alist
+(gnus-define-group-parameter
+ posting-charset-alist
+ :type list
+ :function-document
+ "Return the permitted unencoded charsets for posting of GROUP."
+ :variable gnus-group-posting-charset-alist
+ :variable-default
'(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
(message-this-is-mail nil nil)
(message-this-is-news nil t))
+ :variable-document
"Alist of regexps and permitted unencoded charsets for posting.
Each element of the alist has the form (TEST HEADER BODY-LIST), where
TEST is either a regular expression matching the newsgroup header or a
Note that any value other than nil for HEADER infringes some RFCs, so
use this option with care."
- :type '(repeat (list :tag "Permitted unencoded charsets"
- (choice :tag "Where"
- (regexp :tag "Group")
- (const :tag "Mail message" :value message-this-is-mail)
- (const :tag "News article" :value message-this-is-news))
- (choice :tag "Header"
- (const :tag "None" nil)
- (symbol :tag "Charset"))
- (choice :tag "Body"
- (const :tag "Any" :value t)
- (const :tag "None" :value nil)
- (repeat :tag "Charsets"
- (symbol :tag "Charset")))))
- :group 'gnus-charset)
+ :variable-group gnus-charset
+ :variable-type
+ '(repeat (list :tag "Permitted unencoded charsets"
+ (choice :tag "Where"
+ (regexp :tag "Group")
+ (const :tag "Mail message" :value message-this-is-mail)
+ (const :tag "News article" :value message-this-is-news))
+ (choice :tag "Header"
+ (const :tag "None" nil)
+ (symbol :tag "Charset"))
+ (choice :tag "Body"
+ (const :tag "Any" :value t)
+ (const :tag "None" :value nil)
+ (repeat :tag "Charsets"
+ (symbol :tag "Charset")))))
+ :parameter-type '(choice :tag "Permitted unencoded charsets"
+ :value nil
+ (repeat (symbol)))
+ :parameter-document "\
+List of charsets that are permitted to be unencoded.")
(defcustom gnus-debug-files
'("gnus.el" "gnus-sum.el" "gnus-group.el"
(defvar gnus-inhibit-posting-styles nil
"Inhibit the use of posting styles.")
+(defvar gnus-article-yanked-articles nil)
(defvar gnus-message-buffer "*Mail Gnus*")
(defvar gnus-article-copy nil)
(defvar gnus-check-before-posting nil)
;;; Internal functions.
+(defun gnus-inews-make-draft ()
+ `(lambda ()
+ (gnus-inews-make-draft-meta-information
+ ,gnus-newsgroup-name ,gnus-article-reply)))
+
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
(let ((winconf (make-symbol "gnus-setup-message-winconf"))
(buffer (make-symbol "gnus-setup-message-buffer"))
(article (make-symbol "gnus-setup-message-article"))
+ (yanked (make-symbol "gnus-setup-yanked-articles"))
(group (make-symbol "gnus-setup-message-group")))
`(let ((,winconf (current-window-configuration))
(,buffer (buffer-name (current-buffer)))
(,article gnus-article-reply)
+ (,yanked gnus-article-yanked-articles)
(,group gnus-newsgroup-name)
(message-header-setup-hook
(copy-sequence message-header-setup-hook))
(add-hook 'message-mode-hook
(lambda ()
(gnus-configure-posting-styles ,group)))
+ (gnus-pull ',(intern gnus-draft-meta-information-header)
+ message-required-headers)
+ (when (and ,group
+ (not (string= ,group "")))
+ (push (cons
+ (intern gnus-draft-meta-information-header)
+ (gnus-inews-make-draft))
+ message-required-headers))
(unwind-protect
(progn
,@forms)
- (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config)
- (gnus-inews-insert-draft-meta-information ,group ,article)
+ (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
+ ,yanked)
(setq gnus-message-buffer (current-buffer))
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
(run-hooks 'post-command-hook)
(set-buffer-modified-p nil))))
-(defun gnus-inews-insert-draft-meta-information (group article)
- (save-excursion
- (when (and group
- (not (string= group ""))
- (not (message-fetch-field gnus-draft-meta-information-header)))
- (goto-char (point-min))
- (insert gnus-draft-meta-information-header ": (\"" group "\" "
- (if article (number-to-string
- (if (listp article)
- (car article)
- article)) "\"\"")
- ")\n"))))
+(defun gnus-inews-make-draft-meta-information (group article)
+ (concat "(\"" group "\" "
+ (if article (number-to-string
+ (if (listp article)
+ (car article)
+ article)) "\"\"")
+ ")"))
;;;###autoload
(defun gnus-msg-mail (&optional to subject other-headers continue
(symbol-value (car elem))))
(throw 'found (cons (cadr elem) (caddr elem)))))))))
-(defun gnus-inews-add-send-actions (winconf buffer article &optional config)
+(defun gnus-inews-add-send-actions (winconf buffer article
+ &optional config yanked)
(make-local-hook 'message-sent-hook)
(add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
'gnus-inews-do-gcc) nil t)
(set-buffer ,buffer)
,(when article
(if (eq config 'forward)
- `(gnus-summary-mark-article-as-forwarded ',article)
- `(gnus-summary-mark-article-as-replied ',article)))))
+ `(gnus-summary-mark-article-as-forwarded ',yanked)
+ `(gnus-summary-mark-article-as-replied ',yanked)))))
'send))
(put 'gnus-setup-message 'lisp-indent-function 1)
(with-current-buffer gnus-article-copy
(save-restriction
(nnheader-narrow-to-headers)
- (ietf-drums-unfold-fws)
- (nnheader-parse-head t)))))
+ (nnheader-parse-naked-head)))))
(message-yank-original)
(setq beg (or beg (mark t))))
(when articles
(goto-char (point-min))
(while (looking-at message-unix-mail-delimiter)
(forward-line 1))
- (setq beg (point)
- end (or (message-goto-body) beg))
+ (let ((mail-header-separator ""))
+ (setq beg (point)
+ end (or (message-goto-body) beg)))
;; Delete the headers from the displayed articles.
(set-buffer gnus-article-copy)
- (delete-region (goto-char (point-min))
- (or (message-goto-body) (point-max)))
+ (let ((mail-header-separator ""))
+ (delete-region (goto-char (point-min))
+ (or (message-goto-body) (point-max))))
;; Insert the original article headers.
(insert-buffer-substring gnus-original-article-buffer beg end)
;; Decode charsets.
(when article-buffer
(gnus-copy-article-buffer))
(let ((gnus-article-reply (and article-buffer (gnus-summary-article-number)))
+ (gnus-article-yanked-articles yank)
(add-to-list gnus-add-to-list))
(gnus-setup-message (cond (yank 'reply-yank)
(article-buffer 'reply)
(gnus-inews-yank-articles yank))))))
(defun gnus-msg-treat-broken-reply-to (&optional force)
- "Remove the Reply-to header iff broken-reply-to."
+ "Remove the Reply-to header if broken-reply-to."
(when (or force
(gnus-group-find-parameter
gnus-newsgroup-name 'broken-reply-to))
(caar yank)
(car yank)))
(gnus-article-reply (or article (gnus-summary-article-number)))
+ (gnus-article-yanked-articles yank)
(headers ""))
;; Stripping headers should be specified with mail-yank-ignored-headers.
(when yank
(set-buffer gnus-article-buffer)
(setq signed (memq 'signed gnus-article-wash-types))
(setq encrypted (memq 'encrypted gnus-article-wash-types)))
- (cond ((and gnus-message-replysign signed)
- (mml-secure-message mml-default-sign-method 'sign))
- ((and gnus-message-replyencrypt encrypted)
+ (cond ((and gnus-message-replyencrypt encrypted)
(mml-secure-message mml-default-encrypt-method
(if gnus-message-replysignencrypted
'signencrypt
- 'encrypt)))))))
+ 'encrypt)))
+ ((and gnus-message-replysign signed)
+ (mml-secure-message mml-default-sign-method 'sign))))))
(defun gnus-summary-reply-with-original (n &optional wide)
"Start composing a reply mail to the current message.
For the `inline' alternatives, also see the variable
`message-forward-ignored-headers'."
(interactive "P")
- (if (null (cdr (gnus-summary-work-articles nil)))
- (let ((message-forward-as-mime message-forward-as-mime)
- (message-forward-show-mml message-forward-show-mml))
- (cond
- ((null arg))
- ((eq arg 1)
- (setq message-forward-as-mime nil
- message-forward-show-mml t))
- ((eq arg 2)
- (setq message-forward-as-mime t
- message-forward-show-mml nil))
- ((eq arg 3)
- (setq message-forward-as-mime t
- message-forward-show-mml t))
- ((eq arg 4)
- (setq message-forward-as-mime nil
- message-forward-show-mml nil))
- (t
- (setq message-forward-as-mime (not message-forward-as-mime))))
- (let ((gnus-article-reply (gnus-summary-article-number)))
- (gnus-setup-message 'forward
- (gnus-summary-select-article)
- (let ((mail-parse-charset
- (or (and (gnus-buffer-live-p gnus-article-buffer)
- (with-current-buffer gnus-article-buffer
- gnus-article-charset))
- gnus-newsgroup-charset))
- (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
- (set-buffer gnus-original-article-buffer)
- (message-forward post)))))
- (gnus-uu-digest-mail-forward arg post)))
+ (if (cdr (gnus-summary-work-articles nil))
+ ;; Process marks are given.
+ (gnus-uu-digest-mail-forward arg post)
+ ;; No process marks.
+ (let ((message-forward-as-mime message-forward-as-mime)
+ (message-forward-show-mml message-forward-show-mml))
+ (cond
+ ((null arg))
+ ((eq arg 1)
+ (setq message-forward-as-mime nil
+ message-forward-show-mml t))
+ ((eq arg 2)
+ (setq message-forward-as-mime t
+ message-forward-show-mml nil))
+ ((eq arg 3)
+ (setq message-forward-as-mime t
+ message-forward-show-mml t))
+ ((eq arg 4)
+ (setq message-forward-as-mime nil
+ message-forward-show-mml nil))
+ (t
+ (setq message-forward-as-mime (not message-forward-as-mime))))
+ (let* ((gnus-article-reply (gnus-summary-article-number))
+ (gnus-article-yanked-articles (list gnus-article-reply)))
+ (gnus-setup-message 'forward
+ (gnus-summary-select-article)
+ (let ((mail-parse-charset
+ (or (and (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ gnus-article-charset))
+ gnus-newsgroup-charset))
+ (mail-parse-ignored-charsets
+ gnus-newsgroup-ignored-charsets))
+ (set-buffer gnus-original-article-buffer)
+ (message-forward post)))))))
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
message-required-news-headers
message-required-mail-headers)))
(goto-char (point-max))
- (insert "Gcc: " group "\n")
+ (if (string-match " " group)
+ (insert "Gcc: \"" group "\"\n")
+ (insert "Gcc: " group "\n"))
(widen)))
(gnus-inews-do-gcc)
(when (and (get-buffer gnus-group-buffer)
group))))
(when gcc
(insert "Gcc: "
- (if (stringp gcc) gcc
- (mapconcat 'identity gcc " "))
+ (if (stringp gcc)
+ (if (string-match " " gcc)
+ (concat "\"" gcc "\"")
+ gcc)
+ (mapconcat (lambda (group)
+ (if (string-match " " group)
+ (concat "\"" group "\"")
+ group))
+ gcc " "))
"\n"))))))
(defun gnus-inews-insert-archive-gcc (&optional group)
(progn
(insert
(if (stringp gcc-self-val)
- gcc-self-val
- group))
+ (if (string-match " " gcc-self-val)
+ (concat "\"" gcc-self-val "\"")
+ gcc-self-val)
+ (if (string-match " " group)
+ (concat "\"" group "\"")
+ group)))
(if (not (eq gcc-self-val 'none))
(insert "\n")
(progn
(kill-line))))
;; Use the list of groups.
(while (setq name (pop groups))
- (insert (if (string-match ":" name)
- name
- (gnus-group-prefixed-name
- name gnus-message-archive-method)))
+ (let ((str (if (string-match ":" name)
+ name
+ (gnus-group-prefixed-name
+ name gnus-message-archive-method))))
+ (insert (if (string-match " " str)
+ (concat "\"" str "\"")
+ str)))
(when groups
(insert " ")))
(insert "\n")))))))
(setq results (delq name (delq address results)))
;; make-local-hook is not obsolete in Emacs 20 or XEmacs.
(make-local-hook 'message-setup-hook)
+ (setq results (sort results (lambda (x y)
+ (string-lessp (car x) (car y)))))
(dolist (result results)
(add-hook 'message-setup-hook
(cond
;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002
+;; Free Software Foundation, Inc.
+
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
See <URL:http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html> for an
issuer registry."
:group 'gnus-nocem
+ :link '(url-link "http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html")
:type '(repeat (choice string sexp)))
(defcustom gnus-nocem-directory
(defcustom gnus-nocem-liberal-fetch nil
"*If t try to fetch all messages which have @@NCM in the subject.
Otherwise don't fetch messages which have references or whose message-id
-matches an previously scanned and verified nocem message."
+matches a previously scanned and verified nocem message."
:group 'gnus-nocem
:type 'boolean)
(setq list2 (cdr list2)))
list1))
+(defun gnus-range-difference (range1 range2)
+ "Return the range of elements in RANGE1 that do not appear in RANGE2.
+Both ranges must be in ascending order."
+ (setq range1 (gnus-range-normalize range1))
+ (setq range2 (gnus-range-normalize range2))
+ (let* ((new-range (cons nil (copy-sequence range1)))
+ (r new-range)
+ (safe t))
+ (while (cdr r)
+ (let* ((r1 (cadr r))
+ (r2 (car range2))
+ (min1 (if (numberp r1) r1 (car r1)))
+ (max1 (if (numberp r1) r1 (cdr r1)))
+ (min2 (if (numberp r2) r2 (car r2)))
+ (max2 (if (numberp r2) r2 (cdr r2))))
+
+ (cond ((> min1 max1)
+ ;; Invalid range: may result from overlap condition (below)
+ ;; remove Invalid range
+ (setcdr r (cddr r)))
+ ((and (= min1 max1)
+ (listp r1))
+ ;; Inefficient representation: may result from overlap condition (below)
+ (setcar (cdr r) min1))
+ ((not min2)
+ ;; All done with range2
+ (setq r nil))
+ ((< max1 min2)
+ ;; No overlap: range1 preceeds range2
+ (pop r))
+ ((< max2 min1)
+ ;; No overlap: range2 preceeds range1
+ (pop range2))
+ ((and (<= min2 min1) (<= max1 max2))
+ ;; Complete overlap: range1 removed
+ (setcdr r (cddr r)))
+ (t
+ (setcdr r (nconc (list (cons min1 (1- min2)) (cons (1+ max2) max1)) (cddr r)))))))
+ (cdr new-range)))
+
+
+
;;;###autoload
(defun gnus-sorted-difference (list1 list2)
"Return a list of elements of LIST1 that do not appear in LIST2.
(default gnus-summary-default-score)
(default-high gnus-summary-default-high-score)
(default-low gnus-summary-default-low-score)
+ (uncached (memq article gnus-newsgroup-undownloaded))
+ (downloaded (not uncached))
(mark (or (gnus-summary-article-mark article) gnus-unread-mark)))
;; Eval the cars of the lists until we find a match.
(while (and list
;; All score code written by Per Abrahamsen <abraham@iesd.auc.dk>.
-;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-score-set-mark-below (score)
"Automatically mark articles with score below SCORE as read."
(interactive
In the `bad' case, the string is a unsafe subexpression of REGEXP,
and we do not have a simple replacement to suggest.
-See `(Gnus)Scoring Tips' for examples of good regular expressions."
+See Info node `(gnus)Scoring Tips' for examples of good regular expressions."
(let (case-fold-search)
(and
;; First, try a relatively fast necessary condition.
gnus-soup-encoding-type
gnus-soup-index-type)
(gnus-soup-area-set-number
- area (1+ (or (gnus-soup-area-number area) 0))))
- ;; Mark article as read.
- (set-buffer gnus-summary-buffer)
+ area (1+ (or (gnus-soup-area-number area) 0)))
+ ;; Mark article as read.
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-mark-as-read (car articles) gnus-souped-mark))
(gnus-summary-remove-process-mark (car articles))
- (gnus-summary-mark-as-read (car articles) gnus-souped-mark)
(setq articles (cdr articles)))
(kill-buffer tmp-buf))
(gnus-soup-save-areas)
:group 'gnus-format
:type 'boolean)
+(defcustom gnus-make-format-preserve-properties (featurep 'xemacs)
+ "*If non-nil, use a replacement `format' function which preserves
+text properties. This is only needed on XEmacs, as FSF Emacs does this anyway."
+ :group 'gnus-format
+ :type 'boolean)
+
;;; Internal variables.
(defvar gnus-summary-mark-positions nil)
(defun gnus-balloon-face-function (form type)
`(gnus-put-text-property
(point) (progn ,@form (point))
- 'balloon-help
+ ,(if (fboundp 'balloon-help-mode)
+ ''balloon-help
+ ''help-echo)
,(intern (format "gnus-balloon-face-%d" type))))
(defun gnus-spec-tab (column)
characters correctly. This is because `format' may pad to columns or to
characters when given a pad value."
(let ((pad (abs pad-width))
- (side (< 0 pad-width)))
+ (side (< 0 pad-width))
+ (length-fun (gnus-string-width-function)))
(if (symbolp el)
- `(let ((need (- ,pad (,(if gnus-use-correct-string-widths
- 'gnus-correct-length
- 'length)
- ,el))))
+ `(let ((need (- ,pad (,length-fun ,el))))
(if (> need 0)
(concat ,(when side '(make-string need ?\ ))
,el
,(when (not side) '(make-string need ?\ )))
,el))
`(let* ((val (eval ,el))
- (need (- ,pad (,(if gnus-use-correct-string-widths
- 'gnus-correct-length
- 'length) val))))
+ (need (- ,pad (,length-fun val))))
(if (> need 0)
(concat ,(when side '(make-string need ?\ ))
val
(nth 1 sform)))))
form)))
+
+(defun gnus-xmas-format (fstring &rest args)
+ "A version of `format' which preserves text properties.
+
+Required for XEmacs, where the built in `format' function strips all text
+properties from both the format string and any inserted strings.
+
+Only supports the format sequence %s, and %% for inserting
+literal % characters. A pad width and an optional - (to right pad)
+are supported for %s."
+ (let ((re "%%\\|%\\(-\\)?\\([1-9][0-9]*\\)?s")
+ (n (length args)))
+ (with-temp-buffer
+ (insert-string fstring)
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (goto-char (match-end 0))
+ (cond
+ ((string= (match-string 0) "%%")
+ (delete-char -1))
+ (t
+ (if (null args)
+ (error 'wrong-number-of-arguments #'my-format n fstring))
+ (let* ((minlen (string-to-int (or (match-string 2) "")))
+ (arg (car args))
+ (str (if (stringp arg) arg (format "%s" arg)))
+ (lpad (null (match-string 1)))
+ (padlen (max 0 (- minlen (length str)))))
+ (replace-match "")
+ (if lpad (insert-char ?\ padlen))
+ (insert str)
+ (unless lpad (insert-char ?\ padlen))
+ (setq args (cdr args))))))
+ (buffer-string))))
+
(defun gnus-parse-simple-format (format spec-alist &optional insert)
;; This function parses the FORMAT string with the help of the
;; SPEC-ALIST and returns a list that can be eval'ed to return a
;; A single string spec in the end of the spec.
((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
(list (match-string 1 fstring) (car flist)))
+ ;; Only string (and %) specs (XEmacs only!)
+ ((and (featurep 'xemacs)
+ gnus-make-format-preserve-properties
+ (string-match
+ "\\`\\([^%]*\\(%%\\|%-?\\([1-9][0-9]*\\)?s\\)\\)*[^%]*\\'"
+ fstring))
+ (list (cons 'gnus-xmas-format (cons fstring (nreverse flist)))))
;; A more complex spec.
(t
(list (cons 'format (cons fstring (nreverse flist)))))))
%a agent covered
General format specifiers can also be used.
-See (gnus)Formatting Variables."
+See Info node `(gnus)Formatting Variables'."
:link '(custom-manual "(gnus)Formatting Variables")
:group 'gnus-server-visual
:type 'string)
(easy-menu-define
gnus-server-server-menu gnus-server-mode-map ""
'("Server"
- ["Add" gnus-server-add-server t]
+ ["Add..." gnus-server-add-server t]
["Browse" gnus-server-read-server t]
["Scan" gnus-server-scan-server t]
["List" gnus-server-list-servers t]
(while alist
(unless (member (cdar alist) done)
(push (cdar alist) done)
- (cdr (setq server (pop alist)))
+ (setq server (pop alist))
(when (and server (car server) (cdr server))
(gnus-server-insert-server-line (car server) (cdr server))))
(when (member (cdar alist) done)
"L" gnus-browse-exit
"q" gnus-browse-exit
"Q" gnus-browse-exit
+ "d" gnus-browse-describe-group
"\C-c\C-c" gnus-browse-exit
"?" gnus-browse-describe-briefly
["Subscribe" gnus-browse-unsubscribe-current-group t]
["Read" gnus-browse-read-group t]
["Select" gnus-browse-select-group t]
+ ["Describe" gnus-browse-describe-groups t]
["Next" gnus-browse-next-group t]
["Prev" gnus-browse-prev-group t]
["Exit" gnus-browse-exit t]))
(list
(format
"Gnus: %%b {%s:%s}" (car method) (cadr method))))
- (let ((buffer-read-only nil) charset
+ (let ((buffer-read-only nil)
+ charset
(prefix (let ((gnus-select-method orig-select-method))
(gnus-group-prefixed-name "" method))))
- (while groups
- (setq group (car groups))
+ (dolist (group groups)
(setq charset (gnus-group-name-charset method (car group)))
(gnus-add-text-properties
(point)
(prog1 (1+ (point))
(insert
(format "%c%7d: %s\n"
- (let ((level (gnus-group-level (concat prefix (car group)))))
+ (let ((level (gnus-group-level
+ (concat prefix (car group)))))
(cond
((<= level gnus-level-subscribed) ? )
((<= level gnus-level-unsubscribed) ?U)
(match-string-no-properties 1))
gnus-browse-current-method)))))
+(defun gnus-browse-describe-group (group)
+ "Describe the current group."
+ (interactive (list (gnus-browse-group-name)))
+ (gnus-group-describe-group nil group))
+
(defun gnus-browse-unsubscribe-group ()
"Toggle subscription of the current group in the browse buffer."
(let ((sub nil)
(unless (eq (char-after) ? )
(setq sub t))
(setq group (gnus-browse-group-name))
- ;;;;
- ;;(when (and sub
- ;; (cadr (gnus-gethash group gnus-newsrc-hashtb)))
- ;;(error "Group already subscribed"))
(if sub
(progn
;; Make sure the group has been properly removed before we
:group 'gnus-start
:type 'hook)
-(defcustom gnus-setup-news-hook nil
+(defcustom gnus-setup-news-hook
+ '(gnus-fixup-nnimap-unread-after-getting-new-news)
"A hook after reading the .newsrc file, but before generating the buffer."
:group 'gnus-start
:type 'hook)
:type 'hook)
(defcustom gnus-after-getting-new-news-hook
- '(gnus-display-time-event-handler)
+ '(gnus-display-time-event-handler
+ gnus-fixup-nnimap-unread-after-getting-new-news)
"*A hook run after Gnus checks for new news when Gnus is already running."
:group 'gnus-group-new
:type 'hook)
(add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
;; Do the actual startup.
+ (if gnus-agent
+ (gnus-request-create-group "queue" '(nndraft "")))
+ (gnus-request-create-group "drafts" '(nndraft ""))
(gnus-setup-news nil level dont-connect)
(gnus-run-hooks 'gnus-setup-news-hook)
(gnus-start-draft-setup)
(t 0))
level))
scanned-methods info group active method retrieve-groups)
- (gnus-message 5 "Checking new news...")
+ (gnus-message 6 "Checking new news...")
(while newsrc
(setq active (gnus-active (setq group (gnus-info-group
(gnus-set-active group nil)
(setcar (gnus-gethash group gnus-newsrc-hashtb) t)))))))
- (gnus-message 5 "Checking new news...done")))
+ (gnus-message 6 "Checking new news...done")))
;; Create a hash table out of the newsrc alist. The `car's of the
;; alist elements are used as keys.
(setq article (pop articles)) ranges)
(push article news)))
(when news
+ ;; Enter this list into the group info.
(gnus-info-set-read
info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
+
+ ;; Set the number of unread articles in gnus-newsrc-hashtb.
+ (gnus-get-unread-articles-in-group info (gnus-active group))
+
+ ;; Insert the change into the group buffer and the dribble file.
+ (gnus-group-update-group group t))))
+
+(defun gnus-make-ascending-articles-unread (group articles)
+ "Mark ascending ARTICLES in GROUP as unread."
+ (let* ((entry (or (gnus-gethash group gnus-newsrc-hashtb)
+ (gnus-gethash (gnus-group-real-name group)
+ gnus-newsrc-hashtb)))
+ (info (nth 2 entry))
+ (ranges (gnus-info-read info))
+ (r ranges)
+ modified)
+
+ (while articles
+ (let ((article (pop articles))) ; get the next article to remove from ranges
+ (while (let ((range (car ranges))) ; note the current range
+ (if (atom range) ; single value range
+ (cond ((not range)
+ ;; the articles extend past the end of the ranges
+ ;; OK - I'm done
+ (setq articles nil))
+ ((< range article)
+ ;; this range preceeds the article. Leave the range unmodified.
+ (pop ranges)
+ ranges)
+ ((= range article)
+ ;; this range exactly matches the article; REMOVE THE RANGE.
+ ;; NOTE: When the range being removed is the last range, the list is corrupted by inserting null at its end.
+ (setcar ranges (cadr ranges))
+ (setcdr ranges (cddr ranges))
+ (setq modified (if (car ranges) t 'remove-null))
+ nil))
+ (let ((min (car range))
+ (max (cdr range)))
+ ;; I have a min/max range to consider
+ (cond ((> min max) ; invalid range introduced by splitter
+ (setcar ranges (cadr ranges))
+ (setcdr ranges (cddr ranges))
+ (setq modified (if (car ranges) t 'remove-null))
+ ranges)
+ ((= min max)
+ ;; replace min/max range with a single-value range
+ (setcar ranges min)
+ ranges)
+ ((< max article)
+ ;; this range preceeds the article. Leave the range unmodified.
+ (pop ranges)
+ ranges)
+ ((< article min)
+ ;; this article preceeds the range. Return null to move to the
+ ;; next article
+ nil)
+ (t
+ ;; this article splits the range into two parts
+ (setcdr ranges (cons (cons (1+ article) max) (cdr ranges)))
+ (setcdr range (1- article))
+ (setq modified t)
+ ranges))))))))
+
+ (when modified
+ (when (eq modified 'remove-null)
+ (setq r (delq nil r)))
+ ;; Enter this list into the group info.
+ (gnus-info-set-read info r)
+
+ ;; Set the number of unread articles in gnus-newsrc-hashtb.
+ (gnus-get-unread-articles-in-group info (gnus-active group))
+
+ ;; Insert the change into the group buffer and the dribble file.
(gnus-group-update-group group t))))
;; Enter all dead groups into the hashtb.
(nconc (gnus-uncompress-range dormant)
(gnus-uncompress-range ticked)))))))))
+(defun gnus-load (file)
+ "Load FILE, but in such a way that read errors can be reported."
+ (with-temp-buffer
+ (insert-file-contents file)
+ (while (not (eobp))
+ (condition-case type
+ (let ((form (read (current-buffer))))
+ (eval form))
+ (error
+ (unless (eq (car type) 'end-of-file)
+ (let ((error (format "Error in %s line %d" file
+ (count-lines (point-min) (point)))))
+ (ding)
+ (unless (gnus-yes-or-no-p (concat error "; continue? "))
+ (error "%s" error)))))))))
+
(defun gnus-read-newsrc-el-file (file)
(let ((ding-file (concat file "d")))
;; We always, always read the .eld file.
(gnus-message 5 "Reading %s..." ding-file)
(let (gnus-newsrc-assoc)
- (if (or debug-on-error debug-on-quit)
- (let ((coding-system-for-read gnus-ding-file-coding-system))
- (load ding-file t t t))
- (condition-case nil
- (let ((coding-system-for-read gnus-ding-file-coding-system))
- (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)))))
+ (let ((coding-system-for-read gnus-ding-file-coding-system))
+ (gnus-load ding-file))
;; Older versions of `gnus-format-specs' are no longer valid
;; in Oort Gnus 0.01.
(let ((version
(when (gnus-boundp 'display-time-timer)
(display-time-event-handler)))
+;;;###autoload
+(defun gnus-fixup-nnimap-unread-after-getting-new-news ()
+ (let (server group info)
+ (mapatoms
+ (lambda (sym)
+ (when (and (setq group (symbol-name sym))
+ (gnus-group-entry group)
+ (setq info (symbol-value sym)))
+ (gnus-sethash group (cons (nth 2 info) (cdr (gnus-group-entry group)))
+ gnus-newsrc-hashtb)))
+ (if (boundp 'nnimap-mailbox-info)
+ (symbol-value 'nnimap-mailbox-info)
+ (make-vector 1 0)))))
+
+
(provide 'gnus-start)
;;; gnus-start.el ends here
+
+
(const adopt)
(const empty)))
+(defcustom gnus-summary-make-false-root-always t
+ "Always make a false dummy root."
+ :group 'gnus-thread
+ :type 'boolean)
+
(defcustom gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
"*A regexp to match subjects to be excluded from loose thread gathering.
As loose thread gathering is done on subjects only, that means that
:type '(repeat function))
(defcustom gnus-simplify-ignored-prefixes nil
- "*Regexp, matches for which are removed from subject lines when simplifying fuzzily."
+ "*Remove matches for this regexp from subject lines when simplifying fuzzily."
:group 'gnus-thread
:type '(choice (const :tag "off" nil)
regexp))
the end of an article.
If nil, the marking commands do NOT go to the next unread article
-(they go to the next article instead). If `never', commands that
+\(they go to the next article instead). If `never', commands that
usually go to the next unread article, will go to the next article,
whether it is read or not."
:group 'gnus-summary-marks
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-undownloaded-mark ?@
+(defcustom gnus-undownloaded-mark ?-
"*Mark used for articles that weren't downloaded."
:group 'gnus-summary-marks
:type 'character)
+(defcustom gnus-downloaded-mark ?+
+ "*Mark used for articles that were downloaded."
+ :group 'gnus-summary-marks
+ :type 'character)
+
(defcustom gnus-downloadable-mark ?%
"*Mark used for articles that are to be downloaded."
:group 'gnus-summary-marks
:type 'boolean)
(defcustom gnus-summary-dummy-line-format
- " %(: :%) %S\n"
+ " %(: :%) %S\n"
"*The format specification for the dummy roots in the summary buffer.
It works along the same lines as a normal formatting string,
with some simple extensions.
:group 'gnus-summary-visual
:type 'face)
+(defvar gnus-tmp-downloaded nil)
+
(defcustom gnus-summary-highlight
'(((eq mark gnus-canceled-mark)
. gnus-summary-cancelled-face)
+ ((and uncached (> score default-high))
+ . gnus-summary-high-uncached-face)
+ ((and uncached (< score default-low))
+ . gnus-summary-low-uncached-face)
+ (uncached
+ . gnus-summary-normal-uncached-face)
((and (> score default-high)
(or (eq mark gnus-dormant-mark)
(eq mark gnus-ticked-mark)))
. gnus-summary-low-unread-face)
((eq mark gnus-unread-mark)
. gnus-summary-normal-unread-face)
- ((and (> score default-high) (memq mark (list gnus-downloadable-mark
- gnus-undownloaded-mark)))
- . gnus-summary-high-unread-face)
- ((and (< score default-low) (memq mark (list gnus-downloadable-mark
- gnus-undownloaded-mark)))
- . gnus-summary-low-unread-face)
- ((and (memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
- (memq article gnus-newsgroup-unreads))
- . gnus-summary-normal-unread-face)
- ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
- . gnus-summary-normal-read-face)
((> score default-high)
. gnus-summary-high-read-face)
((< score default-low)
(defvar gnus-article-ignored-charsets nil)
(defvar gnus-scores-exclude-files nil)
(defvar gnus-page-broken nil)
-(defvar gnus-inhibit-mime-unbuttonizing nil)
(defvar gnus-original-article nil)
(defvar gnus-article-internal-prepare-hook nil)
(?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)
+ (?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
(?L gnus-tmp-lines ?s)
+ (?O gnus-tmp-downloaded ?c)
(?I gnus-tmp-indentation ?s)
(?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
(?R gnus-tmp-replied ?c)
(defvar gnus-last-shell-command nil
"Default shell command on article.")
+(defvar gnus-newsgroup-agentized nil
+ "Locally bound in each summary buffer to indicate whether the server has been agentized.")
(defvar gnus-newsgroup-begin nil)
(defvar gnus-newsgroup-end nil)
(defvar gnus-newsgroup-last-rmail nil)
"T" gnus-summary-limit-include-thread
"d" gnus-summary-limit-exclude-dormant
"t" gnus-summary-limit-to-age
+ "." gnus-summary-limit-to-unseen
"x" gnus-summary-limit-to-extra
"p" gnus-summary-limit-to-display-predicate
"E" gnus-summary-limit-include-expunged
(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
"g" gnus-summary-prepare
- "c" gnus-summary-insert-cached-articles)
+ "c" gnus-summary-insert-cached-articles
+ "d" gnus-summary-insert-dormant-articles)
(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
"c" gnus-summary-catchup-and-exit
"f" gnus-article-display-x-face
"l" gnus-summary-stop-page-breaking
"r" gnus-summary-caesar-message
+ "m" gnus-summary-morse-message
"t" gnus-summary-toggle-header
"g" gnus-treat-smiley
"v" gnus-summary-verbose-headers
"f" gnus-summary-fetch-faq
"d" gnus-summary-describe-group
"h" gnus-summary-describe-briefly
- "i" gnus-info-find-node)
+ "i" gnus-info-find-node
+ "c" gnus-group-fetch-charter
+ "C" gnus-group-fetch-control)
(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
"e" gnus-summary-expire-articles
["Charset" gnus-article-decode-charset t]
["QP" gnus-article-de-quoted-unreadable t]
["Base64" gnus-article-de-base64-unreadable t]
+ ["View MIME buttons" gnus-summary-display-buttonized t]
["View all" gnus-mime-view-all-parts t]
["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t]
["Encrypt body" gnus-article-encrypt-body t]
(sort (if (fboundp 'coding-system-list)
(coding-system-list)
(mapcar 'car mm-mime-mule-charset-alist))
- (lambda (a b)
- (string< (symbol-name a)
- (symbol-name b))))))))
+ 'string<)))))
("Washing"
("Remove Blanks"
["Leading" gnus-article-strip-leading-blank-lines t]
["Rot 13" gnus-summary-caesar-message
,@(if (featurep 'xemacs) '(t)
'(:help "\"Caesar rotate\" article by 13"))]
- ["Unix pipe" gnus-summary-pipe-message t]
+ ["Morse decode" gnus-summary-morse-message t]
+ ["Unix pipe..." gnus-summary-pipe-message t]
["Add buttons" gnus-article-add-buttons t]
["Add buttons to head" gnus-article-add-buttons-to-head t]
["Stop page breaking" gnus-summary-stop-page-breaking t]
["Author..." gnus-summary-limit-to-author t]
["Age..." gnus-summary-limit-to-age t]
["Extra..." gnus-summary-limit-to-extra t]
- ["Score" gnus-summary-limit-to-score t]
+ ["Score..." gnus-summary-limit-to-score t]
["Display Predicate" gnus-summary-limit-to-display-predicate t]
["Unread" gnus-summary-limit-to-unread t]
+ ["Unseen" gnus-summary-limit-to-unseen t]
["Non-dormant" gnus-summary-limit-exclude-dormant t]
- ["Articles" gnus-summary-limit-to-articles t]
+ ["Next articles" gnus-summary-limit-to-articles t]
["Pop limit" gnus-summary-pop-limit t]
["Show dormant" gnus-summary-limit-include-dormant t]
["Hide childless dormant"
("Help"
["Fetch group FAQ" gnus-summary-fetch-faq t]
["Describe group" gnus-summary-describe-group t]
+ ["Fetch charter" gnus-group-fetch-charter
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Display the charter of the current group"))]
+ ["Fetch control message" gnus-group-fetch-control
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Display the archived control message for the current group"))]
["Read manual" gnus-info-find-node t])
("Modes"
["Pick and read" gnus-pick-mode t]
("Regeneration"
["Regenerate" gnus-summary-prepare t]
["Insert cached articles" gnus-summary-insert-cached-articles t]
+ ["Insert dormant articles" gnus-summary-insert-dormant-articles t]
["Toggle threading" gnus-summary-toggle-threads t])
["See old articles" gnus-summary-insert-old-articles t]
["See new articles" gnus-summary-insert-new-articles t]
(defmacro gnus-summary-article-number ()
"The article number of the article on the current line.
-If there isn's an article number here, then we return the current
+If there isn't an article number here, then we return the current
article number."
'(progn
(gnus-summary-skip-intangible)
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)
(let ((gnus-replied-mark 129)
(gnus-score-below-mark 130)
(gnus-score-over-mark 130)
- (gnus-download-mark 131)
+ (gnus-downloaded-mark 131)
(spec gnus-summary-line-format-spec)
gnus-visual pos)
(save-excursion
(gnus-set-work-buffer)
(let ((gnus-summary-line-format-spec spec)
- (gnus-newsgroup-downloadable '((0 . t))))
+ (gnus-newsgroup-downloadable '(0)))
(gnus-summary-insert-line
[0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil]
- 0 nil 128 t nil "" nil 1)
+ 0 nil nil 128 t nil "" nil 1)
(goto-char (point-min))
(setq pos (list (cons 'unread (and (search-forward "\200" nil t)
(- (point) (point-min) 1)))))
(defun gnus-summary-insert-line (gnus-tmp-header
gnus-tmp-level gnus-tmp-current
- gnus-tmp-unread gnus-tmp-replied
+ undownloaded gnus-tmp-unread gnus-tmp-replied
gnus-tmp-expirable gnus-tmp-subject-or-nil
&optional gnus-tmp-dummy gnus-tmp-score
gnus-tmp-process)
((memq gnus-tmp-number gnus-newsgroup-unseen)
gnus-unseen-mark)
(t gnus-no-mark)))
+ (gnus-tmp-downloaded
+ (cond (undownloaded
+ gnus-undownloaded-mark)
+ (gnus-newsgroup-agentized
+ gnus-downloaded-mark)
+ (t
+ gnus-no-mark)))
(gnus-tmp-from (mail-header-from gnus-tmp-header))
(gnus-tmp-name
(cond
gnus-empty-thread-mark)
number)))
+(defsubst gnus-summary-line-message-size (head)
+ "Return pretty-printed version of message size.
+This function is intended to be used in
+`gnus-summary-line-format-alist', which see."
+ (let ((c (or (mail-header-chars head) -1)))
+ (cond ((< c 0) "n/a") ; chars not available
+ ((< c (* 1000 10)) (format "%1.1fk" (/ c 1024.0)))
+ ((< c (* 1000 100)) (format "%dk" (/ c 1024.0)))
+ ((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024))))
+ (t (format "%dM" (/ c (* 1024.0 1024)))))))
+
+
(defun gnus-summary-set-local-parameters (group)
"Go through the local params of GROUP and set all variable specs in that list."
(let ((params (gnus-group-find-parameter group))
(let ((gnus-newsgroup-dormant nil))
(gnus-summary-initial-limit show-all))
(gnus-summary-initial-limit show-all))
- ;; When untreaded, all articles are always shown.
+ ;; When unthreaded, all articles are always shown.
(setq gnus-newsgroup-limit
(mapcar
(lambda (header) (mail-header-number header))
;; Mark this buffer as "prepared".
(setq gnus-newsgroup-prepared t)
(gnus-run-hooks 'gnus-summary-prepared-hook)
+ (gnus-group-update-group group)
t)))))
(defun gnus-summary-auto-select-subject ()
(setcdr prev (cdr threads))
(setq threads prev))
;; Enter this thread into the hash table.
- (gnus-sethash subject threads hashtb)))
+ (gnus-sethash subject
+ (if gnus-summary-make-false-root-always
+ (progn
+ ;; If you want a dummy root above all
+ ;; threads...
+ (setcar threads (list whole-subject
+ (car threads)))
+ threads)
+ threads)
+ hashtb)))
(setq prev threads)
(setq threads (cdr threads)))
result)))
;; overview: [num subject from date id refs chars lines misc]
(unwind-protect
- (progn
+ (let (x)
(narrow-to-region (point) eol)
(unless (eobp)
(forward-char))
(setq header
(make-full-mail-header
number ; number
- (funcall gnus-decode-encoded-word-function
- (nnheader-nov-field)) ; subject
- (funcall gnus-decode-encoded-word-function
- (nnheader-nov-field)) ; from
+ (condition-case () ; subject
+ (funcall gnus-decode-encoded-word-function
+ (setq x (nnheader-nov-field)))
+ (error x))
+ (condition-case () ; from
+ (funcall gnus-decode-encoded-word-function
+ (setq x (nnheader-nov-field)))
+ (error x))
(nnheader-nov-field) ; date
(nnheader-nov-read-message-id) ; id
(setq references (nnheader-nov-field)) ; refs
(level (gnus-summary-thread-level)))
(gnus-delete-line)
(gnus-summary-insert-line
- header level nil (gnus-article-mark article)
+ header level nil
+ (memq article gnus-newsgroup-undownloaded)
+ (gnus-article-mark article)
(memq article gnus-newsgroup-replied)
(memq article gnus-newsgroup-expirable)
;; Only insert the Subject string when it's different
(when parent
(delq thread parent)))
(if (gnus-summary-insert-subject id header)
- ;; Set the (possibly) new article number in the data structure.
+ ;; Set the (possibly) new article number in the data structure.
(gnus-data-set-number data (gnus-id-to-article id))
(setcar thread old)
nil))))
(if (not gnus-thread-sort-functions)
threads
(gnus-message 8 "Sorting threads...")
- (prog1
- (gnus-sort-threads-1
+ (let ((max-lisp-eval-depth 5000))
+ (prog1 (gnus-sort-threads-1
threads
(gnus-make-sort-function gnus-thread-sort-functions))
- (gnus-message 8 "Sorting threads...done"))))
+ (gnus-message 8 "Sorting threads...done")))))
(defun gnus-sort-articles (articles)
"Sort ARTICLES."
(defun gnus-thread-latest-date (thread)
"Return the highest article date in THREAD."
(let ((previous-time 0))
- (apply 'max (mapcar
- (lambda (header)
- (setq previous-time
- (time-to-seconds
- (mail-header-parse-date
- (condition-case ()
- (mail-header-date header)
- (error previous-time))))))
- (sort
- (message-flatten-list thread)
- (lambda (h1 h2)
- (< (mail-header-number h1)
- (mail-header-number h2))))))))
+ (apply 'max
+ (mapcar
+ (lambda (header)
+ (setq previous-time
+ (time-to-seconds
+ (condition-case ()
+ (mail-header-parse-date (mail-header-date header))
+ (error previous-time)))))
+ (sort
+ (message-flatten-list thread)
+ (lambda (h1 h2)
+ (< (mail-header-number h1)
+ (mail-header-number h2))))))))
(defun gnus-thread-total-score-1 (root)
;; This function find the total score of the thread below ROOT.
(let ((gnus-tmp-level 0)
(default-score (or gnus-summary-default-score 0))
(gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
+ (building-line-count gnus-summary-display-while-building)
+ (building-count (integerp gnus-summary-display-while-building))
thread number subject stack state gnus-tmp-gathered beg-match
new-roots gnus-tmp-new-adopts thread-end simp-subject
- gnus-tmp-header gnus-tmp-unread
+ gnus-tmp-header gnus-tmp-unread gnus-tmp-downloaded
gnus-tmp-replied gnus-tmp-subject-or-nil
gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
;; Do the threaded display.
+ (if gnus-summary-display-while-building
+ (switch-to-buffer (buffer-name)))
(while (or threads stack gnus-tmp-new-adopts new-roots)
(if (and (= gnus-tmp-level 0)
((memq number gnus-newsgroup-unseen)
gnus-unseen-mark)
(t gnus-no-mark))
+ gnus-tmp-downloaded
+ (cond ((memq number gnus-newsgroup-undownloaded)
+ gnus-undownloaded-mark)
+ (gnus-newsgroup-agentized
+ gnus-downloaded-mark)
+ (t
+ gnus-no-mark))
gnus-tmp-from (mail-header-from gnus-tmp-header)
gnus-tmp-name
(cond
(push (if (nth 1 thread) 1 0) tree-stack)
(incf gnus-tmp-level)
(setq threads (if thread-end nil (cdar thread)))
+ (if gnus-summary-display-while-building
+ (if building-count
+ (progn
+ ;; use a set frequency
+ (setq building-line-count (1- building-line-count))
+ (when (= building-line-count 0)
+ (sit-for 0)
+ (setq building-line-count
+ gnus-summary-display-while-building)))
+ ;; always
+ (sit-for 0)))
(unless threads
(setq gnus-tmp-level 0)))))
(gnus-message 7 "Generating summary...done"))
gnus-newsgroup-data)
(gnus-summary-insert-line
header 0 number
+ (memq number gnus-newsgroup-undownloaded)
mark (memq number gnus-newsgroup-replied)
(memq number gnus-newsgroup-expirable)
(mail-header-subject header) nil
;; Adjust and set lists of article marks.
(when info
(gnus-adjust-marked-articles info))
-
(if (setq articles select-articles)
(setq gnus-newsgroup-unselected
(gnus-sorted-difference gnus-newsgroup-unreads articles))
(gnus-make-hashtable (length articles)))
(gnus-set-global-variables)
;; Retrieve the headers and read them in.
+
(setq gnus-newsgroup-headers (gnus-fetch-headers articles))
;; Kludge to avoid having cached articles nixed out in virtual groups.
(gnus-get-predicate display)))
;; Uses the dynamically bound `number' variable.
-(defvar number)
+(eval-when-compile
+ (defvar number))
(defun gnus-article-marked-p (type &optional article)
(let ((article (or article number)))
(cond
(defun gnus-articles-to-read (group &optional read-all)
"Find out what articles the user wants to read."
- (let* ((articles
+ (let* ((display (gnus-group-find-parameter group 'display))
+ (articles
;; Select all articles if `read-all' is non-nil, or if there
;; are no unread articles.
(if (or read-all
(progn
(while arts
(when (or (and undownloaded
- (eq gnus-undownloaded-mark
- (gnus-data-mark (car arts))))
+ (memq (car arts) gnus-newsgroup-undownloaded))
(gnus-data-unread-p (car arts)))
(setq result (car arts)
arts nil))
(defun gnus-summary-toggle-truncation (&optional arg)
"Toggle truncation of summary lines.
-With arg, turn line truncation on iff arg is positive."
+With arg, turn line truncation on if arg is positive."
(interactive "P")
(setq truncate-lines
(if (null arg) (not truncate-lines)
(> (prefix-numeric-value arg) 0)))
(redraw-display))
+(defun gnus-summary-find-uncancelled ()
+ "Return the number of an uncancelled article.
+The current article is considered, then following articles, then previous
+articles. If all articles are cancelled then return a dummy 0."
+ (let (found)
+ (dolist (rev '(nil t))
+ (unless found ; don't demand the reverse list if we don't need it
+ (let ((data (gnus-data-find-list
+ (gnus-summary-article-number) (gnus-data-list rev))))
+ (while (and data (not found))
+ (if (not (eq gnus-canceled-mark (gnus-data-mark (car data))))
+ (setq found (gnus-data-number (car data))))
+ (setq data (cdr data))))))
+ (or found 0)))
+
(defun gnus-summary-reselect-current-group (&optional all rescan)
"Exit and then reselect the current newsgroup.
The prefix argument ALL means to select all articles."
(interactive "P")
(when (gnus-ephemeral-group-p gnus-newsgroup-name)
(error "Ephemeral groups can't be reselected"))
- (let ((current-subject (gnus-summary-article-number))
+ (let ((current-subject (gnus-summary-find-uncancelled))
(group gnus-newsgroup-name))
(setq gnus-newsgroup-begin nil)
(gnus-summary-exit)
(gnus-async-halt-prefetch)
(let* ((group gnus-newsgroup-name)
(quit-config (gnus-group-quit-config gnus-newsgroup-name))
+ (gnus-group-is-exiting-p t)
(mode major-mode)
(group-point nil)
(buf (current-buffer)))
(progn
(gnus-deaden-summary)
(setq mode nil))
- ;; We set all buffer-local variables to nil. It is unclear why
+ ;; 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.
"Quit reading current newsgroup without updating read article info."
(interactive)
(let* ((group gnus-newsgroup-name)
+ (gnus-group-is-exiting-p t)
(quit-config (gnus-group-quit-config group)))
(when (or no-questions
gnus-expert-user
(gnus-configure-windows 'group 'force)
;; Clear the current group name.
(setq gnus-newsgroup-name nil)
+ (gnus-group-update-group group)
(when (equal (gnus-group-group-name) group)
(gnus-group-next-unread-group 1))
(when quit-config
(list
(when current-prefix-arg
(completing-read
- "Faq dir: " (and (listp gnus-group-faq-directory)
+ "FAQ dir: " (and (listp gnus-group-faq-directory)
(mapcar (lambda (file) (list file))
gnus-group-faq-directory))))))
(let (gnus-faq-buffer)
(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)
(let ((unreads (gnus-group-group-unread)))
(if (and (or (eq t unreads)
(and unreads (not (zerop unreads))))
- (gnus-summary-read-group
- target-group nil no-article
- (and (buffer-name current-buffer) current-buffer)
- nil backward))
+ (progn
+ ;; Now 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...
+ (when (gnus-buffer-live-p current-buffer)
+ (set-buffer current-buffer)
+ (gnus-summary-exit t))
+ (gnus-summary-read-group
+ target-group nil no-article
+ (and (buffer-name current-buffer) current-buffer)
+ nil backward)))
(setq entered t)
(setq current-group target-group
target-group nil)))))))
(let ((data gnus-newsgroup-data))
(while (and data
(and (not (and undownloaded
- (eq gnus-undownloaded-mark
- (gnus-data-mark (car data)))))
+ (memq (car data) gnus-newsgroup-undownloaded)))
(if unseen
(or (not (memq
(gnus-data-number (car data))
(interactive "p")
(gnus-summary-next-subject (- n) t))
+(defun gnus-summary-goto-subjects (articles)
+ "Insert the subject header for ARTICLES in the current buffer."
+ (save-excursion
+ (dolist (article articles)
+ (gnus-summary-goto-subject article t)))
+ (gnus-summary-limit (append articles gnus-newsgroup-limit))
+ (gnus-summary-position-point))
+
(defun gnus-summary-goto-subject (article &optional force silent)
"Go the subject line of ARTICLE.
If FORCE, also allow jumping to articles not currently shown."
(let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
(?\C-p (gnus-group-prev-unread-group 1))))
(cursor-in-echo-area t)
- keve key group ended)
+ keve key group ended prompt)
(save-excursion
(set-buffer gnus-group-buffer)
(goto-char start)
(gnus-summary-best-group gnus-newsgroup-name)
(gnus-summary-search-group backward gnus-keep-same-level))))
(while (not ended)
- (gnus-message
- 5 "No more%s articles%s" (if unread " unread" "")
- (if (and group
- (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
- (format " (Type %s for %s [%s])"
- (single-key-description cmd) group
- (car (gnus-gethash group gnus-newsrc-hashtb)))
- (format " (Type %s to exit %s)"
- (single-key-description cmd)
- gnus-newsgroup-name)))
+ (setq prompt
+ (format
+ "No more%s articles%s " (if unread " unread" "")
+ (if (and group
+ (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
+ (format " (Type %s for %s [%s])"
+ (single-key-description cmd) group
+ (car (gnus-gethash group gnus-newsrc-hashtb)))
+ (format " (Type %s to exit %s)"
+ (single-key-description cmd)
+ gnus-newsgroup-name))))
;; Confirm auto selection.
- (setq key (car (setq keve (gnus-read-event-char))))
- (setq ended t)
+ (setq key (car (setq keve (gnus-read-event-char prompt)))
+ ended t)
(cond
((assq key keystrokes)
(let ((obuf (current-buffer)))
(and gnus-auto-select-same
(gnus-summary-article-subject))))
-(defun gnus-summary-next-page (&optional lines circular)
+(defun gnus-summary-next-page (&optional lines circular stop)
"Show next page of the selected article.
If at the end of the current article, select the next article.
LINES says how many lines should be scrolled up.
If CIRCULAR is non-nil, go to the start of the article instead of
selecting the next article when reaching the end of the current
-article."
+article.
+
+If STOP is non-nil, just stop when reaching the end of the message."
(interactive "P")
(setq gnus-summary-buffer (current-buffer))
(gnus-set-global-variables)
(gnus-eval-in-buffer-window gnus-article-buffer
(setq endp (gnus-article-next-page lines)))
(when endp
- (cond (circular
+ (cond (stop
+ (gnus-message 3 "End of message"))
+ (circular
(gnus-summary-beginning-of-article))
(lines
(gnus-message 3 "End of message"))
days)
(while (not days-got)
(setq days (if younger
- (read-string "Limit to articles within (in days): ")
- (read-string "Limit to articles older than (in days): ")))
+ (read-string "Limit to articles younger than (in days, older when negative): ")
+ (read-string
+ "Limit to articles older than (in days, younger when negative): ")))
(when (> (length days) 0)
(setq days (read days)))
(if (numberp days)
(gnus-summary-limit articles)
(gnus-summary-position-point))))
+(defun gnus-summary-limit-to-unseen ()
+ "Limit to unseen articles."
+ (interactive)
+ (prog1
+ (gnus-summary-limit gnus-newsgroup-unseen)
+ (gnus-summary-position-point)))
+
(defun gnus-summary-limit-include-thread (id)
"Display all the hidden articles that is in the thread with ID in it.
When called interactively, ID is the Message-ID of the current
(gnus-summary-limit (nconc articles gnus-newsgroup-limit))
(gnus-summary-position-point))))
+(defun gnus-summary-insert-dormant-articles ()
+ "Insert all the dormat articles for this group into the current buffer."
+ (interactive)
+ (let ((gnus-verbose (max 6 gnus-verbose)))
+ (if (not gnus-newsgroup-dormant)
+ (gnus-message 3 "No cached articles for this group")
+ (gnus-summary-goto-subjects gnus-newsgroup-dormant))))
+
(defun gnus-summary-limit-include-dormant ()
"Display all the hidden articles that are marked as dormant.
Note that this command only works on a subset of the articles currently
;; will really go down to a leaf article first, before slowly
;; working its way up towards the root.
(when thread
- (let ((children
+ (let* ((max-lisp-eval-depth 5000)
+ (children
(if (cdr thread)
(apply '+ (mapcar 'gnus-summary-limit-children
(cdr thread)))
(gnus-message 3 "Couldn't fetch article %s" message-id)))))))
(defun gnus-refer-article-methods ()
- "Return a list of referrable methods."
+ "Return a list of referable methods."
(cond
;; No method, so we default to current and native.
((null gnus-refer-article-method)
;; We don't want to change current point nor window configuration.
(save-excursion
(save-window-excursion
- (gnus-message 6 "Executing %s..." (key-description command))
-;; We'd like to execute COMMAND interactively so as to give arguments.
- (gnus-execute header regexp
- `(call-interactively ',(key-binding command))
- backward)
- (gnus-message 6 "Executing %s...done" (key-description command)))))
+ (let (gnus-visual
+ gnus-treat-strip-trailing-blank-lines
+ gnus-treat-strip-leading-blank-lines
+ gnus-treat-strip-multiple-blank-lines
+ gnus-treat-hide-boring-headers
+ gnus-treat-fold-newsgroups
+ gnus-article-prepare-hook)
+ (gnus-message 6 "Executing %s..." (key-description command))
+ ;; We'd like to execute COMMAND interactively so as to give arguments.
+ (gnus-execute header regexp
+ `(call-interactively ',(key-binding command))
+ backward)
+ (gnus-message 6 "Executing %s...done" (key-description command))))))
(defun gnus-summary-beginning-of-article ()
"Scroll the article back to the beginning."
(interactive "P")
(let ((window (and (gnus-buffer-live-p gnus-article-buffer)
(get-buffer-window gnus-article-buffer t))))
- (when window
- (with-current-buffer gnus-article-buffer
+ (with-current-buffer gnus-article-buffer
+ (widen)
+ (article-narrow-to-head)
+ (let* ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (hidden (if (numberp arg)
+ (>= arg 0)
+ (gnus-article-hidden-text-p 'headers)))
+ s e)
+ (delete-region (point-min) (point-max))
+ (with-current-buffer gnus-original-article-buffer
+ (goto-char (setq s (point-min)))
+ (setq e (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max))))
+ (insert-buffer-substring gnus-original-article-buffer s e)
+ (article-decode-encoded-words)
+ (if hidden
+ (let ((gnus-treat-hide-headers nil)
+ (gnus-treat-hide-boring-headers nil))
+ (gnus-delete-wash-type 'headers)
+ (gnus-treat-article 'head))
+ (gnus-treat-article 'head))
(widen)
- (article-narrow-to-head)
- (let* ((buffer-read-only nil)
- (inhibit-point-motion-hooks t)
- (hidden (if (numberp arg)
- (>= arg 0)
- (gnus-article-hidden-text-p 'headers)))
- s e)
- (delete-region (point-min) (point-max))
- (with-current-buffer gnus-original-article-buffer
- (goto-char (setq s (point-min)))
- (setq e (if (search-forward "\n\n" nil t)
- (1- (point))
- (point-max))))
- (insert-buffer-substring gnus-original-article-buffer s e)
- (article-decode-encoded-words)
- (if hidden
- (let ((gnus-treat-hide-headers nil)
- (gnus-treat-hide-boring-headers nil))
- (gnus-delete-wash-type 'headers)
- (gnus-treat-article 'head))
- (gnus-treat-article 'head))
- (widen)
- (set-window-start window (goto-char (point-min)))
- (setq gnus-page-broken
- (when gnus-break-pages
- (gnus-narrow-to-page)
- t))
- (gnus-set-mode-line 'article))))))
+ (if window
+ (set-window-start window (goto-char (point-min))))
+ (setq gnus-page-broken
+ (when gnus-break-pages
+ (gnus-narrow-to-page)
+ t))
+ (gnus-set-mode-line 'article)))))
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
(message-caesar-buffer-body arg)
(set-window-start (get-buffer-window (current-buffer)) start))))))
+(autoload 'unmorse-region "morse"
+ "Convert morse coded text in region to ordinary ASCII text."
+ t)
+
+(defun gnus-summary-morse-message (&optional arg)
+ "Morse decode the current article."
+ (interactive "P")
+ (gnus-summary-select-article)
+ (let ((mail-header-separator ""))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((pos (window-start))
+ buffer-read-only)
+ (goto-char (point-min))
+ (when (message-goto-body)
+ (gnus-narrow-to-body))
+ (goto-char (point-min))
+ (while (re-search-forward "·" (point-max) t)
+ (replace-match "."))
+ (unmorse-region (point-min) (point-max))
+ (widen)
+ (set-window-start (get-buffer-window (current-buffer)) pos)))))))
+
(defun gnus-summary-stop-page-breaking ()
"Stop page breaking in the current article."
(interactive)
to-group (cdar marks) (list to-article) info)))
(setq marks (cdr marks)))
- (gnus-request-set-mark to-group (list (list (list to-article)
- 'add
- to-marks))))
+ (gnus-request-set-mark
+ to-group (list (list (list to-article) 'add to-marks))))
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
:type 'symbol
:group 'gnus-summary-mail)
+(defcustom gnus-summary-display-while-building nil
+ "If not-nil, show and update the summary buffer as it's being built.
+If the value is t, update the buffer after every line is inserted. If
+the value is an integer (N), update the display every N lines."
+ :group 'gnus-thread
+ :type '(choice (const :tag "off" nil)
+ number
+ (const :tag "frequently" t)))
+
(defun gnus-summary-respool-article (&optional n method)
"Respool the current article.
The article will be squeezed through the mail spooling process again,
(setq gnus-article-mime-handles nil))))))
(t
(setq force t)))
- (when (and raw (not force) (equal gnus-newsgroup-name "nndraft:drafts"))
- (error "Can't edit the raw article in group nndraft:drafts"))
+ (when (and raw (not force)
+ (member gnus-newsgroup-name '("nndraft:delayed"
+ "nndraft:drafts"
+ "nndraft:queue")))
+ (error "Can't edit the raw article in group %s"
+ gnus-newsgroup-name))
(save-excursion
(set-buffer gnus-summary-buffer)
(let ((mail-parse-charset gnus-newsgroup-charset)
(when (and (not raw) (gnus-buffer-live-p gnus-article-buffer))
(with-current-buffer gnus-article-buffer
(mm-enable-multibyte)))
- (if (equal gnus-newsgroup-name "nndraft:drafts")
+ (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts"))
(setq raw t))
(gnus-article-edit-article
(if raw 'ignore
(not (equal gnus-newsgroup-name (car gnus-article-current))))
(error "No current article selected"))
;; Remove old bookmark, if one exists.
- (let ((old (assq article gnus-newsgroup-bookmarks)))
- (when old
- (setq gnus-newsgroup-bookmarks
- (delq old gnus-newsgroup-bookmarks))))
+ (gnus-pull article gnus-newsgroup-bookmarks)
;; Set the new bookmark, which is on the form
;; (article-number . line-number-in-body).
(push
(count-lines
(min (point)
(save-excursion
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
+ (article-goto-body)
(point)))
(point))))
gnus-newsgroup-bookmarks)
"Remove the bookmark from the current article."
(interactive (list (gnus-summary-article-number)))
;; Remove old bookmark, if one exists.
- (let ((old (assq article gnus-newsgroup-bookmarks)))
- (if old
- (progn
- (setq gnus-newsgroup-bookmarks
- (delq old gnus-newsgroup-bookmarks))
- (gnus-message 6 "Removed bookmark."))
- (gnus-message 6 "No bookmark in current article."))))
+ (if (not (assq article gnus-newsgroup-bookmarks))
+ (gnus-message 6 "No bookmark in current article.")
+ (gnus-pull article gnus-newsgroup-bookmarks)
+ (gnus-message 6 "Removed bookmark.")))
;; Suggested by Daniel Quinlan <quinlan@best.com>.
(defun gnus-summary-mark-as-dormant (n)
If N is negative, mark backwards instead. Mark with MARK, ?r by default.
The difference between N and the actual number of articles marked is
returned.
-Iff NO-EXPIRE, auto-expiry will be inhibited."
+If NO-EXPIRE, auto-expiry will be inhibited."
(interactive "p")
(gnus-summary-show-thread)
(let ((backward (< n 0))
(gnus-error 1 "Can't mark negative article numbers")
nil)
(setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
- (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked))
+ (setq gnus-newsgroup-spam-marked
+ (delq article gnus-newsgroup-spam-marked))
(setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
(setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
(setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
If MARK is nil, then the default character `?r' is used.
If ARTICLE is nil, then the article on the current line will be
marked.
-Iff NO-EXPIRE, auto-expiry will be inhibited."
+If NO-EXPIRE, auto-expiry will be inhibited."
;; The mark might be a string.
(when (stringp mark)
(setq mark (aref mark 0)))
(gnus-run-hooks 'gnus-summary-update-hook))
t)
+(defun gnus-summary-update-download-mark (article)
+ "Update the secondary (read, process, cache) mark."
+ (gnus-summary-update-mark
+ (cond ((memq article gnus-newsgroup-undownloaded)
+ gnus-undownloaded-mark)
+ (gnus-newsgroup-agentized
+ gnus-downloaded-mark)
+ (t
+ gnus-no-mark))
+ 'download)
+ (gnus-summary-update-line t)
+ t)
+
(defun gnus-summary-update-mark (mark type)
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
(buffer-read-only nil))
(gnus-add-to-sorted-list gnus-newsgroup-marked article)))
((= mark gnus-spam-mark)
(setq gnus-newsgroup-spam-marked
- (gnus-add-to-sorted-list gnus-newsgroup-spam-marked article)))
+ (gnus-add-to-sorted-list gnus-newsgroup-spam-marked
+ article)))
((= mark gnus-dormant-mark)
(setq gnus-newsgroup-dormant
(gnus-add-to-sorted-list gnus-newsgroup-dormant article)))
(gnus-summary-position-point))
(defun gnus-summary-catchup-all (&optional quietly)
- "Mark all articles in this newsgroup as read."
+ "Mark all articles in this newsgroup as read.
+This command is dangerous. Normally, you want \\[gnus-summary-catchup]
+instead, which marks only unread articles as read."
(interactive "P")
(gnus-summary-catchup t quietly))
(gnus-summary-exit))))
(defun gnus-summary-catchup-all-and-exit (&optional quietly)
- "Mark all articles in this newsgroup as read, and then exit."
+ "Mark all articles in this newsgroup as read, and then exit.
+This command is dangerous. Normally, you want \\[gnus-summary-catchup-and-exit]
+instead, which marks only unread articles as read."
(interactive "P")
(gnus-summary-catchup-and-exit t quietly))
(gnus-set-mode-line 'summary)
n))
-(defun gnus-summary-pipe-output (&optional arg)
+(defun gnus-summary-pipe-output (&optional arg headers)
"Pipe the current article to a subprocess.
If N is a positive number, pipe the N next articles.
If N is a negative number, pipe the N previous articles.
If N is nil and any articles have been marked with the process mark,
-pipe those articles instead."
- (interactive "P")
+pipe those articles instead.
+If HEADERS (the symbolic prefix), include the headers, too."
+ (interactive (gnus-interactive "P\ny"))
(require 'gnus-art)
- (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
+ (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)
+ (gnus-save-all-headers (or headers gnus-save-all-headers)))
(gnus-summary-save-article arg t))
(let ((buffer (get-buffer "*Shell Command Output*")))
- (if (and buffer
- (with-current-buffer buffer (> (point-max) (point-min))))
- (gnus-configure-windows 'pipe))))
+ (when (and buffer
+ (not (zerop (buffer-size buffer))))
+ (gnus-configure-windows 'pipe))))
(defun gnus-summary-save-article-mail (&optional arg)
"Append the current article to an mail file.
(setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
'face gnus-summary-selected-face))))))
-;; New implementation by Christian Limpach <Christian.Limpach@nice.ch>.
+(defvar gnus-summary-highlight-line-cached nil)
+(defvar gnus-summary-highlight-line-trigger nil)
+
+(defun gnus-summary-highlight-line-0 ()
+ (if (and (eq gnus-summary-highlight-line-trigger
+ gnus-summary-highlight)
+ gnus-summary-highlight-line-cached)
+ gnus-summary-highlight-line-cached
+ (setq gnus-summary-highlight-line-trigger gnus-summary-highlight
+ gnus-summary-highlight-line-cached
+ (let* ((cond (list 'cond))
+ (c cond)
+ (list gnus-summary-highlight))
+ (while list
+ (setcdr c (cons (list (caar list) (list 'quote (cdar list))) nil))
+ (setq c (cdr c)
+ list (cdr list)))
+ (gnus-byte-compile (list 'lambda nil cond))))))
+
(defun gnus-summary-highlight-line ()
"Highlight current line according to `gnus-summary-highlight'."
- (let* ((list gnus-summary-highlight)
- (beg (gnus-point-at-bol))
- (article (gnus-summary-article-number))
- (score (or (cdr (assq (or article gnus-current-article)
+ (let* ((beg (gnus-point-at-bol))
+ (article (or (gnus-summary-article-number) gnus-current-article))
+ (score (or (cdr (assq article
gnus-newsgroup-scored))
gnus-summary-default-score 0))
(mark (or (gnus-summary-article-mark) gnus-unread-mark))
(inhibit-read-only t)
(default gnus-summary-default-score)
(default-high gnus-summary-default-high-score)
- (default-low gnus-summary-default-low-score))
- ;; 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)))
+ (default-low gnus-summary-default-low-score)
+ (uncached (memq article gnus-newsgroup-undownloaded))
+ (downloaded (not uncached)))
+ (let ((face (funcall (gnus-summary-highlight-line-0))))
(unless (eq face (get-text-property beg 'face))
(gnus-put-text-property-excluding-characters-with-faces
beg (gnus-point-at-eol) 'face
(defun gnus-summary-setup-default-charset ()
"Setup newsgroup default charset."
- (if (equal gnus-newsgroup-name "nndraft:drafts")
+ (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts"))
(setq gnus-newsgroup-charset nil)
(let* ((ignored-charsets
(or gnus-newsgroup-ephemeral-ignored-charsets
(let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
older len)
(setq older
- (gnus-sorted-difference
- (gnus-uncompress-range (list gnus-newsgroup-active))
- old))
- (setq len (length older))
+ ;; Some nntp servers lie about their active range. When
+ ;; this happens, the active range can be in the millions.
+ ;; Use a compressed range to avoid creating a huge list.
+ (gnus-range-difference (list gnus-newsgroup-active) old))
+ (setq len (gnus-range-length older))
(cond
((null older) nil)
((numberp all)
(if (< all len)
- (setq older (last older all))))
- (all nil)
+ (let ((older-range (nreverse older)))
+ (setq older nil)
+
+ (while (> all 0)
+ (let* ((r (pop older-range))
+ (min (if (numberp r) r (car r)))
+ (max (if (numberp r) r (cdr r))))
+ (while (and (<= min max)
+ (> all 0))
+ (push max older)
+ (setq all (1- all)
+ max (1- max))))))
+ (setq older (gnus-uncompress-range older))))
+ (all
+ (setq older (gnus-uncompress-range older)))
(t
- (if (and (numberp gnus-large-newsgroup)
+ (when (and (numberp gnus-large-newsgroup)
(> len gnus-large-newsgroup))
(let* ((cursor-in-echo-area nil)
(initial (gnus-parameter-large-newsgroup-initial
(unless (string-match "^[ \t]*$" input)
(setq all (string-to-number input))
(if (< all len)
- (setq older (last older all))))))))
+ (let ((older-range (nreverse older)))
+ (setq older nil)
+
+ (while (> all 0)
+ (let* ((r (pop older-range))
+ (min (if (numberp r) r (car r)))
+ (max (if (numberp r) r (cdr r))))
+ (while (and (<= min max)
+ (> all 0))
+ (push max older)
+ (setq all (1- all)
+ max (1- max))))))))))
+ (setq older (gnus-uncompress-range older))))
(if (not older)
(message "No old news.")
(gnus-summary-insert-articles older)
%A Number of unread articles in the groups in the topic and its subtopics.
General format specifiers can also be used.
-See (gnus)Formatting Variables."
+See Info node `(gnus)Formatting Variables'."
:link '(custom-manual "(gnus)Formatting Variables")
:type 'string
:group 'gnus-topic)
(unfound t)
entry)
;; Try to jump to a visible group.
- (while (and g (not (gnus-group-goto-group (car g) t)))
+ (while (and g
+ (not (gnus-group-goto-group (car g) t)))
(pop g))
;; It wasn't visible, so we try to see where to insert it.
(when (not g)
(when (and unfound
topic
(not (gnus-topic-goto-missing-topic topic)))
- (let* ((top (gnus-topic-find-topology topic))
- (children (cddr top))
- (type (cadr top))
- (unread 0)
- (entries (gnus-topic-find-groups
- (car type) (car gnus-group-list-mode)
- (cdr gnus-group-list-mode))))
- (while children
- (incf unread (gnus-topic-unread (caar (pop children)))))
- (while (setq entry (pop entries))
- (when (numberp (car entry))
- (incf unread (car entry))))
- (gnus-topic-insert-topic-line
- topic t t (car (gnus-topic-find-topology topic)) nil unread))))))
+ (gnus-topic-display-missing-topic topic)))))
+
+(defun gnus-topic-display-missing-topic (topic)
+ "Insert topic lines recursively for missing topics."
+ (let ((parent (gnus-topic-find-topology
+ (gnus-topic-parent-topic topic))))
+ (when (and parent
+ (not (gnus-topic-goto-missing-topic (caadr parent))))
+ (gnus-topic-display-missing-topic (caadr parent))))
+ (gnus-topic-goto-missing-topic topic)
+ (let* ((top (gnus-topic-find-topology topic))
+ (children (cddr top))
+ (type (cadr top))
+ (unread 0)
+ (entries (gnus-topic-find-groups
+ (car type) (car gnus-group-list-mode)
+ (cdr gnus-group-list-mode)))
+ entry)
+ (while children
+ (incf unread (gnus-topic-unread (caar (pop children)))))
+ (while (setq entry (pop entries))
+ (when (numberp (car entry))
+ (incf unread (car entry))))
+ (gnus-topic-insert-topic-line
+ topic t t (car (gnus-topic-find-topology topic)) nil unread)))
(defun gnus-topic-goto-missing-topic (topic)
(if (gnus-topic-goto-topic topic)
'("Topics"
["Toggle topics" gnus-topic-mode t]
("Groups"
- ["Copy" gnus-topic-copy-group t]
- ["Move" gnus-topic-move-group t]
+ ["Copy..." gnus-topic-copy-group t]
+ ["Move..." gnus-topic-move-group t]
["Remove" gnus-topic-remove-group t]
- ["Copy matching" gnus-topic-copy-matching t]
+ ["Copy matching..." gnus-topic-copy-matching t]
["Move matching" gnus-topic-move-matching t])
("Topics"
- ["Goto" gnus-topic-jump-to-topic t]
+ ["Goto..." gnus-topic-jump-to-topic t]
["Show" gnus-topic-show-topic t]
["Hide" gnus-topic-hide-topic t]
["Delete" gnus-topic-delete t]
- ["Rename" gnus-topic-rename t]
- ["Create" gnus-topic-create-topic t]
+ ["Rename..." gnus-topic-rename t]
+ ["Create..." gnus-topic-create-topic t]
["Mark" gnus-topic-mark-topic t]
["Indent" gnus-topic-indent t]
["Sort" gnus-topic-sort-topics t]
top)
(defun gnus-topic-sort-topics (&optional topic reverse)
- "Sort topics in TOPIC alphabeticaly by topic name.
+ "Sort topics in TOPIC alphabetically by topic name.
If REVERSE, reverse the sorting order."
(interactive
(list (completing-read "Sort topics in : " gnus-topic-alist nil t
((gnus-seconds-year) . "%b %d")
(t . "%b %d '%y")) ;;this one is used when no
;;other does match
- "Alist of time in seconds and format specification used to display dates not older.
-The first element must be a number or a function returning a
-number. The second element is a format-specification as described in
-the documentation for format-time-string. The list must be ordered
-smallest number up. When there is an element, which is not a number,
-the corresponding format-specification will be used, disregarding any
-following elements. You can use the functions gnus-seconds-today,
-gnus-seconds-month, gnus-seconds-year which will return the number of
-seconds which passed today/this month/this year.")
+ "Specifies date format depending on age of article.
+This is an alist of items (AGE . FORMAT). AGE can be a number (of
+seconds) or a Lisp expression evaluating to a number. When the age of
+the article is less than this number, then use `format-time-string'
+with the corresponding FORMAT for displaying the date of the article.
+If AGE is not a number or a Lisp expression evaluating to a
+non-number, then the corresponding FORMAT is used as a default value.
+
+Note that the list is processed from the beginning, so it should be
+sorted by ascending AGE. Also note that items following the first
+non-number AGE will be ignored.
+
+You can use the functions `gnus-seconds-today', `gnus-seconds-month'
+and `gnus-seconds-year' in the AGE spec. They return the number of
+seconds passed since the start of today, of this month, of this year,
+respectively.")
(defun gnus-user-date (messy-date)
"Format the messy-date acording to gnus-user-date-format-alist.
(set-window-hscroll (gnus-get-buffer-window (current-buffer) t) 0))
max))))
-(defun gnus-read-event-char ()
+(defun gnus-read-event-char (&optional prompt)
"Get the next event."
- (let ((event (read-event)))
+ (let ((event (read-event prompt)))
;; should be gnus-characterp, but this can't be called in XEmacs anyway
(cons (and (numberp event) event) event)))
It is safe to use gnus-atomic-progn-assign with long computations.
Note that if any of the symbols in PROTECT were unbound, they will be
-set to nil on a sucessful assignment. In case of an error or other
+set to nil on a successful assignment. In case of an error or other
non-local exit, it will still be unbound."
(let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol
(concat (symbol-name x)
(kill-buffer buf))
tchar))
+(defun gnus-select-frame-set-input-focus (frame)
+ "Select FRAME, raise it, and set input focus, if possible."
+ (cond ((featurep 'xemacs)
+ (raise-frame frame)
+ (select-frame frame)
+ (focus-frame frame))
+ ;; The function `select-frame-set-input-focus' won't set
+ ;; the input focus under Emacs 21.2 and X window system.
+ ;;((fboundp 'select-frame-set-input-focus)
+ ;; (defalias 'gnus-select-frame-set-input-focus
+ ;; 'select-frame-set-input-focus)
+ ;; (select-frame-set-input-focus frame))
+ (t
+ (raise-frame frame)
+ (select-frame frame)
+ (cond ((and (eq window-system 'x)
+ (fboundp 'x-focus-frame))
+ (x-focus-frame frame))
+ ((eq window-system 'w32)
+ (w32-focus-frame frame)))
+ (when focus-follows-mouse
+ (set-mouse-position frame (1- (frame-width frame)) 0)))))
+
+(defun gnus-frame-or-window-display-name (object)
+ "Given a frame or window, return the associated display name.
+Return nil otherwise."
+ (if (featurep 'xemacs)
+ (device-connection (dfw-device object))
+ (if (or (framep object)
+ (and (windowp object)
+ (setq object (window-frame object))))
+ (let ((display (frame-parameter object 'display)))
+ (if (and (stringp display)
+ ;; Exclude invalid display names.
+ (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'"
+ display))
+ display)))))
+
(provide 'gnus-util)
;;; gnus-util.el ends here
"^MIME-Version:" "^Content-Disposition:" "^Content-Description:"
"^Content-ID:")
"*List of regexps to match headers included in digested messages.
-The headers will be included in the sequence they are matched."
+The headers will be included in the sequence they are matched. If nil
+include all headers."
:group 'gnus-extract
:type '(repeat regexp))
;;; gnus-win.el --- window configuration functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(unless window
(setq window current-window))
(select-window window)
- ;; This might be an old-stylee buffer config.
+ ;; This might be an old-style buffer config.
(when (vectorp split)
(setq split (append split nil)))
(when (or (consp (car split))
(gnus-xmas-menu-add grouplens
gnus-grouplens-menu))
-(defun gnus-xmas-read-event-char ()
+(defun gnus-xmas-read-event-char (&optional prompt)
"Get the next event."
+ (when prompt
+ (message "%s" prompt))
(let ((event (next-command-event)))
(sit-for 0)
;; We junk all non-key events. Is this naughty?
(eval-when-compile (require 'cl))
(require 'wid-edit)
(require 'mm-util)
+(require 'nnheader)
+
+;; Make sure it was the right mm-util.
+(unless (fboundp 'mm-guess-mime-charset)
+ (error "Wrong `mm-util' found in `load-path'. Make sure the Gnus one is found first."))
(defgroup gnus nil
"The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
;; Other
(defgroup gnus-visual nil
- "Options controling the visual fluff."
+ "Options controlling the visual fluff."
:group 'gnus
:group 'faces)
:group 'gnus)
(defgroup gnus-meta nil
- "Meta variables controling major portions of Gnus.
+ "Meta variables controlling major portions of Gnus.
In general, modifying these variables does not take affect until Gnus
is restarted, and sometimes reloaded."
:group 'gnus)
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.07"
+(defconst gnus-version-number "0.08"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Oort Gnus v%s" gnus-version-number)
()))
"Face used for normal interest ancient articles.")
+(defface gnus-summary-high-uncached-face
+ '((((class color)
+ (background light))
+ (:bold t :foreground "cyan4" :bold nil))
+ (((class color) (background dark))
+ (:bold t :foreground "LightGray" :bold nil))
+ (t (:inverse-video t :bold t)))
+ "Face used for high interest uncached articles.")
+
+(defface gnus-summary-low-uncached-face
+ '((((class color)
+ (background light))
+ (:italic t :foreground "cyan4" :bold nil))
+ (((class color) (background dark))
+ (:italic t :foreground "LightGray" :bold nil))
+ (t (:inverse-video t :italic t)))
+ "Face used for low interest uncached articles.")
+
+(defface gnus-summary-normal-uncached-face
+ '((((class color)
+ (background light))
+ (:foreground "cyan4" :bold nil))
+ (((class color) (background dark))
+ (:foreground "LightGray" :bold nil))
+ (t (:inverse-video t)))
+ "Face used for normal interest uncached articles.")
+
(defface gnus-summary-high-unread-face
'((t
(:bold t)))
((and
(fboundp 'find-image)
(display-graphic-p)
- (let ((image (find-image
- `((:type xpm :file "gnus.xpm"
- :color-symbols
- (("thing" . ,(car gnus-logo-colors))
- ("shadow" . ,(cadr gnus-logo-colors))
- ("background" . ,(face-background 'default))))
- (:type pbm :file "gnus.pbm"
- ;; Account for the pbm's blackground.
- :background ,(face-foreground 'gnus-splash-face)
- :foreground ,(face-background 'default))
- (:type xbm :file "gnus.xbm"
- ;; Account for the xbm's blackground.
- :background ,(face-foreground 'gnus-splash-face)
- :foreground ,(face-background 'default))))))
+ (let* ((data-directory (nnheader-find-etc-directory "gnus"))
+ (image (find-image
+ `((:type xpm :file "gnus.xpm"
+ :color-symbols
+ (("thing" . ,(car gnus-logo-colors))
+ ("shadow" . ,(cadr gnus-logo-colors))
+ ("oort" . "#eeeeee")
+ ("background" . ,(face-background 'default))))
+ (:type pbm :file "gnus.pbm"
+ ;; Account for the pbm's blackground.
+ :background ,(face-foreground 'gnus-splash-face)
+ :foreground ,(face-background 'default))
+ (:type xbm :file "gnus.xbm"
+ ;; Account for the xbm's blackground.
+ :background ,(face-foreground 'gnus-splash-face)
+ :foreground ,(face-background 'default))))))
(when image
(let ((size (image-size image)))
(insert-char ?\n (max 0 (round (- (window-height)
:type '(choice directory
(repeat directory)))
+(defcustom gnus-group-charter-alist
+ '(("no" . (concat "http://no.news-admin.org/charter/" name ".txt"))
+ ("de" . (concat "http://purl.net/charta/" name ".html"))
+ ("dk" . (concat "http://www.usenet.dk/grupper.pl?get=" name))
+ ("england" . (concat "http://england.news-admin.org/charters/" name))
+ ("fr" . (concat "http://www.usenet-fr.net/fur/chartes/" name ".html"))
+ ("europa" . (concat "http://www.europa.usenet.eu.org/chartas/charta-en-"
+ (gnus-replace-in-string name "europa\\." "") ".html"))
+ ("nl" . (concat "http://www.xs4all.nl/~sister/usenet/charters/" name))
+ ("aus" . (concat "http://aus.news-admin.org/groupinfo.php/" name))
+ ("pl" . (concat "http://www.usenet.pl/opisy/" name))
+ ("ch" . (concat "http://www.use-net.ch/Usenet/charter.html#" name))
+ ("at" . (concat "http://www.usenet.at/chartas/" name "/charta"))
+ ("uk" . (concat "http://www.usenet.org.uk/" name ".html"))
+ ("wales" . (concat "http://www.wales-usenet.org/english/groups/" name ".html"))
+ ("dfw" . (concat "http://www.cirr.com/dfw/charters/" name ".html"))
+ ("se" . (concat "http://www.usenet-se.net/Reglementen/"
+ (gnus-replace-in-string name "\\." "_") ".html"))
+ ("milw" . (concat "http://usenet.mil.wi.us/"
+ (gnus-replace-in-string name "milw\\." "") "-charter"))
+ ("ca" . (concat "http://www.sbay.org/ca/charter-" name ".html"))
+ ("netins" . (concat "http://www.netins.net/usenet/charter/"
+ (gnus-replace-in-string name "\\." "-") "-charter.html")))
+ "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter.
+ When FORM is evaluated `name' is bound to the name of the group."
+ :group 'gnus-group-various
+ :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form"))))
+
+(defcustom gnus-group-fetch-control-use-browse-url nil
+ "*Non-nil means that control messages are displayed using `browse-url'.
+Otherwise they are fetched with ange-ftp and displayed in an ephemeral
+group."
+ :group 'gnus-group-various
+ :type 'boolean)
+
(defcustom gnus-use-cross-reference t
"*Non-nil means that cross referenced articles will be marked as read.
If nil, ignore cross references. If t, mark articles as read in
:group 'gnus-meta
:type 'boolean)
-(defcustom gnus-keep-backlog nil
+(defcustom gnus-keep-backlog 20
"*If non-nil, Gnus will keep read articles for later re-retrieval.
If it is a number N, then Gnus will only keep the last N articles
read. If it is neither nil nor a number, Gnus will keep all read
`gnus-large-newsgroup'). If it is `nil', the default value is the
total number of articles in the group.")
+;; group parameters for spam processing added by Ted Zlatanov <tzz@lifelogs.com>
+(defvar gnus-group-spam-classification-spam t
+ "Spam group classification (requires spam.el).
+This group contains spam messages. On summary entry, unread messages
+will be marked as spam. On summary exit, the specified spam
+processors will be invoked on spam-marked messages, then those
+messages will be expired, so the spam processor will only see a
+spam-marked message once.")
+
+(defvar gnus-group-spam-classification-ham 'ask
+ "The ham value for the spam group parameter (requires spam.el).
+On summary exit, the specified ham processors will be invoked on
+ham-marked messages. Exercise caution, since the ham processor will
+see the same message more than once because there is no ham message
+registry.")
+
+(gnus-define-group-parameter
+ spam-contents
+ :type list
+ :function-document
+ "The spam type (spam, ham, or neither) of the group."
+ :variable gnus-spam-newsgroup-contents
+ :variable-default nil
+ :variable-document
+ "*Groups in which to automatically mark new articles as spam on
+summary entry. If non-nil, this should be a list of group name
+regexps that should match all groups in which to do automatic spam
+tagging, associated with a classification (spam, ham, or neither).
+This only makes sense for mail groups."
+ :variable-group spam
+ :variable-type '(repeat
+ (list :tag "Group contents spam/ham classification"
+ (regexp :tag "Group")
+ (choice
+ (variable-item gnus-group-spam-classification-spam)
+ (variable-item gnus-group-spam-classification-ham)
+ (other :tag "Unclassified" nil))))
+
+ :parameter-type '(list :tag "Group contents spam/ham classification"
+ (choice :tag "Group contents classification for spam sorting"
+ (variable-item gnus-group-spam-classification-spam)
+ (variable-item gnus-group-spam-classification-ham)
+ (other :tag "Unclassified" nil)))
+ :parameter-document
+ "The spam classification (spam, ham, or neither) of this group.
+When a spam group is entered, all unread articles are marked as spam.")
+
+(defvar gnus-group-spam-exit-processor-ifile "ifile"
+ "The ifile summary exit spam processor.
+Only applicable to spam groups.")
+
+(defvar gnus-group-spam-exit-processor-bogofilter "bogofilter"
+ "The Bogofilter summary exit spam processor.
+Only applicable to spam groups.")
+
+(defvar gnus-group-spam-exit-processor-blacklist "blacklist"
+ "The Blacklist summary exit spam processor.
+Only applicable to spam groups.")
+
+(defvar gnus-group-ham-exit-processor-whitelist "whitelist"
+ "The whitelist summary exit ham processor.
+Only applicable to non-spam (unclassified and ham) groups.")
+
+(defvar gnus-group-ham-exit-processor-BBDB "bbdb"
+ "The BBDB summary exit ham processor.
+Only applicable to non-spam (unclassified and ham) groups.")
+
+(gnus-define-group-parameter
+ spam-process
+ :type list
+ :parameter-type '(choice :tag "Spam Summary Exit Processor"
+ :value nil
+ (list :tag "Spam Summary Exit Processor Choices"
+ (set
+ (variable-item gnus-group-spam-exit-processor-ifile)
+ (variable-item gnus-group-spam-exit-processor-bogofilter)
+ (variable-item gnus-group-spam-exit-processor-blacklist)
+ (variable-item gnus-group-ham-exit-processor-whitelist)
+ (variable-item gnus-group-ham-exit-processor-BBDB))))
+ :function-document
+ "Which spam or ham processors will be applied to the GROUP articles at summary exit."
+ :variable gnus-spam-process-newsgroups
+ :variable-default nil
+ :variable-document
+ "*Groups in which to automatically process spam or ham articles with
+a backend on summary exit. If non-nil, this should be a list of group
+name regexps that should match all groups in which to do automatic
+spam processing, associated with the appropriate processor. This only makes sense
+for mail groups."
+ :variable-group spam
+ :variable-type '(repeat :tag "Spam/Ham Processors"
+ (list :tag "Spam Summary Exit Processor Choices"
+ (regexp :tag "Group Regexp")
+ (set :tag "Spam/Ham Summary Exit Processor"
+ (variable-item gnus-group-spam-exit-processor-ifile)
+ (variable-item gnus-group-spam-exit-processor-bogofilter)
+ (variable-item gnus-group-spam-exit-processor-blacklist)
+ (variable-item gnus-group-ham-exit-processor-whitelist)
+ (variable-item gnus-group-ham-exit-processor-BBDB))))
+ :parameter-document
+ "Which spam processors will be applied to the spam or ham GROUP articles at summary exit.")
+
+(gnus-define-group-parameter
+ spam-process-destination
+ :parameter-type '(choice :tag "Destination for spam-processed articles at summary exit"
+ (string :tag "Move to a group")
+ (other :tag "Expire" nil))
+ :function-document
+ "Where spam-processed articles will go at summary exit."
+ :variable gnus-spam-process-destinations
+ :variable-default nil
+ :variable-document
+ "*Groups in which to explicitly send spam-processed articles to
+another group, or expire them (the default). If non-nil, this should
+be a list of group name regexps that should match all groups in which
+to do spam-processed article moving, associated with the destination
+group or `nil' for explicit expiration. This only makes sense for
+mail groups."
+ :variable-group spam
+ :variable-type '(repeat :tag "Spam-processed articles destination"
+ (list
+ (regexp :tag "Group Regexp")
+ (choice :tag "Destination for spam-processed articles at summary exit"
+ (string :tag "Move to a group")
+ (other :tag "Expire" nil))))
+ :parameter-document
+ "Where spam-processed articles will go at summary exit.")
+
(defcustom gnus-group-uncollapsed-levels 1
"Number of group name elements to leave alone when making a short group name."
:group 'gnus-group-visual
:group 'gnus-agent
:type 'boolean)
+(defcustom gnus-other-frame-function 'gnus
+ "Function called by the command `gnus-other-frame'."
+ :group 'gnus-start
+ :type '(choice (function-item gnus)
+ (function-item gnus-no-server)
+ (function-item gnus-slave)
+ (function-item gnus-slave-no-server)))
+
+(defcustom gnus-other-frame-parameters nil
+ "Frame parameters used by `gnus-other-frame' to create a Gnus frame.
+This should be an alist for FSF Emacs, or a plist for XEmacs."
+ :group 'gnus-start
+ :type (if (featurep 'xemacs)
+ '(repeat (list :inline t :format "%v"
+ (symbol :tag "Property")
+ (sexp :tag "Value")))
+ '(repeat (cons :format "%v"
+ (symbol :tag "Parameter")
+ (sexp :tag "Value")))))
+
\f
;;; Internal variables
gnus-newsrc-alist gnus-server-alist
gnus-killed-list gnus-zombie-list
gnus-topic-topology gnus-topic-alist
- gnus-format-specs)
+ gnus-agent-covered-methods gnus-format-specs)
"Gnus variables saved in the quick startup file.")
(defvar gnus-newsrc-alist nil
(defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$"
"Regexp matching invalid groups.")
+(defvar gnus-other-frame-object nil
+ "A frame object which will be created by `gnus-other-frame'.")
+
;;; End of variables.
;; Define some autoload functions Gnus might use.
("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-queue)
("gnus-mlspl" gnus-group-split gnus-group-split-fancy)
("gnus-mlspl" :interactive t gnus-group-split-setup
- gnus-group-split-update))))
+ gnus-group-split-update)
+ ("gnus-delay" gnus-delay-initialize))))
;;; gnus-sum.el thingies
%M Message-id of the article (string)
%r References of the article (string)
%c Number of characters in the article (integer)
+%k Pretty-printed version of the above (string)
+ For example, \"1.2k\" or \"0.4M\".
%L Number of lines in the article (integer)
%I Indentation based on thread level (a string of spaces)
%B A complex trn-style thread tree (string)
%V Total thread score (number).
%P The line number (number).
%O Download mark (character).
+%C If present, indicates desired cursor position
+ (instead of after first colon).
%u User defined specifier. The next character in the format string should
be a letter. Gnus will call the function gnus-user-format-function-X,
where X is the letter following %u. The function will be passed the
This restriction may disappear in later versions of Gnus.
General format specifiers can also be used.
-See `(gnus)Formatting Variables'."
+See Info node `(gnus)Formatting Variables'."
:link '(custom-manual "(gnus)Formatting Variables")
:type 'string
:group 'gnus-summary-format)
(defmacro gnus-get-info (group)
`(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
-;;; Load the compatability functions.
+;;; Load the compatibility functions.
(require 'gnus-ems)
You should call this in the `gnus-group-buffer' buffer.
The function `gnus-group-find-parameter' will do that for you."
;; The speed trick: No cons'ing and quit early.
- (or (let ((params (funcall gnus-group-get-parameter-function group)))
- ;; Start easy, check the "real" group parameters.
- (gnus-group-parameter-value params symbol allow-list))
+ (let* ((params (funcall gnus-group-get-parameter-function group))
+ ;; Start easy, check the "real" group parameters.
+ (simple-results
+ (gnus-group-parameter-value params symbol allow-list t)))
+ (if simple-results
+ ;; Found results; return them.
+ (car simple-results)
;; We didn't found it there, try `gnus-parameters'.
(let ((result nil)
(head nil)
;; Exit the loop early.
(setq tail nil))))
;; Done.
- result)))
+ result))))
(defun gnus-group-find-parameter (group &optional symbol allow-list)
"Return the group parameters for GROUP.
(gnus-group-parameter-value params symbol allow-list)
params)))
-(defun gnus-group-parameter-value (params symbol &optional allow-list)
+(defun gnus-group-parameter-value (params symbol &optional
+ allow-list present-p)
"Return the value of SYMBOL in group PARAMS."
;; We only wish to return group parameters (dotted lists) and
;; not local variables, which may have the same names.
(eq (car elem) symbol)
(or allow-list
(atom (cdr elem))))
- (throw 'found (cdr elem))))))))
+ (throw 'found (if present-p (list (cdr elem))
+ (cdr elem)))))))))
(defun gnus-group-add-parameter (group param)
"Add parameter PARAM to GROUP."
(gnus arg nil 'slave))
;;;###autoload
-(defun gnus-other-frame (&optional arg)
- "Pop up a frame to read news."
+(defun gnus-other-frame (&optional arg display)
+ "Pop up a frame to read news.
+This will call one of the Gnus commands which is specified by the user
+option `gnus-other-frame-function' (default `gnus') with the argument
+ARG if Gnus is not running, otherwise just pop up a Gnus frame. The
+optional second argument DISPLAY should be a standard display string
+such as \"unix:0\" to specify where to pop up a frame. If DISPLAY is
+omitted or the function `make-frame-on-display' is not available, the
+current display is used."
(interactive "P")
- (let ((window (get-buffer-window gnus-group-buffer)))
- (cond (window
- (select-frame (window-frame window)))
- (t
- (select-frame (make-frame)))))
- (gnus arg))
+ (if (fboundp 'make-frame-on-display)
+ (unless display
+ (setq display (gnus-frame-or-window-display-name (selected-frame))))
+ (setq display nil))
+ (let ((alive (gnus-alive-p)))
+ (unless (and alive
+ (catch 'found
+ (walk-windows
+ (lambda (window)
+ (when (and (or (not display)
+ (equal display
+ (gnus-frame-or-window-display-name
+ window)))
+ (with-current-buffer (window-buffer window)
+ (string-match "\\`gnus-"
+ (symbol-name major-mode))))
+ (gnus-select-frame-set-input-focus
+ (setq gnus-other-frame-object (window-frame window)))
+ (select-window window)
+ (throw 'found t)))
+ 'ignore t)))
+ (gnus-select-frame-set-input-focus
+ (setq gnus-other-frame-object
+ (if display
+ (make-frame-on-display display gnus-other-frame-parameters)
+ (make-frame gnus-other-frame-parameters))))
+ (if alive
+ (switch-to-buffer gnus-group-buffer)
+ (funcall gnus-other-frame-function arg)
+ (add-hook 'gnus-exit-gnus-hook
+ (lambda nil
+ (when (and (frame-live-p gnus-other-frame-object)
+ (cdr (frame-list)))
+ (delete-frame gnus-other-frame-object))
+ (setq gnus-other-frame-object nil)))))))
;;(setq thing ? ; this is a comment
;; more 'yes)
(defvar ietf-drums-no-ws-ctl-token "\001-\010\013\014\016-\037\177"
"US-ASCII control characters excluding CR, LF and white space.")
(defvar ietf-drums-text-token "\001-\011\013\014\016-\177"
- "US-ASCII characters exlcuding CR and LF.")
+ "US-ASCII characters excluding CR and LF.")
(defvar ietf-drums-specials-token "()<>[]:;@\\,.\""
"Special characters.")
(defvar ietf-drums-quote-token "\\"
"Textual token including full stop.")
(defvar ietf-drums-qtext-token
(concat ietf-drums-no-ws-ctl-token "\041\043-\133\135-\177")
- "Non-white-space control characaters, plus the rest of ASCII excluding backslash and doublequote.")
+ "Non-white-space control characters, plus the rest of ASCII excluding
+backslash and doublequote.")
(defvar ietf-drums-tspecials "][()<>@,;:\\\"/?="
"Tspecials.")
(defvar imap-continuation nil
"Non-nil indicates that the server emitted a continuation request.
-The actually value is really the text on the continuation line.")
+The actual value is really the text on the continuation line.")
(defvar imap-callbacks nil
"List of response tags and callbacks, on the form `(number . function)'.
nil)
(defun imap-shell-open (name buffer server port)
- (let ((cmds imap-shell-program)
+ (let ((cmds (if (listp imap-shell-program) imap-shell-program
+ (list imap-shell-program)))
cmd done)
(while (and (not done) (setq cmd (pop cmds)))
(message "imap: Opening IMAP connection with `%s'..." cmd)
(when process
(while (and (memq (process-status process) '(open run))
(set-buffer buffer) ;; XXX "blue moon" nntp.el bug
- (goto-char (point-min))
+ (goto-char (point-max))
+ (forward-line -1)
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
(defun imap-interactive-login (buffer loginfunc)
"Login to server in BUFFER.
LOGINFUNC is passed a username and a password, it should return t if
-it where sucessful authenticating itself to the server, nil otherwise.
+it where successful authenticating itself to the server, nil otherwise.
Returns t if login was successful, nil otherwise."
(with-current-buffer buffer
(make-local-variable 'imap-username)
available authenticators. If nil, it choices the best stream the
server is capable of.
BUFFER can be a buffer or a name of a buffer, which is created if
-necessery. If nil, the buffer name is generated."
+necessary. If nil, the buffer name is generated."
(setq buffer (or buffer (format " *imap* %s:%d" server (or port 0))))
(with-current-buffer (get-buffer-create buffer)
(if (imap-opened buffer)
((search-forward "UIDNEXT \\([0-9]+\\)" nil t)
(imap-mailbox-put 'uidnext (match-string 1)))
((search-forward "UNSEEN " nil t)
- (imap-mailbox-put 'unseen (read (current-buffer))))
+ (imap-mailbox-put 'first-unseen (read (current-buffer))))
((looking-at "UIDVALIDITY \\([0-9]+\\)")
(imap-mailbox-put 'uidvalidity (match-string 1)))
((search-forward "READ-ONLY" nil t)
(defun imap-parse-status ()
(let ((mailbox (imap-parse-mailbox)))
- (when (and mailbox (search-forward "(" nil t))
- (while (not (eq (char-after) ?\)))
- (let ((token (read (current-buffer))))
- (cond ((eq token 'MESSAGES)
+ (if (eq (char-after) ? )
+ (forward-char))
+ (when (and mailbox (eq (char-after) ?\())
+ (while (and (not (eq (char-after) ?\)))
+ (or (forward-char) t)
+ (looking-at "\\([A-Za-z]+\\) "))
+ (let ((token (match-string 1)))
+ (goto-char (match-end 0))
+ (cond ((string= token "MESSAGES")
(imap-mailbox-put 'messages (read (current-buffer)) mailbox))
- ((eq token 'RECENT)
+ ((string= token "RECENT")
(imap-mailbox-put 'recent (read (current-buffer)) mailbox))
- ((eq token 'UIDNEXT)
- (and (looking-at " \\([0-9]+\\)")
- (imap-mailbox-put 'uidnext (match-string 1) mailbox)
- (goto-char (match-end 1))))
- ((eq token 'UIDVALIDITY)
- (and (looking-at " \\([0-9]+\\)")
- (imap-mailbox-put 'uidvalidity (match-string 1) mailbox)
- (goto-char (match-end 1))))
- ((eq token 'UNSEEN)
+ ((string= token "UIDNEXT")
+ (and (looking-at "[0-9]+")
+ (imap-mailbox-put 'uidnext (match-string 0) mailbox)
+ (goto-char (match-end 0))))
+ ((string= token "UIDVALIDITY")
+ (and (looking-at "[0-9]+")
+ (imap-mailbox-put 'uidvalidity (match-string 0) mailbox)
+ (goto-char (match-end 0))))
+ ((string= token "UNSEEN")
(imap-mailbox-put 'unseen (read (current-buffer)) mailbox))
(t
(message "Unknown status data %s in mailbox %s ignored"
- token mailbox))))))))
+ token mailbox)
+ (read (current-buffer)))))))))
;; acl_data ::= "ACL" SPACE mailbox *(SPACE identifier SPACE
;; rights)
;; Shut up.
-(defvar byte-compile-default-warnings)
-
(defun maybe-fbind (args)
(while args
(or (fboundp (car args))
(defun maybe-bind (args)
(mapcar (lambda (var) (unless (boundp var) (set var nil))) args))
-(maybe-fbind '(babel-fetch
- babel-wash create-image decode-coding-string display-graphic-p
- replace-regexp-in-string
- bbdb-complete-name
- display-time-event-handler
- find-image font-create-object gnus-mule-get-coding-system
- font-lock-set-defaults
- find-coding-systems-string
- image-size image-type-available-p insert-image
- image-type-from-file-header
- make-symbolic-link
- make-temp-file message-xmas-redefine
- mail-abbrev-in-expansion-header-p
- mail-aliases-setup mm-copy-tree
- mule-write-region-no-coding-system put-image
- ring-elements
- charsetp sort-coding-systems
- coding-system-p coding-system-list
- propertize make-mode-line-mouse2-map
- frames-on-display-list
- make-mode-line-mouse-map
- rmail-select-summary rmail-summary-exists rmail-update-summary
- rmail-msg-is-pruned rmail-msg-restore-non-pruned-header
- sc-cite-regexp set-font-family set-font-size temp-directory
- string-as-multibyte
+(maybe-fbind '(create-image display-graphic-p
+ display-time-event-handler find-image image-size
+ image-type-available-p insert-image
+ make-mode-line-mouse-map make-temp-file propertize
+ put-image replace-regexp-in-string rmail-msg-is-pruned
+ rmail-msg-restore-non-pruned-header sort-coding-systems
tool-bar-add-item tool-bar-add-item-from-menu
- unix-sync
- url-view-url vcard-pretty-print
- url-insert-file-contents
- w3-coding-system-for-mime-charset w3-prepare-buffer w3-region
- w3m-charset-to-coding-system w3m-region
- widget-make-intangible x-defined-colors))
-
-(maybe-bind '(adaptive-fill-first-line-regexp
- adaptive-fill-regexp babel-history babel-translations
- default-enable-multibyte-characters
- enable-multibyte-characters
- display-time-mail-function imap-password mail-mode-hook
- filladapt-mode
- mc-pgp-always-sign
- gnus-message-group-art
- gpg-unabbrev-trust-alist
- nnoo-definition-alist
- current-language-environment
- language-info-alist
- url-current-callback-func url-be-asynchronous
- url-current-callback-data url-working-buffer
- url-current-mime-headers w3-meta-charset-content-type-regexp
- rmail-enable-mime-composing
+ tool-bar-local-item-from-menu url-http-file-exists-p
+ vcard-pretty-print w32-focus-frame
+ w3m-charset-to-coding-system x-focus-frame))
+(maybe-bind '(filladapt-mode
+ mc-pgp-always-sign rmail-enable-mime-composing
rmail-insert-mime-forwarded-message-function
- w3-meta-content-type-charset-regexp
w3m-cid-retrieve-function-alist w3m-current-buffer
- w3m-meta-content-type-charset-regexp w3m-mode-map
- url-package-version url-package-name))
+ w3m-meta-content-type-charset-regexp w3m-minor-mode-map))
(if (featurep 'xemacs)
(progn
- (defvar track-mouse nil)
- (maybe-fbind '(char-charset
- coding-system-get compute-motion coordinates-in-window-p
- delete-overlay easy-menu-create-keymaps
- error-message-string event-click-count event-end
- event-start facemenu-add-new-face facemenu-get-face
- find-charset-region find-coding-systems-for-charsets
- find-coding-systems-region find-non-ascii-charset-region
- frame-face-alist get-charset-property internal-find-face
- internal-next-face-id mail-abbrevs-setup make-char-table
- make-face-internal make-face-x-resource-internal
- make-overlay mouse-minibuffer-check mouse-movement-p
- mouse-scroll-subr overlay-buffer overlay-end
- overlay-get overlay-lists overlay-put
- overlays-in
- overlay-start posn-point posn-window
- read-event read-event run-with-idle-timer
- set-buffer-multibyte set-char-table-range
- set-face-stipple set-frame-face-alist track-mouse
- url-retrieve w3-form-encode-xwfu window-at
- window-edges x-color-values x-popup-menu browse-url
- frame-char-height frame-char-width
- url-generic-parse-url xml-parse-region
- make-network-process))
- (maybe-bind '(buffer-display-table
- buffer-file-coding-system font-lock-defaults
- global-face-data gnus-article-x-face-too-ugly
- gnus-newsgroup-charset gnus-newsgroup-emphasis-alist
- gnus-newsgroup-name mark-active
- mouse-selection-click-count
- mouse-selection-click-count-buffer
- temporary-file-directory transient-mark-mode
- url-current-mime-type
- user-full-name user-login-name
- w3-image-mappings)))
- (maybe-bind '(browse-url-browser-function
- enable-multibyte-characters help-echo-owns-message))
- (maybe-fbind '(Info-goto-node
- add-submenu annotation-glyph annotationp babel-as-string
- button-press-event-p characterp color-instance-name
- color-instance-rgb-components color-name delete-annotation
- device-class device-on-window-system-p device-type
- display-error event-glyph event-object event-point
- events-to-keys face-doc-string find-face frame-device
- frame-property get-popup-menu-response glyph-height
- glyph-property glyph-width glyphp make-annotation
- make-event
- make-color-instance make-extent make-glyph make-gui-button
- make-image-specifier map-extents next-command-event
- pp-to-string read-color set-extent-property
- set-face-doc-string set-glyph-image set-glyph-property
- specifier-instance url-generic-parse-url
- valid-image-instantiator-format-p w3-do-setup
- window-pixel-height window-pixel-width
- xml-parse-region make-network-process)))
-
-(require 'custom)
-
-(defun md5 (a &optional b c)
- )
+ (maybe-fbind '(ccl-execute-on-string
+ char-charset charsetp coding-system-get
+ coding-system-list coding-system-p decode-coding-region
+ decode-coding-string define-ccl-program delete-overlay
+ detect-coding-region encode-coding-region
+ encode-coding-string event-click-count event-end
+ event-start find-charset-region
+ find-coding-systems-for-charsets
+ find-coding-systems-region find-coding-systems-string
+ get-charset-property mail-abbrevs-setup
+ mouse-minibuffer-check mouse-movement-p mouse-scroll-subr
+ overlay-lists pgg-parse-crc24-string posn-point
+ posn-window read-event set-buffer-multibyte track-mouse
+ window-edges w3m-region))
+ (maybe-bind '(adaptive-fill-first-line-regexp
+ buffer-display-table buffer-file-coding-system
+ current-language-environment
+ default-enable-multibyte-characters
+ enable-multibyte-characters language-info-alist
+ mark-active mouse-selection-click-count
+ mouse-selection-click-count-buffer pgg-parse-crc24
+ temporary-file-directory transient-mark-mode)))
+ (maybe-fbind '(bbdb-complete-name
+ bbdb-records delete-annotation device-connection dfw-device
+ events-to-keys font-lock-set-defaults frame-device
+ glyph-height glyph-width mail-aliases-setup make-annotation
+ make-event make-glyph make-network-process map-extents
+ message-xmas-redefine set-extent-property temp-directory
+ url-generic-parse-url url-insert-file-contents
+ valid-image-instantiator-format-p
+ w3-coding-system-for-mime-charset w3-do-setup
+ w3-prepare-buffer w3-region w3m-region window-pixel-height
+ window-pixel-width))
+ (maybe-bind '(help-echo-owns-message
+ mail-mode-hook url-package-name url-package-version
+ w3-meta-charset-content-type-regexp
+ w3-meta-content-type-charset-regexp)))
(defun nnkiboze-score-file (a)
-)
+ )
(provide 'lpath)
This variable is a list of mail source specifiers.
See Info node `(gnus)Mail Source Specifiers'."
:group 'mail-source
+ :link '(custom-manual "(gnus)Mail Source Specifiers")
:type `(repeat
(choice :format "%[Value Menu%] %v"
:value (file)
(function :tag "Predicate"))
(group :inline t
(const :format "" :value :prescript)
- (string :tag "Prescript"))
+ (choice :tag "Prescript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")))
(group :inline t
(const :format "" :value :postscript)
- (string :tag "Postscript"))
+ (choice :tag "Postscript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")))
(group :inline t
(const :format "" :value :plugged)
(boolean :tag "Plugged"))))
(string :tag "Program"))
(group :inline t
(const :format "" :value :prescript)
- (string :tag "Prescript"))
+ (choice :tag "Prescript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")))
(group :inline t
(const :format "" :value :postscript)
- (string :tag "Postscript"))
+ (choice :tag "Postscript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")))
(group :inline t
(const :format "" :value :function)
(function :tag "Function"))
(error
(unless (yes-or-no-p
(format "Mail source %s error (%s). Continue? "
- source
+ (if (memq ':password source)
+ (let ((s (copy-sequence source)))
+ (setcar (cdr (memq ':password s))
+ "********")
+ s)
+ source)
(cadr err)))
(error "Cannot get new mail"))
0)))))))))
(defun mail-source-run-script (script spec &optional delay)
(when script
- (if (and (symbolp script) (fboundp script))
+ (if (functionp script)
(funcall script)
(mail-source-call-script
(format-spec script spec))))
mail-source-password-cache)))
result)))
+(defun mail-source-touch-pop ()
+ "Open and close a POP connection shortly.
+POP server should be defined in `mail-source-primary-source' (which is
+preferred) or `mail-sources'. You may use it for the POP-before-SMTP
+authentication. To do that, you need to set the option
+`message-send-mail-function' to `message-smtpmail-send-it' and put the
+following line in .gnus file:
+
+\(add-hook 'message-send-mail-hook 'mail-source-touch-pop)
+"
+ (let ((sources (if mail-source-primary-source
+ (list mail-source-primary-source)
+ mail-sources)))
+ (while sources
+ (if (eq 'pop (car (car sources)))
+ (mail-source-check-pop (car sources)))
+ (setq sources (cdr sources)))))
+
(defun mail-source-new-mail-p ()
"Handler for `display-time' to indicate when new mail is available."
;; Flash (ie. ring the visible bell) if mail is available.
;; (type . "application/dvi")
;; (test . (eq (mm-device-type) 'ns)))
("dvi"
- (viewer . "xdvi %s")
- (test . (eq (mm-device-type) 'x))
+ (viewer . "xdvi -safer %s")
+ (test . (eq window-system 'x))
("needsx11")
(type . "application/dvi"))
("dvi"
("copiousoutput"))
;; Prefer free viewers.
("pdf"
- (viewer . "gv %s")
+ (viewer . "gv -safer %s")
(type . "application/pdf")
(test . window-system))
("pdf"
(viewer . "xpdf %s")
(type . "application/pdf")
- (test . (eq (mm-device-type) 'x)))
+ (test . (eq window-system 'x)))
("pdf"
(viewer . "acroread %s")
(type . "application/pdf"))
("postscript"
(viewer . "ghostview -dSAFER %s")
(type . "application/postscript")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11"))
("postscript"
(viewer . "ps2ascii %s")
(viewer . "xwud -in %s")
(type . "image/x-xwd")
("compose" . "xwd -frame > %s")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11"))
("x11-dump"
(viewer . "xwud -in %s")
(type . "image/x-xwd")
("compose" . "xwd -frame > %s")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11"))
("windowdump"
(viewer . "xwud -in %s")
(type . "image/x-xwd")
("compose" . "xwd -frame > %s")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11"))
;;; XEmacs says `ns' device-type not implemented.
;; (".*"
(".*"
(viewer . "display %s")
(type . "image/*")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11"))
(".*"
(viewer . "ee %s")
(type . "image/*")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11")))
("text"
("plain"
("mpeg"
(viewer . "mpeg_play %s")
(type . "video/mpeg")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11")))
("x-world"
("x-vrml"
:group 'message-headers
:type 'boolean)
-(defcustom message-syntax-checks
+(defcustom message-syntax-checks
(if message-insert-canlock '((sender . disabled)) nil)
;; Guess this one shouldn't be easy to customize...
"*Controls what syntax checks should not be performed on outgoing posts.
`new-text', `quoting-style', `redirected-followup', `signature',
`approved', `sender', `empty', `empty-headers', `message-id', `from',
`subject', `shorten-followup-to', `existing-newsgroups',
-`buffer-file-name', `unchanged', `newsgroups', `reply-to'."
+`buffer-file-name', `unchanged', `newsgroups', `reply-to',
+'continuation-headers'."
:group 'message-news
:type '(repeat sexp)) ; Fixme: improve this
+(defcustom message-required-headers '((optional . References) From)
+ "*Headers to be generated or promted for when sending a message.
+Also see `message-required-news-headers' and
+1message-required-mail-headers'."
+ :group 'message-news
+ :group 'message-headers
+ :type '(repeat sexp))
+
+(defcustom message-draft-headers '(References From)
+ "*Headers to be generated when saving a draft message."
+ :group 'message-news
+ :group 'message-headers
+ :type '(repeat sexp))
+
(defcustom message-required-news-headers
'(From Newsgroups Subject Date Message-ID
- (optional . Organization) Lines
+ (optional . Organization)
(optional . User-Agent))
"*Headers to be generated or prompted for when posting an article.
RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
:type '(repeat sexp))
(defcustom message-required-mail-headers
- '(From Subject Date (optional . In-Reply-To) Message-ID Lines
+ '(From Subject Date (optional . In-Reply-To) Message-ID
(optional . User-Agent))
"*Headers to be generated or prompted for when mailing a message.
It is recommended that From, Date, To, Subject and Message-ID be
-included. Organization, Lines and User-Agent are optional."
+included. Organization and User-Agent are optional."
:group 'message-mail
:group 'message-headers
:type '(repeat sexp))
:group 'message-headers
:type 'regexp)
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:"
"*Header lines matching this regexp will be deleted before posting.
It's best to delete old Path and Date headers before posting to avoid
any confusion."
:group 'message-various
:type 'regexp)
+;;; Start of variables adopted from `message-utils.el'.
+
+(defcustom message-subject-trailing-was-query 'ask
+ ;; should it default to nil or ask?
+ "*What to do with trailing \"(was: <old subject>)\" in subject lines.
+If nil, leave the subject unchanged. If it is the symbol `ask', query
+the user what do do. In this case, the subject is matched against
+`message-subject-trailing-was-ask-regexp'. If
+`message-subject-trailing-was-query' is t, always strip the trailing
+old subject. In this case, `message-subject-trailing-was-regexp' is
+used."
+ :type '(choice (const :tag "never" nil)
+ (const :tag "always strip" t)
+ (const ask))
+ :group 'message-various)
+
+(defcustom message-subject-trailing-was-ask-regexp
+ "[ \t]*\\([[(]+[Ww][Aa][Ss][ \t]*.*[\])]+\\)"
+ "*Regexp matching \"(was: <old subject>)\" in the subject line.
+
+The function `message-strip-subject-trailing-was' uses this regexp if
+`message-subject-trailing-was-query' is set to the symbol `ask'. If
+the variable is t instead of `ask', use
+`message-subject-trailing-was-regexp' instead.
+
+It is okay to create some false positives here, as the user is asked."
+ :group 'message-various
+ :type 'regexp)
+
+(defcustom message-subject-trailing-was-regexp
+ "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)"
+ "*Regexp matching \"(was: <old subject>)\" in the subject line.
+
+If `message-subject-trailing-was-query' is set to t, the subject is
+matched against `message-subject-trailing-was-regexp' in
+`message-strip-subject-trailing-was'. You should use a regexp creating very
+few false positives here."
+ :group 'message-various
+ :type 'regexp)
+
+;;; marking inserted text
+
+;;;###autoload
+(defcustom message-mark-insert-begin
+ "--8<---------------cut here---------------start------------->8---\n"
+ "How to mark the beginning of some inserted text."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-mark-insert-end
+ "--8<---------------cut here---------------end--------------->8---\n"
+ "How to mark the end of some inserted text."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-archive-header
+ "X-No-Archive: Yes\n"
+ "Header to insert when you don't want your article to be archived.
+Archives \(such as groups.googgle.com\) respect this header."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-archive-note
+ "X-No-Archive: Yes - save http://groups.google.com/"
+ "Note to insert why you wouldn't want this posting archived.
+If nil, don't insert any text in the body."
+ :type 'string
+ :group 'message-various)
+
+;;; Crossposts and Followups
+;; inspired by JoH-followup-to by Jochem Huhman <joh at gmx.de>
+;; new suggestions by R. Weikusat <rw at another.de>
+
+(defvar message-cross-post-old-target nil
+ "Old target for cross-posts or follow-ups.")
+(make-variable-buffer-local 'message-cross-post-old-target)
+
+;;;###autoload
+(defcustom message-cross-post-default t
+ "When non-nil `message-cross-post-followup-to' will normally perform a
+crosspost. If nil, `message-cross-post-followup-to' will only do a followup.
+Note that you can explicitly override this setting by calling
+`message-cross-post-followup-to' with a prefix."
+ :type 'boolean
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-cross-post-note
+ "Crosspost & Followup-To: "
+ "Note to insert before signature to notify of cross-post and follow-up."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-followup-to-note
+ "Followup-To: "
+ "Note to insert before signature to notify of follow-up only."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-cross-post-note-function
+ 'message-cross-post-insert-note
+ "Function to use to insert note about Crosspost or Followup-To.
+The function will be called with four arguments. The function should not only
+insert a note, but also ensure old notes are deleted. See the documentation
+for `message-cross-post-insert-note'. "
+ :type 'function
+ :group 'message-various)
+
+;;; End of variables adopted from `message-utils.el'.
+
;;;###autoload
(defcustom message-signature-separator "^-- *$"
"Regexp matching the signature separator."
:group 'message-forwarding
:type 'boolean)
-(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:"
+(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From "
"*All headers that match this regexp will be deleted when resending a message."
:group 'message-interface
:type 'regexp)
(defcustom message-cite-prefix-regexp
(if (string-match "[[:digit:]]" "1") ;; support POSIX?
- "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>»|:}+]\\)+"
+ "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+"
;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
(let ((old-table (syntax-table))
non-word-constituents)
(if (string-match "\\w" ".") "" ".")))
(set-syntax-table old-table)
(if (equal non-word-constituents "")
- "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>»|:}+]\\)+"
+ "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+"
(concat "\\([ \t]*\\(\\w\\|["
non-word-constituents
- "]\\)+>+\\|[ \t]*[]>»|:}+]\\)+"))))
+ "]\\)+>+\\|[ \t]*[]>|}+]\\)+"))))
"*Regexp matching the longest possible citation prefix on a line."
:group 'message-insertion
:type 'regexp)
Valid values include `message-send-mail-with-sendmail' (the default),
`message-send-mail-with-mh', `message-send-mail-with-qmail',
-`smtpmail-send-it' and `feedmail-send-it'.
+`message-smtpmail-send-it', `smtpmail-send-it' and `feedmail-send-it'.
See also `send-mail-function'."
:type '(radio (function-item message-send-mail-with-sendmail)
(function-item message-send-mail-with-mh)
(function-item message-send-mail-with-qmail)
+ (function-item message-smtpmail-send-it)
(function-item smtpmail-send-it)
(function-item feedmail-send-it)
(function :tag "Other"))
"*If non-nil, generate all required headers before composing.
The variables `message-required-news-headers' and
`message-required-mail-headers' specify which headers to generate.
+This can also be a list of headers that should be generated before
+composing.
Note that the variable `message-deletable-headers' specifies headers which
are to be deleted and then re-generated before sending, so this variable
:type '(choice file (const :tags "None" nil))
:group 'message-insertion)
+;;;###autoload
+(defcustom message-signature-insert-empty-line t
+ "*If non-nil, insert an empty line before the signature separator."
+ :type 'boolean
+ :group 'message-insertion)
+
(defcustom message-distribution-function nil
"*Function called to return a Distribution header."
:group 'message-news
`empty-article' Allow you to post an empty article;
`quoted-text-only' Allow you to post quoted text only;
`multiple-copies' Allow you to post multiple copies;
-`cancel-messages' Allow you to cancel or supersede messages from
+`cancel-messages' Allow you to cancel or supersede messages from
your other email addresses.")
(defsubst message-gnksa-enable-p (feature)
`((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
1 'message-separator-face))
nil)
- (,(concat "^\\(" message-cite-prefix-regexp "\\).*")
+ ((lambda (limit)
+ (re-search-forward (concat "^\\("
+ message-cite-prefix-regexp
+ "\\).*")
+ limit t))
(0 'message-cited-text-face))
("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>"
(0 'message-mml-face))))
(unbold-region b e)
(ununderline-region b e))))
"Alist of mail and news faces for facemenu.
-The cdr of ech entry is a function for applying the face to a region.")
+The cdr of each entry is a function for applying the face to a region.")
(defcustom message-send-hook nil
"Hook run before sending messages."
(defvar message-draft-coding-system
mm-auto-save-coding-system
- "Coding system to compose mail.")
+ "*Coding system to compose mail.
+If you'd like to make it possible to share draft files between XEmacs
+and Emacs, you may use `iso-2022-7bit' for this value at your own risk.
+Note that the coding-system `iso-2022-7bit' isn't suitable to all data.")
(defcustom message-send-mail-partially-limit 1000000
"The limitation of messages sent as message/partial.
(autoload 'gnus-group-name-charset "gnus-group")
(autoload 'gnus-group-name-decode "gnus-group")
(autoload 'gnus-groups-from-server "gnus")
- (autoload 'rmail-output "rmailout"))
+ (autoload 'rmail-output "rmailout")
+ (autoload 'gnus-delay-article "gnus-delay"))
\f
(insert (car headers) ?\n)))))
(setq headers (cdr headers))))
+(defmacro message-with-reply-buffer (&rest forms)
+ "Evaluate FORMS in the reply buffer, if it exists."
+ `(when (and message-reply-buffer
+ (buffer-name message-reply-buffer))
+ (save-excursion
+ (set-buffer message-reply-buffer)
+ ,@forms)))
+
+(put 'message-with-reply-buffer 'lisp-indent-function 0)
+(put 'message-with-reply-buffer 'edebug-form-spec '(body))
(defun message-fetch-reply-field (header)
"Fetch field HEADER 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))))
+ (message-with-reply-buffer
+ (message-fetch-field header)))
(defun message-set-work-buffer ()
(if (get-buffer " *message work*")
(substring subject (match-end 0))
subject))
+;;; Start of functions adopted from `message-utils.el'.
+
+(defun message-strip-subject-trailing-was (subject)
+ "Remove trailing \"(Was: <old subject>)\" from subject lines.
+Leading \"Re: \" is not stripped by this function. Use the function
+`message-strip-subject-re' for this."
+ (let* ((query message-subject-trailing-was-query)
+ (new) (found))
+ (setq found
+ (string-match
+ (if (eq query 'ask)
+ message-subject-trailing-was-ask-regexp
+ message-subject-trailing-was-regexp)
+ subject))
+ (if found
+ (setq new (substring subject 0 (match-beginning 0))))
+ (if (or (not found) (eq query nil))
+ subject
+ (if (eq query 'ask)
+ (if (message-y-or-n-p
+ "Strip `(was: <old subject>)' in subject? " t
+ (concat
+ "Strip `(was: <old subject>)' in subject "
+ "and use the new one instead?\n\n"
+ "Current subject is: \""
+ subject "\"\n\n"
+ "New subject would be: \""
+ new "\"\n\n"
+ "See the variable `message-subject-trailing-was-query' "
+ "to get rid of this query."
+ ))
+ new subject)
+ new))))
+
+;;; Suggested by Jonas Steverud @ www.dtek.chalmers.se/~d4jonas/
+
+;;;###autoload
+(defun message-change-subject (new-subject)
+ "Ask for new Subject: header, append (was: <Old Subject>)."
+ (interactive
+ (list
+ (read-from-minibuffer "New subject: ")))
+ (cond ((and (not (or (null new-subject) ; new subject not empty
+ (zerop (string-width new-subject))
+ (string-match "^[ \t]*$" new-subject))))
+ (save-excursion
+ (let ((old-subject (message-fetch-field "Subject")))
+ (cond ((not old-subject)
+ (error "No current subject."))
+ ((not (string-match
+ (concat "^[ \t]*"
+ (regexp-quote new-subject)
+ " \t]*$")
+ old-subject)) ; yes, it really is a new subject
+ ;; delete eventual Re: prefix
+ (setq old-subject
+ (message-strip-subject-re old-subject))
+ (message-goto-subject)
+ (message-delete-line)
+ (insert (concat "Subject: "
+ new-subject
+ " (was: "
+ old-subject ")\n")))))))))
+
+;;;###autoload
+(defun message-mark-inserted-region (beg end)
+ "Mark some region in the current article with enclosing tags.
+See `message-mark-insert-begin' and `message-mark-insert-end'."
+ (interactive "r")
+ (save-excursion
+ ; add to the end of the region first, otherwise end would be invalid
+ (goto-char end)
+ (insert message-mark-insert-end)
+ (goto-char beg)
+ (insert message-mark-insert-begin)))
+
+;;;###autoload
+(defun message-mark-insert-file (file)
+ "Inserts FILE at point, marking it with enclosing tags.
+See `message-mark-insert-begin' and `message-mark-insert-end'."
+ (interactive "fFile to insert: ")
+ ;; reverse insertion to get correct result.
+ (let ((p (point)))
+ (insert message-mark-insert-end)
+ (goto-char p)
+ (insert-file-contents file)
+ (goto-char p)
+ (insert message-mark-insert-begin)))
+
+;;;###autoload
+(defun message-add-archive-header ()
+ "Insert \"X-No-Archive: Yes\" in the header and a note in the body.
+The note can be customized using `message-archive-note'. When called with a
+prefix argument, ask for a text to insert. If you don't want the note in the
+body, set `message-archive-note' to nil."
+ (interactive)
+ (if current-prefix-arg
+ (setq message-archive-note
+ (read-from-minibuffer "Reason for No-Archive: "
+ (cons message-archive-note 0))))
+ (save-excursion
+ (if (message-goto-signature)
+ (re-search-backward message-signature-separator))
+ (when message-archive-note
+ (insert message-archive-note)
+ (newline))
+ (message-add-header message-archive-header)
+ (message-sort-headers)))
+
+;;;###autoload
+(defun message-cross-post-followup-to-header (target-group)
+ "Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP.
+With prefix-argument just set Follow-Up, don't cross-post."
+ (interactive
+ (list ; Completion based on Gnus
+ (completing-read "Followup To: "
+ (if (boundp 'gnus-newsrc-alist)
+ gnus-newsrc-alist)
+ nil nil '("poster" . 0)
+ (if (boundp 'gnus-group-history)
+ 'gnus-group-history))))
+ (message-remove-header "Follow[Uu]p-[Tt]o" t)
+ (message-goto-newsgroups)
+ (beginning-of-line)
+ ;; if we already did a crosspost before, kill old target
+ (if (and message-cross-post-old-target
+ (re-search-forward
+ (regexp-quote (concat "," message-cross-post-old-target))
+ nil t))
+ (replace-match ""))
+ ;; unless (followup is to poster or user explicitly asked not
+ ;; to cross-post, or target-group is already in Newsgroups)
+ ;; add target-group to Newsgroups line.
+ (cond ((and (or
+ ;; def: cross-post, req:no
+ (and message-cross-post-default (not current-prefix-arg))
+ ;; def: no-cross-post, req:yes
+ (and (not message-cross-post-default) current-prefix-arg))
+ (not (string-match "poster" target-group))
+ (not (string-match (regexp-quote target-group)
+ (message-fetch-field "Newsgroups"))))
+ (end-of-line)
+ (insert-string (concat "," target-group))))
+ (end-of-line) ; ensure Followup: comes after Newsgroups:
+ ;; unless new followup would be identical to Newsgroups line
+ ;; make a new Followup-To line
+ (if (not (string-match (concat "^[ \t]*"
+ target-group
+ "[ \t]*$")
+ (message-fetch-field "Newsgroups")))
+ (insert (concat "\nFollowup-To: " target-group)))
+ (setq message-cross-post-old-target target-group))
+
+;;;###autoload
+(defun message-cross-post-insert-note (target-group cross-post in-old
+ old-groups)
+ "Insert a in message body note about a set Followup or Crosspost.
+If there have been previous notes, delete them. TARGET-GROUP specifies the
+group to Followup-To. When CROSS-POST is t, insert note about
+crossposting. IN-OLD specifies whether TARGET-GROUP is a member of
+OLD-GROUPS. OLD-GROUPS lists the old-groups the posting would have
+been made to before the user asked for a Crosspost."
+ ;; start scanning body for previous uses
+ (message-goto-signature)
+ (let ((head (re-search-backward
+ (concat "^" mail-header-separator)
+ nil t))) ; just search in body
+ (message-goto-signature)
+ (while (re-search-backward
+ (concat "^" (regexp-quote message-cross-post-note) ".*")
+ head t)
+ (message-delete-line))
+ (message-goto-signature)
+ (while (re-search-backward
+ (concat "^" (regexp-quote message-followup-to-note) ".*")
+ head t)
+ (message-delete-line))
+ ;; insert new note
+ (if (message-goto-signature)
+ (re-search-backward message-signature-separator))
+ (if (or in-old
+ (not cross-post)
+ (string-match "^[ \t]*poster[ \t]*$" target-group))
+ (insert (concat message-followup-to-note target-group "\n"))
+ (insert (concat message-cross-post-note target-group "\n")))))
+
+;;;###autoload
+(defun message-cross-post-followup-to (target-group)
+ "Crossposts message and sets Followup-To to TARGET-GROUP.
+With prefix-argument just set Follow-Up, don't cross-post."
+ (interactive
+ (list ; Completion based on Gnus
+ (completing-read "Followup To: "
+ (if (boundp 'gnus-newsrc-alist)
+ gnus-newsrc-alist)
+ nil nil '("poster" . 0)
+ (if (boundp 'gnus-group-history)
+ 'gnus-group-history))))
+ (cond ((not (or (null target-group) ; new subject not empty
+ (zerop (string-width target-group))
+ (string-match "^[ \t]*$" target-group)))
+ (save-excursion
+ (let* ((old-groups (message-fetch-field "Newsgroups"))
+ (in-old (string-match
+ (regexp-quote target-group)
+ (or old-groups ""))))
+ ;; check whether target exactly matches old Newsgroups
+ (cond ((not old-groups)
+ (error "No current newsgroup."))
+ ((or (not in-old)
+ (not (string-match
+ (concat "^[ \t]*"
+ (regexp-quote target-group)
+ "[ \t]*$")
+ old-groups)))
+ ;; yes, Newsgroups line must change
+ (message-cross-post-followup-to-header target-group)
+ ;; insert note whether we do cross-post or followup-to
+ (funcall message-cross-post-note-function
+ target-group
+ (if (or (and message-cross-post-default
+ (not current-prefix-arg))
+ (and (not message-cross-post-default)
+ current-prefix-arg)) t)
+ in-old old-groups))))))))
+
+;;; Reduce To: to Cc: or Bcc: header
+
+;;;###autoload
+(defun message-reduce-to-to-cc ()
+ "Replace contents of To: header with contents of Cc: or Bcc: header."
+ (interactive)
+ (let ((cc-content (message-fetch-field "cc"))
+ (bcc nil))
+ (if (and (not cc-content)
+ (setq cc-content (message-fetch-field "bcc")))
+ (setq bcc t))
+ (cond (cc-content
+ (save-excursion
+ (message-goto-to)
+ (message-delete-line)
+ (insert (concat "To: " cc-content "\n"))
+ (message-remove-header (if bcc
+ "bcc"
+ "cc")))))))
+
+;;; End of functions adopted from `message-utils.el'.
+
(defun message-remove-header (header &optional is-regexp first reverse)
"Remove HEADER in the narrowed buffer.
If IS-REGEXP, HEADER is a regular expression.
(message-fetch-field "cc")
(message-fetch-field "bcc")))))))
+(defun message-subscribed-p ()
+ "Say whether we need to insert a MFT header."
+ (or message-subscribed-regexps
+ message-subscribed-addresses
+ message-subscribed-address-file
+ message-subscribed-address-functions))
+
(defun message-next-header ()
"Go to the beginning of the next header."
(beginning-of-line)
(define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
(define-key message-mode-map "\C-c\C-f\C-i" 'message-insert-or-toggle-importance)
(define-key message-mode-map "\C-c\C-f\C-a" 'message-gen-unsubscribed-mft)
+
+ ;; modify headers (and insert notes in body)
+ (define-key message-mode-map "\C-c\C-fs" 'message-change-subject)
+ ;;
+ (define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to)
+ ;; prefix+message-cross-post-followup-to = same w/o cross-post
+ (define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc)
+ (define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header)
+ ;; mark inserted text
+ (define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region)
+ (define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file)
+
(define-key message-mode-map "\C-c\C-b" 'message-goto-body)
(define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
(define-key message-mode-map "\C-c\C-t" 'message-insert-to)
+ (define-key message-mode-map "\C-c\C-p" 'message-insert-wide-reply)
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
(define-key message-mode-map "\C-c\C-l" 'message-to-list-only)
,@(if (featurep 'xemacs) '(t)
'(:help "Spellcheck this message"))]
"----"
+ ["Insert Region Marked" message-mark-inserted-region
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Mark region with enclosing tags"))]
+ ["Insert File Marked..." message-mark-insert-file
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Insert file at point marked with enclosing tags"))]
+ "----"
["Send Message" message-send-and-exit
,@(if (featurep 'xemacs) '(t)
'(:help "Send this message"))]
["Postpone Message" message-dont-send
,@(if (featurep 'xemacs) '(t)
'(:help "File this draft message and exit"))]
- ["Send at Specific Time" gnus-delay-article
+ ["Send at Specific Time..." gnus-delay-article
,@(if (featurep 'xemacs) '(t)
'(:help "Ask, then arrange to send message at that time"))]
["Kill Message" message-kill-buffer
["To" message-goto-to t]
["From" message-goto-from t]
["Subject" message-goto-subject t]
+ ["Change subject..." message-change-subject t]
["Cc" message-goto-cc t]
+ ["Bcc" message-goto-bcc t]
+ ["Fcc" message-goto-fcc t]
["Reply-To" message-goto-reply-to t]
+ "----"
+ ;; (typical) news stuff
["Summary" message-goto-summary t]
["Keywords" message-goto-keywords t]
["Newsgroups" message-goto-newsgroups t]
["Followup-To" message-goto-followup-to t]
- ["Mail-Followup-To" message-goto-mail-followup-to t]
+ ;; ["Followup-To (with note in body)" message-cross-post-followup-to t]
+ ["Crosspost / Followup-To..." message-cross-post-followup-to t]
["Distribution" message-goto-distribution t]
+ ["X-No-Archive:" message-add-archive-header t ]
+ "----"
+ ;; (typical) mailing-lists stuff
+ ["Send to list only" message-to-list-only t]
+ ["Mail-Followup-To" message-goto-mail-followup-to t]
+ ["Reduce To: to Cc:" message-reduce-to-to-cc t]
+ "----"
["Body" message-goto-body t]
["Signature" message-goto-signature t]))
C-c C-f C-f move to Followup-To
C-c C-f C-m move to Mail-Followup-To
C-c C-f C-i cycle through Importance values
+ C-c C-f s change subject and append \"(was: <Old Subject>)\"
+ C-c C-f x crossposting with FollowUp-To header and note in body
+ C-c C-f t replace To: header with contents of Cc: or Bcc:
+ C-c C-f a Insert X-No-Archive: header and a note in the body
C-c C-t `message-insert-to' (add a To header to a news followup)
C-c C-l `message-to-list-only' (removes all but list address in to/cc)
C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply)
C-c C-a `mml-attach-file' (attach a file as MIME).
C-c C-u `message-insert-or-toggle-importance' (insert or cycle importance).
C-c M-n `message-insert-disposition-notification-to' (request receipt).
+C-c M-m `message-mark-inserted-region' (mark region with enclosing tags).
+C-c M-f `message-mark-insert-file' (insert file marked with enclosing tags).
M-RET `message-newline-and-reformat' (break the line and reformat)."
(setq local-abbrev-table text-mode-abbrev-table)
(set (make-local-variable 'message-reply-buffer) nil)
(or (equal (downcase co) "never")
(equal (downcase co) "nobody")))
(error "The user has requested not to have copies sent via mail")))
- (when (and (message-position-on-field "To")
- (mail-fetch-field "to")
- (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
- (insert ", "))
- (insert (or (message-fetch-reply-field "mail-reply-to")
- (message-fetch-reply-field "reply-to")
- (message-fetch-reply-field "from") "")))
+ (message-carefully-insert-headers
+ (list (cons 'To
+ (or (message-fetch-reply-field "mail-reply-to")
+ (message-fetch-reply-field "reply-to")
+ (message-fetch-reply-field "from")
+ "")))))
+
+(defun message-insert-wide-reply ()
+ "Insert To and Cc headers as if you were doing a wide reply."
+ (interactive)
+ (let ((headers (message-with-reply-buffer
+ (message-get-reply-headers t))))
+ (message-carefully-insert-headers headers)))
+
+(defun message-carefully-insert-headers (headers)
+ (dolist (header headers)
+ (let ((header-name (symbol-name (car header))))
+ (when (and (message-position-on-field header-name)
+ (mail-fetch-field header-name)
+ (not (string-match "\\` *\\'"
+ (mail-fetch-field header-name))))
+ (insert ", "))
+ (insert (cdr header)))))
(defun message-widen-reply ()
"Widen the reply to include maximum recipients."
;; Insert the signature.
(unless (bolp)
(insert "\n"))
- (insert "\n-- \n")
+ (when message-signature-insert-empty-line
+ (insert "\n"))
+ (insert "-- \n")
(if (eq signature t)
(insert-file-contents message-signature-file)
(insert signature))
(or (< (mm-char-int char) 128)
(and (mm-multibyte-p)
(memq (char-charset char)
- '(eight-bit-control eight-bit-graphic
+ '(eight-bit-control eight-bit-graphic
control-1)))))
(add-text-properties (point) (1+ (point)) '(highlight t))
(setq found t))
(skip-chars-forward mm-7bit-chars))
(when found
(setq choice
- (gnus-multiple-choice
+ (gnus-multiple-choice
"Illegible text found. Continue posting? "
'((?d "Remove and continue posting")
(?r "Replace with dots and continue posting")
(save-restriction
(message-narrow-to-headers)
;; Generate the Mail-Followup-To header if the header is not there...
- (if (and (or message-subscribed-regexps
- message-subscribed-addresses
- message-subscribed-address-file
- message-subscribed-address-functions)
+ (if (and (message-subscribed-p)
(not (mail-fetch-field "mail-followup-to")))
(setq headers
(cons
;; require one newline at the end.
(or (= (preceding-char) ?\n)
(insert ?\n))
+ (message-cleanup-headers)
(when
(save-restriction
(message-narrow-to-headers)
"The message size is too large, split? "
t
"\
-The message size, " (/ (point-max) 1000) "KB, is too large.
+The message size, "
+ (/ (point-max) 1000) "KB, is too large.
Some mail gateways (MTA's) bounce large messages. To avoid the
problem, answer `y', and the message will be split into several
smaller pieces, the size of each is about "
-(/ message-send-mail-partially-limit 1000)
-"KB except the last
+ (/ message-send-mail-partially-limit 1000)
+ "KB except the last
one.
However, some mail readers (MUA's) can't read split messages, i.e.,
;; Pass it on to mh.
(mh-send-letter)))
+(defun message-smtpmail-send-it ()
+ "Send the prepared message buffer with `smtpmail-send-it'.
+This only differs from `smtpmail-send-it' that this command evaluates
+`message-send-mail-hook' just before sending a message. It is useful
+if your ISP requires the POP-before-SMTP authentication. See the
+documentation for the function `mail-source-touch-pop'."
+ (run-hooks 'message-send-mail-hook)
+ (smtpmail-send-it))
+
(defun message-canlock-generate ()
"Return a string that is non-trival to guess.
Do not use this for anything important, it is cryptographically weak."
- (sha1 (concat (message-unique-id)
- (format "%x%x%x" (random) (random t) (random))
- (prin1-to-string (recent-keys))
- (prin1-to-string (garbage-collect)))))
+ (let (sha1-maximum-internal-length)
+ (sha1 (concat (message-unique-id)
+ (format "%x%x%x" (random) (random t) (random))
+ (prin1-to-string (recent-keys))
+ (prin1-to-string (garbage-collect))))))
(defun message-canlock-password ()
"The password used by message for cancel locks.
This is the value of `canlock-password', if that option is non-nil.
Otherwise, generate and save a value for `canlock-password' first."
(unless canlock-password
- (customize-save-variable 'canlock-password (message-canlock-generate)))
+ (customize-save-variable 'canlock-password (message-canlock-generate))
+ (setq canlock-password-for-verify canlock-password))
canlock-password)
(defun message-insert-canlock ()
(if (= (length errors) 1) "this" "these")
(if (= (length errors) 1) "" "s")
(mapconcat 'identity errors ", ")))))))
+ ;; Check continuation headers.
+ (message-check 'continuation-headers
+ (goto-char (point-min))
+ (let ((do-posting t))
+ (while (re-search-forward "^[^ \t\n][^:\n]*$" nil t)
+ (if (y-or-n-p "Fix continuation lines? ")
+ (progn
+ (goto-char (match-beginning 0))
+ (insert " "))
+ (unless (y-or-n-p "Send anyway? ")
+ (setq do-posting nil))))
+ do-posting))
;; Check the Newsgroups & Followup-To headers for syntax errors.
(message-check 'valid-newsgroups
(let ((case-fold-search t)
(message-goto-body)
(int-to-string (count-lines (point) (point-max))))))
+(defun message-make-references ()
+ "Return the References header for this message."
+ (when message-reply-headers
+ (let ((message-id (mail-header-message-id message-reply-headers))
+ (references (mail-header-references message-reply-headers))
+ new-references)
+ (if (or references message-id)
+ (concat (or references "") (and references " ")
+ (or message-id ""))
+ nil))))
+
(defun message-make-in-reply-to ()
"Return the In-Reply-To header for this message."
(when message-reply-headers
(message-make-fqdn)))
(defun message-to-list-only ()
+ "Send a message to the list only.
+Remove all addresses but the list address from To and Cc headers."
(interactive)
(let ((listaddr (message-make-mft t)))
(when listaddr
(defun message-generate-headers (headers)
"Prepare article HEADERS.
Headers already prepared in the buffer are not modified."
+ (setq headers (append headers message-required-headers))
(save-restriction
(message-narrow-to-headers)
(let* ((Date (message-make-date))
(Subject nil)
(Newsgroups nil)
(In-Reply-To (message-make-in-reply-to))
+ (References (message-make-references))
(To nil)
(Distribution (message-make-distribution))
(Lines (message-make-lines))
;; So we find out what value we should insert.
(setq value
(cond
- ((and (consp elem) (eq (car elem) 'optional))
+ ((and (consp elem)
+ (eq (car elem) 'optional))
;; This is an optional header. If the cdr of this
;; is something that is nil, then we do not insert
;; this header.
(setq header (cdr elem))
- (or (and (fboundp (cdr elem)) (funcall (cdr elem)))
- (and (boundp (cdr elem)) (symbol-value (cdr elem)))))
+ (or (and (message-functionp (cdr elem))
+ (funcall (cdr elem)))
+ (and (boundp (cdr elem))
+ (symbol-value (cdr elem)))))
((consp elem)
;; The element is a cons. Either the cdr is a
;; string to be inserted verbatim, or it is a
;; function, and we insert the value returned from
;; this function.
- (or (and (stringp (cdr elem)) (cdr elem))
- (and (fboundp (cdr elem)) (funcall (cdr elem)))))
- ((and (boundp header) (symbol-value header))
+ (or (and (stringp (cdr elem))
+ (cdr elem))
+ (and (message-functionp (cdr elem))
+ (funcall (cdr elem)))))
+ ((and (boundp header)
+ (symbol-value header))
;; The element is a symbol. We insert the value
;; of this symbol, if any.
(symbol-value header))
(progn
;; This header didn't exist, so we insert it.
(goto-char (point-max))
- (insert (if (stringp header) header (symbol-name header))
- ": " value)
- ;; We check whether the value was ended by a
- ;; newline. If now, we insert one.
- (unless (bolp)
- (insert "\n"))
- (forward-line -1))
+ (let ((formatter
+ (cdr (assq header message-header-format-alist))))
+ (if formatter
+ (funcall formatter header value)
+ (insert (if (stringp header)
+ header (symbol-name header))
+ ": " value))
+ ;; We check whether the value was ended by a
+ ;; newline. If now, we insert one.
+ (unless (bolp)
+ (insert "\n"))
+ (forward-line -1)))
;; The value of this header was empty, so we clear
;; totally and insert the new value.
(delete-region (point) (gnus-point-at-eol))
(forward-line 2)))
(sit-for 0)))
+(defcustom message-beginning-of-line t
+ "Whether C-a goes to beginning of header values."
+ :group 'message-buffers
+ :type 'boolean)
+
(defun message-beginning-of-line (&optional n)
"Move point to beginning of header value or to beginning of line."
(interactive "p")
(let ((zrs 'zmacs-region-stays))
(when (and (interactive-p) (boundp zrs))
(set zrs t)))
- (if (message-point-in-header-p)
+ (if (and message-beginning-of-line
+ (message-point-in-header-p))
(let* ((here (point))
(bol (progn (beginning-of-line n) (point)))
(eol (gnus-point-at-eol))
headers)
nil switch-function yank-action actions)))))
+(defun message-headers-to-generate (headers included-headers excluded-headers)
+ "Return a list that includes all headers from HEADERS.
+If INCLUDED-HEADERS is a list, just include those headers. If if is
+t, include all headers. In any case, headers from EXCLUDED-HEADERS
+are not included."
+ (let ((result nil)
+ header-name)
+ (dolist (header headers)
+ (setq header-name (cond
+ ((and (consp header)
+ (eq (car header) 'optional))
+ ;; On the form (optional . Header)
+ (cdr header))
+ ((consp header)
+ ;; On the form (Header . function)
+ (car header))
+ (t
+ ;; Just a Header.
+ header)))
+ (when (and (not (memq header-name excluded-headers))
+ (or (eq included-headers t)
+ (memq header-name included-headers)))
+ (push header result)))
+ (nreverse result)))
+
(defun message-setup-1 (headers &optional replybuffer actions)
(dolist (action actions)
(condition-case nil
(or (bolp) (insert ?\n)))
(when message-generate-headers-first
(message-generate-headers
- (delq 'Lines
- (delq 'Subject
- (copy-sequence message-required-news-headers))))))
+ (message-headers-to-generate
+ (append message-required-news-headers
+ message-required-headers)
+ message-generate-headers-first
+ '(Lines Subject)))))
(when (message-mail-p)
(when message-default-mail-headers
(insert message-default-mail-headers)
(or (bolp) (insert ?\n)))
(when message-generate-headers-first
(message-generate-headers
- (delq 'Lines
- (delq 'Subject
- (copy-sequence message-required-mail-headers))))))
+ (message-headers-to-generate
+ (append message-required-mail-headers
+ message-required-headers)
+ message-generate-headers-first
+ '(Lines Subject)))))
(run-hooks 'message-signature-setup-hook)
(message-insert-signature)
(save-restriction
(when message-auto-save-directory
(unless (file-directory-p
(directory-file-name message-auto-save-directory))
- (gnus-make-directory message-auto-save-directory))
+ (make-directory message-auto-save-directory t))
(if (gnus-alive-p)
(setq message-draft-article
(nndraft-request-associate-buffer "drafts"))
(setq buffer-file-name (expand-file-name
(if (memq system-type
'(ms-dos ms-windows windows-nt
- cygwin32 win32 w32
+ cygwin cygwin32 win32 w32
mswindows))
"message"
"*message*")
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
-(defun message-get-reply-headers (wide &optional to-address)
+(defun message-get-reply-headers (wide &optional to-address address-headers)
(let (follow-to mct never-mct to cc author mft recipients)
;; Find all relevant headers we need.
(setq to (message-fetch-field "to")
(cond
((not wide)
(setq recipients (concat ", " author)))
+ (address-headers
+ (dolist (header address-headers)
+ (let ((value (message-fetch-field header)))
+ (when value
+ (setq recipients (concat recipients ", " value))))))
((and mft
(string-match "[^ \t,]" mft)
(or (not (eq message-use-mail-followup-to 'ask))
(when gnus-list-identifiers
(setq subject (message-strip-list-identifiers subject)))
(setq subject (concat "Re: " (message-strip-subject-re subject)))
+ (when message-subject-trailing-was-query
+ (setq subject (message-strip-subject-trailing-was subject)))
(when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
(string-match "<[^>]+>" gnus-warning))
(message-setup
`((Subject . ,subject)
- ,@follow-to
- ,@(if (or references message-id)
- `((References . ,(concat (or references "") (and references " ")
- (or message-id ""))))
- nil))
+ ,@follow-to)
cur)))
;;;###autoload
(if gnus-list-identifiers
(setq subject (message-strip-list-identifiers subject)))
(setq subject (concat "Re: " (message-strip-subject-re subject)))
+ (when message-subject-trailing-was-query
+ (setq subject (message-strip-subject-trailing-was subject)))
(widen))
(message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
+ (setq message-reply-headers
+ (vector 0 subject from date message-id references 0 0 ""))
+
(message-setup
`((Subject . ,subject)
,@(cond
(t
`((Newsgroups . ,newsgroups))))
,@(and distribution (list (cons 'Distribution distribution)))
- ,@(if (or references message-id)
- `((References . ,(concat (or references "") (and references " ")
- (or message-id "")))))
,@(when (and mct
(not (or (equal (downcase mct) "never")
(equal (downcase mct) "nobody"))))
(or mrt reply-to from "")
mct)))))
- cur)
-
- (setq message-reply-headers
- (vector 0 subject from date message-id references 0 0 ""))))
+ cur)))
;;;###autoload
(not message-forward-decoded-p))
(insert
(with-temp-buffer
- (if (with-current-buffer forward-buffer
- (mm-multibyte-p))
- (insert-buffer-substring forward-buffer)
- (mm-disable-multibyte-mule4)
- (insert
- (with-current-buffer forward-buffer
- (mm-string-as-unibyte (buffer-string))))
- (mm-enable-multibyte-mule4))
+ (mm-disable-multibyte-mule4)
+ (insert
+ (with-current-buffer forward-buffer
+ (mm-string-as-unibyte (buffer-string))))
+ (mm-enable-multibyte-mule4)
(mime-to-mml)
(goto-char (point-min))
(when (looking-at "From ")
(defvar tool-bar-map)
(defvar tool-bar-mode))
+(defun message-tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props)
+ ;; We need to make tool bar entries in local keymaps with
+ ;; `tool-bar-local-item-from-menu' in Emacs > 21.3
+ (if (fboundp 'tool-bar-local-item-from-menu)
+ ;; This is for Emacs 21.3
+ (tool-bar-local-item-from-menu command icon in-map from-map props)
+ (tool-bar-add-item-from-menu command icon from-map props)))
+
(defun message-tool-bar-map ()
(or message-tool-bar-map
(setq message-tool-bar-map
- (and
+ (and
(condition-case nil (require 'tool-bar) (error nil))
(fboundp 'tool-bar-add-item-from-menu)
tool-bar-mode
(dolist (key '(print-buffer kill-buffer save-buffer
write-file dired open-file))
(define-key tool-bar-map (vector key) nil))
- (tool-bar-add-item-from-menu
- 'message-send-and-exit "mail_send" message-mode-map)
- (tool-bar-add-item-from-menu
- 'message-kill-buffer "close" message-mode-map)
- (tool-bar-add-item-from-menu
- 'message-dont-send "cancel" message-mode-map)
- (tool-bar-add-item-from-menu
- 'mml-attach-file "attach" mml-mode-map)
- (tool-bar-add-item-from-menu
- 'ispell-message "spell" message-mode-map)
- (tool-bar-add-item-from-menu
+ (message-tool-bar-local-item-from-menu
+ 'message-send-and-exit "mail_send" tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
+ 'message-kill-buffer "close" tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
+ 'message-dont-send "cancel" tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
+ 'mml-attach-file "attach" tool-bar-map mml-mode-map)
+ (message-tool-bar-local-item-from-menu
+ 'ispell-message "spell" tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
'message-insert-importance-high "important"
- message-mode-map)
- (tool-bar-add-item-from-menu
+ tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
'message-insert-importance-low "unimportant"
- message-mode-map)
- (tool-bar-add-item-from-menu
+ tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
'message-insert-disposition-notification-to "receipt"
- message-mode-map)
+ tool-bar-map message-mode-map)
tool-bar-map)))))
;;; Group name completion.
(defcustom message-completion-alist
(list (cons message-newgroups-header-regexp 'message-expand-group)
- '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name))
+ '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name)
+ '("^\\(Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):"
+ . message-expand-name)
+ '("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):"
+ . message-expand-name))
"Alist of (RE . FUN). Use FUN for completion on header lines matching RE."
:group 'message
:type '(alist :key-type regexp :value-type function))
;;; messcompat.el --- making message mode compatible with mail mode
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;;; Commentary:
-;; This file tries to provide backward compatability with sendmail.el
+;; This file tries to provide backward compatibility with sendmail.el
;; for Message mode. It should be used by simply adding
;;
;; (require 'messcompat)
bits)
((and (not mm-use-ultra-safe-encoding)
(not longp)
+ (not (eq '7bit (cdr (assq charset mm-body-charset-encoding-alist))))
(or (eq t (cdr message-posting-charset))
(memq charset (cdr message-posting-charset))
(eq charset mail-parse-charset)))
(require 'mm-uu)
(funcall mm-uu-binhex-decode-function (point-min) (point-max))
t)
+ ((eq encoding 'x-yenc)
+ (require 'mm-uu)
+ (funcall mm-uu-yenc-decode-function (point-min) (point-max))
+ )
((functionp encoding)
(funcall encoding (point-min) (point-max))
t)
(message "Error while decoding: %s" error)
nil))
(when (and
- (memq encoding '(base64 x-uuencode x-uue x-binhex))
+ (memq encoding '(base64 x-uuencode x-uue x-binhex x-yenc))
(equal type "text/plain"))
(goto-char (point-min))
(while (search-forward "\r\n" nil t)
will be bound with this value. You may set this value to nil if you
consider all the urls to be safe."
:type '(choice (regexp :tag "Regexp")
- (const :tag "All URLs are safe" nil)
- :group 'mime-display))
+ (const :tag "All URLs are safe" nil))
+ :group 'mime-display)
(defcustom mm-inline-text-html-with-w3m-keymap t
"If non-nil, use emacs-w3m command keys in the article buffer."
(message "Viewing with %s" method)
(cond
(needsterm
- (unwind-protect
- (if window-system
- (start-process "*display*" nil
- mm-external-terminal-program
- "-e" shell-file-name
- shell-command-switch
- (mm-mailcap-command
- method file (mm-handle-type handle)))
- (require 'term)
- (require 'gnus-win)
- (set-buffer
- (setq buffer
- (make-term "display"
- shell-file-name
- nil
- shell-command-switch
- (mm-mailcap-command
- method file
- (mm-handle-type handle)))))
- (term-mode)
- (term-char-mode)
- (set-process-sentinel
- (get-buffer-process buffer)
- `(lambda (process state)
- (if (eq 'exit (process-status process))
- (gnus-configure-windows
- ',gnus-current-window-configuration))))
- (gnus-configure-windows 'display-term))
- (mm-handle-set-external-undisplayer handle (cons file buffer)))
- (message "Displaying %s..." (format method file))
+ (let ((command (mm-mailcap-command
+ method file (mm-handle-type handle))))
+ (unwind-protect
+ (if window-system
+ (start-process "*display*" nil
+ mm-external-terminal-program
+ "-e" shell-file-name
+ shell-command-switch command)
+ (require 'term)
+ (require 'gnus-win)
+ (set-buffer
+ (setq buffer
+ (make-term "display"
+ shell-file-name
+ nil
+ shell-command-switch command)))
+ (term-mode)
+ (term-char-mode)
+ (set-process-sentinel
+ (get-buffer-process buffer)
+ `(lambda (process state)
+ (if (eq 'exit (process-status process))
+ (gnus-configure-windows
+ ',gnus-current-window-configuration))))
+ (gnus-configure-windows 'display-term))
+ (mm-handle-set-external-undisplayer handle (cons file buffer)))
+ (message "Displaying %s..." command))
'external)
(copiousoutput
(with-current-buffer outbuf
(ignore-errors (kill-buffer buffer))))))
'inline)
(t
- (unwind-protect
- (start-process "*display*"
- (setq buffer
- (generate-new-buffer " *mm*"))
- shell-file-name
- shell-command-switch
- (mm-mailcap-command
- method file (mm-handle-type handle)))
- (mm-handle-set-external-undisplayer
- handle (cons file buffer)))
- (message "Displaying %s..." (format method file))
+ (let ((command (mm-mailcap-command
+ method file (mm-handle-type handle))))
+ (unwind-protect
+ (start-process "*display*"
+ (setq buffer
+ (generate-new-buffer " *mm*"))
+ shell-file-name
+ shell-command-switch command)
+ (mm-handle-set-external-undisplayer
+ handle (cons file buffer)))
+ (message "Displaying %s..." command))
'external)))))))
(defun mm-mailcap-command (method file type-list)
(beg 0)
(uses-stdin t)
out sub total)
- (while (string-match "%{\\([^}]+\\)}\\|%s\\|%t\\|%%" method beg)
+ (while (string-match "%{\\([^}]+\\)}\\|'%s'\\|\"%s\"\\|%s\\|%t\\|%%"
+ method beg)
(push (substring method beg (match-beginning 0)) out)
(setq beg (match-end 0)
total (match-string 0 method)
(cond
((string= total "%%")
(push "%" out))
- ((string= total "%s")
+ ((or (string= total "%s")
+ ;; We do our own quoting.
+ (string= total "'%s'")
+ (string= total "\"%s\""))
(setq uses-stdin nil)
(push (mm-quote-arg
(gnus-map-function mm-path-name-rewrite-functions file)) out))
"Return a safer but similar encoding."
(cond
((memq encoding '(7bit 8bit quoted-printable)) 'quoted-printable)
- ;; The remaing encodings are binary and base64 (and perhaps some
+ ;; The remaining encodings are binary and base64 (and perhaps some
;; non-standard ones), which are both turned into base64.
(t 'base64)))
(defun mm-url-insert-file-contents (url)
(if mm-url-use-external
- (if (string-match "^file:/+" url)
- (insert-file-contents (substring url (1- (match-end 0))))
- (mm-url-insert-file-contents-external url))
+ (progn
+ (if (string-match "^file:/+" url)
+ (insert-file-contents (substring url (1- (match-end 0))))
+ (mm-url-insert-file-contents-external url))
+ (goto-char (point-min))
+ (list url (buffer-size)))
(mm-url-load-url)
(let ((name buffer-file-name)
(url-package-name (or mm-url-package-name
;;; mm-util.el --- Utility functions for Mule and low level things
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(coding-system-list . ignore)
(decode-coding-region . ignore)
(char-int . identity)
- (device-type . ignore)
(coding-system-equal . equal)
(annotationp . ignore)
(set-buffer-file-coding-system . ignore)
(setq idx (1+ idx)))
string)))
(string-as-unibyte . identity)
+ (string-make-unibyte . identity)
(string-as-multibyte . identity)
(multibyte-string-p . ignore))))
mm-iso-8859-15-compatible))
"A table of the difference character between ISO-8859-X and ISO-8859-15.")
-(defcustom mm-coding-system-priorities nil
+(defcustom mm-coding-system-priorities
+ (if (boundp 'current-language-environment)
+ (let ((lang (symbol-value 'current-language-environment)))
+ (cond ((string= lang "Japanese")
+ ;; Japanese users may prefer iso-2022-jp to shift-jis.
+ '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis
+ iso-latin-1 utf-8)))))
"Preferred coding systems for encoding outgoing mails.
More than one suitable coding systems may be found for some texts. By
default, a coding system with the highest priority is used to encode
outgoing mails (see `sort-coding-systems'). If this variable is set,
-it overrides the default priority. For example, Japanese users may
-prefer iso-2022-jp to japanese-shift-jis:
-
-\(setq mm-coding-system-priorities
- '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis iso-latin-1 utf-8))
-"
- :type '(repeat (coding-system :tag "Coding system"))
+it overrides the default priority."
+ :type '(repeat (symbol :tag "Coding system"))
:group 'mime)
(defvar mm-use-find-coding-systems-region
(autoload 'binhex-decode-region-external "binhex")
(autoload 'binhex-decode-region-internal "binhex")
+(autoload 'yenc-decode-region "yenc")
+(autoload 'yenc-extract-filename "yenc")
+
(defcustom mm-uu-decode-function 'uudecode-decode-region
"*Function to uudecode.
Internal function is done in Lisp by default, therefore decoding may
(function-item :tag "External" binhex-decode-region-external))
:group 'gnus-article-mime)
+(defvar mm-uu-yenc-decode-function 'yenc-decode-region)
+
(defvar mm-uu-pgp-beginning-signature
"^-----BEGIN PGP SIGNATURE-----")
mm-uu-binhex-extract
nil
mm-uu-binhex-filename)
+ (yenc
+ "^=ybegin.*size=[0-9]+.*name=.*$"
+ "^=yend.*size=[0-9]+"
+ mm-uu-yenc-extract
+ mm-uu-yenc-filename)
(shar
"^#! */bin/sh"
"^exit 0$"
nil
mm-uu-emacs-sources-test)))
-(defcustom mm-uu-configure-list nil
+(defcustom mm-uu-configure-list '((shar . disabled))
"A list of mm-uu configuration.
To disable dissecting shar codes, for instance, add
`(shar . disabled)' to this list."
(ignore-errors
(binhex-decode-region start-point end-point t))))
+(defun mm-uu-yenc-filename ()
+ (goto-char start-point)
+ (setq file-name
+ (ignore-errors
+ (yenc-extract-filename))))
+
(defun mm-uu-forward-test ()
(save-excursion
(goto-char start-point)
(list mm-dissect-disposition
(cons 'filename file-name)))))
+(defun mm-uu-yenc-extract ()
+ (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+ (list (or (and file-name
+ (string-match "\\.[^\\.]+$" file-name)
+ (mailcap-extension-to-mime
+ (match-string 0 file-name)))
+ "application/octet-stream"))
+ 'x-yenc nil
+ (if (and file-name (not (equal file-name "")))
+ (list mm-dissect-disposition
+ (cons 'filename file-name)))))
+
+
(defun mm-uu-shar-extract ()
(mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
'("application/x-shar")))
(defvar mm-text-html-renderer-alist
'((w3 . mm-inline-text-html-render-with-w3)
(w3m . mm-inline-text-html-render-with-w3m)
+ (w3m-standalone mm-inline-render-with-stdin nil
+ "w3m" "-dump" "-T" "text/html")
(links mm-inline-render-with-file
mm-links-remove-leading-blank
"links" "-dump" file)
(defvar mm-text-html-washer-alist
'((w3 . gnus-article-wash-html-with-w3)
(w3m . gnus-article-wash-html-with-w3m)
+ (w3m-standalone mm-inline-render-with-stdin nil
+ "w3m" "-dump" "-T" "text/html")
(links mm-inline-wash-with-file
mm-links-remove-leading-blank
"links" "-dump" file)
(delete-region ,(point-min-marker)
,(point-max-marker)))))))))
-(defvar mm-w3m-mode-map nil
- "Local keymap for inlined text/html part rendered by emacs-w3m. It will
-be different from `w3m-mode-map' to use in the article buffer.")
-
-(defvar mm-w3m-mode-command-alist
- '((backward-char)
- (describe-mode)
- (forward-char)
- (goto-line)
- (next-line)
- (previous-line)
- (w3m-antenna)
- (w3m-antenna-add-current-url)
- (w3m-bookmark-add-current-url)
- (w3m-bookmark-add-this-url)
- (w3m-bookmark-view)
- (w3m-close-window)
- (w3m-copy-buffer)
- (w3m-delete-buffer)
- (w3m-dtree)
- (w3m-edit-current-url)
- (w3m-edit-this-url)
- (w3m-gohome)
- (w3m-goto-url)
- (w3m-goto-url-new-session)
- (w3m-history)
- (w3m-history-restore-position)
- (w3m-history-store-position)
- (w3m-namazu)
- (w3m-next-buffer)
- (w3m-previous-buffer)
- (w3m-quit)
- (w3m-redisplay-with-charset)
- (w3m-reload-this-page)
- (w3m-scroll-down-or-previous-url)
- (w3m-scroll-up-or-next-url)
- (w3m-search)
- (w3m-select-buffer)
- (w3m-switch-buffer)
- (w3m-view-header)
- (w3m-view-parent-page)
- (w3m-view-previous-page)
- (w3m-view-source)
- (w3m-weather))
- "Alist of commands to use for emacs-w3m in the article buffer. Each
-element looks like (FROM-COMMAND . TO-COMMAND); FROM-COMMAND should be
-registered in `w3m-mode-map' which will be substituted by TO-COMMAND
-in `mm-w3m-mode-map'. If TO-COMMAND is nil, an article command key
-will not be substituted.")
-
-(defvar mm-w3m-mode-dont-bind-keys (list [up] [right] [left] [down])
- "List of keys which should not be bound for the emacs-w3m commands.")
-
(defvar mm-w3m-setup nil
"Whether gnus-article-mode has been setup to use emacs-w3m.")
"Setup gnus-article-mode to use emacs-w3m."
(unless mm-w3m-setup
(require 'w3m)
- (unless mm-w3m-mode-map
- (setq mm-w3m-mode-map (copy-keymap w3m-mode-map))
- (dolist (def mm-w3m-mode-command-alist)
- (condition-case nil
- (substitute-key-definition (car def) (cdr def) mm-w3m-mode-map)
- (error)))
- (dolist (key mm-w3m-mode-dont-bind-keys)
- (condition-case nil
- (define-key mm-w3m-mode-map key nil)
- (error))))
(unless (assq 'gnus-article-mode w3m-cid-retrieve-function-alist)
(push (cons 'gnus-article-mode 'mm-w3m-cid-retrieve)
w3m-cid-retrieve-function-alist))
(mm-insert-part handle)
(throw 'found-handle (mm-handle-media-type handle)))))))
+(eval-and-compile
+ (unless (or (featurep 'xemacs)
+ (>= emacs-major-version 21))
+ (defvar mm-w3m-mode-map nil
+ "Keymap for text/html part rendered by `mm-w3m-preview-text/html'.
+This map is overwritten by `mm-w3m-local-map-property' based on the
+value of `w3m-minor-mode-map'. Therefore, in order to add some
+commands to this map, add them to `w3m-minor-mode-map' instead of this
+map.")))
+
+(defun mm-w3m-local-map-property ()
+ (when (and (boundp 'w3m-minor-mode-map) w3m-minor-mode-map)
+ (if (or (featurep 'xemacs)
+ (>= emacs-major-version 21))
+ (list 'keymap w3m-minor-mode-map)
+ (list 'local-map
+ (or mm-w3m-mode-map
+ (progn
+ (setq mm-w3m-mode-map (copy-keymap w3m-minor-mode-map))
+ (set-keymap-parent mm-w3m-mode-map gnus-article-mode-map)
+ mm-w3m-mode-map))))))
+
(defun mm-inline-text-html-render-with-w3m (handle)
"Render a text/html part using emacs-w3m."
(mm-setup-w3m)
(when mm-inline-text-html-with-w3m-keymap
(add-text-properties
(point-min) (point-max)
- (append '(mm-inline-text-html-with-w3m t)
- (gnus-local-map-property mm-w3m-mode-map)))))
+ (nconc (mm-w3m-local-map-property)
+ '(mm-inline-text-html-with-w3m t)))))
(mm-handle-set-undisplayer
handle
`(lambda ()
(defvar mml-default-encrypt-method (caar mml-encrypt-alist)
"Default encryption method.")
-(defvar mml-signencrypt-style-alist
+(defcustom mml-signencrypt-style-alist
'(("smime" separate)
("pgp" separate)
("pgpmime" separate))
- "Alist specifying whether or not a single sign & encrypt
-operation should be perfomed when requesting signencrypt.
-Note that combined sign & encrypt is NOT supported by pgp v2!
-Also note that you should access this with mml-signencrypt-style")
-
+ "Alist specifying if `signencrypt' results in two separate operations or not.
+The first entry indicates the MML security type, valid entries include
+the strings \"smime\", \"pgp\", and \"pgpmime\". The second entry is
+a symbol `separate' or `combined' where `separate' means that MML signs
+and encrypt messages in a two step process, and `combined' means that MML
+signs and encrypt the message in one step.
+Note that the `combined' mode is NOT supported by all OpenPGP implementations,
+in particular PGP version 2 does not support it!"
+ :type '(repeat (list (choice (const :tag "S/MIME" "smime")
+ (const :tag "PGP" "pgp")
+ (const :tag "PGP/MIME" "pgpmime")
+ (string :tag "User defined"))
+ (choice (const :tag "Separate" separate)
+ (const :tag "Combined" combined)))))
+
;;; Configuration/helper functions
(defun mml-signencrypt-style (method &optional style)
"Function for setting/getting the signencrypt-style used. Takes two
arguments, the method (e.g. \"pgp\") and optionally the mode
-(e.g. combined). If the mode is omitted, the current value is returned.
+\(e.g. combined). If the mode is omitted, the current value is returned.
For example, if you prefer to use combined sign & encrypt with
smime, putting the following in your Gnus startup file will
enable that behavior:
- (mml-set-signencrypt-style \"smime\" combined)"
+\(mml-set-signencrypt-style \"smime\" combined)
+
+You can also customize or set `mml-signencrypt-style-alist' instead."
(let ((style-item (assoc method mml-signencrypt-style-alist)))
(if style-item
(if (or (eq style 'separate)
(or (mml-smime-sign cont)
(error "Signing failed... inspect message logs for errors")))
-(defun mml-smime-encrypt-buffer (cont)
+(defun mml-smime-encrypt-buffer (cont &optional sign)
+ (when sign
+ (message "Combined sign and encrypt S/MIME not support yet")
+ (sit-for 1))
(or (mml-smime-encrypt cont)
(error "Encryption failed... inspect message logs for errors")))
(or (mml1991-sign cont)
(error "Signing failed... inspect message logs for errors")))
-(defun mml-pgp-encrypt-buffer (cont)
- (or (mml1991-encrypt cont)
+(defun mml-pgp-encrypt-buffer (cont &optional sign)
+ (or (mml1991-encrypt cont sign)
(error "Encryption failed... inspect message logs for errors")))
(defun mml-pgpmime-sign-buffer (cont)
;;; mml.el --- A package for parsing and validating MML documents
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
(let* (secure-mode
(taginfo (mml-read-tag))
(recipients (cdr (assq 'recipients taginfo)))
+ (sender (cdr (assq 'sender taginfo)))
(location (cdr (assq 'tag-location taginfo)))
(mode (cdr (assq 'mode taginfo)))
(method (cdr (assq 'method taginfo)))
(setq tags (list "sign" method "encrypt" method))))
(eval `(mml-insert-tag ,secure-mode
,@tags
- ,(if recipients 'recipients)
- ,recipients))
+ ,(if recipients "recipients")
+ ,recipients
+ ,(if sender "sender")
+ ,sender))
;; restart the parse
(goto-char location)))
((looking-at "<#multipart")
"Return the buffer up till the next part, multipart or closing part or multipart.
If MML is non-nil, return the buffer up till the correspondent mml tag."
(let ((beg (point)) (count 1))
- ;; If the tag ended at the end of the line, we go to the next line.
+ ;; If the tag ended at the end of the line, we go to the next line.
(when (looking-at "[ \t]*\n")
(forward-line 1))
(if mml
;; ignore 0x1b, it is part of iso-2022-jp
(setq encoding (mm-body-7-or-8))))
(t
+ ;; Only perform format=flowed filling on text/plain
+ ;; parts where there either isn't a format parameter
+ ;; in the mml tag or it says "flowed" and there
+ ;; actually are hard newlines in the text.
+ (let (use-hard-newlines)
+ (when (and (string= type "text/plain")
+ (or (null (assq 'format cont))
+ (string= (cdr (assq 'format cont))
+ "flowed"))
+ (setq use-hard-newlines
+ (text-property-any
+ (point-min) (point-max) 'hard 't)))
+ (fill-flowed-encode)
+ ;; Indicate that `mml-insert-mime-headers' should
+ ;; insert a "; format=flowed" string unless the
+ ;; user has already specified it.
+ (setq flowed (null (assq 'format cont)))))
(setq charset (mm-encode-body charset))
(setq encoding (mm-body-encoding
charset (cdr (assq 'encoding cont))))))
- ;; Only perform format=flowed filling on text/plain
- ;; parts where there either isn't a format parameter
- ;; in the mml tag or it says "flowed" and there
- ;; actually are hard newlines in the text.
- (let (use-hard-newlines)
- (when (and (string= type "text/plain")
- (or (null (assq 'format cont))
- (string= (cdr (assq 'format cont))
- "flowed"))
- (setq use-hard-newlines
- (text-property-any
- (point-min) (point-max) 'hard 't)))
- (fill-flowed-encode)
- ;; Indicate that `mml-insert-mime-headers' should
- ;; insert a "; format=flowed" string unless the
- ;; user has already specified it.
- (setq flowed (null (assq 'format cont)))))
(setq coded (buffer-string)))
(mml-insert-mime-headers cont type charset encoding flowed)
(insert "\n")
(defvar mml-mode-map
(let ((sign (make-sparse-keymap))
(encrypt (make-sparse-keymap))
+ (signpart (make-sparse-keymap))
+ (encryptpart (make-sparse-keymap))
(map (make-sparse-keymap))
(main (make-sparse-keymap)))
(define-key sign "p" 'mml-secure-message-sign-pgpmime)
(define-key sign "o" 'mml-secure-message-sign-pgp)
(define-key sign "s" 'mml-secure-message-sign-smime)
+ (define-key signpart "p" 'mml-secure-sign-pgpmime)
+ (define-key signpart "o" 'mml-secure-sign-pgp)
+ (define-key signpart "s" 'mml-secure-sign-smime)
(define-key encrypt "p" 'mml-secure-message-encrypt-pgpmime)
(define-key encrypt "o" 'mml-secure-message-encrypt-pgp)
(define-key encrypt "s" 'mml-secure-message-encrypt-smime)
+ (define-key encryptpart "p" 'mml-secure-encrypt-pgpmime)
+ (define-key encryptpart "o" 'mml-secure-encrypt-pgp)
+ (define-key encryptpart "s" 'mml-secure-encrypt-smime)
(define-key map "\C-n" 'mml-unsecure-message)
(define-key map "f" 'mml-attach-file)
(define-key map "b" 'mml-attach-buffer)
(define-key map "v" 'mml-validate)
(define-key map "P" 'mml-preview)
(define-key map "s" sign)
+ (define-key map "S" signpart)
(define-key map "c" encrypt)
+ (define-key map "C" encryptpart)
;;(define-key map "n" 'mml-narrow-to-part)
;; `M-m' conflicts with `back-to-indentation'.
;; (define-key main "\M-m" map)
(easy-menu-define
mml-menu mml-mode-map ""
`("Attachments"
- ["Attach File" mml-attach-file
+ ["Attach File..." mml-attach-file
,@(if (featurep 'xemacs) '(t)
'(:help "Attach a file at point"))]
- ["Attach Buffer" mml-attach-buffer t]
- ["Attach External" mml-attach-external t]
- ["Insert Part" mml-insert-part t]
- ["Insert Multipart" mml-insert-multipart t]
+ ["Attach Buffer..." mml-attach-buffer t]
+ ["Attach External..." mml-attach-external t]
+ ["Insert Part..." mml-insert-part t]
+ ["Insert Multipart..." mml-insert-multipart t]
["PGP/MIME Sign" mml-secure-message-sign-pgpmime t]
["PGP/MIME Encrypt" mml-secure-message-encrypt-pgpmime t]
["PGP Sign" mml-secure-message-sign-pgp t]
["PGP Encrypt" mml-secure-message-encrypt-pgp t]
["S/MIME Sign" mml-secure-message-sign-smime t]
["S/MIME Encrypt" mml-secure-message-encrypt-smime t]
+ ("Secure MIME part"
+ ["PGP/MIME Sign Part" mml-secure-sign-pgpmime t]
+ ["PGP/MIME Encrypt Part" mml-secure-encrypt-pgpmime t]
+ ["PGP Sign Part" mml-secure-sign-pgp t]
+ ["PGP Encrypt Part" mml-secure-encrypt-pgp t]
+ ["S/MIME Sign Part" mml-secure-sign-smime t]
+ ["S/MIME Encrypt Part" mml-secure-encrypt-smime t])
["Encrypt/Sign off" mml-unsecure-message t]
;;["Narrow" mml-narrow-to-part t]
["Quote MML" mml-quote-region t]
(defun mml-minibuffer-read-file (prompt)
(let ((file (read-file-name prompt nil nil t)))
- ;; Prevent some common errors. This is inspired by similar code in
+ ;; Prevent some common errors. This is inspired by similar code in
;; VM.
(when (file-directory-p file)
(error "%s is a directory, cannot attach" file))
(when value
;; Quote VALUE if it contains suspicious characters.
(when (string-match "[\"'\\~/*;() \t\n]" value)
- (setq value (prin1-to-string value)))
+ (setq value (with-output-to-string
+ (let (print-escape-nonascii)
+ (prin1 value)))))
(insert (format " %s=%s" key value)))))
(insert ">\n"))
(mml-insert-tag 'part 'type type 'disposition "inline")
(forward-line -1))
+(defun mml-preview-insert-mft ()
+ "Insert a Mail-Followup-To header before previewing an article.
+Should be adopted if code in `message-send-mail' is changed."
+ (when (and (message-mail-p)
+ (message-subscribed-p)
+ (not (mail-fetch-field "mail-followup-to"))
+ (message-make-mft))
+ (message-position-on-field "Mail-Followup-To" "X-Draft-From")
+ (insert (message-make-mft))))
+
(defun mml-preview (&optional raw)
"Display current buffer with Gnus, in a new buffer.
If RAW, don't highlight the article."
(save-excursion
(let* ((buf (current-buffer))
(message-options message-options)
+ (message-this-is-mail (message-mail-p))
(message-this-is-news (message-news-p))
(message-posting-charset (or (gnus-setup-posting-charset
(save-restriction
"*MIME preview of ") (buffer-name))))
(erase-buffer)
(insert-buffer buf)
+ (mml-preview-insert-mft)
(let ((message-deletable-headers (if (message-news-p)
nil
message-deletable-headers)))
;;; Commentary:
-;; RCS: $Id: mml1991.el,v 1.1.1.3 2002-08-06 12:41:35 yamaoka Exp $
+;; RCS: $Id: mml1991.el,v 1.1.1.4 2003-01-14 05:36:30 yamaoka Exp $
;;; Code:
'((mailcrypt mml1991-mailcrypt-sign
mml1991-mailcrypt-encrypt)
(gpg mml1991-gpg-sign
- mml1991-gpg-encrypt))
+ mml1991-gpg-encrypt)
+ (pgg mml1991-pgg-sign
+ mml1991-pgg-encrypt))
"Alist of PGP functions.")
;;; mailcrypt wrapper
(insert-buffer signature)
(goto-char (point-max)))))
-(defun mml1991-mailcrypt-encrypt (cont)
+(defun mml1991-mailcrypt-encrypt (cont &optional sign)
(let ((text (current-buffer))
+ (mc-pgp-always-sign
+ (or mc-pgp-always-sign
+ sign
+ (eq t (or (message-options-get 'message-sign-encrypt)
+ (message-options-set
+ 'message-sign-encrypt
+ (or (y-or-n-p "Sign the message? ")
+ 'not))))
+ 'never))
cipher
(result-buffer (get-buffer-create "*GPG Result*")))
;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
(insert-buffer signature)
(goto-char (point-max)))))
-(defun mml1991-gpg-encrypt (cont)
+(defun mml1991-gpg-encrypt (cont &optional sign)
(let ((text (current-buffer))
cipher
(result-buffer (get-buffer-create "*GPG Result*")))
(kill-region (point-min) (point))))
(mm-with-unibyte-current-buffer-mule4
(with-temp-buffer
- (unless (gpg-sign-encrypt
- text (setq cipher (current-buffer))
- result-buffer
- (split-string
- (or
- (message-options-get 'message-recipients)
- (message-options-set 'message-recipients
- (read-string "Recipients: ")))
- "[ \f\t\n\r\v,]+")
- nil
- (message-options-get 'message-sender)
- t t) ; armor & textmode
- (unless (> (point-max) (point-min))
- (pop-to-buffer result-buffer)
- (error "Encrypt error")))
+ (flet ((gpg-encrypt-func
+ (sign plaintext ciphertext result recipients &optional
+ passphrase sign-with-key armor textmode)
+ (if sign
+ (gpg-sign-encrypt
+ plaintext ciphertext result recipients passphrase
+ sign-with-key armor textmode)
+ (gpg-encrypt
+ plaintext ciphertext result recipients passphrase
+ armor textmode))))
+ (unless (gpg-encrypt-func
+ sign
+ text (setq cipher (current-buffer))
+ result-buffer
+ (split-string
+ (or
+ (message-options-get 'message-recipients)
+ (message-options-set 'message-recipients
+ (read-string "Recipients: ")))
+ "[ \f\t\n\r\v,]+")
+ nil
+ (message-options-get 'message-sender)
+ t t) ; armor & textmode
+ (unless (> (point-max) (point-min))
+ (pop-to-buffer result-buffer)
+ (error "Encrypt error"))))
(goto-char (point-min))
(while (re-search-forward "\r+$" nil t)
(replace-match "" t t))
(insert-buffer cipher)
(goto-char (point-max))))))
+;; pgg wrapper
+
+(defvar pgg-output-buffer)
+(defvar pgg-errors-buffer)
+
+(defun mml1991-pgg-sign (cont)
+ (let (headers)
+ ;; Don't sign headers.
+ (goto-char (point-min))
+ (while (not (looking-at "^$"))
+ (forward-line))
+ (unless (eobp) ;; no headers?
+ (setq headers (buffer-substring (point-min) (point)))
+ (forward-line) ;; skip header/body separator
+ (kill-region (point-min) (point)))
+ (quoted-printable-decode-region (point-min) (point-max))
+ (unless (let ((pgg-default-user-id
+ (or (message-options-get 'message-sender)
+ pgg-default-user-id)))
+ (pgg-sign-region (point-min) (point-max) t))
+ (pop-to-buffer pgg-errors-buffer)
+ (error "Encrypt error"))
+ (kill-region (point-min) (point-max))
+ (insert-buffer pgg-output-buffer)
+ (goto-char (point-min))
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" t t))
+ (quoted-printable-encode-region (point-min) (point-max))
+ (goto-char (point-min))
+ (if headers (insert headers))
+ (insert "\n")
+ t))
+
+(defun mml1991-pgg-encrypt (cont &optional sign)
+ (let (headers)
+ ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
+ (goto-char (point-min))
+ (while (looking-at "^Content[^ ]+:") (forward-line))
+ (if (> (point) (point-min))
+ (progn
+ (kill-region (point-min) (point))))
+ (unless (pgg-encrypt-region
+ (point-min) (point-max)
+ (split-string
+ (or
+ (message-options-get 'message-recipients)
+ (message-options-set 'message-recipients
+ (read-string "Recipients: ")))
+ "[ \f\t\n\r\v,]+")
+ sign)
+ (pop-to-buffer pgg-errors-buffer)
+ (error "Encrypt error"))
+ (kill-region (point-min) (point-max))
+ ;;(insert "Content-Type: application/pgp-encrypted\n\n")
+ ;;(insert "Version: 1\n\n")
+ (insert "\n")
+ (insert-buffer pgg-output-buffer)
+ t))
+
;;;###autoload
-(defun mml1991-encrypt (cont)
+(defun mml1991-encrypt (cont &optional sign)
(let ((func (nth 2 (assq mml1991-use mml1991-function-alist))))
(if func
- (funcall func cont)
+ (funcall func cont sign)
(error "Cannot find encrypt function"))))
;;;###autoload
(eval-when-compile (require 'cl))
(require 'mm-decode)
+(require 'mm-util)
(defvar mml2015-use (or
(progn
(ignore-errors
+ (require 'pgg))
+ (and (fboundp 'pgg-sign-region)
+ 'pgg))
+ (progn
+ (ignore-errors
(require 'gpg))
(and (fboundp 'gpg-sign-detached)
'gpg))
mml2015-gpg-verify
mml2015-gpg-decrypt
mml2015-gpg-clear-verify
- mml2015-gpg-clear-decrypt))
+ mml2015-gpg-clear-decrypt)
+ (pgg mml2015-pgg-sign
+ mml2015-pgg-encrypt
+ mml2015-pgg-verify
+ mml2015-pgg-decrypt
+ mml2015-pgg-clear-verify
+ mml2015-pgg-clear-decrypt))
"Alist of PGP/MIME functions.")
(defvar mml2015-result-buffer nil)
-(defvar mml2015-trust-boundaries-alist
- '((trust-undefined . nil)
- (trust-none . nil)
- (trust-marginal . t)
- (trust-full . t)
- (trust-ultimate . t))
- "Trust boundaries for a signer's GnuPG key.
-This alist contains pairs of the form (trust-symbol . boolean), with
-symbols that are contained in `gpg-unabbrev-trust-alist'. The boolean
-specifies whether the given trust value is good enough to be trusted
-by you.")
+(defcustom mml2015-unabbrev-trust-alist
+ '(("TRUST_UNDEFINED" . nil)
+ ("TRUST_NEVER" . nil)
+ ("TRUST_MARGINAL" . t)
+ ("TRUST_FULLY" . t)
+ ("TRUST_ULTIMATE" . t))
+ "Map GnuPG trust output values to a boolean saying if you trust the key."
+ :type '(repeat (cons (regexp :tag "GnuPG output regexp")
+ (boolean :tag "Trust key"))))
;;; mailcrypt wrapper
(defun mml2015-gpg-extract-signature-details ()
(goto-char (point-min))
- (if (boundp 'gpg-unabbrev-trust-alist)
- (let* ((expired (re-search-forward
- "^\\[GNUPG:\\] SIGEXPIRED$"
- nil t))
- (signer (and (re-search-forward
- "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$"
- nil t)
- (cons (match-string 1) (match-string 2))))
- (fprint (and (re-search-forward
- "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) "
- nil t)
- (match-string 1)))
- (trust (and (re-search-forward
- "^\\[GNUPG:\\] \\(TRUST_.*\\)$"
- nil t)
- (match-string 1)))
- (trust-good-enough-p
- (cdr (assoc (cdr (assoc trust gpg-unabbrev-trust-alist))
- mml2015-trust-boundaries-alist))))
- (cond ((and signer fprint)
- (concat (cdr signer)
- (unless trust-good-enough-p
- (concat "\nUntrusted, Fingerprint: "
- (mml2015-gpg-pretty-print-fpr fprint)))
- (when expired
- (format "\nWARNING: Signature from expired key (%s)"
- (car signer)))))
- (t
- "From unknown user")))
- (if (re-search-forward "^gpg: Good signature from \"\\(.*\\)\"$" nil t)
- (match-string 1)
- "From unknown user")))
+ (let* ((expired (re-search-forward
+ "^\\[GNUPG:\\] SIGEXPIRED$"
+ nil t))
+ (signer (and (re-search-forward
+ "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$"
+ nil t)
+ (cons (match-string 1) (match-string 2))))
+ (fprint (and (re-search-forward
+ "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) "
+ nil t)
+ (match-string 1)))
+ (trust (and (re-search-forward
+ "^\\[GNUPG:\\] \\(TRUST_.*\\)$"
+ nil t)
+ (match-string 1)))
+ (trust-good-enough-p
+ (cdr (assoc trust mml2015-unabbrev-trust-alist))))
+ (cond ((and signer fprint)
+ (concat (cdr signer)
+ (unless trust-good-enough-p
+ (concat "\nUntrusted, Fingerprint: "
+ (mml2015-gpg-pretty-print-fpr fprint)))
+ (when expired
+ (format "\nWARNING: Signature from expired key (%s)"
+ (car signer)))))
+ ((re-search-forward
+ "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t)
+ (match-string 2))
+ (t
+ "From unknown user"))))
(defun mml2015-gpg-verify (handle ctl)
(catch 'error
(insert (format "--%s--\n" boundary))
(goto-char (point-max))))))
+;;; pgg wrapper
+
+(eval-when-compile
+ (defvar pgg-errors-buffer)
+ (defvar pgg-output-buffer))
+
+(eval-and-compile
+ (autoload 'pgg-decrypt-region "pgg")
+ (autoload 'pgg-verify-region "pgg")
+ (autoload 'pgg-sign-region "pgg")
+ (autoload 'pgg-encrypt-region "pgg"))
+
+(defun mml2015-pgg-decrypt (handle ctl)
+ (catch 'error
+ (let ((pgg-errors-buffer mml2015-result-buffer)
+ child handles result decrypt-status)
+ (unless (setq child (mm-find-part-by-type
+ (cdr handle)
+ "application/octet-stream" nil t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ (throw 'error handle))
+ (with-temp-buffer
+ (mm-insert-part child)
+ (if (condition-case err
+ (prog1
+ (pgg-decrypt-region (point-min) (point-max))
+ (setq decrypt-status
+ (with-current-buffer mml2015-result-buffer
+ (buffer-string)))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ decrypt-status))
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ nil))
+ (with-current-buffer pgg-output-buffer
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n" t t))
+ (setq handles (mm-dissect-buffer t))
+ (mm-destroy-parts handle)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (concat decrypt-status
+ (when (stringp (car handles))
+ "\n" (mm-handle-multipart-ctl-parameter
+ handles 'gnus-details))))
+ (if (listp (car handles))
+ handles
+ (list handles)))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed")
+ (throw 'error handle))))))
+
+(defun mml2015-pgg-clear-decrypt ()
+ (let ((pgg-errors-buffer mml2015-result-buffer))
+ (if (prog1
+ (pgg-decrypt-region (point-min) (point-max))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (with-current-buffer mml2015-result-buffer
+ (buffer-string))))
+ (progn
+ (erase-buffer)
+ (insert-buffer pgg-output-buffer)
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n" t t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK"))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed"))))
+
+(defun mml2015-pgg-verify (handle ctl)
+ (let ((pgg-errors-buffer mml2015-result-buffer)
+ signature-file part signature)
+ (if (or (null (setq part (mm-find-raw-part-by-type
+ ctl (or (mm-handle-multipart-ctl-parameter
+ ctl 'protocol)
+ "application/pgp-signature")
+ t)))
+ (null (setq signature (mm-find-part-by-type
+ (cdr handle) "application/pgp-signature" nil t))))
+ (progn
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ handle)
+ (with-temp-buffer
+ (insert part)
+ ;; Convert <LF> to <CR><LF> in verify mode. Sign and
+ ;; clearsign use --textmode. The conversion is not necessary.
+ ;; In clearverify, the conversion is not necessary either.
+ (goto-char (point-min))
+ (end-of-line)
+ (while (not (eobp))
+ (unless (eq (char-before) ?\r)
+ (insert "\r"))
+ (forward-line)
+ (end-of-line))
+ (with-temp-file (setq signature-file (mm-make-temp-file "pgg"))
+ (mm-insert-part signature))
+ (if (condition-case err
+ (prog1
+ (pgg-verify-region (point-min) (point-max)
+ signature-file t)
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n" t t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (concat (with-current-buffer pgg-output-buffer
+ (buffer-string))
+ (with-current-buffer pgg-errors-buffer
+ (buffer-string)))))
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ nil))
+ (progn
+ (delete-file signature-file)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info
+ (with-current-buffer pgg-errors-buffer
+ (mml2015-gpg-extract-signature-details))))
+ (delete-file signature-file)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed")))))
+ handle)
+
+(defun mml2015-pgg-clear-verify ()
+ (let ((pgg-errors-buffer mml2015-result-buffer)
+ (text (current-buffer)))
+ (if (condition-case err
+ (prog1
+ (mm-with-unibyte-buffer
+ (insert-buffer text)
+ (pgg-verify-region (point-min) (point-max) nil t))
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n" t t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (concat (with-current-buffer pgg-output-buffer
+ (buffer-string))
+ (with-current-buffer pgg-errors-buffer
+ (buffer-string)))))
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ nil))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info
+ (with-current-buffer pgg-errors-buffer
+ (mml2015-gpg-extract-signature-details)))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed"))))
+
+(defun mml2015-pgg-sign (cont)
+ (let ((pgg-errors-buffer mml2015-result-buffer)
+ (boundary (funcall mml-boundary-function (incf mml-multipart-number))))
+ (unless (pgg-sign-region (point-min) (point-max))
+ (pop-to-buffer mml2015-result-buffer)
+ (error "Sign error"))
+ (goto-char (point-min))
+ (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
+ boundary))
+ ;;; FIXME: what is the micalg?
+ (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n")
+ (insert (format "\n--%s\n" boundary))
+ (goto-char (point-max))
+ (insert (format "\n--%s\n" boundary))
+ (insert "Content-Type: application/pgp-signature\n\n")
+ (insert-buffer pgg-output-buffer)
+ (goto-char (point-max))
+ (insert (format "--%s--\n" boundary))
+ (goto-char (point-max))))
+
+(defun mml2015-pgg-encrypt (cont &optional sign)
+ (let ((pgg-errors-buffer mml2015-result-buffer)
+ (boundary (funcall mml-boundary-function (incf mml-multipart-number))))
+ (unless (pgg-encrypt-region (point-min) (point-max)
+ (split-string
+ (or
+ (message-options-get 'message-recipients)
+ (message-options-set 'message-recipients
+ (read-string "Recipients: ")))
+ "[ \f\t\n\r\v,]+")
+ sign)
+ (pop-to-buffer mml2015-result-buffer)
+ (error "Encrypt error"))
+ (delete-region (point-min) (point-max))
+ (goto-char (point-min))
+ (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
+ boundary))
+ (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
+ (insert (format "--%s\n" boundary))
+ (insert "Content-Type: application/pgp-encrypted\n\n")
+ (insert "Version: 1\n\n")
+ (insert (format "--%s\n" boundary))
+ (insert "Content-Type: application/octet-stream\n\n")
+ (insert-buffer pgg-output-buffer)
+ (goto-char (point-max))
+ (insert (format "--%s--\n" boundary))
+ (goto-char (point-max))))
+
;;; General wrapper
(defun mml2015-clean-buffer ()
(narrow-to-region
(goto-char (point-min))
(if (search-forward "\n\n" nil t) (1- (point)) (point-max))))
- ;; Fold continuation lines.
- (goto-char (point-min))
- (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " " t t))
- ;; Remove any tabs; they are too confusing.
- (subst-char-in-region (point-min) (point-max) ?\t ? )
- (let ((headers (nnheader-parse-head t)))
+ (let ((headers (nnheader-parse-naked-head)))
(mail-header-set-chars headers chars)
(mail-header-set-number headers number)
headers))))
(when (and (file-exists-p newest)
(let ((nnmail-file-coding-system
(if (file-newer-than-file-p file auto)
- (if (equal group "drafts")
+ (if (member group '("drafts" "delayed"))
message-draft-coding-system
mm-text-coding-system)
mm-auto-save-coding-system)))
;; If there's a mail header separator in this file,
;; we remove it.
(when (re-search-forward
- (concat "^" mail-header-separator "$") nil t)
+ (concat "^" (regexp-quote mail-header-separator) "$") nil t)
(replace-match "" t t)))
t))))
nil))))
t)
+(defun nndraft-generate-headers ()
+ (save-excursion
+ (message-generate-headers
+ (message-headers-to-generate
+ message-required-headers message-draft-headers nil))))
+
(deffoo nndraft-request-associate-buffer (group)
"Associate the current buffer with some article in the draft group."
(nndraft-open-server "")
(setq buffer-file-name (expand-file-name file)
buffer-auto-save-file-name (make-auto-save-file-name))
(clear-visited-file-modtime)
+ (make-local-variable 'write-contents-hooks)
+ (push 'nndraft-generate-headers write-contents-hooks)
article))
(deffoo nndraft-request-group (group &optional server dont-check)
(deffoo nndraft-request-replace-article (article group buffer)
(nndraft-possibly-change-group group)
(let ((nnmail-file-coding-system
- (if (equal group "drafts")
- mm-auto-save-coding-system
+ (if (member group '("drafts" "delayed"))
+ message-draft-coding-system
mm-text-coding-system)))
(nnoo-parent-function 'nndraft 'nnmh-request-replace-article
(list article group buffer))))
(if (search-forward "\n\n" e t) (setq e (1- (point)))))
(with-temp-buffer
(insert-buffer-substring buf b e)
- ;; Fold continuation lines.
- (goto-char (point-min))
- (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " " t t))
- ;; Remove any tabs; they are too confusing.
- (subst-char-in-region (point-min) (point-max) ?\t ? )
- (let ((headers (nnheader-parse-head t)))
+ (let ((headers (nnheader-parse-naked-head)))
(mail-header-set-chars headers chars)
(mail-header-set-number headers number)
headers)))))
(defvar nnheader-head-chop-length 2048
"*Length of each read operation when trying to fetch HEAD headers.")
-(defvar nnheader-file-name-translation-alist
+(defvar nnheader-file-name-translation-alist
(let ((case-fold-search t))
(cond
- ((string-match "windows-nt\\|os/2\\|emx\\|cygwin32"
+ ((string-match "windows-nt\\|os/2\\|emx\\|cygwin"
(symbol-name system-type))
(append (mapcar (lambda (c) (cons c ?_))
'(?: ?* ?\" ?< ?> ??))
- (if (string-match "windows-nt\\|cygwin32"
+ (if (string-match "windows-nt\\|cygwin"
(symbol-name system-type))
nil
'((?+ . ?-)))))
;; Parsing headers and NOV lines.
+(defsubst nnheader-remove-cr-followed-by-lf ()
+ (goto-char (point-max))
+ (while (search-backward "\r\n" nil t)
+ (delete-char 1)))
+
(defsubst nnheader-header-value ()
(skip-chars-forward " \t")
(buffer-substring (point) (gnus-point-at-eol)))
-(defun nnheader-parse-head (&optional naked)
+(defun nnheader-parse-naked-head (&optional number)
+ ;; This function unfolds continuation lines in this buffer
+ ;; destructively. When this side effect is unwanted, use
+ ;; `nnheader-parse-head' instead of this function.
(let ((case-fold-search t)
- (cur (current-buffer))
(buffer-read-only nil)
- in-reply-to lines p ref)
- (goto-char (point-min))
- (when naked
- (insert "\n"))
- ;; Search to the beginning of the next header. Error messages
- ;; do not begin with 2 or 3.
+ (cur (current-buffer))
+ (p (point-min))
+ in-reply-to lines ref)
+ (nnheader-remove-cr-followed-by-lf)
+ (ietf-drums-unfold-fws)
+ (subst-char-in-region (point-min) (point-max) ?\t ? )
+ (goto-char p)
+ (insert "\n")
(prog1
- (when (or naked (re-search-forward "^[23][0-9]+ " nil t))
- ;; This implementation of this function, with nine
- ;; search-forwards instead of the one re-search-forward and
- ;; a case (which basically was the old function) is actually
- ;; about twice as fast, even though it looks messier. You
- ;; can't have everything, I guess. Speed and elegance
- ;; don't always go hand in hand.
- (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 "<[^\n>]+>" in-reply-to))
- (let (ref2)
- (setq ref (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (while (string-match "<[^\n>]+>"
- in-reply-to (match-end 0))
- (setq ref2 (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (when (> (length ref2) (length ref))
- (setq ref ref2)))
- ref)
- nil)))
- ;; Chars.
- 0
- ;; Lines.
- (progn
- (goto-char p)
- (if (search-forward "\nlines: " nil t)
- (if (numberp (setq lines (read cur)))
- lines 0)
- 0))
- ;; Xref.
- (progn
- (goto-char p)
- (and (search-forward "\nxref:" nil t)
- (nnheader-header-value)))
-
- ;; Extra.
- (when nnmail-extra-headers
- (let ((extra nnmail-extra-headers)
- out)
- (while extra
- (goto-char p)
- (when (search-forward
- (concat "\n" (symbol-name (car extra)) ":") nil t)
- (push (cons (car extra) (nnheader-header-value))
- out))
- (pop extra))
- out))))
- (when naked
- (goto-char (point-min))
- (delete-char 1)))))
+ ;; This implementation of this function, with nine
+ ;; search-forwards instead of the one re-search-forward and a
+ ;; case (which basically was the old function) is actually
+ ;; about twice as fast, even though it looks messier. You
+ ;; can't have everything, I guess. Speed and elegance don't
+ ;; always go hand in hand.
+ (vector
+ ;; Number.
+ (or number 0)
+ ;; Subject.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nsubject:" nil t)
+ (nnheader-header-value) "(none)"))
+ ;; From.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nfrom:" nil t)
+ (nnheader-header-value) "(nobody)"))
+ ;; Date.
+ (progn
+ (goto-char p)
+ (if (search-forward "\ndate:" nil t)
+ (nnheader-header-value) ""))
+ ;; Message-ID.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nmessage-id:" nil t)
+ (buffer-substring
+ (1- (or (search-forward "<" (gnus-point-at-eol) t)
+ (point)))
+ (or (search-forward ">" (gnus-point-at-eol) t) (point)))
+ ;; If there was no message-id, we just fake one to make
+ ;; subsequent routines simpler.
+ (nnheader-generate-fake-message-id)))
+ ;; References.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nreferences:" nil t)
+ (nnheader-header-value)
+ ;; Get the references from the in-reply-to header if
+ ;; there were no references and the in-reply-to header
+ ;; looks promising.
+ (if (and (search-forward "\nin-reply-to:" nil t)
+ (setq in-reply-to (nnheader-header-value))
+ (string-match "<[^\n>]+>" in-reply-to))
+ (let (ref2)
+ (setq ref (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (while (string-match "<[^\n>]+>"
+ in-reply-to (match-end 0))
+ (setq ref2 (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (when (> (length ref2) (length ref))
+ (setq ref ref2)))
+ ref)
+ nil)))
+ ;; Chars.
+ 0
+ ;; Lines.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nlines: " nil t)
+ (if (numberp (setq lines (read cur)))
+ lines 0)
+ 0))
+ ;; Xref.
+ (progn
+ (goto-char p)
+ (and (search-forward "\nxref:" nil t)
+ (nnheader-header-value)))
+ ;; Extra.
+ (when nnmail-extra-headers
+ (let ((extra nnmail-extra-headers)
+ out)
+ (while extra
+ (goto-char p)
+ (when (search-forward
+ (concat "\n" (symbol-name (car extra)) ":") nil t)
+ (push (cons (car extra) (nnheader-header-value))
+ out))
+ (pop extra))
+ out)))
+ (goto-char p)
+ (delete-char 1))))
+
+(defun nnheader-parse-head (&optional naked)
+ (let ((cur (current-buffer)) num beg end)
+ (when (if naked
+ (setq num 0
+ beg (point-min)
+ end (point-max))
+ (goto-char (point-min))
+ ;; Search to the beginning of the next header. Error
+ ;; messages do not begin with 2 or 3.
+ (when (re-search-forward "^[23][0-9]+ " nil t)
+ (end-of-line)
+ (setq num (read cur)
+ beg (point)
+ end (if (search-forward "\n.\n" nil t)
+ (- (point) 2)
+ (point)))))
+ (with-temp-buffer
+ (insert-buffer-substring cur beg end)
+ (nnheader-parse-naked-head num)))))
(defmacro nnheader-nov-skip-field ()
'(search-forward "\t" eol 'move))
(point-max)))
(goto-char (point-min)))
+(defun nnheader-remove-body ()
+ "Remove the body from an article in this current buffer."
+ (goto-char (point-min))
+ (when (re-search-forward "\n\r?\n" nil t)
+ (delete-region (point) (point-max))))
+
(defun nnheader-set-temp-buffer (name &optional noerase)
"Set-buffer to an empty (possibly new) buffer called NAME with undo disabled."
(set-buffer (get-buffer-create name))
(defun nnheader-ms-strip-cr ()
"Strip ^M from the end of all lines."
(save-excursion
- (goto-char (point-min))
- (while (re-search-forward "\r$" nil t)
- (delete-backward-char 1))))
+ (nnheader-remove-cr-followed-by-lf)))
(defun nnheader-file-size (file)
"Return the file size of FILE or 0."
;;; nnimap.el --- imap backend for Gnus
-;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Jim Radford <radford@robby.caltech.edu>
;; o Split up big fetches (1,* header especially) in smaller chunks
;; o What do I do with gnus-newsgroup-*?
;; o Tell Gnus about new groups (how can we tell?)
-;; o Respooling (fix Gnus?) (unnecessery?)
+;; o Respooling (fix Gnus?) (unnecessary?)
;; o Add support for the following: (if applicable)
;; request-list-newsgroups, request-regenerate
;; list-active-group,
(functionp value))
(defcustom nnimap-split-rule nil
- "Mail will be split according to theese rules.
+ "Mail will be split according to these rules.
Mail is read from mailbox(es) specified in `nnimap-split-inbox'.
\(setq nnimap-split-rule '((\"INBOX.gnus-imap\" \"From:.*gnus-imap\")
(\"INBOX.junk\" \"Subject:.*buy\")))
-As you can see, `nnimap-split-rule' is a list of lists, where the first
-element in each \"rule\" is the name of the IMAP mailbox, and the
-second is a regexp that nnimap will try to match on the header to find
-a fit.
+As you can see, `nnimap-split-rule' is a list of lists, where the
+first element in each \"rule\" is the name of the IMAP mailbox (or the
+symbol `junk' if you want to remove the mail), and the second is a
+regexp that nnimap will try to match on the header to find a fit.
The second element can also be a function. In that case, it will be
called narrowed to the headers with the first element of the rule as
If this is 'imap-mailbox-lsub, then use a server-side subscription list to
restrict visible folders.")
+(defcustom nnimap-debug nil
+ "If non-nil, random debug spews are placed in *nnimap-debug* buffer."
+ :group 'nnimap
+ :type 'boolean)
+
;; Internal variables:
+(defvar nnimap-debug-buffer "*nnimap-debug*")
(defvar nnimap-mailbox-info (gnus-make-hashtable 997))
-(defvar nnimap-debug nil
- "Name of buffer to record debugging info.
-For example: (setq nnimap-debug \"*nnimap-debug*\")")
(defvar nnimap-current-move-server nil)
(defvar nnimap-current-move-group nil)
(defvar nnimap-current-move-article nil)
(defvar nnimap-progress-chars '(?| ?/ ?- ?\\))
(defvar nnimap-progress-how-often 20)
(defvar nnimap-counter)
-(defvar nnimap-callback-callback-function nil
- "Gnus callback the nnimap asynchronous callback should call.")
-(defvar nnimap-callback-buffer nil
- "Which buffer the asynchronous article prefetch callback should work in.")
(defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers.
(defvar nnimap-current-server nil) ;; Current server
(defvar nnimap-server-buffer nil) ;; Current servers' buffer
(imap-mailbox-unselect nnimap-server-buffer))))
(defun nnimap-find-minmax-uid (group &optional examine)
- "Find lowest and highest active article nummber in GROUP.
+ "Find lowest and highest active article number in GROUP.
If EXAMINE is non-nil the group is selected read-only."
(with-current-buffer nnimap-server-buffer
(when (or (string= group (imap-current-mailbox))
(with-temp-buffer
(buffer-disable-undo)
(insert headers)
- (nnheader-ms-strip-cr)
- (nnheader-fold-continuation-lines)
- (subst-char-in-region (point-min) (point-max) ?\t ? )
- (let ((head (nnheader-parse-head 'naked)))
+ (let ((head (nnheader-parse-naked-head)))
(mail-header-set-number head uid)
(mail-header-set-chars head chars)
(mail-header-set-lines head lines)
(with-current-buffer (get-buffer-create nnimap-server-buffer)
(nnoo-change-server 'nnimap server defs))
(or (and nnimap-server-buffer
- (imap-opened nnimap-server-buffer))
+ (imap-opened nnimap-server-buffer)
+ (if (with-current-buffer nnimap-server-buffer
+ (memq imap-state '(auth select examine)))
+ t
+ (imap-close nnimap-server-buffer)
+ (nnimap-open-connection server)))
(nnimap-open-connection server))))
(deffoo nnimap-server-opened (&optional server)
'identity)
(or string "")))
-(defun nnimap-callback ()
- (remove-hook 'imap-fetch-data-hook 'nnimap-callback)
- (with-current-buffer nnimap-callback-buffer
- (insert
- (with-current-buffer nnimap-server-buffer
- (nnimap-demule
- (if (imap-capability 'IMAP4rev1)
- ;; xxx don't just use car? alist doesn't contain
- ;; anything else now, but it might...
- (nth 2 (car (imap-message-get (imap-current-message) 'BODYDETAIL)))
- (imap-message-get (imap-current-message) 'RFC822)))))
- (nnheader-ms-strip-cr)
- (funcall nnimap-callback-callback-function t)))
+(defun nnimap-make-callback (article gnus-callback buffer)
+ "Return a callback function."
+ `(lambda ()
+ (nnimap-callback ,article ,gnus-callback ,buffer)))
+
+(defun nnimap-callback (article gnus-callback buffer)
+ (when (eq article (imap-current-message))
+ (remove-hook 'imap-fetch-data-hook
+ (nnimap-make-callback article gnus-callback buffer))
+ (with-current-buffer buffer
+ (insert
+ (with-current-buffer nnimap-server-buffer
+ (nnimap-demule
+ (if (imap-capability 'IMAP4rev1)
+ ;; xxx don't just use car? alist doesn't contain
+ ;; anything else now, but it might...
+ (nth 2 (car (imap-message-get article 'BODYDETAIL)))
+ (imap-message-get article 'RFC822)))))
+ (nnheader-ms-strip-cr)
+ (funcall gnus-callback t))))
(defun nnimap-request-article-part (article part prop &optional
group server to-buffer detail)
nnimap-server-buffer))
article)))
(when article
- (gnus-message 10 "nnimap: Fetching (part of) article %d..." article)
+ (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..."
+ article (or group imap-current-mailbox
+ gnus-newsgroup-name))
(if (not nnheader-callback-function)
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
(nth 2 (car data))
data))))
(nnheader-ms-strip-cr)
- (gnus-message 10 "nnimap: Fetching (part of) article %d...done"
- article)
+ (gnus-message
+ 10 "nnimap: Fetching (part of) article %d from %s...done"
+ article (or group imap-current-mailbox gnus-newsgroup-name))
(if (bobp)
- (nnheader-report 'nnimap "No such article: %s"
+ (nnheader-report 'nnimap "No such article %d in %s: %s"
+ article (or group imap-current-mailbox
+ gnus-newsgroup-name)
(imap-error-text nnimap-server-buffer))
(cons group article)))
- (add-hook 'imap-fetch-data-hook 'nnimap-callback)
- (setq nnimap-callback-callback-function nnheader-callback-function
- nnimap-callback-buffer nntp-server-buffer)
+ (add-hook 'imap-fetch-data-hook
+ (nnimap-make-callback article
+ nnheader-callback-function
+ nntp-server-buffer))
(imap-fetch-asynch article part nil nnimap-server-buffer)
(cons group article))))))
(nnheader-report 'nnimap "Group %s selected" group)
t)))))
+(defun nnimap-update-unseen (group &optional server)
+ "Update the unseen count in `nnimap-mailbox-info'."
+ (gnus-sethash
+ (gnus-group-prefixed-name group server)
+ (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server)
+ nnimap-mailbox-info)))
+ (list (nth 0 old) (nth 1 old)
+ (imap-mailbox-status group 'unseen nnimap-server-buffer)
+ (nth 3 old)))
+ nnimap-mailbox-info))
+
(defun nnimap-close-group (group &optional server)
(with-current-buffer nnimap-server-buffer
(when (and (imap-opened)
(nnimap-possibly-change-group group server))
+ (nnimap-update-unseen group server)
(case nnimap-expunge-on-close
(always (progn
(imap-mailbox-expunge nnimap-close-asynchronous)
(if (null nnimap-retrieve-groups-asynchronous)
(setq slowgroups groups)
(dolist (group groups)
- (gnus-message 7 "nnimap: Checking mailbox %s" group)
- (add-to-list (if (gnus-gethash-safe (concat server group)
- nnimap-mailbox-info)
+ (gnus-message 9 "nnimap: Quickly checking mailbox %s" group)
+ (add-to-list (if (gnus-gethash-safe
+ (gnus-group-prefixed-name group server)
+ nnimap-mailbox-info)
'asyncgroups
'slowgroups)
(list group (imap-mailbox-status-asynch
- group 'uidnext nnimap-server-buffer))))
+ group '(uidvalidity uidnext unseen)
+ nnimap-server-buffer))))
(dolist (asyncgroup asyncgroups)
(let ((group (nth 0 asyncgroup))
(tag (nth 1 asyncgroup))
new old)
(when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer))
- (if (nnimap-string-lessp-numerical
- (car (gnus-gethash
- (concat server group) nnimap-mailbox-info))
- (imap-mailbox-get 'uidnext group nnimap-server-buffer))
+ (if (or (not (string=
+ (nth 0 (gnus-gethash (gnus-group-prefixed-name
+ group server)
+ nnimap-mailbox-info))
+ (imap-mailbox-get 'uidvalidity group
+ nnimap-server-buffer)))
+ (not (string=
+ (nth 1 (gnus-gethash (gnus-group-prefixed-name
+ group server)
+ nnimap-mailbox-info))
+ (imap-mailbox-get 'uidnext group
+ nnimap-server-buffer))))
(push (list group) slowgroups)
- (insert (cdr (gnus-gethash (concat server group)
- nnimap-mailbox-info))))))))
+ (insert (nth 3 (gnus-gethash (gnus-group-prefixed-name
+ group server)
+ nnimap-mailbox-info))))))))
(dolist (group slowgroups)
(if nnimap-retrieve-groups-asynchronous
(setq group (car group)))
- (gnus-message 7 "nnimap: Rechecking mailbox %s" group)
+ (gnus-message 7 "nnimap: Mailbox %s modified" group)
(imap-mailbox-put 'uidnext nil group nnimap-server-buffer)
(or (member "\\NoSelect" (imap-mailbox-get 'list-flags group
nnimap-server-buffer))
(insert str)
(when nnimap-retrieve-groups-asynchronous
(gnus-sethash
- (concat server group)
- (cons (or (imap-mailbox-get
+ (gnus-group-prefixed-name group server)
+ (list (or (imap-mailbox-get
+ 'uidvalidity group nnimap-server-buffer)
+ (imap-mailbox-status
+ group 'uidvalidity nnimap-server-buffer))
+ (or (imap-mailbox-get
'uidnext group nnimap-server-buffer)
(imap-mailbox-status
group 'uidnext nnimap-server-buffer))
+ (or (imap-mailbox-get
+ 'unseen group nnimap-server-buffer)
+ (imap-mailbox-status
+ group 'unseen nnimap-server-buffer))
str)
nnimap-mailbox-info)))))))
(gnus-message 5 "nnimap: Checking mailboxes...done")
(when nnmail-cache-accepted-message-ids
(with-current-buffer nntp-server-buffer
(let (msgid)
- (and (setq msgid
+ (and (setq msgid
(nnmail-fetch-field "message-id"))
(nnmail-cache-insert msgid to-group)))))
;; Add the group-art list to the history list.
(defun nnimap-expiry-target (arts group server)
(unless (eq nnmail-expiry-target 'delete)
(with-temp-buffer
- (dolist (art (gnus-uncompress-sequence arts))
- (nnimap-request-article art group server (current-buffer))
+ (dolist (art arts)
+ (nnimap-request-article art group server (current-buffer))
;; hints for optimization in `nnimap-request-accept-article'
(let ((nnimap-current-move-article art)
(nnimap-current-move-group group)
(let ((artseq (gnus-compress-sequence articles)))
(when (and artseq (nnimap-possibly-change-group group server))
(with-current-buffer nnimap-server-buffer
- (if force
- (progn
- (nnimap-expiry-target artseq group server)
- (when (imap-message-flags-add (imap-range-to-message-set artseq)
- "\\Deleted")
- (setq articles nil)))
- (let ((days (or (and nnmail-expiry-wait-function
- (funcall nnmail-expiry-wait-function group))
- nnmail-expiry-wait)))
- (cond ((eq days 'immediate)
- (nnimap-expiry-target artseq group server)
- (when (imap-message-flags-add
- (imap-range-to-message-set artseq) "\\Deleted")
- (setq articles nil)))
- ((numberp days)
- (let ((oldarts (imap-search
- (format nnimap-expunge-search-string
- (imap-range-to-message-set artseq)
- (nnimap-date-days-ago days))))
- (imap-fetch-data-hook
- '(nnimap-request-expire-articles-progress)))
+ (let ((days (or (and nnmail-expiry-wait-function
+ (funcall nnmail-expiry-wait-function group))
+ nnmail-expiry-wait)))
+ (cond ((or force (eq days 'immediate))
+ (let ((oldarts (imap-search
+ (concat "UID "
+ (imap-range-to-message-set artseq)))))
+ (when oldarts
+ (nnimap-expiry-target oldarts group server)
+ (when (imap-message-flags-add
+ (imap-range-to-message-set
+ (gnus-compress-sequence oldarts)) "\\Deleted")
+ (setq articles (gnus-set-difference
+ articles oldarts))))))
+ ((numberp days)
+ (let ((oldarts (imap-search
+ (format nnimap-expunge-search-string
+ (imap-range-to-message-set artseq)
+ (nnimap-date-days-ago days))))
+ (imap-fetch-data-hook
+ '(nnimap-request-expire-articles-progress)))
+ (when oldarts
(nnimap-expiry-target oldarts group server)
- (and oldarts
- (imap-message-flags-add
- (imap-range-to-message-set
- (gnus-compress-sequence oldarts))
- "\\Deleted")
- (setq articles (gnus-set-difference
- articles oldarts)))))))))))
+ (when (imap-message-flags-add
+ (imap-range-to-message-set
+ (gnus-compress-sequence oldarts)) "\\Deleted")
+ (setq articles (gnus-set-difference
+ articles oldarts)))))))))))
;; return articles not deleted
articles)
(when nnimap-debug
(require 'trace)
- (buffer-disable-undo (get-buffer-create nnimap-debug))
- (mapcar (lambda (f) (trace-function-background f nnimap-debug))
+ (buffer-disable-undo (get-buffer-create nnimap-debug-buffer))
+ (mapcar (lambda (f) (trace-function-background f nnimap-debug-buffer))
'(
nnimap-possibly-change-server
nnimap-verify-uidvalidity
;;;
(defun nnlistserv-kk-create-mapping ()
- "Perform the search and create an number-to-url alist."
+ "Perform the search and create a number-to-url alist."
(save-excursion
(set-buffer nnweb-buffer)
(let ((case-fold-search t)
:group 'nnmail)
(defgroup nnmail-split nil
- "Organizing the incomming mail in folders."
+ "Organizing the incoming mail in folders."
:group 'nnmail)
(defgroup nnmail-files nil
:type 'boolean)
(defcustom nnmail-split-fancy-with-parent-ignore-groups nil
- "Regexp that matches group names to be ignored when applying
-`nnmail-split-fancy-with-parent'. This can also be a list of regexps."
+ "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'.
+This can also be a list of regexps."
:group 'nnmail-split
:type '(choice (const :tag "none" nil)
(regexp :value ".*")
(repeat :value (".*") regexp)))
(defcustom nnmail-cache-ignore-groups nil
- "Regexp that matches group names to be ignored when inserting message
-ids into the cache (`nnmail-cache-insert'). This can also be a list
-of regexps."
+ "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert').
+This can also be a list of regexps."
:group 'nnmail-split
:type '(choice (const :tag "none" nil)
(regexp :value ".*")
(setq head-end (point))
;; We try the Content-Length value. The idea: skip over the header
;; separator, then check what happens content-length bytes into the
- ;; message body. This should be either the end ot the buffer, the
+ ;; message body. This should be either the end of the buffer, the
;; message separator or a blank line followed by the separator.
;; The blank line should probably be deleted. If neither of the
;; three is met, the content-length header is probably invalid.
(defun nnmail-split-fancy ()
"Fancy splitting method.
-See the documentation for the variable `nnmail-split-fancy' for documentation."
+See the documentation for the variable `nnmail-split-fancy' for details."
(let ((syntab (syntax-table)))
(unwind-protect
(progn
;; Builtin : operation.
((eq (car split) ':)
+ (when nnmail-split-tracing
+ (push split nnmail-split-trace))
(nnmail-split-it (save-excursion (eval (cdr split)))))
;; Builtin ! operation.
(when (search-backward id nil t)
(beginning-of-line)
(skip-chars-forward "^\n\r\t")
- (unless (eolp)
+ (unless (looking-at "[\r\n]")
(forward-char 1)
(buffer-substring (point)
(progn (end-of-line) (point))))))))
(nnmail-cache-open))
(mapcar (lambda (x)
(setq res (or (nnmail-cache-fetch-group x) res))
- (when (or (string= "drafts" res)
+ (when (or (member res '("delayed" "drafts" "queue"))
(and regexp res (string-match regexp res)))
(setq res nil)))
references)
(when (nnheader-functionp target)
(setq target (funcall target group)))
(unless (eq target 'delete)
- (gnus-request-accept-article target nil nil t))))
+ (let ((group-art (gnus-request-accept-article target nil nil t)))
+ (when (consp group-art)
+ (gnus-group-mark-article-read target (cdr group-art)))))))
(defun nnmail-fancy-expiry-target (group)
"Returns a target expiry group determined by `nnmail-fancy-expiry-targets'."
;;; Commentary:
-;; Maildir format is documented in the maildir(5) man page from qmail
-;; (available at <URL:http://multivac.cwru.edu./prj/maildir.5>) and at
-;; <URL:http://cr.yp.to/proto/maildir.html>. nnmaildir also stores
+;; Maildir format is documented at <URL:http://cr.yp.to/proto/maildir.html>
+;; and in the maildir(5) man page from qmail (available at
+;; <URL:http://www.qmail.org/man/man5/maildir.html>). nnmaildir also stores
;; extra information in the .nnmaildir/ directory within a maildir.
;;
;; Some goals of nnmaildir:
-;; * Everything Just Works, and correctly. E.g., stale NOV data is
-;; ignored; no need for -generate-nov-databases.
-;; * Perfect reliability: [C-g] will never corrupt its data in memory,
-;; and SIGKILL will never corrupt its data in the filesystem.
+;; * Everything Just Works, and correctly. E.g., NOV data is automatically
+;; regenerated when stale; no need for manually running
+;; *-generate-nov-databases.
+;; * Perfect reliability: [C-g] will never corrupt its data in memory, and
+;; SIGKILL will never corrupt its data in the filesystem.
+;; * Allow concurrent operation as much as possible. If files change out
+;; from under us, adapt to the changes or degrade gracefully.
;; * We use the filesystem as a database, so that, e.g., it's easy to
;; manipulate marks from outside Gnus.
-;; * All information about a group is stored in the maildir, for easy
-;; backup, copying, restoring, etc.
+;; * All information about a group is stored in the maildir, for easy backup,
+;; copying, restoring, etc.
;;
;; Todo:
-;; * Don't force article renumbering, so nnmaildir can be used with
-;; the cache and agent. Alternatively, completely rewrite the Gnus
-;; backend interface, which would have other advantages as well.
-;;
-;; See also <URL:http://multivac.cwru.edu./nnmaildir/> until that
-;; information is added to the Gnus manual.
+;; * Merge the information from <URL:http://multivac.cwru.edu./nnmaildir/>
+;; into the Gnus manual.
+;; * Allow create-directory = ".", and configurable prefix of maildir names,
+;; stripped off to produce group names.
+;; * Add a hook for when moving messages from new/ to cur/, to support
+;; nnmail's duplicate detection.
+;; * Allow each mark directory in a group to have its own inode for mark
+;; files, to accommodate AFS.
+;; * Improve generated Xrefs, so crossposts are detectable.
+;; * Improve readability.
;;; Code:
+;; eval this before editing
+[(progn
+ (put 'nnmaildir--with-nntp-buffer 'lisp-indent-function 0)
+ (put 'nnmaildir--with-work-buffer 'lisp-indent-function 0)
+ (put 'nnmaildir--with-nov-buffer 'lisp-indent-function 0)
+ (put 'nnmaildir--with-move-buffer 'lisp-indent-function 0)
+ )
+]
+
(eval-and-compile
(require 'nnheader)
(require 'gnus)
;; A copy of nnmail-extra-headers
(defvar nnmaildir--extra nil)
-;; A disk NOV structure (must be prin1-able, so no defstruct) looks like this:
+;; A NOV structure looks like this (must be prin1-able, so no defstruct):
["subject\tfrom\tdate"
"references\tchars\lines"
"To: you\tIn-Reply-To: <your.mess@ge>"
(msgid nil :type string) ;; "<mess.age@id>"
(nov nil :type vector)) ;; cached nov structure, or nil
-(defstruct nnmaildir--lists
+(defstruct nnmaildir--grp
+ (name nil :type string) ;; "group.name"
+ (new nil :type list) ;; new/ modtime
+ (cur nil :type list) ;; cur/ modtime
+ (min 1 :type natnum) ;; minimum article number
+ (count 0 :type natnum) ;; count of articles
(nlist nil :type list) ;; list of articles, ordered descending by number
(flist nil :type vector) ;; obarray mapping filename prefix->article
- (mlist nil :type vector)) ;; obarray mapping message-id->article
-
-(defstruct nnmaildir--grp
- (name nil :type string) ;; "group.name"
- (new nil :type list) ;; new/ modtime
- (cur nil :type list) ;; cur/ modtime
- (lists nil :type nnmaildir--lists) ;; lists of articles in this group
- (cache nil :type vector) ;; nov cache
- (index nil :type natnum) ;; index of next cache entry to replace
- (mmth nil :type vector)) ;; obarray mapping mark name->dir modtime
+ (mlist nil :type vector) ;; obarray mapping message-id->article
+ (cache nil :type vector) ;; nov cache
+ (index nil :type natnum) ;; index of next cache entry to replace
+ (mmth nil :type vector)) ;; obarray mapping mark name->dir modtime
+ ; ("Mark Mod Time Hash")
(defstruct nnmaildir--srv
(address nil :type string) ;; server address string
(gnm nil) ;; flag: split from mail-sources?
(create-dir nil :type string)) ;; group creation directory
-(defmacro nnmaildir--nlist-last-num (nlist)
- `(let ((nlist ,nlist))
- (if nlist (nnmaildir--art-num (car nlist)) 0)))
-(defmacro nnmaildir--nlist-art (nlist num) ;;;; evals args multiple times
- `(and ,nlist
- (>= (nnmaildir--art-num (car ,nlist)) ,num)
- (nth (- (nnmaildir--art-num (car ,nlist)) ,num) ,nlist)))
+(defun nnmaildir--expired-article (group article)
+ (setf (nnmaildir--art-nov article) nil)
+ (let ((flist (nnmaildir--grp-flist group))
+ (mlist (nnmaildir--grp-mlist group))
+ (min (nnmaildir--grp-min group))
+ (count (1- (nnmaildir--grp-count group)))
+ (prefix (nnmaildir--art-prefix article))
+ (msgid (nnmaildir--art-msgid article))
+ (new-nlist nil)
+ (nlist-pre '(nil . nil))
+ nlist-post num)
+ (unless (zerop count)
+ (setq nlist-post (nnmaildir--grp-nlist group)
+ num (nnmaildir--art-num article))
+ (if (eq num (caar nlist-post))
+ (setq new-nlist (cdr nlist-post))
+ (setq new-nlist nlist-post
+ nlist-pre nlist-post
+ nlist-post (cdr nlist-post))
+ (while (/= num (caar nlist-post))
+ (setq nlist-pre nlist-post
+ nlist-post (cdr nlist-post)))
+ (setq nlist-post (cdr nlist-post))
+ (if (eq num min)
+ (setq min (caar nlist-pre)))))
+ (let ((inhibit-quit t))
+ (setf (nnmaildir--grp-min group) min)
+ (setf (nnmaildir--grp-count group) count)
+ (setf (nnmaildir--grp-nlist group) new-nlist)
+ (setcdr nlist-pre nlist-post)
+ (unintern prefix flist)
+ (unintern msgid mlist))))
+
+(defun nnmaildir--nlist-art (group num)
+ (let ((entry (assq num (nnmaildir--grp-nlist group))))
+ (if entry
+ (cdr entry))))
(defmacro nnmaildir--flist-art (list file)
`(symbol-value (intern-soft ,file ,list)))
(defmacro nnmaildir--mlist-art (list msgid)
gname)))
(defun nnmaildir--param (pgname param)
- (setq param (gnus-group-find-parameter pgname param 'allow-list)
- param (if (vectorp param) (aref param 0) param))
+ (setq param (gnus-group-find-parameter pgname param 'allow-list))
+ (if (vectorp param) (setq param (aref param 0)))
(eval param))
(defmacro nnmaildir--with-nntp-buffer (&rest body)
(defmacro nnmaildir--nndir (dir) `(nnmaildir--subdir ,dir ".nnmaildir"))
(defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov"))
(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks"))
+(defmacro nnmaildir--num-dir (dir) `(nnmaildir--subdir ,dir "num"))
+(defmacro nnmaildir--num-file (dir) `(concat ,dir ":"))
(defmacro nnmaildir--unlink (file-arg)
`(let ((file ,file-arg))
(defun nnmaildir--mkdir (dir)
(or (file-exists-p (file-name-as-directory dir))
(make-directory-internal (directory-file-name dir))))
-
+(defun nnmaildir--delete-dir-files (dir ls)
+ (mapcar 'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort))
+ (delete-directory dir))
+
+(defun nnmaildir--group-maxnum (server group)
+ (if (zerop (nnmaildir--grp-count group)) 0
+ (let ((x (nnmaildir--srvgrp-dir (nnmaildir--srv-dir server)
+ (nnmaildir--grp-name group))))
+ (setq x (nnmaildir--nndir x)
+ x (nnmaildir--num-dir x)
+ x (nnmaildir--num-file x)
+ x (file-attributes x))
+ (if x (1- (nth 1 x)) 0))))
+
+;; Make the given server, if non-nil, be the current server. Then make the
+;; given group, if non-nil, be the current group of the current server. Then
+;; return the group object for the current group.
(defun nnmaildir--prepare (server group)
(let (x groups)
(catch 'return
(if (null server)
- (or (setq server nnmaildir--cur-server)
- (throw 'return nil))
- (or (setq server (intern-soft server nnmaildir--servers))
+ (unless (setq server nnmaildir--cur-server)
(throw 'return nil))
+ (unless (setq server (intern-soft server nnmaildir--servers))
+ (throw 'return nil))
(setq server (symbol-value server)
nnmaildir--cur-server server))
- (or (setq groups (nnmaildir--srv-groups server))
- (throw 'return nil))
- (if (nnmaildir--srv-method server) nil
+ (unless (setq groups (nnmaildir--srv-groups server))
+ (throw 'return nil))
+ (unless (nnmaildir--srv-method server)
(setq x (concat "nnmaildir:" (nnmaildir--srv-address server))
x (gnus-server-to-method x))
- (or x (throw 'return nil))
+ (unless x (throw 'return nil))
(setf (nnmaildir--srv-method server) x))
(if (null group)
- (or (setq group (nnmaildir--srv-curgrp server))
- (throw 'return nil))
- (or (setq group (intern-soft group groups))
- (throw 'return nil))
+ (unless (setq group (nnmaildir--srv-curgrp server))
+ (throw 'return nil))
+ (unless (setq group (intern-soft group groups))
+ (throw 'return nil))
(setq group (symbol-value group)))
group)))
+(defun nnmaildir--tab-to-space (string)
+ (let ((pos 0))
+ (while (string-match "\t" string pos)
+ (aset string (match-beginning 0) ? )
+ (setq pos (match-end 0))))
+ string)
+
(defun nnmaildir--update-nov (server group article)
(let ((nnheader-file-coding-system 'binary)
(srv-dir (nnmaildir--srv-dir server))
+ (storage-version 1) ;; [version article-number msgid [...nov...]]
dir gname pgname msgdir prefix suffix file attr mtime novdir novfile
- nov msgid nov-beg nov-mid nov-end field pos extra val old-extra
- new-extra deactivate-mark)
+ nov msgid nov-beg nov-mid nov-end field val old-extra num numdir
+ deactivate-mark)
(catch 'return
- (setq suffix (nnmaildir--art-suffix article))
- (if (stringp suffix) nil
- (setf (nnmaildir--art-nov article) nil)
- (throw 'return nil))
(setq gname (nnmaildir--grp-name group)
pgname (nnmaildir--pgname server gname)
dir (nnmaildir--srvgrp-dir srv-dir gname)
msgdir (if (nnmaildir--param pgname 'read-only)
(nnmaildir--new dir) (nnmaildir--cur dir))
prefix (nnmaildir--art-prefix article)
+ suffix (nnmaildir--art-suffix article)
file (concat msgdir prefix suffix)
attr (file-attributes file))
- (if attr nil
- (setf (nnmaildir--art-suffix article) 'expire)
- (setf (nnmaildir--art-nov article) nil)
+ (unless attr
+ (nnmaildir--expired-article group article)
(throw 'return nil))
(setq mtime (nth 5 attr)
attr (nth 7 attr)
nov (nnmaildir--art-nov article)
- novdir (nnmaildir--nov-dir (nnmaildir--nndir dir))
+ dir (nnmaildir--nndir dir)
+ novdir (nnmaildir--nov-dir dir)
novfile (concat novdir prefix))
- (or (equal nnmaildir--extra nnmail-extra-headers)
- (setq nnmaildir--extra (copy-sequence nnmail-extra-headers)))
+ (unless (equal nnmaildir--extra nnmail-extra-headers)
+ (setq nnmaildir--extra (copy-sequence nnmail-extra-headers)))
(nnmaildir--with-nov-buffer
- (when (file-exists-p novfile) ;; If not, force reparsing the message.
- (if nov nil ;; It's already in memory.
- ;; Else read the data from the NOV file.
- (erase-buffer)
- (nnheader-insert-file-contents novfile)
- (setq nov (read (current-buffer)))
- (setf (nnmaildir--art-msgid article) (car nov))
- (setq nov (cadr nov)))
- ;; If the NOV's modtime matches the file's current modtime, and it
- ;; has the right structure (i.e., it wasn't produced by a too-much
- ;; older version of nnmaildir), then we may use this NOV data
- ;; rather than parsing the message file, unless
- ;; nnmail-extra-headers has been augmented since this data was last
- ;; parsed.
- (when (and (equal mtime (nnmaildir--nov-get-mtime nov))
- (= (length nov) nnmaildir--novlen)
- (stringp (nnmaildir--nov-get-beg nov))
- (stringp (nnmaildir--nov-get-mid nov))
- (stringp (nnmaildir--nov-get-end nov))
- (listp (nnmaildir--nov-get-mtime nov))
- (listp (nnmaildir--nov-get-extra nov)))
- ;; this NOV data is potentially up-to-date; now check extra headers
- (setq old-extra (nnmaildir--nov-get-extra nov))
- (when (equal nnmaildir--extra old-extra) ;; common case
- (nnmaildir--nov-set-extra nov nnmaildir--extra) ;; save memory
+ ;; First we'll check for already-parsed NOV data.
+ (cond ((not (file-exists-p novfile))
+ ;; The NOV file doesn't exist; we have to parse the message.
+ (setq nov nil))
+ ((not nov)
+ ;; The file exists, but the data isn't in memory; read the file.
+ (erase-buffer)
+ (nnheader-insert-file-contents novfile)
+ (setq nov (read (current-buffer)))
+ (if (not (and (vectorp nov)
+ (/= 0 (length nov))
+ (equal storage-version (aref nov 0))))
+ ;; This NOV data seems to be in the wrong format.
+ (setq nov nil)
+ (unless (nnmaildir--art-num article)
+ (setf (nnmaildir--art-num article) (aref nov 1)))
+ (unless (nnmaildir--art-msgid article)
+ (setf (nnmaildir--art-msgid article) (aref nov 2)))
+ (setq nov (aref nov 3)))))
+ ;; Now check whether the already-parsed data (if we have any) is
+ ;; usable: if the message has been edited or if nnmail-extra-headers
+ ;; has been augmented since this data was parsed from the message,
+ ;; then we have to reparse. Otherwise it's up-to-date.
+ (when (and nov (equal mtime (nnmaildir--nov-get-mtime nov)))
+ ;; The timestamp matches. Now check nnmail-extra-headers.
+ (setq old-extra (nnmaildir--nov-get-extra nov))
+ (when (equal nnmaildir--extra old-extra) ;; common case
+ ;; Save memory; use a single copy of the list value.
+ (nnmaildir--nov-set-extra nov nnmaildir--extra)
+ (throw 'return nov))
+ ;; They're not equal, but maybe the new is a subset of the old.
+ (if (null nnmaildir--extra)
+ ;; The empty set is a subset of every set.
(throw 'return nov))
- ;; They're not equal, but maybe the new is a subset of the old...
- (if (null nnmaildir--extra) (throw 'return nov))
- (setq new-extra nnmaildir--extra)
- (while new-extra
- (if (memq (car new-extra) old-extra)
- (progn
- (setq new-extra (cdr new-extra))
- (if new-extra nil (throw 'return nov)))
- (setq new-extra nil))))) ;;found one not in old-extra;quit loop
+ (if (not (memq nil (mapcar (lambda (e) (memq e old-extra))
+ nnmaildir--extra)))
+ (throw 'return nov)))
;; Parse the NOV data out of the message.
(erase-buffer)
(nnheader-insert-file-contents file)
(setq nov-mid 0))
(goto-char (point-min))
(delete-char 1)
- (nnheader-fold-continuation-lines)
- (setq nov (nnheader-parse-head 'naked)
+ (setq nov (nnheader-parse-naked-head)
field (or (mail-header-lines nov) 0)))
- (if (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:)) nil
+ (unless (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:))
(setq nov-mid field))
(setq nov-mid (number-to-string nov-mid)
- nov-mid (concat (number-to-string attr) "\t" nov-mid)
- field (or (mail-header-references nov) "")
- pos 0)
+ nov-mid (concat (number-to-string attr) "\t" nov-mid))
(save-match-data
- (while (string-match "\t" field pos)
- (aset field (match-beginning 0) ? )
- (setq pos (match-end 0)))
+ (setq field (or (mail-header-references nov) ""))
+ (nnmaildir--tab-to-space field)
(setq nov-mid (concat field "\t" nov-mid)
- extra (mail-header-extra nov)
- nov-end "")
- (while extra
- (setq field (car extra) extra (cdr extra)
- val (cdr field) field (symbol-name (car field))
- pos 0)
- (while (string-match "\t" field pos)
- (aset field (match-beginning 0) ? )
- (setq pos (match-end 0)))
- (setq pos 0)
- (while (string-match "\t" val pos)
- (aset val (match-beginning 0) ? )
- (setq pos (match-end 0)))
- (setq nov-end (concat nov-end "\t" field ": " val)))
- (setq nov-end (if (zerop (length nov-end)) "" (substring nov-end 1))
- field (or (mail-header-subject nov) "")
- pos 0)
- (while (string-match "\t" field pos)
- (aset field (match-beginning 0) ? )
- (setq pos (match-end 0)))
- (setq nov-beg field
- field (or (mail-header-from nov) "")
- pos 0)
- (while (string-match "\t" field pos)
- (aset field (match-beginning 0) ? )
- (setq pos (match-end 0)))
- (setq nov-beg (concat nov-beg "\t" field)
- field (or (mail-header-date nov) "")
- pos 0)
- (while (string-match "\t" field pos)
- (aset field (match-beginning 0) ? )
- (setq pos (match-end 0)))
- (setq nov-beg (concat nov-beg "\t" field)
- field (mail-header-id nov)
- pos 0)
- (while (string-match "\t" field pos)
- (aset field (match-beginning 0) ? )
- (setq pos (match-end 0)))
- (setq msgid field))
+ nov-beg (mapconcat
+ (lambda (f) (nnmaildir--tab-to-space (or f "")))
+ (list (mail-header-subject nov)
+ (mail-header-from nov)
+ (mail-header-date nov)) "\t")
+ nov-end (mapconcat
+ (lambda (extra)
+ (setq field (symbol-name (car extra))
+ val (cdr extra))
+ (nnmaildir--tab-to-space field)
+ (nnmaildir--tab-to-space val)
+ (concat field ": " val))
+ (mail-header-extra nov) "\t")))
+ (setq msgid (mail-header-id nov))
(if (or (null msgid) (nnheader-fake-message-id-p msgid))
(setq msgid (concat "<" prefix "@nnmaildir>")))
+ (nnmaildir--tab-to-space msgid)
+ ;; The data is parsed; create an nnmaildir NOV structure.
(setq nov (nnmaildir--nov-new nov-beg nov-mid nov-end mtime
- nnmaildir--extra))
+ nnmaildir--extra)
+ num (nnmaildir--art-num article))
+ (unless num
+ ;; Allocate a new article number.
+ (erase-buffer)
+ (setq numdir (nnmaildir--num-dir dir)
+ file (nnmaildir--num-file numdir)
+ num -1)
+ (nnmaildir--mkdir numdir)
+ (write-region "" nil file nil 'no-message)
+ (while file
+ ;; Get the number of links to file.
+ (setq attr (nth 1 (file-attributes file)))
+ (if (= attr num)
+ ;; We've already tried this number, in the previous loop
+ ;; iteration, and failed.
+ (signal 'error `("Corrupt internal nnmaildir data" ,numdir)))
+ ;; If attr is 123, try to link file to "123". This atomically
+ ;; increases the link count and creates the "123" link, failing
+ ;; if that link was already created by another Gnus, just after
+ ;; we stat()ed file.
+ (condition-case nil
+ (progn
+ (add-name-to-file file (concat numdir (format "%x" attr)))
+ (setq file nil)) ;; Stop looping.
+ (file-already-exists nil))
+ (setq num attr))
+ (setf (nnmaildir--art-num article) num))
+ ;; Store this new NOV data in a file
(erase-buffer)
- (prin1 (list msgid nov) (current-buffer))
+ (prin1 (vector storage-version num msgid nov) (current-buffer))
(setq file (concat novfile ":"))
(nnmaildir--unlink file)
- (write-region (point-min) (point-max) file nil 'no-message))
+ (write-region (point-min) (point-max) file nil 'no-message nil 'excl))
(rename-file file novfile 'replace)
(setf (nnmaildir--art-msgid article) msgid)
nov)))
(let ((cache (nnmaildir--grp-cache group))
(index (nnmaildir--grp-index group))
goner)
- (if (nnmaildir--art-nov article) nil
+ (unless (nnmaildir--art-nov article)
(setq goner (aref cache index))
(if goner (setf (nnmaildir--art-nov goner) nil))
(aset cache index article)
(defun nnmaildir--grp-add-art (server group article)
(let ((nov (nnmaildir--update-nov server group article))
- old-lists new-lists)
+ count num min nlist nlist-cdr insert-nlist)
(when nov
- (setq old-lists (nnmaildir--grp-lists group)
- new-lists (copy-nnmaildir--lists old-lists))
- (setf (nnmaildir--lists-nlist new-lists)
- (cons article (nnmaildir--lists-nlist new-lists)))
+ (setq count (1+ (nnmaildir--grp-count group))
+ num (nnmaildir--art-num article)
+ min (if (= count 1) num
+ (min num (nnmaildir--grp-min group)))
+ nlist (nnmaildir--grp-nlist group))
+ (if (or (null nlist) (> num (caar nlist)))
+ (setq nlist (cons (cons num article) nlist))
+ (setq insert-nlist t
+ nlist-cdr (cdr nlist))
+ (while (< num (caar nlist-cdr))
+ (setq nlist nlist-cdr
+ nlist-cdr (cdr nlist))))
(let ((inhibit-quit t))
- (setf (nnmaildir--grp-lists group) new-lists)
- (set (intern (nnmaildir--art-prefix article)
- (nnmaildir--lists-flist new-lists))
- article)
- (set (intern (nnmaildir--art-msgid article)
- (nnmaildir--lists-mlist new-lists))
- article))
+ (setf (nnmaildir--grp-count group) count)
+ (setf (nnmaildir--grp-min group) min)
+ (if insert-nlist
+ (setcdr nlist (cons (cons num article) nlist-cdr))
+ (setf (nnmaildir--grp-nlist group) nlist))
+ (set (intern (nnmaildir--art-prefix article)
+ (nnmaildir--grp-flist group))
+ article)
+ (set (intern (nnmaildir--art-msgid article)
+ (nnmaildir--grp-mlist group))
+ article)
+ (set (intern (nnmaildir--grp-name group)
+ (nnmaildir--srv-groups server))
+ group))
(nnmaildir--cache-nov group article nov)
t)))
(or (nnmaildir--param pgname 'directory-files)
(nnmaildir--srv-ls server)))
-(defun nnmaildir--article-count (group)
- (let ((ct 0)
- (min 1))
- (setq group (nnmaildir--grp-lists group)
- group (nnmaildir--lists-nlist group))
- (while group
- (if (stringp (nnmaildir--art-suffix (car group)))
- (setq ct (1+ ct)
- min (nnmaildir--art-num (car group))))
- (setq group (cdr group)))
- (cons ct min)))
-
(defun nnmaildir-article-number-to-file-name
(number group-name server-address-string)
(let ((group (nnmaildir--prepare server-address-string group-name))
- list article suffix dir filename pgname)
+ article dir pgname)
(catch 'return
- (if (null group)
- ;; The given group or server does not exist.
- (throw 'return nil))
- (setq list (nnmaildir--grp-lists group)
- list (nnmaildir--lists-nlist list)
- article (nnmaildir--nlist-art list number))
- (if (null article)
- ;; The given article number does not exist in this group.
- (throw 'return nil))
- (setq suffix (nnmaildir--art-suffix article))
- (if (not (stringp suffix))
- ;; The article has expired.
- (throw 'return nil))
- (setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ (unless group
+ ;; The given group or server does not exist.
+ (throw 'return nil))
+ (setq article (nnmaildir--nlist-art group number))
+ (unless article
+ ;; The given article number does not exist in this group.
+ (throw 'return nil))
+ (setq pgname (nnmaildir--pgname nnmaildir--cur-server group-name)
+ dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--srvgrp-dir dir group-name)
- pgname (nnmaildir--pgname nnmaildir--cur-server group-name)
- group (if (nnmaildir--param pgname 'read-only)
- (nnmaildir--new dir) (nnmaildir--cur dir))
- filename (concat group (nnmaildir--art-prefix article) suffix))
- (if (file-exists-p filename)
- filename
- ;; The article disappeared out from under us.
- (setf (nnmaildir--art-suffix article) 'expire)
- (setf (nnmaildir--art-nov article) nil)
- nil))))
+ dir (if (nnmaildir--param pgname 'read-only)
+ (nnmaildir--new dir) (nnmaildir--cur dir)))
+ (concat dir (nnmaildir--art-prefix article)
+ (nnmaildir--art-suffix article)))))
(defun nnmaildir-article-number-to-base-name
(number group-name server-address-string)
- (let ((group (nnmaildir--prepare server-address-string group-name))
- list article suffix dir filename)
- (catch 'return
- (if (null group)
- ;; The given group or server does not exist.
- (throw 'return nil))
- (setq list (nnmaildir--grp-lists group)
- list (nnmaildir--lists-nlist list)
- article (nnmaildir--nlist-art list number))
- (if (null article)
- ;; The given article number does not exist in this group.
- (throw 'return nil))
- (setq suffix (nnmaildir--art-suffix article))
- (if (not (stringp suffix))
- ;; The article has expired.
- (throw 'return nil))
- (cons (nnmaildir--art-prefix article) suffix))))
+ (let ((x (nnmaildir--prepare server-address-string group-name)))
+ (when x
+ (setq x (nnmaildir--nlist-art x number))
+ (and x (cons (nnmaildir--art-prefix x)
+ (nnmaildir--art-suffix x))))))
(defun nnmaildir-base-name-to-article-number
(base-name group-name server-address-string)
- (let ((group (nnmaildir--prepare server-address-string group-name))
- list article suffix dir filename)
- (catch 'return
- (if (null group)
- ;; The given group or server does not exist.
- (throw 'return nil))
- (setq list (nnmaildir--grp-lists group)
- list (nnmaildir--lists-flist list)
- article (nnmaildir--flist-art list base-name))
- (if (null article)
- ;; The given article number does not exist in this group.
- (throw 'return nil))
- (nnmaildir--art-num article))))
+ (let ((x (nnmaildir--prepare server-address-string group-name)))
+ (when x
+ (setq x (nnmaildir--grp-flist x)
+ x (nnmaildir--flist-art x base-name))
+ (and x (nnmaildir--art-num x)))))
+
+(defun nnmaildir--nlist-iterate (nlist ranges func)
+ (let (entry high low nlist2)
+ (if (eq ranges 'all)
+ (setq ranges `((1 . ,(caar nlist)))))
+ (while ranges
+ (setq entry (car ranges) ranges (cdr ranges))
+ (while (and ranges (eq entry (car ranges)))
+ (setq ranges (cdr ranges))) ;; skip duplicates
+ (if (numberp entry)
+ (setq low entry
+ high entry)
+ (setq low (car entry)
+ high (cdr entry)))
+ (setq nlist2 nlist) ;; Don't assume any sorting of ranges
+ (catch 'iterate-loop
+ (while nlist2
+ (if (<= (caar nlist2) high) (throw 'iterate-loop nil))
+ (setq nlist2 (cdr nlist2))))
+ (catch 'iterate-loop
+ (while nlist2
+ (setq entry (car nlist2) nlist2 (cdr nlist2))
+ (if (< (car entry) low) (throw 'iterate-loop nil))
+ (funcall func (cdr entry)))))))
+
+(defun nnmaildir--up2-1 (n)
+ (if (zerop n) 1 (1- (lsh 1 (1+ (logb n))))))
(defun nnmaildir-request-type (group &optional article)
'mail)
(setq nnmaildir--cur-server server)
(throw 'return t))
(setq server (make-nnmaildir--srv :address x))
- (let ((inhibit-quit t))
- (set (intern x nnmaildir--servers) server)))
+ (let ((inhibit-quit t))
+ (set (intern x nnmaildir--servers) server)))
(setq dir (assq 'directory defs))
- (if dir nil
+ (unless dir
(setf (nnmaildir--srv-error server)
"You must set \"directory\" in the select method")
(throw 'return nil))
dir (eval dir)
dir (expand-file-name dir)
dir (file-name-as-directory dir))
- (if (file-exists-p dir) nil
+ (unless (file-exists-p dir)
(setf (nnmaildir--srv-error server) (concat "No such directory: " dir))
(throw 'return nil))
(setf (nnmaildir--srv-dir server) dir)
(setq x (assq 'directory-files defs))
(if (null x)
- (setq x (symbol-function (if nnheader-directory-files-is-safe
- 'directory-files
- 'nnheader-directory-files-safe)))
+ (setq x (if nnheader-directory-files-is-safe 'directory-files
+ 'nnheader-directory-files-safe))
(setq x (cadr x))
- (if (functionp x) nil
+ (unless (functionp x)
(setf (nnmaildir--srv-error server)
(concat "Not a function: " (prin1-to-string x)))
(throw 'return nil)))
(setf (nnmaildir--srv-ls server) x)
- (setq x (funcall x dir nil "\\`[^.]" 'nosort)
- x (length x)
- size 1)
- (while (<= size x) (setq size (* 2 size)))
- (if (/= size 1) (setq size (1- size)))
+ (setq size (length (funcall x dir nil "\\`[^.]" 'nosort))
+ size (nnmaildir--up2-1 size))
(and (setq x (assq 'get-new-mail defs))
(setq x (cdr x))
(car x)
(catch 'return
(let ((36h-ago (- (car (current-time)) 2))
absdir nndir tdir ndir cdir nattr cattr isnew pgname read-only ls
- files file num dir flist group x)
+ files num dir flist group x)
(setq absdir (nnmaildir--srvgrp-dir srv-dir gname)
nndir (nnmaildir--nndir absdir))
- (if (file-exists-p absdir) nil
+ (unless (file-exists-p absdir)
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "No such directory: " absdir))
(throw 'return nil))
cdir (nnmaildir--cur absdir)
nattr (file-attributes ndir)
cattr (file-attributes cdir))
- (if (and (file-exists-p tdir) nattr cattr) nil
+ (unless (and (file-exists-p tdir) nattr cattr)
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "Not a maildir: " absdir))
(throw 'return nil))
(if group
(setq isnew nil)
(setq isnew t
- group (make-nnmaildir--grp :name gname :index 0
- :lists (make-nnmaildir--lists)))
+ group (make-nnmaildir--grp :name gname :index 0))
(nnmaildir--mkdir nndir)
(nnmaildir--mkdir (nnmaildir--nov-dir nndir))
(nnmaildir--mkdir (nnmaildir--marks-dir nndir))
(write-region "" nil (concat nndir "markfile") nil 'no-message))
(setq read-only (nnmaildir--param pgname 'read-only)
ls (or (nnmaildir--param pgname 'directory-files) srv-ls))
- (if read-only nil
+ (unless read-only
(setq x (nth 11 (file-attributes tdir)))
- (if (and (= x (nth 11 nattr)) (= x (nth 11 cattr))) nil
+ (unless (and (= x (nth 11 nattr)) (= x (nth 11 cattr)))
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "Maildir spans filesystems: " absdir))
(throw 'return nil))
- (setq files (funcall ls tdir 'full "\\`[^.]" 'nosort))
- (while files
- (setq file (car files) files (cdr files)
- x (file-attributes file))
- (if (or (< 1 (cadr x)) (> 36h-ago (car (nth 4 x))))
- (delete-file file))))
+ (mapcar
+ (lambda (file)
+ (setq x (file-attributes file))
+ (if (or (> (cadr x) 1) (< (car (nth 4 x)) 36h-ago))
+ (delete-file file)))
+ (funcall ls tdir 'full "\\`[^.]" 'nosort)))
(or scan-msgs
isnew
(throw 'return t))
(setq nattr nil))
(if read-only (setq dir (and (or isnew nattr) ndir))
(when (or isnew nattr)
- (setq files (funcall ls ndir nil "\\`[^.]" 'nosort))
- (while files
- (setq file (car files) files (cdr files))
- (rename-file (concat ndir file) (concat cdir file ":2,")))
+ (mapcar
+ (lambda (file)
+ (rename-file (concat ndir file) (concat cdir file ":2,")))
+ (funcall ls ndir nil "\\`[^.]" 'nosort))
(setf (nnmaildir--grp-new group) nattr))
(setq cattr (nth 5 (file-attributes cdir)))
(if (equal cattr (nnmaildir--grp-cur group))
(setq cattr nil))
(setq dir (and (or isnew cattr) cdir)))
- (if dir nil (throw 'return t))
- (setq files (funcall ls dir nil "\\`[^.]" 'nosort))
+ (unless dir (throw 'return t))
+ (setq files (funcall ls dir nil "\\`[^.]" 'nosort)
+ files (save-match-data
+ (mapcar
+ (lambda (f)
+ (string-match "\\`\\([^:]*\\)\\(\\(:.*\\)?\\)\\'" f)
+ (cons (match-string 1 f) (match-string 2 f)))
+ files)))
(when isnew
- (setq x (length files)
- num 1)
- (while (<= num x) (setq num (* 2 num)))
- (if (/= num 1) (setq num (1- num)))
- (setq x (nnmaildir--grp-lists group))
- (setf (nnmaildir--lists-flist x) (make-vector num 0))
- (setf (nnmaildir--lists-mlist x) (make-vector num 0))
+ (setq num (nnmaildir--up2-1 (length files)))
+ (setf (nnmaildir--grp-flist group) (make-vector num 0))
+ (setf (nnmaildir--grp-mlist group) (make-vector num 0))
(setf (nnmaildir--grp-mmth group) (make-vector 1 0))
(setq num (nnmaildir--param pgname 'nov-cache-size))
(if (numberp num) (if (< num 1) (setq num 1))
- (setq x files
- num 16
+ (setq num 16
cdir (nnmaildir--marks-dir nndir)
ndir (nnmaildir--subdir cdir "tick")
cdir (nnmaildir--subdir cdir "read"))
- (while x
- (setq file (car x) x (cdr x))
- (string-match "\\`\\([^:]*\\)\\(\\(:.*\\)?\\)\\'" file)
- (setq file (match-string 1 file))
- (if (or (not (file-exists-p (concat cdir file)))
- (file-exists-p (concat ndir file)))
- (setq num (1+ num)))))
+ (mapcar
+ (lambda (file)
+ (setq file (car file))
+ (if (or (not (file-exists-p (concat cdir file)))
+ (file-exists-p (concat ndir file)))
+ (setq num (1+ num))))
+ files))
(setf (nnmaildir--grp-cache group) (make-vector num nil))
(let ((inhibit-quit t))
(set (intern gname groups) group))
(or scan-msgs (throw 'return t)))
- (setq flist (nnmaildir--grp-lists group)
- num (nnmaildir--lists-nlist flist)
- flist (nnmaildir--lists-flist flist)
- num (nnmaildir--nlist-last-num num)
- x files
- files nil)
- (while x
- (setq file (car x) x (cdr x))
- (string-match "\\`\\([^:]*\\)\\(\\(:.*\\)?\\)\\'" file)
- (setq file (cons (match-string 1 file) (match-string 2 file)))
- (if (nnmaildir--flist-art flist (car file)) nil
- (setq files (cons file files))))
- (setq files (mapcar 'nnmaildir--parse-filename files)
+ (setq flist (nnmaildir--grp-flist group)
+ files (mapcar
+ (lambda (file)
+ (and (null (nnmaildir--flist-art flist (car file)))
+ file))
+ files)
+ files (delq nil files)
+ files (mapcar 'nnmaildir--parse-filename files)
files (sort files 'nnmaildir--sort-files))
- (while files
- (setq file (car files) files (cdr files)
- file (if (consp file) file (aref file 5))
- x (make-nnmaildir--art :prefix (car file) :suffix(cdr file)
- :num (1+ num)))
- (if (nnmaildir--grp-add-art nnmaildir--cur-server group x)
- (setq num (1+ num))))
+ (mapcar
+ (lambda (file)
+ (setq file (if (consp file) file (aref file 5))
+ x (make-nnmaildir--art :prefix (car file) :suffix (cdr file)))
+ (nnmaildir--grp-add-art nnmaildir--cur-server group x))
+ files)
(if read-only (setf (nnmaildir--grp-new group) nattr)
(setf (nnmaildir--grp-cur group) cattr)))
t))
method srv-dir srv-ls))
groups))
(setq dirs (funcall srv-ls srv-dir nil "\\`[^.]" 'nosort)
- x (length dirs)
- seen 1)
- (while (<= seen x) (setq seen (* 2 seen)))
- (if (/= seen 1) (setq seen (1- seen)))
- (setq seen (make-vector seen 0))
- (while dirs
- (setq grp-dir (car dirs) dirs (cdr dirs))
- (if (nnmaildir--scan grp-dir scan-group groups method srv-dir
- srv-ls)
- (intern grp-dir seen)))
+ seen (nnmaildir--up2-1 (length dirs))
+ seen (make-vector seen 0))
+ (mapcar
+ (lambda (grp-dir)
+ (if (nnmaildir--scan grp-dir scan-group groups method srv-dir
+ srv-ls)
+ (intern grp-dir seen)))
+ dirs)
(setq x nil)
(mapatoms (lambda (group)
(setq group (symbol-name group))
- (if (intern-soft group seen) nil
+ (unless (intern-soft group seen)
(setq x (cons group x))))
groups)
- (while x
- (unintern (car x) groups)
- (setq x (cdr x)))
+ (mapcar (lambda (grp) (unintern grp groups)) x)
(setf (nnmaildir--srv-mtime nnmaildir--cur-server)
(nth 5 (file-attributes srv-dir))))
(and scan-group
(defun nnmaildir-request-list (&optional server)
(nnmaildir-request-scan 'find-new-groups server)
- (let (pgname ro ct-min deactivate-mark)
+ (let (pgname ro deactivate-mark)
(nnmaildir--prepare server nil)
(nnmaildir--with-nntp-buffer
(erase-buffer)
(setq pgname (symbol-name group)
pgname (nnmaildir--pgname nnmaildir--cur-server pgname)
group (symbol-value group)
- ro (nnmaildir--param pgname 'read-only)
- ct-min (nnmaildir--article-count group))
+ ro (nnmaildir--param pgname 'read-only))
(insert (nnmaildir--grp-name group) " ")
- (princ (nnmaildir--nlist-last-num
- (nnmaildir--lists-nlist
- (nnmaildir--grp-lists group)))
- nntp-server-buffer)
+ (princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
+ nntp-server-buffer)
(insert " ")
- (princ (cdr ct-min) nntp-server-buffer)
+ (princ (nnmaildir--grp-min group) nntp-server-buffer)
(insert " " (if ro "n" "y") "\n"))
(nnmaildir--srv-groups nnmaildir--cur-server))))
t)
(nnmaildir-request-list server))
(defun nnmaildir-retrieve-groups (groups &optional server)
- (let (gname group ct-min deactivate-mark)
+ (let (group deactivate-mark)
(nnmaildir--prepare server nil)
(nnmaildir--with-nntp-buffer
(erase-buffer)
- (while groups
- (setq gname (car groups) groups (cdr groups))
- (setq group (nnmaildir--prepare nil gname))
- (if (null group) (insert "411 no such news group\n")
- (setq ct-min (nnmaildir--article-count group))
- (insert "211 ")
- (princ (car ct-min) nntp-server-buffer)
- (insert " ")
- (princ (cdr ct-min) nntp-server-buffer)
- (insert " ")
- (princ (nnmaildir--nlist-last-num
- (nnmaildir--lists-nlist
- (nnmaildir--grp-lists group)))
- nntp-server-buffer)
- (insert " " gname "\n")))))
+ (mapcar
+ (lambda (gname)
+ (setq group (nnmaildir--prepare nil gname))
+ (if (null group) (insert "411 no such news group\n")
+ (insert "211 ")
+ (princ (nnmaildir--grp-count group) nntp-server-buffer)
+ (insert " ")
+ (princ (nnmaildir--grp-min group) nntp-server-buffer)
+ (insert " ")
+ (princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
+ nntp-server-buffer)
+ (insert " " gname "\n")))
+ groups)))
'group)
(defun nnmaildir-request-update-info (gname info &optional server)
(let ((group (nnmaildir--prepare server gname))
- pgname nlist flist last always-marks never-marks old-marks dotfile num
- dir markdirs marks mark ranges articles article read end new-marks ls
- old-mmth new-mmth mtime mark-sym deactivate-mark)
+ pgname flist all always-marks never-marks old-marks dotfile num dir
+ markdirs marks mark ranges markdir article read end new-marks ls
+ old-mmth new-mmth mtime mark-sym deactivate-mark)
(catch 'return
- (if group nil
+ (unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "No such group: " gname))
(throw 'return nil))
(setq gname (nnmaildir--grp-name group)
pgname (nnmaildir--pgname nnmaildir--cur-server gname)
- nlist (nnmaildir--grp-lists group)
- flist (nnmaildir--lists-flist nlist)
- nlist (nnmaildir--lists-nlist nlist))
- (if nlist nil
+ flist (nnmaildir--grp-flist group))
+ (when (zerop (nnmaildir--grp-count group))
(gnus-info-set-read info nil)
(gnus-info-set-marks info nil 'extend)
(throw 'return info))
(setq old-marks (cons 'read (gnus-info-read info))
old-marks (cons old-marks (gnus-info-marks info))
- last (nnmaildir--nlist-last-num nlist)
always-marks (nnmaildir--param pgname 'always-marks)
never-marks (nnmaildir--param pgname 'never-marks)
dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--marks-dir dir)
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
markdirs (funcall ls dir nil "\\`[^.]" 'nosort)
- num (length markdirs)
- new-mmth 1)
- (while (<= new-mmth num) (setq new-mmth (* 2 new-mmth)))
- (if (/= new-mmth 1) (setq new-mmth (1- new-mmth)))
- (setq new-mmth (make-vector new-mmth 0)
+ new-mmth (nnmaildir--up2-1 (length markdirs))
+ new-mmth (make-vector new-mmth 0)
old-mmth (nnmaildir--grp-mmth group))
- (while markdirs
- (setq mark (car markdirs) markdirs (cdr markdirs)
- articles (nnmaildir--subdir dir mark)
- mark-sym (intern mark)
- ranges nil)
- (catch 'got-ranges
- (if (memq mark-sym never-marks) (throw 'got-ranges nil))
- (when (memq mark-sym always-marks)
- (setq ranges (list (cons 1 last)))
- (throw 'got-ranges nil))
- (setq mtime (nth 5 (file-attributes articles)))
- (set (intern mark new-mmth) mtime)
- (when (equal mtime (symbol-value (intern-soft mark old-mmth)))
- (setq ranges (assq mark-sym old-marks))
- (if ranges (setq ranges (cdr ranges)))
- (throw 'got-ranges nil))
- (setq articles (funcall ls articles nil "\\`[^.]" 'nosort))
- (while articles
- (setq article (car articles) articles (cdr articles)
- article (nnmaildir--flist-art flist article))
- (if article
- (setq num (nnmaildir--art-num article)
- ranges (gnus-add-to-range ranges (list num))))))
- (if (eq mark-sym 'read) (setq read ranges)
- (if ranges (setq marks (cons (cons mark-sym ranges) marks)))))
+ (mapcar
+ (lambda (mark)
+ (setq markdir (nnmaildir--subdir dir mark)
+ mark-sym (intern mark)
+ ranges nil)
+ (catch 'got-ranges
+ (if (memq mark-sym never-marks) (throw 'got-ranges nil))
+ (when (memq mark-sym always-marks)
+ (unless all
+ (setq all (nnmaildir--grp-nlist group)
+ all (mapcar 'car all)
+ all (nreverse all)
+ all (gnus-compress-sequence all 'always-list)
+ all (cons 'dummy-mark-symbol all)))
+ (setq ranges (cdr all))
+ (throw 'got-ranges nil))
+ (setq mtime (nth 5 (file-attributes markdir)))
+ (set (intern mark new-mmth) mtime)
+ (when (equal mtime (symbol-value (intern-soft mark old-mmth)))
+ (setq ranges (assq mark-sym old-marks))
+ (if ranges (setq ranges (cdr ranges)))
+ (throw 'got-ranges nil))
+ (mapcar
+ (lambda (prefix)
+ (setq article (nnmaildir--flist-art flist prefix))
+ (if article
+ (setq ranges
+ (gnus-add-to-range ranges
+ `(,(nnmaildir--art-num article))))))
+ (funcall ls markdir nil "\\`[^.]" 'nosort)))
+ (if (eq mark-sym 'read) (setq read ranges)
+ (if ranges (setq marks (cons (cons mark-sym ranges) marks)))))
+ markdirs)
(gnus-info-set-read info read)
(gnus-info-set-marks info marks 'extend)
(setf (nnmaildir--grp-mmth group) new-mmth)
(defun nnmaildir-request-group (gname &optional server fast)
(let ((group (nnmaildir--prepare server gname))
- ct-min deactivate-mark)
- (nnmaildir--with-nntp-buffer
- (erase-buffer)
- (catch 'return
- (if group nil
- (insert "411 no such news group\n")
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "No such group: " gname))
- (throw 'return nil))
- (setf (nnmaildir--srv-curgrp nnmaildir--cur-server) group)
- (if fast (throw 'return t))
- (setq ct-min (nnmaildir--article-count group))
+ deactivate-mark)
+ (catch 'return
+ (unless group
+ ;; (insert "411 no such news group\n")
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
+ (throw 'return nil))
+ (setf (nnmaildir--srv-curgrp nnmaildir--cur-server) group)
+ (if fast (throw 'return t))
+ (nnmaildir--with-nntp-buffer
+ (erase-buffer)
(insert "211 ")
- (princ (car ct-min) nntp-server-buffer)
+ (princ (nnmaildir--grp-count group) nntp-server-buffer)
(insert " ")
- (princ (cdr ct-min) nntp-server-buffer)
+ (princ (nnmaildir--grp-min group) nntp-server-buffer)
(insert " ")
- (princ (nnmaildir--nlist-last-num
- (nnmaildir--lists-nlist
- (nnmaildir--grp-lists group)))
+ (princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
nntp-server-buffer)
(insert " " gname "\n")
t))))
(file-coding-system-alist nil)
srv-dir x groups)
(catch 'return
- (if group nil
+ (unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "No such group: " gname))
(throw 'return nil))
(setq x (nnmaildir--srv-groups nnmaildir--cur-server)
groups (make-vector (length x) 0))
(mapatoms (lambda (sym)
- (if (eq (symbol-value sym) group) nil
+ (unless (eq (symbol-value sym) group)
(set (intern (symbol-name sym) groups)
(symbol-value sym))))
x)
(defun nnmaildir-request-delete-group (gname force &optional server)
(let ((group (nnmaildir--prepare server gname))
- pgname grp-dir dir dirs files ls deactivate-mark)
+ pgname grp-dir dir ls deactivate-mark)
(catch 'return
- (if group nil
+ (unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "No such group: " gname))
(throw 'return nil))
(setq grp-dir (nnmaildir--srv-dir nnmaildir--cur-server)
grp-dir (nnmaildir--srvgrp-dir grp-dir gname))
(if (not force) (setq grp-dir (directory-file-name grp-dir))
+ (setq ls (nnmaildir--group-ls nnmaildir--cur-server pgname))
(if (nnmaildir--param pgname 'read-only)
(progn (delete-directory (nnmaildir--tmp grp-dir))
(nnmaildir--unlink (nnmaildir--new grp-dir))
(delete-directory (nnmaildir--cur grp-dir)))
- (nnmaildir--with-work-buffer
- (erase-buffer)
- (setq ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
- files (funcall ls (nnmaildir--tmp grp-dir) 'full "\\`[^.]"
- 'nosort))
- (while files
- (delete-file (car files))
- (setq files (cdr files)))
- (delete-directory (nnmaildir--tmp grp-dir))
- (setq files (funcall ls (nnmaildir--new grp-dir) 'full "\\`[^.]"
- 'nosort))
- (while files
- (delete-file (car files))
- (setq files (cdr files)))
- (delete-directory (nnmaildir--new grp-dir))
- (setq files (funcall ls (nnmaildir--cur grp-dir) 'full "\\`[^.]"
- 'nosort))
- (while files
- (delete-file (car files))
- (setq files (cdr files)))
- (delete-directory (nnmaildir--cur grp-dir))))
- (setq dir (nnmaildir--nndir grp-dir)
- dirs (cons (nnmaildir--nov-dir dir)
- (funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]"
- 'nosort)))
- (while dirs
- (setq dir (car dirs) dirs (cdr dirs)
- files (funcall ls dir 'full "\\`[^.]" 'nosort))
- (while files
- (delete-file (car files))
- (setq files (cdr files)))
- (delete-directory dir))
+ (nnmaildir--delete-dir-files (nnmaildir--tmp grp-dir) ls)
+ (nnmaildir--delete-dir-files (nnmaildir--new grp-dir) ls)
+ (nnmaildir--delete-dir-files (nnmaildir--cur grp-dir) ls))
+ (setq dir (nnmaildir--nndir grp-dir))
+ (mapcar (lambda (subdir) (nnmaildir--delete-dir-files subdir ls))
+ `(,(nnmaildir--nov-dir dir) ,(nnmaildir--num-dir dir)
+ ,@(funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]"
+ 'nosort)))
(setq dir (nnmaildir--nndir grp-dir))
(nnmaildir--unlink (concat dir "markfile"))
(nnmaildir--unlink (concat dir "markfile{new}"))
(delete-directory dir)
(setq grp-dir (directory-file-name grp-dir)
dir (car (file-attributes grp-dir)))
- (if (eq (aref "/" 0) (aref dir 0)) nil
+ (unless (eq (aref "/" 0) (aref dir 0))
(setq dir (concat (file-truename
(nnmaildir--srv-dir nnmaildir--cur-server))
dir)))
(defun nnmaildir-retrieve-headers (articles &optional gname server fetch-old)
(let ((group (nnmaildir--prepare server gname))
- srv-dir dir nlist mlist article num stop nov nlist2 deactivate-mark)
+ srv-dir dir nlist mlist article num start stop nov nlist2 insert-nov
+ deactivate-mark)
+ (setq insert-nov
+ (lambda (article)
+ (setq nov (nnmaildir--update-nov nnmaildir--cur-server group
+ article))
+ (when nov
+ (nnmaildir--cache-nov group article nov)
+ (setq num (nnmaildir--art-num article))
+ (princ num nntp-server-buffer)
+ (insert "\t" (nnmaildir--nov-get-beg nov) "\t"
+ (nnmaildir--art-msgid article) "\t"
+ (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir "
+ gname ":")
+ (princ num nntp-server-buffer)
+ (insert "\t" (nnmaildir--nov-get-end nov) "\n"))))
(catch 'return
- (if group nil
+ (unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(if gname (concat "No such group: " gname) "No current group"))
(throw 'return nil))
(nnmaildir--with-nntp-buffer
(erase-buffer)
- (setq nlist (nnmaildir--grp-lists group)
- mlist (nnmaildir--lists-mlist nlist)
- nlist (nnmaildir--lists-nlist nlist)
+ (setq mlist (nnmaildir--grp-mlist group)
+ nlist (nnmaildir--grp-nlist group)
gname (nnmaildir--grp-name group)
srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--srvgrp-dir srv-dir gname))
(cond
((null nlist))
((and fetch-old (not (numberp fetch-old)))
- (while nlist
- (setq article (car nlist) nlist (cdr nlist)
- nov (nnmaildir--update-nov nnmaildir--cur-server group
- article))
- (when nov
- (nnmaildir--cache-nov group article nov)
- (setq num (nnmaildir--art-num article))
- (princ num nntp-server-buffer)
- (insert "\t" (nnmaildir--nov-get-beg nov) "\t"
- (nnmaildir--art-msgid article) "\t"
- (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " gname
- ":")
- (princ num nntp-server-buffer)
- (insert "\t" (nnmaildir--nov-get-end nov) "\n")
- (goto-char (point-min)))))
+ (nnmaildir--nlist-iterate nlist 'all insert-nov))
((null articles))
((stringp (car articles))
- (while articles
- (setq article (car articles) articles (cdr articles)
- article (nnmaildir--mlist-art mlist article))
- (when (and article
- (setq nov (nnmaildir--update-nov nnmaildir--cur-server
- group article)))
- (nnmaildir--cache-nov group article nov)
- (setq num (nnmaildir--art-num article))
- (princ num nntp-server-buffer)
- (insert "\t" (nnmaildir--nov-get-beg nov) "\t"
- (nnmaildir--art-msgid article) "\t"
- (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " gname
- ":")
- (princ num nntp-server-buffer)
- (insert "\t" (nnmaildir--nov-get-end nov) "\n"))))
+ (mapcar
+ (lambda (msgid)
+ (setq article (nnmaildir--mlist-art mlist msgid))
+ (if article (funcall insert-nov article)))
+ articles))
(t
(if fetch-old
- ;; Assume the article range is sorted ascending
+ ;; Assume the article range list is sorted ascending
(setq stop (car articles)
- num (car (last articles))
- stop (if (numberp stop) stop (car stop))
- num (if (numberp num) num (cdr num))
+ start (car (last articles))
+ stop (if (numberp stop) stop (car stop))
+ start (if (numberp start) start (cdr start))
stop (- stop fetch-old)
stop (if (< stop 1) 1 stop)
- articles (list (cons stop num))))
- (while articles
- (setq stop (car articles) articles (cdr articles))
- (while (eq stop (car articles))
- (setq articles (cdr articles)))
- (if (numberp stop) (setq num stop)
- (setq num (cdr stop) stop (car stop)))
- (setq nlist2 (nthcdr (- (nnmaildir--art-num (car nlist)) num)
- nlist))
- (while (and nlist2
- (setq article (car nlist2)
- num (nnmaildir--art-num article))
- (>= num stop))
- (setq nlist2 (cdr nlist2)
- nov (nnmaildir--update-nov nnmaildir--cur-server group
- article))
- (when nov
- (nnmaildir--cache-nov group article nov)
- (princ num nntp-server-buffer)
- (insert "\t" (nnmaildir--nov-get-beg nov) "\t"
- (nnmaildir--art-msgid article) "\t"
- (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " gname
- ":")
- (princ num nntp-server-buffer)
- (insert "\t" (nnmaildir--nov-get-end nov) "\n")
- (goto-char (point-min)))))))
+ articles (list (cons stop start))))
+ (nnmaildir--nlist-iterate nlist articles insert-nov)))
(sort-numeric-fields 1 (point-min) (point-max))
'nov))))
(defun nnmaildir-request-article (num-msgid &optional gname server to-buffer)
(let ((group (nnmaildir--prepare server gname))
(case-fold-search t)
- list article suffix dir pgname deactivate-mark)
+ list article dir pgname deactivate-mark)
(catch 'return
- (if group nil
+ (unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(if gname (concat "No such group: " gname) "No current group"))
(throw 'return nil))
- (setq list (nnmaildir--grp-lists group))
(if (numberp num-msgid)
- (setq list (nnmaildir--lists-nlist list)
- article (nnmaildir--nlist-art list num-msgid))
- (setq list (nnmaildir--lists-mlist list)
+ (setq article (nnmaildir--nlist-art group num-msgid))
+ (setq list (nnmaildir--grp-mlist group)
article (nnmaildir--mlist-art list num-msgid))
(if article (setq num-msgid (nnmaildir--art-num article))
(catch 'found
(mapatoms
- (lambda (grp)
- (setq group (symbol-value grp)
- list (nnmaildir--grp-lists group)
- list (nnmaildir--lists-mlist list)
+ (lambda (group-sym)
+ (setq group (symbol-value group-sym)
+ list (nnmaildir--grp-mlist group)
article (nnmaildir--mlist-art list num-msgid))
(when article
(setq num-msgid (nnmaildir--art-num article))
(throw 'found nil)))
- (nnmaildir--srv-groups nnmaildir--cur-server)))))
- (if article nil
- (setf (nnmaildir--srv-error nnmaildir--cur-server) "No such article")
- (throw 'return nil))
- (if (stringp (setq suffix (nnmaildir--art-suffix article))) nil
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- "Article has expired")
- (throw 'return nil))
+ (nnmaildir--srv-groups nnmaildir--cur-server))))
+ (unless article
+ (setf (nnmaildir--srv-error nnmaildir--cur-server) "No such article")
+ (throw 'return nil)))
(setq gname (nnmaildir--grp-name group)
pgname (nnmaildir--pgname nnmaildir--cur-server gname)
dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--srvgrp-dir dir gname)
- group (if (nnmaildir--param pgname 'read-only)
- (nnmaildir--new dir) (nnmaildir--cur dir))
- nnmaildir-article-file-name (concat group
- (nnmaildir--art-prefix
- article)
- suffix))
- (if (file-exists-p nnmaildir-article-file-name) nil
- (setf (nnmaildir--art-suffix article) 'expire)
- (setf (nnmaildir--art-nov article) nil)
+ dir (if (nnmaildir--param pgname 'read-only)
+ (nnmaildir--new dir) (nnmaildir--cur dir))
+ nnmaildir-article-file-name
+ (concat dir
+ (nnmaildir--art-prefix article)
+ (nnmaildir--art-suffix article)))
+ (unless (file-exists-p nnmaildir-article-file-name)
+ (nnmaildir--expired-article group article)
(setf (nnmaildir--srv-error nnmaildir--cur-server)
"Article has expired")
(throw 'return nil))
(let (message-required-mail-headers)
(funcall message-send-mail-function)))
-(defun nnmaildir-request-replace-article (article gname buffer)
+(defun nnmaildir-request-replace-article (number gname buffer)
(let ((group (nnmaildir--prepare nil gname))
(coding-system-for-write nnheader-file-coding-system)
(buffer-file-coding-system nil)
(file-coding-system-alist nil)
- file dir suffix tmpfile deactivate-mark)
+ dir file article suffix tmpfile deactivate-mark)
(catch 'return
- (if group nil
+ (unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "No such group: " gname))
(throw 'return nil))
(throw 'return nil))
(setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--srvgrp-dir dir gname)
- file (nnmaildir--grp-lists group)
- file (nnmaildir--lists-nlist file)
- file (nnmaildir--nlist-art file article))
- (if (and file (stringp (setq suffix (nnmaildir--art-suffix file))))
- nil
+ article (nnmaildir--nlist-art group number))
+ (unless article
(setf (nnmaildir--srv-error nnmaildir--cur-server)
- (format "No such article: %d" article))
+ (concat "No such article: " (number-to-string number)))
+ (throw 'return nil))
+ (setq suffix (nnmaildir--art-suffix article)
+ file (nnmaildir--art-prefix article)
+ tmpfile (concat (nnmaildir--tmp dir) file))
+ (when (file-exists-p tmpfile)
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "File exists: " tmpfile))
(throw 'return nil))
(save-excursion
(set-buffer buffer)
- (setq article file
- file (nnmaildir--art-prefix article)
- tmpfile (concat (nnmaildir--tmp dir) file))
- (when (file-exists-p tmpfile)
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "File exists: " tmpfile))
- (throw 'return nil))
(write-region (point-min) (point-max) tmpfile nil 'no-message nil
- 'confirm-overwrite)) ;; error would be preferred :(
+ 'excl))
(unix-sync) ;; no fsync :(
(rename-file tmpfile (concat (nnmaildir--cur dir) file suffix) 'replace)
t)))
(defun nnmaildir-request-move-article (article gname server accept-form
&optional last)
(let ((group (nnmaildir--prepare server gname))
- pgname list suffix result nnmaildir--file deactivate-mark)
+ pgname suffix result nnmaildir--file deactivate-mark)
(catch 'return
- (if group nil
+ (unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "No such group: " gname))
(throw 'return nil))
(setq gname (nnmaildir--grp-name group)
pgname (nnmaildir--pgname nnmaildir--cur-server gname)
- list (nnmaildir--grp-lists group)
- list (nnmaildir--lists-nlist list)
- article (nnmaildir--nlist-art list article))
- (if article nil
+ article (nnmaildir--nlist-art group article))
+ (unless article
(setf (nnmaildir--srv-error nnmaildir--cur-server) "No such article")
(throw 'return nil))
- (if (stringp (setq suffix (nnmaildir--art-suffix article))) nil
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- "Article has expired")
- (throw 'return nil))
- (setq nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server)
+ (setq suffix (nnmaildir--art-suffix article)
+ nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server)
nnmaildir--file (nnmaildir--srvgrp-dir nnmaildir--file gname)
nnmaildir--file (if (nnmaildir--param pgname 'read-only)
(nnmaildir--new nnmaildir--file)
nnmaildir--file (concat nnmaildir--file
(nnmaildir--art-prefix article)
suffix))
- (if (file-exists-p nnmaildir--file) nil
- (setf (nnmaildir--art-suffix article) 'expire)
- (setf (nnmaildir--art-nov article) nil)
+ (unless (file-exists-p nnmaildir--file)
+ (nnmaildir--expired-article group article)
(setf (nnmaildir--srv-error nnmaildir--cur-server)
"Article has expired")
(throw 'return nil))
(erase-buffer)
(nnheader-insert-file-contents nnmaildir--file)
(setq result (eval accept-form)))
- (if (or (null result) (nnmaildir--param pgname 'read-only)) nil
+ (unless (or (null result) (nnmaildir--param pgname 'read-only))
(nnmaildir--unlink nnmaildir--file)
- (setf (nnmaildir--art-suffix article) 'expire)
- (setf (nnmaildir--art-nov article) nil))
+ (nnmaildir--expired-article group article))
result)))
(defun nnmaildir-request-accept-article (gname &optional server last)
(coding-system-for-write nnheader-file-coding-system)
(buffer-file-coding-system nil)
(file-coding-system-alist nil)
- srv-dir dir file tmpfile curfile 24h num article)
+ srv-dir dir file tmpfile curfile 24h article)
(catch 'return
- (if group nil
+ (unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "No such group: " gname))
(throw 'return nil))
(setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--srvgrp-dir srv-dir gname)
file (format-time-string "%s" nil))
- (if (string-equal nnmaildir--delivery-time file) nil
+ (unless (string-equal nnmaildir--delivery-time file)
(setq nnmaildir--delivery-time file
nnmaildir--delivery-ct 0))
(setq file (concat file "." nnmaildir--delivery-pid))
- (if (zerop nnmaildir--delivery-ct) nil
+ (unless (zerop nnmaildir--delivery-ct)
(setq file (concat file "_"
(number-to-string nnmaildir--delivery-ct))))
(setq file (concat file "." (system-name))
(add-name-to-file nnmaildir--file tmpfile)
(error
(write-region (point-min) (point-max) tmpfile nil 'no-message nil
- 'confirm-overwrite) ;; error would be preferred :(
+ 'excl)
(unix-sync))) ;; no fsync :(
(cancel-timer 24h)
(condition-case err
(nnmaildir--unlink tmpfile)
(throw 'return nil)))
(nnmaildir--unlink tmpfile)
- (setq num (nnmaildir--grp-lists group)
- num (nnmaildir--lists-nlist num)
- num (1+ (nnmaildir--nlist-last-num num))
- article (make-nnmaildir--art :prefix file :suffix ":2," :num num))
+ (setq article (make-nnmaildir--art :prefix file :suffix ":2,"))
(if (nnmaildir--grp-add-art nnmaildir--cur-server group article)
- (cons gname num)))))
+ (cons gname (nnmaildir--art-num article))))))
(defun nnmaildir-save-mail (group-art)
(catch 'return
- (if group-art nil
+ (unless group-art
(throw 'return nil))
- (let ((ret group-art)
- ga gname x groups nnmaildir--file deactivate-mark)
+ (let (ga gname x groups nnmaildir--file deactivate-mark)
(save-excursion
(goto-char (point-min))
(save-match-data
(or (intern-soft gname groups)
(nnmaildir-request-create-group gname)
(throw 'return nil)) ;; not that nnmail bothers to check :(
- (if (nnmaildir-request-accept-article gname) nil
+ (unless (nnmaildir-request-accept-article gname)
(throw 'return nil))
- (setq x (nnmaildir--prepare nil gname)
- nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server)
- nnmaildir--file (nnmaildir--subdir nnmaildir--file
- (nnmaildir--grp-name x))
- x (nnmaildir--grp-lists x)
- x (nnmaildir--lists-nlist x)
- x (car x)
+ (setq nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server)
+ nnmaildir--file (nnmaildir--srvgrp-dir nnmaildir--file gname)
+ x (nnmaildir--prepare nil gname)
+ x (nnmaildir--grp-nlist x)
+ x (cdar x)
nnmaildir--file (concat nnmaildir--file
(nnmaildir--art-prefix x)
(nnmaildir--art-suffix x)))
- (while group-art
- (setq ga (car group-art) group-art (cdr group-art)
- gname (car ga))
- (if (and (or (intern-soft gname groups)
- (nnmaildir-request-create-group gname))
- (nnmaildir-request-accept-article gname)) nil
- (setq ret (delq ga ret)))) ;; We'll still try the other groups
- ret)))
-
-(defun nnmaildir-active-number (group)
- (let ((x (nnmaildir--prepare nil group)))
- (catch 'return
- (if x nil
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "No such group: " group))
- (throw 'return nil))
- (setq x (nnmaildir--grp-lists x)
- x (nnmaildir--lists-nlist x))
- (if x
- (setq x (car x)
- x (nnmaildir--art-num x)
- x (1+ x))
- 1))))
+ (delq nil
+ (mapcar
+ (lambda (ga)
+ (setq gname (car ga))
+ (and (or (intern-soft gname groups)
+ (nnmaildir-request-create-group gname))
+ (nnmaildir-request-accept-article gname)
+ ga))
+ group-art)))))
+
+(defun nnmaildir-active-number (gname)
+ 0)
(defun nnmaildir-request-expire-articles (ranges &optional gname server force)
(let ((no-force (not force))
(group (nnmaildir--prepare server gname))
- pgname time boundary time-iter bound-iter high low target dir nlist
- stop number article didnt suffix nnmaildir--file
- nnmaildir-article-file-name deactivate-mark)
+ pgname time boundary bound-iter high low target dir nlist nlist2
+ stop article didnt nnmaildir--file nnmaildir-article-file-name
+ deactivate-mark)
(catch 'return
- (if group nil
+ (unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(if gname (concat "No such group: " gname) "No current group"))
(throw 'return (gnus-uncompress-range ranges)))
pgname (nnmaildir--pgname nnmaildir--cur-server gname))
(if (nnmaildir--param pgname 'read-only)
(throw 'return (gnus-uncompress-range ranges)))
- (setq time (or (nnmaildir--param pgname 'expire-age)
- (* 86400 ;; seconds per day
- (or (and nnmail-expiry-wait-function
- (funcall nnmail-expiry-wait-function gname))
- nnmail-expiry-wait))))
- (if (or force (integerp time)) nil
- (throw 'return (gnus-uncompress-range ranges)))
- (setq boundary (current-time)
- high (- (car boundary) (/ time 65536))
- low (- (cadr boundary) (% time 65536)))
- (if (< low 0)
- (setq low (+ low 65536)
- high (1- high)))
- (setcar (cdr boundary) low)
- (setcar boundary high)
+ (setq time (nnmaildir--param pgname 'expire-age))
+ (unless time
+ (setq time (or (and nnmail-expiry-wait-function
+ (funcall nnmail-expiry-wait-function gname))
+ nnmail-expiry-wait))
+ (if (eq time 'immediate)
+ (setq time 0)
+ (if (numberp time)
+ (setq time (* time 86400)))))
+ (when no-force
+ (unless (integerp time) ;; handle 'never
+ (throw 'return (gnus-uncompress-range ranges)))
+ (setq boundary (current-time)
+ high (- (car boundary) (/ time 65536))
+ low (- (cadr boundary) (% time 65536)))
+ (if (< low 0)
+ (setq low (+ low 65536)
+ high (1- high)))
+ (setcar (cdr boundary) low)
+ (setcar boundary high))
(setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--srvgrp-dir dir gname)
dir (nnmaildir--cur dir)
- nlist (nnmaildir--grp-lists group)
- nlist (nnmaildir--lists-nlist nlist)
+ nlist (nnmaildir--grp-nlist group)
ranges (reverse ranges))
(nnmaildir--with-move-buffer
- (while ranges
- (setq number (car ranges) ranges (cdr ranges))
- (while (eq number (car ranges))
- (setq ranges (cdr ranges)))
- (if (numberp number) (setq stop number)
- (setq stop (car number) number (cdr number)))
- (setq nlist (nthcdr (- (nnmaildir--art-num (car nlist)) number)
- nlist))
- (while (and nlist
- (setq article (car nlist)
- number (nnmaildir--art-num article))
- (>= number stop))
- (setq nlist (cdr nlist)
- suffix (nnmaildir--art-suffix article))
- (catch 'continue
- (if (stringp suffix) nil
- (setf (nnmaildir--art-suffix article) 'expire)
- (setf (nnmaildir--art-nov article) nil)
- (throw 'continue nil))
- (setq nnmaildir--file (nnmaildir--art-prefix article)
- nnmaildir--file (concat dir nnmaildir--file suffix)
- time (file-attributes nnmaildir--file))
- (if time nil
- (setf (nnmaildir--art-suffix article) 'expire)
- (setf (nnmaildir--art-nov article) nil)
- (throw 'continue nil))
- (setq time (nth 5 time)
- time-iter time
- bound-iter boundary)
- (if (and no-force
- (progn
- (while (and bound-iter time-iter
- (= (car bound-iter) (car time-iter)))
- (setq bound-iter (cdr bound-iter)
- time-iter (cdr time-iter)))
- (and bound-iter time-iter
- (car-less-than-car bound-iter time-iter))))
- (setq didnt (cons number didnt))
- (save-excursion
- (setq nnmaildir-article-file-name nnmaildir--file
- target (nnmaildir--param pgname 'expire-group)))
- (when (and (stringp target)
- (not (string-equal target pgname))) ;; Move it.
- (erase-buffer)
- (nnheader-insert-file-contents nnmaildir--file)
- (gnus-request-accept-article target nil nil 'no-encode))
- (if (equal target pgname)
- (setq didnt (cons number didnt)) ;; Leave it here.
- (nnmaildir--unlink nnmaildir--file)
- (setf (nnmaildir--art-suffix article) 'expire)
- (setf (nnmaildir--art-nov article) nil))))))
+ (nnmaildir--nlist-iterate
+ nlist ranges
+ (lambda (article)
+ (setq nnmaildir--file (nnmaildir--art-prefix article)
+ nnmaildir--file (concat dir nnmaildir--file
+ (nnmaildir--art-suffix article))
+ time (file-attributes nnmaildir--file))
+ (cond
+ ((null time)
+ (nnmaildir--expired-article group article))
+ ((and no-force
+ (progn
+ (setq time (nth 5 time)
+ bound-iter boundary)
+ (while (and bound-iter time
+ (= (car bound-iter) (car time)))
+ (setq bound-iter (cdr bound-iter)
+ time (cdr time)))
+ (and bound-iter time
+ (car-less-than-car bound-iter time))))
+ (setq didnt (cons (nnmaildir--art-num article) didnt)))
+ (t
+ (setq nnmaildir-article-file-name nnmaildir--file
+ target (if force nil
+ (save-excursion
+ (save-restriction
+ (nnmaildir--param pgname 'expire-group)))))
+ (when (and (stringp target)
+ (not (string-equal target pgname))) ;; Move it.
+ (erase-buffer)
+ (nnheader-insert-file-contents nnmaildir--file)
+ (gnus-request-accept-article target nil nil 'no-encode))
+ (if (equal target pgname)
+ ;; Leave it here.
+ (setq didnt (cons (nnmaildir--art-num article) didnt))
+ (nnmaildir--unlink nnmaildir--file)
+ (nnmaildir--expired-article group article))))))
(erase-buffer))
didnt)))
(coding-system-for-write nnheader-file-coding-system)
(buffer-file-coding-system nil)
(file-coding-system-alist nil)
- del-mark add-marks marksdir markfile action group-nlist nlist ranges
- begin end article all-marks todo-marks did-marks marks form mdir mfile
+ del-mark del-action add-action set-action marksdir markfile nlist
+ ranges begin end article all-marks todo-marks did-marks mdir mfile
pgname ls markfilenew deactivate-mark)
(setq del-mark
- (lambda ()
- (setq mfile (nnmaildir--subdir marksdir (symbol-name (car marks)))
+ (lambda (mark)
+ (setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
mfile (concat mfile (nnmaildir--art-prefix article)))
(nnmaildir--unlink mfile))
- add-marks
- (lambda ()
- (while marks
- (setq mdir (nnmaildir--subdir marksdir (symbol-name (car marks)))
- mfile (concat mdir (nnmaildir--art-prefix article)))
- (if (memq (car marks) did-marks) nil
- (nnmaildir--mkdir mdir)
- (setq did-marks (cons (car marks) did-marks)))
- (if (file-exists-p mfile) nil
- (condition-case nil
- (add-name-to-file markfile mfile)
- (file-error
- (if (file-exists-p mfile) nil
- ;; too many links, maybe
- (write-region "" nil markfilenew nil 'no-message)
- (add-name-to-file markfilenew mfile 'ok-if-already-exists)
- (rename-file markfilenew markfile 'replace)))))
- (setq marks (cdr marks)))))
+ del-action (lambda (article) (mapcar del-mark todo-marks))
+ add-action
+ (lambda (article)
+ (mapcar
+ (lambda (mark)
+ (setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
+ mfile (concat mdir (nnmaildir--art-prefix article)))
+ (unless (memq mark did-marks)
+ (nnmaildir--mkdir mdir)
+ (setq did-marks (cons mark did-marks)))
+ (unless (file-exists-p mfile)
+ (condition-case nil
+ (add-name-to-file markfile mfile)
+ (file-error
+ (unless (file-exists-p mfile)
+ ;; too many links, maybe
+ (write-region "" nil markfilenew nil 'no-message)
+ (add-name-to-file markfilenew mfile
+ 'ok-if-already-exists)
+ (rename-file markfilenew markfile 'replace))))))
+ todo-marks))
+ set-action (lambda (article)
+ (funcall add-action)
+ (mapcar (lambda (mark)
+ (unless (memq mark todo-marks)
+ (funcall del-mark mark)))
+ all-marks)))
(catch 'return
- (if group nil
+ (unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "No such group: " gname))
- (while actions
- (setq ranges (gnus-range-add ranges (caar actions))
- actions (cdr actions)))
+ (mapcar (lambda (action)
+ (setq ranges (gnus-range-add ranges (car action))))
+ actions)
(throw 'return ranges))
- (setq group-nlist (nnmaildir--grp-lists group)
- group-nlist (nnmaildir--lists-nlist group-nlist)
+ (setq nlist (nnmaildir--grp-nlist group)
marksdir (nnmaildir--srv-dir nnmaildir--cur-server)
marksdir (nnmaildir--srvgrp-dir marksdir gname)
marksdir (nnmaildir--nndir marksdir)
pgname (nnmaildir--pgname nnmaildir--cur-server gname)
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort)
- marks all-marks)
- (while marks
- (setcar marks (intern (car marks)))
- (setq marks (cdr marks)))
- (while actions
- (setq action (car actions) actions (cdr actions)
- nlist group-nlist
- ranges (car action)
- todo-marks (caddr action)
- marks todo-marks)
- (while marks
- (if (memq (car marks) all-marks) nil
- (setq all-marks (cons (car marks) all-marks)))
- (setq marks (cdr marks)))
- (setq form
- (cond
- ((eq 'del (cadr action))
- '(while marks
- (funcall del-mark)
- (setq marks (cdr marks))))
- ((eq 'add (cadr action)) '(funcall add-marks))
- (t
- '(progn
- (funcall add-marks)
- (setq marks all-marks)
- (while marks
- (if (memq (car marks) todo-marks) nil
- (funcall del-mark))
- (setq marks (cdr marks)))))))
- (if (numberp (cdr ranges)) (setq ranges (list ranges))
- (setq ranges (reverse ranges)))
- (while ranges
- (setq begin (car ranges) ranges (cdr ranges))
- (while (eq begin (car ranges))
- (setq ranges (cdr ranges)))
- (if (numberp begin) (setq end begin)
- (setq end (cdr begin) begin (car begin)))
- (setq nlist (nthcdr (- (nnmaildir--art-num (car nlist)) end)
- nlist))
- (while (and nlist
- (setq article (car nlist))
- (>= (nnmaildir--art-num article) begin))
- (setq nlist (cdr nlist))
- (when (stringp (nnmaildir--art-suffix article))
- (setq marks todo-marks)
- (eval form)))))
+ all-marks (mapcar 'intern all-marks))
+ (mapcar
+ (lambda (action)
+ (setq ranges (car action)
+ todo-marks (caddr action))
+ (mapcar (lambda (mark) (add-to-list 'all-marks mark)) todo-marks)
+ (if (numberp (cdr ranges)) (setq ranges (list ranges)))
+ (nnmaildir--nlist-iterate nlist ranges
+ (cond ((eq 'del (cadr action)) del-action)
+ ((eq 'add (cadr action)) add-action)
+ (t set-action))))
+ actions)
nil)))
-(defun nnmaildir-close-group (group &optional server)
- t)
+(defun nnmaildir-close-group (gname &optional server)
+ (let ((group (nnmaildir--prepare server gname))
+ pgname ls dir msgdir files flist dirs)
+ (if (null group)
+ (progn
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
+ nil)
+ (setq pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+ ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
+ dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir dir gname)
+ msgdir (if (nnmaildir--param pgname 'read-only)
+ (nnmaildir--new dir) (nnmaildir--cur dir))
+ dir (nnmaildir--nndir dir)
+ dirs (cons (nnmaildir--nov-dir dir)
+ (funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]"
+ 'nosort))
+ dirs (mapcar
+ (lambda (dir)
+ (cons dir (funcall ls dir nil "\\`[^.]" 'nosort)))
+ dirs)
+ files (funcall ls msgdir nil "\\`[^.]" 'nosort)
+ flist (nnmaildir--up2-1 (length files))
+ flist (make-vector flist 0))
+ (save-match-data
+ (mapcar
+ (lambda (file)
+ (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file)
+ (intern (match-string 1 file) flist))
+ files))
+ (mapcar
+ (lambda (dir)
+ (setq files (cdr dir)
+ dir (file-name-as-directory (car dir)))
+ (mapcar
+ (lambda (file)
+ (unless (intern-soft file flist)
+ (setq file (concat dir file))
+ (delete-file file)))
+ files))
+ dirs)
+ t)))
(defun nnmaildir-close-server (&optional server)
(let (flist ls dirs dir files file x)
(nnmaildir--prepare server nil)
- (setq server nnmaildir--cur-server)
- (when server
- (setq nnmaildir--cur-server nil)
- (save-match-data
- (mapatoms
- (lambda (group)
- (setq x (nnmaildir--pgname server (symbol-name group))
- group (symbol-value group)
- ls (nnmaildir--group-ls server x)
- dir (nnmaildir--srv-dir server)
- dir (nnmaildir--srvgrp-dir dir (nnmaildir--grp-name group))
- x (nnmaildir--param x 'read-only)
- x (if x (nnmaildir--new dir) (nnmaildir--cur dir))
- files (funcall ls x nil "\\`[^.]" 'nosort)
- x (length files)
- flist 1)
- (while (<= flist x) (setq flist (* 2 flist)))
- (if (/= flist 1) (setq flist (1- flist)))
- (setq flist (make-vector flist 0))
- (while files
- (setq file (car files) files (cdr files))
- (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file)
- (intern (match-string 1 file) flist))
- (setq dir (nnmaildir--nndir dir)
- dirs (cons (nnmaildir--nov-dir dir)
- (funcall ls (nnmaildir--marks-dir dir) 'full
- "\\`[^.]" 'nosort)))
- (while dirs
- (setq dir (car dirs) dirs (cdr dirs)
- files (funcall ls dir nil "\\`[^.]" 'nosort)
- dir (file-name-as-directory dir))
- (while files
- (setq file (car files) files (cdr files))
- (if (intern-soft file flist) nil
- (setq file (concat dir file))
- (delete-file file)))))
- (nnmaildir--srv-groups server)))
+ (when nnmaildir--cur-server
+ (setq server nnmaildir--cur-server
+ nnmaildir--cur-server nil)
(unintern (nnmaildir--srv-address server) nnmaildir--servers)))
t)
(mapatoms (lambda (server)
(setq servers (cons (symbol-name server) servers)))
nnmaildir--servers)
- (while servers
- (nnmaildir-close-server (car servers))
- (setq servers (cdr servers)))
+ (mapcar 'nnmaildir-close-server servers)
(setq buffer (get-buffer " *nnmaildir work*"))
(if buffer (kill-buffer buffer))
(setq buffer (get-buffer " *nnmaildir nov*"))
(if buffer (kill-buffer buffer)))
t)
-(defun nnmaildir--edit-prep ()
- (let ((extras '(mapcar mapatoms))
- name)
- (mapatoms
- (lambda (sym)
- (when (or (memq sym extras)
- (and (fboundp sym)
- (setq name (symbol-name sym))
- (>= (length name) 10)
- (or (string-equal "nnmaildir-" (substring name 0 10))
- (and (>= (length name) 15)
- (string-equal "make-nnmaildir-"
- (substring name 0 15))))))
- (put sym 'lisp-indent-function 0))))
- 'done))
-
(provide 'nnmaildir)
;; Local Variables:
;; indent-tabs-mode: t
;; fill-column: 77
-;; eval: (progn (require 'nnmaildir) (nnmaildir--edit-prep))
;; End:
;;; nnmaildir.el ends here
(goto-char (point-max))
(insert
(format
- "%s %d %d y\n"
+ "%s %.0f %.0f y\n"
(progn
(string-match
(regexp-quote
(unless (zerop (buffer-size))
(narrow-to-region
(goto-char (point-min))
- (if (re-search-forward "\n\r?\n" nil t) (1- (point)) (point-max))))
- ;; Fold continuation lines.
- (goto-char (point-min))
- (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " " t t))
- ;; Remove any tabs; they are too confusing.
- (subst-char-in-region (point-min) (point-max) ?\t ? )
- ;; Remove any ^M's; they are too confusing.
- (subst-char-in-region (point-min) (point-max) ?\r ? )
- (let ((headers (nnheader-parse-head t)))
+ (if (re-search-forward "\n\r?\n" nil t)
+ (1- (point))
+ (point-max))))
+ (let ((headers (nnheader-parse-naked-head)))
(mail-header-set-chars headers chars)
(mail-header-set-number headers number)
headers))))
(setcdr bstate (delq defs (cdr bstate)))
(pop defs)
(while defs
- (set (car (pop defs)) nil)))))
+ (set (car (pop defs)) nil)))))
t)
(defun nnoo-close (backend)
("Kuro5hin"
"http://www.kuro5hin.org/backend.rdf"
"Technology and culture, from the trenches.")
- ("JabberCentral"
- "http://www.jabbercentral.com/rss.php"
- "News around the Jabber instant messaging system.")))
+ ("Jabber Software Foundation News"
+ "http://www.jabber.org/news/rss.xml"
+ "News and announcements from the Jabber Software Foundation.")
+ ))
(defvar nnrss-use-local nil)
(let ((coding-system-for-write 'binary)
print-level print-length)
(with-temp-file file
+ (insert "(setq nnrss-group-alist '"
+ (prin1-to-string nnrss-group-alist)
+ ")\n")
(insert "(setq nnrss-server-data '"
(prin1-to-string nnrss-server-data)
")\n")))))
(setq subject (concat "Re: " (substring subject (match-end 0)))))
(setq subject (mm-url-decode-entities-string subject))
(search-forward "<BR>")
- (if (looking-at
- "by[ \t\n]+<a[^>]+>\\([^<]+\\)</a>[ \t\n]*(\\(<[^>]+>\\)*\\([^<>)]+\\))")
- (progn
- (goto-char (- (match-end 0) 5))
- (setq from (concat
- (mm-url-decode-entities-string (match-string 1))
- " <" (match-string 3) ">")))
- (setq from "")
- (when (looking-at "by \\([^<>]*\\) on ")
- (goto-char (- (match-end 0) 5))
- (setq from (mm-url-decode-entities-string (match-string 1)))))
- (search-forward " on ")
+ (cond
+ ((looking-at
+ "by[ \t\n]+<a[^>]+>\\([^<]+\\)</a>[ \t\n]*(\\(<[^>]+>\\)*\\([^<>)]+\\))")
+ (goto-char (- (match-end 0) 5))
+ (setq from (concat
+ (mm-url-decode-entities-string (match-string 1))
+ " <" (match-string 3) ">")))
+ ((looking-at "by[ \t\n]+<a[^>]+>\\([^<(]+\\) (\\([0-9]+\\))</a>")
+ (goto-char (- (match-end 0) 5))
+ (setq from (concat
+ (mm-url-decode-entities-string (match-string 1))
+ " <" (match-string 2) ">")))
+ ((looking-at "by \\([^<>]*\\)[\t\n\r ]+on ")
+ (goto-char (- (match-end 0) 5))
+ (setq from (mm-url-decode-entities-string (match-string 1))))
+ (t
+ (setq from "")))
+ (search-forward "on ")
(setq date
(nnslashdot-date-to-date
(buffer-substring (point) (progn (skip-chars-forward "^()<>\n\r") (point)))))
(set-buffer nntp-server-buffer)
(erase-buffer)
(dolist (elem nnslashdot-groups)
- (insert (prin1-to-string (car elem))
- " " (number-to-string (cadr elem)) " 1 y\n"))))
+ (when (numberp (cadr elem))
+ (insert (prin1-to-string (car elem))
+ " " (number-to-string (cadr elem)) " 1 y\n")))))
(defun nnslashdot-lose (why)
(error "Slashdot HTML has changed; please get a new version of nnslashdot"))
(provide 'nnslashdot)
;;; nnslashdot.el ends here
+
(when index-buffer
(insert-buffer-substring index-buffer)
(goto-char b)
- ;; We have to remove the index number entires and
+ ;; We have to remove the index number entries and
;; insert article numbers instead.
(while (looking-at "[0-9]+")
(replace-match (int-to-string number) t t)
(nntp-snarf-error-message)
nil))
((not (memq (process-status process) '(open run)))
- (nnheader-report 'nntp "Server closed connection"))
+ (nntp-report "Server closed connection"))
(t
(goto-char (point-max))
(let ((limit (point-min))
nntp-address nntp-port-number
nntp-server-buffer
wait-for nnheader-callback-function)
- ;; If nothing to wait for, still remove possibly echo'ed commands
- (unless wait-for
+ ;; If nothing to wait for, still remove possibly echo'ed commands.
+ ;; We don't have echos if nntp-open-connection-function
+ ;; is `nntp-open-network-stream', so we skip this in that case.
+ (unless (or wait-for
+ (equal nntp-open-connection-function
+ 'nntp-open-network-stream))
(nntp-accept-response)
(save-excursion
(set-buffer buffer)
(t
nil)))
+(defvar nntp-with-open-group-first-pass nil)
+
+(defmacro nntp-with-open-group (group server &optional connectionless &rest forms)
+ "Protect against servers that don't like clients that keep idle connections opens. The problem
+being that these servers may either close a connection or simply ignore any further requests on a
+connection. Closed connections are not detected until accept-process-output has updated the
+process-status. Dropped connections are not detected until the connection timeouts (which may be
+several minutes) or nntp-connection-timeout has expired. When these occur nntp-with-open-group,
+opens a new connection then re-issues the NNTP command whose response triggered the error."
+ (when (and (listp connectionless)
+ (not (eq connectionless nil)))
+ (setq forms (cons connectionless forms)
+ connectionless nil))
+ `(let ((nntp-with-open-group-first-pass t)
+ nntp-with-open-group-internal)
+ (while (catch 'nntp-with-open-group-error
+ ;; Open the connection to the server
+ ;; NOTE: Existing connections are NOT tested.
+ (nntp-possibly-change-group ,group ,server ,connectionless)
+
+ (let ((timer
+ (and nntp-connection-timeout
+ (nnheader-run-at-time
+ nntp-connection-timeout nil
+ '(lambda ()
+ (let ((process (nntp-find-connection nntp-server-buffer))
+ (buffer (and process (process-buffer process))))
+ ; when I an able to identify the connection to the server AND I've received NO
+ ; reponse for nntp-connection-timeout seconds.
+ (when (and buffer (eq 0 (buffer-size buffer)))
+ ; Close the connection. Take no other action as the accept input code will
+ ; handle the closed connection.
+ (nntp-kill-buffer buffer))))))))
+ (unwind-protect
+ (setq nntp-with-open-group-internal (progn ,@forms))
+ (when timer
+ (nnheader-cancel-timer timer)))
+ nil))
+ (setq nntp-with-open-group-first-pass nil))
+ nntp-with-open-group-internal))
+
+(defsubst nntp-report (&rest args)
+ "Report an error from the nntp backend.
+The first string in ARGS can be a format string.
+For some commands, the failed command may be retried once before actually displaying the error report."
+
+ (if nntp-with-open-group-first-pass
+ (throw 'nntp-with-open-group-error t))
+
+ (nnheader-report 'nntp args)
+ )
+
(deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
"Retrieve the headers of ARTICLES."
- (nntp-possibly-change-group group server)
- (save-excursion
- (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
- (erase-buffer)
- (if (and (not gnus-nov-is-evil)
- (not nntp-nov-is-evil)
- (nntp-retrieve-headers-with-xover articles fetch-old))
- ;; We successfully retrieved the headers via XOVER.
- 'nov
- ;; XOVER didn't work, so we do it the hard, slow and inefficient
- ;; way.
- (let ((number (length articles))
- (count 0)
- (received 0)
- (last-point (point-min))
- (buf (nntp-find-connection-buffer nntp-server-buffer))
- (nntp-inhibit-erase t)
- article)
- ;; Send HEAD commands.
- (while (setq article (pop articles))
- (nntp-send-command
- nil
- "HEAD" (if (numberp article)
- (int-to-string article)
- ;; `articles' is either a list of article numbers
- ;; or a list of article IDs.
- article))
- (incf count)
- ;; Every 400 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null articles) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (nntp-accept-response)
- (while (progn
- (set-buffer buf)
- (goto-char last-point)
- ;; Count replies.
- (while (nntp-next-result-arrived-p)
- (setq last-point (point))
- (incf received))
- (< received count))
- ;; If number of headers is greater than 100, give
- ;; informative messages.
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (zerop (% received 20))
- (nnheader-message 6 "NNTP: Receiving headers... %d%%"
- (/ (* received 100) number)))
- (nntp-accept-response))))
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (nnheader-message 6 "NNTP: Receiving headers...done"))
-
- ;; Now all of replies are received. Fold continuation lines.
- (nnheader-fold-continuation-lines)
- ;; Remove all "\r"'s.
- (nnheader-strip-cr)
- (copy-to-buffer nntp-server-buffer (point-min) (point-max))
- 'headers))))
+ (nntp-with-open-group
+ group server
+ (save-excursion
+ (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
+ (erase-buffer)
+ (if (and (not gnus-nov-is-evil)
+ (not nntp-nov-is-evil)
+ (nntp-retrieve-headers-with-xover articles fetch-old))
+ ;; We successfully retrieved the headers via XOVER.
+ 'nov
+ ;; XOVER didn't work, so we do it the hard, slow and inefficient
+ ;; way.
+ (let ((number (length articles))
+ (count 0)
+ (received 0)
+ (last-point (point-min))
+ (buf (nntp-find-connection-buffer nntp-server-buffer))
+ (nntp-inhibit-erase t)
+ article)
+ ;; Send HEAD commands.
+ (while (setq article (pop articles))
+ (nntp-send-command
+ nil
+ "HEAD" (if (numberp article)
+ (int-to-string article)
+ ;; `articles' is either a list of article numbers
+ ;; or a list of article IDs.
+ article))
+ (incf count)
+ ;; Every 400 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (nntp-accept-response)
+ (while (progn
+ (set-buffer buf)
+ (goto-char last-point)
+ ;; Count replies.
+ (while (nntp-next-result-arrived-p)
+ (setq last-point (point))
+ (incf received))
+ (< received count))
+ ;; If number of headers is greater than 100, give
+ ;; informative messages.
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (zerop (% received 20))
+ (nnheader-message 6 "NNTP: Receiving headers... %d%%"
+ (/ (* received 100) number)))
+ (nntp-accept-response))))
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (nnheader-message 6 "NNTP: Receiving headers...done"))
+
+ ;; Now all of replies are received. Fold continuation lines.
+ (nnheader-fold-continuation-lines)
+ ;; Remove all "\r"'s.
+ (nnheader-strip-cr)
+ (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+ 'headers)))))
(deffoo nntp-retrieve-groups (groups &optional server)
"Retrieve group info on GROUPS."
'active))))))
(deffoo nntp-retrieve-articles (articles &optional group server)
- (nntp-possibly-change-group group server)
- (save-excursion
- (let ((number (length articles))
- (count 0)
- (received 0)
- (last-point (point-min))
- (buf (nntp-find-connection-buffer nntp-server-buffer))
- (nntp-inhibit-erase t)
- (map (apply 'vector articles))
- (point 1)
- article)
- (set-buffer buf)
- (erase-buffer)
- ;; Send ARTICLE command.
- (while (setq article (pop articles))
- (nntp-send-command
- nil
- "ARTICLE" (if (numberp article)
- (int-to-string article)
- ;; `articles' is either a list of article numbers
- ;; or a list of article IDs.
- article))
- (incf count)
- ;; Every 400 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null articles) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (nntp-accept-response)
- (while (progn
- (set-buffer buf)
- (goto-char last-point)
- ;; Count replies.
- (while (nntp-next-result-arrived-p)
- (aset map received (cons (aref map received) (point)))
- (setq last-point (point))
- (incf received))
- (< received count))
- ;; If number of headers is greater than 100, give
- ;; informative messages.
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (zerop (% received 20))
- (nnheader-message 6 "NNTP: Receiving articles... %d%%"
- (/ (* received 100) number)))
- (nntp-accept-response))))
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (nnheader-message 6 "NNTP: Receiving articles...done"))
-
- ;; Now we have all the responses. We go through the results,
- ;; wash it and copy it over to the server buffer.
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (setq last-point (point-min))
- (mapcar
- (lambda (entry)
- (narrow-to-region
- (setq point (goto-char (point-max)))
- (progn
- (insert-buffer-substring buf last-point (cdr entry))
- (point-max)))
- (setq last-point (cdr entry))
- (nntp-decode-text)
- (widen)
- (cons (car entry) point))
- map))))
+ (nntp-with-open-group
+ group server
+ (save-excursion
+ (let ((number (length articles))
+ (count 0)
+ (received 0)
+ (last-point (point-min))
+ (buf (nntp-find-connection-buffer nntp-server-buffer))
+ (nntp-inhibit-erase t)
+ (map (apply 'vector articles))
+ (point 1)
+ article)
+ (set-buffer buf)
+ (erase-buffer)
+ ;; Send ARTICLE command.
+ (while (setq article (pop articles))
+ (nntp-send-command
+ nil
+ "ARTICLE" (if (numberp article)
+ (int-to-string article)
+ ;; `articles' is either a list of article numbers
+ ;; or a list of article IDs.
+ article))
+ (incf count)
+ ;; Every 400 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (nntp-accept-response)
+ (while (progn
+ (set-buffer buf)
+ (goto-char last-point)
+ ;; Count replies.
+ (while (nntp-next-result-arrived-p)
+ (aset map received (cons (aref map received) (point)))
+ (setq last-point (point))
+ (incf received))
+ (< received count))
+ ;; If number of headers is greater than 100, give
+ ;; informative messages.
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (zerop (% received 20))
+ (nnheader-message 6 "NNTP: Receiving articles... %d%%"
+ (/ (* received 100) number)))
+ (nntp-accept-response))))
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (nnheader-message 6 "NNTP: Receiving articles...done"))
+
+ ;; Now we have all the responses. We go through the results,
+ ;; wash it and copy it over to the server buffer.
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (setq last-point (point-min))
+ (mapcar
+ (lambda (entry)
+ (narrow-to-region
+ (setq point (goto-char (point-max)))
+ (progn
+ (insert-buffer-substring buf last-point (cdr entry))
+ (point-max)))
+ (setq last-point (cdr entry))
+ (nntp-decode-text)
+ (widen)
+ (cons (car entry) point))
+ map)))))
(defun nntp-try-list-active (group)
(nntp-list-active-group group)
(nntp-send-command "^\\.*\r?\n" "LISTGROUP" group))
(deffoo nntp-request-article (article &optional group server buffer command)
- (nntp-possibly-change-group group server)
- (when (nntp-send-command-and-decode
- "\r?\n\\.\r?\n" "ARTICLE"
- (if (numberp article) (int-to-string article) article))
- (if (and buffer
- (not (equal buffer nntp-server-buffer)))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (copy-to-buffer buffer (point-min) (point-max))
- (nntp-find-group-and-number group))
- (nntp-find-group-and-number group))))
+ (nntp-with-open-group
+ group server
+ (when (nntp-send-command-and-decode
+ "\r?\n\\.\r?\n" "ARTICLE"
+ (if (numberp article) (int-to-string article) article))
+ (if (and buffer
+ (not (equal buffer nntp-server-buffer)))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (copy-to-buffer buffer (point-min) (point-max))
+ (nntp-find-group-and-number group))
+ (nntp-find-group-and-number group)))))
(deffoo nntp-request-head (article &optional group server)
(nntp-possibly-change-group group server)
(if (numberp article) (int-to-string article) article)))
(deffoo nntp-request-group (group &optional server dont-check)
- (nntp-possibly-change-group nil server)
- (when (nntp-send-command "^[245].*\n" "GROUP" group)
- (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
- (setcar (cddr entry) group))))
+ (nntp-with-open-group
+ nil server
+ (when (nntp-send-command "^[245].*\n" "GROUP" group)
+ (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
+ (setcar (cddr entry) group)))))
(deffoo nntp-close-group (group &optional server)
t)
(unless (< len 10)
(setq nntp-have-messaged t)
(nnheader-message 7 "nntp read: %dk" len)))
- (accept-process-output process (or timeout 1))))
+ (accept-process-output process (or timeout 1))
+ ;; accept-process-output may update status of process to indicate that the server has closed the
+ ;; connection. This MUST be handled here as the buffer restored by the save-excursion may be the
+ ;; process's former output buffer (i.e. now killed)
+ (or (memq (process-status process) '(open run))
+ (nntp-report "Server closed connection"))))
(defun nntp-accept-response ()
"Wait for output from the process that outputs to BUFFER."
in-process-buffer-p
(buf nntp-server-buffer)
(process-buffer (nntp-find-connection-buffer nntp-server-buffer))
- first)
+ first
+ last)
;; We have to check `nntp-server-xover'. If it gets set to nil,
;; that means that the server does not understand XOVER, but we
;; won't know that until we try.
(setq articles (cdr articles)))
(setq in-process-buffer-p (stringp nntp-server-xover))
- (nntp-send-xover-command first (car articles))
- (setq articles (cdr articles))
+ (nntp-send-xover-command first (setq last (car articles)))
+ (setq articles (cdr articles))
(when (and nntp-server-xover in-process-buffer-p)
;; Don't count tried request.
;; Every 400 requests we have to read the stream in
;; order to avoid deadlocks.
(when (or (null articles) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
+ (= 1 (% count nntp-maximum-request)))
(nntp-accept-response)
;; On some Emacs versions the preceding function has a
(while (re-search-forward "^[0-9][0-9][0-9] .*\n" nil t)
(incf received))
(setq last-point (point))
- (< received count))
+ (or (< received count) ;; I haven't started reading the final response
+ (progn
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (looking-at "^\\.\r?\n"))) ;; I haven't read the end of the final response
+ ))
(nntp-accept-response)
- (set-buffer process-buffer))
- (set-buffer buf))))
+ (set-buffer process-buffer))))
+
+ ;; Some nntp servers seem to have an extension to the XOVER extension. On these
+ ;; servers, requesting an article range preceeding the active range does not return an
+ ;; error as specified in the RFC. What we instead get is the NOV entry for the first
+ ;; available article. Obviously, a client can use that entry to avoid making unnecessary
+ ;; requests. The only problem is for a client that assumes that the response will always be
+ ;; within the requested ranage. For such a client, we can get N copies of the same entry
+ ;; (one for each XOVER command sent to the server).
+
+ (when (<= count 1)
+ (goto-char (point-min))
+ (when (re-search-forward "^[0-9][0-9][0-9] .*\n\\([0-9]+\\)" nil t)
+ (let ((low-limit (string-to-int (buffer-substring (match-beginning 1) (match-end 1)))))
+ (while (and articles (<= (car articles) low-limit))
+ (setq articles (cdr articles))))))
+ (set-buffer buf))
(when nntp-server-xover
(when in-process-buffer-p
- (set-buffer process-buffer)
- ;; Wait for the reply from the final command.
- (goto-char (point-max))
- (while (not (re-search-backward "^[0-9][0-9][0-9] " nil t))
- (nntp-accept-response)
- (set-buffer process-buffer)
- (goto-char (point-max)))
- (when (looking-at "^[23]")
- (while (progn
- (goto-char (point-max))
- (forward-line -1)
- (not (looking-at "^\\.\r?\n")))
- (nntp-accept-response)
- (set-buffer process-buffer)))
(set-buffer buf)
(goto-char (point-max))
(insert-buffer-substring process-buffer)
(set-buffer nntp-server-buffer)
(erase-buffer)
(setq nntp-server-xover nil)))
- nntp-server-xover))))
+ nntp-server-xover))))
(defun nntp-find-group-and-number (&optional group)
(save-excursion
(defun nntp-wait-for-string (regexp)
"Wait until string arrives in the buffer."
- (let ((buf (current-buffer)))
+ (let ((buf (current-buffer))
+ proc)
(goto-char (point-min))
- (while (not (re-search-forward regexp nil t))
- (accept-process-output (nntp-find-connection nntp-server-buffer))
+ (while (and (setq proc (get-buffer-process buf))
+ (memq (process-status proc) '(open run))
+ (not (re-search-forward regexp nil t)))
+ (accept-process-output proc)
(set-buffer buf)
(goto-char (point-min)))))
;;; nnvirtual.el --- virtual newsgroups access for Gnus
-;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: David Moore <dmoore@ucsd.edu>
;;; group.
;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and
-;;; 6-7 resprectively, then the virtual article numbers look like:
+;;; 6-7 respectively, then the virtual article numbers look like:
;;;
;;; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; A1 A2 A3 A4 B1 A5 B2 A6 B3 A7 B4 C6 A8 B5 C7
(caar map))))
(defun nnweb-google-create-mapping ()
- "Perform the search and create an number-to-url alist."
+ "Perform the search and create a number-to-url alist."
(save-excursion
(set-buffer nnweb-buffer)
(erase-buffer)
;;; parse-time.el --- Parsing time strings
-;; Copyright (C) 1996, 2000 by Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2000, 2002 by Free Software Foundation, Inc.
;; Author: Erik Naggum <erik@naggum.no>
;; Keywords: util
;; `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.
+;; values to obtain an internal time value.
;;; Code:
--- /dev/null
+;;; pgg-def.el --- functions/macros for defining PGG functions
+
+;; Copyright (C) 1999 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'custom)
+
+(defgroup pgg ()
+ "Glue for the various PGP implementations."
+ :group 'mime)
+
+(defcustom pgg-default-scheme 'gpg
+ "Default PGP scheme."
+ :group 'pgg
+ :type '(choice (const :tag "GnuPG" gpg)
+ (const :tag "PGP 5" pgp5)
+ (const :tag "PGP" pgp)))
+
+(defcustom pgg-default-user-id (user-login-name)
+ "User ID of your default identity."
+ :group 'pgg
+ :type 'string)
+
+(defcustom pgg-default-keyserver-address "wwwkeys.pgp.net"
+ "Host name of keyserver."
+ :group 'pgg
+ :type 'string)
+
+(defcustom pgg-query-keyserver nil
+ "Whether PGG queries keyservers for missing keys when verifying messages."
+ :group 'pgg
+ :type 'boolean)
+
+(defcustom pgg-encrypt-for-me nil
+ "If t, encrypt all outgoing messages with user's public key."
+ :group 'pgg
+ :type 'boolean)
+
+(defcustom pgg-cache-passphrase t
+ "If t, cache passphrase."
+ :group 'pgg
+ :type 'boolean)
+
+(defcustom pgg-passphrase-cache-expiry 16
+ "How many seconds the passphrase is cached.
+Whether the passphrase is cached at all is controlled by
+`pgg-cache-passphrase'."
+ :group 'pgg
+ :type 'integer)
+
+(defvar pgg-messages-coding-system nil
+ "Coding system used when reading from a PGP external process.")
+
+(defvar pgg-status-buffer " *PGG status*")
+(defvar pgg-errors-buffer " *PGG errors*")
+(defvar pgg-output-buffer " *PGG output*")
+
+(defvar pgg-echo-buffer "*PGG-echo*")
+
+(defvar pgg-scheme nil
+ "Current scheme of PGP implementation.")
+
+(defmacro pgg-truncate-key-identifier (key)
+ `(if (> (length ,key) 8) (substring ,key 8) ,key))
+
+(provide 'pgg-def)
+
+;;; pgg-def.el ends here
--- /dev/null
+;;; pgg-gpg.el --- GnuPG support for PGG.
+
+;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/10/28
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; 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:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-gpg ()
+ "GnuPG interface"
+ :group 'pgg)
+
+(defcustom pgg-gpg-program "gpg"
+ "The GnuPG executable."
+ :group 'pgg-gpg
+ :type 'string)
+
+(defcustom pgg-gpg-extra-args nil
+ "Extra arguments for every GnuPG invocation."
+ :group 'pgg-gpg
+ :type '(choice
+ (const :tag "None" nil)
+ (string :tag "Arguments")))
+
+(defvar pgg-gpg-user-id nil
+ "GnuPG ID of your default identity.")
+
+(defun pgg-gpg-process-region (start end passphrase program args)
+ (let* ((output-file-name
+ (expand-file-name (make-temp-name "pgg-output")
+ pgg-temporary-file-directory))
+ (args
+ `("--status-fd" "2"
+ ,@(if passphrase '("--passphrase-fd" "0"))
+ "--output" ,output-file-name
+ ,@pgg-gpg-extra-args ,@args))
+ (output-buffer pgg-output-buffer)
+ (errors-buffer pgg-errors-buffer)
+ (orig-mode (default-file-modes))
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create errors-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (unwind-protect
+ (progn
+ (set-default-file-modes 448)
+ (let ((coding-system-for-write 'binary))
+ (setq process
+ (apply #'start-process "*GnuPG*" errors-buffer
+ program args)))
+ (set-process-sentinel process #'ignore)
+ (when passphrase
+ (process-send-string process (concat passphrase "\n")))
+ (process-send-region process start end)
+ (process-send-eof process)
+ (while (eq 'run (process-status process))
+ (accept-process-output process 5))
+ (setq status (process-status process)
+ exit-status (process-exit-status process))
+ (delete-process process)
+ (with-current-buffer (get-buffer-create output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (if (file-exists-p output-file-name)
+ (let ((coding-system-for-read 'raw-text-dos))
+ (insert-file-contents output-file-name)))
+ (set-buffer errors-buffer)
+ (if (memq status '(stop signal))
+ (error "%s exited abnormally: '%s'" program exit-status))
+ (if (= 127 exit-status)
+ (error "%s could not be found" program))))
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ (if (file-exists-p output-file-name)
+ (delete-file output-file-name))
+ (set-default-file-modes orig-mode))))
+
+(defun pgg-gpg-possibly-cache-passphrase (passphrase)
+ (if (and pgg-cache-passphrase
+ (progn
+ (goto-char (point-min))
+ (re-search-forward "^\\[GNUPG:] GOOD_PASSPHRASE\\>" nil t)))
+ (pgg-add-passphrase-cache
+ (progn
+ (goto-char (point-min))
+ (if (re-search-forward
+ "^\\[GNUPG:] NEED_PASSPHRASE \\w+ ?\\w*" nil t)
+ (substring (match-string 0) -8)))
+ passphrase)))
+
+(defun pgg-gpg-lookup-key (string &optional type)
+ "Search keys associated with STRING."
+ (let ((args (list "--with-colons" "--no-greeting" "--batch"
+ (if type "--list-secret-keys" "--list-keys")
+ string)))
+ (with-temp-buffer
+ (apply #'call-process pgg-gpg-program nil t nil args)
+ (goto-char (point-min))
+ (if (re-search-forward "^\\(sec\\|pub\\):" nil t)
+ (substring
+ (nth 3 (split-string
+ (buffer-substring (match-end 0)
+ (progn (end-of-line)(point)))
+ ":")) 8)))))
+
+(defun pgg-gpg-encrypt-region (start end recipients &optional sign)
+ "Encrypt the current region between START and END.
+If optional argument SIGN is non-nil, do a combined sign and encrypt."
+ (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
+ (passphrase
+ (when sign
+ (pgg-read-passphrase
+ (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
+ (pgg-gpg-lookup-key pgg-gpg-user-id 'encrypt))))
+ (args
+ (append
+ (list "--batch" "--armor" "--always-trust" "--encrypt")
+ (if sign (list "--sign" "--local-user" pgg-gpg-user-id))
+ (if recipients
+ (apply #'nconc
+ (mapcar (lambda (rcpt)
+ (list "--remote-user" rcpt))
+ (append recipients
+ (if pgg-encrypt-for-me
+ (list pgg-gpg-user-id)))))))))
+ (pgg-as-lbt start end 'CRLF
+ (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
+ (when sign
+ (with-current-buffer pgg-errors-buffer
+ (pgg-gpg-possibly-cache-passphrase passphrase)))
+ (pgg-process-when-success)))
+
+(defun pgg-gpg-decrypt-region (start end)
+ "Decrypt the current region between START and END."
+ (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
+ (pgg-gpg-lookup-key pgg-gpg-user-id 'encrypt)))
+ (args '("--batch" "--decrypt")))
+ (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
+ (with-current-buffer pgg-errors-buffer
+ (pgg-gpg-possibly-cache-passphrase passphrase)
+ (goto-char (point-min))
+ (re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t))))
+
+(defun pgg-gpg-sign-region (start end &optional cleartext)
+ "Make detached signature from text between START and END."
+ (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
+ (pgg-gpg-lookup-key pgg-gpg-user-id 'sign)))
+ (args
+ (list (if cleartext "--clearsign" "--detach-sign")
+ "--armor" "--batch" "--verbose"
+ "--local-user" pgg-gpg-user-id))
+ (inhibit-read-only t)
+ buffer-read-only)
+ (pgg-as-lbt start end 'CRLF
+ (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
+ (with-current-buffer pgg-errors-buffer
+ (pgg-gpg-possibly-cache-passphrase passphrase))
+ (pgg-process-when-success)))
+
+(defun pgg-gpg-verify-region (start end &optional signature)
+ "Verify region between START and END as the detached signature SIGNATURE."
+ (let ((args '("--batch" "--verify")))
+ (when (stringp signature)
+ (setq args (append args (list signature))))
+ (setq args (append args '("-")))
+ (pgg-gpg-process-region start end nil pgg-gpg-program args)
+ (with-current-buffer pgg-errors-buffer
+ (goto-char (point-min))
+ (while (re-search-forward "^gpg: \\(.*\\)\n" nil t)
+ (with-current-buffer pgg-output-buffer
+ (insert-buffer-substring pgg-errors-buffer
+ (match-beginning 1) (match-end 0)))
+ (delete-region (match-beginning 0) (match-end 0)))
+ (goto-char (point-min))
+ (re-search-forward "^\\[GNUPG:] GOODSIG\\>" nil t))))
+
+(defun pgg-gpg-insert-key ()
+ "Insert public key at point."
+ (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
+ (args (list "--batch" "--export" "--armor"
+ pgg-gpg-user-id)))
+ (pgg-gpg-process-region (point)(point) nil pgg-gpg-program args)
+ (insert-buffer-substring pgg-output-buffer)))
+
+(defun pgg-gpg-snarf-keys-region (start end)
+ "Add all public keys in region between START and END to the keyring."
+ (let ((args '("--import" "--batch" "-")) status)
+ (pgg-gpg-process-region start end nil pgg-gpg-program args)
+ (set-buffer pgg-errors-buffer)
+ (goto-char (point-min))
+ (when (re-search-forward "^\\[GNUPG:] IMPORT_RES\\>" nil t)
+ (setq status (buffer-substring (match-end 0)
+ (progn (end-of-line)(point)))
+ status (vconcat (mapcar #'string-to-int (split-string status))))
+ (erase-buffer)
+ (insert (format "Imported %d key(s).
+\tArmor contains %d key(s) [%d bad, %d old].\n"
+ (+ (aref status 2)
+ (aref status 10))
+ (aref status 0)
+ (aref status 1)
+ (+ (aref status 4)
+ (aref status 11)))
+ (if (zerop (aref status 9))
+ ""
+ "\tSecret keys are imported.\n")))
+ (append-to-buffer pgg-output-buffer (point-min)(point-max))
+ (pgg-process-when-success)))
+
+(provide 'pgg-gpg)
+
+;;; pgg-gpg.el ends here
--- /dev/null
+;;; pgg-parse.el --- OpenPGP packet parsing
+
+;; Copyright (C) 1999 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/10/28
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; 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.
+
+;;; Commentary:
+
+;; This module is based on
+
+;; [OpenPGP] RFC 2440: "OpenPGP Message Format"
+;; by John W. Noerenberg, II <jwn2@qualcomm.com>,
+;; Jon Callas <jon@pgp.com>, Lutz Donnerhacke <lutz@iks-jena.de>,
+;; Hal Finney <hal@pgp.com> and Rodney Thayer <rodney@unitran.com>
+;; (1998/11)
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'custom)
+
+(defgroup pgg-parse ()
+ "OpenPGP packet parsing"
+ :group 'pgg)
+
+(defcustom pgg-parse-public-key-algorithm-alist
+ '((1 . RSA) (2 . RSA-E) (3 . RSA-S) (16 . ELG-E) (17 . DSA) (20 . ELG))
+ "Alist of the assigned number to the public key algorithm."
+ :group 'pgg-parse
+ :type '(repeat
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
+
+(defcustom pgg-parse-symmetric-key-algorithm-alist
+ '((1 . IDEA) (2 . 3DES) (4 . CAST5) (5 . SAFER-SK128))
+ "Alist of the assigned number to the simmetric key algorithm."
+ :group 'pgg-parse
+ :type '(repeat
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
+
+(defcustom pgg-parse-hash-algorithm-alist
+ '((1 . MD5) (2 . SHA1) (3 . RIPEMD160) (5 . MD2))
+ "Alist of the assigned number to the cryptographic hash algorithm."
+ :group 'pgg-parse
+ :type '(repeat
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
+
+(defcustom pgg-parse-compression-algorithm-alist
+ '((0 . nil); Uncompressed
+ (1 . ZIP)
+ (2 . ZLIB))
+ "Alist of the assigned number to the compression algorithm."
+ :group 'pgg-parse
+ :type '(repeat
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
+
+(defcustom pgg-parse-signature-type-alist
+ '((0 . "Signature of a binary document")
+ (1 . "Signature of a canonical text document")
+ (2 . "Standalone signature")
+ (16 . "Generic certification of a User ID and Public Key packet")
+ (17 . "Persona certification of a User ID and Public Key packet")
+ (18 . "Casual certification of a User ID and Public Key packet")
+ (19 . "Positive certification of a User ID and Public Key packet")
+ (24 . "Subkey Binding Signature")
+ (31 . "Signature directly on a key")
+ (32 . "Key revocation signature")
+ (40 . "Subkey revocation signature")
+ (48 . "Certification revocation signature")
+ (64 . "Timestamp signature."))
+ "Alist of the assigned number to the signature type."
+ :group 'pgg-parse
+ :type '(repeat
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
+
+(defcustom pgg-ignore-packet-checksum t; XXX
+ "If non-nil checksum of each ascii armored packet will be ignored."
+ :group 'pgg-parse
+ :type 'boolean)
+
+(defvar pgg-armor-header-lines
+ '("^-----BEGIN PGP MESSAGE\\(, PART [0-9]+\\(/[0-9]+\\)?\\)?-----\r?$"
+ "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$"
+ "^-----BEGIN PGP PRIVATE KEY BLOCK-----\r?$"
+ "^-----BEGIN PGP SIGNATURE-----\r?$")
+ "Armor headers.")
+
+(eval-and-compile
+ (defalias 'pgg-char-int (if (fboundp 'char-int)
+ 'char-int
+ 'identity)))
+
+(defmacro pgg-format-key-identifier (string)
+ `(mapconcat (lambda (c) (format "%02X" (pgg-char-int c)))
+ ,string "")
+ ;; `(upcase (apply #'format "%02x%02x%02x%02x%02x%02x%02x%02x"
+ ;; (string-to-int-list ,string)))
+ )
+
+(defmacro pgg-parse-time-field (bytes)
+ `(list (logior (lsh (car ,bytes) 8)
+ (nth 1 ,bytes))
+ (logior (lsh (nth 2 ,bytes) 8)
+ (nth 3 ,bytes))
+ 0))
+
+(defmacro pgg-byte-after (&optional pos)
+ `(pgg-char-int (char-after ,(or pos `(point)))))
+
+(defmacro pgg-read-byte ()
+ `(pgg-char-int (char-after (prog1 (point) (forward-char)))))
+
+(defmacro pgg-read-bytes-string (nbytes)
+ `(buffer-substring
+ (point) (prog1 (+ ,nbytes (point))
+ (forward-char ,nbytes))))
+
+(defmacro pgg-read-bytes (nbytes)
+ `(mapcar #'pgg-char-int (pgg-read-bytes-string ,nbytes))
+ ;; `(string-to-int-list (pgg-read-bytes-string ,nbytes))
+ )
+
+(defmacro pgg-read-body-string (ptag)
+ `(if (nth 1 ,ptag)
+ (pgg-read-bytes-string (nth 1 ,ptag))
+ (pgg-read-bytes-string (- (point-max) (point)))))
+
+(defmacro pgg-read-body (ptag)
+ `(mapcar #'pgg-char-int (pgg-read-body-string ,ptag))
+ ;; `(string-to-int-list (pgg-read-body-string ,ptag))
+ )
+
+(defalias 'pgg-skip-bytes 'forward-char)
+
+(defmacro pgg-skip-header (ptag)
+ `(pgg-skip-bytes (nth 2 ,ptag)))
+
+(defmacro pgg-skip-body (ptag)
+ `(pgg-skip-bytes (nth 1 ,ptag)))
+
+(defmacro pgg-set-alist (alist key value)
+ `(setq ,alist (nconc ,alist (list (cons ,key ,value)))))
+
+(when (fboundp 'define-ccl-program)
+
+ (define-ccl-program pgg-parse-crc24
+ '(1
+ ((loop
+ (read r0) (r1 ^= r0) (r2 ^= 0)
+ (r5 = 0)
+ (loop
+ (r1 <<= 1)
+ (r1 += ((r2 >> 15) & 1))
+ (r2 <<= 1)
+ (if (r1 & 256)
+ ((r1 ^= 390) (r2 ^= 19707)))
+ (if (r5 < 7)
+ ((r5 += 1)
+ (repeat))))
+ (repeat)))))
+
+ (defun pgg-parse-crc24-string (string)
+ (let ((h (vector nil 183 1230 nil nil nil nil nil nil)))
+ (ccl-execute-on-string pgg-parse-crc24 h string)
+ (format "%c%c%c"
+ (logand (aref h 1) 255)
+ (logand (lsh (aref h 2) -8) 255)
+ (logand (aref h 2) 255)))))
+
+(defmacro pgg-parse-length-type (c)
+ `(cond
+ ((< ,c 192) (cons ,c 1))
+ ((< ,c 224)
+ (cons (+ (lsh (- ,c 192) 8)
+ (pgg-byte-after (+ 2 (point)))
+ 192)
+ 2))
+ ((= ,c 255)
+ (cons (cons (logior (lsh (pgg-byte-after (+ 2 (point))) 8)
+ (pgg-byte-after (+ 3 (point))))
+ (logior (lsh (pgg-byte-after (+ 4 (point))) 8)
+ (pgg-byte-after (+ 5 (point)))))
+ 5))
+ (t;partial body length
+ '(0 . 0))))
+
+(defun pgg-parse-packet-header ()
+ (let ((ptag (pgg-byte-after))
+ length-type content-tag packet-bytes header-bytes)
+ (if (zerop (logand 64 ptag));Old format
+ (progn
+ (setq length-type (logand ptag 3)
+ length-type (if (= 3 length-type) 0 (lsh 1 length-type))
+ content-tag (logand 15 (lsh ptag -2))
+ packet-bytes 0
+ header-bytes (1+ length-type))
+ (dotimes (i length-type)
+ (setq packet-bytes
+ (logior (lsh packet-bytes 8)
+ (pgg-byte-after (+ 1 i (point)))))))
+ (setq content-tag (logand 63 ptag)
+ length-type (pgg-parse-length-type
+ (pgg-byte-after (1+ (point))))
+ packet-bytes (car length-type)
+ header-bytes (1+ (cdr length-type))))
+ (list content-tag packet-bytes header-bytes)))
+
+(defun pgg-parse-packet (ptag)
+ (case (car ptag)
+ (1 ;Public-Key Encrypted Session Key Packet
+ (pgg-parse-public-key-encrypted-session-key-packet ptag))
+ (2 ;Signature Packet
+ (pgg-parse-signature-packet ptag))
+ (3 ;Symmetric-Key Encrypted Session Key Packet
+ (pgg-parse-symmetric-key-encrypted-session-key-packet ptag))
+ ;; 4 -- One-Pass Signature Packet
+ ;; 5 -- Secret Key Packet
+ (6 ;Public Key Packet
+ (pgg-parse-public-key-packet ptag))
+ ;; 7 -- Secret Subkey Packet
+ ;; 8 -- Compressed Data Packet
+ (9 ;Symmetrically Encrypted Data Packet
+ (pgg-read-body-string ptag))
+ (10 ;Marker Packet
+ (pgg-read-body-string ptag))
+ (11 ;Literal Data Packet
+ (pgg-read-body-string ptag))
+ ;; 12 -- Trust Packet
+ (13 ;User ID Packet
+ (pgg-read-body-string ptag))
+ ;; 14 -- Public Subkey Packet
+ ;; 60 .. 63 -- Private or Experimental Values
+ ))
+
+(defun pgg-parse-packets (&optional header-parser body-parser)
+ (let ((header-parser
+ (or header-parser
+ (function pgg-parse-packet-header)))
+ (body-parser
+ (or body-parser
+ (function pgg-parse-packet)))
+ result ptag)
+ (while (> (point-max) (1+ (point)))
+ (setq ptag (funcall header-parser))
+ (pgg-skip-header ptag)
+ (push (cons (car ptag)
+ (save-excursion
+ (funcall body-parser ptag)))
+ result)
+ (if (zerop (nth 1 ptag))
+ (goto-char (point-max))
+ (forward-char (nth 1 ptag))))
+ result))
+
+(defun pgg-parse-signature-subpacket-header ()
+ (let ((length-type (pgg-parse-length-type (pgg-byte-after))))
+ (list (pgg-byte-after (+ (cdr length-type) (point)))
+ (1- (car length-type))
+ (1+ (cdr length-type)))))
+
+(defun pgg-parse-signature-subpacket (ptag)
+ (case (car ptag)
+ (2 ;signature creation time
+ (cons 'creation-time
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes))))
+ (3 ;signature expiration time
+ (cons 'signature-expiry
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes))))
+ (4 ;exportable certification
+ (cons 'exportability (pgg-read-byte)))
+ (5 ;trust signature
+ (cons 'trust-level (pgg-read-byte)))
+ (6 ;regular expression
+ (cons 'regular-expression
+ (pgg-read-body-string ptag)))
+ (7 ;revocable
+ (cons 'revocability (pgg-read-byte)))
+ (9 ;key expiration time
+ (cons 'key-expiry
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes))))
+ ;; 10 = placeholder for backward compatibility
+ (11 ;preferred symmetric algorithms
+ (cons 'preferred-symmetric-key-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-symmetric-key-algorithm-alist))))
+ (12 ;revocation key
+ )
+ (16 ;issuer key ID
+ (cons 'key-identifier
+ (pgg-format-key-identifier (pgg-read-body-string ptag))))
+ (20 ;notation data
+ (pgg-skip-bytes 4)
+ (cons 'notation
+ (let ((name-bytes (pgg-read-bytes 2))
+ (value-bytes (pgg-read-bytes 2)))
+ (cons (pgg-read-bytes-string
+ (logior (lsh (car name-bytes) 8)
+ (nth 1 name-bytes)))
+ (pgg-read-bytes-string
+ (logior (lsh (car value-bytes) 8)
+ (nth 1 value-bytes)))))))
+ (21 ;preferred hash algorithms
+ (cons 'preferred-hash-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-hash-algorithm-alist))))
+ (22 ;preferred compression algorithms
+ (cons 'preferred-compression-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-compression-algorithm-alist))))
+ (23 ;key server preferences
+ (cons 'key-server-preferences
+ (pgg-read-body ptag)))
+ (24 ;preferred key server
+ (cons 'preferred-key-server
+ (pgg-read-body-string ptag)))
+ ;; 25 = primary user id
+ (26 ;policy URL
+ (cons 'policy-url (pgg-read-body-string ptag)))
+ ;; 27 = key flags
+ ;; 28 = signer's user id
+ ;; 29 = reason for revocation
+ ;; 100 to 110 = internal or user-defined
+ ))
+
+(defun pgg-parse-signature-packet (ptag)
+ (let* ((signature-version (pgg-byte-after))
+ (result (list (cons 'version signature-version)))
+ hashed-material field n)
+ (cond
+ ((= signature-version 3)
+ (pgg-skip-bytes 2)
+ (setq hashed-material (pgg-read-bytes 5))
+ (pgg-set-alist result
+ 'signature-type
+ (cdr (assq (pop hashed-material)
+ pgg-parse-signature-type-alist)))
+ (pgg-set-alist result
+ 'creation-time
+ (pgg-parse-time-field hashed-material))
+ (pgg-set-alist result
+ 'key-identifier
+ (pgg-format-key-identifier
+ (pgg-read-bytes-string 8)))
+ (pgg-set-alist result
+ 'public-key-algorithm (pgg-read-byte))
+ (pgg-set-alist result
+ 'hash-algorithm (pgg-read-byte)))
+ ((= signature-version 4)
+ (pgg-skip-bytes 1)
+ (pgg-set-alist result
+ 'signature-type
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-signature-type-alist)))
+ (pgg-set-alist result
+ 'public-key-algorithm
+ (pgg-read-byte))
+ (pgg-set-alist result
+ 'hash-algorithm (pgg-read-byte))
+ (when (>= 10000 (setq n (pgg-read-bytes 2)
+ n (logior (lsh (car n) 8)
+ (nth 1 n))))
+ (save-restriction
+ (narrow-to-region (point)(+ n (point)))
+ (nconc result
+ (mapcar (function cdr) ;remove packet types
+ (pgg-parse-packets
+ #'pgg-parse-signature-subpacket-header
+ #'pgg-parse-signature-subpacket)))
+ (goto-char (point-max))))
+ (when (>= 10000 (setq n (pgg-read-bytes 2)
+ n (logior (lsh (car n) 8)
+ (nth 1 n))))
+ (save-restriction
+ (narrow-to-region (point)(+ n (point)))
+ (nconc result
+ (mapcar (function cdr) ;remove packet types
+ (pgg-parse-packets
+ #'pgg-parse-signature-subpacket-header
+ #'pgg-parse-signature-subpacket)))))))
+
+ (setcdr (setq field (assq 'public-key-algorithm
+ result))
+ (cdr (assq (cdr field)
+ pgg-parse-public-key-algorithm-alist)))
+ (setcdr (setq field (assq 'hash-algorithm
+ result))
+ (cdr (assq (cdr field)
+ pgg-parse-hash-algorithm-alist)))
+ result))
+
+(defun pgg-parse-public-key-encrypted-session-key-packet (ptag)
+ (let (result)
+ (pgg-set-alist result
+ 'version (pgg-read-byte))
+ (pgg-set-alist result
+ 'key-identifier
+ (pgg-format-key-identifier
+ (pgg-read-bytes-string 8)))
+ (pgg-set-alist result
+ 'public-key-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-public-key-algorithm-alist)))
+ result))
+
+(defun pgg-parse-symmetric-key-encrypted-session-key-packet (ptag)
+ (let (result)
+ (pgg-set-alist result
+ 'version
+ (pgg-read-byte))
+ (pgg-set-alist result
+ 'symmetric-key-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-symmetric-key-algorithm-alist)))
+ result))
+
+(defun pgg-parse-public-key-packet (ptag)
+ (let* ((key-version (pgg-read-byte))
+ (result (list (cons 'version key-version)))
+ field)
+ (cond
+ ((= 3 key-version)
+ (pgg-set-alist result
+ 'creation-time
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes)))
+ (pgg-set-alist result
+ 'key-expiry (pgg-read-bytes 2))
+ (pgg-set-alist result
+ 'public-key-algorithm (pgg-read-byte)))
+ ((= 4 key-version)
+ (pgg-set-alist result
+ 'creation-time
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes)))
+ (pgg-set-alist result
+ 'public-key-algorithm (pgg-read-byte))))
+
+ (setcdr (setq field (assq 'public-key-algorithm
+ result))
+ (cdr (assq (cdr field)
+ pgg-parse-public-key-algorithm-alist)))
+ result))
+
+(defun pgg-decode-packets ()
+ (let* ((marker
+ (set-marker (make-marker)
+ (and (re-search-forward "^=")
+ (match-beginning 0))))
+ (checksum (buffer-substring (point) (+ 4 (point)))))
+ (delete-region marker (point-max))
+ (base64-decode-region (point-min) marker)
+ (when (fboundp 'pgg-parse-crc24-string)
+ (or pgg-ignore-packet-checksum
+ (string-equal
+ (base64-encode-string (pgg-parse-crc24-string
+ (buffer-string)))
+ checksum)
+ (error "PGP packet checksum does not match")))))
+
+(defun pgg-decode-armor-region (start end)
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (re-search-forward "^-+BEGIN PGP" nil t)
+ (delete-region (point-min)
+ (and (search-forward "\n\n")
+ (match-end 0)))
+ (pgg-decode-packets)
+ (goto-char (point-min))
+ (pgg-parse-packets)))
+
+(defun pgg-parse-armor (string)
+ (with-temp-buffer
+ (buffer-disable-undo)
+ (if (fboundp 'set-buffer-multibyte)
+ (set-buffer-multibyte nil))
+ (insert string)
+ (pgg-decode-armor-region (point-min)(point))))
+
+(eval-and-compile
+ (defalias 'pgg-string-as-unibyte (if (fboundp 'string-as-unibyte)
+ 'string-as-unibyte
+ 'identity)))
+
+(defun pgg-parse-armor-region (start end)
+ (pgg-parse-armor (pgg-string-as-unibyte (buffer-substring start end))))
+
+(provide 'pgg-parse)
+
+;;; pgg-parse.el ends here
--- /dev/null
+;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
+
+;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; 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:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-pgp ()
+ "PGP 2.* and 6.* interface"
+ :group 'pgg)
+
+(defcustom pgg-pgp-program "pgp"
+ "PGP 2.* and 6.* executable."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-shell-file-name "/bin/sh"
+ "File name to load inferior shells from.
+Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-shell-command-switch "-c"
+ "Switch used to have the shell execute its command line argument."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-extra-args nil
+ "Extra arguments for every PGP invocation."
+ :group 'pgg-pgp
+ :type '(choice
+ (const :tag "None" nil)
+ (string :tag "Arguments")))
+
+(defvar pgg-pgp-user-id nil
+ "PGP ID of your default identity.")
+
+(defun pgg-pgp-process-region (start end passphrase program args)
+ (let* ((errors-file-name
+ (expand-file-name (make-temp-name "pgg-errors")
+ pgg-temporary-file-directory))
+ (args
+ (append args
+ pgg-pgp-extra-args
+ (list (concat "2>" errors-file-name))))
+ (shell-file-name pgg-pgp-shell-file-name)
+ (shell-command-switch pgg-pgp-shell-command-switch)
+ (process-environment process-environment)
+ (output-buffer pgg-output-buffer)
+ (errors-buffer pgg-errors-buffer)
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (when passphrase
+ (setenv "PGPPASSFD" "0"))
+ (unwind-protect
+ (progn
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (setq process
+ (apply #'funcall
+ #'start-process-shell-command "*PGP*" output-buffer
+ program args)))
+ (set-process-sentinel process #'ignore)
+ (when passphrase
+ (process-send-string process (concat passphrase "\n")))
+ (process-send-region process start end)
+ (process-send-eof process)
+ (while (eq 'run (process-status process))
+ (accept-process-output process 5))
+ (setq status (process-status process)
+ exit-status (process-exit-status process))
+ (delete-process process)
+ (with-current-buffer output-buffer
+ (pgg-convert-lbt-region (point-min)(point-max) 'LF)
+
+ (if (memq status '(stop signal))
+ (error "%s exited abnormally: '%s'" program exit-status))
+ (if (= 127 exit-status)
+ (error "%s could not be found" program))
+
+ (set-buffer (get-buffer-create errors-buffer))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-file-contents errors-file-name)))
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ (condition-case nil
+ (delete-file errors-file-name)
+ (file-error nil)))))
+
+(defun pgg-pgp-lookup-key (string &optional type)
+ "Search keys associated with STRING."
+ (let ((args (list "+batchmode" "+language=en" "-kv" string)))
+ (with-current-buffer (get-buffer-create pgg-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (apply #'call-process pgg-pgp-program nil t nil args)
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward "^pub\\s +[0-9]+/" nil t);PGP 2.*
+ (buffer-substring (point)(+ 8 (point))))
+ ((re-search-forward "^Type" nil t);PGP 6.*
+ (beginning-of-line 2)
+ (substring
+ (nth 2 (split-string
+ (buffer-substring (point)(progn (end-of-line) (point)))))
+ 2))))))
+
+(defun pgg-pgp-encrypt-region (start end recipients)
+ "Encrypt the current region between START and END."
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (args
+ `("+encrypttoself=off +verbose=1" "+batchmode"
+ "+language=us" "-fate"
+ ,@(if recipients
+ (mapcar (lambda (rcpt) (concat "\"" rcpt "\""))
+ (append recipients
+ (if pgg-encrypt-for-me
+ (list pgg-pgp-user-id))))))))
+ (pgg-pgp-process-region start end nil pgg-pgp-program args)
+ (pgg-process-when-success nil)))
+
+(defun pgg-pgp-decrypt-region (start end)
+ "Decrypt the current region between START and END."
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp-user-id)
+ (pgg-pgp-lookup-key pgg-pgp-user-id 'encrypt)))
+ (args
+ '("+verbose=1" "+batchmode" "+language=us" "-f")))
+ (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
+ (pgg-process-when-success nil)))
+
+(defun pgg-pgp-sign-region (start end &optional clearsign)
+ "Make detached signature from text between START and END."
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp-user-id)
+ (pgg-pgp-lookup-key pgg-pgp-user-id 'sign)))
+ (args
+ (list (if clearsign "-fast" "-fbast")
+ "+verbose=1" "+language=us" "+batchmode"
+ "-u" pgg-pgp-user-id)))
+ (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
+ (pgg-process-when-success
+ (goto-char (point-min))
+ (when (re-search-forward "^-+BEGIN PGP" nil t);XXX
+ (let ((packet
+ (cdr (assq 2 (pgg-parse-armor-region
+ (progn (beginning-of-line 2)
+ (point))
+ (point-max))))))
+ (if pgg-cache-passphrase
+ (pgg-add-passphrase-cache
+ (cdr (assq 'key-identifier packet))
+ passphrase)))))))
+
+(defun pgg-pgp-verify-region (start end &optional signature)
+ "Verify region between START and END as the detached signature SIGNATURE."
+ (let* ((basename (expand-file-name "pgg" temporary-file-directory))
+ (orig-file (make-temp-name basename))
+ (args '("+verbose=1" "+batchmode" "+language=us"))
+ (orig-mode (default-file-modes)))
+ (unwind-protect
+ (progn
+ (set-default-file-modes 448)
+ (let ((coding-system-for-write 'binary)
+ jka-compr-compression-info-list jam-zcat-filename-list)
+ (write-region start end orig-file)))
+ (set-default-file-modes orig-mode))
+ (when (stringp signature)
+ (copy-file signature (setq signature (concat orig-file ".asc")))
+ (setq args (append args (list signature orig-file))))
+ (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
+ (delete-file orig-file)
+ (if signature (delete-file signature))
+ (pgg-process-when-success
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (while (re-search-forward "^warning: " nil t)
+ (delete-region (match-beginning 0)
+ (progn (beginning-of-line 2) (point)))))
+ (goto-char (point-min))
+ (when (re-search-forward "^\\.$" nil t)
+ (delete-region (point-min)
+ (progn (beginning-of-line 2)
+ (point)))))))
+
+(defun pgg-pgp-insert-key ()
+ "Insert public key at point."
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (args
+ (list "+verbose=1" "+batchmode" "+language=us" "-kxaf"
+ (concat "\"" pgg-pgp-user-id "\""))))
+ (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
+ (insert-buffer-substring pgg-output-buffer)))
+
+(defun pgg-pgp-snarf-keys-region (start end)
+ "Add all public keys in region between START and END to the keyring."
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (basename (expand-file-name "pgg" temporary-file-directory))
+ (key-file (make-temp-name basename))
+ (args
+ (list "+verbose=1" "+batchmode" "+language=us" "-kaf"
+ key-file)))
+ (let ((coding-system-for-write 'raw-text-dos))
+ (write-region start end key-file))
+ (pgg-pgp-process-region start end nil pgg-pgp-program args)
+ (delete-file key-file)
+ (pgg-process-when-success nil)))
+
+(provide 'pgg-pgp)
+
+;;; pgg-pgp.el ends here
--- /dev/null
+;;; pgg-pgp5.el --- PGP 5.* support for PGG.
+
+;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; 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:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-pgp5 ()
+ "PGP 5.* interface"
+ :group 'pgg)
+
+(defcustom pgg-pgp5-pgpe-program "pgpe"
+ "PGP 5.* 'pgpe' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgps-program "pgps"
+ "PGP 5.* 'pgps' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgpk-program "pgpk"
+ "PGP 5.* 'pgpk' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgpv-program "pgpv"
+ "PGP 5.* 'pgpv' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-shell-file-name "/bin/sh"
+ "File name to load inferior shells from.
+Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-shell-command-switch "-c"
+ "Switch used to have the shell execute its command line argument."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-extra-args nil
+ "Extra arguments for every PGP 5.* invocation."
+ :group 'pgg-pgp5
+ :type '(choice
+ (const :tag "None" nil)
+ (string :tag "Arguments")))
+
+(defvar pgg-pgp5-user-id nil
+ "PGP 5.* ID of your default identity.")
+
+(defun pgg-pgp5-process-region (start end passphrase program args)
+ (let* ((errors-file-name
+ (expand-file-name (make-temp-name "pgg-errors")
+ pgg-temporary-file-directory))
+ (args
+ (append args
+ pgg-pgp5-extra-args
+ (list (concat "2>" errors-file-name))))
+ (shell-file-name pgg-pgp5-shell-file-name)
+ (shell-command-switch pgg-pgp5-shell-command-switch)
+ (process-environment process-environment)
+ (output-buffer pgg-output-buffer)
+ (errors-buffer pgg-errors-buffer)
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (when passphrase
+ (setenv "PGPPASSFD" "0"))
+ (unwind-protect
+ (progn
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (setq process
+ (apply #'funcall
+ #'start-process-shell-command "*PGP*" output-buffer
+ program args)))
+ (set-process-sentinel process #'ignore)
+ (when passphrase
+ (process-send-string process (concat passphrase "\n")))
+ (process-send-region process start end)
+ (process-send-eof process)
+ (while (eq 'run (process-status process))
+ (accept-process-output process 5))
+ (setq status (process-status process)
+ exit-status (process-exit-status process))
+ (delete-process process)
+ (with-current-buffer output-buffer
+ (pgg-convert-lbt-region (point-min)(point-max) 'LF)
+
+ (if (memq status '(stop signal))
+ (error "%s exited abnormally: '%s'" program exit-status))
+ (if (= 127 exit-status)
+ (error "%s could not be found" program))
+
+ (set-buffer (get-buffer-create errors-buffer))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-file-contents errors-file-name)))
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ (condition-case nil
+ (delete-file errors-file-name)
+ (file-error nil)))))
+
+(defun pgg-pgp5-lookup-key (string &optional type)
+ "Search keys associated with STRING."
+ (let ((args (list "+language=en" "-l" string)))
+ (with-current-buffer (get-buffer-create pgg-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (apply #'call-process pgg-pgp5-pgpk-program nil t nil args)
+ (goto-char (point-min))
+ (when (re-search-forward "^sec" nil t)
+ (substring
+ (nth 2 (split-string
+ (buffer-substring (match-end 0)(progn (end-of-line)(point)))))
+ 2)))))
+
+(defun pgg-pgp5-encrypt-region (start end recipients)
+ "Encrypt the current region between START and END."
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (args
+ `("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1"
+ ,@(if recipients
+ (apply #'append
+ (mapcar (lambda (rcpt)
+ (list "-r"
+ (concat "\"" rcpt "\"")))
+ (append recipients
+ (if pgg-encrypt-for-me
+ (list pgg-pgp5-user-id)))))))))
+ (pgg-pgp5-process-region start end nil pgg-pgp5-pgpe-program args)
+ (pgg-process-when-success nil)))
+
+(defun pgg-pgp5-decrypt-region (start end)
+ "Decrypt the current region between START and END."
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp5-user-id)
+ (pgg-pgp5-lookup-key pgg-pgp5-user-id 'encrypt)))
+ (args
+ '("+verbose=1" "+batchmode=1" "+language=us" "-f")))
+ (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgpv-program args)
+ (pgg-process-when-success nil)))
+
+(defun pgg-pgp5-sign-region (start end &optional clearsign)
+ "Make detached signature from text between START and END."
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp5-user-id)
+ (pgg-pgp5-lookup-key pgg-pgp5-user-id 'sign)))
+ (args
+ (list (if clearsign "-fat" "-fbat")
+ "+verbose=1" "+language=us" "+batchmode=1"
+ "-u" pgg-pgp5-user-id)))
+ (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgps-program args)
+ (pgg-process-when-success
+ (when (re-search-forward "^-+BEGIN PGP SIGNATURE" nil t);XXX
+ (let ((packet
+ (cdr (assq 2 (pgg-parse-armor-region
+ (progn (beginning-of-line 2)
+ (point))
+ (point-max))))))
+ (if pgg-cache-passphrase
+ (pgg-add-passphrase-cache
+ (cdr (assq 'key-identifier packet))
+ passphrase)))))))
+
+(defun pgg-pgp5-verify-region (start end &optional signature)
+ "Verify region between START and END as the detached signature SIGNATURE."
+ (let* ((basename (expand-file-name "pgg" pgg-temporary-file-directory))
+ (orig-file (make-temp-name basename))
+ (args '("+verbose=1" "+batchmode=1" "+language=us"))
+ (orig-mode (default-file-modes)))
+ (unwind-protect
+ (progn
+ (set-default-file-modes 448)
+ (let ((coding-system-for-write 'binary)
+ jka-compr-compression-info-list jam-zcat-filename-list)
+ (write-region start end orig-file)))
+ (set-default-file-modes orig-mode))
+ (when (stringp signature)
+ (copy-file signature (setq signature (concat orig-file ".asc")))
+ (setq args (append args (list signature))))
+ (pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpv-program args)
+ (delete-file orig-file)
+ (if signature (delete-file signature))
+ (with-current-buffer pgg-errors-buffer
+ (goto-char (point-min))
+ (if (re-search-forward "^Good signature" nil t)
+ (progn
+ (set-buffer pgg-output-buffer)
+ (insert-buffer-substring pgg-errors-buffer)
+ t)
+ nil))))
+
+(defun pgg-pgp5-insert-key ()
+ "Insert public key at point."
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (args
+ (list "+verbose=1" "+batchmode=1" "+language=us" "-x"
+ (concat "\"" pgg-pgp5-user-id "\""))))
+ (pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpk-program args)
+ (insert-buffer-substring pgg-output-buffer)))
+
+(defun pgg-pgp5-snarf-keys-region (start end)
+ "Add all public keys in region between START and END to the keyring."
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (basename (expand-file-name "pgg" pgg-temporary-file-directory))
+ (key-file (make-temp-name basename))
+ (args
+ (list "+verbose=1" "+batchmode=1" "+language=us" "-a"
+ key-file)))
+ (let ((coding-system-for-write 'raw-text-dos))
+ (write-region start end key-file))
+ (pgg-pgp5-process-region start end nil pgg-pgp5-pgpk-program args)
+ (delete-file key-file)
+ (pgg-process-when-success nil)))
+
+(provide 'pgg-pgp5)
+
+;;; pgg-pgp5.el ends here
--- /dev/null
+;;; pgg.el --- glue for the various PGP implementations.
+
+;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/10/28
+;; Keywords: PGP
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; 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.
+
+
+;;; Commentary:
+;;
+
+;;; Code:
+
+(require 'pgg-def)
+(require 'pgg-parse)
+
+(eval-when-compile
+ (ignore-errors
+ (require 'w3)
+ (require 'url)))
+
+(defvar pgg-temporary-file-directory
+ (cond ((fboundp 'temp-directory) (temp-directory))
+ ((boundp 'temporary-file-directory) temporary-file-directory)
+ ("/tmp/")))
+
+;;; @ utility functions
+;;;
+
+(defvar pgg-fetch-key-function (if (fboundp 'url-insert-file-contents)
+ (function pgg-fetch-key-with-w3)))
+
+(defun pgg-invoke (func scheme &rest args)
+ (progn
+ (require (intern (format "pgg-%s" scheme)))
+ (apply 'funcall (intern (format "pgg-%s-%s" scheme func)) args)))
+
+(put 'pgg-save-coding-system 'lisp-indent-function 2)
+
+(defmacro pgg-save-coding-system (start end &rest body)
+ `(if (interactive-p)
+ (let ((buffer (current-buffer)))
+ (with-temp-buffer
+ (let (buffer-undo-list)
+ (insert-buffer-substring buffer ,start ,end)
+ (encode-coding-region (point-min)(point-max)
+ buffer-file-coding-system)
+ (prog1 (save-excursion ,@body)
+ (push nil buffer-undo-list)
+ (ignore-errors (undo))))))
+ (save-restriction
+ (narrow-to-region ,start ,end)
+ ,@body)))
+
+(defun pgg-temp-buffer-show-function (buffer)
+ (let ((window (split-window-vertically)))
+ (set-window-buffer window buffer)
+ (shrink-window-if-larger-than-buffer window)))
+
+(defun pgg-display-output-buffer (start end status)
+ (if status
+ (progn
+ (delete-region start end)
+ (insert-buffer-substring pgg-output-buffer)
+ (decode-coding-region start (point) buffer-file-coding-system))
+ (let ((temp-buffer-show-function
+ (function pgg-temp-buffer-show-function)))
+ (with-output-to-temp-buffer pgg-echo-buffer
+ (set-buffer standard-output)
+ (insert-buffer-substring pgg-errors-buffer)))))
+
+(defvar pgg-passphrase-cache (make-vector 7 0))
+
+(defvar pgg-read-passphrase nil)
+(defun pgg-read-passphrase (prompt &optional key)
+ (if (not pgg-read-passphrase)
+ (if (functionp 'read-passwd)
+ (setq pgg-read-passphrase 'read-passwd)
+ (if (load "passwd" t)
+ (setq pgg-read-passphrase 'read-passwd)
+ (autoload 'ange-ftp-read-passwd "ange-ftp")
+ (setq pgg-read-passphrase 'ange-ftp-read-passwd))))
+ (or (and pgg-cache-passphrase
+ key (setq key (pgg-truncate-key-identifier key))
+ (symbol-value (intern-soft key pgg-passphrase-cache)))
+ (funcall pgg-read-passphrase prompt)))
+
+(defun pgg-add-passphrase-cache (key passphrase)
+ (setq key (pgg-truncate-key-identifier key))
+ (set (intern key pgg-passphrase-cache)
+ passphrase)
+ (run-at-time pgg-passphrase-cache-expiry nil
+ #'pgg-remove-passphrase-cache
+ key))
+
+(defun pgg-remove-passphrase-cache (key)
+ (let ((passphrase (symbol-value (intern-soft key pgg-passphrase-cache))))
+ (when passphrase
+ (fillarray passphrase ?_)
+ (unintern key pgg-passphrase-cache))))
+
+(defmacro pgg-convert-lbt-region (start end lbt)
+ `(let ((pgg-conversion-end (set-marker (make-marker) ,end)))
+ (goto-char ,start)
+ (case ,lbt
+ (CRLF
+ (while (progn
+ (end-of-line)
+ (> (marker-position pgg-conversion-end) (point)))
+ (insert "\r")
+ (forward-line 1)))
+ (LF
+ (while (re-search-forward "\r$" pgg-conversion-end t)
+ (replace-match ""))))))
+
+(put 'pgg-as-lbt 'lisp-indent-function 3)
+
+(defmacro pgg-as-lbt (start end lbt &rest body)
+ `(let ((inhibit-read-only t)
+ buffer-read-only
+ buffer-undo-list)
+ (pgg-convert-lbt-region ,start ,end ,lbt)
+ (let ((,end (point)))
+ ,@body)
+ (push nil buffer-undo-list)
+ (ignore-errors (undo))))
+
+(put 'pgg-process-when-success 'lisp-indent-function 0)
+
+(defmacro pgg-process-when-success (&rest body)
+ `(with-current-buffer pgg-output-buffer
+ (if (zerop (buffer-size)) nil ,@body t)))
+
+;;; @ interface functions
+;;;
+
+;;;###autoload
+(defun pgg-encrypt-region (start end rcpts &optional sign)
+ "Encrypt the current region between START and END for RCPTS.
+If optional argument SIGN is non-nil, do a combined sign and encrypt."
+ (interactive
+ (list (region-beginning)(region-end)
+ (split-string (read-string "Recipients: ") "[ \t,]+")))
+ (let ((status
+ (pgg-save-coding-system start end
+ (pgg-invoke "encrypt-region" (or pgg-scheme pgg-default-scheme)
+ (point-min) (point-max) rcpts sign))))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-encrypt (rcpts &optional sign start end)
+ "Encrypt the current buffer for RCPTS.
+If optional argument SIGN is non-nil, do a combined sign and encrypt.
+If optional arguments START and END are specified, only encrypt within
+the region."
+ (interactive (list (split-string (read-string "Recipients: ") "[ \t,]+")))
+ (let* ((start (or start (point-min)))
+ (end (or end (point-max)))
+ (status (pgg-encrypt-region start end rcpts sign)))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-decrypt-region (start end)
+ "Decrypt the current region between START and END."
+ (interactive "r")
+ (let* ((buf (current-buffer))
+ (packet (cdr (assq 1 (with-temp-buffer
+ (insert-buffer buf)
+ (pgg-decode-armor-region
+ (point-min) (point-max))))))
+ (key (cdr (assq 'key-identifier packet)))
+ (pgg-default-user-id
+ (if key
+ (concat "0x" (pgg-truncate-key-identifier key))
+ pgg-default-user-id))
+ (status
+ (pgg-save-coding-system start end
+ (pgg-invoke "decrypt-region" (or pgg-scheme pgg-default-scheme)
+ (point-min) (point-max)))))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-decrypt (&optional start end)
+ "Decrypt the current buffer.
+If optional arguments START and END are specified, only decrypt within
+the region."
+ (interactive "")
+ (let* ((start (or start (point-min)))
+ (end (or end (point-max)))
+ (status (pgg-decrypt-region start end)))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-sign-region (start end &optional cleartext)
+ "Make the signature from text between START and END.
+If the optional 3rd argument CLEARTEXT is non-nil, it does not create
+a detached signature.
+If this function is called interactively, CLEARTEXT is enabled
+and the the output is displayed."
+ (interactive "r")
+ (let ((status (pgg-save-coding-system start end
+ (pgg-invoke "sign-region" (or pgg-scheme pgg-default-scheme)
+ (point-min) (point-max)
+ (or (interactive-p) cleartext)))))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-sign (&optional cleartext start end)
+ "Sign the current buffer.
+If the optional argument CLEARTEXT is non-nil, it does not create a
+detached signature.
+If optional arguments START and END are specified, only sign data
+within the region.
+If this function is called interactively, CLEARTEXT is enabled
+and the the output is displayed."
+ (interactive "")
+ (let* ((start (or start (point-min)))
+ (end (or end (point-max)))
+ (status (pgg-sign-region start end (or (interactive-p) cleartext))))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-verify-region (start end &optional signature fetch)
+ "Verify the current region between START and END.
+If the optional 3rd argument SIGNATURE is non-nil, it is treated as
+the detached signature of the current region.
+
+If the optional 4th argument FETCH is non-nil, we attempt to fetch the
+signer's public key from `pgg-default-keyserver-address'."
+ (interactive "r")
+ (let* ((packet
+ (if (null signature) nil
+ (with-temp-buffer
+ (buffer-disable-undo)
+ (if (fboundp 'set-buffer-multibyte)
+ (set-buffer-multibyte nil))
+ (insert-file-contents signature)
+ (cdr (assq 2 (pgg-decode-armor-region
+ (point-min)(point-max)))))))
+ (key (cdr (assq 'key-identifier packet)))
+ status keyserver)
+ (and (stringp key)
+ pgg-query-keyserver
+ (setq key (concat "0x" (pgg-truncate-key-identifier key)))
+ (null (pgg-lookup-key key))
+ (or fetch (interactive-p))
+ (y-or-n-p (format "Key %s not found; attempt to fetch? " key))
+ (setq keyserver
+ (or (cdr (assq 'preferred-key-server packet))
+ pgg-default-keyserver-address))
+ (pgg-fetch-key keyserver key))
+ (setq status
+ (pgg-save-coding-system start end
+ (pgg-invoke "verify-region" (or pgg-scheme pgg-default-scheme)
+ (point-min) (point-max) signature)))
+ (when (interactive-p)
+ (let ((temp-buffer-show-function
+ (function pgg-temp-buffer-show-function)))
+ (with-output-to-temp-buffer pgg-echo-buffer
+ (set-buffer standard-output)
+ (insert-buffer-substring (if status pgg-output-buffer
+ pgg-errors-buffer)))))
+ status))
+
+;;;###autoload
+(defun pgg-verify (&optional signature fetch start end)
+ "Verify the current buffer.
+If the optional argument SIGNATURE is non-nil, it is treated as
+the detached signature of the current region.
+If the optional argument FETCH is non-nil, we attempt to fetch the
+signer's public key from `pgg-default-keyserver-address'.
+If optional arguments START and END are specified, only verify data
+within the region."
+ (interactive "")
+ (let* ((start (or start (point-min)))
+ (end (or end (point-max)))
+ (status (pgg-verify-region start end signature fetch)))
+ (when (interactive-p)
+ (let ((temp-buffer-show-function
+ (function pgg-temp-buffer-show-function)))
+ (with-output-to-temp-buffer pgg-echo-buffer
+ (set-buffer standard-output)
+ (insert-buffer-substring (if status pgg-output-buffer
+ pgg-errors-buffer)))))))
+
+;;;###autoload
+(defun pgg-insert-key ()
+ "Insert the ASCII armored public key."
+ (interactive)
+ (pgg-invoke "insert-key" (or pgg-scheme pgg-default-scheme)))
+
+;;;###autoload
+(defun pgg-snarf-keys-region (start end)
+ "Import public keys in the current region between START and END."
+ (interactive "r")
+ (pgg-save-coding-system start end
+ (pgg-invoke "snarf-keys-region" (or pgg-scheme pgg-default-scheme)
+ start end)))
+
+;;;###autoload
+(defun pgg-snarf-keys ()
+ "Import public keys in the current buffer."
+ (interactive "")
+ (pgg-snarf-keys-region (point-min) (point-max)))
+
+(defun pgg-lookup-key (string &optional type)
+ (pgg-invoke "lookup-key" (or pgg-scheme pgg-default-scheme) string type))
+
+(defvar pgg-insert-url-function (function pgg-insert-url-with-w3))
+
+(defun pgg-insert-url-with-w3 (url)
+ (ignore-errors
+ (require 'w3)
+ (require 'url)
+ (let (buffer-file-name)
+ (url-insert-file-contents url))))
+
+(defvar pgg-insert-url-extra-arguments nil)
+(defvar pgg-insert-url-program nil)
+
+(defun pgg-insert-url-with-program (url)
+ (let ((args (copy-sequence pgg-insert-url-extra-arguments))
+ process)
+ (insert
+ (with-temp-buffer
+ (setq process
+ (apply #'start-process " *PGG url*" (current-buffer)
+ pgg-insert-url-program (nconc args (list url))))
+ (set-process-sentinel process #'ignore)
+ (while (eq 'run (process-status process))
+ (accept-process-output process 5))
+ (delete-process process)
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ (buffer-string)))))
+
+(defun pgg-fetch-key (keyserver key)
+ "Attempt to fetch a KEY from KEYSERVER for addition to PGP or GnuPG keyring."
+ (with-current-buffer (get-buffer-create pgg-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (let ((proto (if (string-match "^[a-zA-Z\\+\\.\\\\-]+:" keyserver)
+ (substring keyserver 0 (1- (match-end 0))))))
+ (save-excursion
+ (funcall pgg-insert-url-function
+ (if proto keyserver
+ (format "http://%s:11371/pks/lookup?op=get&search=%s"
+ keyserver key))))
+ (when (re-search-forward "^-+BEGIN" nil 'last)
+ (delete-region (point-min) (match-beginning 0))
+ (when (re-search-forward "^-+END" nil t)
+ (delete-region (progn (end-of-line) (point))
+ (point-max)))
+ (insert "\n")
+ (with-temp-buffer
+ (insert-buffer-substring pgg-output-buffer)
+ (pgg-snarf-keys-region (point-min)(point-max)))))))
+
+
+(provide 'pgg)
+
+;;; pgg.el ends here
(set-buffer (process-buffer process))
(goto-char pop3-read-point)
(while (not (search-forward "\r\n" nil t))
- (accept-process-output process 3)
+ (accept-process-output process 0 500)
(goto-char pop3-read-point))
(setq match-end (point))
(goto-char pop3-read-point)
(save-excursion
(set-buffer (process-buffer process))
(while (not (re-search-forward "^\\.\r\n" nil t))
- (accept-process-output process 3)
+ (accept-process-output process 0 500)
;; bill@att.com ... to save wear and tear on the heap
;; uncommented because the condensed version below is a problem for
;; some.
When it is set non-nil, only buffers or strings with strictly
HZ-encoded are decoded."
:type 'boolean
- :group 'gnus)
+ :group 'mime)
(defcustom rfc1843-decode-hzp t
"HZ+ decoding support if non-nil.
The document of HZ+ 0.78 specification can be found at
ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc"
:type 'boolean
- :group 'gnus)
+ :group 'mime)
(defcustom rfc1843-newsgroups-regexp "chinese\\|hz"
"Regexp of newsgroups in which might be HZ encoded."
:type 'string
- :group 'gnus)
+ :group 'mime)
(defun rfc1843-decode-region (from to)
"Decode HZ in the region between FROM and TO."
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl)
+ (defvar message-posting-charset))
(require 'qp)
(require 'mm-util)
(iso-8859-4 . Q)
(iso-8859-5 . B)
(koi8-r . B)
- (iso-8859-7 . Q)
- (iso-8859-8 . Q)
+ (iso-8859-7 . B)
+ (iso-8859-8 . B)
(iso-8859-9 . Q)
(iso-8859-14 . Q)
(iso-8859-15 . Q)
(iso-2022-jp-2 . B)
(iso-2022-int-1 . B))
"Alist of MIME charsets to RFC2047 encodings.
-Valid encodings are nil, `Q' and `B'.")
+Valid encodings are nil, `Q' and `B'. These indicate binary (no) encoding,
+quoted-printable and base64 respectively.")
(defvar rfc2047-encoding-function-alist
'((Q . rfc2047-q-encode-region)
(prog1
(match-string 0)
(delete-region (match-beginning 0) (match-end 0)))))
+ ;; Remove newlines between decoded words. Though such things
+ ;; must not be essentially there.
+ (save-restriction
+ (narrow-to-region e (point))
+ (goto-char e)
+ (while (re-search-forward "[\n\r]+" nil t)
+ (replace-match " "))
+ (goto-char (point-max)))
(when (and (mm-multibyte-p)
mail-parse-charset
(not (eq mail-parse-charset 'us-ascii))
(point-min) (point-max)
(if keyfile
keyfile
- (smime-get-key-by-email
+ (smime-get-key-with-certs-by-email
(completing-read
(concat "Sign using which key? "
(if smime-keys (concat "(default " (caar smime-keys) ") ")
(defun smime-get-key-by-email (email)
(cadr (assoc email smime-keys)))
+(defun smime-get-key-with-certs-by-email (email)
+ (cdr (assoc email smime-keys)))
+
(provide 'smime)
;;; smime.el ends here
--- /dev/null
+;;; spam-stat.el --- detecting spam based on statistics
+
+;; Copyright (C) 2002 Alex Schroeder
+
+;; Author: Alex Schroeder <alex@gnu.org>
+;; Maintainer: Alex Schroeder <alex@gnu.org>
+;; Version: 0.3.5
+;; Keywords: spam filtering gnus
+;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SpamStat
+
+;; This file is NOT part of GNU Emacs.
+
+;; This 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 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 implements spam analysis according to Paul Graham in "A Plan
+;; for Spam". The basis for all this is a statistical distribution of
+;; words for your spam and non-spam mails. We need this information
+;; in a hash-table so that the analysis can use the information when
+;; looking at your mails. Therefore, before you begin, you need tons
+;; of mails (Graham uses 4000 non-spam and 4000 spam mails for his
+;; experiments).
+;;
+;; The main interface to using spam-stat, are the following functions:
+;;
+;; `spam-stat-buffer-is-spam' -- called in a buffer, that buffer is
+;; considered to be a new spam mail; use this for new mail that has
+;; not been processed before
+;;
+;; `spam-stat-buffer-is-no-spam' -- called in a buffer, that buffer
+;; is considered to be a new non-spam mail; use this for new mail that
+;; has not been processed before
+;;
+;; `spam-stat-buffer-change-to-spam' -- called in a buffer, that
+;; buffer is no longer considered to be normal mail but spam; use this
+;; to change the status of a mail that has already been processed as
+;; non-spam
+;;
+;; `spam-stat-buffer-change-to-non-spam' -- called in a buffer, that
+;; buffer is no longer considered to be spam but normal mail; use this
+;; to change the status of a mail that has already been processed as
+;; spam
+;;
+;; `spam-stat-save' -- save the hash table to the file; the filename
+;; used is stored in the variable `spam-stat-file'
+;;
+;; `spam-stat-load' -- load the hash table from a file; the filename
+;; used is stored in the variable `spam-stat-file'
+;;
+;; `spam-stat-score-word' -- return the spam score for a word
+;;
+;; `spam-stat-score-buffer' -- return the spam score for a buffer
+;;
+;; `spam-stat-split-fancy' -- for fancy mail splitting; add
+;; the rule (: spam-stat-split-fancy) to `nnmail-split-fancy'
+;;
+;; This requires the following in your ~/.gnus file:
+;;
+;; (require 'spam-stat)
+;; (spam-stat-load)
+
+;;; Testing:
+
+;; Typical test will involve calls to the following functions:
+;;
+;; Reset: (setq spam-stat (make-hash-table :test 'equal))
+;; Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam")
+;; Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc")
+;; Save table: (spam-stat-save)
+;; File size: (nth 7 (file-attributes spam-stat-file))
+;; Number of words: (hash-table-count spam-stat)
+;; Test spam: (spam-stat-test-directory "~/Mail/mail/spam")
+;; Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc")
+;; Reduce table size: (spam-stat-reduce-size)
+;; Save table: (spam-stat-save)
+;; File size: (nth 7 (file-attributes spam-stat-file))
+;; Number of words: (hash-table-count spam-stat)
+;; Test spam: (spam-stat-test-directory "~/Mail/mail/spam")
+;; Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc")
+
+;;; Dictionary Creation:
+
+;; Typically, you will filter away mailing lists etc. using specific
+;; rules in `nnmail-split-fancy'. Somewhere among these rules, you
+;; will filter spam. Here is how you would create your dictionary:
+
+;; Reset: (setq spam-stat (make-hash-table :test 'equal))
+;; Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam")
+;; Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc")
+;; Repeat for any other non-spam group you need...
+;; Reduce table size: (spam-stat-reduce-size)
+;; Save table: (spam-stat-save)
+
+;;; Todo:
+
+;; Speed it up. Integrate with Gnus such that it uses spam and expiry
+;; marks to call the appropriate functions when leaving the summary
+;; buffer and saves the hash table when leaving Gnus. More testing:
+;; More mails, disabling SpamAssassin, double checking algorithm, find
+;; improved algorithm.
+
+;;; Thanks:
+
+;; Ted Zlatanov <tzz@lifelogs.com>
+;; Jesper Harder <harder@myrealbox.com>
+;; Dan Schmidt <dfan@dfan.org>
+
+\f
+
+;;; Code:
+
+(defgroup spam-stat nil
+ "Statistical spam detection for Emacs.
+Use the functions to build a dictionary of words and their statistical
+distribution in spam and non-spam mails. Then use a function to determine
+wether a buffer contains spam or not."
+ :group 'gnus)
+
+(defcustom spam-stat-file "~/.spam-stat.el"
+ "File used to save and load the dictionary.
+See `spam-stat-to-hash-table' for the format of the file."
+ :type 'file
+ :group 'spam-stat)
+
+(defcustom spam-stat-unknown-word-score 0.2
+ "The score to use for unknown words.
+Also used for words that don't appear often enough."
+ :type 'number
+ :group 'spam-stat)
+
+(defcustom spam-stat-max-word-length 15
+ "Only words shorter than this will be considered."
+ :type 'integer
+ :group 'spam-stat)
+
+(defcustom spam-stat-max-buffer-length 10240
+ "Only the beginning of buffers will be analyzed.
+This variable says how many characters this will be."
+ :type 'integer
+ :group 'spam-stat)
+
+(defcustom spam-stat-split-fancy-spam-group "mail.spam"
+ "Name of the group where spam should be stored, if
+`spam-stat-split-fancy' is used in fancy splitting rules."
+ :type 'string
+ :group 'spam-stat)
+
+(defvar spam-stat-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)
+ table)
+ "Syntax table used when processing mails for statistical analysis.
+The important part is which characters are word constituents.")
+
+(defvar spam-stat-buffer nil
+ "Buffer to use for scoring while splitting.
+This is set by hooking into Gnus.")
+
+(defvar spam-stat-buffer-name " *spam stat buffer*"
+ "Name of the `spam-stat-buffer'.")
+
+;; Functions missing in Emacs 20
+
+(when (memq nil (mapcar 'fboundp
+ '(gethash hash-table-count make-hash-table
+ mapc puthash)))
+ (require 'cl)
+ (unless (fboundp 'puthash)
+ ;; alias puthash is missing from Emacs 20 cl-extra.el
+ (defalias 'puthash 'cl-puthash)))
+
+(eval-when-compile
+ (unless (fboundp 'with-syntax-table)
+ ;; Imported from Emacs 21.2
+ (defmacro with-syntax-table (table &rest body) "\
+Evaluate BODY with syntax table of current buffer set to a copy of TABLE.
+The syntax table of the current buffer is saved, BODY is evaluated, and the
+saved table is restored, even in case of an abnormal exit.
+Value is what BODY returns."
+ (let ((old-table (make-symbol "table"))
+ (old-buffer (make-symbol "buffer")))
+ `(let ((,old-table (syntax-table))
+ (,old-buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (set-syntax-table (copy-syntax-table ,table))
+ ,@body)
+ (save-current-buffer
+ (set-buffer ,old-buffer)
+ (set-syntax-table ,old-table))))))))
+
+;; Hooking into Gnus
+
+(defun spam-stat-store-current-buffer ()
+ "Store a copy of the current buffer in `spam-stat-buffer'."
+ (save-excursion
+ (let ((str (buffer-string)))
+ (set-buffer (get-buffer-create spam-stat-buffer-name))
+ (erase-buffer)
+ (insert str)
+ (setq spam-stat-buffer (current-buffer)))))
+
+(defun spam-stat-store-gnus-article-buffer ()
+ "Store a copy of the current article in `spam-stat-buffer'.
+This uses `gnus-article-buffer'."
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (spam-stat-store-current-buffer)))
+
+(add-hook 'nnmail-prepare-incoming-message-hook
+ 'spam-stat-store-current-buffer)
+(add-hook 'gnus-select-article-hook
+ 'spam-stat-store-gnus-article-buffer)
+
+;; Data -- not using defstruct in order to save space and time
+
+(defvar spam-stat (make-hash-table :test 'equal)
+ "Hash table used to store the statistics.
+Use `spam-stat-load' to load the file.
+Every word is used as a key in this table. The value is a vector.
+Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
+`spam-stat-bad', and `spam-stat-score' to access this vector.")
+
+(defvar spam-stat-ngood 0
+ "The number of good mails in the dictionary.")
+
+(defvar spam-stat-nbad 0
+ "The number of bad mails in the dictionary.")
+
+(defsubst spam-stat-good (entry)
+ "Return the number of times this word belongs to good mails."
+ (aref entry 0))
+
+(defsubst spam-stat-bad (entry)
+ "Return the number of times this word belongs to bad mails."
+ (aref entry 1))
+
+(defsubst spam-stat-score (entry)
+ "Set the score of this word."
+ (if entry
+ (aref entry 2)
+ spam-stat-unknown-word-score))
+
+(defsubst spam-stat-set-good (entry value)
+ "Set the number of times this word belongs to good mails."
+ (aset entry 0 value))
+
+(defsubst spam-stat-set-bad (entry value)
+ "Set the number of times this word belongs to bad mails."
+ (aset entry 1 value))
+
+(defsubst spam-stat-set-score (entry value)
+ "Set the score of this word."
+ (aset entry 2 value))
+
+(defsubst spam-stat-make-entry (good bad)
+ "Return a vector with the given properties."
+ (let ((entry (vector good bad nil)))
+ (spam-stat-set-score entry (spam-stat-compute-score entry))
+ entry))
+
+;; Computing
+
+(defun spam-stat-compute-score (entry)
+ "Compute the score of this word. 1.0 means spam."
+ ;; promote all numbers to floats for the divisions
+ (let* ((g (* 2.0 (spam-stat-good entry)))
+ (b (float (spam-stat-bad entry))))
+ (cond ((< (+ g b) 5)
+ .2)
+ ((= 0 spam-stat-ngood)
+ .99)
+ ((= 0 spam-stat-nbad)
+ .01)
+ (t
+ (max .01
+ (min .99 (/ (/ b spam-stat-nbad)
+ (+ (/ g spam-stat-ngood)
+ (/ b spam-stat-nbad)))))))))
+
+;; Parsing
+
+(defmacro with-spam-stat-max-buffer-size (&rest body)
+ "Narrows the buffer down to the first 4k characters, then evaluates BODY."
+ `(save-restriction
+ (when (> (- (point-max)
+ (point-min))
+ spam-stat-max-buffer-length)
+ (narrow-to-region (point-min)
+ (+ (point-min) spam-stat-max-buffer-length)))
+ ,@body))
+
+(defun spam-stat-buffer-words ()
+ "Return a hash table of words and number of occurences in the buffer."
+ (with-spam-stat-max-buffer-size
+ (with-syntax-table spam-stat-syntax-table
+ (goto-char (point-min))
+ (let ((result (make-hash-table :test 'equal))
+ word count)
+ (while (re-search-forward "\\w+" nil t)
+ (setq word (match-string-no-properties 0)
+ count (1+ (gethash word result 0)))
+ (when (< (length word) spam-stat-max-word-length)
+ (puthash word count result)))
+ result))))
+
+(defun spam-stat-buffer-is-spam ()
+ "Consider current buffer to be a new spam mail."
+ (setq spam-stat-nbad (1+ spam-stat-nbad))
+ (maphash
+ (lambda (word count)
+ (let ((entry (gethash word spam-stat)))
+ (if entry
+ (spam-stat-set-bad entry (+ count (spam-stat-bad entry)))
+ (setq entry (spam-stat-make-entry 0 count)))
+ (spam-stat-set-score entry (spam-stat-compute-score entry))
+ (puthash word entry spam-stat)))
+ (spam-stat-buffer-words)))
+
+(defun spam-stat-buffer-is-non-spam ()
+ "Consider current buffer to be a new non-spam mail."
+ (setq spam-stat-ngood (1+ spam-stat-ngood))
+ (maphash
+ (lambda (word count)
+ (let ((entry (gethash word spam-stat)))
+ (if entry
+ (spam-stat-set-good entry (+ count (spam-stat-good entry)))
+ (setq entry (spam-stat-make-entry count 0)))
+ (spam-stat-set-score entry (spam-stat-compute-score entry))
+ (puthash word entry spam-stat)))
+ (spam-stat-buffer-words)))
+
+(defun spam-stat-buffer-change-to-spam ()
+ "Consider current buffer no longer normal mail but spam."
+ (setq spam-stat-nbad (1+ spam-stat-nbad)
+ spam-stat-ngood (1- spam-stat-ngood))
+ (maphash
+ (lambda (word count)
+ (let ((entry (gethash word spam-stat)))
+ (if (not entry)
+ (error "This buffer has unknown words in it.")
+ (spam-stat-set-good entry (- (spam-stat-good entry) count))
+ (spam-stat-set-bad entry (+ (spam-stat-bad entry) count))
+ (spam-stat-set-score entry (spam-stat-compute-score entry))
+ (puthash word entry spam-stat))))
+ (spam-stat-buffer-words)))
+
+(defun spam-stat-buffer-change-to-non-spam ()
+ "Consider current buffer no longer spam but normal mail."
+ (setq spam-stat-nbad (1- spam-stat-nbad)
+ spam-stat-ngood (1+ spam-stat-ngood))
+ (maphash
+ (lambda (word count)
+ (let ((entry (gethash word spam-stat)))
+ (if (not entry)
+ (error "This buffer has unknown words in it.")
+ (spam-stat-set-good entry (+ (spam-stat-good entry) count))
+ (spam-stat-set-bad entry (- (spam-stat-bad entry) count))
+ (spam-stat-set-score entry (spam-stat-compute-score entry))
+ (puthash word entry spam-stat))))
+ (spam-stat-buffer-words)))
+
+;; Saving and Loading
+
+(defun spam-stat-save ()
+ "Save the `spam-stat' hash table as lisp file."
+ (interactive)
+ (with-temp-buffer
+ (let ((standard-output (current-buffer)))
+ (insert "(setq spam-stat (spam-stat-to-hash-table '(")
+ (maphash (lambda (word entry)
+ (prin1 (list word
+ (spam-stat-good entry)
+ (spam-stat-bad entry))))
+ spam-stat)
+ (insert ")) spam-stat-ngood "
+ (number-to-string spam-stat-ngood)
+ " spam-stat-nbad "
+ (number-to-string spam-stat-nbad)
+ ")"))
+ (write-file spam-stat-file)))
+
+(defun spam-stat-load ()
+ "Read the `spam-stat' hash table from disk."
+ (load-file spam-stat-file))
+
+(defun spam-stat-to-hash-table (entries)
+ "Turn list ENTRIES into a hash table and store as `spam-stat'.
+Every element in ENTRIES has the form \(WORD GOOD BAD) where WORD is
+the word string, NGOOD is the number of good mails it has appeared in,
+NBAD is the number of bad mails it has appeared in, GOOD is the number
+of times it appeared in good mails, and BAD is the number of times it
+has appeared in bad mails."
+ (let ((table (make-hash-table :test 'equal)))
+ (mapc (lambda (l)
+ (puthash (car l)
+ (spam-stat-make-entry (nth 1 l) (nth 2 l))
+ table))
+ entries)
+ table))
+
+(defun spam-stat-reset ()
+ "Reset `spam-stat' to an empty hash-table.
+This deletes all the statistics."
+ (interactive)
+ (setq spam-stat (make-hash-table :test 'equal)))
+
+;; Scoring buffers
+
+(defvar spam-stat-score-data nil
+ "Raw data used in the last run of `spam-stat-score-buffer'.")
+
+(defsubst spam-stat-score-word (word)
+ "Return score for WORD.
+The default score for unknown words is stored in
+`spam-stat-unknown-word-score'."
+ (spam-stat-score (gethash word spam-stat)))
+
+(defun spam-stat-buffer-words-with-scores ()
+ "Process current buffer, return the 15 most conspicuous words.
+These are the words whose spam-stat differs the most from 0.5.
+The list returned contains elements of the form \(WORD SCORE DIFF),
+where DIFF is the difference between SCORE and 0.5."
+ (with-spam-stat-max-buffer-size
+ (with-syntax-table spam-stat-syntax-table
+ (let (result word score)
+ (maphash (lambda (word ignore)
+ (setq score (spam-stat-score-word word)
+ result (cons (list word score (abs (- score 0.5)))
+ result)))
+ (spam-stat-buffer-words))
+ (setq result (sort result (lambda (a b) (< (nth 2 b) (nth 2 a)))))
+ (setcdr (nthcdr 14 result) nil)
+ result))))
+
+(defun spam-stat-score-buffer ()
+ "Return a score describing the spam-probability for this buffer."
+ (setq spam-stat-score-data (spam-stat-buffer-words-with-scores))
+ (let* ((probs (mapcar (lambda (e) (cadr e)) spam-stat-score-data))
+ (prod (apply #'* probs)))
+ (/ prod (+ prod (apply #'* (mapcar #'(lambda (x) (- 1 x))
+ probs))))))
+
+(defun spam-stat-split-fancy ()
+ "Return the name of the spam group if the current mail is spam.
+Use this function on `nnmail-split-fancy'. If you are interested in
+the raw data used for the last run of `spam-stat-score-buffer',
+check the variable `spam-stat-score-data'."
+ (condition-case var
+ (progn
+ (set-buffer spam-stat-buffer)
+ (goto-char (point-min))
+ (when (> (spam-stat-score-buffer) 0.9)
+ (when (boundp 'nnmail-split-trace)
+ (mapc (lambda (entry)
+ (push entry nnmail-split-trace))
+ spam-stat-score-data))
+ spam-stat-split-fancy-spam-group))
+ (error (message "Error in spam-stat-split-fancy: %S" var)
+ nil)))
+
+;; Testing
+
+(defun spam-stat-process-directory (dir func)
+ "Process all the regular files in directory DIR using function FUNC."
+ (let* ((files (directory-files dir t "^[^.]"))
+ (max (/ (length files) 100.0))
+ (count 0))
+ (with-temp-buffer
+ (dolist (f files)
+ (when (and (file-readable-p f)
+ (file-regular-p f))
+ (setq count (1+ count))
+ (message "Reading %s: %.2f%%" dir (/ count max))
+ (insert-file-contents f)
+ (funcall func)
+ (erase-buffer))))))
+
+(defun spam-stat-process-spam-directory (dir)
+ "Process all the regular files in directory DIR as spam."
+ (interactive "D")
+ (spam-stat-process-directory dir 'spam-stat-buffer-is-spam))
+
+(defun spam-stat-process-non-spam-directory (dir)
+ "Process all the regular files in directory DIR as non-spam."
+ (interactive "D")
+ (spam-stat-process-directory dir 'spam-stat-buffer-is-non-spam))
+
+(defun spam-stat-count ()
+ "Return size of `spam-stat'."
+ (interactive)
+ (hash-table-count spam-stat))
+
+(defun spam-stat-test-directory (dir)
+ "Test all the regular files in directory DIR for spam.
+If the result is 1.0, then all files are considered spam.
+If the result is 0.0, non of the files is considered spam.
+You can use this to determine error rates."
+ (interactive "D")
+ (let* ((files (directory-files dir t "^[^.]"))
+ (total (length files))
+ (score 0.0); float
+ (max (/ total 100.0)); float
+ (count 0))
+ (with-temp-buffer
+ (dolist (f files)
+ (when (and (file-readable-p f)
+ (file-regular-p f))
+ (setq count (1+ count))
+ (message "Reading %.2f%%, score %.2f%%"
+ (/ count max) (/ score count))
+ (insert-file-contents f)
+ (when (> (spam-stat-score-buffer) 0.9)
+ (setq score (1+ score)))
+ (erase-buffer))))
+ (message "Final score: %d / %d = %f" score total (/ score total))))
+
+;; Shrinking the dictionary
+
+(defun spam-stat-reduce-size (&optional count)
+ "Reduce the size of `spam-stat'.
+This removes all words that occur less than COUNT from the dictionary.
+COUNT defaults to 5"
+ (interactive)
+ (setq count (or count 5))
+ (maphash (lambda (key entry)
+ (when (< (+ (spam-stat-good entry)
+ (spam-stat-bad entry))
+ count)
+ (remhash key spam-stat)))
+ spam-stat))
+
+(provide 'spam-stat)
+
+;;; spam-stat.el ends here
;;; Commentary:
+;;; This module addresses a few aspects of spam control under Gnus. Page
+;;; breaks are used for grouping declarations and documentation relating to
+;;; each particular aspect.
+
+;;; The integration with Gnus is not yet complete. See various `FIXME'
+;;; comments, below, for supplementary explanations or discussions.
+
+;;; Several TODO items are marked as such
+
;;; Code:
-(require 'dns)
+(require 'gnus-sum)
+
+(require 'gnus-uu) ; because of key prefix issues
+(require 'gnus) ; for the definitions of group content classification and spam processors
+
+;; FIXME! We should not require `message' until we actually need
+;; them. Best would be to declare needed functions as auto-loadable.
(require 'message)
-;;; Blackholes
+;; Attempt to load BBDB macros
+(eval-when-compile
+ (condition-case nil
+ (require 'bbdb-com)
+ (file-error (defalias 'bbdb-search 'ignore))))
+
+;; autoload executable-find
+(eval-and-compile
+ ;; executable-find is not autoloaded in Emacs 20
+ (autoload 'executable-find "executable"))
+
+;; autoload ifile-spam-filter
+(eval-and-compile
+ (autoload 'ifile-spam-filter "ifile-gnus"))
+
+;; autoload query-dig
+(eval-and-compile
+ (autoload 'query-dig "dig"))
+
+;; autoload query-dns
+(eval-and-compile
+ (autoload 'query-dns "dns"))
+
+;;; Main parameters.
+
+(defgroup spam nil
+ "Spam configuration.")
+
+(defcustom spam-directory "~/News/spam/"
+ "Directory for spam whitelists and blacklists."
+ :type 'directory
+ :group 'spam)
+
+(defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
+ "The location of the whitelist.
+The file format is one regular expression per line.
+The regular expression is matched against the address."
+ :type 'file
+ :group 'spam)
+
+(defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
+ "The location of the blacklist.
+The file format is one regular expression per line.
+The regular expression is matched against the address."
+ :type 'file
+ :group 'spam)
+
+(defcustom spam-use-dig t
+ "Whether query-dig should be used instead of query-dns."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-blacklist nil
+ "Whether the blacklist should be used by spam-split."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-whitelist nil
+ "Whether the whitelist should be used by spam-split."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-blackholes nil
+ "Whether blackholes should be used by spam-split."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-bogofilter nil
+ "Whether bogofilter should be used by spam-split."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-BBDB nil
+ "Whether BBDB should be used by spam-split."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-ifile nil
+ "Whether ifile should be used by spam-split."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-split-group "spam"
+ "Group name where incoming spam should be put by spam-split."
+ :type 'string
+ :group 'spam)
+
+;; FIXME! The mailgroup list evidently depends on other choices made by the
+;; user, so the built-in default below is not likely to be appropriate.
+(defcustom spam-junk-mailgroups (cons spam-split-group '("mail.junk" "poste.pourriel"))
+ "Mailgroups with spam contents.
+All unmarked article in such group receive the spam mark on group entry."
+ :type '(repeat (string :tag "Group"))
+ :group 'spam)
+
+(defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org" "dev.null.dk" "relays.visi.com")
+ "List of blackhole servers."
+ :type '(repeat (string :tag "Server"))
+ :group 'spam)
+
+(defcustom spam-ham-marks (list 'gnus-del-mark 'gnus-read-mark 'gnus-killed-mark 'gnus-kill-file-mark 'gnus-low-score-mark)
+ "Marks considered as being ham (positively not spam).
+Such articles will be processed as ham (non-spam) on group exit."
+ :type '(set
+ (variable-item gnus-del-mark)
+ (variable-item gnus-read-mark)
+ (variable-item gnus-killed-mark)
+ (variable-item gnus-kill-file-mark)
+ (variable-item gnus-low-score-mark))
+ :group 'spam)
+
+(defcustom spam-spam-marks (list 'gnus-spam-mark)
+ "Marks considered as being spam (positively spam).
+Such articles will be transmitted to `bogofilter -s' on group exit."
+ :type '(set
+ (variable-item gnus-spam-mark)
+ (variable-item gnus-killed-mark)
+ (variable-item gnus-kill-file-mark)
+ (variable-item gnus-low-score-mark))
+ :group 'spam)
+
+(defcustom spam-face 'gnus-splash-face
+ "Face for spam-marked articles"
+ :type 'face
+ :group 'spam)
+
+(defgroup spam-bogofilter nil
+ "Spam bogofilter configuration."
+ :group 'spam)
+
+(defcustom spam-bogofilter-output-buffer-name "*Bogofilter Output*"
+ "Name of buffer when displaying `bogofilter -v' output."
+ :type 'string
+ :group 'spam-bogofilter)
+
+(defcustom spam-bogofilter-initial-timeout 40
+ "Timeout in seconds for the initial reply from the `bogofilter' program."
+ :type 'integer
+ :group 'spam-bogofilter)
+
+(defcustom spam-bogofilter-subsequent-timeout 15
+ "Timeout in seconds for any subsequent reply from the `bogofilter' program."
+ :type 'integer
+ :group 'spam-bogofilter)
+
+(defcustom spam-bogofilter-path (executable-find "bogofilter")
+ "File path of the Bogofilter executable program."
+ :type '(choice (file :tag "Location of bogofilter")
+ (const :tag "Bogofilter is not installed"))
+ :group 'spam-bogofilter)
+
+;; FIXME! In the following regexp, we should explain which tool produces
+;; which kind of header. I do not even remember them all by now. X-Junk
+;; (and previously X-NoSpam) are produced by the `NoSpam' tool, which has
+;; never been published, so it might not be reasonable leaving it in the
+;; list.
+(defcustom spam-bogofilter-spaminfo-header-regexp "^X-\\(jf\\|Junk\\|NoSpam\\|Spam\\|SB\\)[^:]*:"
+ "Regexp for spam markups in headers.
+Markup from spam recognisers, as well as `Xref', are to be removed from
+articles before they get registered by Bogofilter."
+ :type 'regexp
+ :group 'spam-bogofilter)
+
+;;; Key bindings for spam control.
+
+(gnus-define-keys gnus-summary-mode-map
+ "St" spam-bogofilter-score
+ "Sx" gnus-summary-mark-as-spam
+ "Mst" spam-bogofilter-score
+ "Msx" gnus-summary-mark-as-spam
+ "\M-d" gnus-summary-mark-as-spam)
+
+;;; How to highlight a spam summary line.
+
+;; TODO: How do we redo this every time spam-face is customized?
+
+(push '((eq mark gnus-spam-mark) . spam-face)
+ gnus-summary-highlight)
+
+;; convenience functions
+(defun spam-group-spam-contents-p (group)
+ (if (stringp group)
+ (or (member group spam-junk-mailgroups)
+ (memq 'gnus-group-spam-classification-spam (gnus-parameter-spam-contents group)))
+ nil))
+
+(defun spam-group-ham-contents-p (group)
+ (if (stringp group)
+ (memq 'gnus-group-spam-classification-ham (gnus-parameter-spam-contents group))
+ nil))
+
+(defun spam-group-processor-p (group processor)
+ (if (and (stringp group)
+ (symbolp processor))
+ (member processor (car (gnus-parameter-spam-process group)))
+ nil))
+
+(defun spam-group-processor-bogofilter-p (group)
+ (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
+
+(defun spam-group-processor-ifile-p (group)
+ (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
+
+(defun spam-group-processor-blacklist-p (group)
+ (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
+
+(defun spam-group-processor-whitelist-p (group)
+ (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist))
-(defvar spam-blackhole-servers
- '("bl.spamcop.net" "relays.ordb.org" "dev.null.dk"
- "relays.visi.com" "rbl.maps.vix.com")
- "List of blackhole servers.")
+(defun spam-group-processor-BBDB-p (group)
+ (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
-(defvar spam-split-group "spam" "Default group name for spam-split.")
+;;; Hooks dispatching. A bit raw for now.
+
+(defun spam-summary-prepare ()
+ (spam-mark-junk-as-spam-routine))
+
+(defun spam-summary-prepare-exit ()
+ ;; The spam processors are invoked for any group, spam or ham or neither
+ (when (and spam-bogofilter-path
+ (spam-group-processor-bogofilter-p gnus-newsgroup-name))
+ (spam-bogofilter-register-routine))
+
+ (when (spam-group-processor-ifile-p gnus-newsgroup-name)
+ (spam-ifile-register-routine))
+
+ (when (spam-group-processor-bogofilter-p gnus-newsgroup-name)
+ (spam-blacklist-register-routine))
+
+ ;; Only for spam groups, we expire and maybe move articles
+ (when (spam-group-spam-contents-p gnus-newsgroup-name)
+ (spam-mark-spam-as-expired-and-move-routine (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
+
+ (when (spam-group-ham-contents-p gnus-newsgroup-name)
+ (when (spam-group-processor-whitelist-p gnus-newsgroup-name)
+ (spam-whitelist-register-routine))
+ (when (spam-group-processor-BBDB-p gnus-newsgroup-name)
+ (spam-BBDB-register-routine))))
+
+(add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
+(add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
+
+(defun spam-mark-junk-as-spam-routine ()
+ ;; check the global list of group names spam-junk-mailgroups and the group parameters
+ (when (spam-group-spam-contents-p gnus-newsgroup-name)
+ (let ((articles gnus-newsgroup-articles)
+ article)
+ (while articles
+ (setq article (pop articles))
+ (when (eq (gnus-summary-article-mark article) gnus-unread-mark)
+ (gnus-summary-mark-article article gnus-spam-mark))))))
+
+(defun spam-mark-spam-as-expired-and-move-routine (&optional group)
+ (let ((articles gnus-newsgroup-articles)
+ article)
+ (while articles
+ (setq article (pop articles))
+ (when (eq (gnus-summary-article-mark article) gnus-spam-mark)
+ (gnus-summary-mark-article article gnus-expirable-mark)
+ (when (stringp group)
+ (let ((gnus-current-article article))
+ (gnus-summary-move-article nil group)))))))
+
+(defun spam-generic-register-routine (spam-func ham-func)
+ (let ((articles gnus-newsgroup-articles)
+ article mark ham-articles spam-articles spam-mark-values ham-mark-values)
+
+ ;; marks are stored as symbolic values, so we have to dereference them for memq to work
+ ;; we wouldn't have to do this if gnus-summary-article-mark returned a symbol.
+ (dolist (mark spam-ham-marks)
+ (push (symbol-value mark) ham-mark-values))
+
+ (dolist (mark spam-spam-marks)
+ (push (symbol-value mark) spam-mark-values))
+
+ (while articles
+ (setq article (pop articles)
+ mark (gnus-summary-article-mark article))
+ (cond ((memq mark spam-mark-values) (push article spam-articles))
+ ((memq article gnus-newsgroup-saved))
+ ((memq mark ham-mark-values) (push article ham-articles))))
+ (when (and ham-articles ham-func)
+ (mapc ham-func ham-articles)) ; we use mapc because unlike mapcar it discards the return values
+ (when (and spam-articles spam-func)
+ (mapc spam-func spam-articles)))) ; we use mapc because unlike mapcar it discards the return values
+
+(defun spam-fetch-field-from-fast (article)
+ "Fetch the `from' field quickly, using the Gnus internal gnus-data-list function"
+ (if (and (numberp article)
+ (assoc article (gnus-data-list nil)))
+ (mail-header-from (gnus-data-header (assoc article (gnus-data-list nil))))
+ nil))
+
+\f
+;;;; Spam determination.
+
+(defvar spam-list-of-checks
+ '((spam-use-blacklist . spam-check-blacklist)
+ (spam-use-whitelist . spam-check-whitelist)
+ (spam-use-BBDB . spam-check-BBDB)
+ (spam-use-ifile . spam-check-ifile)
+ (spam-use-blackholes . spam-check-blackholes)
+ (spam-use-bogofilter . spam-check-bogofilter))
+"The spam-list-of-checks list contains pairs associating a parameter
+variable with a spam checking function. If the parameter variable is
+true, then the checking function is called, and its value decides what
+happens. Each individual check may return `nil', `t', or a mailgroup
+name. The value `nil' means that the check does not yield a decision,
+and so, that further checks are needed. The value `t' means that the
+message is definitely not spam, and that further spam checks should be
+inhibited. Otherwise, a mailgroup name is returned where the mail
+should go, and further checks are also inhibited. The usual mailgroup
+name is the value of `spam-split-group', meaning that the message is
+definitely a spam.")
+
+(defun spam-split ()
+ "Split this message into the `spam' group if it is spam.
+This function can be used as an entry in `nnmail-split-fancy', for
+example like this: (: spam-split)
+
+See the Info node `(gnus)Fancy Mail Splitting' for more details."
+ (interactive)
+
+ (let ((list-of-checks spam-list-of-checks)
+ decision)
+ (while (and list-of-checks (not decision))
+ (let ((pair (pop list-of-checks)))
+ (when (symbol-value (car pair))
+ (setq decision (funcall (cdr pair))))))
+ (if (eq decision t)
+ nil
+ decision)))
+\f
+;;;; Blackholes.
(defun spam-check-blackholes ()
- "Check the Receieved headers for blackholed relays."
+ "Check the Received headers for blackholed relays."
(let ((headers (message-fetch-field "received"))
ips matches)
(when headers
(goto-char (point-min))
(while (re-search-forward
"\\[\\([0-9]+.[0-9]+.[0-9]+.[0-9]+\\)\\]" nil t)
- (message "blackhole search found host IP %s" (match-string 1))
+ (message "Blackhole search found host IP %s." (match-string 1))
(push (mapconcat 'identity
(nreverse (split-string (match-string 1) "\\."))
".")
ips)))
(dolist (server spam-blackhole-servers)
(dolist (ip ips)
- (when (query-dns (concat ip "." server))
- (push (list ip server (query-dns (concat ip "." server) 'TXT))
- matches))))
- matches)))
+ (let ((query-string (concat ip "." server)))
+ (if spam-use-dig
+ (let ((query-result (query-dig query-string)))
+ (when query-result
+ (message "spam detected with blackhole check of relay %s (dig query result '%s')" query-string query-result)
+ (push (list ip server query-result)
+ matches)))
+ ;; else, if not using dig.el
+ (when (query-dns query-string)
+ (push (list ip server (query-dns query-string 'TXT))
+ matches)))))))
+ (when matches
+ spam-split-group)))
+\f
+;;;; BBDB
+;;; original idea for spam-check-BBDB from Alexander Kotelnikov <sacha@giotto.sj.ru>
-;;; Black- and white-lists
+;; all this is done inside a condition-case to trap errors
+(condition-case nil
+ (progn
-(defvar spam-directory "~/News/spam/"
- "When spam files are kept.")
+ (require 'bbdb-com)
-(defvar spam-whitelist (expand-file-name "whitelist" spam-directory)
- "The location of the whitelist.
-The file format is one regular expression per line.
-The regular expression is matched against the address.")
+ (defun spam-enter-ham-BBDB (from)
+ "Enter an address into the BBDB; implies ham (non-spam) sender"
+ (when (stringp from)
+ (let* ((parsed-address (gnus-extract-address-components from))
+ (name (or (car parsed-address) "Ham Sender"))
+ (net-address (car (cdr parsed-address))))
+ (message "Adding address %s to BBDB" from)
+ (when (and net-address
+ (not (bbdb-search (bbdb-records) nil nil net-address)))
+ (bbdb-create-internal name nil net-address nil nil "ham sender added by spam.el")))))
-(defvar spam-blacklist (expand-file-name "blacklist" spam-directory)
- "The location of the blacklist.
-The file format is one regular expression per line.
-The regular expression is matched against the address.")
+ (defun spam-BBDB-register-routine ()
+ (spam-generic-register-routine
+ ;; spam function
+ nil
+ ;; ham function
+ (lambda (article)
+ (spam-enter-ham-BBDB (spam-fetch-field-from-fast article)))))
+
+ (defun spam-check-BBDB ()
+ "Mail from people in the BBDB is never considered spam"
+ (let ((who (message-fetch-field "from")))
+ (when who
+ (setq who (regexp-quote (cadr (gnus-extract-address-components who))))
+ (if (bbdb-search (bbdb-records) nil nil who) nil spam-split-group)))))
+
+ (file-error (progn
+ (setq spam-list-of-checks
+ (delete (assoc 'spam-use-BBDB spam-list-of-checks)
+ spam-list-of-checks))
+ (defun spam-check-BBDB ()
+ message "spam-check-BBDB was invoked, but it shouldn't have")
+ (defun spam-BBDB-register-routine ()
+ (spam-generic-register-routine nil nil)))))
+
+\f
+;;;; ifile
+;;; uses ifile-gnus.el from http://www.ai.mit.edu/people/jhbrown/ifile-gnus.html
+;;; check the ifile backend; return nil if the mail was NOT classified as spam
+;;; TODO: we can't (require 'ifile-gnus), because it will insinuate itself automatically
+(defun spam-check-ifile ()
+ (let ((ifile-primary-spam-group spam-split-group))
+ (ifile-spam-filter nil)))
+
+;; TODO: add ifile registration
+;; We need ifile-gnus.el to support nnimap; we could feel the message
+;; directly to ifile like we do with bogofilter but that's ugly.
+(defun spam-ifile-register-routine ()
+ (spam-generic-register-routine nil nil))
+
+\f
+;;;; Blacklists and whitelists.
(defvar spam-whitelist-cache nil)
(defvar spam-blacklist-cache nil)
-(defun spam-enter-whitelist (address &optional blacklist)
- "Enter ADDRESS into the whitelist.
-Optional arg BLACKLIST, if non-nil, means to enter in the blacklist instead."
+(defun spam-enter-whitelist (address)
+ "Enter ADDRESS into the whitelist."
(interactive "sAddress: ")
- (let ((file (if blacklist spam-blacklist spam-whitelist)))
- (unless (file-exists-p (file-name-directory file))
- (make-directory (file-name-directory file) t))
- (save-excursion
- (set-buffer
- (find-file-noselect file))
- (goto-char (point-max))
- (unless (bobp)
- (insert "\n"))
- (insert address "\n")
- (save-buffer)
- (spam-refresh-list-cache))))
+ (spam-enter-list address spam-whitelist)
+ (setq spam-whitelist-cache nil))
(defun spam-enter-blacklist (address)
"Enter ADDRESS into the blacklist."
(interactive "sAddress: ")
- (spam-enter-whitelist address t))
+ (spam-enter-list address spam-blacklist)
+ (setq spam-blacklist-cache nil))
+
+(defun spam-enter-list (address file)
+ "Enter ADDRESS into the given FILE, either the whitelist or the blacklist."
+ (unless (file-exists-p (file-name-directory file))
+ (make-directory (file-name-directory file) t))
+ (save-excursion
+ (set-buffer
+ (find-file-noselect file))
+ (goto-char (point-max))
+ (unless (bobp)
+ (insert "\n"))
+ (insert address "\n")
+ (save-buffer)))
+
+;;; returns nil if the sender is in the whitelist, spam-split-group otherwise
+(defun spam-check-whitelist ()
+ ;; FIXME! Should it detect when file timestamps change?
+ (unless spam-whitelist-cache
+ (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
+ (if (spam-from-listed-p spam-whitelist-cache) nil spam-split-group))
+
+(defun spam-check-blacklist ()
+ ;; FIXME! Should it detect when file timestamps change?
+ (unless spam-blacklist-cache
+ (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
+ (and (spam-from-listed-p spam-blacklist-cache) spam-split-group))
(eval-and-compile
(defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
'point-at-eol
'line-end-position)))
-(defun spam-parse-whitelist (&optional blacklist)
- (let ((file (if blacklist spam-blacklist spam-whitelist))
- contents address)
- (when (file-exists-p file)
+(defun spam-parse-list (file)
+ (when (file-readable-p file)
+ (let (contents address)
(with-temp-buffer
(insert-file-contents file)
(while (not (eobp))
(push address contents))))
(nreverse contents))))
-(defun spam-refresh-list-cache ()
- (setq spam-whitelist-cache (spam-parse-whitelist))
- (setq spam-blacklist-cache (spam-parse-whitelist t)))
-
-(defun spam-address-whitelisted-p (address &optional blacklist)
- (let ((cache (if blacklist spam-blacklist-cache spam-whitelist-cache))
+(defun spam-from-listed-p (cache)
+ (let ((from (message-fetch-field "from"))
found)
- (while (and (not found)
- cache)
- (when (string-match (pop cache) address)
- (setq found t)))
+ (while cache
+ (when (string-match (pop cache) from)
+ (setq found t
+ cache nil)))
found))
-(defun spam-address-blacklisted-p (address &optional blacklist)
- (if address
- (spam-address-whitelisted-p address t)
- nil))
+(defun spam-blacklist-register-routine ()
+ (spam-generic-register-routine
+ ;; the spam function
+ (lambda (article)
+ (let ((from (spam-fetch-field-from-fast article)))
+ (when (stringp from)
+ (spam-enter-blacklist from))))
+ ;; the ham function
+ nil))
-;; Function for nnmail-split-fancy: returns 'spam' if an article is deemed to be spam
-(defun spam-split ()
- "Split this message into the `spam' group if it is spam.
-This function can be used as an entry in `nnmail-split-fancy', for
-example like this: (: spam-split)
+(defun spam-whitelist-register-routine ()
+ (spam-generic-register-routine
+ ;; the spam function
+ nil
+ ;; the ham function
+ (lambda (article)
+ (let ((from (spam-fetch-field-from-fast article)))
+ (when (stringp from)
+ (spam-enter-whitelist from))))))
-See the Info node `(gnus)Fancy Mail Splitting' for more details."
+\f
+;;;; Bogofilter
+
+;;; See Paul Graham article, at `http://www.paulgraham.com/spam.html'.
+
+;;; This page is for those wanting to control spam with the help of Eric
+;;; Raymond's speedy Bogofilter, see http://www.tuxedo.org/~esr/bogofilter.
+;;; This has been tested with a locally patched copy of version 0.4.
+
+;;; Make sure Bogofilter is installed. Bogofilter internally uses Judy fast
+;;; associative arrays, so you need to install Judy first, and Bogofilter
+;;; next. Fetch both distributions by visiting the following links and
+;;; downloading the latest version of each:
+;;;
+;;; http://sourceforge.net/projects/judy/
+;;; http://www.tuxedo.org/~esr/bogofilter/
+;;;
+;;; Unpack the Judy distribution and enter its main directory. Then do:
+;;;
+;;; ./configure
+;;; make
+;;; make install
+;;;
+;;; You will likely need to become super-user for the last step. Then, unpack
+;;; the Bogofilter distribution and enter its main directory:
+;;;
+;;; make
+;;; make install
+;;;
+;;; Here as well, you need to become super-user for the last step. Now,
+;;; initialize your word lists by doing, under your own identity:
+;;;
+;;; mkdir ~/.bogofilter
+;;; touch ~/.bogofilter/badlist
+;;; touch ~/.bogofilter/goodlist
+;;;
+;;; These two files are text files you may edit, but you normally don't!
+
+;;; The `M-d' command gets added to Gnus summary mode, marking current article
+;;; as spam, showing it with the `H' mark. Whenever you see a spam article,
+;;; make sure to mark its summary line with `M-d' before leaving the group.
+;;; Some groups, as per variable `spam-junk-mailgroups' below, receive articles
+;;; from Gnus splitting on clues added by spam recognisers, so for these
+;;; groups, we tack an `H' mark at group entry for all summary lines which
+;;; would otherwise have no other mark. Make sure to _remove_ `H' marks for
+;;; any article which is _not_ genuine spam, before leaving such groups: you
+;;; may use `M-u' to "unread" the article, or `d' for declaring it read the
+;;; non-spam way. When you leave a group, all `H' marked articles, saved or
+;;; unsaved, are sent to Bogofilter which will study them as spam samples.
+
+;;; Messages may also be deleted in various other ways, and unless
+;;; `spam-ham-marks-form' gets overridden below, marks `R' and `r' for default
+;;; read or explicit delete, marks `X' and 'K' for automatic or explicit
+;;; kills, as well as mark `Y' for low scores, are all considered to be
+;;; associated with articles which are not spam. This assumption might be
+;;; false, in particular if you use kill files or score files as means for
+;;; detecting genuine spam, you should then adjust `spam-ham-marks-form'. When
+;;; you leave a group, all _unsaved_ articles bearing any the above marks are
+;;; sent to Bogofilter which will study these as not-spam samples. If you
+;;; explicit kill a lot, you might sometimes end up with articles marked `K'
+;;; which you never saw, and which might accidentally contain spam. Best is
+;;; to make sure that real spam is marked with `H', and nothing else.
+
+;;; All other marks do not contribute to Bogofilter pre-conditioning. In
+;;; particular, ticked, dormant or souped articles are likely to contribute
+;;; later, when they will get deleted for real, so there is no need to use
+;;; them prematurely. Explicitly expired articles do not contribute, command
+;;; `E' is a way to get rid of an article without Bogofilter ever seeing it.
+
+;;; In a word, with a minimum of care for associating the `H' mark for spam
+;;; articles only, Bogofilter training all gets fairly automatic. You should
+;;; do this until you get a few hundreds of articles in each category, spam
+;;; or not. The shell command `head -1 ~/.bogofilter/*' shows both article
+;;; counts. The command `S S' in summary mode, either for debugging or for
+;;; curiosity, triggers Bogofilter into displaying in another buffer the
+;;; "spamicity" score of the current article (between 0.0 and 1.0), together
+;;; with the article words which most significantly contribute to the score.
+
+;;; The real way for using Bogofilter, however, is to have some use tool like
+;;; `procmail' for invoking it on message reception, then adding some
+;;; recognisable header in case of detected spam. Gnus splitting rules might
+;;; later trip on these added headers and react by sorting such articles into
+;;; specific junk folders as per `spam-junk-mailgroups'. Here is a possible
+;;; `.procmailrc' contents (still untested -- please tell me how it goes):
+;;;
+;;; :0HBf:
+;;; * ? bogofilter
+;;; | formail -bfI "X-Spam-Status: Yes"
+
+(defun spam-check-bogofilter ()
+ ;; Dynamic spam check. I do not know how to check the exit status,
+ ;; so instead, read `bogofilter -v' output.
+ (when (and spam-use-bogofilter spam-bogofilter-path)
+ (spam-bogofilter-articles nil "-v" (list (gnus-summary-article-number)))
+ (when (save-excursion
+ (set-buffer spam-bogofilter-output-buffer-name)
+ (goto-char (point-min))
+ (re-search-forward "Spamicity: \\(0\\.9\\|1\\.0\\)" nil t))
+ spam-split-group)))
+
+(defun spam-bogofilter-score ()
+ "Use `bogofilter -v' on the current article.
+This yields the 15 most discriminant words for this article and the
+spamicity coefficient of each, and the overall article spamicity."
(interactive)
+ (when (and spam-use-bogofilter spam-bogofilter-path)
+ (spam-bogofilter-articles nil "-v" (list (gnus-summary-article-number)))
+ (with-current-buffer spam-bogofilter-output-buffer-name
+ (unless (zerop (buffer-size))
+ (if (<= (count-lines (point-min) (point-max)) 1)
+ (progn
+ (goto-char (point-max))
+ (when (bolp)
+ (backward-char 1))
+ (message "%s" (buffer-substring (point-min) (point))))
+ (goto-char (point-min))
+ (display-buffer (current-buffer)))))))
+
+(defun spam-bogofilter-register-routine ()
+ (let ((articles gnus-newsgroup-articles)
+ article mark ham-articles spam-articles spam-mark-values ham-mark-values)
+
+ ;; marks are stored as symbolic values, so we have to dereference them for memq to work
+ ;; we wouldn't have to do this if gnus-summary-article-mark returned a symbol.
+ (dolist (mark spam-ham-marks)
+ (push (symbol-value mark) ham-mark-values))
+
+ (dolist (mark spam-spam-marks)
+ (push (symbol-value mark) spam-mark-values))
- ;; refresh the cache if it's necessary
- (unless spam-whitelist-cache (spam-refresh-list-cache))
- (unless spam-blacklist-cache (spam-refresh-list-cache))
+ (while articles
+ (setq article (pop articles)
+ mark (gnus-summary-article-mark article))
+ (cond ((memq mark spam-mark-values) (push article spam-articles))
+ ((memq article gnus-newsgroup-saved))
+ ((memq mark ham-mark-values) (push article ham-articles))))
+ (when ham-articles
+ (spam-bogofilter-articles "ham" "-n" ham-articles))
+ (when spam-articles
+ (spam-bogofilter-articles "SPAM" "-s" spam-articles))))
- (let* ((from (message-fetch-field "from"))
- (group nil))
- (when (spam-check-blackholes)
- (setq group spam-split-group))
- (unless (spam-address-whitelisted-p from) ; unless the address is whitelisted,
- (when (spam-address-blacklisted-p from) ; check if it's blacklisted,
- (setq group spam-split-group)) ; and if so, set the group to spam-split-group
- group)))
+(defun spam-bogofilter-articles (type option articles)
+ (let ((output-buffer (get-buffer-create spam-bogofilter-output-buffer-name))
+ (article-copy (get-buffer-create " *Bogofilter Article Copy*"))
+ (remove-regexp (concat spam-bogofilter-spaminfo-header-regexp "\\|Xref:"))
+ (counter 0)
+ prefix process article)
+ (when type
+ (setq prefix (format "Studying %d articles as %s..." (length articles)
+ type))
+ (message "%s" prefix))
+ (save-excursion (set-buffer output-buffer) (erase-buffer))
+ (setq process (start-process "bogofilter" output-buffer
+ spam-bogofilter-path "-F" option))
+ (process-kill-without-query process t)
+ (unwind-protect
+ (save-window-excursion
+ (while articles
+ (setq counter (1+ counter))
+ (when prefix
+ (message "%s %d" prefix counter))
+ (setq article (pop articles))
+ (gnus-summary-goto-subject article)
+ (gnus-summary-show-article t)
+ (gnus-eval-in-buffer-window article-copy
+ (insert-buffer-substring gnus-original-article-buffer)
+ ;; Remove spam classification redundant headers: they may induce
+ ;; unwanted biases in later analysis.
+ (message-remove-header remove-regexp t)
+ ;; Bogofilter really wants From envelopes for counting articles.
+ ;; Fake one at the beginning, make sure there will be no other.
+ (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 ">")))
+ (process-send-region process (point-min) (point-max))
+ (erase-buffer))))
+ ;; Sending the EOF is unwind-protected. This is to prevent lost copies
+ ;; of `bogofilter', hung on reading their standard input, in case the
+ ;; whole registering process gets interrupted by the user.
+ (process-send-eof process))
+ (kill-buffer article-copy)
+ ;; Receive process output. It sadly seems that we still have to protect
+ ;; ourselves against hung `bogofilter' processes.
+ (let ((status (process-status process))
+ (timeout (* 1000 spam-bogofilter-initial-timeout))
+ (quanta 200)) ; also counted in milliseconds
+ (while (and (not (eq status 'exit)) (> timeout 0))
+ ;; `accept-process-output' timeout is counted in microseconds.
+ (setq timeout (if (accept-process-output process 0 (* 1000 quanta))
+ (* 1000 spam-bogofilter-subsequent-timeout)
+ (- timeout quanta))
+ status (process-status process)))
+ (if (eq status 'exit)
+ (when prefix
+ (message "%s done!" prefix))
+ ;; Sigh! The process did time out... Become brutal!
+ (interrupt-process process)
+ (message "%s %d INTERRUPTED! (Article %d, status %s)"
+ (or prefix "Bogofilter process...")
+ counter article status)
+ ;; Give some time for user to read. Sitting redisplays but gives up
+ ;; if input is pending. Sleeping does not give up, but it does not
+ ;; redisplay either. Mix both: let's redisplay and not give up.
+ (sit-for 1)
+ (sleep-for 3)))))
(provide 'spam)
-;;; spam.el ends here
+;;; spam.el ends here.
;;; time-date.el --- Date and time handling functions
-;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu Umeda <umerin@mse.kyutech.ac.jp>
(parse-time-string
;; `parse-time-string' isn't sufficiently general or
;; robust. It fails to grok some of the formats that
- ;; timzeone does (e.g. dodgy post-2000 stuff from some
+ ;; timezone does (e.g. dodgy post-2000 stuff from some
;; Elms) and either fails or returns bogus values. Lars
;; reverted this change, but that loses non-trivially
;; often for me. -- fx
--- /dev/null
+;;; yenc.el --- elisp native yenc decoder
+;; Copyright (c) 2002 Free Software Foundation, Inc.
+
+;; Author: Jesper Harder <harder@ifa.au.dk>
+;; Keywords: yenc 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:
+
+;; Functions for decoding yenc encoded messages.
+;;
+;; Limitations:
+;;
+;; * Does not handle multipart messages.
+;; * No support for external decoders.
+;; * Doesn't check the crc32 checksum (if present).
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defconst yenc-begin-line
+ "^=ybegin.*$")
+
+(defconst yenc-decoding-vector
+ [214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230
+ 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247
+ 248 249 250 251 252 253 254 255 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
+ 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
+ 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
+ 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
+ 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
+ 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139
+ 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156
+ 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173
+ 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
+ 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
+ 208 209 210 211 212 213])
+
+;;;###autoload
+(defun yenc-decode-region (start end)
+ "Yenc decode region between START and END using an internal decoder."
+ (interactive "r")
+ (let (work-buffer)
+ (unwind-protect
+ (save-excursion
+ (goto-char start)
+ (when (re-search-forward yenc-begin-line end t)
+ (let ((first (match-end 0))
+ (header-alist (yenc-parse-line (match-string 0)))
+ bytes last footer-alist char)
+ (when (re-search-forward "^=ypart.*$" end t)
+ (setq first (match-end 0)))
+ (when (re-search-forward "^=yend.*$" end t)
+ (setq last (match-beginning 0))
+ (setq footer-alist (yenc-parse-line (match-string 0)))
+ (let (default-enable-multibyte-characters)
+ (setq work-buffer (generate-new-buffer " *yenc-work*")))
+ (while (< first last)
+ (setq char (char-after first))
+ (cond ((or (eq char ?\r)
+ (eq char ?\n)))
+ ((eq char ?=)
+ (setq char (char-after (incf first)))
+ (with-current-buffer work-buffer
+ (insert-char (mod (- char 106) 256) 1)))
+ (t
+ (with-current-buffer work-buffer
+ ;;(insert-char (mod (- char 42) 256) 1)
+ (insert-char (aref yenc-decoding-vector char) 1))))
+ (incf first))
+ (setq bytes (buffer-size work-buffer))
+ (unless (and (= (cdr (assq 'size header-alist)) bytes)
+ (= (cdr (assq 'size footer-alist)) bytes))
+ (message "Warning: Size mismatch while decoding."))
+ (goto-char start)
+ (delete-region start end)
+ (insert-buffer-substring work-buffer))))
+ (and work-buffer (kill-buffer work-buffer))))))
+
+;;;###autoload
+(defun yenc-extract-filename ()
+ "Extract file name from an yenc header."
+ (save-excursion
+ (when (re-search-forward yenc-begin-line nil t)
+ (cdr (assoc 'name (yenc-parse-line (match-string 0)))))))
+
+(defun yenc-parse-line (str)
+ "Extract file name and size from STR."
+ (let (result name)
+ (when (string-match "^=y.*size=\\([0-9]+\\)" str)
+ (push (cons 'size (string-to-number (match-string 1 str))) result))
+ (when (string-match "^=y.*name=\\(.*\\)$" str)
+ (setq name (match-string 1 str))
+ ;; Remove trailing white space
+ (when (string-match " +$" name)
+ (setq name (substring name 0 (match-beginning 0))))
+ (push (cons 'name name) result))
+ result))
+
+(provide 'yenc)
+
+;;; yenc.el ends here
message
message-[0-9]*
sieve
+pgg
gnustmp.texi
*.dvi
*.dvi-x
old
thumb*
auto
+*.tpt
+2003-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Group Line Specification): Addition.
+
+2003-01-03 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.texi: Fix typos.
+
+2003-01-02 Simon Josefsson <jas@extundo.com>
+
+ * gnus.texi (Troubleshooting): Add.
+
+2003-01-02 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus.texi (Article Buttons): Regexps are case insensitive here.
+
+2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Summary Generation Commands): Addition.
+
+2003-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.texi (Message Headers): Added example.
+ (Message Headers): Addition.
+
+2002-12-31 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus.texi (Top): Add pointers to related manuals. Suggested by
+ Reiner Steib.
+
+2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Saving Articles): Addition.
+
+2002-12-30 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus.texi (Blackholes): added information on query-dig and
+ dig.el; users are told that using blackhole checks is OK now
+
+2002-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Loose Threads): add
+ gnus-summary-make-false-root-always.
+ (Finding the Parent): Change name of nnweb server.
+
+2002-12-22 Jesper Harder <harder@ifa.au.dk>
+
+ * emacs-mime.texi: Fix typos. Index variables. Add
+ mm-automatic-external-display, mm-w3m-safe-url-regexp and
+ mm-external-terminal-program.
+
+2002-12-20 Jesper Harder <harder@ifa.au.dk>
+
+ * message.texi (Message Headers): Add message-allow-no-recipients.
+ (Various Commands): Add TAB and message-tab-body-function.
+
+2002-12-19 Paul Jarc <prj@po.cwru.edu>
+
+ * gnus.texi (Optional Back End Functions):
+ nnchoke-request-update-info need not return the info object.
+
+2002-12-15 Jesper Harder <harder@ifa.au.dk>
+
+ * gnusref.tex: Additions.
+
+2002-12-14 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.texi (Mail): Explain nil value of gnus-uu-digest-headers.
+
+2002-12-10 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus.texi (Posting Styles): Clarify the `(header MATCH REGEXP)'
+ case.
+ (Back End Interface): Mention nnnotbackends. Suggested by Jan
+ Rychter.
+
+2002-11-29 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus.texi (MIME Commands): Document gnus-inhibit-mime-unbuttonizing.
+
+2002-11-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.texi (Expiring in IMAP): backend -> back end.
+ (Wide Characters): The default value of
+ gnus-use-correct-string-widths under Emacs is nil.
+ (Filtering Spam Using spam.el): backend -> back end.
+ (Extending spam.el): backend -> back end.
+ (Filtering Spam Using Statistics (spam-stat.el)): Fix typo.
+ (Creating a spam-stat dictionary): Fix typo.
+ (Creating a spam-stat dictionary): backend -> back end.
+
+2002-11-22 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus.texi (Extending spam.el): fixed typos and wrong @items
+
+2002-11-21 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus.texi:
+ added new keyboard commands
+
+ * gnus.texi: added extended section on spam
+
+2002-11-18 jas
+
+ * gnus.texi: Fix IMAP expiring typos.
+
+2002-11-18 kaig
+
+ * gnus.texi: *** empty log message ***
+
+2002-11-18 jas
+
+ * gnus.texi: More morse.
+
+ * gnus.texi (Article Washing): Add morse.
+
+2002-11-17 jas
+
+ * gnus.texi: Fix typo.
+
+ * gnus.texi (Expiring in IMAP): Add.
+ (Group Parameters): Add reference.
+
+2002-11-16 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus.texi (Expiring Mail): Give summary on difference between
+ auto-expire and total-expire and provide information for choosing
+ between them.
+
+2002-11-18 Simon Josefsson <jas@extundo.com>
+
+ * gnus.texi (Article Washing): Add morse.
+
+2002-11-17 Simon Josefsson <jas@extundo.com>
+
+ * gnus.texi (Expiring in IMAP): Add.
+ (Group Parameters): Add reference.
+
+2002-10-24 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.texi (RSS): Add gnus-summary-mark-as-read-forward into the
+ example code. From Christoph Conrad <christoph.conrad@gmx.de>.
+
+2002-10-17 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus.texi (Other Marks): Document gnus-downloadable-mark and
+ gnus-undownloaded-mark. Adapted idea from Sriram Karra
+ <karra@shakti.homelinux.net>.
+ (Formatting Fonts): Say that guillemets are wrong. (How to enter
+ guillemets in Texinfo files?)
+
+2002-10-12 Simon Josefsson <jas@extundo.com>
+
+ * message.texi (Movement): Add.
+
+2002-10-11 Jesper harder <harder@ifa.au.dk>
+
+ * gnus.texi (Formatting Fonts): Fix for balloon help in GNU Emacs.
+
+2002-10-11 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.texi (Delayed Articles): Fix gnus-delay-initialize.
+
+2002-10-10 Simon Josefsson <jas@extundo.com>
+
+ * message.texi (Security): Fix.
+
+2002-10-04 Simon Josefsson <jas@extundo.com>
+
+ * pgg.texi: Document sign parameter.
+
+ * gnus.texi: Add \gnuskey tex command.
+
+ * texi2latex.el (latexi-translate-file): Do PGG. (Poor) support
+ of @set, @deffn, @defvar, @defun, @key. Improve error.
+
+ * Makefile.in: Add PGG.
+
+ * pgg.texi: New file.
+
+2002-10-03 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus.texi (Group Information): Mention prefix argument for
+ gnus-group-fetch-charter and gnus-group-fetch-control.
+ From Jesper Harder.
+
+2002-09-26 Simon Josefsson <jas@extundo.com>
+
+ * gnus.texi (Agent Variables): Add.
+
+2002-09-25 Simon Josefsson <jas@extundo.com>
+
+ * gnus.texi (Troubleshooting): Add.
+
+2002-09-23 Jesper harder <harder@ifa.au.dk>
+
+ * gnus.texi (Summary Maneuvering): Fix gnus-auto-select-next.
+
+2002-09-19 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.texi (X-Face): Add GIF.
+
+2002-09-18 Simon Josefsson <jas@extundo.com>
+
+ * gnus.texi (A note on namespaces): New.
+
+2002-09-16 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus.texi (Splitting Mail): "By default, splitting is performed
+ on all incoming messages." This sentence had a "not" too many.
+ Explicitly say that `nnmail-resplit-incoming' has effect only for
+ `directory' mail-sources entries.
+
+2002-09-15 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus.texi (Mail Source Specifiers): Say "one-to-one
+ correspondence" in the description of `directory'.
+
+2002-09-11 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus.texi (Top, Summary Buffer): Add info to "Delayed Articles"
+ menu line.
+
+2002-09-11 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.texi (Article Hiding): Add a document for
+ gnus-article-address-banner-alist.
+
+2002-09-11 Simon Josefsson <jas@extundo.com>
+
+ * gnus.texi (Splitting in IMAP): Fix.
+
+2002-09-10 Simon Josefsson <jas@extundo.com>
+
+ * gnus.texi (Other Marks): Fix.
+
+2002-09-09 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus.texi (Splitting Mail): Typo.
+ (Comparing Mail Back Ends): Say "back end" instead of "backend".
+ (Terminology): Try to explain "back end" better.
+
+2002-09-09 Simon Josefsson <jas@extundo.com>
+
+ * gnus.texi (Article Buttons): Add.
+
+2002-09-09 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus.texi (Splitting Mail): Document nnmail-resplit-incoming,
+ xref to Mail Source Specifiers.
+ (Mail Source Specifiers): Add index entry for
+ nnmail-scan-directory-mail-source-once. Add index entry for
+ nnmail-resplit-incoming, with xref to Splitting Mail.
+
+2002-09-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Browse Foreign Server): Addition.
+ (Limiting): Addition.articles
+
+2002-09-04 Simon Josefsson <jas@extundo.com>
+
+ * gnus.texi (Mail Source Specifiers): Fix.
+
+2002-09-03 Simon Josefsson <jas@extundo.com>
+
+ * gnus.texi (Direct Functions, Common Variables): Named ports like
+ "snews" doesn't work with some external tools. Thanks to
+ "D. Watson" <djwatson@u.washington.edu> for noting this.
+
+2002-09-01 Simon Josefsson <jas@extundo.com>
+
+ * gnus.texi (Gnus Unplugged): Fix, agent is now enabled by default.
+ (Agent as Cache): New.
+
+2002-08-26 Jesper harder <harder@ifa.au.dk>
+
+ * gnus.texi (Group Information): Add gnus-group-fetch-charter and
+ gnus-group-fetch-control.
+
+2002-08-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.texi (Posting Server): Document message-smtpmail-send-it.
+
+ * message.texi (Mail Variables): Add message-smtpmail-send-it.
+
+2002-08-27 Simon Josefsson <jas@extundo.com>
+
+ * gnus.texi (Mail Source Specifiers): Fix :path default.
+
+2002-08-22 Jesper harder <harder@ifa.au.dk>
+
+ * gnus.texi (Summary Mail Commands): Add
+ gnus-summary-reply-broken-reply-to and
+ gnus-summary-reply-broken-reply-to-with-original.
+ (Setting Process Marks): Add gnus-uu-unmark-region
+ (Article Header): Fix typo.
+ (MIME Commands): Fix typo.
+ (MIME Commands): Index gnus-article-decode-mime-words,
+ gnus-article-decode-charset and gnus-mime-view-all-parts.
+
+2002-08-20 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus.texi (Mail Source Specifiers): Mention variable
+ nnmail-resplit-incoming under `directory' specifier.
+
+2002-08-18 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus.texi (Summary Buffer Lines): Document the %k specifier.
+
+2002-08-15 Jesper harder <harder@ifa.au.dk>
+
+ * gnus.texi (Group Line Specification): Add %C.
+ (Group Parameters): Comments can be displayed in the group line.
+
+2002-08-07 Jesper harder <harder@ifa.au.dk>
+
+ * emacs-mime.texi (Non-MIME): Add yenc.
+ (yenc): New node.
+
2002-08-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (Summary Sorting): Document randomization.
2002-05-01 Lars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
* message.texi (Message Headers): Remove colon from index
- entries.
+ entries.
2002-05-01 Simon Josefsson <jas@extundo.com>
INSTALL_DATA = @INSTALL_DATA@
SHELL = /bin/sh
PAPERTYPE=a4
-INFO_DEPS=gnus message emacs-mime sieve
+INFO_DEPS=gnus message emacs-mime sieve pgg
all: $(INFO_DEPS)
$(EMACSINFO) $<; \
fi
-dvi: gnus.dvi message.dvi refcard.dvi emacs-mime.dvi sieve.dvi
+dvi: gnus.dvi message.dvi refcard.dvi emacs-mime.dvi sieve.dvi pgg.dvi
-pdf: gnus.pdf message.pdf refcard.pdf emacs-mime.pdf sieve.pdf
+pdf: gnus.pdf message.pdf refcard.pdf emacs-mime.pdf sieve.pdf pgg.pdf
.texi.dvi :
sed -e '/@iflatex/,/@end iflatex/d' $< > gnustmp.texi
texi2latex.elc: texi2latex.el
srcdir=$(srcdir)/../lisp $(EMACSCOMP) -l $(srcdir)/../lisp/dgnushack.el --eval '(byte-compile-file "$(srcdir)/texi2latex.el")'
-latex: gnus.latexi gnus-faq.latexi message.latexi emacs-mime.latexi sieve.latexi
+latex: gnus.latexi gnus-faq.latexi message.latexi emacs-mime.latexi sieve.latexi pgg.latexi
-gnus.latexi gnus-faq.latexi message.latexi emacs-mime.latexi sieve.latexi: $(srcdir)/gnus.texi $(srcdir)/gnus-faq.texi $(srcdir)/message.texi $(srcdir)/emacs-mime.texi $(srcdir)/sieve.texi texi2latex.elc
+gnus.latexi gnus-faq.latexi message.latexi emacs-mime.latexi sieve.latexi pgg.latexi: $(srcdir)/gnus.texi $(srcdir)/gnus-faq.texi $(srcdir)/message.texi $(srcdir)/emacs-mime.texi $(srcdir)/sieve.texi $(srcdir)/pgg.texi texi2latex.elc
srcdir=$(srcdir) $(EMACSCOMP) -l ./texi2latex.elc -f latexi-translate
.latexi.dvi-x:
@sc{mime} messages.
This manual is directed at users who want to modify the behaviour of
-the MIME encoding/decoding process or want a more detailed picture of
-how the Emacs MIME library works, and people who want to write
-functions and commands that manipulate @sc{mime} elements.
+the @sc{mime} encoding/decoding process or want a more detailed
+picture of how the Emacs @sc{mime} library works, and people who want
+to write functions and commands that manipulate @sc{mime} elements.
@sc{mime} is short for @dfn{Multipurpose Internet Mail Extensions}.
This standard is documented in a number of RFCs; mainly RFC2045 (Format
@node Non-MIME
@section Non-MIME
+@vindex mm-uu-configure-list
Gnus also understands some non-@sc{mime} attachments, such as
-postscript, uuencode, binhex, shar, forward, gnatsweb, pgp. Each of
-these features can be disabled by add an item into
+postscript, uuencode, binhex, yenc, shar, forward, gnatsweb, pgp.
+Each of these features can be disabled by add an item into
@code{mm-uu-configure-list}. For example,
@lisp
@findex binhex
Binhex encoded file.
+@item yenc
+@findex yenc
+Yenc encoded file.
+
@item shar
@findex shar
Shar archive file.
@table @code
@item mm-inline-media-tests
+@vindex mm-inline-media-tests
This is an alist where the key is a @sc{mime} type, the second element
is a function to display the part @dfn{inline} (i.e., inside Emacs), and
the third element is a form to be @code{eval}ed to say whether the part
@emph{actually} displayed inline.
@item mm-inlined-types
+@vindex mm-inlined-types
This, on the other hand, says what types are to be displayed inline, if
they satisfy the conditions set by the variable above. It's a list of
@sc{mime} media types.
@item mm-automatic-display
+@vindex mm-automatic-display
This is a list of types that are to be displayed ``automatically'', but
only if the above variable allows it. That is, only inlinable parts can
be displayed automatically.
+@item mm-automatic-external-display
+@vindex mm-automatic-external-display
+This is a list of types that will be displayed automatically in an
+external viewer.
+
@item mm-attachment-override-types
+@vindex mm-attachment-override-types
Some @sc{mime} agents create parts that have a content-disposition of
@samp{attachment}. This variable allows overriding that disposition and
displaying the part inline. (Note that the disposition is only
overridden if we are able to, and want to, display the part inline.)
@item mm-discouraged-alternatives
+@vindex mm-discouraged-alternatives
List of @sc{mime} types that are discouraged when viewing
@samp{multipart/alternative}. Viewing agents are supposed to view the
last possible part of a message, as that is supposed to be the richest.
However, users may prefer other types instead, and this list says what
types are most unwanted. If, for instance, @samp{text/html} parts are
-very unwanted, and @samp{text/richtech} parts are somewhat unwanted,
+very unwanted, and @samp{text/richtext} parts are somewhat unwanted,
you could say something like:
@lisp
(remove "text/html" mm-automatic-display))
@end lisp
-@item mm-inline-large-images-p
+@item mm-inline-large-images
+@vindex mm-inline-large-images
When displaying inline images that are larger than the window, XEmacs
does not enable scrolling, which means that you cannot see the whole
image. To prevent this, the library tries to determine the image size
makes the library display all inline images as inline, regardless of
their size.
-@item mm-inline-override-type
+@item mm-inline-override-types
+@vindex mm-inline-override-types
@code{mm-inlined-types} may include regular expressions, for example to
specify that all @samp{text/.*} parts be displayed inline. If a user
prefers to have a type that matches such a regular expression be treated
includes @samp{text/.*}, then including @samp{text/html} in this
variable will cause @samp{text/html} parts to be treated as attachments.
-@item mm-inline-text-html-renderer
+@item mm-text-html-renderer
+@vindex mm-text-html-renderer
This selects the function used to render @sc{html}. The predefined
renderers are selected by the symbols @code{w3},
@code{w3m}@footnote{See @uref{http://emacs-w3m.namazu.org/} for more
-information about emacs-w3m}, @code{links}, @code{lynx} or
-@code{html2text}. You can also specify a function, which will be
+information about emacs-w3m}, @code{links}, @code{lynx},
+@code{w3m-standalone} or @code{html2text}. If @code{nil} use an
+external viewer. You can also specify a function, which will be
called with a @sc{mime} handle as the argument.
@item mm-inline-text-html-with-images
+@vindex mm-inline-text-html-with-images
Some @sc{html} mails might have the trick of spammers using
@samp{<img>} tags. It is likely to be intended to verify whether you
have read the mail. You can prevent your personal informations from
have set the option @code{w3m-key-binding} to @code{info}, use @kbd{i}
or @kbd{I} instead.}
+@item mm-w3m-safe-url-regexp
+@vindex mm-w3m-safe-url-regexp
+A regular expression that matches safe URL names, i.e. URLs that are
+unlikely to leak personal information when rendering @sc{html} email
+(the default value is @samp{\\`cid:}). If @code{nil} consider all
+URLs safe.
+
@item mm-inline-text-html-with-w3m-keymap
+@vindex mm-inline-text-html-with-w3m-keymap
You can use emacs-w3m command keys in the inlined text/html part by
setting this option to non-@code{nil}. The default value is @code{t}.
+@item mm-external-terminal-program
+@vindex mm-external-terminal-program
+The program used to start an external terminal.
+
@end table
@item mm-body-charset-encoding-alist
@vindex mm-body-charset-encoding-alist
-Mapping from MIME charset to encoding to use. This variable is
+Mapping from @sc{mime} charset to encoding to use. This variable is
usually used except, e.g., when other requirements force a specific
encoding (digitally signed messages require 7bit encodings). The
default is @code{((iso-2022-jp . 7bit) (iso-2022-jp-2 . 7bit))}. As
@item mm-content-transfer-encoding-defaults
@vindex mm-content-transfer-encoding-defaults
-Mapping from MIME types to encoding to use. This variable is usually
+Mapping from @sc{mime} types to encoding to use. This variable is usually
used except, e.g., when other requirements force a safer encoding
(digitally signed messages require 7bit encoding). Besides the normal
-MIME encodings, @code{qp-or-base64} may be used to indicate that for
+@sc{mime} encodings, @code{qp-or-base64} may be used to indicate that for
each case the most efficient of quoted-printable and base64 should be
used. You can override this setting on a per-message basis by using
the @code{encoding} MML tag (@pxref{MML Definition}).
* base64:: Base64 en/decoding.
* binhex:: Binhex decoding.
* uudecode:: Uuencode decoding.
+* yenc:: Yenc decoding.
* rfc1843:: Decoding HZ-encoded text.
* mailcap:: How parts are displayed is specified by the @file{.mailcap} file
@end menu
Characters in this charset should not be decoded by this library.
This defaults to @code{iso-8859-1}.
-@item rfc2047-header-encoding-list
-@vindex rfc2047-header-encoding-list
+@item rfc2047-header-encoding-alist
+@vindex rfc2047-header-encoding-alist
This is an alist of header / encoding-type pairs. Its main purpose is
to prevent encoding of certain headers.
@end table
-
@node uudecode
@section uudecode
@cindex uuencode
@end table
+@node yenc
+@section yenc
+@cindex yenc
+
+@code{yenc} is used for encoding binaries on Usenet. The following
+function is supplied by this package:
+
+@table @code
+@item yenc-decode-region
+@findex yenc-decode-region
+Decode the encoded text in the region.
+
+@end table
+
+
@node rfc1843
@section rfc1843
@cindex rfc1843
\makeindex
\begin{document}
-\newcommand{\gnusversionname}{Oort Gnus v0.07}
+\newcommand{\gnusversionname}{Oort Gnus v0.09}
\newcommand{\gnuschaptername}{}
\newcommand{\gnussectionname}{}
\newcommand{\gnussamp}[1]{``{\fontencoding{OT1}\gnusselectttfont{}#1}''}
\newcommand{\gnuslisp}[1]{\gnustt{#1}}
\newcommand{\gnuskbd}[1]{`\gnustt{#1}'}
+\newcommand{\gnuskey}[1]{`\gnustt{#1}'}
\newcommand{\gnusfile}[1]{`\gnustt{#1}'}
\newcommand{\gnusdfn}[1]{\textit{#1}}
\newcommand{\gnusi}[1]{\textit{#1}}
spool or your mbox file. All at the same time, if you want to push your
luck.
-This manual corresponds to Oort Gnus v0.07.
+This manual corresponds to Oort Gnus v0.09.
@end ifinfo
* Index:: Variable, function and concept index.
* Key Index:: Key Index.
+Other related manuals
+
+* Message:(message). Composing messages.
+* Emacs-MIME:(emacs-mime). Composing messages; MIME-specific parts.
+* Sieve:(sieve). Managing Sieve scripts in Emacs.
+* PGG:(pgg). PGP/MIME with Gnus.
+
@detailmenu
--- The Detailed Node Listing ---
* Choosing Articles:: Reading articles.
* Paging the Article:: Scrolling the current article.
* Reply Followup and Post:: Posting articles.
-* Delayed Articles::
+* Delayed Articles:: Send articles at a later time.
* Marking Articles:: Marking articles as read, expirable, etc.
* Limiting:: You can limit the summary buffer.
* Threading:: How threads are made.
@sc{imap}
* Splitting in IMAP:: Splitting mail with nnimap.
+* Expiring in IMAP:: Expiring mail with nnimap.
* Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox.
* Expunging mailboxes:: Equivalent of a "compress mailbox" button.
+* A note on namespaces:: How to (not) use IMAP namespace in Gnus.
Other Sources
* 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.
+* Agent as Cache:: The Agent is a big cache too.
* Agent Expiry:: How to make old articles go away.
* Agent and IMAP:: How to use the Agent with IMAP.
* Outgoing Messages:: What happens when you post/mail something?
Thwarting Email Spam
+* The problem of spam:: Some background, and some solutions
* Anti-Spam Basics:: Simple steps to reduce the amount of spam.
* SpamAssassin:: How to use external anti-spam tools.
* Hashcash:: Reduce spam by burning CPU time.
+* Filtering Spam Using spam.el::
+* Filtering Spam Using Statistics (spam-stat.el)::
Appendices
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.
+@samp{%M%S%5y:%B%(%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. @xref{Positioning
@item G
Group name.
+@item C
+Group comment (@pxref{Group Parameters}) or group name if there is no
+comment element in the group parameters.
+
@item D
Newsgroup description.
@item s
Select method.
+@item B
+If the summary buffer for the group is open or not.
+
@item n
Select from where.
@end table
This variable can also be a function. In that case, that function
-will be called to place point on a subject line.
+will be called to place point on a subject line.
If you want to prevent automatic selection in some group (say, in a
binary group with Huge articles) you can set the
precedence over any default @code{Gcc} rules as described later
(@pxref{Archived Messages}). CAVEAT:: It yields an error putting
@code{(gcc-self . t)} in groups of a @code{nntp} server or so, because
-a @code{nntp} server doesn't accept artciles.
+a @code{nntp} server doesn't accept articles.
@item auto-expire
@cindex auto-expire
@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}.
+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}
+(@pxref{Expiring Mail}) 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
@item comment
@cindex 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.
+Elements that look like @code{(comment . "This is a comment")} are
+arbitrary comments on the group. You can display comments in the
+group line (@pxref{Group Line Specification}).
@item charset
@cindex charset
Sort the group buffer alphabetically by back end name
(@code{gnus-group-sort-groups-by-method}).
+@item G S n
+@kindex G S n (Group)
+@findex gnus-group-sort-groups-by-real-name
+Sort the group buffer alphabetically by real (unprefixed) group name
+(@code{gnus-group-sort-groups-by-real-name}).
+
@end table
All the commands below obey the process/prefix convention
Sort the groups alphabetically by back end name
(@code{gnus-group-sort-selected-groups-by-method}).
+@item G P n
+@kindex G P n (Group)
+@findex gnus-group-sort-selected-groups-by-real-name
+Sort the groups alphabetically by real (unprefixed) group name
+(@code{gnus-group-sort-selected-groups-by-real-name}).
+
@item G P s
@kindex G P s (Group)
@findex gnus-group-sort-selected-groups
@findex gnus-browse-exit
Exit browse mode (@code{gnus-browse-exit}).
+@item d
+@kindex d (Browse)
+@findex gnus-browse-describe-group
+Describe the current group (@code{gnus-browse-describe-group}).
+
@item ?
@kindex ? (Browse)
@findex gnus-browse-describe-briefly
@item subscribe-level
When subscribing new groups by topic (see the @code{subscribe} parameter),
-the group will be subscribed with the level specified in the
+the group will be subscribed with the level specified in the
@code{subscribe-level} instead of @code{gnus-level-default-subscribed}.
@end table
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 c
+@kindex H c (Group)
+@findex gnus-group-fetch-charter
+@vindex gnus-group-charter-alist
+@cindex charter
+Try to open the charter for the current group in a web browser
+(@code{gnus-group-fetch-charter}). Query for a group if given a
+prefix argument.
+
+Gnus will use @code{gnus-group-charter-alist} to find the location of
+the charter. If no location is known, Gnus will fetch the control
+messages for the group, which in some cases includes the charter.
+
+@item H C
+@kindex H C (Group)
+@findex gnus-group-fetch-control
+@vindex gnus-group-fetch-control-use-browse-url
+@cindex control message
+Fetch the control messages for the group from the archive at
+@code{ftp.isc.org} (@code{gnus-group-fetch-control}). Query for a
+group if given a prefix argument.
+
+If @code{gnus-group-fetch-control-use-browse-url} is non-nil, Gnus
+will open the control messages in a browser using @code{browse-url}.
+Otherwise they are fetched using @code{ange-ftp} and displayed in an
+ephemeral group.
+
+Note that the control messages are compressed. To use this command
+you need to turn on @code{auto-compression-mode}
+(@pxref{(emacs)Compressed Files}).
+
@item H d
@itemx C-c C-d
@c @icon{gnus-group-describe-group}
If you would like greater control of the time format, you can use a
user-defined format spec. Something like the following should do the
-trick:
+trick:
@lisp
(setq gnus-group-line-format
(format-time-string "%b %d %H:%M" time)
"")))
@end lisp
-
+
@node File Commands
@subsection File Commands
* Choosing Articles:: Reading articles.
* Paging the Article:: Scrolling the current article.
* Reply Followup and Post:: Posting articles.
-* Delayed Articles::
+* Delayed Articles:: Send articles at a later time.
* Marking Articles:: Marking articles as read, expirable, etc.
* Limiting:: You can limit the summary buffer.
* Threading:: How threads are made.
@item c
Number of characters in the article. This specifier is not supported
in some methods (like nnfolder).
+@item k
+Pretty-printed version of the number of characters in the article;
+for example, @samp{1.2k} or @samp{0.4M}.
@item I
Indentation based on thread level (@pxref{Customizing Threading}).
@item B
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}.
+next group with unread articles. 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
original message (@code{gnus-summary-very-wide-reply-with-original}). This
command uses the process/prefix convention.
+@item S B r
+@kindex S B r (Summary)
+@findex gnus-summary-reply-broken-reply-to
+Mail a reply to the author of the current article but ignore the
+@code{Reply-To} field (@code{gnus-summary-reply-broken-reply-to}).
+
+@item S B R
+@kindex S B R (Summary)
+@findex gnus-summary-reply-broken-reply-to-with-original
+Mail a reply to the author of the current article and include the
+original message but ignore the @code{Reply-To} field
+(@code{gnus-summary-reply-broken-reply-to-with-original}).
+
@item S o m
@itemx C-c C-f
@kindex S o m (Summary)
forward as an rfc822 @sc{mime} section; if the prefix is 4, forward message
directly inline; otherwise, the message is forwarded as no prefix given
but use the flipped value of (@code{message-forward-as-mime}). By
-default, the message is decoded and forwarded as an rfc822 @sc{mime}
+default, the message is decoded and forwarded as an rfc822 @sc{mime}
section.
@item S m
@table @code
@item gnus-delay-initialize
@findex gnus-delay-initialize
-By default, this function installs the @kbd{C-c C-j} key binding in
-Message mode and @code{gnus-delay-send-queue} in
-@code{gnus-get-new-news-hook}. But it accepts two optional arguments,
-@code{no-keymap} and @code{no-check}. If @code{no-keymap} is non-nil,
-the @kbd{C-c C-j} binding is not intalled. If @code{no-check} is
-non-nil, @code{gnus-get-new-news-hook} is not changed.
-
-For example, @code{(gnus-delay-initialize nil t)} means to change the
-keymap but not to change @code{gnus-get-new-news-hook}. Presumably, you
-want to use the demon for sending due delayed articles. Just don't
-forget to set that up :-)
+By default, this function installs @code{gnus-delay-send-queue} in
+@code{gnus-get-new-news-hook}. But it accepts the optional second
+argument @code{no-check}. If it is non-nil,
+@code{gnus-get-new-news-hook} is not changed. The optional first
+argument is ignored.
+
+For example, @code{(gnus-delay-initialize nil t)} means to do nothing.
+Presumably, you want to use the demon for sending due delayed articles.
+Just don't forget to set that up :-)
@end table
@item
@vindex gnus-recent-mark
-Articles that according to the back end haven't been seen by the user
+Articles that according to the server haven't been shown to the user
before are marked with a @samp{N} in the second column
-(@code{gnus-recent-mark}). Note that not all back ends support this
-mark, in which case it simply never appears.
+(@code{gnus-recent-mark}). Note that not all servers support this
+mark, in which case it simply never appears. Compare with
+@code{gnus-unseen-mark}.
@item
@vindex gnus-unseen-mark
-Articles that haven't been seen by the user before are marked with a
-@samp{.} in the second column (@code{gnus-unseen-mark}).
+Articles that haven't been seen before in Gnus by the user are marked
+with a @samp{.} in the second column (@code{gnus-unseen-mark}).
+Compare with @code{gnus-recent-mark}.
+
+@item
+@vindex gnus-undownloaded-mark
+When using the Gnus agent @pxref{Agent Basics}, some articles might not
+have been downloaded. Such articles cannot be viewed while you are
+offline (unplugged). These articles get the @samp{@@} mark in the
+first column. (The variable @code{gnus-undownloaded-mark} controls
+which character to use.)
+
+@item
+@vindex gnus-downloadable-mark
+The Gnus agent @pxref{Agent Basics} downloads some articles
+automatically, but it is also possible to explicitly mark articles for
+download, even if they would not be downloaded automatically. Such
+explicitly-marked articles get the @samp{%} mark in the first column.
+(The variable @code{gnus-downloadable-mark} controls which character to
+use.)
@item
@vindex gnus-not-empty-thread-mark
@findex gnus-uu-mark-region
Mark articles in region (@code{gnus-uu-mark-region}).
+@item M P g
+@kindex M P g
+@findex gnus-uu-unmark-region
+Unmark articles in region (@code{gnus-uu-unmark-region}).
+
@item M P t
@kindex M P t (Summary)
@findex gnus-uu-mark-thread
(@code{gnus-summary-pop-limit}). If given a prefix, pop all limits off
the stack.
+@item / .
+@kindex / . (Summary)
+@findex gnus-summary-limit-to-unseen
+Limit the summary buffer to the unseen articles
+(@code{gnus-summary-limit-to-unseen}).
+
@item / v
@kindex / v (Summary)
@findex gnus-summary-limit-to-score
@item dummy
@vindex gnus-summary-dummy-line-format
+@vindex gnus-summary-make-false-root-always
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}.
+If you want all threads to have a dummy root, even the non-gathered
+ones, set @code{gnus-summary-make-false-root-always} to t.
@item empty
Gnus won't actually make any article the parent, but simply leave the
generated.
This can also be a predicate specifier (@pxref{Predicate Specifiers}).
-Avaliable predicates are @code{gnus-article-unread-p} and
+Available predicates are @code{gnus-article-unread-p} and
@code{gnus-article-unseen-p}).
Here's an example:
@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}).
+If given a symbolic prefix (@pxref{Symbolic Prefixes}), include the
+complete headers in the piped output.
@item O P
@kindex O P (Summary)
@item W W B
@kindex W W B (Summary)
@findex gnus-article-strip-banner
+@vindex gnus-article-banner-alist
+@vindex gnus-article-address-banner-alist
@cindex banner
@cindex OneList
@cindex stripping advertisements
corresponding regular expression in @code{gnus-article-banner-alist} is
used.
+Regardless of a group, you can hide things like advertisements only when
+the sender of an article has a certain mail address specified in
+@code{gnus-article-address-banner-alist}.
+
+@table @code
+
+@item gnus-article-address-banner-alist
+@vindex gnus-article-address-banner-alist
+Alist of mail addresses and banners. Each element has the form
+@code{(ADDRESS . BANNER)}, where ADDRESS is a regexp matching a mail
+address in the From header, BANNER is one of a symbol @code{signature},
+an item in @code{gnus-article-banner-alist}, a regexp and @code{nil}.
+If ADDRESS matches author's mail address, it will remove things like
+advertisements. For example, if a sender has the mail address
+@samp{hail@@yoo-hoo.co.jp} and there is a banner something like
+@samp{Do You Yoo-hoo!?} in all articles he sends, you can use the
+following element to remove them:
+
+@lisp
+("@@yoo-hoo\\.co\\.jp\\'" . "\n_+\nDo You Yoo-hoo!\\?\n.*\n.*\n")
+@end lisp
+
+@end table
+
@item W W c
@kindex W W c (Summary)
@findex gnus-article-hide-citation
#15). It is sometimes referred to as ``Caesar rotate'' because Caesar
is rumored to have employed this form of, uh, somewhat weak encryption.
+@item W m
+@kindex W m (Summary)
+@findex gnus-summary-morse-message
+@c @icon{gnus-summary-morse-message}
+Morse decode the article buffer (@code{gnus-summary-morse-message}).
+
@item W t
@item t
@kindex W t (Summary)
@vindex gnus-article-wash-function
The default is to use the function specified by
-@code{mm-inline-text-html-renderer} (@pxref{Customization, , , emacs-mime})
+@code{mm-inline-text-html-renderer} (@pxref{Customization, , , emacs-mime})
to convert the @sc{html}, but this is controlled by the
@code{gnus-article-wash-function} variable. Pre-defined functions you
can use include:
@item W G f
@kindex W G f (Summary)
-@findex gnus-article-treat-fold-header
+@findex gnus-article-treat-fold-headers
Fold all the message headers
(@code{gnus-article-treat-fold-headers}).
with the minimum of fuzz when you hit @kbd{RET} or use the middle mouse
button on these references.
+@vindex gnus-button-man-handler
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:
+Well-formed URLs, mail addresses, Message-IDs, Info links and man pages.
+This is controlled by two variables, one that handles article bodies and
+one that handles article heads:
@table @code
@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{<URL:\\([^\n\r>]*\\)>}. This can also be a variable containing a
-regexp, useful variables to use include @code{gnus-button-url-regexp}.
+All text that match this regular expression (case insensitive) will be
+considered an external reference. Here's a typical regexp that matches
+embedded URLs: @samp{<URL:\\([^\n\r>]*\\)>}. This can also be a
+variable containing a regexp, useful variables to use include
+@code{gnus-button-url-regexp}.
@item button-par
Gnus has to know which parts of the matches is to be highlighted. This
@cindex x-face
@cindex smileys
-These commands add various frivolous display gimmics to the article
+These commands add various frivolous display gimmicks to the article
buffer in Emacs versions that support them.
@code{X-Face} headers are small black-and-white images supplied by the
@item M-t
@kindex M-t (Summary)
-@findex gnus-summary-display-buttonized
+@findex gnus-summary-toggle-display-buttonized
Toggle the buttonized display of the article buffer
(@code{gnus-summary-toggle-display-buttonized}).
@item W M w
@kindex W M w (Summary)
+@findex gnus-article-decode-mime-words
Decode RFC 2047-encoded words in the article headers
(@code{gnus-article-decode-mime-words}).
@item W M c
@kindex W M c (Summary)
+@findex gnus-article-decode-charset
Decode encoded article bodies as well as charsets
(@code{gnus-article-decode-charset}).
@item W M v
@kindex W M v (Summary)
+@findex gnus-mime-view-all-parts
View all the @sc{mime} parts in the current article
(@code{gnus-mime-view-all-parts}).
@vindex gnus-unbuttonized-mime-types
This is a list of regexps. @sc{mime} types that match a regexp from
this list won't have @sc{mime} buttons inserted unless they aren't
-displayed or this variable is overriden by
+displayed or this variable is overridden by
@code{gnus-buttonized-mime-types}. The default value is
@code{(".*/.*")}.
To see e.g. security buttons but no other buttons, you could set this
variable to @code{("multipart/signed")} and leave
-@code{gnus-unbuttonized-mime-types} to the default value.
+@code{gnus-unbuttonized-mime-types} at the default value.
+
+@item gnus-inhibit-mime-unbuttonizing
+@vindex gnus-inhibit-mime-unbuttonizing
+If this is non-nil, then all @sc{mime} parts get buttons. The default
+value is @code{nil}.
@item gnus-article-mime-part-function
@vindex gnus-article-mime-part-function
@lisp
(setq gnus-refer-article-method
'(current
- (nnweb "refer" (nnweb-type google))))
+ (nnweb "google" (nnweb-type google))))
@end lisp
Most of the mail back ends support fetching by @code{Message-ID}, but
Pull all cached articles (for the current group) into the summary buffer
(@code{gnus-summary-insert-cached-articles}).
+@item Y d
+@kindex Y d (Summary)
+@findex gnus-summary-insert-dormant-articles
+Pull all dormant articles (for the current group) into the summary buffer
+(@code{gnus-summary-insert-dormant-articles}).
+
@end table
@item gnus-treat-strip-pgp (t, last, integer)
@item gnus-treat-strip-trailing-blank-lines (t, last, integer)
@item gnus-treat-unsplit-urls (t, integer)
+@item gnus-treat-wash-html (t, integer)
@xref{Article Washing}.
@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.
+headers will be included in the sequence they are matched. If
+@code{nil} include all headers.
@item gnus-add-to-list
@vindex gnus-add-to-list
Thank you for asking. I hate you.
-It can be quite complicated.
+It can be quite complicated.
@vindex gnus-post-method
When posting news, Message usually invokes @code{message-send-news}
smtpmail-default-smtp-server "YOUR SMTP HOST")
@end lisp
-Other possible choises for @code{message-send-mail-function} includes
+To the thing similar to this, there is @code{message-smtpmail-send-it}.
+It is useful if your ISP requires the POP-before-SMTP authentication.
+See the documentation for the function @code{mail-source-touch-pop}.
+
+Other possible choices for @code{message-send-mail-function} includes
@code{message-send-mail-with-mh}, @code{message-send-mail-with-qmail},
and @code{feedmail-send-it}.
string, then Gnus will try to regexp match it against the group name.
If it is the form @code{(header MATCH REGEXP)}, then Gnus will look in
the original article for a header whose name is MATCH and compare that
-REGEXP. MATCH and REGEXP are strings. If it's a function symbol, that
-function will be called with no arguments. If it's a variable symbol,
-then the variable will be referenced. If it's a list, then that list
-will be @code{eval}ed. In any case, if this returns a non-@code{nil}
-value, then the style is said to @dfn{match}.
+REGEXP. MATCH and REGEXP are strings. (There original article is the
+one you are replying or following up to. If you are not composing a
+reply or a followup, then there is nothing to match against.) If the
+@code{match} is a function symbol, that function will be called with no
+arguments. If it's a variable symbol, then the variable will be
+referenced. If it's a list, then that list will be @code{eval}ed. In
+any case, if this returns a non-@code{nil} value, then the style is said
+to @dfn{match}.
Each style may contain an arbitrary amount of @dfn{attributes}. Each
attribute consists of a @code{(@var{name} @var{value})} pair. The
;; Type `C-c C-c' after you've finished editing.
;;
;; "snews" is port 563 and is predefined in our /etc/services
+;; however, openssl s_client -port doesn't like named ports
;;
(nntp "snews.bar.com"
(nntp-open-connection-function nntp-open-ssl-stream)
- (nntp-port-number "snews")
+ (nntp-port-number 563)
(nntp-address "snews.bar.com"))
@end lisp
@item nntp-port-number
@vindex nntp-port-number
Port number to connect to the @sc{nntp} server. The default is @samp{nntp}.
+If you use @sc{nntp} over @sc{ssl}, you may want to use integer ports rather
+than named ports (i.e, use @samp{563} instead of @samp{snews}), because
+external SSL tools may not work with named ports.
@item nntp-end-of-line
@vindex nntp-end-of-line
@code{nnmail-mail-splitting-decodes} to nil, which is useful if you
want to match articles based on the raw header data.
+@vindex nnmail-resplit-incoming
+By default, splitting is performed on all incoming messages. If
+you specify a @code{directory} entry for the variable
+@code{mail-sources} @pxref{Mail Source Specifiers}, however, then
+splitting does @emph{not} happen by default. You can set the variable
+@code{nnmail-resplit-incoming} to a non-nil value to make splitting
+happen even in this case. (This variable has no effect on other kinds
+of entries.)
+
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
@table @code
@item :path
The path of the file. Defaults to the value of the @code{MAIL}
-environment variable or @file{/usr/mail/spool/user-name}.
+environment variable or the value of @code{rmail-spool-directory}
+(usually something like @file{/usr/mail/spool/user-name}).
@end table
An example file mail source:
@item directory
-Get mail from several files in a directory. This is typically used
-when you have procmail split the incoming mail into several files.
-That is, mail from the file @file{foo.bar.spool} will be put in the
-group @code{foo.bar}. (You can change the suffix to be used instead
+@vindex nnmail-scan-directory-mail-source-once
+Get mail from several files in a directory. This is typically used when
+you have procmail split the incoming mail into several files. That is,
+there is a one-to-one correspondence between files in that directory and
+groups, so that mail from the file @file{foo.bar.spool} will be put in
+the group @code{foo.bar}. (You can change the suffix to be used instead
of @code{.spool}.) Setting
-@code{nnmail-scan-directory-mail-source-once} to non-nil forces Gnus
-to scan the mail source only once. This is particularly useful if you
-want to scan mail groups at a specified level.
+@code{nnmail-scan-directory-mail-source-once} to non-nil forces Gnus to
+scan the mail source only once. This is particularly useful if you want
+to scan mail groups at a specified level.
+
+@vindex nnmail-resplit-incoming
+There is also the variable @code{nnmail-resplit-incoming}, if you set
+that to a non-nil value, then the normal splitting process is applied
+to all the files from the directory, @ref{Splitting Mail}.
Keywords:
The predicate used to find articles to fetch. The default, @samp{UNSEEN
UNDELETED}, is probably the best choice for most people, but if you
sometimes peek in your mailbox with a @sc{imap} client and mark some
-articles as read (or; SEEN) you might want to set this to @samp{nil}.
+articles as read (or; SEEN) you might want to set this to @samp{1:*}.
Then all articles in the mailbox is fetched, no matter what. For a
complete list of predicates, see RFC 2060 section 6.4.4.
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
+articles as @dfn{expirable}. (With the default keybindings, this means
+that you have to type @kbd{E}.) 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.
+You do not have to mark articles as expirable by hand. Gnus provides
+two features, called `auto-expire' and `total-expire', that can help you
+with this. In a nutshell, `auto-expire' means that Gnus hits @kbd{E}
+for you when you select an article. And `total-expire' means that Gnus
+considers all articles as expirable that are read. So, in addition to
+the articles marked @samp{E}, also the articles marked @samp{r},
+@samp{R}, @samp{O}, @samp{K}, @samp{Y} and so on are considered
+expirable.
+
+When should either auto-expire or total-expire be used? Most people
+who are subscribed to mailing lists split each list into its own group
+and then turn on auto-expire or total-expire for those groups.
+(@xref{Splitting Mail}, for more information on splitting each list
+into its own group.)
+
+Which one is better, auto-expire or total-expire? It's not easy to
+answer. Generally speaking, auto-expire is probably faster. Another
+advantage of auto-expire is that you get more marks to work with: for
+the articles that are supposed to stick around, you can still choose
+between tick and dormant and read marks. But with total-expire, you
+only have dormant and ticked to choose from. The advantage of
+total-expire is that it works well with adaptive scoring @pxref{Adaptive
+Scoring}. Auto-expire works with normal scoring but not with adaptive
+scoring.
+
@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.
+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
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
+storing the mail to disk. For that purpose, we have three hooks and
various functions that can be put in these hooks.
@table @code
course, and is still maintained by Stallman.
Both of the above forms leave your mail in a single file on your
-filesystem, and they must parse that entire file each time you take a
+file system, and they must parse that entire file each time you take a
look at your mail.
@item nnml
provided by the active file and overviews.
@code{nnml} costs @dfn{inodes} in a big way; that is, it soaks up the
-resource which defines available places in the filesystem to put new
+resource which defines available places in the file system to put new
files. Sysadmins take a dim view of heavy inode occupation within
-tight, shared filesystems. But if you live on a personal machine where
-the filesystem is your own and space is not at a premium, @code{nnml}
+tight, shared file systems. But if you live on a personal machine where
+the file system is your own and space is not at a premium, @code{nnml}
wins big.
It is also problematic using this back end if you are living in a
@code{df -i} to see how plentiful your inode supply is.) If this slows
you down or takes up very much space, consider switching to ReiserFS
(@uref{http://www.namesys.com/}) or another non-block-structured
-filesystem.
+file system.
Since maildirs don't require locking for delivery, the maildirs you use
as groups can also be the maildirs your mail is directly delivered to.
@code{nnmaildir}.
For configuring expiry and other things, @code{nnmaildir} uses group
-parameters slightly different from those of other mail backends.
+parameters slightly different from those of other mail back ends.
@code{nnmaildir} uses a significant amount of memory to speed things up.
(It keeps in memory some of the things that @code{nnml} stores in files
and that @code{nnmh} repeatedly parses out of message files.) If this
is a problem for you, you can set the @code{nov-cache-size} group
-parameter to somthing small (0 would probably not work, but 1 probably
+parameter to something small (0 would probably not work, but 1 probably
would) to make it use less memory.
Startup and shutdown are likely to be slower with @code{nnmaildir} than
-with other backends. Everything in between is likely to be faster,
-depending in part on your filesystem.
+with other back ends. Everything in between is likely to be faster,
+depending in part on your file system.
@code{nnmaildir} does not use @code{nnoo}, so you cannot use @code{nnoo}
-to write an @code{nnmaildir}-derived backend.
+to write an @code{nnmaildir}-derived back end.
@end table
similar. You restore the data by restoring the directory tree, and
adding a server definition pointing to that directory in Gnus. The
@ref{Article Backlog}, @ref{Asynchronous Fetching} and other things
-might interfer with overwriting data, so you may want to shut down Gnus
+might interfere with overwriting data, so you may want to shut down Gnus
before you restore the data.
It is also possible to archive individual @code{nnml},
has to retrieve absolutely all comments in a group upon entry. If a
threaded display is not required, @code{nnslashdot} will only retrieve
the comments that are actually wanted by the user. Threading is nicer,
-but much, much slower than untreaded.
+but much, much slower than unthreaded.
@item nnslashdot-login-name
@vindex nnslashdot-login-name
(assq (gnus-summary-article-number)
gnus-newsgroup-data))))))
(if url
- (browse-url (cdr url))
+ (progn
+ (browse-url (cdr url))
+ (gnus-summary-mark-as-read-forward 1))
(gnus-summary-scroll-up arg))))
(eval-after-load "gnus"
@vindex imap-ssl-program
For SSL connections, the OpenSSL program is available from
@uref{http://www.openssl.org/}. OpenSSL was formerly known as SSLeay,
-and nnimap support it too - altough the most recent versions of
+and nnimap support it too - although the most recent versions of
SSLeay, 0.9.x, are known to have serious bugs making it
useless. Earlier versions, especially 0.8.x, of SSLeay are known to
work. The variable @code{imap-ssl-program} contain parameters to pass
@item
@dfn{login:} Plain-text username/password via LOGIN.
@item
-@dfn{anonymous:} Login as `anonymous', supplying your emailadress as password.
+@dfn{anonymous:} Login as `anonymous', supplying your email address as password.
@end itemize
@item nnimap-expunge-on-close
@menu
* Splitting in IMAP:: Splitting mail with nnimap.
+* Expiring in IMAP:: Expiring mail with nnimap.
* Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox.
* Expunging mailboxes:: Equivalent of a "compress mailbox" button.
+* A note on namespaces:: How to (not) use IMAP namespace in Gnus.
@end menu
("INBOX.lists.\\1" "^Sender: owner-\\([a-z-]+\\)@@")
@end lisp
+The first element can also be the symbol @code{junk} to indicate that
+matching messages should simply be deleted. Use with care.
+
The second element can also be a function. In that case, it will be
called with the first element of the rule as the argument, in a buffer
containing the headers of the article. It should return a non-nil value
@end table
+@node Expiring in IMAP
+@subsection Expiring in IMAP
+@cindex expiring imap mail
+
+Even though @sc{nnimap} is not a proper @sc{nnmail} derived back end,
+it supports most features in regular expiring (@pxref{Expiring Mail}).
+Unlike splitting in IMAP (@pxref{Splitting in IMAP}) it do not clone
+the @sc{nnmail} variables (i.e., creating @var{nnimap-expiry-wait})
+but reuse the @sc{nnmail} variables. What follows below are the
+variables used by the @sc{nnimap} expiry process.
+
+A note on how the expire mark is stored on the @sc{imap} server is
+appropriate here as well. The expire mark is translated into a
+@sc{imap} client specific mark, @code{gnus-expire}, and stored on the
+message. This means that likely only Gnus will understand and treat
+the @code{gnus-expire} mark properly, although other clients may allow
+you to view client specific flags on the message. It also means that
+your server must support permanent storage of client specific flags on
+messages. Most do, fortunately.
+
+@table @code
+
+@item nnmail-expiry-wait
+@item nnmail-expiry-wait-function
+
+These variables are fully supported. The expire value can be a
+number, the symbol @var{immediate} or @var{never}.
+
+@item nnmail-expiry-target
+
+This variable is supported, and internally implemented by calling the
+@sc{nnmail} functions that handle this. It contains an optimization
+that if the destination is a IMAP group on the same server, the
+article is copied instead of appended (that is, uploaded again).
+
+@end table
+
@node Editing IMAP ACLs
@subsection Editing IMAP ACLs
@cindex editing imap acls
Currently there is no way of showing deleted articles, you can just
delete them.
+@node A note on namespaces
+@subsection A note on namespaces
+@cindex IMAP namespace
+@cindex namespaces
+
+The IMAP protocol has a concept called namespaces, described by the
+following text in the RFC:
+
+@example
+5.1.2. Mailbox Namespace Naming Convention
+
+ By convention, the first hierarchical element of any mailbox name
+ which begins with "#" identifies the "namespace" of the remainder of
+ the name. This makes it possible to disambiguate between different
+ types of mailbox stores, each of which have their own namespaces.
+
+ For example, implementations which offer access to USENET
+ newsgroups MAY use the "#news" namespace to partition the USENET
+ newsgroup namespace from that of other mailboxes. Thus, the
+ comp.mail.misc newsgroup would have an mailbox name of
+ "#news.comp.mail.misc", and the name "comp.mail.misc" could refer
+ to a different object (e.g. a user's private mailbox).
+@end example
+
+While there is nothing in this text that warrants concern for the IMAP
+implementation in Gnus, some servers use namespace prefixes in a way
+that does not work with how Gnus uses mailbox names.
+Specifically, University of Washington's IMAP server uses mailbox
+names like @code{#driver.mbx/read-mail} which are valid only in the
+@sc{create} and @sc{append} commands. After the mailbox is created
+(or a messages is appended to a mailbox), it must be accessed without
+the namespace prefix, i.e @code{read-mail}. Since Gnus do not make it
+possible for the user to guarantee that user entered mailbox names
+will only be used with the CREATE and APPEND commands, you should
+simply not use the namespace prefixed mailbox names in Gnus.
+
+See the UoW @sc{imapd} documentation for the @code{#driver.*/} prefix
+for more information on how to use the prefixes. They are a power
+tool and should be used only if you are sure what the effects are.
@node Other Sources
@section Other Sources
@code{nnvirtual} groups do not inherit anything but articles and marks
from component groups---group parameters, for instance, are not
-inherited.
+inherited.
@node Kibozed Groups
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 in your @file{.gnus.el}
-file:
-
-@lisp
-(setq gnus-agent t)
-@end lisp
-@end itemize
-
-That's it. Gnus is now an ``offline'' newsreader.
+Setting up Gnus as an ``offline'' newsreader is quite simple. In
+fact, you don't even have to configure anything.
Of course, to use it as such, you have to learn a few new commands.
* 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.
+* Agent as Cache:: The Agent is a big cache too.
* Agent Expiry:: How to make old articles go away.
* Agent and IMAP:: How to use the Agent with IMAP.
* Outgoing Messages:: What happens when you post/mail something?
Decide which servers should be covered by the Agent. If you have a mail
back end, 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.
+@kbd{J a} on the server (or servers) that you wish to have covered by the
+Agent (@pxref{Server Agent Commands}), or @kbd{J r} on automatically
+added servers you do not wish to have covered by the Agent. By default,
+all @code{nntp} and @code{nnimap} groups in @code{gnus-select-method} and
+@code{gnus-secondary-select-methods} are agentized.
@item
Decide on download policy. @xref{Agent Categories}.
or you could append your predicate to the predefined
@code{gnus-category-predicate-alist} in your @file{~/.gnus.el} or
-wherever.
+wherever.
@lisp
(require 'gnus-agent)
@end table
+@node Agent as Cache
+@subsection Agent as Cache
+
+When Gnus is plugged, it is not efficient to download headers or
+articles from the server again, if they are already stored in the
+Agent. So, Gnus normally only downloads headers once, and stores them
+in the Agent. These headers are later used when generating the summary
+buffer, regardless of whether you are plugged or unplugged. Articles
+are not cached in the Agent by default though (that would potentially
+consume lots of disk space), but if you have already downloaded an
+article into the Agent, Gnus will not download the article from the
+server again but use the locally stored copy instead.
+
+This behaviour can be controlled by @code{gnus-agent-cache}
+(@pxref{Agent Variables}).
+
@node Agent Expiry
@subsection Agent Expiry
case for nntp. Thus Gnus need to remember flag changes when
disconnected, and synchronize these flags when you plug back in.
-Gnus keep track of flag changes when reading nnimap groups under the
-Agent by default. When you plug back in, by default Gnus will check if
-you have any changed any flags and ask if you wish to synchronize these
-with the server. This behavior is customizable with
-@code{gnus-agent-synchronize-flags}.
+Gnus keeps track of flag changes when reading nnimap groups under the
+Agent. When you plug back in, Gnus will check if you have any changed
+any flags and ask if you wish to synchronize these with the server.
+The behavior is customizable by @code{gnus-agent-synchronize-flags}.
@vindex gnus-agent-synchronize-flags
If @code{gnus-agent-synchronize-flags} is @code{nil}, the Agent will
-never automatically synchronize flags. If it is @code{ask}, the
-default, the Agent will check if you made any changes and if so ask if
-you wish to synchronize these when you re-connect. If it has any other
-value, all flags will be synchronized automatically.
+never automatically synchronize flags. If it is @code{ask}, which is
+the default, the Agent will check if you made any changes and if so
+ask if you wish to synchronize these when you re-connect. If it has
+any other value, all flags will be synchronized automatically.
-If you do not wish to automatically synchronize flags when you
-re-connect, this can be done manually with the
+If you do not wish to synchronize flags automatically when you
+re-connect, you can do it manually with the
@code{gnus-agent-synchronize-flags} command that is bound to @kbd{J Y}
-in the group buffer by default.
+in the group buffer.
Some things are currently not implemented in the Agent that you'd might
expect from a disconnected @sc{imap} client, including:
@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.
+stored in the draft group ``queue'' (@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
@item gnus-agent-cache
@vindex gnus-agent-cache
-Variable to control whether use the locally stored @sc{nov} and articles when
-plugged.
+Variable to control whether use the locally stored @sc{nov} and
+articles when plugged, e.g. essentially using the Agent as a cache.
+The default is non-nil, which means to use the Agent as a cache.
@item gnus-agent-go-online
@vindex gnus-agent-go-online
other value, all offline servers will be automatically switched into
online status.
+@item gnus-server-unopen-status
+@vindex gnus-server-unopen-status
+Perhaps not a Agent variable, but closely related to the Agent, this
+variable says what will happen if Gnus cannot open a server. If the
+Agent is enabled, the default, @code{nil}, makes Gnus ask the user
+whether to deny the server or whether to unplug the agent. If the
+Agent is disabled, Gnus always simply deny the server. Other choices
+for this variable include @code{denied} and @code{offline} the latter
+is only valid if the Agent is used.
+
@end table
;;; Make Gnus into an offline newsreader.
;;; (gnus-agentize) ; The obsolete setting.
-(setq gnus-agent t)
+;;; (setq gnus-agent t) ; Now the default.
@end lisp
That should be it, basically. Put that in your @file{~/.gnus.el} file,
Some may feel that short words shouldn't count when doing adaptive
scoring. If so, you may set @code{gnus-adaptive-word-length-limit} to
an integer. Words shorter than this number will be ignored. This
-variable defaults til @code{nil}.
+variable defaults to @code{nil}.
@vindex gnus-adaptive-word-syntax-table
When the scoring is done, @code{gnus-adaptive-word-syntax-table} is the
@include emacs-mime.texi
@chapter Sieve
@include sieve.texi
+@chapter PGG
+@include pgg.texi
@end iflatex
@end iftex
@code{mouse-face} specs---you can say @samp{%3(hello%)} to have
@samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}.
-Text inside the @samp{%<} and @samp{%>} specifiers will get the special
-@code{balloon-help} property set to @code{gnus-balloon-face-0}. If you
-say @samp{%1<}, you'll get @code{gnus-balloon-face-1} and so on. The
-@code{gnus-balloon-face-*} variables should be either strings or symbols
-naming functions that return a string. Under @code{balloon-help-mode},
-when the mouse passes over text with this property set, a balloon window
-will appear and display the string. Please refer to the doc string of
-@code{balloon-help-mode} for more information on this.
+Text inside the @samp{%<<} and @samp{%>>} specifiers will get the
+special @code{balloon-help} property set to @code{gnus-balloon-face-0}.
+If you say @samp{%1<<}, you'll get @code{gnus-balloon-face-1} and so on.
+The @code{gnus-balloon-face-*} variables should be either strings or
+symbols naming functions that return a string. When the mouse passes
+over text with this property set, a balloon window will appear and
+display the string. Please refer to @ref{(emacs)Help Echo} (in GNU
+Emacs) or the doc string of @code{balloon-help-mode} (in XEmacs) for
+more information on this. (For technical reasons, the guillemets have
+been approximated as @samp{<<} and @samp{>>} in this paragraph.)
Here's an alternative recipe for the group buffer:
The problem is that when formatting, Gnus assumes that if a string is 10
characters wide, it'll be 10 Latin characters wide on the screen. In
-these coutries, that's not true.
+these countries, that's not true.
@vindex gnus-use-correct-string-widths
To help fix this, you can set @code{gnus-use-correct-string-widths} to
@code{t}. This makes buffer generation slower, but the results will be
-prettieer. The default value is @code{t}.
-
+prettier. The default value under XEmacs is @code{t} but @code{nil}
+for Emacs.
@node Window Layout
Internally, Gnus calls @code{gnus-make-predicate} on these specifiers
to create a function that can be called. This input parameter to this
function will be passed along to all the functions in the predicate
-specifier.
+specifier.
@node Moderation
@code{gnus-convert-pbm-to-x-face-command} shell command. The
@samp{pbm} files should be 48x48 pixels big.
-@code{gnus-x-face-from-file} takes a file as the parameter, and then
+@code{gnus-x-face-from-file} takes a GIF file as the parameter, and then
converts the file to X-Face format by using the
@code{gnus-convert-image-to-x-face-command} shell command.
Here's how you would typically use the former function. Put something
-like the folllowing in your @file{.gnus.el} file:
+like the following in your @file{.gnus.el} file:
@lisp
(setq message-required-news-headers
(``New! Miracle tonic for growing full, lustrous hair on your toes!'')
and one mail asking me to repent and find some god.
-This is annoying.
+This is annoying. Here's what you can do about it.
@menu
+* The problem of spam:: Some background, and some solutions
* Anti-Spam Basics:: Simple steps to reduce the amount of spam.
* SpamAssassin:: How to use external anti-spam tools.
* Hashcash:: Reduce spam by burning CPU time.
+* Filtering Spam Using spam.el::
+* Filtering Spam Using Statistics (spam-stat.el)::
@end menu
+@node The problem of spam
+@subsection The problem of spam
+@cindex email spam
+@cindex spam filtering approaches
+@cindex filtering approaches, spam
+@cindex UCE
+@cindex unsolicited commercial email
+
+First, some background on spam.
+
+If you have access to e-mail, you are familiar with spam (technically
+termed @acronym{UCE}, Unsolicited Commercial E-mail). Simply put, it exists
+because e-mail delivery is very cheap compared to paper mail, so only
+a very small percentage of people need to respond to an UCE to make it
+worthwhile to the advertiser. Ironically, one of the most common
+spams is the one offering a database of e-mail addresses for further
+spamming. Senders of spam are usually called @emph{spammers}, but terms like
+@emph{vermin}, @emph{scum}, and @emph{morons} are in common use as well.
+
+Spam comes from a wide variety of sources. It is simply impossible to
+dispose of all spam without discarding useful messages. A good
+example is the TMDA system, which requires senders
+unknown to you to confirm themselves as legitimate senders before
+their e-mail can reach you. Without getting into the technical side
+of TMDA, a downside is clearly that e-mail from legitimate sources may
+be discarded if those sources can't or won't confirm themselves
+through the TMDA system. Another problem with TMDA is that it
+requires its users to have a basic understanding of e-mail delivery
+and processing.
+
+The simplest approach to filtering spam is filtering. If you get 200
+spam messages per day from @email{random-address@@vmadmin.com}, you
+block @samp{vmadmin.com}. If you get 200 messages about
+@samp{VIAGRA}, you discard all messages with @samp{VIAGRA} in the
+message. This, unfortunately, is a great way to discard legitimate
+e-mail. For instance, the very informative and useful RISKS digest
+has been blocked by overzealous mail filters because it
+@strong{contained} words that were common in spam messages.
+Nevertheless, in isolated cases, with great care, direct filtering of
+mail can be useful.
+
+Another approach to filtering e-mail is the distributed spam
+processing, for instance DCC implements such a system. In essence,
+@code{N} systems around the world agree that a machine @samp{X} in
+China, Ghana, or California is sending out spam e-mail, and these
+@code{N} systems enter @samp{X} or the spam e-mail from @samp{X} into
+a database. The criteria for spam detection vary - it may be the
+number of messages sent, the content of the messages, and so on. When
+a user of the distributed processing system wants to find out if a
+message is spam, he consults one of those @code{N} systems.
+
+Distributed spam processing works very well against spammers that send
+a large number of messages at once, but it requires the user to set up
+fairly complicated checks. There are commercial and free distributed
+spam processing systems. Distributed spam processing has its risks as
+well. For instance legitimate e-mail senders have been accused of
+sending spam, and their web sites have been shut down for some time
+because of the incident.
+
+The statistical approach to spam filtering is also popular. It is
+based on a statistical analysis of previous spam messages. Usually
+the analysis is a simple word frequency count, with perhaps pairs of
+words or 3-word combinations thrown into the mix. Statistical
+analysis of spam works very well in most of the cases, but it can
+classify legitimate e-mail as spam in some cases. It takes time to
+run the analysis, the full message must be analyzed, and the user has
+to store the database of spam analyses.
+
@node Anti-Spam Basics
@subsection Anti-Spam Basics
@cindex email spam
(setq mail-sources
'((file :prescript "formail -bs spamassassin < /var/mail/%u")
(pop :user "jrl"
- :server "pophost"
+ :server "pophost"
:postscript "mv %t /tmp/foo; formail -bs spamc < /tmp/foo > %t")))
@end lisp
A novel technique to fight spam is to require senders to do something
costly for each message they send. This has the obvious drawback that
you cannot rely on that everyone in the world uses this technique,
-since it is not part of the internet standards, but it may be useful
+since it is not part of the Internet standards, but it may be useful
in smaller communities.
While the tools in the previous section work well in practice, they
customized mail filtering scripts. Improvements in this area would be
a useful contribution, however.
+@node Filtering Spam Using spam.el
+@subsection Filtering Spam Using spam.el
+@cindex spam filtering
+@cindex spam.el
+
+The idea behind @code{spam.el} is to have a control center for spam detection
+and filtering in Gnus. To that end, @code{spam.el} does two things: it
+filters incoming mail, and it analyzes mail known to be spam.
+
+So, what happens when you load @code{spam.el}? First of all, you get
+the following keyboard commands:
+
+@table @kbd
+
+@item M-d
+@itemx M s x
+@itemx S x
+@kindex M-d
+@kindex S x
+@kindex M s x
+@findex gnus-summary-mark-as-spam
+@code{gnus-summary-mark-as-spam}.
+
+Mark current article as spam, showing it with the @samp{H} mark.
+Whenever you see a spam article, make sure to mark its summary line
+with @kbd{M-d} before leaving the group.
+
+@item M s t
+@itemx S t
+@kindex M s t
+@kindex S t
+@findex spam-bogofilter-score
+@code{spam-bogofilter-score}.
+
+You must have bogofilter processing enabled for that command to work
+properly.
+
+@xref{Bogofilter}.
+
+@end table
+
+Gnus can learn from the spam you get. All you have to do is collect
+your spam in one or more spam groups, and set the variable
+@code{spam-junk-mailgroups} as appropriate. In these groups, all messages
+are considered to be spam by default: they get the @samp{H} mark. You must
+review these messages from time to time and remove the @samp{H} mark for
+every message that is not spam after all. When you leave a spam
+group, all messages that continue with the @samp{H} mark, are passed on to
+the spam-detection engine (bogofilter, ifile, and others). To remove
+the @samp{H} mark, you can use @kbd{M-u} to "unread" the article, or @kbd{d} for
+declaring it read the non-spam way. When you leave a group, all @samp{H}
+marked articles, saved or unsaved, are sent to Bogofilter or ifile
+(depending on @code{spam-use-bogofilter} and @code{spam-use-ifile}), which will study
+them as spam samples.
+
+Messages may also be deleted in various other ways, and unless
+@code{spam-ham-marks-form} gets overridden below, marks @samp{R} and @samp{r} for
+default read or explicit delete, marks @samp{X} and @samp{K} for automatic or
+explicit kills, as well as mark @samp{Y} for low scores, are all considered
+to be associated with articles which are not spam. This assumption
+might be false, in particular if you use kill files or score files as
+means for detecting genuine spam, you should then adjust
+@code{spam-ham-marks-form}. When you leave a group, all _unsaved_ articles
+bearing any the above marks are sent to Bogofilter or ifile, which
+will study these as not-spam samples. If you explicit kill a lot, you
+might sometimes end up with articles marked @samp{K} which you never saw,
+and which might accidentally contain spam. Best is to make sure that
+real spam is marked with @samp{H}, and nothing else.
+
+All other marks do not contribute to Bogofilter or ifile
+pre-conditioning. In particular, ticked, dormant or souped articles
+are likely to contribute later, when they will get deleted for real,
+so there is no need to use them prematurely. Explicitly expired
+articles do not contribute, command @kbd{E} is a way to get rid of an
+article without Bogofilter or ifile ever seeing it.
+
+@strong{TODO: @code{spam-use-ifile} does not process spam articles on group exit.
+I'm waiting for info from the author of @code{ifile-gnus.el}, because I think
+that functionality should go in @code{ifile-gnus.el} rather than @code{spam.el}.}
+
+To use the @code{spam.el} facilities for incoming mail filtering, you
+must add the following to your fancy split list
+@code{nnmail-split-fancy} or @code{nnimap-split-fancy}:
+
+@example
+(: spam-split)
+@end example
+
+Note that the fancy split may be called @code{nnmail-split-fancy} or
+@code{nnimap-split-fancy}, depending on whether you use the nnmail or
+nnimap back ends to retrieve your mail.
+
+The @code{spam-split} function will process incoming mail and send the mail
+considered to be spam into the group name given by the variable
+@code{spam-split-group}. Usually that group name is @samp{spam}.
+
+The following are the methods you can use to control the behavior of
+@code{spam-split}:
+
+@menu
+* Blacklists and Whitelists::
+* BBDB Whitelists::
+* Blackholes::
+* Bogofilter::
+* Ifile spam filtering::
+* Extending spam.el::
+@end menu
+
+@node Blacklists and Whitelists
+@subsubsection Blacklists and Whitelists
+@cindex spam filtering
+@cindex whitelists, spam filtering
+@cindex blacklists, spam filtering
+@cindex spam.el
+
+@defvar spam-use-blacklist
+Set this variables to t (the default) if you want to use blacklists.
+@end defvar
+
+@defvar spam-use-whitelist
+Set this variables to t if you want to use whitelists.
+@end defvar
+
+Blacklists are lists of regular expressions matching addresses you
+consider to be spam senders. For instance, to block mail from any
+sender at @samp{vmadmin.com}, you can put @samp{vmadmin.com} in your
+blacklist. Since you start out with an empty blacklist, no harm is
+done by having the @code{spam-use-blacklist} variable set, so it is
+set by default. Blacklist entries use the Emacs regular expression
+syntax.
+
+Conversely, whitelists tell Gnus what addresses are considered
+legitimate. All non-whitelisted addresses are considered spammers.
+This option is probably not useful for most Gnus users unless the
+whitelists is very comprehensive. Also see @ref{BBDB Whitelists}.
+Whitelist entries use the Emacs regular expression syntax.
+
+The Blacklist and whitelist location can be customized with the
+@code{spam-directory} variable (@file{~/News/spam} by default). The whitelist
+and blacklist files will be in that directory, named @file{whitelist} and
+@file{blacklist} respectively.
+
+@node BBDB Whitelists
+@subsubsection BBDB Whitelists
+@cindex spam filtering
+@cindex BBDB whitelists, spam filtering
+@cindex BBDB, spam filtering
+@cindex spam.el
+
+@defvar spam-use-bbdb
+
+Analogous to @code{spam-use-whitelist} (@pxref{Blacklists and
+Whitelists}), but uses the BBDB as the source of whitelisted addresses,
+without regular expressions. You must have the BBDB loaded for
+@code{spam-use-bbdb} to work properly. Only addresses in the BBDB
+will be allowed through; all others will be classified as spam.
+
+@end defvar
+
+@node Blackholes
+@subsubsection Blackholes
+@cindex spam filtering
+@cindex blackholes, spam filtering
+@cindex spam.el
+
+@defvar spam-use-blackholes
+
+This option is disabled by default. You can let Gnus consult the
+blackhole-type distributed spam processing systems (DCC, for instance)
+when you set this option. The variable @code{spam-blackhole-servers}
+holds the list of blackhole servers Gnus will consult. The current
+list is fairly comprehensive, but make sure to let us know if it
+contains outdated servers.
+
+The blackhole check uses the @code{dig.el} package, but you can tell
+@code{spam.el} to use @code{dns.el} instead for better performance if
+you set @code{spam-use-dig} to nil. It is not recommended at this
+time to set @code{spam-use-dig} to nil despite the possible
+performance improvements, because some users may be unable to use it,
+but you can try it and see if it works for you.
+
+@end defvar
+
+@node Bogofilter
+@subsubsection Bogofilter
+@cindex spam filtering
+@cindex bogofilter, spam filtering
+@cindex spam.el
+
+@defvar spam-use-bogofilter
+
+Set this variable if you want to use Eric Raymond's speedy Bogofilter.
+This has been tested with a locally patched copy of version 0.4. Make
+sure to read the installation comments in @code{spam.el}.
+
+With a minimum of care for associating the @samp{H} mark for spam
+articles only, Bogofilter training all gets fairly automatic. You
+should do this until you get a few hundreds of articles in each
+category, spam or not. The shell command @command{head -1
+~/.bogofilter/*} shows both article counts. The command @kbd{S t} in
+summary mode, either for debugging or for curiosity, triggers
+Bogofilter into displaying in another buffer the @emph{spamicity}
+score of the current article (between 0.0 and 1.0), together with the
+article words which most significantly contribute to the score.
+
+@end defvar
+
+@node Ifile spam filtering
+@subsubsection Ifile spam filtering
+@cindex spam filtering
+@cindex ifile, spam filtering
+@cindex spam.el
+
+@defvar spam-use-ifile
+
+Enable this variable if you want to use Ifile, a statistical analyzer
+similar to Bogofilter. Currently you must have @code{ifile-gnus.el}
+loaded. The integration of Ifile with @code{spam.el} is not finished
+yet, but you can use @code{ifile-gnus.el} on its own if you like.
+
+@end defvar
+
+@node Extending spam.el
+@subsubsection Extending spam.el
+@cindex spam filtering
+@cindex spam.el, extending
+@cindex extending spam.el
+
+Say you want to add a new back end called blackbox. Provide the following:
+
+@enumerate
+@item
+documentation
+
+@item
+code
+
+@example
+(defvar spam-use-blackbox nil
+ "True if blackbox should be used.")
+@end example
+
+Add
+@example
+ (spam-use-blackbox . spam-check-blackbox)
+@end example
+to @code{spam-list-of-checks}.
+
+@item
+functionality
+
+Write the @code{spam-check-blackbox} function. It should return
+@samp{nil} or @code{spam-split-group}. See the existing
+@code{spam-check-*} functions for examples of what you can do.
+@end enumerate
+
+@node Filtering Spam Using Statistics (spam-stat.el)
+@subsection Filtering Spam Using Statistics (spam-stat.el)
+@cindex Paul Graham
+@cindex Graham, Paul
+@cindex naive Bayesian spam filtering
+@cindex Bayesian spam filtering, naive
+@cindex spam filtering, naive Bayesian
+
+Paul Graham has written an excellent essay about spam filtering using
+statistics: @uref{http://www.paulgraham.com/spam.html,A Plan for
+Spam}. In it he describes the inherent deficiency of rule-based
+filtering as used by SpamAssassin, for example: Somebody has to write
+the rules, and everybody else has to install these rules. You are
+always late. It would be much better, he argues, to filter mail based
+on whether it somehow resembles spam or non-spam. One way to measure
+this is word distribution. He then goes on to describe a solution
+that checks whether a new mail resembles any of your other spam mails
+or not.
+
+The basic idea is this: Create a two collections of your mail, one
+with spam, one with non-spam. Count how often each word appears in
+either collection, weight this by the total number of mails in the
+collections, and store this information in a dictionary. For every
+word in a new mail, determine its probability to belong to a spam or a
+non-spam mail. Use the 15 most conspicuous words, compute the total
+probability of the mail being spam. If this probability is higher
+than a certain threshold, the mail is considered to be spam.
+
+Gnus supports this kind of filtering. But it needs some setting up.
+First, you need two collections of your mail, one with spam, one with
+non-spam. Then you need to create a dictionary using these two
+collections, and save it. And last but not least, you need to use
+this dictionary in your fancy mail splitting rules.
+
+@menu
+* Creating a spam-stat dictionary::
+* Splitting mail using spam-stat::
+* Low-level interface to the spam-stat dictionary::
+@end menu
+
+@node Creating a spam-stat dictionary
+@subsubsection Creating a spam-stat dictionary
+
+Before you can begin to filter spam based on statistics, you must
+create these statistics based on two mail collections, one with spam,
+one with non-spam. These statistics are then stored in a dictionary
+for later use. In order for these statistics to be meaningful, you
+need several hundred emails in both collections.
+
+Gnus currently supports only the nnml back end for automated dictionary
+creation. The nnml back end stores all mails in a directory, one file
+per mail. Use the following:
+
+@defun spam-stat-process-spam-directory
+Create spam statistics for every file in this directory. Every file
+is treated as one spam mail.
+@end defun
+
+@defun spam-stat-process-non-spam-directory
+Create non-spam statistics for every file in this directory. Every
+file is treated as one non-spam mail.
+@end defun
+
+Usually you would call @code{spam-stat-process-spam-directory} on a
+directory such as @file{~/Mail/mail/spam} (this usually corresponds
+the the group @samp{nnml:mail.spam}), and you would call
+@code{spam-stat-process-non-spam-directory} on a directory such as
+@file{~/Mail/mail/misc} (this usually corresponds the the group
+@samp{nnml:mail.misc}).
+
+@defvar spam-stat
+This variable holds the hash-table with all the statistics -- the
+dictionary we have been talking about. For every word in either
+collection, this hash-table stores a vector describing how often the
+word appeared in spam and often it appeared in non-spam mails.
+
+If you want to regenerate the statistics from scratch, you need to
+reset the dictionary.
+
+@end defvar
+
+@defun spam-stat-reset
+Reset the @code{spam-stat} hash-table, deleting all the statistics.
+
+When you are done, you must save the dictionary. The dictionary may
+be rather large. If you will not update the dictionary incrementally
+(instead, you will recreate it once a month, for example), then you
+can reduce the size of the dictionary by deleting all words that did
+not appear often enough or that do not clearly belong to only spam or
+only non-spam mails.
+@end defun
+
+@defun spam-stat-reduce-size
+Reduce the size of the dictionary. Use this only if you do not want
+to update the dictionary incrementally.
+@end defun
+
+@defun spam-stat-save
+Save the dictionary.
+@end defun
+
+@defvar spam-stat-file
+The filename used to store the dictionary. This defaults to
+@file{~/.spam-stat.el}.
+@end defvar
+
+@node Splitting mail using spam-stat
+@subsubsection Splitting mail using spam-stat
+
+In order to use @code{spam-stat} to split your mail, you need to add the
+following to your @file{~/.gnus} file:
+
+@example
+(require 'spam-stat)
+(spam-stat-load)
+@end example
+
+This will load the necessary Gnus code, and the dictionary you
+created.
+
+Next, you need to adapt your fancy splitting rules: You need to
+determine how to use @code{spam-stat}. In the simplest case, you only have
+two groups, @samp{mail.misc} and @samp{mail.spam}. The following expression says
+that mail is either spam or it should go into @samp{mail.misc}. If it is
+spam, then @code{spam-stat-split-fancy} will return @samp{mail.spam}.
+
+@example
+(setq nnmail-split-fancy
+ `(| (: spam-stat-split-fancy)
+ "mail.misc"))
+@end example
+
+@defvar spam-stat-split-fancy-spam-group
+The group to use for spam. Default is @samp{mail.spam}.
+@end defvar
+
+If you also filter mail with specific subjects into other groups, use
+the following expression. It only the mails not matching the regular
+expression are considered potential spam.
+
+@example
+(setq nnmail-split-fancy
+ `(| ("Subject" "\\bspam-stat\\b" "mail.emacs")
+ (: spam-stat-split-fancy)
+ "mail.misc"))
+@end example
+
+If you want to filter for spam first, then you must be careful when
+creating the dictionary. Note that @code{spam-stat-split-fancy} must
+consider both mails in @samp{mail.emacs} and in @samp{mail.misc} as
+non-spam, therefore both should be in your collection of non-spam
+mails, when creating the dictionary!
+
+@example
+(setq nnmail-split-fancy
+ `(| (: spam-stat-split-fancy)
+ ("Subject" "\\bspam-stat\\b" "mail.emacs")
+ "mail.misc"))
+@end example
+
+You can combine this with traditional filtering. Here, we move all
+HTML-only mails into the @samp{mail.spam.filtered} group. Note that since
+@code{spam-stat-split-fancy} will never see them, the mails in
+@samp{mail.spam.filtered} should be neither in your collection of spam mails,
+nor in your collection of non-spam mails, when creating the
+dictionary!
+
+@example
+(setq nnmail-split-fancy
+ `(| ("Content-Type" "text/html" "mail.spam.filtered")
+ (: spam-stat-split-fancy)
+ ("Subject" "\\bspam-stat\\b" "mail.emacs")
+ "mail.misc"))
+@end example
+
+
+@node Low-level interface to the spam-stat dictionary
+@subsubsection Low-level interface to the spam-stat dictionary
+
+The main interface to using @code{spam-stat}, are the following functions:
+
+@defun spam-stat-buffer-is-spam
+called in a buffer, that buffer is considered to be a new spam mail;
+use this for new mail that has not been processed before
+
+@end defun
+
+@defun spam-stat-buffer-is-no-spam
+called in a buffer, that buffer is considered to be a new non-spam
+mail; use this for new mail that has not been processed before
+
+@end defun
+
+@defun spam-stat-buffer-change-to-spam
+called in a buffer, that buffer is no longer considered to be normal
+mail but spam; use this to change the status of a mail that has
+already been processed as non-spam
+
+@end defun
+
+@defun spam-stat-buffer-change-to-non-spam
+called in a buffer, that buffer is no longer considered to be spam but
+normal mail; use this to change the status of a mail that has already
+been processed as spam
+
+@end defun
+
+@defun spam-stat-save
+save the hash table to the file; the filename used is stored in the
+variable @code{spam-stat-file}
+
+@end defun
+
+@defun spam-stat-load
+load the hash table from a file; the filename used is stored in the
+variable @code{spam-stat-file}
+
+@end defun
+
+@defun spam-stat-score-word
+return the spam score for a word
+
+@end defun
+
+@defun spam-stat-score-buffer
+return the spam score for a buffer
+
+@end defun
+
+@defun spam-stat-split-fancy
+for fancy mail splitting; add the rule @samp{(: spam-stat-split-fancy)} to
+@code{nnmail-split-fancy}
+
+This requires the following in your @file{~/.gnus} file:
+
+@example
+(require 'spam-stat)
+(spam-stat-load)
+@end example
+
+@end defun
+
+Typical test will involve calls to the following functions:
+
+@example
+Reset: (setq spam-stat (make-hash-table :test 'equal))
+Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam")
+Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc")
+Save table: (spam-stat-save)
+File size: (nth 7 (file-attributes spam-stat-file))
+Number of words: (hash-table-count spam-stat)
+Test spam: (spam-stat-test-directory "~/Mail/mail/spam")
+Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc")
+Reduce table size: (spam-stat-reduce-size)
+Save table: (spam-stat-save)
+File size: (nth 7 (file-attributes spam-stat-file))
+Number of words: (hash-table-count spam-stat)
+Test spam: (spam-stat-test-directory "~/Mail/mail/spam")
+Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc")
+@end example
+
+Here is how you would create your dictionary:
+
+@example
+Reset: (setq spam-stat (make-hash-table :test 'equal))
+Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam")
+Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc")
+Repeat for any other non-spam group you need...
+Reduce table size: (spam-stat-reduce-size)
+Save table: (spam-stat-save)
+@end example
+
@node Various Various
@section Various Various
@cindex mode lines
whatever packages the Gnus XEmacs package requires. The current
requirements are @samp{gnus}, @samp{w3}, @samp{mh-e},
@samp{mailcrypt}, @samp{rmail}, @samp{eterm}, @samp{mail-lib},
-@samp{xemacs-base}, and @samp{fsf-compat}.
+@samp{xemacs-base}, and @samp{fsf-compat}. The @samp{misc-games}
+package is required for Morse decoding.
@node History
decoding (verification and decryption).
@item PGP/MIME - RFC 2015/3156
-RFC 2015 (superceded by 3156 which references RFC 2440 instead of RFC
+RFC 2015 (superseded by 3156 which references RFC 2440 instead of RFC
1991) describes the @sc{mime}-wrapping around the RF 1991/2440 format.
Gnus supports both encoding and decoding.
@item back end
@cindex back end
-Gnus gets fed articles from a number of back ends, both news and mail
-back ends. Gnus does not handle the underlying media, so to speak---this
-is all done by the back ends.
+Gnus considers mail and news to be mostly the same, really. The only
+difference is how to access the actual articles. News articles are
+commonly fetched via the protocol NNTP, whereas mail messages could be
+read from a file on the local disk. The internal architecture of Gnus
+thus comprises a `front end' and a number of `back ends'. Internally,
+when you enter a group (by hitting @key{RET}, say), you thereby invoke
+a function in the front end in Gnus. The front end then `talks' to a
+back end and says things like ``Give me the list of articles in the foo
+group'' or ``Show me article number 4711''.
+
+So a back end mainly defines either a protocol (the @code{nntp} back end
+accesses news via NNTP, the @code{nnimap} back end accesses mail via
+IMAP) or a file format and directory layout (the @code{nnspool} back end
+accesses news via the common `spool directory' format, the @code{nnml}
+back end access mail via a file format and directory layout that's
+quite similar).
+
+Gnus does not handle the underlying media, so to speak---this is all
+done by the back ends. A back end is a collection of functions to
+access the articles.
+
+However, sometimes the term `back end' is also used where `server'
+would have been more appropriate. And then there is the term `select
+method' which can mean either. The Gnus terminology can be quite
+confusing.
@item native
@cindex native
If you would like to contribute a patch to fix bugs or make
improvements, please produce the patch using @samp{diff -u}.
+@cindex edebug
+If you want to debug your problem further before reporting, possibly
+in order to solve the problem yourself and send a patch, you can use
+edebug. Debugging lisp code is documented in the Elisp manual
+(@pxref{Debugging, , Debugging Lisp Programs, elisp, The GNU Emacs
+Lisp Reference Manual}). To get you started with edebug, consider if
+you discover some weird behaviour when pressing @kbd{c}, the first
+step is to do @kbd{C-h k c} and click on the hyperlink (Emacs only) in
+the documentation buffer that leads you to the function definition,
+then press @kbd{M-x edebug-defun RET} with point inside that function,
+return to Gnus and press @kbd{c} to invoke the code. You will be
+placed in the lisp buffer and can single step using @kbd{SPC} and
+evaluate expressions using @kbd{M-:} or inspect variables using
+@kbd{C-h v}, abort execution with @kbd{q}, and resume execution with
+@kbd{c} or @kbd{g}.
+
+@cindex elp
+@cindex profile
+@cindex slow
+Sometimes, a problem do not directly generate a elisp error but
+manifests itself by causing Gnus to be very slow. In these cases, you
+can use @kbd{M-x toggle-debug-on-quit} and press C-j when things are
+slow, and then try to analyze the backtrace (repeating the procedure
+helps isolating the real problem areas). A fancier approach is to use
+the elisp profiler, ELP. The profiler is (or should be) fully
+documented elsewhere, but to get you started there are a few steps
+that need to be followed. First, instrument the part of Gnus you are
+interested in for profiling, e.g. @kbd{M-x elp-instrument-package RET
+gnus} or @kbd{M-x elp-instrument-packagre RET message}. Then perform
+the operation that is slow and press @kbd{M-x elp-results}. You will
+then see which operations that takes time, and can debug them further.
+If the entire operation takes much longer than the time spent in the
+slowest function in the profiler output, you probably profiled the
+wrong part of Gnus. To reset profiling statistics, use @kbd{M-x
+elp-reset-all}. @kbd{M-x elp-restore-all} is supposed to remove
+profiling, but given the complexities and dynamic code generation in
+Gnus, it might not always work perfectly.
+
If you just need help, you are better off asking on
@samp{gnu.emacs.gnus}. I'm not very helpful.
also useful for the article numbers to start at 1 to avoid running out
of numbers as long as possible.
+Note that by convention, backends are named @code{nnsomething}, but
+Gnus also comes with some @code{nnnotbackends}, such as
+@file{nnheader.el}, @file{nnmail.el} and @file{nnoo.el}.
+
In the examples and definitions I will refer to the imaginary back end
@code{nnchoke}.
alterations. This comes in handy if the back end 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.
+should return a non-nil value.
There should be no result data from this function.
%% include file for the Gnus refcard and booklet
\def\progver{5.10}\def\refver{5.10-1} % program and refcard versions
-\def\date{Oct 13th, 2001}
+\def\date{Dec 15th, 2002}
\def\author{Gnus Bugfixing Girls + Boys $<$bugs@gnus.org$>$}
%%
\newcommand{\Notes}{%
\subsection*{Notes}
{\esamepage
- Gnus is complex. Currently it has some 346 interactive (user-callable)
- functions. Of these 279 are in the two major modes (Group and
+ Gnus is complex. Currently it has some 876 interactive (user-callable)
+ functions. Of these 618 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
+ have 3 or even 4 bindings. The total number of keybindings is 677. 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.
C-c C-i & Gnus online-manual ({\bf info}).\\
C-x C-t & {\bf Transpose} two groups.\\
H f & Fetch this group's {\bf FAQ} (using ange-ftp).\\
+ H c & Display this group's {\bf charter}. [Prefix: query for group]\\
+ H C & Display this group's {\bf control message} (using
+ ange-ftp). [Prefix: query for group]\\
H v & (V) Display the Gnus {\bf version} number.\\
H d & (C-c C-d) Show the {\bf description} of this group
[Prefix: re-read from server].\\
@page
@vskip 0pt plus 1filll
-Copyright @copyright{} 1996, 1997, 1998, 1999, 2000, 2001, 2002
+Copyright @copyright{} 1996, 1997, 1998, 1999, 2000, 2001, 2002
Free Software Foundation, Inc.
Permission is granted to copy, distribute and/or modify this document
@vindex message-subscribed-addresses
@item message-subscribed-addresses
This should be a list of addresses the user is subscribed to. Its
-default value is @code{nil}. Example:
+default value is @code{nil}. Example:
@lisp
-(setq message-subscribed-addresses
+(setq message-subscribed-addresses
'("ding@@gnus.org" "bing@@noose.org"))
@end lisp
@item C-a
@kindex C-a
@findex message-beginning-of-line
+@vindex message-beginning-of-line
If at beginning of header value, go to beginning of line, else go to
beginning of header value. (The header value comes after the header
-name and the colon.)
+name and the colon.) This behaviour can be disabled by toggling
+the variable @code{message-beginning-of-line}.
@end table
message a single part tag will be used. This way, message mode will
do the Right Thing (TM) with signed/encrypted multipart messages.
+@vindex mml-signencrypt-style-alist
By default, when encrypting a message, Gnus will use the "signencrypt"
mode. If you would like to disable this for a particular message,
give the mml-secure-message-encrypt-* command a prefix argument. (for
example, C-u C-c C-m c p). Additionally, by default Gnus will
separately sign, then encrypt a message which has the mode
-signencrypt. If you would like to change this behavior use the
-@code{mml-signencrypt-style} function. For example
+signencrypt. If you would like to change this behavior you can
+customize the @code{mml-signencrypt-style-alist} variable. For
+example:
-@code{(mml-signencrypt-style "pgpmime" 'combined)}
+
+@lisp
+(setq mml-signencrypt-style-alist '(("smime" combined)
+ ("pgp" combined)
+ ("pgpmime" combined)))
+@end lisp
Will cause Gnus to sign and encrypt in one pass, thus generating a
-single signed and encrypted part.
+single signed and encrypted part. Note that combined sign and encrypt
+does not work with all supported OpenPGP implementations (in
+particular, PGP version 2 do not support this).
Since signing and especially encryption often is used when sensitive
information is sent, you may want to have some way to ensure that your
Rename the buffer (@code{message-rename-buffer}). If given a prefix,
prompt for a new buffer name.
+@item TAB
+@kindex TAB
+@findex message-tab
+@vindex message-tab-body-function
+If non-@code{nil} execute the function specified in
+@code{message-tab-body-function}. Otherwise use the function bound to
+@kbd{TAB} in @code{text-mode-map} or @code{global-map}.
+
@end table
@item message-generate-headers-first
@vindex message-generate-headers-first
-If non-@code{nil}, generate all required headers before starting to
-compose the message.
+If @code{t}, generate all required headers before starting to
+compose the message. This can also be a list of headers to generate:
+
+@lisp
+(setq message-generate-headers-first
+ '(References))
+@end lisp
-The variables @code{message-required-mail-headers} and
-@code{message-required-news-headers} specify which headers are required.
+@vindex message-required-headers
+The variables @code{message-required-headers},
+@code{message-required-mail-headers} and
+@code{message-required-news-headers} specify which headers are
+required.
Note that some headers will be removed and re-generated before posting,
because of the variable @code{message-deletable-headers} (see below).
+@item message-draft-headers
+@vindex message-draft-headers
+When running Message from Gnus, the message buffers are associated
+with a draft group. @code{message-draft-headers} says which headers
+should be generated when a draft is written to the draft group.
+
@item message-from-style
@vindex message-from-style
Specifies how @code{From} headers should look. There are four valid
A regexp to match the alternative email addresses. The first matched
address (not primary one) is used in the @code{From} field.
+@item message-allow-no-recipients
+@vindex message-allow-no-recipients
+Specifies what to do when there are no recipients other than
+@code{Gcc} or @code{Fcc}. If it is @code{always}, the posting is
+allowed. If it is @code{never}, the posting is not allowed. If it is
+@code{ask} (the default), you are prompted.
+
@end table
@findex message-send-mail-with-sendmail
@findex message-send-mail-with-mh
@findex message-send-mail-with-qmail
+@findex message-smtpmail-send-it
@findex smtpmail-send-it
@findex feedmail-send-it
Function used to send the current buffer as mail. The default is
@code{message-send-mail-with-sendmail}. Other valid values include
@code{message-send-mail-with-mh}, @code{message-send-mail-with-qmail},
-@code{smtpmail-send-it} and @code{feedmail-send-it}.
+@code{message-smtpmail-send-it}, @code{smtpmail-send-it} and
+@code{feedmail-send-it}.
@item message-mh-deletable-headers
@vindex message-mh-deletable-headers
@item message-send-mail-partially-limit
@vindex message-send-mail-partially-limit
The limitation of messages sent as message/partial.
-The lower bound of message size in characters, beyond which the message
+The lower bound of message size in characters, beyond which the message
should be sent in several parts. If it is nil, the size is unlimited.
@end table
File containing the signature to be inserted at the end of the buffer.
The default is @file{~/.signature}.
+@item message-signature-insert-empty-line
+@vindex message-signature-insert-empty-line
+If @code{t} (the default value) an empty line is inserted before the
+signature separator.
+
@end table
Note that RFC1036bis says that a signature should be preceded by the three
Symbol naming a @sc{mime} charset. Non-ASCII characters in messages are
assumed to be encoded using this charset. The default is @code{nil},
which means ask the user. (This variable is used only on non-@sc{mule}
-Emacsen.
-@xref{Charset Translation, , Charset Translation, emacs-mime,
+Emacsen.
+@xref{Charset Translation, , Charset Translation, emacs-mime,
Emacs MIME Manual}, for details on the @sc{mule}-to-@sc{mime}
translation process.
--- /dev/null
+\input texinfo @c -*-texinfo-*-
+
+@setfilename pgg.info
+
+@set VERSION 0.1
+
+@direntry
+* PGG: (pgg). Emacs interface to various PGP implementations.
+@end direntry
+
+@settitle PGG @value{VERSION}
+
+@ifinfo
+This file describes the PGG.
+
+Copyright (C) 2001 Daiki Ueno.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.1 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
+Texts. A copy of the license is included in the section entitled "GNU
+Free Documentation License".
+@end ifinfo
+
+@tex
+
+@titlepage
+@title PGG
+
+@author by Daiki Ueno
+@page
+
+@vskip 0pt plus 1filll
+Copyright @copyright{} 2001 Daiki Ueno.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.1 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
+Texts. A copy of the license is included in the section entitled "GNU
+Free Documentation License".
+@end titlepage
+@page
+
+@end tex
+
+@node Top
+@top PGG
+This manual describes PGG. PGG is an interface library between Emacs
+and various tools for secure communication. PGG also provides a simple
+user interface to encrypt, decrypt, sign, and verify MIME messages.
+
+@menu
+* Overview:: What PGG is.
+* Prerequisites:: Complicated stuff you may have to do.
+* How to use:: Getting started quickly.
+* Architecture::
+* Parsing OpenPGP packets::
+* Function Index::
+* Variable Index::
+@end menu
+
+@node Overview
+@chapter Overview
+
+PGG is an interface library between Emacs and various tools for secure
+communication. Even though Mailcrypt has similar feature, it does not
+deal with detached PGP messages, normally used in PGP/MIME
+infrastructure. This was the main reason why I wrote the new library.
+
+PGP/MIME is an application of MIME Object Security Services (RFC1848).
+The standard is documented in RFC2015.
+
+@node Prerequisites
+@chapter Prerequisites
+
+PGG requires at least one implementation of privacy guard system.
+This document assumes that you have already obtained and installed them
+and that you are familiar with its basic functions.
+
+By default, PGG uses GnuPG, but Pretty Good Privacy version 2 or version
+5 are also supported. If you are new to such a system, I recomend that
+you should look over the GNU Privacy Handbook (GPH) which is available
+at @uref{http://www.gnupg.org/gph/}.
+
+@node How to use
+@chapter How to use
+
+The toplevel interface of this library is quite simple, and only
+intended to use with public-key cryptographic operation.
+
+To use PGG, evaluate following expression at the beginning of your
+application program.
+
+@lisp
+(require 'pgg)
+@end lisp
+
+If you want to check existence of pgg.el at runtime, instead you can
+list autoload setting for desired functions as follows.
+
+@lisp
+(autoload 'pgg-encrypt-region "pgg"
+ "Encrypt the current region." t)
+(autoload 'pgg-decrypt-region "pgg"
+ "Decrypt the current region." t)
+(autoload 'pgg-sign-region "pgg"
+ "Sign the current region." t)
+(autoload 'pgg-verify-region "pgg"
+ "Verify the current region." t)
+(autoload 'pgg-insert-key "pgg"
+ "Insert the ASCII armored public key." t)
+(autoload 'pgg-snarf-keys-region "pgg"
+ "Import public keys in the current region." t)
+@end lisp
+
+@menu
+* User Commands::
+* Selecting an implementation::
+* Caching passphrase::
+@end menu
+
+@node User Commands
+@section User Commands
+
+At this time you can use some cryptographic commands. The behavior of
+these commands relies on a fashion of invocation because they are also
+intended to be used as library functions. In case you don't have the
+signer's public key, for example, the function @code{pgg-verify-region}
+fails immediately, but if the function had been called interactively, it
+would ask you to retrieve the signer's public key from the server.
+
+@deffn Command pgg-encrypt-region start end recipients &optional sign
+Encrypt the current region between @var{start} and @var{end} for
+@var{recipients}. When the function were called interactively, you
+would be asked about the recipients.
+
+If encryption is successful, it replaces the current region contents (in
+the accessible portion) with the resulting data.
+
+If optional argument @var{sign} is non-nil, the function is request to
+do a combined sign and encrypt. This currently only work with GnuPG.
+@end deffn
+
+@deffn Command pgg-decrypt-region start end
+Decrypt the current region between @var{start} and @var{end}. If
+decryption is successful, it replaces the current region contents (in
+the accessible portion) with the resulting data.
+@end deffn
+
+@deffn Command pgg-sign-region start end &optional cleartext
+Make the signature from text between @var{start} and @var{end}. If the
+optional third argument @var{cleartext} is non-@code{nil}, or the
+function is called interactively, it does not create a detached
+signature. In such a case, it replaces the current region contents (in
+the accessible portion) with the resulting data.
+@end deffn
+
+@deffn Command pgg-verify-region start end &optional signature fetch
+Verify the current region between @var{start} and @var{end}. If the
+optional third argument @var{signature} is non-@code{nil}, or the function
+is called interactively, it is treated as the detached signature of the
+current region.
+
+If the optional 4th argument @var{fetch} is non-@code{nil}, or the
+function is called interactively, we attempt to fetch the signer's
+public key from the key server.
+@end deffn
+
+@deffn Command pgg-insert-key
+Retrieve the user's public key and insert it as ASCII-armored format.
+@end deffn
+
+@deffn Command pgg-snarf-keys-region start end
+Collect public keys in the current region between @var{start} and
+@var{end}, and add them into the user's keyring.
+@end deffn
+
+@node Selecting an implementation
+@section Selecting an implementation
+
+Since PGP has a long history and there are a number of PGP
+implementations available today, the function which each one has differs
+considerably. For example, if you are using GnuPG, you know you can
+select cipher algorithm from 3DES, CAST5, BLOWFISH, and so on, but on
+the other hand the version 2 of PGP only supports IDEA.
+
+By default, if the variable @var{pgg-scheme} is not set, PGG searches the
+registered scheme for an implementation of the requested service
+associated with the named algorithm. If there are no match, PGG uses
+@var{pgg-default-scheme}. In other words, there are two options to
+control which command is used to process the incoming PGP armors. One
+is for encrypting and signing, the other is for decrypting and
+verifying.
+
+@defvar pgg-scheme
+Force specify the scheme of PGP implementation for decrypting and verifying.
+The value can be @code{gpg}, @code{pgp}, and @code{pgp5}.
+@end defvar
+
+@defvar pgg-default-scheme
+Force specify the scheme of PGP implementation for encrypting and signing.
+The value can be @code{gpg}, @code{pgp}, and @code{pgp5}.
+@end defvar
+
+@node Caching passphrase
+@section Caching passphrase
+
+PGG provides a simple passphrase caching mechanism. If you want to
+arrange the interaction, set the variable @var{pgg-read-passphrase}.
+
+@defvar pgg-cache-passphrase
+If non-@code{nil}, store passphrases. The default value of this
+variable is @code{t}. If you were worry about security issue, however,
+you could stop caching with setting it @code{nil}.
+@end defvar
+
+@defvar pgg-passphrase-cache-expiry
+Elapsed time for expiration in seconds.
+@end defvar
+
+@node Architecture
+@chapter Architecture
+
+PGG introduces the notion of a "scheme of PGP implementation" (used
+interchangeably with "scheme" in this document). This term refers to a
+singleton object wrapped with the luna object system.
+
+Since PGG was designed for accessing and developing PGP functionality,
+the architecture had to be designed not just for interoperablity but
+also for extensiblity. In this chapter we explore the architecture
+while finding out how to write the PGG backend.
+
+@menu
+* Initializing::
+* Backend methods::
+* Getting output::
+@end menu
+
+@node Initializing
+@section Initializing
+
+A scheme must be initialized before it is used.
+It had better guarantee to keep only one instance of a scheme.
+
+The following code is snipped out of @file{pgg-gpg.el}. Once an
+instance of @code{pgg-gpg} scheme is initialized, it's stored to the
+variable @var{pgg-scheme-gpg-instance} and will be reused from now on.
+
+@lisp
+(defvar pgg-scheme-gpg-instance nil)
+
+(defun pgg-make-scheme-gpg ()
+ (or pgg-scheme-gpg-instance
+ (setq pgg-scheme-gpg-instance
+ (luna-make-entity 'pgg-scheme-gpg))))
+@end lisp
+
+The name of the function must follow the
+regulation---@code{pgg-make-scheme-} follows the backend name.
+
+@node Backend methods
+@section Backend methods
+
+In each backend, these methods must be present. The output of these
+methods is stored in special buffers (@ref{Getting output}), so that
+these methods must tell the status of the execution.
+
+@deffn Method pgg-scheme-lookup-key scheme string &optional type
+Return keys associated with @var{string}. If the optional third
+argument @var{type} is non-@code{nil}, it searches from the secret
+keyrings.
+@end deffn
+
+@deffn Method pgg-scheme-encrypt-region scheme start end recipients &optional sign
+Encrypt the current region between @var{start} and @var{end} for
+@var{recipients}. If @var{sign} is non-nil, do a combined sign and
+encrypt. If encryption is successful, it returns @code{t}, otherwise
+@code{nil}.
+@end deffn
+
+@deffn Method pgg-scheme-decrypt-region scheme start end
+Decrypt the current region between @var{start} and @var{end}. If
+decryption is successful, it returns @code{t}, otherwise @code{nil}.
+@end deffn
+
+@deffn Method pgg-scheme-sign-region scheme start end &optional cleartext
+Make the signature from text between @var{start} and @var{end}. If the
+optional third argument @var{cleartext} is non-@code{nil}, it does not
+create a detached signature. If signing is successful, it returns
+@code{t}, otherwise @code{nil}.
+@end deffn
+
+@deffn Method pgg-scheme-verify-region scheme start end &optional signature
+Verify the current region between @var{start} and @var{end}. If the
+optional third argument @var{signature} is non-@code{nil}, it is treated
+as the detached signature of the current region. If the signature is
+successflly verified, it returns @code{t}, otherwise @code{nil}.
+@end deffn
+
+@deffn Method pgg-scheme-insert-key scheme
+Retrieve the user's public key and insert it as ASCII-armored format.
+On success, it returns @code{t}, otherwise @code{nil}.
+@end deffn
+
+@deffn Method pgg-scheme-snarf-keys-region scheme start end
+Collect public keys in the current region between @var{start} and
+@var{end}, and add them into the user's keyring.
+On success, it returns @code{t}, otherwise @code{nil}.
+@end deffn
+
+@node Getting output
+@section Getting output
+
+The output of the backend methods (@ref{Backend methods}) is stored in
+special buffers, so that these methods must tell the status of the
+execution.
+
+@defvar pgg-errors-buffer
+The standard error output of the execution of the PGP command is stored
+here.
+@end defvar
+
+@defvar pgg-output-buffer
+The standard output of the execution of the PGP command is stored here.
+@end defvar
+
+@defvar pgg-status-buffer
+The rest of status information of the execution of the PGP command is
+stored here.
+@end defvar
+
+@node Parsing OpenPGP packets
+@chapter Parsing OpenPGP packets
+
+The format of OpenPGP messages is maintained in order to publish all
+necessary information needed to develop interoperable applications.
+The standard is documented in RFC 2440.
+
+PGG has its own parser for the OpenPGP packets.
+
+@defun pgg-parse-armor string
+List the sequence of packets in @var{string}.
+@end defun
+
+@defun pgg-parse-armor-region start end
+List the sequence of packets in the current region between @var{start}
+and @var{end}.
+@end defun
+
+@defvar pgg-ignore-packet-checksum
+If non-@code{nil}, don't check the checksum of the packets.
+@end defvar
+
+@node Function Index
+@chapter Function Index
+@printindex fn
+
+@node Variable Index
+@chapter Variable Index
+@printindex vr
+
+@summarycontents
+@contents
+@bye
+
+@c End:
(latexi-translate-file "gnus-faq")
(latexi-translate-file "message" t)
(latexi-translate-file "emacs-mime" t)
- (latexi-translate-file "sieve" t))
+ (latexi-translate-file "sieve" t)
+ (latexi-translate-file "pgg" t))
(defun latexi-translate-file (file &optional as-a-chapter)
"Translate file a LaTeX file."
(progn (end-of-line) (point))))
(if (equal arg "@head")
(insert "\\gnusinteresting")))
- ((member command '("setfilename"
+ ((member command '("setfilename" "set"
"synindex" "setchapternewpage"
"summarycontents" "bye"
"top" "iftex" "cartouche"
(insert "\\\\"))
((equal command "sp")
(replace-match "" t t))
+ ((member command '("deffn" "defvar" "defun"))
+ (replace-match "" t t))
((equal command "node")
(latexi-strip-line)
(unless (string-match "Index" arg)
(insert (format "\\end{%s}\n" arg)))
((member arg '("iflatex" "iftex" "cartouche"))
(latexi-strip-line))
+ ((member arg '("deffn" "defvar" "defun"))
+ (latexi-strip-line))
(t
(error "Unknown end arg: %s" arg))))
((member command '("table"))
;; "\\begin{theindex}\\input{gnus.%s}\\end{theindex}\n" arg))
)
(t
- (error "Unknown command (line %d): %s"
+ (error "Unknown command (file %s line %d): %s"
+ file
(save-excursion
(widen)
(1+ (count-lines (point-min) (progn
(latexi-strip-line))
((member command '("ref" "xref" "pxref"))
(latexi-exchange-command (concat "gnus" command) arg))
- ((member command '("sc" "file" "dfn" "emph" "kbd" "uref"
+ ((member command '("sc" "file" "dfn" "emph" "kbd" "key" "uref"
"code" "samp" "var" "strong" "i"
"result"))
(goto-char (match-beginning 0))
(delete-char 2)
(insert "duppat{}"))
(t
- (error "Unknown command (line %d): %s"
+ (error "Unknown command (file %s line %d): %s"
+ file
(save-excursion
(widen)
(1+ (count-lines (point-min) (progn
projects / elisp / gnus.git- / commitdiff