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