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