diff options
Diffstat (limited to 'guimb')
-rw-r--r-- | guimb/collect.c | 30 | ||||
-rw-r--r-- | guimb/guimb.h | 11 | ||||
-rw-r--r-- | guimb/main.c | 68 | ||||
-rw-r--r-- | guimb/scm/sieve-core.scm | 17 | ||||
-rw-r--r-- | guimb/scm/sieve.scm.in | 83 |
5 files changed, 101 insertions, 108 deletions
diff --git a/guimb/collect.c b/guimb/collect.c index d4f78f988..8839d98a3 100644 --- a/guimb/collect.c +++ b/guimb/collect.c @@ -1,6 +1,6 @@ /* GNU Mailutils -- a suite of utilities for electronic mail Copyright (C) 1999, 2000, 2001, 2002, 2005, - 2007 Free Software Foundation, Inc. + 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 @@ -191,31 +191,3 @@ collect_drop_mailbox () } } -SCM -guimb_catch_body (void *data, mu_mailbox_t unused) -{ - struct guimb_data *gd = data; - if (gd->program_file) - scm_primitive_load (scm_makfrom0str (gd->program_file)); - - if (gd->program_expr) - scm_c_eval_string (gd->program_expr); - - return SCM_BOOL_F; -} - -SCM -guimb_catch_handler (void *unused, SCM tag, SCM throw_args) -{ - collect_drop_mailbox (); - return scm_handle_by_message ("guimb", tag, throw_args); -} - -int -guimb_exit (void *unused1, mu_mailbox_t unused2) -{ - int rc = collect_output (); - collect_drop_mailbox (); - return rc; -} - diff --git a/guimb/guimb.h b/guimb/guimb.h index 95df1417d..166f86cdc 100644 --- a/guimb/guimb.h +++ b/guimb/guimb.h @@ -1,6 +1,6 @@ /* GNU Mailutils -- a suite of utilities for electronic mail Copyright (C) 1999, 2000, 2001, 2002, 2005, - 2007 Free Software Foundation, Inc. + 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 @@ -67,12 +67,3 @@ int collect_output (void); void util_error (const char *fmt, ...) MU_PRINTFLIKE(1, 2); int util_tempfile (char **namep); -struct guimb_data -{ - char *program_file; - char *program_expr; -}; - -SCM guimb_catch_body (void *data, mu_mailbox_t unused); -SCM guimb_catch_handler (void *unused, SCM tag, SCM throw_args); -int guimb_exit (void *unused1, mu_mailbox_t unused2); diff --git a/guimb/main.c b/guimb/main.c index 64c548b1a..6a294720c 100644 --- a/guimb/main.c +++ b/guimb/main.c @@ -145,19 +145,21 @@ static const char *guimb_argp_capa[] = { "license", NULL }; - + +const char *main_sym = "mailutils-main"; + int main (int argc, char *argv[]) { + int rc; int c = argc; int index; - mu_guimb_param_t param; - struct guimb_data gd; /* Native Language Support */ MU_APP_INIT_NLS (); - append_arg (""); + /* Register the desired formats. */ + mu_register_all_formats (); mu_argp_init (program_version, NULL); if (mu_app_init (&argp, guimb_argp_capa, NULL, argc, argv, 0, &index, &c)) @@ -169,17 +171,12 @@ main (int argc, char *argv[]) if (!user_name) user_name = who_am_i (); - if (program_file) - g_argv[0] = program_file; - else if (!program_expr) + if (!program_file && !program_expr) { mu_error (_("At least one of -fecs must be used. Try guimb --help for more info.")); - exit (0); + exit (1); } - /* Register the desired formats. */ - mu_register_all_formats (); - if (!argv[index]) { if (default_mailbox) @@ -202,27 +199,42 @@ main (int argc, char *argv[]) collect_append_file ("-"); } - append_arg (NULL); - g_argc--; - /* Finish creating input mailbox */ collect_create_mailbox (); - gd.program_file = program_file; - gd.program_expr = program_expr; + mu_guile_init (debug_guile); + if (program_file) + mu_guile_load (program_file, g_argc, g_argv); + if (program_expr) + mu_guile_eval (program_expr); + + rc = mu_guile_mailbox_apply (mbox, main_sym); + switch (rc) + { + case 0: + collect_output (); + break; + + case MU_ERR_NOENT: + mu_error (_("%s not defined"), main_sym); + break; + + case EINVAL: + mu_error (_("%s is not a procedure object"), main_sym); + break; + + case MU_ERR_FAILURE: + mu_error (_("execution of %s failed"), main_sym); + break; + + default: + mu_error (_("unrecognized error")); + break; + } + + collect_drop_mailbox (); - param.debug_guile = debug_guile; - param.mbox = mbox; - param.user_name = user_name; - param.init = NULL; - param.catch_body = guimb_catch_body; - param.catch_handler = guimb_catch_handler; - param.next = NULL; - param.exit = guimb_exit; - param.data = &gd; - mu_process_mailbox (g_argc, g_argv, ¶m); - /*NOTREACHED*/ - return 0; + return !!rc; } char * 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")))) ;;;; |