From: yamaoka Date: Tue, 6 Aug 2002 13:45:57 +0000 (+0000) Subject: T-gnus 6.15.7 revision 00. X-Git-Tag: t-gnus-6_15_7-00 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=f6a1ae0f3c76e1cbf2c6b2c6ab6a50cae9929882;p=elisp%2Fgnus.git- T-gnus 6.15.7 revision 00. --- diff --git a/ChangeLog b/ChangeLog index bd21efb..dca2ee2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,85 @@ +2002-08-06 Katsumi Yamaoka + + * lisp/gnus-vers.el: T-gnus 6.15.7 revision 00. + +2002-08-06 TSUCHIYA Masatoshi + + * lisp/gnus-namazu.el (gnus-namazu-update-index): Handle error + messages printed by Namazu. + (gnus-namazu/update-sentinel): Likewise. + (gnus-namazu-need-path-normalization): Change its default value. + (gnus-namazu/normalize-results): Remove `file://' prefix. + + * texi/gnus-ja.texi (Namazu Groups): Update documents. + + * lisp/gnus-namazu.el (gnus-namazu/update-p): Print error + messages. + (gnus-namazu-update-index): Small clean up. + (gnus-namazu-update-all-indices): Ditto. + +2002-08-05 TSUCHIYA Masatoshi + + * lisp/gnus-namazu.el: Bug fix of updating multiple indices. + (gnus-namazu/setup): Call `gnus-namazu-update-all-indices' without + arguments. + (gnus-namazu-create-index): Clean temporary files even if an + indexer is killed. + (gnus-namazu/update-p): New function. + (gnus-namazu-update-all-indices): Reimplemented. + (gnus-namazu-update-index): Call `gnus-namazu/update-p' to decide + whether the specified index will be updated. + (gnus-namazu/update-sentinel): Follow the change of + `gnus-namazu-update-all-indices'. + +2002-08-05 TSUCHIYA Masatoshi + + * lisp/gnus.el (toplevel): Add autoloads for + `gnus-namazu-create-index', and `gnus-namazu-update-all-indices' + and `gnus-namazu-update-index'. + + * lisp/gnus-namazu.el: Support automatically updating multiple + indices. + (gnus-namazu-make-index-interval): Abolished. + (gnus-namazu-index-update-interval): New option. + (gnus-namazu/setup): Call `gnus-namazu-update-all-indices' instead + of `gnus-namazu-make-index'. + (gnus-namazu/mknmz-process): Abolished. + (gnus-namazu/status-file-name): New macro. + (gnus-namazu-make-index, gnus-namazu-make-index-stop, + gnus-namazu/mknmz-sentinel): Removed. + (gnus-namazu/mknmz-cleanup, gnus-namazu/index-old-p): New function. + (gnus-namazu-create-index, gnus-namazu-update-all-indices, + gnus-namazu-update-index, gnus-namazu-stop-update): New command. + (gnus-namazu/update-directories, gnus-namazu/update-process): New + internal variable. + +2002-07-31 TSUCHIYA Masatoshi + + * lisp/gnus-namazu.el: Support automatically updating index. + (gnus-namazu-default-index-directory): New constant. + (gnus-namazu-make-index-interval, gnus-namazu-make-index-command, + gnus-namazu-make-index-arguments): New options. + (gnus-namazu/setup): Call `gnus-namazu-make-index'. + (gnus-namazu/real-group-name): Renamed from + `gnus-namazu/check-cache-group'. + (gnus-namazu/cache-group-candidates): Renamed from + `gnus-namazu/cache-group-candidates'. + (gnus-namazu/search): Experimental support of articles covered by + agent. + (gnus-namazu/default-index-directory, gnus-namazu/lapse-seconds, + gnus-namazu/mknmz-sentinel): New internal functions. + (gnus-namazu/mknmz-process): New internal variable. + (gnus-namazu/lock-file-name, gnus-namazu/index-file-name): New + macros. + (gnus-namazu-make-index, gnus-namazu-make-index-stop): New + commands. + +2002-07-30 TSUCHIYA Masatoshi + + * lisp/gnus-namazu.el (gnus-namazu/request-list): Removed. + (gnus-namazu/get-current-to): New function. + (gnus-namazu/complete-query): Call the above. + 2002-07-19 Katsumi Yamaoka * lisp/pop3.el: Don't autoload "ssl". @@ -8,11 +90,22 @@ * lisp/gnus-namazu.el (gnus-namazu/truncate-article-list): Remove a redundancy. -2002-06-25 TSUCHIYA Masatoshi +2002-07-11 TSUCHIYA Masatoshi - * lisp/gnus-namazu.el (gnus-namazu/truncate-article-list): When - `gnus-large-newsgroup' is equal to nil, no confirmation is - required. + * texi/gnus-ja.texi (Web Newspaper): Update the url of w3m. + +2002-07-05 Katsumi Yamaoka + + * lisp/gnus-sum.el (gnus-summary-mode-map): Replace + `gnus-article-toggle-headers' with `gnus-summary-toggle-header'. + (gnus-summary-wash-map): Ditto. + (gnus-summary-wash-hide-map): Replace + `gnus-article-toggle-headers' with `gnus-article-hide-headers'. + (gnus-summary-article-menu): Ditto. + + * lisp/gnus.el: Remove autoload for `gnus-article-toggle-headers'. + + * lisp/gnus-art.el (article-toggle-headers): Abolished. 2002-07-04 Katsumi Yamaoka @@ -31,12 +124,30 @@ workaround I installed on 1999-12-28, i.e. also call `as-binary-process' in windows-nt. +2002-06-26 Katsumi Yamaoka + + * contrib/hashcash.el: Require `cl' when compiling. + (hashcash-strip-quoted-names): Replace `subseq' with `substring'. + (mail-add-payment): Allow no `mail-header-separator' in the buffer; + don't use `mapc'. + +2002-06-25 TSUCHIYA Masatoshi + + * lisp/gnus-namazu.el (gnus-namazu/truncate-article-list): When + `gnus-large-newsgroup' is equal to nil, no confirmation is + required. + 2002-06-23 Tetsuo Tsukamoto * lisp/pop3.el (pop3-open-ssl-stream): Do away with w32-related workaround I installed on 1999-12-27, i.e. also call `as-binary-process' in windows-nt. +2002-06-12 Katsumi Yamaoka + + * lisp/message.el (message-send): Kill `message-encoding-buffer' + even if sending failed. + 2002-06-11 Katsumi Yamaoka * lisp/gnus-vers.el (gnus-revision-number): Increment to 02. @@ -47,6 +158,36 @@ `gnus-message-setup-hook'. (gnus-summary-resend-bounced-mail): Ditto. + * lisp/dns.el (dns-make-network-process): Bind + `default-process-coding-system' to `(binary . binary)'; bind + `program-coding-system-alist' to nil. + + * lisp/gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Bind + `input-coding-system' and `output-coding-system' to `binary'. + + * lisp/gnus-namazu.el (gnus-namazu/call-namazu): Bind + `input-coding-system' and `output-coding-system' to the velue of + `gnus-namazu-coding-system'. + + * lisp/imap.el (imap-ssl-open): Don't bind the values for + `input-coding-system' and `output-coding-system'. + + * lisp/nnmaildir.el (nnmaildir-request-scan): Bind + `output-coding-system' to the value of + `nnheader-file-coding-system'; bind `file-coding-system' to nil. + (nnmaildir-request-rename-group): Ditto. + (nnmaildir-request-replace-article): Ditto. + (nnmaildir-request-accept-article): Ditto. + (nnmaildir-request-set-mark): Ditto. + + * lisp/nnmbox.el (nnmbox-save-buffer): Simplify the source code. + + * lisp/nnrss.el (nnrss-read-server-data): Bind + `input-coding-system' to `binary'. + (nnrss-save-server-data): Bind `output-coding-system' to `binary'. + (nnrss-read-group-data): Bind `input-coding-system' to `binary'. + (nnrss-save-group-data): Bind `output-coding-system' to `binary'. + 2002-06-07 Katsumi Yamaoka * lisp/pop3.el: Add a comment for the use of `ssl' or `tls' @@ -67,8 +208,6 @@ * contrib/gpg-ring.el: Remove RCS magic cookie. * lisp/nnir.el: Ditto. - * lisp/sieve-manage.el: Ditto. - * lisp/sieve-mode.el: Ditto. * texi/ptexinfmt.el (texinfo-discard-command-and-arg): New function. @@ -79,6 +218,12 @@ 2.3. Support @., @:, @-. (texinfo-format-inforef): New function. +2002-05-30 Katsumi Yamaoka + + * lisp/nnheader.el (nnheader-unfold-fws): New function copied from + `ietf-drums-unfold-fws'. + (ietf-drums-unfold-fws): Alias to `nnheader-unfold-fws'. + 2002-04-30 Daiki Ueno * lisp/message.el (message-expand-name-function): New user option. diff --git a/GNUS-NEWS b/GNUS-NEWS index 83e5448..ea07a21 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". @@ -173,8 +183,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/README.T-gnus b/README.T-gnus index de5137f..9a7b903 100644 --- a/README.T-gnus +++ b/README.T-gnus @@ -33,6 +33,6 @@ NEWS: * T-gnus 6.15 - this is based on Oort Gnus. - The latest T-gnus is T-gnus 6.15.6 (based on Oort Gnus 0.06). It + The latest T-gnus is T-gnus 6.15.7 (based on Oort Gnus 0.07). It requires SEMI/WEMI (1.13.5 or later), FLIM (1.13.1 or later), and APEL (10.0 or later). 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..ccdd314 --- /dev/null +++ b/contrib/hashcash.el @@ -0,0 +1,120 @@ +;;; hashcash.el --- Add hashcash payments to email + +;; $Revision: 1.1.4.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: + +(eval-when-compile (require 'cl)) + +(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 (substring addr 0 (match-beginning 1)) + (substring addr (match-end 1))) + addr)) + +(defun hashcash-payment-required (addr) + "Return the hashcash payment value required for the given address." + (let ((val (assoc addr hashcash-payment-alist))) + (if val + (if (cddr val) + (caddr val) + (cadr val)) + hashcash-default-payment))) + +(defun hashcash-payment-to (addr) + "Return the string with which hashcash payments should collide." + (let ((val (assoc addr hashcash-payment-alist))) + (if val + (if (cddr val) + (cadr val) + (car val)) + addr))) + +(defun hashcash-generate-payment (str val) + "Generate a hashcash payment by finding a VAL-bit collison on STR." + (if (> val 0) + (save-excursion + (set-buffer (get-buffer-create " *hashcash*")) + (erase-buffer) + (call-process hashcash 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)) + (re-search-forward (concat "^\\(" + (regexp-quote mail-header-separator) + "\\)?$")) + (beginning-of-line) + (narrow-to-region (point-min) (point)) + (let ((to (hashcash-strip-quoted-names (mail-fetch-field "To" nil t))) + (cc (hashcash-strip-quoted-names (mail-fetch-field "Cc" nil t))) + (ng (hashcash-strip-quoted-names + (mail-fetch-field "Newsgroups" nil t)))) + (when to + (setq addrlist (split-string to ",[ \t\n]*"))) + (when cc + (setq addrlist (nconc addrlist (split-string cc ",[ \t\n]*")))) + (when ng + (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*"))))) + (while addrlist + (hashcash-insert-payment (pop addrlist)))))) + t) + +(provide 'hashcash) + +;;; hashcash.el ends here diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 452beb9..ec6c07f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,536 @@ +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. @@ -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/dns.el b/lisp/dns.el index 475909a..76f6bb7 100644 --- a/lisp/dns.el +++ b/lisp/dns.el @@ -287,7 +287,9 @@ If TCP-P, the first two bytes of the package with be the length field." (open-network-stream "dns" (current-buffer) ,server "domain" 'udp)) `(let ((server ,server) (coding-system-for-read 'binary) - (coding-system-for-write 'binary)) + (coding-system-for-write 'binary) + (default-process-coding-system '(binary . binary)) + program-coding-system-alist) (if (fboundp 'make-network-process) (make-network-process :name "dns" diff --git a/lisp/flow-fill.el b/lisp/flow-fill.el index dfe09c2..5dca163 100644 --- a/lisp/flow-fill.el +++ b/lisp/flow-fill.el @@ -134,11 +134,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 d945cac..b864b27 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -640,8 +640,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." @@ -651,7 +655,8 @@ be a select method." (file-name-coding-system nnmail-pathname-coding-system) (pathname-coding-system nnmail-pathname-coding-system)) (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers") - (prin1 gnus-agent-covered-methods (current-buffer))))) + (prin1 (mapcar 'gnus-method-simplify gnus-agent-covered-methods) + (current-buffer))))) ;;; ;;; Summary commands @@ -1660,15 +1665,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 @@ -1676,8 +1686,8 @@ The following commands are available: (while (setq gnus-command-method (pop methods)) (when (file-exists-p (gnus-agent-lib-file "active")) (with-temp-buffer - (insert-file-contents-as-coding-system - gnus-agent-file-coding-system (gnus-agent-lib-file "active")) + (let ((nnheader-file-coding-system gnus-agent-file-coding-system)) + (nnheader-insert-file-contents (gnus-agent-lib-file "active"))) (gnus-active-to-gnus-format gnus-command-method (setq orig (gnus-make-hashtable @@ -1688,174 +1698,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)))) - (gnus-uncompress-range - (cdr (assq 'save (gnus-info-marks info)))) - (gnus-uncompress-range - (cdr (assq 'reply (gnus-info-marks info))))) - nov-file (gnus-agent-article-name ".overview" group) - lowest nil - highest nil) - (gnus-agent-load-alist group) - (gnus-message 5 "Expiring articles in %s" group) - (set-buffer overview) - (erase-buffer) - (when (file-exists-p nov-file) - (nnheader-insert-file-contents nov-file)) - (goto-char (point-min)) - (setq article 0) - (while (setq elem (pop articles)) - (setq article (car elem)) - (when (or (null low) - (< article low) - gnus-agent-expire-all - (and (not (memq article unreads)) - (not (memq article marked)))) - ;; Find and nuke the NOV line. - (while (and (not (eobp)) - (or (not (numberp - (setq art (read (current-buffer))))) - (< art article))) - (if (and (numberp art) - (file-exists-p - (gnus-agent-article-name - (number-to-string art) group))) - (progn - (unless lowest - (setq lowest art)) - (setq highest art) - (forward-line 1)) - ;; Remove old NOV lines that have no articles. - (gnus-delete-line))) - (if (or (eobp) - (/= art article)) - (beginning-of-line) - (gnus-delete-line)) - ;; Nuke the article. - (when (file-exists-p - (setq file (gnus-agent-article-name - (number-to-string article) - group))) - (delete-file file)) - ;; Schedule the history line for nuking. - (push (cdr elem) histories))) - (gnus-make-directory (file-name-directory nov-file)) - (write-region-as-coding-system - gnus-agent-file-coding-system - (point-min) (point-max) nov-file nil 'silent) - ;; Delete the unwanted entries in the alist. - (setq gnus-agent-article-alist - (sort gnus-agent-article-alist 'car-less-than-car)) - (let* ((alist gnus-agent-article-alist) - (prev (cons nil alist)) - (first prev) - expired) - (while (and alist - (<= (caar alist) article)) - (if (or (not (cdar alist)) - (not (file-exists-p - (gnus-agent-article-name - (number-to-string - (caar alist)) - group)))) + (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)) + (write-region-as-coding-system + gnus-agent-file-coding-system + (point-min) (point-max) nov-file nil 'silent) + ;; Delete the unwanted entries in the alist. + (setq gnus-agent-article-alist + (sort gnus-agent-article-alist 'car-less-than-car)) + (let* ((alist gnus-agent-article-alist) + (prev (cons nil alist)) + (first prev) + expired) + (while (and alist + (<= (caar alist) article)) + (if (or (not (cdar alist)) + (not (file-exists-p + (gnus-agent-article-name + (number-to-string + (caar alist)) + group)))) + (progn + (push (caar alist) expired) + (setcdr prev (setq alist (cdr alist)))) + (setq prev alist + alist (cdr alist)))) + (setq gnus-agent-article-alist (cdr first)) + (gnus-agent-save-alist group) + ;; Mark all articles up to the first article + ;; in `gnus-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 7ab2441..163c87b 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -322,6 +322,7 @@ directly.") '(("\\*" "\\*" bold) ("_" "_" underline) ("/" "/" italic) + ("-" "-" strikethru) ("_/" "/_" underline-italic) ("_\\*" "\\*_" underline-bold) ("\\*/" "/\\*" bold-italic) @@ -387,7 +388,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 @@ -1388,8 +1393,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.") @@ -1695,91 +1700,6 @@ always hide." (point-max))) 'boring-headers)))) -(defun article-toggle-headers (&optional arg) - "Toggle hiding of headers. If given a negative prefix, always show; -if given a positive prefix, always hide." - (interactive (gnus-article-hidden-arg)) - (let ((force (when (numberp arg) - (cond ((> arg 0) 'always-hide) - ((< arg 0) 'always-show)))) - (window (get-buffer-window gnus-article-buffer)) - (header-end (point-min)) - header-start field-end field-start - (inhibit-point-motion-hooks t) - (inhibit-read-only t)) - (save-restriction - (widen) - (while (and (setq header-start - (text-property-any header-end (point-max) - 'article-treated-header t)) - (setq header-end - (text-property-not-all header-start (point-max) - 'article-treated-header t))) - (setq field-end header-start) - (cond - (;; Hide exposed invisible fields. - (and (not (eq 'always-show force)) - (setq field-start - (text-property-any field-end header-end - 'exposed-invisible-field t))) - (while (and field-start - (setq field-end (text-property-not-all - field-start header-end - 'exposed-invisible-field t))) - (add-text-properties field-start field-end gnus-hidden-properties) - (setq field-start (text-property-any field-end header-end - 'exposed-invisible-field t))) - (put-text-property header-start header-end - 'exposed-invisible-field nil)) - (;; Expose invisible fields. - (and (not (eq 'always-hide force)) - (setq field-start - (text-property-any field-end header-end 'invisible t))) - (while (and field-start - (setq field-end (text-property-not-all - field-start header-end - 'invisible t))) - ;; If the invisible text is not terminated with newline, we - ;; won't expose it. Because it may be created by x-face-mule. - ;; BTW, XEmacs sometimes fail in putting an invisible text - ;; property with `gnus-article-hide-text' (really?). In that - ;; case, the invisible text might be started from the middle of - ;; a line, so we will expose the sort of thing. - (when (or (not (or (eq header-start field-start) - (eq ?\n (char-before field-start)))) - (eq ?\n (char-before field-end)) - ;; Expose a boundary line anyway. - (string-equal - "\nX-Boundary: " - (buffer-substring (max (- field-end 13) header-start) - field-end))) - (remove-text-properties field-start field-end - gnus-hidden-properties) - (put-text-property field-start field-end - 'exposed-invisible-field t)) - (setq field-start (text-property-any field-end header-end - 'invisible t)))) - (;; Hide fields. - (not (eq 'always-show force)) - (narrow-to-region header-start header-end) - (article-hide-headers) - ;; Re-display X-Face image under XEmacs. - (when (and (featurep 'xemacs) - (gnus-functionp gnus-article-x-face-command)) - (let ((func (cadr (assq 'gnus-treat-display-xface - gnus-treatment-function-alist))) - (condition 'head)) - (when (and (not gnus-inhibit-treatment) - func - (gnus-treat-predicate gnus-treat-display-xface)) - (funcall func) - (put-text-property header-start header-end 'read-only nil)))) - (widen)) - )) - (goto-char (point-min)) - (when window - (set-window-start window (point-min)))))) - (defvar gnus-article-normalized-header-length 40 "Length of normalized headers.") @@ -2297,7 +2217,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. @@ -2910,7 +2833,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 T-gnus)" date)))) (defun article-date-local (&optional highlight) "Convert the current article date to the local timezone." @@ -3481,7 +3404,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-verify-cancel-lock article-monafy article-hide-boring-headers - article-toggle-headers article-treat-overstrike article-fill-long-lines article-capitalize-sentences @@ -3591,7 +3513,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is gnus-article-treatment-menu gnus-article-mode-map "" ;; Fixme: this should use :active (and maybe :visible). '("Treatment" - ["Hide headers" gnus-article-toggle-headers t] + ["Hide headers" gnus-article-hide-headers t] ["Hide signature" gnus-article-hide-signature t] ["Hide citation" gnus-article-hide-citation t] ["Treat overstrike" gnus-article-treat-overstrike t] @@ -5408,6 +5330,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)) @@ -5426,7 +5350,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) @@ -5434,10 +5359,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 69dc0d7..207f096 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -342,7 +342,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 65ce313..927abba 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 @@ -260,6 +260,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) @@ -519,7 +524,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 8a4d70a..b06a122 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -75,20 +75,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-fun.el b/lisp/gnus-fun.el index 4589fd7..fa2b54f 100644 --- a/lisp/gnus-fun.el +++ b/lisp/gnus-fun.el @@ -122,6 +122,8 @@ Output to the current buffer, replace text, and don't mingle error." (ok-p t) (coding-system-for-read 'binary) (coding-system-for-write 'binary) + (input-coding-system 'binary) + (output-coding-system 'binary) default-enable-multibyte-characters start bit-array bit-arrays pixel) (with-temp-buffer diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 10631dc..9e153b1 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -175,10 +175,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 330b300..fc8fc33 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -398,6 +398,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)) @@ -484,17 +485,26 @@ 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) diff --git a/lisp/gnus-logic.el b/lisp/gnus-logic.el index b9b7fbb..20fe9e0 100644 --- a/lisp/gnus-logic.el +++ b/lisp/gnus-logic.el @@ -179,7 +179,7 @@ (defun gnus-advanced-integer (index match type) (if (not (memq type '(< > <= >= =))) (error "No such integer score type: %s" type) - (funcall type match (or (aref gnus-advanced-headers index) 0)))) + (funcall type (or (aref gnus-advanced-headers index) 0) match))) (defun gnus-advanced-date (index match type) (let ((date (apply 'encode-time (parse-time-string diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index bcfedf6..6bf7aaf 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -241,11 +241,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 @@ -492,6 +506,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 @@ -521,6 +537,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 @@ -552,7 +570,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) @@ -564,6 +584,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 @@ -593,6 +615,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 @@ -624,7 +648,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))) @@ -650,7 +676,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." @@ -699,7 +726,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 @@ -1091,51 +1121,59 @@ 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))) - (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))) + (message-reply nil wide) + (when yank + (gnus-inews-yank-articles yank)) + (gnus-summary-handle-replysign))))) + +(defun gnus-summary-handle-replysign () + "Check the various replysign variables and take action accordingly." + (when nil;;(or gnus-message-replysign gnus-message-replyencrypt) + (let (signed encrypted) + (save-excursion + (set-buffer gnus-article-buffer) + (setq signed (memq 'signed gnus-article-wash-types)) + (setq encrypted (memq 'encrypted gnus-article-wash-types))) + (cond ((and gnus-message-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. @@ -1275,7 +1313,8 @@ forward those articles instead." (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-namazu.el b/lisp/gnus-namazu.el index 6883870..4940d6c 100644 --- a/lisp/gnus-namazu.el +++ b/lisp/gnus-namazu.el @@ -1,4 +1,4 @@ -;;; gnus-namazu.el --- Search mail with Namazu. -*- coding: iso-2022-7bit; -*- +;;; gnus-namazu.el --- Search mail with Namazu -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 2000,2001,2002 TSUCHIYA Masatoshi @@ -26,43 +26,71 @@ ;;; Commentary: ;; This file defines the command to search mails and persistent -;; articles with Namazu and browse its results with Gnus. This module -;; requires the external command, Namazu. Visit the following page -;; for more information. +;; articles with Namazu and to browse its results with Gnus. +;; +;; Namazu is a full-text search engine intended for easy use. For +;; more detail about Namazu, visit the following page: ;; ;; http://namazu.org/ +;;; Quick Start: + +;; If this module has already been installed, only 3 steps are +;; required to search articles with this module. +;; +;; (1) Install Namazu. +;; (2) Start Gnus and type M-x gnus-namazu-create-index RET to make +;; index of articles. +;; (3) In group buffer or in summary buffer, type C-c C-n query RET. + + ;;; Install: -;; Make index of articles with Namzu before using this module. +;; Before installing this module, you must install Namazu. +;; +;; This file is a part of T-gnus but is not *YET* a part of Gnus. +;; When you would like to use this module in Gnus (not T-gnus), put +;; this file into the lisp/ directory in the Gnus source tree and run +;; `make install'. And then, put the following expression into your +;; ~/.gnus. +;; +;; (require 'gnus-namazu) +;; (gnus-namazu-insinuate) ;; -;; % mkdir ~/News/namazu -;; % mknmz -a -h -O ~/News/namazu ~/Mail ~/News/cache +;; In order to make index of articles with Namazu before using this +;; module, type M-x gnus-namazu-create-index RET. Otherwise, you can +;; create index by yourself with the following commands: +;; +;; % mkdir ~/News/namazu +;; % mknmz -a -h -O ~/News/namazu ~/Mail ~/News/cache ;; ;; The first command makes the directory for index files, and the ;; second command generates index files of mails and persistent ;; articles. ;; -;; When you put index files of Namazu into the directory other than -;; the default one (~/News/namazu), it is necessary to put this -;; expression to your ~/.gnus, in order to set the path of index files -;; to `gnus-namazu-index-directories'. +;; In order to update indices for incoming articles, this module +;; automatically runs mknmz, the indexer of Namazu, at an interval of +;; 3 days; this period is set to `gnus-namazu-index-update-interval'. ;; -;; (setq gnus-namazu-index-directories -;; (list (expand-file-name "~/namazu"))) +;; Indices will be updated when `gnus-namazu-search' is called. If +;; you want to update indices everywhen Gnus is started, you can put +;; the following expression to your ~/.gnus. ;; -;; If you would like to use this module in Gnus (not T-gnus), put this -;; file into the lisp/ directory in the Gnus source tree and run `make -;; install'. And then, put the following expressions into your ~/.gnus. +;; (add-hook 'gnus-startup-hook 'gnus-namazu-update-all-indices) ;; -;; (require 'gnus-namazu) -;; (gnus-namazu-insinuate) - - -;;; Usage: - -;; In group buffer or in summary buffer, type C-c C-n query RET. +;; In order to control mknmz closely, disable the automatic updating +;; feature and run mknmz by yourself. In this case, set nil to the +;; above option. +;; +;; (setq gnus-namazu-index-update-interval nil) +;; +;; When your index is put into the directory other than the default +;; one (~/News/namazu), it is necessary to set its place to +;; `gnus-namazu-index-directories' as follows: +;; +;; (setq gnus-namazu-index-directories +;; (list (expand-file-name "~/namazu"))) ;;; Code: @@ -80,9 +108,7 @@ ;; To suppress byte-compile warning. (eval-when-compile (defvar nnml-directory) - (defvar nnml-group-alist) - (defvar nnmh-directory) - (defvar nnmh-group-alist)) + (defvar nnmh-directory)) (defgroup gnus-namazu nil @@ -91,14 +117,18 @@ :group 'gnus :prefix "gnus-namazu-") +(defconst gnus-namazu-default-index-directory + (expand-file-name "namazu" gnus-directory) + "Default place of Namazu index files.") + (defcustom gnus-namazu-index-directories (list (or (and (boundp 'gnus-namazu-index-directory) (symbol-value 'gnus-namazu-index-directory)) (and (boundp 'nnir-namazu-index-directory) (symbol-value 'nnir-namazu-index-directory)) - (expand-file-name "namazu" gnus-directory))) - "*Index directory of Namazu." + gnus-namazu-default-index-directory)) + "*Places of Namazu index files." :type '(repeat directory) :group 'gnus-namazu) @@ -109,8 +139,8 @@ (symbol-value 'nnir-namazu-program)) "namazu") "*Name of the executable file of Namazu." - :group 'gnus-namazu - :type 'string) + :type 'string + :group 'gnus-namazu) (defcustom gnus-namazu-additional-arguments nil "*Additional arguments of Namazu. @@ -119,6 +149,30 @@ options make any sense in this context." :type '(repeat string) :group 'gnus-namazu) +(defcustom gnus-namazu-index-update-interval + 259200 ; 3 days == 259200 seconds. + "*Number of seconds between running the indexer of Namazu." + :type '(choice (const :tag "Never run the indexer" nil) + (integer :tag "Number of seconds")) + :group 'gnus-namazu) + +(defcustom gnus-namazu-make-index-command "mknmz" + "*Name of the executable file of the indexer of Namazu." + :type 'string + :group 'gnus-namazu) + +(defcustom gnus-namazu-make-index-arguments + (nconc + (list "--all" "--mailnews" "--deny=^.*[^0-9].*$") + (when (or (and (boundp 'current-language-environment) + (string= "Japanese" + (symbol-value 'current-language-environment))) + (boundp 'MULE)) + (list "--indexing-lang=ja"))) + "*Arguments of the indexer of Namazu." + :type '(repeat string) + :group 'gnus-namazu) + (defcustom gnus-namazu-field-keywords '("date" "from" "newsgroups" "size" "subject" "summary" "to" "uri") "*List of keywords to do field-search." @@ -134,8 +188,8 @@ options make any sense in this context." :group 'gnus-namazu) (defcustom gnus-namazu-need-path-normalization - (eq system-type 'windows-nt) - "*Non-nil means that outputs of namazu may contain a not normalized path." + (and (memq system-type '(windows-nt OS/2 emx)) t) + "*Non-nil means that outputs of namazu may contain drive letters." :type 'boolean :group 'gnus-namazu) @@ -194,6 +248,12 @@ options make any sense in this context." (gnus-servers-using-backend 'nnml) (gnus-servers-using-backend 'nnmh))) +(defsubst gnus-namazu/default-index-directory () + (if (member gnus-namazu-default-index-directory + gnus-namazu-index-directories) + gnus-namazu-default-index-directory + (car gnus-namazu-index-directories))) + (defun gnus-namazu/setup () (and (boundp 'gnus-group-name-charset-group-alist) (not (member (cons gnus-namazu/group-name-regexp @@ -205,17 +265,8 @@ options make any sense in this context." (setcdr pair gnus-namazu-coding-system) (push (cons gnus-namazu/group-name-regexp gnus-namazu-coding-system) - gnus-group-name-charset-group-alist))))) - -(defun gnus-namazu/request-list (server) - "Return groups of the server SERVER." - (and (memq (car server) '(nnml nnmh)) - (nnoo-change-server (car server) (nth 1 server) (nthcdr 2 server)) - (gnus-request-list server) - (mapcar (function car) - (if (eq 'nnml (car server)) - nnml-group-alist - nnmh-group-alist)))) + gnus-group-name-charset-group-alist)))) + (gnus-namazu-update-all-indices)) (defun gnus-namazu/server-directory (server) "Return the top directory of the server SERVER." @@ -231,6 +282,8 @@ options make any sense in this context." "Normalize file names returned by Namazu in this current buffer." (goto-char (point-min)) (while (not (eobp)) + (when (looking-at "file://") + (delete-region (point) (match-end 0))) (when (if gnus-namazu-need-path-normalization (or (not (looking-at "/\\(.\\)|/")) (replace-match "\\1:/")) @@ -243,8 +296,11 @@ options make any sense in this context." (defsubst gnus-namazu/call-namazu (query) (let ((coding-system-for-read gnus-namazu-coding-system) (coding-system-for-write gnus-namazu-coding-system) + (input-coding-system gnus-namazu-coding-system) + (output-coding-system gnus-namazu-coding-system) (default-process-coding-system (cons gnus-namazu-coding-system gnus-namazu-coding-system)) + program-coding-system-alist (file-name-coding-system gnus-namazu-coding-system) (pathname-coding-system gnus-namazu-coding-system)) (apply 'call-process @@ -272,17 +328,17 @@ options make any sense in this context." gnus-newsrc-hashtb) orig)))) -(defun gnus-namazu/check-cache-group (str) - "Get the news group from the partial path STR of the cached article." - (if (gnus-use-long-file-name 'not-cache) +(defun gnus-namazu/real-group-name (cond str) + "Generate the real group name from the partial path, STR." + (if cond str (catch 'found-group - (dolist (group (gnus-namazu/cache-group-candidates + (dolist (group (gnus-namazu/possible-real-groups (nnheader-replace-chars-in-string str ?/ ?.))) (when (gnus-gethash group gnus-newsrc-hashtb) (throw 'found-group group)))))) -(defun gnus-namazu/cache-group-candidates (str) +(defun gnus-namazu/possible-real-groups (str) "Regard the string STR as the partial path of the cached article and generate possible group names from it." (if (string-match "_\\(_\\(_\\)?\\)?" str) @@ -291,14 +347,14 @@ generate possible group names from it." (cond ((match-beginning 2) ;; The number of discoverd underscores = 3 (nconc - (gnus-namazu/cache-group-candidates (concat prefix "/__" suffix)) - (gnus-namazu/cache-group-candidates (concat prefix ".._" suffix)))) + (gnus-namazu/possible-real-groups (concat prefix "/__" suffix)) + (gnus-namazu/possible-real-groups (concat prefix ".._" suffix)))) ((match-beginning 1) ;; The number of discoverd underscores = 2 (nconc - (gnus-namazu/cache-group-candidates (concat prefix "//" suffix)) - (gnus-namazu/cache-group-candidates (concat prefix ".." suffix)))) + (gnus-namazu/possible-real-groups (concat prefix "//" suffix)) + (gnus-namazu/possible-real-groups (concat prefix ".." suffix)))) (t ;; The number of discoverd underscores = 1 - (gnus-namazu/cache-group-candidates (concat prefix "/" suffix))))) + (gnus-namazu/possible-real-groups (concat prefix "/" suffix))))) (if (string-match "\\." str) ;; Handle the first occurence of period. (list (concat (substring str 0 (match-beginning 0)) @@ -326,6 +382,11 @@ generate possible group names from it." (regexp-quote (file-name-as-directory (expand-file-name gnus-cache-directory))) + "\\(.*\\)/\\([0-9]+\\)$")) + (agent-regexp (concat + (regexp-quote + (file-name-as-directory + (expand-file-name gnus-agent-directory))) "\\(.*\\)/\\([0-9]+\\)$"))) (gnus-namazu/normalize-results) (goto-char (point-min)) @@ -335,7 +396,14 @@ generate possible group names from it." ;; Check the discoverd file is the persistent article. (and (looking-at cache-regexp) (setq file (match-string-no-properties 2) - group (gnus-namazu/check-cache-group + group (gnus-namazu/real-group-name + (gnus-use-long-file-name 'not-cache) + (match-string-no-properties 1)))) + ;; Check the discoverd file is covered by the agent. + (and (looking-at agent-regexp) + (setq file (match-string-no-properties 2) + group (gnus-namazu/real-group-name + nnmail-use-long-file-names (match-string-no-properties 1)))) ;; Check the discovered file is managed by Gnus servers. (and (looking-at topdir-regexp) @@ -350,7 +418,10 @@ generate possible group names from it." file (match-string 1 file)) (setq group (gnus-namazu/group-prefixed-name - (nnheader-replace-chars-in-string group ?/ ?.) + (if nnmail-use-long-file-names + group + (nnheader-replace-chars-in-string group + ?/ ?.)) server))))) (or (not groups) (member group groups)) @@ -418,6 +489,15 @@ generate possible group names from it." (mail-header-from (gnus-summary-article-header)))))))) +(defun gnus-namazu/get-current-to () + (and gnus-namazu/read-query-original-buffer + (bufferp gnus-namazu/read-query-original-buffer) + (with-current-buffer gnus-namazu/read-query-original-buffer + (when (eq major-mode 'gnus-summary-mode) + (cadr (mail-extract-address-components + (cdr (assq 'To (mail-header-extra + (gnus-summary-article-header)))))))))) + (defmacro gnus-namazu/minibuffer-prompt-end () (if (fboundp 'minibuffer-prompt-end) '(minibuffer-prompt-end) @@ -485,6 +565,13 @@ generate possible group names from it." (when f (goto-char pos) (insert "\"" f "\"") + (setq pos (point))))) + ((and (looking-at "\\+to:") + (= pos (match-end 0))) + (let ((to (gnus-namazu/get-current-to))) + (when to + (goto-char pos) + (insert "\"" to "\"") (setq pos (point)))))) (goto-char pos))) @@ -597,6 +684,186 @@ and make a virtual group contains its results." '<))) (message "No entry.")))) +(defmacro gnus-namazu/lock-file-name (&optional directory) + `(expand-file-name "NMZ.lock2" ,directory)) + +(defmacro gnus-namazu/status-file-name (&optional directory) + `(expand-file-name "NMZ.status" ,directory)) + +(defmacro gnus-namazu/index-file-name (&optional directory) + `(expand-file-name "NMZ.i" ,directory)) + +(defun gnus-namazu/mknmz-cleanup (directory) + (let ((lockfile (gnus-namazu/lock-file-name directory))) + (when (file-exists-p lockfile) + (delete-file lockfile) + (dolist (tmpfile (directory-files directory t "\\`NMZ\\..*\\.tmp\\'" t)) + (delete-file tmpfile))))) + +;;;###autoload +(defun gnus-namazu-create-index (directory &optional target-directories force) + "Create index under DIRECTORY." + (interactive + (list + (if (and current-prefix-arg (> (length gnus-namazu-index-directories) 1)) + (completing-read "Directory: " + (mapcar 'list gnus-namazu-index-directories) nil t) + (gnus-namazu/default-index-directory)) + nil t)) + (setq directory (file-name-as-directory (expand-file-name directory))) + (unless target-directories + (setq target-directories + (delq nil + (mapcar (lambda (dir) + (when (file-directory-p dir) dir)) + (append + (mapcar 'gnus-namazu/server-directory + (gnus-namazu/indexed-servers)) + (list + (expand-file-name gnus-cache-directory) + (expand-file-name gnus-agent-directory))))))) + (if (file-exists-p (gnus-namazu/lock-file-name directory)) + (when force + (error "Found lock file: %s" (gnus-namazu/lock-file-name directory))) + (with-current-buffer + (get-buffer-create (concat " *mknmz*" directory)) + (erase-buffer) + (unless (file-directory-p directory) + (make-directory directory t)) + (setq default-directory directory) + (let ((args (append gnus-namazu-make-index-arguments + target-directories))) + (insert "% " gnus-namazu-make-index-command " " + (mapconcat 'identity args " ") "\n") + (goto-char (point-max)) + (when force + (pop-to-buffer (current-buffer))) + (message "Make index at %s..." directory) + (unwind-protect + (apply 'call-process gnus-namazu-make-index-command nil t t args) + (gnus-namazu/mknmz-cleanup directory)) + (message "Make index at %s...done" directory) + (unless force + (kill-buffer (current-buffer))))))) + +(defun gnus-namazu/lapse-seconds (start end) + "Return lapse seconds from START to END. +START and END are lists which represent time in Emacs-style." + (+ (* (- (car end) (car start)) 65536) + (cadr end) + (- (cadr start)))) + +(defun gnus-namazu/index-old-p (directory) + "Return non-nil value when the index under the DIRECTORY is older +than the period that is set to `gnus-namazu-index-update-interval'" + (let ((file (gnus-namazu/index-file-name directory))) + (or (not (file-exists-p file)) + (and (integerp gnus-namazu-index-update-interval) + (>= (gnus-namazu/lapse-seconds + (nth 5 (file-attributes file)) + (current-time)) + gnus-namazu-index-update-interval))))) + +(defvar gnus-namazu/update-directories nil) +(defvar gnus-namazu/update-process nil) + +(defun gnus-namazu/update-p (directory &optional force) + "Return the DIRECTORY when the index undef the DIRECTORY should be updated." + (setq directory (file-name-as-directory (expand-file-name directory))) + (labels ((error-message (format &rest args) + (apply (if force 'error 'message) format args) + nil)) + (if gnus-namazu/update-process + (error-message "%s" "Can not run two update processes simultaneously") + (and (or force + (gnus-namazu/index-old-p directory)) + (let ((status-file (gnus-namazu/status-file-name directory))) + (or (file-exists-p status-file) + (error-message "Can not find status file: %s" status-file))) + (let ((lock-file (gnus-namazu/lock-file-name directory))) + (or (not (file-exists-p lock-file)) + (error-message "Found lock file: %s" lock-file))) + directory)))) + +;;;###autoload +(defun gnus-namazu-update-index (directory &optional force) + "Update the index under the DIRECTORY." + (interactive + (list + (if (and current-prefix-arg (> (length gnus-namazu-index-directories) 1)) + (completing-read "Directory: " + (mapcar 'list gnus-namazu-index-directories) nil t) + (gnus-namazu/default-index-directory)) + t)) + (when (setq directory (gnus-namazu/update-p directory force)) + (with-current-buffer (get-buffer-create (concat " *mknmz*" directory)) + (buffer-disable-undo) + (erase-buffer) + (unless (file-directory-p directory) + (make-directory directory t)) + (setq default-directory directory) + (let ((proc (start-process gnus-namazu-make-index-command + (current-buffer) + gnus-namazu-make-index-command + (format "--update=%s" directory)))) + (if (processp proc) + (prog1 (setq gnus-namazu/update-process proc) + (process-kill-without-query proc) + (set-process-sentinel proc 'gnus-namazu/update-sentinel) + (add-hook 'kill-emacs-hook 'gnus-namazu-stop-update) + (message "Update index at %s..." directory)) + (goto-char (point-min)) + (if (re-search-forward "^ERROR:.*$" nil t) + (progn + (pop-to-buffer (current-buffer)) + (funcall (if force 'error 'message) + "Update index at %s...%s" directory (match-string 0))) + (kill-buffer (current-buffer)) + (funcall (if force 'error 'message) + "Can not start %s" gnus-namazu-make-index-command)) + nil))))) + +;;;###autoload +(defun gnus-namazu-update-all-indices (&optional directories force) + "Update all indices which is set to `gnus-namazu-index-directories'." + (interactive (list nil t)) + (when (setq directories + (delq nil (mapcar + (lambda (d) (gnus-namazu/update-p d force)) + (or directories gnus-namazu-index-directories)))) + (setq gnus-namazu/update-directories (cdr directories)) + (gnus-namazu-update-index (car directories)))) + +(defun gnus-namazu/update-sentinel (process event) + (let ((buffer (process-buffer process))) + (when (buffer-name buffer) + (with-current-buffer buffer + (gnus-namazu/mknmz-cleanup default-directory) + (goto-char (point-min)) + (cond + ((re-search-forward "^ERROR:.*$" nil t) + (pop-to-buffer (current-buffer)) + (message "Update index at %s...%s" + default-directory (match-string 0)) + (setq gnus-namazu/update-directories nil)) + ((and (eq 'exit (process-status process)) + (zerop (process-exit-status process))) + (message "Update index at %s...done" default-directory) + (unless (or debug-on-error debug-on-quit) + (kill-buffer buffer))))))) + (setq gnus-namazu/update-process nil) + (when gnus-namazu/update-directories + (gnus-namazu-update-all-indices gnus-namazu/update-directories))) + +;;;###autoload +(defun gnus-namazu-stop-update () + "Stop the running indexer of Namazu." + (interactive) + (setq gnus-namazu/update-directories nil) + (and gnus-namazu/update-process + (processp gnus-namazu/update-process) + (kill-process gnus-namazu/update-process))) + (let (current-load-list) (defadvice gnus-offer-save-summaries (before gnus-namazu-kill-summary-buffers activate compile) @@ -614,6 +881,7 @@ is called." (kill-buffer (car buffers))) (setq buffers (cdr buffers)))))) +;;;###autoload (defun gnus-namazu-insinuate () (add-hook 'gnus-group-mode-hook diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el index 15b6fb9..44f45f1 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 cf4b856..14725c5 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -812,7 +812,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) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 9cfd3a7..3834da6 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -54,7 +54,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) @@ -147,8 +147,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)) @@ -567,7 +568,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." @@ -670,7 +671,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." @@ -680,6 +682,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) @@ -699,7 +702,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 @@ -711,6 +715,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 '+ @@ -1179,6 +1184,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) @@ -1223,6 +1229,9 @@ end position and text.") (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.") @@ -1311,6 +1320,7 @@ end position and text.") 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 @@ -1380,6 +1390,13 @@ buffers. 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) @@ -1562,6 +1579,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 @@ -1590,7 +1608,7 @@ increase the score of each group you read." "i" gnus-summary-news-other-window "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article - "t" gnus-article-toggle-headers + "t" gnus-summary-toggle-header "g" gnus-summary-show-article "l" gnus-summary-goto-last-article "v" gnus-summary-preview-mime-message @@ -1758,7 +1776,7 @@ increase the score of each group you read." "f" gnus-article-display-x-face "l" gnus-summary-stop-page-breaking "r" gnus-summary-caesar-message - "t" gnus-article-toggle-headers + "t" gnus-summary-toggle-header "g" gnus-treat-smiley "v" gnus-summary-verbose-headers "m" gnus-summary-toggle-mime @@ -1769,7 +1787,7 @@ increase the score of each group you read." (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) "a" gnus-article-hide - "h" gnus-article-toggle-headers + "h" gnus-article-hide-headers "b" gnus-article-hide-boring-headers "s" gnus-article-hide-signature "c" gnus-article-hide-citation @@ -1917,6 +1935,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) @@ -1955,7 +1997,7 @@ increase the score of each group you read." (let ((innards `(("Hide" ["All" gnus-article-hide t] - ["Headers" gnus-article-toggle-headers t] + ["Headers" gnus-article-hide-headers t] ["Signature" gnus-article-hide-signature t] ["Citation" gnus-article-hide-citation t] ["List identifiers" gnus-article-hide-list-identifiers t] @@ -1982,27 +2024,28 @@ 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] @@ -2283,6 +2326,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] @@ -2700,6 +2744,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)))) @@ -2805,6 +2850,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)) @@ -2945,6 +2991,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) @@ -2967,6 +3014,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 @@ -3648,7 +3696,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) @@ -3691,7 +3739,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) @@ -3701,10 +3750,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)) @@ -4212,6 +4261,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) @@ -4404,7 +4462,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 @@ -4493,7 +4551,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 @@ -4501,8 +4560,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)) @@ -4563,15 +4621,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))) @@ -4656,7 +4712,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) @@ -4941,6 +4997,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) @@ -7835,8 +7893,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 @@ -8396,35 +8454,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." @@ -8941,6 +9003,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 @@ -9382,6 +9445,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. @@ -9413,6 +9477,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)) @@ -9420,6 +9485,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 @@ -9472,6 +9541,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))) @@ -9546,6 +9616,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. @@ -9561,6 +9632,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)) @@ -9572,6 +9644,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))) @@ -9785,6 +9860,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 @@ -10216,6 +10292,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. @@ -11317,7 +11399,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 @@ -11350,13 +11432,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 b7d054d..d356c31 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -381,9 +381,17 @@ If RECURSIVE is t, return groups in its subtopics too." "Compute the group parameters for GROUP taking into account inheritance from topics." (let ((params-list (copy-sequence (gnus-group-get-parameter group)))) (save-excursion - (gnus-group-goto-group group) (nconc params-list - (gnus-topic-hierarchical-parameters (gnus-current-topic)))))) + (gnus-topic-hierarchical-parameters + ;; First we try to go to the group within the group + ;; buffer and find the topic for the group that way. + ;; This hopefully copes well with groups that are in + ;; more than one topic. Failing that (i.e. when the + ;; group isn't visible in the group buffer) we find a + ;; topic for the group via gnus-group-topic. + (or (and (gnus-group-goto-group group) + (gnus-current-topic)) + (gnus-group-topic group))))))) (defun gnus-topic-hierarchical-parameters (topic) "Return a topic list computed for TOPIC." @@ -1522,7 +1530,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)))))) @@ -1541,7 +1549,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-vers.el b/lisp/gnus-vers.el index d6bdf4a..117fcbe 100644 --- a/lisp/gnus-vers.el +++ b/lisp/gnus-vers.el @@ -34,16 +34,16 @@ (require 'product) (provide 'gnus-vers) -(defconst gnus-revision-number "02" +(defconst gnus-revision-number "00" "Revision number for this version of gnus.") ;; Product information of this gnus. (product-provide 'gnus-vers (product-define "T-gnus" nil - (list 6 15 6 + (list 6 15 7 (string-to-number gnus-revision-number)))) -(defconst gnus-original-version-number "0.06" +(defconst gnus-original-version-number "0.07" "Version number for this version of Gnus.") (provide 'running-pterodactyl-gnus-0_73-or-later) diff --git a/lisp/gnus.el b/lisp/gnus.el index 8d323f7..b12d258 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1306,7 +1306,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. @@ -1590,6 +1591,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 @@ -1821,7 +1837,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) @@ -1834,7 +1851,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" @@ -2218,8 +2235,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ;; gnus-article-show-all gnus-article-edit-mode gnus-article-edit-article gnus-article-edit-done article-decode-encoded-words - gnus-start-date-timer gnus-stop-date-timer - gnus-article-toggle-headers) + gnus-start-date-timer gnus-stop-date-timer) ("gnus-int" gnus-request-type) ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 gnus-dribble-enter gnus-read-init-file gnus-dribble-touch) @@ -2275,6 +2291,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ;; To search articles with Namazu. (autoload 'gnus-namazu-search "gnus-namazu" nil t) +(autoload 'gnus-namazu-create-index "gnus-namazu" nil t) +(autoload 'gnus-namazu-update-index "gnus-namazu" nil t) +(autoload 'gnus-namazu-update-all-indices "gnus-namazu" nil t) ;; To make nnir groups. (autoload 'gnus-group-make-nnir-group "nnir" nil t) @@ -2520,12 +2539,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 5cf4016..e0fc8a5 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -466,7 +466,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 f87e0a4..fdfc1cb 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -350,7 +350,7 @@ value may go against RFC-1036 and draft-ietf-usefor-article-05.txt. " :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 @@ -1167,27 +1167,51 @@ 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:\\|" - "[Mm]ail-[Cc]opies-[Tt]o:\\|" - "[Mm]ail-[Rr]eply-[Tt]o:\\|" - "[Mm]ail-[Ff]ollowup-[Tt]o:\\)" content) + (,(message-font-lock-make-header-matcher + (concat "^\\([GBF]?[Cc][Cc]:\\|[Rr]eply-[Tt]o:\\|" + "[Mm]ail-[Cc]opies-[Tt]o:\\|" + "[Mm]ail-[Rr]eply-[Tt]o:\\|" + "[Mm]ail-[Ff]ollowup-[Tt]o:\\)" content)) (1 'message-header-name-face) (2 'message-header-cc-face nil t)) - (,(concat "^\\([Ss]ubject:\\)" content) + (,(message-font-lock-make-header-matcher + (concat "^\\([Ss]ubject:\\)" content)) (1 'message-header-name-face) (2 'message-header-subject-face nil t)) - (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content) + (,(message-font-lock-make-header-matcher + (concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)) (1 'message-header-name-face) (2 'message-header-newsgroups-face nil t)) - (,(concat "^\\([A-Z][^: \n\t]+:\\)" content) + (,(message-font-lock-make-header-matcher + (concat "^\\([A-Z][^: \n\t]+:\\)" content)) (1 'message-header-name-face) (2 'message-header-other-face nil t)) - (,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content) + (,(message-font-lock-make-header-matcher + (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content)) (1 'message-header-name-face) (2 'message-header-name-face)) ,@(if (and mail-header-separator @@ -3052,36 +3076,41 @@ It should typically alter the sending method in some way or other." (success t) elem sent dont-barf-on-no-method (message-options message-options)) - (message-options-set-recipient) - (save-excursion - (set-buffer message-encoding-buffer) - (erase-buffer) - ;; ;; Avoid copying text props (except hard newlines). - ;; T-gnus change: copy all text props from the editing buffer - ;; into the encoding buffer. - (insert-buffer-substring message-edit-buffer) - (funcall message-encode-function) - (while (and success - (setq elem (pop alist))) - (when (funcall (cadr elem)) - (when (and (or (not (memq (car elem) - message-sent-message-via)) - (if (or (message-gnksa-enable-p 'multiple-copies) - (not (eq (car elem) 'news))) - (y-or-n-p - (format - "Already sent message via %s; resend? " - (car elem))) - (error "Denied posting -- multiple copies"))) - (setq success (funcall (caddr elem) arg))) - (setq sent t))))) - (unless - (or sent - (not success) - (let ((fcc (message-fetch-field "Fcc")) - (gcc (message-fetch-field "Gcc"))) - (when (or fcc gcc) - (or (eq message-allow-no-recipients 'always) + (unwind-protect + (progn + (message-options-set-recipient) + (save-excursion + (set-buffer message-encoding-buffer) + (erase-buffer) + ;; ;; Avoid copying text props (except hard newlines). + ;; T-gnus change: copy all text props from the editing buffer + ;; into the encoding buffer. + (insert-buffer-substring message-edit-buffer) + (funcall message-encode-function) + (while (and success + (setq elem (pop alist))) + (when (funcall (cadr elem)) + (when (and + (or (not (memq (car elem) + message-sent-message-via)) + (if (or (message-gnksa-enable-p 'multiple-copies) + (not (eq (car elem) 'news))) + (y-or-n-p + (format + "Already sent message via %s; resend? " + (car elem))) + (error "Denied posting -- multiple copies"))) + (setq success (funcall (caddr elem) arg))) + (setq sent t))))) + (unless + (or + sent + (not success) + (let ((fcc (message-fetch-field "Fcc")) + (gcc (message-fetch-field "Gcc"))) + (when (or fcc gcc) + (or + (eq message-allow-no-recipients 'always) (and (not (eq message-allow-no-recipients 'never)) (setq dont-barf-on-no-method (gnus-y-or-n-p @@ -3089,23 +3118,22 @@ It should typically alter the sending method in some way or other." (cond ((and fcc gcc) "Fcc and Gcc") (fcc "Fcc") (t "Gcc")))))))))) - (error "No methods specified to send by")) - (prog1 - (when (or dont-barf-on-no-method - (and success sent)) - (message-do-fcc) - (save-excursion - (run-hooks 'message-sent-hook)) - (message "Sending...done") - ;; Mark the buffer as unmodified and delete auto-save. - (set-buffer-modified-p nil) - (delete-auto-save-file-if-necessary t) - (message-disassociate-draft) - ;; Delete other mail buffers and stuff. - (message-do-send-housekeeping) - (message-do-actions message-send-actions) - ;; Return success. - t) + (error "No methods specified to send by")) + (when (or dont-barf-on-no-method + (and success sent)) + (message-do-fcc) + (save-excursion + (run-hooks 'message-sent-hook)) + (message "Sending...done") + ;; Mark the buffer as unmodified and delete auto-save. + (set-buffer-modified-p nil) + (delete-auto-save-file-if-necessary t) + (message-disassociate-draft) + ;; Delete other mail buffers and stuff. + (message-do-send-housekeeping) + (message-do-actions message-send-actions) + ;; Return success. + t)) (kill-buffer message-encoding-buffer))))) (defun message-send-via-mail (arg) @@ -3457,61 +3485,67 @@ This sub function is for exclusive use of `message-send-mail'." " sendmail errors") 0)) resend-to-addresses delimline) - (let ((case-fold-search t)) - (save-restriction - (message-narrow-to-headers) - (setq resend-to-addresses (message-fetch-field "resent-to"))) - ;; Change header-delimiter to be what sendmail expects. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1) - (setq delimline (point-marker)) - (run-hooks 'message-send-mail-hook) - ;; Insert an extra newline if we need it to work around - ;; Sun's bug that swallows newlines. - (goto-char (1+ delimline)) - (when (eval message-mailer-swallows-blank-line) - (newline)) - (when message-interactive - (save-excursion - (set-buffer errbuf) - (erase-buffer)))) - (let ((default-directory "/")) - (as-binary-process - (apply 'call-process-region - (append (list (point-min) (point-max) - (if (boundp 'sendmail-program) - sendmail-program - "/usr/lib/sendmail") - nil errbuf nil "-oi") - ;; Always specify who from, - ;; since some systems have broken sendmails. - ;; But some systems are more broken with -f, so - ;; we'll let users override this. - (if (null message-sendmail-f-is-evil) - (list "-f" (message-make-address))) - ;; These mean "report errors by mail" - ;; and "deliver in background". - (if (null message-interactive) '("-oem" "-odb")) - ;; Get the addresses from the message - ;; unless this is a resend. - ;; We must not do that for a resend - ;; because we would find the original addresses. - ;; For a resend, include the specific addresses. - (if resend-to-addresses - (list resend-to-addresses) - '("-t")))))) - (when message-interactive - (save-excursion - (set-buffer errbuf) - (goto-char (point-min)) - (while (re-search-forward "\n\n* *" nil t) - (replace-match "; ")) - (if (not (zerop (buffer-size))) - (error "Sending...failed to %s" - (buffer-substring (point-min) (point-max))))) + (unwind-protect + (progn + (let ((case-fold-search t)) + (save-restriction + (message-narrow-to-headers) + (setq resend-to-addresses (message-fetch-field "resent-to"))) + ;; Change header-delimiter to be what sendmail expects. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (backward-char 1) + (setq delimline (point-marker)) + (run-hooks 'message-send-mail-hook) + ;; Insert an extra newline if we need it to work around + ;; Sun's bug that swallows newlines. + (goto-char (1+ delimline)) + (when (eval message-mailer-swallows-blank-line) + (newline)) + (when message-interactive + (save-excursion + (set-buffer errbuf) + (erase-buffer)))) + (let* ((default-directory "/") + (cpr (as-binary-process + (apply + 'call-process-region + (append + (list (point-min) (point-max) + (if (boundp 'sendmail-program) + sendmail-program + "/usr/lib/sendmail") + nil errbuf nil "-oi") + ;; Always specify who from, + ;; since some systems have broken sendmails. + ;; But some systems are more broken with -f, so + ;; we'll let users override this. + (if (null message-sendmail-f-is-evil) + (list "-f" (message-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))))) @@ -4921,6 +4955,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))) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 32ee6e6..5f9cba6 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 @@ -685,9 +694,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 fa44d45..48afccd 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 243e8c2..f1c032c 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 93a595c..fe7afff 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -271,7 +271,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 @@ -281,8 +281,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 405b304..68aa8b3 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 4eb71c2..6950d6c 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 49abfd6..a93f9d2 100644 --- a/lisp/mml1991.el +++ b/lisp/mml1991.el @@ -34,7 +34,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 75af79c..ff6c04d 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -310,9 +310,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 @@ -352,6 +353,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 () @@ -415,10 +417,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) @@ -428,12 +433,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"))) @@ -558,28 +567,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)) @@ -640,11 +663,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 78676fe..8cecb1e 100644 --- a/lisp/nnbabyl.el +++ b/lisp/nnbabyl.el @@ -350,7 +350,7 @@ (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) (delete-region (point) (progn (forward-line 1) (point))))) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) (setq result (if (stringp group) (list (cons group (nnbabyl-active-number group))) @@ -366,7 +366,7 @@ (insert-buffer-substring buf) (when last (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) (save-buffer) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) result)))) diff --git a/lisp/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 143b05e..b675e26 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 591a0bd..013fb40 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -160,7 +160,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) @@ -175,16 +175,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)))))) @@ -491,7 +528,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 b6ca95c..312c274 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -79,7 +79,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: @@ -458,6 +469,18 @@ given, the return value will not contain the last newline." (defalias 'mail-header-field-value 'std11-field-value)) +;; ietf-drums stuff. +(unless (featurep 'ietf-drums) + ;; Should keep track of `ietf-drums-unfold-fws' in ietf-drums.el. + (defun nnheader-unfold-fws () + "Unfold folding white space in the current buffer." + (goto-char (point-min)) + (while (re-search-forward "[ \t]*\n[ \t]+" nil t) + (replace-match " " t t)) + (goto-char (point-min))) + + (defalias 'ietf-drums-unfold-fws 'nnheader-unfold-fws)) + ;;; Header access macros. ;; These macros may look very much like the ones in GNUS 4.1. They diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 3f39bb1..335cdcd 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: @@ -281,9 +282,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.") @@ -379,7 +383,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*\")") @@ -969,7 +973,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 @@ -980,10 +985,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))) @@ -1002,7 +1009,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 @@ -1150,7 +1157,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. @@ -1209,8 +1219,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 @@ -1381,7 +1393,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 a98a187..fafa6e2 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -103,7 +103,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"))) @@ -122,6 +123,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. @@ -483,6 +493,11 @@ parameter. It should return nil, `warn' or `delete'." :group 'nnmail :type 'symbol) +(defcustom nnmail-mail-splitting-decodes t + "Whether the nnmail splitting functionality should MIME decode headers." + :group 'nnmail + :type 'boolean) + ;;; Internal variables. (defvar nnmail-article-buffer " *nnmail incoming*" @@ -1001,8 +1016,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. - (mime-decode-header-in-region (point-min) (point-max) - nnmail-mail-splitting-charset) + (when nnmail-mail-splitting-decodes + (mime-decode-header-in-region (point-min) (point-max) + nnmail-mail-splitting-charset)) ;; Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) @@ -1457,37 +1473,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)) @@ -1589,7 +1596,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) @@ -1764,7 +1771,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/nnmaildir.el b/lisp/nnmaildir.el index 2c01d2b..e9d5ef5 100644 --- a/lisp/nnmaildir.el +++ b/lisp/nnmaildir.el @@ -700,7 +700,9 @@ by nnmaildir-request-article.") (defun nnmaildir-request-scan (&optional scan-group server) (let ((coding-system-for-write nnheader-file-coding-system) + (output-coding-system nnheader-file-coding-system) (buffer-file-coding-system nil) + (file-coding-system nil) (file-coding-system-alist nil) (nnmaildir-get-new-mail t) (nnmaildir-group-alist nil) @@ -934,7 +936,9 @@ by nnmaildir-request-article.") (defun nnmaildir-request-rename-group (gname new-name &optional server) (let ((group (nnmaildir--prepare server gname)) (coding-system-for-write nnheader-file-coding-system) + (output-coding-system nnheader-file-coding-system) (buffer-file-coding-system nil) + (file-coding-system nil) (file-coding-system-alist nil) srv-dir x groups) (catch 'return @@ -1201,7 +1205,9 @@ by nnmaildir-request-article.") (defun nnmaildir-request-replace-article (article gname buffer) (let ((group (nnmaildir--prepare nil gname)) (coding-system-for-write nnheader-file-coding-system) + (output-coding-system nnheader-file-coding-system) (buffer-file-coding-system nil) + (file-coding-system nil) (file-coding-system-alist nil) file dir suffix tmpfile deactivate-mark) (catch 'return @@ -1287,7 +1293,9 @@ by nnmaildir-request-article.") (defun nnmaildir-request-accept-article (gname &optional server last) (let ((group (nnmaildir--prepare server gname)) (coding-system-for-write nnheader-file-coding-system) + (output-coding-system nnheader-file-coding-system) (buffer-file-coding-system nil) + (file-coding-system nil) (file-coding-system-alist nil) srv-dir dir file tmpfile curfile 24h num article) (catch 'return @@ -1500,7 +1508,9 @@ by nnmaildir-request-article.") (defun nnmaildir-request-set-mark (gname actions &optional server) (let ((group (nnmaildir--prepare server gname)) (coding-system-for-write nnheader-file-coding-system) + (output-coding-system nnheader-file-coding-system) (buffer-file-coding-system nil) + (file-coding-system nil) (file-coding-system-alist nil) del-mark add-marks marksdir markfile action group-nlist nlist ranges begin end article all-marks todo-marks did-marks marks form mdir mfile diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el index 8157bec..fe4a30b 100644 --- a/lisp/nnmbox.el +++ b/lisp/nnmbox.el @@ -189,18 +189,11 @@ (1+ (- (cdr active) (car active))) (car active) (cdr active) group))))) -(static-if (boundp 'MULE) - (defun nnmbox-save-buffer () - (let ((output-coding-system - (or nnmbox-file-coding-system-for-write - nnmbox-file-coding-system))) - (save-buffer))) - (defun nnmbox-save-buffer () - (let ((coding-system-for-write - (or nnmbox-file-coding-system-for-write - nnmbox-file-coding-system))) - (save-buffer))) - ) +(defun nnmbox-save-buffer () + (let* ((coding-system-for-write (or nnmbox-file-coding-system-for-write + nnmbox-file-coding-system)) + (output-coding-system coding-system-for-write)) + (save-buffer))) (defun nnmbox-save-active (group-alist active-file) (let ((nnmail-active-file-coding-system @@ -341,7 +334,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 91fbcc0..e814774 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -325,7 +325,7 @@ as unread by Gnus.") (not (equal group "draft"))) (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 d27213f..7a1b531 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -375,7 +375,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/nnrss.el b/lisp/nnrss.el index fd9ea8a..8f66d43 100644 --- a/lisp/nnrss.el +++ b/lisp/nnrss.el @@ -378,6 +378,7 @@ ARTICLE is the article number of the current headline.") (when (file-exists-p file) (with-temp-buffer (let ((coding-system-for-read 'binary) + (input-coding-system 'binary) emacs-lisp-mode-hook) (insert-file-contents file) (emacs-lisp-mode) @@ -394,6 +395,7 @@ ARTICLE is the article number of the current headline.") server ".el")) nnrss-directory))) (let ((coding-system-for-write 'binary) + (output-coding-system 'binary) print-level print-length) (with-temp-file file (insert "(setq nnrss-server-data '" @@ -416,6 +418,7 @@ ARTICLE is the article number of the current headline.") (when (file-exists-p file) (with-temp-buffer (let ((coding-system-for-read 'binary) + (input-coding-system 'binary) emacs-lisp-mode-hook) (insert-file-contents file) (emacs-lisp-mode) @@ -438,6 +441,7 @@ ARTICLE is the article number of the current headline.") server ".el")) nnrss-directory))) (let ((coding-system-for-write 'binary) + (output-coding-system 'binary) print-level print-length) (with-temp-file file (insert "(setq nnrss-group-data '" diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el index 5820103..45299f5 100644 --- a/lisp/nnslashdot.el +++ b/lisp/nnslashdot.el @@ -54,6 +54,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.") @@ -293,6 +296,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. @@ -322,20 +326,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 0836590..e0bda9e 100644 --- a/lisp/nnsoup.el +++ b/lisp/nnsoup.el @@ -115,7 +115,7 @@ backend for the messages.") ;; articles in SEQUENCE come from. (while (and areas sequence) ;; Peel off areas that are below sequence. - (while (and areas (< (cdaar areas) (car sequence))) + (while (and areas (< (cdar (car areas)) (car sequence))) (setq areas (cdr areas))) (when areas ;; This is a useful area. @@ -131,7 +131,7 @@ backend for the messages.") (setq use-nov nil)) ;; We assign the portion of `sequence' that is relevant to ;; this MSG packet to this packet. - (while (and sequence (<= (car sequence) (cdaar areas))) + (while (and sequence (<= (car sequence) (cdar (car areas)))) (push (car sequence) this-area-seq) (setq sequence (cdr sequence))) (setcar useful-areas (cons (nreverse this-area-seq) @@ -250,7 +250,7 @@ backend for the messages.") ;; Try to guess the type based on the first article in the group. (when (not article) (setq article - (cdaar (cddr (assoc group nnsoup-group-alist))))) + (cdar (car (cddr (assoc group nnsoup-group-alist)))))) (if (not article) 'unknown (let ((kind (gnus-soup-encoding-kind @@ -372,7 +372,7 @@ backend for the messages.") (setq min (caaar e)) (while (cdr e) (setq e (cdr e))) - (setq max (cdaar e)) + (setq max (cdar (car e))) (setcdr entry (cons (cons min max) (cdr entry))))) (setq nnsoup-group-alist-touched t)) nnsoup-group-alist)) @@ -652,7 +652,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 8bbf408..047b8a5 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -138,6 +138,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.") @@ -1664,6 +1671,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', @@ -1673,11 +1681,12 @@ 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)) @@ -1685,6 +1694,9 @@ Please refer to the following variables to customize the connection: (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 9ae4303..ece9640 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -50,8 +50,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 @@ -63,33 +62,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.") @@ -312,385 +303,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) -;; (input-coding-system 'binary) -;; (output-coding-system '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 ;;; @@ -796,12 +408,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)))))) @@ -828,6 +451,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