Change doom-ansi-apply, print! & format!

Color let-functions no longer take format string arguments. e.g.

  (format! (red "Hello %s" "world"))

Becomes

  (format! (red "Hello %s") "world")

The same goes for print!. Also, doom-ansi-apply now takes two arguments
instead of three.

Also merges doom-message-{fg,bg,fx} into doom-ansi-alist, and reduces
backtrace noise when errors originate from inside these macros.
This commit is contained in:
Henrik Lissner 2018-09-07 21:56:07 -04:00
parent f7ad520ee0
commit 4d10c28c37
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
5 changed files with 60 additions and 68 deletions

View file

@ -1,29 +1,8 @@
;;; core/autoload/message.el -*- lexical-binding: t; -*-
(defconst doom-message-fg
'((black 30 term-color-black)
(red 31 term-color-red)
(green 32 term-color-green)
(yellow 33 term-color-yellow)
(blue 34 term-color-blue)
(magenta 35 term-color-magenta)
(cyan 36 term-color-cyan)
(white 37 term-color-white))
"List of text colors.")
(defconst doom-message-bg
'((on-black 40 term-color-black)
(on-red 41 term-color-red)
(on-green 42 term-color-green)
(on-yellow 43 term-color-yellow)
(on-blue 44 term-color-blue)
(on-magenta 45 term-color-magenta)
(on-cyan 46 term-color-cyan)
(on-white 47 term-color-white))
"List of colors to draw text on.")
(defconst doom-message-fx
'((bold 1 :weight bold)
(defvar doom-ansi-alist
'(;; fx
(bold 1 :weight bold)
(dark 2)
(italic 3 :slant italic)
(underscore 4 :underline t)
@ -31,48 +10,62 @@
(rapid 6)
(contrary 7)
(concealed 8)
(strike 9 :strike-through t))
"List of styles.")
(strike 9 :strike-through t)
;; fg
(black 30 term-color-black)
(red 31 term-color-red)
(green 32 term-color-green)
(yellow 33 term-color-yellow)
(blue 34 term-color-blue)
(magenta 35 term-color-magenta)
(cyan 36 term-color-cyan)
(white 37 term-color-white)
;; bg
(on-black 40 term-color-black)
(on-red 41 term-color-red)
(on-green 42 term-color-green)
(on-yellow 43 term-color-yellow)
(on-blue 44 term-color-blue)
(on-magenta 45 term-color-magenta)
(on-cyan 46 term-color-cyan)
(on-white 47 term-color-white))
"TODO")
;;;###autoload
(defun doom-ansi-apply (code message &rest args)
(defun doom-ansi-apply (style text)
"Apply CODE to formatted MESSAGE with ARGS. CODE is derived from any of
`doom-message-fg', `doom-message-bg' or `doom-message-fx'.
In a noninteractive session, this wraps the result in ansi color codes.
Otherwise, it maps colors to a term-color-* face."
(let ((text (apply #'format message args)))
(let ((code (cadr (assq style doom-ansi-alist))))
(if noninteractive
(format "\e[%dm%s\e[%dm"
(cadr
(or (assq code doom-message-fg)
(assq code doom-message-bg)
(assq code doom-message-fx)))
(cadr (assq style doom-ansi-alist))
text 0)
(require 'term) ; piggyback on term's color faces
(propertize
text 'face
(append (get-text-property 0 'face text)
(let (spec)
(cond ((setq spec (caddr (assq code doom-message-fg)))
`(:foreground ,(face-foreground spec)))
((setq spec (caddr (assq code doom-message-bg)))
`(:background ,(face-background spec)))
((cddr (assq code doom-message-fx)))))))))
(cond ((>= code 40)
`(:background ,(caddr (assq style doom-ansi-alist))))
((>= code 30)
`(:foreground ,(face-foreground (caddr (assq style doom-ansi-alist)))))
((cddr (assq style doom-ansi-alist))))))))))
;;;###autoload
(defmacro format! (message &rest args)
"An alternative to `format' that understands (color ...) and converts them
into faces or ANSI codes depending on the type of sesssion we're in."
`(cl-flet*
(,@(cl-loop for rule
in (append doom-message-fg doom-message-bg doom-message-fx)
collect
`(,(car rule)
(lambda (message &rest args)
(apply #'doom-ansi-apply ',(car rule) message args))))
(,@(mapcar (lambda (rule) `(,(car rule)
(lambda (message)
(doom-ansi-apply ',(car rule) message))))
doom-ansi-alist)
(color
(lambda (code format &rest args)
(apply #'doom-ansi-apply code format args))))
(lambda (code format)
(doom-ansi-apply code format))))
(format ,message ,@args)))
;;;###autoload
@ -82,9 +75,9 @@ standard out).
Can be colored using (color ...) blocks:
(print! \"Hello %s %s\" (bold (blue \"How are you?\")))
(print! \"Hello %s %s\" (red \"World\"))
(print! (green \"Great %s!\" \"success\"))
(print! \"Hello %s\" (bold (blue \"How are you?\")))
(print! \"Hello %s\" (red \"World\"))
(print! (green \"Great %s!\") \"success\")
Uses faces in interactive sessions and ANSI codes otherwise."
`(if (not noninteractive)

View file

@ -17,14 +17,14 @@
`(condition-case-unless-debug e
(progn ,@body)
('user-error
(print! (bold (red " NOTICE: %s" e))))
(print! (bold (red " NOTICE: %s")) e))
('file-error
(print! (bold (red " FILE ERROR: %s" (error-message-string e))))
(print! (bold (red " FILE ERROR: %s")) (error-message-string e))
(print! " Trying again...")
(quiet! (doom-refresh-packages-maybe t))
,@body)
('error
(print! (bold (red " FATAL ERROR: %s\n Run again with the -d flag for details" e))))))
(print! (bold (red " FATAL ERROR: %s\n Run again with the -d flag for details")) e))))
(defun doom--refresh-pkg-cache ()
"Clear the cache for `doom-refresh-packages-maybe'."

View file

@ -156,10 +156,9 @@
(doom--condition-case!
(let ((result (doom-delete-package pkg t)))
(if result (setq success t))
(print! (color (if result 'green 'red)
"%s %s"
(print! (color (if result 'green 'red) "%s %s")
(if result "✓ Removed" "✕ Failed to remove")
pkg)))))
pkg))))
(print! (bold (green "Finished!")))
(when success
(set-file-times doom-packages-dir)

View file

@ -11,27 +11,27 @@
:to-equal "Hello World"))
(it "supports ansi coloring in noninteractive sessions"
(expect (format! (red "Hello %s" "World"))
(expect (format! (red "Hello %s") "World")
:to-equal "Hello World"))
(it "supports faces in interactive sessions"
(let (noninteractive)
(expect (get-text-property 0 'face (format! (red "Hello %s" "World")))
(expect (get-text-property 0 'face (format! (red "Hello %s") "World"))
:to-equal (list :foreground (face-foreground 'term-color-red)))))
(it "supports nested color specs"
(expect (format! (bold (red "Hello %s" "World")))
(expect (format! (bold (red "Hello %s")) "World")
:to-equal (format "\e[%dm%s\e[0m" 1
(format "\e[%dm%s\e[0m" 31 "Hello World")))
(expect (format! (on-red (bold "Hello %s" "World")))
(expect (format! (on-red (bold "Hello %s")) "World")
:to-equal (format "\e[%dm%s\e[0m" 41
(format "\e[%dm%s\e[0m" 1 "Hello World")))
(expect (format! (dark (white "Hello %s" "World")))
(expect (format! (dark (white "Hello %s")) "World")
:to-equal (format "\e[%dm%s\e[0m" 2
(format "\e[%dm%s\e[0m" 37 "Hello World"))))
(it "supports dynamic color apply syntax"
(expect (format! (color 'red "Hello %s" "World"))
:to-equal (format! (red "Hello %s" "World")))
(expect (format! (color (if nil 'red 'blue) "Hello %s" "World"))
:to-equal (format! (blue "Hello %s" "World"))))))
(expect (format! (color 'red "Hello %s") "World")
:to-equal (format! (red "Hello %s") "World"))
(expect (format! (color (if nil 'red 'blue) "Hello %s") "World")
:to-equal (format! (blue "Hello %s") "World")))))

View file

@ -115,9 +115,9 @@ If ARG (universal argument), open selection in other-window."
"\\):?\\s-*\\(.+\\)")
x)
(error
(print! (red "Error matching task in file: (%s) %s"
(print! (red "Error matching task in file: (%s) %s")
(error-message-string ex)
(car (split-string x ":"))))
(car (split-string x ":")))
nil))
collect `((type . ,(match-string 3 x))
(desc . ,(match-string 4 x))