ui: adding a WINDOW: that is like MAIN-WINDOW: but without making the word a main...

diff --git a/basis/ui/ui-docs.factor b/basis/ui/ui-docs.factor
index e060dff42b932fd3244d0cd1cea02ae49c1632bf..d6c945022495c3b1631cce35f232918e2cfef5a7 100644 (file)
--- a/basis/ui/ui-docs.factor
+++ b/basis/ui/ui-docs.factor
@@ -161,8 +161,11 @@ ARTICLE: "ui-windows" "Top-level windows"
 { $subsections ungraft* }
 "The root of the gadget hierarchy in a window is a special gadget which is rarely operated on directly, but it is helpful to know it exists:"
 { $subsections world }
-"There is also syntax for defining a main window as the entry point for a vocabulary:"
-{ $subsections POSTPONE: MAIN-WINDOW: } ;
+"There is also syntax for defining window words, including a main window that is the entry point for a vocabulary:"
+{ $subsections
+    POSTPONE: WINDOW:
+    POSTPONE: MAIN-WINDOW:
+} ;
 
 ARTICLE: "ui-backend" "Developing UI backends"
 "None of the words documented in this section should be called directly by user code. They are only of interest when developing new UI backends."
@@ -340,6 +343,20 @@ HELP: textured-background
 HELP: dialog-window
 { $description "Provides a hint to the window manager to create a floating, dialog-style window. Currently, this is only implemented for the GTK backend." } ;
 
+HELP: WINDOW:
+{ $syntax "WINDOW: window-word { attributes }
+    attribute-code ;" }
+{ $description "Defines a word for the current vocabulary named " { $snippet "window-word" } " that opens a UI window when run. The " { $snippet "attributes" } " specify the key-value pairs of the window's " { $link world-attributes } ". The " { $snippet "attribute-code" } " is run with the " { $snippet "world-attributes" } " on the stack; this allows the word to construct gadget objects to place in the " { $snippet "gadget" } " slot or set other runtime-dependent world attributes." }
+{ $examples
+"From the " { $vocab-link "hello-ui" } " vocabulary. Creates a window with the title \"Hi\" containing a label reading \"Hello world\":"
+{ $code
+"USING: accessors ui ui.gadgets.labels ;
+IN: hello-ui
+
+WINDOW: hello { { title \"Hi\" } }
+    \"Hello world\" <label> >>gadgets ;"
+} } ;
+
 HELP: MAIN-WINDOW:
 { $syntax "MAIN-WINDOW: window-word { attributes }
     attribute-code ;" }
@@ -354,6 +371,8 @@ MAIN-WINDOW: hello { { title \"Hi\" } }
     \"Hello world\" <label> >>gadgets ;"
 } } ;
 
+{ POSTPONE: WINDOW: POSTPONE: MAIN-WINDOW: } related-words
+
 ARTICLE: "ui.gadgets.worlds-window-controls" "Window controls"
 "The following window controls can be placed in a " { $link world } " window:"
 { $subsections

diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor
index 289dd23d0f2bd9710c880f8555cb71df55b17d21..e80fd009c4c9d82b665aa9ad5312781e0e19b6cb 100644 (file)
--- a/basis/ui/ui.factor
+++ b/basis/ui/ui.factor
@@ -223,16 +223,20 @@ HOOK: beep ui-backend ( -- )
 
 HOOK: system-alert ui-backend ( caption text -- )
 
-: parse-main-window-attributes ( class -- attributes )
+: parse-window-attributes ( class -- attributes )
     "{" expect dup all-slots parse-tuple-literal-slots ;
 
-: define-main-window ( word attributes quot -- )
-    [
-        '[ [ f _ clone @ open-window ] with-ui ] ( -- ) define-declared
-    ] [ 2drop current-vocab main<< ] 3bi ;
+: define-window ( word attributes quot -- )
+    '[ [ f _ clone @ open-window ] with-ui ] ( -- ) define-declared ;
+
+SYNTAX: WINDOW:
+    scan-new-word
+    world-attributes parse-window-attributes
+    parse-definition
+    define-window ;
 
 SYNTAX: MAIN-WINDOW:
     scan-new-word
-    world-attributes parse-main-window-attributes
+    world-attributes parse-window-attributes
     parse-definition
-    define-main-window ;
+    [ define-window ] [ 2drop current-vocab main<< ] 3bi ;