ld/yasnippet
1
0
Fork 0
mirror of https://github.com/joaotavora/yasnippet.git synced 2025-10-13 13:13:03 +00:00
Code Issues Packages Projects Releases Wiki Activity

* fix more bugs

Browse Source 
* cleanup just a little bit
This commit is contained in:
capitaomorte 2009-08-13 22:17:41 +00:00
parent ceabe9376e
commit 2c4dc70ab7
1 changed files with 115 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

204
yasnippet.el
View File

@ -721,12 +721,12 @@ Key bindings:
;; ;;
(defstruct (yas/template (:constructor yas/make-template (defstruct (yas/template (:constructor yas/make-template
(content name condition env file keybinding))) (content name condition expand-env file keybinding)))
"A template for a snippet." "A template for a snippet."
content content
name name
condition condition
env expand-env
file file
keybinding) keybinding)
@ -736,14 +736,17 @@ Key bindings:
(hash (make-hash-table :test 'equal)) (hash (make-hash-table :test 'equal))
(parents nil)) (parents nil))
(defun yas/template-condition-predicate (condition)
;;;; Filtering/condition login
;;;;
(defun yas/eval-condition (condition)
(condition-case err (condition-case err
(save-excursion (save-excursion
(save-restriction (save-restriction
(save-match-data (save-match-data
(eval condition)))) (eval condition))))
(error (progn (error (progn
(message (format "[yas]error in condition evaluation: %s" (message (format "[yas] error in condition evaluation: %s"
(error-message-string err))) (error-message-string err)))
nil)))) nil))))
@ -760,15 +763,26 @@ This function implements the rules described in
(if (eq requirement 'always) (if (eq requirement 'always)
templates templates
(remove-if-not #'(lambda (pair) (remove-if-not #'(lambda (pair)
(let* ((condition (yas/template-condition (cdr pair))) (yas/template-can-expand-p (yas/template-condition (cdr pair)) requirement))
(result (or (null condition)
(yas/template-condition-predicate condition))))
(cond ((eq requirement t)
result)
(t
(eq requirement result)))))
templates)))) templates))))
(defun yas/template-can-expand-p (condition &optional requirement)
"Evaluates CONDITION and REQUIREMENT and returns a boolean"
(let* ((requirement (or requirement
(yas/require-template-specific-condition-p)))
(result (or (null condition)
(yas/eval-condition
(condition-case err
(read condition)
(error (progn
(message (format "[yas] error reading condition: %s"
(error-message-string err))))
nil))))))
(cond ((eq requirement t)
result)
(t
(eq requirement result)))))
(defun yas/snippet-table-fetch (table key) (defun yas/snippet-table-fetch (table key)
"Fetch a snippet binding to KEY from TABLE." "Fetch a snippet binding to KEY from TABLE."
(when table (when table
@ -835,9 +849,12 @@ the template of a snippet in the current snippet-table."
(when (and existing (when (and existing
(yas/template-keybinding existing)) (yas/template-keybinding existing))
(define-key (define-key
(car (yas/template-keybinding existing)) (symbol-value (first (yas/template-keybinding existing)))
(cdr (yas/template-keybinding existing)) (second (yas/template-keybinding existing))
nil))) nil)
(setq yas/active-keybindings
(delete (yas/template-keybinding existing)
yas/active-keybindings))))
;; Now store the new template ;; Now store the new template
;; ;;
(puthash key (puthash key
@ -860,7 +877,7 @@ a list of modes like this to help the judgement."
(or (fboundp mode) (or (fboundp mode)
(find mode yas/known-modes))) (find mode yas/known-modes)))
(defun yas/eval-string (string) (defun yas/read-and-eval-string (string)
;; TODO: This is a possible optimization point, the expression could ;; TODO: This is a possible optimization point, the expression could
;; be stored in cons format instead of string, ;; be stored in cons format instead of string,
"Evaluate STRING and convert the result to string." "Evaluate STRING and convert the result to string."
@ -984,7 +1001,7 @@ Here's a list of currently recognized variables:
(when (string= "name" (match-string-no-properties 1)) (when (string= "name" (match-string-no-properties 1))
(setq name (match-string-no-properties 2))) (setq name (match-string-no-properties 2)))
(when (string= "condition" (match-string-no-properties 1)) (when (string= "condition" (match-string-no-properties 1))
(setq condition (read (match-string-no-properties 2)))) (setq condition (match-string-no-properties 2)))
(when (string= "group" (match-string-no-properties 1)) (when (string= "group" (match-string-no-properties 1))
(setq group (match-string-no-properties 2))) (setq group (match-string-no-properties 2)))
(when (string= "expand-env" (match-string-no-properties 1)) (when (string= "expand-env" (match-string-no-properties 1))
@ -1227,12 +1244,12 @@ content of the file is the template."
"Remove the all active snippet keybindings." "Remove the all active snippet keybindings."
(interactive) (interactive)
(dolist (keybinding yas/active-keybindings) (dolist (keybinding yas/active-keybindings)
(define-key (car keybinding) (cdr keybinding) nil)) (define-key (symbol-value (first keybinding)) (second keybinding) nil))
(setq yas/active-keybindings nil)) (setq yas/active-keybindings nil))
(defun yas/reload-all () (defun yas/reload-all (&optional reset-root-directory)
"Reload all snippets and rebuild the YASnippet menu. " "Reload all snippets and rebuild the YASnippet menu. "
(interactive) (interactive "P")
;; Turn off global modes and minor modes, save their state though ;; Turn off global modes and minor modes, save their state though
;; ;;
(let ((restore-global-mode (prog1 yas/global-mode (let ((restore-global-mode (prog1 yas/global-mode
@ -1259,6 +1276,9 @@ content of the file is the template."
;; Now, clean up the other keymaps we might have cluttered up. ;; Now, clean up the other keymaps we might have cluttered up.
(yas/kill-snippet-keybindings) (yas/kill-snippet-keybindings)
(when reset-root-directory
(setq yas/root-directory nil))
;; Reload the directories listed in `yas/root-directory' or prompt ;; Reload the directories listed in `yas/root-directory' or prompt
;; the user to select one. ;; the user to select one.
;; ;;
@ -1470,23 +1490,22 @@ its parent modes."
(condition-case err (condition-case err
(when keybinding (when keybinding
(setq keybinding (read (eighth snippet))) (setq keybinding (read (eighth snippet)))
(let* ((mode-map-symbol (intern (concat (symbol-name mode) "-map"))) (let* ((this-mode-map-symbol (intern (concat (symbol-name mode) "-map")))
(keys (or (and (consp keybinding) (keys (or (and (consp keybinding)
(read-kbd-macro (cdr keybinding))) (read-kbd-macro (cdr keybinding)))
(read-kbd-macro keybinding))) (read-kbd-macro keybinding)))
(keymap (or (and (consp keybinding) (keymap-symbol (or (and (consp keybinding)
(boundp (car keybinding)) (car keybinding))
(symbol-value (car keybinding))) this-mode-map-symbol)))
(and (boundp mode-map-symbol) (if (and (boundp keymap-symbol)
(symbol-value mode-map-symbol))))) (keymapp (symbol-value keymap-symbol)))
(if (keymapp keymap) (setq keybinding (list keymap-symbol
(progn keys
(setq keybinding (cons keymap keys)) name))
(push keybinding yas/active-keybindings)) (error "that keymap does not exit"))))
(setq keybinding nil))))
(error (error
(message "[yas] warning: could not read keybinding %s for snippet \"%s\"" (message "[yas] warning: keybinding \"%s\" invalid for snippet \"%s\""
keybinding name) (key-description keybinding) name)
(setf keybinding nil))) (setf keybinding nil)))
;; Create the `yas/template' object and store in the ;; Create the `yas/template' object and store in the
@ -1509,14 +1528,21 @@ its parent modes."
;; If we have a keybinding, register it if it does not ;; If we have a keybinding, register it if it does not
;; conflict! ;; conflict!
;; ;;
(unless (or (not (consp keybinding)) (when keybinding
(lookup-key (car keybinding) (cdr keybinding))) (if (lookup-key (symbol-value (first keybinding)) (second keybinding))
(define-key (message "[yas] warning: won't overwrite keybinding \"%s\" for snippet \"%s\" in `%s'"
(car keybinding) (key-description (second keybinding)) name (first keybinding))
(cdr keybinding) (define-key
`(lambda (&optional yas/prefix) (symbol-value (first keybinding))
(interactive "P") (second keybinding)
(yas/expand-snippet ,(second snippet))))) `(lambda (&optional yas/prefix)
(interactive "P")
(when (yas/template-can-expand-p ,(yas/template-condition template))
(yas/expand-snippet ,(yas/template-content template)
nil
nil
,(yas/template-expand-env template)))))
(add-to-list 'yas/active-keybindings keybinding)))
;; Setup the menu groups, reorganizing from group to group if ;; Setup the menu groups, reorganizing from group to group if
;; necessary ;; necessary
@ -1620,7 +1646,7 @@ will only be expanded when the condition evaluated to non-nil."
conditions to filter out potential expansions." conditions to filter out potential expansions."
(if (eq 'always yas/buffer-local-condition) (if (eq 'always yas/buffer-local-condition)
'always 'always
(let ((local-condition (yas/template-condition-predicate (let ((local-condition (yas/eval-condition
yas/buffer-local-condition))) yas/buffer-local-condition)))
(when local-condition (when local-condition
(if (eq local-condition t) (if (eq local-condition t)
@ -1653,7 +1679,7 @@ defined in `yas/fallback-behavior'"
(yas/expand-snippet (yas/template-content template) (yas/expand-snippet (yas/template-content template)
start start
end end
(yas/template-env template)))) (yas/template-expand-env template))))
(cond ((eq yas/fallback-behavior 'return-nil) (cond ((eq yas/fallback-behavior 'return-nil)
;; return nil ;; return nil
nil) nil)
@ -1715,7 +1741,7 @@ by condition."
(yas/expand-snippet (yas/template-content template) (yas/expand-snippet (yas/template-content template)
(car where) (car where)
(cdr where) (cdr where)
(yas/template-env template)) (yas/template-expand-env template))
(message "[yas] No snippets can be inserted here!")))) (message "[yas] No snippets can be inserted here!"))))
(defun yas/visit-snippet-file () (defun yas/visit-snippet-file ()
@ -1914,7 +1940,7 @@ With optional prefix argument KILL quit the window and buffer."
(yas/expand-snippet (yas/template-content template) (yas/expand-snippet (yas/template-content template)
(point-min) (point-min)
(point-max) (point-max)
(yas/template-env template)) (yas/template-expand-env template))
(when debug (when debug
(add-hook 'post-command-hook 'yas/debug-snippet-vars 't 'local)))) (add-hook 'post-command-hook 'yas/debug-snippet-vars 't 'local))))
(t (t
@ -2054,7 +2080,7 @@ for this field, apply it. Otherwise, returned nil."
(transformed (and transform (transformed (and transform
(save-excursion (save-excursion
(goto-char start-point) (goto-char start-point)
(yas/eval-string transform))))) (yas/read-and-eval-string transform)))))
transformed)) transformed))
(defsubst yas/replace-all (from to &optional text) (defsubst yas/replace-all (from to &optional text)
@ -2148,7 +2174,7 @@ delegate to `yas/next-field'."
(text yas/text) (text yas/text)
(yas/modified-p (yas/field-modified-p active-field))) (yas/modified-p (yas/field-modified-p active-field)))
;;; primary field transform: exit call to field-transform ;;; primary field transform: exit call to field-transform
(yas/eval-string (yas/field-transform active-field)))) (yas/read-and-eval-string (yas/field-transform active-field))))
;; Now actually move... ;; Now actually move...
(cond ((>= target-pos (length live-fields)) (cond ((>= target-pos (length live-fields))
(yas/exit-snippet snippet)) (yas/exit-snippet snippet))
@ -2946,7 +2972,7 @@ With optional string TEXT do it in string instead of the buffer."
"Replace all the \"`(lisp-expression)`\"-style expression "Replace all the \"`(lisp-expression)`\"-style expression
with their evaluated value" with their evaluated value"
(while (re-search-forward yas/backquote-lisp-expression-regexp nil t) (while (re-search-forward yas/backquote-lisp-expression-regexp nil t)
(let ((transformed (yas/eval-string (yas/restore-escapes (match-string 1))))) (let ((transformed (yas/read-and-eval-string (yas/restore-escapes (match-string 1)))))
(goto-char (match-end 0)) (goto-char (match-end 0))
(when transformed (insert transformed)) (when transformed (insert transformed))
(delete-region (match-beginning 0) (match-end 0))))) (delete-region (match-beginning 0) (match-end 0)))))
@ -3265,6 +3291,7 @@ When multiple expressions are found, only the last one counts."
(interactive) (interactive)
(yas/global-mode -1) (yas/global-mode -1)
(yas/minor-mode -1) (yas/minor-mode -1)
(yas/kill-snippet-keybindings)
(mapatoms #'(lambda (atom) (mapatoms #'(lambda (atom)
(when (string-match "yas/" (symbol-name atom)) (when (string-match "yas/" (symbol-name atom))
(unintern atom))))) (unintern atom)))))
@ -3291,12 +3318,11 @@ When multiple expressions are found, only the last one counts."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; `locate-dominating-file' is added for compatibility in emacs < 23 ;;; `locate-dominating-file' is added for compatibility in emacs < 23
(eval-when-compile (unless (or (eq emacs-major-version 23)
(unless (or (eq emacs-major-version 23) (fboundp 'locate-dominating-file))
(fboundp 'locate-dominating-file)) (defvar locate-dominating-stop-dir-regexp
(defvar locate-dominating-stop-dir-regexp "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'"
"\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'" "Regexp of directory names which stop the search in `locate-dominating-file'.
"Regexp of directory names which stop the search in `locate-dominating-file'.
Any directory whose name matches this regexp will be treated like Any directory whose name matches this regexp will be treated like
a kind of root directory by `locate-dominating-file' which will stop its search a kind of root directory by `locate-dominating-file' which will stop its search
when it bumps into it. when it bumps into it.
@ -3304,44 +3330,44 @@ The default regexp prevents fruitless and time-consuming attempts to find
special files in directories in which filenames are interpreted as hostnames, special files in directories in which filenames are interpreted as hostnames,
or mount points potentially requiring authentication as a different user.") or mount points potentially requiring authentication as a different user.")
(defun locate-dominating-file (file name) (defun locate-dominating-file (file name)
"Look up the directory hierarchy from FILE for a file named NAME. "Look up the directory hierarchy from FILE for a file named NAME.
Stop at the first parent directory containing a file NAME, Stop at the first parent directory containing a file NAME,
and return the directory. Return nil if not found." and return the directory. Return nil if not found."
;; We used to use the above locate-dominating-files code, but the ;; We used to use the above locate-dominating-files code, but the
;; directory-files call is very costly, so we're much better off doing ;; directory-files call is very costly, so we're much better off doing
;; multiple calls using the code in here. ;; multiple calls using the code in here.
;; ;;
;; Represent /home/luser/foo as ~/foo so that we don't try to look for ;; Represent /home/luser/foo as ~/foo so that we don't try to look for
;; `name' in /home or in /. ;; `name' in /home or in /.
(setq file (abbreviate-file-name file)) (setq file (abbreviate-file-name file))
(let ((root nil) (let ((root nil)
(prev-file file) (prev-file file)
;; `user' is not initialized outside the loop because ;; `user' is not initialized outside the loop because
;; `file' may not exist, so we may have to walk up part of the ;; `file' may not exist, so we may have to walk up part of the
;; hierarchy before we find the "initial UID". ;; hierarchy before we find the "initial UID".
(user nil) (user nil)
try) try)
(while (not (or root (while (not (or root
(null file) (null file)
;; FIXME: Disabled this heuristic because it is sometimes ;; FIXME: Disabled this heuristic because it is sometimes
;; inappropriate. ;; inappropriate.
;; As a heuristic, we stop looking up the hierarchy of ;; As a heuristic, we stop looking up the hierarchy of
;; directories as soon as we find a directory belonging ;; directories as soon as we find a directory belonging
;; to another user. This should save us from looking in ;; to another user. This should save us from looking in
;; things like /net and /afs. This assumes that all the ;; things like /net and /afs. This assumes that all the
;; files inside a project belong to the same user. ;; files inside a project belong to the same user.
;; (let ((prev-user user)) ;; (let ((prev-user user))
;; (setq user (nth 2 (file-attributes file))) ;; (setq user (nth 2 (file-attributes file)))
;; (and prev-user (not (equal user prev-user)))) ;; (and prev-user (not (equal user prev-user))))
(string-match locate-dominating-stop-dir-regexp file))) (string-match locate-dominating-stop-dir-regexp file)))
(setq try (file-exists-p (expand-file-name name file))) (setq try (file-exists-p (expand-file-name name file)))
(cond (try (setq root file)) (cond (try (setq root file))
((equal file (setq prev-file file ((equal file (setq prev-file file
file (file-name-directory file (file-name-directory
(directory-file-name file)))) (directory-file-name file))))
(setq file nil)))) (setq file nil))))
root)))) root)))
(provide 'yasnippet) (provide 'yasnippet)