Update of /project/beirc/cvsroot/beirc In directory common-lisp:/tmp/cvs-serv21256

Modified Files: application.lisp Log Message: rework command reading.

user input will no long be erased when invoking a presentation to command translator. (i.e. clicking on a URL will preserve the content of the input buffer). This works only for non-command reading, though.

--- /project/beirc/cvsroot/beirc/application.lisp 2006/02/22 16:30:50 1.39 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/02/23 19:43:29 1.40 @@ -125,6 +125,8 @@

(defvar *beirc-frame*)

+(defvar *last-input-line* nil) + (defun beirc-status-display (*application-frame* *standard-output*) (with-text-family (t :sans-serif) (multiple-value-bind (seconds minutes hours) (decode-universal-time (get-universal-time)) @@ -233,7 +235,8 @@ (clim-sys:make-process (lambda () (progv syms vals - (let* ((frame (make-application-frame 'beirc)) + (let* ((*last-input-line* nil) + (frame (make-application-frame 'beirc)) (ticker-process (clim-sys:make-process (lambda () (ticker frame)) :name "Beirc Ticker"))) (setf *beirc-frame* frame) @@ -751,25 +754,32 @@ (connection-process frame) nil (slot-value frame 'nick) nil))

+ + (defmethod clim:read-frame-command ((frame beirc) &key (stream *standard-input*)) - (multiple-value-prog1 - (clim:with-input-editing (stream) - (let ((c (clim:read-gesture :stream stream :peek-p t))) - (cond ((eql c #/) - (clim:read-gesture :stream stream) - (clim:accept 'clim:command :stream stream :prompt nil)) - (t - (list 'com-say (accept 'mumble :prompt nil :stream stream)))))) + (multiple-value-prog1 + (clim:with-input-editing (stream) + (when *last-input-line* + (replace-input stream *last-input-line* :rescan t)) + (with-input-context ('command) (object) + (let ((c (clim:read-gesture :stream stream :peek-p t))) + (multiple-value-prog1 + (cond ((eql c #/) + (clim:read-gesture :stream stream) + (clim:accept 'clim:command :stream stream :prompt nil)) + (t + (list 'com-say (accept 'mumble :prompt nil :stream stream)))) + (setf *last-input-line* nil))) + (command + (let ((buffer (stream-input-buffer stream))) + (when (every 'characterp buffer) + (setf *last-input-line* + (with-output-to-string (s) + (loop for char across buffer + do (write-char char s)))))) + object))) (window-clear stream)))

-(defmethod read-frame-command :around ((frame beirc) - &key (stream *standard-input*)) - (with-input-context ('command) (object) - (call-next-method) - (command - (window-clear stream) - object))) - (defun restart-beirc () (clim-sys:destroy-process *gui-process*) (setf *beirc-frame* nil)