1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
|
;;; ecb-semantic-wrapper.el -- define wrappers for all semantic funcs/vars
;; Copyright (C) 2000 - 2003 Jesper Nordenberg,
;; Klaus Berndl,
;; Free Software Foundation, Inc.
;; Author: Klaus Berndl <klaus.berndl@sdm.de>
;; Maintainer: Klaus Berndl <klaus.berndl@sdm.de>
;; Kevin A. Burton <burton@openprivacy.org>
;; Keywords: browser, code, programming, tools
;; Created: 2003
;; This program is free software; you can redistribute it and/or modify it under
;; the terms of the GNU General Public License as published by the Free Software
;; Foundation; either version 2, or (at your option) any later version.
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
;; details.
;; You should have received a copy of the GNU General Public License along with
;; GNU Emacs; see the file COPYING. If not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
;; $Id: ecb-semantic-wrapper.el,v 1.8 2004-12-10 16:34:17 berndl Exp $
;;; Commentary:
;; This file contains wrappers for every semantic-function and -variable used
;; by ECB independent which semantic version is used. So the ECB-code is
;; independent from the fact, if semantic 2.0 offers backward-compatibility or
;; not. This library offers for each variable V of semantic a getter-function
;; named "ecb--V" and for each function F an alias named "ecb--F". V and F
;; follow the naming conventiones of semantic 2.0 but the resulting functions
;; always point to the correct variable or function of semantic independent
;; which semantic version is loaded. ECB only uses the functions exported from
;; ecb-semantic-wrapper.el!
(require 'semantic)
(defconst ecb-semantic-2-loaded (string-match "^2" semantic-version))
(defconst ecb-semantic-2-beta-nr (if (and ecb-semantic-2-loaded
(string-match "beta\\([1-9]\\).*"
semantic-version))
(string-to-number
(match-string 1 semantic-version))
-1))
(eval-when-compile
(require 'silentcomp))
;; semantic 1.X does not have this
(silentcomp-defvar semanticdb-search-system-databases)
(silentcomp-defvar semantic-format-use-images-flag)
(silentcomp-defvar ezimage-use-images)
;; -- getter functions for all variables of semantic currently used by ECB ---
(defsubst ecb--semantic-symbol->name-assoc-list ()
"Return the value of `semantic-symbol->name-assoc-list'."
(symbol-value 'semantic-symbol->name-assoc-list))
(defsubst ecb--semantic-symbol->name-assoc-list-for-type-parts ()
"Return the value of `semantic-symbol->name-assoc-list-for-type-parts'."
(symbol-value 'semantic-symbol->name-assoc-list-for-type-parts))
(defsubst ecb--semantic-format-tag-functions ()
"Return either the value of `semantic-format-tag-functions' or
`semantic-token->text-functions' depending which semantic version is loaded."
(if (boundp 'semantic-format-tag-functions)
(symbol-value 'semantic-format-tag-functions)
(symbol-value 'semantic-token->text-functions)))
(defsubst ecb--semantic-orphaned-member-metaparent-type ()
"Return the value of `semantic-orphaned-member-metaparent-type'."
(symbol-value 'semantic-orphaned-member-metaparent-type))
(defsubst ecb--semantic-uml-colon-string ()
"Return the value of `semantic-uml-colon-string'."
(symbol-value 'semantic-uml-colon-string))
(defsubst ecb--semantic-format-face-alist ()
"Return either the value of `semantic-format-face-alist' or
`semantic-face-alist' depending which semantic version is loaded."
(if (boundp 'semantic-format-face-alist)
(symbol-value 'semantic-format-face-alist)
(symbol-value 'semantic-face-alist)))
(defsubst ecb--semantic-after-toplevel-cache-change-hook ()
"Return the hook-symbol `semantic-after-toplevel-cache-change-hook'."
'semantic-after-toplevel-cache-change-hook)
(defsubst ecb--semantic-after-partial-cache-change-hook ()
"Return the hook-symbol `semantic-after-partial-cache-change-hook'."
'semantic-after-partial-cache-change-hook)
(defsubst ecb--ezimage-use-images ()
(if (boundp 'ezimage-use-images)
ezimage-use-images))
(defsubst ecb--semantic-format-use-images-flag ()
(if (boundp 'semantic-format-use-images-flag)
semantic-format-use-images-flag))
;; -- an alias for all functions of semantic currently used by ECB ---
(defconst ecb--semantic-function-alist
'((semantic-active-p . semantic-active-p)
(semantic-token-function-args . semantic-tag-function-arguments)
(semantic-token-type-parts . semantic-tag-type-members)
(semantic-something-to-stream . semantic-something-to-tag-table)
(semantic-find-nonterminal-by-overlay . semantic-find-tag-by-overlay)
;; here both functions return a list of tags!
(semantic-find-nonterminal-by-token . semantic-find-tags-by-class)
(semantic-find-nonterminal-by-name . semantic-brute-find-first-tag-by-name)
(semantic-current-nonterminal-parent . semantic-current-tag-parent)
(semantic-adopt-external-members . semantic-adopt-external-members)
(semantic-bucketize . semantic-bucketize)
(semantic-clear-toplevel-cache . semantic-clear-toplevel-cache)
(semantic-colorize-text . semantic--format-colorize-text)
(semantic-current-nonterminal . semantic-current-tag)
(semantic-equivalent-tokens-p . semantic-equivalent-tag-p)
(semantic-find-dependency . semantic-dependency-tag-file)
(semantic-find-documentation . semantic-documentation-for-tag)
(semantic-flex-start . semantic-lex-token-start)
(semantic-nonterminal-children . semantic-tag-children-compatibility)
(semantic-nonterminal-protection . semantic-tag-protection)
(semantic-overlay-live-p . semantic-overlay-live-p)
(semantic-overlay-p . semantic-overlay-p)
(semantic-token-buffer . semantic-tag-buffer)
(semantic-token-end . semantic-tag-end)
(semantic-token-extra-spec . semantic-tag-get-attribute)
(semantic-token-function-parent . semantic-tag-function-parent)
(semantic-token-get . semantic--tag-get-property)
(semantic-token-name . semantic-tag-name)
(semantic-token-overlay . semantic-tag-overlay)
(semantic-token-overlay-cdr . semantic--tag-overlay-cdr)
(semantic-token-p . semantic-tag-p)
(semantic-token-put . semantic--tag-put-property)
(semantic-token-start . semantic-tag-start)
(semantic-token-token . semantic-tag-class)
(semantic-token-type . semantic-tag-type)
(semantic-token-type-parent-superclass . semantic-tag-type-superclass)
(semantic-token-type-parent-implement . semantic-tag-type-interfaces)
(semantic-token-with-position-p . semantic-tag-with-position-p))
"Alist where the car is a function of semantic 1.X and the cdr is the
equivalent new function of semantic 2.X. This alist should contain every
function ECB uses from the semantic library.")
(defconst ecb--semantic-format-function-alist
'((semantic-name-nonterminal . semantic-format-tag-name)
(semantic-abbreviate-nonterminal . semantic-format-tag-abbreviate)
(semantic-summarize-nonterminal . semantic-format-tag-summarize)
(semantic-prototype-nonterminal . semantic-format-tag-prototype)
(semantic-concise-prototype-nonterminal . semantic-format-tag-concise-prototype)
(semantic-uml-abbreviate-nonterminal . semantic-format-tag-uml-abbreviate)
(semantic-uml-prototype-nonterminal . semantic-format-tag-uml-prototype)
(semantic-uml-concise-prototype-nonterminal . semantic-format-tag-uml-concise-prototype)
(semantic-prin1-nonterminal . semantic-format-tag-prin1))
"Alist where the car is a function of semantic 1.X and the cdr is the
equivalent new function of semantic 2.X. This alist should contain every
function of `semantic-token->text-functions' (rsp. for semantic 2.X
`semantic-format-tag-functions'.")
(defconst ecb--semanticdb-function-alist
'((semanticdb-minor-mode-p . semanticdb-minor-mode-p)
;; This is not a full compatible alias. Only the first two parameters can
;; be used with this alias!
(semanticdb-find-nonterminal-by-name . semanticdb-find-tags-by-name)
(semanticdb-full-filename . semanticdb-full-filename))
"Alist where the car is a function of semanticdb 1.X and the cdr is the
equivalent new function of semanticdb 2.X. This alist should contain every
function ECB uses from the semanticdb library.")
;; new let us create the aliase. Each alias has the name "ecb--"<function of
;; semantic 2.0>.
(dolist (f-elem (append ecb--semantic-function-alist
ecb--semantic-format-function-alist
ecb--semanticdb-function-alist))
(defalias (intern (concat "ecb--" (symbol-name (cdr f-elem))))
(if (fboundp (cdr f-elem))
(cdr f-elem)
(car f-elem))))
(defsubst ecb--semantic-tag (name class &rest ignore)
"Create a new semantic tag with name NAME and tag-class CLASS."
(if (fboundp 'semantic-tag)
(apply 'semantic-tag name class ignore)
(list name class nil nil nil nil)))
(defsubst ecb--semantic--tag-set-overlay (tag overlay)
"Set the overlay part of TAG with OVERLAY. OVERLAY can be an overlay or an
unloaded buffer representation."
(let ((o-cdr (ecb--semantic--tag-overlay-cdr tag)))
(setcar o-cdr overlay)))
(defsubst ecb--semantic-tag-calculate-parent (tag)
"Attempt to calculate the parent-tag of TAG."
(if (fboundp 'semantic-tag-calculate-parent)
(apply 'semantic-tag-calculate-parent (list tag))
(save-excursion
(set-buffer (ecb--semantic-tag-buffer tag))
(goto-char (ecb--semantic-tag-start tag))
(ecb--semantic-current-tag-parent))))
(cond ((fboundp 'semantic-tag-static-p)
(defalias 'ecb--semantic-tag-static-p 'semantic-tag-static-p))
((fboundp 'semantic-tag-static)
(defalias 'ecb--semantic-tag-static-p 'semantic-tag-static))
((fboundp 'semantic-nonterminal-static)
(defalias 'ecb--semantic-tag-static-p 'semantic-nonterminal-static))
(t
(defsubst ecb--semantic-tag-static-p (tag &optional parent)
nil)))
(cond ((fboundp 'semantic-tag-abstract-p)
(defalias 'ecb--semantic-tag-abstract-p 'semantic-tag-abstract-p))
((fboundp 'semantic-tag-abstract)
(defalias 'ecb--semantic-tag-abstract-p 'semantic-tag-abstract))
((fboundp 'semantic-nonterminal-abstract)
(defalias 'ecb--semantic-tag-abstract-p 'semantic-nonterminal-abstract))
(t
(defsubst ecb--semantic-tag-abstract-p (tag &optional parent)
nil)))
(defsubst ecb--semantic-tag-prototype-p (tag)
(ecb--semantic-tag-get-attribute tag (if (> ecb-semantic-2-beta-nr 1)
:prototype-flag
'prototype)))
(if (fboundp 'semantic-tag-function-constructor-p)
(defalias 'ecb--semantic-tag-function-constructor-p
'semantic-tag-function-constructor-p)
(defsubst ecb--semantic-tag-function-constructor-p (tag)
(ecb--semantic-tag-get-attribute tag (if (> ecb-semantic-2-beta-nr 1)
:constructor-flag
'constructor))))
(if (fboundp 'semantic-tag-function-destructor-p)
(defalias 'ecb--semantic-tag-function-destructor-p
'semantic-tag-function-destructor-p)
(defsubst ecb--semantic-tag-function-destructor-p (tag)
(ecb--semantic-tag-get-attribute tag (if (> ecb-semantic-2-beta-nr 1)
:destructor-flag
'destructor))))
(defsubst ecb--semantic-fetch-tags (&optional check-cache)
(if (fboundp 'semantic-fetch-tags)
(apply 'semantic-fetch-tags nil)
(apply 'semantic-bovinate-toplevel (list check-cache))))
(if (fboundp 'semantic-tag-components)
(defalias 'ecb--semantic-tag-components
'semantic-tag-components)
(defun ecb--semantic-tag-components (tag)
(cond ((equal (ecb--semantic-tag-class tag) 'type)
(ecb--semantic-tag-type-members tag))
((equal (ecb--semantic-tag-class tag) 'function)
(ecb--semantic-tag-function-arguments tag))
(t nil))))
(if (fboundp 'semantic-flatten-tags-table)
(defalias 'ecb--semantic-flatten-tags-table
'semantic-flatten-tags-table)
(defun ecb--semantic-flatten-tags-table (&optional table)
"Flatten the tags table TABLE.
All tags in TABLE, and all components of top level tags
in TABLE will appear at the top level of list.
Tags promoted to the top of the list will still appear
unmodified as components of their parent tags."
(let* ((table (ecb--semantic-something-to-tag-table table))
;; Initialize the starting list with our table.
(lists (list table)))
(mapc (lambda (tag)
(let ((components (ecb--semantic-tag-components tag)))
(if (and components
;; unpositined tags can be hazardous to
;; completion. Do we need any type of tag
;; here? - EL
(ecb--semantic-tag-with-position-p (car components)))
(setq lists (cons
(ecb--semantic-flatten-tags-table components)
lists)))))
table)
(apply 'append (nreverse lists))
)))
;; Klaus Berndl <klaus.berndl@sdm.de>: Here we must make a list of tags by
;; hand for semantic 1.4!!
(if (fboundp 'semantic-find-tags-by-name)
(defalias 'ecb--semantic-find-tags-by-name
'semantic-find-tags-by-name)
(defsubst ecb--semantic-find-tags-by-name (name &optional table)
(list (ecb--semantic-brute-find-first-tag-by-name name table))))
;;; semanticdb-API Functions
;;
;; Once you have a search result, use these routines to operate
;; on the search results at a higher level
(if (fboundp 'semanticdb-strip-find-results)
(defalias 'ecb--semanticdb-strip-find-results
'semanticdb-strip-find-results)
(defun ecb--semanticdb-strip-find-results (results)
"Strip a semanticdb search RESULTS to exclude objects.
This makes it appear more like the results of a `semantic-find-' call."
(apply #'append (mapcar #'cdr results))))
(if (fboundp 'semanticdb-find-result-length)
(defalias 'ecb--semanticdb-find-result-length
'semanticdb-find-result-length)
(defun ecb--semanticdb-find-result-length (result)
"Number of tags found in RESULT."
(let ((count 0))
(mapc (lambda (onetable)
(setq count (+ count (1- (length onetable)))))
result)
count)))
(defun ecb--semanticdb-find-result-nth (result n)
"In RESULT, return the Nth search result.
Like `semanticdb-find-result-nth', except that only the TAG
is returned, and the buffer it is found it will be made current.
If the result tag has no position information, the originating buffer
is still made current."
(if (fboundp 'semanticdb-find-result-nth)
(apply 'semanticdb-find-result-nth (list result n))
(let ((ans nil)
(anstable nil))
;; Loop over each single table hit.
(while (and (not ans) result)
;; For each table result, get local length, and modify
;; N to be that much less.
(let ((ll (length (cdr (car result))))) ;; local length
(if (> ll n)
;; We have a local match.
(setq ans (nth n (cdr (car result)))
anstable (car (car result)))
;; More to go. Decrement N.
(setq n (- n ll))))
;; Keep moving.
(setq result (cdr result)))
(cons ans anstable))))
(defun ecb--semanticdb-find-result-nth-with-file (result n)
"In RESULT, return the Nth search result.
This is a 0 based search result, with the first match being element 0. Returns
a cons cell with car is the searched and found tag and the cdr is the
associated full filename of this tag. If the search result is not associated
with a file, then the cdr of the result-cons is nil."
(let ((result-nth (ecb--semanticdb-find-result-nth result n)))
(if (and (car result-nth)
(ecb--semantic-tag-with-position-p (car result-nth))
(cdr result-nth))
(cons (car result-nth)
(ecb--semanticdb-full-filename (cdr result-nth)))
(cons (car result-nth) nil))))
(silentcomp-provide 'ecb-semantic-wrapper)
;;; ecb-semantic-wrapper.el end here
|
