* Only the full snippet undo/redo missing. Fields are quite OK, I think.

* Also the mirror and primary transforms would be nice.
This commit is contained in:
capitaomorte 2008-09-15 08:58:48 +00:00
parent 5a3b161219
commit aa75b00b55

View File

@ -3,7 +3,7 @@
;; Copyright 2008 pluskid ;; Copyright 2008 pluskid
;; ;;
;; Author: pluskid <pluskid@gmail.com> ;; Author: pluskid <pluskid@gmail.com>
;; Version: 0.5.6 XXX: Change this ;; Version: 0.5.6 XXX: Change this
;; X-URL: http://code.google.com/p/yasnippet/ ;; X-URL: http://code.google.com/p/yasnippet/
;; This file is free software; you can redistribute it and/or modify ;; This file is free software; you can redistribute it and/or modify
@ -309,7 +309,6 @@ set to t."
(next nil) (next nil)
(prev nil) (prev nil)
snippet snippet
(deleted nil)
(modified nil)) (modified nil))
(defstruct (yas/field (defstruct (yas/field
(:constructor yas/make-field (start end number value transform parent-field))) (:constructor yas/make-field (start end number value transform parent-field)))
@ -535,32 +534,36 @@ the template of a snippet in the current snippet-table."
(save-excursion (save-excursion
(let* ((inhibit-modification-hooks t) (let* ((inhibit-modification-hooks t)
(primary (yas/group-primary-field field-group)) (primary (yas/group-primary-field field-group))
(text (yas/current-field-text primary))) (text (yas/current-field-text primary))
(buffer-undo-list t))
;; For all fields except the primary, replace their text ;; For all fields except the primary, replace their text
(yas/replace-fields-with-value (remove-if #'(lambda (field) (yas/replace-fields-with-value (remove-if #'(lambda (field)
(equal field primary)) (equal field primary))
(yas/group-fields field-group)) (yas/group-fields field-group))
text) text)
;; Call recursively for subfields ;; Call recursively for subfields
(unless dont-recurse-down (unless dont-recurse-down
(dolist (subfield (yas/field-subfields primary)) (dolist (subfield (yas/field-subfields primary))
(yas/update-mirrors (yas/field-group subfield)))) (yas/update-mirrors (yas/field-group subfield))))
;; Call recursively for parent field ;; Call recursively for parent field
(when (yas/field-parent-field primary) (when (yas/field-parent-field primary)
(yas/update-mirrors (yas/field-group (yas/field-parent-field primary)) (yas/update-mirrors (yas/field-group (yas/field-parent-field primary))
'dont-recurse)))))) 'dont-recurse))))))
(defun yas/current-field-text (field) (defun yas/current-field-text (field)
(buffer-substring-no-properties (yas/field-start field) (buffer-substring-no-properties (yas/field-start field)
(yas/field-end field))) (yas/field-end field)))
(defun yas/current-active-group (&optional snippet point) (defun yas/current-active-group (&optional snippet point)
"..." "...
XXX: TODO: Remove if possible and replace inline.
"
(let ((snippet (or snippet (let ((snippet (or snippet
(yas/snippet-of-current-keymap (or point (yas/snippet-of-current-keymap (or point
(point)))))) (point))))))
(and snippet (and snippet
(yas/snippet-active-group snippet)))) (yas/snippet-active-group snippet))))
(defun yas/overlay-modification-hook (overlay after? beg end &optional length) (defun yas/overlay-modification-hook (overlay after? beg end &optional length)
"Synchronizes all fields for the group of the current field overlay "Synchronizes all fields for the group of the current field overlay
@ -575,44 +578,45 @@ of the primary field."
"Hook for snippet overlay when text is inserted in front of a snippet field." "Hook for snippet overlay when text is inserted in front of a snippet field."
(let ((group (yas/current-active-group))) (let ((group (yas/current-active-group)))
(when (and after? (when (and after?
group) group)
(let ((inhibit-modification-hooks t)) (let ((inhibit-modification-hooks t))
;; ;;
;; If the group hasn't ever been modified, delete its contents ;; If the group hasn't ever been modified, delete its contents
;; completely. ;; completely.
;; ;;
(when (not (yas/group-modified group)) (when (not (yas/group-modified group))
(setf (yas/group-modified group) t) (setf (yas/group-modified group) t)
(when (> (overlay-end overlay) end) (when (> (overlay-end overlay) end)
(save-excursion (save-excursion
(goto-char end) (goto-char end)
(delete-char (- (overlay-end overlay) end)))) (delete-char (- (overlay-end overlay) end))))
;; ;; ;;
;; Mark subgroups as `yas/group-deleted', so we're no longer ;; ;; Mark subgroups as `yas/group-deleted', so we're no longer
;; able to move them. This action is undoable as long as ;; ;; able to move them. This action is undoable as long as
;; `yas/undo-before-hook' exists in the `pre-command-hook' ;; ;; `yas/undo-before-hook' exists in the `pre-command-hook'
;; in the proper place. ;; ;; in the proper place.
;; ;; ;;
(mapcar #'(lambda (group) ;; (mapcar #'(lambda (group)
(setf (yas/group-deleted group) t)) ;; (setf (yas/group-deleted group) t))
(mapcar #'yas/field-group (yas/field-subfields (yas/group-primary-field group))))) ;; (mapcar #'yas/field-group (yas/field-subfields (yas/group-primary-field group))))
;; in any case, synchronize mirror fields )
(yas/update-mirrors group))))) ;; in any case, synchronize mirror fields
(yas/update-mirrors group)))))
(defun yas/move-overlay-and-field (overlay field start end) (defun yas/move-overlay-and-field (overlay field start end)
(move-overlay overlay (move-overlay overlay
start start
end) end)
(move-marker (yas/field-start field) start) (move-marker (yas/field-start field) start)
(move-marker (yas/field-end field) end)) (move-marker (yas/field-end field) end))
(defun yas/overlay-insert-behind-hook (overlay after? beg end &optional length) (defun yas/overlay-insert-behind-hook (overlay after? beg end &optional length)
"Hook for snippet overlay when text is inserted just behind the currently active field overlay." "Hook for snippet overlay when text is inserted just behind the currently active field overlay."
(let* ((group (yas/current-active-group)) (let* ((group (yas/current-active-group))
(field (and group (field (and group
(yas/group-primary-field group)))) (yas/group-primary-field group))))
(when (and after? (when (and after?
field) field)
(yas/move-overlay-and-field overlay field (overlay-start overlay) end) (yas/move-overlay-and-field overlay field (overlay-start overlay) end)
(yas/update-mirrors group)))) (yas/update-mirrors group))))
@ -644,12 +648,12 @@ redo-ed."
(length (- end start)) (length (- end start))
(text (yas/calculate-field-value field (or rep (text (yas/calculate-field-value field (or rep
(yas/field-value field)))) (yas/field-value field))))
(inhibit-modification-hooks t)) (inhibit-modification-hooks t))
(when text (when text
(goto-char start) (goto-char start)
(insert text) (insert text)
(delete-char length) (delete-char length)
(move-marker (yas/field-end field) (point)))))) (move-marker (yas/field-end field) (point))))))
(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
@ -750,12 +754,12 @@ will be deleted before inserting template."
(setf (yas/snippet-exit-marker snippet) (copy-marker (point) t))) (setf (yas/snippet-exit-marker snippet) (copy-marker (point) t)))
;; ;; Step 12: Construct undo information ;; ;; Step 12: Construct undo information
;; (unless (eq original-undo-list t) ;; (unless (eq original-undo-list t)
;; (add-to-list 'original-undo-list ;; (add-to-list 'original-undo-list
;; `(apply yas/undo-expand-snippet ;; `(apply yas/undo-expand-snippet
;; ,(point-min) ;; ,(point-min)
;; ,key ;; ,key
;; ,snippet))) ;; ,snippet)))
;; Step 13: remove the trigger key ;; Step 13: remove the trigger key
(widen) (widen)
@ -766,16 +770,16 @@ will be deleted before inserting template."
;; Step 15: place the cursor at a proper place ;; Step 15: place the cursor at a proper place
(let* ((first-group (car (yas/snippet-groups snippet))) (let* ((first-group (car (yas/snippet-groups snippet)))
(first-field (and first-group (first-field (and first-group
(yas/group-primary-field first-group))) (yas/group-primary-field first-group)))
overlay) overlay)
(cond (first-field (cond (first-field
;; Step 10: Move to the new group, setting up ;; Step 10: Move to the new group, setting up
;; properties of the wandering active field overlay. ;; properties of the wandering active field overlay.
(yas/move-to-group snippet first-group)) (yas/move-to-group snippet first-group))
(t (t
;; no need to call exit-snippet, since no overlay created. ;; no need to call exit-snippet, since no overlay created.
(yas/exit-snippet snippet)))) (yas/exit-snippet snippet))))
;; Step 16: Do necessary indenting ;; Step 16: Do necessary indenting
(save-excursion (save-excursion
@ -853,34 +857,34 @@ Allows nested placeholder in the style of Textmate."
(yas/snippet-add-field (yas/snippet-add-field
snippet snippet
(yas/make-field (yas/make-field
(set-marker (make-marker) (match-beginning 0)) (set-marker (make-marker) (match-beginning 0))
(set-marker (make-marker) (or (marker-position bracket-end) (set-marker (make-marker) (or (marker-position bracket-end)
(match-end 0))) (match-end 0)))
(and number (string-to-number number)) (and number (string-to-number number))
value value
transform transform
parent-field))) parent-field)))
(when parent-field (when parent-field
(setf (yas/field-subfields parent-field) (setf (yas/field-subfields parent-field)
(push brand-new-field (yas/field-subfields parent-field)))) (push brand-new-field (yas/field-subfields parent-field))))
;; f) delete useless regions, move to correct spot for more ;; f) delete useless regions, move to correct spot for more
;; search... ;; search...
(delete-region (match-beginning 0) (or (marker-position value-start) (delete-region (match-beginning 0) (or (marker-position value-start)
(point))) (point)))
(when value (when value
(when (marker-position bracket-end) (when (marker-position bracket-end)
(delete-region value-end bracket-end)) (delete-region value-end bracket-end))
;; g) investigate nested placeholders ;; g) investigate nested placeholders
(save-excursion (save-excursion
(save-restriction (save-restriction
(narrow-to-region value-start value-end) (narrow-to-region value-start value-end)
(goto-char (point-min)) (goto-char (point-min))
(yas/field-parse-create snippet brand-new-field))) (yas/field-parse-create snippet brand-new-field)))
;; h) ;; h)
(setf (yas/field-value brand-new-field) (setf (yas/field-value brand-new-field)
(buffer-substring-no-properties value-start value-end))))))) (buffer-substring-no-properties value-start value-end)))))))
(defun yas/field-bracket-end () (defun yas/field-bracket-end ()
"Calculates position of the field's closing bracket if any. "Calculates position of the field's closing bracket if any.
@ -903,7 +907,7 @@ placeholders."
(defun yas/snippet-of-current-keymap (&optional point) (defun yas/snippet-of-current-keymap (&optional point)
"Return the most recently inserted snippet holding covering "Return the most recently inserted snippet holding covering
POINT." POINT."
(let ((point (or point (point))) (let ((point (or point (point)))
(keymap-snippet nil) (keymap-snippet nil)
(snippet nil)) (snippet nil))
(dolist (overlay (overlays-at point)) (dolist (overlay (overlays-at point))
@ -1290,56 +1294,62 @@ when the condition evaluated to non-nil."
(defun yas/current-group-for-navigation (&optional snippet) (defun yas/current-group-for-navigation (&optional snippet)
(and snippet (and snippet
(yas/snippet-active-group snippet))) (yas/snippet-active-group snippet)))
(defun yas/group-probably-deleted-p (group)
(let ((primary-field (yas/group-primary-field group)))
(and (zerop (- (yas/field-start primary-field) (yas/field-end primary-field)))
(yas/field-parent-field primary-field))))
(defun yas/next-field-group (&optional arg) (defun yas/next-field-group (&optional arg)
"Navigate to next field group. If there's none, exit the snippet." "Navigate to next field group. 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))
(number (and snippet (number (and snippet
(+ arg (+ arg
(yas/group-number (yas/current-group-for-navigation snippet))))) (yas/group-number (yas/current-group-for-navigation snippet)))))
(target-group (and number (live-groups (remove-if #'yas/group-probably-deleted-p (yas/snippet-groups snippet)))
(> number 0) (target-group (and number
(find-if #'(lambda (group) (> number 0)
(and (not (yas/group-deleted group)) (find-if #'(lambda (group)
(= number (yas/group-number group)))) (= number (yas/group-number group)))
(yas/snippet-groups snippet))))) live-groups))))
(cond ((and number (cond ((and number
(> number (length (remove-if #'yas/group-deleted (yas/snippet-groups snippet))))) (> number (length live-groups)))
(yas/exit-snippet snippet)) (yas/exit-snippet snippet))
(target-group (target-group
(yas/move-to-group snippet target-group)) (yas/move-to-group snippet target-group))
(t (t
nil)))) nil))))
(defun yas/move-to-group (snippet group) (defun yas/move-to-group (snippet group &optional dontmove)
"Update SNIPPET to move to group GROUP." "Update SNIPPET to move to group GROUP."
(let ((field (yas/group-primary-field group)) (let ((field (yas/group-primary-field group))
(overlay (yas/snippet-active-field-overlay snippet))) (overlay (yas/snippet-active-field-overlay snippet)))
(goto-char (yas/field-start field)) (unless dontmove
(goto-char (yas/field-start field)))
(setf (yas/snippet-active-group snippet) group) (setf (yas/snippet-active-group snippet) group)
(setf (yas/group-deleted group) nil) ;; (setf (yas/group-deleted group) nil)
(cond ((and overlay (cond ((and overlay
(overlay-buffer overlay)) (overlay-buffer overlay))
(move-overlay overlay (yas/field-start field) (move-overlay overlay (yas/field-start field)
(yas/field-end field))) (yas/field-end field)))
(t (t
(setq overlay (make-overlay (yas/field-start first-field) (yas/field-end first-field))) (setq overlay (make-overlay (yas/field-start first-field) (yas/field-end first-field)))
(overlay-put overlay 'modification-hooks yas/overlay-modification-hooks) (overlay-put overlay 'modification-hooks yas/overlay-modification-hooks)
(overlay-put overlay 'insert-in-front-hooks yas/overlay-insert-in-front-hooks) (overlay-put overlay 'insert-in-front-hooks yas/overlay-insert-in-front-hooks)
(overlay-put overlay 'insert-behind-hooks yas/overlay-insert-behind-hooks) (overlay-put overlay 'insert-behind-hooks yas/overlay-insert-behind-hooks)
(overlay-put overlay 'face 'yas/field-highlight-face) (overlay-put overlay 'face 'yas/field-highlight-face)
(setf (yas/snippet-active-field-overlay snippet) overlay))))) (setf (yas/snippet-active-field-overlay snippet) overlay)))))
(defun yas/prev-field-group () (defun yas/prev-field-group ()
"Navigate to prev field group. If there's none, exit the snippet." "Navigate to prev field group. If there's none, exit the snippet."
(interactive) (interactive)
(yas/next-field-group -1)) (yas/next-field-group -1))
(defun yas/exit-snippet (snippet) (defun yas/exit-snippet (snippet)
"Goto exit-marker of SNIPPET and cleanup the snippet. Cleaning "Goto exit-marker of SNIPPET and cleanup the snippet. Cleaning
up the snippet does not delete it!" up the snippet does not delete it!"
@ -1408,7 +1418,7 @@ current buffer."
`yas/check-cleanup-snippet' from the `post-command-hook'" `yas/check-cleanup-snippet' from the `post-command-hook'"
(interactive) (interactive)
(maphash #'(lambda (key snippet) (maphash #'(lambda (key snippet)
(when (yas/snippet-p snippet) (yas/cleanup-snippet snippet))) (when (yas/snippet-p snippet) (yas/cleanup-snippet snippet)))
yas/registered-snippets) yas/registered-snippets)
(unless (eq 0 (hash-table-count yas/registered-snippets)) (unless (eq 0 (hash-table-count yas/registered-snippets))
(setq yas/registered-snippets (make-hash-table :test 'eq)) (setq yas/registered-snippets (make-hash-table :test 'eq))
@ -1418,12 +1428,12 @@ current buffer."
"Cleanup SNIPPET, but leave point as it is. This renders the "Cleanup 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)) (let* ((control-overlay (yas/snippet-control-overlay snippet))
(field-overlay (yas/snippet-active-field-overlay snippet)) (field-overlay (yas/snippet-active-field-overlay snippet))
yas/snippet-beg yas/snippet-end) yas/snippet-beg yas/snippet-end)
;; ;;
;; 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 undo
;; its original expansion. This is used by `yas/undo-expand-snippet' ;; its original expansion. This is used by `yas/undo-expand-snippet'
;; ;;
(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))
@ -1432,33 +1442,33 @@ snippet as ordinary text"
(delete-overlay control-overlay)) (delete-overlay control-overlay))
;; ;;
;; Delete the currently active field overlay if any ;; Delete the currently active field overlay if any
;; ;;
(when (and field-overlay (when (and field-overlay
(overlay-buffer field-overlay)) (overlay-buffer field-overlay))
(delete-overlay field-overlay)) (delete-overlay field-overlay))
;; ;;
;; Iterate every group, and in it, every field. ;; Iterate every group, and in it, every field.
;; ;;
(dolist (group (yas/snippet-groups snippet)) (dolist (group (yas/snippet-groups snippet))
(dolist (field (yas/group-fields group)) (dolist (field (yas/group-fields group))
(let ((start-marker (yas/field-start field)) (let ((start-marker (yas/field-start field))
(end-marker (yas/field-end field))) (end-marker (yas/field-end field)))
;; ;;
;; convert markers into points, before losing the reference. ;; convert markers into points, before losing the reference.
;; ;;
(when (markerp start-marker) (when (markerp start-marker)
(setf (yas/field-start field) (marker-position start-marker)) (setf (yas/field-start field) (marker-position start-marker))
(set-marker start-marker nil)) (set-marker start-marker nil))
(when (markerp end-marker) (when (markerp end-marker)
(setf (yas/field-end field) (marker-position end-marker)) (setf (yas/field-end field) (marker-position end-marker))
(set-marker end-marker nil))))) (set-marker end-marker nil)))))
;; ;;
;; 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))
(yas/unregister-snippet snippet)) (yas/unregister-snippet snippet))
@ -1469,8 +1479,8 @@ 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)) (let* ((snippet (yas/snippet-of-current-keymap))
(group (and snippet (group (and snippet
(yas/snippet-active-group snippet)))) (yas/snippet-active-group snippet))))
(cond (;; (cond (;;
;; No snippet at point, cleanup *all* snippets ;; No snippet at point, cleanup *all* snippets
;; ;;
@ -1479,8 +1489,8 @@ registered snippets last."
(;; A snippet exits at point, but point left the currently (;; A snippet exits at point, but point left the currently
;; active field overlay ;; active field overlay
(or (not group) (or (not group)
(and group (and group
(not (yas/point-in-field-p (yas/group-primary-field group))))) (not (yas/point-in-field-p (yas/group-primary-field group)))))
(yas/cleanup-snippet snippet)) (yas/cleanup-snippet snippet))
(;; (;;
;; Snippet at point, and point inside a snippet field, ;; Snippet at point, and point inside a snippet field,
@ -1498,83 +1508,102 @@ registered snippets last."
(defun yas/undo-before-hook () (defun yas/undo-before-hook ()
"..." "..."
(let* ((snippet (yas/snippet-of-current-keymap)) (let* ((snippet (yas/snippet-of-current-keymap))
(field-overlay (and snippet (field-overlay (and snippet
(yas/snippet-active-field-overlay snippet)))) (yas/snippet-active-field-overlay snippet))))
(when (and field-overlay (when (and field-overlay
(overlay-buffer field-overlay)) (overlay-buffer field-overlay))
(setf (yas/snippet-undo-saved-info snippet) (setf (yas/snippet-undo-saved-info snippet)
(list (list
;; ;;
;; Save boundaries of current field ;; Save boundaries of current field
;; ;;
(cons (overlay-start field-overlay) (cons (overlay-start field-overlay)
(overlay-end field-overlay)) (overlay-end field-overlay))
;; ;;
;; Save a reference to current group ;; Save a reference to current group
;; ;;
(yas/snippet-active-group snippet)))))) (yas/snippet-active-group snippet))))))
(defun yas/undo-after-hook () (defun yas/undo-after-hook ()
"..." "..."
(let* ((snippet (yas/snippet-of-current-keymap)) (let* ((snippet (yas/snippet-of-current-keymap))
(saved-info (and snippet (saved-info (and snippet
(yas/snippet-undo-saved-info snippet)))) (yas/snippet-undo-saved-info snippet))))
(unless (null saved-info) (unless (null saved-info)
(yas/push-undo-action-maybe (list 'yas/undo-restore-active-group (yas/push-undo-action-maybe (list 'yas/undo-restore-active-group
(second saved-info) (second saved-info)
(car (first saved-info)) (car (first saved-info))
(cdr (first saved-info))))))) (cdr (first saved-info)))))))
(defun yas/undo-restore-active-group (group start end) (defun yas/undo-restore-active-group (group start end)
"..." "..."
(let* ((snippet (yas/snippet-of-current-keymap)) (let* ((snippet (yas/snippet-of-current-keymap))
(field-overlay (yas/snippet-active-field-overlay snippet)) (field-overlay (yas/snippet-active-field-overlay snippet))
(field (yas/group-primary-field group))) (field (yas/group-primary-field group))
(yas/move-to-group snippet group) (inhibit-modification-hooks t))
(yas/move-to-group snippet group 'dontmove)
(yas/move-overlay-and-field field-overlay field start end) (yas/move-overlay-and-field field-overlay field start end)
(yas/update-mirrors group))) (yas/update-mirrors group)))
(defun yas/point-in-field-p (field &optional point) (defun yas/point-in-field-p (field &optional point)
"..." "..."
(let ((point (or point (let ((point (or point
(point)))) (point))))
(and (>= point (yas/field-start field)) (and (>= point (yas/field-start field))
(<= point (yas/field-end field))))) (<= point (yas/field-end field)))))
(defun yas/push-undo-action-maybe (apply-args) (defun yas/push-undo-action-maybe (apply-args)
"..." "..."
(let ((undo-list buffer-undo-list) (let ((undo-list buffer-undo-list)
(target-separator nil) (target-separator nil)
done) done)
(unless (eq t buffer-undo-list) (unless (eq t buffer-undo-list)
;; ;;
;; Discard possibly existing/missing start separator ;; Discard possibly existing/missing start separator
;; ;;
(when (null (car undo-list)) (when (null (car undo-list))
(setq undo-list (cdr undo-list))) (setq undo-list (cdr undo-list)))
;; ;;
;; Find the target separator keeping `undo-list' as a reference to ;; Find the target separator keeping `undo-list' as a reference to
;; the list starting before that. ;; the list starting before that.
;; ;;
(while (not done) (while (not done)
(cond ((eq (first apply-args) (cond ((eq (first apply-args)
(condition-case opps (condition-case opps
(second (car undo-list)) (second (car undo-list))
(error nil))) (error nil)))
(setq done 'return)) (setq done 'return))
((null (cadr undo-list)) ((null (cadr undo-list))
(setq done 'try-insert)) (setq done 'try-insert))
(t (t
(setq undo-list (cdr undo-list))))) (setq undo-list (cdr undo-list)))))
(unless (eq done 'return) (unless (eq done 'return)
;; ;;
;; Push a the apply-args action there ;; Push a the apply-args action there
;; ;;
(setq target-separator (cdr undo-list)) (setq target-separator (cdr undo-list))
(setf (cdr undo-list) (setf (cdr undo-list)
(cons (cons 'apply (cons (cons 'apply
apply-args) apply-args)
target-separator)))))) target-separator))))))
(defun yas/sanitize-undo-redo ()
(let ((undo-list buffer-undo-list)
done)
(unless (eq t buffer-undo-list)
;;
;; Discard possibly existing/missing start separator
;;
(when (null (car undo-list))
(setq undo-list (cdr undo-list)))
(delete-if #'(lambda (elem)
(when (and (consp elem)
(integerp (cdr elem))
(> (cdr elem) (point-max)))
(prog1 t
(message "Deleting %s in the undo-list (greater than point-max=%s)!!!" elem (point-max)))))
undo-list
:end (position nil undo-list)))))
;; Debug functions. Use (or change) at will whenever needed. ;; Debug functions. Use (or change) at will whenever needed.
@ -1590,52 +1619,53 @@ registered snippets last."
(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" (princ (format "\t key %s for snippet %s"
key key
(yas/snippet-id snippet))) (yas/snippet-id snippet)))
(princ (format "\t Big overlay %s\n" (princ (format "\t Big overlay %s\n"
(yas/snippet-control-overlay snippet))) (yas/snippet-control-overlay snippet)))
(if (yas/snippet-active-field-overlay snippet) (if (yas/snippet-active-field-overlay snippet)
(princ (format "\t Field overlay %s\n " (princ (format "\t Field overlay %s\n "
(yas/snippet-active-field-overlay snippet))) (yas/snippet-active-field-overlay snippet)))
(princ "No active field overlay!!\m")) (princ "No active field overlay!!\m"))
(dolist (group (yas/snippet-groups snippet)) (dolist (group (yas/snippet-groups snippet))
(princ (format "\t Group $%s with %s fields is %s and %s" (princ (format "\t Group $%s with %s fields is %s and %s"
(yas/group-number group) (yas/group-number group)
(length (yas/group-fields group)) (length (yas/group-fields group))
(if (yas/group-deleted group) (if (yas/group-probably-deleted-p group)
"DELETED" "DELETED"
"alive") "alive")
(if (eq group (yas/snippet-active-group snippet)) (if (eq group (yas/snippet-active-group snippet))
"ACTIVE!\n" "ACTIVE!\n"
"NOT ACTIVE!\n"))) "NOT ACTIVE!\n")))
(dolist (field (yas/group-fields group)) (dolist (field (yas/group-fields group))
(princ (format "\t\t* %s field. Current value (%s) .\n" (princ (format "\t\t* %s field. Current value (%s) .\n"
(if (eq field (yas/group-primary-field group)) (if (eq field (yas/group-primary-field group))
"Primary" "Mirror") "Primary" "Mirror")
(yas/current-field-text field))) (yas/current-field-text field)))
(princ (format "\t\t From %s to %s\n" (princ (format "\t\t From %s to %s\n"
(yas/field-start field) (yas/field-start field)
(yas/field-end field))) (yas/field-end field)))
))) 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))
(princ (format "\nUndo is %s." (princ (format "\nUndo is %s and point-max is %s.\n"
(if (eq buffer-undo-list t) (if (eq buffer-undo-list t)
"DISABLED" "DISABLED"
"ENABLED"))) "ENABLED")
(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 "Undolist 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 "%s: %s\n" (position undo-elem first-ten) undo-elem))))))) (princ (format "%s: %s\n" (position undo-elem first-ten) (truncate-string-to-width (format "%s" undo-elem) 50))))))))
(defun yas/exterminate-package () (defun yas/exterminate-package ()
(interactive) (interactive)