[cells-cvs] CVS Celtk

[fgoenninger]

Update of /project/cells/cvsroot/Celtk
In directory clnet:/tmp/cvs-serv4713

Modified Files:
	composites.lisp 
Log Message:
Added: Cell slot "decoration" to window. This allows creating
Splash screens without any window manager decoration: No title
bar, no border, no nothing. Use :decoration :none for the defmodel
of a window to achieve this. Setting decoration to :normal restores
all window decorations.

--- /project/cells/cvsroot/Celtk/composites.lisp	2006/09/05 18:43:22	1.14
+++ /project/cells/cvsroot/Celtk/composites.lisp	2006/09/28 20:02:40	1.15
@@ -102,9 +102,8 @@
   (tkfont-info (tkfont-info-loader))
   initial-focus
   on-key-down
-  on-key-up)
-
-
+  on-key-up
+  (decoration (c-in :normal)))
 
 (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))
@@ -119,6 +118,17 @@
       (setf (keyboard-modifiers .tkw)
         (delete mod (keyboard-modifiers .tkw))))))
 
+(defobserver decoration ((self window)) ;; == wm overrideredirect 0|1
+  (assert (or (eq new-value nil)        ;; Does not change decoration
+	      (eq new-value :normal)    ;; "normal"
+              (eq new-value :none)))    ;; No title bar, no nothing ...
+  (if (not (eq new-value old-value))
+      (case new-value
+	(:none    (tk-format '(:pre-make-tk new-value)
+			     "wm overrideredirect ~a 1" (^path)))
+	(:normal  (tk-format '(:pre-make-tk new-value)
+			     "wm overrideredirect ~a 0" (^path))))))
+
 (defobserver initial-focus ()
   (when new-value
     (tk-format '(:fini new-value) "focus ~a" (path new-value))))