From 38a01aac203925429e4a26afee8dd33110349cc0 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 22 Jun 2018 03:19:33 -0700 Subject: [PATCH] Fix x11-screen plugin for autoloading by Edwin's new x-display-type. --- src/x11-screen/NEWS | 5 ++ src/x11-screen/compile.sh | 4 +- src/x11-screen/configure.ac | 4 +- src/x11-screen/make.scm | 81 ++++++------------------ src/x11-screen/x11-screen.pkg | 115 ++++++++++------------------------ src/x11-screen/x11-screen.scm | 24 ++----- 6 files changed, 63 insertions(+), 170 deletions(-) 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) -- 2.25.1