From 4474964873edfbab6f37f01899312e0b5b2db05e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 27 Jun 2005 04:40:51 +0000
Subject: [PATCH] UI cleanup

---
 library/ui/dialogs.factor    | 54 --------------------
 library/ui/inspector.factor  | 98 ------------------------------------
 library/ui/labels.factor     | 11 +++-
 library/ui/load.factor       |  5 +-
 library/ui/panes.factor      | 93 ----------------------------------
 library/ui/tool-menus.factor | 18 -------
 library/ui/ui.factor         | 14 +-----
 7 files changed, 12 insertions(+), 281 deletions(-)
 delete mode 100644 library/ui/dialogs.factor
 delete mode 100644 library/ui/inspector.factor
 delete mode 100644 library/ui/panes.factor
 delete mode 100644 library/ui/tool-menus.factor

diff --git a/library/ui/dialogs.factor b/library/ui/dialogs.factor
deleted file mode 100644
index efc24cf5cc..0000000000
--- a/library/ui/dialogs.factor
+++ /dev/null
@@ -1,54 +0,0 @@
-IN: gadgets
-USING: generic kernel namespaces threads ;
-
-TUPLE: dialog continuation ;
-
-: dialog-action ( dialog ? -- )
-    over close-tile swap dialog-continuation call ;
-
-: dialog-ok ( dialog -- ) t dialog-action ;
-
-: dialog-cancel ( dialog -- ) f dialog-action ;
-
-: <dialog-buttons> ( -- gadget )
-    <default-shelf>
-    "OK" [ dialog-ok ] <button> over add-gadget
-    "Cancel" [ dialog-cancel ] <button> over add-gadget ;
-
-: dialog-actions ( dialog -- )
-    dup [ dialog-ok ] dup set-action
-    [ dialog-cancel ] dup set-action ;
-
-C: dialog ( content continuation -- gadget )
-    [ set-dialog-continuation ] keep
-    [ <empty-gadget> swap set-delegate ] keep
-    [
-        >r <default-pile>
-        [ add-gadget ] keep
-        [ <dialog-buttons> swap add-gadget ] keep
-        r> add-gadget
-    ] keep
-    [ dialog-actions ] keep ;
-
-: dialog ( content title -- ? )
-    #! Show a modal dialog and wait until OK or Cancel is
-    #! clicked. Outputs a true value if OK was clicked.
-    [ swap >r <dialog> r> tile stop ] callcc1 2nip ;
-
-TUPLE: prompt editor ;
-
-C: prompt ( prompt -- gadget )
-    0 default-gap 0 <pile> over set-delegate
-    [ >r <label> r> add-gadget ] keep
-    "" <editor> over set-prompt-editor
-    dup prompt-editor line-border over add-gadget ;
-
-: input-dialog ( prompt -- input )
-    #! Show an input dialog and resume the current continuation
-    #! when the user clicks OK or Cancel. If they click Cancel,
-    #! push f.
-    <prompt> dup "Input" dialog [
-        prompt-editor editor-text
-    ] [
-        drop f
-    ] ifte ;
diff --git a/library/ui/inspector.factor b/library/ui/inspector.factor
deleted file mode 100644
index 248894f447..0000000000
--- a/library/ui/inspector.factor
+++ /dev/null
@@ -1,98 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: errors gadgets generic hashtables kernel kernel-internals
-lists namespaces sequences strings unparser vectors words ;
-
-: label-box ( list -- gadget )
-    0 0 0 <pile> swap [ <presentation> over add-gadget ] each ;
-
-: unparse* ( obj -- str ) dup string? [ unparse ] unless ;
-
-: sort-sheet ( assoc -- assoc )
-    #! Sort an association list whose keys are arbitrary objects
-    [ 2car swap unparse* swap unparse* string> ] sort ;
-
-: alist>sheet ( assoc -- sheet )
-    unzip swap
-    <default-shelf>
-    [ >r label-box r> add-gadget ] keep
-    [ >r label-box r> add-gadget ] keep ;
-
-: <titled> ( gadget title -- gadget )
-    0 10 0 <shelf>
-    [ >r <label> r> add-gadget ] keep
-    [ add-gadget ] keep ;
-
-: top-sheet ( obj -- sheet )
-    dup class word-name <label> "Class:" <titled>
-    swap unparse <label> "Object:" <titled>
-    <line-pile> [ add-gadget ] keep [ add-gadget ] keep ;
-
-: object>alist ( obj -- assoc )
-    dup class "slots" word-prop [
-        second [ execute ] keep swons
-    ] map-with ;
-
-: slot-sheet ( obj -- sheet )
-    object>alist sort-sheet alist>sheet "Slots:" <titled> ;
-
-GENERIC: custom-sheet ( obj -- gadget )
-
-: <inspector> ( obj -- gadget )
-    0 10 0 <pile>
-    over top-sheet over add-gadget
-    over slot-sheet over add-gadget
-    swap custom-sheet over add-gadget ;
-
-M: object custom-sheet drop <empty-gadget> ;
-
-M: list custom-sheet ( list -- gadget )
-    [ length count ] keep zip alist>sheet "Elements:" <titled> ;
-
-M: array custom-sheet ( array -- gadget )
-    >list custom-sheet ;
-
-M: vector custom-sheet ( array -- gadget )
-    >list custom-sheet ;
-
-M: hashtable custom-sheet ( array -- gadget )
-    hash>alist sort-sheet alist>sheet "Entries:" <titled> ;
-
-M: word custom-sheet ( word -- gadget )
-    word-props <inspector> empty-border "Properties:" <titled> ;
-
-M: tuple custom-sheet ( tuple -- gadget )
-    delegate [
-        <inspector> empty-border "Delegate:" <titled>
-    ] [
-        <empty-gadget>
-    ] ifte* ;
-
-! We ensure that only one inspector is open for each object.
-SYMBOL: inspectors
-
-: ensure-ui
-    world get dup [ world-running? ] when [
-        "Inspector cannot be used if UI not running." throw
-    ] unless ;
-
-: inspector ( obj -- gadget )
-    #! Return an existing inspector gadget for this object, or
-    #! create a new one.
-    dup inspectors get assq [ ] [
-        dup <inspector>
-        [ swap inspectors [ acons ] change ] keep
-    ] ?ifte ;
-
-: inspector-tile ( obj -- tile )
-    inspector <scroller> "Inspector" <tile> ;
-
-: inspect ( obj -- )
-    #! Show an inspector for the object. The inspector lists
-    #! slots and entries in collections.
-    ensure-ui global [
-        inspector-tile world get add-gadget
-    ] bind ;
-
-global [ inspectors off ] bind
diff --git a/library/ui/labels.factor b/library/ui/labels.factor
index ff250c9f39..71e3696e86 100644
--- a/library/ui/labels.factor
+++ b/library/ui/labels.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel lists math namespaces sdl io sequences ;
+USING: generic hashtables io kernel lists math namespaces sdl
+sequences ;
 
 ! A label gadget draws a string.
 TUPLE: label text ;
