1 ;;; Handle input and key command dispatching
5 (define-condition quit
(lice-condition)
6 () (:documentation
"A condition raised when the user aborted the
7 operation (by pressing C-g, for instance)."))
9 (defvar *last-command
* nil
10 "The last command executed.")
12 (defvar *this-command
* nil
13 "The command that was executed. This is to the command being
14 executed before it is executed. *last-command* will be set to this
15 when the command finishes. The command can change this value if it
16 wants to change what *last-command* will be set to. Used in the `yank'
17 and `yank-pop' commands.")
19 (defvar *current-prefix-arg
* nil
20 "The value of the prefix argument for this editing command.
21 It may be a number, or the symbol `-' for just a minus sign as arg,
22 or a list whose car is a number for just one or more C-u's
23 or nil if no argument has been specified.
24 This is what `(interactive \"P\")' returns.")
26 ;; (defun collect-command-args (cmd)
27 ;; "Return a list of values (some collected from the user) to pass to the CMD function."
28 ;; (mapcar (lambda (arg)
29 ;; (funcall (gethash (second arg) *command-arg-type-hash*)))
30 ;; (command-args cmd)))
32 (defvar *this-command-keys
* nil
33 "The key sequence that invoked the current command.")
35 (defun this-command-keys ()
36 "Return the key sequence that invoked this command.
37 The value is a list of KEYs."
40 (defun dispatch-command (name)
41 (let* ((cmd (lookup-command name
))
42 ;; (args (collect-command-args cmd))
43 (*this-command
* (command-name cmd
))
44 (*current-prefix-arg
* *prefix-arg
*))
46 (handler-case (funcall (command-fn cmd
))
49 ;; FIXME: debug-on-quit
54 ;; ;; FIXME: lice has no debugger yet, so use the lisp's
56 ;; (if *debug-on-error*
60 (setf *last-command
* *this-command
*
61 ;; reset command keys, since the command is over.
62 *this-command-keys
* nil
)
70 (defvar *unread-command-events
* nil
71 "List of events to be read as the command input.
72 These events are processed first, before actual keyboard input.")
74 (defun last-command-char ()
75 "Return the character of the last key event in the list of key
76 events that invoked the current command."
77 (key-char (car *this-command-keys
*)))
79 ;; This is really TTY specific
81 (let* ((*current-event
* (if *unread-command-events
*
82 (pop *unread-command-events
*)
84 (def (if *current-kmap
*
85 (lookup-key-internal *current-kmap
* *current-event
* t
*current-keymap-theme
* t
)
88 (when *overriding-terminal-local-map
*
89 (lookup-key-internal *overriding-terminal-local-map
* *current-event
* t
*current-keymap-theme
* t
))
90 (when *overriding-local-map
*
91 (lookup-key-internal *overriding-local-map
* *current-event
* t
*current-keymap-theme
* t
))
92 (when (current-local-map)
93 (lookup-key-internal (current-local-map) *current-event
* t
*current-keymap-theme
* t
))
94 ;;(lookup-key-internal (major-mode-map (major-mode)) *current-event* t *current-keymap-theme* t)
95 ;; TODO: minor mode maps
96 ;; check the global map
97 (lookup-key-internal *global-map
* *current-event
* t
*current-keymap-theme
* t
)))))
98 (dformat +debug-v
+ "~a ~s ~a~%"
99 def
#|
(key-hashid *current-event
*)|
# *current-event
* (key-char *current-event
*))
101 (handle-key-binding def
*current-event
*)
103 (message "~{~a ~}is undefined" (mapcar 'print-key
(reverse (cons *current-event
* (this-command-keys)))))
104 (setf *this-command-keys
* nil
)
105 (throw :unbound-key nil
)))))
107 (defgeneric handle-key-binding
(binding key-seq
))
109 (defmethod handle-key-binding ((binding keymap
) key-seq
)
110 (let ((*current-kmap
* binding
))
111 (push key-seq
*this-command-keys
*)
112 ;;(message "~{~a ~}" (mapcar 'print-key (this-command-keys)))
115 (defmethod handle-key-binding ((binding symbol
) key-seq
)
116 ;; reset the current-kmap in case the command reads input. XXX: Is
118 (let ((*current-kmap
* nil
))
119 ;; TODO: handle gathering args
120 (push key-seq
*this-command-keys
*)
121 (dispatch-command binding
)))
123 ;; XXX: this is temporary
124 (defconstant +key-backspace
+ 0407)
125 (defconstant +key-enter
+ 0527)
126 (defconstant +key-tab
+ 0407)
127 (defconstant +key-escape
+ 27)
129 (defun wait-for-event ()
130 ;; don't let the user C-g when reading for input
131 (let ((*waiting-for-input
* t
))
133 for event
= (frame-read-event (selected-frame))
134 for procs
= (poll-processes) do
135 ;; they hit the interrupt key so simulate that key press
137 (setf *quit-flag
* nil
139 :char
(code-char (+ *quit-code
* 96))
143 ;; handle subprocesses
145 ;; let the user break out of this stuff
146 (let ((*waiting-for-input
* nil
))
147 (dispatch-processes procs
)
148 (frame-render (selected-frame))))
150 ;; FIXME: Yes, I'd love to be able to sleep until there was
151 ;; activity on one of the streams lice is waiting for input on
152 ;; but i don't know how to do that. So just sleep for a tiny
153 ;; bit to pass control over to the operating system and then
158 (defun top-level-next-event ()
159 ;; Bind this locally so its value is restored after the
160 ;; command is dispatched. Otherwise, calls to set-buffer
162 (setf *current-buffer
* (window-buffer (frame-selected-window (selected-frame))))
166 (provide :lice-0.1
/input
)