summaryrefslogtreecommitdiff
path: root/guimb
diff options
context:
space:
mode:
Diffstat (limited to 'guimb')
-rw-r--r--guimb/collect.c30
-rw-r--r--guimb/guimb.h11
-rw-r--r--guimb/main.c68
-rw-r--r--guimb/scm/sieve-core.scm17
-rw-r--r--guimb/scm/sieve.scm.in83
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, &param);
- /*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"))))
;;;;

Return to:

Send suggestions and report system problems to the System administrator.