feat: Add color options

cmds/qob.lisp

@@ -26,6 +26,12 @@
     :long-name "all"
     :persistent t
     :key :all)
+   (clingon:make-option
+    :flag
+    :description "enable/disable color output"
+    :long-name "no-color"
+    :persistent t
+    :key :no-color)
    (clingon:make-option
     :integer
     :description "set verbosity from 0 to 5"

lisp/_color.lisp

@@ -0,0 +1,45 @@
+;;; lisp/_color.lisp --- Color module
+;;; Commentary:
+;;; Code:
+
+(defvar qob-enable-color t
+  "Set to nil to disable color.")
+
+(defun qob-color-code (color)
+  "Return the ANSI color code by COLOR."
+  (ecase color
+    (:gray    "38;5;8")
+    (:black   30)
+    (:red     31)
+    (:green   32)
+    (:yellow  33)
+    (:blue    34)
+    (:magenta 35)
+    (:cyan    36)
+    (:white   37)))
+
+(defun qob-color-it (color str)
+  "COLOR the STR."
+  (check-type color keyword)
+  (if qob-enable-color
+      (format nil "~C[~Am~A~C[0m"
+              #\Esc (qob-color-code color) str #\Esc)
+      str))
+
+(defun qob-ansi-red (str)
+  "Color STR in red."
+  (qob-color-it :red str))
+
+(defun qob-ansi-green (str)
+  "Color STR in green."
+  (qob-color-it :green str))
+
+(defun qob-ansi-yellow (str)
+  "Color STR in yellow."
+  (qob-color-it :yellow str))
+
+(defun qob-ansi-cyan (str)
+  "Color STR in cyan."
+  (qob-color-it :cyan str))
+
+;;; End of lisp/_color.lisp

lisp/_prepare.lisp

@@ -1,4 +1,4 @@
-;;; lisp/_prepare.el --- Prepare for command tasks
+;;; lisp/_prepare.lisp --- Prepare for command tasks
 ;;; Commentary: Prepare to setup Qob environment for sandboxing
 ;;; Code:
 
@@ -37,28 +37,23 @@ The arguments FMT and ARGS are used to form the output message."
 
 (defun qob-trace (msg &rest args)
   "Send trace message; see function `qob--msg' for arguments MSG and ARGS."
-  ;; TODO: ..
   (apply #'qob-msg msg args))
 
 (defun qob-debug (msg &rest args)
   "Send debug message; see function `qob--msg' for arguments MSG and ARGS."
-  ;; TODO: ..
   (apply #'qob-msg msg args))
 
 (defun qob-info (msg &rest args)
   "Send info message; see function `qob--msg' for arguments MSG and ARGS."
-  ;; TODO: ..
-  (apply #'qob-msg msg args))
+  (qob-msg (qob-ansi-cyan (format nil msg args))))
 
 (defun qob-warn (msg &rest args)
   "Send warning message; see function `qob--msg' for arguments MSG and ARGS."
-  ;; TODO: ..
-  (apply #'qob-msg msg args))
+  (qob-msg (qob-ansi-yellow (format nil msg args))))
 
 (defun qob-error (msg &rest args)
   "Send error message; see function `qob--msg' for arguments MSG and ARGS."
-  ;; TODO: ..
-  (apply #'qob-msg msg args))
+  (qob-msg (qob-ansi-red (format nil msg args))))
 
 ;;
 ;;; Environment
@@ -95,6 +90,15 @@ Argument ENV-NAME is used to get the argument string."
 (defvar qob-quicklisp-installed-p (uiop:getenv "QOB_QUICKLISP_INSTALLED")
   "Return non-nil if Quicklisp is already installed.")
 
+(defun qob-dot-home ()
+  "Return the directory path to `.qob/type/version'.
+
+For example, `.qob/sbcl/2.4.9/'."
+  (uiop:merge-pathnames* (concatenate 'string
+                                      (lisp-implementation-type) "/"
+                                      (lisp-implementation-version) "/")
+                         qob-dot))
+
 ;;
 ;;; Utils
 
@@ -153,6 +157,10 @@ the `qob-start' execution.")
   "Non-nil when flag is on (`-a', `--all')."
   (qob--flag "--all"))
 
+(defun qob-no-color-p ()
+  "Non-nil when flag is on (`--no-color')."
+  (qob--flag "--no-color"))
+
 ;;; Number (with arguments)
 (defun qob-verbose ()
   "Non-nil when flag has value (`-v', `--verbose')."
@@ -170,13 +178,12 @@ the `qob-start' execution.")
   "Return the QuickLisp installed directory base on scope."
   (uiop:merge-pathnames* "quicklisp/" (if (qob-global-p)
                                           (user-homedir-pathname)
-                                          qob-dot)))
+                                          (qob-dot-home))))
 
 (defun qob-init-ql ()
   "Initialize QuickLisp."
   (let* ((ql-dir (qob-ql-installed-dir))
          (ql-init (uiop:merge-pathnames* "setup.lisp" ql-dir)))
-    (qob-info "~A" ql-dir)
     (unless qob-quicklisp-installed-p
       (qob-quicklisp-install ql-dir))
     (when (probe-file ql-init)
@@ -225,4 +232,9 @@ If optional argument WITH-TEST is non-nil; include test ASD files as well."
 
 ;;(qob-load "extern/alexandria")
 
+;;
+;;; Initialization
+
+(setq qob-enable-color (not (qob-no-color-p)))
+
 ;;; End of lisp/_prepare.lisp

lisp/core/install-deps.lisp

@@ -0,0 +1,16 @@
+;;;; lisp/core/install-deps.lisp --- Install dependent systems
+
+;;; Commentary
+;;
+;; Command use to install dependent systems,
+;;
+;;   $ qob install-deps
+;;
+
+;;; Code
+
+(qob-init-ql)
+
+
+
+;;; End of lisp/core/install-deps.lisp

lisp/core/install.lisp

@@ -1,15 +1,15 @@
-;;;; lisp/core/install.lisp --- Build executable
+;;;; lisp/core/install.lisp --- Install systems
 
 ;;; Commentary
 ;;
-;; Command use to install packages,
+;; Command use to install systems,
 ;;
 ;;   $ qob install [names..]
 ;;
 ;;
 ;;  Optional arguments:
 ;;
-;;    [names..]     name of the package(s) to install
+;;    [names..]     name of the system(s) to install
 ;;
 
 ;;; Code

lisp/core/list.lisp

@@ -11,6 +11,15 @@
 
 (qob-init-ql)
 
+(defun qob-list--print-system (name)
+  "Print the system info by NAME."
+  (let* ((system (asdf:find-system name))
+         (version (or (asdf:component-version system)
+                      "0")))
+    (qob-println "   ~A (~A)"
+                 (qob-ansi-green name)
+                 (qob-ansi-yellow version))))
+
 (let* ((pre-systems (asdf/system-registry:registered-systems))
        (pre-systems (reverse pre-systems))
        (post-systems)
@@ -23,16 +32,12 @@
                                 (asdf/system-registry:registered-systems))
         post-systems (reverse post-systems))
 
-  (qob-info "Pre-built systems:")
-
-  (dolist (system pre-systems)
-    (qob-println "  ~A" system))
+  (qob-println "Pre-built systems:")
+  (mapc #'qob-list--print-system pre-systems)
 
   (when local-p
     (qob-msg "")
-    (qob-info "User systems:")
-
-    (dolist (system post-systems)
-      (qob-println "  ~A" system))))
+    (qob-println "User systems:")
+    (mapc #'qob-list--print-system post-systems)))
 
 ;;; End of lisp/core/list.lisp

src/utils.lisp

@@ -56,6 +56,8 @@
       (nconc opts `("--global")))
     (when (clingon:getopt cmd :all)
       (nconc opts `("--all")))
+    (when (clingon:getopt cmd :no-color)
+      (nconc opts `("--no-color")))
     ;; Number (with value)
     (let ((verbose (verbose cmd)))
       (when verbose
@@ -106,6 +108,7 @@ Argument CMD is used to extract positional arguments and options."
 (defun call-script (script cmd)
   "Run the lisp implementation with the SCRIPT and CMD."
   (let ((el      (lisp-script "_el_lib"))
+        (color   (lisp-script "_color"))
         (prepare (lisp-script "_prepare"))
         (no-ql   (lisp-script "_no_ql"))
         (ql      (lisp-script "_ql"))
@@ -116,6 +119,7 @@ Argument CMD is used to extract positional arguments and options."
                                  (list "--load" (quicklisp-lisp cmd)
                                        "--load" ql))
                              (list "--load"   el
+                                   "--load"   color
                                    "--load"   prepare
                                    "--script" script))
                 cmd)))