got undo working
This commit is contained in:
parent
cfdc0371db
commit
81c02526c2
119
femto.tal
119
femto.tal
|
@ -3,27 +3,12 @@
|
||||||
( requires terminal to be in raw mode )
|
( requires terminal to be in raw mode )
|
||||||
( see femto launcher script for more details )
|
( see femto launcher script for more details )
|
||||||
( )
|
( )
|
||||||
( ANSI sequences )
|
( ANSI sequences used )
|
||||||
( )
|
( )
|
||||||
( goto $row,$col ESC [ $row ; $col H )
|
( goto $row,$col ESC [ $row ; $col H )
|
||||||
( goto home ESC [ H )
|
( go right by n ESC [ n C )
|
||||||
( go up ESC [ A )
|
|
||||||
( go down ESC [ B )
|
|
||||||
( go right ESC [ C )
|
|
||||||
( go left ESC [ D )
|
|
||||||
( )
|
|
||||||
( query cursor ESC [ 6 n )
|
( query cursor ESC [ 6 n )
|
||||||
( )
|
|
||||||
( all scroll on ESC [ r )
|
|
||||||
( region scroll on ESC [ $y0 ; $y1 r )
|
|
||||||
( scroll down ESC D )
|
|
||||||
( scroll up ESC M )
|
|
||||||
( )
|
|
||||||
( erase cur->eol ESC [ K )
|
|
||||||
( erase cur->sol ESC [ 1 K )
|
|
||||||
( erase line ESC [ 2 K )
|
( erase line ESC [ 2 K )
|
||||||
( erase line->bot ESC [ J )
|
|
||||||
( erase line->top ESC [ 1 J )
|
|
||||||
( erase all ESC [ 2 J )
|
( erase all ESC [ 2 J )
|
||||||
( )
|
( )
|
||||||
( set attrs ESC [ $at1 ; ... m )
|
( set attrs ESC [ $at1 ; ... m )
|
||||||
|
@ -50,7 +35,7 @@
|
||||||
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ]
|
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ]
|
||||||
|a0 @File [ &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
|
|a0 @File [ &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
|
||||||
|
|
||||||
( MAX file size is currently #d000, i.e. 53248 bytes )
|
( MAX file size is currently #d200, i.e. 532926 bytes )
|
||||||
|
|
||||||
%dbg { #ff .System/debug DEO }
|
%dbg { #ff .System/debug DEO }
|
||||||
%emit { .Console/write DEO }
|
%emit { .Console/write DEO }
|
||||||
|
@ -83,6 +68,7 @@
|
||||||
%emit-] { LIT2 '] 18 DEO }
|
%emit-] { LIT2 '] 18 DEO }
|
||||||
%emit-m { LIT2 'm 18 DEO }
|
%emit-m { LIT2 'm 18 DEO }
|
||||||
%emit-n { LIT2 'n 18 DEO }
|
%emit-n { LIT2 'n 18 DEO }
|
||||||
|
%emit-u { LIT2 'u 18 DEO }
|
||||||
%emit-~ { LIT2 '~ 18 DEO }
|
%emit-~ { LIT2 '~ 18 DEO }
|
||||||
|
|
||||||
%quit! { #01 .System/halt DEO BRK }
|
%quit! { #01 .System/halt DEO BRK }
|
||||||
|
@ -129,6 +115,7 @@
|
||||||
|
|
||||||
( tracks overall editor state between events )
|
( tracks overall editor state between events )
|
||||||
@state [
|
@state [
|
||||||
|
&in-undo $1 ( are we currently in undo? )
|
||||||
&key $1 ( last key read )
|
&key $1 ( last key read )
|
||||||
&saw-esc $1 ( did we just see ESC? )
|
&saw-esc $1 ( did we just see ESC? )
|
||||||
&saw-xterm $1 ( did we just see an ESC [ xterm sequence? )
|
&saw-xterm $1 ( did we just see an ESC [ xterm sequence? )
|
||||||
|
@ -191,9 +178,10 @@
|
||||||
( the interpreter to halt. )
|
( the interpreter to halt. )
|
||||||
@error! ( msg* -> )
|
@error! ( msg* -> )
|
||||||
emit-! sp
|
emit-! sp
|
||||||
&loop LDAk #00 EQU ,&done JCN
|
;print JSR2
|
||||||
|
( &loop LDAk #00 EQU ,&done JCN
|
||||||
LDAk emit INC2 ,&loop JMP
|
LDAk emit INC2 ,&loop JMP
|
||||||
&done POP2 nl dbg BRK
|
&done POP2 ) nl dbg BRK
|
||||||
|
|
||||||
( open the given file at editor start up )
|
( open the given file at editor start up )
|
||||||
( )
|
( )
|
||||||
|
@ -202,7 +190,7 @@
|
||||||
( TODO: enable closing/opening files with editor already running )
|
( TODO: enable closing/opening files with editor already running )
|
||||||
@open-file ( filename* -> )
|
@open-file ( filename* -> )
|
||||||
.File/name DEO2
|
.File/name DEO2
|
||||||
#d000 .File/length DEO2
|
#d200 .File/length DEO2
|
||||||
;data .File/read DEO2
|
;data .File/read DEO2
|
||||||
|
|
||||||
.File/success DEI2 #0000 GTH2 ,&ok JCN
|
.File/success DEI2 #0000 GTH2 ,&ok JCN
|
||||||
|
@ -452,9 +440,7 @@
|
||||||
( beginning quitting femto, prompting if unsaved changes )
|
( beginning quitting femto, prompting if unsaved changes )
|
||||||
@quit
|
@quit
|
||||||
#01 .state/quitting STZ
|
#01 .state/quitting STZ
|
||||||
.state/modified LDZ ,&is-modified JCN
|
.state/modified LDZ #00 EQU ;quit-now JCN2
|
||||||
quit!
|
|
||||||
&is-modified
|
|
||||||
;messages/quit-prompt ;messages/null ;do-quit ;start-prompt JSR2
|
;messages/quit-prompt ;messages/null ;do-quit ;start-prompt JSR2
|
||||||
;redraw-prompt-and-cursor JSR2 ;return JMP2
|
;redraw-prompt-and-cursor JSR2 ;return JMP2
|
||||||
|
|
||||||
|
@ -491,7 +477,6 @@
|
||||||
( )
|
( )
|
||||||
( this should not be called for newlines, see ;newline )
|
( this should not be called for newlines, see ;newline )
|
||||||
@insert ( c^ -> )
|
@insert ( c^ -> )
|
||||||
#01 .state/modified STZ
|
|
||||||
;cur-pos JSR2 ;shift-right JSR2
|
;cur-pos JSR2 ;shift-right JSR2
|
||||||
;cur-col JSR2 INC2 .cursor/col STZ2
|
;cur-col JSR2 INC2 .cursor/col STZ2
|
||||||
;redraw-all JSR2 ;return JMP2
|
;redraw-all JSR2 ;return JMP2
|
||||||
|
@ -509,7 +494,6 @@
|
||||||
( either call ;insert with \t or else insert a number of )
|
( either call ;insert with \t or else insert a number of )
|
||||||
( spaces based on .config/tab-width. )
|
( spaces based on .config/tab-width. )
|
||||||
@insert-tab ( -> )
|
@insert-tab ( -> )
|
||||||
#01 .state/modified STZ
|
|
||||||
.config/insert-tabs LDZ ,&use-tabs JCN
|
.config/insert-tabs LDZ ,&use-tabs JCN
|
||||||
#0000 .config/tab-width LDZ2 SUB2
|
#0000 .config/tab-width LDZ2 SUB2
|
||||||
&loop
|
&loop
|
||||||
|
@ -524,7 +508,6 @@
|
||||||
|
|
||||||
( insert a newline at the cursor position )
|
( insert a newline at the cursor position )
|
||||||
@newline ( c^ -> )
|
@newline ( c^ -> )
|
||||||
#01 .state/modified STZ
|
|
||||||
#0a ;cur-pos JSR2 ;shift-right JSR2
|
#0a ;cur-pos JSR2 ;shift-right JSR2
|
||||||
#0000 .cursor/col STZ2
|
#0000 .cursor/col STZ2
|
||||||
.cursor/row LDZ2 INC2 .cursor/row STZ2
|
.cursor/row LDZ2 INC2 .cursor/row STZ2
|
||||||
|
@ -547,7 +530,6 @@
|
||||||
|
|
||||||
( delete the character under the cursor, if any )
|
( delete the character under the cursor, if any )
|
||||||
@delete ( -> )
|
@delete ( -> )
|
||||||
#01 .state/modified STZ
|
|
||||||
;last-pos JSR2 ;cur-pos JSR2 LTH2 ;return JCN2
|
;last-pos JSR2 ;cur-pos JSR2 LTH2 ;return JCN2
|
||||||
;cur-pos JSR2 LDAk STH ( cur [c] )
|
;cur-pos JSR2 LDAk STH ( cur [c] )
|
||||||
;shift-left JSR2 ( [c] )
|
;shift-left JSR2 ( [c] )
|
||||||
|
@ -676,7 +658,7 @@
|
||||||
|
|
||||||
( currently used to print stack information. )
|
( currently used to print stack information. )
|
||||||
@debug
|
@debug
|
||||||
;messages/rel-line-error ;error! JMP2
|
;messages/input-error ;error! JMP2
|
||||||
|
|
||||||
( move the terminal's cursor to the message line )
|
( move the terminal's cursor to the message line )
|
||||||
( )
|
( )
|
||||||
|
@ -830,6 +812,7 @@
|
||||||
.state/key LDZ LIT 'g EQU ( M-g ) ;goto-line JCN2
|
.state/key LDZ LIT 'g EQU ( M-g ) ;goto-line JCN2
|
||||||
.state/key LDZ LIT 's EQU ( M-s ) ;regex-search JCN2
|
.state/key LDZ LIT 's EQU ( M-s ) ;regex-search JCN2
|
||||||
.state/key LDZ LIT 't EQU ( M-t ) ;toggle-tabs JCN2
|
.state/key LDZ LIT 't EQU ( M-t ) ;toggle-tabs JCN2
|
||||||
|
.state/key LDZ LIT 'u EQU ( M-u ) ;undo JCN2
|
||||||
.state/key LDZ LIT 'v EQU ( M-v ) ;page-up JCN2
|
.state/key LDZ LIT 'v EQU ( M-v ) ;page-up JCN2
|
||||||
.state/key LDZ LIT '[ EQU ( M-[ ) ;xterm JCN2
|
.state/key LDZ LIT '[ EQU ( M-[ ) ;xterm JCN2
|
||||||
BRK
|
BRK
|
||||||
|
@ -1089,6 +1072,7 @@
|
||||||
( and so on. this might ultimately be more efficient but )
|
( and so on. this might ultimately be more efficient but )
|
||||||
( for now what we have works. )
|
( for now what we have works. )
|
||||||
@on-key
|
@on-key
|
||||||
|
#00 .state/in-undo STZ
|
||||||
.Console/read DEI .state/key STZ
|
.Console/read DEI .state/key STZ
|
||||||
;clear-message-line JSR2
|
;clear-message-line JSR2
|
||||||
.searching/active LDZ ;on-key-searching JCN2
|
.searching/active LDZ ;on-key-searching JCN2
|
||||||
|
@ -1161,13 +1145,11 @@
|
||||||
|
|
||||||
( draw the current cursor location )
|
( draw the current cursor location )
|
||||||
@draw-cursor ( -> )
|
@draw-cursor ( -> )
|
||||||
.prompt/active LDZ ,&on-prompt JCN
|
.prompt/active LDZ #00 EQU JMP JMP2r
|
||||||
( TODO: handle long lines )
|
( TODO: handle long lines )
|
||||||
;cur-w-col JSR2 lmargin ADD2
|
;cur-w-col JSR2 lmargin ADD2
|
||||||
.cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2
|
.cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2
|
||||||
;term-move-cursor JMP2
|
;term-move-cursor JMP2
|
||||||
&on-prompt
|
|
||||||
JMP2r
|
|
||||||
|
|
||||||
( current column in terms of display width )
|
( current column in terms of display width )
|
||||||
( )
|
( )
|
||||||
|
@ -1211,7 +1193,12 @@
|
||||||
.cursor/row LDZ2 INC2 ;emit-dec2 JSR2
|
.cursor/row LDZ2 INC2 ;emit-dec2 JSR2
|
||||||
emit-) sp emit-[
|
emit-) sp emit-[
|
||||||
LIT 's .config/insert-tabs LDZ ADD emit
|
LIT 's .config/insert-tabs LDZ ADD emit
|
||||||
emit-]
|
emit-] sp emit-u emit-:
|
||||||
|
;undo-stack/pos LDA2 ;undo-stack/data SUB2 #0003 DIV2 ;emit-dec2 JSR2
|
||||||
|
( sp
|
||||||
|
;undo-stack/pos LDA2 #0003 SUB2 LDA2k ;emit-dec2 JSR2 sp
|
||||||
|
INC2 INC2 LDA #00 SWP ;emit-dec2 JSR2 ( ) )
|
||||||
|
|
||||||
;emit-reset JMP2
|
;emit-reset JMP2
|
||||||
|
|
||||||
@draw-prompt ( -> )
|
@draw-prompt ( -> )
|
||||||
|
@ -1249,8 +1236,7 @@
|
||||||
OVR2 STH2r ADD2 ( offset limit offset+cols-col )
|
OVR2 STH2r ADD2 ( offset limit offset+cols-col )
|
||||||
;min2 JSR2 STH2 ( offset [cutoff] )
|
;min2 JSR2 STH2 ( offset [cutoff] )
|
||||||
&loop ( i [cutoff] )
|
&loop ( i [cutoff] )
|
||||||
DUP2 STH2kr LTH2 ,&continue JCN ,&done JMP
|
DUP2 STH2kr LTH2 #00 EQU ,&done JCN
|
||||||
&continue ( i [cutoff] )
|
|
||||||
LDAk #00 EQU ,&done JCN
|
LDAk #00 EQU ,&done JCN
|
||||||
LDAk #18 DEO INC2 ,&loop JMP
|
LDAk #18 DEO INC2 ,&loop JMP
|
||||||
&done
|
&done
|
||||||
|
@ -1385,8 +1371,7 @@
|
||||||
;draw-matches JSR2
|
;draw-matches JSR2
|
||||||
;draw-statusbar JSR2
|
;draw-statusbar JSR2
|
||||||
;draw-prompt JSR2
|
;draw-prompt JSR2
|
||||||
;draw-cursor JSR2
|
;draw-cursor JMP2
|
||||||
JMP2r
|
|
||||||
|
|
||||||
( handler completion code to do necessary drawing and BRK )
|
( handler completion code to do necessary drawing and BRK )
|
||||||
@return ( -> )
|
@return ( -> )
|
||||||
|
@ -1442,8 +1427,7 @@
|
||||||
#0000 ,&col STR2
|
#0000 ,&col STR2
|
||||||
;data
|
;data
|
||||||
&loop ( s pos )
|
&loop ( s pos )
|
||||||
GTH2k ,&next JCN ,&done JMP
|
GTH2k #00 EQU ,&done JCN
|
||||||
&next
|
|
||||||
LDAk #0a EQU ,&newline JCN
|
LDAk #0a EQU ,&newline JCN
|
||||||
,&col LDR2 INC2 ,&col STR2
|
,&col LDR2 INC2 ,&col STR2
|
||||||
INC2 ,&loop JMP
|
INC2 ,&loop JMP
|
||||||
|
@ -1491,8 +1475,11 @@
|
||||||
|
|
||||||
( insert one character at the cursor position )
|
( insert one character at the cursor position )
|
||||||
@shift-right ( c^ addr* -> )
|
@shift-right ( c^ addr* -> )
|
||||||
|
#01 .state/modified STZ
|
||||||
ROT STH ( addr [prev^] )
|
ROT STH ( addr [prev^] )
|
||||||
;last-pos JSR2 SWP2 ( last addr [prev^] )
|
;last-pos JSR2 SWP2 ( last addr [prev^] )
|
||||||
|
.state/in-undo LDZ ,&loop JCN
|
||||||
|
STH2k #00 STH2r ;u-push JSR2
|
||||||
&loop LTH2k ,&done JCN ( last addr [prev^] )
|
&loop LTH2k ,&done JCN ( last addr [prev^] )
|
||||||
LDAk STH SWPr ( last addr [prev^ curr^] )
|
LDAk STH SWPr ( last addr [prev^ curr^] )
|
||||||
DUP2 STHr ( last addr addr prev^ [curr^] )
|
DUP2 STHr ( last addr addr prev^ [curr^] )
|
||||||
|
@ -1508,7 +1495,10 @@
|
||||||
( )
|
( )
|
||||||
( TODO: change last/addr order and GTH -> LTH to remove hack )
|
( TODO: change last/addr order and GTH -> LTH to remove hack )
|
||||||
@shift-left ( addr* -> )
|
@shift-left ( addr* -> )
|
||||||
|
#01 .state/modified STZ
|
||||||
;last-pos JSR2 SWP2 ( last addr )
|
;last-pos JSR2 SWP2 ( last addr )
|
||||||
|
.state/in-undo LDZ ,&loop JCN
|
||||||
|
STH2k ;cur-pos JSR2 LDA STH2r ;u-push JSR2
|
||||||
&loop GTH2k ,&next JCN ( last addr )
|
&loop GTH2k ,&next JCN ( last addr )
|
||||||
,&done JMP ( last addr )
|
,&done JMP ( last addr )
|
||||||
&next DUP2 INC2 LDAk ( last addr addr+1 c1^ )
|
&next DUP2 INC2 LDAk ( last addr addr+1 c1^ )
|
||||||
|
@ -1563,7 +1553,7 @@
|
||||||
|
|
||||||
( various string constants used as messages for the user )
|
( various string constants used as messages for the user )
|
||||||
@messages [ &null 00
|
@messages [ &null 00
|
||||||
&input-error "input 20 "error: 20 00
|
&input-error "Input 20 "error: 20 00
|
||||||
&bytes 20 "bytes, 00
|
&bytes 20 "bytes, 00
|
||||||
&save-ok "Successfully 20 "saved 20 00
|
&save-ok "Successfully 20 "saved 20 00
|
||||||
&save-failed "Failed 20 "to 20 "save 20 00
|
&save-failed "Failed 20 "to 20 "save 20 00
|
||||||
|
@ -1575,12 +1565,55 @@
|
||||||
&quit-prompt "Save 20 "modified 20 "file 20 "(y/n)? 20 00
|
&quit-prompt "Save 20 "modified 20 "file 20 "(y/n)? 20 00
|
||||||
&unknown-input "Unknown 20 "input: 20 00
|
&unknown-input "Unknown 20 "input: 20 00
|
||||||
&no-matches-found "No 20 "matches 20 "found: 20 00
|
&no-matches-found "No 20 "matches 20 "found: 20 00
|
||||||
&term-size-parse-error "error 20 "parsing 20 "term 20 "size 00
|
&term-size-parse-error "Error 20 "parsing 20 "term 20 "size 00
|
||||||
&rel-line-error "invalid 20 "relative 20 "line 20 "number 00
|
|
||||||
]
|
]
|
||||||
|
|
||||||
|
@undo ( -> )
|
||||||
|
#01 .state/in-undo STZ
|
||||||
|
;undo-stack/pos LDA2 ;undo-stack/data EQU2 ,&noop JCN
|
||||||
|
;undo-stack/pos LDA2 #0003 SUB2
|
||||||
|
DUP2 ;undo-stack/pos STA2
|
||||||
|
LDA2k STH2 ( pos [addr] )
|
||||||
|
INC2 INC2 LDA STH2r ( c addr )
|
||||||
|
;jump-to-pos JSR2
|
||||||
|
DUP #00 EQU ,&delete JCN
|
||||||
|
DUP #0a EQU ,&newline JCN
|
||||||
|
DUP #09 EQU ,&tab JCN
|
||||||
|
;insert JMP2
|
||||||
|
&newline POP ;newline JMP2
|
||||||
|
&tab POP ;insert-tab JMP2
|
||||||
|
&delete POP ;delete JMP2
|
||||||
|
&noop BRK
|
||||||
|
|
||||||
|
@u-free ( -> )
|
||||||
|
;undo-stack/data STH2k #0003 ADD2 ( st+3 [st] )
|
||||||
|
&loop LDAk STH2kr STA
|
||||||
|
INC2 INC2r
|
||||||
|
DUP2 ;undo-stack/pos LDA2 LTH2 ,&loop JCN
|
||||||
|
&done ;undo-stack/pos LDA2k #0003 SUB2 SWP2 STA2
|
||||||
|
POP2 POP2r JMP2r
|
||||||
|
|
||||||
|
@u-push ( c^ addr* -> )
|
||||||
|
;undo-stack/pos DUP2 LDA2 ( c^ addr* top* pos* )
|
||||||
|
GTH2 ( c^ addr* top>pos^ ) ,&has-room JCN ( c^ addr* )
|
||||||
|
;u-free JSR2
|
||||||
|
&has-room ;undo-stack/pos LDA2 ( c^ addr* pos* )
|
||||||
|
STH2k ( c addr pos [pos] )
|
||||||
|
STA2 ( c [pos] )
|
||||||
|
STH2r INC2 INC2 STH2k ( c pos+2 [pos+2] )
|
||||||
|
STA ( [pos+2] )
|
||||||
|
STH2r INC2 ( pos+3 ) ;undo-stack/pos STA2 ( [] )
|
||||||
|
JMP2r
|
||||||
|
|
||||||
( path to file being edited )
|
( path to file being edited )
|
||||||
@filename $80
|
@filename $80
|
||||||
|
|
||||||
|
@undo-stack [
|
||||||
|
&data $180 ( 128 steps )
|
||||||
|
&pos :undo-stack/data
|
||||||
|
]
|
||||||
|
|
||||||
( actual file data to be edited )
|
( actual file data to be edited )
|
||||||
@data $d000
|
@data $d200
|
||||||
|
|
||||||
|
( end of femto.tal )
|
||||||
|
|
Loading…
Reference in New Issue