From 4eee07acff4f1da272dd47765a6d12d47d0bf51a Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Wed, 18 Nov 2009 13:27:02 +0000
Subject: [PATCH] cl: Unpleasant hack to fetch program name.

It seems that `cl-launch' doesn't set CL_LAUNCH_FILE when doing `-X',
which is rather inconvenient.  Stuff using `mdw.sys-base' wins because
(massive cheat) ASDF systems are loaded before the program name is
stripped off the front of the argument list; we don't get that luxury
here.  So `*load-pathname*' will have to do; take `pathname-name' to
strip away the unpleasant realities of FASL-caching.

Of course, if we're dumping images then CL_LAUNCH_FILE is set properly.
<sigh>
---
 cl-fringe.lisp | 28 ++++++++++++++++------------
 1 file changed, 16 insertions(+), 12 deletions(-)

diff --git a/cl-fringe.lisp b/cl-fringe.lisp
index 7386c38..3716f3b 100644
--- a/cl-fringe.lisp
+++ b/cl-fringe.lisp
@@ -95,17 +95,21 @@
 				       (iterate-fringe (parse-tree b))))))))
 
 #+cl-launch
-(defun launch ()
-  (flet ((bail (format args)
-	   (format *error-output* "~A: ~?~%"
-		   (cl-launch:getenv "CL_LAUNCH_FILE") format args)
-	   (cl-launch:quit 1)))
-    (handler-case
-	(main cl-launch:*arguments*)
-      (simple-error (err)
-	(bail (simple-condition-format-control err)
-	      (simple-condition-format-arguments err)))
-      (error (err)
-	(bail "~A" err)))))
+(progn
+  (defparameter *program-name*
+    (pathname-name (or (cl-launch:getenv "CL_LAUNCH_FILE")
+		       (namestring *load-pathname*)
+		       "<unknown>")))
+  (defun launch ()
+    (flet ((bail (format args)
+	     (format *error-output* "~A: ~?~%" *program-name* format args)
+	     (cl-launch:quit 1)))
+      (handler-case
+	  (main cl-launch:*arguments*)
+	(simple-error (err)
+	  (bail (simple-condition-format-control err)
+		(simple-condition-format-arguments err)))
+	(error (err)
+	  (bail "~A" err))))))
 
 ;;;----- That's all, folks --------------------------------------------------
-- 
2.11.0