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