;;; jde-wzd.el
;; $Revision: 1.5 $ 

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

;; Copyright (C) 1997, 1998 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.

(require 'beanshell)

(defun jde-wiz-get-imports()
  (let ((import-re "import[ ]+\\(.*\\)[ ]*;")
	(imports nil))    
    (save-excursion
      (goto-char (point-max))
      (while (re-search-backward import-re (point-min) t)
	(looking-at import-re)
	(setq imports (nconc imports 
			     (list (buffer-substring-no-properties 
				    (match-beginning 1) 
				    (match-end 1)))))))
    imports))

(defun jde-wiz-get-package-name ()
  (let ((package-re "package[ \t]+\\(.*\\)[ \t]*;"))
    (save-excursion
      (goto-char (point-max))
      (when (re-search-backward package-re (point-min) t)
	(looking-at package-re)
	(buffer-substring-no-properties
		       (match-beginning 1)
		       (match-end 1))))))

(defun jde-wiz-get-import-insertion-point ()
  (let ((ip-re
	 (list (cons "import[ ]+\\(.*\\)[ ]*;" 'backward)
	       (cons "package[ \t]+\\(.*\\)[ \t]*;" 'backward)
	       (cons "^$" 'forward)))
	insertion-point n)
    (save-excursion
      (setq i 0)
      (setq n (length ip-re))
      (while (and
	      (not insertion-point)
	      (< i n))
	(let ((re (car (nth i ip-re)))
	      (direction (cdr (nth i ip-re))))
	  (if (eq direction 'forward)
	      (progn
		(goto-char (point-min))
		(setq insertion-point (re-search-forward re (point-max) t)))
	    (goto-char (point-max))
	    (setq insertion-point (re-search-backward re (point-min) t)))
	    (when insertion-point
	      (forward-line 1)
	      (setq insertion-point (point))))
	(setq i (+ i 1))))
    insertion-point))

(defun jde-wiz-insert-imports (new-imports) 
  (let ((existing-imports
	 (jde-wiz-get-imports))
	i n)
    (save-excursion
      (goto-char (jde-wiz-get-import-insertion-point))
      (setq i 0)
      (setq n (length new-imports))
      (while (< i n)
	(let ((new-import 
	       (nth i new-imports)))
	  (when (not (find new-import existing-imports :test 'string=))
	    (insert
	     (concat "import " new-import ";\n"))))
	(setq i (+ i 1))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Method Interface Implementation wizard                                  ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun jde-wiz-get-unqualified-name (name)
  (string-match "[^.]+$" name)
  (substring name (match-beginning 0) (match-end 0)))


(defun jde-wiz-update-implements-clause (interface-name)
  (interactive
   "sEnter interface: ")
  (let ((interface 
	 (jde-wiz-get-unqualified-name interface-name)))
    (save-excursion
      (let* ((class-re "class[ \t]+\\([a-zA-z]+[a-zA-Z0-9._]*\\).*[ \n]*{")
	     (open-brace-pos
	      (scan-lists (point) -1 1))
	     (class-name-end-pos
	      (when (re-search-backward class-re (point-min) t)
		(looking-at class-re)
		(match-end 1)))
	     (implements-keyword-end-pos
	      (when (and open-brace-pos class-name-end-pos)
		(goto-char open-brace-pos)
		(if (re-search-backward "implements" class-name-end-pos t)
		    (match-end 0)))))
	(if implements-keyword-end-pos
	    (progn
	      (goto-char implements-keyword-end-pos)
	      (insert (concat " " interface ", ")))
	  (when class-name-end-pos
	    (goto-char (- open-brace-pos 1))
	      (insert (concat " implements " interface " "))))))))


(defun jde-wiz-implement-interface (interface-name)
  "*Generate a skeleton implementation of a specified interface."
  (interactive
   "sInterface name: ")
  (condition-case err
      (let* ((nl-brace-p
	      (find 'before 
		    (cdr (assoc 'defun-open c-hanging-braces-alist))))
	     (code
	      (bsh-eval
	       (concat
		"jde.wizards.InterfaceFactory.makeInterface(\""
		interface-name "\", true, true, "
		(if nl-brace-p "true" "false") ");"))))
	(if code 
	    (let ((required-imports
		   (bsh-eval-r
		    "jde.wizards.InterfaceFactory.getImportedClasses();")))
	      (insert code)
	      (if required-imports
		  (jde-wiz-insert-imports required-imports))
	      (jde-wiz-update-implements-clause interface-name))))	  
    (error
     (message "%s" (error-message-string err)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Method override wizard                                                  ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun jde-wiz-get-method-class ()
  (let ((class-re "class[ \t]+\\([a-zA-z]+[a-zA-Z0-9._]*\\).*[ \n]*{"))
    (save-excursion
      (scan-lists (point) -1 1)
      (when (re-search-backward class-re (point-min) t)
	(looking-at class-re)
	(buffer-substring-no-properties
		     (match-beginning 1)
		     (match-end 1))))))


(defun jde-wiz-override-method (method-name)
  "Overrides a method whose name you specify.
This command creates a skeleton implementation of the
overridden method at point. This command infers the
qualified name of the class of the overriden method by 
prepending the package name of the current buffer to
the class containing point. If the class defines
more than one method of the same name, this command
prompts you to select the desired method from a list
of method prototypes.

This command also generates import statements for 
the parameter and return types of the overridden method.
The import statements are inserted after the last 
existing import statement or the package statement
or the first blank line in the source file. Import
statements are generated only for types for which an
import statement does not already exist in the file.

NOTE: this command works only if the overriding class 
      has been previously compiled."
  (interactive
   "sMethod name: ")
  (condition-case err
      (let* ((package-name (jde-wiz-get-package-name))
	     (class-name (jde-wiz-get-method-class))
	     (qualified-class-name 
	      (if (and package-name class-name)
		  (concat package-name "." class-name)
		class-name)))
	(if qualified-class-name
	    (let ((signatures
		   (bsh-eval
		    (concat 
		     "jde.wizards.MethodOverrideFactory.getCandidateSignatures(\""
		     qualified-class-name "\",\"" method-name "\");") t)))
	      (if signatures
		  (if (> (length signatures) 1)
		      (jde-wiz-override-variant-method signatures)
		    (jde-wiz-override-method-internal (car signatures)  signatures))))))
    (error
     (message "%s" (error-message-string err)))))

(defun jde-wiz-override-method-internal (selected-method methods)
  (let* ((variant
	 (position selected-method methods :test 'string=))
	 (nl-brace-p
	  (find 'before 
		(cdr (assoc 'defun-open c-hanging-braces-alist))))
	 (skeleton
	  (bsh-eval-r
	   (concat
	    "jde.wizards.MethodOverrideFactory.getMethodSkeleton("
	    variant 
	    (if nl-brace-p
		", true"
	      ", false")
	    ");")))
	 (required-imports
	  (bsh-eval-r
	   "jde.wizards.MethodOverrideFactory.getImportedClasses();")))
    (insert skeleton)
    (if required-imports
	(jde-wiz-insert-imports required-imports))))


(defun jde-wiz-override-variant-method (methods) 
  (let ((buf (get-buffer-create "*Choose Method*")))
    (setq jde-wiz-source-buffer (current-buffer))
    (setq jde-wiz-method-variants methods)
    (setq jde-wiz-selected-method (car methods))
    (set-buffer buf)
    (widget-insert "Select the method you want to override.\n")
    (widget-insert "Then click the Ok button.\n\n")
    (let ((args (list
		 'radio-button-choice
		 :value (car methods)
		 :notify (lambda (widget &rest ignore)
			   (setq jde-wiz-selected-method (widget-value widget))
			   (message "You selected: %s"
				    (widget-value widget))))))
	  (setq args (nconc
		      args
		       (mapcar (lambda (x) (list 'item x)) methods)))
	  (apply 'widget-create args)
	  )
    (widget-insert "\n")
    (widget-create 'push-button
		   :notify (lambda (&rest ignore)
			     (let ((dialog-buffer
				    (current-buffer)))
			       (set-buffer jde-wiz-source-buffer)
			       (delete-window)
			       (kill-buffer dialog-buffer)
			       (jde-wiz-override-method-internal
				jde-wiz-selected-method 
				jde-wiz-method-variants)
			       (message "Method inserted.")
			     ))
     		 "Ok")
    (use-local-map widget-keymap)
    (widget-setup)
    (pop-to-buffer buf)))

	  
(provide 'jde-wiz);

;; $Log: jde-wiz.el $
;; Revision 1.5  1998/11/22 22:03:43  paulk
;; Fixed bug in interface wizard.
;;
;; Revision 1.4  1998/11/22 21:55:33  paulk
;; Fixed bug in interface wizard.
;;
;; Revision 1.3  1998/11/21 02:41:34  paulk
;; Fixed bug.
;; Added implements clause update function to interface implementation wizard.
;;
;; Revision 1.2  1998/11/10 00:46:39  paulk
;; Added smart import insertion to interface wizard.
;;
;; Revision 1.1  1998/11/08 00:39:24  paulk
;; Initial revision
;;


;; End of jde-wiz.el