Commit | Line | Data |
---|---|---|
4d902e6f CY |
1 | ;;; srecode/mode.el --- Minor mode for managing and using SRecode templates |
2 | ||
3 | ;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Eric M. Ludlam <eric@siege-engine.com> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation, either version 3 of the License, or | |
12 | ;; (at your option) any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | ;;; Commentary: | |
23 | ;; | |
24 | ;; Minor mode for working with SRecode template files. | |
25 | ;; | |
26 | ;; Depends on Semantic for minor-mode convenience functions. | |
27 | ||
28 | (require 'mode-local) | |
29 | (require 'srecode) | |
30 | (require 'srecode/insert) | |
31 | (require 'srecode/find) | |
32 | (require 'srecode/map) | |
33 | ;; (require 'senator) | |
34 | (require 'semantic/decorate) | |
35 | (require 'semantic/wisent) | |
36 | ||
37 | (eval-when-compile (require 'semantic/find)) | |
38 | ||
39 | ;;; Code: | |
40 | ||
41 | (defcustom global-srecode-minor-mode nil | |
42 | "Non-nil in buffers with Semantic Recoder macro keybindings." | |
43 | :group 'srecode | |
44 | :type 'boolean | |
b82525f2 | 45 | :require 'srecode/mode |
4d902e6f CY |
46 | :initialize 'custom-initialize-default |
47 | :set (lambda (sym val) | |
48 | (global-srecode-minor-mode (if val 1 -1)))) | |
49 | ||
50 | (defvar srecode-minor-mode nil | |
51 | "Non-nil in buffers with Semantic Recoder macro keybindings.") | |
52 | (make-variable-buffer-local 'srecode-minor-mode) | |
53 | ||
54 | (defcustom srecode-minor-mode-hook nil | |
55 | "Hook run at the end of the function `srecode-minor-mode'." | |
56 | :group 'srecode | |
57 | :type 'hook) | |
58 | ||
59 | ;; We don't want to waste space. There is a menu after all. | |
60 | ;;(add-to-list 'minor-mode-alist '(srecode-minor-mode "")) | |
61 | ||
62 | (defvar srecode-prefix-key [(control ?c) ?/] | |
63 | "The common prefix key in srecode minor mode.") | |
64 | ||
65 | (defvar srecode-prefix-map | |
66 | (let ((km (make-sparse-keymap))) | |
67 | ;; Basic template codes | |
68 | (define-key km "/" 'srecode-insert) | |
69 | (define-key km [insert] 'srecode-insert) | |
70 | (define-key km "." 'srecode-insert-again) | |
71 | (define-key km "E" 'srecode-edit) | |
72 | ;; Template indirect binding | |
73 | (let ((k ?a)) | |
74 | (while (<= k ?z) | |
75 | (define-key km (format "%c" k) 'srecode-bind-insert) | |
76 | (setq k (1+ k)))) | |
77 | km) | |
78 | "Keymap used behind the srecode prefix key in in srecode minor mode.") | |
79 | ||
80 | (defvar srecode-menu-bar | |
81 | (list | |
82 | "SRecoder" | |
eb1ac101 | 83 | (semantic-menu-item |
4d902e6f CY |
84 | ["Insert Template" |
85 | srecode-insert | |
86 | :active t | |
87 | :help "Insert a template by name." | |
88 | ]) | |
eb1ac101 | 89 | (semantic-menu-item |
4d902e6f CY |
90 | ["Insert Template Again" |
91 | srecode-insert-again | |
92 | :active t | |
93 | :help "Run the same template as last time again." | |
94 | ]) | |
eb1ac101 | 95 | (semantic-menu-item |
4d902e6f CY |
96 | ["Edit Template" |
97 | srecode-edit | |
98 | :active t | |
99 | :help "Edit a template for this language by name." | |
100 | ]) | |
101 | "---" | |
102 | '( "Insert ..." :filter srecode-minor-mode-templates-menu ) | |
103 | `( "Generate ..." :filter srecode-minor-mode-generate-menu ) | |
104 | "---" | |
eb1ac101 | 105 | (semantic-menu-item |
4d902e6f CY |
106 | ["Customize..." |
107 | (customize-group "srecode") | |
108 | :active t | |
109 | :help "Customize SRecode options" | |
110 | ]) | |
111 | (list | |
112 | "Debugging Tools..." | |
eb1ac101 | 113 | (semantic-menu-item |
4d902e6f CY |
114 | ["Dump Template MAP" |
115 | srecode-get-maps | |
116 | :active t | |
117 | :help "Calculate (if needed) and display the current template file map." | |
118 | ]) | |
eb1ac101 | 119 | (semantic-menu-item |
4d902e6f CY |
120 | ["Dump Tables" |
121 | srecode-dump-templates | |
122 | :active t | |
123 | :help "Dump the current template table." | |
124 | ]) | |
eb1ac101 | 125 | (semantic-menu-item |
4d902e6f CY |
126 | ["Dump Dictionary" |
127 | srecode-dictionary-dump | |
128 | :active t | |
129 | :help "Calculate a dump a dictionary for point." | |
130 | ]) | |
131 | ) | |
132 | ) | |
133 | "Menu for srecode minor mode.") | |
134 | ||
135 | (defvar srecode-minor-menu nil | |
136 | "Menu keymap build from `srecode-menu-bar'.") | |
137 | ||
138 | (defcustom srecode-takeover-INS-key nil | |
139 | "Use the insert key for inserting templates." | |
140 | :group 'srecode | |
141 | :type 'boolean) | |
142 | ||
143 | (defvar srecode-mode-map | |
144 | (let ((km (make-sparse-keymap))) | |
145 | (define-key km srecode-prefix-key srecode-prefix-map) | |
146 | (easy-menu-define srecode-minor-menu km "Srecode Minor Mode Menu" | |
147 | srecode-menu-bar) | |
148 | (when srecode-takeover-INS-key | |
149 | (define-key km [insert] srecode-prefix-map)) | |
150 | km) | |
151 | "Keymap for srecode minor mode.") | |
152 | ||
153 | ;;;###autoload | |
154 | (defun srecode-minor-mode (&optional arg) | |
155 | "Toggle srecode minor mode. | |
156 | With prefix argument ARG, turn on if positive, otherwise off. The | |
157 | minor mode can be turned on only if semantic feature is available and | |
158 | the current buffer was set up for parsing. Return non-nil if the | |
159 | minor mode is enabled. | |
160 | ||
161 | \\{srecode-mode-map}" | |
162 | (interactive | |
163 | (list (or current-prefix-arg | |
164 | (if srecode-minor-mode 0 1)))) | |
165 | ;; Flip the bits. | |
166 | (setq srecode-minor-mode | |
167 | (if arg | |
168 | (> | |
169 | (prefix-numeric-value arg) | |
170 | 0) | |
171 | (not srecode-minor-mode))) | |
172 | ;; If we are turning things on, make sure we have templates for | |
173 | ;; this mode first. | |
174 | (when srecode-minor-mode | |
175 | (when (not (apply | |
176 | 'append | |
177 | (mapcar (lambda (map) | |
178 | (srecode-map-entries-for-mode map major-mode)) | |
179 | (srecode-get-maps)))) | |
180 | (setq srecode-minor-mode nil)) | |
181 | ) | |
182 | ;; Run hooks if we are turning this on. | |
183 | (when srecode-minor-mode | |
184 | (run-hooks 'srecode-minor-mode-hook)) | |
185 | srecode-minor-mode) | |
186 | ||
187 | ;;;###autoload | |
188 | (defun global-srecode-minor-mode (&optional arg) | |
189 | "Toggle global use of srecode minor mode. | |
190 | If ARG is positive, enable, if it is negative, disable. | |
191 | If ARG is nil, then toggle." | |
192 | (interactive "P") | |
193 | (setq global-srecode-minor-mode | |
194 | (semantic-toggle-minor-mode-globally | |
195 | 'srecode-minor-mode arg))) | |
196 | ||
197 | ;; Use the semantic minor mode magic stuff. | |
198 | (semantic-add-minor-mode 'srecode-minor-mode "" srecode-mode-map) | |
199 | ||
200 | ;;; Menu Filters | |
201 | ;; | |
202 | (defun srecode-minor-mode-templates-menu (menu-def) | |
203 | "Create a menu item of cascading filters active for this mode. | |
204 | MENU-DEF is the menu to bind this into." | |
205 | ;; Doing this SEGVs Emacs on windows. | |
206 | ;;(srecode-load-tables-for-mode major-mode) | |
207 | ||
208 | (let* ((modetable (srecode-get-mode-table major-mode)) | |
209 | (subtab (when modetable (oref modetable :tables))) | |
210 | (context nil) | |
211 | (active nil) | |
212 | (ltab nil) | |
213 | (temp nil) | |
214 | (alltabs nil) | |
215 | ) | |
216 | (if (not subtab) | |
217 | ;; No tables, show a "load the tables" option. | |
218 | (list (vector "Load Mode Tables..." | |
219 | (lambda () | |
220 | (interactive) | |
221 | (srecode-load-tables-for-mode major-mode)) | |
222 | )) | |
223 | ;; Build something | |
224 | (setq context (car-safe (srecode-calculate-context))) | |
225 | ||
226 | (while subtab | |
227 | (setq ltab (oref (car subtab) templates)) | |
228 | (while ltab | |
229 | (setq temp (car ltab)) | |
230 | ||
231 | ;; Do something with this template. | |
232 | ||
233 | (let* ((ctxt (oref temp context)) | |
234 | (ctxtcons (assoc ctxt alltabs)) | |
235 | (bind (if (slot-boundp temp 'binding) | |
236 | (oref temp binding))) | |
237 | (name (object-name-string temp))) | |
238 | ||
239 | (when (not ctxtcons) | |
240 | (if (string= context ctxt) | |
241 | ;; If this context is not in the current list of contexts | |
242 | ;; is equal to the current context, then manage the | |
243 | ;; active list instead | |
244 | (setq active | |
245 | (setq ctxtcons (or active (cons ctxt nil)))) | |
246 | ;; This is not an active context, add it to alltabs. | |
247 | (setq ctxtcons (cons ctxt nil)) | |
248 | (setq alltabs (cons ctxtcons alltabs)))) | |
249 | ||
250 | (let ((new (vector | |
251 | (if bind | |
252 | (concat name " (" bind ")") | |
253 | name) | |
254 | `(lambda () (interactive) | |
255 | (srecode-insert (concat ,ctxt ":" ,name))) | |
256 | t))) | |
257 | ||
258 | (setcdr ctxtcons (cons | |
259 | new | |
260 | (cdr ctxtcons))))) | |
261 | ||
262 | (setq ltab (cdr ltab))) | |
263 | (setq subtab (cdr subtab))) | |
264 | ||
265 | ;; Now create the menu | |
266 | (easy-menu-filter-return | |
267 | (easy-menu-create-menu | |
268 | "Semantic Recoder Filters" | |
269 | (append (cdr active) | |
270 | alltabs) | |
271 | )) | |
272 | ))) | |
273 | ||
274 | (defvar srecode-minor-mode-generators nil | |
275 | "List of code generators to be displayed in the srecoder menu.") | |
276 | ||
277 | (defun srecode-minor-mode-generate-menu (menu-def) | |
278 | "Create a menu item of cascading filters active for this mode. | |
279 | MENU-DEF is the menu to bind this into." | |
280 | ;; Doing this SEGVs Emacs on windows. | |
281 | ;;(srecode-load-tables-for-mode major-mode) | |
282 | (let ((allgeneratorapps nil)) | |
283 | ||
284 | (dolist (gen srecode-minor-mode-generators) | |
285 | (setq allgeneratorapps | |
286 | (cons (vector (cdr gen) (car gen)) | |
287 | allgeneratorapps)) | |
288 | (message "Adding %S to srecode menu" (car gen)) | |
289 | ) | |
290 | ||
291 | (easy-menu-filter-return | |
292 | (easy-menu-create-menu | |
293 | "Semantic Recoder Generate Filters" | |
294 | allgeneratorapps))) | |
295 | ) | |
296 | ||
297 | ;;; Minor Mode commands | |
298 | ;; | |
299 | (defun srecode-bind-insert () | |
300 | "Bound insert for Srecode macros. | |
301 | This command will insert whichever srecode template has a binding | |
302 | to the current key." | |
303 | (interactive) | |
304 | (let* ((k last-command-event) | |
305 | (ctxt (srecode-calculate-context)) | |
306 | ;; Find the template with the binding K | |
307 | (template (srecode-template-get-table-for-binding | |
308 | (srecode-table) k ctxt))) | |
309 | ;; test it. | |
310 | (when (not template) | |
311 | (error "No template bound to %c" k)) | |
312 | ;; insert | |
313 | (srecode-insert template) | |
314 | )) | |
315 | ||
316 | (defun srecode-edit (template-name) | |
317 | "Switch to the template buffer for TEMPLATE-NAME. | |
318 | Template is chosen based on the mode of the starting buffer." | |
319 | ;; @todo - Get a template stack from the last run template, and show | |
320 | ;; those too! | |
321 | (interactive (list (srecode-read-template-name | |
322 | "Template Name: " | |
323 | (car srecode-read-template-name-history)))) | |
324 | (if (not (srecode-table)) | |
325 | (error "No template table found for mode %s" major-mode)) | |
326 | (let ((temp (srecode-template-get-table (srecode-table) template-name))) | |
327 | (if (not temp) | |
328 | (error "No Template named %s" template-name)) | |
329 | ;; We need a template specific table, since tables chain. | |
330 | (let ((tab (oref temp :table)) | |
331 | (names nil) | |
332 | ) | |
333 | (find-file (oref tab :file)) | |
334 | (setq names (semantic-find-tags-by-name (oref temp :object-name) | |
335 | (current-buffer))) | |
336 | (cond ((= (length names) 1) | |
337 | (semantic-go-to-tag (car names)) | |
338 | (semantic-momentary-highlight-tag (car names))) | |
339 | ((> (length names) 1) | |
340 | (let* ((ctxt (semantic-find-tags-by-name (oref temp :context) | |
341 | (current-buffer))) | |
342 | (cls (semantic-find-tags-by-class 'context ctxt)) | |
343 | ) | |
344 | (while (and names | |
345 | (< (semantic-tag-start (car names)) | |
346 | (semantic-tag-start (car cls)))) | |
347 | (setq names (cdr names))) | |
348 | (if names | |
349 | (progn | |
350 | (semantic-go-to-tag (car names)) | |
351 | (semantic-momentary-highlight-tag (car names))) | |
352 | (error "Can't find template %s" template-name)) | |
353 | )) | |
354 | (t (error "Can't find template %s" template-name))) | |
355 | ))) | |
356 | ||
357 | (defun srecode-add-code-generator (function name &optional binding) | |
358 | "Add the srecoder code generator FUNCTION with NAME to the menu. | |
359 | Optional BINDING specifies the keybinding to use in the srecoder map. | |
360 | BINDING should be a capital letter. Lower case letters are reserved | |
361 | for individual templates. | |
362 | Optional MODE specifies a major mode this function applies to. | |
363 | Do not specify a mode if this function could be applied to most | |
364 | programming modes." | |
365 | ;; Update the menu generating part. | |
366 | (let ((remloop nil)) | |
367 | (while (setq remloop (assoc function srecode-minor-mode-generators)) | |
368 | (setq srecode-minor-mode-generators | |
369 | (remove remloop srecode-minor-mode-generators)))) | |
370 | ||
371 | (add-to-list 'srecode-minor-mode-generators | |
372 | (cons function name)) | |
373 | ||
374 | ;; Remove this function from any old bindings. | |
375 | (when binding | |
376 | (let ((oldkey (where-is-internal function | |
377 | (list srecode-prefix-map) | |
378 | t t t))) | |
379 | (if (or (not oldkey) | |
380 | (and (= (length oldkey) 1) | |
381 | (= (length binding) 1) | |
382 | (= (aref oldkey 0) (aref binding 0)))) | |
383 | ;; Its the same. | |
384 | nil | |
385 | ;; Remove the old binding | |
386 | (define-key srecode-prefix-map oldkey nil) | |
387 | ))) | |
388 | ||
389 | ;; Update Keybings | |
390 | (let ((oldbinding (lookup-key srecode-prefix-map binding))) | |
391 | ||
392 | ;; During development, allow overrides. | |
393 | (when (and oldbinding | |
394 | (not (eq oldbinding function)) | |
395 | (or (eq this-command 'eval-defun) (eq this-command 'checkdoc-eval-defun)) | |
396 | (y-or-n-p (format "Override old binding %s? " oldbinding))) | |
397 | (setq oldbinding nil)) | |
398 | ||
399 | (if (not oldbinding) | |
400 | (define-key srecode-prefix-map binding function) | |
401 | (if (eq function oldbinding) | |
402 | nil | |
403 | ;; Not the same. | |
404 | (message "Conflict binding %S binding to srecode map." | |
405 | binding)))) | |
406 | ) | |
407 | ||
408 | ;; Add default code generators: | |
409 | (srecode-add-code-generator 'srecode-document-insert-comment "Comments" "C") | |
410 | (srecode-add-code-generator 'srecode-insert-getset "Get/Set" "G") | |
411 | ||
412 | (provide 'srecode/mode) | |
413 | ||
414 | ;; Local variables: | |
415 | ;; generated-autoload-file: "loaddefs.el" | |
416 | ;; generated-autoload-feature: srecode/loaddefs | |
417 | ;; generated-autoload-load-name: "srecode/mode" | |
418 | ;; End: | |
419 | ||
420 | ;;; srecode/mode.el ends here |