searching forward and back by regex works
This commit is contained in:
parent
da49d8bd69
commit
4ffd80526b
121
femto.tal
121
femto.tal
|
|
@ -94,8 +94,7 @@
|
|||
|
||||
@term [
|
||||
&cols $2 ( relative x coordinate of cursor, from 0 )
|
||||
&rows $2 ( relative y coordinaet of cursor, from 1 )
|
||||
( &lmargin $2 ( left padding needed for line numbers ) )
|
||||
&rows $2 ( relative y coordinate of cursor, from 1 )
|
||||
]
|
||||
|
||||
@config [
|
||||
|
|
@ -151,6 +150,8 @@
|
|||
&orig-row $2 ( row we began the search at )
|
||||
&orig-col $2 ( col we began the search at )
|
||||
®ex $2 ( regex to be stored if any )
|
||||
&start $2 ( absolute start pos of match )
|
||||
&end $2 ( absolute limit pos of match )
|
||||
]
|
||||
|
||||
( startup )
|
||||
|
|
@ -166,7 +167,6 @@
|
|||
@init-zero-page ( -> )
|
||||
#0050 .term/cols STZ2
|
||||
#0018 .term/rows STZ2
|
||||
( #0006 .term/lmargin STZ2 )
|
||||
|
||||
#0004 .config/tab-width STZ2
|
||||
#00 .config/insert-tabs STZ
|
||||
|
|
@ -605,6 +605,8 @@
|
|||
;return JMP2
|
||||
|
||||
@do-search ( -> )
|
||||
.cursor/row LDZ2 .searching/orig-row STZ2
|
||||
.cursor/col LDZ2 .searching/orig-col STZ2
|
||||
#0000 .searching/regex STZ2
|
||||
;move-to-next-match JSR2 ,&found JCN
|
||||
;move-to-prev-match JSR2 ,&found JCN
|
||||
|
|
@ -619,7 +621,10 @@
|
|||
;redraw-prompt-and-cursor JSR2 ;return JMP2
|
||||
|
||||
@do-regex-search ( -> )
|
||||
;tmp/data ;compile .searching/regex STZ2
|
||||
;cur-pos JSR2 DUP2 .searching/start STZ2 .searching/end STZ2
|
||||
.cursor/row LDZ2 .searching/orig-row STZ2
|
||||
.cursor/col LDZ2 .searching/orig-col STZ2
|
||||
;tmp/data ;compile JSR2 .searching/regex STZ2
|
||||
;move-to-next-regex-match JSR2 ,&found JCN
|
||||
;move-to-prev-regex-match JSR2 ,&found JCN
|
||||
;messages/no-matches-found ;tmp/data ;send-message JSR2 BRK
|
||||
|
|
@ -720,10 +725,16 @@
|
|||
( matches overlap. )
|
||||
|
||||
@jump-to-next-match ( -> )
|
||||
;move-to-next-match JSR2 POP ;return JMP2
|
||||
.searching/regex LDZ2 ORA ,&is-regex JCN
|
||||
;move-to-next-match JSR2 POP ;return JMP2
|
||||
&is-regex
|
||||
;move-to-next-regex-match JSR2 POP ;return JMP2
|
||||
|
||||
@jump-to-prev-match ( -> )
|
||||
;move-to-prev-match JSR2 POP ;return JMP2
|
||||
.searching/regex LDZ2 ORA ,&is-regex JCN
|
||||
;move-to-prev-match JSR2 POP ;return JMP2
|
||||
&is-regex
|
||||
;move-to-prev-regex-match JSR2 POP ;return JMP2
|
||||
|
||||
@move-to-next-match ( -> ok^ )
|
||||
.buffer/limit LDZ2
|
||||
|
|
@ -752,38 +763,42 @@
|
|||
POP2 POP2 #00 JMP2r
|
||||
|
||||
@move-to-next-regex-match ( -> ok^ )
|
||||
.buffer/limit LDZ2
|
||||
;cur-pos JSR2 INC2
|
||||
&loop
|
||||
GTH2k #00 EQU ,&fail JCN
|
||||
( ;search-start ;search-end )
|
||||
( DUP2 ;matches-at JSR2 )
|
||||
DUP2 .searching/regex LDR2 ;rx-search
|
||||
,&found JCN
|
||||
INC2 ( TODO move to next line )
|
||||
,&loop JMP
|
||||
.searching/end LDZ2 .buffer/limit LDZ2 OVR2
|
||||
GTH2 ,&ok JCN
|
||||
POP2 #00 JMP2r
|
||||
&ok
|
||||
.searching/regex LDZ2 ;rx-search JSR2 ,&found JCN
|
||||
#00 JMP2r
|
||||
&found
|
||||
POP2 POP2
|
||||
;search-start LDA2
|
||||
;search-end LDA2 .searching/end STZ2
|
||||
;search-start LDA2 DUP2 .searching/start STZ2
|
||||
;jump-to-pos JSR2 #01 JMP2r
|
||||
&fail
|
||||
POP2 POP2 #00 JMP2r
|
||||
|
||||
( compared to move-to-next-regex-match this is kind of inefficient. )
|
||||
( that's because we have no easy way to search backwards from a point. )
|
||||
( )
|
||||
( we could do some kind of fancy thing where we search the previous )
|
||||
( N bytes, then the 2N bytes before that, etc. )
|
||||
( )
|
||||
( however, 64K is small enough that just searching from the beginning )
|
||||
( and then taking the last match before the cursor works. )
|
||||
@move-to-prev-regex-match ( -> ok^ )
|
||||
#00 JMP2r
|
||||
( ;data
|
||||
;cur-pos JSR2 #0001 SUB2
|
||||
&loop
|
||||
GTH2k ,&fail JCN
|
||||
DUP2 ;matches-at JSR2
|
||||
ORA ,&found JCN
|
||||
#0001 SUB2 ,&loop JMP
|
||||
&found
|
||||
NIP2 ;jump-to-pos JSR2 #01 ,&done JMP
|
||||
&fail
|
||||
POP2 POP2 #00
|
||||
LITr 00
|
||||
;cur-pos JSR2 ;data ( limit pos [res] )
|
||||
&loop ( limit pos [res] )
|
||||
GTH2k #00 EQU ,&done JCN ( limit pos )
|
||||
DUP2 .searching/regex LDZ2 ;rx-search JSR2 ( limit pos match? )
|
||||
#00 EQU ,&done JCN ( limit pos )
|
||||
OVR2 ;search-end LDA2 LTH2 ,&done JCN
|
||||
POP2 POPr LITr 01
|
||||
;search-start LDA2 .searching/start STZ2
|
||||
;search-end LDA2 DUP2 .searching/end STZ2
|
||||
,&loop JMP
|
||||
&done
|
||||
JMP2r )
|
||||
POP2 POP2 STHr DUP #00 EQU ,&fail JCN
|
||||
.searching/start LDZ2 ;jump-to-pos JSR2
|
||||
&fail
|
||||
JMP2r
|
||||
|
||||
@on-key-searching
|
||||
.state/key LDZ #07 EQU ( C-g ) ;cancel-search JCN2
|
||||
|
|
@ -863,7 +878,7 @@
|
|||
@draw-cursor ( -> )
|
||||
.prompt/active LDZ ,&on-prompt JCN
|
||||
( TODO: handle long lines )
|
||||
;cur-w-col JSR2 ( .term/lmargin LDZ2 ) lmargin ADD2
|
||||
;cur-w-col JSR2 lmargin ADD2
|
||||
.cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2
|
||||
;term-move-cursor JMP2
|
||||
&on-prompt
|
||||
|
|
@ -971,15 +986,33 @@
|
|||
¬-end
|
||||
;abs-line JMP2
|
||||
|
||||
( TODO: enable drawing of regex matches )
|
||||
( requires a way to anchor our regex on the LHS (e.g. ^) )
|
||||
@draw-regex-matches ( -> )
|
||||
;emit-color-reverse JSR2 ( )
|
||||
;screen-limit JSR2 .buffer/offset LDZ2 ( limit pos )
|
||||
&loop ( limit pos )
|
||||
GTH2k #00 EQU ( limit pos limit>pos=0? )
|
||||
,&done JCN ( limit pos )
|
||||
DUP2 .searching/regex LDZ2 ( limit pos pos rx )
|
||||
;rx-search JSR2 #00 EQU ( limit pos found=0? )
|
||||
,&done JCN ( limit pos )
|
||||
POP2 ;search-start LDA2 ( limit start )
|
||||
GTH2k #00 EQU ( limit start limit>start=0? )
|
||||
,&done JCN ( limit start )
|
||||
;search-end LDA2 OVR2 ( limit start end start )
|
||||
;pos-to-row-col JSR2 ( limit start end row col )
|
||||
lmargin ADD2 ( limit start end row col+lm )
|
||||
SWP2 .buffer/line-offset LDZ2 SUB2 ( limit start end col+lm row-lo )
|
||||
;draw-region JSR2 ( limit )
|
||||
;search-end LDA2 ( limit end ) ,&loop JMP
|
||||
&done ( limit pos )
|
||||
POP2 POP2 JMP2r
|
||||
|
||||
@draw-matches ( -> )
|
||||
( return if not searching )
|
||||
.searching/active LDZ #00 EQU ,&return JCN ( )
|
||||
.searching/regex LDZ2 ORA ;draw-regex-matches JCN2
|
||||
;emit-color-reverse JSR2
|
||||
|
||||
( .term/lmargin LDZ2 ) lmargin ,&x STR2 #0000 ,&y STR2 ( x <- 0, y <- 0 )
|
||||
|
||||
lmargin ,&x STR2 #0000 ,&y STR2 ( x <- 0, y <- 0 )
|
||||
.buffer/offset LDZ2 DUP2
|
||||
;screen-limit JSR2 SUB2 STH2 ( offset [-count] )
|
||||
|
||||
|
|
@ -1002,7 +1035,7 @@
|
|||
ADD2 ADD2r ( offset+n [n-count] )
|
||||
,&loop JMP
|
||||
&newline ( offset [-count] )
|
||||
( .term/lmargin LDZ2 ) lmargin ,&x STR2
|
||||
lmargin ,&x STR2
|
||||
,&y LDR2 INC2 ,&y STR2
|
||||
INC2 INC2r
|
||||
,&loop JMP
|
||||
|
|
@ -1011,7 +1044,7 @@
|
|||
;emit-reset JSR2
|
||||
&return
|
||||
JMP2r
|
||||
[ &x $2 &y $2 ]
|
||||
[ &x $2 &y $2 ]
|
||||
|
||||
@emit-tab ( -> )
|
||||
#0000 .config/tab-width LDZ2 SUB2
|
||||
|
|
@ -1041,7 +1074,7 @@
|
|||
.buffer/offset LDZ2
|
||||
&bol
|
||||
ADD2kr STH2r ;draw-linenum JSR2
|
||||
( .term/lmargin LDZ2 ) lmargin INC2 ,&x STR2
|
||||
lmargin INC2 ,&x STR2
|
||||
&loop ( offset [k line-offset] )
|
||||
LDAk #00 EQU ,&eof JCN
|
||||
LDAk #0a EQU ,&eol JCN
|
||||
|
|
@ -1067,7 +1100,7 @@
|
|||
&eof-loop
|
||||
STH2kr .term/rows LDZ2 GTH2 ,&done JCN
|
||||
cr nl
|
||||
( .term/lmargin LDZ2 ) lmargin ;term-move-right JSR2
|
||||
lmargin ;term-move-right JSR2
|
||||
emit-~ INC2r
|
||||
,&eof-loop JMP
|
||||
&done POP2 POP2r POP2r
|
||||
|
|
@ -1263,7 +1296,7 @@
|
|||
®ex-search-prompt "Regex 20 "to 20 "Search 20 "for: 20 00
|
||||
&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 00
|
||||
&no-matches-found "No 20 "matches 20 "found: 20 00
|
||||
&saved "-- 20 00
|
||||
&unsaved "** 20 00
|
||||
&term-size-parse-error "error 20 "parsing 20 "term 20 "size 00
|
||||
|
|
|
|||
37
regex.tal
37
regex.tal
|
|
@ -73,10 +73,9 @@
|
|||
( 5. when backtracking we must rewind to "last started" subgroup )
|
||||
|
||||
%debug { #ff #0e DEO }
|
||||
( %emit { #18 DEO } )
|
||||
%space { #20 emit }
|
||||
%newline { #0a emit }
|
||||
( %quit! { #01 #0f DEO BRK } )
|
||||
%emit! { #18 DEO }
|
||||
%space { #20 emit! }
|
||||
%newline { #0a emit! }
|
||||
|
||||
( now that uxnasm throws errors about writing into the zero page )
|
||||
( we have to do something like this to be able to compile library )
|
||||
|
|
@ -84,17 +83,17 @@
|
|||
( avoid conficting with the program we're included in. )
|
||||
( )
|
||||
( remove this if needed when including it in other projects. )
|
||||
( |2000 )
|
||||
|2000
|
||||
|
||||
( ERROR HANDLING )
|
||||
|
||||
( using error! will print the given message before causing )
|
||||
( the interpreter to halt. )
|
||||
( @error! ( msg* -> )
|
||||
LIT '! emit space
|
||||
@error!! ( msg* -> )
|
||||
LIT '! emit! space
|
||||
&loop LDAk ,&continue JCN ,&done JMP
|
||||
&continue LDAk emit INC2 ,&loop JMP
|
||||
&done POP2 newline quit! )
|
||||
&continue LDAk emit! INC2 ,&loop JMP
|
||||
&done POP2 newline #010f DEO BRK
|
||||
|
||||
( error messages )
|
||||
@unknown-node-type "unknown 20 "node 20 "type 00
|
||||
|
|
@ -163,7 +162,7 @@
|
|||
LDAk #07 EQU ;do-dollar JCN2
|
||||
LDAk #08 EQU ;do-lpar JCN2
|
||||
LDAk #09 EQU ;do-rpar JCN2
|
||||
;unknown-node-type ;error! JSR2
|
||||
LDAk ;unknown-node-type ;error!! JSR2
|
||||
|
||||
( used when we hit a dead-end during matching. )
|
||||
( )
|
||||
|
|
@ -378,7 +377,7 @@
|
|||
POP
|
||||
;parens LDA2 #0000 GTH2 ,&mismatched-parens JCN
|
||||
;unroll-stack JSR2 POP2 JMP2r
|
||||
&mismatched-parens ;mismatched-parens ;error! JSR2
|
||||
&mismatched-parens ;mismatched-parens ;error!! JSR2
|
||||
|
||||
( called when we read "|" )
|
||||
( )
|
||||
|
|
@ -416,7 +415,7 @@
|
|||
;parens LDA2 #0001 SUB2 ;parens STA2 ( parens-- )
|
||||
;unroll-stack JSR2
|
||||
;c-peek-and-finalize JMP2
|
||||
&mismatched-parens ;mismatched-parens ;error! JSR2
|
||||
&mismatched-parens ;mismatched-parens ;error!! JSR2
|
||||
|
||||
( called when we read "." )
|
||||
( )
|
||||
|
|
@ -477,21 +476,21 @@
|
|||
( actually calling this means the code broke an invariant somewhere. )
|
||||
@c-star ( c^ -> regex* )
|
||||
POP
|
||||
;star-invariant ;error! JSR2
|
||||
;star-invariant ;error!! JSR2
|
||||
|
||||
( called if we parse a "+" )
|
||||
( )
|
||||
( actually calling this means the code broke an invariant somewhere. )
|
||||
@c-plus ( c^ -> regex* )
|
||||
POP
|
||||
;plus-invariant ;error! JSR2
|
||||
;plus-invariant ;error!! JSR2
|
||||
|
||||
( called if we parse a "?" )
|
||||
( )
|
||||
( actually calling this means the code broke an invariant somewhere. )
|
||||
@c-qmark ( c^ -> regex* )
|
||||
POP
|
||||
;qmark-invariant ;error! JSR2
|
||||
;qmark-invariant ;error!! JSR2
|
||||
|
||||
( ALLOCATING REGEX NDOES )
|
||||
|
||||
|
|
@ -617,7 +616,7 @@
|
|||
&!5 LDAk #03 NEQ ,&!3 JCN #0002 ADD2 ,&continue JMP
|
||||
&!3 INC2
|
||||
&continue ;set-next-addr JSR2 JMP2r
|
||||
&unknown ;unknown-node-type ;error! JSR2
|
||||
&unknown LDAk ;unknown-node-type ;error!! JSR2
|
||||
|
||||
@set-next-or-addr ( target* addr* -> )
|
||||
LDA2k #0000 EQU2 ( target addr addr=0? ) ,&is-zero JCN
|
||||
|
|
@ -688,11 +687,11 @@
|
|||
|
||||
( error if stack is full )
|
||||
@assert-stack-avail ( -> )
|
||||
;stack-avail JSR2 ,&ok JCN ;stack-is-full ;error! JSR2 &ok JMP2r
|
||||
;stack-avail JSR2 ,&ok JCN ;stack-is-full ;error!! JSR2 &ok JMP2r
|
||||
|
||||
( error is stack is empty )
|
||||
@assert-stack-exist ( -> )
|
||||
;stack-exist JSR2 ,&ok JCN ;stack-is-empty ;error! JSR2 &ok JMP2r
|
||||
;stack-exist JSR2 ,&ok JCN ;stack-is-empty ;error!! JSR2 &ok JMP2r
|
||||
|
||||
( stack-pos points to the next free stack position (or the top if full). )
|
||||
@stack-pos :stack-bot ( the next position to insert at )
|
||||
|
|
@ -730,7 +729,7 @@
|
|||
,&error JCN ( pos+size [pos] )
|
||||
;arena-pos STA2 ( pos += size [pos] )
|
||||
STH2r JMP2r ( pos )
|
||||
&error POP2 POP2r ;arena-is-full ;error! JSR2
|
||||
&error POP2 POP2r ;arena-is-full ;error!! JSR2
|
||||
|
||||
@arena-pos :arena-bot ( the next position to allocate )
|
||||
@arena-bot $400 @arena-top ( holds up to 1024 bytes )
|
||||
|
|
|
|||
|
|
@ -69,12 +69,12 @@
|
|||
|
||||
@emit-byte ( byte^ -- )
|
||||
DUP #04 SFT ,&hex JSR #0f AND ,&hex JMP
|
||||
&hex #30 ADD DUP #39 GTH #27 MUL ADD emit
|
||||
&hex #30 ADD DUP #39 GTH #27 MUL ADD emit!
|
||||
JMP2r
|
||||
|
||||
( print stack size, followed by contents )
|
||||
@emit-stack ( -> )
|
||||
space LIT 'n emit LIT '= emit ;stack-pos LDA2 ;stack-bot SUB2 #0004 DIV2 ;emit-short JSR2 LIT ': emit
|
||||
space LIT 'n emit! LIT '= emit! ;stack-pos LDA2 ;stack-bot SUB2 #0004 DIV2 ;emit-short JSR2 LIT ': emit!
|
||||
;stack-bot
|
||||
&loop
|
||||
DUP2 ;stack-pos LDA2 LTH2 ,&ok JCN
|
||||
|
|
@ -99,10 +99,10 @@
|
|||
DUP2 ;arena-pos LDA2 LTH2 ,&ok JCN POP2 JMP2r
|
||||
&ok
|
||||
DUP2 ;emit-short JSR2
|
||||
LIT ': emit space
|
||||
LIT ': emit! space
|
||||
LDAk #01 NEQ ,&!1 JCN #03 ;emit-n JSR2 ,&loop JMP
|
||||
&!1 LDAk #02 NEQ ,&!2 JCN #03 ;emit-n JSR2 ,&loop JMP
|
||||
&!2 LDAk #03 NEQ ,&!3 JCN #04 ;emit-n JSR2 ,&loop JMP
|
||||
&!3 LDAk #04 NEQ ,&!4 JCN #05 ;emit-n JSR2 ,&loop JMP
|
||||
&!4 LDAk #05 NEQ ,&!5 JCN #05 ;emit-n JSR2 ,&loop JMP
|
||||
&!5 ;unknown-node-type ;error! JSR2
|
||||
&!5 ;unknown-node-type ;error!! JSR2
|
||||
|
|
|
|||
Loading…
Reference in New Issue