;;; jde-complete.el -- Smart completion for the JDE

;; Author: Rodrigo Reyes <reyes@chez.com>
;; Maintainer: Rodrigo Reyes, Paul Kinnucan, Howard Spector
;; Keywords: java, intellisense, completion

;; Copyright (C) 1999 Rodrigo Reyes

;; This package follows the GNU General Public Licence (GPL), see the
;; COPYING file that comes along with GNU Emacs. This is free software,
;; you can redistribute it and/or modify it under the GNU GPL terms.
;;
;; Java is a registered trademark of Sun Microsystem, Inc.
;;
;;; Commentary:

;; This is one of a set of packages that make up the
;; Java Development Environment (JDE) for Emacs. See the
;; JDE User's Guide for more information.

;;
;; This package adds smart completion to the JDE. How it works is
;; simple : put the cursor at the end of a statement "under
;; construction", eg. "myVariable.rem<CURSOR HERE> and call the
;; jde-complete-at-point emacs-lisp function (this is by default
;; C-.). A completion is then inserted. If multiple completions are
;; possible, calling the completion function again will cycle through
;; all the possibilities (as dabbrev-mode does).

;; To retrieve all the possible completions, it uses the java code in
;; jde.util.Completion.getClassInfo(), called by beanshell. That
;; need the class to be compiled (but that's not worst than an etag
;; call).

;; Known bugs/problems :

;; - Due to the way the JVM works, it is not possible to explicitly
;; unload a class. So, if major changes are done in a class, the
;; beanshell must be restarted in order to reload the class.

;;
;; TODO :
;;
;; - [EASY] Check for the variables,
;; - [EASY] Check for the static classes
;; - [NOT THAT EASY] Keep the completion information in the minibuffer
;; (it is currently erased after the user presses a key).
;; - [AVERAGE] Add a cache for the class informations.
;; - Check for fields declared at the end of the class.

;; The latest version of the JDE is available at
;; <URL:http://sunsite.auc.dk/jde/>.
;; <URL:http://www.geocities.com/SiliconValley/Lakes/1506/>

;; Please send any comments, bugs, or upgrade requests to
;; Paul Kinnucan at paulk@mathworks.com.

