Skip to content
Toggle navigation
Toggle navigation
This project
Loading...
Sign in
John McEleney
/
mailutils
Go to a project
Toggle navigation
Toggle navigation pinning
Projects
Groups
Snippets
Help
Project
Activity
Repository
Pipelines
Graphs
Issues
0
Merge Requests
0
Wiki
Network
Create a new issue
Builds
Commits
Issue Boards
Files
Commits
Network
Compare
Branches
Tags
Commit
45d77f4b
...
45d77f4b4ddcc6b5c9350e1980788bdcdd7347ce
authored
2002-10-14 17:45:48 +0000
by
Sergey Poznyakoff
Browse Files
Options
Browse Files
Tag
Download
Email Patches
Plain Diff
Allow to be executed directly by guile
1 parent
0199d664
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
43 additions
and
3 deletions
guimb/scm/sieve-core.scm
guimb/scm/sieve-core.scm
View file @
45d77f4
...
...
@@ -397,18 +397,58 @@
(
if
(
isatty?
(
current-output-port
))
(
display
(
string-append
level
": "
msg
"\n"
)))))
(
define
(
guimb?
)
(
catch
#t
(
lambda
()
(
let
((
v
current-mailbox
))
v
))
(
lambda
args
#f
)))
;;; Sieve-main
(
define
sieve-mailbox
#f
)
(
define
sieve-current-message
#f
)
(
define
(
sieve-main
)
(
define
(
sieve-run
)
(
if
(
not
sieve-my-email
)
(
set!
sieve-my-email
(
mu-username->email
)))
(
let
((
count
(
mu-mailbox-messages-count
current-mailbox
)))
; (DEBUG 1 "Mailbox: " sieve-mailbox)
(
let
((
count
(
mu-mailbox-messages-count
sieve-mailbox
)))
(
do
((
n
1
(
1+
n
)))
((
>
n
count
)
#f
)
(
set!
sieve-current-message
(
mu-mailbox-get-message
current
-mailbox
n
))
(
mu-mailbox-get-message
sieve
-mailbox
n
))
(
catch
'sieve-stop
sieve-process-message
(
lambda
args
#f
)))
(
sieve-close-mailboxes
)))
(
define
(
sieve-command-line
)
(
catch
#t
(
lambda
()
(
let
((
args
sieve-script-args
))
(
append
(
list
"<temp-file>"
)
args
)))
(
lambda
args
(
command-line
))))
(
define
(
sieve-main
)
(
cond
((
not
(
guimb?
))
; (DEBUG 1 "Loading mailutils")
(
set!
%load-path
(
append
%load-path
(
list
sieve-libdir
)))
(
use-modules
(
mailutils
))
(
let*
((
cl
(
sieve-command-line
))
(
name
(
if
(
and
(
not
(
null?
(
cdr
cl
)))
(
string?
(
cadr
cl
)))
(
cadr
cl
)
(
string-append
mu-path-maildir
"/"
(
passwd:name
(
mu-getpwuid
(
getuid
)))))))
; (DEBUG 2 "mailbox name " name)
(
set!
sieve-mailbox
(
mu-mailbox-open
name
"rw"
))
(
sieve-run
)
(
mu-mailbox-expunge
sieve-mailbox
)
(
mu-mailbox-close
sieve-mailbox
)))
(
else
; (DEBUG 1 "Using current-mailbox")
(
set!
sieve-mailbox
current-mailbox
)
(
sieve-run
))))
...
...
Please
register
or
sign in
to post a comment