Permalink
Browse files

refactor: redo and document some of the menu-bar code, also add tests

  • Loading branch information...
1 parent e7f2253 commit 668efefdd43a28355c9f601c76c949cc94caf196 @joaotavora committed Jul 22, 2012
Showing with 230 additions and 47 deletions.
  1. +140 −11 yasnippet-tests.el
  2. +90 −36 yasnippet.el
View
151 yasnippet-tests.el
@@ -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:
View
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,19 +2131,19 @@ 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
(third e)
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))))))

0 comments on commit 668efef

Please sign in to comment.