(defvar jde-complete-current-list nil
  "The list of all the completion. Each element of the list is a list
which car is the possible completion, and the cdr is an additional
information about this completion.")

(defvar jde-complete-current-list-index nil
  "An index to an element in jde-complete-current-list. This is used to
cycle the list.")

(defvar jde-complete-current-beginning (make-marker)
  "The beginning of the region where the last completion was inserted.")

(defvar jde-complete-current-end (make-marker)
  "The end of the region where the last completion was inserted.")

(defun jde-complete-import-list ()
  "Build the list of java package declared in the current buffer.
It mostly scans the buffer for 'import' statements, and return the
resulting list. It impliciyly adds the java.lang.* package."
  (save-excursion
    (beginning-of-buffer)
    (let (lst first second)
      (if (re-search-forward "package[ \t\n\r]+\\([a-zA-Z0-9.]+\\)[ \t\n\r]*;" nil t)
	  (setq lst (append lst (list (list (concat (match-string 1) ".") "*")))))
      (while (not (null 		 
		   (re-search-forward "import[ \t\n\r]+\\(\\([a-zA-Z0-9]+[.]\\)+\\)\\([*]\\|[a-zA-Z0-9]+\\)" nil t) ))
	(setq first (match-string 1))
	(setq second (match-string 3))
	(if (string= "*" second)
	    (setq lst (append lst
			      (list (list first second))))
	  (setq lst (append (list (list first second))
			    lst))))
      (if (not (member "java.lang.*" lst))
	  (setq lst (append lst (list (list "java.lang." "*")))))
      lst)))



(defun jde-complete-valid-java-declaration-at (point varname)
  "Verify that a POINT starts a valid java declaration
for the VARNAME variable."
(save-excursion
  (goto-char point)
  (if (looking-at (concat "\\([A-Za-z0-9_.\177-\377]+\\)[ \t\n\r]+" (jde-complete-double-backquotes varname) "[ \t\n\r]*[;=]"))
      (match-string 1)
    nil)))
  
(defun jde-complete-double-backquotes (varname)
  "Build a new string identical to VARNAME, except that every backquote
`\' is doubled, so that it can be used in a regex expression"
  (let (result (idx 0) (len (length varname)) curcar)
    (while (< idx len)
      (setq curcar (elt varname idx))
      (setq result (concat result (if (eq curcar ?\\)
				      "\\\\"
				    (make-string 1 curcar))))
      (setq idx (+ 1 idx)))
    result))

(defun jde-complete-declared-type-of (name)
  "Find in the current buffer the java type of the variable NAME.  The
function returns a string containing the name of the class, or nil
otherwise. This function does not give the fully-qualified java class
name, it just returns the type as it is declared."
  (save-excursion
    (let (found res pos orgpt resname)
      (while (and (not found)
		  (search-backward name nil t))
	(setq pos (point))
	(backward-word 1)
	(setq resname (jde-complete-valid-java-declaration-at (point) name))
	(goto-char pos)
	(forward-char -1)
	(if (not (null resname))
	    (progn (setq res resname)
		   (setq found t))))
    res)))

(defun jde-complete-filter-fqn (importlist)
"Filter all the fully-qualified classnames in the import list. It uses
the knowledge that those classnames are at the beginning of the list,
so that it can stops at the first package import (with a star `*' at
the end of the declaration)."
  (if (not (null importlist))
      (if (string= "*" (car (cdr (car importlist))))
	  importlist
	(jde-complete-filter-fqn (cdr importlist)))))



(defun jde-complete-guess-type-of (name)

"Guess the fully qualified name of the class NAME, using the import
list. It returns a string if the fqn was found, or a list of possible
packages otherwise."

  (let ((importlist (jde-complete-import-list)) shortname fullname tmp result)
    (while (and (not (null importlist)) (null result))
      (setq tmp (car importlist))
      (setq shortname (car (cdr tmp)))
      (setq fullname (concat (car tmp) name))
      (cond 
       ((string= "*" shortname)
	(setq result importlist))
       ((string= name shortname)
	(setq result fullname))
       (t 
	(setq importlist (cdr importlist)))))
    result))

(defun jde-complete-get-classinfo (name)
"Return the class info list for the class NAME (possibly the short
java name). This list contains lists of elements, which car is a
possible completion, and the cdr gives additional informations on the
car."
  (let ((guessed (jde-complete-guess-type-of name)) result)
    (if (stringp guessed)
	(setq result (bsh-eval 
		      (concat "jde.util.Completion.getClassInfo(\"" guessed "\");")))
      (if (not (null name))
	  (setq result (bsh-eval (jde-complete-get-classinfo-javacode name guessed)))))
    (if (not (null result))
	(eval (read result))
      nil)))


(defun jde-complete-get-classinfo-javacode (name import)
"Return the java code that calls the
jde.util.Completion.getClassInfo function with the short java class
name NAME and the package list IMPORT where to look at."
  (save-excursion
    (concat "{ " 
	      "String[] lst = new String[" (number-to-string (length import)) "];\n"
	      (let ((count -1))
		(mapconcat (function (lambda (x) 
				       (setq count (+ 1 count))
					   (concat "lst[" (int-to-string count) "]=\"" 
						   (car (nth count import)) "\";\n")))
			   import
			   " "))
	      "jde.util.Completion.getClassInfo(\"" name "\",lst);\n"
	      "}")))


