;;; janus.el --- a simple package -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Jeet Ray
;; Author: Jeet Ray <aiern@protonmail.com>
;; Keywords: lisp
;; Version: 0.0.1
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Put a description of the package here
;;; Code:
(require 'cl-lib)
(require 's)
(require 'dash)
(require 'meq)
(defcustom meq/var/current-theme nil "The default theme.")
(defcustom meq/var/current-theme-mode nil "The default theme mode.")
(defvar meq/var/aliases '(:orange (orange flamingo-pink)))
(defvar meq/var/modes '(:light nil :dark nil))
(defvar meq/var/rainbow-identifiers-saturation-light 50)
(defvar meq/var/rainbow-identifiers-saturation-dark 30)
(setq rainbow-identifiers-cie-l*a*b*-color-count most-positive-fixnum)
(setq rainbow-identifiers-choose-face-function 'rainbow-identifiers-cie-l*a*b*-choose-face)
(mapc #'(lambda (color) (interactive)
(mapc #'(lambda (alias) (interactive)
(push alias (cl-getf meq/var/modes :light))) (cl-getf meq/var/aliases color)))
'(:orange))
(mapc #'(lambda (color) (interactive)
(mapc #'(lambda (alias) (interactive)
(push alias (cl-getf meq/var/modes :dark))) (cl-getf meq/var/aliases color)))
'())
(defvar meq/var/faces `(
;; Adapted From: http://ergoemacs.org/emacs/elisp_define_face.html
(flamingo-pink . (
;; :alternate ((((class color) (background light))
;; :foreground "#ab5dee" :bold t)
;; (((class color) (background dark))
;; :foreground "#fca78e" :bold t))
:alternate ((t (:foreground "#ab5dee" :bold t)))
:original ((t (:foreground "#fca78e" :bold t)))
:aliases ,(cl-getf meq/var/aliases :orange)))
(orange . (
;; :alternate ((((class color) (background light))
;; :foreground "#ab5dee" :bold t)
;; (((class color) (background dark))
;; :foreground "#ffb86c" :bold t))
:alternate ((t (:foreground "#ab5dee" :bold t)))
:original ((t (:foreground "#ffb86c" :bold t)))
:aliases ,(cl-getf meq/var/aliases :orange)))))
;;;###autoload
(defmacro meq/set-alternate-color (color) (interactive)
(face-spec-set
(meq/inconcat "meq/" (symbol-name color))
(cl-getf (cdr (assq color meq/var/faces)) :alternate)
'face-defface-spec))
;;;###autoload
(defmacro meq/set-original-color (color) (interactive)
(face-spec-set
(meq/inconcat "meq/" (symbol-name color))
(cl-getf (cdr (assq color meq/var/faces)) :original)
'face-defface-spec))
;;;###autoload
(defun meq/same-color-switch (name mode) (interactive)
(mapc #'(lambda (color) (interactive)
(let* ((contains-list (mapcar #'(lambda (alias) (interactive)
(and
(s-contains? (symbol-name alias) name)
(member alias (cl-getf
meq/var/modes
(meq/inconcat ":" mode))))) (cl-getf (cdr color) :aliases))))
(if (--any? (and it t) contains-list)
(eval `(meq/set-alternate-color ,(car color)))
(eval `(meq/set-original-color ,(car color)))))) meq/var/faces))
;; (mapc #'(lambda (color) (interactive)
;; (eval `(defface
;; ,(meq/inconcat "meq/" (symbol-name (car color)))
;; ',(cl-getf (cdr color) :original)
;; ,(symbol-name (car color))))) meq/var/faces)
(mapc #'(lambda (color) (interactive)
`(face-spec-set
,(meq/inconcat "meq/" (symbol-name (car color)))
',(cl-getf (cdr color) :original)
'face-defface-spec)) meq/var/faces)
;;;###autoload
(defun meq/first-char-numeric-p (hex)
(s-with hex
(s-chop-prefix "#")
(s-left 1)
(s-numeric?)))
(defmacro meq/rainbow-conditions (a b)
(and
(string= meq/var/current-theme-mode (symbol-name a))
(eval `(=
rainbow-identifiers-cie-l*a*b*-saturation
,(meq/inconcat "meq/var/rainbow-identifiers-" (symbol-name b))))))
;;;###autoload
(defun meq/load-theme (theme) (interactive)
(let* ((name (symbol-name theme))
(mode (car (last (split-string name "-"))))
(rmode (meq/inconcat "meq/var/rainbow-identifiers-saturation-" mode)))
;; Adapted From:
;; Answer: https://stackoverflow.com/a/18552615/10827766
;; User: https://stackoverflow.com/users/729907/drew
(save-excursion (setq meq/var/current-theme theme)
(customize-save-variable 'meq/var/current-theme theme)
(setq meq/var/current-theme-mode mode)
(customize-save-variable 'meq/var/current-theme-mode mode))
(meq/same-color-switch name mode)
(load-theme theme)
(when (featurep 'rainbow-identifiers)
(rainbow-identifiers-mode 0)
(if (string= meq/var/current-theme-mode "dark")
;; Adapted From:
;; Answer: https://emacs.stackexchange.com/a/29184/31428
;; User: https://emacs.stackexchange.com/users/897/lindydancer
(if (meq/first-char-numeric-p (face-attribute 'default :background))
(eval `(setq rainbow-identifiers-cie-l*a*b*-saturation ,rmode))
(setq rainbow-identifiers-cie-l*a*b*-saturation 275))
(eval `(setq rainbow-identifiers-cie-l*a*b*-saturation ,rmode)))
(rainbow-identifiers-mode 1))))
;;;###autoload
(defun meq/which-theme nil (interactive)
(meq/when-item-in-cla "--theme"
(let* ((name (meq/get-next-in-cla "--theme")))
(meq/load-theme (intern (concat
name
(if (meq/item-in-cla "--light") "-light" "-dark"))))
(delete "--dark" command-line-args))))
;;;###autoload
(defun meq/switch-theme-mode nil (interactive)
(meq/load-theme (intern (concat
(replace-regexp-in-string "-dark" "" (replace-regexp-in-string "-light" "" (symbol-name meq/var/current-theme)))
"-"
(if (string= meq/var/current-theme-mode "light") "dark" "light")))))
(provide 'janus)
;;; janus.el ends here