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
=====================================================
(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")
)
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])
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}
(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
(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
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
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
#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
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
#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)
\f
;;;; Initialization
-(define x-display-type)
(define x-display-data)
(define x-display-events)
(define x-display-name #f)
(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)
projects / mit-scheme.git / commitdiff