* snippet.el (snippet--post-command-hook): Robustify snippet exit
logic.
(snippet-exit-snippet): Just schedule and exit, but don't exit
directly.
(snippet--activate-snippet): Initialise `snippet--exit-reason' to
nil.
(snippet--activate-snippet): Add to post-command-hook locally.
(snippet--describe-object, snippet--debug-snippet): Fix whitespace
This commit is contained in:
João Távora 2015-04-04 13:15:59 +01:00
parent 91a0b281c7
commit d92a479263

View File

@ -620,7 +620,7 @@ PREV means move to the previous field."
(goto-char (if (markerp exit) (goto-char (if (markerp exit)
exit exit
(snippet--object-start exit)))) (snippet--object-start exit))))
(snippet-exit-snippet)))) (snippet-exit-snippet "moved to exit"))))
(defun snippet-prev-field () (defun snippet-prev-field ()
"Move the the start of the previous field in the current snippet. "Move the the start of the previous field in the current snippet.
@ -630,11 +630,7 @@ Skips over nested fields if their parent has been modified."
(snippet-next-field t)) (snippet-next-field t))
(defun snippet-exit-snippet (&optional reason) (defun snippet-exit-snippet (&optional reason)
(delete-overlay snippet--field-overlay) (overlay-put snippet--field-overlay 'snippet--exit-reason reason))
(message "snippet exited%s"
(or (and reason
(format " (%s)" reason))
"")))
;;; Main ;;; Main
@ -669,6 +665,7 @@ Skips over nested fields if their parent has been modified."
(overlay-put overlay 'snippet--objects objects) (overlay-put overlay 'snippet--objects objects)
(overlay-put overlay 'snippet--fields fields) (overlay-put overlay 'snippet--fields fields)
(overlay-put overlay 'snippet--exit exit) (overlay-put overlay 'snippet--exit exit)
(overlay-put overlay 'snippet--exit-reason nil)
(overlay-put overlay 'face ' snippet-field-face) (overlay-put overlay 'face ' snippet-field-face)
(overlay-put overlay (overlay-put overlay
'modification-hooks 'modification-hooks
@ -684,30 +681,57 @@ Skips over nested fields if their parent has been modified."
snippet-field-keymap) snippet-field-keymap)
overlay)) overlay))
(snippet-next-field) (snippet-next-field)
(add-hook 'post-command-hook 'snippet--post-command-hook t))) (add-hook 'post-command-hook 'snippet--post-command-hook 'append 'local)))
(defun snippet--post-command-hook () (defun snippet--post-command-hook ()
(cond ((and snippet--field-overlay ;; TODO: exiting the snippet might someday run user-provided code, hence the
(overlay-buffer snippet--field-overlay)) ;; apparent overengineeredness
(cond ((or (< (point) ;;
(let ((remove-self "unknown reason")
(exit-reason nil))
(cond
((and snippet--field-overlay
(not (overlay-buffer snippet--field-overlay)))
;; Something deleted the overlay
(setq remove-self t
exit-reason "overlay destroyed"))
(snippet--field-overlay
(setq exit-reason
(or (overlay-get snippet--field-overlay
'snippet--exit-reason)
(and (or (< (point)
(overlay-start snippet--field-overlay)) (overlay-start snippet--field-overlay))
(> (point) (> (point)
(overlay-end snippet--field-overlay))) (overlay-end snippet--field-overlay)))
(snippet-exit-snippet "point left snippet") "point left snippet")))
(remove-hook 'post-command-hook 'snippet--post-command-hook t)) (setq remove-self (and exit-reason t)))
(snippet--debug (t
(snippet--debug-snippet snippet--field-overlay)))) (setq remove-self "shouldn't be there"
(snippet--field-overlay exit-reason "no overlay")))
;; snippet must have been exited for some other reason (when remove-self
(unless (eq remove-self t)
(display-warning
'snippet
(format "Forced remove snippet--post-command-hook (%s)" remove-self))
;; in this case, even try to remove if globally
;; ;;
(remove-hook 'post-command-hook 'snippet--post-command-hook t)))) (remove-hook 'post-command-hook 'snippet--post-command-hook))
(remove-hook 'post-command-hook 'snippet--post-command-hook 'local))
(if (and snippet--debug snippet--field-overlay)
(snippet--debug-snippet snippet--field-overlay))
(when exit-reason
(when snippet--field-overlay
(delete-overlay snippet--field-overlay)
(setq snippet--field-overlay nil))
(message "snippet exited (%s)" exit-reason))))
;;; Debug helpers ;;; Debug helpers
;;; ;;;
(cl-defmethod snippet--describe-object ((object snippet--object) &key _short) (cl-defmethod snippet--describe-object ((object snippet--object) &key _short)
(with-current-buffer (snippet--object-buffer object) (with-current-buffer (snippet--object-buffer object)
(format "covering \"%s\"\n from %s\n to %s\n next: %s\n prev: %s\n parent: %s" (format
"covering \"%s\"\n from %s\n to %s\n next: %s\n prev: %s\n parent: %s"
(propertize (buffer-substring (propertize (buffer-substring
(snippet--object-start object) (snippet--object-start object)
(snippet--object-end object)) (snippet--object-end object))
@ -747,7 +771,8 @@ Skips over nested fields if their parent has been modified."
(with-current-buffer (get-buffer-create "*snippet-debug*") (with-current-buffer (get-buffer-create "*snippet-debug*")
(let ((inhibit-read-only t) (let ((inhibit-read-only t)
(sorted (cl-sort (cl-copy-list (sorted (cl-sort (cl-copy-list
(overlay-get field-overlay 'snippet--objects)) #'< (overlay-get field-overlay 'snippet--objects))
#'<
:key #'snippet--object-start))) :key #'snippet--object-start)))
(erase-buffer) (erase-buffer)
(cl-loop for object in sorted (cl-loop for object in sorted
@ -759,6 +784,7 @@ Skips over nested fields if their parent has been modified."
;; Local Variables: ;; Local Variables:
;; coding: utf-8 ;; coding: utf-8
;; whitespace-mode: t
;; whitespace-style: (face lines-tail) ;; whitespace-style: (face lines-tail)
;; whitespace-line-column: 80 ;; whitespace-line-column: 80
;; fill-column: 80 ;; fill-column: 80