* Getting there, getting there, `yas/push-undo-action-maybe' has to be

modified to adapt to new arg list and use `pushnew'

* A `yas/cleanup-snippet' action has to be pushed on `yas/expand' 

* expanding a new snippet with a snippet already active must render
  the previous one disabled. This shouldn't be a field, it should be
  found out on the fly. disabled means its big overlay is coloured
  some other color.

* transformations have to be accounted for

* code has to be cleaned up and thoroughly commented.
This commit is contained in:
capitaomorte 2008-09-18 21:43:28 +00:00
parent d117ee3857
commit 9fa6f3533e

View File

@ -567,10 +567,10 @@ XXX: TODO: Remove if possible and replace inline.
(defun yas/make-control-overlay (start end) (defun yas/make-control-overlay (start end)
"..." "..."
(let ((overlay (make-overlay start (let ((overlay (make-overlay start
end end
nil nil
nil nil
t))) t)))
(overlay-put overlay 'keymap yas/keymap) (overlay-put overlay 'keymap yas/keymap)
(overlay-put overlay 'yas/snippet-reference snippet) (overlay-put overlay 'yas/snippet-reference snippet)
overlay)) overlay))
@ -617,14 +617,14 @@ of the primary field."
;; Move the overlay to the correct spot, creating one if necessary. ;; Move the overlay to the correct spot, creating one if necessary.
;; ;;
(cond ((and overlay (cond ((and overlay
(overlay-buffer overlay)) (overlay-buffer overlay))
(move-overlay overlay start end)) (move-overlay overlay start end))
(t (t
(setq overlay (make-overlay start end)) (setq overlay (make-overlay start end))
(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)))
;; ;;
;; Move the markers to the correct spot, correcting them if they're ;; Move the markers to the correct spot, correcting them if they're
;; no longer markers ;; no longer markers
@ -731,7 +731,7 @@ will be deleted before inserting template."
(setq prev group))) (setq prev group)))
;; Step 7: Create keymap overlay for snippet ;; Step 7: Create keymap overlay for snippet
(setf (yas/snippet-control-overlay snippet) (yas/make-control-overlay (point-min) (point-max))) (setf (yas/snippet-control-overlay snippet) (yas/make-control-overlay (point-min) (point-max)))
;; Step 8: Replace mirror field values with primary group's ;; Step 8: Replace mirror field values with primary group's
;; value ;; value
@ -1330,9 +1330,9 @@ when the condition evaluated to non-nil."
(goto-char (yas/field-start field))) (goto-char (yas/field-start field)))
(setf (yas/snippet-active-group snippet) group) (setf (yas/snippet-active-group snippet) group)
(setf (yas/snippet-active-field-overlay snippet) (setf (yas/snippet-active-field-overlay snippet)
(yas/move-overlay-and-field overlay field (yas/move-overlay-and-field overlay field
(yas/field-start field) (yas/field-start field)
(yas/field-end field))))) (yas/field-end field)))))
(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."
@ -1377,9 +1377,9 @@ up the snippet does not delete it!"
(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))
#'(lambda (fn) (add-hook hook-var fn 'append 'local))) #'(lambda (fn) (add-hook hook-var fn 'append 'local)))
fn-list)) fn-list))
(defun yas/register-snippet (snippet) (defun yas/register-snippet (snippet)
"Register SNIPPET in the `yas/registered-snippets' table. Add a "Register SNIPPET in the `yas/registered-snippets' table. Add a
@ -1394,15 +1394,15 @@ registered snippet exists in the current buffer. Return snippet"
;; setup the `pre-command-hook' ;; setup the `pre-command-hook'
;; ;;
(yas/add-remove-many-hooks 'pre-command-hook (yas/add-remove-many-hooks 'pre-command-hook
(list 'yas/clear-pending-undo-actions (list 'yas/clear-pending-undo-actions
'yas/save-active-group-boundaries)) 'yas/save-active-group-boundaries))
;; ;;
;; setup the `post-command-hook' ;; setup the `post-command-hook'
;; ;;
(yas/add-remove-many-hooks 'post-command-hook (yas/add-remove-many-hooks 'post-command-hook
(list 'yas/check-cleanup-snippet (list 'yas/check-cleanup-snippet
'yas/correct-undo-list 'yas/correct-undo-list
'yas/debug-some-vars)) 'yas/debug-some-vars))
snippet) snippet)
(defun yas/unregister-snippet (snippet) (defun yas/unregister-snippet (snippet)
@ -1414,14 +1414,14 @@ current buffer."
(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
(list 'yas/clear-pending-undo-actions (list 'yas/clear-pending-undo-actions
'yas/save-active-group-boundaries) 'yas/save-active-group-boundaries)
'remove) 'remove)
(yas/add-remove-many-hooks 'post-command-hook (yas/add-remove-many-hooks 'post-command-hook
(list 'yas/correct-undo-list (list 'yas/correct-undo-list
'yas/check-cleanup-snippet 'yas/check-cleanup-snippet
'yas/debug-some-vars) 'yas/debug-some-vars)
'remove))) 'remove)))
(defun yas/exterminate-snippets () (defun yas/exterminate-snippets ()
"Remove all locally registered snippets and remove "Remove all locally registered snippets and remove
@ -1440,8 +1440,8 @@ 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-beg
yas/snippet-end yas/snippet-end
saved-groups-and-boundaries) saved-groups-and-boundaries)
;; ;;
;; 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'
@ -1477,12 +1477,12 @@ 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
;; ;;
(setq yas/pending-undo-actions nil) (setq yas/pending-undo-actions (list
(yas/push-undo-action-maybe (list 'yas/revive-snippet (list 'above-all
snippet `(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)))))
;; ;;
;; 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
@ -1549,18 +1549,20 @@ performed in `yas/correct-undo-list', which is placed in the
;; ;;
;; Save boundaries of current field ;; Save boundaries of current field
;; ;;
(push (list 'yas/restore-group-boundaries (push (list 'after-first-action
group (list 'yas/restore-group-boundaries
snippet group
(overlay-start field-overlay) snippet
(overlay-end field-overlay)) (overlay-start 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 'yas/restore-active-group (push (list 'after-first-action
group (list 'yas/restore-active-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)
@ -1573,8 +1575,8 @@ performed in `yas/correct-undo-list', which is placed in the
;; ;;
(dolist (group (yas/snippet-groups snippet)) (dolist (group (yas/snippet-groups snippet))
(yas/restore-group-boundaries group snippet (yas/restore-group-boundaries group snippet
(yas/field-start (yas/group-primary-field group)) (yas/field-start (yas/group-primary-field group))
(yas/field-end (yas/group-primary-field group)))) (yas/field-end (yas/group-primary-field group))))
;; ;;
;; Move to the previously active group ;; Move to the previously active group
;; ;;
@ -1582,7 +1584,7 @@ performed in `yas/correct-undo-list', which is placed in the
;; ;;
;; Reregister this snippet ;; Reregister this snippet
;; ;;
(yas/register-snippet snipept)) (yas/register-snippet snippet))
(defun yas/restore-active-group (group snippet) (defun yas/restore-active-group (group snippet)
"..." "..."
@ -1605,42 +1607,45 @@ performed in `yas/correct-undo-list', which is placed in the
(<= point (yas/field-end field))))) (<= point (yas/field-end field)))))
(defun yas/correct-undo-list () (defun yas/correct-undo-list ()
(mapcar #'yas/push-undo-action-maybe yas/pending-undo-actions)) (mapcar #'(lambda (args)
(apply #'yas/push-undo-action-maybe args))
yas/pending-undo-actions))
(defun yas/push-undo-action-maybe (apply-args) (defun yas/push-undo-action-maybe (how apply-args &optional jump-first-separator)
"..." "..."
(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)
;; (cond ((eq how 'after-first-action)
;; Discard possibly existing/missing start separator ;;
;; ;; Discard possibly existing/missing start separator
(when (null (car undo-list)) ;;
(setq undo-list (cdr undo-list))) (when (null (car undo-list))
;; (setq undo-list (cdr undo-list)))
;; Find the target separator keeping `undo-list' as a reference to ;;
;; the list starting before that. ;; Find the target separator keeping `undo-list' as a reference to
;; ;; the list starting before that.
(while (not done) ;;
(cond ((eq (first apply-args) (while (not done)
(condition-case opps (cond ((eq (first apply-args)
(second (car undo-list)) (condition-case opps
(error nil))) (second (car undo-list))
(setq done 'return)) (error nil)))
((null (cadr undo-list)) (setq done 'return))
(setq done 'try-insert)) ((null (cadr undo-list))
(t (setq done 'try-insert))
(setq undo-list (cdr undo-list))))) (t
(unless (eq done 'return) (setq undo-list (cdr undo-list)))))
;; (unless (eq done 'return)
;; Push a the apply-args action there ;;
;; ;; Push a the apply-args action there
(setq target-separator (cdr undo-list)) ;;
(setf (cdr undo-list) (setq target-separator (cdr undo-list))
(cons (cons 'apply (setf (cdr undo-list)
apply-args) (cons (cons 'apply
target-separator)))))) apply-args)
target-separator))))))))
(defun yas/sanitize-undo-redo () (defun yas/sanitize-undo-redo ()
(let ((undo-list buffer-undo-list) (let ((undo-list buffer-undo-list)
@ -1657,7 +1662,7 @@ performed in `yas/correct-undo-list', which is placed in the
(> (cdr elem) (point-max))) (> (cdr elem) (point-max)))
(prog1 t (prog1 t
(message "Deleting %s in the undo-list (greater than point-max=%s)!!!" (message "Deleting %s in the undo-list (greater than point-max=%s)!!!"
elem (point-max))))) elem (point-max)))))
undo-list undo-list
:end (position nil undo-list))))) :end (position nil undo-list)))))