Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv1658
Modified Files: application.lisp beirc.asd message-display.lisp package.lisp receivers.lisp Log Message: use McCLIM's built-in tab layout
--- /project/beirc/cvsroot/beirc/application.lisp 2006/05/31 19:35:39 1.84 +++ /project/beirc/cvsroot/beirc/application.lisp 2007/02/24 10:58:16 1.85 @@ -79,7 +79,7 @@ (ignored-nicks :initform nil) (receivers :initform (make-hash-table :test #'equal) :accessor receivers) (server-receivers :initform nil :reader server-receivers) - (tab-panes-to-receivers :initform (make-hash-table :test #'equal) :accessor tab-panes-to-receivers) + (tab-pages-to-receivers :initform (make-hash-table :test #'equal) :accessor tab-pages-to-receivers) (presence :initform (make-hash-table :test #'equal) :reader presence)) (:panes (io @@ -115,7 +115,7 @@ (default (vertically () (with-tab-layout ('receiver-pane :name 'query) - ("*Not Connected*" server 'receiver-pane)) + ("*Not Connected*" server :presentation-type 'receiver-pane)) (make-pane 'clim-extensions:box-adjuster-gadget) io (20 pointer-doc) @@ -123,8 +123,8 @@ status-bar)))))
;;; addition of optional argument allows debugging from outside the frame process. [2006/03/16:rpg] -(defun receiver-from-tab-pane (tab-pane &optional (frame *application-frame*)) - (gethash tab-pane (tab-panes-to-receivers frame))) +(defun receiver-from-tab-page (page &optional (frame *application-frame*)) + (gethash page (tab-pages-to-receivers frame)))
(defvar *current-receiver-override*)
@@ -136,7 +136,7 @@ (defmethod current-receiver ((frame beirc)) (let ((receiver (if (boundp '*current-receiver-override*) *current-receiver-override* - (receiver-from-tab-pane (enabled-pane (find-pane-named frame 'query)) frame)))) + (receiver-from-tab-page (tab-layout-enabled-page (find-pane-named frame 'query)) frame)))) (if (typep receiver 'receiver) receiver nil))) @@ -417,8 +417,8 @@ (macrolet ((define-window-switcher (name keystroke direction predicate) `(define-beirc-command (,name :name t :keystroke ,keystroke) () - (let* ((current-pane (tab-layout::tab-pane-pane - (enabled-pane (find-pane-named *application-frame* 'query)))) + (let* ((current-pane (tab-page-pane + (tab-layout-enabled-page (find-pane-named *application-frame* 'query)))) (list-of-panes (sheet-children (sheet-parent current-pane))) (n-panes (length list-of-panes)) (current-pane-position (position current-pane list-of-panes)) @@ -433,11 +433,9 @@ until (or (= i end-position) (funcall predicate (nth (mod (+ n-panes i) n-panes) list-of-panes))) finally (return i))) - (switch-to-pane (nth (mod (+ n-panes position) n-panes) list-of-panes) - 'tab-layout-pane)))))) + (switch-to-page (sheet-to-page (nth (mod (+ n-panes position) n-panes) list-of-panes)))))))) (labels ((pane-interesting-p (pane) - (let ((receiver (receiver-from-tab-pane - (find-in-tab-panes-list pane 'tab-layout-pane)))) + (let ((receiver (receiver-from-tab-page (sheet-to-page pane)))) (or (> (messages-directed-to-me receiver) 0) (> (unseen-messages receiver) 0))))) (define-window-switcher com-interesting-window-next (#\Tab :control) 1 #'pane-interesting-p) @@ -870,24 +868,20 @@ (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)))))) + (title (receiver-from-tab-page + (sheet-to-page object)))))) (object) - (receiver-from-tab-pane - (find-in-tab-panes-list object 'tab-layout-pane))) + (receiver-from-tab-page (sheet-to-page object)))
(define-presentation-translator receiver-pane-to-channel-translator (receiver-pane channel beirc :documentation ((object stream) (format stream "Channel: ~A" - (channel (receiver-from-tab-pane - (find-in-tab-panes-list object 'tab-layout-pane))))) + (channel (sheet-to-page object)))) :tester ((object) - (channel (receiver-from-tab-pane - (find-in-tab-panes-list object 'tab-layout-pane))))) + (channel (receiver-from-tab-page (sheet-to-page object))))) (object) - (channel (receiver-from-tab-pane - (find-in-tab-panes-list object 'tab-layout-pane)))) + (channel (sheet-to-page object)))
(define-presentation-translator receiver-to-channel-translator (receiver channel beirc @@ -950,10 +944,8 @@ (unwind-protect (progn (setf (irc:client-stream connection) (make-broadcast-stream)) - (when (tab-layout:find-in-tab-panes-list (find-pane-named frame 'server) - (find-pane-named frame 'query)) - (tab-layout:remove-pane (find-pane-named frame 'server) - (find-pane-named frame 'query))) + (when (sheet-to-page (find-pane-named frame 'server)) + (remove-page (sheet-to-page (find-pane-named frame 'server)))) (setf (server-receiver frame connection) server-receiver) (setf (ui-process *application-frame*) (current-process)) (if (processes-supported-p) @@ -1138,4 +1130,4 @@
(defmethod frame-exit :after ((frame beirc)) "Shut off the sound server process, if necessary." - (stop-sound-server)) \ No newline at end of file + (stop-sound-server)) --- /project/beirc/cvsroot/beirc/beirc.asd 2006/04/19 21:22:47 1.11 +++ /project/beirc/cvsroot/beirc/beirc.asd 2007/02/24 10:58:16 1.12 @@ -6,7 +6,7 @@ (cl:in-package :beirc.system)
(defsystem :beirc - :depends-on (:mcclim :cl-irc :split-sequence :tab-layout :cl-ppcre :cl-fad) + :depends-on (:mcclim :cl-irc :split-sequence :cl-ppcre :cl-fad) :components ((:file "package") (:file "variables" :depends-on ("package")) (:file "events" :depends-on ("package")) @@ -20,4 +20,4 @@ ;; probably wrong, and the dependency should be ;; removed. [2006/04/06:rpg] (:file "sound-player" :depends-on ("package" "variables")) - )) \ No newline at end of file + )) --- /project/beirc/cvsroot/beirc/message-display.lisp 2006/05/29 20:05:42 1.50 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2007/02/24 10:58:16 1.51 @@ -697,4 +697,4 @@ maximize (preamble-length message)))) (formatting-table (t) (loop for message in messages - do (print-message message receiver))))) \ No newline at end of file + do (print-message message receiver))))) --- /project/beirc/cvsroot/beirc/package.lisp 2006/05/29 20:05:42 1.5 +++ /project/beirc/cvsroot/beirc/package.lisp 2007/02/24 10:58:16 1.6 @@ -1,5 +1,5 @@ (cl:defpackage :beirc - (:use :clim :clim-lisp :clim-sys :tab-layout) + (:use :clim :clim-lisp :clim-sys :clim-tab-layout) (:export #:beirc #:*beirc-user-init-file* #:*hyperspec-base-url* #:*default-fill-column* #:*timestamp-column-orientation* --- /project/beirc/cvsroot/beirc/receivers.lisp 2006/04/12 18:42:30 1.28 +++ /project/beirc/cvsroot/beirc/receivers.lisp 2007/02/24 10:58:16 1.29 @@ -17,7 +17,7 @@ (incomplete-input :accessor incomplete-input :initform "") (positions-mentioning-user :accessor positions-mentioning-user :initform nil) (pane :reader pane) - (tab-pane :accessor tab-pane))) + (tab-page :accessor tab-page)))
(defclass irc-connection-closed-message (irc:irc-message) ())
@@ -56,16 +56,18 @@ (defun initialize-receiver-with-pane (receiver frame pane &key (add-pane-p t)) (setf (slot-value receiver 'pane) pane) (if (not add-pane-p) - (setf (slot-value receiver 'tab-pane) - (find-in-tab-panes-list pane - 'tab-layout-pane)) + (setf (slot-value receiver 'tab-page) (sheet-to-page pane)) (progn - (setf (slot-value receiver 'tab-pane) - (make-tab-pane-from-list (title receiver) (pane receiver) 'receiver-pane)) - (add-pane (tab-pane receiver) (find-pane-named frame 'query)) + (setf (slot-value receiver 'tab-page) + (make-instance 'tab-page + :title (title receiver) + :pane (pane receiver) + :enabled-callback 'receiver-page-enabled-callback + :presentation-type 'receiver-pane)) + (add-page (tab-page receiver) (find-pane-named frame 'query)) ;; resize the pane to fit the tab container (change-space-requirements pane))) - (setf (gethash (tab-pane receiver) (tab-panes-to-receivers frame)) receiver)) + (setf (gethash (tab-page receiver) (tab-pages-to-receivers frame)) receiver))
(defun rename-query-receiver (receiver new-name) (let ((old-title (irc:normalize-nickname (connection receiver) @@ -75,7 +77,7 @@ (with-slots (title query) receiver (setf title new-name query new-name - (tab-layout::tab-pane-title (tab-pane receiver)) new-name) + (tab-page-title (tab-page receiver)) new-name) (remhash (list (connection receiver) old-title) (receivers *application-frame*)) (setf (gethash (list (connection receiver) normalized-name) (receivers *application-frame*)) receiver)))) @@ -127,8 +129,7 @@
(defun remove-receiver (receiver frame) - (tab-layout:remove-pane (tab-pane receiver) - (find-pane-named frame 'query)) + (remove-page (tab-page receiver)) (remhash (list (connection receiver) (title receiver)) (receivers frame)))
(defparameter *network-service-sources* '("nickserv" "memoserv" "chanserv" "") @@ -299,29 +300,24 @@
(defun update-drawing-options (receiver) (when (and (slot-boundp receiver 'pane) (sheetp (pane receiver)) - (find-in-tab-panes-list (pane receiver) 'tab-layout-pane)) - (set-drawing-options-for-pane-in-tab-layout (pane receiver) - `(:ink ,(cond ((> (messages-directed-to-me receiver) 0) +green+) - ((> (unseen-messages receiver) 0) +red+) - (t +black+)))))) - -(defmethod switch-to-pane :after ((pane sheet) (parent (eql 'tab-layout-pane))) - (let ((my-tab-layout-pane (find-pane-named *application-frame* 'query))) - (when (eq (sheet-parent (sheet-parent pane)) ;; Is this the desired tab-layout? - my-tab-layout-pane) - - (let ((receiver (receiver-from-tab-pane - (find-in-tab-panes-list pane my-tab-layout-pane)))) - (unless (null receiver) - (setf (unseen-messages receiver) 0) - (setf (all-unseen-messages receiver) 0) - (setf (messages-directed-to-me receiver) 0) - (setf (last-visited receiver) (get-universal-time)) - (update-drawing-options receiver)))))) + (sheet-to-page (pane receiver))) + (setf (tab-page-drawing-options (sheet-to-page (pane receiver))) + `(:ink ,(cond ((> (messages-directed-to-me receiver) 0) +green+) + ((> (unseen-messages receiver) 0) +red+) + (t +black+)))))) + +(defun receiver-page-enabled-callback (page) + (let ((receiver (receiver-from-tab-page page))) + (unless (null receiver) + (setf (unseen-messages receiver) 0) + (setf (all-unseen-messages receiver) 0) + (setf (messages-directed-to-me receiver) 0) + (setf (last-visited receiver) (get-universal-time)) + (update-drawing-options receiver))))
(defun raise-receiver (receiver) (setf (unseen-messages receiver) 0) (setf (all-unseen-messages receiver) 0) (setf (messages-directed-to-me receiver) 0) (setf (last-visited receiver) (get-universal-time)) - (switch-to-pane (pane receiver) 'tab-layout-pane)) + (switch-to-page (sheet-to-page (pane receiver))))