source: project/release/4/vandusen/trunk/vandusen-pager.scm @ 21508

Last change on this file since 21508 was 21376, checked in by Moritz Heidkamp, 10 years ago

vandusen: apply pager patch by Christian Kellermann and bump version to 0.6

File size: 1.8 KB
Line 
1(module vandusen-pager ()
2
3(import chicken scheme extras  data-structures srfi-1 posix)
4(use vandusen irc)
5
6(plugin 'pager
7        (lambda ()
8          (define tasks '())
9
10          (define (add-task! from nick text)
11            (let ((msg (list (seconds->string (current-seconds)) from text)))
12              (cond ((alist-ref nick tasks equal?) => (lambda (k) (set! tasks (alist-update! nick (cons msg k) tasks equal?))))
13                    (else (set! tasks (alist-cons nick (cons msg '()) tasks))))))
14
15          (command 'tell
16                   '(: "tell" (+ space) (submatch (+ (~ (or space #\, #\:)))) (or #\, #\:) (* space) (submatch (+ any)))
17                   (lambda (master nick msg)
18                     (add-task! (irc:message-sender master) nick msg)
19                     (reply-to master (format "I will tell ~a when he/she speaks again." nick)))
20                   public: #t)
21
22          (command 'list-messages
23                   '(: "messages" (* any))
24                   (lambda (m . rest)
25                     (reply-to m (format "I am holding ~a messages in my head:~%~A" (length tasks) tasks))))
26
27          (message-handler (lambda (m)
28                             (cond ((alist-ref (irc:message-sender m) tasks equal?) =>
29                                    (lambda (msgs)
30                                      (for-each (lambda (msg)
31                                                  (whisper-to (irc:message-sender m)
32                                                              (conc (first msg) " " (second msg) ": " (third  msg))))
33                                                msgs)
34                                      (set! tasks (alist-delete (irc:message-sender m) tasks equal?)))))
35                             #f)
36                           command: "PRIVMSG"))))
Note: See TracBrowser for help on using the repository browser.