lisp/cedet/srecode/mode.el

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