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