aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorChong Yidong2009-08-28 14:51:35 +0000
committerChong Yidong2009-08-28 14:51:35 +0000
commite6b0a25d1a89d9b7c37dbc9de1bbc9fb7a0448f2 (patch)
treed33d7b6f49ed4a91d5b2971046572f2fe7eb09cc
parent02f122ca26158bbb650d6a416437cbdc8808ff89 (diff)
downloademacs-e6b0a25d1a89d9b7c37dbc9de1bbc9fb7a0448f2.tar.gz
emacs-e6b0a25d1a89d9b7c37dbc9de1bbc9fb7a0448f2.zip
Files removed.
Diffstat
-rw-r--r--lisp/cedet/semantic-fw.el530
-rw-r--r--lisp/cedet/semantic-lex.el2089
-rw-r--r--lisp/cedet/semantic-tag.el1569
3 files changed, 0 insertions, 4188 deletions
diff --git a/lisp/cedet/semantic-fw.el b/lisp/cedet/semantic-fw.el
deleted file mode 100644
index 7f8e1bd3103..00000000000
--- a/lisp/cedet/semantic-fw.el
+++ /dev/null
@@ -1,530 +0,0 @@
1;;; semantic-fw.el --- Framework for Semantic
2
3;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4;;; 2007, 2008, 2009 Free Software Foundation, Inc.
5
6;; Author: Eric M. Ludlam <zappo@gnu.org>
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24;;
25;; Semantic has several core features shared across it's lex/parse/util
26;; stages. This used to clutter semantic.el some. These routines are all
27;; simple things that are not parser specific, but aid in making
28;; semantic flexible and compatible amongst different Emacs platforms.
29
30;;; No Requirements.
31
32;;; Code:
33;;
34(require 'mode-local)
35(require 'eieio)
36
37;;; Compatibility
38;;
39(if (featurep 'xemacs)
40 (progn
41 (defalias 'semantic-buffer-local-value 'symbol-value-in-buffer)
42 (defalias 'semantic-overlay-live-p
43 (lambda (o)
44 (and (extent-live-p o)
45 (not (extent-detached-p o))
46 (bufferp (extent-buffer o)))))
47 (defalias 'semantic-make-overlay
48 (lambda (beg end &optional buffer &rest rest)
49 "Xemacs `make-extent', supporting the front/rear advance options."
50 (let ((ol (make-extent beg end buffer)))
51 (when rest
52 (set-extent-property ol 'start-open (car rest))
53 (setq rest (cdr rest)))
54 (when rest
55 (set-extent-property ol 'end-open (car rest)))
56 ol)))
57 (defalias 'semantic-overlay-put 'set-extent-property)
58 (defalias 'semantic-overlay-get 'extent-property)
59 (defalias 'semantic-overlay-properties 'extent-properties)
60 (defalias 'semantic-overlay-move 'set-extent-endpoints)
61 (defalias 'semantic-overlay-delete 'delete-extent)
62 (defalias 'semantic-overlays-at
63 (lambda (pos)
64 (condition-case nil
65 (extent-list nil pos pos)
66 (error nil))
67 ))
68 (defalias 'semantic-overlays-in
69 (lambda (beg end) (extent-list nil beg end)))
70 (defalias 'semantic-overlay-buffer 'extent-buffer)
71 (defalias 'semantic-overlay-start 'extent-start-position)
72 (defalias 'semantic-overlay-end 'extent-end-position)
73 (defalias 'semantic-overlay-size 'extent-length)
74 (defalias 'semantic-overlay-next-change 'next-extent-change)
75 (defalias 'semantic-overlay-previous-change 'previous-extent-change)
76 (defalias 'semantic-overlay-lists
77 (lambda () (list (extent-list))))
78 (defalias 'semantic-overlay-p 'extentp)
79 (defalias 'semantic-event-window 'event-window)
80 (defun semantic-read-event ()
81 (let ((event (next-command-event)))
82 (if (key-press-event-p event)
83 (let ((c (event-to-character event)))
84 (if (char-equal c (quit-char))
85 (keyboard-quit)
86 c)))
87 event))
88 (defun semantic-popup-menu (menu)
89 "Blockinig version of `popup-menu'"
90 (popup-menu menu)
91 ;; Wait...
92 (while (popup-up-p) (dispatch-event (next-event))))
93 )
94 ;; Emacs Bindings
95 (defalias 'semantic-buffer-local-value 'buffer-local-value)
96 (defalias 'semantic-overlay-live-p 'overlay-buffer)
97 (defalias 'semantic-make-overlay 'make-overlay)
98 (defalias 'semantic-overlay-put 'overlay-put)
99 (defalias 'semantic-overlay-get 'overlay-get)
100 (defalias 'semantic-overlay-properties 'overlay-properties)
101 (defalias 'semantic-overlay-move 'move-overlay)
102 (defalias 'semantic-overlay-delete 'delete-overlay)
103 (defalias 'semantic-overlays-at 'overlays-at)
104 (defalias 'semantic-overlays-in 'overlays-in)
105 (defalias 'semantic-overlay-buffer 'overlay-buffer)
106 (defalias 'semantic-overlay-start 'overlay-start)
107 (defalias 'semantic-overlay-end 'overlay-end)
108 (defalias 'semantic-overlay-size 'overlay-size)
109 (defalias 'semantic-overlay-next-change 'next-overlay-change)
110 (defalias 'semantic-overlay-previous-change 'previous-overlay-change)
111 (defalias 'semantic-overlay-lists 'overlay-lists)
112 (defalias 'semantic-overlay-p 'overlayp)
113 (defalias 'semantic-read-event 'read-event)
114 (defalias 'semantic-popup-menu 'popup-menu)
115 (defun semantic-event-window (event)
116 "Extract the window from EVENT."
117 (car (car (cdr event))))
118 )
119
120(if (and (not (featurep 'xemacs))
121 (>= emacs-major-version 21))
122 (defalias 'semantic-make-local-hook 'identity)
123 (defalias 'semantic-make-local-hook 'make-local-hook)
124 )
125
126(if (featurep 'xemacs)
127 (defalias 'semantic-mode-line-update 'redraw-modeline)
128 (defalias 'semantic-mode-line-update 'force-mode-line-update))
129
130;; Since Emacs 22 major mode functions should use `run-mode-hooks' to
131;; run major mode hooks.
132(defalias 'semantic-run-mode-hooks
133 (if (fboundp 'run-mode-hooks)
134 'run-mode-hooks
135 'run-hooks))
136
137;; Fancy compat useage now handled in cedet-compat
138(defalias 'semantic-subst-char-in-string 'subst-char-in-string)
139
140
141(defun semantic-delete-overlay-maybe (overlay)
142 "Delete OVERLAY if it is a semantic token overlay."
143 (if (semantic-overlay-get overlay 'semantic)
144 (semantic-overlay-delete overlay)))
145
146(defalias 'semantic-compile-warn
147 (eval-when-compile
148 (if (fboundp 'byte-compile-warn)
149 'byte-compile-warn
150 'message)))
151
152(if (not (fboundp 'string-to-number))
153 (defalias 'string-to-number 'string-to-int))
154
155;;; Menu Item compatibility
156;;
157(defun semantic-menu-item (item)
158 "Build an XEmacs compatible menu item from vector ITEM.
159That is remove the unsupported :help stuff."
160 (if (featurep 'xemacs)
161 (let ((n (length item))
162 (i 0)
163 slot l)
164 (while (< i n)
165 (setq slot (aref item i))
166 (if (and (keywordp slot)
167 (eq slot :help))
168 (setq i (1+ i))
169 (setq l (cons slot l)))
170 (setq i (1+ i)))
171 (apply #'vector (nreverse l)))
172 item))
173
174;;; Positional Data Cache
175;;
176(defvar semantic-cache-data-overlays nil
177 "List of all overlays waiting to be flushed.")
178
179(defun semantic-cache-data-to-buffer (buffer start end value name &optional lifespan)
180 "In BUFFER over the region START END, remember VALUE.
181NAME specifies a special name that can be searched for later to
182recover the cached data with `semantic-get-cache-data'.
183LIFESPAN indicates how long the data cache will be remembered.
184The default LIFESPAN is 'end-of-command.
185Possible Lifespans are:
186 'end-of-command - Remove the cache at the end of the currently
187 executing command.
188 'exit-cache-zone - Remove when point leaves the overlay at the
189 end of the currently executing command."
190 ;; Check if LIFESPAN is valid before to create any overlay
191 (or lifespan (setq lifespan 'end-of-command))
192 (or (memq lifespan '(end-of-command exit-cache-zone))
193 (error "semantic-cache-data-to-buffer: Unknown LIFESPAN: %s"
194 lifespan))
195 (let ((o (semantic-make-overlay start end buffer)))
196 (semantic-overlay-put o 'cache-name name)
197 (semantic-overlay-put o 'cached-value value)
198 (semantic-overlay-put o 'lifespan lifespan)
199 (setq semantic-cache-data-overlays
200 (cons o semantic-cache-data-overlays))
201 ;;(message "Adding to cache: %s" o)
202 (add-hook 'post-command-hook 'semantic-cache-data-post-command-hook)
203 ))
204
205(defun semantic-cache-data-post-command-hook ()
206 "Flush `semantic-cache-data-overlays' based 'lifespan property.
207Remove self from `post-command-hook' if it is empty."
208 (let ((newcache nil)
209 (oldcache semantic-cache-data-overlays))
210 (while oldcache
211 (let* ((o (car oldcache))
212 (life (semantic-overlay-get o 'lifespan))
213 )
214 (if (or (eq life 'end-of-command)
215 (and (eq life 'exit-cache-zone)
216 (not (member o (semantic-overlays-at (point))))))
217 (progn
218 ;;(message "Removing from cache: %s" o)
219 (semantic-overlay-delete o)
220 )
221 (setq newcache (cons o newcache))))
222 (setq oldcache (cdr oldcache)))
223 (setq semantic-cache-data-overlays (nreverse newcache)))
224
225 ;; Remove ourselves if we have removed all overlays.
226 (unless semantic-cache-data-overlays
227 (remove-hook 'post-command-hook
228 'semantic-cache-data-post-command-hook)))
229
230(defun semantic-get-cache-data (name &optional point)
231 "Get cached data with NAME from optional POINT."
232 (save-excursion
233 (if point (goto-char point))
234 (let ((o (semantic-overlays-at (point)))
235 (ans nil))
236 (while (and (not ans) o)
237 (if (equal (semantic-overlay-get (car o) 'cache-name) name)
238 (setq ans (car o))
239 (setq o (cdr o))))
240 (when ans
241 (semantic-overlay-get ans 'cached-value)))))
242
243(defun semantic-test-data-cache ()
244 "Test the data cache."
245 (interactive)
246 (let ((data '(a b c)))
247 (save-excursion
248 (set-buffer (get-buffer-create " *semantic-test-data-cache*"))
249 (erase-buffer)
250 (insert "The Moose is Loose")
251 (goto-char (point-min))
252 (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5)
253 data 'moose 'exit-cache-zone)
254 (if (equal (semantic-get-cache-data 'moose) data)
255 (message "Successfully retrieved cached data.")
256 (error "Failed to retrieve cached data"))
257 )))
258
259;;; Obsoleting various functions & variables
260;;
261(defun semantic-overload-symbol-from-function (name)
262 "Return the symbol for overload used by NAME, the defined symbol."
263 (let ((sym-name (symbol-name name)))
264 (if (string-match "^semantic-" sym-name)
265 (intern (substring sym-name (match-end 0)))
266 name)))
267
268(defun semantic-alias-obsolete (oldfnalias newfn)
269 "Make OLDFNALIAS an alias for NEWFN.
270Mark OLDFNALIAS as obsolete, such that the byte compiler
271will throw a warning when it encounters this symbol."
272 (defalias oldfnalias newfn)
273 (make-obsolete oldfnalias newfn)
274 (when (and (function-overload-p newfn)
275 (not (overload-obsoleted-by newfn))
276 ;; Only throw this warning when byte compiling things.
277 (boundp 'byte-compile-current-file)
278 byte-compile-current-file
279 (not (string-match "cedet" byte-compile-current-file))
280 )
281 (make-obsolete-overload oldfnalias newfn)
282 (semantic-compile-warn
283 "%s: `%s' obsoletes overload `%s'"
284 byte-compile-current-file
285 newfn
286 (semantic-overload-symbol-from-function oldfnalias))
287 ))
288
289(defun semantic-varalias-obsolete (oldvaralias newvar)
290 "Make OLDVARALIAS an alias for variable NEWVAR.
291Mark OLDVARALIAS as obsolete, such that the byte compiler
292will throw a warning when it encounters this symbol."
293 (make-obsolete-variable oldvaralias newvar)
294 (condition-case nil
295 (defvaralias oldvaralias newvar)
296 (error
297 ;; Only throw this warning when byte compiling things.
298 (when (and (boundp 'byte-compile-current-file)
299 byte-compile-current-file)
300 (semantic-compile-warn
301 "variable `%s' obsoletes, but isn't alias of `%s'"
302 newvar oldvaralias)
303 ))))
304
305;;; Help debugging
306;;
307(defmacro semantic-safe (format &rest body)
308 "Turn into a FORMAT message any error caught during eval of BODY.
309Return the value of last BODY form or nil if an error occurred.
310FORMAT can have a %s escape which will be replaced with the actual
311error message.
312If `debug-on-error' is set, errors are not caught, so that you can
313debug them.
314Avoid using a large BODY since it is duplicated."
315 ;;(declare (debug t) (indent 1))
316 `(if debug-on-error
317 ;;(let ((inhibit-quit nil)) ,@body)
318 ;; Note to self: Doing the above screws up the wisent parser.
319 (progn ,@body)
320 (condition-case err
321 (progn ,@body)
322 (error
323 (message ,format (format "%S - %s" (current-buffer)
324 (error-message-string err)))
325 nil))))
326(put 'semantic-safe 'lisp-indent-function 1)
327
328;;; Misc utilities
329;;
330(defsubst semantic-map-buffers (function)
331 "Run FUNCTION for each Semantic enabled buffer found.
332FUNCTION does not have arguments. When FUNCTION is entered
333`current-buffer' is a selected Semantic enabled buffer."
334 (mode-local-map-file-buffers function #'semantic-active-p))
335
336(defalias 'semantic-map-mode-buffers
337 'mode-local-map-mode-buffers)
338
339(semantic-alias-obsolete 'semantic-fetch-overload
340 'fetch-overload)
341
342(semantic-alias-obsolete 'define-mode-overload-implementation
343 'define-mode-local-override)
344
345(semantic-alias-obsolete 'semantic-with-mode-bindings
346 'with-mode-local)
347
348(semantic-alias-obsolete 'define-semantic-child-mode
349 'define-child-mode)
350
351(defun semantic-install-function-overrides (overrides &optional transient mode)
352 "Install the function OVERRIDES in the specified environment.
353OVERRIDES must be an alist ((OVERLOAD . FUNCTION) ...) where OVERLOAD
354is a symbol identifying an overloadable entry, and FUNCTION is the
355function to override it with.
356If optional argument TRANSIENT is non-nil, installed overrides can in
357turn be overridden by next installation.
358If optional argument MODE is non-nil, it must be a major mode symbol.
359OVERRIDES will be installed globally for this major mode. If MODE is
360nil, OVERRIDES will be installed locally in the current buffer. This
361later installation should be done in MODE hook."
362 (mode-local-bind
363 ;; Add the semantic- prefix to OVERLOAD short names.
364 (mapcar
365 #'(lambda (e)
366 (let ((name (symbol-name (car e))))
367 (if (string-match "^semantic-" name)
368 e
369 (cons (intern (format "semantic-%s" name)) (cdr e)))))
370 overrides)
371 (list 'constant-flag (not transient)
372 'override-flag t)
373 mode))
374
375;;; User Interrupt handling
376;;
377(defvar semantic-current-input-throw-symbol nil
378 "The current throw symbol for `semantic-exit-on-input'.")
379
380(defmacro semantic-exit-on-input (symbol &rest forms)
381 "Using SYMBOL as an argument to `throw', execute FORMS.
382If FORMS includes a call to `semantic-thow-on-input', then
383if a user presses any key during execution, this form macro
384will exit with the value passed to `semantic-throw-on-input'.
385If FORMS completes, then the return value is the same as `progn'."
386 `(let ((semantic-current-input-throw-symbol ,symbol))
387 (catch ,symbol
388 ,@forms)))
389(put 'semantic-exit-on-input 'lisp-indent-function 1)
390
391(defmacro semantic-throw-on-input (from)
392 "Exit with `throw' when in `semantic-exit-on-input' on user input.
393FROM is an indication of where this function is called from as a value
394to pass to `throw'. It is recommended to use the name of the function
395calling this one."
396 `(when (and semantic-current-input-throw-symbol
397 (or (input-pending-p) (accept-process-output)))
398 (throw semantic-current-input-throw-symbol ,from)))
399
400(defun semantic-test-throw-on-input ()
401 "Test that throw on input will work."
402 (interactive)
403 (semantic-throw-on-input 'done-die)
404 (message "Exit Code: %s"
405 (semantic-exit-on-input 'testing
406 (let ((inhibit-quit nil)
407 (message-log-max nil))
408 (while t
409 (message "Looping ... press a key to test")
410 (semantic-throw-on-input 'test-inner-loop))
411 'exit)))
412 (when (input-pending-p)
413 (if (fboundp 'read-event)
414 (read-event)
415 (read-char)))
416 )
417
418;;; Special versions of Find File
419;;
420(defun semantic-find-file-noselect (file &optional nowarn rawfile wildcards)
421 "Call `find-file-noselect' with various features turned off.
422Use this when referencing a file that will be soon deleted.
423FILE, NOWARN, RAWFILE, and WILDCARDS are passed into `find-file-noselect'"
424 (let* ((recentf-exclude '( (lambda (f) t) ))
425 ;; This is a brave statement. Don't waste time loading in
426 ;; lots of modes. Especially decoration mode can waste a lot
427 ;; of time for a buffer we intend to kill.
428 (semantic-init-hooks nil)
429 ;; This disables the part of EDE that asks questions
430 (ede-auto-add-method 'never)
431 ;; Ask font-lock to not colorize these buffers, nor to
432 ;; whine about it either.
433 (font-lock-maximum-size 0)
434 (font-lock-verbose nil)
435 ;; Disable revision control
436 (vc-handled-backends nil)
437 ;; Don't prompt to insert a template if we visit an empty file
438 (auto-insert nil)
439 ;; We don't want emacs to query about unsafe local variables
440 (enable-local-variables
441 (if (featurep 'xemacs)
442 ;; XEmacs only has nil as an option?
443 nil
444 ;; Emacs 23 has the spiffy :safe option, nil otherwise.
445 (if (>= emacs-major-version 22)
446 nil
447 :safe)))
448 ;; ... or eval variables
449 (enable-local-eval nil)
450 )
451 (if (featurep 'xemacs)
452 (find-file-noselect file nowarn rawfile)
453 (find-file-noselect file nowarn rawfile wildcards))
454 ))
455
456
457;;; Editor goodies ;-)
458;;
459(defconst semantic-fw-font-lock-keywords
460 (eval-when-compile
461 (let* (
462 ;; Variable declarations
463 (vl nil)
464 (kv (if vl (regexp-opt vl t) ""))
465 ;; Function declarations
466 (vf '(
467 "define-lex"
468 "define-lex-analyzer"
469 "define-lex-block-analyzer"
470 "define-lex-regex-analyzer"
471 "define-lex-spp-macro-declaration-analyzer"
472 "define-lex-spp-macro-undeclaration-analyzer"
473 "define-lex-spp-include-analyzer"
474 "define-lex-simple-regex-analyzer"
475 "define-lex-keyword-type-analyzer"
476 "define-lex-sexp-type-analyzer"
477 "define-lex-regex-type-analyzer"
478 "define-lex-string-type-analyzer"
479 "define-lex-block-type-analyzer"
480 ;;"define-mode-overload-implementation"
481 ;;"define-semantic-child-mode"
482 "define-semantic-idle-service"
483 "define-semantic-decoration-style"
484 "define-wisent-lexer"
485 "semantic-alias-obsolete"
486 "semantic-varalias-obsolete"
487 "semantic-make-obsolete-overload"
488 "defcustom-mode-local-semantic-dependency-system-include-path"
489 ))
490 (kf (if vf (regexp-opt vf t) ""))
491 ;; Regexp depths
492 (kv-depth (if kv (regexp-opt-depth kv) nil))
493 (kf-depth (if kf (regexp-opt-depth kf) nil))
494 )
495 `((,(concat
496 ;; Declarative things
497 "(\\(" kv "\\|" kf "\\)"
498 ;; Whitespaces & names
499 "\\>[ \t]*\\(\\sw+\\)?[ \t]*\\(\\sw+\\)?"
500 )
501 (1 font-lock-keyword-face)
502 (,(+ 1 kv-depth kf-depth 1)
503 (cond ((match-beginning 2)
504 font-lock-type-face)
505 ((match-beginning ,(+ 1 kv-depth 1))
506 font-lock-function-name-face)
507 )
508 nil t)
509 (,(+ 1 kv-depth kf-depth 1 1)
510 (cond ((match-beginning 2)
511 font-lock-variable-name-face)
512 )
513 nil t)))
514 ))
515 "Highlighted Semantic keywords.")
516
517;; (when (fboundp 'font-lock-add-keywords)
518;; (font-lock-add-keywords 'emacs-lisp-mode
519;; semantic-fw-font-lock-keywords))
520
521;;; Interfacing with edebug
522;;
523(defun semantic-fw-add-edebug-spec ()
524 (def-edebug-spec semantic-exit-on-input 'def-body))
525
526(add-hook 'edebug-setup-hook 'semantic-fw-add-edebug-spec)
527
528(provide 'semantic-fw)
529
530;;; semantic-fw.el ends here
diff --git a/lisp/cedet/semantic-lex.el b/lisp/cedet/semantic-lex.el
deleted file mode 100644
index 171cd6cd04d..00000000000
--- a/lisp/cedet/semantic-lex.el
+++ /dev/null
@@ -1,2089 +0,0 @@
1;;; semantic-lex.el --- Lexical Analyzer builder
2
3;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4;;; 2007, 2008, 2009 Free Software Foundation, Inc.
5
6;; Author: Eric M. Ludlam <zappo@gnu.org>
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24;;
25;; This file handles the creation of lexical analyzers for different
26;; languages in Emacs Lisp. The purpose of a lexical analyzer is to
27;; convert a buffer into a list of lexical tokens. Each token
28;; contains the token class (such as 'number, 'symbol, 'IF, etc) and
29;; the location in the buffer it was found. Optionally, a token also
30;; contains a string representing what is at the designated buffer
31;; location.
32;;
33;; Tokens are pushed onto a token stream, which is basically a list of
34;; all the lexical tokens from the analyzed region. The token stream
35;; is then handed to the grammar which parsers the file.
36;;
37;;; How it works
38;;
39;; Each analyzer specifies a condition and forms. These conditions
40;; and forms are assembled into a function by `define-lex' that does
41;; the lexical analysis.
42;;
43;; In the lexical analyzer created with `define-lex', each condition
44;; is tested for a given point. When the conditin is true, the forms
45;; run.
46;;
47;; The forms can push a lexical token onto the token stream. The
48;; analyzer forms also must move the current analyzer point. If the
49;; analyzer point is moved without pushing a token, then tne matched
50;; syntax is effectively ignored, or skipped.
51;;
52;; Thus, starting at the beginning of a region to be analyzed, each
53;; condition is tested. One will match, and a lexical token might be
54;; pushed, and the point is moved to the end of the lexical token
55;; identified. At the new position, the process occurs again until
56;; the end of the specified region is reached.
57;;
58;;; How to use semantic-lex
59;;
60;; To create a lexer for a language, use the `define-lex' macro.
61;;
62;; The `define-lex' macro accepts a list of lexical analyzers. Each
63;; analyzer is created with `define-lex-analyzer', or one of the
64;; derivitive macros. A single analyzer defines a regular expression
65;; to match text in a buffer, and a short segment of code to create
66;; one lexical token.
67;;
68;; Each analyzer has a NAME, DOC, a CONDITION, and possibly some
69;; FORMS. The NAME is the name used in `define-lex'. The DOC
70;; describes what the analyzer should do.
71;;
72;; The CONDITION evaluates the text at the current point in the
73;; current buffer. If CONDITION is true, then the FORMS will be
74;; executed.
75;;
76;; The purpose of the FORMS is to push new lexical tokens onto the
77;; list of tokens for the current buffer, and to move point after the
78;; matched text.
79;;
80;; Some macros for creating one analyzer are:
81;;
82;; define-lex-analyzer - A generic analyzer associating any style of
83;; condition to forms.
84;; define-lex-regex-analyzer - Matches a regular expression.
85;; define-lex-simple-regex-analyzer - Matches a regular expressions,
86;; and pushes the match.
87;; define-lex-block-analyzer - Matches list syntax, and defines
88;; handles open/close delimiters.
89;;
90;; These macros are used by the grammar compiler when lexical
91;; information is specified in a grammar:
92;; define-lex- * -type-analyzer - Matches syntax specified in
93;; a grammar, and pushes one token for it. The * would
94;; be `sexp' for things like lists or strings, and
95;; `string' for things that need to match some special
96;; string, such as "\\." where a literal match is needed.
97;;
98;;; Lexical Tables
99;;
100;; There are tables of different symbols managed in semantic-lex.el.
101;; They are:
102;;
103;; Lexical keyword table - A Table of symbols declared in a grammar
104;; file with the %keyword declaration.
105;; Keywords are used by `semantic-lex-symbol-or-keyword'
106;; to create lexical tokens based on the keyword.
107;;
108;; Lexical type table - A table of symbols declared in a grammer
109;; file with the %type declaration.
110;; The grammar compiler uses the type table to create new
111;; lexical analyzers. These analyzers are then used to when
112;; a new lexical analyzer is made for a language.
113;;
114;;; Lexical Types
115;;
116;; A lexical type defines a kind of lexical analyzer that will be
117;; automatically generated from a grammar file based on some
118;; predetermined attributes. For now these two attributes are
119;; recognized :
120;;
121;; * matchdatatype : define the kind of lexical analyzer. That is :
122;;
123;; - regexp : define a regexp analyzer (see
124;; `define-lex-regex-type-analyzer')
125;;
126;; - string : define a string analyzer (see
127;; `define-lex-string-type-analyzer')
128;;
129;; - block : define a block type analyzer (see
130;; `define-lex-block-type-analyzer')
131;;
132;; - sexp : define a sexp analyzer (see
133;; `define-lex-sexp-type-analyzer')
134;;
135;; - keyword : define a keyword analyzer (see
136;; `define-lex-keyword-type-analyzer')
137;;
138;; * syntax : define the syntax that matches a syntactic
139;; expression. When syntax is matched the corresponding type
140;; analyzer is entered and the resulting match data will be
141;; interpreted based on the kind of analyzer (see matchdatatype
142;; above).
143;;
144;; The following lexical types are predefined :
145;;
146;; +-------------+---------------+--------------------------------+
147;; | type | matchdatatype | syntax |
148;; +-------------+---------------+--------------------------------+
149;; | punctuation | string | "\\(\\s.\\|\\s$\\|\\s'\\)+" |
150;; | keyword | keyword | "\\(\\sw\\|\\s_\\)+" |
151;; | symbol | regexp | "\\(\\sw\\|\\s_\\)+" |
152;; | string | sexp | "\\s\"" |
153;; | number | regexp | semantic-lex-number-expression |
154;; | block | block | "\\s(\\|\\s)" |
155;; +-------------+---------------+--------------------------------+
156;;
157;; In a grammar you must use a %type expression to automatically generate
158;; the corresponding analyzers of that type.
159;;
160;; Here is an example to auto-generate punctuation analyzers
161;; with 'matchdatatype and 'syntax predefined (see table above)
162;;
163;; %type <punctuation> ;; will auto-generate this kind of analyzers
164;;
165;; It is equivalent to write :
166;;
167;; %type <punctuation> syntax "\\(\\s.\\|\\s$\\|\\s'\\)+" matchdatatype string
168;;
169;; ;; Some punctuations based on the type defines above
170;;
171;; %token <punctuation> NOT "!"
172;; %token <punctuation> NOTEQ "!="
173;; %token <punctuation> MOD "%"
174;; %token <punctuation> MODEQ "%="
175;;
176
177;;; On the Semantic 1.x lexer
178;;
179;; In semantic 1.x, the lexical analyzer was an all purpose routine.
180;; To boost efficiency, the analyzer is now a series of routines that
181;; are constructed at build time into a single routine. This will
182;; eliminate unneeded if statements to speed the lexer.
183
184(require 'semantic-fw)
185;;; Code:
186
187;;; Compatibility
188;;
189(eval-and-compile
190 (if (not (fboundp 'with-syntax-table))
191
192;; Copied from Emacs 21 for compatibility with released Emacses.
193(defmacro with-syntax-table (table &rest body)
194 "With syntax table of current buffer set to a copy of TABLE, evaluate BODY.
195The syntax table of the current buffer is saved, BODY is evaluated, and the
196saved table is restored, even in case of an abnormal exit.
197Value is what BODY returns."
198 (let ((old-table (make-symbol "table"))
199 (old-buffer (make-symbol "buffer")))
200 `(let ((,old-table (syntax-table))
201 (,old-buffer (current-buffer)))
202 (unwind-protect
203 (progn
204 (set-syntax-table (copy-syntax-table ,table))
205 ,@body)
206 (save-current-buffer
207 (set-buffer ,old-buffer)
208 (set-syntax-table ,old-table))))))
209
210))
211
212;;; Semantic 2.x lexical analysis
213;;
214(defun semantic-lex-map-symbols (fun table &optional property)
215 "Call function FUN on every symbol in TABLE.
216If optional PROPERTY is non-nil, call FUN only on every symbol which
217as a PROPERTY value. FUN receives a symbol as argument."
218 (if (arrayp table)
219 (mapatoms
220 #'(lambda (symbol)
221 (if (or (null property) (get symbol property))
222 (funcall fun symbol)))
223 table)))
224
225;;; Lexical keyword table handling.
226;;
227;; These keywords are keywords defined for using in a grammar with the
228;; %keyword declaration, and are not keywords used in Emacs Lisp.
229
230(defvar semantic-flex-keywords-obarray nil
231 "Buffer local keyword obarray for the lexical analyzer.
232These keywords are matched explicitly, and converted into special symbols.")
233(make-variable-buffer-local 'semantic-flex-keywords-obarray)
234
235(defmacro semantic-lex-keyword-invalid (name)
236 "Signal that NAME is an invalid keyword name."
237 `(signal 'wrong-type-argument '(semantic-lex-keyword-p ,name)))
238
239(defsubst semantic-lex-keyword-symbol (name)
240 "Return keyword symbol with NAME or nil if not found."
241 (and (arrayp semantic-flex-keywords-obarray)
242 (stringp name)
243 (intern-soft name semantic-flex-keywords-obarray)))
244
245(defsubst semantic-lex-keyword-p (name)
246 "Return non-nil if a keyword with NAME exists in the keyword table.
247Return nil otherwise."
248 (and (setq name (semantic-lex-keyword-symbol name))
249 (symbol-value name)))
250
251(defsubst semantic-lex-keyword-set (name value)
252 "Set value of keyword with NAME to VALUE and return VALUE."
253 (set (intern name semantic-flex-keywords-obarray) value))
254
255(defsubst semantic-lex-keyword-value (name)
256 "Return value of keyword with NAME.
257Signal an error if a keyword with NAME does not exist."
258 (let ((keyword (semantic-lex-keyword-symbol name)))
259 (if keyword
260 (symbol-value keyword)
261 (semantic-lex-keyword-invalid name))))
262
263(defsubst semantic-lex-keyword-put (name property value)
264 "For keyword with NAME, set its PROPERTY to VALUE."
265 (let ((keyword (semantic-lex-keyword-symbol name)))
266 (if keyword
267 (put keyword property value)
268 (semantic-lex-keyword-invalid name))))
269
270(defsubst semantic-lex-keyword-get (name property)
271 "For keyword with NAME, return its PROPERTY value."
272 (let ((keyword (semantic-lex-keyword-symbol name)))
273 (if keyword
274 (get keyword property)
275 (semantic-lex-keyword-invalid name))))
276
277(defun semantic-lex-make-keyword-table (specs &optional propspecs)
278 "Convert keyword SPECS into an obarray and return it.
279SPECS must be a list of (NAME . TOKSYM) elements, where:
280
281 NAME is the name of the keyword symbol to define.
282 TOKSYM is the lexical token symbol of that keyword.
283
284If optional argument PROPSPECS is non nil, then interpret it, and
285apply those properties.
286PROPSPECS must be a list of (NAME PROPERTY VALUE) elements."
287 ;; Create the symbol hash table
288 (let ((semantic-flex-keywords-obarray (make-vector 13 0))
289 spec)
290 ;; fill it with stuff
291 (while specs
292 (setq spec (car specs)
293 specs (cdr specs))
294 (semantic-lex-keyword-set (car spec) (cdr spec)))
295 ;; Apply all properties
296 (while propspecs
297 (setq spec (car propspecs)
298 propspecs (cdr propspecs))
299 (semantic-lex-keyword-put (car spec) (nth 1 spec) (nth 2 spec)))
300 semantic-flex-keywords-obarray))
301
302(defsubst semantic-lex-map-keywords (fun &optional property)
303 "Call function FUN on every lexical keyword.
304If optional PROPERTY is non-nil, call FUN only on every keyword which
305as a PROPERTY value. FUN receives a lexical keyword as argument."
306 (semantic-lex-map-symbols
307 fun semantic-flex-keywords-obarray property))
308
309(defun semantic-lex-keywords (&optional property)
310 "Return a list of lexical keywords.
311If optional PROPERTY is non-nil, return only keywords which have a
312PROPERTY set."
313 (let (keywords)
314 (semantic-lex-map-keywords
315 #'(lambda (symbol) (setq keywords (cons symbol keywords)))
316 property)
317 keywords))
318
319;;; Type table handling.
320;;
321;; The lexical type table manages types that occur in a grammar file
322;; with the %type declaration. Types represent different syntaxes.
323;; See code for `semantic-lex-preset-default-types' for the classic
324;; types of syntax.
325(defvar semantic-lex-types-obarray nil
326 "Buffer local types obarray for the lexical analyzer.")
327(make-variable-buffer-local 'semantic-lex-types-obarray)
328
329(defmacro semantic-lex-type-invalid (type)
330 "Signal that TYPE is an invalid lexical type name."
331 `(signal 'wrong-type-argument '(semantic-lex-type-p ,type)))
332
333(defsubst semantic-lex-type-symbol (type)
334 "Return symbol with TYPE or nil if not found."
335 (and (arrayp semantic-lex-types-obarray)
336 (stringp type)
337 (intern-soft type semantic-lex-types-obarray)))
338
339(defsubst semantic-lex-type-p (type)
340 "Return non-nil if a symbol with TYPE name exists."
341 (and (setq type (semantic-lex-type-symbol type))
342 (symbol-value type)))
343
344(defsubst semantic-lex-type-set (type value)
345 "Set value of symbol with TYPE name to VALUE and return VALUE."
346 (set (intern type semantic-lex-types-obarray) value))
347
348(defsubst semantic-lex-type-value (type &optional noerror)
349 "Return value of symbol with TYPE name.
350If optional argument NOERROR is non-nil return nil if a symbol with
351TYPE name does not exist. Otherwise signal an error."
352 (let ((sym (semantic-lex-type-symbol type)))
353 (if sym
354 (symbol-value sym)
355 (unless noerror
356 (semantic-lex-type-invalid type)))))
357
358(defsubst semantic-lex-type-put (type property value &optional add)
359 "For symbol with TYPE name, set its PROPERTY to VALUE.
360If optional argument ADD is non-nil, create a new symbol with TYPE
361name if it does not already exist. Otherwise signal an error."
362 (let ((sym (semantic-lex-type-symbol type)))
363 (unless sym
364 (or add (semantic-lex-type-invalid type))
365 (semantic-lex-type-set type nil)
366 (setq sym (semantic-lex-type-symbol type)))
367 (put sym property value)))
368
369(defsubst semantic-lex-type-get (type property &optional noerror)
370 "For symbol with TYPE name, return its PROPERTY value.
371If optional argument NOERROR is non-nil return nil if a symbol with
372TYPE name does not exist. Otherwise signal an error."
373 (let ((sym (semantic-lex-type-symbol type)))
374 (if sym
375 (get sym property)
376 (unless noerror
377 (semantic-lex-type-invalid type)))))
378
379(defun semantic-lex-preset-default-types ()
380 "Install useful default properties for well known types."
381 (semantic-lex-type-put "punctuation" 'matchdatatype 'string t)
382 (semantic-lex-type-put "punctuation" 'syntax "\\(\\s.\\|\\s$\\|\\s'\\)+")
383 (semantic-lex-type-put "keyword" 'matchdatatype 'keyword t)
384 (semantic-lex-type-put "keyword" 'syntax "\\(\\sw\\|\\s_\\)+")
385 (semantic-lex-type-put "symbol" 'matchdatatype 'regexp t)
386 (semantic-lex-type-put "symbol" 'syntax "\\(\\sw\\|\\s_\\)+")
387 (semantic-lex-type-put "string" 'matchdatatype 'sexp t)
388 (semantic-lex-type-put "string" 'syntax "\\s\"")
389 (semantic-lex-type-put "number" 'matchdatatype 'regexp t)
390 (semantic-lex-type-put "number" 'syntax 'semantic-lex-number-expression)
391 (semantic-lex-type-put "block" 'matchdatatype 'block t)
392 (semantic-lex-type-put "block" 'syntax "\\s(\\|\\s)")
393 )
394
395(defun semantic-lex-make-type-table (specs &optional propspecs)
396 "Convert type SPECS into an obarray and return it.
397SPECS must be a list of (TYPE . TOKENS) elements, where:
398
399 TYPE is the name of the type symbol to define.
400 TOKENS is an list of (TOKSYM . MATCHER) elements, where:
401
402 TOKSYM is any lexical token symbol.
403 MATCHER is a string or regexp a text must match to be a such
404 lexical token.
405
406If optional argument PROPSPECS is non nil, then interpret it, and
407apply those properties.
408PROPSPECS must be a list of (TYPE PROPERTY VALUE)."
409 ;; Create the symbol hash table
410 (let* ((semantic-lex-types-obarray (make-vector 13 0))
411 spec type tokens token alist default)
412 ;; fill it with stuff
413 (while specs
414 (setq spec (car specs)
415 specs (cdr specs)
416 type (car spec)
417 tokens (cdr spec)
418 default nil
419 alist nil)
420 (while tokens
421 (setq token (car tokens)
422 tokens (cdr tokens))
423 (if (cdr token)
424 (setq alist (cons token alist))
425 (setq token (car token))
426 (if default
427 (message
428 "*Warning* default value of <%s> tokens changed to %S, was %S"
429 type default token))
430 (setq default token)))
431 ;; Ensure the default matching spec is the first one.
432 (semantic-lex-type-set type (cons default (nreverse alist))))
433 ;; Install useful default types & properties
434 (semantic-lex-preset-default-types)
435 ;; Apply all properties
436 (while propspecs
437 (setq spec (car propspecs)
438 propspecs (cdr propspecs))
439 ;; Create the type if necessary.
440 (semantic-lex-type-put (car spec) (nth 1 spec) (nth 2 spec) t))
441 semantic-lex-types-obarray))
442
443(defsubst semantic-lex-map-types (fun &optional property)
444 "Call function FUN on every lexical type.
445If optional PROPERTY is non-nil, call FUN only on every type symbol
446which as a PROPERTY value. FUN receives a type symbol as argument."
447 (semantic-lex-map-symbols
448 fun semantic-lex-types-obarray property))
449
450(defun semantic-lex-types (&optional property)
451 "Return a list of lexical type symbols.
452If optional PROPERTY is non-nil, return only type symbols which have
453PROPERTY set."
454 (let (types)
455 (semantic-lex-map-types
456 #'(lambda (symbol) (setq types (cons symbol types)))
457 property)
458 types))
459
460;;; Lexical Analyzer framework settings
461;;
462
463(defvar semantic-lex-analyzer 'semantic-flex
464 "The lexical analyzer used for a given buffer.
465See `semantic-lex' for documentation.
466For compatibility with Semantic 1.x it defaults to `semantic-flex'.")
467(make-variable-buffer-local 'semantic-lex-analyzer)
468
469(defvar semantic-lex-tokens
470 '(
471 (bol)
472 (charquote)
473 (close-paren)
474 (comment)
475 (newline)
476 (open-paren)
477 (punctuation)
478 (semantic-list)
479 (string)
480 (symbol)
481 (whitespace)
482 )
483 "An alist of of semantic token types.
484As of December 2001 (semantic 1.4beta13), this variable is not used in
485any code. The only use is to refer to the doc-string from elsewhere.
486
487The key to this alist is the symbol representing token type that
488\\[semantic-flex] returns. These are
489
490 - bol: Empty string matching a beginning of line.
491 This token is produced with
492 `semantic-lex-beginning-of-line'.
493
494 - charquote: String sequences that match `\\s\\+' regexp.
495 This token is produced with `semantic-lex-charquote'.
496
497 - close-paren: Characters that match `\\s)' regexp.
498 These are typically `)', `}', `]', etc.
499 This token is produced with
500 `semantic-lex-close-paren'.
501
502 - comment: A comment chunk. These token types are not
503 produced by default.
504 This token is produced with `semantic-lex-comments'.
505 Comments are ignored with `semantic-lex-ignore-comments'.
506 Comments are treated as whitespace with
507 `semantic-lex-comments-as-whitespace'.
508
509 - newline Characters matching `\\s-*\\(\n\\|\\s>\\)' regexp.
510 This token is produced with `semantic-lex-newline'.
511
512 - open-paren: Characters that match `\\s(' regexp.
513 These are typically `(', `{', `[', etc.
514 If `semantic-lex-paren-or-list' is used,
515 then `open-paren' is not usually generated unless
516 the `depth' argument to \\[semantic-lex] is
517 greater than 0.
518 This token is always produced if the analyzer
519 `semantic-lex-open-paren' is used.
520
521 - punctuation: Characters matching `{\\(\\s.\\|\\s$\\|\\s'\\)'
522 regexp.
523 This token is produced with `semantic-lex-punctuation'.
524 Always specify this analyzer after the comment
525 analyzer.
526
527 - semantic-list: String delimited by matching parenthesis, braces,
528 etc. that the lexer skipped over, because the
529 `depth' parameter to \\[semantic-flex] was not high
530 enough.
531 This token is produced with `semantic-lex-paren-or-list'.
532
533 - string: Quoted strings, i.e., string sequences that start
534 and end with characters matching `\\s\"'
535 regexp. The lexer relies on @code{forward-sexp} to
536 find the matching end.
537 This token is produced with `semantic-lex-string'.
538
539 - symbol: String sequences that match `\\(\\sw\\|\\s_\\)+'
540 regexp.
541 This token is produced with
542 `semantic-lex-symbol-or-keyword'. Always add this analyzer
543 after `semantic-lex-number', or other analyzers that
544 match its regular expression.
545
546 - whitespace: Characters that match `\\s-+' regexp.
547 This token is produced with `semantic-lex-whitespace'.")
548
549(defvar semantic-lex-syntax-modifications nil
550 "Changes to the syntax table for this buffer.
551These changes are active only while the buffer is being flexed.
552This is a list where each element has the form:
553 (CHAR CLASS)
554CHAR is the char passed to `modify-syntax-entry',
555and CLASS is the string also passed to `modify-syntax-entry' to define
556what syntax class CHAR has.")
557(make-variable-buffer-local 'semantic-lex-syntax-modifications)
558
559(defvar semantic-lex-syntax-table nil
560 "Syntax table used by lexical analysis.
561See also `semantic-lex-syntax-modifications'.")
562(make-variable-buffer-local 'semantic-lex-syntax-table)
563
564(defvar semantic-lex-comment-regex nil
565 "Regular expression for identifying comment start during lexical analysis.
566This may be automatically set when semantic initializes in a mode, but
567may need to be overriden for some special languages.")
568(make-variable-buffer-local 'semantic-lex-comment-regex)
569
570(defvar semantic-lex-number-expression
571 ;; This expression was written by David Ponce for Java, and copied
572 ;; here for C and any other similar language.
573 (eval-when-compile
574 (concat "\\("
575 "\\<[0-9]+[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
576 "\\|"
577 "\\<[0-9]+[.][eE][-+]?[0-9]+[fFdD]?\\>"
578 "\\|"
579 "\\<[0-9]+[.][fFdD]\\>"
580 "\\|"
581 "\\<[0-9]+[.]"
582 "\\|"
583 "[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
584 "\\|"
585 "\\<[0-9]+[eE][-+]?[0-9]+[fFdD]?\\>"
586 "\\|"
587 "\\<0[xX][0-9a-fA-F]+[lL]?\\>"
588 "\\|"
589 "\\<[0-9]+[lLfFdD]?\\>"
590 "\\)"
591 ))
592 "Regular expression for matching a number.
593If this value is nil, no number extraction is done during lex.
594This expression tries to match C and Java like numbers.
595
596DECIMAL_LITERAL:
597 [1-9][0-9]*
598 ;
599HEX_LITERAL:
600 0[xX][0-9a-fA-F]+
601 ;
602OCTAL_LITERAL:
603 0[0-7]*
604 ;
605INTEGER_LITERAL:
606 <DECIMAL_LITERAL>[lL]?
607 | <HEX_LITERAL>[lL]?
608 | <OCTAL_LITERAL>[lL]?
609 ;
610EXPONENT:
611 [eE][+-]?[09]+
612 ;
613FLOATING_POINT_LITERAL:
614 [0-9]+[.][0-9]*<EXPONENT>?[fFdD]?
615 | [.][0-9]+<EXPONENT>?[fFdD]?
616 | [0-9]+<EXPONENT>[fFdD]?
617 | [0-9]+<EXPONENT>?[fFdD]
618 ;")
619(make-variable-buffer-local 'semantic-lex-number-expression)
620
621(defvar semantic-lex-depth 0
622 "Default lexing depth.
623This specifies how many lists to create tokens in.")
624(make-variable-buffer-local 'semantic-lex-depth)
625
626(defvar semantic-lex-unterminated-syntax-end-function
627 (lambda (syntax syntax-start lex-end) lex-end)
628 "Function called when unterminated syntax is encountered.
629This should be set to one function. That function should take three
630parameters. The SYNTAX, or type of syntax which is unterminated.
631SYNTAX-START where the broken syntax begins.
632LEX-END is where the lexical analysis was asked to end.
633This function can be used for languages that can intelligently fix up
634broken syntax, or the exit lexical analysis via `throw' or `signal'
635when finding unterminated syntax.")
636
637;;; Interactive testing commands
638
639(defun semantic-lex-test (arg)
640 "Test the semantic lexer in the current buffer.
641If universal argument ARG, then try the whole buffer."
642 (interactive "P")
643 (let* ((start (current-time))
644 (result (semantic-lex
645 (if arg (point-min) (point))
646 (point-max)))
647 (end (current-time)))
648 (message "Elapsed Time: %.2f seconds."
649 (semantic-elapsed-time start end))
650 (pop-to-buffer "*Lexer Output*")
651 (require 'pp)
652 (erase-buffer)
653 (insert (pp-to-string result))
654 (goto-char (point-min))
655 ))
656
657(defun semantic-lex-test-full-depth (arg)
658 "Test the semantic lexer in the current buffer parsing through lists.
659Usually the lexer parses
660If universal argument ARG, then try the whole buffer."
661 (interactive "P")
662 (let* ((start (current-time))
663 (result (semantic-lex
664 (if arg (point-min) (point))
665 (point-max)
666 100))
667 (end (current-time)))
668 (message "Elapsed Time: %.2f seconds."
669 (semantic-elapsed-time start end))
670 (pop-to-buffer "*Lexer Output*")
671 (require 'pp)
672 (erase-buffer)
673 (insert (pp-to-string result))
674 (goto-char (point-min))
675 ))
676
677(defun semantic-lex-test-region (beg end)
678 "Test the semantic lexer in the current buffer.
679Analyze the area between BEG and END."
680 (interactive "r")
681 (let ((result (semantic-lex beg end)))
682 (pop-to-buffer "*Lexer Output*")
683 (require 'pp)
684 (erase-buffer)
685 (insert (pp-to-string result))
686 (goto-char (point-min))
687 ))
688
689(defvar semantic-lex-debug nil
690 "When non-nil, debug the local lexical analyzer.")
691
692(defun semantic-lex-debug (arg)
693 "Debug the semantic lexer in the current buffer.
694Argument ARG specifies of the analyze the whole buffer, or start at point.
695While engaged, each token identified by the lexer will be highlighted
696in the target buffer A description of the current token will be
697displayed in the minibuffer. Press SPC to move to the next lexical token."
698 (interactive "P")
699 (require 'semantic-debug)
700 (let ((semantic-lex-debug t))
701 (semantic-lex-test arg)))
702
703(defun semantic-lex-highlight-token (token)
704 "Highlight the lexical TOKEN.
705TOKEN is a lexical token with a START And END position.
706Return the overlay."
707 (let ((o (semantic-make-overlay (semantic-lex-token-start token)
708 (semantic-lex-token-end token))))
709 (semantic-overlay-put o 'face 'highlight)
710 o))
711
712(defsubst semantic-lex-debug-break (token)
713 "Break during lexical analysis at TOKEN."
714 (when semantic-lex-debug
715 (let ((o nil))
716 (unwind-protect
717 (progn
718 (when token
719 (setq o (semantic-lex-highlight-token token)))
720 (semantic-read-event
721 (format "%S :: SPC - continue" token))
722 )
723 (when o
724 (semantic-overlay-delete o))))))
725
726;;; Lexical analyzer creation
727;;
728;; Code for creating a lex function from lists of analyzers.
729;;
730;; A lexical analyzer is created from a list of individual analyzers.
731;; Each individual analyzer specifies a single match, and code that
732;; goes with it.
733;;
734;; Creation of an analyzer assembles these analyzers into a new function
735;; with the behaviors of all the individual analyzers.
736;;
737(defmacro semantic-lex-one-token (analyzers)
738 "Calculate one token from the current buffer at point.
739Uses locally bound variables from `define-lex'.
740Argument ANALYZERS is the list of analyzers being used."
741 (cons 'cond (mapcar #'symbol-value analyzers)))
742
743(defvar semantic-lex-end-point nil
744 "The end point as tracked through lexical functions.")
745
746(defvar semantic-lex-current-depth nil
747 "The current depth as tracked through lexical functions.")
748
749(defvar semantic-lex-maximum-depth nil
750 "The maximum depth of parenthisis as tracked through lexical functions.")
751
752(defvar semantic-lex-token-stream nil
753 "The current token stream we are collecting.")
754
755(defvar semantic-lex-analysis-bounds nil
756 "The bounds of the current analysis.")
757
758(defvar semantic-lex-block-streams nil
759 "Streams of tokens inside collapsed blocks.
760This is an alist of (ANCHOR . STREAM) elements where ANCHOR is the
761start position of the block, and STREAM is the list of tokens in that
762block.")
763
764(defvar semantic-lex-reset-hooks nil
765 "List of hooks major-modes use to reset lexical analyzers.
766Hooks are called with START and END values for the current lexical pass.
767Should be set with `add-hook'specifying a LOCAL option.")
768
769;; Stack of nested blocks.
770(defvar semantic-lex-block-stack nil)
771;;(defvar semantic-lex-timeout 5
772;; "*Number of sections of lexing before giving up.")
773
774(defmacro define-lex (name doc &rest analyzers)
775 "Create a new lexical analyzer with NAME.
776DOC is a documentation string describing this analyzer.
777ANALYZERS are small code snippets of analyzers to use when
778building the new NAMED analyzer. Only use analyzers which
779are written to be used in `define-lex'.
780Each analyzer should be an analyzer created with `define-lex-analyzer'.
781Note: The order in which analyzers are listed is important.
782If two analyzers can match the same text, it is important to order the
783analyzers so that the one you want to match first occurs first. For
784example, it is good to put a numbe analyzer in front of a symbol
785analyzer which might mistake a number for as a symbol."
786 `(defun ,name (start end &optional depth length)
787 ,(concat doc "\nSee `semantic-lex' for more information.")
788 ;; Make sure the state of block parsing starts over.
789 (setq semantic-lex-block-streams nil)
790 ;; Allow specialty reset items.
791 (run-hook-with-args 'semantic-lex-reset-hooks start end)
792 ;; Lexing state.
793 (let* (;(starttime (current-time))
794 (starting-position (point))
795 (semantic-lex-token-stream nil)
796 (semantic-lex-block-stack nil)
797 (tmp-start start)
798 (semantic-lex-end-point start)
799 (semantic-lex-current-depth 0)
800 ;; Use the default depth when not specified.
801 (semantic-lex-maximum-depth
802 (or depth semantic-lex-depth))
803 ;; Bounds needed for unterminated syntax
804 (semantic-lex-analysis-bounds (cons start end))
805 ;; This entry prevents text properties from
806 ;; confusing our lexical analysis. See Emacs 22 (CVS)
807 ;; version of C++ mode with template hack text properties.
808 (parse-sexp-lookup-properties nil)
809 )
810 ;; Maybe REMOVE THIS LATER.
811 ;; Trying to find incremental parser bug.
812 (when (> end (point-max))
813 (error ,(format "%s: end (%%d) > point-max (%%d)" name)
814 end (point-max)))
815 (with-syntax-table semantic-lex-syntax-table
816 (goto-char start)
817 (while (and (< (point) end)
818 (or (not length)
819 (<= (length semantic-lex-token-stream) length)))
820 (semantic-lex-one-token ,analyzers)
821 (when (eq semantic-lex-end-point tmp-start)
822 (error ,(format "%s: endless loop at %%d, after %%S" name)
823 tmp-start (car semantic-lex-token-stream)))
824 (setq tmp-start semantic-lex-end-point)
825 (goto-char semantic-lex-end-point)
826 ;;(when (> (semantic-elapsed-time starttime (current-time))
827 ;; semantic-lex-timeout)
828 ;; (error "Timeout during lex at char %d" (point)))
829 (semantic-throw-on-input 'lex)
830 (semantic-lex-debug-break (car semantic-lex-token-stream))
831 ))
832 ;; Check that there is no unterminated block.
833 (when semantic-lex-block-stack
834 (let* ((last (pop semantic-lex-block-stack))
835 (blk last))
836 (while blk
837 (message
838 ,(format "%s: `%%s' block from %%S is unterminated" name)
839 (car blk) (cadr blk))
840 (setq blk (pop semantic-lex-block-stack)))
841 (semantic-lex-unterminated-syntax-detected (car last))))
842 ;; Return to where we started.
843 ;; Do not wrap in protective stuff so that if there is an error
844 ;; thrown, the user knows where.
845 (goto-char starting-position)
846 ;; Return the token stream
847 (nreverse semantic-lex-token-stream))))
848
849;;; Collapsed block tokens delimited by any tokens.
850;;
851(defun semantic-lex-start-block (syntax)
852 "Mark the last read token as the beginning of a SYNTAX block."
853 (if (or (not semantic-lex-maximum-depth)
854 (< semantic-lex-current-depth semantic-lex-maximum-depth))
855 (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
856 (push (list syntax (car semantic-lex-token-stream))
857 semantic-lex-block-stack)))
858
859(defun semantic-lex-end-block (syntax)
860 "Process the end of a previously marked SYNTAX block.
861That is, collapse the tokens inside that block, including the
862beginning and end of block tokens, into a high level block token of
863class SYNTAX.
864The token at beginning of block is the one marked by a previous call
865to `semantic-lex-start-block'. The current token is the end of block.
866The collapsed tokens are saved in `semantic-lex-block-streams'."
867 (if (null semantic-lex-block-stack)
868 (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
869 (let* ((stream semantic-lex-token-stream)
870 (blk (pop semantic-lex-block-stack))
871 (bstream (cdr blk))
872 (first (car bstream))
873 (last (pop stream)) ;; The current token mark the EOBLK
874 tok)
875 (if (not (eq (car blk) syntax))
876 ;; SYNTAX doesn't match the syntax of the current block in
877 ;; the stack. So we encountered the end of the SYNTAX block
878 ;; before the end of the current one in the stack which is
879 ;; signaled unterminated.
880 (semantic-lex-unterminated-syntax-detected (car blk))
881 ;; Move tokens found inside the block from the main stream
882 ;; into a separate block stream.
883 (while (and stream (not (eq (setq tok (pop stream)) first)))
884 (push tok bstream))
885 ;; The token marked as beginning of block was not encountered.
886 ;; This should not happen!
887 (or (eq tok first)
888 (error "Token %S not found at beginning of block `%s'"
889 first syntax))
890 ;; Save the block stream for future reuse, to avoid to redo
891 ;; the lexical analysis of the block content!
892 ;; Anchor the block stream with its start position, so we can
893 ;; use: (cdr (assq start semantic-lex-block-streams)) to
894 ;; quickly retrieve the lexical stream associated to a block.
895 (setcar blk (semantic-lex-token-start first))
896 (setcdr blk (nreverse bstream))
897 (push blk semantic-lex-block-streams)
898 ;; In the main stream, replace the tokens inside the block by
899 ;; a high level block token of class SYNTAX.
900 (setq semantic-lex-token-stream stream)
901 (semantic-lex-push-token
902 (semantic-lex-token
903 syntax (car blk) (semantic-lex-token-end last)))
904 ))))
905
906;;; Lexical token API
907;;
908;; Functions for accessing parts of a token. Use these functions
909;; instead of accessing the list structure directly because the
910;; contents of the lexical may change.
911;;
912(defmacro semantic-lex-token (symbol start end &optional str)
913 "Create a lexical token.
914SYMBOL is a symbol representing the class of syntax found.
915START and END define the bounds of the token in the current buffer.
916Optional STR is the string for the token iff the the bounds
917in the buffer do not cover the string they represent. (As from
918macro expansion.)"
919 ;; This if statement checks the existance of a STR argument at
920 ;; compile time, where STR is some symbol or constant. If the
921 ;; variable STr (runtime) is nil, this will make an incorrect decision.
922 ;;
923 ;; It is like this to maintain the original speed of the compiled
924 ;; code.
925 (if str
926 `(cons ,symbol (cons ,str (cons ,start ,end)))
927 `(cons ,symbol (cons ,start ,end))))
928
929(defun semantic-lex-token-p (thing)
930 "Return non-nil if THING is a semantic lex token.
931This is an exhaustively robust check."
932 (and (consp thing)
933 (symbolp (car thing))
934 (or (and (numberp (nth 1 thing))
935 (numberp (nthcdr 2 thing)))
936 (and (stringp (nth 1 thing))
937 (numberp (nth 2 thing))
938 (numberp (nthcdr 3 thing)))
939 ))
940 )
941
942(defun semantic-lex-token-with-text-p (thing)
943 "Return non-nil if THING is a semantic lex token.
944This is an exhaustively robust check."
945 (and (consp thing)
946 (symbolp (car thing))
947 (= (length thing) 4)
948 (stringp (nth 1 thing))
949 (numberp (nth 2 thing))
950 (numberp (nth 3 thing)))
951 )
952
953(defun semantic-lex-token-without-text-p (thing)
954 "Return non-nil if THING is a semantic lex token.
955This is an exhaustively robust check."
956 (and (consp thing)
957 (symbolp (car thing))
958 (= (length thing) 3)
959 (numberp (nth 1 thing))
960 (numberp (nth 2 thing)))
961 )
962
963(defun semantic-lex-expand-block-specs (specs)
964 "Expand block specifications SPECS into a Lisp form.
965SPECS is a list of (BLOCK BEGIN END) elements where BLOCK, BEGIN, and
966END are token class symbols that indicate to produce one collapsed
967BLOCK token from tokens found between BEGIN and END ones.
968BLOCK must be a non-nil symbol, and at least one of the BEGIN or END
969symbols must be non-nil too.
970When BEGIN is non-nil, generate a call to `semantic-lex-start-block'
971when a BEGIN token class is encountered.
972When END is non-nil, generate a call to `semantic-lex-end-block' when
973an END token class is encountered."
974 (let ((class (make-symbol "class"))
975 (form nil))
976 (dolist (spec specs)
977 (when (car spec)
978 (when (nth 1 spec)
979 (push `((eq ',(nth 1 spec) ,class)
980 (semantic-lex-start-block ',(car spec)))
981 form))
982 (when (nth 2 spec)
983 (push `((eq ',(nth 2 spec) ,class)
984 (semantic-lex-end-block ',(car spec)))
985 form))))
986 (when form
987 `((let ((,class (semantic-lex-token-class
988 (car semantic-lex-token-stream))))
989 (cond ,@(nreverse form))))
990 )))
991
992(defmacro semantic-lex-push-token (token &rest blockspecs)
993 "Push TOKEN in the lexical analyzer token stream.
994Return the lexical analysis current end point.
995If optional arguments BLOCKSPECS is non-nil, it specifies to process
996collapsed block tokens. See `semantic-lex-expand-block-specs' for
997more details.
998This macro should only be called within the bounds of
999`define-lex-analyzer'. It changes the values of the lexical analyzer
1000variables `token-stream' and `semantic-lex-end-point'. If you need to
1001move `semantic-lex-end-point' somewhere else, just modify this
1002variable after calling `semantic-lex-push-token'."
1003 `(progn
1004 (push ,token semantic-lex-token-stream)
1005 ,@(semantic-lex-expand-block-specs blockspecs)
1006 (setq semantic-lex-end-point
1007 (semantic-lex-token-end (car semantic-lex-token-stream)))
1008 ))
1009
1010(defsubst semantic-lex-token-class (token)
1011 "Fetch the class of the lexical token TOKEN.
1012See also the function `semantic-lex-token'."
1013 (car token))
1014
1015(defsubst semantic-lex-token-bounds (token)
1016 "Fetch the start and end locations of the lexical token TOKEN.
1017Return a pair (START . END)."
1018 (if (not (numberp (car (cdr token))))
1019 (cdr (cdr token))
1020 (cdr token)))
1021
1022(defsubst semantic-lex-token-start (token)
1023 "Fetch the start position of the lexical token TOKEN.
1024See also the function `semantic-lex-token'."
1025 (car (semantic-lex-token-bounds token)))
1026
1027(defsubst semantic-lex-token-end (token)
1028 "Fetch the end position of the lexical token TOKEN.
1029See also the function `semantic-lex-token'."
1030 (cdr (semantic-lex-token-bounds token)))
1031
1032(defsubst semantic-lex-token-text (token)
1033 "Fetch the text associated with the lexical token TOKEN.
1034See also the function `semantic-lex-token'."
1035 (if (stringp (car (cdr token)))
1036 (car (cdr token))
1037 (buffer-substring-no-properties
1038 (semantic-lex-token-start token)
1039 (semantic-lex-token-end token))))
1040
1041(defun semantic-lex-init ()
1042 "Initialize any lexical state for this buffer."
1043 (unless semantic-lex-comment-regex
1044 (setq semantic-lex-comment-regex
1045 (if comment-start-skip
1046 (concat "\\(\\s<\\|" comment-start-skip "\\)")
1047 "\\(\\s<\\)")))
1048 ;; Setup the lexer syntax-table
1049 (setq semantic-lex-syntax-table (copy-syntax-table (syntax-table)))
1050 (dolist (mod semantic-lex-syntax-modifications)
1051 (modify-syntax-entry
1052 (car mod) (nth 1 mod) semantic-lex-syntax-table)))
1053
1054(define-overloadable-function semantic-lex (start end &optional depth length)
1055 "Lexically analyze text in the current buffer between START and END.
1056Optional argument DEPTH indicates at what level to scan over entire
1057lists. The last argument, LENGTH specifies that `semantic-lex'
1058should only return LENGTH tokens. The return value is a token stream.
1059Each element is a list, such of the form
1060 (symbol start-expression . end-expression)
1061where SYMBOL denotes the token type.
1062See `semantic-lex-tokens' variable for details on token types. END
1063does not mark the end of the text scanned, only the end of the
1064beginning of text scanned. Thus, if a string extends past END, the
1065end of the return token will be larger than END. To truly restrict
1066scanning, use `narrow-to-region'."
1067 (funcall semantic-lex-analyzer start end depth length))
1068
1069(defsubst semantic-lex-buffer (&optional depth)
1070 "Lex the current buffer.
1071Optional argument DEPTH is the depth to scan into lists."
1072 (semantic-lex (point-min) (point-max) depth))
1073
1074(defsubst semantic-lex-list (semlist depth)
1075 "Lex the body of SEMLIST to DEPTH."
1076 (semantic-lex (semantic-lex-token-start semlist)
1077 (semantic-lex-token-end semlist)
1078 depth))
1079
1080;;; Analyzer creation macros
1081;;
1082;; An individual analyzer is a condition and code that goes with it.
1083;;
1084;; Created analyzers become variables with the code associated with them
1085;; as the symbol value. These analyzers are assembled into a lexer
1086;; to create new lexical analyzers.
1087;;
1088(defsubst semantic-lex-unterminated-syntax-detected (syntax)
1089 "Inside a lexical analyzer, use this when unterminated syntax was found.
1090Argument SYNTAX indicates the type of syntax that is unterminated.
1091The job of this function is to move (point) to a new logical location
1092so that analysis can continue, if possible."
1093 (goto-char
1094 (funcall semantic-lex-unterminated-syntax-end-function
1095 syntax
1096 (car semantic-lex-analysis-bounds)
1097 (cdr semantic-lex-analysis-bounds)
1098 ))
1099 (setq semantic-lex-end-point (point)))
1100
1101(defcustom semantic-lex-debug-analyzers nil
1102 "Non nil means to debug analyzers with syntax protection.
1103Only in effect if `debug-on-error' is also non-nil."
1104 :group 'semantic
1105 :type 'boolean)
1106
1107(defmacro semantic-lex-unterminated-syntax-protection (syntax &rest forms)
1108 "For SYNTAX, execute FORMS with protection for unterminated syntax.
1109If FORMS throws an error, treat this as a syntax problem, and
1110execute the unterminated syntax code. FORMS should return a position.
1111Irreguardless of an error, the cursor should be moved to the end of
1112the desired syntax, and a position returned.
1113If `debug-on-error' is set, errors are not caught, so that you can
1114debug them.
1115Avoid using a large FORMS since it is duplicated."
1116 `(if (and debug-on-error semantic-lex-debug-analyzers)
1117 (progn ,@forms)
1118 (condition-case nil
1119 (progn ,@forms)
1120 (error
1121 (semantic-lex-unterminated-syntax-detected ,syntax)))))
1122(put 'semantic-lex-unterminated-syntax-protection
1123 'lisp-indent-function 1)
1124
1125(defmacro define-lex-analyzer (name doc condition &rest forms)
1126 "Create a single lexical analyzer NAME with DOC.
1127When an analyzer is called, the current buffer and point are
1128positioned in a buffer at the location to be analyzed.
1129CONDITION is an expression which returns t if FORMS should be run.
1130Within the bounds of CONDITION and FORMS, the use of backquote
1131can be used to evaluate expressions at compile time.
1132While forms are running, the following variables will be locally bound:
1133 `semantic-lex-analysis-bounds' - The bounds of the current analysis.
1134 of the form (START . END)
1135 `semantic-lex-maximum-depth' - The maximum depth of semantic-list
1136 for the current analysis.
1137 `semantic-lex-current-depth' - The current depth of `semantic-list' that has
1138 been decended.
1139 `semantic-lex-end-point' - End Point after match.
1140 Analyzers should set this to a buffer location if their
1141 match string does not represent the end of the matched text.
1142 `semantic-lex-token-stream' - The token list being collected.
1143 Add new lexical tokens to this list.
1144Proper action in FORMS is to move the value of `semantic-lex-end-point' to
1145after the location of the analyzed entry, and to add any discovered tokens
1146at the beginning of `semantic-lex-token-stream'.
1147This can be done by using `semantic-lex-push-token'."
1148 `(eval-and-compile
1149 (defvar ,name nil ,doc)
1150 (defun ,name nil)
1151 ;; Do this part separately so that re-evaluation rebuilds this code.
1152 (setq ,name '(,condition ,@forms))
1153 ;; Build a single lexical analyzer function, so the doc for
1154 ;; function help is automatically provided, and perhaps the
1155 ;; function could be useful for testing and debugging one
1156 ;; analyzer.
1157 (fset ',name (lambda () ,doc
1158 (let ((semantic-lex-token-stream nil)
1159 (semantic-lex-end-point (point))
1160 (semantic-lex-analysis-bounds
1161 (cons (point) (point-max)))
1162 (semantic-lex-current-depth 0)
1163 (semantic-lex-maximum-depth
1164 semantic-lex-depth)
1165 )
1166 (when ,condition ,@forms)
1167 semantic-lex-token-stream)))
1168 ))
1169
1170(defmacro define-lex-regex-analyzer (name doc regexp &rest forms)
1171 "Create a lexical analyzer with NAME and DOC that will match REGEXP.
1172FORMS are evaluated upon a successful match.
1173See `define-lex-analyzer' for more about analyzers."
1174 `(define-lex-analyzer ,name
1175 ,doc
1176 (looking-at ,regexp)
1177 ,@forms
1178 ))
1179
1180(defmacro define-lex-simple-regex-analyzer (name doc regexp toksym
1181 &optional index
1182 &rest forms)
1183 "Create a lexical analyzer with NAME and DOC that match REGEXP.
1184TOKSYM is the symbol to use when creating a semantic lexical token.
1185INDEX is the index into the match that defines the bounds of the token.
1186Index should be a plain integer, and not specified in the macro as an
1187expression.
1188FORMS are evaluated upon a successful match BEFORE the new token is
1189created. It is valid to ignore FORMS.
1190See `define-lex-analyzer' for more about analyzers."
1191 `(define-lex-analyzer ,name
1192 ,doc
1193 (looking-at ,regexp)
1194 ,@forms
1195 (semantic-lex-push-token
1196 (semantic-lex-token ,toksym
1197 (match-beginning ,(or index 0))
1198 (match-end ,(or index 0))))
1199 ))
1200
1201(defmacro define-lex-block-analyzer (name doc spec1 &rest specs)
1202 "Create a lexical analyzer NAME for paired delimiters blocks.
1203It detects a paired delimiters block or the corresponding open or
1204close delimiter depending on the value of the variable
1205`semantic-lex-current-depth'. DOC is the documentation string of the lexical
1206analyzer. SPEC1 and SPECS specify the token symbols and open, close
1207delimiters used. Each SPEC has the form:
1208
1209\(BLOCK-SYM (OPEN-DELIM OPEN-SYM) (CLOSE-DELIM CLOSE-SYM))
1210
1211where BLOCK-SYM is the symbol returned in a block token. OPEN-DELIM
1212and CLOSE-DELIM are respectively the open and close delimiters
1213identifying a block. OPEN-SYM and CLOSE-SYM are respectively the
1214symbols returned in open and close tokens."
1215 (let ((specs (cons spec1 specs))
1216 spec open olist clist)
1217 (while specs
1218 (setq spec (car specs)
1219 specs (cdr specs)
1220 open (nth 1 spec)
1221 ;; build alist ((OPEN-DELIM OPEN-SYM BLOCK-SYM) ...)
1222 olist (cons (list (car open) (cadr open) (car spec)) olist)
1223 ;; build alist ((CLOSE-DELIM CLOSE-SYM) ...)
1224 clist (cons (nth 2 spec) clist)))
1225 `(define-lex-analyzer ,name
1226 ,doc
1227 (and
1228 (looking-at "\\(\\s(\\|\\s)\\)")
1229 (let ((text (match-string 0)) match)
1230 (cond
1231 ((setq match (assoc text ',olist))
1232 (if (or (not semantic-lex-maximum-depth)
1233 (< semantic-lex-current-depth semantic-lex-maximum-depth))
1234 (progn
1235 (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
1236 (semantic-lex-push-token
1237 (semantic-lex-token
1238 (nth 1 match)
1239 (match-beginning 0) (match-end 0))))
1240 (semantic-lex-push-token
1241 (semantic-lex-token
1242 (nth 2 match)
1243 (match-beginning 0)
1244 (save-excursion
1245 (semantic-lex-unterminated-syntax-protection (nth 2 match)
1246 (forward-list 1)
1247 (point)))
1248 ))
1249 ))
1250 ((setq match (assoc text ',clist))
1251 (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
1252 (semantic-lex-push-token
1253 (semantic-lex-token
1254 (nth 1 match)
1255 (match-beginning 0) (match-end 0)))))))
1256 )))
1257
1258;;; Analyzers
1259;;
1260;; Pre-defined common analyzers.
1261;;
1262(define-lex-analyzer semantic-lex-default-action
1263 "The default action when no other lexical actions match text.
1264This action will just throw an error."
1265 t
1266 (error "Unmatched Text during Lexical Analysis"))
1267
1268(define-lex-analyzer semantic-lex-beginning-of-line
1269 "Detect and create a beginning of line token (BOL)."
1270 (and (bolp)
1271 ;; Just insert a (bol N . N) token in the token stream,
1272 ;; without moving the point. N is the point at the
1273 ;; beginning of line.
1274 (semantic-lex-push-token (semantic-lex-token 'bol (point) (point)))
1275 nil) ;; CONTINUE
1276 ;; We identify and add the BOL token onto the stream, but since
1277 ;; semantic-lex-end-point doesn't move, we always fail CONDITION, and have no
1278 ;; FORMS body.
1279 nil)
1280
1281(define-lex-simple-regex-analyzer semantic-lex-newline
1282 "Detect and create newline tokens."
1283 "\\s-*\\(\n\\|\\s>\\)" 'newline 1)
1284
1285(define-lex-regex-analyzer semantic-lex-newline-as-whitespace
1286 "Detect and create newline tokens.
1287Use this ONLY if newlines are not whitespace characters (such as when
1288they are comment end characters) AND when you want whitespace tokens."
1289 "\\s-*\\(\n\\|\\s>\\)"
1290 ;; Language wants whitespaces. Create a token for it.
1291 (if (eq (semantic-lex-token-class (car semantic-lex-token-stream))
1292 'whitespace)
1293 ;; Merge whitespace tokens together if they are adjacent. Two
1294 ;; whitespace tokens may be sperated by a comment which is not in
1295 ;; the token stream.
1296 (setcdr (semantic-lex-token-bounds (car semantic-lex-token-stream))
1297 (match-end 0))
1298 (semantic-lex-push-token
1299 (semantic-lex-token
1300 'whitespace (match-beginning 0) (match-end 0)))))
1301
1302(define-lex-regex-analyzer semantic-lex-ignore-newline
1303 "Detect and ignore newline tokens.
1304Use this ONLY if newlines are not whitespace characters (such as when
1305they are comment end characters)."
1306 "\\s-*\\(\n\\|\\s>\\)"
1307 (setq semantic-lex-end-point (match-end 0)))
1308
1309(define-lex-regex-analyzer semantic-lex-whitespace
1310 "Detect and create whitespace tokens."
1311 ;; catch whitespace when needed
1312 "\\s-+"
1313 ;; Language wants whitespaces. Create a token for it.
1314 (if (eq (semantic-lex-token-class (car semantic-lex-token-stream))
1315 'whitespace)
1316 ;; Merge whitespace tokens together if they are adjacent. Two
1317 ;; whitespace tokens may be sperated by a comment which is not in
1318 ;; the token stream.
1319 (progn
1320 (setq semantic-lex-end-point (match-end 0))
1321 (setcdr (semantic-lex-token-bounds (car semantic-lex-token-stream))
1322 semantic-lex-end-point))
1323 (semantic-lex-push-token
1324 (semantic-lex-token
1325 'whitespace (match-beginning 0) (match-end 0)))))
1326
1327(define-lex-regex-analyzer semantic-lex-ignore-whitespace
1328 "Detect and skip over whitespace tokens."
1329 ;; catch whitespace when needed
1330 "\\s-+"
1331 ;; Skip over the detected whitespace, do not create a token for it.
1332 (setq semantic-lex-end-point (match-end 0)))
1333
1334(define-lex-simple-regex-analyzer semantic-lex-number
1335 "Detect and create number tokens.
1336See `semantic-lex-number-expression' for details on matching numbers,
1337and number formats."
1338 semantic-lex-number-expression 'number)
1339
1340(define-lex-regex-analyzer semantic-lex-symbol-or-keyword
1341 "Detect and create symbol and keyword tokens."
1342 "\\(\\sw\\|\\s_\\)+"
1343 (semantic-lex-push-token
1344 (semantic-lex-token
1345 (or (semantic-lex-keyword-p (match-string 0)) 'symbol)
1346 (match-beginning 0) (match-end 0))))
1347
1348(define-lex-simple-regex-analyzer semantic-lex-charquote
1349 "Detect and create charquote tokens."
1350 ;; Character quoting characters (ie, \n as newline)
1351 "\\s\\+" 'charquote)
1352
1353(define-lex-simple-regex-analyzer semantic-lex-punctuation
1354 "Detect and create punctuation tokens."
1355 "\\(\\s.\\|\\s$\\|\\s'\\)" 'punctuation)
1356
1357(define-lex-analyzer semantic-lex-punctuation-type
1358 "Detect and create a punctuation type token.
1359Recognized punctuations are defined in the current table of lexical
1360types, as the value of the `punctuation' token type."
1361 (and (looking-at "\\(\\s.\\|\\s$\\|\\s'\\)+")
1362 (let* ((key (match-string 0))
1363 (pos (match-beginning 0))
1364 (end (match-end 0))
1365 (len (- end pos))
1366 (lst (semantic-lex-type-value "punctuation" t))
1367 (def (car lst)) ;; default lexical symbol or nil
1368 (lst (cdr lst)) ;; alist of (LEX-SYM . PUNCT-STRING)
1369 (elt nil))
1370 (if lst
1371 ;; Starting with the longest one, search if the
1372 ;; punctuation string is defined for this language.
1373 (while (and (> len 0) (not (setq elt (rassoc key lst))))
1374 (setq len (1- len)
1375 key (substring key 0 len))))
1376 (if elt ;; Return the punctuation token found
1377 (semantic-lex-push-token
1378 (semantic-lex-token (car elt) pos (+ pos len)))
1379 (if def ;; Return a default generic token
1380 (semantic-lex-push-token
1381 (semantic-lex-token def pos end))
1382 ;; Nothing match
1383 )))))
1384
1385(define-lex-regex-analyzer semantic-lex-paren-or-list
1386 "Detect open parenthesis.
1387Return either a paren token or a semantic list token depending on
1388`semantic-lex-current-depth'."
1389 "\\s("
1390 (if (or (not semantic-lex-maximum-depth)
1391 (< semantic-lex-current-depth semantic-lex-maximum-depth))
1392 (progn
1393 (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
1394 (semantic-lex-push-token
1395 (semantic-lex-token
1396 'open-paren (match-beginning 0) (match-end 0))))
1397 (semantic-lex-push-token
1398 (semantic-lex-token
1399 'semantic-list (match-beginning 0)
1400 (save-excursion
1401 (semantic-lex-unterminated-syntax-protection 'semantic-list
1402 (forward-list 1)
1403 (point))
1404 )))
1405 ))
1406
1407(define-lex-simple-regex-analyzer semantic-lex-open-paren
1408 "Detect and create an open parenthisis token."
1409 "\\s(" 'open-paren 0 (setq semantic-lex-current-depth (1+ semantic-lex-current-depth)))
1410
1411(define-lex-simple-regex-analyzer semantic-lex-close-paren
1412 "Detect and create a close paren token."
1413 "\\s)" 'close-paren 0 (setq semantic-lex-current-depth (1- semantic-lex-current-depth)))
1414
1415(define-lex-regex-analyzer semantic-lex-string
1416 "Detect and create a string token."
1417 "\\s\""
1418 ;; Zing to the end of this string.
1419 (semantic-lex-push-token
1420 (semantic-lex-token
1421 'string (point)
1422 (save-excursion
1423 (semantic-lex-unterminated-syntax-protection 'string
1424 (forward-sexp 1)
1425 (point))
1426 ))))
1427
1428(define-lex-regex-analyzer semantic-lex-comments
1429 "Detect and create a comment token."
1430 semantic-lex-comment-regex
1431 (save-excursion
1432 (forward-comment 1)
1433 ;; Generate newline token if enabled
1434 (if (bolp) (backward-char 1))
1435 (setq semantic-lex-end-point (point))
1436 ;; Language wants comments or want them as whitespaces,
1437 ;; link them together.
1438 (if (eq (semantic-lex-token-class (car semantic-lex-token-stream)) 'comment)
1439 (setcdr (semantic-lex-token-bounds (car semantic-lex-token-stream))
1440 semantic-lex-end-point)
1441 (semantic-lex-push-token
1442 (semantic-lex-token
1443 'comment (match-beginning 0) semantic-lex-end-point)))))
1444
1445(define-lex-regex-analyzer semantic-lex-comments-as-whitespace
1446 "Detect comments and create a whitespace token."
1447 semantic-lex-comment-regex
1448 (save-excursion
1449 (forward-comment 1)
1450 ;; Generate newline token if enabled
1451 (if (bolp) (backward-char 1))
1452 (setq semantic-lex-end-point (point))
1453 ;; Language wants comments or want them as whitespaces,
1454 ;; link them together.
1455 (if (eq (semantic-lex-token-class (car semantic-lex-token-stream)) 'whitespace)
1456 (setcdr (semantic-lex-token-bounds (car semantic-lex-token-stream))
1457 semantic-lex-end-point)
1458 (semantic-lex-push-token
1459 (semantic-lex-token
1460 'whitespace (match-beginning 0) semantic-lex-end-point)))))
1461
1462(define-lex-regex-analyzer semantic-lex-ignore-comments
1463 "Detect and create a comment token."
1464 semantic-lex-comment-regex
1465 (let ((comment-start-point (point)))
1466 (forward-comment 1)
1467 (if (eq (point) comment-start-point)
1468 ;; In this case our start-skip string failed
1469 ;; to work properly. Lets try and move over
1470 ;; whatever white space we matched to begin
1471 ;; with.
1472 (skip-syntax-forward "-.'"
1473 (save-excursion
1474 (end-of-line)
1475 (point)))
1476 ;; We may need to back up so newlines or whitespace is generated.
1477 (if (bolp)
1478 (backward-char 1)))
1479 (if (eq (point) comment-start-point)
1480 (error "Strange comment syntax prevents lexical analysis"))
1481 (setq semantic-lex-end-point (point))))
1482
1483;;; Comment lexer
1484;;
1485;; Predefined lexers that could be used instead of creating new
1486;; analyers.
1487
1488(define-lex semantic-comment-lexer
1489 "A simple lexical analyzer that handles comments.
1490This lexer will only return comment tokens. It is the default lexer
1491used by `semantic-find-doc-snarf-comment' to snarf up the comment at
1492point."
1493 semantic-lex-ignore-whitespace
1494 semantic-lex-ignore-newline
1495 semantic-lex-comments
1496 semantic-lex-default-action)
1497
1498;;; Test Lexer
1499;;
1500(define-lex semantic-simple-lexer
1501 "A simple lexical analyzer that handles simple buffers.
1502This lexer ignores comments and whitespace, and will return
1503syntax as specified by the syntax table."
1504 semantic-lex-ignore-whitespace
1505 semantic-lex-ignore-newline
1506 semantic-lex-number
1507 semantic-lex-symbol-or-keyword
1508 semantic-lex-charquote
1509 semantic-lex-paren-or-list
1510 semantic-lex-close-paren
1511 semantic-lex-string
1512 semantic-lex-ignore-comments
1513 semantic-lex-punctuation
1514 semantic-lex-default-action)
1515
1516;;; Analyzers generated from grammar.
1517;;
1518;; Some analyzers are hand written. Analyzers created with these
1519;; functions are generated from the grammar files.
1520
1521(defmacro define-lex-keyword-type-analyzer (name doc syntax)
1522 "Define a keyword type analyzer NAME with DOC string.
1523SYNTAX is the regexp that matches a keyword syntactic expression."
1524 (let ((key (make-symbol "key")))
1525 `(define-lex-analyzer ,name
1526 ,doc
1527 (and (looking-at ,syntax)
1528 (let ((,key (semantic-lex-keyword-p (match-string 0))))
1529 (when ,key
1530 (semantic-lex-push-token
1531 (semantic-lex-token
1532 ,key (match-beginning 0) (match-end 0)))))))
1533 ))
1534
1535(defmacro define-lex-sexp-type-analyzer (name doc syntax token)
1536 "Define a sexp type analyzer NAME with DOC string.
1537SYNTAX is the regexp that matches the beginning of the s-expression.
1538TOKEN is the lexical token returned when SYNTAX matches."
1539 `(define-lex-regex-analyzer ,name
1540 ,doc
1541 ,syntax
1542 (semantic-lex-push-token
1543 (semantic-lex-token
1544 ,token (point)
1545 (save-excursion
1546 (semantic-lex-unterminated-syntax-protection ,token
1547 (forward-sexp 1)
1548 (point))))))
1549 )
1550
1551(defmacro define-lex-regex-type-analyzer (name doc syntax matches default)
1552 "Define a regexp type analyzer NAME with DOC string.
1553SYNTAX is the regexp that matches a syntactic expression.
1554MATCHES is an alist of lexical elements used to refine the syntactic
1555expression.
1556DEFAULT is the default lexical token returned when no MATCHES."
1557 (if matches
1558 (let* ((val (make-symbol "val"))
1559 (lst (make-symbol "lst"))
1560 (elt (make-symbol "elt"))
1561 (pos (make-symbol "pos"))
1562 (end (make-symbol "end")))
1563 `(define-lex-analyzer ,name
1564 ,doc
1565 (and (looking-at ,syntax)
1566 (let* ((,val (match-string 0))
1567 (,pos (match-beginning 0))
1568 (,end (match-end 0))
1569 (,lst ,matches)
1570 ,elt)
1571 (while (and ,lst (not ,elt))
1572 (if (string-match (cdar ,lst) ,val)
1573 (setq ,elt (caar ,lst))
1574 (setq ,lst (cdr ,lst))))
1575 (semantic-lex-push-token
1576 (semantic-lex-token (or ,elt ,default) ,pos ,end))))
1577 ))
1578 `(define-lex-simple-regex-analyzer ,name
1579 ,doc
1580 ,syntax ,default)
1581 ))
1582
1583(defmacro define-lex-string-type-analyzer (name doc syntax matches default)
1584 "Define a string type analyzer NAME with DOC string.
1585SYNTAX is the regexp that matches a syntactic expression.
1586MATCHES is an alist of lexical elements used to refine the syntactic
1587expression.
1588DEFAULT is the default lexical token returned when no MATCHES."
1589 (if matches
1590 (let* ((val (make-symbol "val"))
1591 (lst (make-symbol "lst"))
1592 (elt (make-symbol "elt"))
1593 (pos (make-symbol "pos"))
1594 (end (make-symbol "end"))
1595 (len (make-symbol "len")))
1596 `(define-lex-analyzer ,name
1597 ,doc
1598 (and (looking-at ,syntax)
1599 (let* ((,val (match-string 0))
1600 (,pos (match-beginning 0))
1601 (,end (match-end 0))
1602 (,len (- ,end ,pos))
1603 (,lst ,matches)
1604 ,elt)
1605 ;; Starting with the longest one, search if a lexical
1606 ;; value match a token defined for this language.
1607 (while (and (> ,len 0) (not (setq ,elt (rassoc ,val ,lst))))
1608 (setq ,len (1- ,len)
1609 ,val (substring ,val 0 ,len)))
1610 (when ,elt ;; Adjust token end position.
1611 (setq ,elt (car ,elt)
1612 ,end (+ ,pos ,len)))
1613 (semantic-lex-push-token
1614 (semantic-lex-token (or ,elt ,default) ,pos ,end))))
1615 ))
1616 `(define-lex-simple-regex-analyzer ,name
1617 ,doc
1618 ,syntax ,default)
1619 ))
1620
1621(defmacro define-lex-block-type-analyzer (name doc syntax matches)
1622 "Define a block type analyzer NAME with DOC string.
1623
1624SYNTAX is the regexp that matches block delimiters, typically the
1625open (`\\\\s(') and close (`\\\\s)') parenthesis syntax classes.
1626
1627MATCHES is a pair (OPEN-SPECS . CLOSE-SPECS) that defines blocks.
1628
1629 OPEN-SPECS is a list of (OPEN-DELIM OPEN-TOKEN BLOCK-TOKEN) elements
1630 where:
1631
1632 OPEN-DELIM is a string: the block open delimiter character.
1633
1634 OPEN-TOKEN is the lexical token class associated to the OPEN-DELIM
1635 delimiter.
1636
1637 BLOCK-TOKEN is the lexical token class associated to the block
1638 that starts at the OPEN-DELIM delimiter.
1639
1640 CLOSE-SPECS is a list of (CLOSE-DELIM CLOSE-TOKEN) elements where:
1641
1642 CLOSE-DELIM is a string: the block end delimiter character.
1643
1644 CLOSE-TOKEN is the lexical token class associated to the
1645 CLOSE-DELIM delimiter.
1646
1647Each element in OPEN-SPECS must have a corresponding element in
1648CLOSE-SPECS.
1649
1650The lexer will return a BLOCK-TOKEN token when the value of
1651`semantic-lex-current-depth' is greater than or equal to the maximum
1652depth of parenthesis tracking (see also the function `semantic-lex').
1653Otherwise it will return OPEN-TOKEN and CLOSE-TOKEN tokens.
1654
1655TO DO: Put the following in the developer's guide and just put a
1656reference here.
1657
1658In the grammar:
1659
1660The value of a block token must be a string that contains a readable
1661sexp of the form:
1662
1663 \"(OPEN-TOKEN CLOSE-TOKEN)\"
1664
1665OPEN-TOKEN and CLOSE-TOKEN represent the block delimiters, and must be
1666lexical tokens of respectively `open-paren' and `close-paren' types.
1667Their value is the corresponding delimiter character as a string.
1668
1669Here is a small example to analyze a parenthesis block:
1670
1671 %token <block> PAREN_BLOCK \"(LPAREN RPAREN)\"
1672 %token <open-paren> LPAREN \"(\"
1673 %token <close-paren> RPAREN \")\"
1674
1675When the lexer encounters the open-paren delimiter \"(\":
1676
1677 - If the maximum depth of parenthesis tracking is not reached (that
1678 is, current depth < max depth), it returns a (LPAREN start . end)
1679 token, then continue analysis inside the block. Later, when the
1680 corresponding close-paren delimiter \")\" will be encountered, it
1681 will return a (RPAREN start . end) token.
1682
1683 - If the maximum depth of parenthesis tracking is reached (current
1684 depth >= max depth), it returns the whole parenthesis block as
1685 a (PAREN_BLOCK start . end) token."
1686 (let* ((val (make-symbol "val"))
1687 (lst (make-symbol "lst"))
1688 (elt (make-symbol "elt")))
1689 `(define-lex-analyzer ,name
1690 ,doc
1691 (and
1692 (looking-at ,syntax) ;; "\\(\\s(\\|\\s)\\)"
1693 (let ((,val (match-string 0))
1694 (,lst ,matches)
1695 ,elt)
1696 (cond
1697 ((setq ,elt (assoc ,val (car ,lst)))
1698 (if (or (not semantic-lex-maximum-depth)
1699 (< semantic-lex-current-depth semantic-lex-maximum-depth))
1700 (progn
1701 (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
1702 (semantic-lex-push-token
1703 (semantic-lex-token
1704 (nth 1 ,elt)
1705 (match-beginning 0) (match-end 0))))
1706 (semantic-lex-push-token
1707 (semantic-lex-token
1708 (nth 2 ,elt)
1709 (match-beginning 0)
1710 (save-excursion
1711 (semantic-lex-unterminated-syntax-protection (nth 2 ,elt)
1712 (forward-list 1)
1713 (point)))))))
1714 ((setq ,elt (assoc ,val (cdr ,lst)))
1715 (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
1716 (semantic-lex-push-token
1717 (semantic-lex-token
1718 (nth 1 ,elt)
1719 (match-beginning 0) (match-end 0))))
1720 ))))
1721 ))
1722
1723;;; Lexical Safety
1724;;
1725;; The semantic lexers, unlike other lexers, can throw errors on
1726;; unbalanced syntax. Since editing is all about changeging test
1727;; we need to provide a convenient way to protect against syntactic
1728;; inequalities.
1729
1730(defmacro semantic-lex-catch-errors (symbol &rest forms)
1731 "Using SYMBOL, execute FORMS catching lexical errors.
1732If FORMS results in a call to the parser that throws a lexical error,
1733the error will be caught here without the buffer's cache being thrown
1734out of date.
1735If there is an error, the syntax that failed is returned.
1736If there is no error, then the last value of FORMS is returned."
1737 (let ((ret (make-symbol "ret"))
1738 (syntax (make-symbol "syntax"))
1739 (start (make-symbol "start"))
1740 (end (make-symbol "end")))
1741 `(let* ((semantic-lex-unterminated-syntax-end-function
1742 (lambda (,syntax ,start ,end)
1743 (throw ',symbol ,syntax)))
1744 ;; Delete the below when semantic-flex is fully retired.
1745 (semantic-flex-unterminated-syntax-end-function
1746 semantic-lex-unterminated-syntax-end-function)
1747 (,ret (catch ',symbol
1748 (save-excursion
1749 ,@forms
1750 nil))))
1751 ;; Great Sadness. Assume that FORMS execute within the
1752 ;; confines of the current buffer only! Mark this thing
1753 ;; unparseable iff the special symbol was thrown. This
1754 ;; will prevent future calls from parsing, but will allow
1755 ;; then to still return the cache.
1756 (when ,ret
1757 ;; Leave this message off. If an APP using this fcn wants
1758 ;; a message, they can do it themselves. This cleans up
1759 ;; problems with the idle scheduler obscuring useful data.
1760 ;;(message "Buffer not currently parsable (%S)." ,ret)
1761 (semantic-parse-tree-unparseable))
1762 ,ret)))
1763(put 'semantic-lex-catch-errors 'lisp-indent-function 1)
1764
1765
1766;;; Interfacing with edebug
1767;;
1768(add-hook
1769 'edebug-setup-hook
1770 #'(lambda ()
1771
1772 (def-edebug-spec define-lex
1773 (&define name stringp (&rest symbolp))
1774 )
1775 (def-edebug-spec define-lex-analyzer
1776 (&define name stringp form def-body)
1777 )
1778 (def-edebug-spec define-lex-regex-analyzer
1779 (&define name stringp form def-body)
1780 )
1781 (def-edebug-spec define-lex-simple-regex-analyzer
1782 (&define name stringp form symbolp [ &optional form ] def-body)
1783 )
1784 (def-edebug-spec define-lex-block-analyzer
1785 (&define name stringp form (&rest form))
1786 )
1787 (def-edebug-spec semantic-lex-catch-errors
1788 (symbolp def-body)
1789 )
1790
1791 ))
1792
1793;;; Compatibility with Semantic 1.x lexical analysis
1794;;
1795;; NOTE: DELETE THIS SOMEDAY SOON
1796
1797(semantic-alias-obsolete 'semantic-flex-start 'semantic-lex-token-start)
1798(semantic-alias-obsolete 'semantic-flex-end 'semantic-lex-token-end)
1799(semantic-alias-obsolete 'semantic-flex-text 'semantic-lex-token-text)
1800(semantic-alias-obsolete 'semantic-flex-make-keyword-table 'semantic-lex-make-keyword-table)
1801(semantic-alias-obsolete 'semantic-flex-keyword-p 'semantic-lex-keyword-p)
1802(semantic-alias-obsolete 'semantic-flex-keyword-put 'semantic-lex-keyword-put)
1803(semantic-alias-obsolete 'semantic-flex-keyword-get 'semantic-lex-keyword-get)
1804(semantic-alias-obsolete 'semantic-flex-map-keywords 'semantic-lex-map-keywords)
1805(semantic-alias-obsolete 'semantic-flex-keywords 'semantic-lex-keywords)
1806(semantic-alias-obsolete 'semantic-flex-buffer 'semantic-lex-buffer)
1807(semantic-alias-obsolete 'semantic-flex-list 'semantic-lex-list)
1808
1809;; This simple scanner uses the syntax table to generate a stream of
1810;; simple tokens of the form:
1811;;
1812;; (SYMBOL START . END)
1813;;
1814;; Where symbol is the type of thing it is. START and END mark that
1815;; objects boundary.
1816
1817(defvar semantic-flex-tokens semantic-lex-tokens
1818 "An alist of of semantic token types.
1819See variable `semantic-lex-tokens'.")
1820
1821(defvar semantic-flex-unterminated-syntax-end-function
1822 (lambda (syntax syntax-start flex-end) flex-end)
1823 "Function called when unterminated syntax is encountered.
1824This should be set to one function. That function should take three
1825parameters. The SYNTAX, or type of syntax which is unterminated.
1826SYNTAX-START where the broken syntax begins.
1827FLEX-END is where the lexical analysis was asked to end.
1828This function can be used for languages that can intelligently fix up
1829broken syntax, or the exit lexical analysis via `throw' or `signal'
1830when finding unterminated syntax.")
1831
1832(defvar semantic-flex-extensions nil
1833 "Buffer local extensions to the lexical analyzer.
1834This should contain an alist with a key of a regex and a data element of
1835a function. The function should both move point, and return a lexical
1836token of the form:
1837 ( TYPE START . END)
1838nil is also a valid return value.
1839TYPE can be any type of symbol, as long as it doesn't occur as a
1840nonterminal in the language definition.")
1841(make-variable-buffer-local 'semantic-flex-extensions)
1842
1843(defvar semantic-flex-syntax-modifications nil
1844 "Changes to the syntax table for this buffer.
1845These changes are active only while the buffer is being flexed.
1846This is a list where each element has the form:
1847 (CHAR CLASS)
1848CHAR is the char passed to `modify-syntax-entry',
1849and CLASS is the string also passed to `modify-syntax-entry' to define
1850what syntax class CHAR has.")
1851(make-variable-buffer-local 'semantic-flex-syntax-modifications)
1852
1853(defvar semantic-ignore-comments t
1854 "Default comment handling.
1855t means to strip comments when flexing. Nil means to keep comments
1856as part of the token stream.")
1857(make-variable-buffer-local 'semantic-ignore-comments)
1858
1859(defvar semantic-flex-enable-newlines nil
1860 "When flexing, report 'newlines as syntactic elements.
1861Useful for languages where the newline is a special case terminator.
1862Only set this on a per mode basis, not globally.")
1863(make-variable-buffer-local 'semantic-flex-enable-newlines)
1864
1865(defvar semantic-flex-enable-whitespace nil
1866 "When flexing, report 'whitespace as syntactic elements.
1867Useful for languages where the syntax is whitespace dependent.
1868Only set this on a per mode basis, not globally.")
1869(make-variable-buffer-local 'semantic-flex-enable-whitespace)
1870
1871(defvar semantic-flex-enable-bol nil
1872 "When flexing, report beginning of lines as syntactic elements.
1873Useful for languages like python which are indentation sensitive.
1874Only set this on a per mode basis, not globally.")
1875(make-variable-buffer-local 'semantic-flex-enable-bol)
1876
1877(defvar semantic-number-expression semantic-lex-number-expression
1878 "See variable `semantic-lex-number-expression'.")
1879(make-variable-buffer-local 'semantic-number-expression)
1880
1881(defvar semantic-flex-depth 0
1882 "Default flexing depth.
1883This specifies how many lists to create tokens in.")
1884(make-variable-buffer-local 'semantic-flex-depth)
1885
1886(defun semantic-flex (start end &optional depth length)
1887 "Using the syntax table, do something roughly equivalent to flex.
1888Semantically check between START and END. Optional argument DEPTH
1889indicates at what level to scan over entire lists.
1890The return value is a token stream. Each element is a list, such of
1891the form (symbol start-expression . end-expression) where SYMBOL
1892denotes the token type.
1893See `semantic-flex-tokens' variable for details on token types.
1894END does not mark the end of the text scanned, only the end of the
1895beginning of text scanned. Thus, if a string extends past END, the
1896end of the return token will be larger than END. To truly restrict
1897scanning, use `narrow-to-region'.
1898The last argument, LENGTH specifies that `semantic-flex' should only
1899return LENGTH tokens."
1900 (message "`semantic-flex' is an obsolete function. Use `define-lex' to create lexers.")
1901 (if (not semantic-flex-keywords-obarray)
1902 (setq semantic-flex-keywords-obarray [ nil ]))
1903 (let ((ts nil)
1904 (pos (point))
1905 (ep nil)
1906 (curdepth 0)
1907 (cs (if comment-start-skip
1908 (concat "\\(\\s<\\|" comment-start-skip "\\)")
1909 (concat "\\(\\s<\\)")))
1910 (newsyntax (copy-syntax-table (syntax-table)))
1911 (mods semantic-flex-syntax-modifications)
1912 ;; Use the default depth if it is not specified.
1913 (depth (or depth semantic-flex-depth)))
1914 ;; Update the syntax table
1915 (while mods
1916 (modify-syntax-entry (car (car mods)) (car (cdr (car mods))) newsyntax)
1917 (setq mods (cdr mods)))
1918 (with-syntax-table newsyntax
1919 (goto-char start)
1920 (while (and (< (point) end) (or (not length) (<= (length ts) length)))
1921 (cond
1922 ;; catch beginning of lines when needed.
1923 ;; Must be done before catching any other tokens!
1924 ((and semantic-flex-enable-bol
1925 (bolp)
1926 ;; Just insert a (bol N . N) token in the token stream,
1927 ;; without moving the point. N is the point at the
1928 ;; beginning of line.
1929 (setq ts (cons (cons 'bol (cons (point) (point))) ts))
1930 nil)) ;; CONTINUE
1931 ;; special extensions, includes whitespace, nl, etc.
1932 ((and semantic-flex-extensions
1933 (let ((fe semantic-flex-extensions)
1934 (r nil))
1935 (while fe
1936 (if (looking-at (car (car fe)))
1937 (setq ts (cons (funcall (cdr (car fe))) ts)
1938 r t
1939 fe nil
1940 ep (point)))
1941 (setq fe (cdr fe)))
1942 (if (and r (not (car ts))) (setq ts (cdr ts)))
1943 r)))
1944 ;; catch newlines when needed
1945 ((looking-at "\\s-*\\(\n\\|\\s>\\)")
1946 (if semantic-flex-enable-newlines
1947 (setq ep (match-end 1)
1948 ts (cons (cons 'newline
1949 (cons (match-beginning 1) ep))
1950 ts))))
1951 ;; catch whitespace when needed
1952 ((looking-at "\\s-+")
1953 (if semantic-flex-enable-whitespace
1954 ;; Language wants whitespaces, link them together.
1955 (if (eq (car (car ts)) 'whitespace)
1956 (setcdr (cdr (car ts)) (match-end 0))
1957 (setq ts (cons (cons 'whitespace
1958 (cons (match-beginning 0)
1959 (match-end 0)))
1960 ts)))))
1961 ;; numbers
1962 ((and semantic-number-expression
1963 (looking-at semantic-number-expression))
1964 (setq ts (cons (cons 'number
1965 (cons (match-beginning 0)
1966 (match-end 0)))
1967 ts)))
1968 ;; symbols
1969 ((looking-at "\\(\\sw\\|\\s_\\)+")
1970 (setq ts (cons (cons
1971 ;; Get info on if this is a keyword or not
1972 (or (semantic-flex-keyword-p (match-string 0))
1973 'symbol)
1974 (cons (match-beginning 0) (match-end 0)))
1975 ts)))
1976 ;; Character quoting characters (ie, \n as newline)
1977 ((looking-at "\\s\\+")
1978 (setq ts (cons (cons 'charquote
1979 (cons (match-beginning 0) (match-end 0)))
1980 ts)))
1981 ;; Open parens, or semantic-lists.
1982 ((looking-at "\\s(")
1983 (if (or (not depth) (< curdepth depth))
1984 (progn
1985 (setq curdepth (1+ curdepth))
1986 (setq ts (cons (cons 'open-paren
1987 (cons (match-beginning 0) (match-end 0)))
1988 ts)))
1989 (setq ts (cons
1990 (cons 'semantic-list
1991 (cons (match-beginning 0)
1992 (save-excursion
1993 (condition-case nil
1994 (forward-list 1)
1995 ;; This case makes flex robust
1996 ;; to broken lists.
1997 (error
1998 (goto-char
1999 (funcall
2000 semantic-flex-unterminated-syntax-end-function
2001 'semantic-list
2002 start end))))
2003 (setq ep (point)))))
2004 ts))))
2005 ;; Close parens
2006 ((looking-at "\\s)")
2007 (setq ts (cons (cons 'close-paren
2008 (cons (match-beginning 0) (match-end 0)))
2009 ts))
2010 (setq curdepth (1- curdepth)))
2011 ;; String initiators
2012 ((looking-at "\\s\"")
2013 ;; Zing to the end of this string.
2014 (setq ts (cons (cons 'string
2015 (cons (match-beginning 0)
2016 (save-excursion
2017 (condition-case nil
2018 (forward-sexp 1)
2019 ;; This case makes flex
2020 ;; robust to broken strings.
2021 (error
2022 (goto-char
2023 (funcall
2024 semantic-flex-unterminated-syntax-end-function
2025 'string
2026 start end))))
2027 (setq ep (point)))))
2028 ts)))
2029 ;; comments
2030 ((looking-at cs)
2031 (if (and semantic-ignore-comments
2032 (not semantic-flex-enable-whitespace))
2033 ;; If the language doesn't deal with comments nor
2034 ;; whitespaces, ignore them here.
2035 (let ((comment-start-point (point)))
2036 (forward-comment 1)
2037 (if (eq (point) comment-start-point)
2038 ;; In this case our start-skip string failed
2039 ;; to work properly. Lets try and move over
2040 ;; whatever white space we matched to begin
2041 ;; with.
2042 (skip-syntax-forward "-.'"
2043 (save-excursion
2044 (end-of-line)
2045 (point)))
2046 ;;(forward-comment 1)
2047 ;; Generate newline token if enabled
2048 (if (and semantic-flex-enable-newlines
2049 (bolp))
2050 (backward-char 1)))
2051 (if (eq (point) comment-start-point)
2052 (error "Strange comment syntax prevents lexical analysis"))
2053 (setq ep (point)))
2054 (let ((tk (if semantic-ignore-comments 'whitespace 'comment)))
2055 (save-excursion
2056 (forward-comment 1)
2057 ;; Generate newline token if enabled
2058 (if (and semantic-flex-enable-newlines
2059 (bolp))
2060 (backward-char 1))
2061 (setq ep (point)))
2062 ;; Language wants comments or want them as whitespaces,
2063 ;; link them together.
2064 (if (eq (car (car ts)) tk)
2065 (setcdr (cdr (car ts)) ep)
2066 (setq ts (cons (cons tk (cons (match-beginning 0) ep))
2067 ts))))))
2068 ;; punctuation
2069 ((looking-at "\\(\\s.\\|\\s$\\|\\s'\\)")
2070 (setq ts (cons (cons 'punctuation
2071 (cons (match-beginning 0) (match-end 0)))
2072 ts)))
2073 ;; unknown token
2074 (t
2075 (error "What is that?")))
2076 (goto-char (or ep (match-end 0)))
2077 (setq ep nil)))
2078 ;; maybe catch the last beginning of line when needed
2079 (and semantic-flex-enable-bol
2080 (= (point) end)
2081 (bolp)
2082 (setq ts (cons (cons 'bol (cons (point) (point))) ts)))
2083 (goto-char pos)
2084 ;;(message "Flexing muscles...done")
2085 (nreverse ts)))
2086
2087(provide 'semantic-lex)
2088
2089;;; semantic-lex.el ends here
diff --git a/lisp/cedet/semantic-tag.el b/lisp/cedet/semantic-tag.el
deleted file mode 100644
index afd3333be4f..00000000000
--- a/lisp/cedet/semantic-tag.el
+++ /dev/null
@@ -1,1569 +0,0 @@
1;;; semantic-tag.el --- tag creation and access
2
3;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007,
4;;; 2008, 2009 Free Software Foundation, Inc.
5
6;; Author: Eric M. Ludlam <zappo@gnu.org>
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24;;
25;; I. The core production of semantic is the list of tags produced by the
26;; different parsers. This file provides 3 APIs related to tag access:
27;;
28;; 1) Primitive Tag Access
29;; There is a set of common features to all tags. These access
30;; functions can get these values.
31;; 2) Standard Tag Access
32;; A Standard Tag should be produced by most traditional languages
33;; with standard styles common to typed object oriented languages.
34;; These functions can access these data elements from a tag.
35;; 3) Generic Tag Access
36;; Access to tag structure in a more direct way.
37;; ** May not be forward compatible.
38;;
39;; II. There is also an API for tag creation. Use `semantic-tag' to create
40;; a new tag.
41;;
42;; III. Tag Comparison. Allows explicit or comparitive tests to see
43;; if two tags are the same.
44
45;;; History:
46;;
47
48;;; Code:
49;;
50
51;; Keep this only so long as we have obsolete fcns.
52(require 'semantic-fw)
53
54(defconst semantic-tag-version semantic-version
55 "Version string of semantic tags made with this code.")
56
57(defconst semantic-tag-incompatible-version "1.0"
58 "Version string of semantic tags which are not currently compatible.
59These old style tags may be loaded from a file with semantic db.
60In this case, we must flush the old tags and start over.")
61
62;;; Primitive Tag access system:
63;;
64;; Raw tags in semantic are lists of 5 elements:
65;;
66;; (NAME CLASS ATTRIBUTES PROPERTIES OVERLAY)
67;;
68;; Where:
69;;
70;; - NAME is a string that represents the tag name.
71;;
72;; - CLASS is a symbol that represent the class of the tag (for
73;; example, usual classes are `type', `function', `variable',
74;; `include', `package', `code').
75;;
76;; - ATTRIBUTES is a public list of attributes that describes
77;; language data represented by the tag (for example, a variable
78;; can have a `:constant-flag' attribute, a function an `:arguments'
79;; attribute, etc.).
80;;
81;; - PROPERTIES is a private list of properties used internally.
82;;
83;; - OVERLAY represent the location of data described by the tag.
84;;
85
86(defsubst semantic-tag-name (tag)
87 "Return the name of TAG.
88For functions, variables, classes, typedefs, etc., this is the identifier
89that is being defined. For tags without an obvious associated name, this
90may be the statement type, e.g., this may return @code{print} for python's
91print statement."
92 (car tag))
93
94(defsubst semantic-tag-class (tag)
95 "Return the class of TAG.
96That is, the symbol 'variable, 'function, 'type, or other.
97There is no limit to the symbols that may represent the class of a tag.
98Each parser generates tags with classes defined by it.
99
100For functional languages, typical tag classes are:
101
102@table @code
103@item type
104Data types, named map for a memory block.
105@item function
106A function or method, or named execution location.
107@item variable
108A variable, or named storage for data.
109@item include
110Statement that represents a file from which more tags can be found.
111@item package
112Statement that declairs this file's package name.
113@item code
114Code that has not name or binding to any other symbol, such as in a script.
115@end table
116"
117 (nth 1 tag))
118
119(defsubst semantic-tag-attributes (tag)
120 "Return the list of public attributes of TAG.
121That is a property list: (ATTRIBUTE-1 VALUE-1 ATTRIBUTE-2 VALUE-2...)."
122 (nth 2 tag))
123
124(defsubst semantic-tag-properties (tag)
125 "Return the list of private properties of TAG.
126That is a property list: (PROPERTY-1 VALUE-1 PROPERTY-2 VALUE-2...)."
127 (nth 3 tag))
128
129(defsubst semantic-tag-overlay (tag)
130 "Return the OVERLAY part of TAG.
131That is, an overlay or an unloaded buffer representation.
132This function can also return an array of the form [ START END ].
133This occurs for tags that are not currently linked into a buffer."
134 (nth 4 tag))
135
136(defsubst semantic--tag-overlay-cdr (tag)
137 "Return the cons cell whose car is the OVERLAY part of TAG.
138That function is for internal use only."
139 (nthcdr 4 tag))
140
141(defsubst semantic--tag-set-overlay (tag overlay)
142 "Set the overlay part of TAG with OVERLAY.
143That function is for internal use only."
144 (setcar (semantic--tag-overlay-cdr tag) overlay))
145
146(defsubst semantic-tag-start (tag)
147 "Return the start location of TAG."
148 (let ((o (semantic-tag-overlay tag)))
149 (if (semantic-overlay-p o)
150 (semantic-overlay-start o)
151 (aref o 0))))
152
153(defsubst semantic-tag-end (tag)
154 "Return the end location of TAG."
155 (let ((o (semantic-tag-overlay tag)))
156 (if (semantic-overlay-p o)
157 (semantic-overlay-end o)
158 (aref o 1))))
159
160(defsubst semantic-tag-bounds (tag)
161 "Return the location (START END) of data TAG describes."
162 (list (semantic-tag-start tag)
163 (semantic-tag-end tag)))
164
165(defun semantic-tag-set-bounds (tag start end)
166 "In TAG, set the START and END location of data it describes."
167 (let ((o (semantic-tag-overlay tag)))
168 (if (semantic-overlay-p o)
169 (semantic-overlay-move o start end)
170 (semantic--tag-set-overlay tag (vector start end)))))
171
172(defun semantic-tag-in-buffer-p (tag)
173 "Return the buffer TAG resides in IFF tag is already in a buffer.
174If a tag is not in a buffer, return nil."
175 (let ((o (semantic-tag-overlay tag)))
176 ;; TAG is currently linked to a buffer, return it.
177 (when (and (semantic-overlay-p o)
178 (semantic-overlay-live-p o))
179 (semantic-overlay-buffer o))))
180
181(defsubst semantic--tag-get-property (tag property)
182 "From TAG, extract the value of PROPERTY.
183Return the value found, or nil if PROPERTY is not one of the
184properties of TAG.
185That function is for internal use only."
186 (plist-get (semantic-tag-properties tag) property))
187
188(defun semantic-tag-buffer (tag)
189 "Return the buffer TAG resides in.
190If TAG has an originating file, read that file into a (maybe new)
191buffer, and return it.
192Return nil if there is no buffer for this tag."
193 (let ((buff (semantic-tag-in-buffer-p tag)))
194 (if buff
195 buff
196 ;; TAG has an originating file, read that file into a buffer, and
197 ;; return it.
198 (if (semantic--tag-get-property tag :filename)
199 (find-file-noselect (semantic--tag-get-property tag :filename))
200 ;; TAG is not in Emacs right now, no buffer is available.
201 ))))
202
203(defun semantic-tag-mode (&optional tag)
204 "Return the major mode active for TAG.
205TAG defaults to the tag at point in current buffer.
206If TAG has a :mode property return it.
207If point is inside TAG bounds, return the major mode active at point.
208Return the major mode active at beginning of TAG otherwise.
209See also the function `semantic-ctxt-current-mode'."
210 (or tag (setq tag (semantic-current-tag)))
211 (or (semantic--tag-get-property tag :mode)
212 (let ((buffer (semantic-tag-buffer tag))
213 (start (semantic-tag-start tag))
214 (end (semantic-tag-end tag)))
215 (save-excursion
216 (and buffer (set-buffer buffer))
217 ;; Unless point is inside TAG bounds, move it to the
218 ;; beginning of TAG.
219 (or (and (>= (point) start) (< (point) end))
220 (goto-char start))
221 (require 'semantic-ctxt)
222 (semantic-ctxt-current-mode)))))
223
224(defsubst semantic--tag-attributes-cdr (tag)
225 "Return the cons cell whose car is the ATTRIBUTES part of TAG.
226That function is for internal use only."
227 (nthcdr 2 tag))
228
229(defsubst semantic-tag-put-attribute (tag attribute value)
230 "Change value in TAG of ATTRIBUTE to VALUE.
231If ATTRIBUTE already exists, its value is set to VALUE, otherwise the
232new ATTRIBUTE VALUE pair is added.
233Return TAG.
234Use this function in a parser when not all attributes are known at the
235same time."
236 (let* ((plist-cdr (semantic--tag-attributes-cdr tag)))
237 (when (consp plist-cdr)
238 (setcar plist-cdr
239 (semantic-tag-make-plist
240 (plist-put (car plist-cdr) attribute value))))
241 tag))
242
243(defun semantic-tag-put-attribute-no-side-effect (tag attribute value)
244 "Change value in TAG of ATTRIBUTE to VALUE without side effects.
245All cons cells in the attribute list are replicated so that there
246are no side effects if TAG is in shared lists.
247If ATTRIBUTE already exists, its value is set to VALUE, otherwise the
248new ATTRIBUTE VALUE pair is added.
249Return TAG."
250 (let* ((plist-cdr (semantic--tag-attributes-cdr tag)))
251 (when (consp plist-cdr)
252 (setcar plist-cdr
253 (semantic-tag-make-plist
254 (plist-put (copy-sequence (car plist-cdr))
255 attribute value))))
256 tag))
257
258(defsubst semantic-tag-get-attribute (tag attribute)
259 "From TAG, return the value of ATTRIBUTE.
260ATTRIBUTE is a symbol whose specification value to get.
261Return the value found, or nil if ATTRIBUTE is not one of the
262attributes of TAG."
263 (plist-get (semantic-tag-attributes tag) attribute))
264
265;; These functions are for internal use only!
266(defsubst semantic--tag-properties-cdr (tag)
267 "Return the cons cell whose car is the PROPERTIES part of TAG.
268That function is for internal use only."
269 (nthcdr 3 tag))
270
271(defun semantic--tag-put-property (tag property value)
272 "Change value in TAG of PROPERTY to VALUE.
273If PROPERTY already exists, its value is set to VALUE, otherwise the
274new PROPERTY VALUE pair is added.
275Return TAG.
276That function is for internal use only."
277 (let* ((plist-cdr (semantic--tag-properties-cdr tag)))
278 (when (consp plist-cdr)
279 (setcar plist-cdr
280 (semantic-tag-make-plist
281 (plist-put (car plist-cdr) property value))))
282 tag))
283
284(defun semantic--tag-put-property-no-side-effect (tag property value)
285 "Change value in TAG of PROPERTY to VALUE without side effects.
286All cons cells in the property list are replicated so that there
287are no side effects if TAG is in shared lists.
288If PROPERTY already exists, its value is set to VALUE, otherwise the
289new PROPERTY VALUE pair is added.
290Return TAG.
291That function is for internal use only."
292 (let* ((plist-cdr (semantic--tag-properties-cdr tag)))
293 (when (consp plist-cdr)
294 (setcar plist-cdr
295 (semantic-tag-make-plist
296 (plist-put (copy-sequence (car plist-cdr))
297 property value))))
298 tag))
299
300(defun semantic-tag-file-name (tag)
301 "Return the name of the file from which TAG originated.
302Return nil if that information can't be obtained.
303If TAG is from a loaded buffer, then that buffer's filename is used.
304If TAG is unlinked, but has a :filename property, then that is used."
305 (let ((buffer (semantic-tag-in-buffer-p tag)))
306 (if buffer
307 (buffer-file-name buffer)
308 (semantic--tag-get-property tag :filename))))
309
310;;; Tag tests and comparisons.
311;;
312;;;###autoload
313(defsubst semantic-tag-p (tag)
314 "Return non-nil if TAG is most likely a semantic tag."
315 (condition-case nil
316 (and (consp tag)
317 (stringp (car tag)) ; NAME
318 (symbolp (nth 1 tag)) (nth 1 tag) ; TAG-CLASS
319 (listp (nth 2 tag)) ; ATTRIBUTES
320 (listp (nth 3 tag)) ; PROPERTIES
321 )
322 ;; If an error occurs, then it most certainly is not a tag.
323 (error nil)))
324
325(defsubst semantic-tag-of-class-p (tag class)
326 "Return non-nil if class of TAG is CLASS."
327 (eq (semantic-tag-class tag) class))
328
329(defsubst semantic-tag-type-members (tag)
330 "Return the members of the type that TAG describes.
331That is the value of the `:members' attribute."
332 (semantic-tag-get-attribute tag :members))
333
334(defun semantic-tag-with-position-p (tag)
335 "Return non-nil if TAG has positional information."
336 (and (semantic-tag-p tag)
337 (let ((o (semantic-tag-overlay tag)))
338 (or (and (semantic-overlay-p o)
339 (semantic-overlay-live-p o))
340 (arrayp o)))))
341
342(defun semantic-equivalent-tag-p (tag1 tag2)
343 "Compare TAG1 and TAG2 and return non-nil if they are equivalent.
344Use `equal' on elements the name, class, and position.
345Use this function if tags are being copied and regrouped to test
346for if two tags represent the same thing, but may be constructed
347of different cons cells."
348 (and (equal (semantic-tag-name tag1) (semantic-tag-name tag2))
349 (semantic-tag-of-class-p tag1 (semantic-tag-class tag2))
350 (or (and (not (semantic-tag-overlay tag1))
351 (not (semantic-tag-overlay tag2)))
352 (and (semantic-tag-overlay tag1)
353 (semantic-tag-overlay tag2)
354 (equal (semantic-tag-bounds tag1)
355 (semantic-tag-bounds tag2))))))
356
357(defsubst semantic-tag-type (tag)
358 "Return the value of the `:type' attribute of TAG.
359For a function it would be the data type of the return value.
360For a variable, it is the storage type of that variable.
361For a data type, the type is the style of datatype, such as
362struct or union."
363 (semantic-tag-get-attribute tag :type))
364
365(defun semantic-tag-similar-p (tag1 tag2 &rest ignorable-attributes)
366 "Test to see if TAG1 and TAG2 are similar.
367Two tags are similar if their name, datatype, and various attributes
368are the same.
369
370Similar tags that have sub-tags such as arg lists or type members,
371are similar w/out checking the sub-list of tags.
372Optional argument IGNORABLE-ATTRIBUTES are attributes to ignore while comparing similarity."
373 (let* ((A1 (and (equal (semantic-tag-name tag1) (semantic-tag-name tag2))
374 (semantic-tag-of-class-p tag1 (semantic-tag-class tag2))
375 (semantic-tag-of-type-p tag1 (semantic-tag-type tag2))))
376 (attr1 (semantic-tag-attributes tag1))
377 (A2 (= (length attr1) (length (semantic-tag-attributes tag2))))
378 (A3 t)
379 )
380 (when (and (not A2) ignorable-attributes)
381 (setq A2 t))
382 (while (and A2 attr1 A3)
383 (let ((a (car attr1))
384 (v (car (cdr attr1))))
385
386 (cond ((or (eq a :type) ;; already tested above.
387 (memq a ignorable-attributes)) ;; Ignore them...
388 nil)
389
390 ;; Don't test sublists of tags
391 ((and (listp v) (semantic-tag-p (car v)))
392 nil)
393
394 ;; The attributes are not the same?
395 ((not (equal v (semantic-tag-get-attribute tag2 a)))
396 (setq A3 nil))
397 (t
398 nil))
399 )
400 (setq attr1 (cdr (cdr attr1))))
401
402 (and A1 A2 A3)
403 ))
404
405(defun semantic-tag-similar-with-subtags-p (tag1 tag2 &rest ignorable-attributes)
406 "Test to see if TAG1 and TAG2 are similar.
407Uses `semantic-tag-similar-p' but also recurses through sub-tags, such
408as argument lists and type members.
409Optional argument IGNORABLE-ATTRIBUTES is passed down to
410`semantic-tag-similar-p'."
411 (let ((C1 (semantic-tag-components tag1))
412 (C2 (semantic-tag-components tag2))
413 )
414 (if (or (/= (length C1) (length C2))
415 (not (semantic-tag-similar-p tag1 tag2 ignorable-attributes))
416 )
417 ;; Basic test fails.
418 nil
419 ;; Else, check component lists.
420 (catch 'component-dissimilar
421 (while C1
422
423 (if (not (semantic-tag-similar-with-subtags-p
424 (car C1) (car C2) ignorable-attributes))
425 (throw 'component-dissimilar nil))
426
427 (setq C1 (cdr C1))
428 (setq C2 (cdr C2))
429 )
430 ;; If we made it this far, we are ok.
431 t) )))
432
433
434(defun semantic-tag-of-type-p (tag type)
435 "Compare TAG's type against TYPE. Non nil if equivalent.
436TYPE can be a string, or a tag of class 'type.
437This can be complex since some tags might have a :type that is a tag,
438while other tags might just have a string. This function will also be
439return true of TAG's type is compared directly to the declaration of a
440data type."
441 (let* ((tagtype (semantic-tag-type tag))
442 (tagtypestring (cond ((stringp tagtype)
443 tagtype)
444 ((and (semantic-tag-p tagtype)
445 (semantic-tag-of-class-p tagtype 'type))
446 (semantic-tag-name tagtype))
447 (t "")))
448 (typestring (cond ((stringp type)
449 type)
450 ((and (semantic-tag-p type)
451 (semantic-tag-of-class-p type 'type))
452 (semantic-tag-name type))
453 (t "")))
454 )
455 (and
456 tagtypestring
457 (or
458 ;; Matching strings (input type is string)
459 (and (stringp type)
460 (string= tagtypestring type))
461 ;; Matching strings (tag type is string)
462 (and (stringp tagtype)
463 (string= tagtype typestring))
464 ;; Matching tokens, and the type of the type is the same.
465 (and (string= tagtypestring typestring)
466 (if (and (semantic-tag-type tagtype) (semantic-tag-type type))
467 (equal (semantic-tag-type tagtype) (semantic-tag-type type))
468 t))
469 ))
470 ))
471
472(defun semantic-tag-type-compound-p (tag)
473 "Return non-nil the type of TAG is compound.
474Compound implies a structure or similar data type.
475Returns the list of tag members if it is compound."
476 (let* ((tagtype (semantic-tag-type tag))
477 )
478 (when (and (semantic-tag-p tagtype)
479 (semantic-tag-of-class-p tagtype 'type))
480 ;; We have the potential of this being a nifty compound type.
481 (semantic-tag-type-members tagtype)
482 )))
483
484(defun semantic-tag-faux-p (tag)
485 "Return non-nil if TAG is a FAUX tag.
486FAUX tags are created to represent a construct that is
487not known to exist in the code.
488
489Example: When the class browser sees methods to a class, but
490cannot find the class, it will create a faux tag to represent the
491class to store those methods."
492 (semantic--tag-get-property tag :faux-flag))
493
494;;; Tag creation
495;;
496
497;; Is this function still necessary?
498(defun semantic-tag-make-plist (args)
499 "Create a property list with ARGS.
500Args is a property list of the form (KEY1 VALUE1 ... KEYN VALUEN).
501Where KEY is a symbol, and VALUE is the value for that symbol.
502The return value will be a new property list, with these KEY/VALUE
503pairs eliminated:
504
505 - KEY associated to nil VALUE.
506 - KEY associated to an empty string VALUE.
507 - KEY associated to a zero VALUE."
508 (let (plist key val)
509 (while args
510 (setq key (car args)
511 val (nth 1 args)
512 args (nthcdr 2 args))
513 (or (member val '("" nil))
514 (and (numberp val) (zerop val))
515 (setq plist (cons key (cons val plist)))))
516 ;; It is not useful to reverse the new plist.
517 plist))
518
519(defsubst semantic-tag (name class &rest attributes)
520 "Create a generic semantic tag.
521NAME is a string representing the name of this tag.
522CLASS is the symbol that represents the class of tag this is,
523such as 'variable, or 'function.
524ATTRIBUTES is a list of additional attributes belonging to this tag."
525 (list name class (semantic-tag-make-plist attributes) nil nil))
526
527(defsubst semantic-tag-new-variable (name type &optional default-value &rest attributes)
528 "Create a semantic tag of class 'variable.
529NAME is the name of this variable.
530TYPE is a string or semantic tag representing the type of this variable.
531Optional DEFAULT-VALUE is a string representing the default value of this variable.
532ATTRIBUTES is a list of additional attributes belonging to this tag."
533 (apply 'semantic-tag name 'variable
534 :type type
535 :default-value default-value
536 attributes))
537
538(defsubst semantic-tag-new-function (name type arg-list &rest attributes)
539 "Create a semantic tag of class 'function.
540NAME is the name of this function.
541TYPE is a string or semantic tag representing the type of this function.
542ARG-LIST is a list of strings or semantic tags representing the
543arguments of this function.
544ATTRIBUTES is a list of additional attributes belonging to this tag."
545 (apply 'semantic-tag name 'function
546 :type type
547 :arguments arg-list
548 attributes))
549
550(defsubst semantic-tag-new-type (name type members parents &rest attributes)
551 "Create a semantic tag of class 'type.
552NAME is the name of this type.
553TYPE is a string or semantic tag representing the type of this type.
554MEMBERS is a list of strings or semantic tags representing the
555elements that make up this type if it is a composite type.
556PARENTS is a cons cell. (EXPLICIT-PARENTS . INTERFACE-PARENTS)
557EXPLICIT-PARENTS can be a single string (Just one parent) or a
558list of parents (in a multiple inheritance situation). It can also
559be nil.
560INTERFACE-PARENTS is a list of strings representing the names of
561all INTERFACES, or abstract classes inherited from. It can also be
562nil.
563This slot can be interesting because the form:
564 ( nil \"string\")
565is a valid parent where there is no explicit parent, and only an
566interface.
567ATTRIBUTES is a list of additional attributes belonging to this tag."
568 (apply 'semantic-tag name 'type
569 :type type
570 :members members
571 :superclasses (car parents)
572 :interfaces (cdr parents)
573 attributes))
574
575(defsubst semantic-tag-new-include (name system-flag &rest attributes)
576 "Create a semantic tag of class 'include.
577NAME is the name of this include.
578SYSTEM-FLAG represents that we were able to identify this include as belonging
579to the system, as opposed to belonging to the local project.
580ATTRIBUTES is a list of additional attributes belonging to this tag."
581 (apply 'semantic-tag name 'include
582 :system-flag system-flag
583 attributes))
584
585(defsubst semantic-tag-new-package (name detail &rest attributes)
586 "Create a semantic tag of class 'package.
587NAME is the name of this package.
588DETAIL is extra information about this package, such as a location where
589it can be found.
590ATTRIBUTES is a list of additional attributes belonging to this tag."
591 (apply 'semantic-tag name 'package
592 :detail detail
593 attributes))
594
595(defsubst semantic-tag-new-code (name detail &rest attributes)
596 "Create a semantic tag of class 'code.
597NAME is a name for this code.
598DETAIL is extra information about the code.
599ATTRIBUTES is a list of additional attributes belonging to this tag."
600 (apply 'semantic-tag name 'code
601 :detail detail
602 attributes))
603
604(defsubst semantic-tag-set-faux (tag)
605 "Set TAG to be a new FAUX tag.
606FAUX tags represent constructs not found in the source code.
607You can identify a faux tag with `semantic-tag-faux-p'"
608 (semantic--tag-put-property tag :faux-flag t))
609
610(defsubst semantic-tag-set-name (tag name)
611 "Set TAG name to NAME."
612 (setcar tag name))
613
614;;; Copying and cloning tags.
615;;
616(defsubst semantic-tag-clone (tag &optional name)
617 "Clone TAG, creating a new TAG.
618If optional argument NAME is not nil it specifies a new name for the
619cloned tag."
620 ;; Right now, TAG is a list.
621 (list (or name (semantic-tag-name tag))
622 (semantic-tag-class tag)
623 (copy-sequence (semantic-tag-attributes tag))
624 (copy-sequence (semantic-tag-properties tag))
625 (semantic-tag-overlay tag)))
626
627(defun semantic-tag-copy (tag &optional name keep-file)
628 "Return a copy of TAG unlinked from the originating buffer.
629If optional argument NAME is non-nil it specifies a new name for the
630copied tag.
631If optional argument KEEP-FILE is non-nil, and TAG was linked to a
632buffer, the originating buffer file name is kept in the `:filename'
633property of the copied tag.
634If KEEP-FILE is a string, and the orginating buffer is NOT available,
635then KEEP-FILE is stored on the `:filename' property.
636This runs the tag hook `unlink-copy-hook`."
637 ;; Right now, TAG is a list.
638 (let ((copy (semantic-tag-clone tag name)))
639
640 ;; Keep the filename if needed.
641 (when keep-file
642 (semantic--tag-put-property
643 copy :filename (or (semantic-tag-file-name copy)
644 (and (stringp keep-file)
645 keep-file)
646 )))
647
648 (when (semantic-tag-with-position-p tag)
649 ;; Convert the overlay to a vector, effectively 'unlinking' the tag.
650 (semantic--tag-set-overlay
651 copy (vector (semantic-tag-start copy) (semantic-tag-end copy)))
652
653 ;; Force the children to be copied also.
654 ;;(let ((chil (semantic--tag-copy-list
655 ;; (semantic-tag-components-with-overlays tag)
656 ;; keep-file)))
657 ;;;; Put the list into TAG.
658 ;;)
659
660 ;; Call the unlink-copy hook. This should tell tools that
661 ;; this tag is not part of any buffer.
662 (when (semantic-overlay-p (semantic-tag-overlay tag))
663 (semantic--tag-run-hooks copy 'unlink-copy-hook))
664 )
665 copy))
666
667;;(defun semantic--tag-copy-list (tags &optional keep-file)
668;; "Make copies of TAGS and return the list of TAGS."
669;; (let ((out nil))
670;; (dolist (tag tags out)
671;; (setq out (cons (semantic-tag-copy tag nil keep-file)
672;; out))
673;; )))
674
675(defun semantic--tag-copy-properties (tag1 tag2)
676 "Copy private properties from TAG1 to TAG2.
677Return TAG2.
678This function is for internal use only."
679 (let ((plist (semantic-tag-properties tag1)))
680 (while plist
681 (semantic--tag-put-property tag2 (car plist) (nth 1 plist))
682 (setq plist (nthcdr 2 plist)))
683 tag2))
684
685;;; DEEP COPIES
686;;
687(defun semantic-tag-deep-copy-one-tag (tag &optional filter)
688 "Make a deep copy of TAG, applying FILTER to each child-tag.
689Properties and overlay info are not copied.
690FILTER takes TAG as an argument, and should returns a semantic-tag.
691It is safe for FILTER to modify the input tag and return it."
692 (when (not filter) (setq filter 'identity))
693 (when (not (semantic-tag-p tag))
694 (signal 'wrong-type-argument (list tag 'semantic-tag-p)))
695 (funcall filter (list (semantic-tag-name tag)
696 (semantic-tag-class tag)
697 (semantic--tag-deep-copy-attributes
698 (semantic-tag-attributes tag) filter)
699 nil
700 nil)))
701
702(defun semantic--tag-deep-copy-attributes (attrs &optional filter)
703 "Make a deep copy of ATTRS, applying FILTER to each child-tag.
704
705It is safe to modify ATTR, and return a permutaion of that list.
706
707FILTER takes TAG as an argument, and should returns a semantic-tag.
708It is safe for FILTER to modify the input tag and return it."
709 (when (car attrs)
710 (when (not (symbolp (car attrs))) (error "Bad Attribute List in tag"))
711 (cons (car attrs)
712 (cons (semantic--tag-deep-copy-value (nth 1 attrs) filter)
713 (semantic--tag-deep-copy-attributes (nthcdr 2 attrs) filter)))))
714
715(defun semantic--tag-deep-copy-value (value &optional filter)
716 "Make a deep copy of VALUE, applying FILTER to each child-tag.
717
718It is safe to modify VALUE, and return a permutaion of that list.
719
720FILTER takes TAG as an argument, and should returns a semantic-tag.
721It is safe for FILTER to modify the input tag and return it."
722 (cond
723 ;; Another tag.
724 ((semantic-tag-p value)
725 (semantic-tag-deep-copy-one-tag value filter))
726
727 ;; A list of more tags
728 ((and (listp value) (semantic-tag-p (car value)))
729 (semantic--tag-deep-copy-tag-list value filter))
730
731 ;; Some arbitrary data.
732 (t value)))
733
734(defun semantic--tag-deep-copy-tag-list (tags &optional filter)
735 "Make a deep copy of TAGS, applying FILTER to each child-tag.
736
737It is safe to modify the TAGS list, and return a permutaion of that list.
738
739FILTER takes TAG as an argument, and should returns a semantic-tag.
740It is safe for FILTER to modify the input tag and return it."
741 (when (car tags)
742 (if (semantic-tag-p (car tags))
743 (cons (semantic-tag-deep-copy-one-tag (car tags) filter)
744 (semantic--tag-deep-copy-tag-list (cdr tags) filter))
745 (cons (car tags) (semantic--tag-deep-copy-tag-list (cdr tags) filter)))))
746
747
748;;; Standard Tag Access
749;;
750
751;;; Common
752;;
753
754(defsubst semantic-tag-modifiers (tag)
755 "Return the value of the `:typemodifiers' attribute of TAG."
756 (semantic-tag-get-attribute tag :typemodifiers))
757
758(defun semantic-tag-docstring (tag &optional buffer)
759 "Return the documentation of TAG.
760That is the value defined by the `:documentation' attribute.
761Optional argument BUFFER indicates where to get the text from.
762If not provided, then only the POSITION can be provided.
763
764If you want to get documentation for languages that do not store
765the documentation string in the tag itself, use
766`semantic-documentation-for-tag' instead."
767 (let ((p (semantic-tag-get-attribute tag :documentation)))
768 (cond
769 ((stringp p) p) ;; it is the doc string.
770
771 ((semantic-lex-token-with-text-p p)
772 (semantic-lex-token-text p))
773
774 ((and (semantic-lex-token-without-text-p p)
775 buffer)
776 (with-current-buffer buffer
777 (semantic-lex-token-text (car (semantic-lex p (1+ p))))))
778
779 (t nil))))
780
781;;; Generic attributes for tags of any class.
782;;
783(defsubst semantic-tag-named-parent (tag)
784 "Return the parent of TAG.
785That is the value of the `:parent' attribute.
786If a definition can occur outside an actual parent structure, but
787refers to that parent by name, then the :parent attribute should be used."
788 (semantic-tag-get-attribute tag :parent))
789
790;;; Tags of class `type'
791
792(defun semantic-tag-type-superclasses (tag)
793 "Return the list of superclass names of the type that TAG describes."
794 (let ((supers (semantic-tag-get-attribute tag :superclasses)))
795 (cond ((stringp supers)
796 ;; If we have a string, make it a list.
797 (list supers))
798 ((semantic-tag-p supers)
799 ;; If we have one tag, return just the name.
800 (list (semantic-tag-name supers)))
801 ((and (consp supers) (semantic-tag-p (car supers)))
802 ;; If we have a tag list, then return the names.
803 (mapcar (lambda (s) (semantic-tag-name s))
804 supers))
805 ((consp supers)
806 ;; A list of something, return it.
807 supers))))
808
809(defun semantic--tag-find-parent-by-name (name supers)
810 "Find the superclass NAME in the list of SUPERS.
811If a simple search doesn't do it, try splitting up the names
812in SUPERS."
813 (let ((stag nil))
814 (setq stag (semantic-find-first-tag-by-name name supers))
815
816 (when (not stag)
817 (dolist (S supers)
818 (let* ((sname (semantic-tag-name S))
819 (splitparts (semantic-analyze-split-name sname))
820 (parts (if (stringp splitparts)
821 (list splitparts)
822 (nreverse splitparts))))
823 (when (string= name (car parts))
824 (setq stag S))
825 )))
826
827 stag))
828
829(defun semantic-tag-type-superclass-protection (tag parentstring)
830 "Return the inheritance protection in TAG from PARENTSTRING.
831PARENTSTRING is the name of the parent being inherited.
832The return protection is a symbol, 'public, 'protection, and 'private."
833 (let ((supers (semantic-tag-get-attribute tag :superclasses)))
834 (cond ((stringp supers)
835 'public)
836 ((semantic-tag-p supers)
837 (let ((prot (semantic-tag-get-attribute supers :protection)))
838 (or (cdr (assoc prot '(("public" . public)
839 ("protected" . protected)
840 ("private" . private))))
841 'public)))
842 ((and (consp supers) (stringp (car supers)))
843 'public)
844 ((and (consp supers) (semantic-tag-p (car supers)))
845 (let* ((stag (semantic--tag-find-parent-by-name parentstring supers))
846 (prot (when stag
847 (semantic-tag-get-attribute stag :protection))))
848 (or (cdr (assoc prot '(("public" . public)
849 ("protected" . protected)
850 ("private" . private))))
851 (when (equal prot "unspecified")
852 (if (semantic-tag-of-type-p tag "class")
853 'private
854 'public))
855 'public))))
856 ))
857
858(defsubst semantic-tag-type-interfaces (tag)
859 "Return the list of interfaces of the type that TAG describes."
860 ;; @todo - make this as robust as the above.
861 (semantic-tag-get-attribute tag :interfaces))
862
863;;; Tags of class `function'
864;;
865(defsubst semantic-tag-function-arguments (tag)
866 "Return the arguments of the function that TAG describes.
867That is the value of the `:arguments' attribute."
868 (semantic-tag-get-attribute tag :arguments))
869
870(defsubst semantic-tag-function-throws (tag)
871 "Return the exceptions the function that TAG describes can throw.
872That is the value of the `:throws' attribute."
873 (semantic-tag-get-attribute tag :throws))
874
875(defsubst semantic-tag-function-parent (tag)
876 "Return the parent of the function that TAG describes.
877That is the value of the `:parent' attribute.
878A function has a parent if it is a method of a class, and if the
879function does not appear in body of it's parent class."
880 (semantic-tag-named-parent tag))
881
882(defsubst semantic-tag-function-destructor-p (tag)
883 "Return non-nil if TAG describes a destructor function.
884That is the value of the `:destructor-flag' attribute."
885 (semantic-tag-get-attribute tag :destructor-flag))
886
887(defsubst semantic-tag-function-constructor-p (tag)
888 "Return non-nil if TAG describes a constructor function.
889That is the value of the `:constructor-flag' attribute."
890 (semantic-tag-get-attribute tag :constructor-flag))
891
892;;; Tags of class `variable'
893;;
894(defsubst semantic-tag-variable-default (tag)
895 "Return the default value of the variable that TAG describes.
896That is the value of the attribute `:default-value'."
897 (semantic-tag-get-attribute tag :default-value))
898
899(defsubst semantic-tag-variable-constant-p (tag)
900 "Return non-nil if the variable that TAG describes is a constant.
901That is the value of the attribute `:constant-flag'."
902 (semantic-tag-get-attribute tag :constant-flag))
903
904;;; Tags of class `include'
905;;
906(defsubst semantic-tag-include-system-p (tag)
907 "Return non-nil if the include that TAG describes is a system include.
908That is the value of the attribute `:system-flag'."
909 (semantic-tag-get-attribute tag :system-flag))
910
911(define-overloadable-function semantic-tag-include-filename (tag)
912 "Return a filename representation of TAG.
913The default action is to return the `semantic-tag-name'.
914Some languages do not use full filenames in their include statements.
915Override this method to translate the code represenation
916into a filename. (A relative filename if necessary.)
917
918See `semantic-dependency-tag-file' to expand an include
919tag to a full file name.")
920
921(defun semantic-tag-include-filename-default (tag)
922 "Return a filename representation of TAG.
923Returns `semantic-tag-name'."
924 (semantic-tag-name tag))
925
926;;; Tags of class `code'
927;;
928(defsubst semantic-tag-code-detail (tag)
929 "Return detail information from code that TAG describes.
930That is the value of the attribute `:detail'."
931 (semantic-tag-get-attribute tag :detail))
932
933;;; Tags of class `alias'
934;;
935(defsubst semantic-tag-new-alias (name meta-tag-class value &rest attributes)
936 "Create a semantic tag of class alias.
937NAME is a name for this alias.
938META-TAG-CLASS is the class of the tag this tag is an alias.
939VALUE is the aliased definition.
940ATTRIBUTES is a list of additional attributes belonging to this tag."
941 (apply 'semantic-tag name 'alias
942 :aliasclass meta-tag-class
943 :definition value
944 attributes))
945
946(defsubst semantic-tag-alias-class (tag)
947 "Return the class of tag TAG is an alias."
948 (semantic-tag-get-attribute tag :aliasclass))
949
950;;;###autoload
951(define-overloadable-function semantic-tag-alias-definition (tag)
952 "Return the definition TAG is an alias.
953The returned value is a tag of the class that
954`semantic-tag-alias-class' returns for TAG.
955The default is to return the value of the :definition attribute.
956Return nil if TAG is not of class 'alias."
957 (when (semantic-tag-of-class-p tag 'alias)
958 (:override
959 (semantic-tag-get-attribute tag :definition))))
960
961;;; Language Specific Tag access via overload
962;;
963;;;###autoload
964(define-overloadable-function semantic-tag-components (tag)
965 "Return a list of components for TAG.
966A Component is a part of TAG which itself may be a TAG.
967Examples include the elements of a structure in a
968tag of class `type, or the list of arguments to a
969tag of class 'function."
970 )
971
972(defun semantic-tag-components-default (tag)
973 "Return a list of components for TAG.
974Perform the described task in `semantic-tag-components'."
975 (cond ((semantic-tag-of-class-p tag 'type)
976 (semantic-tag-type-members tag))
977 ((semantic-tag-of-class-p tag 'function)
978 (semantic-tag-function-arguments tag))
979 (t nil)))
980
981;;;###autoload
982(define-overloadable-function semantic-tag-components-with-overlays (tag)
983 "Return the list of top level components belonging to TAG.
984Children are any sub-tags which contain overlays.
985
986Default behavior is to get `semantic-tag-components' in addition
987to the components of an anonymous types (if applicable.)
988
989Note for language authors:
990 If a mode defines a language tag that has tags in it with overlays
991you should still return them with this function.
992Ignoring this step will prevent several features from working correctly."
993 )
994
995(defun semantic-tag-components-with-overlays-default (tag)
996 "Return the list of top level components belonging to TAG.
997Children are any sub-tags which contain overlays.
998The default action collects regular components of TAG, in addition
999to any components beloning to an anonymous type."
1000 (let ((explicit-children (semantic-tag-components tag))
1001 (type (semantic-tag-type tag))
1002 (anon-type-children nil)
1003 (all-children nil))
1004 ;; Identify if this tag has an anonymous structure as
1005 ;; its type. This implies it may have children with overlays.
1006 (when (and type (semantic-tag-p type))
1007 (setq anon-type-children (semantic-tag-components type))
1008 ;; Add anonymous children
1009 (while anon-type-children
1010 (when (semantic-tag-with-position-p (car anon-type-children))
1011 (setq all-children (cons (car anon-type-children) all-children)))
1012 (setq anon-type-children (cdr anon-type-children))))
1013 ;; Add explicit children
1014 (while explicit-children
1015 (when (semantic-tag-with-position-p (car explicit-children))
1016 (setq all-children (cons (car explicit-children) all-children)))
1017 (setq explicit-children (cdr explicit-children)))
1018 ;; Return
1019 (nreverse all-children)))
1020
1021(defun semantic-tag-children-compatibility (tag &optional positiononly)
1022 "Return children of TAG.
1023If POSITIONONLY is nil, use `semantic-tag-components'.
1024If POSITIONONLY is non-nil, use `semantic-tag-components-with-overlays'.
1025DO NOT use this fcn in new code. Use one of the above instead."
1026 (if positiononly
1027 (semantic-tag-components-with-overlays tag)
1028 (semantic-tag-components tag)))
1029
1030;;; Tag Region
1031;;
1032;; A Tag represents a region in a buffer. You can narrow to that tag.
1033;;
1034(defun semantic-narrow-to-tag (&optional tag)
1035 "Narrow to the region specified by the bounds of TAG.
1036See `semantic-tag-bounds'."
1037 (interactive)
1038 (if (not tag) (setq tag (semantic-current-tag)))
1039 (narrow-to-region (semantic-tag-start tag)
1040 (semantic-tag-end tag)))
1041
1042(defmacro semantic-with-buffer-narrowed-to-current-tag (&rest body)
1043 "Execute BODY with the buffer narrowed to the current tag."
1044 `(save-restriction
1045 (semantic-narrow-to-tag (semantic-current-tag))
1046 ,@body))
1047(put 'semantic-with-buffer-narrowed-to-current-tag 'lisp-indent-function 0)
1048(add-hook 'edebug-setup-hook
1049 (lambda ()
1050 (def-edebug-spec semantic-with-buffer-narrowed-to-current-tag
1051 (def-body))))
1052
1053(defmacro semantic-with-buffer-narrowed-to-tag (tag &rest body)
1054 "Narrow to TAG, and execute BODY."
1055 `(save-restriction
1056 (semantic-narrow-to-tag ,tag)
1057 ,@body))
1058(put 'semantic-with-buffer-narrowed-to-tag 'lisp-indent-function 1)
1059(add-hook 'edebug-setup-hook
1060 (lambda ()
1061 (def-edebug-spec semantic-with-buffer-narrowed-to-tag
1062 (def-body))))
1063
1064;;; Tag Hooks
1065;;
1066;; Semantic may want to provide special hooks when specific operations
1067;; are about to happen on a given tag. These routines allow for hook
1068;; maintenance on a tag.
1069
1070;; Internal global variable used to manage tag hooks. For example,
1071;; some implementation of `remove-hook' checks that the hook variable
1072;; is `default-boundp'.
1073(defvar semantic--tag-hook-value)
1074
1075(defun semantic-tag-add-hook (tag hook function &optional append)
1076 "Onto TAG, add to the value of HOOK the function FUNCTION.
1077FUNCTION is added (if necessary) at the beginning of the hook list
1078unless the optional argument APPEND is non-nil, in which case
1079FUNCTION is added at the end.
1080HOOK should be a symbol, and FUNCTION may be any valid function.
1081See also the function `add-hook'."
1082 (let ((semantic--tag-hook-value (semantic--tag-get-property tag hook)))
1083 (add-hook 'semantic--tag-hook-value function append)
1084 (semantic--tag-put-property tag hook semantic--tag-hook-value)
1085 semantic--tag-hook-value))
1086
1087(defun semantic-tag-remove-hook (tag hook function)
1088 "Onto TAG, remove from the value of HOOK the function FUNCTION.
1089HOOK should be a symbol, and FUNCTION may be any valid function. If
1090FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in
1091the list of hooks to run in HOOK, then nothing is done.
1092See also the function `remove-hook'."
1093 (let ((semantic--tag-hook-value (semantic--tag-get-property tag hook)))
1094 (remove-hook 'semantic--tag-hook-value function)
1095 (semantic--tag-put-property tag hook semantic--tag-hook-value)
1096 semantic--tag-hook-value))
1097
1098(defun semantic--tag-run-hooks (tag hook &rest args)
1099 "Run for TAG all expressions saved on the property HOOK.
1100Each hook expression must take at least one argument, the TAG.
1101For any given situation, additional ARGS may be passed."
1102 (let ((semantic--tag-hook-value (semantic--tag-get-property tag hook))
1103 (arglist (cons tag args)))
1104 (condition-case err
1105 ;; If a hook bombs, ignore it! Usually this is tied into
1106 ;; some sort of critical system.
1107 (apply 'run-hook-with-args 'semantic--tag-hook-value arglist)
1108 (error (message "Error: %S" err)))))
1109
1110;;; Tags and Overlays
1111;;
1112;; Overlays are used so that we can quickly identify tags from
1113;; buffer positions and regions using built in Emacs commands.
1114;;
1115
1116(defsubst semantic--tag-unlink-list-from-buffer (tags)
1117 "Convert TAGS from using an overlay to using an overlay proxy.
1118This function is for internal use only."
1119 (mapcar 'semantic--tag-unlink-from-buffer tags))
1120
1121(defun semantic--tag-unlink-from-buffer (tag)
1122 "Convert TAG from using an overlay to using an overlay proxy.
1123This function is for internal use only."
1124 (when (semantic-tag-p tag)
1125 (let ((o (semantic-tag-overlay tag)))
1126 (when (semantic-overlay-p o)
1127 (semantic--tag-set-overlay
1128 tag (vector (semantic-overlay-start o)
1129 (semantic-overlay-end o)))
1130 (semantic-overlay-delete o))
1131 ;; Look for a link hook on TAG.
1132 (semantic--tag-run-hooks tag 'unlink-hook)
1133 ;; Fix the sub-tags which contain overlays.
1134 (semantic--tag-unlink-list-from-buffer
1135 (semantic-tag-components-with-overlays tag)))))
1136
1137(defsubst semantic--tag-link-list-to-buffer (tags)
1138 "Convert TAGS from using an overlay proxy to using an overlay.
1139This function is for internal use only."
1140 (mapcar 'semantic--tag-link-to-buffer tags))
1141
1142(defun semantic--tag-link-to-buffer (tag)
1143 "Convert TAG from using an overlay proxy to using an overlay.
1144This function is for internal use only."
1145 (when (semantic-tag-p tag)
1146 (let ((o (semantic-tag-overlay tag)))
1147 (when (and (vectorp o) (= (length o) 2))
1148 (setq o (semantic-make-overlay (aref o 0) (aref o 1)
1149 (current-buffer)))
1150 (semantic--tag-set-overlay tag o)
1151 (semantic-overlay-put o 'semantic tag)
1152 ;; Clear the :filename property
1153 (semantic--tag-put-property tag :filename nil))
1154 ;; Look for a link hook on TAG.
1155 (semantic--tag-run-hooks tag 'link-hook)
1156 ;; Fix the sub-tags which contain overlays.
1157 (semantic--tag-link-list-to-buffer
1158 (semantic-tag-components-with-overlays tag)))))
1159
1160(defun semantic--tag-unlink-cache-from-buffer ()
1161 "Convert all tags in the current cache to use overlay proxys.
1162This function is for internal use only."
1163 (semantic--tag-unlink-list-from-buffer
1164 ;; @todo- use fetch-tags-fast?
1165 (semantic-fetch-tags)))
1166
1167(defvar semantic--buffer-cache)
1168
1169(defun semantic--tag-link-cache-to-buffer ()
1170 "Convert all tags in the current cache to use overlays.
1171This function is for internal use only."
1172 (condition-case nil
1173 ;; In this unique case, we cannot call the usual toplevel fn.
1174 ;; because we don't want a reparse, we want the old overlays.
1175 (semantic--tag-link-list-to-buffer
1176 semantic--buffer-cache)
1177 ;; Recover when there is an error restoring the cache.
1178 (error (message "Error recovering tag list")
1179 (semantic-clear-toplevel-cache)
1180 nil)))
1181
1182;;; Tag Cooking
1183;;
1184;; Raw tags from a parser follow a different positional format than
1185;; those used in the buffer cache. Raw tags need to be cooked into
1186;; semantic cache friendly tags for use by the masses.
1187;;
1188(defsubst semantic--tag-expanded-p (tag)
1189 "Return non-nil if TAG is expanded.
1190This function is for internal use only.
1191See also the function `semantic--expand-tag'."
1192 ;; In fact a cooked tag is actually a list of cooked tags
1193 ;; because a raw tag can be expanded in several cooked ones!
1194 (when (consp tag)
1195 (while (and (semantic-tag-p (car tag))
1196 (vectorp (semantic-tag-overlay (car tag))))
1197 (setq tag (cdr tag)))
1198 (null tag)))
1199
1200(defvar semantic-tag-expand-function nil
1201 "Function used to expand a tag.
1202It is passed each tag production, and must return a list of tags
1203derived from it, or nil if it does not need to be expanded.
1204
1205Languages with compound definitions should use this function to expand
1206from one compound symbol into several. For example, in C or Java the
1207following definition is easily parsed into one tag:
1208
1209 int a, b;
1210
1211This function should take this compound tag and turn it into two tags,
1212one for A, and the other for B.")
1213(make-variable-buffer-local 'semantic-tag-expand-function)
1214
1215(defun semantic--tag-expand (tag)
1216 "Convert TAG from a raw state to a cooked state, and expand it.
1217Returns a list of cooked tags.
1218
1219 The parser returns raw tags with positional data START END at the
1220end of the tag data structure (a list for now). We convert it from
1221that to a cooked state that uses an overlay proxy, that is, a vector
1222\[START END].
1223
1224 The raw tag is changed with side effects and maybe expanded in
1225several derived tags when the variable `semantic-tag-expand-function'
1226is set.
1227
1228This function is for internal use only."
1229 (if (semantic--tag-expanded-p tag)
1230 ;; Just return TAG if it is already expanded (by a grammar
1231 ;; semantic action), or if it isn't recognized as a valid
1232 ;; semantic tag.
1233 tag
1234
1235 ;; Try to cook the tag. This code will be removed when tag will
1236 ;; be directly created with the right format.
1237 (condition-case nil
1238 (let ((ocdr (semantic--tag-overlay-cdr tag)))
1239 ;; OCDR contains the sub-list of TAG whose car is the
1240 ;; OVERLAY part of TAG. That is, a list (OVERLAY START END).
1241 ;; Convert it into an overlay proxy ([START END]).
1242 (semantic--tag-set-overlay
1243 tag (vector (nth 1 ocdr) (nth 2 ocdr)))
1244 ;; Remove START END positions at end of tag.
1245 (setcdr ocdr nil)
1246 ;; At this point (length TAG) must be 5!
1247 ;;(unless (= (length tag) 5)
1248 ;; (error "Tag expansion failed"))
1249 )
1250 (error
1251 (message "A Rule must return a single tag-line list!")
1252 (debug tag)
1253 nil))
1254
1255;; @todo - I think we've waited long enough. Lets find out.
1256;;
1257;; ;; Compatibility code to be removed in future versions.
1258;; (unless semantic-tag-expand-function
1259;; ;; This line throws a byte compiler warning.
1260;; (setq semantic-tag-expand-function semantic-expand-nonterminal)
1261;; )
1262
1263 ;; Expand based on local configuration
1264 (if semantic-tag-expand-function
1265 (or (funcall semantic-tag-expand-function tag)
1266 (list tag))
1267 (list tag))))
1268
1269;; Foreign tags
1270;;
1271(defmacro semantic-foreign-tag-invalid (tag)
1272 "Signal that TAG is an invalid foreign tag."
1273 `(signal 'wrong-type-argument '(semantic-foreign-tag-p ,tag)))
1274
1275(defsubst semantic-foreign-tag-p (tag)
1276 "Return non-nil if TAG is a foreign tag.
1277That is, a tag unlinked from the originating buffer, which carries the
1278originating buffer file name, and major mode."
1279 (and (semantic-tag-p tag)
1280 (semantic--tag-get-property tag :foreign-flag)))
1281
1282(defsubst semantic-foreign-tag-check (tag)
1283 "Check that TAG is a valid foreign tag.
1284Signal an error if not."
1285 (or (semantic-foreign-tag-p tag)
1286 (semantic-foreign-tag-invalid tag)))
1287
1288(defun semantic-foreign-tag (&optional tag)
1289 "Return a copy of TAG as a foreign tag, or nil if it can't be done.
1290TAG defaults to the tag at point in current buffer.
1291See also `semantic-foreign-tag-p'."
1292 (or tag (setq tag (semantic-current-tag)))
1293 (when (semantic-tag-p tag)
1294 (let ((ftag (semantic-tag-copy tag nil t))
1295 ;; Do extra work for the doc strings, since this is a
1296 ;; common use case.
1297 (doc (condition-case nil
1298 (semantic-documentation-for-tag tag)
1299 (error nil))))
1300 ;; A foreign tag must carry its originating buffer file name!
1301 (when (semantic--tag-get-property ftag :filename)
1302 (semantic--tag-put-property ftag :mode (semantic-tag-mode tag))
1303 (semantic--tag-put-property ftag :documentation doc)
1304 (semantic--tag-put-property ftag :foreign-flag t)
1305 ftag))))
1306
1307;; High level obtain/insert foreign tag overloads
1308;;
1309;;;###autoload
1310(define-overloadable-function semantic-obtain-foreign-tag (&optional tag)
1311 "Obtain a foreign tag from TAG.
1312TAG defaults to the tag at point in current buffer.
1313Return the obtained foreign tag or nil if failed."
1314 (semantic-foreign-tag tag))
1315
1316(defun semantic-insert-foreign-tag-default (foreign-tag)
1317 "Insert FOREIGN-TAG into the current buffer.
1318The default behavior assumes the current buffer is a language file,
1319and attempts to insert a prototype/function call."
1320 ;; Long term goal: Have a mechanism for a tempo-like template insert
1321 ;; for the given tag.
1322 (insert (semantic-format-tag-prototype foreign-tag)))
1323
1324;;;###autoload
1325(define-overloadable-function semantic-insert-foreign-tag (foreign-tag)
1326 "Insert FOREIGN-TAG into the current buffer.
1327Signal an error if FOREIGN-TAG is not a valid foreign tag.
1328This function is overridable with the symbol `insert-foreign-tag'."
1329 (semantic-foreign-tag-check foreign-tag)
1330 (:override)
1331 (message (semantic-format-tag-summarize foreign-tag)))
1332
1333;;; Support log modes here
1334(define-mode-local-override semantic-insert-foreign-tag
1335 log-edit-mode (foreign-tag)
1336 "Insert foreign tags into log-edit mode."
1337 (insert (concat "(" (semantic-format-tag-name foreign-tag) "): ")))
1338
1339(define-mode-local-override semantic-insert-foreign-tag
1340 change-log-mode (foreign-tag)
1341 "Insert foreign tags into log-edit mode."
1342 (insert (concat "(" (semantic-format-tag-name foreign-tag) "): ")))
1343
1344
1345;;; EDEBUG display support
1346;;
1347(eval-after-load "cedet-edebug"
1348 '(progn
1349 (cedet-edebug-add-print-override
1350 '(semantic-tag-p object)
1351 '(concat "#<TAG " (semantic-format-tag-name object) ">"))
1352 (cedet-edebug-add-print-override
1353 '(and (listp object) (semantic-tag-p (car object)))
1354 '(cedet-edebug-prin1-recurse object))
1355 ))
1356
1357;;; Compatibility
1358;;
1359(defconst semantic-token-version
1360 semantic-tag-version)
1361(defconst semantic-token-incompatible-version
1362 semantic-tag-incompatible-version)
1363
1364(semantic-alias-obsolete 'semantic-token-name
1365 'semantic-tag-name)
1366
1367(semantic-alias-obsolete 'semantic-token-token
1368 'semantic-tag-class)
1369
1370(semantic-alias-obsolete 'semantic-token-extra-specs
1371 'semantic-tag-attributes)
1372
1373(semantic-alias-obsolete 'semantic-token-properties
1374 'semantic-tag-properties)
1375
1376(semantic-alias-obsolete 'semantic-token-properties-cdr
1377 'semantic--tag-properties-cdr)
1378
1379(semantic-alias-obsolete 'semantic-token-overlay
1380 'semantic-tag-overlay)
1381
1382(semantic-alias-obsolete 'semantic-token-overlay-cdr
1383 'semantic--tag-overlay-cdr)
1384
1385(semantic-alias-obsolete 'semantic-token-start
1386 'semantic-tag-start)
1387
1388(semantic-alias-obsolete 'semantic-token-end
1389 'semantic-tag-end)
1390
1391(semantic-alias-obsolete 'semantic-token-extent
1392 'semantic-tag-bounds)
1393
1394(semantic-alias-obsolete 'semantic-token-buffer
1395 'semantic-tag-buffer)
1396
1397(semantic-alias-obsolete 'semantic-token-put
1398 'semantic--tag-put-property)
1399
1400(semantic-alias-obsolete 'semantic-token-put-no-side-effect
1401 'semantic--tag-put-property-no-side-effect)
1402
1403(semantic-alias-obsolete 'semantic-token-get
1404 'semantic--tag-get-property)
1405
1406(semantic-alias-obsolete 'semantic-token-add-extra-spec
1407 'semantic-tag-put-attribute)
1408
1409(semantic-alias-obsolete 'semantic-token-extra-spec
1410 'semantic-tag-get-attribute)
1411
1412(semantic-alias-obsolete 'semantic-token-type
1413 'semantic-tag-type)
1414
1415(semantic-alias-obsolete 'semantic-token-modifiers
1416 'semantic-tag-modifiers)
1417
1418(semantic-alias-obsolete 'semantic-token-docstring
1419 'semantic-tag-docstring)
1420
1421(semantic-alias-obsolete 'semantic-token-type-parts
1422 'semantic-tag-type-members)
1423
1424(defsubst semantic-token-type-parent (tag)
1425 "Return the parent of the type that TAG describes.
1426The return value is a list. A value of nil means no parents.
1427The `car' of the list is either the parent class, or a list
1428of parent classes. The `cdr' of the list is the list of
1429interfaces, or abstract classes which are parents of TAG."
1430 (cons (semantic-tag-get-attribute tag :superclasses)
1431 (semantic-tag-type-interfaces tag)))
1432(make-obsolete 'semantic-token-type-parent
1433 "\
1434use `semantic-tag-type-superclass' \
1435and `semantic-tag-type-interfaces' instead")
1436
1437(semantic-alias-obsolete 'semantic-token-type-parent-superclass
1438 'semantic-tag-type-superclasses)
1439
1440(semantic-alias-obsolete 'semantic-token-type-parent-implement
1441 'semantic-tag-type-interfaces)
1442
1443(semantic-alias-obsolete 'semantic-token-type-extra-specs
1444 'semantic-tag-attributes)
1445
1446(semantic-alias-obsolete 'semantic-token-type-extra-spec
1447 'semantic-tag-get-attribute)
1448
1449(semantic-alias-obsolete 'semantic-token-type-modifiers
1450 'semantic-tag-modifiers)
1451
1452(semantic-alias-obsolete 'semantic-token-function-args
1453 'semantic-tag-function-arguments)
1454
1455(semantic-alias-obsolete 'semantic-token-function-extra-specs
1456 'semantic-tag-attributes)
1457
1458(semantic-alias-obsolete 'semantic-token-function-extra-spec
1459 'semantic-tag-get-attribute)
1460
1461(semantic-alias-obsolete 'semantic-token-function-modifiers
1462 'semantic-tag-modifiers)
1463
1464(semantic-alias-obsolete 'semantic-token-function-throws
1465 'semantic-tag-function-throws)
1466
1467(semantic-alias-obsolete 'semantic-token-function-parent
1468 'semantic-tag-function-parent)
1469
1470(semantic-alias-obsolete 'semantic-token-function-destructor
1471 'semantic-tag-function-destructor-p)
1472
1473(semantic-alias-obsolete 'semantic-token-variable-default
1474 'semantic-tag-variable-default)
1475
1476(semantic-alias-obsolete 'semantic-token-variable-extra-specs
1477 'semantic-tag-attributes)
1478
1479(semantic-alias-obsolete 'semantic-token-variable-extra-spec
1480 'semantic-tag-get-attribute)
1481
1482(semantic-alias-obsolete 'semantic-token-variable-modifiers
1483 'semantic-tag-modifiers)
1484
1485(semantic-alias-obsolete 'semantic-token-variable-const
1486 'semantic-tag-variable-constant-p)
1487
1488(semantic-alias-obsolete 'semantic-token-variable-optsuffix
1489 'semantic-tag-variable-optsuffix)
1490
1491(semantic-alias-obsolete 'semantic-token-include-system
1492 'semantic-tag-include-system-p)
1493
1494(semantic-alias-obsolete 'semantic-token-p
1495 'semantic-tag-p)
1496
1497(semantic-alias-obsolete 'semantic-token-with-position-p
1498 'semantic-tag-with-position-p)
1499
1500(semantic-alias-obsolete 'semantic-tag-make-assoc-list
1501 'semantic-tag-make-plist)
1502
1503(semantic-alias-obsolete 'semantic-nonterminal-children
1504 'semantic-tag-children-compatibility)
1505
1506(semantic-alias-obsolete 'semantic-narrow-to-token
1507 'semantic-narrow-to-tag)
1508
1509(semantic-alias-obsolete 'semantic-with-buffer-narrowed-to-current-token
1510 'semantic-with-buffer-narrowed-to-current-tag)
1511
1512(semantic-alias-obsolete 'semantic-with-buffer-narrowed-to-token
1513 'semantic-with-buffer-narrowed-to-tag)
1514
1515(semantic-alias-obsolete 'semantic-deoverlay-token
1516 'semantic--tag-unlink-from-buffer)
1517
1518(semantic-alias-obsolete 'semantic-overlay-token
1519 'semantic--tag-link-to-buffer)
1520
1521(semantic-alias-obsolete 'semantic-deoverlay-list
1522 'semantic--tag-unlink-list-from-buffer)
1523
1524(semantic-alias-obsolete 'semantic-overlay-list
1525 'semantic--tag-link-list-to-buffer)
1526
1527(semantic-alias-obsolete 'semantic-deoverlay-cache
1528 'semantic--tag-unlink-cache-from-buffer)
1529
1530(semantic-alias-obsolete 'semantic-overlay-cache
1531 'semantic--tag-link-cache-to-buffer)
1532
1533(semantic-alias-obsolete 'semantic-cooked-token-p
1534 'semantic--tag-expanded-p)
1535
1536(semantic-varalias-obsolete 'semantic-expand-nonterminal
1537 'semantic-tag-expand-function)
1538
1539(semantic-alias-obsolete 'semantic-raw-to-cooked-token
1540 'semantic--tag-expand)
1541
1542;; Lets test this out during this short transition.
1543(semantic-alias-obsolete 'semantic-clone-tag
1544 'semantic-tag-clone)
1545
1546(semantic-alias-obsolete 'semantic-token
1547 'semantic-tag)
1548
1549(semantic-alias-obsolete 'semantic-token-new-variable
1550 'semantic-tag-new-variable)
1551
1552(semantic-alias-obsolete 'semantic-token-new-function
1553 'semantic-tag-new-function)
1554
1555(semantic-alias-obsolete 'semantic-token-new-type
1556 'semantic-tag-new-type)
1557
1558(semantic-alias-obsolete 'semantic-token-new-include
1559 'semantic-tag-new-include)
1560
1561(semantic-alias-obsolete 'semantic-token-new-package
1562 'semantic-tag-new-package)
1563
1564(semantic-alias-obsolete 'semantic-equivalent-tokens-p
1565 'semantic-equivalent-tag-p)
1566
1567(provide 'semantic-tag)
1568
1569;;; semantic-tag.el ends here
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-19 23:44:26 +0000