Commit 286018ee authored by bp's avatar bp
Browse files

Quotation syntax changed from :[ ]: to [: ;]

git-svn-id: https://forth-ev.de/repos/bigforth@2149 3b8d8251-53f3-0310-8f3b-fd1cb8370982
parent 3fc46df2
......@@ -356,8 +356,8 @@ hscaler implements
: subbox ( -- )
^ M[ slide ]M ['] part0a ['] part5 arule new
^ R[ lpage ]R ['] part1 ['] part0b hslider-p Eside new
^ M[ slide ]M :[ part4 swap 2* xS + swap ]:
:[ part0a swap xS 2* + swap ]:
^ M[ slide ]M [: part4 swap 2* xS + swap ;]
[: part0a swap xS 2* + swap ;]
hslider-f hslider-d Erule new
arule with $01000003 assign ^ endwith
^ R[ rpage ]R ['] part3 ['] part0b hslider-p Eside new
......@@ -369,8 +369,8 @@ vscaler implements
: subbox ( -- )
^ M[ slide ]M ['] part5 ['] part0a arule new
^ R[ rpage ]R ['] part0b ['] part3 vslider-p Eside new
^ M[ slide ]M :[ part0a swap xS 2* + swap ]:
:[ part4 swap 2* xS + swap ]:
^ M[ slide ]M [: part0a swap xS 2* + swap ;]
[: part4 swap 2* xS + swap ;]
vslider-f vslider-d Erule new
arule with $01000003 assign ^ endwith
^ R[ lpage ]R ['] part0b ['] part1 vslider-p Eside new
......
......@@ -422,7 +422,7 @@ hslider implements
: part0b xN 0 ;
: init ( callback -- ) >callback
^ R[ lstep ]R 0 slidetri new \ 1 ^ habox new fixbox
^ R[ lpage ]R :[ part1 part0 drop 2/ 0 p+ ]: ['] part0
^ R[ lpage ]R [: part1 part0 drop 2/ 0 p+ ;] ['] part0
hslider-pl hslider-pms hslider-fl hslider-dl Eleft new
^ M[ slide ]M ['] part2' ['] part0 hslider-fls hslider-dls Erule new
arule with $02000003 assign ^ endwith
......@@ -430,7 +430,7 @@ hslider implements
arule with $01000003 assign ^ endwith
^ M[ slide ]M ['] part2' ['] part0 hslider-frs hslider-dls Erule new
arule with $02000003 assign ^ endwith
^ R[ rpage ]R :[ part3 part0 drop 2/ 0 p+ ]: ['] part0
^ R[ rpage ]R [: part3 part0 drop 2/ 0 p+ ;] ['] part0
hslider-pr hslider-pms hslider-fr hslider-dr Eright new
^ R[ rstep ]R 2 slidetri new \ 1 ^ habox new fixbox
7 super init ;
......@@ -447,7 +447,7 @@ hscaler implements
: part4' ( -- glue ) part4 swap xM xS 2* - 2/ - 1 max swap ;
: init ( callback -- ) >callback
^ M[ slide ]M ['] part0a ['] part5 arule new
^ R[ lpage ]R :[ part1 part0c drop 2/ 0 p+ ]: ['] part0c
^ R[ lpage ]R [: part1 part0c drop 2/ 0 p+ ;] ['] part0c
hslider-pl hslider-pms hslider-fl hslider-dl Eleft new
arule with $01000003 assign ^ endwith
^ M[ slide ]M ['] part4' ['] part0c hslider-fls hslider-dls Erule new
......@@ -457,7 +457,7 @@ hscaler implements
^ M[ slide ]M ['] part4' ['] part0c hslider-frs hslider-drs Erule new
arule with $01000003 assign ^ endwith
3 hbox new
^ R[ rpage ]R :[ part3 part0c drop 2/ 0 p+ ]: ['] part0c
^ R[ rpage ]R [: part3 part0c drop 2/ 0 p+ ;] ['] part0c
hslider-pr hslider-pms hslider-fr hslider-dr Eright new
arule with $01000003 assign ^ endwith
3 hbox new
......@@ -470,7 +470,7 @@ vscaler implements
: part4'v ( -- glue ) part4 swap xM xS 2* - 2/ - 1 max swap ;
: init ( callback -- ) >callback
^ M[ slide ]M ['] part5 ['] part0a arule new
^ R[ rpage ]R ['] part0cv :[ part3 part0cv drop 2/ 0 p+ ]:
^ R[ rpage ]R ['] part0cv [: part3 part0cv drop 2/ 0 p+ ;]
vslider-pt vslider-pms vslider-ft vslider-dt Etop new
arule with $01000003 assign ^ endwith
^ M[ slide ]M ['] part0cv ['] part4'v vslider-fts vslider-dts Erule new
......@@ -480,7 +480,7 @@ vscaler implements
^ M[ slide ]M ['] part0cv ['] part4'v vslider-fbs vslider-dbs Erule new
arule with $01000003 assign ^ endwith
3 vbox new
^ R[ lpage ]R ['] part0cv :[ part1 part0cv drop 2/ 0 p+ ]:
^ R[ lpage ]R ['] part0cv [: part1 part0cv drop 2/ 0 p+ ;]
vslider-pb vslider-pms vslider-fb vslider-db Ebot new
arule with $01000003 assign ^ endwith
3 vbox new
......@@ -493,7 +493,7 @@ vslider implements
: part0bv xN 0 ;
: init ( callback -- ) >callback
^ R[ lstep ]R 1 slidetri new \ 1 ^ habox new fixbox
^ R[ lpage ]R ['] part0 :[ part1 part0 drop 2/ 0 p+ ]:
^ R[ lpage ]R ['] part0 [: part1 part0 drop 2/ 0 p+ ;]
vslider-pt vslider-pms vslider-ft vslider-dt Etop new
^ M[ slide ]M ['] part0 ['] part2'v vslider-fts vslider-dts Erule new
arule with $02000003 assign ^ endwith
......@@ -501,7 +501,7 @@ vslider implements
arule with $02000003 assign ^ endwith
^ M[ slide ]M ['] part0 ['] part2'v vslider-fbs vslider-dbs Erule new
arule with $02000003 assign ^ endwith
^ R[ rpage ]R ['] part0 :[ part3 part0 drop 2/ 0 p+ ]:
^ R[ rpage ]R ['] part0 [: part3 part0 drop 2/ 0 p+ ;]
vslider-pb vslider-pms vslider-fb vslider-db Ebot new
^ R[ rstep ]R 3 slidetri new \ 1 ^ habox new fixbox
7 super init ;
......
......@@ -157,37 +157,37 @@ class;
\ actor simplification 05mar07py
: noop-i ; immediate
synonym S[ :[
synonym DT[ :[
synonym T[ :[
synonym TS[ :[
synonym CK[ :[
synonym SC[ :[
synonym SL[ :[
synonym ]T[ :[
synonym S[ [:
synonym DT[ [:
synonym T[ [:
synonym TS[ [:
synonym CK[ [:
synonym SC[ [:
synonym SL[ [:
synonym ]T[ [:
synonym CP[ noop-i
synonym ]CP noop-i
: ]S postpone ]: simple postpone new ; immediate restrict
: ]DT postpone ]: data-act postpone new ; immediate restrict
: ]T postpone ]: toggle postpone new ; immediate restrict
: ]CK postpone ]: click postpone new ; immediate restrict
: ][ postpone ]: postpone :[ ; immediate restrict
: ]TS postpone ]: toggle-state postpone new ;
: ]S postpone ;] simple postpone new ; immediate restrict
: ]DT postpone ;] data-act postpone new ; immediate restrict
: ]T postpone ;] toggle postpone new ; immediate restrict
: ]CK postpone ;] click postpone new ; immediate restrict
: ][ postpone ;] postpone [: ; immediate restrict
: ]TS postpone ;] toggle-state postpone new ;
immediate restrict
: ]N ; immediate
: ]TERM ; immediate
\ other simplifications 05mar07py
: C[ ; immediate restrict
: ]SC postpone ]: scale-do postpone new ; immediate restrict
: ]SL postpone ]: slider-do postpone new ; immediate restrict
: ]SC postpone ;] scale-do postpone new ; immediate restrict
: ]SL postpone ;] slider-do postpone new ; immediate restrict
: TV[ ; immediate restrict
: TB[ ; immediate restrict
: TN[ ; immediate restrict
: ]TV postpone ]: toggle-var postpone new ; immediate restrict
: ]TB postpone ]: toggle-bit postpone new ; immediate restrict
: ]TN postpone ]: toggle-num postpone new ; immediate restrict
: ]TV postpone ;] toggle-var postpone new ; immediate restrict
: ]TB postpone ;] toggle-bit postpone new ; immediate restrict
: ]TN postpone ;] toggle-num postpone new ; immediate restrict
: DF[ postpone dup postpone >o ; immediate restrict
: ]DF postpone o> ; immediate restrict
......@@ -97,7 +97,7 @@ how: : dispose clicks HandleOff
: .catch-rest ( n -- ) ." Error " . cr ;
: handle-events ( -- ) events-lock @ ?EXIT
events-lock on
:[ handle-event invoke drop ]: catch
[: handle-event invoke drop ;] catch
events-lock off throw ;
: do-event pass^ @ op!
up@ TO event-task'
......@@ -461,9 +461,9 @@ how: : dispose clicks HandleOff
\ Display 04aug05py
[defined] x11 [IF]
:[ event XMotionEvent time @ event-time !
:noname event XMotionEvent time @ event-time !
event XMotionEvent x @+ @ mxy!
event XMotionEvent state @ 8 >> mb ! moved! ]:
event XMotionEvent state @ 8 >> mb ! moved! ;
MotionNotify cells Handlers + !
| 2Variable comp_stat
| Variable look_key
......@@ -471,7 +471,7 @@ how: : dispose clicks HandleOff
\ Display 04jan07py
:[ ( -- ) \ cr 'd emit 'o emit
:noname ( -- ) \ cr 'd emit 'o emit
do-exposed
event XKeyEvent time @ event-time !
[defined] has-utf8 [IF] xrc ic @ ?dup >r [THEN]
......@@ -483,13 +483,13 @@ how: : dispose clicks HandleOff
?dup IF look_chars swap bounds ?DO
I xc@+ swap >r event XKeyEvent state @ $3F and keyed
r> I - +LOOP EXIT THEN
look_key @ event XKeyEvent state @ $3F and $80 or keyed ]:
look_key @ event XKeyEvent state @ $3F and $80 or keyed ;
KeyPress cells Handlers + !
\ Display 11sep05py
:[ \ cr ." mapping notify"
event XRefreshKeyboardMapping drop ]:
:noname \ cr ." mapping notify"
event XRefreshKeyboardMapping drop ;
MappingNotify cells Handlers + !
: click^ ( -- event ) clicks @ @+ swap 8* + ;
: transclick ( x y -- x' y' ) ;
......@@ -524,7 +524,7 @@ how: : dispose clicks HandleOff
: .button cr base push hex event XButtonEvent window
@+ @+ @ swap rot xwin @ 9 .r 9 .r 9 .r 9 .r
space event XButtonEvent x @+ swap . @ . ;
:[ ( -- )
:noname ( -- )
do-exposed
event XButtonEvent time @ event-time !
event XButtonEvent time @ dup true in-time?
......@@ -536,11 +536,11 @@ how: : dispose clicks HandleOff
lastclick on
THEN EXIT THEN event !xyclick flags #pending -bit
THEN flags #pending bit@ IF moreclicks THEN
1 event sendclick lastclick on ]:
1 event sendclick lastclick on ;
ButtonPress cells Handlers + !
\ Display 09mar99py
:[ ( -- )
:noname ( -- )
do-exposed
event XButtonEvent time @ event-time !
event XButtonEvent time @ dup 0 in-time?
......@@ -556,7 +556,7 @@ how: : dispose clicks HandleOff
IF event !xyclick +clicks moreclicks THEN
flags #pending bit@ 0= >r
2 event sendclick lastclick off
r> IF flags #pending -bit THEN ]:
r> IF flags #pending -bit THEN ;
ButtonRelease cells Handlers + !
\ Display 28jun98py
......@@ -571,32 +571,32 @@ how: : dispose clicks HandleOff
\ Display 04aug05py
:[
:noname
event XExposeEvent x @+ @+ @+ @ add-region
\ event XExposeEvent count @ 0= IF ." draw" draw THEN
flags #exposed +bit ]:
flags #exposed +bit ;
dup Expose cells Handlers + !
GraphicsExpose cells Handlers + !
:[ do-exposed pointed self
IF mx @ my @ pointed moved THEN ]:
:noname do-exposed pointed self
IF mx @ my @ pointed moved THEN ;
EnterNotify cells Handlers + !
:[ do-exposed pointed self
IF pointed leave 0 bind pointed moved? drop THEN ]:
:noname do-exposed pointed self
IF pointed leave 0 bind pointed moved? drop THEN ;
LeaveNotify cells Handlers + !
\ Display 23apr06py
Create xev here sizeof XEvent dup allot erase
:[ \ cr ." Selection Notify "
:noname \ cr ." Selection Notify "
event XSelectionRequestEvent time @ event-time !
event XSelectionEvent property @
event XSelectionEvent requestor @
xrc dpy @ fetch-property ]:
xrc dpy @ fetch-property ;
SelectionNotify cells Handlers + !
:[ \ cr ." Selection Clear "
own-selection off ]:
:noname \ cr ." Selection Clear "
own-selection off ;
SelectionClear cells Handlers + !
\ Display 16jan05py
......@@ -622,7 +622,7 @@ how: : dispose clicks HandleOff
'string 2 PropModeReplace #32 4 rest-request ;
\ Display 16jan05py
:[ \ cr ." Selection Request "
:noname \ cr ." Selection Request "
event XSelectionRequestEvent time @ event-time !
event xev 4 cells move
event XSelectionRequestEvent requestor
......@@ -642,51 +642,51 @@ how: : dispose clicks HandleOff
xrc dpy @
event XSelectionRequestEvent requestor @
0 0 xev XSendEvent drop ]:
0 0 xev XSendEvent drop ;
SelectionRequest cells Handlers + !
\ Display 07jan07py
:[ flags #exposed +bit ]: NoExpose cells Handlers + !
:[ ( -- ) \ resize request
:noname flags #exposed +bit ; NoExpose cells Handlers + !
:noname ( -- ) \ resize request
event XConfigureEvent x @ x !
event XConfigureEvent y @ y !
event XConfigureEvent width @ rw !
event XConfigureEvent height @ rh ! ]:
event XConfigureEvent height @ rh ! ;
ConfigureNotify cells Handlers + !
:[ do-exposed focus ]:
:noname do-exposed focus ;
FocusIn cells Handlers + !
:[ do-exposed defocus ]:
:noname do-exposed defocus ;
FocusOut cells Handlers + !
: >exposed ( -- ) sync flags #exposed -bit
BEGIN ( ExposureMask ) 0 get-event
pause flags #exposed bit@ UNTIL ;
\ Display 02aug98py
:[ ( -- )
event sizeof XClientMessageEvent dump ]:
:noname ( -- )
event sizeof XClientMessageEvent dump ;
ClientMessage cells Handlers + !
[THEN]
\ Display 19jan00py
[defined] win32 [IF] Create paint $40 allot
:[ ( lparam wparam msg win -- ret )
:noname ( lparam wparam msg win -- ret )
xrc dc @ >r paint xwin @ BeginPaint xrc dc !
Xform0 xrc dc @ SetWorldTransform drop
draw paint xwin @ EndPaint drop r> xrc dc !
2drop 2drop 0 flags #exposed +bit ]: WM_PAINT Handler@ !
:[ 3 pick >lohi y ! x ! DefWindowProc ]:
2drop 2drop 0 flags #exposed +bit ; WM_PAINT Handler@ !
:noname 3 pick >lohi y ! x ! DefWindowProc ;
WM_MOVE Handler@ !
:[ 2drop 2drop close 0 ]: WM_CLOSE Handler@ !
:[ 3 pick WINDOWPOS flags @ SWP_NOSIZE and
:noname 2drop 2drop close 0 ; WM_CLOSE Handler@ !
:noname 3 pick WINDOWPOS flags @ SWP_NOSIZE and
IF DefWindowProc EXIT THEN 2drop drop
WINDOWPOS cx 2@ 0. 0. sp@ 0 style @ rot
AdjustWindowRect drop p- p- rw ! rh !
size-event 0 ]: WM_WINDOWPOSCHANGED Handler@ !
size-event 0 ; WM_WINDOWPOSCHANGED Handler@ !
\ Display 28jul07py
:[ 2drop drop { rect |
:noname 2drop drop { rect |
vglue >r hglue >r 0 0 sp@ >r 0 style @ r>
AdjustWindowRect drop p- rect 2@ p+
dup r> + 2 pick r> + >r >r
......@@ -696,11 +696,11 @@ how: : dispose clicks HandleOff
AdjustWindowRect drop p- rect 2@ p+
rot over - r@ 2/ + r@ / r> * + -rot swap
over - r@ 2/ + r@ / r> * + swap
rect 2 cells + 2! 0 } ]: WM_SIZING Handler@ !
\ :[ ( lparam wparam msg win -- ret )
\ DefWindowProc ]: WM_INPUTLANGCHANGE Handler@ !
\ :[ ( lparam wparam msg win -- ret )
\ DefWindowProc ]: WM_INPUTLANGCHANGEREQUEST Handler@ !
rect 2 cells + 2! 0 } ; WM_SIZING Handler@ !
\ :noname ( lparam wparam msg win -- ret )
\ DefWindowProc ; WM_INPUTLANGCHANGE Handler@ !
\ :noname ( lparam wparam msg win -- ret )
\ DefWindowProc ; WM_INPUTLANGCHANGEREQUEST Handler@ !
\ Display 19jan00py
......@@ -723,15 +723,15 @@ private:
$FF51 , $FF52 , $FF53 , $FF54 ,
0 , 0 , 0 , 0 ,
$0000 , $007F ,
:[ 2drop nip dup $21 $2F within
:noname 2drop nip dup $21 $2F within
IF $21 - cells xkeys + @ ?dup
IF shift@ ?keyed THEN
ELSE drop THEN 0 ]: WM_KEYDOWN Handler@ !
:[ 2drop nip shift@ ?keyed 0 ]:
ELSE drop THEN 0 ; WM_KEYDOWN Handler@ !
:noname 2drop nip shift@ ?keyed 0 ;
WM_CHAR Handler@ !
\ :[ 2drop nip shift@ ?keyed 0 ]:
\ :noname 2drop nip shift@ ?keyed 0 ;
\ WM_IME_CHAR Handler@ !
:[ 2drop nip shift@ ( 8 or ) ?keyed 0 ]:
:noname 2drop nip shift@ ( 8 or ) ?keyed 0 ;
WM_SYSCHAR Handler@ !
\ Display 12aug00py
......@@ -768,7 +768,7 @@ private:
: +clicks ( -- ) click^ 6+ dup w@ 2+ -2 and swap w! ;
\ Display 19jan00py
:[ ( lparam wparam msg win -- 0 ) ?grab \ add press
:noname ( lparam wparam msg win -- 0 ) ?grab \ add press
SetCapture 2drop 2drop
event MSG time @ dup true in-time?
swap lasttime !
......@@ -779,13 +779,13 @@ private:
lastclick on
THEN 0 EXIT THEN event !xyclick flags #pending -bit
THEN flags #pending bit@ IF moreclicks THEN
1 event sendclick lastclick on 0 ]:
1 event sendclick lastclick on 0 ;
dup WM_LBUTTONDOWN Handler@ !
dup WM_RBUTTONDOWN Handler@ !
WM_MBUTTONDOWN Handler@ !
\ Display 19jan00py
:[ 2drop $13 and 0= IF ReleaseCapture drop THEN
:noname 2drop $13 and 0= IF ReleaseCapture drop THEN
?grab drop event MSG time @ dup 0 in-time?
swap lasttime !
IF event samepos? IF lastclick @
......@@ -798,7 +798,7 @@ private:
IF event !xyclick +clicks moreclicks THEN
flags #pending bit@ 0= >r
2 event sendclick lastclick off 0
r> IF flags #pending -bit THEN ]:
r> IF flags #pending -bit THEN ;
dup WM_LBUTTONUP Handler@ !
dup WM_RBUTTONUP Handler@ ! WM_MBUTTONUP Handler@ !
......@@ -813,10 +813,10 @@ private:
click^ w!+ w!+ w!+ w!
moreclicks
2 +LOOP drop ;
:[ ( lparam wparam msg win -- ) moved!
:noname ( lparam wparam msg win -- ) moved!
flags #pending bit@ IF moreclicks flags #pending -bit THEN
event MSG time @ lasttime !
2drop 2drop event sendwheel 0 ]:
2drop 2drop event sendwheel 0 ;
WM_MOUSEWHEEL Handler@ !
\ Display 12aug00py
......@@ -829,25 +829,25 @@ private:
clicks @ $C + dup 8 - clicks @ @ 8* move
( 2over 2over cr . . . . ) ;
:[ 2drop drop >r
:noname 2drop drop >r
vglue + hglue +
0. sp@ 0 style @ rot AdjustWindowRect drop p-
r> $8 + 2! 0 ]:
r> $8 + 2! 0 ;
WM_GETMINMAXINFO Handler@ !
\ Display 29jul07py
:[ ( lparam wparam msg win -- ) ?grab moved!
2drop >mshift $FF and mb ! >lohi mxy! 0 ]:
:noname ( lparam wparam msg win -- ) ?grab moved!
2drop >mshift $FF and mb ! >lohi mxy! 0 ;
WM_MOUSEMOVE Handler@ !
:[ opointed self
:noname opointed self
IF pointed leave 0 bind pointed THEN
DefWindowProc ]: WM_NCMOUSEMOVE Handler@ !
DefWindowProc ; WM_NCMOUSEMOVE Handler@ !
:[ focus 2drop 2drop 0 ]: WM_SETFOCUS Handler@ !
:[ defocus 2drop 2drop 0 ]: WM_KILLFOCUS Handler@ !
:[ ( lparam wparam msg win -- )
:noname focus 2drop 2drop 0 ; WM_SETFOCUS Handler@ !
:noname defocus 2drop 2drop 0 ; WM_KILLFOCUS Handler@ !
:noname ( lparam wparam msg win -- )
2drop 2drop get-sys-colors xrc free-colors
xrc colors 0 ]: WM_SYSCOLORCHANGE Handler@ !
xrc colors 0 ; WM_SYSCOLORCHANGE Handler@ !
: >exposed ;
[THEN]
class;
......
\ anonymous definitions in a definition
: :[ ( compile-time: -- orig colon-sys )
: [: ( compile-time: -- orig colon-sys )
state @ IF loffset @ last @ POSTPONE AHEAD true ELSE false THEN
:noname ; immediate
: ]: ( compile-time: orig colon-sys -- ; run-time: -- xt )
: ;] ( compile-time: orig colon-sys -- ; run-time: -- xt )
POSTPONE ; >r IF ] POSTPONE THEN r> POSTPONE ALiteral last ! loffset !
ELSE r> THEN ( xt ) ; immediate
\\\
......@@ -18,8 +18,8 @@
execute ;
: test ( f -- )
:[ ." true" ]:
:[ ." false" ]:
[: ." true" ;]
[: ." false" ;]
if-else ;
1 test cr \ writes "true"
......
......@@ -247,7 +247,7 @@ how: : init ( -- ) 0 1 *filll 0 1 *fil super init ;
class;
: flipper combined ' +flip
:[ combined attribs c@ :flip or combined attribs c! combined hide ]:
[: combined attribs c@ :flip or combined attribs c! combined hide ;]
toggle new ;
\ Topindex, topglue 11apr99py
......@@ -471,13 +471,13 @@ how: 0 key-methods !
: fetch ( -- addr u ) edit get ;
class;
synonym ST[ :[
: ]ST postpone ]: edit-action postpone new ; immediate restrict
synonym ST[ [:
: ]ST postpone ;] edit-action postpone new ; immediate restrict
\ text input key binding 15apr01py
: K[ ( key -- ) (textfield postpone with postpone :[ ;
: ]K ( key sys ) postpone ]: >r (textfield postpone endwith r>
: K[ ( key -- ) (textfield postpone with postpone [: ;
: ]K ( key sys ) postpone ;] >r (textfield postpone endwith r>
& edit-action >o edit-action bind-key o> ; immediate
: K-alias ( key1 key2 -- ) swap edit-action find-key
?dup IF cell+ @
......@@ -535,8 +535,8 @@ class;
: sn-base# ( obj n -- )
swap number-action with nbase ! self endwith ;
: #[ ( key -- ) (textfield postpone with postpone :[ ;
: ]# ( key sys ) postpone ]: >r (textfield postpone endwith r>
: #[ ( key -- ) (textfield postpone with postpone [: ;
: ]# ( key sys ) postpone ;] >r (textfield postpone endwith r>
& number-action >o number-action bind-key o> ; immediate
'$' #[ callback self number-action with
fetch $10 nbase ! store endwith ]#
......@@ -549,8 +549,8 @@ class;
'-' #[ callback self number-action with
fetch dnegate store endwith ]#
synonym SN[ :[
: ]SN postpone ]: number-action postpone new ;
synonym SN[ [:
: ]SN postpone ;] number-action postpone new ;
immediate restrict
\ number edit variables 15apr01py
......@@ -669,12 +669,12 @@ parbox class text-parbox
how: Variable text-string
: init ( addr u format -- ) >r
text-string $! 0 text-string bl
:[ -trailing bl skip text-word new swap 1+ ]: $iter
[: -trailing bl skip text-word new swap 1+ ;] $iter
r> super init text-string $off ;
: assign ( addr u -- ) text-string $! dispose-childs
unhbox 2drop dispose[] items 'nil bind childs
0 text-string bl
:[ -trailing bl skip text-word new swap 1+ ]: $iter
[: -trailing bl skip text-word new swap 1+ ;] $iter
dup n' ! text-string $off [], over bind[] items
?DO I ! -cell +LOOP 0 hboxing dup n ! >box
dpy self dpy! ;
......
......@@ -285,11 +285,11 @@ class;
previous previous
: GL[ postpone :[ glcanvas postpone with ; immediate
: ]GL glcanvas postpone endwith postpone ]: ; immediate
: GL[ postpone [: glcanvas postpone with ; immediate
: ]GL glcanvas postpone endwith postpone ;] ; immediate
: CV[ postpone :[ canvas postpone with ; immediate
: ]CV canvas postpone endwith postpone ]: ; immediate
: CV[ postpone [: canvas postpone with ; immediate
: ]CV canvas postpone endwith postpone ;] ; immediate
\ helper words for Theseus 21sep07py
......
......@@ -23,21 +23,21 @@ class;
endwith
endwith ;
: ]#f ( key sys ) postpone ]: (textfield postpone endwith
: ]#f ( key sys ) postpone ;] (textfield postpone endwith
& float-action >o float-action bind-key o> ; immediate
'-' #[ sp@ 1 ins drop 1 c ]#F
'.' #[ sp@ 1 ins drop 1 c ]#F
',' #[ sp@ 1 ins drop 1 c ]#F
'e' #[ sp@ 1 ins drop 1 c ]#F
'E' #[ sp@ 1 ins drop 1 c ]#F
: ]SF postpone ]: float-action postpone new ;
: ]SF postpone ;] float-action postpone new ;
[defined] DoNotSin [IF] DoNotSin [THEN]
immediate restrict
[defined] alias [IF]
' :[ alias SF[ immediate restrict
' [: alias SF[ immediate restrict
' noop alias ]F
[ELSE]
synonym SF[ :[
synonym SF[ [:
synonym ]F noop
[THEN]
......
......@@ -387,11 +387,11 @@ how: \ init ( act addr len -- )
\ menu-entry 12dec99py
: hglue text $@ menu-sep scan nip
IF 0 text menu-sep :[ fnt size drop 1 *fil
IF 0 text menu-sep [: fnt size drop 1 *fil
2 pick parent with
dup >r 1- combined tab@ p+
r> combined tab!
endwith 1+ ]: $iter
endwith 1+ ;] $iter
1- parent with combined tab@ endwith
xM xS + 1+ 0 p+
ELSE textwh @ xM + xS + 1+ 1 *fil THEN ;
......@@ -685,11 +685,11 @@ how: : assign ( addr u -- ) text assign ;
0 text edit ds !
^ M[ clicked ]M :down tributton new bind tri
info self 1 habox new hfixbox text self
^ S[ ]S :[ text childs vglue ]: :[ xS 0 ]: arule new
^ S[ ]S [: text childs vglue ;] [: xS 0 ;] arule new
tri self