continuations destructors documents documents.elements fry hashtables
help help.markup io io.styles kernel lexer listener math models sets
models.delay models.arrow namespaces parser prettyprint quotations
-sequences strings threads tools.vocabs vocabs vocabs.loader
+sequences strings threads vocabs vocabs.refresh vocabs.loader
vocabs.parser words debugger ui ui.commands ui.pens.solid ui.gadgets
ui.gadgets.glass ui.gadgets.buttons ui.gadgets.editors
ui.gadgets.labeled ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.borders ui.gestures
ui.operations ui.tools.browser ui.tools.common ui.tools.debugger
ui.tools.listener.completion ui.tools.listener.popups
-ui.tools.listener.history ui.tools.error-list ;
+ui.tools.listener.history ui.images ui.tools.error-list
+tools.errors.model ;
FROM: source-files.errors => all-errors ;
IN: ui.tools.listener
: interactor-busy? ( interactor -- ? )
#! We're busy if there's no thread to resume.
- [ waiting>> ]
- [ thread>> dup [ thread-registered? ] when ]
- bi and not ;
+ {
+ [ waiting>> ]
+ [ thread>> dup [ thread-registered? ] when ]
+ } 1&& not ;
-SLOT: vocabs
+SLOT: manifest
-M: interactor vocabs>>
+M: interactor manifest>>
dup interactor-busy? [ drop f ] [
- use swap
interactor-continuation name>>
- assoc-stack
+ manifest swap assoc-stack
] if ;
: vocab-exists? ( name -- ? )
drop dup vocab-exists? [ >vocab-link ] [ drop f ] if ;
M: word-completion (word-at-caret)
- vocabs>> assoc-stack ;
+ manifest>> dup [
+ '[ _ _ search-manifest ] [ drop f ] recover
+ ] [ 2drop f ] if ;
M: char-completion (word-at-caret)
2drop f ;
M: interactor dispose drop ;
: go-to-error ( interactor error -- )
- [ line>> 1- ] [ column>> ] bi 2array
+ [ line>> 1 - ] [ column>> ] bi 2array
over set-caret
mark>caret ;
-TUPLE: listener-gadget < tool input output scroller ;
+TUPLE: listener-gadget < tool error-summary output scroller input ;
{ 600 700 } listener-gadget set-tool-dim
: listener-streams ( listener -- input output )
[ input>> ] [ output>> <pane-stream> ] bi ;
-: init-listener ( listener -- listener )
+: init-input/output ( listener -- listener )
<interactor>
[ >>input ] [ pane new-pane t >>scrolls? >>output ] bi
dup listener-streams >>output drop ;
-: <listener-gadget> ( -- gadget )
+: error-summary. ( -- )
+ error-counts keys [
+ H{ { table-gap { 3 3 } } } [
+ [ [ [ icon>> write-image ] with-cell ] each ] with-row
+ ] tabular-output
+ { "Press " { $command tool "common" show-error-list } " to view errors." }
+ print-element
+ ] unless-empty ;
+
+: <error-summary> ( -- gadget )
+ error-list-model get [ drop error-summary. ] <pane-control>
+ COLOR: light-yellow <solid> >>interior ;
+
+: init-error-summary ( listener -- listener )
+ <error-summary> >>error-summary
+ dup error-summary>> f track-add ;
+
+: <listener-gadget> ( -- listener )
vertical listener-gadget new-track
add-toolbar
- init-listener
+ init-input/output
dup output>> <scroller> >>scroller
- dup scroller>> 1 track-add ;
+ dup scroller>> 1 track-add
+ init-error-summary ;
M: listener-gadget focusable-child*
input>> dup popup>> or ;
: clear-stack ( listener -- )
[ [ clear ] \ clear ] dip (call-listener) ;
-: use-if-necessary ( word seq -- )
+: use-if-necessary ( word manifest -- )
2dup [ vocabulary>> ] dip and [
- 2dup [ assoc-stack ] keep = [ 2drop ] [
- [ vocabulary>> vocab-words ] dip push
- ] if
+ manifest [
+ [ vocabulary>> use-vocab ]
+ [ dup name>> associate use-words ] bi
+ ] with-variable
] [ 2drop ] if ;
M: word accept-completion-hook
- interactor>> vocabs>> use-if-necessary ;
+ interactor>> manifest>> use-if-necessary ;
M: object accept-completion-hook 2drop ;
{ T{ key-down f { C+ } "r" } history-completion-popup }
} define-command-map
-: ui-error-summary ( -- )
- error-counts keys [
- [ icon>> 1array \ $image prefix " " 2array ] { } map-as
- { "Press " { $command tool "common" show-error-list } " to view errors." }
- append print-element nl
- ] unless-empty ;
-
: listener-thread ( listener -- )
dup listener-streams [
[ com-browse ] help-hook set
'[ [ _ input>> ] 2dip debugger-popup ] error-hook set
- [ ui-error-summary ] error-summary-hook set
+ error-summary? off
tip-of-the-day. nl
listener
] with-streams* ;
[ call-next-method ] [ restart-listener ] bi ;
M: listener-gadget ungraft*
- [ com-end ] [ call-next-method ] bi ;
\ No newline at end of file
+ [ com-end ] [ call-next-method ] bi ;