104498
|
1 ;;; srecode/srt-mode.el --- Major mode for writing screcode macros
|
|
2
|
|
3 ;; Copyright (C) 2005, 2007, 2008, 2009 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 tempalte."
|
|
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
|
|
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
|
|
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 characteres, 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 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 the 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 beginning of the current context.
|
|
390 Moves the the beginning 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 (save-excursion
|
|
633 (set-buffer (oref context buffer))
|
|
634 (let* ((prefix (car (last (oref context :prefix))))
|
|
635 (prefixstr (cond ((stringp prefix)
|
|
636 prefix)
|
|
637 ((semantic-tag-p prefix)
|
|
638 (semantic-tag-name prefix))))
|
|
639 ; (completetext (cond ((semantic-tag-p prefix)
|
|
640 ; (semantic-tag-name prefix))
|
|
641 ; ((stringp prefix)
|
|
642 ; prefix)
|
|
643 ; ((stringp (car prefix))
|
|
644 ; (car prefix))))
|
|
645 (argtype (car (oref context :argument)))
|
|
646 (matches nil))
|
|
647
|
|
648 ;; Depending on what the analyzer is, we have different ways
|
|
649 ;; of creating completions.
|
|
650 (cond ((eq argtype 'template)
|
|
651 (setq matches (semantic-find-tags-for-completion
|
|
652 prefixstr (current-buffer)))
|
|
653 (setq matches (semantic-find-tags-by-class
|
|
654 'function matches))
|
|
655 )
|
|
656 ((eq argtype 'elispfcn)
|
|
657 (with-mode-local emacs-lisp-mode
|
|
658 (setq matches (semanticdb-find-tags-for-completion
|
|
659 prefixstr))
|
|
660 (setq matches (semantic-find-tags-by-class
|
|
661 'function matches))
|
|
662 )
|
|
663 )
|
|
664 ((eq argtype 'macro)
|
|
665 (let ((scope (oref context scope)))
|
|
666 (setq matches
|
|
667 (semantic-find-tags-for-completion
|
|
668 prefixstr (oref scope fullscope))))
|
|
669 )
|
|
670 )
|
|
671
|
|
672 matches)))
|
|
673
|
|
674
|
|
675
|
|
676 ;;; Utils
|
|
677 ;;
|
|
678 (defun srecode-template-get-mode ()
|
|
679 "Get the supported major mode for this template file."
|
|
680 (let ((m (semantic-find-first-tag-by-name "mode" (current-buffer))))
|
|
681 (when m (read (semantic-tag-variable-default m)))))
|
|
682
|
|
683 (defun srecode-template-get-escape-start ()
|
|
684 "Get the current escape_start characters."
|
|
685 (let ((es (semantic-find-first-tag-by-name "escape_start" (current-buffer)))
|
|
686 )
|
|
687 (if es (car (semantic-tag-get-attribute es :default-value))
|
|
688 "{{")))
|
|
689
|
|
690 (defun srecode-template-get-escape-end ()
|
|
691 "Get the current escape_end characters."
|
|
692 (let ((ee (semantic-find-first-tag-by-name "escape_end" (current-buffer)))
|
|
693 )
|
|
694 (if ee (car (semantic-tag-get-attribute ee :default-value))
|
|
695 "}}")))
|
|
696
|
|
697 (defun srecode-template-current-context (&optional point)
|
|
698 "Calculate the context encompassing POINT."
|
|
699 (save-excursion
|
|
700 (when point (goto-char (point)))
|
|
701 (let ((ct (semantic-current-tag)))
|
|
702 (when (not ct)
|
|
703 (setq ct (semantic-find-tag-by-overlay-prev)))
|
|
704
|
|
705 ;; Loop till we find the context.
|
|
706 (while (and ct (not (semantic-tag-of-class-p ct 'context)))
|
|
707 (setq ct (semantic-find-tag-by-overlay-prev
|
|
708 (semantic-tag-start ct))))
|
|
709
|
|
710 (if ct
|
|
711 (read (semantic-tag-name ct))
|
|
712 'declaration))))
|
|
713
|
|
714 (defun srecode-template-find-templates-of-context (context &optional buffer)
|
|
715 "Find all the templates belonging to a particular CONTEXT.
|
|
716 When optional BUFFER is provided, search that buffer."
|
|
717 (save-excursion
|
|
718 (when buffer (set-buffer buffer))
|
|
719 (let ((tags (semantic-fetch-available-tags))
|
|
720 (cc 'declaration)
|
|
721 (scan nil)
|
|
722 (ans nil))
|
|
723
|
|
724 (when (eq cc context)
|
|
725 (setq scan t))
|
|
726
|
|
727 (dolist (T tags)
|
|
728 ;; Handle contexts
|
|
729 (when (semantic-tag-of-class-p T 'context)
|
|
730 (setq cc (read (semantic-tag-name T)))
|
|
731 (when (eq cc context)
|
|
732 (setq scan t)))
|
|
733
|
|
734 ;; Scan
|
|
735 (when (and scan (semantic-tag-of-class-p T 'function))
|
|
736 (setq ans (cons T ans)))
|
|
737 )
|
|
738
|
|
739 (nreverse ans))))
|
|
740
|
|
741 (provide 'srecode/srt-mode)
|
|
742
|
|
743 ;; The autoloads in this file must go into the global loaddefs.el, not
|
|
744 ;; the srecode one, so that srecode-template-mode can be called from
|
|
745 ;; auto-mode-alist.
|
|
746
|
|
747 ;; Local variables:
|
|
748 ;; generated-autoload-load-name: "srecode/srt-mode"
|
|
749 ;; End:
|
|
750
|
|
751 ;;; srecode/srt-mode.el ends here
|