From f4e8511c0a63836468bd6ec168d88c0e0b060d75 Mon Sep 17 00:00:00 2001 From: nicolas-p Date: Sat, 25 Jul 2015 09:39:46 +0200 Subject: [PATCH] Fixed compatibility issue with labeled gadget --- basis/ui/gadgets/colors/colors.factor | 1 + basis/ui/gadgets/labeled/labeled.factor | 21 ++++++++++++++----- basis/ui/tools/browser/popups/popups.factor | 2 +- basis/ui/tools/error-list/error-list.factor | 6 +++--- basis/ui/tools/inspector/inspector.factor | 4 ++-- .../listener/completion/completion.factor | 4 ++-- basis/ui/tools/listener/listener.factor | 2 +- basis/ui/tools/traceback/traceback.factor | 4 ++-- 8 files changed, 28 insertions(+), 16 deletions(-) diff --git a/basis/ui/gadgets/colors/colors.factor b/basis/ui/gadgets/colors/colors.factor index 3ae3c72e4c..f7428a5bdd 100644 --- a/basis/ui/gadgets/colors/colors.factor +++ b/basis/ui/gadgets/colors/colors.factor @@ -18,6 +18,7 @@ CONSTANT: errors-color COLOR: chocolate1 CONSTANT: details-color COLOR: SlateGray2 CONSTANT: debugger-color COLOR: chocolate1 +CONSTANT: completion-color COLOR: magenta CONSTANT: data-stack-color COLOR: DodgerBlue CONSTANT: retain-stack-color COLOR: HotPink diff --git a/basis/ui/gadgets/labeled/labeled.factor b/basis/ui/gadgets/labeled/labeled.factor index 1e0daea9b3..a5ab87568c 100644 --- a/basis/ui/gadgets/labeled/labeled.factor +++ b/basis/ui/gadgets/labeled/labeled.factor @@ -37,13 +37,24 @@ M: labeled-gadget focusable-child* content>> ; PRIVATE> -: ( gadget title color -- labeled ) +: ( gadget title color -- labeled ) vertical labeled-gadget new-track with-lines swap >>color add-title-bar swap >>content add-content-area ; - -: ( gadget title color -- labeled ) - - COLOR: grey85 >>boundary ; + +: ( gadget title color -- labeled ) + COLOR: grey85 >>boundary ; + +: ( gadget title -- labeled ) + vertical labeled-gadget new-track with-lines + add-title-bar + swap >>content dup content>> + vertical + add-content + { 5 5 } + content-background >>interior + 1 track-add + COLOR: grey85 >>boundary + { 3 3 } ; diff --git a/basis/ui/tools/browser/popups/popups.factor b/basis/ui/tools/browser/popups/popups.factor index b49cfdaeb5..8a65136b8a 100644 --- a/basis/ui/tools/browser/popups/popups.factor +++ b/basis/ui/tools/browser/popups/popups.factor @@ -33,7 +33,7 @@ TUPLE: links-popup < wrapper ; : ( model quot title -- gadget ) [ COLOR: white >>interior ] dip - popup-color links-popup new-wrapper ; + popup-color links-popup new-wrapper ; links-popup H{ { T{ key-down f f "ESC" } [ hide-glass ] } diff --git a/basis/ui/tools/error-list/error-list.factor b/basis/ui/tools/error-list/error-list.factor index 1ed266cbc0..dfb00c9564 100644 --- a/basis/ui/tools/error-list/error-list.factor +++ b/basis/ui/tools/error-list/error-list.factor @@ -168,11 +168,11 @@ error-display "toolbar" f { error-list vertical with-lines error-list f track-add error-list source-file-table>> margins white-interior - "Source files" source-files-color 1/4 track-add + "Source files" source-files-color 1/4 track-add error-list error-table>> margins white-interior - "Errors" errors-color 1/4 track-add + "Errors" errors-color 1/4 track-add error-list error-display>> - "Details" details-color 1/2 track-add + "Details" details-color 1/2 track-add 1 track-add ; M: error-list-gadget focusable-child* diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor index e04bebc2d3..04071798ad 100644 --- a/basis/ui/tools/inspector/inspector.factor +++ b/basis/ui/tools/inspector/inspector.factor @@ -86,8 +86,8 @@ M: hashtable make-slot-descriptions add-toolbar swap >>model dup model>> >>table - dup model>> margins white-interior "Object" object-color f track-add - dup table>> white-interior "Contents" contents-color 1 track-add ; + dup model>> margins white-interior "Object" object-color f track-add + dup table>> white-interior "Contents" contents-color 1 track-add ; M: inspector-gadget focusable-child* table>> ; diff --git a/basis/ui/tools/listener/completion/completion.factor b/basis/ui/tools/listener/completion/completion.factor index 6543c8051a..af3615c975 100644 --- a/basis/ui/tools/listener/completion/completion.factor +++ b/basis/ui/tools/listener/completion/completion.factor @@ -4,7 +4,7 @@ USING: accessors arrays assocs calendar colors colors.constants documents documents.elements fry kernel words sets splitting math math.vectors models.delay models.arrow combinators.short-circuit parser present sequences tools.completion help.vocabs generic fonts -definitions.icons ui.images ui.commands ui.operations ui.gadgets +definitions.icons ui.images ui.commands ui.operations ui.gadgets ui.gadgets.colors ui.gadgets.editors ui.gadgets.glass ui.gadgets.scrollers ui.gadgets.tables ui.gadgets.tracks ui.gadgets.labeled ui.gadgets.worlds ui.gadgets.wrappers ui.gestures ui.pens.solid @@ -154,7 +154,7 @@ GENERIC# accept-completion-hook 1 ( item popup -- ) [ vertical completion-popup new-track ] 2dip [ [ >>interactor ] [ >>completion-mode ] bi* ] [ >>table ] 2bi dup [ ] [ completion-mode>> completion-banner ] bi - COLOR: yellow 1 track-add ; + completion-color 1 track-add ; completion-popup H{ { T{ key-down f f "TAB" } [ table>> row-action ] } diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index b8ff7bec2e..3a82da5e93 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -335,7 +335,7 @@ M: object accept-completion-hook 2drop ; : ( error continuation -- popup ) over compute-restarts [ hide-glass ] - "Error" debugger-color ; + "Error" debugger-color ; : debugger-popup ( interactor error continuation -- ) [ one-line-elt ] 2dip show-listener-popup ; diff --git a/basis/ui/tools/traceback/traceback.factor b/basis/ui/tools/traceback/traceback.factor index 25149c5d85..0b2b2820f7 100644 --- a/basis/ui/tools/traceback/traceback.factor +++ b/basis/ui/tools/traceback/traceback.factor @@ -33,12 +33,12 @@ M: stack-entry-renderer row-value drop object>> ; : ( model quot title color -- gadget ) [ '[ dup _ when ] margins white-interior ] 2dip - ; ! Il attend le titre en dernier + ; : ( model -- gadget ) [ [ call>> callstack. ] when* ] t >>scrolls? margins white-interior - "Call stack" call-stack-color ; + "Call stack" call-stack-color ; : ( model -- gadget ) [ data>> ] "Data stack" data-stack-color ;