lisp/cedet/srecode/srt-mode.el

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