mirror of
https://github.com/joaotavora/yasnippet.git
synced 2025-10-13 05:03:04 +00:00
refactor: redo and document some of the menu-bar code, also add tests
This commit is contained in:
João Távora
parent
e7f22535fb
commit
668efefdd4
@ -28,8 +28,7 @@
|
||||
(require 'ert)
|
||||
(require 'ert-x)
|
||||
|
||||
|
||||
|
||||
|
||||
;;; Snippet mechanics
|
||||
|
||||
(ert-deftest field-navigation ()
|
||||
@ -94,7 +93,7 @@
|
||||
;; (should (string= (buffer-substring-no-properties (point-min) (point-max))
|
||||
;; "brother from another mother!"))))
|
||||
|
||||
|
||||
|
||||
;;; Misc tests
|
||||
;;;
|
||||
|
||||
@ -109,10 +108,10 @@ TODO: correct this bug!"
|
||||
(should (string= (buffer-substring-no-properties (point-min) (point-max))
|
||||
"brother from another mother") ;; no newline should be here!
|
||||
)))
|
||||
|
||||
|
||||
;;; Loading
|
||||
;;;
|
||||
(defmacro with-some-interesting-snippet-dirs (&rest body)
|
||||
(defmacro yas-with-some-interesting-snippet-dirs (&rest body)
|
||||
`(yas-saving-variables
|
||||
(yas-with-snippet-dirs
|
||||
'((".emacs.d/snippets"
|
||||
@ -130,13 +129,13 @@ TODO: correct this bug!"
|
||||
|
||||
(ert-deftest basic-jit-loading ()
|
||||
"Test basic loading and expansion of snippets"
|
||||
(with-some-interesting-snippet-dirs
|
||||
(yas-with-some-interesting-snippet-dirs
|
||||
(yas-reload-all)
|
||||
(yas--basic-jit-loading-1)))
|
||||
|
||||
(ert-deftest basic-jit-loading-with-compiled-snippets ()
|
||||
"Test basic loading and expansion of snippets"
|
||||
(with-some-interesting-snippet-dirs
|
||||
(yas-with-some-interesting-snippet-dirs
|
||||
(yas-reload-all)
|
||||
(yas-recompile-all)
|
||||
(flet ((yas--load-directory-2
|
||||
@ -168,6 +167,126 @@ TODO: correct this bug!"
|
||||
("def" . "# define")))
|
||||
(yas-should-not-expand '("sc" "dolist" "ert-deftest"))))
|
||||
|
||||
|
||||
;;; Menu
|
||||
;;;
|
||||
(defmacro yas-with-even-more-interesting-snippet-dirs (&rest body)
|
||||
`(yas-saving-variables
|
||||
(yas-with-snippet-dirs
|
||||
`((".emacs.d/snippets"
|
||||
("c-mode"
|
||||
(".yas-make-groups" . "")
|
||||
("printf" . "printf($1);")
|
||||
("foo-group-a"
|
||||
("fnprintf" . "fprintf($1);")
|
||||
("snprintf" . "snprintf($1);"))
|
||||
("foo-group-b"
|
||||
("strcmp" . "strecmp($1);")
|
||||
("strcasecmp" . "strcasecmp($1);")))
|
||||
("lisp-interaction-mode"
|
||||
("ert-deftest" . "# group: barbar\n# --\n(ert-deftest ${1:name} () $0)"))
|
||||
("fancy-mode"
|
||||
("a-guy" . "# uuid: 999\n# --\nyo!")
|
||||
("a-sir" . "# uuid: 12345\n# --\nindeed!")
|
||||
("a-lady" . "# uuid: 54321\n# --\noh-la-la!")
|
||||
("a-beggar" . "# uuid: 0101\n# --\narrrgh!")
|
||||
("an-outcast" . "# uuid: 666\n# --\narrrgh!")
|
||||
(".yas-setup.el" . , (pp-to-string
|
||||
'(yas-define-menu 'fancy-mode
|
||||
'((yas-ignore-item "0101")
|
||||
(yas-item "999")
|
||||
(yas-submenu "sirs"
|
||||
((yas-item "12345")))
|
||||
(yas-submenu "ladies"
|
||||
((yas-item "54321"))))
|
||||
'("666")))))))
|
||||
,@body)))
|
||||
|
||||
(ert-deftest test-yas-define-menu ()
|
||||
(let ((yas-use-menu t))
|
||||
(yas-with-even-more-interesting-snippet-dirs
|
||||
(yas-reload-all 'no-jit)
|
||||
(let ((menu (cdr (gethash 'fancy-mode yas--menu-table))))
|
||||
(should (eql 4 (length menu)))
|
||||
(dolist (item '("a-guy" "a-beggar"))
|
||||
(should (find item menu :key #'third :test #'string=)))
|
||||
(should-not (find "an-outcast" menu :key #'third :test #'string=))
|
||||
(dolist (submenu '("sirs" "ladies"))
|
||||
(should (keymapp
|
||||
(fourth
|
||||
(find submenu menu :key #'third :test #'string=)))))
|
||||
))))
|
||||
|
||||
(ert-deftest test-group-menus ()
|
||||
"Test group-based menus using .yas-make-groups and the group directive"
|
||||
(let ((yas-use-menu t))
|
||||
(yas-with-even-more-interesting-snippet-dirs
|
||||
(yas-reload-all 'no-jit)
|
||||
;; first the subdir-based groups
|
||||
;;
|
||||
(let ((menu (cdr (gethash 'c-mode yas--menu-table))))
|
||||
(should (eql 3 (length menu)))
|
||||
(dolist (item '("printf" "foo-group-a" "foo-group-b"))
|
||||
(should (find item menu :key #'third :test #'string=)))
|
||||
(dolist (submenu '("foo-group-a" "foo-group-b"))
|
||||
(should (keymapp
|
||||
(fourth
|
||||
(find submenu menu :key #'third :test #'string=))))))
|
||||
;; now group directives
|
||||
;;
|
||||
(let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
|
||||
(should (eql 1 (length menu)))
|
||||
(should (find "barbar" menu :key #'third :test #'string=))
|
||||
(should (keymapp
|
||||
(fourth
|
||||
(find "barbar" menu :key #'third :test #'string=))))))))
|
||||
|
||||
(ert-deftest test-group-menus-twisted ()
|
||||
"Same as similarly named test, but be mean.
|
||||
|
||||
TODO: be meaner"
|
||||
(let ((yas-use-menu t))
|
||||
(yas-with-even-more-interesting-snippet-dirs
|
||||
;; add a group directive conflicting with the subdir and watch
|
||||
;; behaviour
|
||||
(with-temp-buffer
|
||||
(insert "# group: foo-group-c\n# --\nstrecmp($1)")
|
||||
(write-region nil nil (concat (first (yas-snippet-dirs))
|
||||
"/c-mode/foo-group-b/strcmp")))
|
||||
(yas-reload-all 'no-jit)
|
||||
(let ((menu (cdr (gethash 'c-mode yas--menu-table))))
|
||||
(should (eql 4 (length menu)))
|
||||
(dolist (item '("printf" "foo-group-a" "foo-group-b" "foo-group-c"))
|
||||
(should (find item menu :key #'third :test #'string=)))
|
||||
(dolist (submenu '("foo-group-a" "foo-group-b" "foo-group-c"))
|
||||
(should (keymapp
|
||||
(fourth
|
||||
(find submenu menu :key #'third :test #'string=))))))
|
||||
;; delete the .yas-make-groups file and watch behaviour
|
||||
;;
|
||||
(delete-file (concat (first (yas-snippet-dirs))
|
||||
"/c-mode/.yas-make-groups"))
|
||||
(yas-reload-all 'no-jit)
|
||||
(let ((menu (cdr (gethash 'c-mode yas--menu-table))))
|
||||
(should (eql 5 (length menu))))
|
||||
;; Change a group directive and reload
|
||||
;;
|
||||
(let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
|
||||
(should (find "barbar" menu :key #'third :test #'string=)))
|
||||
|
||||
(with-temp-buffer
|
||||
(insert "# group: foofoo\n# --\n(ert-deftest ${1:name} () $0)")
|
||||
(write-region nil nil (concat (first (yas-snippet-dirs))
|
||||
"/lisp-interaction-mode/ert-deftest")))
|
||||
(yas-reload-all 'no-jit)
|
||||
(let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
|
||||
(should (eql 1 (length menu)))
|
||||
(should (find "foofoo" menu :key #'third :test #'string=))
|
||||
(should (keymapp
|
||||
(fourth
|
||||
(find "foofoo" menu :key #'third :test #'string=))))))))
|
||||
|
||||
|
||||
;;; Helpers
|
||||
;;;
|
||||
|
||||
@ -220,12 +339,18 @@ TODO: correct this bug!"
|
||||
(push sym syms))))
|
||||
syms))
|
||||
|
||||
(defun yas-call-with-saving-variables (fn)
|
||||
(let* ((vars (yas-variables))
|
||||
(saved-values (mapcar #'symbol-value vars)))
|
||||
(unwind-protect
|
||||
(funcall fn)
|
||||
(loop for var in vars
|
||||
for saved in saved-values
|
||||
do (set var saved)))))
|
||||
|
||||
(defmacro yas-saving-variables (&rest body)
|
||||
`(let ,(mapcar #'(lambda (sym)
|
||||
`(,sym ,sym))
|
||||
(yas-variables))
|
||||
,@body))
|
||||
`(yas-call-with-saving-variables #'(lambda () ,@body)))
|
||||
|
||||
|
||||
(defun yas-call-with-snippet-dirs (dirs fn)
|
||||
(let* ((default-directory (make-temp-file "yasnippet-fixture" t))
|
||||
@ -253,5 +378,9 @@ TODO: correct this bug!"
|
||||
;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert-x.el
|
||||
;;; /usr/bin/emacs -nw -Q -L . -l yasnippet-tests.el --batch -e ert
|
||||
|
||||
|
||||
(provide 'yasnippet-tests)
|
||||
;;; yasnippet-tests.el ends here
|
||||
;; Local Variables:
|
||||
;; lexical-binding: t
|
||||
;; End:
|
||||
|
||||
126
yasnippet.el
126
yasnippet.el
@ -361,7 +361,9 @@ Any other non-nil value, every submenu is listed."
|
||||
(const :tag "No menu" nil))
|
||||
:group 'yasnippet)
|
||||
|
||||
(defcustom yas-trigger-symbol " =>"
|
||||
(defcustom yas-trigger-symbol (if (eq window-system 'mac)
|
||||
(char-to-string ?\x21E5) ;; little ->| sign
|
||||
" =>")
|
||||
"The text that will be used in menu to represent the trigger."
|
||||
:type 'string
|
||||
:group 'yasnippet)
|
||||
@ -1065,7 +1067,7 @@ keybinding)."
|
||||
(let ((name (yas--template-name template))
|
||||
(key (yas--template-key template))
|
||||
(keybinding (yas--template-keybinding template))
|
||||
(menu-binding-pair (yas--snippet-menu-binding-pair-get-create template)))
|
||||
(menu-binding-pair (yas--template-menu-binding-pair-get-create template)))
|
||||
(dolist (k (remove nil (list key keybinding)))
|
||||
(puthash name
|
||||
template
|
||||
@ -1077,14 +1079,10 @@ keybinding)."
|
||||
(when (vectorp k)
|
||||
(define-key (yas--table-direct-keymap table) k 'yas-expand-from-keymap)))
|
||||
|
||||
;; Update trigger & keybinding in the menu-binding pair
|
||||
;;
|
||||
(unless (eq (cdr menu-binding-pair) :none)
|
||||
(setf (getf (cdr (car menu-binding-pair)) :keys)
|
||||
(or (and keybinding (key-description keybinding))
|
||||
(and key (concat key yas-trigger-symbol)))))
|
||||
|
||||
(puthash (yas--template-uuid template) template (yas--table-uuidhash table))))
|
||||
;; Update TABLE's `yas--table-uuidhash'
|
||||
(puthash (yas--template-uuid template)
|
||||
template
|
||||
(yas--table-uuidhash table))))
|
||||
|
||||
(defun yas--update-template (table template)
|
||||
"Add or update TEMPLATE in TABLE.
|
||||
@ -1098,33 +1096,52 @@ Also takes care of adding and updating to the associated menu."
|
||||
(yas--add-template table template)
|
||||
;; Take care of the menu
|
||||
;;
|
||||
(let ((keymap
|
||||
(yas--menu-keymap-get-create (yas--table-mode table)
|
||||
(mapcar #'yas--table-mode
|
||||
(yas--table-parents table))))
|
||||
(group (yas--template-group template)))
|
||||
(when (and yas-use-menu
|
||||
keymap
|
||||
(not (cdr (yas--template-menu-binding-pair template))))
|
||||
(when yas-use-menu
|
||||
(yas--update-template-menu table template)))
|
||||
|
||||
(defun yas--update-template-menu (table template)
|
||||
"Update every menu-related for TEMPLATE"
|
||||
(let ((menu-binding-pair (yas--template-menu-binding-pair-get-create template))
|
||||
(key (yas--template-key template))
|
||||
(keybinding (yas--template-keybinding template)))
|
||||
;; The snippet might have changed name or keys, so update
|
||||
;; user-visible strings
|
||||
;;
|
||||
(unless (eq (cdr menu-binding-pair) :none)
|
||||
;; the menu item name
|
||||
;;
|
||||
(setf (cadar menu-binding-pair) (yas--template-name template))
|
||||
;; the :keys information (also visible to the user)
|
||||
(setf (getf (cdr (car menu-binding-pair)) :keys)
|
||||
(or (and keybinding (key-description keybinding))
|
||||
(and key (concat key yas-trigger-symbol))))))
|
||||
(unless (yas--template-menu-managed-by-yas-define-menu template)
|
||||
(let ((menu-keymap
|
||||
(yas--menu-keymap-get-create (yas--table-mode table)
|
||||
(mapcar #'yas--table-mode
|
||||
(yas--table-parents table))))
|
||||
(group (yas--template-group template)))
|
||||
;; Remove from menu keymap
|
||||
;;
|
||||
(yas--delete-from-keymap keymap (yas--template-uuid template))
|
||||
(assert menu-keymap)
|
||||
(yas--delete-from-keymap menu-keymap (yas--template-uuid template))
|
||||
|
||||
;; Add necessary subgroups as necessary.
|
||||
;;
|
||||
(dolist (subgroup group)
|
||||
(let ((subgroup-keymap (lookup-key keymap (vector (make-symbol subgroup)))))
|
||||
(let ((subgroup-keymap (lookup-key menu-keymap (vector (make-symbol subgroup)))))
|
||||
(unless (and subgroup-keymap
|
||||
(keymapp subgroup-keymap))
|
||||
(setq subgroup-keymap (make-sparse-keymap))
|
||||
(define-key keymap (vector (make-symbol subgroup))
|
||||
(define-key menu-keymap (vector (make-symbol subgroup))
|
||||
`(menu-item ,subgroup ,subgroup-keymap)))
|
||||
(setq keymap subgroup-keymap)))
|
||||
(setq menu-keymap subgroup-keymap)))
|
||||
|
||||
;; Add this entry to the keymap
|
||||
;;
|
||||
(let ((menu-binding-pair (yas--snippet-menu-binding-pair-get-create template)))
|
||||
(define-key keymap (vector (make-symbol (yas--template-uuid template))) (car menu-binding-pair))))))
|
||||
(define-key menu-keymap
|
||||
(vector (make-symbol (yas--template-uuid template)))
|
||||
(car (yas--template-menu-binding-pair template))))))
|
||||
|
||||
(defun yas--namehash-templates-alist (namehash)
|
||||
(let (alist)
|
||||
@ -1776,8 +1793,7 @@ loading."
|
||||
;; Init the `yas-minor-mode-map', taking care not to break the
|
||||
;; menu....
|
||||
;;
|
||||
(setf (cdr yas-minor-mode-map)
|
||||
(cdr (yas--init-minor-keymap)))
|
||||
(setcdr yas-minor-mode-map (cdr (yas--init-minor-keymap)))
|
||||
|
||||
;; Reload the directories listed in `yas-snippet-dirs' or prompt
|
||||
;; the user to select one.
|
||||
@ -1903,9 +1919,9 @@ This works by stubbing a few functions, then calling
|
||||
|
||||
(defun yas--define-parents (mode parents)
|
||||
"Add PARENTS to the list of MODE's parents"
|
||||
(puthash mode-sym (remove-duplicates
|
||||
(append parents
|
||||
(gethash mode-sym yas--parents)))
|
||||
(puthash mode (remove-duplicates
|
||||
(append parents
|
||||
(gethash mode yas--parents)))
|
||||
yas--parents))
|
||||
|
||||
(defun yas-define-snippets (mode snippets)
|
||||
@ -1982,7 +1998,39 @@ the current buffers contents."
|
||||
;;
|
||||
template))
|
||||
|
||||
(defun yas--snippet-menu-binding-pair-get-create (template &optional type)
|
||||
|
||||
;;; Apropos snippet menu:
|
||||
;;
|
||||
;; The snippet menu keymaps are store by mode in hash table called
|
||||
;; `yas--menu-table'. They are linked to the main menu in
|
||||
;; `yas--menu-keymap-get-create' and are initially created empty,
|
||||
;; reflecting the table hierarchy.
|
||||
;;
|
||||
;; They can be populated in two mutually exclusive ways: (1) by
|
||||
;; reading `yas--template-group', which in turn is populated by the "#
|
||||
;; group:" directives of the snippets or the ".yas-make-groups" file
|
||||
;; or (2) by using a separate `yas-define-menu' call, which declares a
|
||||
;; menu structure based on snippets uuids.
|
||||
;;
|
||||
;; Both situations are handled in `yas--update-template-menu', which
|
||||
;; uses the predicate `yas--template-menu-managed-by-yas-define-menu'
|
||||
;; that can tell between the two situations.
|
||||
;;
|
||||
;; Note:
|
||||
;;
|
||||
;; * if `yas-define-menu' is used it must run before
|
||||
;; `yas-define-snippets' and the UUIDS must match, otherwise we get
|
||||
;; duplicate entries. The `yas--template' objects are created in
|
||||
;; `yas-define-menu', holding nothing but the menu entry,
|
||||
;; represented by a pair of ((menu-item NAME :keys KEYS) TYPE) and
|
||||
;; stored in `yas--template-menu-binding-pair'. The (menu-item ...)
|
||||
;; part is then stored in the menu keymap itself which make the item
|
||||
;; appear to the user. These limitations could probably be revised.
|
||||
;;
|
||||
;; * The `yas--template-perm-group' slot is only used in
|
||||
;; `yas-describe-tables'.
|
||||
;;
|
||||
(defun yas--template-menu-binding-pair-get-create (template &optional type)
|
||||
"Get TEMPLATE's menu binding or assign it a new one.
|
||||
|
||||
TYPE may be `:stay', signalling this menu binding should be
|
||||
@ -1996,6 +2044,10 @@ static in the menu."
|
||||
,(yas--make-menu-binding template)
|
||||
:keys ,nil)
|
||||
type)))))
|
||||
(defun yas--template-menu-managed-by-yas-define-menu (template)
|
||||
"Non-nil if TEMPLATE's menu entry was included in a `yas-define-menu' call."
|
||||
(cdr (yas--template-menu-binding-pair template)))
|
||||
|
||||
|
||||
(defun yas--show-menu-p (mode)
|
||||
(cond ((eq yas-use-menu 'abbreviate)
|
||||
@ -2004,6 +2056,8 @@ static in the menu."
|
||||
(yas--table-mode table))
|
||||
(yas--get-snippet-tables))))
|
||||
((eq yas-use-menu 'full)
|
||||
t)
|
||||
((eq yas-use-menu t)
|
||||
t)))
|
||||
|
||||
(defun yas--delete-from-keymap (keymap uuid)
|
||||
@ -2031,7 +2085,7 @@ static in the menu."
|
||||
(null (cdr (third (cdr item)))))))
|
||||
(rest keymap))))
|
||||
|
||||
(defun yas-define-menu (mode menu omit-items)
|
||||
(defun yas-define-menu (mode menu &optional omit-items)
|
||||
"Define a snippet menu for MODE according to MENU, ommitting OMIT-ITEMS.
|
||||
|
||||
MENU is a list, its elements can be:
|
||||
@ -2067,7 +2121,7 @@ This function does nothing if `yas-use-menu' is nil.
|
||||
:uuid uuid))))
|
||||
(setf (yas--template-menu-binding-pair template) (cons nil :none)))))))
|
||||
|
||||
(defun yas--define-menu-1 (table keymap menu uuidhash &optional group-list)
|
||||
(defun yas--define-menu-1 (table menu-keymap menu uuidhash &optional group-list)
|
||||
(dolist (e (reverse menu))
|
||||
(cond ((eq (first e) 'yas-item)
|
||||
(let ((template (or (gethash (second e) uuidhash)
|
||||
@ -2077,11 +2131,11 @@ This function does nothing if `yas-use-menu' is nil.
|
||||
:table table
|
||||
:perm-group group-list
|
||||
:uuid (second e)))))
|
||||
(define-key keymap (vector (gensym))
|
||||
(car (yas--snippet-menu-binding-pair-get-create template :stay)))))
|
||||
(define-key menu-keymap (vector (gensym))
|
||||
(car (yas--template-menu-binding-pair-get-create template :stay)))))
|
||||
((eq (first e) 'yas-submenu)
|
||||
(let ((subkeymap (make-sparse-keymap)))
|
||||
(define-key keymap (vector (gensym))
|
||||
(define-key menu-keymap (vector (gensym))
|
||||
`(menu-item ,(second e) ,subkeymap))
|
||||
(yas--define-menu-1 table
|
||||
subkeymap
|
||||
@ -2089,7 +2143,7 @@ This function does nothing if `yas-use-menu' is nil.
|
||||
uuidhash
|
||||
(append group-list (list (second e))))))
|
||||
((eq (first e) 'yas-separator)
|
||||
(define-key keymap (vector (gensym))
|
||||
(define-key menu-keymap (vector (gensym))
|
||||
'(menu-item "----")))
|
||||
(t
|
||||
(yas--message 3 "Don't know anything about menu entry %s" (first e))))))
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user