;;; jbrowse.el --- Simple class browser for Java Programming Language.

;; Copyright (C) 2000 Daiki Ueno

;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: Java

;; This file is not part of any package.

;; This program 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.

;; This program 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 this program; 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:

(defvar jbrowse-class-java-lang-reflect-method
  (java-find-class "java.lang.reflect.Method"))
(defvar jbrowse-class-java-lang-reflect-modifier
  (java-find-class "java.lang.reflect.Modifier"))
(defvar jbrowse-class-java-lang-class
  (java-find-class "java.lang.Class"))
(defvar jbrowse-class-java-lang-package
  (java-find-class "java.lang.Package"))

(defvar jbrowse-class-obarray (make-vector 31 0))

(defun jbrowse-type-string (type)
  (let ((name (java-call-virtual-method type "getName")))
    (if (eq (string-to-char name) ?\[)
	(concat
	 (jbrowse-type-string
	  (java-call-virtual-method type "getComponentType"))
	 "[]")
      (or (java-call-virtual-method type "isPrimitive")
	  (set (intern name jbrowse-class-obarray) nil)) ;Prepare cache entry.
      name)))

(defvar jbrowse-modifier-chars
  '((public ?+) (private ?-) (protected ?#)))

(defun jbrowse-modifier-chars (modifiers)
  (let ((alist jbrowse-modifier-chars)
	chars)
    (while alist
      (if (java-call-static-method
	   jbrowse-class-java-lang-reflect-modifier
	   (concat "is" (capitalize (symbol-name (car (car alist)))))
	   modifiers)
	  (push (nth 1 (car alist)) chars))
      (setq alist (cdr alist)))
    chars))

(defun jbrowse-make-method-info (method)
  (nconc
   (list
    (java-call-virtual-method method "getName")
    (jbrowse-type-string
     (java-call-virtual-method method "getReturnType"))
    (jbrowse-modifier-chars
     (java-call-virtual-method method "getModifiers")))
   (mapcar
    #'jbrowse-type-string
    (java-call-virtual-method method "getParameterTypes"))))

(defun jbrowse-describe-method-info (info)
    (insert
     (let ((modifier-chars (nth 2 info)))
       (if modifier-chars
	   (apply #'string modifier-chars)
	 "  "))
     (car info)
     ": ")
    (jbrowse-insert-type (nth 1 info))
    (let ((params (nthcdr 3 info)))
      (when params
	(insert "\n  (")
	(while params
	  (jbrowse-insert-type (pop params)))
	(insert ")")))
    (insert "\n"))

(defun jbrowse-insert-type (type)
  (if (intern-soft type jbrowse-class-obarray)
      (let ((point (point))
	    extent)
	(insert type)
	(setq extent (make-extent point (point)))
	(set-extent-properties
	 extent `(mouse-face highlight help-symbol ,type))
	(set-extent-property
	 extent 'activate-function
	 #'(lambda (event extent)
	     (help-symbol-run-function-1
	      event extent 'jbrowse-describe-class))))
    (insert type)))

(defun jbrowse-make-class-info (name)
  (let* ((class
	  (java-call-static-method
	   jbrowse-class-java-lang-class "forName" name))
	 (super
	  (java-call-virtual-method class "getSuperclass")))
    (cons
     (and super (java-call-virtual-method super "getName"))
     (mapcar
      #'jbrowse-make-method-info
      (java-call-virtual-method class "getDeclaredMethods")))))

(defun jbrowse-describe-class-1 (class info)
  (with-displaying-help-buffer
   (lambda ()
     (with-current-buffer standard-output
       (if (null (car info))
	   (insert (format "`%s' is\n\n" class))
	 (insert (format "`%s' is derived from `" class))
	 (jbrowse-insert-type (car info))
	 (insert "'\n\n"))
       (let ((methods (cdr info)))
	 (while methods
	   (jbrowse-describe-method-info (pop methods))))
       ;; Return the text we displayed.
       (buffer-string nil nil standard-output)))
   (format "class `%s'" class)))

(defun jbrowse-describe-class (class)
  (interactive
   (let ((classes (mapcar #'java-class-name (java-class-list))))
     (list
      (if current-prefix-arg
	  (let ((packages
		 (mapcar
		  (lambda (package)
		    (java-call-virtual-method package "getName"))
		  (java-call-static-method
		   jbrowse-class-java-lang-package "getPackages"))))
	    (completing-read "Describe class: " (mapcar #'list classes)))
	(completing-read "Describe class: " jbrowse-class-obarray)))))
  (let ((class-info (symbol-value (intern-soft class jbrowse-class-obarray))))
    (unless class-info
      (setq class-info (jbrowse-make-class-info class))
      (set (intern class jbrowse-class-obarray) class-info))
    (jbrowse-describe-class-1 class class-info)))

(provide 'jbrowse)

;;; jbrowse.el ends here