From ac1a4884d03fc0495c773500d8a13f84b695fa43 Mon Sep 17 00:00:00 2001 From: tslil clingman <> Date: Wed, 11 Sep 2019 19:18:14 -0400 Subject: Init --- emacs/scripts/acquiesce.el | 351 ++++++++++++++++++++++++++++++++++++++++ emacs/scripts/caps-lock-mode.el | 21 +++ emacs/scripts/cdm-mode.el | 342 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 714 insertions(+) create mode 100644 emacs/scripts/acquiesce.el create mode 100644 emacs/scripts/caps-lock-mode.el create mode 100644 emacs/scripts/cdm-mode.el (limited to 'emacs/scripts') diff --git a/emacs/scripts/acquiesce.el b/emacs/scripts/acquiesce.el new file mode 100644 index 0000000..0dcf9fc --- /dev/null +++ b/emacs/scripts/acquiesce.el @@ -0,0 +1,351 @@ +(require 'cl) + +(defmacro default (expr default) + "If `expr' evaluates to non-null then return the result, otherwise give `default'." + (let ((e (gensym))) + `(let ((,e ,expr)) + (if ,e ,e ,default)))) + +;; ============================================================================= +;; File stuff +(defun acme--file-p (str) + (and (file-exists-p str) + (file-readable-p str) + (not (car (file-attributes str))))) + +(defun acme--recursive-locate-file (regexp start-dir depth) + (let ((dirs (list start-dir)) found) + (cl-loop + while (and (not found) (/= depth 0)) do + (let (ndirs) + (cl-loop for dir in dirs unless found do + (let ((candidates (directory-files-and-attributes + dir t + directory-files-no-dot-files-regexp))) + (cl-loop for file in candidates unless found do + (let ((name (nth 0 file)) + (is-dir (nth 1 file))) + (if is-dir (add-to-list 'ndirs name nil nil) + (when (string-match-p regexp name) + (setq found name) nil)))))) + (setq depth (1- depth)) + (setq dirs ndirs))) + found)) + +(defun acme--as-pos-natural (arg) + (when arg + (if (stringp arg) + (unless (string-match-p "[^0-9]" arg) + (let ((n (string-to-number arg))) + (when (and (> n 0) (integerp n)) n))) + (when (and (integerp arg) (> arg 0)) arg)))) + +(defun acme--parse-as-file (str dir) + "Attempt to interpret a string as [:[:]] or +:[][:] where at least one of or is +given, and find a file that best represents the string by processing the +following in order: + + 0. if is not given, assume current file + 1. as a file in dir + 2. as an absolute path to a file + 3. If at least is given, take as a regexp against + which to match a file in dir, of which the first match + (alphabetically) is taken" + (let* ((spl (split-string str ":+?" nil)) + (line-s (nth 1 spl)) (col-s (nth 2 spl)) + (line (if line-s (acme--as-pos-natural line-s) 1)) + (col (if col-s (acme--as-pos-natural col-s) 1)) + (fn (nth 0 spl))) + (when (and line col (> 4 (length spl)) + (not (string-match-p ".*/$" fn))) + (cl-flet ((found (f) (when f (list :LINE line :COL col :FILE f)))) + (let ((rfn (concat dir fn))) + (cond + ((or (and line-s line) (and col-s col)) (list :LINE line :COL col :FILE nil)) + ((acme--file-p rfn) (found rfn)) + ((acme--file-p fn) (found fn)) + ((or col-s line-s) (found (acme--recursive-locate-file + fn dir + acme-find-file-recursive-depth))) + + )))))) + +(defun acme--process-file (file) + (let ((fname (plist-get file :FILE)) + (line (plist-get file :LINE)) + (col (plist-get file :COL))) + (when fname (find-file fname)) + (when line (goto-line line)) + (when col (forward-char col)))) + +;; ============================================================================= +;; General magic +(defmacro return-first (first &rest body) + "Execute `first' first, then `body', return whatever `first' did." + (let ((val (gensym))) + `(let ((,val ,first)) + ,@body + ,val))) + +(defun acme--extract-string (&optional count) + "Extract a string from the buffer as follows: +1. If there is a region, use it +2. If point is at the start of the line, then use the whole line. +3. Take the previous (count)?count:1 words +After this, place the point at the end of the appropriate block" + (let ((n (default count 1)) + (p (point)) + (b (line-beginning-position)) + (e (line-end-position))) + (assert (/= n 0) t) + (cond + ((use-region-p) + (return-first + (buffer-substring-no-properties (region-beginning) (region-end)) + (goto-char (region-end)))) + ((= p b) (return-first + (buffer-substring-no-properties b e) + (end-of-line))) + (t (let* ((re (default (search-forward " " e t) e)) + (rs (default (search-backward " " b t n) b))) + (return-first + (buffer-substring-no-properties rs re) + (goto-char re))))))) + +;; ============================================================================= +;; Tag window and buffers +(defun* acme--load-tags (&key (buffer nil) (init nil)) + "Retrieve or create the tags associated to `buffer' (or +current-buffer), saving the old tags if we are _changing_ +buffers." + (assert (window-live-p acme--tag-window)) + (assert (buffer-live-p acme--tag-buffer)) + (let* ((cur-buff (current-buffer)) + (new-buff (default buffer cur-buff)) + (existing-tags (assoc new-buff acme--tag-buffers-alist)) + ) + (set-buffer acme--tag-buffer) + (if (and existing-tags (not init)) + (setf (cdr (assoc cur-buff acme--tag-buffers-alist)) + (buffer-string))) + (erase-buffer) + (if existing-tags (insert (cdr existing-tags)) + (let ((new-tags (concat default-directory " " + (buffer-name new-buff) + acme-tag-default-string))) + (insert new-tags) + (add-to-list 'acme--tag-buffers-alist + `(,new-buff . ,new-tags)))))) + +(defun acme--init-tag-window () + "Initialise the tag window and tag buffer." + (when acme--tag-buffer + (unless (buffer-live-p acme--tag-buffer) + (setq acme--tag-buffer nil))) + (when acme--tag-window + (unless (window-live-p acme--tag-window) + (setq acme--tag-window nil))) + (when acme-delete-other-windows (delete-other-windows)) + (let* ((tag-win (selected-window)) + (content-win (split-window-vertically 2))) + (setq acme--tag-window tag-win + ;;window-size-fixed t + acme--tag-buffer (find-file acme-tag-buffer-name)) + (set-window-dedicated-p acme--tag-window t) + (select-window content-win))) + +(defun acme--get-nth-from-tag (n) + "Get the n'th field from the tag, only really useful n<3." + (save-current-buffer + (set-buffer (cdr (acme--get-tag-buffer))) + (nth n (split-string-and-unquote (buffer-string))))) + +(defun acme--get-directory-from-tag () + (acme--get-nth-from-tag 0)) + +(defun acme--get-buffer-name-from-tag () + (acme--get-nth-from-tag 1)) + +;; ============================================================================= +;; Marking input and output locations +(defun acme-mark-input (&optional arg) + "When the region is active, mark it as the ACME input field, +otherwise take the current buffer as input. Any argument causes +the input to be marked as blank." + (interactive "P") + (setq acme--input-pointer + (if arg 'EMPTY + (if (region-active-p) + (list :BUFFER (current-buffer) + :START (region-beginning) + :END (region-end)) + (list :BUFFER (current-buffer) + :START 0 + :END (buffer-size)))))) + +(defun acme-mark-output (&optional arg) + "When the region is active, mark it as the ACME output +field (thereby consigning it to be replaced by any output), +otherwise take the current buffer as output. Any argument causes +the output to be sent to `acme-error-buffer-name' for the +current directory." + (interactive "P") + (setq acme--output-pointer + (if arg 'EMPTY + (if (region-active-p) + (list :BUFFER (current-buffer) + :START (region-beginning) + :END (region-end)) + (list :BUFFER (current-buffer) + :START (point) + :END nil))))) + +(defun acme-mark-io () + "Mark the current buffer/region as a location for ACME +I/O (useful for piping through commands, for example)." + (interactive) + (acme-input-mark) + (acme-output-mark)) + +;; TODO: Overlays so you can see what is what? + +(defun acme--execute-command (command) + (let* ((list (split-string command)) + (cmd (car list)) + (args (combine-and-quote-strings (cdr list))) + (out-file (make-temp-file "acme--execute-command-output"))) + (save-excursion + (if (eq acme--input-pointer 'EMPTY) + (call-process cmd nil `(:file ,out-file) nil args) + (let ((in-file (make-temp-file "acme--execute-command-input"))) + (set-buffer (plist-get acme--input-pointer :BUFFER)) + (write-region (plist-get acme--input-pointer :START) + (plist-get acme--input-pointer :END) + in-file) + (call-process cmd in-file `(:file ,out-file) nil args) + (delete-file in-file))) + (if (eq acme--output-pointer 'EMPTY) + (progn + (find-file (concat default-directory acme-error-buffer-name)) + (end-of-buffer)) + (let ((out-buffer (plist-get acme--output-pointer :BUFFER)) + (s (plist-get acme--output-pointer :START)) + (e (plist-get acme--output-pointer :END))) + (set-buffer out-buffer) + (beginning-of-buffer) + (when e (delete-region s e)) + (goto-char s))) + (insert-file out-file) + (delete-file out-file)))) + +$date +%H/%M +$ls . +;; Output should start here: +;; 2 +;; 1 +;; 4 +;; 3 +;; 5 +;; 9 +;; $sort +$sort + +;; ============================================================================= +;; General interface +(defun acme-do () + "A generic wrapper around opening files, directories, man-pages, +URLS and other things" + (interactive) + ;; For now, + (acme--process-file + (acme--parse-as-file + (acme--extract-string) + (acme--get-directory-from-tag))) + ) + +(defun acme-execute () + "A DWIM executor. The command to execute is retrieved with + `acme--extract-string'. + +If the command begins with a $, then it is interpreted as a shell +command in the following ways: + +1. If there is neither input nor output marked then it is + executed and the output and errors sent to the buffer + `acme-error-buffer-name' for the current directory. + +2. Using whatever input is marked (whole buffer or region) + + a. If output is marked as a region, is it overwritten with the + result of the command on the input + + b. If output is marked as a buffer, then the result of command + on the input is inserted in that buffer at the marked + position. + +NOTE: When input and output buffers are set to be the same, the +input region is first sent to the command, and then the output +region is overwritten. + +If the command does not start with a $, then it shipped off to +eshell where more magic happens. +" + + (interactive) + (let ((str (acme--extract-string))) + (if (string-prefix-p "$" str) + (acme--execute-command (subseq str 1)) + (eshell-command str)))) + + +(defun acme-init () + ;; TODO: Potentially advise window-deletable-p + (acme--init-tag-window) + (acme--load-tags :init t) + ;;(add-hook 'buffer-list-update-hook 'acme--load-tags) + ;;(add-hook 'find-file-hook 'acme--load-tags) + ) + +;; ============================================================================= +;; Variables and customisable stuff +(defcustom acme-delete-other-windows t + "Delete all other windows when starting ACME mode so that the +tag window is above all others.") +(defcustom acme-find-file-recursive-depth 3 + "Maximum folder depth to recursively seek files for `acme-do'") +(defcustom acme-tag-default-string "Snarf Look Put" + "Default tags for new buffers") +(defcustom acme-tag-buffer-name "+tags" + "Name for tags buffer") +(defcustom acme-error-buffer-name "+errors" + "Name for error buffer used for general output") + +;; (defvar acme--tag-windows-alist nil) +(defvar acme--tag-buffers-alist nil) +(defvar acme--tag-window nil) +(defvar acme--tag-buffer nil) + +(defvar acme--input-pointer nil) +(defvar acme--output-pointer nil) + +;; ============================================================================= +;; Keymap +(defvar acme-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c d") 'acme-do) + (define-key map (kbd "C-c e") 'acme-execute) + (define-key map (kbd "C-c m i") 'acme-mark-input) + (define-key map (kbd "C-c m o") 'acme-mark-output) + (define-key map (kbd "C-c m b") 'acme-mark-io) + map)) + +;; ============================================================================= +;; Mode definition +(define-minor-mode acme-mode + "ACME-esque magic, but key driven" + :lighter " ACME" :keymap acme-mode-map + :global t + (acme-init)) + +(provide 'acme-mode) diff --git a/emacs/scripts/caps-lock-mode.el b/emacs/scripts/caps-lock-mode.el new file mode 100644 index 0000000..c80883a --- /dev/null +++ b/emacs/scripts/caps-lock-mode.el @@ -0,0 +1,21 @@ +(defvar caps-lock-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [remap self-insert-command] 'upcased-self-insert) + map)) + +(define-minor-mode caps-lock-mode + "Caps lock minor mode." + nil " CLK" caps-lock-mode-map) + +(defun upcased-self-insert (arg) + "Insert an uppercase version of the input, unless in a comment or string" + (interactive "p") + (let* ((syn (syntax-ppss)) + (comment-or-string (or (nth 4 syn) (nth 3 syn))) + (last-command-event (if (and (not comment-or-string) + (characterp last-command-event)) + (upcase last-command-event) + last-command-event))) + (self-insert-command arg))) + +(provide 'caps-lock-mode) diff --git a/emacs/scripts/cdm-mode.el b/emacs/scripts/cdm-mode.el new file mode 100644 index 0000000..03fcc76 --- /dev/null +++ b/emacs/scripts/cdm-mode.el @@ -0,0 +1,342 @@ +;; Time-stamp: <2019-05-22 19:10:33 (tslil@basingstoke)> + +(defvar cdm-arr-type-list '(("arrow" . "a") + ("id" . "d") + ("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"))) + +(defvar cdm-parr-dir-list '(("left -> right" . 0) + ("right -> left" . 1) + ("up -> down" . 2) + ("down -> up" . 3))) + +(defvar cdm-wrap-list '("diagram" "tikzpicture" "diagram*" "dgrm")) + +(defvar cdm--pos-list '("below" "right" "left" "above" + "midway" "below right" "below left" + "above right" "above left" "none")) + +(defvar cdm-cell-len ".3cm") + +(defvar cdm--use-helm nil) + +(defvar cdm-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c a") 'cdm-insert-arrow) + (define-key map (kbd "C-c n") 'cdm-insert-node) + (define-key map (kbd "C-c d") 'cdm-insert-square) + (define-key map (kbd "C-c r") 'cdm-square-reset) + map)) + +(defvar cdm--node-list nil) +(defvar cdm--pos-helm-source nil) +(defvar cdm--node-helm-source nil) +(defvar cdm--parr-dir-helm-source nil) +(defvar cdm--arr-type-helm-source nil) + +(defvar cdm--strip-label t) + +(defvar cdm--square-progress 0) +(defvar cdm--square-nodes nil) + +(defun cdm--find-enclosing-pair () + (let* ((p (point)) s e + (lst (cl-loop + for delim in cdm-wrap-list collect + (save-excursion + (when (and + (setq s (search-backward (concat "\\begin{" delim "}") 0 t)) + (setq e (search-forward (concat "\\end{" delim "}") nil t)) + (<= s p) (<= p e)) + (list s e)))))) + (cl-flet + ((nearest (best curr) + (if (or (not best) + (and curr + (> (car curr) (car best)) + (< (cadr curr) (cadr best)))) + curr best))) + (reduce #'nearest lst :initial-value nil)))) + +(defun cdm--is-natural (str) + (when (and str (string-match "[0-9]+" str)) + (string-to-number str))) + +(defun cdm--sort-p (s1 s2) + (let ((n1 (cdm--is-natural (cdr s1))) + (n2 (cdm--is-natural (cdr s2)))) + (if (and n1 n2) (> n1 n2) + (string-lessp (cdr s1) (cdr s2))))) + +(defun cdm--strip-label-f (str) + (let ((strs (split-string str "$+"))) + (if (and (= 3 (length strs)) + (string-blank-p (car strs)) + (string-blank-p (caddr strs))) + (cadr strs) str))) + +;; TODO: This will probably pick up nodes in the text of other nodes. +(defun cdm--scan-for-nodes (start end) + (save-excursion + (setq cdm--node-list nil) + (goto-char start) + (let (node-start node-end label-start label-end) + (while (setq node-start (search-forward "node(" end t)) + (setq node-end (search-forward ")" end t) + label-start (search-forward "{" end t) + label-end (progn (backward-char) + (ignore-errors (1+ (forward-list))))) + (when (and node-end label-start label-end (< 1 (- node-end node-start))) + (let* ((temp (if (and label-end label-start (> label-end label-start)) + (buffer-substring-no-properties label-start (- label-end 2)) + "This literal will never appear in the list.")) + (node (buffer-substring-no-properties node-start (1- node-end))) + (label (if (string-blank-p temp) (concat node "\t(no label)") + (concat (if cdm--strip-label (cdm--strip-label-f temp) temp) + "\t(" node ")")))) + (push `(,label . ,node) cdm--node-list)))))) + cdm--node-list) + +(defun cdm--get-nodes () + (let ((enclosing-pair (cdm--find-enclosing-pair))) + (if enclosing-pair + (progn (apply #'cdm--scan-for-nodes enclosing-pair) + (setq cdm--node-list (sort (copy-list cdm--node-list) #'cdm--sort-p)) + (or cdm--node-list t)) + (error "Not currently in an enclosing diagram environment.")))) + +(defun cdm--ivy-complete (prompt list) + (cdr (assoc-string (ivy-read prompt list) list))) + +(defun cdm--complete-nodes (prompt) + (if cdm--use-helm (helm :sources cdm--node-helm-source + :prompt prompt + :buffer "*helm-node*") + (cdm--ivy-complete prompt cdm--node-list))) + +(defun cdm--complete-position () + (let* ((prompt "Select relative position: ") + (p (if cdm--use-helm (helm :sources cdm--pos-helm-source + :prompt prompt + :buffer "*helm-position*") + (ivy-read prompt cdm--pos-list)))) + (when p + (cond + ((string-equal "none" p) nil) + ((string-equal "midway" p) (concat p ", from= ")) + (t (concat p " of= ")))))) + +(defun cdm--complete-arr-type () + (let ((prompt "Select arrow type: ")) + (if cdm--use-helm (helm :sources cdm--arr-type-helm-source + :prompt prompt + :buffer "*helm-arrow*")) + (cdm--ivy-complete prompt cdm-arr-type-list))) + +(defun cdm--not-so-smart-move () + (back-to-indentation) + (unless (= (point) (line-end-position)) + (end-of-line) + (newline-and-indent))) + +(defun cdm--insert-raw-node (name modifiers content &optional goto) + (cdm--not-so-smart-move) + (insert "\\node(" name ")[" modifiers "]{" content "};") + (when goto (backward-char goto))) + +(defun cdm--insert-raw-path (name starting ending modifiers content &optional goto) + (cdm--not-so-smart-move) + (insert "\\path(" starting ") -- (" ending ")node(" + name ")[auto=false" modifiers "]{" content "};") + (when goto (backward-char goto))) + +(defun cdm--next-name () + (when (cdm--get-nodes) + (let* ((last-name (cdar cdm--node-list)) + (last-number (if last-name (string-to-number last-name) 0))) + (unless (and (= 0 last-number) + last-name) + (number-to-string (+ 1 last-number)))))) + +(defun cdm-insert-node (&optional node-name) + (interactive) + (let* ((name (or node-name + (read-string "New node name: " (cdm--next-name)))) + (position (cdm--complete-position)) + (rel-to (when position (cdm--complete-nodes position))) + (midway-other (when (and position + (string-prefix-p "midway" position)) + (cdm--complete-nodes "midway, ending=")))) + (if midway-other + (cdm--insert-raw-path name rel-to midway-other ",midway" "$$" 3) + (cdm--insert-raw-node name (if rel-to (concat position rel-to) "") "$$" 3)))) + +(defun cdm--string-good-p (str) + (and str (string-or-null-p str) (not (string-blank-p str)))) + +(defun cdm--insert-arrow-tex (from-node to-node type &optional label-props draw-style misc) + (end-of-line) + (newline-and-indent) + (insert "\\draw[" type + (if (cdm--string-good-p draw-style) + (concat "," draw-style) "") + "]" + (if (cdm--string-good-p misc) misc "") + "(" from-node ")to" + (if label-props + (concat " node[" label-props "]{$$}") "") + "(" 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 + :prompt prompt + :buffer "*helm-parr*") + (cdm--ivy-complete prompt cdm-parr-dir-list)))) + (when ty + (let ((dirs (case ty + (0 '(".east" . ".west" )) + (1 '(".west" . ".east" )) + (2 '(".south". ".north")) + (3 '(".north". ".south")))) + (pre-str (concat "[" (if (< ty 2) "y" "x") "shift=")) + (plus "+0.6ex]") + (minus "-0.6ex]") + (swaps (if (or (= ty 0) (= ty 2)) '("" . "swap") '("swap" . "")))) + (cdm--insert-arrow-tex (concat pre-str plus from-node (car dirs)) + (concat pre-str plus to-node (cdr dirs)) + "a" (when labelled (car swaps))) + (cdm--insert-arrow-tex (concat pre-str minus from-node (car dirs)) + (concat pre-str minus to-node (cdr dirs)) + "a" (when labelled (cdr swaps))))))) + +(defmacro let*-unless-null (list &rest body) + (if list + (let* ((curr (pop list)) + (dest (car curr)) + (expr (cadr curr))) + `(let ((,dest ,expr)) + (when ,dest (let*-unless-null ,list ,@body)))) + `(progn ,@body))) + +(defun cdm-insert-arrow (extra-props) + (interactive "P") + (when (cdm--get-nodes) + (unless cdm--node-list + (error "Cannot insert an arrow, no nodes found.")) + (end-of-line) + ;; TODO: recast i.t.o let*-unless-null + (let ((type (cdm--complete-arr-type))) + (when type + (let* ((par (string-equal "p" type)) + (extra (when (and (not par) 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: ")))) + (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)) + (t (cdm--insert-arrow-tex from-node to-node type label-props extra)))))))) + + +(defun cdm-square-reset () + (interactive) + (setq cdm--square-progress 0 + cdm--square-nodes nil) + (message "Square progress reset.")) + +;; TODO: Orientation? This is broken with swaps if you change orientation... +(defun cdm--prompt-insert-arrow-square (node-1 node-2 swap) + (when (cdm--get-nodes) + (let (r d) + (dolist (n cdm--node-list) + (when (or (string-equal node-1 (cdr n)) + (string-equal node-2 (cdr n))) + (add-to-list 'r n))) + (setq cdm--node-list r) + (setq d (cdm--complete-nodes "Domain for arrow: ")) + (if (string-equal d node-1) + (cdm--insert-arrow-tex d node-2 "a" swap) + (cdm--insert-arrow-tex d node-1 "a" swap))))) + +(defun cdm-insert-square () + (interactive) + (let ((p cdm--square-progress) + (n cdm--square-nodes) + (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 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)) + ((= p 0) (cdm-insert-node s))) + ;; Adjust state + (if (= p 7) (cdm-square-reset) + (setq cdm--square-progress (1+ cdm--square-progress)) + (when (and (<= p 3) (>= p 0)) + (add-to-list 'cdm--square-nodes s t))))) + +(defun cdm--init-helm () + (setq cdm--pos-helm-source (helm-build-sync-source "position" + :candidates 'cdm--pos-list + :fuzzy-match t + :nomark t) + cdm--arr-type-helm-source (helm-build-sync-source "arrow-type" + :candidates 'cdm-arr-type-list + :fuzzy-match t + :nomark t) + cdm--node-helm-source (helm-build-sync-source "nodes" + :candidates 'cdm--node-list + :fuzzy-match t + :nomark t + :multiline t) + cdm--parr-dir-helm-source (helm-build-sync-source "parr-dir" + :candidates 'cdm-parr-dir-list + :fuzzy-match t + :nomark t))) + +(defun cdm--init () + (require 'subr-x) + (require 'cl) + (if cdm--use-helm (cdm--init-helm)) ) + +(define-minor-mode cdm-mode + "Minor mode to help with commutative diagrams" + :lighter " CDM" :keymap cdm-mode-map + (cdm--init)) + +(provide 'cdm-mode) -- cgit v1.2.3