52 lines
1.4 KiB
Factor
52 lines
1.4 KiB
Factor
! Copyright (C) 2005 Slava Pestov.
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
IN: gadgets
|
|
USING: generic hashtables inspector io jedit kernel lists memory
|
|
namespaces parser prettyprint sequences styles vectors words ;
|
|
|
|
SYMBOL: commands
|
|
|
|
global [ 100 <vector> commands set ] bind
|
|
|
|
: define-command ( class name quot -- )
|
|
3list commands get push ;
|
|
|
|
: applicable ( object -- )
|
|
commands get >list
|
|
[ car "predicate" word-prop call ] subset-with ;
|
|
|
|
DEFER: pane-call
|
|
|
|
: command-menu ( pane -- menu )
|
|
presented get dup applicable [
|
|
3dup third [
|
|
[ swap literal, % ] make-list , ,
|
|
[ pane-call drop ] %
|
|
] make-list >r second r> cons
|
|
] map 2nip ;
|
|
|
|
: init-commands ( gadget pane -- )
|
|
over presented paint-prop [
|
|
[ drop ] swap
|
|
unit
|
|
[ command-menu <menu> show-menu ] append3
|
|
button-gestures
|
|
] [
|
|
2drop
|
|
] ifte ;
|
|
|
|
: <styled-label> ( style text -- label )
|
|
<label> swap alist>hash over set-gadget-paint ;
|
|
|
|
: <presentation> ( style text pane -- presentation )
|
|
>r <styled-label> dup r> init-commands ;
|
|
|
|
object "Prettyprint" [ prettyprint ] define-command
|
|
object "Inspect" [ inspect ] define-command
|
|
object "References" [ references inspect ] define-command
|
|
|
|
\ word "See" [ see ] define-command
|
|
\ word "Execute" [ execute ] define-command
|
|
\ word "Usage" [ usage . ] define-command
|
|
\ word "jEdit" [ jedit ] define-command
|