From 4bebffd17096ea689e3a9047d28aa2658165ab7f Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 30 Aug 2008 19:52:40 -0500
Subject: [PATCH 1/2] Update usages of old accessors from 'ui.gadgets.buttons'
---
basis/ui/gadgets/buttons/buttons-docs.factor | 10 +++++-----
basis/ui/gadgets/buttons/buttons.factor | 17 ++++++++---------
2 files changed, 13 insertions(+), 14 deletions(-)
diff --git a/basis/ui/gadgets/buttons/buttons-docs.factor b/basis/ui/gadgets/buttons/buttons-docs.factor
index b975416e97..c4edaac144 100755
--- a/basis/ui/gadgets/buttons/buttons-docs.factor
+++ b/basis/ui/gadgets/buttons/buttons-docs.factor
@@ -7,7 +7,7 @@ HELP: button
$nl
"A button's appearance can vary depending on the state of the mouse button if the " { $snippet "interior" } " or " { $snippet "boundary" } " slots are set to instances of " { $link button-paint } "."
$nl
-"A button can be selected, which is distinct from being pressed. This state is held in the " { $link button-selected? } " slot, and is used by the " { $link <toggle-buttons> } " word to construct a row of buttons for choosing among several alternatives." } ;
+"A button can be selected, which is distinct from being pressed. This state is held in the " { $snippet "selected?" } " slot, and is used by the " { $link <toggle-buttons> } " word to construct a row of buttons for choosing among several alternatives." } ;
HELP: <button>
{ $values { "label" gadget } { "quot" "a quotation with stack effect " { $snippet "( button -- )" } } { "button" "a new " { $link button } } }
@@ -28,10 +28,10 @@ HELP: <repeat-button>
HELP: button-paint
{ $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " gneeric words by delegating to an object in one of four slots which depend on the state of the button being drawn:"
{ $list
- { { $link button-paint-plain } " - the button is inactive" }
- { { $link button-paint-rollover } " - the button is under the mouse" }
- { { $link button-paint-pressed } " - the button is under the mouse and a mouse button is held down" }
- { { $link button-paint-selected } " - the button is selected (see " { $link <toggle-buttons> } }
+ { { $snippet "plain" } " - the button is inactive" }
+ { { $snippet "rollover" } " - the button is under the mouse" }
+ { { $snippet "pressed" } " - the button is under the mouse and a mouse button is held down" }
+ { { $snippet "selected" } " - the button is selected (see " { $link <toggle-buttons> } }
}
"The " { $link <roll-button> } " and " { $link <bevel-button> } " words create " { $link button } " instances with specific " { $link button-paint } "." } ;
diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor
index 09bf036c9a..b5e8e8a1e1 100755
--- a/basis/ui/gadgets/buttons/buttons.factor
+++ b/basis/ui/gadgets/buttons/buttons.factor
@@ -25,14 +25,13 @@ TUPLE: button < border pressed? selected? quot ;
dup mouse-clicked?
over button-rollover? and
buttons-down? and
- over set-button-pressed?
+ over (>>pressed?)
relayout-1 ;
: if-clicked ( button quot -- )
>r dup button-update dup button-rollover? r> [ drop ] if ;
-: button-clicked ( button -- )
- dup button-quot if-clicked ;
+: button-clicked ( button -- ) dup quot>> if-clicked ;
button H{
{ T{ button-up } [ button-clicked ] }
@@ -106,7 +105,7 @@ TUPLE: checkmark-paint color ;
C: <checkmark-paint> checkmark-paint
M: checkmark-paint draw-interior
- checkmark-paint-color set-color
+ color>> set-color
origin get [
rect-dim
{ 0 0 } over gl-line
@@ -145,18 +144,18 @@ TUPLE: checkbox < button ;
swap >>model ;
M: checkbox model-changed
- swap model-value over set-button-selected? relayout-1 ;
+ swap model-value over (>>selected?) relayout-1 ;
TUPLE: radio-paint color ;
C: <radio-paint> radio-paint
M: radio-paint draw-interior
- radio-paint-color set-color
+ color>> set-color
origin get { 4 4 } v+ swap rect-dim { 8 8 } v- 12 gl-fill-circle ;
M: radio-paint draw-boundary
- radio-paint-color set-color
+ color>> set-color
origin get { 1 1 } v+ swap rect-dim { 2 2 } v- 12 gl-circle ;
: radio-knob-theme ( gadget -- )
@@ -184,8 +183,8 @@ TUPLE: radio-control < button value ;
M: radio-control model-changed
swap model-value
- over radio-control-value =
- over set-button-selected?
+ over value>> =
+ over (>>selected?)
relayout-1 ;
: <radio-controls> ( parent model assoc quot -- parent )
From 7a75d2e070ad127f6565376ac87d54007a7a08cc Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 30 Aug 2008 20:06:45 -0500
Subject: [PATCH 2/2] 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: <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 }
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 ;
-: <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