diff options
| -rw-r--r-- | emacs/scripts/cdm-mode.el | 78 |
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)) |