Commit b6b9ed4e authored by Christophe Rhodes's avatar Christophe Rhodes

Implement, basically from Tim Moore, a command input context for the climacs

top level.  (This allows presentation-to-command translators to be clickable)
parent 7131b836
......@@ -249,57 +249,65 @@
(substitute numargp *numeric-argument-p* command :test #'eq))
(defun climacs-top-level (frame &key
command-parser command-unparser
partial-command-parser prompt)
command-parser command-unparser
partial-command-parser prompt)
(declare (ignore command-parser command-unparser partial-command-parser prompt))
(with-slots (windows) frame
(setf windows (list (find-climacs-pane (find-pane-named frame 'win))))
(push (buffer (car windows)) (buffers frame))
(let ((*standard-output* (car windows))
(*standard-input* (find-pane-named frame 'int))
(*print-pretty* nil)
(*abort-gestures* '((:keyboard #\g 512))))
(redisplay-frame-panes frame :force-p t)
(loop (handler-case
(loop for gestures = '()
do (multiple-value-bind (numarg numargp)
(read-numeric-argument :stream *standard-input*)
(loop (setf *current-gesture* (climacs-read-gesture))
(setf gestures (nconc gestures (list *current-gesture*)))
(let ((item (find-gestures gestures 'global-climacs-table)))
(cond ((not item)
(beep) (return))
((eq (command-menu-item-type item) :command)
(let ((command (command-menu-item-value item)))
(unless (consp command)
(setf command (list command)))
(setf command (substitute-numeric-argument-marker command numarg))
(setf command (substitute-numeric-argument-p command numargp))
(handler-case
(execute-frame-command frame command)
(error (condition)
(beep)
(format *error-output* "~a~%" condition)))
(setf (previous-command *standard-output*)
(if (consp command)
(car command)
command))
(return)))
(t nil))))
(let ((buffer (buffer (current-window))))
(when (modified-p buffer)
(setf (needs-saving buffer) t)))
(when (null (remaining-keys *application-frame*))
(setf (executingp *application-frame*) nil)
(redisplay-frame-panes frame))))
(abort-gesture () (display-message "Quit")))
(beep)
(let ((buffer (buffer (current-window))))
(when (modified-p buffer)
(setf (needs-saving buffer) t)))
(when (null (remaining-keys *application-frame*))
(setf (executingp *application-frame*) nil)
(redisplay-frame-panes frame))))))
(setf windows (list (find-climacs-pane (find-pane-named frame 'win))))
(push (buffer (car windows)) (buffers frame))
(let ((*standard-output* (car windows))
(*standard-input* (find-pane-named frame 'int))
(*print-pretty* nil)
(*abort-gestures* '((:keyboard #\g 512))))
(redisplay-frame-panes frame :force-p t)
(flet ((do-command (command)
(handler-case
(execute-frame-command frame command)
(error (condition)
(beep)
(format *error-output* "~a~%" condition)))
(setf (previous-command *standard-output*)
(if (consp command)
(car command)
command)))
(update-climacs ()
(let ((buffer (buffer (current-window))))
(when (modified-p buffer)
(setf (needs-saving buffer) t)))
(when (null (remaining-keys *application-frame*))
(setf (executingp *application-frame*) nil)
(redisplay-frame-panes frame))))
(loop
for maybe-error = t
do (handler-case
(with-input-context ('(command
:command-table 'global-climacs-table))
(object)
(loop
for gestures = '()
for numarg = (read-numeric-argument :stream *standard-input*)
do (loop (setf *current-gesture* (climacs-read-gesture))
(setf gestures (nconc gestures (list *current-gesture*)))
(let ((item (find-gestures gestures 'global-climacs-table)))
(cond ((not item)
(beep) (return))
((eq (command-menu-item-type item) :command)
(let ((command (command-menu-item-value item)))
(unless (consp command)
(setf command (list command)))
(setf command (substitute-numeric-argument-marker command numarg))
(do-command command)
(return)))
(t nil))))
(update-climacs))
(t
(do-command object)
(setq maybe-error nil)))
(abort-gesture ()
(display-message "Quit")))
(when maybe-error
(beep))
(update-climacs))))))
(defmacro simple-command-loop (command-table loop-condition end-clauses)
(let ((gesture (gensym))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment