code.delx.au - gnu-emacs/blob - lisp/cedet/srecode/mode.el

   1 ;;; srecode/mode.el --- Minor mode for managing and using SRecode templates
   2
   3 ;; Copyright (C) 2008-2016 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 'semantic/decorate)
  34 (require 'semantic/wisent)
  35 (require 'semantic/senator)
  36 (require 'semantic/wisent)
  37
  38 (eval-when-compile
  39   (require 'semantic/find))
  40
  41 ;;; Code:
  42
  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)
  67   "Keymap used behind the srecode prefix key in srecode minor mode.")
  68
  69 (defvar srecode-menu-bar
  70   (list
  71    "SRecoder"
  72    (semantic-menu-item
  73     ["Insert Template"
  74      srecode-insert
  75      :active t
  76      :help "Insert a template by name."
  77      ])
  78    (semantic-menu-item
  79     ["Insert Template Again"
  80      srecode-insert-again
  81      :active t
  82      :help "Run the same template as last time again."
  83      ])
  84    (semantic-menu-item
  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    "---"
  94     (semantic-menu-item
  95      ["Customize..."
  96       (customize-group "srecode")
  97       :active t
  98       :help "Customize SRecode options"
  99       ])
 100    (list
 101     "Debugging Tools..."
 102     (semantic-menu-item
 103      ["Dump Template MAP"
 104       srecode-get-maps
 105       :active t
 106       :help "Calculate (if needed) and display the current template file map."
 107       ])
 108     (semantic-menu-item
 109      ["Dump Tables"
 110       srecode-dump-templates
 111       :active t
 112       :help "Dump the current template table."
 113       ])
 114     (semantic-menu-item
 115      ["Dump Dictionary"
 116       srecode-dictionary-dump
 117       :active t
 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."
 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
 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.
 155
 156 \\{srecode-mode-map}"
 157   :keymap srecode-mode-map
 158   ;; If we are turning things on, make sure we have templates for
 159   ;; this mode first.
 160   (if srecode-minor-mode
 161       (if (not (apply
 162                 'append
 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)
 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)
 176
 177 ;;;###autoload
 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)))
 186
 187 ;; Use the semantic minor mode magic stuff.
 188 (semantic-add-minor-mode 'srecode-minor-mode "")
 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
 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)))
 228                    (name (eieio-object-name-string temp)))
 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)))
 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)
 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)))
 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
 381   ;; Update Keybindings
 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"
 408 ;; generated-autoload-load-name: "srecode/mode"
 409 ;; End:
 410
 411 ;;; srecode/mode.el ends here