1 ;; Command related functions
6 ((name :type symbol
:initarg
:name
:accessor command-name
)
7 (args :type list
:initarg
:args
:accessor command-args
)
8 (fn :type function
:initarg
:fn
:accessor command-fn
)
9 (doc :type
(or null string
) :initarg
:doc
:accessor command-doc
))
10 (:documentation
"An interactive command."))
12 (defvar *commands
* (make-hash-table)
13 "A hash table of interactive commands")
15 (defmacro defcommand
(name (&optional args
&rest interactive-args
) &body body
)
16 "Create an interactive command named NAME."
21 (setf (gethash ',name
*commands
*)
25 :args
',interactive-args
26 :doc
,(when (typep (first body
) 'string
) (first body
))
28 (let ((,tmp
(list ,@(mapcar (lambda (a)
30 `(funcall (gethash ,(first a
) *command-arg-type-hash
*) ,@(cdr a
))
31 `(funcall (gethash ,a
*command-arg-type-hash
*))))
33 ;; XXX: Is this a sick hack? We need to reset the
34 ;; prefix-arg at the right time. After the command
35 ;; is executed we can't because the universal
36 ;; argument code sets the prefix-arg for the next
37 ;; command. The Right spot seems to be to reset it
38 ;; once a command is about to be executed, and
39 ;; after the prefix arg has been gathered to be
40 ;; used in the command. Which is right here.
41 (setf *prefix-arg
* nil
)
42 ;; Note that we use the actual function. If the
43 ;; function is redefined, the command will
44 ;; continue to be defined and will call the
45 ;; function declared above, not the redefined one.
46 (apply #',name
,tmp
))))))))
48 (defgeneric lookup-command
(name)
49 (:documentation
"lookup the command named NAME."))
51 (defmethod lookup-command ((name symbol
))
52 (gethash name
*commands
*))
54 (defmethod lookup-command ((name string
))
55 ;; FIXME: this can fill the keyword package with lots of junk
57 (gethash (intern (string-upcase name
) "KEYWORD") *commands
*))
59 (defun call-command (name &rest args
)
60 "Use this command to call an interactive command from a lisp program."
61 (let ((cmd (lookup-command name
)))
62 (apply (command-fn cmd
) args
)))
64 (defvar *command-arg-type-hash
* (make-hash-table)
65 "A hash table of symbols. each symbol is an interactive argument
66 type whose value is a function that is called to gather input from the
67 user (or somewhere else) and return the result. For instance,
68 :BUFFER's value is read-buffer which prompts the user for a buffer and
71 This variable is here to allow modules to add new argument types easily.")
73 (defvar mark-even-if-inactive nil
74 "*Non-nil means you can use the mark even when inactive.
75 This option makes a difference in Transient Mark mode.
76 When the option is non-nil, deactivation of the mark
77 turns off region highlighting, but commands that use the mark
78 behave as if the mark were still active.")