blob: 30f9830db8f9241fb55dd9f12add497845f70c0b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
#lang racket/base
(require (for-syntax racket/base racket/list syntax/parse syntax/parse/lib/function-header)
irc/core irc/bot irc/users irc/storage racket/format racket/string racket/exn)
(provide define-command error-user)
(struct command-registration (signature help power action))
(define current-commands (make-parameter (make-hash)))
(define current-command-name (make-parameter #f))
(define (command-add signature action
#:help [help #f]
#:power [power 0]
#:min-interval [interv 0])
(hash-set! (current-commands)
(car signature) (command-registration signature help power action)))
(define (sufficient-power? nick wanted)
(or (= wanted 0)
(and (is-identified? nick)
(>= (user-power nick) wanted))))
(define (command-process)
(define s-exp (safe-read-string (string-join (cdr (params)))))
(when (pair? s-exp)
(parameterize ([current-command-name (car s-exp)])
(define command (hash-ref (current-commands) (current-command-name) #f))
(define required-power (command-registration-power command))
(when command
(if (sufficient-power? (source) required-power)
(begin
(log-irc-info "Executing ~a" (current-command-name))
(apply (command-registration-action command)
(cdr s-exp)))
(error-user "Insufficient power (~a required)" required-power))))))
(define (error-user . args)
(raise-user-error (current-command-name) (apply format args)))
(on (and (command-is 'PRIVMSG)
(not (source-is (current-nick)))
(not (ignored? (source))))
(with-handlers
([exn:fail:user? (λ (e) (privmsg (source) (exn->string e)))])
(command-process)))
(define-syntax (define-command stx)
(define-splicing-syntax-class single-keyword
(pattern (~seq kwname:keyword kwval:expr)))
(syntax-parse stx
[(_ fn:function-header
kw:single-keyword ...
action ...)
(with-syntax ([(kw ...)
(append* (map syntax->list (syntax->list #'(kw ...))))])
#'(command-add 'fn kw ... (lambda fn.args action ...)))]))
(define-command (list)
#:help "List all registered commands accessible to you"
(reply (~s
(for/list ([(k v) (current-commands)]
#:when (sufficient-power? (source) (command-registration-power v)))
(car (command-registration-signature v))))))
(define-command (help [command #f])
#:help "Display command argument names and description"
(if command
(let ([c (hash-ref (current-commands) command #f)])
(if c
(let* ([cr (command-registration-signature c)]
[help (command-registration-help c)])
(if help (reply (format "~s - ~a" cr help))
(reply (~s cr))))
(reply "There is no such command")))
(reply "You need to supply a command name, e.g. (help list)")))
|