Update of /project/cells/cvsroot/Celtk In directory clnet:/tmp/cvs-serv31920
Modified Files: composites.lisp Log Message: Added: + Methods iconify and deiconify for class window + new class FULL-SCREEN-NO-DECO-WINDOW as a convenience function for creating a window with no decorations that occupies the whole screen + New functions screen-width and screen-height
Changed: + now the symbols application, iconify, deiconify, full-screen-no-deco-window, screen-width, screen-height are exported from the Celtk package.
--- /project/cells/cvsroot/Celtk/composites.lisp 2006/09/29 09:15:24 1.17 +++ /project/cells/cvsroot/Celtk/composites.lisp 2006/09/29 16:08:31 1.18 @@ -18,6 +18,19 @@
(in-package :Celtk)
+(eval-now! + (export '(title$ active .time decoration))) + +(export! application + keyboard-modifiers + iconify + deiconify + full-screen-no-deco-window + screen-width + screen-height) + +;;; --- decoration ------------------------------------------- + (defmd decoration-mixin () (decoration (c-in :normal)))
@@ -70,9 +83,6 @@ (defmodel composite-widget (widget) ((kids-packing :initarg :kids-packing :accessor kids-packing :initform nil)))
-(eval-now! - (export '(title$ active .time decoration))) - (defvar *app*)
(defmodel application (family) @@ -87,8 +97,6 @@ (defun app-idle (self) (setf (^app-time) (get-internal-real-time)))
-(export! keyboard-modifiers) - (defmd window (composite-widget decoration-mixin) (title$ (c? (string-capitalize (class-name (class-of self))))) (dictionary (make-hash-table :test 'equalp)) @@ -105,6 +113,26 @@ on-key-down on-key-up)
+(defun screen-width () + (let ((*tkw* *tkw*)) + (tk-format-now "winfo screenwidth ."))) + +(defun screen-height () + (let ((*tkw* *tkw*)) + (tk-format-now "winfo screenheight ."))) + +(defmodel full-screen-no-deco-window (window) + ()) + +(defmethod initialize-instance :before ((self full-screen-no-deco-window) + &key &allow-other-keys) + (tk-format '(:pre-make-tk self) + "wm geometry . [winfo screenwidth .]x[winfo screenheight .]+0+0") + (tk-format '(:pre-make-tk self) "update idletasks") + #-macosx (tk-format '(:pre-make-tk self) "wm attributes . -topmost yes") + (tk-format '(:pre-make-tk self) "wm overrideredirect . yes") + ) + (defmethod do-on-key-down :before (self &rest args &aux (keysym (car args))) (trc nil "ctk::do-on-key-down window" keysym (keyboard-modifiers .tkw)) (bwhen (mod (keysym-to-modifier keysym)) @@ -188,3 +216,14 @@ (defmethod path ((self window)) ".") (defmethod parent-path ((self window)) "")
+(defmethod iconify ((self window)) + (%%do-decoration self :normal) + (tk-format `(:fini) "wm iconify ~a" (^path))) + +(defmethod deiconify ((self window)) + (%%do-decoration self (decoration self)) + (tk-format `(:fini) "wm deiconify ~a" (^path))) + + + +