← Back to branch summary

~ubuntu-branches/ubuntu/saucy/ecb/saucy

« back to all changes in this revision

Viewing changes to ecb-semantic-wrapper.el

  • Committer: Bazaar Package Importer
  • Author(s): Joerg Jaspert
  • Date: 2004-09-01 22:15:18 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20040901221518-0jfdt2apb2rj69ey
Tags: 2.27-1
And include latest Upstream too...

Show diffs side-by-side

added added

removed removed

Lines of Context:
ecb-semantic-wrapper.el
23
23
;; GNU Emacs; see the file COPYING.  If not, write to the Free Software
24
24
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
25
25
 
26
 
;; $Id: ecb-semantic-wrapper.el,v 1.6 2004/02/07 11:08:44 berndl Exp $
 
26
;; $Id: ecb-semantic-wrapper.el,v 1.15 2004/04/15 16:34:08 berndl Exp $
27
27
 
28
28
;;; Commentary:
29
29
 
41
41
(require 'semantic)
42
42
 
43
43
(defconst ecb-semantic-2-loaded (string-match "^2" semantic-version))
 
44
(defconst ecb-semantic-2-beta-nr (if (and ecb-semantic-2-loaded
 
45
                                          (string-match "beta\\([1-9]\\).*"
 
46
                                                        semantic-version))
 
47
                                     (string-to-number
 
48
                                      (match-string 1 semantic-version))
 
49
                                   -1))
44
50
 
45
51
(eval-when-compile
46
52
  (require 'silentcomp))
47
53
 
48
54
;; semantic 1.X does not have this
49
55
(silentcomp-defvar semanticdb-search-system-databases)
50
 
 
 
56
(silentcomp-defvar semantic-format-use-images-flag)
 
57
(silentcomp-defvar ezimage-use-images)
51
58
 
52
59
;; -- getter functions for all variables of semantic currently used by ECB ---
53
60
 
55
62
  "Return the value of `semantic-symbol->name-assoc-list'."
56
63
  (symbol-value 'semantic-symbol->name-assoc-list))
57
64
 
 
65
(defsubst ecb--semantic-symbol->name-assoc-list-for-type-parts ()
 
66
  "Return the value of `semantic-symbol->name-assoc-list-for-type-parts'."
 
67
  (symbol-value 'semantic-symbol->name-assoc-list-for-type-parts))
 
68
 
58
69
(defsubst ecb--semantic-format-tag-functions ()
59
70
  "Return either the value of `semantic-format-tag-functions' or
60
71
`semantic-token->text-functions' depending which semantic version is loaded."
85
96
  "Return the hook-symbol `semantic-after-partial-cache-change-hook'."
86
97
  'semantic-after-partial-cache-change-hook)
87
98
 
 
99
(defsubst ecb--ezimage-use-images ()
 
100
  (if (boundp 'ezimage-use-images)
 
101
      ezimage-use-images))
 
102
 
 
103
(defsubst ecb--semantic-format-use-images-flag ()
 
104
  (if (boundp 'semantic-format-use-images-flag)
 
105
      semantic-format-use-images-flag))
 
106
 
88
107
;; -- an alias for all functions of semantic currently used by ECB ---
89
108
 
90
109
(defconst ecb--semantic-function-alist
91
 
  '((semantic-active-p                     . semantic-active-p)
92
 
    (semantic-token-function-args          . semantic-tag-function-arguments)
93
 
    (semantic-find-nonterminal-by-overlay  . semantic-find-tag-by-overlay)
94
 
    (semantic-current-nonterminal-parent   . semantic-current-tag-parent)
95
 
    (semantic-adopt-external-members       . semantic-adopt-external-members)
96
 
    (semantic-bovinate-toplevel            . semantic-bovinate-toplevel)
97
 
    (semantic-bucketize                    . semantic-bucketize)
98
 
    (semantic-c-template-string            . semantic-c-template-string)
99
 
    (semantic-clear-toplevel-cache         . semantic-clear-toplevel-cache)
100
 
    (semantic-colorize-text                . semantic--format-colorize-text)
101
 
    (semantic-current-nonterminal          . semantic-current-tag)
102
 
    (semantic-equivalent-tokens-p          . semantic-equivalent-tag-p)
103
 
    (semantic-find-dependency              . semantic-dependency-tag-file)
104
 
    (semantic-find-documentation           . semantic-documentation-for-tag)
105
 
    (semantic-flex-start                   . semantic-lex-token-start)
106
 
    (semantic-nonterminal-children         . semantic-tag-children-compatibility)
107
 
    (semantic-nonterminal-protection       . semantic-tag-protection)
108
 
    (semantic-overlay-live-p               . semantic-overlay-live-p)
109
 
    (semantic-overlay-p                    . semantic-overlay-p)
110
 
    (semantic-token-buffer                 . semantic-tag-buffer)
111
 
    (semantic-token-end                    . semantic-tag-end)
112
 
    (semantic-token-extra-spec             . semantic-tag-get-attribute)
113
 
    (semantic-token-function-parent        . semantic-tag-function-parent)
114
 
    (semantic-token-get                    . semantic--tag-get-property)
115
 
    (semantic-token-name                   . semantic-tag-name)
116
 
    (semantic-token-overlay                . semantic-tag-overlay)
117
 
    (semantic-token-overlay-cdr            . semantic--tag-overlay-cdr)
118
 
    (semantic-token-p                      . semantic-tag-p)
119
 
    (semantic-token-put                    . semantic--tag-put-property)
120
 
    (semantic-token-start                  . semantic-tag-start)
121
 
    (semantic-token-token                  . semantic-tag-class)
122
 
    (semantic-token-type                   . semantic-tag-type)
123
 
    (semantic-token-type-parent-superclass . semantic-tag-type-superclass)
124
 
    (semantic-token-type-parent-implement  . semantic-tag-type-interfaces)
125
 
    (semantic-token-with-position-p        . semantic-tag-with-position-p))
 
110
  '((semantic-active-p                        . semantic-active-p)
 
111
    (semantic-token-function-args             . semantic-tag-function-arguments)
 
112
    (semantic-token-type-parts                . semantic-tag-type-members)
 
113
    (semantic-something-to-stream             . semantic-something-to-tag-table)
 
114
    (semantic-find-nonterminal-by-overlay     . semantic-find-tag-by-overlay)
 
115
    ;; here both functions return a list of tags!
 
116
    (semantic-find-nonterminal-by-token       . semantic-find-tags-by-class)
 
117
    (semantic-find-nonterminal-by-name        . semantic-brute-find-first-tag-by-name)
 
118
    (semantic-current-nonterminal-parent      . semantic-current-tag-parent)
 
119
    (semantic-adopt-external-members          . semantic-adopt-external-members)
 
120
    (semantic-bucketize                       . semantic-bucketize)
 
121
    (semantic-c-template-string               . semantic-c-template-string)
 
122
    (semantic-clear-toplevel-cache            . semantic-clear-toplevel-cache)
 
123
    (semantic-colorize-text                   . semantic--format-colorize-text)
 
124
    (semantic-current-nonterminal             . semantic-current-tag)
 
125
    (semantic-equivalent-tokens-p             . semantic-equivalent-tag-p)
 
126
    (semantic-find-dependency                 . semantic-dependency-tag-file)
 
127
    (semantic-find-documentation              . semantic-documentation-for-tag)
 
128
    (semantic-flex-start                      . semantic-lex-token-start)
 
129
    (semantic-nonterminal-children            . semantic-tag-children-compatibility)
 
130
    (semantic-nonterminal-protection          . semantic-tag-protection)
 
131
    (semantic-overlay-live-p                  . semantic-overlay-live-p)
 
132
    (semantic-overlay-p                       . semantic-overlay-p)
 
133
    (semantic-token-buffer                    . semantic-tag-buffer)
 
134
    (semantic-token-end                       . semantic-tag-end)
 
135
    (semantic-token-extra-spec                . semantic-tag-get-attribute)
 
136
    (semantic-token-function-parent           . semantic-tag-function-parent)
 
137
    (semantic-token-get                       . semantic--tag-get-property)
 
138
    (semantic-token-name                      . semantic-tag-name)
 
139
    (semantic-token-overlay                   . semantic-tag-overlay)
 
140
    (semantic-token-overlay-cdr               . semantic--tag-overlay-cdr)
 
141
    (semantic-token-p                         . semantic-tag-p)
 
142
    (semantic-token-put                       . semantic--tag-put-property)
 
143
    (semantic-token-start                     . semantic-tag-start)
 
144
    (semantic-token-token                     . semantic-tag-class)
 
145
    (semantic-token-type                      . semantic-tag-type)
 
146
    (semantic-token-type-parent-superclass    . semantic-tag-type-superclass)
 
147
    (semantic-token-type-parent-implement     . semantic-tag-type-interfaces)
 
148
    (semantic-token-with-position-p           . semantic-tag-with-position-p))
126
149
  "Alist where the car is a function of semantic 1.X and the cdr is the
127
150
equivalent new function of semantic 2.X. This alist should contain every
128
151
function ECB uses from the semantic library.")
184
207
      (goto-char (ecb--semantic-tag-start tag))
185
208
      (ecb--semantic-current-tag-parent))))
186
209
 
187
 
 
188
 
;;; API Functions
 
210
(cond ((fboundp 'semantic-tag-static-p)
 
211
       (defalias 'ecb--semantic-tag-static-p 'semantic-tag-static-p))
 
212
      ((fboundp 'semantic-tag-static)
 
213
       (defalias 'ecb--semantic-tag-static-p 'semantic-tag-static))
 
214
      ((fboundp 'semantic-nonterminal-static)
 
215
       (defalias 'ecb--semantic-tag-static-p 'semantic-nonterminal-static))
 
216
      (t
 
217
       (defsubst ecb--semantic-tag-static-p (tag &optional parent)
 
218
         nil)))
 
219
 
 
220
(cond ((fboundp 'semantic-tag-abstract-p)
 
221
       (defalias 'ecb--semantic-tag-abstract-p 'semantic-tag-abstract-p))
 
222
      ((fboundp 'semantic-tag-abstract)
 
223
       (defalias 'ecb--semantic-tag-abstract-p 'semantic-tag-abstract))
 
224
      ((fboundp 'semantic-nonterminal-abstract)
 
225
       (defalias 'ecb--semantic-tag-abstract-p 'semantic-nonterminal-abstract))
 
226
      (t
 
227
       (defsubst ecb--semantic-tag-abstract-p (tag &optional parent)
 
228
         nil)))
 
229
 
 
230
(defsubst ecb--semantic-tag-prototype-p (tag)
 
231
  (ecb--semantic-tag-get-attribute tag (if (> ecb-semantic-2-beta-nr 1)
 
232
                                           :prototype-flag
 
233
                                         'prototype)))
 
234
 
 
235
(if (fboundp 'semantic-tag-function-constructor-p)
 
236
    (defalias 'ecb--semantic-tag-function-constructor-p
 
237
      'semantic-tag-function-constructor-p)
 
238
  (defsubst ecb--semantic-tag-function-constructor-p (tag)
 
239
    (ecb--semantic-tag-get-attribute tag (if (> ecb-semantic-2-beta-nr 1)
 
240
                                             :constructor-flag
 
241
                                           'constructor))))
 
242
    
 
243
(if (fboundp 'semantic-tag-function-destructor-p)
 
244
    (defalias 'ecb--semantic-tag-function-destructor-p
 
245
      'semantic-tag-function-destructor-p)
 
246
  (defsubst ecb--semantic-tag-function-destructor-p (tag)
 
247
    (ecb--semantic-tag-get-attribute tag (if (> ecb-semantic-2-beta-nr 1)
 
248
                                             :destructor-flag
 
249
                                           'destructor))))
 
250
    
 
251
    
 
252
(defsubst ecb--semantic-fetch-tags (&optional check-cache)
 
253
  (if (fboundp 'semantic-fetch-tags)
 
254
      (apply 'semantic-fetch-tags nil)
 
255
    (apply 'semantic-bovinate-toplevel (list check-cache))))
 
256
 
 
257
 
 
258
(if (fboundp 'semantic-tag-components)
 
259
    (defalias 'ecb--semantic-tag-components
 
260
      'semantic-tag-components)
 
261
  (defun ecb--semantic-tag-components (tag)
 
262
    (cond ((equal (ecb--semantic-tag-class tag) 'type)
 
263
           (ecb--semantic-tag-type-members tag))
 
264
          ((equal (ecb--semantic-tag-class tag) 'function)
 
265
           (ecb--semantic-tag-function-arguments tag))
 
266
          (t nil))))
 
267
 
 
268
(if (fboundp 'semantic-flatten-tags-table)
 
269
    (defalias 'ecb--semantic-flatten-tags-table
 
270
      'semantic-flatten-tags-table)
 
271
  (defun ecb--semantic-flatten-tags-table (&optional table)
 
272
    "Flatten the tags table TABLE.
 
273
All tags in TABLE, and all components of top level tags
 
274
in TABLE will appear at the top level of list.
 
275
Tags promoted to the top of the list will still appear
 
276
unmodified as components of their parent tags."
 
277
    (let* ((table (ecb--semantic-something-to-tag-table table))
 
278
           ;; Initialize the starting list with our table.
 
279
           (lists (list table)))
 
280
      (mapc (lambda (tag)
 
281
              (let ((components (ecb--semantic-tag-components tag)))
 
282
                (if (and components
 
283
                         ;; unpositined tags can be hazardous to
 
284
                         ;; completion.  Do we need any type of tag
 
285
                         ;; here? - EL
 
286
                         (ecb--semantic-tag-with-position-p (car components)))
 
287
                    (setq lists (cons
 
288
                                 (ecb--semantic-flatten-tags-table components)
 
289
                                 lists)))))
 
290
            table)
 
291
      (apply 'append (nreverse lists))
 
292
      )))
 
293
 
 
294
;; Klaus Berndl <klaus.berndl@sdm.de>: Here we must make a list of tags by
 
295
;; hand for semantic 1.4!!
 
296
(if (fboundp 'semantic-find-tags-by-name)
 
297
    (defalias 'ecb--semantic-find-tags-by-name
 
298
      'semantic-find-tags-by-name)
 
299
  (defsubst ecb--semantic-find-tags-by-name (name &optional table)
 
300
    (list (ecb--semantic-brute-find-first-tag-by-name name table))))
 
301
 
 
302
;;; semanticdb-API Functions
189
303
;;
190
304
;; Once you have a search result, use these routines to operate
191
305
;; on the search results at a higher level
192
306
 
193
307
 
194
 
;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: Remove this again when they are
195
 
;; fbound in the beta2 of cedet! But for now we can use them for implementing
196
 
;; ecb-method-browser.el better.
197
308
(if (fboundp 'semanticdb-strip-find-results)
198
309
    (defalias 'ecb--semanticdb-strip-find-results
199
310
      'semanticdb-strip-find-results)
215
326
 
216
327
(defun ecb--semanticdb-find-result-nth (result n)
217
328
  "In RESULT, return the Nth search result.
 
329
Like `semanticdb-find-result-nth', except that only the TAG
 
330
is returned, and the buffer it is found it will be made current.
 
331
If the result tag has no position information, the originating buffer
 
332
is still made current."
 
333
  (if (fboundp 'semanticdb-find-result-nth)
 
334
      (apply 'semanticdb-find-result-nth (list result n))
 
335
    (let ((ans nil)
 
336
          (anstable nil))
 
337
      ;; Loop over each single table hit.
 
338
      (while (and (not ans) result)
 
339
        ;; For each table result, get local length, and modify
 
340
        ;; N to be that much less.
 
341
        (let ((ll (length (cdr (car result))))) ;; local length
 
342
          (if (> ll n)
 
343
              ;; We have a local match.
 
344
              (setq ans (nth n (cdr (car result)))
 
345
                    anstable (car (car result)))
 
346
            ;; More to go.  Decrement N.
 
347
            (setq n (- n ll))))
 
348
        ;; Keep moving.
 
349
        (setq result (cdr result)))
 
350
      (cons ans anstable))))
 
351
 
 
352
(defun ecb--semanticdb-find-result-nth-with-file (result n)
 
353
  "In RESULT, return the Nth search result.
218
354
This is a 0 based search result, with the first match being element 0. Returns
219
355
a cons cell with car is the searched and found tag and the cdr is the
220
356
associated full filename of this tag. If the search result is not associated
221
 
with a file, then the cdar of the result-cons is nil."
222
 
  (let ((ans nil)
223
 
        (ans-file nil))
224
 
    ;; Loop over each single table hit.
225
 
    (while (and (not ans) result)
226
 
      ;; For each table result, get local length, and modify
227
 
      ;; N to be that much less.
228
 
      (let ((ll (length (cdr (car result))))) ;; local length
229
 
        (if (> ll n)
230
 
            ;; We have a local match.
231
 
            (setq ans (nth n (cdr (car result))))
232
 
          ;; More to go.  Decrement N.
233
 
          (setq n (- n ll))))
234
 
      ;; If we have a hit, double-check the find-file
235
 
      ;; entry.  If the file must be loaded, then gat that table's
236
 
      ;; source file into a buffer.
237
 
      ;; Klaus Berndl <klaus.berndl@sdm.de>: Modified to return the
238
 
      ;; full-filename too.
239
 
      (when (and ans (ecb--semantic-tag-with-position-p ans))
240
 
        (setq ans-file (ecb--semanticdb-full-filename (car (car result)))))
241
 
      ;; Keep moving.
242
 
      (setq result (cdr result)))
243
 
    (cons ans ans-file)))
 
357
with a file, then the cdr of the result-cons is nil."
 
358
  (let ((result-nth (ecb--semanticdb-find-result-nth result n)))
 
359
    (if (and (car result-nth)
 
360
             (ecb--semantic-tag-with-position-p (car result-nth))
 
361
             (cdr result-nth))
 
362
        (cons (car result-nth)
 
363
              (ecb--semanticdb-full-filename (cdr result-nth)))
 
364
      (cons (car result-nth) nil))))
 
365
    
 
366
;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: Add this code to semantic-el.el
 
367
;; after a cedet-upgrade. It has to be added to the function
 
368
;; `semantic-elisp-use-read' direct before the (t ...)-clause in the cond!
 
369
;;
 
370
;;    ((eq ts 'tree-buffer-defpopup-command)
 
371
;;     ;; tree-buffer-defpopup-command
 
372
;;     (semantic-tag-new-function
 
373
;;      sn nil nil
 
374
;;      :user-visible-flag nil
 
375
;;      :documentation (semantic-elisp-do-doc (nth 2 rt))
 
376
;;      )
 
377
;;     )
 
378
;;    ((eq ts 'ecb-layout-define)
 
379
;;     ;; ecb-layout-define
 
380
;;     (semantic-tag-new-function
 
381
;;      tss nil (semantic-elisp-desymbolify (list (nth 2 rt)))
 
382
;;      :user-visible-flag nil
 
383
;;      :documentation (semantic-elisp-do-doc (nth 3 rt))
 
384
;;      )
 
385
;;     )
 
386
 
244
387
 
245
388
(silentcomp-provide 'ecb-semantic-wrapper)
246
389