[PATCH] Colorized REPL

[PATCH] Colorized REPL

[Nala Ginrut]

[-- Attachment #1: Type: text/plain, Size: 599 bytes --]

Hi folks!
Here's a patch to add colorized-REPL.
With Daniel's optional REPL printer patch, this one based on the former
would print colored result more pretty than guile-colorized. 
Thanks Daniel Hartwig!

And I didn't patch the doc to add an usage for this module, since it's
very easy, like (ice-9 readline):
-----------------cut-----------------
(use-modules (ice-9 colorized))
(activate-colorized)
-----------------end-----------------
And one may add these two lines to his/her '~/.guile'.

@ludo: I attached Daniel's patch in this mail, please apply in the order
if you accept them.

Thanks!


[-- Attachment #2: 0001-repl-add-repl-option-for-customized-print.alt.patch --]
[-- Type: text/x-patch, Size: 2948 bytes --]

From 2251a259058524fbe631fd287c95b43882227f79 Mon Sep 17 00:00:00 2001
From: Daniel Hartwig <mandyke@gmail.com>
Date: Tue, 4 Dec 2012 11:41:35 +0800
Subject: [PATCH] repl: add repl-option for customized print

* module/system/repl/common.scm (repl-default-options)
  (repl-print): Add option to use customized print procedure.
* doc/ref/scheme-using.texi (REPL Commands): Update.
---
 doc/ref/scheme-using.texi     |    4 ++++
 module/system/repl/common.scm |   21 +++++++++++++++------
 2 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index 7eb84de..4f9e6db 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -445,6 +445,10 @@ choice is available.  Off by default (indicating compilation).
 @item prompt
 A customized REPL prompt.  @code{#f} by default, indicating the default
 prompt.
+@item print
+A procedure of two arguments used to print the result of evaluating each
+expression.  The arguments are the current REPL and the value to print.
+By default, @code{#f}, to use the default procedure.
 @item value-history
 Whether value history is on or not.  @xref{Value History}.
 @item on-error
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index 346ba99..3f3e785 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -119,6 +119,11 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
                     ((thunk? prompt) (lambda (repl) (prompt)))
                     ((procedure? prompt) prompt)
                     (else (error "Invalid prompt" prompt)))))
+     (print #f ,(lambda (print)
+                  (cond
+                   ((not print) #f)
+                   ((procedure? print) print)
+                   (else (error "Invalid print procedure" print)))))
      (value-history
       ,(value-history-enabled?)
       ,(lambda (x)
@@ -209,12 +214,16 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
   (if (not (eq? val *unspecified*))
       (begin
         (run-hook before-print-hook val)
-        ;; The result of an evaluation is representable in scheme, and
-        ;; should be printed with the generic printer, `write'. The
-        ;; language-printer is something else: it prints expressions of
-        ;; a given language, not the result of evaluation.
-	(write val)
-	(newline))))
+        (cond
+         ((repl-option-ref repl 'print)
+          => (lambda (print) (print repl val)))
+         (else
+          ;; The result of an evaluation is representable in scheme, and
+          ;; should be printed with the generic printer, `write'. The
+          ;; language-printer is something else: it prints expressions of
+          ;; a given language, not the result of evaluation.
+          (write val)
+          (newline))))))
 
 (define (repl-option-ref repl key)
   (cadr (or (assq key (repl-options repl))
-- 
1.7.10.4


[-- Attachment #3: 0002-ice-9-colorized-REPL-feature.patch --]
[-- Type: text/x-patch, Size: 9481 bytes --]

From 74972f91b6ae4e52d1195d4ea7eda927d2264832 Mon Sep 17 00:00:00 2001
From: Nala Ginrut <nalaginrut@gmail.com>
Date: Wed, 5 Dec 2012 14:51:53 +0800
Subject: [PATCH] ice-9: colorized REPL feature.

* new file:   module/ice-9/colorized.scm
---
 module/ice-9/colorized.scm |  290 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 290 insertions(+)
 create mode 100644 module/ice-9/colorized.scm

diff --git a/module/ice-9/colorized.scm b/module/ice-9/colorized.scm
new file mode 100644
index 0000000..fe42a9a
--- /dev/null
+++ b/module/ice-9/colorized.scm
@@ -0,0 +1,290 @@
+;;  Copyright (C) 2012
+;;      "Mu Lei" known as "NalaGinrut" <NalaGinrut@gmail.com>
+;;  Ragnarok is free software: you can redistribute it and/or modify
+;;  it under the terms of the GNU General Public License as published by
+;;  the Free Software Foundation, either version 3 of the License, or
+;;  (at your option) any later version.
+
+;;  Ragnarok is distributed in the hope that it will be useful,
+;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;  GNU General Public License for more details.
+
+;;  You should have received a copy of the GNU General Public License
+;;  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (ice-9 colorized)
+  #:use-module (oop goops)
+  #:use-module (rnrs)
+  #:use-module (ice-9 rdelim)
+  #:use-module (srfi srfi-1)
+  #:use-module (system repl common)
+  #:export (activate-colorized))
+
+(define (colorized-repl-printer repl val)
+  (colorize-it val))
+
+(define (activate-colorized)
+  (repl-option-set! (car (fluid-ref *repl-stack*))
+		    'print colorized-repl-printer))
+
+(define-record-type color-scheme
+  (fields str data class color control method))
+  
+(define *color-list*
+  '((nothing      .  "0;0")
+    (black        .  "0;30")
+    (red          .  "0;31")
+    (green        .  "0;32")
+    (brown        .  "0;33")
+    (blue         .  "0;34")
+    (cyan         .  "0;36")
+    (purple       .  "0;35")
+    (light-gray   .  "0;37")
+    (dark-gray    .  "1;30")
+    (light-red    .  "1;31")
+    (light-green  .  "1;32")
+    (yellow       .  "1;33")
+    (light-blue   .  "1;34")
+    (light-cyan   .  "1;36")
+    (light-purple .  "1;35")
+    (white        .  "1;37")))
+
+(define get-color
+  (lambda (color)
+    (assoc-ref *color-list* color)))
+
+(define color-it
+  (lambda (cs)
+    (let* ((str (color-scheme-str cs))
+	   (color (color-scheme-color cs))
+	   (control (color-scheme-control cs)))
+      (color-it-inner color str control))))
+
+(define color-it-inner
+  (lambda (color str control)
+    (string-append "\x1b[" (get-color color) "m" str "\x1b[" control "m")))
+
+(define *pre-sign* 
+  `((,<list>       .   "(") 
+    (,<pair>       .   "(") 
+    (,<vector>     .   "#(")
+    (,<bytevector> .   "#vu8(")
+    (,<array>      .   #f))) ;; array's sign is complecated.
+
+(define* (pre-print cs #:optional (port (current-output-port)))
+  (let* ((class (color-scheme-class cs))
+	 (control (color-scheme-control cs))
+	 (sign (assoc-ref *pre-sign* class))
+	 (color (color-scheme-color cs))) ;; (car color) is the color, (cdr color) is the control
+    (if sign
+	(display (color-it-inner color sign control) port)  ;; not array
+	(display (color-array-inner cs) port) ;; array complecated coloring
+	)))
+
+(define (print-dot port)
+  (display (color-it-inner 'light-cyan "." "0") port))
+
+(define is-sign?
+  (lambda (ch)
+    (char-set-contains? char-set:punctuation ch)))
+
+(define color-array-inner
+  (lambda (cs)
+    (let* ((colors (color-scheme-color cs))
+	   (control (color-scheme-control cs))
+	   (sign-color (car colors))
+	   (attr-color (cadr colors))
+	   (str (color-scheme-str cs))
+	   (attrs (string->list 
+		   (call-with-input-string str (lambda (p) (read-delimited "(" p))))))
+      (call-with-output-string
+       (lambda (port)
+	 (for-each (lambda (ch)
+		     (let ((color (if (is-sign? ch) sign-color attr-color)))
+		       (display (color-it-inner color (string ch) control) port)))
+		   attrs)
+	 (display (color-it-inner sign-color "(" control) port) ;; output right-parent
+	 )))))
+
+;; I believe all end-sign is ")"      
+(define* (post-print cs #:optional (port (current-output-port)))
+  (let* ((c (color-scheme-color cs))
+	 (control (color-scheme-control cs))
+	 (color (if (list? c) (car c) c))) ;; array has a color-list
+    (display (color-it-inner color ")" control) port)))
+
+(define (color-integer cs)
+  (color-it cs))
+
+(define (color-char cs)
+  (color-it cs))
+
+(define (color-string cs)
+  (color-it cs))
+
+(define (color-list cs)
+  (let ((data (color-scheme-data cs)))
+    (if (proper-list? data)
+	(call-with-output-string
+	 (lambda (port)
+	   (pre-print cs port)
+	   (for-each (lambda (x) (colorize x port) (display " " port)) data)
+	   (seek port -1 SEEK_CUR)
+	   (post-print cs port)))
+	(color-pair cs))))
+    
+(define (color-pair cs)
+  (let* ((data (color-scheme-data cs))
+	 (d1 (car data))
+	 (d2 (cdr data)))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (colorize d1 port)
+       (display " " port) (print-dot port) (display " " port)
+       (colorize d2 port)
+       (post-print cs port)))))
+
+(define (color-class cs)
+  (color-it cs))
+
+(define (color-procedure cs)
+  (color-it cs))
+
+(define (color-vector cs)
+  (let ((vv (color-scheme-data cs)))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (vector-for-each (lambda (x) (colorize x port) (display " " port)) vv)
+       (seek port -1 SEEK_CUR)
+       (post-print cs port)))))
+    
+(define (color-keyword cs)
+  (color-it cs))
+
+;; TODO: maybe print it as char one by one?
+(define (color-char-set cs)
+  (color-it cs))
+
+(define (color-symbol cs)
+  (color-it cs))
+
+(define (color-stack cs)
+  (color-it cs))
+
+(define (color-record-type cs)
+  (color-it cs))
+
+(define (color-real cs)
+  (color-it cs))
+
+(define (color-fraction cs)
+  (let* ((data (color-scheme-data cs))
+	 (colors (color-scheme-color cs))
+	 (num-color (car colors))
+	 (div-color (cadr colors))
+	 (control (color-scheme-control cs))
+	 (n (object->string (numerator data)))
+	 (d (object->string (denominator data))))
+    (call-with-output-string
+     (lambda (port)
+       (display (color-it-inner num-color n control) port)
+       (display (color-it-inner div-color "/" control) port)
+       (display (color-it-inner num-color d control) port)))))
+
+(define (color-regexp cs)
+  (color-it cs))
+
+(define (color-bitvector cs)
+  ;; TODO: is it right?
+  (color-it cs))
+
+(define (color-bytevector cs)
+  (let ((ll (bytevector->u8-list (color-scheme-data cs))))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (for-each (lambda (x) (colorize x port) (display " " port)) ll)
+       (seek port -1 SEEK_CUR)
+       (post-print cs port)))))
+
+(define (color-boolean cs)
+  (color-it cs))
+
+(define (color-arbiter cs)
+  (color-it cs))
+
+(define (color-array cs)
+  (let ((ll (array->list (color-scheme-data cs))))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (for-each (lambda (x) (colorize x port) (display " " port)) ll) ;; easy life to use list rather than array.
+       (seek port -1 SEEK_CUR)
+       (post-print cs port)))))
+
+(define (color-complex cs)
+  (color-it cs))
+
+(define (color-hashtable cs)
+  (color-it cs))
+
+(define (color-hook cs)
+  (color-it cs))
+
+(define (color-unknown cs)
+  (color-it cs))
+
+
+(define *colorize-list*
+  `((,<integer> ,color-integer light-blue)
+    (,<char> ,color-char brown)
+    (,<string> ,color-string red)
+    (,<list> ,color-list light-blue)
+    (,<pair> ,color-list light-gray) ;; NOTE: proper-list is a <pair>, and cons is <pair> too, so call color-list either.
+    (,<class> ,color-class light-cyan)
+    (,<procedure> ,color-procedure yellow)
+    (,<vector> ,color-vector light-purple)
+    (,<keyword> ,color-keyword purple)
+    (,<character-set> ,color-char-set white)
+    (,<symbol> ,color-symbol light-green)
+    (,<stack> ,color-stack purple)
+    (,<record-type> ,color-record-type dark-gray)
+    (,<real> ,color-real yellow)
+    (,<fraction> ,color-fraction (light-blue yellow))
+    (,<regexp> ,color-regexp green)
+    (,<bitvector> ,color-bitvector brown)
+    (,<bytevector> ,color-bytevector cyan)
+    (,<boolean> ,color-boolean blue)
+    (,<arbiter> ,color-arbiter blue)
+    (,<array> ,color-array (light-cyan brown))
+    (,<complex> ,color-complex purple)
+    (,<hashtable> ,color-hashtable blue)
+    (,<hook> ,color-hook green)
+    (,<unknown> ,color-unknown white)
+    ;; TODO: if there's anything to add
+    ))
+
+;; NOTE: we don't use control now, but I write the mechanism for future usage.
+(define generate-color-scheme
+  (lambda (data)
+    (let* ((class (class-of data))
+	   (str (object->string data))
+	   (r (assoc-ref *colorize-list* class))
+	   (method (car r))
+	   (color (cadr r)))
+      (make-color-scheme str data class color "0" method)))) 
+
+(define* (colorize-it data #:optional (port (current-output-port)))
+  (colorize data port)
+  (newline port))
+
+(define* (colorize data #:optional (port (current-output-port)))
+  (let* ((cs (generate-color-scheme data))
+	 (f (color-scheme-method cs)))
+    (display (f cs) port)))
+
+
+
-- 
1.7.10.4

Re: [PATCH] Colorized REPL

[Daniel Hartwig]

On 5 December 2012 15:21, Nala Ginrut <nalaginrut@gmail.com> wrote:
> Hi folks!
> Here's a patch to add colorized-REPL.

Some comments :-)

diff --git a/module/ice-9/colorized.scm b/module/ice-9/colorized.scm
new file mode 100644
index 0000000..fe42a9a
--- /dev/null
+++ b/module/ice-9/colorized.scm
@@ -0,0 +1,290 @@
+;;  Copyright (C) 2012
+;;      "Mu Lei" known as "NalaGinrut" <NalaGinrut@gmail.com>
+;;  Ragnarok is free software: you can redistribute it and/or modify
+;;  it under the terms of the GNU General Public License as published by
+;;  the Free Software Foundation, either version 3 of the License, or
+;;  (at your option) any later version.

Contributions to GNU must have the copyright assigned to FSF, no?


+  #:use-module (oop goops)

This module seems only used to determine the type of each datum for
assigning a colour:

+(define *colorize-list*
+  `((,<integer> ,color-integer light-blue)
+    (,<char> ,color-char brown)

The datums tested for are all primitives.  For reference, the
“class-of” operator is more-or-less equivalent to:

 (cond
  ((integer? x) <interge>)
  ((char? x) <char>)
  …

Is there some advantage to using the GOOPS classes rather than
equivalent predicates, which are more universal?  Of course, the order
of the tests matters highly in both cases.


There is already a guile-lib module (ansi term-color) that has a
particular syntax and defines the codes.  It would be excellent to
make use of it here, or at least share the syntax and avoid some
duplication.


Regards

Re: [PATCH] Colorized REPL

[Nala Ginrut]

[-- Attachment #1: Type: text/plain, Size: 2271 bytes --]

On Wed, 2012-12-05 at 16:23 +0800, Daniel Hartwig wrote:
> On 5 December 2012 15:21, Nala Ginrut <nalaginrut@gmail.com> wrote:
> > Hi folks!
> > Here's a patch to add colorized-REPL.
> 
> Some comments :-)
> 
> diff --git a/module/ice-9/colorized.scm b/module/ice-9/colorized.scm
> new file mode 100644
> index 0000000..fe42a9a
> --- /dev/null
> +++ b/module/ice-9/colorized.scm
> @@ -0,0 +1,290 @@
> +;;  Copyright (C) 2012
> +;;      "Mu Lei" known as "NalaGinrut" <NalaGinrut@gmail.com>
> +;;  Ragnarok is free software: you can redistribute it and/or modify
> +;;  it under the terms of the GNU General Public License as published by
> +;;  the Free Software Foundation, either version 3 of the License, or
> +;;  (at your option) any later version.
> 
> Contributions to GNU must have the copyright assigned to FSF, no?
> 
> 

Oh~I'm very sorry! I just copied the header from one of my project!

> +  #:use-module (oop goops)
> 
> This module seems only used to determine the type of each datum for
> assigning a colour:
> 
> +(define *colorize-list*
> +  `((,<integer> ,color-integer light-blue)
> +    (,<char> ,color-char brown)
> 
> The datums tested for are all primitives.  For reference, the
> “class-of” operator is more-or-less equivalent to:
> 
>  (cond
>   ((integer? x) <interge>)
>   ((char? x) <char>)
>   …
> 
> Is there some advantage to using the GOOPS classes rather than
> equivalent predicates, which are more universal?  Of course, the order
> of the tests matters highly in both cases.
> 

GOOPS classes covered all the possible types in Guile, and it's easy to
detect the type of a datum with class-of. I just choose the simplest way
which I can imagined.

> 
> There is already a guile-lib module (ansi term-color) that has a
> particular syntax and defines the codes.  It would be excellent to
> make use of it here, or at least share the syntax and avoid some
> duplication.
> 

The code segment of the color is not so big, so I write my own. 
And it's not easy to do a quick hack with mixing other guy's code.
For a quick hack, and it's simple, so I have no time to care about
reusing other's work. I don't think it's proper to use (ansi term-color)
purposely, since it's not in Guile.


PS: A fixed patch attached.
> 
> Regards
> 


[-- Attachment #2: 0002-ice-9-colorized-REPL-feature.patch --]
[-- Type: text/x-patch, Size: 9572 bytes --]

From a2c3d6d1873c14ff1dbc64081003ce4c0ad0e844 Mon Sep 17 00:00:00 2001
From: Nala Ginrut <nalaginrut@gmail.com>
Date: Wed, 5 Dec 2012 14:51:53 +0800
Subject: [PATCH] ice-9: colorized REPL feature.

* new file:   module/ice-9/colorized.scm
---
 module/ice-9/colorized.scm |  291 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 291 insertions(+)
 create mode 100644 module/ice-9/colorized.scm

diff --git a/module/ice-9/colorized.scm b/module/ice-9/colorized.scm
new file mode 100644
index 0000000..7c59872
--- /dev/null
+++ b/module/ice-9/colorized.scm
@@ -0,0 +1,291 @@
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (ice-9 colorized)
+  #:use-module (oop goops)
+  #:use-module (rnrs)
+  #:use-module (ice-9 rdelim)
+  #:use-module (srfi srfi-1)
+  #:use-module (system repl common)
+  #:export (activate-colorized))
+
+(define (colorized-repl-printer repl val)
+  (colorize-it val))
+
+(define (activate-colorized)
+  (repl-option-set! (car (fluid-ref *repl-stack*))
+		    'print colorized-repl-printer))
+
+(define-record-type color-scheme
+  (fields str data class color control method))
+  
+(define *color-list*
+  '((nothing      .  "0;0")
+    (black        .  "0;30")
+    (red          .  "0;31")
+    (green        .  "0;32")
+    (brown        .  "0;33")
+    (blue         .  "0;34")
+    (cyan         .  "0;36")
+    (purple       .  "0;35")
+    (light-gray   .  "0;37")
+    (dark-gray    .  "1;30")
+    (light-red    .  "1;31")
+    (light-green  .  "1;32")
+    (yellow       .  "1;33")
+    (light-blue   .  "1;34")
+    (light-cyan   .  "1;36")
+    (light-purple .  "1;35")
+    (white        .  "1;37")))
+
+(define get-color
+  (lambda (color)
+    (assoc-ref *color-list* color)))
+
+(define color-it
+  (lambda (cs)
+    (let* ((str (color-scheme-str cs))
+	   (color (color-scheme-color cs))
+	   (control (color-scheme-control cs)))
+      (color-it-inner color str control))))
+
+(define color-it-inner
+  (lambda (color str control)
+    (string-append "\x1b[" (get-color color) "m" str "\x1b[" control "m")))
+
+(define *pre-sign* 
+  `((,<list>       .   "(") 
+    (,<pair>       .   "(") 
+    (,<vector>     .   "#(")
+    (,<bytevector> .   "#vu8(")
+    (,<array>      .   #f))) ;; array's sign is complecated.
+
+(define* (pre-print cs #:optional (port (current-output-port)))
+  (let* ((class (color-scheme-class cs))
+	 (control (color-scheme-control cs))
+	 (sign (assoc-ref *pre-sign* class))
+	 (color (color-scheme-color cs))) ;; (car color) is the color, (cdr color) is the control
+    (if sign
+	(display (color-it-inner color sign control) port)  ;; not array
+	(display (color-array-inner cs) port) ;; array complecated coloring
+	)))
+
+(define (print-dot port)
+  (display (color-it-inner 'light-cyan "." "0") port))
+
+(define is-sign?
+  (lambda (ch)
+    (char-set-contains? char-set:punctuation ch)))
+
+(define color-array-inner
+  (lambda (cs)
+    (let* ((colors (color-scheme-color cs))
+	   (control (color-scheme-control cs))
+	   (sign-color (car colors))
+	   (attr-color (cadr colors))
+	   (str (color-scheme-str cs))
+	   (attrs (string->list 
+		   (call-with-input-string str (lambda (p) (read-delimited "(" p))))))
+      (call-with-output-string
+       (lambda (port)
+	 (for-each (lambda (ch)
+		     (let ((color (if (is-sign? ch) sign-color attr-color)))
+		       (display (color-it-inner color (string ch) control) port)))
+		   attrs)
+	 (display (color-it-inner sign-color "(" control) port) ;; output right-parent
+	 )))))
+
+;; I believe all end-sign is ")"      
+(define* (post-print cs #:optional (port (current-output-port)))
+  (let* ((c (color-scheme-color cs))
+	 (control (color-scheme-control cs))
+	 (color (if (list? c) (car c) c))) ;; array has a color-list
+    (display (color-it-inner color ")" control) port)))
+
+(define (color-integer cs)
+  (color-it cs))
+
+(define (color-char cs)
+  (color-it cs))
+
+(define (color-string cs)
+  (color-it cs))
+
+(define (color-list cs)
+  (let ((data (color-scheme-data cs)))
+    (if (proper-list? data)
+	(call-with-output-string
+	 (lambda (port)
+	   (pre-print cs port)
+	   (for-each (lambda (x) (colorize x port) (display " " port)) data)
+	   (seek port -1 SEEK_CUR)
+	   (post-print cs port)))
+	(color-pair cs))))
+    
+(define (color-pair cs)
+  (let* ((data (color-scheme-data cs))
+	 (d1 (car data))
+	 (d2 (cdr data)))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (colorize d1 port)
+       (display " " port) (print-dot port) (display " " port)
+       (colorize d2 port)
+       (post-print cs port)))))
+
+(define (color-class cs)
+  (color-it cs))
+
+(define (color-procedure cs)
+  (color-it cs))
+
+(define (color-vector cs)
+  (let ((vv (color-scheme-data cs)))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (vector-for-each (lambda (x) (colorize x port) (display " " port)) vv)
+       (seek port -1 SEEK_CUR)
+       (post-print cs port)))))
+    
+(define (color-keyword cs)
+  (color-it cs))
+
+;; TODO: maybe print it as char one by one?
+(define (color-char-set cs)
+  (color-it cs))
+
+(define (color-symbol cs)
+  (color-it cs))
+
+(define (color-stack cs)
+  (color-it cs))
+
+(define (color-record-type cs)
+  (color-it cs))
+
+(define (color-real cs)
+  (color-it cs))
+
+(define (color-fraction cs)
+  (let* ((data (color-scheme-data cs))
+	 (colors (color-scheme-color cs))
+	 (num-color (car colors))
+	 (div-color (cadr colors))
+	 (control (color-scheme-control cs))
+	 (n (object->string (numerator data)))
+	 (d (object->string (denominator data))))
+    (call-with-output-string
+     (lambda (port)
+       (display (color-it-inner num-color n control) port)
+       (display (color-it-inner div-color "/" control) port)
+       (display (color-it-inner num-color d control) port)))))
+
+(define (color-regexp cs)
+  (color-it cs))
+
+(define (color-bitvector cs)
+  ;; TODO: is it right?
+  (color-it cs))
+
+(define (color-bytevector cs)
+  (let ((ll (bytevector->u8-list (color-scheme-data cs))))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (for-each (lambda (x) (colorize x port) (display " " port)) ll)
+       (seek port -1 SEEK_CUR)
+       (post-print cs port)))))
+
+(define (color-boolean cs)
+  (color-it cs))
+
+(define (color-arbiter cs)
+  (color-it cs))
+
+(define (color-array cs)
+  (let ((ll (array->list (color-scheme-data cs))))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (for-each (lambda (x) (colorize x port) (display " " port)) ll) ;; easy life to use list rather than array.
+       (seek port -1 SEEK_CUR)
+       (post-print cs port)))))
+
+(define (color-complex cs)
+  (color-it cs))
+
+(define (color-hashtable cs)
+  (color-it cs))
+
+(define (color-hook cs)
+  (color-it cs))
+
+(define (color-unknown cs)
+  (color-it cs))
+
+
+(define *colorize-list*
+  `((,<integer> ,color-integer light-blue)
+    (,<char> ,color-char brown)
+    (,<string> ,color-string red)
+    (,<list> ,color-list light-blue)
+    (,<pair> ,color-list light-gray) ;; NOTE: proper-list is a <pair>, and cons is <pair> too, so call color-list either.
+    (,<class> ,color-class light-cyan)
+    (,<procedure> ,color-procedure yellow)
+    (,<vector> ,color-vector light-purple)
+    (,<keyword> ,color-keyword purple)
+    (,<character-set> ,color-char-set white)
+    (,<symbol> ,color-symbol light-green)
+    (,<stack> ,color-stack purple)
+    (,<record-type> ,color-record-type dark-gray)
+    (,<real> ,color-real yellow)
+    (,<fraction> ,color-fraction (light-blue yellow))
+    (,<regexp> ,color-regexp green)
+    (,<bitvector> ,color-bitvector brown)
+    (,<bytevector> ,color-bytevector cyan)
+    (,<boolean> ,color-boolean blue)
+    (,<arbiter> ,color-arbiter blue)
+    (,<array> ,color-array (light-cyan brown))
+    (,<complex> ,color-complex purple)
+    (,<hashtable> ,color-hashtable blue)
+    (,<hook> ,color-hook green)
+    (,<unknown> ,color-unknown white)
+    ;; TODO: if there's anything to add
+    ))
+
+;; NOTE: we don't use control now, but I write the mechanism for future usage.
+(define generate-color-scheme
+  (lambda (data)
+    (let* ((class (class-of data))
+	   (str (object->string data))
+	   (r (assoc-ref *colorize-list* class))
+	   (method (car r))
+	   (color (cadr r)))
+      (make-color-scheme str data class color "0" method)))) 
+
+(define* (colorize-it data #:optional (port (current-output-port)))
+  (colorize data port)
+  (newline port))
+
+(define* (colorize data #:optional (port (current-output-port)))
+  (let* ((cs (generate-color-scheme data))
+	 (f (color-scheme-method cs)))
+    (display (f cs) port)))
+
+
+
-- 
1.7.10.4

Re: [PATCH] Colorized REPL

[Nala Ginrut]

[-- Attachment #1: Type: text/plain, Size: 2559 bytes --]

Wrong again. I forget add 'before-print-hook' and *unspecified*
situation.

Resend again.

On Wed, 2012-12-05 at 16:48 +0800, Nala Ginrut wrote:
> On Wed, 2012-12-05 at 16:23 +0800, Daniel Hartwig wrote:
> > On 5 December 2012 15:21, Nala Ginrut <nalaginrut@gmail.com> wrote:
> > > Hi folks!
> > > Here's a patch to add colorized-REPL.
> > 
> > Some comments :-)
> > 
> > diff --git a/module/ice-9/colorized.scm b/module/ice-9/colorized.scm
> > new file mode 100644
> > index 0000000..fe42a9a
> > --- /dev/null
> > +++ b/module/ice-9/colorized.scm
> > @@ -0,0 +1,290 @@
> > +;;  Copyright (C) 2012
> > +;;      "Mu Lei" known as "NalaGinrut" <NalaGinrut@gmail.com>
> > +;;  Ragnarok is free software: you can redistribute it and/or modify
> > +;;  it under the terms of the GNU General Public License as published by
> > +;;  the Free Software Foundation, either version 3 of the License, or
> > +;;  (at your option) any later version.
> > 
> > Contributions to GNU must have the copyright assigned to FSF, no?
> > 
> > 
> 
> Oh~I'm very sorry! I just copied the header from one of my project!
> 
> > +  #:use-module (oop goops)
> > 
> > This module seems only used to determine the type of each datum for
> > assigning a colour:
> > 
> > +(define *colorize-list*
> > +  `((,<integer> ,color-integer light-blue)
> > +    (,<char> ,color-char brown)
> > 
> > The datums tested for are all primitives.  For reference, the
> > “class-of” operator is more-or-less equivalent to:
> > 
> >  (cond
> >   ((integer? x) <interge>)
> >   ((char? x) <char>)
> >   …
> > 
> > Is there some advantage to using the GOOPS classes rather than
> > equivalent predicates, which are more universal?  Of course, the order
> > of the tests matters highly in both cases.
> > 
> 
> GOOPS classes covered all the possible types in Guile, and it's easy to
> detect the type of a datum with class-of. I just choose the simplest way
> which I can imagined.
> 
> > 
> > There is already a guile-lib module (ansi term-color) that has a
> > particular syntax and defines the codes.  It would be excellent to
> > make use of it here, or at least share the syntax and avoid some
> > duplication.
> > 
> 
> The code segment of the color is not so big, so I write my own. 
> And it's not easy to do a quick hack with mixing other guy's code.
> For a quick hack, and it's simple, so I have no time to care about
> reusing other's work. I don't think it's proper to use (ansi term-color)
> purposely, since it's not in Guile.
> 
> 
> PS: A fixed patch attached.
> > 
> > Regards
> > 
> 


[-- Attachment #2: 0002-ice-9-colorized-REPL-feature.patch --]
[-- Type: text/x-patch, Size: 9681 bytes --]

From a4609b78fdf6c96813592915be04dae3ae25f28b Mon Sep 17 00:00:00 2001
From: Nala Ginrut <nalaginrut@gmail.com>
Date: Wed, 5 Dec 2012 14:51:53 +0800
Subject: [PATCH] ice-9: colorized REPL feature.

* new file:   module/ice-9/colorized.scm
---
 module/ice-9/colorized.scm |  294 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 294 insertions(+)
 create mode 100644 module/ice-9/colorized.scm

diff --git a/module/ice-9/colorized.scm b/module/ice-9/colorized.scm
new file mode 100644
index 0000000..0602d94
--- /dev/null
+++ b/module/ice-9/colorized.scm
@@ -0,0 +1,294 @@
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (ice-9 colorized)
+  #:use-module (oop goops)
+  #:use-module (rnrs)
+  #:use-module (ice-9 rdelim)
+  #:use-module (srfi srfi-1)
+  #:use-module (system repl common)
+  #:export (activate-colorized))
+
+(define (colorized-repl-printer repl val)
+  (if (not (eq? val *unspecified*))
+      (begin
+        (run-hook before-print-hook val)  
+        (colorize-it val))))
+      
+(define (activate-colorized)
+  (repl-option-set! (car (fluid-ref *repl-stack*))
+		    'print colorized-repl-printer))
+
+(define-record-type color-scheme
+  (fields str data class color control method))
+  
+(define *color-list*
+  '((nothing      .  "0;0")
+    (black        .  "0;30")
+    (red          .  "0;31")
+    (green        .  "0;32")
+    (brown        .  "0;33")
+    (blue         .  "0;34")
+    (cyan         .  "0;36")
+    (purple       .  "0;35")
+    (light-gray   .  "0;37")
+    (dark-gray    .  "1;30")
+    (light-red    .  "1;31")
+    (light-green  .  "1;32")
+    (yellow       .  "1;33")
+    (light-blue   .  "1;34")
+    (light-cyan   .  "1;36")
+    (light-purple .  "1;35")
+    (white        .  "1;37")))
+
+(define get-color
+  (lambda (color)
+    (assoc-ref *color-list* color)))
+
+(define color-it
+  (lambda (cs)
+    (let* ((str (color-scheme-str cs))
+	   (color (color-scheme-color cs))
+	   (control (color-scheme-control cs)))
+      (color-it-inner color str control))))
+
+(define color-it-inner
+  (lambda (color str control)
+    (string-append "\x1b[" (get-color color) "m" str "\x1b[" control "m")))
+
+(define *pre-sign* 
+  `((,<list>       .   "(") 
+    (,<pair>       .   "(") 
+    (,<vector>     .   "#(")
+    (,<bytevector> .   "#vu8(")
+    (,<array>      .   #f))) ;; array's sign is complecated.
+
+(define* (pre-print cs #:optional (port (current-output-port)))
+  (let* ((class (color-scheme-class cs))
+	 (control (color-scheme-control cs))
+	 (sign (assoc-ref *pre-sign* class))
+	 (color (color-scheme-color cs))) ;; (car color) is the color, (cdr color) is the control
+    (if sign
+	(display (color-it-inner color sign control) port)  ;; not array
+	(display (color-array-inner cs) port) ;; array complecated coloring
+	)))
+
+(define (print-dot port)
+  (display (color-it-inner 'light-cyan "." "0") port))
+
+(define is-sign?
+  (lambda (ch)
+    (char-set-contains? char-set:punctuation ch)))
+
+(define color-array-inner
+  (lambda (cs)
+    (let* ((colors (color-scheme-color cs))
+	   (control (color-scheme-control cs))
+	   (sign-color (car colors))
+	   (attr-color (cadr colors))
+	   (str (color-scheme-str cs))
+	   (attrs (string->list 
+		   (call-with-input-string str (lambda (p) (read-delimited "(" p))))))
+      (call-with-output-string
+       (lambda (port)
+	 (for-each (lambda (ch)
+		     (let ((color (if (is-sign? ch) sign-color attr-color)))
+		       (display (color-it-inner color (string ch) control) port)))
+		   attrs)
+	 (display (color-it-inner sign-color "(" control) port) ;; output right-parent
+	 )))))
+
+;; I believe all end-sign is ")"      
+(define* (post-print cs #:optional (port (current-output-port)))
+  (let* ((c (color-scheme-color cs))
+	 (control (color-scheme-control cs))
+	 (color (if (list? c) (car c) c))) ;; array has a color-list
+    (display (color-it-inner color ")" control) port)))
+
+(define (color-integer cs)
+  (color-it cs))
+
+(define (color-char cs)
+  (color-it cs))
+
+(define (color-string cs)
+  (color-it cs))
+
+(define (color-list cs)
+  (let ((data (color-scheme-data cs)))
+    (if (proper-list? data)
+	(call-with-output-string
+	 (lambda (port)
+	   (pre-print cs port)
+	   (for-each (lambda (x) (colorize x port) (display " " port)) data)
+	   (seek port -1 SEEK_CUR)
+	   (post-print cs port)))
+	(color-pair cs))))
+    
+(define (color-pair cs)
+  (let* ((data (color-scheme-data cs))
+	 (d1 (car data))
+	 (d2 (cdr data)))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (colorize d1 port)
+       (display " " port) (print-dot port) (display " " port)
+       (colorize d2 port)
+       (post-print cs port)))))
+
+(define (color-class cs)
+  (color-it cs))
+
+(define (color-procedure cs)
+  (color-it cs))
+
+(define (color-vector cs)
+  (let ((vv (color-scheme-data cs)))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (vector-for-each (lambda (x) (colorize x port) (display " " port)) vv)
+       (seek port -1 SEEK_CUR)
+       (post-print cs port)))))
+    
+(define (color-keyword cs)
+  (color-it cs))
+
+;; TODO: maybe print it as char one by one?
+(define (color-char-set cs)
+  (color-it cs))
+
+(define (color-symbol cs)
+  (color-it cs))
+
+(define (color-stack cs)
+  (color-it cs))
+
+(define (color-record-type cs)
+  (color-it cs))
+
+(define (color-real cs)
+  (color-it cs))
+
+(define (color-fraction cs)
+  (let* ((data (color-scheme-data cs))
+	 (colors (color-scheme-color cs))
+	 (num-color (car colors))
+	 (div-color (cadr colors))
+	 (control (color-scheme-control cs))
+	 (n (object->string (numerator data)))
+	 (d (object->string (denominator data))))
+    (call-with-output-string
+     (lambda (port)
+       (display (color-it-inner num-color n control) port)
+       (display (color-it-inner div-color "/" control) port)
+       (display (color-it-inner num-color d control) port)))))
+
+(define (color-regexp cs)
+  (color-it cs))
+
+(define (color-bitvector cs)
+  ;; TODO: is it right?
+  (color-it cs))
+
+(define (color-bytevector cs)
+  (let ((ll (bytevector->u8-list (color-scheme-data cs))))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (for-each (lambda (x) (colorize x port) (display " " port)) ll)
+       (seek port -1 SEEK_CUR)
+       (post-print cs port)))))
+
+(define (color-boolean cs)
+  (color-it cs))
+
+(define (color-arbiter cs)
+  (color-it cs))
+
+(define (color-array cs)
+  (let ((ll (array->list (color-scheme-data cs))))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (for-each (lambda (x) (colorize x port) (display " " port)) ll) ;; easy life to use list rather than array.
+       (seek port -1 SEEK_CUR)
+       (post-print cs port)))))
+
+(define (color-complex cs)
+  (color-it cs))
+
+(define (color-hashtable cs)
+  (color-it cs))
+
+(define (color-hook cs)
+  (color-it cs))
+
+(define (color-unknown cs)
+  (color-it cs))
+
+
+(define *colorize-list*
+  `((,<integer> ,color-integer light-blue)
+    (,<char> ,color-char brown)
+    (,<string> ,color-string red)
+    (,<list> ,color-list light-blue)
+    (,<pair> ,color-list light-gray) ;; NOTE: proper-list is a <pair>, and cons is <pair> too, so call color-list either.
+    (,<class> ,color-class light-cyan)
+    (,<procedure> ,color-procedure yellow)
+    (,<vector> ,color-vector light-purple)
+    (,<keyword> ,color-keyword purple)
+    (,<character-set> ,color-char-set white)
+    (,<symbol> ,color-symbol light-green)
+    (,<stack> ,color-stack purple)
+    (,<record-type> ,color-record-type dark-gray)
+    (,<real> ,color-real yellow)
+    (,<fraction> ,color-fraction (light-blue yellow))
+    (,<regexp> ,color-regexp green)
+    (,<bitvector> ,color-bitvector brown)
+    (,<bytevector> ,color-bytevector cyan)
+    (,<boolean> ,color-boolean blue)
+    (,<arbiter> ,color-arbiter blue)
+    (,<array> ,color-array (light-cyan brown))
+    (,<complex> ,color-complex purple)
+    (,<hashtable> ,color-hashtable blue)
+    (,<hook> ,color-hook green)
+    (,<unknown> ,color-unknown white)
+    ;; TODO: if there's anything to add
+    ))
+
+;; NOTE: we don't use control now, but I write the mechanism for future usage.
+(define generate-color-scheme
+  (lambda (data)
+    (let* ((class (class-of data))
+	   (str (object->string data))
+	   (r (assoc-ref *colorize-list* class))
+	   (method (car r))
+	   (color (cadr r)))
+      (make-color-scheme str data class color "0" method)))) 
+
+(define* (colorize-it data #:optional (port (current-output-port)))
+  (colorize data port)
+  (newline port))
+
+(define* (colorize data #:optional (port (current-output-port)))
+  (let* ((cs (generate-color-scheme data))
+	 (f (color-scheme-method cs)))
+    (display (f cs) port)))
+
+
+
-- 
1.7.10.4

Re: [PATCH] Colorized REPL

[Daniel Hartwig]

On 5 December 2012 16:48, Nala Ginrut <nalaginrut@gmail.com> wrote:
>> Is there some advantage to using the GOOPS classes rather than
>> equivalent predicates, which are more universal?  Of course, the order
>> of the tests matters highly in both cases.
>>
>
> GOOPS classes covered all the possible types in Guile, and it's easy to
> detect the type of a datum with class-of. I just choose the simplest way
> which I can imagined.

Predicates cover the same or a greater range of types, in more detail.
 Consider application-specific types:
- a non-GOOPS extension will provide a predicate, but no specific GOOPS class;
- a GOOPS extension will typically provide both.

If the colouring is to be made extensible (as it should be), a system
based on GOOPS class will be insufficient for these extra types.
Further, suppose a user wants to colour the same type differently
depending on it's content (such as short vs. long strings, or strings
matching some pattern).

>
>>
>> There is already a guile-lib module (ansi term-color) that has a
>> particular syntax and defines the codes.  It would be excellent to
>> make use of it here, or at least share the syntax and avoid some
>> duplication.
>>
>
> The code segment of the color is not so big, so I write my own.
> And it's not easy to do a quick hack with mixing other guy's code.
> For a quick hack, and it's simple, so I have no time to care about
> reusing other's work.

Please consider to at least adjust your syntax to be compatible …

> I don't think it's proper to use (ansi term-color)
> purposely, since it's not in Guile.

… or target this work at extending guile-lib; as a pure-scheme module,
it certainly falls within the scope.  I understand you are keen to
have this integrated in to Guile proper.

> Wrong again. I forget add 'before-print-hook' and *unspecified*
> situation.

With the alternate (and preferred, IMO) patch I sent, the custom
print procedure should not contain those parts anyway.  You can
presume that an the before-print-hook has been called, and
unspecified value has already been ignored.

Anyway, looks like a good start to such a feature, though I am
surprised to see the structure is very different to pretty-print ! :-)

Regards

Re: [PATCH] Colorized REPL

[Daniel Llorens]

> On 5 December 2012 15:21, Nala Ginrut <nalaginrut@gmail.com> wrote:

> I don't think it's proper to use (ansi term-color)
> purposely, since it's not in Guile.

Maybe we should start moving a few things from guile-lib into Guile proper.

(ansi term-color) may be a candidate. I think that (os process) should be merged in Guile in some form, run-with-pipe has appeared in the lists a few times.

Regards

	Daniel

Re: [PATCH] Colorized REPL

[Nala Ginrut]

On Wed, 2012-12-05 at 10:50 +0100, Daniel Llorens wrote:
> > On 5 December 2012 15:21, Nala Ginrut <nalaginrut@gmail.com> wrote:
> 
> > I don't think it's proper to use (ansi term-color)
> > purposely, since it's not in Guile.
> 
> Maybe we should start moving a few things from guile-lib into Guile proper.
> 
> (ansi term-color) may be a candidate. I think that (os process) should be merged in Guile in some form, run-with-pipe has appeared in the lists a few times.
> 

No against for me.
And IIRC, I've expressed my desire for adding (os process). I ever wrote
my own implementation for one project since I didn't find one in Guile.

> Regards
> 
> 	Daniel
> 
> 

Re: [PATCH] Colorized REPL

[Daniel Hartwig]

On 5 December 2012 17:50, Daniel Llorens <daniel.llorens@bluewin.ch> wrote:
>  I think that (os process) should be merged in Guile in some
> form, run-with-pipe has appeared in the lists a few times.

Yes, this was ACK during one of those discussions.

I believe most of the problem with open-pipe may have been resolved by
changes to the soft port code, i.e. closing of only one end of the
port.

Re: [PATCH] Colorized REPL

[Nala Ginrut]

On Wed, 2012-12-05 at 17:45 +0800, Daniel Hartwig wrote:
> On 5 December 2012 16:48, Nala Ginrut <nalaginrut@gmail.com> wrote:
> >> Is there some advantage to using the GOOPS classes rather than
> >> equivalent predicates, which are more universal?  Of course, the order
> >> of the tests matters highly in both cases.
> >>
> >
> > GOOPS classes covered all the possible types in Guile, and it's easy to
> > detect the type of a datum with class-of. I just choose the simplest way
> > which I can imagined.
> 
> Predicates cover the same or a greater range of types, in more detail.
>  Consider application-specific types:
> - a non-GOOPS extension will provide a predicate, but no specific GOOPS class;
> - a GOOPS extension will typically provide both.
> 
> If the colouring is to be made extensible (as it should be), a system
> based on GOOPS class will be insufficient for these extra types.
> Further, suppose a user wants to colour the same type differently
> depending on it's content (such as short vs. long strings, or strings
> matching some pattern).
> 

OK, I understand it now. And I'm going to write an more extensible
type-checker. Nevertheless, maybe I should do some work to give the
users chance to define his/her own color-scheme in '~/.guile'. 
But it maybe not so easy, I've no idea about it yet. So I'll do the
type-checker first. 

> >
> >>
> >> There is already a guile-lib module (ansi term-color) that has a
> >> particular syntax and defines the codes.  It would be excellent to
> >> make use of it here, or at least share the syntax and avoid some
> >> duplication.
> >>
> >
> > The code segment of the color is not so big, so I write my own.
> > And it's not easy to do a quick hack with mixing other guy's code.
> > For a quick hack, and it's simple, so I have no time to care about
> > reusing other's work.
> 
> Please consider to at least adjust your syntax to be compatible …
> 
> > I don't think it's proper to use (ansi term-color)
> > purposely, since it's not in Guile.
> 
> … or target this work at extending guile-lib; as a pure-scheme module,
> it certainly falls within the scope.  I understand you are keen to
> have this integrated in to Guile proper.
> 

I can understand this too. So your suggestion is to write a 
(term ansi-color) compatible interface. I think it's easy to do.
But I'm afraid that Guile don't integrate (term ansi-color). Or I should
copy (term ansi-color) into colorized.scm? It's not a big one, but is it
proper?
Anyway, (ice-9 colorized) contains ansi-color procedures could be worthy
of the name.

What if I send three patches eventually?
1. optinal-repl-printer
2. colorized.scm
3. ansi-color.scm

I just want to make sure colorized-repl feature work successfully.

> > Wrong again. I forget add 'before-print-hook' and *unspecified*
> > situation.
> 
> With the alternate (and preferred, IMO) patch I sent, the custom
> print procedure should not contain those parts anyway.  You can
> presume that an the before-print-hook has been called, and
> unspecified value has already been ignored.
> 
> Anyway, looks like a good start to such a feature, though I am
> surprised to see the structure is very different to pretty-print ! :-)
> 
> Regards
> 

Re: [PATCH] Colorized REPL

[Daniel Hartwig]

On 5 December 2012 18:27, Nala Ginrut <nalaginrut@gmail.com> wrote:
> I can understand this too. So your suggestion is to write a
> (term ansi-color) compatible interface. I think it's easy to do.
> But I'm afraid that Guile don't integrate (term ansi-color).

In your code, one uses "(light-blue yellow)", and only some times as a
list, where as in ansi-color the symbols are upper case and the names
different, "RED ON-BLUE".  I am suggesting to use the same names for
same things, so the interface is more-or-less compatible.

> Or I should
> copy (term ansi-color) into colorized.scm? It's not a big one, but is it
> proper?

I am not sure about the licensing there.  That module is copyrighted,
though GPLv3+.  A merge /may/ require the original author to assign
the copyright.

Still, reusing it would be ideal, which is why I suggest to target
this extension to guile-lib and avoid maintaining two sets of similar
colour->ansi-string type functions.

Re: [PATCH] Colorized REPL

[Nala Ginrut]

On Wed, 2012-12-05 at 19:19 +0800, Daniel Hartwig wrote:
> On 5 December 2012 18:27, Nala Ginrut <nalaginrut@gmail.com> wrote:
> > I can understand this too. So your suggestion is to write a
> > (term ansi-color) compatible interface. I think it's easy to do.
> > But I'm afraid that Guile don't integrate (term ansi-color).
> 
> In your code, one uses "(light-blue yellow)", and only some times as a
> list, where as in ansi-color the symbols are upper case and the names
> different, "RED ON-BLUE".  I am suggesting to use the same names for
> same things, so the interface is more-or-less compatible.
> 

Agreed. ;-)

> > Or I should
> > copy (term ansi-color) into colorized.scm? It's not a big one, but is it
> > proper?
> 
> I am not sure about the licensing there.  That module is copyrighted,
> though GPLv3+.  A merge /may/ require the original author to assign
> the copyright.
> 
> Still, reusing it would be ideal, which is why I suggest to target
> this extension to guile-lib and avoid maintaining two sets of similar
> colour->ansi-string type functions.
> 


Seems things gonna be a little complicated.
IMO, the perfect solution is to merge (term ansi-color) into (ice-9
colorized), and we reused the code, and the user can use colored string,
everyone is happy.

But if we need the original author to assign the copyright, I'm not sure
how long will it be. Last time I assigned the copyright took about one
month, since it's long way to send a hand-written assignment to USA.
Or I just request the original author to assign the copyright in the
code?
Which one is right?

Re: [PATCH] Colorized REPL

[Daniel Hartwig]

On 6 December 2012 10:43, Nala Ginrut <nalaginrut@gmail.com> wrote:
> But if we need the original author to assign the copyright, I'm not sure
> how long will it be. Last time I assigned the copyright took about one
> month, since it's long way to send a hand-written assignment to USA.
> Or I just request the original author to assign the copyright in the
> code?
> Which one is right?

On those things, I don't know.

In the mean time do not worry about merging of ansi-color, just adjust
your syntax as discussed and continue to develop in your git repo.  If
it should later become merged then we can remove the duplicates.
Or—again and for the final time—target this work at guile-lib.

I presume that in the long term you would integrate this directly with
the existing pretty-print procedure, rather than, e.g., reimplementing
how to print vectors, arrays, etc..  That makes a lot of sense, and
saves you having to figure out all the details of correctly formatting
an array: just intersperse the colourize code throughout pretty-print.

Re: [PATCH] Colorized REPL

[Nala Ginrut]

On Thu, 2012-12-06 at 11:09 +0800, Daniel Hartwig wrote:
> On 6 December 2012 10:43, Nala Ginrut <nalaginrut@gmail.com> wrote:
> > But if we need the original author to assign the copyright, I'm not sure
> > how long will it be. Last time I assigned the copyright took about one
> > month, since it's long way to send a hand-written assignment to USA.
> > Or I just request the original author to assign the copyright in the
> > code?
> > Which one is right?
> 
> On those things, I don't know.
> 
> In the mean time do not worry about merging of ansi-color, just adjust
> your syntax as discussed and continue to develop in your git repo.  If
> it should later become merged then we can remove the duplicates.
> Or—again and for the final time—target this work at guile-lib.
> 

OK, I'll keep updating it here, in 'upstream' branch:
https://github.com/NalaGinrut/guile-colorized/tree/upstream
The 'upstream' branch won't guarantee an independent module to be used.

> I presume that in the long term you would integrate this directly with
> the existing pretty-print procedure, rather than, e.g., reimplementing
> how to print vectors, arrays, etc..  That makes a lot of sense, and
> saves you having to figure out all the details of correctly formatting
> an array: just intersperse the colourize code throughout pretty-print.

I was aimed to patch pretty-print for coloring. But I changed my mind
because an independent module is easy to develop and debug.
Anyway, I think it's nice to integrate it into pretty-print and
inner-debugger in the long term.

BTW, I added custom-color-scheme feature, then the users can define
their own color-scheme in '~/.guile'. As you suggested, they my define
the color for any data-type they like, they can pass their own
type-checker/colorize-method in. 
For a instance:
==========================~/.guile=============================
(use-modules (ice-9 colorized))
(add-color-scheme! 
  `(,(lambda (data) (> data 10000)) 'MY-LONG-NUMBER ,colorize 'BLUE))
=============================end===============================
And 10001 would be rendered as blue one.


Regards.

Re: [PATCH] Colorized REPL

[Daniel Hartwig]

On 6 December 2012 12:28, Nala Ginrut <nalaginrut@gmail.com> wrote:
> I was aimed to patch pretty-print for coloring. But I changed my mind
> because an independent module is easy to develop and debug.

Yes, I thought as much.  Do keep the eventual integration in mind,
since I'm sure the maintainers are not interested in another
independent logic for printing scheme values :-)

> For a instance:
> ==========================~/.guile=============================
> (use-modules (ice-9 colorized))
> (add-color-scheme!
>   `(,(lambda (data) (> data 10000)) 'MY-LONG-NUMBER ,colorize 'BLUE))
> =============================end===============================

Neat.

Re: [PATCH] Colorized REPL

[Ian Price]

Daniel Llorens <daniel.llorens@bluewin.ch> writes:

> Maybe we should start moving a few things from guile-lib into Guile proper.

Or, you could use the package manager I keep pimping :)

> (ansi term-color) may be a candidate. I think that (os process) should be merged in Guile in some form, run-with-pipe has appeared in the lists a few times.
(os process) might be reasonable, since we are forever complaining about
the popen module, but I don't see why we need (ansi term-color).

-- 
Ian Price -- shift-reset.com

"Programming is like pinball. The reward for doing it well is
the opportunity to do it again" - from "The Wizardy Compiled"

Re: [PATCH] Colorized REPL

[Daniel Hartwig]

On 9 December 2012 05:35, Ian Price <ianprice90@googlemail.com> wrote:
> Or, you could use the package manager I keep pimping :)

Yes indeed, it works quite well.  As does just adding such files to a
site- or user-local module path.

> (os process) might be reasonable, since we are forever complaining about
> the popen module, but I don't see why we need (ansi term-color).

Yes, agree.  It is best to avoid adding some extra fluff (such as ansi
color module, colored output, etc.) to the core when appropriate.
Feature creep and all that is not a big win, makes guile generally
/less/ embeddable, and such.

Re: [PATCH] Colorized REPL

[Nala Ginrut]

On Sun, 2012-12-09 at 08:50 +0800, Daniel Hartwig wrote:
> On 9 December 2012 05:35, Ian Price <ianprice90@googlemail.com> wrote:
> > Or, you could use the package manager I keep pimping :)
> 
> Yes indeed, it works quite well.  As does just adding such files to a
> site- or user-local module path.
> 
> > (os process) might be reasonable, since we are forever complaining about
> > the popen module, but I don't see why we need (ansi term-color).
> 
> Yes, agree.  It is best to avoid adding some extra fluff (such as ansi
> color module, colored output, etc.) to the core when appropriate.
> Feature creep and all that is not a big win, makes guile generally
> /less/ embeddable, and such.
> 

(ice-9 colorized) has already had the useful part compatible with (ansi
term-color), you may checkout 'upstream' branch. So we don't have to add
(ansi term-color).

@ijp: yeah~what's the status about guildhall? Is there an official
release? And the main site for it?

Re: [PATCH] Colorized REPL

[Ludovic Courtès]

Hi!

Daniel Hartwig <mandyke@gmail.com> skribis:

> I am not sure about the licensing there.  That module is copyrighted,
> though GPLv3+.  A merge /may/ require the original author to assign
> the copyright.

It’s not a requirement, but we should probably try to get in touch with
him (Richard Todd) because he actually has a copyright assignment on
file for Guile.

Nala: Would you like to ask him if he’s OK with having (term ansi-color)
integrated as part of Guile?  In that case, it would fall under FSF
copyright.

Thanks!

Ludo’.

Re: [PATCH] Colorized REPL

[Nala Ginrut]

On Mon, 2012-12-10 at 00:29 +0100, Ludovic Courtès wrote:
> Hi!
> 
> Daniel Hartwig <mandyke@gmail.com> skribis:
> 
> > I am not sure about the licensing there.  That module is copyrighted,
> > though GPLv3+.  A merge /may/ require the original author to assign
> > the copyright.
> 
> It’s not a requirement, but we should probably try to get in touch with
> him (Richard Todd) because he actually has a copyright assignment on
> file for Guile.
> 
> Nala: Would you like to ask him if he’s OK with having (term ansi-color)
> integrated as part of Guile?  In that case, it would fall under FSF
> copyright.
> 

I'll ask him later. But I think we just need part of his code, and I
rewrote most of it to be compatible with my implementation. Anyway, I'll
borrow his 'color-string' to give a way for the user to color the string
as they wish.
Since (term ansi-color) code is small one, except for the comment, do we
still need to ask him for integration? IMO, we just borrowed something
interfaces from his code.  

Another question:
I'll try to patch the colorized into 'pretty-print' now, but is it
expected? Or just leave it as a independent module? Which is the proper
way for the maintainer?

> Thanks!
> 
> Ludo’.
> 
> 

Re: [PATCH] Colorized REPL

[Ludovic Courtès]

Hi,

Nala Ginrut <nalaginrut@gmail.com> skribis:

> Since (term ansi-color) code is small one, except for the comment, do we
> still need to ask him for integration? IMO, we just borrowed something
> interfaces from his code.  

Well yes, the color table itself is public data, not even copyrightable
per se.

> Another question:
> I'll try to patch the colorized into 'pretty-print' now, but is it
> expected? Or just leave it as a independent module? Which is the proper
> way for the maintainer?

Instead of patching (ice-9 pretty-print) specifically for your purposes,
perhaps you could instead make it more generally extensible, in a way
that would be useful for your use case but not only?

(I first need to look at the other threads on this topic...)

Thanks,
Ludo’.

Re: [PATCH] Colorized REPL

[Nala Ginrut]

On Mon, 2012-12-10 at 22:42 +0100, Ludovic Courtès wrote:
> Hi,
> 
> Nala Ginrut <nalaginrut@gmail.com> skribis:
> 
> > Since (term ansi-color) code is small one, except for the comment, do we
> > still need to ask him for integration? IMO, we just borrowed something
> > interfaces from his code.  
> 
> Well yes, the color table itself is public data, not even copyrightable
> per se.
> 
> > Another question:
> > I'll try to patch the colorized into 'pretty-print' now, but is it
> > expected? Or just leave it as a independent module? Which is the proper
> > way for the maintainer?
> 
> Instead of patching (ice-9 pretty-print) specifically for your purposes,
> perhaps you could instead make it more generally extensible, in a way
> that would be useful for your use case but not only?
> 

I think (ice-9 colorized) is enough for colored-REPL purpose, of course,
with Daniel's 'option-REPL-printer' patch. Besides, it'll provide other
methods of coloring for the users.

But the opinion to patch to 'pretty-print' also has a reason: if not,
we'll keep another version of 'list/vector/array' printers. And the
output indent may be different from 'pretty-print'. Some guys may think
it's interesting, but others maybe not.

hmm...

> (I first need to look at the other threads on this topic...)
> 
> Thanks,
> Ludo’.

Re: [PATCH] Colorized REPL

[Nala Ginrut]

I sent a mail to the author of (term ansi-color), but seems the
emal-address was invalid.
Well, anyway, to the reason mentioned above, I think it's enough.

New implementation works now, I'll have some tests before release.
Suggestions are welcome ;-)
https://github.com/NalaGinrut/guile-colorized/tree/upstream

On Tue, Dec 11, 2012 at 10:31 AM, Nala Ginrut <nalaginrut@gmail.com> wrote:
> On Mon, 2012-12-10 at 22:42 +0100, Ludovic Courtès wrote:
>> Hi,
>>
>> Nala Ginrut <nalaginrut@gmail.com> skribis:
>>
>> > Since (term ansi-color) code is small one, except for the comment, do we
>> > still need to ask him for integration? IMO, we just borrowed something
>> > interfaces from his code.
>>
>> Well yes, the color table itself is public data, not even copyrightable
>> per se.
>>
>> > Another question:
>> > I'll try to patch the colorized into 'pretty-print' now, but is it
>> > expected? Or just leave it as a independent module? Which is the proper
>> > way for the maintainer?
>>
>> Instead of patching (ice-9 pretty-print) specifically for your purposes,
>> perhaps you could instead make it more generally extensible, in a way
>> that would be useful for your use case but not only?
>>
>
> I think (ice-9 colorized) is enough for colored-REPL purpose, of course,
> with Daniel's 'option-REPL-printer' patch. Besides, it'll provide other
> methods of coloring for the users.
>
> But the opinion to patch to 'pretty-print' also has a reason: if not,
> we'll keep another version of 'list/vector/array' printers. And the
> output indent may be different from 'pretty-print'. Some guys may think
> it's interesting, but others maybe not.
>
> hmm...
>
>> (I first need to look at the other threads on this topic...)
>>
>> Thanks,
>> Ludo’.
>
>

Re: [PATCH] Colorized REPL

[Nala Ginrut]

hi folks!
guile-colorized upstream updated!
Please review it here:
https://github.com/NalaGinrut/guile-colorized/tree/upstream

Changelog:
* move 'float?' to 'is-inexact?, and 'fraction?' to 'is-exact?' which
predicates number? first. (these two won't be exported)
* unexport all predicates for the type, since we alllow the users define
there color-scheme and type-checker all by themselves.

PS: @Danial repl-default-option-set! works! It's my misuse. :-p

On Sun, 2012-12-09 at 08:50 +0800, Daniel Hartwig wrote:
> On 9 December 2012 05:35, Ian Price <ianprice90@googlemail.com> wrote:
> > Or, you could use the package manager I keep pimping :)
> 
> Yes indeed, it works quite well.  As does just adding such files to a
> site- or user-local module path.
> 
> > (os process) might be reasonable, since we are forever complaining about
> > the popen module, but I don't see why we need (ansi term-color).
> 
> Yes, agree.  It is best to avoid adding some extra fluff (such as ansi
> color module, colored output, etc.) to the core when appropriate.
> Feature creep and all that is not a big win, makes guile generally
> /less/ embeddable, and such.
> 

Re: [PATCH] Colorized REPL

[Nala Ginrut]

[-- Attachment #1: Type: text/plain, Size: 968 bytes --]

I have the honor to release this patch for colorized-REPL.
For a brief description about (ice-9 colorized) module, I listed them
below:
1. colorized-REPL feature:
Add two lines to your ~/.guile, to enable colorized-REPL feature: 
(use-modules (ice-9 colorized))
(activate-colorized)

2. custom color scheme:
Example:
(add-color-scheme! `((,(lambda (data) 
                        (and (number? data) (> data 10000)))
                        MY-LONG-NUM ,color-it (RED))))
Add it to your ~/.guile or in your code at you wish.
This feature is useful, because sometimes we need to test our program
and output a colorful result for some monitoring purpose.
PS: MY-LONG-NUM is an arbitrary name for your own color scheme, as you
like.

3. colored string/display:
(string-in-color "hello" '(BLUE BOLD))
==>  "\x1b[34;1mhello\x1b[0m"
(display-in-color "hello" '(BLUE BOLD))
* is the same with (display (string-in-color ...)) *

Please review it ASAP, thanks!

Happy Hacking!

[-- Attachment #2: 0001-Add-new-feture-colorized-REPL-and-color-string-outpu.patch --]
[-- Type: text/x-patch, Size: 12616 bytes --]

From 92630700cda82c760f2b526c5c776a59f71b7372 Mon Sep 17 00:00:00 2001
From: Nala Ginrut <nalaginrut@gmail.com>
Date: Mon, 31 Dec 2012 16:11:23 +0800
Subject: [PATCH] Add new feture: colorized-REPL, and color string output. *
 new file:   module/ice-9/colorized.scm

---
 module/ice-9/colorized.scm |  375 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 375 insertions(+)
 create mode 100644 module/ice-9/colorized.scm

diff --git a/module/ice-9/colorized.scm b/module/ice-9/colorized.scm
new file mode 100644
index 0000000..c6d280c
--- /dev/null
+++ b/module/ice-9/colorized.scm
@@ -0,0 +1,375 @@
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (ice-9 colorized)
+  #:use-module (oop goops)
+  #:use-module ((rnrs) #:select (bytevector->u8-list define-record-type
+				vector-for-each bytevector?))
+  #:use-module (ice-9 rdelim)
+  #:use-module ((srfi srfi-1) #:select (remove proper-list?))
+  #:use-module (system repl common)
+  #:export (activate-colorized custom-colorized-set! color-it 
+	    string-in-color add-color-scheme! display-in-color))
+
+(define (colorized-repl-printer repl val)
+  (colorize-it val))
+      
+(define (activate-colorized)
+  (repl-default-option-set! 'print colorized-repl-printer))
+
+(define-record-type color-scheme
+  (fields str data type color control method))
+  
+(define *color-list*
+  `((CLEAR       .   "0")
+    (RESET       .   "0")
+    (BOLD        .   "1")
+    (DARK        .   "2")
+    (UNDERLINE   .   "4")
+    (UNDERSCORE  .   "4")
+    (BLINK       .   "5")
+    (REVERSE     .   "6")
+    (CONCEALED   .   "8")
+    (BLACK       .  "30")
+    (RED         .  "31")
+    (GREEN       .  "32")
+    (YELLOW      .  "33")
+    (BLUE        .  "34")
+    (MAGENTA     .  "35")
+    (CYAN        .  "36")
+    (WHITE       .  "37")
+    (ON-BLACK    .  "40")
+    (ON-RED      .  "41")
+    (ON-GREEN    .  "42")
+    (ON-YELLOW   .  "43")
+    (ON-BLUE     .  "44")
+    (ON-MAGENTA  .  "45")
+    (ON-CYAN     .  "46")
+    (ON-WHITE    .  "47")))
+
+(define get-color
+  (lambda (color)
+    (assoc-ref *color-list* color)))
+
+(define generate-color
+  (lambda (colors)
+    (let ((color-list 
+	   (remove not 
+		   (map (lambda (c) (assoc-ref *color-list* c)) colors))))
+      (if (null? color-list)
+	  ""
+	   (string-join color-list ";" 'infix)))))
+
+(define color-it
+  (lambda (cs)
+    (let* ((str (color-scheme-str cs))
+	   (color (color-scheme-color cs))
+	   (control (color-scheme-control cs)))
+      (color-it-inner color str control))))
+
+(define color-it-inner
+  (lambda (color str control)
+    (string-append "\x1b[" (generate-color color) "m" str "\x1b[" (generate-color control) "m")))
+
+(define* (space #:optional (port (current-output-port)))
+  (display #\sp port))
+
+(define (backspace port)
+  (seek port -1 SEEK_CUR))
+
+(define *pre-sign* 
+  `((LIST       .   "(") 
+    (PAIR       .   "(") 
+    (VECTOR     .   "#(")
+    (BYTEVECTOR .   "#vu8(")
+    (ARRAY      .   #f))) ;; array's sign is complecated.
+
+(define* (pre-print cs #:optional (port (current-output-port)))
+  (let* ((type (color-scheme-type cs))
+	 (control (color-scheme-control cs))
+	 (sign (assoc-ref *pre-sign* type))
+	 (color (color-scheme-color cs))) ;; (car color) is the color, (cdr color) is the control
+    (if sign
+	(display (color-it-inner color sign control) port)  ;; not array
+	(display (color-array-inner cs) port) ;; array complecated coloring
+	)))
+
+(define (print-dot port)
+  (let ((light-cyan '(CYAN BOLD)))
+    (display (color-it-inner light-cyan "." '(RESET)) port)))
+
+(define is-sign?
+  (lambda (ch)
+    (char-set-contains? char-set:punctuation ch)))
+
+(define color-array-inner
+  (lambda (cs)
+    (let* ((colors (color-scheme-color cs))
+	   (control (color-scheme-control cs))
+	   (sign-color (car colors))
+	   (attr-color (cadr colors))
+	   (str (color-scheme-str cs))
+	   (attrs (string->list 
+		   (call-with-input-string str (lambda (p) (read-delimited "(" p))))))
+      (call-with-output-string
+       (lambda (port)
+	 (for-each (lambda (ch)
+		     (let ((color (if (is-sign? ch) sign-color attr-color)))
+		       (display (color-it-inner color (string ch) control) port)))
+		   attrs)
+	 (display (color-it-inner sign-color "(" control) port) ;; output right-parent
+	 )))))
+
+;; I believe all end-sign is ")"      
+(define* (post-print cs #:optional (port (current-output-port)))
+  (let* ((c (color-scheme-color cs))
+	 (control (color-scheme-control cs))
+	 (color (if (list? (car c)) (car c) c))) ;; array has a color-list
+    (display (color-it-inner color ")" control) port)))
+
+(define (color-integer cs)
+  (color-it cs))
+
+(define (color-char cs)
+  (color-it cs))
+
+(define (color-string cs)
+  (color-it cs))
+
+(define (color-list cs)
+  (let* ((data (color-scheme-data cs)))
+    (if (proper-list? data)
+	(call-with-output-string
+	 (lambda (port)
+	   (pre-print cs port)
+	   (for-each (lambda (x) (colorize x port) (space port)) data)
+	   (backspace port)  ;; remove the redundant space
+	   (post-print cs port)))
+	(color-pair cs))))
+    
+(define (color-pair cs)
+  (let* ((data (color-scheme-data cs))
+	 (d1 (car data))
+	 (d2 (cdr data)))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (colorize d1 port)
+       (space port) (print-dot port) (space port)
+       (colorize d2 port)
+       (post-print cs port)))))
+
+(define (color-class cs)
+  (color-it cs))
+
+(define (color-procedure cs)
+  (color-it cs))
+
+(define (color-vector cs)
+  (let ((vv (color-scheme-data cs)))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (vector-for-each (lambda (x) (colorize x port) (space port)) vv)
+       (backspace port) ;; remove the redundant space
+       (post-print cs port)))))
+    
+(define (color-keyword cs)
+  (color-it cs))
+
+;; TODO: maybe print it as char one by one?
+(define (color-char-set cs)
+  (color-it cs))
+
+(define (color-symbol cs)
+  (color-it cs))
+
+(define (color-stack cs)
+  (color-it cs))
+
+(define (color-record-type cs)
+  (color-it cs))
+
+(define (color-inexact cs)
+  (color-it cs))
+
+(define (color-exact cs)
+  (let* ((data (color-scheme-data cs))
+	 (colors (color-scheme-color cs))
+	 (num-color (car colors))
+	 (div-color (cadr colors))
+	 (control (color-scheme-control cs))
+	 (n (object->string (numerator data)))
+	 (d (object->string (denominator data))))
+    (call-with-output-string
+     (lambda (port)
+       (format port "~a~a~a" 
+	       (color-it-inner num-color n control)
+	       (color-it-inner div-color "/" control)
+	       (color-it-inner num-color d control))))))
+
+(define (color-regexp cs)
+  (color-it cs))
+
+(define (color-bitvector cs)
+  ;; TODO: is it right?
+  (color-it cs))
+
+(define (color-bytevector cs)
+  (let ((ll (bytevector->u8-list (color-scheme-data cs))))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (for-each (lambda (x) (colorize x port) (space port)) ll)
+       (backspace port) ;; remove the redundant space
+       (post-print cs port)))))
+
+(define (color-boolean cs)
+  (color-it cs))
+
+(define (color-arbiter cs)
+  (color-it cs))
+
+(define (color-array cs)
+  (let ((ll (array->list (color-scheme-data cs))))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (for-each (lambda (x) (colorize x port) (space port)) ll) ;; easy life to use list rather than array.
+       (backspace port)  ;; remove the redundant space
+       (post-print cs port)))))
+
+(define (color-complex cs)
+  (color-it cs))
+
+(define (color-hashtable cs)
+  (color-it cs))
+
+(define (color-hook cs)
+  (color-it cs))
+
+(define (color-unknown cs)
+  (color-it cs))
+
+;;--- custom color scheme ---
+(define *custom-colorized-list* (make-fluid '()))
+
+(define (custom-colorized-set! ll)
+  (fluid-set! *custom-colorized-list* ll))
+
+(define (current-custom-colorized)
+  (fluid-ref *custom-colorized-list*))
+
+(define (add-color-scheme! cs-list)
+  (let ((ll (current-custom-colorized)))
+    (custom-colorized-set! `(,@cs-list ,@ll))))
+;;--- custom color scheme end---
+
+(define (is-inexact? obj)
+  (and (number? obj) (inexact? obj)))
+
+(define (is-exact? obj)
+  (and (number? obj) (exact? obj)))
+
+(define (class? obj)
+  (is-a? obj <class>))
+
+(define (arbiter? obj)
+  (is-a? obj <arbiter>))
+
+(define (unknown? obj)
+  (is-a? obj <unknown>))
+
+(define *colorize-list*
+  `((,integer? INTEGER ,color-integer (BLUE BOLD))
+    (,char? CHAR ,color-char (YELLOW))
+    (,string? STRING ,color-string (RED))
+    (,list? LIST ,color-list (BLUE BOLD))
+    (,pair? PAIR ,color-list (BLACK BOLD)) ;; NOTE: proper-list is a <pair>, and cons is <pair> too, so call color-list either.
+    (,class? CLASS ,color-class (CYAN BOLD))
+    (,procedure? PROCEDURE ,color-procedure (YELLOW BOLD))
+    (,vector? VECTOR ,color-vector (MAGENTA BOLD))
+    (,keyword? KEYWORD ,color-keyword (MAGENTA))
+    (,char-set? CHAR-SET ,color-char-set (WHITE))
+    (,symbol? SYMBOL ,color-symbol (GREEN BOLD))
+    (,stack? STACK ,color-stack (MAGENTA))
+    (,record-type? RECORD-TYPE ,color-record-type (BLACK BOLD))
+    ;; We don't check REAL here, since it'll cover FLOAT and FRACTION, but user may customs it as they wish.
+    (,is-inexact? FLOAT ,color-inexact (YELLOW))
+    (,is-exact? FRACTION ,color-exact ((BLUE BOLD) (YELLOW)))
+    (,regexp? REGEXP ,color-regexp (GREEN))
+    (,bitvector? BITVECTOR ,color-bitvector (YELLOW BOLD))
+    (,bytevector? BYTEVECTOR ,color-bytevector (CYAN))
+    (,boolean? BOOLEAN ,color-boolean (BLUE))
+    (,arbiter? ARBITER ,color-arbiter (BLUE))
+    (,array? ARRAY ,color-array ((CYAN BOLD) (YELLOW BOLD)))
+    (,complex? COMPLEX ,color-complex (MAGENTA))
+    (,hash-table? HASH-TABLE ,color-hashtable (BLUE))
+    (,hook? HOOK ,color-hook (GREEN))
+    (,unknown? UNKNOWN ,color-unknown (WHITE))
+    ;; TODO: if there's anything to add
+    ))
+
+(define type-checker
+  (lambda (data)
+    (call/cc (lambda (return)
+	       (for-each (lambda (x)  ;; checkout user defined data type
+			   (and ((car x) data) (return (cdr x))))
+			 (current-custom-colorized))
+	       (for-each (lambda (x)  ;; checkout default data type
+			   (and ((car x) data) (return (cdr x))))
+			 *colorize-list*)
+	       (return `(UNKNOWN ,color-unknown (WHITE))))))) ;; no suitable data type ,return the unknown solution
+	      
+;; NOTE: we don't use control now, but I write the mechanism for future usage.
+(define generate-color-scheme
+  (lambda (data)
+    (let* ((str (object->string data))
+	   (r (type-checker data))
+	   (type (car r))
+	   (method (cadr r))
+	   (color (caddr r)))
+      (make-color-scheme str data type color '(RESET) method)))) 
+
+(define generate-custom-string-color-scheme
+  (lambda (str color)
+    (make-color-scheme str #f #f color '(RESET) color-string)))
+
+(define string-in-color
+  (lambda (str color)
+"@code{string-in-color}.  The argument @var{color} is the color list.
+   Example: (string-in-color \"hello\" '(BLUE BOLD))" 
+    (and (not (list? color)) (error string-in-color "color should be a list!" color))
+    (let ((cs (generate-custom-string-color-scheme str color)))
+      (color-it cs))))
+
+(define display-in-color
+  (lambda (str color)
+"Call @code{display} with the result of  @code{string-in-color}.
+   Example: (display-in-color \"hello\" '(BLUE BOLD))"
+    (display (string-in-color str color))))
+
+(define* (colorize-it data #:optional (port (current-output-port)))
+  (colorize data port)
+  (newline port))
+
+(define* (colorize data #:optional (port (current-output-port)))
+  (let* ((cs (generate-color-scheme data))
+	 (f (color-scheme-method cs)))
+    (display (f cs) port)))
+
+
+
-- 
1.7.10.4

Re: [PATCH] Colorized REPL

[Ludovic Courtès]

Hi Nala,

Thanks for your work!

Nala Ginrut <nalaginrut@gmail.com> skribis:

> 1. colorized-REPL feature:
> Add two lines to your ~/.guile, to enable colorized-REPL feature: 
> (use-modules (ice-9 colorized))
> (activate-colorized)

I did that, and actually had to jump into a recursive REPL to see it in
effect.  Would be nice to fix it.

Once in effect, the result is pleasant.  :-)

> 2. custom color scheme:
> Example:
> (add-color-scheme! `((,(lambda (data) 
>                         (and (number? data) (> data 10000)))
>                         MY-LONG-NUM ,color-it (RED))))

Nice.

> Add it to your ~/.guile or in your code at you wish.
> This feature is useful, because sometimes we need to test our program
> and output a colorful result for some monitoring purpose.
> PS: MY-LONG-NUM is an arbitrary name for your own color scheme, as you
> like.

Why is that name even needed?

Below is a rough review.  There are many stylistic issues IMO, such as
the lack of proper docstrings and comments, use of conventions that are
uncommon in Guile (like (define foo (lambda (arg) ...)),
*variable-with-stars*, hanging parentheses, etc.), sometimes weird
indentation, and use of tabs.

Overall it’s essentially a new implementation of write/display, so I’m a
bit concerned about keeping it in sync with the other one.  Could you
add test cases that compare the output of both, for instance using a
helper procedure that dismisses ANSI escapes?

Some other comments:

> +(define-module (ice-9 colorized)
> +  #:use-module (oop goops)
> +  #:use-module ((rnrs) #:select (bytevector->u8-list define-record-type
> +				vector-for-each bytevector?))

Would be good to pull neither of these.

Could you use (srfi srfi-9) and (rnrs bytevectors) instead of the
latter?  For GOOPS, see below.

> +(define-record-type color-scheme
> +  (fields str data type color control method))

Could you comment this?  I’m not clear on what each field is.

> +(define *color-list*
> +  `((CLEAR       .   "0")
> +    (RESET       .   "0")
> +    (BOLD        .   "1")
> +    (DARK        .   "2")
> +    (UNDERLINE   .   "4")
> +    (UNDERSCORE  .   "4")
> +    (BLINK       .   "5")
> +    (REVERSE     .   "6")
> +    (CONCEALED   .   "8")
> +    (BLACK       .  "30")
> +    (RED         .  "31")
> +    (GREEN       .  "32")
> +    (YELLOW      .  "33")
> +    (BLUE        .  "34")
> +    (MAGENTA     .  "35")
> +    (CYAN        .  "36")
> +    (WHITE       .  "37")
> +    (ON-BLACK    .  "40")
> +    (ON-RED      .  "41")
> +    (ON-GREEN    .  "42")
> +    (ON-YELLOW   .  "43")
> +    (ON-BLUE     .  "44")
> +    (ON-MAGENTA  .  "45")
> +    (ON-CYAN     .  "46")
> +    (ON-WHITE    .  "47")))

Would it make sense to define a new type for colors?  Like:

  (define-record-type <color>
    (color foreground background attribute)
    color?
    ...)

  (define light-cyan
    (color x y z))

> +(define generate-color
> +  (lambda (colors)
> +    (let ((color-list 
> +	   (remove not 
> +		   (map (lambda (c) (assoc-ref *color-list* c)) colors))))

Use filter-map instead.

> +(define color-it
> +  (lambda (cs)
> +    (let* ((str (color-scheme-str cs))
> +	   (color (color-scheme-color cs))
> +	   (control (color-scheme-control cs)))
> +      (color-it-inner color str control))))

This is somewhat confusing: I’d expect (color-it str cs), but instead
the string to be printed is embedded in the “color scheme”.

> +(define (backspace port)
> +  (seek port -1 SEEK_CUR))

What about non-seekable ports?  Could it be avoided altogether?

> +(define *pre-sign* 
> +  `((LIST       .   "(") 
> +    (PAIR       .   "(") 
> +    (VECTOR     .   "#(")
> +    (BYTEVECTOR .   "#vu8(")
> +    (ARRAY      .   #f))) ;; array's sign is complecated.

It’s complicated, so what?  :-)

The comment should instead mention that arrays get special treatment in
‘pre-print’.

> +(define* (pre-print cs #:optional (port (current-output-port)))
> +  (let* ((type (color-scheme-type cs))
> +	 (control (color-scheme-control cs))
> +	 (sign (assoc-ref *pre-sign* type))
> +	 (color (color-scheme-color cs))) ;; (car color) is the color, (cdr color) is the control

Is that comment necessary here?

> +    (if sign
> +	(display (color-it-inner color sign control) port)  ;; not array
> +	(display (color-array-inner cs) port) ;; array complecated coloring
> +	)))

Parentheses should be at the end of the previous line.
End-of-line comments should be introduced with a single semicolon.

> +(define is-sign?
> +  (lambda (ch)
> +    (char-set-contains? char-set:punctuation ch)))

Perhaps ‘delimiter?’ would be a better name?

> +(define color-array-inner
> +  (lambda (cs)
> +    (let* ((colors (color-scheme-color cs))
> +	   (control (color-scheme-control cs))
> +	   (sign-color (car colors))
> +	   (attr-color (cadr colors))
> +	   (str (color-scheme-str cs))
> +	   (attrs (string->list 
> +		   (call-with-input-string str (lambda (p) (read-delimited "(" p))))))
> +      (call-with-output-string
> +       (lambda (port)
> +	 (for-each (lambda (ch)
> +		     (let ((color (if (is-sign? ch) sign-color attr-color)))
> +		       (display (color-it-inner color (string ch) control) port)))
> +		   attrs)
> +	 (display (color-it-inner sign-color "(" control) port) ;; output right-parent
> +	 )))))

Wow, this is hairy and heavyweight.

> +;; I believe all end-sign is ")"      
> +(define* (post-print cs #:optional (port (current-output-port)))
> +  (let* ((c (color-scheme-color cs))
> +	 (control (color-scheme-control cs))
> +	 (color (if (list? (car c)) (car c) c))) ;; array has a color-list
> +    (display (color-it-inner color ")" control) port)))

Instead of the comment above, add a docstring that says “Write a closing
parenthesis...”.

> +(define *custom-colorized-list* (make-fluid '()))

It’s better to use SRFI-39 parameters (which are in core now).

> +(define (class? obj)
> +  (is-a? obj <class>))

It’s enough to use ‘struct?’ since objects are structs.  This way you
get rid of the dependency on GOOPS.

> +(define (arbiter? obj)
> +  (is-a? obj <arbiter>))

Who care about arbiters?  :-)

> +(define (unknown? obj)
> +  (is-a? obj <unknown>))

This one isn’t needed: it’s just the ‘else’ case.

> +(define *colorize-list*
> +  `((,integer? INTEGER ,color-integer (BLUE BOLD))
> +    (,char? CHAR ,color-char (YELLOW))

Instead of a list, can you instead define a record for each token color
setting?

  (define-record-type <token-color>
    (token-color name pred color-proc color)
    token-color?
    ...)

  (define %token-colors
    `(,(token-color 'integer integer? color-integer '(blue bold))
      ...))

> +(define type-checker
> +  (lambda (data)
> +    (call/cc (lambda (return)
> +	       (for-each (lambda (x)  ;; checkout user defined data type
> +			   (and ((car x) data) (return (cdr x))))
> +			 (current-custom-colorized))
> +	       (for-each (lambda (x)  ;; checkout default data type
> +			   (and ((car x) data) (return (cdr x))))
> +			 *colorize-list*)
> +	       (return `(UNKNOWN ,color-unknown (WHITE))))))) ;; no suitable data type ,return the unknown solution

Using call/cc here is fun but excessively bad-style.  :-)

Try something like:

  (or (any ... (current-custom-colorized))
      (any ... %token-colors)
      (token-color 'unknown (const #t) color-unknown '(white)))

Also, the name is misleading.  Should be called ‘data->token-color’ or
something like that.

> +(define string-in-color
> +  (lambda (str color)
> +"@code{string-in-color}.  The argument @var{color} is the color list.
> +   Example: (string-in-color \"hello\" '(BLUE BOLD))" 

No Texinfo escapes in docstrings.

Thanks,
Ludo’.

Re: [PATCH] Colorized REPL

[Mike Gran]

Hi Nala, Ludo-

> Could you comment this?  I’m not clear on what each field is.
> 
>> +(define *color-list*
>> +  `((CLEAR      .  "0")
>> +    (RESET      .  "0")
>> +    (BOLD        .  "1")
>> +    (DARK        .  "2")
>> +    (UNDERLINE  .  "4")
>> +    (UNDERSCORE  .  "4")
>> +    (BLINK      .  "5")
>> +    (REVERSE    .  "6")
>> +    (CONCEALED  .  "8")
>> +    (BLACK      .  "30")
>> +    (RED        .  "31")
>> +    (GREEN      .  "32")
>> +    (YELLOW      .  "33")
>> +    (BLUE        .  "34")
>> +    (MAGENTA    .  "35")
>> +    (CYAN        .  "36")
>> +    (WHITE      .  "37")
>> +    (ON-BLACK    .  "40")
>> +    (ON-RED      .  "41")
>> +    (ON-GREEN    .  "42")
>> +    (ON-YELLOW  .  "43")
>> +    (ON-BLUE    .  "44")
>> +    (ON-MAGENTA  .  "45")
>> +    (ON-CYAN    .  "46")
>> +    (ON-WHITE    .  "47")))

For what it is worth, below is the ECMA-48 standard's
concept of what these values do.  ECMA-48 lists "7"
as reverse, instead of "6".  


0 default
1 bold
2 faint
4 singly underlined
5 slowly blinking
6 rapidly blinking
7 negative image
8 concealed characters
30 black display
31 red display
32 green display
33 yellow display
34 blue display
35 magenta display
36 cyan display
37 white display
40 black background
41 red background
42 green background
43 yellow background
44 blue background
45 magenta background
46 cyan background
47 white background

Of course, each terminal
is different in practice. The only way to be sure you
are getting it right is to go through terminfo.
OTOH, these days when everything behaves almost like
color xterm, maybe parsing terminfo is just being
pedantic.

Thanks,

Mike Gran

Re: [PATCH] Colorized REPL

[Nala Ginrut]

On Fri, 2013-01-04 at 15:06 +0100, Ludovic Courtès wrote:
> Hi Nala,
> 
> Thanks for your work!
> 
> Nala Ginrut <nalaginrut@gmail.com> skribis:
> 
> > 1. colorized-REPL feature:
> > Add two lines to your ~/.guile, to enable colorized-REPL feature: 
> > (use-modules (ice-9 colorized))
> > (activate-colorized)
> 
> I did that, and actually had to jump into a recursive REPL to see it in
> effect.  Would be nice to fix it.
> 

Well, I'm not sure what's the mean of 'recursive REPL'? 

> Once in effect, the result is pleasant.  :-)
> 

I'm glad you like it. ;-D

> > 2. custom color scheme:
> > Example:
> > (add-color-scheme! `((,(lambda (data) 
> >                         (and (number? data) (> data 10000)))
> >                         MY-LONG-NUM ,color-it (RED))))
> 
> Nice.
> 
> > Add it to your ~/.guile or in your code at you wish.
> > This feature is useful, because sometimes we need to test our program
> > and output a colorful result for some monitoring purpose.
> > PS: MY-LONG-NUM is an arbitrary name for your own color scheme, as you
> > like.
> 
> Why is that name even needed?

It's easy to debug or checkout the color-scheme info with the name.

> 
> Below is a rough review.  There are many stylistic issues IMO, such as
> the lack of proper docstrings and comments, use of conventions that are
> uncommon in Guile (like (define foo (lambda (arg) ...)),
> *variable-with-stars*, hanging parentheses, etc.), sometimes weird
> indentation, and use of tabs.
> 
> Overall it’s essentially a new implementation of write/display, so I’m a
> bit concerned about keeping it in sync with the other one.  Could you
> add test cases that compare the output of both, for instance using a
> helper procedure that dismisses ANSI escapes?
> 

OK, I added a #:test in 'colorize' and a color-it-test for it.
But I know little about the test case of Guile, anyone point me out?

> Some other comments:
> 
> > +(define-module (ice-9 colorized)
> > +  #:use-module (oop goops)
> > +  #:use-module ((rnrs) #:select (bytevector->u8-list define-record-type
> > +				vector-for-each bytevector?))
> 
> Would be good to pull neither of these.
> 
> Could you use (srfi srfi-9) and (rnrs bytevectors) instead of the
> latter?  For GOOPS, see below.
> 

record-type in r6rs is more convenient I think.

> > +(define-record-type color-scheme
> > +  (fields str data type color control method))
> 
> Could you comment this?  I’m not clear on what each field is.
> 
> > +(define *color-list*
> > +  `((CLEAR       .   "0")
> > +    (RESET       .   "0")
> > +    (BOLD        .   "1")
> > +    (DARK        .   "2")
> > +    (UNDERLINE   .   "4")
> > +    (UNDERSCORE  .   "4")
> > +    (BLINK       .   "5")
> > +    (REVERSE     .   "6")
> > +    (CONCEALED   .   "8")
> > +    (BLACK       .  "30")
> > +    (RED         .  "31")
> > +    (GREEN       .  "32")
> > +    (YELLOW      .  "33")
> > +    (BLUE        .  "34")
> > +    (MAGENTA     .  "35")
> > +    (CYAN        .  "36")
> > +    (WHITE       .  "37")
> > +    (ON-BLACK    .  "40")
> > +    (ON-RED      .  "41")
> > +    (ON-GREEN    .  "42")
> > +    (ON-YELLOW   .  "43")
> > +    (ON-BLUE     .  "44")
> > +    (ON-MAGENTA  .  "45")
> > +    (ON-CYAN     .  "46")
> > +    (ON-WHITE    .  "47")))
> 
> Would it make sense to define a new type for colors?  Like:
> 
>   (define-record-type <color>
>     (color foreground background attribute)
>     color?
>     ...)
> 
>   (define light-cyan
>     (color x y z))
> 

Actually, I did similar things (though without record-type), but I was
suggested use the *color-list* implementation from (ansi term) from
guile-lib. hmm... ;-)
Anyway, I think that implementation is not so clear, and it mixed
'colors' and 'controls' together...

> > +(define generate-color
> > +  (lambda (colors)
> > +    (let ((color-list 
> > +	   (remove not 
> > +		   (map (lambda (c) (assoc-ref *color-list* c)) colors))))
> 
> Use filter-map instead.
> 

nice to know that~

> > +(define color-it
> > +  (lambda (cs)
> > +    (let* ((str (color-scheme-str cs))
> > +	   (color (color-scheme-color cs))
> > +	   (control (color-scheme-control cs)))
> > +      (color-it-inner color str control))))
> 
> This is somewhat confusing: I’d expect (color-it str cs), but instead
> the string to be printed is embedded in the “color scheme”.
> 

It's a convenient way to enclose string into 'color-scheme', since the
string could be used later. 

> > +(define (backspace port)
> > +  (seek port -1 SEEK_CUR))
> 
> What about non-seekable ports?  Could it be avoided altogether?
> 

But I think the 'port' parameter in 'call-with-output-string' is always
seekable, isn't it? The 'port' here is not a generic port.

> > +(define *pre-sign* 
> > +  `((LIST       .   "(") 
> > +    (PAIR       .   "(") 
> > +    (VECTOR     .   "#(")
> > +    (BYTEVECTOR .   "#vu8(")
> > +    (ARRAY      .   #f))) ;; array's sign is complecated.
> 
> It’s complicated, so what?  :-)
> 
> The comment should instead mention that arrays get special treatment in
> ‘pre-print’.
> 
> > +(define* (pre-print cs #:optional (port (current-output-port)))
> > +  (let* ((type (color-scheme-type cs))
> > +	 (control (color-scheme-control cs))
> > +	 (sign (assoc-ref *pre-sign* type))
> > +	 (color (color-scheme-color cs))) ;; (car color) is the color, (cdr color) is the control
> 
> Is that comment necessary here?

Ah~thanks for pointing out, it's the obsolete design.

> > +    (if sign
> > +	(display (color-it-inner color sign control) port)  ;; not array
> > +	(display (color-array-inner cs) port) ;; array complecated coloring
> > +	)))
> 
> Parentheses should be at the end of the previous line.
> End-of-line comments should be introduced with a single semicolon.
> 

Fixed them all, comments convention & suspended right-paren. ;-)


> > +(define is-sign?
> > +  (lambda (ch)
> > +    (char-set-contains? char-set:punctuation ch)))
> 
> Perhaps ‘delimiter?’ would be a better name?
> 

Agreed~

> > +(define color-array-inner
> > +  (lambda (cs)
> > +    (let* ((colors (color-scheme-color cs))
> > +	   (control (color-scheme-control cs))
> > +	   (sign-color (car colors))
> > +	   (attr-color (cadr colors))
> > +	   (str (color-scheme-str cs))
> > +	   (attrs (string->list 
> > +		   (call-with-input-string str (lambda (p) (read-delimited "(" p))))))
> > +      (call-with-output-string
> > +       (lambda (port)
> > +	 (for-each (lambda (ch)
> > +		     (let ((color (if (is-sign? ch) sign-color attr-color)))
> > +		       (display (color-it-inner color (string ch) control) port)))
> > +		   attrs)
> > +	 (display (color-it-inner sign-color "(" control) port) ;; output right-parent
> > +	 )))))
> 
> Wow, this is hairy and heavyweight.
> 

Yes, but the aim of colorized-REPL is to show more friendly UI to the
users, it dropped up some efficiency designs.
I do considered a more efficient way to print simpler colorized-array,
but I decide to print it like this finally. I believe a more clear
array-print-result make users hate arrays less, since it's too
complicated in Guile, though we don't have to use it in complicated way
all the time.


> > +;; I believe all end-sign is ")"      
> > +(define* (post-print cs #:optional (port (current-output-port)))
> > +  (let* ((c (color-scheme-color cs))
> > +	 (control (color-scheme-control cs))
> > +	 (color (if (list? (car c)) (car c) c))) ;; array has a color-list
> > +    (display (color-it-inner color ")" control) port)))
> 
> Instead of the comment above, add a docstring that says “Write a closing
> parenthesis...”.
> 

> > +(define *custom-colorized-list* (make-fluid '()))
> 
> It’s better to use SRFI-39 parameters (which are in core now).
> 

Well, fluid is easier. ;-P

> > +(define (class? obj)
> > +  (is-a? obj <class>))
> 
> It’s enough to use ‘struct?’ since objects are structs.  This way you
> get rid of the dependency on GOOPS.
> 
> > +(define (arbiter? obj)
> > +  (is-a? obj <arbiter>))
> 
> Who care about arbiters?  :-)
> 
> > +(define (unknown? obj)
> > +  (is-a? obj <unknown>))
> 
> This one isn’t needed: it’s just the ‘else’ case.
> 

Agreed~

> > +(define *colorize-list*
> > +  `((,integer? INTEGER ,color-integer (BLUE BOLD))
> > +    (,char? CHAR ,color-char (YELLOW))
> 
> Instead of a list, can you instead define a record for each token color
> setting?
> 
>   (define-record-type <token-color>
>     (token-color name pred color-proc color)
>     token-color?
>     ...)
> 
>   (define %token-colors
>     `(,(token-color 'integer integer? color-integer '(blue bold))
>       ...))
> 

Hmm...if it's unnecessary, I prefer be lazy...

> > +(define type-checker
> > +  (lambda (data)
> > +    (call/cc (lambda (return)
> > +	       (for-each (lambda (x)  ;; checkout user defined data type
> > +			   (and ((car x) data) (return (cdr x))))
> > +			 (current-custom-colorized))
> > +	       (for-each (lambda (x)  ;; checkout default data type
> > +			   (and ((car x) data) (return (cdr x))))
> > +			 *colorize-list*)
> > +	       (return `(UNKNOWN ,color-unknown (WHITE))))))) ;; no suitable data type ,return the unknown solution
> 
> Using call/cc here is fun but excessively bad-style.  :-)
> 
> Try something like:
> 
>   (or (any ... (current-custom-colorized))
>       (any ... %token-colors)
>       (token-color 'unknown (const #t) color-unknown '(white)))
> 

But in this context, I need a finder which could return the result, not
just predicate true/false, 'any' seems can't provide that.
Any other suggestion?

> Also, the name is misleading.  Should be called ‘data->token-color’ or
> something like that.
> 

Agreed~

> > +(define string-in-color
> > +  (lambda (str color)
> > +"@code{string-in-color}.  The argument @var{color} is the color list.
> > +   Example: (string-in-color \"hello\" '(BLUE BOLD))" 
> 
> No Texinfo escapes in docstrings.
> 

Agreed~

> Thanks,
> Ludo’.

It's here now:
https://github.com/NalaGinrut/guile-colorized/blob/upstream/ice-9/colorized.scm

And I'm waiting for any help to write the test-case.

Thanks!

Re: [PATCH] Colorized REPL

[Daniel Hartwig]

Hello again

Some comments in addition to Ludo's below.  I have not inspected the
code of your latest submission thoroughly, but enough to agree that
there are many stylistic and algorithmic issues.  I will probably not
be looking in to it any more, and remain a satisfied user of
emacs+geiser.

I still think that this data colourizing or whatever is the domain of
third-party packages, rather than something to include in Guile
proper.


> string-in-color

colorize-string is a much nicer name.

> enable-color-test disable-color-test

These should not be exported.

> colorize

This is the most useful procedure in the module, it should really be exported.


The default colour scheme is far too aggressive and not to my taste at
all.  The focus should be on highlighting the structure (i.e. syntax),
but that is hard to spot when practically every data type has it's own
tweaked colours.  Highlighting is subtle, only a very few conditions
should change the colour: strings and parens are great, but please
leave numbers in whatever the current colour is.

That said, a colour scheme for testing should probably be quite
aggressive, to the point of giving every condition it's own unique set
of attributes.

Also, the “/” in “1/2” appears as a different colour, why?!


On 9 January 2013 18:17, Nala Ginrut <nalaginrut@gmail.com> wrote:
> On Fri, 2013-01-04 at 15:06 +0100, Ludovic Courtès wrote:
>> Nala Ginrut <nalaginrut@gmail.com> skribis:
>> > (activate-colorized)
>>
>> I did that, and actually had to jump into a recursive REPL to see it in
>> effect.  Would be nice to fix it.
>>
>
> Well, I'm not sure what's the mean of 'recursive REPL'?

Starting one REPL inside another.  The updated activate-colorized only
sets default REPL options and does not take care to update the current
instance if one is already active.  So, if an REPL is already running,
one has to do (activate-colorized) followed by starting a new REPL.

>> Below is a rough review.  There are many stylistic issues IMO, such as
>> the lack of proper docstrings and comments, use of conventions that are
>> uncommon in Guile (like (define foo (lambda (arg) ...)),
>> *variable-with-stars*, hanging parentheses, etc.), sometimes weird
>> indentation, and use of tabs.

Procedure arguments “data” which should rather be “obj”.

>>
>> Overall it’s essentially a new implementation of write/display, so I’m a
>> bit concerned about keeping it in sync with the other one.

Yes this is quite concerning.  Having less implementations is
certainly preferable to having more.

The current output is broken for some data types:

scheme@(ice-9 colorized)> (colorize-it #f32(0 1 2))
#vu8(0 0 0 0 0 0 128 63 0 0 0 64)
scheme@(ice-9 colorized)> (colorize-it #u8(0 1 2))
#vu8(0 1 2)
scheme@(ice-9 colorized)> (write #u8(0 1 2)) (newline)
#u8(0 1 2)

The chance of subtle problems with other data types is high, both now
and in the future after any current problems are corrected.

>> Could you
>> add test cases that compare the output of both, for instance using a
>> helper procedure that dismisses ANSI escapes?

You have provided:

> (define color-it-test
>   (lambda (color str control)
>     str))

rather, you want to write a procedure that takes a string with ANSI
code sequences embedded and removes the ANSI codes so that only plain
text remains.  That plain text can then be compared with the output
from write/display.

 (define (remove-ansi-codes str) …)

then use that in the test-cases such as:

 (define (compare-write-and-colorize obj)
   (string= (with-output-to-string
             (lambda () (write obj)))
            (remove-ansi-codes
             (with-output-to-string
              (lambda () (colorize obj))))))

but structure your test cases as per the existing test-suite.

> OK, I added a #:test in 'colorize' and a color-it-test for it.
> But I know little about the test case of Guile, anyone point me out?

See the existing tests filed under test-suite/tests.

>> Would it make sense to define a new type for colors?  Like:
>>
>>   (define-record-type <color>
>>     (color foreground background attribute)
>>     color?
>>     ...)
>>
>>   (define light-cyan
>>     (color x y z))
>>
>
> Actually, I did similar things (though without record-type), but I was
> suggested use the *color-list* implementation from (ansi term) from
> guile-lib. hmm... ;-)
> Anyway, I think that implementation is not so clear, and it mixed
> 'colors' and 'controls' together...

Right, lists are more natural for specifying these sets of attributes,
which could be any combination of foreground, background, and/or
something other.  (ansi term) module sets a very respectable example.

>> > +(define color-it
>> > +  (lambda (cs)
>> > +    (let* ((str (color-scheme-str cs))
>> > +      (color (color-scheme-color cs))
>> > +      (control (color-scheme-control cs)))
>> > +      (color-it-inner color str control))))
>>
>> This is somewhat confusing: I’d expect (color-it str cs), but instead
>> the string to be printed is embedded in the “color scheme”.
>>
>
> It's a convenient way to enclose string into 'color-scheme', since the
> string could be used later.

I agree with Ludo, the string and color scheme are not so related.
This design choice adds confusion to the rest of the module.

>
>> > +(define (backspace port)
>> > +  (seek port -1 SEEK_CUR))
>>
>> What about non-seekable ports?  Could it be avoided altogether?
>>
>
> But I think the 'port' parameter in 'call-with-output-string' is always
> seekable, isn't it? The 'port' here is not a generic port.

Regardless, it is poor style to produce something only to subsequently
scrub it out.  Code does this:

+          (for-each (lambda (x) (colorize x port) (space port)) data)
+          (backspace port)  ;; remove the redundant space

when, if “colorize” produced strings, it could do something like this:

 (display (string-join (map colorize data) " ") port)

or, perhaps more efficiently, this:

 (format port "~{~a~^ ~}" (map colorize data))

>> > +(define color-array-inner

>> Wow, this is hairy and heavyweight.

> Yes, but the aim of colorized-REPL is to show more friendly UI to the
> users, it dropped up some efficiency designs.

Disagree.  It is more difficult to read the array tag with all the
colour changes.  Breaking apart elements to this level is extreme,
prone to errors, and poorly maintainable.  All that for a very
questionable gain in “friendly UI”.  Keep things simple, at least
until you have a smooth module without issues.

Also, this colours the vectag (such as “s16” or “u8”) for arrays, but
does not do the same for bytevectors.  This comes across as very
inconsistent, especially with two such values next to each other.
Just leave the array tags in a single colour.

>> > +(define *colorize-list*
>> > +  `((,integer? INTEGER ,color-integer (BLUE BOLD))
>> > +    (,char? CHAR ,color-char (YELLOW))
>>
>> Instead of a list, can you instead define a record for each token color
>> setting?
>>
>>   (define-record-type <token-color>
>>     (token-color name pred color-proc color)
>>     token-color?
>>     ...)
>>
>>   (define %token-colors
>>     `(,(token-color 'integer integer? color-integer '(blue bold))
>>       ...))
>>
>
> Hmm...if it's unnecessary, I prefer be lazy...
>
>> > +(define type-checker

>>
>> Using call/cc here is fun but excessively bad-style.  :-)
>>
>> Try something like:
>>
>>   (or (any ... (current-custom-colorized))
>>       (any ... %token-colors)
>>       (token-color 'unknown (const #t) color-unknown '(white)))
>>
>
> But in this context, I need a finder which could return the result, not
> just predicate true/false, 'any' seems can't provide that.

You might want to reread the definition of “any”.

Best wishes.

Re: [PATCH] Colorized REPL

[Nala Ginrut]

On Thu, 2013-01-10 at 16:19 +0800, Daniel Hartwig wrote:
> Hello again
> 
> Some comments in addition to Ludo's below.  I have not inspected the
> code of your latest submission thoroughly, but enough to agree that
> there are many stylistic and algorithmic issues.  I will probably not
> be looking in to it any more, and remain a satisfied user of
> emacs+geiser.
> 
> I still think that this data colourizing or whatever is the domain of
> third-party packages, rather than something to include in Guile
> proper.
> 

Well, as I mentioned before, not all people use Emacs, and many of them,
especially newbies, they may never tried Emacs/vi.

> 
> > string-in-color
> 
> colorize-string is a much nicer name.
> 

Agreed~
I changed these:
string-in-color => colorize-string
display-string-in-color => colorized-display

What do you think?

> > enable-color-test disable-color-test
> 
> These should not be exported.
> 
> > colorize
> 
> This is the most useful procedure in the module, it should really be exported.
> 

Alright, fixed.

> 
> The default colour scheme is far too aggressive and not to my taste at
> all.  The focus should be on highlighting the structure (i.e. syntax),
> but that is hard to spot when practically every data type has it's own
> tweaked colours.  Highlighting is subtle, only a very few conditions
> should change the colour: strings and parens are great, but please
> leave numbers in whatever the current colour is.
> 
> That said, a colour scheme for testing should probably be quite
> aggressive, to the point of giving every condition it's own unique set
> of attributes.
> 
> Also, the “/” in “1/2” appears as a different colour, why?!
> 

It's more conspicuous for the users. I asked some guys, they like it.

> 
> On 9 January 2013 18:17, Nala Ginrut <nalaginrut@gmail.com> wrote:
> > On Fri, 2013-01-04 at 15:06 +0100, Ludovic Courtès wrote:
> >> Nala Ginrut <nalaginrut@gmail.com> skribis:
> >> > (activate-colorized)
> >>
> >> I did that, and actually had to jump into a recursive REPL to see it in
> >> effect.  Would be nice to fix it.
> >>
> >
> > Well, I'm not sure what's the mean of 'recursive REPL'?
> 
> Starting one REPL inside another.  The updated activate-colorized only
> sets default REPL options and does not take care to update the current
> instance if one is already active.  So, if an REPL is already running,
> one has to do (activate-colorized) followed by starting a new REPL.
> 

But how to check if a REPL is already running?

> >> Below is a rough review.  There are many stylistic issues IMO, such as
> >> the lack of proper docstrings and comments, use of conventions that are
> >> uncommon in Guile (like (define foo (lambda (arg) ...)),
> >> *variable-with-stars*, hanging parentheses, etc.), sometimes weird
> >> indentation, and use of tabs.
> 
> Procedure arguments “data” which should rather be “obj”.
> 

Colorize an 'obj' is strange, I think 'data' is better.

> >>
> >> Overall it’s essentially a new implementation of write/display, so I’m a
> >> bit concerned about keeping it in sync with the other one.
> 
> Yes this is quite concerning.  Having less implementations is
> certainly preferable to having more.
> 
> The current output is broken for some data types:
> 
> scheme@(ice-9 colorized)> (colorize-it #f32(0 1 2))
> #vu8(0 0 0 0 0 0 128 63 0 0 0 64)
> scheme@(ice-9 colorized)> (colorize-it #u8(0 1 2))
> #vu8(0 1 2)
> scheme@(ice-9 colorized)> (write #u8(0 1 2)) (newline)
> #u8(0 1 2)
> 

It's an important correction, I realized that I don't have to handle
bytevector, it's an special array too, and I don't have to import (rnrs
bytevectors), thanks for pointing out it!
I believe the bugs above all fixed now. 
But what's the expected result of "(write #u8(0 1 2)) (newline)"? 

> The chance of subtle problems with other data types is high, both now
> and in the future after any current problems are corrected.
> 

Any code contains potential bugs.
I don't think people should use (ice-9 colorize) in their serious
program, it's just a tool for newbies to learn Guile more friendly. Even
'colorize-string', it's the co-product of that, and it just output a
string in color, simple enough to avoid dangerous. 

> >> Could you
> >> add test cases that compare the output of both, for instance using a
> >> helper procedure that dismisses ANSI escapes?
> 
> You have provided:
> 
> > (define color-it-test
> >   (lambda (color str control)
> >     str))
> 
> rather, you want to write a procedure that takes a string with ANSI
> code sequences embedded and removes the ANSI codes so that only plain
> text remains.  That plain text can then be compared with the output
> from write/display.
> 
>  (define (remove-ansi-codes str) …)
> 
> then use that in the test-cases such as:
> 

But it's inefficient if I remove ansi-code each time after it's
generated. I prefer output the plain string on the fly with enable test
option.

>  (define (compare-write-and-colorize obj)
>    (string= (with-output-to-string
>              (lambda () (write obj)))
>             (remove-ansi-codes
>              (with-output-to-string
>               (lambda () (colorize obj))))))
> 
> but structure your test cases as per the existing test-suite.
> 
> > OK, I added a #:test in 'colorize' and a color-it-test for it.
> > But I know little about the test case of Guile, anyone point me out?
> 
> See the existing tests filed under test-suite/tests.
> 
> >> Would it make sense to define a new type for colors?  Like:
> >>
> >>   (define-record-type <color>
> >>     (color foreground background attribute)
> >>     color?
> >>     ...)
> >>
> >>   (define light-cyan
> >>     (color x y z))
> >>
> >
> > Actually, I did similar things (though without record-type), but I was
> > suggested use the *color-list* implementation from (ansi term) from
> > guile-lib. hmm... ;-)
> > Anyway, I think that implementation is not so clear, and it mixed
> > 'colors' and 'controls' together...
> 
> Right, lists are more natural for specifying these sets of attributes,
> which could be any combination of foreground, background, and/or
> something other.  (ansi term) module sets a very respectable example.

Anyway, I'll keep it.

> 
> >> > +(define color-it
> >> > +  (lambda (cs)
> >> > +    (let* ((str (color-scheme-str cs))
> >> > +      (color (color-scheme-color cs))
> >> > +      (control (color-scheme-control cs)))
> >> > +      (color-it-inner color str control))))
> >>
> >> This is somewhat confusing: I’d expect (color-it str cs), but instead
> >> the string to be printed is embedded in the “color scheme”.
> >>
> >
> > It's a convenient way to enclose string into 'color-scheme', since the
> > string could be used later.
> 
> I agree with Ludo, the string and color scheme are not so related.
> This design choice adds confusion to the rest of the module.
> 

OK, I think it's an absolute design, fixed. 

> >
> >> > +(define (backspace port)
> >> > +  (seek port -1 SEEK_CUR))
> >>
> >> What about non-seekable ports?  Could it be avoided altogether?
> >>
> >
> > But I think the 'port' parameter in 'call-with-output-string' is always
> > seekable, isn't it? The 'port' here is not a generic port.
> 
> Regardless, it is poor style to produce something only to subsequently
> scrub it out.  Code does this:
> 
> +	   (for-each (lambda (x) (colorize x port) (space port)) data)
> +	   (backspace port)  ;; remove the redundant space
> 
> when, if “colorize” produced strings, it could do something like this:
> 
>  (display (string-join (map colorize data) " ") port)
> 
> or, perhaps more efficiently, this:
> 
>  (format port "~{~a~^ ~}" (map colorize data))
> 

Nice~I'm in the first way, and added a helper function '->cstr' to
generate color string result for any type.
A good hack I like it~

> >> > +(define color-array-inner
> 
> >> Wow, this is hairy and heavyweight.
> 
> > Yes, but the aim of colorized-REPL is to show more friendly UI to the
> > users, it dropped up some efficiency designs.
> 
> Disagree.  It is more difficult to read the array tag with all the
> colour changes.  Breaking apart elements to this level is extreme,
> prone to errors, and poorly maintainable.  All that for a very
> questionable gain in “friendly UI”.  Keep things simple, at least
> until you have a smooth module without issues.
> 

Even if I don't break apart it, it's inefficient too, I have to convert
it to string then output the prefix-part.
As I said, nobody will use it in one's serious program, since it's only
about REPL. Who care about the REPL running speed? Users like a more
friendly REPL UI not a quick REPL since it's useless in a released
program but for test/debug. Except for 'colorized-string', but it's a
simple function which is safe and fast.

> Also, this colours the vectag (such as “s16” or “u8”) for arrays, but
> does not do the same for bytevectors.  This comes across as very
> inconsistent, especially with two such values next to each other.
> Just leave the array tags in a single colour.

I removed bytevectors since it's unnecessary.

> 
> >> > +(define *colorize-list*
> >> > +  `((,integer? INTEGER ,color-integer (BLUE BOLD))
> >> > +    (,char? CHAR ,color-char (YELLOW))
> >>
> >> Instead of a list, can you instead define a record for each token color
> >> setting?
> >>
> >>   (define-record-type <token-color>
> >>     (token-color name pred color-proc color)
> >>     token-color?
> >>     ...)
> >>
> >>   (define %token-colors
> >>     `(,(token-color 'integer integer? color-integer '(blue bold))
> >>       ...))
> >>
> >
> > Hmm...if it's unnecessary, I prefer be lazy...
> >
> >> > +(define type-checker
> 
> >>
> >> Using call/cc here is fun but excessively bad-style.  :-)
> >>
> >> Try something like:
> >>
> >>   (or (any ... (current-custom-colorized))
> >>       (any ... %token-colors)
> >>       (token-color 'unknown (const #t) color-unknown '(white)))
> >>
> >
> > But in this context, I need a finder which could return the result, not
> > just predicate true/false, 'any' seems can't provide that.
> 
> You might want to reread the definition of “any”.
> 

Right~it's a nice thing but I misunderstood it. Fixed.

> Best wishes.

Please review it:
https://github.com/NalaGinrut/guile-colorized/tree/upstream

It become better and better now, no matter if it's applied, it's a nice
thing to play, and I learned many things from this work. Thanks guys!

Re: [PATCH] Colorized REPL

[Daniel Hartwig]

On 11 January 2013 14:29, Nala Ginrut <nalaginrut@gmail.com> wrote:
> On Thu, 2013-01-10 at 16:19 +0800, Daniel Hartwig wrote:
> I changed these:
> string-in-color => colorize-string
> display-string-in-color => colorized-display
>
> What do you think?

Nicer anway.

>> Also, the “/” in “1/2” appears as a different colour, why?!
>>
>
> It's more conspicuous for the users. I asked some guys, they like it.
>

I see.

>
> But how to check if a REPL is already running?

I believe there was some fluid referenced by a previous version of
activate-colorized.

>> Procedure arguments “data” which should rather be “obj”.
>>
>
> Colorize an 'obj' is strange, I think 'data' is better.
>

Not strange at all in the context of Scheme where this is a well
established convention.  “obj” literally means “any object”, talking
about Scheme objects (not GOOPS).  “data” is not commonly used and
when it is, typically has a very specific meaning that does not
include “any object”.  To read a procedure definition that uses the
name “obj” I can immediately tell what types of values it expects
(anything!), whereas “data” carries no particular hints at all.

In any Scheme documentation, such as the Guile manual or any Revised*
Report on Scheme, there is almost exclusive use of the name “obj” for
arguments like this.  See the R5RS section “Entry format”.

> But what's the expected result of "(write #u8(0 1 2)) (newline)"?

As I wrote: #u8(0 1 2).  I provided that line to demonstrate that
colorize-it was producing different output.

>
>> The chance of subtle problems with other data types is high, both now
>> and in the future after any current problems are corrected.
>>
>
> Any code contains potential bugs.

Yes.

> I don't think people should use (ice-9 colorize) in their serious
> program, it's just a tool for newbies to learn Guile more friendly. Even
> 'colorize-string', it's the co-product of that, and it just output a
> string in color, simple enough to avoid dangerous.

Regardless of the purpose, if it is shipped as part of Guile then it
will be used.  It's output must be reliable.

Keep in mind that you can not anticipate everything people will do
with code.  It takes on it's own life and you can only smile and watch
it play :-)

>
> But it's inefficient if I remove ansi-code each time after it's
> generated. I prefer output the plain string on the fly with enable test
> option.

Test cases do not have to be efficient, they must prove the real code.
 By replacing the innermost procedure—colorize-the-string—with a
testing variant you are no longer testing the real code, but something
else.

>> I agree with Ludo, the string and color scheme are not so related.
>> This design choice adds confusion to the rest of the module.
>>
>
> OK, I think it's an absolute design, fixed.

I suppose the original comments were not so clear.  It is not only the
string but other members such as “data” that do not fit the concept of
“colour scheme”.  Anyway, given that it is an internal type there is
not much point to restructuring it all, except for pedantics.


>> when, if “colorize” produced strings, it could do something like this:
>>

> Nice~I'm in the first way, and added a helper function '->cstr' to
> generate color string result for any type.
> A good hack I like it~

Indeed.  The new loops are certainly an improvement.

Personally I would have avoided call-with-output-string in ->cstr and
other low-level procedures, since now there are several calls in and
out of string ports.  I suppose that is another early design decision
that is not worth the effort to change.

>
>> >> > +(define color-array-inner
>>
>> >> Wow, this is hairy and heavyweight.
>>
>> > Yes, but the aim of colorized-REPL is to show more friendly UI to the
>> > users, it dropped up some efficiency designs.
>>
>> Disagree.  It is more difficult to read the array tag with all the
>> colour changes.  Breaking apart elements to this level is extreme,
>> prone to errors, and poorly maintainable.  All that for a very
>> questionable gain in “friendly UI”.  Keep things simple, at least
>> until you have a smooth module without issues.
>>
>
> Even if I don't break apart it, it's inefficient too, I have to convert
> it to string then output the prefix-part.

You could inspect the array and generate the tag yourself.  This would
not explode on very large data structures.  But, as you go on to say …

> As I said, nobody will use it in one's serious program, since it's only
> about REPL. Who care about the REPL running speed? Users like a more
> friendly REPL UI not a quick REPL since it's useless in a released
> program but for test/debug. Except for 'colorized-string', but it's a
> simple function which is safe and fast.

Indeed, with this outlook there is little point to such alternative
treatment, and the easiest thing to do is to rely on the existing
procedures to produce the correct output.

However I will say that an efficient and flexible implementation would
certainly be useful in applications outside of the developers REPL.
Applications display data, and often contain REPL and equivalent. :-)

> Please review it:
> https://github.com/NalaGinrut/guile-colorized/tree/upstream
>

This:

 (define colorize-the-string
   (lambda (color str control)
     (string-append "\x1b[" (generate-color color) "m" str
       "\x1b[" (generate-color control) "m")))

Why move "\x1b[" and "m" out of generate-color here?  Have that
procedure procedure the /complete/ escape sequence and it is much
neater.

Regards

Re: [PATCH] Colorized REPL

[Nala Ginrut]

On Fri, 2013-01-11 at 16:13 +0800, Daniel Hartwig wrote:
> On 11 January 2013 14:29, Nala Ginrut <nalaginrut@gmail.com> wrote:
> > On Thu, 2013-01-10 at 16:19 +0800, Daniel Hartwig wrote:
> > I changed these:
> > string-in-color => colorize-string
> > display-string-in-color => colorized-display
> >
> > What do you think?
> 
> Nicer anway.
> 
> >> Also, the “/” in “1/2” appears as a different colour, why?!
> >>
> >
> > It's more conspicuous for the users. I asked some guys, they like it.
> >
> 
> I see.
> 
> >
> > But how to check if a REPL is already running?
> 
> I believe there was some fluid referenced by a previous version of
> activate-colorized.
> 
> >> Procedure arguments “data” which should rather be “obj”.
> >>
> >
> > Colorize an 'obj' is strange, I think 'data' is better.
> >
> 
> Not strange at all in the context of Scheme where this is a well
> established convention.  “obj” literally means “any object”, talking
> about Scheme objects (not GOOPS).  “data” is not commonly used and
> when it is, typically has a very specific meaning that does not
> include “any object”.  To read a procedure definition that uses the
> name “obj” I can immediately tell what types of values it expects
> (anything!), whereas “data” carries no particular hints at all.
> 
> In any Scheme documentation, such as the Guile manual or any Revised*
> Report on Scheme, there is almost exclusive use of the name “obj” for
> arguments like this.  See the R5RS section “Entry format”.
> 

OK~fixed.

> > But what's the expected result of "(write #u8(0 1 2)) (newline)"?
> 
> As I wrote: #u8(0 1 2).  I provided that line to demonstrate that
> colorize-it was producing different output.
> 
> >
> >> The chance of subtle problems with other data types is high, both now
> >> and in the future after any current problems are corrected.
> >>
> >
> > Any code contains potential bugs.
> 
> Yes.
> 
> > I don't think people should use (ice-9 colorize) in their serious
> > program, it's just a tool for newbies to learn Guile more friendly. Even
> > 'colorize-string', it's the co-product of that, and it just output a
> > string in color, simple enough to avoid dangerous.
> 
> Regardless of the purpose, if it is shipped as part of Guile then it
> will be used.  It's output must be reliable.
> 
> Keep in mind that you can not anticipate everything people will do
> with code.  It takes on it's own life and you can only smile and watch
> it play :-)
> 
> >
> > But it's inefficient if I remove ansi-code each time after it's
> > generated. I prefer output the plain string on the fly with enable test
> > option.
> 
> Test cases do not have to be efficient, they must prove the real code.
>  By replacing the innermost procedure—colorize-the-string—with a
> testing variant you are no longer testing the real code, but something
> else.
> 

Yes, that's a good point, and the test case could move out of the module
itself.

> >> I agree with Ludo, the string and color scheme are not so related.
> >> This design choice adds confusion to the rest of the module.
> >>
> >
> > OK, I think it's an absolute design, fixed.
> 
> I suppose the original comments were not so clear.  It is not only the
> string but other members such as “data” that do not fit the concept of
> “colour scheme”.  Anyway, given that it is an internal type there is
> not much point to restructuring it all, except for pedantics.
> 

Well, if it's too uncomfortable, maybe it should rename to
"colorize-context". Anyway, I agree with your opinion, it's not so
important for an internal type.

> 
> >> when, if “colorize” produced strings, it could do something like this:
> >>
> 
> > Nice~I'm in the first way, and added a helper function '->cstr' to
> > generate color string result for any type.
> > A good hack I like it~
> 
> Indeed.  The new loops are certainly an improvement.
> 
> Personally I would have avoided call-with-output-string in ->cstr and
> other low-level procedures, since now there are several calls in and
> out of string ports.  I suppose that is another early design decision
> that is not worth the effort to change.
> 

Yes, I could do that but taking other advantage of others functions is
better, and it introduced call-with-outout-string anyway.

> >
> >> >> > +(define color-array-inner
> >>
> >> >> Wow, this is hairy and heavyweight.
> >>
> >> > Yes, but the aim of colorized-REPL is to show more friendly UI to the
> >> > users, it dropped up some efficiency designs.
> >>
> >> Disagree.  It is more difficult to read the array tag with all the
> >> colour changes.  Breaking apart elements to this level is extreme,
> >> prone to errors, and poorly maintainable.  All that for a very
> >> questionable gain in “friendly UI”.  Keep things simple, at least
> >> until you have a smooth module without issues.
> >>
> >
> > Even if I don't break apart it, it's inefficient too, I have to convert
> > it to string then output the prefix-part.
> 
> You could inspect the array and generate the tag yourself.  This would
> not explode on very large data structures.  But, as you go on to say …
> 

Seems it's the only 'suck point' now, I do try to handle the prefix with
Guile's function, but the Array is too complicated (and not the srfi-63
compatible), finally I lost, so I tried a easy solution...
PS: I don't think srfi-63 is matter here, just to say it's a brand new
complicated thing to learn...

> > As I said, nobody will use it in one's serious program, since it's only
> > about REPL. Who care about the REPL running speed? Users like a more
> > friendly REPL UI not a quick REPL since it's useless in a released
> > program but for test/debug. Except for 'colorized-string', but it's a
> > simple function which is safe and fast.
> 
> Indeed, with this outlook there is little point to such alternative
> treatment, and the easiest thing to do is to rely on the existing
> procedures to produce the correct output.
> 

If the Array is the only problem, we'd better fix it anyway. I think
there's no other bad thing left, or not?

> However I will say that an efficient and flexible implementation would
> certainly be useful in applications outside of the developers REPL.
> Applications display data, and often contain REPL and equivalent. :-)
> 
> > Please review it:
> > https://github.com/NalaGinrut/guile-colorized/tree/upstream
> >
> 
> This:
> 
>  (define colorize-the-string
>    (lambda (color str control)
>      (string-append "\x1b[" (generate-color color) "m" str
>        "\x1b[" (generate-color control) "m")))
> 
> Why move "\x1b[" and "m" out of generate-color here?  Have that
> procedure procedure the /complete/ escape sequence and it is much
> neater.
> 

Ah~yeah, fixed.

> Regards
> 

I'll call this 'sculpture hacking', hah? ;-D


Thanks!

Re: [PATCH] Colorized REPL

[Ludovic Courtès]

Hi Nala,

Thanks for the update.

Nala Ginrut <nalaginrut@gmail.com> skribis:

> On Fri, 2013-01-04 at 15:06 +0100, Ludovic Courtès wrote:

[...]

>> Nala Ginrut <nalaginrut@gmail.com> skribis:
>> 
>> > 1. colorized-REPL feature:
>> > Add two lines to your ~/.guile, to enable colorized-REPL feature: 
>> > (use-modules (ice-9 colorized))
>> > (activate-colorized)
>> 
>> I did that, and actually had to jump into a recursive REPL to see it in
>> effect.  Would be nice to fix it.
>> 
>
> Well, I'm not sure what's the mean of 'recursive REPL'? 

An inner REPL (info "(guile) Error Handling").

>> > 2. custom color scheme:
>> > Example:
>> > (add-color-scheme! `((,(lambda (data) 
>> >                         (and (number? data) (> data 10000)))
>> >                         MY-LONG-NUM ,color-it (RED))))
>> 
>> Nice.
>> 
>> > Add it to your ~/.guile or in your code at you wish.
>> > This feature is useful, because sometimes we need to test our program
>> > and output a colorful result for some monitoring purpose.
>> > PS: MY-LONG-NUM is an arbitrary name for your own color scheme, as you
>> > like.
>> 
>> Why is that name even needed?
>
> It's easy to debug or checkout the color-scheme info with the name.

Hmm, there’s other info that helps debugging, such as location info of
the procedure, but OK.

>> Below is a rough review.  There are many stylistic issues IMO, such as
>> the lack of proper docstrings and comments, use of conventions that are
>> uncommon in Guile (like (define foo (lambda (arg) ...)),
>> *variable-with-stars*, hanging parentheses, etc.), sometimes weird
>> indentation, and use of tabs.
>> 
>> Overall it’s essentially a new implementation of write/display, so I’m a
>> bit concerned about keeping it in sync with the other one.  Could you
>> add test cases that compare the output of both, for instance using a
>> helper procedure that dismisses ANSI escapes?
>> 
>
> OK, I added a #:test in 'colorize' and a color-it-test for it.
> But I know little about the test case of Guile, anyone point me out?

See under test-suite/tests/*.test.  There’s a small set of constructs to
express unit tests, such as ‘pass-if’.

>> Some other comments:
>> 
>> > +(define-module (ice-9 colorized)
>> > +  #:use-module (oop goops)
>> > +  #:use-module ((rnrs) #:select (bytevector->u8-list define-record-type
>> > +				vector-for-each bytevector?))
>> 
>> Would be good to pull neither of these.
>> 
>> Could you use (srfi srfi-9) and (rnrs bytevectors) instead of the
>> latter?  For GOOPS, see below.
>> 
>
> record-type in r6rs is more convenient I think.

That’s not the question. ;-)  It doesn’t justify pulling in all of R6RS.

>> > +(define-record-type color-scheme
>> > +  (fields str data type color control method))
>> 
>> Could you comment this?  I’m not clear on what each field is.

Ping!

>> > +(define *color-list*
>> > +  `((CLEAR       .   "0")
>> > +    (RESET       .   "0")
>> > +    (BOLD        .   "1")
>> > +    (DARK        .   "2")
>> > +    (UNDERLINE   .   "4")
>> > +    (UNDERSCORE  .   "4")
>> > +    (BLINK       .   "5")
>> > +    (REVERSE     .   "6")
>> > +    (CONCEALED   .   "8")
>> > +    (BLACK       .  "30")
>> > +    (RED         .  "31")
>> > +    (GREEN       .  "32")
>> > +    (YELLOW      .  "33")
>> > +    (BLUE        .  "34")
>> > +    (MAGENTA     .  "35")
>> > +    (CYAN        .  "36")
>> > +    (WHITE       .  "37")
>> > +    (ON-BLACK    .  "40")
>> > +    (ON-RED      .  "41")
>> > +    (ON-GREEN    .  "42")
>> > +    (ON-YELLOW   .  "43")
>> > +    (ON-BLUE     .  "44")
>> > +    (ON-MAGENTA  .  "45")
>> > +    (ON-CYAN     .  "46")
>> > +    (ON-WHITE    .  "47")))
>> 
>> Would it make sense to define a new type for colors?  Like:
>> 
>>   (define-record-type <color>
>>     (color foreground background attribute)
>>     color?
>>     ...)
>> 
>>   (define light-cyan
>>     (color x y z))
>> 
>
> Actually, I did similar things (though without record-type), but I was
> suggested use the *color-list* implementation from (ansi term) from
> guile-lib. hmm... ;-)
> Anyway, I think that implementation is not so clear, and it mixed
> 'colors' and 'controls' together...

Which implementation?  I still think that using a disjoint type for
colors would be better than symbols.  Also, this is something part of
the API, so we can’t just leave it for later discussion.

>> > +(define color-it
>> > +  (lambda (cs)
>> > +    (let* ((str (color-scheme-str cs))
>> > +	   (color (color-scheme-color cs))
>> > +	   (control (color-scheme-control cs)))
>> > +      (color-it-inner color str control))))
>> 
>> This is somewhat confusing: I’d expect (color-it str cs), but instead
>> the string to be printed is embedded in the “color scheme”.
>> 
>
> It's a convenient way to enclose string into 'color-scheme', since the
> string could be used later. 

Surely, but it mixes concerns.  Can you try to make sure ‘color-scheme’
objects are just that, color scheme?

>> > +(define (backspace port)
>> > +  (seek port -1 SEEK_CUR))
>> 
>> What about non-seekable ports?  Could it be avoided altogether?
>> 
>
> But I think the 'port' parameter in 'call-with-output-string' is always
> seekable, isn't it? The 'port' here is not a generic port.

String ports are seekable, right.  However, seeking here seems like a
hack: you could just as well adjust the printer to not write that extra
character instead of writing it and then seeking backwards.  WDYT?

>> > +    (if sign
>> > +	(display (color-it-inner color sign control) port)  ;; not array
>> > +	(display (color-array-inner cs) port) ;; array complecated coloring
>> > +	)))
>> 
>> Parentheses should be at the end of the previous line.
>> End-of-line comments should be introduced with a single semicolon.
>> 
>
> Fixed them all, comments convention & suspended right-paren. ;-)

There are still many conventions wrong, such as procedure definitions,
global variable names, missing docstrings, etc.  Could you try to fix
them as well?

>> > +(define color-array-inner
>> > +  (lambda (cs)
>> > +    (let* ((colors (color-scheme-color cs))
>> > +	   (control (color-scheme-control cs))
>> > +	   (sign-color (car colors))
>> > +	   (attr-color (cadr colors))
>> > +	   (str (color-scheme-str cs))
>> > +	   (attrs (string->list 
>> > +		   (call-with-input-string str (lambda (p) (read-delimited "(" p))))))
>> > +      (call-with-output-string
>> > +       (lambda (port)
>> > +	 (for-each (lambda (ch)
>> > +		     (let ((color (if (is-sign? ch) sign-color attr-color)))
>> > +		       (display (color-it-inner color (string ch) control) port)))
>> > +		   attrs)
>> > +	 (display (color-it-inner sign-color "(" control) port) ;; output right-parent
>> > +	 )))))
>> 
>> Wow, this is hairy and heavyweight.
>> 
>
> Yes, but the aim of colorized-REPL is to show more friendly UI to the
> users, it dropped up some efficiency designs.

When we include features in Guile, we review the /implementation/ of
that feature in the hope that it’ll be reasonably pleasant our eyes.
This particular procedure could surely be made more pleasant to the eye. 
WDYT?

>> > +(define *colorize-list*
>> > +  `((,integer? INTEGER ,color-integer (BLUE BOLD))
>> > +    (,char? CHAR ,color-char (YELLOW))
>> 
>> Instead of a list, can you instead define a record for each token color
>> setting?
>> 
>>   (define-record-type <token-color>
>>     (token-color name pred color-proc color)
>>     token-color?
>>     ...)
>> 
>>   (define %token-colors
>>     `(,(token-color 'integer integer? color-integer '(blue bold))
>>       ...))
>> 
>
> Hmm...if it's unnecessary, I prefer be lazy...

Using disjoint types is beneficial in helping catch programming errors,
and clarify what the objects being worked on are.

Again, this thing is part of the API, so it’s worth thinking it through.
Using a record makes it easier to eventually extend the thing.

So you may consider it necessary.

>> > +(define type-checker
>> > +  (lambda (data)
>> > +    (call/cc (lambda (return)
>> > +	       (for-each (lambda (x)  ;; checkout user defined data type
>> > +			   (and ((car x) data) (return (cdr x))))
>> > +			 (current-custom-colorized))
>> > +	       (for-each (lambda (x)  ;; checkout default data type
>> > +			   (and ((car x) data) (return (cdr x))))
>> > +			 *colorize-list*)
>> > +	       (return `(UNKNOWN ,color-unknown (WHITE))))))) ;; no suitable data type ,return the unknown solution
>> 
>> Using call/cc here is fun but excessively bad-style.  :-)
>> 
>> Try something like:
>> 
>>   (or (any ... (current-custom-colorized))
>>       (any ... %token-colors)
>>       (token-color 'unknown (const #t) color-unknown '(white)))
>> 
>
> But in this context, I need a finder which could return the result, not
> just predicate true/false, 'any' seems can't provide that.

Sorry, it should be ‘find’, not ‘any’.

> It's here now:
> https://github.com/NalaGinrut/guile-colorized/blob/upstream/ice-9/colorized.scm

(Next time please post the code; this facilitates review.)

It seems it’s improved (thanks!), but I would like to see the API issues
and stylistic problems to be addressed.

> And I'm waiting for any help to write the test-case.

If you have specific questions as you work on it, I’m happy to help.
Otherwise, I won’t offer to write the actual tests.

BTW, before it can be integrated, it will also need to have a section in
the manual, probably under “Using Guile Interactively”.  Could you work
on it?

I reckon I’m asking for some extra work, but I think it’s important to
not compromise on Guile’s current standards.

Thank you!

Ludo’.

Re: [PATCH] Colorized REPL

[Noah Lavine]

[-- Attachment #1: Type: text/plain, Size: 1244 bytes --]

Hello,


On Fri, Jan 11, 2013 at 9:33 AM, Ludovic Courtès <ludo@gnu.org> wrote:

> >> Nala Ginrut <nalaginrut@gmail.com> skribis:
> > record-type in r6rs is more convenient I think.
>
> That’s not the question. ;-)  It doesn’t justify pulling in all of R6RS.
>

This is just a small part of a much larger review, but it should be
possible to import (rnrs records syntactic), right? Or maybe even just
(rnrs records) (I don't know much about the R6RS library system).

I see that (rnrs records syntactic) pulls in a bunch of other R6RS stuff,
which perhaps you won't like. But I think there is something wrong with
this idea - the point of having libraries is that we can use them. If we
can't use anything from R6RS because we don't want to pull it in, then why
did we implement it?

I know that supporting other peoples' r6rs programs is also a reason, but I
think that Guile should be able to use the libraries it itself bundles. And
in theory, using RnRS libraries is nice because it promotes portable Scheme
code. (I do agree that R6RS is a sort of weird case, because a lot of it is
different names for features that Guile already has in another form. I'm
not sure if that changes this or not.)

Thanks,
Noah

[-- Attachment #2: Type: text/html, Size: 1860 bytes --]

Re: [PATCH] Colorized REPL

[Ludovic Courtès]

Hello,

Noah Lavine <noah.b.lavine@gmail.com> skribis:

> On Fri, Jan 11, 2013 at 9:33 AM, Ludovic Courtès <ludo@gnu.org> wrote:
>
>> >> Nala Ginrut <nalaginrut@gmail.com> skribis:
>> > record-type in r6rs is more convenient I think.
>>
>> That’s not the question. ;-)  It doesn’t justify pulling in all of R6RS.
>>
>
> This is just a small part of a much larger review, but it should be
> possible to import (rnrs records syntactic), right?

Yes, but even that pulls a number of other rnrs modules.  It seems to me
that SRFI-9, even if it’s slightly more verbose, would be much less of a
burden here.

> I know that supporting other peoples' r6rs programs is also a reason, but I
> think that Guile should be able to use the libraries it itself
> bundles.

I agree in general, yes.  But when the run-time footprint can be reduced
at little cost, it seems nice to do it.

> And in theory, using RnRS libraries is nice because it promotes
> portable Scheme code. (I do agree that R6RS is a sort of weird case,
> because a lot of it is different names for features that Guile already
> has in another form. I'm not sure if that changes this or not.)

Exactly: the problem I have with R6RS is that it basically re-implements
several SRFIs or APIs otherwise available in Guile, sometimes just for
dubious aesthetic reasons–e.g., SRFI-1, SRFI-9, SRFI-3[45].
Traditionally ice-9 modules have not used them.

(Note that R7RS is likely to make that even worse...)

Ludo’.

Re: [PATCH] Colorized REPL

[Daniel Hartwig]

On 11 January 2013 22:33, Ludovic Courtès <ludo@gnu.org> wrote:
>>> > +(define *color-list*
>>> > +  `((CLEAR       .   "0")
>>> > +    (RESET       .   "0")
>>> > +    (BOLD        .   "1")
>>> > +    (DARK        .   "2")

>>> Would it make sense to define a new type for colors?  Like:
>>>
>>>   (define-record-type <color>
>>>     (color foreground background attribute)
>>>     color?
>>>     ...)

I presume you intended this to be private to the module.  Exposing
such a type publicly and calling it <color> is just offensive, since
these are ANSI control codes and contain no colour representation. :-)

>>
>> Actually, I did similar things (though without record-type), but I was
>> suggested use the *color-list* implementation from (ansi term) from
>> guile-lib. hmm... ;-)
>> Anyway, I think that implementation is not so clear, and it mixed
>> 'colors' and 'controls' together...
>
> Which implementation?

See guile-libs (term ansi-color) module.

> I still think that using a disjoint type for
> colors would be better than symbols.

These are arbitrary control codes and can be applied in any
combination.  Essentially, the best you can do with a disjoint type
is:

(define-record-type foo
  (make-foo name code) …

Which you would still need a dictionary to look them up by name, or
export a binding for every code and combination, or provide additional
operators to combine them …

The type you proposed seems to operate at the next level, holding
several codes in pre-defined fields according to their perceived
function (foreground colour, etc.).  Several of those fields will
often be blank, i.e. the case where only “bold” is activated.  These
will have to be later converted to a list to be useful in generating
the escape sequence.

List of symbols is a convenient abstraction over the natural form:
list of control codes.  Embedding this in to a record with named and
function-presuming fields is too much and needlessly complicated, IMO.

List of symbols is also compatible with the interface established by
the earlier guile-lib module, for whatever that is worth.

Using list of symbols:

(colorize-string "foo" '(RED))
(colorize-string "foo" '(BOLD ON-CYAN))

It is not clear to me the interface you are proposed at this level.
Will you provide counter examples to these two calls?

Regards

Re: [PATCH] Colorized REPL

[Daniel Hartwig]

On 11 January 2013 18:40, Nala Ginrut <nalaginrut@gmail.com> wrote:
> Yes, that's a good point, and the test case could move out of the module
> itself.

It should.

>> I suppose the original comments were not so clear.  It is not only the
>> string but other members such as “data” that do not fit the concept of
>> “colour scheme”.  Anyway, given that it is an internal type there is
>> not much point to restructuring it all, except for pedantics.
>>
>
> Well, if it's too uncomfortable, maybe it should rename to
> "colorize-context". Anyway, I agree with your opinion, it's not so
> important for an internal type.

To get it included with Guile, I believe you will have to separate it.
 With a little work there wouldn't be any use for color-scheme or
whatever anyway.

> If the Array is the only problem, we'd better fix it anyway. I think
> there's no other bad thing left, or not?

It is more than the treatment of array.  There are still Ludo's
comments about style and consistency with the rest of Guile's
codebase.  The overall structure leaves something to desire (IMO). …

Anyway, it does what it aims to do.  So that is nice. :-)


Regards

Re: [PATCH] Colorized REPL

[Nala Ginrut]

[-- Attachment #1: Type: text/plain, Size: 1479 bytes --]

hi Daniel & Ludo!

===========================
** Here are the changes:
1. Use srfi-9 record & fields comment
But I still like r6rs record, since it's less code to write. The only
good point for me is easy to comment each field. ;-P

2. Fix function define convention
I'm not aware of that, but are we going to define a function without
explicit 'lambda'?
Sorry but I didn't find any doc for this convention. I read HACKING
file, but it explains only about C code convention.
Anyway, I fixed it.

3. Rename "data" to "obj"

4. Fixed recursive REPL issue:
I think '(null? (fluid-ref *repl-stack*))' is true if there's no REPL
started, right?

============================
** But suspended issues:
1. Code style issue
I can't find a doc in Guile for that. Could anyone help me out?

2. Array efficient issue
I'd like to fix it, but it's complex & inefficient either anyway.
I've no idea at all. Even if I simply output (object->string array),
it's inefficient as read it's array-prefix-part-string, and parse it.
The best way I think is to use array-rank/array-type... such things to
handle all the prefix-part of array. But as I said, it's too
complicated, the simplest way is the way I choose. 
My vote is to avoid complex design if unnecessary. But we may enhance it
later in the long term, rather than put all hackers' power to focus on a
rarely considered issue now.
What do you think?

3. Test case & manual
Should be done after all issues gone.
 
Anything missing?

Thanks!

[-- Attachment #2: colorized.scm --]
[-- Type: text/x-scheme, Size: 11342 bytes --]

;; Copyright (C) 2012 Free Software Foundation, Inc.

;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

;;;; Author: Mu Lei known as NalaGinrut <nalaginrut@gmail.com>

(define-module (ice-9 colorized)
  #:use-module (ice-9 rdelim)
  #:use-module ((srfi srfi-1) #:select (filter-map any proper-list?))
  #:use-module (srfi srfi-9)
  #:use-module (system repl common)
  #:export (activate-colorized custom-colorized-set! color-it colorize-it colorize
	    colorize-string colorized-display add-color-scheme! display-in-color))

(define (colorized-repl-printer repl val)
  (colorize-it val))
      
(define (activate-colorized)
  (let ((rs (fluid-ref *repl-stack*)))
    (if (null? rs)
	(repl-default-option-set! 'print colorized-repl-printer) ; if no REPL started, set as default printer
	(repl-option-set! (car rs) 'print colorized-repl-printer)))) ; or set as the top-REPL printer

;; color-scheme context, contains some info to be used
(define-record-type color-scheme
  (make-color-scheme obj type color control method)
  color-scheme?
  (obj color-scheme-obj) ; the obj to be colored
  (type color-scheme-type) ; the obj type (for debug/test)
  (color color-scheme-color) ; the color
  (control color-scheme-control) ; ansi control code
  (method color-scheme-method)) ; colorized method for the obj type
  
(define *color-list*
  `((CLEAR       .   "0")
    (RESET       .   "0")
    (BOLD        .   "1")
    (DARK        .   "2")
    (UNDERLINE   .   "4")
    (UNDERSCORE  .   "4")
    (BLINK       .   "5")
    (REVERSE     .   "6")
    (CONCEALED   .   "8")
    (BLACK       .  "30")
    (RED         .  "31")
    (GREEN       .  "32")
    (YELLOW      .  "33")
    (BLUE        .  "34")
    (MAGENTA     .  "35")
    (CYAN        .  "36")
    (WHITE       .  "37")
    (ON-BLACK    .  "40")
    (ON-RED      .  "41")
    (ON-GREEN    .  "42")
    (ON-YELLOW   .  "43")
    (ON-BLUE     .  "44")
    (ON-MAGENTA  .  "45")
    (ON-CYAN     .  "46")
    (ON-WHITE    .  "47")))

(define (get-color color)
  (assoc-ref *color-list* color))

(define (generate-color colors)
  (let ((color-list
	 (filter-map (lambda (c) (assoc-ref *color-list* c)) colors)))
    (if (null? color-list)
	""
	(string-append "\x1b[" (string-join color-list ";" 'infix) "m"))))

(define (colorize-the-string color str control)
  (string-append (generate-color color) str (generate-color control)))

(define (color-it-test color str control) str)

;; test-helper functions
;; when eanbled, it won't output colored result, but just normal.
;; it used to test the array/list/vector print result.
(define *color-func* (make-fluid colorize-the-string))
(define (disable-color-test) 
  (fluid-set! *color-func* colorize-the-string))
(define (enable-color-test) 
  (fluid-set! *color-func* color-it-test))

(define (color-it cs) 
  (let* ((obj (color-scheme-obj cs))
	 (str (object->string obj))
	 (color (color-scheme-color cs))
	 (control (color-scheme-control cs)))
    (color-it-inner color str control)))
  
(define (color-it-inner color str control)
  ((fluid-ref *color-func*) color str control))

(define* (space #:optional (port (current-output-port)))
  (display #\sp port))

(define *pre-sign* 
  `((LIST       .   "(") 
    (PAIR       .   "(") 
    (VECTOR     .   "#(")
    (ARRAY      .   #f))) 
;; array's sign is complecated, return #f so it will be handled by pre-print

(define* (pre-print cs #:optional (port (current-output-port)))
  (let* ((type (color-scheme-type cs))
	 (control (color-scheme-control cs))
	 (sign (assoc-ref *pre-sign* type))
	 (color (color-scheme-color cs))) 
    (if sign
	(display (color-it-inner color sign control) port)  ; not array
	;; array complecated coloring
	(display (color-array-inner cs) port))))

(define (print-dot port)
  (let ((light-cyan '(CYAN BOLD)))
    (display (color-it-inner light-cyan "." '(RESET)) port)))

(define (delimiter? ch)
  (char-set-contains? char-set:punctuation ch))

(define (color-array-inner cs)
  (let* ((colors (color-scheme-color cs))
	 (control (color-scheme-control cs))
	 (sign-color (car colors))
	 (attr-color (cadr colors))
	 (str (object->string (color-scheme-obj cs)))
	 (attrs (string->list 
		 (call-with-input-string str (lambda (p) (read-delimited "(" p))))))
    (call-with-output-string
     (lambda (port)
       (for-each (lambda (ch)
		   (let ((color (if (delimiter? ch) sign-color attr-color)))
		     (display (color-it-inner color (string ch) control) port)))
		 attrs)
       ;; output left-paren
       (display (color-it-inner sign-color "(" control) port)))))

;; Write a closing parenthesis.
(define* (post-print cs #:optional (port (current-output-port)))
  (let* ((c (color-scheme-color cs))
	 (control (color-scheme-control cs))
	 (color (if (list? (car c)) (car c) c))) ; array has a color-list
    (display (color-it-inner color ")" control) port)))
      
(define (color-integer cs)
  (color-it cs))

(define (color-char cs)
  (color-it cs))

(define (color-string cs)
  (color-it cs))

(define (color-list cs)
  (let* ((obj (color-scheme-obj cs)))
    (if (proper-list? obj)
	(call-with-output-string
	 (lambda (port)
	   (pre-print cs port)
	   (display (string-join (map ->cstr obj) " ") port)
	   (post-print cs port)))
	(color-pair cs))))
    
(define (color-pair cs)
  (let* ((obj (color-scheme-obj cs))
	 (d1 (car obj))
	 (d2 (cdr obj)))
    (call-with-output-string
     (lambda (port)
       (pre-print cs port)
       (colorize d1 port)
       (space port) (print-dot port) (space port)
       (colorize d2 port)
       (post-print cs port)))))

(define (color-class cs)
  (color-it cs))

(define (color-procedure cs)
  (color-it cs))

(define (color-vector cs)
  (let ((ll (vector->list (color-scheme-obj cs))))
    (call-with-output-string
     (lambda (port)
       (pre-print cs port)
       (display (string-join (map ->cstr ll) " ") port)
       (post-print cs port)))))
    
(define (color-keyword cs)
  (color-it cs))

;; TODO: maybe print it as char one by one?
(define (color-char-set cs)
  (color-it cs))

(define (color-symbol cs)
  (color-it cs))

(define (color-stack cs)
  (color-it cs))

(define (color-record-type cs)
  (color-it cs))

(define (color-inexact cs)
  (color-it cs))

(define (color-exact cs)
  (let* ((obj (color-scheme-obj cs))
	 (colors (color-scheme-color cs))
	 (num-color (car colors))
	 (div-color (cadr colors))
	 (control (color-scheme-control cs))
	 (n (object->string (numerator obj)))
	 (d (object->string (denominator obj))))
    (call-with-output-string
     (lambda (port)
       (format port "~a~a~a" 
	       (color-it-inner num-color n control)
	       (color-it-inner div-color "/" control)
	       (color-it-inner num-color d control))))))

(define (color-regexp cs)
  (color-it cs))

(define (color-bitvector cs)
  ;; TODO: is it right?
  (color-it cs))

(define (color-boolean cs)
  (color-it cs))

(define (color-array cs)
  (let ((ll (array->list (color-scheme-obj cs))))
    (call-with-output-string
     (lambda (port)
       (pre-print cs port)
       (display (string-join (map ->cstr ll) " ") port)
       (post-print cs port)))))

(define (color-complex cs)
  (color-it cs))

(define (color-hashtable cs)
  (color-it cs))

(define (color-hook cs)
  (color-it cs))

(define (color-unknown cs)
  (color-it cs))

;;--- custom color scheme ---
(define *custom-colorized-list* (make-fluid '()))

(define (custom-colorized-set! ll)
  (fluid-set! *custom-colorized-list* ll))

(define (current-custom-colorized)
  (fluid-ref *custom-colorized-list*))

(define (add-color-scheme! cs-list)
  (let ((ll (current-custom-colorized)))
    (custom-colorized-set! `(,@cs-list ,@ll))))
;;--- custom color scheme end---

(define (is-inexact? obj)
  (and (number? obj) (inexact? obj)))

(define (is-exact? obj)
  (and (number? obj) (exact? obj)))

;; A class is a struct.
(define (class? obj)
  (struct? obj))

(define *colorize-list*
  `((,integer? INTEGER ,color-integer (BLUE BOLD))
    (,char? CHAR ,color-char (YELLOW))
    (,string? STRING ,color-string (RED))
    (,list? LIST ,color-list (BLUE BOLD))
    (,pair? PAIR ,color-list (BLACK BOLD)) ; NOTE: proper-list is a <pair>, and cons is <pair> too, so call color-list either.
    (,class? CLASS ,color-class (CYAN BOLD))
    (,procedure? PROCEDURE ,color-procedure (YELLOW BOLD))
    (,vector? VECTOR ,color-vector (MAGENTA BOLD))
    (,keyword? KEYWORD ,color-keyword (MAGENTA))
    (,char-set? CHAR-SET ,color-char-set (WHITE))
    (,symbol? SYMBOL ,color-symbol (GREEN BOLD))
    (,stack? STACK ,color-stack (MAGENTA))
    (,record-type? RECORD-TYPE ,color-record-type (BLACK BOLD))
    ;; We don't check REAL here, since it'll cover FLOAT and FRACTION, but user may customs it as they wish.
    (,is-inexact? FLOAT ,color-inexact (YELLOW))
    (,is-exact? FRACTION ,color-exact ((BLUE BOLD) (YELLOW)))
    (,regexp? REGEXP ,color-regexp (GREEN))
    (,bitvector? BITVECTOR ,color-bitvector (YELLOW BOLD))
    (,array? ARRAY ,color-array ((CYAN BOLD) (YELLOW BOLD)))
    (,boolean? BOOLEAN ,color-boolean (BLUE))
    (,complex? COMPLEX ,color-complex (MAGENTA))
    (,hash-table? HASH-TABLE ,color-hashtable (BLUE))
    (,hook? HOOK ,color-hook (GREEN))))
;; TODO: if there's anything to add

(define (obj->token-color obj)
  (let ((proc (lambda (x) (and ((car x) obj) (cdr x)))))
    (or (any proc (current-custom-colorized)) ; checkout user defined obj type
	(any proc *colorize-list*) ; checkout default obj type
	`(UNKNOWN ,color-unknown (WHITE))))) ; no suitable obj type ,return the unknown solution

;; NOTE: we don't use control now, but I write the mechanism for future usage.
(define (generate-color-scheme obj)
  (let* ((r (obj->token-color obj))
	 (type (car r))
	 (method (cadr r))
	 (color (caddr r)))
    (make-color-scheme obj type color '(RESET) method)))

(define (generate-custom-string-color-scheme str color)
  (make-color-scheme str #f color '(RESET) color-string))

(define (colorize-string str color)
  "Example: (colorize-string \"hello\" '(BLUE BOLD))" 
  (and (not (list? color)) (error colorize-string "color should be a list!" color))
  (colorize-the-string color str '(RESET)))

(define (colorized-display str color)
  "Example: (colorized-display \"hello\" '(BLUE BOLD))"
  (display (colorize-string str color)))

(define* (colorize-it obj #:optional (port (current-output-port)))
  (colorize obj port)
  (newline port))

(define* (colorize obj #:optional (port (current-output-port)))
  (let* ((cs (generate-color-scheme obj))
	 (f (color-scheme-method cs)))
    (display (f cs) port)))

(define (->cstr obj)
  (call-with-output-string
   (lambda (port)
     (colorize obj port))))

Re: [PATCH] Colorized REPL

[Noah Lavine]

[-- Attachment #1: Type: text/plain, Size: 1336 bytes --]

Hello,


On Fri, Jan 11, 2013 at 6:26 PM, Ludovic Courtès <ludo@gnu.org> wrote:

> Hello,
>
> > I know that supporting other peoples' r6rs programs is also a reason,
> but I
> > think that Guile should be able to use the libraries it itself
> > bundles.
>
> I agree in general, yes.  But when the run-time footprint can be reduced
> at little cost, it seems nice to do it.
>
> > And in theory, using RnRS libraries is nice because it promotes
> > portable Scheme code. (I do agree that R6RS is a sort of weird case,
> > because a lot of it is different names for features that Guile already
> > has in another form. I'm not sure if that changes this or not.)
>
> Exactly: the problem I have with R6RS is that it basically re-implements
> several SRFIs or APIs otherwise available in Guile, sometimes just for
> dubious aesthetic reasons–e.g., SRFI-1, SRFI-9, SRFI-3[45].
> Traditionally ice-9 modules have not used them.
>

Yes, I agree with everything you said here. I'm torn, because I think that
in general having more portable Scheme code is good for everyone, and the
RnRS standards are the best way to do that, so maybe we should just accept
that the most recent 1 or 2 standards will always be loaded. But on the
other hand, that doesn't mean that this particular module needs to use them.

Noah

[-- Attachment #2: Type: text/html, Size: 1845 bytes --]

Re: [PATCH] Colorized REPL

[Ludovic Courtès]

Hi Daniel,

Daniel Hartwig <mandyke@gmail.com> skribis:

> On 11 January 2013 22:33, Ludovic Courtès <ludo@gnu.org> wrote:

[...]

>> I still think that using a disjoint type for
>> colors would be better than symbols.
>
> These are arbitrary control codes and can be applied in any
> combination.  Essentially, the best you can do with a disjoint type
> is:
>
> (define-record-type foo
>   (make-foo name code) …
>
> Which you would still need a dictionary to look them up by name, or
> export a binding for every code and combination, or provide additional
> operators to combine them …

Hmm.

> List of symbols is a convenient abstraction over the natural form:
> list of control codes.  Embedding this in to a record with named and
> function-presuming fields is too much and needlessly complicated, IMO.
>
> List of symbols is also compatible with the interface established by
> the earlier guile-lib module, for whatever that is worth.
>
> Using list of symbols:
>
> (colorize-string "foo" '(RED))
> (colorize-string "foo" '(BOLD ON-CYAN))
>
> It is not clear to me the interface you are proposed at this level.
> Will you provide counter examples to these two calls?

In general, using symbols like this amounts to introducing an alternate
name space, with its own rules, and its own support (or lack thereof).
For instance, if you use variables to hold colors, you could write:

  (colorize-string "foo" red)
  (colorize-string "foo" (with-background cyan bold))

And you get unbound variable warnings and errors if there’s a typo, a
type error if you’re passing something unrelated, etc.

That’s why as a rule of thumb I prefer disjoint types and variables for
singleton instances.

Now, there may be cases where this is overkill, or not appropriate for
some reason.  I’m not completely sure about ANSI escapes, so perhaps
you’re right that what I suggest is inappropriate.  Yet, the RED,
ON-CYAN, etc. symbols look ugly to me as an abstraction.

Thanks,
Ludo’.

Re: [PATCH] Colorized REPL

[Ludovic Courtès]

Hi!

Noah Lavine <noah.b.lavine@gmail.com> skribis:

> Yes, I agree with everything you said here. I'm torn, because I think that
> in general having more portable Scheme code is good for everyone, and the
> RnRS standards are the best way to do that, so maybe we should just accept
> that the most recent 1 or 2 standards will always be loaded. But on the
> other hand, that doesn't mean that this particular module needs to use them.

I would like to be as optimistic as you are, but hey, R7RS purposefully
ignores or re-implements part of R6RS, which purposefully ignored
several SRFIs and implementations.

Conversely, Guile is a stable standard.  :-)

Ludo’.

Re: [PATCH] Colorized REPL

[Nala Ginrut]

[-- Attachment #1.1: Type: text/plain, Size: 10788 bytes --]

hi folks!
test-case is ready. I've tested, it works and passed all items.
Please review it.
I'll work on manual for it ASAP.

Thanks!


On Fri, Jan 11, 2013 at 10:33 PM, Ludovic Courtès <ludo@gnu.org> wrote:

> Hi Nala,
>
> Thanks for the update.
>
> Nala Ginrut <nalaginrut@gmail.com> skribis:
>
> > On Fri, 2013-01-04 at 15:06 +0100, Ludovic Courtès wrote:
>
> [...]
>
> >> Nala Ginrut <nalaginrut@gmail.com> skribis:
> >>
> >> > 1. colorized-REPL feature:
> >> > Add two lines to your ~/.guile, to enable colorized-REPL feature:
> >> > (use-modules (ice-9 colorized))
> >> > (activate-colorized)
> >>
> >> I did that, and actually had to jump into a recursive REPL to see it in
> >> effect.  Would be nice to fix it.
> >>
> >
> > Well, I'm not sure what's the mean of 'recursive REPL'?
>
> An inner REPL (info "(guile) Error Handling").
>
> >> > 2. custom color scheme:
> >> > Example:
> >> > (add-color-scheme! `((,(lambda (data)
> >> >                         (and (number? data) (> data 10000)))
> >> >                         MY-LONG-NUM ,color-it (RED))))
> >>
> >> Nice.
> >>
> >> > Add it to your ~/.guile or in your code at you wish.
> >> > This feature is useful, because sometimes we need to test our program
> >> > and output a colorful result for some monitoring purpose.
> >> > PS: MY-LONG-NUM is an arbitrary name for your own color scheme, as you
> >> > like.
> >>
> >> Why is that name even needed?
> >
> > It's easy to debug or checkout the color-scheme info with the name.
>
> Hmm, there’s other info that helps debugging, such as location info of
> the procedure, but OK.
>
> >> Below is a rough review.  There are many stylistic issues IMO, such as
> >> the lack of proper docstrings and comments, use of conventions that are
> >> uncommon in Guile (like (define foo (lambda (arg) ...)),
> >> *variable-with-stars*, hanging parentheses, etc.), sometimes weird
> >> indentation, and use of tabs.
> >>
> >> Overall it’s essentially a new implementation of write/display, so I’m a
> >> bit concerned about keeping it in sync with the other one.  Could you
> >> add test cases that compare the output of both, for instance using a
> >> helper procedure that dismisses ANSI escapes?
> >>
> >
> > OK, I added a #:test in 'colorize' and a color-it-test for it.
> > But I know little about the test case of Guile, anyone point me out?
>
> See under test-suite/tests/*.test.  There’s a small set of constructs to
> express unit tests, such as ‘pass-if’.
>
> >> Some other comments:
> >>
> >> > +(define-module (ice-9 colorized)
> >> > +  #:use-module (oop goops)
> >> > +  #:use-module ((rnrs) #:select (bytevector->u8-list
> define-record-type
> >> > +                          vector-for-each bytevector?))
> >>
> >> Would be good to pull neither of these.
> >>
> >> Could you use (srfi srfi-9) and (rnrs bytevectors) instead of the
> >> latter?  For GOOPS, see below.
> >>
> >
> > record-type in r6rs is more convenient I think.
>
> That’s not the question. ;-)  It doesn’t justify pulling in all of R6RS.
>
> >> > +(define-record-type color-scheme
> >> > +  (fields str data type color control method))
> >>
> >> Could you comment this?  I’m not clear on what each field is.
>
> Ping!
>
> >> > +(define *color-list*
> >> > +  `((CLEAR       .   "0")
> >> > +    (RESET       .   "0")
> >> > +    (BOLD        .   "1")
> >> > +    (DARK        .   "2")
> >> > +    (UNDERLINE   .   "4")
> >> > +    (UNDERSCORE  .   "4")
> >> > +    (BLINK       .   "5")
> >> > +    (REVERSE     .   "6")
> >> > +    (CONCEALED   .   "8")
> >> > +    (BLACK       .  "30")
> >> > +    (RED         .  "31")
> >> > +    (GREEN       .  "32")
> >> > +    (YELLOW      .  "33")
> >> > +    (BLUE        .  "34")
> >> > +    (MAGENTA     .  "35")
> >> > +    (CYAN        .  "36")
> >> > +    (WHITE       .  "37")
> >> > +    (ON-BLACK    .  "40")
> >> > +    (ON-RED      .  "41")
> >> > +    (ON-GREEN    .  "42")
> >> > +    (ON-YELLOW   .  "43")
> >> > +    (ON-BLUE     .  "44")
> >> > +    (ON-MAGENTA  .  "45")
> >> > +    (ON-CYAN     .  "46")
> >> > +    (ON-WHITE    .  "47")))
> >>
> >> Would it make sense to define a new type for colors?  Like:
> >>
> >>   (define-record-type <color>
> >>     (color foreground background attribute)
> >>     color?
> >>     ...)
> >>
> >>   (define light-cyan
> >>     (color x y z))
> >>
> >
> > Actually, I did similar things (though without record-type), but I was
> > suggested use the *color-list* implementation from (ansi term) from
> > guile-lib. hmm... ;-)
> > Anyway, I think that implementation is not so clear, and it mixed
> > 'colors' and 'controls' together...
>
> Which implementation?  I still think that using a disjoint type for
> colors would be better than symbols.  Also, this is something part of
> the API, so we can’t just leave it for later discussion.
>
> >> > +(define color-it
> >> > +  (lambda (cs)
> >> > +    (let* ((str (color-scheme-str cs))
> >> > +     (color (color-scheme-color cs))
> >> > +     (control (color-scheme-control cs)))
> >> > +      (color-it-inner color str control))))
> >>
> >> This is somewhat confusing: I’d expect (color-it str cs), but instead
> >> the string to be printed is embedded in the “color scheme”.
> >>
> >
> > It's a convenient way to enclose string into 'color-scheme', since the
> > string could be used later.
>
> Surely, but it mixes concerns.  Can you try to make sure ‘color-scheme’
> objects are just that, color scheme?
>
> >> > +(define (backspace port)
> >> > +  (seek port -1 SEEK_CUR))
> >>
> >> What about non-seekable ports?  Could it be avoided altogether?
> >>
> >
> > But I think the 'port' parameter in 'call-with-output-string' is always
> > seekable, isn't it? The 'port' here is not a generic port.
>
> String ports are seekable, right.  However, seeking here seems like a
> hack: you could just as well adjust the printer to not write that extra
> character instead of writing it and then seeking backwards.  WDYT?
>
> >> > +    (if sign
> >> > +  (display (color-it-inner color sign control) port)  ;; not array
> >> > +  (display (color-array-inner cs) port) ;; array complecated coloring
> >> > +  )))
> >>
> >> Parentheses should be at the end of the previous line.
> >> End-of-line comments should be introduced with a single semicolon.
> >>
> >
> > Fixed them all, comments convention & suspended right-paren. ;-)
>
> There are still many conventions wrong, such as procedure definitions,
> global variable names, missing docstrings, etc.  Could you try to fix
> them as well?
>
> >> > +(define color-array-inner
> >> > +  (lambda (cs)
> >> > +    (let* ((colors (color-scheme-color cs))
> >> > +     (control (color-scheme-control cs))
> >> > +     (sign-color (car colors))
> >> > +     (attr-color (cadr colors))
> >> > +     (str (color-scheme-str cs))
> >> > +     (attrs (string->list
> >> > +             (call-with-input-string str (lambda (p) (read-delimited
> "(" p))))))
> >> > +      (call-with-output-string
> >> > +       (lambda (port)
> >> > +   (for-each (lambda (ch)
> >> > +               (let ((color (if (is-sign? ch) sign-color
> attr-color)))
> >> > +                 (display (color-it-inner color (string ch) control)
> port)))
> >> > +             attrs)
> >> > +   (display (color-it-inner sign-color "(" control) port) ;; output
> right-parent
> >> > +   )))))
> >>
> >> Wow, this is hairy and heavyweight.
> >>
> >
> > Yes, but the aim of colorized-REPL is to show more friendly UI to the
> > users, it dropped up some efficiency designs.
>
> When we include features in Guile, we review the /implementation/ of
> that feature in the hope that it’ll be reasonably pleasant our eyes.
> This particular procedure could surely be made more pleasant to the eye.
> WDYT?
>
> >> > +(define *colorize-list*
> >> > +  `((,integer? INTEGER ,color-integer (BLUE BOLD))
> >> > +    (,char? CHAR ,color-char (YELLOW))
> >>
> >> Instead of a list, can you instead define a record for each token color
> >> setting?
> >>
> >>   (define-record-type <token-color>
> >>     (token-color name pred color-proc color)
> >>     token-color?
> >>     ...)
> >>
> >>   (define %token-colors
> >>     `(,(token-color 'integer integer? color-integer '(blue bold))
> >>       ...))
> >>
> >
> > Hmm...if it's unnecessary, I prefer be lazy...
>
> Using disjoint types is beneficial in helping catch programming errors,
> and clarify what the objects being worked on are.
>
> Again, this thing is part of the API, so it’s worth thinking it through.
> Using a record makes it easier to eventually extend the thing.
>
> So you may consider it necessary.
>
> >> > +(define type-checker
> >> > +  (lambda (data)
> >> > +    (call/cc (lambda (return)
> >> > +         (for-each (lambda (x)  ;; checkout user defined data type
> >> > +                     (and ((car x) data) (return (cdr x))))
> >> > +                   (current-custom-colorized))
> >> > +         (for-each (lambda (x)  ;; checkout default data type
> >> > +                     (and ((car x) data) (return (cdr x))))
> >> > +                   *colorize-list*)
> >> > +         (return `(UNKNOWN ,color-unknown (WHITE))))))) ;; no
> suitable data type ,return the unknown solution
> >>
> >> Using call/cc here is fun but excessively bad-style.  :-)
> >>
> >> Try something like:
> >>
> >>   (or (any ... (current-custom-colorized))
> >>       (any ... %token-colors)
> >>       (token-color 'unknown (const #t) color-unknown '(white)))
> >>
> >
> > But in this context, I need a finder which could return the result, not
> > just predicate true/false, 'any' seems can't provide that.
>
> Sorry, it should be ‘find’, not ‘any’.
>
> > It's here now:
> >
> https://github.com/NalaGinrut/guile-colorized/blob/upstream/ice-9/colorized.scm
>
> (Next time please post the code; this facilitates review.)
>
> It seems it’s improved (thanks!), but I would like to see the API issues
> and stylistic problems to be addressed.
>
> > And I'm waiting for any help to write the test-case.
>
> If you have specific questions as you work on it, I’m happy to help.
> Otherwise, I won’t offer to write the actual tests.
>
> BTW, before it can be integrated, it will also need to have a section in
> the manual, probably under “Using Guile Interactively”.  Could you work
> on it?
>
> I reckon I’m asking for some extra work, but I think it’s important to
> not compromise on Guile’s current standards.
>
> Thank you!
>
> Ludo’.
>

[-- Attachment #1.2: Type: text/html, Size: 14414 bytes --]

[-- Attachment #2: colorized.test --]
[-- Type: application/octet-stream, Size: 2728 bytes --]

;;;; colorized.test --- test (ice-9 colorized) module -*- scheme -*-
;;;; 
;;;; Copyright 2012 Free Software Foundation, Inc.
;;;; 
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

(define-module (test-suite test-ice-9-colorized)
  #:use-module (test-suite lib)
  #:use-module (oop goops)
  #:use-module (srfi srfi-9)
  #:use-module (ice-9 colorized))

;; enable colorized-REPL test printer
((@@ (ice-9 colorized) enable-color-test))

;;;
;;; colorzed object test
;;;

(define (test-me obj)
  (pass-if "OK" 
           (equal? (call-with-output-string
                    (lambda (port) (colorize obj port)))
                   (object->string obj))))

(with-test-prefix "colorized object tests"

  (with-test-prefix "integer"
    (test-me 123))

  (with-test-prefix "char"
    (test-me #\c))

  (with-test-prefix "string"
    (test-me "hello world\n"))

  (with-test-prefix "list"
    (test-me '(1 2 3 4 5)))

  (with-test-prefix "pair"
    (test-me (cons 1 2)))

  (with-test-prefix "class"
    (test-me <integer>))

  (with-test-prefix "procedure"
    (test-me +))

  (with-test-prefix "vector"
    (test-me (vector 1 2 3)))

  (with-test-prefix "keyword"
    (test-me #:test-me))

  (with-test-prefix "char-set"
    (test-me char-set:ascii))

  (with-test-prefix "symbol"
    (test-me 'test-me))

  (with-test-prefix "stack"
    (test-me (make-stack #t)))

  (with-test-prefix "record-type"
    (define-record-type aaa (make-aaa a) aaa? (a a))
    (test-me aaa))

  (with-test-prefix "inexact"
    (test-me 1.2))

  (with-test-prefix "exact"
    (test-me 1/2))

  (with-test-prefix "regexp"
    (test-me (make-regexp "[0-9]*")))

  (with-test-prefix "bitvector"
    (test-me (make-bitvector 8)))

  (with-test-prefix "array"
    (test-me #2u32@2@3((1 2) (3 4))))

  (with-test-prefix "boolean"
    (test-me #f)
    (test-me #t))

  (with-test-prefix "complex"
    (test-me 3+4i))

  (with-test-prefix "hash table"
    (test-me (make-hash-table)))

  (with-test-prefix "hook"
    (test-me (make-hook))))

  

Re: [PATCH] Colorized REPL

[Andy Wingo]

On Wed 05 Dec 2012 10:50, Daniel Llorens <daniel.llorens@bluewin.ch> writes:

>> On 5 December 2012 15:21, Nala Ginrut <nalaginrut@gmail.com> wrote:
>
>> I don't think it's proper to use (ansi term-color)
>> purposely, since it's not in Guile.
>
> Maybe we should start moving a few things from guile-lib into Guile proper.
>
> (ansi term-color) may be a candidate. I think that (os process) should
> be merged in Guile in some form, run-with-pipe has appeared in the lists
> a few times.

Patches to (ice-9 popen) are welcome :)  Note that the open-pipe
procedure that is available now within the (ice-9 popen) module does not
create a composite port; that might be useful for a hypothetical patch.

Andy
-- 
http://wingolog.org/

Re: [PATCH] Colorized REPL

[Nala Ginrut]

[-- Attachment #1: Type: text/plain, Size: 72 bytes --]

Hi folks!
Manual of (ice-9 colorized) updated.
Patch attached.

Thanks!

[-- Attachment #2: 0001-Update-manual-for-ice-9-colorized.patch --]
[-- Type: text/x-patch, Size: 5291 bytes --]

From 4e4acbe884716b0c84f1c39bc054244112daf17d Mon Sep 17 00:00:00 2001
From: Nala Ginrut <nalaginrut@gmail.com>
Date: Tue, 22 Jan 2013 19:02:06 +0800
Subject: [PATCH] Update manual for (ice-9 colorized).

* doc/ref/misc-modules.texi: Add (ice-9 colorized).

* doc/ref/scheme-using.texi: Add colorized REPL usage.
---
 doc/ref/misc-modules.texi |   91 +++++++++++++++++++++++++++++++++++++++++++++
 doc/ref/scheme-using.texi |   35 ++++++++++++++++-
 2 files changed, 125 insertions(+), 1 deletion(-)

diff --git a/doc/ref/misc-modules.texi b/doc/ref/misc-modules.texi
index cf1e0e4..770f354 100644
--- a/doc/ref/misc-modules.texi
+++ b/doc/ref/misc-modules.texi
@@ -1789,6 +1789,97 @@ example with the Scheme @code{read} function (@pxref{Scheme Read}),
 @end deffn
 
 
+@node Colorized
+@section Colorized
+
+@cindex Colorized
+The module @code{(ice-9 colorized)} provides the procedure
+@code{activate-colorized}, which provides colored REPL output.
+
+The module is loaded and activated by entering the following:
+
+@lisp
+(use-modules (ice-9 colorized))
+(activate-colorized)
+@end lisp
+
+And you may add your own color scheme with @code{add-color-scheme!}:
+
+@lisp
+(add-color-scheme! `((,(lambda (data) 
+                         (and (number? data) (> data 10000)))
+                          MY-LONG-NUM ,color-it (RED))))
+@print{}
+Result: 10001 (in red color)
+@end lisp
+
+@deffn {Scheme Procedure} activate-colorized
+Activate colorized REPL.
+@end deffn
+
+@deffn {Scheme Procedure} add-color-scheme! color-scheme-list
+Add user defined color scheme. @code{color-scheme-list} consisted as:
+@lisp
+(list (pred scheme-name color-method color-list)
+      ;; other color scheme) 
+@end lisp
+While @code{pred} is the predicate to checkout if it's the type you need,
+@code{scheme-name} is a symbol you named this color scheme, 
+@code{color-method} is the color function, and it could be @code{color-it}
+in default, and @code{color-list} is a ansi-color specific color list.
+@end deffn
+
+@cindex Colorized String
+Also exported by the @code{(ice-9 colorized)} module is
+@code{colorize-string}, a procedure to format a string in certain color.
+
+@lisp
+(use-modules (ice-9 colorized))
+(colorize-display "hello" '(BLUE BOLD))
+@print{} hello (in blue color and bold style)
+(colorize-string "hello" '(BLUE BOLD))
+@print{} "\x1b[32;1mhello\x1b[0m"
+(display (colorize-string "hello" '(BLUE BOLD)))
+@print{} hello (in blue color and bold style)
+@end lisp
+
+@deffn {Scheme Procedure} colorize-string str color
+Return a string formated with @var{str} in @var{color} according to ansi
+color specific.  
+@end deffn
+
+@deffn {Scheme Procedure} colorize-display str color
+Print @var{str} in @var{color}.
+@end deffn
+
+Here is the available colors:
+CLEAR,
+RESET,
+BOLD,
+DARK,
+UNDERLINE, 
+UNDERSCORE,
+BLINK,     
+REVERSE,   
+CONCEALED, 
+BLACK,
+RED,       
+GREEN,     
+YELLOW,    
+BLUE,      
+MAGENTA,   
+CYAN,      
+WHITE,     
+ON-BLACK,  
+ON-RED,    
+ON-GREEN,  
+ON-YELLOW, 
+ON-BLUE,   
+ON-MAGENTA,
+ON-CYAN, 
+ON-WHITE
+
+
 @c Local Variables:
 @c TeX-master: "guile.texi"
 @c End:
diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index e0f91af..fe302c2 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -37,6 +37,7 @@ support for languages other than Scheme.
 @menu
 * Init File::
 * Readline::                    
+* Colorized REPL::
 * Value History::              
 * REPL Commands::               
 * Error Handling::              
@@ -79,6 +80,37 @@ It's a good idea to put these two lines (without the
 @xref{Init File}, for more on @file{.guile}.
 
 
+@node Colorized REPL
+@subsection Colorized REPL
+
+To make colorized result in Guile REPL, or add your own color
+schemes to show the result in colors.
+
+@lisp
+scheme@@(guile-user)> (use-modules (ice-9 colorized))
+scheme@@(guile-user)> (activate-colorized)
+@end lisp
+
+It's a good idea to put these two lines (without the
+@code{scheme@@(guile-user)>} prompts) in your @file{.guile} file.
+Besides, you may add your color schemes for the result:
+@lisp
+(add-color-scheme! (list (pred scheme-name color-method color-list)))
+example:
+(add-color-scheme! `((,(lambda (data) 
+                         (and (number? data) (> data 10000)))
+                          MY-LONG-NUM ,color-it (RED))))
+10001
+@print{} 10001 (in red color)
+@end lisp
+While @code{pred} is the predicate to checkout if it's the type you need,
+@code{scheme-name} is a symbol you named this color scheme, 
+@code{color-method} is the color function, and it could be @code{color-it}
+in default, and @code{color-list} is a ansi-color specific color list, 
+please see @xref{Colorized}.
+@xref{Init File}, for more on @file{.guile}.
+
+
 @node Value History
 @subsection Value History
 
@@ -147,7 +179,8 @@ data structure or closure, they may then be reclaimed by the garbage collector.
 
 @cindex commands
 The REPL exists to read expressions, evaluate them, and then print their
-results. But sometimes one wants to tell the REPL to evaluate an
+results. But sometimes o
+ne wants to tell the REPL to evaluate an
 expression in a different way, or to do something else altogether. A
 user can affect the way the REPL works with a @dfn{REPL command}.
 
-- 
1.7.10.4

Re: [PATCH] Colorized REPL

[Nala Ginrut]

[-- Attachment #1: Type: text/plain, Size: 53 bytes --]

colorized.scm updated.
Please review it. ;-P
Thanks!

[-- Attachment #2: colorized.scm --]
[-- Type: text/x-scheme, Size: 11325 bytes --]

;; Copyright (C) 2012 Free Software Foundation, Inc.

;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

;;;; Author: Mu Lei known as NalaGinrut <nalaginrut@gmail.com>

(define-module (ice-9 colorized)
  #:use-module (ice-9 rdelim)
  #:use-module ((srfi srfi-1) #:select (filter-map any proper-list?))
  #:use-module (srfi srfi-9)
  #:use-module (system repl common)
  #:export (activate-colorized custom-colorized-set! color-it colorize-it colorize
	    colorize-string colorized-display add-color-scheme!))

(define (colorized-repl-printer repl val)
  (colorize-it val))
      
(define (activate-colorized)
  (let ((rs (fluid-ref *repl-stack*)))
    (if (null? rs)
	(repl-default-option-set! 'print colorized-repl-printer) ; if no REPL started, set as default printer
	(repl-option-set! (car rs) 'print colorized-repl-printer)))) ; or set as the top-REPL printer

;; color-scheme context, contains some info to be used
(define-record-type color-scheme
  (make-color-scheme obj type color control method)
  color-scheme?
  (obj color-scheme-obj) ; the obj to be colored
  (type color-scheme-type) ; the obj type (for debug/test)
  (color color-scheme-color) ; the color
  (control color-scheme-control) ; ansi control code
  (method color-scheme-method)) ; colorized method for the obj type
  
(define *color-list*
  `((CLEAR       .   "0")
    (RESET       .   "0")
    (BOLD        .   "1")
    (DARK        .   "2")
    (UNDERLINE   .   "4")
    (UNDERSCORE  .   "4")
    (BLINK       .   "5")
    (REVERSE     .   "6")
    (CONCEALED   .   "8")
    (BLACK       .  "30")
    (RED         .  "31")
    (GREEN       .  "32")
    (YELLOW      .  "33")
    (BLUE        .  "34")
    (MAGENTA     .  "35")
    (CYAN        .  "36")
    (WHITE       .  "37")
    (ON-BLACK    .  "40")
    (ON-RED      .  "41")
    (ON-GREEN    .  "42")
    (ON-YELLOW   .  "43")
    (ON-BLUE     .  "44")
    (ON-MAGENTA  .  "45")
    (ON-CYAN     .  "46")
    (ON-WHITE    .  "47")))

(define (get-color color)
  (assoc-ref *color-list* color))

(define (generate-color colors)
  (let ((color-list
	 (filter-map (lambda (c) (assoc-ref *color-list* c)) colors)))
    (if (null? color-list)
	""
	(string-append "\x1b[" (string-join color-list ";" 'infix) "m"))))

(define (colorize-the-string color str control)
  (string-append (generate-color color) str (generate-color control)))

(define (color-it-test color str control) str)

;; test-helper functions
;; when eanbled, it won't output colored result, but just normal.
;; it used to test the array/list/vector print result.
(define *color-func* (make-fluid colorize-the-string))
(define (disable-color-test) 
  (fluid-set! *color-func* colorize-the-string))
(define (enable-color-test) 
  (fluid-set! *color-func* color-it-test))

(define (color-it cs) 
  (let* ((obj (color-scheme-obj cs))
	 (str (object->string obj))
	 (color (color-scheme-color cs))
	 (control (color-scheme-control cs)))
    (color-it-inner color str control)))
  
(define (color-it-inner color str control)
  ((fluid-ref *color-func*) color str control))

(define* (space #:optional (port (current-output-port)))
  (display #\sp port))

(define *pre-sign* 
  `((LIST       .   "(") 
    (PAIR       .   "(") 
    (VECTOR     .   "#(")
    (ARRAY      .   #f))) 
;; array's sign is complecated, return #f so it will be handled by pre-print

(define* (pre-print cs #:optional (port (current-output-port)))
  (let* ((type (color-scheme-type cs))
	 (control (color-scheme-control cs))
	 (sign (assoc-ref *pre-sign* type))
	 (color (color-scheme-color cs))) 
    (if sign
	(display (color-it-inner color sign control) port)  ; not array
	;; array complecated coloring
	(display (color-array-inner cs) port))))

(define (print-dot port)
  (let ((light-cyan '(CYAN BOLD)))
    (display (color-it-inner light-cyan "." '(RESET)) port)))

(define (delimiter? ch)
  (char-set-contains? char-set:punctuation ch))

(define (color-array-inner cs)
  (let* ((colors (color-scheme-color cs))
	 (control (color-scheme-control cs))
	 (sign-color (car colors))
	 (attr-color (cadr colors))
	 (str (object->string (color-scheme-obj cs)))
	 (attrs (string->list 
		 (call-with-input-string str (lambda (p) (read-delimited "(" p))))))
    (call-with-output-string
     (lambda (port)
       (for-each (lambda (ch)
		   (let ((color (if (delimiter? ch) sign-color attr-color)))
		     (display (color-it-inner color (string ch) control) port)))
		 attrs)
       ;; output left-paren
       (display (color-it-inner sign-color "(" control) port)))))

;; Write a closing parenthesis.
(define* (post-print cs #:optional (port (current-output-port)))
  (let* ((c (color-scheme-color cs))
	 (control (color-scheme-control cs))
	 (color (if (list? (car c)) (car c) c))) ; array has a color-list
    (display (color-it-inner color ")" control) port)))
      
(define (color-integer cs)
  (color-it cs))

(define (color-char cs)
  (color-it cs))

(define (color-string cs)
  (color-it cs))

(define (color-list cs)
  (let* ((obj (color-scheme-obj cs)))
    (if (proper-list? obj)
	(call-with-output-string
	 (lambda (port)
	   (pre-print cs port)
	   (display (string-join (map ->cstr obj) " ") port)
	   (post-print cs port)))
	(color-pair cs))))
    
(define (color-pair cs)
  (let* ((obj (color-scheme-obj cs))
	 (d1 (car obj))
	 (d2 (cdr obj)))
    (call-with-output-string
     (lambda (port)
       (pre-print cs port)
       (colorize d1 port)
       (space port) (print-dot port) (space port)
       (colorize d2 port)
       (post-print cs port)))))

(define (color-class cs)
  (color-it cs))

(define (color-procedure cs)
  (color-it cs))

(define (color-vector cs)
  (let ((ll (vector->list (color-scheme-obj cs))))
    (call-with-output-string
     (lambda (port)
       (pre-print cs port)
       (display (string-join (map ->cstr ll) " ") port)
       (post-print cs port)))))
    
(define (color-keyword cs)
  (color-it cs))

;; TODO: maybe print it as char one by one?
(define (color-char-set cs)
  (color-it cs))

(define (color-symbol cs)
  (color-it cs))

(define (color-stack cs)
  (color-it cs))

(define (color-record-type cs)
  (color-it cs))

(define (color-inexact cs)
  (color-it cs))

(define (color-exact cs)
  (let* ((obj (color-scheme-obj cs))
	 (colors (color-scheme-color cs))
	 (num-color (car colors))
	 (div-color (cadr colors))
	 (control (color-scheme-control cs))
	 (n (object->string (numerator obj)))
	 (d (object->string (denominator obj))))
    (call-with-output-string
     (lambda (port)
       (format port "~a~a~a" 
	       (color-it-inner num-color n control)
	       (color-it-inner div-color "/" control)
	       (color-it-inner num-color d control))))))

(define (color-regexp cs)
  (color-it cs))

(define (color-bitvector cs)
  ;; TODO: is it right?
  (color-it cs))

(define (color-boolean cs)
  (color-it cs))

(define (color-array cs)
  (let ((ll (array->list (color-scheme-obj cs))))
    (call-with-output-string
     (lambda (port)
       (pre-print cs port)
       (display (string-join (map ->cstr ll) " ") port)
       (post-print cs port)))))

(define (color-complex cs)
  (color-it cs))

(define (color-hashtable cs)
  (color-it cs))

(define (color-hook cs)
  (color-it cs))

(define (color-unknown cs)
  (color-it cs))

;;--- custom color scheme ---
(define *custom-colorized-list* (make-fluid '()))

(define (custom-colorized-set! ll)
  (fluid-set! *custom-colorized-list* ll))

(define (current-custom-colorized)
  (fluid-ref *custom-colorized-list*))

(define (add-color-scheme! cs-list)
  (let ((ll (current-custom-colorized)))
    (custom-colorized-set! `(,@cs-list ,@ll))))
;;--- custom color scheme end---

(define (is-inexact? obj)
  (and (number? obj) (inexact? obj)))

(define (is-exact? obj)
  (and (number? obj) (exact? obj)))

;; A class is a struct.
(define (class? obj)
  (struct? obj))

(define *colorize-list*
  `((,integer? INTEGER ,color-integer (BLUE BOLD))
    (,char? CHAR ,color-char (YELLOW))
    (,string? STRING ,color-string (RED))
    (,list? LIST ,color-list (BLUE BOLD))
    (,pair? PAIR ,color-list (BLACK BOLD)) ; NOTE: proper-list is a <pair>, and cons is <pair> too, so call color-list either.
    (,class? CLASS ,color-class (CYAN BOLD))
    (,procedure? PROCEDURE ,color-procedure (YELLOW BOLD))
    (,vector? VECTOR ,color-vector (MAGENTA BOLD))
    (,keyword? KEYWORD ,color-keyword (MAGENTA))
    (,char-set? CHAR-SET ,color-char-set (WHITE))
    (,symbol? SYMBOL ,color-symbol (GREEN BOLD))
    (,stack? STACK ,color-stack (MAGENTA))
    (,record-type? RECORD-TYPE ,color-record-type (BLACK BOLD))
    ;; We don't check REAL here, since it'll cover FLOAT and FRACTION, but user may customs it as they wish.
    (,is-inexact? FLOAT ,color-inexact (YELLOW))
    (,is-exact? FRACTION ,color-exact ((BLUE BOLD) (YELLOW)))
    (,regexp? REGEXP ,color-regexp (GREEN))
    (,bitvector? BITVECTOR ,color-bitvector (YELLOW BOLD))
    (,array? ARRAY ,color-array ((CYAN BOLD) (YELLOW BOLD)))
    (,boolean? BOOLEAN ,color-boolean (BLUE))
    (,complex? COMPLEX ,color-complex (MAGENTA))
    (,hash-table? HASH-TABLE ,color-hashtable (BLUE))
    (,hook? HOOK ,color-hook (GREEN))))
;; TODO: if there's anything to add

(define (obj->token-color obj)
  (let ((proc (lambda (x) (and ((car x) obj) (cdr x)))))
    (or (any proc (current-custom-colorized)) ; checkout user defined obj type
	(any proc *colorize-list*) ; checkout default obj type
	`(UNKNOWN ,color-unknown (WHITE))))) ; no suitable obj type ,return the unknown solution

;; NOTE: we don't use control now, but I write the mechanism for future usage.
(define (generate-color-scheme obj)
  (let* ((r (obj->token-color obj))
	 (type (car r))
	 (method (cadr r))
	 (color (caddr r)))
    (make-color-scheme obj type color '(RESET) method)))

(define (generate-custom-string-color-scheme str color)
  (make-color-scheme str #f color '(RESET) color-string))

(define (colorize-string str color)
  "Example: (colorize-string \"hello\" '(BLUE BOLD))" 
  (and (not (list? color)) (error colorize-string "color should be a list!" color))
  (colorize-the-string color str '(RESET)))

(define (colorized-display str color)
  "Example: (colorized-display \"hello\" '(BLUE BOLD))"
  (display (colorize-string str color)))

(define* (colorize-it obj #:optional (port (current-output-port)))
  (colorize obj port)
  (newline port))

(define* (colorize obj #:optional (port (current-output-port)))
  (let* ((cs (generate-color-scheme obj))
	 (f (color-scheme-method cs)))
    (display (f cs) port)))

(define (->cstr obj)
  (call-with-output-string
   (lambda (port)
     (colorize obj port))))

Re: [PATCH] Colorized REPL

[Andy Wingo]

On Sat 26 Jan 2013 11:15, Nala Ginrut <nalaginrut@gmail.com> writes:

> Please review it. ;-P

A drive-by review (i.e., just style comments and random questions)

> ;; Copyright (C) 2012 Free Software Foundation, Inc.

2013

> ;;;; Author: Mu Lei known as NalaGinrut <nalaginrut@gmail.com>

> (define-module (ice-9 colorized)
>   #:use-module (ice-9 rdelim)
>   #:use-module ((srfi srfi-1) #:select (filter-map any proper-list?))
>   #:use-module (srfi srfi-9)
>   #:use-module (system repl common)
>   #:export (activate-colorized custom-colorized-set! color-it colorize-it colorize
> 	    colorize-string colorized-display add-color-scheme!))

No tabs, please.  In emacs this is (indent-tabs-mode nil) I think; you
can M-x untabify also.

> (define (activate-colorized)
>   (let ((rs (fluid-ref *repl-stack*)))
>     (if (null? rs)
> 	(repl-default-option-set! 'print colorized-repl-printer) ; if no REPL started, set as default printer
> 	(repl-option-set! (car rs) 'print colorized-repl-printer)))) ; or set as the top-REPL printer

Nice

> (define *color-list*
>   `((CLEAR       .   "0")

Why are these upper-cased?  Unless there is a reason, lower-case is
better as it is easier to type and read.

> (define (get-color color)
>   (assoc-ref *color-list* color))

Use assq-ref, the keys are symbols

> (define (generate-color colors)
>   (let ((color-list
> 	 (filter-map (lambda (c) (assoc-ref *color-list* c)) colors)))

Use get-color here; and is the intention to silently ignore unknown
colors?

> (define (colorize-the-string color str control)
>   (string-append (generate-color color) str (generate-color control)))

The name is confusingly like "colorize-string" below.  Better to have a
more descriptive name, or maybe colorize-string-helper.

> ;; test-helper functions
> ;; when eanbled, it won't output colored result, but just normal.
> ;; it used to test the array/list/vector print result.
> (define *color-func* (make-fluid colorize-the-string))
> (define (disable-color-test) 
>   (fluid-set! *color-func* colorize-the-string))
> (define (enable-color-test) 
>   (fluid-set! *color-func* color-it-test))

Surely testing-related functions should not be here?

> (define (color-it-inner color str control)
>   ((fluid-ref *color-func*) color str control))

Use parameters instead of fluids.

> (define *pre-sign* 
>   `((LIST       .   "(") 
>     (PAIR       .   "(") 
>     (VECTOR     .   "#(")
>     (ARRAY      .   #f))) 
> ;; array's sign is complecated, return #f so it will be handled by pre-print

"complicated"

> (define* (pre-print cs #:optional (port (current-output-port)))
>   (let* ((type (color-scheme-type cs))
> 	 (control (color-scheme-control cs))
> 	 (sign (assoc-ref *pre-sign* type))

assq-ref

> (define *colorize-list*
>   `((,integer? INTEGER ,color-integer (BLUE BOLD))
>     (,char? CHAR ,color-char (YELLOW))
>     (,string? STRING ,color-string (RED))

Interesting :)

Regards,

Andy
-- 
http://wingolog.org/

Re: [PATCH] Colorized REPL

[Nala Ginrut]

On Sun, 2013-01-27 at 11:06 +0100, Andy Wingo wrote:
> On Sat 26 Jan 2013 11:15, Nala Ginrut <nalaginrut@gmail.com> writes:
> 
> > Please review it. ;-P
> 
> A drive-by review (i.e., just style comments and random questions)
> 
> > ;; Copyright (C) 2012 Free Software Foundation, Inc.
> 
> 2013
> 
> > ;;;; Author: Mu Lei known as NalaGinrut <nalaginrut@gmail.com>
> 
> > (define-module (ice-9 colorized)
> >   #:use-module (ice-9 rdelim)
> >   #:use-module ((srfi srfi-1) #:select (filter-map any proper-list?))
> >   #:use-module (srfi srfi-9)
> >   #:use-module (system repl common)
> >   #:export (activate-colorized custom-colorized-set! color-it colorize-it colorize
> > 	    colorize-string colorized-display add-color-scheme!))
> 
> No tabs, please.  In emacs this is (indent-tabs-mode nil) I think; you
> can M-x untabify also.
> 

Sorry, I thought I did...

> > (define (activate-colorized)
> >   (let ((rs (fluid-ref *repl-stack*)))
> >     (if (null? rs)
> > 	(repl-default-option-set! 'print colorized-repl-printer) ; if no REPL started, set as default printer
> > 	(repl-option-set! (car rs) 'print colorized-repl-printer)))) ; or set as the top-REPL printer
> 
> Nice
> 
> > (define *color-list*
> >   `((CLEAR       .   "0")
> 
> Why are these upper-cased?  Unless there is a reason, lower-case is
> better as it is easier to type and read.
> 

Well, this issue was discussed several times in this thread.
Originally I used symbol with lowercase for that, and Daniel suggested
me merge (term ansi-color) in guile-lib which is has this style. Then we
found that there're less things could be borrowed from (term
ansi-color), but I was suggested keep this style for some reasons.
Anyway, I don't think this style matters. ;-)

> > (define (get-color color)
> >   (assoc-ref *color-list* color))
> 
> Use assq-ref, the keys are symbols
> 
> > (define (generate-color colors)
> >   (let ((color-list
> > 	 (filter-map (lambda (c) (assoc-ref *color-list* c)) colors)))
> 
> Use get-color here; 

hmm...neglected... 

> and is the intention to silently ignore unknown
> colors?
> 

Yes, I think so. It won't break any think, except for redundant
ansi-control string appended.
And for undefined color-scheme for certain object, there's an 'unknown'
color-scheme for that.

> > (define (colorize-the-string color str control)
> >   (string-append (generate-color color) str (generate-color control)))
> 
> The name is confusingly like "colorize-string" below.  Better to have a
> more descriptive name, or maybe colorize-string-helper.
> 

Fixed.

> > ;; test-helper functions
> > ;; when eanbled, it won't output colored result, but just normal.
> > ;; it used to test the array/list/vector print result.
> > (define *color-func* (make-fluid colorize-the-string))
> > (define (disable-color-test) 
> >   (fluid-set! *color-func* colorize-the-string))
> > (define (enable-color-test) 
> >   (fluid-set! *color-func* color-it-test))
> 
> Surely testing-related functions should not be here?
> 

Daniel suggest me strip all the escape sequence from the result.
But I have some trouble with the regexp in Guile, seems "\\d+" can't
work, others, like "\\w+" works.
Maybe I should start a new thread about more details usage about regexp
in Guile? 

> > (define (color-it-inner color str control)
> >   ((fluid-ref *color-func*) color str control))
> 
> Use parameters instead of fluids.
> 
> > (define *pre-sign* 
> >   `((LIST       .   "(") 
> >     (PAIR       .   "(") 
> >     (VECTOR     .   "#(")
> >     (ARRAY      .   #f))) 
> > ;; array's sign is complecated, return #f so it will be handled by pre-print
> 
> "complicated"
> 

Shamed... :-(

> > (define* (pre-print cs #:optional (port (current-output-port)))
> >   (let* ((type (color-scheme-type cs))
> > 	 (control (color-scheme-control cs))
> > 	 (sign (assoc-ref *pre-sign* type))
> 
> assq-ref

Fixed.

> 
> > (define *colorize-list*
> >   `((,integer? INTEGER ,color-integer (BLUE BOLD))
> >     (,char? CHAR ,color-char (YELLOW))
> >     (,string? STRING ,color-string (RED))
> 
> Interesting :)
> 
> Regards,
> 
> Andy

Re: [PATCH] Colorized REPL

[Nala Ginrut]

[-- Attachment #1: Type: text/plain, Size: 97 bytes --]

Move test func to test-case.
And I think all the issues fixed.

Updated things attached.
Thanks!

[-- Attachment #2: colorized.scm --]
[-- Type: text/x-scheme, Size: 11437 bytes --]

;; Copyright (C) 2013 Free Software Foundation, Inc.

;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

;;;; Author: Mu Lei known as NalaGinrut <nalaginrut@gmail.com>

(define-module (ice-9 colorized)
  #:use-module (ice-9 rdelim)
  #:use-module ((srfi srfi-1) #:select (filter-map any proper-list?))
  #:use-module (srfi srfi-9)
  #:use-module (system repl common)
  #:export (activate-colorized custom-colorized-set! color-it colorize-it colorize
            color-func colorize-string colorized-display add-color-scheme!))

(define (colorized-repl-printer repl val)
  (colorize-it val))

(define (activate-colorized)
  (let ((rs (fluid-ref *repl-stack*)))
    (if (null? rs)
	(repl-default-option-set! 'print colorized-repl-printer) ; if no REPL started, set as default printer
	(repl-option-set! (car rs) 'print colorized-repl-printer)))) ; or set as the top-REPL printer

;; color-scheme context, contains some info to be used
(define-record-type color-scheme
  (make-color-scheme obj type color control method)
  color-scheme?
  (obj color-scheme-obj) ; the obj to be colored
  (type color-scheme-type) ; the obj type (for debug/test)
  (color color-scheme-color) ; the color
  (control color-scheme-control) ; ansi control code
  (method color-scheme-method)) ; colorized method for the obj type

(define *color-list*
  `((CLEAR       .   "0")
    (RESET       .   "0")
    (BOLD        .   "1")
    (DARK        .   "2")
    (UNDERLINE   .   "4")
    (UNDERSCORE  .   "4")
    (BLINK       .   "5")
    (REVERSE     .   "6")
    (CONCEALED   .   "8")
    (BLACK       .  "30")
    (RED         .  "31")
    (GREEN       .  "32")
    (YELLOW      .  "33")
    (BLUE        .  "34")
    (MAGENTA     .  "35")
    (CYAN        .  "36")
    (WHITE       .  "37")
    (ON-BLACK    .  "40")
    (ON-RED      .  "41")
    (ON-GREEN    .  "42")
    (ON-YELLOW   .  "43")
    (ON-BLUE     .  "44")
    (ON-MAGENTA  .  "45")
    (ON-CYAN     .  "46")
    (ON-WHITE    .  "47")))

(define (get-color color)
  (assq-ref *color-list* color))

(define (generate-color colors)
  (let ((color-list
         (filter-map get-color colors)))
    (if (null? color-list)
        ""
        (string-append "\x1b[" (string-join color-list ";" 'infix) "m"))))

(define (colorize-string-helper color str control)
  (string-append (generate-color color) str (generate-color control)))

;; test-helper functions
;; when eanbled, it won't output colored result, but just normal.
;; it used to test the array/list/vector print result.
(define color-func (make-parameter colorize-string-helper))

(define (color-it cs) 
  (let* ((obj (color-scheme-obj cs))
         (str (object->string obj))
         (color (color-scheme-color cs))
         (control (color-scheme-control cs)))
    (color-it-inner color str control)))

(define (color-it-inner color str control)
  ((color-func) color str control))

(define* (space #:optional (port (current-output-port)))
  (display #\sp port))

(define *pre-sign* 
  `((LIST       .   "(") 
    (PAIR       .   "(") 
    (VECTOR     .   "#(")
    (ARRAY      .   #f))) 
;; array's sign is complicated, return #f so it will be handled by pre-print

(define* (pre-print cs #:optional (port (current-output-port)))
  (let* ((type (color-scheme-type cs))
         (control (color-scheme-control cs))
         (sign (assq-ref *pre-sign* type))
         (color (color-scheme-color cs))) 
    (if sign
        (display (color-it-inner color sign control) port)  ; not array
        ;; array complecated coloring
        (display (color-array-inner cs) port))))

(define (print-dot port)
  (let ((light-cyan '(CYAN BOLD)))
    (display (color-it-inner light-cyan "." '(RESET)) port)))

(define (delimiter? ch)
  (char-set-contains? char-set:punctuation ch))

(define (color-array-inner cs)
  (let* ((colors (color-scheme-color cs))
         (control (color-scheme-control cs))
         (sign-color (car colors))
         (attr-color (cadr colors))
         (str (object->string (color-scheme-obj cs)))
         (attrs (string->list 
                 (call-with-input-string str (lambda (p) (read-delimited "(" p))))))
    (call-with-output-string
     (lambda (port)
       (for-each (lambda (ch)
                   (let ((color (if (delimiter? ch) sign-color attr-color)))
                     (display (color-it-inner color (string ch) control) port)))
                 attrs)
       ;; output left-paren
       (display (color-it-inner sign-color "(" control) port)))))

;; Write a closing parenthesis.
(define* (post-print cs #:optional (port (current-output-port)))
  (let* ((c (color-scheme-color cs))
         (control (color-scheme-control cs))
         (color (if (list? (car c)) (car c) c))) ; array has a color-list
    (display (color-it-inner color ")" control) port)))

(define (color-integer cs)
  (color-it cs))

(define (color-char cs)
  (color-it cs))

(define (color-string cs)
  (color-it cs))

(define (color-list cs)
  (let* ((obj (color-scheme-obj cs)))
    (if (proper-list? obj)
        (call-with-output-string
         (lambda (port)
           (pre-print cs port)
           (display (string-join (map ->cstr obj) " ") port)
           (post-print cs port)))
        (color-pair cs))))

(define (color-pair cs)
  (let* ((obj (color-scheme-obj cs))
         (d1 (car obj))
         (d2 (cdr obj)))
    (call-with-output-string
     (lambda (port)
       (pre-print cs port)
       (colorize d1 port)
       (space port) (print-dot port) (space port)
       (colorize d2 port)
       (post-print cs port)))))

(define (color-class cs)
  (color-it cs))

(define (color-procedure cs)
  (color-it cs))

(define (color-vector cs)
  (let ((ll (vector->list (color-scheme-obj cs))))
    (call-with-output-string
     (lambda (port)
       (pre-print cs port)
       (display (string-join (map ->cstr ll) " ") port)
       (post-print cs port)))))

(define (color-keyword cs)
  (color-it cs))

;; TODO: maybe print it as char one by one?
(define (color-char-set cs)
  (color-it cs))

(define (color-symbol cs)
  (color-it cs))

(define (color-stack cs)
  (color-it cs))

(define (color-record-type cs)
  (color-it cs))

(define (color-inexact cs)
  (color-it cs))

(define (color-exact cs)
  (let* ((obj (color-scheme-obj cs))
         (colors (color-scheme-color cs))
         (num-color (car colors))
         (div-color (cadr colors))
         (control (color-scheme-control cs))
         (n (object->string (numerator obj)))
         (d (object->string (denominator obj))))
    (call-with-output-string
     (lambda (port)
       (format port "~a~a~a" 
               (color-it-inner num-color n control)
               (color-it-inner div-color "/" control)
               (color-it-inner num-color d control))))))

(define (color-regexp cs)
  (color-it cs))

(define (color-bitvector cs)
  ;; TODO: is it right?
  (color-it cs))

(define (color-boolean cs)
  (color-it cs))

(define (color-array cs)
  (let ((ll (array->list (color-scheme-obj cs))))
    (call-with-output-string
     (lambda (port)
       (pre-print cs port)
       (display (string-join (map ->cstr ll) " ") port)
       (post-print cs port)))))

(define (color-complex cs)
  (color-it cs))

(define (color-hashtable cs)
  (color-it cs))

(define (color-hook cs)
  (color-it cs))

(define (color-unknown cs)
  (color-it cs))

;;--- custom color scheme ---
(define *custom-colorized-list* (make-fluid '()))

(define (custom-colorized-set! ll)
  (fluid-set! *custom-colorized-list* ll))

(define (current-custom-colorized)
  (fluid-ref *custom-colorized-list*))

(define (add-color-scheme! cs-list)
  (let ((ll (current-custom-colorized)))
    (custom-colorized-set! `(,@cs-list ,@ll))))
;;--- custom color scheme end---

(define (is-inexact? obj)
  (and (number? obj) (inexact? obj)))

(define (is-exact? obj)
  (and (number? obj) (exact? obj)))

;; A class is a struct.
(define (class? obj)
  (struct? obj))

(define *colorize-list*
  `((,integer? INTEGER ,color-integer (BLUE BOLD))
    (,char? CHAR ,color-char (YELLOW))
    (,string? STRING ,color-string (RED))
    (,list? LIST ,color-list (BLUE BOLD))
    (,pair? PAIR ,color-list (BLACK BOLD)) ; NOTE: proper-list is a <pair>, and cons is <pair> too, so call color-list either.
    (,class? CLASS ,color-class (CYAN BOLD))
    (,procedure? PROCEDURE ,color-procedure (YELLOW BOLD))
    (,vector? VECTOR ,color-vector (MAGENTA BOLD))
    (,keyword? KEYWORD ,color-keyword (MAGENTA))
    (,char-set? CHAR-SET ,color-char-set (WHITE))
    (,symbol? SYMBOL ,color-symbol (GREEN BOLD))
    (,stack? STACK ,color-stack (MAGENTA))
    (,record-type? RECORD-TYPE ,color-record-type (BLACK BOLD))
    ;; We don't check REAL here, since it'll cover FLOAT and FRACTION, but user may customs it as they wish.
    (,is-inexact? FLOAT ,color-inexact (YELLOW))
    (,is-exact? FRACTION ,color-exact ((BLUE BOLD) (YELLOW)))
    (,regexp? REGEXP ,color-regexp (GREEN))
    (,bitvector? BITVECTOR ,color-bitvector (YELLOW BOLD))
    (,array? ARRAY ,color-array ((CYAN BOLD) (YELLOW BOLD)))
    (,boolean? BOOLEAN ,color-boolean (BLUE))
    (,complex? COMPLEX ,color-complex (MAGENTA))
    (,hash-table? HASH-TABLE ,color-hashtable (BLUE))
    (,hook? HOOK ,color-hook (GREEN))))
;; TODO: if there's anything to add

(define (obj->token-color obj)
  (let ((proc (lambda (x) (and ((car x) obj) (cdr x)))))
    (or (any proc (current-custom-colorized)) ; checkout user defined obj type
        (any proc *colorize-list*) ; checkout default obj type
        `(UNKNOWN ,color-unknown (WHITE))))) ; no suitable obj type ,return the unknown solution

;; NOTE: we don't use control now, but I write the mechanism for future usage.
(define (generate-color-scheme obj)
  (let* ((r (obj->token-color obj))
         (type (car r))
         (method (cadr r))
         (color (caddr r)))
    (make-color-scheme obj type color '(RESET) method)))

(define (generate-custom-string-color-scheme str color)
  (make-color-scheme str #f color '(RESET) color-string))

(define (colorize-string str color)
  "Example: (colorize-string \"hello\" '(BLUE BOLD))" 
  (and (not (list? color)) (error colorize-string "color should be a list!" color))
  (colorize-string-helper color str '(RESET)))

(define (colorized-display str color)
  "Example: (colorized-display \"hello\" '(BLUE BOLD))"
  (display (colorize-string str color)))

(define* (colorize-it obj #:optional (port (current-output-port)))
  (colorize obj port)
  (newline port))

(define* (colorize obj #:optional (port (current-output-port)))
  (let* ((cs (generate-color-scheme obj))
         (f (color-scheme-method cs)))
    (display (f cs) port)))

(define (->cstr obj)
  (call-with-output-string
   (lambda (port)
     (colorize obj port))))

[-- Attachment #3: colorized.test --]
[-- Type: text/plain, Size: 2277 bytes --]

;;;; colorized.test --- test (ice-9 colorized) module -*- scheme -*-
;;;; 
;;;; Copyright 2013 Free Software Foundation, Inc.
;;;; 
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

(define-module (test-suite test-ice-9-colorized)
  #:use-module (test-suite lib)
  #:use-module (oop goops)
  #:use-module (srfi srfi-9)
  #:use-module (ice-9 colorized))

;; colorized-REPL test printer
(define (color-it-test color str control) str)

;;;
;;; colorzed object test
;;;

(define-record-type aaa (make-aaa a) aaa? (a a))

(define (test-me obj info)
  (parameterize ((color-func color-it-test))
    (pass-if info 
      (equal? (call-with-output-string
               (lambda (port) (colorize obj port)))
              (object->string obj)))))

(with-test-prefix "colorized object tests"

  (test-me 123 "integer")

  (test-me #\c "char")

  (test-me "hello world\n" "string")

  (test-me '(1 2 3 4 5) "list")

  (test-me (cons 1 2) "pair")
  
  (test-me <integer> "class")

  (test-me + "procedure")

  (test-me (vector 1 2 3) "vector")

  (test-me #:test-me "keyword")

  (test-me char-set:ascii "char-set")

  (test-me 'test-me "symbol")
  
  (test-me (make-stack #t) "stack")

  (test-me aaa "record-type")

  (test-me 1.2 "inexact")

  (test-me 1/2 "exact")

  (test-me (make-regexp "[0-9]*") "regexp")

  (test-me (make-bitvector 8) "bitvector")

  (test-me #2u32@2@3((1 2) (3 4)) "array")

  (test-me #f "boolean false")
  (test-me #t "boolean true")

  (test-me 3+4i "complex")

  (test-me (make-hash-table) "hash table")

  (test-me (make-hook) "hook"))

  

[-- Attachment #4: Update-manual-for-ice-9-colorized.patch --]
[-- Type: text/x-patch, Size: 5291 bytes --]

From 4e4acbe884716b0c84f1c39bc054244112daf17d Mon Sep 17 00:00:00 2001
From: Nala Ginrut <nalaginrut@gmail.com>
Date: Tue, 22 Jan 2013 19:02:06 +0800
Subject: [PATCH] Update manual for (ice-9 colorized).

* doc/ref/misc-modules.texi: Add (ice-9 colorized).

* doc/ref/scheme-using.texi: Add colorized REPL usage.
---
 doc/ref/misc-modules.texi |   91 +++++++++++++++++++++++++++++++++++++++++++++
 doc/ref/scheme-using.texi |   35 ++++++++++++++++-
 2 files changed, 125 insertions(+), 1 deletion(-)

diff --git a/doc/ref/misc-modules.texi b/doc/ref/misc-modules.texi
index cf1e0e4..770f354 100644
--- a/doc/ref/misc-modules.texi
+++ b/doc/ref/misc-modules.texi
@@ -1789,6 +1789,97 @@ example with the Scheme @code{read} function (@pxref{Scheme Read}),
 @end deffn
 
 
+@node Colorized
+@section Colorized
+
+@cindex Colorized
+The module @code{(ice-9 colorized)} provides the procedure
+@code{activate-colorized}, which provides colored REPL output.
+
+The module is loaded and activated by entering the following:
+
+@lisp
+(use-modules (ice-9 colorized))
+(activate-colorized)
+@end lisp
+
+And you may add your own color scheme with @code{add-color-scheme!}:
+
+@lisp
+(add-color-scheme! `((,(lambda (data) 
+                         (and (number? data) (> data 10000)))
+                          MY-LONG-NUM ,color-it (RED))))
+@print{}
+Result: 10001 (in red color)
+@end lisp
+
+@deffn {Scheme Procedure} activate-colorized
+Activate colorized REPL.
+@end deffn
+
+@deffn {Scheme Procedure} add-color-scheme! color-scheme-list
+Add user defined color scheme. @code{color-scheme-list} consisted as:
+@lisp
+(list (pred scheme-name color-method color-list)
+      ;; other color scheme) 
+@end lisp
+While @code{pred} is the predicate to checkout if it's the type you need,
+@code{scheme-name} is a symbol you named this color scheme, 
+@code{color-method} is the color function, and it could be @code{color-it}
+in default, and @code{color-list} is a ansi-color specific color list.
+@end deffn
+
+@cindex Colorized String
+Also exported by the @code{(ice-9 colorized)} module is
+@code{colorize-string}, a procedure to format a string in certain color.
+
+@lisp
+(use-modules (ice-9 colorized))
+(colorize-display "hello" '(BLUE BOLD))
+@print{} hello (in blue color and bold style)
+(colorize-string "hello" '(BLUE BOLD))
+@print{} "\x1b[32;1mhello\x1b[0m"
+(display (colorize-string "hello" '(BLUE BOLD)))
+@print{} hello (in blue color and bold style)
+@end lisp
+
+@deffn {Scheme Procedure} colorize-string str color
+Return a string formated with @var{str} in @var{color} according to ansi
+color specific.  
+@end deffn
+
+@deffn {Scheme Procedure} colorize-display str color
+Print @var{str} in @var{color}.
+@end deffn
+
+Here is the available colors:
+CLEAR,
+RESET,
+BOLD,
+DARK,
+UNDERLINE, 
+UNDERSCORE,
+BLINK,     
+REVERSE,   
+CONCEALED, 
+BLACK,
+RED,       
+GREEN,     
+YELLOW,    
+BLUE,      
+MAGENTA,   
+CYAN,      
+WHITE,     
+ON-BLACK,  
+ON-RED,    
+ON-GREEN,  
+ON-YELLOW, 
+ON-BLUE,   
+ON-MAGENTA,
+ON-CYAN, 
+ON-WHITE
+
+
 @c Local Variables:
 @c TeX-master: "guile.texi"
 @c End:
diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index e0f91af..fe302c2 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -37,6 +37,7 @@ support for languages other than Scheme.
 @menu
 * Init File::
 * Readline::                    
+* Colorized REPL::
 * Value History::              
 * REPL Commands::               
 * Error Handling::              
@@ -79,6 +80,37 @@ It's a good idea to put these two lines (without the
 @xref{Init File}, for more on @file{.guile}.
 
 
+@node Colorized REPL
+@subsection Colorized REPL
+
+To make colorized result in Guile REPL, or add your own color
+schemes to show the result in colors.
+
+@lisp
+scheme@@(guile-user)> (use-modules (ice-9 colorized))
+scheme@@(guile-user)> (activate-colorized)
+@end lisp
+
+It's a good idea to put these two lines (without the
+@code{scheme@@(guile-user)>} prompts) in your @file{.guile} file.
+Besides, you may add your color schemes for the result:
+@lisp
+(add-color-scheme! (list (pred scheme-name color-method color-list)))
+example:
+(add-color-scheme! `((,(lambda (data) 
+                         (and (number? data) (> data 10000)))
+                          MY-LONG-NUM ,color-it (RED))))
+10001
+@print{} 10001 (in red color)
+@end lisp
+While @code{pred} is the predicate to checkout if it's the type you need,
+@code{scheme-name} is a symbol you named this color scheme, 
+@code{color-method} is the color function, and it could be @code{color-it}
+in default, and @code{color-list} is a ansi-color specific color list, 
+please see @xref{Colorized}.
+@xref{Init File}, for more on @file{.guile}.
+
+
 @node Value History
 @subsection Value History
 
@@ -147,7 +179,8 @@ data structure or closure, they may then be reclaimed by the garbage collector.
 
 @cindex commands
 The REPL exists to read expressions, evaluate them, and then print their
-results. But sometimes one wants to tell the REPL to evaluate an
+results. But sometimes o
+ne wants to tell the REPL to evaluate an
 expression in a different way, or to do something else altogether. A
 user can affect the way the REPL works with a @dfn{REPL command}.
 
-- 
1.7.10.4

Re: [PATCH] Colorized REPL

[David Pirotte]

Hello,

> But I have some trouble with the regexp in Guile, seems "\\d+" can't
> work, others, like "\\w+" works.

i also had this 'problem' and someone suggested to rather use [[:digit:]]+
and friends - [:blank:] [:alpha:] ...

Cheers,
David

Re: [PATCH] Colorized REPL

[Nala Ginrut]

[-- Attachment #1: Type: text/plain, Size: 432 bytes --]

Thanks David!
It's nice to know that,  I thought Guile use PCRE, but I realized it's
posix RE.


On Mon, Jan 28, 2013 at 9:58 PM, David Pirotte <david@altosw.be> wrote:

> Hello,
>
> > But I have some trouble with the regexp in Guile, seems "\\d+" can't
> > work, others, like "\\w+" works.
>
> i also had this 'problem' and someone suggested to rather use [[:digit:]]+
> and friends - [:blank:] [:alpha:] ...
>
> Cheers,
> David
>

[-- Attachment #2: Type: text/html, Size: 837 bytes --]

Re: [PATCH] Colorized REPL

[Nala Ginrut]

[-- Attachment #1.1: Type: text/plain, Size: 560 bytes --]

patch updated.
Thanks!


On Mon, Jan 28, 2013 at 10:56 PM, Nala Ginrut <nalaginrut@gmail.com> wrote:

> Thanks David!
> It's nice to know that,  I thought Guile use PCRE, but I realized it's
> posix RE.
>
>
> On Mon, Jan 28, 2013 at 9:58 PM, David Pirotte <david@altosw.be> wrote:
>
>> Hello,
>>
>> > But I have some trouble with the regexp in Guile, seems "\\d+" can't
>> > work, others, like "\\w+" works.
>>
>> i also had this 'problem' and someone suggested to rather use [[:digit:]]+
>> and friends - [:blank:] [:alpha:] ...
>>
>> Cheers,
>> David
>>
>
>

[-- Attachment #1.2: Type: text/html, Size: 1290 bytes --]

[-- Attachment #2: 0001-Add-colorized-REPL.patch --]
[-- Type: application/octet-stream, Size: 20342 bytes --]

From 9810ca4c55a9b1775237f3a0e4e68d64dc6e5054 Mon Sep 17 00:00:00 2001
From: Nala Ginrut <nalaginrut@gmail.com>
Date: Thu, 31 Jan 2013 22:17:25 +0800
Subject: [PATCH] Add colorized-REPL

* doc/ref/misc-modules.texi
* doc/ref/scheme-using.texi: add docs for colorized-REPL

* module/ice-9/colorized.scm: add colorized-REPL module.

* test-suite/tests/colorized.test: add colorized-REPL test case.
---
 doc/ref/misc-modules.texi       |   68 ++++++++
 doc/ref/scheme-using.texi       |   38 ++++-
 module/ice-9/colorized.scm      |  355 +++++++++++++++++++++++++++++++++++++++
 test-suite/tests/colorized.test |   88 ++++++++++
 4 files changed, 546 insertions(+), 3 deletions(-)
 create mode 100644 module/ice-9/colorized.scm
 create mode 100644 test-suite/tests/colorized.test

diff --git a/doc/ref/misc-modules.texi b/doc/ref/misc-modules.texi
index cf1e0e4..e2ca6f9 100644
--- a/doc/ref/misc-modules.texi
+++ b/doc/ref/misc-modules.texi
@@ -1788,6 +1788,74 @@ example with the Scheme @code{read} function (@pxref{Scheme Read}),
 @end example
 @end deffn
 
+@node Colorized
+@section Colorized
+
+@cindex Colorized
+The module @code{(ice-9 colorized)} provides the procedure
+@code{activate-colorized}, which provides colored REPL output.
+
+The module is loaded and activated by entering the following:
+
+@lisp
+(use-modules (ice-9 colorized))
+(activate-colorized)
+@end lisp
+
+And you may add your own color scheme with @code{add-color-scheme!}:
+
+@lisp
+(add-color-scheme! `((,(lambda (data) 
+                         (and (number? data) (> data 10000)))
+                          MY-LONG-NUM ,color-it (RED))))
+@print{}
+Result: 10001 (in red color)
+@end lisp
+
+@deffn {Scheme Procedure} activate-colorized
+Activate colorized REPL.
+@end deffn
+
+@deffn {Scheme Procedure} add-color-scheme! color-scheme-list
+Add user defined color scheme. @code{color-scheme-list} consisted as:
+@lisp
+(list (pred scheme-name color-method color-list)
+      ;; other color scheme) 
+@end lisp
+While @code{pred} is the predicate to checkout if it's the type you need,
+@code{scheme-name} is a symbol you named this color scheme, 
+@code{color-method} is the color function, and it could be @code{color-it}
+in default, and @code{color-list} is a ansi-color specific color list.
+@end deffn
+
+@cindex Colorized String
+Also exported by the @code{(ice-9 colorized)} module is
+@code{colorize-string}, a procedure to format a string in certain color.
+Note: This feature works under most mainstream console whose respect ansi-color,
+but causes messes under some console.
+
+@lisp
+(use-modules (ice-9 colorized))
+(colorize-display "hello" '(BLUE BOLD))
+@print{} hello (in blue color and bold style)
+(colorize-string "hello" '(BLUE BOLD))
+@print{} "\x1b[32;1mhello\x1b[0m"
+(display (colorize-string "hello" '(BLUE BOLD)))
+@print{} hello (in blue color and bold style)
+@end lisp
+
+@deffn {Scheme Procedure} colorize-string str color
+Return a string formated with @var{str} in @var{color} according to ansi
+color specific.  
+@end deffn
+
+@deffn {Scheme Procedure} colorize-display str color
+Print @var{str} in @var{color}.
+@end deffn
+
+@deffn {Scheme Procedure} show-all-colors
+Print all available colors.
+@end deffn
 
 @c Local Variables:
 @c TeX-master: "guile.texi"
diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index e0f91af..7a77c92 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -37,6 +37,7 @@ support for languages other than Scheme.
 @menu
 * Init File::
 * Readline::                    
+* Colorized REPL::
 * Value History::              
 * REPL Commands::               
 * Error Handling::              
@@ -79,6 +80,37 @@ It's a good idea to put these two lines (without the
 @xref{Init File}, for more on @file{.guile}.
 
 
+@node Colorized REPL
+@subsection Colorized REPL
+
+To make colorized result in Guile REPL, or add your own color
+schemes to show the result in colors.
+
+@lisp
+scheme@@(guile-user)> (use-modules (ice-9 colorized))
+scheme@@(guile-user)> (activate-colorized)
+@end lisp
+
+It's a good idea to put these two lines (without the
+@code{scheme@@(guile-user)>} prompts) in your @file{.guile} file.
+Besides, you may add your color schemes for the result:
+@lisp
+(add-color-scheme! (list (pred scheme-name color-method color-list)))
+example:
+(add-color-scheme! `((,(lambda (data) 
+                         (and (number? data) (> data 10000)))
+                          MY-LONG-NUM ,color-it (RED))))
+10001
+@print{} 10001 (in red color)
+@end lisp
+While @code{pred} is the predicate to checkout if it's the type you need,
+@code{scheme-name} is a symbol you named this color scheme, 
+@code{color-method} is the color function, and it could be @code{color-it}
+in default, and @code{color-list} is a ansi-color specific color list, 
+please see @xref{Colorized}.
+@xref{Init File}, for more on @file{.guile}.
+
+
 @node Value History
 @subsection Value History
 
@@ -147,9 +179,9 @@ data structure or closure, they may then be reclaimed by the garbage collector.
 
 @cindex commands
 The REPL exists to read expressions, evaluate them, and then print their
-results. But sometimes one wants to tell the REPL to evaluate an
-expression in a different way, or to do something else altogether. A
-user can affect the way the REPL works with a @dfn{REPL command}.
+results. But sometimes one wants to tell the REPL to evaluate an expression
+in a different way, or to do something else altogether. A user can affect
+the way the REPL works with a @dfn{REPL command}.
 
 The previous section had an example of a command, in the form of
 @code{,option}.
diff --git a/module/ice-9/colorized.scm b/module/ice-9/colorized.scm
new file mode 100644
index 0000000..2892f4b
--- /dev/null
+++ b/module/ice-9/colorized.scm
@@ -0,0 +1,355 @@
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;;; Author: Mu Lei known as NalaGinrut <nalaginrut@gmail.com>
+
+(define-module (ice-9 colorized)
+  #:use-module (ice-9 rdelim)
+  #:use-module ((srfi srfi-1) #:select (filter-map any proper-list?))
+  #:use-module (srfi srfi-9)
+  #:use-module (system repl common)
+  #:export (activate-colorized custom-colorized-set! color-it colorize-it colorize
+            color-func colorize-string colorized-display add-color-scheme!
+            show-all-colors))
+
+(define (colorized-repl-printer repl val)
+  (colorize-it val))
+
+(define (activate-colorized)
+  (let ((rs (fluid-ref *repl-stack*)))
+    (if (null? rs)
+	(repl-default-option-set! 'print colorized-repl-printer) ; if no REPL started, set as default printer
+	(repl-option-set! (car rs) 'print colorized-repl-printer)))) ; or set as the top-REPL printer
+
+;; color-scheme context, contains some info to be used
+(define-record-type color-scheme
+  (make-color-scheme obj type color control method)
+  color-scheme?
+  (obj color-scheme-obj) ; the obj to be colored
+  (type color-scheme-type) ; the obj type (for debug/test)
+  (color color-scheme-color) ; the color
+  (control color-scheme-control) ; ansi control code
+  (method color-scheme-method)) ; colorized method for the obj type
+
+(define *color-list*
+  `((CLEAR       .   "0")
+    (RESET       .   "0")
+    (BOLD        .   "1")
+    (DARK        .   "2")
+    (UNDERLINE   .   "4")
+    (UNDERSCORE  .   "4")
+    (BLINK       .   "5")
+    (REVERSE     .   "6")
+    (CONCEALED   .   "8")
+    (BLACK       .  "30")
+    (RED         .  "31")
+    (GREEN       .  "32")
+    (YELLOW      .  "33")
+    (BLUE        .  "34")
+    (MAGENTA     .  "35")
+    (CYAN        .  "36")
+    (WHITE       .  "37")
+    (ON-BLACK    .  "40")
+    (ON-RED      .  "41")
+    (ON-GREEN    .  "42")
+    (ON-YELLOW   .  "43")
+    (ON-BLUE     .  "44")
+    (ON-MAGENTA  .  "45")
+    (ON-CYAN     .  "46")
+    (ON-WHITE    .  "47")))
+
+(define (show-all-colors)
+  (for-each (lambda (c)
+              (format #t "~a~%" (car c)))
+            *color-list*))
+
+(define (get-color color)
+  (assq-ref *color-list* color))
+
+(define (generate-color colors)
+  (let ((color-list
+         (filter-map get-color colors)))
+    (if (null? color-list)
+        ""
+        (string-append "\x1b[" (string-join color-list ";" 'infix) "m"))))
+
+(define (colorize-string-helper color str control)
+  (string-append (generate-color color) str (generate-color control)))
+
+;; test-helper functions
+;; when eanbled, it won't output colored result, but just normal.
+;; it used to test the array/list/vector print result.
+(define color-func (make-parameter colorize-string-helper))
+
+(define (color-it cs) 
+  (let* ((obj (color-scheme-obj cs))
+         (str (object->string obj))
+         (color (color-scheme-color cs))
+         (control (color-scheme-control cs)))
+    (color-it-inner color str control)))
+
+(define (color-it-inner color str control)
+  ((color-func) color str control))
+
+(define* (space #:optional (port (current-output-port)))
+  (display #\sp port))
+
+(define *pre-sign* 
+  `((LIST       .   "(") 
+    (PAIR       .   "(") 
+    (VECTOR     .   "#(")
+    (ARRAY      .   #f))) 
+;; array's sign is complicated, return #f so it will be handled by pre-print
+
+(define* (pre-print cs #:optional (port (current-output-port)))
+  (let* ((type (color-scheme-type cs))
+         (control (color-scheme-control cs))
+         (sign (assq-ref *pre-sign* type))
+         (color (color-scheme-color cs))) 
+    (if sign
+        (display (color-it-inner color sign control) port)  ; not array
+        ;; array complecated coloring
+        (display (color-array-inner cs) port))))
+
+(define (print-dot port)
+  (let ((light-cyan '(CYAN BOLD)))
+    (display (color-it-inner light-cyan "." '(RESET)) port)))
+
+(define (delimiter? ch)
+  (char-set-contains? char-set:punctuation ch))
+
+(define (color-array-inner cs)
+  (let* ((colors (color-scheme-color cs))
+         (control (color-scheme-control cs))
+         (sign-color (car colors))
+         (attr-color (cadr colors))
+         (str (object->string (color-scheme-obj cs)))
+         (attrs (string->list 
+                 (call-with-input-string str (lambda (p) (read-delimited "(" p))))))
+    (call-with-output-string
+     (lambda (port)
+       (for-each (lambda (ch)
+                   (let ((color (if (delimiter? ch) sign-color attr-color)))
+                     (display (color-it-inner color (string ch) control) port)))
+                 attrs)
+       ;; output left-paren
+       (display (color-it-inner sign-color "(" control) port)))))
+
+;; Write a closing parenthesis.
+(define* (post-print cs #:optional (port (current-output-port)))
+  (let* ((c (color-scheme-color cs))
+         (control (color-scheme-control cs))
+         (color (if (list? (car c)) (car c) c))) ; array has a color-list
+    (display (color-it-inner color ")" control) port)))
+
+(define (color-integer cs)
+  (color-it cs))
+
+(define (color-char cs)
+  (color-it cs))
+
+(define (color-string cs)
+  (color-it cs))
+
+(define (color-list cs)
+  (let* ((obj (color-scheme-obj cs)))
+    (if (proper-list? obj)
+        (call-with-output-string
+         (lambda (port)
+           (pre-print cs port)
+           (display (string-join (map ->cstr obj) " ") port)
+           (post-print cs port)))
+        (color-pair cs))))
+
+(define (color-pair cs)
+  (let* ((obj (color-scheme-obj cs))
+         (d1 (car obj))
+         (d2 (cdr obj)))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (colorize d1 port)
+       (space port) (print-dot port) (space port)
+       (colorize d2 port)
+       (post-print cs port)))))
+
+(define (color-class cs)
+  (color-it cs))
+
+(define (color-procedure cs)
+  (color-it cs))
+
+(define (color-vector cs)
+  (let ((ll (vector->list (color-scheme-obj cs))))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (display (string-join (map ->cstr ll) " ") port)
+       (post-print cs port)))))
+
+(define (color-keyword cs)
+  (color-it cs))
+
+;; TODO: maybe print it as char one by one?
+(define (color-char-set cs)
+  (color-it cs))
+
+(define (color-symbol cs)
+  (color-it cs))
+
+(define (color-stack cs)
+  (color-it cs))
+
+(define (color-record-type cs)
+  (color-it cs))
+
+(define (color-inexact cs)
+  (color-it cs))
+
+(define (color-exact cs)
+  (let* ((obj (color-scheme-obj cs))
+         (colors (color-scheme-color cs))
+         (num-color (car colors))
+         (div-color (cadr colors))
+         (control (color-scheme-control cs))
+         (n (object->string (numerator obj)))
+         (d (object->string (denominator obj))))
+    (call-with-output-string
+     (lambda (port)
+       (format port "~a~a~a" 
+               (color-it-inner num-color n control)
+               (color-it-inner div-color "/" control)
+               (color-it-inner num-color d control))))))
+
+(define (color-regexp cs)
+  (color-it cs))
+
+(define (color-bitvector cs)
+  ;; TODO: is it right?
+  (color-it cs))
+
+(define (color-boolean cs)
+  (color-it cs))
+
+(define (color-array cs)
+  (let ((ll (array->list (color-scheme-obj cs))))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (display (string-join (map ->cstr ll) " ") port)
+       (post-print cs port)))))
+
+(define (color-complex cs)
+  (color-it cs))
+
+(define (color-hashtable cs)
+  (color-it cs))
+
+(define (color-hook cs)
+  (color-it cs))
+
+(define (color-unknown cs)
+  (color-it cs))
+
+;;--- custom color scheme ---
+(define *custom-colorized-list* (make-fluid '()))
+
+(define (custom-colorized-set! ll)
+  (fluid-set! *custom-colorized-list* ll))
+
+(define (current-custom-colorized)
+  (fluid-ref *custom-colorized-list*))
+
+(define (add-color-scheme! cs-list)
+  (let ((ll (current-custom-colorized)))
+    (custom-colorized-set! `(,@cs-list ,@ll))))
+;;--- custom color scheme end---
+
+(define (is-inexact? obj)
+  (and (number? obj) (inexact? obj)))
+
+(define (is-exact? obj)
+  (and (number? obj) (exact? obj)))
+
+;; A class is a struct.
+(define (class? obj)
+  (struct? obj))
+
+(define *colorize-list*
+  `((,integer? INTEGER ,color-integer (BLUE BOLD))
+    (,char? CHAR ,color-char (YELLOW))
+    (,string? STRING ,color-string (RED))
+    (,list? LIST ,color-list (BLUE BOLD))
+    (,pair? PAIR ,color-list (BLACK BOLD)) ; NOTE: proper-list is a <pair>, and cons is <pair> too, so call color-list either.
+    (,class? CLASS ,color-class (CYAN BOLD))
+    (,procedure? PROCEDURE ,color-procedure (YELLOW BOLD))
+    (,vector? VECTOR ,color-vector (MAGENTA BOLD))
+    (,keyword? KEYWORD ,color-keyword (MAGENTA))
+    (,char-set? CHAR-SET ,color-char-set (WHITE))
+    (,symbol? SYMBOL ,color-symbol (GREEN BOLD))
+    (,stack? STACK ,color-stack (MAGENTA))
+    (,record-type? RECORD-TYPE ,color-record-type (BLACK BOLD))
+    ;; We don't check REAL here, since it'll cover FLOAT and FRACTION, but user may customs it as they wish.
+    (,is-inexact? FLOAT ,color-inexact (YELLOW))
+    (,is-exact? FRACTION ,color-exact ((BLUE BOLD) (YELLOW)))
+    (,regexp? REGEXP ,color-regexp (GREEN))
+    (,bitvector? BITVECTOR ,color-bitvector (YELLOW BOLD))
+    (,array? ARRAY ,color-array ((CYAN BOLD) (YELLOW BOLD)))
+    (,boolean? BOOLEAN ,color-boolean (BLUE))
+    (,complex? COMPLEX ,color-complex (MAGENTA))
+    (,hash-table? HASH-TABLE ,color-hashtable (BLUE))
+    (,hook? HOOK ,color-hook (GREEN))))
+;; TODO: if there's anything to add
+
+(define (obj->token-color obj)
+  (let ((proc (lambda (x) (and ((car x) obj) (cdr x)))))
+    (or (any proc (current-custom-colorized)) ; checkout user defined obj type
+        (any proc *colorize-list*) ; checkout default obj type
+        `(UNKNOWN ,color-unknown (WHITE))))) ; no suitable obj type ,return the unknown solution
+
+;; NOTE: we don't use control now, but I write the mechanism for future usage.
+(define (generate-color-scheme obj)
+  (let* ((r (obj->token-color obj))
+         (type (car r))
+         (method (cadr r))
+         (color (caddr r)))
+    (make-color-scheme obj type color '(RESET) method)))
+
+(define (generate-custom-string-color-scheme str color)
+  (make-color-scheme str #f color '(RESET) color-string))
+
+(define (colorize-string str color)
+  "Example: (colorize-string \"hello\" '(BLUE BOLD))" 
+  (and (not (list? color)) (error colorize-string "color should be a list!" color))
+  (colorize-string-helper color str '(RESET)))
+
+(define (colorized-display str color)
+  "Example: (colorized-display \"hello\" '(BLUE BOLD))"
+  (display (colorize-string str color)))
+
+(define* (colorize-it obj #:optional (port (current-output-port)))
+  (colorize obj port)
+  (newline port))
+
+(define* (colorize obj #:optional (port (current-output-port)))
+  (let* ((cs (generate-color-scheme obj))
+         (f (color-scheme-method cs)))
+    (display (f cs) port)))
+
+(define (->cstr obj)
+  (call-with-output-string
+   (lambda (port)
+     (colorize obj port))))
diff --git a/test-suite/tests/colorized.test b/test-suite/tests/colorized.test
new file mode 100644
index 0000000..a8baadb
--- /dev/null
+++ b/test-suite/tests/colorized.test
@@ -0,0 +1,88 @@
+;;;; colorized.test --- test (ice-9 colorized) module -*- scheme -*-
+;;;; 
+;;;; Copyright 2013 Free Software Foundation, Inc.
+;;;; 
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-suite test-ice-9-colorized)
+  #:use-module (test-suite lib)
+  #:use-module (oop goops)
+  #:use-module (srfi srfi-9)
+  #:use-module (ice-9 colorized))
+
+;; colorized-REPL test printer
+(define (color-it-test color str control) str)
+
+;;;
+;;; colorzed object test
+;;;
+
+(define-record-type aaa (make-aaa a) aaa? (a a))
+
+(define (test-me obj info)
+  (parameterize ((color-func color-it-test))
+    (pass-if info 
+      (equal? (call-with-output-string
+               (lambda (port) (colorize obj port)))
+              (object->string obj)))))
+
+(with-test-prefix "colorized object tests"
+
+  (test-me 123 "integer")
+
+  (test-me #\c "char")
+
+  (test-me "hello world\n" "string")
+
+  (test-me '(1 2 3 4 5) "list")
+
+  (test-me (cons 1 2) "pair")
+  
+  (test-me <integer> "class")
+
+  (test-me + "procedure")
+
+  (test-me (vector 1 2 3) "vector")
+
+  (test-me #:test-me "keyword")
+
+  (test-me char-set:ascii "char-set")
+
+  (test-me 'test-me "symbol")
+  
+  (test-me (make-stack #t) "stack")
+
+  (test-me aaa "record-type")
+
+  (test-me 1.2 "inexact")
+
+  (test-me 1/2 "exact")
+
+  (test-me (make-regexp "[0-9]*") "regexp")
+
+  (test-me (make-bitvector 8) "bitvector")
+
+  (test-me #2u32@2@3((1 2) (3 4)) "array")
+
+  (test-me #f "boolean false")
+  (test-me #t "boolean true")
+
+  (test-me 3+4i "complex")
+
+  (test-me (make-hash-table) "hash table")
+
+  (test-me (make-hook) "hook"))
+
+  
-- 
1.7.0.4

Re: [PATCH] Colorized REPL

[Nala Ginrut]

[-- Attachment #1.1: Type: text/plain, Size: 732 bytes --]

Sorry, forget to add it into ice-9/Makefile.am
Send again.


On Thu, Jan 31, 2013 at 10:25 PM, Nala Ginrut <nalaginrut@gmail.com> wrote:

> patch updated.
> Thanks!
>
>
> On Mon, Jan 28, 2013 at 10:56 PM, Nala Ginrut <nalaginrut@gmail.com>wrote:
>
>> Thanks David!
>> It's nice to know that,  I thought Guile use PCRE, but I realized it's
>> posix RE.
>>
>>
>> On Mon, Jan 28, 2013 at 9:58 PM, David Pirotte <david@altosw.be> wrote:
>>
>>> Hello,
>>>
>>> > But I have some trouble with the regexp in Guile, seems "\\d+" can't
>>> > work, others, like "\\w+" works.
>>>
>>> i also had this 'problem' and someone suggested to rather use
>>> [[:digit:]]+
>>> and friends - [:blank:] [:alpha:] ...
>>>
>>> Cheers,
>>> David
>>>
>>
>>
>

[-- Attachment #1.2: Type: text/html, Size: 1766 bytes --]

[-- Attachment #2: 0001-Add-colorized-REPL.patch --]
[-- Type: application/octet-stream, Size: 20738 bytes --]

From e6c604679e3928bb1b179072a83b72bc65b7d96f Mon Sep 17 00:00:00 2001
From: NalaGinrut <nalaginrut@gmail.com>
Date: Thu, 31 Jan 2013 22:17:25 +0800
Subject: [PATCH] Add colorized-REPL

* doc/ref/misc-modules.texi
* doc/ref/scheme-using.texi: add docs for colorized-REPL

* module/ice-9/colorized.scm: add colorized-REPL module.

* test-suite/tests/colorized.test: add colorized-REPL test case.

* module/Makefile.am: add ice-9/colorized.scm
---
 doc/ref/misc-modules.texi       |   68 ++++++++
 doc/ref/scheme-using.texi       |   38 ++++-
 module/Makefile.am              |    1 +
 module/ice-9/colorized.scm      |  355 +++++++++++++++++++++++++++++++++++++++
 test-suite/tests/colorized.test |   88 ++++++++++
 5 files changed, 547 insertions(+), 3 deletions(-)
 create mode 100644 module/ice-9/colorized.scm
 create mode 100644 test-suite/tests/colorized.test

diff --git a/doc/ref/misc-modules.texi b/doc/ref/misc-modules.texi
index cf1e0e4..e2ca6f9 100644
--- a/doc/ref/misc-modules.texi
+++ b/doc/ref/misc-modules.texi
@@ -1788,6 +1788,74 @@ example with the Scheme @code{read} function (@pxref{Scheme Read}),
 @end example
 @end deffn
 
+@node Colorized
+@section Colorized
+
+@cindex Colorized
+The module @code{(ice-9 colorized)} provides the procedure
+@code{activate-colorized}, which provides colored REPL output.
+
+The module is loaded and activated by entering the following:
+
+@lisp
+(use-modules (ice-9 colorized))
+(activate-colorized)
+@end lisp
+
+And you may add your own color scheme with @code{add-color-scheme!}:
+
+@lisp
+(add-color-scheme! `((,(lambda (data) 
+                         (and (number? data) (> data 10000)))
+                          MY-LONG-NUM ,color-it (RED))))
+@print{}
+Result: 10001 (in red color)
+@end lisp
+
+@deffn {Scheme Procedure} activate-colorized
+Activate colorized REPL.
+@end deffn
+
+@deffn {Scheme Procedure} add-color-scheme! color-scheme-list
+Add user defined color scheme. @code{color-scheme-list} consisted as:
+@lisp
+(list (pred scheme-name color-method color-list)
+      ;; other color scheme) 
+@end lisp
+While @code{pred} is the predicate to checkout if it's the type you need,
+@code{scheme-name} is a symbol you named this color scheme, 
+@code{color-method} is the color function, and it could be @code{color-it}
+in default, and @code{color-list} is a ansi-color specific color list.
+@end deffn
+
+@cindex Colorized String
+Also exported by the @code{(ice-9 colorized)} module is
+@code{colorize-string}, a procedure to format a string in certain color.
+Note: This feature works under most mainstream console whose respect ansi-color,
+but causes messes under some console.
+
+@lisp
+(use-modules (ice-9 colorized))
+(colorize-display "hello" '(BLUE BOLD))
+@print{} hello (in blue color and bold style)
+(colorize-string "hello" '(BLUE BOLD))
+@print{} "\x1b[32;1mhello\x1b[0m"
+(display (colorize-string "hello" '(BLUE BOLD)))
+@print{} hello (in blue color and bold style)
+@end lisp
+
+@deffn {Scheme Procedure} colorize-string str color
+Return a string formated with @var{str} in @var{color} according to ansi
+color specific.  
+@end deffn
+
+@deffn {Scheme Procedure} colorize-display str color
+Print @var{str} in @var{color}.
+@end deffn
+
+@deffn {Scheme Procedure} show-all-colors
+Print all available colors.
+@end deffn
 
 @c Local Variables:
 @c TeX-master: "guile.texi"
diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index e0f91af..7a77c92 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -37,6 +37,7 @@ support for languages other than Scheme.
 @menu
 * Init File::
 * Readline::                    
+* Colorized REPL::
 * Value History::              
 * REPL Commands::               
 * Error Handling::              
@@ -79,6 +80,37 @@ It's a good idea to put these two lines (without the
 @xref{Init File}, for more on @file{.guile}.
 
 
+@node Colorized REPL
+@subsection Colorized REPL
+
+To make colorized result in Guile REPL, or add your own color
+schemes to show the result in colors.
+
+@lisp
+scheme@@(guile-user)> (use-modules (ice-9 colorized))
+scheme@@(guile-user)> (activate-colorized)
+@end lisp
+
+It's a good idea to put these two lines (without the
+@code{scheme@@(guile-user)>} prompts) in your @file{.guile} file.
+Besides, you may add your color schemes for the result:
+@lisp
+(add-color-scheme! (list (pred scheme-name color-method color-list)))
+example:
+(add-color-scheme! `((,(lambda (data) 
+                         (and (number? data) (> data 10000)))
+                          MY-LONG-NUM ,color-it (RED))))
+10001
+@print{} 10001 (in red color)
+@end lisp
+While @code{pred} is the predicate to checkout if it's the type you need,
+@code{scheme-name} is a symbol you named this color scheme, 
+@code{color-method} is the color function, and it could be @code{color-it}
+in default, and @code{color-list} is a ansi-color specific color list, 
+please see @xref{Colorized}.
+@xref{Init File}, for more on @file{.guile}.
+
+
 @node Value History
 @subsection Value History
 
@@ -147,9 +179,9 @@ data structure or closure, they may then be reclaimed by the garbage collector.
 
 @cindex commands
 The REPL exists to read expressions, evaluate them, and then print their
-results. But sometimes one wants to tell the REPL to evaluate an
-expression in a different way, or to do something else altogether. A
-user can affect the way the REPL works with a @dfn{REPL command}.
+results. But sometimes one wants to tell the REPL to evaluate an expression
+in a different way, or to do something else altogether. A user can affect
+the way the REPL works with a @dfn{REPL command}.
 
 The previous section had an example of a command, in the form of
 @code{,option}.
diff --git a/module/Makefile.am b/module/Makefile.am
index 472bc48..2eec0e5 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -250,6 +250,7 @@ ICE_9_SOURCES = \
   ice-9/weak-vector.scm \
   ice-9/list.scm \
   ice-9/serialize.scm \
+  ice-9/colorized.scm \
   ice-9/local-eval.scm
 
 if HAVE_FORK
diff --git a/module/ice-9/colorized.scm b/module/ice-9/colorized.scm
new file mode 100644
index 0000000..2892f4b
--- /dev/null
+++ b/module/ice-9/colorized.scm
@@ -0,0 +1,355 @@
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;;; Author: Mu Lei known as NalaGinrut <nalaginrut@gmail.com>
+
+(define-module (ice-9 colorized)
+  #:use-module (ice-9 rdelim)
+  #:use-module ((srfi srfi-1) #:select (filter-map any proper-list?))
+  #:use-module (srfi srfi-9)
+  #:use-module (system repl common)
+  #:export (activate-colorized custom-colorized-set! color-it colorize-it colorize
+            color-func colorize-string colorized-display add-color-scheme!
+            show-all-colors))
+
+(define (colorized-repl-printer repl val)
+  (colorize-it val))
+
+(define (activate-colorized)
+  (let ((rs (fluid-ref *repl-stack*)))
+    (if (null? rs)
+	(repl-default-option-set! 'print colorized-repl-printer) ; if no REPL started, set as default printer
+	(repl-option-set! (car rs) 'print colorized-repl-printer)))) ; or set as the top-REPL printer
+
+;; color-scheme context, contains some info to be used
+(define-record-type color-scheme
+  (make-color-scheme obj type color control method)
+  color-scheme?
+  (obj color-scheme-obj) ; the obj to be colored
+  (type color-scheme-type) ; the obj type (for debug/test)
+  (color color-scheme-color) ; the color
+  (control color-scheme-control) ; ansi control code
+  (method color-scheme-method)) ; colorized method for the obj type
+
+(define *color-list*
+  `((CLEAR       .   "0")
+    (RESET       .   "0")
+    (BOLD        .   "1")
+    (DARK        .   "2")
+    (UNDERLINE   .   "4")
+    (UNDERSCORE  .   "4")
+    (BLINK       .   "5")
+    (REVERSE     .   "6")
+    (CONCEALED   .   "8")
+    (BLACK       .  "30")
+    (RED         .  "31")
+    (GREEN       .  "32")
+    (YELLOW      .  "33")
+    (BLUE        .  "34")
+    (MAGENTA     .  "35")
+    (CYAN        .  "36")
+    (WHITE       .  "37")
+    (ON-BLACK    .  "40")
+    (ON-RED      .  "41")
+    (ON-GREEN    .  "42")
+    (ON-YELLOW   .  "43")
+    (ON-BLUE     .  "44")
+    (ON-MAGENTA  .  "45")
+    (ON-CYAN     .  "46")
+    (ON-WHITE    .  "47")))
+
+(define (show-all-colors)
+  (for-each (lambda (c)
+              (format #t "~a~%" (car c)))
+            *color-list*))
+
+(define (get-color color)
+  (assq-ref *color-list* color))
+
+(define (generate-color colors)
+  (let ((color-list
+         (filter-map get-color colors)))
+    (if (null? color-list)
+        ""
+        (string-append "\x1b[" (string-join color-list ";" 'infix) "m"))))
+
+(define (colorize-string-helper color str control)
+  (string-append (generate-color color) str (generate-color control)))
+
+;; test-helper functions
+;; when eanbled, it won't output colored result, but just normal.
+;; it used to test the array/list/vector print result.
+(define color-func (make-parameter colorize-string-helper))
+
+(define (color-it cs) 
+  (let* ((obj (color-scheme-obj cs))
+         (str (object->string obj))
+         (color (color-scheme-color cs))
+         (control (color-scheme-control cs)))
+    (color-it-inner color str control)))
+
+(define (color-it-inner color str control)
+  ((color-func) color str control))
+
+(define* (space #:optional (port (current-output-port)))
+  (display #\sp port))
+
+(define *pre-sign* 
+  `((LIST       .   "(") 
+    (PAIR       .   "(") 
+    (VECTOR     .   "#(")
+    (ARRAY      .   #f))) 
+;; array's sign is complicated, return #f so it will be handled by pre-print
+
+(define* (pre-print cs #:optional (port (current-output-port)))
+  (let* ((type (color-scheme-type cs))
+         (control (color-scheme-control cs))
+         (sign (assq-ref *pre-sign* type))
+         (color (color-scheme-color cs))) 
+    (if sign
+        (display (color-it-inner color sign control) port)  ; not array
+        ;; array complecated coloring
+        (display (color-array-inner cs) port))))
+
+(define (print-dot port)
+  (let ((light-cyan '(CYAN BOLD)))
+    (display (color-it-inner light-cyan "." '(RESET)) port)))
+
+(define (delimiter? ch)
+  (char-set-contains? char-set:punctuation ch))
+
+(define (color-array-inner cs)
+  (let* ((colors (color-scheme-color cs))
+         (control (color-scheme-control cs))
+         (sign-color (car colors))
+         (attr-color (cadr colors))
+         (str (object->string (color-scheme-obj cs)))
+         (attrs (string->list 
+                 (call-with-input-string str (lambda (p) (read-delimited "(" p))))))
+    (call-with-output-string
+     (lambda (port)
+       (for-each (lambda (ch)
+                   (let ((color (if (delimiter? ch) sign-color attr-color)))
+                     (display (color-it-inner color (string ch) control) port)))
+                 attrs)
+       ;; output left-paren
+       (display (color-it-inner sign-color "(" control) port)))))
+
+;; Write a closing parenthesis.
+(define* (post-print cs #:optional (port (current-output-port)))
+  (let* ((c (color-scheme-color cs))
+         (control (color-scheme-control cs))
+         (color (if (list? (car c)) (car c) c))) ; array has a color-list
+    (display (color-it-inner color ")" control) port)))
+
+(define (color-integer cs)
+  (color-it cs))
+
+(define (color-char cs)
+  (color-it cs))
+
+(define (color-string cs)
+  (color-it cs))
+
+(define (color-list cs)
+  (let* ((obj (color-scheme-obj cs)))
+    (if (proper-list? obj)
+        (call-with-output-string
+         (lambda (port)
+           (pre-print cs port)
+           (display (string-join (map ->cstr obj) " ") port)
+           (post-print cs port)))
+        (color-pair cs))))
+
+(define (color-pair cs)
+  (let* ((obj (color-scheme-obj cs))
+         (d1 (car obj))
+         (d2 (cdr obj)))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (colorize d1 port)
+       (space port) (print-dot port) (space port)
+       (colorize d2 port)
+       (post-print cs port)))))
+
+(define (color-class cs)
+  (color-it cs))
+
+(define (color-procedure cs)
+  (color-it cs))
+
+(define (color-vector cs)
+  (let ((ll (vector->list (color-scheme-obj cs))))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (display (string-join (map ->cstr ll) " ") port)
+       (post-print cs port)))))
+
+(define (color-keyword cs)
+  (color-it cs))
+
+;; TODO: maybe print it as char one by one?
+(define (color-char-set cs)
+  (color-it cs))
+
+(define (color-symbol cs)
+  (color-it cs))
+
+(define (color-stack cs)
+  (color-it cs))
+
+(define (color-record-type cs)
+  (color-it cs))
+
+(define (color-inexact cs)
+  (color-it cs))
+
+(define (color-exact cs)
+  (let* ((obj (color-scheme-obj cs))
+         (colors (color-scheme-color cs))
+         (num-color (car colors))
+         (div-color (cadr colors))
+         (control (color-scheme-control cs))
+         (n (object->string (numerator obj)))
+         (d (object->string (denominator obj))))
+    (call-with-output-string
+     (lambda (port)
+       (format port "~a~a~a" 
+               (color-it-inner num-color n control)
+               (color-it-inner div-color "/" control)
+               (color-it-inner num-color d control))))))
+
+(define (color-regexp cs)
+  (color-it cs))
+
+(define (color-bitvector cs)
+  ;; TODO: is it right?
+  (color-it cs))
+
+(define (color-boolean cs)
+  (color-it cs))
+
+(define (color-array cs)
+  (let ((ll (array->list (color-scheme-obj cs))))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (display (string-join (map ->cstr ll) " ") port)
+       (post-print cs port)))))
+
+(define (color-complex cs)
+  (color-it cs))
+
+(define (color-hashtable cs)
+  (color-it cs))
+
+(define (color-hook cs)
+  (color-it cs))
+
+(define (color-unknown cs)
+  (color-it cs))
+
+;;--- custom color scheme ---
+(define *custom-colorized-list* (make-fluid '()))
+
+(define (custom-colorized-set! ll)
+  (fluid-set! *custom-colorized-list* ll))
+
+(define (current-custom-colorized)
+  (fluid-ref *custom-colorized-list*))
+
+(define (add-color-scheme! cs-list)
+  (let ((ll (current-custom-colorized)))
+    (custom-colorized-set! `(,@cs-list ,@ll))))
+;;--- custom color scheme end---
+
+(define (is-inexact? obj)
+  (and (number? obj) (inexact? obj)))
+
+(define (is-exact? obj)
+  (and (number? obj) (exact? obj)))
+
+;; A class is a struct.
+(define (class? obj)
+  (struct? obj))
+
+(define *colorize-list*
+  `((,integer? INTEGER ,color-integer (BLUE BOLD))
+    (,char? CHAR ,color-char (YELLOW))
+    (,string? STRING ,color-string (RED))
+    (,list? LIST ,color-list (BLUE BOLD))
+    (,pair? PAIR ,color-list (BLACK BOLD)) ; NOTE: proper-list is a <pair>, and cons is <pair> too, so call color-list either.
+    (,class? CLASS ,color-class (CYAN BOLD))
+    (,procedure? PROCEDURE ,color-procedure (YELLOW BOLD))
+    (,vector? VECTOR ,color-vector (MAGENTA BOLD))
+    (,keyword? KEYWORD ,color-keyword (MAGENTA))
+    (,char-set? CHAR-SET ,color-char-set (WHITE))
+    (,symbol? SYMBOL ,color-symbol (GREEN BOLD))
+    (,stack? STACK ,color-stack (MAGENTA))
+    (,record-type? RECORD-TYPE ,color-record-type (BLACK BOLD))
+    ;; We don't check REAL here, since it'll cover FLOAT and FRACTION, but user may customs it as they wish.
+    (,is-inexact? FLOAT ,color-inexact (YELLOW))
+    (,is-exact? FRACTION ,color-exact ((BLUE BOLD) (YELLOW)))
+    (,regexp? REGEXP ,color-regexp (GREEN))
+    (,bitvector? BITVECTOR ,color-bitvector (YELLOW BOLD))
+    (,array? ARRAY ,color-array ((CYAN BOLD) (YELLOW BOLD)))
+    (,boolean? BOOLEAN ,color-boolean (BLUE))
+    (,complex? COMPLEX ,color-complex (MAGENTA))
+    (,hash-table? HASH-TABLE ,color-hashtable (BLUE))
+    (,hook? HOOK ,color-hook (GREEN))))
+;; TODO: if there's anything to add
+
+(define (obj->token-color obj)
+  (let ((proc (lambda (x) (and ((car x) obj) (cdr x)))))
+    (or (any proc (current-custom-colorized)) ; checkout user defined obj type
+        (any proc *colorize-list*) ; checkout default obj type
+        `(UNKNOWN ,color-unknown (WHITE))))) ; no suitable obj type ,return the unknown solution
+
+;; NOTE: we don't use control now, but I write the mechanism for future usage.
+(define (generate-color-scheme obj)
+  (let* ((r (obj->token-color obj))
+         (type (car r))
+         (method (cadr r))
+         (color (caddr r)))
+    (make-color-scheme obj type color '(RESET) method)))
+
+(define (generate-custom-string-color-scheme str color)
+  (make-color-scheme str #f color '(RESET) color-string))
+
+(define (colorize-string str color)
+  "Example: (colorize-string \"hello\" '(BLUE BOLD))" 
+  (and (not (list? color)) (error colorize-string "color should be a list!" color))
+  (colorize-string-helper color str '(RESET)))
+
+(define (colorized-display str color)
+  "Example: (colorized-display \"hello\" '(BLUE BOLD))"
+  (display (colorize-string str color)))
+
+(define* (colorize-it obj #:optional (port (current-output-port)))
+  (colorize obj port)
+  (newline port))
+
+(define* (colorize obj #:optional (port (current-output-port)))
+  (let* ((cs (generate-color-scheme obj))
+         (f (color-scheme-method cs)))
+    (display (f cs) port)))
+
+(define (->cstr obj)
+  (call-with-output-string
+   (lambda (port)
+     (colorize obj port))))
diff --git a/test-suite/tests/colorized.test b/test-suite/tests/colorized.test
new file mode 100644
index 0000000..a8baadb
--- /dev/null
+++ b/test-suite/tests/colorized.test
@@ -0,0 +1,88 @@
+;;;; colorized.test --- test (ice-9 colorized) module -*- scheme -*-
+;;;; 
+;;;; Copyright 2013 Free Software Foundation, Inc.
+;;;; 
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-suite test-ice-9-colorized)
+  #:use-module (test-suite lib)
+  #:use-module (oop goops)
+  #:use-module (srfi srfi-9)
+  #:use-module (ice-9 colorized))
+
+;; colorized-REPL test printer
+(define (color-it-test color str control) str)
+
+;;;
+;;; colorzed object test
+;;;
+
+(define-record-type aaa (make-aaa a) aaa? (a a))
+
+(define (test-me obj info)
+  (parameterize ((color-func color-it-test))
+    (pass-if info 
+      (equal? (call-with-output-string
+               (lambda (port) (colorize obj port)))
+              (object->string obj)))))
+
+(with-test-prefix "colorized object tests"
+
+  (test-me 123 "integer")
+
+  (test-me #\c "char")
+
+  (test-me "hello world\n" "string")
+
+  (test-me '(1 2 3 4 5) "list")
+
+  (test-me (cons 1 2) "pair")
+  
+  (test-me <integer> "class")
+
+  (test-me + "procedure")
+
+  (test-me (vector 1 2 3) "vector")
+
+  (test-me #:test-me "keyword")
+
+  (test-me char-set:ascii "char-set")
+
+  (test-me 'test-me "symbol")
+  
+  (test-me (make-stack #t) "stack")
+
+  (test-me aaa "record-type")
+
+  (test-me 1.2 "inexact")
+
+  (test-me 1/2 "exact")
+
+  (test-me (make-regexp "[0-9]*") "regexp")
+
+  (test-me (make-bitvector 8) "bitvector")
+
+  (test-me #2u32@2@3((1 2) (3 4)) "array")
+
+  (test-me #f "boolean false")
+  (test-me #t "boolean true")
+
+  (test-me 3+4i "complex")
+
+  (test-me (make-hash-table) "hash table")
+
+  (test-me (make-hook) "hook"))
+
+  
-- 
1.7.0.4

Re: [PATCH] Colorized REPL

[Nala Ginrut]

[-- Attachment #1.1: Type: text/plain, Size: 950 bytes --]

Sorry again.
Forget to add it into test-suite/Makefile.am
So many things to do for a new feature ;-)


On Thu, Jan 31, 2013 at 10:31 PM, Nala Ginrut <nalaginrut@gmail.com> wrote:

> Sorry, forget to add it into ice-9/Makefile.am
> Send again.
>
>
> On Thu, Jan 31, 2013 at 10:25 PM, Nala Ginrut <nalaginrut@gmail.com>wrote:
>
>> patch updated.
>> Thanks!
>>
>>
>> On Mon, Jan 28, 2013 at 10:56 PM, Nala Ginrut <nalaginrut@gmail.com>wrote:
>>
>>> Thanks David!
>>> It's nice to know that,  I thought Guile use PCRE, but I realized it's
>>> posix RE.
>>>
>>>
>>> On Mon, Jan 28, 2013 at 9:58 PM, David Pirotte <david@altosw.be> wrote:
>>>
>>>> Hello,
>>>>
>>>> > But I have some trouble with the regexp in Guile, seems "\\d+" can't
>>>> > work, others, like "\\w+" works.
>>>>
>>>> i also had this 'problem' and someone suggested to rather use
>>>> [[:digit:]]+
>>>> and friends - [:blank:] [:alpha:] ...
>>>>
>>>> Cheers,
>>>> David
>>>>
>>>
>>>
>>
>

[-- Attachment #1.2: Type: text/html, Size: 2296 bytes --]

[-- Attachment #2: 0001-Add-colorized-REPL.patch --]
[-- Type: application/octet-stream, Size: 21258 bytes --]

From 91f474b158c6d2ae353c58d73f9e6a35126a3712 Mon Sep 17 00:00:00 2001
From: NalaGinrut <nalaginrut@gmail.com>
Date: Thu, 31 Jan 2013 22:17:25 +0800
Subject: [PATCH] Add colorized-REPL

* doc/ref/misc-modules.texi
* doc/ref/scheme-using.texi: add docs for colorized-REPL

* module/ice-9/colorized.scm: add colorized-REPL module.

* test-suite/tests/colorized.test: add colorized-REPL test case.

* module/Makefile.am: add ice-9/colorized.scm

* modified:   test-suite/Makefile.amL add ice-9/colorized.scm
---
 doc/ref/misc-modules.texi       |   68 ++++++++
 doc/ref/scheme-using.texi       |   38 ++++-
 module/Makefile.am              |    1 +
 module/ice-9/colorized.scm      |  355 +++++++++++++++++++++++++++++++++++++++
 test-suite/Makefile.am          |    1 +
 test-suite/tests/colorized.test |   88 ++++++++++
 6 files changed, 548 insertions(+), 3 deletions(-)
 create mode 100644 module/ice-9/colorized.scm
 create mode 100644 test-suite/tests/colorized.test

diff --git a/doc/ref/misc-modules.texi b/doc/ref/misc-modules.texi
index cf1e0e4..e2ca6f9 100644
--- a/doc/ref/misc-modules.texi
+++ b/doc/ref/misc-modules.texi
@@ -1788,6 +1788,74 @@ example with the Scheme @code{read} function (@pxref{Scheme Read}),
 @end example
 @end deffn
 
+@node Colorized
+@section Colorized
+
+@cindex Colorized
+The module @code{(ice-9 colorized)} provides the procedure
+@code{activate-colorized}, which provides colored REPL output.
+
+The module is loaded and activated by entering the following:
+
+@lisp
+(use-modules (ice-9 colorized))
+(activate-colorized)
+@end lisp
+
+And you may add your own color scheme with @code{add-color-scheme!}:
+
+@lisp
+(add-color-scheme! `((,(lambda (data) 
+                         (and (number? data) (> data 10000)))
+                          MY-LONG-NUM ,color-it (RED))))
+@print{}
+Result: 10001 (in red color)
+@end lisp
+
+@deffn {Scheme Procedure} activate-colorized
+Activate colorized REPL.
+@end deffn
+
+@deffn {Scheme Procedure} add-color-scheme! color-scheme-list
+Add user defined color scheme. @code{color-scheme-list} consisted as:
+@lisp
+(list (pred scheme-name color-method color-list)
+      ;; other color scheme) 
+@end lisp
+While @code{pred} is the predicate to checkout if it's the type you need,
+@code{scheme-name} is a symbol you named this color scheme, 
+@code{color-method} is the color function, and it could be @code{color-it}
+in default, and @code{color-list} is a ansi-color specific color list.
+@end deffn
+
+@cindex Colorized String
+Also exported by the @code{(ice-9 colorized)} module is
+@code{colorize-string}, a procedure to format a string in certain color.
+Note: This feature works under most mainstream console whose respect ansi-color,
+but causes messes under some console.
+
+@lisp
+(use-modules (ice-9 colorized))
+(colorize-display "hello" '(BLUE BOLD))
+@print{} hello (in blue color and bold style)
+(colorize-string "hello" '(BLUE BOLD))
+@print{} "\x1b[32;1mhello\x1b[0m"
+(display (colorize-string "hello" '(BLUE BOLD)))
+@print{} hello (in blue color and bold style)
+@end lisp
+
+@deffn {Scheme Procedure} colorize-string str color
+Return a string formated with @var{str} in @var{color} according to ansi
+color specific.  
+@end deffn
+
+@deffn {Scheme Procedure} colorize-display str color
+Print @var{str} in @var{color}.
+@end deffn
+
+@deffn {Scheme Procedure} show-all-colors
+Print all available colors.
+@end deffn
 
 @c Local Variables:
 @c TeX-master: "guile.texi"
diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index e0f91af..7a77c92 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -37,6 +37,7 @@ support for languages other than Scheme.
 @menu
 * Init File::
 * Readline::                    
+* Colorized REPL::
 * Value History::              
 * REPL Commands::               
 * Error Handling::              
@@ -79,6 +80,37 @@ It's a good idea to put these two lines (without the
 @xref{Init File}, for more on @file{.guile}.
 
 
+@node Colorized REPL
+@subsection Colorized REPL
+
+To make colorized result in Guile REPL, or add your own color
+schemes to show the result in colors.
+
+@lisp
+scheme@@(guile-user)> (use-modules (ice-9 colorized))
+scheme@@(guile-user)> (activate-colorized)
+@end lisp
+
+It's a good idea to put these two lines (without the
+@code{scheme@@(guile-user)>} prompts) in your @file{.guile} file.
+Besides, you may add your color schemes for the result:
+@lisp
+(add-color-scheme! (list (pred scheme-name color-method color-list)))
+example:
+(add-color-scheme! `((,(lambda (data) 
+                         (and (number? data) (> data 10000)))
+                          MY-LONG-NUM ,color-it (RED))))
+10001
+@print{} 10001 (in red color)
+@end lisp
+While @code{pred} is the predicate to checkout if it's the type you need,
+@code{scheme-name} is a symbol you named this color scheme, 
+@code{color-method} is the color function, and it could be @code{color-it}
+in default, and @code{color-list} is a ansi-color specific color list, 
+please see @xref{Colorized}.
+@xref{Init File}, for more on @file{.guile}.
+
+
 @node Value History
 @subsection Value History
 
@@ -147,9 +179,9 @@ data structure or closure, they may then be reclaimed by the garbage collector.
 
 @cindex commands
 The REPL exists to read expressions, evaluate them, and then print their
-results. But sometimes one wants to tell the REPL to evaluate an
-expression in a different way, or to do something else altogether. A
-user can affect the way the REPL works with a @dfn{REPL command}.
+results. But sometimes one wants to tell the REPL to evaluate an expression
+in a different way, or to do something else altogether. A user can affect
+the way the REPL works with a @dfn{REPL command}.
 
 The previous section had an example of a command, in the form of
 @code{,option}.
diff --git a/module/Makefile.am b/module/Makefile.am
index 472bc48..2eec0e5 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -250,6 +250,7 @@ ICE_9_SOURCES = \
   ice-9/weak-vector.scm \
   ice-9/list.scm \
   ice-9/serialize.scm \
+  ice-9/colorized.scm \
   ice-9/local-eval.scm
 
 if HAVE_FORK
diff --git a/module/ice-9/colorized.scm b/module/ice-9/colorized.scm
new file mode 100644
index 0000000..2892f4b
--- /dev/null
+++ b/module/ice-9/colorized.scm
@@ -0,0 +1,355 @@
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;;; Author: Mu Lei known as NalaGinrut <nalaginrut@gmail.com>
+
+(define-module (ice-9 colorized)
+  #:use-module (ice-9 rdelim)
+  #:use-module ((srfi srfi-1) #:select (filter-map any proper-list?))
+  #:use-module (srfi srfi-9)
+  #:use-module (system repl common)
+  #:export (activate-colorized custom-colorized-set! color-it colorize-it colorize
+            color-func colorize-string colorized-display add-color-scheme!
+            show-all-colors))
+
+(define (colorized-repl-printer repl val)
+  (colorize-it val))
+
+(define (activate-colorized)
+  (let ((rs (fluid-ref *repl-stack*)))
+    (if (null? rs)
+	(repl-default-option-set! 'print colorized-repl-printer) ; if no REPL started, set as default printer
+	(repl-option-set! (car rs) 'print colorized-repl-printer)))) ; or set as the top-REPL printer
+
+;; color-scheme context, contains some info to be used
+(define-record-type color-scheme
+  (make-color-scheme obj type color control method)
+  color-scheme?
+  (obj color-scheme-obj) ; the obj to be colored
+  (type color-scheme-type) ; the obj type (for debug/test)
+  (color color-scheme-color) ; the color
+  (control color-scheme-control) ; ansi control code
+  (method color-scheme-method)) ; colorized method for the obj type
+
+(define *color-list*
+  `((CLEAR       .   "0")
+    (RESET       .   "0")
+    (BOLD        .   "1")
+    (DARK        .   "2")
+    (UNDERLINE   .   "4")
+    (UNDERSCORE  .   "4")
+    (BLINK       .   "5")
+    (REVERSE     .   "6")
+    (CONCEALED   .   "8")
+    (BLACK       .  "30")
+    (RED         .  "31")
+    (GREEN       .  "32")
+    (YELLOW      .  "33")
+    (BLUE        .  "34")
+    (MAGENTA     .  "35")
+    (CYAN        .  "36")
+    (WHITE       .  "37")
+    (ON-BLACK    .  "40")
+    (ON-RED      .  "41")
+    (ON-GREEN    .  "42")
+    (ON-YELLOW   .  "43")
+    (ON-BLUE     .  "44")
+    (ON-MAGENTA  .  "45")
+    (ON-CYAN     .  "46")
+    (ON-WHITE    .  "47")))
+
+(define (show-all-colors)
+  (for-each (lambda (c)
+              (format #t "~a~%" (car c)))
+            *color-list*))
+
+(define (get-color color)
+  (assq-ref *color-list* color))
+
+(define (generate-color colors)
+  (let ((color-list
+         (filter-map get-color colors)))
+    (if (null? color-list)
+        ""
+        (string-append "\x1b[" (string-join color-list ";" 'infix) "m"))))
+
+(define (colorize-string-helper color str control)
+  (string-append (generate-color color) str (generate-color control)))
+
+;; test-helper functions
+;; when eanbled, it won't output colored result, but just normal.
+;; it used to test the array/list/vector print result.
+(define color-func (make-parameter colorize-string-helper))
+
+(define (color-it cs) 
+  (let* ((obj (color-scheme-obj cs))
+         (str (object->string obj))
+         (color (color-scheme-color cs))
+         (control (color-scheme-control cs)))
+    (color-it-inner color str control)))
+
+(define (color-it-inner color str control)
+  ((color-func) color str control))
+
+(define* (space #:optional (port (current-output-port)))
+  (display #\sp port))
+
+(define *pre-sign* 
+  `((LIST       .   "(") 
+    (PAIR       .   "(") 
+    (VECTOR     .   "#(")
+    (ARRAY      .   #f))) 
+;; array's sign is complicated, return #f so it will be handled by pre-print
+
+(define* (pre-print cs #:optional (port (current-output-port)))
+  (let* ((type (color-scheme-type cs))
+         (control (color-scheme-control cs))
+         (sign (assq-ref *pre-sign* type))
+         (color (color-scheme-color cs))) 
+    (if sign
+        (display (color-it-inner color sign control) port)  ; not array
+        ;; array complecated coloring
+        (display (color-array-inner cs) port))))
+
+(define (print-dot port)
+  (let ((light-cyan '(CYAN BOLD)))
+    (display (color-it-inner light-cyan "." '(RESET)) port)))
+
+(define (delimiter? ch)
+  (char-set-contains? char-set:punctuation ch))
+
+(define (color-array-inner cs)
+  (let* ((colors (color-scheme-color cs))
+         (control (color-scheme-control cs))
+         (sign-color (car colors))
+         (attr-color (cadr colors))
+         (str (object->string (color-scheme-obj cs)))
+         (attrs (string->list 
+                 (call-with-input-string str (lambda (p) (read-delimited "(" p))))))
+    (call-with-output-string
+     (lambda (port)
+       (for-each (lambda (ch)
+                   (let ((color (if (delimiter? ch) sign-color attr-color)))
+                     (display (color-it-inner color (string ch) control) port)))
+                 attrs)
+       ;; output left-paren
+       (display (color-it-inner sign-color "(" control) port)))))
+
+;; Write a closing parenthesis.
+(define* (post-print cs #:optional (port (current-output-port)))
+  (let* ((c (color-scheme-color cs))
+         (control (color-scheme-control cs))
+         (color (if (list? (car c)) (car c) c))) ; array has a color-list
+    (display (color-it-inner color ")" control) port)))
+
+(define (color-integer cs)
+  (color-it cs))
+
+(define (color-char cs)
+  (color-it cs))
+
+(define (color-string cs)
+  (color-it cs))
+
+(define (color-list cs)
+  (let* ((obj (color-scheme-obj cs)))
+    (if (proper-list? obj)
+        (call-with-output-string
+         (lambda (port)
+           (pre-print cs port)
+           (display (string-join (map ->cstr obj) " ") port)
+           (post-print cs port)))
+        (color-pair cs))))
+
+(define (color-pair cs)
+  (let* ((obj (color-scheme-obj cs))
+         (d1 (car obj))
+         (d2 (cdr obj)))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (colorize d1 port)
+       (space port) (print-dot port) (space port)
+       (colorize d2 port)
+       (post-print cs port)))))
+
+(define (color-class cs)
+  (color-it cs))
+
+(define (color-procedure cs)
+  (color-it cs))
+
+(define (color-vector cs)
+  (let ((ll (vector->list (color-scheme-obj cs))))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (display (string-join (map ->cstr ll) " ") port)
+       (post-print cs port)))))
+
+(define (color-keyword cs)
+  (color-it cs))
+
+;; TODO: maybe print it as char one by one?
+(define (color-char-set cs)
+  (color-it cs))
+
+(define (color-symbol cs)
+  (color-it cs))
+
+(define (color-stack cs)
+  (color-it cs))
+
+(define (color-record-type cs)
+  (color-it cs))
+
+(define (color-inexact cs)
+  (color-it cs))
+
+(define (color-exact cs)
+  (let* ((obj (color-scheme-obj cs))
+         (colors (color-scheme-color cs))
+         (num-color (car colors))
+         (div-color (cadr colors))
+         (control (color-scheme-control cs))
+         (n (object->string (numerator obj)))
+         (d (object->string (denominator obj))))
+    (call-with-output-string
+     (lambda (port)
+       (format port "~a~a~a" 
+               (color-it-inner num-color n control)
+               (color-it-inner div-color "/" control)
+               (color-it-inner num-color d control))))))
+
+(define (color-regexp cs)
+  (color-it cs))
+
+(define (color-bitvector cs)
+  ;; TODO: is it right?
+  (color-it cs))
+
+(define (color-boolean cs)
+  (color-it cs))
+
+(define (color-array cs)
+  (let ((ll (array->list (color-scheme-obj cs))))
+    (call-with-output-string
+     (lambda (port)
+       (pre-print cs port)
+       (display (string-join (map ->cstr ll) " ") port)
+       (post-print cs port)))))
+
+(define (color-complex cs)
+  (color-it cs))
+
+(define (color-hashtable cs)
+  (color-it cs))
+
+(define (color-hook cs)
+  (color-it cs))
+
+(define (color-unknown cs)
+  (color-it cs))
+
+;;--- custom color scheme ---
+(define *custom-colorized-list* (make-fluid '()))
+
+(define (custom-colorized-set! ll)
+  (fluid-set! *custom-colorized-list* ll))
+
+(define (current-custom-colorized)
+  (fluid-ref *custom-colorized-list*))
+
+(define (add-color-scheme! cs-list)
+  (let ((ll (current-custom-colorized)))
+    (custom-colorized-set! `(,@cs-list ,@ll))))
+;;--- custom color scheme end---
+
+(define (is-inexact? obj)
+  (and (number? obj) (inexact? obj)))
+
+(define (is-exact? obj)
+  (and (number? obj) (exact? obj)))
+
+;; A class is a struct.
+(define (class? obj)
+  (struct? obj))
+
+(define *colorize-list*
+  `((,integer? INTEGER ,color-integer (BLUE BOLD))
+    (,char? CHAR ,color-char (YELLOW))
+    (,string? STRING ,color-string (RED))
+    (,list? LIST ,color-list (BLUE BOLD))
+    (,pair? PAIR ,color-list (BLACK BOLD)) ; NOTE: proper-list is a <pair>, and cons is <pair> too, so call color-list either.
+    (,class? CLASS ,color-class (CYAN BOLD))
+    (,procedure? PROCEDURE ,color-procedure (YELLOW BOLD))
+    (,vector? VECTOR ,color-vector (MAGENTA BOLD))
+    (,keyword? KEYWORD ,color-keyword (MAGENTA))
+    (,char-set? CHAR-SET ,color-char-set (WHITE))
+    (,symbol? SYMBOL ,color-symbol (GREEN BOLD))
+    (,stack? STACK ,color-stack (MAGENTA))
+    (,record-type? RECORD-TYPE ,color-record-type (BLACK BOLD))
+    ;; We don't check REAL here, since it'll cover FLOAT and FRACTION, but user may customs it as they wish.
+    (,is-inexact? FLOAT ,color-inexact (YELLOW))
+    (,is-exact? FRACTION ,color-exact ((BLUE BOLD) (YELLOW)))
+    (,regexp? REGEXP ,color-regexp (GREEN))
+    (,bitvector? BITVECTOR ,color-bitvector (YELLOW BOLD))
+    (,array? ARRAY ,color-array ((CYAN BOLD) (YELLOW BOLD)))
+    (,boolean? BOOLEAN ,color-boolean (BLUE))
+    (,complex? COMPLEX ,color-complex (MAGENTA))
+    (,hash-table? HASH-TABLE ,color-hashtable (BLUE))
+    (,hook? HOOK ,color-hook (GREEN))))
+;; TODO: if there's anything to add
+
+(define (obj->token-color obj)
+  (let ((proc (lambda (x) (and ((car x) obj) (cdr x)))))
+    (or (any proc (current-custom-colorized)) ; checkout user defined obj type
+        (any proc *colorize-list*) ; checkout default obj type
+        `(UNKNOWN ,color-unknown (WHITE))))) ; no suitable obj type ,return the unknown solution
+
+;; NOTE: we don't use control now, but I write the mechanism for future usage.
+(define (generate-color-scheme obj)
+  (let* ((r (obj->token-color obj))
+         (type (car r))
+         (method (cadr r))
+         (color (caddr r)))
+    (make-color-scheme obj type color '(RESET) method)))
+
+(define (generate-custom-string-color-scheme str color)
+  (make-color-scheme str #f color '(RESET) color-string))
+
+(define (colorize-string str color)
+  "Example: (colorize-string \"hello\" '(BLUE BOLD))" 
+  (and (not (list? color)) (error colorize-string "color should be a list!" color))
+  (colorize-string-helper color str '(RESET)))
+
+(define (colorized-display str color)
+  "Example: (colorized-display \"hello\" '(BLUE BOLD))"
+  (display (colorize-string str color)))
+
+(define* (colorize-it obj #:optional (port (current-output-port)))
+  (colorize obj port)
+  (newline port))
+
+(define* (colorize obj #:optional (port (current-output-port)))
+  (let* ((cs (generate-color-scheme obj))
+         (f (color-scheme-method cs)))
+    (display (f cs) port)))
+
+(define (->cstr obj)
+  (call-with-output-string
+   (lambda (port)
+     (colorize obj port))))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 9fba7b8..ea587fe 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -110,6 +110,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/rnrs-libraries.test		\
 	    tests/ramap.test			\
 	    tests/rdelim.test			\
+	    tests/colorized.test		\
 	    tests/reader.test			\
 	    tests/receive.test			\
 	    tests/regexp.test			\
diff --git a/test-suite/tests/colorized.test b/test-suite/tests/colorized.test
new file mode 100644
index 0000000..a8baadb
--- /dev/null
+++ b/test-suite/tests/colorized.test
@@ -0,0 +1,88 @@
+;;;; colorized.test --- test (ice-9 colorized) module -*- scheme -*-
+;;;; 
+;;;; Copyright 2013 Free Software Foundation, Inc.
+;;;; 
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-suite test-ice-9-colorized)
+  #:use-module (test-suite lib)
+  #:use-module (oop goops)
+  #:use-module (srfi srfi-9)
+  #:use-module (ice-9 colorized))
+
+;; colorized-REPL test printer
+(define (color-it-test color str control) str)
+
+;;;
+;;; colorzed object test
+;;;
+
+(define-record-type aaa (make-aaa a) aaa? (a a))
+
+(define (test-me obj info)
+  (parameterize ((color-func color-it-test))
+    (pass-if info 
+      (equal? (call-with-output-string
+               (lambda (port) (colorize obj port)))
+              (object->string obj)))))
+
+(with-test-prefix "colorized object tests"
+
+  (test-me 123 "integer")
+
+  (test-me #\c "char")
+
+  (test-me "hello world\n" "string")
+
+  (test-me '(1 2 3 4 5) "list")
+
+  (test-me (cons 1 2) "pair")
+  
+  (test-me <integer> "class")
+
+  (test-me + "procedure")
+
+  (test-me (vector 1 2 3) "vector")
+
+  (test-me #:test-me "keyword")
+
+  (test-me char-set:ascii "char-set")
+
+  (test-me 'test-me "symbol")
+  
+  (test-me (make-stack #t) "stack")
+
+  (test-me aaa "record-type")
+
+  (test-me 1.2 "inexact")
+
+  (test-me 1/2 "exact")
+
+  (test-me (make-regexp "[0-9]*") "regexp")
+
+  (test-me (make-bitvector 8) "bitvector")
+
+  (test-me #2u32@2@3((1 2) (3 4)) "array")
+
+  (test-me #f "boolean false")
+  (test-me #t "boolean true")
+
+  (test-me 3+4i "complex")
+
+  (test-me (make-hash-table) "hash table")
+
+  (test-me (make-hook) "hook"))
+
+  
-- 
1.7.0.4