[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[SCM] GNU Mailutils branch, master, updated. release-2.2-341-geb838fe
|
From: |
Sergey Poznyakoff |
|
Subject: |
[SCM] GNU Mailutils branch, master, updated. release-2.2-341-geb838fe |
|
Date: |
Fri, 07 Jan 2011 22:45:22 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Mailutils".
http://git.savannah.gnu.org/cgit/mailutils.git/commit/?id=eb838fece8d5c38fb6fd4ea2b33d3982607acfff
The branch, master has been updated
via eb838fece8d5c38fb6fd4ea2b33d3982607acfff (commit)
via 273e66dcf41df1fc262629b85b4cde983681d6c4 (commit)
via 91022df9ce5b2ffafaf1b602f028922dc77e35e4 (commit)
from 284d8c5a28972234c51c8fa4a299e7f64b490d10 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit eb838fece8d5c38fb6fd4ea2b33d3982607acfff
Author: Sergey Poznyakoff <address@hidden>
Date: Fri Jan 7 17:48:09 2011 +0200
guimb: further improvements
* libmu_scm/mu_body.c (mu-body?): New function.
* libmu_scm/mu_mailbox.c (mu-mailbox?): New function.
* libmu_scm/mu_message.c (mu-message?): New function.
* libmu_scm/mu_mime.c (mu-mime?): New function.
* scheme/guimb.scmi (guimb-process-mailbox): guimb-message returns
a message to be appended to the output mailbox.
commit 273e66dcf41df1fc262629b85b4cde983681d6c4
Author: Sergey Poznyakoff <address@hidden>
Date: Fri Jan 7 14:43:04 2011 +0200
Reincarnate guimb as a pure Scheme program.
* libmu_scm/mailutils.scm.in: Move to libmu_scm/mailutils/mailutils.scm.in.
Use the MAILUTILS_SCM_LIBRARY_ROOT environment variable to load
libraries from the specified location (to be used in tests).
* libmu_scm/mailutils/.gitignore: New file.
* libmu_scm/mailutils/Makefile.am: New file.
* libmu_scm/Makefile.am (SUBDIRS): Add mailutils
(mailutils.scm): Remove goal and associated variables.
* scheme/guimb.scmi: New file. Reincarnation of guimb.
* scheme/Makefile.am: Build guimb from guimb.scmi.
* scheme/sieve2scm.scmi (sieve-version): Use mu-package
and mu-version global variables.
* configure.ac (AC_CONFIG_FILES): Add libmu_scm/mailutils/Makefile.
commit 91022df9ce5b2ffafaf1b602f028922dc77e35e4
Author: Sergey Poznyakoff <address@hidden>
Date: Thu Jan 6 17:01:10 2011 +0200
Minor changes in scheme-related code.
* libmu_scm/mu_scm.c (_mu_scm_bugreport, mu-bugreport): New variable.
(format_table): Add pops and imaps.
* scheme/reject.scm: Minor changes.
* scheme/sieve2scm.scmi: Minor changes.
-----------------------------------------------------------------------
Summary of changes:
configure.ac | 1 +
libmu_scm/Makefile.am | 16 +-
libmu_scm/mailutils/.gitignore | 1 +
{readmsg => libmu_scm/mailutils}/Makefile.am | 29 +--
libmu_scm/{ => mailutils}/mailutils.scm.in | 39 +++--
libmu_scm/mu_body.c | 9 +
libmu_scm/mu_mailbox.c | 9 +
libmu_scm/mu_message.c | 9 +
libmu_scm/mu_mime.c | 9 +
libmu_scm/mu_scm.c | 10 +-
scheme/Makefile.am | 28 ++-
scheme/guimb.scmi | 289 ++++++++++++++++++++++++++
scheme/reject.scm | 2 +-
scheme/sieve2scm.scmi | 3 +-
14 files changed, 396 insertions(+), 58 deletions(-)
create mode 100644 libmu_scm/mailutils/.gitignore
copy {readmsg => libmu_scm/mailutils}/Makefile.am (63%)
rename libmu_scm/{ => mailutils}/mailutils.scm.in (56%)
create mode 100644 scheme/guimb.scmi
diff --git a/configure.ac b/configure.ac
index 8650599..e03a4c3 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1364,6 +1364,7 @@ AC_CONFIG_FILES([
libmu_cfg/Makefile
libmu_cpp/Makefile
libmu_scm/Makefile
+ libmu_scm/mailutils/Makefile
libmu_sieve/Makefile
libmu_sieve/extensions/Makefile
libproto/Makefile
diff --git a/libmu_scm/Makefile.am b/libmu_scm/Makefile.am
index 0d3ff2f..b870486 100644
--- a/libmu_scm/Makefile.am
+++ b/libmu_scm/Makefile.am
@@ -15,6 +15,8 @@
## You should have received a copy of the GNU General Public License
## along with GNU Mailutils. If not, see <http://www.gnu.org/licenses/>.
+SUBDIRS = . mailutils
+
INCLUDES = -I. @MU_LIB_COMMON_INCLUDES@ @GUILE_INCLUDES@
lib_LTLIBRARIES=libmu_scm.la
@@ -48,8 +50,6 @@ libmu_scm_la_LIBADD = \
${MU_LIB_MAILUTILS}\
@GUILE_LIBS@
-EXTRA_DIST=mailutils.scm mailutils.scm.in
-
DOT_X_FILES=\
mu_address.x\
mu_body.x\
@@ -72,15 +72,9 @@ DOT_DOC_FILES=\
mu_scm.doc\
mu_util.doc
+EXTRA_DIST=
CLEANFILES=
-DISTCLEANFILES=\
- mailutils.scm
-
-mailutils.scm: mailutils.scm.in
- $(AM_V_GEN)m4 -DVERSION=$(VERSION) -DLIBDIR=$(libdir) \
- -DSITEDIR=$(sitedir) \
- -DBUILDDIR=$(top_builddir)/libmu_scm \
- $(srcdir)/mailutils.scm.in > $@
+DISTCLEANFILES=
install-data-hook:
@here=`pwd`; \
@@ -93,7 +87,7 @@ install-data-hook:
cd $$here
sitedir = @GUILE_SITE@/$(PACKAGE)
-site_DATA = mailutils.scm
+site_DATA =
SUFFIXES=
BUILT_SOURCES=
include ../gint/gint.mk
diff --git a/libmu_scm/mailutils/.gitignore b/libmu_scm/mailutils/.gitignore
new file mode 100644
index 0000000..a3d6ed8
--- /dev/null
+++ b/libmu_scm/mailutils/.gitignore
@@ -0,0 +1 @@
+mailutils.scm
diff --git a/readmsg/Makefile.am b/libmu_scm/mailutils/Makefile.am
similarity index 63%
copy from readmsg/Makefile.am
copy to libmu_scm/mailutils/Makefile.am
index 2d9f392..9e46149 100644
--- a/readmsg/Makefile.am
+++ b/libmu_scm/mailutils/Makefile.am
@@ -1,5 +1,5 @@
## This file is part of GNU Mailutils.
-## Copyright (C) 2001, 2002, 2003, 2004, 2007, 2010, 2011 Free Software
+## Copyright (C) 2001, 2002, 2006, 2007, 2009, 2010, 2011 Free Software
## Foundation, Inc.
##
## GNU Mailutils is free software; you can redistribute it and/or
@@ -15,22 +15,17 @@
## You should have received a copy of the GNU General Public License
## along with GNU Mailutils. If not, see <http://www.gnu.org/licenses/>.
-INCLUDES = @MU_APP_COMMON_INCLUDES@
+EXTRA_DIST=mailutils.scm mailutils.scm.in
-SUBDIRS = . tests
+DISTCLEANFILES=\
+ mailutils.scm
-bin_PROGRAMS = readmsg
-readmsg_SOURCES = readmsg.c msglist.c readmsg.h
+sitedir = @GUILE_SITE@/$(PACKAGE)
+site_DATA = mailutils.scm
+
+mailutils.scm: mailutils.scm.in
+ $(AM_V_GEN)m4 -DVERSION=$(VERSION) -DLIBDIR=$(libdir) \
+ -DSITEDIR=$(sitedir) \
+ -DBUILDDIR=$(top_builddir)/libmu_scm \
+ $(srcdir)/mailutils.scm.in > $@
-readmsg_LDADD =\
- ${MU_APP_LIBRARIES}\
- ${MU_LIB_MBOX}\
- ${MU_LIB_IMAP}\
- ${MU_LIB_POP}\
- ${MU_LIB_NNTP}\
- ${MU_LIB_MH}\
- ${MU_LIB_MAILDIR}\
- ${MU_LIB_AUTH}\
- @address@hidden
- ${MU_LIB_MAILUTILS}\
- @MU_COMMON_LIBRARIES@
diff --git a/libmu_scm/mailutils.scm.in b/libmu_scm/mailutils/mailutils.scm.in
similarity index 56%
rename from libmu_scm/mailutils.scm.in
rename to libmu_scm/mailutils/mailutils.scm.in
index 3ee5bc7..6e955ed 100644
--- a/libmu_scm/mailutils.scm.in
+++ b/libmu_scm/mailutils/mailutils.scm.in
@@ -24,20 +24,31 @@ changequote([,])dnl
(set! documentation-files (append documentation-files
(list "SITEDIR/guile-procedures.txt")))
-(define mu-libs (list "libmailutils"
- "libmu_auth"
- "libmu_mbox"
- "libmu_mh"
- "libmu_maildir"
- "libmu_pop"
- "libmu_imap"))
+(define mu-libs (list (cons "libmailutils" "libmailutils")
+ (cons "libmu_auth" "libmu_auth")
+ (cons "libproto/mbox" "libmu_mbox")
+ (cons "libproto/mh" "libmu_mh")
+ (cons "libproto/maildir" "libmu_maildir")
+ (cons "libproto/pop" "libmu_pop")
+ (cons "libproto/imap" "libmu_imap")))
-(let ((lib-path "LIBDIR/"))
- (for-each
- (lambda (lib)
- (dynamic-link (string-append lib-path lib)))
- mu-libs)
- (load-extension (string-append
- lib-path "libguile-mailutils-v-VERSION") "mu_scm_init"))
+(cond
+ ((getenv "MAILUTILS_SCM_LIBRARY_ROOT") =>
+ (lambda (root)
+ (for-each
+ (lambda (lib)
+ (dynamic-link (string-append root "/" (car lib) "/" (cdr lib))))
+ mu-libs)
+ (load-extension (string-append root "/libmu_scm/libmu_scm")
+ "mu_scm_init")))
+ (else
+ (let ((lib-path "LIBDIR/"))
+ (for-each
+ (lambda (lib)
+ (dynamic-link (string-append lib-path (cdr lib))))
+ mu-libs)
+ (load-extension (string-append
+ lib-path "libguile-mailutils-v-VERSION")
+ "mu_scm_init"))))
;;;; End of mailutils.scm
diff --git a/libmu_scm/mu_body.c b/libmu_scm/mu_body.c
index 007040b..8dbe42c 100644
--- a/libmu_scm/mu_body.c
+++ b/libmu_scm/mu_body.c
@@ -95,6 +95,15 @@ mu_scm_body_create (SCM msg, mu_body_t body)
/* ************************************************************************* */
/* Guile primitives */
+SCM_DEFINE_PUBLIC (scm_mu_body_p, "mu-body?", 1, 0, 0,
+ (SCM scm),
+"Return @code{true} if @var{scm} is a Mailutils message body object.\n")
+#define FUNC_NAME s_scm_mu_body_p
+{
+ return mu_scm_is_body (scm);
+}
+#undef FUNC_NAME
+
SCM_DEFINE_PUBLIC (scm_mu_body_read_line, "mu-body-read-line", 1, 0, 0,
(SCM body),
"Read next line from the @var{body}.")
diff --git a/libmu_scm/mu_mailbox.c b/libmu_scm/mu_mailbox.c
index 7703216..df1aa47 100644
--- a/libmu_scm/mu_mailbox.c
+++ b/libmu_scm/mu_mailbox.c
@@ -136,6 +136,15 @@ mu_scm_is_mailbox (SCM scm)
/* ************************************************************************* */
/* Guile primitives */
+SCM_DEFINE_PUBLIC (scm_mu_mailbox_p, "mu-mailbox?", 1, 0, 0,
+ (SCM scm),
+"Return @code{true} if @var{scm} is a Mailutils mailbox.\n")
+#define FUNC_NAME s_scm_mu_mailbox_p
+{
+ return scm_from_bool (mu_scm_is_mailbox (scm));
+}
+#undef FUNC_NAME
+
SCM_DEFINE_PUBLIC (scm_mu_mail_directory, "mu-mail-directory", 0, 1, 0,
(SCM url),
"Do not use this function. Use mu-user-mailbox-url instead.")
diff --git a/libmu_scm/mu_message.c b/libmu_scm/mu_message.c
index 08bc1d1..4a99a8e 100644
--- a/libmu_scm/mu_message.c
+++ b/libmu_scm/mu_message.c
@@ -175,6 +175,15 @@ mu_scm_is_message (SCM scm)
/* ************************************************************************* */
/* Guile primitives */
+SCM_DEFINE_PUBLIC (scm_mu_message_p, "mu-message?", 1, 0, 0,
+ (SCM scm),
+"Return @code{true} if @var{scm} is a Mailutils message.\n")
+#define FUNC_NAME s_scm_mu_message_p
+{
+ return scm_from_bool (mu_scm_is_message (scm));
+}
+#undef FUNC_NAME
+
SCM_DEFINE_PUBLIC (scm_mu_message_create, "mu-message-create", 0, 0, 0,
(),
"Creates an empty message.\n")
diff --git a/libmu_scm/mu_mime.c b/libmu_scm/mu_mime.c
index aefc455..1d29498 100644
--- a/libmu_scm/mu_mime.c
+++ b/libmu_scm/mu_mime.c
@@ -88,6 +88,15 @@ mu_scm_is_mime (SCM scm)
/* ************************************************************************* */
/* Guile primitives */
+SCM_DEFINE_PUBLIC (scm_mu_mime_p, "mu-mime?", 1, 0, 0,
+ (SCM scm),
+"Return @code{true} if @var{scm} is a Mailutils MIME object.\n")
+#define FUNC_NAME s_scm_mu_mime_p
+{
+ return scm_from_bool (mu_scm_is_mime (scm));
+}
+#undef FUNC_NAME
+
SCM_DEFINE_PUBLIC (scm_mu_mime_create, "mu-mime-create", 0, 2, 0,
(SCM flags, SCM mesg),
"Creates a new @acronym{MIME} object. Both arguments are optional.\n"
diff --git a/libmu_scm/mu_scm.c b/libmu_scm/mu_scm.c
index d9c4aee..9e43506 100644
--- a/libmu_scm/mu_scm.c
+++ b/libmu_scm/mu_scm.c
@@ -36,10 +36,12 @@ mu_scm_error (const char *func_name, int status,
SCM _mu_scm_package_string; /* STRING: PACKAGE_STRING */
SCM _mu_scm_package; /* STRING: PACKAGE */
SCM _mu_scm_version; /* STRING: VERSION */
+SCM _mu_scm_bugreport; /* STRING: PACKAGE_BUGREPORT */
SCM _mu_scm_mailer; /* STRING: Default mailer path. */
SCM _mu_scm_debug; /* NUM: Default debug level. */
-struct format_record {
+struct format_record
+{
char *name;
mu_record_t *record;
};
@@ -49,7 +51,9 @@ static struct format_record format_table[] = {
{ "mh", &mu_mh_record },
{ "maildir", &mu_maildir_record },
{ "pop", &mu_pop_record },
+ { "pops", &mu_pops_record },
{ "imap", &mu_imap_record },
+ { "imaps", &mu_imap_record },
{ "sendmail", &mu_sendmail_record },
{ "smtp", &mu_smtp_record },
{ NULL, NULL },
@@ -185,6 +189,10 @@ mu_scm_init ()
_mu_scm_package_string = scm_from_locale_string (PACKAGE_STRING);
scm_c_define ("mu-package-string", _mu_scm_package_string);
scm_c_export ("mu-package-string", NULL);
+
+ _mu_scm_bugreport = scm_from_locale_string (PACKAGE_BUGREPORT);
+ scm_c_define ("mu-bugreport", _mu_scm_bugreport);
+ scm_c_export ("mu-bugreport", NULL);
/* Create MU- attribute names */
for (i = 0; attr_kw[i].name; i++)
diff --git a/scheme/Makefile.am b/scheme/Makefile.am
index c0e0023..c146dfb 100644
--- a/scheme/Makefile.am
+++ b/scheme/Makefile.am
@@ -15,8 +15,8 @@
## You should have received a copy of the GNU General Public License
## along with GNU Mailutils. If not, see <http://www.gnu.org/licenses/>.
-bin_SCRIPTS = sieve2scm
-EXTRA_SCRIPTS=sieve2scm
+bin_SCRIPTS = sieve2scm guimb
+
# FIXME: Sieve2scm is temporarly exempted from installchecks because
# it may fail starting during checks, if libguile-mailutils-v- library
# has not been previously installed. The proper fix would be to alter
@@ -25,19 +25,23 @@ AM_INSTALLCHECK_STD_OPTIONS_EXEMPT=sieve2scm
address@hidden@
-sieve2scm: sieve2scm.scmi sieve.sed
- $(AM_V_GEN)sed -f sieve.sed $(srcdir)/sieve2scm.scmi > sieve2scm
+sieve2scm: sieve2scm.scmi package.sed
+ $(AM_V_GEN)sed -f package.sed $(srcdir)/sieve2scm.scmi > sieve2scm
$(AM_V_at)chmod +w sieve2scm
-sieve.sed: Makefile
- $(AM_V_GEN)echo 's,%GUILE_BINDIR%,@GUILE_BINDIR@,g' > sieve.sed
- $(AM_V_at)echo 's,%BINDIR%,$(bindir),g' >> sieve.sed
- $(AM_V_at)echo 's,%GUILE_SITE%,$(GUILE_SITE),g' >> sieve.sed
- $(AM_V_at)echo 's,%LIBDIR%,$(sievemoddir),g' >> sieve.sed
- $(AM_V_at)echo 's,%PACKAGE%,$(PACKAGE),g' >> sieve.sed
- $(AM_V_at)echo 's,%VERSION%,$(VERSION),g' >> sieve.sed
+guimb: guimb.scmi package.sed
+ $(AM_V_GEN)sed -f package.sed $(srcdir)/guimb.scmi > guimb
+ $(AM_V_at)chmod +w guimb
+
+package.sed: Makefile
+ $(AM_V_GEN)echo 's,%GUILE_BINDIR%,@GUILE_BINDIR@,g' > package.sed
+ $(AM_V_at)echo 's,%BINDIR%,$(bindir),g' >> package.sed
+ $(AM_V_at)echo 's,%GUILE_SITE%,$(GUILE_SITE),g' >> package.sed
+ $(AM_V_at)echo 's,%LIBDIR%,$(sievemoddir),g' >> package.sed
+ $(AM_V_at)echo 's,%PACKAGE%,$(PACKAGE),g' >> package.sed
+ $(AM_V_at)echo 's,%VERSION%,$(VERSION),g' >> package.sed
-CLEANFILES = sieve2scm sieve.sed
+CLEANFILES = sieve2scm guimb package.sed
address@hidden@/$(PACKAGE)
site_DATA=sieve-core.scm
diff --git a/scheme/guimb.scmi b/scheme/guimb.scmi
new file mode 100644
index 0000000..dfee888
--- /dev/null
+++ b/scheme/guimb.scmi
@@ -0,0 +1,289 @@
+#! /bin/sh
+# aside from this initial boilerplate, this is actually -*- scheme -*- code
+main='(module-ref (resolve-module '\''(scheme guimb)) '\'main')'
+exec ${GUILE-guile} -l $0 -c "(apply $main (list (command-line)))" "$@"
+!#
+;;;; GNU Mailutils -- a suite of utilities for electronic mail
+;;;; Copyright (C) 1999, 2000, 2001, 2006, 2007, 2009, 2010, 2011 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
+;;;; the Free Software Foundation; either version 3, or (at your option)
+;;;; any later version.
+;;;;
+;;;; GNU Mailutils is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License along
+;;;; with GNU Mailutils. If not, see <http://www.gnu.org/licenses/>.
+;;;;
+(if (not (member "%GUILE_SITE%" %load-path))
+ (set! %load-path (cons "%GUILE_SITE%" %load-path)))
+(define-module (scheme guimb)
+ :export (guimb))
+
+(use-modules (ice-9 getopt-long)
+ (ice-9 rdelim)
+ (srfi srfi-1)
+ (mailutils mailutils))
+
+(define program-name "guimb")
+(define output-mailbox-name #f)
+(define output-mailbox-mode #f)
+(define source-file-name #f)
+(define source-expression #f)
+(define user-name #f)
+(define input-mailbox-names '())
+(define script-arguments '())
+
+(define output-mailbox #f)
+
+(define (guimb-version)
+ (format #t "guimb (~A) ~A~%" mu-package mu-version)
+ (exit 0))
+
+(define (guimb-help)
+ (format #t "usage: guimb [OPTIONS] [MAILBOX [MAILBOX...]]
+guimb applies a scheme function to each message from a set of input mailboxes
+
+The following options stop argument processing, and pass the remaining
+arguments to the guimb-getopt function, if it is defined in the module:
+
+ -c, --code=EXPR execute given Scheme expression
+ -s, --source=MODNAME load Scheme module MODNAME
+
+The following options have the same effect, but do not affect further
+options parsing:
+
+ -e, --expression=EXPR execute given Scheme expression
+ -f, --file=MODNAME load Scheme module MODNAME
+
+The module to be loaded is normally defined in a file named MODNAME.scm
+somewhere in your %load-path.
+
+Other options:
+
+ -M, --mailbox=NAME set output mailbox name
+ -u, --user[=NAME] direct output to the system mailbox of the
+ user NAME (default - current user)
+ -r, --read-only open mailbox in read-only mode
+
+Script arguments:
+
+ -g, --guile-arg=ARG append ARG to the command line passed to script
+ -{ args... -} append args to the command line passed to script
+ --lparen args... --rparen likewise
+
+ -L, --load-path=PATH append PATH to the beginning of the %load-path
+
+ -?, --help give this help list
+ --usage give a short usage message
+ -V, --version print program version
+
+Mandatory or optional arguments to long options are also mandatory or optional
+for any corresponding short options.
+
+")
+ (format #t "Report bugs to <~A>.~%" mu-bugreport)
+ (exit 0))
+
+(define (guimb-usage)
+ ; FIXME
+ (guimb-help))
+
+(define (error fmt . rest)
+ (with-output-to-port
+ (current-error-port)
+ (lambda ()
+ (format #t "~A: " program-name)
+ (apply format #t fmt rest)
+ (newline))))
+
+(define (extract-args arglist)
+ (let ((level 0))
+ (let ((result (filter
+ (lambda (x)
+ (cond
+ ((or (string=? x "--lparen")
+ (string=? x "-{"))
+ (set! level (+ level 1))
+ #f)
+ ((or (string=? x "--rparen")
+ (string=? x "-}"))
+ (if (> level 0)
+ (set! level (- level 1))
+ (set! script-arguments (append script-arguments
+ (list x))))
+ #f)
+ ((> level 0)
+ (set! script-arguments (append script-arguments
+ (list x)))
+ #f)
+ (else
+ #t)))
+ arglist)))
+ (if (> level 0)
+ (error "missing closing -}"))
+ result)))
+
+(define (parse-cmdline cmdline)
+ (let ((grammar `((source (single-char #\s)
+ (value #t))
+ (code (single-char #\c)
+ (value #t))
+ (file (single-char #\f)
+ (value #t))
+ (expression (single-char #\e)
+ (value #t))
+ (mailbox (single-char #\M)
+ (value #t))
+ (user (single-char #\u)
+ (value optional))
+ (read-only (single-char #\r))
+ (guile-arg (single-char #\g)
+ (value #t))
+ (load-path (single-char #\L)
+ (value #t))
+ (help (single-char #\?))
+ (usage)
+ (version (single-char #\V)))))
+ (do ((arglist (getopt-long (extract-args (command-line)) grammar)
+ (cdr arglist)))
+ ((null? arglist))
+ (let ((x (car arglist)))
+ (case (car x)
+ ((mailbox)
+ (set! output-mailbox-name (cdr x)))
+ ((source file)
+ (set! source-file-name (cdr x)))
+ ((code expression)
+ (set! source-expression (cdr x)))
+ ((load-path)
+ (set! %load-path (append
+ (string-split (cdr x) #\:)
+ %load-path)))
+ ((user)
+ (set! user-name (cdr x)))
+ ((guile-arg)
+ (set! script-arguments (append script-arguments (list (cdr x)))))
+ ((version)
+ (guimb-version))
+ ((help)
+ (guimb-help))
+ ((usage)
+ (guimb-usage))
+ ((read-only)
+ (set! output-mailbox-mode "r"))
+ ('()
+ (if (not (null? (cdr x)))
+ (set! input-mailbox-names (append input-mailbox-names
+ (cdr x))))))))))
+
+(define guimb-module #f)
+
+(define (get-module)
+ (if (not guimb-module)
+ (set! guimb-module (resolve-module '(scheme guimb))))
+ guimb-module)
+
+(define-macro (bound? name)
+ `(and (module-defined? guimb-module ',name)
+ (procedure? ,name)))
+
+(define (guimb-parse-command-line cmdline)
+ (let ((script-args '())
+ (argtail (find-tail
+ (lambda (x)
+ (or (string=? x "-c")
+ (string=? x "--code")
+ (string=? x "-s")
+ (string=? x "--source")
+ (string-prefix? "--code=" x)
+ (string-prefix? "--source=" x)))
+ cmdline)))
+ (cond
+ (argtail
+ (if (let ((x (car argtail)))
+ (not (or (string-prefix? "--code=" x)
+ (string-prefix? "--source=" x))))
+ (set! argtail (cdr argtail)))
+ (cond ((not (null? argtail))
+ (set! script-args (cdr argtail))
+ (set-cdr! argtail '())))))
+ (parse-cmdline cmdline)
+ (set! script-arguments (append script-arguments script-args))
+
+ (if (not output-mailbox-mode)
+ (set! output-mailbox-mode (if (null? input-mailbox-names) "wr" "a")))
+
+ (cond
+ (user-name
+ (set! output-mailbox
+ (mu-mailbox-open
+ (if (string? user-name)
+ (string-append "%" user-name)
+ "")
+ output-mailbox-mode)))
+ (output-mailbox-name
+ (set! output-mailbox (mu-mailbox-open output-mailbox-name
+ output-mailbox-mode))))
+; (write output-mailbox)(newline)
+
+ (if source-file-name
+ (module-use!
+ (get-module)
+ (resolve-interface (list (string->symbol source-file-name)))))
+ (if source-expression
+ (eval-string source-expression))
+
+ (if (bound? guimb-getopt)
+ (guimb-getopt script-arguments)) ))
+
+(define (guimb-single-mailbox mbox)
+ (let msg-loop ((msg (mu-mailbox-first-message mbox)))
+ (if (not (eof-object? msg))
+ (begin
+ (guimb-message msg)
+ (msg-loop (mu-mailbox-next-message mbox))))))
+
+(define (guimb-process-mailbox mbox)
+ (if (not output-mailbox)
+ (guimb-single-mailbox mbox)
+ (let msg-loop ((msg (mu-mailbox-first-message mbox)))
+ (if (not (eof-object? msg))
+ (let ((x (guimb-message msg)))
+ (if (mu-message? x)
+ (mu-mailbox-append-message output-mailbox x))
+ (msg-loop (mu-mailbox-next-message mbox)))))))
+
+(define (guimb cmdline)
+ (mu-register-format)
+ (guimb-parse-command-line cmdline)
+ (if (null? input-mailbox-names)
+ (guimb-single-mailbox output-mailbox)
+ (for-each
+ (lambda (mbox-name)
+ (let ((current-mailbox (mu-mailbox-open mbox-name "r")))
+ (guimb-process-mailbox current-mailbox)))
+ input-mailbox-names))
+ (if (bound? guimb-end)
+ (guimb-end)))
+
+(debug-enable 'debug)
+(debug-options '(show-file-name #t
+ stack 20000
+ debug
+ backtrace
+ depth 20
+ maxdepth 1000
+ frames 3
+ indent 10
+ width 79
+ procnames))
+
+(define main guimb)
+
+;;;; End of guimb
diff --git a/scheme/reject.scm b/scheme/reject.scm
index a418d4b..117031f 100644
--- a/scheme/reject.scm
+++ b/scheme/reject.scm
@@ -50,7 +50,7 @@
(port (mu-message-get-port mesg "w")))
(mu-message-set-header mesg "Content-Type" "message/delivery-status")
- (display (string-append "Reporting-UA: sieve; GNU "
+ (display (string-append "Reporting-UA: sieve; "
mu-package-string "\n") port)
(display (string-append "Arrival-Date: " datestr "\n") port)
(newline port)
diff --git a/scheme/sieve2scm.scmi b/scheme/sieve2scm.scmi
index 5c9cf49..6d2c85d 100644
--- a/scheme/sieve2scm.scmi
+++ b/scheme/sieve2scm.scmi
@@ -995,8 +995,7 @@ exec ${GUILE-guile} -l $0 -c '(mailutils-main)'\n")
(exit 0))
(define (sieve-version)
- (display "sieve.scm (GNU %PACKAGE% %VERSION%)")
- (newline)
+ (format #t "sieve2scm (~A) ~A~%" mu-package mu-version)
(exit 0))
;;; Parse command line
hooks/post-receive
--
GNU Mailutils
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [SCM] GNU Mailutils branch, master, updated. release-2.2-341-geb838fe,
Sergey Poznyakoff <=