Update old accessors from 'ui.gadgets.editors'
parent
4bebffd170
commit
7a75d2e070
|
@ -7,32 +7,34 @@ HELP: editor
|
|||
$nl
|
||||
"Editors have the following slots:"
|
||||
{ $list
|
||||
{ { $link editor-font } " - a font specifier." }
|
||||
{ { $link editor-color } " - text color specifier." }
|
||||
{ { $link editor-caret-color } " - caret color specifier." }
|
||||
{ { $link editor-selection-color } " - selection background color specifier." }
|
||||
{ { $link editor-caret } " - a model storing a line/column pair." }
|
||||
{ { $link editor-mark } " - a model storing a line/column pair. If there is no selection, the mark is equal to the caret, otherwise the mark is located at the opposite end of the selection from the caret." }
|
||||
{ { $link editor-focused? } " - a boolean." }
|
||||
{ { $snippet "font" } " - a font specifier." }
|
||||
{ { $snippet "color" } " - text color specifier." }
|
||||
{ { $snippet "caret-color" } " - caret color specifier." }
|
||||
{ { $snippet "selection-color" } " - selection background color specifier." }
|
||||
{ { $snippet "caret" } " - a model storing a line/column pair." }
|
||||
{ { $snippet "mark" } " - a model storing a line/column pair. If there is no selection, the mark is equal to the caret, otherwise the mark is located at the opposite end of the selection from the caret." }
|
||||
{ { $snippet "focused?" } " - a boolean." }
|
||||
} } ;
|
||||
|
||||
HELP: <editor>
|
||||
{ $values { "editor" "a new " { $link editor } } }
|
||||
{ $description "Creates a new " { $link editor } " with an empty document." } ;
|
||||
|
||||
HELP: editor-caret ( editor -- caret )
|
||||
{ $values { "editor" editor } { "caret" model } }
|
||||
{ $description "Outputs a " { $link model } " holding the current caret location." } ;
|
||||
! 'editor-caret' is now an old accessor, but it's documented as a word here. Maybe move this description somewhere else.
|
||||
|
||||
{ editor-caret editor-caret* editor-mark editor-mark* } related-words
|
||||
! 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 ( 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" } }
|
||||
|
@ -74,9 +76,7 @@ HELP: set-editor-string
|
|||
|
||||
ARTICLE: "gadgets-editors-selection" "The caret and mark"
|
||||
"If there is no selection, the caret and the mark are at the same location; otherwise the mark delimits the end-point of the selection opposite the caret."
|
||||
{ $subsection editor-caret }
|
||||
{ $subsection editor-caret* }
|
||||
{ $subsection editor-mark }
|
||||
{ $subsection editor-mark* }
|
||||
{ $subsection change-caret }
|
||||
{ $subsection change-caret&mark }
|
||||
|
|
|
@ -47,35 +47,35 @@ focused? ;
|
|||
|
||||
M: editor graft*
|
||||
dup
|
||||
dup editor-caret activate-editor-model
|
||||
dup editor-mark activate-editor-model ;
|
||||
dup caret>> activate-editor-model
|
||||
dup mark>> activate-editor-model ;
|
||||
|
||||
M: editor ungraft*
|
||||
dup
|
||||
dup editor-caret deactivate-editor-model
|
||||
dup editor-mark deactivate-editor-model ;
|
||||
dup caret>> deactivate-editor-model
|
||||
dup mark>> deactivate-editor-model ;
|
||||
|
||||
: editor-caret* ( editor -- loc ) editor-caret model-value ;
|
||||
: editor-caret* ( editor -- loc ) caret>> model-value ;
|
||||
|
||||
: editor-mark* ( editor -- loc ) editor-mark model-value ;
|
||||
: editor-mark* ( editor -- loc ) mark>> model-value ;
|
||||
|
||||
: set-caret ( loc editor -- )
|
||||
[ model>> validate-loc ] keep
|
||||
editor-caret set-model ;
|
||||
caret>> set-model ;
|
||||
|
||||
: change-caret ( editor quot -- )
|
||||
over >r >r dup editor-caret* swap model>> r> call r>
|
||||
set-caret ; inline
|
||||
|
||||
: mark>caret ( editor -- )
|
||||
dup editor-caret* swap editor-mark set-model ;
|
||||
dup editor-caret* swap mark>> set-model ;
|
||||
|
||||
: change-caret&mark ( editor quot -- )
|
||||
over >r change-caret r> mark>caret ; inline
|
||||
|
||||
: editor-line ( n editor -- str ) control-value nth ;
|
||||
|
||||
: editor-font* ( editor -- font ) editor-font open-font ;
|
||||
: editor-font* ( editor -- font ) font>> open-font ;
|
||||
|
||||
: line-height ( editor -- n )
|
||||
editor-font* "" string-height ;
|
||||
|
@ -96,11 +96,9 @@ M: editor ungraft*
|
|||
: click-loc ( editor model -- )
|
||||
>r clicked-loc r> set-model ;
|
||||
|
||||
: focus-editor ( editor -- )
|
||||
t over set-editor-focused? relayout-1 ;
|
||||
: focus-editor ( editor -- ) t over (>>focused?) relayout-1 ;
|
||||
|
||||
: unfocus-editor ( editor -- )
|
||||
f over set-editor-focused? relayout-1 ;
|
||||
: unfocus-editor ( editor -- ) f over (>>focused?) relayout-1 ;
|
||||
|
||||
: (offset>x) ( font col# str -- x )
|
||||
swap head-slice string-width ;
|
||||
|
@ -127,9 +125,9 @@ M: editor ungraft*
|
|||
] when drop ;
|
||||
|
||||
: draw-caret ( -- )
|
||||
editor get editor-focused? [
|
||||
editor get focused?>> [
|
||||
editor get
|
||||
dup editor-caret-color set-color
|
||||
dup caret-color>> set-color
|
||||
dup caret-loc origin get v+
|
||||
swap caret-dim over v+
|
||||
[ { 0.5 -0.5 } v+ ] bi@ gl-line
|
||||
|
@ -142,7 +140,7 @@ M: editor ungraft*
|
|||
line-translation gl-translate ;
|
||||
|
||||
: draw-line ( editor str -- )
|
||||
>r editor-font r> { 0 0 } draw-string ;
|
||||
>r font>> r> { 0 0 } draw-string ;
|
||||
|
||||
: first-visible-line ( editor -- n )
|
||||
clip get rect-loc second origin get second -
|
||||
|
@ -173,7 +171,7 @@ M: editor ungraft*
|
|||
|
||||
: draw-lines ( -- )
|
||||
\ first-visible-line get [
|
||||
editor get dup editor-color set-color
|
||||
editor get dup color>> set-color
|
||||
dup visible-lines
|
||||
[ draw-line 1 translate-lines ] with each
|
||||
] with-editor-translation ;
|
||||
|
@ -192,7 +190,7 @@ M: editor ungraft*
|
|||
(draw-selection) ;
|
||||
|
||||
: draw-selection ( -- )
|
||||
editor get editor-selection-color set-color
|
||||
editor get selection-color>> set-color
|
||||
editor get selection-start/end
|
||||
over first [
|
||||
2dup [
|
||||
|
@ -244,7 +242,7 @@ M: editor user-input*
|
|||
M: editor gadget-text* editor-string % ;
|
||||
|
||||
: extend-selection ( editor -- )
|
||||
dup request-focus dup editor-caret click-loc ;
|
||||
dup request-focus dup caret>> click-loc ;
|
||||
|
||||
: mouse-elt ( -- element )
|
||||
hand-click# get {
|
||||
|
@ -272,8 +270,8 @@ M: editor gadget-text* editor-string % ;
|
|||
|
||||
: drag-selection ( editor -- )
|
||||
dup drag-caret&mark
|
||||
pick editor-mark set-model
|
||||
swap editor-caret set-model ;
|
||||
pick mark>> set-model
|
||||
swap caret>> set-model ;
|
||||
|
||||
: editor-cut ( editor clipboard -- )
|
||||
dupd gadget-copy remove-selection ;
|
||||
|
@ -305,7 +303,7 @@ M: editor gadget-text* editor-string % ;
|
|||
dupd editor-select-next mark>caret ;
|
||||
|
||||
: editor-select ( from to editor -- )
|
||||
tuck editor-caret set-model editor-mark set-model ;
|
||||
tuck caret>> set-model mark>> set-model ;
|
||||
|
||||
: select-elt ( editor elt -- )
|
||||
over >r
|
||||
|
@ -318,7 +316,7 @@ M: editor gadget-text* editor-string % ;
|
|||
|
||||
: position-caret ( editor -- )
|
||||
mouse-elt dup T{ one-char-elt } =
|
||||
[ drop dup extend-selection dup editor-mark click-loc ]
|
||||
[ drop dup extend-selection dup mark>> click-loc ]
|
||||
[ select-elt ] if ;
|
||||
|
||||
: insert-newline ( editor -- ) "\n" swap user-input ;
|
||||
|
|
|
@ -36,8 +36,7 @@ output history flag mailbox thread waiting help ;
|
|||
assoc-stack
|
||||
] if ;
|
||||
|
||||
: <help-model> ( interactor -- model )
|
||||
editor-caret 1/3 seconds <delay> ;
|
||||
: <help-model> ( interactor -- model ) caret>> 1/3 seconds <delay> ;
|
||||
|
||||
: <interactor> ( output -- gadget )
|
||||
interactor new-editor
|
||||
|
|
Loading…
Reference in New Issue