diff --git a/CHANGES b/CHANGES index 89bc91f3..87288570 100644 --- a/CHANGES +++ b/CHANGES @@ -7,7 +7,7 @@ Changes in JMurmel-1.5.0 relative to JMurmel-1.4.8 error to jerror * changed defmacro: is now allowed inside labels forms - * added fresh-line, make-string-writer + * added fresh-line, make-string-writer, tabulate * mlib: added format, formatter, error diff --git a/lambda/src/main/java/io/github/jmurmel/LambdaJ.java b/lambda/src/main/java/io/github/jmurmel/LambdaJ.java index 7d632547..77e4af20 100644 --- a/lambda/src/main/java/io/github/jmurmel/LambdaJ.java +++ b/lambda/src/main/java/io/github/jmurmel/LambdaJ.java @@ -344,6 +344,7 @@ public interface ObjectWriter { default void printString(CharSequence s) { printObj(s, false); } void printEol(); default boolean freshLine() { printEol(); return true; } + default void tabulate(boolean relative, int colnum, int colinc) { printString(" "); } } /** if an atom implements this interface then {@link Writeable#printSEx(LambdaJ.WriteConsumer, boolean)} will be used by the Murmel primitive {@code write} */ @@ -1239,6 +1240,33 @@ private static class ColumnCountingWriteConsumer implements WriteConsumer { if (out.col != 0) { out.print("\n"); return true; } return false; } + @Override public void tabulate(boolean relative, int colnum, int colinc) { + if (relative) { + // ~@T performs relative tabulation. + // ~colnum,colinc@T outputs colnum spaces and then outputs the smallest non-negative number of additional spaces + // necessary to move the cursor to a column that is a multiple of colinc. + blanks(colnum); + if (colinc > 1 && out.col % colinc != 0) blanks(colinc - out.col % colinc); + } + else { + // ~T spaces over to a given column. + // ~colnum,colincT will output sufficient spaces to move the cursor to column colnum. + // If the cursor is already at or beyond column colnum, it will output spaces to move it to column colnum+k*colinc + // for the smallest positive integer k possible, unless colinc is zero, in which case no spaces are output if the cursor is already at or beyond column colnum. + final int cols = colnum - out.col; + blanks(cols); + if (colinc > 0 && cols <= 0) { + int n = out.col - colnum; + blanks(colinc - n % colinc); + } + } + } + + private void blanks(int n) { + for (int i = 0; i < n; ++i) { + out.print(" "); + } + } } private static class StringSexpWriter extends SExpressionWriter implements CharSequence { @@ -2529,6 +2557,9 @@ enum WellknownSymbol { sWriteln("writeln", Features.HAVE_IO, 0, 3) { @Override Object apply(LambdaJ intp, ConsCell args) { return writeln(intp.getLispPrinter(args, 2, intp.getLispPrinter()), args, cdr(args) == null || cadr(args) != null); } }, sLnwrite("lnwrite", Features.HAVE_IO, 0, 3) { @Override Object apply(LambdaJ intp, ConsCell args) { return lnwrite(intp.getLispPrinter(args, 2, intp.getLispPrinter()), args, cdr(args) == null || cadr(args) != null); } }, sFreshLine("fresh-line", Features.HAVE_IO, 0, 1) { @Override Object apply(LambdaJ intp, ConsCell args) { return intp.boolResult(freshLine(intp.getLispPrinter(args, 0, intp.getLispPrinter()))); } }, + sTabulate("tabulate", Features.HAVE_IO, 3, 4) { @Override Object apply(LambdaJ intp, ConsCell args) { tabulate(intp.getLispPrinter(args, 3, intp.getLispPrinter()), + car(args) != null, toNonnegInt("tabulate", cadr(args)), toNonnegInt("tabulate", caddr(args))); + return null; } }, sMakeStringWriter("make-string-writer", Features.HAVE_IO, 0) { @Override Object apply(LambdaJ intp, ConsCell args) { return LambdaJ.StringSexpWriter.make(); } }, @@ -6195,6 +6226,11 @@ static boolean freshLine(ObjectWriter lispPrinter) { return lispPrinter.freshLine(); } + static void tabulate(ObjectWriter lispPrinter, boolean relative, int colnum, int colinc) { + if (lispPrinter == null) throw errorUnsupported("tabulate", "%s: lispStdout is " + NIL); + lispPrinter.tabulate(relative, colnum, colinc); + } + static Object lnwrite(ObjectWriter lispPrinter, ConsCell arg, boolean printEscape) { if (lispPrinter == null) throw errorUnsupported("lnwrite", "%s: lispStdout is " + NIL); lispPrinter.printEol(); @@ -8829,6 +8865,8 @@ private CompilerIteratorGenerator scanHashCompiler(Object hash) { public final Object freshLine (Object... args) { clrValues(); varargsMinMax("fresh-line", args, 0, 1); return bool(LambdaJ.Subr.freshLine(getLispPrinter(args, 0, lispPrinter))); } public final Object freshLine () { clrValues(); return bool(LambdaJ.Subr.freshLine(lispPrinter)); } + public final Object _tabulate (Object... args) { clrValues(); varargsMinMax("tabulate", args, 3, 4); LambdaJ.Subr.tabulate(getLispPrinter(args, 3, lispPrinter), args[0] != null, toNonnegInt("tabulate", args[1]), toNonnegInt("tabulate", args[2])); return null; } + public final Object makeStringWriter (Object... args) { clrValues(); noArgs("make-string-writer", args); return LambdaJ.StringSexpWriter.make(); } public final Object makeStringWriter () { clrValues(); return LambdaJ.StringSexpWriter.make(); } @@ -9670,6 +9708,7 @@ protected static void main(MurmelJavaProgram program) { case "write": return (CompilerPrimitive)this::_write; case "writeln": return (CompilerPrimitive)this::_writeln; case "fresh-line": return (CompilerPrimitive)this::freshLine; + case "tabulate": return (CompilerPrimitive)this::_tabulate; case "make-string-writer": return (CompilerPrimitive)this::makeStringWriter; case "lnwrite": return (CompilerPrimitive)this::_lnwrite; @@ -9887,7 +9926,7 @@ private static void notAPrimitive(String func, Object symbol, String javaName) { + APPEND + "\n" +VALUES + "\n" + "round" + "\n" +"floor" + "\n" +"ceiling" + "\n" +"truncate" + "\n" + "fround" + "\n" +"ffloor" + "\n" +"fceiling" + "\n" +"ftruncate" + "\n" - + "sqrt" + "\n" +"log" + "\n" +"log10" + "\n" +"exp" + "\n" +"expt" + "\n" +"mod" + "\n" +"rem" + "\n" +"signum" + "\n" +"random" + "\n" + + "sqrt" + "\n" +"log" + "\n" +"log10" + "\n" +"exp" + "\n" +"expt" + "\n" +"mod" + "\n" +"rem" + "\n" +"signum" + "\n" +"random" + "\n" + "tabulate" + "\n" + "gensym" + "\n" +"trace" + "\n" +"untrace" + "\n" + JERROR + "\n" +JMETHOD + "\n" +"jproxy"; diff --git a/murmel-langref.html b/murmel-langref.html index 0ab13ab9..9673aa6b 100644 --- a/murmel-langref.html +++ b/murmel-langref.html @@ -1281,6 +1281,18 @@ Print an EOL character (-sequence) unless already at the beginning of line. +### (tabulate relativep colnum colinc) -> nil + +Since: 1.5 + +If `relativep` is nil then output sufficient spaces to move the cursor to column `colnum`. +If the cursor was already at or beyond column `colnum` and `colinc` is non-zero, +then output spaces to move the cursor to column `colnum+k*colinc` for the smallest positive integer `k` possible. + +If `relativep` is non-nil then output `colnum` spaces and then output the smallest non-negative number of additional spaces +necessary to move the cursor to a column that is a multiple of `colinc`. + + ### (make-string-writer) -> writer Since: 1.5 diff --git a/murmel-langref.lisp b/murmel-langref.lisp index 9f7397dc..97180bd2 100644 --- a/murmel-langref.lisp +++ b/murmel-langref.lisp @@ -1275,6 +1275,18 @@ pi ; ==> 3.141592653589793 ; Print an EOL character (-sequence) unless already at the beginning of line. +; = (tabulate relativep colnum colinc) -> nil +; +; Since: 1.5 +; +; If `relativep` is nil then output sufficient spaces to move the cursor to column `colnum`. +; If the cursor was already at or beyond column `colnum` and `colinc` is non-zero, +; then output spaces to move the cursor to column `colnum+k*colinc` for the smallest positive integer `k` possible. +; +; If `relativep` is non-nil then output `colnum` spaces and then output the smallest non-negative number of additional spaces +; necessary to move the cursor to a column that is a multiple of `colinc`. + + ; = (make-string-writer) -> writer ; ; Since: 1.5 diff --git a/murmel-langref.md b/murmel-langref.md index 4531c62c..e01b645e 100644 --- a/murmel-langref.md +++ b/murmel-langref.md @@ -1272,6 +1272,18 @@ Since: 1.5 Print an EOL character (-sequence) unless already at the beginning of line. +### (tabulate relativep colnum colinc) -> nil + +Since: 1.5 + +If `relativep` is nil then output sufficient spaces to move the cursor to column `colnum`. +If the cursor was already at or beyond column `colnum` and `colinc` is non-zero, +then output spaces to move the cursor to column `colnum+k*colinc` for the smallest positive integer `k` possible. + +If `relativep` is non-nil then output `colnum` spaces and then output the smallest non-negative number of additional spaces +necessary to move the cursor to a column that is a multiple of `colinc`. + + ### (make-string-writer) -> writer Since: 1.5 diff --git a/murmel.completions b/murmel.completions index 88825a6a..d66330dc 100644 --- a/murmel.completions +++ b/murmel.completions @@ -191,6 +191,7 @@ read write writeln fresh-line +tabulate make-string-writer lnwrite jformat diff --git a/samples.murmel-mlib/mlib-test.lisp b/samples.murmel-mlib/mlib-test.lisp index 08737a2e..f2fcddfb 100644 --- a/samples.murmel-mlib/mlib-test.lisp +++ b/samples.murmel-mlib/mlib-test.lisp @@ -2122,7 +2122,6 @@ bbb" "~@e" 123.456) - ;; ~F (test #-murmel "123.456" @@ -2178,6 +2177,7 @@ bbb" (test "xyxxy" "~@g" 'xyxxy) + ;; ~~ (test "~~~~~" "~5~") @@ -2185,6 +2185,20 @@ bbb" "~v~" 5) +;; ~T +(test "12345678 abc" + "12345678~tabc") + +(test "12345678 abc" + "12345678~10tabc") + +(test "12345678 abc" + "12345678~2,3tabc") + +(test "12345678 abc" + "12345678~v,v@tabc" 2 2) + + ;; Tilde asterisk (test "5" "~*~d" 4 5) diff --git a/samples.murmel-mlib/mlib.lisp b/samples.murmel-mlib/mlib.lisp index 2f38ef7e..2724a647 100644 --- a/samples.murmel-mlib/mlib.lisp +++ b/samples.murmel-mlib/mlib.lisp @@ -3951,7 +3951,16 @@ ;; Tilde T: Tabulate ((#\t #\T) - (do-char #\Tab params)) + (let* ((colnum (case (car params) + ((nil 1) 1) + (#\v (require-argument-sexp)) + (t m%nonneg-integer-for-format (car params)))) + (params (cdr params)) + (colinc (case (car params) + ((nil 1) 1) + (#\v (require-argument-sexp)) + (t m%nonneg-integer-for-format (car params))))) + (collect `(tabulate ,atp ,colnum ,colinc output-stream)))) ;; Control flow @@ -4147,7 +4156,10 @@ ;; Tilde T: Tabulate ((#\t #\T) - (do-char #\Tab params)) + (let* ((colnum (prefix-int-with-default 1)) + (params (cdr params)) + (colinc (prefix-int-with-default 1))) + (tabulate atp colnum colinc output-stream))) ;; Control flow