Face copier, speeds up frame creation for short term frame usage

config-exwm.org

@@ -616,50 +616,15 @@
 #+end_src
 * Floating windows don't need that many faces ^_^
 #+begin_src emacs-lisp
-  (defun my/frame-dont-copy-faces (frame &optional parameters)
-    "Initialize the frame-local faces of FRAME.
-  Calculate the face definitions using the face specs, custom theme
-  settings, X resources, and `face-new-frame-defaults'.
-  Finally, apply any relevant face attributes found amongst the
-  frame parameters in PARAMETERS."
-    ;; The `reverse' is so that `default' goes first.
-    (dolist (face (remove-if-not (lambda (x)
-                                   (let ((name (symbol-name x)))
-                                     (string-match-p "^doom-.*"
-                                                     name)))
-                                 (nreverse (face-list))))
-      (condition-case ()
-          (progn
-            ;; Initialize faces from face spec and custom theme.
-            (face-spec-recalc face frame)
-            ;; Apply attributes specified by face-new-frame-defaults
-            (internal-merge-in-global-face face frame))
-        ;; Don't let invalid specs prevent frame creation.
-        (error nil)))
-
-    ;; Apply attributes specified by frame parameters.
-    (let ((face-params '((foreground-color default :foreground)
-                         (background-color default :background)
-                         (font default :font)
-                         (border-color border :background)
-                         (cursor-color cursor :background)
-                         (scroll-bar-foreground scroll-bar :foreground)
-                         (scroll-bar-background scroll-bar :background)
-                         (mouse-color mouse :background))))
-      (dolist (param face-params)
-        (let* ((param-name (nth 0 param))
-               (value (cdr (assq param-name parameters))))
-          (if value
-              (set-face-attribute (nth 1 param) frame
-                                  (nth 2 param) value))))))
+  (def-face-copier1 my/frame-dont-copy-faces (sym)
+    (let ((name (symbol-name sym)))
+      (string-match-p "^doom-.*" name))
+    mode-line
+    mode-line-inactive)
 
   (defun my/exwm-floating--advise-make-frame (orig id)
-    (advice-add 'face-set-after-frame-default
-                :override
-                'my/frame-dont-copy-faces)
-    (funcall orig id)
-    (advice-remove 'face-set-after-frame-default
-                   'my/frame-dont-copy-faces))
+    (override1-face my/frame-dont-copy-faces
+      (funcall orig id)))
 
   (advice-add #'exwm-floating--set-floating
               :around

config-org.org

@@ -1419,3 +1419,21 @@
                                  (my/agenda-file "eternal.org")))
       '(and (tags-local "bored"))))
 #+end_src
+* org-noter
+#+begin_src emacs-lisp
+  (use-package org-noter)
+  (when (featurep 'exwm)
+    (setq org-noter-always-create-frame nil))
+
+  (def-face-copier x-show-tip-faces (sym)
+    nil
+    tooltip)
+
+  (defun dont-copy-faces-for-x-show-tip (orig &rest args)
+    (override1-face x-show-tip-faces
+      (apply orig args)))
+
+  (advice-add #'x-show-tip
+              :around
+              #'dont-copy-faces-for-x-show-tip)
+#+end_src

lisp/face-copier.el

@@ -0,0 +1,130 @@
+;;; face-copier.el ---  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Benson Chu
+
+;; Author: Benson Chu <bensonchu457@gmail.com>
+;; Created: [2020-01-05 18:56]
+
+;; This file is not part of GNU Emacs
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(defalias 'def-face-copier
+  'def-face-copier1)
+
+(defmacro def-face-copier1 (name var body-pred &rest included)
+  (declare (indent 2))
+  (let* ((name (symbol-name name))
+         (name (intern (concat name "--face-set"))))
+    `(defun ,name (frame &optional parameters)
+       ;; The `reverse' is so that `default' goes first.
+       (dolist (face (append ',included 
+                             (remove-if-not 
+                              (lambda ,var
+                                ,body-pred)
+                              (nreverse (face-list)))))
+         (condition-case ()
+             (progn
+               ;; Initialize faces from face spec and custom theme.
+               (face-spec-recalc face frame)
+               ;; Apply attributes specified by face-new-frame-defaults
+               (internal-merge-in-global-face face frame))
+           ;; Don't let invalid specs prevent frame creation.
+           (error nil)))
+
+       ;; Apply attributes specified by frame parameters.
+       (let ((face-params '((foreground-color default :foreground)
+                            (background-color default :background)
+                            (font default :font)
+                            (border-color border :background)
+                            (cursor-color cursor :background)
+                            (scroll-bar-foreground scroll-bar :foreground)
+                            (scroll-bar-background scroll-bar :background)
+                            (mouse-color mouse :background))))
+         (dolist (param face-params)
+           (let* ((param-name (nth 0 param))
+                  (value (cdr (assq param-name parameters))))
+             (if value
+                 (set-face-attribute (nth 1 param) frame
+                                     (nth 2 param) value))))))))
+
+(defmacro def-face-copier2 (name var body-pred &rest included)
+  (declare (indent 2))
+  (let* ((name (symbol-name name))
+         (name (intern (concat name "--face-recalc"))))
+    (let ((sym (car var)))
+      `(defun ,name (,sym frame)
+         (when (or (member ,sym ',included)
+                   ,body-pred)
+           (while (get ,sym 'face-alias)
+             (setq ,sym (get ,sym 'face-alias)))
+           (face-spec-reset-face ,sym frame)
+           ;; If FACE is customized or themed, set the custom spec from
+           ;; `theme-face' records.
+           (let ((theme-faces (get ,sym 'theme-face))
+                 (no-match-found 0)
+                 face-attrs theme-face-applied)
+             (if theme-faces
+                 (dolist (elt (reverse theme-faces))
+                   (setq face-attrs (face-spec-choose (cadr elt) frame no-match-found))
+                   (unless (eq face-attrs no-match-found)
+                     (face-spec-set-2 ,sym frame face-attrs)
+                     (setq theme-face-applied t))))
+             ;; If there was a spec applicable to FRAME, that overrides the
+             ;; defface spec entirely (rather than inheriting from it).  If
+             ;; there was no spec applicable to FRAME, apply the defface spec
+             ;; as well as any applicable X resources.
+             (unless theme-face-applied
+               (setq face-attrs (face-spec-choose (face-default-spec ,sym) frame))
+               (face-spec-set-2 ,sym frame face-attrs)
+               (make-face-x-resource-internal ,sym frame))
+             (setq face-attrs (face-spec-choose (get ,sym 'face-override-spec) frame))
+             (face-spec-set-2 ,sym frame face-attrs)))))))
+
+(defmacro def-face-copier3 (name var body-pred &rest included)
+  `(progn
+     (def-face-copier1 ,name ,var ,body-pred &rest ,included)
+     (def-face-copier2 ,name ,var ,body-pred &rest ,included)))
+
+(defmacro override1-face (name &rest body)
+  (declare 
+           (indent 1))
+  (let* ((name (symbol-name name))
+         (face-set (intern (concat name "--face-set"))))
+    `(cl-letf (((symbol-function 'face-set-after-frame-default)
+                (symbol-function ',face-set)))
+       ,@body)))
+
+(defmacro override2-face (name &rest body)
+  (declare 
+           (indent 1))
+  (let* ((name (symbol-name name))
+         (face-recalc (intern (concat name "--face-recalc"))))
+    `(cl-letf (((symbol-function 'face-spec-recalc)
+                (symbol-function ',face-recalc)))
+       ,@body)))
+
+(defmacro override-face (name &rest body)
+  (declare 
+           (indent 1))
+  `(override1-face ,name
+     (override2-face ,name
+       ,@body)))
+
+(provide 'face-copier)
+;;; face-copier.el ends here