lisp/cedet/srecode/srt-mode.el

   1 ;;; srecode/srt-mode.el --- Major mode for writing screcode macros
   2
   3 ;; Copyright (C) 2005, 2007-2011 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; GNU Emacs is free software: you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; GNU Emacs is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Commentary:
  21
  22 ;; Originally named srecode-template-mode.el in the CEDET repository.
  23
  24 (require 'srecode/compile)
  25 (require 'srecode/ctxt)
  26 (require 'srecode/template)
  27
  28 (require 'semantic)
  29 (require 'semantic/analyze)
  30 (require 'semantic/wisent)
  31 (eval-when-compile
  32   (require 'semantic/find))
  33
  34 (declare-function srecode-create-dictionary "srecode/dictionary")
  35 (declare-function srecode-resolve-argument-list "srecode/insert")
  36
  37 ;;; Code:
  38 (defvar srecode-template-mode-syntax-table
  39   (let ((table (make-syntax-table (standard-syntax-table))))
  40     (modify-syntax-entry ?\; ". 12"  table) ;; SEMI, Comment start ;;
  41     (modify-syntax-entry ?\n ">"     table) ;; Comment end
  42     (modify-syntax-entry ?$  "."     table) ;; Punctuation
  43     (modify-syntax-entry ?:  "."     table) ;; Punctuation
  44     (modify-syntax-entry ?<  "."     table) ;; Punctuation
  45     (modify-syntax-entry ?>  "."     table) ;; Punctuation
  46     (modify-syntax-entry ?#  "."     table) ;; Punctuation
  47     (modify-syntax-entry ?!  "."     table) ;; Punctuation
  48     (modify-syntax-entry ??  "."     table) ;; Punctuation
  49     (modify-syntax-entry ?\" "\""    table) ;; String
  50     (modify-syntax-entry ?\- "_"     table) ;; Symbol
  51     (modify-syntax-entry ?\\ "\\"    table) ;; Quote
  52     (modify-syntax-entry ?\` "'"     table) ;; Prefix ` (backquote)
  53     (modify-syntax-entry ?\' "'"     table) ;; Prefix ' (quote)
  54     (modify-syntax-entry ?\, "'"     table) ;; Prefix , (comma)
  55
  56     table)
  57   "Syntax table used in semantic recoder macro buffers.")
  58
  59 (defface srecode-separator-face
  60   '((t (:weight bold :strike-through t)))
  61   "Face used for decorating separators in srecode template mode."
  62   :group 'srecode)
  63
  64 (defvar srecode-font-lock-keywords
  65   '(
  66     ;; Template
  67     ("^\\(template\\)\\s-+\\(\\w*\\)\\(\\( \\(:\\w+\\)\\|\\)+\\)$"
  68      (1 font-lock-keyword-face)
  69      (2 font-lock-function-name-face)
  70      (3 font-lock-builtin-face ))
  71     ("^\\(sectiondictionary\\)\\s-+\""
  72      (1 font-lock-keyword-face))
  73     ("^\\(bind\\)\\s-+\""
  74      (1 font-lock-keyword-face))
  75     ;; Variable type setting
  76     ("^\\(set\\)\\s-+\\(\\w+\\)\\s-+"
  77      (1 font-lock-keyword-face)
  78      (2 font-lock-variable-name-face))
  79     ("^\\(show\\)\\s-+\\(\\w+\\)\\s-*$"
  80      (1 font-lock-keyword-face)
  81      (2 font-lock-variable-name-face))
  82     ("\\<\\(macro\\)\\s-+\""
  83      (1 font-lock-keyword-face))
  84     ;; Context type setting
  85     ("^\\(context\\)\\s-+\\(\\w+\\)"
  86      (1 font-lock-keyword-face)
  87      (2 font-lock-builtin-face))
  88     ;; Prompting setting
  89     ("^\\(prompt\\)\\s-+\\(\\w+\\)"
  90      (1 font-lock-keyword-face)
  91      (2 font-lock-variable-name-face))
  92     ("\\(default\\(macro\\)?\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
  93      (1 font-lock-keyword-face)
  94      (3 font-lock-type-face))
  95     ("\\<\\(default\\(macro\\)?\\)\\>" (1 font-lock-keyword-face))
  96     ("\\<\\(read\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
  97      (1 font-lock-keyword-face)
  98      (2 font-lock-type-face))
  99
 100     ;; Macro separators
 101     ("^----\n" 0 'srecode-separator-face)
 102
 103     ;; Macro Matching
 104     (srecode-template-mode-macro-escape-match 1 font-lock-string-face)
 105     ((lambda (limit)
 106        (srecode-template-mode-font-lock-macro-helper
 107         limit "\\(\\??\\w+\\)[^ \t\n{}$#@&*()]*"))
 108      1 font-lock-variable-name-face)
 109     ((lambda (limit)
 110        (srecode-template-mode-font-lock-macro-helper
 111         limit "\\([#/]\\w+\\)[^ \t\n{}$#@&*()]*"))
 112      1 font-lock-keyword-face)
 113     ((lambda (limit)
 114        (srecode-template-mode-font-lock-macro-helper
 115         limit "\\([<>]\\w*\\):\\(\\w+\\):\\(\\w+\\)"))
 116      (1 font-lock-keyword-face)
 117      (2 font-lock-builtin-face)
 118      (3 font-lock-type-face))
 119     ((lambda (limit)
 120        (srecode-template-mode-font-lock-macro-helper
 121         limit "\\([<>?]?\\w*\\):\\(\\w+\\)"))
 122      (1 font-lock-keyword-face)
 123      (2 font-lock-type-face))
 124     ((lambda (limit)
 125        (srecode-template-mode-font-lock-macro-helper
 126         limit "!\\([^{}$]*\\)"))
 127      1 font-lock-comment-face)
 128
 129     )
 130   "Keywords for use with srecode macros and font-lock.")
 131
 132 (defun srecode-template-mode-font-lock-macro-helper (limit expression)
 133   "Match against escape characters.
 134 Don't scan past LIMIT.  Match with EXPRESSION."
 135   (let* ((done nil)
 136          (md nil)
 137          (es (regexp-quote (srecode-template-get-escape-start)))
 138          (ee (regexp-quote (srecode-template-get-escape-end)))
 139          (regex (concat es expression ee))
 140          )
 141     (while (not done)
 142       (save-match-data
 143         (if (re-search-forward regex limit t)
 144             (when (equal (car (srecode-calculate-context)) "code")
 145               (setq md (match-data)
 146                     done t))
 147           (setq done t))))
 148     (set-match-data md)
 149     ;; (when md (message "Found a match!"))
 150     (when md t)))
 151
 152 (defun srecode-template-mode-macro-escape-match (limit)
 153   "Match against escape characters.
 154 Don't scan past LIMIT."
 155   (let* ((done nil)
 156          (md nil)
 157          (es (regexp-quote (srecode-template-get-escape-start)))
 158          (ee (regexp-quote (srecode-template-get-escape-end)))
 159          (regex (concat "\\(" es "\\|" ee "\\)"))
 160          )
 161     (while (not done)
 162       (save-match-data
 163         (if (re-search-forward regex limit t)
 164             (when (equal (car (srecode-calculate-context)) "code")
 165               (setq md (match-data)
 166                     done t))
 167           (setq done t))))
 168     (set-match-data md)
 169     ;;(when md (message "Found a match!"))
 170     (when md t)))
 171
 172 (defvar srecode-font-lock-macro-keywords nil
 173   "Dynamically generated `font-lock' keywords for srecode templates.
 174 Once the escape_start, and escape_end sequences are known, then
 175 we can tell font lock about them.")
 176
 177 (defvar srecode-template-mode-map
 178   (let ((km (make-sparse-keymap)))
 179     (define-key km "\C-c\C-c" 'srecode-compile-templates)
 180     (define-key km "\C-c\C-m" 'srecode-macro-help)
 181     (define-key km "/" 'srecode-self-insert-complete-end-macro)
 182     km)
 183   "Keymap used in srecode mode.")
 184
 185 ;;;###autoload
 186 (define-derived-mode srecode-template-mode fundamental-mode "SRecorder"
 187   "Major-mode for writing SRecode macros."
 188   (setq comment-start ";;"
 189         comment-end "")
 190   (set (make-local-variable 'parse-sexp-ignore-comments) t)
 191   (set (make-local-variable 'comment-start-skip)
 192        "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
 193   (set (make-local-variable 'font-lock-defaults)
 194        '(srecode-font-lock-keywords
 195          nil  ;; perform string/comment fontification
 196          nil  ;; keywords are case sensitive.
 197          ;; This puts _ & - as a word constituant,
 198          ;; simplifying our keywords significantly
 199          ((?_ . "w") (?- . "w")))))
 200
 201 ;;;###autoload
 202 (defalias 'srt-mode 'srecode-template-mode)
 203
 204 ;;; Template Commands
 205 ;;
 206 (defun srecode-self-insert-complete-end-macro ()
 207   "Self insert the current key, then autocomplete the end macro."
 208   (interactive)
 209   (call-interactively 'self-insert-command)
 210   (when (and (semantic-current-tag)
 211              (semantic-tag-of-class-p (semantic-current-tag) 'function)
 212              )
 213     (let* ((es (srecode-template-get-escape-start))
 214            (ee (srecode-template-get-escape-end))
 215            (name (save-excursion
 216                    (forward-char (- (length es)))
 217                    (forward-char -1)
 218                    (if (looking-at (regexp-quote es))
 219                        (srecode-up-context-get-name (point) t))))
 220            )
 221       (when name
 222         (insert name)
 223         (insert ee))))
 224   )
 225
 226
 227 (defun srecode-macro-help ()
 228   "Provide help for working with macros in a template."
 229   (interactive)
 230   (let* ((root 'srecode-template-inserter)
 231          (chl (aref (class-v root) class-children))
 232          (ess (srecode-template-get-escape-start))
 233          (ees (srecode-template-get-escape-end))
 234          )
 235     (with-output-to-temp-buffer "*SRecode Macros*"
 236       (princ "Description of known SRecode Template Macros.")
 237       (terpri)
 238       (terpri)
 239       (while chl
 240         (let* ((C (car chl))
 241                (name (symbol-name C))
 242                (key (when (slot-exists-p C 'key)
 243                       (oref C key)))
 244                (showexample t)
 245                )
 246           (setq chl (cdr chl))
 247           (setq chl (append (aref (class-v C) class-children) chl))
 248
 249           (catch 'skip
 250             (when (eq C 'srecode-template-inserter-section-end)
 251               (throw 'skip nil))
 252
 253             (when (class-abstract-p C)
 254               (throw 'skip nil))
 255
 256             (princ "`")
 257             (princ name)
 258             (princ "'")
 259             (when (slot-exists-p C 'key)
 260               (when key
 261                 (princ " - Character Key: ")
 262                 (if (stringp key)
 263                     (progn
 264                       (setq showexample nil)
 265                       (cond ((string= key "\n")
 266                              (princ "\"\\n\"")
 267                              )
 268                             (t
 269                              (prin1 key)
 270                              )))
 271                   (prin1 (format "%c" key))
 272                   )))
 273             (terpri)
 274             (princ (documentation-property C 'variable-documentation))
 275             (terpri)
 276             (when showexample
 277               (princ "Example:")
 278               (terpri)
 279               (srecode-inserter-prin-example C ess ees)
 280               )
 281
 282             (terpri)
 283
 284             ) ;; catch
 285           );; let*
 286         ))))
 287
 288 \f
 289 ;;; Misc Language Overrides
 290 ;;
 291 (define-mode-local-override semantic-ia-insert-tag
 292   srecode-template-mode (tag)
 293   "Insert the SRecode TAG into the current buffer."
 294   (insert (semantic-tag-name tag)))
 295
 296 \f
 297 ;;; Local Context Parsing.
 298
 299 (defun srecode-in-macro-p (&optional point)
 300   "Non-nil if POINT is inside a macro bounds.
 301 If the ESCAPE_START and END are different sequences,
 302 a simple search is used.  If ESCAPE_START and END are the same
 303 characters, start at the beginning of the line, and find out
 304 how many occur."
 305   (let ((tag (semantic-current-tag))
 306         (es (regexp-quote (srecode-template-get-escape-start)))
 307         (ee (regexp-quote (srecode-template-get-escape-end)))
 308         (start (or point (point)))
 309         )
 310     (when (and tag (semantic-tag-of-class-p tag 'function))
 311       (if (string= es ee)
 312           (save-excursion
 313             (beginning-of-line)
 314             (while (re-search-forward es start t 2))
 315             (if (re-search-forward es start t)
 316                 ;; If there is a single, the answer is yes.
 317                 t
 318               ;; If there wasn't another, then the answer is no.
 319               nil)
 320             )
 321         ;; ES And EE are not the same.
 322         (save-excursion
 323           (and (re-search-backward es (semantic-tag-start tag) t)
 324                (>= (or (re-search-forward ee (semantic-tag-end tag) t)
 325                        ;; No end match means an incomplete macro.
 326                        start)
 327                   start)))
 328         ))))
 329
 330 (defun srecode-up-context-get-name (&optional point find-unmatched)
 331   "Move up one context as for `semantic-up-context', and return the name.
 332 Moves point to the opening characters of the section macro text.
 333 If there is no upper context, return nil.
 334 Starts at POINT if provided.
 335 If FIND-UNMATCHED is specified as non-nil, then we are looking for an unmatched
 336 section."
 337   (when point (goto-char (point)))
 338   (let* ((tag (semantic-current-tag))
 339          (es (regexp-quote (srecode-template-get-escape-start)))
 340          (start (concat es "[#<]\\(\\w+\\)"))
 341          (orig (point))
 342          (name nil)
 343          (res nil))
 344     (when (semantic-tag-of-class-p tag 'function)
 345       (while (and (not res)
 346                   (re-search-backward start (semantic-tag-start tag) t))
 347         (when (save-excursion
 348                 (setq name (match-string 1))
 349                 (let ((endr (concat es "/" name)))
 350                   (if (re-search-forward endr (semantic-tag-end tag) t)
 351                       (< orig (point))
 352                     (if (not find-unmatched)
 353                         (error "Unmatched Section Template")
 354                       ;; We found what we want.
 355                       t))))
 356           (setq res (point)))
 357         )
 358       ;; Restore in no result found.
 359       (goto-char (or res orig))
 360       name)))
 361
 362 (define-mode-local-override semantic-up-context
 363   srecode-template-mode (&optional point)
 364   "Move up one context in the current code.
 365 Moves out one named section."
 366   (not (srecode-up-context-get-name point)))
 367
 368 (define-mode-local-override semantic-beginning-of-context
 369   srecode-template-mode (&optional point)
 370   "Move to the beginning of the current context.
 371 Moves to the beginning of one named section."
 372   (if (semantic-up-context point)
 373       t
 374     (let ((es (regexp-quote (srecode-template-get-escape-start)))
 375           (ee (regexp-quote (srecode-template-get-escape-end))))
 376       (re-search-forward es) ;; move over the start chars.
 377       (re-search-forward ee) ;; Move after the end chars.
 378       nil)))
 379
 380 (define-mode-local-override semantic-end-of-context
 381   srecode-template-mode (&optional point)
 382   "Move to the end of the current context.
 383 Moves to the end of one named section."
 384   (let ((name (srecode-up-context-get-name point))
 385         (tag (semantic-current-tag))
 386         (es  (regexp-quote (srecode-template-get-escape-start))))
 387   (if (not name)
 388       t
 389     (unless (re-search-forward (concat es "/" name) (semantic-tag-end tag) t)
 390       (error "Section %s has no end" name))
 391     (goto-char (match-beginning 0))
 392     nil)))
 393
 394 (define-mode-local-override semantic-get-local-variables
 395   srecode-template-mode (&optional point)
 396   "Get local variables from an SRecode template."
 397   (save-excursion
 398     (when point (goto-char (point)))
 399     (let* ((tag (semantic-current-tag))
 400            (name (save-excursion
 401                    (srecode-up-context-get-name (point))))
 402            (subdicts (semantic-tag-get-attribute tag :dictionaries))
 403            (global nil)
 404            )
 405       (dolist (D subdicts)
 406         (setq global (cons (semantic-tag-new-variable (car D) nil)
 407                            global)))
 408       (if name
 409           ;; Lookup any subdictionaries in TAG.
 410           (let ((res nil))
 411
 412             (while (and (not res) subdicts)
 413               ;; Find the subdictionary with the same name.  Those variables
 414               ;; are now local to this section.
 415               (when (string= (car (car subdicts)) name)
 416                 (setq res (cdr (car subdicts))))
 417               (setq subdicts (cdr subdicts)))
 418             ;; Pre-pend our global vars.
 419             (append global res))
 420         ;; If we aren't in a subsection, just do the global variables
 421         global
 422         ))))
 423
 424 (define-mode-local-override semantic-get-local-arguments
 425   srecode-template-mode (&optional point)
 426   "Get local arguments from an SRecode template."
 427   (require 'srecode/insert)
 428   (save-excursion
 429     (when point (goto-char (point)))
 430     (let* ((tag (semantic-current-tag))
 431            (args (semantic-tag-function-arguments tag))
 432            (argsym (mapcar 'intern args))
 433            (argvars nil)
 434            ;; Create a temporary dictionary in which the
 435            ;; arguments can be resolved so we can extract
 436            ;; the results.
 437            (dict (srecode-create-dictionary t))
 438            )
 439       ;; Resolve args into our temp dictionary
 440       (srecode-resolve-argument-list argsym dict)
 441
 442       (maphash
 443        (lambda (key entry)
 444          (setq argvars
 445                (cons (semantic-tag-new-variable key nil entry)
 446                      argvars)))
 447        (oref dict namehash))
 448
 449       argvars)))
 450
 451 (define-mode-local-override semantic-ctxt-current-symbol
 452   srecode-template-mode (&optional point)
 453   "Return the current symbol under POINT.
 454 Return nil if point is not on/in a template macro."
 455   (let ((macro (srecode-parse-this-macro point)))
 456     (cdr macro))
 457   )
 458
 459 (defun srecode-parse-this-macro (&optional point)
 460   "Return the current symbol under POINT.
 461 Return nil if point is not on/in a template macro.
 462 The first element is the key for the current macro, such as # for a
 463 section or ? for an ask variable."
 464   (save-excursion
 465     (if point (goto-char point))
 466     (let ((tag (semantic-current-tag))
 467           (es (regexp-quote (srecode-template-get-escape-start)))
 468           (ee (regexp-quote (srecode-template-get-escape-end)))
 469           (start (point))
 470           (macrostart nil)
 471           (raw nil)
 472           )
 473       (when (and tag (semantic-tag-of-class-p tag 'function)
 474                  (srecode-in-macro-p point)
 475                  (re-search-backward es (semantic-tag-start tag) t))
 476         (setq macrostart (match-end 0))
 477         (goto-char macrostart)
 478         ;; We have a match
 479         (when (not (re-search-forward ee (semantic-tag-end tag) t))
 480           (goto-char start) ;; Pretend we are ok for completion
 481           (set-match-data (list start start))
 482           )
 483
 484         (if (> start (point))
 485             ;; If our starting point is after the found point, that
 486             ;; means we are not inside the macro.  Return nil.
 487             nil
 488           ;; We are inside the macro, extract the text so far.
 489           (let* ((macroend (match-beginning 0))
 490                  (raw (buffer-substring-no-properties
 491                        macrostart macroend))
 492                  (STATE (srecode-compile-state "TMP"))
 493                  (inserter (condition-case nil
 494                                (srecode-compile-parse-inserter
 495                                 raw STATE)
 496                              (error nil)))
 497                  )
 498             (when inserter
 499               (let ((base
 500                      (cons (oref inserter :object-name)
 501                            (if (and (slot-boundp inserter :secondname)
 502                                     (oref inserter :secondname))
 503                                (split-string (oref inserter :secondname)
 504                                              ":")
 505                              nil)))
 506                     (key (oref inserter key)))
 507                 (cond ((null key)
 508                        ;; A plain variable
 509                        (cons nil base))
 510                       (t
 511                        ;; A complex variable thingy.
 512                        (cons (format "%c" key)
 513                              base)))))
 514             )
 515           )))
 516     ))
 517
 518 (define-mode-local-override semantic-analyze-current-context
 519   srecode-template-mode (point)
 520   "Provide a Semantic analysis in SRecode template mode."
 521     (let* ((context-return nil)
 522            (prefixandbounds (semantic-ctxt-current-symbol-and-bounds))
 523            (prefix (car prefixandbounds))
 524            (bounds (nth 2 prefixandbounds))
 525            (key (car (srecode-parse-this-macro (point))))
 526            (prefixsym nil)
 527            (prefix-var nil)
 528            (prefix-context nil)
 529            (prefix-function nil)
 530            (prefixclass (semantic-ctxt-current-class-list))
 531            (globalvar (semantic-find-tags-by-class 'variable (current-buffer)))
 532            (argtype 'macro)
 533            (scope (semantic-calculate-scope point))
 534            )
 535
 536       (oset scope fullscope (append (oref scope localvar) globalvar))
 537
 538       (when prefix
 539         ;; First, try to find the variable for the first
 540         ;; entry in the prefix list.
 541         (setq prefix-var (semantic-find-first-tag-by-name
 542                           (car prefix) (oref scope fullscope)))
 543
 544         (cond
 545          ((and (or (not key) (string= key "?"))
 546                (> (length prefix) 1))
 547           ;; Variables can have lisp function names.
 548           (with-mode-local emacs-lisp-mode
 549             (let ((fcns (semanticdb-find-tags-by-name (car (last prefix)))))
 550               (setq prefix-function (car (semanticdb-find-result-nth fcns 0)))
 551               (setq argtype 'elispfcn)))
 552           )
 553          ((or (string= key "<") (string= key ">"))
 554           ;; Includes have second args that is the template name.
 555           (if (= (length prefix) 3)
 556               (let ((contexts (semantic-find-tags-by-class
 557                                'context (current-buffer))))
 558                 (setq prefix-context
 559                       (or (semantic-find-first-tag-by-name
 560                            (nth 1 prefix) contexts)
 561                           ;; Calculate from location
 562                           (semantic-tag
 563                            (symbol-name
 564                             (srecode-template-current-context))
 565                            'context)))
 566                 (setq argtype 'template))
 567             (setq prefix-context
 568                   ;; Calculate from location
 569                   (semantic-tag
 570                    (symbol-name (srecode-template-current-context))
 571                    'context))
 572             (setq argtype 'template)
 573             )
 574           ;; The last one?
 575           (when (> (length prefix) 1)
 576             (let ((toc (srecode-template-find-templates-of-context
 577                         (read (semantic-tag-name prefix-context))))
 578                   )
 579               (setq prefix-function
 580                     (or (semantic-find-first-tag-by-name
 581                         (car (last prefix)) toc)
 582                         ;; Not in this buffer?  Search the master
 583                         ;; templates list.
 584                         nil))
 585               ))
 586           )
 587          )
 588
 589         (setq prefixsym
 590               (cond ((= (length prefix) 3)
 591                      (list (or prefix-var (nth 0 prefix))
 592                            (or prefix-context (nth 1 prefix))
 593                            (or prefix-function (nth 2 prefix))))
 594                     ((= (length prefix) 2)
 595                      (list (or prefix-var (nth 0 prefix))
 596                            (or prefix-function (nth 1 prefix))))
 597                     ((= (length prefix) 1)
 598                      (list (or prefix-var (nth 0 prefix)))
 599                      )))
 600
 601         (setq context-return
 602               (semantic-analyze-context-functionarg
 603                "context-for-srecode"
 604                :buffer (current-buffer)
 605                :scope scope
 606                :bounds bounds
 607                :prefix (or prefixsym
 608                            prefix)
 609                :prefixtypes nil
 610                :prefixclass prefixclass
 611                :errors nil
 612                ;; Use the functionarg analyzer class so we
 613                ;; can save the current key, and the index
 614                ;; into the macro part we are completing on.
 615                :function (list key)
 616                :index (length prefix)
 617                :argument (list argtype)
 618                ))
 619
 620         context-return)))
 621
 622 (define-mode-local-override semantic-analyze-possible-completions
 623   srecode-template-mode (context)
 624   "Return a list of possible completions based on NONTEXT."
 625   (with-current-buffer (oref context buffer)
 626     (let* ((prefix (car (last (oref context :prefix))))
 627            (prefixstr (cond ((stringp prefix)
 628                              prefix)
 629                             ((semantic-tag-p prefix)
 630                              (semantic-tag-name prefix))))
 631 ;          (completetext (cond ((semantic-tag-p prefix)
 632 ;                               (semantic-tag-name prefix))
 633 ;                              ((stringp prefix)
 634 ;                               prefix)
 635 ;                              ((stringp (car prefix))
 636 ;                               (car prefix))))
 637            (argtype (car (oref context :argument)))
 638            (matches nil))
 639
 640       ;; Depending on what the analyzer is, we have different ways
 641       ;; of creating completions.
 642       (cond ((eq argtype 'template)
 643              (setq matches (semantic-find-tags-for-completion
 644                             prefixstr (current-buffer)))
 645              (setq matches (semantic-find-tags-by-class
 646                             'function matches))
 647              )
 648             ((eq argtype 'elispfcn)
 649              (with-mode-local emacs-lisp-mode
 650                (setq matches (semanticdb-find-tags-for-completion
 651                               prefixstr))
 652                (setq matches (semantic-find-tags-by-class
 653                               'function matches))
 654                )
 655              )
 656             ((eq argtype 'macro)
 657              (let ((scope (oref context scope)))
 658                (setq matches
 659                      (semantic-find-tags-for-completion
 660                       prefixstr (oref scope fullscope))))
 661              )
 662             )
 663
 664       matches)))
 665
 666
 667 \f
 668 ;;; Utils
 669 ;;
 670 (defun srecode-template-get-mode ()
 671   "Get the supported major mode for this template file."
 672   (let ((m (semantic-find-first-tag-by-name "mode" (current-buffer))))
 673     (when m (read (semantic-tag-variable-default m)))))
 674
 675 (defun srecode-template-get-escape-start ()
 676   "Get the current escape_start characters."
 677   (let ((es (semantic-find-first-tag-by-name "escape_start" (current-buffer)))
 678         )
 679      (if es (car (semantic-tag-get-attribute es :default-value))
 680        "{{")))
 681
 682 (defun srecode-template-get-escape-end ()
 683   "Get the current escape_end characters."
 684   (let ((ee (semantic-find-first-tag-by-name "escape_end" (current-buffer)))
 685         )
 686     (if ee (car (semantic-tag-get-attribute ee :default-value))
 687       "}}")))
 688
 689 (defun srecode-template-current-context (&optional point)
 690   "Calculate the context encompassing POINT."
 691   (save-excursion
 692     (when point (goto-char (point)))
 693     (let ((ct (semantic-current-tag)))
 694       (when (not ct)
 695         (setq ct (semantic-find-tag-by-overlay-prev)))
 696
 697       ;; Loop till we find the context.
 698       (while (and ct (not (semantic-tag-of-class-p ct 'context)))
 699         (setq ct (semantic-find-tag-by-overlay-prev
 700                   (semantic-tag-start ct))))
 701
 702       (if ct
 703           (read (semantic-tag-name ct))
 704         'declaration))))
 705
 706 (defun srecode-template-find-templates-of-context (context &optional buffer)
 707   "Find all the templates belonging to a particular CONTEXT.
 708 When optional BUFFER is provided, search that buffer."
 709   (save-excursion
 710     (when buffer (set-buffer buffer))
 711     (let ((tags (semantic-fetch-available-tags))
 712           (cc 'declaration)
 713           (scan nil)
 714           (ans nil))
 715
 716       (when (eq cc context)
 717         (setq scan t))
 718
 719       (dolist (T tags)
 720         ;; Handle contexts
 721         (when (semantic-tag-of-class-p T 'context)
 722           (setq cc (read (semantic-tag-name T)))
 723           (when (eq cc context)
 724             (setq scan t)))
 725
 726         ;; Scan
 727         (when (and scan (semantic-tag-of-class-p T 'function))
 728           (setq ans (cons T ans)))
 729         )
 730
 731       (nreverse ans))))
 732
 733 (provide 'srecode/srt-mode)
 734
 735 ;; The autoloads in this file must go into the global loaddefs.el, not
 736 ;; the srecode one, so that srecode-template-mode can be called from
 737 ;; auto-mode-alist.
 738
 739 ;; Local variables:
 740 ;; generated-autoload-load-name: "srecode/srt-mode"
 741 ;; End:
 742
 743 ;;; srecode/srt-mode.el ends here