! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs calendar combinators locals
-colors.constants combinators.short-circuit compiler.units
-concurrency.flags concurrency.mailboxes continuations destructors
-documents documents.elements fry hashtables help help.markup io
-io.styles kernel lexer listener math models models.delay models.arrow
-namespaces parser prettyprint quotations sequences strings threads
-tools.vocabs vocabs vocabs.loader vocabs.parser words debugger ui ui.commands
-ui.pens.solid ui.gadgets ui.gadgets.glass ui.gadgets.buttons ui.gadgets.editors
+source-files.errors colors.constants combinators.short-circuit
+compiler.units help.tips concurrency.flags concurrency.mailboxes
+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 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.listener.history ui.images ui.tools.error-list
+tools.errors.model ;
+FROM: source-files.errors => all-errors ;
IN: ui.tools.listener
! If waiting is t, we're waiting for user input, and invoking
: 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 ;
: listener-run-files ( seq -- )
[
- [ \ listener-run-files ] dip
- '[ _ [ run-file ] each ] call-listener
+ '[ _ [ run-file ] each ]
+ \ listener-run-files
+ call-listener
] unless-empty ;
: com-end ( listener -- )
: 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
-: welcome. ( -- )
- "If this is your first time with Factor, please read the " print
- "handbook" ($link) ". To see a list of keyboard shortcuts," print
- "press F1." print nl ;
-
: listener-thread ( listener -- )
dup listener-streams [
[ com-browse ] help-hook set
'[ [ _ input>> ] 2dip debugger-popup ] error-hook set
- welcome.
+ error-summary? off
+ tip-of-the-day. nl
listener
] with-streams* ;
[ wait-for-listener ]
} cleave ;
-: listener-help ( -- ) "ui-listener" com-browse ;
+: listener-help ( -- ) "help.home" com-browse ;
\ listener-help H{ { +nullary+ t } } define-command
[ 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 ;
projects / factor.git / blobdiff