Clean up ui.gadgets.menus, improve docs, ad add right-click menus to panes and editors with clipboard commands

db4
Slava Pestov 2008-11-30 15:03:05 -06:00
parent b1f855a55f
commit 5fff1bdf05
8 changed files with 66 additions and 43 deletions

View File

@ -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"

View File

@ -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." } ;

View File

@ -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 ;

View File

@ -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"

View File

@ -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 ;

View File

@ -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

View File

@ -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 ] }

View File

@ -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" } ;