;;; daphne-stenogr.el

;; Version 1.0

;; Mode: rec
;;  File: daphne-stenogr.el
;;  Brief: TODO.
;;  Version: 1.0
;;  License: Gnu Affero General Public License (Gnu AGPL)
;;  + Version 3 or Any Later Version.
;;  Keywords: Elisp
;; # end of rec

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;   ___              ___             _
;;  / __|_ __ _  _   / __|___ _ _  __| |_ __
;; | (__| '_ \ || | | (__/ _ \ ' \/ _` \ \ /
;;  \___| .__/\_, |  \___\___/_||_\__,_/_\_\
;;      |_|   |__/

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the Gnu Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.

;; You should have received a copy of the GNU General Public License
;; along with this file.  A copy of the license is included in the file
;; entitled "gnu--agpl.texi".  If not, see
;; <http://www.gnu.org/licenses/>.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Commentary:

;;; Code:

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; (require 'rx) ; Is this needed

;; (eval-when-compile
;;   (setq byte-compile-function-environment
;;	(delq (assq 'daphne-mode byte-compile-function-environment)
;;	      byte-compile-function-environment)))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;     _           _             
;;  __| |__ _ _ __| |_  _ _  ___ 
;; / _` / _` | '_ \ ' \| ' \/ -_)
;; \__,_\__,_| .__/_||_|_||_\___|
;;           |_|                 

(defgroup daphne ()
  "Groups tools for assisting with superior & inferior typeface."
  :prefix "daphne"
  :group 'daphne)

(defgroup keyword-typeface ()
  "Groups tools for typesetting mathematical symbols."
  :prefix "daphne-keyword"
  :group 'daphne)

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;  _                                 _              
;; | |_ _____ ____ ___ _ __    __ ___| |___ _  _ _ _ 
;; |  _/ -_) \ / _/ _ \ '  \  / _/ _ \ / _ \ || | '_|
;;  \__\___/_\_\__\___/_|_|_| \__\___/_\___/\_,_|_|  

(defface texmark-colour
  '( (default :inherit bold)
     ( ((class color) (background light)) :foreground "#00FF00" )
     ( ((class color) (background dark))  :foreground "#00FF00" )
     (t :inherit font-lock-builtin-face) )
  "User defined colour typeface for tex command keywords.")

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; For a user defined typeface, inherit "texmark-markup".

(defface texmark-typeface
  '((t :inherit font-lock-keyword-face)) 
   "Colour typeface for tex command keywords.")

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Mode: rec
;;  Defconst: texcom-cluster
;;  Brief: Sets tex keywords 
;;  Subject: The `rx' regular expression parser
;;  Brief: texcom-cluster sets tex keywords using rx, a regular
;;  + expression parser that is easier to read.
;;  Example: `rx' command
;;  +  (rx "\\" word-start (group (or "alpha" "beta" "zeta")) word-end)
;;  Example: Equivalent concatenated expression
;;  +  (concat "\\\\\\<\\(alpha\\|beta\\|zeta\\)\\>")
;; # end of rec

(defconst texmark-cluster
  `(
    ;; -------------------------------------------------
    ;; Greek

    (,(rx "\\" word-start (group (or "alpha" "beta" "chi" "delta"
          "Delta" "epsilon" "varepsilon" "eta" "gamma" "Gamma" "iota"
          "kappa" "lambda" "Lambda" "mu" "nu" "omega" "Omega" "phi"
          "varphi" "Phi" "pi" "varpi" "Pi" "psi" "Psi" "rho" "varrho"
          "sigma" "varsigma" "Sigma" "tau" "theta" "vartheta" "Theta"
          "upsilon" "Upsilon" "xi" "Xi" "zeta"))
	  word-end)
     (1 'texmark-typeface))

    ;; -------------------------------------------------
    ;; Mathematical symbols

    (,(rx "\\" word-start (group (or "infty" "Re" "Im" "angle"
          "triangle" "backslash" "vert" "Vert" "emptyset" "bot" "top"
          "exists" "forall" "hbar" "ell" "aleph" "imath" "jmath"
          "nabla" "neg" "lnot" "prime" "partial" "surd" "wp" "flat"
          "sharp" "natural" "clubsuit" "diamondsuit" "heartsuit"
          "spadesuit"))
	  word-end)
     (1 'texmark-typeface))

    ;; -------------------------------------------------
    ;; Binary operations

    (,(rx "\\" word-start (group (or "vee" "wedge" "amalg" "cap" "cup"
          "uplus" "sqcap" "sqcup" "dagger" "ddagger" "land" "lor"
          "cdot" "diamond" "bullet" "circ" "bigcirc" "odot" "ominus"
          "oplus" "oslash" "otimes" "pm" "mp" "triangleleft"
          "triangleright" "bigtriangledown" "bigtriangleup" "ast"
          "star" "times" "div" "setminus" "wr"))
	  word-end)
     (1 'texmark-typeface))

    ;; -------------------------------------------------
    ;; Mathematical relations

    (,(rx "\\" word-start (group (or "asymp" "cong" "dashv" "vdash"
          "perp" "mid" "parallel" "doteq" "equiv" "ge" "geq" "le"
          "leq" "gg" "ll" "models" "ne" "neq" "notin" "in" "ni" "owns"
          "prec" "preceq" "succ" "succeq" "bowtie" "propto" "approx"
          "sim" "simeq" "frown" "smile" "subset" "subseteq" "supset"
          "supseteq" "sqsubseteq" "sqsupseteq" "cos" "sin" "tan" "cot"
          "csc" "sec" "arccos" "arcsin" "arctan" "cosh" "coth" "sinh"
          "tanh" "det" "dim" "exp" "ln" "log" "lg" "arg" "deg" "gcd"
          "hom" "ker" "inf" "sup" "lim" "liminf" "limsup" "max" "min"
          "Pr"))
	  word-end)
     (1 'texmark-typeface))

    ;; -------------------------------------------------
    ;; Delimeters

    (,(rx "\\" word-start (group (or "lbrace" "rbrace" "lbrack"
          "rbrack" "langle" "rangle" "lceil" "rceil" "lfloor"
          "rfloor"))
	  word-end)
     (1 'texmark-typeface))

    ;; -------------------------------------------------
    ;; Arrows

    (,(rx "\\" word-start (group (or "leftarrow" "gets" "Leftarrow"
          "rightarrow" "to" "Rightarrow" "leftrightarrow"
          "Leftrightarrow" "longleftarrow" "Longleftarrow"
          "longrightarrow" "Longrightarrow" "longleftrightarrow"
          "Longleftrightarrow" "iff" "hookleftarrow" "hookrightarrow"
          "leftharpoondown" "rightharpoondown" "leftharpoonup"
          "rightharpoonup" "rightleftharpoons" "mapsto" "longmapsto"
          "downarrow" "Downarrow" "uparrow" "Uparrow" "updownarrow"
          "Updownarrow" "nearrow" "searrow" "nwarrow" "swarrow"))
          word-end)
     (1 'texmark-typeface))

    ;; -------------------------------------------------
    ;; Large mathematical operations

    (,(rx "\\" word-start (group (or "bigcap" "bigcup" "bigodot"
          "bigoplus" "bigotimes" "bigsqcup" "biguplus" "bigvee"
          "bigwedge" "coprod" "smallint" "int" "oint" "prod" "sum"
          "limits" "nolimits" "displaylimits"))
	  word-end)
     (1 'texmark-typeface))

    ;; -------------------------------------------------
    ;; Fractions and stacking

    (,(rx "\\" word-start (group (or "over" "atop" "above" "choose"
          "brace" "cases" "underbrace" "overbrace" "underline"
          "overline" "overleftarrow" "overrightarrow" "buildrel"
          "ldots" "cdots" "vdots" "ddots" "lgroup" "rgroup" "left"
          "right" "delimiter" "delimiterfactor" "delimitershortfall"
          "matrix" "pmatrix" "bordermatrix" "sqrt" "root" "of"))
          word-end)
     (1 'texmark-typeface))

    ;; -------------------------------------------------
    ;; Punctuation and style

    (,(rx "\\" word-start (group (or "cdotp" "ldotp" "colon" "sb" "sp"
          "textstyle" "scriptstyle" "scriptscriptstyle"
          "displaystyle"))
	  word-end)
     (1 'texmark-typeface))

    ;; -------------------------------------------------
    ;; Mathematical accents

    (,(rx "\\" word-start (group (or "acute" "b" "bar" "breve" "check"
          "ddot" "dot" "grave" "hat" "widehat" "tilde" "widetilde"
          "vec"))
	  word-end)
     (1 'texmark-typeface))

    ;; -------------------------------------------------
    ;; Mathematical class

    (,(rx "\\" word-start (group (or "mathord" "mathop" "mathbin"
          "mathrel " "mathopen" "mathclose" "mathpunct"))
	  word-end)
     (1 'texmark-typeface))

    ;; -------------------------------------------------
    ;; Equations and multiline display

    (,(rx "\\" word-start (group (or "eqno" "leqno" "displaylines"
          "eqalign" "eqalignno" "leqalignno"))
	  word-end)
     (1 'texmark-typeface))

    ;; -------------------------------------------------
    ;; Big sizes.  Using concat rather than rx.

    (,(rx "\\" word-start (group (or "big" "bigl" "bigm" "bigr" "Big"
          "Bigl" "Bigm" "Bigr" "bigg" "biggl" "biggm" "biggr" "Bigg"
          "Biggl" "Biggm" "Biggr" "downbracefill" "upbracefill"
          "arrowvert" "Arrowvert" "lmoustache" "rmoustache"
          "bracevert"))
	  word-end)
     (1 'texmark-typeface)) )

  "Typeface fontification for tex keywords.")

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun texmark-typeface-enable ()
  "Sets the highlight colour for tex commands."

  (font-lock-add-keywords nil texmark-cluster t)
  (font-lock-flush))

;; +++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun texmark-typeface-disable ()
  "Clears the highlight colour for tex commands."

  (font-lock-remove-keywords nil texmark-cluster)
  (font-lock-flush))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; * Displays texmath glyphs for the corresponding tex commands.

;;  _    _                                 
;; (_)__| |___ ___  __ _ _ _ __ _ _ __  ___
;; | / _` / -_) _ \/ _` | '_/ _` | '  \(_-<
;; |_\__,_\___\___/\__, |_| \__,_|_|_|_/__/
;;                 |___/                   

;;(require 'prog-mode)

;; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defvar texsym-cluster
  '(
     ;; Greek Letters
     ;; *************

     ("\\alpha" . ?α)      ("\\beta" . ?β)     ("\\chi" . ?χ)
     ("\\delta" . ?δ)      ("\\Delta" . ?Δ)    ("\\epsilon" . ?ϵ)
     ("\\varepsilon" . ?ε) ("\\eta" . ?η)      ("\\gamma" . ?γ)
     ("\\Gamma" . ?Γ)      ("\\iota" . ?ι)     ("\\kappa" . ?κ)
     ("\\lambda" . ?λ)     ("\\Lambda" . ?Λ)   ("\\mu" . ?μ)
     ("\\nu" . ?ν)         ("\\omega" . ?ω)    ("\\Omega" . ?Ω)
     ("\\phi" . ?ϕ)        ("\\varphi" . ?φ)   ("\\pi" . ?π)
     ("\\Pi" . ?Π)         ("\\psi" . ?ψ)      ("\\Psi" . ?Ψ)
     ("\\rho" . ?ρ)        ("\\varrho" . ?ϱ)   ("\\sigma" . ?σ)
     ("\\varsigma" . ?ς)   ("\\Sigma" . ?Σ)    ("\\tau" . ?τ)
     ("\\theta" . ?θ)      ("\\vartheta" . ?ϑ) ("\\Theta" . ?Θ)
     ("\\upsilon" . ?υ)    ("\\Upsilon" . ?Υ)  ("\\xi" . ?ξ)
     ("\\Xi" . ?Ξ)         ("\\zeta" . ?ζ)

     ;; Mathematical Symbols
     ;; ********************

     ("\\forall" . ?∀)    ("\\exists" . ?∃)    ("\\infty" . ?∞)
     ("\\emptyset" . ?∅)  ("\\sqrt" . ?√)      ("\\surd" . ?√)
     ("\\Re" . ?ℜ)        ("\\Im" . ?ℑ)        ("\\ell" . ?ℓ)
     ("\\hbar" . ?ℏ)      ("\\wp" . ?℘)        ("\\aleph" . ?ℵ)
     ("\\imath" . ?ı)     ("\\jmath" . ?ȷ)     ("\\angle" . ?∠)
     ("\\partial" . ?∂)   ("\\nabla" . ?∇)     ("\\triangle" . ?△)
     ("\\vert" . ?|)      ("\\Vert" . ?∥)      ("\\backslash" . ?∖)
     ("\\bot" . ?⊥)       ("\\top" . ?⊤)       ("\\prime" . ?′)
     ("\\neg" . ?¬)       ("\\lnot" . ?¬)      ("\\natural" . ?♮) 
     ("\\flat" . ?♭)      ("\\sharp" . ?♯)     ("\\clubsuit" . ?♣)
     ("\\heartsuit" . ?♡) ("\\spadesuit" . ?♠) ("\\diamondsuit" . ?⋄) 

     ;; Binary Operations
     ;; *****************

     ("\\over" . ?/)
     ("\\vee" . ?∨)     ("\\wedge" . ?∧)   ("\\cap" . ?∩)
     ("\\cup" . ?∪)     ("\\uplus" . ?⊎)   ("\\sqcap" . ?⊓)
     ("\\dagger" . ?†)  ("\\ddagger" . ?‡) ("\\land" . ?∧)
     ("\\lor" . ?∨)     ("\\cdot" . ?⋅)    ("\\diamond" . ?⋄)
     ("\\bullet" . ?∙)  ("\\circ" . ?∘)    ("\\bigcirc" . ?◯)
     ("\\odot" . ?⊙)    ("\\ominus" . ?⊖)  ("\\oplus" . ?⊕)
     ("\\oslash" . ?⊘)  ("\\otimes" . ?⊗)  ("\\pm" . ?±)
     ("\\mp" . ?∓)      ("\\ast" . ?∗)     ("\\star" . ?⋆)
     ("\\times" . ?×)   ("\\div" . ?÷)     ("\\amalg" . ?⨿)
     ("\\triangleleft" . ?◃)    ("\\triangleright" . ?▹)
     ("\\bigtriangledown" . ?▽) ("\\bigtriangleup" . ?△)
     ;;("\\setminus" . ?∖)      ("\\wr" . ?≀)

     ;; Large Mathematical Operations
     ;; *****************************

     ("\\sum" . ?∑)       ("\\prod" . ?∏)       ("\\coprod" . ?∐)
     ("\\smallint" . ?∫)  ("\\int" . ?∫)        ("\\oint" . ?∮)
     ("\\bigoplus" . ?⨁) ("\\bigotimes" . ?⨂)  ("\\bigodot" . ?⨀)
     ("\\bigcap" . ?⋂)    ("\\bigcup" . ?⋃)     ("\\bigvee" . ?⋁)
     ("\\bigwedge" . ?⋀)  ("\\bigsqcup" . ?⨆)  ("\\biguplus" . ?⨄)

     ;; Mathematical Relations
     ;; **********************

     ("\\asymp" . ?≍)      ("\\cong" . ?≅)      ("\\dashv" . ?⊣)
     ("\\vdash" . ?⊢)      ("\\perp" . ?⊥)      ("\\mid" . ?∣)
     ("\\parallel" . ?∥)   ("\\doteq" . ?≐)     ("\\equiv" . ?≡)
     ("\\ge" . ?≥)         ("\\geq" . ?≥)       ("\\le" . ?≤)
     ("\\leq" . ?≤)        ("\\gg" . ?≫)        ("\\ll" . ?≪)
     ("\\models" . ?⊨)    ("\\ne" . ?≠)         ("\\notin" . ?∉)
     ("\\in" . ?∈)         ("\\ni" . ?∋)        ("\\owns" . ?∋)
     ("\\prec" . ?≺)       ("\\preceq" . ?⪯)    ("\\succ" . ?≻)
     ("\\succeq" . ?⪰)    ("\\bowtie" . ?⋈)     ("\\propto" . ?∝)
     ("\\approx" . ?≈)     ("\\sim" . ?∼)        ("\\simeq" . ?≃)
     ("\\frown" . ?⌢)     ("\\smile" . ?⌣)     ("\\subset" . ?⊂)
     ("\\subseteq" . ?⊆)   ("\\supset" . ?⊃)     ("\\supseteq" . ?⊇)
     ("\\sqsubseteq" . ?⊑) ("\\sqsupseteq" . ?⊒)

     ;; Delimeters
     ;; **********

     ("\\lbrace" . ?{)    ("\\rbrace" . ?})    ("\\lbrack" . ?\[)
     ("\\rbrack" . ?\])   ("\\langle" . ?\⟨)   ("\\rangle" . ?\⟩)
     ("\\lceil" . ?⌈)     ("\\rceil" . ?⌉)     ("\\lfloor" . ?⌊)
     ("\\rfloor" . ?⌋)    ("\\widehat" . ?^)   ("\\overline" . ?̅ )  
     ("\\tilde" . ?~)     ("\\left\\{" . ?{)   ("\\right\\}" . ?})
     ("\\left\\[" . ?\[)  ("\\right\\]" . ?\]) 
     ("\\left\\(" . ?\()  ("\\right\\)" . ?\))
     ("\\bigl\(" . ?\()   ("\\bigr\)" . ?\))
     ("\\Biggl\(" . ?\()  ("\\Biggr\)" . ?\))

     ;; Arrows
     ;; ******
     
     ("\\iff" . ?⟺)           ("\\gets" . ?←)
     ("\\to" . ?→)             ("\\longmapsto" . ?⟼) 
     ("\\leftarrow" . ?←)      ("\\rightarrow" . ?→)
     ("\\Leftarrow" . ?⇐)      ("\\Rightarrow" . ?⇒)
     ("\\uparrow" . ?↑)        ("\\Uparrow" . ?⇑)
     ("\\nearrow" . ?↗)        ("\\searrow" . ?↘)
     ("\\nwarrow" . ?↖)        ("\\swarrow" . ?↙)
     ("\\updownarrow" . ?↕)    ("\\Updownarrow" . ?⇕)
     ("\\downarrow" . ?↓)      ("\\Downarrow" . ?⇓)
     ("\\leftrightarrow" . ?↔) ("\\Leftrightarrow" . ?⇔)
     ("\\longleftarrow" . ?⟵)  ("\\Longleftarrow" . ?⟸)
     ("\\longrightarrow" . ?⟶) ("\\Longrightarrow" . ?⟹)

     ("\\longleftrightarrow" . ?⟷) ("\\Longleftrightarrow" . ?⟺)
     ("\\hookleftarrow" . ?↩)      ("\\hookrightarrow" . ?↪)
     ("\\leftharpoondown" . ?↽)    ("\\rightharpoondown" . ?⇁)
     ("\\leftharpoonup" . ?↼)      ("\\rightharpoonup" . ?⇀)
     ("\\rightleftharpoons" . ?⇌)  ("\\mapsto" . ?↦)

     ;; Fractions and Stacking
     ;; **********************

     ("\\dots" . ?…)    ("\\ldots" . ?…)  ("\\cdots" . ?⋯)
     ("\\vdots" . ?⋮)  ("\\ddots" . ?⋱)

     ;; Punctuation and Style
     ;; *********************
     
     ("\\cdotp" . ?⋅) ("\\ldotp" . ?.) ("\\colon" . ?:)

     ;; Tex Primitives
     ;; **************

     ;; ?\N{NAME} specifies character by the Unicode Name 
     ("\\cr" . ?\N{ZERO WIDTH SPACE})
     
     ;; Other Glyphs (e.g. Latex)
     ;; *************************

     ("\\Subset" . ?⋐)     ("\\Supset" . ?⋑)    ("\\Vdash" . ?⊩)
     ("\\Vvdash" . ?⊪)    ("\\because" . ?∵)   ("\\boxminus" . ?⊟)
     ("\\boxplus" . ?⊞)    ("\\boxtimes" . ?⊠)  ("\\circeq" . ?≗)
     ("\\eqcirc" . ?≖)     ("\\eqcolon" . ?≕)   ("\\circledR" . ?®)
     ("\\circledS" . ?Ⓢ)  ("\\ggg" . ?⋙)      ("\\gnapprox" . ?⋧)
     ("\\lambdabar" . ?ƛ)  ("\\veebar" . ?⊻)    ("\\celsius" . ?℃)
     ("\\textdied" . ?✝)   ("\\urcorner" . ?⌝)  ("\\u{i}" . ?ĭ)
     ("\\vDash" . ?⊨)     ("\\textwon" . ?₩)    ("\\textpeso" . ?₱)
     ("\\textlira" . ?₤)   ("\\textnaira" . ?₦) ("\\textbaht" . ?฿)

     ("\\gneq" . ?≩)       ("\\gneqq" . ?≩)    ("\\gnsim" . ?⋧)
     ("\\gtrapprox" . ?≳)  ("\\gtrdot" . ?⋗)   ("\\gtreqless" . ?⋛)
     ("\\gtreqqless" . ?⋛) ("\\gtrless" . ?≷)  ("\\gtrsim" . ?≳)
     ("\\gvertneqq" . ?≩)  ("\\qquad" . ?⧢)    ("\\quad" . ?␣)
     ("\\curlyeqprec" . ?⋞)        ("\\curlyeqsucc" . ?⋟)
     ("\\curlypreceq" . ?≼)        ("\\curlyvee" . ?⋎)
     ("\\curlywedge" . ?⋏)         ("\\curvearrowleft" . ?↶)
     ("\\curvearrowright" . ?↷)    ("\\divideontimes" . ?⋇) 
     ("\\eqslantgtr" . ?⋝)         ("\\eqslantless" . ?⋜)
     ("\\ordfeminine" . ?ª)        ("\\ordmasculine" . ?º)
     ("\\circlearrowleft" . ?↺)    ("\\circlearrowright" . ?↻)
     
     ("\\rightrightarrows" . ?⇉)   ("\\rightthreetimes" . ?⋌)
     ("\\sphericalangle" . ?∢)     ("\\twoheadleftarrow" . ?↞)
     ("\\twoheadrightarrow" . ?↠)  ("\\textcolonmonetary" . ?₡)
     ("\\textpertenthousand" . ?‱) ("\\textreferencemark" . ?※)
     ("\\textrecipe" . ?℞)        ("\\textinterrobang" . ?‽)    
     ("\\textnumero" . ?№)         ("\\textdiscount" . ?⁒)
     ("\\textestimated" . ?℮)      ("\\textopenbullet" . ?◦)
     ("\\textlquill" . ?\⁅)        ("\\textrquill" . ?\⁆)
     ("\\textcircledP" . ?℗) )

  "A glyph list usable for tex modes.")

;; +++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun texsym-predicate (start end _match)
  "Prettify mathematical expressions defined by tex syntax.
Matches START with a backslash and END with a word constituent
[a-zA-Z0-9].  Uses the prettify functionality of `prog-mode'."

  (not (or (memq (char-before start) '(?\\))
           (memq (char-syntax (or (char-after end) ?\s)) '(?w))
	   (nth 8 (syntax-ppss)))) )

;; -----------------------------------------------------

(defun prettify-symbols-cluster ()
  "Set keywords and corresponding glyph."
  (setq-local prettify-symbols-alist texsym-cluster)
  (setq prettify-symbols-compose-predicate 'texsym-predicate))

;; +++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun ideogram-view-enable ()
  "Enables typeface for tex glyphs."
  (prettify-symbols-cluster)
  (prettify-symbols-mode))

(defun ideogram-view-disable ()
  "Enables typeface for tex glyphs."
  (prettify-symbols-mode 0))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;      _       _ 
;;  _ _(_)__ __(_)
;; | '_| / _/ _| |
;; |_| |_\__\__|_|

(defcustom ricci-signal t
  "Displays mathematical expressions in Ricci Notation. 
Ricci Notation is enabled when `ricci-signal' is `t', otherwise
disabled."
  :type 'boolean
  :group 'ricci)

(put 'ricci-signal 'safe-local-variable 'booleanp)

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defcustom ricci-deviat '(0.18 -0.18)
  "Sets the superior and inferior vertical deviation of typeface.
Deviation is measured relative to the text font size."
  :group 'ricci
  :type '(list (float :tag "supr-deviat")
               (float :tag "infr-deviat")) )

;; +++++++++++++++++++++++++++++++++++++++++++++++++++++

(defcustom ricci-scale 0.8
  "Sets the superior and inferior typeface scaling with preceding text.
For nested expressions, scale is applied repeatedly, with limit set by
`ricci-hmin'."
  :type 'float
  :group 'ricci)

;; +++++++++++++++++++++++++++++++++++++++++++++++++++++

(defcustom ricci-hmin 0.8
  "Sets the minimum ricci glyph height.
For integer values, the hmin is scaled in units of 1/10 point size.
For floating point values, relative height is used."
  :type '(choice (integer :tag "Font height in 1/10 point units")
		 (float   :tag "Fraction of font height"))
  :group 'ricci)

;; +++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun ricci-height (height)
  "Return integer HEIGHT of superior and inferior glyph.
HEIGHT  typeface height. Integer scaled in 1/10 of point size.
Not smaller than value set by `daphne-hmin'."

  (ceiling
     (max
        (if (integerp ricci-hmin)
	    ricci-hmin
	  (condition-case nil ; For bootstrapping.
	      (* ricci-hmin
		 (face-attribute 'default :height))
	    (error 0)))
	(* height ricci-scale))))  ; assumes height is integer.

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defface ricci-supr '((t :height ricci-height))
  "Typography for superior glyphs in Ricci Script."
  :group 'ricci)

;; +++++++++++++++++++++++++++++++++++++++++++++++++++++

(defface ricci-infr '((t :height ricci-height))
  "Typography for inferior glyphs in Ricci Script."
  :group 'ricci)

;; +++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun ricci-raise (pos)
  "Raise and lower typeface at position POS.
POS  Position in buffer"

  (unless
      (or (memq (get-text-property pos 'face)
		'(font-lock-constant-face font-lock-builtin-face))

	  (let ( (odd nil) (pos pos) )
	    (while (eq (char-before pos) ?\\)    ; Check backslash quoting
	      (setq pos (1- pos) odd (not odd)))
	    odd))

    (if (eq (char-after pos) ?^)
	`(face ricci-supr display  ; detected superscript `^'.
	       (raise ,(car ricci-deviat)))
      `(face ricci-infr display    ; detected subscript `_'
	     (raise ,(cadr ricci-deviat)))) ))

;; +++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun ricci-match (limit)
  "Matches superior and inferior glyph patterns up to LIMIT.
LIMIT  Narrows the accessible portion of the buffer."
  
  (when (and ricci-signal
	     (re-search-forward "[_^] *\\([^\n\\{}]\\|\
\\\\\\([a-zA-Z@]+\\|[^ \t\n]\\)\\|\\({\\)\\)" limit t))
    (when (match-end 3)
      (let (($beg (match-beginning 3))
	    ($end (save-restriction
		   (narrow-to-region (point-min) limit)
		   (condition-case nil
		       (scan-lists (point) 1 1) (error nil)))))
	;; body of let
	(store-match-data
           (if $end
	       (list (match-beginning 0) $end $beg $end)
	     (list $beg $beg $beg $beg)))))
    t))

;; +++++++++++++++++++++++++++++++++++++++++++++++++++++

;; Mode: rec
;;  Defun: (ricci-script sel)
;;  Param: SEL  Selection enabled or disabled
;; # end of rec
 
;; Mode: rec
;;  Subject: [TODO] setq-local change in Emacs 27.2
;;  + Change setq-local commands for Gnu Emacs ? onwards
;;  +   (setq-local ricci-deviat '(0.34 -0.34)
;;  +               ricci-scale  0.2))
;;  Detail: Changes in Emacs 27.2
;;  + `setq-local' can now set an arbitrary number of variables,
;;  + which makes the syntax more like `setq'.
;;
;;  Subject: Declaration of font-lock-add-keywords
;;  +  (font-lock-add-keywords MODE KEYWORDS &optional HOW)
;;  Detail: For details call `C-h f font-lock-add-keywords'.
;; # end of rec

(defun ricci-script (sel)
  "Set the superior and inferior deviaton and scale.
SEL  Selection enabled or disabled"

  (pcase sel
     ("+"  ; enables feature
        (setq-local ricci-deviat  '(0.34 -0.34))
        (setq-local ricci-scale   0.2))
     ("-"  ; disables feature
        (setq-local ricci-deviat  '(0.0 0.0))
        (setq-local ricci-scale   1.0)) )

  (font-lock-add-keywords nil
     '( (ricci-match (1 (ricci-raise (match-beginning 0)))) )
     t)
  (font-lock-flush) )

;; +++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun ricci-script-enable ()
  "Displays mathematics with Ricci Notation."
  (interactive)
  (ricci-script "+") )

;; +++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun ricci-script-disable ()
  "Disables the display of Ricci Script."
  (interactive)
  (ricci-script "-") )

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar-local stenogr-sweep-kondor 1
  "Keeps track of the cycle state in `daphne-stenogr-sweep'.")

(defun stenogr-sweep ()
  "Cycles supinf and ideograms functionality."
   (interactive)

   ;; uses (+) for feature enabled, (-) for feature disabled
   (pcase stenogr-sweep-kondor

     (1 (ideogram-view-enable)
        (message "daphne | + Ideogram Vision")
        (setq-local stenogr-sweep-kondor (1+ stenogr-sweep-kondor)))

     (2 (ricci-script-enable)
        (message "daphne | + Ideogram Vision | + Ricci Script")
        (setq-local stenogr-sweep-kondor (1+ stenogr-sweep-kondor)))
     
     (_ (ricci-script-disable)
        (ideogram-view-disable)
        (message "daphne | - Ideogram Vision | - Ricci Script")
        (setq-local stenogr-sweep-kondor 1)) ))

;; -----------------------------------------------------

(defun daphne-stenogr-sweep-keytrigger ()
   "Key trigger capability for rapid execution of commands."
   (global-set-key (kbd "H-s") #'stenogr-sweep) )

;; -----------------------------------------------------

(defun daphne-stenogr-launch ()
  "Launch Ideogram tools for mathematical notation. 
Provides three capabilities - Tex command highlighting; Ricci
Notation; Ideogram display."

  (message "+ daphne-stenogr")
  (texmark-typeface-enable)
  (daphne-stenogr-sweep-keytrigger))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Subject: define-minor-mode
;; Brief: Defines a new minor mode
;; Subject: Documentation for `define-minor-mode'.
;; +  C-h f define-minor-mode
;; Declaration: define-minor-mode
;; +  (define-minor-mode MODE DOC
;; +     &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)
;; Brief: Defines a toggle command MODE and by default a control
;; + variable named MODE.

;;;###autoload
(define-minor-mode daphne-minor-mode
  "Minor mode for assisting with superior & inferior typeface."
  :init-value nil
  :lighter " Daphne"  ; used in modeline when mode is enabled

  ;; Disable commands first to avoids multiple copies of lists when
  ;; calling `(daphne-minor-mode 1)' several times.
  (texmark-typeface-disable)
  (ricci-script-disable)
  (when daphne-minor-mode  ! variable self-made by define-minor-mode
     (texmark-typeface-enable)
     (ricci-script-enable)) )

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(provide 'daphne)

;; code ends here

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Marginalia

;; Mode: rec
;;  Subject: Idempotency of variables
;;  Detail: Idempotency describes an action which, when performed
;;  + multiple times, has no further effect on its subject after the
;;  + first time it is performed.  In algebra, a idempotent quantity is
;;  + a quantity which when multiplied into itself gives itself.
;; End of rec

;; daphne-stenogr.el ends here