From: yamaoka Date: Tue, 9 Nov 1999 00:51:44 +0000 (+0000) Subject: Sync up with Pterodactyl Gnus v0.98. X-Git-Tag: t-gnus-6_13_3-00~3 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=888466827905a8610e02f3a7a061cc5e3dec1f1e;p=elisp%2Fgnus.git- Sync up with Pterodactyl Gnus v0.98. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 14ba45e..885e63a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,193 @@ +Fri Nov 5 19:10:02 1999 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.98 is released. + +1999-11-05 01:27:49 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-expire): Remove bad line in NOV. + +1999-11-04 22:20:35 Shenghuo ZHU + + * mml.el (mml-generate-mime-1): Read attached binary file in + binary mode. + +1999-11-03 16:08:56 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-toggle-header): Fix arg bug. + +1999-11-03 15:27:38 Shenghuo ZHU + + * mailcap.el (mailcap-viewer-lessp): Fix bug. + +1999-11-02 17:28:33 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-search-article): Fix loop search bug. + +1999-10-31 21:24:59 Shenghuo ZHU + + * gnus-art.el (gnus-article-mime-match-handle-first): New function. + (gnus-article-mime-match-handle-function): New variable. + (gnus-article-view-part): Make `b' customizable. + +1999-10-29 14:30:07 Shenghuo ZHU + + * gnus-sum.el (gnus-article-get-xrefs): Test eobp. + +1999-09-27 Hrvoje Niksic + + * mm-decode.el (mm-attachment-override-types): Exclude text/plain. + +1999-10-26 23:27:44 Shenghuo ZHU + + * mm-decode.el (mm-dissect-buffer): CTE may come without CTL. + +1999-10-26 21:44:05 Shenghuo ZHU + + * gnus-srvr.el (gnus-browse-foreign-server): Use + `buffer-substring' instead of `read'. + +1999-10-23 Simon Josefsson + + * nnimap.el, imap.el, rfc2104.el: New files. + + * gnus.el (gnus-valid-select-methods): Add nnimap. + + * gnus-group.el (gnus-group-group-map): Add + gnus-group-nnimap-edit-acl, gnus-group-nnimap-expunge. + (gnus-group-nnimap-expunge): New function. + (gnus-group-nnimap-edit-acl): New function. + + * gnus-agent.el (gnus-agent-group-mode-map): Add + gnus-agent-synchronize. + (gnus-agent-synchronize): New function. + (gnus-agent-fetch-group-1): Check if server is open. + + * nnagent.el (nnagent-request-set-mark): Save marks. + + * mail-source.el (mail-source-keyword-map): New imap mail-source. + (mail-source-fetcher-alist): Map to imap fetcher function. + (mail-source-fetch-imap): New function. + + * gnus-art.el (article-hide-pgp): Hide all headers, not just + Hash:. + +1999-10-22 11:03:00 Shenghuo ZHU + + * gnus-topic.el (gnus-topic-sort-topics-1): New function. + (gnus-topic-sort-topics): New function. + (gnus-topic-make-menu-bar): Add sort-topics. + (gnus-topic-move): New function. + (gnus-topic-move-group): Move the topic if no group selected. + +1999-10-13 21:31:50 Shenghuo ZHU + + * gnus-art.el (gnus-article-setup-buffer): Fix buffer leak. + +1999-10-13 12:52:18 Shenghuo ZHU + + * mm-view.el (mm-inline-message): Fix leaving group bug. + +1999-10-07 17:59:49 Shenghuo ZHU + + * gnus-msg.el (gnus-post-method): Use normal method if current is + not available. + +1999-10-07 17:09:34 Shenghuo ZHU + + * nnmail.el (nnmail-insert-xref): Dealing with empty articles. + (nnmail-insert-lines): Ditto. + +1999-10-07 Shenghuo ZHU + + * nnfolder.el (nnfolder-insert-newsgroup-line): Insert a blank + line. + + * message.el (message-unsent-separator): One more separator. + +1999-10-06 Shenghuo ZHU + + * nnfolder.el (nnfolder-request-move-article): For empty article, + search till (point-max). + (nnfolder-retrieve-headers): Ditto. + (nnfolder-request-accept-article): Ditto. + (nnfolder-save-mail): Ditto. + (nnfolder-insert-newsgroup-line): Ditto. + +1999-10-05 Shenghuo ZHU + + * qp.el (quoted-printable-encode-region): Check eobp. + +1999-10-03 Shenghuo ZHU + + * nntp.el (nntp-retrieve-headers-with-xover): Fix hanging problem. + +1999-10-02 Shenghuo ZHU + + * nntp.el (nntp-send-xover-command): Wait for nothing if not + wait-for-reply. + +1999-09-29 Shenghuo ZHU + + * mm-uu.el (mm-uu-forward-begin-line): Change the regexp. + (mm-uu-forward-end-line): Ditto. + +1999-09-29 Didier Verna + + * binhex.el (binhex-decode-region): don't consider the value of + `enable-multibyte-characters' in XEmacs. + + * gnus-start.el (gnus-read-descriptions-file): ditto. + + * mm-util.el (mm-multibyte-p): ditto. + (mm-with-unibyte-buffer): ditto. + (mm-find-charset-region): use `mm-multibyte-p'. + + * mm-bodies.el (mm-decode-body): ditto. + (mm-decode-string): ditto. + + * lpath.el ((string-match "XEmacs" emacs-version)): Don't define + `enable-multibyte-characters' in XEmacs. + +1999-09-29 Shenghuo ZHU + + * mm-util.el (mm-binary-coding-system): Try binary first. + +1999-09-14 Shenghuo ZHU + + * rfc1843.el (rfc1843-decode-article-body): Don't decode twice. + +1999-09-10 Shenghuo ZHU + + * gnus-art.el (article-make-date-line): Add time-zone in iso8601 + format. + (article-date-ut): Find correct insert position. + +1999-09-03 Shenghuo ZHU + + * mm-uu.el (mm-uu-dissect): Do not dissect quoted-printable + forwarded message. + +1999-09-27 20:33:41 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-find-groups): Work for unactivated + groups. + + * message.el (message-resend): Use message mode when prompting. + + * gnus-art.el (article-hide-headers): Mark wash. + (article-emphasize): Ditto. + +1999-09-27 19:52:14 Vladimir Volovich + + * message.el (message-newline-and-reformat): Work for SC. + +1999-09-27 19:38:33 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-group-posting-charset-alist): 2047 in de.*. + + * gnus-sum.el (gnus-newsgroup-ignored-charsets): Add x-unknown. + +>>>>>>> 5.100 Mon Sep 27 15:18:05 1999 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.97 is released. @@ -133,7 +323,7 @@ Mon Sep 27 15:18:05 1999 Lars Magne Ingebrigtsen * gnus-art.el (gnus-treat-predicate): Work for (not 5). -1999-08-27 Peter von der Ahé +1999-08-27 Peter von der Ah-Aé $)A * message.el (message-send): More helpful error message if sending fails @@ -335,7 +525,7 @@ Fri Aug 27 13:17:48 1999 Lars Magne Ingebrigtsen * gnus-agent.el (gnus-agent-get-undownloaded-list): Don't mark cached articles as `undownloaded'. -Tue Jul 20 02:39:56 1999 Peter von der Ahé +Tue Jul 20 02:39:56 1999 Peter von der Ah-Aé $)A * gnus-sum.el (gnus-summary-exit): Allow gnus-use-adaptive-scoring to have buffer local values. @@ -2887,7 +3077,7 @@ Mon Nov 30 23:38:02 1998 Shenghuo ZHU * mm-uu.el (mm-uu-dissect): Use mm-make-handle. -1998-12-01 01:53:49 François Pinard +1998-12-01 01:53:49 Fran-Açois Pinard $)A * nndoc.el (nndoc-mime-parts-type-p): Do related. @@ -4633,7 +4823,7 @@ Mon Sep 14 18:55:38 1998 Lars Magne Ingebrigtsen * rfc2047.el (rfc2047-q-encode-region): Would bug out. -1998-09-13 François Pinard +1998-09-13 Fran-Açois Pinard $)A * nndoc.el: Make nndoc-dissection-alist simpler for MIME, adjust all related functions. Handle message/rfc822 parts. Display subject on diff --git a/lisp/binhex.el b/lisp/binhex.el index 9137a0a..b562051 100644 --- a/lisp/binhex.el +++ b/lisp/binhex.el @@ -3,7 +3,7 @@ ;; Author: Shenghuo Zhu ;; Create Date: Oct 1, 1998 -;; $Revision: 1.1.2.7 $ +;; $Revision: 1.1.2.7.6.1 $ ;; Time-stamp: ;; Keywords: binhex @@ -199,12 +199,12 @@ If HEADER-ONLY is non-nil only decode header and return filename." (save-excursion (goto-char start) (when (re-search-forward binhex-begin-line end t) - (if (boundp 'enable-multibyte-characters) + (if (and (not (string-match "XEmacs\\|Lucid" emacs-version)) + (boundp 'enable-multibyte-characters)) (let ((multibyte (default-value 'enable-multibyte-characters))) (setq-default enable-multibyte-characters nil) - (setq work-buffer - (generate-new-buffer " *binhex-work*")) + (setq work-buffer (generate-new-buffer " *binhex-work*")) (setq-default enable-multibyte-characters multibyte)) (setq work-buffer (generate-new-buffer " *binhex-work*"))) (buffer-disable-undo work-buffer) diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index 2433217..24d24c3 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -62,17 +62,18 @@ (condition-case nil (char-after) (wrong-number-of-arguments - ;; Optimize byte code for `char-after', + ;; Optimize byte code for `char-after'. (put 'char-after 'byte-optimizer 'byte-optimize-char-after) (defun byte-optimize-char-after (form) (if (null (cdr form)) '(char-after (point)) - form)))) + form)) + (byte-defop-compiler char-after 0-1))) (condition-case nil (char-before) (wrong-number-of-arguments - ;; Optimize byte code for `char-before', + ;; Optimize byte code for `char-before'. (put 'char-before 'byte-optimizer 'byte-optimize-char-before) (defun byte-optimize-char-before (form) (if (null (cdr form)) diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 3c092fc..858d5b7 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -236,6 +236,7 @@ fetched will be limited to it. If not a positive integer, never consider it." "Jc" gnus-enter-category-buffer "Jj" gnus-agent-toggle-plugged "Js" gnus-agent-fetch-session + "JY" gnus-agent-synchronize "JS" gnus-group-send-drafts "Ja" gnus-agent-add-group "Jr" gnus-agent-remove-group) @@ -427,6 +428,27 @@ be a select method." (setf (cadddr c) (delete group (cadddr c)))))) (gnus-category-write))) +(defun gnus-agent-synchronize () + "Synchronize local, unplugged, data with backend. +Currently sends flag setting requests, if any." + (interactive) + (save-excursion + (dolist (gnus-command-method gnus-agent-covered-methods) + (when (file-exists-p (gnus-agent-lib-file "flags")) + (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*")) + (erase-buffer) + (insert-file-contents (gnus-agent-lib-file "flags")) + (if (null (gnus-check-server gnus-command-method)) + (message "Couldn't open server %s" (nth 1 gnus-command-method)) + (while (not (eobp)) + (if (null (eval (read (current-buffer)))) + (progn (forward-line) + (kill-line -1)) + (write-file (gnus-agent-lib-file "flags")) + (error "Couldn't set flags from file %s" + (gnus-agent-lib-file "flags")))) + (write-file (gnus-agent-lib-file "flags"))))))) + ;;; ;;; Server mode commands ;;; @@ -972,6 +994,8 @@ the actual number of articles toggled is returned." gnus-newsgroup-scored gnus-headers gnus-score gnus-use-cache articles arts category predicate info marks score-param) + (unless (gnus-check-group group) + (error "Can't open server for %s" group)) ;; Fetch headers. (when (and (or (gnus-active group) (gnus-activate-group group)) (setq articles (gnus-agent-fetch-headers group)) @@ -1468,9 +1492,10 @@ The following commands are available: (or (not (numberp (setq art (read (current-buffer))))) (< art article))) - (if (file-exists-p - (gnus-agent-article-name - (number-to-string art) group)) + (if (and (numberp art) + (file-exists-p + (gnus-agent-article-name + (number-to-string art) group))) (progn (unless lowest (setq lowest art)) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index ff10e1e..dc64a45 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -646,6 +646,22 @@ be added below it (otherwise)." :group 'gnus-article-headers :type 'boolean) +(defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative + "Function called with a MIME handle as the argument. +This is meant for people who want to view first matched part. +For `undisplayed-alternative' (default), the first undisplayed +part or alternative part is used. For `undisplayed', the first +undisplayed part is used. For a function, the first part which +the function return `t' is used. For `nil', the first part is +used." + :group 'gnus-article-mime + :type '(choice + (item :tag "first" :value nil) + (item :tag "undisplayed" :value undisplayed) + (item :tag "undisplayed or alternative" + :value undisplayed-alternative) + (function))) + ;;; ;;; The treatment variables ;;; @@ -1147,6 +1163,7 @@ Initialized from `text-mode-syntax-table.") (when (setq beg (text-property-any (point-min) (point-max) 'message-rank (+ 2 max))) ;; We delete or make invisible the unwanted headers. + (push 'headers gnus-article-wash-types) (if delete (progn (add-text-properties @@ -1638,9 +1655,9 @@ header in the current article." (when (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) (push 'pgp gnus-article-wash-types) (delete-region (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)))) + ;; Remove armor headers (rfc2440 6.2) + (delete-region (point) (or (re-search-forward "^[ \t]*\n" nil t) + (point))) (setq beg (point)) ;; Hide the actual signature. (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) @@ -2080,9 +2097,13 @@ should replace the \"Date:\" one, or should be added below it." (format-time-string gnus-article-time-format time)))) ;; ISO 8601. ((eq type 'iso8601) - (concat - "Date: " - (format-time-string "%Y%m%dT%H%M%S" time))) + (let ((tz (car (current-time-zone time)))) + (concat + "Date: " + (format-time-string "%Y%m%dT%H%M%S" time) + (format "%s%02d%02d" + (if (> tz 0) "+" "-") (/ (abs tz) 3600) + (/ (% (abs tz) 3600) 60))))) ;; Do an X-Sent lapsed format. ((eq type 'lapsed) ;; If the date is seriously mangled, the timezone functions are @@ -2231,6 +2252,7 @@ This format is defined by the `gnus-article-time-format' variable." face (nth 3 elem)) (while (re-search-forward regexp nil t) (when (and (match-beginning visible) (match-beginning invisible)) + (push 'emphasis gnus-article-wash-types) (gnus-article-hide-text (match-beginning invisible) (match-end invisible) props) (gnus-article-unhide-text-type @@ -3297,11 +3319,33 @@ value of the variable `gnus-show-mime' is non-nil." (interactive "p") (gnus-article-part-wrapper n 'gnus-mime-inline-part)) -(defun gnus-article-view-part (n) +(defun gnus-article-mime-match-handle-first (condition) + (if condition + (let ((alist gnus-article-mime-handle-alist) ihandle n) + (while (setq ihandle (pop alist)) + (if (and (cond + ((functionp condition) + (funcall condition (cdr ihandle))) + ((eq condition 'undisplayed) + (not (or (mm-handle-undisplayer (cdr ihandle)) + (equal (mm-handle-media-type (cdr ihandle)) + "multipart/alternative")))) + ((eq condition 'undisplayed-alternative) + (not (mm-handle-undisplayer (cdr ihandle)))) + (t t)) + (gnus-article-goto-part (car ihandle)) + (or (not n) (< (car ihandle) n))) + (setq n (car ihandle)))) + (or n 1)) + 1)) + +(defun gnus-article-view-part (&optional n) "View MIME part N, which is the numerical prefix." - (interactive "p") + (interactive "P") (save-current-buffer (set-buffer gnus-article-buffer) + (or (numberp n) (setq n (gnus-article-mime-match-handle-first + gnus-article-mime-match-handle-function))) (when (> n (length gnus-article-mime-handle-alist)) (error "No such part")) (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) @@ -5097,14 +5141,6 @@ For example: (set-alist 'mime-preview-quitting-method-alist 'gnus-original-article-mode #'gnus-mime-preview-quitting-method) -(defun gnus-following-method (buf) - (set-buffer buf) - (message-followup) - (message-yank-original) - (kill-buffer buf) - (goto-char (point-min)) - ) - (set-alist 'mime-preview-following-method-alist 'gnus-original-article-mode #'gnus-following-method) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 66520f7..49fc4f2 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -522,6 +522,7 @@ ticked: The number of ticked articles." "u" gnus-group-make-useful-group "a" gnus-group-make-archive-group "k" gnus-group-make-kiboze-group + "l" gnus-group-nnimap-edit-acl "m" gnus-group-make-group "E" gnus-group-edit-group "e" gnus-group-edit-group-method @@ -533,6 +534,7 @@ ticked: The number of ticked articles." "w" gnus-group-make-web-group "r" gnus-group-rename-group "c" gnus-group-customize + "x" gnus-group-nnimap-expunge "\177" gnus-group-delete-group [delete] gnus-group-delete-group) @@ -2223,6 +2225,62 @@ score file entries for articles to include in the group." 'summary 'group))) (error "Couldn't enter %s" dir)))) +(eval-and-compile + (autoload 'nnimap-expunge "nnimap") + (autoload 'nnimap-acl-get "nnimap") + (autoload 'nnimap-acl-edit "nnimap")) + +(defun gnus-group-nnimap-expunge (group) + "Expunge deleted articles in current nnimap GROUP." + (interactive (list (gnus-group-group-name))) + (let ((mailbox (gnus-group-real-name group)) method) + (unless group + (error "No group on current line")) + (unless (gnus-get-info group) + (error "Killed group; can't be edited")) + (unless (eq 'nnimap (car (setq method (gnus-find-method-for-group group)))) + (error "%s is not an nnimap group" group)) + (nnimap-expunge mailbox (cadr method)))) + +(defun gnus-group-nnimap-edit-acl (group) + "Edit the Access Control List of current nnimap GROUP." + (interactive (list (gnus-group-group-name))) + (let ((mailbox (gnus-group-real-name group)) method acl) + (unless group + (error "No group on current line")) + (unless (gnus-get-info group) + (error "Killed group; can't be edited")) + (unless (eq (car (setq method (gnus-find-method-for-group group))) 'nnimap) + (error "%s is not an nnimap group" group)) + (gnus-edit-form (setq acl (nnimap-acl-get mailbox (cadr method))) + (format "Editing the access control list for `%s'. + + An access control list is a list of (identifier . rights) elements. + + The identifier string specifies the corresponding user. The + identifier \"anyone\" is reserved to refer to the universal identity. + + Rights is a string listing a (possibly empty) set of alphanumeric + characters, each character listing a set of operations which is being + controlled. Letters are reserved for ``standard'' rights, listed + below. Digits are reserved for implementation or site defined rights. + + l - lookup (mailbox is visible to LIST/LSUB commands) + r - read (SELECT the mailbox, perform CHECK, FETCH, PARTIAL, + SEARCH, COPY from mailbox) + s - keep seen/unseen information across sessions (STORE SEEN flag) + w - write (STORE flags other than SEEN and DELETED) + i - insert (perform APPEND, COPY into mailbox) + p - post (send mail to submission address for mailbox, + not enforced by IMAP4 itself) + c - create (CREATE new sub-mailboxes in any implementation-defined + hierarchy) + d - delete (STORE DELETED flag, perform EXPUNGE) + a - administer (perform SETACL)" group) + `(lambda (form) + (nnimap-acl-edit + ,mailbox ',method ',acl form))))) + ;; Group sorting commands ;; Suggested by Joe Hildebrand . diff --git a/lisp/gnus-mailcap.el b/lisp/gnus-mailcap.el index 0e0f44f..462e0ee 100644 --- a/lisp/gnus-mailcap.el +++ b/lisp/gnus-mailcap.el @@ -623,12 +623,12 @@ If TEST is not given, it defaults to t." (x-lisp (not (stringp (or (cdr-safe (assq 'viewer x)) "")))) (y-lisp (not (stringp (or (cdr-safe (assq 'viewer y)) ""))))) (cond - ((and x-lisp (not y-lisp)) - t) - ((and (not y-lisp) x-wild (not y-wild)) - t) + ((and x-wild (not y-wild)) + nil) ((and (not x-wild) y-wild) t) + ((and (not y-lisp) x-lisp) + t) (t nil)))) (defun mailcap-mime-info (string &optional request) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 9ba9f4e..766666e 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -109,6 +109,7 @@ the second with the current group name.") (defcustom gnus-group-posting-charset-alist '(("^no\\." iso-8859-1) (message-this-is-mail nil) + ("^de\\." nil) (".*" iso-8859-1) (message-this-is-news iso-8859-1)) "Alist of regexps (to match group names) and default charsets to be unencoded when posting." @@ -615,6 +616,7 @@ If SILENT, don't prompt the user." ;; Override normal method. ((and (eq gnus-post-method 'current) (not (eq (car group-method) 'nndraft)) + (gnus-get-function group-method 'request-post t) (not arg)) group-method) ((and gnus-post-method @@ -1334,6 +1336,21 @@ this is a reply." )))) +;;; @ for MIME view mode +;;; + +(defun gnus-following-method (buf) + (gnus-setup-message 'reply-yank + (set-buffer buf) + (if (message-news-p) + (message-followup) + (message-reply nil 'wide)) + (let ((message-reply-buffer buf)) + (message-yank-original)) + (message-goto-body)) + (kill-buffer buf)) + + ;;; Allow redefinition of functions. (gnus-ems-redefine) diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 7980f8d..d087acd 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -594,7 +594,9 @@ The following commands are available: (delete-matching-lines gnus-ignored-newsgroups)) (while (not (eobp)) (ignore-errors - (push (cons (read cur) + (push (cons (let ((p (point))) + (skip-chars-forward "^ \t") + (buffer-substring p (point))) (max 0 (- (1+ (read cur)) (read cur)))) groups)) (forward-line)))) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index ec37c36..e97de78 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -2561,8 +2561,9 @@ If FORCE is non-nil, the .newsrc file is read." (let ((str (buffer-substring (point) (progn (end-of-line) (point)))) (coding - (and (boundp 'enable-multibyte-characters) - enable-multibyte-characters + (and (or gnus-xemacs + (and (boundp 'enable-multibyte-characters) + enable-multibyte-characters)) (fboundp 'gnus-mule-get-coding-system) (gnus-mule-get-coding-system (symbol-name group))))) (when coding diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index c3641e3..4374114 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -852,7 +852,7 @@ which it may alter in any way.") (symbol :tag "Charset"))) :group 'gnus-charset) -(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit) +(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown) "List of charsets that should be ignored. When these charsets are used in the \"charset\" parameter, the default charset will be used instead." @@ -4859,7 +4859,8 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (save-restriction (nnheader-narrow-to-headers) (goto-char (point-min)) - (when (or (and (eq (downcase (char-after)) ?x) + (when (or (and (not (eobp)) + (eq (downcase (char-after)) ?x) (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (goto-char (1+ (match-end 0))) @@ -7046,6 +7047,7 @@ Optional argument BACKWARD means do search for backward. (require 'gnus-art) (let ((gnus-select-article-hook nil) ;Disable hook. (gnus-article-display-hook nil) + (gnus-article-prepare-hook nil) (gnus-mark-article-hook nil) ;Inhibit marking as read. (gnus-use-article-prefetch nil) (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay. @@ -7299,9 +7301,12 @@ If ARG is a negative number, hide the unwanted header lines." (let* ((buffer-read-only nil) (inhibit-point-motion-hooks t) hidden e) - (save-restriction - (article-narrow-to-head) - (setq hidden (gnus-article-hidden-text-p 'headers))) + (setq hidden + (if (numberp arg) + (>= arg 0) + (save-restriction + (article-narrow-to-head) + (gnus-article-hidden-text-p 'headers)))) (goto-char (point-min)) (when (search-forward "\n\n" nil t) (delete-region (point-min) (1- (point)))) @@ -7314,8 +7319,7 @@ If ARG is a negative number, hide the unwanted header lines." (save-restriction (narrow-to-region (point-min) (point)) (article-decode-encoded-words) - (if (or hidden - (and (numberp arg) (< arg 0))) + (if hidden (let ((gnus-treat-hide-headers nil) (gnus-treat-hide-boring-headers nil)) (gnus-treat-article 'head)) diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 97da766..b8235cf 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -212,11 +212,12 @@ If TOPIC, start with that topic." (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)))) (and - unread ; nil means that the group is dead. + info ; nil means that the group is dead. (<= clevel level) (>= clevel lowest) ; Is inside the level we want. (or all - (if (eq unread t) + (if (or (eq unread t) + (eq unread nil)) gnus-group-list-inactive-groups (> unread 0)) (and gnus-list-groups-with-ticked-articles @@ -981,6 +982,7 @@ articles in the topic and its subtopics." ["Create" gnus-topic-create-topic t] ["Mark" gnus-topic-mark-topic t] ["Indent" gnus-topic-indent t] + ["Sort" gnus-topic-sort-topics t] ["Toggle hide empty" gnus-topic-toggle-display-empty-topics t] ["Edit parameters" gnus-topic-edit-parameters t]) ["List active" gnus-topic-list-active t])))) @@ -1119,23 +1121,25 @@ If COPYP, copy the groups instead." (completing-read "Move to topic: " gnus-topic-alist nil t))) (let ((groups (gnus-group-process-prefix n)) (topicl (assoc topic gnus-topic-alist)) - (start-group (progn (forward-line 1) (gnus-group-group-name))) (start-topic (gnus-group-topic-name)) + (start-group (progn (forward-line 1) (gnus-group-group-name))) entry) - (mapcar - (lambda (g) - (gnus-group-remove-mark g) - (when (and - (setq entry (assoc (gnus-current-topic) gnus-topic-alist)) - (not copyp)) - (setcdr entry (gnus-delete-first g (cdr entry)))) - (nconc topicl (list g))) - groups) - (gnus-topic-enter-dribble) - (if start-group - (gnus-group-goto-group start-group) - (gnus-topic-goto-topic start-topic)) - (gnus-group-list-groups))) + (if (and (not groups) (not copyp) start-topic) + (gnus-topic-move start-topic topic) + (mapcar + (lambda (g) + (gnus-group-remove-mark g) + (when (and + (setq entry (assoc (gnus-current-topic) gnus-topic-alist)) + (not copyp)) + (setcdr entry (gnus-delete-first g (cdr entry)))) + (nconc topicl (list g))) + groups) + (gnus-topic-enter-dribble) + (if start-group + (gnus-group-goto-group start-group) + (gnus-topic-goto-topic start-topic)) + (gnus-group-list-groups)))) (defun gnus-topic-remove-group (&optional arg) "Remove the current group from the topic." @@ -1475,6 +1479,55 @@ If REVERSE, sort in reverse order." (interactive "P") (gnus-topic-sort-groups 'gnus-group-sort-by-method reverse)) +(defun gnus-topic-sort-topics-1 (top reverse) + (if (cdr top) + (let ((subtop + (mapcar `(lambda (top) + (gnus-topic-sort-topics-1 top ,reverse)) + (sort (cdr top) + '(lambda (t1 t2) + (string-lessp (caar t1) (caar t2))))))) + (setcdr top (if reverse (reverse subtop) subtop)))) + top) + +(defun gnus-topic-sort-topics (&optional topic reverse) + "Sort topics in TOPIC alphabeticaly by topic name. +If REVERSE, reverse the sorting order." + (interactive + (list (completing-read "Sort topics in : " gnus-topic-alist nil t + (gnus-current-topic)) + current-prefix-arg)) + (let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic))) + gnus-topic-topology))) + (gnus-topic-sort-topics-1 topic-topology reverse) + (gnus-topic-enter-dribble) + (gnus-group-list-groups) + (gnus-topic-goto-topic topic))) + +(defun gnus-topic-move (current to) + "Move the CURRENT topic to TO." + (interactive + (list + (gnus-group-topic-name) + (completing-read "Move to topic: " gnus-topic-alist nil t))) + (unless (and current to) + (error "Can't find topic")) + (let ((current-top (cdr (gnus-topic-find-topology current))) + (to-top (cdr (gnus-topic-find-topology to)))) + (unless current-top + (error "Can't find topic `%s'" current)) + (unless to-top + (error "Can't find topic `%s'" to)) + (if (gnus-topic-find-topology to current-top 0) ;; Don't care the level + (error "Can't move `%s' to its sub-level" current)) + (gnus-topic-find-topology current nil nil 'delete) + (while (cdr to-top) + (setq to-top (cdr to-top))) + (setcdr to-top (list current-top)) + (gnus-topic-enter-dribble) + (gnus-group-list-groups) + (gnus-topic-goto-topic current))) + (provide 'gnus-topic) ;;; gnus-topic.el ends here diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index ba7cbc9..8de7434 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -999,7 +999,8 @@ ARG is passed to the first function." (if full-names (symbol-name sym) (gnus-group-real-name (symbol-name sym))) - (cdr (symbol-value sym)) + (or (cdr (symbol-value sym)) + (car (symbol-value sym))) (car (symbol-value sym)))))) hashtb)))) (defun gnus-write-active-file-as-coding-system @@ -1015,7 +1016,8 @@ ARG is passed to the first function." (if full-names (symbol-name sym) (gnus-group-real-name (symbol-name sym))) - (cdr (symbol-value sym)) + (or (cdr (symbol-value sym)) + (car (symbol-value sym))) (car (symbol-value sym)))))) hashtb)))) ) diff --git a/lisp/lpath.el b/lisp/lpath.el index 699def5..e4b76df 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -46,14 +46,14 @@ rmail-summary-exists rmail-select-summary rmail-update-summary url-retrieve temp-directory babel-fetch babel-wash babel-as-string - )) + sc-cite-regexp)) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count mouse-selection-click-count-buffer buffer-display-table font-lock-defaults user-full-name user-login-name gnus-newsgroup-name gnus-article-x-face-too-ugly gnus-newsgroup-charset gnus-newsgroup-emphasis-alist - mail-mode-hook enable-multibyte-characters + mail-mode-hook adaptive-fill-first-line-regexp adaptive-fill-regexp url-current-mime-headers buffer-file-coding-system w3-image-mappings url-current-mime-type @@ -94,7 +94,7 @@ w3-coding-system-for-mime-charset rmail-summary-exists rmail-select-summary rmail-update-summary url-generic-parse-url valid-image-instantiator-format-p - babel-fetch babel-wash babel-as-string + babel-fetch babel-wash babel-as-string sc-cite-regexp smiley-encode-buffer))) (setq load-path (cons "." load-path)) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 06bfbde..de4dd78 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -90,7 +90,16 @@ This variable is a list of mail source specifiers." (:connection) (:authentication password)) (maildir - (:path "~/Maildir/new/"))) + (:path "~/Maildir/new/")) + (imap + (:server (getenv "MAILHOST")) + (:port) + (:stream) + (:authentication) + (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER"))) + (:password) + (:mailbox "INBOX") + (:predicate "UNSEEN UNDELETED"))) "Mapping from keywords to default values. All keywords that can be used must be listed here.")) @@ -98,7 +107,8 @@ 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) - (maildir mail-source-fetch-maildir)) + (maildir mail-source-fetch-maildir) + (imap mail-source-fetch-imap)) "A mapping from source type to fetcher function.") (defvar mail-source-password-cache nil) @@ -421,6 +431,46 @@ If ARGS, PROMPT is used as an argument to `format'." (incf found (mail-source-callback callback file)))) found))) +(eval-and-compile + (autoload 'imap-open "imap") + (autoload 'imap-authenticate "imap") + (autoload 'imap-mailbox-select "imap") + (autoload 'imap-search "imap") + (autoload 'imap-fetch "imap") + (autoload 'imap-mailbox-unselect "imap") + (autoload 'imap-close "imap") + (autoload 'imap-error-text "imap") + (autoload 'nnheader-ms-strip-cr "nnheader")) + +(defun mail-source-fetch-imap (source callback) + "Fetcher for imap sources." + (mail-source-bind (imap source) + (let ((found 0) + (buf (get-buffer-create (generate-new-buffer-name " *imap source*"))) + (mail-source-string (format "imap:%s:%s" server mailbox))) + (if (and (imap-open server port stream authentication buf) + (imap-authenticate user password buf) + (imap-mailbox-select mailbox nil buf)) + (let (str (coding-system-for-write 'binary)) + (with-temp-file mail-source-crash-box + ;; if predicate is nil, use all uids + (dolist (uid (imap-search (or predicate "1:*") buf)) + (when (setq str (imap-fetch uid "RFC822" 'RFC822 nil buf)) + (insert "From imap " (current-time-string) "\n") + (save-excursion + (insert str "\n\n")) + (while (re-search-forward "^From " nil t) + (replace-match ">From ")) + (goto-char (point-max)))) + (nnheader-ms-strip-cr)) + (incf found (mail-source-callback callback server)) + (imap-mailbox-unselect buf) + (imap-close buf)) + (imap-close buf) + (error (imap-error-text buf))) + (kill-buffer buf) + found))) + (provide 'mail-source) ;;; mail-source.el ends here diff --git a/lisp/message.el b/lisp/message.el index 15c8537..4f745c7 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1299,6 +1299,7 @@ The cdr of ech entry is a function for applying the face to a region.") "^ *---+ +Original message +---+ *$\\|" "^ *--+ +begin message +--+ *$\\|" "^ *---+ +Original message follows +---+ *$\\|" + "^ *---+ +Undelivered message follows +---+ *$\\|" "^|? *---+ +Message text follows: +---+ *|?$") "A regexp that matches the separator before the text of a failed message.") @@ -2007,10 +2008,12 @@ With the prefix argument FORCE, insert the header anyway." quoted) (save-excursion (beginning-of-line) - (setq quoted (looking-at (regexp-quote message-yank-prefix)))) + (if (looking-at (sc-cite-regexp)) + (setq quoted (buffer-substring (match-beginning 0) (match-end 0))))) (insert "\n\n\n\n") + (delete-region (point) (re-search-forward "[ \t]*")) (when quoted - (insert message-yank-prefix)) + (insert quoted)) (fill-paragraph nil) (goto-char point) (forward-line 2))) @@ -4700,7 +4703,11 @@ Optional NEWS will use news to forward instead of mail." ;;;###autoload (defun message-resend (address) "Resend the current article to ADDRESS." - (interactive "sResend message to: ") + (interactive + (list + (let ((mail-abbrev-mode-regexp "")) + (read-from-minibuffer + "Resend message to: " nil message-mode-map)))) (message "Resending message to %s..." address) (save-excursion (let ((cur (current-buffer)) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 3ced083..a448b0b 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -209,7 +209,7 @@ The characters in CHARSET should then be decoded." ;; buffer-file-coding-system ;;Article buffer is nil coding system ;;in XEmacs - enable-multibyte-characters + (mm-multibyte-p) (or (not (eq mule-charset 'ascii)) (setq mule-charset mail-parse-charset))) (mm-decode-coding-region (point-min) (point-max) mule-charset)))))) @@ -225,7 +225,7 @@ The characters in CHARSET should then be decoded." (let (mule-charset) (when (and charset (setq mule-charset (mm-charset-to-coding-system charset)) - enable-multibyte-characters + (mm-multibyte-p) (or (not (eq mule-charset 'ascii)) (setq mule-charset mail-parse-charset))) (mm-decode-coding-string string mule-charset)))) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 5ce2188..deec0c3 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -139,7 +139,7 @@ "message/rfc822") "A list of MIME types to be displayed automatically.") -(defvar mm-attachment-override-types '("text/plain" "text/x-vcard") +(defvar mm-attachment-override-types '("text/x-vcard") "Types that should have \"attachment\" ignored if they can be displayed inline.") (defvar mm-automatic-external-display nil @@ -190,7 +190,11 @@ to: (if (or (not ctl) (not (string-match "/" (car ctl)))) (mm-dissect-singlepart - '("text/plain") nil no-strict-mime + '("text/plain") + (and cte (intern (downcase (mail-header-remove-whitespace + (mail-header-remove-comments + cte))))) + no-strict-mime (and cd (ignore-errors (mail-header-parse-content-disposition cd))) description) (setq type (split-string (car ctl) "/")) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 43c94f2..5a4d8c3 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -112,8 +112,8 @@ (defvar mm-binary-coding-system (cond - ((mm-coding-system-p 'no-conversion) 'no-conversion) ((mm-coding-system-p 'binary) 'binary) + ((mm-coding-system-p 'no-conversion) 'no-conversion) (t nil)) "100% binary coding system.") @@ -235,15 +235,17 @@ used as the line break code type of the coding system." (defsubst mm-multibyte-p () "Say whether multibyte is enabled." - (and (boundp 'enable-multibyte-characters) - enable-multibyte-characters)) + (or (string-match "XEmacs\\|Lucid" emacs-version) + (and (boundp 'enable-multibyte-characters) + enable-multibyte-characters))) (defmacro mm-with-unibyte-buffer (&rest forms) "Create a temporary buffer, and evaluate FORMS there like `progn'. See also `with-temp-file' and `with-output-to-string'." (let ((temp-buffer (make-symbol "temp-buffer")) (multibyte (make-symbol "multibyte"))) - `(if (not (boundp 'enable-multibyte-characters)) + `(if (or (string-match "XEmacs\\|Lucid" emacs-version) + (not (boundp 'enable-multibyte-characters))) (with-temp-buffer ,@forms) (let ((,multibyte (default-value 'enable-multibyte-characters)) ,temp-buffer) @@ -267,8 +269,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 + ((and (mm-multibyte-p) (fboundp 'find-charset-region)) (find-charset-region b e)) ((not (boundp 'current-language-environment)) diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index ba23c74..97c67d5 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -81,8 +81,8 @@ decoder, such as hexbin." ;;; Thanks to Edward J. Sabol and ;;; Peter von der Ah\'e -(defconst mm-uu-forward-begin-line "^-+ \\(?:Start of \\)?Forwarded message") -(defconst mm-uu-forward-end-line "^-+ End\\(?: of\\)? forwarded message") +(defconst mm-uu-forward-begin-line "^-+ \\(Start of \\)?Forwarded message") +(defconst mm-uu-forward-end-line "^-+ End \\(of \\)?forwarded message") (defvar mm-uu-begin-line nil) @@ -147,7 +147,7 @@ To disable dissecting shar codes, for instance, add (setq cte (intern (downcase (mail-header-remove-whitespace (mail-header-remove-comments cte)))))) - (if (eq cte 'base64) + (if (memq cte '(base64 quoted-printable)) (setq charset 'gnus-encoded ;; a fake charset cte nil))) (goto-char (point-max))) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index caee4f0..f5651f4 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -188,7 +188,9 @@ (setq handles gnus-article-mime-handles)) (when handles (setq gnus-article-mime-handles - (append gnus-article-mime-handles handles))) + (nconc gnus-article-mime-handles + (if (listp (car handles)) + handles (list handles))))) (mm-handle-set-undisplayer handle `(lambda () diff --git a/lisp/mml.el b/lisp/mml.el index 771487d..1aa55ac 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -242,7 +242,8 @@ contents of this part.") (insert-buffer-substring (cdr (assq 'buffer cont)))) ((and (setq filename (cdr (assq 'filename cont))) (not (equal (cdr (assq 'nofile cont)) "yes"))) - (mm-insert-file-contents filename nil nil nil nil t)) + (let ((coding-system-for-read mm-binary-coding-system)) + (mm-insert-file-contents filename nil nil nil nil t))) (t (insert (cdr (assq 'contents cont))))) (setq encoding (mm-encode-buffer type) diff --git a/lisp/nnagent.el b/lisp/nnagent.el index 9d94eb8..ed62850 100644 --- a/lisp/nnagent.el +++ b/lisp/nnagent.el @@ -114,7 +114,12 @@ (gnus-request-accept-article "nndraft:queue" nil t t)) (deffoo nnagent-request-set-mark (group action server) - action) + (with-temp-buffer + (insert (format "(%s-request-set-mark \"%s\" '%s \"%s\")\n" + (nth 0 gnus-command-method) group action + (or server (nth 1 gnus-command-method)))) + (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags"))) + nil) ;; Use nnml functions for just about everything. (nnoo-import nnagent diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 368e171..af52564 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -121,8 +121,9 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (set-buffer nnfolder-current-buffer) (when (nnfolder-goto-article article) (setq start (point)) - (search-forward "\n\n" nil t) - (setq stop (1- (point))) + (setq stop (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max))) (set-buffer nntp-server-buffer) (insert (format "221 %d Article retrieved.\n" article)) (insert-buffer-substring nnfolder-current-buffer start stop) @@ -370,7 +371,8 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (goto-char (point-min)) (while (re-search-forward (concat "^" nnfolder-article-marker) - (save-excursion (search-forward "\n\n" nil t) (point)) t) + (save-excursion (and (search-forward "\n\n" nil t) (point))) + t) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) (setq result (eval accept-form)) @@ -402,8 +404,9 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.") (save-excursion (set-buffer buf) (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-line -1) + (if (search-forward "\n\n" nil t) + (forward-line -1) + (goto-char (point-max))) (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) (delete-region (point) (progn (forward-line 1) (point)))) (when nnmail-cache-accepted-message-ids @@ -631,8 +634,9 @@ deleted. Point is left where the deleted region was." (while (setq group-art (pop group-art-list)) ;; Kill any previous newsgroup markers. (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-line -1) + (if (search-forward "\n\n" nil t) + (forward-line -1) + (goto-char (point-max))) (while (search-backward (concat "\n" nnfolder-article-marker) nil t) (delete-region (1+ (point)) (progn (forward-line 2) (point)))) @@ -661,10 +665,12 @@ deleted. Point is left where the deleted region was." (defun nnfolder-insert-newsgroup-line (group-art) (save-excursion (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (forward-char -1) - (insert (format (concat nnfolder-article-marker "%d %s\n") - (cdr group-art) (current-time-string)))))) + (unless (search-forward "\n\n" nil t) + (goto-char (point-max)) + (insert "\n")) + (forward-char -1) + (insert (format (concat nnfolder-article-marker "%d %s\n") + (cdr group-art) (current-time-string))))) (defun nnfolder-active-number (group) ;; Find the next article number in GROUP. diff --git a/lisp/nnmail.el b/lisp/nnmail.el index e8e16dc..75c1281 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1007,35 +1007,39 @@ Return the number of characters in the body." (let (lines chars) (save-excursion (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (setq chars (- (point-max) (point))) - (setq lines (count-lines (point) (point-max))) - (forward-char -1) - (save-excursion - (when (re-search-backward "^Lines: " nil t) - (delete-region (point) (progn (forward-line 1) (point))))) - (beginning-of-line) - (insert (format "Lines: %d\n" (max lines 0))) - chars)))) + (unless (search-forward "\n\n" nil t) + (goto-char (point-max)) + (insert "\n")) + (setq chars (- (point-max) (point))) + (setq lines (count-lines (point) (point-max))) + (forward-char -1) + (save-excursion + (when (re-search-backward "^Lines: " nil t) + (delete-region (point) (progn (forward-line 1) (point))))) + (beginning-of-line) + (insert (format "Lines: %d\n" (max lines 0))) + chars))) (defun nnmail-insert-xref (group-alist) "Insert an Xref line based on the (group . article) alist." (save-excursion (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (forward-char -1) - (when (re-search-backward "^Xref: " nil t) - (delete-region (match-beginning 0) - (progn (forward-line 1) (point)))) - (insert (format "Xref: %s" (system-name))) - (while group-alist - (insert (format " %s:%d" - (encode-coding-string - (caar group-alist) - nnmail-pathname-coding-system) - (cdar group-alist))) - (setq group-alist (cdr group-alist))) - (insert "\n")))) + (unless (search-forward "\n\n" nil t) + (goto-char (point-max)) + (insert "\n")) + (forward-char -1) + (when (re-search-backward "^Xref: " nil t) + (delete-region (match-beginning 0) + (progn (forward-line 1) (point)))) + (insert (format "Xref: %s" (system-name))) + (while group-alist + (insert (format " %s:%d" + (encode-coding-string + (caar group-alist) + nnmail-pathname-coding-system) + (cdar group-alist))) + (setq group-alist (cdr group-alist))) + (insert "\n"))) ;;; Message washing functions diff --git a/lisp/nntp.el b/lisp/nntp.el index d37490d..d7fddd4 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1141,9 +1141,10 @@ password contained in '~/.nntp-authinfo'." ((numberp nntp-nov-gap) (let ((count 0) (received 0) - (last-point (point-min)) + last-point + in-process-buffer-p (buf nntp-server-buffer) - ;;(process-buffer (nntp-find-connection (current-buffer)))) + (process-buffer (nntp-find-connection-buffer nntp-server-buffer)) first) ;; We have to check `nntp-server-xover'. If it gets set to nil, ;; that means that the server does not understand XOVER, but we @@ -1156,40 +1157,55 @@ password contained in '~/.nntp-authinfo'." (< (- (nth 1 articles) (car articles)) nntp-nov-gap)) (setq articles (cdr articles))) - (when (nntp-send-xover-command first (car articles)) - (setq articles (cdr articles) - count (1+ count)) - + (setq in-process-buffer-p (stringp nntp-server-xover)) + (nntp-send-xover-command first (car articles)) + (setq articles (cdr articles)) + + (when (and nntp-server-xover in-process-buffer-p) + ;; Don't count tried request. + (setq count (1+ count)) + ;; Every 400 requests we have to read the stream in ;; order to avoid deadlocks. (when (or (null articles) ;All requests have been sent. (zerop (% count nntp-maximum-request))) - (accept-process-output) + + (nntp-accept-response) ;; On some Emacs versions the preceding function has ;; a tendency to change the buffer. Perhaps. It's ;; quite difficult to reproduce, because it only ;; seems to happen once in a blue moon. - (set-buffer buf) + (set-buffer process-buffer) (while (progn - (goto-char last-point) + (goto-char (or last-point (point-min))) ;; Count replies. (while (re-search-forward "^[0-9][0-9][0-9] " nil t) (setq received (1+ received))) (setq last-point (point)) (< received count)) - (accept-process-output) - (set-buffer buf))))) + (nntp-accept-response) + (set-buffer process-buffer)) + (set-buffer buf)))) (when nntp-server-xover - ;; Wait for the reply from the final command. - (goto-char (point-max)) - (re-search-backward "^[0-9][0-9][0-9] " nil t) - (when (looking-at "^[23]") - (while (progn - (goto-char (point-max)) - (forward-line -1) - (not (looking-at "^\\.\r?\n"))) - (nntp-accept-response))) + (when in-process-buffer-p + (set-buffer process-buffer) + ;; Wait for the reply from the final command. + (goto-char (point-max)) + (re-search-backward "^[0-9][0-9][0-9] " nil t) + (when (looking-at "^[23]") + (while (progn + (goto-char (point-max)) + (forward-line -1) + (not (looking-at "^\\.\r?\n"))) + (nntp-accept-response) + (set-buffer process-buffer))) + (set-buffer buf) + (goto-char (point-max)) + (insert-buffer-substring process-buffer) + (set-buffer process-buffer) + (erase-buffer) + (set-buffer buf)) ;; We remove any "." lines and status lines. (goto-char (point-min)) @@ -1212,7 +1228,7 @@ password contained in '~/.nntp-authinfo'." (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range) ;; We do not wait for the reply. - (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range)) + (nntp-send-command-nodelete nil nntp-server-xover range)) (let ((commands nntp-xover-commands)) ;; `nntp-xover-commands' is a list of possible XOVER commands. ;; We try them all until we get at positive response. diff --git a/lisp/qp.el b/lisp/qp.el index 18c66b7..56203e9 100644 --- a/lisp/qp.el +++ b/lisp/qp.el @@ -99,11 +99,12 @@ matched by that regexp." (end-of-line) (while (> (current-column) 72) (beginning-of-line) - (forward-char 72) + (forward-char 71) ;; 71 char plus an "=" (search-backward "=" (- (point) 2) t) (insert "=\n") (end-of-line)) - (forward-line)))))) + (unless (eobp) + (forward-line))))))) (defun quoted-printable-encode-string (string) "QP-encode STRING and return the results." diff --git a/lisp/rfc1843.el b/lisp/rfc1843.el index 07b2cf2..fd11345 100644 --- a/lisp/rfc1843.el +++ b/lisp/rfc1843.el @@ -1,13 +1,10 @@ ;;; rfc1843.el --- HZ (rfc1843) decoding -;; Copyright (c) 1998 by Shenghuo Zhu +;; Copyright (c) 1998,1999 by Shenghuo Zhu ;; Author: Shenghuo Zhu -;; $Revision: 1.1.2.6 $ ;; Keywords: news HZ -;; Time-stamp: -;; This file is not part of GNU Emacs, but the same permissions -;; apply. +;; This file is a part of GNU Emacs, but the same permissions apply. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published @@ -139,9 +136,20 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" (save-excursion (save-restriction (message-narrow-to-head) - (goto-char (point-max)) - (widen) - (rfc1843-decode-region (point) (point-max)))))) + (let* ((inhibit-point-motion-hooks t) + (case-fold-search t) + (ct (message-fetch-field "Content-Type" t)) + (ctl (and ct (ignore-errors + (mail-header-parse-content-type ct))))) + (if (and ctl (not (string-match "/" (car ctl)))) + (setq ctl nil)) + (goto-char (point-max)) + (widen) + (forward-line 1) + (narrow-to-region (point) (point-max)) + (when (or (not ctl) + (equal (car ctl) "text/plain")) + (rfc1843-decode-region (point) (point-max)))))))) (defvar rfc1843-old-gnus-decode-header-function nil) (defvar gnus-decode-header-methods) diff --git a/texi/ChangeLog b/texi/ChangeLog index 0667c43..42cd590 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,13 @@ +1999-10-23 Simon Josefsson + + * gnus.texi (Mail Source Specifiers): Add imap mail-source. + (IMAP): New subsection. + (SOUP): Typo. + +1999-09-27 16:07:31 Lars Magne Ingebrigtsen + + * emacs-mime.texi (New Viewers): Fix. + 1999-09-25 10:58:17 Lars Magne Ingebrigtsen * message.texi (Forwarding): Updated. diff --git a/texi/gnus.texi b/texi/gnus.texi index 9c24e31..4224838 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -10363,6 +10363,62 @@ An example maildir mail source: (maildir :path "/home/user-name/Maildir/cur") @end lisp +@item imap +Get mail from a IMAP server. If you don't want to use IMAP as intended, +as a network mail reading protocol, for some reason or other Gnus let +you treat it similar to a POP server and fetches articles from a given +IMAP mailbox. + +Keywords: + +@table @code +@item :server +The name of the IMAP server. The default is taken from the +@code{MAILHOST} environment variable. + +@item :port +The port number of the IMAP server. The default is @samp{143}, or +@samp{993} for SSL connections. + +@item :user +The user name to give to the IMAP server. The default is the login +name. + +@item :password +The password to give to the IMAP server. If not specified, the user is +prompted. + +@item :stream +What stream to use for connecting to the server, this is one of the +symbols in @code{imap-stream-alist}. Right now, this means +@samp{kerberos4}, @samp{ssl} or the default @samp{network}. + +@item :authenticator +Which authenticator to use for authenticating to the server, this is one +of the symbols in @code{imap-authenticator-alist}. Right now, this means +@samp{kerberos4}, @samp{cram-md5}, @samp{anonymous} or the default +@samp{login}. + +@item :mailbox +The name of the mailbox to get mail from. The default is @samp{INBOX} +which normally is the mailbox which receive incoming mail. + +@item :predicate +The predicate used to find articles to fetch. The default, +@samp{UNSEEN UNDELETED}, is probably the best choice for most people, +but if you sometimes peek in your mailbox with a IMAP client and mark +some articles as read (or; SEEN) you might want to set this to +@samp{nil}. Then all articles in the mailbox is fetched, no matter +what. For a complete list of predicates, see RFC2060 §6.4.4. + +@end table + +An example IMAP mail source: + +@lisp +(imap :server "mail.mycorp.com" :stream kerberos4) +@end lisp + @end table @@ -11500,6 +11556,7 @@ newsgroups. * SOUP:: Reading @sc{SOUP} packets ``offline''. * Web Searches:: Creating groups from articles that match a string. * Mail-To-News Gateways:: Posting articles via mail-to-news gateways. +* IMAP:: Using Gnus as a IMAP client. @end menu @@ -11822,7 +11879,7 @@ Of course, us Unix Weenie types of human beans use things like transport things like Ghod intended. And then we just use normal newsreaders. -However, it can sometimes be convenient to do something a that's a bit +However, it can sometimes be convenient to do something that's a bit easier on the brain if you have a very slow modem, and you're not really that interested in doing things properly. @@ -12259,6 +12316,267 @@ So, to use this, simply say something like: @end lisp + +@node IMAP +@subsection IMAP +@cindex nnimap +@cindex IMAP + +IMAP is a network protocol for reading mail (or news, or ...), think of +it as a modernized NNTP. Connecting to a IMAP server is much similar to +connecting to a news server, you just specify the network address of the +server. + +The following variables can be used to create a virtual @code{nnimap} +server: + +@table @code + +@item nnimap-address +@vindex nnimap-address + +The address of the remote IMAP server. Defaults to the virtual server +name if not specified. + +@item nnimap-server-port +@vindex nnimap-server-port +Port on server to contact. Defaults to port 143, or 993 for SSL. + +@item nnimap-list-pattern +@vindex nnimap-list-pattern +String or list of strings of mailboxes to limit available groups +to. This is used when the server has very many mailboxes and you're only +interested in a few -- some servers export your home directory via IMAP, +you'll probably want to limit the mailboxes to those in @file{~/Mail/*} +then. + +The string can also be a cons of REFERENCE and the string as above, what +REFERENCE is used for is server specific, but on the University of +Washington server it's a directory that will be concatenated with the +mailbox. + +Example: + +@lisp +("INBOX" "Mail/*" "alt.sex.*" ("~friend/Mail/" . "list/*")) +@end lisp + +@item nnimap-stream +@vindex nnimap-stream +The type of stream used to connect to your server. By default, nnimap +will use the most secure stream your server is capable of. + +@itemize @bullet +@item +@dfn{kerberos4:} Uses the `imtest' program. +@item +@dfn{ssl:} Uses OpenSSL or SSLeay. +@item +@dfn{network:} Plain, TCP/IP network connection. +@end itemize + +@item nnimap-authenticator +@vindex nnimap-authenticator + +The authenticator used to connect to the server. By default, nnimap will +use the most secure authenticator your server is capable of. + +@itemize @bullet +@item +@dfn{kerberos4:} Kerberos authentication. +@item +@dfn{cram-md5:} Encrypted username/password via CRAM-MD5. +@item +@dfn{login:} Plain-text username/password via LOGIN. +@item +@dfn{anonymous:} Login as `anonymous', supplying your emailadress as password. +@end itemize + +@item nnimap-expunge-on-close +@cindex Expunging +@vindex nnimap-expunge-on-close +Unlike Parmenides the IMAP designers has decided that things that +doesn't exist actually does exist. More specifically, IMAP has this +concept of marking articles @code{Deleted} which doesn't actually delete +them, and this (marking them @code{Deleted}, that is) is what nnimap +does when you delete a article in Gnus (with @kbd{G DEL} or similair). + +Since the articles aren't really removed when we mark them with the +@code{Deleted} flag we'll need a way to actually delete them. Feel like +running in circles yet? + +Traditionally, nnimap has removed all articles marked as @code{Deleted} +when closing a mailbox but this is now configurable by this server +variable. + +The possible options are: + +@table @code + +@item always +The default behaviour, delete all articles marked as "Deleted" when +closing a mailbox. +@item never +Never actually delete articles. Currently there is no way of showing the +articles marked for deletion in nnimap, but other IMAP clients may allow +you to do this. If you ever want to run the EXPUNGE command manually, +@xref{Expunging mailboxes}. +@item ask +When closing mailboxes, nnimap will ask if you wish to expunge deleted +articles or not. +@end table + +@end table + +@menu +* Splitting in IMAP:: Splitting mail with nnimap. +* Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox. +* Expunging mailboxes:: Equivalent of a "compress mailbox" button. +@end menu + + + +@node Splitting in IMAP +@subsubsection Splitting in IMAP +@cindex splitting imap mail + +Splitting is something Gnus users has loved and used for years, and now +the rest of the world is catching up. Yeah, dream on, not many IMAP +server has server side splitting and those that have splitting seem to +use some non-standard protocol. This means that IMAP support for Gnus +has to do it's own splitting. + +And it does. + +There are three variables of interest: + +@table @code + +@item nnimap-split-crosspost +@cindex splitting, crosspost +@cindex crosspost +@vindex nnimap-split-crosspost + +If non-nil, do crossposting if several split methods match the mail. If +nil, the first match in @code{nnimap-split-rule} found will be used. + +Nnmail equivalent: @code{nnmail-crosspost}. + +@item nnimap-split-inbox +@cindex splitting, inbox +@cindex inbox +@vindex nnimap-split-inbox + +A string or a list of strings that gives the name(s) of IMAP mailboxes +to split from. Defaults to nil, which means that splitting is disabled! + +@lisp +(setq nnimap-split-inbox '("INBOX" ("~/friend/Mail" . "lists/*") "lists.imap")) +@end lisp + +No nnmail equivalent. + +@item nnimap-split-rule +@cindex Splitting, rules +@vindex nnimap-split-rule + +New mail found in @code{nnimap-split-inbox} will be split according to +this variable. + +This variable contains a list of lists, where the first element in the +sublist gives the name of the IMAP mailbox to move articles matching the +regexp in the second element in the sublist. Got that? Neither did I, we +need examples. + +@lisp +(setq nnimap-split-rule + '(("INBOX.nnimap" "^Sender: owner-nnimap@@vic20.globalcom.se") + ("INBOX.junk" "^Subject:.*MAKE MONEY") + ("INBOX.private" ""))) +@end lisp + +This will put all articles from the nnimap mailing list into mailbox +INBOX.nnimap, all articles containing MAKE MONEY in the Subject: line +into INBOX.spam and everything else in INBOX.private. + +The first string may contain `\\1' forms, like the ones used by +replace-match to insert sub-expressions from the matched text. For +instance: + +@lisp + ("INBOX.lists.\\1" "^Sender: owner-\\([a-z-]+\\)@") +@end lisp + +The second element can also be a function. In that case, it will be +called with the first element of the rule as the argument, in a buffer +containing the headers of the article. It should return a non-nil value +if it thinks that the mail belongs in that group. + +Nnmail users might recollect that the last regexp had to be empty to +match all articles (like in the example above). This is not required in +nnimap. Articles not matching any of the regexps will not be moved out +of your inbox. (This might might affect performance if you keep lots of +unread articles in your inbox, since the splitting code would go over +them every time you fetch new mail.) + +These rules are processed from the beginning of the alist toward the +end. The first rule to make a match will "win", unless you have +crossposting enabled. In that case, all matching rules will "win". + +The splitting code tries to create mailboxes if it need too. + +Nnmail equivalent: @code{nnmail-split-methods}. + +@end table + +@node Editing IMAP ACLs +@subsubsection Editing IMAP ACLs +@cindex editing imap acls +@cindex Access Control Lists +@cindex Editing IMAP ACLs +@kindex G l +@findex gnus-group-nnimap-edit-acl + +ACL stands for Access Control List. ACLs are used in IMAP for limiting +(or enabling) other users access to your mail boxes. Not all IMAP +servers support this, this function will give an error if it doesn't. + +To edit a ACL for a mailbox, type @kbd{G l} +(@code{gnus-group-edit-nnimap-acl}) and you'll be presented with a ACL +editing window with detailed instructions. + +Some possible uses: + +@itemize @bullet +@item +Giving "anyone" the "lrs" rights (lookup, read, keep seen/unseen flags) +on your mailing list mailboxes enables other users on the same server to +follow the list without subscribing to it. +@item +At least with the Cyrus server, you are required to give the user +"anyone" posting ("p") capabilities to have "plussing" work (that is, +mail sent to user+mailbox@@domain ending up in the IMAP mailbox +INBOX.mailbox). +@end itemize + +@node Expunging mailboxes +@subsubsection Expunging mailboxes +@cindex expunging + +@cindex Expunge +@cindex Manual expunging +@kindex G x +@findex gnus-group-nnimap-expunge + +If you're using the @code{never} setting of @code{nnimap-expunge-close}, +you may want the option of expunging all deleted articles in a mailbox +manually. This is exactly what @kbd{G x} does. + +Currently there is no way of showing deleted articles, you can just +delete them. + + + @node Combined Groups @section Combined Groups