[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
nnimap 0.92 -> 0.93 patches
Index: nnimap/ChangeLog
diff -u nnimap/ChangeLog:1.169 nnimap/ChangeLog:1.179
--- nnimap/ChangeLog:1.169 Thu Jan 7 16:18:25 1999
+++ nnimap/ChangeLog Thu Feb 4 17:51:23 1999
@@ -1,3 +1,60 @@
+1999-02-05 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap 0.93 released.
+
+1999-02-05 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-continuation): New variable.
+ (imap-send-command-1): New function.
+ (imap-send-command): Handle buffers and functions.
+ (imap-wait-for-tag): Return INCOMPLETE if continuation request
+ found.
+ (imap-parse-response): Store imap continuation text.
+ (imap-message-append): Don't cdr.
+
+ * nnimap.el (nnimap-request-accept-article): Rfc822-regexping
+ works. Get UID.
+
+1999-02-04 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el: Moved some variables into 1.x section.
+
+1999-01-28 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.texi (split-rule): Update.
+
+1999-01-28 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-possibly-change-group): Print group in
+ uidvalidity clash message.
+
+ * nnimap.el (nnimap-split-articles): Don't treat crossposting.
+
+ (nnimap-split-to-groups): Fold continuation lines once. Use
+ nnmail-expand-newtext to expand group names if they contain
+ regexp-like stuff. Fast exit if match is found and no
+ crossposting is requested.
+
+ (nnimap-expand-newtext): New function, originally
+ nnmail-expand-newtext.
+
+1999-01-28 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-arrival-filter): Removed kernel junk handling, it
+ does not solve all problems and isn't the Right Thing to do.
+
+1999-01-27 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-arrival-filter): Handle junk from kernel.
+
+1999-01-25 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-parse-response): Check tag.
+
+1999-01-08 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el: Moved some functions to nnimap 1.x section.
+
1999-01-08 Simon Josefsson <jas@pdc.kth.se>
* nnimap 0.92 released.
Index: nnimap/imap.el
diff -u nnimap/imap.el:1.106 nnimap/imap.el:1.112
--- nnimap/imap.el:1.106 Thu Jan 7 16:17:35 1999
+++ nnimap/imap.el Thu Feb 4 17:31:32 1999
@@ -280,6 +280,10 @@
(defvar imap-process nil
"Process.")
+(defvar imap-continuation nil
+ "Non-nil indicates that the server emitted a continuation request. The
+actually value is really the text on the continuation line.")
+
(defvar imap-log "*imap-log*"
"Imap session trace.")
@@ -880,14 +884,15 @@
(defun imap-message-append (mailbox article &optional buffer flags date-time)
"Append ARTICLE buffer to MAILBOX on server in BUFFER. FLAGS and
-DATE-TIME is currently not used."
+DATE-TIME is currently not used. Return a cons holding uidvalidity of
+MAILBOX and UID the newly created article got, or nil on failure."
(with-current-buffer (or buffer (current-buffer))
(if (imap-capability 'UIDPLUS)
(let ((imap-current-target-mailbox mailbox))
(when (imap-ok-p (imap-send-command-wait
(list "APPEND " (imap-encode-string mailbox) " "
article)))
- (cdr (imap-mailbox-get 'appenduid mailbox))))
+ (imap-mailbox-get 'appenduid mailbox)))
(let (res)
(when (setq res (imap-mailbox-status mailbox '(uidvalidity uidnext)))
(when (imap-ok-p (imap-send-command-wait
@@ -898,35 +903,80 @@
;; Internal functions.
+(defun imap-send-command-1 (cmdstr)
+ (setq cmdstr (concat cmdstr imap-client-eol))
+ (and imap-log
+ (with-current-buffer (get-buffer-create imap-log)
+ (imap-disable-multibyte)
+ (buffer-disable-undo)
+ (goto-char (point-max))
+ (insert cmdstr)))
+ (process-send-string imap-process cmdstr))
+
(defun imap-send-command (command &optional buffer)
(with-current-buffer (or buffer (current-buffer))
(if (not (listp command)) (setq command (list command)))
(let ((tag (setq imap-tag (1+ imap-tag)))
- cmdstr cmd)
+ cmd cmdstr)
(setq cmdstr (concat (number-to-string imap-tag) " "))
(while (setq cmd (pop command))
(cond ((stringp cmd)
(setq cmdstr (concat cmdstr cmd)))
+ ((bufferp cmd)
+ (setq cmdstr
+ (concat cmdstr (format "{%d}" (with-current-buffer cmd
+ (buffer-size)))))
+ (unwind-protect
+ (progn
+ (imap-send-command-1 cmdstr)
+ (setq cmdstr nil)
+ (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
+ (setq command nil) ;; abort command if no cont-req
+ (let ((process imap-process)
+ (stream imap-stream))
+ (with-current-buffer cmd
+ (when (eq stream 'kerberos4)
+ ;; XXX modifies buffer!
+ (goto-char (point-min))
+ (while (re-search-forward "\r\n" nil t)
+ (replace-match "\n")))
+ (and imap-log
+ (with-current-buffer (get-buffer-create
+ imap-log)
+ (imap-disable-multibyte)
+ (buffer-disable-undo)
+ (goto-char (point-max))
+ (insert-buffer-substring cmd)))
+ (process-send-region process (point-min)
+ (point-max)))
+ (process-send-string process imap-client-eol))))
+ (setq imap-continuation nil)))
+ ((functionp cmd)
+ (imap-send-command-1 cmdstr)
+ (setq cmdstr nil)
+ (unwind-protect
+ (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
+ (setq command nil) ;; abort command if no cont-req
+ (setq command (cons (funcall cmd imap-continuation)
+ command)))
+ (setq imap-continuation nil)))
(t
(error "Unknown command type"))))
- (setq cmdstr (concat cmdstr imap-client-eol))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert cmdstr)))
- (process-send-string imap-process cmdstr)
+ (if cmdstr
+ (imap-send-command-1 cmdstr))
tag)))
(defun imap-wait-for-tag (tag &optional buffer)
(with-current-buffer (or buffer (current-buffer))
- (while (< imap-reached-tag tag)
+ (while (and (null imap-continuation)
+ (< imap-reached-tag tag))
(or (and (not (memq (process-status imap-process) '(open run)))
(sit-for 1))
(accept-process-output imap-process 1)))
(or (assq tag imap-failed-tags)
- 'OK)))
+ (if imap-continuation
+ 'INCOMPLETE
+ 'OK))))
(defun imap-sentinel (process string)
(delete-process process))
@@ -955,8 +1005,8 @@
(buffer-disable-undo)
(goto-char (point-max))
(insert string)))
- (goto-char (point-min))
(let (end)
+ (goto-char (point-min))
(while (setq end (imap-find-next-line))
(save-restriction
(narrow-to-region (point-min) end)
@@ -1106,7 +1156,10 @@
"Parse a IMAP command response."
(let (token)
(case (setq token (read (current-buffer)))
- (+ (imap-parse-continue-req))
+ (+ (setq imap-continuation
+ (or (buffer-substring (min (point-max) (1+ (point)))
+ (point-max))
+ t)))
(* (case (prog1 (setq token (read (current-buffer)))
(or (eobp) (forward-char)))
(OK (imap-parse-resp-text))
@@ -1132,34 +1185,39 @@
(FETCH (imap-parse-fetch token))
(t (message "Garbage: %s" (buffer-string)))))))
(t (let (status)
- (case (prog1 (setq status (read (current-buffer)))
- (or (eobp) (forward-char)))
- (OK (progn
- (setq imap-reached-tag (max imap-reached-tag token))
- (imap-parse-resp-text)))
- (NO (progn
- (setq imap-reached-tag (max imap-reached-tag token))
- (save-excursion
- (imap-parse-resp-text))
- (let (code text)
- (when (eq (char-after) ?\[)
- (setq code (buffer-substring (point) (search-forward "]")))
- (or (eobp) (forward-char)))
- (setq text (buffer-substring (point) (point-max)))
- (push (list token status code text) imap-failed-tags))))
- (BAD (progn
- (setq imap-reached-tag (max imap-reached-tag token))
- (save-excursion
- (imap-parse-resp-text))
- (let (code text)
- (when (eq (char-after) ?\[)
- (setq code (buffer-substring (point) (search-forward "]")))
- (or (eobp) (forward-char)))
- (setq text (buffer-substring (point) (point-max)))
- (push (list token status code text) imap-failed-tags)
- (message "Internal error, tag %s status %s code %s text %s"
- token status code text))))
- (t (message "Garbage after tag: %s" (buffer-string)))))))))
+ (if (not (integerp token))
+ (message "Garbage: %s" (buffer-string))
+ (case (prog1 (setq status (read (current-buffer)))
+ (or (eobp) (forward-char)))
+ (OK (progn
+ (setq imap-reached-tag (max imap-reached-tag token))
+ (imap-parse-resp-text)))
+ (NO (progn
+ (setq imap-reached-tag (max imap-reached-tag token))
+ (save-excursion
+ (imap-parse-resp-text))
+ (let (code text)
+ (when (eq (char-after) ?\[)
+ (setq code (buffer-substring (point)
+ (search-forward "]")))
+ (or (eobp) (forward-char)))
+ (setq text (buffer-substring (point) (point-max)))
+ (push (list token status code text)
+ imap-failed-tags))))
+ (BAD (progn
+ (setq imap-reached-tag (max imap-reached-tag token))
+ (save-excursion
+ (imap-parse-resp-text))
+ (let (code text)
+ (when (eq (char-after) ?\[)
+ (setq code (buffer-substring (point)
+ (search-forward "]")))
+ (or (eobp) (forward-char)))
+ (setq text (buffer-substring (point) (point-max)))
+ (push (list token status code text) imap-failed-tags)
+ (message "Internal error, tag %s status %s code %s text %s"
+ token status code text))))
+ (t (message "Garbage: %s" (buffer-string))))))))))
;; resp-text = ["[" resp-text-code "]" SP] text
;;
Index: nnimap/nnimap.el
diff -u nnimap/nnimap.el:1.125 nnimap/nnimap.el:1.130
--- nnimap/nnimap.el:1.125 Thu Jan 7 16:18:01 1999
+++ nnimap/nnimap.el Thu Feb 4 17:41:30 1999
@@ -1,6 +1,6 @@
;;; nnimap.el --- IMAP backend for Gnus
-;;; Copyright (C) 1998 Simon Josefsson <jas@pdc.kth.se>
+;;; Copyright (C) 1998,1999 Simon Josefsson <jas@pdc.kth.se>
;;; Copyright (C) 1998 Jim Radford <radford@robby.caltech.edu>
;;; Copyright (C) 1997 John McClary Prevost <visigoth@cs.cmu.edu>
@@ -77,100 +77,24 @@
;;; o Support RFC2221 (Login referrals)
;;; o IMAP2BIS compatibility? (RFC2061)
;;; o Debug imtest, it dumps with "Time is out of bounds" sometimes
+;;; (This has been acknowledged by the Cyrus team and they are
+;;; looking into it -- as a workaround, set `imap-imtest-arguments' to
+;;; "-k", only integrity and privacy checking causes the bug.)
;;; o ACAP stuff (perhaps a different project, would be nice to ACAPify
;;; .newsrc.eld)
;;; o MIME
;; nnimap 1.x variables:
-;; Legacy variables:
-
-(require 'imap)
+(eval-and-compile
+ (require 'imap))
(require 'nnoo)
-(require 'nnheader)
-(require 'nnmail)
-(require 'gnus)
-(require 'gnus-range)
-
-(eval-when-compile (require 'cl))
-
-(gnus-declare-backend "nnimap" 'mail 'address 'prompt-address
- 'physical-address 'respool) ;; respool??
-(nnoo-declare nnimap) ; we derive from no one
+(nnoo-declare nnimap)
-(defconst nnimap-version "nnimap 0.92")
+(defconst nnimap-version "nnimap 0.93")
-;; Various server variables.
-
-(defvoo nnimap-directory message-directory
- "Data directory for the nnimap backend.")
-
-(defvoo nnimap-active-file
- (concat (file-name-as-directory nnimap-directory) "active")
- "Mail active file for the nnimap backend.")
-
-(defvoo nnimap-list-pattern "*"
-"*PATTERN or list of PATTERNS use to limit available groups.
-
-A pattern is either GROUP or (REFERENCE . GROUP).
-
-GROUP is a string. See the available wildcard characters below.
-
-The meaning of REFERENCE is server-specific, so it's
-expected that you (the user) can figure out the appropriate setting.
-On the Cyrus server, this is irrelevant. On the UWash server, this
-gets joined together with GROUP. If it is not specified the
-default is an empty string.
-
-Example:
- '(\"INBOX\" \"Mail/*\" \"alt.sex.*\" (\"~friend/Mail/\" . \"list/*\"))
-
-Also note that currently groups that start with a '.' cause Gnus to
-choke, so instead of using something like \"*\" which might match
-\".mailboxlist\" you could use \"~/*\" which would match
-\"~/.mailboxlist\" and not cause problems.
-
-The two wildcards are * and %. * means match anything, much like in
-shell globbing in Unix. * does match hierarchy delimiters (. or /, in
-the usual case.) % is the same as *, but does not match the hierarchy
-delimiter.")
-
-(defvoo nnimap-list-method "LIST" ; "LSUB"
- "*Function called on IMAP server to list groups. One of \"LSUB\" or
-\"LIST\". LSUB means only retrieve groups marked on the server as
-subscribed. LIST means every matching group should be retrieved.")
-
-(defvoo nnimap-address nil
- "*The name of the IMAP server. If nil, uses the virtual server's name.")
-
-(defvoo nnimap-server-address nil
- "Obsolete. Use `nnimap-address'.")
-
-(defvoo nnimap-server-port nil
- "*The port of the IMAP server. If nil, uses the default port. (143).")
-
-(defvoo nnimap-imap-defs nil
- "*Definitions of variables to set up in the IMAP buffer.")
-
-(defvoo nnimap-expunge-on-close 'always ; 'ask, 'never
- "When a IMAP group with articles marked for deletion is closed, this
-variable determine if nnimap should actually remove the articles or
-not.
-
-If always, nnimap always perform a expunge when closing the group.
-If never, nnimap never expunges articles marked for deletion.
-If ask, nnimap will ask you if you wish to expunge marked articles.
-
-When setting this variable to `never', you can only expunge articles
-by using `G x' (gnus-group-nnimap-expunge) from the Group buffer.")
-
-(defvoo nnimap-group-list-speed 'slow ; 'fast, 'medium
- "*If fast, do not show number of articles in the group list.
-If medium, guess number of articles by using the UIDNEXT attribute.
-If slow, fetch the UID of lowest/highest article.")
-
;; Splitting variables
(defvar nnimap-split-crosspost t
@@ -262,6 +186,87 @@
(const :format "" "password")
(string :format "Password: %v")))))))
+;; Legacy variables:
+
+(require 'nnheader)
+(require 'nnmail)
+(require 'gnus)
+(require 'gnus-range)
+
+(eval-when-compile (require 'cl))
+
+(gnus-declare-backend "nnimap" 'mail 'address 'prompt-address
+ 'physical-address 'respool) ;; respool??
+
+;; Various server variables.
+
+(defvoo nnimap-directory message-directory
+ "Data directory for the nnimap backend.")
+
+(defvoo nnimap-active-file
+ (concat (file-name-as-directory nnimap-directory) "active")
+ "Mail active file for the nnimap backend.")
+
+(defvoo nnimap-list-pattern "*"
+"*PATTERN or list of PATTERNS use to limit available groups.
+
+A pattern is either GROUP or (REFERENCE . GROUP).
+
+GROUP is a string. See the available wildcard characters below.
+
+The meaning of REFERENCE is server-specific, so it's
+expected that you (the user) can figure out the appropriate setting.
+On the Cyrus server, this is irrelevant. On the UWash server, this
+gets joined together with GROUP. If it is not specified the
+default is an empty string.
+
+Example:
+ '(\"INBOX\" \"Mail/*\" \"alt.sex.*\" (\"~friend/Mail/\" . \"list/*\"))
+
+Also note that currently groups that start with a '.' cause Gnus to
+choke, so instead of using something like \"*\" which might match
+\".mailboxlist\" you could use \"~/*\" which would match
+\"~/.mailboxlist\" and not cause problems.
+
+The two wildcards are * and %. * means match anything, much like in
+shell globbing in Unix. * does match hierarchy delimiters (. or /, in
+the usual case.) % is the same as *, but does not match the hierarchy
+delimiter.")
+
+(defvoo nnimap-list-method "LIST" ; "LSUB"
+ "*Function called on IMAP server to list groups. One of \"LSUB\" or
+\"LIST\". LSUB means only retrieve groups marked on the server as
+subscribed. LIST means every matching group should be retrieved.")
+
+(defvoo nnimap-address nil
+ "*The name of the IMAP server. If nil, uses the virtual server's name.")
+
+(defvoo nnimap-server-address nil
+ "Obsolete. Use `nnimap-address'.")
+
+(defvoo nnimap-server-port nil
+ "*The port of the IMAP server. If nil, uses the default port. (143).")
+
+(defvoo nnimap-imap-defs nil
+ "*Definitions of variables to set up in the IMAP buffer.")
+
+(defvoo nnimap-expunge-on-close 'always ; 'ask, 'never
+ "When a IMAP group with articles marked for deletion is closed, this
+variable determine if nnimap should actually remove the articles or
+not.
+
+If always, nnimap always perform a expunge when closing the group.
+If never, nnimap never expunges articles marked for deletion.
+If ask, nnimap will ask you if you wish to expunge marked articles.
+
+When setting this variable to `never', you can only expunge articles
+by using `G x' (gnus-group-nnimap-expunge) from the Group buffer.")
+
+(defvoo nnimap-group-list-speed 'slow ; 'fast, 'medium
+ "*If fast, do not show number of articles in the group list.
+If medium, guess number of articles by using the UIDNEXT attribute.
+If slow, fetch the UID of lowest/highest article.")
+
;; Internal variables.
(defvoo nnimap-need-expunge nil)
@@ -322,7 +327,7 @@
; nnimap-ok-p
nnimap-split-copy-delete-article
nnimap-split-move-article
-; nnimap-split-to-groups
+ nnimap-split-to-groups
nnimap-split-articles
nnimap-request-update-info-internal
nnimap-request-set-mark
@@ -343,8 +348,287 @@
nnimap-save-info-hook
nnimap-update-flags-hook
)))
+
+;; nnimap 1.x functions:
+
+(defun nnimap-body-lines (body)
+ "Return number of lines in article by looking at the mime bodystructure
+BODY."
+ (if (listp body)
+ (if (stringp (car body))
+ (cond ((and (string= (car body) "TEXT")
+ (numberp (nth 7 body)))
+ (nth 7 body))
+ ((and (string= (car body) "MESSAGE")
+ (numberp (nth 9 body)))
+ (nth 9 body))
+ (t 0))
+ (apply '+ (mapcar 'nnimap-body-lines body)))
+ 0))
+
+;; nnimap-request-scan doesn't need to do anything. the delivery agent
+;; program is responsible for putting new message in the imap folders.
+;; compare the situation with nntp (nil function) and with all nnmail-
+;; backends (fetches mail from spools, POPing, saving in files on local
+;; storage etc).
+;; On the other hand, we could do message splitting here.
+(deffoo nnimap-request-scan (&optional group server)
+ (nnimap-split-articles group server))
+
+(defun nnimap-split-copy-delete-article (article group to-group server)
+ "Move article ARTICLE from group GROUP on current server to group TO-GROUP."
+ (when (nnimap-ok-p (nnimap-send-command-wait
+ (format "UID COPY %d %s" article to-group)))
+ (setq nnimap-need-expunge t)
+ (if (imap-message-flags-add (format "%d" article) "\\Seen \\Deleted")
+ (message "IMAP split moved %s:%s:%d to %s" server group
+ article to-group)
+ (error "IMAP flag store failed: you may have unread mail marked as read!"))))
+
+(defun nnimap-split-move-article (article group to-group server)
+ (when to-group
+ (unless (nnimap-split-copy-delete-article article group to-group server)
+ (message "Could not find mailbox %s, creating..." to-group)
+ (if (nnimap-ok-p (nnimap-send-command-wait
+ (format "CREATE %s" to-group)))
+ (nnimap-split-copy-delete-article article group to-group server)
+ (message "Could not create mailbox %s." to-group)))))
+
+;; This is from nnmail.el:nnmail-expand-newtext, written by Larsi.
+(defun nnimap-expand-newtext (newtext)
+ (let ((len (length newtext))
+ (pos 0)
+ c expanded beg N did-expand)
+ (while (< pos len)
+ (setq beg pos)
+ (while (and (< pos len)
+ (not (= (aref newtext pos) ?\\)))
+ (setq pos (1+ pos)))
+ (unless (= beg pos)
+ (push (substring newtext beg pos) expanded))
+ (when (< pos len)
+ ;; We hit a \; expand it.
+ (setq did-expand t
+ pos (1+ pos)
+ c (aref newtext pos))
+ (if (not (or (= c ?\&)
+ (and (>= c ?1)
+ (<= c ?9))))
+ ;; \ followed by some character we don't expand.
+ (push (char-to-string c) expanded)
+ ;; \& or \N
+ (if (= c ?\&)
+ (setq N 0)
+ (setq N (- c ?0)))
+ (when (match-beginning N)
+ (push (buffer-substring (match-beginning N) (match-end N))
+ expanded))))
+ (setq pos (1+ pos)))
+ (if did-expand
+ (apply 'concat (nreverse expanded))
+ newtext)))
+
+;; tries to match all rules in nnimap-split-rule against content of
+;; nntp-server-buffer, returns a list of groups that matched.
+(defun nnimap-split-to-groups (rules)
+ (let (to-groups regrepp)
+ (with-current-buffer nntp-server-buffer
+ ;; Fold continuation lines.
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+ (replace-match " " t t))
+ (catch 'split-done
+ (dolist (rule rules to-groups)
+ (let ((group (car rule))
+ (regexp (cadr rule)))
+ (goto-char (point-min))
+ (when (and (if (stringp regexp)
+ (progn
+ (setq regrepp (string-match "\\\\[0-9&]" group))
+ (re-search-forward regexp nil t))
+ (funcall regexp group))
+ ;; Don't enter the article into the same group twice.
+ (not (assoc group to-groups)))
+ (push (if regrepp
+ (nnimap-expand-newtext group)
+ group)
+ to-groups)
+ (or nnimap-split-crosspost
+ (throw 'split-done to-groups)))))))))
+
+(defun nnimap-split-find-rule (server inbox)
+ nnimap-split-rule)
+
+(defun nnimap-split-find-inbox (server)
+ (if (listp nnimap-split-inbox)
+ nnimap-split-inbox
+ (list nnimap-split-inbox)))
+
+(defun nnimap-split-articles (&optional group server)
+ (when (nnimap-possibly-change-server server)
+ (with-current-buffer nnimap-server-buffer
+ (let (rule inbox (inboxes (nnimap-split-find-inbox server)))
+ ;; iterate over inboxes
+ (while (and (setq inbox (pop inboxes))
+ (nnimap-possibly-change-group inbox)) ;; SELECT
+ ;; find split rule for this server / inbox
+ (when (setq rule (nnimap-split-find-rule server inbox))
+ ;; iterate over articles
+ (dolist (article (imap-search "UNSEEN"))
+ (when (nnimap-request-head article)
+ ;; move article to right group(s)
+ (dolist (to-group (nnimap-split-to-groups rule) t)
+ (nnimap-split-move-article article inbox to-group server)))))
+ (when (imap-mailbox-select inbox) ;; just in case
+ ;; todo: UID EXPUNGE (if available) to remove splitted articles
+ (nnimap-expunge-close-group)))
+ t))))
+
+;; (nn)IMAP specific decisions:
+;;
+;; o deletion of reply-marks is prohibited
+;; o dormant articles are also marked as ticked
+;;
+;; action looks like:
+;; (((1 . 10) 'set '(read ticked))
+;; ((1 . 10) 'del '(tick reply expire killed dormant save download unsend)))
+;;
+(deffoo nnimap-request-set-mark (group actions &optional server)
+ (when (nnimap-possibly-change-group group server)
+ (with-current-buffer nnimap-server-buffer
+ (let (action)
+ (gnus-message 7 "Setting marks in %s:%s..."
+ (nnoo-current-server 'nnimap) group)
+ (while (setq action (pop actions))
+ (let ((range (nth 0 action))
+ (what (nth 1 action))
+ (pred (nth 2 action)))
+ ;; enforce local decisions
+ (if (eq what 'del)
+ (setq pred (delq 'reply pred)))
+ (if (memq 'dormant pred)
+ (setq pred (cons 'tick pred)))
+ (when (and range pred)
+ (cond ((eq what 'del)
+ (imap-message-flags-del (nnimap-range-to-string range)
+ (nnimap-mark-to-flag pred nil t)))
+ ((eq what 'add)
+ (imap-message-flags-add (nnimap-range-to-string range)
+ (nnimap-mark-to-flag pred nil t)))
+ ((eq what 'set)
+ (imap-message-flags-set (nnimap-range-to-string range)
+ (nnimap-mark-to-flag pred nil t)))))))
+ (gnus-message 7 "Setting marks in %s:%s...done"
+ (nnoo-current-server 'nnimap) group)))))
+
+(deffoo nnimap-request-move-article (article group server
+ accept-form &optional last)
+ (save-excursion
+ (let ((buf (get-buffer-create " *nnimap move*"))
+ result)
+ (and
+ (nnimap-request-article article group server)
+ (save-excursion
+ (set-buffer buf)
+ (buffer-disable-undo (current-buffer))
+ (insert-buffer-substring nntp-server-buffer)
+ (setq result (eval accept-form))
+ (kill-buffer buf)
+ result)
+ (nnimap-request-expire-articles (list article) group server t))
+ result)))
+
+;;; Gnus functions
+
+(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 "Expunging only available for nnimap groups"))
+ (when (nnimap-possibly-change-group mailbox (cadr method))
+ (nnimap-send-command-wait "EXPUNGE" nnimap-server-buffer))))
+
+(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 'nnimap (car (setq method (gnus-find-method-for-group group))))
+ (error "ACL editing only available for nnimap groups"))
+ (when (nnimap-possibly-change-server (cadr method))
+ (unless (imap-capability 'ACL nnimap-server-buffer)
+ (error "Your server does not support ACL editing"))
+ (gnus-edit-form (setq acl (imap-mailbox-acl-get mailbox
+ nnimap-server-buffer))
+ (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)
+ (gnus-group-nnimap-edit-acl-done
+ ,mailbox ',method ',acl form))))))
-;; nnimap 1.x functions:
+(defun gnus-group-nnimap-edit-acl-done (mailbox method old-acls new-acls)
+ (when (nnimap-possibly-change-server (cadr method))
+ (with-current-buffer nnimap-server-buffer
+ ;; delete all removed identifiers
+ (mapcar (lambda (old-acl)
+ (unless (assoc (car old-acl) new-acls)
+ (or (imap-mailbox-acl-delete (car old-acl) mailbox)
+ (error "Can't delete ACL for %s..." (car old-acl)))))
+ old-acls)
+ ;; set all changed acl's
+ (mapcar (lambda (new-acl)
+ (let ((new-rights (cdr new-acl))
+ (old-rights (cdr (assoc (car new-acl) old-acls))))
+ (unless (and old-rights new-rights
+ (string= old-rights new-rights))
+ (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox)
+ (error "Can't set ACL for %s to %s..." (car new-acl)
+ new-rights)))))
+ new-acls)
+ t)))
+
+;;; Gnus glue
+
+(defun nnimap-group-mode-hook ()
+ (define-key gnus-group-mode-map (if (fboundp 'kbd) (kbd "G l")
+ (read-kbd-macro "G l"))
+ 'gnus-group-nnimap-edit-acl)
+ (define-key gnus-group-mode-map (if (fboundp 'kbd) (kbd "G x")
+ (read-kbd-macro "G x"))
+ 'gnus-group-nnimap-expunge))
+(add-hook 'gnus-group-mode-hook 'nnimap-group-mode-hook)
;; legacy functions:
@@ -361,22 +645,6 @@
(nnoo-define-basics nnimap)
-(defun nnimap-body-lines (body)
- "Return number of lines in article by looking at the mime bodystructure
-BODY."
- (if (listp body)
- (if (stringp (car body))
- (cond ((and (string= (car body) "TEXT")
- (numberp (nth 7 body)))
- (nth 7 body))
- ((and (string= (car body) "MESSAGE")
- (numberp (nth 9 body)))
- (nth 9 body))
- (t 0))
- (apply '+ (mapcar 'nnimap-body-lines body)))
- 0))
-
-
(defun nnimap-retrieve-headers-progress ()
(when (> nnimap-length 25)
(setq nnimap-counter (1+ nnimap-counter))
@@ -742,90 +1010,6 @@
(deffoo nnimap-request-type (group article)
'mail)
-(defun nnimap-split-copy-delete-article (article group to-group server)
- "Move article ARTICLE from group GROUP on current server to group TO-GROUP."
- (when (nnimap-ok-p (nnimap-send-command-wait
- (format "UID COPY %d %s" article to-group)))
- (setq nnimap-need-expunge t)
- (if (imap-message-flags-add (format "%d" article) "\\Seen \\Deleted")
- (message "IMAP split moved %s:%s:%d to %s" server group
- article to-group)
- (error "IMAP flag store failed: you may have unread mail marked as read!"))))
-
-(defun nnimap-split-move-article (article group to-group server)
- (when to-group
- (unless (nnimap-split-copy-delete-article article group to-group server)
- (message "Could not find mailbox %s, creating..." to-group)
- (if (nnimap-ok-p (nnimap-send-command-wait
- (format "CREATE %s" to-group)))
- (nnimap-split-copy-delete-article article group to-group server)
- (message "Could not create mailbox %s." to-group)))))
-
-;; tries to match all rules in nnimap-split-rule against content of
-;; nntp-server-buffer, returns a list of groups that matched.
-(defun nnimap-split-to-groups (rule)
- (let (to-groups)
- (with-current-buffer nntp-server-buffer
- (mapcar (lambda (rule)
- (let ((group (car rule))
- (regexp (cadr rule)))
- ;; Fold continuation lines.
- (goto-char (point-min))
- (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " " t t))
- (goto-char (point-min))
- (when (re-search-forward regexp nil t)
- (setq to-groups (cons group to-groups)))))
- rule)
- (reverse to-groups))))
-
-(defun nnimap-split-find-rule (server inbox)
- nnimap-split-rule)
-
-(defun nnimap-split-find-inbox (server)
- (if (listp nnimap-split-inbox)
- nnimap-split-inbox
- (list nnimap-split-inbox)))
-
-(defun nnimap-split-articles (&optional group server)
- (when (nnimap-possibly-change-server server)
- (with-current-buffer nnimap-server-buffer
- (let (rule inbox (inboxes (nnimap-split-find-inbox server)))
- ;; iterate over inboxes
- (while (and (setq inbox (pop inboxes))
- (nnimap-possibly-change-group inbox)) ;; SELECT
- ;; find split rule for this server / inbox
- (when (setq rule (nnimap-split-find-rule server inbox))
- (let (article (unseens (imap-search "UNSEEN")))
- ;; iterate over articles
- (while (setq article (pop unseens))
- (when (nnimap-request-head article)
- ;; article into what groups?
- (let ((groups (nnimap-split-to-groups rule)))
- ;; move it there
- (if nnimap-split-crosspost
- ;; move to all boxes
- (let (to-group)
- (while (setq to-group (pop groups))
- (nnimap-split-move-article article inbox
- to-group server)))
- ;; move to first matching box, if any
- (nnimap-split-move-article article inbox
- (car groups) server)))))))
- (when (imap-mailbox-select inbox) ;; just in case
- ;; todo: UID EXPUNGE (if available) to remove splitted articles
- (nnimap-expunge-close-group)))
- t))))
-
-;; nnimap-request-scan doesn't need to do anything. the delivery agent
-;; program is responsible for putting new message in the imap folders.
-;; compare the situation with nntp (nil function) and with all nnmail-
-;; backends (fetches mail from spools, POPing, saving in files on local
-;; storage etc).
-;; On the other hand, we could do message splitting here.
-(deffoo nnimap-request-scan (&optional group server)
- (nnimap-split-articles group server))
-
;; until everyone uses gnus >= 5.6.24
(deffoo nnimap-request-group-description (group &optional server)
(when (nnimap-possibly-change-server server)
@@ -847,43 +1031,6 @@
(erase-buffer))
t))
-;; (nn)IMAP specific decisions:
-;;
-;; o deletion of reply-marks is prohibited
-;; o dormant articles are also marked as ticked
-;;
-;; action looks like:
-;; (((1 . 10) 'set '(read ticked))
-;; ((1 . 10) 'del '(tick reply expire killed dormant save download unsend)))
-;;
-(deffoo nnimap-request-set-mark (group actions &optional server)
- (when (nnimap-possibly-change-group group server)
- (with-current-buffer nnimap-server-buffer
- (let (action)
- (gnus-message 7 "Setting marks in %s:%s..."
- (nnoo-current-server 'nnimap) group)
- (while (setq action (pop actions))
- (let ((range (nth 0 action))
- (what (nth 1 action))
- (pred (nth 2 action)))
- ;; enforce local decisions
- (if (eq what 'del)
- (setq pred (delq 'reply pred)))
- (if (memq 'dormant pred)
- (setq pred (cons 'tick pred)))
- (when (and range pred)
- (cond ((eq what 'del)
- (imap-message-flags-del (nnimap-range-to-string range)
- (nnimap-mark-to-flag pred nil t)))
- ((eq what 'add)
- (imap-message-flags-add (nnimap-range-to-string range)
- (nnimap-mark-to-flag pred nil t)))
- ((eq what 'set)
- (imap-message-flags-set (nnimap-range-to-string range)
- (nnimap-mark-to-flag pred nil t)))))))
- (gnus-message 7 "Setting marks in %s:%s...done"
- (nnoo-current-server 'nnimap) group)))))
-
(deffoo nnimap-request-create-group (group &optional server args)
(when (nnimap-possibly-change-server server)
(nnimap-ok-p (nnimap-send-command-wait
@@ -956,35 +1103,17 @@
;; return articles not deleted
articles)
-(deffoo nnimap-request-move-article (article group server
- accept-form &optional last)
- (save-excursion
- (let ((buf (get-buffer-create " *nnimap move*"))
- result)
- (and
- (nnimap-request-article article group server)
- (save-excursion
- (set-buffer buf)
- (buffer-disable-undo (current-buffer))
- (insert-buffer-substring nntp-server-buffer)
- (setq result (eval accept-form))
- (kill-buffer buf)
- result)
- (nnimap-request-expire-articles (list article) group server t))
- result)))
-
(deffoo nnimap-request-accept-article (group &optional server last)
(when (nnimap-possibly-change-server server)
- ;; turn into rfc822 format (\r\n eol's) if needed
+ ;; turn into rfc822 format (\r\n eol's)
(with-current-buffer (current-buffer)
(goto-char (point-min))
- (while (re-search-forward "\\(^\\|[^\r]\\)\n" nil t)
+ (while (re-search-forward "\n" nil t)
(replace-match "\r\n")))
- (let ((status (imap-message-append group
- (current-buffer)
+ (let ((status (imap-message-append group (current-buffer)
nnimap-server-buffer)))
(when status
- (cons group (nth 2 status))))))
+ (cons group (nth 1 status))))))
;; (deffoo nnimap-request-replace-article -- IMAP does not support replacing
@@ -1016,7 +1145,7 @@
;; predicate => "SEEN", "FLAGGED", "DRAFT", "KEYWORD gnus-expire" etc
;;
;; Mark should not really contain 'read since it's not a "mark" in the Gnus
-;; world, but we cheat. Mark == gnus-articlemark-lists + '(read . read).
+;; world, but we cheat. Mark == gnus-article-mark-lists + '(read . read).
;;
(defconst nnimap-mark-to-predicate-alist
@@ -1180,27 +1309,10 @@
(not (gnus-info-read info)))
(gnus-group-set-parameter groupname 'uidvalidity
new-uid)
- (message "UIDVALIDITY clash. Old value `%s', new `%s'"
- old-uid new-uid)
+ (message "UIDVALIDITY clash in group %s. Old value `%s', new `%s'" group old-uid new-uid)
(imap-mailbox-unselect))))))))
imap-current-mailbox)))
-;;; Gnus functions
-
-(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 "Expunging only available for nnimap groups"))
- (when (nnimap-possibly-change-group mailbox (cadr method))
- (nnimap-send-command-wait "EXPUNGE" nnimap-server-buffer))))
-
(eval-and-compile
(if (not (fboundp 'destructive-plist-to-alist)) ;; From XEmacs subr.el
(defun destructive-plist-to-alist (plist)
@@ -1228,82 +1340,6 @@
(setcdr plist next)
(setq plist next))
head))))
-
-(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 'nnimap (car (setq method (gnus-find-method-for-group group))))
- (error "ACL editing only available for nnimap groups"))
- (when (nnimap-possibly-change-server (cadr method))
- (unless (imap-capability 'ACL nnimap-server-buffer)
- (error "Your server does not support ACL editing"))
- (gnus-edit-form (setq acl (imap-mailbox-acl-get mailbox
- nnimap-server-buffer))
- (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)
- (gnus-group-nnimap-edit-acl-done
- ,mailbox ',method ',acl form))))))
-
-(defun gnus-group-nnimap-edit-acl-done (mailbox method old-acls new-acls)
- (when (nnimap-possibly-change-server (cadr method))
- (with-current-buffer nnimap-server-buffer
- ;; delete all removed identifiers
- (mapcar (lambda (old-acl)
- (unless (assoc (car old-acl) new-acls)
- (or (imap-mailbox-acl-delete (car old-acl) mailbox)
- (error "Can't delete ACL for %s..." (car old-acl)))))
- old-acls)
- ;; set all changed acl's
- (mapcar (lambda (new-acl)
- (let ((new-rights (cdr new-acl))
- (old-rights (cdr (assoc (car new-acl) old-acls))))
- (unless (and old-rights new-rights
- (string= old-rights new-rights))
- (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox)
- (error "Can't set ACL for %s to %s..." (car new-acl)
- new-rights)))))
- new-acls)
- t)))
-
-;;; Gnus glue
-
-(defun nnimap-group-mode-hook ()
- (define-key gnus-group-mode-map (if (fboundp 'kbd) (kbd "G l")
- (read-kbd-macro "G l"))
- 'gnus-group-nnimap-edit-acl)
- (define-key gnus-group-mode-map (if (fboundp 'kbd) (kbd "G x")
- (read-kbd-macro "G x"))
- 'gnus-group-nnimap-expunge))
-(add-hook 'gnus-group-mode-hook 'nnimap-group-mode-hook)
(provide 'nnimap)
Index: nnimap/nnimap.texi
diff -u nnimap/nnimap.texi:1.19 nnimap/nnimap.texi:1.20
--- nnimap/nnimap.texi:1.19 Fri Dec 18 12:51:18 1998
+++ nnimap/nnimap.texi Thu Jan 28 15:00:52 1999
@@ -7,14 +7,14 @@
@setchapternewpage odd
@paragraphindent 0
-@set VERSION $Revision: 1.1 $
+@set VERSION $Revision: 1.1 $
@set NNIMAP-VERSION 0.84
@ifinfo
This file documents nnimap, an Emacs Lisp package for accessing
IMAP servers from GNUS.
- Copyright 1998 Simon Josefsson, texinfo conversion by Martin Fouts
+ Copyright 1998,1999 Simon Josefsson, texinfo conversion by Martin Fouts.
Permission is granted to make and distribute verbatim
copies of this manual provided the copyright notice and
@@ -506,23 +506,39 @@
@lisp
(setq nnimap-split-rule
- '(("INBOX.nnimap" "^Sender: owner-nnimap@@vic20.globalcom.se")
+ '(("INBOX.nnimap" "^Sender: owner-nnimap@@vic20.globalcom.se")
("INBOX.spam" "^Subject:.*MAKE MONEY")
("INBOX.private" "")))
@end lisp
-This will put all articles from the nnimap mailing list into the IMAP
-mailbox INBOX.nnimap, all articles containing MAKE MONEY in the Subject:
-line in INBOX.spam and everything else in INBOX.private.
-
-It's probably a very good idea to have a empty regexp as the last entry
-has in the example, this will clear the incoming mailbox from mail that
-otherwise would be subject to the splitting process every time you start
-Gnus.
+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.
+
+The last of these groups should always be a general one, and the regular
+expression should always be `' so that it matches any mails that haven't
+been matched by any of the other regexps.
+
+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 has too.
-Nnmail (semi-)equivalent: @code{nnmail-split-methods}.
+Nnmail equivalent: @code{nnmail-split-methods}.
@node config-expiring, config-krb, config-splitting, config
@section Expiring Mail