* Snippet table store is now based on two hash tables (keyhash and

namehash) instead of a hash table and an alist (this is still not ideal).

* `yas/wrap-around-region' can now also be 'cua' (undocumented feature)

* More cleanup
This commit is contained in:
capitaomorte 2009-08-16 13:32:19 +00:00
parent 6b1dce61d9
commit f28cc874af

View File

@ -339,7 +339,7 @@ This cafn only work when snippets are loaded from files."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User can also customize these ;; User can also customize these
(defvar yas/keymap (make-sparse-keymap) (defvar yas/keymap nil
"The keymap active while a snippet expansion is in progress.") "The keymap active while a snippet expansion is in progress.")
(defun yas/define-some-keys (keys keymap definition) (defun yas/define-some-keys (keys keymap definition)
@ -349,9 +349,14 @@ This cafn only work when snippets are loaded from files."
(dolist (key keys) (dolist (key keys)
(define-key keymap (read-kbd-macro key) definition)))) (define-key keymap (read-kbd-macro key) definition))))
(yas/define-some-keys yas/next-field-key yas/keymap 'yas/next-field-or-maybe-expand) (let ((map (make-sparse-keymap)))
(yas/define-some-keys yas/prev-field-key yas/keymap 'yas/prev-field) (mapc #'(lambda (binding)
(yas/define-some-keys yas/skip-and-clear-key yas/keymap 'yas/skip-and-clear-or-delete-char) (yas/define-some-keys (car binding) map (cdr binding)))
`((,yas/next-field-key . yas/next-field-or-maybe-expand)
(,yas/prev-field-key . yas/prev-field)
("C-g" . yas/abort-snippet)
(,yas/skip-and-clear-key . yas/skip-and-clear-or-delete-char)))
(setq yas/keymap map))
(defvar yas/key-syntaxes (list "w" "w_" "w_." "^ ") (defvar yas/key-syntaxes (list "w" "w_" "w_." "^ ")
"A list of syntax of a key. This list is tried in the order "A list of syntax of a key. This list is tried in the order
@ -438,9 +443,6 @@ Here's an example:
(defvar yas/version "0.6.1b") (defvar yas/version "0.6.1b")
(defvar yas/snippet-tables (make-hash-table)
"A hash table of MAJOR-MODE symbols to `yas/snippet-table' objects.")
(defvar yas/menu-table (make-hash-table) (defvar yas/menu-table (make-hash-table)
"A hash table of MAJOR-MODE symbols to menu keymaps.") "A hash table of MAJOR-MODE symbols to menu keymaps.")
@ -731,12 +733,94 @@ Key bindings:
file file
keybinding) keybinding)
(defvar yas/snippet-tables (make-hash-table)
"A hash table of MAJOR-MODE symbols to `yas/snippet-table' objects.")
(defstruct (yas/snippet-table (:constructor yas/make-snippet-table (name))) (defstruct (yas/snippet-table (:constructor yas/make-snippet-table (name)))
"A table to store snippets for a particular mode." "A table to store snippets for a particular mode.
Has the following fields:
`yas/snippet-table-name'
A symbol normally corresponding to a major mode, but can also be
a pseudo major-mode to be referenced in `yas/mode-symbol', for
example.
`yas/snippet-table-hash'
A hash table the key is a string (the snippet key) and the
value is yet another hash of (NAME TEMPLATE), where NAME is the
snippet name and TEMPLATE is a `yas/template' object name.
`yas/snippet-table-parents'
A list of tables considered parents of this table: i.e. when
searching for expansions they are searched as well."
name name
(hash (make-hash-table :test 'equal)) (hash (make-hash-table :test 'equal))
(parents nil)) (parents nil))
(defvar yas/better-guess-for-replacements nil
"If non-nil `yas/store' better guess snippet replacements.")
(defun yas/store (table name key template)
"Store a snippet template in the TABLE."
;; This is dones by searching twice:
;;
;; * Try to get the existing namehash from TABLE using key.
;;
;; * Try to get the existing namehash from by searching the *whole*
;; snippet table for NAME. This is becuase they user might have
;; changed the key and that can no longer be used to locate the
;; previous `yas/template-structure'.
;;
;; * If that returns nothing, oh well...
;;
(dolist (existing-namehash (remove nil (list (gethash key (yas/snippet-table-hash table))
(when yas/better-guess-for-replacements
(let (a)
(maphash #'(lambda (key namehash)
(when (gethash name namehash)
(setq a namehash)))
(yas/snippet-table-hash table))
a)))))
(let ((existing-template (gethash name existing-namehash)))
(when existing-template
;; Remove the existing keybinding
(when (yas/template-keybinding existing-template)
(define-key
(symbol-value (first (yas/template-keybinding existing-template)))
(second (yas/template-keybinding existing-template))
nil)
(setq yas/active-keybindings
(delete (yas/template-keybinding existing-template)
yas/active-keybindings)))
;; Remove the (name . template) mapping from existing-namehash.
(remhash name existing-namehash))))
;; Now store the new template independent of the previous steps.
;;
(puthash name
template
(or (gethash key
(yas/snippet-table-hash table))
(puthash key
(make-hash-table :test 'equal)
(yas/snippet-table-hash table)))))
(defun yas/fetch (table key)
"Fetch a snippet binding to KEY from TABLE."
(let* ((keyhash (yas/snippet-table-hash table))
(namehash (and keyhash (gethash key keyhash))))
(when namehash
(yas/filter-templates-by-condition
(let (alist)
(maphash #'(lambda (k v)
(push (cons k v) alist))
namehash)
alist)))))
;; Filtering/condition logic ;; Filtering/condition logic
@ -755,7 +839,7 @@ Key bindings:
(defun yas/filter-templates-by-condition (templates) (defun yas/filter-templates-by-condition (templates)
"Filter the templates using the applicable condition. "Filter the templates using the applicable condition.
TEMPLATES is a list of cons (KEY . TEMPLATE) where KEY is a TEMPLATES is a list of cons (NAME . TEMPLATE) where NAME is a
string and TEMPLATE is a `yas/template' structure. string and TEMPLATE is a `yas/template' structure.
This function implements the rules described in This function implements the rules described in
@ -800,12 +884,6 @@ conditions to filter out potential expansions."
(t (t
(eq requirement result))))) (eq requirement result)))))
(defun yas/snippet-table-fetch (table key)
"Fetch a snippet binding to KEY from TABLE."
(when table
(yas/filter-templates-by-condition
(copy-list (gethash key (yas/snippet-table-hash table))))))
(defun yas/snippet-table-get-all-parents (table) (defun yas/snippet-table-get-all-parents (table)
(let ((parents (yas/snippet-table-parents table))) (let ((parents (yas/snippet-table-parents table)))
(when parents (when parents
@ -815,8 +893,10 @@ conditions to filter out potential expansions."
(defun yas/snippet-table-templates (table) (defun yas/snippet-table-templates (table)
(when table (when table
(let ((acc (list))) (let ((acc (list)))
(maphash #'(lambda (key templates) (maphash #'(lambda (key namehash)
(setq acc (nconc acc (copy-list templates)))) (maphash #'(lambda (name template)
(push (cons name template) acc))
namehash))
(yas/snippet-table-hash table)) (yas/snippet-table-hash table))
(yas/filter-templates-by-condition acc)))) (yas/filter-templates-by-condition acc))))
@ -837,7 +917,7 @@ the template of a snippet in the current snippet-table."
(setq start (point))) (setq start (point)))
(setq templates (setq templates
(mapcan #'(lambda (table) (mapcan #'(lambda (table)
(yas/snippet-table-fetch table (buffer-substring-no-properties start end))) (yas/fetch table (buffer-substring-no-properties start end)))
(yas/get-snippet-tables))) (yas/get-snippet-tables)))
(if templates (if templates
(setq done t) (setq done t)
@ -856,31 +936,6 @@ the template of a snippet in the current snippet-table."
(yas/snippet-table-hash table)) (yas/snippet-table-hash table))
acc))) acc)))
(defun yas/snippet-table-store (table name key template)
"Store a snippet template in the TABLE."
;; If replacing a snippet template, remember to remove its
;; keybinding first.
;;
(let ((existing (aget (gethash key (yas/snippet-table-hash table))
name)))
(when (and existing
(yas/template-keybinding existing))
(define-key
(symbol-value (first (yas/template-keybinding existing)))
(second (yas/template-keybinding existing))
nil)
(setq yas/active-keybindings
(delete (yas/template-keybinding existing)
yas/active-keybindings))))
;; Now store the new template
;;
(puthash key
(yas/modify-alist (gethash key
(yas/snippet-table-hash table))
name
template)
(yas/snippet-table-hash table)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal functions ;; Internal functions
@ -1006,7 +1061,7 @@ Here's a list of currently recognized variables:
condition condition
(group (and file (group (and file
(yas/calculate-group file))) (yas/calculate-group file)))
env expand-env
binding) binding)
(if (re-search-forward "^# --\n" nil t) (if (re-search-forward "^# --\n" nil t)
(progn (setq template (progn (setq template
@ -1022,14 +1077,14 @@ Here's a list of currently recognized variables:
(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))
(setq env (match-string-no-properties 2))) (setq expand-env (match-string-no-properties 2)))
(when (string= "key" (match-string-no-properties 1)) (when (string= "key" (match-string-no-properties 1))
(setq key (match-string-no-properties 2))) (setq key (match-string-no-properties 2)))
(when (string= "binding" (match-string-no-properties 1)) (when (string= "binding" (match-string-no-properties 1))
(setq binding (match-string-no-properties 2))))) (setq binding (match-string-no-properties 2)))))
(setq template (setq template
(buffer-substring-no-properties (point-min) (point-max)))) (buffer-substring-no-properties (point-min) (point-max))))
(list key template name condition group env file binding))) (list key template name condition group expand-env file binding)))
(defun yas/calculate-group (file) (defun yas/calculate-group (file)
"Calculate the group for snippet file path FILE." "Calculate the group for snippet file path FILE."
@ -1101,15 +1156,6 @@ Here's a list of currently recognized variables:
(car where) (car where)
(cdr where))))) (cdr where)))))
(defun yas/modify-alist (alist key value)
"Modify ALIST to map KEY to VALUE. return the new alist."
(let ((pair (assoc key alist)))
(if (null pair)
(cons (cons key value)
alist)
(setcdr pair value)
alist)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Popping up for keys and templates ;; Popping up for keys and templates
;; ;;
@ -1334,11 +1380,17 @@ foo\"bar\\! -> \"foo\\\"bar\\\\!\""
(defun yas/compile-bundle (defun yas/compile-bundle
(&optional yasnippet yasnippet-bundle snippet-roots code dropdown) (&optional yasnippet yasnippet-bundle snippet-roots code dropdown)
"Compile snippets in SNIPPET-ROOTS to a single bundle file. "Compile snippets in SNIPPET-ROOTS to a single bundle file.
YASNIPPET is the yasnippet.el file path.
YASNIPPET-BUNDLE is the output file of the compile result.
SNIPPET-ROOTS is a list of root directories that contains the SNIPPET-ROOTS is a list of root directories that contains the
snippets definition. YASNIPPET is the yasnippet.el file snippets definition.
path. YASNIPPET-BUNDLE is the output file of the compile
result. CODE is the code you would like to used to initialize CODE is the code you would like to used to initialize yasnippet.
yasnippet. Last optional argument DROPDOWN is the filename of the
Last optional argument DROPDOWN is the filename of the
dropdown-list.el library. dropdown-list.el library.
Here's the default value for all the parameters: Here's the default value for all the parameters:
@ -1346,27 +1398,28 @@ Here's the default value for all the parameters:
(yas/compile-bundle \"yasnippet.el\" (yas/compile-bundle \"yasnippet.el\"
\"./yasnippet-bundle.el\" \"./yasnippet-bundle.el\"
'(\"snippets\") '(\"snippets\")
\"(yas/initialize)\") \"(yas/initialize-bundle)\"
\"dropdown-list.el\")
..
" "
(when (null yasnippet) (interactive "ffind the yasnippet.el file: \nFTarget bundle file: \nDSnippet directory to bundle: \nMExtra code? \nfdropdown-library: ")
(setq yasnippet "yasnippet.el"))
(when (null yasnippet-bundle) (let* ((yasnippet (or yasnippet
(setq yasnippet-bundle "./yasnippet-bundle.el")) ("yasnippet.el")))
(when (null snippet-roots) (yasnippet-bundle (or yasnippet-bundle
(setq snippet-roots '("snippets"))) "./yasnippet-bundle.el"))
(when (null dropdown) (snippet-roots (or snippet-roots
(setq dropdown "dropdown-list.el")) "snippets"))
(when (null code) (dropdown (or dropdown
(setq code (concat "(yas/initialize-bundle)" "dropdown-list.el"))
"\n;;;###autoload" ; break through so that won't (code (or (and code
"(require 'yasnippet-bundle)"))) ; be treated as magic comment (condition-case err (read code) (error nil))
code)
(let ((dirs (or (and (listp snippet-roots) snippet-roots) (concat "(yas/initialize-bundle)"
(list snippet-roots))) "\n;;;###autoload" ; break through so that won't
(bundle-buffer nil)) "(require 'yasnippet-bundle)")))
(dirs (or (and (listp snippet-roots) snippet-roots)
(list snippet-roots)))
(bundle-buffer nil))
(with-temp-buffer (with-temp-buffer
(setq bundle-buffer (current-buffer)) (setq bundle-buffer (current-buffer))
(insert ";;; yasnippet-bundle.el --- " (insert ";;; yasnippet-bundle.el --- "
@ -1387,34 +1440,28 @@ Here's the default value for all the parameters:
(mode snippets &optional parent-or-parents) (mode snippets &optional parent-or-parents)
(with-current-buffer bundle-buffer (with-current-buffer bundle-buffer
(insert ";;; snippets for " (symbol-name mode) "\n") (insert ";;; snippets for " (symbol-name mode) "\n")
(insert "(yas/define-snippets '" (symbol-name mode) "\n") (let ((literal-snippets (list)))
(insert "'(\n") (dolist (snippet snippets)
(dolist (snippet snippets) (let ((key (first snippet))
(insert " (" (template-content (second snippet))
(yas/quote-string (car snippet)) (name (third snippet))
" " (condition (fourth snippet))
(yas/quote-string (nth 1 snippet)) (group (fifth snippet))
" " (expand-env (sixth snippet))
(if (nth 2 snippet) ;; Omit the file on purpose
(yas/quote-string (nth 2 snippet)) (file nil);; (seventh snippet))
"nil") (binding (eighth snippet)))
" " (push `(,key
(if (nth 3 snippet) ,template-content
(format "'%s" (nth 3 snippet)) ,name
"nil") ,condition
" " ,group
(if (nth 4 snippet) ,expand-env
(yas/quote-string (nth 4 snippet)) ,file
"nil") ,binding)
")\n")) literal-snippets)))
(insert " )\n") (insert (pp-to-string `(yas/define-snippets ',mode ',literal-snippets ',parent-or-parents)))
(insert (if parent-or-parents (insert "\n\n")))))
(format "'%s" parent-or-parents)
"nil")
;; (if directory
;; (concat "\"" directory "\"")
;; "nil")
")\n\n"))))
(dolist (dir dirs) (dolist (dir dirs)
(dolist (subdir (yas/subdirs dir)) (dolist (subdir (yas/subdirs dir))
(yas/load-directory-1 subdir nil 'no-hierarchy-parents)))) (yas/load-directory-1 subdir nil 'no-hierarchy-parents))))
@ -1519,10 +1566,10 @@ its parent modes."
(setq keybinding (list keymap-symbol (setq keybinding (list keymap-symbol
keys keys
name)) name))
(error "that keymap does not exit")))) (error (format "keymap \"%s\" does not (yet?) exist" keymap-symbol)))))
(error (error
(message "[yas] warning: keybinding \"%s\" invalid for snippet \"%s\"" (message "[yas] warning: keybinding \"%s\" invalid for snippet \"%s\" since %s."
(key-description keybinding) name) keybinding name (error-message-string err))
(setf keybinding nil))) (setf keybinding nil)))
;; Create the `yas/template' object and store in the ;; Create the `yas/template' object and store in the
@ -1538,10 +1585,10 @@ its parent modes."
keybinding)) keybinding))
(when (and key (when (and key
name) name)
(yas/snippet-table-store snippet-table (yas/store snippet-table
name name
key key
template)) template))
;; If we have a keybinding, register it if it does not ;; If we have a keybinding, register it if it does not
;; conflict! ;; conflict!
;; ;;
@ -1593,16 +1640,15 @@ its parent modes."
(concat key yas/trigger-symbol)))))))))) (concat key yas/trigger-symbol))))))))))
(defun yas/show-menu-p (mode) (defun yas/show-menu-p (mode)
(message "what")
(cond ((eq yas/use-menu 'abbreviate) (cond ((eq yas/use-menu 'abbreviate)
(find mode (cons major-mode (find mode
(if (listp yas/mode-symbol) (mapcar #'(lambda (table)
yas/mode-symbol (intern (yas/snippet-table-name table)))
(list yas/mode-symbol))))) (yas/get-snippet-tables))))
((eq yas/use-menu 'real-modes) ((eq yas/use-menu 'real-modes)
(yas/real-mode? mode)) (yas/real-mode? mode))
(t (t
t))) t)))
(defun yas/delete-from-keymap (keymap name) (defun yas/delete-from-keymap (keymap name)
"Recursively delete items name NAME from KEYMAP and its submenus. "Recursively delete items name NAME from KEYMAP and its submenus.
@ -1721,7 +1767,7 @@ Honours `yas/choose-tables-first', `yas/choose-keys-first' and
(mapcan #'yas/snippet-table-all-keys tables)))) (mapcan #'yas/snippet-table-all-keys tables))))
(when key (when key
(mapcan #'(lambda (table) (mapcan #'(lambda (table)
(yas/snippet-table-fetch table key)) (yas/fetch table key))
tables))) tables)))
(mapcan #'yas/snippet-table-templates tables)))) (mapcan #'yas/snippet-table-templates tables))))
@ -1906,9 +1952,10 @@ With optional prefix argument KILL quit the window and buffer."
(name (and parsed (name (and parsed
(third parsed)))) (third parsed))))
(when name (when name
(yas/define-snippets (car major-mode-and-parent) (let ((yas/better-guess-for-replacements t))
(list parsed) (yas/define-snippets (car major-mode-and-parent)
(cdr major-mode-and-parent)) (list parsed)
(cdr major-mode-and-parent)))
(when (and (buffer-modified-p) (when (and (buffer-modified-p)
(y-or-n-p "Save snippet? ")) (y-or-n-p "Save snippet? "))
(save-buffer)) (save-buffer))
@ -2011,6 +2058,10 @@ Otherwise throw exception."
(when field (when field
(yas/field-text-for-display field)))) (yas/field-text-for-display field))))
(defun yas/default-from-field (number)
(unless yas/modified-p
(yas/field-value number)))
(defun yas/inside-string () (defun yas/inside-string ()
(equal 'font-lock-string-face (get-char-property (1- (point)) 'face))) (equal 'font-lock-string-face (get-char-property (1- (point)) 'face)))
@ -2218,6 +2269,13 @@ Also create some protection overlays"
(interactive) (interactive)
(yas/next-field -1)) (yas/next-field -1))
(defun yas/abort-snippet (&optional snippet)
(interactive)
(let ((snippet (or snippet
(car (yas/snippets-at-point)))))
(when snippet
(setf (yas/snippet-force-exit snippet) t))))
(defun yas/exit-snippet (snippet) (defun yas/exit-snippet (snippet)
"Goto exit-marker of SNIPPET." "Goto exit-marker of SNIPPET."
(interactive) (interactive)
@ -3097,8 +3155,14 @@ When multiple expressions are found, only the last one counts."
(yas/make-exit (yas/make-marker (match-end 0)))) (yas/make-exit (yas/make-marker (match-end 0))))
(save-excursion (save-excursion
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
(when (and yas/wrap-around-region yas/selected-text) (when yas/wrap-around-region
(insert yas/selected-text)) (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))) (push (cons (point) (yas/exit-marker (yas/snippet-exit snippet)))
yas/dollar-regions))) yas/dollar-regions)))
(t (t