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