Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv24914
Modified Files: application.lisp Log Message: Beirc's prompt is changed: After the the word "Beirc" now the current receiver's title is shown, and it will be presented as the current receiver (with the presentation-type RECEIVER).
The presentation-translator RECEIVER-TO-CHANNEL-TRANSLATOR is added (with :tester and :documentation).
A :tester is added to RECEIVER-PANE-TO-CHANNEL-TRANSLATOR. (Sadly, CLIM's presentation-translators seem not to be transitive, otherwise we could get rid of this presentation-translator.)
Date: Wed Oct 5 05:39:14 2005 Author: mretzlaff
Index: beirc/application.lisp diff -u beirc/application.lisp:1.30 beirc/application.lisp:1.31 --- beirc/application.lisp:1.30 Mon Oct 3 01:47:51 2005 +++ beirc/application.lisp Wed Oct 5 05:39:14 2005 @@ -136,9 +136,13 @@ (length (current-messages))))))
(defun beirc-prompt (*standard-output* *application-frame*) - (format *standard-output* "Beirc ~A => " - (or (current-query) - (current-channel)))) + (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*))
;; (defun format-message (prefix mumble) ;; (write-line @@ -599,10 +603,23 @@ :documentation ((object stream) (format stream "Channel: ~A" (channel (receiver-from-tab-pane - (find-in-tab-panes-list object 'tab-layout-pane)))))) + (find-in-tab-panes-list object 'tab-layout-pane))))) + :tester ((object) + (channel (receiver-from-tab-pane + (find-in-tab-panes-list object 'tab-layout-pane))))) (object) (channel (receiver-from-tab-pane (find-in-tab-panes-list object 'tab-layout-pane)))) + +(define-presentation-translator receiver-to-channel-translator + (receiver channel beirc + :documentation ((object stream) + (format stream "Channel: ~A" + (channel object))) + :tester ((object) + (channel object))) + (object) + (channel object))
(define-presentation-translator nickname-to-hostmask-translator (nickname hostmask beirc