Re: Fwd: Re: Patch file for colorize module

[Sahitihi <sahi@swecha.net>]

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

Hi Ricardo,

Text file is attached with all changes I added including colorize module.

The changes added to build.scm is (/(parameterize
((current-build-output-port  colorful-build-output-port)) /)

> Please send me the complete changes as a text file, so that I can apply
> it to my copy of the Guix repository.
>
---
Thanks!!
Sahithi.

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

[-- Attachment #2: Colorize module and Soft port --]
[-- Type: text/plain, Size: 3044 bytes --]

(define color-table
  `((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 (color . lst)
  "Return a string containing the ANSI escape sequence for producing the
requested set of attributes in LST.  Unknown attributes are ignored."
  (let ((color-list
         (remove not
                 (map (lambda (color) (assq-ref color-table color))
                      lst))))
    (if (null? color-list)
        ""
        (string-append
         (string #\esc #\[)
         (string-join color-list ";" 'infix)
         "m"))))

(define (colorize-string str . color-list)
  "Return a copy of STR colorized using ANSI escape sequences according to the
attributes STR.  At the end of the returned string, the color attributes will
be reset such that subsequent output will not have any colors in effect."
  (string-append
   (apply color color-list)
   str
   (color 'RESET)))

 
(define (handle-string str)
    (let ((message  (or (and=> (string-match "^(starting phase)(.*)" str)
           (lambda (m)
             (string-append
               (colorize-string (match:substring m 1) 'BLUE)
               (colorize-string (match:substring m 2) 'GREEN))))

       (and=> (string-match "^(phase) (.*) (succeeded after) (.*) (seconds)" str)
          (lambda (m)
            (string-append
              (colorize-string (match:substring m 1) 'BLUE)
              (colorize-string (match:substring m 2) 'GREEN)
              (colorize-string (match:substring m 3) 'BLUE)
              (colorize-string (match:substring m 4) 'GREEN)
              (colorize-string (match:substring m 5) 'BLUE))))

       (and=> (string-match "^(phase)(.*) (failed after) (.*) (seconds)" str)
          (lambda (m)
            (string-append
              (colorize-string (match:substring m 1) 'RED)
              (colorize-string (match:substring m 2) 'GREEN)
              (colorize-string (match:substring m 3) 'RED)
              (colorize-string (match:substring m 4) 'GREEN)
              (colorize-string (match:substring m 5) 'RED))))

    ;; Didn’t match, so return unmodified string.
       str)))
    (display message (current-error-port))))

(define colorful-build-output-port
  (make-soft-port
   (vector
    (lambda (c) (write c (current-error-port)))
    handle-string
    (lambda () (display "." (current-error-port)))
    (lambda () (char-upcase (read-char)))
    (lambda () (display "@" (current-error-port))))
   "rw"))

;;; ui.scm ends here