* implemented `yas/points-to-markers' and friend, look OK.

* mirrors only update when something actually changes

* cant reproduce strange undo/redo bug that I think I saw

* escapes apparently working OK

* expressions in fields working OK, but now tested extensively

TODO: Implement the per-snippet exit hook just like the "condition"
      Handle indent the best possible way
      Merge changes from trunk
This commit is contained in:
capitaomorte 2009-07-09 16:12:48 +00:00
parent dec6fcda41
commit 39aab51b28

View File

@ -227,10 +227,14 @@ to expand.
"${\\([0-9]+:\\)?\\([^}]*\\)}" "${\\([0-9]+:\\)?\\([^}]*\\)}"
"A regexp to *almost* recognize a field") "A regexp to *almost* recognize a field")
(defconst yas/expression-regexp (defconst yas/dollar-lisp-expression-regexp
"$\\(([^)]*)\\)" "$\\(([^)]*)\\)"
"A regexp to *almost* recognize a \"$(...)\" expression") "A regexp to *almost* recognize a \"$(...)\" expression")
(defconst yas/backquote-lisp-expression-regexp
"`\\([^`]*\\)`"
"A regexp to recognize a \"`(...)`\" expression")
(defconst yas/transform-mirror-regexp (defconst yas/transform-mirror-regexp
"${\\(?:\\([0-9]+\\):\\)?$\\([^}]*\\)" "${\\(?:\\([0-9]+\\):\\)?$\\([^}]*\\)"
"A regexp to *almost* recognize a mirror with a transform") "A regexp to *almost* recognize a mirror with a transform")
@ -944,7 +948,7 @@ Also create some protection overlays"
(yas/make-move-field-protection-overlays snippet field) (yas/make-move-field-protection-overlays snippet field)
(overlay-put yas/active-field-overlay 'yas/field field) (overlay-put yas/active-field-overlay 'yas/field field)
(unless (yas/field-modified-p field) (unless (yas/field-modified-p field)
(if (yas/update-field field snippet) (if (yas/field-update-display field snippet)
(let ((inhibit-modification-hooks t)) (let ((inhibit-modification-hooks t))
(yas/update-mirrors snippet)) (yas/update-mirrors snippet))
(setf (yas/field-modified-p field) nil)))) (setf (yas/field-modified-p field) nil))))
@ -967,42 +971,48 @@ up the snippet does not delete it!"
;;; Apropos markers-to-points: This can be useful for performance reasons, so ;;; Apropos markers-to-points: This can be useful for performance reasons, so
;;; that an excessive number of live markers arent kept aroung in the ;;; that an excessive number of live markers arent kept aroung in the
;;; `buffer-undo-list'. However in `markers-to-points', the set-to-nil ;;; `buffer-undo-list'. In `markers-to-points', the set-to-nil
;;; markers can't simply be discarded and replaced with fresh ones in ;;; markers can't simply be discarded and replaced with fresh ones in
;;; `points-to-markers'. The original set-to-nil marker has to be ;;; `points-to-markers'. The original marker that was just set to nilhas to be
;;; reused. ;;; reused.
;;; ;;;
;;; (defun yas/markers-to-points (snippet) ;;; This shouldn't bring horrible problems with undo/redo, but it
;;; "Convert all markers in SNIPPET to simple integer buffer positions." ;;; would be one of the the first thing I'd remove if I was debugging that...
;;; (dolist (field (yas/snippet-fields snippet)) ;;;
;;; (let ((start (marker-position (yas/field-start field))) (defun yas/markers-to-points (snippet)
;;; (end (marker-position (yas/field-end field)))) "Convert all markers in SNIPPET to a cons (POINT . MARKER)
;;; (set-marker (yas/field-start field) nil) where POINT is the original position of the marker and MARKER is
;;; (set-marker (yas/field-end field) nil) the original marker object with the position set to nil."
;;; (setf (yas/field-start field) start) (dolist (field (yas/snippet-fields snippet))
;;; (setf (yas/field-end field) end)) (let ((start (marker-position (yas/field-start field)))
;;; (dolist (mirror (yas/field-mirrors field)) (end (marker-position (yas/field-end field))))
;;; (let ((start (marker-position (yas/mirror-start mirror))) (set-marker (yas/field-start field) nil)
;;; (end (marker-position (yas/mirror-end mirror)))) (set-marker (yas/field-end field) nil)
;;; (set-marker (yas/mirror-start mirror) nil) (setf (yas/field-start field) (cons start (yas/field-start field)))
;;; (set-marker (yas/mirror-end mirror) nil) (setf (yas/field-end field) (cons end (yas/field-end field))))
;;; (setf (yas/mirror-start mirror) start) (dolist (mirror (yas/field-mirrors field))
;;; (setf (yas/mirror-end mirror) end)))) (let ((start (marker-position (yas/mirror-start mirror)))
;;; (when (yas/snippet-exit snippet) (end (marker-position (yas/mirror-end mirror))))
;;; (let ((exit (marker-position (yas/snippet-exit snippet)))) (set-marker (yas/mirror-start mirror) nil)
;;; (set-marker (yas/snippet-exit snippet) nil) (set-marker (yas/mirror-end mirror) nil)
;;; (setf (yas/snippet-exit snippet) exit)))) (setf (yas/mirror-start mirror) (cons start (yas/mirror-start mirror)))
;; (setf (yas/mirror-end mirror) (cons end (yas/mirror-end mirror))))))
;;; (defun yas/points-to-markers (snippet) (when (yas/snippet-exit snippet)
;;; "Convert all simple integer buffer positions in SNIPPET to markers" (let ((exit (marker-position (yas/snippet-exit snippet))))
;;; (dolist (field (yas/snippet-fields snippet)) (set-marker (yas/snippet-exit snippet) nil)
;;; (setf (yas/field-start field) (set-marker (make-marker) (yas/field-start field))) (setf (yas/snippet-exit snippet) (cons exit (yas/snippet-exit snippet))))))
;;; (setf (yas/field-end field) (set-marker (make-marker) (yas/field-end field)))
;;; (dolist (mirror (yas/field-mirrors field)) (defun yas/points-to-markers (snippet)
;;; (setf (yas/mirror-start mirror) (set-marker (make-marker) (yas/mirror-start mirror))) "Convert all cons (POINT . MARKER) in SNIPPET to markers. This
;;; (setf (yas/mirror-end mirror) (set-marker (make-marker) (yas/mirror-end mirror))))) is done by setting MARKER to POINT with `set-marker'."
;;; (when (yas/snippet-exit snippet) (dolist (field (yas/snippet-fields snippet))
;;; (setf (yas/snippet-exit snippet) (set-marker (make-marker) (yas/snippet-exit snippet))))) (setf (yas/field-start field) (set-marker (cdr (yas/field-start field)) (car (yas/field-start field))))
(setf (yas/field-end field) (set-marker (cdr (yas/field-end field)) (car (yas/field-end field))))
(dolist (mirror (yas/field-mirrors field))
(setf (yas/mirror-start mirror) (set-marker (cdr (yas/mirror-start mirror)) (car (yas/mirror-start mirror))))
(setf (yas/mirror-end mirror) (set-marker (cdr (yas/mirror-end mirror)) (car (yas/mirror-end mirror))))))
(when (yas/snippet-exit snippet)
(setf (yas/snippet-exit snippet) (set-marker (cdr (yas/snippet-exit snippet)) (car (yas/snippet-exit snippet))))))
(defun yas/commit-snippet (snippet &optional no-hooks) (defun yas/commit-snippet (snippet &optional no-hooks)
"Commit SNIPPET, but leave point as it is. This renders the "Commit SNIPPET, but leave point as it is. This renders the
@ -1037,9 +1047,12 @@ exiting the snippet."
(when previous-field (when previous-field
(yas/advance-field-and-parents-maybe previous-field yas/snippet-end))) (yas/advance-field-and-parents-maybe previous-field yas/snippet-end)))
;; Convert all markers to points,
;;
(yas/markers-to-points snippet)
;; Push an action for snippet revival ;; Push an action for snippet revival
;; ;;
;; (if yas/allow-buggy-redo (yas/points-to-markers snippet))
(push `(apply yas/snippet-revive ,yas/snippet-beg ,yas/snippet-end ,snippet) (push `(apply yas/snippet-revive ,yas/snippet-beg ,yas/snippet-end ,snippet)
buffer-undo-list) buffer-undo-list)
@ -1182,7 +1195,7 @@ progress."
(let ((field (overlay-get yas/active-field-overlay 'yas/field))) (let ((field (overlay-get yas/active-field-overlay 'yas/field)))
(cond (after? (cond (after?
(yas/advance-field-and-parents-maybe field (overlay-end overlay)) (yas/advance-field-and-parents-maybe field (overlay-end overlay))
(yas/update-field field (car (yas/snippets-at-point))) (yas/field-update-display field (car (yas/snippets-at-point)))
(yas/update-mirrors (car (yas/snippets-at-point)))) (yas/update-mirrors (car (yas/snippets-at-point))))
(field (field
(when (and (not after?) (when (and (not after?)
@ -1193,17 +1206,21 @@ progress."
(yas/clear-field field)) (yas/clear-field field))
(setf (yas/field-modified-p field) t)))))) (setf (yas/field-modified-p field) t))))))
(defun yas/update-field (field snippet) (defun yas/field-update-display (field snippet)
"Much like `yas/mirror-update-display', but for fields"
(when (yas/field-transform field) (when (yas/field-transform field)
(let ((inhibit-modification-hooks t) (let ((inhibit-modification-hooks t)
(transformed (yas/apply-transform field field 'nil-on-empty)) (transformed (yas/apply-transform field field 'nil-on-empty))
(point (point))) (point (point)))
(when transformed (when (and transformed
(yas/clear-field field) (not (string= transformed (buffer-substring-no-properties (yas/field-start field) (yas/field-end field)))))
(goto-char (yas/field-start field))
(insert transformed) (insert transformed)
(yas/advance-field-and-parents-maybe field (point)) (if (> (yas/field-end field) (point))
(when (yas/field-contains-point-p field point) (delete-region (point) (yas/field-end field))
(goto-char point)))))) (set-marker (yas/field-end field) (point)))
t))))
;;; ;;;
;;; Apropos protection overlays:... ;;; Apropos protection overlays:...
;;; ;;;
@ -1350,11 +1367,14 @@ to their correct locations *at the time the snippet is revived*.
After revival, push the `yas/take-care-of-redo' in the After revival, push the `yas/take-care-of-redo' in the
`buffer-undo-list'" `buffer-undo-list'"
;; Reconvert all the points to markers
;;
(yas/points-to-markers snippet)
(setf (yas/snippet-control-overlay snippet) (yas/make-control-overlay beg end)) (setf (yas/snippet-control-overlay snippet) (yas/make-control-overlay beg end))
(overlay-put (yas/snippet-control-overlay snippet) 'yas/snippet snippet) (overlay-put (yas/snippet-control-overlay snippet) 'yas/snippet snippet)
(yas/move-to-field snippet (or (yas/snippet-active-field snippet) (yas/move-to-field snippet (or (yas/snippet-active-field snippet)
(car (yas/snippet-fields snippet)))) (car (yas/snippet-fields snippet))))
;; (if yas/allow-buggy-redo (yas/points-to-markers snippet))
(push `(apply yas/take-care-of-redo ,beg ,end ,snippet) (push `(apply yas/take-care-of-redo ,beg ,end ,snippet)
buffer-undo-list)) buffer-undo-list))
@ -1402,6 +1422,10 @@ Meant to be called in a narrowed buffer, does various passes"
;; protect escapes ;; protect escapes
;; ;;
(yas/protect-escapes) (yas/protect-escapes)
;; replace all backquoted expressions
;;
(goto-char parse-start)
(yas/replace-backquotes)
;; parse fields ;; parse fields
;; ;;
(goto-char parse-start) (goto-char parse-start)
@ -1418,19 +1442,40 @@ Meant to be called in a narrowed buffer, does various passes"
;; ;;
(yas/restore-escapes))) (yas/restore-escapes)))
(defun yas/escape-string (escaped)
(concat "YASESCAPE" (format "%d" escaped) "PROTECTGUARD"))
(defun yas/protect-escapes () (defun yas/protect-escapes ()
"Protect all escaped characters with their numeric ASCII value.") "Protect all escaped characters with their numeric ASCII value."
(mapc #'(lambda (escaped)
(yas/replace-all (concat "\\" (char-to-string escaped))
(yas/escape-string escaped)))
'(?\\ ?` ?$ ?} )))
(defun yas/restore-escapes () (defun yas/restore-escapes ()
"Restore all escaped characters from their numeric ASCII value.") "Restore all escaped characters from their numeric ASCII value."
(mapc #'(lambda (escaped)
(yas/replace-all (concat "YASESCAPE" (format "%d" escaped) "PROTECTGUARD")
(char-to-string escaped)))
'(?\\ ?` ?$ ?} )))
(defun yas/replace-backquotes ()
"Replace all the \"`(lisp-expression)`\"-style expression
with their evaluated value"
(while (re-search-forward yas/backquote-lisp-expression-regexp nil t)
(let ((transformed (yas/eval-string (match-string 1))))
(goto-char (match-end 0))
(insert transformed)
(delete-region (match-beginning 0) (match-end 0)))))
(defun yas/field-parse-create (snippet &optional parent-field) (defun yas/field-parse-create (snippet &optional parent-field)
"Parse the \"${n: }\" or \"$(lisp-expression)\" expressions, in "Parse the \"${n: }\" or \"$(lisp-expression)\" expressions, in
two separate passes. two separate passes.
For \"$(lisp-expression)\" expressions \"lisp-expression\" is set to: For \"$(lisp-expression)\" expressions \"lisp-expression\" is:
* The snippets exit-hook if PARENT-FIELD is nil; * Replaced in-place with its value;
* PARENT-FIELD's transform, otherwise. * set PARENT-FIELD's transform, otherwise.
When multiple such expressions are found, only the last one counts." When multiple such expressions are found, only the last one counts."
(save-excursion (save-excursion
@ -1456,13 +1501,16 @@ When multiple such expressions are found, only the last one counts."
(goto-char (point-min)) (goto-char (point-min))
(yas/field-parse-create snippet brand-new-field))))))) (yas/field-parse-create snippet brand-new-field)))))))
(save-excursion (save-excursion
(while (re-search-forward yas/expression-regexp nil t) (while (re-search-forward yas/dollar-lisp-expression-regexp nil t)
(let* ((real-match-end-0 (scan-sexps (1+ (match-beginning 0)) 1))) (let* ((real-match-end-0 (scan-sexps (1+ (match-beginning 0)) 1)))
(when real-match-end-0 (when real-match-end-0
(let ((lisp-expression-string (buffer-substring-no-properties (match-beginning 1) real-match-end-0)))
(if parent-field (if parent-field
(setf (yas/field-transform parent-field) (buffer-substring-no-properties (match-beginning 1) real-match-end-0)) (setf (yas/field-transform parent-field) lisp-expression-string)
(setf (yas/snippet-exit-hook snippet) (buffer-substring-no-properties (match-beginning 1) real-match-end-0))) (let ((transformed (yas/eval-string lisp-expression-string)))
(delete-region (match-beginning 0) real-match-end-0)))))) (goto-char real-match-end-0)
(insert transformed)))
(delete-region (match-beginning 0) real-match-end-0)))))))
(defun yas/transform-mirror-parse-create (snippet) (defun yas/transform-mirror-parse-create (snippet)
"Parse the \"${n:(lisp-expression)}\" mirror transformations." "Parse the \"${n:(lisp-expression)}\" mirror transformations."
@ -1511,11 +1559,13 @@ When multiple such expressions are found, only the last one counts."
(defun yas/mirror-update-display (mirror field) (defun yas/mirror-update-display (mirror field)
"Update MIRROR according to FIELD (and mirror transform)." "Update MIRROR according to FIELD (and mirror transform)."
(goto-char (yas/mirror-start mirror)) (let ((transformed (yas/apply-transform mirror field)))
(delete-region (yas/mirror-start mirror) (yas/mirror-end mirror)) (when (not (string= transformed (buffer-substring-no-properties (yas/mirror-start mirror) (yas/mirror-end mirror))))
(insert (yas/apply-transform mirror field)) (goto-char (yas/mirror-start mirror))
(set-marker (yas/mirror-end mirror) (point))) (insert transformed)
(if (> (yas/mirror-end mirror) (point))
(delete-region (point) (yas/mirror-end mirror))
(set-marker (yas/mirror-end mirror) (point))))))
;; Debug functions. Use (or change) at will whenever needed. ;; Debug functions. Use (or change) at will whenever needed.
;; ;;
@ -1562,6 +1612,7 @@ When multiple such expressions are found, only the last one counts."
(yas/load-directory "~/Source/yasnippet/snippets/") (yas/load-directory "~/Source/yasnippet/snippets/")
;;(kill-buffer (get-buffer "*YAS TEST*")) ;;(kill-buffer (get-buffer "*YAS TEST*"))
(set-buffer (switch-to-buffer "*YAS TEST*")) (set-buffer (switch-to-buffer "*YAS TEST*"))
(mapcar #'yas/commit-snippet (yas/snippets-at-point 'all-snippets))
(erase-buffer) (erase-buffer)
(setq buffer-undo-list nil) (setq buffer-undo-list nil)
(html-mode) (html-mode)