[beirc-cvs] CVS update: beirc/application.lisp

[Max-Gerd Retzlaff]

Update of /project/beirc/cvsroot/beirc
In directory common-lisp.net:/tmp/cvs-serv1689

Modified Files:
	application.lisp 
Log Message:
Beirc's prompt is now surrounded by a :DROP-SHADOW box (and the "text-modish"
" => " will not be printed anymore).

Date: Wed Oct  5 15:21:36 2005
Author: mretzlaff

Index: beirc/application.lisp
diff -u beirc/application.lisp:1.31 beirc/application.lisp:1.32
--- beirc/application.lisp:1.31	Wed Oct  5 05:39:14 2005
+++ beirc/application.lisp	Wed Oct  5 15:21:36 2005
@@ -106,7 +106,8 @@
        (vertically ()
          (with-tab-layout ('receiver-pane :name 'query)
            ("*Server*" server 'receiver-pane))
-         (68 io)
+         ;; (68 io) ;; no drop-shadow prompt
+         (72 io)
          (20 pointer-doc)
          (20                            ;<-- Sigh! Bitrot!
           status-bar)))))
@@ -136,13 +137,16 @@
               (length (current-messages))))))
 
 (defun beirc-prompt (*standard-output* *application-frame*)
-  (write-string "Beirc" *standard-output*)
-  (let ((receiver (current-receiver *application-frame*)))
-    (when receiver
-      (write-string " " *standard-output*)
-      (with-output-as-presentation (*standard-output* receiver 'receiver)
-        (write-string (title receiver) *standard-output*))))
-  (write-string " => " *standard-output*))
+  (stream-increment-cursor-position *standard-output* 3 4)
+  (surrounding-output-with-border (*standard-output* :shape :drop-shadow :move-cursor nil)
+    (write-string "Beirc" *standard-output*)
+    (let ((receiver (current-receiver *application-frame*)))
+      (when receiver
+        (write-string " " *standard-output*)
+        (with-output-as-presentation (*standard-output* receiver 'receiver)
+          (write-string (title receiver) *standard-output*)))))
+  (stream-increment-cursor-position *standard-output* 10 0)
+  #+nil (write-string " => " *standard-output*))
 
 ;; (defun format-message (prefix mumble)
 ;;   (write-line