├── .elpaignore ├── .gitignore ├── snapshots ├── cnfonts-ui-1.png ├── cnfonts-ui-2.png ├── cnfonts-ui-3.png ├── cnfonts-ui-4.png ├── cnfonts-ui-5.png ├── cnfonts-ui-6.png ├── cnfonts-ui-7.png ├── cnfonts-edit-fontnames.gif ├── cnfonts-edit-fontsizes.gif └── cnfonts-increase-and-decrease-fontsize.gif ├── README.org ├── cnfonts-ui.el └── cnfonts.el /.elpaignore: -------------------------------------------------------------------------------- 1 | snapshots -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /*~ 2 | /chinese-fonts-setup.org 3 | /cnfonts-autoloads.el 4 | -------------------------------------------------------------------------------- /snapshots/cnfonts-ui-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tumashu/cnfonts/HEAD/snapshots/cnfonts-ui-1.png -------------------------------------------------------------------------------- /snapshots/cnfonts-ui-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tumashu/cnfonts/HEAD/snapshots/cnfonts-ui-2.png -------------------------------------------------------------------------------- /snapshots/cnfonts-ui-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tumashu/cnfonts/HEAD/snapshots/cnfonts-ui-3.png -------------------------------------------------------------------------------- /snapshots/cnfonts-ui-4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tumashu/cnfonts/HEAD/snapshots/cnfonts-ui-4.png -------------------------------------------------------------------------------- /snapshots/cnfonts-ui-5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tumashu/cnfonts/HEAD/snapshots/cnfonts-ui-5.png -------------------------------------------------------------------------------- /snapshots/cnfonts-ui-6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tumashu/cnfonts/HEAD/snapshots/cnfonts-ui-6.png -------------------------------------------------------------------------------- /snapshots/cnfonts-ui-7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tumashu/cnfonts/HEAD/snapshots/cnfonts-ui-7.png -------------------------------------------------------------------------------- /snapshots/cnfonts-edit-fontnames.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tumashu/cnfonts/HEAD/snapshots/cnfonts-edit-fontnames.gif -------------------------------------------------------------------------------- /snapshots/cnfonts-edit-fontsizes.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tumashu/cnfonts/HEAD/snapshots/cnfonts-edit-fontsizes.gif -------------------------------------------------------------------------------- /snapshots/cnfonts-increase-and-decrease-fontsize.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tumashu/cnfonts/HEAD/snapshots/cnfonts-increase-and-decrease-fontsize.gif -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+title: A simple Chinese fonts config tool 2 | #+author: Feng Shu 3 | 4 | * 简介 5 | 6 | cnfonts 原来叫: chinese-fonts-setup, 是一个 Emacs 中英文字体配置工 7 | 具。可以比较方便地实现中文字体和英文字体等宽（也就是大家常说的中英 8 | 文对齐）。 9 | 10 | 注：这个 package 特别适用于需要处理中英文混合表格的中文 org-mode 用 11 | 户。 12 | 13 | * 基本原理 14 | 15 | cnfonts 的核心很简单，就是让中文字体和英文字体使用不同的字号，从而 16 | 实现中英文对齐。 17 | 18 | * 使用特点 19 | 20 | cnfonts 添加了许多辅助工具，使配置和调节字体和字号的工作更加简便快 21 | 捷，它有几个优点： 22 | 23 | 1. 安装即用：cnfonts 内置字体 fallback 功能，只需安装，就能够配置中 24 | 文字体和英文字体，让中文可以 *正确* 显示（但未必完美），不会因为 25 | Emacs 配置中指定的字体不存在而报错。 26 | 27 | 2. 设置方便：cnfonts 自带一个 profile 文件调整工具，这个工具有直观 28 | 的图形界面，可以让用户设置字体名称和字体大小，分分钟实现中文字体 29 | 和英文字体的等宽对齐。 30 | 31 | * 下载安装 32 | 33 | 1. 配置melpa源，参考：http://melpa.org/#/getting-started 34 | 2. M-x package-install RET cnfonts RET 35 | 3. 在emacs配置文件中（比如: ~/.emacs）添加如下代码： 36 | 37 | #+begin_example 38 | (require 'cnfonts) 39 | ;; 让 cnfonts 在 Emacs 启动时自动生效。 40 | (cnfonts-mode 1) 41 | ;; 添加两个字号增大缩小的快捷键 42 | ;; (define-key cnfonts-mode-map (kbd "C--") #'cnfonts-decrease-fontsize) 43 | ;; (define-key cnfonts-mode-map (kbd "C-=") #'cnfonts-increase-fontsize) 44 | #+end_example 45 | 46 | * 配置使用 47 | ** 最简单的用法（懒人必备） 48 | 49 | 通过下面几个命令，用户可以 *快速* 了解 cnfonts 的大部分功能，而不需 50 | 要阅读整篇文档，如果用户想深入了解 cnfonts 或者自定义一些特殊的功能， 51 | 阅读整篇文档是逃不开的。 52 | 53 | | 命令 | 功能 | 54 | |---------------------------+--------------| 55 | | cnfonts-edit-profile | 调整字体设置 | 56 | | cnfonts-increase-fontsize | 增大字号 | 57 | | cnfonts-decrease-fontsize | 减小字号 | 58 | 59 | ** profile 的概念 60 | 61 | profile 代表了一套字体配置，cnfonts 使用 profile 的概念，来维护多套 62 | 字体配置，从而实现特定的环境使用特定的字体配置，比如：在编程时使用 63 | “Consolas + 微米黑”，在阅读文章时使用 “PragmataPro + 黑体”，等等。 64 | 65 | 每一个 profile 都对应一个 emacs-lisp 文件, 保存在 66 | `cnfonts-directory' 对应的目录中, 这些文件包含了英文字体设置，中文 67 | 字体设置以及中文字体大小等。 68 | 69 | ** profile 命名与切换 70 | 71 | cnfonts 默认使用三个 profile: profile1, profile2 和 profile3, 如果 72 | 想使用其它有意义的名称，可以设置: 73 | 74 | #+begin_example 75 | (setq cnfonts-profiles 76 | '("program" "org-mode" "read-book")) 77 | #+end_example 78 | 79 | cnfonts 使用下面两个命令来切换 profile ： 80 | 81 | | Command | Help | 82 | |------------------------+-------------------------| 83 | | cnfonts-switch-profile | 选择并切换 profile | 84 | | cnfonts-next-profile | 直接切换到下一个profile | 85 | 86 | ** 使用 cnfonts-edit-profile 命令调整 profile 87 | 88 | 如果 *当前使用* 的字体不符合使用习惯，用户可以运行 89 | `cnfonts-edit-profile'命令来调整 *当前* profile,这个命令会弹出一个 90 | 图形化界面，类似： 91 | 92 | [[file:./snapshots/cnfonts-ui-1.png]] 93 | [[file:./snapshots/cnfonts-ui-2.png]] 94 | [[file:./snapshots/cnfonts-ui-3.png]] 95 | [[file:./snapshots/cnfonts-ui-4.png]] 96 | [[file:./snapshots/cnfonts-ui-5.png]] 97 | [[file:./snapshots/cnfonts-ui-6.png]] 98 | [[file:./snapshots/cnfonts-ui-7.png]] 99 | 100 | 注1: 配置完成后，有可能需要重启 Emacs, 参考： 101 | http://debbugs.gnu.org/db/17/1785.html 102 | 103 | ** 使用 cnfonts-regenerate-profile 重置 profile 104 | 105 | `cnfonts-regenerate-profile' 命令会使用 cnfonts 自带的 fallback 信 106 | 息，覆盖需要 *重置* 的 profile, 这个 profile 原来的内容将丢失，请紧 107 | 慎使用！ 108 | 109 | ** 调整字体大小 110 | `cnfonts' 使用下述两个命令调整字体大小: 111 | 112 | | Command | Help | 113 | |---------------------------+--------------| 114 | | cnfonts-increase-fontsize | 增大字体大小 | 115 | | cnfonts-decrease-fontsize | 减小字体大小 | 116 | 117 | 注意：在调整字体大小的同时，字号信息也会保存到 `cnfonts-directory' 118 | 目录下`cnfonts-config-filename' 对应的文件中。 119 | 120 | [[file:./snapshots/cnfonts-increase-and-decrease-fontsize.gif]] 121 | 122 | ** 使用 cnfonts-use-system-type 123 | 124 | 有些用户希望将 profile 配置文件做为自己的 Emacs 配置，在不同的计算 125 | 机上同步和管理，我建议这些用户将 `cnfonts-use-system-type'设置为 t, 126 | 这样，相同名称的 profile 在不同的操作系统下，保存的位置也不同，可以 127 | 避免 profile 冲突。 128 | 129 | ** 让 cnfonts 随着 Emacs 自动启动 130 | 131 | `cnfonts-mode' 命令可以让 cnfonts 随着 Emacs 自动启动，这个命令将 132 | `cnfonts-set-font' 添加到下面两个 hook: 133 | 134 | 1. `after-make-frame-functions' 135 | 2. `window-setup-hook' 136 | 137 | 用户也可以手动运行 `cnfonts-set-font' 来让 cnfonts 生效。 138 | 139 | ** cnfonts 与 org-mode 配合使用 140 | 141 | 许多用户使用 org-mode 时，习惯让不同的标题，使用的字体大小也不同， 142 | 这个特性需要用户设置： 143 | 144 | #+begin_example 145 | (setq cnfonts-use-face-font-rescale t) 146 | #+end_example 147 | 148 | 注：这个功能不能在 window 系统下使用，它会让对齐功能失效，Linux 下 149 | 这个功能 *一般* 可以使用，Mac 系统未测试，同学可以亲自试一试。 150 | 151 | ** cnfonts 高级功能 152 | 153 | *** 设置一些不常用汉字字符的字体 154 | 155 | #+begin_example 156 | (push '(#x3400 . #x4DFF) cnfonts-ornaments) 157 | #+end_example 158 | 159 | 注意事项： 160 | 161 | 1. "(#x3400 . #x4DFF)" 代表了待设字符在 unicode-bmp 中的范围。 162 | 2. 用户可以通过下面的方式来确定待字符的范围 163 | 1. 运行 `describe-char' 来显示 *待设字符* 的信息 164 | 2. 点击 “code point in charset” 处的链接，来显示整个 unicode-bmp 表 165 | 3. 获取范围 166 | 3. 如果遇到 *部分符号* 无法正确对齐，可以参考: 167 | 1. https://github.com/tumashu/cnfonts/issues/64#issuecomment-296414028 168 | 169 | *** 设置行距随着字号自动调整 170 | 171 | #+begin_example 172 | (defvar my-line-spacing-alist 173 | '((9 . 0.1) (10 . 0.9) (11.5 . 0.2) 174 | (12.5 . 0.2) (14 . 0.2) (16 . 0.2) 175 | (18 . 0.2) (20 . 1.0) (22 . 0.2) 176 | (24 . 0.2) (26 . 0.2) (28 . 0.2) 177 | (30 . 0.2) (32 . 0.2))) 178 | 179 | (defun my-line-spacing-setup (fontsizes-list) 180 | (let ((fontsize (car fontsizes-list)) 181 | (line-spacing-alist (copy-list my-line-spacing-alist))) 182 | (dolist (list line-spacing-alist) 183 | (when (= fontsize (car list)) 184 | (setq line-spacing-alist nil) 185 | (setq-default line-spacing (cdr list)))))) 186 | 187 | (add-hook 'cnfonts-set-font-finish-hook #'my-line-spacing-setup) 188 | #+end_example 189 | 190 | * Tips 191 | 192 | 1. 如果用户需要在自己的 Emacs 配置中管理一些个人字体，可以使用变量 193 | `cnfonts-personal-fontnames' , 其结构与 194 | `cnfonts--fontnames-fallback'一样。 195 | 2. 使用命令: `describe-char' 可以了解光标处字符使用什么字体。 196 | 3. 在 scratch 中写一行 elisp 代码： 197 | 198 | #+begin_example 199 | (cl-prettyprint (font-family-list)) 200 | #+end_example 201 | 202 | 执行后，就会在 scratch 中插入当前可用字体的名称列表，这是一个很 203 | 有用的技巧。 204 | 205 | 4. Windows 用户 (特别是 Windows XP 用户) 可以安装 MacType 软件来优 206 | 化字体显示效果，推荐使用。 207 | 5. Mac 用户配置 profile 文件的时候，偶尔会遇到 'C-c C-c' 刷新缓慢的 208 | 问题，这可能是 ext-b 字体缺失引起的，建议安装 ext-b 字体试试。 209 | 1. Ext-B字符列表: https://cdo.wikipedia.org/wiki/Wikipedia:Unicode%E6%93%B4%E5%B1%95%E6%BC%A2%E5%AD%97 210 | 2. HanaMinB 下载地址: https://osdn.jp/projects/hanazono-font/downloads/62072/hanazono-20141012.zip/ 211 | 6. 字体设置和 coding 设置也有关系，如果 cnfonts 的行为很奇怪，又找 212 | 不到确切原因，可以参考： 213 | https://github.com/tumashu/cnfonts/issues/54#issuecomment-246228904 214 | 215 | * 参考文章 216 | 1. http://baohaojun.github.io/perfect-emacs-chinese-font.html 217 | 2. http://zhuoqiang.me/torture-emacs.html 218 | -------------------------------------------------------------------------------- /cnfonts-ui.el: -------------------------------------------------------------------------------- 1 | ;;; cnfonts-ui.el --- A cnfonts profile editor with beautiful interface. -*- lexical-binding: t; -*- 2 | 3 | ;; * Header 4 | ;; Copyright (c) 2016, Feng Shu 5 | 6 | ;; Author: Feng Shu 7 | ;; Package-Requires: ((emacs "24")) 8 | ;; Version: 1.1.2 9 | ;; Keywords: convenience, Chinese, font 10 | 11 | ;; This file is not part of GNU Emacs. 12 | 13 | ;; This program is free software; you can redistribute it and/or 14 | ;; modify it under the terms of the GNU General Public License 15 | ;; as published by the Free Software Foundation; either version 3 16 | ;; of the License, or (at your option) any later version. 17 | 18 | ;; This program is distributed in the hope that it will be useful, 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 | ;; GNU General Public License for more details. 22 | 23 | ;; You should have received a copy of the GNU General Public License 24 | ;; along with GNU Emacs; see the file COPYING. If not, write to the 25 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 26 | ;; Boston, MA 02110-1301, USA. 27 | 28 | ;;; Commentary: 29 | ;; A cnfonts profile editor which has a beautiful interface. 30 | 31 | ;;; Code: 32 | 33 | ;; * 代码 :code: 34 | (require 'cl-lib) 35 | (require 'cus-edit) 36 | (require 'cnfonts) 37 | 38 | (defconst cnfonts-ui--pages 39 | '((start-page 40 | :keybinding "t" 41 | :button-name "开始") 42 | (english-fonts-page 43 | :index 0 44 | :keybinding "e" 45 | :button-name "英文") 46 | (chinese-fonts-page 47 | :index 1 48 | :keybinding "c" 49 | :button-name "中文") 50 | (extb-fonts-page 51 | :index 2 52 | :keybinding "x" 53 | :button-name "EXT-B") 54 | (symbol-fonts-page 55 | :index 3 56 | :keybinding "s" 57 | :note " 58 | 注意：字符等宽对齐往往不容易设置，涉及字体混用, char-width, 字体 59 | 优先级等多种原因，有兴趣的同学可以看看这个链接： 60 | 61 | https://github.com/tumashu/cnfonts/issues/64 62 | 63 | Emacs 25.2 以后，当 default font 有某个字符的时候，优先使用这个字 64 | 体，可以将 use-default-font-for-symbols 设置为 nil 来关闭。" 65 | :button-name "字符") 66 | (ornament-fonts-page 67 | :index 4 68 | :keybinding "d" 69 | :note (lambda () 70 | (format " 71 | 某些 Emacs 社区配置（比如：spacemacs）使用某些特殊字符或者符号做 72 | 为装饰或者点缀，这个页面用于设置这些特殊字符的字体。 73 | 比如: %S" 74 | (mapconcat (lambda (x) 75 | (when (ignore-errors (consp x)) 76 | (concat (char-to-string (car x)) 77 | (char-to-string (cdr x))))) 78 | cnfonts-ornaments ""))) 79 | :button-name "点缀") 80 | (align-page 81 | :align-page t 82 | :keybinding "1" 83 | :button-name "对齐") 84 | (key-page 85 | :keybinding "k" 86 | :button-name "快捷键") 87 | (help-page 88 | :keybinding "h" 89 | :button-name "帮助"))) 90 | 91 | (defvar cnfonts-ui-mode-map 92 | (let ((map (make-keymap))) 93 | (set-keymap-parent 94 | map (make-composed-keymap 95 | widget-keymap 96 | special-mode-map)) 97 | (suppress-keymap map) 98 | (define-key map "n" 'next-line) 99 | (define-key map "p" 'previous-line) 100 | (define-key map "f" 'cnfonts-ui-next-page) 101 | (define-key map "b" 'cnfonts-ui-previous-page) 102 | (define-key map "R" 'cnfonts-ui-restart) 103 | (define-key map " " 'cnfonts-ui-toggle-select-font) 104 | (define-key map "\t" 'cnfonts-ui-forward) 105 | (define-key map "\e\t" 'cnfonts-ui-backward) 106 | (define-key map [backtab] 'cnfonts-ui-backward) 107 | (define-key map "=" 'cnfonts-ui-increase-align) 108 | (define-key map "-" 'cnfonts-ui-decrease-align) 109 | (define-key map (kbd "C-") 'cnfonts-ui-increase-align) 110 | (define-key map (kbd "C-") 'cnfonts-ui-decrease-align) 111 | (define-key map [drag-mouse-1] 'ignore) 112 | (define-key map [mouse-1] 'ignore) 113 | map) 114 | "Keymap for `cnfonts-ui-mode'.") 115 | 116 | (defvar cnfonts-ui--widgets-alist nil) 117 | (defvar cnfonts-ui--current-page nil) 118 | (defvar cnfonts-ui--widgets-navigation nil) 119 | (defvar cnfonts-ui--widgets-elisp-snippet nil) 120 | (defvar cnfonts-ui--verbose nil) 121 | (defvar cnfonts-ui--move-mouse nil) 122 | 123 | (defmacro cnfonts-ui-create-page (page-name &rest body) 124 | (declare (indent 1) (debug t)) 125 | (let ((func-name 126 | (intern (concat "cnfonts-ui-page-" 127 | (symbol-name page-name)))) 128 | (buffer-name (make-symbol "buffer-name")) 129 | (point (make-symbol "point"))) 130 | `(defun ,func-name (&optional _widget _event create-buffer) 131 | (interactive) 132 | (let ((,buffer-name (format " *cnfonts: %S*" ',page-name)) 133 | (,point (point))) 134 | ;; 创建或者切换 page 时，强制重新读取 profile. 135 | (cnfonts--read-profile nil t) 136 | (if create-buffer 137 | (with-current-buffer (get-buffer-create ,buffer-name) 138 | (let ((inhibit-read-only t)) 139 | (erase-buffer)) 140 | (cnfonts-ui-mode) 141 | (define-key cnfonts-ui-mode-map 142 | (cnfonts-ui--get-page-info 143 | ',page-name :keybinding) 144 | ',func-name) 145 | (set (make-local-variable 'cnfonts-ui--widgets-alist) nil) 146 | (set (make-local-variable 'cnfonts-ui--current-page) ',page-name) 147 | (set (make-local-variable 'cnfonts-ui--widgets-navigation) nil) 148 | (set (make-local-variable 'cnfonts-ui--widgets-elisp-snippet) nil) 149 | (setq truncate-lines t) 150 | ,@body 151 | (widget-setup) 152 | (goto-char ,point)) 153 | (cnfonts-ui--switch-to-page ',page-name)) 154 | (when cnfonts-ui--move-mouse 155 | (cnfonts-ui--move-mouse)))))) 156 | 157 | (define-derived-mode cnfonts-ui-mode special-mode "CNFONTS-UI" 158 | "Major mode for cnfonts-ui. Do not call this mode function yourself. 159 | It is meant for internal use." 160 | (use-local-map cnfonts-ui-mode-map) 161 | (custom--initialize-widget-variables)) 162 | (put 'cnfonts-ui-mode 'mode-class 'special) 163 | 164 | (defun cnfonts-ui--get-page-info (page-name key) 165 | (let ((page-info (cdr (assq page-name cnfonts-ui--pages)))) 166 | (plist-get page-info key))) 167 | 168 | (defun cnfonts-ui--switch-to-page (page-name) 169 | "Switch to page which name is PAGE-NAME." 170 | (let ((point (point))) 171 | (switch-to-buffer (format " *cnfonts: %S*" page-name)) 172 | (dolist (widget cnfonts-ui--widgets-navigation) 173 | (let ((orig-value (widget-value widget)) 174 | (widget-page (widget-get widget :page-name))) 175 | (if (eq cnfonts-ui--current-page widget-page) 176 | (widget-value-set 177 | widget (replace-regexp-in-string 178 | " " "*" orig-value)) 179 | (widget-value-set 180 | widget (replace-regexp-in-string 181 | "*" " " orig-value))))) 182 | (goto-char point))) 183 | 184 | (defun cnfonts-ui--move-mouse () 185 | "Move mouse to current point." 186 | (let ((x-y (posn-x-y (posn-at-point (+ (point) 1))))) 187 | (when (and (car x-y) (cdr x-y)) 188 | (set-mouse-pixel-position 189 | (window-frame) 190 | (+ (car x-y) (/ (default-font-width) 2)) 191 | (+ (cdr x-y) (/ (default-font-height) 2)))))) 192 | 193 | (defun cnfonts-ui () 194 | (interactive) 195 | (if (not (display-graphic-p)) 196 | (message "[cnfonts]: 不支持 Emacs 终端模式！") 197 | ;; "cus-edit" 不能很好的在 Emacs daemon 下工作，hack! 198 | (setq custom-raised-buttons 199 | (not (equal (face-valid-attribute-values :box) 200 | '(("unspecified" . unspecified))))) 201 | (load-library "cus-edit") 202 | (dolist (page-info cnfonts-ui--pages) 203 | (let ((page-name (car page-info))) 204 | (funcall (cnfonts-ui--get-page-function page-name) 205 | nil nil t))) 206 | (funcall (cnfonts-ui--get-page-function 'start-page)))) 207 | 208 | (defun cnfonts-ui--get-page-function (page-name) 209 | (intern (concat "cnfonts-ui-page-" 210 | (symbol-name page-name)))) 211 | 212 | (cnfonts-ui-create-page start-page 213 | (cnfonts-ui--create-tab-stop-point) 214 | (cnfonts-ui--create-navigation) 215 | (widget-insert " 216 | 217 | ** 注意事项 218 | 219 | 如果需要 Emacs 启动时激活 cnfonts，请在 Emacs 配置文件中添加一行 220 | 代码： 221 | 222 | (cnfonts-mode 1) 223 | 224 | 常用命令 功能 225 | ---------------------------------------------- ---------------- 226 | cnfonts-edit-profile 调整字体设置 227 | cnfonts-increase-fontsize 增大字号 228 | cnfonts-decrease-fontsize 减小字号 229 | 230 | 231 | 注意：如果安装 cnfonts 后，发现 Emacs 卡顿甚至崩溃，可以安装 232 | HanaMinB 字体试试，这个字体的下载地址可以从 [ 帮助 ] 页面中找到。 233 | " )) 234 | 235 | (defun cnfonts-ui--create-tab-stop-point () 236 | "Create a widget. 237 | the curse will stop to this widget when forward/backward widget." 238 | (widget-create 239 | 'push-button 240 | :tag "\n" 241 | :tab-stop-point t 242 | :button-face-get 'ignore 243 | :mouse-face-get 'ignore)) 244 | 245 | (defun cnfonts-ui--create-navigation () 246 | (dolist (page-name (mapcar #'car cnfonts-ui--pages)) 247 | (push (cnfonts-ui--create-page-switch-button page-name) 248 | cnfonts-ui--widgets-navigation) 249 | (widget-insert " "))) 250 | 251 | (defun cnfonts-ui--create-page-switch-button (page-name 252 | &optional ignore-face) 253 | "Create a button which used to switch page named PAGE-NAME. 254 | TODO: IGNORE-FACE." 255 | (let ((button-name 256 | (cnfonts-ui--get-page-info 257 | page-name :button-name)) 258 | (alter-button-name 259 | (cnfonts-ui--get-page-info 260 | page-name :alter-button-name)) 261 | (action 262 | (cnfonts-ui--get-page-function page-name))) 263 | (if ignore-face 264 | (widget-create 265 | 'push-button 266 | :value 267 | (format "[ %s ]" (or alter-button-name 268 | button-name)) 269 | :button-face-get 'ignore 270 | :mouse-face-get 'ignore 271 | :page-name page-name 272 | :action action) 273 | (widget-create 274 | 'push-button 275 | :value (format " %s " button-name) 276 | :page-name page-name 277 | :action action)))) 278 | 279 | (cnfonts-ui-create-page english-fonts-page 280 | (cnfonts-ui--create-fonts-page 'english-fonts-page)) 281 | 282 | (defun cnfonts-ui--create-fonts-page (page-name) 283 | (let ((index (cnfonts-ui--get-page-info page-name :index)) 284 | (note (cnfonts-ui--get-page-info page-name :note) ) 285 | (fontname-alist cnfonts--custom-set-fontnames)) 286 | (widget-insert "\n") 287 | (cnfonts-ui--create-navigation) 288 | (widget-insert "\n") 289 | (when note 290 | (if (functionp note) 291 | (widget-insert (funcall note) "\n") 292 | (widget-insert note "\n"))) 293 | (widget-insert " 294 | P: 表示当前字体包含在变量 `cnfonts-personal-fontnames' 中。 295 | NA: 表示系统没有安装当前字体。\n\n") 296 | (let ((fonts (nth index fontname-alist)) 297 | widget1 widget2 widget3) 298 | (widget-insert "状态 当前字体") 299 | (widget-insert 300 | (format "%53s\n" 301 | (format "( %s )" 302 | (cnfonts--get-current-profile t)))) 303 | (widget-insert 304 | (concat "---- ----------------------------" 305 | "---------------------------------\n")) 306 | (dolist (font fonts) 307 | (setq widget1 308 | (widget-create 309 | 'push-button 310 | :font-name font 311 | :index index 312 | :button-face-get 'ignore 313 | :mouse-face-get 'ignore 314 | :value 315 | (format "%-6s" 316 | (cnfonts-ui--return-status-string 317 | font index)))) 318 | (setq widget2 319 | (widget-create 320 | 'checkbox 321 | :value 322 | (equal font (car (nth index fontname-alist))) 323 | :font-name font 324 | :flag t 325 | :tab-stop-point t 326 | :index index 327 | :action 'cnfonts-ui-toggle-select-font)) 328 | (setq widget3 329 | (widget-create 330 | 'push-button 331 | :button-face-get 'ignore 332 | :mouse-face-get 'ignore 333 | :value (format " %-50s" font) 334 | :action 'cnfonts-ui-toggle-select-font)) 335 | (push (cons widget1 widget2) cnfonts-ui--widgets-alist) 336 | (push (cons widget2 widget2) cnfonts-ui--widgets-alist) 337 | (push (cons widget3 widget2) cnfonts-ui--widgets-alist) 338 | (widget-insert "\n" ))))) 339 | 340 | (defun cnfonts-ui--return-status-string (font index) 341 | (format 342 | "%-2s %-2s" 343 | (if (cnfonts--font-exists-p font t) 344 | "" 345 | "NA") 346 | (if (member font (nth index cnfonts-personal-fontnames)) 347 | "P" 348 | ""))) 349 | 350 | (defun cnfonts-ui-toggle-select-font (&optional widget event) 351 | (interactive) 352 | (let* ((widget (or widget (widget-at))) 353 | (widget1 (cdr (assoc widget cnfonts-ui--widgets-alist))) 354 | (widgets (mapcar #'cdr cnfonts-ui--widgets-alist)) 355 | (font (widget-get widget1 :font-name)) 356 | (index (widget-get widget1 :index)) 357 | (flag (widget-get widget1 :flag))) 358 | (if (not flag) 359 | (message (concat "[cnfonts]: 当前光标所在位置不对，" 360 | " 请将光标移动到字体所在的行上面。")) 361 | (widget-toggle-action widget1 event) 362 | (dolist (w widgets) 363 | (unless (equal (widget-get w :font-name) font) 364 | (widget-value-set w nil) 365 | (widget-apply w :notify w event))) 366 | (if (not (cnfonts--font-exists-p font)) 367 | (message "[cnfonts]: 系统没有安装字体: %S ." font) 368 | (when (widget-value widget1) 369 | (cnfonts--update-profile-fontnames index font) 370 | (cnfonts--save-profile) 371 | (cnfonts-set-font)))))) 372 | 373 | (cnfonts-ui-create-page chinese-fonts-page 374 | (cnfonts-ui--create-fonts-page 'chinese-fonts-page)) 375 | 376 | (cnfonts-ui-create-page extb-fonts-page 377 | (cnfonts-ui--create-fonts-page 'extb-fonts-page)) 378 | 379 | (cnfonts-ui-create-page symbol-fonts-page 380 | (cnfonts-ui--create-fonts-page 'symbol-fonts-page)) 381 | 382 | (cnfonts-ui-create-page ornament-fonts-page 383 | (cnfonts-ui--create-fonts-page 'ornament-fonts-page)) 384 | 385 | (cnfonts-ui-create-page align-page 386 | (cnfonts-ui--create-align-page 'align-page)) 387 | 388 | (defun cnfonts-ui--create-align-page (_page-name) 389 | (let* ((profile-name (cnfonts--get-current-profile t)) 390 | (profile-fontsize 391 | (cnfonts--get-profile-fontsize profile-name)) 392 | (fontsize-list 393 | (cnfonts--get-fontsizes profile-fontsize))) 394 | 395 | (widget-insert "\n") 396 | (cnfonts-ui--create-navigation) 397 | (widget-insert "\n\n") 398 | 399 | (widget-insert "字体类别 字号 ") 400 | (widget-insert 401 | (format "%51s\n" 402 | (format "( %s )" 403 | (cnfonts--get-current-profile t)))) 404 | (widget-insert 405 | (concat "---------- ------------------------" 406 | "---------------------------------\n")) 407 | 408 | (cnfonts-ui--create-align-line 409 | 0 "ASCII " fontsize-list "| More haste, less speed. |") 410 | (cnfonts-ui--create-align-line 411 | 1 "CJKV " fontsize-list "| 为天地立心，为生民立命；|") 412 | (cnfonts-ui--create-align-line 413 | 2 "EXT-B " fontsize-list "| 𠄀𠄁𠄂𠄃𠄄𠄅𠄆𠄇𠄈𠄉𠄀。|") 414 | (cnfonts-ui--create-align-line 415 | 3 "Symbol " fontsize-list "> αβχδεφγηιϕκλνοπθρστυʌɯʊ <") 416 | (cnfonts-ui--create-align-line 417 | 4 "Ornament" fontsize-list 418 | (concat 419 | "> " 420 | (mapconcat 421 | (lambda (x) 422 | (when (ignore-errors (consp x)) 423 | (concat (char-to-string (car x)) 424 | (char-to-string (cdr x))))) 425 | cnfonts-ornaments ""))) 426 | 427 | (widget-insert "\n") 428 | 429 | (widget-create 430 | 'push-button 431 | :button-face-get 'ignore 432 | :mouse-face-get 'ignore 433 | :tag "[设置上一个字号]" 434 | :action 435 | (lambda (widget event) 436 | (let ((cnfonts-ui--move-mouse t)) 437 | (cnfonts-decrease-fontsize) 438 | (cnfonts-ui-page-align-page nil nil t)))) 439 | (widget-insert " ") 440 | (widget-create 441 | 'push-button 442 | :button-face-get 'ignore 443 | :mouse-face-get 'ignore 444 | :tag "[设置下一个字号]" 445 | :action 446 | (lambda (widget event) 447 | (let ((cnfonts-ui--move-mouse t)) 448 | (cnfonts-increase-fontsize) 449 | (cnfonts-ui-page-align-page nil nil t)))))) 450 | 451 | (defun cnfonts-ui--create-align-line (index 452 | label 453 | fontsize-list 454 | align-string) 455 | (let ((fontsize (number-to-string 456 | (nth index fontsize-list))) 457 | widget1 widget2 widget3 widget4) 458 | (widget-insert (format "%s. " (+ index 1))) 459 | (widget-insert (format "%-5s " label)) 460 | (if (= index 0) 461 | (progn (setq widget1 (widget-create 462 | 'push-button 463 | :value (format "%-6s " fontsize) 464 | :flag t 465 | :key (car fontsize-list) 466 | :button-face-get 'ignore 467 | :mouse-face-get 'ignore)) 468 | (push (cons widget1 widget1) cnfonts-ui--widgets-alist)) 469 | (setq widget2 (widget-create 470 | 'push-button 471 | :value (format "%-5s" fontsize) 472 | :index index 473 | :flag t 474 | :key (car fontsize-list) 475 | :tab-stop-point t 476 | :button-face-get 'ignore 477 | :mouse-face-get 'ignore)) 478 | (setq widget3 (widget-create 479 | 'push-button 480 | :tag "[-]" 481 | :index index 482 | :flag t 483 | :key (car fontsize-list) 484 | :button-face-get 'ignore 485 | :mouse-face-get 'ignore 486 | :action 'cnfonts-ui-decrease-align)) 487 | (setq widget4 (widget-create 488 | 'push-button 489 | :tag "[+]" 490 | :index index 491 | :flag t 492 | :key (car fontsize-list) 493 | :button-face-get 'ignore 494 | :mouse-face-get 'ignore 495 | :action 'cnfonts-ui-increase-align)) 496 | (push (cons widget2 widget2) 497 | cnfonts-ui--widgets-alist) 498 | (push (cons widget3 widget2) 499 | cnfonts-ui--widgets-alist) 500 | (push (cons widget4 widget2) 501 | cnfonts-ui--widgets-alist)) 502 | (widget-insert " ") 503 | (widget-insert align-string) 504 | (widget-insert "\n"))) 505 | 506 | (defun cnfonts-ui-decrease-align (&optional widget event) 507 | (interactive) 508 | (cnfonts-ui--operate-align widget event -0.5)) 509 | 510 | (defun cnfonts-ui--operate-align (&optional widget _event n) 511 | (let* ((widget (or widget (widget-at))) 512 | (key (widget-get widget :key)) 513 | (index (widget-get widget :index)) 514 | (flag (widget-get widget :flag)) 515 | (widget-show-fontsize 516 | (cdr (assoc widget cnfonts-ui--widgets-alist)))) 517 | (if (not flag) 518 | (message (concat 519 | "[cnfonts]: 当前光标所在位置不对，" 520 | "请将光标移动到 ‘中文字号’ " 521 | "或者 ‘EXT-B字体字号’ 对应的数字上。")) 522 | (when (and index key (numberp n)) 523 | (cnfonts--update-profile-fontsizes key index n) 524 | ;; 更新加号按钮和减号按钮前面的数字标签 525 | (widget-value-set 526 | widget-show-fontsize 527 | (format "%-5s" (nth index (cnfonts--get-fontsizes key))))) 528 | (when key 529 | (cnfonts--save-profile) 530 | (cnfonts--set-font (cnfonts--get-fontsizes key))) 531 | (dotimes (i 5) 532 | (sit-for 0.3) 533 | (message "[cnfonts]: 测试 Minibuffer 是否抖动 (%s/%s)" 534 | (+ i 1) 5) 535 | (sit-for 0.3) 536 | (message nil))))) 537 | 538 | (defun cnfonts-ui-increase-align (&optional widget event) 539 | (interactive) 540 | (cnfonts-ui--operate-align widget event 0.5)) 541 | 542 | ;; key-page *must* create at the end, make sure other page's 543 | ;; keybinding are defined. 544 | (cnfonts-ui-create-page key-page 545 | (cnfonts-ui--create-tab-stop-point) 546 | (cnfonts-ui--create-navigation) 547 | (widget-insert 548 | (substitute-command-keys " 549 | 550 | ** 标签切换快捷键 551 | 552 | 功能 按键 553 | ---------------------- -------- 554 | 切换到下一个标签 \\[cnfonts-ui-next-page] 555 | 切换到上一个标签 \\[cnfonts-ui-previous-page] 556 | 切换到 [ 开始 ] 标签 \\[cnfonts-ui-page-start-page] 557 | 切换到 [ 英文 ] 标签 \\[cnfonts-ui-page-english-fonts-page] 558 | 切换到 [ 中文 ] 标签 \\[cnfonts-ui-page-chinese-fonts-page] 559 | 切换到 [ EXT-B ] 标签 \\[cnfonts-ui-page-extb-fonts-page] 560 | 切换到 [ 对齐 ] 标签 \\[cnfonts-ui-page-align-page] 561 | 切换到 [ 快捷键 ] 标签 \\[cnfonts-ui-page-key-page] 562 | 切换到 [ 帮助 ] 标签 \\[cnfonts-ui-page-help-page] 563 | 564 | ** 字体选择快捷键 565 | 566 | 功能 按键 567 | ---------------------- -------- 568 | 选择/不选择当前字体 \\[cnfonts-ui-toggle-select-font] 569 | 570 | 571 | ** 中英文等宽对齐快捷键 572 | 573 | 功能 按键 574 | ---------------------- -------- 575 | 增大光标处的字号来对齐 \\[cnfonts-ui-increase-align] 576 | 减小光标处的字号来对齐 \\[cnfonts-ui-decrease-align] 577 | 578 | ** 其它快捷键 579 | 580 | 功能 按键 581 | ---------------------- -------- 582 | 重启UI \\[cnfonts-ui-restart] 583 | ")) 584 | (cnfonts-ui--create-tab-stop-point)) 585 | 586 | (cnfonts-ui-create-page help-page 587 | (cnfonts-ui--create-tab-stop-point) 588 | (cnfonts-ui--create-navigation) 589 | (widget-insert "\n\n") 590 | (let ((file (concat 591 | (file-name-directory 592 | (locate-library "cnfonts")) 593 | "cnfonts.el")) 594 | begin end string) 595 | (when (file-exists-p file) 596 | (with-temp-buffer 597 | (insert-file-contents file) 598 | (goto-char (point-min)) 599 | (when (re-search-forward "^;;; Commentary:$" nil t) 600 | (setq begin (line-beginning-position 2)) 601 | (when (re-search-forward "^;;; Code:$") 602 | (setq end (line-beginning-position)))) 603 | (when (and begin end) 604 | (setq string 605 | (replace-regexp-in-string 606 | ":README:" "" 607 | (replace-regexp-in-string 608 | "^;; " "" 609 | (buffer-substring-no-properties 610 | begin end))))))) 611 | (widget-insert (or string ""))) 612 | (cnfonts-ui--create-tab-stop-point)) 613 | 614 | (defun cnfonts-ui-forward (&optional backward) 615 | "Switch to next widget of current page. 616 | If BACKWARD is non-nil, switch to previous widget." 617 | (interactive) 618 | (run-hooks 'widget-forward-hook) 619 | (let ((step (if backward -1 1)) 620 | (forward t)) 621 | (widget-move step) 622 | (while forward 623 | (if (widget-get (widget-at) :tab-stop-point) 624 | (setq forward nil) 625 | (widget-move step))))) 626 | 627 | (defun cnfonts-ui-backward () 628 | "Switch to previous widget of current page." 629 | (interactive) 630 | (cnfonts-ui-forward t)) 631 | 632 | (defun cnfonts-ui-next-page () 633 | "Switch to next page of cnfonts-ui." 634 | (interactive) 635 | (cnfonts-ui--operate-page 1)) 636 | 637 | (defun cnfonts-ui--operate-page (step) 638 | "Internal function, which used to cnfonts-ui page switch." 639 | (let* ((pages (mapcar #'car cnfonts-ui--pages)) 640 | (pos-max (- (length pages) 1)) 641 | (cur-page-pos 642 | (cl-position cnfonts-ui--current-page pages)) 643 | (next-page-pos 644 | (if cur-page-pos 645 | (if (> step 0) 646 | (if (> (+ step cur-page-pos) pos-max) 647 | 0 648 | (+ step cur-page-pos)) 649 | (if (< (+ step cur-page-pos) 0) 650 | pos-max 651 | (+ step cur-page-pos))) 652 | 0)) 653 | (next-page (nth next-page-pos pages))) 654 | (cnfonts-ui--switch-to-page next-page))) 655 | 656 | (defun cnfonts-ui-previous-page () 657 | "Switch to previous page of cnfonts-ui." 658 | (interactive) 659 | (cnfonts-ui--operate-page -1)) 660 | 661 | (defun cnfonts-ui-restart () 662 | "Restart cnfonts-ui." 663 | (interactive) 664 | (let ((current-page cnfonts-ui--current-page) 665 | (point (point))) 666 | (cnfonts-ui) 667 | (cnfonts-ui--switch-to-page current-page) 668 | (goto-char point))) 669 | 670 | ;; * Footer 671 | (provide 'cnfonts-ui) 672 | 673 | ;;; cnfonts-ui.el ends here 674 | -------------------------------------------------------------------------------- /cnfonts.el: -------------------------------------------------------------------------------- 1 | ;;; cnfonts.el --- A simple Chinese fonts config tool -*- lexical-binding: t; -*- 2 | 3 | ;; * Header 4 | ;; Copyright (c) 2011-2015, Feng Shu 5 | 6 | ;; Author: Feng Shu 7 | ;; URL: https://github.com/tumashu/cnfonts 8 | ;; Package-Requires: ((emacs "24")) 9 | ;; Version: 1.1.3 10 | ;; Keywords: convenience, Chinese, font 11 | 12 | ;; This file is not part of GNU Emacs. 13 | 14 | ;; This program is free software; you can redistribute it and/or 15 | ;; modify it under the terms of the GNU General Public License 16 | ;; as published by the Free Software Foundation; either version 3 17 | ;; of the License, or (at your option) any later version. 18 | 19 | ;; This program is distributed in the hope that it will be useful, 20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 | ;; GNU General Public License for more details. 23 | 24 | ;; You should have received a copy of the GNU General Public License 25 | ;; along with GNU Emacs; see the file COPYING. If not, write to the 26 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 27 | ;; Boston, MA 02110-1301, USA. 28 | 29 | ;;; Commentary: 30 | 31 | ;; * cnfonts README :README: 32 | 33 | ;; cnfonts 原来叫: chinese-fonts-setup, 是一个 Emacs 中英文字体配置工 34 | ;; 具。可以比较方便地实现中文字体和英文字体等宽（也就是大家常说的中英 35 | ;; 文对齐）。 36 | 37 | ;; 注：这个 package 特别适用于需要处理中英文混合表格的中文 org-mode 用 38 | ;; 户。 39 | 40 | ;;; Code: 41 | 42 | ;; * 代码 :code: 43 | (require 'cl-lib) 44 | (require 'mwheel) 45 | (require 'touch-screen nil t) 46 | 47 | (defgroup cnfonts nil 48 | "Chinese fonts setup." 49 | :prefix "cnfonts-" 50 | :group 'applications) 51 | 52 | (defcustom cnfonts-profiles '("profile1" "profile2" "profile3") 53 | "Lists cnfonts profiles." 54 | :type '(repeat string)) 55 | 56 | (defcustom cnfonts-default-fontsize 12.5 57 | "Default cnfonts fontsize." 58 | :type 'number) 59 | 60 | (defcustom cnfonts-directory (locate-user-emacs-file "cnfonts/") 61 | "Directory, cnfonts config file and profiles will be stored in." 62 | :type 'directory) 63 | 64 | (defcustom cnfonts-config-filename "cnfonts.conf" 65 | "Filename of cnfonts config file. 66 | It record the current profile and profile fontsize." 67 | :type 'string) 68 | 69 | (defcustom cnfonts-use-system-type nil 70 | "构建 profile 文件所在的目录时，是否考虑当前的 `system-type'. 71 | 72 | 假设当前系统为 Linux, 当这个选项设置为 t 后，profile1 文件的路径， 73 | 将从 'DIR/profile1.el' 转为 'DIR/SYSTEM-TYPE/profile.el'" 74 | :type 'boolean) 75 | 76 | (defcustom cnfonts-keep-frame-size t 77 | "在调整字体的时候，是否保持当前 frame 大小不变." 78 | :type 'boolean) 79 | 80 | (defcustom cnfonts-disable-bold nil 81 | "是否禁用英文粗体." 82 | :type 'boolean) 83 | 84 | (defcustom cnfonts-disable-italic nil 85 | "是否禁用英文斜体." 86 | :type 'boolean) 87 | 88 | (defcustom cnfonts-disable-bold-italic nil 89 | "是否禁用英文粗斜体." 90 | :type 'boolean) 91 | 92 | (defcustom cnfonts-use-face-font-rescale nil 93 | "是否通过设定 `face-font-rescale-alist' 来达到中英文对齐. 94 | 95 | 在 window 平台下，将这个变量设置为 t 会导致 cnfonts 字体对齐功能 96 | 失效，在大多数 linux 平台下这个功能都可以正常使用。" 97 | :type 'boolean) 98 | 99 | (defcustom cnfonts-set-font-finish-hook nil 100 | "A hook, by which user can set additional fonts." 101 | :type 'hook) 102 | 103 | (defvar cnfonts-mode-map 104 | (let ((map (make-sparse-keymap))) 105 | (define-key map (kbd "C-") #'cnfonts-mouse-wheel) 106 | (define-key map (kbd "C-") #'cnfonts-mouse-wheel) 107 | (define-key map (kbd "C-") #'cnfonts-mouse-wheel) 108 | (define-key map (kbd "C-") #'cnfonts-mouse-wheel) 109 | (define-key map (kbd "") #'cnfonts-touch-screen-pinch) 110 | map) 111 | "Keymap used by `cnfonts-mode'.") 112 | 113 | 114 | (defvar cnfonts--config-info nil 115 | "The cofonts config info read from config file.") 116 | 117 | (defconst cnfonts--fontsizes-fallback 118 | '((6 7 7 6 6 ) 119 | (7 8 8 7 7 ) 120 | (8 9 9 8 8 ) 121 | (9 10.5 10.5 9 9 ) 122 | (10 12.0 12.0 10 10 ) 123 | (11 13.0 13.0 11 11 ) 124 | (11.5 13.5 13.5 11.5 11.5) 125 | (12 14.0 14.0 12 12 ) 126 | (12.5 15.0 15.0 12.5 12.5) 127 | (13 15.5 15.5 13 13 ) 128 | (13.5 16.0 16.0 13.5 13.5) 129 | (14 16.5 16.5 14 14 ) 130 | (14.5 17.0 17.0 14.5 14.5) 131 | (15 18.0 18.0 15 15 ) 132 | (16 19.5 19.5 16 16 ) 133 | (18 21.0 21.0 18 18 ) 134 | (20 24.0 24.0 20 20 ) 135 | (22 25.5 25.5 22 22 ) 136 | (24 28.5 28.5 24 24 ) 137 | (26 31.5 31.5 26 26 ) 138 | (28 33.0 33.0 28 28 ) 139 | (30 36.0 36.0 30 30 ) 140 | (32 39.0 39.0 32 32 )) 141 | "一个列表，每一个元素都有类似结构： 142 | 143 | (英文字号 中文字号 EXT-B字体字号 Symbol字体字号).") 144 | 145 | (defcustom cnfonts-personal-fontnames nil 146 | "用户自己维护的字体列表，结构同 `cnfonts--fontnames-fallback'." 147 | :group 'cnfonts 148 | :type '(choice 149 | (const :tag "None" nil) 150 | (list (repeat :tag "English fonts" string) 151 | (repeat :tag "Chinese fonts" string) 152 | (repeat :tag "Ext-B fonts" string) 153 | (repeat :tag "Symbol fonts" string) 154 | (repeat :tag "Fonts used for ornament chars " string)))) 155 | 156 | (defconst cnfonts--fontnames-fallback 157 | '(;; 英文字体 158 | ("Monaco" "Consolas" "DejaVu Sans Mono" "Droid Sans Mono" 159 | "PragmataPro Mono" "Courier" "Courier New" "Ubuntu Mono" 160 | "Liberation Mono" "MonacoB" "MonacoB2" "MonacoBSemi" 161 | "Droid Sans Mono Pro" "Inconsolata" "Source Code Pro" 162 | "Lucida Console" "Envy Code R" "Andale Mono" 163 | "Lucida Sans Typewriter" "monoOne" "Lucida Typewriter" 164 | "Panic Sans" "Hack" "Bitstream Vera Sans Mono" "HyperFont" 165 | "PT Mono" "Ti92Pluspc" "Excalibur Monospace" "Menlof" 166 | "Cousine" "Fira Mono" "Lekton" "M+ 1mn" "BPmono" "Free Mono" 167 | "Anonymous Pro" "ProFont" "ProFontWindows" "Latin Modern Mono" 168 | "Code 2002" "ProggyCleanTT" "ProggyTinyTT" "Iosevka Term" 169 | "Inconsolata-dz" "American Typewriter" "Menlo" "Ubuntu Mono" 170 | "Anka/Coder Condensed" "Fantasque Sans Mono" "M+ 1m" "CamingoCode" 171 | "Office Code Pro" "Roboto Mono" "Input Mono" "Courier Prime Code" 172 | "NanumGothicCoding" "Monoid" "Edlo" "Iosevka" "Mononoki" 173 | "Robot Mono" "Fantasque" "Fira Code" "Go Mono" "Noto Sans Mono CJK" 174 | "InputMonoCompressed" "Hasklig" "Terminus" "FantasqueSansMono" 175 | "AnonymousPro" "Arimo" "D2Coding" "Inconsolata-g" "Noto Mono" 176 | "ProFont for Powerline" "Meslo" "Meslo Dotted" "Symbol Neu" 177 | "Tinos" "Space Mono" "SFMono Nerd Font") 178 | ;; 中文字体 179 | ("微软雅黑" "Noto Sans Mono CJK SC" "Noto Sans Mono CJK TC" 180 | "Noto Sans CJK SC" "Noto Sans CJK TC" "Microsoft Yahei" 181 | "Microsoft YaHei Mono" "Microsoft_Yahei" "Ubuntu Mono" 182 | "文泉驿等宽微米黑" "文泉驿等宽正黑" "黑体" "Source Han Serif CN" 183 | "Source Han Sans CN" "思源黑体 CN" "思源宋体 CN" "Hiragino Sans GB" 184 | "文泉驿正黑" "文泉驿点阵正黑" "SimHei" "SimSun" "NSimSun" 185 | "FangSong" "KaiTi" "FangSong_GB2312" "KaiTi_GB2312" "LiSu" 186 | "YouYuan" "新宋体" "宋体" "楷体_GB2312" "仿宋_GB2312" "幼圆" 187 | "隶书" "STXihei" "STKaiti" "STSong" "STFangsong" "STXingkai" 188 | "华文仿宋" "华文行楷" "华文细黑" "华文楷体" ) 189 | ;; EXT-B 字体 190 | ("HanaMinB" "SimSun-ExtB" "MingLiU-ExtB" "PMingLiU-ExtB" 191 | "MingLiU_HKSCS-ExtB" "Hanazono Mincho" "Hanazono Mincho A" 192 | "Hanazono Mincho B" "Hanazono Mincho C" "Hanazono Mincho Ex" 193 | "Hanazono Mincho Ex A1" "Hanazono Mincho Ex A2" 194 | "Hanazono Mincho Ex B" "Hanazono Mincho Ex C" "Hanazono Mincho I") 195 | ;; Symbol 字符字体 196 | ("Segoe UI Symbol" "Symbola" "Standard Symbols L") 197 | ;; Emacs 社区配置中，用于装饰的字符使用的字体 198 | ("NanumGothic" "Arial Unicode MS" "MS Gothic" 199 | "Lucida Sans Unicode"))) 200 | 201 | (defcustom cnfonts-ornaments 202 | (list 203 | ;; spacemacs window numbers 204 | '(#x2776 . #x2793) 205 | ;; spacemacs mode-line circled letters 206 | '(#x24b6 . #x24fe) 207 | ;; spacemacs mode-line additional characters 208 | '(#x2295 . #x22a1) 209 | ;; spacemacs new version lighter 210 | '(#x2190 . #x2200)) 211 | "字符区间组成的列表，emacs 社区配置来美化和点缀。" 212 | :type 'sexp) 213 | 214 | (defvar cnfonts--minibuffer-echo-string nil) 215 | 216 | (defvar cnfonts--custom-set-fontnames nil 217 | "*专用* 变量，只用与 cnfonts 的 profile 文件. 218 | 219 | 这些 profile 文件保存在 `cnfonts-directory' 对应的目录中。在其它 220 | 地方设置这个变量没有任何用处！") 221 | 222 | (defvar cnfonts--custom-set-fontsizes nil 223 | "*专用* 变量，只用与 cnfonts 的 profile 文件. 224 | 225 | 这些 profile 文件保存在 `cnfonts-directory' 对应的目录中。在其它 226 | 地方设置这个变量没有任何用处！") 227 | 228 | ;;;###autoload 229 | (define-minor-mode cnfonts-mode 230 | "cnfonts mode." 231 | :global t 232 | (cond 233 | (cnfonts-mode 234 | (add-hook 'after-make-frame-functions #'cnfonts-set-font) 235 | (add-hook 'window-setup-hook #'cnfonts-set-font) 236 | (message (concat "[cnfonts]: cnfonts-mode 激活, " 237 | "使用 `cnfonts-edit-profile' 命令调整字体设置。"))) 238 | (t (remove-hook 'after-make-frame-functions #'cnfonts-set-font) 239 | (remove-hook 'window-setup-hook #'cnfonts-set-font)))) 240 | 241 | ;; 两个兼容命令，未来会删除，建议使用 cnfonts-mode. 242 | (defun cnfonts-enable () (cnfonts-mode 1)) 243 | (defun cnfonts-disable () (cnfonts-mode -1)) 244 | 245 | ;;;###autoload 246 | (defun cnfonts-set-font (&optional frame) 247 | "使用已经保存的字号设置字体. 248 | 如果 FRAME 是 non-nil, 设置对应的 FRAME 的字体。" 249 | (interactive) 250 | (cnfonts--read-profile) 251 | (let* ((profile-name (cnfonts--get-current-profile t)) 252 | (profile-fontsize 253 | (cnfonts--get-profile-fontsize profile-name)) 254 | (fontsizes-list 255 | (cnfonts--get-fontsizes profile-fontsize))) 256 | (when (display-graphic-p frame) 257 | (if frame 258 | (with-selected-frame frame 259 | (cnfonts--set-font fontsizes-list)) 260 | (cnfonts--set-font fontsizes-list))) 261 | (cnfonts--update-and-save-config 262 | profile-name (car fontsizes-list)) 263 | (cnfonts--save-profile) 264 | ;; This is useful for exwm to adjust mode-line, please see: 265 | ;; https://github.com/ch11ng/exwm/issues/249#issuecomment-299692305 266 | (redisplay t))) 267 | 268 | (defun cnfonts--read-profile (&optional profile-name force-read) 269 | "Get previously saved fontnames and fontsizes. 270 | 271 | When PROFILE-NAME is provided, read it instead of current 272 | profile. When FORCE-READ is non-nil, profile file will be 273 | re-read." 274 | (cnfonts--read-config) 275 | (cnfonts--read-profile-1 profile-name force-read) 276 | (cnfonts--update-and-save-config profile-name)) 277 | 278 | (defun cnfonts--read-config () 279 | "Read cnfonts's config file." 280 | (unless cnfonts--config-info 281 | (let ((save-file (cnfonts--return-config-file-path))) 282 | (when (file-readable-p save-file) 283 | (with-temp-buffer 284 | (insert-file-contents save-file) 285 | (setq cnfonts--config-info 286 | (read (current-buffer)))))))) 287 | 288 | (defun cnfonts--return-config-file-path () 289 | "Return the path of config file." 290 | (expand-file-name 291 | (concat (file-name-as-directory cnfonts-directory) 292 | cnfonts-config-filename))) 293 | 294 | (defun cnfonts--read-profile-1 (profile-name force-read) 295 | "Internal function of `cnfonts--read-profile'." 296 | (when (or force-read 297 | (not (and cnfonts--custom-set-fontnames 298 | cnfonts--custom-set-fontsizes))) 299 | (load (if profile-name 300 | (cnfonts--get-profile profile-name) 301 | (cnfonts--get-current-profile)) 302 | t t) 303 | (setq cnfonts--custom-set-fontnames 304 | (cnfonts--merge-fontnames 305 | cnfonts--custom-set-fontnames 306 | cnfonts-personal-fontnames 307 | cnfonts--fontnames-fallback)) 308 | (setq cnfonts--custom-set-fontsizes 309 | (cnfonts--merge-fontsizes 310 | cnfonts--custom-set-fontsizes 311 | cnfonts--fontsizes-fallback)))) 312 | 313 | (defun cnfonts--get-profile (profile-name) 314 | "Get profile file which name is PROFILE-NAME." 315 | (let* ((cnfonts-profile-version "v4") ;; 升级 profile 格式时改变版本号 316 | (directory-name 317 | (file-name-as-directory 318 | (concat (file-name-as-directory cnfonts-directory) 319 | cnfonts-profile-version 320 | "/" 321 | (if cnfonts-use-system-type 322 | (replace-regexp-in-string 323 | "/" "-" 324 | (symbol-name system-type)) 325 | ""))))) 326 | (make-directory directory-name t) 327 | (expand-file-name 328 | (concat directory-name 329 | (replace-regexp-in-string 330 | "/" "-" 331 | profile-name) 332 | ".el")))) 333 | 334 | (defun cnfonts--get-current-profile (&optional return-profile-name) 335 | "Get current profile file. 336 | 337 | When RETURN-PROFILE-NAME is non-nil, return current profile 338 | file's name." 339 | (let* ((profile-name (car (car cnfonts--config-info))) 340 | (profile-name 341 | (if (member profile-name cnfonts-profiles) 342 | profile-name 343 | (car cnfonts-profiles)))) 344 | (if return-profile-name 345 | profile-name 346 | (cnfonts--get-profile profile-name)))) 347 | 348 | (defun cnfonts--merge-fontnames (list1 list2 list3) 349 | "Merge fontname lists LIST1, LIST2 and LIST3 into one." 350 | (let ((n (max (length list1) 351 | (length list2) 352 | (length list3))) 353 | output) 354 | (dotimes (i n) 355 | (let ((x1 (ignore-errors (nth i list1))) 356 | (x2 (ignore-errors (nth i list2))) 357 | (x3 (ignore-errors (nth i list3)))) 358 | (push (delete-dups 359 | (remove nil `(,@x1 ,@x2 ,@x3))) 360 | output))) 361 | (reverse output))) 362 | 363 | (defun cnfonts--merge-fontsizes (list1 list2) 364 | "Merge fontsizes lists LIST1, LIST2 and LIST3 into one." 365 | (let ((keys (if (> (length list1) (length list2)) 366 | (mapcar #'car list1) 367 | (mapcar #'car list2))) 368 | result) 369 | (dolist (key keys) 370 | (let* ((x1 (assoc key list1 #'=)) 371 | (x2 (assoc key list2 #'=)) 372 | (n1 (length x1)) 373 | (n2 (length x2))) 374 | (if (>= n1 n2) 375 | (push x1 result) 376 | (push `(,@x1 ,@(nthcdr n1 x2)) result)))) 377 | (reverse result))) 378 | 379 | (defun cnfonts--update-and-save-config (profile-name &optional fontsize) 380 | "Update PROFILE-NAME and FONTSIZE into config file." 381 | (when profile-name 382 | (let* ((size (cdr (assoc profile-name cnfonts--config-info))) 383 | (fontsize (or fontsize size))) 384 | (setq cnfonts--config-info 385 | (cons (cons profile-name fontsize) 386 | (cl-remove-if 387 | (lambda (x) 388 | (or (equal (car x) profile-name) 389 | (equal (car x) 't))) 390 | cnfonts--config-info))))) 391 | (cnfonts--save-config)) 392 | 393 | (defun cnfonts--save-config () 394 | "Save cnfonts config ." 395 | (with-temp-file (cnfonts--return-config-file-path) 396 | (prin1 (cl-remove-duplicates 397 | (remove nil cnfonts--config-info) 398 | :test (lambda (x y) 399 | (equal (car x) (car y))) 400 | :from-end t) 401 | (current-buffer)))) 402 | 403 | (defun cnfonts--get-profile-fontsize (profile-name) 404 | "Get the font size info from profile which name is PROFILE-NAME." 405 | (let ((fontsize 406 | (cdr (assoc profile-name 407 | cnfonts--config-info)))) 408 | (min (max (or fontsize cnfonts-default-fontsize) 6) 32))) 409 | 410 | (defun cnfonts--get-fontsizes (&optional fontsize) 411 | "获取 FONTSIZE 对应的 fontsize-list." 412 | (unless (file-exists-p (cnfonts--get-current-profile)) 413 | (message (concat 414 | "[cnfonts]: 如果中英文不能对齐，" 415 | "请运行 `cnfonts-edit-profile' 编辑当前 profile。"))) 416 | (when (numberp fontsize) 417 | (assoc fontsize cnfonts--custom-set-fontsizes #'=))) 418 | 419 | (defun cnfonts--set-font (fontsizes-list) 420 | "根据 FONTSIZES-LIST 调整当前 frame 使用的字体. 421 | 422 | 当全局变量 `cnfonts-keep-frame-size'设置为 t 时，调整字体时保持当 423 | 前 frame 大小不变。" 424 | (if (not cnfonts-use-face-font-rescale) 425 | (cnfonts--set-face-font-rescale nil) 426 | (cnfonts--set-face-font-rescale fontsizes-list) 427 | ;; 通过设定 `face-font-rescale-alist' 来实现中英文对齐时， 428 | ;; 只设定英文字体字号，中文等字体字号不设定。 429 | (setq fontsizes-list 430 | (list (car fontsizes-list)))) 431 | (when (display-multi-font-p) 432 | (let ((frame-inhibit-implied-resize 433 | cnfonts-keep-frame-size)) 434 | (cnfonts--set-font-1 fontsizes-list) 435 | (run-hook-with-args 'cnfonts-set-font-finish-hook 436 | fontsizes-list)))) 437 | 438 | (defun cnfonts--set-face-font-rescale (fontsizes-list) 439 | "根据 FONTSIZES-LIST 设定 `face-font-rescale-alist' 系数." 440 | (setq face-font-rescale-alist 441 | (when fontsizes-list 442 | (cl-loop 443 | for font in (cnfonts--get-valid-fonts) 444 | for size in fontsizes-list 445 | collect (cons font (/ (float size) 446 | (car fontsizes-list))))))) 447 | 448 | (defun cnfonts--get-valid-fonts () 449 | "获取当前可用字体并返回一个列表。" 450 | (mapcar #'cnfonts--find-valid-font 451 | cnfonts--custom-set-fontnames)) 452 | 453 | (defun cnfonts--find-valid-font (fonts) 454 | "从 FONTS 中寻找一个可用的字体。" 455 | (let (font) 456 | (while fonts 457 | (setq font (pop fonts)) 458 | (when (setq font (cnfonts--font-exists-p font)) 459 | (setq fonts nil))) 460 | font)) 461 | 462 | (defun cnfonts--font-exists-p (font &optional fast) 463 | "测试 FONT 是否存在，如果存在，则返回可用字体名称." 464 | (or (when-let* ((xlfd (car (x-list-fonts font nil nil 1))) 465 | (lst (split-string xlfd "-")) 466 | (name (string-join 467 | (cl-subseq lst 2 (- (length lst) 12)) 468 | "-")) 469 | ;; 名称只包含数字的字体不做处理。 470 | (non-num-p (string-match-p "[^0-9]" font))) 471 | name) 472 | (unless fast 473 | (cl-find-if 474 | (lambda (x) 475 | (or (equal font x) 476 | (equal (encode-coding-string font 'utf-8) x) 477 | (equal (encode-coding-string font 'gbk) x))) 478 | (font-family-list))))) 479 | 480 | (defun cnfonts--set-font-1 (fontsizes-list) 481 | "核心函数，用于设置字体. 482 | 483 | 参数 FONTSIZES-LIST 是一个列表，其结构类似： 484 | 485 | (英文字号 中文字号 EXT-B字号 Symbol字号 装饰用字体字号) 486 | 487 | 其中，英文字体字号必须设定，其余字体字号可以设定，也可以省略。" 488 | (let* ((valid-fonts (cnfonts--get-valid-fonts)) 489 | 490 | (english-fontname (nth 0 valid-fonts)) 491 | (chinese-fontname (nth 1 valid-fonts)) 492 | (extb-fontname (nth 2 valid-fonts)) 493 | (symbol-fontname (nth 3 valid-fonts)) 494 | (ornament-fontname (nth 4 valid-fonts)) 495 | 496 | (english-fontsize 497 | (cnfonts--float (nth 0 fontsizes-list))) 498 | (chinese-fontsize 499 | (cnfonts--float (nth 1 fontsizes-list))) 500 | (extb-fontsize 501 | (cnfonts--float (nth 2 fontsizes-list))) 502 | (symbol-fontsize 503 | (cnfonts--float (nth 3 fontsizes-list))) 504 | (ornament-fontsize 505 | (cnfonts--float (nth 4 fontsizes-list))) 506 | 507 | (english-fontspec 508 | (when english-fontname 509 | (font-spec :name english-fontname 510 | :size english-fontsize))) 511 | (english-bold-fontspec 512 | (when english-fontname 513 | (font-spec :name english-fontname 514 | :size english-fontsize 515 | :weight 'bold))) 516 | (english-italic-fontspec 517 | (when english-fontname 518 | (font-spec :name english-fontname 519 | :size english-fontsize 520 | :slant 'italic))) 521 | (english-bold-italic-fontspec 522 | (when english-fontname 523 | (font-spec :name english-fontname 524 | :size english-fontsize 525 | :weight 'bold 526 | :slant 'italic))) 527 | (chinese-fontspec 528 | (when chinese-fontname 529 | (font-spec :name chinese-fontname 530 | :size chinese-fontsize))) 531 | (extb-fontspec 532 | (when extb-fontname 533 | (font-spec :name extb-fontname 534 | :size extb-fontsize))) 535 | (symbol-fontspec 536 | (when symbol-fontname 537 | (font-spec :name symbol-fontname 538 | :size symbol-fontsize))) 539 | (ornament-fontspec 540 | (when ornament-fontname 541 | (font-spec :name ornament-fontname 542 | :size ornament-fontsize)))) 543 | 544 | (when (cnfonts--fontspec-valid-p english-fontspec) 545 | ;; 设置英文字体。 546 | (set-face-attribute 547 | 'default nil :font english-fontspec) 548 | ;; 设置英文粗体。 549 | (if cnfonts-disable-bold 550 | (set-face-font 'bold english-fontspec) 551 | (if (cnfonts--fontspec-valid-p english-bold-fontspec) 552 | (set-face-font 'bold english-bold-fontspec) 553 | (message 554 | "[cnfonts]: %S 对应的粗体没有找到，不作处理！" 555 | english-fontname))) 556 | 557 | ;; 设置英文斜体。 558 | (if cnfonts-disable-italic 559 | (set-face-font 'italic english-fontspec) 560 | (if (cnfonts--fontspec-valid-p english-italic-fontspec) 561 | (set-face-font 'italic english-italic-fontspec) 562 | (message 563 | "[cnfonts]: %S 对应的斜体没有找到，不作处理！" 564 | english-fontname))) 565 | 566 | ;; 设置英文粗斜体。 567 | (if cnfonts-disable-bold-italic 568 | (set-face-font 569 | 'bold-italic english-fontspec) 570 | (if (cnfonts--fontspec-valid-p english-bold-italic-fontspec) 571 | (set-face-font 572 | 'bold-italic english-bold-italic-fontspec) 573 | (message 574 | "[cnfonts]: %S 对应的粗斜体没有找到，不作处理！" 575 | english-fontname)))) 576 | 577 | ;; 设置中文字体，注意，不要使用 'unicode charset, 578 | ;; 否则上面的英文字体设置将会失效。 579 | (when (cnfonts--fontspec-valid-p chinese-fontspec) 580 | (dolist (charset '(kana han cjk-misc bopomofo hangul)) 581 | (set-fontset-font 582 | "fontset-default" 583 | charset chinese-fontspec))) 584 | 585 | ;; 当所选的 chinese-fontspec 不支持韩语(hangul)时, 用 586 | ;; extb-fontspec 来显示 587 | (when (cnfonts--fontspec-valid-p extb-fontspec) 588 | (set-fontset-font 589 | "fontset-default" 590 | 'hangul extb-fontspec nil 'append)) 591 | 592 | ;; 设置 EXT-B 字体，用于显示不常用的汉字。 593 | (when (cnfonts--fontspec-valid-p extb-fontspec) 594 | (set-fontset-font 595 | "fontset-default" 596 | nil extb-fontspec nil 'prepend)) 597 | 598 | ;; 设置 symbol 字体。 599 | (when (cnfonts--fontspec-valid-p symbol-fontspec) 600 | (dolist (charset '(symbol phonetic)) 601 | (set-fontset-font 602 | "fontset-default" 603 | charset symbol-fontspec nil 'prepend))) 604 | 605 | ;; 设置点缀字符的字体。 606 | (when (cnfonts--fontspec-valid-p ornament-fontspec) 607 | (dolist (charset cnfonts-ornaments) 608 | (set-fontset-font 609 | "fontset-default" 610 | charset ornament-fontspec nil 'prepend))) 611 | 612 | (setq cnfonts--minibuffer-echo-string 613 | (format "[cnfonts]: %s 英文字体: %s-%.1f，中文字体: %s, EXTB字体：%s" 614 | (cnfonts--get-current-profile t) 615 | (or english-fontname "无") english-fontsize 616 | (or chinese-fontname "无") 617 | (or extb-fontname "无"))) 618 | (message ""))) 619 | 620 | (defun cnfonts--float (num) 621 | "确保一个 NUM 总是浮点格式." 622 | (when (numberp num) 623 | (float num))) 624 | 625 | (defun cnfonts--fontspec-valid-p (fontspec) 626 | "检查 FONTSPEC 是否有效." 627 | (and fontspec (list-fonts fontspec))) 628 | 629 | (defun cnfonts--save-profile (&optional profile-name 630 | use-fallback) 631 | "Save FONTNAMES and FONTSIZES to current profile. 632 | When PROFILE-NAME is non-nil, save to this profile instead." 633 | (with-temp-buffer 634 | (insert ";; -*- lexical-binding: t; -*-") 635 | (insert "\n") 636 | (insert (concat 637 | ";; `cnfonts--custom-set-fontsnames' 结构" 638 | "与 `cnfonts--fontnames-fallback' 相同。")) 639 | (cnfonts--dump-variable 640 | 'cnfonts--custom-set-fontnames 641 | (mapcar #'delete-dups 642 | (if use-fallback 643 | cnfonts--fontnames-fallback 644 | cnfonts--custom-set-fontnames))) 645 | (insert "\n") 646 | (insert (concat 647 | ";; `cnfonts--custom-set-fontsizes' 结构" 648 | "与 `cnfonts--fontsizes-fallback' 相同。")) 649 | (cnfonts--dump-variable 650 | 'cnfonts--custom-set-fontsizes 651 | (if use-fallback 652 | cnfonts--fontsizes-fallback 653 | cnfonts--custom-set-fontsizes)) 654 | (write-region 655 | (point-min) (point-max) 656 | (cnfonts--get-profile 657 | (or profile-name 658 | (cnfonts--get-current-profile t))) 659 | nil :silent))) 660 | 661 | (defun cnfonts--dump-variable (variable value) 662 | "Insert a \"(setq VARIABLE VALUE)\" in the current buffer." 663 | (cond ((atom value) 664 | (insert (format "\n(setq %S %S)\n" 665 | variable value))) 666 | ((atom (car value)) 667 | (insert (format "\n(setq %S\n '%S)\n" 668 | variable value))) 669 | (t (insert (format "\n(setq %S\n '(" variable)) 670 | (dolist (exp value) 671 | (insert (concat "\n (" 672 | (mapconcat 673 | (lambda (x) 674 | (format "%-4S" x)) 675 | exp " ") 676 | ")"))) 677 | (insert "\n ))\n")))) 678 | 679 | ;; Functions used by cnfonts-ui. 680 | (defun cnfonts--update-profile-fontnames (font-type-index 681 | font) 682 | (setf (nth font-type-index cnfonts--custom-set-fontnames) 683 | (delete-dups 684 | `(,font ,@(nth font-type-index 685 | cnfonts--custom-set-fontnames))))) 686 | 687 | (defun cnfonts--update-profile-fontsizes (english-size 688 | font-type-index 689 | incf-x) 690 | (when (and font-type-index font-type-index (numberp incf-x)) 691 | (cl-incf (nth font-type-index 692 | (assoc english-size 693 | cnfonts--custom-set-fontsizes)) 694 | incf-x))) 695 | 696 | ;;;###autoload 697 | (defun cnfonts-increase-fontsize (&optional arg) 698 | "Cnfonts 增大字体." 699 | (interactive) 700 | (cnfonts--next-fontsize (or arg 1))) 701 | 702 | ;;;###autoload 703 | (defun cnfonts--next-fontsize (n) 704 | "使用下 N 个字号." 705 | (if (not (display-graphic-p)) 706 | (message "[cnfonts]: 不支持 emacs 终端模式！") 707 | (cnfonts--read-profile) 708 | (let* ((steps (mapcar #'car cnfonts--fontsizes-fallback)) 709 | (profile-name 710 | (cnfonts--get-current-profile t)) 711 | (profile-fontsize 712 | (cnfonts--get-profile-fontsize profile-name)) 713 | (index (+ (cl-position 714 | profile-fontsize steps :test #'=) 715 | n)) 716 | (fontsizes-list 717 | (cnfonts--get-fontsizes (nth index steps)))) 718 | (when fontsizes-list 719 | (cnfonts--set-font fontsizes-list) 720 | (cnfonts--update-and-save-config 721 | profile-name (car fontsizes-list)) 722 | (message cnfonts--minibuffer-echo-string))))) 723 | 724 | ;;;###autoload 725 | (defun cnfonts-decrease-fontsize (&optional arg) 726 | "Cnfonts 减小字体." 727 | (interactive) 728 | (cnfonts--next-fontsize (if arg (* arg -1) -1))) 729 | 730 | ;;;###autoload 731 | (defun cnfonts-reset-fontsize () 732 | "使用 `cnfonts-default-fontsize' 重置字号." 733 | (interactive) 734 | (cnfonts--next-fontsize 0)) 735 | 736 | ;;;###autoload 737 | (defun cnfonts-mouse-wheel (event) 738 | "使用 mouse wheel 调整字体大小，类似 `mouse-wheel-text-scale'." 739 | (interactive (list last-input-event)) 740 | (if (functionp 'mouse-wheel-text-scale) 741 | (cl-letf (((symbol-function 'text-scale-increase) 742 | #'cnfonts-increase-fontsize) 743 | ((symbol-function 'text-scale-decrease) 744 | #'cnfonts-decrease-fontsize)) 745 | (mouse-wheel-text-scale event)) 746 | (message "当前 Emacs 版本没有 `mouse-wheel-text-scale' 命令。"))) 747 | 748 | ;; Fix warns 749 | (defvar text-scale-mode) 750 | (defvar text-scale-mode-amount) 751 | (defvar touch-screen-aux-tool) 752 | 753 | ;;;###autoload 754 | (defun cnfonts-touch-screen-pinch (event) 755 | "使用 touch screen pinch 调整字体大小，类似: `touch-screen-pinch'." 756 | (interactive "e") 757 | (if (functionp 'touch-screen-pinch) 758 | (cl-letf (((symbol-function 'text-scale-set) 759 | (lambda (x) 760 | (let* ((current-scale 761 | (if text-scale-mode 762 | text-scale-mode-amount 763 | 0)) 764 | (start-scale 765 | (or (aref touch-screen-aux-tool 7) 766 | (aset touch-screen-aux-tool 7 767 | current-scale)))) 768 | (if (> (- x start-scale) 0) 769 | (cnfonts-increase-fontsize) 770 | (cnfonts-decrease-fontsize)))))) 771 | (touch-screen-pinch event)) 772 | (message "当前 Emacs 版本没有 `touch-screen-pinch' 命令。"))) 773 | 774 | ;;;###autoload 775 | (defun cnfonts-switch-profile () 776 | "切换 cnfonts profile." 777 | (interactive) 778 | (let ((profile (completing-read 779 | "Set cnfonts profile to:" 780 | cnfonts-profiles))) 781 | (cnfonts--select-profile profile))) 782 | 783 | (defun cnfonts--select-profile (profile-name) 784 | "选择 PROFILE-NAME." 785 | (if (not (member profile-name cnfonts-profiles)) 786 | (message "[cnfonts]: %s doesn't exist." profile-name) 787 | (cnfonts--read-profile profile-name t) 788 | (cnfonts-set-font))) 789 | 790 | ;;;###autoload 791 | (defun cnfonts-next-profile (&optional _) 792 | "选择下一个字体设置 profile." 793 | (interactive) 794 | (let* ((profiles cnfonts-profiles) 795 | (current-profile 796 | (cnfonts--get-current-profile t)) 797 | (next-profile 798 | (or (cadr (member current-profile profiles)) 799 | (car profiles)))) 800 | (when next-profile 801 | (cnfonts--read-profile next-profile t) 802 | (cnfonts-set-font) 803 | (message "[cnfonts]: Current cnfonts profile is set to: \"%s\"" 804 | next-profile)))) 805 | 806 | ;;;###autoload 807 | (declare-function cnfonts-ui "cnfonts-ui") 808 | (defun cnfonts-edit-profile () 809 | "编辑当前 cnfonts profile." 810 | (interactive) 811 | (if (not (display-graphic-p)) 812 | (message "[cnfonts]: 不支持 emacs 终端模式！") 813 | (cnfonts--read-profile) 814 | (let ((file (cnfonts--get-current-profile))) 815 | (unless (file-readable-p file) 816 | (cnfonts--save-profile nil t)) 817 | (require 'cnfonts-ui) 818 | (cnfonts-ui)))) 819 | 820 | ;;;###autoload 821 | (defun cnfonts-regenerate-profile () 822 | "重新生成当前 profile." 823 | (interactive) 824 | (let ((profile-name (completing-read 825 | "Regenerate profile: " 826 | cnfonts-profiles))) 827 | (if (yes-or-no-p (format "Regenerate (%s)? " profile-name)) 828 | (cnfonts--save-profile profile-name t) 829 | (message "[cnfonts]: Ignore regenerate profile!")))) 830 | 831 | ;; * Footer 832 | (provide 'cnfonts) 833 | 834 | ;;; cnfonts.el ends here 835 | --------------------------------------------------------------------------------