From c98672eb54a72530c4594999624bef54b44bf432 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 4 Dec 2016 00:28:18 -0500 Subject: [PATCH 1/6] Fixup yasnippet-debug.el * yasnippet-debug.el: Replace cl with cl-lib, replace yas--snippets-at-point with yas-active-snippets. --- yasnippet-debug.el | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/yasnippet-debug.el b/yasnippet-debug.el index b12bcd4..92950cc 100644 --- a/yasnippet-debug.el +++ b/yasnippet-debug.el @@ -25,7 +25,7 @@ ;;; Code: (require 'yasnippet) -(require 'cl) +(require 'cl-lib) (defun yas-debug-snippet-vars () "Debug snippets, fields, mirrors and the `buffer-undo-list'." @@ -36,12 +36,12 @@ (princ (format "\nPost command hook: %s\n" post-command-hook)) (princ (format "\nPre command hook: %s\n" pre-command-hook)) - (princ (format "%s live snippets in total\n" (length (yas--snippets-at-point (quote all-snippets))))) + (princ (format "%s live snippets in total\n" (length (yas-active-snippets 'all-snippets)))) (princ (format "%s overlays in buffer:\n\n" (length (overlays-in (point-min) (point-max))))) - (princ (format "%s live snippets at point:\n\n" (length (yas--snippets-at-point)))) + (princ (format "%s live snippets at point:\n\n" (length (yas-active-snippets)))) - (dolist (snippet (yas--snippets-at-point)) + (dolist (snippet (yas-active-snippets)) (princ (format "\tsid: %d control overlay from %d to %d\n" (yas--snippet-id snippet) (overlay-start (yas--snippet-control-overlay snippet)) @@ -76,11 +76,13 @@ "ENABLED") (point-max))) (unless (eq buffer-undo-list t) - (princ (format "Undpolist has %s elements. First 10 elements follow:\n" (length buffer-undo-list))) - (let ((first-ten (subseq buffer-undo-list 0 (min 19 - (length buffer-undo-list))))) + (princ (format "Undpolist has %s elements. First 10 elements follow:\n" + (length buffer-undo-list))) + (let ((first-ten (cl-subseq buffer-undo-list 0 + (min 19 (length buffer-undo-list))))) (dolist (undo-elem first-ten) - (princ (format "%2s: %s\n" (position undo-elem first-ten) (truncate-string-to-width (format "%s" undo-elem) 70)))))))) + (princ (format "%2s: %s\n" (cl-position undo-elem first-ten) + (truncate-string-to-width (format "%s" undo-elem) 70)))))))) (defun yas--debug-format-fom-concise (fom) (when fom @@ -108,12 +110,11 @@ (defun yas-debug-test (&optional quiet) (interactive "P") - (yas-load-directory (or (and (listp yas-snippet-dirs) - (first yas-snippet-dirs)) + (yas-load-directory (or (car-safe yas-snippet-dirs) yas-snippet-dirs "~/Source/yasnippet/snippets/")) (set-buffer (switch-to-buffer "*YAS TEST*")) - (mapc #'yas--commit-snippet (yas--snippets-at-point 'all-snippets)) + (mapc #'yas--commit-snippet (yas-active-snippets 'all-snippets)) (erase-buffer) (setq buffer-undo-list nil) (setq undo-in-progress nil) @@ -128,6 +129,5 @@ (provide 'yasnippet-debug) ;; Local Variables: ;; indent-tabs-mode: nil -;; byte-compile-warnings: (not cl-functions) ;; End: ;;; yasnippet-debug.el ends here From 274406ee44f76a5a3cbd420f2afcd880108c51b2 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 4 Dec 2016 13:12:14 -0500 Subject: [PATCH 2/6] Provide command line interface from yasnippet-debug.el yasnippet-debug.el can now be used to quickly test and debug a snippet in a file. * Rakefile (itests): New target, runs tests interactively. * yasnippet-debug.el: Set lexical binding. (when-let): Backwards compabtility definition. (yas-debug-live-indicators, yas-debug-live-colors) (yas-debug-recently-live-indicators, yas-debug-get-live-indicator) (yas-debug-live-marker, yas-debug-ov-fom-start, yas-debug-ov-fom-end) (yas-debug-live-range, yas-debug-with-tracebuf, yas-debug-snippet) (yas-debug-target-buffer, yas-debug-target-snippets) (yas-debug-snippets, yas-debug-process-command-line): New functions and variables. (yas-debug-test): Remove. * yasnippet.el (yas--snippet-revive): List snippet identifier in debug message. (yas--post-command-handler): Allow the debugger to run. --- Rakefile | 6 + yasnippet-debug.el | 351 ++++++++++++++++++++++++++++++++++++--------- yasnippet.el | 46 +++--- 3 files changed, 313 insertions(+), 90 deletions(-) diff --git a/Rakefile b/Rakefile index e2bb4f7..85133e6 100644 --- a/Rakefile +++ b/Rakefile @@ -20,6 +20,12 @@ task :tests do " --batch -f ert-run-tests-batch-and-exit" end +desc "run test in interactive mode" +task :itests do + sh "#{$EMACS} -Q -L . -l yasnippet-tests.el" + + " --eval \"(call-interactively 'ert)\"" +end + desc "create a release package" task :package do release_dir = "pkg/yasnippet-#{$version}" diff --git a/yasnippet-debug.el b/yasnippet-debug.el index 92950cc..c080a11 100644 --- a/yasnippet-debug.el +++ b/yasnippet-debug.el @@ -1,8 +1,8 @@ -;;; yasnippet-debug.el --- debug functions for yasnippet +;;; yasnippet-debug.el --- debug functions for yasnippet -*- lexical-binding: t -*- ;; Copyright (C) 2010, 2013, 2014 Free Software Foundation, Inc. -;; Author: João Távora +;; Author: João Távora ;; Keywords: emulations, convenience ;; This program is free software; you can redistribute it and/or modify @@ -20,69 +20,258 @@ ;;; Commentary: -;; Just some debug functions - +;; Some debug functions. When loaded from the command line, provides +;; quick way to test out snippets in a fresh Emacs instance. +;; +;; emacs -Q -l yasnippet-debug [-v[v]] +;; [-M:] [-M.] [-S:[]] +;; [-- ...] +;; +;; See the source in `yas-debug-process-command-line' for meaning of +;; args. +;; ;;; Code: -(require 'yasnippet) +(defconst yas--loaddir + (file-name-directory (or load-file-name buffer-file-name)) + "Directory that yasnippet was loaded from.") + +(require 'yasnippet (expand-file-name "yasnippet" yas--loaddir)) (require 'cl-lib) +(eval-when-compile + (unless (require 'subr-x nil t) + (defmacro when-let (key-val &rest body) + (declare (indent 1) (debug ((symbolp form) body))) + `(let ((,(car key-val) ,(cadr key-val))) + (when ,(car key-val) + ,@body))))) + +(defvar yas-debug-live-indicators + (make-hash-table :test #'eq)) + +(defun yas-debug-live-colors () + (let ((colors ())) + (maphash (lambda (_k v) (push (nth 1 (car v)) colors)) yas-debug-live-indicators) + colors)) + +(defvar yas-debug-recently-live-indicators) + +(defun yas-debug-get-live-indicator (location) + (require 'color) + (when (boundp 'yas-debug-recently-live-indicators) + (push location yas-debug-recently-live-indicators)) + (let (beg end) + (if (markerp location) + (setq beg (setq end (marker-position location))) + (setq beg (yas-debug-ov-fom-start location) + end (yas-debug-ov-fom-end location))) + (or (when-let (color-ov (gethash location yas-debug-live-indicators)) + (if (and beg end) (move-overlay (cdr color-ov) beg end) + (delete-overlay (cdr color-ov))) + color-ov) + (let* ((live-colors (yas-debug-live-colors)) + (color + (cl-loop with best-color = nil with max-dist = -1 + for color = (format "#%06X" (random #x1000000)) + for comp = (apply #'color-rgb-to-hex (color-complement color)) + if (< (color-distance color (face-foreground 'default)) + (color-distance comp (face-foreground 'default))) + do (setq color comp) + for dist = (cl-loop for c in live-colors + minimize (color-distance c color)) + if (or (not live-colors) (> dist max-dist)) + do (setq best-color color) (setq max-dist dist) + repeat (if live-colors 100 1) + finally return `(:background ,best-color))) + (ov (make-overlay beg end))) + (if (markerp location) + (overlay-put ov 'before-string (propertize "↓" 'face color)) + (overlay-put ov 'before-string (propertize "↘" 'face color)) + (overlay-put ov 'after-string (propertize "↙" 'face color))) + (puthash location (cons color ov) yas-debug-live-indicators))))) + +(defun yas-debug-live-marker (marker) + (let* ((buffer (current-buffer)) + (color-ov (yas-debug-get-live-indicator marker)) + (color (car color-ov)) + (ov (cdr color-ov)) + (decorator (overlay-get ov 'before-string))) + (propertize (format "at %d" (marker-position marker)) + 'cursor-sensor-functions + `(,(lambda (window _oldpos dir) + (overlay-put + ov 'before-string + (propertize decorator + 'face (if (eq dir 'entered) + 'mode-line-highlight color))))) + 'face color))) + +(defun yas-debug-ov-fom-start (ovfom) + (if (overlayp ovfom) (overlay-start ovfom) + (let ((m (yas--fom-start ovfom))) + (when (markerp m) (marker-position m))))) +(defun yas-debug-ov-fom-end (ovfom) + (if (overlayp ovfom) (overlay-end ovfom) + (let ((m (yas--fom-end ovfom))) + (when (markerp m) (marker-position m))))) + +(defun yas-debug-live-range (range) + (let* ((color-ov (yas-debug-get-live-indicator range)) + (color (car color-ov)) + (ov (cdr color-ov)) + (decorator-beg (overlay-get ov 'before-string)) + (decorator-end (overlay-get ov 'after-string)) + (beg (yas-debug-ov-fom-start range)) + (end (yas-debug-ov-fom-end range))) + (if (and beg end) + (propertize (format "from %d to %d" beg end) + 'cursor-sensor-functions + `(,(lambda (window _oldpos dir) + (let ((face (if (eq dir 'entered) + 'mode-line-highlight color))) + (overlay-put ov 'before-string + (propertize decorator-beg 'face face)) + (overlay-put ov 'after-string + (propertize decorator-end 'face face))))) + 'face color) + ""))) + +(defmacro yas-debug-with-tracebuf (outbuf &rest body) + (declare (indent 1)) + (let ((tracebuf-var (make-symbol "tracebuf"))) + `(let ((,tracebuf-var (or ,outbuf (get-buffer-create "*YASnippet trace*")))) + (unless (eq ,tracebuf-var (current-buffer)) + (cl-flet ((printf (fmt &rest args) + (with-current-buffer ,tracebuf-var + (insert (apply #'format fmt args))))) + (unless ,outbuf + (with-current-buffer ,tracebuf-var + (erase-buffer) + (when (fboundp 'cursor-sensor-mode) + (cursor-sensor-mode +1)) + (setq truncate-lines t))) + (setq ,outbuf ,tracebuf-var) + (save-restriction + (widen) + ,@body)))))) + + +(defun yas-debug-snippet (snippet &optional outbuf) + (yas-debug-with-tracebuf outbuf + (when-let (overlay (yas--snippet-control-overlay snippet)) + (printf "\tsid: %d control overlay %s\n" + (yas--snippet-id snippet) + (yas-debug-live-range overlay))) + (when-let (active-field (yas--snippet-active-field snippet)) + (unless (consp (yas--field-start active-field)) + (printf "\tactive field: #%d %s covering \"%s\"\n" + (yas--field-number active-field) + (yas-debug-live-range active-field) + (buffer-substring-no-properties (yas--field-start active-field) (yas--field-end active-field))))) + (when-let (exit (yas--snippet-exit snippet)) + (printf "\tsnippet-exit: %s next: %s\n" + (yas-debug-live-marker (yas--exit-marker exit)) + (yas--exit-next exit))) + (dolist (field (yas--snippet-fields snippet)) + (unless (consp (yas--field-start field)) + (printf "\tfield: %d %s covering \"%s\" next: %s%s\n" + (yas--field-number field) + (yas-debug-live-range field) + (buffer-substring-no-properties (yas--field-start field) (yas--field-end field)) + (yas--debug-format-fom-concise (yas--field-next field)) + (if (yas--field-parent-field field) "(has a parent)" ""))) + (dolist (mirror (yas--field-mirrors field)) + (unless (consp (yas--mirror-start mirror)) + (printf "\t\tmirror: %s covering \"%s\" next: %s\n" + (yas-debug-live-range mirror) + (buffer-substring-no-properties (yas--mirror-start mirror) (yas--mirror-end mirror)) + (yas--debug-format-fom-concise (yas--mirror-next mirror)))))))) + +(defvar yas-debug-target-buffer nil) +(defvar-local yas-debug-target-snippets nil) + +(defadvice yas--snippet-parse-create (before yas-debug-target-snippet (snippet)) + (add-to-list 'yas-debug-target-snippets snippet)) + +(defadvice yas--commit-snippet (after yas-debug-untarget-snippet (snippet)) + (setq yas-debug-target-snippets + (remq snippet yas-debug-target-snippets)) + (maphash (lambda (k color-ov) + (delete-overlay (cdr color-ov))) + yas-debug-live-indicators) + (clrhash yas-debug-live-indicators)) + +(defun yas-debug-snippets (&optional outbuf hook) + (interactive (list nil t)) + (condition-case err + (yas-debug-with-tracebuf outbuf + (unless (buffer-live-p yas-debug-target-buffer) + (setq yas-debug-target-buffer nil)) + (with-current-buffer (or yas-debug-target-buffer (current-buffer)) + (when yas-debug-target-snippets + (setq yas-debug-target-snippets + (cl-delete-if-not #'yas--snippet-p yas-debug-target-snippets))) + (let ((yas-debug-recently-live-indicators nil)) + (dolist (snippet (or yas-debug-target-snippets + (yas-active-snippets))) + (printf "snippet %d\n" (yas--snippet-id snippet)) + (yas-debug-snippet snippet outbuf)) + (maphash (lambda (loc color-ov) + (unless (memq loc yas-debug-recently-live-indicators) + (delete-overlay (cdr color-ov)) + (remhash loc yas-debug-live-indicators))) + yas-debug-live-indicators))) + (when hook + (setq yas-debug-target-buffer (current-buffer)) + (ad-enable-advice 'yas--snippet-parse-create 'before 'yas-debug-target-snippet) + (ad-activate 'yas--snippet-parse-create) + (ad-enable-advice 'yas--commit-snippet 'after 'yas-debug-untarget-snippet) + (ad-activate 'yas--commit-snippet) + (add-hook 'post-command-hook #'yas-debug-snippets) + ;; Window management is slapped together, it does what I + ;; want when the caller has a single window open. Good + ;; enough for now. + (when (eq hook 'create) + (require 'edebug) + (edebug-instrument-function 'yas--snippet-parse-create) + (let ((buf-point (find-function-noselect 'yas--snippet-parse-create))) + (with-current-buffer (car buf-point) + (goto-char (cdr buf-point))))) + outbuf)) + ((debug error) (signal (car err) (cdr err))))) + +(defun yas-debug-snippet-create () + (yas-debug-snippets nil 'create)) (defun yas-debug-snippet-vars () "Debug snippets, fields, mirrors and the `buffer-undo-list'." (interactive) - (with-output-to-temp-buffer "*YASnippet trace*" - (princ "Interesting YASnippet vars: \n\n") + (yas-debug-with-tracebuf () + (printf "Interesting YASnippet vars: \n\n") - (princ (format "\nPost command hook: %s\n" post-command-hook)) - (princ (format "\nPre command hook: %s\n" pre-command-hook)) + (printf "\nPost command hook: %s\n" post-command-hook) + (printf "\nPre command hook: %s\n" pre-command-hook) - (princ (format "%s live snippets in total\n" (length (yas-active-snippets 'all-snippets)))) - (princ (format "%s overlays in buffer:\n\n" (length (overlays-in (point-min) (point-max))))) - (princ (format "%s live snippets at point:\n\n" (length (yas-active-snippets)))) + (printf "%s live snippets in total\n" (length (yas-active-snippets 'all-snippets))) + (printf "%s overlays in buffer:\n\n" (length (overlays-in (point-min) (point-max)))) + (printf "%s live snippets at point:\n\n" (length (yas-active-snippets))) + (yas-debug-snippets outbuf) - (dolist (snippet (yas-active-snippets)) - (princ (format "\tsid: %d control overlay from %d to %d\n" - (yas--snippet-id snippet) - (overlay-start (yas--snippet-control-overlay snippet)) - (overlay-end (yas--snippet-control-overlay snippet)))) - (princ (format "\tactive field: %s from %s to %s covering \"%s\"\n" - (yas--field-number (yas--snippet-active-field snippet)) - (marker-position (yas--field-start (yas--snippet-active-field snippet))) - (marker-position (yas--field-end (yas--snippet-active-field snippet))) - (buffer-substring-no-properties (yas--field-start (yas--snippet-active-field snippet)) (yas--field-end (yas--snippet-active-field snippet))))) - (when (yas--snippet-exit snippet) - (princ (format "\tsnippet-exit: at %s next: %s\n" - (yas--exit-marker (yas--snippet-exit snippet)) - (yas--exit-next (yas--snippet-exit snippet))))) - (dolist (field (yas--snippet-fields snippet)) - (princ (format "\tfield: %s from %s to %s covering \"%s\" next: %s%s\n" - (yas--field-number field) - (marker-position (yas--field-start field)) - (marker-position (yas--field-end field)) - (buffer-substring-no-properties (yas--field-start field) (yas--field-end field)) - (yas--debug-format-fom-concise (yas--field-next field)) - (if (yas--field-parent-field field) "(has a parent)" ""))) - (dolist (mirror (yas--field-mirrors field)) - (princ (format "\t\tmirror: from %s to %s covering \"%s\" next: %s\n" - (marker-position (yas--mirror-start mirror)) - (marker-position (yas--mirror-end mirror)) - (buffer-substring-no-properties (yas--mirror-start mirror) (yas--mirror-end mirror)) - (yas--debug-format-fom-concise (yas--mirror-next mirror))))))) - - (princ (format "\nUndo is %s and point-max is %s.\n" - (if (eq buffer-undo-list t) - "DISABLED" - "ENABLED") - (point-max))) + (printf "\nUndo is %s and point-max is %s.\n" + (if (eq buffer-undo-list t) + "DISABLED" + "ENABLED") + (point-max)) (unless (eq buffer-undo-list t) - (princ (format "Undpolist has %s elements. First 10 elements follow:\n" - (length buffer-undo-list))) + (printf "Undpolist has %s elements. First 10 elements follow:\n" + (length buffer-undo-list)) (let ((first-ten (cl-subseq buffer-undo-list 0 (min 19 (length buffer-undo-list))))) (dolist (undo-elem first-ten) - (princ (format "%2s: %s\n" (cl-position undo-elem first-ten) - (truncate-string-to-width (format "%s" undo-elem) 70)))))))) + (printf "%2s: %s\n" (cl-position undo-elem first-ten) + (truncate-string-to-width (format "%s" undo-elem) 70))))) + (display-buffer tracebuf))) (defun yas--debug-format-fom-concise (fom) (when fom @@ -99,6 +288,50 @@ (format "snippet exit at %d" (marker-position (yas--fom-start fom))))))) +(defun yas-debug-process-command-line () + "Implement command line processing." + (setq yas-verbosity 99) + (setq yas-triggers-in-field t) + (setq debug-on-error t) + (let* ((snippet-file nil) + (snippet-mode 'fundamental-mode) + (options (cl-loop for opt = (pop command-line-args-left) + while (and opt (not (equal opt "--")) + (string-prefix-p "-" opt)) + collect opt)) + (snippet-key nil)) + (when-let (mode (cl-member "-M:" options :test #'string-prefix-p)) + (setq snippet-mode (intern (concat (substring (car mode) 3) "-mode")))) + (when-let (mode (cl-member "-M." options :test #'string-prefix-p)) + (setq snippet-mode + (cdr (cl-assoc (substring (car mode) 2) auto-mode-alist + :test (lambda (ext regexp) (string-match-p regexp ext)))))) + (switch-to-buffer (get-buffer-create "*yas test*")) + (funcall snippet-mode) + (when-let (snippet-file (cl-member "-S:" options :test #'string-prefix-p)) + (setq snippet-file (substring (car snippet-file) 3)) + (if (file-exists-p snippet-file) + (with-temp-buffer + (insert-file-contents snippet-file) + (let ((snippet-deflist (yas--parse-template snippet-file))) + (yas-define-snippets snippet-mode (list snippet-deflist)) + (setq snippet-key (car snippet-deflist)))) + (yas-reload-all) + (let ((template (yas--lookup-snippet-1 snippet-file snippet-mode))) + (if template + (setq snippet-key (yas--template-key template)) + (error "No such snippet `%s'" snippet-file))))) + (display-buffer (find-file-noselect + (expand-file-name "yasnippet.el" yas--loaddir))) + (when-let (verbosity (car (or (member "-v" options) (member "-vv" options)))) + (set-window-buffer + (split-window) (yas-debug-snippets + nil (if (equal verbosity "-vv") 'create t)))) + (yas-minor-mode +1) + (when snippet-key (insert snippet-key)))) + +(when command-line-args-left + (yas-debug-process-command-line)) (defun yas-exterminate-package () (interactive) @@ -108,24 +341,6 @@ (when (string-match "yas[-/]" (symbol-name atom)) (unintern atom obarray))))) -(defun yas-debug-test (&optional quiet) - (interactive "P") - (yas-load-directory (or (car-safe yas-snippet-dirs) - yas-snippet-dirs - "~/Source/yasnippet/snippets/")) - (set-buffer (switch-to-buffer "*YAS TEST*")) - (mapc #'yas--commit-snippet (yas-active-snippets 'all-snippets)) - (erase-buffer) - (setq buffer-undo-list nil) - (setq undo-in-progress nil) - (snippet-mode) - (yas-minor-mode 1) - (let ((abbrev)) - (setq abbrev "$f") - (insert abbrev)) - (unless quiet - (add-hook 'post-command-hook 'yas-debug-snippet-vars 't 'local))) - (provide 'yasnippet-debug) ;; Local Variables: ;; indent-tabs-mode: nil diff --git a/yasnippet.el b/yasnippet.el index 69f7381..4751209 100644 --- a/yasnippet.el +++ b/yasnippet.el @@ -3828,7 +3828,7 @@ considered when expanding the snippet." (sit-for 0) ;; fix issue 125 (yas--letenv (yas--snippet-expand-env snippet) (yas--move-to-field snippet first-field)))) - (yas--message 4 "snippet expanded.") + (yas--message 4 "snippet %d expanded." (yas--snippet-id snippet)) (setq deactivate-mark nil) t)))) @@ -4601,27 +4601,29 @@ When multiple expressions are found, only the last one counts." ;; (defun yas--post-command-handler () "Handles various yasnippet conditions after each command." - (yas--finish-moving-snippets) - (cond ((eq 'undo this-command) - ;; - ;; After undo revival the correct field is sometimes not - ;; restored correctly, this condition handles that - ;; - (let* ((snippet (car (yas-active-snippets))) - (target-field - (and snippet - (cl-find-if-not - (lambda (field) - (yas--field-probably-deleted-p snippet field)) - (remq nil - (cons (yas--snippet-active-field snippet) - (yas--snippet-fields snippet))))))) - (when target-field - (yas--move-to-field snippet target-field)))) - ((not (yas--undo-in-progress)) - ;; When not in an undo, check if we must commit the snippet - ;; (user exited it). - (yas--check-commit-snippet)))) + (condition-case err + (progn (yas--finish-moving-snippets) + (cond ((eq 'undo this-command) + ;; + ;; After undo revival the correct field is sometimes not + ;; restored correctly, this condition handles that + ;; + (let* ((snippet (car (yas-active-snippets))) + (target-field + (and snippet + (cl-find-if-not + (lambda (field) + (yas--field-probably-deleted-p snippet field)) + (remq nil + (cons (yas--snippet-active-field snippet) + (yas--snippet-fields snippet))))))) + (when target-field + (yas--move-to-field snippet target-field)))) + ((not (yas--undo-in-progress)) + ;; When not in an undo, check if we must commit the snippet + ;; (user exited it). + (yas--check-commit-snippet)))) + ((debug error) (signal (car err) (cdr err))))) ;;; Fancy docs: ;; From 2f5cb2e2ef892595a0c8d634be401718f9d0771c Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 11 May 2017 07:56:42 -0400 Subject: [PATCH 3/6] Make yas-debug-process-command-line easier to debug * yasnippet-debug.el (yas-debug-process-command-line): Allow giving options programatically --- yasnippet-debug.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/yasnippet-debug.el b/yasnippet-debug.el index c080a11..ac0d237 100644 --- a/yasnippet-debug.el +++ b/yasnippet-debug.el @@ -288,18 +288,19 @@ (format "snippet exit at %d" (marker-position (yas--fom-start fom))))))) -(defun yas-debug-process-command-line () +(defun yas-debug-process-command-line (&optional options) "Implement command line processing." (setq yas-verbosity 99) (setq yas-triggers-in-field t) (setq debug-on-error t) (let* ((snippet-file nil) (snippet-mode 'fundamental-mode) - (options (cl-loop for opt = (pop command-line-args-left) - while (and opt (not (equal opt "--")) - (string-prefix-p "-" opt)) - collect opt)) (snippet-key nil)) + (unless options + (setq options (cl-loop for opt = (pop command-line-args-left) + while (and opt (not (equal opt "--")) + (string-prefix-p "-" opt)) + collect opt))) (when-let (mode (cl-member "-M:" options :test #'string-prefix-p)) (setq snippet-mode (intern (concat (substring (car mode) 3) "-mode")))) (when-let (mode (cl-member "-M." options :test #'string-prefix-p)) From 7b03ac2030ed5a63d352f1a8142dee0cac7439e0 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Tue, 16 May 2017 21:37:04 -0400 Subject: [PATCH 4/6] Handle dead snippets better * yasnippet-debug.el (yas-debug-live-marker) (yas-debug-ov-fom-start, yas-debug-ov-fom-end) (yas-debug-live-range, yas--debug-format-fom-concise): Don't assume snippet has markers, it could have been converted to integer position. --- yasnippet-debug.el | 49 ++++++++++++++++++++++++---------------------- 1 file changed, 26 insertions(+), 23 deletions(-) diff --git a/yasnippet-debug.el b/yasnippet-debug.el index ac0d237..65b773f 100644 --- a/yasnippet-debug.el +++ b/yasnippet-debug.el @@ -95,25 +95,28 @@ (color-ov (yas-debug-get-live-indicator marker)) (color (car color-ov)) (ov (cdr color-ov)) - (decorator (overlay-get ov 'before-string))) - (propertize (format "at %d" (marker-position marker)) - 'cursor-sensor-functions - `(,(lambda (window _oldpos dir) - (overlay-put - ov 'before-string - (propertize decorator - 'face (if (eq dir 'entered) - 'mode-line-highlight color))))) - 'face color))) + (decorator (overlay-get ov 'before-string)) + (str (format "at %d" (+ marker)))) + (if (markerp marker) + (propertize str + 'cursor-sensor-functions + `(,(lambda (window _oldpos dir) + (overlay-put + ov 'before-string + (propertize decorator + 'face (if (eq dir 'entered) + 'mode-line-highlight color))))) + 'face color) + str))) (defun yas-debug-ov-fom-start (ovfom) - (if (overlayp ovfom) (overlay-start ovfom) - (let ((m (yas--fom-start ovfom))) - (when (markerp m) (marker-position m))))) + (cond ((overlayp ovfom) (overlay-start ovfom)) + ((integerp ovfom) ovfom) + (t (yas--fom-start ovfom)))) (defun yas-debug-ov-fom-end (ovfom) - (if (overlayp ovfom) (overlay-end ovfom) - (let ((m (yas--fom-end ovfom))) - (when (markerp m) (marker-position m))))) + (cond ((overlayp ovfom) (overlay-end ovfom)) + ((integerp ovfom) ovfom) + (t (yas--fom-end ovfom)))) (defun yas-debug-live-range (range) (let* ((color-ov (yas-debug-get-live-indicator range)) @@ -123,8 +126,8 @@ (decorator-end (overlay-get ov 'after-string)) (beg (yas-debug-ov-fom-start range)) (end (yas-debug-ov-fom-end range))) - (if (and beg end) - (propertize (format "from %d to %d" beg end) + (if (and beg end (not (integerp beg)) (not (integerp end))) + (propertize (format "from %d to %d" (+ beg) (+ end)) 'cursor-sensor-functions `(,(lambda (window _oldpos dir) (let ((face (if (eq dir 'entered) @@ -278,15 +281,15 @@ (cond ((yas--field-p fom) (format "field %s from %d to %d" (yas--field-number fom) - (marker-position (yas--field-start fom)) - (marker-position (yas--field-end fom)))) + (+ (yas--field-start fom)) + (+ (yas--field-end fom)))) ((yas--mirror-p fom) (format "mirror from %d to %d" - (marker-position (yas--mirror-start fom)) - (marker-position (yas--mirror-end fom)))) + (+ (yas--mirror-start fom)) + (+ (yas--mirror-end fom)))) (t (format "snippet exit at %d" - (marker-position (yas--fom-start fom))))))) + (+ (yas--fom-start fom))))))) (defun yas-debug-process-command-line (&optional options) "Implement command line processing." From b0e729b1decbef605e59dc906897c9c84affbdfe Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 1 Jun 2017 22:04:51 -0400 Subject: [PATCH 5/6] Optionally add undo list to debug info * yasnippet-debug.el (yas-debug-undo): New variable. (yas-toggle-debug-undo): New command. (yas-debug-snippets): Print undo list if `yas-debug-undo' is non-nil. --- yasnippet-debug.el | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/yasnippet-debug.el b/yasnippet-debug.el index 65b773f..f198219 100644 --- a/yasnippet-debug.el +++ b/yasnippet-debug.el @@ -192,6 +192,12 @@ (defvar yas-debug-target-buffer nil) (defvar-local yas-debug-target-snippets nil) +(defvar yas-debug-undo nil) + +(defun yas-toggle-debug-undo (value) + (interactive (list (not yas-debug-undo))) + (setq yas-debug-undo value) + (yas--message 3 "debug undo %sabled" (if yas-debug-undo "en" "dis"))) (defadvice yas--snippet-parse-create (before yas-debug-target-snippet (snippet)) (add-to-list 'yas-debug-target-snippets snippet)) @@ -223,7 +229,11 @@ (unless (memq loc yas-debug-recently-live-indicators) (delete-overlay (cdr color-ov)) (remhash loc yas-debug-live-indicators))) - yas-debug-live-indicators))) + yas-debug-live-indicators)) + (when (and yas-debug-undo (listp buffer-undo-list)) + (printf "Undo list has %s elements:\n" (length buffer-undo-list)) + (cl-loop for undo-elem in buffer-undo-list + do (printf "%S\n" undo-elem)))) (when hook (setq yas-debug-target-buffer (current-buffer)) (ad-enable-advice 'yas--snippet-parse-create 'before 'yas-debug-target-snippet) From 164acd6869094e45ea36f7d5cf88b08dcf60e4b5 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 3 Jun 2017 11:37:39 -0400 Subject: [PATCH 6/6] * yasnippet-debug.el (yas-debug-snippet): Show modified flag. --- yasnippet-debug.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/yasnippet-debug.el b/yasnippet-debug.el index f198219..6e639a4 100644 --- a/yasnippet-debug.el +++ b/yasnippet-debug.el @@ -167,8 +167,9 @@ (yas-debug-live-range overlay))) (when-let (active-field (yas--snippet-active-field snippet)) (unless (consp (yas--field-start active-field)) - (printf "\tactive field: #%d %s covering \"%s\"\n" + (printf "\tactive field: #%d %s %s covering \"%s\"\n" (yas--field-number active-field) + (if (yas--field-modified-p active-field) "**" "--") (yas-debug-live-range active-field) (buffer-substring-no-properties (yas--field-start active-field) (yas--field-end active-field))))) (when-let (exit (yas--snippet-exit snippet)) @@ -177,8 +178,9 @@ (yas--exit-next exit))) (dolist (field (yas--snippet-fields snippet)) (unless (consp (yas--field-start field)) - (printf "\tfield: %d %s covering \"%s\" next: %s%s\n" + (printf "\tfield: %d %s %s covering \"%s\" next: %s%s\n" (yas--field-number field) + (if (yas--field-modified-p field) "**" "--") (yas-debug-live-range field) (buffer-substring-no-properties (yas--field-start field) (yas--field-end field)) (yas--debug-format-fom-concise (yas--field-next field))