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
76
77
78
79
80
81
|
;;; dyn-commands.scm: Dynamic Commands support.
;;; author: Anand Babu <ab@zresearch.com>
;;; copyright 2005 FreeTalk Core Team
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 2, or (at
;;; your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA
(use-modules (ice-9 string-fun))
(define dynamic-command-registry '())
(define (add-command! func command syntax description)
"Adds a dynamic command"
(if (procedure? func)
(set! dynamic-command-registry
(assoc-set! dynamic-command-registry
command
(list func syntax description)))
(display (string-append "freetalk: error: command ["
command
"] not bound to any procedure\n"))))
(define (remove-command! command)
"Removes a dynamic command"
(set! dynamic-command-registry
(assoc-remove! dynamic-command-registry
command)))
(define (dynamic-command-proc command args)
(if (not args)
(set! args ""))
((lambda (cmd-entry)
(if cmd-entry
(begin
((car cmd-entry) args)
(ft-hook-return)))) (assoc-ref dynamic-command-registry command)))
;; (if (string-null? args)
;; (ft-hook-return))
;; Terminate all empty messages here - AVATI: moved to commands.c:do_send_message()
(add-hook! ft-command-hook dynamic-command-proc)
(define (help args)
"display help message"
(let ((command-name (sans-surrounding-whitespace args))
(command-doc (assoc-ref dynamic-command-registry (sans-surrounding-whitespace args))))
(if (not (string-null? args))
(if (not (list? command-doc))
(display "no such command\n")
(display (string-append command-name
" - "
(cadr command-doc)
"\n\t"
(caddr command-doc)
"\n"
)))
(for-each (lambda (command-entry)
(display (string-append (car command-entry)
" - "
(caddr command-entry)
"\n\t"
(cadddr command-entry)
"\n"
)))
(sort dynamic-command-registry
(lambda (a b)
(string<? (car a) (car b))))))))
(add-command! help "help" "help [COMMAND]" "show help")
(add-command! help "/help" "/help [COMMAND]" "show help")
|
