Code cleanup, fix stack assertion error
parent
12db389fc2
commit
169b07e0b3
|
@ -7,6 +7,8 @@
|
|||
- variable width word wrap
|
||||
- graphical crossref tool
|
||||
- http://paste.lisp.org/display/30426
|
||||
- C+p: shows newlines as a box
|
||||
- use mach exception handling to trap div by zero on os x
|
||||
|
||||
- menu Command: quots look dumb
|
||||
- top level window positioning on ms windows
|
||||
|
|
|
@ -80,19 +80,19 @@ M: listener-gadget tool-help
|
|||
listener-gadget swap find-tool nip tool-gadget
|
||||
listener-gadget-input interactor-busy? ;
|
||||
|
||||
: find-listener ( -- listener )
|
||||
: get-listener ( -- listener )
|
||||
listener-gadget
|
||||
[ workspace-busy? not ] find-workspace*
|
||||
[ workspace-busy? not ] get-workspace*
|
||||
show-tool tool-gadget ;
|
||||
|
||||
: (call-listener) ( quot listener -- )
|
||||
listener-gadget-input interactor-call ;
|
||||
|
||||
: call-listener ( quot -- )
|
||||
find-listener (call-listener) ;
|
||||
get-listener (call-listener) ;
|
||||
|
||||
: eval-listener ( string -- )
|
||||
find-listener
|
||||
get-listener
|
||||
listener-gadget-input [ set-editor-text ] keep
|
||||
interactor-commit ;
|
||||
|
||||
|
|
|
@ -33,7 +33,7 @@ M: messages compile-error
|
|||
|
||||
: <messages-button> ( -- gadget )
|
||||
"Compiler messages"
|
||||
[ drop find-workspace messages select-tool ]
|
||||
[ find-workspace messages select-tool ]
|
||||
<bevel-button> ;
|
||||
|
||||
M: messages batch-ends
|
||||
|
|
|
@ -80,7 +80,7 @@ M: operation invoke-command ( target operation -- )
|
|||
[ drop ] [ [ "USE: " % % " " % % ] "" make ] if ;
|
||||
|
||||
: insert-word ( word -- )
|
||||
find-listener [ word-completion-string ] keep
|
||||
get-listener [ word-completion-string ] keep
|
||||
listener-gadget-input user-input ;
|
||||
|
||||
[ word? ] H{
|
||||
|
@ -147,7 +147,7 @@ M: operation invoke-command ( target operation -- )
|
|||
{ +primary+ t }
|
||||
{ +name+ "Browse" }
|
||||
{ +keyboard+ T{ key-down f { A+ } "b" } }
|
||||
{ +quot+ [ vocab-link-name find-workspace swap show-vocab-words ] }
|
||||
{ +quot+ [ vocab-link-name get-workspace swap show-vocab-words ] }
|
||||
} define-operation
|
||||
|
||||
[ vocab-link? ] H{
|
||||
|
@ -199,7 +199,7 @@ M: operation invoke-command ( target operation -- )
|
|||
{ +primary+ t }
|
||||
{ +name+ "Browse" }
|
||||
{ +keyboard+ T{ key-down f { A+ } "b" } }
|
||||
{ +quot+ [ find-workspace swap show-module-files ] }
|
||||
{ +quot+ [ get-workspace swap show-module-files ] }
|
||||
} define-operation
|
||||
|
||||
[ module? ] H{
|
||||
|
|
|
@ -34,7 +34,7 @@ search-field H{
|
|||
|
||||
: <search-list> ( seq producer presenter -- gadget )
|
||||
-rot curry <search-model>
|
||||
[ [ workspace? ] find-parent hide-popup ] -rot
|
||||
[ find-workspace hide-popup ] -rot
|
||||
<list> ;
|
||||
|
||||
C: live-search ( string seq producer presenter -- gadget )
|
||||
|
@ -126,7 +126,7 @@ C: history-search ( string seq -- gadget )
|
|||
[ delegate>live-search ] keep ;
|
||||
|
||||
: search-action ( search -- obj )
|
||||
dup [ workspace? ] find-parent hide-popup
|
||||
dup find-workspace hide-popup
|
||||
live-search-list list-value ;
|
||||
|
||||
: show-titled-popup ( workspace gadget title -- )
|
||||
|
|
|
@ -22,6 +22,8 @@ M: gadget tool-help drop f ;
|
|||
|
||||
TUPLE: workspace book popup ;
|
||||
|
||||
: find-workspace [ workspace? ] find-parent ;
|
||||
|
||||
TUPLE: tool gadget ;
|
||||
|
||||
: find-tool ( class workspace -- index tool )
|
||||
|
@ -34,17 +36,17 @@ TUPLE: tool gadget ;
|
|||
|
||||
: select-tool ( workspace class -- ) swap show-tool drop ;
|
||||
|
||||
: find-workspace* ( quot -- workspace )
|
||||
: get-workspace* ( quot -- workspace )
|
||||
[ dup workspace? [ over call ] [ drop f ] if ] find-window
|
||||
[ nip dup raise-window world-gadget ]
|
||||
[ workspace-window drop find-workspace* ] if* ; inline
|
||||
[ workspace-window drop get-workspace* ] if* ; inline
|
||||
|
||||
: find-workspace ( -- workspace ) [ drop t ] find-workspace* ;
|
||||
: get-workspace ( -- workspace ) [ drop t ] get-workspace* ;
|
||||
|
||||
: call-tool ( arg class -- )
|
||||
find-workspace show-tool call-tool* ;
|
||||
get-workspace show-tool call-tool* ;
|
||||
|
||||
: get-tool ( class -- gadget )
|
||||
find-workspace find-tool nip tool-gadget ;
|
||||
get-workspace find-tool nip tool-gadget ;
|
||||
|
||||
: find-messages ( -- gadget ) messages get-tool ;
|
||||
|
|
|
@ -75,7 +75,7 @@ M: walker-gadget tool-help drop "ui-walker" ;
|
|||
|
||||
: walker-step-all ( walker -- )
|
||||
dup [ step-all ] walker-command reset-walker
|
||||
find-workspace listener-gadget select-tool ;
|
||||
get-workspace listener-gadget select-tool ;
|
||||
|
||||
walker-gadget "toolbar" {
|
||||
{ "Step" T{ key-down f f "s" } [ walker-step ] }
|
||||
|
|
Loading…
Reference in New Issue