Commit eb838fec eb838fece8d5c38fb6fd4ea2b33d3982607acfff by Sergey Poznyakoff

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.
1 parent 273e66dc
...@@ -95,6 +95,15 @@ mu_scm_body_create (SCM msg, mu_body_t body) ...@@ -95,6 +95,15 @@ mu_scm_body_create (SCM msg, mu_body_t body)
95 /* ************************************************************************* */ 95 /* ************************************************************************* */
96 /* Guile primitives */ 96 /* Guile primitives */
97 97
98 SCM_DEFINE_PUBLIC (scm_mu_body_p, "mu-body?", 1, 0, 0,
99 (SCM scm),
100 "Return @code{true} if @var{scm} is a Mailutils message body object.\n")
101 #define FUNC_NAME s_scm_mu_body_p
102 {
103 return mu_scm_is_body (scm);
104 }
105 #undef FUNC_NAME
106
98 SCM_DEFINE_PUBLIC (scm_mu_body_read_line, "mu-body-read-line", 1, 0, 0, 107 SCM_DEFINE_PUBLIC (scm_mu_body_read_line, "mu-body-read-line", 1, 0, 0,
99 (SCM body), 108 (SCM body),
100 "Read next line from the @var{body}.") 109 "Read next line from the @var{body}.")
......
...@@ -136,6 +136,15 @@ mu_scm_is_mailbox (SCM scm) ...@@ -136,6 +136,15 @@ mu_scm_is_mailbox (SCM scm)
136 /* ************************************************************************* */ 136 /* ************************************************************************* */
137 /* Guile primitives */ 137 /* Guile primitives */
138 138
139 SCM_DEFINE_PUBLIC (scm_mu_mailbox_p, "mu-mailbox?", 1, 0, 0,
140 (SCM scm),
141 "Return @code{true} if @var{scm} is a Mailutils mailbox.\n")
142 #define FUNC_NAME s_scm_mu_mailbox_p
143 {
144 return scm_from_bool (mu_scm_is_mailbox (scm));
145 }
146 #undef FUNC_NAME
147
139 SCM_DEFINE_PUBLIC (scm_mu_mail_directory, "mu-mail-directory", 0, 1, 0, 148 SCM_DEFINE_PUBLIC (scm_mu_mail_directory, "mu-mail-directory", 0, 1, 0,
140 (SCM url), 149 (SCM url),
141 "Do not use this function. Use mu-user-mailbox-url instead.") 150 "Do not use this function. Use mu-user-mailbox-url instead.")
......
...@@ -175,6 +175,15 @@ mu_scm_is_message (SCM scm) ...@@ -175,6 +175,15 @@ mu_scm_is_message (SCM scm)
175 /* ************************************************************************* */ 175 /* ************************************************************************* */
176 /* Guile primitives */ 176 /* Guile primitives */
177 177
178 SCM_DEFINE_PUBLIC (scm_mu_message_p, "mu-message?", 1, 0, 0,
179 (SCM scm),
180 "Return @code{true} if @var{scm} is a Mailutils message.\n")
181 #define FUNC_NAME s_scm_mu_message_p
182 {
183 return scm_from_bool (mu_scm_is_message (scm));
184 }
185 #undef FUNC_NAME
186
178 SCM_DEFINE_PUBLIC (scm_mu_message_create, "mu-message-create", 0, 0, 0, 187 SCM_DEFINE_PUBLIC (scm_mu_message_create, "mu-message-create", 0, 0, 0,
179 (), 188 (),
180 "Creates an empty message.\n") 189 "Creates an empty message.\n")
......
...@@ -88,6 +88,15 @@ mu_scm_is_mime (SCM scm) ...@@ -88,6 +88,15 @@ mu_scm_is_mime (SCM scm)
88 /* ************************************************************************* */ 88 /* ************************************************************************* */
89 /* Guile primitives */ 89 /* Guile primitives */
90 90
91 SCM_DEFINE_PUBLIC (scm_mu_mime_p, "mu-mime?", 1, 0, 0,
92 (SCM scm),
93 "Return @code{true} if @var{scm} is a Mailutils MIME object.\n")
94 #define FUNC_NAME s_scm_mu_mime_p
95 {
96 return scm_from_bool (mu_scm_is_mime (scm));
97 }
98 #undef FUNC_NAME
99
91 SCM_DEFINE_PUBLIC (scm_mu_mime_create, "mu-mime-create", 0, 2, 0, 100 SCM_DEFINE_PUBLIC (scm_mu_mime_create, "mu-mime-create", 0, 2, 0,
92 (SCM flags, SCM mesg), 101 (SCM flags, SCM mesg),
93 "Creates a new @acronym{MIME} object. Both arguments are optional.\n" 102 "Creates a new @acronym{MIME} object. Both arguments are optional.\n"
......
...@@ -49,22 +49,26 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (list (command-line)))" "$@" ...@@ -49,22 +49,26 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (list (command-line)))" "$@"
49 (format #t "usage: guimb [OPTIONS] [MAILBOX [MAILBOX...]] 49 (format #t "usage: guimb [OPTIONS] [MAILBOX [MAILBOX...]]
50 guimb applies a scheme function to each message from a set of input mailboxes 50 guimb applies a scheme function to each message from a set of input mailboxes
51 51
52 The following options stop argument processing, and pass all remaining 52 The following options stop argument processing, and pass the remaining
53 arguments as the value of (command-line): 53 arguments to the guimb-getopt function, if it is defined in the module:
54 54
55 -c, --code=EXPR execute given scheme expression 55 -c, --code=EXPR execute given Scheme expression
56 -s, --source=FILE load Scheme module from FILE.scm 56 -s, --source=MODNAME load Scheme module MODNAME
57 57
58 The following options do not affect further options parsing: 58 The following options have the same effect, but do not affect further
59 options parsing:
59 60
60 -e, --expression=EXPR execute given scheme expression 61 -e, --expression=EXPR execute given Scheme expression
61 -f, --file=FILE load Scheme module from FILE.scm 62 -f, --file=MODNAME load Scheme module MODNAME
63
64 The module to be loaded is normally defined in a file named MODNAME.scm
65 somewhere in your %load-path.
62 66
63 Other options: 67 Other options:
64 68
65 -M, --mailbox=NAME set output mailbox name 69 -M, --mailbox=NAME set output mailbox name
66 -u, --user[=NAME] act as local MDA for user NAME (default - current 70 -u, --user[=NAME] direct output to the system mailbox of the
67 user) 71 user NAME (default - current user)
68 -r, --read-only open mailbox in read-only mode 72 -r, --read-only open mailbox in read-only mode
69 73
70 Script arguments: 74 Script arguments:
...@@ -250,9 +254,9 @@ for any corresponding short options. ...@@ -250,9 +254,9 @@ for any corresponding short options.
250 (guimb-single-mailbox mbox) 254 (guimb-single-mailbox mbox)
251 (let msg-loop ((msg (mu-mailbox-first-message mbox))) 255 (let msg-loop ((msg (mu-mailbox-first-message mbox)))
252 (if (not (eof-object? msg)) 256 (if (not (eof-object? msg))
253 (begin 257 (let ((x (guimb-message msg)))
254 (if (guimb-message msg) 258 (if (mu-message? x)
255 (mu-mailbox-append-message output-mailbox msg)) 259 (mu-mailbox-append-message output-mailbox x))
256 (msg-loop (mu-mailbox-next-message mbox))))))) 260 (msg-loop (mu-mailbox-next-message mbox)))))))
257 261
258 (define (guimb cmdline) 262 (define (guimb cmdline)
......