ld/yasnippet
1
0
Fork 0
mirror of https://github.com/joaotavora/yasnippet.git synced 2025-10-14 05:23:04 +00:00
Code Issues Packages Projects Releases Wiki Activity

snippet revival working relatively OK, but need to work on undoing an expansion

Browse Source
This commit is contained in:
capitaomorte 2009-07-03 15:04:49 +00:00
parent 3f9b630d95
commit 0932310893
1 changed files with 150 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

267
yasnippet.el
View File

@ -294,6 +294,8 @@ set to t."
(defvar yas/active-field-overlay nil (defvar yas/active-field-overlay nil
"Overlays the currently active field") "Overlays the currently active field")
(make-variable-buffer-local 'yas/active-field-overlay)
(defstruct (yas/snippet (:constructor yas/make-snippet ())) (defstruct (yas/snippet (:constructor yas/make-snippet ()))
"A snippet. "A snippet.
@ -301,8 +303,7 @@ set to t."
(fields '()) (fields '())
(exit nil) (exit nil)
(id (yas/snippet-next-id) :read-only t) (id (yas/snippet-next-id) :read-only t)
(control-overlay nil) (control-overlay nil))
(active-field nil))
(defstruct (yas/field (:constructor yas/make-field (number overlay-pair parent-field))) (defstruct (yas/field (:constructor yas/make-field (number overlay-pair parent-field)))
"A field." "A field."
@ -313,7 +314,7 @@ set to t."
(next nil) (next nil)
(prev nil) (prev nil)
(transform nil) (transform nil)
(modified nil)) (modified-p nil))
(defstruct (yas/mirror (:constructor yas/make-mirror (overlay transform))) (defstruct (yas/mirror (:constructor yas/make-mirror (overlay transform)))
"A mirror." "A mirror."
@ -502,11 +503,18 @@ the template of a snippet in the current snippet-table."
start start
end))) end)))
(defun yas/hidden-overlays-in (beg end)
"A sorted list of hidden yas overlays overlapping the region
between BEG and END"
(sort (remove-if-not #'(lambda (ov)
(overlay-get ov 'yas/hidden))
(overlays-in beg end))
#'(lambda (ov1 ov2)
(> (overlay-start ov2) (overlay-start ov1)))))
(defun yas/field-text-for-display (field) (defun yas/field-text-for-display (field)
"Return the propertized display text for field FIELD. " "Return the propertized display text for field FIELD. "
(let ((hidden-overlays (remove-if-not #'(lambda (ov) (let ((hidden-overlays (yas/hidden-overlays-in (yas/field-start field) (yas/field-end field)))
(overlay-get ov 'yas/hidden))
(overlays-in (yas/field-start field) (yas/field-end field))))
(text)) (text))
(when hidden-overlays (when hidden-overlays
(reduce #'(lambda (ov1 ov2) (reduce #'(lambda (ov1 ov2)
@ -514,9 +522,7 @@ the template of a snippet in the current snippet-table."
(buffer-substring (overlay-end ov1) (overlay-start ov2)) (buffer-substring (overlay-end ov1) (overlay-start ov2))
(overlay-get ov1 'after-string))) (overlay-get ov1 'after-string)))
ov2) ov2)
(sort hidden-overlays hidden-overlays))
#'(lambda (ov1 ov2)
(> (overlay-start ov2) (overlay-start ov1))))))
text)) text))
(defun yas/current-field-text (field) (defun yas/current-field-text (field)
@ -532,25 +538,39 @@ the template of a snippet in the current snippet-table."
nil nil
t))) t)))
(overlay-put overlay 'keymap yas/keymap) (overlay-put overlay 'keymap yas/keymap)
(overlay-put overlay 'yas/snippet-reference snippet) (overlay-put overlay 'yas/snippet snippet)
overlay)) overlay))
(defun yas/on-field-overlay-modification (overlay after? beg end &optional length) (defun yas/on-field-overlay-modification (overlay after? beg end &optional length)
"To be written" "To be written"
(when (and after? (unless undo-in-progress
yas/registered-snippets) (cond ((and after?
(maphash #'(lambda (key snippet) yas/registered-snippets)
(yas/update-mirrors snippet)) (maphash #'(lambda (key snippet)
yas/registered-snippets))) (yas/update-mirrors snippet))
yas/registered-snippets))
((not after?)
(let ((field (overlay-get overlay 'yas/field)))
(unless (yas/field-modified-p field)
(let ((inhibit-modification-hooks t))
(reduce #'(lambda (ov1 ov2)
(delete-region (overlay-end ov1) (overlay-start ov2))
ov2)
(yas/hidden-overlays-in (yas/field-start field) (yas/field-end field))))
(setf (yas/field-modified-p field) t))))
(t
nil))))
(add-to-list 'debug-ignored-errors "^Exit the snippet first$") (add-to-list 'debug-ignored-errors "^Exit the snippet first$")
(defun yas/on-hidden-overlay-modification (overlay after? beg end &optional length) (defun yas/on-hidden-overlay-modification (overlay after? beg end &optional length)
(unless (or after? (unless undo-in-progress
(null (overlay-buffer overlay))) (unless (or after?
;; (save-excursion (null (overlay-buffer overlay)))
;; (yas/exit-snippet (overlay-get overlay 'yas/snippet))) ;; (save-excursion
;; (call-interactively this-command) ;; (yas/exit-snippet (overlay-get overlay 'yas/snippet)))
(error "Exit the snippet first"))) ;; (call-interactively this-command)
(goto-char beg)
(error "Exit the snippet first"))))
(defun yas/overlay-insert-in-front-hook (overlay after? beg end &optional length) (defun yas/overlay-insert-in-front-hook (overlay after? beg end &optional length)
"To be written" "To be written"
@ -572,7 +592,6 @@ will be deleted before inserting template."
(save-restriction (save-restriction
(narrow-to-region start start) (narrow-to-region start start)
;; (setq buffer-undo-list t) ;; disable undo for a short while
(insert template) (insert template)
;; Step XX: do necessary indent ;; Step XX: do necessary indent
@ -644,19 +663,19 @@ will be deleted before inserting template."
;; Create keymap overlay for snippet ;; Create keymap overlay for snippet
(setf (yas/snippet-control-overlay snippet) (yas/make-control-overlay (point-min) (point-max))) (setf (yas/snippet-control-overlay snippet) (yas/make-control-overlay (point-min) (point-max)))
;; Step XX: move to end and make sure exit-marker exist
;; Move to end
(goto-char (point-max)) (goto-char (point-max))
(unless (yas/snippet-exit snippet)
(setf (yas/snippet-exit snippet) (copy-marker (point) t))) ;; Place the cursor at a proper place
;; Step XX: place the cursor at a proper place
(let* ((first-field (car (yas/snippet-fields snippet))) (let* ((first-field (car (yas/snippet-fields snippet)))
overlay) overlay)
(cond (first-field (cond (first-field
;; Step XX: Move to the new field, setting up ;; Move to the new field, setting up properties of the
;; properties of the wandering active field overlay. ;; wandering active field overlay.
(yas/move-to-field snippet first-field)) (yas/move-to-field snippet first-field))
(t (t
;; no need to call exit-snippet, since no overlay created. ;; No fields, quite a simple snippet I suppose
(yas/exit-snippet snippet)))) (yas/exit-snippet snippet))))
(widen) (widen)
snippet)) snippet))
@ -683,9 +702,9 @@ Allows nested placeholder in the style of Textmate."
(not (zerop number)) (not (zerop number))
(yas/make-field number (yas/make-field number
(cons (make-overlay (match-beginning 0) (cons (make-overlay (match-beginning 0)
(match-beginning 2)) (match-beginning 2) nil t nil)
(make-overlay (1- real-match-end-0) (make-overlay (1- real-match-end-0)
real-match-end-0)) real-match-end-0 nil t nil))
parent-field)))) parent-field))))
(when brand-new-field (when brand-new-field
(push brand-new-field (yas/snippet-fields snippet)) (push brand-new-field (yas/snippet-fields snippet))
@ -704,7 +723,7 @@ Allows nested placeholder in the style of Textmate."
(yas/snippet-find-field snippet number)))) (yas/snippet-find-field snippet number))))
(when (and real-match-end-0 field) (when (and real-match-end-0 field)
(push (yas/make-mirror (make-overlay (match-beginning 0) (push (yas/make-mirror (make-overlay (match-beginning 0)
real-match-end-0) real-match-end-0 nil t nil)
(buffer-substring-no-properties (match-beginning 2) (buffer-substring-no-properties (match-beginning 2)
(1- real-match-end-0))) (1- real-match-end-0)))
(yas/field-mirrors field)))))) (yas/field-mirrors field))))))
@ -714,11 +733,11 @@ Allows nested placeholder in the style of Textmate."
(let ((number (string-to-number (match-string-no-properties 1)))) (let ((number (string-to-number (match-string-no-properties 1))))
(if (zerop number) (if (zerop number)
(setf (yas/snippet-exit snippet) (setf (yas/snippet-exit snippet)
(make-overlay (match-beginning 0) (match-end 0))) (make-overlay (match-beginning 0) (match-end 0) nil t nil))
(let ((field (yas/snippet-find-field snippet number))) (let ((field (yas/snippet-find-field snippet number)))
(when field (when field
(let ((ov (make-overlay (match-beginning 0) (let ((ov (make-overlay (match-beginning 0)
(match-end 0)))) (match-end 0) nil t nil)))
(overlay-put ov 'yas/mirrorp t) (overlay-put ov 'yas/mirrorp t)
(push (yas/make-mirror ov nil) (push (yas/make-mirror ov nil)
(yas/field-mirrors field))))))))) (yas/field-mirrors field)))))))))
@ -1109,15 +1128,22 @@ when the condition evaluated to non-nil."
(and (zerop (- (yas/field-start field) (yas/field-end field))) (and (zerop (- (yas/field-start field) (yas/field-end field)))
(yas/field-parent-field field))) (yas/field-parent-field field)))
(defun yas/snippet-of-current-keymap ()
(first (remove nil (mapcar #'(lambda (ov)
(overlay-get ov 'yas/snippet))
(overlays-at (point))))))
(defun yas/next-field (&optional arg) (defun yas/next-field (&optional arg)
"Navigate to next field. If there's none, exit the snippet." "Navigate to next field. If there's none, exit the snippet."
(interactive) (interactive)
(let* ((arg (or arg (let* ((arg (or arg
1)) 1))
(snippet (yas/snippet-of-current-keymap)) (snippet (yas/snippet-of-current-keymap))
(active-field (overlay-get yas/active-field-overlay 'yas/field))
(number (and snippet (number (and snippet
(+ arg (+ arg
(yas/field-number (yas/snippet-active-field snippet))))) (yas/field-number active-field))))
(live-fields (remove-if #'yas/field-probably-deleted-p (yas/snippet-fields snippet))) (live-fields (remove-if #'yas/field-probably-deleted-p (yas/snippet-fields snippet)))
(target-field (yas/snippet-find-field snippet number))) (target-field (yas/snippet-find-field snippet number)))
(cond ((and number (cond ((and number
@ -1131,7 +1157,6 @@ when the condition evaluated to non-nil."
(defun yas/move-to-field (snippet field) (defun yas/move-to-field (snippet field)
"Update SNIPPET to move to field FIELD." "Update SNIPPET to move to field FIELD."
(goto-char (overlay-end (car (yas/field-overlay-pair field)))) (goto-char (overlay-end (car (yas/field-overlay-pair field))))
(setf (yas/snippet-active-field snippet) field)
(if (and yas/active-field-overlay (if (and yas/active-field-overlay
(overlay-buffer yas/active-field-overlay)) (overlay-buffer yas/active-field-overlay))
(move-overlay yas/active-field-overlay (move-overlay yas/active-field-overlay
@ -1140,7 +1165,8 @@ when the condition evaluated to non-nil."
;; create a new overlay ;; create a new overlay
(setq yas/active-field-overlay (setq yas/active-field-overlay
(make-overlay (overlay-end (car (yas/field-overlay-pair field))) (make-overlay (overlay-end (car (yas/field-overlay-pair field)))
(overlay-start (cdr (yas/field-overlay-pair field))))) (overlay-start (cdr (yas/field-overlay-pair field)))
nil nil t))
(overlay-put yas/active-field-overlay 'face 'yas/field-highlight-face) (overlay-put yas/active-field-overlay 'face 'yas/field-highlight-face)
(overlay-put yas/active-field-overlay 'modification-hooks '(yas/on-field-overlay-modification)) (overlay-put yas/active-field-overlay 'modification-hooks '(yas/on-field-overlay-modification))
(overlay-put yas/active-field-overlay 'insert-in-front-hooks '(yas/on-field-overlay-modification)) (overlay-put yas/active-field-overlay 'insert-in-front-hooks '(yas/on-field-overlay-modification))
@ -1156,12 +1182,7 @@ when the condition evaluated to non-nil."
"Goto exit-marker of SNIPPET and commit the snippet. Cleaning "Goto exit-marker of SNIPPET and commit the snippet. Cleaning
up the snippet does not delete it!" up the snippet does not delete it!"
(interactive) (interactive)
(let ((exit-marker (set-marker (make-marker) (if (markerp (yas/snippet-exit snippet)) (goto-char (yas/commit-snippet snippet)))
(yas/snippet-exit snippet)
(overlay-start (yas/snippet-exit snippet))))))
(yas/commit-snippet snippet)
(goto-char exit-marker)
(set-marker exit-marker nil)))
;; Snippet register and unregister routines. ;; Snippet register and unregister routines.
;; ;;
@ -1185,8 +1206,8 @@ exists in the current buffer. Return snippet"
;; ;;
;; setup the `pre-command-hook' and `post-command-hook' ;; setup the `pre-command-hook' and `post-command-hook'
;; ;;
(add-hook 'pre-command-hook 'yas/pre-command-handler) (add-hook 'pre-command-hook 'yas/pre-command-handler 'local)
(add-hook 'post-command-hook 'yas/post-command-handler) (add-hook 'post-command-hook 'yas/post-command-handler 'local)
snippet) snippet)
(defun yas/unregister-snippet (snippet) (defun yas/unregister-snippet (snippet)
@ -1202,8 +1223,8 @@ more snippets registered in the current buffer."
;; ;;
(when (eq 0 (when (eq 0
(hash-table-count yas/registered-snippets)) (hash-table-count yas/registered-snippets))
(remove-hook 'pre-command-hook 'yas/pre-command-handler) (remove-hook 'pre-command-hook 'yas/pre-command-handler 'local)
(remove-hook 'post-command-hook 'yas/post-command-handler))) (remove-hook 'post-command-hook 'yas/post-command-handler 'local)))
(defun yas/exterminate-snippets () (defun yas/exterminate-snippets ()
@ -1218,21 +1239,26 @@ more snippets registered in the current buffer."
(defun yas/commit-snippet (snippet) (defun yas/commit-snippet (snippet)
"Commit SNIPPET, but leave point as it is. This renders the "Commit SNIPPET, but leave point as it is. This renders the
snippet as ordinary text" snippet as ordinary text.
(let* ((control-overlay (yas/snippet-control-overlay snippet))
Return a buffer position where the point should be placed if
exiting the snippet."
(let ((control-overlay (yas/snippet-control-overlay snippet))
yas/snippet-beg yas/snippet-beg
yas/snippet-end) yas/snippet-end
exit (point))
;; ;;
;; Save the end of the moribund snippet in case we need to undo ;; Save the end of the moribund snippet in case we need to revive it
;; its original expansion. This is used by `yas/undo-expand-snippet' ;; its original expansion.
;; ;;
(when (and control-overlay (when (and control-overlay
(overlay-buffer control-overlay)) (overlay-buffer control-overlay))
(setq yas/snippet-beg (overlay-start control-overlay)) (setq yas/snippet-beg (overlay-start control-overlay))
(setq yas/snippet-end (overlay-end control-overlay)) (setq yas/snippet-end (overlay-end control-overlay))
(delete-overlay control-overlay)) (delete-overlay control-overlay)
(narrow-to-region yas/snippet-beg yas/snippet-end))
;; TODO: Maybe action for snippet revival ;; Push an action for snippet revival
;; ;;
(push `(apply yas/snippet-create ,yas/snippet-beg ,yas/snippet-end) (push `(apply yas/snippet-create ,yas/snippet-beg ,yas/snippet-end)
buffer-undo-list) buffer-undo-list)
@ -1260,10 +1286,12 @@ snippet as ordinary text"
(yas/delete-overlay-region ov))))) (yas/delete-overlay-region ov)))))
;; Take care of the exit marker ;; Take care of the exit marker
;; ;;
(if (and (overlayp (yas/snippet-exit snippet)) (cond ((and (yas/snippet-exit snippet)
(overlay-buffer (yas/snippet-exit snippet))) (overlay-buffer (yas/snippet-exit snippet)))
(yas/delete-overlay-region (yas/snippet-exit snippet)) (setq exit (overlay-start (yas/snippet-exit snippet)))
(set-marker (yas/snippet-exit snippet) nil))) (yas/delete-overlay-region (yas/snippet-exit snippet)))
(t
(setq exit (point-max)))))
;; XXX: `yas/after-exit-snippet-hook' should be run with ;; XXX: `yas/after-exit-snippet-hook' should be run with
;; `yas/snippet-beg' and `yas/snippet-end' bound. That might not ;; `yas/snippet-beg' and `yas/snippet-end' bound. That might not
@ -1271,9 +1299,10 @@ snippet as ordinary text"
;; disappeared, which sometimes happens when the snippet's messed ;; disappeared, which sometimes happens when the snippet's messed
;; up... ;; up...
;; ;;
(run-hooks 'yas/after-exit-snippet-hook)) (run-hooks 'yas/after-exit-snippet-hook)
(yas/unregister-snippet snippet)) (yas/unregister-snippet snippet)
(widen)
exit))
(defun yas/check-commit-snippet () (defun yas/check-commit-snippet ()
"Checks if point exited the currently active field of the "Checks if point exited the currently active field of the
@ -1281,27 +1310,28 @@ snippet, if so cleans up the whole snippet up.
This function is part of `post-command-hook' while This function is part of `post-command-hook' while
registered snippets last." registered snippets last."
(let* ((snippet (yas/snippet-of-current-keymap)) (unless undo-in-progress
(field (and snippet (let* ((snippet (yas/snippet-of-current-keymap))
(yas/snippet-active-field snippet)))) (field (and yas/active-field-overlay
(cond (;; (overlay-buffer yas/active-field-overlay)
;; No snippet at point, cleanup *all* snippets (overlay-get yas/active-field-overlay 'yas/field))))
;; (cond ((null snippet)
(null snippet) ;;
;; (yas/cleanup-all-snippets) ;; No snippet at point, cleanup *all* snippets
) ;;
(;; A snippet exits at point, but point left the currently (yas/exterminate-snippets))
;; active field overlay ((or (not field)
(or (not field) (and field
(and field (not (yas/point-in-field-p field))))
(not (yas/point-in-field-p (yas/field-primary-field field))))) ;; A snippet exitss at point, but point left the currently
(yas/cleanup-snippet snippet)) ;; active field overlay
(;; (save-excursion (yas/commit-snippet snippet)))
;; Snippet at point, and point inside a snippet field, ( ;;
;; everything is normal ;; Snippet at point, and point inside a snippet field,
;; ;; everything is normal
t ;;
nil)))) t
nil)))))
(defun yas/point-in-field-p (field &optional point) (defun yas/point-in-field-p (field &optional point)
"..." "..."
@ -1313,12 +1343,15 @@ registered snippets last."
;; ;;
;; Pre and post command handlers ;; Pre and post command handlers
;; ;;
(defun yas/pre-command-handler () (defun yas/pre-command-handler ()
) )
(defun yas/post-command-handler () (defun yas/post-command-handler ()
) ;; (when (eq this-command 'yas/next-field)
;; (when (null (car buffer-undo-list))
;; (setq buffer-undo-list (cdr buffer-undo-list))))
;; (yas/check-commit-snippet)
)
;; Debug functions. Use (or change) at will whenever needed. ;; Debug functions. Use (or change) at will whenever needed.
@ -1328,39 +1361,39 @@ registered snippets last."
(with-output-to-temp-buffer "*YASnippet trace*" (with-output-to-temp-buffer "*YASnippet trace*"
(princ "Interesting YASnippet vars: \n\n") (princ "Interesting YASnippet vars: \n\n")
(princ (format "Register hash-table: %s\n\n" yas/registered-snippets)) (princ (format "Register hash-table: %s\n\n" yas/registered-snippets))
(cond ((not yas/registered-snippets) ;; (cond ((not yas/registered-snippets)
(princ " No snippet hash table!")) ;; (princ " No snippet hash table!"))
((eq (hash-table-count yas/registered-snippets) 0) ;; ((eq (hash-table-count yas/registered-snippets) 0)
(princ " No registered snippets\n")) ;; (princ " No registered snippets\n"))
(t ;; (t
(maphash #'(lambda (key snippet) ;; (maphash #'(lambda (key snippet)
(princ (format "\t key %s for snippet %s\n" ;; (princ (format "\t key %s for snippet %s\n"
key ;; key
(yas/snippet-id snippet))) ;; (yas/snippet-id snippet)))
(princ (format "\t Control overlay %s\n" ;; (princ (format "\t Control overlay %s\n"
(yas/snippet-control-overlay snippet))) ;; (yas/snippet-control-overlay snippet)))
(dolist (field (yas/snippet-fields snippet)) ;; (dolist (field (yas/snippet-fields snippet))
(princ (format "\t field %s with %s mirrors is %s and %s" ;; (princ (format "\t field %s with %s mirrors is %s and %s"
(yas/field-number field) ;; (yas/field-number field)
(length (yas/field-mirrors field)) ;; (length (yas/field-mirrors field))
(if (yas/field-probably-deleted-p field) ;; (if (yas/field-probably-deleted-p field)
"DELETED" ;; "DELETED"
"alive") ;; "alive")
(if (eq field (yas/snippet-active-field snippet)) ;; (if (eq field (overlay-get yas/active-field-overlay 'yas/field))
"ACTIVE!\n" ;; "ACTIVE!\n"
"NOT ACTIVE!\n"))) ;; "NOT ACTIVE!\n")))
(princ (format "\t\t Covering: %s\n" (yas/current-field-text field))) ;; (princ (format "\t\t Covering: %s\n" (yas/current-field-text field)))
(princ (format "\t\t Displays: %s\n" (yas/field-text-for-display field))) ;; ;; (princ (format "\t\t Displays: %s\n" (yas/field-text-for-display field)))
;; (dolist (mirror (yas/field-mirrors field)) ;; ;; (dolist (mirror (yas/field-mirrors field))
;; (princ (format "\t\t Mirror displays: \n" ;; ;; (princ (format "\t\t Mirror displays: \n"
;; (if (eq field (yas/field-primary-field field)) ;; ;; (if (eq field (yas/field-primary-field field))
;; "Primary" "Mirror")))) ;; ;; "Primary" "Mirror"))))
)) ;; ))
yas/registered-snippets))) ;; yas/registered-snippets)))
(princ (format "\nPost command hook: %s\n" post-command-hook)) (princ (format "\nPost command hook: %s\n" post-command-hook))
(princ (format "\nPre command hook: %s\n" pre-command-hook)) (princ (format "\nPre command hook: %s\n" pre-command-hook))
@ -1384,7 +1417,7 @@ registered snippets last."
(when (string-match "yas/" (symbol-name atom)) (when (string-match "yas/" (symbol-name atom))
(unintern atom))))) (unintern atom)))))
(defun yas/debug-test (&optional verbose) (defun yas/debug-test (&optional quiet)
(interactive "P") (interactive "P")
(yas/load-directory "~/Source/yasnippet/snippets/") (yas/load-directory "~/Source/yasnippet/snippets/")
;;(kill-buffer (get-buffer "*YAS TEST*")) ;;(kill-buffer (get-buffer "*YAS TEST*"))
@ -1394,11 +1427,11 @@ registered snippets last."
(setq buffer-undo-list nil) (setq buffer-undo-list nil)
(let ((abbrev)) (let ((abbrev))
(if (require 'ido nil t) (if (require 'ido nil t)
(setq abbrev (ido-completing-read "Snippet abbrev: " '("crazy" "prop"))) (setq abbrev (ido-completing-read "Snippet abbrev: " '("crazy" "prip" "prop")))
(setq abbrev "crazy")) (setq abbrev "prop"))
(insert abbrev)) (insert abbrev))
(objc-mode) (objc-mode)
(when verbose (unless quiet
(add-hook (make-local-variable 'post-command-hook) 'yas/debug-some-vars)) (add-hook (make-local-variable 'post-command-hook) 'yas/debug-some-vars))
(yas/expand)) (yas/expand))