diff --git a/lispy-test.el b/lispy-test.el index 8de14f0f..d686397e 100644 --- a/lispy-test.el +++ b/lispy-test.el @@ -95,6 +95,109 @@ (with-syntax-table table (split-string str "\\b" t))))) +(defun lispy-simulate-key (key) + "Simulate key press KEY. +This is used rather than `execute-kbd-macro' because apparently +that function somehow fails to run within `ert-deftest'." + (should (numberp key)) + (let ((cmd (keymap-lookup nil (key-description (vector key))))) + (setq last-command-event key) + (call-interactively cmd) + (setq last-command cmd))) + +(defun lispy-simulate-keys (keys) + "Simulate a sequence of KEYS. +See `lispy-simulate-key'." + (seq-do #'lispy-simulate-key keys)) + +(cl-defun lispy-simulate-expect + (keys &key buffer point (mode #'lisp-mode)) + "Simulate key sequence KEYS and check the result. +If KEYS is a sequence of sequence, simulate each element of KEYS +instead. + +MODE is the major mode in effect. + +BUFFER, if non-nil, is the buffer string to match after the keys +are simulated. + +POINT, if non-nil, is the point to match after the keys are +pressed." + (declare (indent 1)) + (if (seqp (seq-first keys)) + (seq-do (lambda (keys) + (lispy-simulate-expect keys + :buffer buffer + :point point + :mode mode)) + keys) + (with-temp-buffer + (funcall mode) + (lispy-mode) + (lispy-simulate-keys keys) + (when buffer + (should (thread-last (buffer-substring-no-properties + (point-min) (point-max)) + (string= buffer)))) + (let ((point (cl-case point + (max (point-max)) + (min (point-min)) + (t point)))) + (when point + (should (= (point) point))))))) + +(ert-deftest lispy-read-unsafe-chars () + "See #648." + ;; Expect: (de|) + ;; Recipe: ( d e + (lispy-simulate-expect '(?\( ?d ?e) + :buffer "(de)" + :point 4) + ;; Expect: (.)| + ;; Recipes: + ;; 1: ( . ) i + ;; 2. ( . SPC C-b C-t ) i + ;; 3. ( . SPC ) i + ;; 4. ( . SPC C-b C-t SPC ) i + (lispy-simulate-expect + '((?\( ?. ?\) ?i) ; format "(.)" + (?\( ?. ? ?\C-b ?\C-t ?\) ?i) ; format "( .)" + (?\( ?. ? ?\) ?i) ; format "(. )" + (?\( ?. ? ?\C-b ?\C-t ? ?\) ?i)) ; format "( . )" + :buffer "(.)" + :point 'max) + ;; Expect: (f .)| + ;; Recipes: + ;; 1. ( f SPC . ) i + ;; 2. ( f SPC . SPC ) i + (lispy-simulate-expect + '((?\( ?f ? ?. ?\) ?i) ; format "(f .)" + (?\( ?f ? ?. ? ?\) ?i)) ; format "(f . )" + :buffer "(f .)" + :point 'max) + ;; Expect: (. f)| + ;; Recipe: ( . SPC f ) i + (lispy-simulate-expect '(?\( ?. ? ?f ?\) ?i) + :buffer "(. f)" + :point 'max)) + +(ert-deftest lispy-read-quote-newline () + (lispy-simulate-expect "(progn 0'O" + :buffer "(progn '0)" + :point 'max) + (lispy-simulate-expect "(progn ignore#'O" + :buffer "(progn #'ignore)" + :point 'max) + (lispy-simulate-expect "(progn 0`O" + :buffer "(progn `0)" + :point 'max) + (lispy-simulate-expect "`(progn 0,O" + :buffer "`(progn ,0)" + :point 'max) + (lispy-simulate-expect "`(progn nil,@O" + :buffer "`(progn ,@nil)" + :point 'max)) + (ert-deftest lispy-decode-keysequence () (should (equal (lispy-decode-keysequence "23ab50c") '(23 "a" "b" 50 "c"))) @@ -2388,7 +2491,7 @@ Insert KEY if there's no command." (should (string= (lispy-with "|;;* Intro" "a") ";;* Intro\n;;* |"))) -(ert-deftest lispy-outline-add () +(ert-deftest lispy-outline-add-2 () ; FIXME: duplicate name (should (string= (lispy-with "(quote ~foo|)" "~") "(quote ~~foo|)")) (should (string= (lispy-with "(quote ~~foo|)" "~") @@ -2594,7 +2697,7 @@ Insert KEY if there's no command." (execute-kbd-macro (kbd "aa"))) "(progn (setq type 'norwegian-blue)\n (~setq| plumage-type 'lovely))")))) -(ert-deftest lispy-ace-subword () +(ert-deftest lispy-ace-subword-2 () ; FIXME: duplicate name (should (string= (lispy-with "|(progn (setq type 'norwegian-blue)\n (setq plumage-type 'lovely))" (execute-kbd-macro (kbd "-g"))) "(progn (setq type 'norwegian-blue)\n (setq |plumage~-type 'lovely))")) diff --git a/lispy.el b/lispy.el index 0c5c9720..67d8f311 100644 --- a/lispy.el +++ b/lispy.el @@ -7286,6 +7286,34 @@ See https://clojure.org/guides/weird_characters#_character_literal.") (match-string subexp))) t t nil subexp))))) +(defun lispy--delete-insignificant-sexps () + "Delete insignificant sexps. +That is, delete internal representations such as \\=(ly-raw +newline), which serves no purpose in the input sexp." + (rx-let ((sp0 (* space)) + (sp1 (+ space))) + (save-match-data + (while (looking-at (rx sp0 ?\( sp0 + "ly-raw" sp1 + "newline" sp0 ?\))) + (replace-match ""))))) + +(defun lispy--read-reader-syntax (rs tag) + "Handle reading a reader syntax RS. +The matched reader syntax has TAG as its internal tag." + (save-excursion + (goto-char (point-min)) + (save-match-data + (while (re-search-forward + (rx (or bol (not ?\\)) (group-n 1 (regexp rs))) + nil t) + (unless (lispy--in-string-or-comment-p) + (lispy--delete-insignificant-sexps) + (forward-sexp) + (insert ")") + (replace-match (format "(ly-raw %s " tag) + nil nil nil 1)))))) + ;; TODO: Make the read test pass on string with semi-colon (defun lispy--read (str) "Read STR including comments and newlines." @@ -7416,25 +7444,9 @@ See https://clojure.org/guides/weird_characters#_character_literal.") (replace-match (format "(ly-raw clojure-keyword %S)" (match-string-no-properties 1))))) ;; ——— #' ————————————————————— - (goto-char (point-min)) - (while (re-search-forward "#'" nil t) - (unless (lispy--in-string-or-comment-p) - (forward-sexp) - (insert ")") - (replace-match "(ly-raw function "))) + (lispy--read-reader-syntax "#'" "function") ;; ——— ,@ ————————————————————— - (goto-char (point-min)) - (while (re-search-forward "\\(?:[^\\]\\|^\\),@" nil t) - (unless (lispy--in-string-or-comment-p) - (backward-char 2) - (let ((beg (point)) - (sxp (ignore-errors (read (current-buffer))))) - (when (and (consp sxp) - (eq (car sxp) '\,@)) - (insert ")") - (goto-char beg) - (delete-char 2) - (insert "(ly-raw comma-splice "))))) + (lispy--read-reader-syntax ",@" "comma-splice") ;; ——— #_ ————————————————————— (goto-char (point-min)) (while (re-search-forward "#_[({[]" nil t) @@ -7457,53 +7469,23 @@ See https://clojure.org/guides/weird_characters#_character_literal.") (match-string 1))) nil nil nil 1))) ;; ——— ' —————————————————————— - (goto-char (point-min)) - (while (re-search-forward "'" nil t) - (unless (lispy--in-string-or-comment-p) - (backward-char 1) - (let ((beg (point)) - (sxp (ignore-errors (read (current-buffer))))) - (when (and (consp sxp) - (eq (car sxp) 'quote)) - (insert ")") - (goto-char beg) - (delete-char 1) - (insert "(ly-raw quote "))))) + (lispy--read-reader-syntax "'" "quote") ;; ——— ` —————————————————————— - (goto-char (point-min)) - (while (re-search-forward "\\(?:[^\\]\\|^\\)`" nil t) - (unless (lispy--in-string-or-comment-p) - (cond ((looking-at lispy-left) - (delete-char -1) - (insert "(ly-raw \\` ") - (forward-list 1) - (insert ")") - (backward-list 1) - (forward-char 7)) - ((looking-at "\\sw\\|\\s_\\|[,@]") - (let ((beg (point))) - (forward-sexp 1) - (insert "\")") - (goto-char (1- beg)) - (insert "(ly-raw quasiquote \"")))))) + (lispy--read-reader-syntax "`" "quasiquote") ;; ——— , —————————————————————— (lispy--replace-regexp-in-code "\\\\," "(ly-raw comma-symbol)") - (goto-char (point-min)) - (while (re-search-forward "[^\\]?,[^@\"]" nil t) - (unless (lispy--in-string-or-comment-p) - (backward-char 2) - (if (memq major-mode lispy-clojure-modes) - (progn - (delete-char 1) - (insert "(ly-raw clojure-comma)")) - (let ((beg (point)) - (sxp (ignore-errors (read (current-buffer))))) - (when (and (consp sxp) - (eq (car sxp) '\,)) - (insert ")") - (goto-char beg) - (delete-char 1) - (insert "(ly-raw \\, ")))))) + (if (memq major-mode lispy-clojure-modes) + ;; I don't know clojure, so I'll leave that + ;; execution path untouched + (progn + (goto-char (point-min)) + (while (re-search-forward "[^\\]?,[^@\"]" nil t) + (unless (lispy--in-string-or-comment-p) + (backward-char 2) + (progn + (delete-char 1) + (insert "(ly-raw clojure-comma)"))))) + (lispy--read-reader-syntax "," "comma")) ;; ——— angle syntax ————————— ;; used for markers/buffers/windows/overlays (goto-char (point-min)) @@ -8128,7 +8110,7 @@ The outer delimiters are stripped." (delete-char (- (skip-chars-backward " "))) (insert "\n")) - ((string comment symbol float quasiquote) + ((string comment symbol) (delete-region beg (point)) (insert (cl-caddr sxp))) (comma-symbol @@ -8249,7 +8231,7 @@ The outer delimiters are stripped." (reference (delete-region beg (point)) (insert (cl-caddr sxp))) - (\` + ((quasiquote \`) (if (> (length sxp) 3) (progn (goto-char beg) @@ -8260,7 +8242,7 @@ The outer delimiters are stripped." (insert "`") (prin1 (cl-caddr sxp) (current-buffer))) (goto-char beg)) - (\, + ((comma \,) (delete-region beg (point)) (insert ",") (prin1 (cl-caddr sxp) (current-buffer))