commit 635922780acf4506816bd56593a17ad73b6ab39d
parent 12eb9c4837b9395ae89a93625775574e9e77dabe
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 14 Jan 2023 21:59:29 -0500
text/ed: new unit, first steps (wip)
see doc/text/ed
Diffstat:
8 files changed, 253 insertions(+), 4 deletions(-)
diff --git a/Makefile b/Makefile
@@ -65,9 +65,9 @@ testcc: dusk
testemul: dusk
echo "' byefail ' abort realias f<< tests/emul/all.fs bye" | ./dusk || (echo; exit 1)
-.PHONY: testgr
-testgr: dusk
- echo "' byefail ' abort realias f<< tests/gr/all.fs bye" | ./dusk || (echo; exit 1)
+.PHONY: testtext
+testtext: dusk
+ echo "' byefail ' abort realias f<< tests/text/all.fs bye" | ./dusk || (echo; exit 1)
.PHONY: clean
clean:
diff --git a/fs/doc/dict.txt b/fs/doc/dict.txt
@@ -255,6 +255,7 @@ llnext ll -- ll Yield next LL element.
llend ll -- ll Iterate LL until we reach the last element.
llprev tgt ll -- ll From "ll", iterate LL until we reach the element when the
LL pointer points to "tgt".
+llappend elem ll -- Append "elem" at the end of "ll".
lladd ll -- ll Write a new LL element to here, yield it, then write its
address to the last element of "ll".
llinsert 'll -- ll Given a *pointer* to a LL, write a new LL to here and
diff --git a/fs/doc/text/ed.txt b/fs/doc/text/ed.txt
@@ -0,0 +1,155 @@
+# Text Editor
+
+TODO: this editor is a work in progress. What is described below isn't yet
+entirely implemented.
+
+This line based text editor lives at text/ed.fs and allows the examination and
+modification of text contents.
+
+The central structure of this unit is Edbuf (editor buffer) and its API is
+described below. You will typically only want one copy of this structure and
+this unit automatically instantiate one and binds it to the "edbuf" structbind.
+
+This structure has all the methods to need to load, save and modify text
+contents from within it. The buffer is a linked list of Line structures which
+themselves reference buffers in an Arena allocator (see doc/lib/alloc). Lines
+have a maximum length of ARENASZ bytes.
+
+Interacting directly with the buffer structure gives you a maximum of
+flexibility, but is a bit verbose. To make text operations more efficient,
+shortcut words are provided. They are described below.
+
+Because these shortcut can clash with other words in the system, it is
+recommended to load the text editor in its own context (see doc/lib/context).
+
+## Line API
+
+The Line structure describes a line in the Ed buffer. It is a linked list. The
+line structure does not include the LF character. This means that an empty line
+has a cnt of 0.
+
+Fields:
+
+next Next line in LL
+cnt Number of characters in the line
+ptr Pointer to the first character of the line
+
+## Edbuf API
+
+Edbuf extends the IO struct (see doc/sys/io), allowing some pretty nice
+interactions with other IO-aware words. How it works is that its "IO position"
+is related to its line positioning. Whenever we change the active line, its
+"IO position" becomes the beginning of that line.
+
+An IO read of Edbuf reads the requested number of bytes from the current line
+up until the end of the line. If the read results in partially reading a line,
+"cpos" is updated with a "sub-line" position. That number is the index we're
+currently at within the current line.
+
+An IO write writes to the currently selected line. If the line already had
+contents, the written part is concatenated to the pre-existing part. If a LF is
+encountered, a new line is created and :writebuf stops.
+
+Therefore, "loading" a file contents to the buffer is a :write to it. Saving the
+buffer somewhere else is a :read from it.
+
+No special care is given to ASCII control characters except for LF. Try to avoid
+them in your text files.
+
+Line numbers are 0-indexed.
+
+Fields:
+
+buf An arena buffer with the contents of lines (see doc/lib/alloc).
+lines The first Line of the LL.
+sel A pointer to the select Line.
+cpos Current position (character index) on the current line.
+
+Words:
+
+:new ( -- edbuf )
+ Create a new Edbuf structure with its own "buf" arena.
+
+:empty ( self -- )
+ Empty the buffer, resetting positions and arena allocator.
+
+:line ( n self -- line )
+ Return Line reference for line at index "n".
+
+:print ( n self -- )
+ Print "n" lines, starting from current line, to stdio.
+
+:cprint ( self -- )
+ Print current line with a second line under it containing a "^" character
+ indicating the current "cpos".
+
+:insert ( n self -- )
+ Insert "n" empty lines at "lpos", displacing subsequent lines by "n".
+
+:delete ( n self -- )
+ Delete "n" lines starting from "lpos".
+
+:cinsert ( a u self -- )
+ Insert character range "a u" at current line/char position. This means copying
+ the current line buffer in a new area (otherwise we overwrite another line
+ with the new contents) with the new content inserted in the middle.
+
+:cdelete ( n self -- )
+ Delete n characters from current line/char position.
+
+:cfind ( a u self -- )
+ Search current line for substring contained in range "a u". If found, move
+ "cpos" to it.
+
+## Convenience layer
+
+The convenience layer is a collection of words with short names that makes
+interacting with the API above easier. The "input" words ("a" and "i") work in
+a peculiar way because they piggy-back on sys/rdln. When one of thoe words is
+executed, it fetches the rest of the sys/rdln line directly and copies that
+string as the inserted/added string. For example, let's say that you type this:
+
+ foo bar i Hello there
+
+"foo", "bar" and "i" will be interpreted normally, but "Hello there" will be
+copied without going through the interpreter. The, rdln's input buffer is
+cleared and we go back to regular interpretation.
+
+Values:
+
+print? Boolean flags indicating whether all actions are followed by :cprint.
+pagesz Number of lines in a "page"
+
+Words:
+
+p ( -- )
+ Print one "page".
+
+s ( -- )
+ Print "stats", that is, the current line with :cprint followed by another
+ line with "current lineno" / "line count".
+
+i ( "...\n" -- )
+ Insert typed line before the current one and select it.
+
+a ( "...\n" -- )
+ Append types line after the current one and select it.
+
+d ( n -- )
+ Delete "n" lines starting from the current one.
+
+g ( lineno -- )
+ Select line number "lineno"
+
+{ ( -- )
+ Go one "page" up.
+
+} ( -- )
+ Go one "page" down.
+
+eof ( -- )
+ Go to the last line of the buffer.
+
+edload ( -- )
+ Empty the buffer and load the entire contents of "file" (see doc/sys/file)
+ into it.
diff --git a/fs/sys/rdln.fs b/fs/sys/rdln.fs
@@ -1,7 +1,7 @@
\ Readline interface
require /sys/kbd.fs
-64 const LNSZ
+$80 const LNSZ
create in( LNSZ allot
here value in)
in) value in>
diff --git a/fs/tests/all.fs b/fs/tests/all.fs
@@ -8,4 +8,5 @@ f<< /tests/comp/c/all.fs
f<< /tests/ar/all.fs
f<< /tests/emul/all.fs
f<< /tests/gr/all.fs
+f<< /tests/text/all.fs
." All tests passed\n"
diff --git a/fs/tests/text/all.fs b/fs/tests/text/all.fs
@@ -0,0 +1,2 @@
+f<< /tests/text/ed.fs
+
diff --git a/fs/tests/text/ed.fs b/fs/tests/text/ed.fs
@@ -0,0 +1,10 @@
+?f<< /tests/harness.fs
+?f<< /text/ed.fs
+testbegin
+\ Ed tests
+f" /init.fs" edload
+\ TODO: if I run this test in isolation, "s" works fine. If I run the test from
+\ the whole suite, it spits garbage and unbalances PS.
+\ s
+p
+testend
diff --git a/fs/text/ed.fs b/fs/text/ed.fs
@@ -0,0 +1,80 @@
+?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" ;
+
+struct[ Line
+ sfield next
+ sfield cnt
+ sfield ptr
+]struct
+
+extends IO struct[ Edbuf
+ sfield buf
+ sfield lines
+ sfield sel
+ sfield cpos
+
+ : _readbuf ( a self -- a? read-n ) abort" TODO" ;
+
+ : _newline ( self -- line )
+ Line SZ swap buf Arena :allot dup Line SZ 0 fill ;
+
+ : _addline ( self -- )
+ dup _newline swap 2dup to sel lines llappend ;
+
+ : _writeline ( a u self -- ) dup >r sel >r \ V1=self V2=sel
+ V2 Line ptr if \ we need to concatenate "a u" to line
+ V2 Line cnt over + V1 buf Arena :ensure ( a u )
+ V2 Line ptr V2 Line cnt V1 buf Arena :move ( a u new-a )
+ V2 to Line ptr ( a u )
+ tuck V1 buf Arena :move drop ( u )
+ else ( a u )
+ tuck V1 buf Arena :move V2 to Line ptr then ( u )
+ r> to+ Line cnt rdrop ;
+
+ : _writebuf ( a n self -- written-n ) >r \ V1=self
+ 2dup LF rot> [c]? ( a u idx ) dup 0< if
+ drop tuck r> _writeline ( written-n )
+ else ( a u idx )
+ nip tuck r@ _writeline 1+ ( written-n )
+ r> _addline then ;
+
+ : :empty ( self -- )
+ dup buf Arena :reset
+ 0 over to cpos
+ dup _newline swap 2dup to lines to sel ;
+
+ : :new ( -- edbuf )
+ Arena :new here ( arena edbuf )
+ 0 ( putback ) , ['] _readbuf , ['] _writebuf , ['] drop , ['] :empty ,
+ swap ( arena ) , 0 ( lines ) , 0 ( sel ) , 0 ( cpos ) ,
+ dup :empty ;
+
+ : :linecnt ( self -- cnt ) lines llcnt ;
+
+ : :selpos ( self -- idx ) dup sel swap lines llidx ;
+
+ : :print ( n self -- ) >r \ V1=self
+ >r V1 sel begin ( line )
+ dup Line ptr over Line cnt stdio :write LF stdout
+ llnext dup not if leave then next drop rdrop ;
+]struct
+
+Edbuf :new structbind Edbuf edbuf
+
+\ Convenience layer
+
+20 value pagesz
+
+: edload ( -- )
+ 0 file :seek edbuf :empty
+ edbuf :self file :spit
+ edbuf lines to edbuf sel ;
+
+: s ( -- ) edbuf :linecnt edbuf :selpos .f" %d / %d\n" ;
+
+: p ( -- ) pagesz edbuf :print ;
