;;; -*- lexical-binding: t -*- (require 'cl-lib) (cl-pushnew "." load-path :test #'string=) (require 'luki-lisp) (-> 'll-frame) (-> 'bad-face-clrs) ;; ----------------------------------------------------------------------------- (defun get-color (x vt) (if (gfx) (x-get-resource (@f "color%d" x) "*") vt)) ;; (when (gfx) (x-get-resource (@f "color%d" 0) "*")) ; DNC? ;; ----------------------------------------------------------------------------- (defun monospace-fonts () (seq-filter (L (f) (when-let* ((info (font-info f))) (string-match-p "spacing=100" (aref info 1)))) (font-family-list))) (let ((fonts (cl-delete-duplicates (monospace-fonts))) (i 0)) (defun next-monospace (&optional n) (i) (or n (setf n 1)) (when-let* ((font (nth (m (++ i n) (--- fonts)) fonts))) (set-frame-font font t) (fullscreen) ($ "font: %s" font))) (defun prev-monospace (&optional n) (i) (next-monospace (if n (- n) -1))) (declare-function next-monospace nil) (declare-function prev-monospace nil)) (keymap-global-set "M--" #'prev-monospace) (keymap-global-set "M-=" #'next-monospace) ;; ---------------------------------------------------------------------------yx ;; the ys are at col 79 ;; ---------------------------------------------------------------------------yx (defun set-all-faces (&optional a) (i) (cl-loop with old = (face-attribute 'default :height) with font = (or (face-attribute 'default :family) "OCRA") with w = 'normal with stp = 4 ; note: smaller DNC with h-def = 100 with hf = (cond ((ni a) (cond ; INTEGER: ((< a (- stp)) (- old (abs a))) ; reduce x on -x ((< a 0) (- old stp)) ; reduce stp ((= a 0) old) ; (see below) ((< 0 a (1+ stp)) (+ stp old)) ; increase stp (a))) ; set to a ((floatp a) (floor a)) ; FLOAT: crashes on e.g. 107.5 ((functionp a) (funcall a old))) ; FUNCTION: set to a(old) ;; SAFE: try to just hold down the key to reduce ;; it will start over at the default when below 3 ;; "if anything can start anew, then everything must continue" with h = (or (& (ni hf) (< stp hf) hf) h-def) with fs = (face-list) initially (goto-char (pos-bol)) (setf a (& (lu current-prefix-arg) (1st current-prefix-arg))) for f in fs do ;; ZERO: set all faces foreground to unspecified (when (z a) (set-face-attribute f nil :foreground 'unspecified)) ;; ALWAYS: do this (set-face-attribute f nil :font font :height h :width w :underline nil) finally (prog1 h (when (functionp 'window-char-resolution) ($ " %s (%d%%)" (window-char-resolution nil t t) h))))) (keymap-global-set "C-0" #'set-all-faces) (keymap-global-set "C-)" (L () (set-all-faces 0))) (keymap-global-set "C--" (L () (set-all-faces -1))) (keymap-global-set "C-=" (L () (set-all-faces 1))) ;; ----------------------------------------------------------------------------x ;; test area 51 col 80 ->x ;; ----------------------------------------------------------------------------x ;; (set-all-faces) ; set to the default value, 100 ;; (set-all-faces nil) ; .. ;; (set-all-faces t) ; .. ;; (let ((current-prefix-arg '(120))) (call-interactively #'set-all-faces)) ; set to 120 ;; (let ((current-prefix-arg '(110))) (call-interactively #'set-all-faces)) ; .. .. 110 ;; (let ((current-prefix-arg '(-10))) (call-interactively #'set-all-faces)) ; reduce 10 ;; (set-all-faces -50) ; reduce 50 ;; (set-all-faces -5) ; .. 5 ;; (set-all-faces -3) ; .. 3 ;; (set-all-faces -2) ; as -2 is too small, treat it as -3 ;; (set-all-faces -1) ; .. ;; (set-all-faces 0) ; still set it to the old value ;; (set-all-faces 1) ; as +1 is too small, treat it as 3 ;; (set-all-faces 2) ; .. ;; (set-all-faces 3) ; increase 3 ;; (set-all-faces 105) ; set to 105 ;; (set-all-faces 107) ; .. .. 107, noticable from 108 to 107, but not from 105 ;; (set-all-faces 108) ; .. .. 108 ;; (set-all-faces #'1-) ; nothing happens as +/- 1 is too small ;; (set-all-faces #'1+) ; .. ;; (set-all-faces (L (e) (cl-incf e 8))) ; increase 8 ;; (set-all-faces (L (e) (cl-decf e 16))) ; reduce 16 ;; ----------------------------------------------------------------------------- (defun what-face (pos) (interactive "d") (let ((face (or (get-char-property pos 'face) (get-char-property pos 'read-cf-name)))) (if face (when-let* ((face-str (@f "%s" face))) (kill-new face-str) ($ face-str)) ($ "No face!")))) ;; ----------------------------------------------------------------------------- (defun set-face (face fg &optional bold bg) (setf bold (if bold 'bold 'normal)) (setf bg (if bg bg (face-bg 'our-black))) (set-face-attribute face nil :foreground fg :background bg :weight bold)) ;; ----------------------------------------------------------------------------- (font-lock-add-keywords 'emacs-lisp-mode '( ("our-black-b" . 'font-lock-doc-face) ("our-red-b" . 'font-lock-type-face) ("our-green-b" . 'font-lock-keyword-face) ("our-yellow-b" . 'font-lock-preprocessor-face) ("our-blue-b" . 'font-lock-comment-face) ("our-magenta-b" . 'font-lock-constant-face) ("our-cyan-b" . 'font-lock-function-name-face) ("our-white-b" . 'font-lock-operator-face) ("\\#'[-[:alnum:]]+" . 'font-lock-function-name-face) ("1-" . 'font-lock-preprocessor-face) ("1\\+" . 'font-lock-keyword-face) ("?[\\]\\{,1\\}." . 'font-lock-constant-face) ("\\#[[:digit:]]=" . 'font-lock-preprocessor-face) ("\\#[[:digit:]]\\#" . 'font-lock-doc-face) ("font-lock-builtin-face" . 'font-lock-builtin-face) ("font-lock-comment-delimiter-face" . 'font-lock-comment-delimiter-face) ("font-lock-comment-face" . 'font-lock-comment-face) ("font-lock-constant-face" . 'font-lock-constant-face) ("font-lock-doc-face" . 'font-lock-doc-face) ("font-lock-function-name-face" . 'font-lock-function-name-face) ("font-lock-keyword-face" . 'font-lock-keyword-face) ("font-lock-negation-char-face" . 'font-lock-negation-char-face) ("font-lcok-operator-face" . 'font-lock-operator-face) ("font-lock-preprocessor-face" . 'font-lock-preprocessor-face) ("font-lock-regexp-grouping-backslash" . 'font-lock-regexp-grouping-backslash) ("font-lock-regexp-grouping-construct" . 'font-lock-regexp-grouping-construct) ("font-lock-string-face" . 'font-lock-string-face) ("font-lock-type-face" . 'font-lock-type-face) ("font-lock-variable-name-face" . 'font-lock-variable-name-face) ("font-lock-warning-face" . 'font-lock-warning-face)) t) (set-face 'font-lock-builtin-face (face-fg 'our-cyan-b) t) (set-face 'font-lock-comment-delimiter-face (face-fg 'our-blue-b) t) (set-face 'font-lock-comment-face (face-fg 'our-blue-b) t) (set-face 'font-lock-constant-face (face-fg 'our-magenta-b) t) (set-face 'font-lock-doc-face (face-fg 'our-black-b) t) (set-face 'font-lock-function-name-face (face-fg 'our-cyan-b) t) (set-face 'font-lock-keyword-face (face-fg 'our-green-b) t) (set-face 'font-lock-negation-char-face (face-fg 'our-black-b) t) (set-face 'font-lock-operator-face (face-fg 'our-white-b) t) (set-face 'font-lock-preprocessor-face (face-fg 'our-yellow-b) t) (set-face 'font-lock-regexp-grouping-backslash (face-fg 'our-blue-b) t) (set-face 'font-lock-regexp-grouping-construct (face-fg 'our-yellow-b) t) (set-face 'font-lock-string-face (face-fg 'our-magenta-b) t) (set-face 'font-lock-type-face (face-fg 'our-red-b) t) (set-face 'font-lock-variable-name-face (face-fg 'our-white-b) t) ;; ----------------------------------------------------------------------------- ;; mode line ;; ----------------------------------------------------------------------------- (set-face-attribute 'mode-line-active nil :foreground (face-fg 'our-black) :background (face-fg 'our-white)) (set-face-attribute 'mode-line-inactive nil :foreground (face-fg 'our-white-b) :background (face-fg 'our-black-b)) (setq-default mode-line-format "%8 %l %C %q %8 %[ %b %* %]") ;; ----------------------------------------------------------------------------- ;; faces ;; ----------------------------------------------------------------------------- (set-face 'default (face-fg 'our-white-b) t (face-bg 'our-black)) (set-face-attribute 'region nil :background "#875fd7") ;; ----------------------------------------------------------------------------- (<- 'll-face) ;; -----------------------------------------------------------------------------