Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

*** empty log message ***

  • Loading branch information...
commit 4e82d566924d807ea0927aa382f7f875e14f33be 1 parent 9bff3e1
@larsmagne larsmagne authored
View
227 lisp/ChangeLog
@@ -1,3 +1,230 @@
+Thu Feb 11 04:58:51 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.76 is released.
+
+1999-02-06 Felix Lee <flee@cygnus.com>
+
+ * gnus.el (gnus-group-change-level-function): Typo.
+
+1999-02-11 05:47:51 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <yamaoka@jpl.org>
+
+ * 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 <larsi@gnus.org>
+
+ * gnus.el (gnus-other-frame): Always pop up a new frame.
+
+Wed Feb 10 01:03:43 1999 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-range.el (gnus-range-add): Rewrite.
+
+1999-02-02 18:12:00 Carsten Leonhardt <leo@arioch.oche.de>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <larsi@gnus.org>
+
+ * mml.el (mml-parse-singlepart-with-multiple-charsets): Check for
+ us-ascii.
+
+1999-02-04 00:00:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <ichikawa@hv.epson.co.jp>
+
+ * mail-source.el (mail-source-fetch-with-program): Take optional
+ parameter.
+
+1999-02-03 00:31:21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <eichin@thok.org>
+
+ * 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 <kmkaplan@western.fr>
+
+ * gnus-picon.el (gnus-picons-parse-filenames): Quote group names.
+
+1999-01-28 04:15:46 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-start.el (gnus-read-active-file): Eliminate duplicated
+ select methods.
+
+1999-01-27 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus-range.el (gnus-remove-from-range): Sort second argument.
+
+1999-02-02 10:55:23 Scott Hofmann <shofmann@mindspring.com>
+
+ * nntp.el: Use mail-source-read-passwd instead of nnmail-read-passwd.
+
+Mon Feb 1 23:23:03 1999 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <cook@sightpath.com>
+
+ * Defenestrate spurious ?a.
+
+1999-02-02 21:59:51 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail-source.el (mail-source-fetch-pop): Instead use
+ :authentication.
+
+1999-02-01 Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
+
+ * lisp/mail-source.el : Support APOP authentication scheme.
+
+1999-02-02 21:56:14 Tatsuya Ichikawa <t-ichi@niagara.shiojiri.ne.jp>
+
+ * pop3.el (pop3-movemail): Return t.
+
+1999-02-02 21:48:46 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * rfc2047.el (rfc2047-fold-region): New function.
+ (rfc2047-encode-message-header): Use it.
+
+1999-02-02 21:07:27 Hallvard B. Furuseth <h.b.furuseth@usit.uio.no>
+
+ * gnus-sum.el (gnus-group-charset-alist): Add more.
+
Mon Feb 1 21:18:00 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.75 is released.
View
71 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 <larsi@gnus.org>
+;; 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
View
1  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)))))
View
169 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)
View
4 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.
View
8 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.
View
1  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"))
View
8 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."
View
5 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\\)/"
View
73 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)
View
60 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
View
110 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\\>\\|\\<chinese\\>" 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))
View
10 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))
View
63 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
View
74 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)
View
59 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)))
View
22 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
View
109 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
View
29 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))
@@ -505,27 +499,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
View
3  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))
View
9 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
View
71 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)
View
2  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.
View
8 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)
View
4 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))))))))
View
2  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.
View
24 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)))