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