LisTeX

(defvar listex-lisp-macro-alist nil
  "Alist storing all listex macros that are defined.")

(defmacro listex:lisp-macro-alist-pair (alist key args list-or-fun)
  `(list '(alist-get ',key ,alist)
         ,(cl-etypecase list-or-fun
            (function list-or-fun)
            (list `(cl-flet ((f ,args ,list-or-fun))
                     (cl-function f))))))

(defmacro listex:defmacro (key !args list-or-fun)
  `(let ((args (listex:lisp-macro-alist-pair listex-lisp-macro-alist
                                             ,key
                                             ,!args
                                             ,list-or-fun)))
     (eval `(setf ,@args))))



(defmacro listex:newcmd--format-function (args fmt)
  `(format ,fmt ,@(cl-loop for a in args
                           ;; make sure that a is not a & identifier
                           ;; for functions like &rest
                           if (not (string-prefix-p "&" (symbol-name a)))
                           collect `(listex:render-tex ,a))))

(defmacro listex:newcmd (key args fmt)
  `(listex:defmacro ,key ,args (listex:newcmd--format-function ,args, fmt)))

(defmacro listex:defalias (alias key)
  `(setf (alist-get ',alias listex-alias-alist) ',key))

;; important macros
(listex:newcmd braced (&rest body) "{%s}")
(listex:newcmd progn (&rest body) "%s")
(listex:newcmd list (&rest body) "%s")

;; left right stuff
(listex:newcmd lr (l r &rest body) "\\left%1$s %3$s \\right%2$s")
(listex:defmacro lrp (&rest args) `(lr \( \) ,@args))
(listex:defmacro lrs (&rest args) `(lr \[ \] ,@args))
(listex:defmacro set (&rest args) `(lr /{ /} ,@args))

;; quantum mechanics
(listex:defmacro <| (&rest args) `(lr /langle | ,@args))
(listex:defmacro |> (&rest args) `(lr | /rangle ,@args))

;; exponents
(listex:newcmd ^ (base &rest sup) "%s^{%s}")
(listex:newcmd _ (base &rest sub) "%s_{%s}")
(listex:newcmd ^_ (base sup sub) "%s^{%s}_{%s}")
(listex:newcmd _^ (base sub sup) "%s_{%s}^{%s}")

;; wrapping
(listex:newcmd begend (b &rest bod) "%s%s%1$s")
(listex:newcmd env (env-name &rest body) "\\begin{%1$s}\n%s\n\\end{%1$s}")

(listex:defmacro mat (&rest args) `(env pmatrix ,@args))

;; Math environments
(listex:defmacro $ (&rest args) `(begend $ ,@args))
(listex:defmacro $$ (&rest args) `(begend $$ ,@args))
(listex:defmacro eq (&rest args) `(env equation ,@args))
(listex:defmacro eq* (&rest args) `(env equation* ,@args))
(listex:defmacro al (&rest args) `(env align ,@args))
(listex:defmacro al* (&rest args) `(env align* ,@args))

;; force newlines in the output
(listex:newcmd terpri () "\n")
(listex:newcmd br () "\n")
(listex:newcmd nl () "\n")

;; more convoluted example
(listex:defmacro matrix
                 (rows cols &rest elements)
                 (progn
                   (cl-assert (eq (length elements) (* cols rows)))
                   `(env pmatrix
                         ,@(cl-loop for el in elements
                                    with i = 0
                                    with buff = nil
                                    do (push el buff)
                                    do (cl-incf i)
                                    if (eq (% i cols) 0)
                                    do (push '\\\\ buff)
                                    and collect (reverse buff)
                                    and do (setf buff nil)
                                    else
                                    do (push '& buff)))))

(defun listex:render-tex (expr)
  "Main function to convert a listex DSL s-expression
   into a latex-compatible string."
  (cl-etypecase expr
    (listex:lisp-macro (let* ((args (cdr expr))
                              (name (car expr))
                              (f (listex:lisp-macro-get-fun name))
                              (new-expr (apply f args)))
                         (listex:render-tex new-expr)))
    (listex:alias (let* ((replacement (listex:get-alias expr)))
                    (listex:render-tex replacement)))
    (listex:keyword (format "\\%s"
                            (string-remove-prefix listex-keyword-prefix
                                                  (symbol-name expr))))
    (listex:command
     (let* ((args (mapcar (lambda (e) (cl-etypecase e
                                        (vector e)
                                        (otherwise (format
                                                    "{%s}"
                                                    (listex:render-tex e)))))
                          (cdr expr)))
            (name (format "\\%s" (string-remove-prefix listex-command-prefix
                                                       (symbol-name
                                                        (car expr)))))
            (args-strings (mapcar #'listex:render-tex args)))
       (concat name (string-join args-strings))))
    (listex:operator (let* ((name (car expr))
                            (namestr (symbol-name name))
                            (op (if (> (length namestr) 1)
                                    (string-remove-prefix listex-operator-prefix
                                                          namestr)
                                  namestr)))
                       (string-join (mapcar #'listex:render-tex (cdr expr))
                                    (format " %s " op))))
    (list (string-join (mapcar #'listex:render-tex expr) " "))
    (atom (format "%s" expr))))




(defun listex (expr)
  (listex:render-tex expr))

(defun listex:render-last-sexpr (&optional not-eval?)
  (interactive "P")
  (let ((sexp (thing-at-point 'sexp)))
    (message (listex:render-tex (if not-eval?
                                    (read sexp)
                                    (eval (read sexp)))))))

(defun listex:render-defun (&optional not-eval?)
  (interactive "P")
  (let ((sexp (thing-at-point 'defun)))
    (message (listex:render-tex (if not-eval?
                                    (read sexp)
                                    (eval (read sexp)))))))

(use-package listex
    :config
    (evil-define-key '(insert normal) listex-mode-map
      (kbd "C-c C-c") #'listex:render-defun
      (kbd "C-c C-e") #'listex:render-last-sexpr))

'(progn
   (-documentclass [12pt] article)
   (-usepackage hyperref)
   (env document
	(-section Introduction)
	(nl)
	(progn This document is is an example for the (-texttt LisTeX)
	       domain specific language \(DSL\).
	       (nl)

	       You can also do inline math

	       ($ (+ (^ A 5)) + 5)

	       or displaystyle math

	       (nl)

	       ($$ (+ (^ A 5) 5)
		   .)

	       )))

(lt-aliaslet ((φ '/phi)
	      († '/dagger))
  '(matrix 2 3
	 (-hat A) B (-dot E)
	 (-tilde (-hat C)) D (_ E (matrix 2 2
					  1 (* (-hat φ) †)
					  3 4))))

weird-matrix

(cl-subst '(-color red /psi)
	  'D
	  weird-matrix)

(lt-cmdlet ((χ (a b c) "%s^{%s^{%s}}"))
	   '(-frac (χ 5 5 5)
		   /varphi))

(lt-aliaslet ((δ '/delta)
	      (μ '/mu)
	      (ν '/nu)
	      (~% "\n")
	      (=nl= '\\\\)
	      (gμν '(_ g μ ν)))
  (lt-macrolet ((lisp (&rest args) (eval `(progn ,@args)))
		(main (&rest args) `(env document ,@args))
		(text (&rest args) (progn (require 's)
					  (s-word-wrap 80 (listex args))))
		(code (&rest args) `(-texttt ,@args))
		(* (&rest title) `("\\section{" ,@title "}" "\n\n"))
		(** (&rest title) `("\\subsection{" ,@title "}" "\n\n"))
		(*** (&rest title) `("\\ssubsection{" ,@title "}" "\n\n"))
		(eqlab (label &rest args) `(eq (-label ,label)
					       ,@args))

		(d! (var) `(progn (-mathrm d) ,var)))
    '(main
      (* Über das Gravitationsfeld eines Massenpunktes nach der
	 Einsteinschen Theorie.)

      (text Hr. Einstein hat in seiner Arbeit über die Perihelbewegung des
	    Merkur "(s. Sitzungsberichte vom 18. November 1915)" folgendes
	    Problem gestellt:

	    =nl=

	    Ein Punkt bewege sich gemäß der Forderung

	    (eqlab eq:main-metric-definition
		   (lr /{ \.
		       (env matrix
			    (= (δ /int (d! s))
			       0)
			    =nl= =nl=
			    (= (d! s)
			       (-sqrt (/sum gμν
					    (d! (_ x μ))
					    (d! (_ x ν))))))))

	    wobeit ($ gμν) Funktionen der Variabeln ($ x) bedeuten und bei
	    der Variation am Anfang und Ende des Integrationswegs die
	    Variablen ($ x) festzuhalten sind. Der Punkt
	    bewege sich "also," kurz "gesagt," auf einer geodätischen Linie in
	    der durch das Linienelement ($ (d! s)) charakterisierten
	    Mannigfaltigkeit.

	    =nl=

	    Die Ausführung der Variation ergibt die Bewegungsgleichungen des
	    Punktes)

      =nl=
      To be continued...)))

(defun listex:render-xml (expr)
  "Main function to convert a listex DSL s-expression
   into a latex-compatible string."
  (cl-etypecase expr
    (listex:lisp-macro (let* ((args (cdr expr))
                              (name (car expr))
                              (f (listex:lisp-macro-get-fun name))
                              (new-expr (apply f args)))
                         (listex:render-xml new-expr)))
    (listex:alias (let* ((replacement (listex:get-alias expr)))
                    (listex:render-xml replacement)))
    (listex:command
     (let* ((name (string-remove-prefix
                   listex-command-prefix
                   (symbol-name (car expr))))
            (args-strings (mapcar #'listex:render-xml (cdr expr))))
       (format "%s=\"%s\"" name (string-join args-strings " "))))
    (list (string-join (mapcar #'listex:render-xml expr) " "))
    (atom (format "%s" expr))))


(defmacro with-xml (&rest body)
  `(cl-flet ((commandp (lambda (e) (typep e 'listex:command)))
             (join-exprs (l) (string-join (mapcar #'listex:render-xml l) " ")))
       (lt-macrolet ((> (name &rest content)
                        (let ((commands (remove-if-not #'commandp content))
                              (tag-content (remove-if #'commandp content)))
                          (format "<%s %s>\n%s\n</%1$s>\n"
                                  name
                                  (join-exprs commands)
                                  (join-exprs tag-content)))))
         ,@body)))

(lt-macrolet ((π (&rest body) `(> p (-class md-3 flex) ,@body)))
  (with-xml
   '(> html
       (> head
	  (> title
	     This is the inside of this title))
       (> body
	  (> div (-class "content")
	     (π Here is a paragraph of my blog.
		I am pretty happy about how my paragraph is coming along.)

	     And this is some content that I want to put
	     outside of my paragraph.)))))

<html >
<head >
<title >
This is the inside of this title
</title>

</head>
 <body >
<div class="content">
<p class="md-3 flex">
Here is a paragraph of my blog. I am pretty happy about how my paragraph is coming along.
</p>
 And this is some content that I want to put outside of my paragraph.
</div>

</body>

</html>