@@ -17,3 +18,11 @@ M: label pref-size ( label -- w h )
 
 M: label draw-shape ( label -- )
     [ label-text ] keep [ draw-string ] with-trans ;
+
+: <styled-label> ( style text -- label )
+    <label> swap [
+        unswons [
+            [[ "fg" foreground ]]
+            [[ "bg" background ]]
+        ] assoc swons
+    ] map alist>hash over set-gadget-paint ;
diff --git a/library/ui/load.factor b/library/ui/load.factor
index 52b4f4ad37..364914072a 100644
--- a/library/ui/load.factor
+++ b/library/ui/load.factor
@@ -1,5 +1,6 @@
 USING: kernel parser sequences io ;
 [
+    "/library/ui/colors.factor"
     "/library/ui/shapes.factor"
     "/library/ui/points.factor"
     "/library/ui/rectangles.factor"
@@ -29,11 +30,7 @@ USING: kernel parser sequences io ;
     "/library/ui/presentations.factor"
     "/library/ui/tiles.factor"
     "/library/ui/splitters.factor"
-    "/library/ui/panes.factor"
-    "/library/ui/dialogs.factor"
-    "/library/ui/inspector.factor"
     "/library/ui/init-world.factor"
-    "/library/ui/tool-menus.factor"
     "/library/ui/ui.factor"
 ] [
     dup print run-resource
diff --git a/library/ui/panes.factor b/library/ui/panes.factor
deleted file mode 100644
index 2961195ac9..0000000000
--- a/library/ui/panes.factor
+++ /dev/null
@@ -1,93 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: generic kernel line-editor listener lists math namespaces
-sequences io strings threads ;
-
-! A pane is an area that can display text.
-
-! output: pile
-! current: shelf
-! input: editor
-TUPLE: pane output active current input continuation ;
-
-: add-output 2dup set-pane-output add-gadget ;
-: add-input 2dup set-pane-input add-gadget ;
-
-: <active-line> ( input current -- line )
-    <line-shelf> [ add-gadget ] keep [ add-gadget ] keep ;
-
-: init-active-line ( pane -- )
-    dup pane-active [ unparent ] when*
-    [ dup pane-input swap pane-current <active-line> ] keep
-    2dup set-pane-active add-gadget ;
-
-: pane-paint ( pane -- )
-    [[ "Monospaced" 12 ]] font set-paint-prop ;
-
-: pop-continuation ( pane -- quot )
-    dup pane-continuation f rot set-pane-continuation ;
-
-: pane-return ( pane -- )
-    [
-        pane-input [
-            commit-history line-text get line-clear
-        ] with-editor
-    ] keep
-    2dup stream-write "\n" over stream-write
-    pop-continuation in-thread drop ;
- 
-: pane-actions ( line -- )
-    [
-        [[ [ button-down 1 ] [ pane-input click-editor ] ]]
-        [[ [ "RETURN" ] [ pane-return ] ]]
-        [[ [ "UP" ] [ pane-input [ history-prev ] with-editor ] ]]
-        [[ [ "DOWN" ] [ pane-input [ history-next ] with-editor ] ]]
-    ] swap add-actions ;
-
-C: pane ( -- pane )
-    <line-pile> over set-delegate
-    <line-pile> over add-output
-    "" <label> over set-pane-current
-    "" <editor> over set-pane-input
-    dup init-active-line
-    dup pane-paint
-    dup pane-actions ;
-
-: pane-write-1 ( text pane -- )
-    >r <label> r> pane-current add-gadget ;
-
-: pane-terpri ( pane -- )
-    dup pane-current over pane-output add-gadget
-    <line-shelf> over set-pane-current init-active-line ;
-
-: pane-write ( pane list -- )
-    2dup car swap pane-write-1
-    cdr dup [
-        over pane-terpri pane-write
-    ] [
-        2drop
-    ] ifte ;
-
-! Panes are streams.
-M: pane stream-flush ( stream -- ) relayout ;
-M: pane stream-auto-flush ( stream -- ) stream-flush ;
-
-M: pane stream-readln ( stream -- line )
-    [ over set-pane-continuation stop ] callcc1 nip ;
-
-M: pane stream-write-attr ( string style stream -- )
-    [ nip swap "\n" split pane-write ] keep scroll>bottom ;
-
-M: pane stream-close ( stream -- ) drop ;
-
-: <console> ( -- pane )
-    <pane> dup
-    [ [ clear  print-banner listener ] in-thread ] with-stream
-    <scroller> ;
-
-: console ( -- )
-    #! Open an UI console window.
-    <console> "Listener" <tile> world get [
-        shape-size rect> 3/4 * >rect rot resize-gadget
-    ] 2keep add-gadget ;
diff --git a/library/ui/tool-menus.factor b/library/ui/tool-menus.factor
deleted file mode 100644
index 20e3873a8b..0000000000
--- a/library/ui/tool-menus.factor
+++ /dev/null
@@ -1,18 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: gadgets
-USING: kernel memory namespaces io ;
-
-SYMBOL: root-menu
-
-: show-root-menu ( -- )
-    root-menu get <menu> show-menu ;
-
-[
-    [[ "Listener" [ console ] ]]
-    [[ "Globals" [ global inspect ] ]]
-    [[ "Save image" [ save ] ]]
-    [[ "Exit" [ f world get set-world-running? ] ]]
-] root-menu set
-
-! world get [ drop show-root-menu ] [ button-down 1 ] set-action
diff --git a/library/ui/ui.factor b/library/ui/ui.factor
index 825b9a1ba9..3a31dc2f7e 100644
--- a/library/ui/ui.factor
+++ b/library/ui/ui.factor
@@ -3,18 +3,6 @@
 IN: gadgets
 USING: kernel namespaces sdl sequences ;
 
-: title ( -- str )
-    "Factor " version append ;
-
-SYMBOL: first-time?
-global [ first-time? on ] bind
-
-: first-time ( -- )
-    first-time? get [
-        world get gadget-paint [ console ] bind
-        global [ first-time? off ] bind
-    ] when ;
-
 IN: shells
 
 : ui ( -- )
@@ -22,7 +10,7 @@ IN: shells
     #! dimensions.
     world get shape-size 0 SDL_RESIZABLE [
         0 x set 0 y set [
-            title dup SDL_WM_SetCaption first-time
+            "Factor " version append dup SDL_WM_SetCaption
             start-world
             run-world
         ] with-screen