From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Fri, 22 Jun 2018 10:19:33 +0000 (-0700)
Subject: Fix x11-screen plugin for autoloading by Edwin's new x-display-type.
X-Git-Tag: mit-scheme-pucked-9.2.15~10^2
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=38a01aac203925429e4a26afee8dd33110349cc0;p=mit-scheme.git

Fix x11-screen plugin for autoloading by Edwin's new x-display-type.
---

diff --git a/src/x11-screen/NEWS b/src/x11-screen/NEWS
index e876d53e5..6391bec42 100644
--- a/src/x11-screen/NEWS
+++ b/src/x11-screen/NEWS
@@ -22,6 +22,11 @@ along with MIT/GNU Scheme; if not, write to the Free Software
 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
 USA.
 
+mit-scheme-x11-screen 1.0 - Matt Birkholz, 2018-06-21
+=====================================================
+
+Cooperate with Edwin's x-display-type which autoloads this plugin.
+
 mit-scheme-x11-screen 0.2 - Matt Birkholz, 2017-05-23
 =====================================================
 
diff --git a/src/x11-screen/compile.sh b/src/x11-screen/compile.sh
index 775ab8586..88556b52c 100755
--- a/src/x11-screen/compile.sh
+++ b/src/x11-screen/compile.sh
@@ -43,8 +43,8 @@ ${MIT_SCHEME_EXE} --batch-mode <<\EOF
     (construct-packages-from-file (fasload package-set)))
 
   (compile-file "x11-screen" '() (->environment '(edwin screen x11-screen)))
-  ;;(compile-file "x11-key" '() (->environment '(edwin x-keys)))
-  ;;(compile-file "x11-com" '() (->environment '(edwin x-commands)))
+  (compile-file "x11-key" '() (->environment '(edwin x11-keys)))
+  (compile-file "x11-command" '() (->environment '(edwin x11-commands)))
 
   (cref/generate-constructors "x11-screen")
   )
diff --git a/src/x11-screen/configure.ac b/src/x11-screen/configure.ac
index 61c835b84..25636bbab 100644
--- a/src/x11-screen/configure.ac
+++ b/src/x11-screen/configure.ac
@@ -1,7 +1,7 @@
 dnl Process this file with autoconf to produce a configure script.
 
 AC_INIT([MIT/GNU Scheme Edwin X11 Screen plugin],
-        [0.2],
+        [1.0],
         [bug-mit-scheme@gnu.org],
         [mit-scheme-x11-screen])
 AC_CONFIG_SRCDIR([x11-screen.pkg])
