jbrowse.el

   1 ;;; jbrowse.el --- Simple class browser for Java Programming Language.
   2
   3 ;; Copyright (C) 2000 Daiki Ueno
   4
   5 ;; Author: Daiki Ueno <ueno@unixuser.org>
   6 ;; Keywords: Java
   7
   8 ;; This file is not part of any package.
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or
  13 ;; (at your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (defvar jbrowse-class-java-lang-reflect-method
  30   (java-find-class "java.lang.reflect.Method"))
  31 (defvar jbrowse-class-java-lang-reflect-modifier
  32   (java-find-class "java.lang.reflect.Modifier"))
  33 (defvar jbrowse-class-java-lang-class
  34   (java-find-class "java.lang.Class"))
  35 (defvar jbrowse-class-java-lang-package
  36   (java-find-class "java.lang.Package"))
  37
  38 (defvar jbrowse-class-obarray (make-vector 31 0))
  39
  40 (defun jbrowse-type-string (type)
  41   (let ((name (java-call-virtual-method type "getName")))
  42     (if (eq (string-to-char name) ?\[)
  43         (concat
  44          (jbrowse-type-string
  45           (java-call-virtual-method type "getComponentType"))
  46          "[]")
  47       (or (java-call-virtual-method type "isPrimitive")
  48           (set (intern name jbrowse-class-obarray) nil)) ;Prepare cache entry.
  49       name)))
  50
  51 (defvar jbrowse-modifier-chars
  52   '((public ?+) (private ?-) (protected ?#)))
  53
  54 (defun jbrowse-modifier-chars (modifiers)
  55   (let ((alist jbrowse-modifier-chars)
  56         chars)
  57     (while alist
  58       (if (java-call-static-method
  59            jbrowse-class-java-lang-reflect-modifier
  60            (concat "is" (capitalize (symbol-name (car (car alist)))))
  61            modifiers)
  62           (push (nth 1 (car alist)) chars))
  63       (setq alist (cdr alist)))
  64     chars))
  65
  66 (defun jbrowse-make-method-info (method)
  67   (nconc
  68    (list
  69     (java-call-virtual-method method "getName")
  70     (jbrowse-type-string
  71      (java-call-virtual-method method "getReturnType"))
  72     (jbrowse-modifier-chars
  73      (java-call-virtual-method method "getModifiers")))
  74    (mapcar
  75     #'jbrowse-type-string
  76     (java-call-virtual-method method "getParameterTypes"))))
  77
  78 (defun jbrowse-describe-method-info (info)
  79     (insert
  80      (let ((modifier-chars (nth 2 info)))
  81        (if modifier-chars
  82            (apply #'string modifier-chars)
  83          "  "))
  84      (car info)
  85      ": ")
  86     (jbrowse-insert-type (nth 1 info))
  87     (let ((params (nthcdr 3 info)))
  88       (when params
  89         (insert "\n  (")
  90         (while params
  91           (jbrowse-insert-type (pop params)))
  92         (insert ")")))
  93     (insert "\n"))
  94
  95 (defun jbrowse-insert-type (type)
  96   (if (intern-soft type jbrowse-class-obarray)
  97       (let ((point (point))
  98             extent)
  99         (insert type)
 100         (setq extent (make-extent point (point)))
 101         (set-extent-properties
 102          extent `(mouse-face highlight help-symbol ,type))
 103         (set-extent-property
 104          extent 'activate-function
 105          #'(lambda (event extent)
 106              (help-symbol-run-function-1
 107               event extent 'jbrowse-describe-class))))
 108     (insert type)))
 109
 110 (defun jbrowse-make-class-info (name)
 111   (let* ((class
 112           (java-call-static-method
 113            jbrowse-class-java-lang-class "forName" name))
 114          (super
 115           (java-call-virtual-method class "getSuperclass")))
 116     (cons
 117      (and super (java-call-virtual-method super "getName"))
 118      (mapcar
 119       #'jbrowse-make-method-info
 120       (java-call-virtual-method class "getDeclaredMethods")))))
 121
 122 (defun jbrowse-describe-class-1 (class info)
 123   (with-displaying-help-buffer
 124    (lambda ()
 125      (with-current-buffer standard-output
 126        (if (null (car info))
 127            (insert (format "`%s' is\n\n" class))
 128          (insert (format "`%s' is derived from `" class))
 129          (jbrowse-insert-type (car info))
 130          (insert "'\n\n"))
 131        (let ((methods (cdr info)))
 132          (while methods
 133            (jbrowse-describe-method-info (pop methods))))
 134        ;; Return the text we displayed.
 135        (buffer-string nil nil standard-output)))
 136    (format "class `%s'" class)))
 137
 138 (defun jbrowse-describe-class (class)
 139   (interactive
 140    (let ((classes (mapcar #'java-class-name (java-class-list))))
 141      (list
 142       (if current-prefix-arg
 143           (let ((packages
 144                  (mapcar
 145                   (lambda (package)
 146                     (java-call-virtual-method package "getName"))
 147                   (java-call-static-method
 148                    jbrowse-class-java-lang-package "getPackages"))))
 149             (completing-read "Describe class: " (mapcar #'list classes)))
 150         (completing-read "Describe class: " jbrowse-class-obarray)))))
 151   (let ((class-info (symbol-value (intern-soft class jbrowse-class-obarray))))
 152     (unless class-info
 153       (setq class-info (jbrowse-make-class-info class))
 154       (set (intern class jbrowse-class-obarray) class-info))
 155     (jbrowse-describe-class-1 class class-info)))
 156
 157 (provide 'jbrowse)
 158
 159 ;;; jbrowse.el ends here