diff --git a/basis/ui/backend/gtk/gtk.factor b/basis/ui/backend/gtk/gtk.factor index 6e3703e4b7..ed0a45ee6a 100644 --- a/basis/ui/backend/gtk/gtk.factor +++ b/basis/ui/backend/gtk/gtk.factor @@ -361,6 +361,7 @@ CONSTANT: window-controls>decor-flags { small-title-bar $ GDK_DECOR_TITLE } { normal-title-bar $ GDK_DECOR_TITLE } { textured-background 0 } + { floating-window 0 } } CONSTANT: window-controls>func-flags @@ -372,13 +373,19 @@ CONSTANT: window-controls>func-flags { small-title-bar 0 } { normal-title-bar 0 } { textured-background 0 } + { floating-window 0 } } +: set-window-hint ( win controls -- ) + { + { [ floating-window over member-eq? ] [ drop GDK_WINDOW_TYPE_HINT_DIALOG ] } + { [ small-title-bar over member-eq? ] [ drop GDK_WINDOW_TYPE_HINT_UTILITY ] } + [ drop GDK_WINDOW_TYPE_HINT_NORMAL ] + } cond gtk_window_set_type_hint ; + : configure-window-controls ( win controls -- ) [ - small-title-bar swap member-eq? - GDK_WINDOW_TYPE_HINT_UTILITY GDK_WINDOW_TYPE_HINT_NORMAL ? - gtk_window_set_type_hint + set-window-hint ] [ [ gtk_widget_get_window ] dip window-controls>decor-flags symbols>flags diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index 63c89c9494..2644240bd7 100644 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/basis/ui/gadgets/worlds/worlds.factor @@ -15,7 +15,8 @@ SYMBOLS: resize-handles small-title-bar normal-title-bar - textured-background ; + textured-background + floating-window ; CONSTANT: default-world-pixel-format-attributes { diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor index c46bd44760..470a7ea40c 100644 --- a/basis/ui/tools/browser/browser.factor +++ b/basis/ui/tools/browser/browser.factor @@ -8,7 +8,7 @@ ui.gadgets.borders ui.gadgets.buttons ui.gadgets.editors ui.gadgets.glass ui.gadgets.labels ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.viewports ui.gestures ui.tools.browser.history -ui.tools.browser.popups ui.tools.common vocabs ; +ui.tools.browser.popups ui.tools.common vocabs ui.gadgets.worlds ; IN: ui.tools.browser TUPLE: browser-gadget < tool history scroller search-field popup ; @@ -89,7 +89,11 @@ M: browser-gadget definitions-changed ( set browser -- ) M: browser-gadget focusable-child* search-field>> ; : (browser-window) ( topic -- ) - "Browser" open-status-window ; + + + "Browser" >>title + { floating-window } >>window-controls + open-status-window ; : browser-window ( -- ) "help.home" (browser-window) ; diff --git a/basis/ui/tools/deploy/deploy.factor b/basis/ui/tools/deploy/deploy.factor index 34c579c35a..34a19569b6 100644 --- a/basis/ui/tools/deploy/deploy.factor +++ b/basis/ui/tools/deploy/deploy.factor @@ -5,7 +5,8 @@ tools.deploy.config.editor tools.deploy vocabs namespaces models.mapping sequences system accessors fry ui.gadgets ui.render ui.gadgets.buttons ui.gadgets.packs ui.gadgets.labels ui.gadgets.editors ui.gadgets.borders ui.gestures ui.commands assocs -ui.gadgets.tracks ui ui.tools.listener ui.tools.browser ; +ui.gadgets.tracks ui ui.tools.listener ui.tools.browser +ui.gadgets.worlds ; IN: ui.tools.deploy TUPLE: deploy-gadget < pack vocab settings ; @@ -111,5 +112,9 @@ deploy-gadget "toolbar" f { : deploy-tool ( vocab -- ) vocab-name [ { 10 10 } ] - [ "Deploying “" "”" surround ] bi + [ + + swap "Deploying “" "”" surround >>title + { floating-window } >>window-controls + ] bi open-window ; diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor index 785f46d13f..100defe0df 100644 --- a/basis/ui/tools/inspector/inspector.factor +++ b/basis/ui/tools/inspector/inspector.factor @@ -6,7 +6,7 @@ classes io io.styles arrays hashtables math.order sorting refs fonts ui.tools.browser ui.commands ui.operations ui.gadgets ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.slots ui.gadgets.tracks ui.gestures ui.gadgets.buttons ui.gadgets.tables ui.gadgets.status-bar -ui.gadgets.labeled ui.tools.common ui combinators ; +ui.gadgets.labeled ui.tools.common ui combinators ui.gadgets.worlds ; IN: ui.tools.inspector TUPLE: inspector-gadget < tool table ; @@ -101,7 +101,12 @@ M: inspector-gadget focusable-child* \ com-push H{ { +listener+ t } } define-command : slot-editor-window ( close-hook update-hook assoc key key-string -- ) - [ ] [ "Slot editor: " prepend ] bi* + [ ] + [ + + swap "Slot editor: " prepend >>title + { floating-window } >>window-controls + ] bi* open-status-window ; : com-edit-slot ( inspector -- ) diff --git a/basis/ui/ui-docs.factor b/basis/ui/ui-docs.factor index f6ded4cffe..55c799e63e 100644 --- a/basis/ui/ui-docs.factor +++ b/basis/ui/ui-docs.factor @@ -333,6 +333,9 @@ HELP: normal-title-bar HELP: textured-background { $description "Asks for a window to have a background that blends seamlessly with the window frame. Factor will leave the window background transparent and pass mouse button gestures not handled directly by a gadget through to the window system so that the window can be dragged from anywhere on its background." } ; +HELP: floating-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: MAIN-WINDOW: { $syntax "MAIN-WINDOW: window-word { attributes } attribute-code ;" } @@ -357,5 +360,6 @@ ARTICLE: "ui.gadgets.worlds-window-controls" "Window controls" small-title-bar normal-title-bar textured-background + floating-window } "Provide a sequence of these values in the " { $snippet "window-controls" } " slot of the " { $link world-attributes } " tuple you pass to " { $link open-window } "." ;