* a little bit of trouble with protection after C-d or deletions, but nothing too serious...

This commit is contained in:
capitaomorte 2009-07-05 22:17:22 +00:00
parent 514243f5b9
commit f31a071457

View File

@ -66,10 +66,13 @@ current column if this variable is non-`nil'.")
"The key to bind as a trigger of snippet.") "The key to bind as a trigger of snippet.")
(defvar yas/next-field-key (kbd "<tab>") (defvar yas/next-field-key (kbd "<tab>")
"The key to navigate to next field.") "The key to navigate to next field.")
(defvar yas/clear-field-key (kbd "C-d")
"The key to clear the currently active field.")
(defvar yas/keymap (make-sparse-keymap) (defvar yas/keymap (make-sparse-keymap)
"The keymap of snippet.") "The keymap of snippet.")
(define-key yas/keymap yas/next-field-key 'yas/next-field) (define-key yas/keymap yas/next-field-key 'yas/next-field)
(define-key yas/keymap yas/clear-field-key 'yas/clear-field)
(define-key yas/keymap (kbd "S-TAB") 'yas/prev-field) (define-key yas/keymap (kbd "S-TAB") 'yas/prev-field)
(define-key yas/keymap (kbd "<S-iso-lefttab>") 'yas/prev-field) (define-key yas/keymap (kbd "<S-iso-lefttab>") 'yas/prev-field)
(define-key yas/keymap (kbd "<S-tab>") 'yas/prev-field) (define-key yas/keymap (kbd "<S-tab>") 'yas/prev-field)
@ -298,7 +301,11 @@ 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")
(defvar yas/field-protection-overlays nil
"Two overlays protect the current active field ")
(make-variable-buffer-local 'yas/active-field-overlay) (make-variable-buffer-local 'yas/active-field-overlay)
(make-variable-buffer-local 'yas/field-protection-overlays)
(defstruct (yas/snippet (:constructor yas/make-snippet ())) (defstruct (yas/snippet (:constructor yas/make-snippet ()))
"A snippet. "A snippet.
@ -522,30 +529,36 @@ the template of a snippet in the current snippet-table."
(overlay-put overlay 'evaporate t) (overlay-put overlay 'evaporate t)
overlay)) overlay))
(defun yas/clear-field (&optional field)
(interactive)
(let ((field (or field
(and yas/active-field-overlay
(overlay-buffer yas/active-field-overlay)
(overlay-get yas/active-field-overlay 'yas/field)))))
(delete-region (yas/field-start field) (yas/field-end field))))
(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 ((and after? (cond ((and after?
(not (yas/undo-in-progress))) (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)))
;; (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 (t
nil))) (let ((field (overlay-get yas/active-field-overlay 'yas/field)))
(when (and field
(not (or after? (yas/undo-in-progress)))
(not (yas/field-modified-p field)))
(setf (yas/field-modified-p field) t)
(yas/clear-field field))))))
(defun yas/overlay-insert-in-front-hook (overlay after? beg end &optional length) (defun yas/on-protection-overlay-modification (overlay after? beg end &optional length)
"To be written" "To be written"
) (cond ((not (or after?
(yas/undo-in-progress)))
(defun yas/overlay-insert-behind-hook (overlay after? beg end &optional length) (let ((snippet (car (yas/snippets-at-point))))
"To be written" (when snippet
) (yas/commit-snippet snippet)
(call-interactively this-command)
(error "Snippet exited"))))))
(defun yas/expand-snippet (start end template) (defun yas/expand-snippet (start end template)
"Expand snippet at current point. Text between START and END "Expand snippet at current point. Text between START and END
@ -569,13 +582,19 @@ will be deleted before inserting template."
buffer-undo-list)))) buffer-undo-list))))
(defun yas/take-care-of-redo (beg end snippet) (defun yas/take-care-of-redo (beg end snippet)
(let ((inhibit-modification-hooks t))
(when yas/active-field-overlay
(delete-overlay yas/active-field-overlay))
(when yas/field-protection-overlays
(mapcar #'delete-overlay yas/field-protection-overlays)))
(push `(apply yas/snippet-revive ,beg ,end ,snippet) (push `(apply yas/snippet-revive ,beg ,end ,snippet)
buffer-undo-list)) buffer-undo-list))
(defun yas/snippet-revive (beg end snippet) (defun yas/snippet-revive (beg end 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 (car (yas/snippet-fields snippet))) (yas/move-to-field snippet (or (yas/snippet-active-field snippet)
(car (yas/snippet-fields 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))
@ -1100,10 +1119,7 @@ when the condition evaluated to non-nil."
(t (t
nil)))) nil))))
(defun yas/move-to-field (snippet field) (defun yas/make-move-active-field-overlay (snippet field)
"Update SNIPPET to move to field 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
@ -1114,10 +1130,36 @@ when the condition evaluated to non-nil."
(yas/field-end 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 '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))))
(defun yas/make-move-field-protection-overlays (snippet field)
(cond ((and yas/field-protection-overlays
(every #'overlay-buffer yas/field-protection-overlays))
(move-overlay (first yas/field-protection-overlays) (1- (yas/field-start field)) (yas/field-start field))
(move-overlay (second yas/field-protection-overlays) (yas/field-end field) (1+ (yas/field-end field))))
(t
(setq yas/field-protection-overlays
(list (make-overlay (1- (yas/field-start field)) (yas/field-start field) nil t nil)
(make-overlay (yas/field-end field) (1+ (yas/field-end field)) nil t nil)))
(dolist (ov yas/field-protection-overlays)
(overlay-put ov 'face 'yas/field-debug-face)
;; (overlay-put ov 'evaporate t)
(overlay-put ov 'modification-hooks '(yas/on-protection-overlay-modification))
(overlay-put ov 'insert-in-front-hooks '(yas/on-protection-overlay-modification))
(overlay-put ov 'insert-behind-hooks '(yas/on-protection-overlay-modification))))))
(defun yas/move-to-field (snippet field)
"Update SNIPPET to move to field FIELD.
Also create some protection overlays"
(goto-char (yas/field-start field))
(setf (yas/snippet-active-field snippet) field)
(yas/make-move-active-field-overlay 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))
(defun yas/prev-field () (defun yas/prev-field ()
@ -1129,7 +1171,9 @@ 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)
(goto-char (yas/commit-snippet snippet))) (goto-char (if (yas/snippet-exit snippet)
(yas/snippet-exit snippet)
(overlay-end (yas/snippet-control-overlay snippet)))))
(defun yas/exterminate-snippets () (defun yas/exterminate-snippets ()
"Remove all snippets in buffer" "Remove all snippets in buffer"
@ -1149,8 +1193,7 @@ Return a buffer position where the point should be placed if
exiting the snippet." exiting the snippet."
(let ((control-overlay (yas/snippet-control-overlay 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 revive it ;; Save the end of the moribund snippet in case we need to revive it
;; its original expansion. ;; its original expansion.
@ -1159,58 +1202,30 @@ exiting the snippet."
(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))
(let ((inhibit-modification-hooks t))
(when yas/active-field-overlay
(delete-overlay yas/active-field-overlay))
(when yas/field-protection-overlays
(mapcar #'delete-overlay yas/field-protection-overlays)))
;; Push an action for snippet revival ;; Push an action for snippet revival
;; ;;
(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)
;; Trash those overlays!
;;
(let ((inhibit-modification-hooks t))
(when yas/active-field-overlay
(delete-overlay yas/active-field-overlay))
;; Delete all the text under the overlays
(dolist (field (yas/snippet-fields snippet))
(dolist (mirror (yas/field-mirrors field))
(let ((mirror-overlay (yas/mirror-overlay mirror)))
(when (and mirror-overlay
(overlay-buffer mirror-overlay))
(goto-char (overlay-start mirror-overlay))
(yas/delete-overlay-region mirror-overlay)
(insert (yas/apply-transform mirror field)))))
(let* ((overlay-pair (yas/field-overlay-pair field))
(before (car overlay-pair))
(after (cdr overlay-pair)))
(dolist (ov (list before after))
(when (and ov
(overlay-buffer ov))
(yas/delete-overlay-region ov)))))
;; Take care of the exit marker
;;
(cond ((and (yas/snippet-exit snippet)
(overlay-buffer (yas/snippet-exit snippet)))
(setq exit (overlay-start (yas/snippet-exit snippet)))
(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
;; be the case if the main overlay had somehow already ;; be the case if the main overlay had somehow already
;; 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)))
(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
snippet, if so cleans up the whole snippet up." snippet, if so cleans up the whole snippet up."
(unless (yas/undo-in-progress)
(let* ((snippet (first (yas/snippets-at-point)))) (let* ((snippet (first (yas/snippets-at-point))))
(cond ((null snippet) (cond ((null snippet)
;; ;;
@ -1219,17 +1234,19 @@ snippet, if so cleans up the whole snippet up."
(yas/exterminate-snippets)) (yas/exterminate-snippets))
((let ((beg (overlay-start yas/active-field-overlay)) ((let ((beg (overlay-start yas/active-field-overlay))
(end (overlay-end yas/active-field-overlay))) (end (overlay-end yas/active-field-overlay)))
(or (> (point) end) (or (not end)
(not beg)
(> (point) end)
(< (point) beg))) (< (point) beg)))
;; A snippet exitss at point, but point left the currently ;; A snippet exitss at point, but point left the currently
;; active field overlay ;; active field overlay
(save-excursion (yas/commit-snippet snippet))) (yas/commit-snippet snippet))
( ;; ( ;;
;; Snippet at point, and point inside a snippet field, ;; Snippet at point, and point inside a snippet field,
;; everything is normal ;; everything is normal
;; ;;
t t
nil))))) nil))))
;; ;;
;; Pre and post command handlers ;; Pre and post command handlers
@ -1243,9 +1260,8 @@ snippet, if so cleans up the whole snippet up."
(when snippet (when 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)))))))
(t ((not (yas/undo-in-progress))
;; (yas/check-commit-snippet) (yas/check-commit-snippet))))
)))
;; Debug functions. Use (or change) at will whenever needed. ;; Debug functions. Use (or change) at will whenever needed.
@ -1263,7 +1279,7 @@ snippet, if so cleans up the whole snippet up."
"ENABLED") "ENABLED")
(point-max))) (point-max)))
(unless (eq buffer-undo-list t) (unless (eq buffer-undo-list t)
(princ (format "Undolist has %s elements. First 10 elements follow:\n" (length buffer-undo-list))) (princ (format "Undpolist has %s elements. First 10 elements follow:\n" (length buffer-undo-list)))
(let ((first-ten (subseq buffer-undo-list 0 19))) (let ((first-ten (subseq buffer-undo-list 0 19)))
(dolist (undo-elem first-ten) (dolist (undo-elem first-ten)
(princ (format "%2s: %s\n" (position undo-elem first-ten) (truncate-string-to-width (format "%s" undo-elem) 70)))))))) (princ (format "%2s: %s\n" (position undo-elem first-ten) (truncate-string-to-width (format "%s" undo-elem) 70))))))))