commands.lisp

   1 ;; Command related functions
   2
   3 (in-package "LICE")
   4
   5 (defclass command ()
   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."))
  11
  12 (defvar *commands* (make-hash-table)
  13   "A hash table of interactive commands")
  14
  15 (defmacro defcommand (name (&optional args &rest interactive-args) &body body)
  16   "Create an interactive command named NAME."
  17   (let ((tmp (gensym)))
  18     `(progn
  19        (defun ,name ,args
  20          ,@body)
  21        (setf (gethash ',name *commands*)
  22              (make-instance
  23               'command
  24               :name ',name
  25               :args ',interactive-args
  26               :doc ,(when (typep (first body) 'string) (first body))
  27               :fn (lambda ()
  28                     (let ((,tmp (list ,@(mapcar (lambda (a)
  29                                                   (if (listp a)
  30                                                       `(funcall (gethash ,(first a) *command-arg-type-hash*) ,@(cdr a))
  31                                                     `(funcall (gethash ,a *command-arg-type-hash*))))
  32                                                 interactive-args))))
  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))))))))
  47
  48 (defgeneric lookup-command (name)
  49   (:documentation "lookup the command named NAME."))
  50
  51 (defmethod lookup-command ((name symbol))
  52   (gethash name *commands*))
  53
  54 (defmethod lookup-command ((name string))
  55   ;; FIXME: this can fill the keyword package with lots of junk
  56   ;; symbols.
  57   (gethash (intern (string-upcase name) "KEYWORD") *commands*))
  58
  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)))
  63
  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
  69 returns it.
  70
  71 This variable is here to allow modules to add new argument types easily.")
  72
  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.")