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