summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--irc/command.rkt47
1 files changed, 30 insertions, 17 deletions
diff --git a/irc/command.rkt b/irc/command.rkt
index 933f7e5..30f9830 100644
--- a/irc/command.rkt
+++ b/irc/command.rkt
@@ -1,14 +1,16 @@
#lang racket/base
(require (for-syntax racket/base racket/list syntax/parse syntax/parse/lib/function-header)
- irc/bot irc/users racket/format racket/string)
-(provide define-command)
+ 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])
+ #:power [power 0]
+ #:min-interval [interv 0])
(hash-set! (current-commands)
(car signature) (command-registration signature help power action)))
@@ -20,34 +22,45 @@
(define (command-process)
(define s-exp (safe-read-string (string-join (cdr (params)))))
(when (pair? s-exp)
- (define command (hash-ref (current-commands) (car s-exp) #f))
- (define required-power (command-registration-power command))
- (when command
- (if (sufficient-power? (source) required-power)
- (apply (command-registration-action command)
- (cdr s-exp))
- (reply (format "Insufficient power (~a required)" required-power))))))
+ (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))))
- (command-process))
+ (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
- [(_ (name:id fn ...)
+ [(_ fn:function-header
kw:single-keyword ...
action ...)
(with-syntax ([(kw ...)
(append* (map syntax->list (syntax->list #'(kw ...))))])
- #'(command-add '(name fn ...) kw ... (lambda (fn ...) action ...)))]))
+ #'(command-add 'fn kw ... (lambda fn.args action ...)))]))
(define-command (list)
- #:help "List all registered commands"
- (reply (~s (hash-map (current-commands)
- (λ (k v) (car (command-registration-signature v)))))))
+ #: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"