From dlichteblau at common-lisp.net Sat Feb 24 10:58:16 2007 From: dlichteblau at common-lisp.net (dlichteblau) Date: Sat, 24 Feb 2007 05:58:16 -0500 (EST) Subject: [beirc-cvs] CVS beirc Message-ID: <20070224105816.5D37E2F04B@common-lisp.net> 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)))) From dlichteblau at common-lisp.net Sat Feb 24 19:25:51 2007 From: dlichteblau at common-lisp.net (dlichteblau) Date: Sat, 24 Feb 2007 14:25:51 -0500 (EST) Subject: [beirc-cvs] CVS beirc Message-ID: <20070224192551.241C272086@common-lisp.net> Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv13582 Modified Files: application.lisp Log Message: repaired define-window-switcher, thanks to Thomas Persson for the bug report --- /project/beirc/cvsroot/beirc/application.lisp 2007/02/24 10:58:16 1.85 +++ /project/beirc/cvsroot/beirc/application.lisp 2007/02/24 19:25:49 1.86 @@ -417,9 +417,12 @@ (macrolet ((define-window-switcher (name keystroke direction predicate) `(define-beirc-command (,name :name t :keystroke ,keystroke) () - (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))) + (let* ((tab-layout + (find-pane-named *application-frame* 'query)) + (current-pane (tab-page-pane + (tab-layout-enabled-page tab-layout))) + (list-of-panes (mapcar #'tab-page-pane + (tab-layout-pages tab-layout))) (n-panes (length list-of-panes)) (current-pane-position (position current-pane list-of-panes)) (position current-pane-position) From dlichteblau at common-lisp.net Sat Feb 24 19:33:38 2007 From: dlichteblau at common-lisp.net (dlichteblau) Date: Sat, 24 Feb 2007 14:33:38 -0500 (EST) Subject: [beirc-cvs] CVS beirc Message-ID: <20070224193338.85DFEA17E@common-lisp.net> Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv13990 Modified Files: application.lisp Log Message: "repaired define-window-switcher", take #2. While the previous check-in was correct, it was still converting pages to panes and back to pages. Here's a new version using just pages. --- /project/beirc/cvsroot/beirc/application.lisp 2007/02/24 19:25:49 1.86 +++ /project/beirc/cvsroot/beirc/application.lisp 2007/02/24 19:33:37 1.87 @@ -419,30 +419,28 @@ () (let* ((tab-layout (find-pane-named *application-frame* 'query)) - (current-pane (tab-page-pane - (tab-layout-enabled-page tab-layout))) - (list-of-panes (mapcar #'tab-page-pane - (tab-layout-pages tab-layout))) - (n-panes (length list-of-panes)) - (current-pane-position (position current-pane list-of-panes)) - (position current-pane-position) + (current-page (tab-layout-enabled-page tab-layout)) + (list-of-pages (tab-layout-pages tab-layout)) + (n-pages (length list-of-pages)) + (current-page-position (position current-page list-of-pages)) + (position current-page-position) (predicate ,predicate) (step-by ,direction) - (start-position (- current-pane-position (* step-by n-panes))) - (end-position (+ current-pane-position (* step-by n-panes)))) - (when list-of-panes + (start-position (- current-page-position (* step-by n-pages))) + (end-position (+ current-page-position (* step-by n-pages)))) + (when list-of-pages (setf position (loop for i = (+ step-by start-position) then (+ i step-by) until (or (= i end-position) - (funcall predicate (nth (mod (+ n-panes i) n-panes) list-of-panes))) + (funcall predicate (nth (mod (+ n-pages i) n-pages) list-of-pages))) finally (return i))) - (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-page (sheet-to-page pane)))) + (switch-to-page (nth (mod (+ n-pages position) n-pages) list-of-pages))))))) + (labels ((page-interesting-p (page) + (let ((receiver (receiver-from-tab-page page))) (or (> (messages-directed-to-me receiver) 0) (> (unseen-messages receiver) 0))))) - (define-window-switcher com-interesting-window-next (#\Tab :control) 1 #'pane-interesting-p) - (define-window-switcher com-interesting-window-previous (:iso-left-tab :control :shift) -1 #'pane-interesting-p) + (define-window-switcher com-interesting-window-next (#\Tab :control) 1 #'page-interesting-p) + (define-window-switcher com-interesting-window-previous (:iso-left-tab :control :shift) -1 #'page-interesting-p) (define-window-switcher com-window-next (:next :control) 1 (constantly t)) (define-window-switcher com-window-previous (:prior :control) -1 (constantly t)))) From dlichteblau at common-lisp.net Sun Feb 25 12:29:58 2007 From: dlichteblau at common-lisp.net (dlichteblau) Date: Sun, 25 Feb 2007 07:29:58 -0500 (EST) Subject: [beirc-cvs] CVS beirc Message-ID: <20070225122958.5FEC1111CF@common-lisp.net> Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv28686 Modified Files: application.lisp Log Message: when /nick is used before /connect, set *default-nick* instead of erroring out on the non-existing connection --- /project/beirc/cvsroot/beirc/application.lisp 2007/02/24 19:33:37 1.87 +++ /project/beirc/cvsroot/beirc/application.lisp 2007/02/25 12:29:58 1.88 @@ -691,7 +691,13 @@ (format nil "~AACTION ~A~A" (code-char 1) what (code-char 1))))) (define-beirc-command (com-nick :name t) ((new-nick 'string :prompt "new nick")) - (irc:nick (current-connection *application-frame*) new-nick)) + (let ((connection (current-connection *application-frame*))) + (cond + (connection + (irc:nick connection new-nick)) + (t + (format *standard-input* "Default nickname set to ~A.~%" new-nick) + (setf *default-nick* new-nick))))) (define-beirc-command (com-browse-url :name t) ((url 'url :prompt "url")) (handler-case