d6
/
nxu
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

got undo working

This commit is contained in:
~d6 2022-04-08 23:52:07 -04:00
parent cfdc0371db
commit 81c02526c2
1 changed files with 79 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
femto.tal
View File

@ -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,11 +440,9 @@
( 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! ;messages/quit-prompt ;messages/null ;do-quit ;start-prompt JSR2
&is-modified ;redraw-prompt-and-cursor JSR2 ;return JMP2
;messages/quit-prompt ;messages/null ;do-quit ;start-prompt JSR2
;redraw-prompt-and-cursor JSR2 ;return JMP2
( display two strings on the message line ) ( display two strings on the message line )
( ) ( )
@ -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,8 +1193,13 @@
.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-:
;emit-reset JMP2 ;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 ( -> ) @draw-prompt ( -> )
;clear-message-line JSR2 ;clear-message-line JSR2
@ -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 )