@@ -47,7 +47,7 @@ os_suffix=`echo "(display (microcode-id/operating-system-suffix))" \
 
 MIT_SCHEME_PKD="x11-screen-${os_suffix}.pkd"
 
-for f in x11-screen; do	# x11-key x11-command
+for f in x11-screen x11-key x11-command; do
     MIT_SCHEME_SCMs="${MIT_SCHEME_SCMs} ${f}.scm"
     MIT_SCHEME_BCIs="${MIT_SCHEME_BCIs} ${f}.bci"
     MIT_SCHEME_DEPS="${MIT_SCHEME_DEPS}
diff --git a/src/x11-screen/make.scm b/src/x11-screen/make.scm
index 5c4a6f1e1..7c676f66c 100644
--- a/src/x11-screen/make.scm
+++ b/src/x11-screen/make.scm
@@ -7,70 +7,25 @@ Load the X11-Screen option. |#
 (with-loader-base-uri (system-library-uri "x11-screen/")
   (lambda ()
     (load-package-set "x11-screen")))
-(add-subsystem-identification! "X11-Screen" '(0 2))
+(add-subsystem-identification! "X11-Screen" '(1 0))
 
-;; Reassign (edwin x-commands) bindings created by the define-
-;; primitives form.  Reassign them to their replacements in the (x11)
-;; package.
-(let ((xcom (->environment '(edwin x-commands)))
-      (x11 (->environment '(x11))))
-  (for-each (lambda (name)
-	      (environment-assign! xcom name (environment-lookup x11 name)))
-	    '(x-list-fonts
-	      x-set-default-font
-	      x-window-clear
-	      x-window-get-position
-	      x-window-get-size
-	      x-window-lower
-	      x-window-raise
-	      x-window-set-background-color
-	      x-window-set-border-color
-	      x-window-set-border-width
-	      x-window-set-cursor-color
-	      x-window-set-font
-	      x-window-set-foreground-color
-	      x-window-set-internal-border-width
-	      x-window-set-mouse-color
-	      x-window-set-mouse-shape
-	      x-window-set-position
-	      x-window-set-size
-	      x-window-x-size
-	      x-window-y-size
-	      xterm-reconfigure
-	      xterm-set-size
-	      xterm-x-size
-	      xterm-y-size)))
-
-;; Reassign (edwin screen x-screen) bindings exported to (edwin).
-(let ((edwin (->environment '(edwin)))
+;; Replace stubs in (edwin screen x-screen).
+(let ((x (->environment '(edwin screen x-screen)))
       (x11 (->environment '(edwin screen x11-screen))))
-  (for-each (lambda (name)
-	      (environment-assign! edwin name (environment-lookup x11 name)))
-	    '(edwin-variable$x-cut-to-clipboard
-	      edwin-variable$x-paste-from-clipboard
-	      os/interprogram-cut
-	      os/interprogram-paste
-	      x-root-window-size
-	      x-screen-ignore-focus-button?
-	      x-selection-timeout
-	      xterm-screen/flush!
-	      xterm-screen/grab-focus!)))
+  (for-each
+    (lambda (name)
+      (environment-assign! x name (environment-lookup x11 name)))
+    '(make-xterm-screen
+      get-xterm-input-operations
+      with-editor-interrupts-from-x
+      with-x-interrupts-enabled
+      with-x-interrupts-disabled)))
 
-;; Reassign (edwin screen x-screen) bindings exported to (edwin x-commands).
-(let ((edwin (->environment '(edwin x-commands)))
+;; Replace stubs in (edwin).
+(let ((edwin (->environment '(edwin)))
       (x11 (->environment '(edwin screen x11-screen))))
-  (for-each (lambda (name)
-	      (environment-assign! edwin name (environment-lookup x11 name)))
-	    '(screen-display
-	      screen-xterm
-	      xterm-screen/set-icon-name
-	      xterm-screen/set-name)))
-
-;; Remove the X display type.  If it stays on the list, its available?
-;; operation will load the prx11 microcode module which contains
-;; conflicting definitions for symbols like xterm_open_window.
-(let ((env (->environment '(edwin display-type))))
-  (set! (access display-types env)
-	(filter (lambda (display-type)
-		  (not (eq? 'X ((access display-type/name env) display-type))))
-		(access display-types env))))
\ No newline at end of file
+  (for-each
+    (lambda (name)
+      (environment-assign! edwin name (environment-lookup x11 name)))
+    '(os/interprogram-cut
+      os/interprogram-paste)))
\ No newline at end of file
diff --git a/src/x11-screen/x11-screen.pkg b/src/x11-screen/x11-screen.pkg
index 965bd1533..7de182cb0 100644
--- a/src/x11-screen/x11-screen.pkg
+++ b/src/x11-screen/x11-screen.pkg
@@ -32,35 +32,25 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define-package (edwin screen x11-screen)
   (files "x11-screen")
   (parent (edwin screen))
-  ;; Until the microcode module based Edwin X Screen is removed, these
-  ;; bindings are already in (edwin) and (edwin x-commands).  They
-  ;; cannot be exported again, and must be patched by
-  ;; (load-option 'x11-screen).
-  #;(export (edwin)
+  (export (edwin)
 	  edwin-variable$x-cut-to-clipboard
 	  edwin-variable$x-paste-from-clipboard
-	  os/interprogram-cut
-	  os/interprogram-paste
 	  x-root-window-size
 	  x-screen-ignore-focus-button?
 	  x-selection-timeout
 	  xterm-screen/flush!
 	  xterm-screen/grab-focus!)
-  #;(export (edwin x-commands)
+  (export (edwin x11-commands)
 	  screen-display
 	  screen-xterm
 	  xterm-screen/set-icon-name
 	  xterm-screen/set-name)
+  (import (edwin screen x-screen)
+	  x-display-type)
   (import (edwin keyboard)
 	  keyboard-peek-busy-no-hang)
   (import (edwin process)
 	  register-process-output-events)
-  (import (edwin x-keys)
-	  x-make-special-key)
-  (import (edwin x-commands)
-	  update-xterm-screen-names!)
-  ;; Import bindings that, in (edwin screen x-screen), are defined by
-  ;; a define-primitives form.
   (import (x11)
 	  x-change-property
 	  x-close-all-displays
@@ -115,10 +105,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	  xterm-write-cursor!
 	  xterm-write-substring!
 	  xterm-x-size
-	  xterm-y-size)
-  ;; Import bindings that, in (edwin screen x-screen), are defined by
-  ;; optimistic stabs at FFI constants.
-  (import (x11)
+	  xterm-y-size
+
 	  event-type:button-down
 	  event-type:button-up
 	  event-type:configure
@@ -140,75 +128,36 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	  event-type:property-notify
 	  number-of-event-types))
 
-#;(define-package (edwin x11-keys)
+(define-package (edwin x11-keys)
   (files "x11-key")
   (parent (edwin))
   (export (edwin screen x11-screen)
 	  x-make-special-key))
 
-#;(define-package (edwin x-commands)
-  (files "x11-com")
+(define-package (edwin x11-commands)
+  (files "x11-command")
   (parent (edwin))
-  (import (edwin)
-	  edwin-command$lower-frame
-	  edwin-command$raise-frame
-	  edwin-command$set-background-color
-	  edwin-command$set-border-color
-	  edwin-command$set-border-width
-	  edwin-command$set-cursor-color
-	  edwin-command$set-default-font
-	  edwin-command$set-font
-	  edwin-command$set-foreground-color
-	  edwin-command$set-frame-icon-name
-	  edwin-command$set-frame-name
-	  edwin-command$set-frame-position
-	  edwin-command$set-frame-size
-	  edwin-command$set-internal-border-width
-	  edwin-command$set-mouse-color
-	  edwin-command$set-mouse-shape
-	  edwin-command$show-frame-position
-	  edwin-command$show-frame-size
-	  edwin-command$x-lower-screen
-	  edwin-command$x-mouse-ignore
-	  edwin-command$x-mouse-keep-one-window
-	  edwin-command$x-mouse-select
-	  edwin-command$x-mouse-select-and-split
-	  edwin-command$x-mouse-set-mark
-	  edwin-command$x-mouse-set-point
-	  edwin-command$x-mouse-show-event
-	  edwin-command$x-raise-screen
-	  edwin-command$x-set-background-color
-	  edwin-command$x-set-border-color
-	  edwin-command$x-set-border-width
-	  edwin-command$x-set-cursor-color
-	  edwin-command$x-set-font
-	  edwin-command$x-set-foreground-color
-	  edwin-command$x-set-icon-name
-	  edwin-command$x-set-internal-border-width
-	  edwin-command$x-set-mouse-color
-	  edwin-command$x-set-mouse-shape
-	  edwin-command$x-set-position
-	  edwin-command$x-set-size
-	  edwin-command$x-set-window-name
-	  edwin-variable$frame-icon-name-format
-	  edwin-variable$frame-icon-name-length
-	  edwin-variable$x-screen-icon-name-format
-	  edwin-variable$x-screen-icon-name-length
-	  edwin-variable$x-screen-name-format
-	  edwin-variable$x-screen-name-length
-
-	  ;; Convenience exports?  Do we need non-X-specific
-	  ;; abstractions to define mouse commands?
-	  ;;x-button1-down
-	  ;;x-button1-up
-	  ;;x-button2-down
-	  ;;x-button2-up
-	  ;;x-button3-down
-	  ;;x-button3-up
-	  ;;x-button4-down
-	  ;;x-button4-up
-	  ;;x-button5-down
-	  ;;x-button5-up
-	  )
   (export (edwin screen x11-screen)
-	  update-xterm-screen-names!))
\ No newline at end of file
+	  update-xterm-screen-names!)
+  (import (x11)
+	  x-list-fonts
+	  x-set-default-font
+	  x-window-clear
+	  x-window-get-position
+	  x-window-get-size
+	  x-window-lower
+	  x-window-raise
+	  x-window-set-background-color
+	  x-window-set-border-color
+	  x-window-set-border-width
+	  x-window-set-cursor-color
+	  x-window-set-font
+	  x-window-set-foreground-color
+	  x-window-set-internal-border-width
+	  x-window-set-mouse-color
+	  x-window-set-mouse-shape
+	  x-window-set-position
+	  xterm-reconfigure
+	  xterm-set-size
+	  xterm-x-size
+	  xterm-y-size))
\ No newline at end of file
diff --git a/src/x11-screen/x11-screen.scm b/src/x11-screen/x11-screen.scm
index e0555ed64..3f5053a45 100644
--- a/src/x11-screen/x11-screen.scm
+++ b/src/x11-screen/x11-screen.scm
@@ -1024,9 +1024,7 @@ In either case, it is copied to the primary selection."
   #t
   boolean?)
 
-(set!
- os/interprogram-cut
- (named-lambda (os/interprogram-cut string context)
+(define (os/interprogram-cut string context)
    (if (eq? x-display-type (current-display-type))
        (let ((xterm (screen-xterm (selected-screen))))
 	 (let ((own-selection
@@ -1038,7 +1036,7 @@ In either case, it is copied to the primary selection."
 				 string))))
 	   (own-selection 'PRIMARY)
 	   (if (ref-variable x-cut-to-clipboard context)
-	       (own-selection 'CLIPBOARD)))))))
+	       (own-selection 'CLIPBOARD))))))
 
 (define (own-selection display selection window time value)
   (and (eqv? window
@@ -1208,11 +1206,9 @@ Otherwise, it is copied from the primary selection."
   #t
   boolean?)
 
-(set!
- os/interprogram-paste
- (named-lambda (os/interprogram-paste context)
+(define (os/interprogram-paste context)
    (and (eq? x-display-type (current-display-type))
-	(xterm/interprogram-paste (screen-xterm (selected-screen)) context))))
+	(xterm/interprogram-paste (screen-xterm (selected-screen)) context)))
 
 (define (xterm/interprogram-paste xterm context)
   (or (and (ref-variable x-paste-from-clipboard context)
@@ -1360,7 +1356,6 @@ Otherwise, it is copied from the primary selection."
 
 ;;;; Initialization
 
-(define x-display-type)
 (define x-display-data)
 (define x-display-events)
 (define x-display-name #f)
@@ -1388,17 +1383,6 @@ Otherwise, it is copied from the primary selection."
 
 (define (initialize-package!)
   (set! screen-list '())
-  (set! x-display-type
-	(make-display-type 'X11
-			   #t
-			   get-x-display
-			   make-xterm-screen
-			   (lambda (screen)
-			     screen	;ignore
-			     (get-xterm-input-operations))
-			   with-editor-interrupts-from-x
-			   with-x-interrupts-enabled
-			   with-x-interrupts-disabled))
   (reset-x-display!)
   (add-event-receiver! event:after-restore reset-x-display!)
   unspecific)