Use sieve-mailbox-open instead of mu-mailbox-open. The former searches

the list of open mailboxes and returns one if found. All the mailboxes
get closed at once when the sieve program finishes execution. This saves
memory and speeds up the execution (fewer calls to gc, if any).
sieve-regexp-to-posix: escape special characters.
action-reject: Use ports instead of mu-body- interface.

1 files changed, 50 insertions, 14 deletions

diff --git a/guimb/scm/sieve-core.scm b/guimb/scm/sieve-core.scm
index 7cb6c92ca..d1c14fdfe 100644
--- a/guimb/scm/sieve-core.scm
+++ b/guimb/scm/sieve-core.scm
@@ -17,6 +17,37 @@
 
 ;;;; This module provides core functionality for the sieve scripts.
 
+;;; List of open mailboxes.
+;;; Each entry is: (list MAILBOX-NAME OPEN-FLAGS MBOX)
+(define sieve-mailbox-list '())
+
+;;; Cached mailbox open: Lookup in the list first, if not found,
+;;; call mu-mailbox-open and append to the list.
+;;; NOTE: second element of each slot (OPEN-FLAGS) is not currently
+;;; used, sinse all the mailboxes are open with "cw".
+(define (sieve-mailbox-open name flags)
+  (let ((slot (assoc name sieve-mailbox-list)))
+    (if slot
+	(list-ref slot 2)
+      (let ((mbox (mu-mailbox-open name flags)))
+	(if mbox
+	    (set! sieve-mailbox-list (append
+				      sieve-mailbox-list
+				      (list
+				       (list name flags mbox)))))
+	mbox))))
+
+;;; Close all open mailboxes.
+(define (sieve-close-mailboxes)
+  (for-each
+   (lambda (slot)
+     (cond
+      ((list-ref slot 2)
+       => (lambda (mbox)
+	    (mu-mailbox-close mbox)))))
+   sieve-mailbox-list)
+  (set! sieve-mailbox-list '()))
+
 ;;; Comparators
 (cond
  (sieve-parser
@@ -37,8 +68,8 @@
 
 (define (action-reject reason)
   (let* ((out-msg (mu-message-create))
-	 (outbody (mu-message-get-body out-msg))
-	 (inbody (mu-message-get-body sieve-current-message)))
+	 (out-port (mu-message-get-port out-msg "w"))
+	 (in-port (mu-message-get-port sieve-current-message "r")))
     (mu-message-set-header out-msg "To"
 			   (mu-message-get-header sieve-current-message
 						  "From"))
@@ -49,34 +80,36 @@
 			    "Re: "
 			    (mu-message-get-header sieve-current-message
 						   "Subject")))
-    (mu-body-write outbody reason)
+    (display reason out-port)
 
     (cond
      (sieve-option-quote
-      (mu-body-write outbody "\n\nThe rejected message follows:\n")
+      (display "\n\nThe rejected message follows:\n" out-port)
       (do ((hdr (mu-message-get-header-fields sieve-current-message)
 		(cdr hdr)))
 	  ((null? hdr) #f)
 	(let ((s (car hdr)))
-	  (mu-body-write outbody (string-append
-				  sieve-indent-prefix
-				  (car s) ": " (cdr s) "\n"))))
-      (mu-body-write outbody (string-append sieve-indent-prefix "\n"))
-      (do ((line (mu-body-read-line inbody) (mu-body-read-line inbody)))
+	  (display (string-append
+		    sieve-indent-prefix
+		    (car s) ": " (cdr s) "\n") out-port)))
+      (display sieve-indent-prefix out-port)
+      (newline out-port)
+      (do ((line (read-line in-port) (read-line in-port)))
 	  ((eof-object? line) #f)
-	(mu-body-write outbody (string-append sieve-indent-prefix line)))))
-
+	(display (string-append sieve-indent-prefix line "\n") out-port))))
+    (close-input-port in-port)
+    (close-output-port out-port)
+	
     (mu-message-send out-msg))
   (mu-message-delete sieve-current-message))
 
 ;;; fileinto
 
 (define (action-fileinto filename)
-  (let ((outbox (mu-mailbox-open filename "cw")))
+  (let ((outbox (sieve-mailbox-open filename "cw")))
     (cond
      (outbox
       (mu-mailbox-append-message outbox sieve-current-message)
-      (mu-mailbox-close outbox)
       (mu-message-delete sieve-current-message)))))
 
 ;;; redirect is defined in redirect.scm
@@ -170,6 +203,8 @@
 	  (set! cl (append (list #\.) cl)))
 	 ((char=? ch #\*)
 	  (set! cl (append (list #\* #\.) cl)))
+	 ((member ch (list #\. #\$ #\^ #\[ #\]))
+	  (set! cl (append (list ch #\\) cl)))
 	 (else
 	  (set! cl (append (list ch) cl))))))))
 		  
@@ -366,4 +401,5 @@
 	(catch 'sieve-stop
 	       sieve-process-message
 	       (lambda args
-		 #f)))))
+		 #f)))
+    (sieve-close-mailboxes)))