(defun jde-complete-java-variable-at-point ()
  "Return the current word, according to java syntax.
A '.' is  part of a name."
  (save-excursion
    (let (start varname curcar found 
		(original-point (point)) 
		intermediate-point beg-point)
      (setq curcar (char-before))
      (while (null found)
	(cond 
	 ((or (and (>= curcar ?a) (<= curcar ?z))
	      (and (>= curcar ?A) (<= curcar ?Z))
	      (and (>= curcar ?0) (<= curcar ?9))
	      (>= curcar 127)
	      (member curcar '(?_ ?\\)))
	  (forward-char -1))
	 ((eq ?. curcar)
	  (setq found (point)))
	 (t
	  (setq found t)))
	(setq curcar (char-before)))
      ;;
      (setq intermediate-point (point))
      (if (not (eq t found))
	  (progn 
	    (setq curcar (char-before))
	    (while (or (and (>= curcar ?a) (<= curcar ?z))
		       (and (>= curcar ?A) (<= curcar ?Z))
		       (and (>= curcar ?0) (<= curcar ?9))
		       (>= curcar 127)
		       (member curcar '(?. ?_ ?\\)))
	      (forward-char -1)
	      (setq curcar (char-before)))
	    (setq beg-point (point))
	    (set-marker jde-complete-current-beginning intermediate-point)
	    (set-marker jde-complete-current-end original-point)
	    (list (buffer-substring beg-point (- intermediate-point 1))
		  (buffer-substring intermediate-point original-point)))
	nil))))

(defun jde-complete-build-completion-list (classinfo)
"Build a completion list from the CLASSINFO list, as returned by the
jde.util.Completion.getClassInfo function."
  (let ((result nil) (tmp nil))
    ;; get the variable fields
    (setq tmp (car classinfo))
    (while (not (null tmp))
      (setq result (append (list (list (car tmp))) result))
      (setq tmp (cdr tmp)))
    ;; get the methods 
    (setq tmp (nth 2 classinfo))
    (while (not (null tmp))
      (setq result (append (list (list (concat (car (car tmp))"(")
				       (jde-complete-build-information-for-completion (car tmp))
				       ;; (car tmp)
				       )) result))
      (setq tmp (cdr tmp)))
    result))

(defun jde-complete-build-information-for-completion (lst)
  (let ((result (concat (car (cdr lst)) " " (car lst) "(")))
    (setq lst (cdr (cdr lst)))
    (while (not (null lst))
      (setq result (concat result (car lst)))
      (setq lst (cdr lst))
      (if (not (null lst))
	  (setq result (concat result ", "))))
    (setq result (concat result ")"))
    result))

(defun jde-complete-complete-cycle ()
  "Replace the previous completion by the next one in the list."
  (let (elem)
    (setq jde-complete-current-list-index (+ 1 jde-complete-current-list-index))
    (if (>= jde-complete-current-list-index (length jde-complete-current-list))
	(setq jde-complete-current-list-index 0))
    (setq elem (nth jde-complete-current-list-index jde-complete-current-list))
    (if (not (null (car elem)))
	(progn
	  (delete-region jde-complete-current-beginning jde-complete-current-end)
	  (insert (car elem))
	  (set-marker jde-complete-current-end 
		      (+ (marker-position jde-complete-current-beginning) (length (car elem))))
	  (message (car (cdr elem))))
      (message (format "No completion at this point!")))
    ;;  (goto-char (marker-position jde-complete-current-end))
    ))

(defun jde-complete-insert-completion (item)
  (if item 
      (let* ((chop-point
	      (if (string-match " : " item)
		  (string-match " : " item)
		(length item)))
	     (completion (substring item 0 chop-point)))
	(delete-region jde-complete-current-beginning jde-complete-current-end)
	(insert completion)
	(set-marker jde-complete-current-end 
		    (+ (marker-position jde-complete-current-beginning) 
		       (length completion))))))

(defun jde-complete-popup-xemacs-completion-menu (completion-list)
 (let* ((items
	 (sort
	  ;; Change each item in the completion list from the form
	  ;;   return-value method-name(args)
	  ;; to the form
	  ;;   method-name(args) : return-value
	  (mapcar
	   (lambda (completion)
	     (let ((completion-short (nth 0 completion))
		   (completion-long (nth 1 completion)))
	       (if completion-long
		   (let ((chop-pos (string-match " " completion-long)))
		     (concat 
		      (substring completion-long (+ 1 chop-pos)
				 (length completion-long)) 
		      " : " 
		      (substring completion-long 0 chop-pos)))
		 completion-short)))
	   completion-list)
	  'string<))
	(menu	
	 (cons
	  "Completions"
	  (mapcar
	   (lambda (item)
	     (vector item (list 'jde-complete-insert-completion item)))
	   items))))
   (popup-menu-and-execute-in-window menu (selected-window))))

;; Howard Spector provided the first version of this function.
(defun jde-complete-popup-emacs-completion-menu (completion-list)
  "Builds a popup menu which displays all of the possible completions for the
   object it was invoked on."
  (let* ((menu 
	  (cons 
	   "Completions"
	   (list 
	    (cons ""
		  (mapcar 
		   (lambda (elt) 
		     (cons  elt elt))
		   ;; Sort completion list alphabetically by method name
		   (sort
		    ;; Change each item in the completion list from the form
		    ;;   return-value method-name(args)
		    ;; to the form
		    ;;   method-name(args) : return-value
		    (mapcar
		     (lambda (completion)
		       (let ((completion-short (nth 0 completion))
			     (completion-long (nth 1 completion)))
			 (if completion-long
			     (let ((chop-pos (string-match " " completion-long)))
			       (concat 
				(substring completion-long (+ 1 chop-pos)
					   (length completion-long)) 
				" : " 
				(substring completion-long 0 chop-pos)))
			   completion-short)))
		     completion-list)
		    'string<))))))
	 (mouse-pos (if (nth 1 (mouse-position))
			(mouse-position)
		      (set-mouse-position 
		       ;;(car (mouse-position))   ;; Frame
		       (if jde-xemacsp (selected-window) (selected-frame))
		       (/ (frame-width) 2);; x position
		       2);; y position
		      (mouse-position)))
	 (pos (list 
	       (list 
		(car (cdr mouse-pos));; XOFFSET
		(1+ (cdr (cdr mouse-pos))));; YOFFSET
	       (car mouse-pos)));; WINDOW
	 (pos
	  (list
	   (list 1 1)
	   (selected-window)))
	 (name (x-popup-menu pos menu)))
    (jde-complete-insert-completion name)))


(defun jde-complete-find-all-completions (pat lst)
  (let ((result nil))
    (while (not (null lst))
      (if (equal 0 (string-match pat (car (car lst))))
	  (setq result (append (list (car lst)) result)))
      (setq lst (cdr lst)))
    result))

(defun jde-complete-at-point ()
  "Smart-complete the method at point."
  (interactive)
  (if (and
       (not (null jde-complete-current-list))
       (markerp jde-complete-current-beginning)
       (markerp jde-complete-current-end)
       (marker-position jde-complete-current-beginning)
       (marker-position jde-complete-current-end)
       (>= (point) (marker-position jde-complete-current-beginning))
       (<= (point) (marker-position jde-complete-current-end))
       (eq last-command this-command))
      (jde-complete-complete-cycle))
    (let* ((pair (jde-complete-java-variable-at-point))
	   vtype classinfo fulllist)
       (setq jde-complete-current-list nil)
      (if (not (null pair))
	  (progn
	    (setq vtype (jde-parse-declared-type-of (car pair)))
	    (if (not (null vtype))
		(progn
		  (setq classinfo (jde-complete-get-classinfo vtype))
		  (setq fulllist (jde-complete-build-completion-list classinfo))
		  (setq jde-complete-current-list 
			(jde-complete-find-all-completions (car (cdr pair)) fulllist))
		  (setq jde-complete-current-list-index -1)
		  (jde-complete-complete-cycle))
	      (message (format "Can't find any declaration for `%s'!" 
			       (car pair)))))
	(message "No completion at this point."))))

(defun jde-complete-at-point-menu()
  (interactive)
  (let* ((pair (jde-complete-java-variable-at-point))
	 vtype classinfo fulllist completion-list)
    (if (not (null pair))
	(progn
	  (setq vtype (jde-parse-declared-type-of (car pair)))
	  (if (not (null vtype))
	      (progn
		(setq classinfo (jde-complete-get-classinfo vtype))
		(setq fulllist (jde-complete-build-completion-list classinfo))
		(setq completion-list
		      (jde-complete-find-all-completions (car (cdr pair)) fulllist))
		(if completion-list
		    (if jde-xemacsp
			(jde-complete-popup-xemacs-completion-menu completion-list)
		      (jde-complete-popup-emacs-completion-menu completion-list))
		  (message "No completion at this point.")))
	    (message (format "Can't find any declaration for `%s'!" 
			     (car pair)))))
      (message "No completion at this point."))))

;; A default binding.
;; (global-set-key [(control \.)] 'jde-complete-at-point)

(provide 'jde-complete)

;; $Log: jde-complete.el,v $
;; Revision 1.1  2000/08/13 13:43:57  michaels
;; Initial checkin.
;;
;; Revision 1.7  2000/06/01 05:52:25  paulk
;; Completion menu now works on XEmacs.
;;
;; Revision 1.6  2000/05/16 04:41:28  paulk
;; *** empty log message ***
;;

;; end of jde-complete.el
