srt-mode.el 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744
  1. ;;; srecode/srt-mode.el --- Major mode for writing screcode macros
  2. ;; Copyright (C) 2005, 2007-2012 Free Software Foundation, Inc.
  3. ;; This file is part of GNU Emacs.
  4. ;; GNU Emacs is free software: you can redistribute it and/or modify
  5. ;; it under the terms of the GNU General Public License as published by
  6. ;; the Free Software Foundation, either version 3 of the License, or
  7. ;; (at your option) any later version.
  8. ;; GNU Emacs is distributed in the hope that it will be useful,
  9. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. ;; GNU General Public License for more details.
  12. ;; You should have received a copy of the GNU General Public License
  13. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  14. ;;; Commentary:
  15. ;; Originally named srecode-template-mode.el in the CEDET repository.
  16. (require 'srecode/compile)
  17. (require 'srecode/ctxt)
  18. (require 'srecode/template)
  19. (require 'semantic)
  20. (require 'semantic/analyze)
  21. (require 'semantic/wisent)
  22. (eval-when-compile
  23. (require 'semantic/find))
  24. (declare-function srecode-create-dictionary "srecode/dictionary")
  25. (declare-function srecode-resolve-argument-list "srecode/insert")
  26. ;;; Code:
  27. (defvar srecode-template-mode-syntax-table
  28. (let ((table (make-syntax-table (standard-syntax-table))))
  29. (modify-syntax-entry ?\; ". 12" table) ;; SEMI, Comment start ;;
  30. (modify-syntax-entry ?\n ">" table) ;; Comment end
  31. (modify-syntax-entry ?$ "." table) ;; Punctuation
  32. (modify-syntax-entry ?: "." table) ;; Punctuation
  33. (modify-syntax-entry ?< "." table) ;; Punctuation
  34. (modify-syntax-entry ?> "." table) ;; Punctuation
  35. (modify-syntax-entry ?# "." table) ;; Punctuation
  36. (modify-syntax-entry ?! "." table) ;; Punctuation
  37. (modify-syntax-entry ?? "." table) ;; Punctuation
  38. (modify-syntax-entry ?\" "\"" table) ;; String
  39. (modify-syntax-entry ?\- "_" table) ;; Symbol
  40. (modify-syntax-entry ?\\ "\\" table) ;; Quote
  41. (modify-syntax-entry ?\` "'" table) ;; Prefix ` (backquote)
  42. (modify-syntax-entry ?\' "'" table) ;; Prefix ' (quote)
  43. (modify-syntax-entry ?\, "'" table) ;; Prefix , (comma)
  44. table)
  45. "Syntax table used in semantic recoder macro buffers.")
  46. (defface srecode-separator-face
  47. '((t (:weight bold :strike-through t)))
  48. "Face used for decorating separators in srecode template mode."
  49. :group 'srecode)
  50. (defvar srecode-font-lock-keywords
  51. '(
  52. ;; Template
  53. ("^\\(template\\)\\s-+\\(\\w*\\)\\(\\( \\(:\\w+\\)\\|\\)+\\)$"
  54. (1 font-lock-keyword-face)
  55. (2 font-lock-function-name-face)
  56. (3 font-lock-builtin-face ))
  57. ("^\\(sectiondictionary\\)\\s-+\""
  58. (1 font-lock-keyword-face))
  59. ("^\\(bind\\)\\s-+\""
  60. (1 font-lock-keyword-face))
  61. ;; Variable type setting
  62. ("^\\(set\\)\\s-+\\(\\w+\\)\\s-+"
  63. (1 font-lock-keyword-face)
  64. (2 font-lock-variable-name-face))
  65. ("^\\(show\\)\\s-+\\(\\w+\\)\\s-*$"
  66. (1 font-lock-keyword-face)
  67. (2 font-lock-variable-name-face))
  68. ("\\<\\(macro\\)\\s-+\""
  69. (1 font-lock-keyword-face))
  70. ;; Context type setting
  71. ("^\\(context\\)\\s-+\\(\\w+\\)"
  72. (1 font-lock-keyword-face)
  73. (2 font-lock-builtin-face))
  74. ;; Prompting setting
  75. ("^\\(prompt\\)\\s-+\\(\\w+\\)"
  76. (1 font-lock-keyword-face)
  77. (2 font-lock-variable-name-face))
  78. ("\\(default\\(macro\\)?\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
  79. (1 font-lock-keyword-face)
  80. (3 font-lock-type-face))
  81. ("\\<\\(default\\(macro\\)?\\)\\>" (1 font-lock-keyword-face))
  82. ("\\<\\(read\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
  83. (1 font-lock-keyword-face)
  84. (2 font-lock-type-face))
  85. ;; Macro separators
  86. ("^----\n" 0 'srecode-separator-face)
  87. ;; Macro Matching
  88. (srecode-template-mode-macro-escape-match 1 font-lock-string-face)
  89. ((lambda (limit)
  90. (srecode-template-mode-font-lock-macro-helper
  91. limit "\\(\\??\\w+\\)[^ \t\n{}$#@&*()]*"))
  92. 1 font-lock-variable-name-face)
  93. ((lambda (limit)
  94. (srecode-template-mode-font-lock-macro-helper
  95. limit "\\([#/]\\w+\\)[^ \t\n{}$#@&*()]*"))
  96. 1 font-lock-keyword-face)
  97. ((lambda (limit)
  98. (srecode-template-mode-font-lock-macro-helper
  99. limit "\\([<>]\\w*\\):\\(\\w+\\):\\(\\w+\\)"))
  100. (1 font-lock-keyword-face)
  101. (2 font-lock-builtin-face)
  102. (3 font-lock-type-face))
  103. ((lambda (limit)
  104. (srecode-template-mode-font-lock-macro-helper
  105. limit "\\([<>?]?\\w*\\):\\(\\w+\\)"))
  106. (1 font-lock-keyword-face)
  107. (2 font-lock-type-face))
  108. ((lambda (limit)
  109. (srecode-template-mode-font-lock-macro-helper
  110. limit "!\\([^{}$]*\\)"))
  111. 1 font-lock-comment-face)
  112. )
  113. "Keywords for use with srecode macros and font-lock.")
  114. (defun srecode-template-mode-font-lock-macro-helper (limit expression)
  115. "Match against escape characters.
  116. Don't scan past LIMIT. Match with EXPRESSION."
  117. (let* ((done nil)
  118. (md nil)
  119. (es (regexp-quote (srecode-template-get-escape-start)))
  120. (ee (regexp-quote (srecode-template-get-escape-end)))
  121. (regex (concat es expression ee))
  122. )
  123. (while (not done)
  124. (save-match-data
  125. (if (re-search-forward regex limit t)
  126. (when (equal (car (srecode-calculate-context)) "code")
  127. (setq md (match-data)
  128. done t))
  129. (setq done t))))
  130. (set-match-data md)
  131. ;; (when md (message "Found a match!"))
  132. (when md t)))
  133. (defun srecode-template-mode-macro-escape-match (limit)
  134. "Match against escape characters.
  135. Don't scan past LIMIT."
  136. (let* ((done nil)
  137. (md nil)
  138. (es (regexp-quote (srecode-template-get-escape-start)))
  139. (ee (regexp-quote (srecode-template-get-escape-end)))
  140. (regex (concat "\\(" es "\\|" ee "\\)"))
  141. )
  142. (while (not done)
  143. (save-match-data
  144. (if (re-search-forward regex limit t)
  145. (when (equal (car (srecode-calculate-context)) "code")
  146. (setq md (match-data)
  147. done t))
  148. (setq done t))))
  149. (set-match-data md)
  150. ;;(when md (message "Found a match!"))
  151. (when md t)))
  152. (defvar srecode-font-lock-macro-keywords nil
  153. "Dynamically generated `font-lock' keywords for srecode templates.
  154. Once the escape_start, and escape_end sequences are known, then
  155. we can tell font lock about them.")
  156. (defvar srecode-template-mode-map
  157. (let ((km (make-sparse-keymap)))
  158. (define-key km "\C-c\C-c" 'srecode-compile-templates)
  159. (define-key km "\C-c\C-m" 'srecode-macro-help)
  160. (define-key km "/" 'srecode-self-insert-complete-end-macro)
  161. km)
  162. "Keymap used in srecode mode.")
  163. ;;;###autoload
  164. (define-derived-mode srecode-template-mode fundamental-mode "SRecorder"
  165. "Major-mode for writing SRecode macros."
  166. (setq comment-start ";;"
  167. comment-end "")
  168. (set (make-local-variable 'parse-sexp-ignore-comments) t)
  169. (set (make-local-variable 'comment-start-skip)
  170. "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
  171. (set (make-local-variable 'font-lock-defaults)
  172. '(srecode-font-lock-keywords
  173. nil ;; perform string/comment fontification
  174. nil ;; keywords are case sensitive.
  175. ;; This puts _ & - as a word constituent,
  176. ;; simplifying our keywords significantly
  177. ((?_ . "w") (?- . "w")))))
  178. ;;;###autoload
  179. (defalias 'srt-mode 'srecode-template-mode)
  180. ;;; Template Commands
  181. ;;
  182. (defun srecode-self-insert-complete-end-macro ()
  183. "Self insert the current key, then autocomplete the end macro."
  184. (interactive)
  185. (call-interactively 'self-insert-command)
  186. (when (and (semantic-current-tag)
  187. (semantic-tag-of-class-p (semantic-current-tag) 'function)
  188. )
  189. (let* ((es (srecode-template-get-escape-start))
  190. (ee (srecode-template-get-escape-end))
  191. (name (save-excursion
  192. (forward-char (- (length es)))
  193. (forward-char -1)
  194. (if (looking-at (regexp-quote es))
  195. (srecode-up-context-get-name (point) t))))
  196. )
  197. (when name
  198. (insert name)
  199. (insert ee))))
  200. )
  201. (defun srecode-macro-help ()
  202. "Provide help for working with macros in a template."
  203. (interactive)
  204. (let* ((root 'srecode-template-inserter)
  205. (chl (aref (class-v root) class-children))
  206. (ess (srecode-template-get-escape-start))
  207. (ees (srecode-template-get-escape-end))
  208. )
  209. (with-output-to-temp-buffer "*SRecode Macros*"
  210. (princ "Description of known SRecode Template Macros.")
  211. (terpri)
  212. (terpri)
  213. (while chl
  214. (let* ((C (car chl))
  215. (name (symbol-name C))
  216. (key (when (slot-exists-p C 'key)
  217. (oref C key)))
  218. (showexample t)
  219. )
  220. (setq chl (cdr chl))
  221. (setq chl (append (aref (class-v C) class-children) chl))
  222. (catch 'skip
  223. (when (eq C 'srecode-template-inserter-section-end)
  224. (throw 'skip nil))
  225. (when (class-abstract-p C)
  226. (throw 'skip nil))
  227. (princ "`")
  228. (princ name)
  229. (princ "'")
  230. (when (slot-exists-p C 'key)
  231. (when key
  232. (princ " - Character Key: ")
  233. (if (stringp key)
  234. (progn
  235. (setq showexample nil)
  236. (cond ((string= key "\n")
  237. (princ "\"\\n\"")
  238. )
  239. (t
  240. (prin1 key)
  241. )))
  242. (prin1 (format "%c" key))
  243. )))
  244. (terpri)
  245. (princ (documentation-property C 'variable-documentation))
  246. (terpri)
  247. (when showexample
  248. (princ "Example:")
  249. (terpri)
  250. (srecode-inserter-prin-example C ess ees)
  251. )
  252. (terpri)
  253. ) ;; catch
  254. );; let*
  255. ))))
  256. ;;; Misc Language Overrides
  257. ;;
  258. (define-mode-local-override semantic-ia-insert-tag
  259. srecode-template-mode (tag)
  260. "Insert the SRecode TAG into the current buffer."
  261. (insert (semantic-tag-name tag)))
  262. ;;; Local Context Parsing.
  263. (defun srecode-in-macro-p (&optional point)
  264. "Non-nil if POINT is inside a macro bounds.
  265. If the ESCAPE_START and END are different sequences,
  266. a simple search is used. If ESCAPE_START and END are the same
  267. characters, start at the beginning of the line, and find out
  268. how many occur."
  269. (let ((tag (semantic-current-tag))
  270. (es (regexp-quote (srecode-template-get-escape-start)))
  271. (ee (regexp-quote (srecode-template-get-escape-end)))
  272. (start (or point (point)))
  273. )
  274. (when (and tag (semantic-tag-of-class-p tag 'function))
  275. (if (string= es ee)
  276. (save-excursion
  277. (beginning-of-line)
  278. (while (re-search-forward es start t 2))
  279. (if (re-search-forward es start t)
  280. ;; If there is a single, the answer is yes.
  281. t
  282. ;; If there wasn't another, then the answer is no.
  283. nil)
  284. )
  285. ;; ES And EE are not the same.
  286. (save-excursion
  287. (and (re-search-backward es (semantic-tag-start tag) t)
  288. (>= (or (re-search-forward ee (semantic-tag-end tag) t)
  289. ;; No end match means an incomplete macro.
  290. start)
  291. start)))
  292. ))))
  293. (defun srecode-up-context-get-name (&optional point find-unmatched)
  294. "Move up one context as for `semantic-up-context', and return the name.
  295. Moves point to the opening characters of the section macro text.
  296. If there is no upper context, return nil.
  297. Starts at POINT if provided.
  298. If FIND-UNMATCHED is specified as non-nil, then we are looking for an unmatched
  299. section."
  300. (when point (goto-char (point)))
  301. (let* ((tag (semantic-current-tag))
  302. (es (regexp-quote (srecode-template-get-escape-start)))
  303. (start (concat es "[#<]\\(\\w+\\)"))
  304. (orig (point))
  305. (name nil)
  306. (res nil))
  307. (when (semantic-tag-of-class-p tag 'function)
  308. (while (and (not res)
  309. (re-search-backward start (semantic-tag-start tag) t))
  310. (when (save-excursion
  311. (setq name (match-string 1))
  312. (let ((endr (concat es "/" name)))
  313. (if (re-search-forward endr (semantic-tag-end tag) t)
  314. (< orig (point))
  315. (if (not find-unmatched)
  316. (error "Unmatched Section Template")
  317. ;; We found what we want.
  318. t))))
  319. (setq res (point)))
  320. )
  321. ;; Restore in no result found.
  322. (goto-char (or res orig))
  323. name)))
  324. (define-mode-local-override semantic-up-context
  325. srecode-template-mode (&optional point)
  326. "Move up one context in the current code.
  327. Moves out one named section."
  328. (not (srecode-up-context-get-name point)))
  329. (define-mode-local-override semantic-beginning-of-context
  330. srecode-template-mode (&optional point)
  331. "Move to the beginning of the current context.
  332. Moves to the beginning of one named section."
  333. (if (semantic-up-context point)
  334. t
  335. (let ((es (regexp-quote (srecode-template-get-escape-start)))
  336. (ee (regexp-quote (srecode-template-get-escape-end))))
  337. (re-search-forward es) ;; move over the start chars.
  338. (re-search-forward ee) ;; Move after the end chars.
  339. nil)))
  340. (define-mode-local-override semantic-end-of-context
  341. srecode-template-mode (&optional point)
  342. "Move to the end of the current context.
  343. Moves to the end of one named section."
  344. (let ((name (srecode-up-context-get-name point))
  345. (tag (semantic-current-tag))
  346. (es (regexp-quote (srecode-template-get-escape-start))))
  347. (if (not name)
  348. t
  349. (unless (re-search-forward (concat es "/" name) (semantic-tag-end tag) t)
  350. (error "Section %s has no end" name))
  351. (goto-char (match-beginning 0))
  352. nil)))
  353. (define-mode-local-override semantic-get-local-variables
  354. srecode-template-mode (&optional point)
  355. "Get local variables from an SRecode template."
  356. (save-excursion
  357. (when point (goto-char (point)))
  358. (let* ((tag (semantic-current-tag))
  359. (name (save-excursion
  360. (srecode-up-context-get-name (point))))
  361. (subdicts (semantic-tag-get-attribute tag :dictionaries))
  362. (global nil)
  363. )
  364. (dolist (D subdicts)
  365. (setq global (cons (semantic-tag-new-variable (car D) nil)
  366. global)))
  367. (if name
  368. ;; Lookup any subdictionaries in TAG.
  369. (let ((res nil))
  370. (while (and (not res) subdicts)
  371. ;; Find the subdictionary with the same name. Those variables
  372. ;; are now local to this section.
  373. (when (string= (car (car subdicts)) name)
  374. (setq res (cdr (car subdicts))))
  375. (setq subdicts (cdr subdicts)))
  376. ;; Pre-pend our global vars.
  377. (append global res))
  378. ;; If we aren't in a subsection, just do the global variables
  379. global
  380. ))))
  381. (define-mode-local-override semantic-get-local-arguments
  382. srecode-template-mode (&optional point)
  383. "Get local arguments from an SRecode template."
  384. (require 'srecode/insert)
  385. (save-excursion
  386. (when point (goto-char (point)))
  387. (let* ((tag (semantic-current-tag))
  388. (args (semantic-tag-function-arguments tag))
  389. (argsym (mapcar 'intern args))
  390. (argvars nil)
  391. ;; Create a temporary dictionary in which the
  392. ;; arguments can be resolved so we can extract
  393. ;; the results.
  394. (dict (srecode-create-dictionary t))
  395. )
  396. ;; Resolve args into our temp dictionary
  397. (srecode-resolve-argument-list argsym dict)
  398. (maphash
  399. (lambda (key entry)
  400. (setq argvars
  401. (cons (semantic-tag-new-variable key nil entry)
  402. argvars)))
  403. (oref dict namehash))
  404. argvars)))
  405. (define-mode-local-override semantic-ctxt-current-symbol
  406. srecode-template-mode (&optional point)
  407. "Return the current symbol under POINT.
  408. Return nil if point is not on/in a template macro."
  409. (let ((macro (srecode-parse-this-macro point)))
  410. (cdr macro))
  411. )
  412. (defun srecode-parse-this-macro (&optional point)
  413. "Return the current symbol under POINT.
  414. Return nil if point is not on/in a template macro.
  415. The first element is the key for the current macro, such as # for a
  416. section or ? for an ask variable."
  417. (save-excursion
  418. (if point (goto-char point))
  419. (let ((tag (semantic-current-tag))
  420. (es (regexp-quote (srecode-template-get-escape-start)))
  421. (ee (regexp-quote (srecode-template-get-escape-end)))
  422. (start (point))
  423. (macrostart nil)
  424. (raw nil)
  425. )
  426. (when (and tag (semantic-tag-of-class-p tag 'function)
  427. (srecode-in-macro-p point)
  428. (re-search-backward es (semantic-tag-start tag) t))
  429. (setq macrostart (match-end 0))
  430. (goto-char macrostart)
  431. ;; We have a match
  432. (when (not (re-search-forward ee (semantic-tag-end tag) t))
  433. (goto-char start) ;; Pretend we are ok for completion
  434. (set-match-data (list start start))
  435. )
  436. (if (> start (point))
  437. ;; If our starting point is after the found point, that
  438. ;; means we are not inside the macro. Return nil.
  439. nil
  440. ;; We are inside the macro, extract the text so far.
  441. (let* ((macroend (match-beginning 0))
  442. (raw (buffer-substring-no-properties
  443. macrostart macroend))
  444. (STATE (srecode-compile-state "TMP"))
  445. (inserter (condition-case nil
  446. (srecode-compile-parse-inserter
  447. raw STATE)
  448. (error nil)))
  449. )
  450. (when inserter
  451. (let ((base
  452. (cons (oref inserter :object-name)
  453. (if (and (slot-boundp inserter :secondname)
  454. (oref inserter :secondname))
  455. (split-string (oref inserter :secondname)
  456. ":")
  457. nil)))
  458. (key (oref inserter key)))
  459. (cond ((null key)
  460. ;; A plain variable
  461. (cons nil base))
  462. (t
  463. ;; A complex variable thingy.
  464. (cons (format "%c" key)
  465. base)))))
  466. )
  467. )))
  468. ))
  469. (define-mode-local-override semantic-analyze-current-context
  470. srecode-template-mode (point)
  471. "Provide a Semantic analysis in SRecode template mode."
  472. (let* ((context-return nil)
  473. (prefixandbounds (semantic-ctxt-current-symbol-and-bounds))
  474. (prefix (car prefixandbounds))
  475. (bounds (nth 2 prefixandbounds))
  476. (key (car (srecode-parse-this-macro (point))))
  477. (prefixsym nil)
  478. (prefix-var nil)
  479. (prefix-context nil)
  480. (prefix-function nil)
  481. (prefixclass (semantic-ctxt-current-class-list))
  482. (globalvar (semantic-find-tags-by-class 'variable (current-buffer)))
  483. (argtype 'macro)
  484. (scope (semantic-calculate-scope point))
  485. )
  486. (oset scope fullscope (append (oref scope localvar) globalvar))
  487. (when prefix
  488. ;; First, try to find the variable for the first
  489. ;; entry in the prefix list.
  490. (setq prefix-var (semantic-find-first-tag-by-name
  491. (car prefix) (oref scope fullscope)))
  492. (cond
  493. ((and (or (not key) (string= key "?"))
  494. (> (length prefix) 1))
  495. ;; Variables can have lisp function names.
  496. (with-mode-local emacs-lisp-mode
  497. (let ((fcns (semanticdb-find-tags-by-name (car (last prefix)))))
  498. (setq prefix-function (car (semanticdb-find-result-nth fcns 0)))
  499. (setq argtype 'elispfcn)))
  500. )
  501. ((or (string= key "<") (string= key ">"))
  502. ;; Includes have second args that is the template name.
  503. (if (= (length prefix) 3)
  504. (let ((contexts (semantic-find-tags-by-class
  505. 'context (current-buffer))))
  506. (setq prefix-context
  507. (or (semantic-find-first-tag-by-name
  508. (nth 1 prefix) contexts)
  509. ;; Calculate from location
  510. (semantic-tag
  511. (symbol-name
  512. (srecode-template-current-context))
  513. 'context)))
  514. (setq argtype 'template))
  515. (setq prefix-context
  516. ;; Calculate from location
  517. (semantic-tag
  518. (symbol-name (srecode-template-current-context))
  519. 'context))
  520. (setq argtype 'template)
  521. )
  522. ;; The last one?
  523. (when (> (length prefix) 1)
  524. (let ((toc (srecode-template-find-templates-of-context
  525. (read (semantic-tag-name prefix-context))))
  526. )
  527. (setq prefix-function
  528. (or (semantic-find-first-tag-by-name
  529. (car (last prefix)) toc)
  530. ;; Not in this buffer? Search the master
  531. ;; templates list.
  532. nil))
  533. ))
  534. )
  535. )
  536. (setq prefixsym
  537. (cond ((= (length prefix) 3)
  538. (list (or prefix-var (nth 0 prefix))
  539. (or prefix-context (nth 1 prefix))
  540. (or prefix-function (nth 2 prefix))))
  541. ((= (length prefix) 2)
  542. (list (or prefix-var (nth 0 prefix))
  543. (or prefix-function (nth 1 prefix))))
  544. ((= (length prefix) 1)
  545. (list (or prefix-var (nth 0 prefix)))
  546. )))
  547. (setq context-return
  548. (semantic-analyze-context-functionarg
  549. "context-for-srecode"
  550. :buffer (current-buffer)
  551. :scope scope
  552. :bounds bounds
  553. :prefix (or prefixsym
  554. prefix)
  555. :prefixtypes nil
  556. :prefixclass prefixclass
  557. :errors nil
  558. ;; Use the functionarg analyzer class so we
  559. ;; can save the current key, and the index
  560. ;; into the macro part we are completing on.
  561. :function (list key)
  562. :index (length prefix)
  563. :argument (list argtype)
  564. ))
  565. context-return)))
  566. (define-mode-local-override semantic-analyze-possible-completions
  567. srecode-template-mode (context)
  568. "Return a list of possible completions based on NONTEXT."
  569. (with-current-buffer (oref context buffer)
  570. (let* ((prefix (car (last (oref context :prefix))))
  571. (prefixstr (cond ((stringp prefix)
  572. prefix)
  573. ((semantic-tag-p prefix)
  574. (semantic-tag-name prefix))))
  575. ; (completetext (cond ((semantic-tag-p prefix)
  576. ; (semantic-tag-name prefix))
  577. ; ((stringp prefix)
  578. ; prefix)
  579. ; ((stringp (car prefix))
  580. ; (car prefix))))
  581. (argtype (car (oref context :argument)))
  582. (matches nil))
  583. ;; Depending on what the analyzer is, we have different ways
  584. ;; of creating completions.
  585. (cond ((eq argtype 'template)
  586. (setq matches (semantic-find-tags-for-completion
  587. prefixstr (current-buffer)))
  588. (setq matches (semantic-find-tags-by-class
  589. 'function matches))
  590. )
  591. ((eq argtype 'elispfcn)
  592. (with-mode-local emacs-lisp-mode
  593. (setq matches (semanticdb-find-tags-for-completion
  594. prefixstr))
  595. (setq matches (semantic-find-tags-by-class
  596. 'function matches))
  597. )
  598. )
  599. ((eq argtype 'macro)
  600. (let ((scope (oref context scope)))
  601. (setq matches
  602. (semantic-find-tags-for-completion
  603. prefixstr (oref scope fullscope))))
  604. )
  605. )
  606. matches)))
  607. ;;; Utils
  608. ;;
  609. (defun srecode-template-get-mode ()
  610. "Get the supported major mode for this template file."
  611. (let ((m (semantic-find-first-tag-by-name "mode" (current-buffer))))
  612. (when m (read (semantic-tag-variable-default m)))))
  613. (defun srecode-template-get-escape-start ()
  614. "Get the current escape_start characters."
  615. (let ((es (semantic-find-first-tag-by-name "escape_start" (current-buffer)))
  616. )
  617. (if es (car (semantic-tag-get-attribute es :default-value))
  618. "{{")))
  619. (defun srecode-template-get-escape-end ()
  620. "Get the current escape_end characters."
  621. (let ((ee (semantic-find-first-tag-by-name "escape_end" (current-buffer)))
  622. )
  623. (if ee (car (semantic-tag-get-attribute ee :default-value))
  624. "}}")))
  625. (defun srecode-template-current-context (&optional point)
  626. "Calculate the context encompassing POINT."
  627. (save-excursion
  628. (when point (goto-char (point)))
  629. (let ((ct (semantic-current-tag)))
  630. (when (not ct)
  631. (setq ct (semantic-find-tag-by-overlay-prev)))
  632. ;; Loop till we find the context.
  633. (while (and ct (not (semantic-tag-of-class-p ct 'context)))
  634. (setq ct (semantic-find-tag-by-overlay-prev
  635. (semantic-tag-start ct))))
  636. (if ct
  637. (read (semantic-tag-name ct))
  638. 'declaration))))
  639. (defun srecode-template-find-templates-of-context (context &optional buffer)
  640. "Find all the templates belonging to a particular CONTEXT.
  641. When optional BUFFER is provided, search that buffer."
  642. (save-excursion
  643. (when buffer (set-buffer buffer))
  644. (let ((tags (semantic-fetch-available-tags))
  645. (cc 'declaration)
  646. (scan nil)
  647. (ans nil))
  648. (when (eq cc context)
  649. (setq scan t))
  650. (dolist (T tags)
  651. ;; Handle contexts
  652. (when (semantic-tag-of-class-p T 'context)
  653. (setq cc (read (semantic-tag-name T)))
  654. (when (eq cc context)
  655. (setq scan t)))
  656. ;; Scan
  657. (when (and scan (semantic-tag-of-class-p T 'function))
  658. (setq ans (cons T ans)))
  659. )
  660. (nreverse ans))))
  661. (provide 'srecode/srt-mode)
  662. ;; The autoloads in this file must go into the global loaddefs.el, not
  663. ;; the srecode one, so that srecode-template-mode can be called from
  664. ;; auto-mode-alist.
  665. ;; Local variables:
  666. ;; generated-autoload-load-name: "srecode/srt-mode"
  667. ;; End:
  668. ;;; srecode/srt-mode.el ends here