lisp/cedet/srecode/srt-mode.el

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