Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Snippet parser for new engine #441

Open
wants to merge 3 commits into
base: snippet-engine
Choose a base branch
from
Open

Snippet parser for new engine #441

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
6366684
Replace funcs from 'cl with their 'cl-lib counterparts
immerrr Dec 6, 2013
38ef956
Add alpha version of snippet parser
immerrr Dec 6, 2013
0b89bc0
Implement parsing nested fields, add couple more tests
immerrr Dec 6, 2013
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
70 changes: 70 additions & 0 deletions snippet-tests.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -312,3 +312,73 @@
(should-error (snippet--canonicalize-form '(&mirror 1 (foo) (bar))))
(should-error (snippet--canonicalize-form '(&field 1 (foo) (bar))))
(should-error (snippet--canonicalize-form '(&eval (foo) (bar)))))


;;; Snippet parser tests.
;;;

(ert-deftest parse-string-literals ()
(should (equal (snippet--parse-snippet "") '("")))
(should (equal (snippet--parse-snippet "foobar") '("foobar"))))

(ert-deftest parse-escape-sequences ()
(should (equal (snippet--parse-snippet "foobar\\$123") '("foobar$123")))
(should (equal (snippet--parse-snippet "foobar\\\\") '("foobar\\")))
(should (equal (snippet--parse-snippet "foobar\\\\\\\\") '("foobar\\\\")))
(should (equal (snippet--parse-snippet "\\$") '("$")))
(should (equal (snippet--parse-snippet "\\a") '("a"))))

(ert-deftest parse-invalid-escape-sequences ()
:expected-result :failed
(should-error (snippet--parse-snippet "\\"))
(should-error (snippet--parse-snippet "foobar \\"))
(should-error (snippet--parse-snippet "foobar \\\\\\")))

(ert-deftest parse-eval-blocks ()
(should (equal (snippet--parse-snippet "foo`(upcase region-string)`bar")
'("foo" (upcase region-string) "bar")))
(should (equal (snippet--parse-snippet "`(upcase region-string)`")
'((upcase region-string))))
(should (equal (snippet--parse-snippet "`(apply concat \\`(,region-string \"foobar\"))`")
'((apply concat `(,region-string "foobar"))))))


(ert-deftest parse-tabstops ()
(should (equal (snippet--parse-snippet "foo$1")
'("foo" (&field "1" nil))))

(should (equal (snippet--parse-snippet "foo$123")
'("foo" (&field "123" nil))))

(should (equal (snippet--parse-snippet "foo$1 $2 $1")
'("foo" (&field "1" nil) " " (&field "2" nil) " "
(&mirror "1" nil)))))

(ert-deftest parse-exits ()
(should (equal (snippet--parse-snippet "$0") '((&exit nil))))
(should (equal (snippet--parse-snippet "${0:foobar}") '((&exit "foobar"))))
(should (equal (snippet--parse-snippet "${0:`(upcase \"foobar\")`}")
'((&exit (upcase "foobar"))))))

(ert-deftest parse-primary-field ()
:expected-result :failed
(should (equal (snippet--parse-snippet "$1 ${1:foobar} $1")
'((&mirror "1" nil) " " (&field "1" "foobar") " "
(&mirror "1" nil))))

(should (equal (snippet--parse-snippet "${1:$(upcase region-string)} $1")
'((&mirror "1" (&transform (upcase region-string))) " "
(&field "1" nil))))

(should (equal (snippet--parse-snippet "${1:$(upcase region-string)} $1 ${1:foobar}")
'((&mirror "1" (&transform (upcase region-string))) " "
(&mirror "1" nil) " " (&field "1" "foobar")))))

(ert-deftest parse-field-contents ()
(should (equal (snippet--parse-snippet "${1:foo`(upcase region-string)`bar}")
'((&field "1" (&eval (concat ("foo"
(upcase region-string)
"bar")))))))

(should (equal (snippet--parse-snippet "${1:foo$2bar}")
'((&field "1" (&nested "foo" (&field "2" nil) "bar"))))))
197 changes: 193 additions & 4 deletions snippet.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -167,7 +167,7 @@ Argument BODY is a list of forms as described in `define-snippet'."
(let ((unfolded (snippet--unfold-forms
(mapcar #'snippet--canonicalize-form body)))
all-objects exit-object)
`(let* (,@(loop for form in unfolded
`(let* (,@(cl-loop for form in unfolded
append (pcase form
(`(&field ,name ,_expr (&parent ,parent))
`((,(snippet--make-field-sym name)
Expand All @@ -177,7 +177,7 @@ Argument BODY is a list of forms as described in `define-snippet'."
(buffer-substring-no-properties
(region-beginning)
(region-end)))))
(let* (,@(loop
(let* (,@(cl-loop
for form in unfolded
with mirror-idx = 0
with sym
Expand Down Expand Up @@ -301,6 +301,195 @@ pairs. Its meaning is not decided yet"
Argument FORMS is a list of forms as described in `define-snippet'."
`(lambda () ,(snippet--define-body forms)))


;;; Parsing snippets
;;;


(defun snippet--char-escaped-p ()
"Return non-nil if point is preceded by backslash which is not
itself escaped"
(unless (or (bobp) (eobp))
(save-excursion
(/= 0 (% (skip-chars-backward "\\\\") 2)))))


(defun snippet--parse-unescape-substring (start-pos end-pos)
(replace-regexp-in-string
"\\\\\\(.\\)" "\\1"
(buffer-substring-no-properties start-pos end-pos)))


(defun snippet--parse-text-block (stop-chars)
(let ((start-pos (point)))
(while (and (/= 0 (skip-chars-forward (concat "^" stop-chars)))
(snippet--char-escaped-p))
(goto-char (1+ (point))))
(snippet--parse-unescape-substring start-pos (point))))


(defun snippet--parse-constant ()
"Parse `expr` construct.

`expr` contents are evaluated at the moment of expansion and
remain constant afterwards (unlike transformation fields), hence
the name."
(when (eq (char-after) ?`)
(let ((start-pos (point))
(contents (progn (forward-char)
(snippet--parse-text-block "`"))))

(when (eobp)
(error "Runaway constant starting at position %s" start-pos))

(forward-char)
(read contents))))


(defun snippet--parse-tabstop ()
(when (re-search-forward "\\=\\$\\([0-9]+\\)" nil t)
(list '&field (match-string-no-properties 1) nil)))


;; (declare-function snippet--parse-next-primitive "snippet.el")


(defun snippet--parse-make-field-expr (raw-subexprs)
(cl-loop for sub in raw-subexprs
with has-subfields = nil
with transform = nil

if (memq (car-safe sub) '(&field &mirror))
do (setq has-subfields t)

if (eq (car-safe sub) '&transform)
do (setq transform sub)
else collect sub into subexprs

finally return
(cond
(transform
(when subexprs
(error (concat "Parsing field with both subexprs and transformation is not implemented")))
transform)

(has-subfields
(cons '&nested subexprs))

((> (length subexprs) 1)
`(&eval (concat ,subexprs)))

(t (car-safe subexprs)))))


(defun snippet--parse-field-or-mirror ()
(let ((start-pos (point))
field-type field-name field-exprs)
(when (re-search-forward "\\=\\${\\([0-9]+\\)?:" nil t)
(setq field-name (match-string-no-properties 1)
field-type '&field)
;; Field-or-mirror preamble parsed successfully. Let's parse the body.
(cond
;; If it's a mirror, the body is empty, just mark it as such.
((looking-at "\\$(")
(setq field-type '&mirror))
;; If it's a field with no default value, just skip one '$' character.
((looking-at "\\$\\$(")
(forward-char))
;; Otherwise parse all primitives inside field definition
(t (while (and (not (looking-at "\\(}\\|\\$(\\)")))
(push (snippet--parse-next-primitive "}$`") field-exprs))))

;; Now let's try parsing field transformation.
(when (looking-at "\\$(")
(forward-char)
(push (cons '&transform (read (current-buffer))) field-exprs)

(unless (eq (char-after) ?})
(error "More text after transformation in %s at position %s"
(if (eq field-type '&mirror) "mirror" "field")
start-pos)))

(cond
;; Skip closing brace if it's there.
((eq (char-after) ?}) (forward-char))
;; If not, report runaway field-or-mirror.
((eobp) (error "Runaway %s at position %s"
(if (eq field-type '&mirror) "mirror" "field")
start-pos))
;; This should not happen, because field body parser only stops before
;; '}' or '$(', and '$(' triggers transformation parsing, which has its
;; own '}'-verification. Still, a sanity check won't hurt.
(t
(error "Close brace not found for %s at position %s, should not happen"
(if (eq field-type '&mirror) "mirror" "field")
start-pos)))

(list field-type field-name
(snippet--parse-make-field-expr (nreverse field-exprs))))))


(defun snippet--parse-snippet (str)
"Parse snippet definition STR to format supported by `define-snippet'.

The parsing is done in temporary buffer."
(let (result)
(if (string= str "")
(push "" result)

(with-temp-buffer
(setq buf (current-buffer))
(insert str)
(goto-char (point-min))

(while (not (eobp))
(push (snippet--parse-next-primitive "$`") result))))

(snippet--finalize-parsed (nreverse result))))


(defun snippet--parse-next-primitive (text-block-stop-chars)
(or (snippet--parse-tabstop)
(snippet--parse-field-or-mirror)
(snippet--parse-constant)
(snippet--parse-text-block text-block-stop-chars)
(when (and (eq (char-after) ?$)
(memq ?$ (string-to-list text-block-stop-chars)))
(forward-char)
"$")))


(defun snippet--finalize-parsed (parsed &optional field-table)
(when (null field-table)
(setq field-table (make-hash-table :test 'equal)))

(cl-loop for cur-elt in parsed
when (and (listp cur-elt)
(eq (car cur-elt) '&field))
do (push cur-elt (gethash (cadr cur-elt) field-table)))

(maphash
(lambda (field-name fields)
(setq fields (nreverse fields))

(cond
;; Fields with name == '0' are exits.
((string= field-name "0")
(cl-loop for f in fields
do (progn (setcar f '&exit)
(setcdr f (cddr f)))))
(t
(cl-loop for f in fields
with primary = nil

if primary do (setcar f '&mirror)
else do (setq primary f)))))
field-table)

parsed)




;;; Snippet mechanics
;;;
Expand Down Expand Up @@ -369,7 +558,7 @@ Argument FORMS is a list of forms as described in `define-snippet'."
:source source
:transform (snippet--make-transform-lambda transform))))
(snippet--inserting-object mirror prev
(pushnew mirror (snippet--field-mirrors source)))))
(cl-pushnew mirror (snippet--field-mirrors source)))))

(defun snippet--make-and-insert-exit (parent prev constant)
(let ((exit (snippet--make-exit :parent parent :prev prev)))
Expand Down Expand Up @@ -530,7 +719,7 @@ PREV means move to the previous field."
(target (if field
(cadr (cl-remove-if #'snippet--field-skip-p
(memq field sorted)))
(first sorted))))
(cl-first sorted))))
(if target
(snippet--move-to-field target)
(let ((exit (overlay-get snippet--field-overlay
Expand Down