* Reacessing prompting code, fixed some bugs...

* Added a hack in `yas/x-prompt-pretty-templates'.
This commit is contained in:
capitaomorte 2010-04-07 16:45:20 +00:00
parent df408a1c00
commit ef47045cab

View File

@ -1026,7 +1026,10 @@ keybinding)."
(yas/add-template snippet-table template)) (yas/add-template snippet-table template))
(defun yas/fetch (table key) (defun yas/fetch (table key)
"Fetch snippets in TABLE by KEY. " "Fetch templates in TABLE by KEY.
Return a list of cons (NAME . TEMPLATE) where NAME is a
string and TEMPLATE is a `yas/template' structure."
(let* ((keyhash (yas/table-hash table)) (let* ((keyhash (yas/table-hash table))
(namehash (and keyhash (gethash key keyhash)))) (namehash (and keyhash (gethash key keyhash))))
(when namehash (when namehash
@ -1443,67 +1446,110 @@ TEMPLATES is a list of `yas/template'."
yas/prompt-functions))) yas/prompt-functions)))
(defun yas/x-prompt (prompt choices &optional display-fn) (defun yas/x-prompt (prompt choices &optional display-fn)
"Display choices in a x-window prompt."
;; FIXME: HACK: if we notice that one of the objects in choices is
;; actually a `yas/template', defer to `yas/x-prompt-pretty-templates'
;;
;; This would be better implemented by passing CHOICES as a
;; strucutred tree rather than a list. Modifications would go as far
;; up as `yas/all-templates' I think.
;;
(when (and window-system choices) (when (and window-system choices)
(let ((keymap (cons 'keymap (let ((chosen
(cons (if (yas/template-p (first choices))
prompt (yas/x-prompt-pretty-templates prompt choices)
(mapcar (lambda (choice) (let (menu d) ;; d for display
(list choice (dolist (c choices)
'menu-item (setq d (or (and display-fn (funcall display-fn c))
(if display-fn c))
(funcall display-fn choice) (cond ((stringp d)
choice) (push (cons (concat " " d) c) menu))
t)) ((listp d)
choices))))) (push (car d) menu))))
(when (cdr keymap) (setq menu (list prompt (push "title" menu)))
(car (x-popup-menu (if (fboundp 'posn-at-point) (x-popup-menu (if (fboundp 'posn-at-point)
(let ((x-y (posn-x-y (posn-at-point (point))))) (let ((x-y (posn-x-y (posn-at-point (point)))))
(list (list (+ (car x-y) 10) (list (list (+ (car x-y) 10)
(+ (cdr x-y) 20)) (+ (cdr x-y) 20))
(selected-window))) (selected-window)))
t) t)
keymap)))))) menu)))))
(or chosen
(keyboard-quit)))))
(defun yas/x-prompt-pretty-templates (prompt templates)
"Display TEMPLATES, grouping neatly by table name."
(let ((props (list))
menu
more-than-one-table
prefix)
(dolist (tl templates)
(push tl (getf props (intern (yas/table-name (yas/template-table tl))))))
(setq more-than-one-table (> (length props) 2))
(setq prefix (if more-than-one-table
" " ""))
(dolist (thing props)
(cond ((listp thing)
(setq menu (nconc (mapcar #'(lambda (tl)
(cons (concat prefix (yas/template-name tl))
tl))
thing)
menu)))
(more-than-one-table
(push (symbol-name thing) menu))))
(setq menu (nreverse 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)
(list prompt (push "title" menu)))))
(defun yas/ido-prompt (prompt choices &optional display-fn) (defun yas/ido-prompt (prompt choices &optional display-fn)
(when (and (featurep 'ido) (when (and (featurep 'ido)
ido-mode) ido-mode)
(let* ((formatted-choices (or (and display-fn (yas/completing-prompt prompt choices display-fn #'ido-completing-read)))
(mapcar display-fn choices))
choices))
(chosen (and formatted-choices
(ido-completing-read prompt
formatted-choices
nil
'require-match
nil
nil))))
(when chosen
(nth (position chosen formatted-choices :test #'string=) choices)))))
(eval-when-compile (require 'dropdown-list nil t)) (eval-when-compile (require 'dropdown-list nil t))
(defun yas/dropdown-prompt (prompt choices &optional display-fn) (defun yas/dropdown-prompt (prompt choices &optional display-fn)
(when (featurep 'dropdown-list) (when (featurep 'dropdown-list)
(let* ((formatted-choices (or (and display-fn (let (formatted-choices
(mapcar display-fn choices)) filtered-choices
choices)) chosen
(chosen (and formatted-choices d)
(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
(nth (dropdown-list formatted-choices) (nth (dropdown-list formatted-choices)
choices)))) filtered-choices))))))
chosen)))
(defun yas/completing-prompt (prompt choices &optional display-fn) (defun yas/completing-prompt (prompt choices &optional display-fn completion-fn)
(let* ((formatted-choices (or (and display-fn (let (formatted-choices
(mapcar display-fn choices)) filtered-choices
choices)) chosen
(chosen (and formatted-choices d
(completing-read prompt (completion-fn (or completion-fn
formatted-choices #'completing-read)))
nil (dolist (choice choices)
'require-match (setq d (or (and display-fn (funcall display-fn choice))
nil choice))
nil)))) (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)))
(when chosen (when chosen
(nth (position chosen formatted-choices :test #'string=) choices)))) (nth (position chosen formatted-choices :test #'string=) filtered-choices))))
(defun yas/no-prompt (prompt choices &optional display-fn) (defun yas/no-prompt (prompt choices &optional display-fn)
(first choices)) (first choices))