fonts.el

(setq cxa/font-pairs
      '((default
	 :heading (:family "TheFutureFZYouHei" :weight bold :slant normal)
	 :body (:family "WCaslonZZMC" :height 270)
	 :code (:family "PitchFZ" :height 200))
	(brill
	 :heading (:family "TheFutureFZYouHei" :weight bold :slant normal)
	 :body (:family "Brill" :height 270)
	 :code (:family "PitchSansOPPO" :height 200))
	(questa
	 :heading (:family "Questa Grande" :weight bold :slant normal)
	 :body (:family "Questa" :height 240)
	 :code (:family "Courier Prime" :height 240))
	(questa-sans
	 :heading (:family "Questa Slab" :weight bold :slant normal)
	 :body (:family "Questa Sans" :height 240)
	 :code (:family "Courier Prime Sans" :height 240))
	(allrounder
	 :heading (:family "Allrounder Grotesk" :slant normal)
	 :body (:family "Allrounder Antiqua" :height 240)
	 :code (:family "Courier Prime" :height 240))
	(mbtype
	 :heading (:family "Heliotrope 8 Caps" :slant normal)
	 :body (:family "Heliotrope")
	 :code (:family "Targa Pro Mono"))))

(defun cxa/set-fonts (pair-name)
  (let* ((fp (cdr (assoc pair-name cxa/font-pairs)))
	 (heading (plist-get fp :heading))
	 (body (plist-get fp :body))
	 (text-size (plist-get body :height))
	 (code (plist-get fp :code))
	 (cookies nil))
    (push (apply 'face-remap-add-relative 'variable-pitch body)
	  cookies)
    (push (apply 'face-remap-add-relative 'default code)
	  cookies)
    (push (apply 'face-remap-add-relative 'shr-code code)
	  cookies)
    ;; reset inline code size to match body size
    (push (face-remap-add-relative 'shr-code :height text-size)
	  cookies)
    (cl-loop for face in '(shr-h1 shr-h2 shr-h3 shr-h4 shr-h5 shr-h6)
	     for height in '(1.5 1.4 1.3 1.2 1.1 1.05)
	     do
	     (push (apply 'face-remap-add-relative face
			  :height (round (* text-size height)) heading)
		   cookies))
    cookies))

(defun cxa/select-preset-fonts ()
  (interactive)
  (if (or (derived-mode-p 'nov-mode)
	  (derived-mode-p 'eww-mode))
      (let* ((choices (mapcar 'car cxa/font-pairs))
	     (choice (completing-read "Select preset fonts: " choices)))
	(with-current-buffer (current-buffer)
	  (when (boundp 'cxa/preset-fonts-cookies)
	    (dolist (cookie cxa/preset-fonts-cookies)
	      (face-remap-remove-relative cookie)))
	  (setq-local cxa/preset-fonts-cookies (cxa/set-fonts (intern choice)))))
    (message "Adjust font for %s is not supported" major-mode)))