From 48e0e179ca9579eca414804aa4f8e7ae8fb040bb Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 13 Aug 2015 06:18:32 -0700
Subject: New display-width function.

* eval.c (eval_init): Register display-width intrinsic.

* lib.c (display_width): New function.

* lib.h (display_width): Declared.

* txr.1: Documented display-width.
---
 eval.c |  1 +
 lib.c  | 22 ++++++++++++++++++++++
 lib.h  |  1 +
 txr.1  | 27 +++++++++++++++++++++++++++
 4 files changed, 51 insertions(+)

diff --git a/eval.c b/eval.c
index 0432931a..b7e31992 100644
--- a/eval.c
+++ b/eval.c
@@ -4463,6 +4463,7 @@ void eval_init(void)
   reg_fun(intern(lit("prinl"), user_package), func_n2o(prinl, 1));
   reg_fun(intern(lit("pprinl"), user_package), func_n2o(pprinl, 1));
   reg_fun(intern(lit("tprint"), user_package), func_n2o(tprint, 1));
+  reg_fun(intern(lit("display-width"), user_package), func_n1(display_width));
 
   reg_varl(user_package_s = intern(lit("user-package"), user_package_var),
            user_package_var);
diff --git a/lib.c b/lib.c
index 4a110875..103c92cd 100644
--- a/lib.c
+++ b/lib.c
@@ -7211,6 +7211,28 @@ val tostringp(val obj)
   return get_string_from_stream(ss);
 }
 
+val display_width(val obj)
+{
+  if (stringp(obj)) {
+    const wchar_t *s = c_str(obj);
+    cnum width = 0;
+    for (; *s; s++) {
+      if (iswcntrl(*s))
+        continue;
+      width += 1 + wide_display_char_p(*s);
+    }
+    return num(width);
+  } else if (chrp(obj)) {
+    wchar_t ch = c_chr(obj);
+    if (iswcntrl(ch))
+      return zero;
+    return num_fast(1 + wide_display_char_p(ch));
+  }
+
+  uw_throwf(type_error_s, lit("display-width: ~s isn't a character or string"),
+            obj, nao);
+}
+
 val time_sec(void)
 {
   struct timeval tv;
diff --git a/lib.h b/lib.h
index b75f519e..ad5194bd 100644
--- a/lib.h
+++ b/lib.h
@@ -860,6 +860,7 @@ val obj_print(val obj, val stream);
 val obj_pprint(val obj, val stream);
 val tostring(val obj);
 val tostringp(val obj);
+val display_width(val obj);
 #if !HAVE_SETENV
 void setenv(const char *name, const char *value, int overwrite);
 void unsetenv(const char *name);
diff --git a/txr.1 b/txr.1
index e9bf5832..d788c6bb 100644
--- a/txr.1
+++ b/txr.1
@@ -27328,6 +27328,33 @@ results in no output at all.  This effectively means that an arbitrarily nested
 structure of lists and vectors is printed flattened, with one element on each
 line.
 
+.coNP Function @ display-width
+.synb
+.mets (display-width << char )
+.mets (display-width << string )
+.syne
+.desc
+The
+.code display-width
+function calculates the number of places occupied by the printed representation
+of
+.meta char
+or
+.metn string
+on a monospace display which renders certain characters, such as the East Asian
+kanji and other characters, using two places.
+
+For a
+.meta string
+argument, this value is the sum of the individual display width of the
+string's constituent characters. The display width of an empty string is zero.
+
+Control characters are assigned a display width of zero, regardless of
+their display control semantics, if any.
+
+Characters marked by Unicode as being wide or full width, have a display
+width of two. Other characters have a display width of one.
+
 .coNP Function @ streamp
 .synb
 .mets (streamp << obj )
-- 
cgit v1.2.3