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

[Andreas Fuchs]

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

Modified Files:
	application.lisp receivers.lisp 
Log Message:
commit mgr's pointer documentation pane patch. Thanks!

Date: Sun Sep 25 19:51:35 2005
Author: afuchs

Index: beirc/application.lisp
diff -u beirc/application.lisp:1.5 beirc/application.lisp:1.6
--- beirc/application.lisp:1.5	Sun Sep 25 18:30:40 2005
+++ beirc/application.lisp	Sun Sep 25 19:51:34 2005
@@ -80,6 +80,7 @@
   (:panes
    (io
     :interactor)
+   (pointer-doc :pointer-documentation)
    (status-bar
     :application
     :display-function 'beirc-status-display
@@ -106,6 +107,7 @@
          (with-tab-layout ('receiver-pane :name 'query)
            ("*Server*" server 'receiver-pane))
          (60 io)
+         (20 pointer-doc)
          (20                            ;<-- Sigh! Bitrot!
           status-bar)))))
 
@@ -446,7 +448,11 @@
   (list (presentation-object presentation)))
 
 (define-presentation-translator receiver-pane-to-receiver-translator
-    (receiver-pane receiver beirc)
+    (receiver-pane receiver beirc
+       :documentation ((object stream)
+                       (format stream "Reiceiver: ~A"
+                               (title (receiver-from-tab-pane
+                                       (find-in-tab-panes-list object 'tab-layout-pane))))))
     (object)
   (receiver-from-tab-pane
          (find-in-tab-panes-list object 'tab-layout-pane)))


Index: beirc/receivers.lisp
diff -u beirc/receivers.lisp:1.1 beirc/receivers.lisp:1.2
--- beirc/receivers.lisp:1.1	Sun Sep 25 14:43:52 2005
+++ beirc/receivers.lisp	Sun Sep 25 19:51:34 2005
@@ -11,6 +11,16 @@
       (pane :reader pane)
       (tab-pane :accessor tab-pane)))
 
+(defun slot-value-or-something (object &key (slot 'name) (something "without name"))
+  (if (slot-boundp object slot)
+      (slot-value object slot)
+      something))
+
+(defmethod print-object ((receiver receiver) stream)
+  (print-unreadable-object (receiver stream :type t)
+    (write-string (slot-value-or-something receiver :slot 'title :something "without title")
+                  stream)))
+
 (define-presentation-type receiver-pane ())
 
 ;;; KLUDGE: make-clim-application-pane doesn't return an application