[mcclim-cvs] CVS mcclim/Apps/Listener

[thenriksen]

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener
In directory clnet:/tmp/cvs-serv23245/Apps/Listener

Modified Files:
	listener.lisp 
Log Message:
Replace the sharp bracket in the Listener prompt by an actual arrow.


--- /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp	2008/01/06 01:33:25	1.38
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp	2008/02/01 18:48:56	1.39
@@ -145,9 +145,18 @@
 (defun print-listener-prompt (stream frame)
   (declare (ignore frame))
   (with-text-face (stream :italic)
-    (with-output-as-presentation (stream *package* 'package :single-box t)
-      (print-package-name stream))
-    (princ "> " stream)))
+    (let* ((text-style-width (text-style-width (medium-default-text-style stream) stream))
+           (arrow-width (* 2 text-style-width))
+           (prompt-height
+            (bounding-rectangle-height
+             (with-output-as-presentation (stream *package* 'package :single-box t)
+               (print-package-name stream)))))
+      (multiple-value-bind (x y) (stream-cursor-position stream)
+        (draw-arrow* stream x (+ y (/ prompt-height 2))
+                     (+ x arrow-width) (+ y (/ prompt-height 2))
+                     :head-length (/ text-style-width 2)
+                     :head-width (floor (/ prompt-height 2))))
+      (stream-increment-cursor-position stream (+ arrow-width text-style-width) 0))))
 
 (defmethod frame-standard-output ((frame listener))
   (get-frame-pane frame 'interactor))