view lisp/cedet/srecode/srt-mode.el @ 105406:5b8c8cd21526

* cedet/srecode/srt-mode.el (srecode-template-mode): Doc fix. * files.el (auto-mode-alist): Add .srt and Project.ede. * cedet/semantic.el (semantic-mode): Handle srecode-template-mode-hook as well. * cedet/srecode/template.el: Remove hook variable. * cedet/ede/proj-comp.el: Require ede/pmake when compiling. * cedet/ede.el (ede-target-forms-menu): Don't enable if no projects exist. * cedet/srecode/map.el (srecode-map-base-template-dir): Look for templates in data-directory. * cedet/ede/srecode.el (ede-srecode-setup): Use default templates directory. * cedet/semantic/util-modes.el (semantic-highlight-func-mode): Doc fix. * cedet/ede/proj-comp.el (ede-proj-makefile-insert-variables): Only insert each variable once. * cedet/ede/pmake.el (ede-pmake-insert-variable-once): New macro. (ede-pmake-insert-variable-shared): Use it. * cedet/ede/cpp-root.el (ede-preprocessor-map): Do not deref table for lexical table iff table is nil.
author Chong Yidong <cyd@stupidchicken.com>
date Sat, 03 Oct 2009 19:28:05 +0000
parents 7f4c7f5c0eba
children 309bc750556d
line wrap: on
line source

;;; srecode/srt-mode.el --- Major mode for writing screcode macros

;; Copyright (C) 2005, 2007, 2008, 2009 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Originally named srecode-template-mode.el in the CEDET repository.

