* Fuckin' more complicated than I thought. Think I'll have to sanitize

the `buffer-undo-list' once in a while
This commit is contained in:
capitaomorte 2008-09-19 16:40:50 +00:00
parent 9fa6f3533e
commit 50e7af74fa

View File

@ -752,13 +752,14 @@ will be deleted before inserting template."
(unless (yas/snippet-exit-marker snippet) (unless (yas/snippet-exit-marker snippet)
(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) (setq yas/pending-undo-actions (list
;; (add-to-list 'original-undo-list (list 'before-first-action
;; `(apply yas/undo-expand-snippet `(apply yas/cleanup-snippet
;; ,(point-min) ,snippet
;; ,key after-first-action)
;; ,snippet))) 'jump-first-separator)))
;; Step 13: remove the trigger key ;; Step 13: remove the trigger key
(widen) (widen)
@ -1375,6 +1376,14 @@ up the snippet does not delete it!"
(eval-when-compile (eval-when-compile
(make-variable-buffer-local 'yas/registered-snippets)) (make-variable-buffer-local 'yas/registered-snippets))
(defvar yas/temporary-pre-command-hooks (list 'yas/clear-pending-undo-actions
'yas/save-active-group-boundaries))
(defvar yas/temporary-post-command-hooks (list 'yas/check-cleanup-snippet
'yas/push-pending-undo-actions
'yas/debug-some-vars))
(defun yas/add-remove-many-hooks (hook-var fn-list &optional remove) (defun yas/add-remove-many-hooks (hook-var fn-list &optional remove)
(mapcar (if remove (mapcar (if remove
#'(lambda (fn) (remove-hook hook-var fn 'local)) #'(lambda (fn) (remove-hook hook-var fn 'local))
@ -1391,18 +1400,10 @@ registered snippet exists in the current buffer. Return snippet"
;; ;;
(puthash (yas/snippet-id snippet) snippet yas/registered-snippets) (puthash (yas/snippet-id snippet) snippet yas/registered-snippets)
;; ;;
;; setup the `pre-command-hook' ;; setup the `pre-command-hook' and `post-command-hook'
;; ;;
(yas/add-remove-many-hooks 'pre-command-hook (yas/add-remove-many-hooks 'pre-command-hook yas/temporary-pre-command-hooks)
(list 'yas/clear-pending-undo-actions (yas/add-remove-many-hooks 'post-command-hook yas/temporary-post-command-hooks)
'yas/save-active-group-boundaries))
;;
;; setup the `post-command-hook'
;;
(yas/add-remove-many-hooks 'post-command-hook
(list 'yas/check-cleanup-snippet
'yas/correct-undo-list
'yas/debug-some-vars))
snippet) snippet)
(defun yas/unregister-snippet (snippet) (defun yas/unregister-snippet (snippet)
@ -1410,23 +1411,30 @@ registered snippet exists in the current buffer. Return snippet"
table. Remove `yas/check-cleanup-snippet' from the buffer-local table. Remove `yas/check-cleanup-snippet' from the buffer-local
`post-command-hook' if no more snippets registered in the `post-command-hook' if no more snippets registered in the
current buffer." current buffer."
;;
;;
;;
(remhash (yas/snippet-id snippet) yas/registered-snippets) (remhash (yas/snippet-id snippet) yas/registered-snippets)
;;
;;
;;
(when (eq 0 (when (eq 0
(hash-table-count yas/registered-snippets)) (hash-table-count yas/registered-snippets))
(yas/add-remove-many-hooks 'pre-command-hook (yas/add-remove-many-hooks 'pre-command-hook yas/temporary-pre-command-hooks 'remove)
(list 'yas/clear-pending-undo-actions (yas/add-remove-many-hooks 'post-command-hook yas/temporary-post-command-hooks 'remove)
'yas/save-active-group-boundaries) (when yas/pending-undo-actions
'remove) (add-hook 'post-command-hook 'yas/push-pending-undo-actions-once 'append 'local))))
(yas/add-remove-many-hooks 'post-command-hook
(list 'yas/correct-undo-list
'yas/check-cleanup-snippet
'yas/debug-some-vars)
'remove)))
(defun yas/exterminate-snippets () (defun yas/exterminate-snippets ()
"Remove all locally registered snippets and remove "Remove all locally registered snippets and remove
`yas/check-cleanup-snippet' from the `post-command-hook'" `yas/check-cleanup-snippet' from the `post-command-hook'"
(interactive) (interactive)
(setq yas/pending-undo-actions nil)
(setq buffer-undo-list nil)
(yas/cleanup-all-snippets))
(defun yas/cleanup-all-snippets ()
(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)
@ -1434,7 +1442,7 @@ current buffer."
(setq yas/registered-snippets (make-hash-table :test 'eq)) (setq yas/registered-snippets (make-hash-table :test 'eq))
(message "Warning: yas/snippet hash-table not fully clean. Forcing NIL."))) (message "Warning: yas/snippet hash-table not fully clean. Forcing NIL.")))
(defun yas/cleanup-snippet (snippet) (defun yas/cleanup-snippet (snippet &optional undo-action-method)
"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))
@ -1477,12 +1485,15 @@ snippet as ordinary text"
;; forget all other pending undo actions and push a undo/redo ;; forget all other pending undo actions and push a undo/redo
;; action for snippet revival ;; action for snippet revival
;; ;;
(unless (eq 'this-command 'yas/exterminate-snippets)
(setq yas/pending-undo-actions (list (setq yas/pending-undo-actions (list
(list 'above-all (list (or undo-action-method 'before-first-action)
`(yas/revive-snippet ,snippet `(apply yas/revive-snippet
,snippet
,yas/snippet-beg ,yas/snippet-beg
,yas/snippet-end ,yas/snippet-end
,(yas/snippet-active-group snippet))))) ,(yas/snippet-active-group snippet))
'jump-first-separator))))
;; ;;
;; 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
@ -1507,7 +1518,7 @@ registered snippets last."
;; No snippet at point, cleanup *all* snippets ;; No snippet at point, cleanup *all* snippets
;; ;;
(null snippet) (null snippet)
(yas/exterminate-snippets)) (yas/cleanup-all-snippets))
(;; 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)
@ -1521,13 +1532,13 @@ registered snippets last."
t t
nil)))) nil))))
;; Field-level undo functionality
;; ;;
;; XXX: Commentary on this section by joaot. ;; Undo functionality
;; ;;
;; ...
(defvar yas/pending-undo-actions nil) (defvar yas/pending-undo-actions nil)
(eval-when-compile
(make-variable-buffer-local 'yas/pending-undo-actions))
(defun yas/clear-pending-undo-actions () (defun yas/clear-pending-undo-actions ()
(setq yas/pending-undo-actions nil)) (setq yas/pending-undo-actions nil))
@ -1550,22 +1561,22 @@ performed in `yas/correct-undo-list', which is placed in the
;; Save boundaries of current field ;; Save boundaries of current field
;; ;;
(push (list 'after-first-action (push (list 'after-first-action
(list 'yas/restore-group-boundaries `(apply yas/restore-group-boundaries
group ,group
snippet ,snippet
(overlay-start field-overlay) ,(overlay-start field-overlay)
(overlay-end field-overlay))) ,(overlay-end field-overlay)))
yas/pending-undo-actions) yas/pending-undo-actions)
;; ;;
;; Save a reference to current group ;; Save a reference to current group
;; ;;
(push (list 'after-first-action (push (list 'after-first-action
(list 'yas/restore-active-group `(apply yas/restore-active-group ,group ,snippet))
group
snippet))
yas/pending-undo-actions))) yas/pending-undo-actions)))
(defun yas/revive-snippet (snippet snippet-start snippet-end active-group) (defun yas/revive-snippet (snippet snippet-start snippet-end active-group)
(let ((inhibit-modification-hooks t)
(buffer-undo-list t))
;; ;;
;; Revive the control overlay ;; Revive the control overlay
;; ;;
@ -1580,11 +1591,15 @@ performed in `yas/correct-undo-list', which is placed in the
;; ;;
;; Move to the previously active group ;; Move to the previously active group
;; ;;
(yas/restore-active-group active-group snippet) (yas/move-to-group snippet active-group)
;; ;;
;; Reregister this snippet ;; Reregister this snippet
;; ;;
(yas/register-snippet snippet)) (yas/register-snippet snippet)
;;
;; Erase any pending undo actions.
;;
(setq yas/pending-undo-actions nil)))
(defun yas/restore-active-group (group snippet) (defun yas/restore-active-group (group snippet)
"..." "..."
@ -1596,7 +1611,7 @@ performed in `yas/correct-undo-list', which is placed in the
(let* ((field-overlay (yas/snippet-active-field-overlay snippet)) (let* ((field-overlay (yas/snippet-active-field-overlay snippet))
(field (yas/group-primary-field group)) (field (yas/group-primary-field group))
(inhibit-modification-hooks t)) (inhibit-modification-hooks t))
(yas/move-overlay-and-field field-overlay field start end) (setf (yas/snippet-active-field-overlay snippet) (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)
@ -1606,46 +1621,48 @@ performed in `yas/correct-undo-list', which is placed in the
(and (>= point (yas/field-start field)) (and (>= point (yas/field-start field))
(<= point (yas/field-end field))))) (<= point (yas/field-end field)))))
(defun yas/correct-undo-list () (defun yas/push-pending-undo-actions ()
(mapcar #'(lambda (args) (mapcar #'(lambda (args)
(apply #'yas/push-undo-action-maybe args)) (apply #'yas/push-undo-action-maybe args))
yas/pending-undo-actions)) yas/pending-undo-actions))
(defun yas/push-undo-action-maybe (how apply-args &optional jump-first-separator) (defun yas/push-pending-undo-actions-once ()
(yas/push-pending-undo-actions)
(remove-hook 'post-command-hook 'yas/push-pending-undo-actions-once 'local))
(defun yas/push-undo-action-maybe (how entry &optional jump-first-separator)
"..." "..."
(let ((undo-list buffer-undo-list)
(target-separator nil)
done)
(unless (eq t buffer-undo-list) (unless (eq t buffer-undo-list)
(cond ((eq how 'after-first-action) (cond (;;
;; ;;
;; Discard possibly existing/missing start separator
;; ;;
(when (null (car undo-list)) (eq 'after-first-action how)
(let ((undo-list buffer-undo-list)
done)
(when (and jump-first-separator
(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
;; the list starting before that.
;;
(while (not done) (while (not done)
(cond ((eq (first apply-args) (cond ((condition-case oops
(condition-case opps (and (eq 'apply (first entry))
(second (car undo-list)) (eq (second entry)
(error nil))) (second (car undo-list))))
(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 entry (cdr undo-list)))))
(;;
;; ;;
;; Push a the apply-args action there
;; ;;
(setq target-separator (cdr undo-list)) (eq 'before-first-action how)
(setf (cdr undo-list) (if (and jump-first-separator
(cons (cons 'apply (null (car buffer-undo-list)))
apply-args) (push entry (cdr buffer-undo-list))
target-separator)))))))) (push entry buffer-undo-list))))))
(defun yas/sanitize-undo-redo () (defun yas/sanitize-undo-redo ()
(let ((undo-list buffer-undo-list) (let ((undo-list buffer-undo-list)
@ -1725,7 +1742,7 @@ performed in `yas/correct-undo-list', which is placed in the
(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) (truncate-string-to-width (format "%s" undo-elem) 50)))))))) (princ (format "%2s: %s\n" (position undo-elem first-ten) (truncate-string-to-width (format "%s" undo-elem) 70))))))))
(defun yas/exterminate-package () (defun yas/exterminate-package ()
(interactive) (interactive)