From 987061aedd3714c34fb13c15710fcf3707083159 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 21 Jul 2019 13:52:59 +0200 Subject: [PATCH] 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. --- bin/doom-doctor | 2 +- core/autoload/format.el | 231 +++++++++++++++++++++++++++++++++++++++ core/autoload/message.el | 132 ---------------------- 3 files changed, 232 insertions(+), 133 deletions(-) create mode 100644 core/autoload/format.el delete mode 100644 core/autoload/message.el diff --git a/bin/doom-doctor b/bin/doom-doctor index 51dfede90..119d4b741 100755 --- a/bin/doom-doctor +++ b/bin/doom-doctor @@ -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) diff --git a/core/autoload/format.el b/core/autoload/format.el new file mode 100644 index 000000000..7c986e9d4 --- /dev/null +++ b/core/autoload/format.el @@ -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))) diff --git a/core/autoload/message.el b/core/autoload/message.el deleted file mode 100644 index b2b0d6aa0..000000000 --- a/core/autoload/message.el +++ /dev/null @@ -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)))