diff options
| -rw-r--r-- | irc/command.rkt | 47 |
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" |