duskos

commit aba53d399ab5e8c733a296379db1ea1c616ab2ca
parent bf035d835d0bc3bc6e442b9c1ee483f7df5d94d9
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Sun, 15 Jan 2023 14:25:47 -0500

text/ed: add some movement commands

Diffstat:
M
fs/doc/text/ed.txt
 | 
27
+++++++++++++++++++++++++++
M
fs/tests/text/ed.fs
 | 
6
+++---
M
fs/text/ed.fs
 | 
31
+++++++++++++++++++++++--------

3 files changed, 53 insertions(+), 11 deletions(-)
diff --git a/fs/doc/text/ed.txt b/fs/doc/text/ed.txt
@@ -115,6 +115,15 @@ string as the inserted/added string. For example, let's say that you type this:
 copied without going through the interpreter. The, rdln's input buffer is
 cleared and we go back to regular interpretation.
 
+### Movement
+
+Word names for movement are inspired by UNIX's vim, that is h/j/k/l. Each of
+those movement word take a number parameter to indicate by how many lines or
+characters we move. There is also "H" and "L" for beginning/end of line
+movements.
+
+### API
+
 Values:
 
 print?   Boolean flags indicating whether all actions are followed by :cprint.
@@ -141,6 +150,24 @@ d ( n -- )
 g ( lineno -- )
   Select line number "lineno"
 
+h ( n -- )
+  Go "n" characters to the left.
+
+H ( -- )
+  Go to the beginning of the line.
+
+l ( n -- )
+  Go "n" characters to the right.
+
+L ( -- )
+  Go to the end of the line.
+
+j ( n -- )
+  Go "n" lines up.
+
+k ( n -- )
+  Go "n" lines down.
+
 { ( -- )
   Go one "page" up.
 
diff --git a/fs/tests/text/ed.fs b/fs/tests/text/ed.fs
@@ -3,8 +3,8 @@
 testbegin
 \ Ed tests
 f" /tests/txtfile" edload
-edbuf sel llnext to edbuf sel
-5 to edbuf cpos
-capture s S" with some text\n     ^\n1 / 17\n" #s=
+1 g
+5 capture l
+S" with some text\n     ^\n1 / 17\n" #s=
 p
 testend
diff --git a/fs/text/ed.fs b/fs/text/ed.fs
@@ -1,10 +1,7 @@
 ?f<< /lib/arena.fs
 ?f<< /lib/fmt.fs
 ?f<< /lib/str.fs
-
-: llidx ( tgt ll -- idx )
-  0 >r begin 2dup = if 2drop r> neg exit then llnext next
-  abort" llprev failed" ;
+?f<< /lib/math.fs
 
 : nspcs ( n -- ) ?dup if >r begin SPC stdout next then ;
 
@@ -18,6 +15,7 @@ extends IO struct[ Edbuf
   sfield buf
   sfield lines
   sfield sel
+  sfield lpos
   sfield cpos
 
   : _readbuf ( a self -- a? read-n ) abort" TODO" ;
@@ -25,8 +23,17 @@ extends IO struct[ Edbuf
   : _newline ( self -- line )
     Line SZ swap buf Arena :allot dup Line SZ 0 fill ;
 
+  : _sel$ ( self -- )
+    0 over to lpos dup lines swap to sel ;
+
+  : :godown ( n self -- )
+    over if swap >r dup sel begin ( self line )
+        dup llnext if llnext over 1 swap to+ lpos else leave then
+      next then ( self line )
+    swap to sel ;
+
   : _addline ( self -- )
-    dup _newline swap 2dup to sel lines llappend ;
+    dup _newline over lines llappend 1 swap :godown ;
 
   : _writeline ( a u self -- ) dup >r sel >r \ V1=self V2=sel
     V2 Line ptr if \ we need to concatenate "a u" to line
@@ -53,12 +60,14 @@ extends IO struct[ Edbuf
   : :new ( -- edbuf )
     Arena :new here ( arena edbuf )
     0 ( putback ) , ['] _readbuf , ['] _writebuf , ['] drop , ['] :empty ,
-    swap ( arena ) , 0 ( lines ) , 0 ( sel ) , 0 ( cpos ) ,
+    swap ( arena ) , 0 ( lines ) , 0 ( sel ) , 0 ( lpos ) , 0 ( cpos ) ,
     dup :empty ;
 
   : :linecnt ( self -- cnt ) lines llcnt ;
 
-  : :selpos ( self -- idx ) dup sel swap lines llidx ;
+  : :goleft ( n self -- ) dup cpos rot - max0 swap to cpos ;
+  : :goright ( n self -- ) dup cpos rot + over sel Line cnt min swap to cpos ;
+  : :go ( n self -- ) dup _sel$ :godown ;
 
   : _nl> ( -- ) LF stdout ;
 
@@ -78,6 +87,7 @@ Edbuf :new structbind Edbuf edbuf
 
 \ Convenience layer
 
+1 value print?
 20 value pagesz
 
 : edload ( -- )
@@ -85,6 +95,11 @@ Edbuf :new structbind Edbuf edbuf
   edbuf :self file :spit
   edbuf lines to edbuf sel ;
 
-: s ( -- ) edbuf :cprint edbuf :linecnt edbuf :selpos .f" %d / %d\n" ;
+: s ( -- ) edbuf :cprint edbuf :linecnt edbuf lpos .f" %d / %d\n" ;
+: ?s print? if s then ;
 
+: g ( n -- ) edbuf :go ?s ;
+: h ( n -- ) edbuf :goleft ?s ;
+: l ( n -- ) edbuf :goright ?s ;
+: j ( n -- ) edbuf :godown ?s ;
 : p ( -- ) pagesz edbuf :print ;