From 7a75d2e070ad127f6565376ac87d54007a7a08cc Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 30 Aug 2008 20:06:45 -0500 Subject: [PATCH] Update old accessors from 'ui.gadgets.editors' --- basis/ui/gadgets/editors/editors-docs.factor | 32 +++++++------- basis/ui/gadgets/editors/editors.factor | 44 ++++++++++---------- basis/ui/tools/interactor/interactor.factor | 3 +- 3 files changed, 38 insertions(+), 41 deletions(-) diff --git a/basis/ui/gadgets/editors/editors-docs.factor b/basis/ui/gadgets/editors/editors-docs.factor index 42d300d330..b691668206 100755 --- a/basis/ui/gadgets/editors/editors-docs.factor +++ b/basis/ui/gadgets/editors/editors-docs.factor @@ -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: { $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 } diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index d8810824c6..06a8b4886a 100755 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -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 ; diff --git a/basis/ui/tools/interactor/interactor.factor b/basis/ui/tools/interactor/interactor.factor index 624a6e5b83..20428a39b6 100755 --- a/basis/ui/tools/interactor/interactor.factor +++ b/basis/ui/tools/interactor/interactor.factor @@ -36,8 +36,7 @@ output history flag mailbox thread waiting help ; assoc-stack ] if ; -: ( interactor -- model ) - editor-caret 1/3 seconds ; +: ( interactor -- model ) caret>> 1/3 seconds ; : ( output -- gadget ) interactor new-editor