From 79a80dba057d045713ffb689cc64b7fde8ba2949 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Wed, 8 Jun 2016 15:01:07 -0700 Subject: [PATCH] x11-screen/x11-screen-check.sh: Test read some X11 properties. --- src/x11-screen/Makefile.am | 2 +- src/x11-screen/x11-screen-check.sh | 11 +++++--- src/x11-screen/x11-screen-test.scm | 40 ++++++++++++++++++++++++++++++ 3 files changed, 49 insertions(+), 4 deletions(-) create mode 100644 src/x11-screen/x11-screen-test.scm diff --git a/src/x11-screen/Makefile.am b/src/x11-screen/Makefile.am index 42dce0151..bacb3241c 100644 --- a/src/x11-screen/Makefile.am +++ b/src/x11-screen/Makefile.am @@ -61,7 +61,7 @@ ETAGS_ARGS = $(sources) TAGS_DEPENDENCIES = $(sources) EXTRA_DIST += $(sources) compile.sh x11-screen.pkg -EXTRA_DIST += x11-screen-check.sh +EXTRA_DIST += x11-screen-check.sh x11-screen-test.scm EXTRA_DIST += make.scm optiondb.scm install-data-hook: diff --git a/src/x11-screen/x11-screen-check.sh b/src/x11-screen/x11-screen-check.sh index e6f727c39..00ec66b91 100755 --- a/src/x11-screen/x11-screen-check.sh +++ b/src/x11-screen/x11-screen-check.sh @@ -1,16 +1,21 @@ #!/bin/sh +# -*-Scheme-*- # # Test the X11-SCREEN option. set -e ${MIT_SCHEME_EXE} --prepend-library . <<\EOF (begin - (load-option 'X11-SCREEN) - (if (let ((display (get-environment-variable "DISPLAY"))) (or (not (string? display)) (string-null? display))) (warn "DISPLAY not set") - (edit)) + (let ((edwin (->environment '(edwin)))) + (load-option 'X11-SCREEN) + (set! (access os/init-file-name edwin) + (let ((pathname (merge-pathnames "x11-screen-test.scm"))) + (named-lambda (os/init-file-name/x11-screen-test) + pathname))) + (edit))) ) EOF diff --git a/src/x11-screen/x11-screen-test.scm b/src/x11-screen/x11-screen-test.scm new file mode 100644 index 000000000..6c2c8ece6 --- /dev/null +++ b/src/x11-screen/x11-screen-test.scm @@ -0,0 +1,40 @@ +#| -*-Scheme-*- + +Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, + 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, + 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016 + Massachusetts Institute of Technology + +This file is part of an x11 plugin for 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. + +This plugin 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. + +|# + +;;;; Test the x11-screen type. + +(let ((x11s (->environment '(edwin screen x11-screen)))) + (let ((xterm ((access screen-xterm x11s) (selected-screen))) + (xd ((access screen-display x11s) (selected-screen))) + (get-xterm-property (access get-xterm-property x11s)) + (x-atom->symbol (access x-atom->symbol x11s))) + (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))) + (display "WM hints:\n") + (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 -- 2.25.1