Source

jde / lisp / jde-imenu.el

Full commit
  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
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
;;; jde-imenu.el --- imenu setup for the JDE
;; $Revision$ 

;; Author: Paul Kinnucan <paulk@mathworks.com>,
;;         David Ponce <david@dponce.com>
;; Maintainer: Paul Kinnucan, David Ponce
;; Keywords: java, tools

;; Copyright (C) 2000, 2001, 2002 Paul Kinnucan.

;; GNU Emacs 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.

;; GNU Emacs 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.

;;; Commentary:

;;; Code:

(require 'semantic-java)
(require 'semantic-imenu)
(require 'regexp-opt)

;;; Compatibility
(cond
 ((fboundp 'char-valid-p)
  (defalias 'jde-imenu-char-valid-p 'char-valid-p))
 ((fboundp 'char-int-p)
  (defalias 'jde-imenu-char-valid-p 'char-int-p))
 (t
  (defun jde-imenu-char-valid-p (object)
    "Return t if OBJECT is a valid normal character."
    (condition-case nil
        (progn
          (char-to-string object)
          t)
      (error nil))))
 )

;;;;
;;;; Global options
;;;;

(defcustom jde-imenu-enable t
  "*Enables creation of a classes index menu in the Emacs menubar."
  :group 'jde-project
  :type 'boolean)

(defcustom jde-imenu-create-index-function 'semantic-create-imenu-index
  "*Function used to create the \"Classes\" imenu.
Files must be reopened to update the imenu when this option is
changed. The default is the generic `semantic-create-imenu-index'."
  :group 'jde-project
  :type 'function)

(defcustom jde-imenu-include-signature t
  "*If non-nil imenu displays full method signatures and field types.
Use *Rescan* to rebuild the imenu when you have changed this option."
  :group 'jde-project
  :type 'boolean)

(defcustom jde-imenu-include-modifiers nil
  "*If non-nil imenu shows abbreviations for Java modifiers.
Use *Rescan* to rebuild the imenu when you have changed this option.
See also `jde-imenu-modifier-abbrev-alist'."
  :group 'jde-project
  :type 'boolean)

(defconst jde-imenu-default-modifier-abbrev-alist
  '(
    ("public"        . ?+)              ; +
    ("protected"     . 177)             ; �
    ("private"       . 172)             ; �

    ("static"        . ?)              ; �
    ("transient"     . ?#)              ; #
    ("volatile"      . ?~)              ; ~

    ("abstract"      . 170)             ; �
    ("final"         . 182)             ; �
    ("native"        . ?$)              ; $

    ("synchronized"  . ?@)              ; @
    ("strictfp"      . ?%)              ; %
    )
  "Default value of `jde-imenu-modifier-abbrev-alist'.")

(defconst jde-imenu-valid-modifiers-regexp
  (concat "\\b"
          (regexp-opt
           (mapcar #'car jde-imenu-default-modifier-abbrev-alist) t)
          "\\b")
  "Regexp of valid Java modifiers used by
`jde-imenu-modifier-field-validate'.")

(defun jde-imenu-modifier-field-validate (widget)
  "Validate a Java modifier value.
Used by `jde-imenu-modifier-abbrev-alist' customization."
  (save-excursion
    (let ((value (widget-value widget)))
      (if (and (stringp value)
               (string-match jde-imenu-valid-modifiers-regexp value))
          nil
        (widget-put widget :error (format "Invalid modifier: %S" value))
        widget))))

(defun jde-imenu-abbrev-field-validate (widget)
  "Validate a character abbreviation.
 Used by `jde-imenu-modifier-abbrev-alist' customization."
  (save-excursion
    (let ((value (widget-value widget)))
      (if (jde-imenu-char-valid-p value)
          nil
        (widget-put widget :error
                    (format "Invalid character value: %S" value))
        widget))))
      
(defcustom jde-imenu-modifier-abbrev-alist
  jde-imenu-default-modifier-abbrev-alist
  "*Alist of character abbreviations for Java modifiers.
Each association has the form (MODIFIER . CHARACTER) where MODIFIER is
a valid Java modifier string (see `jde-imenu-valid-modifiers-regexp')
and CHARACTER any valid character. Modifiers without any valid
association are not displayed (see also `jde-imenu-include-modifiers')."
  :group 'jde-project
  :type '(repeat
	  (cons :tag "Abbrev"
		(string :tag "Modifier"
                        :validate
                        (lambda (widget)
                          (jde-imenu-modifier-field-validate widget))
                        "")
                (choice :tag "Abbreviation"
                        (const     :tag "None" nil)
                        (character :tag "Character")
                        (integer   :tag "Character value"
                                   :validate
                                   (lambda (widget)
                                     (jde-imenu-abbrev-field-validate widget))
                                   ))
                )))

(defcustom jde-imenu-sort nil
  "*If non-nil sorts items in the index menu.
You can choose:

- - 'asc   to sort by token name ascending (ignoring case).
- - 'desc  to sort by token name descending (ignoring case).

Use *Rescan* to rebuild the imenu when you have changed this option."
  :group 'jde-project
  :type '(choice (const :tag "No sort"    nil )
                 (const :tag "Ascending"  asc )
                 (const :tag "Descending" desc))
  :set '(lambda (sym val)
          ;; setup sorting for `semantic-create-imenu-index'
          ;; buffer local
          (setq semantic-imenu-sort-bucket-function
                (cond ((eq val 'asc)
                       'semantic-sort-tokens-by-name-increasing-ci)
                      ((eq val 'desc)
                       'semantic-sort-tokens-by-name-decreasing-ci)
                      (t
                       nil)))
          ;; global
          (set-default 'semantic-imenu-sort-bucket-function
                       semantic-imenu-sort-bucket-function)
          (set-default sym val)))

;;;;
;;;; Helper functions
;;;;

(defun jde-imenu-abbreviate-modifiers (modifiers)
  "Return a string of character abbreviations for MODIFIERS or \"\" if
not found. This string is prepended to each type, function and
variable prototype, giving a synthetic view of their modifiers (See
also `jde-imenu-include-modifiers')."
  (if (not jde-imenu-include-modifiers)
      ""
    (let ((alist jde-imenu-modifier-abbrev-alist)
          (abbrevs "")
          entry modifier)
      (while alist
        (setq entry (car alist)
              alist (cdr alist))
        (if (member (car entry) modifiers)
            (setq abbrevs
                  (concat abbrevs (if (jde-imenu-char-valid-p (cdr entry))
                                      (char-to-string (cdr entry))
                                    "")))))
      (if (> (length abbrevs) 0)
          (concat abbrevs " ")         ; trailing whitespace separator
        abbrevs))))

;;;;
;;;; Universal `semantic-imenu' stuff adapted to JDE's needs
;;;;

(defun jde-imenu-prototype-nonterminal (token &optional parent color)
  "Return a prototype for TOKEN.
See also `semantic-prototype-nonterminal'."
  (let* ((token-cat  (semantic-token-token token))
         (prototyper (intern-soft (format "jde-imenu-prototype-%s"
                                          token-cat))))
    (if (fboundp prototyper)
        (funcall prototyper token parent color)
      (semantic-java-prototype-nonterminal token parent color))))

(defun jde-imenu-prototype-function (token &optional parent color)
  "Return a function (method) prototype for TOKEN.
See also `semantic-java-prototype-function'."
  (let ((sign (if jde-imenu-include-signature
                  (semantic-java-prototype-function token parent color)
                (concat (if color
                            (semantic-colorize-text
                             (semantic-token-name token) 'function)
                          (semantic-token-name token))
                        "()"))))
    (concat (jde-imenu-abbreviate-modifiers
             (semantic-token-function-modifiers token))
            sign)))

(defun jde-imenu-prototype-variable (token &optional parent color)
  "Return a variable (field) prototype for TOKEN.
See also `semantic-java-prototype-variable'."
  (let ((sign (if jde-imenu-include-signature
                  (semantic-java-prototype-variable token parent color)
                (if color
                    (semantic-colorize-text
                     (semantic-token-name token) 'variable)
                  (semantic-token-name token)))))
    (concat (jde-imenu-abbreviate-modifiers
             (semantic-token-variable-modifiers token))
            sign)))

(defun jde-imenu-prototype-type (token &optional parent color)
  "Return a type (class/interface) prototype for TOKEN.
See also `semantic-prototype-nonterminal'."
  (let ((sign (semantic-java-prototype-type token parent color)))
    (concat (jde-imenu-abbreviate-modifiers
             (semantic-token-type-modifiers token))
            sign)))

;;;;
;;;; Specific JDE's imenu (to be replaced by semantic-imenu stuff)
;;;;

(defcustom jde-imenu-include-classdef t
  "*If non-nil `jde-imenu-index-class' adds *class def* items in imenu
index to go to class definition."
  :group 'jde-project
  :type 'boolean)

(defun jde-imenu-sort-tokens (tokens)
  "Sorts the token list TOKENS depending on `jde-imenu-sort' value."
  (cond ((eq jde-imenu-sort 'asc)
         (sort tokens
               (function
                (lambda (token1 token2)
                  (string-lessp (upcase (semantic-token-name token1))
                                (upcase (semantic-token-name token2)))))))
        ((eq jde-imenu-sort 'desc)
         (sort tokens
               (function
                (lambda (token1 token2)
                  (string-lessp (upcase (semantic-token-name token2))
                                (upcase (semantic-token-name token1)))))))
        (t
         tokens)))

(defun jde-imenu-index-class  (class-token)
  "Creates an imenu index for a class in CLASS-TOKEN."
  (let* ((class-name  (semantic-token-name       class-token))
         (class-type  (semantic-token-type       class-token))
         (class-start (semantic-token-start      class-token))
         (class-parts (semantic-token-type-parts class-token))
         (class-index (jde-imenu-index-class-parts class-parts)))

    (if jde-imenu-include-classdef
        ;; If requested adds a *class def* item to go to the class def.
        (setq class-index (cons (cons "*class def*" class-start)
                                class-index))
      ;; Else adds an *empty* item to go to the class def. only
      ;; when there is not parts
      (or class-index
          (setq class-index
                (list (cons "*empty*"
                            class-start)))))

    (list (cons (format "%s %s" class-type class-name)
                class-index))))

(defun jde-imenu-index-class-parts (tokens)
  "Creates an imenu index for class parts in TOKENS.
When`jde-imenu-include-signature' is non-nil the
index menu displays full method signatures and field types."
  (let ((methods (semantic-find-nonterminal-by-token 'function tokens))
        (fields  (semantic-find-nonterminal-by-token 'variable tokens))
        (classes (semantic-find-nonterminal-by-token 'type     tokens))
        index)

    (setq methods (jde-imenu-sort-tokens methods))
    (while methods
      (let* ((method-token (car methods))
             (method-name  (semantic-token-name method-token))
             (method-pos   (semantic-token-start method-token))
             method-sig)
        (if jde-imenu-include-signature
            (let ((method-type  (semantic-token-type method-token))
                  (method-args  (semantic-token-function-args method-token)))
              (setq method-sig (if method-type
                                   (format "%s %s(" method-type method-name)
                                 (format "%s(" method-name)))
              (while method-args
                (let ((method-arg-token (car method-args))
                      method-arg-type)
                  (when (semantic-token-p method-arg-token)
                    (setq method-arg-type (semantic-token-type method-arg-token))
                    (setq method-sig (concat method-sig method-arg-type ",")))
                  (setq method-args (cdr method-args))))
              ;; remove the extra comma at end
              (if (char-equal ?, (aref method-sig (1- (length method-sig))))
                  (setq method-sig (substring method-sig 0 -1)))
              (setq method-sig (concat method-sig ")")))
          (setq method-sig (format "%s()" method-name)))
        (setq index
              (append
               index (list (cons method-sig method-pos)))))
      (setq methods (cdr methods)))

    ;; Add a separator between method and field index
    (if fields
        (setq index (append index '(("-"))))) 
    
    (setq fields (jde-imenu-sort-tokens fields))
    (while fields
      (let* ((field-token (car fields))
             (field-name  (semantic-token-name  field-token))
             (field-pos   (semantic-token-start field-token)))
        (if jde-imenu-include-signature
            (setq field-name (concat (semantic-token-type field-token)
                                     " " field-name)))
        (setq index 
              (append 
               index (list (cons field-name field-pos)))))
      (setq fields (cdr fields)))

    (setq classes (jde-imenu-sort-tokens classes))
    (while classes
      (let* ((class-token  (car classes))
             (class-index  (jde-imenu-index-class class-token)))
        (setq index (append index class-index)))
      (setq classes (cdr classes)))
    index))

(defun jde-create-imenu-index ()
  "Creates an imenu index for a Java source buffer.
This function uses the semantic bovinator to index the buffer."

    (semantic-bovinate-toplevel t)
 
    (let* ((tokens   (semantic-bovinate-toplevel))
	   (packages (semantic-find-nonterminal-by-token 'package tokens))
	   (depends  (semantic-find-nonterminal-by-token 'include tokens))
	   (classes  (semantic-find-nonterminal-by-token 'type tokens))
	   depend-index
	   index)


      (setq classes (jde-imenu-sort-tokens classes))
      (while classes
	(let* ((class-token  (car classes))
	       (class-index  (jde-imenu-index-class class-token)))
	  (setq index (append index class-index)))
	(setq classes (cdr classes)))

      (setq depends (jde-imenu-sort-tokens depends))
      (while depends
	(let* ((depend-token (car depends))
	       (depend-name  (semantic-token-name  depend-token))
	       (depend-pos   (semantic-token-start depend-token)))
	  (setq depend-index (append depend-index (list (cons depend-name depend-pos)))))
	(setq depends (cdr depends)))
      (if depend-index
	  (setq index (append index (list (cons "imports" depend-index)))))

      (setq packages (jde-imenu-sort-tokens packages))
      (while packages
	(let* ((package-token (car packages))
	       (package-name  (semantic-token-name  package-token))
	       (package-pos   (semantic-token-start package-token)))
	  (setq index 
		(append 
		 index 
		 (list (cons (concat "package " package-name) package-pos)))))
	(setq packages (cdr packages)))
      index))

;;;;
;;;; JDE's imenu setup
;;;;

(defun jde-imenu-setup ()
  "Setup the JDE's \"Classes\" imenu when entering jde-mode."
  (when jde-imenu-enable

    ;; semantic overloaded functions
    (semantic-install-function-overrides
     '((prototype-nonterminal . jde-imenu-prototype-nonterminal)))

    ;; function to use for creating the imenu
    (setq imenu-create-index-function
          (if (fboundp jde-imenu-create-index-function)
              jde-imenu-create-index-function
            'semantic-create-imenu-index))

    ;; add the imenu to the menu bar for the current buffer
    (imenu-add-to-menubar "Classes")

    ))

(provide 'jde-imenu)

;; $Log$
;; Revision 1.5  2002/09/16 04:42:55  paulk
;; XEmacs compatibility fix: added require statement for regexp-opt package.
;;
;; Revision 1.4  2001/05/23 03:51:45  paulk
;; Removed which-func support as jde-which-method is better.
;;
;; Revision 1.3  2001/05/19 02:35:59  paulk
;; Updated to support semantic 1.4. Thanks to David Ponce.
;;
;; Revision 1.2  2000/11/27 06:18:39  paulk
;; Miscellaneous bug fixes and minor enhancements.
;;
;; Revision 1.1  2000/10/20 04:04:20  paulk
;; Initial version.
;;

;;; jde-imenu.el ends here