;; This file:
;;   http://angg.twu.net/dednat6/dednat6.el.html
;;   http://angg.twu.net/dednat6/dednat6.el
;;           (find-angg "dednat6/dednat6.el")
;; Author: Eduardo Ochs <[email protected]>
;; Version: 2020aug14

;; This file adds some support for Dednat6 to Emacs. To use it, put
;; something like this in your .emacs:
;;
;;   (load "~/path_to_this_file/dednat6.el")
;;
;; or execute the sexp above with `C-x C-e' or something similar.
;;
;; Dednat6 is explained here:
;;
;;   http://angg.twu.net/dednat6/tug-slides.pdf
;;   http://angg.twu.net/dednat6/tugboat-rev2.pdf
;;   http://angg.twu.net/dednat6.html
;;
;; This file defines the commands `M-x diagskel', that inserts a
;; skeleton of a(n empty) 2D diagram at point, and `M-x dednames',
;; that is a bit harder to understand - so here is an example.

"When you load this file in Emacs it will treat this multi-line
string as a comment. To test `M-x dednames' mark the %:-block
below as the region, put the point at the end of it,

%:
%:   A
%:   :
%:   B    [B]^1  D  [C]^1  E     A
%:  ---   ::::::::  ::::::::     :
%:  BvC       F        F         B     D
%:  --------------------1        -------
%:            F                     F
%:
%:            ^before               ^after
%:

and run `M-x dednames'. It will insert something like

  \\pu
  $$\\ded{before} \\qquad \\ded{after}$$

at point, but without the double slashes. Don't forget to undo
your changes to this file!"




;;;  __  __                 _ _                 _        _ 
;;; |  \/  |    __  __   __| (_) __ _  __ _ ___| | _____| |
;;; | |\/| |____\ \/ /  / _` | |/ _` |/ _` / __| |/ / _ \ |
;;; | |  | |_____>  <  | (_| | | (_| | (_| \__ \   <  __/ |
;;; |_|  |_|    /_/\_\  \__,_|_|\__,_|\__, |___/_|\_\___|_|
;;;                                   |___/                

(defun diagskel ()
  "Insert a skeleton for a dednat6 diagram - its %D-block and its TeX code.
This function inserts at point a skeleton for an empty diagram.
In most situations it is better to change the name of the diagram
- \"??\", by default - to something more descriptive."
  (interactive)
  (insert "
%D diagram ??
%D 2Dx     100
%D 2D  100
%D 2D
%D 2D  +20
%D 2D
%D # ren ==>
%D
%D ((
%D
%D ))
%D enddiagram
%D
$$\\pu
  \\diag{??}
$$
"))


;;;  __  __                 _          _                                 
;;; |  \/  |    __  __   __| | ___  __| |_ __   __ _ _ __ ___   ___  ___ 
;;; | |\/| |____\ \/ /  / _` |/ _ \/ _` | '_ \ / _` | '_ ` _ \ / _ \/ __|
;;; | |  | |_____>  <  | (_| |  __/ (_| | | | | (_| | | | | | |  __/\__ \
;;; |_|  |_|    /_/\_\  \__,_|\___|\__,_|_| |_|\__,_|_| |_| |_|\___||___/
;;;                                                                      

;; Test: (dednames-in-lines "%: ^A ^B C D\n%: E ^FG ^HI\nblah")
;;   --> (("A" "B") ("FG" "HI"))
;;
(defun dednames-in-lines (bigstr)
  "An internal function used by `dednames'.
It takes the lines that start with \"%:\" in BIGSTR and returns
the names of the derivation trees defined in those lines, as a
list of lists."
  (let ((lines (split-string bigstr "[\n\r]+" t))
	(listoflists nil))
    (dolist (line lines)
      (if (string-match "^%:[ \t]" line)
	  (let ((words (split-string line))
		(listofdednames nil))
	    (dolist (word words)
	      (if (string-match "^^" word)
		  (setq listofdednames (cons (substring word 1 nil)
					     listofdednames))))
	    (if listofdednames
		(setq listoflists (cons listofdednames listoflists))))))
    (reverse (mapcar 'reverse listoflists))))

;; Test: (dednames-to-tex '(("A" "B") ("C" "D")))
;;   --> \pu
;;       $$\ded{A} \qquad \ded{B}$$
;;       $$\ded{C} \qquad \ded{D}$$
;;
(defun dednames-to-tex (listoflists)
  "An internal function used by `dednames'.
It takes the LISTOFLISTS generated by `dednames-in-lines' and
converts it to TeX code that typesets its derivation trees."
  (let ((f (lambda (str)  (format "\\ded{%s}" str)))
        (g (lambda (list) (format "$$%s$$\n" (mapconcat f list " \\qquad ")))))
    (format "\\pu\n%s" (mapconcat g listoflists ""))))

;; Test: (dednames-to-tex-2 '(("A" "B") ("C" "D")))
;;   --> $$\pu
;;         \begin{array}{c}
;;         \ded{A} \qquad \ded{B} \\ \\
;;         \ded{C} \qquad \ded{D} \\
;;         \end{array}
;;       $$
;;
(defun dednames-to-tex-2 (listoflists)
  "`dednames' calls this function if invoked with the argument 2."
  (let* ((f (lambda (str)  (format "\\ded{%s}" str)))
         (g (lambda (list) (format "  %s" (mapconcat f list " \\qquad "))))
	 (body (mapconcat g listoflists " \\\\ \\\\\n")))
    (format "$$\\pu\n  \\begin{array}{c}\n%s \\\\\n  \\end{array}\n$$" body)))

(defun dednames (s e arg)
  (interactive "r\nP")
  "Generate TeX code to typeset the derivation trees in the region.
To use this function, mark a region containing %:-blocks for
dednat6, put the point at the end of the region, and type M-x
dednames. This function will insert at point the TeX code for
typesetting the derivation trees defined in the region, in a
format like this:

\\pu
$$\ded{A} \\qquad \ded{B}$$
$$\ded{C} \\qquad \ded{D}$$"
  (let* ((bigstr      (buffer-substring-no-properties s e))
	 (listoflists (dednames-in-lines bigstr))
	 (suffix      (if arg (format "-%d" arg) ""))
	 (subfunction (intern (format "dednames-to-tex%s" suffix)))
	 (tex         (if listoflists (funcall subfunction listoflists))))
    (if listoflists
	(insert tex)
      (error "No \"%:\" lines in region or no \"^dedname\"s in them"))))