Files
.emacs.d/lisp/fix-theme-colors.el

242 lines
8.7 KiB
EmacsLisp

#!/usr/bin/env emacs --script
;;; fix-theme-colors.el --- Fix invalid color names and properties in Emacs themes
;; This scipt is AI generated.
;; This script fixes common issues in color-theme files:
;; 1. Space-separated color names (e.g., "deep sky blue" -> "DeepSkyBlue")
;; 2. Invalid color names (e.g., "PaleYellow" -> "LightYellow")
;; 3. Negative line-width values in :box properties
;; 4. Removes compiled .elc files to force reload of fixed sources
(require 'cl-lib)
(defvar theme-fixes-space
'(("deep sky blue" . "DeepSkyBlue")
("spring green" . "SpringGreen")
("light blue" . "LightBlue")
("lime green" . "LimeGreen")
("dark green" . "DarkGreen")
("dim gray" . "DimGray")
("forest green" . "ForestGreen")
("light gray" . "LightGray")
("light pink" . "LightPink")
("medium purple" . "MediumPurple")
("pale green" . "PaleGreen")
("medium aquamarine" . "MediumAquamarine")
("powder blue" . "PowderBlue")
("dark olive green" . "DarkOliveGreen")
("dark slate blue" . "DarkSlateBlue")
("dark slate grey" . "DarkSlateGrey")
("dark turquoise" . "DarkTurquoise")
("dark violet" . "DarkViolet")
("deep pink" . "DeepPink")
("dodger blue" . "DodgerBlue")
("floral white" . "FloralWhite")
("ghost white" . "GhostWhite")
("green yellow" . "GreenYellow")
("hot pink" . "HotPink")
("indian red" . "IndianRed")
("lavender blush" . "LavenderBlush")
("lawn green" . "LawnGreen")
("lemon chiffon" . "LemonChiffon")
("light coral" . "LightCoral")
("light cyan" . "LightCyan")
("light goldenrod" . "LightGoldenrod")
("light goldenrod yellow" . "LightGoldenrodYellow")
("light salmon" . "LightSalmon")
("light sea green" . "LightSeaGreen")
("light sky blue" . "LightSkyBlue")
("light slate blue" . "LightSlateBlue")
("light slate gray" . "LightSlateGray")
("light steel blue" . "LightSteelBlue")
("light yellow" . "LightYellow")
("medium blue" . "MediumBlue")
("medium orchid" . "MediumOrchid")
("medium sea green" . "MediumSeaGreen")
("medium slate blue" . "MediumSlateBlue")
("medium spring green" . "MediumSpringGreen")
("medium turquoise" . "MediumTurquoise")
("medium violet red" . "MediumVioletRed")
("midnight blue" . "MidnightBlue")
("mint cream" . "MintCream")
("misty rose" . "MistyRose")
("navajo white" . "NavajoWhite")
("navy blue" . "NavyBlue")
("old lace" . "OldLace")
("olive drab" . "OliveDrab")
("orange red" . "OrangeRed")
("pale goldenrod" . "PaleGoldenrod")
("pale turquoise" . "PaleTurquoise")
("pale violet red" . "PaleVioletRed")
("papaya whip" . "PapayaWhip")
("peach puff" . "PeachPuff")
("rosy brown" . "RosyBrown")
("royal blue" . "RoyalBlue")
("saddle brown" . "SaddleBrown")
("sandy brown" . "SandyBrown")
("sea green" . "SeaGreen")
("sky blue" . "SkyBlue")
("slate blue" . "SlateBlue")
("slate gray" . "SlateGray")
("spring green" . "SpringGreen")
("steel blue" . "SteelBlue")
("white smoke" . "WhiteSmoke")
("yellow green" . "YellowGreen")
("antique white" . "AntiqueWhite")
("blanched almond" . "BlanchedAlmond")
("blue violet" . "BlueViolet")
("burlywood" . "Burlywood")
("cadet blue" . "CadetBlue")
("chartreuse" . "Chartreuse")
("chocolate" . "Chocolate")
("cornflower blue" . "CornflowerBlue")
("cornsilk" . "Cornsilk")
("dark blue" . "DarkBlue")
("dark cyan" . "DarkCyan")
("dark goldenrod" . "DarkGoldenrod")
("dark gray" . "DarkGray")
("dark grey" . "DarkGrey")
("dark khaki" . "DarkKhaki")
("dark magenta" . "DarkMagenta")
("dark orange" . "DarkOrange")
("dark orchid" . "DarkOrchid")
("dark red" . "DarkRed")
("dark salmon" . "DarkSalmon")
("dark sea green" . "DarkSeaGreen"))
"Mapping of space-separated color names to CamelCase.")
(defvar theme-fixes-invalid
'(("PaleYellow" . "LightYellow")
("Blue-Eshell" . "DeepSkyBlue"))
"Mapping of invalid color names to valid alternatives.")
(defvar theme-fixes-box
'((":style none" . ":style nil")
(":line-width -1" . ":line-width 1"))
"Fixes for invalid :box properties.")
(defvar theme-fixes-box-family
'((":family \"helv\"" . "")
(":family \"outline-lucida console\"" . ""))
"Remove invalid :family property inside :box.")
(defun fix-theme-file (filepath)
"Fix all issues in a single theme file."
(message "Processing: %s" filepath)
(let ((content (with-temp-buffer
(insert-file-contents filepath)
(buffer-string)))
(changes 0))
;; Fix space-separated colors
(dolist (fix theme-fixes-space)
(let ((old-color (car fix))
(new-color (cdr fix))
(case-fold-search nil))
(when (string-match (regexp-quote (format "\"%s\"" old-color)) content)
(setq content (replace-regexp-in-string
(regexp-quote (format "\"%s\"" old-color))
(format "\"%s\"" new-color)
content))
(setq changes (1+ changes)))))
;; Fix invalid colors
(dolist (fix theme-fixes-invalid)
(let ((old-color (car fix))
(new-color (cdr fix))
(case-fold-search nil))
(when (string-match (regexp-quote (format "\"%s\"" old-color)) content)
(setq content (replace-regexp-in-string
(regexp-quote (format "\"%s\"" old-color))
(format "\"%s\"" new-color)
content))
(setq changes (1+ changes)))))
;; Fix :box properties
(dolist (fix theme-fixes-box)
(let ((old-prop (car fix))
(new-prop (cdr fix)))
(when (string-match (regexp-quote old-prop) content)
(setq content (replace-regexp-in-string
(regexp-quote old-prop)
new-prop
content))
(setq changes (1+ changes)))))
;; Fix :family inside :box (invalid property)
(dolist (fix theme-fixes-box-family)
(let ((old-prop (car fix))
(new-prop (cdr fix)))
(when (string-match (regexp-quote old-prop) content)
(setq content (replace-regexp-in-string
(regexp-quote old-prop)
new-prop
content))
(setq changes (1+ changes)))))
(with-temp-file filepath
(insert content))
(message " Fixed %d issue(s)" changes)
changes))
(defun fix-all-themes (themes-dir)
"Fix all theme files in THEMES-DIR."
(let ((theme-files (directory-files themes-dir t "\\-theme\\.el$"))
(total-changes 0))
(dolist (file theme-files)
(setq total-changes (+ total-changes (fix-theme-file file))))
(message "\nTotal issues fixed across all themes: %d" total-changes)))
(defun remove-compiled-themes (build-dir)
"Remove all compiled .elc theme files to force reload of sources."
(let ((elc-files (directory-files build-dir t "\\-theme\\.elc$"))
(count 0))
(dolist (file elc-files)
(delete-file file)
(setq count (1+ count)))
(message "Removed %d compiled theme files (.elc)" count)))
;;;###autoload
(defun fix-theme-colors ()
"Fix invalid color names and properties in Emacs themes.
This function can be called interactively or from Lisp."
(interactive)
(let* ((themes-dir (expand-file-name "~/.emacs.d/straight/repos/replace-colorthemes/"))
(build-dir (expand-file-name "~/.emacs.d/straight/build/color-theme-modern/")))
(message "=== Fixing theme files ===\n")
;; Fix source files
(if (file-directory-p themes-dir)
(progn
(message "Processing source files in: %s" themes-dir)
(fix-all-themes themes-dir))
(message "WARNING: Source themes directory not found: %s" themes-dir))
(message "\n")
;; Fix build files (these are what Emacs actually loads)
(if (file-directory-p build-dir)
(progn
(message "Processing build files in: %s" build-dir)
(fix-all-themes build-dir)
(remove-compiled-themes build-dir))
(message "WARNING: Build themes directory not found: %s" build-dir))
(message "\n=== Done! ===")
(message "Restart Emacs to load fixed themes.")))
;; When run as a script (--script), execute the function
(when noninteractive
(fix-theme-colors))
;;;###autoload
(defun fix-theme-colors-add-to-load-path ()
"Add the directory containing this file to load-path."
(interactive)
(add-to-list 'load-path (file-name-directory load-file-name))
(message "Added %s to load-path" (file-name-directory load-file-name)))
(provide 'fix-theme-colors)
;;; fix-theme-colors.el ends here