* 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

@ -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,7 +534,8 @@ 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))
@ -555,7 +555,10 @@ the template of a snippet in the current snippet-table."
(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))))))
@ -587,15 +590,16 @@ of the primary field."
(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 ;; in any case, synchronize mirror fields
(yas/update-mirrors group))))) (yas/update-mirrors group)))))
@ -1292,6 +1296,11 @@ when the condition evaluated to non-nil."
(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)
@ -1301,27 +1310,28 @@ when the condition evaluated to non-nil."
(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)))))
(live-groups (remove-if #'yas/group-probably-deleted-p (yas/snippet-groups snippet)))
(target-group (and number (target-group (and number
(> number 0) (> number 0)
(find-if #'(lambda (group) (find-if #'(lambda (group)
(and (not (yas/group-deleted group)) (= number (yas/group-number group)))
(= number (yas/group-number group)))) live-groups))))
(yas/snippet-groups snippet)))))
(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)
@ -1529,8 +1539,9 @@ registered snippets last."
"..." "..."
(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)))
@ -1576,6 +1587,24 @@ registered snippets last."
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.
@ -1608,7 +1637,7 @@ registered snippets last."
(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))
@ -1627,15 +1656,16 @@ registered snippets last."
(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)