[climacs-cvs] CVS climacs

[thenriksen]

Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv19279

Modified Files:
	climacs-lisp-syntax.lisp climacs-lisp-syntax-commands.lisp 
Log Message:
Added local-definition finding.


--- /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp	2008/01/07 16:59:20	1.9
+++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp	2008/01/10 11:22:03	1.10
@@ -342,6 +342,26 @@
        'cl:function)
       (t t))))
 
+(defun find-local-definition (syntax symbol-form)
+  "Return a form locally defining `symbol-form' as a
+function (explicitly via `flet' or `labels', does not expand
+macros or similar). If no such form can be found, return NIL."
+  (labels ((locally-binding-p (form)
+             (or (form-equal syntax (form-operator form) "FLET")
+                 (form-equal syntax (form-operator form) "LABELS")))
+           (match (form-operator)
+             (when form-operator
+               (form-equal syntax form-operator symbol-form)))
+           (find-local-binding (form)
+             (or (when (locally-binding-p form)
+                   (loop for binding in (form-children (first (form-operands form)))
+                      when (and (form-list-p binding)
+                                (match (form-operator binding)))
+                      return binding))
+                 (unless (form-at-top-level-p form)
+                   (find-local-binding (parent form))))))
+    (find-local-binding (list-at-mark syntax (start-offset symbol-form)))))
+
 (defun edit-definition (symbol &optional type)
   (let ((all-definitions (find-definitions-for-drei
                           (get-usable-image (current-syntax))
--- /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp	2007/12/11 18:46:53	1.7
+++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp	2008/01/10 11:22:03	1.8
@@ -119,7 +119,10 @@
   (let* ((token (this-form (current-syntax) (point)))
          (this-symbol (form-to-object (current-syntax) token)))
     (when (and this-symbol (symbolp this-symbol))
-      (edit-definition this-symbol))))
+      (let ((local-definition (find-local-definition (current-syntax) token)))
+        (if local-definition
+            (setf (offset (point)) (start-offset local-definition))
+            (edit-definition this-symbol))))))
 
 (define-command (com-return-from-definition :name t :command-table climacs-lisp-table)
     ()