blob: 07930065ea851009befe346177d12137c6dc8b1b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
;;; font-profiles.el --- Shared Workflow Font Profile Data -*- lexical-binding: t; coding: utf-8; -*-
;; author: Craig Jennings <c@cjennings.net>
;;; Commentary:
;;
;; Layer: 1 (Foundation).
;; Category: F/L.
;; Load shape: library.
;; Top-level side effects: none.
;; Runtime requires: host-environment.
;; Direct test load: yes.
;;
;; Owns the effective font properties shared by the global Fontaine adapter and
;; buffer-local mode adapters such as nov-reading. Consumers can therefore use
;; the same named profile without making a global Fontaine selection.
;;; Code:
(require 'host-environment)
(declare-function face-remap-add-relative "face-remap")
(defconst cj/font-profile-shared-properties
`(:default-family "BerkeleyMono Nerd Font"
:default-weight regular
:default-height ,(if (env-laptop-p) 130 140)
:fixed-pitch-family nil
:fixed-pitch-weight nil
:fixed-pitch-height 1.0
:fixed-pitch-serif-family nil
:fixed-pitch-serif-weight nil
:fixed-pitch-serif-height 1.0
:variable-pitch-family "Lexend"
:variable-pitch-weight regular
:variable-pitch-height 1.0
:bold-family nil
:bold-weight bold
:italic-family nil
:italic-slant italic
:line-spacing nil)
"Properties shared by every workflow font profile unless overridden.")
(defconst cj/font-profile-definitions
'((everyday)
(writing
:default-height 140
:variable-pitch-family "Merriweather"
:variable-pitch-weight light)
(reading
:default-family "Merriweather"
:default-height 140
:fixed-pitch-family "Merriweather"
:fixed-pitch-serif-family "Merriweather"
:variable-pitch-family "Merriweather")
(coding-xs
:default-height 110
:variable-pitch-family "BerkeleyMono Nerd Font")
(coding
:default-height 130
:variable-pitch-family "BerkeleyMono Nerd Font")
(coding-xl
:default-height 160
:variable-pitch-family "BerkeleyMono Nerd Font")
(presentation
:default-height 200))
"Profile-specific font properties in user-facing order.")
(defconst cj/font-profile-order
(mapcar #'car cj/font-profile-definitions)
"Workflow font profiles in user-facing order.")
(defun cj/font-profile-p (profile)
"Return non-nil when PROFILE is a configured workflow font profile."
(memq profile cj/font-profile-order))
(defun cj/font-profile-properties (profile)
"Return effective font properties for workflow PROFILE."
(let ((entry (assq profile cj/font-profile-definitions)))
(unless entry
(user-error "Unknown font profile: %s" profile))
(append (cdr entry) cj/font-profile-shared-properties)))
(defun cj/font-profile-remap-buffer (profile &optional height)
"Apply PROFILE's face families buffer-locally and return remap cookies.
When HEIGHT is non-nil, use it for every remapped face instead of the profile's
configured heights. No global face or Fontaine state is changed."
(let ((properties (cj/font-profile-properties profile))
(cookies nil))
(dolist (face-property '((default
:default-family :default-height)
(fixed-pitch
:fixed-pitch-family :fixed-pitch-height)
(fixed-pitch-serif
:fixed-pitch-serif-family
:fixed-pitch-serif-height)
(variable-pitch
:variable-pitch-family
:variable-pitch-height)))
(pcase-let ((`(,face ,family-property ,height-property)
face-property))
(let ((family (or (plist-get properties family-property)
(and (memq face '(fixed-pitch fixed-pitch-serif))
(plist-get properties :default-family))))
(face-height (or height
(plist-get properties height-property))))
(when family
(push (face-remap-add-relative
face :family family :height face-height)
cookies)))))
(nreverse cookies)))
(provide 'font-profiles)
;;; font-profiles.el ends here
|
