Mercurial > emacs
annotate lisp/cedet/srecode/srt-mode.el @ 112214:40a246eebab9
* lisp/emacs-lisp/easymenu.el: Add :enable, and obey :label. Require CL.
(easy-menu-create-menu, easy-menu-convert-item-1):
Use :label rather than nil for labels. Use `case'.
Add :enable as alias for :active.
(easy-menu-binding): Obey :label.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Thu, 13 Jan 2011 21:12:43 -0500 |
parents | 6e613fbf73d7 |
children | ef719132ddfa |
rev | line source |
---|---|
104498 | 1 ;;; srecode/srt-mode.el --- Major mode for writing screcode macros |
2 | |
112213
6e613fbf73d7
Use run-mode-hooks for major mode hooks.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
3 ;; Copyright (C) 2005, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. |
104498 | 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 | |
112213
6e613fbf73d7
Use run-mode-hooks for major mode hooks.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
186 (define-derived-mode srecode-template-mode fundamental-mode "SRecorder" |
105406
5b8c8cd21526
* cedet/srecode/srt-mode.el (srecode-template-mode): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
105377
diff
changeset
|
187 "Major-mode for writing SRecode macros." |
112213
6e613fbf73d7
Use run-mode-hooks for major mode hooks.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
188 (setq comment-start ";;" |
104498 | 189 comment-end "") |
190 (set (make-local-variable 'parse-sexp-ignore-comments) t) | |
191 (set (make-local-variable 'comment-start-skip) | |
192 "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") | |
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 | |
112213
6e613fbf73d7
Use run-mode-hooks for major mode hooks.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
199 ((?_ . "w") (?- . "w"))))) |
104498 | 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 () | |
105328 | 228 "Provide help for working with macros in a template." |
104498 | 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 | |
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 | |
297 ;;; Local Context Parsing. | |
298 | |
299 (defun srecode-in-macro-p (&optional point) | |
300 "Non-nil if POINT is inside a macro bounds. | |
301 If the ESCAPE_START and END are different sequences, | |
302 a simple search is used. If ESCAPE_START and END are the same | |
105328 | 303 characters, start at the beginning of the line, and find out |
104498 | 304 how 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) | |
105423
309bc750556d
* files-x.el (modify-dir-local-variable)
Juanma Barranquero <lekktu@gmail.com>
parents:
105406
diff
changeset
|
316 ;; If there is a single, the answer is yes. |
104498 | 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. | |
332 Moves point to the opening characters of the section macro text. | |
333 If there is no upper context, return nil. | |
334 Starts at POINT if provided. | |
335 If FIND-UNMATCHED is specified as non-nil, then we are looking for an unmatched | |
336 section." | |
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. | |
365 Moves 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. | |
105425
02f737c16cc4
* cedet/ede/makefile-edit.el (makefile-beginning-of-command)
Juanma Barranquero <lekktu@gmail.com>
parents:
105423
diff
changeset
|
371 Moves to the beginning of one named section." |
104498 | 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) | |
105425
02f737c16cc4
* cedet/ede/makefile-edit.el (makefile-beginning-of-command)
Juanma Barranquero <lekktu@gmail.com>
parents:
105423
diff
changeset
|
382 "Move to the end of the current context. |
02f737c16cc4
* cedet/ede/makefile-edit.el (makefile-beginning-of-command)
Juanma Barranquero <lekktu@gmail.com>
parents:
105423
diff
changeset
|
383 Moves to the end of one named section." |
104498 | 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. | |
454 Return 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. | |
461 Return nil if point is not on/in a template macro. | |
462 The first element is the key for the current macro, such as # for a | |
463 section 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." | |
105799
3fe6da4a95a9
* cedet/srecode/srt-mode.el (semantic-analyze-possible-completions):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105425
diff
changeset
|
625 (with-current-buffer (oref context buffer) |
104498 | 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 | |
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. | |
708 When 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 | |
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 | |
105377 | 743 ;; arch-tag: 9c613c25-d885-417a-8f0d-1824b26b22a5 |
104498 | 744 ;;; srecode/srt-mode.el ends here |