 ;;  (put 'if 'fi:common-lisp-indent-hook nil)
 ;;  (put 'if 'fi:lisp-indent-hook nil)
 
-
+;; detect packages and methods better
+
+
+(defun remove-package (str)
+  (let ((start (or (and (string-match "[\\w_]*:+[\\w_]*" str)
+			(match-end 0))
+		   0)))
+    (when (> start (length str))
+      (setq start 0))
+    (substring-no-properties str start)))
+
+(defun get-package-at-point ()
+  ;; try to find the package if present
+  ;; back one symbol
+  (save-excursion
+    (ignore-errors
+      (forward-sexp -1))
+    (when (looking-at "\\sw+::\?\\sw+")
+      (fi::defontify-string
+       (buffer-substring (point)
+			 (progn 
+			   (while (not (looking-at ":"))
+			     (forward-char 1))
+			   (point)))))))
+
+(defun get-method-symbol-at-point (&optional up-p)
+  ;; do we have a defmethod ?
+  (if (save-excursion
+	(ignore-errors 
+	  (forward-sexp -1)
+	  (forward-sexp -1))
+	(looking-at "defmethod"))
+      (let* ((package (or (get-package-at-point)
+			  (fi::package)))
+	     (symbol (get-simple-symbol-at-point nil package))
+	     start-class
+	     class)
+	(save-excursion
+	  ;; get the class
+	  (forward-sexp 1)	  
+	  (while (looking-at " ")
+	    (forward-char 1))
+	  ;; we are at the start of the specifier
+	  ;; we should have somethind like ((var class	    
+	  (while (looking-at "[ (]")
+	    (forward-char 1))
+	  (forward-sexp 1)	    
+	  (while (looking-at " ")
+	    (forward-char 1))	    
+	  (setq start-class (point))
+	  (forward-sexp 1)
+	  (setq class
+		(remove-package
+		 (fi::defontify-string
+		  (buffer-substring
+		   start-class
+		   (point)))))
+	  ;; do we have a package in our symbol ?
+	  (cond (package
+		 ;; try to find the "real" package of the defgeneric
+		 (setq package (fi:eval-in-lisp (format "(opx2-lisp::find-real-package \"%s\" \"%s\")" symbol package)))
+		 (format "%s::METHOD.%s.%s" (upcase package) (upcase symbol) (upcase class)))
+		(t
+		 (format "METHOD.%s.%s" (upcase symbol) (upcase class))))))
+    (get-simple-symbol-at-point nil nil)))
+
+;; comes from fi::get-symbol-at-point
+;; redefined from fi-lep.el
+(defun get-simple-symbol-at-point (&optional up-p package)
+  (let* ((symbol
+	  (cond
+	   ((looking-at "\\sw\\|\\s_")
+	    (save-excursion
+	      (while (looking-at "\\sw\\|\\s_")
+		(forward-char 1))			
+	      (fi::defontify-string
+	       (buffer-substring
+		(point)
+		(progn (forward-sexp -1)
+		       (while (looking-at "\\s'")
+			 (forward-char 1))
+		       (point))))))		
+	   (t
+	    (condition-case ()
+		(save-excursion
+		  (if up-p
+		      (let ((opoint (point)))
+			(cond ((= (following-char) ?\()
+			       (forward-char 1))
+			      ((= (preceding-char) ?\))
+			       (forward-char -1)))
+			(up-list -1)
+			(forward-char 1)
+			(if (looking-at "def")
+			    (goto-char opoint)
+			  (if (looking-at "funcall\\|apply")
+			      (progn
+				(forward-sexp 2)
+				(backward-sexp 1)
+				(if (looking-at "#'")
+				    (forward-char 2)
+				  (if (looking-at "(function")
+				      (progn
+					(forward-char 1)
+					(forward-sexp 2)
+					(backward-sexp 1)))))))))
+		  (while (looking-at "\\sw\\|\\s_")
+		    (forward-char 1))
+		  (if (re-search-backward "\\sw\\|\\s_" nil t)
+		      (progn (forward-char 1)
+			     (fi::defontify-string
+			      (buffer-substring
+			       (point)
+			       (progn (forward-sexp -1)
+				      (while (looking-at "\\s'")
+					(forward-char 1))
+				      (point)))))
+		    nil))
+	      (error nil))))))
+    (when (and symbol package) (setq symbol (remove-package symbol)))
+    (when (and symbol (not package)) (setq symbol (fi::normalize-symbol-package symbol)))
+    (or symbol
+	(if (and up-p (null symbol))
+	    (fi::get-symbol-at-point)))))
+
+;; get the full symbol at point
+;; ie the symbol
+;; and if we are on a defmethod, get the method symbol
+(defun fi::get-symbol-at-point (&optional up-p no-method)
+  (if no-method
+      (get-simple-symbol-at-point up-p nil)
+    (get-method-symbol-at-point up-p)))
+
+;; redefined from fi-utils.el
+;; optional argument method?
+(defun fi::get-default-symbol (prompt &optional up-p ignore-keywords no-method)
+  ;;  (let ((symbol-at-point (fi::get-symbol-at-point up-p no-method)))
+  (let ((symbol-at-point (fi::get-symbol-at-point up-p no-method)))
+    (if fi::use-symbol-at-point
+	(list symbol-at-point)
+      (let ((read-symbol
+	     (let ((fi::original-package (fi::package)))
+	       (fi::ensure-minibuffer-visible)
+	       (fi::completing-read
+		(if symbol-at-point
+		    (format "%s: (default %s) " prompt symbol-at-point)
+		  (format "%s: " prompt))
+		'fi::minibuffer-complete))))
+	(list (if (string= read-symbol "")
+		  symbol-at-point
+		read-symbol))))))


(setq fi:eli-compatibility-mode nil) ;;do not try to connect on 9666 (acl <= 6.2)


;; indentation rules
(put 'letf 'fi:common-lisp-indent-hook '(like flet))
(put 'letf 'fi:lisp-indent-hook '(like flet))

;;;; (when (fboundp :require-patch) (:require-patch ""))
;;;; HISTORY :
;;;; $Log$
;;;; Revision 3.7  2015/11/09 09:18:39  troche
;;;; * control C + . working properly on defmethod
;;;;
;;;; Revision 3.6  2015/09/28 12:18:07  mgautier
;;;; vim '%' -> go to the closing/opening parenthesis if on a parenthesis or insert a %
;;;;
