2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
2017, 2018, 2019 Massachusetts Institute of Technology
-This file is part of an x11-screen plugin for MIT/GNU Scheme.
+This file is part of MIT/GNU Scheme.
MIT/GNU Scheme is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-The X11-SCREEN option.
+The X11 Screen option.
This option creates an (edwin screen x11-screen) package that is
autoloaded by Edwin's X display type. It is built in the GNU standard
# 2015, 2016, 2017, 2018, 2019 Massachusetts Institute of
# Technology
#
-# This file is part of an X11-screen plugin for MIT/GNU Scheme.
+# This file is part of MIT/GNU Scheme.
#
-# This plugin is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
+# MIT/GNU Scheme is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License as
+# published by the Free Software Foundation; either version 2 of the
+# License, or (at your option) any later version.
#
-# This plugin is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MIT/GNU Scheme is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
-# along with this plugin; if not, write to the Free Software
+# along with MIT/GNU Scheme; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
# 02110-1301, USA.
-# Compile the X11-SCREEN plugin.
+# Compile the X11-Screen plugin.
set -e
: ${MIT_SCHEME_EXE=mit-scheme}
2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
2017, 2018, 2019 Massachusetts Institute of Technology
-This file is part of an X11-screen plugin for MIT/GNU Scheme.
+This file is part of MIT/GNU Scheme.
MIT/GNU Scheme is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
2017, 2018, 2019 Massachusetts Institute of Technology
-This file is part of an X11-screen plugin for MIT/GNU Scheme.
+This file is part of MIT/GNU Scheme.
-This plugin is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2 of the License, or (at your
-option) any later version.
+MIT/GNU Scheme is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
-This plugin is distributed in the hope that it will be useful, but
+MIT/GNU Scheme is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this plugin; if not, write to the Free Software Foundation,
-Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
+along with MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
|#
;; This list must be kept in alphabetical order by filename.
(standard-scheme-find-file-initialization
- '#(("x11-key" (edwin x-keys))
- ("x11-command" (edwin x-commands))
+ '#(("x11-key" (edwin x11-keys))
+ ("x11-command" (edwin x11-commands))
("x11-screen" (edwin screen x11-screen))))
\ No newline at end of file
#| -*-Scheme-*- |#
-(define-load-option 'X11-SCREEN
+(define-load-option 'x11-screen
(standard-system-loader "."))
(further-load-options #t)
\ No newline at end of file
2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
2017, 2018, 2019 Massachusetts Institute of Technology
-This file is part of an X11-screen plugin for MIT/GNU Scheme.
+This file is part of MIT/GNU Scheme.
-This plugin is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2 of the License, or (at your
-option) any later version.
+MIT/GNU Scheme is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
-This plugin is distributed in the hope that it will be useful, but
+MIT/GNU Scheme is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this plugin; if not, write to the Free Software Foundation,
-Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
+along with MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
|#
(screen-xterm (selected-screen)))
\f
(define-command set-foreground-color
- "Set foreground (text) color of selected frame to COLOR."
+ "Set foreground (text) color of selected frame to color."
"sSet foreground color"
(lambda (color)
(x-window-set-foreground-color (current-xterm) color)
(update-screen! (selected-screen) true)))
(define-command set-background-color
- "Set background color of selected frame to COLOR."
+ "Set background color of selected frame to color."
"sSet background color"
(lambda (color)
(let ((xterm (current-xterm)))
(update-screen! (selected-screen) true)))
(define-command set-border-color
- "Set border color of selected frame to COLOR."
+ "Set border color of selected frame to color."
"sSet border color"
(lambda (color)
(x-window-set-border-color (current-xterm) color)))
(define-command set-cursor-color
- "Set cursor color of selected frame to COLOR."
+ "Set cursor color of selected frame to color."
"sSet cursor color"
(lambda (color)
(x-window-set-cursor-color (current-xterm) color)))
(define-command set-mouse-color
- "Set mouse color of selected frame to COLOR."
+ "Set mouse color of selected frame to color."
"sSet mouse color"
(lambda (color)
(x-window-set-mouse-color (current-xterm) color)))
(define-command set-border-width
- "Set border width of selected frame to WIDTH."
+ "Set border width of selected frame to width."
"nSet border width"
(lambda (width)
(x-window-set-border-width (current-xterm) (max 0 width))
(update-screen! (selected-screen) true)))
(define-command set-internal-border-width
- "Set internal border width of selected frame to WIDTH."
+ "Set internal border width of selected frame to width."
"nSet internal border width"
(lambda (width)
(x-window-set-internal-border-width (current-xterm) (max 0 width))))
\f
(define-command set-font
- "Set text font of selected frame to FONT."
+ "Set text font of selected frame to font."
(lambda ()
(list (prompt-for-x-font-name "Set font" #f)))
(lambda (font)
" pixels)")))))
(define-command set-frame-size
- "Set size of selected frame to WIDTH x HEIGHT."
+ "Set size of selected frame to width x height."
"nFrame width (chars)\nnFrame height (chars)"
(lambda (width height)
(xterm-set-size (current-xterm) (max 2 width) (max 2 height))))
(x-window-set-position (current-xterm) x y)))
\f
(define-command set-frame-name
- "Set name of selected frame to NAME.
+ "Set name of selected frame to name.
Useful only if `frame-name-format' is false."
"sSet frame name"
(lambda (name) (xterm-screen/set-name (selected-screen) name)))
(define-command set-frame-icon-name
- "Set icon name of selected frame to NAME.
+ "Set icon name of selected frame to name.
Useful only if `frame-icon-name-format' is false."
"sSet frame icon name"
(lambda (name) (xterm-screen/set-icon-name (selected-screen) name)))
(lambda () (x-window-lower (current-xterm))))
\f
(define-command set-mouse-shape
- "Set mouse cursor shape for selected frame to SHAPE.
-SHAPE must be the (string) name of one of the known cursor shapes.
+ "Set mouse cursor shape for selected frame to shape.
+shape must be the (string) name of one of the known cursor shapes.
When called interactively, completion is available on the input."
(lambda ()
(list (prompt-for-alist-value "Set mouse shape"
(sc-macro-transformer
(lambda (form environment)
(let ((name (cadr form)))
- `(DEFINE ,(symbol 'EDWIN-COMMAND$X- name)
- ,(close-syntax (symbol 'EDWIN-COMMAND$ name)
+ `(define ,(symbol 'edwin-command$x- name)
+ ,(close-syntax (symbol 'edwin-command$ name)
environment))))))
(define-old-mouse-command set-foreground-color)
2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
2017, 2018, 2019 Massachusetts Institute of Technology
-This file is part of an X11-screen plugin for MIT/GNU Scheme.
+This file is part of MIT/GNU Scheme.
-This plugin is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2 of the License, or (at your
-option) any later version.
+MIT/GNU Scheme is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
-This plugin is distributed in the hope that it will be useful, but
+MIT/GNU Scheme is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this plugin; if not, write to the Free Software Foundation,
-Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
+along with MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
|#
#!/bin/sh
# -*-Scheme-*-
#
-# Test the X11-SCREEN option.
+# Test the X11 Screen option.
set -e
${MIT_SCHEME_EXE} --prepend-library . <<\EOF
2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
2017, 2018, 2019 Massachusetts Institute of Technology
-This file is part of an X11-screen plugin for MIT/GNU Scheme.
+This file is part of MIT/GNU Scheme.
-This plugin is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2 of the License, or (at your
-option) any later version.
+MIT/GNU Scheme is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
-This plugin is distributed in the hope that it will be useful, but
+MIT/GNU Scheme is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this plugin; if not, write to the Free Software Foundation,
-Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
+along with MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
|#
-;;;; Test the x11-screen type.
+;;;; Test the X11 Screen type.
\f
(let ((x11s (->environment '(edwin screen x11-screen))))
(let ((xterm ((access screen-xterm x11s) (selected-screen)))
(display "WM allowed actions:\n")
(pp (vector-map
(lambda (atom) (x-atom->symbol xd atom))
- (get-xterm-property xterm '_NET_WM_ALLOWED_ACTIONS 'atom #f)))
+ (get-xterm-property xterm '|_NET_WM_ALLOWED_ACTIONS| 'atom #f)))
(display "WM hints:\n")
- (pp (get-xterm-property xterm 'WM_HINTS 'wm_hints #f))
+ (pp (get-xterm-property xterm '|WM_HINTS| 'wm_hints #f))
(display "WM normal hints:\n")
- (pp (get-xterm-property xterm 'WM_NORMAL_HINTS 'wm_size_hints #f))))
\ No newline at end of file
+ (pp (get-xterm-property xterm '|WM_NORMAL_HINTS| 'wm_size_hints #f))))
\ No newline at end of file
2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
2017, 2018, 2019 Massachusetts Institute of Technology
-This file is part of an X11-screen plugin for MIT/GNU Scheme.
+This file is part of MIT/GNU Scheme.
-This plugin is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2 of the License, or (at your
-option) any later version.
+MIT/GNU Scheme is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
-This plugin is distributed in the hope that it will be useful, but
+MIT/GNU Scheme is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this plugin; if not, write to the Free Software Foundation,
-Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
+along with MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
|#
(selected? #t)
(name #f)
(icon-name #f)
- (x-visibility 'VISIBLE)
+ (x-visibility 'visible)
(mapped? #f)
(unexposed? #t))
;;; on the window until the first Expose event arrives. The manual
;;; says nothing about the relationship between this event and the
;;; MapNotify event associated with that mapping. We use the fields
-;;; UNEXPOSED? and MAPPED? to track the arrival of those events.
-;;; The screen's visibility remains 'UNMAPPED until both have arrived.
-;;; Meanwhile, X-VISIBILITY tracks Visibility events. When the window
-;;; is both exposed and mapped, VISIBILITY reflects X-VISIBILITY.
+;;; unexposed? and mapped? to track the arrival of those events.
+;;; The screen's visibility remains 'unmapped until both have arrived.
+;;; Meanwhile, x-visibility tracks Visibility events. When the window
+;;; is both exposed and mapped, visibility reflects x-visibility.
(define (screen-x-visibility screen)
(xterm-screen-state/x-visibility (screen-state screen)))
(begin
(set-screen-unexposed?! screen #f)
(update-visibility! screen)
- (if (eq? 'ENTERED unexposed?)
+ (if (eq? 'entered unexposed?)
(xterm-screen/enter! screen))))))))
(define (update-visibility! screen)
(if (and (screen-mapped? screen)
(screen-exposed? screen))
(screen-x-visibility screen)
- 'UNMAPPED))))
+ 'unmapped))))
\f
(define (screen-xterm screen)
(xterm-screen-state/xterm (screen-state screen)))
(define (xterm-screen/enter! screen)
(if (screen-unexposed? screen)
- (set-screen-unexposed?! screen 'ENTERED)
+ (set-screen-unexposed?! screen 'entered)
(begin
(set-screen-selected?! screen #t)
(let ((xterm (screen-xterm screen)))
(define (xterm-screen/scroll-lines-down! screen xl xu yl yu amount)
(xterm-scroll-lines-down (screen-xterm screen) xl xu yl yu amount)
- 'UNCHANGED)
+ 'unchanged)
(define (xterm-screen/scroll-lines-up! screen xl xu yl yu amount)
(xterm-scroll-lines-up (screen-xterm screen) xl xu yl yu amount)
- 'UNCHANGED)
+ 'unchanged)
(define (xterm-screen/beep screen)
(x-window-beep (screen-xterm screen))
(process-special-event event))))
(pce-event
(lambda (flag)
- (make-input-event (if (eq? flag 'FORCE-RETURN) 'RETURN 'UPDATE)
+ (make-input-event (if (eq? flag 'force-return) 'return 'update)
update-screens!
#f))))
(let ((get-next-event
(define (register!)
(set! previewer-registration
(register-io-thread-event (x-display-descriptor x-display-data)
- 'READ (current-thread) preview-events))
+ 'read (current-thread) preview-events))
unspecific)
(define (preview-events mode)
(define-event-handler event-type:button-down
(lambda (screen event)
(set! last-focus-time (vector-ref event 5))
- (if (eq? ignore-button-state 'IGNORE-BUTTON-DOWN)
+ (if (eq? ignore-button-state 'ignore-button-down)
(begin
- (set! ignore-button-state 'IGNORE-BUTTON-UP)
+ (set! ignore-button-state 'ignore-button-up)
#f)
(let ((xterm (screen-xterm screen)))
(make-input-event
- 'BUTTON
+ 'button
execute-button-command
screen
(let ((n (vector-ref event 4)))
(define-event-handler event-type:button-up
(lambda (screen event)
(set! last-focus-time (vector-ref event 5))
- (if (eq? ignore-button-state 'IGNORE-BUTTON-UP)
+ (if (eq? ignore-button-state 'ignore-button-up)
(begin
(set! ignore-button-state #f)
#f)
(let ((xterm (screen-xterm screen)))
(make-input-event
- 'BUTTON
+ 'button
execute-button-command
screen
(let ((n (vector-ref event 4)))
\f
(define-event-handler event-type:configure
(lambda (screen event)
- (make-input-event 'SET-SCREEN-SIZE
+ (make-input-event 'set-screen-size
(lambda (screen event)
(let ((xterm (screen-xterm screen))
(x-size (vector-ref event 2))
(lambda (screen event)
event
(if x-screen-ignore-focus-button?
- (set! ignore-button-state 'IGNORE-BUTTON-DOWN))
+ (set! ignore-button-state 'ignore-button-down))
(and (not (selected-screen? screen))
- (make-input-event 'SELECT-SCREEN
+ (make-input-event 'select-screen
(lambda (screen)
(fluid-let ((last-focus-time #f))
(select-screen screen)))
(lambda (screen event)
event
(and (not (screen-deleted? screen))
- (make-input-event 'DELETE-SCREEN delete-screen! screen))))
+ (make-input-event 'delete-screen delete-screen! screen))))
;; Note that this handler is run in an interrupt (IO event).
(define-event-handler event-type:map
(begin
(set-screen-mapped?! screen #t)
(screen-force-update screen)
- (make-input-event 'UPDATE update-screen! screen #f)))))
+ (make-input-event 'update update-screen! screen #f)))))
;; Note that this handler is run in an interrupt (IO event).
(define-event-handler event-type:unmap
(and (not (screen-deleted? screen))
(let ((old-visibility (screen-x-visibility screen)))
(case (vector-ref event 2)
- ((0) (set-screen-x-visibility! screen 'VISIBLE))
- ((1) (set-screen-x-visibility! screen 'PARTIALLY-OBSCURED))
- ((2) (set-screen-x-visibility! screen 'OBSCURED)))
- (and (eq? old-visibility 'OBSCURED)
+ ((0) (set-screen-x-visibility! screen 'visible))
+ ((1) (set-screen-x-visibility! screen 'partially-obscured))
+ ((2) (set-screen-x-visibility! screen 'obscured)))
+ (and (eq? old-visibility 'obscured)
(begin
(screen-force-update screen)
- (make-input-event 'UPDATE update-screen! screen #f)))))))
+ (make-input-event 'update update-screen! screen #f)))))))
(define-event-handler event-type:take-focus
(lambda (screen event)
(set! last-focus-time (vector-ref event 2))
- (make-input-event 'SELECT-SCREEN select-screen screen)))
+ (make-input-event 'select-screen select-screen screen)))
\f
;;;; Atoms
(define built-in-atoms
'#(#F
- PRIMARY
- SECONDARY
- ARC
- ATOM
- BITMAP
- CARDINAL
- COLORMAP
- CURSOR
- CUT_BUFFER0
- CUT_BUFFER1
- CUT_BUFFER2
- CUT_BUFFER3
- CUT_BUFFER4
- CUT_BUFFER5
- CUT_BUFFER6
- CUT_BUFFER7
- DRAWABLE
- FONT
- INTEGER
- PIXMAP
- POINT
- RECTANGLE
- RESOURCE_MANAGER
- RGB_COLOR_MAP
- RGB_BEST_MAP
- RGB_BLUE_MAP
- RGB_DEFAULT_MAP
- RGB_GRAY_MAP
- RGB_GREEN_MAP
- RGB_RED_MAP
- STRING
- VISUALID
- WINDOW
- WM_COMMAND
- WM_HINTS
- WM_CLIENT_MACHINE
- WM_ICON_NAME
- WM_ICON_SIZE
- WM_NAME
- WM_NORMAL_HINTS
- WM_SIZE_HINTS
- WM_ZOOM_HINTS
- MIN_SPACE
- NORM_SPACE
- MAX_SPACE
- END_SPACE
- SUPERSCRIPT_X
- SUPERSCRIPT_Y
- SUBSCRIPT_X
- SUBSCRIPT_Y
- UNDERLINE_POSITION
- UNDERLINE_THICKNESS
- STRIKEOUT_ASCENT
- STRIKEOUT_DESCENT
- ITALIC_ANGLE
- X_HEIGHT
- QUAD_WIDTH
- WEIGHT
- POINT_SIZE
- RESOLUTION
- COPYRIGHT
- NOTICE
- FONT_NAME
- FAMILY_NAME
- FULL_NAME
- CAP_HEIGHT
- WM_CLASS
- WM_TRANSIENT_FOR))
+ |PRIMARY|
+ |SECONDARY|
+ |ARC|
+ |ATOM|
+ |BITMAP|
+ |CARDINAL|
+ |COLORMAP|
+ |CURSOR|
+ |CUT_BUFFER0|
+ |CUT_BUFFER1|
+ |CUT_BUFFER2|
+ |CUT_BUFFER3|
+ |CUT_BUFFER4|
+ |CUT_BUFFER5|
+ |CUT_BUFFER6|
+ |CUT_BUFFER7|
+ |DRAWABLE|
+ |FONT|
+ |INTEGER|
+ |PIXMAP|
+ |POINT|
+ |RECTANGLE|
+ |RESOURCE_MANAGER|
+ |RGB_COLOR_MAP|
+ |RGB_BEST_MAP|
+ |RGB_BLUE_MAP|
+ |RGB_DEFAULT_MAP|
+ |RGB_GRAY_MAP|
+ |RGB_GREEN_MAP|
+ |RGB_RED_MAP|
+ |STRING|
+ |VISUALID|
+ |WINDOW|
+ |WM_COMMAND|
+ |WM_HINTS|
+ |WM_CLIENT_MACHINE|
+ |WM_ICON_NAME|
+ |WM_ICON_SIZE|
+ |WM_NAME|
+ |WM_NORMAL_HINTS|
+ |WM_SIZE_HINTS|
+ |WM_ZOOM_HINTS|
+ |MIN_SPACE|
+ |NORM_SPACE|
+ |MAX_SPACE|
+ |END_SPACE|
+ |SUPERSCRIPT_X|
+ |SUPERSCRIPT_Y|
+ |SUBSCRIPT_X|
+ |SUBSCRIPT_Y|
+ |UNDERLINE_POSITION|
+ |UNDERLINE_THICKNESS|
+ |STRIKEOUT_ASCENT|
+ |STRIKEOUT_DESCENT|
+ |ITALIC_ANGLE|
+ |X_HEIGHT|
+ |QUAD_WIDTH|
+ |WEIGHT|
+ |POINT_SIZE|
+ |RESOLUTION|
+ |COPYRIGHT|
+ |NOTICE|
+ |FONT_NAME|
+ |FAMILY_NAME|
+ |FULL_NAME|
+ |CAP_HEIGHT|
+ |WM_CLASS|
+ |WM_TRANSIENT_FOR|))
\f
(define (symbol->x-atom display name soft?)
(or (hash-table-ref/default built-in-atoms-table name #f)
(x-window-id xterm)
last-focus-time
string))))
- (own-selection 'PRIMARY)
+ (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
(hash-table-set! table key result)
result))))))
-;;; In the next two procedures, we must allow TIME to be 0, even
+;;; In the next two procedures, we must allow time to be 0, even
;;; though the ICCCM forbids this, because existing clients use that
-;;; value. An example of a broken client is GTK+ version 1.2.6.
+;;; value. An example of a broken client is Gtk+ version 1.2.6.
(define (display/selection-record display name time)
(let ((record
data)
target))))
(case target
- ((STRING)
+ ((|STRING|)
(win 8 (selection-record/value record)))
- ((TARGETS)
- (win 32 (atoms->property-data '(STRING TIMESTAMP) display)))
- ((TIMESTAMP)
+ ((|TARGETS|)
+ (win 32 (atoms->property-data '(|STRING| |TIMESTAMP|) display)))
+ ((|TIMESTAMP|)
(win 32 (timestamp->property-data (selection-record/time record))))
- ((MULTIPLE)
+ ((|MULTIPLE|)
(and multiple?
(let ((alist
(property-data->atom-alist
(or (get-window-property display requestor property
- 'MULTIPLE #f)
+ '|MULTIPLE| #f)
(error "Missing MULTIPLE property:" property))
display)))
(for-each (lambda (entry)
(define (property-data->atom-alist data display)
(if (not (even? (vector-length data)))
- (error:bad-range-argument data 'PROPERTY-DATA->ATOM-ALIST))
+ (error:bad-range-argument data 'property-data->atom-alist))
(let loop ((atoms
(map (lambda (atom) (x-atom->symbol display atom))
(vector->list data))))
(define (xterm/interprogram-paste xterm context)
(or (and (ref-variable x-paste-from-clipboard context)
- (xterm/interprogram-paste-1 xterm 'CLIPBOARD))
- (xterm/interprogram-paste-1 xterm 'PRIMARY)))
+ (xterm/interprogram-paste-1 xterm '|CLIPBOARD|))
+ (xterm/interprogram-paste-1 xterm '|PRIMARY|)))
(define (xterm/interprogram-paste-1 xterm selection)
(with-thread-events-blocked
(lambda ()
- (let ((property '_EDWIN_TMP_)
+ (let ((property '|_EDWIN_TMP_|)
(time last-focus-time))
(cond ((display/selection-record (x-window-display xterm)
selection time)
=> selection-record/value)
- ((request-selection xterm selection 'STRING property time)
- (receive-selection xterm property 'STRING time))
- ((request-selection xterm selection 'C_STRING property time)
- (receive-selection xterm property 'C_STRING time))
+ ((request-selection xterm selection '|STRING| property time)
+ (receive-selection xterm property '|STRING| time))
+ ((request-selection xterm selection '|C_STRING| property time)
+ (receive-selection xterm property '|C_STRING| time))
(else #f))))))
(define (request-selection xterm selection target property time)
(x-delete-property display window property)
(x-convert-selection display selection target property window time)
(x-display-flush display)
- (eq? 'REQUEST-GRANTED
+ (eq? 'request-granted
(wait-for-event x-selection-timeout
(lambda (event)
(fix:= event-type:selection-notify (vector-ref event 0)))
(= target (selection-notify/target event))
(= time (selection-notify/time event))
(if (= property (selection-notify/property event))
- 'REQUEST-GRANTED
- 'REQUEST-DENIED))))))))
+ 'request-granted
+ 'request-denied))))))))
(define-structure (selection-notify (type vector)
(initial-offset 2)
(let ((value (get-xterm-property xterm property #f #t)))
(if (not value)
(error "Missing selection value."))
- (if (eq? 'INCR (car value))
+ (if (eq? 'incr (car value))
(receive-incremental-selection xterm property target time)
(and (eq? target (car value))
(cdr value)))))
(wait-for-window-property-change xterm property time
x-property-state:new-value)))
(if (not time)
- (error "Timeout waiting for PROPERTY-NOTIFY event."))
+ (error "Timeout waiting for property-notify event."))
(let ((value (get-xterm-property xterm property target #t)))
(if (not value)
- (error "Missing property after PROPERTY-NOTIFY event."))
+ (error "Missing property after property-notify event."))
(if (string-null? value)
(apply string-append (reverse! accum))
(loop time (cons value accum)))))))
unspecific)
(define (get-x-display)
- ;; X-OPEN-DISPLAY hangs, uninterruptibly, when the X server is
+ ;; x-open-display hangs, uninterruptibly, when the X server is
;; running the login loop of xdm. Can this be fixed?
(or x-display-data
(and (or x-display-name
- (let ((DISPLAY (get-environment-variable "DISPLAY")))
- (and (string? DISPLAY)
- (not (string-null? DISPLAY)))))
+ (let ((display (get-environment-variable "DISPLAY")))
+ (and (string? display)
+ (not (string-null? display)))))
(plugin-available? "x11")
(begin
- (load-option 'X11)
+ (load-option 'x11)
(let ((display (x-open-display x-display-name)))
(set! x-display-data display)
(set! x-display-events (make-queue))
projects / mit-scheme.git / commitdiff