Re: [PATCH] Colorized REPL

[Ludovic Courtès]

Hi Nala,

Thanks for your work!

Nala Ginrut <address@hidden> 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’.