lisp/cedet/srecode/mode.el

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