Changed functionality of 2/3 cells

1 files changed, 46 insertions, 32 deletions

diff --git a/emacs/scripts/cdm-mode.el b/emacs/scripts/cdm-mode.el
index 03fcc76..5fb2c37 100644
--- a/emacs/scripts/cdm-mode.el
+++ b/emacs/scripts/cdm-mode.el
@@ -1,16 +1,16 @@
-;; Time-stamp: <2019-05-22 19:10:33 (tslil@basingstoke)>
+;; Time-stamp: <2020-02-26 21:47:18 (tslil@bison)>
 
 (defvar cdm-arr-type-list '(("arrow" . "a")
                             ("id" . "d")
+                            ("universal" . "u")
+                            ("2-cell" . "cn")
+                            ("2-cell iso" . "cni")
+                            ("2-cell eq" . "cne")
+                            ("3-cell" . "ct")
+                            ("3-cell eq" . "cte")
                             ("proarrow" . "proarrow")
                             ("proid" . "proequal")
                             ("prodotted" . "prodotted")
-                            ("2-square" . "sn")
-                            ("id-square" . "sd")
-                            ("universal" . "u")
-                            ("2-cell" . "n")
-                            ("3-cell" . "t")
-                            ("3-square" . "st")
                             ("parallel" . "p")
                             ("monomorphism" . "m")
                             ("epimorphism" . "e")))
@@ -26,8 +26,6 @@
                         "midway" "below right" "below left"
                         "above right" "above left" "none"))
 
-(defvar cdm-cell-len ".3cm")
-
 (defvar cdm--use-helm nil)
 
 (defvar cdm-mode-map
@@ -184,6 +182,34 @@
 (defun cdm--string-good-p (str)
   (and str (string-or-null-p str) (not (string-blank-p str))))
 
+(defvar cdm-default-cell-slide "\\cellslide")
+(defvar cdm-default-cell-length "\\celllength")
+
+(defun cdm--insert-cell-tex (from-node to-node type &optional label-props slide length)
+  (end-of-line)
+  (newline-and-indent)
+  (let* ((iso (string-suffix-p "i" type))
+         (typ (substring-no-properties type 1 (if iso -1 (length type))))
+         (yes-props (cdm--string-good-p label-props))
+         (yes-slide (cdm--string-good-p slide))
+         (yes-length (cdm--string-good-p length))
+         (yes-type (not (string-equal typ "n")))
+
+         (lps (if (or yes-props yes-type yes-slide yes-length)
+                  (concat "[" (if yes-props label-props "") "]") ""))
+         (tys (if (or yes-type yes-slide yes-length)
+                  (concat "[" typ "]") ""))
+         (sls (if (or yes-slide yes-length)
+                  (concat "[" (if yes-slide slide cdm-default-cell-slide) "]")
+                ""))
+         (lns (if yes-length (concat "[" length "]") "")))
+    (insert "\\cell" (if iso "i" "")
+            lps tys sls lns
+            "{" from-node "}"
+            "{" to-node "}"
+            "{};"))
+  (backward-char 2))
+
 (defun cdm--insert-arrow-tex (from-node to-node type &optional label-props draw-style misc)
   (end-of-line)
   (newline-and-indent)
@@ -198,17 +224,6 @@
           "(" to-node ");")
   (when label-props (search-backward "$}")))
 
-(defun cdm--insert-arrow-square-tex (from-node to-node type &optional label-props extra)
-  (cdm--insert-arrow-tex "\\p2" "\\p3" type
-                         (unless (string-equal type "d")
-                           (concat label-props "inner sep=0,swap"))
-                         extra
-                         (concat "let \\p1 = ($("
-                                 from-node ")!.5!("
-                                 to-node ")$), \\p2 = ($(\\p1)!" cdm-cell-len "!("
-                                 from-node ")$), \\p3 =($(\\p1)!" cdm-cell-len "!("
-                                 to-node ")$) in ")))
-
 (defun cdm--insert-parallel-arrows (from-node to-node &optional labelled)
   (let* ((prompt "Select parallel arrow directionality: ")
          (ty (if cdm--use-helm (helm :sources cdm--parr-dir-helm-source
@@ -251,24 +266,23 @@
     (let ((type (cdm--complete-arr-type)))
       (when type
         (let* ((par (string-equal "p" type))
-               (extra (when (and (not par) extra-props)
+               (cell (string-prefix-p "c" type))
+               (extra (when (and (not par) (not cell) extra-props)
                         (read-string "Extra properties: ")))
                (from-node (cdm--complete-nodes "From: "))
                (to-node (cdm--complete-nodes "To: "))
                (labelled (unless (string-suffix-p "d" type)
                            (char-equal ?\C-m (read-char "Labelled (Return = yes)?"))))
                (label-props (when (and (not par) labelled)
-                              (read-string "Label properties: "))))
+                              (read-string "Label properties: ")))
+               (slide (when cell
+                        (read-string "Slide: ")))
+               (length (when cell (read-string "Length: "))))
           (cond
            (par (cdm--insert-parallel-arrows from-node to-node labelled))
-           ((string-prefix-p "s" type)
-            (cdm--insert-arrow-square-tex from-node to-node
-                                          (string-remove-prefix "s" type)
-                                          label-props
-                                          extra))
+           (cell (cdm--insert-cell-tex from-node to-node type label-props slide length))
            (t (cdm--insert-arrow-tex from-node to-node type label-props extra))))))))
 
-
 (defun cdm-square-reset ()
   (interactive)
   (setq cdm--square-progress 0
@@ -296,10 +310,10 @@
         (s (cdm--next-name)))
     ;; Insert stuff
     (cond
-     ((= p 7) (cdm--prompt-insert-arrow-square (nth 3 n) (nth 1 n) "swap"))
-     ((= p 6) (cdm--prompt-insert-arrow-square (nth 2 n) (nth 0 n) ""))
-     ((= p 5) (cdm--prompt-insert-arrow-square (nth 3 n) (nth 2 n) ""))
-     ((= p 4) (cdm--prompt-insert-arrow-square (nth 1 n) (nth 0 n) "swap"))
+     ((= p 7) (cdm--prompt-insert-arrow-square (nth 3 n) (nth 1 n) ""))
+     ((= p 6) (cdm--prompt-insert-arrow-square (nth 2 n) (nth 0 n) "swap"))
+     ((= p 5) (cdm--prompt-insert-arrow-square (nth 3 n) (nth 2 n) "swap"))
+     ((= p 4) (cdm--prompt-insert-arrow-square (nth 1 n) (nth 0 n) ""))
      ((= p 3) (cdm--insert-raw-node s (concat "below of=" (cadr n)) "$$" 3))
      ((= p 2) (cdm--insert-raw-node s (concat "below of=" (car n)) "$$" 3))
      ((= p 1) (cdm--insert-raw-node s (concat "right of=" (car n)) "$$" 3))