;;; fancy-splash.el --- Generated package (no.6) from my config -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2024 TEC ;; ;; Author: TEC <https://code.tecosaur.net/tec> ;; Maintainer: TEC <contact@tecosaur.net> ;; Created: April 20, 2024 ;; Modified: April 20, 2024 ;; Version: 2024.04.20 ;; Homepage: https://code.tecosaur.net/tec/emacs-config ;; Package-Requires: ((emacs "29.1")) ;; ;; This file is not part of GNU Emacs. ;; ;;; Commentary: ;; ;; Generated package (no.6) from my config. ;; ;; During generation, dependency on other aspects of my configuration and ;; packages is inferred via (regexp-based) static analysis. While this seems ;; to do a good job, this method is imperfect. This code likely depends on ;; utilities provided by Doom, and if you try to run it in isolation you may ;; discover the code makes more assumptions. ;; ;; That said, I've found pretty good results so far. ;; ;;; Code: (defvar fancy-splash-image-directory (expand-file-name "misc/splash-images/" doom-user-dir) "Directory in which to look for splash image templates.") (defvar fancy-splash-image-template (expand-file-name "emacs-e-template.svg" fancy-splash-image-directory) "Default template svg used for the splash image. Colours are substituted as per `fancy-splash-template-colours'.") (defvar fancy-splash-template-colours '(("#111112" :face default :attr :foreground) ("#8b8c8d" :face shadow) ("#eeeeef" :face default :attr :background) ("#e66100" :face highlight :attr :background) ("#1c71d8" :face font-lock-keyword-face) ("#f5c211" :face font-lock-type-face) ("#813d9c" :face font-lock-constant-face) ("#865e3c" :face font-lock-function-name-face) ("#2ec27e" :face font-lock-string-face) ("#c01c28" :face error) ("#000001" :face ansi-color-black) ("#ff0000" :face ansi-color-red) ("#ff00ff" :face ansi-color-magenta) ("#00ff00" :face ansi-color-green) ("#ffff00" :face ansi-color-yellow) ("#0000ff" :face ansi-color-blue) ("#00ffff" :face ansi-color-cyan) ("#fffffe" :face ansi-color-white)) "Alist of colour-replacement plists. Each plist is of the form (\"$placeholder\" :doom-color 'key :face 'face). If the current theme is a doom theme :doom-color will be used, otherwise the colour will be face foreground.") (defun fancy-splash-check-buffer () "Check the current SVG buffer for bad colours." (interactive) (when (eq major-mode 'image-mode) (xml-mode)) (when (and (featurep 'rainbow-mode) (not (bound-and-true-p rainbow-mode))) (rainbow-mode 1)) (let* ((colours (mapcar #'car fancy-splash-template-colours)) (colourise-hex (lambda (hex) (propertize hex 'face `((:foreground ,(if (< 0.5 (cl-destructuring-bind (r g b) (x-color-values hex) ;; Values taken from `rainbow-color-luminance' (/ (+ (* .2126 r) (* .7152 g) (* .0722 b)) (* 256 255 1.0)))) "white" "black") (:background ,hex)))))) (cn 96) (colour-menu-entries (mapcar (lambda (colour) (cl-incf cn) (cons cn (cons (substring-no-properties colour) (format " (%s) %s %s" (propertize (char-to-string cn) 'face 'font-lock-keyword-face) (funcall colourise-hex colour) (propertize (symbol-name (plist-get (cdr (assoc colour fancy-splash-template-colours)) :face)) 'face 'shadow))))) colours)) (colour-menu-template (format "Colour %%s is unexpected! Should this be one of the following?\n %s %s to ignore %s to quit" (mapconcat #'cddr colour-menu-entries "\n") (propertize "SPC" 'face 'font-lock-keyword-face) (propertize "ESC" 'face 'font-lock-keyword-face))) (colour-menu-choice-keys (append (mapcar #'car colour-menu-entries) (list ?\s))) (buf (get-buffer-create "*fancy-splash-lint-colours-popup*")) (good-colour-p (lambda (colour) (or (assoc colour fancy-splash-template-colours) ;; Check if greyscale (or (and (= (length colour) 4) (= (aref colour 1) ; r (aref colour 2) ; g (aref colour 3))) ; b (and (= (length colour) 7) (string= (substring colour 1 3) ; rr = (substring colour 3 5)) ; gg (string= (substring colour 3 5) ; gg = (substring colour 5 7))))))) ; bb (prompt-to-replace (lambda (target) (with-current-buffer buf (erase-buffer) (insert (format colour-menu-template (funcall colourise-hex target))) (setq-local cursor-type nil) (set-buffer-modified-p nil) (goto-char (point-min))) (save-window-excursion (pop-to-buffer buf) (fit-window-to-buffer (get-buffer-window buf)) (car (alist-get (read-char-choice (format "Select replacement, %s-%s or SPC: " (char-to-string (caar colour-menu-entries)) (char-to-string (caar (last colour-menu-entries)))) colour-menu-choice-keys) colour-menu-entries)))))) (save-excursion (goto-char (point-min)) (while (re-search-forward "#[0-9A-Fa-f]\\{6\\}\\|#[0-9A-Fa-f]\\{3\\}" nil t) (recenter) (let* ((colour (match-string 0)) (replacement (and (not (funcall good-colour-p colour)) (funcall prompt-to-replace colour)))) (when replacement (replace-match replacement t t)))) (message "Done")))) (defvar fancy-splash-cache-dir (expand-file-name "theme-splashes/" doom-cache-dir)) (defvar fancy-splash-sizes `((:height 300 :min-height 50 :padding (0 . 2)) (:height 250 :min-height 42 :padding (2 . 4)) (:height 200 :min-height 35 :padding (3 . 3)) (:height 150 :min-height 28 :padding (3 . 3)) (:height 100 :min-height 20 :padding (2 . 2)) (:height 75 :min-height 15 :padding (2 . 1)) (:height 50 :min-height 10 :padding (1 . 0)) (:height 1 :min-height 0 :padding (0 . 0))) "List of plists specifying image sizing states. Each plist should have the following properties: - :height, the height of the image - :min-height, the minimum `frame-height' for image - :padding, a `+doom-dashboard-banner-padding' (top . bottom) padding specification to apply Optionally, each plist may set the following two properties: - :template, a non-default template file - :file, a file to use instead of template") (defun fancy-splash-filename (theme template height) "Get the file name for the splash image with THEME and of HEIGHT." (expand-file-name (format "%s-%s-%d.svg" theme (file-name-base template) height) fancy-splash-cache-dir)) (defun fancy-splash-generate-image (template height) "Create a themed image from TEMPLATE of HEIGHT. The theming is performed using `fancy-splash-template-colours' and the current theme." (with-temp-buffer (insert-file-contents template) (goto-char (point-min)) (if (re-search-forward "$height" nil t) (replace-match (number-to-string height) t t) (if (re-search-forward "height=\"100\\(?:\\.0[0-9]*\\)?\"" nil t) (progn (replace-match (format "height=\"%s\"" height) t t) (goto-char (point-min)) (when (re-search-forward "\\([ \t\n]\\)width=\"[\\.0-9]+\"[ \t\n]*" nil t) (replace-match "\\1"))) (warn "Warning! fancy splash template: neither $height nor height=100 not found in %s" template))) (dolist (substitution fancy-splash-template-colours) (goto-char (point-min)) (let* ((replacement-colour (face-attribute (plist-get (cdr substitution) :face) (or (plist-get (cdr substitution) :attr) :foreground) nil 'default)) (replacement-hex (if (string-prefix-p "#" replacement-colour) replacement-colour (apply 'format "#%02x%02x%02x" (mapcar (lambda (c) (ash c -8)) (color-values replacement-colour)))))) (while (search-forward (car substitution) nil t) (replace-match replacement-hex nil nil)))) (unless (file-exists-p fancy-splash-cache-dir) (make-directory fancy-splash-cache-dir t)) (let ((inhibit-message t)) (write-region nil nil (fancy-splash-filename (car custom-enabled-themes) template height))))) (defun fancy-splash-generate-all-images () "Perform `fancy-splash-generate-image' in bulk." (dolist (size fancy-splash-sizes) (unless (plist-get size :file) (fancy-splash-generate-image (or (plist-get size :template) fancy-splash-image-template) (plist-get size :height))))) (defun fancy-splash-ensure-theme-images-exist (&optional height) "Ensure that the relevant images exist. Use the image of HEIGHT to check, defaulting to the height of the first specification in `fancy-splash-sizes'. If that file does not exist for the current theme, `fancy-splash-generate-all-images' is called. " (unless (file-exists-p (fancy-splash-filename (car custom-enabled-themes) fancy-splash-image-template (or height (plist-get (car fancy-splash-sizes) :height)))) (fancy-splash-generate-all-images))) (defun fancy-splash-clear-cache (&optional delete-files) "Clear all cached fancy splash images. Optionally delete all cache files and regenerate the currently relevant set." (interactive (list t)) (dolist (size fancy-splash-sizes) (unless (plist-get size :file) (let ((image-file (fancy-splash-filename (car custom-enabled-themes) (or (plist-get size :template) fancy-splash-image-template) (plist-get size :height)))) (image-flush (create-image image-file) t)))) (message "Fancy splash image cache cleared!") (when delete-files (delete-directory fancy-splash-cache-dir t) (fancy-splash-generate-all-images) (message "Fancy splash images cache deleted!"))) (defun fancy-splash-switch-template () "Switch the template used for the fancy splash image." (interactive) (let ((new (completing-read "Splash template: " (mapcar (lambda (template) (replace-regexp-in-string "-template\\.svg$" "" template)) (directory-files fancy-splash-image-directory nil "-template\\.svg\\'")) nil t))) (setq fancy-splash-image-template (expand-file-name (concat new "-template.svg") fancy-splash-image-directory)) (fancy-splash-clear-cache) (message "") ; Clear message from `fancy-splash-clear-cache'. (setq fancy-splash--last-size nil) (fancy-splash-apply-appropriate-image))) (defun fancy-splash-get-appropriate-size () "Find the firt `fancy-splash-sizes' with min-height of at least frame height." (let ((height (frame-height))) (cl-some (lambda (size) (when (>= height (plist-get size :min-height)) size)) fancy-splash-sizes))) (setq fancy-splash--last-size nil) (setq fancy-splash--last-theme nil) (defun fancy-splash-apply-appropriate-image (&rest _) "Ensure the appropriate splash image is applied to the dashboard. This function's signature is \"&rest _\" to allow it to be used in hooks that call functions with arguments." (let ((appropriate-size (fancy-splash-get-appropriate-size))) (unless (and (equal appropriate-size fancy-splash--last-size) (equal (car custom-enabled-themes) fancy-splash--last-theme)) (unless (plist-get appropriate-size :file) (fancy-splash-ensure-theme-images-exist (plist-get appropriate-size :height))) (setq fancy-splash-image (or (plist-get appropriate-size :file) (fancy-splash-filename (car custom-enabled-themes) fancy-splash-image-template (plist-get appropriate-size :height))) +doom-dashboard-banner-padding (plist-get appropriate-size :padding) fancy-splash--last-size appropriate-size fancy-splash--last-theme (car custom-enabled-themes)) (+doom-dashboard-reload)))) (provide 'fancy-splash) ;;; fancy-splash.el ends here