Rewrite autoload/message.el & move to format.el
Adds new convenience macros like print! and insert!, and adds classes; which are helper functions that can be called inline within format!, print! et co, e.g. (format! "%s" (filename "/tmp/some/file")) ; => file (format! "%s" (relpath "/tmp/some/file" "/tmp")) ; => some/file (format! "%s" (dirname "/tmp/some/file")) ; => /tmp/some Check out doom-format-class-alist for more.
This commit is contained in:
Henrik Lissner
parent
99e23adec1
commit
987061aedd
3 changed files with 232 additions and 133 deletions
|
|
@ -28,7 +28,7 @@
|
|||
(setq debug-on-error t))
|
||||
|
||||
(require 'pp)
|
||||
(load (expand-file-name "core/autoload/message" user-emacs-directory) nil t)
|
||||
(load (expand-file-name "core/autoload/format" user-emacs-directory) nil t)
|
||||
|
||||
|
||||
(defvar doom-init-p nil)
|
||||
|
|
|
|||
231
core/autoload/format.el
Normal file
231
core/autoload/format.el
Normal file
|
|
@ -0,0 +1,231 @@
|
|||
;;; core/autoload/format.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar doom-format-ansi-alist
|
||||
'(;; fx
|
||||
(bold 1 :weight bold)
|
||||
(dark 2)
|
||||
(italic 3 :slant italic)
|
||||
(underscore 4 :underline t)
|
||||
(blink 5)
|
||||
(rapid 6)
|
||||
(contrary 7)
|
||||
(concealed 8)
|
||||
(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))
|
||||
"An alist of fg/bg/fx names mapped to ansi codes and term-color-* variables.
|
||||
|
||||
This serves as the cipher for converting (COLOR ...) function calls in `print!'
|
||||
and `format!' into colored output, where COLOR is any car of this list.")
|
||||
|
||||
(defvar doom-format-class-alist
|
||||
`((color . doom--format-color)
|
||||
(class . doom--format-class)
|
||||
(indent . doom--format-indent)
|
||||
(autofill . doom--format-autofill)
|
||||
|
||||
(success . (lambda (str &rest args)
|
||||
(apply #'doom--format-color 'green (format "✓ %s" str) args)))
|
||||
(warn . (lambda (str &rest args)
|
||||
(apply #'doom--format-color 'yellow (format "! %s" str) args)))
|
||||
(error . (lambda (str &rest args)
|
||||
(apply #'doom--format-color 'red (format "x %s" str) args)))
|
||||
(info . (lambda (str &rest args)
|
||||
(concat "- " (if args (apply #'format str args) str))))
|
||||
(start . (lambda (str &rest args)
|
||||
(concat "> " (if args (apply #'format str args) str))))
|
||||
(debug . (lambda (str &rest args) (if doom-debug-mode (apply #'format str args) "")))
|
||||
(path . abbreviate-file-name)
|
||||
(symbol . symbol-name)
|
||||
(relpath . (lambda (str &optional dir)
|
||||
(let ((dir (or dir (file-truename default-directory)))
|
||||
(str (file-truename str)))
|
||||
(if (file-in-directory-p str dir)
|
||||
(file-relative-name str dir)
|
||||
(abbreviate-file-name str)))))
|
||||
(filename . file-name-nondirectory)
|
||||
(dirname . (lambda (path)
|
||||
(unless (file-directory-p path)
|
||||
(setq path (file-name-directory path)))
|
||||
(directory-file-name path))))
|
||||
"An alist of text classes that map to transformation functions.
|
||||
|
||||
Any of these classes can be called like functions from within `format!' and
|
||||
`print!' calls, which will transform their input.")
|
||||
|
||||
(defvar doom-format-indent 0
|
||||
"Level to rigidly indent text returned by `format!' and `print!'.")
|
||||
|
||||
(defvar doom-format-backend
|
||||
(if noninteractive 'ansi 'text-properties)
|
||||
"Determines whether to print colors with ANSI codes or with text properties.
|
||||
|
||||
Accepts 'ansi and 'text-properties. nil means don't render colors.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
(defun doom--format (output)
|
||||
(if (string-empty-p (string-trim output))
|
||||
""
|
||||
(concat (make-string doom-format-indent 32)
|
||||
(replace-regexp-in-string
|
||||
"\n" (concat "\n" (make-string doom-format-indent 32))
|
||||
output t t))))
|
||||
|
||||
(defun doom--format-print (output)
|
||||
(unless (string-empty-p output)
|
||||
(if (not noninteractive)
|
||||
(message "%s" output)
|
||||
(princ output)
|
||||
(terpri)) ; newline
|
||||
t))
|
||||
|
||||
(defun doom--format-indent (width text &optional prefix)
|
||||
"Indent TEXT by WIDTH spaces. If ARGS, format TEXT with them."
|
||||
(with-temp-buffer
|
||||
(setq text (format "%s" text))
|
||||
(insert text)
|
||||
(indent-rigidly (point-min) (point-max) width)
|
||||
(when (stringp prefix)
|
||||
(when (> width 2)
|
||||
(goto-char (point-min))
|
||||
(beginning-of-line-text)
|
||||
(delete-char (- (length prefix)))
|
||||
(insert prefix)))
|
||||
(buffer-string)))
|
||||
|
||||
(defun doom--format-autofill (&rest msgs)
|
||||
"Ensure MSG is split into lines no longer than `fill-column'."
|
||||
(with-temp-buffer
|
||||
(let ((fill-column 76))
|
||||
(dolist (line msgs)
|
||||
(when line
|
||||
(insert (format "%s" line))))
|
||||
(fill-region (point-min) (point-max))
|
||||
(buffer-string))))
|
||||
|
||||
(defun doom--format-color (style format &rest args)
|
||||
"Apply STYLE to formatted MESSAGE with ARGS.
|
||||
|
||||
STYLE is a symbol that correlates to `doom-format-ansi-alist'.
|
||||
|
||||
In a noninteractive session, this wraps the result in ansi color codes.
|
||||
Otherwise, it maps colors to a term-color-* face."
|
||||
(let* ((code (cadr (assq style doom-format-ansi-alist)))
|
||||
(format (format "%s" format))
|
||||
(message (if args (apply #'format format args) format)))
|
||||
(unless code
|
||||
(error "%S is an invalid color" style))
|
||||
(pcase doom-format-backend
|
||||
(`ansi
|
||||
(format "\e[%dm%s\e[%dm" code message 0))
|
||||
(`text-properties
|
||||
(require 'term) ; piggyback on term's color faces
|
||||
(propertize
|
||||
message
|
||||
'face
|
||||
(append (get-text-property 0 'face format)
|
||||
(cond ((>= code 40)
|
||||
`(:background ,(caddr (assq style doom-format-ansi-alist))))
|
||||
((>= code 30)
|
||||
`(:foreground ,(face-foreground (caddr (assq style doom-format-ansi-alist)))))
|
||||
((cddr (assq style doom-format-ansi-alist)))))))
|
||||
(_ message))))
|
||||
|
||||
(defun doom--format-class (class format &rest args)
|
||||
"Apply CLASS to formatted format with ARGS.
|
||||
|
||||
CLASS is derived from `doom-format-class-alist', and can contain any arbitrary,
|
||||
transformative logic."
|
||||
(let (fn)
|
||||
(cond ((setq fn (cdr (assq class doom-format-class-alist)))
|
||||
(if (functionp fn)
|
||||
(apply fn format args)
|
||||
(error "%s does not have a function" class)))
|
||||
(args (apply #'format format args))
|
||||
(format))))
|
||||
|
||||
(defun doom--format-apply (forms &optional sub)
|
||||
"Replace color-name functions with calls to `doom--format-color'."
|
||||
(cond ((null forms) nil)
|
||||
((listp forms)
|
||||
(append (cond ((not (symbolp (car forms)))
|
||||
(list (doom--format-apply (car forms))))
|
||||
(sub
|
||||
(list (car forms)))
|
||||
((assq (car forms) doom-format-ansi-alist)
|
||||
`(doom--format-color ',(car forms)))
|
||||
((assq (car forms) doom-format-class-alist)
|
||||
`(doom--format-class ',(car forms)))
|
||||
((list (car forms))))
|
||||
(doom--format-apply (cdr forms) t)
|
||||
nil))
|
||||
(forms)))
|
||||
|
||||
;;;###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."
|
||||
(declare (debug t))
|
||||
`(doom--format (format ,@(doom--format-apply `(,message ,@args)))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print-group! (&rest body)
|
||||
"Indents any `print!' or `format!' output within BODY."
|
||||
(declare (debug t))
|
||||
`(let ((doom-format-indent (+ 2 doom-format-indent)))
|
||||
,@body))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print! (message &rest args)
|
||||
"Uses `message' in interactive sessions and `princ' otherwise (prints to
|
||||
standard out).
|
||||
|
||||
Can be colored using (color ...) blocks:
|
||||
|
||||
(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."
|
||||
(declare (debug t))
|
||||
`(doom--format-print (format! ,message ,@args)))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro insert! (message &rest args)
|
||||
"Like `insert'; the last argument must be format arguments for MESSAGE.
|
||||
|
||||
\(fn MESSAGE... ARGS)"
|
||||
(declare (debug t))
|
||||
`(insert (format! (concat ,message ,@(butlast args))
|
||||
,@(car (last args)))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro error! (message &rest args)
|
||||
"Like `error', but with the power of `format!'."
|
||||
(declare (debug t))
|
||||
`(error (format! ,message ,@args)))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro user-error! (message &rest args)
|
||||
"Like `user-error', but with the power of `format!'."
|
||||
(declare (debug t))
|
||||
`(user-error (format! ,message ,@args)))
|
||||
|
|
@ -1,132 +0,0 @@
|
|||
;;; core/autoload/message.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar doom-ansi-alist
|
||||
'(;; fx
|
||||
(bold 1 :weight bold)
|
||||
(dark 2)
|
||||
(italic 3 :slant italic)
|
||||
(underscore 4 :underline t)
|
||||
(blink 5)
|
||||
(rapid 6)
|
||||
(contrary 7)
|
||||
(concealed 8)
|
||||
(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")
|
||||
|
||||
(defvar doom-message-backend
|
||||
(if noninteractive 'ansi 'text-properties)
|
||||
"Determines whether to print colors with ANSI codes or with text properties.
|
||||
|
||||
Accepts 'ansi and 'text-properties. nil means don't render colors.")
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-message-indent (width text &rest args)
|
||||
"Indent TEXT by WIDTH spaces. If ARGS, format TEXT with them."
|
||||
(with-temp-buffer
|
||||
(insert (apply #'format text args))
|
||||
(let ((fill-column 80))
|
||||
(fill-region (point-min) (point-max))
|
||||
(indent-rigidly (point-min) (point-max) width))
|
||||
(when (> width 2)
|
||||
(goto-char (point-min))
|
||||
(beginning-of-line-text)
|
||||
(delete-char -2)
|
||||
(insert "> "))
|
||||
(buffer-string)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-message-autofill (&rest msgs)
|
||||
"Ensure MSG is split into lines no longer than `fill-column'."
|
||||
(with-temp-buffer
|
||||
(let ((fill-column 70))
|
||||
(dolist (line msgs)
|
||||
(when line
|
||||
(insert line)))
|
||||
(fill-region (point-min) (point-max))
|
||||
(buffer-string))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-color-apply (style text &rest args)
|
||||
"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 ((code (car (cdr (assq style doom-ansi-alist))))
|
||||
(message (if args (apply #'format text args) text)))
|
||||
(pcase doom-message-backend
|
||||
(`ansi
|
||||
(format "\e[%dm%s\e[%dm"
|
||||
(car (cdr (assq style doom-ansi-alist)))
|
||||
message 0))
|
||||
(`text-properties
|
||||
(require 'term) ; piggyback on term's color faces
|
||||
(propertize
|
||||
message
|
||||
'face
|
||||
(append (get-text-property 0 'face text)
|
||||
(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)))))))
|
||||
(_ message))))
|
||||
|
||||
(defun doom--short-color-replace (forms)
|
||||
"Replace color-name functions with calls to `doom-color-apply'."
|
||||
(cond ((null forms) nil)
|
||||
((listp forms)
|
||||
(append (cond ((not (symbolp (car forms)))
|
||||
(list (doom--short-color-replace (car forms))))
|
||||
((assq (car forms) doom-ansi-alist)
|
||||
`(doom-color-apply ',(car forms)))
|
||||
((eq (car forms) 'color)
|
||||
(pop forms)
|
||||
`(doom-color-apply ,(car forms)))
|
||||
((memq (car forms) '(indent autofill))
|
||||
(let ((fn (pop forms)))
|
||||
`(,(intern (format "doom-message-%s" fn))
|
||||
,(car forms))))
|
||||
((list (car forms))))
|
||||
(doom--short-color-replace (cdr forms))
|
||||
nil))
|
||||
(forms)))
|
||||
|
||||
;;;###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."
|
||||
`(format ,@(doom--short-color-replace `(,message ,@args))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print! (message &rest args)
|
||||
"Uses `message' in interactive sessions and `princ' otherwise (prints to
|
||||
standard out).
|
||||
|
||||
Can be colored using (color ...) blocks:
|
||||
|
||||
(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."
|
||||
`(progn (princ (format! ,message ,@args))
|
||||
(terpri)))
|
||||
Loading…
Add table
Add a link
Reference in a new issue