From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Fri, 13 Jul 2012 02:21:44 +0000 (-0700)
Subject: gtk: Avoid signaling an error in hook/process-command-line.
X-Git-Tag: mit-scheme-pucked-9.2.12~583
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7a6c1b0bad999cd64ae995f985256f7e0a585f15;p=mit-scheme.git

gtk: Avoid signaling an error in hook/process-command-line.
---

diff --git a/src/gtk/main.scm b/src/gtk/main.scm
index f7db51471..21165d9fb 100644
--- a/src/gtk/main.scm
+++ b/src/gtk/main.scm
@@ -35,25 +35,25 @@ USA.
       (set! hook/process-command-line
 	    (lambda (line)
 	      (processor
-	       (list->vector
-		(start-gtk program-name (vector->list line)))))))))
-
-(define (start-gtk name args)
-  (if (let ((s (get-environment-variable "DISPLAY")))
-	(and (string? s) (not (string-null? s))))
-      (let ((path (system-library-pathname "gtk-shim.so" #f)))
-	(if path
-	    (if (file-loadable? path)
-		(start-gtk* name args)
-		(begin
-		  (warn "Gtk shim not loadable")
-		  args))
-	    (begin
-	      (warn "No Gtk shim")
-	      args)))
-      (begin
-	(warn "DISPLAY not set")
-	args)))
+	       (let ((val (ignore-errors
+			   (lambda ()
+			     (start-gtk program-name (vector->list line))))))
+		 (if (condition? val)
+		     (begin
+		       (warn val)
+		       line)
+		     (list->vector val)))))))))
+
+ (define (start-gtk name args)
+   (if (let ((s (get-environment-variable "DISPLAY")))
+	 (and (string? s) (not (string-null? s))))
+       (let ((path (system-library-pathname "gtk-shim.so" #f)))
+	 (if path
+	     (if (file-loadable? path)
+		 (start-gtk* name args)
+		 (error "Gtk shim not loadable."))
+	     (error "No Gtk shim")))
+       (error "DISPLAY not set")))
 
 (define (start-gtk* name args)
   ;; Call start_gtk.  Signals an error if gtk_init_check returns 0.