pest.lisp 4.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117
  1. ;; PROMPT_COMMAND='export PS1="$(pest)"'
  2. (defun string-assoc (key alist)
  3. "Shortcut function over :test #'equal for working with TOML alists"
  4. (cdr (assoc key alist :test #'equal)))
  5. (defun config-parse (&optional path)
  6. (let ((config-path (if path path (concatenate 'string (uiop:getenv "HOME") "/.config/pest/config.toml"))))
  7. (if (probe-file config-path)
  8. (with-open-file (fh config-path :direction :input)
  9. (let ((file-content (with-output-to-string (out)
  10. (loop for line = (read-line fh nil)
  11. while line
  12. do (format out "~a~%" line)))))
  13. (clop:parse file-content))))))
  14. (defvar *config* NIL)
  15. (defun parse-colors (alist)
  16. "Given an alist containing the fg and bg lists, extract and flatten the rgb color ints into chlorophyll rgb-colors
  17. Returns a list with two elements, the fg chlorophyll rgb object and the bg object"
  18. ;; TODO let assignment can be made more compact via lambda for extracting from toml alist eg. with arg "fg" or "bg"
  19. (let ((colors
  20. (list
  21. (string-assoc "fg" (string-assoc "colors" alist))
  22. (string-assoc "bg" (string-assoc "colors" alist)))))
  23. (loop for rgb-list in colors
  24. collect (destructuring-bind (r g b) rgb-list
  25. (chlorophyll:create-rgb-color r g b)))))
  26. ;; Battery
  27. (defvar *display-battery* NIL)
  28. ;; Git
  29. (defvar *display-git* NIL)
  30. (defvar *git-string* NIL)
  31. (defvar *git-style* NIL)
  32. (defun make-style (config key)
  33. "Given a valid TOML config and key, make the chlorophyll style object for the git status string"
  34. (let ((rgb-colors (parse-colors (string-assoc key config))))
  35. (chlorophyll:new-style
  36. :bold T
  37. :foreground (first rgb-colors)
  38. :background (second rgb-colors))))
  39. (defun check-git-enabled (config)
  40. (if (or
  41. (string-assoc "display_head" (string-assoc "git" config))
  42. (string-assoc "display_branch" (string-assoc "git" config)))
  43. T))
  44. (defun check-git-dir ()
  45. (if (probe-file (pathname (concatenate 'string (get-pwd) "/.git")))
  46. T
  47. NIL))
  48. (defun make-git-string (config)
  49. "Emit string that contains git information to be printed. Assumes if called that git info is enabled."
  50. (if (probe-file (pathname (concatenate 'string (get-pwd) "/.git")))
  51. (let ((git-string NIL))
  52. (if (string-assoc "display_head" (string-assoc "git" config))
  53. (setf git-string (concatenate 'string git-string (legit:current-commit "." :short T))))
  54. (if (string-assoc "display_branch" (string-assoc "git" config))
  55. (progn
  56. (if (string-assoc "display_head" (string-assoc "git" config))
  57. (setf git-string (concatenate 'string git-string "|" (legit:current-branch "." :short T)))
  58. (setf git-string (concatenate 'string git-string (legit:current-branch "." :short T)))))) ;; This is messy
  59. (setf git-string (concatenate 'string (string-assoc "git_prefix" (string-assoc "git" config)) git-string))
  60. git-string)))
  61. ;; Prompt
  62. (defvar *prompt-style* NIL)
  63. (defun get-user ()
  64. (uiop:getenv "USER"))
  65. (defun get-hostname ()
  66. (machine-instance))
  67. ;; Regex Scanners
  68. ;; TODO $HOME rendered as /home/user as opposed to ~
  69. (defvar *home-scan* (ppcre:create-scanner (concatenate 'string "^" (format NIL "~a" (user-homedir-pathname)))))
  70. (defun get-pwd ()
  71. (ppcre:regex-replace *home-scan* (uiop:getenv "PWD") "~/"))
  72. (defun make-prompt-string (config)
  73. "Given config options, produce prompt string (eg: user@hostname:dir terminator)"
  74. (let ((prompt-alist (string-assoc "prompt" config))
  75. (prompt-string NIL))
  76. (if (string-assoc "display_user" prompt-alist)
  77. (setf prompt-string (concatenate 'string prompt-string (get-user) (string-assoc "user_suffix" prompt-alist))))
  78. (if (string-assoc "display_hostname" prompt-alist)
  79. (setf prompt-string (concatenate 'string prompt-string (get-hostname) (string-assoc "hostname_suffix" prompt-alist))))
  80. (if (string-assoc "display_pwd" prompt-alist)
  81. (setf prompt-string (concatenate 'string prompt-string (get-pwd) (string-assoc "pwd_suffix" prompt-alist))))
  82. prompt-string))
  83. (defun reload-config ()
  84. (setf *config* (config-parse "~/Repos/cl-pest/config.toml"))
  85. (setf *prompt-style* (make-style *config* "prompt"))
  86. (if (check-git-enabled *config*)
  87. (setf *git-style* (make-style *config* "git"))))
  88. (defun render-prompt ()
  89. "After resolving all config parsing and string generation, render the prompt output here. Produces a stylized string"
  90. (format T "~A" (chlorophyll:stylize *prompt-style* (make-prompt-string *config*)))
  91. (if (and (check-git-enabled *config*) (check-git-dir))
  92. (format T " ~A" (chlorophyll:stylize *git-style* (make-git-string *config*))))
  93. (format T "~A" (string-assoc "prompt_char" (string-assoc "prompt" *config*))))
  94. (defun main ()
  95. (reload-config)
  96. (render-prompt))