From 668efefdd43a28355c9f601c76c949cc94caf196 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 22 Jul 2012 19:11:28 +0100 Subject: [PATCH] refactor: redo and document some of the menu-bar code, also add tests --- yasnippet-tests.el | 151 +++++++++++++++++++++++++++++++++++++++++---- yasnippet.el | 126 ++++++++++++++++++++++++++----------- 2 files changed, 230 insertions(+), 47 deletions(-) diff --git a/yasnippet-tests.el b/yasnippet-tests.el index 9ac687f..536fea2 100644 --- a/yasnippet-tests.el +++ b/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: diff --git a/yasnippet.el b/yasnippet.el index 98bffa2..d932f5b 100644 --- a/yasnippet.el +++ b/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))))))