|
code@51
|
1 |
;;; yasnippet.el --- Yet another snippet extension for Emacs.
|
|
code@51
|
2 |
|
|
code@51
|
3 |
;; Copyright 2008 pluskid
|
|
code@51
|
4 |
;;
|
|
code@51
|
5 |
;; Author: pluskid <pluskid@gmail.com>
|
|
code@51
|
6 |
;; Version: 0.5.2
|
|
code@51
|
7 |
;; X-URL: http://code.google.com/p/yasnippet/
|
|
code@51
|
8 |
|
|
code@51
|
9 |
;; This file is free software; you can redistribute it and/or modify
|
|
code@51
|
10 |
;; it under the terms of the GNU General Public License as published by
|
|
code@51
|
11 |
;; the Free Software Foundation; either version 2, or (at your option)
|
|
code@51
|
12 |
;; any later version.
|
|
code@51
|
13 |
|
|
code@51
|
14 |
;; This file is distributed in the hope that it will be useful,
|
|
code@51
|
15 |
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
code@51
|
16 |
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
code@51
|
17 |
;; GNU General Public License for more details.
|
|
code@51
|
18 |
|
|
code@51
|
19 |
;; You should have received a copy of the GNU General Public License
|
|
code@51
|
20 |
;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
code@51
|
21 |
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
code@51
|
22 |
;; Boston, MA 02111-1307, USA.
|
|
code@51
|
23 |
|
|
code@51
|
24 |
;;; Commentary:
|
|
code@51
|
25 |
|
|
code@51
|
26 |
;; Basic steps to setup:
|
|
code@51
|
27 |
;; 1. Place `yasnippet.el' in your `load-path'.
|
|
code@51
|
28 |
;; 2. In your .emacs file:
|
|
code@51
|
29 |
;; (require 'yasnippet)
|
|
code@51
|
30 |
;; 3. Place the `snippets' directory somewhere. E.g: ~/.emacs.d/snippets
|
|
code@51
|
31 |
;; 4. In your .emacs file
|
|
code@51
|
32 |
;; (yas/initialize)
|
|
code@51
|
33 |
;; (yas/load-directory "~/.emacs.d/snippets")
|
|
code@51
|
34 |
;;
|
|
code@51
|
35 |
;; For more information and detailed usage, refer to the project page:
|
|
code@51
|
36 |
;; http://code.google.com/p/yasnippet/
|
|
code@51
|
37 |
|
|
code@51
|
38 |
(require 'cl)
|
|
code@51
|
39 |
|
|
code@51
|
40 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
41 |
;; User customizable variables
|
|
code@51
|
42 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
43 |
(defvar yas/key-syntaxes (list "w" "w_" "w_." "^ ")
|
|
code@51
|
44 |
"A list of syntax of a key. This list is tried in the order
|
|
code@51
|
45 |
to try to find a key. For example, if the list is '(\"w\" \"w_\").
|
|
code@51
|
46 |
And in emacs-lisp-mode, where \"-\" has the syntax of \"_\":
|
|
code@51
|
47 |
|
|
code@51
|
48 |
foo-bar
|
|
code@51
|
49 |
|
|
code@51
|
50 |
will first try \"bar\", if not found, then \"foo-bar\" is tried.")
|
|
code@51
|
51 |
|
|
code@51
|
52 |
(defvar yas/root-directory nil
|
|
code@51
|
53 |
"The (list of) root directory that stores the snippets for each
|
|
code@51
|
54 |
major modes.")
|
|
code@51
|
55 |
|
|
code@51
|
56 |
(defvar yas/indent-line t
|
|
code@51
|
57 |
"Each (except the 1st) line of the snippet template is indented to
|
|
code@51
|
58 |
current column if this variable is non-`nil'.")
|
|
code@51
|
59 |
(make-variable-buffer-local 'yas/indent-line)
|
|
code@51
|
60 |
|
|
code@51
|
61 |
(defvar yas/trigger-key (kbd "TAB")
|
|
code@51
|
62 |
"The key to bind as a trigger of snippet.")
|
|
code@51
|
63 |
(defvar yas/next-field-key (kbd "TAB")
|
|
code@51
|
64 |
"The key to navigate to next field.")
|
|
code@51
|
65 |
|
|
code@51
|
66 |
(defvar yas/keymap (make-sparse-keymap)
|
|
code@51
|
67 |
"The keymap of snippet.")
|
|
code@51
|
68 |
(define-key yas/keymap yas/next-field-key 'yas/next-field-group)
|
|
code@51
|
69 |
(define-key yas/keymap (kbd "S-TAB") 'yas/prev-field-group)
|
|
code@51
|
70 |
(define-key yas/keymap (kbd "<S-iso-lefttab>") 'yas/prev-field-group)
|
|
code@51
|
71 |
(define-key yas/keymap (kbd "<S-tab>") 'yas/prev-field-group)
|
|
code@51
|
72 |
(define-key yas/keymap (kbd "<backtab>") 'yas/prev-field-group)
|
|
code@51
|
73 |
|
|
code@51
|
74 |
(defvar yas/show-all-modes-in-menu nil
|
|
code@51
|
75 |
"Currently yasnippet only all \"real modes\" to menubar. For
|
|
code@51
|
76 |
example, you define snippets for \"cc-mode\" and make it the
|
|
code@51
|
77 |
parent of `c-mode', `c++-mode' and `java-mode'. There's really
|
|
code@51
|
78 |
no such mode like \"cc-mode\". So we don't show it in the yasnippet
|
|
code@51
|
79 |
menu to avoid the menu becoming too big with strange modes. The
|
|
code@51
|
80 |
snippets defined for \"cc-mode\" can still be accessed from
|
|
code@51
|
81 |
menu-bar->c-mode->parent (or c++-mode, java-mode, all are ok).
|
|
code@51
|
82 |
However, if you really like to show all modes in the menu, set
|
|
code@51
|
83 |
this variable to t.")
|
|
code@51
|
84 |
(defvar yas/use-menu t
|
|
code@51
|
85 |
"If this is set to `t', all snippet template of the current
|
|
code@51
|
86 |
mode will be listed under the menu \"yasnippet\".")
|
|
code@51
|
87 |
(defvar yas/trigger-symbol " =>"
|
|
code@51
|
88 |
"The text that will be used in menu to represent the trigger.")
|
|
code@51
|
89 |
|
|
code@51
|
90 |
(defface yas/field-highlight-face
|
|
code@51
|
91 |
'((((class color) (background light)) (:background "DarkSeaGreen2"))
|
|
code@51
|
92 |
(t (:background "DimGrey")))
|
|
code@51
|
93 |
"The face used to highlight a field of snippet.")
|
|
code@51
|
94 |
(defface yas/mirror-highlight-face
|
|
code@51
|
95 |
'((((class color) (background light)) (:background "LightYellow2"))
|
|
code@51
|
96 |
(t (:background "gray22")))
|
|
code@51
|
97 |
"The face used to highlight mirror fields of a snippet.")
|
|
code@51
|
98 |
|
|
code@51
|
99 |
(defvar yas/window-system-popup-function #'yas/dropdown-list-popup-for-template
|
|
code@51
|
100 |
"When there's multiple candidate for a snippet key. This function
|
|
code@51
|
101 |
is called to let user select one of them. `yas/text-popup-function'
|
|
code@51
|
102 |
is used instead when not in a window system.")
|
|
code@51
|
103 |
(defvar yas/text-popup-function #'yas/dropdown-list-popup-for-template
|
|
code@51
|
104 |
"When there's multiple candidate for a snippet key. If not in a
|
|
code@51
|
105 |
window system, this function is called to let user select one of
|
|
code@51
|
106 |
them. `yas/window-system-popup-function' is used instead when in
|
|
code@51
|
107 |
a window system.")
|
|
code@51
|
108 |
|
|
code@51
|
109 |
(defvar yas/extra-mode-hooks
|
|
code@51
|
110 |
'(ruby-mode-hook actionscript-mode-hook)
|
|
code@51
|
111 |
"A list of mode-hook that should be hooked to enable yas/minor-mode.
|
|
code@51
|
112 |
Most modes need no special consideration. Some mode (like ruby-mode)
|
|
code@51
|
113 |
doesn't call `after-change-major-mode-hook' need to be hooked explicitly.")
|
|
code@51
|
114 |
|
|
code@51
|
115 |
(defvar yas/after-exit-snippet-hook
|
|
code@51
|
116 |
'()
|
|
code@51
|
117 |
"Hooks to run after a snippet exited.
|
|
code@51
|
118 |
The hooks will be run in an environment where some variables bound to
|
|
code@51
|
119 |
proper values:
|
|
code@51
|
120 |
* yas/snippet-beg : The beginning of the region of the snippet.
|
|
code@51
|
121 |
* yas/snippet-end : Similar to beg.")
|
|
code@51
|
122 |
|
|
code@51
|
123 |
(defvar yas/before-expand-snippet-hook
|
|
code@51
|
124 |
'()
|
|
code@51
|
125 |
"Hooks to run after a before expanding a snippet.")
|
|
code@51
|
126 |
|
|
code@51
|
127 |
(defvar yas/buffer-local-condition
|
|
code@51
|
128 |
'(if (and (not (bobp))
|
|
code@51
|
129 |
(or (equal "font-lock-comment-face"
|
|
code@51
|
130 |
(get-char-property (1- (point))
|
|
code@51
|
131 |
'face))
|
|
code@51
|
132 |
(equal "font-lock-string-face"
|
|
code@51
|
133 |
(get-char-property (1- (point))
|
|
code@51
|
134 |
'face))))
|
|
code@51
|
135 |
'(require-snippet-condition . force-in-comment)
|
|
code@51
|
136 |
t)
|
|
code@51
|
137 |
"Condition to yasnippet local to each buffer.
|
|
code@51
|
138 |
|
|
code@51
|
139 |
* If yas/buffer-local-condition evaluate to nil, snippet
|
|
code@51
|
140 |
won't be expanded.
|
|
code@51
|
141 |
|
|
code@51
|
142 |
* If it evaluate to the a cons cell where the car is the
|
|
code@51
|
143 |
symbol require-snippet-condition and the cdr is a
|
|
code@51
|
144 |
symbol (let's call it requirement):
|
|
code@51
|
145 |
* If the snippet has no condition, then it won't be
|
|
code@51
|
146 |
expanded.
|
|
code@51
|
147 |
* If the snippet has a condition but evaluate to nil or
|
|
code@51
|
148 |
error occured during evaluation, it won't be expanded.
|
|
code@51
|
149 |
* If the snippet has a condition that evaluate to
|
|
code@51
|
150 |
non-nil (let's call it result):
|
|
code@51
|
151 |
* If requirement is t, the snippet is ready to be
|
|
code@51
|
152 |
expanded.
|
|
code@51
|
153 |
* If requirement is eq to result, the snippet is ready
|
|
code@51
|
154 |
to be expanded.
|
|
code@51
|
155 |
* Otherwise the snippet won't be expanded.
|
|
code@51
|
156 |
* If it evaluate to other non-nil value:
|
|
code@51
|
157 |
* If the snippet has no condition, or has a condition that
|
|
code@51
|
158 |
evaluate to non-nil, it is ready to be expanded.
|
|
code@51
|
159 |
* Otherwise, it won't be expanded.
|
|
code@51
|
160 |
|
|
code@51
|
161 |
Here's an example:
|
|
code@51
|
162 |
|
|
code@51
|
163 |
(add-hook 'python-mode-hook
|
|
code@51
|
164 |
'(lambda ()
|
|
code@51
|
165 |
(setq yas/buffer-local-condition
|
|
code@51
|
166 |
'(if (python-in-string/comment)
|
|
code@51
|
167 |
'(require-snippet-condition . force-in-comment)
|
|
code@51
|
168 |
t))))")
|
|
code@51
|
169 |
|
|
code@51
|
170 |
(defvar yas/fallback-behavior 'call-other-command
|
|
code@51
|
171 |
"The fall back behavior of YASnippet when it can't find a snippet
|
|
code@51
|
172 |
to expand.
|
|
code@51
|
173 |
|
|
code@51
|
174 |
* 'call-other-command means try to temporarily disable
|
|
code@51
|
175 |
YASnippet and call other command bound to `yas/trigger-key'.
|
|
code@51
|
176 |
* 'return-nil means return nil.")
|
|
code@51
|
177 |
|
|
code@51
|
178 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
179 |
;; Internal variables
|
|
code@51
|
180 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
181 |
(defvar yas/version "0.5.2")
|
|
code@51
|
182 |
|
|
code@51
|
183 |
(defvar yas/snippet-tables (make-hash-table)
|
|
code@51
|
184 |
"A hash table of snippet tables corresponding to each major-mode.")
|
|
code@51
|
185 |
(defvar yas/menu-table (make-hash-table)
|
|
code@51
|
186 |
"A hash table of menus of corresponding major-mode.")
|
|
code@51
|
187 |
(defvar yas/menu-keymap (make-sparse-keymap "YASnippet"))
|
|
code@51
|
188 |
;; empty menu will cause problems, so we insert some items
|
|
code@51
|
189 |
(define-key yas/menu-keymap [yas/about]
|
|
code@51
|
190 |
'(menu-item "About" yas/about))
|
|
code@51
|
191 |
(define-key yas/menu-keymap [yas/reload]
|
|
code@51
|
192 |
'(menu-item "Reload all snippets" yas/reload-all))
|
|
code@51
|
193 |
(define-key yas/menu-keymap [yas/load]
|
|
code@51
|
194 |
'(menu-item "Load snippets..." yas/load-directory))
|
|
code@51
|
195 |
(define-key yas/menu-keymap [yas/separator]
|
|
code@51
|
196 |
'(menu-item "--"))
|
|
code@51
|
197 |
|
|
code@51
|
198 |
(defvar yas/known-modes
|
|
code@51
|
199 |
'(ruby-mode rst-mode)
|
|
code@51
|
200 |
"A list of mode which is well known but not part of emacs.")
|
|
code@51
|
201 |
(defconst yas/escape-backslash
|
|
code@51
|
202 |
(concat "YASESCAPE" "BACKSLASH" "PROTECTGUARD"))
|
|
code@51
|
203 |
(defconst yas/escape-dollar
|
|
code@51
|
204 |
(concat "YASESCAPE" "DOLLAR" "PROTECTGUARD"))
|
|
code@51
|
205 |
(defconst yas/escape-backquote
|
|
code@51
|
206 |
(concat "YASESCAPE" "BACKQUOTE" "PROTECTGUARD"))
|
|
code@51
|
207 |
|
|
code@51
|
208 |
(defconst yas/field-regexp
|
|
code@51
|
209 |
(concat "$\\([0-9]+\\)" "\\|"
|
|
code@51
|
210 |
"${\\(?:\\([0-9]+\\):\\)?\\([^}]*\\)}"))
|
|
code@51
|
211 |
|
|
code@51
|
212 |
(defvar yas/snippet-id-seed 0
|
|
code@51
|
213 |
"Contains the next id for a snippet")
|
|
code@51
|
214 |
(defun yas/snippet-next-id ()
|
|
code@51
|
215 |
(let ((id yas/snippet-id-seed))
|
|
code@51
|
216 |
(incf yas/snippet-id-seed)
|
|
code@51
|
217 |
id))
|
|
code@51
|
218 |
|
|
code@51
|
219 |
(defvar yas/overlay-modification-hooks
|
|
code@51
|
220 |
(list 'yas/overlay-modification-hook)
|
|
code@51
|
221 |
"The list of hooks to the overlay modification event.")
|
|
code@51
|
222 |
(defvar yas/overlay-insert-in-front-hooks
|
|
code@51
|
223 |
(list 'yas/overlay-insert-in-front-hook)
|
|
code@51
|
224 |
"The list of hooks of the overlay inserted in front event.")
|
|
code@51
|
225 |
(defvar yas/keymap-overlay-modification-hooks
|
|
code@51
|
226 |
(list 'yas/overlay-maybe-insert-behind-hook)
|
|
code@51
|
227 |
"The list of hooks of the big keymap overlay modification event.")
|
|
code@51
|
228 |
|
|
code@51
|
229 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
230 |
;; YASnippet minor mode
|
|
code@51
|
231 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
232 |
(defvar yas/minor-mode-map (make-sparse-keymap)
|
|
code@51
|
233 |
"The keymap of yas/minor-mode")
|
|
code@51
|
234 |
(defvar yas/minor-mode-on-hook nil
|
|
code@51
|
235 |
"Hook to call when yas/minor-mode is on.")
|
|
code@51
|
236 |
(defvar yas/minor-mode-off-hook nil
|
|
code@51
|
237 |
"Hook to call when yas/minor-mode is off.")
|
|
code@51
|
238 |
(define-minor-mode yas/minor-mode
|
|
code@51
|
239 |
"Toggle YASnippet mode.
|
|
code@51
|
240 |
With no argument, this command toggles the mode.
|
|
code@51
|
241 |
positive prefix argument turns on the mode.
|
|
code@51
|
242 |
Negative prefix argument turns off the mode.
|
|
code@51
|
243 |
|
|
code@51
|
244 |
When YASnippet mode is enabled, the TAB key
|
|
code@51
|
245 |
expands snippets of code depending on the mode.
|
|
code@51
|
246 |
|
|
code@51
|
247 |
You can customize the key through `yas/trigger-key'."
|
|
code@51
|
248 |
;; The initial value.
|
|
code@51
|
249 |
nil
|
|
code@51
|
250 |
;; The indicator for the mode line.
|
|
code@51
|
251 |
" yas"
|
|
code@51
|
252 |
:group 'editing
|
|
code@51
|
253 |
(define-key yas/minor-mode-map yas/trigger-key 'yas/expand))
|
|
code@51
|
254 |
|
|
code@51
|
255 |
(defun yas/minor-mode-on ()
|
|
code@51
|
256 |
"Turn on YASnippet minor mode."
|
|
code@51
|
257 |
(interactive)
|
|
code@51
|
258 |
(yas/minor-mode 1))
|
|
code@51
|
259 |
(defun yas/minor-mode-off ()
|
|
code@51
|
260 |
"Turn off YASnippet minor mode."
|
|
code@51
|
261 |
(interactive)
|
|
code@51
|
262 |
(yas/minor-mode -1))
|
|
code@51
|
263 |
|
|
code@51
|
264 |
|
|
code@51
|
265 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
266 |
;; Internal Structs
|
|
code@51
|
267 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
268 |
(defstruct (yas/template (:constructor yas/make-template
|
|
code@51
|
269 |
(content name condition)))
|
|
code@51
|
270 |
"A template for a snippet."
|
|
code@51
|
271 |
content
|
|
code@51
|
272 |
name
|
|
code@51
|
273 |
condition)
|
|
code@51
|
274 |
(defstruct (yas/snippet (:constructor yas/make-snippet ()))
|
|
code@51
|
275 |
"A snippet."
|
|
code@51
|
276 |
(groups nil)
|
|
code@51
|
277 |
(exit-marker nil)
|
|
code@51
|
278 |
(id (yas/snippet-next-id) :read-only t)
|
|
code@51
|
279 |
(overlay nil))
|
|
code@51
|
280 |
(defstruct (yas/group (:constructor yas/make-group (primary-field snippet)))
|
|
code@51
|
281 |
"A group contains a list of field with the same number."
|
|
code@51
|
282 |
primary-field
|
|
code@51
|
283 |
(fields (list primary-field))
|
|
code@51
|
284 |
(next nil)
|
|
code@51
|
285 |
(prev nil)
|
|
code@51
|
286 |
snippet)
|
|
code@51
|
287 |
(defstruct (yas/field
|
|
code@51
|
288 |
(:constructor yas/make-field (overlay number value transform)))
|
|
code@51
|
289 |
"A field in a snippet."
|
|
code@51
|
290 |
overlay
|
|
code@51
|
291 |
number
|
|
code@51
|
292 |
transform
|
|
code@51
|
293 |
value)
|
|
code@51
|
294 |
(defstruct (yas/snippet-table (:constructor yas/make-snippet-table ()))
|
|
code@51
|
295 |
"A table to store snippets for a perticular mode."
|
|
code@51
|
296 |
(hash (make-hash-table :test 'equal))
|
|
code@51
|
297 |
(parent nil))
|
|
code@51
|
298 |
|
|
code@51
|
299 |
(defun yas/snippet-valid? (snippet)
|
|
code@51
|
300 |
"See if snippet is valid (ie. still alive)."
|
|
code@51
|
301 |
(and (not (null snippet))
|
|
code@51
|
302 |
(not (null (yas/snippet-overlay snippet)))
|
|
code@51
|
303 |
(not (null (overlay-start (yas/snippet-overlay snippet))))))
|
|
code@51
|
304 |
|
|
code@51
|
305 |
(defun yas/snippet-add-field (snippet field)
|
|
code@51
|
306 |
"Add FIELD to SNIPPET."
|
|
code@51
|
307 |
(let ((group (find field
|
|
code@51
|
308 |
(yas/snippet-groups snippet)
|
|
code@51
|
309 |
:test
|
|
code@51
|
310 |
'(lambda (field group)
|
|
code@51
|
311 |
(and (not (null (yas/field-number field)))
|
|
code@51
|
312 |
(not (null (yas/group-number group)))
|
|
code@51
|
313 |
(= (yas/field-number field)
|
|
code@51
|
314 |
(yas/group-number group)))))))
|
|
code@51
|
315 |
(if group
|
|
code@51
|
316 |
(yas/group-add-field group field)
|
|
code@51
|
317 |
(push (yas/make-group field snippet)
|
|
code@51
|
318 |
(yas/snippet-groups snippet)))))
|
|
code@51
|
319 |
|
|
code@51
|
320 |
(defun yas/group-value (group)
|
|
code@51
|
321 |
"Get the default value of the field group."
|
|
code@51
|
322 |
(or (yas/field-value
|
|
code@51
|
323 |
(yas/group-primary-field group))
|
|
code@51
|
324 |
""))
|
|
code@51
|
325 |
(defun yas/group-number (group)
|
|
code@51
|
326 |
"Get the number of the field group."
|
|
code@51
|
327 |
(yas/field-number
|
|
code@51
|
328 |
(yas/group-primary-field group)))
|
|
code@51
|
329 |
(defun yas/group-add-field (group field)
|
|
code@51
|
330 |
"Add a field to the field group. If the value of the primary
|
|
code@51
|
331 |
field is nil and that of the field is not nil, the field is set
|
|
code@51
|
332 |
as the primary field of the group."
|
|
code@51
|
333 |
(push field (yas/group-fields group))
|
|
code@51
|
334 |
(when (and (null (yas/field-value (yas/group-primary-field group)))
|
|
code@51
|
335 |
(yas/field-value field))
|
|
code@51
|
336 |
(setf (yas/group-primary-field group) field)))
|
|
code@51
|
337 |
|
|
code@51
|
338 |
(defun yas/snippet-field-compare (field1 field2)
|
|
code@51
|
339 |
"Compare two fields. The field with a number is sorted first.
|
|
code@51
|
340 |
If they both have a number, compare through the number. If neither
|
|
code@51
|
341 |
have, compare through the start point of the overlay."
|
|
code@51
|
342 |
(let ((n1 (yas/field-number field1))
|
|
code@51
|
343 |
(n2 (yas/field-number field2)))
|
|
code@51
|
344 |
(if n1
|
|
code@51
|
345 |
(if n2
|
|
code@51
|
346 |
(< n1 n2)
|
|
code@51
|
347 |
t)
|
|
code@51
|
348 |
(if n2
|
|
code@51
|
349 |
nil
|
|
code@51
|
350 |
(< (overlay-start (yas/field-overlay field1))
|
|
code@51
|
351 |
(overlay-start (yas/field-overlay field2)))))))
|
|
code@51
|
352 |
|
|
code@51
|
353 |
(defun yas/template-condition-predicate (condition)
|
|
code@51
|
354 |
(condition-case err
|
|
code@51
|
355 |
(save-excursion
|
|
code@51
|
356 |
(save-restriction
|
|
code@51
|
357 |
(save-match-data
|
|
code@51
|
358 |
(eval condition))))
|
|
code@51
|
359 |
(error (progn
|
|
code@51
|
360 |
(message (format "[yas]error in condition evaluation: %s"
|
|
code@51
|
361 |
(error-message-string err)))
|
|
code@51
|
362 |
nil))))
|
|
code@51
|
363 |
|
|
code@51
|
364 |
(defun yas/filter-templates-by-condition (templates)
|
|
code@51
|
365 |
"Filter the templates using the condition. The rules are:
|
|
code@51
|
366 |
|
|
code@51
|
367 |
* If the template has no condition, it is kept.
|
|
code@51
|
368 |
* If the template's condition eval to non-nil, it is kept.
|
|
code@51
|
369 |
* Otherwise (eval error or eval to nil) it is filtered."
|
|
code@51
|
370 |
(remove-if '(lambda (pair)
|
|
code@51
|
371 |
(let ((condition (yas/template-condition (cdr pair))))
|
|
code@51
|
372 |
(if (null condition)
|
|
code@51
|
373 |
(if yas/require-template-condition
|
|
code@51
|
374 |
t
|
|
code@51
|
375 |
nil)
|
|
code@51
|
376 |
(let ((result
|
|
code@51
|
377 |
(yas/template-condition-predicate condition)))
|
|
code@51
|
378 |
(if (eq yas/require-template-condition t)
|
|
code@51
|
379 |
result
|
|
code@51
|
380 |
(not (eq result yas/require-template-condition)))))))
|
|
code@51
|
381 |
templates))
|
|
code@51
|
382 |
|
|
code@51
|
383 |
(defun yas/snippet-table-fetch (table key)
|
|
code@51
|
384 |
"Fetch a snippet binding to KEY from TABLE. If not found,
|
|
code@51
|
385 |
fetch from parent if any."
|
|
code@51
|
386 |
(let ((templates (yas/filter-templates-by-condition
|
|
code@51
|
387 |
(gethash key (yas/snippet-table-hash table)))))
|
|
code@51
|
388 |
(when (and (null templates)
|
|
code@51
|
389 |
(not (null (yas/snippet-table-parent table))))
|
|
code@51
|
390 |
(setq templates (yas/snippet-table-fetch
|
|
code@51
|
391 |
(yas/snippet-table-parent table)
|
|
code@51
|
392 |
key)))
|
|
code@51
|
393 |
templates))
|
|
code@51
|
394 |
(defun yas/snippet-table-store (table full-key key template)
|
|
code@51
|
395 |
"Store a snippet template in the table."
|
|
code@51
|
396 |
(puthash key
|
|
code@51
|
397 |
(yas/modify-alist (gethash key
|
|
code@51
|
398 |
(yas/snippet-table-hash table))
|
|
code@51
|
399 |
full-key
|
|
code@51
|
400 |
template)
|
|
code@51
|
401 |
(yas/snippet-table-hash table)))
|
|
code@51
|
402 |
|
|
code@51
|
403 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
404 |
;; Internal functions
|
|
code@51
|
405 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
406 |
(defun yas/ensure-minor-mode-priority ()
|
|
code@51
|
407 |
"Ensure that the key binding of yas/minor-mode takes priority."
|
|
code@51
|
408 |
(unless (eq 'yas/minor-mode
|
|
code@51
|
409 |
(caar minor-mode-map-alist))
|
|
code@51
|
410 |
(setq minor-mode-map-alist
|
|
code@51
|
411 |
(cons
|
|
code@51
|
412 |
(cons 'yas/minor-mode yas/minor-mode-map)
|
|
code@51
|
413 |
(assq-delete-all 'yas/minor-mode
|
|
code@51
|
414 |
minor-mode-map-alist)))))
|
|
code@51
|
415 |
|
|
code@51
|
416 |
(defun yas/real-mode? (mode)
|
|
code@51
|
417 |
"Try to find out if MODE is a real mode. The MODE bound to
|
|
code@51
|
418 |
a function (like `c-mode') is considered real mode. Other well
|
|
code@51
|
419 |
known mode like `ruby-mode' which is not part of Emacs might
|
|
code@51
|
420 |
not bound to a function until it is loaded. So yasnippet keeps
|
|
code@51
|
421 |
a list of modes like this to help the judgement."
|
|
code@51
|
422 |
(or (fboundp mode)
|
|
code@51
|
423 |
(find mode yas/known-modes)))
|
|
code@51
|
424 |
|
|
code@51
|
425 |
(defun yas/eval-string (string)
|
|
code@51
|
426 |
"Evaluate STRING and convert the result to string."
|
|
code@51
|
427 |
(condition-case err
|
|
code@51
|
428 |
(save-excursion
|
|
code@51
|
429 |
(save-restriction
|
|
code@51
|
430 |
(save-match-data
|
|
code@51
|
431 |
(format "%s" (eval (read string))))))
|
|
code@51
|
432 |
(error (format "(error in elisp evaluation: %s)"
|
|
code@51
|
433 |
(error-message-string err)))))
|
|
code@51
|
434 |
(defun yas/calculate-field-value (field value)
|
|
code@51
|
435 |
"Calculate the value of the field. If there's a transform
|
|
code@51
|
436 |
for this field, apply it. Otherwise, the value is returned
|
|
code@51
|
437 |
unmodified."
|
|
code@51
|
438 |
(let ((text value)
|
|
code@51
|
439 |
(transform (yas/field-transform field)))
|
|
code@51
|
440 |
(if transform
|
|
code@51
|
441 |
(yas/eval-string transform)
|
|
code@51
|
442 |
text)))
|
|
code@51
|
443 |
(defsubst yas/replace-all (from to)
|
|
code@51
|
444 |
"Replace all occurance from FROM to TO."
|
|
code@51
|
445 |
(goto-char (point-min))
|
|
code@51
|
446 |
(while (search-forward from nil t)
|
|
code@51
|
447 |
(replace-match to t t)))
|
|
code@51
|
448 |
|
|
code@51
|
449 |
(defun yas/snippet-table (mode)
|
|
code@51
|
450 |
"Get the snippet table corresponding to MODE."
|
|
code@51
|
451 |
(let ((table (gethash mode yas/snippet-tables)))
|
|
code@51
|
452 |
(unless table
|
|
code@51
|
453 |
(setq table (yas/make-snippet-table))
|
|
code@51
|
454 |
(puthash mode table yas/snippet-tables))
|
|
code@51
|
455 |
table))
|
|
code@51
|
456 |
(defsubst yas/current-snippet-table ()
|
|
code@51
|
457 |
"Get the snippet table for current major-mode."
|
|
code@51
|
458 |
(yas/snippet-table major-mode))
|
|
code@51
|
459 |
|
|
code@51
|
460 |
(defun yas/menu-keymap-for-mode (mode)
|
|
code@51
|
461 |
"Get the menu keymap correspondong to MODE."
|
|
code@51
|
462 |
(let ((keymap (gethash mode yas/menu-table)))
|
|
code@51
|
463 |
(unless keymap
|
|
code@51
|
464 |
(setq keymap (make-sparse-keymap))
|
|
code@51
|
465 |
(puthash mode keymap yas/menu-table))
|
|
code@51
|
466 |
keymap))
|
|
code@51
|
467 |
|
|
code@51
|
468 |
(defun yas/current-key ()
|
|
code@51
|
469 |
"Get the key under current position. A key is used to find
|
|
code@51
|
470 |
the template of a snippet in the current snippet-table."
|
|
code@51
|
471 |
(let ((start (point))
|
|
code@51
|
472 |
(end (point))
|
|
code@51
|
473 |
(syntaxes yas/key-syntaxes)
|
|
code@51
|
474 |
syntax done templates)
|
|
code@51
|
475 |
(while (and (not done) syntaxes)
|
|
code@51
|
476 |
(setq syntax (car syntaxes))
|
|
code@51
|
477 |
(setq syntaxes (cdr syntaxes))
|
|
code@51
|
478 |
(save-excursion
|
|
code@51
|
479 |
(skip-syntax-backward syntax)
|
|
code@51
|
480 |
(setq start (point)))
|
|
code@51
|
481 |
(setq templates
|
|
code@51
|
482 |
(yas/snippet-table-fetch
|
|
code@51
|
483 |
(yas/current-snippet-table)
|
|
code@51
|
484 |
(buffer-substring-no-properties start end)))
|
|
code@51
|
485 |
(if templates
|
|
code@51
|
486 |
(setq done t)
|
|
code@51
|
487 |
(setq start end)))
|
|
code@51
|
488 |
(list templates
|
|
code@51
|
489 |
start
|
|
code@51
|
490 |
end)))
|
|
code@51
|
491 |
|
|
code@51
|
492 |
(defun yas/synchronize-fields (field-group)
|
|
code@51
|
493 |
"Update all fields' text according to the primary field."
|
|
code@51
|
494 |
(when (yas/snippet-valid? (yas/group-snippet field-group))
|
|
code@51
|
495 |
(save-excursion
|
|
code@51
|
496 |
(let* ((inhibit-modification-hooks t)
|
|
code@51
|
497 |
(primary (yas/group-primary-field field-group))
|
|
code@51
|
498 |
(primary-overlay (yas/field-overlay primary))
|
|
code@51
|
499 |
(text (buffer-substring-no-properties (overlay-start primary-overlay)
|
|
code@51
|
500 |
(overlay-end primary-overlay))))
|
|
code@51
|
501 |
(dolist (field (yas/group-fields field-group))
|
|
code@51
|
502 |
(let* ((field-overlay (yas/field-overlay field))
|
|
code@51
|
503 |
(original-length (- (overlay-end field-overlay)
|
|
code@51
|
504 |
(overlay-start field-overlay))))
|
|
code@51
|
505 |
(unless (eq field-overlay primary-overlay)
|
|
code@51
|
506 |
(goto-char (overlay-start field-overlay))
|
|
code@51
|
507 |
(insert (yas/calculate-field-value field text))
|
|
code@51
|
508 |
(if (= (overlay-start field-overlay)
|
|
code@51
|
509 |
(overlay-end field-overlay))
|
|
code@51
|
510 |
(move-overlay field-overlay
|
|
code@51
|
511 |
(overlay-start field-overlay)
|
|
code@51
|
512 |
(point))
|
|
code@51
|
513 |
(delete-char original-length)))))))))
|
|
code@51
|
514 |
|
|
code@51
|
515 |
(defun yas/overlay-modification-hook (overlay after? beg end &optional length)
|
|
code@51
|
516 |
"Modification hook for snippet field overlay."
|
|
code@51
|
517 |
(when (and after? (not undo-in-progress))
|
|
code@51
|
518 |
(yas/synchronize-fields (overlay-get overlay 'yas/group))))
|
|
code@51
|
519 |
(defun yas/overlay-insert-in-front-hook (overlay after? beg end &optional length)
|
|
code@51
|
520 |
"Hook for snippet overlay when text is inserted in front of a snippet field."
|
|
code@51
|
521 |
(when after?
|
|
code@51
|
522 |
(let ((field-group (overlay-get overlay 'yas/group))
|
|
code@51
|
523 |
(inhibit-modification-hooks t))
|
|
code@51
|
524 |
(when (not (overlay-get overlay 'yas/modified?))
|
|
code@51
|
525 |
(overlay-put overlay 'yas/modified? t)
|
|
code@51
|
526 |
(when (> (overlay-end overlay) end)
|
|
code@51
|
527 |
(save-excursion
|
|
code@51
|
528 |
(goto-char end)
|
|
code@51
|
529 |
(delete-char (- (overlay-end overlay) end)))))
|
|
code@51
|
530 |
(yas/synchronize-fields field-group))))
|
|
code@51
|
531 |
(defun yas/overlay-maybe-insert-behind-hook (overlay after? beg end &optional length)
|
|
code@51
|
532 |
"Insert behind hook sometimes doesn't get called. I don't know why.
|
|
code@51
|
533 |
So I add modification hook in the big overlay and try to detect `insert-behind'
|
|
code@51
|
534 |
event manually."
|
|
code@51
|
535 |
(when after?
|
|
code@51
|
536 |
(cond ((and (= beg end)
|
|
code@51
|
537 |
(> length 0)
|
|
code@51
|
538 |
(= (overlay-start overlay)
|
|
code@51
|
539 |
(overlay-end overlay)))
|
|
code@51
|
540 |
(yas/exit-snippet (overlay-get overlay 'yas/snippet-reference)))
|
|
code@51
|
541 |
((and (= length 0)
|
|
code@51
|
542 |
(> end beg)
|
|
code@51
|
543 |
(null (yas/current-snippet-overlay beg))
|
|
code@51
|
544 |
(not (bobp)))
|
|
code@51
|
545 |
(let ((field-overlay (yas/current-snippet-overlay (1- beg))))
|
|
code@51
|
546 |
(if field-overlay
|
|
code@51
|
547 |
(when (= beg (overlay-end field-overlay))
|
|
code@51
|
548 |
(move-overlay field-overlay
|
|
code@51
|
549 |
(overlay-start field-overlay)
|
|
code@51
|
550 |
end)
|
|
code@51
|
551 |
(yas/synchronize-fields (overlay-get field-overlay 'yas/group)))
|
|
code@51
|
552 |
(let ((snippet (yas/snippet-of-current-keymap))
|
|
code@51
|
553 |
(done nil))
|
|
code@51
|
554 |
(if snippet
|
|
code@51
|
555 |
(do* ((groups (yas/snippet-groups snippet) (cdr groups))
|
|
code@51
|
556 |
(group (car groups) (car groups)))
|
|
code@51
|
557 |
((or (null groups)
|
|
code@51
|
558 |
done))
|
|
code@51
|
559 |
(setq field-overlay (yas/field-overlay
|
|
code@51
|
560 |
(yas/group-primary-field group)))
|
|
code@51
|
561 |
(when (and (= (overlay-start field-overlay)
|
|
code@51
|
562 |
(overlay-end field-overlay))
|
|
code@51
|
563 |
(= beg
|
|
code@51
|
564 |
(overlay-start field-overlay)))
|
|
code@51
|
565 |
(move-overlay field-overlay beg end)
|
|
code@51
|
566 |
(yas/synchronize-fields group)
|
|
code@51
|
567 |
(setq done t)))))))))))
|
|
code@51
|
568 |
|
|
code@51
|
569 |
(defun yas/undo-expand-snippet (start end key snippet)
|
|
code@51
|
570 |
"Undo a snippet expansion. Delete the overlays. This undo can't be
|
|
code@51
|
571 |
redo-ed."
|
|
code@51
|
572 |
(let ((undo (car buffer-undo-list)))
|
|
code@51
|
573 |
(while (null undo)
|
|
code@51
|
574 |
(setq buffer-undo-list (cdr buffer-undo-list))
|
|
code@51
|
575 |
(setq undo (car buffer-undo-list)))
|
|
code@51
|
576 |
;; Remove this undo operation record
|
|
code@51
|
577 |
(setq buffer-undo-list (cdr buffer-undo-list))
|
|
code@51
|
578 |
(let ((inhibit-modification-hooks t)
|
|
code@51
|
579 |
(buffer-undo-list t))
|
|
code@51
|
580 |
(yas/exit-snippet snippet)
|
|
code@51
|
581 |
(goto-char start)
|
|
code@51
|
582 |
(delete-char (- end start))
|
|
code@51
|
583 |
(insert key))))
|
|
code@51
|
584 |
|
|
code@51
|
585 |
(defun yas/expand-snippet (start end template)
|
|
code@51
|
586 |
"Expand snippet at current point. Text between START and END
|
|
code@51
|
587 |
will be deleted before inserting template."
|
|
code@51
|
588 |
(run-hooks 'yas/before-expand-snippet-hook)
|
|
code@51
|
589 |
|
|
code@51
|
590 |
(goto-char start)
|
|
code@51
|
591 |
|
|
code@51
|
592 |
(let ((key (buffer-substring-no-properties start end))
|
|
code@51
|
593 |
(original-undo-list buffer-undo-list)
|
|
code@51
|
594 |
(inhibit-modification-hooks t)
|
|
code@51
|
595 |
(length (- end start))
|
|
code@51
|
596 |
(column (current-column)))
|
|
code@51
|
597 |
(save-restriction
|
|
code@51
|
598 |
(narrow-to-region start start)
|
|
code@51
|
599 |
|
|
code@51
|
600 |
(setq buffer-undo-list t)
|
|
code@51
|
601 |
(insert template)
|
|
code@51
|
602 |
|
|
code@51
|
603 |
;; Step 1: do necessary indent
|
|
code@51
|
604 |
(when yas/indent-line
|
|
code@51
|
605 |
(let* ((indent (if indent-tabs-mode
|
|
code@51
|
606 |
(concat (make-string (/ column tab-width) ?\t)
|
|
code@51
|
607 |
(make-string (% column tab-width) ?\ ))
|
|
code@51
|
608 |
(make-string column ?\ ))))
|
|
code@51
|
609 |
(goto-char (point-min))
|
|
code@51
|
610 |
(while (and (zerop (forward-line))
|
|
code@51
|
611 |
(= (current-column) 0))
|
|
code@51
|
612 |
(insert indent))))
|
|
code@51
|
613 |
|
|
code@51
|
614 |
;; Step 2: protect backslash and backquote
|
|
code@51
|
615 |
(yas/replace-all "\\\\" yas/escape-backslash)
|
|
code@51
|
616 |
(yas/replace-all "\\`" yas/escape-backquote)
|
|
code@51
|
617 |
|
|
code@51
|
618 |
;; Step 3: evaluate all backquotes
|
|
code@51
|
619 |
(goto-char (point-min))
|
|
code@51
|
620 |
(while (re-search-forward "`\\([^`]*\\)`" nil t)
|
|
code@51
|
621 |
(replace-match (yas/eval-string (match-string-no-properties 1))
|
|
code@51
|
622 |
t t))
|
|
code@51
|
623 |
|
|
code@51
|
624 |
;; Step 4: protect all escapes, including backslash and backquot
|
|
code@51
|
625 |
;; which may be produced in Step 3
|
|
code@51
|
626 |
(yas/replace-all "\\\\" yas/escape-backslash)
|
|
code@51
|
627 |
(yas/replace-all "\\`" yas/escape-backquote)
|
|
code@51
|
628 |
(yas/replace-all "\\$" yas/escape-dollar)
|
|
code@51
|
629 |
|
|
code@51
|
630 |
(let ((snippet (yas/make-snippet)))
|
|
code@51
|
631 |
;; Step 5: Create fields
|
|
code@51
|
632 |
(goto-char (point-min))
|
|
code@51
|
633 |
(while (re-search-forward yas/field-regexp nil t)
|
|
code@51
|
634 |
(let ((number (or (match-string-no-properties 1)
|
|
code@51
|
635 |
(match-string-no-properties 2)))
|
|
code@51
|
636 |
(transform nil)
|
|
code@51
|
637 |
(value (match-string-no-properties 3)))
|
|
code@51
|
638 |
(when (eq (elt value 0) ?\$)
|
|
code@51
|
639 |
(setq transform (substring value 1))
|
|
code@51
|
640 |
(setq value nil))
|
|
code@51
|
641 |
(if (and number
|
|
code@51
|
642 |
(string= "0" number))
|
|
code@51
|
643 |
(progn
|
|
code@51
|
644 |
(replace-match "")
|
|
code@51
|
645 |
(setf (yas/snippet-exit-marker snippet)
|
|
code@51
|
646 |
(copy-marker (point) t)))
|
|
code@51
|
647 |
(yas/snippet-add-field
|
|
code@51
|
648 |
snippet
|
|
code@51
|
649 |
(yas/make-field
|
|
code@51
|
650 |
(make-overlay (match-beginning 0) (match-end 0))
|
|
code@51
|
651 |
(and number (string-to-number number))
|
|
code@51
|
652 |
value
|
|
code@51
|
653 |
transform)))))
|
|
code@51
|
654 |
|
|
code@51
|
655 |
;; Step 6: Sort and link each field group
|
|
code@51
|
656 |
(setf (yas/snippet-groups snippet)
|
|
code@51
|
657 |
(sort (yas/snippet-groups snippet)
|
|
code@51
|
658 |
'(lambda (group1 group2)
|
|
code@51
|
659 |
(yas/snippet-field-compare
|
|
code@51
|
660 |
(yas/group-primary-field group1)
|
|
code@51
|
661 |
(yas/group-primary-field group2)))))
|
|
code@51
|
662 |
(let ((prev nil))
|
|
code@51
|
663 |
(dolist (group (yas/snippet-groups snippet))
|
|
code@51
|
664 |
(setf (yas/group-prev group) prev)
|
|
code@51
|
665 |
(when prev
|
|
code@51
|
666 |
(setf (yas/group-next prev) group))
|
|
code@51
|
667 |
(setq prev group)))
|
|
code@51
|
668 |
|
|
code@51
|
669 |
;; Step 7: Create keymap overlay for snippet
|
|
code@51
|
670 |
(let ((overlay (make-overlay (point-min)
|
|
code@51
|
671 |
(point-max)
|
|
code@51
|
672 |
nil
|
|
code@51
|
673 |
nil
|
|
code@51
|
674 |
t)))
|
|
code@51
|
675 |
(overlay-put overlay
|
|
code@51
|
676 |
'modification-hooks
|
|
code@51
|
677 |
yas/keymap-overlay-modification-hooks)
|
|
code@51
|
678 |
(overlay-put overlay
|
|
code@51
|
679 |
'insert-behind-hooks
|
|
code@51
|
680 |
yas/keymap-overlay-modification-hooks)
|
|
code@51
|
681 |
(overlay-put overlay 'keymap yas/keymap)
|
|
code@51
|
682 |
(overlay-put overlay 'yas/snippet-reference snippet)
|
|
code@51
|
683 |
(setf (yas/snippet-overlay snippet) overlay))
|
|
code@51
|
684 |
|
|
code@51
|
685 |
;; Step 8: Replace fields with default values
|
|
code@51
|
686 |
(dolist (group (yas/snippet-groups snippet))
|
|
code@51
|
687 |
(let ((value (yas/group-value group)))
|
|
code@51
|
688 |
(dolist (field (yas/group-fields group))
|
|
code@51
|
689 |
(let* ((overlay (yas/field-overlay field))
|
|
code@51
|
690 |
(start (overlay-start overlay))
|
|
code@51
|
691 |
(end (overlay-end overlay))
|
|
code@51
|
692 |
(length (- end start)))
|
|
code@51
|
693 |
(goto-char start)
|
|
code@51
|
694 |
(insert (yas/calculate-field-value field value))
|
|
code@51
|
695 |
(delete-char length)))))
|
|
code@51
|
696 |
|
|
code@51
|
697 |
;; Step 9: restore all escape characters
|
|
code@51
|
698 |
(yas/replace-all yas/escape-dollar "$")
|
|
code@51
|
699 |
(yas/replace-all yas/escape-backquote "`")
|
|
code@51
|
700 |
(yas/replace-all yas/escape-backslash "\\")
|
|
code@51
|
701 |
|
|
code@51
|
702 |
;; Step 10: Set up properties of overlays
|
|
code@51
|
703 |
(dolist (group (yas/snippet-groups snippet))
|
|
code@51
|
704 |
(let ((overlay (yas/field-overlay
|
|
code@51
|
705 |
(yas/group-primary-field group))))
|
|
code@51
|
706 |
(overlay-put overlay 'yas/snippet snippet)
|
|
code@51
|
707 |
(overlay-put overlay 'yas/group group)
|
|
code@51
|
708 |
(overlay-put overlay 'yas/modified? nil)
|
|
code@51
|
709 |
(overlay-put overlay 'modification-hooks yas/overlay-modification-hooks)
|
|
code@51
|
710 |
(overlay-put overlay 'insert-in-front-hooks yas/overlay-insert-in-front-hooks)
|
|
code@51
|
711 |
(overlay-put overlay 'face 'yas/field-highlight-face)
|
|
code@51
|
712 |
(dolist (field (yas/group-fields group))
|
|
code@51
|
713 |
(unless (equal overlay (yas/field-overlay field))
|
|
code@51
|
714 |
(overlay-put (yas/field-overlay field)
|
|
code@51
|
715 |
'face
|
|
code@51
|
716 |
'yas/mirror-highlight-face)))))
|
|
code@51
|
717 |
|
|
code@51
|
718 |
;; Step 11: move to end and make sure exit-marker exist
|
|
code@51
|
719 |
(goto-char (point-max))
|
|
code@51
|
720 |
(unless (yas/snippet-exit-marker snippet)
|
|
code@51
|
721 |
(setf (yas/snippet-exit-marker snippet) (copy-marker (point) t)))
|
|
code@51
|
722 |
|
|
code@51
|
723 |
;; Step 12: Construct undo information
|
|
code@51
|
724 |
(unless (eq original-undo-list t)
|
|
code@51
|
725 |
(add-to-list 'original-undo-list
|
|
code@51
|
726 |
`(apply yas/undo-expand-snippet
|
|
code@51
|
727 |
,(point-min)
|
|
code@51
|
728 |
,(point-max)
|
|
code@51
|
729 |
,key
|
|
code@51
|
730 |
,snippet)))
|
|
code@51
|
731 |
|
|
code@51
|
732 |
;; Step 13: remove the trigger key
|
|
code@51
|
733 |
(widen)
|
|
code@51
|
734 |
(delete-char length)
|
|
code@51
|
735 |
|
|
code@51
|
736 |
(setq buffer-undo-list original-undo-list)
|
|
code@51
|
737 |
|
|
code@51
|
738 |
;; Step 14: place the cursor at a proper place
|
|
code@51
|
739 |
(let ((groups (yas/snippet-groups snippet))
|
|
code@51
|
740 |
(exit-marker (yas/snippet-exit-marker snippet)))
|
|
code@51
|
741 |
(if groups
|
|
code@51
|
742 |
(goto-char (overlay-start
|
|
code@51
|
743 |
(yas/field-overlay
|
|
code@51
|
744 |
(yas/group-primary-field
|
|
code@51
|
745 |
(car groups)))))
|
|
code@51
|
746 |
;; no need to call exit-snippet, since no overlay created.
|
|
code@51
|
747 |
(yas/exit-snippet snippet)))))))
|
|
code@51
|
748 |
|
|
code@51
|
749 |
(defun yas/current-snippet-overlay (&optional point)
|
|
code@51
|
750 |
"Get the most proper overlay which is belongs to a snippet."
|
|
code@51
|
751 |
(let ((point (or point (point)))
|
|
code@51
|
752 |
(snippet-overlay nil))
|
|
code@51
|
753 |
(dolist (overlay (overlays-at point))
|
|
code@51
|
754 |
(when (overlay-get overlay 'yas/snippet)
|
|
code@51
|
755 |
(if (null snippet-overlay)
|
|
code@51
|
756 |
(setq snippet-overlay overlay)
|
|
code@51
|
757 |
(when (> (yas/snippet-id (overlay-get overlay 'yas/snippet))
|
|
code@51
|
758 |
(yas/snippet-id (overlay-get snippet-overlay 'yas/snippet)))
|
|
code@51
|
759 |
(setq snippet-overlay overlay)))))
|
|
code@51
|
760 |
snippet-overlay))
|
|
code@51
|
761 |
|
|
code@51
|
762 |
(defun yas/snippet-of-current-keymap (&optional point)
|
|
code@51
|
763 |
"Get the snippet holding the snippet keymap under POINT."
|
|
code@51
|
764 |
(let ((point (or point (point)))
|
|
code@51
|
765 |
(keymap-snippet nil)
|
|
code@51
|
766 |
(snippet nil))
|
|
code@51
|
767 |
(dolist (overlay (overlays-at point))
|
|
code@51
|
768 |
(setq snippet (overlay-get overlay 'yas/snippet-reference))
|
|
code@51
|
769 |
(when snippet
|
|
code@51
|
770 |
(if (null keymap-snippet)
|
|
code@51
|
771 |
(setq keymap-snippet snippet)
|
|
code@51
|
772 |
(when (> (yas/snippet-id snippet)
|
|
code@51
|
773 |
(yas/snippet-id keymap-snippet))
|
|
code@51
|
774 |
(setq keymap-snippet snippet)))))
|
|
code@51
|
775 |
keymap-snippet))
|
|
code@51
|
776 |
|
|
code@51
|
777 |
(defun yas/current-overlay-for-navigation ()
|
|
code@51
|
778 |
"Get current overlay for navigation. Might be overlay at current or previous point."
|
|
code@51
|
779 |
(let ((overlay1 (yas/current-snippet-overlay))
|
|
code@51
|
780 |
(overlay2 (if (bobp)
|
|
code@51
|
781 |
nil
|
|
code@51
|
782 |
(yas/current-snippet-overlay (- (point) 1)))))
|
|
code@51
|
783 |
(if (null overlay1)
|
|
code@51
|
784 |
overlay2
|
|
code@51
|
785 |
(if (or (null overlay2)
|
|
code@51
|
786 |
(eq (overlay-get overlay1 'yas/snippet)
|
|
code@51
|
787 |
(overlay-get overlay2 'yas/snippet)))
|
|
code@51
|
788 |
overlay1
|
|
code@51
|
789 |
(if (> (yas/snippet-id (overlay-get overlay2 'yas/snippet))
|
|
code@51
|
790 |
(yas/snippet-id (overlay-get overlay1 'yas/snippet)))
|
|
code@51
|
791 |
overlay2
|
|
code@51
|
792 |
overlay1)))))
|
|
code@51
|
793 |
|
|
code@51
|
794 |
(defun yas/navigate-group (group next?)
|
|
code@51
|
795 |
"Go to next of previous field group. Exit snippet if none."
|
|
code@51
|
796 |
(let ((target (if next?
|
|
code@51
|
797 |
(yas/group-next group)
|
|
code@51
|
798 |
(yas/group-prev group))))
|
|
code@51
|
799 |
(if target
|
|
code@51
|
800 |
(goto-char (overlay-start
|
|
code@51
|
801 |
(yas/field-overlay
|
|
code@51
|
802 |
(yas/group-primary-field target))))
|
|
code@51
|
803 |
(yas/exit-snippet (yas/group-snippet group)))))
|
|
code@51
|
804 |
|
|
code@51
|
805 |
(defun yas/parse-template ()
|
|
code@51
|
806 |
"Parse the template in the current buffer.
|
|
code@51
|
807 |
If the buffer contains a line of \"# --\" then the contents
|
|
code@51
|
808 |
above this line are ignored. Variables can be set above this
|
|
code@51
|
809 |
line through the syntax:
|
|
code@51
|
810 |
|
|
code@51
|
811 |
#name : value
|
|
code@51
|
812 |
|
|
code@51
|
813 |
Here's a list of currently recognized variables:
|
|
code@51
|
814 |
|
|
code@51
|
815 |
* name
|
|
code@51
|
816 |
* contributor
|
|
code@51
|
817 |
* condition
|
|
code@51
|
818 |
|
|
code@51
|
819 |
#name: #include \"...\"
|
|
code@51
|
820 |
# --
|
|
code@51
|
821 |
#include \"$1\""
|
|
code@51
|
822 |
(goto-char (point-min))
|
|
code@51
|
823 |
(let (template name bound condition)
|
|
code@51
|
824 |
(if (re-search-forward "^# --\n" nil t)
|
|
code@51
|
825 |
(progn (setq template
|
|
code@51
|
826 |
(buffer-substring-no-properties (point)
|
|
code@51
|
827 |
(point-max)))
|
|
code@51
|
828 |
(setq bound (point))
|
|
code@51
|
829 |
(goto-char (point-min))
|
|
code@51
|
830 |
(while (re-search-forward "^#\\([^ ]+\\) *: *\\(.*\\)$" bound t)
|
|
code@51
|
831 |
(when (string= "name" (match-string-no-properties 1))
|
|
code@51
|
832 |
(setq name (match-string-no-properties 2)))
|
|
code@51
|
833 |
(when (string= "condition" (match-string-no-properties 1))
|
|
code@51
|
834 |
(setq condition (read (match-string-no-properties 2))))))
|
|
code@51
|
835 |
(setq template
|
|
code@51
|
836 |
(buffer-substring-no-properties (point-min) (point-max))))
|
|
code@51
|
837 |
(list template name condition)))
|
|
code@51
|
838 |
|
|
code@51
|
839 |
(defun yas/directory-files (directory file?)
|
|
code@51
|
840 |
"Return directory files or subdirectories in full path."
|
|
code@51
|
841 |
(remove-if (lambda (file)
|
|
code@51
|
842 |
(or (string-match "^\\."
|
|
code@51
|
843 |
(file-name-nondirectory file))
|
|
code@51
|
844 |
(if file?
|
|
code@51
|
845 |
(file-directory-p file)
|
|
code@51
|
846 |
(not (file-directory-p file)))))
|
|
code@51
|
847 |
(directory-files directory t)))
|
|
code@51
|
848 |
|
|
code@51
|
849 |
(defun yas/make-menu-binding (template)
|
|
code@51
|
850 |
(lexical-let ((template template))
|
|
code@51
|
851 |
(lambda ()
|
|
code@51
|
852 |
(interactive)
|
|
code@51
|
853 |
(yas/expand-snippet (point)
|
|
code@51
|
854 |
(point)
|
|
code@51
|
855 |
template))))
|
|
code@51
|
856 |
|
|
code@51
|
857 |
(defun yas/modify-alist (alist key value)
|
|
code@51
|
858 |
"Modify ALIST to map KEY to VALUE. return the new alist."
|
|
code@51
|
859 |
(let ((pair (assoc key alist)))
|
|
code@51
|
860 |
(if (null pair)
|
|
code@51
|
861 |
(cons (cons key value)
|
|
code@51
|
862 |
alist)
|
|
code@51
|
863 |
(setcdr pair value)
|
|
code@51
|
864 |
alist)))
|
|
code@51
|
865 |
|
|
code@51
|
866 |
(defun yas/fake-keymap-for-popup (templates)
|
|
code@51
|
867 |
"Create a fake keymap for popup menu usage."
|
|
code@51
|
868 |
(cons 'keymap
|
|
code@51
|
869 |
(mapcar (lambda (pair)
|
|
code@51
|
870 |
(let* ((template (cdr pair))
|
|
code@51
|
871 |
(name (yas/template-name template))
|
|
code@51
|
872 |
(content (yas/template-content template)))
|
|
code@51
|
873 |
(list content 'menu-item name t)))
|
|
code@51
|
874 |
templates)))
|
|
code@51
|
875 |
|
|
code@51
|
876 |
(defun yas/point-to-coord (&optional point)
|
|
code@51
|
877 |
"Get the xoffset/yoffset information of POINT.
|
|
code@51
|
878 |
If POINT is not given, default is to current point.
|
|
code@51
|
879 |
If `posn-at-point' is not available (like in Emacs 21.3),
|
|
code@51
|
880 |
t is returned simply."
|
|
code@51
|
881 |
(if (fboundp 'posn-at-point)
|
|
code@51
|
882 |
(let ((x-y (posn-x-y (posn-at-point (or point (point))))))
|
|
code@51
|
883 |
(list (list (+ (car x-y) 10)
|
|
code@51
|
884 |
(+ (cdr x-y) 20))
|
|
code@51
|
885 |
(selected-window)))
|
|
code@51
|
886 |
t))
|
|
code@51
|
887 |
|
|
code@51
|
888 |
(defun yas/x-popup-menu-for-template (templates)
|
|
code@51
|
889 |
"Show a popup menu listing templates to let the user select one."
|
|
code@51
|
890 |
(car (x-popup-menu (yas/point-to-coord)
|
|
code@51
|
891 |
(yas/fake-keymap-for-popup templates))))
|
|
code@51
|
892 |
(defun yas/text-popup-for-template (templates)
|
|
code@51
|
893 |
"Can't display popup menu in text mode. Just select the first one."
|
|
code@51
|
894 |
(yas/template-content (cdar templates)))
|
|
code@51
|
895 |
(defun yas/dropdown-list-popup-for-template (templates)
|
|
code@51
|
896 |
"Use dropdown-list.el to popup for templates. Better than the
|
|
code@51
|
897 |
default \"select first\" behavior of `yas/text-popup-for-template'.
|
|
code@51
|
898 |
You can also use this in window-system.
|
|
code@51
|
899 |
|
|
code@51
|
900 |
NOTE: You need to download and install dropdown-list.el to use this."
|
|
code@51
|
901 |
(if (fboundp 'dropdown-list)
|
|
code@51
|
902 |
(let ((n (dropdown-list (mapcar (lambda (i)
|
|
code@51
|
903 |
(yas/template-name
|
|
code@51
|
904 |
(cdr i)))
|
|
code@51
|
905 |
templates))))
|
|
code@51
|
906 |
(if n
|
|
code@51
|
907 |
(yas/template-content
|
|
code@51
|
908 |
(cdr (nth n templates)))
|
|
code@51
|
909 |
nil))
|
|
code@51
|
910 |
(error "Please download and install dropdown-list.el to use this")))
|
|
code@51
|
911 |
|
|
code@51
|
912 |
(defun yas/popup-for-template (templates)
|
|
code@51
|
913 |
(if window-system
|
|
code@51
|
914 |
(funcall yas/window-system-popup-function templates)
|
|
code@51
|
915 |
(funcall yas/text-popup-function templates)))
|
|
code@51
|
916 |
|
|
code@51
|
917 |
(defun yas/load-directory-1 (directory &optional parent)
|
|
code@51
|
918 |
"Really do the job of loading snippets from a directory
|
|
code@51
|
919 |
hierarchy."
|
|
code@51
|
920 |
(let ((mode-sym (intern (file-name-nondirectory directory)))
|
|
code@51
|
921 |
(snippets nil))
|
|
code@51
|
922 |
(with-temp-buffer
|
|
code@51
|
923 |
(dolist (file (yas/directory-files directory t))
|
|
code@51
|
924 |
(when (file-readable-p file)
|
|
code@51
|
925 |
(insert-file-contents file nil nil nil t)
|
|
code@51
|
926 |
(push (cons (file-name-nondirectory file)
|
|
code@51
|
927 |
(yas/parse-template))
|
|
code@51
|
928 |
snippets))))
|
|
code@51
|
929 |
(yas/define-snippets mode-sym
|
|
code@51
|
930 |
snippets
|
|
code@51
|
931 |
parent)
|
|
code@51
|
932 |
(dolist (subdir (yas/directory-files directory nil))
|
|
code@51
|
933 |
(yas/load-directory-1 subdir mode-sym))))
|
|
code@51
|
934 |
|
|
code@51
|
935 |
(defun yas/quote-string (string)
|
|
code@51
|
936 |
"Escape and quote STRING.
|
|
code@51
|
937 |
foo\"bar\\! -> \"foo\\\"bar\\\\!\""
|
|
code@51
|
938 |
(concat "\""
|
|
code@51
|
939 |
(replace-regexp-in-string "[\\\"]"
|
|
code@51
|
940 |
"\\\\\\&"
|
|
code@51
|
941 |
string
|
|
code@51
|
942 |
t)
|
|
code@51
|
943 |
"\""))
|
|
code@51
|
944 |
|
|
code@51
|
945 |
(defun yas/compile-bundle
|
|
code@51
|
946 |
(&optional yasnippet yasnippet-bundle snippet-roots code)
|
|
code@51
|
947 |
"Compile snippets in SNIPPET-ROOTS to a single bundle file.
|
|
code@51
|
948 |
SNIPPET-ROOTS is a list of root directories that contains the snippets
|
|
code@51
|
949 |
definition. YASNIPPET is the yasnippet.el file path. YASNIPPET-BUNDLE
|
|
code@51
|
950 |
is the output file of the compile result. CODE is the code you would
|
|
code@51
|
951 |
like to used to initialize yasnippet. Here's the default value for
|
|
code@51
|
952 |
all the parameters:
|
|
code@51
|
953 |
|
|
code@51
|
954 |
(yas/compile-bundle \"yasnippet.el\"
|
|
code@51
|
955 |
\"./yasnippet-bundle.el\"
|
|
code@51
|
956 |
'(\"snippets\")
|
|
code@51
|
957 |
\"(yas/initialize)\")"
|
|
code@51
|
958 |
(when (null yasnippet)
|
|
code@51
|
959 |
(setq yasnippet "yasnippet.el"))
|
|
code@51
|
960 |
(when (null yasnippet-bundle)
|
|
code@51
|
961 |
(setq yasnippet-bundle "./yasnippet-bundle.el"))
|
|
code@51
|
962 |
(when (null snippet-roots)
|
|
code@51
|
963 |
(setq snippet-roots '("snippets")))
|
|
code@51
|
964 |
(when (null code)
|
|
code@51
|
965 |
(setq code "(yas/initialize)"))
|
|
code@51
|
966 |
|
|
code@51
|
967 |
(let ((dirs (or (and (listp snippet-roots) snippet-roots)
|
|
code@51
|
968 |
(list snippet-roots)))
|
|
code@51
|
969 |
(bundle-buffer nil))
|
|
code@51
|
970 |
(with-temp-buffer
|
|
code@51
|
971 |
(setq bundle-buffer (current-buffer))
|
|
code@51
|
972 |
(insert-file-contents yasnippet)
|
|
code@51
|
973 |
(goto-char (point-max))
|
|
code@51
|
974 |
(insert ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n")
|
|
code@51
|
975 |
(insert ";;;; Auto-generated code ;;;;\n")
|
|
code@51
|
976 |
(insert ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n")
|
|
code@51
|
977 |
(insert code "\n")
|
|
code@51
|
978 |
(flet ((yas/define-snippets
|
|
code@51
|
979 |
(mode snippets &optional parent)
|
|
code@51
|
980 |
(with-current-buffer bundle-buffer
|
|
code@51
|
981 |
(insert ";;; snippets for " (symbol-name mode) "\n")
|
|
code@51
|
982 |
(insert "(yas/define-snippets '" (symbol-name mode) "\n")
|
|
code@51
|
983 |
(insert "'(\n")
|
|
code@51
|
984 |
(dolist (snippet snippets)
|
|
code@51
|
985 |
(insert " ("
|
|
code@51
|
986 |
(yas/quote-string (car snippet))
|
|
code@51
|
987 |
" "
|
|
code@51
|
988 |
(yas/quote-string (cadr snippet))
|
|
code@51
|
989 |
" "
|
|
code@51
|
990 |
(if (caddr snippet)
|
|
code@51
|
991 |
(yas/quote-string (caddr snippet))
|
|
code@51
|
992 |
"nil")
|
|
code@51
|
993 |
" "
|
|
code@51
|
994 |
(if (nth 3 snippet)
|
|
code@51
|
995 |
(format "'%s" (nth 3 snippet))
|
|
code@51
|
996 |
"nil")
|
|
code@51
|
997 |
")\n"))
|
|
code@51
|
998 |
(insert " )\n")
|
|
code@51
|
999 |
(insert (if parent
|
|
code@51
|
1000 |
(concat "'" (symbol-name parent))
|
|
code@51
|
1001 |
"nil")
|
|
code@51
|
1002 |
")\n\n"))))
|
|
code@51
|
1003 |
(dolist (dir dirs)
|
|
code@51
|
1004 |
(dolist (subdir (yas/directory-files dir nil))
|
|
code@51
|
1005 |
(yas/load-directory-1 subdir nil))))
|
|
code@51
|
1006 |
(insert "(provide '"
|
|
code@51
|
1007 |
(file-name-nondirectory
|
|
code@51
|
1008 |
(file-name-sans-extension
|
|
code@51
|
1009 |
yasnippet-bundle))
|
|
code@51
|
1010 |
")\n")
|
|
code@51
|
1011 |
(setq buffer-file-name yasnippet-bundle)
|
|
code@51
|
1012 |
(save-buffer))))
|
|
code@51
|
1013 |
|
|
code@51
|
1014 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
1015 |
;; User level functions
|
|
code@51
|
1016 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
1017 |
(defun yas/about ()
|
|
code@51
|
1018 |
(interactive)
|
|
code@51
|
1019 |
(message (concat "yasnippet (version "
|
|
code@51
|
1020 |
yas/version
|
|
code@51
|
1021 |
") -- pluskid <pluskid@gmail.com>")))
|
|
code@51
|
1022 |
(defun yas/reload-all ()
|
|
code@51
|
1023 |
"Reload all snippets."
|
|
code@51
|
1024 |
(interactive)
|
|
code@51
|
1025 |
(if yas/root-directory
|
|
code@51
|
1026 |
(if (listp yas/root-directory)
|
|
code@51
|
1027 |
(dolist (directory yas/root-directory)
|
|
code@51
|
1028 |
(yas/load-directory directory))
|
|
code@51
|
1029 |
(yas/load-directory yas/root-directory))
|
|
code@51
|
1030 |
(call-interactively 'yas/load-directory))
|
|
code@51
|
1031 |
(message "done."))
|
|
code@51
|
1032 |
|
|
code@51
|
1033 |
(defun yas/load-directory (directory)
|
|
code@51
|
1034 |
"Load snippet definition from a directory hierarchy.
|
|
code@51
|
1035 |
Below the top-level directory, each directory is a mode
|
|
code@51
|
1036 |
name. And under each subdirectory, each file is a definition
|
|
code@51
|
1037 |
of a snippet. The file name is the trigger key and the
|
|
code@51
|
1038 |
content of the file is the template."
|
|
code@51
|
1039 |
(interactive "DSelect the root directory: ")
|
|
code@51
|
1040 |
(when (and (interactive-p)
|
|
code@51
|
1041 |
(file-directory-p directory))
|
|
code@51
|
1042 |
(add-to-list 'yas/root-directory directory))
|
|
code@51
|
1043 |
(dolist (dir (yas/directory-files directory nil))
|
|
code@51
|
1044 |
(yas/load-directory-1 dir))
|
|
code@51
|
1045 |
(when (interactive-p)
|
|
code@51
|
1046 |
(message "done.")))
|
|
code@51
|
1047 |
|
|
code@51
|
1048 |
(defun yas/initialize ()
|
|
code@51
|
1049 |
"Do necessary initialization."
|
|
code@51
|
1050 |
(add-hook 'after-change-major-mode-hook
|
|
code@51
|
1051 |
'yas/minor-mode-on)
|
|
code@51
|
1052 |
(dolist (hook yas/extra-mode-hooks)
|
|
code@51
|
1053 |
(add-hook hook
|
|
code@51
|
1054 |
'yas/minor-mode-on))
|
|
code@51
|
1055 |
(add-hook 'yas/minor-mode-on-hook
|
|
code@51
|
1056 |
'yas/ensure-minor-mode-priority)
|
|
code@51
|
1057 |
(when yas/use-menu
|
|
code@51
|
1058 |
(define-key-after
|
|
code@51
|
1059 |
(lookup-key global-map [menu-bar])
|
|
code@51
|
1060 |
[yasnippet]
|
|
code@51
|
1061 |
(cons "YASnippet" yas/menu-keymap)
|
|
code@51
|
1062 |
'buffer)))
|
|
code@51
|
1063 |
|
|
code@51
|
1064 |
(defun yas/define-snippets (mode snippets &optional parent-mode)
|
|
code@51
|
1065 |
"Define snippets for MODE. SNIPPETS is a list of
|
|
code@51
|
1066 |
snippet definition, of the following form:
|
|
code@51
|
1067 |
|
|
code@51
|
1068 |
(KEY TEMPLATE NAME CONDITION)
|
|
code@51
|
1069 |
|
|
code@51
|
1070 |
or the NAME and CONDITION may be omitted. The optional 3rd
|
|
code@51
|
1071 |
parameter can be used to specify the parent mode of MODE. That
|
|
code@51
|
1072 |
is, when looking a snippet in MODE failed, it can refer to its
|
|
code@51
|
1073 |
parent mode. The PARENT-MODE may not need to be a real mode."
|
|
code@51
|
1074 |
(let ((snippet-table (yas/snippet-table mode))
|
|
code@51
|
1075 |
(parent-table (if parent-mode
|
|
code@51
|
1076 |
(yas/snippet-table parent-mode)
|
|
code@51
|
1077 |
nil))
|
|
code@51
|
1078 |
(keymap (if yas/use-menu
|
|
code@51
|
1079 |
(yas/menu-keymap-for-mode mode)
|
|
code@51
|
1080 |
nil)))
|
|
code@51
|
1081 |
(when parent-table
|
|
code@51
|
1082 |
(setf (yas/snippet-table-parent snippet-table)
|
|
code@51
|
1083 |
parent-table)
|
|
code@51
|
1084 |
(when yas/use-menu
|
|
code@51
|
1085 |
(define-key keymap (vector 'parent-mode)
|
|
code@51
|
1086 |
`(menu-item "parent mode"
|
|
code@51
|
1087 |
,(yas/menu-keymap-for-mode parent-mode)))))
|
|
code@51
|
1088 |
(when (and yas/use-menu
|
|
code@51
|
1089 |
(yas/real-mode? mode))
|
|
code@51
|
1090 |
(define-key yas/menu-keymap (vector mode)
|
|
code@51
|
1091 |
`(menu-item ,(symbol-name mode) ,keymap)))
|
|
code@51
|
1092 |
(dolist (snippet snippets)
|
|
code@51
|
1093 |
(let* ((full-key (car snippet))
|
|
code@51
|
1094 |
(key (file-name-sans-extension full-key))
|
|
code@51
|
1095 |
(name (caddr snippet))
|
|
code@51
|
1096 |
(condition (nth 3 snippet))
|
|
code@51
|
1097 |
(template (yas/make-template (cadr snippet)
|
|
code@51
|
1098 |
(or name key)
|
|
code@51
|
1099 |
condition)))
|
|
code@51
|
1100 |
(yas/snippet-table-store snippet-table
|
|
code@51
|
1101 |
full-key
|
|
code@51
|
1102 |
key
|
|
code@51
|
1103 |
template)
|
|
code@51
|
1104 |
(when yas/use-menu
|
|
code@51
|
1105 |
(define-key keymap (vector (make-symbol full-key))
|
|
code@51
|
1106 |
`(menu-item ,(yas/template-name template)
|
|
code@51
|
1107 |
,(yas/make-menu-binding (yas/template-content template))
|
|
code@51
|
1108 |
:keys ,(concat key yas/trigger-symbol))))))))
|
|
code@51
|
1109 |
|
|
code@51
|
1110 |
(defun yas/set-mode-parent (mode parent)
|
|
code@51
|
1111 |
"Set parent mode of MODE to PARENT."
|
|
code@51
|
1112 |
(setf (yas/snippet-table-parent
|
|
code@51
|
1113 |
(yas/snippet-table mode))
|
|
code@51
|
1114 |
(yas/snippet-table parent))
|
|
code@51
|
1115 |
(when yas/use-menu
|
|
code@51
|
1116 |
(define-key (yas/menu-keymap-for-mode mode) (vector 'parent-mode)
|
|
code@51
|
1117 |
`(menu-item "parent mode"
|
|
code@51
|
1118 |
,(yas/menu-keymap-for-mode parent)))))
|
|
code@51
|
1119 |
|
|
code@51
|
1120 |
(defun yas/define (mode key template &optional name condition)
|
|
code@51
|
1121 |
"Define a snippet. Expanding KEY into TEMPLATE.
|
|
code@51
|
1122 |
NAME is a description to this template. Also update
|
|
code@51
|
1123 |
the menu if `yas/use-menu' is `t'. CONDITION is the
|
|
code@51
|
1124 |
condition attached to this snippet. If you attach a
|
|
code@51
|
1125 |
condition to a snippet, then it will only be expanded
|
|
code@51
|
1126 |
when the condition evaluated to non-nil."
|
|
code@51
|
1127 |
(yas/define-snippets mode
|
|
code@51
|
1128 |
(list (list key template name condition))))
|
|
code@51
|
1129 |
|
|
code@51
|
1130 |
|
|
code@51
|
1131 |
(defun yas/hippie-try-expand (first-time?)
|
|
code@51
|
1132 |
"Integrate with hippie expand. Just put this function in
|
|
code@51
|
1133 |
`hippie-expand-try-functions-list'."
|
|
code@51
|
1134 |
(if (not first-time?)
|
|
code@51
|
1135 |
(let ((yas/fallback-behavior 'return-nil))
|
|
code@51
|
1136 |
(yas/expand))
|
|
code@51
|
1137 |
(when (and (null (car buffer-undo-list))
|
|
code@51
|
1138 |
(eq 'apply
|
|
code@51
|
1139 |
(car (cadr buffer-undo-list)))
|
|
code@51
|
1140 |
(eq 'yas/undo-expand-snippet
|
|
code@51
|
1141 |
(cadr (cadr buffer-undo-list))))
|
|
code@51
|
1142 |
(undo 1))
|
|
code@51
|
1143 |
nil))
|
|
code@51
|
1144 |
|
|
code@51
|
1145 |
(defun yas/expand ()
|
|
code@51
|
1146 |
"Expand a snippet."
|
|
code@51
|
1147 |
(interactive)
|
|
code@51
|
1148 |
(let ((local-condition (yas/template-condition-predicate
|
|
code@51
|
1149 |
yas/buffer-local-condition)))
|
|
code@51
|
1150 |
(if local-condition
|
|
code@51
|
1151 |
(let ((yas/require-template-condition
|
|
code@51
|
1152 |
(if (and (consp local-condition)
|
|
code@51
|
1153 |
(eq 'require-snippet-condition (car local-condition))
|
|
code@51
|
1154 |
(symbolp (cdr local-condition)))
|
|
code@51
|
1155 |
(cdr local-condition)
|
|
code@51
|
1156 |
nil)))
|
|
code@51
|
1157 |
(multiple-value-bind (templates start end) (yas/current-key)
|
|
code@51
|
1158 |
(if templates
|
|
code@51
|
1159 |
(let ((template (if (null (cdr templates)) ; only 1 template
|
|
code@51
|
1160 |
(yas/template-content (cdar templates))
|
|
code@51
|
1161 |
(yas/popup-for-template templates))))
|
|
code@51
|
1162 |
(if template
|
|
code@51
|
1163 |
(progn (yas/expand-snippet start end template)
|
|
code@51
|
1164 |
'expanded) ; expanded successfully
|
|
code@51
|
1165 |
'interruptted)) ; interrupted by user
|
|
code@51
|
1166 |
(if (eq yas/fallback-behavior 'return-nil)
|
|
code@51
|
1167 |
nil ; return nil
|
|
code@51
|
1168 |
(let* ((yas/minor-mode nil)
|
|
code@51
|
1169 |
(command (key-binding yas/trigger-key)))
|
|
code@51
|
1170 |
(when (commandp command)
|
|
code@51
|
1171 |
(call-interactively command))))))))))
|
|
code@51
|
1172 |
|
|
code@51
|
1173 |
(defun yas/next-field-group ()
|
|
code@51
|
1174 |
"Navigate to next field group. If there's none, exit the snippet."
|
|
code@51
|
1175 |
(interactive)
|
|
code@51
|
1176 |
(let ((overlay (yas/current-overlay-for-navigation)))
|
|
code@51
|
1177 |
(if overlay
|
|
code@51
|
1178 |
(yas/navigate-group (overlay-get overlay 'yas/group) t)
|
|
code@51
|
1179 |
(let ((snippet (yas/snippet-of-current-keymap))
|
|
code@51
|
1180 |
(done nil))
|
|
code@51
|
1181 |
(if snippet
|
|
code@51
|
1182 |
(do* ((groups (yas/snippet-groups snippet) (cdr groups))
|
|
code@51
|
1183 |
(group (car groups) (car groups)))
|
|
code@51
|
1184 |
((or (null groups)
|
|
code@51
|
1185 |
done)
|
|
code@51
|
1186 |
(unless done
|
|
code@51
|
1187 |
(let* ((overlay (yas/snippet-overlay snippet))
|
|
code@51
|
1188 |
(keymap (overlay-get overlay 'keymap))
|
|
code@51
|
1189 |
(command nil))
|
|
code@51
|
1190 |
(overlay-put overlay 'keymap nil)
|
|
code@51
|
1191 |
(overlay-put overlay 'yas/snippet-reference nil)
|
|
code@51
|
1192 |
(setq command (key-binding yas/next-field-key))
|
|
code@51
|
1193 |
(when (commandp command)
|
|
code@51
|
1194 |
(call-interactively command))
|
|
code@51
|
1195 |
(overlay-put overlay 'keymap keymap)
|
|
code@51
|
1196 |
(overlay-put overlay 'yas/snippet-reference snippet))))
|
|
code@51
|
1197 |
(when (= (point)
|
|
code@51
|
1198 |
(overlay-start
|
|
code@51
|
1199 |
(yas/field-overlay
|
|
code@51
|
1200 |
(yas/group-primary-field group))))
|
|
code@51
|
1201 |
(setq done t)
|
|
code@51
|
1202 |
(yas/navigate-group group t))))))))
|
|
code@51
|
1203 |
|
|
code@51
|
1204 |
(defun yas/prev-field-group ()
|
|
code@51
|
1205 |
"Navigate to prev field group. If there's none, exit the snippet."
|
|
code@51
|
1206 |
(interactive)
|
|
code@51
|
1207 |
(let ((overlay (yas/current-overlay-for-navigation)))
|
|
code@51
|
1208 |
(if overlay
|
|
code@51
|
1209 |
(yas/navigate-group (overlay-get overlay 'yas/group) nil)
|
|
code@51
|
1210 |
(let ((snippet (yas/snippet-of-current-keymap))
|
|
code@51
|
1211 |
(done nil))
|
|
code@51
|
1212 |
(if snippet
|
|
code@51
|
1213 |
(do* ((groups (yas/snippet-groups snippet) (cdr groups))
|
|
code@51
|
1214 |
(group (car groups) (car groups)))
|
|
code@51
|
1215 |
((or (null groups)
|
|
code@51
|
1216 |
done)
|
|
code@51
|
1217 |
(unless done (message "Not in a snippet field.")))
|
|
code@51
|
1218 |
(when (= (point)
|
|
code@51
|
1219 |
(overlay-start
|
|
code@51
|
1220 |
(yas/field-overlay
|
|
code@51
|
1221 |
(yas/group-primary-field group))))
|
|
code@51
|
1222 |
(setq done t)
|
|
code@51
|
1223 |
(yas/navigate-group group nil)))
|
|
code@51
|
1224 |
(message "Not in a snippet field."))))))
|
|
code@51
|
1225 |
|
|
code@51
|
1226 |
(defun yas/exit-snippet (snippet)
|
|
code@51
|
1227 |
"Goto exit-marker of SNIPPET and delete the snippet."
|
|
code@51
|
1228 |
(interactive)
|
|
code@51
|
1229 |
(let ((overlay (yas/snippet-overlay snippet)))
|
|
code@51
|
1230 |
(let ((yas/snippet-beg (overlay-start overlay))
|
|
code@51
|
1231 |
(yas/snippet-end (overlay-end overlay)))
|
|
code@51
|
1232 |
(goto-char (yas/snippet-exit-marker snippet))
|
|
code@51
|
1233 |
(delete-overlay overlay)
|
|
code@51
|
1234 |
(dolist (group (yas/snippet-groups snippet))
|
|
code@51
|
1235 |
(dolist (field (yas/group-fields group))
|
|
code@51
|
1236 |
(delete-overlay (yas/field-overlay field))))
|
|
code@51
|
1237 |
|
|
code@51
|
1238 |
(run-hooks 'yas/after-exit-snippet-hook))))
|
|
code@51
|
1239 |
|
|
code@51
|
1240 |
(provide 'yasnippet)
|
|
code@51
|
1241 |
|
|
code@51
|
1242 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
1243 |
;; Monkey patching for other functions that's causing
|
|
code@51
|
1244 |
;; problems to yasnippet. For details on why I patch
|
|
code@51
|
1245 |
;; those functions, refer to
|
|
code@51
|
1246 |
;; http://code.google.com/p/yasnippet/wiki/MonkeyPatching
|
|
code@51
|
1247 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
1248 |
(defadvice c-neutralize-syntax-in-CPP
|
|
code@51
|
1249 |
(around yas-mp/c-neutralize-syntax-in-CPP activate)
|
|
code@51
|
1250 |
"Adviced `c-neutralize-syntax-in-CPP' to properly
|
|
code@51
|
1251 |
handle the end-of-buffer error fired in it by calling
|
|
code@51
|
1252 |
`forward-char' at the end of buffer."
|
|
code@51
|
1253 |
(condition-case err
|
|
code@51
|
1254 |
ad-do-it
|
|
code@51
|
1255 |
(error (message (error-message-string err)))))
|
|
code@51
|
1256 |
|
|
code@51
|
1257 |
|
|
code@51
|
1258 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
1259 |
;; Contents of dropdown-list.el
|
|
code@51
|
1260 |
;;
|
|
code@51
|
1261 |
;; dropdown-list.el is used by yasnippet to select multiple
|
|
code@51
|
1262 |
;; candidate snippets.
|
|
code@51
|
1263 |
;;
|
|
code@51
|
1264 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
1265 |
;;; dropdown-list.el --- Drop-down menu interface
|
|
code@51
|
1266 |
;;
|
|
code@51
|
1267 |
;; Filename: dropdown-list.el
|
|
code@51
|
1268 |
;; Description: Drop-down menu interface
|
|
code@51
|
1269 |
;; Author: Jaeyoun Chung [jay.chung@gmail.com]
|
|
code@51
|
1270 |
;; Maintainer:
|
|
code@51
|
1271 |
;; Copyright (C) 2008 Jaeyoun Chung
|
|
code@51
|
1272 |
;; Created: Sun Mar 16 11:20:45 2008 (Pacific Daylight Time)
|
|
code@51
|
1273 |
;; Version:
|
|
code@51
|
1274 |
;; Last-Updated: Sun Mar 16 12:19:49 2008 (Pacific Daylight Time)
|
|
code@51
|
1275 |
;; By: dradams
|
|
code@51
|
1276 |
;; Update #: 43
|
|
code@51
|
1277 |
;; URL: http://www.emacswiki.org/cgi-bin/wiki/dropdown-list.el
|
|
code@51
|
1278 |
;; Keywords: convenience menu
|
|
code@51
|
1279 |
;; Compatibility: GNU Emacs 21.x, GNU Emacs 22.x
|
|
code@51
|
1280 |
;;
|
|
code@51
|
1281 |
;; Features that might be required by this library:
|
|
code@51
|
1282 |
;;
|
|
code@51
|
1283 |
;; `cl'.
|
|
code@51
|
1284 |
;;
|
|
code@51
|
1285 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
1286 |
;;
|
|
code@51
|
1287 |
;;; Commentary:
|
|
code@51
|
1288 |
;;
|
|
code@51
|
1289 |
;; According to Jaeyoun Chung, "overlay code stolen from company-mode.el."
|
|
code@51
|
1290 |
;;
|
|
code@51
|
1291 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
1292 |
;;
|
|
code@51
|
1293 |
;;; Change log:
|
|
code@51
|
1294 |
;;
|
|
code@51
|
1295 |
;; 2008/03/16 dadams
|
|
code@51
|
1296 |
;; Clean-up - e.g. use char-to-string for control chars removed by email posting.
|
|
code@51
|
1297 |
;; Moved example usage code (define-key*, command-selector) inside the library.
|
|
code@51
|
1298 |
;; Require cl.el at byte-compile time.
|
|
code@51
|
1299 |
;; Added GPL statement.
|
|
code@51
|
1300 |
;; 2008/01/06 Jaeyoun Chung
|
|
code@51
|
1301 |
;; Posted to gnu-emacs-sources@gnu.org at 9:10 p.m.
|
|
code@51
|
1302 |
;;
|
|
code@51
|
1303 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
1304 |
;;
|
|
code@51
|
1305 |
;; This program is free software; you can redistribute it and/or
|
|
code@51
|
1306 |
;; modify it under the terms of the GNU General Public License as
|
|
code@51
|
1307 |
;; published by the Free Software Foundation; either version 3, or
|
|
code@51
|
1308 |
;; (at your option) any later version.
|
|
code@51
|
1309 |
;;
|
|
code@51
|
1310 |
;; This program is distributed in the hope that it will be useful,
|
|
code@51
|
1311 |
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
code@51
|
1312 |
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
code@51
|
1313 |
;; General Public License for more details.
|
|
code@51
|
1314 |
;;
|
|
code@51
|
1315 |
;; You should have received a copy of the GNU General Public License
|
|
code@51
|
1316 |
;; along with this program; see the file COPYING. If not, write to
|
|
code@51
|
1317 |
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
|
code@51
|
1318 |
;; Floor, Boston, MA 02110-1301, USA.
|
|
code@51
|
1319 |
;;
|
|
code@51
|
1320 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
1321 |
;;
|
|
code@51
|
1322 |
;;; Code:
|
|
code@51
|
1323 |
|
|
code@51
|
1324 |
(eval-when-compile (require 'cl)) ;; decf, fourth, incf, loop, mapcar*
|
|
code@51
|
1325 |
|
|
code@51
|
1326 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
1327 |
|
|
code@51
|
1328 |
(defface dropdown-list-face
|
|
code@51
|
1329 |
'((t :inherit default :background "lightyellow" :foreground "black"))
|
|
code@51
|
1330 |
"*Bla." :group 'dropdown-list)
|
|
code@51
|
1331 |
|
|
code@51
|
1332 |
(defface dropdown-list-selection-face
|
|
code@51
|
1333 |
'((t :inherit dropdown-list :background "purple"))
|
|
code@51
|
1334 |
"*Bla." :group 'dropdown-list)
|
|
code@51
|
1335 |
|
|
code@51
|
1336 |
(defvar dropdown-list-overlays nil)
|
|
code@51
|
1337 |
|
|
code@51
|
1338 |
(defun dropdown-list-hide ()
|
|
code@51
|
1339 |
(while dropdown-list-overlays
|
|
code@51
|
1340 |
(delete-overlay (pop dropdown-list-overlays))))
|
|
code@51
|
1341 |
|
|
code@51
|
1342 |
(defun dropdown-list-put-overlay (beg end &optional prop value prop2 value2)
|
|
code@51
|
1343 |
(let ((ov (make-overlay beg end)))
|
|
code@51
|
1344 |
(overlay-put ov 'window t)
|
|
code@51
|
1345 |
(when prop
|
|
code@51
|
1346 |
(overlay-put ov prop value)
|
|
code@51
|
1347 |
(when prop2 (overlay-put ov prop2 value2)))
|
|
code@51
|
1348 |
ov))
|
|
code@51
|
1349 |
|
|
code@51
|
1350 |
(defun dropdown-list-line (start replacement &optional no-insert)
|
|
code@51
|
1351 |
;; start might be in the middle of a tab, which means we need to hide the
|
|
code@51
|
1352 |
;; tab and add spaces
|
|
code@51
|
1353 |
(let ((end (+ start (length replacement)))
|
|
code@51
|
1354 |
beg-point end-point
|
|
code@51
|
1355 |
before-string after-string)
|
|
code@51
|
1356 |
(goto-char (point-at-eol))
|
|
code@51
|
1357 |
(if (< (current-column) start)
|
|
code@51
|
1358 |
(progn (setq before-string (make-string (- start (current-column)) ? ))
|
|
code@51
|
1359 |
(setq beg-point (point)))
|
|
code@51
|
1360 |
(goto-char (point-at-bol)) ;; Emacs bug, move-to-column is wrong otherwise
|
|
code@51
|
1361 |
(move-to-column start)
|
|
code@51
|
1362 |
(setq beg-point (point))
|
|
code@51
|
1363 |
(when (> (current-column) start)
|
|
code@51
|
1364 |
(goto-char (1- (point)))
|
|
code@51
|
1365 |
(setq beg-point (point))
|
|
code@51
|
1366 |
(setq before-string (make-string (- start (current-column)) ? ))))
|
|
code@51
|
1367 |
(move-to-column end)
|
|
code@51
|
1368 |
(setq end-point (point))
|
|
code@51
|
1369 |
(let ((end-offset (- (current-column) end)))
|
|
code@51
|
1370 |
(when (> end-offset 0) (setq after-string (make-string end-offset ?b))))
|
|
code@51
|
1371 |
(when no-insert
|
|
code@51
|
1372 |
;; prevent inheriting of faces
|
|
code@51
|
1373 |
(setq before-string (when before-string (propertize before-string 'face 'default)))
|
|
code@51
|
1374 |
(setq after-string (when after-string (propertize after-string 'face 'default))))
|
|
code@51
|
1375 |
(let ((string (concat before-string replacement after-string)))
|
|
code@51
|
1376 |
(if no-insert
|
|
code@51
|
1377 |
string
|
|
code@51
|
1378 |
(push (dropdown-list-put-overlay beg-point end-point 'invisible t
|
|
code@51
|
1379 |
'after-string string)
|
|
code@51
|
1380 |
dropdown-list-overlays)))))
|
|
code@51
|
1381 |
|
|
code@51
|
1382 |
(defun dropdown-list-start-column (display-width)
|
|
code@51
|
1383 |
(let ((column (mod (current-column) (window-width)))
|
|
code@51
|
1384 |
(width (window-width)))
|
|
code@51
|
1385 |
(cond ((<= (+ column display-width) width) column)
|
|
code@51
|
1386 |
((> column display-width) (- column display-width))
|
|
code@51
|
1387 |
((>= width display-width) (- width display-width))
|
|
code@51
|
1388 |
(t nil))))
|
|
code@51
|
1389 |
|
|
code@51
|
1390 |
(defun dropdown-list-move-to-start-line (candidate-count)
|
|
code@51
|
1391 |
(decf candidate-count)
|
|
code@51
|
1392 |
(let ((above-line-count (save-excursion (- (vertical-motion (- candidate-count)))))
|
|
code@51
|
1393 |
(below-line-count (save-excursion (vertical-motion candidate-count))))
|
|
code@51
|
1394 |
(cond ((= below-line-count candidate-count)
|
|
code@51
|
1395 |
t)
|
|
code@51
|
1396 |
((= above-line-count candidate-count)
|
|
code@51
|
1397 |
(vertical-motion (- candidate-count))
|
|
code@51
|
1398 |
t)
|
|
code@51
|
1399 |
((>= (+ below-line-count above-line-count) candidate-count)
|
|
code@51
|
1400 |
(vertical-motion (- (- candidate-count below-line-count)))
|
|
code@51
|
1401 |
t)
|
|
code@51
|
1402 |
(t nil))))
|
|
code@51
|
1403 |
|
|
code@51
|
1404 |
(defun dropdown-list-at-point (candidates &optional selidx)
|
|
code@51
|
1405 |
(dropdown-list-hide)
|
|
code@51
|
1406 |
(let* ((lengths (mapcar #'length candidates))
|
|
code@51
|
1407 |
(max-length (apply #'max lengths))
|
|
code@51
|
1408 |
(start (dropdown-list-start-column (+ max-length 3)))
|
|
code@51
|
1409 |
(i -1)
|
|
code@51
|
1410 |
(candidates (mapcar* (lambda (candidate length)
|
|
code@51
|
1411 |
(let ((diff (- max-length length)))
|
|
code@51
|
1412 |
(propertize
|
|
code@51
|
1413 |
(concat (if (> diff 0)
|
|
code@51
|
1414 |
(concat candidate (make-string diff ? ))
|
|
code@51
|
1415 |
(substring candidate 0 max-length))
|
|
code@51
|
1416 |
(format "%3d" (+ 2 i)))
|
|
code@51
|
1417 |
'face (if (eql (incf i) selidx)
|
|
code@51
|
1418 |
'dropdown-list-selection-face
|
|
code@51
|
1419 |
'dropdown-list-face))))
|
|
code@51
|
1420 |
candidates
|
|
code@51
|
1421 |
lengths)))
|
|
code@51
|
1422 |
(save-excursion
|
|
code@51
|
1423 |
(and start
|
|
code@51
|
1424 |
(dropdown-list-move-to-start-line (length candidates))
|
|
code@51
|
1425 |
(loop initially (vertical-motion 0)
|
|
code@51
|
1426 |
for candidate in candidates
|
|
code@51
|
1427 |
do (dropdown-list-line (+ (current-column) start) candidate)
|
|
code@51
|
1428 |
while (/= (vertical-motion 1) 0)
|
|
code@51
|
1429 |
finally return t)))))
|
|
code@51
|
1430 |
|
|
code@51
|
1431 |
(defun dropdown-list (candidates)
|
|
code@51
|
1432 |
(let ((selection)
|
|
code@51
|
1433 |
(temp-buffer))
|
|
code@51
|
1434 |
(save-window-excursion
|
|
code@51
|
1435 |
(unwind-protect
|
|
code@51
|
1436 |
(let ((candidate-count (length candidates))
|
|
code@51
|
1437 |
done key selidx)
|
|
code@51
|
1438 |
(while (not done)
|
|
code@51
|
1439 |
(unless (dropdown-list-at-point candidates selidx)
|
|
code@51
|
1440 |
(switch-to-buffer (setq temp-buffer (get-buffer-create "*selection*"))
|
|
code@51
|
1441 |
'norecord)
|
|
code@51
|
1442 |
(delete-other-windows)
|
|
code@51
|
1443 |
(delete-region (point-min) (point-max))
|
|
code@51
|
1444 |
(insert (make-string (length candidates) ?\n))
|
|
code@51
|
1445 |
(goto-char (point-min))
|
|
code@51
|
1446 |
(dropdown-list-at-point candidates selidx))
|
|
code@51
|
1447 |
(setq key (read-key-sequence ""))
|
|
code@51
|
1448 |
(cond ((and (stringp key)
|
|
code@51
|
1449 |
(>= (aref key 0) ?1)
|
|
code@51
|
1450 |
(<= (aref key 0) (+ ?0 (min 9 candidate-count))))
|
|
code@51
|
1451 |
(setq selection (- (aref key 0) ?1)
|
|
code@51
|
1452 |
done t))
|
|
code@51
|
1453 |
((member key `(,(char-to-string ?\C-p) [up]))
|
|
code@51
|
1454 |
(setq selidx (mod (+ candidate-count (1- (or selidx 0)))
|
|
code@51
|
1455 |
candidate-count)))
|
|
code@51
|
1456 |
((member key `(,(char-to-string ?\C-n) [down]))
|
|
code@51
|
1457 |
(setq selidx (mod (1+ (or selidx -1)) candidate-count)))
|
|
code@51
|
1458 |
((member key `(,(char-to-string ?\f))))
|
|
code@51
|
1459 |
((member key `(,(char-to-string ?\r) [return]))
|
|
code@51
|
1460 |
(setq selection selidx
|
|
code@51
|
1461 |
done t))
|
|
code@51
|
1462 |
(t (setq done t)))))
|
|
code@51
|
1463 |
(dropdown-list-hide)
|
|
code@51
|
1464 |
(and temp-buffer (kill-buffer temp-buffer)))
|
|
code@51
|
1465 |
;; (when selection
|
|
code@51
|
1466 |
;; (message "your selection => %d: %s" selection (nth selection candidates))
|
|
code@51
|
1467 |
;; (sit-for 1))
|
|
code@51
|
1468 |
selection)))
|
|
code@51
|
1469 |
|
|
code@51
|
1470 |
(defun define-key* (keymap key command)
|
|
code@51
|
1471 |
"Add COMMAND to the multiple-command binding of KEY in KEYMAP.
|
|
code@51
|
1472 |
Use multiple times to bind different COMMANDs to the same KEY."
|
|
code@51
|
1473 |
(define-key keymap key (combine-command command (lookup-key keymap key))))
|
|
code@51
|
1474 |
|
|
code@51
|
1475 |
(defun combine-command (command defs)
|
|
code@51
|
1476 |
"$$$$$ FIXME - no doc string"
|
|
code@51
|
1477 |
(cond ((null defs) command)
|
|
code@51
|
1478 |
((and (listp defs)
|
|
code@51
|
1479 |
(eq 'lambda (car defs))
|
|
code@51
|
1480 |
(= (length defs) 4)
|
|
code@51
|
1481 |
(listp (fourth defs))
|
|
code@51
|
1482 |
(eq 'command-selector (car (fourth defs))))
|
|
code@51
|
1483 |
(unless (member `',command (cdr (fourth defs)))
|
|
code@51
|
1484 |
(setcdr (fourth defs) (nconc (cdr (fourth defs)) `(',command))))
|
|
code@51
|
1485 |
defs)
|
|
code@51
|
1486 |
(t
|
|
code@51
|
1487 |
`(lambda () (interactive) (command-selector ',defs ',command)))))
|
|
code@51
|
1488 |
|
|
code@51
|
1489 |
(defvar command-selector-last-command nil "$$$$$ FIXME - no doc string")
|
|
code@51
|
1490 |
|
|
code@51
|
1491 |
(defun command-selector (&rest candidates)
|
|
code@51
|
1492 |
"$$$$$ FIXME - no doc string"
|
|
code@51
|
1493 |
(if (and (eq last-command this-command) command-selector-last-command)
|
|
code@51
|
1494 |
(call-interactively command-selector-last-command)
|
|
code@51
|
1495 |
(let* ((candidate-strings
|
|
code@51
|
1496 |
(mapcar (lambda (candidate)
|
|
code@51
|
1497 |
(format "%s" (if (symbolp candidate)
|
|
code@51
|
1498 |
candidate
|
|
code@51
|
1499 |
(let ((s (format "%s" candidate)))
|
|
code@51
|
1500 |
(if (>= (length s) 7)
|
|
code@51
|
1501 |
(concat (substring s 0 7) "...")
|
|
code@51
|
1502 |
s)))))
|
|
code@51
|
1503 |
candidates))
|
|
code@51
|
1504 |
(selection (dropdown-list candidate-strings)))
|
|
code@51
|
1505 |
(when selection
|
|
code@51
|
1506 |
(let ((cmd (nth selection candidates)))
|
|
code@51
|
1507 |
(call-interactively cmd)
|
|
code@51
|
1508 |
(setq command-selector-last-command cmd))))))
|
|
code@51
|
1509 |
|
|
code@51
|
1510 |
;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
1511 |
|
|
code@51
|
1512 |
(provide 'dropdown-list)
|
|
code@51
|
1513 |
|
|
code@51
|
1514 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
code@51
|
1515 |
;;; dropdown-list.el ends here
|
|
code@51
|
1516 |
|