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