392 lines
12 KiB
EmacsLisp
392 lines
12 KiB
EmacsLisp
;;; srecode/mode.el --- Minor mode for managing and using SRecode templates -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2008-2024 Free Software Foundation, Inc.
|
|
|
|
;; Author: Eric M. Ludlam <zappo@gnu.org>
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
;;
|
|
;; Minor mode for working with SRecode template files.
|
|
;;
|
|
;; Depends on Semantic for minor-mode convenience functions.
|
|
|
|
(require 'mode-local)
|
|
(require 'srecode)
|
|
(require 'srecode/insert)
|
|
(require 'srecode/find)
|
|
(require 'srecode/map)
|
|
(require 'semantic/decorate)
|
|
(require 'semantic/wisent)
|
|
(require 'semantic/senator)
|
|
(require 'semantic/wisent)
|
|
|
|
(eval-when-compile
|
|
(require 'semantic/find))
|
|
|
|
;;; Code:
|
|
|
|
(defcustom srecode-minor-mode-hook nil
|
|
"Hook run at the end of the function `srecode-minor-mode'."
|
|
:group 'srecode
|
|
:type 'hook)
|
|
|
|
;; We don't want to waste space. There is a menu after all.
|
|
;;(add-to-list 'minor-mode-alist '(srecode-minor-mode ""))
|
|
|
|
(defvar srecode-prefix-key [(control ?c) ?/]
|
|
"The common prefix key in srecode minor mode.")
|
|
|
|
(defvar srecode-prefix-map
|
|
(let ((km (make-sparse-keymap)))
|
|
;; Basic template codes
|
|
(define-key km "/" #'srecode-insert)
|
|
(define-key km [insert] #'srecode-insert)
|
|
(define-key km "." #'srecode-insert-again)
|
|
(define-key km "E" #'srecode-edit)
|
|
;; Template indirect binding
|
|
(let ((k ?a))
|
|
(while (<= k ?z)
|
|
(define-key km (format "%c" k) #'srecode-bind-insert)
|
|
(setq k (1+ k))))
|
|
km)
|
|
"Keymap used behind the srecode prefix key in srecode minor mode.")
|
|
|
|
(defvar srecode-menu-bar
|
|
(list
|
|
"SRecoder"
|
|
["Insert Template"
|
|
srecode-insert
|
|
:active t
|
|
:help "Insert a template by name."]
|
|
["Insert Template Again"
|
|
srecode-insert-again
|
|
:active t
|
|
:help "Run the same template as last time again."]
|
|
["Edit Template"
|
|
srecode-edit
|
|
:active t
|
|
:help "Edit a template for this language by name."]
|
|
"---"
|
|
'( "Insert ..." :filter srecode-minor-mode-templates-menu )
|
|
'( "Generate ..." :filter srecode-minor-mode-generate-menu )
|
|
"---"
|
|
["Customize..."
|
|
(customize-group "srecode")
|
|
:active t
|
|
:help "Customize SRecode options"]
|
|
(list
|
|
"Debugging Tools..."
|
|
["Dump Template MAP"
|
|
srecode-get-maps
|
|
:active t
|
|
:help "Calculate (if needed) and display the current template file map."]
|
|
["Dump Tables"
|
|
srecode-dump-templates
|
|
:active t
|
|
:help "Dump the current template table."]
|
|
["Dump Dictionary"
|
|
srecode-dictionary-dump
|
|
:active t
|
|
:help "Calculate and dump a dictionary for point."]
|
|
["Show Macro Help"
|
|
srecode-macro-help
|
|
:active t
|
|
:help "Display the different types of macros available."]))
|
|
"Menu for srecode minor mode.")
|
|
|
|
(defvar srecode-minor-menu nil
|
|
"Menu keymap build from `srecode-menu-bar'.")
|
|
|
|
(defcustom srecode-takeover-INS-key nil
|
|
"Use the insert key for inserting templates."
|
|
:group 'srecode
|
|
:type 'boolean)
|
|
|
|
(defvar srecode-mode-map
|
|
(let ((km (make-sparse-keymap)))
|
|
(define-key km srecode-prefix-key srecode-prefix-map)
|
|
(easy-menu-define srecode-minor-menu km "Srecode Minor Mode Menu"
|
|
srecode-menu-bar)
|
|
(when srecode-takeover-INS-key
|
|
(define-key km [insert] srecode-prefix-map))
|
|
km)
|
|
"Keymap for srecode minor mode.")
|
|
|
|
;;;###autoload
|
|
(define-minor-mode srecode-minor-mode
|
|
"Toggle srecode minor mode.
|
|
|
|
The minor mode can be turned on only if semantic feature is
|
|
available and the current buffer was set up for parsing. Return
|
|
non-nil if the minor mode is enabled.
|
|
|
|
\\{srecode-mode-map}"
|
|
:keymap srecode-mode-map
|
|
;; If we are turning things on, make sure we have templates for
|
|
;; this mode first.
|
|
(if srecode-minor-mode
|
|
(if (not (apply
|
|
#'append
|
|
(mapcar (lambda (map)
|
|
(srecode-map-entries-for-mode map major-mode))
|
|
(srecode-get-maps))))
|
|
(setq srecode-minor-mode nil)
|
|
;; Else, we have success, do stuff
|
|
;; FIXME: Where are `cedet-m3-menu-do-hooks' nor `srecode-m3-items'?
|
|
(when (fboundp 'srecode-m3-items)
|
|
(add-hook 'cedet-m3-menu-do-hooks #'srecode-m3-items nil t)))
|
|
(when (fboundp 'srecode-m3-items)
|
|
(remove-hook 'cedet-m3-menu-do-hooks #'srecode-m3-items t)))
|
|
;; Run hooks if we are turning this on.
|
|
(when srecode-minor-mode
|
|
(run-hooks 'srecode-minor-mode-hook))
|
|
srecode-minor-mode)
|
|
|
|
;;;###autoload
|
|
(define-minor-mode global-srecode-minor-mode
|
|
"Toggle global use of srecode minor mode."
|
|
:global t :group 'srecode
|
|
;; Not needed because it's autoloaded instead.
|
|
;; :require 'srecode/mode
|
|
(semantic-toggle-minor-mode-globally
|
|
'srecode-minor-mode (if global-srecode-minor-mode 1 -1)))
|
|
|
|
;; Use the semantic minor mode magic stuff.
|
|
(semantic-add-minor-mode 'srecode-minor-mode "")
|
|
|
|
;;; Menu Filters
|
|
;;
|
|
(defun srecode-minor-mode-templates-menu (_menu-def)
|
|
"Create a menu item of cascading filters active for this mode.
|
|
MENU-DEF is the menu to bind this into."
|
|
;; Doing this SEGVs Emacs on windows.
|
|
;;(srecode-load-tables-for-mode major-mode)
|
|
|
|
(let* ((modetable (srecode-get-mode-table major-mode))
|
|
(subtab (when modetable (oref modetable tables)))
|
|
(context nil)
|
|
(active nil)
|
|
(ltab nil)
|
|
(temp nil)
|
|
(alltabs nil)
|
|
)
|
|
(if (not subtab)
|
|
;; No tables, show a "load the tables" option.
|
|
(list (vector "Load Mode Tables..."
|
|
(lambda ()
|
|
(interactive)
|
|
(srecode-load-tables-for-mode major-mode))
|
|
))
|
|
;; Build something
|
|
(setq context (car-safe (srecode-calculate-context)))
|
|
|
|
(while subtab
|
|
(when (srecode-template-table-in-project-p (car subtab))
|
|
(setq ltab (oref (car subtab) templates))
|
|
(while ltab
|
|
(setq temp (car ltab))
|
|
|
|
;; Do something with this template.
|
|
|
|
(let* ((ctxt (oref temp context))
|
|
(ctxtcons (assoc ctxt alltabs))
|
|
(bind (if (slot-boundp temp 'binding)
|
|
(oref temp binding)))
|
|
(name (eieio-object-name-string temp)))
|
|
|
|
(when (not ctxtcons)
|
|
(if (string= context ctxt)
|
|
;; If this context is not in the current list of contexts
|
|
;; is equal to the current context, then manage the
|
|
;; active list instead
|
|
(setq active
|
|
(setq ctxtcons (or active (cons ctxt nil))))
|
|
;; This is not an active context, add it to alltabs.
|
|
(setq ctxtcons (cons ctxt nil))
|
|
(setq alltabs (cons ctxtcons alltabs))))
|
|
|
|
(let ((new (vector
|
|
(if bind
|
|
(concat name " (" bind ")")
|
|
name)
|
|
(lambda () (interactive)
|
|
(srecode-insert (concat ctxt ":" name)))
|
|
t)))
|
|
|
|
(push new (cdr ctxtcons))))
|
|
|
|
(setq ltab (cdr ltab))))
|
|
(setq subtab (cdr subtab)))
|
|
|
|
;; Now create the menu
|
|
(easy-menu-filter-return
|
|
(easy-menu-create-menu
|
|
"Semantic Recoder Filters"
|
|
(append (cdr active)
|
|
alltabs)
|
|
))
|
|
)))
|
|
|
|
(defvar srecode-minor-mode-generators nil
|
|
"List of code generators to be displayed in the srecoder menu.")
|
|
|
|
(defun srecode-minor-mode-generate-menu (_menu-def)
|
|
"Create a menu item of cascading filters active for this mode.
|
|
MENU-DEF is the menu to bind this into."
|
|
;; Doing this SEGVs Emacs on windows.
|
|
;;(srecode-load-tables-for-mode major-mode)
|
|
(let ((allgeneratorapps nil))
|
|
|
|
(dolist (gen srecode-minor-mode-generators)
|
|
(setq allgeneratorapps
|
|
(cons (vector (cdr gen) (car gen))
|
|
allgeneratorapps))
|
|
(message "Adding %S to srecode menu" (car gen))
|
|
)
|
|
|
|
(easy-menu-filter-return
|
|
(easy-menu-create-menu
|
|
"Semantic Recoder Generate Filters"
|
|
allgeneratorapps)))
|
|
)
|
|
|
|
;;; Minor Mode commands
|
|
;;
|
|
(defun srecode-bind-insert ()
|
|
"Bound insert for Srecode macros.
|
|
This command will insert whichever srecode template has a binding
|
|
to the current key."
|
|
(interactive)
|
|
(srecode-load-tables-for-mode major-mode)
|
|
(let* ((k last-command-event)
|
|
(ctxt (srecode-calculate-context))
|
|
;; Find the template with the binding K
|
|
(template (srecode-template-get-table-for-binding
|
|
(srecode-table) k ctxt)))
|
|
;; test it.
|
|
(when (not template)
|
|
(error "No template bound to %c" k))
|
|
;; insert
|
|
(srecode-insert template)
|
|
))
|
|
|
|
(defun srecode-edit (template-name)
|
|
"Switch to the template buffer for TEMPLATE-NAME.
|
|
Template is chosen based on the mode of the starting buffer."
|
|
;; @todo - Get a template stack from the last run template, and show
|
|
;; those too!
|
|
(interactive (list (srecode-read-template-name
|
|
"Template Name: "
|
|
(car srecode-read-template-name-history))))
|
|
(if (not (srecode-table))
|
|
(error "No template table found for mode %s" major-mode))
|
|
(let ((temp (srecode-template-get-table (srecode-table) template-name)))
|
|
(if (not temp)
|
|
(error "No Template named %s" template-name))
|
|
;; We need a template specific table, since tables chain.
|
|
(let ((tab (oref temp table))
|
|
(names nil)
|
|
)
|
|
(find-file (oref tab file))
|
|
(setq names (semantic-find-tags-by-name (oref temp object-name)
|
|
(current-buffer)))
|
|
(cond ((= (length names) 1)
|
|
(semantic-go-to-tag (car names))
|
|
(semantic-momentary-highlight-tag (car names)))
|
|
((> (length names) 1)
|
|
(let* ((ctxt (semantic-find-tags-by-name (oref temp context)
|
|
(current-buffer)))
|
|
(cls (semantic-find-tags-by-class 'context ctxt))
|
|
)
|
|
(while (and names
|
|
(< (semantic-tag-start (car names))
|
|
(semantic-tag-start (car cls))))
|
|
(setq names (cdr names)))
|
|
(if names
|
|
(progn
|
|
(semantic-go-to-tag (car names))
|
|
(semantic-momentary-highlight-tag (car names)))
|
|
(error "Can't find template %s" template-name))
|
|
))
|
|
(t (error "Can't find template %s" template-name)))
|
|
)))
|
|
|
|
(defun srecode-add-code-generator (function name &optional binding)
|
|
"Add the srecoder code generator FUNCTION with NAME to the menu.
|
|
Optional BINDING specifies the keybinding to use in the srecoder map.
|
|
BINDING should be a capital letter. Lower case letters are reserved
|
|
for individual templates.
|
|
Optional MODE specifies a major mode this function applies to.
|
|
Do not specify a mode if this function could be applied to most
|
|
programming modes."
|
|
;; Update the menu generating part.
|
|
(let ((remloop nil))
|
|
(while (setq remloop (assoc function srecode-minor-mode-generators))
|
|
(setq srecode-minor-mode-generators
|
|
(remove remloop srecode-minor-mode-generators))))
|
|
|
|
(add-to-list 'srecode-minor-mode-generators
|
|
(cons function name))
|
|
|
|
;; Remove this function from any old bindings.
|
|
(when binding
|
|
(let ((oldkey (where-is-internal function
|
|
(list srecode-prefix-map)
|
|
t t t)))
|
|
(if (or (not oldkey)
|
|
(and (= (length oldkey) 1)
|
|
(= (length binding) 1)
|
|
(= (aref oldkey 0) (aref binding 0))))
|
|
;; Its the same.
|
|
nil
|
|
;; Remove the old binding
|
|
(define-key srecode-prefix-map oldkey nil)
|
|
)))
|
|
|
|
;; Update Keybindings
|
|
(let ((oldbinding (lookup-key srecode-prefix-map binding)))
|
|
|
|
;; During development, allow overrides.
|
|
(when (and oldbinding
|
|
(not (eq oldbinding function))
|
|
(or (eq this-command 'eval-defun) (eq this-command 'checkdoc-eval-defun))
|
|
(y-or-n-p (format "Override old binding %s? " oldbinding)))
|
|
(setq oldbinding nil))
|
|
|
|
(if (not oldbinding)
|
|
(define-key srecode-prefix-map binding function)
|
|
(if (eq function oldbinding)
|
|
nil
|
|
;; Not the same.
|
|
(message "Conflict binding %S binding to srecode map."
|
|
binding))))
|
|
)
|
|
|
|
;; Add default code generators:
|
|
(srecode-add-code-generator 'srecode-document-insert-comment "Comments" "C")
|
|
(srecode-add-code-generator 'srecode-insert-getset "Get/Set" "G")
|
|
|
|
(provide 'srecode/mode)
|
|
|
|
;; Local variables:
|
|
;; generated-autoload-file: "loaddefs.el"
|
|
;; generated-autoload-load-name: "srecode/mode"
|
|
;; End:
|
|
|
|
;;; srecode/mode.el ends here
|