add content-gadget hook for inspector

Allow objects such as images, strings, and audio clips to display rich representations of themselves in the inspector by providing methods for a content-gadget generic.

basis/ui/gadgets/panes/panes-docs.factor

@@ -47,6 +47,10 @@ HELP: <pane-stream>
 
 { with-pane make-pane } related-words
 
+HELP: content-gadget
+{ $values { "object" object } { "gadget/f" { $maybe gadget } } }
+{ $description "This generic function may be implemented for objects in order to display a rich representation of the object in the " { $link "ui-inspector" } ". If " { $snippet "content-gadget" } " returns a gadget for an inspected object, the returned gadget is displayed under the \"Content\" heading in the inspector window. If " { $snippet "content-gadget" } " returns " { $link POSTPONE: f } ", no content section is included in the given object's inspector." } ;
+
 ARTICLE: "ui.gadgets.panes" "Pane gadgets"
 "The " { $vocab-link "ui.gadgets.panes" } " vocabulary implements panes, which display formatted text."
 { $subsections

basis/ui/gadgets/panes/panes.factor

@@ -12,6 +12,7 @@ ui.text ui.gadgets.presentations ui.gadgets.grids ui.gadgets.tracks
 ui.gadgets.icons ui.gadgets.grid-lines ui.baseline-alignment
 colors io.styles classes ;
 FROM: io.styles => foreground background ;
+FROM: ui.gadgets.wrappers => <wrapper> ;
 IN: ui.gadgets.panes
 
 TUPLE: pane < track
@@ -436,3 +437,12 @@ pane H{
     { copy-action [ com-copy ] }
     { T{ button-down f f 3 } [ pane-menu ] }
 } set-gestures
+
+GENERIC: content-gadget ( object -- gadget/f )
+M: object content-gadget drop f ;
+
+M: string content-gadget
+    '[ _ write ] make-pane <scroller>
+        { 450 100 } >>pref-dim
+    <wrapper> ;
+

basis/ui/tools/inspector/inspector-docs.factor

@@ -1,5 +1,5 @@
 USING: help.markup help.syntax ui.commands ui.gadgets.slots
-ui.gadgets.editors kernel ;
+ui.gadgets.panes ui.gadgets.editors kernel ;
 IN: ui.tools.inspector
 
 ARTICLE: "ui-inspector-edit" "Editing slot values in the inspector"
@@ -15,6 +15,8 @@ ARTICLE: "ui-inspector" "UI inspector"
 $nl
 "To display an object in the UI inspector, right-click a presentation and choose " { $strong "Inspector" } " from the menu that appears. The inspector can also be opened from the listener using a word:"
 { $subsections inspector }
+"Objects may extend the inspector window with a content gadget, in order to provide a rich representation of the object's content in the inspector."
+{ $subsections content-gadget }
 "The inspector embeds a table gadget, which supports keyboard navigation; see " { $link "ui.gadgets.tables" } ". It also provides a few other commands:"
 { $command-map inspector-gadget "toolbar" }
 { $command-map inspector-gadget "multi-touch" }
@@ -25,4 +27,4 @@ HELP: inspector
 { $values { "obj" object } }
 { $description "Opens a new inspector window displaying the slots of " { $snippet "obj" } "." } ;
 
-ABOUT: "ui-inspector"
+ABOUT: "ui-inspector"

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 ;
+ui.gadgets.labeled ui.tools.common ui combinators ;
 IN: ui.tools.inspector
 
 TUPLE: inspector-gadget < tool table ;
@@ -30,24 +30,34 @@ M: inspector-renderer column-titles
 : <summary-gadget> ( model -- gadget )
     [
         standard-table-style [
-            [
+            {
                 [
-                    [ "Class:" write ] with-cell
-                    [ class-of pprint ] with-cell
-                ] with-row
-            ]
-            [
+                    [
+                        [ "Class:" write ] with-cell
+                        [ class-of pprint ] with-cell
+                    ] with-row
+                ]
                 [
-                    [ "Object:" write ] with-cell
-                    [ pprint-short ] with-cell
-                ] with-row
-            ]
-            [
+                    [
+                        [ "Object:" write ] with-cell
+                        [ pprint-short ] with-cell
+                    ] with-row
+                ]
                 [
-                    [ "Summary:" write ] with-cell
-                    [ print-summary ] with-cell
-                ] with-row
-            ] tri
+                    [
+                        [ "Summary:" write ] with-cell
+                        [ print-summary ] with-cell
+                    ] with-row
+                ]
+                [
+                    content-gadget [
+                        [
+                            [ "Content:" write ] with-cell
+                            [ output-stream get write-gadget ] with-cell
+                        ] with-row
+                    ] when*
+                ]
+            } cleave
         ] tabular-output
     ] <pane-control> ;
 
@@ -123,3 +133,5 @@ inspector-gadget "multi-touch" f {
 
 : inspector ( obj -- )
     <model> inspect-model ;
+
+{ 550 400 } inspector-gadget set-tool-dim

extra/audio/gadget/gadget.factor

@@ -72,3 +72,6 @@ PRIVATE>
 
 : audio. ( audio -- )
     <audio-gadget> gadget. ;
+
+M: audio content-gadget
+    <audio-gadget> ;

extra/images/viewer/viewer.factor

@@ -109,3 +109,6 @@ M: model set-image [ value>> >>image drop ] [ >>model ] 2bi ;
 M: image-control graft* start-control ;
 M: image-control ungraft* [ stop-control ] [ call-next-method ] bi ;
 PRIVATE>
+
+M: image content-gadget
+    <image-gadget> ;