fix: better logic for wrapping selected text and writing mirror transforms

This commit is contained in:
Joao Tavora 2013-11-02 01:00:03 +00:00
parent f32e4fe2ea
commit 4ece494427
2 changed files with 49 additions and 26 deletions

View File

@ -47,24 +47,28 @@
" " " "
(&field 3 "field"))) (&field 3 "field")))
(&mirror 3 (concat ", nested mirroring: " (&mirror 3 (concat ", nested mirroring: "
field-text)))) field-string))))
(printf ("printf (\"" (printf ("printf (\""
(&field 1 "%s") (&field 1 "%s")
(&mirror 1 (if (string-match "%" field-text) "\"," "\")")) (&mirror 1 (if (string-match "%" field-string) "\"," "\")"))
(&field 2) (&field 2)
(&mirror 1 (if (string-match "%" field-text) "\)" "")))) (&mirror 1 (if (string-match "%" field-string) "\)" ""))))
(sprintf-maybe ((&mirror 0 (when field-text "s")) (sprintf-maybe ((&mirror 0 (unless field-empty "s"))
"printf (" "printf ("
(&field 0) (&field 0)
(&mirror 0 (when field-text ",")) (&mirror 0 (unless field-empty ","))
"\"" "\""
(&field 1 "%s") (&field 1 "%s")
(&mirror 1 (if (string-match "%" field-text) "\"," "\")")) (&mirror 1 (if (string-match "%" field-string) "\"," "\")"))
(&field 2) (&field 2)
(&mirror 1 (if (string-match "%" field-text) "\)" "")))) (&mirror 1 (if (string-match "%" field-string) "\)" ""))))
(emacs-version ((&field 1 emacs-version) (emacs-version ((&field 1 emacs-version)
" " (upcase (emacs-version)) " " " " (upcase (emacs-version)) " "
(&mirror 1))))) (&mirror 1)))
(wrap-selected-region ("foo"
selected-text
"baz"
(&field 1 selected-text)))))
(defun snippet--insert-test-snippet (name) (defun snippet--insert-test-snippet (name)
(funcall (make-snippet (cadr (assoc name snippet--test-snippets-alist))))) (funcall (make-snippet (cadr (assoc name snippet--test-snippets-alist)))))
@ -197,6 +201,20 @@
(upcase (emacs-version)) " " (upcase (emacs-version)) " "
"somestring"))))) "somestring")))))
(ert-deftest wrap-selected-region ()
;; this test needs some work. testing with `region-active-p' is hard
;; and also the "delete-selection" behaviour isn't decided yet
;;
:expected-result :failed
(with-temp-buffer
(ert-simulate-command '((lambda () (interactive) (insert "bar"))))
(set-mark (point))
(goto-char (point-max))
(snippet--insert-test-snippet 'wrap-selected-region)
(should (equal (buffer-string)
"foobarbazbar"))))
;;; input validation ;;; input validation
;;; ;;;

View File

@ -254,10 +254,8 @@ I would need these somewhere in the let* form
make-mirror-forms))) make-mirror-forms)))
(defun snippet--transform-lambda (transform-form) (defun snippet--transform-lambda (transform-form)
`(lambda (field-text) `(lambda (field-string field-empty)
(if (null field-text) ,transform-form))
""
,transform-form)))
(defun snippet--eval-lambda (eval-form) (defun snippet--eval-lambda (eval-form)
`(lambda (selected-text) `(lambda (selected-text)
@ -268,9 +266,14 @@ I would need these somewhere in the let* form
(let* ((tuples (snippet--form-tuples body)) (let* ((tuples (snippet--form-tuples body))
(marker-init-forms (snippet--marker-init-forms tuples)) (marker-init-forms (snippet--marker-init-forms tuples))
(init-object-forms (snippet--object-init-forms tuples)) (init-object-forms (snippet--object-init-forms tuples))
(first-field-sym (snippet--first-field-sym tuples))) (first-field-sym (snippet--first-field-sym tuples))
(region-text-sym (make-symbol "region-text")))
`(let* (,@(mapcar #'car init-object-forms) `(let* (,@(mapcar #'car init-object-forms)
,@marker-init-forms) ,@marker-init-forms
(,region-text-sym (and (region-active-p)
(buffer-substring-no-properties
(region-beginning)
(region-end)))))
,@(mapcar #'second init-object-forms) ,@(mapcar #'second init-object-forms)
@ -282,15 +285,15 @@ I would need these somewhere in the let* form
,(when (eq `&eval (car expr)) ,(when (eq `&eval (car expr))
`(snippet--with-current-object ,sym `(snippet--with-current-object ,sym
(insert (insert
(funcall ,(snippet--eval-lambda (cadr expr)) (or (funcall ,(snippet--eval-lambda (cadr expr))
(and (region-active-p) ,region-text-sym)
(buffer-substring-no-properties ""))))))
(region-beginning)
(region-end)))))))))
(`(&mirror . ,_) (`(&mirror . ,_)
`((snippet--insert-object ,sym))) `((snippet--insert-object ,sym)))
(t (t
`((insert (eval ,form)))))) `((insert (or (funcall ,(snippet--eval-lambda form)
,region-text-sym)
""))))))
,@(cl-loop ,@(cl-loop
for (sym form) in tuples for (sym form) in tuples
append (pcase form append (pcase form
@ -340,7 +343,7 @@ Each form in BODY can be:
* A cons (mirror FIELD-NAME MIRROR-TRANSFORM) defining a mirror * A cons (mirror FIELD-NAME MIRROR-TRANSFORM) defining a mirror
of the field named FIELD-NAME. Each time the text under the of the field named FIELD-NAME. Each time the text under the
field changes, the form MIRROR-TRANSFORM is invoked with the field changes, the form MIRROR-TRANSFORM is invoked with the
variable `field-text' set to the text under the field. The variable `field-string' set to the text under the field. The
string produced become the text under the mirror. string produced become the text under the mirror.
* A string literal which is inserted as a literal part of the * A string literal which is inserted as a literal part of the
@ -550,8 +553,11 @@ can be:
(snippet--object-end mirror)) (snippet--object-end mirror))
(save-excursion (save-excursion
(goto-char (snippet--object-start mirror)) (goto-char (snippet--object-start mirror))
(insert (funcall (snippet--mirror-transform mirror) (let ((field-string (snippet--field-string (snippet--mirror-source mirror))))
(snippet--field-text (snippet--mirror-source mirror))))))) (insert (or (funcall (snippet--mirror-transform mirror)
field-string
(string= "" field-string))
""))))))
(defun snippet--move-to-field (field) (defun snippet--move-to-field (field)
(goto-char (snippet--object-start field)) (goto-char (snippet--object-start field))
@ -601,11 +607,10 @@ can be:
(t (t
(snippet--open-object field))))) (snippet--open-object field)))))
(defun snippet--field-text (field) (defun snippet--field-string (field)
(let ((start (snippet--object-start field)) (let ((start (snippet--object-start field))
(end (snippet--object-end field))) (end (snippet--object-end field)))
(and (/= start end) (buffer-substring-no-properties start end)))
(buffer-substring-no-properties start end))))
(defvar snippet--debug nil) (defvar snippet--debug nil)
;; (setq snippet--debug t) ;; (setq snippet--debug t)