https://git.spwbk.site/swatson/cl-pest/raw/master/pest.lisp
___________________________________

;; PROMPT_COMMAND='export PS1="$(pest)"'

(defun string-assoc (key alist)
 "Shortcut function over :test #'equal for working with TOML alists"
 (cdr (assoc key alist :test #'equal)))

(defun find-config ()
 (let ((config-paths (list
                      (concatenate 'string (uiop:getenv "HOME") "/.config/pest/config.toml")
                      "/etc/pest/config.toml"
                      (concatenate 'string (uiop:getenv "PWD") "./config"))))
   (loop for path-str in config-paths
         do (if (probe-file path-str)
                (return-from find-config path-str)))))

(defun config-parse (&optional path)
 (let ((config-path (if path path (find-config))))
   (if config-path
       (with-open-file (fh config-path :direction :input)
                          (let ((file-content (with-output-to-string (out)
                                                (loop for line = (read-line fh nil)
                                                      while line
                                                      do (format out "~a~%" line)))))
                            (clop:parse file-content)))
       (clop:parse "
[git]
display_head = false
display_branch = false
git_prefix = \"\"
[git.colors]
fg = [0, 120, 50]
bg = [0, 0, 0]

[prompt]
display_user = false
user_suffix = \"\"
display_hostname = false
hostname_suffix = \"\"
display_pwd = true
pwd_suffix = \"\"
prompt_char = \" λ \"
[prompt.colors]
fg = [255, 255, 255]
bg = [0, 0, 0]
"))))

(defvar *config* NIL)

(defun parse-colors (alist)
 "Given an alist containing the fg and bg lists, extract and flatten the rgb color ints into chlorophyll rgb-colors
  Returns a list with two elements, the fg chlorophyll rgb object and the bg object"
 ;; TODO let assignment can be made more compact via lambda for extracting from toml alist eg. with arg "fg" or "bg"
 (let ((colors
         (list
          (string-assoc "fg" (string-assoc "colors" alist))
          (string-assoc "bg" (string-assoc "colors" alist)))))
   (loop for rgb-list in colors
         collect (destructuring-bind (r g b) rgb-list
                   (chlorophyll:create-rgb-color r g b)))))

;; Battery
(defvar *display-battery* NIL)

;; Git
(defvar *display-git* NIL)
(defvar *git-string* NIL)
(defvar *git-style* NIL)

(defun make-style (config key)
 "Given a valid TOML config and key, make the chlorophyll style object for the git status string"
 (let ((rgb-colors (parse-colors (string-assoc key config))))
   (chlorophyll:new-style
                      :bold T
                      :foreground (first rgb-colors)
                      :background (second rgb-colors))))

(defun check-git-enabled (config)
 (if (or
      (string-assoc "display_head" (string-assoc "git" config))
      (string-assoc "display_branch" (string-assoc "git" config)))
     T))

(defun check-git-dir ()
 (if (probe-file (pathname (concatenate 'string (get-pwd) "/.git")))
     T
     NIL))

(defun make-git-string (config)
 "Emit string that contains git information to be printed. Assumes if called that git info is enabled."
 (if (probe-file (pathname (concatenate 'string (get-pwd) "/.git")))
     (let ((git-string NIL))
       (if (string-assoc "display_head" (string-assoc "git" config))
           (setf git-string (concatenate 'string git-string (legit:current-commit "." :short T))))
       (if (string-assoc "display_branch" (string-assoc "git" config))
           (progn
             (if (string-assoc "display_head" (string-assoc "git" config))
                 (setf git-string (concatenate 'string git-string "|" (legit:current-branch "." :short T)))
                 (setf git-string (concatenate 'string git-string (legit:current-branch "." :short T)))))) ;; This is messy
       (setf git-string (concatenate 'string (string-assoc "git_prefix" (string-assoc "git" config)) git-string))
       git-string)))

;; Prompt
(defvar *prompt-style* NIL)

(defun get-user ()
 (uiop:getenv "USER"))

(defun get-hostname ()
 (machine-instance))

;; Regex Scanners
;; TODO $HOME rendered as /home/user as opposed to ~
(defvar *home-scan* (ppcre:create-scanner (concatenate 'string "^" (format NIL "~a" (user-homedir-pathname)))))

(defun get-pwd ()
 (ppcre:regex-replace *home-scan* (uiop:getenv "PWD") "~/"))

(defun make-prompt-string (config)
 "Given config options, produce prompt string (eg: user@hostname:dir terminator)"
 (let ((prompt-alist (string-assoc "prompt" config))
       (prompt-string NIL))
   (if (string-assoc "display_user" prompt-alist)
       (setf prompt-string (concatenate 'string prompt-string (get-user) (string-assoc "user_suffix" prompt-alist))))
   (if (string-assoc "display_hostname" prompt-alist)
       (setf prompt-string (concatenate 'string prompt-string (get-hostname) (string-assoc "hostname_suffix" prompt-alist))))
   (if (string-assoc "display_pwd" prompt-alist)
       (setf prompt-string (concatenate 'string prompt-string (get-pwd) (string-assoc "pwd_suffix" prompt-alist))))
   prompt-string))


(defun reload-config ()
 (setf *config* (config-parse))
 (setf *prompt-style* (make-style *config* "prompt"))
 (if (check-git-enabled *config*)
     (setf *git-style* (make-style *config* "git"))))

(defun render-prompt ()
 "After resolving all config parsing and string generation, render the prompt output here. Produces a stylized string"
 (format T "~A" (chlorophyll:stylize *prompt-style* (make-prompt-string *config*)))
 (if (and (check-git-enabled *config*) (check-git-dir))
     (format T " ~A" (chlorophyll:stylize *git-style* (make-git-string *config*))))
 (format T "~A" (string-assoc "prompt_char" (string-assoc "prompt" *config*))))

(defun main ()
 (reload-config)
 (render-prompt))

You are viewing proxied material from chate.io. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.