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

* Changed the approach yet again, this is it, this should work...

Browse Source
This commit is contained in:
capitaomorte 2009-07-05 20:20:59 +00:00
parent 97608378d3
commit 514243f5b9
1 changed files with 113 additions and 177 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

288
yasnippet.el
View File

@ -307,12 +307,13 @@ 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)
(defstruct (yas/field (:constructor yas/make-field (number overlay-pair parent-field))) (defstruct (yas/field (:constructor yas/make-field (number start end parent-field)))
"A field." "A field."
number number
overlay-pair start end
parent-field parent-field
(mirrors '()) (mirrors '())
(next nil) (next nil)
@ -320,17 +321,11 @@ set to t."
(transform nil) (transform nil)
(modified-p nil)) (modified-p nil))
(defstruct (yas/mirror (:constructor yas/make-mirror (overlay transform))) (defstruct (yas/mirror (:constructor yas/make-mirror (start end transform)))
"A mirror." "A mirror."
overlay start end
(transform nil)) (transform nil))
(defun yas/field-start (field) (overlay-start (car (yas/field-overlay-pair field))))
(defun yas/field-end (field) (overlay-end (cdr (yas/field-overlay-pair field))))
(defun yas/mirror-start (mirror) (overlay-start (yas/mirror-overlay mirror)))
(defun yas/mirror-end (mirror) (overlay-end (yas/mirror-overlay mirror)))
(defstruct (yas/snippet-table (:constructor yas/make-snippet-table ())) (defstruct (yas/snippet-table (:constructor yas/make-snippet-table ()))
"A table to store snippets for a perticular mode." "A table to store snippets for a perticular mode."
(hash (make-hash-table :test 'equal)) (hash (make-hash-table :test 'equal))
@ -507,31 +502,9 @@ 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 (yas/hidden-overlays-in (yas/field-start field) (yas/field-end field))) (buffer-substring (yas/field-start field) (yas/field-end field)))
(text))
(when hidden-overlays
(reduce #'(lambda (ov1 ov2)
(setq text (concat text
(buffer-substring (overlay-end ov1) (overlay-start ov2))
(overlay-get ov1 'after-string)))
ov2)
hidden-overlays))
text))
(defun yas/current-field-text (field)
(buffer-substring-no-properties (yas/field-start field)
(yas/field-end field)))
(defun yas/undo-in-progress () (defun yas/undo-in-progress ()
(or undo-in-progress (or undo-in-progress
@ -551,31 +524,21 @@ the template of a snippet in the current snippet-table."
(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"
(cond (after? (cond ((and after?
(not (yas/undo-in-progress)))
(mapcar #'yas/update-mirrors (yas/snippets-at-point))) (mapcar #'yas/update-mirrors (yas/snippets-at-point)))
((not (or after? (yas/undo-in-progress))) ;; ((not (or after? (yas/undo-in-progress)))
(let ((field (overlay-get overlay 'yas/field))) ;; (let ((field (overlay-get overlay 'yas/field)))
(unless (yas/field-modified-p field) ;; (unless (yas/field-modified-p field)
(let ((inhibit-modification-hooks t)) ;; (let ((inhibit-modification-hooks t))
(reduce #'(lambda (ov1 ov2) ;; (reduce #'(lambda (ov1 ov2)
(delete-region (overlay-end ov1) (overlay-start ov2)) ;; (delete-region (overlay-end ov1) (overlay-start ov2))
ov2) ;; ov2)
(yas/hidden-overlays-in (yas/field-start field) (yas/field-end field)))) ;; (yas/hidden-overlays-in (yas/field-start field) (yas/field-end field))))
(setf (yas/field-modified-p field) t)))) ;; (setf (yas/field-modified-p field) t))))
(t (t
nil))) nil)))
(add-to-list 'debug-ignored-errors "^Exit the snippet first$")
(defun yas/on-hidden-overlay-modification (overlay after? beg end &optional length)
(unless (yas/undo-in-progress)
(unless (or after?
(null (overlay-buffer overlay)))
;; (save-excursion
;; (yas/exit-snippet (overlay-get overlay 'yas/snippet)))
;; (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"
) )
@ -592,103 +555,70 @@ will be deleted before inserting template."
(let* ((key (buffer-substring-no-properties start end)) (let* ((key (buffer-substring-no-properties start end))
(length (- end start)) (length (- end start))
(column (current-column))) (column (current-column))
snippet)
(delete-char length)
(save-restriction (save-restriction
(narrow-to-region start start) (let ((buffer-undo-list t))
(narrow-to-region start start)
(insert template)
(setq snippet (yas/snippet-create (point-min) (point-max))))
(push (cons (point-min) (point-max)) buffer-undo-list)
;; Push an undo action
(push `(apply yas/take-care-of-redo ,(point-min) ,(point-max) ,snippet)
buffer-undo-list))))
(insert template) (defun yas/take-care-of-redo (beg end snippet)
(push `(apply yas/snippet-revive ,beg ,end ,snippet)
buffer-undo-list))
;; Step XX: do necessary indent (defun yas/snippet-revive (beg end snippet)
(when yas/indent-line (setf (yas/snippet-control-overlay snippet) (yas/make-control-overlay beg end))
(let* ((indent (if indent-tabs-mode (overlay-put (yas/snippet-control-overlay snippet) 'yas/snippet snippet)
(concat (make-string (/ column tab-width) ?\t) (yas/move-to-field snippet (car (yas/snippet-fields snippet)))
(make-string (% column tab-width) ?\ )) (push `(apply yas/take-care-of-redo ,beg ,end ,snippet)
(make-string column ?\ ))))
(goto-char (point-min))
(while (and (zerop (forward-line))
(= (current-column) 0))
(insert indent))))
(let ((template-beg (point-min))
(template-end (point-max)))
(widen)
(goto-char template-end)
(delete-char length)
(let ((snippet (yas/snippet-create template-beg template-end)))
;; Do more indenting
(save-excursion
(goto-char (overlay-start (yas/snippet-control-overlay snippet)))
(while (re-search-forward "$>" nil t)
(replace-match "")
(indent-according-to-mode)))
;; Push an undo action
(push `(apply yas/take-care-of-redo ,template-beg ,template-end)
buffer-undo-list))))))
(defun yas/take-care-of-redo (beg end)
(message "taking care of undo between %s and %s" beg end)
(push `(apply yas/snippet-create ,beg ,end)
buffer-undo-list)) buffer-undo-list))
(defun yas/snippet-create (begin end) (defun yas/snippet-create (begin end)
(narrow-to-region begin end)
(let ((snippet (yas/make-snippet))) (let ((snippet (yas/make-snippet)))
(goto-char (point-min)) (goto-char begin)
(yas/snippet-parse-create snippet) (yas/snippet-parse-create snippet)
;; Sort and link each field ;; Sort and link each field
(setf (yas/snippet-fields snippet) (yas/snippet-sort-link-fields snippet)
(sort (yas/snippet-fields snippet)
'(lambda (field1 field2)
(yas/snippet-field-compare field1 field2))))
(let ((prev nil)) ;; Update the mirrors for the first time
(dolist (field (yas/snippet-fields snippet)) (yas/update-mirrors snippet)
(setf (yas/field-prev field) prev)
(when prev
(setf (yas/field-next prev) field))
(setq prev field)))
;; Hide (or highlight for debugging) all hidden overlays ;; Create keymap overlay for snippet
(let ((prop-list)) (setf (yas/snippet-control-overlay snippet) (yas/make-control-overlay (point-min) (point-max)))
(push (if (member 'yas/debug-some-vars post-command-hook)
(cons 'face 'yas/field-debug-face)
(cons 'invisible t))
prop-list)
(push (cons 'evaporate t) prop-list)
(push (cons 'yas/hidden t) prop-list)
(push (cons 'yas/snippet snippet) prop-list)
(push (cons 'modification-hooks '(yas/on-hidden-overlay-modification)) prop-list) ;; what i really wanted is 'read-only
(dolist (prop prop-list)
(dolist (field (yas/snippet-fields snippet))
(overlay-put (car (yas/field-overlay-pair field)) (car prop) (cdr prop))
(overlay-put (cdr (yas/field-overlay-pair field)) (car prop) (cdr prop))
(dolist (mirror (yas/field-mirrors field))
(overlay-put (yas/mirror-overlay mirror) (car prop) (cdr prop))))
(when (overlayp (yas/snippet-exit snippet))
(overlay-put (yas/snippet-exit snippet) (car prop) (cdr prop)))))
;; Update the mirrors ;; Move to end
(yas/update-mirrors snippet) (goto-char (point-max))
;; Create keymap overlay for snippet ;; Place the cursor at a proper place
(setf (yas/snippet-control-overlay snippet) (yas/make-control-overlay (point-min) (point-max))) (let* ((first-field (car (yas/snippet-fields snippet)))
overlay)
(cond (first-field
;; Move to the new field, setting up properties of the
;; wandering active field overlay.
(yas/move-to-field snippet first-field))
(t
;; No fields, quite a simple snippet I suppose
(yas/exit-snippet snippet))))
snippet))
;; Move to end (defun yas/snippet-sort-link-fields (snippet)
(goto-char (point-max)) (setf (yas/snippet-fields snippet)
(sort (yas/snippet-fields snippet)
;; Place the cursor at a proper place '(lambda (field1 field2)
(let* ((first-field (car (yas/snippet-fields snippet))) (yas/snippet-field-compare field1 field2))))
overlay) (let ((prev nil))
(cond (first-field (dolist (field (yas/snippet-fields snippet))
;; Move to the new field, setting up properties of the (setf (yas/field-prev field) prev)
;; wandering active field overlay. (when prev
(yas/move-to-field snippet first-field)) (setf (yas/field-next prev) field))
(t (setq prev field))))
;; No fields, quite a simple snippet I suppose
(yas/exit-snippet snippet))))
(widen)
snippet))
(defun yas/snippet-parse-create (snippet) (defun yas/snippet-parse-create (snippet)
"Parse a recently inserted snippet template, creating all "Parse a recently inserted snippet template, creating all
@ -711,16 +641,16 @@ Allows nested placeholder in the style of Textmate."
number number
(not (zerop number)) (not (zerop number))
(yas/make-field number (yas/make-field number
(cons (make-overlay (match-beginning 0) (set-marker (make-marker) (match-beginning 2))
(match-beginning 2) nil t nil) (set-marker (make-marker) (1- real-match-end-0))
(make-overlay (1- real-match-end-0)
real-match-end-0 nil t nil))
parent-field)))) parent-field))))
(when brand-new-field (when brand-new-field
(delete-region (1- real-match-end-0) real-match-end-0)
(delete-region (match-beginning 0) (match-beginning 2))
(push brand-new-field (yas/snippet-fields snippet)) (push brand-new-field (yas/snippet-fields snippet))
(save-excursion (save-excursion
(save-restriction (save-restriction
(narrow-to-region (match-beginning 2) (1- real-match-end-0)) (narrow-to-region (yas/field-start brand-new-field) (yas/field-end brand-new-field))
(goto-char (point-min)) (goto-char (point-min))
(yas/field-parse-create snippet brand-new-field))))))) (yas/field-parse-create snippet brand-new-field)))))))
@ -732,34 +662,40 @@ Allows nested placeholder in the style of Textmate."
(not (zerop number)) (not (zerop number))
(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 (set-marker (make-marker) (match-beginning 0))
real-match-end-0 nil t nil) (set-marker (make-marker) (match-beginning 0))
(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))
(delete-region (match-beginning 0) real-match-end-0)))))
(defun yas/simple-mirror-parse-create (snippet) (defun yas/simple-mirror-parse-create (snippet)
(while (re-search-forward yas/simple-mirror-regexp nil t) (while (re-search-forward yas/simple-mirror-regexp nil t)
(let ((number (string-to-number (match-string-no-properties 1)))) (let ((number (string-to-number (match-string-no-properties 1))))
(if (zerop number) (cond ((zerop number)
(setf (yas/snippet-exit snippet) (setf (yas/snippet-exit snippet)
(make-overlay (match-beginning 0) (match-end 0) nil t nil)) (set-marker (make-marker) (match-beginning 0)))
(let ((field (yas/snippet-find-field snippet number))) (delete-region (match-beginning 0) (match-end 0)))
(when field (t
(let ((ov (make-overlay (match-beginning 0) (let ((field (yas/snippet-find-field snippet number)))
(match-end 0) nil t nil))) (when field
(overlay-put ov 'yas/mirrorp t) (push (yas/make-mirror (set-marker (make-marker) (match-beginning 0))
(push (yas/make-mirror ov nil) (set-marker (make-marker) (match-beginning 0))
(yas/field-mirrors field))))))))) nil)
(yas/field-mirrors field))
(delete-region (match-beginning 0) (match-end 0)))))))))
(defun yas/update-mirrors (snippet) (defun yas/update-mirrors (snippet)
(save-excursion
(dolist (field (yas/snippet-fields snippet)) (dolist (field (yas/snippet-fields snippet))
(dolist (mirror (yas/field-mirrors field)) (dolist (mirror (yas/field-mirrors field))
(yas/mirror-update-display mirror field)))) (yas/mirror-update-display mirror field)))))
(defun yas/mirror-update-display (mirror field) (defun yas/mirror-update-display (mirror field)
(overlay-put (yas/mirror-overlay mirror) 'after-string (goto-char (yas/mirror-start mirror))
(propertize (yas/apply-transform mirror field) 'face 'yas/mirror-highlight-face))) (delete-region (yas/mirror-start mirror) (yas/mirror-end mirror))
(insert (yas/apply-transform mirror field))
(set-marker (yas/mirror-end mirror) (point)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Template-related and snippet loading functions ;;; Template-related and snippet loading functions
@ -1166,19 +1102,19 @@ 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 (yas/field-start 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
(overlay-end (car (yas/field-overlay-pair field))) (yas/field-start field)
(overlay-start (cdr (yas/field-overlay-pair field)))) (yas/field-end field))
;; create a new overlay, this is the only yas overlay that
;; shouldn't evaporate
(setq yas/active-field-overlay (setq yas/active-field-overlay
(make-overlay (overlay-end (car (yas/field-overlay-pair field))) (make-overlay (yas/field-start field)
(overlay-start (cdr (yas/field-overlay-pair field))) (yas/field-end field)
nil nil t)) 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 'evaporate t)
(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))
(overlay-put yas/active-field-overlay 'insert-behind-hooks '(yas/on-field-overlay-modification))) (overlay-put yas/active-field-overlay 'insert-behind-hooks '(yas/on-field-overlay-modification)))
@ -1228,7 +1164,7 @@ exiting the snippet."
;; Push an 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-revive ,yas/snippet-beg ,yas/snippet-end ,snippet)
buffer-undo-list) buffer-undo-list)
;; Trash those overlays! ;; Trash those overlays!
@ -1302,17 +1238,17 @@ snippet, if so cleans up the whole snippet up."
) )
(defun yas/post-command-handler () (defun yas/post-command-handler ()
(yas/check-commit-snippet)) (cond ((eq 'undo this-command)
(let ((snippet (car (yas/snippets-at-point))))
(when snippet
(yas/move-to-field snippet (or (yas/snippet-active-field snippet)
(car (yas/snippet-fields snippet)))))))
(t
;; (yas/check-commit-snippet)
)))
;; Debug functions. Use (or change) at will whenever needed. ;; Debug functions. Use (or change) at will whenever needed.
(defun yas/toggle-hidden-overlays ()
(interactive)
(mapcar #'(lambda (ov)
(when (overlay-get ov 'yas/hidden)
(overlay-put ov 'invisible (not (overlay-get ov 'invisible)))))
(overlays-in (point-min) (point-max))))
(defun yas/debug-some-vars () (defun yas/debug-some-vars ()
(interactive) (interactive)
(with-output-to-temp-buffer "*YASnippet trace*" (with-output-to-temp-buffer "*YASnippet trace*"