(when load-file-name
(concat (file-name-directory load-file-name) "snippets")))
+(defconst yas--default-user-snippets-dir
+ (concat user-emacs-directory "snippets"))
+
(defcustom yas-snippet-dirs (remove nil
- (list "~/.emacs.d/snippets"
+ (list yas--default-user-snippets-dir
'yas-installed-snippets-dir))
"List of top-level snippet directories.
(defun yas--modes-to-activate (&optional mode)
"Compute list of mode symbols that are active for `yas-expand'
and friends."
- (let (dfs)
- (setq dfs (lambda (mode &optional explored)
- (push mode explored)
- (cons mode
- (loop for neighbour
- in (cl-list* (get mode 'derived-mode-parent)
- (ignore-errors (symbol-function mode))
- (gethash mode yas--parents))
- when (and neighbour
- (not (memq neighbour explored))
- (symbolp neighbour))
- append (funcall dfs neighbour explored)))))
- (remove-duplicates (if mode
- (funcall dfs mode)
- (append yas--extra-modes
- (funcall dfs major-mode))))))
+ (let* ((explored (if mode (list mode) ; Building up list in reverse.
+ (cons major-mode (reverse yas--extra-modes))))
+ (dfs
+ (lambda (mode)
+ (cl-loop for neighbour
+ in (cl-list* (get mode 'derived-mode-parent)
+ (ignore-errors (symbol-function mode))
+ (gethash mode yas--parents))
+ when (and neighbour
+ (not (memq neighbour explored))
+ (symbolp neighbour))
+ do (push neighbour explored)
+ (funcall dfs neighbour)))))
+ (mapcar dfs explored)
+ (nreverse explored)))
(defvar yas-minor-mode-hook nil
"Hook run when `yas-minor-mode' is turned on.")
expand-env load-file xkeybinding xuuid save-file
&aux
(name (or xname
- (and load-file (file-name-directory load-file))
- (and save-file (file-name-directory save-file))
+ ;; A little redundant: we always get a name
+ ;; from `yas--parse-template' except when
+ ;; there isn't a file.
+ (and load-file (file-name-nondirectory load-file))
+ (and save-file (file-name-nondirectory save-file))
key))
(keybinding (yas--read-keybinding xkeybinding))
(uuid (or xuuid name))
'again)
(setq methods (cdr methods))))
(t
- (yas--warning "Warning invalid element %s in `yas-key-syntaxes'" method)))
+ (setq methods (cdr methods))
+ (yas--warning "Invalid element `%s' in `yas-key-syntaxes'" method)))
(let ((possible-key (buffer-substring-no-properties (point) original)))
(save-excursion
(goto-char original)
:visible (yas--show-menu-p ',mode)))
menu-keymap))
-
-(defmacro yas--called-interactively-p (&optional kind)
- "A backward-compatible version of `called-interactively-p'.
-
-Optional KIND is as documented at `called-interactively-p'
-in GNU Emacs 24.1 or higher."
- (if (string< emacs-version "24.1")
- '(called-interactively-p)
- `(called-interactively-p ,kind)))
-
\f
;;; Template-related and snippet loading functions
(point-max)))
(setq bound (point))
(goto-char (point-min))
- (while (re-search-forward "^# *\\([^ ]+?\\) *: *\\(.*\\)$" bound t)
+ (while (re-search-forward "^# *\\([^ ]+?\\) *: *\\(.*?\\)[[:space:]]*$" bound t)
(when (string= "uuid" (match-string-no-properties 1))
(setq uuid (match-string-no-properties 2)))
(when (string= "type" (match-string-no-properties 1))
(defun yas-x-prompt (prompt choices &optional display-fn)
"Display choices in a x-window prompt."
(when (and window-system choices)
+ ;; Let window position be recalculated to ensure that
+ ;; `posn-at-point' returns non-nil.
+ (redisplay)
(or
(x-popup-menu
(if (fboundp 'posn-at-point)
(funcall fun)))
;; Look for buffers that are already in `mode-sym', and so
;; need the new snippets immediately...
- ;;
- (when use-jit
+ ;;
+ (when use-jit
(cl-loop for buffer in (buffer-list)
do (with-current-buffer buffer
(when (eq major-mode mode-sym)
(push buffer impatient-buffers)))))))
;; ...after TOP-LEVEL-DIR has been completely loaded, call
;; `yas--load-pending-jits' in these impatient buffers.
- ;;
+ ;;
(cl-loop for buffer in impatient-buffers
do (with-current-buffer buffer (yas--load-pending-jits))))
(when interactive
(current-time-string)))))
;; Normal case.
(unless (file-exists-p (concat directory "/" ".yas-skip"))
- (if (and (progn (yas--message 2 "Loading compiled snippets from %s" directory) t)
- (load (expand-file-name ".yas-compiled-snippets" directory) 'noerror (<= yas-verbosity 3)))
- (yas--message 2 "Loading snippet files from %s" 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)
(yas--load-directory-2 directory mode-sym)))))
(defun yas--load-directory-2 (directory mode-sym)
;; loops when other extensions use mechanisms similar
;; to `yas--keybinding-beyond-yasnippet'. (github #525
;; and #526)
- ;;
+ ;;
(yas-minor-mode nil)
(beyond-yasnippet (yas--keybinding-beyond-yasnippet)))
(yas--message 4 "Falling back to %s" beyond-yasnippet)
(assert (or (null beyond-yasnippet) (commandp beyond-yasnippet)))
- (setq this-original-command beyond-yasnippet)
+ (setq this-command beyond-yasnippet)
(when beyond-yasnippet
(call-interactively beyond-yasnippet))))
((and (listp yas-fallback-behavior)
(remove-duplicates (mapcan #'yas--table-templates tables)
:test #'equal))))
+(defun yas--lookup-snippet-1 (name mode)
+ "Get the snippet called NAME in MODE's tables."
+ (let ((yas-choose-tables-first nil) ; avoid prompts
+ (yas-choose-keys-first nil))
+ (cl-find name (yas--all-templates
+ (yas--get-snippet-tables mode))
+ :key #'yas--template-name :test #'string=)))
+
(defun yas-lookup-snippet (name &optional mode noerror)
"Get the snippet content for the snippet NAME in MODE's tables.
called NAME.
Honours `yas-buffer-local-condition'."
- (let* ((yas-choose-tables-first nil) ; avoid prompts
- (yas-choose-keys-first nil)
- (snippet (cl-find name (yas--all-templates
- (yas--get-snippet-tables mode))
- :key #'yas--template-name :test #'string=)))
+ (let ((snippet (yas--lookup-snippet-1 name mode)))
(cond
(snippet (yas--template-content snippet))
(noerror nil)
(let ((main-dir (replace-regexp-in-string
"/+$" ""
(or (first (or (yas-snippet-dirs)
- (setq yas-snippet-dirs '("~/.emacs.d/snippets")))))))
+ (setq yas-snippet-dirs (list yas--default-user-snippets-dir)))))))
(tables (or (and table
(list table))
(yas--get-snippet-tables))))
The most recently-inserted snippets are returned first."
(sort
- (remove nil (remove-duplicates (mapcar #'(lambda (ov)
- (overlay-get ov 'yas--snippet))
- (if all-snippets
- (overlays-in (point-min) (point-max))
- (nconc (overlays-at (point)) (overlays-at (1- (point))))))))
+ (delq nil (delete-dups
+ (mapcar (lambda (ov) (overlay-get ov 'yas--snippet))
+ (if all-snippets (overlays-in (point-min) (point-max))
+ (nconc (overlays-at (point))
+ (overlays-at (1- (point))))))))
#'(lambda (s1 s2)
(<= (yas--snippet-id s2) (yas--snippet-id s1)))))
(defvar yas--inhibit-overlay-hooks nil
"Bind this temporarily to non-nil to prevent running `yas--on-*-modification'.")
-(defmacro yas--inhibit-overlay-hooks (&rest body)
- "Run BODY with `yas--inhibit-overlay-hooks' set to t."
- (declare (indent 0))
- `(let ((yas--inhibit-overlay-hooks t))
- ,@body))
-
(defvar yas-snippet-beg nil "Beginning position of the last snippet committed.")
(defvar yas-snippet-end nil "End position of the last snippet committed.")
(setq yas-snippet-end (overlay-end control-overlay))
(delete-overlay control-overlay))
- (yas--inhibit-overlay-hooks
+ (let ((yas--inhibit-overlay-hooks t))
(when yas--active-field-overlay
(delete-overlay yas--active-field-overlay))
(when yas--field-protection-overlays
(defun yas--on-field-overlay-modification (overlay after? _beg _end &optional _length)
"Clears the field and updates mirrors, conditionally.
-Only clears the field if it hasn't been modified and it point it
-at field start. This hook doesn't do anything if an undo is in
-progress."
+Only clears the field if it hasn't been modified and point is at
+field start. This hook does nothing if an undo is in progress."
(unless (or yas--inhibit-overlay-hooks
+ (not (overlayp yas--active-field-overlay)) ; Avoid Emacs bug #21824.
(yas--undo-in-progress))
(let* ((field (overlay-get overlay 'yas--field))
(snippet (overlay-get yas--active-field-overlay 'yas--snippet)))
(yas--field-update-display field))
(yas--update-mirrors snippet))
(field
- (when (and (not after?)
+ (when (and (eq this-command 'self-insert-command)
(not (yas--field-modified-p field))
- (eq (point) (if (markerp (yas--field-start field))
- (marker-position (yas--field-start field))
- (yas--field-start field))))
+ (= (point) (yas--field-start field)))
(yas--skip-and-clear field))
(setf (yas--field-modified-p field) t))))))
\f
;; As of github #537 this no longer inhibits the command by issuing an
;; error: all the snippets at point, including nested snippets, are
;; automatically commited and the current command can proceed.
-;;
+;;
(defun yas--make-move-field-protection-overlays (snippet field)
"Place protection overlays surrounding SNIPPET's FIELD.
;;
(when (< (buffer-size) end)
(save-excursion
- (yas--inhibit-overlay-hooks
+ (let ((yas--inhibit-overlay-hooks t))
(goto-char (point-max))
(newline))))
;; go on to normal overlay creation/moving
;; them mostly to make the undo information
;;
(setq yas--start-column (current-column))
- (yas--inhibit-overlay-hooks
+ (let ((yas--inhibit-overlay-hooks t))
(setq snippet
(if expand-env
(eval `(let* ,expand-env
(set-marker marker nil)))))
(defun yas--scan-sexps (from count)
- (condition-case _
+ (ignore-errors
+ (save-match-data ; `scan-sexps' may modify match data.
(with-syntax-table (standard-syntax-table)
- (scan-sexps from count))
- (error
- nil)))
+ (scan-sexps from count)))))
(defun yas--make-marker (pos)
"Create a marker at POS with nil `marker-insertion-type'."
;; after the ":", this will be
;; caught as a mirror with
;; transform later.
- (not (save-match-data
- (eq (string-match "$[ \t\n]*("
- (match-string-no-properties 2)) 0)))
+ (not (string-match-p "\\`\\$[ \t\n]*("
+ (match-string-no-properties 2)))
;; allow ${0: some exit text}
;; (not (and number (zerop number)))
(yas--make-field number
(not (string= reflection (buffer-substring-no-properties (yas--mirror-start mirror)
(yas--mirror-end mirror)))))
(goto-char (yas--mirror-start mirror))
- (yas--inhibit-overlay-hooks
+ (let ((yas--inhibit-overlay-hooks t))
(insert reflection))
(if (> (yas--mirror-end mirror) (point))
(delete-region (point) (yas--mirror-end mirror))
(yas--field-end field)))))
(setf (yas--field-modified-p field) t)
(goto-char (yas--field-start field))
- (yas--inhibit-overlay-hooks
+ (let ((yas--inhibit-overlay-hooks t))
(insert transformed)
(if (> (yas--field-end field) (point))
(delete-region (point) (yas--field-end field))