code.delx.au - gnu-emacs/blob - lisp/cedet/srecode/srt-mode.el

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