gtk-screen: Add spawn-edit.

diff --git a/src/gtk-screen/gtk-screen.pkg b/src/gtk-screen/gtk-screen.pkg
index e41a6a5fb1958f79015ff46596bf29672711ad87..f9be66f5aa6e19a2b25e32e5c25d02cb5167ba52 100644 (file)
--- a/src/gtk-screen/gtk-screen.pkg
+++ b/src/gtk-screen/gtk-screen.pkg
@@ -32,6 +32,7 @@ USA.
   (files "gtk-screen" "gtk-faces")
   (parent (edwin screen))
   (export ()
+         spawn-edit
          set-gtk-screen-hooks!)
   (export (edwin)
          ;; edwin-variable$x-cut-to-clipboard

diff --git a/src/gtk-screen/gtk-screen.scm b/src/gtk-screen/gtk-screen.scm
index c96f54af2321279a50b19fafba5ac5e5e6734bd5..185cb5f3ee5e977b6e49e6de83d8b6401ba13167 100644 (file)
--- a/src/gtk-screen/gtk-screen.scm
+++ b/src/gtk-screen/gtk-screen.scm
@@ -704,6 +704,25 @@ USA.
                           with-gtk-interrupts-enabled
                           with-gtk-interrupts-disabled))
   unspecific)
+
+(define (spawn-edit . args)
+  (cond (edwin-editor
+        (error "Edwin is already running."))
+       ((let ((types (editor-display-types)))
+          (and (pair? types)
+               (eq? 'console (display-type/name (car types)))
+               (null? (cdr types))))
+        (error "Edwin must run on the console."))
+       (else
+        (call-with-current-continuation
+         (lambda (continue)
+           (detach-thread
+            (create-thread continue
+              (lambda ()
+                (set! editor-can-exit? #t)
+                (set! paranoid-exit? #t)
+                (apply edit args)
+                (stop-current-thread)))))))))
 \f
 (define (update-widgets screen)
   (%trace ";   update-widgets "screen"\n")