:group 'yasnippet)
(defcustom yas-wrap-around-region nil
- "If non-nil, snippet expansion wraps around selected region.
-
-The wrapping occurs just before the snippet's exit marker. This
-can be overridden on a per-snippet basis."
- :type 'boolean
+ "What to insert for snippet's $0 field.
+
+If set to a character, insert contents of corresponding register.
+If non-nil insert region contents. This can be overridden on a
+per-snippet basis. A value of `cua' is considered equivalent to
+`?0' for backwards compatibility."
+ :type '(choice (character :tag "Insert from register")
+ (const t :tag "Insert region contents")
+ (const nil :tag "Don't insert anything")
+ (const cua)) ; backwards compat
:group 'yasnippet)
(defcustom yas-good-grace t
(read-kbd-macro keybinding 'need-vector))))
res)
(error
- (yas--message 3 "warning: keybinding \"%s\" invalid since %s."
+ (yas--message 2 "warning: keybinding \"%s\" invalid since %s."
keybinding (error-message-string err))
nil))))
(or (yas--template-load-file template)
(let ((file (yas--template-save-file template)))
(when file
- (yas--message 2 "%s has no load file, use save file, %s, instead."
+ (yas--message 3 "%s has no load file, using save file, %s, instead."
(yas--template-name template) file))
file)))
(defun yas--load-yas-setup-file (file)
(if (not yas--creating-compiled-snippets)
;; Normal case.
- (load file 'noerror (<= yas-verbosity 2))
+ (load file 'noerror (<= yas-verbosity 4))
(let ((elfile (concat file ".el")))
(when (file-exists-p elfile)
(insert ";;; contents of the .yas-setup.el support file:\n;;;\n")
(cl-loop for buffer in (buffer-list)
do (with-current-buffer buffer
(when (eq major-mode mode-sym)
- (yas--message 3 "Discovered there was already %s in %s" buffer mode-sym)
+ (yas--message 4 "Discovered there was already %s in %s" buffer mode-sym)
(push buffer impatient-buffers)))))))
;; ...after TOP-LEVEL-DIR has been completely loaded, call
;; `yas--load-pending-jits' in these impatient buffers.
;; Normal case.
(unless (file-exists-p (expand-file-name ".yas-skip" directory))
(unless (and (load (expand-file-name ".yas-compiled-snippets" directory) 'noerror (<= yas-verbosity 3))
- (progn (yas--message 2 "Loaded compiled snippets from %s" directory) t))
- (yas--message 2 "Loading snippet files from %s" directory)
+ (progn (yas--message 4 "Loaded compiled snippets from %s" directory) t))
+ (yas--message 4 "Loading snippet files from %s" directory)
(yas--load-directory-2 directory mode-sym)))))
(defun yas--load-directory-2 (directory mode-sym)
(cond ((file-directory-p directory)
(yas-load-directory directory (not nojit))
(if nojit
- (yas--message 3 "Loaded %s" directory)
- (yas--message 3 "Prepared just-in-time loading for %s" directory)))
+ (yas--message 4 "Loaded %s" directory)
+ (yas--message 4 "Prepared just-in-time loading for %s" directory)))
(t
(push (yas--message 0 "Check your `yas-snippet-dirs': %s is not a directory" directory) errors)))))
errors))
(yas-direct-keymaps-reload)
(run-hooks 'yas-after-reload-hook)
- (yas--message 3 "Reloaded everything%s...%s."
- (if no-jit "" " (snippets will load just-in-time)")
- (if errors " (some errors, check *Messages*)" "")))))
+ (yas--message (if errors 2 3) "Reloaded everything%s...%s."
+ (if no-jit "" " (snippets will load just-in-time)")
+ (if errors " (some errors, check *Messages*)" "")))))
(defvar yas-after-reload-hook nil
"Hooks run after `yas-reload-all'.")
(let ((funs (reverse (gethash mode yas--scheduled-jit-loads))))
;; must reverse to maintain coherence with `yas-snippet-dirs'
(dolist (fun funs)
- (yas--message 3 "Loading for `%s', just-in-time: %s!" mode fun)
+ (yas--message 4 "Loading for `%s', just-in-time: %s!" mode fun)
(funcall fun))
(remhash mode yas--scheduled-jit-loads))))
(define-key menu-keymap (vector (gensym))
'(menu-item "----")))
(t
- (yas--message 3 "Don't know anything about menu entry %s" (first e))))))
+ (yas--message 1 "Don't know anything about menu entry %s" (first e))))))
\f
(defun yas--define (mode key template &optional name condition group)
"Define a snippet. Expanding KEY into TEMPLATE.
(yas--templates-for-key-at-point))
(yas--templates-for-key-at-point))))
(if templates-and-pos
- (yas--expand-or-prompt-for-template (nth 0 templates-and-pos)
- (nth 1 templates-and-pos)
- (nth 2 templates-and-pos))
+ (yas--expand-or-prompt-for-template
+ (nth 0 templates-and-pos)
+ ;; Delete snippet key and active region when expanding.
+ (min (if (use-region-p) (region-beginning) most-positive-fixnum)
+ (nth 1 templates-and-pos))
+ (max (if (use-region-p) (region-end) most-negative-fixnum)
+ (nth 2 templates-and-pos)))
(yas--fallback))))
(defun yas-expand-from-keymap ()
(car where)
(cdr where)
(yas--template-expand-env yas--current-template))
- (yas--message 3 "No snippets can be inserted here!"))))
+ (yas--message 1 "No snippets can be inserted here!"))))
(defun yas-visit-snippet-file ()
"Choose a snippet to edit, selection like `yas-insert-snippet'.
(defun yas-load-snippet-buffer (table &optional interactive)
"Parse and load current buffer's snippet definition into TABLE.
-
-TABLE is a symbol naming a passed to `yas--table-get-create'.
-
-When called interactively, prompt for the table name."
+TABLE is a symbol name passed to `yas--table-get-create'. When
+called interactively, prompt for the table name."
(interactive (list (yas--read-table) t))
(cond
;; We have `yas--editing-template', this buffer's content comes from a
(yas--table-name (yas--template-table yas--editing-template)))))
(defun yas-load-snippet-buffer-and-close (table &optional kill)
- "Load the snippet with `yas-load-snippet-buffer', possibly
- save, then `quit-window' if saved.
-
-If the snippet is new, ask the user whether (and where) to save
-it. If the snippet already has a file, just save it.
+ "Load and save the snippet, then `quit-window' if saved.
+Loading is performed by `yas-load-snippet-buffer'. If the
+snippet is new, ask the user whether (and where) to save it. If
+the snippet already has a file, just save it.
The prefix argument KILL is passed to `quit-window'.
(require 'yasnippet-debug nil t))
(add-hook 'post-command-hook 'yas-debug-snippet-vars nil t))))
(t
- (yas--message 3 "Cannot test snippet for unknown major mode")))))
+ (yas--message 1 "Cannot test snippet for unknown major mode")))))
(defun yas-active-keys ()
"Return all active trigger keys for current buffer and point."
string iff EMPTY-ON-NIL-P is true."
(let* ((yas-text (yas--field-text-for-display field))
(yas-modified-p (yas--field-modified-p field))
- (yas-moving-away-p nil)
(transform (if (yas--mirror-p field-or-mirror)
(yas--mirror-transform field-or-mirror)
(yas--field-transform field-or-mirror)))
(let* ((snippet (car (yas--snippets-at-point)))
(active-field (overlay-get yas--active-field-overlay 'yas--field))
(target-field (yas--find-next-field arg snippet active-field)))
- ;; First check if we're moving out of a field with a transform.
- (when (and active-field (yas--field-transform active-field))
- (let* ((yas-moving-away-p t)
- (yas-text (yas--field-text-for-display active-field))
- (yas-modified-p (yas--field-modified-p active-field)))
- ;; primary field transform: exit call to field-transform
- (yas--eval-lisp (yas--field-transform active-field))))
+ ;; Apply transform to active field.
+ (when active-field
+ (let ((yas-moving-away-p t))
+ (when (yas--field-update-display active-field)
+ (yas--update-mirrors snippet))))
;; Now actually move...
(if target-field
(yas--move-to-field snippet target-field)
(condition-case error
(run-hooks hook-var)
(error
- (yas--message 3 "%s error: %s" hook-var (error-message-string error)))))
+ (yas--message 2 "%s error: %s" hook-var (error-message-string error)))))
(defun yas--check-commit-snippet ()
(= length (- end beg)) ; deletion or insertion
(yas--undo-in-progress))
(let ((snippets (yas--snippets-at-point)))
- (yas--message 3 "Comitting snippets. Action would destroy a protection overlay.")
+ (yas--message 2 "Committing snippets. Action would destroy a protection overlay.")
(cl-loop for snippet in snippets
do (yas--commit-snippet snippet)))))
;; them mostly to make the undo information
;;
(setq yas--start-column (current-column))
- (let ((yas--inhibit-overlay-hooks t))
+ (let ((yas--inhibit-overlay-hooks t)
+ ;; Avoid major-mode's syntax propertizing function,
+ ;; since we mess with the syntax-table and also
+ ;; insert things that are not valid in the
+ ;; major-mode language syntax anyway.
+ (syntax-propertize-function nil))
(setq snippet
(if expand-env
(eval `(let* ,expand-env
(insert content)
(yas--snippet-create start (point))))
(insert content)
- (yas--snippet-create start (point))))))
+ (yas--snippet-create start (point)))))
+ ;; Invalidate any syntax-propertizing done while `syntax-propertize-function' was nil
+ (syntax-ppss-flush-cache start))
;; stacked-expansion: This checks for stacked expansion, save the
;; `yas--previous-active-field' and advance its boundary.
(when first-field
(sit-for 0) ;; fix issue 125
(yas--move-to-field snippet first-field)))
- (yas--message 3 "snippet expanded.")
+ (yas--message 4 "snippet expanded.")
t))))
(defun yas--take-care-of-redo (_beg _end snippet)
backquoted Lisp expressions should be inserted at the end of
expansion.")
+(defvar yas--indent-markers nil
+ "List of markers for manual indentation.")
+
(defun yas--snippet-parse-create (snippet)
"Parse a recently inserted snippet template, creating all
necessary fields, mirrors and exit points.
;; protect escaped characters
;;
(yas--protect-escapes)
+ ;; Parse indent markers: `$>'.
+ (goto-char parse-start)
+ (yas--indent-parse-create snippet)
;; parse fields with {}
;;
(goto-char parse-start)
(yas--calculate-adjacencies snippet)
;; Delete $-constructs
;;
- (save-restriction (widen) (yas--delete-regions yas--dollar-regions))
+ (save-restriction
+ (widen)
+ (yas--delete-regions yas--dollar-regions))
+ ;; Make sure to do this insertion *after* deleting the dollar
+ ;; regions, otherwise we invalidate the calculated positions of
+ ;; all the fields following $0.
+ (let ((exit (yas--snippet-exit snippet)))
+ (goto-char (if exit (yas--exit-marker exit) (point-max))))
+ (when (eq yas-wrap-around-region 'cua)
+ (setq yas-wrap-around-region ?0))
+ (cond ((and yas-wrap-around-region yas-selected-text)
+ (insert yas-selected-text))
+ ((and (characterp yas-wrap-around-region)
+ (get-register yas-wrap-around-region))
+ (insert (prog1 (get-register yas-wrap-around-region)
+ (set-register yas-wrap-around-region nil)))))
;; restore backquoted expression values
;;
(yas--restore-backquotes)
(goto-char parse-start)
(yas--indent snippet)))
-(defun yas--indent-according-to-mode (snippet-markers)
- "Indent current line according to mode, preserving SNIPPET-MARKERS."
+(defun yas--indent-region (from to snippet)
+ "Indent the lines between FROM and TO with `indent-according-to-mode'.
+The SNIPPET's markers are preserved."
;;; Apropos indenting problems....
;;
;; `indent-according-to-mode' uses whatever `indent-line-function'
;; `front-advance' property set to nil.
;;
;; This is why I have these `trouble-markers', they are the ones at
- ;; they are the ones at the first non-whitespace char at the line
- ;; (i.e. at `yas--real-line-beginning'. After indentation takes place
- ;; we should be at the correct to restore them to. All other
- ;; non-trouble-markers have been *pushed* and don't need special
- ;; attention.
- ;;
- (goto-char (yas--real-line-beginning))
- (let ((trouble-markers (remove-if-not #'(lambda (marker)
- (= marker (point)))
- snippet-markers)))
- (save-restriction
- (widen)
- (condition-case _
- (indent-according-to-mode)
- (error (yas--message 3 "Warning: `yas--indent-according-to-mode' having problems running %s" indent-line-function)
- nil)))
- (mapc #'(lambda (marker)
- (set-marker marker (point)))
- trouble-markers)))
+ ;; the first non-whitespace char at the line. After indentation
+ ;; takes place we should be at the correct to restore them. All
+ ;; other non-trouble-markers should have been *pushed* and don't
+ ;; need special attention.
+ (let* ((snippet-markers (yas--collect-snippet-markers snippet))
+ (to (set-marker (make-marker) to)))
+ (save-excursion
+ (goto-char from)
+ (save-restriction
+ (widen)
+ ;; Indent each non-empty line.
+ (cl-loop if (/= (line-beginning-position) (line-end-position)) do
+ (back-to-indentation)
+ (let ((trouble-markers ; The markers at (point).
+ (cl-remove (point) snippet-markers :test #'/=)))
+ (unwind-protect
+ (indent-according-to-mode)
+ (dolist (marker trouble-markers)
+ (set-marker marker (point)))))
+ while (and (zerop (forward-line 1))
+ (< (point) to)))))))
(defvar yas--indent-original-column nil)
(defun yas--indent (snippet)
- (let ((snippet-markers (yas--collect-snippet-markers snippet)))
- ;; Look for those $>
- (save-excursion
- (while (re-search-forward "$>" nil t)
- (delete-region (match-beginning 0) (match-end 0))
- (when (not (eq yas-indent-line 'auto))
- (yas--indent-according-to-mode snippet-markers))))
- ;; Now do stuff for 'fixed and 'auto
- (save-excursion
- (cond ((eq yas-indent-line 'fixed)
- (while (and (zerop (forward-line))
- (zerop (current-column)))
- (indent-to-column yas--indent-original-column)))
- ((eq yas-indent-line 'auto)
- (let ((end (set-marker (make-marker) (point-max)))
- (indent-first-line-p yas-also-auto-indent-first-line))
- (while (and (zerop (if indent-first-line-p
- (prog1
- (forward-line 0)
- (setq indent-first-line-p nil))
- (forward-line 1)))
- (not (eobp))
- (<= (point) end))
- (yas--indent-according-to-mode snippet-markers))))
- (t
- nil)))))
+ ;; Indent lines that had indent markers (`$>') on them.
+ (save-excursion
+ (dolist (marker yas--indent-markers)
+ (unless (eq yas-indent-line 'auto)
+ (goto-char marker)
+ (yas--indent-region (line-beginning-position)
+ (line-end-position)
+ snippet))
+ ;; Finished with this marker.
+ (set-marker marker nil))
+ (setq yas--indent-markers nil))
+ ;; Now do stuff for `fixed' and `auto'.
+ (save-excursion
+ (cond ((eq yas-indent-line 'fixed)
+ (while (and (zerop (forward-line))
+ (zerop (current-column)))
+ (indent-to-column yas--indent-original-column)))
+ ((eq yas-indent-line 'auto)
+ (let ((end (set-marker (make-marker) (point-max))))
+ (unless yas-also-auto-indent-first-line
+ (forward-line 1))
+ (yas--indent-region (line-beginning-position)
+ (point-max)
+ snippet))))))
(defun yas--collect-snippet-markers (snippet)
"Make a list of all the markers used by SNIPPET."
(push (yas--exit-marker snippet-exit) markers)))
markers))
-(defun yas--real-line-beginning ()
- (let ((c (char-after (line-beginning-position)))
- (n (line-beginning-position)))
- (while (or (eql c ?\ )
- (eql c ?\t))
- (cl-incf n)
- (setq c (char-after n)))
- n))
-
(defun yas--escape-string (escaped)
(concat "YASESCAPE" (format "%d" escaped) "PROTECTGUARD"))
(set-marker-insertion-type marker nil)
marker))
+(defun yas--indent-parse-create (snippet)
+ "Parse the \"$>\" indentation markers in SNIPPET."
+ (setq yas--indent-markers ())
+ (while (search-forward "$>" nil t)
+ (delete-region (match-beginning 0) (match-end 0))
+ ;; Mark the beginning of the line.
+ (push (yas--make-marker (line-beginning-position))
+ yas--indent-markers))
+ (setq yas--indent-markers (nreverse yas--indent-markers)))
+
(defun yas--field-parse-create (snippet &optional parent-field)
"Parse most field expressions in SNIPPET, except for the simple one \"$n\".
(while (re-search-forward yas--simple-mirror-regexp nil t)
(let ((number (string-to-number (match-string-no-properties 1))))
(cond ((zerop number)
-
(setf (yas--snippet-exit snippet)
(yas--make-exit (yas--make-marker (match-end 0))))
- (save-excursion
- (goto-char (match-beginning 0))
- (when yas-wrap-around-region
- (cond (yas-selected-text
- (insert yas-selected-text))
- ((and (eq yas-wrap-around-region 'cua)
- cua-mode
- (get-register ?0))
- (insert (prog1 (get-register ?0)
- (set-register ?0 nil))))))
- (push (cons (point) (yas--exit-marker (yas--snippet-exit snippet)))
- yas--dollar-regions)))
+ (push (cons (match-beginning 0) (yas--exit-marker (yas--snippet-exit snippet)))
+ yas--dollar-regions))
(t
(let ((field (yas--snippet-find-field snippet number)))
(if field
(save-restriction
(widen)
(save-excursion
- (dolist (field-and-mirror
- (sort
- ;; make a list of ((F1 . M1) (F1 . M2) (F2 . M3) (F2 . M4) ...)
- ;; where F is the field that M is mirroring
- ;;
- (cl-mapcan #'(lambda (field)
- (mapcar #'(lambda (mirror)
- (cons field mirror))
- (yas--field-mirrors field)))
- (yas--snippet-fields snippet))
- ;; then sort this list so that entries with mirrors with parent
- ;; fields appear before. This was important for fixing #290, and
- ;; luckily also handles the case where a mirror in a field causes
- ;; another mirror to need reupdating
- ;;
- #'(lambda (field-and-mirror1 field-and-mirror2)
- (> (yas--calculate-mirror-depth (cdr field-and-mirror1))
- (yas--calculate-mirror-depth (cdr field-and-mirror2))))))
- (let* ((field (car field-and-mirror))
- (mirror (cdr field-and-mirror))
- (parent-field (yas--mirror-parent-field mirror)))
- ;; before updating a mirror with a parent-field, maybe advance
- ;; its start (#290)
- ;;
- (when parent-field
- (yas--advance-start-maybe mirror (yas--fom-start parent-field)))
- ;; update this mirror
- ;;
- (yas--mirror-update-display mirror field)
- ;; `yas--place-overlays' is needed if the active field and
- ;; protected overlays have been changed because of insertions
- ;; in `yas--mirror-update-display'
- ;;
- (when (eq field (yas--snippet-active-field snippet))
- (yas--place-overlays snippet field)))))))
-
-(defun yas--mirror-update-display (mirror field)
+ (dolist (field-and-mirror
+ (sort
+ ;; make a list of ((F1 . M1) (F1 . M2) (F2 . M3) (F2 . M4) ...)
+ ;; where F is the field that M is mirroring
+ ;;
+ (cl-mapcan #'(lambda (field)
+ (mapcar #'(lambda (mirror)
+ (cons field mirror))
+ (yas--field-mirrors field)))
+ (yas--snippet-fields snippet))
+ ;; then sort this list so that entries with mirrors with parent
+ ;; fields appear before. This was important for fixing #290, and
+ ;; luckily also handles the case where a mirror in a field causes
+ ;; another mirror to need reupdating
+ ;;
+ #'(lambda (field-and-mirror1 field-and-mirror2)
+ (> (yas--calculate-mirror-depth (cdr field-and-mirror1))
+ (yas--calculate-mirror-depth (cdr field-and-mirror2))))))
+ (let* ((field (car field-and-mirror))
+ (mirror (cdr field-and-mirror))
+ (parent-field (yas--mirror-parent-field mirror)))
+ ;; before updating a mirror with a parent-field, maybe advance
+ ;; its start (#290)
+ ;;
+ (when parent-field
+ (yas--advance-start-maybe mirror (yas--fom-start parent-field)))
+ ;; update this mirror
+ ;;
+ (yas--mirror-update-display mirror field snippet)
+ ;; `yas--place-overlays' is needed since the active field and
+ ;; protected overlays might have been changed because of insertions
+ ;; in `yas--mirror-update-display'.
+ (let ((active-field (yas--snippet-active-field snippet)))
+ (when active-field (yas--place-overlays snippet active-field))))))))
+
+(defun yas--mirror-update-display (mirror field snippet)
"Update MIRROR according to FIELD (and mirror transform)."
(let* ((mirror-parent-field (yas--mirror-parent-field mirror))
(set-marker (yas--mirror-end mirror) (point))
(yas--advance-start-maybe (yas--mirror-next mirror) (point))
;; super-special advance
- (yas--advance-end-of-parents-maybe mirror-parent-field (point))))))
+ (yas--advance-end-of-parents-maybe mirror-parent-field (point)))
+ (let ((yas--inhibit-overlay-hooks t))
+ (yas--indent-region (yas--mirror-start mirror)
+ (yas--mirror-end mirror)
+ snippet)))))
(defun yas--field-update-display (field)
"Much like `yas--mirror-update-display', but for fields."
\f
;;; Utils
-(defvar yas-verbosity 4
+(defvar yas-verbosity 3
"Log level for `yas--message' 4 means trace most anything, 0 means nothing.")
(defun yas--message (level message &rest args)