ref: 91a6ae6490c3b44708c205b09615ea95595037ad
parent: 7c48f6ae533454deaa30bed3429fb5e777140b00
author: JeffBezanson <[email protected]>
date: Sun May 31 18:09:26 EDT 2009
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*])])
#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
-----------------------------------------------------------------------------