ink/.emacs.d
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
2240c18f18d216a0b8098d16e817031158fe734f
.emacs.d/lisp/pragmatapro-lig.el
Iñaki Dominguez 2240c18f18 many changes
2022-12-30 22:49:12 +01:00

448 lines
12 KiB
EmacsLisp
Raw Blame History

;; Emacs PramgataPro 0.828 Ligatures Support
;; Author: lumiknit (aasr4r4@gmail.com)
;; Version: 20200211
;; Usage: Use "M-x 'pragmatapro-lig-mode' RET" to turn on ligature minor mode.
;; Or, use 'pragmatapro-lig-global-mode to turn it on globally.
;; I recommend you to compile this file before load it.
(eval-when-compile (defconst pragmatapro-lig-alist
'( ;;("[ERROR]" #Xe2c0)
;; ("[DEBUG]" #Xe2c1)
;; ("[INFO]" #Xe2c2)
;; ("[WARN]" #Xe2c3)
;; ("[WARNING]" #Xe2c4)
;; ("[ERR]" #Xe2c5)
;; ("[FATAL]" #Xe2c6)
;; ("[TRACE]" #Xe2c7)
;; ("[FIXME]" #Xe2c8)
;; ("[TODO]" #Xe2c9)
;; ("[BUG]" #Xe2ca)
;; ("[NOTE]" #Xe2cb)
;; ("[HACK]" #Xe2cc)
;; ("[MARK]" #Xe2cd)
;; ("[FAIL]" #Xe2ce)
;; ("// ERROR" #Xe2e0)
;; ("// DEBUG" #Xe2e1)
;; ("// INFO" #Xe2e2)
;; ("// WARN" #Xe2e3)
;; ("// WARNING" #Xe2e4)
;; ("// ERR" #Xe2e5)
;; ("// FATAL" #Xe2e6)
;; ("// TRACE" #Xe2e7)
;; ("// FIXME" #Xe2e8)
;; ("// TODO" #Xe2e9)
;; ("// BUG" #Xe2ea)
;; ("// NOTE" #Xe2eb)
;; ("// HACK" #Xe2ec)
;; ("// MARK" #Xe2ed)
;; ("// FAIL" #Xe2ee)
;; ("# ERROR" #Xe2f0)
;; ("# DEBUG" #Xe2f1)
;; ("# INFO" #Xe2f2)
;; ("# WARN" #Xe2f3)
;; ("# WARNING" #Xe2f4)
;; ("# ERR" #Xe2f5)
;; ("# FATAL" #Xe2f6)
;; ("# TRACE" #Xe2f7)
;; ("# FIXME" #Xe2f8)
;; ("# TODO" #Xe2f9)
;; ("# BUG" #Xe2fa)
;; ("# NOTE" #Xe2fb)
;; ("# HACK" #Xe2fc)
;; ("# MARK" #Xe2fd)
;; ("# FAIL" #Xe2fe)
("!!" #Xe900)
("!=" #Xe901)
("!==" #Xe902)
("!!!" #Xe903)
;; ("!≡" #Xe904)
;; ("!≡≡" #Xe905)
("!>" #Xe906)
("!=<" #Xe907)
("#(" #Xe920)
("#_" #Xe921)
("#{" #Xe922)
("#?" #Xe923)
("#>" #Xe924)
("##" #Xe925)
("#_(" #Xe926)
("%=" #Xe930)
("%>" #Xe931)
("%>%" #Xe932)
("%<%" #Xe933)
;; ("<~" #Xe93f)
("&%" #Xe940)
("&&" #Xe941)
("&*" #Xe942)
("&+" #Xe943)
("&-" #Xe944)
("&/" #Xe945)
("&=" #Xe946)
("&&&" #Xe947)
("&>" #Xe948)
("$>" #Xe955)
;; ("~>" #Xe95f)
("***" #Xe960)
("*=" #Xe961)
("*/" #Xe962)
("*>" #Xe963)
("++" #Xe970)
("+++" #Xe971)
("+=" #Xe972)
("+>" #Xe973)
("++=" #Xe974)
("--" #Xe980)
("-<" #Xe981)
("-<<" #Xe982)
("-=" #Xe983)
("->" #Xe984)
("->>" #Xe985)
("---" #Xe986)
("-->" #Xe987)
("-+-" #Xe988)
("-\\/" #Xe989)
("-|>" #Xe98a)
("-<|" #Xe98b)
("->-" #Xe98c)
("-<-" #Xe98d)
(".." #Xe990)
("..." #Xe991)
("..<" #Xe992)
(".>" #Xe993)
(".~" #Xe994)
(".=" #Xe995)
("/*" #Xe9a0)
("//" #Xe9a1)
("/>" #Xe9a2)
("/=" #Xe9a3)
("/==" #Xe9a4)
("///" #Xe9a5)
("/**" #Xe9a6)
(":::" #Xe9af)
("::" #Xe9b0)
(":=" #Xe9b1)
(":>" #Xe9b3)
(":=>" #Xe9b4)
(":(" #Xe9b5)
(":-(" #Xe9b6)
(":)" #Xe9b7)
(":-)" #Xe9b8)
(":/" #Xe9b9)
(":\\" #Xe9ba)
(":3" #Xe9bb)
(":D" #Xe9bc)
(":P" #Xe9bd)
(":>:" #Xe9be)
(":<:" #Xe9bf)
("<$>" #Xe9c0)
("<*" #Xe9c1)
("<*>" #Xe9c2)
("<+>" #Xe9c3)
("<-" #Xe9c4)
("<<" #Xe9c5)
("<<<" #Xe9c6)
("<<=" #Xe9c7)
("<=" #Xe9c8)
("<=>" #Xe9c9)
("<>" #Xe9ca)
("<|>" #Xe9cb)
("<<-" #Xe9cc)
("<|" #Xe9cd)
("<=<" #Xe9ce)
("<~" #Xe9cf)
("<~~" #Xe9d0)
("<<~" #Xe9d1)
("<$" #Xe9d2)
("<+" #Xe9d3)
("<!>" #Xe9d4)
("<@>" #Xe9d5)
("<#>" #Xe9d6)
("<%>" #Xe9d7)
("<^>" #Xe9d8)
("<&>" #Xe9d9)
("<?>" #Xe9da)
("<.>" #Xe9db)
("</>" #Xe9dc)
("<\\>" #Xe9dd)
("<\">" #Xe9de)
("<:>" #Xe9df)
("<~>" #Xe9e0)
("<**>" #Xe9e1)
("<<^" #Xe9e2)
("<!" #Xe9e3)
("<@" #Xe9e4)
("<#" #Xe9e5)
("<%" #Xe9e6)
("<^" #Xe9e7)
("<&" #Xe9e8)
("<?" #Xe9e9)
("<." #Xe9ea)
("</" #Xe9eb)
("<\\" #Xe9ec)
("<\"" #Xe9ed)
("<:" #Xe9ee)
("<->" #Xe9ef)
("<!--" #Xe9f0)
("<--" #Xe9f1)
("<~<" #Xe9f2)
("<==>" #Xe9f3)
("<|-" #Xe9f4)
("<||" #Xe9f5)
("<<|" #Xe9f6)
("<-<" #Xe9f7)
("<-->" #Xe9f8)
("<<==" #Xe9f9)
("<==" #Xe9fa)
("=<<" #Xea00)
("==" #Xea01)
("===" #Xea02)
("==>" #Xea03)
("=>" #Xea04)
("=~" #Xea05)
("=>>" #Xea06)
("=/=" #Xea07)
("=~=" #Xea08)
("==>>" #Xea09)
("=>=" #Xea0a)
("=<=" #Xea0b)
("=<" #Xea0c)
;;("≡≡" #Xea10)
;;("≡≡≡" #Xea11)
;;("≡:≡" #Xea12)
(">-" #Xea20)
(">=" #Xea21)
(">>" #Xea22)
(">>-" #Xea23)
(">>=" #Xea24)
(">>>" #Xea25)
(">=>" #Xea26)
(">>^" #Xea27)
(">>|" #Xea28)
(">!=" #Xea29)
(">->" #Xea2a)
("??" #Xea40)
("?~" #Xea41)
("?=" #Xea42)
("?>" #Xea43)
("???" #Xea44)
("?." #Xea45)
("^=" #Xea48)
("^." #Xea49)
("^?" #Xea4a)
("^.." #Xea4b)
("^<<" #Xea4c)
("^>>" #Xea4d)
("^>" #Xea4e)
("\\\\" #Xea50)
("\\>" #Xea51)
("\\/-" #Xea52)
("@>" #Xea57)
("|=" #Xea60)
("||" #Xea61)
("|>" #Xea62)
("|||" #Xea63)
("|+|" #Xea64)
("|->" #Xea65)
("|-->" #Xea66)
("|=>" #Xea67)
("|==>" #Xea68)
("|>-" #Xea69)
("|<<" #Xea6a)
("||>" #Xea6b)
("|>>" #Xea6c)
("|-" #Xea6d)
("||-" #Xea6e)
("~=" #Xea70)
("~>" #Xea71)
("~~>" #Xea72)
("~>>" #Xea73)
("[[" #Xea80)
("]]" #Xea81)
("\">" #Xea90)
("_|_" #Xea97)
)))
(defconst pragmatapro-lig-table
(eval-when-compile
(let ((v (make-vector 128 nil)))
(dolist (i pragmatapro-lig-alist)
(let ((s (car i))
(f (min 127 (aref (car i) 0)))
(c (cadr i)))
(let ((a (aref v f))
(r (substring s 1))
(lr (1- (length s))))
(aset
v f
(cons
(max (if a (car a) 0) lr)
(cons (list r lr
(vconcat (mapcar
'string
(concat (make-string lr ?\s)
(string c)))))
(and a (cdr a))))))))
(vconcat (mapcar (lambda (l)
(if l
(cons (car l)
(sort (cdr l) (lambda (x y)
(> (cadr x) (cadr y)))))
nil))
v)))))
(defconst pragmatapro-lig-use-table
(eval-when-compile
(let ((v (make-vector 128 nil)))
(dolist (i pragmatapro-lig-alist)
(let ((s (car i)))
(dotimes (j (length s))
(aset v (aref s j) t))))
v)))
(defun pragmatapro-guess-range (start end)
(save-excursion
(let ((s start) (e end)
(ss (progn (goto-char start) (line-beginning-position)))
(ee (progn (goto-char end) (line-end-position))))
(while (and (> s ss)
(aref pragmatapro-lig-use-table
(min 127 (or (char-before s) 127))))
(setq s (1- s)))
(while (and (< e ee)
(aref pragmatapro-lig-use-table
(min 127 (or (char-after e) 127))))
(setq e (1+ e)))
(cons s e))))
(defun pragmatapro-remove-ligatures (start end)
"Remove ligatures in start-end in the current buffer"
(let ((p (text-property-any start end 'ligature t))
(e nil))
(while p
(setq e (or (next-single-property-change p 'ligature) end))
(remove-list-of-text-properties p e '(ligature display))
(setq p (text-property-any e end 'ligature t)))))
(defun pragmatapro-update-ligatures (start end &optional l)
"Update ligatures in start-end in the current buffer"
(let ((modified (buffer-modified-p))
(inhibit-read-only t)
(case-fold-search nil))
(save-excursion
(let ((z (pragmatapro-guess-range (or start (point))
(or end (point)))))
(goto-char (car z))
(setq end (cdr z)))
(when (<= (point) end)
(pragmatapro-remove-ligatures (point) end))
(while (< (point) end)
(let* ((c (char-after))
(l (and c (aref pragmatapro-lig-table (min 127 c)))))
(forward-char 1)
(when l
(catch 'break
(let ((pt (point)))
(dolist (p (cdr l))
(when (string-prefix-p
(car p)
(buffer-substring-no-properties
pt (min (+ pt (car l)) (1+ (buffer-size)))))
(forward-char (cadr p))
(let ((s (1- pt)) (th (caddr p)))
(put-text-property s (point) 'ligature t)
(dotimes (i (1+ (cadr p)))
(put-text-property (+ s i) (+ s i 1) 'display
(aref th i)))
(throw 'break nil))))))))))
(set-buffer-modified-p modified)))
(define-minor-mode pragmatapro-lig-mode
"Compose pragmatapro's ligatures."
:lighter " PragLig"
(let ((inhibit-modification-hooks t)
(inhibit-read-only t))
(if pragmatapro-lig-mode
(progn ; Turn on
(add-hook 'after-change-functions 'pragmatapro-update-ligatures t t)
(when (> (buffer-size) 0)
(pragmatapro-update-ligatures 1 (buffer-size))))
;; Turn off
(remove-hook 'after-change-functions 'pragmatapro-update-ligatures t)
(when (> (buffer-size) 0)
(pragmatapro-remove-ligatures 1 (buffer-size)))))
pragmatapro-lig-mode)
(defun pragmatapro-lig-mode-on ()
(pragmatapro-lig-mode 1))
(define-globalized-minor-mode pragmatapro-lig-global-mode
pragmatapro-lig-mode
pragmatapro-lig-mode-on)
;; ---
(defvar pragmatapro-icons
(eval-when-compile
(let ((tt (make-hash-table :size 127 :test 'equal)))
(puthash "lisp" "()" tt)
(puthash "lisp interaction" "()\xf41f" tt)
(puthash "scheme" "(λ)" tt)
(puthash "inferior scheme" "(λ)\xf41f" tt)
(puthash "dired" "\xe5fe" tt)
(puthash "html" "\xe736" tt)
(puthash "web" "\xe796" tt)
(puthash "scala" "\xe737" tt)
(puthash "c" "\xe61e" tt)
(puthash "c/*l" "\xe61e" tt)
(puthash "c++" "\xe61d" tt)
(puthash "c++//l" "\xe61d" tt)
(puthash "java//l" "\xe738" tt)
(puthash "java" "\xe738" tt)
(puthash "ruby" "\xe791" tt)
(puthash "inf-ruby" "\xe791\xf41f" tt)
(puthash "rails" "\xe73b" tt)
(puthash "python" "\xe606" tt)
(puthash "inferior python" "\xe606\xf41f" tt)
(puthash "php" "\xe73d" tt)
(puthash "markdown" "\xe73e" tt)
(puthash "css" "\xe749" tt)
(puthash "sass" "\xe74b" tt)
(puthash "javascript" "\xe60c" tt)
(puthash "js" "\xe74e" tt)
(puthash "typescript" "\xe628" tt)
(puthash "jquery" "\xe750" tt)
(puthash "coffee" "\xe751" tt)
(puthash "angularjs" "\xe753" tt)
(puthash "swift" "\xe755" tt)
(puthash "less" "\xe758" tt)
(puthash "clojure" "\xe76a" tt)
(puthash "cidar" "\xe76a" tt)
(puthash "haskell" "\xe777" tt)
(puthash "haskell-cabal" "\xe777 Cabal" tt)
(puthash "interactive-haskell" "\xe777\xf41f" tt)
(puthash "hscompilation" "\xe777\x2611" tt)
(puthash "emacs-lisp" "(\xe779)" tt)
(puthash "prolog" "\xe7a1" tt)
(puthash "fsharp" "\xe7a7" tt)
(puthash "rust" "\xe7a8" tt)
(puthash "d" "\xe7af" tt)
(puthash "erlang" "\xe7b1" tt)
(puthash "lua" "\xe620" tt)
(puthash "dart" "\xe798" tt)
(puthash "dart//l" "\xe798" tt)
(puthash "go" "\xe627" tt)
(puthash "git" "\xe630" tt)
(puthash "comint" "\xf41f" tt)
(puthash "fundamental" "\xf4a5" tt)
(puthash "shell" "\xe7a2" tt)
(puthash "elixir" "\xf499" tt)
(puthash "debugger" "\xf4a0" tt)
tt)))
(defun pragmatapro-get-mode-icon ()
(let ((z (gethash (downcase mode-name) pragmatapro-icons)))
(if z z mode-name)))
(provide 'pragmatapro-lig)
Reference in New Issue View Git Blame Copy Permalink