~ chicken-core (chicken-5) 2f5952b92b48207161dd4252a0888b14cc7c5cca

commit 2f5952b92b48207161dd4252a0888b14cc7c5cca
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Sep 2 15:55:57 2016 +0200
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Sat Sep 10 12:32:21 2016 +0200

    feathers: fixed use of source file search path
    
    Signed-off-by: Peter Bex <peter@more-magic.net>

diff --git a/NEWS b/NEWS
index b148866a..629a12ca 100644
--- a/NEWS
+++ b/NEWS
@@ -43,6 +43,7 @@
 
 - Tools
   - Feathers now has a more neutral color scheme and larger font size.
+  - With the -dir option, feathers can now correctly find source code.
 
 - Runtime system:
   - The calling convention of CPS procedures has been changed to
diff --git a/feathers.tcl b/feathers.tcl
index 0e678888..59451f37 100644
--- a/feathers.tcl
+++ b/feathers.tcl
@@ -1420,24 +1420,41 @@ proc ExtractLocation args {
 }
 
 
+proc LocateFile {fname} {
+    global search_path
+
+    foreach d $search_path {
+        set fn [file join $d $fname]
+
+        if {[file exists $fn]} {
+            set fn [file normalize $fn]
+            Log "Located: $fn"
+            return $fn
+        }
+    }
+
+    return ""
+}
+
+
 proc InsertDebugInfo {index event args} {
     global file_list globals
     set loc [eval ExtractLocation $args]
 
-    # chck for assignment event
+    # check for assignment event
     if {$event == 1} {
         set name [lindex $args 1]
         lappend globals($name) $index
     }
 
     if {$loc != ""} {
-        set fname [file normalize [lindex $loc 0]]
-        set line [lindex $loc 1]
+        set fname [LocateFile [lindex $loc 0]]
 
         if {[lsearch -exact $file_list $fname] == -1} {
             lappend file_list $fname
         }
 
+        set line [lindex $loc 1]
         # icky: compute array variable name from filename:
         set tname "file:$fname"
         global $tname
@@ -1696,19 +1713,11 @@ proc LocateEvent {loc val} {
     set loc [ExtractLocation $loc $val]
 
     if {$loc != ""} {
-        set fname [file normalize [lindex $loc 0]]
+        set fname0 [lindex $loc 0]
+        set fname [LocateFile [lindex $loc 0]]
         set line [lindex $loc 1]
 
         if {$fname != $current_filename} {
-            foreach d $search_path {
-                set fn [file join $d $fname]
-
-                if {[file exists $fn]} {
-                    set fname $fn
-                    break
-                }
-            }
-
             if {![LoadFile $fname]} return
 
             if {[SwitchFile $fname]} ApplyTags