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 )
|
||||
( see femto launcher script for more details )
|
||||
( )
|
||||
( ANSI sequences )
|
||||
( ANSI sequences used )
|
||||
( )
|
||||
( goto $row,$col ESC [ $row ; $col H )
|
||||
( goto home ESC [ H )
|
||||
( go up ESC [ A )
|
||||
( go down ESC [ B )
|
||||
( go right ESC [ C )
|
||||
( go left ESC [ D )
|
||||
( )
|
||||
( go right by n ESC [ n C )
|
||||
( 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->bot ESC [ J )
|
||||
( erase line->top ESC [ 1 J )
|
||||
( erase all ESC [ 2 J )
|
||||
( )
|
||||
( set attrs ESC [ $at1 ; ... m )
|
||||
|
@ -50,7 +35,7 @@
|
|||
|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 ]
|
||||
|
||||
( 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 }
|
||||
%emit { .Console/write DEO }
|
||||
|
@ -83,6 +68,7 @@
|
|||
%emit-] { LIT2 '] 18 DEO }
|
||||
%emit-m { LIT2 'm 18 DEO }
|
||||
%emit-n { LIT2 'n 18 DEO }
|
||||
%emit-u { LIT2 'u 18 DEO }
|
||||
%emit-~ { LIT2 '~ 18 DEO }
|
||||
|
||||
%quit! { #01 .System/halt DEO BRK }
|
||||
|
@ -129,6 +115,7 @@
|
|||
|
||||
( tracks overall editor state between events )
|
||||
@state [
|
||||
&in-undo $1 ( are we currently in undo? )
|
||||
&key $1 ( last key read )
|
||||
&saw-esc $1 ( did we just see ESC? )
|
||||
&saw-xterm $1 ( did we just see an ESC [ xterm sequence? )
|
||||
|
@ -191,9 +178,10 @@
|
|||
( the interpreter to halt. )
|
||||
@error! ( msg* -> )
|
||||
emit-! sp
|
||||
&loop LDAk #00 EQU ,&done JCN
|
||||
;print JSR2
|
||||
( &loop LDAk #00 EQU ,&done JCN
|
||||
LDAk emit INC2 ,&loop JMP
|
||||
&done POP2 nl dbg BRK
|
||||
&done POP2 ) nl dbg BRK
|
||||
|
||||
( open the given file at editor start up )
|
||||
( )
|
||||
|
@ -202,7 +190,7 @@
|
|||
( TODO: enable closing/opening files with editor already running )
|
||||
@open-file ( filename* -> )
|
||||
.File/name DEO2
|
||||
#d000 .File/length DEO2
|
||||
#d200 .File/length DEO2
|
||||
;data .File/read DEO2
|
||||
|
||||
.File/success DEI2 #0000 GTH2 ,&ok JCN
|
||||
|
@ -452,9 +440,7 @@
|
|||
( beginning quitting femto, prompting if unsaved changes )
|
||||
@quit
|
||||
#01 .state/quitting STZ
|
||||
.state/modified LDZ ,&is-modified JCN
|
||||
quit!
|
||||
&is-modified
|
||||
.state/modified LDZ #00 EQU ;quit-now JCN2
|
||||
;messages/quit-prompt ;messages/null ;do-quit ;start-prompt JSR2
|
||||
;redraw-prompt-and-cursor JSR2 ;return JMP2
|
||||
|
||||
|
@ -491,7 +477,6 @@
|
|||
( )
|
||||
( this should not be called for newlines, see ;newline )
|
||||
@insert ( c^ -> )
|
||||
#01 .state/modified STZ
|
||||
;cur-pos JSR2 ;shift-right JSR2
|
||||
;cur-col JSR2 INC2 .cursor/col STZ2
|
||||
;redraw-all JSR2 ;return JMP2
|
||||
|
@ -509,7 +494,6 @@
|
|||
( either call ;insert with \t or else insert a number of )
|
||||
( spaces based on .config/tab-width. )
|
||||
@insert-tab ( -> )
|
||||
#01 .state/modified STZ
|
||||
.config/insert-tabs LDZ ,&use-tabs JCN
|
||||
#0000 .config/tab-width LDZ2 SUB2
|
||||
&loop
|
||||
|
@ -524,7 +508,6 @@
|
|||
|
||||
( insert a newline at the cursor position )
|
||||
@newline ( c^ -> )
|
||||
#01 .state/modified STZ
|
||||
#0a ;cur-pos JSR2 ;shift-right JSR2
|
||||
#0000 .cursor/col STZ2
|
||||
.cursor/row LDZ2 INC2 .cursor/row STZ2
|
||||
|
@ -547,7 +530,6 @@
|
|||
|
||||
( delete the character under the cursor, if any )
|
||||
@delete ( -> )
|
||||
#01 .state/modified STZ
|
||||
;last-pos JSR2 ;cur-pos JSR2 LTH2 ;return JCN2
|
||||
;cur-pos JSR2 LDAk STH ( cur [c] )
|
||||
;shift-left JSR2 ( [c] )
|
||||
|
@ -676,7 +658,7 @@
|
|||
|
||||
( currently used to print stack information. )
|
||||
@debug
|
||||
;messages/rel-line-error ;error! JMP2
|
||||
;messages/input-error ;error! JMP2
|
||||
|
||||
( 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 's EQU ( M-s ) ;regex-search 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 '[ EQU ( M-[ ) ;xterm JCN2
|
||||
BRK
|
||||
|
@ -1089,6 +1072,7 @@
|
|||
( and so on. this might ultimately be more efficient but )
|
||||
( for now what we have works. )
|
||||
@on-key
|
||||
#00 .state/in-undo STZ
|
||||
.Console/read DEI .state/key STZ
|
||||
;clear-message-line JSR2
|
||||
.searching/active LDZ ;on-key-searching JCN2
|
||||
|
@ -1161,13 +1145,11 @@
|
|||
|
||||
( draw the current cursor location )
|
||||
@draw-cursor ( -> )
|
||||
.prompt/active LDZ ,&on-prompt JCN
|
||||
.prompt/active LDZ #00 EQU JMP JMP2r
|
||||
( TODO: handle long lines )
|
||||
;cur-w-col JSR2 lmargin ADD2
|
||||
.cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2
|
||||
;term-move-cursor JMP2
|
||||
&on-prompt
|
||||
JMP2r
|
||||
|
||||
( current column in terms of display width )
|
||||
( )
|
||||
|
@ -1211,7 +1193,12 @@
|
|||
.cursor/row LDZ2 INC2 ;emit-dec2 JSR2
|
||||
emit-) sp 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
|
||||
|
||||
@draw-prompt ( -> )
|
||||
|
@ -1249,8 +1236,7 @@
|
|||
OVR2 STH2r ADD2 ( offset limit offset+cols-col )
|
||||
;min2 JSR2 STH2 ( offset [cutoff] )
|
||||
&loop ( i [cutoff] )
|
||||
DUP2 STH2kr LTH2 ,&continue JCN ,&done JMP
|
||||
&continue ( i [cutoff] )
|
||||
DUP2 STH2kr LTH2 #00 EQU ,&done JCN
|
||||
LDAk #00 EQU ,&done JCN
|
||||
LDAk #18 DEO INC2 ,&loop JMP
|
||||
&done
|
||||
|
@ -1385,8 +1371,7 @@
|
|||
;draw-matches JSR2
|
||||
;draw-statusbar JSR2
|
||||
;draw-prompt JSR2
|
||||
;draw-cursor JSR2
|
||||
JMP2r
|
||||
;draw-cursor JMP2
|
||||
|
||||
( handler completion code to do necessary drawing and BRK )
|
||||
@return ( -> )
|
||||
|
@ -1442,8 +1427,7 @@
|
|||
#0000 ,&col STR2
|
||||
;data
|
||||
&loop ( s pos )
|
||||
GTH2k ,&next JCN ,&done JMP
|
||||
&next
|
||||
GTH2k #00 EQU ,&done JCN
|
||||
LDAk #0a EQU ,&newline JCN
|
||||
,&col LDR2 INC2 ,&col STR2
|
||||
INC2 ,&loop JMP
|
||||
|
@ -1491,8 +1475,11 @@
|
|||
|
||||
( insert one character at the cursor position )
|
||||
@shift-right ( c^ addr* -> )
|
||||
#01 .state/modified STZ
|
||||
ROT STH ( 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^] )
|
||||
LDAk STH SWPr ( last 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 )
|
||||
@shift-left ( addr* -> )
|
||||
#01 .state/modified STZ
|
||||
;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 )
|
||||
,&done JMP ( last addr )
|
||||
&next DUP2 INC2 LDAk ( last addr addr+1 c1^ )
|
||||
|
@ -1563,7 +1553,7 @@
|
|||
|
||||
( various string constants used as messages for the user )
|
||||
@messages [ &null 00
|
||||
&input-error "input 20 "error: 20 00
|
||||
&input-error "Input 20 "error: 20 00
|
||||
&bytes 20 "bytes, 00
|
||||
&save-ok "Successfully 20 "saved 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
|
||||
&unknown-input "Unknown 20 "input: 20 00
|
||||
&no-matches-found "No 20 "matches 20 "found: 20 00
|
||||
&term-size-parse-error "error 20 "parsing 20 "term 20 "size 00
|
||||
&rel-line-error "invalid 20 "relative 20 "line 20 "number 00
|
||||
&term-size-parse-error "Error 20 "parsing 20 "term 20 "size 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 )
|
||||
@filename $80
|
||||
|
||||
@undo-stack [
|
||||
&data $180 ( 128 steps )
|
||||
&pos :undo-stack/data
|
||||
]
|
||||
|
||||
( actual file data to be edited )
|
||||
@data $d000
|
||||
@data $d200
|
||||
|
||||
( end of femto.tal )
|
||||
|
|
Loading…
Reference in New Issue