(require 'srecode/compile)
(require 'srecode/ctxt)
(require 'srecode/template)

(require 'semantic)
(require 'semantic/analyze)
(require 'semantic/wisent)
(eval-when-compile
  (require 'semantic/find))

(declare-function srecode-create-dictionary "srecode/dictionary")
(declare-function srecode-resolve-argument-list "srecode/insert")

;;; Code:
(defvar srecode-template-mode-syntax-table
  (let ((table (make-syntax-table (standard-syntax-table))))
    (modify-syntax-entry ?\; ". 12"  table) ;; SEMI, Comment start ;;
    (modify-syntax-entry ?\n ">"     table) ;; Comment end
    (modify-syntax-entry ?$  "."     table) ;; Punctuation
    (modify-syntax-entry ?:  "."     table) ;; Punctuation
    (modify-syntax-entry ?<  "."     table) ;; Punctuation
    (modify-syntax-entry ?>  "."     table) ;; Punctuation
    (modify-syntax-entry ?#  "."     table) ;; Punctuation
    (modify-syntax-entry ?!  "."     table) ;; Punctuation
    (modify-syntax-entry ??  "."     table) ;; Punctuation
    (modify-syntax-entry ?\" "\""    table) ;; String
    (modify-syntax-entry ?\- "_"     table) ;; Symbol
    (modify-syntax-entry ?\\ "\\"    table) ;; Quote
    (modify-syntax-entry ?\` "'"     table) ;; Prefix ` (backquote)
    (modify-syntax-entry ?\' "'"     table) ;; Prefix ' (quote)
    (modify-syntax-entry ?\, "'"     table) ;; Prefix , (comma)

    table)
  "Syntax table used in semantic recoder macro buffers.")

(defface srecode-separator-face
  '((t (:weight bold :strike-through t)))
  "Face used for decorating separators in srecode template mode."
  :group 'srecode)

(defvar srecode-font-lock-keywords
  '(
    ;; Template
    ("^\\(template\\)\\s-+\\(\\w*\\)\\(\\( \\(:\\w+\\)\\|\\)+\\)$"
     (1 font-lock-keyword-face)
     (2 font-lock-function-name-face)
     (3 font-lock-builtin-face ))
    ("^\\(sectiondictionary\\)\\s-+\""
     (1 font-lock-keyword-face))
    ("^\\(bind\\)\\s-+\""
     (1 font-lock-keyword-face))
    ;; Variable type setting
    ("^\\(set\\)\\s-+\\(\\w+\\)\\s-+"
     (1 font-lock-keyword-face)
     (2 font-lock-variable-name-face))
    ("^\\(show\\)\\s-+\\(\\w+\\)\\s-*$"
     (1 font-lock-keyword-face)
     (2 font-lock-variable-name-face))
    ("\\<\\(macro\\)\\s-+\""
     (1 font-lock-keyword-face))
    ;; Context type setting
    ("^\\(context\\)\\s-+\\(\\w+\\)"
     (1 font-lock-keyword-face)
     (2 font-lock-builtin-face))
    ;; Prompting setting
    ("^\\(prompt\\)\\s-+\\(\\w+\\)"
     (1 font-lock-keyword-face)
     (2 font-lock-variable-name-face))
    ("\\(default\\(macro\\)?\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
     (1 font-lock-keyword-face)
     (3 font-lock-type-face))
    ("\\<\\(default\\(macro\\)?\\)\\>" (1 font-lock-keyword-face))
    ("\\<\\(read\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
     (1 font-lock-keyword-face)
     (2 font-lock-type-face))

    ;; Macro separators
    ("^----\n" 0 'srecode-separator-face)

    ;; Macro Matching
    (srecode-template-mode-macro-escape-match 1 font-lock-string-face)
    ((lambda (limit)
       (srecode-template-mode-font-lock-macro-helper
	limit "\\(\\??\\w+\\)[^ \t\n{}$#@&*()]*"))
     1 font-lock-variable-name-face)
    ((lambda (limit)
       (srecode-template-mode-font-lock-macro-helper
	limit "\\([#/]\\w+\\)[^ \t\n{}$#@&*()]*"))
     1 font-lock-keyword-face)
    ((lambda (limit)
       (srecode-template-mode-font-lock-macro-helper
	limit "\\([<>]\\w*\\):\\(\\w+\\):\\(\\w+\\)"))
     (1 font-lock-keyword-face)
     (2 font-lock-builtin-face)
     (3 font-lock-type-face))
    ((lambda (limit)
       (srecode-template-mode-font-lock-macro-helper
	limit "\\([<>?]?\\w*\\):\\(\\w+\\)"))
     (1 font-lock-keyword-face)
     (2 font-lock-type-face))
    ((lambda (limit)
       (srecode-template-mode-font-lock-macro-helper
	limit "!\\([^{}$]*\\)"))
     1 font-lock-comment-face)

    )
  "Keywords for use with srecode macros and font-lock.")

(defun srecode-template-mode-font-lock-macro-helper (limit expression)
  "Match against escape characters.
Don't scan past LIMIT.  Match with EXPRESSION."
  (let* ((done nil)
	 (md nil)
	 (es (regexp-quote (srecode-template-get-escape-start)))
	 (ee (regexp-quote (srecode-template-get-escape-end)))
	 (regex (concat es expression ee))
	 )
    (while (not done)
      (save-match-data
	(if (re-search-forward regex limit t)
	    (when (equal (car (srecode-calculate-context)) "code")
	      (setq md (match-data)
		    done t))
	  (setq done t))))
    (set-match-data md)
    ;; (when md (message "Found a match!"))
    (when md t)))

(defun srecode-template-mode-macro-escape-match (limit)
  "Match against escape characters.
Don't scan past LIMIT."
  (let* ((done nil)
	 (md nil)
	 (es (regexp-quote (srecode-template-get-escape-start)))
	 (ee (regexp-quote (srecode-template-get-escape-end)))
	 (regex (concat "\\(" es "\\|" ee "\\)"))
	 )
    (while (not done)
      (save-match-data
	(if (re-search-forward regex limit t)
	    (when (equal (car (srecode-calculate-context)) "code")
	      (setq md (match-data)
		    done t))
	  (setq done t))))
    (set-match-data md)
    ;;(when md (message "Found a match!"))
    (when md t)))

(defvar srecode-font-lock-macro-keywords nil
  "Dynamically generated `font-lock' keywords for srecode templates.
Once the escape_start, and escape_end sequences are known, then
we can tell font lock about them.")

(defvar srecode-template-mode-map
  (let ((km (make-sparse-keymap)))
    (define-key km "\C-c\C-c" 'srecode-compile-templates)
    (define-key km "\C-c\C-m" 'srecode-macro-help)
    (define-key km "/" 'srecode-self-insert-complete-end-macro)
    km)
  "Keymap used in srecode mode.")

;;;###autoload
(defun srecode-template-mode ()
  "Major-mode for writing SRecode macros."
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'srecode-template-mode
        mode-name "SRecoder"
	comment-start ";;"
	comment-end "")
  (set (make-local-variable 'parse-sexp-ignore-comments) t)
  (set (make-local-variable 'comment-start-skip)
       "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
  (set-syntax-table srecode-template-mode-syntax-table)
  (use-local-map srecode-template-mode-map)
  (set (make-local-variable 'font-lock-defaults)
       '(srecode-font-lock-keywords
         nil  ;; perform string/comment fontification
         nil  ;; keywords are case sensitive.
         ;; This puts _ & - as a word constituant,
         ;; simplifying our keywords significantly
         ((?_ . "w") (?- . "w"))))
  (run-hooks 'srecode-template-mode-hook))

;;;###autoload
(defalias 'srt-mode 'srecode-template-mode)

;;; Template Commands
;;
(defun srecode-self-insert-complete-end-macro ()
  "Self insert the current key, then autocomplete the end macro."
  (interactive)
  (call-interactively 'self-insert-command)
  (when (and (semantic-current-tag)
	     (semantic-tag-of-class-p (semantic-current-tag) 'function)
	     )
    (let* ((es (srecode-template-get-escape-start))
	   (ee (srecode-template-get-escape-end))
	   (name (save-excursion
		   (forward-char (- (length es)))
		   (forward-char -1)
		   (if (looking-at (regexp-quote es))
		       (srecode-up-context-get-name (point) t))))
	   )
      (when name
	(insert name)
	(insert ee))))
  )


(defun srecode-macro-help ()
  "Provide help for working with macros in a template."
  (interactive)
  (let* ((root 'srecode-template-inserter)
	 (chl (aref (class-v root) class-children))
	 (ess (srecode-template-get-escape-start))
	 (ees (srecode-template-get-escape-end))
	 )
    (with-output-to-temp-buffer "*SRecode Macros*"
      (princ "Description of known SRecode Template Macros.")
      (terpri)
      (terpri)
      (while chl
	(let* ((C (car chl))
	       (name (symbol-name C))
	       (key (when (slot-exists-p C 'key)
		      (oref C key)))
	       (showexample t)
	       )
	  (setq chl (cdr chl))
	  (setq chl (append (aref (class-v C) class-children) chl))

	  (catch 'skip
	    (when (eq C 'srecode-template-inserter-section-end)
	      (throw 'skip nil))

	    (when (class-abstract-p C)
	      (throw 'skip nil))

	    (princ "`")
	    (princ name)
	    (princ "'")
	    (when (slot-exists-p C 'key)
	      (when key
		(princ " - Character Key: ")
		(if (stringp key)
		    (progn
		      (setq showexample nil)
		      (cond ((string= key "\n")
			     (princ "\"\\n\"")
			     )
			    (t
			     (prin1 key)
			     )))
		  (prin1 (format "%c" key))
		  )))
	    (terpri)
	    (princ (documentation-property C 'variable-documentation))
	    (terpri)
	    (when showexample
	      (princ "Example:")
	      (terpri)
	      (srecode-inserter-prin-example C ess ees)
	      )

	    (terpri)

	    ) ;; catch
	  );; let*
	))))


;;; Misc Language Overrides
;;
(define-mode-local-override semantic-ia-insert-tag
  srecode-template-mode (tag)
  "Insert the SRecode TAG into the current buffer."
  (insert (semantic-tag-name tag)))


;;; Local Context Parsing.

(defun srecode-in-macro-p (&optional point)
  "Non-nil if POINT is inside a macro bounds.
If the ESCAPE_START and END are different sequences,
a simple search is used.  If ESCAPE_START and END are the same
characters, start at the beginning of the line, and find out
how many occur."
  (let ((tag (semantic-current-tag))
	(es (regexp-quote (srecode-template-get-escape-start)))
	(ee (regexp-quote (srecode-template-get-escape-end)))
	(start (or point (point)))
	)
    (when (and tag (semantic-tag-of-class-p tag 'function))
      (if (string= es ee)
	  (save-excursion
	    (beginning-of-line)
	    (while (re-search-forward es start t 2))
	    (if (re-search-forward es start t)
		;; If there is a single, the the answer is yes.
		t
	      ;; If there wasn't another, then the answer is no.
	      nil)
	    )
	;; ES And EE are not the same.
	(save-excursion
	  (and (re-search-backward es (semantic-tag-start tag) t)
	       (>= (or (re-search-forward ee (semantic-tag-end tag) t)
		       ;; No end match means an incomplete macro.
		       start)
		  start)))
	))))

(defun srecode-up-context-get-name (&optional point find-unmatched)
  "Move up one context as for `semantic-up-context', and return the name.
Moves point to the opening characters of the section macro text.
If there is no upper context, return nil.
Starts at POINT if provided.
If FIND-UNMATCHED is specified as non-nil, then we are looking for an unmatched
section."
  (when point (goto-char (point)))
  (let* ((tag (semantic-current-tag))
	 (es (regexp-quote (srecode-template-get-escape-start)))
	 (start (concat es "[#<]\\(\\w+\\)"))
	 (orig (point))
	 (name nil)
	 (res nil))
    (when (semantic-tag-of-class-p tag 'function)
      (while (and (not res)
		  (re-search-backward start (semantic-tag-start tag) t))
	(when (save-excursion
		(setq name (match-string 1))
		(let ((endr (concat es "/" name)))
		  (if (re-search-forward endr (semantic-tag-end tag) t)
		      (< orig (point))
		    (if (not find-unmatched)
			(error "Unmatched Section Template")
		      ;; We found what we want.
		      t))))
	  (setq res (point)))
	)
      ;; Restore in no result found.
      (goto-char (or res orig))
      name)))

(define-mode-local-override semantic-up-context
  srecode-template-mode (&optional point)
  "Move up one context in the current code.
Moves out one named section."
  (not (srecode-up-context-get-name point)))

(define-mode-local-override semantic-beginning-of-context
  srecode-template-mode (&optional point)
  "Move to the beginning of the current context.
Moves the the beginning of one named section."
  (if (semantic-up-context point)
      t
    (let ((es (regexp-quote (srecode-template-get-escape-start)))
	  (ee (regexp-quote (srecode-template-get-escape-end))))
      (re-search-forward es) ;; move over the start chars.
      (re-search-forward ee) ;; Move after the end chars.
      nil)))

(define-mode-local-override semantic-end-of-context
  srecode-template-mode (&optional point)
  "Move to the beginning of the current context.
Moves the the beginning of one named section."
  (let ((name (srecode-up-context-get-name point))
	(tag (semantic-current-tag))
	(es  (regexp-quote (srecode-template-get-escape-start))))
  (if (not name)
      t
    (unless (re-search-forward (concat es "/" name) (semantic-tag-end tag) t)
      (error "Section %s has no end" name))
    (goto-char (match-beginning 0))
    nil)))

(define-mode-local-override semantic-get-local-variables
  srecode-template-mode (&optional point)
  "Get local variables from an SRecode template."
  (save-excursion
    (when point (goto-char (point)))
    (let* ((tag (semantic-current-tag))
	   (name (save-excursion
		   (srecode-up-context-get-name (point))))
	   (subdicts (semantic-tag-get-attribute tag :dictionaries))
	   (global nil)
	   )
      (dolist (D subdicts)
	(setq global (cons (semantic-tag-new-variable (car D) nil)
			   global)))
      (if name
	  ;; Lookup any subdictionaries in TAG.
	  (let ((res nil))

	    (while (and (not res) subdicts)
	      ;; Find the subdictionary with the same name.  Those variables
	      ;; are now local to this section.
	      (when (string= (car (car subdicts)) name)
		(setq res (cdr (car subdicts))))
	      (setq subdicts (cdr subdicts)))
	    ;; Pre-pend our global vars.
	    (append global res))
	;; If we aren't in a subsection, just do the global variables
	global
	))))

(define-mode-local-override semantic-get-local-arguments
  srecode-template-mode (&optional point)
  "Get local arguments from an SRecode template."
  (require 'srecode/insert)
  (save-excursion
    (when point (goto-char (point)))
    (let* ((tag (semantic-current-tag))
	   (args (semantic-tag-function-arguments tag))
	   (argsym (mapcar 'intern args))
	   (argvars nil)
	   ;; Create a temporary dictionary in which the
	   ;; arguments can be resolved so we can extract
	   ;; the results.
	   (dict (srecode-create-dictionary t))
	   )
      ;; Resolve args into our temp dictionary
      (srecode-resolve-argument-list argsym dict)

      (maphash
       (lambda (key entry)
	 (setq argvars
	       (cons (semantic-tag-new-variable key nil entry)
		     argvars)))
       (oref dict namehash))

      argvars)))

(define-mode-local-override semantic-ctxt-current-symbol
  srecode-template-mode (&optional point)
  "Return the current symbol under POINT.
Return nil if point is not on/in a template macro."
  (let ((macro (srecode-parse-this-macro point)))
    (cdr macro))
  )

(defun srecode-parse-this-macro (&optional point)
  "Return the current symbol under POINT.
Return nil if point is not on/in a template macro.
The first element is the key for the current macro, such as # for a
section or ? for an ask variable."
  (save-excursion
    (if point (goto-char point))
    (let ((tag (semantic-current-tag))
	  (es (regexp-quote (srecode-template-get-escape-start)))
	  (ee (regexp-quote (srecode-template-get-escape-end)))
	  (start (point))
	  (macrostart nil)
	  (raw nil)
	  )
      (when (and tag (semantic-tag-of-class-p tag 'function)
		 (srecode-in-macro-p point)
		 (re-search-backward es (semantic-tag-start tag) t))
	(setq macrostart (match-end 0))
	(goto-char macrostart)
	;; We have a match
	(when (not (re-search-forward ee (semantic-tag-end tag) t))
	  (goto-char start) ;; Pretend we are ok for completion
	  (set-match-data (list start start))
	  )

	(if (> start (point))
	    ;; If our starting point is after the found point, that
	    ;; means we are not inside the macro.  Retur nil.
	    nil
	  ;; We are inside the macro, extract the text so far.
	  (let* ((macroend (match-beginning 0))
		 (raw (buffer-substring-no-properties
		       macrostart macroend))
		 (STATE (srecode-compile-state "TMP"))
		 (inserter (condition-case nil
			       (srecode-compile-parse-inserter
				raw STATE)
			     (error nil)))
		 )
	    (when inserter
	      (let ((base
		     (cons (oref inserter :object-name)
			   (if (and (slot-boundp inserter :secondname)
				    (oref inserter :secondname))
			       (split-string (oref inserter :secondname)
					     ":")
			     nil)))
		    (key (oref inserter key)))
		(cond ((null key)
		       ;; A plain variable
		       (cons nil base))
		      (t
		       ;; A complex variable thingy.
		       (cons (format "%c" key)
			     base)))))
	    )
	  )))
    ))

(define-mode-local-override semantic-analyze-current-context
  srecode-template-mode (point)
  "Provide a Semantic analysis in SRecode template mode."
    (let* ((context-return nil)
	   (prefixandbounds (semantic-ctxt-current-symbol-and-bounds))
	   (prefix (car prefixandbounds))
	   (bounds (nth 2 prefixandbounds))
	   (key (car (srecode-parse-this-macro (point))))
	   (prefixsym nil)
	   (prefix-var nil)
	   (prefix-context nil)
	   (prefix-function nil)
	   (prefixclass (semantic-ctxt-current-class-list))
	   (globalvar (semantic-find-tags-by-class 'variable (current-buffer)))
	   (argtype 'macro)
	   (scope (semantic-calculate-scope point))
	   )

      (oset scope fullscope (append (oref scope localvar) globalvar))

      (when prefix
	;; First, try to find the variable for the first
	;; entry in the prefix list.
	(setq prefix-var (semantic-find-first-tag-by-name
			  (car prefix) (oref scope fullscope)))

	(cond
	 ((and (or (not key) (string= key "?"))
	       (> (length prefix) 1))
	  ;; Variables can have lisp function names.
	  (with-mode-local emacs-lisp-mode
	    (let ((fcns (semanticdb-find-tags-by-name (car (last prefix)))))
	      (setq prefix-function (car (semanticdb-find-result-nth fcns 0)))
	      (setq argtype 'elispfcn)))
	  )
	 ((or (string= key "<") (string= key ">"))
	  ;; Includes have second args that is the template name.
	  (if (= (length prefix) 3)
	      (let ((contexts (semantic-find-tags-by-class
			       'context (current-buffer))))
		(setq prefix-context
		      (or (semantic-find-first-tag-by-name
			   (nth 1 prefix) contexts)
			  ;; Calculate from location
			  (semantic-tag
			   (symbol-name
			    (srecode-template-current-context))
			   'context)))
		(setq argtype 'template))
	    (setq prefix-context
		  ;; Calculate from location
		  (semantic-tag
		   (symbol-name (srecode-template-current-context))
		   'context))
	    (setq argtype 'template)
	    )
	  ;; The last one?
	  (when (> (length prefix) 1)
	    (let ((toc (srecode-template-find-templates-of-context
			(read (semantic-tag-name prefix-context))))
		  )
	      (setq prefix-function
		    (or (semantic-find-first-tag-by-name
			(car (last prefix)) toc)
			;; Not in this buffer?  Search the master
			;; templates list.
			nil))
	      ))
	  )
	 )

	(setq prefixsym
	      (cond ((= (length prefix) 3)
		     (list (or prefix-var (nth 0 prefix))
			   (or prefix-context (nth 1 prefix))
			   (or prefix-function (nth 2 prefix))))
		    ((= (length prefix) 2)
		     (list (or prefix-var (nth 0 prefix))
			   (or prefix-function (nth 1 prefix))))
		    ((= (length prefix) 1)
		     (list (or prefix-var (nth 0 prefix)))
		     )))

	(setq context-return
	      (semantic-analyze-context-functionarg
	       "context-for-srecode"
	       :buffer (current-buffer)
	       :scope scope
	       :bounds bounds
	       :prefix (or prefixsym
			   prefix)
	       :prefixtypes nil
	       :prefixclass prefixclass
	       :errors nil
	       ;; Use the functionarg analyzer class so we
	       ;; can save the current key, and the index
	       ;; into the macro part we are completing on.
	       :function (list key)
	       :index (length prefix)
	       :argument (list argtype)
	       ))

	context-return)))

(define-mode-local-override semantic-analyze-possible-completions
  srecode-template-mode (context)
  "Return a list of possible completions based on NONTEXT."
  (save-excursion
    (set-buffer (oref context buffer))
    (let* ((prefix (car (last (oref context :prefix))))
	   (prefixstr (cond ((stringp prefix)
			     prefix)
			    ((semantic-tag-p prefix)
			     (semantic-tag-name prefix))))
;	   (completetext (cond ((semantic-tag-p prefix)
;				(semantic-tag-name prefix))
;			       ((stringp prefix)
;				prefix)
;			       ((stringp (car prefix))
;				(car prefix))))
	   (argtype (car (oref context :argument)))
	   (matches nil))

      ;; Depending on what the analyzer is, we have different ways
      ;; of creating completions.
      (cond ((eq argtype 'template)
	     (setq matches (semantic-find-tags-for-completion
			    prefixstr (current-buffer)))
	     (setq matches (semantic-find-tags-by-class
			    'function matches))
	     )
	    ((eq argtype 'elispfcn)
	     (with-mode-local emacs-lisp-mode
	       (setq matches (semanticdb-find-tags-for-completion
			      prefixstr))
	       (setq matches (semantic-find-tags-by-class
			      'function matches))
	       )
	     )
	    ((eq argtype 'macro)
	     (let ((scope (oref context scope)))
	       (setq matches
		     (semantic-find-tags-for-completion
		      prefixstr (oref scope fullscope))))
	     )
	    )

      matches)))



;;; Utils
;;
(defun srecode-template-get-mode ()
  "Get the supported major mode for this template file."
  (let ((m (semantic-find-first-tag-by-name "mode" (current-buffer))))
    (when m (read (semantic-tag-variable-default m)))))

(defun srecode-template-get-escape-start ()
  "Get the current escape_start characters."
  (let ((es (semantic-find-first-tag-by-name "escape_start" (current-buffer)))
	)
     (if es (car (semantic-tag-get-attribute es :default-value))
       "{{")))

(defun srecode-template-get-escape-end ()
  "Get the current escape_end characters."
  (let ((ee (semantic-find-first-tag-by-name "escape_end" (current-buffer)))
	)
    (if ee (car (semantic-tag-get-attribute ee :default-value))
      "}}")))

(defun srecode-template-current-context (&optional point)
  "Calculate the context encompassing POINT."
  (save-excursion
    (when point (goto-char (point)))
    (let ((ct (semantic-current-tag)))
      (when (not ct)
	(setq ct (semantic-find-tag-by-overlay-prev)))

      ;; Loop till we find the context.
      (while (and ct (not (semantic-tag-of-class-p ct 'context)))
	(setq ct (semantic-find-tag-by-overlay-prev
		  (semantic-tag-start ct))))

      (if ct
	  (read (semantic-tag-name ct))
	'declaration))))

(defun srecode-template-find-templates-of-context (context &optional buffer)
  "Find all the templates belonging to a particular CONTEXT.
When optional BUFFER is provided, search that buffer."
  (save-excursion
    (when buffer (set-buffer buffer))
    (let ((tags (semantic-fetch-available-tags))
	  (cc 'declaration)
	  (scan nil)
	  (ans nil))

      (when (eq cc context)
	(setq scan t))

      (dolist (T tags)
	;; Handle contexts
	(when (semantic-tag-of-class-p T 'context)
	  (setq cc (read (semantic-tag-name T)))
	  (when (eq cc context)
	    (setq scan t)))

	;; Scan
	(when (and scan (semantic-tag-of-class-p T 'function))
	  (setq ans (cons T ans)))
	)

      (nreverse ans))))

(provide 'srecode/srt-mode)

;; The autoloads in this file must go into the global loaddefs.el, not
;; the srecode one, so that srecode-template-mode can be called from
;; auto-mode-alist.

;; Local variables:
;; generated-autoload-load-name: "srecode/srt-mode"
;; End:

;; arch-tag: 9c613c25-d885-417a-8f0d-1824b26b22a5
;;; srecode/srt-mode.el ends here