|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
;;; This file:
;;; http://angg.twu.net/elisp/cl-glyphs.el.html
;;; http://angg.twu.net/elisp/cl-glyphs.el
;;; (find-angg "elisp/cl-glyphs.el")
;;; Author: Eduardo Ochs <eduardoochs@gmail.com>
;;
;; (defun e () (interactive) (find-angg "elisp/cl-glyphs.el"))
;;
;; (find-node "(cl)Structures")
;; (find-node "(cl)Structures" "Macro: cl-defstruct")
;; (find-node "(cl)Structures" "#s(person1 nil nil nil)")
;; (find-elnode "Hash Table Type" "#s")
;; (find-elnode "Records" "#s")
;;
;; (find-eevfile "eev-glyphs.el")
;; (find-eevfile "eev-math-glyphs.el")
;; (find-angg "LATEX/istanbulglyphs.el")
;; (find-epp (macroexpand '(cl-defstruct ee-glyph pos keys char face)))
;; (find-LATEXfile "2019oxford-chars.tex")
;; See: (find-es "emacs" "while-string-match")
;; (find-es "emacs" "rx")
;;
(setq ee-glyph4-re
(rx-let ((nonblank (not (any " \t\n"))))
(rx (or (and (group-n 1 nonblank) ; 1: pos
" "
(group-n 2 nonblank nonblank) ; 2: keys
(optional
" "
(group-n 3 nonblank (zero-or-more nonblank))) ; 3: latex
)
(and "face: " (group-n 4 (one-or-more nonblank))) ; 4: face
(and ";; " (zero-or-more (not "\n"))) ; comment
))))
(defun ee-glyphs-do (code bigstr)
(let ((bigstrpos 0))
(while (string-match ee-glyph4-re bigstr bigstrpos)
(let ((pos (match-string 1 bigstr))
(keys (match-string 2 bigstr))
(latex (match-string 3 bigstr))
(face (match-string 4 bigstr)))
(eval code)
(setq bigstrpos (match-end 0))))))
(setq ee-glyphs-keys-to-pos (make-hash-table :test 'equal))
(setq ee-glyphs-pos-to-latex (make-hash-table :test 'equal))
(setq ee-glyphs-current-face nil)
(defun ee-glyphs-do-default ()
(if pos (puthash keys pos ee-glyphs-keys-to-pos))
(if pos (eepitch-set-glyph0 pos pos ee-glyphs-current-face))
(if latex (puthash pos latex ee-glyphs-pos-to-latex))
(if face (setq ee-glyphs-current-face (eval face)))
)
(setq ee-glyphs-bigstr0
"
;; Comment
face: foo
Δ DD \\Delta
Γ GG \\Gamma
Θ Th \\Theta
α aa \\alpha
β bb \\beta
γ gg \\gamma
∈ in \\in
≤ le \\le
≥ ge \\ge
≥ ge
")
(defun ee-glyphs-do-test () (insert (format "%S %S %S / %S\n" pos keys latex face)))
' (ee-glyph4-do '(ee-glyphs-do-test) ee-glyphs-bigstr)
(setq ee-tla-table (make-hash-table :test 'equal))
;; Tests: (ee-tla-canonicalize nil)
;; (ee-tla-canonicalize "/home/edrx/foo")
(defun ee-tla-canonicalize (o)
(if (stringp o) (ee-shorten-file-name (ee-expand o)) o))
;; Here the argument tla has to be a symbol.
(defun ee-tla-set (tla fname)
(setq fname (ee-tla-canonicalize fname))
(puthash fname tla ee-tla-table)
(puthash tla fname ee-tla-table))
(setq ee-glyph3-re
(rx-let ((posc (not (any " \t\n")))
(keyc (not (any " \t\n")))
(latexc (not (any " \t\n")))
(latex (latexc (zero-or-more latexc)))
)
(rx (group posc) " "
(group keyc keyc)
(optional " " (group latexc (zero-or-more latexc)))
)))
(defun ee-glyph3-foreach (f bigstr)
"Run F for each match of ee-f-pkl-re in BIGSTR."
(let ((pos 0))
(while (string-match ee-glyph3-re bigstr pos)
(funcall f (match-string 1 bigstr)
(match-string 2 bigstr)
(match-string 3 bigstr))
(setq pos (match-end 0)))))
' (Test:
(ee-glyph3-foreach
(lambda (p k l) (insert (format "\n %S %S %S" p k l)))
"
Δ DD \\Delta
Γ GG \\Gamma
Θ Th \\Theta
α aa \\alpha
β bb \\beta
γ gg \\gamma
∈ in \\in
≤ le \\le
≥ ge \\ge
≥ ge
")
)
(cl-defstruct ee-glyph posc keys char face latex)
(setq ee-g-face nil)
(defun ee-g-make (posc &optional keys char latex)
(make-ee-glyph :pos posc :keys keys :char char :latex latex :face ee-g-face))
(find-eppp
(list
(list (ee-g-make "á" "'a")
(ee-g-make "á" "'a")
(ee-g-make "á" "'a")
(ee-g-make "á" "'a")
))
)
(ee-g-process
(setq bigstr
"
Δ DD \\Delta
Γ GG \\Gamma
Θ Th \\Theta
α aa \\alpha
β bb \\beta
γ gg \\gamma
∈ in \\in
≤ le \\le
≥ ge \\ge
")
la ∧ lo ∨ -> → to → <> ↔ => ⇒ <= ⇐ TT ⊤ BO ⊥ Do ⋅
<- ← up ↑ dn ↓ |- ⊢ -| ⊣ |= ⊨ ud ↕ NW ↖ NE ↗ SE ↘ SW ↙ LR ⇔
su ⊂ se ⊆ Se ⊇ Su ⊃ Pa ∂ Na ∇ em ∅
.. … bu • sq √
ca ∩ cu ∪ CA ⋂ CU ⋃ LO ⋁ LA ⋀ sm ∖
qa ⊓ qu ⊔ && ⅋ [[ ⟦ ]] ⟧ -o ⊸ li ✀
fa ∀ ex ∃ Bo □ nc ◻ po ⋄ fl ♭ na ♮ sh ♯
-1 ¹ 11 ¹ 22 ² 33 ³ oo ∘ 88 ∞ In ∫
hu ⇀ <1 〈 1> 〉 o. ⊙ o- ⊖ o+ ⊕ o/ ⊘ ox ⊗ __ ▁ :: ⠆
bf 𝐛 it 𝐢 rm 𝐫 tx 𝐭 sf 𝐬
"
;; (find-elnode "Char Classes" "[:unibyte:]")
(setq g (make-ee-glyph :char ?\^T
:glyphchar ?T
:face 'eev-glyph-face-yellow-on-red))
(defun ee-glyph-set-glyph (g)
(eepitch-set-glyph (ee-glyph-pos g)
(or (ee-glyph-char g)
(ee-glyph-pos g))
(ee-glyph-face g)))
(defun ee-glyph-unset-glyph (g)
(eepitch-set-glyph (ee-glyph-pos g) nil nil))
;;; __ _
;;; / _| __ _ ___ ___ _ __ ___ ___ ___| | _____ _ _ ___ ___
;;; | |_ / _` |/ __/ _ \ '_ \ / _ \/ __/ __| |/ / _ \ | | / __/ __|
;;; | _| (_| | (_| __/ |_) | (_) \__ \__ \ < __/ |_| \__ \__ \
;;; |_| \__,_|\___\___| .__/ \___/|___/___/_|\_\___|\__, |___/___/
;;; |_| |___/
;;
;; A `faceposskeyss' is a list like this,
;;
;; (F1 F2 "A B C" "a b c" "D E" "d e" F3 "F G" "f g")
;;
;; ink
(setq ee-glyphs-current-face ())
(setq ee-glyphs-current-poss ())
(setq ee-glyphs-current-keyss ())
;; (find-efunctiondescr 'keywordp)
(defun ee-glyphs-fpks-do0 (code)
(let* ((face ee-glyphs-current-face)
(poss (ee-split ee-glyphs-current-poss))
(keyss (ee-split ee-glyphs-current-keyss)))
(dolist (i (number-sequence 0 (- (length keyss) 1)))
(let* ((pos (nth i poss))
(keys (nth i keyss)))
(eval code)))))
;; Test:
;; (setq ee-glyphs-current-face 'eepitch-star-face)
;; (setq ee-glyphs-current-poss "A B C ")
;; (setq ee-glyphs-current-keyss "aa bb cc")
;; (ee-glyphs-pos-keys-do '(insert (format "\n%S" (list face pos keys))))
(defun ee-glyphs-fpks-do (list code)
(while list
(cond
;; Case 1: change face
((symbolp (car list))
(setq ee-glyphs-current-face (car list))
(setq list (cdr list)))
;;
;; Case 2: process poss and keyss
((stringp (car list))
(setq ee-glyphs-current-poss (car list))
(setq ee-glyphs-current-keyss (cadr list))
(setq list (cddr list))
(ee-glyphs-fpks-do0 code))
;;
(t (error "Not fpks: %S" (car list))))))
;; Test:
' (ee-glyphs-faceposskeyss-do
'(F1 F2 "A B C" "a b c" "D E" "d e" F3 "F G" "f g")
'(insert (format "\n%S" (list face pos keys)))
)
;; (find-efunctiondescr 'dolist)
;; (find-efunctiondescr 'seq)
;; (find-elnode "Sequence Functions")
;; (find-efunctiondescr 'number-sequence)
;; (ee-glyph-set-glyph g)
;; (ee-glyph-unset-glyph g)