From 7ebf974f6bac5c2f61e7c7cda2962fa4d8766b81 Mon Sep 17 00:00:00 2001 From: ichikawa Date: Thu, 11 Feb 1999 12:01:39 +0000 Subject: [PATCH] Importing pgnus-0.76 --- lisp/ChangeLog | 227 ++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/binhex.el | 2 +- lisp/format-spec.el | 71 ++++++++++++++++ lisp/gnus-agent.el | 1 - lisp/gnus-art.el | 169 +++++++++++++++++++++---------------- lisp/gnus-cus.el | 4 +- lisp/gnus-group.el | 8 +- lisp/gnus-load.el | 1 - lisp/gnus-msg.el | 8 +- lisp/gnus-picon.el | 5 +- lisp/gnus-range.el | 73 ++++++++++++---- lisp/gnus-start.el | 60 +++++++------ lisp/gnus-sum.el | 110 +++++++++++------------- lisp/gnus.el | 10 +-- lisp/mail-source.el | 63 ++++++++------ lisp/message.el | 74 ++++------------ lisp/mm-bodies.el | 59 ++++++++++--- lisp/mm-util.el | 22 +++-- lisp/mm-uu.el | 2 +- lisp/mml.el | 109 ++++++++++++++++++++---- lisp/nndoc.el | 29 +------ lisp/nnfolder.el | 3 +- lisp/nnheader.el | 9 +- lisp/nnmail.el | 71 ++++++++++++++-- lisp/nnml.el | 2 +- lisp/nntp.el | 8 +- lisp/nnvirtual.el | 4 +- lisp/pop3.el | 2 +- lisp/rfc2047.el | 24 +++++- lisp/uudecode.el | 2 +- texi/ChangeLog | 16 ++++ texi/emacs-mime.texi | 28 +++++++ texi/gnus.texi | 113 ++++++++++++++++++------- texi/message.texi | 6 +- 34 files changed, 1005 insertions(+), 390 deletions(-) create mode 100644 lisp/format-spec.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5fb51b3..750947c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,230 @@ +Thu Feb 11 04:58:51 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.76 is released. + +1999-02-06 Felix Lee + + * gnus.el (gnus-group-change-level-function): Typo. + +1999-02-11 05:47:51 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-nov-skip-field): Removed. + (gnus-nov-field): Ditto. + (gnus-nov-parse-extra): Ditto. + (gnus-nov-read-integer): Ditto. + +1999-02-05 09:44:20 Katsumi Yamaoka + + * nnheader.el (nnheader-nov-read-message-id): New macro. + (nnheader-parse-nov): Use it. + + * gnus-sum.el (gnus-nov-read-message-id): New macro. + (gnus-nov-parse-line): Use it; use `(eobp)' instead of + `(eq (char-after) ?\n)'. + +1999-02-11 05:16:26 Lars Magne Ingebrigtsen + + * gnus.el (gnus-other-frame): Always pop up a new frame. + +Wed Feb 10 01:03:43 1999 Shenghuo ZHU + + * gnus-range.el (gnus-range-add): Rewrite. + +1999-02-02 18:12:00 Carsten Leonhardt + + * nnmail.el (nnmail-split-incoming): Added detection of maildir + format. + (nnmail-process-maildir-mail-format): New function. + + * mail-source.el (mail-source-fetch-maildir): New function. + (mail-source-keyword-map): Add default for maildir method. + (mail-source-fetcher-alist): Changed "qmail" to "maildir". + +1999-02-10 02:29:28 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetcher-alist): Remove apop. + + * nndoc.el (nndoc-type-alist): Remove MIME-digest. + (nndoc-mime-digest-type-p): Removed. + +1999-02-09 15:25:52 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-read-summary-keys): Set the point + where it is supposed to be. + (gnus-treat-play-sounds): New variable. + + * gnus-sum.el (gnus-newsgroup-ignored-charsets): New variable. + + * gnus-art.el (article-display-x-face): Narrow to head. + (gnus-article-washed-types): New variable. + (article-hide-pgp): Is not a toggle. + (gnus-article-hide-text-type): Save types. + (article-decode-charset): Use it. + + * nnmail.el (nnmail-get-new-mail): Ignore procmail. + + * message.el (message-forward-start-separator): Removed. + (message-forward-end-separator): Removed. + (message-signature-before-forwarded-message): Removed. + (message-included-forward-headers): Removed. + (message-check-news-body-syntax): Don't check forward. + (message-forward): Use MIME. + + * nnvirtual.el (nnvirtual-request-article): Bind + gnus-article-decode-hook to nil. + +1999-02-06 16:55:25 Lars Magne Ingebrigtsen + + * mml.el (mml-parse-singlepart-with-multiple-charsets): Check for + us-ascii. + +1999-02-04 00:00:35 Lars Magne Ingebrigtsen + + * format-spec.el (format-spec): Be more robust. + + * message.el (message-encode-message-body): Default + mail-parse-charset to mail-parse-charset. + + * gnus-sum.el (gnus-summary-edit-article-done): Don't encode. + (gnus-summary-edit-article): Bind mail-parse-charset. + + * mml.el (mml-read-tag): Ignore white space after end of tag. + + * message.el (message-goto-body): Also work in separatorless + articles. + + * mml.el (mml-translate-from-mime): New function. + (mml-insert-mime): Ditto. + (mml-to-mime): New function. + (mime-to-mml): New name. + + * gnus-sum.el (gnus-summary-edit-article): Always select raw + article. + + * gnus-group.el (gnus-group-catchup-current): Unmark groups. + + * gnus-sum.el (gnus-summary-setup-default-charset): Don't + special-case nndraft groups. + +1999-02-03 16:44:19 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-get-newsgroup-headers): Bind charset. + (gnus-get-newsgroup-headers): Already bound. + + * message.el (message-encode-message-body): Use posting charset. + + * mm-bodies.el (mm-encode-body): Use MIME charsets. + (mm-body-encoding): Do CTE. + (mm-body-7-or-8): New function. + + * mm-util.el (mm-mime-charset): Always fall back on alist. + (mm-mime-mule-charset-alist): Include katakana-jisx0201. + (mm-mime-mule-charset-alist): Add arabic-*-column. + (mm-find-mime-charset-region): New function. + + * format-spec.el (format-spec-make): New function. + + * mail-source.el (format-spec): Required. + (mail-source-fetch-with-program): Removed. + (mail-source-fetch-with-program): New function. + + * format-spec.el: New file. + +1999-02-03 16:00:41 Tatsuya Ichikawa + + * mail-source.el (mail-source-fetch-with-program): Take optional + parameter. + +1999-02-03 00:31:21 Lars Magne Ingebrigtsen + + * gnus-start.el: Ignore some groups. + (gnus-setup-news): Bind nnmail-fetched-sources. + + * message.el (message-send-mail): Remove all tabs. + + * mm-util.el (mm-find-charset-region): Just check whether + find-charset-region is defined. + +1999-02-02 23:35:20 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-get-new-news): Use + nnmail-fetched-sources. + + * nnmail.el (nnmail-fetched-sources): New variable. + (nnmail-get-new-mail): Use it. + + * mail-source.el (mail-source-fetched-sources): New variable. + (mail-source-fetch): Use it. + +1999-02-02 23:20:20 Mark W. Eichin + + * gnus.el (gnus-getenv-nntpserver): if the file that + gnus-nntpserver-file names has a trailing newline, the + string-match will always match, and thus the file will never be + read. (^ matches start of "line", \\` matches start of "buffer", + which is what was intended...) + +1999-02-02 23:17:40 Kim-Minh Kaplan + + * gnus-picon.el (gnus-picons-parse-filenames): Quote group names. + +1999-01-28 04:15:46 Katsumi Yamaoka + + * gnus-start.el (gnus-read-active-file): Eliminate duplicated + select methods. + +1999-01-27 Simon Josefsson + + * gnus-range.el (gnus-remove-from-range): Sort second argument. + +1999-02-02 10:55:23 Scott Hofmann + + * nntp.el: Use mail-source-read-passwd instead of nnmail-read-passwd. + +Mon Feb 1 23:23:03 1999 Shenghuo ZHU + + * gnus-cus.el (gnus-group-parameters): Charset as symbol, and fix + a typo. + * gnus-sum.el (gnus-summary-setup-default-charset): Set nndraft's + charset to nil. + * gnus-agent.el (gnus-agent-queue-setup): Remove charset setting. + * gnus-start.el (gnus-start-draft-setup): Ditto. + +1999-02-02 22:13:14 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch-directory): Use the predicate. + (mail-source-value): Don't do variables. + + * nnmail.el (nnmail-get-new-mail): Set the predicate. + + * gnus-sum.el (gnus-summary-toggle-header): Fix, and bound to t. + +1999-02-01 Michael Cook + + * Defenestrate spurious ?a. + +1999-02-02 21:59:51 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch-pop): Instead use + :authentication. + +1999-02-01 Tatsuya Ichikawa + + * lisp/mail-source.el : Support APOP authentication scheme. + +1999-02-02 21:56:14 Tatsuya Ichikawa + + * pop3.el (pop3-movemail): Return t. + +1999-02-02 21:48:46 Lars Magne Ingebrigtsen + + * rfc2047.el (rfc2047-fold-region): New function. + (rfc2047-encode-message-header): Use it. + +1999-02-02 21:07:27 Hallvard B. Furuseth + + * gnus-sum.el (gnus-group-charset-alist): Add more. + Mon Feb 1 21:18:00 1999 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.75 is released. diff --git a/lisp/binhex.el b/lisp/binhex.el index 9611fd7..ddad17e 100644 --- a/lisp/binhex.el +++ b/lisp/binhex.el @@ -3,7 +3,7 @@ ;; Author: Shenghuo Zhu ;; Create Date: Oct 1, 1998 -;; $Revision: 1.1.1.9 $ +;; $Revision: 1.1.1.10 $ ;; Time-stamp: ;; Keywords: binhex diff --git a/lisp/format-spec.el b/lisp/format-spec.el new file mode 100644 index 0000000..8986dc0 --- /dev/null +++ b/lisp/format-spec.el @@ -0,0 +1,71 @@ +;;; format-spec.el --- functions for formatting arbitrary formatting strings +;; Copyright (C) 1999 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; Keywords: tools + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(eval-when-compile (require 'cl)) + +(defun format-spec (format specification) + "Return a string based on FORMAT and SPECIFICATION. +FORMAT is a string containing `format'-like specs like \"bash %u %k\", +while SPECIFICATION is an alist mapping from format spec characters +to values." + (with-temp-buffer + (insert format) + (goto-char (point-min)) + (while (search-forward "%" nil t) + (cond + ;; Quoted percent sign. + ((eq (char-after) ?%) + (delete-char 1)) + ;; Valid format spec. + ((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)") + (let* ((num (match-string 1)) + (spec (string-to-char (match-string 2))) + (val (cdr (assq spec specification)))) + (delete-region (1- (match-beginning 0)) (match-end 0)) + (unless val + (error "Invalid format character: %s" spec)) + (insert (format (concat "%" num "s") val)))) + ;; Signal an error on bogus format strings. + (t + (error "Invalid format string")))) + (buffer-string))) + +(defun format-spec-make (&rest pairs) + "Return an alist suitable for use in `format-spec' based on PAIRS. +PAIRS is a list where every other element is a character and a value, +starting with a character." + (let (alist) + (while pairs + (unless (cdr pairs) + (error "Invalid list of pairs")) + (push (cons (car pairs) (cadr pairs)) alist) + (setq pairs (cddr pairs))) + (nreverse alist))) + +(provide 'format-spec) + +;;; format-spec.el ends here diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index c2b29e2..737bfcf 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -330,7 +330,6 @@ agent minor mode in all Gnus buffers." (gnus-request-create-group "queue" '(nndraft "")) (let ((gnus-level-default-subscribed 1)) (gnus-subscribe-group "nndraft:queue" nil '(nndraft ""))) - (gnus-group-set-parameter "nndraft:queue" 'charset nil) (gnus-group-set-parameter "nndraft:queue" 'gnus-dummy '((gnus-draft-mode))))) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 164fbed..37c6c95 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -774,9 +774,15 @@ The format is defined by the `gnus-article-time-format' variable." :group 'gnus-article-treat :type gnus-article-treat-custom) +(defcustom gnus-treat-play-sounds nil + "Fill long lines." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + ;;; Internal variables (defvar article-goto-body-goes-to-point-min-p nil) +(defvar gnus-article-wash-types nil) (defvar gnus-article-mime-handle-alist-1 nil) (defvar gnus-treatment-function-alist @@ -813,7 +819,8 @@ The format is defined by the `gnus-article-time-format' variable." (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) (gnus-treat-display-xface gnus-article-display-x-face) (gnus-treat-display-smileys gnus-smiley-display) - (gnus-treat-display-picons gnus-article-display-picons))) + (gnus-treat-display-picons gnus-article-display-picons) + (gnus-treat-play-sounds gnus-earcon-display))) (defvar gnus-article-mime-handle-alist nil) (defvar article-lapsed-timer nil) @@ -883,11 +890,14 @@ Then replace the article with the result." (defun gnus-article-hide-text-type (b e type) "Hide text of TYPE between B and E." + (push type gnus-article-wash-types) (gnus-article-hide-text b e (cons 'article-type (cons type gnus-hidden-properties)))) (defun gnus-article-unhide-text-type (b e type) "Unhide text of TYPE between B and E." + (setq gnus-article-wash-types + (delq type gnus-article-wash-types)) (remove-text-properties b e (cons 'article-type (cons type gnus-hidden-properties))) (when (memq 'intangible gnus-hidden-properties) @@ -1263,6 +1273,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (case-fold-search t) from last) (save-restriction + (message-narrow-to-head) (goto-char (point-min)) (setq from (message-fetch-field "from")) (goto-char (point-min)) @@ -1332,6 +1343,8 @@ If PROMPT (the prefix), prompt for a coding system to use." (mail-content-type-get ctl 'charset)))) (mail-parse-charset gnus-newsgroup-charset) buffer-read-only) + (when (memq charset gnus-newsgroup-ignored-charsets) + (setq charset nil)) (goto-char (point-max)) (widen) (forward-line 1) @@ -1371,43 +1384,41 @@ or not." (when charset (mm-decode-body charset))))))) -(defun article-hide-pgp (&optional arg) - "Toggle hiding of any PGP headers and signatures in the current article. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-article-hidden-arg)) - (unless (gnus-article-check-hidden-text 'pgp arg) - (save-excursion - (let ((inhibit-point-motion-hooks t) - buffer-read-only beg end) - (widen) - (goto-char (point-min)) - ;; Hide the "header". - (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) - (delete-region (1+ (match-beginning 0)) (match-end 0)) - ;; PGP 5 and GNU PG add a `Hash: <>' comment, hide that too - (when (looking-at "Hash:.*$") - (delete-region (point) (1+ (gnus-point-at-eol)))) - (setq beg (point)) - ;; Hide the actual signature. - (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) - (setq end (1+ (match-beginning 0))) - (delete-region - end - (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) - (match-end 0) - ;; Perhaps we shouldn't hide to the end of the buffer - ;; if there is no end to the signature? - (point-max)))) - ;; Hide "- " PGP quotation markers. - (when (and beg end) - (narrow-to-region beg end) - (goto-char (point-min)) - (while (re-search-forward "^- " nil t) - (delete-region - (match-beginning 0) (match-end 0))) - (widen)) - (gnus-run-hooks 'gnus-article-hide-pgp-hook)))))) +(defun article-hide-pgp () + "Remove any PGP headers and signatures in the current article." + (interactive) + (save-excursion + (let ((inhibit-point-motion-hooks t) + buffer-read-only beg end) + (widen) + (goto-char (point-min)) + ;; Hide the "header". + (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) + (push 'pgp gnus-article-wash-types) + (delete-region (1+ (match-beginning 0)) (match-end 0)) + ;; PGP 5 and GNU PG add a `Hash: <>' comment, hide that too + (when (looking-at "Hash:.*$") + (delete-region (point) (1+ (gnus-point-at-eol)))) + (setq beg (point)) + ;; Hide the actual signature. + (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) + (setq end (1+ (match-beginning 0))) + (delete-region + end + (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) + (match-end 0) + ;; Perhaps we shouldn't hide to the end of the buffer + ;; if there is no end to the signature? + (point-max)))) + ;; Hide "- " PGP quotation markers. + (when (and beg end) + (narrow-to-region beg end) + (goto-char (point-min)) + (while (re-search-forward "^- " nil t) + (delete-region + (match-beginning 0) (match-end 0))) + (widen)) + (gnus-run-hooks 'gnus-article-hide-pgp-hook))))) (defun article-hide-pem (&optional arg) "Toggle hiding of any PEM headers and signatures in the current article. @@ -1419,23 +1430,23 @@ always hide." (let (buffer-read-only end) (widen) (goto-char (point-min)) - ;; hide the horrendously ugly "header". - (and (search-forward "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" - nil - t) - (setq end (1+ (match-beginning 0))) - (gnus-article-hide-text-type - end - (if (search-forward "\n\n" nil t) - (match-end 0) - (point-max)) - 'pem)) - ;; hide the trailer as well - (and (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n" - nil - t) - (gnus-article-hide-text-type - (match-beginning 0) (match-end 0) 'pem)))))) + ;; Hide the horrendously ugly "header". + (when (and (search-forward + "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" + nil t) + (setq end (1+ (match-beginning 0)))) + (push 'pem gnus-article-wash-types) + (gnus-article-hide-text-type + end + (if (search-forward "\n\n" nil t) + (match-end 0) + (point-max)) + 'pem) + ;; Hide the trailer as well + (when (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n" + nil t) + (gnus-article-hide-text-type + (match-beginning 0) (match-end 0) 'pem))))))) (defun article-strip-banner () "Strip the banner specified by the `banner' group parameter." @@ -2356,6 +2367,7 @@ commands: (make-local-variable 'gnus-article-mime-handles) (make-local-variable 'gnus-article-decoded-p) (make-local-variable 'gnus-article-mime-handle-alist) + (make-local-variable 'gnus-article-washed-types) (gnus-set-default-directory) (buffer-disable-undo) (setq buffer-read-only t) @@ -2522,9 +2534,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist)) (gnus-set-mode-line 'article)) - (gnus-configure-windows 'article) (article-goto-body) (set-window-point (get-buffer-window (current-buffer)) (point)) + (gnus-configure-windows 'article) t)))))) ;;;###autoload @@ -2723,20 +2735,25 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-article-part-wrapper n 'mm-save-part)) (defun gnus-article-interactively-view-part (n) - "Pipe MIME part N, which is the numerical prefix." + "View MIME part N interactively, which is the numerical prefix." (interactive "p") (gnus-article-part-wrapper n 'mm-interactively-view-part)) (defun gnus-article-copy-part (n) - "Pipe MIME part N, which is the numerical prefix." + "Copy MIME part N, which is the numerical prefix." (interactive "p") (gnus-article-part-wrapper n 'gnus-mime-copy-part)) (defun gnus-article-externalize-part (n) - "Pipe MIME part N, which is the numerical prefix." + "View MIME part N externally, which is the numerical prefix." (interactive "p") (gnus-article-part-wrapper n 'gnus-mime-externalize-part)) +(defun gnus-article-inline-part (n) + "Inline MIME part N, which is the numerical prefix." + (interactive "p") + (gnus-article-part-wrapper n 'gnus-mime-inline-part)) + (defun gnus-article-view-part (n) "View MIME part N, which is the numerical prefix." (interactive "p") @@ -2860,7 +2877,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." ;; may change the point. So we set the window point. (set-window-point window point))) (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect))) - handle name type b e display) + buffer-read-only handle name type b e display) (unless ihandles ;; Top-level call; we clean up. (mm-destroy-parts gnus-article-mime-handles) @@ -3077,14 +3094,14 @@ If ALL-HEADERS is non-nil, no headers are hidden." "Return a string which display status of article washing." (save-excursion (set-buffer gnus-article-buffer) - (let ((cite (gnus-article-hidden-text-p 'cite)) - (headers (gnus-article-hidden-text-p 'headers)) - (boring (gnus-article-hidden-text-p 'boring-headers)) - (pgp (gnus-article-hidden-text-p 'pgp)) - (pem (gnus-article-hidden-text-p 'pem)) - (signature (gnus-article-hidden-text-p 'signature)) - (overstrike (gnus-article-hidden-text-p 'overstrike)) - (emphasis (gnus-article-hidden-text-p 'emphasis))) + (let ((cite (memq 'cite gnus-article-wash-types)) + (headers (memq 'headers gnus-article-wash-types)) + (boring (memq 'boring-headers gnus-article-wash-types)) + (pgp (memq 'pgp gnus-article-wash-types)) + (pem (memq 'pem gnus-article-wash-types)) + (signature (memq 'signature gnus-article-wash-types)) + (overstrike (memq 'overstrike gnus-article-wash-types)) + (emphasis (memq 'emphasis gnus-article-wash-types))) (format "%c%c%c%c%c%c" (if cite ?c ? ) (if (or headers boring) ?h ? ) @@ -3332,9 +3349,12 @@ Argument LINES specifies lines to be scrolled down." (set-buffer obuf) (unless not-restore-window (set-window-configuration owin)) - (unless (or (not (eq selected 'old)) (member keys up-to-top)) + (when (eq selected 'old) + (article-goto-body) + (set-window-start (get-buffer-window (current-buffer)) + 1) (set-window-point (get-buffer-window (current-buffer)) - opoint)) + (point))) (let ((win (get-buffer-window gnus-article-current-summary))) (when win (set-window-point win new-sum-point)))))))) @@ -3565,18 +3585,21 @@ groups." (error "The current newsgroup does not support article editing")) (gnus-article-date-original) (gnus-article-edit-article + 'ignore `(lambda (no-highlight) + 'ignore (gnus-summary-edit-article-done ,(or (mail-header-references gnus-current-headers) "") ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))) -(defun gnus-article-edit-article (exit-func) +(defun gnus-article-edit-article (start-func exit-func) "Start editing the contents of the current article buffer." (let ((winconf (current-window-configuration))) (set-buffer gnus-article-buffer) (gnus-article-edit-mode) - (gnus-article-delete-text-of-type 'annotation) - (gnus-set-text-properties (point-min) (point-max) nil) + (funcall start-func) + ;;(gnus-article-delete-text-of-type 'annotation) + ;;(gnus-set-text-properties (point-min) (point-max) nil) (gnus-configure-windows 'edit-article) (setq gnus-article-edit-done-function exit-func) (setq gnus-prev-winconf winconf) diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index a560e2a..e50aef0 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -108,7 +108,7 @@ rules as described later).") (const signature) string ) "\ Banner to be removed from articles.") -a + (auto-expire (const :tag "Automatic Expire" t) "\ All articles that are read will be marked as expirable.") @@ -167,7 +167,7 @@ An arbitrary comment on the group.") Always display this group, even when there are no unread articles in it..") - (charset (string :tag "Charset") "\ + (charset (symbol :tag "Charset") "\ The default charset to use in the group.")) "Alist of valid group parameters. diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 0af00bd..3845b76 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -49,7 +49,7 @@ :group 'gnus-group-foreign :type 'directory) -(defcustom gnus-no-groups-message "No news is no news" +(defcustom gnus-no-groups-message "No gnus is bad news" "*Message displayed by Gnus when no groups are available." :group 'gnus-start :type 'string) @@ -2462,6 +2462,7 @@ up is returned." (format "these %d groups" (length groups))))))) n (while (setq group (pop groups)) + (gnus-group-remove-mark group) ;; Virtual groups have to be given special treatment. (let ((method (gnus-find-method-for-group group))) (when (eq 'nnvirtual (car method)) @@ -2900,7 +2901,10 @@ If ARG is a number, it specifies which levels you are interested in re-scanning. If ARG is non-nil and not a number, this will force \"hard\" re-reading of the active files from all servers." (interactive "P") - (let ((gnus-inhibit-demon t)) + (let ((gnus-inhibit-demon t) + ;; Binding this variable will inhibit multiple fetchings + ;; of the same mail source. + (nnmail-fetched-sources (list t))) (gnus-run-hooks 'gnus-get-new-news-hook) ;; Read any slave files. diff --git a/lisp/gnus-load.el b/lisp/gnus-load.el index 978f272..f89f95e 100644 --- a/lisp/gnus-load.el +++ b/lisp/gnus-load.el @@ -19,7 +19,6 @@ (put 'gnus-thread 'custom-loads '("gnus-sum")) (put 'languages 'custom-loads '("cus-edit")) (put 'development 'custom-loads '("cus-edit")) -(put 'gnus-treading 'custom-loads '("gnus-sum")) (put 'nnmail-various 'custom-loads '("nnmail")) (put 'extensions 'custom-loads '("wid-edit")) (put 'message-various 'custom-loads '("message")) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 8877db8..a6a8387 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -645,9 +645,9 @@ The original article will be yanked." (interactive "P") (gnus-summary-reply-with-original n t)) -(defun gnus-summary-mail-forward (&optional full-headers post) +(defun gnus-summary-mail-forward (&optional not-used post) "Forward the current message to another user. -If FULL-HEADERS (the prefix), include full headers when forwarding." +If POST, post instead of mail." (interactive "P") (gnus-setup-message 'forward (gnus-summary-select-article) @@ -659,9 +659,7 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (erase-buffer) (insert text) (run-hooks 'gnus-article-decode-hook) - (let ((message-included-forward-headers - (if full-headers "" message-included-forward-headers))) - (message-forward post))))) + (message-forward post)))) (defun gnus-summary-resend-message (address n) "Resend the current article to ADDRESS." diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index cd85fbb..1fe2064 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -592,9 +592,10 @@ none, and whose CDR is the corresponding element of DOMAINS." (setq start-re (concat ;; dbs - "^\\(" (mapconcat 'identity dbs "\\|") "\\)/" + "^\\(" (mapconcat 'regexp-quote dbs "\\|") "\\)/" ;; host - "\\(\\(" (replace-in-string host "\\." "/\\|" t) + "\\(\\(" (mapconcat 'regexp-quote + (message-tokenize-header host ".") "/\\|") "/\\|MISC/\\)*\\)" ;; user "\\(" (regexp-quote user) "\\|unknown\\)/" diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el index 2705795..97197fe 100644 --- a/lisp/gnus-range.el +++ b/lisp/gnus-range.el @@ -226,7 +226,12 @@ Note: LIST has to be sorted over `<'." (defun gnus-remove-from-range (range1 range2) "Return a range that has all articles from RANGE2 removed from -RANGE1. The returned range is always a list." +RANGE1. The returned range is always a list. RANGE2 can also be a +unsorted list of articles." + (if (listp (cdr range2)) + (setq range2 (sort range2 (lambda (e1 e2) + (< (if (consp e1) (car e1) e1) + (if (consp e2) (car e2) e2)))))) (if (or (null range1) (null range2)) range1 (let (out r1 r2 r1_min r1_max r2_min r2_max) @@ -326,19 +331,59 @@ RANGE1. The returned range is always a list." sublistp)) (defun gnus-range-add (range1 range2) - "Add RANGE2 to RANGE1 destructively." - (cond - ;; If either are nil, then the job is quite easy. - ((or (null range1) (null range2)) - (or range1 range2)) - (t - ;; I don't like thinking. - (gnus-compress-sequence - (sort - (nconc - (gnus-uncompress-range range1) - (gnus-uncompress-range range2)) - '<))))) + "Add RANGE2 to RANGE1 (nondestructively)." + (unless (listp (cdr range1)) + (setq range1 (list range1))) + (unless (listp (cdr range2)) + (setq range2 (list range2))) + (let ((item1 (pop range1)) + (item2 (pop range2)) + range item selector) + (while (or item1 item2) + (setq selector + (cond + ((null item1) nil) + ((null item2) t) + ((and (numberp item1) (numberp item2)) (< item1 item2)) + ((numberp item1) (< item1 (car item2))) + ((numberp item2) (< (car item1) item2)) + (t (< (car item1) (car item2))))) + (setq item + (or + (let ((tmp1 item) (tmp2 (if selector item1 item2))) + (cond + ((null tmp1) tmp2) + ((null tmp2) tmp1) + ((and (numberp tmp1) (numberp tmp2)) + (cond + ((eq tmp1 tmp2) tmp1) + ((eq (1+ tmp1) tmp2) (cons tmp1 tmp2)) + ((eq (1+ tmp2) tmp1) (cons tmp2 tmp1)) + (t nil))) + ((numberp tmp1) + (cond + ((and (>= tmp1 (car tmp2)) (<= tmp1 (cdr tmp2))) tmp2) + ((eq (1+ tmp1) (car tmp2)) (cons tmp1 (cdr tmp2))) + ((eq (1- tmp1) (cdr tmp2)) (cons (car tmp2) tmp1)) + (t nil))) + ((numberp tmp2) + (cond + ((and (>= tmp2 (car tmp1)) (<= tmp2 (cdr tmp1))) tmp1) + ((eq (1+ tmp2) (car tmp1)) (cons tmp2 (cdr tmp1))) + ((eq (1- tmp2) (cdr tmp1)) (cons (car tmp1) tmp2)) + (t nil))) + ((< (1+ (cdr tmp1)) (car tmp2)) nil) + ((< (1+ (cdr tmp2)) (car tmp1)) nil) + (t (cons (min (car tmp1) (car tmp2)) + (max (cdr tmp1) (cdr tmp2)))))) + (progn + (if item (push item range)) + (if selector item1 item2)))) + (if selector + (setq item1 (pop range1)) + (setq item2 (pop range2)))) + (if item (push item range)) + (reverse range))) (provide 'gnus-range) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index bcd0148..46243b2 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -720,7 +720,6 @@ prompt the user for the name of an NNTP server to use." (unless (gnus-gethash "nndraft:drafts" gnus-newsrc-hashtb) (let ((gnus-level-default-subscribed 1)) (gnus-subscribe-group "nndraft:drafts" nil '(nndraft ""))) - (gnus-group-set-parameter "nndraft:drafts" 'charset nil) (gnus-group-set-parameter "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode))))) @@ -855,7 +854,10 @@ prompt the user for the name of an NNTP server to use." "Setup news information. If RAWFILE is non-nil, the .newsrc file will also be read. If LEVEL is non-nil, the news will be set up at level LEVEL." - (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))) + (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))) + ;; Binding this variable will inhibit multiple fetchings + ;; of the same mail source. + (nnmail-fetched-sources (list t))) (when init ;; Clear some variables to re-initialize news information. @@ -1521,19 +1523,24 @@ newsgroup." (cond ;; We don't want these groups. ((> (gnus-info-level info) level) - (setq active nil)) + (setq active 'ignore)) ;; Activate groups. ((not gnus-read-active-file) (setq active (gnus-activate-group group 'scan)) (inline (gnus-close-group group))))) ;; Get the number of unread articles in the group. - (if active - (inline (gnus-get-unread-articles-in-group info active t)) + (cond + ((eq active 'ignore) + ;; Don't do anything. + ) + (active + (inline (gnus-get-unread-articles-in-group info active t))) + (t ;; The group couldn't be reached, so we nix out the number of ;; unread articles and stuff. (gnus-set-active group nil) - (setcar (gnus-gethash group gnus-newsrc-hashtb) t))) + (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))) (gnus-message 5 "Checking new news...done"))) @@ -1641,30 +1648,30 @@ newsgroup." (defun gnus-read-active-file (&optional force not-native) (gnus-group-set-mode-line) (let ((methods - (append - (if (and (not not-native) - (gnus-check-server gnus-select-method)) - ;; The native server is available. - (cons gnus-select-method gnus-secondary-select-methods) - ;; The native server is down, so we just do the - ;; secondary ones. - gnus-secondary-select-methods) - ;; Also read from the archive server. - (when (gnus-archive-server-wanted-p) - (list "archive")))) - list-type) + (mapcar + (lambda (m) (if (stringp m) (gnus-server-get-method nil m) m)) + (append + (if (and (not not-native) + (gnus-check-server gnus-select-method)) + ;; The native server is available. + (cons gnus-select-method gnus-secondary-select-methods) + ;; The native server is down, so we just do the + ;; secondary ones. + gnus-secondary-select-methods) + ;; Also read from the archive server. + (when (gnus-archive-server-wanted-p) + (list "archive"))))) + method where mesg list-type) (setq gnus-have-read-active-file nil) (save-excursion (set-buffer nntp-server-buffer) - (while methods - (let* ((method (if (stringp (car methods)) - (gnus-server-get-method nil (car methods)) - (car methods))) - (where (nth 1 method)) - (mesg (format "Reading active file%s via %s..." + (while (setq method (pop methods)) + (unless (member method methods) + (setq where (nth 1 method) + mesg (format "Reading active file%s via %s..." (if (and where (not (zerop (length where)))) (concat " from " where) "") - (car method)))) + (car method))) (gnus-message 5 mesg) (when (gnus-check-server method) ;; Request that the backend scan its incoming messages. @@ -1711,8 +1718,7 @@ newsgroup." (gnus-active-to-gnus-format method gnus-active-hashtb nil t) ;; We mark this active file as read. (push method gnus-have-read-active-file) - (gnus-message 5 "%sdone" mesg)))))) - (setq methods (cdr methods)))))) + (gnus-message 5 "%sdone" mesg)))))))))) ;; Read an active file and place the results in `gnus-active-hashtb'. (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 8a33d84..87a2f78 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -606,7 +606,7 @@ See `gnus-thread-score-function' for en explanation of what a \"thread score\" is. This variable is local to the summary buffers." - :group 'gnus-treading + :group 'gnus-threading :group 'gnus-score-default :type '(choice (const :tag "off" nil) integer)) @@ -802,12 +802,22 @@ which it may alter in any way.") ("^cn\\>\\|\\" cn-gb-2312) ("^fj\\>\\|^japan\\>" iso-2022-jp-2) ("^relcom\\>" koi8-r) + ("^\\(cz\\|hun\\|pl\\|sk\\)\\>" iso-8859-2) + ("^israel\\>" iso-8859-1) + ("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1) (".*" iso-8859-1)) - "Alist of regexps (to match group names) and default charsets to be used." + "Alist of regexps (to match group names) and default charsets to be used when reading." :type '(repeat (list (regexp :tag "Group") (symbol :tag "Charset"))) :group 'gnus-charset) +(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit) + "List of charsets that should be ignored. +When these charsets are used in the \"charset\" parameter, the +default charset will be used instead." + :type '(repeat symbol) + :group 'gnus-charset) + ;;; Internal variables (defvar gnus-article-mime-handles nil) @@ -1294,7 +1304,7 @@ increase the score of each group you read." "a" gnus-summary-post-news "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article - "t" gnus-article-hide-headers + "t" gnus-summary-toggle-header "g" gnus-summary-show-article "l" gnus-summary-goto-last-article "\C-c\C-v\C-v" gnus-uu-decode-uu-view @@ -1539,6 +1549,7 @@ increase the score of each group you read." "o" gnus-article-save-part "c" gnus-article-copy-part "e" gnus-article-externalize-part + "i" gnus-article-inline-part "|" gnus-article-pipe-part) ) @@ -3162,31 +3173,6 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq heads nil))))) gnus-newsgroup-dependencies))) -(defmacro gnus-nov-read-integer () - '(prog1 - (if (eq (char-after) ?\t) - 0 - (let ((num (ignore-errors (read buffer)))) - (if (numberp num) num 0))) - (unless (eobp) - (search-forward "\t" eol 'move)))) - -(defmacro gnus-nov-skip-field () - '(search-forward "\t" eol 'move)) - -(defmacro gnus-nov-field () - '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) - -(defmacro gnus-nov-parse-extra () - '(let (out string) - (while (not (memq (char-after) '(?\n nil))) - (setq string (gnus-nov-field)) - (when (string-match "^\\([^ :]+\\): " string) - (push (cons (intern (match-string 1 string)) - (substring string (match-end 0))) - out))) - out)) - ;; This function has to be called with point after the article number ;; on the beginning of the line. (defsubst gnus-nov-parse-line (number dependencies &optional force-new) @@ -3203,20 +3189,19 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq header (make-full-mail-header - number ; number + number ; number (funcall gnus-decode-encoded-word-function - (gnus-nov-field)) ; subject + (nnheader-nov-field)) ; subject (funcall gnus-decode-encoded-word-function - (gnus-nov-field)) ; from - (gnus-nov-field) ; date - (or (gnus-nov-field) - (nnheader-generate-fake-message-id)) ; id - (gnus-nov-field) ; refs - (gnus-nov-read-integer) ; chars - (gnus-nov-read-integer) ; lines - (unless (eq (char-after) ?\n) - (gnus-nov-field)) ; misc - (gnus-nov-parse-extra)))) ; extra + (nnheader-nov-field)) ; from + (nnheader-nov-field) ; date + (nnheader-nov-read-message-id) ; id + (nnheader-nov-field) ; refs + (nnheader-nov-read-integer) ; chars + (nnheader-nov-read-integer) ; lines + (unless (eobp) + (nnheader-nov-field)) ; misc + (nnheader-nov-parse-extra)))) ; extra (widen)) @@ -7028,9 +7013,7 @@ If ARG is a negative number, hide the unwanted header lines." (set-buffer gnus-article-buffer) (let* ((buffer-read-only nil) (inhibit-point-motion-hooks t) - (hidden (text-property-any - (goto-char (point-min)) (search-forward "\n\n") - 'invisible t)) + (hidden (gnus-article-hidden-text-p 'headers)) e) (goto-char (point-min)) (when (search-forward "\n\n" nil t) @@ -7042,7 +7025,8 @@ If ARG is a negative number, hide the unwanted header lines." (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) (insert-buffer-substring gnus-original-article-buffer 1 e) (narrow-to-region (point-min) (point)) - (if (or (not hidden) (and (numberp arg) (< arg 0))) + (if (or hidden + (and (numberp arg) (< arg 0))) (let ((gnus-treat-hide-headers nil) (gnus-treat-hide-boring-headers nil)) (gnus-treat-article 'head)) @@ -7507,22 +7491,22 @@ This will have permanent effect only in mail groups. If FORCE is non-nil, allow editing of articles even in read-only groups." (interactive "P") - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-set-global-variables) - (when (and (not force) - (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing")) - ;; Select article if needed. - (unless (eq (gnus-summary-article-number) - gnus-current-article) - (gnus-summary-select-article t)) - (gnus-article-date-original) - (gnus-article-edit-article - `(lambda (no-highlight) - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))) + (let ((mail-parse-charset gnus-newsgroup-charset)) + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-set-global-variables) + (when (and (not force) + (gnus-group-read-only-p)) + (error "The current newsgroup does not support article editing")) + (gnus-summary-show-article t) + (gnus-article-edit-article + 'mime-to-mml + `(lambda (no-highlight) + (let ((mail-parse-charset ',gnus-newsgroup-charset)) + (mml-to-mime) + (gnus-summary-edit-article-done + ,(or (mail-header-references gnus-current-headers) "") + ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))))) (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit) @@ -7537,8 +7521,7 @@ groups." (if (and (not read-only) (not (gnus-request-replace-article (cdr gnus-article-current) (car gnus-article-current) - (current-buffer) - (not gnus-article-decoded-p)))) + (current-buffer) t))) (error "Couldn't replace article") ;; Update the summary buffer. (if (and references @@ -9175,7 +9158,8 @@ save those articles instead." (gnus-group-real-name gnus-newsgroup-name)))) (setq gnus-newsgroup-charset (or (and gnus-newsgroup-name - (or (gnus-group-find-parameter gnus-newsgroup-name 'charset) + (or (gnus-group-find-parameter gnus-newsgroup-name + 'charset) (let ((alist gnus-group-charset-alist) elem (charset nil)) (while (setq elem (pop alist)) diff --git a/lisp/gnus.el b/lisp/gnus.el index 395cba4..ac5135a 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -259,7 +259,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.75" +(defconst gnus-version-number "0.76" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) @@ -859,7 +859,7 @@ used to 899, you would say something along these lines: (insert-file-contents gnus-nntpserver-file) (let ((name (buffer-string))) (prog1 - (if (string-match "^[ \t\n]*$" name) + (if (string-match "\\'[ \t\n]*$" name) nil name) (kill-buffer (current-buffer)))))))) @@ -1159,7 +1159,7 @@ articles. This is not a good idea." :type 'boolean) (defcustom gnus-use-picons nil - "*If non-nil, display picons." + "*If non-nil, display picons in a frame of their own." :group 'gnus-meta :type 'boolean) @@ -1348,7 +1348,7 @@ following hook: (defcustom gnus-group-change-level-function nil "Function run when a group level is changed. It is called with three parameters -- GROUP, LEVEL and OLDLEVEL." - :group 'gnus-group-level + :group 'gnus-group-levels :type 'function) ;;; Face thingies. @@ -2807,8 +2807,6 @@ As opposed to `gnus', this command will not connect to the local server." (let ((window (get-buffer-window gnus-group-buffer))) (cond (window (select-frame (window-frame window))) - ((= (length (frame-list)) 1) - (select-frame (make-frame))) (t (other-frame 1)))) (gnus arg)) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index ed23bab..7fef760 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -28,6 +28,7 @@ (eval-when-compile (require 'cl)) (eval-and-compile (autoload 'pop3-movemail "pop3")) +(require 'format-spec) (defgroup mail-source nil "The mail-fetching library." @@ -65,17 +66,18 @@ (concat "/usr/spool/mail/" (user-login-name))))) (directory (:path) - (:suffix ".spool")) + (:suffix ".spool") + (:predicate identity)) (pop (:server (getenv "MAILHOST")) (:port "pop3") (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER"))) (:program) - (:args) (:function) - (:password)) + (:password) + (:authentication password)) (maildir - (:path))) + (:path "~/Maildir/new/"))) "Mapping from keywords to default values. All keywords that can be used must be listed here.")) @@ -83,7 +85,7 @@ All keywords that can be used must be listed here.")) '((file mail-source-fetch-file) (directory mail-source-fetch-directory) (pop mail-source-fetch-pop) - (qmail mail-source-fetch-qmail)) + (maildir mail-source-fetch-maildir)) "A mapping from source type to fetcher function.") (defvar mail-source-password-cache nil) @@ -140,10 +142,6 @@ of the `let' form." ((and (listp value) (functionp (car value))) (eval value)) - ;; Variable - ((and (symbolp value) - (boundp value)) - (symbol-value value)) ;; Just return the value. (t value))) @@ -278,9 +276,9 @@ If ARGS, PROMPT is used as an argument to `format'." (setq mail-source-read-passwd 'ange-ftp-read-passwd))) (funcall mail-source-read-passwd prompt))) -(defun mail-source-fetch-with-program (program args to) - (zerop (apply 'call-process program nil nil nil - (append (split-string args) (list to))))) +(defun mail-source-fetch-with-program (program) + (zerop (call-process shell-file-name nil nil nil + shell-command-switch program))) ;;; ;;; Different fetchers @@ -302,6 +300,7 @@ If ARGS, PROMPT is used as an argument to `format'." (dolist (file (directory-files path t (concat (regexp-quote suffix) "$"))) (when (and (file-regular-p file) + (funcall predicate file) (mail-source-movemail file mail-source-crash-box)) (incf found (mail-source-callback callback file)))) found))) @@ -311,28 +310,33 @@ If ARGS, PROMPT is used as an argument to `format'." (mail-source-bind (pop source) (let ((from (format "%s:%s:%s" server user port)) (mail-source-string (format "pop:%s@%s" user server))) - (setq password - (or password - (cdr (assoc from mail-source-password-cache)) - (mail-source-read-passwd - (format "Password for %s at %s: " user server)))) - (unless (assoc from mail-source-password-cache) - (push (cons from password) mail-source-password-cache)) + (when (and (not (eq authentication 'apop)) + (not program)) + (setq password + (or password + (cdr (assoc from mail-source-password-cache)) + (mail-source-read-passwd + (format "Password for %s at %s: " user server)))) + (unless (assoc from mail-source-password-cache) + (push (cons from password) mail-source-password-cache))) (when server (setenv "MAILHOST" server)) (if (cond (program - (when (listp args) - (setq args (eval args))) (mail-source-fetch-with-program - program args mail-source-crash-box)) + (format-spec + program + (format-spec-make ?p password ?t mail-source-crash-box + ?s server ?P port ?u user)))) (function - (funcall function mail-source-crash-box)) + (funcall function mail-source-crash-box)) ;; The default is to use pop3.el. (t (let ((pop3-password password) (pop3-maildrop user) - (pop3-mailhost server)) + (pop3-mailhost server) + (pop3-authentication-scheme + (if (eq authentication 'apop) 'apop 'pass))) (save-excursion (pop3-movemail mail-source-crash-box))))) (mail-source-callback callback server) ;; We nix out the password in case the error @@ -342,6 +346,17 @@ If ARGS, PROMPT is used as an argument to `format'." mail-source-password-cache)) 0)))) +(defun mail-source-fetch-maildir (source callback) + "Fetcher for maildir sources." + (mail-source-bind (maildir source) + (let ((found 0) + (mail-source-string (format "maildir:%s" path))) + (dolist (file (directory-files path t)) + (when (and (file-regular-p file) + (not (rename-file file mail-source-crash-box))) + (incf found (mail-source-callback callback file)))) + found))) + (provide 'mail-source) ;;; mail-source.el ends here diff --git a/lisp/message.el b/lisp/message.el index 5a84b91..a347dc3 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -278,29 +278,6 @@ If t, use `message-user-organization-file'." :type 'file :group 'message-headers) -(defcustom message-forward-start-separator - "------- Start of forwarded message -------\n" - "*Delimiter inserted before forwarded messages." - :group 'message-forwarding - :type 'string) - -(defcustom message-forward-end-separator - "------- End of forwarded message -------\n" - "*Delimiter inserted after forwarded messages." - :group 'message-forwarding - :type 'string) - -(defcustom message-signature-before-forwarded-message t - "*If non-nil, put the signature before any included forwarded message." - :group 'message-forwarding - :type 'boolean) - -(defcustom message-included-forward-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" - "*Regexp matching headers to be included in forwarded messages." - :group 'message-forwarding - :type 'regexp) - (defcustom message-make-forward-subject-function 'message-forward-subject-author-subject "*A list of functions that are called to generate a subject header for forwarded messages. @@ -1537,7 +1514,8 @@ C-c C-a message-mime-attach-file (attach a file as MIME)." (interactive) (if (looking-at "[ \t]*\n") (expand-abbrev)) (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n") nil t)) + (or (search-forward (concat "\n" mail-header-separator "\n") nil t) + (search-forward "\n\n" nil t))) (defun message-goto-eoh () "Move point to the end of the headers." @@ -2115,6 +2093,7 @@ the user from the mailer." (let ((message-deletable-headers (if news nil message-deletable-headers))) (message-generate-headers message-required-mail-headers)) + (untabify (point-min) (point-max)) (let ((mail-parse-charset message-posting-charset)) (mail-encode-encoded-word-buffer)) ;; Let the user do all of the above. @@ -2290,6 +2269,7 @@ to find out how to use this." (message-narrow-to-headers) ;; Insert some headers. (message-generate-headers message-required-news-headers) + (untabify (point-min) (point-max)) (let ((mail-parse-charset message-posting-charset)) (mail-encode-encoded-word-buffer)) ;; Let the user do all of the above. @@ -2589,15 +2569,12 @@ to find out how to use this." ;; Check the length of the signature. (message-check 'signature (goto-char (point-max)) - (if (or (not (re-search-backward message-signature-separator nil t)) - (search-forward message-forward-end-separator nil t)) - t - (if (> (count-lines (point) (point-max)) 5) - (y-or-n-p - (format - "Your .sig is %d lines; it should be max 4. Really post? " - (1- (count-lines (point) (point-max))))) - t))))) + (if (> (count-lines (point) (point-max)) 5) + (y-or-n-p + (format + "Your .sig is %d lines; it should be max 4. Really post? " + (1- (count-lines (point) (point-max))))) + t)))) (defun message-checksum () "Return a \"checksum\" for the current buffer." @@ -3806,29 +3783,10 @@ Optional NEWS will use news to forward instead of mail." (message-mail nil subject)) ;; Put point where we want it before inserting the forwarded ;; message. - (if message-signature-before-forwarded-message - (goto-char (point-max)) - (message-goto-body)) - ;; Make sure we're at the start of the line. - (unless (eolp) - (insert "\n")) - ;; Narrow to the area we are to insert. - (narrow-to-region (point) (point)) - ;; Insert the separators and the forwarded buffer. - (insert message-forward-start-separator) - (setq art-beg (point)) - (insert-buffer-substring cur) - (goto-char (point-max)) - (insert message-forward-end-separator) - (set-text-properties (point-min) (point-max) nil) - ;; Remove all unwanted headers. - (goto-char art-beg) - (narrow-to-region (point) (if (search-forward "\n\n" nil t) - (1- (point)) - (point))) - (goto-char (point-min)) - (message-remove-header message-included-forward-headers t nil t) - (widen) + (message-goto-body) + (insert (format + "\n\n<#part type=message/rfc822 buffer=%S disposition=inline><#/part>\n" + (buffer-name cur))) (message-position-point))) ;;;###autoload @@ -4216,7 +4174,9 @@ TYPE is the MIME type to use." type (prin1-to-string file)))) (defun message-encode-message-body () - (let ((mail-parse-charset message-default-charset) + (let ((mail-parse-charset (or mail-parse-charset + message-default-charset + message-posting-charset)) (case-fold-search t) lines multipart-p content-type-p) (message-goto-body) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index c9b24b5..90de90f 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -38,6 +38,28 @@ ;; BS, vertical TAB, form feed, and ^_ (defvar mm-8bit-char-regexp "[^\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f]") +(defvar mm-body-charset-encoding-alist + '((us-ascii . 7bit) + (iso-8859-1 . quoted-printable) + (iso-8859-2 . quoted-printable) + (iso-8859-3 . quoted-printable) + (iso-8859-4 . quoted-printable) + (iso-8859-5 . base64) + (koi8-r . base64) + (iso-8859-7 . quoted-printable) + (iso-8859-8 . quoted-printable) + (iso-8859-9 . quoted-printable) + (iso-2022-jp . base64) + (iso-2022-kr . base64) + (gb2312 . base64) + (cn-gb . base64) + (cn-gb-2312 . base64) + (euc-kr . base64) + (iso-2022-jp-2 . base64) + (iso-2022-int-1 . base64)) + "Alist of MIME charsets to encodings. +Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'.") + (defun mm-encode-body () "Encode a body. Should be called narrowed to the body that is to be encoded. @@ -58,8 +80,7 @@ If no encoding was done, nil is returned." nil)) (save-excursion (goto-char (point-min)) - (let ((charsets - (delq 'ascii (mm-find-charset-region (point-min) (point-max)))) + (let ((charsets (mm-find-mime-charset-region (point-min) (point-max))) charset) (cond ;; No encoding. @@ -70,30 +91,44 @@ If no encoding was done, nil is returned." charsets) ;; We encode. (t - (let ((mime-charset (mm-mime-charset (car charsets))) + (let ((charset (car charsets)) start) (when (or t ;; We always decode. (not (mm-coding-system-equal - mime-charset buffer-file-coding-system))) + charset buffer-file-coding-system))) (while (not (eobp)) (if (eq (char-charset (char-after)) 'ascii) (when start (save-restriction (narrow-to-region start (point)) - (mm-encode-coding-region start (point) mime-charset) + (mm-encode-coding-region start (point) charset) (goto-char (point-max))) (setq start nil)) (unless start (setq start (point)))) (forward-char 1)) (when start - (mm-encode-coding-region start (point) mime-charset) + (mm-encode-coding-region start (point) charset) (setq start nil))) - mime-charset))))))) - -(defun mm-body-encoding () - "Return the encoding of the current buffer." + charset))))))) + +(defun mm-body-encoding (charset) + "Do Content-Transfer-Encoding and return the encoding of the current buffer." + (let ((bits (mm-body-7-or-8))) + (cond + ((eq bits '7bit) + bits) + ((eq charset mail-parse-charset) + bits) + (t + (let ((encoding (or (cdr (assq charset mm-body-charset-encoding-alist )) + 'quoted-printable))) + (mm-encode-content-transfer-encoding encoding "text/plain") + encoding))))) + +(defun mm-body-7-or-8 () + "Say whether the body is 7bit or 8bit." (cond ((not (featurep 'mule)) (if (save-excursion @@ -161,8 +196,8 @@ The characters in CHARSET should then be decoded." (when (and charset (setq mule-charset (mm-charset-to-coding-system charset)) ;; buffer-file-coding-system - ;Article buffer is nil coding system - ;in XEmacs + ;;Article buffer is nil coding system + ;;in XEmacs enable-multibyte-characters (or (not (eq mule-charset 'ascii)) (setq mule-charset mail-parse-charset))) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 6c597db..1634ce3 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -58,16 +58,21 @@ (iso-8859-7 greek-iso8859-7) (iso-8859-8 hebrew-iso8859-8) (iso-8859-9 latin-iso8859-9) + (viscii vietnamese-viscii-lower) (iso-2022-jp-2 japanese-jisx0208) (iso-2022-jp latin-jisx0201 japanese-jisx0208-1978) (euc-kr korean-ksc5601) (cn-gb-2312 chinese-gb2312) (cn-big5 chinese-big5-1 chinese-big5-2) + (tibetan tibetan) + (thai-tis620 thai-tis620) + (iso-2022-7bit ethiopic arabic-1-column arabic-2-column) (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 latin-jisx0201 japanese-jisx0208-1978 chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212) + korean-ksc5601 japanese-jisx0212 + katakana-jisx0201) (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 latin-jisx0201 japanese-jisx0208-1978 chinese-gb2312 japanese-jisx0208 @@ -200,10 +205,19 @@ used as the line break code type of the coding system." 'mime-charset)) (and (eq charset 'ascii) 'us-ascii) - (get-charset-property charset 'prefered-coding-system)) + (get-charset-property charset 'prefered-coding-system) + (mm-mule-charset-to-mime-charset charset)) ;; This is for XEmacs. (mm-mule-charset-to-mime-charset charset))) +(defun mm-find-mime-charset-region (b e) + "Return the MIME charsets needed to encode the region between B and E." + (let ((charsets + (mapcar 'mm-mime-charset + (delq 'ascii + (mm-find-charset-region b e))))) + (delete-duplicates charsets))) + (defsubst mm-multibyte-p () "Say whether multibyte is enabled." (and (boundp 'enable-multibyte-characters) @@ -238,9 +252,7 @@ See also `with-temp-file' and `with-output-to-string'." (defun mm-find-charset-region (b e) "Return a list of charsets in the region." (cond - ((and (boundp 'enable-multibyte-characters) - enable-multibyte-characters - (fboundp 'find-charset-region)) + ((fboundp 'find-charset-region) (find-charset-region b e)) ((not (boundp 'current-language-environment)) (save-excursion diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index a412fdf..e664119 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -2,7 +2,7 @@ ;; Copyright (c) 1998 by Shenghuo Zhu ;; Author: Shenghuo Zhu -;; $Revision: 1.1.1.13 $ +;; $Revision: 1.1.1.14 $ ;; Keywords: news postscript uudecode binhex shar ;; This file is not part of GNU Emacs, but the same permissions diff --git a/lisp/mml.el b/lisp/mml.el index 8bb6a85..779997c 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -71,7 +71,7 @@ warn t)) (setq point (point) contents (mml-read-part) - charsets (delq 'ascii (mm-find-charset-region point (point)))) + charsets (mm-find-mime-charset-region point (point))) (if (< (length charsets) 2) (push (nconc tag (list (cons 'contents contents))) struct) @@ -93,15 +93,16 @@ (save-excursion (narrow-to-region beg end) (goto-char (point-min)) - (let ((current (char-charset (following-char))) + (let ((current (mm-mime-charset (char-charset (following-char)))) charset struct space newline paragraph) (while (not (eobp)) (cond ;; The charset remains the same. - ((or (eq (setq charset (char-charset (following-char))) 'ascii) + ((or (eq (setq charset (mm-mime-charset + (char-charset (following-char)))) 'us-ascii) (eq charset current))) ;; The initial charset was ascii. - ((eq current 'ascii) + ((eq current 'us-ascii) (setq current charset space nil newline nil @@ -157,6 +158,7 @@ (push (cons (intern elem) val) contents) (skip-chars-forward " \t\n")) (forward-char 1) + (skip-chars-forward " \t\n") (cons (intern name) (nreverse contents)))) (defun mml-read-part () @@ -201,8 +203,12 @@ (setq type (or (cdr (assq 'type cont)) "text/plain")) (if (equal (car (split-string type "/")) "text") (with-temp-buffer - (if (setq filename (cdr (assq 'filename cont))) - (insert-file-contents-literally filename) + (cond + ((cdr (assq 'buffer cont)) + (insert-buffer-substring (cdr (assq 'buffer cont)))) + ((setq filename (cdr (assq 'filename cont))) + (insert-file-contents-literally filename)) + (t (save-restriction (narrow-to-region (point) (point)) (insert (cdr (assq 'contents cont))) @@ -211,14 +217,18 @@ (while (re-search-forward "<#!+/?\\(part\\|multipart\\|external\\)" nil t) (delete-region (+ (match-beginning 0) 2) - (+ (match-beginning 0) 3))))) - (setq charset (mm-encode-body) - encoding (mm-body-encoding)) + (+ (match-beginning 0) 3)))))) + (setq charset (mm-encode-body)) + (setq encoding (mm-body-encoding charset)) (setq coded (buffer-string))) (mm-with-unibyte-buffer - (if (setq filename (cdr (assq 'filename cont))) - (insert-file-contents-literally filename) - (insert (cdr (assq 'contents cont)))) + (cond + ((cdr (assq 'buffer cont)) + (insert-buffer-substring (cdr (assq 'buffer cont)))) + ((setq filename (cdr (assq 'filename cont))) + (insert-file-contents-literally filename)) + (t + (insert (cdr (assq 'contents cont))))) (setq encoding (mm-encode-buffer type) coded (buffer-string)))) (mml-insert-mime-headers cont type charset encoding) @@ -283,9 +293,13 @@ (cond ((eq (car cont) 'part) (with-temp-buffer - (if (setq filename (cdr (assq 'filename cont))) - (insert-file-contents-literally filename) - (insert (cdr (assq 'contents cont)))) + (cond + ((cdr (assq 'buffer cont)) + (insert-buffer-substring (cdr (assq 'buffer cont)))) + ((setq filename (cdr (assq 'filename cont))) + (insert-file-contents-literally filename)) + (t + (insert (cdr (assq 'contents cont))))) (goto-char (point-min)) (when (re-search-forward (concat "^--" (regexp-quote mml-boundary)) nil t) @@ -377,6 +391,71 @@ (goto-char (match-beginning 1)) (insert "!")))) +;;; +;;; Transforming MIME to MML +;;; + +(defun mime-to-mml () + "Translate the current buffer (which should be a message) into MML." + ;; First decode the head. + (save-restriction + (message-narrow-to-head) + (mail-decode-encoded-word-region (point-min) (point-max))) + (let ((handles (mm-dissect-buffer t))) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (delete-region (point) (point-max)) + (if (stringp (car handles)) + (mml-insert-mime handles) + (mml-insert-mime handles t)) + (mm-destroy-parts handles))) + +(defun mml-to-mime () + "Translate the current buffer from MML to MIME." + (message-encode-message-body) + (save-restriction + (message-narrow-to-headers) + (mail-encode-encoded-word-buffer))) + +(defun mml-insert-mime (handle &optional no-markup) + (let (textp buffer) + ;; Determine type and stuff. + (unless (stringp (car handle)) + (unless (setq textp (equal + (car (split-string + (car (mm-handle-type handle)) "/")) + "text")) + (save-excursion + (set-buffer (setq buffer (generate-new-buffer " *mml*"))) + (mm-insert-part handle)))) + (unless no-markup + (mml-insert-mml-markup handle buffer)) + (cond + ((stringp (car handle)) + (mapcar 'mml-insert-mime (cdr handle)) + (insert "<#/multipart>\n")) + (textp + (mm-insert-part handle) + (goto-char (point-max))) + (t + (insert "<#/part>\n"))))) + +(defun mml-insert-mml-markup (handle &optional buffer) + "Take a MIME handle and insert an MML tag." + (if (stringp (car handle)) + (insert "<#multipart type=" (cadr (split-string (car handle) "/")) + ">\n") + (insert "<#part type=" (car (mm-handle-type handle))) + (dolist (elem (append (cdr (mm-handle-type handle)) + (cdr (mm-handle-disposition handle)))) + (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\"")) + (when buffer + (insert " buffer=\"" (buffer-name buffer) "\"")) + (when (mm-handle-description handle) + (insert " description=\"" (mm-handle-description handle) "\"")) + (equal (split-string (car (mm-handle-type handle)) "/") "text") + (insert ">\n"))) + (provide 'mml) ;;; mml.el ends here diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 2534798..fc35e36 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -38,7 +38,7 @@ (defvoo nndoc-article-type 'guess "*Type of the file. One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', -`rfc934', `rfc822-forward', `mime-digest', `mime-parts', `standard-digest', +`rfc934', `rfc822-forward', `mime-parts', `standard-digest', `slack-digest', `clari-briefs' or `guess'.") (defvoo nndoc-post-type 'mail @@ -81,12 +81,6 @@ from the document.") (head-end . "^\t") (generate-head-function . nndoc-generate-clari-briefs-head) (article-transform-function . nndoc-transform-clari-briefs)) - (mime-digest - (article-begin . "") - (head-end . "^ ?$") - (body-end . "") - (file-end . "") - (subtype digest guess)) (mime-parts (generate-head-function . nndoc-generate-mime-parts-head) (article-transform-function . nndoc-transform-mime-parts)) @@ -506,27 +500,6 @@ from the document.") (insert "From: " "clari@clari.net (" (or from "unknown") ")" "\nSubject: " (or subject "(no subject)") "\n"))) -(defun nndoc-mime-digest-type-p () - (let ((case-fold-search t) - boundary-id b-delimiter entry) - (when (and - (re-search-forward - (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]" - "boundary=\"?\\([^\"\n]*[^\" \t\n]\\)") - nil t) - (match-beginning 1)) - (setq boundary-id (match-string 1) - b-delimiter (concat "\n--" boundary-id "[\n \t]+")) - (setq entry (assq 'mime-digest nndoc-type-alist)) - (setcdr entry - (list - (cons 'head-end "^ ?$") - (cons 'body-begin "^ ?\n") - (cons 'article-begin b-delimiter) - (cons 'body-end-function 'nndoc-digest-body-end) - (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$")))) - t))) - (defun nndoc-standard-digest-type-p () (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t) (re-search-forward diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 898d14d..9c8681e 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -783,7 +783,8 @@ deleted. Point is left where the deleted region was." ;;;###autoload (defun nnfolder-generate-active-file () - "Look for mbox folders in the nnfolder directory and make them into groups." + "Look for mbox folders in the nnfolder directory and make them into groups. +This command does not work if you use short group names." (interactive) (nnmail-activate 'nnfolder) (let ((files (directory-files nnfolder-directory)) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index d329577..24aa197 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -308,6 +308,12 @@ on your system, you could say something like: out))) out)) +(defmacro nnheader-nov-read-message-id () + '(let ((id (nnheader-nov-field))) + (if (string-match "^<[^>]+>$" id) + id + (nnheader-generate-fake-message-id)))) + (defun nnheader-parse-nov () (let ((eol (gnus-point-at-eol))) (vector @@ -315,8 +321,7 @@ on your system, you could say something like: (nnheader-nov-field) ; subject (nnheader-nov-field) ; from (nnheader-nov-field) ; date - (or (nnheader-nov-field) - (nnheader-generate-fake-message-id)) ; id + (nnheader-nov-read-message-id) ; id (nnheader-nov-field) ; refs (nnheader-nov-read-integer) ; chars (nnheader-nov-read-integer) ; lines diff --git a/lisp/nnmail.el b/lisp/nnmail.el index fa88651..e84537e 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -786,6 +786,40 @@ If SOURCE is a directory spec, try to return the group name component." (goto-char end) (forward-line 2))))) +(defun nnmail-process-maildir-mail-format (func artnum-func) +; In a maildir, every file contains exactly one mail + (let ((case-fold-search t) + message-id) + (goto-char (point-min)) + ;; Find the end of the head. + (narrow-to-region + (point-min) + (if (search-forward "\n\n" nil t) + (1- (point)) + ;; This will never happen, but just to be on the safe side -- + ;; if there is no head-body delimiter, we search a bit manually. + (while (and (looking-at "From \\|[^ \t]+:") + (not (eobp))) + (forward-line 1) + (point)))) + ;; Find the Message-ID header. + (goto-char (point-min)) + (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t) + (setq message-id (match-string 1)) + ;; There is no Message-ID here, so we create one. + (save-excursion + (when (re-search-backward "^Message-ID[ \t]*:" nil t) + (beginning-of-line) + (insert "Original-"))) + (forward-line 1) + (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n")) + (run-hooks 'nnmail-prepare-incoming-header-hook) + ;; Allow the backend to save the article. + (widen) + (save-excursion + (goto-char (point-min)) + (nnmail-check-duplication message-id func artnum-func)))) + (defun nnmail-split-incoming (incoming func &optional exit-func group artnum-func) "Go through the entire INCOMING file and pick out each individual mail. @@ -813,6 +847,8 @@ FUNC will be called with the buffer narrowed to each mail." (nnmail-process-babyl-mail-format func artnum-func)) ((looking-at "\^A\^A\^A\^A") (nnmail-process-mmdf-mail-format func artnum-func)) + ((looking-at "Return-Path:") + (nnmail-process-maildir-mail-format func artnum-func)) (t (nnmail-process-unix-mail-format func artnum-func)))) (when exit-func @@ -1289,6 +1325,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;;; Get new mail. +(defvar nnmail-fetched-sources nil) + (defun nnmail-get-value (&rest args) (let ((sym (intern (apply 'format args)))) (when (boundp sym) @@ -1314,7 +1352,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;; and fetch the mail from each. (while (setq source (pop sources)) ;; Be compatible with old values. - (when (stringp source) + (cond + ((stringp source) (setq source (cond ((string-match "^po:" source) @@ -1323,15 +1362,31 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (list 'directory :path source)) (t (list 'file :path source))))) + ((eq source 'procmail) + (message "Invalid value for nnmail-spool-file: `procmail'") + nil)) (nnheader-message 4 "%s: Reading incoming mail from %s..." method (car source)) - (when (mail-source-fetch - source - `(lambda (file orig-file) - (nnmail-split-incoming - file ',(intern (format "%s-save-mail" method)) - ',spool-func (nnmail-get-split-group orig-file source) - ',(intern (format "%s-active-number" method))))) + ;; Hack to only fetch the contents of a single group's spool file. + (when (and (eq (car source) 'directory) + group) + (setq source (append source + (list :predicate + `(lambda (file) + (string-match ,(regexp-quote group) + file)))))) + (when nnmail-fetched-sources + (if (member source nnmail-fetched-sources) + (setq source nil) + (push source nnmail-fetched-sources))) + (when (and source + (mail-source-fetch + source + `(lambda (file orig-file) + (nnmail-split-incoming + file ',(intern (format "%s-save-mail" method)) + ',spool-func (nnmail-get-split-group orig-file source) + ',(intern (format "%s-active-number" method)))))) (incf i))) ;; If we did indeed read any incoming spools, we save all info. (unless (zerop i) diff --git a/lisp/nnml.el b/lisp/nnml.el index ed3e365..d4a2a58 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -591,7 +591,7 @@ all. This may very well take some time.") (let ((file (concat (nnmail-group-pathname (caar ga) nnml-directory) (int-to-string (cdar ga))))) - (if first +z (if first ;; It was already saved, so we just make a hard link. (funcall nnmail-crosspost-link-function first file t) ;; Save the article. diff --git a/lisp/nntp.el b/lisp/nntp.el index c8b4933..816b98f 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -221,7 +221,7 @@ noticing asynchronous data.") (defvar nntp-async-process-list nil) (eval-and-compile - (autoload 'nnmail-read-passwd "nnmail") + (autoload 'mail-source-read-passwd "mail-source") (autoload 'open-ssl-stream "ssl")) @@ -779,7 +779,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the (or passwd nntp-authinfo-password (setq nntp-authinfo-password - (nnmail-read-passwd (format "NNTP (%s@%s) password: " + (mail-source-read-passwd (format "NNTP (%s@%s) password: " user nntp-address)))))))))) (defun nntp-send-nosy-authinfo () @@ -789,7 +789,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user) (when t ;???Should check if AUTHINFO succeeded (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS" - (nnmail-read-passwd "NNTP (%s@%s) password: " + (mail-source-read-passwd "NNTP (%s@%s) password: " user nntp-address)))))) (defun nntp-send-authinfo-from-file () @@ -1254,7 +1254,7 @@ password contained in '~/.nntp-authinfo'." proc (concat (or nntp-telnet-passwd (setq nntp-telnet-passwd - (nnmail-read-passwd "Password: "))) + (mail-source-read-passwd "Password: "))) "\n")) (erase-buffer) (nntp-wait-for-string nntp-telnet-shell-prompt) diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index 61fbc2b..1b745ee 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -219,7 +219,9 @@ to virtual article number.") (if buffer (save-excursion (set-buffer buffer) - (gnus-request-article-this-buffer (cdr amap) cgroup)) + ;; We bind this here to avoid double decoding. + (let ((gnus-article-decode-hook nil)) + (gnus-request-article-this-buffer (cdr amap) cgroup))) (gnus-request-article (cdr amap) cgroup)))))))) diff --git a/lisp/pop3.el b/lisp/pop3.el index 3200fd4..391d5b8 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -104,7 +104,7 @@ Used for APOP authentication.") (pop3-quit process) (kill-buffer crashbuf) ) - ) + t) (defun pop3-open-server (mailhost port) "Open TCP connection to MAILHOST. diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 7e2e570..f11194c 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -124,7 +124,8 @@ Should be called narrowed to the head of the message." (when method (cond ((eq method 'mime) - (rfc2047-encode-region (point-min) (point-max))) + (rfc2047-encode-region (point-min) (point-max)) + (rfc2047-fold-region (point-min) (point-max))) ;; Hm. (t)))) (goto-char (point-max))))) @@ -207,6 +208,27 @@ Should be called narrowed to the head of the message." (insert "?=") (forward-line 1))))) +(defun rfc2047-fold-region (b e) + "Fold the long lines in the region." + (save-restriction + (narrow-to-region b e) + (goto-char (point-min)) + (let ((break nil)) + (while (not (eobp)) + (cond + ((memq (char-after) '(? ?\t)) + (setq break (point))) + ((and (not break) + (looking-at "=\\?")) + (setq break (point))) + ((and (looking-at "\\?=") + (> (- (point) (save-excursion (beginning-of-line) (point))) 76)) + (goto-char break) + (insert "\n ") + (forward-line 1))) + (unless (eobp) + (forward-char 1)))))) + (defun rfc2047-b-encode-region (b e) "Encode the header contained in REGION with the B encoding." (base64-encode-region b e t) diff --git a/lisp/uudecode.el b/lisp/uudecode.el index ea58b84..0703974 100644 --- a/lisp/uudecode.el +++ b/lisp/uudecode.el @@ -2,7 +2,7 @@ ;; Copyright (c) 1998 by Shenghuo Zhu ;; Author: Shenghuo Zhu -;; $Revision: 5.5 $ +;; $Revision: 5.6 $ ;; Keywords: uudecode ;; This file is not part of GNU Emacs, but the same permissions diff --git a/texi/ChangeLog b/texi/ChangeLog index eb96ea0..bb263d0 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,19 @@ +1999-02-09 16:21:35 Lars Magne Ingebrigtsen + + * gnus.texi (Charsets): New. + +1999-02-04 03:45:15 Lars Magne Ingebrigtsen + + * emacs-mime.texi (Conversion): New. + +1999-02-03 03:04:18 Miguel de Icaza + + * gnus.texi (Fetching Mail): Typo fix. + +1999-02-02 22:28:42 Lars Magne Ingebrigtsen + + * gnus.texi (Mail Source Specifiers): Addition. + 1999-02-01 21:05:18 Lars Magne Ingebrigtsen * gnus.texi (Article Hiding): Addition. diff --git a/texi/emacs-mime.texi b/texi/emacs-mime.texi index 0150301..e40194a 100644 --- a/texi/emacs-mime.texi +++ b/texi/emacs-mime.texi @@ -863,6 +863,7 @@ string containing the @sc{mime} message. * Simple MML Example:: An example MML document. * MML Definition:: All valid MML elements. * Advanced MML Example:: Another example MML document. +* Conversion:: Going from @sc{mime} to MML and vice versa. @end menu @@ -1084,6 +1085,33 @@ This plain text part is an attachment. @end example +@node Conversion +@section Conversion + +@findex mime-to-mml +A (multipart) @sc{mime} message can be converted to MML with the +@code{mime-to-mml} function. It works on the message in the current +buffer, and substitutes MML markup for @sc{mime} boundaries. +Non-textual parts do not have their contents in the buffer, but instead +have the contents in separate buffers that are referred to from the MML +tags. + +@findex mml-to-mime +An MML message can be converted back to @sc{mime} by the +@code{mml-to-mime} function. + +These functions are in certain senses ``lossy''---you will not get back +an identical message if you run @sc{mime-to-mml} and then +@sc{mml-to-mime}. Not only will trivial things like the order of the +headers differ, but the contents of the headers may also be different. +For instance, the original message may use base64 encoding on text, +while @sc{mml-to-mime} may decide to use quoted-printable encoding, and +so on. + +In essence, however, these two functions should be the inverse of each +other. The resulting contents of the message should remain equivalent, +if not identical. + @node Standards @chapter Standards diff --git a/texi/gnus.texi b/texi/gnus.texi index 38c5bbb..812ebb5 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.75 Manual +@settitle Pterodactyl Gnus 0.76 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Gnus 0.75 Manual +@title Pterodactyl Gnus 0.76 Manual @author by Lars Magne Ingebrigtsen @page @@ -354,7 +354,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Pterodactyl Gnus 0.75. +This manual corresponds to Pterodactyl Gnus 0.76. @end ifinfo @@ -3252,6 +3252,7 @@ You can have as many summary buffers open as you wish. * Decoding Articles:: Gnus can treat series of (uu)encoded articles. * Article Treatment:: The article buffer can be mangled at will. * MIME Commands:: Doing MIMEy things with the articles. +* Charsets:: Character set issues. * Article Commands:: Doing various things with the article buffer. * Summary Sorting:: Sorting the summary buffer in various ways. * Finding the Parent:: No child support? Get the parent. @@ -6021,7 +6022,7 @@ for instance, @code{sox} to convert an @samp{.au} sound file, you could say something like: @lisp (setq gnus-uu-user-view-rules - (list '(\"\\\\.au$\" \"sox %s -t .aiff > /dev/audio\"))) + (list '("\\\\.au$" "sox %s -t .aiff > /dev/audio"))) @end lisp @item gnus-uu-user-view-rules-end @@ -7037,6 +7038,33 @@ Here's an example function the does the latter: @end table +@node Charsets +@section Charsets +@cindex charsets + +People use different charsets, and we have @sc{mime} to let us know what +charsets they use. Or rather, we wish we had. Many people use +newsreaders and mailers that do not understand or use @sc{mime}, and +just send out messages without saying what character sets they use. To +help a bit with this, some local news hierarchies have policies that say +what character set is the default. For instance, the @samp{fj} +hierarchy uses @code{iso-2022-jp-2}. + +@vindex gnus-group-charset-alist +This knowledge is encoded in the @code{gnus-group-charset-alist} +variable, which is an alist of regexps (to match group names) and +default charsets to be used when reading these groups. + +In addition, some people do use soi-disant @sc{mime}-aware agents that +aren't. These blitely mark messages as being in @code{iso-8859-1} even +if they really are in @code{koi-8}. To help here, the +@code{gnus-newsgroup-ignored-charsets} variable can be used. The +charsets that are listed here will be ignored. The variable can be set +on a group-by-group basis using the group parameters (@pxref{Group +Parameters}). The default value is @code{(unknown-8bit)}, which is +something some agents insist on having in there. + + @node Article Commands @section Article Commands @@ -9962,6 +9990,13 @@ value. @item :suffix Only files ending with this suffix are used. The default is @samp{.spool}. + +@item :predicate +Only files that have this predicate return non-@code{nil} are returned. +The default is @code{identity}. This is used as an additional +filter---only files that have the right suffix @emph{and} satisfy this +predicate are considered. + @end table An example directory mail source: @@ -9993,17 +10028,46 @@ The password to give to the POP server. If not specified, the user is prompted. @item :program -The program to use to fetch mail from the POP server. +The program to use to fetch mail from the POP server. This is should be +a @code{format}-like string. Here's an example: -@item :args -The arguments to give to the program. If this is a string, it is used -as such. If this is a list, it is @code{eval}ed first, and the result -is used. +@example +fetchmail %u@@%s -P %p %t +@end example + +The valid format specifier characters are: + +@table @samp +@item t +The name of the file the mail is to be moved to. This must always be +included in this string. + +@item s +The name of the server. + +@item P +The port number of the server. + +@item u +The user name to use. + +@item p +The password to use. +@end table + +The values used for these specs are taken from the values you give the +corresponding keywords. @item :function The function to use to fetch mail from the POP server. The function is called with one parameter---the name of the file where the mail should be moved to. + +@item :authentication +This can be either the symbol @code{password} or the symbol @code{apop} +and says what authentication scheme to use. The default is +@code{password}. + @end table If the @code{:program} and @code{:function} keywords aren't specified, @@ -10091,7 +10155,7 @@ If you want to fetch mail both from your local spool as well as a POP mail server, you'd say something like: @lisp -(setq mail-spool-file +(setq nnmail-spool-file '((file) (pop :server "pop3.mail.server" :password "secret"))) @@ -10100,7 +10164,7 @@ mail server, you'd say something like: Or, if you don't want to use any of the keyword defaults: @lisp -(setq mail-spool-file +(setq nnmail-spool-file '((file :path "/var/spool/mail/user-name") (pop :server "pop3.mail.server" :user "user-name" @@ -10886,7 +10950,8 @@ extract some information from it before removing it. If you have lots of @code{nnfolder}-like files you'd like to read with @code{nnfolder}, you can use the @kbd{M-x nnfolder-generate-active-file} command to make @code{nnfolder} aware of all likely files in -@code{nnfolder-directory}. +@code{nnfolder-directory}. This only works if you use long file names, +though. @node Other Sources @@ -11035,15 +11100,7 @@ The rnews batch transport format. Forwarded articles. @item mime-parts -MIME multipart messages, besides digests. - -@item mime-digest -@cindex digest -@cindex MIME digest -@cindex 1153 digest -@cindex RFC 1153 digest -@cindex RFC 341 digest -MIME (RFC 1341) digest format. +MIME multipart messages. @item standard-digest The standard (RFC 1153) digest format. @@ -11079,9 +11136,8 @@ Virtual server variables: @vindex nndoc-article-type This should be one of @code{mbox}, @code{babyl}, @code{digest}, @code{news}, @code{rnews}, @code{mmdf}, @code{forward}, @code{rfc934}, -@code{rfc822-forward}, @code{mime-parts}, @code{mime-digest}, -@code{standard-digest}, @code{slack-digest}, @code{clari-briefs} or -@code{guess}. +@code{rfc822-forward}, @code{mime-parts}, @code{standard-digest}, +@code{slack-digest}, @code{clari-briefs} or @code{guess}. @item nndoc-post-type @vindex nndoc-post-type @@ -12760,10 +12816,10 @@ Score on the author name. Score on the subject line. @item x -Score on the Xref line---i.e., the cross-posting line. +Score on the @code{Xref} line---i.e., the cross-posting line. @item r -Score on the References line. +Score on the @code{References} line. @item d Score on the date. @@ -12772,10 +12828,11 @@ Score on the date. Score on the number of lines. @item i -Score on the Message-ID. +Score on the @code{Message-ID} header. @item f -Score on followups. +Score on followups---this matches the author name, and adds scores to +the followups to this author. @item b Score on the body. diff --git a/texi/message.texi b/texi/message.texi index 4006158..4eab43a 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.75 Manual +@settitle Pterodactyl Message 0.76 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Message 0.75 Manual +@title Pterodactyl Message 0.76 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,7 +83,7 @@ Message mode buffers. * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Pterodactyl Message 0.75. Message is +This manual corresponds to Pterodactyl Message 0.76. Message is distributed with the Gnus distribution bearing the same version number as this manual. -- 1.7.10.4