ui.theme: updates to color scheme.

[factor.git] / basis / ui / tools / inspector / inspector.factor

diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor
index 1e9a99e1980dec1f401eaff13f2df44ef31921a0..209e0624bfe3ada19e29de36942ebdd50a6918a0 100644 (file)
--- a/basis/ui/tools/inspector/inspector.factor
+++ b/basis/ui/tools/inspector/inspector.factor
@@ -1,19 +1,18 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors inspector namespaces kernel models fry
-models.filter prettyprint sequences mirrors assocs 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.theme ui.gadgets.labelled
-ui.tools.common ui ;
+USING: accessors colors inspector namespaces kernel models fry
+colors.constants models.arrow prettyprint sequences mirrors
+assocs 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.theme ui.gadgets.tracks ui.gestures
+ui.gadgets.buttons ui.gadgets.tables ui.theme ui.gadgets.toolbar
+ui.gadgets.status-bar ui.gadgets.labeled ui.tools.common ui
+combinators ui.gadgets.worlds ;
 IN: ui.tools.inspector
 
 TUPLE: inspector-gadget < tool table ;
 
-{ 500 300 } inspector-gadget set-tool-dim
-
 TUPLE: slot-description key key-string value value-string ;
 
 : <slot-description> ( key value -- slot-description )
@@ -27,27 +26,40 @@ M: inspector-renderer row-columns
 M: inspector-renderer row-value
     drop value>> ;
 
+M: inspector-renderer column-titles
+    drop { "Key" "Value" } ;
+
 : <summary-gadget> ( model -- gadget )
     [
         standard-table-style [
-            [
+            {
+                [
+                    [
+                        [ "Class:" write ] with-cell
+                        [ class-of pprint ] with-cell
+                    ] with-row
+                ]
                 [
-                    [ "Class:" write ] with-cell
-                    [ class . ] with-cell
-                ] with-row
-            ]
-            [
+                    [
+                        [ "Object:" write ] with-cell
+                        [ pprint-short ] with-cell
+                    ] with-row
+                ]
                 [
-                    [ "Object:" write ] with-cell
-                    [ short. ] with-cell
-                ] with-row
-            ]
-            [
+                    [
+                        [ "Summary:" write ] with-cell
+                        [ print-summary ] with-cell
+                    ] with-row
+                ]
                 [
-                    [ "Summary:" write ] with-cell
-                    [ summary. ] with-cell
-                ] with-row
-            ] tri
+                    content-gadget [
+                        [
+                            [ "Content:" write ] with-cell
+                            [ output-stream get write-gadget ] with-cell
+                        ] with-row
+                    ] when*
+                ]
+            } cleave
         ] tabular-output
     ] <pane-control> ;
 
@@ -57,21 +69,26 @@ M: object make-slot-descriptions
     make-mirror [ <slot-description> ] { } assoc>map ;
 
 M: hashtable make-slot-descriptions
-    call-next-method [ [ key-string>> ] compare ] sort ;
+    call-next-method [ key-string>> ] sort-with ;
 
 : <inspector-table> ( model -- table )
-    [ make-slot-descriptions ] <filter> <table>
-        [ dup primary-operation invoke-command ] >>action
-        inspector-renderer >>renderer
-        monospace-font >>font ;
+    [ make-slot-descriptions ] <arrow> inspector-renderer <table>
+        [ invoke-primary-operation ] >>action
+        monospace-font >>font theme-font-colors
+        line-color >>column-line-color
+        6 >>gap
+        15 >>min-rows
+        15 >>max-rows
+        40 >>min-cols
+        40 >>max-cols ;
 
 : <inspector-gadget> ( model -- gadget )
-    vertical inspector-gadget new-track
+    vertical inspector-gadget new-track with-lines
         add-toolbar
         swap >>model
         dup model>> <inspector-table> >>table
-        dup model>> <summary-gadget> "Object" <labelled-gadget> f track-add
-        dup table>> <scroller> "Contents" <labelled-gadget> 1 track-add ;
+        dup model>> <summary-gadget> margins white-interior "Object" object-color <labeled> f track-add
+        dup table>> <scroller> margins white-interior "Contents" contents-color <labeled> 1 track-add ;
 
 M: inspector-gadget focusable-child*
     table>> ;
@@ -85,8 +102,13 @@ M: inspector-gadget focusable-child*
 \ com-push H{ { +listener+ t } } define-command
 
 : slot-editor-window ( close-hook update-hook assoc key key-string -- )
-    [ <value-ref> <slot-editor> ] [ "Slot editor: " prepend ] bi*
-    open-window ;
+    [ <value-ref> <slot-editor> ]
+    [
+        <world-attributes>
+            swap "Slot editor: " prepend >>title
+            [ { dialog-window } append ] change-window-controls
+    ] bi*
+    open-status-window ;
 
 : com-edit-slot ( inspector -- )
     [ close-window ] swap
@@ -95,9 +117,9 @@ M: inspector-gadget focusable-child*
     [ table>> (selected-row) ] tri [
         [ key>> ] [ key-string>> ] bi
         slot-editor-window
-    ] [ 2drop 2drop ] if ;
+    ] [ 4drop ] if ;
 
-: inspector-help ( -- ) "ui-inspector" com-follow ;
+: inspector-help ( -- ) "ui-inspector" com-browse ;
 
 \ inspector-help H{ { +nullary+ t } } define-command
 
@@ -117,3 +139,5 @@ inspector-gadget "multi-touch" f {
 
 : inspector ( obj -- )
     <model> inspect-model ;
+
+{ 550 400 } inspector-gadget set-tool-dim