src/commands.lisp

   1 ;; Command related functions
   2
   3 (in-package "LICE")
   4
   5 (defvar *prefix-arg* nil
   6   "The value of the prefix argument for the next editing command.
   7 It may be a number, or the symbol `-' for just a minus sign as arg,
   8 or a list whose car is a number for just one or more C-u's
   9 or nil if no argument has been specified.
  10
  11 You cannot examine this variable to find the argument for this command
  12 since it has been set to nil by the time you can look.
  13 Instead, you should use the variable `current-prefix-arg', although
  14 normally commands can get this prefix argument with (interactive \"P\").")
  15
  16 (defclass command ()
  17   ((name :type symbol :initarg :name :accessor command-name)
  18    (args :type list :initarg :args :accessor command-args)
  19    (fn :type function :initarg :fn :accessor command-fn)
  20    (doc :type (or null string) :initarg :doc :accessor command-doc))
  21   (:documentation "An interactive command."))
  22
  23 (defvar *commands* (make-hash-table)
  24   "A hash table of interactive commands")
  25
  26 (defmacro defcommand (name (&optional args &rest interactive-args) &body body)
  27   "Create an interactive command named NAME."
  28   (let ((tmp (gensym)))
  29     `(progn
  30        (defun ,name ,args
  31          ,@body)
  32        (setf (gethash ',name *commands*)
  33              (make-instance
  34               'command
  35               :name ',name
  36               :args ',interactive-args
  37               :doc ,(when (typep (first body) 'string) (first body))
  38               :fn (lambda ()
  39                     (let ((,tmp (list ,@(mapcar (lambda (a)
  40                                                   (if (listp a)
  41                                                       `(funcall (gethash ,(first a) *command-arg-type-hash*) ,@(cdr a))
  42                                                     `(funcall (gethash ,a *command-arg-type-hash*))))
  43                                                 interactive-args))))
  44                       ;; XXX: Is this a sick hack?  We need to reset the
  45                       ;; prefix-arg at the right time. After the command
  46                       ;; is executed we can't because the universal
  47                       ;; argument code sets the prefix-arg for the next
  48                       ;; command. The Right spot seems to be to reset it
  49                       ;; once a command is about to be executed, and
  50                       ;; after the prefix arg has been gathered to be
  51                       ;; used in the command. Which is right here.
  52                       (setf *prefix-arg* nil)
  53                       ;; Note that we use the actual function. If the
  54                       ;; function is redefined, the command will
  55                       ;; continue to be defined and will call the
  56                       ;; function declared above, not the redefined one.
  57                       (apply #',name ,tmp))))))))
  58
  59 (defgeneric lookup-command (name)
  60   (:documentation "lookup the command named NAME."))
  61
  62 (defmethod lookup-command ((name symbol))
  63   (gethash name *commands*))
  64
  65 (defmethod lookup-command ((name string))
  66   ;; FIXME: this can fill the keyword package with lots of junk
  67   ;; symbols.
  68   (gethash (intern (string-upcase name) "KEYWORD") *commands*))
  69
  70 (defun call-command (name &rest args)
  71   "Use this command to call an interactive command from a lisp program."
  72   (let ((cmd (lookup-command name)))
  73     (apply (command-fn cmd) args)))
  74
  75 (defvar *command-arg-type-hash* (make-hash-table)
  76   "A hash table of symbols. each symbol is an interactive argument
  77 type whose value is a function that is called to gather input from the
  78 user (or somewhere else) and return the result. For instance,
  79 :BUFFER's value is read-buffer which prompts the user for a buffer and
  80 returns it.
  81
  82 This variable is here to allow modules to add new argument types easily.")
  83
  84 (defvar mark-even-if-inactive nil
  85   "*Non-nil means you can use the mark even when inactive.
  86 This option makes a difference in Transient Mark mode.
  87 When the option is non-nil, deactivation of the mark
  88 turns off region highlighting, but commands that use the mark
  89 behave as if the mark were still active.")