Clean up ui.gadgets.menus, improve docs, ad add right-click menus to panes and editors with clipboard commands
parent
b1f855a55f
commit
5fff1bdf05
|
@ -71,3 +71,5 @@ ARTICLE: "ui.gadgets.buttons" "Button gadgets"
|
|||
{ $subsection button-paint }
|
||||
"Button constructors take " { $emphasis "label specifiers" } " as input. A label specifier is either a string, an array of strings, a gadget or " { $link f } "."
|
||||
{ $see-also <command-button> "ui-commands" } ;
|
||||
|
||||
ABOUT: "ui.gadgets.buttons"
|
||||
|
|
|
@ -20,22 +20,12 @@ HELP: <editor>
|
|||
{ $values { "editor" "a new " { $link editor } } }
|
||||
{ $description "Creates a new " { $link editor } " with an empty document." } ;
|
||||
|
||||
! 'editor-caret' is now an old accessor, but it's documented as a word here. Maybe move this description somewhere else.
|
||||
|
||||
! HELP: editor-caret ( editor -- caret )
|
||||
! { $values { "editor" editor } { "caret" model } }
|
||||
! { $description "Outputs a " { $link model } " holding the current caret location." } ;
|
||||
|
||||
{ editor-caret* editor-mark* } related-words
|
||||
|
||||
HELP: editor-caret*
|
||||
{ $values { "editor" editor } { "loc" "a pair of integers" } }
|
||||
{ $description "Outputs the current caret location as a line/column number pair." } ;
|
||||
|
||||
! HELP: editor-mark ( editor -- mark )
|
||||
! { $values { "editor" editor } { "mark" model } }
|
||||
! { $description "Outputs a " { $link model } " holding the current mark location." } ;
|
||||
|
||||
HELP: editor-mark*
|
||||
{ $values { "editor" editor } { "loc" "a pair of integers" } }
|
||||
{ $description "Outputs the current mark location as a line/column number pair." } ;
|
||||
|
|
|
@ -6,7 +6,8 @@ io.styles math.vectors sorting colors combinators assocs
|
|||
math.order fry calendar alarms ui.clipboards ui.commands
|
||||
ui.gadgets ui.gadgets.borders ui.gadgets.buttons
|
||||
ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.theme
|
||||
ui.gadgets.wrappers ui.render ui.gestures math.geometry.rect ;
|
||||
ui.gadgets.menus ui.gadgets.wrappers ui.render ui.gestures
|
||||
math.geometry.rect ;
|
||||
IN: ui.gadgets.editors
|
||||
|
||||
TUPLE: editor < gadget
|
||||
|
@ -515,6 +516,13 @@ editor "selection" f {
|
|||
{ T{ key-down f { S+ C+ } "END" } select-end-of-document }
|
||||
} define-command-map
|
||||
|
||||
: editor-menu ( editor -- )
|
||||
{ cut com-copy paste } show-commands-menu ;
|
||||
|
||||
editor "misc" f {
|
||||
{ T{ button-down f f 3 } editor-menu }
|
||||
} define-command-map
|
||||
|
||||
! Multi-line editors
|
||||
TUPLE: multiline-editor < editor ;
|
||||
|
||||
|
|
|
@ -3,9 +3,22 @@ kernel ;
|
|||
IN: ui.gadgets.menus
|
||||
|
||||
HELP: <commands-menu>
|
||||
{ $values { "hook" { $quotation "( button -- )" } } { "target" object } { "commands" "a sequence of commands" } { "gadget" "a new " { $link gadget } } }
|
||||
{ $values { "target" object } { "commands" "a sequence of commands" } { "hook" { $quotation "( button -- )" } } { "menu" "a new " { $link gadget } } }
|
||||
{ $description "Creates a popup menu of commands which are to be invoked on " { $snippet "target" } ". The " { $snippet "hook" } " quotation is run before a command is invoked." } ;
|
||||
|
||||
HELP: show-menu
|
||||
{ $values { "gadget" gadget } { "owner" gadget } }
|
||||
{ $description "Displays a popup menu in the " { $link world } " containing " { $snippet "owner" } " at the current mouse location." } ;
|
||||
{ $values { "owner" gadget } { "menu" gadget } }
|
||||
{ $description "Displays a popup menu in the " { $link world } " containing " { $snippet "owner" } " at the current mouse location. The popup menu can be any gadget." } ;
|
||||
|
||||
HELP: show-commands-menu
|
||||
{ $values { "owner" gadget } { "commands" "a sequence of commands" } }
|
||||
{ $description "Displays a popup menu with the given commands. This is just a convenience word that combines " { $link <commands-menu> } " with " { $link show-menu } "." }
|
||||
{ $notes "Useful for right-click context menus." } ;
|
||||
|
||||
ARTICLE: "ui.gadgets.menus" "Popup menus"
|
||||
"The " { $vocab-link "ui.gadgets.menus" } " vocabulary implements popup menus."
|
||||
{ $subsection <commands-menu> }
|
||||
{ $subsection show-menu }
|
||||
{ $subsection show-commands-menu } ;
|
||||
|
||||
ABOUT: "ui.gadgets.menus"
|
||||
|
|
|
@ -1,10 +1,10 @@
|
|||
! Copyright (C) 2005, 2007 Slava Pestov.
|
||||
! Copyright (C) 2005, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays ui.commands ui.gadgets ui.gadgets.buttons
|
||||
ui.gadgets.worlds ui.gestures generic hashtables kernel math
|
||||
models namespaces opengl sequences math.vectors
|
||||
ui.gadgets.theme ui.gadgets.packs ui.gadgets.borders colors
|
||||
math.geometry.rect ;
|
||||
USING: locals accessors arrays ui.commands ui.gadgets
|
||||
ui.gadgets.buttons ui.gadgets.worlds ui.gestures generic
|
||||
hashtables kernel math models namespaces opengl sequences
|
||||
math.vectors ui.gadgets.theme ui.gadgets.packs
|
||||
ui.gadgets.borders colors math.geometry.rect ;
|
||||
IN: ui.gadgets.menus
|
||||
|
||||
: menu-loc ( world menu -- loc )
|
||||
|
@ -12,9 +12,9 @@ IN: ui.gadgets.menus
|
|||
|
||||
TUPLE: menu-glass < gadget ;
|
||||
|
||||
: <menu-glass> ( menu world -- glass )
|
||||
: <menu-glass> ( world menu -- glass )
|
||||
tuck menu-loc >>loc
|
||||
menu-glass new-gadget
|
||||
[ over menu-loc >>loc ] dip
|
||||
swap add-gadget ;
|
||||
|
||||
M: menu-glass layout* gadget-child prefer ;
|
||||
|
@ -22,30 +22,35 @@ M: menu-glass layout* gadget-child prefer ;
|
|||
: hide-glass ( world -- )
|
||||
[ [ unparent ] when* f ] change-glass drop ;
|
||||
|
||||
: show-glass ( gadget world -- )
|
||||
dup hide-glass
|
||||
swap [ hand-clicked set-global ] [ >>glass ] bi
|
||||
dup glass>> add-gadget drop ;
|
||||
: show-glass ( world gadget -- )
|
||||
[ [ hide-glass ] [ hand-clicked set-global ] bi* ]
|
||||
[ add-gadget drop ]
|
||||
[ >>glass drop ]
|
||||
2tri ;
|
||||
|
||||
: show-menu ( gadget owner -- )
|
||||
find-world [ <menu-glass> ] keep show-glass ;
|
||||
: show-menu ( owner menu -- )
|
||||
[ find-world dup ] dip <menu-glass> show-glass ;
|
||||
|
||||
\ menu-glass H{
|
||||
{ T{ button-down } [ find-world [ hide-glass ] when* ] }
|
||||
{ T{ drag } [ update-clicked drop ] }
|
||||
} set-gestures
|
||||
|
||||
: <menu-item> ( hook target command -- button )
|
||||
dup command-name -rot command-button-quot
|
||||
swapd
|
||||
[ hand-clicked get find-world hide-glass ]
|
||||
3append <roll-button> ;
|
||||
:: <menu-item> ( target hook command -- button )
|
||||
command command-name [
|
||||
hook call
|
||||
target command command-button-quot call
|
||||
hand-clicked get find-world hide-glass
|
||||
] <roll-button> ;
|
||||
|
||||
: menu-theme ( gadget -- gadget )
|
||||
light-gray solid-interior
|
||||
faint-boundary ;
|
||||
|
||||
: <commands-menu> ( hook target commands -- gadget )
|
||||
: <commands-menu> ( target hook commands -- menu )
|
||||
[ <filled-pile> ] 3dip
|
||||
[ <menu-item> add-gadget ] with with each
|
||||
[ <menu-item> add-gadget ] with with each
|
||||
5 <border> menu-theme ;
|
||||
|
||||
: show-commands-menu ( target commands -- )
|
||||
[ dup [ ] ] dip <commands-menu> show-menu ;
|
||||
|
|
|
@ -3,10 +3,10 @@
|
|||
USING: arrays ui.gadgets ui.gadgets.borders ui.gadgets.buttons
|
||||
ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.paragraphs
|
||||
ui.gadgets.incremental ui.gadgets.packs ui.gadgets.theme
|
||||
ui.clipboards ui.gestures ui.traverse ui.render hashtables io
|
||||
kernel namespaces sequences io.styles strings quotations math
|
||||
opengl combinators math.vectors sorting splitting
|
||||
io.streams.nested assocs ui.gadgets.presentations
|
||||
ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render
|
||||
hashtables io kernel namespaces sequences io.styles strings
|
||||
quotations math opengl combinators math.vectors sorting
|
||||
splitting io.streams.nested assocs ui.gadgets.presentations
|
||||
ui.gadgets.slots ui.gadgets.grids ui.gadgets.grid-lines
|
||||
classes.tuple models continuations destructors accessors
|
||||
math.geometry.rect fry ;
|
||||
|
@ -398,6 +398,8 @@ M: f sloppy-pick-up*
|
|||
dup request-focus
|
||||
com-copy-selection ;
|
||||
|
||||
: pane-menu ( pane -- ) { com-copy } show-commands-menu ;
|
||||
|
||||
pane H{
|
||||
{ T{ button-down } [ begin-selection ] }
|
||||
{ T{ button-down f { S+ } 1 } [ select-to-caret ] }
|
||||
|
@ -405,4 +407,5 @@ pane H{
|
|||
{ T{ button-up } [ end-selection ] }
|
||||
{ T{ drag } [ extend-selection ] }
|
||||
{ T{ copy-action } [ com-copy ] }
|
||||
{ T{ button-down f f 3 } [ pane-menu ] }
|
||||
} set-gestures
|
||||
|
|
|
@ -36,12 +36,13 @@ M: presentation ungraft*
|
|||
call-next-method ;
|
||||
|
||||
: <operations-menu> ( presentation -- menu )
|
||||
dup dup hook>> curry
|
||||
swap object>>
|
||||
dup object-operations <commands-menu> ;
|
||||
[ object>> ]
|
||||
[ dup hook>> curry ]
|
||||
[ object>> object-operations ]
|
||||
tri <commands-menu> ;
|
||||
|
||||
: operations-menu ( presentation -- )
|
||||
dup <operations-menu> swap show-menu ;
|
||||
dup <operations-menu> show-menu ;
|
||||
|
||||
presentation H{
|
||||
{ T{ button-down f f 3 } [ operations-menu ] }
|
||||
|
|
|
@ -95,6 +95,7 @@ ARTICLE: "gadgets" "Pre-made UI gadgets"
|
|||
{ $subsection "ui.gadgets.sliders" }
|
||||
{ $subsection "ui.gadgets.scrollers" }
|
||||
{ $subsection "gadgets-editors" }
|
||||
{ $subsection "ui.gadgets.menus" }
|
||||
{ $subsection "ui.gadgets.panes" }
|
||||
{ $subsection "ui.gadgets.presentations" }
|
||||
{ $subsection "ui.gadgets.lists" } ;
|
||||
|
|
Loading…
Reference in New Issue