~ubuntu-branches/debian/stretch/ecb/stretch

« back to all changes in this revision

Viewing changes to .pc/20_fix_semantic_requires/ecb-semantic-wrapper.el

  • Committer: Package Import Robot
  • Author(s): Balint Reczey
  • Date: 2014-10-25 16:13:05 UTC
  • mfrom: (1.1.4)
  • Revision ID: package-import@ubuntu.com-20141025161305-6cg7rnaao1xa4ngb
Tags: 2.40+git20140216-1
* Adopting the package
  Thanks to Mike O'Connor for maintaing the package (Closes: #766440)
* New upstream snapshot (Closes: #729865)
* Drop obsoleted patches
* Bump dh compat level to 9
* Move packaging repository to git.debian.org
* Depend on default emacs (Closes: #754002)
* Bump standards version, no changes needed
* Move homepage URL to source package description

Show diffs side-by-side

added added

removed removed

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