[Gd-chatter] r11762 - in trunk/fundev/sources/environment: dswank protocols

[hannes at gwydiondylan.org]

Author: hannes
Date: Fri Mar 28 04:53:06 2008
New Revision: 11762

Modified:
   trunk/fundev/sources/environment/dswank/dswank-exports.dylan
   trunk/fundev/sources/environment/dswank/dswank.dylan
   trunk/fundev/sources/environment/protocols/utils.dylan
Log:
Job: fd
provide absolute-path? keyword for print-environment-object-location


Modified: trunk/fundev/sources/environment/dswank/dswank-exports.dylan
==============================================================================
--- trunk/fundev/sources/environment/dswank/dswank-exports.dylan	(original)
+++ trunk/fundev/sources/environment/dswank/dswank-exports.dylan	Fri Mar 28 04:53:06 2008
@@ -17,7 +17,7 @@
 end library;
 
 define module dswank
-  use common-dylan;
+  use common-dylan, exclude: { format-to-string };
   use lisp-reader;
   use format;
   use streams;

Modified: trunk/fundev/sources/environment/dswank/dswank.dylan
==============================================================================
--- trunk/fundev/sources/environment/dswank/dswank.dylan	(original)
+++ trunk/fundev/sources/environment/dswank/dswank.dylan	Fri Mar 28 04:53:06 2008
@@ -182,7 +182,10 @@
     
 
   if (location)
-    let source-name = print-environment-object-location(*project*, env-obj); 
+    let source-name
+      = print-environment-object-location(*project*,
+					  env-obj,
+					  absolute-path?: #t); 
 
     let (name, lineno)
       = source-line-location(location.source-location-source-record,

Modified: trunk/fundev/sources/environment/protocols/utils.dylan
==============================================================================
--- trunk/fundev/sources/environment/protocols/utils.dylan	(original)
+++ trunk/fundev/sources/environment/protocols/utils.dylan	Fri Mar 28 04:53:06 2008
@@ -598,11 +598,13 @@
 /// Source location display
 
 define open generic print-environment-object-location
-    (server :: <server>, object :: <environment-object>)
+    (server :: <server>, object :: <environment-object>,
+     #key absolute-path? :: <boolean>)
  => (location :: <string>);
 
 define method print-environment-object-location
-    (project :: <project-object>, object :: <environment-object>)
+    (project :: <project-object>, object :: <environment-object>,
+     #key absolute-path? :: <boolean>)
  => (location :: <string>)
   let source-location = environment-object-source-location(project, object);
   if (source-location)
@@ -612,7 +614,13 @@
 	$interactive-definition;
       <file-source-record> =>
 	let location = source-record.source-record-location;
-	file-exists?(location) & location.locator-name;
+	if (file-exists?(location)) 
+	  if (absolute-path?)
+	    locator-as-string(<byte-string>, location);
+	  else 
+	    location.locator-name;
+	  end;
+	end;
       otherwise =>
 	source-record.source-record-name;
     end
@@ -622,12 +630,23 @@
 
 define method print-environment-object-location
     (project :: <project-object>,
-     project-object :: <project-object>)
+     project-object :: <project-object>,
+     #key absolute-path? :: <boolean>)
  => (location :: <string>)
   ignore(project);
-  as(<string>,
-     project-object.project-filename
-       | project-object.project-debug-filename
-       | $n/a)
+  block (ret)
+    local method printit (locator :: false-or(<locator>))
+	    if (locator)
+	      if (absolute-path?)
+		ret(locator-as-string(<byte-string>, locator))
+	      else
+		ret(as(<string>, locator))
+	      end;
+	    end;
+	  end;
+    printit(project-object.project-filename);
+    printit(project-object.project-debug-filename);
+    $n/a;
+  end;
 end method print-environment-object-location;