Mercurial > emacs
annotate lisp/cedet/srecode/srt-mode.el @ 107521:54f3a4d055ee
Document font-use-system-font.
* cmdargs.texi (Font X): Move most content to Fonts.
* frames.texi (Fonts): New node. Document font-use-system-font.
* emacs.texi (Top):
* xresources.texi (Table of Resources):
* mule.texi (Defining Fontsets, Charsets): Update xrefs.
| author | Chong Yidong <cyd@stupidchicken.com> |
|---|---|
| date | Sat, 20 Mar 2010 13:24:06 -0400 |
| parents | 1d1d5d9bd884 |
| children | 6e613fbf73d7 376148b31b5e |
| rev | line source |
|---|---|
| 104498 | 1 ;;; srecode/srt-mode.el --- Major mode for writing screcode macros |
| 2 | |
| 106815 | 3 ;; Copyright (C) 2005, 2007, 2008, 2009, 2010 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 | |
| 186 (defun srecode-template-mode () | |
|
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." |
| 104498 | 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 () | |
| 105328 | 235 "Provide help for working with macros in a template." |
| 104498 | 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 | |
| 105328 | 310 characters, start at the beginning of the line, and find out |
| 104498 | 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) | |
|
105423
309bc750556d
* files-x.el (modify-dir-local-variable)
Juanma Barranquero <lekktu@gmail.com>
parents:
105406
diff
changeset
|
323 ;; If there is a single, the answer is yes. |
| 104498 | 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. | |
|
105425
02f737c16cc4
* cedet/ede/makefile-edit.el (makefile-beginning-of-command)
Juanma Barranquero <lekktu@gmail.com>
parents:
105423
diff
changeset
|
378 Moves to the beginning of one named section." |
| 104498 | 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) | |
|
105425
02f737c16cc4
* cedet/ede/makefile-edit.el (makefile-beginning-of-command)
Juanma Barranquero <lekktu@gmail.com>
parents:
105423
diff
changeset
|
389 "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
|
390 Moves to the end of one named section." |
| 104498 | 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." | |
|
105799
3fe6da4a95a9
* cedet/srecode/srt-mode.el (semantic-analyze-possible-completions):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105425
diff
changeset
|
632 (with-current-buffer (oref context buffer) |
| 104498 | 633 (let* ((prefix (car (last (oref context :prefix)))) |
| 634 (prefixstr (cond ((stringp prefix) | |
| 635 prefix) | |
| 636 ((semantic-tag-p prefix) | |
| 637 (semantic-tag-name prefix)))) | |
| 638 ; (completetext (cond ((semantic-tag-p prefix) | |
| 639 ; (semantic-tag-name prefix)) | |
| 640 ; ((stringp prefix) | |
| 641 ; prefix) | |
| 642 ; ((stringp (car prefix)) | |
| 643 ; (car prefix)))) | |
| 644 (argtype (car (oref context :argument))) | |
| 645 (matches nil)) | |
| 646 | |
| 647 ;; Depending on what the analyzer is, we have different ways | |
| 648 ;; of creating completions. | |
| 649 (cond ((eq argtype 'template) | |
| 650 (setq matches (semantic-find-tags-for-completion | |
| 651 prefixstr (current-buffer))) | |
| 652 (setq matches (semantic-find-tags-by-class | |
| 653 'function matches)) | |
| 654 ) | |
| 655 ((eq argtype 'elispfcn) | |
| 656 (with-mode-local emacs-lisp-mode | |
| 657 (setq matches (semanticdb-find-tags-for-completion | |
| 658 prefixstr)) | |
| 659 (setq matches (semantic-find-tags-by-class | |
| 660 'function matches)) | |
| 661 ) | |
| 662 ) | |
| 663 ((eq argtype 'macro) | |
| 664 (let ((scope (oref context scope))) | |
| 665 (setq matches | |
| 666 (semantic-find-tags-for-completion | |
| 667 prefixstr (oref scope fullscope)))) | |
| 668 ) | |
| 669 ) | |
| 670 | |
| 671 matches))) | |
| 672 | |
| 673 | |
| 674 | |
| 675 ;;; Utils | |
| 676 ;; | |
| 677 (defun srecode-template-get-mode () | |
| 678 "Get the supported major mode for this template file." | |
| 679 (let ((m (semantic-find-first-tag-by-name "mode" (current-buffer)))) | |
| 680 (when m (read (semantic-tag-variable-default m))))) | |
| 681 | |
| 682 (defun srecode-template-get-escape-start () | |
| 683 "Get the current escape_start characters." | |
| 684 (let ((es (semantic-find-first-tag-by-name "escape_start" (current-buffer))) | |
| 685 ) | |
| 686 (if es (car (semantic-tag-get-attribute es :default-value)) | |
| 687 "{{"))) | |
| 688 | |
| 689 (defun srecode-template-get-escape-end () | |
| 690 "Get the current escape_end characters." | |
| 691 (let ((ee (semantic-find-first-tag-by-name "escape_end" (current-buffer))) | |
| 692 ) | |
| 693 (if ee (car (semantic-tag-get-attribute ee :default-value)) | |
| 694 "}}"))) | |
| 695 | |
| 696 (defun srecode-template-current-context (&optional point) | |
| 697 "Calculate the context encompassing POINT." | |
| 698 (save-excursion | |
| 699 (when point (goto-char (point))) | |
| 700 (let ((ct (semantic-current-tag))) | |
| 701 (when (not ct) | |
| 702 (setq ct (semantic-find-tag-by-overlay-prev))) | |
| 703 | |
| 704 ;; Loop till we find the context. | |
| 705 (while (and ct (not (semantic-tag-of-class-p ct 'context))) | |
| 706 (setq ct (semantic-find-tag-by-overlay-prev | |
| 707 (semantic-tag-start ct)))) | |
| 708 | |
| 709 (if ct | |
| 710 (read (semantic-tag-name ct)) | |
| 711 'declaration)))) | |
| 712 | |
| 713 (defun srecode-template-find-templates-of-context (context &optional buffer) | |
| 714 "Find all the templates belonging to a particular CONTEXT. | |
| 715 When optional BUFFER is provided, search that buffer." | |
| 716 (save-excursion | |
| 717 (when buffer (set-buffer buffer)) | |
| 718 (let ((tags (semantic-fetch-available-tags)) | |
| 719 (cc 'declaration) | |
| 720 (scan nil) | |
| 721 (ans nil)) | |
| 722 | |
| 723 (when (eq cc context) | |
| 724 (setq scan t)) | |
| 725 | |
| 726 (dolist (T tags) | |
| 727 ;; Handle contexts | |
| 728 (when (semantic-tag-of-class-p T 'context) | |
| 729 (setq cc (read (semantic-tag-name T))) | |
| 730 (when (eq cc context) | |
| 731 (setq scan t))) | |
| 732 | |
| 733 ;; Scan | |
| 734 (when (and scan (semantic-tag-of-class-p T 'function)) | |
| 735 (setq ans (cons T ans))) | |
| 736 ) | |
| 737 | |
| 738 (nreverse ans)))) | |
| 739 | |
| 740 (provide 'srecode/srt-mode) | |
| 741 | |
| 742 ;; The autoloads in this file must go into the global loaddefs.el, not | |
| 743 ;; the srecode one, so that srecode-template-mode can be called from | |
| 744 ;; auto-mode-alist. | |
| 745 | |
| 746 ;; Local variables: | |
| 747 ;; generated-autoload-load-name: "srecode/srt-mode" | |
| 748 ;; End: | |
| 749 | |
| 105377 | 750 ;; arch-tag: 9c613c25-d885-417a-8f0d-1824b26b22a5 |
| 104498 | 751 ;;; srecode/srt-mode.el ends here |
