[beirc-cvs] CVS update: beirc/application.lisp

[Max-Gerd Retzlaff]

Update of /project/beirc/cvsroot/beirc
In directory common-lisp.net:/tmp/cvs-serv9481

Modified Files:
	application.lisp 
Log Message:
Adds COM-WINDOW-NEXT and COM-WINDOW-PREVIOUS. The keystrokes do not yet
work (and are uncommented). I hope this will be changed soon.

(Also TAB-LAYOUT:ENABLED-PANE will perhaps be changed; an application that
uses the tab-layout-pane should really not get in touch with objects of
the class TAB-LAYOUT::TAB-PANE itself...)

Date: Sun Oct  2 19:34:18 2005
Author: mretzlaff

Index: beirc/application.lisp
diff -u beirc/application.lisp:1.25 beirc/application.lisp:1.26
--- beirc/application.lisp:1.25	Sun Oct  2 11:30:19 2005
+++ beirc/application.lisp	Sun Oct  2 19:34:15 2005
@@ -300,6 +300,28 @@
 (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)))))
+
 (define-beirc-command (com-close :name t) ((receiver 'receiver :prompt "receiver"))
   (when (eql receiver (server-receiver *application-frame*))
     (error "Can't close the server tab for this application!"))