]> code.delx.au - gnu-emacs-elpa/blobdiff - yasnippet.el
avoid double choices reversing
[gnu-emacs-elpa] / yasnippet.el
index 49514da8156c8fe2678aebc35818939bd56ea6e7..f585b886fddf8a2426c2e2630111a458ffe8948f 100644 (file)
 ;;; Code:
 
 (require 'cl)
+(eval-and-compile
+  (require 'cl-lib))
 (require 'easymenu)
 (require 'help-mode)
 
@@ -183,7 +185,7 @@ as the default for storing the user's new snippets."
 (defvaralias 'yas/root-directory 'yas-snippet-dirs)
 
 (defcustom yas-new-snippet-default "\
-# -*- mode: snippet -*-
+# -*- mode: snippet; require-final-newline: nil -*-
 # name: $1
 # key: ${2:${1:$(yas--key-from-desc yas-text)}}${3:
 # binding: ${4:direct-keybinding}}${5:
@@ -1540,25 +1542,24 @@ Optional PROMPT sets the prompt to use."
   ;; up as `yas--all-templates' I think.
   ;;
   (when (and window-system choices)
-    (let ((chosen
-           (let (menu d) ;; d for display
-             (dolist (c choices)
-               (setq d (or (and display-fn (funcall display-fn c))
-                           c))
-               (cond ((stringp d)
-                      (push (cons (concat "   " d) c) menu))
-                     ((listp d)
-                      (push (car d) menu))))
-             (setq menu (list prompt (push "title" menu)))
-             (x-popup-menu (if (fboundp 'posn-at-point)
-                               (let ((x-y (posn-x-y (posn-at-point (point)))))
-                                 (list (list (+ (car x-y) 10)
-                                             (+ (cdr x-y) 20))
-                                       (selected-window)))
-                             t)
-                           menu))))
-      (or chosen
-          (keyboard-quit)))))
+    (or
+     (let* ((display-fn (or display-fn #'identity))
+            (menu
+             (list prompt
+                   (cons "title"
+                         (mapcar (lambda (c)
+                                   (let ((d (funcall display-fn c)))
+                                     (cond ((stringp d) (cons (concat "   " d) c))
+                                           ((listp d) (car d)))))
+                                 choices)))))
+       (x-popup-menu (if (fboundp 'posn-at-point)
+                         (let ((x-y (posn-x-y (posn-at-point (point)))))
+                           (list (list (+ (car x-y) 10)
+                                       (+ (cdr x-y) 20))
+                                 (selected-window)))
+                       t)
+                     menu))
+     (keyboard-quit))))
 
 (defun yas--x-pretty-prompt-templates (prompt templates)
   "Display TEMPLATES, grouping neatly by table name."
@@ -1599,46 +1600,28 @@ Optional PROMPT sets the prompt to use."
 
 (defun yas-dropdown-prompt (_prompt choices &optional display-fn)
   (when (fboundp 'dropdown-list)
-    (let (formatted-choices
-          filtered-choices
-          d
-          n)
-      (dolist (choice choices)
-        (setq d (or (and display-fn (funcall display-fn choice))
-                      choice))
-        (when (stringp d)
-          (push d formatted-choices)
-          (push choice filtered-choices)))
-
-      (setq n (and formatted-choices (dropdown-list formatted-choices)))
+    (let* ((formatted-choices (if display-fn (delete-if-not display-fn choices)
+                                choices))
+           (filtered-choices (if display-fn (mapcar display-fn filtered-choices)
+                               choices))
+           (n (and formatted-choices
+                   (dropdown-list formatted-choices))))
       (if n
           (nth n filtered-choices)
         (keyboard-quit)))))
 
 (defun yas-completing-prompt (prompt choices &optional display-fn completion-fn)
-  (let (formatted-choices
-        filtered-choices
-        chosen
-        d
-        (completion-fn (or completion-fn
-                           #'completing-read)))
-    (dolist (choice choices)
-      (setq d (or (and display-fn (funcall display-fn choice))
-                    choice))
-      (when (stringp d)
-        (push d formatted-choices)
-        (push choice filtered-choices)))
-    (setq chosen (and formatted-choices
-                      (funcall completion-fn prompt
-                               formatted-choices
-                               nil
-                               'require-match
-                               nil
-                               nil)))
-    (let ((position (or (and chosen
-                             (position chosen formatted-choices :test #'string=))
-                        0)))
-      (nth position filtered-choices))))
+  (let* ((formatted-choices (if display-fn (delete-if-not display-fn choices)
+                              choices))
+         (filtered-choices (if display-fn (mapcar display-fn filtered-choices)
+                             choices))
+         (chosen (and formatted-choices
+                      (funcall (or completion-fn #'completing-read)
+                               prompt formatted-choices
+                               nil 'require-match nil nil)))
+         (position (and chosen
+                        (position chosen formatted-choices :test #'string=))))
+    (nth (or position 0) filtered-choices)))
 
 (defun yas-no-prompt (_prompt choices &optional _display-fn)
   (first choices))
@@ -1929,10 +1912,14 @@ loading."
       ;;
       (yas-direct-keymaps-reload)
 
+      (run-hooks 'yas-after-reload-hook)
       (yas--message 3 "Reloaded everything%s...%s."
                    (if interactive "" " (snippets will load just-in-time)")
                    (if errors " (some errors, check *Messages*)" "")))))
 
+(defvar yas-after-reload-hook nil
+  "Hooks run after `yas-reload-all'.")
+
 (defun yas--load-pending-jits ()
   (dolist (mode (yas--modes-to-activate))
     (let ((funs (reverse (gethash mode yas--scheduled-jit-loads))))
@@ -2276,7 +2263,8 @@ Common gateway for `yas-expand-from-trigger-key' and
            (yas--message 4 "Falling back to %s"  beyond-yasnippet)
            (assert (or (null beyond-yasnippet) (commandp beyond-yasnippet)))
            (setq this-original-command beyond-yasnippet)
-           (call-interactively beyond-yasnippet)))
+           (when beyond-yasnippet
+             (call-interactively beyond-yasnippet))))
         ((and (listp yas-fallback-behavior)
               (cdr yas-fallback-behavior)
               (eq 'apply (car yas-fallback-behavior)))
@@ -2801,10 +2789,11 @@ If found, the content of subexp group SUBEXP (default 0) is
 The last element of POSSIBILITIES may be a list of strings."
   (unless (or yas-moving-away-p
               yas-modified-p)
-    (setq possibilities (nreverse possibilities))
-    (setq possibilities (if (listp (car possibilities))
-                            (append (reverse (car possibilities)) (rest possibilities))
-                                   possibilities))
+    (let* ((last-link (last possibilities))
+           (last-elem (car last-link)))
+      (when (listp last-elem)
+        (setcar last-link (car last-elem))
+        (setcdr last-link (cdr last-elem))))
     (some #'(lambda (fn)
               (funcall fn "Choose: " possibilities))
           yas-prompt-functions)))
@@ -4442,7 +4431,7 @@ and return the directory.  Return nil if not found."
 \f
 ;;; Backward compatibility to yasnippet <= 0.7
 
-(defvar yas--exported-syms '(;; `defcustom's
+(defvar yas--backported-syms '(;; `defcustom's
                              ;;
                              yas-snippet-dirs
                              yas-prompt-functions
@@ -4531,7 +4520,6 @@ and return the directory.  Return nil if not found."
                              yas-unimplemented
                              yas-define-condition-cache
                              yas-hippie-try-expand
-                             yas-active-keys
 
                              ;; debug definitions
                              ;; yas-debug-snippet-vars
@@ -4548,16 +4536,11 @@ and return the directory.  Return nil if not found."
                              ;; yas-call-with-snippet-dirs
                              ;; yas-with-snippet-dirs
 )
-  "Exported yasnippet symbols.
+  "Backported yasnippet symbols.
 
-i.e. ones that I will try to keep in future yasnippet versions
-and ones that other elisp libraries can more or less safely rely
-upon.")
+They are mapped to \"yas/*\" variants.")
 
-(defvar yas--dont-backport '(yas-active-keys)
-  "Exported symbols that don't map back to \"yas/*\" variants.")
-
-(dolist (sym (set-difference yas--exported-syms yas--dont-backport))
+(dolist (sym yas--backported-syms)
   (let ((backported (intern (replace-regexp-in-string "^yas-" "yas/" (symbol-name sym)))))
     (when (boundp sym)
       (make-obsolete-variable backported sym "yasnippet 0.8")
@@ -4566,6 +4549,22 @@ upon.")
       (make-obsolete backported sym "yasnippet 0.8")
       (defalias backported sym))))
 
+(defvar yas--exported-syms
+  (let (exported)
+    (mapatoms (lambda (atom)
+                (if (and (or (and (boundp atom)
+                                  (not (get atom 'byte-obsolete-variable)))
+                             (and (fboundp atom)
+                                  (not (get atom 'byte-obsolete-info))))
+                         (string-match-p "^yas-[^-]" (symbol-name atom)))
+                    (push atom exported))))
+    exported)
+  "Exported yasnippet symbols.
+
+i.e. the ones with \"yas-\" single dash prefix. I will try to
+keep them in future yasnippet versions and other elisp libraries
+can more or less safely rely upon them.")
+
 \f
 (provide 'yasnippet)