diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2009-03-24 20:56:07 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2009-03-24 20:56:07 +0200 |
commit | 43088a1c350b70b627edeb98d927beca3bcd7708 (patch) | |
tree | 1d516191749342a1f88391f426313daf385fd8f3 /guimb/scm | |
parent | 303823bda827fcf3a6f570afe4a9ad7b637663b4 (diff) | |
download | mailutils-43088a1c350b70b627edeb98d927beca3bcd7708.tar.gz mailutils-43088a1c350b70b627edeb98d927beca3bcd7708.tar.bz2 |
Rewrite scripting support in maidag.
* include/mailutils/guile.h (mu_guile_init, mu_guile_load)
(mu_guile_eval, mu_guile_mailbox_apply, mu_guile_message_apply)
(mu_guile_safe_exec, mu_guile_safe_proc_call): New protos.
* libmu_scm/Makefile.am: Add mu_guile.c
* libmu_scm/mu_guile.c: New file.
* libmu_scm/mu_mailbox.c (struct mu_mailbox): Kludge: new member noclose.
(mu_scm_mailbox_free): Do not close/destroy mailbox if it is marked
noclose.
(mu_scm_mailbox_create0): Kludge: new function.
* libmu_scm/mu_message.c (mu_scm_message_print): Bugfix.
* maidag/Makefile.am: Add guile.c and sieve.c.
* maidag/deliver.c (maidag_stdio_delivery) [WITH_GUILE]: Remove block.
(deliver_url): Call script_apply, instead of sieve_test.
* maidag/maidag.c: Rewrite scripting support in a modular way.
Remove options: --sieve, --source (and the corresponding config statements).
Add options: --language, --script.
Add configure statement: filter (block).
* maidag/maidag.h (progfile_pattern, sieve_pattern): Remove.
(script_list, sieve_debug_flags, message_id_header, sieve_enable_log): New
prototypes.
[WITH_GUILE]: Remove.
(maidag_script_fun, struct maidag_script): New data type.
(script_handler): New extern.
(script_lang_handler, script_suffix_handler)
(script_register, script_apply): New protos.
(scheme_check_msg, sieve_check_msg): New protos.
* maidag/script.c: Rewrite. Provide general-purpose serialized script support.
* guimb/guimb.h (struct guimb_data): Remove.
* guimb/main.c: Rewrite in a cleaner way, using functions from mu_guile.c.
* guimb/collect.c (guimb_catch_body, guimb_catch_handler)
(guimb_exit): Remove.
* guimb/scm/sieve-core.scm (sieve-current-message, sieve-mailbox): Public.
(sieve-run-current-message): New public function.
(sieve-run): Call sieve-run-current-message for each message.
* guimb/scm/sieve.scm.in (sieve-save-program): Change code generation to
suit both per-mailbox and per-message invocation. This kicks mail.local
out of whack.
* maidag/guile.c: New file.
* maidag/sieve.c: New file.
Diffstat (limited to 'guimb/scm')
-rw-r--r-- | guimb/scm/sieve-core.scm | 17 | ||||
-rw-r--r-- | guimb/scm/sieve.scm.in | 83 |
2 files changed, 59 insertions, 41 deletions
diff --git a/guimb/scm/sieve-core.scm b/guimb/scm/sieve-core.scm index 89a0872d6..c75cf3484 100644 --- a/guimb/scm/sieve-core.scm +++ b/guimb/scm/sieve-core.scm @@ -457,8 +457,15 @@ (lambda args #f))) ;;; Sieve-main -(define sieve-mailbox #f) -(define sieve-current-message #f) +(define-public sieve-mailbox #f) +(define-public sieve-current-message #f) + +(define-public (sieve-run-current-message thunk) + (and (catch 'sieve-stop + thunk + (lambda args + #f)) + (sieve-verbose-print "IMPLICIT KEEP"))) (define (sieve-run thunk) (if (not sieve-my-email) @@ -470,11 +477,7 @@ ((> n count) #f) (set! sieve-current-message (mu-mailbox-get-message sieve-mailbox n)) - (and (catch 'sieve-stop - thunk - (lambda args - #f)) - (sieve-verbose-print "IMPLICIT KEEP"))) + (sieve-run-current-message thunk)) (sieve-close-mailboxes))) (define (sieve-command-line) diff --git a/guimb/scm/sieve.scm.in b/guimb/scm/sieve.scm.in index 4a8672f3f..293dcf747 100644 --- a/guimb/scm/sieve.scm.in +++ b/guimb/scm/sieve.scm.in @@ -1,8 +1,9 @@ #! %GUILE_BINDIR%/guile -s -# Emacs, its -*- scheme -*- +# Emacs, it's -*- scheme -*- !# ;;;; GNU Mailutils -- a suite of utilities for electronic mail -;;;; Copyright (C) 1999, 2000, 2001, 2006, 2007 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2000, 2001, 2006, 2007, +;;;; 2009 Free Software Foundation, Inc. ;;;; ;;;; GNU Mailutils is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -931,39 +932,53 @@ outfile (lambda () (display "#! ") - (if guimb-header - (display "/home/gray/alpha/bin/guimb -s\n") - (display "/usr/bin/guile -s\n")) - (display (string-append - "# Guile mailbox parser made from " filename)) - (newline) - (display "# by sieve.scm, GNU %PACKAGE% %VERSION%\n!#") - (newline) - - (display - "(if (not (member \"%GUILE_SITE%\" %load-path))\n + (cond + (guimb-header + (display "/home/gray/alpha/bin/guimb -s\n")) + (else + (display "/bin/sh\n\ +# aside from this initial boilerplate, this is actually -*- scheme -*- code\n\ +exec ${GUILE-guile} -l $0 -c '(mailutils-main)'\n"))) + (display (string-append + "# This Guile mailbox parser was made from " filename)) + (newline) + (display "# by sieve.scm, GNU %PACKAGE% %VERSION%\n!#") + (newline) + + (display + "(if (not (member \"%GUILE_SITE%\" %load-path))\n (set! %load-path (cons \"%GUILE_SITE%\" %load-path)))\n") - - (display "(use-modules (mailutils sieve-core))\n") - (display (string-append - "(set! sieve-source \"" filename "\")")) - (newline) - - (for-each - (lambda (file) - (display (string-append - "(load \"" file "\")")) - (newline)) - sieve-load-files) - (newline) - (if request-verbose - (display "(set! sieve-verbose #t)\n")) - (display "(sieve-main ") - - (sieve-code-print-list - (append '(lambda ()) - sieve-code-list)) - (display ")")))) + + (display "(use-modules (mailutils sieve-core))\n") + (display (string-append + "(set! sieve-source \"" filename "\")")) + (newline) + + (for-each + (lambda (file) + (display (string-append + "(load \"" file "\")")) + (newline)) + sieve-load-files) + (newline) + (if request-verbose + (display "(set! sieve-verbose #t)\n")) + (display "(define (sieve-filter-thunk) ") + + (sieve-code-print-list (car sieve-code-list)) + (display ")\n\n") + + (display "(define (mailutils-main . rest)\n") + (display " (sieve-main sieve-filter-thunk))\n\n") + + (display "(define (mailutils-check-message msg)\n\ + (set! sieve-current-message msg)\n\ + (sieve-run-current-message sieve-filter-thunk))\n") + + (display "\n\ +;;;; Local Variables:\n\ +;;;; buffer-read-only: t\n\ +;;;; End:\n")))) ;;;; |