From: yamaoka Date: Tue, 6 Aug 2002 12:41:46 +0000 (+0000) Subject: Importing Oort Gnus v0.07. X-Git-Tag: ognus-0_07~1 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=baa6433903e8c07f69141b65eb0281620c6916ef;p=elisp%2Fgnus.git- Importing Oort Gnus v0.07. --- diff --git a/GNUS-NEWS b/GNUS-NEWS index 84dfda9..2e9ba76 100644 --- a/GNUS-NEWS +++ b/GNUS-NEWS @@ -8,6 +8,16 @@ For older news, see Gnus info node "New Features". * Changes in Oort Gnus +** 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 +with `(setq gnus-agent nil)'. Note that putting (gnus-agentize) in +~/.gnus is not needed any more. + ** gnus-summary-line-format The default value changed to "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n". @@ -172,8 +182,8 @@ variables should change those regexps accordingly. For example: ("^han\\>" euc-kr) -> ("\\(^\\|:\\)han\\>" euc-kr) -** Gnus supports PGP (RFC 1991/2440), PGP-MIME (RFC 2015/3156) and -SMIME. +** Gnus supports PGP (RFC 1991/2440), PGP/MIME (RFC 2015/3156) and +S/MIME (RFC 2630-2633). ** Gnus inlines external parts (message/external). diff --git a/contrib/ChangeLog b/contrib/ChangeLog index f894e17..124ce41 100644 --- a/contrib/ChangeLog +++ b/contrib/ChangeLog @@ -1,3 +1,21 @@ +2002-06-22 Simon Josefsson + + * hashcash.el: New file. + (hashcash-default-payment, hashcash-payment-alist, hashcash): + Defcustom. + (hashcash-generate-payment): Update to recent hashcode command + line syntax. + (hashcash-insert-payment): Use X-Hashcode:. + (mail-add-payment): Also look at Newsgroups. + (top-level): Add provide and EOF comment. + (mail-add-payment): Autoload. + (hashcash-insert-payment): s/Hashcode/Hashcash/ + (mail-add-payment): Doc fix. + +2002-05-20 Lars Magne Ingebrigtsen + + * gnus-mdrtn.el (gnus-moderated-groups): Removed (require 'gnus-load). + 2002-04-24 Kai Gro,A_(Bjohann * ucs-tables.el (featurep): Barf on XEmacs. diff --git a/contrib/hashcash.el b/contrib/hashcash.el new file mode 100644 index 0000000..3c50fd7 --- /dev/null +++ b/contrib/hashcash.el @@ -0,0 +1,115 @@ +;;; hashcash.el --- Add hashcash payments to email + +;; $Revision: 1.1.1.1 $ +;; Copyright (C) 1997,2001 Paul E. Foley + +;; Maintainer: Paul Foley +;; Keywords: mail, hashcash + +;; Released under the GNU General Public License + +;;; Commentary: + +;; The hashcash binary is at http://www.cypherspace.org/hashcash/ +;; +;; Call mail-add-payment to add a hashcash payment to a mail message +;; in the current buffer. +;; +;; To automatically add payments to all outgoing mail: +;; (add-hook 'message-send-hook 'mail-add-payment) + +;;; Code: + +(defcustom hashcash-default-payment 0 + "*The default number of bits to pay to unknown users. +If this is zero, no payment header will be generated. +See `hashcash-payment-alist'." + :type 'integer) + +(defcustom hashcash-payment-alist nil + "*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" + "*The path to the hashcash binary.") + +(require 'mail-utils) + +(defun hashcash-strip-quoted-names (addr) + (setq addr (mail-strip-quoted-names addr)) + (if (and addr (string-match "^[^+@]+\\(\\+[^@]*\\)@" addr)) + (concat (subseq addr 0 (match-beginning 1)) (subseq addr (match-end 1))) + addr)) + +(defun hashcash-payment-required (addr) + "Return the hashcash payment value required for the given address." + (let ((val (assoc addr hashcash-payment-alist))) + (if val + (if (cddr val) + (caddr val) + (cadr val)) + hashcash-default-payment))) + +(defun hashcash-payment-to (addr) + "Return the string with which hashcash payments should collide." + (let ((val (assoc addr hashcash-payment-alist))) + (if val + (if (cddr val) + (cadr val) + (car val)) + addr))) + +(defun hashcash-generate-payment (str val) + "Generate a hashcash payment by finding a VAL-bit collison on STR." + (if (> val 0) + (save-excursion + (set-buffer (get-buffer-create " *hashcash*")) + (erase-buffer) + (call-process hashcash nil t nil (concat "-b " (number-to-string val)) + str) + (goto-char (point-min)) + (buffer-substring (point-at-bol) (point-at-eol))) + nil)) + +(defun hashcash-insert-payment (arg) + "Insert an X-Hashcash header 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-Hashcash: " pay "\n")))) + +;;;###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." + (interactive "P") + (let ((hashcash-default-payment (if arg (prefix-numeric-value arg) + hashcash-default-payment)) + (addrlist nil)) + (save-excursion + (save-restriction + (goto-char (point-min)) + (search-forward mail-header-separator) + (beginning-of-line) + (narrow-to-region (point-min) (point)) + (let ((to (hashcash-strip-quoted-names (mail-fetch-field "To" nil t))) + (cc (hashcash-strip-quoted-names (mail-fetch-field "Cc" nil t))) + (ng (hashcash-strip-quoted-names + (mail-fetch-field "Newsgroups" nil t)))) + (when to + (setq addrlist (split-string to ",[ \t\n]*"))) + (when cc + (setq addrlist (nconc addrlist (split-string cc ",[ \t\n]*")))) + (when ng + (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*"))))) + (when addrlist + (mapc #'hashcash-insert-payment addrlist))))) + t) + +(provide 'hashcash) + +;;; hashcash.el ends here diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b021fd9..ec6c07f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,8 +1,541 @@ +2002-08-04 01:48:57 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.07 is released. + +2002-08-04 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-thread-sort-functions): Doc fix. + (gnus-article-sort-functions): Doc fix. + (t): New keystroke. + (gnus-article-sort-by-random): New function. + (gnus-thread-sort-by-random): New function. + +2002-08-02 Simon Josefsson + + * gnus-logic.el (gnus-advanced-integer): Swap arguments in + funcall. From Scott A Crosby . + +2002-07-31 Danny Siu + + * nnimap.el (nnimap-split-articles): do not call nnmail-fetch-field + when splitting malformed messages without message-id + +2002-07-28 Kai Gro,b_(Bjohann + From Niklas Morberg . + + * nnweb.el (nnweb-type, nnweb-type-definition) + (nnweb-gmane-create-mapping, nnweb-gmane-wash-article) + (nnweb-gmane-search, nnweb-gmane-identity): Added gmane + functionality. + * nnweb.el: Removed old non-functioning search engines. + +2002-07-27 Simon Josefsson + + * message.el (message-forward-make-body): Don't use + `message-forward-ignored-headers' when doing a "raw" followup (it + is important to preserve e.g. CTE). + + * flow-fill.el (fill-flowed): Disable filladapt-mode. + + * gnus-sieve.el (gnus-sieve-guess-rule-for-article): Don't + regexp-quote, Cyrus Sieve is fixed. + + * sieve-manage.el (sieve-manage-deletescript): New function. + + * sieve.el (sieve-manage-mode-map): Fix down-mouse-2 and down-mouse-3. + (sieve-manage-mode): Fix menubar. + (sieve-activate): Change some messages. + (sieve-deactivate-all): New function. + (sieve-deactivate): New alias. + (sieve-remove): New function. + (sieve-help): Fix help. + All suggested by Ned Ludd. + +2002-07-24 Katsumi Yamaoka + + * mm-decode.el (mm-inline-text-html-with-images): Doc fix. + (mm-w3m-safe-url-regexp): New user option. + + * mm-view.el (mm-inline-text-html-render-with-w3m): Use + `mm-w3m-safe-url-regexp' to bind `w3m-safe-url-regexp'. + +2002-07-23 Karl Kleinpaste + + * gnus-sum.el (gnus-summary-delete-article): Force + nnmail-expiry-target to 'delete, so that absolute deletion + happens when absolute deletion is requested. + +2002-07-21 Kai Gro,b_(Bjohann + From Nevin Kapur . + + * nnmail.el (nnmail-fancy-expiry-target): Treat nonexisting + headers as empty headers. + +2002-07-21 Kai Gro,b_(Bjohann + From Jochen Hein . + + * gnus-art.el (gnus-emphasis-alist): Add strikethrough and + correct typo. + (gnus-emphasis-strikethru): New face. + +2002-07-20 Kai Gro,b_(Bjohann + From Jason Merrill . + + * nnfolder.el (nnfolder-retrieve-headers): Avoid searching the + entire file for each of a sequence of missing articles. + + * gnus-salt.el (gnus-binary-display-article): Respect an existing + value for gnus-view-pseudos. + + * gnus-sum.el (gnus-summary-insert-new-articles): Count down to + avoid nreverse. + +2002-07-14 Kai Gro,b_(Bjohann + From Ted Zlatanov . + + * gnus-sum.el (gnus-auto-expirable-marks): Remove `spam'. + (gnus-summary-mode-line-format-alist): Add %h for number of + spams. + (gnus-newsgroup-spam-marked): New variable. + (gnus-summary-local-variables): Add gnus-newsgroup-spam-marked. + (gnus-article-read-p, gnus-article-mark) + (gnus-set-global-variables, gnus-set-global-variables) + (gnus-article-marked-p, gnus-summary-mark-article-as-read) + (gnus-summary-mark-article-as-unread) + (gnus-summary-mark-article-as-unread, gnus-summary-mark-article) + (gnus-mark-article-as-read, gnus-mark-article-as-unread) + (gnus-mark-article-as-unread, gnus-summary-catchup): Grok spam. + +2002-07-10 Simon Josefsson + + * nnimap.el (nnimap-split-to-groups): Allow group string to be a + function. From KANEMATSU Daiji . + +2002-07-09 Nevin Kapur + + * gnus-sum.el (gnus-summary-delete-article): Respect group + parameters while expiring. + +2002-07-08 Simon Josefsson + + * gnus-art.el (article-make-date-line): Fix string. From Henrik + Enberg. + +2002-07-08 Kai Gro,b_(Bjohann + + * gnus-art.el (article-unsplit-urls): Only display MIME when this + function is called interactively. From Niklas Morberg. + +2002-07-06 ShengHuo ZHU + + * gnus-topic.el (gnus-topic-indent, gnus-topic-unindent): Change + cdaar to cdar and car. + + * nnsoup.el (nnsoup-retrieve-headers, nnsoup-request-type) + (nnsoup-read-active-file, nnsoup-article-to-area): Ditto. + +2002-07-05 Katsumi Yamaoka + + * gnus-sum.el (gnus-summary-toggle-header): Show headers anyway; + don't break a narrowed article. + + * nntp.el (nntp-via-rlogin-command-switches): Doc fix. + (nntp-open-via-rlogin-and-telnet): Ditto. + +2002-07-02 Didier Verna + + * nnmail.el (nnmail-split-methods): fix custom type. + +2002-07-02 Kai Gro,b_(Bjohann + + * gnus-art.el (article-unsplit-urls): Keep URL buttonized after + unsplitting. From Niklas Morberg . + +2002-07-01 Kai Gro,b_(Bjohann + + * gnus-msg.el (gnus-summary-resend-default-address): New user option. + (gnus-summary-resend-message): Use it. + +2002-06-28 Katsumi Yamaoka + + * nntp.el (nntp-via-rlogin-command-switches): New variable. + (nntp-open-via-rlogin-and-telnet): Re-revert; use the var above. + +2002-06-28 Kai Gro,b_(Bjohann + + * message.el (message-font-lock-keywords): Don't fontify + headers in the message body, only in the header. + (message-font-lock-make-header-matcher): New function, used by + message-font-lock-keywords. + From Katsumi Yamaoka . + +2002-06-28 Katsumi Yamaoka + + * nntp.el (nntp-open-via-rlogin-and-telnet): Revert last change. + +2002-06-28 Katsumi Yamaoka + + * nntp.el (nntp-open-via-rlogin-and-telnet): Hide commandline args. + +2002-06-26 Kai Gro,b_(Bjohann + + * message.el (message-font-lock-keywords): Revert 2002-06-22 + change. + +2002-06-24 Kai Gro,b_(Bjohann + + * message.el (message-font-lock-keywords): Put colon in header + name match. + +2002-06-22 Kai Gro,b_(Bjohann + + * message.el (message-font-lock-keywords): Don't use header faces + in the body. Thanks to Stefan Monnier for the hint on the + implementation. + +2002-05-09 Miles Bader + + * gnus-cite.el (gnus-cite-blank-line-after-header): New variable. + (gnus-article-hide-citation): Respect it. + +2002-04-12 Juanma Barranquero + + * pop3.el (pop3-open-server): Fix typo. + +2002-06-18 Josh Huber + + * gnus.el (gnus-find-subscribed-addresses): Use add-to-list + instead of push to ignore duplicate to-(list|address) values. + * nnmail.el (nnmail-cache-ignore-groups): New. + * nnmail.el (nnmail-cache-insert): Obey nnmail-cache-ignore-groups + +2002-06-18 Kai Gro,b_(Bjohann + + * gnus-delay.el (gnus-delay-send-queue): Delete the delay header + before sending. Suggested by Jan Rychter. + +2002-06-18 Katsumi Yamaoka + + * dgnushack.el (remove): New compiler macro. + (last, coerce, subseq): Remove compiler macros for those built-in + or unused functions. + +2002-06-17 Kai Gro,b_(Bjohann + + * gnus-start.el (gnus-clear-system, gnus-read-newsrc-file): Make + sure to write byte-compiled versions of gnus-*-format-alist to + .newsrc.eld. From Simon Josefsson. + +2002-06-16 Kai Gro,b_(Bjohann + + * gnus-agent.el (gnus-agent-read-servers) + (gnus-agent-write-servers): Put server name (string like + "nnchoke:frumple") in the file instead of a server specification + (Lisp expression like (nnchoke "frumple" ...parameters...)). + From Bj,Ax(Brn Mork . + +2002-06-16 Simon Josefsson + + * gnus-cache.el (gnus-cache-remove-article): n is &optional. From + Reiner Steib <4uce.02.r.steib@gmx.net>. + +2002-06-15 ShengHuo ZHU + + * nnheader.el (nnheader-file-name-translation-alist): Set the + default value for MS Windows systems. + + * gnus-ems.el (nnheader-file-name-translation-alist): Removed. + +2002-06-14 Katsumi Yamaoka + + * message.el (message-beginning-of-line): Keep the region active + in XEmacs. Suggested by TAKAHASHI Kaoru . + +2002-06-13 Josh Huber + + * gnus-msg.el (gnus-summary-followup): Use g-s-handle-replysign. + * gnus-msg.el (gnus-summary-reply): Ditto. + * gnus-msg.el (gnus-summary-handle-replysign): New. + +2002-06-12 Katsumi Yamaoka + + * message.el (message-send-mail-with-sendmail): Kill errbuf even + if sending failed. + +2002-06-11 Josh Huber + + * gnus-start.el (gnus-dribble-enter): Don't call set-window-point anymore + * mml2015.el (mml2015-mailcrypt-encrypt): Accept optional argument + to sign while encrypting. + +2002-06-11 Simon Josefsson + + * gnus-int.el (gnus-request-move-article): Agent expire article if + successfuly moved. + + * nnweb.el (nnweb-google-create-mapping): Honors the value of + nnweb-max-hits. From Niklas Morberg . + +2002-06-10 Simon Josefsson + + * gnus-int.el (gnus-request-expire-articles): Fix last change? + +2002-06-09 Simon Josefsson + + * gnus-sum.el (gnus-summary-delete-article): Don't agent expire here. + + * gnus-int.el (gnus-request-expire-articles): Do it here instead. + +2002-06-08 ShengHuo ZHU + + * flow-fill.el (fill-flowed): Ignore errors. + +2002-06-06 Simon Josefsson + + * message.el (message-send-mail-with-sendmail): Improve error message. + +2002-06-06 Kai Gro,b_(Bjohann + + * message.el (message-interactive): Change default from nil to t. + Better to be safe than to be fast. + +2002-06-05 Kai Gro,b_(Bjohann + + * message.el (message-send-mail-with-sendmail): Check return value + from call-process-region. + +2002-06-04 Simon Josefsson + + * gnus-msg.el (gnus-group-mail, gnus-group-news) + (gnus-group-post-news, gnus-summary-mail-other-window) + (gnus-summary-news-other-window, gnus-summary-post-news): Bind + gnus-article-copy to nil, thereby inhibiting the `header' posting + style match to use data from last viewed article. + Suggested by Hrvoje Niksic. + +2002-06-04 Katsumi Yamaoka + + * spam.el (spam-point-at-eol): New alias. + (spam-parse-whitelist): Use it. + +2002-06-03 Simon Josefsson + + * nnmail.el (nnmail-mail-splitting-decodes): New variable. + (nnmail-article-group): Use it. + +2002-05-30 Kai Gro,b_(Bjohann + + * gnus-msg.el (gnus-inews-yank-articles): Merge split header lines + so that code reading them won't be surprised. From Jesper Harder + . + +2002-05-29 Simon Josefsson + + * gnus-sum.el (gnus-summary-delete-article): Agent expire deleted + articles. + + * gnus.el (gnus-agent-cache): Doc fix. + (gnus-agent): Change default to t. + + * gnus-agent.el (gnus-agent-expire): Make it accept optional + ARTICLES, GROUP and FORCE parameters. + +2002-05-28 Simon Josefsson + + * gnus-group.el (gnus-group-line-format): Doc fix. + +2002-05-28 Kai Gro,b_(Bjohann + + * gnus-msg.el (gnus-inews-yank-articles): Unfold headers of + original article before yanking. From Jesper Harder + . + +2002-05-26 Simon Josefsson + + * gnus-sum.el (gnus-summary-menu-split): New function. + (gnus-summary-make-menu-bar): Split charset submenu. + (gnus-summary-menu-maxlen): New variable. + (gnus-summary-menu-split): Use it. + +2002-05-25 Simon Josefsson + + * mml.el (mml-preview): Generate some headers. + + * gnus.el (gnus-large-newsgroup): Fix :type. + + * nnimap.el (nnimap-nov-is-evil): Change default to t (because the + Agent cache NOV's by default now). + (nnimap-nov-is-evil): Make it default to `gnus-agent' instead. + +2002-05-18 Jesper Harder + + * gnus-sum.el (gnus-dependencies-add-header): Avoid one unecessary + call to gnus-parent-id when we check for References loops. + (gnus-summary-prepare-threads): Avoid simplifying every Subject + twice by saving the simplified subject string in simp-subject. + +2002-05-23 Simon Josefsson + + * gnus-msg.el (gnus-confirm-mail-reply-to-news): Typo. Trivial + change from Benjamin Rutt . + + * nnweb.el (nnweb-type): Remove dejanewsold. Trivial change from + Niklas Morberg . + +2002-05-22 Simon Josefsson + + * sieve.el (sieve-change-region): Define it before it is used. + + * gnus-msg.el (gnus-confirm-mail-reply-to-news) + (gnus-summary-reply): Ask for confirmation when replying to news. + Defaults to not ask. From Benjamin Rutt + . + + * nnimap.el (nnimap-nov-is-evil): Improve doc. + +2002-05-21 Simon Josefsson + + * sieve-mode.el (sieve-manage): Fix autoloads. + + * sieve-manage.el (sieve-manage-cram-md5-auth): Just send the SASL + name (makes it work with recent Cyrus timsieved). + +2002-05-20 Jason + + * gnus-art.el (gnus-request-article-this-buffer): Try + reconnecting if you don't get the message. + +2002-05-20 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-enter-digest-group): Only get + Reply-To headers from the headers. + +2002-05-18 Lars Magne Ingebrigtsen + + * mm-url.el (mm-url-insert): Remove junk message. + +2002-05-17 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-request-list): Parse new html. + (nnslashdot-use-front-page): New variable. + (nnslashdot-request-list): Use it. + + * mm-url.el (mm-url-timeout): New variable. + (mm-url-retries): Ditto. + (mm-url-insert): Use it. + +2002-05-16 Simon Josefsson + + * gnus-sum.el (gnus-simplify-all-whitespace): New function. + (gnus-simplify-subject-functions): Mention g-s-a-w. + +2002-05-15 Josh Huber + + * nnbabyl.el (nnbabyl-request-accept-article): Pass group to + nnmail-cache-insert. + * nndiary.el (nndiary-request-accept-article): Ditto. + * nnfolder.el (nnfolder-request-accept-article): Ditto. + * nnimap.el (nnimap-request-accept-article): Ditto. + * nnmail.el (nnmail-process-unix-mail-format): Ditto. + * nnmail.el (nnmail-check-duplication): Ditto. (from gnus-art) + * nnmbox.el (nnmbox-request-accept-article): Ditto. + * nnmh.el (nnmh-request-accept-article): Ditto. + * nnmail.el (nnmail-cache-insert): Change group to required, + removed code which tried to figure out the group. + +2002-05-13 Josh Huber + + * mml.el (mml-generate-mime-1): Fix mml generation for signed only + messages. From Hans de Graaff . + * nnml.el (nnml-request-accept-article): Pass in the group name to + nnmail-cache-insert, since it's available. + +2002-05-10 ShengHuo ZHU + + * nndoc.el (nndoc-mime-digest-type-p): Set proper file-end. + +2002-05-08 Kai Gro,b_(Bjohann + From Florian Weimer . + + * gnus.el (subscribed): New group parameter. + (gnus-find-subscribed-addresses): Use it. + +2002-05-08 Josh Huber + + * mml-sec.el (mml-signencrypt-style-alist): Rename. Also, changed + the default for pgpmime to support pgp v2. + * mml-sec.el (mml-signencrypt-style): New accessor function to + allow users to get/set the signencrypt style more easily without + frobbing the alist directly. + * mml.el (mml-generate-mime-1): Use accessor function. + +2002-05-08 Kai Gro,b_(Bjohann + + * gnus-art.el (gnus-article-mode-syntax-table): Specify matching + parenthesis for "<" and ">". Suggested by Andreas Schwab + . + +2002-05-07 Kai Gro,b_(Bjohann + + * nnmail.el (nnmail-cache-insert): Prefer group-art over group + when intuiting the group the message is written to. From Josh + Huber . + +2002-05-06 Simon Josefsson + + * gnus-topic.el (gnus-group-topic-parameters): Work when group + buffer doesn't show group. From Matt Armstrong . + +2002-05-06 Josh Huber + + * mml2015.el (mml2015-gpg-encrypt): Changed name of optional + argument, and fixed compiler warning. (added autoload for + gpg-encrypt). + +2002-05-04 Simon Josefsson + + * mml1991.el (mml1991-function-alist): Doc fix. + + * mml.el (mml-preview): Bind gnus-newsrc-hashtb temporarily if it + doesn't exist (for previewing messages without having Gnus + started). + + * mm-util.el (mm-coding-system-priorities): Defcustom. + + * mm-encode.el (mm-content-transfer-encoding-defaults): Defcustom. + +2002-05-01 Josh Huber + + * gnus-msg.el (gnus-message-replysignencrypted): enabled by + default. + * mml-sec.el: + * mml-sec.el (mml-signencrypt-style): New. + * mml-sec.el (mml-pgpmime-encrypt-buffer): Accept optional + argument `sign'. + * mml-sec.el (mml-secure-message-encrypt-pgp): Changed default to + signencrypt. + * mml-sec.el (mml-secure-message-encrypt-pgpmime): Ditto. + * mml.el (mml-generate-mime-1): Changed logic so a part which is + both signed & encryped is processed in one operation. (rather than + two separate ops: sign, then encrypt) + * mml2015.el (mml2015-gpg-extract-signature-details): Give some + indication if a message is signed by an expired key. + * mml2015.el (mml2015-gpg-encrypt): Accept optional argument which + enables combined sign & encrypt operation. (this was always on + before). + * mml2015.el (mml2015-encrypt): Accept optional argument `sign'. + +2002-05-01 Simon Josefsson + + * nnimap.el (nnimap-retrieve-groups): Use separate data for each + server. + (nnimap-mailbox-info): defvar instead of defvoo. + 2002-05-01 20:09:21 Lars Magne Ingebrigtsen * gnus.el: Oort Gnus v0.06 is released. -2002-05-01 Lars Magne Ingebrigtsen <> +2002-05-01 Lars Magne Ingebrigtsen * lpath.el: Bind url-package-version. @@ -72,12 +605,12 @@ Trivial change from Karl Pfl,Ad(Bsterer . 2002-04-27 Katsumi Yamaoka - + * dns.el (dns-make-network-process): New macro. (query-dns): Use it. 2002-04-27 ShengHuo ZHU - + * gnus-msg.el (gnus-summary-reply): Remove unbound variable article-buffer. @@ -103,12 +636,12 @@ problems. (nnkiboze-generate-group): Set newsrc to the *highest* article number kibozed, not the lowest. - + 2002-04-15 Jesper Harder * gnus-art.el (article-unsplit-urls): Allow trailing SPC. -2002-04-24 Kai Gro,A_(Bjohann +2002-04-24 Kai Gro,b_(Bjohann From Dan Christensen . * nndoc.el (nndoc-type-alist, nndoc-lanl-gov-announce-type-p) @@ -119,7 +652,7 @@ headers for message which are missing these headers. Get rid of spurious \\ lines (purely cosmetic). Extend body-end and file-end regexps, to exclude more garbage from the message. - Make URL rephrasing regexp more flexible, to match current + Make URL rephrasing regexp more flexible, to match current format. 2002-04-23 Simon Josefsson @@ -131,7 +664,7 @@ (gnus-netrc-get, gnus-netrc-machine, gnus-parse-netrc): Aliased to new code in netrc.el. -2002-04-23 Kai Gro,A_(Bjohann +2002-04-23 Kai Gro,b_(Bjohann * gnus-msg.el (gnus-summary-resend-message-edit): Remove message-ignored-resent-headers, too. From Matthieu Moy @@ -200,7 +733,7 @@ * message.el (message-gen-unsubscribed-mft): accept a prefix argument so CC can be included with C-u C-c C-f C-a -2002-04-17 Kai Gro,A_(Bjohann +2002-04-17 Kai Gro,b_(Bjohann From Ted Zlatanov . * spam.el (spam-whitelist, spam-blacklist, spam-enter-whitelist): @@ -353,7 +886,7 @@ * gnus.el (gnus-summary-line-format): Fixing links to Info. Trivial change from Bj,Av(Brn Torkelsson . -2002-03-29 Kai Gro,A_(Bjohann +2002-03-29 Kai Gro,b_(Bjohann * gnus-sum.el (gnus-summary-move-article) (gnus-summary-copy-article): Mention `gnus-move-split-methods' in @@ -387,7 +920,7 @@ (nnmaildir--edit-prep): New function. (Local Variables): Use it. -2002-03-26 Pavel@Janik.cz (Pavel Jan,Bm(Bk) +2002-03-26 Pavel@Janik.cz (Pavel Jan,Am(Bk) * gnus-sum.el (gnus-summary-make-menu-bar): Fix typo. @@ -437,7 +970,7 @@ tags. * gnus-sum.el (gnus-print-buffer): Remove gnus-decoration. - Trivial change from lorentey@elte.hu (L,Bu(Brentey K,Ba(Broly) + Trivial change from lorentey@elte.hu (L,Bu(Brentey K,Aa(Broly) 2002-03-20 Katsumi Yamaoka @@ -453,7 +986,7 @@ * gnus-group.el (gnus-group-process-prefix): Make sure there is a mark. -2002-03-19 Kai Gro,A_(Bjohann +2002-03-19 Kai Gro,b_(Bjohann * gnus-sum.el (gnus-sum-thread-tree-root) (gnus-sum-thread-tree-single-indent) @@ -470,10 +1003,10 @@ 2002-03-13 Simon Josefsson * pop3.el (pop3-open-server): Revert multibyte change. From - Pavel@Janik.cz (Pavel Jan,Bm(Bk). + Pavel@Janik.cz (Pavel Jan,Am(Bk). * message.el (message-send-mail-with-qmail): Make it work. From - Pavel@Janik.cz (Pavel Jan,Bm(Bk). + Pavel@Janik.cz (Pavel Jan,Am(Bk). 2002-03-13 Josh Huber @@ -1080,7 +1613,7 @@ (gnus-article-reply-with-original): Ditto. * binhex.el (binhex-decoder-switches): Fix doc. From - Pavel@Janik.cz (Pavel Jan,Bm(Bk). + Pavel@Janik.cz (Pavel Jan,Am(Bk). 2002-02-04 ShengHuo ZHU @@ -1947,7 +2480,7 @@ * flow-fill.el (fill-flowed-display-column) (fill-flowed-encode-columnq): New variables. Suggested by - Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro,A_(Bjohann). + Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro,b_(Bjohann). (fill-flowed-encode, fill-flowed): Use them. * message.el (message-send-news, message-send-mail): Use @@ -2403,7 +2936,7 @@ * gnus-agent.el (gnus-agent-fetch-session): Run hook. -2002-01-03 Kai Gro,A_(Bjohann +2002-01-03 Kai Gro,b_(Bjohann * gnus-start.el (gnus-read-init-file): Don't force coding system for ~/.gnus. From Dave Love . @@ -2512,7 +3045,7 @@ (gnus-picon-transform-address): Insert spec backward, due to the incompatibility of gnus-xmas-put-image. -2002-01-02 Pavel Jan,Bm(Bk +2002-01-02 Pavel Jan,Am(Bk * gnus-fun.el (gnus-convert-pbm-to-x-face-command): Doc fix. @@ -3049,7 +3582,7 @@ * gnus-art.el, gnus-picon.el, gnus-sieve.el, gnus-sum.el: * gnus-xmas.el, imap.el, mailcap.el, mm-util.el, nnfolder.el: * nnheader.el, nnmail.el: Nil/NIL vs. nil. - From Pavel Jan,Bm(Bk + From Pavel Jan,Am(Bk 2001-12-20 15:00:00 ShengHuo ZHU @@ -3154,7 +3687,7 @@ * mm-url.el (executable-find): autoload. -2001-12-12 Pavel Jan,Bm(Bk +2001-12-12 Pavel Jan,Am(Bk * gnus-mlspl.el (gnus-group-split-fancy): Doc fix (add reference to variable, follow doc-string conventions). @@ -3364,7 +3897,7 @@ * message.el (message-tab-body-function): Set to nil. (message-tab): Use text-mode-map or global-map. - Suggested by Kai Gro,A_(Bjohann . + Suggested by Kai Gro,b_(Bjohann . 2001-11-30 Simon Josefsson @@ -3378,7 +3911,7 @@ * gnus-agent.el (gnus-agent-write-active): Make sure sym is a cons of integers. -2001-11-29 Kai Gro,A_(Bjohann +2001-11-29 Kai Gro,b_(Bjohann * message.el (message-newgroups-header-regexp) (message-completion-alist, message-tab-body-function): Use @@ -3461,7 +3994,7 @@ (gnus-summary-limit-to-extra): Ditto. (gnus-summary-find-matching): Support not-matching argument. -2001-11-25 Kai Gro,A_(Bjohann +2001-11-25 Kai Gro,b_(Bjohann * message.el (message-wash-subject): Use `insert' rather than `insert-string', which is deprecated. @@ -3633,10 +4166,10 @@ 2001-11-09 Simon Josefsson - * gnus.el (gnus-local-domain): Fix doc. From Pavel Jan,Bm(Bk + * gnus.el (gnus-local-domain): Fix doc. From Pavel Jan,Am(Bk . -2001-11-09 Kai Gro,A_(Bjohann +2001-11-09 Kai Gro,b_(Bjohann * message.el (message-point-in-header-p): New function. (message-do-auto-fill): Use it. @@ -3979,7 +4512,7 @@ (nnweb-type-definition): Add google as alias of dejanews. (nnweb-google-parse-1): Forward 1 line. -2001-10-26 Kai Gro,A_(Bjohann +2001-10-26 Kai Gro,b_(Bjohann * gnus-msg.el (gnus-summary-mail-forward): Doc fix: add pointer to variable `message-forward-ignored-headers'. @@ -4015,7 +4548,7 @@ * gnus-msg.el (gnus-extended-version): Include system-configuration. - Suggested by Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro,A_(Bjohann). + Suggested by Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro,b_(Bjohann). 2001-10-22 Per Abrahamsen @@ -4035,7 +4568,7 @@ (nnimap-split-inbox, nnimap-expunge-search-string) (nnimap-importantize-dormant): Remove "*" from doc. -2001-10-20 Kai Gro,A_(Bjohann +2001-10-20 Kai Gro,b_(Bjohann * gnus-sum.el (gnus-summary-limit-to-score): Prompt for score if not supplied via prefix arg. From Lisp, make arg mandatory. @@ -4046,7 +4579,7 @@ * message.el (message-do-auto-fill): Avoid calling 'rfc822-goto-eoh'. -2001-10-20 Kai Gro,A_(Bjohann +2001-10-20 Kai Gro,b_(Bjohann From Paul Jarc . * message.el (message-get-reply-headers): Restructure the logic @@ -4139,7 +4672,7 @@ * gnus-msg.el (gnus-post-method): Changed two instances of `active' to `current' and one `null' to `not'. -2001-10-16 Kai Gro,A_(Bjohann +2001-10-16 Kai Gro,b_(Bjohann From Katsumi Yamaoka . * message.el (message-setup-fill-variables): Use @@ -4151,7 +4684,7 @@ (mml2015-gpg-decrypt-1): Decanonicalize decrypted MIME body. (Mailcrypt seem to do this, but gpg.el doesn't.) -2001-10-16 Kai Gro,A_(Bjohann +2001-10-16 Kai Gro,b_(Bjohann Patch by Oliver Scholz . * gnus-draft.el (gnus-draft-edit-message): Add text property @@ -4206,7 +4739,7 @@ * message.el (message-do-auto-fill): Use gnus-point-at-bol. (autoload): Add some autoloads. -2001-10-12 Kai Gro,A_(Bjohann +2001-10-12 Kai Gro,b_(Bjohann Suggested by Oliver Scholz . * message.el (message-do-auto-fill): New function. Like @@ -4358,7 +4891,7 @@ * gnus-sum.el (gnus-summary-extract-address-component): New function. (gnus-summary-from-or-to-or-newsgroups): Optimize. -2001-09-29 Kai Gro,A_(Bjohann +2001-09-29 Kai Gro,b_(Bjohann * message.el (message-mode-map): Keybinding for `gnus-delay-article'. (message-mode-menu): Menu item for same. @@ -4465,7 +4998,7 @@ * gnus-group.el (gnus-group-catchup): Update expire marks in backend. Also, if ALL also set expire marks on tick/dormant. -2001-09-20 Kai Gro,A_(Bjohann +2001-09-20 Kai Gro,b_(Bjohann * message.el (message-tab-body-function): New variable. * message.el (message-tab): Use it. @@ -4538,7 +5071,7 @@ * gnus-draft.el (gnus-draft-setup): Don't set mark when there isn't an article to set it on (e.g. when you `a' in a group). -2001-09-12 Pavel Jan,Bm(Bk +2001-09-12 Pavel Jan,Am(Bk * mm-util.el (mm-charset-synonym-alist): add windows-1250 so we can read e-mails from Microsoft Outlook users not using ISO @@ -4676,7 +5209,7 @@ * gnus-sum.el (gnus-summary-insert-line): Insert forwarded, recent and unseen marks. -2001-09-05 Kai Gro,A_(Bjohann +2001-09-05 Kai Gro,b_(Bjohann * nnmail.el (nnmail-split-fancy): Document `junk'. @@ -4957,7 +5490,7 @@ * gnus-spec.el (gnus-correct-substring): Stopped one character before we wanted. -2001-08-19 Pavel Jan,Bm(Bk +2001-08-19 Pavel Jan,Am(Bk * earcon.el (earcon-auto-play): Remove unused option. @@ -5172,18 +5705,18 @@ * gnus-srvr.el (gnus-server-browse-in-group-buffer): Default to nil. -2001-08-15 Kai Gro,A_(Bjohann +2001-08-15 Kai Gro,b_(Bjohann * gnus-delay.el (gnus-delay-article): Allow "01:23" time spec, which specifies a time today or tomorrow. 2001-08-15 Simon Josefsson - From Pavel@Janik.cz (Pavel Jan,Bm(Bk) + From Pavel@Janik.cz (Pavel Jan,Am(Bk) * gnus-agent.el (gnus-agent-make-mode-line-string) (gnus-agent-toggle-plugged): Use new API. -2001-08-14 Kai Gro,A_(Bjohann +2001-08-14 Kai Gro,b_(Bjohann * gnus-delay.el (gnus-delay-send-drafts): Fix check whether deadline has expired. @@ -5224,7 +5757,7 @@ * gnus-spec.el (gnus-format-specs): %n is 23 chars. 2001-08-11 09:40:00 Karl Kleinpaste - Committed by Kai Gro,A_(Bjohann. + Committed by Kai Gro,b_(Bjohann. * gnus-score.el (gnus-score-string): Fix `match' regexp for `extra' header case. @@ -5243,7 +5776,7 @@ (nndoc-oe-dbx-dissection): New function. (nndoc-oe-dbx-generate-article): New function. -2001-08-11 Kai Gro,A_(Bjohann +2001-08-11 Kai Gro,b_(Bjohann * gnus-delay.el (gnus-delay-send-drafts): Cleaner way to check whether deadline has been reached. Patch from Dan Nicolaescu @@ -5384,7 +5917,7 @@ before remove. (gnus-mime-security-show-details): Ditto. -2001-08-04 Kai Gro,A_(Bjohann +2001-08-04 Kai Gro,b_(Bjohann * nnmail.el (nnmail-split-fancy-with-parent): Correct `mapconcat' syntax. Protect string-match against nil string and regexp. @@ -5471,7 +6004,7 @@ * gnus-msg.el (gnus-post-method): Refer to `gnus-parameters'. 2001-07-31 17:00:00 ShengHuo ZHU - Originally from Pavel Jan,Bm(Bk + Originally from Pavel Jan,Am(Bk * gnus-agent.el (gnus-agent-make-mode-line-string): New function. (gnus-agent-toggle-plugged): Use it. @@ -5483,7 +6016,7 @@ (gnus-read-newsrc-el-file, gnus-save-newsrc-file) (gnus-slave-save-newsrc): Use it. -2001-07-31 Kai Gro,A_(Bjohann +2001-07-31 Kai Gro,b_(Bjohann * gnus-delay.el (gnus-delay-initialize): Use standard define-key syntax. @@ -5579,7 +6112,7 @@ calls widen. Thanks to Christoph Conrad . -2001-07-29 Kai Gro,A_(Bjohann +2001-07-29 Kai Gro,b_(Bjohann * gnus.el (gnus-summary-line-format): Mention `gnus-sum-thread-*' for %B spec. @@ -5671,7 +6204,7 @@ * nnheader.el (nnheader-translate-file-chars): cygwin32 is running in M$Windows too. -2001-07-26 Kai Gro,A_(Bjohann +2001-07-26 Kai Gro,b_(Bjohann * gnus-delay.el (gnus-delay-send-drafts): Don't `error'. @@ -5754,7 +6287,7 @@ * mm-decode.el (mm-remove-part): Don't murder the current window (nil). (mm-display-external): Use display-term configure. -2001-07-24 Kai Gro,A_(Bjohann +2001-07-24 Kai Gro,b_(Bjohann * gnus-delay.el (gnus-delay-default-hour): New variable. (gnus-delay-article): Allow specific date in YYYY-MM-DD format. @@ -5789,7 +6322,7 @@ `gnus-check-bogus-newsgroups' just after the native server is opened. -2001-07-23 Kai Gro,A_(Bjohann +2001-07-23 Kai Gro,b_(Bjohann * nnmail.el (nnmail-do-request-post): Util function to be used by `nnchoke-request-post' for all nnmail-derived backends. @@ -5807,7 +6340,7 @@ * gnus-msg.el (gnus-setup-message): make-local-hook. -2001-07-22 Kai Gro,A_(Bjohann +2001-07-22 Kai Gro,b_(Bjohann * gnus-delay.el (gnus-delay-article): Fix `read-string' for XEmacs. Allow more units. Submitted by Karl Kleinpaste @@ -5817,7 +6350,7 @@ whether the groups exist, check the right server based on `gnus-post-method'. -2001-07-21 Kai Gro,A_(Bjohann +2001-07-21 Kai Gro,b_(Bjohann * gnus-delay.el: New file. @@ -5832,7 +6365,7 @@ (article-de-base64-unreadable, article-wash-html): (gnus-mime-inline-part, gnus-mime-view-part-as-charset): Ditto. -2001-07-21 Kai Gro,A_(Bjohann +2001-07-21 Kai Gro,b_(Bjohann * nnml.el (nnml-request-post): New function. Can be used for annotations in nnml groups. @@ -5899,12 +6432,12 @@ * gnus-art.el (gnus-article-edit-mode): Use define-derived-mode. -2001-07-16 Kai Gro,A_(Bjohann +2001-07-16 Kai Gro,b_(Bjohann * message.el (message-citation-line-function): Refer to gnus-cite-attribution-suffix. -2001-07-15 Pavel Jan,Bm(Bk +2001-07-15 Pavel Jan,Am(Bk * gnus-art.el,...: Error convention changes. @@ -5921,7 +6454,7 @@ * gnus-setup.el (gnus-use-installed-gnus): Typo. * Cleanup files. - From Pavel@Janik.cz (Pavel Jan,Bm(Bk). + From Pavel@Janik.cz (Pavel Jan,Am(Bk). 2001-07-13 08:00:00 ShengHuo ZHU @@ -5989,7 +6522,7 @@ * gnus-draft.el (gnus-draft-edit-message): Remove Date here. (gnus-draft-setup): Remove backlog. -2001-07-10 Pavel Jan,Bm(Bk +2001-07-10 Pavel Jan,Am(Bk * gnus-logic.el, gnus-srvr.el, gnus-vm.el, nnheaderxm.el, nnoo.el: Cleanup. @@ -6403,7 +6936,7 @@ * gnus-sum.el (gnus-summary-catchup): New argument. (gnus-summary-catchup-from-here): New function. -2001-05-30 Kai Gro,A_(Bjohann +2001-05-30 Kai Gro,b_(Bjohann * mm-view.el (mm-inline-image-xemacs): Insert newline, then move back, then insert glyph. (Before, the glyph was inserted first, @@ -6411,7 +6944,7 @@ it is not possible to insert a character after a glyph which is at the end of a buffer. Patch by Lloyd Zusman . -2001-05-28 Kai Gro,A_(Bjohann +2001-05-28 Kai Gro,b_(Bjohann From Jaap-Henk Hoepman (jhh@xs4all.nl). @@ -6420,7 +6953,7 @@ mm-destroy-postponed-undisplay-list): New functions. (mm-display-external): Use them. -2001-05-27 Kai Gro,A_(Bjohann +2001-05-27 Kai Gro,b_(Bjohann * gnus-salt.el (gnus-tree-highlight-node): Bind `default-high' and `default-low' when evaluating `gnus-summary-highlight'. @@ -6435,7 +6968,7 @@ as details. (mml2015-mailcrypt-clear-verify): Ditto. -2001-05-24 Kai Gro,A_(Bjohann +2001-05-24 Kai Gro,b_(Bjohann From Nevin Kapur . * gnus-sum.el (gnus-summary-default-high-score, @@ -6613,7 +7146,7 @@ matching subjects. (gnus-offer-save-summaries): Clean up. -2001-04-13 Kai Gro,A_(Bjohann +2001-04-13 Kai Gro,b_(Bjohann * nnmail.el (nnmail-split-fancy-with-parent): Add docstring. @@ -6634,7 +7167,7 @@ supported. Suggest by Jim Meyering . 2001-04-02 Nevin Kapur - Committed by Kai Gro,A_(Bjohann . + Committed by Kai Gro,b_(Bjohann . * nnmail.el (nnmail-split-it): Added check for .* at the end of regexp in nnmail-split-fancy. @@ -6855,7 +7388,7 @@ `nnimap-use-nov-p' (it really tested the negative). (nnimap-retrieve-headers): Use it. -2001-03-11 Kai Gro,A_(Bjohann +2001-03-11 Kai Gro,b_(Bjohann * message.el (message-generate-headers-first): Update doc. @@ -7087,7 +7620,7 @@ * gnus-draft.el (gnus-draft-reminder): "Confirm to exit?" -2001-02-19 Kai Gro,A_(Bjohann +2001-02-19 Kai Gro,b_(Bjohann * gnus-sum.el (gnus-thread-sort-functions): Doc fix. Refer to gnus-article-sort-functions. @@ -7207,7 +7740,7 @@ (gnus-subscribe-hierarchically): Return gnus-subscribe-newsgroup's return . -2001-02-12 Kai Gro,A_(Bjohann +2001-02-12 Kai Gro,b_(Bjohann * gnus-cus.el (gnus-score-customize): Doc fix. @@ -7300,7 +7833,7 @@ * gnus-uu.el (gnus-uu-grab-articles): Shoot down original article buffer. -2001-02-07 Kai Gro,A_(Bjohann +2001-02-07 Kai Gro,b_(Bjohann * message.el (message-generate-headers-first): Doc fix. @@ -8024,7 +8557,7 @@ * message.el (message-forward): Save-restriction. -2000-12-21 Kai Gro,A_(Bjohann +2000-12-21 Kai Gro,b_(Bjohann * gnus-art.el (article-treat-dumbquotes): More doc, provided by Paul Stevenson @@ -9117,7 +9650,7 @@ * message.el (message-font-lock-keywords): use message-cite-prefix-regexp. -2000-11-15 Kai Gro,A_(Bjohann +2000-11-15 Kai Gro,b_(Bjohann * gnus-group.el (gnus-group-jump-to-group-prompt): New variable by Stein Arild Str,Ax(Bmme. @@ -9252,7 +9785,7 @@ * gnus-art.el (gnus-mime-display-alternative): Show button if no preferred part. -2000-11-07 Kai Gro,A_(Bjohann +2000-11-07 Kai Gro,b_(Bjohann * gnus-sum.el (gnus-move-split-methods): Say that `gnus-split-methods' uses file names, whereas this uses group diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index ed69d49..1554658 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -49,47 +49,6 @@ ;(push "/usr/share/emacs/site-lisp" load-path) (unless (featurep 'xemacs) - (define-compiler-macro last (&whole form x &optional n) - (if (and (fboundp 'last) - (subrp (symbol-function 'last))) - form - (if n - `(let* ((x ,x) - (n ,n) - (m 0) - (p x)) - (while (consp p) - (incf m) - (pop p)) - (if (<= n 0) - p - (if (< n m) - (nthcdr (- m n) x) - x))) - `(let ((x ,x)) - (while (consp (cdr x)) - (pop x)) - x)))) - - (define-compiler-macro coerce (&whole form x type) - (if (and (fboundp 'coerce) - (subrp (symbol-function 'coerce))) - form - `(let ((x ,x) - (type ,type)) - (cond ((eq type 'list) (if (listp x) x (append x nil))) - ((eq type 'vector) (if (vectorp x) x (vconcat x))) - ((eq type 'string) (if (stringp x) x (concat x))) - ((eq type 'array) (if (arrayp x) x (vconcat x))) - ((and (eq type 'character) (stringp x) (= (length x) 1)) - (aref x 0)) - ((and (eq type 'character) (symbolp x) - (= (length (symbol-name x)) 1)) - (aref (symbol-name x) 0)) - ((eq type 'float) (float x)) - ((typep x type) x) - (t (error "Can't coerce %s to type %s" x type)))))) - (define-compiler-macro merge (&whole form type seq1 seq2 pred &rest keys) (if (and (fboundp 'merge) (subrp (symbol-function 'merge))) @@ -107,57 +66,6 @@ (push (pop seq1) res))) (coerce (nconc (nreverse res) seq1 seq2) type))))) - (define-compiler-macro subseq (&whole form seq start &optional end) - (if (and (fboundp 'subseq) - (subrp (symbol-function 'subseq))) - form - (if end - `(let ((seq ,seq) - (start ,start) - (end ,end)) - (if (stringp seq) - (substring seq start end) - (let (len) - (if (< end 0) - (setq end (+ end (setq len (length seq))))) - (if (< start 0) - (setq start (+ start (or len (setq len (length seq)))))) - (cond ((listp seq) - (if (> start 0) - (setq seq (nthcdr start seq))) - (let ((res nil)) - (while (>= (setq end (1- end)) start) - (push (pop seq) res)) - (nreverse res))) - (t - (let ((res (make-vector (max (- end start) 0) nil)) - (i 0)) - (while (< start end) - (aset res i (aref seq start)) - (setq i (1+ i) - start (1+ start))) - res)))))) - `(let ((seq ,seq) - (start ,start)) - (if (stringp seq) - (substring seq start) - (let (len) - (if (< start 0) - (setq start (+ start (or len (setq len (length seq)))))) - (cond ((listp seq) - (if (> start 0) - (setq seq (nthcdr start seq))) - (copy-sequence seq)) - (t - (let* ((end (or len (length seq))) - (res (make-vector (max (- end start) 0) nil)) - (i 0)) - (while (< start end) - (aset res i (aref seq start)) - (setq i (1+ i) - start (1+ start))) - res))))))))) - (define-compiler-macro copy-list (&whole form list) (if (and (fboundp 'copy-list) (subrp (symbol-function 'copy-list))) @@ -168,7 +76,11 @@ (while (consp list) (push (pop list) res)) (prog1 (nreverse res) (setcdr res list))) (car list))))) - ) + + (define-compiler-macro remove (&whole form item seq) + (if (>= emacs-major-version 21) + form + `(delete ,item (copy-sequence ,seq))))) ;; If we are building w3 in a different directory than the source ;; directory, we must read *.el from source directory and write *.elc diff --git a/lisp/flow-fill.el b/lisp/flow-fill.el index e7ca680..1b62a48 100644 --- a/lisp/flow-fill.el +++ b/lisp/flow-fill.el @@ -133,11 +133,14 @@ RFC 2646 suggests 66 characters for readability." (backward-delete-char -1) (end-of-line)) (unless sig - (let ((fill-prefix (when quote (concat quote " "))) - (fill-column (eval fill-flowed-display-column))) - (fill-region (fill-flowed-point-at-bol) - (min (1+ (fill-flowed-point-at-eol)) (point-max)) - 'left 'nosqueeze)))))))) + (condition-case nil + (let ((fill-prefix (when quote (concat quote " "))) + (fill-column (eval fill-flowed-display-column)) + filladapt-mode) + (fill-region (fill-flowed-point-at-bol) + (min (1+ (fill-flowed-point-at-eol)) (point-max)) + 'left 'nosqueeze)) + (error nil)))))))) (provide 'flow-fill) diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index eaf69d9..aecd9f7 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -628,8 +628,12 @@ be a select method." (defun gnus-agent-read-servers () "Read the alist of covered servers." (setq gnus-agent-covered-methods - (gnus-agent-read-file - (nnheader-concat gnus-agent-directory "lib/servers")))) + (mapcar (lambda (m) + (gnus-server-get-method + nil + (or m "native"))) + (gnus-agent-read-file + (nnheader-concat gnus-agent-directory "lib/servers"))))) (defun gnus-agent-write-servers () "Write the alist of covered servers." @@ -637,7 +641,8 @@ be a select method." (let ((coding-system-for-write nnheader-file-coding-system) (file-name-coding-system nnmail-pathname-coding-system)) (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers") - (prin1 gnus-agent-covered-methods (current-buffer))))) + (prin1 (mapcar 'gnus-method-simplify gnus-agent-covered-methods) + (current-buffer))))) ;;; ;;; Summary commands @@ -1645,15 +1650,20 @@ The following commands are available: (or (gnus-gethash group gnus-category-group-cache) (assq 'default gnus-category-alist))) -(defun gnus-agent-expire () - "Expire all old articles." +(defun gnus-agent-expire (&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." (interactive) - (let ((methods gnus-agent-covered-methods) + (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 group articles + 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 @@ -1672,172 +1682,196 @@ The following commands are available: (setq gnus-agent-current-history (setq history (gnus-agent-history-buffer)))) (goto-char (point-min)) - (when (> (buffer-size) 1) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward "^\t") - (if (let ((fetch-date (read (current-buffer)))) - (if (numberp fetch-date) - ;; 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) - articles (sort (symbol-value sym) 'car-less-than-car) - low (car (gnus-active group)) - info (gnus-get-info group) - unreads (ignore-errors - (gnus-list-of-unread-articles group)) - marked (nconc - (gnus-uncompress-range - (cdr (assq 'tick (gnus-info-marks info)))) - (gnus-uncompress-range - (cdr (assq 'dormant - (gnus-info-marks info))))) - nov-file (gnus-agent-article-name ".overview" group) - lowest nil - highest nil) - (gnus-agent-load-alist group) - (gnus-message 5 "Expiring articles in %s" group) - (set-buffer overview) - (erase-buffer) - (when (file-exists-p nov-file) - (nnheader-insert-file-contents nov-file)) - (goto-char (point-min)) - (setq article 0) - (while (setq elem (pop articles)) - (setq article (car elem)) - (when (or (null low) - (< article low) - gnus-agent-expire-all - (and (not (memq article unreads)) - (not (memq article marked)))) - ;; Find and nuke the NOV line. - (while (and (not (eobp)) - (or (not (numberp - (setq art (read (current-buffer))))) - (< art article))) - (if (and (numberp art) - (file-exists-p - (gnus-agent-article-name - (number-to-string art) group))) - (progn - (unless lowest - (setq lowest art)) - (setq highest art) - (forward-line 1)) - ;; Remove old NOV lines that have no articles. - (gnus-delete-line))) - (if (or (eobp) - (/= art article)) - (beginning-of-line) - (gnus-delete-line)) - ;; Nuke the article. - (when (file-exists-p - (setq file (gnus-agent-article-name - (number-to-string article) - group))) - (delete-file file)) - ;; Schedule the history line for nuking. - (push (cdr elem) histories))) - (gnus-make-directory (file-name-directory nov-file)) - (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)))) + (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 - (push (caar alist) expired) - (setcdr prev (setq alist (cdr alist)))) - (setq prev alist - alist (cdr alist)))) - (setq gnus-agent-article-alist (cdr first)) - (gnus-agent-save-alist group) - ;; Mark all articles up to the first article - ;; in `gnus-article-alist' as read. - (when (and info (caar gnus-agent-article-alist)) - (setcar (nthcdr 2 info) - (gnus-range-add - (nth 2 info) - (cons 1 (- (caar gnus-agent-article-alist) 1))))) - ;; Maybe everything has been expired from - ;; `gnus-article-alist' and so the above marking as - ;; read could not be conducted, or there are - ;; expired article within the range of the alist. - (when (and info - expired - (or (not (caar gnus-agent-article-alist)) - (> (car expired) - (caar gnus-agent-article-alist)))) - (setcar (nthcdr 2 info) - (gnus-add-to-range - (nth 2 info) - (nreverse expired)))) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string info) - ")"))) - (when lowest - (if (gnus-gethash group orig) - (setcar (gnus-gethash group orig) lowest) - (gnus-sethash group (cons lowest highest) orig)))) - expiry-hashtb) - (set-buffer history) - (setq histories (nreverse (sort histories '<))) - (while histories - (goto-char (pop histories)) - (gnus-delete-line)) - (gnus-agent-save-history) - (gnus-agent-close-history) - (gnus-write-active-file - (gnus-agent-lib-file "active") orig)) - (gnus-message 4 "Expiry...done"))))))) + (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")))))) ;;;###autoload (defun gnus-agent-batch () diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 8baf876..956553a 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -286,6 +286,7 @@ directly.") '(("\\*" "\\*" bold) ("_" "_" underline) ("/" "/" italic) + ("-" "-" strikethru) ("_/" "/_" underline-italic) ("_\\*" "\\*_" underline-bold) ("\\*/" "/\\*" bold-italic) @@ -351,7 +352,11 @@ and the latter avoids underlining any whitespace at all." (defface gnus-emphasis-underline-bold-italic '((t (:bold t :italic t :underline t))) "Face used for displaying underlined bold italic emphasized text. -Esample: (_/*word*/_)." +Example: (_/*word*/_)." + :group 'gnus-article-emphasis) + +(defface gnus-emphasis-strikethru '((t (:strikethru t))) + "Face used for displaying strike-through text (-word-)." :group 'gnus-article-emphasis) (defface gnus-emphasis-highlight-words @@ -1282,8 +1287,8 @@ It is a string, such as \"PGP\". If nil, ask user." (let ((table (copy-syntax-table text-mode-syntax-table))) ;; This causes the citation match run O(2^n). ;; (modify-syntax-entry ?- "w" table) - (modify-syntax-entry ?> ")" table) - (modify-syntax-entry ?< "(" table) + (modify-syntax-entry ?> ")<" table) + (modify-syntax-entry ?< "(>" table) table) "Syntax table used in article mode buffers. Initialized from `text-mode-syntax-table.") @@ -2082,7 +2087,10 @@ If READ-CHARSET, ask for a coding system." (goto-char (point-min)) (while (re-search-forward "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) - (replace-match "\\1\\3" t))))) + (replace-match "\\1\\3" t))) + (when (and gnus-display-mime-function (interactive-p)) + (funcall gnus-display-mime-function)))) + (defun article-wash-html (&optional read-charset) "Format an html article. @@ -2664,7 +2672,7 @@ should replace the \"Date:\" one, or should be added below it." ":" (format "%02d" (nth 1 dtime))))))) (error - (format "Date: %s (from Oort)" date)))) + (format "Date: %s (from Gnus)" date)))) (defun article-date-local (&optional highlight) "Convert the current article date to the local timezone." @@ -4940,6 +4948,8 @@ If given a prefix, show the hidden text instead." (let ((gnus-override-method gnus-override-method) (methods (and (stringp article) gnus-refer-article-method)) + (backend (car (gnus-find-method-for-group + gnus-newsgroup-name))) result (buffer-read-only nil)) (if (or (not (listp methods)) @@ -4958,7 +4968,8 @@ If given a prefix, show the hidden text instead." (gnus-kill-all-overlays) (let ((gnus-newsgroup-name group)) (gnus-check-group-server)) - (when (gnus-request-article article group (current-buffer)) + (cond + ((gnus-request-article article group (current-buffer)) (when (numberp article) (gnus-async-prefetch-next group article gnus-summary-buffer) @@ -4966,10 +4977,13 @@ If given a prefix, show the hidden text instead." (gnus-backlog-enter-article group article (current-buffer)))) (setq result 'article)) - (if (not result) - (if methods - (setq gnus-override-method (pop methods)) - (setq result 'done)))) + (methods + (setq gnus-override-method (pop methods))) + ((not (string-match "^400 " + (nnheader-get-report backend))) + ;; If we get 400 server disconnect, reconnect and + ;; retry; otherwise, assume the article has expired. + (setq result 'done)))) (and (eq result 'article) 'article))) ;; It was a pseudo. (t article))) diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index ed2f79f..7e59cc8 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -337,7 +337,7 @@ Returns the list of articles entered." (gnus-summary-position-point) (nreverse out))) -(defun gnus-cache-remove-article (n) +(defun gnus-cache-remove-article (&optional n) "Remove the next N articles from the cache. If not given a prefix, use the process marked articles instead. Returns the list of articles removed." diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index 1c5e424..59ccf01 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -1,6 +1,6 @@ ;;; gnus-cite.el --- parse citations in articles for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Per Abhiddenware @@ -259,6 +259,11 @@ This should make it easier to see who wrote what." :group 'gnus-cite :type 'integer) +(defcustom gnus-cite-blank-line-after-header t + "If non-nil, put a blank line between the citation header and the button." + :group 'gnus-cite + :type 'boolean) + ;;; Internal Variables: (defvar gnus-cite-article nil) @@ -518,7 +523,8 @@ always hide." end (set-marker (make-marker) end)) (gnus-add-text-properties-when 'article-type nil beg end props) (goto-char beg) - (unless (save-excursion (search-backward "\n\n" nil t)) + (when (and gnus-cite-blank-line-after-header + (not (save-excursion (search-backward "\n\n" nil t)))) (insert "\n")) (put-text-property (setq start (point-marker)) diff --git a/lisp/gnus-delay.el b/lisp/gnus-delay.el index 7e712b8..cb4fc91 100644 --- a/lisp/gnus-delay.el +++ b/lisp/gnus-delay.el @@ -145,10 +145,14 @@ DELAY is a string, giving the length of the time. Possible values are: (interactive) (save-excursion (let* ((group (format "nndraft:%s" gnus-delay-group)) + (message-send-hook (copy-sequence message-send-hook)) articles article deadline) (when (gnus-gethash group gnus-newsrc-hashtb) (gnus-activate-group group) + (add-hook 'message-send-hook + '(lambda () + (message-remove-header gnus-delay-header))) (setq articles (nndraft-articles)) (while (setq article (pop articles)) (gnus-request-head article group) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index fcf3a26..70be62e 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -79,20 +79,6 @@ (defvar gnus-mouse-face-prop 'mouse-face "Property used for highlighting mouse regions."))) -(eval-and-compile - (let ((case-fold-search t)) - (cond - ((string-match "windows-nt\\|os/2\\|emx\\|cygwin32" - (symbol-name system-type)) - (setq nnheader-file-name-translation-alist - (append nnheader-file-name-translation-alist - (mapcar (lambda (c) (cons c ?_)) - '(?: ?* ?\" ?< ?> ??)) - (if (string-match "windows-nt\\|cygwin32" - (symbol-name system-type)) - nil - '((?+ . ?-))))))))) - (defvar gnus-tmp-unread) (defvar gnus-tmp-replied) (defvar gnus-tmp-score-char) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index fb3540c..25cc892 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -174,10 +174,10 @@ with some simple extensions. %E Icon as defined by `gnus-group-icon-list'. %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, - where X is the letter following %u. The function will be passed the - current header as argument. The function should return a string, which - will be inserted into the buffer just like information from any other - group specifier. + where X is the letter following %u. The function will be passed a + single dummy parameter as argument.. The function should return a + string, which will be inserted into the buffer just like information + from any other group specifier. Note that this format specification is not always respected. For reasons of efficiency, when listing killed groups, this specification diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 47f4548..be5a448 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -397,6 +397,7 @@ If BUFFER, insert the article in that group." (gnus-cache-request-article article group)) (setq res (cons group article) clean-up t)) + ;; Check the agent cache. ((and gnus-agent gnus-agent-cache gnus-plugged (numberp article) (gnus-agent-request-article article group)) @@ -483,18 +484,27 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." info (nth 1 gnus-command-method)))) (defun gnus-request-expire-articles (articles group &optional force) - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-expire-articles) - articles (gnus-group-real-name group) (nth 1 gnus-command-method) - force))) - -(defun gnus-request-move-article - (article group server accept-function &optional last) - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-move-article) - article (gnus-group-real-name group) - (nth 1 gnus-command-method) accept-function last))) - + (let* ((gnus-command-method (gnus-find-method-for-group group)) + (not-deleted + (funcall + (gnus-get-function gnus-command-method 'request-expire-articles) + articles (gnus-group-real-name group) (nth 1 gnus-command-method) + force))) + (when (and gnus-agent gnus-agent-cache + (gnus-sorted-difference articles not-deleted)) + (gnus-agent-expire (gnus-sorted-difference articles not-deleted) + group 'force)) + not-deleted)) + +(defun gnus-request-move-article (article group server accept-function &optional last) + (let* ((gnus-command-method (gnus-find-method-for-group group)) + (result (funcall (gnus-get-function gnus-command-method 'request-move-article) + article (gnus-group-real-name group) + (nth 1 gnus-command-method) accept-function last))) + (when (and result gnus-agent gnus-agent-cache) + (gnus-agent-expire (list article) group 'force)) + result)) + (defun gnus-request-accept-article (group &optional gnus-command-method last no-encode) ;; Make sure there's a newline at the end of the article. diff --git a/lisp/gnus-logic.el b/lisp/gnus-logic.el index 77fc948..e6a1855 100644 --- a/lisp/gnus-logic.el +++ b/lisp/gnus-logic.el @@ -161,7 +161,7 @@ (defun gnus-advanced-integer (index match type) (if (not (memq type '(< > <= >= =))) (error "No such integer score type: %s" type) - (funcall type match (or (aref gnus-advanced-headers index) 0)))) + (funcall type (or (aref gnus-advanced-headers index) 0) match))) (defun gnus-advanced-date (index match type) (let ((date (apply 'encode-time (parse-time-string diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 7b4543c..13a2e2c 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -234,11 +234,25 @@ See also the `mml-default-encrypt-method' variable." :type 'boolean) (defcustom gnus-message-replysignencrypted - nil + t "Setting this causes automatically encryped messages to also be signed." :group 'gnus-message :type 'boolean) +(defcustom gnus-confirm-mail-reply-to-news nil + "If non-nil, Gnus requests confirmation when replying to news. +This is done because new users often reply by mistake when reading +news." + :group 'gnus-message + :type 'boolean) + +(defcustom gnus-summary-resend-default-address t + "If non-nil, Gnus tries to suggest a default address to resend to. +If nil, the address field will always be empty after invoking +`gnus-summary-resend-message'." + :group 'gnus-message + :type 'boolean) + ;;; Internal variables. (defvar gnus-inhibit-posting-styles nil @@ -483,6 +497,8 @@ If ARG is 1, prompt for a group name to find the posting style." ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. (let ((group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) (buffer (current-buffer))) (unwind-protect (progn @@ -512,6 +528,8 @@ network. The corresponding backend must have a 'request-post method." ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. (let ((group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) (buffer (current-buffer))) (unwind-protect (progn @@ -543,7 +561,9 @@ a news." (completing-read "Newsgroup: " gnus-active-hashtb nil (gnus-read-active-file-p)) (gnus-group-group-name)) - ""))) + "")) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy)) (gnus-post-news 'post gnus-newsgroup-name))) (defun gnus-summary-mail-other-window (&optional arg) @@ -555,6 +575,8 @@ posting style." ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. (let ((group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) (buffer (current-buffer))) (unwind-protect (progn @@ -584,6 +606,8 @@ network. The corresponding backend must have a 'request-post method." ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. (let ((group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) (buffer (current-buffer))) (unwind-protect (progn @@ -615,7 +639,9 @@ a news." (completing-read "Newsgroup: " gnus-active-hashtb nil (gnus-read-active-file-p)) "") - gnus-newsgroup-name))) + gnus-newsgroup-name)) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy)) (gnus-post-news 'post gnus-newsgroup-name))) @@ -641,7 +667,8 @@ yanked." ;; Send a followup. (gnus-post-news nil gnus-newsgroup-name headers gnus-article-buffer - yank nil force-news))) + yank nil force-news) + (gnus-summary-handle-replysign))) (defun gnus-summary-followup-with-original (n &optional force-news) "Compose a followup to an article and include the original article." @@ -676,7 +703,10 @@ yanked." (message-reply-headers ;; The headers are decoded. (with-current-buffer gnus-article-copy - (nnheader-parse-head t)))) + (save-restriction + (nnheader-narrow-to-headers) + (ietf-drums-unfold-fws) + (nnheader-parse-head t))))) (message-yank-original) (setq beg (or beg (mark t)))) (when articles @@ -978,51 +1008,60 @@ If VERY-WIDE, make a very wide reply." (interactive (list (and current-prefix-arg (gnus-summary-work-articles 1)))) - (let* ((article - (if (listp (car yank)) - (caar yank) - (car yank))) - (gnus-article-reply (or article (gnus-summary-article-number))) - (headers "")) - ;; Stripping headers should be specified with mail-yank-ignored-headers. - (when yank - (gnus-summary-goto-subject article)) - (gnus-setup-message (if yank 'reply-yank 'reply) - (if (not very-wide) - (gnus-summary-select-article) - (dolist (article very-wide) - (gnus-summary-select-article nil nil nil article) - (save-excursion - (set-buffer (gnus-copy-article-buffer)) - (gnus-msg-treat-broken-reply-to) - (save-restriction - (message-narrow-to-head) - (setq headers (concat headers (buffer-string))))))) - (set-buffer (gnus-copy-article-buffer)) - (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to) - (save-restriction - (message-narrow-to-head) - (when very-wide - (erase-buffer) - (insert headers)) - (goto-char (point-max))) - (mml-quote-region (point) (point-max)) - (message-reply nil wide) + ;; Allow user to require confirmation before replying by mail to the + ;; author of a news article. + (when (or (not (gnus-news-group-p gnus-newsgroup-name)) + (not gnus-confirm-mail-reply-to-news) + (y-or-n-p "Really reply by mail to article author? ")) + (let* ((article + (if (listp (car yank)) + (caar yank) + (car yank))) + (gnus-article-reply (or article (gnus-summary-article-number))) + (headers "")) + ;; Stripping headers should be specified with mail-yank-ignored-headers. (when yank - (gnus-inews-yank-articles yank)) - (when (or gnus-message-replysign gnus-message-replyencrypt) - (let (signed encrypted) - (save-excursion - (set-buffer gnus-article-buffer) - (setq signed (memq 'signed gnus-article-wash-types)) - (setq encrypted (memq 'encrypted gnus-article-wash-types))) - (cond ((and gnus-message-replysign signed) - (mml-secure-message mml-default-sign-method 'sign)) - ((and gnus-message-replyencrypt encrypted) - (mml-secure-message mml-default-encrypt-method - (if gnus-message-replysignencrypted - 'signencrypt - 'encrypt))))))))) + (gnus-summary-goto-subject article)) + (gnus-setup-message (if yank 'reply-yank 'reply) + (if (not very-wide) + (gnus-summary-select-article) + (dolist (article very-wide) + (gnus-summary-select-article nil nil nil article) + (save-excursion + (set-buffer (gnus-copy-article-buffer)) + (gnus-msg-treat-broken-reply-to) + (save-restriction + (message-narrow-to-head) + (setq headers (concat headers (buffer-string))))))) + (set-buffer (gnus-copy-article-buffer)) + (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to) + (save-restriction + (message-narrow-to-head) + (when very-wide + (erase-buffer) + (insert headers)) + (goto-char (point-max))) + (mml-quote-region (point) (point-max)) + (message-reply nil wide) + (when yank + (gnus-inews-yank-articles yank)) + (gnus-summary-handle-replysign))))) + +(defun gnus-summary-handle-replysign () + "Check the various replysign variables and take action accordingly." + (when (or gnus-message-replysign gnus-message-replyencrypt) + (let (signed encrypted) + (save-excursion + (set-buffer gnus-article-buffer) + (setq signed (memq 'signed gnus-article-wash-types)) + (setq encrypted (memq 'encrypted gnus-article-wash-types))) + (cond ((and gnus-message-replysign signed) + (mml-secure-message mml-default-sign-method 'sign)) + ((and gnus-message-replyencrypt encrypted) + (mml-secure-message mml-default-encrypt-method + (if gnus-message-replysignencrypted + 'signencrypt + 'encrypt))))))) (defun gnus-summary-reply-with-original (n &optional wide) "Start composing a reply mail to the current message. @@ -1129,7 +1168,8 @@ For the `inline' alternatives, also see the variable (interactive (list (message-read-from-minibuffer "Resend message(s) to: " - (when (gnus-buffer-live-p gnus-original-article-buffer) + (when (and gnus-summary-resend-default-address + (gnus-buffer-live-p gnus-original-article-buffer)) ;; If some other article is currently selected, the ;; initial-contents is wrong. Whatever, it is just the ;; initial-contents. diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el index f277591..4968121 100644 --- a/lisp/gnus-salt.el +++ b/lisp/gnus-salt.el @@ -368,7 +368,7 @@ This must be bound to a button-down mouse event." (defun gnus-binary-display-article (article &optional all-header) "Run ARTICLE through the binary decode functions." (when (gnus-summary-goto-subject article) - (let ((gnus-view-pseudos 'automatic)) + (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-uu)))) (defun gnus-binary-show-article (&optional arg) diff --git a/lisp/gnus-sieve.el b/lisp/gnus-sieve.el index 18300ed..2fb82f9 100644 --- a/lisp/gnus-sieve.el +++ b/lisp/gnus-sieve.el @@ -118,7 +118,7 @@ See the documentation for these variables and functions for details." "Guess a sieve rule based on RFC822 article in buffer. Return nil if no rule could be guessed." (when (message-fetch-field "sender") - `(sieve address "sender" ,(regexp-quote (message-fetch-field "sender"))))) + `(sieve address "sender" ,(message-fetch-field "sender")))) ;;;###autoload (defun gnus-sieve-article-add-rule () diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index fce7384..8d02f24 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -611,7 +611,7 @@ the first newsgroup." (defun gnus-clear-system () "Clear all variables and buffers." ;; Clear Gnus variables. - (let ((variables (delete 'gnus-format-specs gnus-variable-list))) + (let ((variables (remove 'gnus-format-specs gnus-variable-list))) (while variables (set (car variables) nil) (setq variables (cdr variables)))) @@ -787,7 +787,11 @@ cautiously -- unloading may cause trouble." (set-buffer gnus-dribble-buffer) (goto-char (point-max)) (insert string "\n") - (set-window-point (get-buffer-window (current-buffer)) (point-max)) + ;; This has been commented by Josh Huber + ;; It causes problems with both XEmacs and Emacs 21, and doesn't + ;; seem to be of much value. (FIXME: remove this after we make sure + ;; it's not needed). + ;; (set-window-point (get-buffer-window (current-buffer)) (point-max)) (bury-buffer gnus-dribble-buffer) (save-excursion (set-buffer gnus-group-buffer) @@ -2017,7 +2021,7 @@ newsgroup." "Read startup file. If FORCE is non-nil, the .newsrc file is read." ;; Reset variables that might be defined in the .newsrc.eld file. - (let ((variables (delete 'gnus-format-specs gnus-variable-list))) + (let ((variables (remove 'gnus-format-specs gnus-variable-list))) (while variables (set (car variables) nil) (setq variables (cdr variables)))) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 898a563..92dc97e 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -43,7 +43,7 @@ (autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t) (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t) (autoload 'mm-uu-dissect "mm-uu") -(autoload 'gnus-article-outlook-deuglify-article "deuglify" +(autoload 'gnus-article-outlook-deuglify-article "deuglify" "Deuglify broken Outlook (Express) articles and redisplay." t) @@ -136,8 +136,9 @@ comparing subjects." "List of functions taking a string argument that simplify subjects. The functions are applied recursively. -Useful functions to put in this list include: `gnus-simplify-subject-re', -`gnus-simplify-subject-fuzzy' and `gnus-simplify-whitespace'." +Useful functions to put in this list include: +`gnus-simplify-subject-re', `gnus-simplify-subject-fuzzy', +`gnus-simplify-whitespace', and `gnus-simplify-all-whitespace'." :group 'gnus-thread :type '(repeat function)) @@ -541,7 +542,7 @@ this variable specifies group names." :type 'boolean) (defcustom gnus-auto-expirable-marks - (list gnus-spam-mark gnus-killed-mark gnus-del-mark gnus-catchup-mark + (list gnus-killed-mark gnus-del-mark gnus-catchup-mark gnus-low-score-mark gnus-ancient-mark gnus-read-mark gnus-souped-mark gnus-duplicate-mark) "*The list of marks converted into expiration if a group is auto-expirable." @@ -644,7 +645,8 @@ was sent, sorting by number means sorting by arrival time.) Ready-made functions include `gnus-article-sort-by-number', `gnus-article-sort-by-author', `gnus-article-sort-by-subject', -`gnus-article-sort-by-date' and `gnus-article-sort-by-score'. +`gnus-article-sort-by-date', `gnus-article-sort-by-random' +and `gnus-article-sort-by-score'. When threading is turned on, the variable `gnus-thread-sort-functions' controls how articles are sorted." @@ -654,6 +656,7 @@ controls how articles are sorted." (function-item gnus-article-sort-by-subject) (function-item gnus-article-sort-by-date) (function-item gnus-article-sort-by-score) + (function-item gnus-article-sort-by-random) (function :tag "other")))) (defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number) @@ -673,7 +676,8 @@ Ready-made functions include `gnus-thread-sort-by-number', `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', `gnus-thread-sort-by-date', `gnus-thread-sort-by-score', `gnus-thread-sort-by-most-recent-number', -`gnus-thread-sort-by-most-recent-date', and +`gnus-thread-sort-by-most-recent-date', +`gnus-thread-sort-by-random', and `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function'). When threading is turned off, the variable @@ -685,6 +689,7 @@ When threading is turned off, the variable (function-item gnus-thread-sort-by-date) (function-item gnus-thread-sort-by-score) (function-item gnus-thread-sort-by-total-score) + (function-item gnus-thread-sort-by-random) (function :tag "other")))) (defcustom gnus-thread-score-function '+ @@ -1132,6 +1137,7 @@ the type of the variable (string, integer, character, etc).") (?u gnus-tmp-user-defined ?s) (?d (length gnus-newsgroup-dormant) ?d) (?t (length gnus-newsgroup-marked) ?d) + (?h (length gnus-newsgroup-spam-marked) ?d) (?r (length gnus-newsgroup-reads) ?d) (?z (gnus-summary-article-score gnus-tmp-article-number) ?d) (?E gnus-newsgroup-expunged-tally ?d) @@ -1171,6 +1177,9 @@ the type of the variable (string, integer, character, etc).") (defvar gnus-newsgroup-marked nil "Sorted list of ticked articles in the current newsgroup (a subset of unread art).") +(defvar gnus-newsgroup-spam-marked nil + "List of ranges of articles that have been marked as spam.") + (defvar gnus-newsgroup-killed nil "List of ranges of articles that have been through the scoring process.") @@ -1256,6 +1265,7 @@ the type of the variable (string, integer, character, etc).") gnus-newsgroup-last-folder gnus-newsgroup-last-file gnus-newsgroup-auto-expire gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked + gnus-newsgroup-spam-marked gnus-newsgroup-reads gnus-newsgroup-saved gnus-newsgroup-replied gnus-newsgroup-forwarded gnus-newsgroup-recent @@ -1362,6 +1372,13 @@ For example: (setq mystr (substring mystr 0 (match-beginning 0)))) mystr)) +(defun gnus-simplify-all-whitespace (str) + "Remove all whitespace from STR." + (let ((mystr str)) + (while (string-match "[ \t\n]+" mystr) + (setq mystr (replace-match "" nil nil mystr))) + mystr)) + (defsubst gnus-simplify-subject-re (subject) "Remove \"Re:\" from subject lines." (if (string-match message-subject-re-regexp subject) @@ -1544,6 +1561,7 @@ increase the score of each group you read." "\C-c\C-s\C-d" gnus-summary-sort-by-date "\C-c\C-s\C-i" gnus-summary-sort-by-score "\C-c\C-s\C-o" gnus-summary-sort-by-original + "\C-c\C-s\C-r" gnus-summary-sort-by-random "=" gnus-summary-expand-window "\C-x\C-s" gnus-summary-reselect-current-group "\M-g" gnus-summary-rescan-group @@ -1906,6 +1924,30 @@ increase the score of each group you read." (defvar gnus-article-post-menu nil) +(defconst gnus-summary-menu-maxlen 20) + +(defun gnus-summary-menu-split (menu) + ;; If we have lots of elements, divide them into groups of 20 + ;; and make a pane (or submenu) for each one. + (if (> (length menu) (/ (* gnus-summary-menu-maxlen 3) 2)) + (let ((menu menu) sublists next + (i 1)) + (while menu + ;; Pull off the next gnus-summary-menu-maxlen elements + ;; and make them the next element of sublist. + (setq next (nthcdr gnus-summary-menu-maxlen menu)) + (if next + (setcdr (nthcdr (1- gnus-summary-menu-maxlen) menu) + nil)) + (setq sublists (cons (cons (format "%s ... %s" (aref (car menu) 0) + (aref (car (last menu)) 0)) menu) + sublists)) + (setq i (1+ i)) + (setq menu next)) + (nreverse sublists)) + ;; Few elements--put them all in one pane. + menu)) + (defun gnus-summary-make-menu-bar () (gnus-turn-off-edit-menu 'summary) @@ -1980,26 +2022,27 @@ increase the score of each group you read." ["Show picons in mail headers" gnus-treat-mail-picon t] ["Show picons in news headers" gnus-treat-newsgroups-picon t] ("View as different encoding" - ,@(mapcar - (lambda (cs) - ;; Since easymenu under FSF Emacs doesn't allow lambda - ;; forms for menu commands, we should provide intern'ed - ;; function symbols. - (let ((command (intern (format "\ + ,@(gnus-summary-menu-split + (mapcar + (lambda (cs) + ;; Since easymenu under FSF Emacs doesn't allow lambda + ;; forms for menu commands, we should provide intern'ed + ;; function symbols. + (let ((command (intern (format "\ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) - (fset command - `(lambda () - (interactive) - (let ((gnus-summary-show-article-charset-alist - '((1 . ,cs)))) - (gnus-summary-show-article 1)))) - `[,(symbol-name cs) ,command t])) - (sort (if (fboundp 'coding-system-list) - (coding-system-list) - (mapcar 'car mm-mime-mule-charset-alist)) - (lambda (a b) - (string< (symbol-name a) - (symbol-name b))))))) + (fset command + `(lambda () + (interactive) + (let ((gnus-summary-show-article-charset-alist + '((1 . ,cs)))) + (gnus-summary-show-article 1)))) + `[,(symbol-name cs) ,command t])) + (sort (if (fboundp 'coding-system-list) + (coding-system-list) + (mapcar 'car mm-mime-mule-charset-alist)) + (lambda (a b) + (string< (symbol-name a) + (symbol-name b)))))))) ("Washing" ("Remove Blanks" ["Leading" gnus-article-strip-leading-blank-lines t] @@ -2282,6 +2325,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Sort by score" gnus-summary-sort-by-score t] ["Sort by lines" gnus-summary-sort-by-lines t] ["Sort by characters" gnus-summary-sort-by-chars t] + ["Randomize" gnus-summary-sort-by-random t] ["Original sort" gnus-summary-sort-by-original t]) ("Help" ["Fetch group FAQ" gnus-summary-fetch-faq t] @@ -2697,6 +2741,7 @@ The following commands are available: (defun gnus-article-read-p (article) "Say whether ARTICLE is read or not." (not (or (memq article gnus-newsgroup-marked) + (memq article gnus-newsgroup-spam-marked) (memq article gnus-newsgroup-unreads) (memq article gnus-newsgroup-unselected) (memq article gnus-newsgroup-dormant)))) @@ -2802,6 +2847,7 @@ marks of articles." ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark) ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark) ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark) + ((memq ,number gnus-newsgroup-spam-marked) gnus-spam-mark) ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark) ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark) (t (or (cdr (assq ,number gnus-newsgroup-reads)) @@ -2942,6 +2988,7 @@ buffer that was in action when the last article was fetched." (setq gnus-summary-buffer (current-buffer)) (let ((name gnus-newsgroup-name) (marked gnus-newsgroup-marked) + (spam gnus-newsgroup-spam-marked) (unread gnus-newsgroup-unreads) (headers gnus-current-headers) (data gnus-newsgroup-data) @@ -2964,6 +3011,7 @@ buffer that was in action when the last article was fetched." (set-buffer gnus-group-buffer) (setq gnus-newsgroup-name name gnus-newsgroup-marked marked + gnus-newsgroup-spam-marked spam gnus-newsgroup-unreads unread gnus-current-headers headers gnus-newsgroup-data data @@ -3624,7 +3672,7 @@ entered. Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (let* ((id (mail-header-id header)) (id-dep (and id (intern id dependencies))) - ref ref-dep ref-header replaced) + parent-id ref ref-dep ref-header replaced) ;; Enter this `header' in the `dependencies' table. (cond ((not id-dep) @@ -3667,7 +3715,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (when (and header (not replaced)) ;; First check that we are not creating a References loop. - (setq ref (gnus-parent-id (mail-header-references header))) + (setq parent-id (gnus-parent-id (mail-header-references header))) + (setq ref parent-id) (while (and ref (setq ref-dep (intern-soft ref dependencies)) (boundp ref-dep) @@ -3677,10 +3726,10 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; root article. (progn (mail-header-set-references (car (symbol-value id-dep)) "none") - (setq ref nil)) + (setq ref nil) + (setq parent-id nil)) (setq ref (gnus-parent-id (mail-header-references ref-header))))) - (setq ref (gnus-parent-id (mail-header-references header))) - (setq ref-dep (intern (or ref "none") dependencies)) + (setq ref-dep (intern (or parent-id "none") dependencies)) (if (boundp ref-dep) (setcdr (symbol-value ref-dep) (nconc (cdr (symbol-value ref-dep)) @@ -4190,6 +4239,15 @@ using some other form will lead to serious barfage." (gnus-article-sort-by-number (gnus-thread-header h1) (gnus-thread-header h2))) +(defsubst gnus-article-sort-by-random (h1 h2) + "Sort articles by article number." + (zerop (random 2))) + +(defun gnus-thread-sort-by-random (h1 h2) + "Sort threads by root article number." + (gnus-article-sort-by-random + (gnus-thread-header h1) (gnus-thread-header h2))) + (defsubst gnus-article-sort-by-lines (h1 h2) "Sort articles by article Lines header." (< (mail-header-lines h1) @@ -4381,7 +4439,7 @@ or a straight list of headers." (default-score (or gnus-summary-default-score 0)) (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight)) thread number subject stack state gnus-tmp-gathered beg-match - new-roots gnus-tmp-new-adopts thread-end + new-roots gnus-tmp-new-adopts thread-end simp-subject gnus-tmp-header gnus-tmp-unread gnus-tmp-replied gnus-tmp-subject-or-nil gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score @@ -4470,7 +4528,8 @@ or a straight list of headers." (setq gnus-tmp-level -1))) (setq number (mail-header-number gnus-tmp-header) - subject (mail-header-subject gnus-tmp-header)) + subject (mail-header-subject gnus-tmp-header) + simp-subject (gnus-simplify-subject-fully subject)) (cond ;; If the thread has changed subject, we might want to make @@ -4478,8 +4537,7 @@ or a straight list of headers." ((and (null gnus-thread-ignore-subject) (not (zerop gnus-tmp-level)) gnus-tmp-prev-subject - (not (inline - (gnus-subject-equal gnus-tmp-prev-subject subject)))) + (not (string= gnus-tmp-prev-subject simp-subject))) (setq new-roots (nconc new-roots (list (car thread))) thread-end t gnus-tmp-header nil)) @@ -4540,15 +4598,13 @@ or a straight list of headers." (cond ((and gnus-thread-ignore-subject gnus-tmp-prev-subject - (not (inline (gnus-subject-equal - gnus-tmp-prev-subject subject)))) + (not (string= gnus-tmp-prev-subject simp-subject))) subject) ((zerop gnus-tmp-level) (if (and (eq gnus-summary-make-false-root 'empty) (memq number gnus-tmp-gathered) gnus-tmp-prev-subject - (inline (gnus-subject-equal - gnus-tmp-prev-subject subject))) + (string= gnus-tmp-prev-subject simp-subject)) gnus-summary-same-subject subject)) (t gnus-summary-same-subject))) @@ -4633,7 +4689,7 @@ or a straight list of headers." (gnus-run-hooks 'gnus-summary-update-hook) (forward-line 1)) - (setq gnus-tmp-prev-subject subject))) + (setq gnus-tmp-prev-subject simp-subject))) (when (nth 1 thread) (push (list (max 0 gnus-tmp-level) @@ -4918,6 +4974,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (cond ((eq type 'tick) (memq article gnus-newsgroup-marked)) + ((eq type 'spam) + (memq article gnus-newsgroup-spam-marked)) ((eq type 'unsend) (memq article gnus-newsgroup-unsendable)) ((eq type 'undownload) @@ -4991,7 +5049,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (numberp gnus-large-newsgroup) (> number gnus-large-newsgroup)) (let* ((cursor-in-echo-area nil) - (initial (gnus-parameter-large-newsgroup-initial + (initial (gnus-parameter-large-newsgroup-initial gnus-newsgroup-name)) (input (read-string @@ -6683,7 +6741,7 @@ be displayed." (interactive) (let ((mm-verify-option 'known) (mm-decrypt-option 'known) - (gnus-buttonized-mime-types (append (list "multipart/signed" + (gnus-buttonized-mime-types (append (list "multipart/signed" "multipart/encrypted") gnus-buttonized-mime-types))) (gnus-summary-select-article nil 'force))) @@ -7805,8 +7863,8 @@ to guess what the document format is." (set-buffer gnus-original-article-buffer) ;; Have the digest group inherit the main mail address of ;; the parent article. - (when (setq to-address (or (message-fetch-field "reply-to") - (message-fetch-field "from"))) + (when (setq to-address (or (gnus-fetch-field "reply-to") + (gnus-fetch-field "from"))) (setq params (append (list (cons 'to-address (funcall gnus-decode-encoded-word-function @@ -8264,35 +8322,39 @@ If ARG is a negative number, turn header display off." If ARG is a positive number, show the entire header. If ARG is a negative number, hide the unwanted header lines." (interactive "P") - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (let* ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - hidden s e) - (save-restriction - (article-narrow-to-head) - (setq e (point-max) - hidden (if (numberp arg) + (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 + (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)))) - (delete-region (point-min) e) - (goto-char (point-min)) - (with-current-buffer gnus-original-article-buffer - (goto-char (setq s (point-min))) - (setq e (search-forward "\n\n" nil t) - e (if e (1- e) (point-max)))) - (insert-buffer-substring gnus-original-article-buffer s e) - (save-restriction - (narrow-to-region (point-min) (point)) + (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 + (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))) - (gnus-set-mode-line 'article))))) + (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)))))) (defun gnus-summary-show-all-headers () "Make all header lines visible." @@ -8790,6 +8852,7 @@ delete these instead." (error "Couldn't open server")) ;; Compute the list of articles to delete. (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<)) + (nnmail-expiry-target 'delete) not-deleted) (if (and gnus-novice-user (not (gnus-yes-or-no-p @@ -9275,6 +9338,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (let ((article (gnus-summary-article-number))) (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (push (cons article mark) gnus-newsgroup-reads) ;; Possibly remove from cache, if that is used. @@ -9306,6 +9370,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (gnus-error 1 "Can't mark negative article numbers") nil) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (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)) @@ -9313,6 +9378,10 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (setq gnus-newsgroup-marked (gnus-add-to-sorted-list gnus-newsgroup-marked article))) + ((= mark gnus-spam-mark) + (setq gnus-newsgroup-spam-marked + (gnus-add-to-sorted-list gnus-newsgroup-spam-marked + article))) ((= mark gnus-dormant-mark) (setq gnus-newsgroup-dormant (gnus-add-to-sorted-list gnus-newsgroup-dormant @@ -9364,6 +9433,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (error "No article on current line")) (if (not (if (or (= mark gnus-unread-mark) (= mark gnus-ticked-mark) + (= mark gnus-spam-mark) (= mark gnus-dormant-mark)) (gnus-mark-article-as-unread article mark) (gnus-mark-article-as-read article mark))) @@ -9437,6 +9507,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." ;; Remove from unread and marked lists. (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (push (cons article mark) gnus-newsgroup-reads) ;; Possibly remove from cache, if that is used. @@ -9452,6 +9523,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (gnus-error 1 "Can't mark negative article numbers") nil) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked) + gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked) gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant) gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable) gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) @@ -9463,6 +9535,9 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (cond ((= mark gnus-ticked-mark) (setq gnus-newsgroup-marked (gnus-add-to-sorted-list gnus-newsgroup-marked article))) + ((= mark gnus-spam-mark) + (setq gnus-newsgroup-spam-marked + (gnus-add-to-sorted-list gnus-newsgroup-spam-marked article))) ((= mark gnus-dormant-mark) (setq gnus-newsgroup-dormant (gnus-add-to-sorted-list gnus-newsgroup-dormant article))) @@ -9676,6 +9751,7 @@ The number of articles marked as read is returned." (progn (when all (setq gnus-newsgroup-marked nil + gnus-newsgroup-spam-marked nil gnus-newsgroup-dormant nil)) (setq gnus-newsgroup-unreads gnus-newsgroup-downloadable)) ;; We actually mark all articles as canceled, which we @@ -10107,6 +10183,12 @@ Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'number reverse)) +(defun gnus-summary-sort-by-random (&optional reverse) + "Randomize the order in the summary buffer. +Argument REVERSE means to randomize in reverse order." + (interactive "P") + (gnus-summary-sort 'random reverse)) + (defun gnus-summary-sort-by-author (&optional reverse) "Sort the summary buffer by author name alphabetically. If `case-fold-search' is non-nil, case of letters is ignored. @@ -10996,7 +11078,7 @@ If ALL is a number, fetch this number of articles." (if (and (numberp gnus-large-newsgroup) (> len gnus-large-newsgroup)) (let* ((cursor-in-echo-area nil) - (initial (gnus-parameter-large-newsgroup-initial + (initial (gnus-parameter-large-newsgroup-initial gnus-newsgroup-name)) (input (read-string @@ -11029,13 +11111,12 @@ If ALL is a number, fetch this number of articles." i new) (setq gnus-newsgroup-active (gnus-activate-group gnus-newsgroup-name 'scan)) - (setq i (1+ (cdr old-active))) - (while (<= i (cdr gnus-newsgroup-active)) + (setq i (cdr gnus-newsgroup-active)) + (while (> i (cdr old-active)) (push i new) - (incf i)) + (decf i)) (if (not new) (message "No gnus is bad news.") - (setq new (nreverse new)) (gnus-summary-insert-articles new) (setq gnus-newsgroup-unreads (gnus-sorted-nunion gnus-newsgroup-unreads new)) diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index b4a4042..e62c2a7 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -380,9 +380,17 @@ If RECURSIVE is t, return groups in its subtopics too." "Compute the group parameters for GROUP taking into account inheritance from topics." (let ((params-list (copy-sequence (gnus-group-get-parameter group)))) (save-excursion - (gnus-group-goto-group group) (nconc params-list - (gnus-topic-hierarchical-parameters (gnus-current-topic)))))) + (gnus-topic-hierarchical-parameters + ;; First we try to go to the group within the group + ;; buffer and find the topic for the group that way. + ;; This hopefully copes well with groups that are in + ;; more than one topic. Failing that (i.e. when the + ;; group isn't visible in the group buffer) we find a + ;; topic for the group via gnus-group-topic. + (or (and (gnus-group-goto-group group) + (gnus-current-topic)) + (gnus-group-topic group))))))) (defun gnus-topic-hierarchical-parameters (topic) "Return a topic list computed for TOPIC." @@ -1521,7 +1529,7 @@ If UNINDENT, remove an indentation." (gnus-topic-kill-group) (push (cdar gnus-topic-killed-topics) gnus-topic-alist) (gnus-topic-create-topic - topic parent nil (cdaar gnus-topic-killed-topics)) + topic parent nil (cdar (car gnus-topic-killed-topics))) (pop gnus-topic-killed-topics) (or (gnus-topic-goto-topic topic) (gnus-topic-goto-topic parent)))))) @@ -1540,7 +1548,7 @@ If UNINDENT, remove an indentation." (push (cdar gnus-topic-killed-topics) gnus-topic-alist) (gnus-topic-create-topic topic grandparent (gnus-topic-next-topic parent) - (cdaar gnus-topic-killed-topics)) + (cdar (car gnus-topic-killed-topics))) (pop gnus-topic-killed-topics) (gnus-topic-goto-topic topic)))) diff --git a/lisp/gnus.el b/lisp/gnus.el index 505930f..1265d16 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -277,7 +277,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.06" +(defconst gnus-version-number "0.07" "Version number for this version of Gnus.") (defconst gnus-version (format "Oort Gnus v%s" gnus-version-number) @@ -1269,7 +1269,8 @@ If the number of articles in a newsgroup is greater than this value, confirmation is required for selecting the newsgroup. If it is `nil', no confirmation is required." :group 'gnus-group-select - :type 'integer) + :type '(choice (const :tag "No limit" nil) + integer)) (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) "*Non-nil means that the default name of a file to save articles in is the group name. @@ -1552,6 +1553,21 @@ The gnus-group-split mail splitting mechanism will behave as if this address was listed in gnus-group-split Addresses (see below).") (gnus-define-group-parameter + subscribed + :type bool + :function-document + "Return GROUP's subscription status." + :variable-document + "*Groups which are automatically considered subscribed." + :parameter-type '(const :tag "Subscribed" t) + :parameter-document "\ +Gnus assumed that you are subscribed to the To/List address. + +When constructing a list of subscribed groups using +`gnus-find-subscribed-addresses', Gnus includes the To address given +above, or the list address (if the To address has not been set).") + +(gnus-define-group-parameter auto-expire :type bool :function gnus-group-auto-expirable-p @@ -1783,7 +1799,8 @@ face." "Whether Gnus is plugged or not.") (defcustom gnus-agent-cache t - "Whether Gnus use agent cache." + "Whether Gnus use agent cache. +You also need to enable `gnus-agent'." :version "21.3" :group 'gnus-agent :type 'boolean) @@ -1796,7 +1813,7 @@ covered by that variable." :type 'symbol :group 'gnus-charset) -(defcustom gnus-agent nil +(defcustom gnus-agent t "Whether we want to use the Gnus agent or not. Putting (gnus-agentize) in ~/.gnus is obsolete by (setq gnus-agent t)." :version "21.3" @@ -2403,12 +2420,12 @@ with a `subscribed' parameter." (let (group address addresses) (dolist (entry (cdr gnus-newsrc-alist)) (setq group (car entry)) - (when (gnus-group-find-parameter group 'subscribed) + (when (gnus-parameter-subscribed group) (setq address (mail-strip-quoted-names (or (gnus-group-fast-parameter group 'to-address) (gnus-group-fast-parameter group 'to-list)))) (when address - (push address addresses)))) + (add-to-list 'addresses address)))) (when addresses (list (mapconcat 'regexp-quote addresses "\\|"))))) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 73891cd..24a1981 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -464,7 +464,8 @@ Return the number of files that were found." (funcall function source callback) (error (unless (yes-or-no-p - (format "Mail source error (%s). Continue? " + (format "Mail source %s error (%s). Continue? " + source (cadr err))) (error "Cannot get new mail")) 0))))))))) diff --git a/lisp/message.el b/lisp/message.el index d6dc3c9..0a5941e 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -258,7 +258,7 @@ any confusion." :type 'string :group 'message-various) -(defcustom message-interactive nil +(defcustom message-interactive t "Non-nil means when sending a message wait for and display errors. nil means let mailer mail back a message to report errors." :group 'message-sending @@ -963,24 +963,48 @@ candidates: "Face used for displaying MML." :group 'message-faces) +(defun message-font-lock-make-header-matcher (regexp) + (let ((form + `(lambda (limit) + (let ((start (point))) + (save-restriction + (widen) + (goto-char (point-min)) + (if (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$") + nil t) + (setq limit (min limit (match-beginning 0)))) + (goto-char start)) + (and (< start limit) + (re-search-forward ,regexp limit t)))))) + (if (featurep 'bytecomp) + (byte-compile form) + form))) + (defvar message-font-lock-keywords (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?")) - `((,(concat "^\\([Tt]o:\\)" content) + `((,(message-font-lock-make-header-matcher + (concat "^\\([Tt]o:\\)" content)) (1 'message-header-name-face) (2 'message-header-to-face nil t)) - (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content) + (,(message-font-lock-make-header-matcher + (concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)) (1 'message-header-name-face) (2 'message-header-cc-face nil t)) - (,(concat "^\\([Ss]ubject:\\)" content) + (,(message-font-lock-make-header-matcher + (concat "^\\([Ss]ubject:\\)" content)) (1 'message-header-name-face) (2 'message-header-subject-face nil t)) - (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content) + (,(message-font-lock-make-header-matcher + (concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)) (1 'message-header-name-face) (2 'message-header-newsgroups-face nil t)) - (,(concat "^\\([A-Z][^: \n\t]+:\\)" content) + (,(message-font-lock-make-header-matcher + (concat "^\\([A-Z][^: \n\t]+:\\)" content)) (1 'message-header-name-face) (2 'message-header-other-face nil t)) - (,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content) + (,(message-font-lock-make-header-matcher + (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content)) (1 'message-header-name-face) (2 'message-header-name-face)) ,@(if (and mail-header-separator @@ -994,6 +1018,7 @@ candidates: (0 'message-mml-face)))) "Additional expressions to highlight in Message mode.") + ;; XEmacs does it like this. For Emacs, we have to set the ;; `font-lock-defaults' buffer-local variable. (put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t)) @@ -1528,6 +1553,7 @@ Point is left at the beginning of the narrowed-to region." (1+ max))))) (message-sort-headers-1)))) + ;;; @@ -2970,61 +2996,67 @@ If you always want Gnus to send messages in one piece, set " sendmail errors") 0)) resend-to-addresses delimline) - (let ((case-fold-search t)) - (save-restriction - (message-narrow-to-headers) - (setq resend-to-addresses (message-fetch-field "resent-to"))) - ;; Change header-delimiter to be what sendmail expects. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1) - (setq delimline (point-marker)) - (run-hooks 'message-send-mail-hook) - ;; Insert an extra newline if we need it to work around - ;; Sun's bug that swallows newlines. - (goto-char (1+ delimline)) - (when (eval message-mailer-swallows-blank-line) - (newline)) - (when message-interactive - (save-excursion - (set-buffer errbuf) - (erase-buffer)))) - (let ((default-directory "/") - (coding-system-for-write message-send-coding-system)) - (apply 'call-process-region - (append (list (point-min) (point-max) - (if (boundp 'sendmail-program) - sendmail-program - "/usr/lib/sendmail") - nil errbuf nil "-oi") - ;; Always specify who from, - ;; since some systems have broken sendmails. - ;; But some systems are more broken with -f, so - ;; we'll let users override this. - (if (null message-sendmail-f-is-evil) - (list "-f" (message-make-address))) - ;; These mean "report errors by mail" - ;; and "deliver in background". - (if (null message-interactive) '("-oem" "-odb")) - ;; Get the addresses from the message - ;; unless this is a resend. - ;; We must not do that for a resend - ;; because we would find the original addresses. - ;; For a resend, include the specific addresses. - (if resend-to-addresses - (list resend-to-addresses) - '("-t"))))) - (when message-interactive - (save-excursion - (set-buffer errbuf) - (goto-char (point-min)) - (while (re-search-forward "\n\n* *" nil t) - (replace-match "; ")) - (if (not (zerop (buffer-size))) - (error "Sending...failed to %s" - (buffer-substring (point-min) (point-max))))) + (unwind-protect + (progn + (let ((case-fold-search t)) + (save-restriction + (message-narrow-to-headers) + (setq resend-to-addresses (message-fetch-field "resent-to"))) + ;; Change header-delimiter to be what sendmail expects. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (backward-char 1) + (setq delimline (point-marker)) + (run-hooks 'message-send-mail-hook) + ;; Insert an extra newline if we need it to work around + ;; Sun's bug that swallows newlines. + (goto-char (1+ delimline)) + (when (eval message-mailer-swallows-blank-line) + (newline)) + (when message-interactive + (save-excursion + (set-buffer errbuf) + (erase-buffer)))) + (let* ((default-directory "/") + (coding-system-for-write message-send-coding-system) + (cpr (apply + 'call-process-region + (append + (list (point-min) (point-max) + (if (boundp 'sendmail-program) + sendmail-program + "/usr/lib/sendmail") + nil errbuf nil "-oi") + ;; Always specify who from, + ;; since some systems have broken sendmails. + ;; But some systems are more broken with -f, so + ;; we'll let users override this. + (if (null message-sendmail-f-is-evil) + (list "-f" (message-make-address))) + ;; These mean "report errors by mail" + ;; and "deliver in background". + (if (null message-interactive) '("-oem" "-odb")) + ;; Get the addresses from the message + ;; unless this is a resend. + ;; We must not do that for a resend + ;; because we would find the original addresses. + ;; For a resend, include the specific addresses. + (if resend-to-addresses + (list resend-to-addresses) + '("-t")))))) + (unless (or (null cpr) (zerop cpr)) + (error "Sending...failed with exit value %d" cpr))) + (when message-interactive + (save-excursion + (set-buffer errbuf) + (goto-char (point-min)) + (while (re-search-forward "\n\n* *" nil t) + (replace-match "; ")) + (if (not (zerop (buffer-size))) + (error "Sending...failed to %s" + (buffer-substring (point-min) (point-max))))))) (when (bufferp errbuf) (kill-buffer errbuf))))) @@ -4280,6 +4312,9 @@ than 988 characters long, and if they are not, trim them until they are." (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) (let* ((here (point)) (bol (progn (beginning-of-line n) (point))) @@ -5155,7 +5190,9 @@ Optional DIGEST will use digest to forward." (or (search-forward "\n\n" nil t) (point))) (delete-region (point-min) (point-max))) (when (and (not current-prefix-arg) - message-forward-ignored-headers) + message-forward-ignored-headers + ;; don't remove CTE, X-Gnus etc when doing "raw" forward: + message-forward-show-mml) (save-restriction (narrow-to-region b e) (goto-char b) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 64d935b..b38ac3b 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -127,14 +127,23 @@ It is suggested to customize `mm-text-html-renderer' instead.") (defcustom mm-inline-text-html-with-images nil "If non-nil, Gnus will allow retrieving images in the HTML contents -with tags. It has no effect on Emacs/w3. For emacs-w3m, the -value of the option `w3m-display-inline-images' will be bound with -this value. In addition, the variable `w3m-safe-url-regexp' will be -bound with the value nil if it is non-nil to make emacs-w3m show all -images, however this behavior may be changed in the future." +with tags. It has no effect on Emacs/w3. See also +the documentation for the option `mm-w3m-safe-url-regexp'." :type 'boolean :group 'mime-display) +(defcustom mm-w3m-safe-url-regexp "\\`cid:" + "Regexp that matches safe url names. Some HTML mails might have a +trick of spammers using tags. It is likely to be intended to +verify whether you have read the mail. You can prevent your personal +informations from leaking by setting this to the regexp which matches +the safe url names. The value of the variable `w3m-safe-url-regexp' +will be bound with this value. You may set this value to nil if you +consider all the urls to be safe." + :type '(choice (regexp :tag "Regexp") + (const :tag "All URLs are safe" nil) + :group 'mime-display)) + (defcustom mm-inline-text-html-with-w3m-keymap t "If non-nil, use emacs-w3m command keys in the article buffer." :type 'boolean @@ -681,9 +690,9 @@ external if displayed external." ;; We create a private sub-directory where we store our files. (set-file-modes dir 448) (if filename - (setq file (expand-file-name + (setq file (expand-file-name (gnus-map-function mm-file-name-rewrite-functions - (file-name-nondirectory filename)) + (file-name-nondirectory filename)) dir)) (setq file (mm-make-temp-file (expand-file-name "mm." dir)))) (let ((coding-system-for-write mm-binary-coding-system)) diff --git a/lisp/mm-encode.el b/lisp/mm-encode.el index 1658299..d75e3f6 100644 --- a/lisp/mm-encode.el +++ b/lisp/mm-encode.el @@ -30,7 +30,7 @@ (eval-and-compile (autoload 'mm-body-7-or-8 "mm-bodies")) -(defvar mm-content-transfer-encoding-defaults +(defcustom mm-content-transfer-encoding-defaults '(("text/x-patch" 8bit) ("text/.*" qp-or-base64) ("message/rfc822" 8bit) @@ -40,7 +40,15 @@ (".*" base64)) "Alist of regexps that match MIME types and their encodings. If the encoding is `qp-or-base64', then either quoted-printable -or base64 will be used, depending on what is more efficient.") +or base64 will be used, depending on what is more efficient." + :type '(repeat (list (regexp :tag "MIME type") + (choice :tag "encoding" + (const 7bit) + (const 8bit) + (const qp-or-base64) + (const quoted-printable) + (const base64)))) + :group 'mime) (defvar mm-use-ultra-safe-encoding nil "If non-nil, use encodings aimed at Procrustean bed survival. diff --git a/lisp/mm-url.el b/lisp/mm-url.el index 561f89a..ab18a57 100644 --- a/lisp/mm-url.el +++ b/lisp/mm-url.el @@ -297,20 +297,38 @@ This is taken from RFC 2396.") args (append mm-url-arguments (list url)))) (apply 'call-process program nil t nil args))) +(defvar mm-url-timeout 30 + "The number of seconds before timing out an URL fetch.") + +(defvar mm-url-retries 10 + "The number of retries after timing out when fetching an URL.") + (defun mm-url-insert (url &optional follow-refresh) "Insert the contents from an URL in the current buffer. If FOLLOW-REFRESH is non-nil, redirect refresh url in META." - (if follow-refresh - (save-restriction - (narrow-to-region (point) (point)) - (mm-url-insert-file-contents url) - (goto-char (point-min)) - (when (re-search-forward - "]*URL=\\([^\"]+\\)\"" nil t) - (let ((url (match-string 1))) - (delete-region (point-min) (point-max)) - (mm-url-insert url t)))) - (mm-url-insert-file-contents url))) + (let ((times mm-url-retries) + (done nil) + (first t) + result) + (while (and (not (zerop (decf times))) + (not done)) + (with-timeout (mm-url-timeout) + (unless first + (message "Trying again (%s)..." (- mm-url-retries times))) + (setq first nil) + (if follow-refresh + (save-restriction + (narrow-to-region (point) (point)) + (mm-url-insert-file-contents url) + (goto-char (point-min)) + (when (re-search-forward + "]*URL=\\([^\"]+\\)\"" nil t) + (let ((url (match-string 1))) + (delete-region (point-min) (point-max)) + (setq result (mm-url-insert url t))))) + (setq result (mm-url-insert-file-contents url))) + (setq done t))) + result)) (defun mm-url-decode-entities () "Decode all HTML entities." diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 18bf4d7..fd6b536 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -268,7 +268,7 @@ Valid elements include: mm-iso-8859-15-compatible)) "A table of the difference character between ISO-8859-X and ISO-8859-15.") -(defvar mm-coding-system-priorities nil +(defcustom mm-coding-system-priorities nil "Preferred coding systems for encoding outgoing mails. More than one suitable coding systems may be found for some texts. By @@ -278,8 +278,10 @@ 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 utf-8)) -") + '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis iso-latin-1 utf-8)) +" + :type '(repeat (coding-system :tag "Coding system")) + :group 'mime) (defvar mm-use-find-coding-systems-region (fboundp 'find-coding-systems-region) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 7bf1cb1..6a04a8f 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -281,9 +281,7 @@ will not be substituted.") (when charset (delete-region (point-min) (point-max)) (insert (mm-decode-string text charset))) - (let ((w3m-safe-url-regexp (if mm-inline-text-html-with-images - nil - "\\`cid:")) + (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) (w3m-display-inline-images mm-inline-text-html-with-images) w3m-force-redisplay) (w3m-region (point-min) (point-max))) diff --git a/lisp/mml-sec.el b/lisp/mml-sec.el index 09fec43..f0f6a64 100644 --- a/lisp/mml-sec.el +++ b/lisp/mml-sec.el @@ -46,6 +46,37 @@ (defvar mml-default-encrypt-method (caar mml-encrypt-alist) "Default encryption method.") +(defvar 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") + +;;; 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. + +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)" + (let ((style-item (assoc method mml-signencrypt-style-alist))) + (if style-item + (if (or (eq style 'separate) + (eq style 'combined)) + ;; valid style setting? + (setf (second style-item) style) + ;; otherwise, just return the current value + (second style-item)) + (gnus-message 3 "Warning, attempt to set invalid signencrypt-style")))) + ;;; Security functions (defun mml-smime-sign-buffer (cont) @@ -68,8 +99,8 @@ (or (mml2015-sign cont) (error "Signing failed... inspect message logs for errors"))) -(defun mml-pgpmime-encrypt-buffer (cont) - (or (mml2015-encrypt cont) +(defun mml-pgpmime-encrypt-buffer (cont &optional sign) + (or (mml2015-encrypt cont sign) (error "Encryption failed... inspect message logs for errors"))) (defun mml-secure-part (method &optional sign) @@ -174,21 +205,17 @@ If called with a prefix argument, only encrypt (do NOT sign)." (interactive "P") (mml-secure-message "smime" (if dontsign 'encrypt 'signencrypt))) -;;; NOTE: this should be switched to use signencrypt -;;; once it does something sensible (defun mml-secure-message-encrypt-pgp (&optional dontsign) "Add MML tag to encrypt and sign the entire message. If called with a prefix argument, only encrypt (do NOT sign)." (interactive "P") - (mml-secure-message "pgp" (if dontsign 'encrypt 'encrypt))) + (mml-secure-message "pgp" (if dontsign 'encrypt 'signencrypt))) -;;; NOTE: this should be switched to use signencrypt -;;; once it does something sensible (defun mml-secure-message-encrypt-pgpmime (&optional dontsign) "Add MML tag to encrypt and sign the entire message. If called with a prefix argument, only encrypt (do NOT sign)." (interactive "P") - (mml-secure-message "pgpmime" (if dontsign 'encrypt 'encrypt))) + (mml-secure-message "pgpmime" (if dontsign 'encrypt 'signencrypt))) (provide 'mml-sec) diff --git a/lisp/mml.el b/lisp/mml.el index 1554513..6065476 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -530,22 +530,29 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (insert "\n--" mml-boundary "--\n"))))) (t (error "Invalid element: %S" cont))) - (let ((item (assoc (cdr (assq 'sign cont)) mml-sign-alist)) + ;; handle sign & encrypt tags in a semi-smart way. + (let ((sign-item (assoc (cdr (assq 'sign cont)) mml-sign-alist)) + (encrypt-item (assoc (cdr (assq 'encrypt cont)) + mml-encrypt-alist)) sender recipients) - (when item + (when (or sign-item encrypt-item) (if (setq sender (cdr (assq 'sender cont))) (message-options-set 'message-sender sender)) (if (setq recipients (cdr (assq 'recipients cont))) (message-options-set 'message-recipients recipients)) - (funcall (nth 1 item) cont))) - (let ((item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist)) - sender recipients) - (when item - (if (setq sender (cdr (assq 'sender cont))) - (message-options-set 'message-sender sender)) - (if (setq recipients (cdr (assq 'recipients cont))) - (message-options-set 'message-recipients recipients)) - (funcall (nth 1 item) cont)))))) + (let ((style (mml-signencrypt-style (first (or sign-item encrypt-item))))) + ;; check if: we're both signing & encrypting, both methods + ;; are the same (why would they be different?!), and that + ;; the signencrypt style allows for combined operation. + (if (and sign-item encrypt-item (equal (first sign-item) + (first encrypt-item)) + (equal style 'combined)) + (funcall (nth 1 encrypt-item) cont t) + ;; otherwise, revert to the old behavior. + (when sign-item + (funcall (nth 1 sign-item) cont)) + (when encrypt-item + (funcall (nth 1 encrypt-item) cont))))))))) (defun mml-compute-boundary (cont) "Return a unique boundary that does not exist in CONT." @@ -999,6 +1006,13 @@ If RAW, don't highlight the article." "*MIME preview of ") (buffer-name)))) (erase-buffer) (insert-buffer buf) + (let ((message-deletable-headers (if (message-news-p) + nil + message-deletable-headers))) + (message-generate-headers + (copy-sequence (if (message-news-p) + message-required-news-headers + message-required-mail-headers)))) (if (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n") nil t) (replace-match "\n")) @@ -1014,7 +1028,9 @@ If RAW, don't highlight the article." (let ((gnus-newsgroup-charset (car message-posting-charset)) gnus-article-prepare-hook gnus-original-article-buffer) (run-hooks 'gnus-article-decode-hook) - (let ((gnus-newsgroup-name "dummy")) + (let ((gnus-newsgroup-name "dummy") + (gnus-newsrc-hashtb (or gnus-newsrc-hashtb + (gnus-make-hashtable 5)))) (gnus-article-prepare-display)))) ;; Disable article-mode-map. (use-local-map nil) diff --git a/lisp/mml1991.el b/lisp/mml1991.el index 5ee1f4f..5f5c599 100644 --- a/lisp/mml1991.el +++ b/lisp/mml1991.el @@ -24,7 +24,7 @@ ;;; Commentary: -;; RCS: $Id: mml1991.el,v 1.1.1.2 2002-05-06 23:49:24 yamaoka Exp $ +;; RCS: $Id: mml1991.el,v 1.1.1.3 2002-08-06 12:41:35 yamaoka Exp $ ;;; Code: @@ -36,7 +36,7 @@ mml1991-mailcrypt-encrypt) (gpg mml1991-gpg-sign mml1991-gpg-encrypt)) - "Alist of PGP/MIME functions.") + "Alist of PGP functions.") ;;; mailcrypt wrapper diff --git a/lisp/mml2015.el b/lisp/mml2015.el index 5e3fa2d..bf3e604 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -309,9 +309,10 @@ by you.") (insert (format "--%s--\n" boundary)) (goto-char (point-max)))) -(defun mml2015-mailcrypt-encrypt (cont) +(defun mml2015-mailcrypt-encrypt (cont &optional sign) (let ((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 @@ -351,6 +352,7 @@ by you.") (autoload 'gpg-verify-cleartext "gpg") (autoload 'gpg-sign-detached "gpg") (autoload 'gpg-sign-encrypt "gpg") + (autoload 'gpg-encrypt "gpg") (autoload 'gpg-passphrase-read "gpg")) (defun mml2015-gpg-passphrase () @@ -414,10 +416,13 @@ by you.") (defun mml2015-gpg-extract-signature-details () (goto-char (point-min)) (if (boundp 'gpg-unabbrev-trust-alist) - (let* ((signer (and (re-search-forward - "^\\[GNUPG:\\] GOODSIG [0-9A-Za-z]* \\(.*\\)$" + (let* ((expired (re-search-forward + "^\\[GNUPG:\\] SIGEXPIRED$" + nil t)) + (signer (and (re-search-forward + "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$" nil t) - (match-string 1))) + (cons (match-string 1) (match-string 2)))) (fprint (and (re-search-forward "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) " nil t) @@ -429,12 +434,16 @@ by you.") (trust-good-enough-p (cdr (assoc (cdr (assoc trust gpg-unabbrev-trust-alist)) mml2015-trust-boundaries-alist)))) - (if (and signer trust fprint) - (concat signer - (unless trust-good-enough-p - (concat "\nUntrusted, Fingerprint: " - (mml2015-gpg-pretty-print-fpr fprint)))) - "From unknown user")) + (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"))) @@ -559,28 +568,42 @@ by you.") (insert (format "--%s--\n" boundary)) (goto-char (point-max))))) -(defun mml2015-gpg-encrypt (cont) +(defun mml2015-gpg-encrypt (cont &optional sign) (let ((boundary (funcall mml-boundary-function (incf mml-multipart-number))) (text (current-buffer)) cipher) (mm-with-unibyte-current-buffer-mule4 (with-temp-buffer - (unless (gpg-sign-encrypt - text (setq cipher (current-buffer)) - mml2015-result-buffer - (split-string - (or - (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+") - nil - (message-options-get 'message-sender) - t t) ; armor & textmode - (unless (> (point-max) (point-min)) - (pop-to-buffer mml2015-result-buffer) - (error "Encrypt error"))) + ;; set up a function to call the correct gpg encrypt routine + ;; with the right arguments. (FIXME: this should be done + ;; differently.) + (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 ; passed in when using signencrypt + text (setq cipher (current-buffer)) + mml2015-result-buffer + (split-string + (or + (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (read-string "Recipients: "))) + "[ \f\t\n\r\v,]+") + nil + (message-options-get 'message-sender) + t t) ; armor & textmode + (unless (> (point-max) (point-min)) + (pop-to-buffer mml2015-result-buffer) + (error "Encrypt error")))) (goto-char (point-min)) (while (re-search-forward "\r+$" nil t) (replace-match "" t t)) @@ -641,11 +664,11 @@ by you.") mml2015-use) ;;;###autoload -(defun mml2015-encrypt (cont) +(defun mml2015-encrypt (cont &optional sign) (mml2015-clean-buffer) (let ((func (nth 2 (assq mml2015-use mml2015-function-alist)))) (if func - (funcall func cont) + (funcall func cont sign) (error "Cannot find encrypt function")))) ;;;###autoload diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el index e4dbed2..504fdca 100644 --- a/lisp/nnbabyl.el +++ b/lisp/nnbabyl.el @@ -349,7 +349,7 @@ (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) (delete-region (point) (progn (forward-line 1) (point))))) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) (setq result (if (stringp group) (list (cons group (nnbabyl-active-number group))) @@ -365,7 +365,7 @@ (insert-buffer-substring buf) (when last (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) (save-buffer) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) result)))) diff --git a/lisp/nndiary.el b/lisp/nndiary.el index 45aac6c..b3b7cf3 100644 --- a/lisp/nndiary.el +++ b/lisp/nndiary.el @@ -759,7 +759,7 @@ all. This may very well take some time.") (when (nndiary-schedule) (let (result) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) (if (stringp group) (and (nnmail-activate 'nndiary) diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 51d83ef..101bb40 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -579,7 +579,7 @@ from the document.") (cons 'body-begin "^ ?\n") (cons 'article-begin b-delimiter) (cons 'body-end-function 'nndoc-digest-body-end) - (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$")))) + (cons 'file-end (concat "^--" boundary-id "--[ \t]*$")))) t))) (defun nndoc-standard-digest-type-p () diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 36826ac..37dc786 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -158,7 +158,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) - (let (article start stop) + (let (article start stop num) (nnfolder-possibly-change-group group server) (when nnfolder-current-buffer (set-buffer nnfolder-current-buffer) @@ -173,16 +173,53 @@ the group. Then the marks file will be regenerated properly by Gnus.") (nnfolder-existing-articles))) (while (setq article (pop articles)) (set-buffer nnfolder-current-buffer) - (when (nnfolder-goto-article article) - (setq start (point)) - (setq stop (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) - (set-buffer nntp-server-buffer) - (insert (format "221 %d Article retrieved.\n" article)) - (insert-buffer-substring nnfolder-current-buffer start stop) - (goto-char (point-max)) - (insert ".\n"))) + (cond ((nnfolder-goto-article article) + (setq start (point)) + (setq stop (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max))) + (set-buffer nntp-server-buffer) + (insert (format "221 %d Article retrieved.\n" article)) + (insert-buffer-substring nnfolder-current-buffer + start stop) + (goto-char (point-max)) + (insert ".\n")) + + ;; If we couldn't find this article, skip over ranges + ;; of missing articles so we don't search the whole file + ;; for each of them. + ((numberp article) + (setq start (point)) + (and + ;; Check that we are either at BOF or after an + ;; article with a lower number. We do this so we + ;; won't be confused by out-of-order article numbers, + ;; as caused by active file bogosity. + (cond + ((bobp)) + ((search-backward (concat "\n" nnfolder-article-marker) + nil t) + (goto-char (match-end 0)) + (setq num (string-to-int + (buffer-substring + (point) (progn (end-of-line) (point))))) + (goto-char start) + (< num article))) + ;; Check that we are before an article with a + ;; higher number. + (search-forward (concat "\n" nnfolder-article-marker) + nil t) + (progn + (setq num (string-to-int + (buffer-substring + (point) (progn (end-of-line) (point))))) + (> num article)) + ;; Discard any article numbers before the one we're + ;; now looking at. + (while (and articles + (< (car articles) num)) + (setq articles (cdr articles)))) + (goto-char start)))) (set-buffer nntp-server-buffer) (nnheader-fold-continuation-lines) 'headers)))))) @@ -489,7 +526,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) (delete-region (point) (progn (forward-line 1) (point)))) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) (setq result (if (stringp group) (list (cons group (nnfolder-active-number group))) (setq art-group diff --git a/lisp/nnheader.el b/lisp/nnheader.el index ee93eec..b5b29f4 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -70,7 +70,18 @@ Integer values will in effect be rounded up to the nearest multiple of (defvar nnheader-head-chop-length 2048 "*Length of each read operation when trying to fetch HEAD headers.") -(defvar nnheader-file-name-translation-alist nil +(defvar nnheader-file-name-translation-alist + (let ((case-fold-search t)) + (cond + ((string-match "windows-nt\\|os/2\\|emx\\|cygwin32" + (symbol-name system-type)) + (append (mapcar (lambda (c) (cons c ?_)) + '(?: ?* ?\" ?< ?> ??)) + (if (string-match "windows-nt\\|cygwin32" + (symbol-name system-type)) + nil + '((?+ . ?-))))) + (t nil))) "*Alist that says how to translate characters in file names. For instance, if \":\" is invalid as a file character in file names on your system, you could say something like: diff --git a/lisp/nnimap.el b/lisp/nnimap.el index b089e16..cfd3be5 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -55,6 +55,7 @@ ;; o What about Gnus's article editing, can we support it? NO! ;; o Use \Draft to support the draft group?? ;; o Duplicate suppression +;; o Rewrite UID SEARCH UID X as UID FETCH X (UID) for those with slow servers ;;; Code: @@ -279,9 +280,12 @@ typical complete file name would be (defvoo nnimap-nov-file-name-suffix ".novcache" "Suffix for NOV cache base filename.") -(defvoo nnimap-nov-is-evil nil - "If non-nil, nnimap will never generate or use a local nov database for this backend. -Using nov databases will speed up header fetching considerably. +(defvoo nnimap-nov-is-evil gnus-agent + "If non-nil, never generate or use a local nov database for this backend. +Using nov databases should speed up header fetching considerably. +However, it will invoke a UID SEARCH UID command on the server, and +some servers implement this command inefficiently by opening each and +every message in the group, thus making it quite slow. Unlike other backends, you do not need to take special care if you flip this variable.") @@ -377,7 +381,7 @@ restrict visible folders.") ;; Internal variables: -(defvoo nnimap-mailbox-info (gnus-make-hashtable 997)) +(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*\")") @@ -966,7 +970,8 @@ function is generally only called when Gnus is shutting down." (setq slowgroups groups) (dolist (group groups) (gnus-message 7 "nnimap: Checking mailbox %s" group) - (add-to-list (if (gnus-gethash-safe group nnimap-mailbox-info) + (add-to-list (if (gnus-gethash-safe (concat server group) + nnimap-mailbox-info) 'asyncgroups 'slowgroups) (list group (imap-mailbox-status-asynch @@ -977,10 +982,12 @@ function is generally only called when Gnus is shutting down." new old) (when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer)) (if (nnimap-string-lessp-numerical - (car (gnus-gethash group nnimap-mailbox-info)) + (car (gnus-gethash + (concat server group) nnimap-mailbox-info)) (imap-mailbox-get 'uidnext group nnimap-server-buffer)) (push (list group) slowgroups) - (insert (cdr (gnus-gethash group nnimap-mailbox-info)))))))) + (insert (cdr (gnus-gethash (concat server group) + nnimap-mailbox-info)))))))) (dolist (group slowgroups) (if nnimap-retrieve-groups-asynchronous (setq group (car group))) @@ -999,7 +1006,7 @@ function is generally only called when Gnus is shutting down." (insert str) (when nnimap-retrieve-groups-asynchronous (gnus-sethash - group + (concat server group) (cons (or (imap-mailbox-get 'uidnext group nnimap-server-buffer) (imap-mailbox-status @@ -1147,7 +1154,10 @@ function is generally only called when Gnus is shutting down." (goto-char (point-min)) (when (and (if (stringp regexp) (progn - (setq regrepp (string-match "\\\\[0-9&]" group)) + (if (not (stringp group)) + (setq group (eval group)) + (setq regrepp + (string-match "\\\\[0-9&]" group))) (re-search-forward regexp nil t)) (funcall regexp group)) ;; Don't enter the article into the same group twice. @@ -1206,8 +1216,10 @@ function is generally only called when Gnus is shutting down." (setq removeorig t) (when nnmail-cache-accepted-message-ids (with-current-buffer nntp-server-buffer - (nnmail-cache-insert (nnmail-fetch-field - "message-id") to-group))) + (let (msgid) + (and (setq msgid + (nnmail-fetch-field "message-id")) + (nnmail-cache-insert msgid to-group))))) ;; Add the group-art list to the history list. (push (list (cons to-group 0)) nnmail-split-history)) (t @@ -1378,7 +1390,8 @@ function is generally only called when Gnus is shutting down." (while (search-forward "\n" nil t) (replace-match "\r\n")) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id")))) + (nnmail-cache-insert (nnmail-fetch-field "message-id") + group))) (when (and last nnmail-cache-accepted-message-ids) (nnmail-cache-close)) ;; this 'or' is for Cyrus server bug diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 9538167..b640ae8 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -104,7 +104,8 @@ The last element should always have \"\" as the regexp. This variable can also have a function as its value." :group 'nnmail-split - :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp)) + :type '(choice (repeat :tag "Alist" (group (string :tag "Name") + (choice regexp function))) (function-item nnmail-split-fancy) (function :tag "Other"))) @@ -123,6 +124,15 @@ If nil, the first match found will be used." (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." + :group 'nnmail-split + :type '(choice (const :tag "none" nil) + (regexp :value ".*") + (repeat :value (".*") regexp))) + ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). (defcustom nnmail-keep-last-article nil "If non-nil, nnmail will never delete/move a group's last article. @@ -484,6 +494,11 @@ parameter. It should return nil, `warn' or `delete'." :group 'nnmail :type 'symbol) +(defcustom nnmail-mail-splitting-decodes nil + "Whether the nnmail splitting functionality should MIME decode headers." + :group 'nnmail + :type 'boolean) + ;;; Internal variables. (defvar nnmail-article-buffer " *nnmail incoming*" @@ -782,8 +797,8 @@ If SOURCE is a directory spec, try to return the group name component." start (if (search-forward "\n\n" nil t) (1- (point)) - ;; This will never happen, but just to be on the safe side -- - ;; if there is no head-body delimiter, we search a bit manually. + ;; This will never happen, but just to be on the safe side -- + ;; if there is no head-body delimiter, we search a bit manually. (while (and (looking-at "From \\|[^ \t]+:") (not (eobp))) (forward-line 1)) @@ -815,12 +830,12 @@ If SOURCE is a directory spec, try to return the group name component." (goto-char (point-max)) (widen) (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 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. + ;; 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 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. (when content-length (forward-line 1) (setq skip (+ (point) content-length)) @@ -1000,8 +1015,9 @@ FUNC will be called with the group name to determine the article number." ;; Copy the headers into the work buffer. (insert-buffer-substring obuf beg end) ;; Decode MIME headers and charsets. - (let ((mail-parse-charset nnmail-mail-splitting-charset)) - (mail-decode-encoded-word-region (point-min) (point-max))) + (when nnmail-mail-splitting-decodes + (let ((mail-parse-charset nnmail-mail-splitting-charset)) + (mail-decode-encoded-word-region (point-min) (point-max)))) ;; Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) @@ -1456,37 +1472,28 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (defvar group) (defvar group-art-list) (defvar group-art) -(defun nnmail-cache-insert (id &optional grp) +(defun nnmail-cache-insert (id grp) (when nnmail-treat-duplicates ;; Store some information about the group this message is written - ;; to. This function might have been called from various places. - ;; Sometimes, a function up in the calling sequence has an - ;; argument GROUP which is bound to a string, the group name. At - ;; other times, there is a function up in the calling sequence - ;; which has an argument GROUP-ART which is a list of pairs, and - ;; the car of a pair is a group name. Should we check that the - ;; length of the list is equal to 1? -- kai - (let ((g nil)) - (cond (grp - (setq g grp)) - ((and (boundp 'group) group) - (setq g group)) - ((and (boundp 'group-art-list) group-art-list - (listp group-art-list)) - (setq g (caar group-art-list))) - ((and (boundp 'group-art) group-art (listp group-art)) - (setq g (caar group-art))) - (t (setq g ""))) - (unless (gnus-buffer-live-p nnmail-cache-buffer) - (nnmail-cache-open)) - (save-excursion - (set-buffer nnmail-cache-buffer) - (goto-char (point-max)) - (if (and g (not (string= "" g)) - (gnus-methods-equal-p gnus-command-method - (nnmail-cache-primary-mail-backend))) - (insert id "\t" g "\n") - (insert id "\n")))))) + ;; to. This is passed in as the grp argument -- all locations this + ;; has been called from have been checked and the group is available. + ;; The only ambiguous case is nnmail-check-duplication which will only + ;; pass the first (of possibly >1) group which matches. -Josh + (unless (gnus-buffer-live-p nnmail-cache-buffer) + (nnmail-cache-open)) + (save-excursion + (set-buffer nnmail-cache-buffer) + (goto-char (point-max)) + (if (and grp (not (string= "" grp)) + (gnus-methods-equal-p gnus-command-method + (nnmail-cache-primary-mail-backend))) + (let ((regexp (if (consp nnmail-cache-ignore-groups) + (mapconcat 'identity nnmail-cache-ignore-groups + "\\|") + nnmail-cache-ignore-groups))) + (unless (and regexp (string-match regexp grp)) + (insert id "\t" grp "\n"))) + (insert id "\n"))))) (defun nnmail-cache-primary-mail-backend () (let ((be-list (cons gnus-select-method gnus-secondary-select-methods)) @@ -1588,7 +1595,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ((not duplication) (funcall func (setq group-art (nreverse (nnmail-article-group artnum-func)))) - (nnmail-cache-insert message-id)) + (nnmail-cache-insert message-id (caar group-art))) ((eq action 'delete) (setq group-art nil)) ((eq action 'warn) @@ -1763,7 +1770,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (setq target (format-time-string (caddr regexp-target-pair) date))) ((and (not (equal header 'to-from)) (string-match (cadr regexp-target-pair) - (message-fetch-field header))) + (or + (message-fetch-field header) + ""))) (setq target (format-time-string (caddr regexp-target-pair) date))))))) diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el index e1e6989..b3003cb 100644 --- a/lisp/nnmbox.el +++ b/lisp/nnmbox.el @@ -332,7 +332,7 @@ (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) (delete-region (point) (progn (forward-line 1) (point)))) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) (setq result (if (stringp group) (list (cons group (nnmbox-active-number group))) (nnmail-article-group 'nnmbox-active-number))) diff --git a/lisp/nnmh.el b/lisp/nnmh.el index 0ab8767..cb80d77 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -316,7 +316,7 @@ as unread by Gnus.") (nnmh-possibly-change-directory group server) (nnmail-check-syntax) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) (nnheader-init-server-buffer) (prog1 (if (stringp group) diff --git a/lisp/nnml.el b/lisp/nnml.el index 76ca820..935fa10 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -369,7 +369,7 @@ marks file will be regenerated properly by Gnus.") (nnmail-check-syntax) (let (result) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) (if (stringp group) (and (nnmail-activate 'nnml) diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el index 250349d..b5b1bfc 100644 --- a/lisp/nnslashdot.el +++ b/lisp/nnslashdot.el @@ -53,6 +53,9 @@ (defvoo nnslashdot-backslash-url "http://slashdot.org/slashdot.xml" "Where nnslashdot will fetch the stories from.") +(defvoo nnslashdot-use-front-page nil + "Use the front page in addition to the backslash page.") + (defvoo nnslashdot-threshold -1 "The article threshold.") @@ -292,6 +295,7 @@ (deffoo nnslashdot-request-list (&optional server) (nnslashdot-possibly-change-server nil server) (let ((number 0) + (first nnslashdot-use-front-page) sid elem description articles gname) (condition-case why ;; First we do the Ultramode to get info on all the latest groups. @@ -321,20 +325,22 @@ (goto-char (point-max)) (widen))) ;; Then do the older groups. - (while (> (- nnslashdot-group-number number) 0) + (while (or first + (> (- nnslashdot-group-number number) 0)) + (setq first nil) (mm-with-unibyte-buffer (let ((case-fold-search t)) (mm-url-insert (format nnslashdot-active-url number) t) (goto-char (point-min)) (while (re-search-forward - "article.pl\\?sid=\\([^&]+\\).*\\([^<]+\\)" + "article.pl\\?sid=\\([^&]+\\).*>\\([^<]+\\)" nil t) (setq sid (match-string 1) description (mm-url-decode-entities-string (match-string 2))) (forward-line 1) - (when (re-search-forward "\\([0-9]+\\)" nil t) - (setq articles (string-to-number (match-string 1)))) + (when (re-search-forward "with \\([0-9]+\\) comment" nil t) + (setq articles (1+ (string-to-number (match-string 1))))) (setq gname (concat description " (" sid ")")) (if (setq elem (assoc gname nnslashdot-groups)) (setcar (cdr elem) articles) diff --git a/lisp/nnsoup.el b/lisp/nnsoup.el index f8d9b38..29791ce 100644 --- a/lisp/nnsoup.el +++ b/lisp/nnsoup.el @@ -114,7 +114,7 @@ backend for the messages.") ;; articles in SEQUENCE come from. (while (and areas sequence) ;; Peel off areas that are below sequence. - (while (and areas (< (cdaar areas) (car sequence))) + (while (and areas (< (cdar (car areas)) (car sequence))) (setq areas (cdr areas))) (when areas ;; This is a useful area. @@ -130,7 +130,7 @@ backend for the messages.") (setq use-nov nil)) ;; We assign the portion of `sequence' that is relevant to ;; this MSG packet to this packet. - (while (and sequence (<= (car sequence) (cdaar areas))) + (while (and sequence (<= (car sequence) (cdar (car areas)))) (push (car sequence) this-area-seq) (setq sequence (cdr sequence))) (setcar useful-areas (cons (nreverse this-area-seq) @@ -249,7 +249,7 @@ backend for the messages.") ;; Try to guess the type based on the first article in the group. (when (not article) (setq article - (cdaar (cddr (assoc group nnsoup-group-alist))))) + (cdar (car (cddr (assoc group nnsoup-group-alist)))))) (if (not article) 'unknown (let ((kind (gnus-soup-encoding-kind @@ -371,7 +371,7 @@ backend for the messages.") (setq min (caaar e)) (while (cdr e) (setq e (cdr e))) - (setq max (cdaar e)) + (setq max (cdar (car e))) (setcdr entry (cons (cons min max) (cdr entry))))) (setq nnsoup-group-alist-touched t)) nnsoup-group-alist)) @@ -651,7 +651,7 @@ backend for the messages.") (defun nnsoup-article-to-area (article group) "Return the area that ARTICLE in GROUP is located in." (let ((areas (cddr (assoc group nnsoup-group-alist)))) - (while (and areas (< (cdaar areas) article)) + (while (and areas (< (cdar (car areas)) article)) (setq areas (cdr areas))) (and areas (car areas)))) diff --git a/lisp/nntp.el b/lisp/nntp.el index 92560b6..1463c1e 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -102,6 +102,13 @@ using and indirect connection method (nntp-open-via-*).") This command is used by the `nntp-open-via-rlogin-and-telnet' method. The default is \"rsh\", but \"ssh\" is a popular alternative.") +(defvoo nntp-via-rlogin-command-switches nil + "*Switches given to the rlogin command `nntp-via-rlogin-command'. +If you use \"ssh\" for `nntp-via-rlogin-command', you may set this to +\(\"-C\") in order to compress all data connections, otherwise set this +to \(\"-t\") or (\"-C\" \"-t\") if the telnet command requires a pseudo-tty +allocation on an intermediate host.") + (defvoo nntp-via-telnet-command "telnet" "*Telnet command used to connect to an intermediate host. This command is used by the `nntp-open-via-telnet-and-telnet' method.") @@ -1596,6 +1603,7 @@ from there. Please refer to the following variables to customize the connection: - `nntp-pre-command', - `nntp-via-rlogin-command', +- `nntp-via-rlogin-command-switches', - `nntp-via-user-name', - `nntp-via-address', - `nntp-telnet-command', @@ -1605,17 +1613,21 @@ Please refer to the following variables to customize the connection: - `nntp-end-of-line'." (let ((command `(,nntp-via-address ,nntp-telnet-command - ,@nntp-telnet-switches - ,nntp-address ,nntp-port-number)) + ,@nntp-telnet-switches)) proc) - (and nntp-via-user-name - (setq command `("-l" ,nntp-via-user-name ,@command))) + (when nntp-via-user-name + (setq command `("-l" ,nntp-via-user-name ,@command))) + (when nntp-via-rlogin-command-switches + (setq command (append nntp-via-rlogin-command-switches command))) (push nntp-via-rlogin-command command) (and nntp-pre-command (push nntp-pre-command command)) (setq proc (apply 'start-process "nntpd" buffer command)) (save-excursion (set-buffer buffer) + (nntp-wait-for-string "^r?telnet") + (process-send-string proc (concat "open " nntp-address + " " nntp-port-number "\n")) (nntp-wait-for-string "^\r*20[01]") (beginning-of-line) (delete-region (point-min) (point)) diff --git a/lisp/nnweb.el b/lisp/nnweb.el index f747ab4..76f4b71 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -49,8 +49,7 @@ (defvoo nnweb-type 'google "What search engine type is being used. -Valid types include `google', `dejanews', `dejanewsold', `reference', -and `altavista'.") +Valid types include `google', `dejanews', and `gmane'.") (defvar nnweb-type-definition '((google @@ -62,33 +61,25 @@ and `altavista'.") (address . "http://groups.google.com/groups") (identifier . nnweb-google-identity)) (dejanews ;; alias of google - ;;(article . nnweb-google-wash-article) - ;;(id . "http://groups.google.com/groups?as_umsgid=%s") (article . ignore) (id . "http://groups.google.com/groups?selm=%s&output=gplain") - ;;(reference . nnweb-google-reference) (reference . identity) (map . nnweb-google-create-mapping) (search . nnweb-google-search) (address . "http://groups.google.com/groups") (identifier . nnweb-google-identity)) - (reference - (article . nnweb-reference-wash-article) - (map . nnweb-reference-create-mapping) - (search . nnweb-reference-search) - (address . "http://www.reference.com/cgi-bin/pn/go") - (identifier . identity)) - (altavista - (article . nnweb-altavista-wash-article) - (map . nnweb-altavista-create-mapping) - (search . nnweb-altavista-search) - (address . "http://www.altavista.digital.com/cgi-bin/query") - (id . "/cgi-bin/news?id@%s") - (identifier . identity))) + (gmane + (article . nnweb-gmane-wash-article) + (id . "http://gmane.org/view.php?group=%s") + (reference . identity) + (map . nnweb-gmane-create-mapping) + (search . nnweb-gmane-search) + (address . "http://gmane.org/") + (identifier . nnweb-gmane-identity))) "Type-definition alist.") (defvoo nnweb-search nil - "Search string to feed to DejaNews.") + "Search string to feed to Google.") (defvoo nnweb-max-hits 999 "Maximum number of hits to display.") @@ -311,383 +302,6 @@ and `altavista'.") nnweb-type nnweb-search server)) (current-buffer)))))) -;; (defun nnweb-fetch-url (url) -;; (let (buf) -;; (save-excursion -;; (if (not nnheader-callback-function) -;; (progn -;; (with-temp-buffer -;; (mm-enable-multibyte) -;; (let ((coding-system-for-read 'binary) -;; (coding-system-for-write 'binary) -;; (default-process-coding-system 'binary)) -;; (nnweb-insert url)) -;; (setq buf (buffer-string))) -;; (erase-buffer) -;; (insert buf) -;; t) -;; (nnweb-url-retrieve-asynch -;; url 'nnweb-callback (current-buffer) nnheader-callback-function) -;; t)))) - -;; (defun nnweb-callback (buffer callback) -;; (when (gnus-buffer-live-p url-working-buffer) -;; (save-excursion -;; (set-buffer url-working-buffer) -;; (funcall (nnweb-definition 'article)) -;; (nnweb-decode-entities) -;; (set-buffer buffer) -;; (goto-char (point-max)) -;; (insert-buffer-substring url-working-buffer)) -;; (funcall callback t) -;; (gnus-kill-buffer url-working-buffer))) - -;; (defun nnweb-url-retrieve-asynch (url callback &rest data) -;; (let ((url-request-method "GET") -;; (old-asynch url-be-asynchronous) -;; (url-request-data nil) -;; (url-request-extra-headers nil) -;; (url-working-buffer (generate-new-buffer-name " *nnweb*"))) -;; (setq-default url-be-asynchronous t) -;; (save-excursion -;; (set-buffer (get-buffer-create url-working-buffer)) -;; (setq url-current-callback-data data -;; url-be-asynchronous t -;; url-current-callback-func callback) -;; (url-retrieve url nil)) -;; (setq-default url-be-asynchronous old-asynch))) - -;; (if (fboundp 'url-retrieve-synchronously) -;; (defun nnweb-url-retrieve-asynch (url callback &rest data) -;; (url-retrieve url callback data))) - -;;; -;;; DejaNews functions. -;;; - -(defun nnweb-dejanews-create-mapping () - "Perform the search and create an number-to-url alist." - (save-excursion - (set-buffer nnweb-buffer) - (erase-buffer) - (when (funcall (nnweb-definition 'search) nnweb-search) - (let ((i 0) - (more t) - (case-fold-search t) - (active (or (cadr (assoc nnweb-group nnweb-group-alist)) - (cons 1 0))) - subject date from - map url parse a table group text) - (while more - ;; Go through all the article hits on this page. - (goto-char (point-min)) - (setq parse (w3-parse-buffer (current-buffer)) - table (nth 1 (nnweb-parse-find-all 'table parse))) - (dolist (row (nth 2 (car (nth 2 table)))) - (setq a (nnweb-parse-find 'a row) - url (cdr (assq 'href (nth 1 a))) - text (nreverse (nnweb-text row))) - (when a - (setq subject (nth 4 text) - group (nth 2 text) - date (nth 1 text) - from (nth 0 text)) - (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date) - (setq date (format "%s %s 00:00:00 %s" - (car (rassq (string-to-number - (match-string 2 date)) - parse-time-months)) - (match-string 3 date) - (match-string 1 date))) - (setq date "Jan 1 00:00:00 0000")) - (incf i) - (setq url (concat url "&fmt=text")) - (when (string-match "&context=[^&]+" url) - (setq url (replace-match "" t t url))) - (unless (nnweb-get-hashtb url) - (push - (list - (incf (cdr active)) - (make-full-mail-header - (cdr active) (concat subject " (" group ")") from date - (concat "<" (nnweb-identifier url) "@dejanews>") - nil 0 0 url)) - map) - (nnweb-set-hashtb (cadar map) (car map))))) - ;; See whether there is a "Get next 20 hits" button here. - (goto-char (point-min)) - (if (or (not (re-search-forward - "HREF=\"\\([^\"]+\\)\"[<>b]+Next result" nil t)) - (>= i nnweb-max-hits)) - (setq more nil) - ;; Yup -- fetch it. - (setq more (match-string 1)) - (erase-buffer) - (mm-url-insert more))) - ;; Return the articles in the right order. - (setq nnweb-articles - (sort (nconc nnweb-articles map) 'car-less-than-car)))))) - -(defun nnweb-dejanews-search (search) - (mm-url-insert - (concat - (nnweb-definition 'address) - "?" - (mm-url-encode-www-form-urlencoded - `(("ST" . "PS") - ("svcclass" . "dnyr") - ("QRY" . ,search) - ("defaultOp" . "AND") - ("DBS" . "1") - ("OP" . "dnquery.xp") - ("LNG" . "ALL") - ("maxhits" . "100") - ("threaded" . "0") - ("format" . "verbose2") - ("showsort" . "date") - ("agesign" . "1") - ("ageweight" . "1"))))) - t) - -;; (defun nnweb-dejanewsold-search (search) -;; (nnweb-fetch-form -;; (nnweb-definition 'address) -;; `(("query" . ,search) -;; ("defaultOp" . "AND") -;; ("svcclass" . "dnold") -;; ("maxhits" . "100") -;; ("format" . "verbose2") -;; ("threaded" . "0") -;; ("showsort" . "date") -;; ("agesign" . "1") -;; ("ageweight" . "1"))) -;; t) - -(defun nnweb-dejanews-identity (url) - "Return an unique identifier based on URL." - (if (string-match "AN=\\([0-9]+\\)" url) - (match-string 1 url) - url)) - -;;; -;;; InReference -;;; - -(defun nnweb-reference-create-mapping () - "Perform the search and create an number-to-url alist." - (save-excursion - (set-buffer nnweb-buffer) - (erase-buffer) - (when (funcall (nnweb-definition 'search) nnweb-search) - (let ((i 0) - (more t) - (case-fold-search t) - (active (or (cadr (assoc nnweb-group nnweb-group-alist)) - (cons 1 0))) - Subject Score Date Newsgroups From Message-ID - map url) - (while more - ;; Go through all the article hits on this page. - (goto-char (point-min)) - (search-forward "
" nil t) - (delete-region (point-min) (point)) - (goto-char (point-min)) - (while (re-search-forward "^ +[0-9]+\\." nil t) - (narrow-to-region - (point) - (if (re-search-forward "^$" nil t) - (match-beginning 0) - (point-max))) - (goto-char (point-min)) - (when (looking-at ".*href=\"\\([^\"]+\\)\"") - (setq url (match-string 1))) - (mm-url-remove-markup) - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (replace-match " ")) - (goto-char (point-min)) - (while (re-search-forward "^\\([^:]+\\): \\(.*\\)$" nil t) - (set (intern (match-string 1)) (match-string 2))) - (widen) - (search-forward "" nil t) - (incf i) - (unless (nnweb-get-hashtb url) - (push - (list - (incf (cdr active)) - (make-full-mail-header - (cdr active) (concat "(" Newsgroups ") " Subject) From Date - Message-ID - nil 0 (string-to-int Score) url)) - map) - (nnweb-set-hashtb (cadar map) (car map)))) - (setq more nil)) - ;; Return the articles in the right order. - (setq nnweb-articles - (sort (nconc nnweb-articles map) 'car-less-than-car)))))) - -(defun nnweb-reference-wash-article () - (let ((case-fold-search t)) - (goto-char (point-min)) - (re-search-forward "^
" nil t) - (delete-region (point-min) (point)) - (search-forward "
" nil t)
-    (forward-line -1)
-    (let ((body (point-marker)))
-      (search-forward "
" nil t) - (delete-region (point) (point-max)) - (mm-url-remove-markup) - (goto-char (point-min)) - (while (looking-at " *$") - (gnus-delete-line)) - (narrow-to-region (point-min) body) - (while (and (re-search-forward "^$" nil t) - (not (eobp))) - (gnus-delete-line)) - (goto-char (point-min)) - (while (looking-at "\\(^[^ ]+:\\) *") - (replace-match "\\1 " t) - (forward-line 1)) - (goto-char (point-min)) - (when (re-search-forward "^References:" nil t) - (narrow-to-region - (point) (if (re-search-forward "^$\\|^[^:]+:" nil t) - (match-beginning 0) - (point-max))) - (goto-char (point-min)) - (while (not (eobp)) - (unless (looking-at "References") - (insert "\t") - (forward-line 1))) - (goto-char (point-min)) - (while (search-forward "," nil t) - (replace-match " " t t))) - (widen) - (mm-url-decode-entities) - (set-marker body nil)))) - -(defun nnweb-reference-search (search) - (mm-url-insert - (concat - (nnweb-definition 'address) - "?" - (mm-url-encode-www-form-urlencoded - `(("search" . "advanced") - ("querytext" . ,search) - ("subj" . "") - ("name" . "") - ("login" . "") - ("host" . "") - ("organization" . "") - ("groups" . "") - ("keywords" . "") - ("choice" . "Search") - ("startmonth" . "Jul") - ("startday" . "25") - ("startyear" . "1996") - ("endmonth" . "Aug") - ("endday" . "24") - ("endyear" . "1996") - ("mode" . "Quick") - ("verbosity" . "Verbose") - ("ranking" . "Relevance") - ("first" . "1") - ("last" . "25") - ("score" . "50"))))) - (setq buffer-file-name nil) - t) - -;;; -;;; Alta Vista -;;; - -(defun nnweb-altavista-create-mapping () - "Perform the search and create an number-to-url alist." - (save-excursion - (set-buffer nnweb-buffer) - (erase-buffer) - (let ((part 0)) - (when (funcall (nnweb-definition 'search) nnweb-search part) - (let ((i 0) - (more t) - (case-fold-search t) - (active (or (cadr (assoc nnweb-group nnweb-group-alist)) - (cons 1 0))) - subject date from id group - map url) - (while more - ;; Go through all the article hits on this page. - (goto-char (point-min)) - (search-forward "
" nil t) - (delete-region (point-min) (match-beginning 0)) - (goto-char (point-min)) - (while (search-forward "
" nil t) - (replace-match "\n")) - (mm-url-decode-entities) - (goto-char (point-min)) - (while (re-search-forward ".*href=\"\\([^\"]+\\)\">\\([^>]*\\)
\\([^-]+\\)- \\([^<]+\\)<.*href=\"news:\\([^\"]+\\)\">.*\">\\(.+\\)

" - nil t) - (setq url (match-string 1) - subject (match-string 2) - date (match-string 3) - group (match-string 4) - id (concat "<" (match-string 5) ">") - from (match-string 6)) - (incf i) - (unless (nnweb-get-hashtb url) - (push - (list - (incf (cdr active)) - (make-full-mail-header - (cdr active) (concat "(" group ") " subject) from date - id nil 0 0 url)) - map) - (nnweb-set-hashtb (cadar map) (car map)))) - ;; See if we want more. - (when (or (not nnweb-articles) - (>= i nnweb-max-hits) - (not (funcall (nnweb-definition 'search) - nnweb-search (incf part)))) - (setq more nil))) - ;; Return the articles in the right order. - (setq nnweb-articles - (sort (nconc nnweb-articles map) 'car-less-than-car))))))) - -(defun nnweb-altavista-wash-article () - (goto-char (point-min)) - (let ((case-fold-search t)) - (when (re-search-forward "^" nil t) - (delete-region (point-min) (match-beginning 0))) - (goto-char (point-min)) - (while (looking-at "\\([^ ]+\\) + +\\(.*\\)$") - (replace-match "\\1: \\2" t) - (forward-line 1)) - (when (re-search-backward "^References:" nil t) - (narrow-to-region (point) (progn (forward-line 1) (point))) - (goto-char (point-min)) - (while (re-search-forward "[0-9]+" nil t) - (replace-match "<\\1> " t))) - (widen) - (mm-url-remove-markup) - (mm-url-decode-entities))) - -(defun nnweb-altavista-search (search &optional part) - (mm-url-insert - (concat - (nnweb-definition 'address) - "?" - (mm-url-encode-www-form-urlencoded - `(("pg" . "aq") - ("what" . "news") - ,@(when part `(("stq" . ,(int-to-string (* part 30))))) - ("fmt" . "d") - ("q" . ,search) - ("r" . "") - ("d0" . "") - ("d1" . ""))))) - (setq buffer-file-name nil) - t) - ;;; ;;; Deja bought by google.com ;;; @@ -793,12 +407,23 @@ and `altavista'.") (set-buffer nnweb-buffer) (erase-buffer) (when (funcall (nnweb-definition 'search) nnweb-search) - (let ((more t)) + (let ((more t) + (i 0)) (while more (setq nnweb-articles (nconc nnweb-articles (nnweb-google-parse-1))) - ;; FIXME: There is more. - (setq more nil)) + ;; Check if there are more articles to fetch + (goto-char (point-min)) + (incf i 100) + (if (or (not (re-search-forward + "]+\\).*Next" nil t)) + (>= i nnweb-max-hits)) + (setq more nil) + ;; Yup, there are more articles + (setq more (concat "http://groups.google.com" (match-string 1))) + (when more + (erase-buffer) + (mm-url-insert more)))) ;; Return the articles in the right order. (setq nnweb-articles (sort nnweb-articles 'car-less-than-car)))))) @@ -825,6 +450,71 @@ and `altavista'.") url)) ;;; +;;; gmane.org +;;; +(defun nnweb-gmane-create-mapping () + "Perform the search and create a number-to-url alist." + (save-excursion + (set-buffer nnweb-buffer) + (erase-buffer) + (when (funcall (nnweb-definition 'search) nnweb-search) + (let ((more t) + (case-fold-search t) + (active (or (cadr (assoc nnweb-group nnweb-group-alist)) + (cons 1 0))) + subject group url + map) + ;; Remove stuff from the beginning of results + (goto-char (point-min)) + (search-forward "Search Results