Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv30518

Modified Files: application.lisp Log Message: add /interesting window {previous,next} and add keystrokes to /window {next,prev}

--- /project/beirc/cvsroot/beirc/application.lisp 2006/02/26 00:07:15 1.45 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/02/26 15:53:30 1.46 @@ -348,27 +348,36 @@ (define-beirc-command (com-raise :name t) ((receiver 'receiver :prompt "receiver")) (raise-receiver receiver))

-(define-beirc-command (com-window-next :name t);; :keystroke (:right :meta)) - () - (let* ((current-pane (tab-layout::tab-pane-pane - (enabled-pane (find-pane-named *application-frame* 'query)))) - (list-of-panes (sheet-children (sheet-parent current-pane))) - (position (position current-pane list-of-panes))) - (when list-of-panes - (if (>= position (1- (length list-of-panes))) - (switch-to-pane (car list-of-panes) 'tab-layout-pane) - (switch-to-pane (nth (1+ position) list-of-panes) 'tab-layout-pane))))) - -(define-beirc-command (com-window-previous :name t);; :keystroke (:left :meta)) - () - (let* ((current-pane (tab-layout::tab-pane-pane - (enabled-pane (find-pane-named *application-frame* 'query)))) - (list-of-panes (sheet-children (sheet-parent current-pane))) - (position (position current-pane list-of-panes))) - (when list-of-panes - (if (<= position 0) - (switch-to-pane (car (last list-of-panes)) 'tab-layout-pane) - (switch-to-pane (nth (1- position) list-of-panes) 'tab-layout-pane))))) +(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)))) + (list-of-panes (sheet-children (sheet-parent current-pane))) + (n-panes (length list-of-panes)) + (current-pane-position (position current-pane list-of-panes)) + (position current-pane-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 + (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))) + finally (return i))) + (switch-to-pane (nth (mod (+ n-panes position) n-panes) list-of-panes) + 'tab-layout-pane)))))) + (labels ((pane-interesting-p (pane) + (let ((receiver (receiver-from-tab-pane + (find-in-tab-panes-list pane 'tab-layout-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) + (define-window-switcher com-interesting-window-previous (:iso-left-tab :control :shift) -1 #'pane-interesting-p) + (define-window-switcher com-window-next (:next :control) 1 (constantly t)) + (define-window-switcher com-window-previous (:prior :control) -1 (constantly t))))

(define-beirc-command (com-close :name t) ((receiver 'receiver :prompt "receiver")) (let* ((connection (current-connection *application-frame*))