summaryrefslogtreecommitdiff
path: root/emacs/scripts/cdm-mode.el
diff options
context:
space:
mode:
authortslil clingman <>2020-03-04 11:16:44 -0800
committertslil clingman <>2020-03-04 11:16:44 -0800
commit6e0beb56dd2fdfccba3094185ca52628091b1208 (patch)
treea9e897696b1f046a2ccf53969c1735ca172034e1 /emacs/scripts/cdm-mode.el
parenta8b572173842b2a1f31bc4109de59ff471a84256 (diff)
Bugs
Diffstat (limited to 'emacs/scripts/cdm-mode.el')
-rw-r--r--emacs/scripts/cdm-mode.el36
1 files changed, 19 insertions, 17 deletions
diff --git a/emacs/scripts/cdm-mode.el b/emacs/scripts/cdm-mode.el
index 2e67d4d..86638dd 100644
--- a/emacs/scripts/cdm-mode.el
+++ b/emacs/scripts/cdm-mode.el
@@ -1,4 +1,4 @@
-;; Time-stamp: <2020-03-04 10:28:56 (tslil@bison)>
+;; Time-stamp: <2020-03-04 11:09:04 (tslil@bison)>
(defvar cdm-arr-type-list '(("arrow" . "a")
("id" . "d")
@@ -26,8 +26,6 @@
"midway" "below right" "below left"
"above right" "above left" "none"))
-(defvar cdm-completion-backend 'default)
-
(defvar cdm-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c a") 'cdm-insert-arrow)
@@ -71,7 +69,7 @@
(n2 (cdm--is-natural (cdr s2))))
(if (and n1 n2) (> n1 n2)
(string-lessp (cdr s1) (cdr s2)))))
-n
+
(defun cdm--strip-label-f (str)
(let ((strs (split-string str "$+")))
(if (and (= 3 (length strs))
@@ -109,13 +107,17 @@ n
(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 (prompt list)
- (cond
- ((eq cdm-completion-backend 'ivy) (cdm--ivy-complete prompt list))
- (t (completing-read prompt list))))
+ (let* ((completion-table (lambda (string pred action)
+ (if (eq action 'metadata)
+ '(metadata (display-sort-function . identity)
+ (cycle-sort-function . identity))
+ (complete-with-action action list string pred)))))
+ (completing-read prompt list)))
+
+(defun cdm--complete-alist (prompt list)
+ (let ((result (cdm--complete prompt list)))
+ (when result (cdr (assoc-string result list)))))
(defun cdm--complete-position ()
(let ((p (cdm--complete "Select relative position: " cdm--pos-list)))
@@ -155,10 +157,10 @@ n
(let* ((name (or node-name
(read-string "New node name: " (cdm--next-name))))
(position (cdm--complete-position))
- (rel-to (when position (cdm--complete position cdm--node-list)))
+ (rel-to (when position (cdm--complete-alist position cdm--node-list)))
(midway-other (when (and position
(string-prefix-p "midway" position))
- (cdm--complete "midway, ending=" cdm--node-list))))
+ (cdm--complete-alist "midway, ending=" cdm--node-list))))
(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))))
@@ -209,7 +211,7 @@ n
(when label-props (search-backward "$}")))
(defun cdm--insert-parallel-arrows (from-node to-node &optional labelled)
- (let* ((ty (cdm--complete "Select parallel arrow directionality: " cdm-parr-dir-list)))
+ (let* ((ty (cdm--complete-alist "Select parallel arrow directionality: " cdm-parr-dir-list)))
(when ty
(let ((dirs (case ty
(0 '(".east" . ".west" ))
@@ -243,14 +245,14 @@ n
(error "Cannot insert an arrow, no nodes found."))
(end-of-line)
;; TODO: recast i.t.o let*-unless-null
- (let ((type (cdm--complete "Select arrow type: " cdm-arr-type-list)))
+ (let ((type (cdm--complete-alist "Select arrow type: " cdm-arr-type-list)))
(when type
(let* ((par (string-equal "p" type))
(cell (string-prefix-p "c" type))
(extra (when (and (not par) (not cell) extra-props)
(read-string "Extra properties: ")))
- (from-node (cdm--complete "From: " cdm--node-list))
- (to-node (cdm--complete "To: " cdm--node-list))
+ (from-node (cdm--complete-alist "From: " cdm--node-list))
+ (to-node (cdm--complete-alist "To: " cdm--node-list))
(labelled (unless (string-suffix-p "d" type)
(char-equal ?\C-m (read-char "Labelled (Return = yes)?"))))
(label-props (when (and (not par) labelled)
@@ -278,7 +280,7 @@ n
(string-equal node-2 (cdr n)))
(add-to-list 'r n)))
(setq cdm--node-list r)
- (setq d (cdm--complete "Domain for arrow: " cdm--node-list))
+ (setq d (cdm--complete-alist "Domain for arrow: " cdm--node-list))
(if (string-equal d node-1)
(cdm--insert-arrow-tex d node-2 "a" swap)
(cdm--insert-arrow-tex d node-1 "a" swap)))))