Re: tex-mode.el

[Christopher Dimech <dimech@gmx.com>]

[-- Attachment #1: Type: text/plain, Size: 2879 bytes --]

Have cleaned up the code, and have identified the problematic part.
I wish to tidy up the "font-lock-add-keywords" part.

Currently the supinf typeface is set using "add-hook", making supinf
activate as soon as one reads the file in emacs.  But, that is not what
I would like. 

I would like a function that turns on the supinf typeface, and have another
one that turns it off.  When one reads the file, everything will be shown
an normal text without the typeface.  And with the key-sequence "H-t", one
could then cycle through the different typefaces.


> Sent: Friday, February 12, 2021 at 9:11 AM
> From: "Emanuel Berg via Users list for the GNU Emacs text editor" <help-gnu-emacs@gnu.org>
> To: help-gnu-emacs@gnu.org
> Subject: Re: tex-mode.el
>
> Christopher Dimech wrote:
> 
> > I have made a minor mode for texinfo that does this, but the
> > buffer is not being returned to look as source code.
> > They still look that they have a difference in height.
> >
> > I attach the file with a test.
> 
> Using this...
> 
> (require 'checkdoc)
> 
> (setq checkdoc-permit-comma-termination-flag t)
> 
> (defun check-package-style ()
>   (interactive)
>   (let ((msg "Style check..."))
>     (message msg)
>     (checkdoc-current-buffer t) ; TAKE-NOTES
>     (message "%sdone" msg) ))
> (defalias 'check-style #'check-package-style)
> 
> It says
> 
> *** crucible-mode.el: checkdoc-current-buffer
> crucible-mode.el:47: You should have a section marked ";;; Code:"
> crucible-mode.el:360: First sentence should end with punctuation
> crucible-mode.el:366: First sentence should end with punctuation
> crucible-mode.el:384: Argument ‘start’ should appear (as START) in the doc string
> crucible-mode.el:386: Lisp symbol ‘prog-mode’ should appear in quotes
> crucible-mode.el:394: All variables and subroutines might as well have a documentation string
> crucible-mode.el:408: Lisp symbol ‘fill-column’ should appear in quotes
> crucible-mode.el:440: First sentence should end with punctuation
> crucible-mode.el:440: First line should be capitalized
> 
> Using the byte compiler, it says
> 
> crucible-mode.el: 
> In texglyph-cycle-crucible:
> crucible-mode.el:425:10: Warning: assignment to free variable
>     ‘tex-font-script-display’
> crucible-mode.el:426:10: Warning: assignment to free variable
>     ‘tex-suscript-height-ratio’
> 
> In end of data:
> crucible-mode.el:458:1: Warning: the following functions are not known to be
>     defined: multic, supinf-typeface-crucible
> 
> Seems to be minor issues most (all?) of them but you might as
> well fix them to be home free. If and when you do that, I'd be
> happy to look at it again, if there are still issues...
> 
> -- 
> underground experts united
> http://user.it.uu.se/~embe8573
> https://dataswamp.org/~incal
> 
> 
>

[-- Attachment #2: crucible-mode.el --]
[-- Type: text/plain, Size: 16933 bytes --]

;;; crucible-mode.el --- Typeface for texmath -*- lexical-binding:t -*-

;; Copyright (C) 2021  Free Software Foundation

;; Author: Christopher Dimech <email@here.com>
;; URL: https://website-here
;; Version: 0.1.0
;; Package-Requires: ((emacs "27.1"))

;; This file is part of Behistun, a Gnu Behistun.

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

;; Behintun is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the Gnu Affero General Public
;; License along with Behistun.  If not, see
;; <http://www.gnu.org/licenses/>.

;;; -------------------------------------------------------------------
;;; Commentary:

;; * Setting texmath keywords using rx
;;   rx uses regular expressions that are easier to read.
;;
;; * Byte Compilation
;;
;;   The Byte Compiler translates functions written in Lisp into
;;   byte-code, a special representation that makes functions execute
;;   faster.  The byte compiler also returns very useful messages.
;;
;;   To byte-compile a file named crucible-mode.el, launch Emacs and
;;   enter the following command.
;;
;;     M-x byte-compile-file Ret crucible-mode.el

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

;; (require 'rx) ; Is this needed

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

;; ---------------------------------------------------------------------
;;; Code:

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

;; ---------------------------------------------------------------------
(defgroup keyword-tfc ()
  "Groups tools for typesetting mathematical symbols."
  :prefix "crucible-keyword"
  :group 'crucible)

;; ---------------------------------------------------------------------
(defvar crucible-mode-hook nil
  "Hook called when Crucible Mode is enabled.")

;; ---------------------------------------------------------------------
;;;###autoload
(define-minor-mode crucible-mode
  "Minor mode for assisting with superior & inferior typeface."
  :init-value nil
  :global nil
  :lighter " Crucible"
  (run-hooks 'crucible-mode-hook))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(multic "
* Colour tex keywords")
;;         _                _                  _
;;  __ ___| |___ _  _ _ _  | |____ __ ___ _ __| |
;; / _/ _ \ / _ \ || | '_| | / /\ V  V / '_/ _` |
;; \__\___/_\___/\_,_|_|   |_\_\ \_/\_/|_| \__,_|

;; ---------------------------------------------------------------------
(defface colour-tex-cruc
  '( (default :inherit bold)
     ( ((class color) (min-colors 88) (background light))
       :foreground "#FF0000" )
     ( ((class color) (min-colors 88) (background dark))
       :foreground "#FF0000" )
     (t :inherit font-lock-builtin-face) )
  "Typeface for tex keywords.")

;; -------------------------------------------------------------------------
(defconst tex-keywords-cruc
  `(
    ;; Greek.  Use (0 'colour-tex-cruc) to highlight the leading "\".
    (,(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 'colour-tex-cruc))
    ;;
    ;; 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 'colour-tex-cruc))
    ;;
    ;; Binary operations
    (,(rx "\\" word-start (group (or "vee" "wedge" "amalg" "cap" "cup"
          "uplus" "sqcap" "sqcup" "dagger" "ddaccer" "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 'colour-tex-cruc))
    ;;
    ;; 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 'colour-tex-cruc))
    ;;
    ;; Delimeters
    (,(rx "\\" word-start (group (or "lbrace" "rbrace" "lbrack"
          "rbrack " "langle" "rangle" "lceil" "rceil" "lfloor"
          "rfloor")) word-end)
     (1 'colour-tex-cruc))
    ;;
    ;; 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 'colour-tex-cruc))
    ;;
    ;; 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 'colour-tex-cruc))
    ;;
    ;; 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 'colour-tex-cruc))
    ;;
    ;; Punctuation and style
    (,(rx "\\" word-start (group (or "cdotp" "ldotp" "colon" "sb" "sp"
          "textstyle" "scriptstyle" "scriptscriptstyle"
          "displaystyle")) word-end)
     (1 'colour-tex-cruc))
    ;;
    ;; Mathematical accents
    (,(rx "\\" word-start (group (or "acute" "b" "bar" "breve" "check"
          "ddot" "dot" "grave" "hat" "widehat" "tilde" "widetilde"
          "vec")) word-end)
     (1 'colour-tex-cruc))
    ;;
    ;; Mathematical class
    (,(rx "\\" word-start (group (or "mathord" "mathop" "mathbin"
          "mathrel " "mathopen" "mathclose" "mathpunct")) word-end)
     (1 'colour-tex-cruc))
    ;;
    ;; Equations and multiline display
    (,(rx "\\" word-start (group (or "eqno" "leqno" "displaylines"
          "eqalign " "eqalignno" "leqalignno")) word-end)
     (1 'colour-tex-cruc))
    ;;
    ;; Big sizes.  Using concat rather than rx.
    (,(concat "\\\\\\<\\(big\\|bigl\\|bigm\\|bigr\\|Big\\|Bigl\\|"
              "Bigm\\|Bigr\\|bigg\\|biggl\\|biggm\\|biggr\\|"
              "Bigg\\|Biggl\\|Biggm\\|Biggr\\|downbracefill\\|"
              "upbracefill\\|arrowvert\\|Arrowvert\\|lmoustache\\|"
              "rmoustache\\|bracevert\\)\\>")
     (1 'colour-tex-cruc)) )
  "Fontification for letters and symbols.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; * Positioning of superscripts and subscripts
;;               _       __
;;  ____  _ _ __(_)_ _  / _|  _ __  ___ ____ _
;; (_-< || | '_ \ | ' \|  _| | '_ \/ _ (_-< ' \
;; /__/\_,_| .__/_|_||_|_|   | .__/\___/__/_||_|
;;         |_|               |_|

;; ---------------------------------------------------------------------
(defcustom supinf-signal t
  "Enables typeface for tex commands."
  :type 'boolean
  :group 'supinf)

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

;; ---------------------------------------------------------------------
(defcustom deviat-supinf '(0.18 -0.18)
  "Sets the vertical shift for superior and inferior glyphs.
Deviation is measured relative to the text font size."
  :group 'supinf
  :type '(list (float :tag "superior-deviation")
               (float :tag "inferior-deviation")) )

;; ---------------------------------------------------------------------
(defcustom height-scale-supinf 0.8
  "Sets relative supinf height ratio with the preceding text.
For nested expressions, the setting is applied repeatedly,
subject to the limit set by `crucible-height-minimum'."
  :type 'float
  :group 'supinf)

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

;; ---------------------------------------------------------------------
(defun supinf-height (height)
  "Return integer HEIGHT of superior and inferior glyph.
Height is an integer that is 1/10 of point size.  Not smaller than the
value set by `crucible-height-minimum'."
  (ceiling
     (max
        (if (integerp height-minimum-supinf)
	    height-minimum-supinf
	  (condition-case nil ; For bootstrapping.
	      (* height-minimum-supinf
		 (face-attribute 'default :height))
	    (error 0)))
	(* height height-scale-supinf))))  ; assumes height is integer.

;; ---------------------------------------------------------------------
(defface supr-tfc
  '((t :height supinf-height))
  "Typography for superior glyphs."
  :group 'supinf)

;; ---------------------------------------------------------------------
(defface infr-tfc
  '((t :height supinf-height))
  "Typography for inferior glyphs."
  :group 'supinf)

;; ---------------------------------------------------------------------
(defun supinf-raise-cruc (pos)
  "Raise and lower typeface at position POS."
  (unless (or (memq (get-text-property pos 'face)
		    '(font-lock-constant-face font-lock-builtin-face))
	      ;; Check for backslash quoting
	      (let ((odd nil) (pos pos))
		(while (eq (char-before pos) ?\\)
		  (setq pos (1- pos) odd (not odd)))
		odd))
    (if (eq (char-after pos) ?^)
	`(face supr-tfc display (raise ,(car deviat-supinf)))
      `(face infr-tfc display (raise ,(cadr deviat-supinf))) )))

;; ---------------------------------------------------------------------
(defun supinf-match (limit)
  "Match superior and inferior glyph patterns up to LIMIT."
  (when (and supinf-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))

;; ---------------------------------------------------------------------
(defconst supinf-font-lock-cruc
  (append
     '((supinf-match
          (1 (supinf-raise-cruc (match-beginning 0))) )))
  "Experimental expressions to highlight in TeX modes.")

;; ---------------------------------------------------------------------
(defun supinf-enable ()
  "Enables a typeface for displaying tex commands."
  (setq supinf-signal t)
  (font-lock-add-keywords nil supinf-font-lock-cruc t))

;; ---------------------------------------------------------------------
(defun supinf-disable-cruc (beg end)
  "Set typeface for text between BEG and END."
  (font-lock-default-unfontify-region beg end)
  (while (< beg end)
    (let ((next (next-single-property-change beg 'display nil end))
	  (prop (get-text-property beg 'display)))
      (if (and (eq (car-safe prop) 'raise)
	       (member (car-safe (cdr prop)) deviat-supinf)
	       (null (cddr prop)))
	  (put-text-property beg next 'display nil))
      (setq beg next))))

;; ---------------------------------------------------------------------
;;(defun tex-typeface-crucible ()
;;  "Font-lock setup for mathematical symbols."
;;  (font-lock-flush (point-min) (point-max))
;;  (if crucible-supinf-enable
;;      (progn
;;        (font-lock-add-keywords nil tex-keywords-cruc t)
;;        (font-lock-add-keywords nil supinf-font-lock-cruc t))
;;    (font-lock-remove-keywords nil tex-keywords-cruc)
;;    (supinf-disable-cruc (point-min) (point-max)))
;;  (font-lock-flush (point-min) (point-max)))

(defun supinf-disable ()
  "Disable supinf functionality."
  (interactive)
  (setq-local supinf-signal nil)
  (font-lock-flush))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; * Displays texmath glyphs for the corresponding tex commands.
;;             _   _           _           _
;;  _ __  __ _| |_| |_    __ _| |_  _ _ __| |_  ___
;; | '  \/ _` |  _| ' \  / _` | | || | '_ \ ' \(_-<
;; |_|_|_\__,_|\__|_||_| \__, |_|\_, | .__/_||_/__/
;;                       |___/   |__/|_|

;;(require 'prog-mode)

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

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

;; ---------------------------------------------------------------------
(defun texglyph-crucible ()
  "Set keywords and corresponding glyph."
  (push '("\\alpha" . ?α) prettify-symbols-alist)
  (push '("\\beta" . ?β) prettify-symbols-alist)
  (setq prettify-symbols-compose-predicate 'texglyph-predicate))

;; ---------------------------------------------------------------------
(defun texglyph-enable ()
  "Enables typeface for tex glyphs."
  (texglyph-crucible)
  (prettify-symbols-mode))

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

;; ---------------------------------------------------------------------
(defvar-local texglyph-state-cruc nil)

(defun texglyph-cycle-crucible ()
  "Cycles supinf and texglyph functionality."
   (interactive)
   (pcase texglyph-state-cruc
     ;; ----------------------------------------------
     (1 (setq supinf-signal t)
	(supinf-enable)
	(message "Supinf Enabled")
        (setq-local texglyph-state-cruc (1+ texglyph-state-cruc)))
     ;; ----------------------------------------------
     (2 (texglyph-enable)
        (message "Supinf and Glyphs Enabled")
        (setq-local texglyph-state-cruc (1+ texglyph-state-cruc)))
     ;; ----------------------------------------------
     (_ (supinf-disable)
	(prettify-symbols-mode 0)
	(message "Supinf and Glyphs Disabled")
        (setq-local texglyph-state-cruc 1)) ))

;; -----------------------------------------------------------------------
(defun crucible-prettify-hook ()
  "Hooks."
  (add-hook 'crucible-mode-hook #'supinf-enable)
  (add-hook 'texinfo-mode-hook #'texglyph-crucible))

(global-set-key (kbd "H-t") #'texglyph-cycle-crucible)

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

(crucible-prettify-hook)
(provide 'crucible-mode)

;;; crucible-mode.el ends here

[-- Attachment #3: crucible-test.texi --]
[-- Type: application/x-texinfo, Size: 1397 bytes --]