cgit.sxemacs.org Git - packages/blob - xemacs-packages/jde/lisp/jde-imenu.el

   1 ;;; jde-imenu.el --- imenu setup for the JDE
   2 ;; $Revision: 1.7 $
   3
   4 ;; Author: Paul Kinnucan <paulk@mathworks.com>,
   5 ;;         David Ponce <david@dponce.com>
   6 ;; Maintainer: Paul Kinnucan, David Ponce
   7 ;; Keywords: java, tools
   8
   9 ;; Copyright (C) 2000, 2001, 2002, 2004 Paul Kinnucan.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;; Code:
  29
  30 (require 'semantic-java)
  31 (require 'semantic-imenu)
  32 (require 'regexp-opt)
  33
  34 ;;; Compatibility
  35 (cond
  36  ((fboundp 'char-valid-p)
  37   (defalias 'jde-imenu-char-valid-p 'char-valid-p))
  38  ((fboundp 'char-int-p)
  39   (defalias 'jde-imenu-char-valid-p 'char-int-p))
  40  (t
  41   (defun jde-imenu-char-valid-p (object)
  42     "Return t if OBJECT is a valid normal character."
  43     (condition-case nil
  44         (progn
  45           (char-to-string object)
  46           t)
  47       (error nil))))
  48  )
  49
  50 ;;;;
  51 ;;;; Global options
  52 ;;;;
  53
  54 (defcustom jde-imenu-enable t
  55   "*Enables creation of a classes index menu in the Emacs menubar."
  56   :group 'jde-project
  57   :type 'boolean)
  58
  59 (defcustom jde-imenu-create-index-function 'semantic-create-imenu-index
  60   "*Function used to create the \"Classes\" imenu.
  61 Files must be reopened to update the imenu when this option is
  62 changed. The default is the generic `semantic-create-imenu-index'."
  63   :group 'jde-project
  64   :type 'function)
  65
  66 (defcustom jde-imenu-include-signature t
  67   "*If non-nil imenu displays full method signatures and field types.
  68 Use *Rescan* to rebuild the imenu when you have changed this option."
  69   :group 'jde-project
  70   :type 'boolean)
  71
  72 (defcustom jde-imenu-include-modifiers nil
  73   "*If non-nil imenu shows abbreviations for Java modifiers.
  74 Use *Rescan* to rebuild the imenu when you have changed this option.
  75 See also `jde-imenu-modifier-abbrev-alist'."
  76   :group 'jde-project
  77   :type 'boolean)
  78
  79 (defconst jde-imenu-default-modifier-abbrev-alist
  80   '(
  81     ("public"        . ?+)              ; +
  82     ("protected"     . 177)             ; ±
  83     ("private"       . 172)             ; ¬
  84
  85     ("static"        . ?§)              ; §
  86     ("transient"     . ?#)              ; #
  87     ("volatile"      . ?~)              ; ~
  88
  89     ("abstract"      . 170)             ; ª
  90     ("final"         . 182)             ; ¶
  91     ("native"        . ?$)              ; $
  92
  93     ("synchronized"  . ?@)              ; @
  94     ("strictfp"      . ?%)              ; %
  95     )
  96   "Default value of `jde-imenu-modifier-abbrev-alist'.")
  97
  98 (defconst jde-imenu-valid-modifiers-regexp
  99   (concat "\\b"
 100           (regexp-opt
 101            (mapcar #'car jde-imenu-default-modifier-abbrev-alist) t)
 102           "\\b")
 103   "Regexp of valid Java modifiers used by
 104 `jde-imenu-modifier-field-validate'.")
 105
 106 (defun jde-imenu-modifier-field-validate (widget)
 107   "Validate a Java modifier value.
 108 Used by `jde-imenu-modifier-abbrev-alist' customization."
 109   (save-excursion
 110     (let ((value (widget-value widget)))
 111       (if (and (stringp value)
 112                (string-match jde-imenu-valid-modifiers-regexp value))
 113           nil
 114         (widget-put widget :error (format "Invalid modifier: %S" value))
 115         widget))))
 116
 117 (defun jde-imenu-abbrev-field-validate (widget)
 118   "Validate a character abbreviation.
 119  Used by `jde-imenu-modifier-abbrev-alist' customization."
 120   (save-excursion
 121     (let ((value (widget-value widget)))
 122       (if (jde-imenu-char-valid-p value)
 123           nil
 124         (widget-put widget :error
 125                     (format "Invalid character value: %S" value))
 126         widget))))
 127
 128 (defcustom jde-imenu-modifier-abbrev-alist
 129   jde-imenu-default-modifier-abbrev-alist
 130   "*Alist of character abbreviations for Java modifiers.
 131 Each association has the form (MODIFIER . CHARACTER) where MODIFIER is
 132 a valid Java modifier string (see `jde-imenu-valid-modifiers-regexp')
 133 and CHARACTER any valid character. Modifiers without any valid
 134 association are not displayed (see also `jde-imenu-include-modifiers')."
 135   :group 'jde-project
 136   :type '(repeat
 137           (cons :tag "Abbrev"
 138                 (string :tag "Modifier"
 139                         :validate
 140                         (lambda (widget)
 141                           (jde-imenu-modifier-field-validate widget))
 142                         "")
 143                 (choice :tag "Abbreviation"
 144                         (const     :tag "None" nil)
 145                         (character :tag "Character")
 146                         (integer   :tag "Character value"
 147                                    :validate
 148                                    (lambda (widget)
 149                                      (jde-imenu-abbrev-field-validate widget))
 150                                    ))
 151                 )))
 152
 153 (defcustom jde-imenu-sort nil
 154   "*If non-nil sorts items in the index menu.
 155 You can choose:
 156
 157 - - 'asc   to sort by tag name ascending (ignoring case).
 158 - - 'desc  to sort by tag name descending (ignoring case).
 159
 160 Use *Rescan* to rebuild the imenu when you have changed this option."
 161   :group 'jde-project
 162   :type '(choice (const :tag "No sort"    nil )
 163                  (const :tag "Ascending"  asc )
 164                  (const :tag "Descending" desc))
 165   :set '(lambda (sym val)
 166           ;; setup sorting for `semantic-create-imenu-index'
 167           ;; buffer local
 168           (setq semantic-imenu-sort-bucket-function
 169                 (cond ((eq val 'asc)
 170                        'semantic-sort-tokens-by-name-increasing-ci)
 171                       ((eq val 'desc)
 172                        'semantic-sort-tokens-by-name-decreasing-ci)
 173                       (t
 174                        nil)))
 175           ;; global
 176           (set-default 'semantic-imenu-sort-bucket-function
 177                        semantic-imenu-sort-bucket-function)
 178           (set-default sym val)))
 179
 180 ;;;;
 181 ;;;; Helper functions
 182 ;;;;
 183
 184 (defun jde-imenu-abbreviate-modifiers (modifiers)
 185   "Return a string of character abbreviations for MODIFIERS or \"\" if
 186 not found. This string is prepended to each type, function and
 187 variable prototype, giving a synthetic view of their modifiers (See
 188 also `jde-imenu-include-modifiers')."
 189   (if (not jde-imenu-include-modifiers)
 190       ""
 191     (let ((alist jde-imenu-modifier-abbrev-alist)
 192           (abbrevs "")
 193           entry modifier)
 194       (while alist
 195         (setq entry (car alist)
 196               alist (cdr alist))
 197         (if (member (car entry) modifiers)
 198             (setq abbrevs
 199                   (concat abbrevs (if (jde-imenu-char-valid-p (cdr entry))
 200                                       (char-to-string (cdr entry))
 201                                     "")))))
 202       (if (> (length abbrevs) 0)
 203           (concat abbrevs " ")         ; trailing whitespace separator
 204         abbrevs))))
 205
 206 ;;;;
 207 ;;;; Universal `semantic-imenu' stuff adapted to JDE's needs
 208 ;;;;
 209
 210 (defun jde-imenu-prototype-nonterminal (tag &optional parent color)
 211   "Return a prototype for TAG.
 212 See also `semantic-prototype-nonterminal'."
 213   (let* ((tag-cat  (semantic-tag-class tag))
 214          (prototyper (intern-soft (format "jde-imenu-prototype-%s"
 215                                           tag-cat))))
 216     (if (fboundp prototyper)
 217         (funcall prototyper tag parent color)
 218       (semantic-format-prototype-tag-java-mode tag parent color))))
 219
 220 (defun jde-imenu-prototype-function (tag &optional parent color)
 221   "Return a function (method) prototype for TAG.
 222 See also `semantic-java-prototype-function'."
 223   (let ((sign (if jde-imenu-include-signature
 224                   (semantic-java-prototype-function tag parent color)
 225                 (concat (if color
 226                             (semantic--format-colorize-text
 227                              (semantic-tag-name tag) 'function)
 228                           (semantic-tag-name tag))
 229                         "()"))))
 230     (concat (jde-imenu-abbreviate-modifiers
 231              (semantic-tag-modifiers tag))
 232             sign)))
 233
 234 (defun jde-imenu-prototype-variable (tag &optional parent color)
 235   "Return a variable (field) prototype for TAG.
 236 See also `semantic-java-prototype-variable'."
 237   (let ((sign (if jde-imenu-include-signature
 238                   (semantic-java-prototype-variable tag parent color)
 239                 (if color
 240                     (semantic--format-colorize-text
 241                      (semantic-tag-name tag) 'variable)
 242                   (semantic-tag-name tag)))))
 243     (concat (jde-imenu-abbreviate-modifiers
 244              (semantic-tag-modifiers tag))
 245             sign)))
 246
 247 (defun jde-imenu-prototype-type (tag &optional parent color)
 248   "Return a type (class/interface) prototype for TAG.
 249 See also `semantic-prototype-nonterminal'."
 250   (let ((sign (semantic-java-prototype-type tag parent color)))
 251     (concat (jde-imenu-abbreviate-modifiers
 252              (semantic-tag-modifiers tag))
 253             sign)))
 254
 255 ;;;;
 256 ;;;; Specific JDE's imenu (to be replaced by semantic-imenu stuff)
 257 ;;;;
 258
 259 (defcustom jde-imenu-include-classdef t
 260   "*If non-nil `jde-imenu-index-class' adds *class def* items in imenu
 261 index to go to class definition."
 262   :group 'jde-project
 263   :type 'boolean)
 264
 265 (defun jde-imenu-sort-tags (tags)
 266   "Sorts the tag list TAGS depending on `jde-imenu-sort' value."
 267   (cond ((eq jde-imenu-sort 'asc)
 268          (sort tags
 269                (function
 270                 (lambda (tag1 tag2)
 271                   (string-lessp (upcase (semantic-tag-name tag1))
 272                                 (upcase (semantic-tag-name tag2)))))))
 273         ((eq jde-imenu-sort 'desc)
 274          (sort tags
 275                (function
 276                 (lambda (tag1 tag2)
 277                   (string-lessp (upcase (semantic-tag-name tag2))
 278                                 (upcase (semantic-tag-name tag1)))))))
 279         (t
 280          tags)))
 281
 282 (defun jde-imenu-index-class  (class-tag)
 283   "Creates an imenu index for a class in CLASS-TAG."
 284   (let* ((class-name  (semantic-tag-name       class-tag))
 285          (class-type  (semantic-tag-type       class-tag))
 286          (class-start (semantic-tag-start      class-tag))
 287          (class-parts (semantic-tag-type-members class-tag))
 288          (class-index (jde-imenu-index-class-parts class-parts)))
 289
 290     (if jde-imenu-include-classdef
 291         ;; If requested adds a *class def* item to go to the class def.
 292         (setq class-index (cons (cons "*class def*" class-start)
 293                                 class-index))
 294       ;; Else adds an *empty* item to go to the class def. only
 295       ;; when there is not parts
 296       (or class-index
 297           (setq class-index
 298                 (list (cons "*empty*"
 299                             class-start)))))
 300
 301     (list (cons (format "%s %s" class-type class-name)
 302                 class-index))))
 303
 304 (defun jde-imenu-index-class-parts (tags)
 305   "Creates an imenu index for class parts in TAGS.
 306 When`jde-imenu-include-signature' is non-nil the
 307 index menu displays full method signatures and field types."
 308   (let ((methods (semantic-find-nonterminal-by-token 'function tags))
 309         (fields  (semantic-find-nonterminal-by-token 'variable tags))
 310         (classes (semantic-find-nonterminal-by-token 'type     tags))
 311         index)
 312
 313     (setq methods (jde-imenu-sort-tags methods))
 314     (while methods
 315       (let* ((method-tag (car methods))
 316              (method-name  (semantic-tag-name method-tag))
 317              (method-pos   (semantic-tag-start method-tag))
 318              method-sig)
 319         (if jde-imenu-include-signature
 320             (let ((method-type  (semantic-tag-type method-tag))
 321                   (method-args  (semantic-tag-function-arguments method-tag)))
 322               (setq method-sig (if method-type
 323                                    (format "%s %s(" method-type method-name)
 324                                  (format "%s(" method-name)))
 325               (while method-args
 326                 (let ((method-arg-tag (car method-args))
 327                       method-arg-type)
 328                   (when (semantic-tag-p method-arg-tag)
 329                     (setq method-arg-type (semantic-tag-type method-arg-tag))
 330                     (setq method-sig (concat method-sig method-arg-type ",")))
 331                   (setq method-args (cdr method-args))))
 332               ;; remove the extra comma at end
 333               (if (char-equal ?, (aref method-sig (1- (length method-sig))))
 334                   (setq method-sig (substring method-sig 0 -1)))
 335               (setq method-sig (concat method-sig ")")))
 336           (setq method-sig (format "%s()" method-name)))
 337         (setq index
 338               (append
 339                index (list (cons method-sig method-pos)))))
 340       (setq methods (cdr methods)))
 341
 342     ;; Add a separator between method and field index
 343     (if fields
 344         (setq index (append index '(("-")))))
 345
 346     (setq fields (jde-imenu-sort-tags fields))
 347     (while fields
 348       (let* ((field-tag (car fields))
 349              (field-name  (semantic-tag-name  field-tag))
 350              (field-pos   (semantic-tag-start field-tag)))
 351         (if jde-imenu-include-signature
 352             (setq field-name (concat (semantic-tag-type field-tag)
 353                                      " " field-name)))
 354         (setq index
 355               (append
 356                index (list (cons field-name field-pos)))))
 357       (setq fields (cdr fields)))
 358
 359     (setq classes (jde-imenu-sort-tags classes))
 360     (while classes
 361       (let* ((class-tag  (car classes))
 362              (class-index  (jde-imenu-index-class class-tag)))
 363         (setq index (append index class-index)))
 364       (setq classes (cdr classes)))
 365     index))
 366
 367 (defun jde-create-imenu-index ()
 368   "Creates an imenu index for a Java source buffer.
 369 This function uses the semantic bovinator to index the buffer."
 370
 371     (semantic-fetch-tags)
 372
 373     (let* ((tags   (semantic-fetch-tags))
 374            (packages (semantic-find-nonterminal-by-token 'package tags))
 375            (depends  (semantic-find-nonterminal-by-token 'include tags))
 376            (classes  (semantic-find-nonterminal-by-token 'type tags))
 377            depend-index
 378            index)
 379
 380
 381       (setq classes (jde-imenu-sort-tags classes))
 382       (while classes
 383         (let* ((class-tag  (car classes))
 384                (class-index  (jde-imenu-index-class class-tag)))
 385           (setq index (append index class-index)))
 386         (setq classes (cdr classes)))
 387
 388       (setq depends (jde-imenu-sort-tags depends))
 389       (while depends
 390         (let* ((depend-tag (car depends))
 391                (depend-name  (semantic-tag-name  depend-tag))
 392                (depend-pos   (semantic-tag-start depend-tag)))
 393           (setq depend-index (append depend-index (list (cons depend-name depend-pos)))))
 394         (setq depends (cdr depends)))
 395       (if depend-index
 396           (setq index (append index (list (cons "imports" depend-index)))))
 397
 398       (setq packages (jde-imenu-sort-tags packages))
 399       (while packages
 400         (let* ((package-tag (car packages))
 401                (package-name  (semantic-tag-name  package-tag))
 402                (package-pos   (semantic-tag-start package-tag)))
 403           (setq index
 404                 (append
 405                  index
 406                  (list (cons (concat "package " package-name) package-pos)))))
 407         (setq packages (cdr packages)))
 408       index))
 409
 410 ;;;;
 411 ;;;; JDE's imenu setup
 412 ;;;;
 413
 414 (defun jde-imenu-setup ()
 415   "Setup the JDE's \"Classes\" imenu when entering jde-mode."
 416   (when jde-imenu-enable
 417
 418     ;; semantic overloaded functions
 419     (semantic-install-function-overrides
 420      (if (fboundp 'semantic-format-tag-prototype)
 421          '((format-tag-prototype . jde-imenu-prototype-nonterminal))
 422        '((prototype-nonterminal . jde-imenu-prototype-nonterminal))
 423        ))
 424
 425     ;; function to use for creating the imenu
 426     (setq imenu-create-index-function
 427           (if (fboundp jde-imenu-create-index-function)
 428               jde-imenu-create-index-function
 429             'semantic-create-imenu-index))
 430
 431     ;; add the imenu to the menu bar for the current buffer
 432     (imenu-add-to-menubar "Classes")
 433
 434     ))
 435
 436 (provide 'jde-imenu)
 437
 438 ;; $Log: jde-imenu.el,v $
 439 ;; Revision 1.7  2004/07/06 05:25:51  paulk
 440 ;; Convert to new tag nomenclature used by semantic 2.0 to avoid
 441 ;; byte-compilation errors caused by references to obsolete names.
 442 ;;
 443 ;; Revision 1.6  2003/09/21 03:35:37  paulk
 444 ;; (jde-imenu-setup): Install correct override for Semantic 2.0. Submitted by David Ponce.
 445 ;;
 446 ;; Revision 1.5  2002/09/16 04:42:55  paulk
 447 ;; XEmacs compatibility fix: added require statement for regexp-opt package.
 448 ;;
 449 ;; Revision 1.4  2001/05/23 03:51:45  paulk
 450 ;; Removed which-func support as jde-which-method is better.
 451 ;;
 452 ;; Revision 1.3  2001/05/19 02:35:59  paulk
 453 ;; Updated to support semantic 1.4. Thanks to David Ponce.
 454 ;;
 455 ;; Revision 1.2  2000/11/27 06:18:39  paulk
 456 ;; Miscellaneous bug fixes and minor enhancements.
 457 ;;
 458 ;; Revision 1.1  2000/10/20 04:04:20  paulk
 459 ;; Initial version.
 460 ;;
 461
 462 ;;; jde-imenu.el ends here