Generalize message! & format! (interactive vs noninteractive)

This commit is contained in:
Henrik Lissner 2017-04-15 03:14:03 -04:00
parent e48c6c5381
commit fedfa1ffad
3 changed files with 41 additions and 36 deletions

View file

@ -1,18 +1,18 @@
;;; message.el ;;; message.el
(defconst doom-ansi-fg (defconst doom-message-fg
'((reset . 0) '((reset . 0)
(black . 30) (black . 30)
(red . 31) (red . 31)
(green . 32) (green . 32)
(yellow . 33) (yellow . 33)
(blue . 34) (blue . 34)
(magenta . 35) (magenta . 35)
(cyan . 36) (cyan . 36)
(white . 37)) (white . 37))
"List of text colors.") "List of text colors.")
(defconst doom-ansi-bg (defconst doom-message-bg
'((on-black . 40) '((on-black . 40)
(on-red . 41) (on-red . 41)
(on-green . 42) (on-green . 42)
@ -23,7 +23,7 @@
(on-white . 47)) (on-white . 47))
"List of colors to draw text on.") "List of colors to draw text on.")
(defconst doom-ansi-fx (defconst doom-message-fx
'((bold . 1) '((bold . 1)
(dark . 2) (dark . 2)
(italic . 3) (italic . 3)
@ -41,11 +41,11 @@
interactive session." interactive session."
`(cl-flet* `(cl-flet*
(,@(mapcar (,@(mapcar
(lambda (ansi) (lambda (rule)
`(,(car ansi) `(,(car rule)
(lambda (message &rest args) (lambda (message &rest args)
(apply 'doom-ansi-apply ,(cdr ansi) message args)))) (apply 'doom-ansi-apply ',(car rule) message args))))
(append doom-ansi-fg doom-ansi-bg doom-ansi-fx)) (append doom-message-fg doom-message-bg doom-message-fx))
(color (symbol-function 'doom-ansi-apply))) (color (symbol-function 'doom-ansi-apply)))
(format ,message ,@args))) (format ,message ,@args)))
@ -53,22 +53,26 @@ interactive session."
(defmacro message! (message &rest args) (defmacro message! (message &rest args)
"An alternative to `message' that strips out ANSI codes if used in an "An alternative to `message' that strips out ANSI codes if used in an
interactive session." interactive session."
`(message (format! ,message ,@args))) `(if noninteractive
(message (format! ,message ,@args))
(let ((buf (get-buffer-create " *doom messages*")))
(with-current-buffer buf
(goto-char (point-max))
(let ((beg (point))
end)
(insert (format! ,message ,@args))
(setq end (point))
(ansi-color-apply-on-region beg end)))
(with-selected-window (doom-popup-buffer buf)
(goto-char (point-max))))))
;;;###autoload ;;;###autoload
(defun doom-ansi-apply (code format &rest args) (defun doom-ansi-apply (code format &rest args)
(if noninteractive (let ((rule (or (assq code doom-message-fg)
(format "\e[%dm%s\e[%sm" (assq code doom-message-bg)
(if (numberp code) (assq code doom-message-fx))))
code (format "\e[%dm%s\e[%dm"
(cdr (or (assq code doom-ansi-fg) (cdr rule)
(assq code doom-ansi-bg) (apply 'format format args)
(assq code doom-ansi-fx)))) 0)))
(apply 'format format args) 0)
(apply 'format format args)))
;; --- DOOM message buffer -----------------------------------------------------
;; TODO
;; (defun doom-message (message &rest args) (interactive))

View file

@ -60,7 +60,8 @@ is enabled/disabled.'")
;; :autoclose If non-nil, close popup if ESC is pressed from any buffer. ;; :autoclose If non-nil, close popup if ESC is pressed from any buffer.
shackle-rules shackle-rules
'(("^ ?\\*doom:.+\\*$" :size 40 :modeline t :regexp t) '(("^ ?\\*doom:.+\\*$" :size 40 :modeline t :regexp t)
("^ ?\\*doom .+\\*$" :size 30 :noselect t :regexp t) ("^ ?\\*doom .+\\*$" :size 10 :noselect t :regexp t)
("^ *doom message*" :size 10 :noselect t :autokill t)
("*Metahelp*" :size 0.5 :autokill t :autoclose t) ("*Metahelp*" :size 0.5 :autokill t :autoclose t)
("^\\*.+-Profiler-Report .+\\*$" :size 0.3 :regexp t :autokill t) ("^\\*.+-Profiler-Report .+\\*$" :size 0.3 :regexp t :autokill t)
("*minor-modes*" :size 0.5 :noselect t :autokill t) ("*minor-modes*" :size 0.5 :noselect t :autokill t)

View file

@ -1,6 +1,7 @@
;;; test/core/autoload/test-message.el ;;; test/core/autoload/test-message.el
(def-test-group! core/autoload/message (def-test-group! core/autoload/message
;; ansi messages
(ert-deftest ansi-format () (ert-deftest ansi-format ()
(let ((noninteractive t)) (let ((noninteractive t))
(should (equal (format! "Hello %s" "World") (should (equal (format! "Hello %s" "World")
@ -9,15 +10,15 @@
"Hello World")) "Hello World"))
(should (equal (format! (green "Hello %s" "World")) (should (equal (format! (green "Hello %s" "World"))
(format "\e[%dm%s\e[0m" (format "\e[%dm%s\e[0m"
(cdr (assq 'green doom-ansi-fg)) (cdr (assq 'green doom-message-fg))
"Hello World"))) "Hello World")))
(should (equal (format! (on-red "Hello %s" "World")) (should (equal (format! (on-red "Hello %s" "World"))
(format "\e[%dm%s\e[0m" (format "\e[%dm%s\e[0m"
(cdr (assq 'on-red doom-ansi-bg)) (cdr (assq 'on-red doom-message-bg))
"Hello World"))) "Hello World")))
(should (equal (format! (bold "Hello %s" "World")) (should (equal (format! (bold "Hello %s" "World"))
(format "\e[%dm%s\e[0m" (format "\e[%dm%s\e[0m"
(cdr (assq 'bold doom-ansi-fx)) (cdr (assq 'bold doom-message-fx))
"Hello World"))))) "Hello World")))))
(ert-deftest ansi-format-nested () (ert-deftest ansi-format-nested ()
@ -38,4 +39,3 @@
(format! (red "Hello %s" "World")))) (format! (red "Hello %s" "World"))))
(should (equal (format! (color (if nil 'red 'blue) "Hello %s" "World")) (should (equal (format! (color (if nil 'red 'blue) "Hello %s" "World"))
(format! (blue "Hello %s" "World"))))))) (format! (blue "Hello %s" "World")))))))