[beirc-cvs] CVS beirc

[afuchs]

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)