Move :ui pretty-code to :ui ligatures
Includes a major refactor of the module.
This commit is contained in:
Henrik Lissner
parent
ed264dcdb2
commit
7081d833f6
32 changed files with 899 additions and 920 deletions
213
modules/ui/ligatures/config.el
Normal file
213
modules/ui/ligatures/config.el
Normal file
|
|
@ -0,0 +1,213 @@
|
|||
;;; ui/ligatures/config.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar +ligatures-classes
|
||||
'(;; org
|
||||
:name "»"
|
||||
:src_block "»"
|
||||
:src_block_end "«"
|
||||
:quote "“"
|
||||
:quote_end "”"
|
||||
;; Functional
|
||||
:lambda "λ"
|
||||
:def "ƒ"
|
||||
:composition "∘"
|
||||
:map "↦"
|
||||
;; Types
|
||||
:null "∅"
|
||||
:true "𝕋"
|
||||
:false "𝔽"
|
||||
:int "ℤ"
|
||||
:float "ℝ"
|
||||
:str "𝕊"
|
||||
:bool "𝔹"
|
||||
:list "𝕃"
|
||||
;; Flow
|
||||
:not "￢"
|
||||
:in "∈"
|
||||
:not-in "∉"
|
||||
:and "∧"
|
||||
:or "∨"
|
||||
:for "∀"
|
||||
:some "∃"
|
||||
:return "⟼"
|
||||
:yield "⟻"
|
||||
;; Other
|
||||
:union "⋃"
|
||||
:intersect "∩"
|
||||
:diff "∖"
|
||||
:tuple "⨂"
|
||||
:pipe "" ;; FIXME: find a non-private char
|
||||
:dot "•")
|
||||
"Options plist for `set-ligatures!'.
|
||||
|
||||
This should not contain any symbols from the Unicode Private Area! There is no
|
||||
universal way of getting the correct symbol as that area varies from font to
|
||||
font.")
|
||||
|
||||
(defvar +ligatures-composition-alist
|
||||
'((?! . "\\(?:!\\(?:==\\|[!=]\\)\\)") ; (regexp-opt '("!!" "!=" "!=="))
|
||||
(?# . "\\(?:#\\(?:###?\\|_(\\|[#(:=?[_{]\\)\\)") ; (regexp-opt '("##" "###" "####" "#(" "#:" "#=" "#?" "#[" "#_" "#_(" "#{"))
|
||||
(?$ . "\\(?:\\$>>?\\)") ; (regexp-opt '("$>" "$>>"))
|
||||
(?% . "\\(?:%%%?\\)") ; (regexp-opt '("%%" "%%%"))
|
||||
(?& . "\\(?:&&&?\\)") ; (regexp-opt '("&&" "&&&"))
|
||||
(?* . "\\(?:\\*\\(?:\\*[*/]\\|[)*/>]\\)?\\)") ; (regexp-opt '("*" "**" "***" "**/" "*/" "*>" "*)"))
|
||||
(?+ . "\\(?:\\+\\(?:\\+\\+\\|[+:>]\\)?\\)") ; (regexp-opt '("+" "++" "+++" "+>" "+:"))
|
||||
(?- . "\\(?:-\\(?:-\\(?:->\\|[>-]\\)\\|<[<-]\\|>[>-]\\|[:<>|}~-]\\)\\)") ; (regexp-opt '("--" "---" "-->" "--->" "->-" "-<" "-<-" "-<<" "->" "->>" "-}" "-~" "-:" "-|"))
|
||||
(?. . "\\(?:\\.\\(?:\\.[.<]\\|[.=>-]\\)\\)") ; (regexp-opt '(".-" ".." "..." "..<" ".=" ".>"))
|
||||
(?/ . "\\(?:/\\(?:\\*\\*\\|//\\|==\\|[*/=>]\\)\\)") ; (regexp-opt '("/*" "/**" "//" "///" "/=" "/==" "/>"))
|
||||
(?: . "\\(?::\\(?:::\\|[+:<=>]\\)?\\)") ; (regexp-opt '(":" "::" ":::" ":=" ":<" ":=" ":>" ":+"))
|
||||
(?\; . ";;") ; (regexp-opt '(";;"))
|
||||
(?0 . "0\\(?:\\(x[a-fA-F0-9]\\).?\\)") ; Tries to match the x in 0xDEADBEEF
|
||||
;; (?x . "x") ; Also tries to match the x in 0xDEADBEEF
|
||||
;; (regexp-opt '("<!--" "<$" "<$>" "<*" "<*>" "<**>" "<+" "<+>" "<-" "<--" "<---" "<->" "<-->" "<--->" "</" "</>" "<<" "<<-" "<<<" "<<=" "<=" "<=<" "<==" "<=>" "<===>" "<>" "<|" "<|>" "<~" "<~~" "<." "<.>" "<..>"))
|
||||
(?< . "\\(?:<\\(?:!--\\|\\$>\\|\\*\\(?:\\*?>\\)\\|\\+>\\|-\\(?:-\\(?:->\\|[>-]\\)\\|[>-]\\)\\|\\.\\(?:\\.?>\\)\\|/>\\|<[<=-]\\|=\\(?:==>\\|[<=>]\\)\\||>\\|~~\\|[$*+./<=>|~-]\\)\\)")
|
||||
(?= . "\\(?:=\\(?:/=\\|:=\\|<<\\|=[=>]\\|>>\\|[=>]\\)\\)") ; (regexp-opt '("=/=" "=:=" "=<<" "==" "===" "==>" "=>" "=>>"))
|
||||
(?> . "\\(?:>\\(?:->\\|=>\\|>[=>-]\\|[:=>-]\\)\\)") ; (regexp-opt '(">-" ">->" ">:" ">=" ">=>" ">>" ">>-" ">>=" ">>>"))
|
||||
(?? . "\\(?:\\?[.:=?]\\)") ; (regexp-opt '("??" "?." "?:" "?="))
|
||||
(?\[ . "\\(?:\\[\\(?:|]\\|[]|]\\)\\)") ; (regexp-opt '("[]" "[|]" "[|"))
|
||||
(?\\ . "\\(?:\\\\\\\\[\\n]?\\)") ; (regexp-opt '("\\\\" "\\\\\\" "\\\\n"))
|
||||
(?^ . "\\(?:\\^==?\\)") ; (regexp-opt '("^=" "^=="))
|
||||
(?w . "\\(?:wwww?\\)") ; (regexp-opt '("www" "wwww"))
|
||||
(?{ . "\\(?:{\\(?:|\\(?:|}\\|[|}]\\)\\|[|-]\\)\\)") ; (regexp-opt '("{-" "{|" "{||" "{|}" "{||}"))
|
||||
(?| . "\\(?:|\\(?:->\\|=>\\||=\\|[]=>|}-]\\)\\)") ; (regexp-opt '("|=" "|>" "||" "||=" "|->" "|=>" "|]" "|}" "|-"))
|
||||
(?_ . "\\(?:_\\(?:|?_\\)\\)") ; (regexp-opt '("_|_" "__"))
|
||||
(?\( . "\\(?:(\\*\\)") ; (regexp-opt '("(*"))
|
||||
(?~ . "\\(?:~\\(?:~>\\|[=>@~-]\\)\\)")) ; (regexp-opt '("~-" "~=" "~>" "~@" "~~" "~~>"))
|
||||
"An alist of all ligatures used by `+ligatures-extras-in-modes'.
|
||||
|
||||
The car is the character ASCII number, cdr is a regex which will call
|
||||
`font-shape-gstring' when matched.
|
||||
|
||||
Because of the underlying code in :ui ligatures module, the regex should match a
|
||||
string starting with the character contained in car.
|
||||
|
||||
This variable is used only if you built Emacs with Harfbuzz on a version >= 28")
|
||||
|
||||
(defvar +ligatures-extra-alist '((t))
|
||||
"An alist mapping major modes to `prettify-symbols-alist' values.")
|
||||
|
||||
(defvar +ligatures-in-modes
|
||||
'(not special-mode comint-mode eshell-mode term-mode vterm-mode)
|
||||
"List of major modes where ligatures should be enabled.
|
||||
|
||||
If t, enable it everywhere (except `fundamental-mode').
|
||||
If the first element is 'not, enable it in any mode besides what is listed.
|
||||
If nil, don't enable ligatures anywhere.")
|
||||
|
||||
(defvar +ligatures-extras-in-modes t
|
||||
"List of major modes where extra ligatures should be enabled.
|
||||
|
||||
Extra ligatures are mode-specific substituions, defined in `+ligatures-classes'
|
||||
and assigned with `set-ligatures!'. This variable controls where these are
|
||||
enabled.
|
||||
|
||||
If t, enable it everywhere (except `fundamental-mode').
|
||||
If the first element is 'not, enable it in any mode besides what is listed.
|
||||
If nil, don't enable these extra ligatures anywhere (though it's more
|
||||
efficient to remove the `+extra' flag from the :ui ligatures module instead).")
|
||||
|
||||
(defvar +ligatures--init-font-hook nil)
|
||||
|
||||
(defun +ligatures--correct-symbol-bounds (ligature-alist)
|
||||
"Prepend non-breaking spaces to a ligature.
|
||||
|
||||
This way `compose-region' (called by `prettify-symbols-mode') will use the
|
||||
correct width of the symbols instead of the width measured by `char-width'."
|
||||
(let ((len (length (car ligature-alist)))
|
||||
(acc (list (cdr ligature-alist))))
|
||||
(while (> len 1)
|
||||
(setq acc (cons #X00a0 (cons '(Br . Bl) acc))
|
||||
len (1- len)))
|
||||
(cons (car ligature-alist) acc)))
|
||||
|
||||
(defun +ligatures--enable-p (modes)
|
||||
"Return t if ligatures should be enabled in this buffer depending on MODES."
|
||||
(unless (eq major-mode 'fundamental-mode)
|
||||
(or (eq modes t)
|
||||
(if (eq (car modes) 'not)
|
||||
(not (apply #'derived-mode-p (cdr modes)))
|
||||
(apply #'derived-mode-p modes)))))
|
||||
|
||||
(defun +ligatures-init-buffer-h ()
|
||||
"Set up ligatures for the current buffer.
|
||||
|
||||
Extra ligatures are mode-specific substituions, defined in
|
||||
`+ligatures-classes', assigned with `set-ligatures!', and made possible
|
||||
with `prettify-symbols-mode'. This variable controls where these are enabled.
|
||||
See `+ligatures-extras-in-modes' to control what major modes this function can
|
||||
and cannot run in."
|
||||
(when after-init-time
|
||||
(when (+ligatures--enable-p +ligatures-in-modes)
|
||||
(if (boundp '+ligature--composition-table)
|
||||
(setq-local composition-function-table +ligature--composition-table)
|
||||
(run-hooks '+ligatures--init-font-hook)
|
||||
(setq +ligatures--init-font-hook nil)))
|
||||
(when (and (featurep! +extra)
|
||||
(+ligatures--enable-p +ligatures-extras-in-modes))
|
||||
(prependq! prettify-symbols-alist (alist-get major-mode +ligatures-extra-alist)))
|
||||
(when prettify-symbols-alist
|
||||
(if prettify-symbols-mode (prettify-symbols-mode -1))
|
||||
(prettify-symbols-mode +1))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Bootstrap
|
||||
|
||||
;;;###package prettify-symbols
|
||||
;; When you get to the right edge, it goes back to how it normally prints
|
||||
(setq prettify-symbols-unprettify-at-point 'right-edge)
|
||||
|
||||
(add-hook! 'doom-init-ui-hook :append
|
||||
(defun +ligatures-init-h ()
|
||||
(add-hook 'after-change-major-mode-hook #'+ligatures-init-buffer-h)))
|
||||
|
||||
(cond
|
||||
;; The emacs-mac build of Emacs appears to have built-in support for ligatures,
|
||||
;; using the same composition-function-table method
|
||||
;; https://bitbucket.org/mituharu/emacs-mac/src/26c8fd9920db9d34ae8f78bceaec714230824dac/lisp/term/mac-win.el?at=master#lines-345:805
|
||||
;; so use that instead if this module is enabled.
|
||||
((and IS-MAC (fboundp 'mac-auto-operator-composition-mode))
|
||||
(add-hook 'doom-init-ui-hook #'mac-auto-operator-composition-mode 'append))
|
||||
|
||||
;; Harfbuzz and Mac builds do not need font-specific ligature support
|
||||
;; if they are above emacs-27.
|
||||
((and EMACS28+
|
||||
(or (featurep 'ns)
|
||||
(string-match-p "HARFBUZZ" system-configuration-features))
|
||||
(featurep 'composite)) ; Emacs loads `composite' at startup
|
||||
(defvar +ligature--composition-table (make-char-table nil))
|
||||
(add-hook! 'doom-init-ui-hook :append
|
||||
(defun +ligature-init-composition-table-h ()
|
||||
(dolist (char-regexp +ligatures-composition-alist)
|
||||
(set-char-table-range
|
||||
+ligature--composition-table
|
||||
(car char-regexp) `([,(cdr char-regexp) 0 font-shape-gstring])))
|
||||
(set-char-table-parent +ligature--composition-table composition-function-table)
|
||||
(add-hook 'after-change-major-mode-hook #'+ligatures-init-buffer-composition-table-h))))
|
||||
|
||||
;; Fallback ligature support for certain, patched fonts. Install them with
|
||||
;; `+ligatures/install-patched-font'
|
||||
((defmacro +ligatures--def-font (id font-plist &rest alist)
|
||||
(declare (indent 2))
|
||||
(let ((alist-var (intern (format "+ligatures-%s-font-alist" id)))
|
||||
(setup-fn (intern (format "+ligatures-init-%s-font-h" id))))
|
||||
`(progn
|
||||
(setf (alist-get ',id +ligatures--font-alist) (list ,@font-plist))
|
||||
(defvar ,alist-var ',alist ,(format "Name of the %s ligature font." id))
|
||||
(defun ,setup-fn (&rest _)
|
||||
(cl-destructuring-bind (name &key _url files range)
|
||||
(or (alist-get ',id +ligatures--font-alist)
|
||||
(error "No ligature font called %s" ',id))
|
||||
(when range
|
||||
(set-fontset-font t range name nil 'prepend))
|
||||
(setq-default prettify-symbols-alist
|
||||
(append (default-value 'prettify-symbols-alist)
|
||||
(mapcar #'+ligatures--correct-symbol-bounds ,alist-var)))))
|
||||
(add-hook '+ligatures--init-font-hook #',setup-fn))))
|
||||
|
||||
(defvar +ligatures--font-alist ())
|
||||
|
||||
(cond ((featurep! +fira) (load! "+fira"))
|
||||
((featurep! +iosevka) (load! "+iosevka"))
|
||||
((featurep! +hasklig) (load! "+hasklig"))
|
||||
((featurep! +pragmata-pro) (load! "+pragmata-pro")))))
|
||||
Loading…
Add table
Add a link
Reference in a new issue