Commit | Line | Data |
---|---|---|
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. | |
138 | Don'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. | |
158 | Don'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. | |
178 | Once the escape_start, and escape_end sequences are known, then | |
179 | we 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 | |
e8cc7880 | 190 | (define-derived-mode srecode-template-mode fundamental-mode "SRecode" |
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) | |
e8cc7880 | 235 | (chl (eieio--class-children (class-v root))) |
4d902e6f CY |
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)) | |
e8cc7880 | 251 | (setq chl (append (eieio--class-children (class-v C)) chl)) |
4d902e6f CY |
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. | |
305 | If the ESCAPE_START and END are different sequences, | |
306 | a simple search is used. If ESCAPE_START and END are the same | |
2f10955c | 307 | characters, start at the beginning of the line, and find out |
4d902e6f CY |
308 | how 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. | |
336 | Moves point to the opening characters of the section macro text. | |
337 | If there is no upper context, return nil. | |
338 | Starts at POINT if provided. | |
339 | If FIND-UNMATCHED is specified as non-nil, then we are looking for an unmatched | |
340 | section." | |
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. | |
369 | Moves 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 | 375 | Moves 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. |
387 | Moves 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. | |
458 | Return 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. | |
465 | Return nil if point is not on/in a template macro. | |
466 | The first element is the key for the current macro, such as # for a | |
467 | section 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. | |
712 | When 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 |