From: Matt Birkholz Date: Wed, 7 Aug 2019 00:56:39 +0000 (-0700) Subject: x11-screen: downcase symbols, most names; fix copyright notices X-Git-Tag: mit-scheme-pucked-10.1.20~12^2~2 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6c74a356dc1d3d9984aa5a6704f26da752e62d42;p=mit-scheme.git x11-screen: downcase symbols, most names; fix copyright notices --- diff --git a/src/x11-screen/NEWS b/src/x11-screen/NEWS index 2ee5ee4bb..f0343f918 100644 --- a/src/x11-screen/NEWS +++ b/src/x11-screen/NEWS @@ -5,7 +5,7 @@ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 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 diff --git a/src/x11-screen/README b/src/x11-screen/README index 02ad443fb..a81517853 100644 --- a/src/x11-screen/README +++ b/src/x11-screen/README @@ -1,4 +1,4 @@ -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 diff --git a/src/x11-screen/compile.sh b/src/x11-screen/compile.sh index 062bd0f1c..ed9a4a23a 100755 --- a/src/x11-screen/compile.sh +++ b/src/x11-screen/compile.sh @@ -7,24 +7,24 @@ # 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} diff --git a/src/x11-screen/configure.ac b/src/x11-screen/configure.ac index 54b336b45..70997b39f 100644 --- a/src/x11-screen/configure.ac +++ b/src/x11-screen/configure.ac @@ -12,7 +12,7 @@ AC_COPYRIGHT( 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 diff --git a/src/x11-screen/ed-ffi.scm b/src/x11-screen/ed-ffi.scm index 4fcde38bf..a953dce3c 100644 --- a/src/x11-screen/ed-ffi.scm +++ b/src/x11-screen/ed-ffi.scm @@ -5,21 +5,22 @@ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 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. |# @@ -28,6 +29,6 @@ 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 diff --git a/src/x11-screen/optiondb.scm b/src/x11-screen/optiondb.scm index 8625f75fc..d1186c1e1 100644 --- a/src/x11-screen/optiondb.scm +++ b/src/x11-screen/optiondb.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- |# -(define-load-option 'X11-SCREEN +(define-load-option 'x11-screen (standard-system-loader ".")) (further-load-options #t) \ No newline at end of file diff --git a/src/x11-screen/x11-command.scm b/src/x11-screen/x11-command.scm index 31394b2df..4ae2cc651 100644 --- a/src/x11-screen/x11-command.scm +++ b/src/x11-screen/x11-command.scm @@ -5,21 +5,22 @@ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 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. |# @@ -31,14 +32,14 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (screen-xterm (selected-screen))) (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))) @@ -47,38 +48,38 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (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)))) (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) @@ -150,7 +151,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. " 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)))) @@ -173,13 +174,13 @@ desktop." (x-window-set-position (current-xterm) x y))) (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))) @@ -226,8 +227,8 @@ Used only if `frame-icon-name-format' is non-false." (lambda () (x-window-lower (current-xterm)))) (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" @@ -268,8 +269,8 @@ When called interactively, completion is available on the input." (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) diff --git a/src/x11-screen/x11-key.scm b/src/x11-screen/x11-key.scm index a08fec691..403eb8bc7 100644 --- a/src/x11-screen/x11-key.scm +++ b/src/x11-screen/x11-key.scm @@ -5,21 +5,22 @@ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 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. |# diff --git a/src/x11-screen/x11-screen-check.sh b/src/x11-screen/x11-screen-check.sh index 1fcd946f4..58aed1522 100755 --- a/src/x11-screen/x11-screen-check.sh +++ b/src/x11-screen/x11-screen-check.sh @@ -1,7 +1,7 @@ #!/bin/sh # -*-Scheme-*- # -# Test the X11-SCREEN option. +# Test the X11 Screen option. set -e ${MIT_SCHEME_EXE} --prepend-library . <<\EOF diff --git a/src/x11-screen/x11-screen-test.scm b/src/x11-screen/x11-screen-test.scm index 3ba507c76..d30f2909f 100644 --- a/src/x11-screen/x11-screen-test.scm +++ b/src/x11-screen/x11-screen-test.scm @@ -5,25 +5,26 @@ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 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. (let ((x11s (->environment '(edwin screen x11-screen)))) (let ((xterm ((access screen-xterm x11s) (selected-screen))) @@ -33,8 +34,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (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 diff --git a/src/x11-screen/x11-screen.pkg b/src/x11-screen/x11-screen.pkg index 5a74ecac8..d688e07cb 100644 --- a/src/x11-screen/x11-screen.pkg +++ b/src/x11-screen/x11-screen.pkg @@ -5,21 +5,22 @@ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 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. |# diff --git a/src/x11-screen/x11-screen.scm b/src/x11-screen/x11-screen.scm index 555f68fce..f1422086f 100644 --- a/src/x11-screen/x11-screen.scm +++ b/src/x11-screen/x11-screen.scm @@ -53,7 +53,7 @@ USA. (selected? #t) (name #f) (icon-name #f) - (x-visibility 'VISIBLE) + (x-visibility 'visible) (mapped? #f) (unexposed? #t)) @@ -130,10 +130,10 @@ USA. ;;; 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))) @@ -166,7 +166,7 @@ USA. (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) @@ -175,7 +175,7 @@ USA. (if (and (screen-mapped? screen) (screen-exposed? screen)) (screen-x-visibility screen) - 'UNMAPPED)))) + 'unmapped)))) (define (screen-xterm screen) (xterm-screen-state/xterm (screen-state screen))) @@ -258,7 +258,7 @@ USA. (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))) @@ -284,11 +284,11 @@ USA. (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)) @@ -368,7 +368,7 @@ USA. (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 @@ -537,7 +537,7 @@ USA. (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) @@ -655,13 +655,13 @@ USA. (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))) @@ -673,13 +673,13 @@ USA. (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))) @@ -690,7 +690,7 @@ USA. (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)) @@ -711,9 +711,9 @@ USA. (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))) @@ -723,7 +723,7 @@ USA. (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 @@ -733,7 +733,7 @@ USA. (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 @@ -749,91 +749,91 @@ USA. (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))) ;;;; 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|)) (define (symbol->x-atom display name soft?) (or (hash-table-ref/default built-in-atoms-table name #f) @@ -1034,9 +1034,9 @@ In either case, it is copied to the primary selection." (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 @@ -1059,9 +1059,9 @@ In either case, it is copied to the primary selection." (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 @@ -1145,18 +1145,18 @@ In either case, it is copied to the primary selection." 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) @@ -1180,7 +1180,7 @@ In either case, it is copied to the primary selection." (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)))) @@ -1212,21 +1212,21 @@ Otherwise, it is copied from the primary selection." (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) @@ -1238,7 +1238,7 @@ Otherwise, it is copied from the primary selection." (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))) @@ -1248,8 +1248,8 @@ Otherwise, it is copied from the primary selection." (= 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) @@ -1264,7 +1264,7 @@ Otherwise, it is copied from the primary selection." (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))))) @@ -1280,10 +1280,10 @@ Otherwise, it is copied from the primary selection." (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))))))) @@ -1366,16 +1366,16 @@ Otherwise, it is copied from the primary selection." 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))