From 19839d3067c8bd779fc05eb0f355564b232329b3 Mon Sep 17 00:00:00 2001 From: tslil Date: Tue, 25 Aug 2026 15:25:32 +0100 Subject: [emacs] lexical binding i guess --- emacs/inits/01-basic.el | 7 +- emacs/inits/02-modeline.el | 4 +- emacs/inits/03-miscload.el | 4 +- emacs/inits/11-completion.el | 79 +++++++---- emacs/inits/13-ibuffer.el | 2 + emacs/inits/14-movement.el | 12 +- emacs/inits/15-project-mgmt.el | 6 +- emacs/inits/20-programming.el | 8 +- emacs/inits/21-functional.el | 2 + emacs/inits/22-lisp.el | 2 + emacs/inits/23-text-related.el | 14 +- emacs/inits/24-latex.el | 8 +- emacs/inits/25-theorems.el | 2 + emacs/inits/27-gemini.el | 2 + emacs/inits/50-file-assocs.el | 2 + emacs/inits/60-misc-configs.el | 2 + emacs/inits/70-global-keybinds.el | 6 +- emacs/inits/99-last.el | 2 + emacs/scripts/acquiesce.el | 2 + emacs/scripts/caps-lock-mode.el | 2 + emacs/scripts/cdm-mode.el | 286 +++++++++++++++++++------------------- 21 files changed, 265 insertions(+), 189 deletions(-) diff --git a/emacs/inits/01-basic.el b/emacs/inits/01-basic.el index e159495..d90138c 100644 --- a/emacs/inits/01-basic.el +++ b/emacs/inits/01-basic.el @@ -1,4 +1,6 @@ -;; Time-stamp: <2026-07-03 09h32 BST (anker)> +;;; -*- lexical-binding: t -*- + +;; Time-stamp: <2026-08-04 09h48 BST (a6b530d2)> ;; ----------------------------------------------------------------------------- ;; Interface @@ -85,7 +87,8 @@ (setq my-font "Monaspace Krypton-14") (setq my-font "Crimson Pro-20") (setq my-font "Readerly-18") - (setq my-font "Libron-16") + (setq my-font "Libron-18") + ;; (setq my-font "Kelmscott Mono-20") (set-frame-font my-font) (set-fontset-font t 'unicode diff --git a/emacs/inits/02-modeline.el b/emacs/inits/02-modeline.el index 142acbb..624100f 100644 --- a/emacs/inits/02-modeline.el +++ b/emacs/inits/02-modeline.el @@ -1,4 +1,6 @@ -;; Time-stamp: <2024-01-18 13h15 CET (3913c8e4)> +;;; -*- lexical-binding: t -*- + +;; Time-stamp: <2026-01-02 17h01 GMT (d63c23ed)> ;; ----------------------------------------------------------------------------- ;; Mode-line diff --git a/emacs/inits/03-miscload.el b/emacs/inits/03-miscload.el index 87c0b4f..038aa1f 100644 --- a/emacs/inits/03-miscload.el +++ b/emacs/inits/03-miscload.el @@ -1,4 +1,6 @@ -;; Time-stamp: <2026-05-22 09h04 PDT (7bca6747)> +;;; -*- lexical-binding: t -*- + +;; Time-stamp: <2026-05-22 09h02 PDT (7bca6747)> (use-package siege-mode :load-path "~/.config/emacs/scripts/siege-mode/") diff --git a/emacs/inits/11-completion.el b/emacs/inits/11-completion.el index c5fd883..654ee5c 100644 --- a/emacs/inits/11-completion.el +++ b/emacs/inits/11-completion.el @@ -1,4 +1,6 @@ -;; Time-stamp: <2026-04-05 20h56 BST (anker)> +;;; -*- lexical-binding: t -*- + +;; Time-stamp: <2026-08-25 15h27 BST (581d7bf5)> (use-package savehist :ensure t @@ -33,32 +35,59 @@ :init (defun my-completing-read-in-region (start end collection &optional predicate) - "Prompt for completion of region in the minibuffer if non-unique." + "Prompt for completion of region in the minibuffer." (barf-if-buffer-read-only) (let* ((initial (buffer-substring-no-properties start end)) - (metadata (completion-metadata initial collection predicate)) - (all (completion-all-completions initial collection predicate - (if (<= start (point) end) - (- (point) start) - (length initial))))) - (when-let ((last (last all))) - (setcdr last nil)) - (let ((completion (cond - ((null all) nil) - ((and (consp all) (null (cdr all))) (car all)) - (t (completing-read "Completion: " collection - predicate t initial))))) - (cond - (completion - (completion--replace start end completion) - (let ((exit-fn (completion-metadata-get metadata 'exit-function))) - (when exit-fn - (funcall exit-fn completion - (if (eq (try-completion completion collection predicate) t) - 'finished 'exact)))) - t) - (t (message "No completion") nil))))) - + (source-buffer (current-buffer)) + (wrapped-table + (if (functionp collection) + `(lambda (str pred action) + (let ((result (with-current-buffer ,source-buffer + (funcall ',collection str pred action)))) + (if (eq action 'metadata) + (cons 'metadata + (mapcar + (lambda (x) + (if (and (consp x) + (symbolp (car x)) + (string-suffix-p + "-function" (symbol-name (car x))) + (functionp (cdr x))) + (cons (car x) + `(lambda (&rest args) + (with-current-buffer ,',source-buffer + (apply ',(cdr x) args)))) + x)) + (cdr result))) + result))) + collection)) + (exit-fn (plist-get completion-extra-properties :exit-function)) + (ann-fun (plist-get completion-extra-properties :annotation-function)) + (aff-fun (plist-get completion-extra-properties :affixation-function)) + (completion-extra-properties + `(,@(and ann-fun + (list :annotation-function + `(lambda (&rest args) + (with-current-buffer ,source-buffer + (apply ',ann-fun args))))) + ,@(and aff-fun + (list :affixation-function + `(lambda (&rest args) + (with-current-buffer ,source-buffer + (apply ',aff-fun args))))))) + (minibuffer-allow-text-properties t) + (enable-recursive-minibuffers t) + (completion (completing-read "Completion: " wrapped-table + predicate t initial))) + (cond + ((and completion (not (string-empty-p completion))) + (completion--replace start end completion) + (when exit-fn + (funcall exit-fn completion + (if (eq (try-completion completion collection predicate) t) + 'finished 'exact))) + t) + (t ([message]I "No completion") nil)))) (defun my-icomplete-backspace () "Delete back to previous / in paths, or normal backspace otherwise." diff --git a/emacs/inits/13-ibuffer.el b/emacs/inits/13-ibuffer.el index b7139f8..6139eba 100644 --- a/emacs/inits/13-ibuffer.el +++ b/emacs/inits/13-ibuffer.el @@ -1,3 +1,5 @@ +;;; -*- lexical-binding: t -*- + ;; Time-stamp: <2026-07-31 11h44 BST (51019882)> (use-package ibuffer diff --git a/emacs/inits/14-movement.el b/emacs/inits/14-movement.el index 66da01f..4011c54 100644 --- a/emacs/inits/14-movement.el +++ b/emacs/inits/14-movement.el @@ -1,4 +1,6 @@ -;; Time-stamp: <2025-06-25 20h18 BST (anker)> +;;; -*- lexical-binding: t -*- + +;; Time-stamp: <2026-03-24 11h04 GMT (1fa9dc52)> ;; ------------------------------------------------------------------- ;; We have expand region at home @@ -102,10 +104,10 @@ (when hardcore-nav-mode (global-set-key (kbd "") nil) (global-set-key (kbd "") nil) - (global-set-key (kbd "") nil) - (global-set-key (kbd "") nil) - (global-set-key (kbd "") nil) - (global-set-key (kbd "") nil) + ;; (global-set-key (kbd "") nil) + ;; (global-set-key (kbd "") nil) + ;; (global-set-key (kbd "") nil) + ;; (global-set-key (kbd "") nil) (global-set-key (kbd "S-") nil) (global-set-key (kbd "S-") nil) (global-set-key (kbd "S-") nil) diff --git a/emacs/inits/15-project-mgmt.el b/emacs/inits/15-project-mgmt.el index f61d75d..ed83477 100644 --- a/emacs/inits/15-project-mgmt.el +++ b/emacs/inits/15-project-mgmt.el @@ -1,4 +1,6 @@ -;; Time-stamp: <2025-02-19 10h42 GMT (anker)> +;;; -*- lexical-binding: t -*- + +;; Time-stamp: <2026-01-02 16h59 GMT (d63c23ed)> (defun revert-all-file-buffers () "Refresh all open file buffers without confirmation" @@ -15,4 +17,4 @@ (require 'project) -(setq project-vc-extra-root-markers '("Cargo.toml")) +(setq project-vc-extra-root-markers '("Cargo.toml" "pyproject.toml")) diff --git a/emacs/inits/20-programming.el b/emacs/inits/20-programming.el index e8ae9b5..e7385ba 100644 --- a/emacs/inits/20-programming.el +++ b/emacs/inits/20-programming.el @@ -1,4 +1,6 @@ -;; Time-stamp: <2026-07-31 11h59 BST (51019882)> +;;; -*- lexical-binding: t -*- + +;; Time-stamp: <2026-08-15 16h16 BST (7b97f8ba)> ;; ----------------------------------------------------------------------------- ;; General setup @@ -68,9 +70,7 @@ (electric-pair-local-mode) (set-fill-column 80) (display-line-numbers-mode 1) - (when (not (eq major-mode 'text-mode)) - (hs-minor-mode)) - (setq auto-hscroll-mode t) + (visual-line-mode 1) (when (not (eq major-mode 'python-ts-mode)) (keymap-set (current-local-map) "M-/" 'completion-at-point)) ) diff --git a/emacs/inits/21-functional.el b/emacs/inits/21-functional.el index 714ccf0..2daa0e3 100644 --- a/emacs/inits/21-functional.el +++ b/emacs/inits/21-functional.el @@ -1,3 +1,5 @@ +;;; -*- lexical-binding: t -*- + ;; Time-stamp: <2026-01-02 11h48 GMT (d63c23ed)> ;; ----------------------------------------------------------------------------- diff --git a/emacs/inits/22-lisp.el b/emacs/inits/22-lisp.el index 9c5e6fb..a411768 100644 --- a/emacs/inits/22-lisp.el +++ b/emacs/inits/22-lisp.el @@ -1,3 +1,5 @@ +;;; -*- lexical-binding: t -*- + ;; Time-stamp: <2025-06-25 20h02 BST (anker)> ;; ---------------------------------------------------------------------------- diff --git a/emacs/inits/23-text-related.el b/emacs/inits/23-text-related.el index 59dcf62..0cfe2f1 100644 --- a/emacs/inits/23-text-related.el +++ b/emacs/inits/23-text-related.el @@ -1,6 +1,6 @@ -;; Time-stamp: <2026-06-22 10h33 BST (anker)> +;;; -*- lexical-binding: t -*- -(add-hook 'text-mode-hook (lambda () (setq line-spacing 6))) +;; Time-stamp: <2026-06-23 10h11 BST (4331e7a1)> ;; ----------------------------------------------------------------------------- ;; Spelling @@ -24,9 +24,11 @@ (setq sentence-end-double-space nil) (add-hook 'text-mode-hook (lambda () + (setq line-spacing 4) (subword-mode 1) (electric-pair-local-mode 1) - (turn-on-auto-fill) + ;; (turn-on-auto-fill) + (visual-line-mode 1) (siege-mode 1) (spell-fu-mode 1))) @@ -40,6 +42,12 @@ :defer :hook (markdown-mode . (lambda () (auto-fill-mode -1) + (setq-local electric-pair-text-pairs + (append '((?{ . ?}) + (?` . ?`) + (?$ . ?$)) + electric-pair-pairs)) + (electric-pair-local-mode 1) (visual-line-mode)))) ;; ----------------------------------------------------------------------------- diff --git a/emacs/inits/24-latex.el b/emacs/inits/24-latex.el index 8df11c1..9f7b33d 100644 --- a/emacs/inits/24-latex.el +++ b/emacs/inits/24-latex.el @@ -1,6 +1,8 @@ -;; Time-stamp: <2025-06-25 19h55 BST (anker)> +;;; -*- lexical-binding: t -*- -(defvar latex-template-dir (expand-file-name "~/typeset/latex-templates")) +;; Time-stamp: <2026-01-15 20h47 GMT (2c38aa2b)> + +(defvar latex-template-dir (expand-file-name "~/typeset/typeset/latex-templates")) (defun prompt-latex-file-template () "Check if tex file does not exist or the command was called interactively. If neither, prompt to insert from a template @@ -119,7 +121,7 @@ populated from the directory *latex-template-dir*" TeX-source-correlate-mode 'synctex TeX-view-program-selection '(((output-dvi style-pstricks) "dvips and gv") (output-dvi "xdvi") - (output-pdf "Zathura") + (output-pdf "Evince") (output-html "xdg-open"))) ;; for PDF tools diff --git a/emacs/inits/25-theorems.el b/emacs/inits/25-theorems.el index 51426b3..68aeef4 100644 --- a/emacs/inits/25-theorems.el +++ b/emacs/inits/25-theorems.el @@ -1,3 +1,5 @@ +;;; -*- lexical-binding: t -*- + ;; Time-stamp: <2024-07-13 15h02 CEST (471b3659)> ;; ----------------------------------------------------------------------------- diff --git a/emacs/inits/27-gemini.el b/emacs/inits/27-gemini.el index 19243d5..0312cb1 100644 --- a/emacs/inits/27-gemini.el +++ b/emacs/inits/27-gemini.el @@ -1,3 +1,5 @@ +;;; -*- lexical-binding: t -*- + ;; Time-stamp: <2025-08-23 13h42 BST (cf998867)> (use-package elpher diff --git a/emacs/inits/50-file-assocs.el b/emacs/inits/50-file-assocs.el index 0024f1a..fc79c1a 100644 --- a/emacs/inits/50-file-assocs.el +++ b/emacs/inits/50-file-assocs.el @@ -1,3 +1,5 @@ +;;; -*- lexical-binding: t -*- + ;; Time-stamp: <2019-09-11 11:29:16 (tslil@basingstoke)> (use-package gnuplot-mode diff --git a/emacs/inits/60-misc-configs.el b/emacs/inits/60-misc-configs.el index 1da810e..9f8a0f1 100644 --- a/emacs/inits/60-misc-configs.el +++ b/emacs/inits/60-misc-configs.el @@ -1,3 +1,5 @@ +;;; -*- lexical-binding: t -*- + ;; Time-stamp: <2022-11-16 07h55 CET (anker)> (use-package dired diff --git a/emacs/inits/70-global-keybinds.el b/emacs/inits/70-global-keybinds.el index de2b17b..6bff284 100644 --- a/emacs/inits/70-global-keybinds.el +++ b/emacs/inits/70-global-keybinds.el @@ -1,8 +1,10 @@ -;; Time-stamp: <2026-05-15 09h11 BST (anker)> +;;; -*- lexical-binding: t -*- + +;; Time-stamp: <2026-08-25 15h28 BST (581d7bf5)> (setq time-stamp-active t time-stamp-line-limit 3 - time-stamp-format "%Y-%02m-%02d %02Hh%02M %Z (%s)") + time-stamp-format "%Y-%02m-%02d %02Hh%02M %Z (%Q)") (add-hook 'before-save-hook #'time-stamp) diff --git a/emacs/inits/99-last.el b/emacs/inits/99-last.el index 9f62f15..b84c993 100644 --- a/emacs/inits/99-last.el +++ b/emacs/inits/99-last.el @@ -1,3 +1,5 @@ +;;; -*- lexical-binding: t -*- + ;; Time-stamp: <2024-03-18 09h51 CET (0c109a04)> (add-hook 'after-init-hook diff --git a/emacs/scripts/acquiesce.el b/emacs/scripts/acquiesce.el index addbd8d..9762be0 100644 --- a/emacs/scripts/acquiesce.el +++ b/emacs/scripts/acquiesce.el @@ -1,3 +1,5 @@ +;;; -*- lexical-binding: t -*- + (require 'cl-lib) (defmacro default (expr default) diff --git a/emacs/scripts/caps-lock-mode.el b/emacs/scripts/caps-lock-mode.el index c80883a..9e9052b 100644 --- a/emacs/scripts/caps-lock-mode.el +++ b/emacs/scripts/caps-lock-mode.el @@ -1,3 +1,5 @@ +;;; -*- lexical-binding: t -*- + (defvar caps-lock-mode-map (let ((map (make-sparse-keymap))) (define-key map [remap self-insert-command] 'upcased-self-insert) diff --git a/emacs/scripts/cdm-mode.el b/emacs/scripts/cdm-mode.el index d62c6a4..401d1e3 100644 --- a/emacs/scripts/cdm-mode.el +++ b/emacs/scripts/cdm-mode.el @@ -1,31 +1,35 @@ -;; Time-stamp: <2022-04-17 09h45 EDT (academic)> +;;; -*- lexical-binding: t -*- + +;; Time-stamp: <2026-08-10 21h19 BST (763f23aa)> + +(require 'cl) (defvar cdm-arr-type-list '(("arrow" . "a") - ("2-cell arrow" . "n") - ("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") - ("parallel" . "p") - ("monomorphism" . "m") - ("epimorphism" . "e"))) + ("2-cell arrow" . "n") + ("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") + ("parallel" . "p") + ("monomorphism" . "m") + ("epimorphism" . "e"))) (defvar cdm-parr-dir-list '(("left -> right" . 0) - ("right -> left" . 1) - ("up -> down" . 2) - ("down -> up" . 3))) + ("right -> left" . 1) + ("up -> down" . 2) + ("down -> up" . 3))) (defvar cdm-wrap-list '("diagram" "tikzpicture" "diagram*" "vdiagram" "vsubdiagram" "hsubdiagram")) (defvar cdm--pos-list '("below" "right" "left" "above" "at" - "midway" "below right" "below left" - "above right" "above left" "none")) + "midway" "below right" "below left" + "above right" "above left" "none")) (defvar cdm-scale-arrow "la") @@ -46,21 +50,21 @@ (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)))))) + (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))) + ((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) @@ -69,16 +73,16 @@ (defun cdm--sort-p (s1 s2) (let ((n1 (cdm--is-natural (cdr s1))) - (n2 (cdm--is-natural (cdr s2)))) + (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))) + (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) @@ -87,35 +91,35 @@ (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)))))) + (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)) + (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--complete (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))))) + (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) @@ -150,24 +154,24 @@ (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))) + (last-number (if last-name (string-to-number last-name) 0))) (unless (and (= 0 last-number) - last-name) - (number-to-string (+ 1 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 (when cdm--node-list (cdm--complete-position))) - (at (string-equal "at" position)) - (rel-to (when (and position (not at)) (cdm--complete-alist position cdm--node-list))) - (extra (when at (concat "at (" (read-string "at: ") ")"))) - (midway-other (when (and position - (string-prefix-p "midway" position)) - (cdm--complete-alist "midway, ending=" cdm--node-list)))) + (read-string "New node name: " (cdm--next-name)))) + (position (when cdm--node-list (cdm--complete-position))) + (at (string-equal "at" position)) + (rel-to (when (and position (not at)) (cdm--complete-alist position cdm--node-list))) + (extra (when at (concat "at (" (read-string "at: ") ")"))) + (midway-other (when (and position + (string-prefix-p "midway" position)) + (cdm--complete-alist "midway, ending=" cdm--node-list)))) (if midway-other - (cdm--insert-raw-path name rel-to midway-other ",la" "$$" 7) + (cdm--insert-raw-path name rel-to midway-other ",la" "$$" 7) (cdm--insert-raw-node name (if rel-to (concat position rel-to) "") "$$" 3 extra)))) (defun cdm--string-good-p (str) @@ -180,67 +184,67 @@ (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 "]") ""))) + (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 ")}" - "{};")) + 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) (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 ");") + (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-parallel-arrows (from-node to-node &optional labelled) (let* ((ty (cdm--complete-alist "Select parallel arrow directionality: " 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))))))) + (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)))) + (dest (car curr)) + (expr (cadr curr))) + `(let ((,dest ,expr)) + (when ,dest (let*-unless-null ,list ,@body)))) `(progn ,@body))) (defun cdm--concat-arrow-scale (string) @@ -255,50 +259,50 @@ ;; TODO: recast i.t.o let*-unless-null (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-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) - (cdm--concat-arrow-scale (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)) - (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)))))))) + (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-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) + (cdm--concat-arrow-scale (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)) + (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 - cdm--square-nodes nil) + cdm--square-nodes nil) (message "Square progress reset.")) ;; TODO: Orientation? This is broken with swaps if one changes orientation... (defun cdm--prompt-insert-arrow-square (node-1 node-2 swap) (when (cdm--get-nodes) (let (r d - (swap (cdm--concat-arrow-scale swap))) + (swap (cdm--concat-arrow-scale swap))) (dolist (n cdm--node-list) - (when (or (string-equal node-1 (cdr n)) - (string-equal node-2 (cdr n))) - (add-to-list 'r n))) + (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-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))))) + (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))) + (n cdm--square-nodes) + (s (cdm--next-name))) ;; Insert stuff (cond ((= p 7) (cdm--prompt-insert-arrow-square (nth 3 n) (nth 1 n) "")) @@ -313,7 +317,7 @@ (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))))) + (add-to-list 'cdm--square-nodes s t))))) (defun cdm--init () (require 'subr-x) -- cgit v1.2.3