last pre-regex commit

This commit is contained in:
~d6 2022-03-31 23:21:49 -04:00
parent b27355c44f
commit 6db5733fd5
2 changed files with 133 additions and 72 deletions

187
femto.tal
View File

@ -142,9 +142,10 @@
( search uses .tmp/pos and .tmp/data to track query string ) ( search uses .tmp/pos and .tmp/data to track query string )
@searching [ @searching [
&active $1 &active $1 ( are we displaying search results? )
&orig-row $2 &orig-row $2 ( row we began the search at )
&orig-col $2 &orig-col $2 ( col we began the search at )
( &regex $2 ( regex to be stored if any ) )
] ]
( startup ) ( startup )
@ -152,6 +153,8 @@
;init-zero-page JSR2 ;init-zero-page JSR2
;startup JMP2 ;startup JMP2
( ~regex.tal )
( intialize zero page variables ) ( intialize zero page variables )
( ) ( )
( everything not specified starts as zero ) ( everything not specified starts as zero )
@ -279,7 +282,8 @@
;redraw-statusbar-and-cursor JSR2 ;redraw-statusbar-and-cursor JSR2
,&skip JMP ,&skip JMP
&next-line #0000 .cursor/col STZ2 &next-line #0000 .cursor/col STZ2
;inc-row JSR2 .cursor/row LDZ2 INC2 .cursor/row STZ2 JMP2r
( ;inc-row JSR2 )
;ensure-visible-cursor JSR2 ;ensure-visible-cursor JSR2
;redraw-cursor JSR2 ;redraw-cursor JSR2
&skip ;return JMP2 &skip ;return JMP2
@ -290,7 +294,8 @@
;cur-col JSR2 #0001 SUB2 .cursor/col STZ2 ;cur-col JSR2 #0001 SUB2 .cursor/col STZ2
;redraw-statusbar-and-cursor JSR2 JMP2r ;redraw-statusbar-and-cursor JSR2 JMP2r
&next-line &next-line
;dec-row JSR2 ( ;dec-row JSR2 )
.cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2 JMP2r
;cur-len JSR2 .cursor/col STZ2 ;cur-len JSR2 .cursor/col STZ2
;ensure-visible-cursor JSR2 ( FIXME ) ;ensure-visible-cursor JSR2 ( FIXME )
;redraw-cursor JSR2 ;redraw-cursor JSR2
@ -301,14 +306,16 @@
@up ( -> ) @up ( -> )
;cur-abs-row JSR2 #0000 EQU2 ,&done JCN ;cur-abs-row JSR2 #0000 EQU2 ,&done JCN
;dec-row JSR2 .cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2 JMP2r
( ;dec-row JSR2 )
;ensure-visible-cursor JSR2 ;ensure-visible-cursor JSR2
;redraw-statusbar JSR2 ;redraw-statusbar JSR2
&done ;redraw-cursor JSR2 ;return JMP2 &done ;redraw-cursor JSR2 ;return JMP2
@down ( -> ) @down ( -> )
;cur-abs-row JSR2 ;last-abs-row JSR2 EQU2 ,&done JCN ;cur-abs-row JSR2 ;last-abs-row JSR2 EQU2 ,&done JCN
;inc-row JSR2 ( ;inc-row JSR2 )
.cursor/row LDZ2 INC2 .cursor/row STZ2 JMP2r
;ensure-visible-cursor JSR2 ;ensure-visible-cursor JSR2
;redraw-statusbar JSR2 ;redraw-statusbar JSR2
&done ;redraw-cursor JSR2 ;return JMP2 &done ;redraw-cursor JSR2 ;return JMP2
@ -409,19 +416,20 @@
#01 .state/modified STZ #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
;inc-row JSR2 ( ;inc-row JSR2 )
.cursor/row LDZ2 INC2 .cursor/row STZ2 JMP2r
.buffer/line-count LDZ2k INC2 ROT STZ2 .buffer/line-count LDZ2k INC2 ROT STZ2
;ensure-visible-cursor JSR2 ;ensure-visible-cursor JSR2
;redraw-all JSR2 ;return JMP2 ;redraw-all JSR2 ;return JMP2
@at-buffer-start ( -> bool^ ) ( @at-buffer-start ( -> bool^ )
;cur-pos JSR2 ;data EQU2 JMP2r ;cur-pos JSR2 ;data EQU2 JMP2r )
@at-line-start ( -> bool^ ) ( @at-line-start ( -> bool^ )
.cursor/col LDZ2 #0000 EQU2 JMP2r .cursor/col LDZ2 #0000 EQU2 JMP2r )
@bof-is-visible ( -> bool^ ) ( @bof-is-visible ( -> bool^ )
.buffer/line-offset LDZ2 #0000 EQU2 JMP2r .buffer/line-offset LDZ2 #0000 EQU2 JMP2r )
@eof-is-visible ( -> bool^ ) @eof-is-visible ( -> bool^ )
.buffer/line-offset LDZ2 .term/rows LDZ2 ADD2 INC2 .buffer/line-offset LDZ2 .term/rows LDZ2 ADD2 INC2
@ -471,7 +479,6 @@
#0000 .cursor/col STZ2 #0000 .cursor/col STZ2
;redraw-all JSR2 ;return JMP2 ;redraw-all JSR2 ;return JMP2
@goto-line ( -> ) @goto-line ( -> )
;messages/goto-line ;messages/null ;do-goto-line ;start-prompt JSR2 ;messages/goto-line ;messages/null ;do-goto-line ;start-prompt JSR2
;redraw-prompt-and-cursor JSR2 ;return JMP2 ;redraw-prompt-and-cursor JSR2 ;return JMP2
@ -552,8 +559,6 @@
@move-to-message-line ( -> ) @move-to-message-line ( -> )
#0000 .term/rows LDZ2 #0002 ADD2 ;term-move-cursor JMP2 #0000 .term/rows LDZ2 #0002 ADD2 ;term-move-cursor JMP2
( TODO: need to create draw-prompt and call it from draw-all )
( when called vector should end in BRK ) ( when called vector should end in BRK )
@start-prompt ( prompt* default* vector* -> ) @start-prompt ( prompt* default* vector* -> )
.prompt/active LDZ ,&is-active JCN .prompt/active LDZ ,&is-active JCN
@ -613,10 +618,25 @@
;redraw-prompt-and-cursor JSR2 ;return JMP2 ;redraw-prompt-and-cursor JSR2 ;return JMP2
@do-search ( -> ) @do-search ( -> )
( TODO: verify the match found anything ) ( #0000 .searching/regex STZ2 )
( if not we should display an error instead of activating searching ) ;move-to-next-match JSR2 ,&found JCN
#01 .searching/active STZ ;move-to-prev-match JSR2 ,&found JCN
;move-to-next-match JMP2 ;move-to-message-line JSR2 ;messages/no-matches-found ;print JSR2
;draw-cursor JSR2 BRK
&found #01 .searching/active STZ ;return JMP2
( @regex-search ( -> )
;messages/regex-search-prompt ;messages/null ;do-regex-search ;start-prompt JSR2
;redraw-prompt-and-cursor JSR2 ;return JMP2
@do-regex-search ( -> )
;tmp/data ;compile .searching/regex STZ2
( compile regex )
;move-to-next-regex-match JSR2 ,&found JCN
;move-to-prev-regex-match JSR2 ,&found JCN
;move-to-message-line JSR2 ;messages/no-matches-found ;print JSR2
;draw-cursor JSR2 BRK
&found #01 .searching/active STZ ;return JMP2 )
@toggle-color ( -> ) @toggle-color ( -> )
.config/color LDZ2 #3733 EQU2 ,&wrap-around JCN .config/color LDZ2 #3733 EQU2 ,&wrap-around JCN
@ -633,11 +653,11 @@
( maybe M-% for search&replace ) ( maybe M-% for search&replace )
@on-key-escaped ( -> ) @on-key-escaped ( -> )
#00 .state/saw-esc STZ #00 .state/saw-esc STZ
( .Console/read DEI .state/key STZ )
.state/key LDZ LIT '< EQU ( M-< ) ;goto-start JCN2 .state/key LDZ LIT '< EQU ( M-< ) ;goto-start JCN2
.state/key LDZ LIT '> EQU ( M-> ) ;goto-end JCN2 .state/key LDZ LIT '> EQU ( M-> ) ;goto-end JCN2
.state/key LDZ LIT 'c EQU ( M-c ) ;toggle-color JCN2 .state/key LDZ LIT 'c EQU ( M-c ) ;toggle-color JCN2
.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 't EQU ( M-t ) ;toggle-tabs JCN2 .state/key LDZ LIT 't EQU ( M-t ) ;toggle-tabs 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
@ -707,7 +727,13 @@
( it can change in response to e.g. cursor position when ) ( it can change in response to e.g. cursor position when )
( matches overlap. ) ( matches overlap. )
@move-to-next-match @jump-to-next-match ( -> )
;move-to-next-match JSR2 POP ;return JMP2
@jump-to-prev-match ( -> )
;move-to-prev-match JSR2 POP ;return JMP2
@move-to-next-match ( -> ok^ )
.buffer/limit LDZ2 .buffer/limit LDZ2
;cur-pos JSR2 INC2 ;cur-pos JSR2 INC2
&loop &loop
@ -717,33 +743,71 @@
ORA ,&found JCN ORA ,&found JCN
INC2 ,&loop JMP INC2 ,&loop JMP
&found &found
NIP2 ;jump-to-pos JSR2 ,&done JMP NIP2 ;jump-to-pos JSR2 #01 ,&done JMP
&fail &fail
POP2 POP2 POP2 POP2 #00
&done &done
;return JMP2 JMP2r
@move-to-prev-match @move-to-prev-match ( -> ok^ )
;data ;data
;cur-pos JSR2 #0001 SUB2 ;cur-pos JSR2 #0001 SUB2
&loop &loop
GTH2k ,&fail JCN GTH2k ,&fail JMP
&next
DUP2 ;matches-at JSR2 DUP2 ;matches-at JSR2
ORA ,&found JCN ORA ,&found JCN
#0001 SUB2 ,&loop JMP #0001 SUB2 ,&loop JMP
&found &found
NIP2 ;jump-to-pos JSR2 ,&done JMP NIP2 ;jump-to-pos JSR2 #01 ,&done JMP
&fail &fail
POP2 POP2 POP2 POP2 #00
&done &done
;return JMP2 JMP2r
( @move-to-next-regex-match ( -> ok^ )
.buffer/limit LDZ2
;cur-pos JSR2 INC2
&loop
GTH2k ,&next JCN ,&fail JMP
&next
( ;search-start ;search-end )
( DUP2 ;matches-at JSR2 )
DUP2 .searching/regex LDR2 ;rx-search
,&found JCN
INC2 ( TODO move to next line )
,&loop JMP
&found
POP2 POP2
;search-start LDA2
;jump-to-pos JSR2 #01 JMP2r
&fail
POP2 POP2 #00
&done
JMP2r )
( @move-to-prev-regex-match ( -> ok^ )
#00 JMP2r
( ;data
;cur-pos JSR2 #0001 SUB2
&loop
GTH2k ,&fail JMP
DUP2 ;matches-at JSR2
ORA ,&found JCN
#0001 SUB2 ,&loop JMP
&found
NIP2 ;jump-to-pos JSR2 #01 ,&done JMP
&fail
POP2 POP2 #00
&done
JMP2r ) )
@on-key-searching @on-key-searching
.state/key LDZ #07 EQU ( C-g ) ;cancel-search JCN2 .state/key LDZ #07 EQU ( C-g ) ;cancel-search JCN2
.state/key LDZ #0d EQU ( \r ) ;finish-search JCN2 .state/key LDZ #0d EQU ( \r ) ;finish-search JCN2
.state/key LDZ #6e EQU ( n ) ;move-to-next-match JCN2 .state/key LDZ #12 EQU ( C-r ) ;jump-to-prev-match JCN2
.state/key LDZ #70 EQU ( p ) ;move-to-prev-match JCN2 .state/key LDZ #13 EQU ( C-s ) ;jump-to-next-match JCN2
.state/key LDZ #6e EQU ( n ) ;jump-to-next-match JCN2
.state/key LDZ #70 EQU ( p ) ;jump-to-prev-match JCN2
;ignore JMP2 ;ignore JMP2
@on-key-prompt @on-key-prompt
@ -805,22 +869,22 @@
@term-erase-all ( -> ) @term-erase-all ( -> )
ansi emit-2 emit-J JMP2r ansi emit-2 emit-J JMP2r
@redraw-is-set ( n^ -> ok^ ) ( @redraw-is-set ( n^ -> ok^ )
.state/redraw LDZ AND JMP2r .state/redraw LDZ AND JMP2r )
@redraw-is-unset ( n^ -> ok^ ) ( @redraw-is-unset ( n^ -> ok^ )
;redraw-is-set JSR2 #00 EQU JMP2r ;redraw-is-set JSR2 #00 EQU JMP2r )
@redraw-add ( n^ -> ) @redraw-add ( n^ -> )
.state/redraw LDZk ROT ORA SWP STZ JMP2r .state/redraw LDZk ROT ORA SWP STZ JMP2r
@redraw-clear ( -> ) #00 .state/redraw STZ JMP2r ( @redraw-clear ( -> ) #00 .state/redraw STZ JMP2r )
@redraw-cursor ( -> ) #01 ;redraw-add JMP2 @redraw-cursor ( -> ) #01 ;redraw-add JMP2
@redraw-statusbar ( -> ) #02 ;redraw-add JMP2 @redraw-statusbar ( -> ) #02 ;redraw-add JMP2
@redraw-statusbar-and-cursor ( -> ) #03 ;redraw-add JMP2 @redraw-statusbar-and-cursor ( -> ) #03 ;redraw-add JMP2
@redraw-prompt ( -> ) #04 ;redraw-add JMP2 ( @redraw-prompt ( -> ) #04 ;redraw-add JMP2 )
@redraw-prompt-and-cursor ( -> ) #05 ;redraw-add JMP2 @redraw-prompt-and-cursor ( -> ) #05 ;redraw-add JMP2
@redraw-matches ( -> ) #08 ;redraw-add JMP2 ( @redraw-matches ( -> ) #08 ;redraw-add JMP2 )
@redraw-all ( -> ) #1f ;redraw-add JMP2 @redraw-all ( -> ) #1f ;redraw-add JMP2
( @offset-for-cur-row ( @offset-for-cur-row
@ -895,9 +959,9 @@
;tmp/data ;print JSR2 ;tmp/data ;print JSR2
JMP2r JMP2r
@draw-prompt-and-cursor ( -> ) ( @draw-prompt-and-cursor ( -> )
;draw-prompt JSR2 ;draw-prompt JSR2
;draw-cursor JMP2 ;draw-cursor JMP2 )
@draw-linenum ( n* -> ) @draw-linenum ( n* -> )
;emit-reset JSR2 ;emit-reset JSR2
@ -1045,13 +1109,14 @@
( handler completion code to do necessary drawing and BRK ) ( handler completion code to do necessary drawing and BRK )
@return ( -> ) @return ( -> )
#10 ;redraw-is-set JSR2 ,&everything JCN .state/redraw LDZ
#08 ;redraw-is-unset JSR2 ,&skip-8 JCN ;draw-matches JSR2 DUP #10 AND ,&draw-all JCN
&skip-8 #04 ;redraw-is-unset JSR2 ,&skip-4 JCN ;draw-prompt JSR2 DUP #08 AND ,&do-8 JCN ,&skip-8 JMP &do-8 ;draw-matches JSR2
&skip-4 #02 ;redraw-is-unset JSR2 ,&skip-2 JCN ;draw-statusbar JSR2 &skip-8 DUP #04 AND ,&do-4 JCN ,&skip-4 JMP &do-4 ;draw-prompt JSR2
&skip-2 #01 ;redraw-is-unset JSR2 ,&skip-1 JCN ;draw-cursor JSR2 &skip-4 DUP #02 AND ,&do-2 JCN ,&skip-2 JMP &do-2 ;draw-statusbar JSR2
&skip-1 BRK &skip-2 DUP #01 AND ,&do-1 JCN ,&skip-1 JMP &do-1 ;draw-cursor JSR2
&everything ;draw-all JSR2 BRK &draw-all ;draw-all JSR2
&skip-1 POP #00 .state/redraw STZ BRK
@str-copy ( src* dst* -> ) @str-copy ( src* dst* -> )
STH2 ( src [dst] ) STH2 ( src [dst] )
@ -1076,8 +1141,8 @@
@cur-len ( -> n* ) @cur-len ( -> n* )
;cur-line JSR2 ;line-len JMP2 ;cur-line JSR2 ;line-len JMP2
@cur-last ( -> n* ) ( @cur-last ( -> n* )
;cur-line JSR2 ;line-len JSR2 #0001 SUB2 JMP2r ;cur-line JSR2 ;line-len JSR2 #0001 SUB2 JMP2r )
( @cur-width ( -> n* ) ( @cur-width ( -> n* )
;cur-line JSR2 ;line-width JMP2 ) ;cur-line JSR2 ;line-width JMP2 )
@ -1106,14 +1171,8 @@
.term/rows LDZ2 ADD2 LTH2 JMP2r .term/rows LDZ2 ADD2 LTH2 JMP2r
&no POP2 POP2 #00 JMP2r &no POP2 POP2 #00 JMP2r
( TODO: leaving stuff on stack it seems )
@jump-to-pos ( s* -> ) @jump-to-pos ( s* -> )
;pos-to-row-col JSR2 ( row col ) ;pos-to-row-col JSR2 SWP2 ;move-to-coord JMP2
SWP2 ( DUP2 ;line-is-visible JSR2 ,&short JCN
;jump-to-line JSR2 ,&done JMP
&short .cursor/row STZ2
&done .cursor/col STZ2 JMP2r )
;move-to-coord JMP2
@pos-to-row-col ( s* -> row* col* ) @pos-to-row-col ( s* -> row* col* )
#0000 ,&row STR2 #0000 ,&row STR2
@ -1227,11 +1286,11 @@
#0000 .cursor/row STZ2 #0000 .cursor/row STZ2
JMP2r JMP2r
@inc-row ( -> ) ( @inc-row ( -> )
.cursor/row LDZ2 INC2 .cursor/row STZ2 JMP2r .cursor/row LDZ2 INC2 .cursor/row STZ2 JMP2r )
@dec-row ( -> ) ( @dec-row ( -> )
.cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2 JMP2r .cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2 JMP2r )
@last-pos ( -> addr* ) @last-pos ( -> addr* )
.buffer/limit LDZ2 #0001 SUB2 JMP2r .buffer/limit LDZ2 #0001 SUB2 JMP2r
@ -1304,8 +1363,10 @@
&goto-line "Go 20 "to 20 "line: 20 00 &goto-line "Go 20 "to 20 "line: 20 00
&save-prompt "File 20 "Name 20 "to 20 "Write: 20 00 &save-prompt "File 20 "Name 20 "to 20 "Write: 20 00
&search-prompt "Text 20 "to 20 "Search 20 "for: 20 00 &search-prompt "Text 20 "to 20 "Search 20 "for: 20 00
( &regex-search-prompt "Regex 20 "to 20 "Search 20 "for: 20 00 )
&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 00
&saved "-- 20 00 &saved "-- 20 00
&unsaved "** 20 00 &unsaved "** 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

View File

@ -73,10 +73,10 @@
( 5. when backtracking we must rewind to "last started" subgroup ) ( 5. when backtracking we must rewind to "last started" subgroup )
%debug { #ff #0e DEO } %debug { #ff #0e DEO }
%emit { #18 DEO } ( %emit { #18 DEO } )
%space { #20 emit } %space { #20 emit }
%newline { #0a emit } %newline { #0a emit }
%quit! { #01 #0f DEO BRK } ( %quit! { #01 #0f DEO BRK } )
( now that uxnasm throws errors about writing into the zero page ) ( now that uxnasm throws errors about writing into the zero page )
( we have to do something like this to be able to compile library ) ( we have to do something like this to be able to compile library )
@ -84,17 +84,17 @@
( avoid conficting with the program we're included in. ) ( avoid conficting with the program we're included in. )
( ) ( )
( remove this if needed when including it in other projects. ) ( remove this if needed when including it in other projects. )
|2000 ( |2000 )
( ERROR HANDLING ) ( ERROR HANDLING )
( using error! will print the given message before causing ) ( using error! will print the given message before causing )
( the interpreter to halt. ) ( the interpreter to halt. )
@error! ( msg* -> ) ( @error! ( msg* -> )
LIT '! emit space LIT '! emit space
&loop LDAk ,&continue JCN ,&done JMP &loop LDAk ,&continue JCN ,&done JMP
&continue LDAk emit INC2 ,&loop JMP &continue LDAk emit INC2 ,&loop JMP
&done POP2 newline quit! &done POP2 newline quit! )
( error messages ) ( error messages )
@unknown-node-type "unknown 20 "node 20 "type 00 @unknown-node-type "unknown 20 "node 20 "type 00
@ -122,15 +122,15 @@
;reset-stack JSR2 ;reset-stack JSR2
;loop JMP2 ;loop JMP2
@search ( str* regex* -> bool^ ) @rx-search ( str* regex* -> bool^ )
#00 ;match-multiline STA #00 ;match-multiline STA
#01 ;search-mode STA #01 ;search-mode STA
;_search JMP2 ;_search JMP2
@search-multiline ( str* regex* -> bool^ ) ( @search-multiline ( str* regex* -> bool^ )
#01 ;match-multiline STA #01 ;match-multiline STA
#01 ;search-mode STA #01 ;search-mode STA
;_search JMP2 ;_search JMP2 )
@_search ( str* regex* -> bool^ ) @_search ( str* regex* -> bool^ )
STH2 ( s* [r*] ) STH2 ( s* [r*] )