1 ;;; srecode/mode.el --- Minor mode for managing and using SRecode templates
3 ;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
7 ;; This file is part of GNU Emacs.
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.
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.
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/>.
24 ;; Minor mode for working with SRecode template files.
26 ;; Depends on Semantic for minor-mode convenience functions.
30 (require 'srecode
/insert
)
31 (require 'srecode
/find
)
32 (require 'srecode
/map
)
33 (require 'semantic
/decorate
)
34 (require 'semantic
/wisent
)
35 (require 'semantic
/senator
)
36 (require 'semantic
/wisent
)
39 (require 'semantic
/find
))
43 (defcustom srecode-minor-mode-hook nil
44 "Hook run at the end of the function `srecode-minor-mode'."
48 ;; We don't want to waste space. There is a menu after all.
49 ;;(add-to-list 'minor-mode-alist '(srecode-minor-mode ""))
51 (defvar srecode-prefix-key
[(control ?c
) ?
/]
52 "The common prefix key in srecode minor mode.")
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
64 (define-key km (format "%c" k) 'srecode-bind-insert)
67 "Keymap used behind the srecode prefix key in srecode minor mode.")
69 (defvar srecode-menu-bar
76 :help "Insert a template by name."
79 ["Insert Template Again"
82 :help "Run the same template as last time again."
88 :help "Edit a template for this language by name."
91 '( "Insert ..." :filter srecode-minor-mode-templates-menu )
92 `( "Generate ..." :filter srecode-minor-mode-generate-menu )
96 (customize-group "srecode")
98 :help "Customize SRecode options"
106 :help "Calculate (if needed) and display the current template file map."
110 srecode-dump-templates
112 :help "Dump the current template table."
116 srecode-dictionary-dump
118 :help "Calculate and dump a dictionary for point."
124 :help "Display the different types of macros available."
128 "Menu for srecode minor mode.")
130 (defvar srecode-minor-menu nil
131 "Menu keymap build from `srecode-menu-bar'.")
133 (defcustom srecode-takeover-INS-key nil
134 "Use the insert key for inserting templates."
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"
143 (when srecode-takeover-INS-key
144 (define-key km [insert] srecode-prefix-map
))
146 "Keymap for srecode minor mode.")
149 (define-minor-mode srecode-minor-mode
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.
156 \\{srecode-mode-map}"
157 :keymap srecode-mode-map
158 ;; If we are turning things on, make sure we have templates for
160 (if srecode-minor-mode
163 (mapcar (lambda (map)
164 (srecode-map-entries-for-mode map major-mode
))
165 (srecode-get-maps))))
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
)
170 (remove-hook 'cedet-m3-menu-do-hooks
'srecode-m3-items t
)
172 ;; Run hooks if we are turning this on.
173 (when srecode-minor-mode
174 (run-hooks 'srecode-minor-mode-hook
))
178 (define-minor-mode global-srecode-minor-mode
179 "Toggle global use of srecode minor mode.
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)))
187 ;; Use the semantic minor mode magic stuff.
188 (semantic-add-minor-mode 'srecode-minor-mode
"")
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)
198 (let* ((modetable (srecode-get-mode-table major-mode
))
199 (subtab (when modetable
(oref modetable
:tables
)))
207 ;; No tables, show a "load the tables" option.
208 (list (vector "Load Mode Tables..."
211 (srecode-load-tables-for-mode major-mode
))
214 (setq context
(car-safe (srecode-calculate-context)))
217 (when (srecode-template-table-in-project-p (car subtab
))
218 (setq ltab
(oref (car subtab
) templates
))
220 (setq temp
(car ltab
))
222 ;; Do something with this template.
224 (let* ((ctxt (oref temp context
))
225 (ctxtcons (assoc ctxt alltabs
))
226 (bind (if (slot-boundp temp
'binding
)
227 (oref temp binding
)))
228 (name (eieio-object-name-string temp
)))
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
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
))))
243 (concat name
" (" bind
")")
245 `(lambda () (interactive)
246 (srecode-insert (concat ,ctxt
":" ,name
)))
249 (setcdr ctxtcons
(cons
253 (setq ltab
(cdr ltab
))))
254 (setq subtab
(cdr subtab
)))
256 ;; Now create the menu
257 (easy-menu-filter-return
258 (easy-menu-create-menu
259 "Semantic Recoder Filters"
265 (defvar srecode-minor-mode-generators nil
266 "List of code generators to be displayed in the srecoder menu.")
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
))
275 (dolist (gen srecode-minor-mode-generators
)
276 (setq allgeneratorapps
277 (cons (vector (cdr gen
) (car gen
))
279 (message "Adding %S to srecode menu" (car gen
))
282 (easy-menu-filter-return
283 (easy-menu-create-menu
284 "Semantic Recoder Generate Filters"
288 ;;; Minor Mode commands
290 (defun srecode-bind-insert ()
291 "Bound insert for Srecode macros.
292 This command will insert whichever srecode template has a binding
295 (srecode-load-tables-for-mode major-mode
)
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
)))
303 (error "No template bound to %c" k
))
305 (srecode-insert template
)
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
313 (interactive (list (srecode-read-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
)))
320 (error "No Template named %s" template-name
))
321 ;; We need a template specific table, since tables chain.
322 (let ((tab (oref temp
:table
))
325 (find-file (oref tab
:file
))
326 (setq names
(semantic-find-tags-by-name (oref temp
:object-name
)
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
)
334 (cls (semantic-find-tags-by-class 'context ctxt
))
337 (< (semantic-tag-start (car names
))
338 (semantic-tag-start (car cls
))))
339 (setq names
(cdr names
)))
342 (semantic-go-to-tag (car names
))
343 (semantic-momentary-highlight-tag (car names
)))
344 (error "Can't find template %s" template-name
))
346 (t (error "Can't find template %s" template-name
)))
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
357 ;; Update the menu generating part.
359 (while (setq remloop
(assoc function srecode-minor-mode-generators
))
360 (setq srecode-minor-mode-generators
361 (remove remloop srecode-minor-mode-generators
))))
363 (add-to-list 'srecode-minor-mode-generators
364 (cons function name
))
366 ;; Remove this function from any old bindings.
368 (let ((oldkey (where-is-internal function
369 (list srecode-prefix-map
)
372 (and (= (length oldkey
) 1)
373 (= (length binding
) 1)
374 (= (aref oldkey
0) (aref binding
0))))
377 ;; Remove the old binding
378 (define-key srecode-prefix-map oldkey nil
)
381 ;; Update Keybindings
382 (let ((oldbinding (lookup-key srecode-prefix-map binding
)))
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
))
392 (define-key srecode-prefix-map binding function
)
393 (if (eq function oldbinding
)
396 (message "Conflict binding %S binding to srecode map."
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")
404 (provide 'srecode
/mode
)
407 ;; generated-autoload-file: "loaddefs.el"
408 ;; generated-autoload-load-name: "srecode/mode"
411 ;;; srecode/mode.el ends here