Replace ansi plugin with internal ansi library

This commit is contained in:
Henrik Lissner 2017-04-12 10:51:29 -04:00
parent 4e5a1d2ed2
commit e50dabfde4
4 changed files with 91 additions and 38 deletions

73
core/autoload/message.el Normal file
View file

@ -0,0 +1,73 @@
;;; message.el
(defconst doom-ansi-fg
'((reset . 0)
(black . 30)
(red . 31)
(green . 32)
(yellow . 33)
(blue . 34)
(magenta . 35)
(cyan . 36)
(white . 37))
"List of text colors.")
(defconst doom-ansi-bg
'((on-black . 40)
(on-red . 41)
(on-green . 42)
(on-yellow . 43)
(on-blue . 44)
(on-magenta . 45)
(on-cyan . 46)
(on-white . 47))
"List of colors to draw text on.")
(defconst doom-ansi-fx
'((bold . 1)
(dark . 2)
(italic . 3)
(underscore . 4)
(blink . 5)
(rapid . 6)
(contrary . 7)
(concealed . 8)
(strike . 9))
"List of styles.")
;;;###autoload
(defmacro ansi-format! (message &rest args)
"An alternative to `format' that strips out ANSI codes if used in an
interactive session."
`(cl-flet*
(,@(mapcar
(lambda (ansi)
`(,(car ansi)
(lambda (message &rest args)
(apply 'doom--ansi-apply ,(cdr ansi) message args))))
(append doom-ansi-fg doom-ansi-bg doom-ansi-fx))
(color (symbol-function 'doom--ansi-apply)))
(format ,message ,@args)))
;;;###autoload
(defmacro ansi-message! (message &rest args)
"An alternative to `message' that strips out ANSI codes if used in an
interactive session."
`(message (ansi-format! ,message ,@args)))
(defun doom--ansi-apply (code format &rest args)
(if noninteractive
(format "\e[%dm%s\e[%sm"
(if (numberp code)
code
(cdr (or (assq code doom-ansi-fg)
(assq code doom-ansi-bg)
(assq code doom-ansi-fx))))
(apply 'format format args) 0)
(apply 'format format args)))
;; --- DOOM message buffer -----------------------------------------------------
;; TODO
;; (defun doom-message (message &rest args) (interactive))

View file

@ -207,7 +207,7 @@ appropriate."
(interactive) (interactive)
(let ((packages (doom-get-missing-packages))) (let ((packages (doom-get-missing-packages)))
(cond ((not packages) (cond ((not packages)
(message "No packages to install!")) (ansi-message! (green "No packages to install!")))
((not (or (getenv "YES") ((not (or (getenv "YES")
(y-or-n-p (y-or-n-p
@ -221,12 +221,12 @@ appropriate."
"ELPA"))) "ELPA")))
(sort (cl-copy-list packages) 'doom--sort-alpha) (sort (cl-copy-list packages) 'doom--sort-alpha)
"\n"))))) "\n")))))
(message! (yellow "Aborted!"))) (ansi-message! (yellow "Aborted!")))
(t (t
(dolist (pkg packages) (dolist (pkg packages)
(condition-case ex (condition-case ex
(message! (cond ((package-installed-p (car pkg)) (ansi-message! (cond ((package-installed-p (car pkg))
(dark (white "[%%s] Skipped %%s (already installed)"))) (dark (white "[%%s] Skipped %%s (already installed)")))
((doom-install-package (car pkg) (cdr pkg)) ((doom-install-package (car pkg) (cdr pkg))
(green "[%%s] Installed %%s")) (green "[%%s] Installed %%s"))
@ -239,9 +239,9 @@ appropriate."
(when (plist-member (cdr pkg) :pin) (when (plist-member (cdr pkg) :pin)
(format " [pinned: %s]" (plist-get (cdr pkg) :pin))))) (format " [pinned: %s]" (plist-get (cdr pkg) :pin)))))
('error ('error
(message! (red "Error (%s): %s" (car pkg) ex))))) (ansi-message! (red "Error (%s): %s" (car pkg) ex)))))
(message! (bold (green "\n---\nFinished!"))) (ansi-message! (bold (green "\n---\nFinished!")))
(doom/reload))))) (doom/reload)))))
;;;###autoload ;;;###autoload
@ -250,7 +250,7 @@ appropriate."
(interactive) (interactive)
(let ((packages (sort (doom-get-outdated-packages) 'doom--sort-alpha))) (let ((packages (sort (doom-get-outdated-packages) 'doom--sort-alpha)))
(cond ((not packages) (cond ((not packages)
(message! (green "Everything is up-to-date"))) (ansi-message! (green "Everything is up-to-date")))
((not (or (getenv "YES") ((not (or (getenv "YES")
(y-or-n-p (y-or-n-p
@ -268,21 +268,21 @@ appropriate."
(package-version-join (cl-caddr pkg)))) (package-version-join (cl-caddr pkg))))
packages packages
"\n")))))) "\n"))))))
(message! (yellow "Aborted!"))) (ansi-message! (yellow "Aborted!")))
(t (t
(dolist (pkg packages) (dolist (pkg packages)
(condition-case ex (condition-case ex
(message! (ansi-message!
(let ((result (doom-update-package (car pkg)))) (let ((result (doom-update-package (car pkg))))
(ansi-apply (if result 'green 'red) (color (if result 'green 'red)
"%s %s" "%s %s"
(if result "Updated" "Failed to update") (if result "Updated" "Failed to update")
(car pkg)))) (car pkg))))
('error ('error
(message! (bold (red "Error installing %s: %s" (car pkg) ex)))))) (ansi-message! (bold (red "Error installing %s: %s" (car pkg) ex))))))
(message! (bold (green "\n---\nFinished!"))) (ansi-message! (bold (green "\n---\nFinished!")))
(doom/reload))))) (doom/reload)))))
;;;###autoload ;;;###autoload
@ -291,7 +291,7 @@ appropriate."
(interactive) (interactive)
(let ((packages (doom-get-orphaned-packages))) (let ((packages (doom-get-orphaned-packages)))
(cond ((not packages) (cond ((not packages)
(message! (green "No unused packages to remove"))) (ansi-message! (green "No unused packages to remove")))
((not (or (getenv "YES") ((not (or (getenv "YES")
(y-or-n-p (y-or-n-p
@ -300,7 +300,7 @@ appropriate."
(mapconcat (lambda (sym) (format "+ %s" (symbol-name sym))) (mapconcat (lambda (sym) (format "+ %s" (symbol-name sym)))
(sort (cl-copy-list packages) 'string-lessp) (sort (cl-copy-list packages) 'string-lessp)
"\n"))))) "\n")))))
(message! (yellow "Aborted!"))) (ansi-message! (yellow "Aborted!")))
(t (t
(dolist (pkg packages) (dolist (pkg packages)
@ -311,9 +311,9 @@ appropriate."
"Failed to delete") "Failed to delete")
pkg) pkg)
('error ('error
(message! (red "Error deleting %s: %s" pkg ex))))) (ansi-message! (red "Error deleting %s: %s" pkg ex)))))
(message! (bold (green "\n---\nFinished!"))) (ansi-message! (bold (green "\n---\nFinished!")))
(doom/reload))))) (doom/reload)))))
;;;###autoload ;;;###autoload

View file

@ -5,11 +5,6 @@
;; ;;
(autoload 'when-let "subr-x") (autoload 'when-let "subr-x")
(autoload 'if-let "subr-x") (autoload 'if-let "subr-x")
;;
(if noninteractive
(require 'ansi)
(autoload 'with-ansi "ansi")
(autoload 'ansi-apply "ansi"))
;; I don't use use-package for these to save on the `fboundp' lookups it does ;; I don't use use-package for these to save on the `fboundp' lookups it does
;; for its :commands property. I use dolists instead of mapc to avoid extra ;; for its :commands property. I use dolists instead of mapc to avoid extra
@ -75,20 +70,6 @@
;; Library ;; Library
;; ;;
(defmacro format! (message &rest args)
"An alternative to `format' that strips out ANSI codes if used in an
interactive session."
`(with-ansi
,(if noninteractive
`(format ,message ,@args)
`(cl-letf (((symbol-function 'ansi-apply) (lambda (_ &rest args) (apply 'format args))))
(format ,message ,@args)))))
(defmacro message! (message &rest args)
"An alternative to `message' that strips out ANSI codes if used in an
interactive session."
`(message (format! ,message ,@args)))
(defmacro λ! (&rest body) (defmacro λ! (&rest body)
"A shortcut for inline interactive lambdas." "A shortcut for inline interactive lambdas."
(declare (doc-string 1)) (declare (doc-string 1))

View file

@ -5,7 +5,6 @@
(package! async) (package! async)
(package! s) (package! s)
(package! f) (package! f)
(package! ansi)
;; core-os.el ;; core-os.el
(when IS-MAC (when IS-MAC