shithub: femtolisp

Info  •  Files  •  Log

adding string.width

--- a/femtolisp/flisp.boot

+++ b/femtolisp/flisp.boot

@@ -71,7 +71,7 @@

 print-to-string

 #function("n1c0e130q42;" [#function("re0f0g00322e1f041;" [io.print io.tostring!]) buffer])

 print-exception

-#function("n1c0^^q43;" [#function("rc0mj02c1mj12g00F16[02g00Mc2<16[02e3g00b4326\x850f0c4e5g0031c6e7g0031c8352f1e9g0031315H1g00F16\x9f02g00Mc:<16\x9f02g00NF6\xb40f0c;e5g0031c<335H1g00F16\xc402g00Mc=<6\xd90f0c>312f0g00NQ25H1g00F16\xe902g00Mc?<6\x080e@e7g0031312f0cAe5g0031325H1eBg003116\x1d02e3g00b2326:1f0g00McC322cDe5g0031q325H1f0cE312f1g00312f0eF312];" [#function("o0e0e1f0t3;" [io.princ *error-stream*]) #function("o0e0e1f0t3;" [io.print *error-stream*]) type-error length= "type-error: " cadr ": expected " caddr ", got " cadddr unbound-error "unbound-error: eval: variable " " has no value" error "error: " load-error print-exception "in file " list? ": " #function("re0f03117?02f0C6H0g005K0g01f041;" [string?]) "*** Unhandled exception: " *linefeed*])])

+#function("n1c0^^q43;" [#function("rc0mj02c1mj12g00F16[02g00Mc2<16[02e3g00b4326\x850f0c4e5g0031c6e7g0031c8352f1e9g0031315M1g00F16\x9f02g00Mc:<16\x9f02g00NF6\xb40f0c;e5g0031c<335M1g00F16\xc402g00Mc=<6\xd90f0c>312f0g00NQ25M1g00F16\xe902g00Mc?<6\x080e@e7g0031312f0cAe5g0031325M1eBg003116\x1d02e3g00b2326?1f1g00M312f0cC312cDe5g0031q325M1f0cE312f1g00312f0eF312];" [#function("o0e0e1f0t3;" [io.princ *error-stream*]) #function("o0e0e1f0t3;" [io.print *error-stream*]) type-error length= "type-error: " cadr ": expected " caddr ", got " cadddr unbound-error "unbound-error: eval: variable " " has no value" error "error: " load-error print-exception "in file " list? ": " #function("re0f03117?02f0C6H0g005K0g01f041;" [string?]) "*** Unhandled exception: " *linefeed*])])

 print

 #function("o0e0e1f0t3;" [io.print *output-stream*])

 princ

--- a/femtolisp/string.c

+++ b/femtolisp/string.c

@@ -8,6 +8,7 @@

 #include <stdarg.h>

 #include <assert.h>

 #include <ctype.h>

+#include <wchar.h>

 #include <wctype.h>

 #include <sys/types.h>

 #include <sys/time.h>

@@ -46,6 +47,22 @@

     return size_wrap(u8_charnum(str+start, stop-start));

 }

+value_t fl_string_width(value_t *args, u_int32_t nargs)

+{

+    argcount("string.width", nargs, 1);

+    if (iscprim(args[0])) {

+        cprim_t *cp = (cprim_t*)ptr(args[0]);

+        if (cp_class(cp) == wchartype) {

+            int w = wcwidth(*(uint32_t*)cp_data(cp));

+            if (w < 0)

+                return FL_F;

+            return fixnum(w);

+        }

+    }

+    char *s = tostring(args[0], "string.width");

+    return size_wrap(u8_strwidth(s));

+}

+

 value_t fl_string_reverse(value_t *args, u_int32_t nargs)

 {

     argcount("string.reverse", nargs, 1);

@@ -373,6 +390,7 @@

     { "string", fl_string },

     { "string?", fl_stringp },

     { "string.count", fl_string_count },

+    { "string.width", fl_string_width },

     { "string.split", fl_string_split },

     { "string.sub", fl_string_sub },

     { "string.find", fl_string_find },

--- a/femtolisp/system.lsp

+++ b/femtolisp/system.lsp

@@ -734,7 +734,8 @@

 	((and (list? e)

 	      (length= e 2))

-	 (eprinc (car e) ": ")

+	 (eprint (car e))

+	 (eprinc ": ")

 	 (let ((msg (cadr e)))

 	   ((if (or (string? msg) (symbol? msg))

 		eprinc eprint)

--- a/femtolisp/test.lsp

+++ b/femtolisp/test.lsp

@@ -218,3 +218,11 @@

       (accumulate-while (pair? lst) (f (car lst) i)

                         (begin (set! lst (cdr lst))

                                (set! i (1+ i)))))))

+

+(define (string.findall haystack needle . offs)

+  (define (sub h n offs lst)

+    (let ((i (string.find h n offs)))

+      (if i

+	  (sub h n (string.inc h i) (cons i lst))

+	  (reverse! lst))))

+  (sub haystack needle (if (null? offs) 0 (car offs)) ()))

--- a/femtolisp/todo

+++ b/femtolisp/todo

@@ -845,7 +845,7 @@

  string.rfind

 *string.encode  - to utf8

 *string.decode  - from utf8 to UCS

- string.width   - # columns

+*string.width   - # columns

 *string.map     - (string.map f s)

@@ -948,7 +948,7 @@

 * *print-pretty* to control it

-- if indent gets too large, dedent back to left edge

+* if indent gets too large, dedent back to left edge

 -----------------------------------------------------------------------------