diff -Nru gcl-2.6.7/debian/changelog gcl-2.6.7/debian/changelog --- gcl-2.6.7/debian/changelog 2011-05-11 20:06:41.000000000 +0000 +++ gcl-2.6.7/debian/changelog 2012-01-20 19:55:45.000000000 +0000 @@ -1,3 +1,72 @@ +gcl (2.6.7-98) unstable; urgency=low + + * restore traditional make-sequence,make-array, and coerce, and + optimize replace, as 2.6.8 compiler is still too weak re: inlines + + -- Camm Maguire Fri, 20 Jan 2012 19:55:45 +0000 + +gcl (2.6.7-97) unstable; urgency=low + + * evade __builtin___clear_cache on hppa + * make-array;make-sequence;replace;coerce + + -- Camm Maguire Fri, 20 Jan 2012 05:13:22 +0000 + +gcl (2.6.7-96) unstable; urgency=low + + * better XDR detection; no __builtin_clear_cache on sh4 + + -- Camm Maguire Wed, 18 Jan 2012 01:32:43 +0000 + +gcl (2.6.7-95) unstable; urgency=low + + * clear_cache after mprotect + + -- Camm Maguire Tue, 17 Jan 2012 03:54:56 +0000 + +gcl (2.6.7-94) unstable; urgency=low + + * optimize unwind at O0 to workaround gcc bug; centralize on + __builtin__clear_cache when available;arm_thm_call reloc support + + -- Camm Maguire Mon, 16 Jan 2012 20:10:07 +0000 + +gcl (2.6.7-93) unstable; urgency=low + + * remove C_GC_OFFSET for sparc64 + * remove ncurses dependency for readline + * Bug fix: "FTBFS: dpkg-buildpackage: error: dpkg-source -b gcl-2.6.7 + gave error exit status 2", thanks to Didier Raboud (Closes: #643131). + * Bug fix: "drops readline support if rebuilt", thanks to Sven Joachim + (Closes: #646735). + * lower opts on sparc64 asof gcc 4.6.1 + + -- Camm Maguire Wed, 11 Jan 2012 21:04:23 +0000 + +gcl (2.6.7-92) unstable; urgency=low + + * remove gprof on arm as mcount calls are 24/22bit -- marginally + accessible + + -- Camm Maguire Sat, 07 Jan 2012 02:42:06 +0000 + +gcl (2.6.7-91) unstable; urgency=low + + * s390x reloc support + * lower C optimization on ia64, arm and mips for now + + -- Camm Maguire Thu, 05 Jan 2012 17:30:01 +0000 + +gcl (2.6.7-90) unstable; urgency=low + + * libtirpc check for newest glibc + * read_preserving_whitespace fix + * armhf reloc support + * s390x support + * try C_GC_OFFSET for sparc64 + + -- Camm Maguire Wed, 04 Jan 2012 19:51:13 +0000 + gcl (2.6.7-89) unstable; urgency=low * support new mips relocs diff -Nru gcl-2.6.7/debian/patches/2.6.8 gcl-2.6.7/debian/patches/2.6.8 --- gcl-2.6.7/debian/patches/2.6.8 1970-01-01 00:00:00.000000000 +0000 +++ gcl-2.6.7/debian/patches/2.6.8 2012-01-04 19:53:36.000000000 +0000 @@ -0,0 +1,399874 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.7-90) unstable; urgency=low + . + * libtirpc check for newest glibc + * read_preserving_whitespace fix + * armhf reloc support + * s390x support + * try C_GC_OFFSET for sparc64 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: http://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- /dev/null ++++ gcl-2.6.7/readme.xgcl +@@ -0,0 +1,77 @@ ++xgcl is an interface from Gnu Common Lisp to the X library, Xlib. ++ ++This software provides a lightweight and fairy easy-to-use way to: ++ * Draw diagrams from Lisp ++ * Create interactive graphical interfaces ++ * Make the interactive Lisp interfaces available via the Web ++ ++Beginning with release 2.6.8, xgcl is built into the make of GCL. ++ ++There is a "raw" interface to the Xlib, and an "easy-to-use" ++interface built on top of it; we will only discuss the "easy-to-use" ++version. ++ ++To use xgcl, start GCL and enter: (xgcl) ++This will load xgcl and print a message inviting you to try (xgcl-demo). ++(xgcl-demo) will create a small window and draw some examples in it. ++You can try (wtestc), (wtestd), ... (wtestk) to try some other things. ++ ++The xgcl files are located in the directory xgcl-2/ relative to the ++GCL directory. ++ ++The file gcl_dwtest.lsp contains the test examples; one way to ++get started quickly is by using this file for examples. ++ ++There is also documentation: ++ dwdoc.tex ++ dwdoc.dvi ++ dwdoc.html http://www.cs.utexas.edu/users/novak/dwdoc.html ++ dwdoc.pdf ++ dwdoc.ps ++ ++To use the basic xgcl, you only need to invoke (xgcl). ++To use some of the more advanced features such as menu-set, described ++below, also load the file gcl_dwimportsb.lsp immediately after ++invoking (xgcl), to import symbols. ++ ++Additional files that may be useful: ++ ++ gcl_menu-set.lsp Source and some comments for menu-set ++ gcl_menu-settrans.lsp menu-set translated to Common Lisp ++ gcl_pcalc.lsp Pocket calculator example ++ gcl_draw-gates.lsp Draw boolean gate symbols ++ gcl_draw.lsp Interactive drawing program source ++ gcl_drawtrans.lsp Drawing program translated to Common Lisp ++ gcl_dwindow.lsp Easy-to-use interface source with comments ++ gcl_dwtrans.lsp Easy-to-use interface translated to Common Lisp ++ gcl_editors.lsp Editors for colors etc. ++ gcl_editorstrans.lsp Editors translated to Common Lisp ++ gcl_ice-cream.lsp Example created using Draw ++ lispserver.lsp Example web demo: a Lisp server ++ lispservertrans.lsp Lisp server translated to Common Lisp ++ Xakcl.paper Documentation on the "raw" Xlib interface ++ Xakcl.example.lsp some PRIMITIVE examples ++ ++ ++This software provides a way to interface Lisp programs to the Web; see: ++ ++ http://www.cs.utexas.edu/users/novak/dwindow.html ++ ++There are two ways to accomplish a Web interface. ++ ++The first uses X directly, and requires that the user have an X server; ++this is reliable and fast, but it only works for the Linux/Mac/Cygwin ++subset of the world. There can also be firewall issues. ++ ++The other option uses WeirdX, an X server written in Java. ++The WeirdX interface is often slow, and sometimes doesn't work at all, ++but when it works, it works with any web browser, even on Windows. ++The WeirdX interface tends to leave "mouse droppings" on interactive ++drawings. ++ ++There are numerous examples of these web interfaces at: ++ ++ http://www.cs.utexas.edu/users/novak/ ++ ++The Draw demo is a good one to try. ++ +--- gcl-2.6.7.orig/makedefc.in ++++ gcl-2.6.7/makedefc.in +@@ -43,6 +43,7 @@ TCL_LIBS=@TCL_LIBS@ + NOTIFY=@NOTIFY@ + CC=@CC@ + CFLAGS=@CFLAGS@ ++LDFLAGS=@LDFLAGS@ + FINAL_CFLAGS=@FINAL_CFLAGS@ + NIFLAGS=@NIFLAGS@ + O3FLAGS=@O3FLAGS@ +@@ -66,3 +67,6 @@ PROCESSOR_FLAGS=@PROCESSOR_FLAGS@ + EXTRA_LOBJS=@EXTRA_LOBJS@ + LEADING_UNDERSCORE=@LEADING_UNDERSCORE@ + GNU_LD=@GNU_LD@ ++AWK=@AWK@ ++LIBBFD=@LIBBFD@ ++LIBIBERTY=@LIBIBERTY@ +--- gcl-2.6.7.orig/configure ++++ gcl-2.6.7/configure +@@ -1,95 +1,773 @@ + #! /bin/sh +- + # Guess values for system-dependent variables and create Makefiles. +-# Generated automatically using autoconf version 2.13 +-# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. ++# Generated by GNU Autoconf 2.68. ++# ++# ++# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, ++# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software ++# Foundation, Inc. ++# + # + # This configure script is free software; the Free Software Foundation + # gives unlimited permission to copy, distribute and modify it. ++## -------------------- ## ++## M4sh Initialization. ## ++## -------------------- ## ++ ++# Be more Bourne compatible ++DUALCASE=1; export DUALCASE # for MKS sh ++if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : ++ emulate sh ++ NULLCMD=: ++ # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which ++ # is contrary to our usage. Disable this feature. ++ alias -g '${1+"$@"}'='"$@"' ++ setopt NO_GLOB_SUBST ++else ++ case `(set -o) 2>/dev/null` in #( ++ *posix*) : ++ set -o posix ;; #( ++ *) : ++ ;; ++esac ++fi ++ ++ ++as_nl=' ++' ++export as_nl ++# Printing a long string crashes Solaris 7 /usr/bin/printf. ++as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' ++as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo ++as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo ++# Prefer a ksh shell builtin over an external printf program on Solaris, ++# but without wasting forks for bash or zsh. ++if test -z "$BASH_VERSION$ZSH_VERSION" \ ++ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then ++ as_echo='print -r --' ++ as_echo_n='print -rn --' ++elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then ++ as_echo='printf %s\n' ++ as_echo_n='printf %s' ++else ++ if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then ++ as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' ++ as_echo_n='/usr/ucb/echo -n' ++ else ++ as_echo_body='eval expr "X$1" : "X\\(.*\\)"' ++ as_echo_n_body='eval ++ arg=$1; ++ case $arg in #( ++ *"$as_nl"*) ++ expr "X$arg" : "X\\(.*\\)$as_nl"; ++ arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; ++ esac; ++ expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" ++ ' ++ export as_echo_n_body ++ as_echo_n='sh -c $as_echo_n_body as_echo' ++ fi ++ export as_echo_body ++ as_echo='sh -c $as_echo_body as_echo' ++fi ++ ++# The user is always right. ++if test "${PATH_SEPARATOR+set}" != set; then ++ PATH_SEPARATOR=: ++ (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { ++ (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || ++ PATH_SEPARATOR=';' ++ } ++fi ++ ++ ++# IFS ++# We need space, tab and new line, in precisely that order. Quoting is ++# there to prevent editors from complaining about space-tab. ++# (If _AS_PATH_WALK were called with IFS unset, it would disable word ++# splitting by setting IFS to empty value.) ++IFS=" "" $as_nl" ++ ++# Find who we are. Look in the path if we contain no directory separator. ++as_myself= ++case $0 in #(( ++ *[\\/]* ) as_myself=$0 ;; ++ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break ++ done ++IFS=$as_save_IFS ++ ++ ;; ++esac ++# We did not find ourselves, most probably we were run as `sh COMMAND' ++# in which case we are not to be found in the path. ++if test "x$as_myself" = x; then ++ as_myself=$0 ++fi ++if test ! -f "$as_myself"; then ++ $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 ++ exit 1 ++fi ++ ++# Unset variables that we do not need and which cause bugs (e.g. in ++# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" ++# suppresses any "Segmentation fault" message there. '((' could ++# trigger a bug in pdksh 5.2.14. ++for as_var in BASH_ENV ENV MAIL MAILPATH ++do eval test x\${$as_var+set} = xset \ ++ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : ++done ++PS1='$ ' ++PS2='> ' ++PS4='+ ' ++ ++# NLS nuisances. ++LC_ALL=C ++export LC_ALL ++LANGUAGE=C ++export LANGUAGE ++ ++# CDPATH. ++(unset CDPATH) >/dev/null 2>&1 && unset CDPATH ++ ++if test "x$CONFIG_SHELL" = x; then ++ as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : ++ emulate sh ++ NULLCMD=: ++ # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which ++ # is contrary to our usage. Disable this feature. ++ alias -g '\${1+\"\$@\"}'='\"\$@\"' ++ setopt NO_GLOB_SUBST ++else ++ case \`(set -o) 2>/dev/null\` in #( ++ *posix*) : ++ set -o posix ;; #( ++ *) : ++ ;; ++esac ++fi ++" ++ as_required="as_fn_return () { (exit \$1); } ++as_fn_success () { as_fn_return 0; } ++as_fn_failure () { as_fn_return 1; } ++as_fn_ret_success () { return 0; } ++as_fn_ret_failure () { return 1; } ++ ++exitcode=0 ++as_fn_success || { exitcode=1; echo as_fn_success failed.; } ++as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } ++as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } ++as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } ++if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : ++ ++else ++ exitcode=1; echo positional parameters were not saved. ++fi ++test x\$exitcode = x0 || exit 1" ++ as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO ++ as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO ++ eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && ++ test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 ++test \$(( 1 + 1 )) = 2 || exit 1" ++ if (eval "$as_required") 2>/dev/null; then : ++ as_have_required=yes ++else ++ as_have_required=no ++fi ++ if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : ++ ++else ++ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++as_found=false ++for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ as_found=: ++ case $as_dir in #( ++ /*) ++ for as_base in sh bash ksh sh5; do ++ # Try only shells that exist, to save several forks. ++ as_shell=$as_dir/$as_base ++ if { test -f "$as_shell" || test -f "$as_shell.exe"; } && ++ { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : ++ CONFIG_SHELL=$as_shell as_have_required=yes ++ if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : ++ break 2 ++fi ++fi ++ done;; ++ esac ++ as_found=false ++done ++$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && ++ { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : ++ CONFIG_SHELL=$SHELL as_have_required=yes ++fi; } ++IFS=$as_save_IFS ++ ++ ++ if test "x$CONFIG_SHELL" != x; then : ++ # We cannot yet assume a decent shell, so we have to provide a ++ # neutralization value for shells without unset; and this also ++ # works around shells that cannot unset nonexistent variables. ++ # Preserve -v and -x to the replacement shell. ++ BASH_ENV=/dev/null ++ ENV=/dev/null ++ (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV ++ export CONFIG_SHELL ++ case $- in # (((( ++ *v*x* | *x*v* ) as_opts=-vx ;; ++ *v* ) as_opts=-v ;; ++ *x* ) as_opts=-x ;; ++ * ) as_opts= ;; ++ esac ++ exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"} ++fi ++ ++ if test x$as_have_required = xno; then : ++ $as_echo "$0: This script requires a shell more modern than all" ++ $as_echo "$0: the shells that I found on your system." ++ if test x${ZSH_VERSION+set} = xset ; then ++ $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" ++ $as_echo "$0: be upgraded to zsh 4.3.4 or later." ++ else ++ $as_echo "$0: Please tell bug-autoconf@gnu.org about your system, ++$0: including any error possibly output before this ++$0: message. Then install a modern shell, or manually run ++$0: the script under such a shell if you do have one." ++ fi ++ exit 1 ++fi ++fi ++fi ++SHELL=${CONFIG_SHELL-/bin/sh} ++export SHELL ++# Unset more variables known to interfere with behavior of common tools. ++CLICOLOR_FORCE= GREP_OPTIONS= ++unset CLICOLOR_FORCE GREP_OPTIONS ++ ++## --------------------- ## ++## M4sh Shell Functions. ## ++## --------------------- ## ++# as_fn_unset VAR ++# --------------- ++# Portably unset VAR. ++as_fn_unset () ++{ ++ { eval $1=; unset $1;} ++} ++as_unset=as_fn_unset ++ ++# as_fn_set_status STATUS ++# ----------------------- ++# Set $? to STATUS, without forking. ++as_fn_set_status () ++{ ++ return $1 ++} # as_fn_set_status ++ ++# as_fn_exit STATUS ++# ----------------- ++# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. ++as_fn_exit () ++{ ++ set +e ++ as_fn_set_status $1 ++ exit $1 ++} # as_fn_exit ++ ++# as_fn_mkdir_p ++# ------------- ++# Create "$as_dir" as a directory, including parents if necessary. ++as_fn_mkdir_p () ++{ ++ ++ case $as_dir in #( ++ -*) as_dir=./$as_dir;; ++ esac ++ test -d "$as_dir" || eval $as_mkdir_p || { ++ as_dirs= ++ while :; do ++ case $as_dir in #( ++ *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( ++ *) as_qdir=$as_dir;; ++ esac ++ as_dirs="'$as_qdir' $as_dirs" ++ as_dir=`$as_dirname -- "$as_dir" || ++$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ ++ X"$as_dir" : 'X\(//\)[^/]' \| \ ++ X"$as_dir" : 'X\(//\)$' \| \ ++ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || ++$as_echo X"$as_dir" | ++ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ ++ s//\1/ ++ q ++ } ++ /^X\(\/\/\)[^/].*/{ ++ s//\1/ ++ q ++ } ++ /^X\(\/\/\)$/{ ++ s//\1/ ++ q ++ } ++ /^X\(\/\).*/{ ++ s//\1/ ++ q ++ } ++ s/.*/./; q'` ++ test -d "$as_dir" && break ++ done ++ test -z "$as_dirs" || eval "mkdir $as_dirs" ++ } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" ++ ++ ++} # as_fn_mkdir_p ++# as_fn_append VAR VALUE ++# ---------------------- ++# Append the text in VALUE to the end of the definition contained in VAR. Take ++# advantage of any shell optimizations that allow amortized linear growth over ++# repeated appends, instead of the typical quadratic growth present in naive ++# implementations. ++if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : ++ eval 'as_fn_append () ++ { ++ eval $1+=\$2 ++ }' ++else ++ as_fn_append () ++ { ++ eval $1=\$$1\$2 ++ } ++fi # as_fn_append ++ ++# as_fn_arith ARG... ++# ------------------ ++# Perform arithmetic evaluation on the ARGs, and store the result in the ++# global $as_val. Take advantage of shells that can avoid forks. The arguments ++# must be portable across $(()) and expr. ++if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : ++ eval 'as_fn_arith () ++ { ++ as_val=$(( $* )) ++ }' ++else ++ as_fn_arith () ++ { ++ as_val=`expr "$@" || test $? -eq 1` ++ } ++fi # as_fn_arith ++ ++ ++# as_fn_error STATUS ERROR [LINENO LOG_FD] ++# ---------------------------------------- ++# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are ++# provided, also output the error to LOG_FD, referencing LINENO. Then exit the ++# script with STATUS, using 1 if that was 0. ++as_fn_error () ++{ ++ as_status=$1; test $as_status -eq 0 && as_status=1 ++ if test "$4"; then ++ as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 ++ fi ++ $as_echo "$as_me: error: $2" >&2 ++ as_fn_exit $as_status ++} # as_fn_error ++ ++if expr a : '\(a\)' >/dev/null 2>&1 && ++ test "X`expr 00001 : '.*\(...\)'`" = X001; then ++ as_expr=expr ++else ++ as_expr=false ++fi ++ ++if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then ++ as_basename=basename ++else ++ as_basename=false ++fi ++ ++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then ++ as_dirname=dirname ++else ++ as_dirname=false ++fi ++ ++as_me=`$as_basename -- "$0" || ++$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ ++ X"$0" : 'X\(//\)$' \| \ ++ X"$0" : 'X\(/\)' \| . 2>/dev/null || ++$as_echo X/"$0" | ++ sed '/^.*\/\([^/][^/]*\)\/*$/{ ++ s//\1/ ++ q ++ } ++ /^X\/\(\/\/\)$/{ ++ s//\1/ ++ q ++ } ++ /^X\/\(\/\).*/{ ++ s//\1/ ++ q ++ } ++ s/.*/./; q'` ++ ++# Avoid depending upon Character Ranges. ++as_cr_letters='abcdefghijklmnopqrstuvwxyz' ++as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' ++as_cr_Letters=$as_cr_letters$as_cr_LETTERS ++as_cr_digits='0123456789' ++as_cr_alnum=$as_cr_Letters$as_cr_digits ++ ++ ++ as_lineno_1=$LINENO as_lineno_1a=$LINENO ++ as_lineno_2=$LINENO as_lineno_2a=$LINENO ++ eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && ++ test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { ++ # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) ++ sed -n ' ++ p ++ /[$]LINENO/= ++ ' <$as_myself | ++ sed ' ++ s/[$]LINENO.*/&-/ ++ t lineno ++ b ++ :lineno ++ N ++ :loop ++ s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ ++ t loop ++ s/-\n.*// ++ ' >$as_me.lineno && ++ chmod +x "$as_me.lineno" || ++ { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } ++ ++ # Don't try to exec as it changes $[0], causing all sort of problems ++ # (the dirname of $[0] is not the place where we might find the ++ # original and so on. Autoconf is especially sensitive to this). ++ . "./$as_me.lineno" ++ # Exit status is that of the last command. ++ exit ++} ++ ++ECHO_C= ECHO_N= ECHO_T= ++case `echo -n x` in #((((( ++-n*) ++ case `echo 'xy\c'` in ++ *c*) ECHO_T=' ';; # ECHO_T is single tab character. ++ xy) ECHO_C='\c';; ++ *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ++ ECHO_T=' ';; ++ esac;; ++*) ++ ECHO_N='-n';; ++esac ++ ++rm -f conf$$ conf$$.exe conf$$.file ++if test -d conf$$.dir; then ++ rm -f conf$$.dir/conf$$.file ++else ++ rm -f conf$$.dir ++ mkdir conf$$.dir 2>/dev/null ++fi ++if (echo >conf$$.file) 2>/dev/null; then ++ if ln -s conf$$.file conf$$ 2>/dev/null; then ++ as_ln_s='ln -s' ++ # ... but there are two gotchas: ++ # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. ++ # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. ++ # In both cases, we have to default to `cp -p'. ++ ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || ++ as_ln_s='cp -p' ++ elif ln conf$$.file conf$$ 2>/dev/null; then ++ as_ln_s=ln ++ else ++ as_ln_s='cp -p' ++ fi ++else ++ as_ln_s='cp -p' ++fi ++rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file ++rmdir conf$$.dir 2>/dev/null ++ ++if mkdir -p . 2>/dev/null; then ++ as_mkdir_p='mkdir -p "$as_dir"' ++else ++ test -d ./-p && rmdir ./-p ++ as_mkdir_p=false ++fi ++ ++if test -x / >/dev/null 2>&1; then ++ as_test_x='test -x' ++else ++ if ls -dL / >/dev/null 2>&1; then ++ as_ls_L_option=L ++ else ++ as_ls_L_option= ++ fi ++ as_test_x=' ++ eval sh -c '\'' ++ if test -d "$1"; then ++ test -d "$1/."; ++ else ++ case $1 in #( ++ -*)set "./$1";; ++ esac; ++ case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( ++ ???[sx]*):;;*)false;;esac;fi ++ '\'' sh ++ ' ++fi ++as_executable_p=$as_test_x ++ ++# Sed expression to map a string onto a valid CPP name. ++as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" ++ ++# Sed expression to map a string onto a valid variable name. ++as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" ++ ++ ++test -n "$DJDIR" || exec 7<&0 &1 ++ ++# Name of the host. ++# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, ++# so uname gets run too. ++ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +-# Defaults: +-ac_help= ++# ++# Initializations. ++# + ac_default_prefix=/usr/local +-# Any additions from configure.in: +-ac_help="$ac_help +- --enable-maxpage=XXXX will compile in a page table of size XXX (eg '--enable-maxpage=64*1024' would give 64K pages allowing 256 MB if pages are 4K each) " +-ac_help="$ac_help +- --enable-holepage=XXXX will compile in a XXX-sized hole between the heap and relocatable memory area (eg '--enable-holepage=64*1024' would give 64K pages allowing 256 MB if pages are 4K each) " +-ac_help="$ac_help +- --enable-vssize=XXXX will compile in a value stack of size XXX " +-ac_help="$ac_help +- --enable-bdssize=XXXX will compile in a binding stack of size XXX " +-ac_help="$ac_help +- --enable-ihssize=XXXX will compile in a invocation history stack of size XXX " +-ac_help="$ac_help +- --enable-frssize=XXXX will compile in a frame stack of size XXX " +-ac_help="$ac_help +- --enable-machine=XXXX will force the use of one of the definitions in h/XXXX.defs " +-ac_help="$ac_help +- --enable-notify=no will disable the automatic notification of gcl maintainers of successful builds/problems " +-ac_help="$ac_help +- --enable-tkconfig=XXXX will force the use of a TK_CONFIG_PREFIX=XXXXX as place to look for tkConfig.sh and tclConfig.sh " +-ac_help="$ac_help +- --enable-tclconfig=XXXX will force the use of a TCL_CONFIG_PREFIX=XXXXX as place to look for tclConfig.sh and tclConfig.sh " +-ac_help="$ac_help +- --enable-infodir=XXXX will force the use of a INFO_DIR=XXXXX as place to look for info " +-ac_help="$ac_help +- --enable-emacsdir=XXXX will manually specify the location for elisp files " +-ac_help="$ac_help +- --enable-common-binary=yes forces use of lowest common denominator instruction sets, (default is =yes) " +-ac_help="$ac_help +- --enable-japi=yes will compile in support for the JAPI graphical interface if present on your system" +-ac_help="$ac_help +- --enable-xdr=yes will compile in support for XDR" +-ac_help="$ac_help +- --enable-dlopen uses dlopen for loading objects, which can then not be retained in saved images +- " +-ac_help="$ac_help +- --enable-statsysbfd uses a static sytem bfd library for loading and relocationing object files +- " +-ac_help="$ac_help +- --enable-dynsysbfd uses a dynamic shared sytem bfd library for loading and relocationing object files +- " +-ac_help="$ac_help +- --enable-locbfd uses a static bfd library built from this source tree for loading and relocationing object files +- " +-ac_help="$ac_help +- --enable-custreloc uses custom gcl code if available for loading and relocationing object files +- " +-ac_help="$ac_help +- --enable-debug builds gcl with -g in CFLAGS to enable running under gdb +- " +-ac_help="$ac_help +- --enable-gprof builds gcl with -pg in CFLAGS to enable profiling with gprof +- " +-ac_help="$ac_help +- --enable-static will link your GCL against static as opposed to shared system libraries " +-ac_help="$ac_help +- --enable-pic builds gcl with -fPIC in CFLAGS +- " +-ac_help="$ac_help +- --enable-oldgmp will link against gmp2 instead of gmp3 +- " +-ac_help="$ac_help +- --enable-dynsysgmp will link against the system libgmp3 overriding certain functions with patched versions from the local source +- " +-ac_help="$ac_help +- --with-x use the X Window System" +-ac_help="$ac_help +---enable-readine enables command line completion via the readline library " +-ac_help="$ac_help +---enable-ansi builds a large gcl aiming for ansi compliance, +- --disable-ansi builds the smaller traditional CLtL1 image" ++ac_clean_files= ++ac_config_libobj_dir=. ++LIBOBJS= ++cross_compiling=no ++subdirs= ++MFLAGS= ++MAKEFLAGS= ++ ++# Identity of this package. ++PACKAGE_NAME= ++PACKAGE_TARNAME= ++PACKAGE_VERSION= ++PACKAGE_STRING= ++PACKAGE_BUGREPORT= ++PACKAGE_URL= ++ ++# Factoring default headers for most tests. ++ac_includes_default="\ ++#include ++#ifdef HAVE_SYS_TYPES_H ++# include ++#endif ++#ifdef HAVE_SYS_STAT_H ++# include ++#endif ++#ifdef STDC_HEADERS ++# include ++# include ++#else ++# ifdef HAVE_STDLIB_H ++# include ++# endif ++#endif ++#ifdef HAVE_STRING_H ++# if !defined STDC_HEADERS && defined HAVE_MEMORY_H ++# include ++# endif ++# include ++#endif ++#ifdef HAVE_STRINGS_H ++# include ++#endif ++#ifdef HAVE_INTTYPES_H ++# include ++#endif ++#ifdef HAVE_STDINT_H ++# include ++#endif ++#ifdef HAVE_UNISTD_H ++# include ++#endif" ++ ++ac_subst_vars='LTLIBOBJS ++LIBOBJS ++use ++GNU_LD ++LEADING_UNDERSCORE ++EXTRA_LOBJS ++O2FLAGS ++O3FLAGS ++NIFLAGS ++FINAL_CFLAGS ++BROKEN_O4_OPT ++NOTIFY ++TCL_LIBS ++TCL_DL_LIBS ++TCL_LIB_SPEC ++TK_XLIBSW ++TK_BUILD_LIB_SPEC ++TK_LIB_SPEC ++TCL_INCLUDE ++TK_INCLUDE ++TK_XINCLUDES ++TCL_LIBRARY ++TK_LIBRARY ++TK_CONFIG_PREFIX ++TCLSH ++INFO_DIR ++EMACS_DEFAULT_EL ++EMACS_SITE_LISP ++EMACS ++HAVE_SIGEMT ++HAVE_SIGSYS ++HAVE_SV_ONSTACK ++ENDIAN_ALREADY_DEFINED ++USE_CLEANUP ++HAVE_PUTENV ++HAVE_SETENV ++NO_PROFILE ++RL_LIB ++RL_OBJS ++CLSTANDARD ++SYSTEM ++FLISP ++HAVE_LONG_LONG ++PAGEWIDTH ++LITTLE_END ++LIBIBERTY ++LIBBFD ++BUILD_BFD ++X_CFLAGS ++X_LIBS ++XMKMF ++GMPDIR ++GMP ++HAVE_MALLOC_ZONE_MEMALIGN ++EGREP ++GREP ++MAKEINFO ++AWK ++CPP ++OBJEXT ++EXEEXT ++ac_ct_CC ++CPPFLAGS ++LDFLAGS ++CFLAGS ++CC ++PROCESSOR_FLAGS ++host_os ++host_vendor ++host_cpu ++host ++build_os ++build_vendor ++build_cpu ++build ++VERSION ++target_alias ++host_alias ++build_alias ++LIBS ++ECHO_T ++ECHO_N ++ECHO_C ++DEFS ++mandir ++localedir ++libdir ++psdir ++pdfdir ++dvidir ++htmldir ++infodir ++docdir ++oldincludedir ++includedir ++localstatedir ++sharedstatedir ++sysconfdir ++datadir ++datarootdir ++libexecdir ++sbindir ++bindir ++program_transform_name ++prefix ++exec_prefix ++PACKAGE_URL ++PACKAGE_BUGREPORT ++PACKAGE_STRING ++PACKAGE_VERSION ++PACKAGE_TARNAME ++PACKAGE_NAME ++PATH_SEPARATOR ++SHELL' ++ac_subst_files='' ++ac_user_opts=' ++enable_option_checking ++enable_maxpage ++enable_holepage ++enable_vssize ++enable_bdssize ++enable_ihssize ++enable_frssize ++enable_machine ++enable_notify ++enable_tcltk ++enable_tkconfig ++enable_tclconfig ++enable_infodir ++enable_emacsdir ++enable_common_binary ++enable_japi ++enable_xdr ++enable_xgcl ++enable_dlopen ++enable_statsysbfd ++enable_dynsysbfd ++enable_custreloc ++enable_debug ++enable_gprof ++enable_static ++enable_pic ++enable_oldgmp ++enable_dynsysgmp ++with_x ++enable_readline ++enable_ansi ++' ++ ac_precious_vars='build_alias ++host_alias ++target_alias ++CC ++CFLAGS ++LDFLAGS ++LIBS ++CPPFLAGS ++CPP ++XMKMF' ++ + + # Initialize some variables set by options. ++ac_init_help= ++ac_init_version=false ++ac_unrecognized_opts= ++ac_unrecognized_sep= + # The variables have the same names as the options, with + # dashes changed to underlines. +-build=NONE +-cache_file=./config.cache ++cache_file=/dev/null + exec_prefix=NONE +-host=NONE + no_create= +-nonopt=NONE + no_recursion= + prefix=NONE + program_prefix=NONE +@@ -98,94 +776,132 @@ program_transform_name=s,x,x, + silent= + site= + srcdir= +-target=NONE + verbose= + x_includes=NONE + x_libraries=NONE ++ ++# Installation directory options. ++# These are left unexpanded so users can "make install exec_prefix=/foo" ++# and all the variables that are supposed to be based on exec_prefix ++# by default will actually change. ++# Use braces instead of parens because sh, perl, etc. also accept them. ++# (The list follows the same order as the GNU Coding Standards.) + bindir='${exec_prefix}/bin' + sbindir='${exec_prefix}/sbin' + libexecdir='${exec_prefix}/libexec' +-datadir='${prefix}/share' ++datarootdir='${prefix}/share' ++datadir='${datarootdir}' + sysconfdir='${prefix}/etc' + sharedstatedir='${prefix}/com' + localstatedir='${prefix}/var' +-libdir='${exec_prefix}/lib' + includedir='${prefix}/include' + oldincludedir='/usr/include' +-infodir='${prefix}/info' +-mandir='${prefix}/man' +- +-# Initialize some other variables. +-subdirs= +-MFLAGS= MAKEFLAGS= +-SHELL=${CONFIG_SHELL-/bin/sh} +-# Maximum number of lines to put in a shell here document. +-ac_max_here_lines=12 ++docdir='${datarootdir}/doc/${PACKAGE}' ++infodir='${datarootdir}/info' ++htmldir='${docdir}' ++dvidir='${docdir}' ++pdfdir='${docdir}' ++psdir='${docdir}' ++libdir='${exec_prefix}/lib' ++localedir='${datarootdir}/locale' ++mandir='${datarootdir}/man' + + ac_prev= ++ac_dashdash= + for ac_option + do +- + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then +- eval "$ac_prev=\$ac_option" ++ eval $ac_prev=\$ac_option + ac_prev= + continue + fi + +- case "$ac_option" in +- -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; +- *) ac_optarg= ;; ++ case $ac_option in ++ *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; ++ *=) ac_optarg= ;; ++ *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + +- case "$ac_option" in ++ case $ac_dashdash$ac_option in ++ --) ++ ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) +- bindir="$ac_optarg" ;; ++ bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) +- ac_prev=build ;; ++ ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) +- build="$ac_optarg" ;; ++ build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) +- cache_file="$ac_optarg" ;; ++ cache_file=$ac_optarg ;; ++ ++ --config-cache | -C) ++ cache_file=config.cache ;; + +- -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ++ -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; +- -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ +- | --da=*) +- datadir="$ac_optarg" ;; ++ -datadir=* | --datadir=* | --datadi=* | --datad=*) ++ datadir=$ac_optarg ;; ++ ++ -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ ++ | --dataroo | --dataro | --datar) ++ ac_prev=datarootdir ;; ++ -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ ++ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) ++ datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) +- ac_feature=`echo $ac_option|sed -e 's/-*disable-//'` ++ ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. +- if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then +- { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } +- fi +- ac_feature=`echo $ac_feature| sed 's/-/_/g'` +- eval "enable_${ac_feature}=no" ;; ++ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && ++ as_fn_error $? "invalid feature name: $ac_useropt" ++ ac_useropt_orig=$ac_useropt ++ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` ++ case $ac_user_opts in ++ *" ++"enable_$ac_useropt" ++"*) ;; ++ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" ++ ac_unrecognized_sep=', ';; ++ esac ++ eval enable_$ac_useropt=no ;; ++ ++ -docdir | --docdir | --docdi | --doc | --do) ++ ac_prev=docdir ;; ++ -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) ++ docdir=$ac_optarg ;; ++ ++ -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ++ ac_prev=dvidir ;; ++ -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) ++ dvidir=$ac_optarg ;; + + -enable-* | --enable-*) +- ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'` ++ ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. +- if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then +- { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } +- fi +- ac_feature=`echo $ac_feature| sed 's/-/_/g'` +- case "$ac_option" in +- *=*) ;; +- *) ac_optarg=yes ;; ++ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && ++ as_fn_error $? "invalid feature name: $ac_useropt" ++ ac_useropt_orig=$ac_useropt ++ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` ++ case $ac_user_opts in ++ *" ++"enable_$ac_useropt" ++"*) ;; ++ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" ++ ac_unrecognized_sep=', ';; + esac +- eval "enable_${ac_feature}='$ac_optarg'" ;; ++ eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ +@@ -194,116 +910,77 @@ do + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) +- exec_prefix="$ac_optarg" ;; ++ exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + +- -help | --help | --hel | --he) +- # Omit some internal or obsolete options to make the list less imposing. +- # This message is too long to be a string in the A/UX 3.1 sh. +- cat << EOF +-Usage: configure [options] [host] +-Options: [defaults in brackets after descriptions] +-Configuration: +- --cache-file=FILE cache test results in FILE +- --help print this message +- --no-create do not create output files +- --quiet, --silent do not print \`checking...' messages +- --version print the version of autoconf that created configure +-Directory and file names: +- --prefix=PREFIX install architecture-independent files in PREFIX +- [$ac_default_prefix] +- --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX +- [same as prefix] +- --bindir=DIR user executables in DIR [EPREFIX/bin] +- --sbindir=DIR system admin executables in DIR [EPREFIX/sbin] +- --libexecdir=DIR program executables in DIR [EPREFIX/libexec] +- --datadir=DIR read-only architecture-independent data in DIR +- [PREFIX/share] +- --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc] +- --sharedstatedir=DIR modifiable architecture-independent data in DIR +- [PREFIX/com] +- --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var] +- --libdir=DIR object code libraries in DIR [EPREFIX/lib] +- --includedir=DIR C header files in DIR [PREFIX/include] +- --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include] +- --infodir=DIR info documentation in DIR [PREFIX/info] +- --mandir=DIR man documentation in DIR [PREFIX/man] +- --srcdir=DIR find the sources in DIR [configure dir or ..] +- --program-prefix=PREFIX prepend PREFIX to installed program names +- --program-suffix=SUFFIX append SUFFIX to installed program names +- --program-transform-name=PROGRAM +- run sed PROGRAM on installed program names +-EOF +- cat << EOF +-Host type: +- --build=BUILD configure for building on BUILD [BUILD=HOST] +- --host=HOST configure for HOST [guessed] +- --target=TARGET configure for TARGET [TARGET=HOST] +-Features and packages: +- --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) +- --enable-FEATURE[=ARG] include FEATURE [ARG=yes] +- --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] +- --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) +- --x-includes=DIR X include files are in DIR +- --x-libraries=DIR X library files are in DIR +-EOF +- if test -n "$ac_help"; then +- echo "--enable and --with options recognized:$ac_help" +- fi +- exit 0 ;; ++ -help | --help | --hel | --he | -h) ++ ac_init_help=long ;; ++ -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ++ ac_init_help=recursive ;; ++ -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ++ ac_init_help=short ;; + + -host | --host | --hos | --ho) +- ac_prev=host ;; ++ ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) +- host="$ac_optarg" ;; ++ host_alias=$ac_optarg ;; ++ ++ -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ++ ac_prev=htmldir ;; ++ -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ ++ | --ht=*) ++ htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) +- includedir="$ac_optarg" ;; ++ includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) +- infodir="$ac_optarg" ;; ++ infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) +- libdir="$ac_optarg" ;; ++ libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) +- libexecdir="$ac_optarg" ;; ++ libexecdir=$ac_optarg ;; ++ ++ -localedir | --localedir | --localedi | --localed | --locale) ++ ac_prev=localedir ;; ++ -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) ++ localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ +- | --localstate | --localstat | --localsta | --localst \ +- | --locals | --local | --loca | --loc | --lo) ++ | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ +- | --localstate=* | --localstat=* | --localsta=* | --localst=* \ +- | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) +- localstatedir="$ac_optarg" ;; ++ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) ++ localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) +- mandir="$ac_optarg" ;; ++ mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ +- | --no-cr | --no-c) ++ | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ +@@ -317,26 +994,26 @@ EOF + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) +- oldincludedir="$ac_optarg" ;; ++ oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) +- prefix="$ac_optarg" ;; ++ prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) +- program_prefix="$ac_optarg" ;; ++ program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) +- program_suffix="$ac_optarg" ;; ++ program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ +@@ -353,7 +1030,17 @@ EOF + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) +- program_transform_name="$ac_optarg" ;; ++ program_transform_name=$ac_optarg ;; ++ ++ -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ++ ac_prev=pdfdir ;; ++ -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) ++ pdfdir=$ac_optarg ;; ++ ++ -psdir | --psdir | --psdi | --psd | --ps) ++ ac_prev=psdir ;; ++ -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) ++ psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) +@@ -363,7 +1050,7 @@ EOF + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) +- sbindir="$ac_optarg" ;; ++ sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ +@@ -374,58 +1061,67 @@ EOF + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) +- sharedstatedir="$ac_optarg" ;; ++ sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) +- site="$ac_optarg" ;; ++ site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) +- srcdir="$ac_optarg" ;; ++ srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) +- sysconfdir="$ac_optarg" ;; ++ sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) +- ac_prev=target ;; ++ ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) +- target="$ac_optarg" ;; ++ target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + +- -version | --version | --versio | --versi | --vers) +- echo "configure generated by autoconf version 2.13" +- exit 0 ;; ++ -version | --version | --versio | --versi | --vers | -V) ++ ac_init_version=: ;; + + -with-* | --with-*) +- ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` ++ ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. +- if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then +- { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } +- fi +- ac_package=`echo $ac_package| sed 's/-/_/g'` +- case "$ac_option" in +- *=*) ;; +- *) ac_optarg=yes ;; ++ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && ++ as_fn_error $? "invalid package name: $ac_useropt" ++ ac_useropt_orig=$ac_useropt ++ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` ++ case $ac_user_opts in ++ *" ++"with_$ac_useropt" ++"*) ;; ++ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" ++ ac_unrecognized_sep=', ';; + esac +- eval "with_${ac_package}='$ac_optarg'" ;; ++ eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) +- ac_package=`echo $ac_option|sed -e 's/-*without-//'` ++ ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. +- if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then +- { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } +- fi +- ac_package=`echo $ac_package| sed 's/-/_/g'` +- eval "with_${ac_package}=no" ;; ++ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && ++ as_fn_error $? "invalid package name: $ac_useropt" ++ ac_useropt_orig=$ac_useropt ++ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` ++ case $ac_user_opts in ++ *" ++"with_$ac_useropt" ++"*) ;; ++ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" ++ ac_unrecognized_sep=', ';; ++ esac ++ eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. +@@ -436,391 +1132,1560 @@ EOF + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) +- x_includes="$ac_optarg" ;; ++ x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) +- x_libraries="$ac_optarg" ;; ++ x_libraries=$ac_optarg ;; + +- -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; } ++ -*) as_fn_error $? "unrecognized option: \`$ac_option' ++Try \`$0 --help' for more information" + ;; + ++ *=*) ++ ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` ++ # Reject names that are not valid shell variable names. ++ case $ac_envvar in #( ++ '' | [0-9]* | *[!_$as_cr_alnum]* ) ++ as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; ++ esac ++ eval $ac_envvar=\$ac_optarg ++ export $ac_envvar ;; ++ + *) +- if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then +- echo "configure: warning: $ac_option: invalid host type" 1>&2 +- fi +- if test "x$nonopt" != xNONE; then +- { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } +- fi +- nonopt="$ac_option" ++ # FIXME: should be removed in autoconf 3.0. ++ $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 ++ expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && ++ $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 ++ : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + ;; + + esac + done + + if test -n "$ac_prev"; then +- { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; } ++ ac_option=--`echo $ac_prev | sed 's/_/-/g'` ++ as_fn_error $? "missing argument to $ac_option" + fi + +-trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 +- +-# File descriptor usage: +-# 0 standard input +-# 1 file creation +-# 2 errors and warnings +-# 3 some systems may open it to /dev/tty +-# 4 used on the Kubota Titan +-# 6 checking for... messages and results +-# 5 compiler messages saved in config.log +-if test "$silent" = yes; then +- exec 6>/dev/null +-else +- exec 6>&1 ++if test -n "$ac_unrecognized_opts"; then ++ case $enable_option_checking in ++ no) ;; ++ fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; ++ *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; ++ esac + fi +-exec 5>./config.log +- +-echo "\ +-This file contains any messages produced by compilers while +-running configure, to aid debugging if configure makes a mistake. +-" 1>&5 + +-# Strip out --no-create and --no-recursion so they do not pile up. +-# Also quote any args containing shell metacharacters. +-ac_configure_args= +-for ac_arg ++# Check all directory arguments for consistency. ++for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ ++ datadir sysconfdir sharedstatedir localstatedir includedir \ ++ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ ++ libdir localedir mandir + do +- case "$ac_arg" in +- -no-create | --no-create | --no-creat | --no-crea | --no-cre \ +- | --no-cr | --no-c) ;; +- -no-recursion | --no-recursion | --no-recursio | --no-recursi \ +- | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; +- *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) +- ac_configure_args="$ac_configure_args '$ac_arg'" ;; +- *) ac_configure_args="$ac_configure_args $ac_arg" ;; ++ eval ac_val=\$$ac_var ++ # Remove trailing slashes. ++ case $ac_val in ++ */ ) ++ ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` ++ eval $ac_var=\$ac_val;; + esac ++ # Be sure to have absolute directory names. ++ case $ac_val in ++ [\\/$]* | ?:[\\/]* ) continue;; ++ NONE | '' ) case $ac_var in *prefix ) continue;; esac;; ++ esac ++ as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" + done + +-# NLS nuisances. +-# Only set these to C if already set. These must not be set unconditionally +-# because not all systems understand e.g. LANG=C (notably SCO). +-# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'! +-# Non-C LC_CTYPE values break the ctype check. +-if test "${LANG+set}" = set; then LANG=C; export LANG; fi +-if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi +-if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi +-if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi ++# There might be people who depend on the old broken behavior: `$host' ++# used to hold the argument of --host etc. ++# FIXME: To remove some day. ++build=$build_alias ++host=$host_alias ++target=$target_alias ++ ++# FIXME: To remove some day. ++if test "x$host_alias" != x; then ++ if test "x$build_alias" = x; then ++ cross_compiling=maybe ++ $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host. ++ If a cross compiler is detected then cross compile mode will be used" >&2 ++ elif test "x$build_alias" != "x$host_alias"; then ++ cross_compiling=yes ++ fi ++fi ++ ++ac_tool_prefix= ++test -n "$host_alias" && ac_tool_prefix=$host_alias- ++ ++test "$silent" = yes && exec 6>/dev/null ++ ++ ++ac_pwd=`pwd` && test -n "$ac_pwd" && ++ac_ls_di=`ls -di .` && ++ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || ++ as_fn_error $? "working directory cannot be determined" ++test "X$ac_ls_di" = "X$ac_pwd_ls_di" || ++ as_fn_error $? "pwd does not report name of working directory" + +-# confdefs.h avoids OS command line length limits that DEFS can exceed. +-rm -rf conftest* confdefs.h +-# AIX cpp loses on an empty file, so make sure it contains at least a newline. +-echo > confdefs.h +- +-# A filename unique to this package, relative to the directory that +-# configure is in, which we can look for to find out if srcdir is correct. +-ac_unique_file= + + # Find the source files, if location was not specified. + if test -z "$srcdir"; then + ac_srcdir_defaulted=yes +- # Try the directory containing this script, then its parent. +- ac_prog=$0 +- ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` +- test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. ++ # Try the directory containing this script, then the parent directory. ++ ac_confdir=`$as_dirname -- "$as_myself" || ++$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ ++ X"$as_myself" : 'X\(//\)[^/]' \| \ ++ X"$as_myself" : 'X\(//\)$' \| \ ++ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || ++$as_echo X"$as_myself" | ++ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ ++ s//\1/ ++ q ++ } ++ /^X\(\/\/\)[^/].*/{ ++ s//\1/ ++ q ++ } ++ /^X\(\/\/\)$/{ ++ s//\1/ ++ q ++ } ++ /^X\(\/\).*/{ ++ s//\1/ ++ q ++ } ++ s/.*/./; q'` + srcdir=$ac_confdir +- if test ! -r $srcdir/$ac_unique_file; then ++ if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi + else + ac_srcdir_defaulted=no + fi +-if test ! -r $srcdir/$ac_unique_file; then +- if test "$ac_srcdir_defaulted" = yes; then +- { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } +- else +- { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } +- fi +-fi +-srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` +- +-# Prefer explicitly selected file to automatically selected ones. +-if test -z "$CONFIG_SITE"; then +- if test "x$prefix" != xNONE; then +- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" +- else +- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" +- fi +-fi +-for ac_site_file in $CONFIG_SITE; do +- if test -r "$ac_site_file"; then +- echo "loading site script $ac_site_file" +- . "$ac_site_file" +- fi ++if test ! -r "$srcdir/$ac_unique_file"; then ++ test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." ++ as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" ++fi ++ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ++ac_abs_confdir=`( ++ cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" ++ pwd)` ++# When building in place, set srcdir=. ++if test "$ac_abs_confdir" = "$ac_pwd"; then ++ srcdir=. ++fi ++# Remove unnecessary trailing slashes from srcdir. ++# Double slashes in file names in object file debugging info ++# mess up M-x gdb in Emacs. ++case $srcdir in ++*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; ++esac ++for ac_var in $ac_precious_vars; do ++ eval ac_env_${ac_var}_set=\${${ac_var}+set} ++ eval ac_env_${ac_var}_value=\$${ac_var} ++ eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} ++ eval ac_cv_env_${ac_var}_value=\$${ac_var} + done + +-if test -r "$cache_file"; then +- echo "loading cache $cache_file" +- . $cache_file +-else +- echo "creating cache $cache_file" +- > $cache_file +-fi +- +-ac_ext=c +-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. +-ac_cpp='$CPP $CPPFLAGS' +-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' +-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +-cross_compiling=$ac_cv_prog_cc_cross +- +-ac_exeext= +-ac_objext=o +-if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then +- # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. +- if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then +- ac_n= ac_c=' +-' ac_t=' ' +- else +- ac_n=-n ac_c= ac_t= +- fi +-else +- ac_n= ac_c='\c' ac_t= +-fi +- +- +- +- +-VERSION=`cat majvers`.`cat minvers` +- +- +-# some parts of this configure script are taken from the tcl configure.in +- + # +-# Arguments ++# Report the --help message. + # ++if test "$ac_init_help" = "long"; then ++ # Omit some internal or obsolete options to make the list less imposing. ++ # This message is too long to be a string in the A/UX 3.1 sh. ++ cat <<_ACEOF ++\`configure' configures this package to adapt to many kinds of systems. + +-help="--enable-maxpage=XXXX will compile in a page table of size XXX (default ${default_maxpage})" +-# Check whether --enable-maxpage or --disable-maxpage was given. +-if test "${enable_maxpage+set}" = set; then +- enableval="$enable_maxpage" +- cat >> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h < if you have libraries in a ++ nonstandard directory ++ LIBS libraries to pass to the linker, e.g. -l ++ CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if ++ you have headers in a nonstandard directory ++ CPP C preprocessor ++ XMKMF Path to xmkmf, Makefile generator for X Window System ++ ++Use these variables to override the choices made by `configure' or to help ++it to find libraries and programs with nonstandard names/locations. ++ ++Report bugs to the package provider. ++_ACEOF ++ac_status=$? ++fi ++ ++if test "$ac_init_help" = "recursive"; then ++ # If there are subdirs, report their specific --help. ++ for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue ++ test -d "$ac_dir" || ++ { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || ++ continue ++ ac_builddir=. ++ ++case "$ac_dir" in ++.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; ++*) ++ ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` ++ # A ".." for each directory in $ac_dir_suffix. ++ ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` ++ case $ac_top_builddir_sub in ++ "") ac_top_builddir_sub=. ac_top_build_prefix= ;; ++ *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; ++ esac ;; ++esac ++ac_abs_top_builddir=$ac_pwd ++ac_abs_builddir=$ac_pwd$ac_dir_suffix ++# for backward compatibility: ++ac_top_builddir=$ac_top_build_prefix ++ ++case $srcdir in ++ .) # We are building in place. ++ ac_srcdir=. ++ ac_top_srcdir=$ac_top_builddir_sub ++ ac_abs_top_srcdir=$ac_pwd ;; ++ [\\/]* | ?:[\\/]* ) # Absolute name. ++ ac_srcdir=$srcdir$ac_dir_suffix; ++ ac_top_srcdir=$srcdir ++ ac_abs_top_srcdir=$srcdir ;; ++ *) # Relative name. ++ ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ++ ac_top_srcdir=$ac_top_build_prefix$srcdir ++ ac_abs_top_srcdir=$ac_pwd/$srcdir ;; ++esac ++ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + ++ cd "$ac_dir" || { ac_status=$?; continue; } ++ # Check for guested configure. ++ if test -f "$ac_srcdir/configure.gnu"; then ++ echo && ++ $SHELL "$ac_srcdir/configure.gnu" --help=recursive ++ elif test -f "$ac_srcdir/configure"; then ++ echo && ++ $SHELL "$ac_srcdir/configure" --help=recursive ++ else ++ $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 ++ fi || ac_status=$? ++ cd "$ac_pwd" || { ac_status=$?; break; } ++ done + fi + +- +-# Check whether --enable-machine or --disable-machine was given. +-if test "${enable_machine+set}" = set; then +- enableval="$enable_machine" +- enable_machine=$enableval ++test -n "$ac_init_help" && exit $ac_status ++if $ac_init_version; then ++ cat <<\_ACEOF ++configure ++generated by GNU Autoconf 2.68 ++ ++Copyright (C) 2010 Free Software Foundation, Inc. ++This configure script is free software; the Free Software Foundation ++gives unlimited permission to copy, distribute and modify it. ++_ACEOF ++ exit ++fi ++ ++## ------------------------ ## ++## Autoconf initialization. ## ++## ------------------------ ## ++ ++# ac_fn_c_try_compile LINENO ++# -------------------------- ++# Try to compile conftest.$ac_ext, and return whether this succeeded. ++ac_fn_c_try_compile () ++{ ++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ rm -f conftest.$ac_objext ++ if { { ac_try="$ac_compile" ++case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_compile") 2>conftest.err ++ ac_status=$? ++ if test -s conftest.err; then ++ grep -v '^ *+' conftest.err >conftest.er1 ++ cat conftest.er1 >&5 ++ mv -f conftest.er1 conftest.err ++ fi ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; } && { ++ test -z "$ac_c_werror_flag" || ++ test ! -s conftest.err ++ } && test -s conftest.$ac_objext; then : ++ ac_retval=0 ++else ++ $as_echo "$as_me: failed program was:" >&5 ++sed 's/^/| /' conftest.$ac_ext >&5 ++ ++ ac_retval=1 ++fi ++ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno ++ as_fn_set_status $ac_retval ++ ++} # ac_fn_c_try_compile ++ ++# ac_fn_c_try_cpp LINENO ++# ---------------------- ++# Try to preprocess conftest.$ac_ext, and return whether this succeeded. ++ac_fn_c_try_cpp () ++{ ++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ if { { ac_try="$ac_cpp conftest.$ac_ext" ++case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err ++ ac_status=$? ++ if test -s conftest.err; then ++ grep -v '^ *+' conftest.err >conftest.er1 ++ cat conftest.er1 >&5 ++ mv -f conftest.er1 conftest.err ++ fi ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; } > conftest.i && { ++ test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || ++ test ! -s conftest.err ++ }; then : ++ ac_retval=0 ++else ++ $as_echo "$as_me: failed program was:" >&5 ++sed 's/^/| /' conftest.$ac_ext >&5 ++ ++ ac_retval=1 ++fi ++ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno ++ as_fn_set_status $ac_retval ++ ++} # ac_fn_c_try_cpp ++ ++# ac_fn_c_try_run LINENO ++# ---------------------- ++# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes ++# that executables *can* be run. ++ac_fn_c_try_run () ++{ ++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ if { { ac_try="$ac_link" ++case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_link") 2>&5 ++ ac_status=$? ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' ++ { { case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_try") 2>&5 ++ ac_status=$? ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; }; }; then : ++ ac_retval=0 ++else ++ $as_echo "$as_me: program exited with status $ac_status" >&5 ++ $as_echo "$as_me: failed program was:" >&5 ++sed 's/^/| /' conftest.$ac_ext >&5 ++ ++ ac_retval=$ac_status ++fi ++ rm -rf conftest.dSYM conftest_ipa8_conftest.oo ++ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno ++ as_fn_set_status $ac_retval ++ ++} # ac_fn_c_try_run ++ ++# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES ++# ------------------------------------------------------- ++# Tests whether HEADER exists, giving a warning if it cannot be compiled using ++# the include files in INCLUDES and setting the cache variable VAR ++# accordingly. ++ac_fn_c_check_header_mongrel () ++{ ++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ if eval \${$3+:} false; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 ++$as_echo_n "checking for $2... " >&6; } ++if eval \${$3+:} false; then : ++ $as_echo_n "(cached) " >&6 ++fi ++eval ac_res=\$$3 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 ++$as_echo "$ac_res" >&6; } ++else ++ # Is the header compilable? ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 ++$as_echo_n "checking $2 usability... " >&6; } ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++$4 ++#include <$2> ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ ac_header_compiler=yes ++else ++ ac_header_compiler=no ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 ++$as_echo "$ac_header_compiler" >&6; } ++ ++# Is the header present? ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 ++$as_echo_n "checking $2 presence... " >&6; } ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include <$2> ++_ACEOF ++if ac_fn_c_try_cpp "$LINENO"; then : ++ ac_header_preproc=yes ++else ++ ac_header_preproc=no ++fi ++rm -f conftest.err conftest.i conftest.$ac_ext ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 ++$as_echo "$ac_header_preproc" >&6; } ++ ++# So? What about this header? ++case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( ++ yes:no: ) ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 ++$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 ++$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} ++ ;; ++ no:yes:* ) ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 ++$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 ++$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 ++$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 ++$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 ++$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} ++ ;; ++esac ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 ++$as_echo_n "checking for $2... " >&6; } ++if eval \${$3+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ eval "$3=\$ac_header_compiler" ++fi ++eval ac_res=\$$3 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 ++$as_echo "$ac_res" >&6; } ++fi ++ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno ++ ++} # ac_fn_c_check_header_mongrel ++ ++# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES ++# ------------------------------------------------------- ++# Tests whether HEADER exists and can be compiled using the include files in ++# INCLUDES, setting the cache variable VAR accordingly. ++ac_fn_c_check_header_compile () ++{ ++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 ++$as_echo_n "checking for $2... " >&6; } ++if eval \${$3+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++$4 ++#include <$2> ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ eval "$3=yes" ++else ++ eval "$3=no" ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++fi ++eval ac_res=\$$3 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 ++$as_echo "$ac_res" >&6; } ++ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno ++ ++} # ac_fn_c_check_header_compile ++ ++# ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES ++# ---------------------------------------------------- ++# Tries to find if the field MEMBER exists in type AGGR, after including ++# INCLUDES, setting cache variable VAR accordingly. ++ac_fn_c_check_member () ++{ ++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5 ++$as_echo_n "checking for $2.$3... " >&6; } ++if eval \${$4+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++$5 ++int ++main () ++{ ++static $2 ac_aggr; ++if (ac_aggr.$3) ++return 0; ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ eval "$4=yes" ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++$5 ++int ++main () ++{ ++static $2 ac_aggr; ++if (sizeof ac_aggr.$3) ++return 0; ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ eval "$4=yes" + else +- enable_machine="" ++ eval "$4=no" + fi +- +- +-#AC_ARG_ENABLE(gmp,[ --enable-gmp=no will disable use of GMP gnu multiprecision arithmetic, (default is =yes)] , +-#[use_gmp=$enableval],[use_gmp="yes"]) +- +-use_gmp="yes" +- +-# Check whether --enable-notify or --disable-notify was given. +-if test "${enable_notify+set}" = set; then +- enableval="$enable_notify" +- enable_notify=$enableval +-else +- enable_notify="yes" ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi +- +- +-# Check whether --enable-tkconfig or --disable-tkconfig was given. +-if test "${enable_tkconfig+set}" = set; then +- enableval="$enable_tkconfig" +- TK_CONFIG_PREFIX=$enableval +-else +- TK_CONFIG_PREFIX="unknown" ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi ++eval ac_res=\$$4 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 ++$as_echo "$ac_res" >&6; } ++ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + ++} # ac_fn_c_check_member + ++# ac_fn_c_check_func LINENO FUNC VAR ++# ---------------------------------- ++# Tests whether FUNC exists, setting the cache variable VAR accordingly ++ac_fn_c_check_func () ++{ ++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 ++$as_echo_n "checking for $2... " >&6; } ++if eval \${$3+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++/* Define $2 to an innocuous variant, in case declares $2. ++ For example, HP-UX 11i declares gettimeofday. */ ++#define $2 innocuous_$2 + +-# Check whether --enable-tclconfig or --disable-tclconfig was given. +-if test "${enable_tclconfig+set}" = set; then +- enableval="$enable_tclconfig" +- TCL_CONFIG_PREFIX=$enableval +-else +- TCL_CONFIG_PREFIX="unknown" +-fi +- ++/* System header to define __stub macros and hopefully few prototypes, ++ which can conflict with char $2 (); below. ++ Prefer to if __STDC__ is defined, since ++ exists even on freestanding compilers. */ + +-# Check whether --enable-infodir or --disable-infodir was given. +-if test "${enable_infodir+set}" = set; then +- enableval="$enable_infodir" +- INFO_DIR=$enableval +-else +- INFO_DIR="unknown" +-fi ++#ifdef __STDC__ ++# include ++#else ++# include ++#endif + +-INFO_DIR=`eval echo $INFO_DIR/` ++#undef $2 + +-# Check whether --enable-emacsdir or --disable-emacsdir was given. +-if test "${enable_emacsdir+set}" = set; then +- enableval="$enable_emacsdir" +- EMACS_SITE_LISP=$enableval +-else +- EMACS_SITE_LISP="unknown" +-fi ++/* Override any GCC internal prototype to avoid an error. ++ Use char because int might match the return type of a GCC ++ builtin and then its argument prototype would still apply. */ ++#ifdef __cplusplus ++extern "C" ++#endif ++char $2 (); ++/* The GNU C library defines this for functions which it implements ++ to always fail with ENOSYS. Some functions are actually named ++ something starting with __ and the normal name is an alias. */ ++#if defined __stub_$2 || defined __stub___$2 ++choke me ++#endif ++ ++int ++main () ++{ ++return $2 (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ eval "$3=yes" ++else ++ eval "$3=no" ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++fi ++eval ac_res=\$$3 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 ++$as_echo "$ac_res" >&6; } ++ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno ++ ++} # ac_fn_c_check_func ++ ++# ac_fn_c_compute_int LINENO EXPR VAR INCLUDES ++# -------------------------------------------- ++# Tries to find the compile-time value of EXPR in a program that includes ++# INCLUDES, setting VAR accordingly. Returns whether the value could be ++# computed ++ac_fn_c_compute_int () ++{ ++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ if test "$cross_compiling" = yes; then ++ # Depending upon the size, compute the lo and hi bounds. ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++$4 ++int ++main () ++{ ++static int test_array [1 - 2 * !(($2) >= 0)]; ++test_array [0] = 0 ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ ac_lo=0 ac_mid=0 ++ while :; do ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++$4 ++int ++main () ++{ ++static int test_array [1 - 2 * !(($2) <= $ac_mid)]; ++test_array [0] = 0 ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ ac_hi=$ac_mid; break ++else ++ as_fn_arith $ac_mid + 1 && ac_lo=$as_val ++ if test $ac_lo -le $ac_mid; then ++ ac_lo= ac_hi= ++ break ++ fi ++ as_fn_arith 2 '*' $ac_mid + 1 && ac_mid=$as_val ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++ done ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++$4 ++int ++main () ++{ ++static int test_array [1 - 2 * !(($2) < 0)]; ++test_array [0] = 0 ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ ac_hi=-1 ac_mid=-1 ++ while :; do ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++$4 ++int ++main () ++{ ++static int test_array [1 - 2 * !(($2) >= $ac_mid)]; ++test_array [0] = 0 ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ ac_lo=$ac_mid; break ++else ++ as_fn_arith '(' $ac_mid ')' - 1 && ac_hi=$as_val ++ if test $ac_mid -le $ac_hi; then ++ ac_lo= ac_hi= ++ break ++ fi ++ as_fn_arith 2 '*' $ac_mid && ac_mid=$as_val ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++ done ++else ++ ac_lo= ac_hi= ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++# Binary search between lo and hi bounds. ++while test "x$ac_lo" != "x$ac_hi"; do ++ as_fn_arith '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo && ac_mid=$as_val ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++$4 ++int ++main () ++{ ++static int test_array [1 - 2 * !(($2) <= $ac_mid)]; ++test_array [0] = 0 ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ ac_hi=$ac_mid ++else ++ as_fn_arith '(' $ac_mid ')' + 1 && ac_lo=$as_val ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++done ++case $ac_lo in #(( ++?*) eval "$3=\$ac_lo"; ac_retval=0 ;; ++'') ac_retval=1 ;; ++esac ++ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++$4 ++static long int longval () { return $2; } ++static unsigned long int ulongval () { return $2; } ++#include ++#include ++int ++main () ++{ ++ ++ FILE *f = fopen ("conftest.val", "w"); ++ if (! f) ++ return 1; ++ if (($2) < 0) ++ { ++ long int i = longval (); ++ if (i != ($2)) ++ return 1; ++ fprintf (f, "%ld", i); ++ } ++ else ++ { ++ unsigned long int i = ulongval (); ++ if (i != ($2)) ++ return 1; ++ fprintf (f, "%lu", i); ++ } ++ /* Do not output a trailing newline, as this causes \r\n confusion ++ on some platforms. */ ++ return ferror (f) || fclose (f) != 0; ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ echo >>conftest.val; read $3 config.log <<_ACEOF ++This file contains any messages produced by compilers while ++running configure, to aid debugging if configure makes a mistake. ++ ++It was created by $as_me, which was ++generated by GNU Autoconf 2.68. Invocation command line was ++ ++ $ $0 $@ ++ ++_ACEOF ++exec 5>>config.log ++{ ++cat <<_ASUNAME ++## --------- ## ++## Platform. ## ++## --------- ## ++ ++hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` ++uname -m = `(uname -m) 2>/dev/null || echo unknown` ++uname -r = `(uname -r) 2>/dev/null || echo unknown` ++uname -s = `(uname -s) 2>/dev/null || echo unknown` ++uname -v = `(uname -v) 2>/dev/null || echo unknown` ++ ++/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` ++/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` ++ ++/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` ++/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` ++/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` ++/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` ++/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` ++/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` ++/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` ++ ++_ASUNAME ++ ++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ $as_echo "PATH: $as_dir" ++ done ++IFS=$as_save_IFS ++ ++} >&5 ++ ++cat >&5 <<_ACEOF ++ ++ ++## ----------- ## ++## Core tests. ## ++## ----------- ## ++ ++_ACEOF ++ ++ ++# Keep a trace of the command line. ++# Strip out --no-create and --no-recursion so they do not pile up. ++# Strip out --silent because we don't want to record it for future runs. ++# Also quote any args containing shell meta-characters. ++# Make two passes to allow for proper duplicate-argument suppression. ++ac_configure_args= ++ac_configure_args0= ++ac_configure_args1= ++ac_must_keep_next=false ++for ac_pass in 1 2 ++do ++ for ac_arg ++ do ++ case $ac_arg in ++ -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; ++ -q | -quiet | --quiet | --quie | --qui | --qu | --q \ ++ | -silent | --silent | --silen | --sile | --sil) ++ continue ;; ++ *\'*) ++ ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; ++ esac ++ case $ac_pass in ++ 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; ++ 2) ++ as_fn_append ac_configure_args1 " '$ac_arg'" ++ if test $ac_must_keep_next = true; then ++ ac_must_keep_next=false # Got value, back to normal. ++ else ++ case $ac_arg in ++ *=* | --config-cache | -C | -disable-* | --disable-* \ ++ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ ++ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ ++ | -with-* | --with-* | -without-* | --without-* | --x) ++ case "$ac_configure_args0 " in ++ "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; ++ esac ++ ;; ++ -* ) ac_must_keep_next=true ;; ++ esac ++ fi ++ as_fn_append ac_configure_args " '$ac_arg'" ++ ;; ++ esac ++ done ++done ++{ ac_configure_args0=; unset ac_configure_args0;} ++{ ac_configure_args1=; unset ac_configure_args1;} ++ ++# When interrupted or exit'd, cleanup temporary files, and complete ++# config.log. We remove comments because anyway the quotes in there ++# would cause problems or look ugly. ++# WARNING: Use '\'' to represent an apostrophe within the trap. ++# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. ++trap 'exit_status=$? ++ # Save into config.log some information that might help in debugging. ++ { ++ echo ++ ++ $as_echo "## ---------------- ## ++## Cache variables. ## ++## ---------------- ##" ++ echo ++ # The following way of writing the cache mishandles newlines in values, ++( ++ for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do ++ eval ac_val=\$$ac_var ++ case $ac_val in #( ++ *${as_nl}*) ++ case $ac_var in #( ++ *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 ++$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; ++ esac ++ case $ac_var in #( ++ _ | IFS | as_nl) ;; #( ++ BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( ++ *) { eval $ac_var=; unset $ac_var;} ;; ++ esac ;; ++ esac ++ done ++ (set) 2>&1 | ++ case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( ++ *${as_nl}ac_space=\ *) ++ sed -n \ ++ "s/'\''/'\''\\\\'\'''\''/g; ++ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ++ ;; #( ++ *) ++ sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ++ ;; ++ esac | ++ sort ++) ++ echo ++ ++ $as_echo "## ----------------- ## ++## Output variables. ## ++## ----------------- ##" ++ echo ++ for ac_var in $ac_subst_vars ++ do ++ eval ac_val=\$$ac_var ++ case $ac_val in ++ *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; ++ esac ++ $as_echo "$ac_var='\''$ac_val'\''" ++ done | sort ++ echo ++ ++ if test -n "$ac_subst_files"; then ++ $as_echo "## ------------------- ## ++## File substitutions. ## ++## ------------------- ##" ++ echo ++ for ac_var in $ac_subst_files ++ do ++ eval ac_val=\$$ac_var ++ case $ac_val in ++ *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; ++ esac ++ $as_echo "$ac_var='\''$ac_val'\''" ++ done | sort ++ echo ++ fi ++ ++ if test -s confdefs.h; then ++ $as_echo "## ----------- ## ++## confdefs.h. ## ++## ----------- ##" ++ echo ++ cat confdefs.h ++ echo ++ fi ++ test "$ac_signal" != 0 && ++ $as_echo "$as_me: caught signal $ac_signal" ++ $as_echo "$as_me: exit $exit_status" ++ } >&5 ++ rm -f core *.core core.conftest.* && ++ rm -f -r conftest* confdefs* conf$$* $ac_clean_files && ++ exit $exit_status ++' 0 ++for ac_signal in 1 2 13 15; do ++ trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal ++done ++ac_signal=0 ++ ++# confdefs.h avoids OS command line length limits that DEFS can exceed. ++rm -f -r conftest* confdefs.h ++ ++$as_echo "/* confdefs.h */" > confdefs.h ++ ++# Predefined preprocessor variables. ++ ++cat >>confdefs.h <<_ACEOF ++#define PACKAGE_NAME "$PACKAGE_NAME" ++_ACEOF ++ ++cat >>confdefs.h <<_ACEOF ++#define PACKAGE_TARNAME "$PACKAGE_TARNAME" ++_ACEOF ++ ++cat >>confdefs.h <<_ACEOF ++#define PACKAGE_VERSION "$PACKAGE_VERSION" ++_ACEOF ++ ++cat >>confdefs.h <<_ACEOF ++#define PACKAGE_STRING "$PACKAGE_STRING" ++_ACEOF ++ ++cat >>confdefs.h <<_ACEOF ++#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" ++_ACEOF ++ ++cat >>confdefs.h <<_ACEOF ++#define PACKAGE_URL "$PACKAGE_URL" ++_ACEOF ++ ++ ++# Let the site file select an alternate cache file if it wants to. ++# Prefer an explicitly selected file to automatically selected ones. ++ac_site_file1=NONE ++ac_site_file2=NONE ++if test -n "$CONFIG_SITE"; then ++ # We do not want a PATH search for config.site. ++ case $CONFIG_SITE in #(( ++ -*) ac_site_file1=./$CONFIG_SITE;; ++ */*) ac_site_file1=$CONFIG_SITE;; ++ *) ac_site_file1=./$CONFIG_SITE;; ++ esac ++elif test "x$prefix" != xNONE; then ++ ac_site_file1=$prefix/share/config.site ++ ac_site_file2=$prefix/etc/config.site ++else ++ ac_site_file1=$ac_default_prefix/share/config.site ++ ac_site_file2=$ac_default_prefix/etc/config.site ++fi ++for ac_site_file in "$ac_site_file1" "$ac_site_file2" ++do ++ test "x$ac_site_file" = xNONE && continue ++ if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 ++$as_echo "$as_me: loading site script $ac_site_file" >&6;} ++ sed 's/^/| /' "$ac_site_file" >&5 ++ . "$ac_site_file" \ ++ || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "failed to load site script $ac_site_file ++See \`config.log' for more details" "$LINENO" 5; } ++ fi ++done ++ ++if test -r "$cache_file"; then ++ # Some versions of bash will fail to source /dev/null (special files ++ # actually), so we avoid doing that. DJGPP emulates it as a regular file. ++ if test /dev/null != "$cache_file" && test -f "$cache_file"; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 ++$as_echo "$as_me: loading cache $cache_file" >&6;} ++ case $cache_file in ++ [\\/]* | ?:[\\/]* ) . "$cache_file";; ++ *) . "./$cache_file";; ++ esac ++ fi ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 ++$as_echo "$as_me: creating cache $cache_file" >&6;} ++ >$cache_file ++fi ++ ++# Check that the precious variables saved in the cache have kept the same ++# value. ++ac_cache_corrupted=false ++for ac_var in $ac_precious_vars; do ++ eval ac_old_set=\$ac_cv_env_${ac_var}_set ++ eval ac_new_set=\$ac_env_${ac_var}_set ++ eval ac_old_val=\$ac_cv_env_${ac_var}_value ++ eval ac_new_val=\$ac_env_${ac_var}_value ++ case $ac_old_set,$ac_new_set in ++ set,) ++ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 ++$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ++ ac_cache_corrupted=: ;; ++ ,set) ++ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 ++$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ++ ac_cache_corrupted=: ;; ++ ,);; ++ *) ++ if test "x$ac_old_val" != "x$ac_new_val"; then ++ # differences in whitespace do not lead to failure. ++ ac_old_val_w=`echo x $ac_old_val` ++ ac_new_val_w=`echo x $ac_new_val` ++ if test "$ac_old_val_w" != "$ac_new_val_w"; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 ++$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} ++ ac_cache_corrupted=: ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 ++$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} ++ eval $ac_var=\$ac_old_val ++ fi ++ { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 ++$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} ++ { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 ++$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} ++ fi;; ++ esac ++ # Pass precious variables to config.status. ++ if test "$ac_new_set" = set; then ++ case $ac_new_val in ++ *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; ++ *) ac_arg=$ac_var=$ac_new_val ;; ++ esac ++ case " $ac_configure_args " in ++ *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. ++ *) as_fn_append ac_configure_args " '$ac_arg'" ;; ++ esac ++ fi ++done ++if $ac_cache_corrupted; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++ { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 ++$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} ++ as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 ++fi ++## -------------------- ## ++## Main body of script. ## ++## -------------------- ## ++ ++ac_ext=c ++ac_cpp='$CPP $CPPFLAGS' ++ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ++ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ++ac_compiler_gnu=$ac_cv_c_compiler_gnu + +-EMACS_SITE_LISP=`eval echo $EMACS_SITE_LISP` + +-# Check whether --enable-common-binary or --disable-common-binary was given. +-if test "${enable_common_binary+set}" = set; then +- enableval="$enable_common_binary" +- use_common_binary=$enableval ++ ++ac_config_headers="$ac_config_headers h/gclincl.h" ++ ++ ++VERSION=`cat majvers`.`cat minvers` ++ ++ ++# some parts of this configure script are taken from the tcl configure.in ++ ++# ++# Arguments ++# ++ ++help="--enable-maxpage=XXXX will compile in a page table of size XXX (default ${default_maxpage})" ++# Check whether --enable-maxpage was given. ++if test "${enable_maxpage+set}" = set; then : ++ enableval=$enable_maxpage; cat >>confdefs.h <<_ACEOF ++#define MAXPAGE $enable_maxpage ++_ACEOF ++ ++fi ++ ++ ++# Check whether --enable-holepage was given. ++if test "${enable_holepage+set}" = set; then : ++ enableval=$enable_holepage; cat >>confdefs.h <<_ACEOF ++#define HOLEPAGE $enable_holepage ++_ACEOF ++ ++fi ++ ++ ++# Check whether --enable-vssize was given. ++if test "${enable_vssize+set}" = set; then : ++ enableval=$enable_vssize; cat >>confdefs.h <<_ACEOF ++#define VSSIZE $enable_vssize ++_ACEOF ++ ++fi ++ ++ ++# Check whether --enable-bdssize was given. ++if test "${enable_bdssize+set}" = set; then : ++ enableval=$enable_bdssize; cat >>confdefs.h <<_ACEOF ++#define BDSSIZE $enable_bdssize ++_ACEOF ++ ++fi ++ ++ ++# Check whether --enable-ihssize was given. ++if test "${enable_ihssize+set}" = set; then : ++ enableval=$enable_ihssize; cat >>confdefs.h <<_ACEOF ++#define IHSSIZE $enable_ihssize ++_ACEOF ++ ++fi ++ ++ ++# Check whether --enable-frssize was given. ++if test "${enable_frssize+set}" = set; then : ++ enableval=$enable_frssize; cat >>confdefs.h <<_ACEOF ++#define FRSSIZE $enable_frssize ++_ACEOF ++ ++fi ++ ++ ++# Check whether --enable-machine was given. ++if test "${enable_machine+set}" = set; then : ++ enableval=$enable_machine; enable_machine=$enableval ++else ++ enable_machine="" ++fi ++ ++ ++#AC_ARG_ENABLE(gmp,[ --enable-gmp=no will disable use of GMP gnu multiprecision arithmetic, (default is =yes)] , ++#[use_gmp=$enableval],[use_gmp="yes"]) ++ ++use_gmp="yes" ++ ++# Check whether --enable-notify was given. ++if test "${enable_notify+set}" = set; then : ++ enableval=$enable_notify; enable_notify=$enableval ++else ++ enable_notify="yes" ++fi ++ ++ ++# Check whether --enable-tcltk was given. ++if test "${enable_tcltk+set}" = set; then : ++ enableval=$enable_tcltk; enable_tcltk=$enableval ++else ++ enable_tcltk="yes" ++fi ++ ++ ++# Check whether --enable-tkconfig was given. ++if test "${enable_tkconfig+set}" = set; then : ++ enableval=$enable_tkconfig; TK_CONFIG_PREFIX=$enableval ++else ++ TK_CONFIG_PREFIX="unknown" ++fi ++ ++ ++ ++# Check whether --enable-tclconfig was given. ++if test "${enable_tclconfig+set}" = set; then : ++ enableval=$enable_tclconfig; TCL_CONFIG_PREFIX=$enableval ++else ++ TCL_CONFIG_PREFIX="unknown" ++fi ++ ++ ++# Check whether --enable-infodir was given. ++if test "${enable_infodir+set}" = set; then : ++ enableval=$enable_infodir; INFO_DIR=$enableval ++else ++ INFO_DIR=$prefix/share/info ++fi ++ ++INFO_DIR=`eval echo $INFO_DIR/` ++ ++# Check whether --enable-emacsdir was given. ++if test "${enable_emacsdir+set}" = set; then : ++ enableval=$enable_emacsdir; EMACS_SITE_LISP=$enableval ++else ++ EMACS_SITE_LISP=$prefix/share/emacs/site-lisp ++fi ++ ++EMACS_SITE_LISP=`eval echo $EMACS_SITE_LISP/` ++ ++# Check whether --enable-common-binary was given. ++if test "${enable_common_binary+set}" = set; then : ++ enableval=$enable_common_binary; use_common_binary=$enableval + else + use_common_binary="yes" + fi + + +-# Check whether --enable-japi or --disable-japi was given. +-if test "${enable_japi+set}" = set; then +- enableval="$enable_japi" +- try_japi=$enableval ++# Check whether --enable-japi was given. ++if test "${enable_japi+set}" = set; then : ++ enableval=$enable_japi; try_japi=$enableval + else + try_japi="no" + fi + + +-# Check whether --enable-xdr or --disable-xdr was given. +-if test "${enable_xdr+set}" = set; then +- enableval="$enable_xdr" +- try_xdr=$enableval ++# Check whether --enable-xdr was given. ++if test "${enable_xdr+set}" = set; then : ++ enableval=$enable_xdr; try_xdr=$enableval + else + try_xdr="no" + fi + + ++# Check whether --enable-xgcl was given. ++if test "${enable_xgcl+set}" = set; then : ++ enableval=$enable_xgcl; enable_xgcl=$enableval ++else ++ enable_xgcl="yes" ++fi ++ ++ + # +-# Host information ++# Host information + # + + + ac_aux_dir= +-for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do +- if test -f $ac_dir/install-sh; then ++for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do ++ if test -f "$ac_dir/install-sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break +- elif test -f $ac_dir/install.sh; then ++ elif test -f "$ac_dir/install.sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break ++ elif test -f "$ac_dir/shtool"; then ++ ac_aux_dir=$ac_dir ++ ac_install_sh="$ac_aux_dir/shtool install -c" ++ break + fi + done + if test -z "$ac_aux_dir"; then +- { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; } ++ as_fn_error $? "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5 + fi +-ac_config_guess=$ac_aux_dir/config.guess +-ac_config_sub=$ac_aux_dir/config.sub +-ac_configure=$ac_aux_dir/configure # This should be Cygnus configure. ++ ++# These three variables are undocumented and unsupported, ++# and are intended to be withdrawn in a future Autoconf release. ++# They can cause serious problems if a builder's source tree is in a directory ++# whose full name contains unusual characters. ++ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. ++ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. ++ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. + + + # Make sure we can run config.sub. +-if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then : +-else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; } +-fi ++$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || ++ as_fn_error $? "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5 + +-echo $ac_n "checking host system type""... $ac_c" 1>&6 +-echo "configure:786: checking host system type" >&5 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5 ++$as_echo_n "checking build system type... " >&6; } ++if ${ac_cv_build+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ ac_build_alias=$build_alias ++test "x$ac_build_alias" = x && ++ ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` ++test "x$ac_build_alias" = x && ++ as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5 ++ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || ++ as_fn_error $? "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5 ++ ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5 ++$as_echo "$ac_cv_build" >&6; } ++case $ac_cv_build in ++*-*-*) ;; ++*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;; ++esac ++build=$ac_cv_build ++ac_save_IFS=$IFS; IFS='-' ++set x $ac_cv_build ++shift ++build_cpu=$1 ++build_vendor=$2 ++shift; shift ++# Remember, the first character of IFS is used to create $*, ++# except with old shells: ++build_os=$* ++IFS=$ac_save_IFS ++case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac ++ ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5 ++$as_echo_n "checking host system type... " >&6; } ++if ${ac_cv_host+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ if test "x$host_alias" = x; then ++ ac_cv_host=$ac_cv_build ++else ++ ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` || ++ as_fn_error $? "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5 ++fi + +-host_alias=$host +-case "$host_alias" in +-NONE) +- case $nonopt in +- NONE) +- if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then : +- else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; } +- fi ;; +- *) host_alias=$nonopt ;; +- esac ;; ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5 ++$as_echo "$ac_cv_host" >&6; } ++case $ac_cv_host in ++*-*-*) ;; ++*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;; + esac ++host=$ac_cv_host ++ac_save_IFS=$IFS; IFS='-' ++set x $ac_cv_host ++shift ++host_cpu=$1 ++host_vendor=$2 ++shift; shift ++# Remember, the first character of IFS is used to create $*, ++# except with old shells: ++host_os=$* ++IFS=$ac_save_IFS ++case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac + +-host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias` +-host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` +-host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` +-host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` +-echo "$ac_t""$host" 1>&6 + + canonical=$host + my_host_kernel=`echo $host_os | awk '{j=split($1,A,"-");print A[1]}'` + my_host_system=`echo $host_os | awk '{j=split($1,A,"-");if (j>=2) print A[2]}'` +-cat >> confdefs.h <>confdefs.h <<_ACEOF + #define HOST_CPU "`echo $host_cpu | awk '{print toupper($0)}'`" +-EOF ++_ACEOF + +-cat >> confdefs.h <>confdefs.h <<_ACEOF + #define HOST_KERNEL "`echo $my_host_kernel | awk '{print toupper($0)}'`" +-EOF ++_ACEOF + +-if test "$my_host_system" != "" ; then +- cat >> confdefs.h <>confdefs.h <<_ACEOF + #define HOST_SYSTEM "`echo $my_host_system | awk '{print toupper($0)}'`" +-EOF ++_ACEOF + + fi + ## host=CPU-COMPANY-SYSTEM +-echo "$ac_t""host=$host" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: host=$host" >&5 ++$as_echo "host=$host" >&6; } + + PROCESSOR_FLAGS=${PROCESSOR_FLAGS:-""} + +@@ -830,12 +2695,24 @@ case $canonical in + older) + use=386-bsd;; + ++ sh4*linux*) ++ use=sh4-linux;; ++ + *x86_64*linux*) + use=amd64-linux;; + ++ *x86_64*kfreebsd*) ++ use=amd64-linux;; ++ + *86*linux*) + use=386-linux;; + ++ *86*kfreebsd*) ++ use=386-kfreebsd;; ++ ++ *86*gnu*) ++ use=386-gnu;; ++ + # m6800 not working with gcc-3.2 + m68k*linux*) + if test "$use_common_binary" = "yes"; then +@@ -873,7 +2750,17 @@ case $canonical in + + powerpc-*-darwin*) + use=powerpc-macosx;; +- ++ ++ *86*darwin*) ++ use=386-macosx ++ if test "$build_cpu" = "x86_64" ; then ++ CFLAGS="-m64 $CFLAGS"; ++ LDFLAGS="-m64 -Wl,-headerpad,72 $LDFLAGS"; ++ else ++ CFLAGS="-m32 $CFLAGS"; ++ LDFLAGS="-m32 -Wl,-headerpad,56 $LDFLAGS"; ++ fi;; ++ + alpha-dec-osf) + use=alpha-osf1;; + +@@ -904,7 +2791,7 @@ case $canonical in + IRIX3*) + use=sgi4d;; + esac ;; +- ++ + + m68k-apple-aux*) + use=mac2;; +@@ -990,7 +2877,7 @@ case $canonical in + # 'ld -Z' means disable W^X + TLDFLAGS="$TLDFLAGS -Z" + use=FreeBSD;; +- ++ + esac + + +@@ -1001,122 +2888,102 @@ if test "x$enable_machine" != "x" ; then + fi + + def_dlopen="no" +-def_statsysbfd="yes" +-def_custreloc="no" ++def_statsysbfd="no" ++def_custreloc="yes" ++#def_statsysbfd="yes" ++#def_custreloc="no" + def_locbfd="no" + def_oldgmp="no" + def_pic="no"; + def_static="no"; + def_debug="no"; +-case $use in ++case $use in ++ *gnu) ++ ln -snf linux.defs h/$use.defs;; + *linux) + ln -snf linux.defs h/$use.defs; + case $use in +- alpha*) +- def_dlopen="yes" ; def_statsysbfd="no" ;; +- mips*) +- def_dlopen="yes" ; def_statsysbfd="no" ;; + # def_static -- Function descriptors are currently realized at runtime in a non-reproducible fashion +-# on these architectures -- CM ++# on these architectures -- CM + ia64*) +- def_dlopen="yes" ; def_statsysbfd="no" ; def_static="no" ;; ++ def_dlopen="yes" ; def_custreloc="no" ;; + hppa*) +- def_dlopen="yes" ; def_statsysbfd="no" ; def_pic="yes" ; def_debug="yes" ;; +-# m68k*) +-# def_oldgmp="yes" ;; ++ def_pic="yes" ;; ++# def_dlopen="yes" ; def_custreloc="no" ; def_pic="yes" ;; + esac;; +- *mingw*) +- def_statsysbfd="no" ; def_custreloc="yes" ;; +- powerpc-macosx) +- def_statsysbfd="no" ; def_locbfd="yes" ;; + esac + +-# Check whether --enable-dlopen or --disable-dlopen was given. +-if test "${enable_dlopen+set}" = set; then +- enableval="$enable_dlopen" +- : ++# Check whether --enable-dlopen was given. ++if test "${enable_dlopen+set}" = set; then : ++ enableval=$enable_dlopen; + else + enable_dlopen="$def_dlopen" + fi + +-# Check whether --enable-statsysbfd or --disable-statsysbfd was given. +-if test "${enable_statsysbfd+set}" = set; then +- enableval="$enable_statsysbfd" +- : ++# Check whether --enable-statsysbfd was given. ++if test "${enable_statsysbfd+set}" = set; then : ++ enableval=$enable_statsysbfd; + else + enable_statsysbfd="$def_statsysbfd" + fi + +-# Check whether --enable-dynsysbfd or --disable-dynsysbfd was given. +-if test "${enable_dynsysbfd+set}" = set; then +- enableval="$enable_dynsysbfd" +- : ++# Check whether --enable-dynsysbfd was given. ++if test "${enable_dynsysbfd+set}" = set; then : ++ enableval=$enable_dynsysbfd; + else + enable_dynsysbfd="no" + fi + +-# Check whether --enable-locbfd or --disable-locbfd was given. +-if test "${enable_locbfd+set}" = set; then +- enableval="$enable_locbfd" +- : +-else +- enable_locbfd="$def_locbfd" +-fi +- +-# Check whether --enable-custreloc or --disable-custreloc was given. +-if test "${enable_custreloc+set}" = set; then +- enableval="$enable_custreloc" +- : ++#AC_ARG_ENABLE(locbfd, ++# [ --enable-locbfd uses a static bfd library built from this source tree for loading and relocationing object files ] ++# ,,enable_locbfd="$def_locbfd") ++# Check whether --enable-custreloc was given. ++if test "${enable_custreloc+set}" = set; then : ++ enableval=$enable_custreloc; + else + enable_custreloc="$def_custreloc" + fi + +-# Check whether --enable-debug or --disable-debug was given. +-if test "${enable_debug+set}" = set; then +- enableval="$enable_debug" +- : ++# Check whether --enable-debug was given. ++if test "${enable_debug+set}" = set; then : ++ enableval=$enable_debug; + else + enable_debug="$def_debug" + fi + +-# Check whether --enable-gprof or --disable-gprof was given. +-if test "${enable_gprof+set}" = set; then +- enableval="$enable_gprof" +- : ++# Check whether --enable-gprof was given. ++if test "${enable_gprof+set}" = set; then : ++ enableval=$enable_gprof; + else + enable_gprof="no" + fi + +-# Check whether --enable-static or --disable-static was given. +-if test "${enable_static+set}" = set; then +- enableval="$enable_static" +- enable_static=$enableval ++# Check whether --enable-static was given. ++if test "${enable_static+set}" = set; then : ++ enableval=$enable_static; enable_static=$enableval + else + enable_static="$def_static" + fi + +-# Check whether --enable-pic or --disable-pic was given. +-if test "${enable_pic+set}" = set; then +- enableval="$enable_pic" +- : ++# Check whether --enable-pic was given. ++if test "${enable_pic+set}" = set; then : ++ enableval=$enable_pic; + else + enable_pic="$def_pic" + fi + + +-# Check whether --enable-oldgmp or --disable-oldgmp was given. +-if test "${enable_oldgmp+set}" = set; then +- enableval="$enable_oldgmp" +- : ++# Check whether --enable-oldgmp was given. ++if test "${enable_oldgmp+set}" = set; then : ++ enableval=$enable_oldgmp; + else + enable_oldgmp="$def_oldgmp" + fi + + +-# Check whether --enable-dynsysgmp or --disable-dynsysgmp was given. +-if test "${enable_dynsysgmp+set}" = set; then +- enableval="$enable_dynsysgmp" +- : ++# Check whether --enable-dynsysgmp was given. ++if test "${enable_dynsysgmp+set}" = set; then : ++ enableval=$enable_dynsysgmp; + else + enable_dynsysgmp="yes" + fi +@@ -1162,21 +3029,26 @@ if test "$load_opt" != "1" ; then + exit 1 + fi + +-TLIBS="" ++TLDFLAGS="" + if test "$enable_static" = "yes" ; then +- TLIBS="-static $TLIBS"; ++ TLDFLAGS="-static -Wl,-zmuldefs $TLDFLAGS"; #FIXME should be in unixport/makefile ++ ++$as_echo "#define STATIC_LINKING 1" >>confdefs.h ++ + fi + ++ + ## finally warn if we did not find a recognized machine.s + ## + #if test "$use" = "unknown" ; then + #types=`echo h/*.defs` | sed -e "s:h/::g" -e "s:\.defs:g"` +-#echo got canonical=$canonical, but was not recognized. +-#echo Unable to guess type to use. Try one of ++#echo got canonical=$canonical, but was not recognized. ++#echo Unable to guess type to use. Try one of + #exit(1) + #fi + +-echo "$ac_t""use=$use" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: use=$use" >&5 ++$as_echo "use=$use" >&6; } + + + # +@@ -1192,214 +3064,686 @@ if test "$LDFLAGS" = "" ; then + LDFLAGS=" " + fi + +-# Extract the first word of "gcc", so it can be a program name with args. +-set dummy gcc; ac_word=$2 +-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +-echo "configure:1199: checking for $ac_word" >&5 +-if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++ac_ext=c ++ac_cpp='$CPP $CPPFLAGS' ++ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ++ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ++ac_compiler_gnu=$ac_cv_c_compiler_gnu ++if test -n "$ac_tool_prefix"; then ++ # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. ++set dummy ${ac_tool_prefix}gcc; ac_word=$2 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 ++$as_echo_n "checking for $ac_word... " >&6; } ++if ${ac_cv_prog_CC+:} false; then : ++ $as_echo_n "(cached) " >&6 + else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. + else +- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" +- ac_dummy="$PATH" +- for ac_dir in $ac_dummy; do +- test -z "$ac_dir" && ac_dir=. +- if test -f $ac_dir/$ac_word; then +- ac_cv_prog_CC="gcc" +- break +- fi ++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ for ac_exec_ext in '' $ac_executable_extensions; do ++ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ++ ac_cv_prog_CC="${ac_tool_prefix}gcc" ++ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 ++ break 2 ++ fi ++done ++ done ++IFS=$as_save_IFS ++ ++fi ++fi ++CC=$ac_cv_prog_CC ++if test -n "$CC"; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 ++$as_echo "$CC" >&6; } ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ++fi ++ ++ ++fi ++if test -z "$ac_cv_prog_CC"; then ++ ac_ct_CC=$CC ++ # Extract the first word of "gcc", so it can be a program name with args. ++set dummy gcc; ac_word=$2 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 ++$as_echo_n "checking for $ac_word... " >&6; } ++if ${ac_cv_prog_ac_ct_CC+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ if test -n "$ac_ct_CC"; then ++ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. ++else ++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ for ac_exec_ext in '' $ac_executable_extensions; do ++ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ++ ac_cv_prog_ac_ct_CC="gcc" ++ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 ++ break 2 ++ fi ++done ++ done ++IFS=$as_save_IFS ++ ++fi ++fi ++ac_ct_CC=$ac_cv_prog_ac_ct_CC ++if test -n "$ac_ct_CC"; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 ++$as_echo "$ac_ct_CC" >&6; } ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ++fi ++ ++ if test "x$ac_ct_CC" = x; then ++ CC="" ++ else ++ case $cross_compiling:$ac_tool_warned in ++yes:) ++{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 ++$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ++ac_tool_warned=yes ;; ++esac ++ CC=$ac_ct_CC ++ fi ++else ++ CC="$ac_cv_prog_CC" ++fi ++ ++if test -z "$CC"; then ++ if test -n "$ac_tool_prefix"; then ++ # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. ++set dummy ${ac_tool_prefix}cc; ac_word=$2 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 ++$as_echo_n "checking for $ac_word... " >&6; } ++if ${ac_cv_prog_CC+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ if test -n "$CC"; then ++ ac_cv_prog_CC="$CC" # Let the user override the test. ++else ++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ for ac_exec_ext in '' $ac_executable_extensions; do ++ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ++ ac_cv_prog_CC="${ac_tool_prefix}cc" ++ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 ++ break 2 ++ fi ++done + done +- IFS="$ac_save_ifs" ++IFS=$as_save_IFS ++ + fi + fi +-CC="$ac_cv_prog_CC" ++CC=$ac_cv_prog_CC + if test -n "$CC"; then +- echo "$ac_t""$CC" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 ++$as_echo "$CC" >&6; } + else +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi + ++ ++ fi ++fi + if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. + set dummy cc; ac_word=$2 +-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +-echo "configure:1229: checking for $ac_word" >&5 +-if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 ++$as_echo_n "checking for $ac_word... " >&6; } ++if ${ac_cv_prog_CC+:} false; then : ++ $as_echo_n "(cached) " >&6 + else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. + else +- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_prog_rejected=no +- ac_dummy="$PATH" +- for ac_dir in $ac_dummy; do +- test -z "$ac_dir" && ac_dir=. +- if test -f $ac_dir/$ac_word; then +- if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then +- ac_prog_rejected=yes +- continue +- fi +- ac_cv_prog_CC="cc" +- break +- fi ++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ for ac_exec_ext in '' $ac_executable_extensions; do ++ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ++ if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ++ ac_prog_rejected=yes ++ continue ++ fi ++ ac_cv_prog_CC="cc" ++ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 ++ break 2 ++ fi ++done + done +- IFS="$ac_save_ifs" ++IFS=$as_save_IFS ++ + if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift +- if test $# -gt 0; then ++ if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift +- set dummy "$ac_dir/$ac_word" "$@" +- shift +- ac_cv_prog_CC="$@" ++ ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi + fi + fi + fi +-CC="$ac_cv_prog_CC" ++CC=$ac_cv_prog_CC + if test -n "$CC"; then +- echo "$ac_t""$CC" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 ++$as_echo "$CC" >&6; } + else +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi + +- if test -z "$CC"; then +- case "`uname -s`" in +- *win32* | *WIN32*) +- # Extract the first word of "cl", so it can be a program name with args. +-set dummy cl; ac_word=$2 +-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +-echo "configure:1280: checking for $ac_word" >&5 +-if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++ ++fi ++if test -z "$CC"; then ++ if test -n "$ac_tool_prefix"; then ++ for ac_prog in cl.exe ++ do ++ # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. ++set dummy $ac_tool_prefix$ac_prog; ac_word=$2 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 ++$as_echo_n "checking for $ac_word... " >&6; } ++if ${ac_cv_prog_CC+:} false; then : ++ $as_echo_n "(cached) " >&6 + else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. + else +- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" +- ac_dummy="$PATH" +- for ac_dir in $ac_dummy; do +- test -z "$ac_dir" && ac_dir=. +- if test -f $ac_dir/$ac_word; then +- ac_cv_prog_CC="cl" +- break +- fi ++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ for ac_exec_ext in '' $ac_executable_extensions; do ++ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ++ ac_cv_prog_CC="$ac_tool_prefix$ac_prog" ++ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 ++ break 2 ++ fi ++done + done +- IFS="$ac_save_ifs" ++IFS=$as_save_IFS ++ + fi + fi +-CC="$ac_cv_prog_CC" ++CC=$ac_cv_prog_CC + if test -n "$CC"; then +- echo "$ac_t""$CC" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 ++$as_echo "$CC" >&6; } + else +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi +- ;; +- esac ++ ++ ++ test -n "$CC" && break ++ done ++fi ++if test -z "$CC"; then ++ ac_ct_CC=$CC ++ for ac_prog in cl.exe ++do ++ # Extract the first word of "$ac_prog", so it can be a program name with args. ++set dummy $ac_prog; ac_word=$2 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 ++$as_echo_n "checking for $ac_word... " >&6; } ++if ${ac_cv_prog_ac_ct_CC+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ if test -n "$ac_ct_CC"; then ++ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. ++else ++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ for ac_exec_ext in '' $ac_executable_extensions; do ++ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ++ ac_cv_prog_ac_ct_CC="$ac_prog" ++ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 ++ break 2 + fi +- test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } ++done ++ done ++IFS=$as_save_IFS ++ ++fi ++fi ++ac_ct_CC=$ac_cv_prog_ac_ct_CC ++if test -n "$ac_ct_CC"; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 ++$as_echo "$ac_ct_CC" >&6; } ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi + +-echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 +-echo "configure:1312: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 + +-ac_ext=c +-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. +-ac_cpp='$CPP $CPPFLAGS' +-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' +-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +-cross_compiling=$ac_cv_prog_cc_cross ++ test -n "$ac_ct_CC" && break ++done ++ ++ if test "x$ac_ct_CC" = x; then ++ CC="" ++ else ++ case $cross_compiling:$ac_tool_warned in ++yes:) ++{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 ++$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ++ac_tool_warned=yes ;; ++esac ++ CC=$ac_ct_CC ++ fi ++fi + +-cat > conftest.$ac_ext << EOF ++fi + +-#line 1323 "configure" +-#include "confdefs.h" + +-main(){return(0);} +-EOF +-if { (eval echo configure:1328: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- ac_cv_prog_cc_works=yes +- # If we can't run a trivial program, we are probably using a cross compiler. +- if (./conftest; exit) 2>/dev/null; then +- ac_cv_prog_cc_cross=no +- else +- ac_cv_prog_cc_cross=yes ++test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "no acceptable C compiler found in \$PATH ++See \`config.log' for more details" "$LINENO" 5; } ++ ++# Provide some information about the compiler. ++$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 ++set X $ac_compile ++ac_compiler=$2 ++for ac_option in --version -v -V -qversion; do ++ { { ac_try="$ac_compiler $ac_option >&5" ++case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_compiler $ac_option >&5") 2>conftest.err ++ ac_status=$? ++ if test -s conftest.err; then ++ sed '10a\ ++... rest of stderr output deleted ... ++ 10q' conftest.err >conftest.er1 ++ cat conftest.er1 >&5 + fi ++ rm -f conftest.er1 conftest.err ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; } ++done ++ ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++int ++main () ++{ ++ ++ ; ++ return 0; ++} ++_ACEOF ++ac_clean_files_save=$ac_clean_files ++ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" ++# Try to create an executable without -o first, disregard a.out. ++# It will help us diagnose broken compilers, and finding out an intuition ++# of exeext. ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 ++$as_echo_n "checking whether the C compiler works... " >&6; } ++ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` ++ ++# The possible output files: ++ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" ++ ++ac_rmfiles= ++for ac_file in $ac_files ++do ++ case $ac_file in ++ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; ++ * ) ac_rmfiles="$ac_rmfiles $ac_file";; ++ esac ++done ++rm -f $ac_rmfiles ++ ++if { { ac_try="$ac_link_default" ++case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_link_default") 2>&5 ++ ac_status=$? ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; }; then : ++ # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. ++# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' ++# in a Makefile. We should not override ac_cv_exeext if it was cached, ++# so that the user can short-circuit this test for compilers unknown to ++# Autoconf. ++for ac_file in $ac_files '' ++do ++ test -f "$ac_file" || continue ++ case $ac_file in ++ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ++ ;; ++ [ab].out ) ++ # We found the default executable, but exeext='' is most ++ # certainly right. ++ break;; ++ *.* ) ++ if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; ++ then :; else ++ ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` ++ fi ++ # We set ac_cv_exeext here because the later test for it is not ++ # safe: cross compilers may not add the suffix if given an `-o' ++ # argument, so we may need to know it at that point already. ++ # Even if this section looks crufty: it has the advantage of ++ # actually working. ++ break;; ++ * ) ++ break;; ++ esac ++done ++test "$ac_cv_exeext" = no && ac_cv_exeext= ++ + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- ac_cv_prog_cc_works=no ++ ac_file='' + fi +-rm -fr conftest* +-ac_ext=c +-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. +-ac_cpp='$CPP $CPPFLAGS' +-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' +-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +-cross_compiling=$ac_cv_prog_cc_cross +- +-echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 +-if test $ac_cv_prog_cc_works = no; then +- { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } +-fi +-echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 +-echo "configure:1354: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +-echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 +-cross_compiling=$ac_cv_prog_cc_cross +- +-echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 +-echo "configure:1359: checking whether we are using GNU C" >&5 +-if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +- ac_cv_prog_gcc=yes ++if test -z "$ac_file"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ++$as_echo "$as_me: failed program was:" >&5 ++sed 's/^/| /' conftest.$ac_ext >&5 ++ ++{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error 77 "C compiler cannot create executables ++See \`config.log' for more details" "$LINENO" 5; } ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 ++$as_echo_n "checking for C compiler default output file name... " >&6; } ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 ++$as_echo "$ac_file" >&6; } ++ac_exeext=$ac_cv_exeext ++ ++rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out ++ac_clean_files=$ac_clean_files_save ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 ++$as_echo_n "checking for suffix of executables... " >&6; } ++if { { ac_try="$ac_link" ++case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_link") 2>&5 ++ ac_status=$? ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; }; then : ++ # If both `conftest.exe' and `conftest' are `present' (well, observable) ++# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will ++# work properly (i.e., refer to `conftest.exe'), while it won't with ++# `rm'. ++for ac_file in conftest.exe conftest conftest.*; do ++ test -f "$ac_file" || continue ++ case $ac_file in ++ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; ++ *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` ++ break;; ++ * ) break;; ++ esac ++done + else +- ac_cv_prog_gcc=no +-fi ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot compute suffix of executables: cannot compile and link ++See \`config.log' for more details" "$LINENO" 5; } ++fi ++rm -f conftest conftest$ac_cv_exeext ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 ++$as_echo "$ac_cv_exeext" >&6; } ++ ++rm -f conftest.$ac_ext ++EXEEXT=$ac_cv_exeext ++ac_exeext=$EXEEXT ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++int ++main () ++{ ++FILE *f = fopen ("conftest.out", "w"); ++ return ferror (f) || fclose (f) != 0; ++ ++ ; ++ return 0; ++} ++_ACEOF ++ac_clean_files="$ac_clean_files conftest.out" ++# Check that the compiler produces executables we can run. If not, either ++# the compiler is broken, or we cross compile. ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 ++$as_echo_n "checking whether we are cross compiling... " >&6; } ++if test "$cross_compiling" != yes; then ++ { { ac_try="$ac_link" ++case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_link") 2>&5 ++ ac_status=$? ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; } ++ if { ac_try='./conftest$ac_cv_exeext' ++ { { case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_try") 2>&5 ++ ac_status=$? ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; }; }; then ++ cross_compiling=no ++ else ++ if test "$cross_compiling" = maybe; then ++ cross_compiling=yes ++ else ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run C compiled programs. ++If you meant to cross compile, use \`--host'. ++See \`config.log' for more details" "$LINENO" 5; } ++ fi ++ fi + fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 ++$as_echo "$cross_compiling" >&6; } ++ ++rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out ++ac_clean_files=$ac_clean_files_save ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 ++$as_echo_n "checking for suffix of object files... " >&6; } ++if ${ac_cv_objext+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++int ++main () ++{ ++ ++ ; ++ return 0; ++} ++_ACEOF ++rm -f conftest.o conftest.obj ++if { { ac_try="$ac_compile" ++case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_compile") 2>&5 ++ ac_status=$? ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; }; then : ++ for ac_file in conftest.o conftest.obj conftest.*; do ++ test -f "$ac_file" || continue; ++ case $ac_file in ++ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; ++ *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` ++ break;; ++ esac ++done ++else ++ $as_echo "$as_me: failed program was:" >&5 ++sed 's/^/| /' conftest.$ac_ext >&5 ++ ++{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot compute suffix of object files: cannot compile ++See \`config.log' for more details" "$LINENO" 5; } ++fi ++rm -f conftest.$ac_cv_objext conftest.$ac_ext ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 ++$as_echo "$ac_cv_objext" >&6; } ++OBJEXT=$ac_cv_objext ++ac_objext=$OBJEXT ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 ++$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } ++if ${ac_cv_c_compiler_gnu+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++int ++main () ++{ ++#ifndef __GNUC__ ++ choke me ++#endif + +-echo "$ac_t""$ac_cv_prog_gcc" 1>&6 ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ ac_compiler_gnu=yes ++else ++ ac_compiler_gnu=no ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++ac_cv_c_compiler_gnu=$ac_compiler_gnu + +-if test $ac_cv_prog_gcc = yes; then ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 ++$as_echo "$ac_cv_c_compiler_gnu" >&6; } ++if test $ac_compiler_gnu = yes; then + GCC=yes + else + GCC= + fi ++ac_test_CFLAGS=${CFLAGS+set} ++ac_save_CFLAGS=$CFLAGS ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 ++$as_echo_n "checking whether $CC accepts -g... " >&6; } ++if ${ac_cv_prog_cc_g+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ ac_save_c_werror_flag=$ac_c_werror_flag ++ ac_c_werror_flag=yes ++ ac_cv_prog_cc_g=no ++ CFLAGS="-g" ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + +-ac_test_CFLAGS="${CFLAGS+set}" +-ac_save_CFLAGS="$CFLAGS" +-CFLAGS= +-echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 +-echo "configure:1387: checking whether ${CC-cc} accepts -g" >&5 +-if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- echo 'void f(){}' > conftest.c +-if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then ++int ++main () ++{ ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes + else +- ac_cv_prog_cc_g=no +-fi +-rm -f conftest* ++ CFLAGS="" ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + +-fi ++int ++main () ++{ ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ ++else ++ ac_c_werror_flag=$ac_save_c_werror_flag ++ CFLAGS="-g" ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++int ++main () ++{ + +-echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ ac_cv_prog_cc_g=yes ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++ ac_c_werror_flag=$ac_save_c_werror_flag ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 ++$as_echo "$ac_cv_prog_cc_g" >&6; } + if test "$ac_test_CFLAGS" = set; then +- CFLAGS="$ac_save_CFLAGS" ++ CFLAGS=$ac_save_CFLAGS + elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" +@@ -1413,86 +3757,239 @@ else + CFLAGS= + fi + fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 ++$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } ++if ${ac_cv_prog_cc_c89+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ ac_cv_prog_cc_c89=no ++ac_save_CC=$CC ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++#include ++#include ++#include ++/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ ++struct buf { int x; }; ++FILE * (*rcsopen) (struct buf *, struct stat *, int); ++static char *e (p, i) ++ char **p; ++ int i; ++{ ++ return p[i]; ++} ++static char *f (char * (*g) (char **, int), char **p, ...) ++{ ++ char *s; ++ va_list v; ++ va_start (v,p); ++ s = g (p, va_arg (v,int)); ++ va_end (v); ++ return s; ++} ++ ++/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has ++ function prototypes and stuff, but not '\xHH' hex character constants. ++ These don't provoke an error unfortunately, instead are silently treated ++ as 'x'. The following induces an error, until -std is added to get ++ proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an ++ array size at least. It's necessary to write '\x00'==0 to get something ++ that's true only with -std. */ ++int osf4_cc_array ['\x00' == 0 ? 1 : -1]; ++ ++/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters ++ inside strings and character constants. */ ++#define FOO(x) 'x' ++int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; ++ ++int test (int i, double x); ++struct s1 {int (*f) (int a);}; ++struct s2 {int (*f) (double a);}; ++int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); ++int argc; ++char **argv; ++int ++main () ++{ ++return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ++ ; ++ return 0; ++} ++_ACEOF ++for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ ++ -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" ++do ++ CC="$ac_save_CC $ac_arg" ++ if ac_fn_c_try_compile "$LINENO"; then : ++ ac_cv_prog_cc_c89=$ac_arg ++fi ++rm -f core conftest.err conftest.$ac_objext ++ test "x$ac_cv_prog_cc_c89" != "xno" && break ++done ++rm -f conftest.$ac_ext ++CC=$ac_save_CC ++ ++fi ++# AC_CACHE_VAL ++case "x$ac_cv_prog_cc_c89" in ++ x) ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 ++$as_echo "none needed" >&6; } ;; ++ xno) ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 ++$as_echo "unsupported" >&6; } ;; ++ *) ++ CC="$CC $ac_cv_prog_cc_c89" ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 ++$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; ++esac ++if test "x$ac_cv_prog_cc_c89" != xno; then : ++ ++fi ++ ++ac_ext=c ++ac_cpp='$CPP $CPPFLAGS' ++ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ++ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ++ac_compiler_gnu=$ac_cv_c_compiler_gnu + +-echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 +-echo "configure:1419: checking how to run the C preprocessor" >&5 ++ac_ext=c ++ac_cpp='$CPP $CPPFLAGS' ++ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ++ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ++ac_compiler_gnu=$ac_cv_c_compiler_gnu ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 ++$as_echo_n "checking how to run the C preprocessor... " >&6; } + # On Suns, sometimes $CPP names a directory. + if test -n "$CPP" && test -d "$CPP"; then + CPP= + fi + if test -z "$CPP"; then +-if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++ if ${ac_cv_prog_CPP+:} false; then : ++ $as_echo_n "(cached) " >&6 + else +- # This must be in double quotes, not single quotes, because CPP may get +- # substituted into the Makefile and "${CC-cc}" will confuse make. +- CPP="${CC-cc} -E" ++ # Double quotes because CPP needs to be expanded ++ for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" ++ do ++ ac_preproc_ok=false ++for ac_c_preproc_warn_flag in '' yes ++do ++ # Use a header file that comes with gcc, so configuring glibc ++ # with a fresh cross-compiler works. ++ # Prefer to if __STDC__ is defined, since ++ # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, +- # not just through cpp. +- cat > conftest.$ac_ext < +-Syntax Error +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:1440: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- : +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- CPP="${CC-cc} -E -traditional-cpp" +- cat > conftest.$ac_ext < +-Syntax Error +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:1457: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- : +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- CPP="${CC-cc} -nologo -E" +- cat > conftest.$ac_ext < +-Syntax Error +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:1474: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- : ++ # not just through cpp. "Syntax error" is here to catch this case. ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#ifdef __STDC__ ++# include ++#else ++# include ++#endif ++ Syntax error ++_ACEOF ++if ac_fn_c_try_cpp "$LINENO"; then : ++ ++else ++ # Broken: fails on valid input. ++continue ++fi ++rm -f conftest.err conftest.i conftest.$ac_ext ++ ++ # OK, works on sane cases. Now check whether nonexistent headers ++ # can be detected and how. ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++_ACEOF ++if ac_fn_c_try_cpp "$LINENO"; then : ++ # Broken: success on invalid input. ++continue + else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- CPP=/lib/cpp ++ # Passes both tests. ++ac_preproc_ok=: ++break + fi +-rm -f conftest* ++rm -f conftest.err conftest.i conftest.$ac_ext ++ ++done ++# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. ++rm -f conftest.i conftest.err conftest.$ac_ext ++if $ac_preproc_ok; then : ++ break + fi +-rm -f conftest* ++ ++ done ++ ac_cv_prog_CPP=$CPP ++ + fi +-rm -f conftest* +- ac_cv_prog_CPP="$CPP" ++ CPP=$ac_cv_prog_CPP ++else ++ ac_cv_prog_CPP=$CPP ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 ++$as_echo "$CPP" >&6; } ++ac_preproc_ok=false ++for ac_c_preproc_warn_flag in '' yes ++do ++ # Use a header file that comes with gcc, so configuring glibc ++ # with a fresh cross-compiler works. ++ # Prefer to if __STDC__ is defined, since ++ # exists even on freestanding compilers. ++ # On the NeXT, cc -E runs the code through the compiler's parser, ++ # not just through cpp. "Syntax error" is here to catch this case. ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#ifdef __STDC__ ++# include ++#else ++# include ++#endif ++ Syntax error ++_ACEOF ++if ac_fn_c_try_cpp "$LINENO"; then : ++ ++else ++ # Broken: fails on valid input. ++continue ++fi ++rm -f conftest.err conftest.i conftest.$ac_ext ++ ++ # OK, works on sane cases. Now check whether nonexistent headers ++ # can be detected and how. ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++_ACEOF ++if ac_fn_c_try_cpp "$LINENO"; then : ++ # Broken: success on invalid input. ++continue ++else ++ # Passes both tests. ++ac_preproc_ok=: ++break + fi +- CPP="$ac_cv_prog_CPP" ++rm -f conftest.err conftest.i conftest.$ac_ext ++ ++done ++# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. ++rm -f conftest.i conftest.err conftest.$ac_ext ++if $ac_preproc_ok; then : ++ + else +- ac_cv_prog_CPP="$CPP" ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "C preprocessor \"$CPP\" fails sanity check ++See \`config.log' for more details" "$LINENO" 5; } + fi +-echo "$ac_t""$CPP" 1>&6 ++ ++ac_ext=c ++ac_cpp='$CPP $CPPFLAGS' ++ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ++ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ++ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +@@ -1507,14 +4004,50 @@ echo "$ac_t""$CPP" 1>&6 + #fi + # subst GCC not only under 386-linux, but where available -- CM + ++if test "$GCC" = "yes" ; then ++ ++ TCFLAGS="-Wall -DVOL=volatile -fsigned-char" ++ ++ #FIXME -Wno-unused-but-set-variable when time ++ TMPF=-Wno-unused-but-set-variable ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $TMPF" >&5 ++$as_echo_n "checking for CFLAG $TMPF... " >&6; } ++ CFLAGS_ORI=$CFLAGS ++ CFLAGS="$CFLAGS $TMPF" ++ ++if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++int main() {return 0;} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ TCFLAGS="$TCFLAGS $TMPF";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ++fi ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++fi ++ ++ CFLAGS=$CFLAGS_ORI + +-TCFLAGS="-Wall -DVOL=volatile -fsigned-char" ++else ++ TCFLAGS="-DVOL=volatile -fsigned-char" ++fi + if test "$GCC" = "yes" ; then + TCFLAGS="$TCFLAGS -pipe" + case $use in + *mingw*) + echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." + echo " It is ptherwise needed for the Unexec stuff to work." ++ if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi + TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; + esac + fi +@@ -1533,6 +4066,8 @@ TO2FLAGS="" + # FIXME -- remove when mingw compiler issues are fixed + case "$use" in + *mingw*) ++ TFPFLAG="";; ++ m68k*)#FIXME gcc 4.x bug workaround + TFPFLAG="";; + *) + TFPFLAG="-fomit-frame-pointer";; +@@ -1540,160 +4075,233 @@ esac + + for ac_prog in gawk nawk awk + do +-# Extract the first word of "$ac_prog", so it can be a program name with args. ++ # Extract the first word of "$ac_prog", so it can be a program name with args. + set dummy $ac_prog; ac_word=$2 +-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +-echo "configure:1547: checking for $ac_word" >&5 +-if eval "test \"`echo '$''{'ac_cv_prog_AWK'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 ++$as_echo_n "checking for $ac_word... " >&6; } ++if ${ac_cv_prog_AWK+:} false; then : ++ $as_echo_n "(cached) " >&6 + else + if test -n "$AWK"; then + ac_cv_prog_AWK="$AWK" # Let the user override the test. + else +- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" +- ac_dummy="$PATH" +- for ac_dir in $ac_dummy; do +- test -z "$ac_dir" && ac_dir=. +- if test -f $ac_dir/$ac_word; then +- ac_cv_prog_AWK="$ac_prog" +- break +- fi +- done +- IFS="$ac_save_ifs" +-fi ++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ for ac_exec_ext in '' $ac_executable_extensions; do ++ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ++ ac_cv_prog_AWK="$ac_prog" ++ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 ++ break 2 ++ fi ++done ++ done ++IFS=$as_save_IFS ++ ++fi + fi +-AWK="$ac_cv_prog_AWK" ++AWK=$ac_cv_prog_AWK + if test -n "$AWK"; then +- echo "$ac_t""$AWK" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AWK" >&5 ++$as_echo "$AWK" >&6; } + else +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi + +-test -n "$AWK" && break ++ ++ test -n "$AWK" && break + done +-test -n "$AWK" || AWK="""" + + ++# Work around system/gprof mips/hppa hang ++case $use in ++ sh4*) enable_gprof="no";; ++ mips*) enable_gprof="no";; ++ hppa*) enable_gprof="no";; ++ *gnu) enable_gprof="no";; ++esac ++ + if test "$enable_gprof" = "yes" ; then +- TCFLAGS="$TCFLAGS -pg" +- TLIBS="$TLIBS -pg" ++ TCFLAGS="$TCFLAGS -pg"; ++ TLIBS="$TLIBS -pg"; + TFPFLAG="" +- cat >> confdefs.h <<\EOF +-#define GCL_GPROF 1 +-EOF ++ $as_echo "#define GCL_GPROF 1" >>confdefs.h + +- echo $ac_n "checking for text start""... $ac_c" 1>&6 +-echo "configure:1587: checking for text start" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for text start" >&5 ++$as_echo_n "checking for text start... " >&6; } + echo 'int main () {return(0);}' >foo.c + $CC foo.c -o foo + GCL_GPROF_START=`nm foo | $AWK '/ *T *__*start$/ {print $NF}'` + rm -f foo.c foo +- echo "$ac_t""$GCL_GPROF_START" 1>&6 +- cat >> confdefs.h <&5 ++$as_echo "$GCL_GPROF_START" >&6; } ++ cat >>confdefs.h <<_ACEOF + #define GCL_GPROF_START $GCL_GPROF_START +-EOF ++_ACEOF + +- case "$use" in +- arm*) ++ case "$use" in ++ arm*) + #FIXME report and remove this when done +- echo "$ac_t""Reducing optimization on profiling arm build to workaround gcc bug" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: Reducing optimization on profiling arm build to workaround gcc bug" >&5 ++$as_echo "Reducing optimization on profiling arm build to workaround gcc bug" >&6; } + enable_debug=yes;; + esac + fi + ++if $CC -v 2>&1 | tail -n 1 | grep -q "gcc version 4.6.1" ; then ++ case "$use" in ++ arm*) ++ #FIXME report and remove this when done ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: Reducing optimization on arm build to workaround gcc 4.6 bug" >&5 ++$as_echo "Reducing optimization on arm build to workaround gcc 4.6 bug" >&6; } ++ enable_debug=yes;; ++ esac ++fi ++ ++ + if test "$enable_debug" = "yes" ; then + TCFLAGS="$TCFLAGS -g" + # for subconfigurations + CFLAGS="$CFLAGS -g" + else +-# FIXME -- remove when mingw compiler issues are fixed +- case "$use" in +- *mingw*) +- TO3FLAGS="-O3 $TFPFLAG";; +- *) +- TO3FLAGS="-O3 $TFPFLAG";; +- esac +-# TO3FLAGS="-O3 $TFPFLAG" ++ TO3FLAGS="-O3 $TFPFLAG" + TO2FLAGS="-O" + fi + + # gcc on ppc cannot compile our new_init.c with full opts --CM + TONIFLAGS="" +-case $use in ++case $use in ++ powerpc*macosx) ++ TCFLAGS="$TCFLAGS -mlongcall";; + *linux) + case $use in + # amd64*) # stack-boundary option does not work +-# TCFLAGS="$TCFLAGS -m64 -mpreferred-stack-boundary=8";; ++# TCFLAGS="$TCFLAGS -m64 -mpreferred-stack-boundary=8";; + alpha*) + TCFLAGS="$TCFLAGS -mieee";; + # m68k*) + # TCFLAGS="$TCFLAGS -ffloat-store";; + hppa*) +- TCFLAGS="$TCFLAGS -ffunction-sections" +- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O $TFPFLAG" ; fi +- if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi ++ TCFLAGS="$TCFLAGS -mlong-calls " ++# TCFLAGS="$TCFLAGS -ffunction-sections" ++# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O $TFPFLAG" ; fi ++# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi + ;; + arm*) +- TCFLAGS="$TCFLAGS -mlong-calls";; +- powerpc*) +- if $CC -v 2>&1 | grep -q "gcc version 3.2" ; then +- echo Reducing optimization for buggy gcc-3.2 +- if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi +- fi; +- echo Probing for longcall +- if ! $CC -v 2>&1 | $AWK '/^gcc version / {split($3,A,".");if (A[1]+0>=3 && A[2]+0>=3) exit 1;}'; then +- echo Enabling longcall on gcc 3.3 or later +- TCFLAGS="$TCFLAGS -mlongcall" +- echo Reducing optimization for buggy gcc 3.3 or later +- if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi +- fi;; ++ TCFLAGS="$TCFLAGS -mlong-calls -fdollars-in-identifiers -g " ++# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; fi ++# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi ++ ;; ++ powerpc*) ++ TCFLAGS="$TCFLAGS -mlongcall" ++ ;; ++# if $CC -v 2>&1 | grep -q "gcc version 3.2" ; then ++# echo Reducing optimization for buggy gcc-3.2 ++# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi ++# fi; ++# echo Probing for longcall ++# if ! $CC -v 2>&1 | $AWK '/^gcc version / {split($3,A,".");if (A[[1]]+0>3 || (A[[1]]+0>=3 && A[[2]]+0>=3)) exit 1;}'; then ++# echo Enabling longcall on gcc 3.3 or later ++# TCFLAGS="$TCFLAGS -mlongcall" ++# echo Reducing optimization for buggy gcc 3.3 or later ++# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi ++# fi;; + esac;; + esac + if test "$enable_pic" = "yes" ; then + TCFLAGS="$TCFLAGS -fPIC" + fi + ++FDEBUG=`echo $CFLAGS | tr ' ' '\012' |grep "^\-g$"|tr '\012' ' '` ++#CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-g$"` ++FOMITF=`echo $CFLAGS | tr ' ' '\012' |grep "^\-fomit-frame-pointer$"|tr '\012' ' '` ++CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-fomit-frame-pointer$"|tr '\012' ' '` ++FOOPT3=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O3$"|tr '\012' ' '` ++CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O3$"|tr '\012' ' '` ++FOOPT2=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O2$"|tr '\012' ' '` ++CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O2$"|tr '\012' ' '` ++FOOPT1=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O1$"|tr '\012' ' '` ++TMP=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O$"|tr '\012' ' '` ++FOOPT1="$FOOPT1$TMP" ++CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O1$"|grep -v "^\-O$"|tr '\012' ' '` ++FOOPT0=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O0$"|tr '\012' ' '` ++CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O0$"|tr '\012' ' '` ++ ++if test "$FOOPT0" != "" ; then ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` ++else ++if test "$FOOPT1" != "" ; then ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[2-3],-O1,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[2-3],-O1,g'` ++else ++if test "$FOOPT2" != "" ; then ++ TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` ++ TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` ++fi ++fi ++fi ++ ++if test "$FDEBUG" != "" ; then ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++fi ++ ++if test "$FOMITF" != "" ; then ++ TO3FLAGS="$TO3FLAGS $FOMITF" ++fi + + # Step 1: set the variable "system" to hold the name and version number + # for the system. This can usually be done via the "uname" command, but + # there are a few systems, like Next, where this doesn't work. + +-echo $ac_n "checking system version (for dynamic loading)""... $ac_c" 1>&6 +-echo "configure:1663: checking system version (for dynamic loading)" >&5 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking system version (for dynamic loading)" >&5 ++$as_echo_n "checking system version (for dynamic loading)... " >&6; } + if machine=`uname -m` ; then true; else machine=unknown ; fi + + for ac_prog in makeinfo + do +-# Extract the first word of "$ac_prog", so it can be a program name with args. ++ # Extract the first word of "$ac_prog", so it can be a program name with args. + set dummy $ac_prog; ac_word=$2 +-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +-echo "configure:1671: checking for $ac_word" >&5 +-if eval "test \"`echo '$''{'ac_cv_prog_MAKEINFO'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 ++$as_echo_n "checking for $ac_word... " >&6; } ++if ${ac_cv_prog_MAKEINFO+:} false; then : ++ $as_echo_n "(cached) " >&6 + else + if test -n "$MAKEINFO"; then + ac_cv_prog_MAKEINFO="$MAKEINFO" # Let the user override the test. + else +- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" +- ac_dummy="$PATH" +- for ac_dir in $ac_dummy; do +- test -z "$ac_dir" && ac_dir=. +- if test -f $ac_dir/$ac_word; then +- ac_cv_prog_MAKEINFO="$ac_prog" +- break +- fi ++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ for ac_exec_ext in '' $ac_executable_extensions; do ++ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ++ ac_cv_prog_MAKEINFO="$ac_prog" ++ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 ++ break 2 ++ fi ++done + done +- IFS="$ac_save_ifs" ++IFS=$as_save_IFS ++ + fi + fi +-MAKEINFO="$ac_cv_prog_MAKEINFO" ++MAKEINFO=$ac_cv_prog_MAKEINFO + if test -n "$MAKEINFO"; then +- echo "$ac_t""$MAKEINFO" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAKEINFO" >&5 ++$as_echo "$MAKEINFO" >&6; } + else +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi + +-test -n "$MAKEINFO" && break ++ ++ test -n "$MAKEINFO" && break + done + test -n "$MAKEINFO" || MAKEINFO=""false"" + +@@ -1704,95 +4312,405 @@ if test -f /usr/lib/NextStep/software_ve + else + system=`uname -s`-`uname -r` + if test "$?" -ne 0 ; then +- echo "$ac_t""unknown (can't find uname command)" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: unknown (can't find uname command)" >&5 ++$as_echo "unknown (can't find uname command)" >&6; } + system=unknown + else + # Special check for weird MP-RAS system (uname returns weird + # results, and the version is kept in special file). +- ++ + if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then +- system=MP-RAS-`${AWK} '{print $3}' /etc/.relid'` ++ system="MP-RAS-`${AWK} '{print $3}' '/etc/.relid'`" + fi + if test "`uname -s`" = "AIX" ; then + system=AIX-`uname -v`.`uname -r` + fi +- echo "$ac_t""$system" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $system" >&5 ++$as_echo "$system" >&6; } + fi + fi + +-# sysconf ++case $use in ++ *macosx) ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 ++$as_echo_n "checking for grep that handles long lines and -e... " >&6; } ++if ${ac_cv_path_GREP+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ if test -z "$GREP"; then ++ ac_path_GREP_found=false ++ # Loop through the user's path and test for each of PROGNAME-LIST ++ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ for ac_prog in grep ggrep; do ++ for ac_exec_ext in '' $ac_executable_extensions; do ++ ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" ++ { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue ++# Check for GNU ac_path_GREP and select it if it is found. ++ # Check for GNU $ac_path_GREP ++case `"$ac_path_GREP" --version 2>&1` in ++*GNU*) ++ ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; ++*) ++ ac_count=0 ++ $as_echo_n 0123456789 >"conftest.in" ++ while : ++ do ++ cat "conftest.in" "conftest.in" >"conftest.tmp" ++ mv "conftest.tmp" "conftest.in" ++ cp "conftest.in" "conftest.nl" ++ $as_echo 'GREP' >> "conftest.nl" ++ "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break ++ diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ++ as_fn_arith $ac_count + 1 && ac_count=$as_val ++ if test $ac_count -gt ${ac_path_GREP_max-0}; then ++ # Best one so far, save it but keep looking for a better one ++ ac_cv_path_GREP="$ac_path_GREP" ++ ac_path_GREP_max=$ac_count ++ fi ++ # 10*(2^10) chars as input seems more than enough ++ test $ac_count -gt 10 && break ++ done ++ rm -f conftest.in conftest.tmp conftest.nl conftest.out;; ++esac ++ ++ $ac_path_GREP_found && break 3 ++ done ++ done ++ done ++IFS=$as_save_IFS ++ if test -z "$ac_cv_path_GREP"; then ++ as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 ++ fi ++else ++ ac_cv_path_GREP=$GREP ++fi + +-ac_safe=`echo "unistd.h" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for unistd.h""... $ac_c" 1>&6 +-echo "configure:1728: checking for unistd.h" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:1738: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 ++$as_echo "$ac_cv_path_GREP" >&6; } ++ GREP="$ac_cv_path_GREP" ++ ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 ++$as_echo_n "checking for egrep... " >&6; } ++if ${ac_cv_path_EGREP+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 ++ then ac_cv_path_EGREP="$GREP -E" ++ else ++ if test -z "$EGREP"; then ++ ac_path_EGREP_found=false ++ # Loop through the user's path and test for each of PROGNAME-LIST ++ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ for ac_prog in egrep; do ++ for ac_exec_ext in '' $ac_executable_extensions; do ++ ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" ++ { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue ++# Check for GNU ac_path_EGREP and select it if it is found. ++ # Check for GNU $ac_path_EGREP ++case `"$ac_path_EGREP" --version 2>&1` in ++*GNU*) ++ ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; ++*) ++ ac_count=0 ++ $as_echo_n 0123456789 >"conftest.in" ++ while : ++ do ++ cat "conftest.in" "conftest.in" >"conftest.tmp" ++ mv "conftest.tmp" "conftest.in" ++ cp "conftest.in" "conftest.nl" ++ $as_echo 'EGREP' >> "conftest.nl" ++ "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break ++ diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ++ as_fn_arith $ac_count + 1 && ac_count=$as_val ++ if test $ac_count -gt ${ac_path_EGREP_max-0}; then ++ # Best one so far, save it but keep looking for a better one ++ ac_cv_path_EGREP="$ac_path_EGREP" ++ ac_path_EGREP_max=$ac_count ++ fi ++ # 10*(2^10) chars as input seems more than enough ++ test $ac_count -gt 10 && break ++ done ++ rm -f conftest.in conftest.tmp conftest.nl conftest.out;; ++esac ++ ++ $ac_path_EGREP_found && break 3 ++ done ++ done ++ done ++IFS=$as_save_IFS ++ if test -z "$ac_cv_path_EGREP"; then ++ as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 ++ fi ++else ++ ac_cv_path_EGREP=$EGREP ++fi ++ ++ fi ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 ++$as_echo "$ac_cv_path_EGREP" >&6; } ++ EGREP="$ac_cv_path_EGREP" ++ ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 ++$as_echo_n "checking for ANSI C header files... " >&6; } ++if ${ac_cv_header_stdc+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++#include ++#include ++#include ++ ++int ++main () ++{ ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ ac_cv_header_stdc=yes ++else ++ ac_cv_header_stdc=no ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++ ++if test $ac_cv_header_stdc = yes; then ++ # SunOS 4.x string.h does not declare mem*, contrary to ANSI. ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++ ++_ACEOF ++if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | ++ $EGREP "memchr" >/dev/null 2>&1; then : ++ ++else ++ ac_cv_header_stdc=no + fi + rm -f conftest* ++ + fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- echo $ac_n "checking for sysconf in -lc""... $ac_c" 1>&6 +-echo "configure:1755: checking for sysconf in -lc" >&5 +-ac_lib_var=`echo c'_'sysconf | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++ ++if test $ac_cv_header_stdc = yes; then ++ # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++ ++_ACEOF ++if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | ++ $EGREP "free" >/dev/null 2>&1; then : ++ + else +- ac_save_LIBS="$LIBS" +-LIBS="-lc $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" ++ ac_cv_header_stdc=no + fi + rm -f conftest* +-LIBS="$ac_save_LIBS" + + fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- echo $ac_n "checking "for _SC_CLK_TCK"""... $ac_c" 1>&6 +-echo "configure:1790: checking "for _SC_CLK_TCK"" >&5 +- if test "$cross_compiling" = yes; then ++ ++if test $ac_cv_header_stdc = yes; then ++ # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. ++ if test "$cross_compiling" = yes; then : ++ : ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++#include ++#if ((' ' & 0x0FF) == 0x020) ++# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') ++# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) ++#else ++# define ISLOWER(c) \ ++ (('a' <= (c) && (c) <= 'i') \ ++ || ('j' <= (c) && (c) <= 'r') \ ++ || ('s' <= (c) && (c) <= 'z')) ++# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) ++#endif ++ ++#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) ++int ++main () ++{ ++ int i; ++ for (i = 0; i < 256; i++) ++ if (XOR (islower (i), ISLOWER (i)) ++ || toupper (i) != TOUPPER (i)) ++ return 2; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ ++else ++ ac_cv_header_stdc=no ++fi ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++fi ++ ++fi ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 ++$as_echo "$ac_cv_header_stdc" >&6; } ++if test $ac_cv_header_stdc = yes; then ++ ++$as_echo "#define STDC_HEADERS 1" >>confdefs.h ++ ++fi ++ ++# On IRIX 5.3, sys/types and inttypes.h are conflicting. ++for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ ++ inttypes.h stdint.h unistd.h ++do : ++ as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ++ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default ++" ++if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : ++ cat >>confdefs.h <<_ACEOF ++#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 ++_ACEOF ++ ++fi ++ ++done ++ ++ ++ac_fn_c_check_header_mongrel "$LINENO" "malloc/malloc.h" "ac_cv_header_malloc_malloc_h" "$ac_includes_default" ++if test "x$ac_cv_header_malloc_malloc_h" = xyes; then : ++ ++else ++ as_fn_error $? "need malloc.h on macosx" "$LINENO" 5 ++fi ++ ++ ++ ac_fn_c_check_member "$LINENO" "struct _malloc_zone_t" "memalign" "ac_cv_member_struct__malloc_zone_t_memalign" " ++ #include ++ ++" ++if test "x$ac_cv_member_struct__malloc_zone_t_memalign" = xyes; then : ++ ++$as_echo "#define HAVE_MALLOC_ZONE_MEMALIGN 1" >>confdefs.h ++ ++fi ++ ++ ++ ;; ++esac ++ ++ ++ ++ ++# sysconf ++ ++ac_fn_c_check_header_mongrel "$LINENO" "unistd.h" "ac_cv_header_unistd_h" "$ac_includes_default" ++if test "x$ac_cv_header_unistd_h" = xyes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sysconf in -lc" >&5 ++$as_echo_n "checking for sysconf in -lc... " >&6; } ++if ${ac_cv_lib_c_sysconf+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ ac_check_lib_save_LIBS=$LIBS ++LIBS="-lc $LIBS" ++ ++# ac_fn_c_try_link LINENO ++# ----------------------- ++# Try to link conftest.$ac_ext, and return whether this succeeded. ++ac_fn_c_try_link () ++{ ++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ rm -f conftest.$ac_objext conftest$ac_exeext ++ if { { ac_try="$ac_link" ++case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_link") 2>conftest.err ++ ac_status=$? ++ if test -s conftest.err; then ++ grep -v '^ *+' conftest.err >conftest.er1 ++ cat conftest.er1 >&5 ++ mv -f conftest.er1 conftest.err ++ fi ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; } && { ++ test -z "$ac_c_werror_flag" || ++ test ! -s conftest.err ++ } && test -s conftest$ac_exeext && { ++ test "$cross_compiling" = yes || ++ $as_test_x conftest$ac_exeext ++ }; then : ++ ac_retval=0 ++else ++ $as_echo "$as_me: failed program was:" >&5 ++sed 's/^/| /' conftest.$ac_ext >&5 ++ ++ ac_retval=1 ++fi ++ # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information ++ # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would ++ # interfere with the next link command; also delete a directory that is ++ # left behind by Apple's compiler. We do this before executing the actions. ++ rm -rf conftest.dSYM conftest_ipa8_conftest.oo ++ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno ++ as_fn_set_status $ac_retval ++ ++} # ac_fn_c_try_link ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++/* Override any GCC internal prototype to avoid an error. ++ Use char because int might match the return type of a GCC ++ builtin and then its argument prototype would still apply. */ ++#ifdef __cplusplus ++extern "C" ++#endif ++char sysconf (); ++int ++main () ++{ ++return sysconf (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_c_sysconf=yes ++else ++ ac_cv_lib_c_sysconf=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_sysconf" >&5 ++$as_echo "$ac_cv_lib_c_sysconf" >&6; } ++if test "x$ac_cv_lib_c_sysconf" = xyes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking \"for _SC_CLK_TCK\"" >&5 ++$as_echo_n "checking \"for _SC_CLK_TCK\"... " >&6; } ++ if test "$cross_compiling" = yes; then : + hz=0 + else +- cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + #include + #include + int +@@ -1802,35 +4720,30 @@ else + fclose(fp); + return 0; + } +-EOF +-if { (eval echo configure:1807: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : + hz=`cat conftest1` +- cat >> confdefs.h <>confdefs.h <<_ACEOF + #define HZ $hz +-EOF ++_ACEOF ++ + +- + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* + hz=0 + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- echo "$ac_t""$hz" 1>&6 +-else +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hz" >&5 ++$as_echo "$hz" >&6; } + fi + +-else +- echo "$ac_t""no" 1>&6 + fi + + + ++ + #MY_SUBDIRS= + + # +@@ -1842,137 +4755,108 @@ rm -f makedefsafter + MP_INCLUDE="" + if test $use_gmp = yes ; then + +- GMPDIR=gmp3 + PATCHED_SYMBOLS="" + if test "$enable_dynsysgmp" = "yes" ; then +- ac_safe=`echo "gmp.h" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for gmp.h""... $ac_c" 1>&6 +-echo "configure:1851: checking for gmp.h" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:1861: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" +-fi +-rm -f conftest* +-fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- echo $ac_n "checking for __gmpz_init in -lgmp""... $ac_c" 1>&6 +-echo "configure:1878: checking for __gmpz_init in -lgmp" >&5 +-ac_lib_var=`echo gmp'_'__gmpz_init | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++ ac_fn_c_check_header_mongrel "$LINENO" "gmp.h" "ac_cv_header_gmp_h" "$ac_includes_default" ++if test "x$ac_cv_header_gmp_h" = xyes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __gmpz_init in -lgmp" >&5 ++$as_echo_n "checking for __gmpz_init in -lgmp... " >&6; } ++if ${ac_cv_lib_gmp___gmpz_init+:} false; then : ++ $as_echo_n "(cached) " >&6 + else +- ac_save_LIBS="$LIBS" ++ ac_check_lib_save_LIBS=$LIBS + LIBS="-lgmp $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- echo $ac_n "checking "for external gmp version"""... $ac_c" 1>&6 +-echo "configure:1913: checking "for external gmp version"" >&5 +- if test "$cross_compiling" = yes; then +- echo "Cannot use dynamic gmp lib" +-else +- cat > conftest.$ac_ext <&5 ++$as_echo "$ac_cv_lib_gmp___gmpz_init" >&6; } ++if test "x$ac_cv_lib_gmp___gmpz_init" = xyes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking \"for external gmp version\"" >&5 ++$as_echo_n "checking \"for external gmp version\"... " >&6; } ++ if test "$cross_compiling" = yes; then : ++ echo "Cannot use dynamic gmp lib" ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + #include + int main() { +- #if __GNU_MP_VERSION == 4 ++ #if __GNU_MP_VERSION == 4 || __GNU_MP_VERSION == 5 + return 0; + #else + return -1; + #endif + } +-EOF +-if { (eval echo configure:1929: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : + # MPFILES=$GMPDIR/mpn/mul_n.o + # PATCHED_SYMBOLS=__gmpn_toom3_mul_n + MPFILES= + PATCHED_SYMBOLS= +- if test "$use" = "m68k-linux" ; then +- MPFILES="$MPFILES $GMPDIR/mpn/lshift.o $GMPDIR/mpn/rshift.o" +- PATCHED_SYMBOLS="$PATCHED_SYMBOLS __gmpn_lshift __gmpn_rshift" +- fi ++# if test "$use" = "m68k-linux" ; then ++# MPFILES="$MPFILES $GMPDIR/mpn/lshift.o $GMPDIR/mpn/rshift.o" ++# PATCHED_SYMBOLS="$PATCHED_SYMBOLS __gmpn_lshift __gmpn_rshift" ++# fi + TLIBS="$TLIBS -lgmp" + echo "#include \"gmp.h\"" >foo.c + echo "int main() {return 0;}" >>foo.c + MP_INCLUDE=`cpp foo.c | grep /gmp.h | head -n 1 | $AWK '{print $3}' | tr -d '"'` + rm -f foo.c + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- echo "Cannot use dynamic gmp lib" ++ echo "Cannot use dynamic gmp lib" + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + else +- echo "$ac_t""no" 1>&6 +-echo "Cannot use dynamic gmp lib" ++ echo "Cannot use dynamic gmp lib" + fi + + else +- echo "$ac_t""no" 1>&6 +-echo "Cannot use dynamic gmp lib" ++ echo "Cannot use dynamic gmp lib" + fi + ++ + fi + + NEED_LOCAL_GMP='' +-if test "$MP_INCLUDE" = "" ; then ++if test "$MP_INCLUDE" = "" ; then + NEED_LOCAL_GMP=1; + fi +-if test "$PATCHED_SYMBOLS" != "" ; then ++if test "$PATCHED_SYMBOLS" != "" ; then + NEED_LOCAL_GMP=1; + fi + +-if test "$NEED_LOCAL_GMP" != "" ; then ++if test "$NEED_LOCAL_GMP" != "" ; then + +- echo $ac_n "checking use_gmp=yes, doing configure in gmp directory""... $ac_c" 1>&6 +-echo "configure:1976: checking use_gmp=yes, doing configure in gmp directory" >&5 ++ GMPDIR=gmp4 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking use_gmp=yes, doing configure in gmp directory" >&5 ++$as_echo_n "checking use_gmp=yes, doing configure in gmp directory... " >&6; } + echo + echo "#" + echo "#" +@@ -1982,11 +4866,11 @@ echo "configure:1976: checking use_gmp=y + echo "#" + + if test "$use_common_binary" = "yes"; then +- cd $GMPDIR && ./configure --host=$host && cd .. ++ cd $GMPDIR && ./configure --build=$host && cd .. + else + cd $GMPDIR && ./configure && cd .. + fi +- #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" ++ #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" + + echo "#" + echo "#" +@@ -2003,45 +4887,49 @@ echo "configure:1976: checking use_gmp=y + + fi + +-echo $ac_n "checking "for leading underscore in object symbols"""... $ac_c" 1>&6 +-echo "configure:2008: checking "for leading underscore in object symbols"" >&5 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking \"for leading underscore in object symbols\"" >&5 ++$as_echo_n "checking \"for leading underscore in object symbols\"... " >&6; } + cat>foo.c < +-int main() {double d=0.0;cos(d);return 0;} ++#include ++int main() {FILE *f;double d=0.0;getc(f);cos(d);return 0;} + EOFF + $CC -c foo.c -o foo.o +-if nm foo.o |grep " U " | grep "_cos" >/dev/null ; then ++if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then + LEADING_UNDERSCORE=1 +- echo "$ac_t"""yes"" 1>&6 ++ $as_echo "#define LEADING_UNDERSCORE 1" >>confdefs.h ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 ++$as_echo "\"yes\"" >&6; } + else + LEADING_UNDERSCORE="" +- echo "$ac_t"""no"" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 ++$as_echo "\"no\"" >&6; } + fi +-echo $ac_n "checking "for GNU ld option -Map"""... $ac_c" 1>&6 +-echo "configure:2022: checking "for GNU ld option -Map"" >&5 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking \"for GNU ld option -Map\"" >&5 ++$as_echo_n "checking \"for GNU ld option -Map\"... " >&6; } + touch map + $CC -o foo -Wl,-Map map foo.o >/dev/null 2>&1 + if test `cat map | wc -l` != "0" ; then +- echo "$ac_t"""yes"" 1>&6 +- cat >> confdefs.h <<\EOF +-#define HAVE_GNU_LD 1 +-EOF ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 ++$as_echo "\"yes\"" >&6; } ++ $as_echo "#define HAVE_GNU_LD 1" >>confdefs.h + + GNU_LD=1 + else +- echo "$ac_t"""no"" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 ++$as_echo "\"no\"" >&6; } + GNU_LD= + fi + rm -f foo.c foo.o foo map + +- echo $ac_n "checking "for size of gmp limbs"""... $ac_c" 1>&6 +-echo "configure:2039: checking "for size of gmp limbs"" >&5 +- if test "$cross_compiling" = yes; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking \"for size of gmp limbs\"" >&5 ++$as_echo_n "checking \"for size of gmp limbs\"... " >&6; } ++ if test "$cross_compiling" = yes; then : + mpsize=0 + else +- cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + #include + #include "$MP_INCLUDE" + int main() { +@@ -2050,37 +4938,35 @@ else + fclose(fp); + return 0; + } +-EOF +-if { (eval echo configure:2055: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : + mpsize=`cat conftest1` + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* + mpsize=0 + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + if test "$mpsize" = "0" ; then + echo "Cannot determine mpsize" + exit 1 + fi +- cat >> confdefs.h <>confdefs.h <<_ACEOF + #define MP_LIMB_BYTES $mpsize +-EOF ++_ACEOF + +- echo "$ac_t""$mpsize" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $mpsize" >&5 ++$as_echo "$mpsize" >&6; } + +- echo $ac_n "checking "_SHORT_LIMB"""... $ac_c" 1>&6 +-echo "configure:2078: checking "_SHORT_LIMB"" >&5 +- if test "$cross_compiling" = yes; then +- echo "$ac_t""no" 1>&6 +-else +- cat > conftest.$ac_ext <&5 ++$as_echo_n "checking \"_SHORT_LIMB\"... " >&6; } ++ if test "$cross_compiling" = yes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + #include + #include "$MP_INCLUDE" + int main() { +@@ -2090,30 +4976,27 @@ else + return 1; + #endif + } +-EOF +-if { (eval echo configure:2095: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- cat >> confdefs.h <<\EOF +-#define __SHORT_LIMB 1 +-EOF +- echo "$ac_t""yes" 1>&6 ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ $as_echo "#define __SHORT_LIMB 1" >>confdefs.h ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ++fi ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++fi ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking \"_LONG_LONG_LIMB\"" >&5 ++$as_echo_n "checking \"_LONG_LONG_LIMB\"... " >&6; } ++ if test "$cross_compiling" = yes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- echo "$ac_t""no" 1>&6 +-fi +-rm -fr conftest* +-fi +- +- echo $ac_n "checking "_LONG_LONG_LIMB"""... $ac_c" 1>&6 +-echo "configure:2111: checking "_LONG_LONG_LIMB"" >&5 +- if test "$cross_compiling" = yes; then +- echo "$ac_t""no" 1>&6 +-else +- cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + #include + #include "$MP_INCLUDE" + int main() { +@@ -2123,30 +5006,25 @@ else + return 1; + #endif + } +-EOF +-if { (eval echo configure:2128: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- cat >> confdefs.h <<\EOF +-#define __LONG_LONG_LIMB 1 +-EOF +- echo "$ac_t""yes" 1>&6 ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ $as_echo "#define __LONG_LONG_LIMB 1" >>confdefs.h ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + + GMP=1 +- cat >> confdefs.h <<\EOF +-#define GMP 1 +-EOF ++ $as_echo "#define GMP 1" >>confdefs.h ++ ++ + +- +- + echo > makedefsafter + echo "MPFILES=$MPFILES" >> makedefsafter + echo "PATCHED_SYMBOLS=$PATCHED_SYMBOLS" >> makedefsafter +@@ -2156,19 +5034,17 @@ fi + + # + # X windows +-# ++# + +-# If we find X, set shell vars x_includes and x_libraries to the +-# paths, otherwise set no_x=yes. +-# Uses ac_ vars as temps to allow command line to override cache and checks. +-# --without-x overrides everything else, but does not touch the cache. +-echo $ac_n "checking for X""... $ac_c" 1>&6 +-echo "configure:2167: checking for X" >&5 +- +-# Check whether --with-x or --without-x was given. +-if test "${with_x+set}" = set; then +- withval="$with_x" +- : ++if test "$enable_xgcl" = "yes" ; then ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5 ++$as_echo_n "checking for X... " >&6; } ++ ++ ++# Check whether --with-x was given. ++if test "${with_x+set}" = set; then : ++ withval=$with_x; + fi + + # $have_x is `yes', `no', `disabled', or empty when we do not yet know. +@@ -2176,1018 +5052,243 @@ if test "x$with_x" = xno; then + # The user explicitly disabled X. + have_x=disabled + else +- if test "x$x_includes" != xNONE && test "x$x_libraries" != xNONE; then +- # Both variables are already set. +- have_x=yes +- else +-if eval "test \"`echo '$''{'ac_cv_have_x'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++ case $x_includes,$x_libraries in #( ++ *\'*) as_fn_error $? "cannot use X directory names containing '" "$LINENO" 5;; #( ++ *,NONE | NONE,*) if ${ac_cv_have_x+:} false; then : ++ $as_echo_n "(cached) " >&6 + else + # One or both of the vars are not set, and there is no cached value. +-ac_x_includes=NO ac_x_libraries=NO +-rm -fr conftestdir +-if mkdir conftestdir; then +- cd conftestdir +- # Make sure to not put "make" in the Imakefile rules, since we grep it out. +- cat > Imakefile <<'EOF' +-acfindx: +- @echo 'ac_im_incroot="${INCROOT}"; ac_im_usrlibdir="${USRLIBDIR}"; ac_im_libdir="${LIBDIR}"' +-EOF +- if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then +- # GNU make sometimes prints "make[1]: Entering...", which would confuse us. +- eval `${MAKE-make} acfindx 2>/dev/null | grep -v make` ++ac_x_includes=no ac_x_libraries=no ++rm -f -r conftest.dir ++if mkdir conftest.dir; then ++ cd conftest.dir ++ cat >Imakefile <<'_ACEOF' ++incroot: ++ @echo incroot='${INCROOT}' ++usrlibdir: ++ @echo usrlibdir='${USRLIBDIR}' ++libdir: ++ @echo libdir='${LIBDIR}' ++_ACEOF ++ if (export CC; ${XMKMF-xmkmf}) >/dev/null 2>/dev/null && test -f Makefile; then ++ # GNU make sometimes prints "make[1]: Entering ...", which would confuse us. ++ for ac_var in incroot usrlibdir libdir; do ++ eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`" ++ done + # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR. +- for ac_extension in a so sl; do +- if test ! -f $ac_im_usrlibdir/libX11.$ac_extension && +- test -f $ac_im_libdir/libX11.$ac_extension; then +- ac_im_usrlibdir=$ac_im_libdir; break ++ for ac_extension in a so sl dylib la dll; do ++ if test ! -f "$ac_im_usrlibdir/libX11.$ac_extension" && ++ test -f "$ac_im_libdir/libX11.$ac_extension"; then ++ ac_im_usrlibdir=$ac_im_libdir; break + fi + done + # Screen out bogus values from the imake configuration. They are + # bogus both because they are the default anyway, and because + # using them would break gcc on systems where it needs fixed includes. +- case "$ac_im_incroot" in +- /usr/include) ;; +- *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes="$ac_im_incroot" ;; ++ case $ac_im_incroot in ++ /usr/include) ac_x_includes= ;; ++ *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes=$ac_im_incroot;; + esac +- case "$ac_im_usrlibdir" in +- /usr/lib | /lib) ;; +- *) test -d "$ac_im_usrlibdir" && ac_x_libraries="$ac_im_usrlibdir" ;; ++ case $ac_im_usrlibdir in ++ /usr/lib | /usr/lib64 | /lib | /lib64) ;; ++ *) test -d "$ac_im_usrlibdir" && ac_x_libraries=$ac_im_usrlibdir ;; + esac + fi + cd .. +- rm -fr conftestdir ++ rm -f -r conftest.dir + fi + +-if test "$ac_x_includes" = NO; then +- # Guess where to find include files, by looking for this one X11 .h file. +- test -z "$x_direct_test_include" && x_direct_test_include=X11/Intrinsic.h ++# Standard set of common directories for X headers. ++# Check X11 before X11Rn because it is often a symlink to the current release. ++ac_x_header_dirs=' ++/usr/X11/include ++/usr/X11R7/include ++/usr/X11R6/include ++/usr/X11R5/include ++/usr/X11R4/include ++ ++/usr/include/X11 ++/usr/include/X11R7 ++/usr/include/X11R6 ++/usr/include/X11R5 ++/usr/include/X11R4 ++ ++/usr/local/X11/include ++/usr/local/X11R7/include ++/usr/local/X11R6/include ++/usr/local/X11R5/include ++/usr/local/X11R4/include ++ ++/usr/local/include/X11 ++/usr/local/include/X11R7 ++/usr/local/include/X11R6 ++/usr/local/include/X11R5 ++/usr/local/include/X11R4 ++ ++/usr/X386/include ++/usr/x386/include ++/usr/XFree86/include/X11 ++ ++/usr/include ++/usr/local/include ++/usr/unsupported/include ++/usr/athena/include ++/usr/local/x11r5/include ++/usr/lpp/Xamples/include ++ ++/usr/openwin/include ++/usr/openwin/share/include' + ++if test "$ac_x_includes" = no; then ++ # Guess where to find include files, by looking for Xlib.h. + # First, try using that file with no special directory specified. +-cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:2234: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++_ACEOF ++if ac_fn_c_try_cpp "$LINENO"; then : + # We can compile using X headers with no special include directory. + ac_x_includes= + else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- # Look for the header file in a standard set of common directories. +-# Check X11 before X11Rn because it is often a symlink to the current release. +- for ac_dir in \ +- /usr/X11/include \ +- /usr/X11R6/include \ +- /usr/X11R5/include \ +- /usr/X11R4/include \ +- \ +- /usr/include/X11 \ +- /usr/include/X11R6 \ +- /usr/include/X11R5 \ +- /usr/include/X11R4 \ +- \ +- /usr/local/X11/include \ +- /usr/local/X11R6/include \ +- /usr/local/X11R5/include \ +- /usr/local/X11R4/include \ +- \ +- /usr/local/include/X11 \ +- /usr/local/include/X11R6 \ +- /usr/local/include/X11R5 \ +- /usr/local/include/X11R4 \ +- \ +- /usr/X386/include \ +- /usr/x386/include \ +- /usr/XFree86/include/X11 \ +- \ +- /usr/include \ +- /usr/local/include \ +- /usr/unsupported/include \ +- /usr/athena/include \ +- /usr/local/x11r5/include \ +- /usr/lpp/Xamples/include \ +- \ +- /usr/openwin/include \ +- /usr/openwin/share/include \ +- ; \ +- do +- if test -r "$ac_dir/$x_direct_test_include"; then +- ac_x_includes=$ac_dir +- break +- fi +- done ++ for ac_dir in $ac_x_header_dirs; do ++ if test -r "$ac_dir/X11/Xlib.h"; then ++ ac_x_includes=$ac_dir ++ break ++ fi ++done + fi +-rm -f conftest* +-fi # $ac_x_includes = NO ++rm -f conftest.err conftest.i conftest.$ac_ext ++fi # $ac_x_includes = no + +-if test "$ac_x_libraries" = NO; then ++if test "$ac_x_libraries" = no; then + # Check for the libraries. +- +- test -z "$x_direct_test_library" && x_direct_test_library=Xt +- test -z "$x_direct_test_function" && x_direct_test_function=XtMalloc +- + # See if we find them without any special options. + # Don't add to $LIBS permanently. +- ac_save_LIBS="$LIBS" +- LIBS="-l$x_direct_test_library $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- LIBS="$ac_save_LIBS" ++ ac_save_LIBS=$LIBS ++ LIBS="-lX11 $LIBS" ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++int ++main () ++{ ++XrmInitialize () ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ LIBS=$ac_save_LIBS + # We can link X programs with no special library path. + ac_x_libraries= + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- LIBS="$ac_save_LIBS" +-# First see if replacing the include by lib works. +-# Check X11 before X11Rn because it is often a symlink to the current release. +-for ac_dir in `echo "$ac_x_includes" | sed s/include/lib/` \ +- /usr/X11/lib \ +- /usr/X11R6/lib \ +- /usr/X11R5/lib \ +- /usr/X11R4/lib \ +- \ +- /usr/lib/X11 \ +- /usr/lib/X11R6 \ +- /usr/lib/X11R5 \ +- /usr/lib/X11R4 \ +- \ +- /usr/local/X11/lib \ +- /usr/local/X11R6/lib \ +- /usr/local/X11R5/lib \ +- /usr/local/X11R4/lib \ +- \ +- /usr/local/lib/X11 \ +- /usr/local/lib/X11R6 \ +- /usr/local/lib/X11R5 \ +- /usr/local/lib/X11R4 \ +- \ +- /usr/X386/lib \ +- /usr/x386/lib \ +- /usr/XFree86/lib/X11 \ +- \ +- /usr/lib \ +- /usr/local/lib \ +- /usr/unsupported/lib \ +- /usr/athena/lib \ +- /usr/local/x11r5/lib \ +- /usr/lpp/Xamples/lib \ +- /lib/usr/lib/X11 \ +- \ +- /usr/openwin/lib \ +- /usr/openwin/share/lib \ +- ; \ ++ LIBS=$ac_save_LIBS ++for ac_dir in `$as_echo "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g` + do +- for ac_extension in a so sl; do +- if test -r $ac_dir/lib${x_direct_test_library}.$ac_extension; then ++ # Don't even attempt the hair of trying to link an X program! ++ for ac_extension in a so sl dylib la dll; do ++ if test -r "$ac_dir/libX11.$ac_extension"; then + ac_x_libraries=$ac_dir + break 2 + fi + done + done + fi +-rm -f conftest* +-fi # $ac_x_libraries = NO +- +-if test "$ac_x_includes" = NO || test "$ac_x_libraries" = NO; then +- # Didn't find X anywhere. Cache the known absence of X. +- ac_cv_have_x="have_x=no" +-else +- # Record where we found X for the cache. +- ac_cv_have_x="have_x=yes \ +- ac_x_includes=$ac_x_includes ac_x_libraries=$ac_x_libraries" +-fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++fi # $ac_x_libraries = no ++ ++case $ac_x_includes,$ac_x_libraries in #( ++ no,* | *,no | *\'*) ++ # Didn't find X, or a directory has "'" in its name. ++ ac_cv_have_x="have_x=no";; #( ++ *) ++ # Record where we found X for the cache. ++ ac_cv_have_x="have_x=yes\ ++ ac_x_includes='$ac_x_includes'\ ++ ac_x_libraries='$ac_x_libraries'" ++esac + fi +- fi ++;; #( ++ *) have_x=yes;; ++ esac + eval "$ac_cv_have_x" + fi # $with_x != no + + if test "$have_x" != yes; then +- echo "$ac_t""$have_x" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $have_x" >&5 ++$as_echo "$have_x" >&6; } + no_x=yes + else + # If each of the values was on the command line, it overrides each guess. + test "x$x_includes" = xNONE && x_includes=$ac_x_includes + test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries + # Update the cache value to reflect the command line values. +- ac_cv_have_x="have_x=yes \ +- ac_x_includes=$x_includes ac_x_libraries=$x_libraries" +- echo "$ac_t""libraries $x_libraries, headers $x_includes" 1>&6 +-fi +- +-if test "$no_x" = yes; then +- # Not all programs may use this symbol, but it does not hurt to define it. +- cat >> confdefs.h <<\EOF +-#define X_DISPLAY_MISSING 1 +-EOF +- +- X_CFLAGS= X_PRE_LIBS= X_LIBS= X_EXTRA_LIBS= ++ ac_cv_have_x="have_x=yes\ ++ ac_x_includes='$x_includes'\ ++ ac_x_libraries='$x_libraries'" ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: libraries $x_libraries, headers $x_includes" >&5 ++$as_echo "libraries $x_libraries, headers $x_includes" >&6; } ++fi ++ ++# AC_PATH_XTRA ++# echo $X_CFLAGS ++# echo $X_LIBS ++# echo $X_EXTRA_LIBS ++# echo $X_PRE_LIBS ++ ++ miss=0 ++# AC_CHECK_LIB(Xmu,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#FIXME remove these ++# AC_CHECK_LIB(Xt,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) ++# AC_CHECK_LIB(Xext,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) ++# AC_CHECK_LIB(Xaw,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#until here ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lX11" >&5 ++$as_echo_n "checking for main in -lX11... " >&6; } ++if ${ac_cv_lib_X11_main+:} false; then : ++ $as_echo_n "(cached) " >&6 + else +- if test -n "$x_includes"; then +- X_CFLAGS="$X_CFLAGS -I$x_includes" +- fi +- +- # It would also be nice to do this for all -L options, not just this one. +- if test -n "$x_libraries"; then +- X_LIBS="$X_LIBS -L$x_libraries" +- # For Solaris; some versions of Sun CC require a space after -R and +- # others require no space. Words are not sufficient . . . . +- case "`(uname -sr) 2>/dev/null`" in +- "SunOS 5"*) +- echo $ac_n "checking whether -R must be followed by a space""... $ac_c" 1>&6 +-echo "configure:2416: checking whether -R must be followed by a space" >&5 +- ac_xsave_LIBS="$LIBS"; LIBS="$LIBS -R$x_libraries" +- cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- ac_R_nospace=yes +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- ac_R_nospace=no +-fi +-rm -f conftest* +- if test $ac_R_nospace = yes; then +- echo "$ac_t""no" 1>&6 +- X_LIBS="$X_LIBS -R$x_libraries" +- else +- LIBS="$ac_xsave_LIBS -R $x_libraries" +- cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- ac_R_space=yes +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- ac_R_space=no +-fi +-rm -f conftest* +- if test $ac_R_space = yes; then +- echo "$ac_t""yes" 1>&6 +- X_LIBS="$X_LIBS -R $x_libraries" +- else +- echo "$ac_t""neither works" 1>&6 +- fi +- fi +- LIBS="$ac_xsave_LIBS" +- esac +- fi +- +- # Check for system-dependent libraries X programs must link with. +- # Do this before checking for the system-independent R6 libraries +- # (-lICE), since we may need -lsocket or whatever for X linking. +- +- if test "$ISC" = yes; then +- X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl_s -linet" +- else +- # Martyn.Johnson@cl.cam.ac.uk says this is needed for Ultrix, if the X +- # libraries were built with DECnet support. And karl@cs.umb.edu says +- # the Alpha needs dnet_stub (dnet does not exist). +- echo $ac_n "checking for dnet_ntoa in -ldnet""... $ac_c" 1>&6 +-echo "configure:2481: checking for dnet_ntoa in -ldnet" >&5 +-ac_lib_var=`echo dnet'_'dnet_ntoa | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- ac_save_LIBS="$LIBS" +-LIBS="-ldnet $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" +- +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet" +-else +- echo "$ac_t""no" 1>&6 +-fi +- +- if test $ac_cv_lib_dnet_dnet_ntoa = no; then +- echo $ac_n "checking for dnet_ntoa in -ldnet_stub""... $ac_c" 1>&6 +-echo "configure:2522: checking for dnet_ntoa in -ldnet_stub" >&5 +-ac_lib_var=`echo dnet_stub'_'dnet_ntoa | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- ac_save_LIBS="$LIBS" +-LIBS="-ldnet_stub $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" +- +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet_stub" +-else +- echo "$ac_t""no" 1>&6 +-fi +- +- fi +- +- # msh@cis.ufl.edu says -lnsl (and -lsocket) are needed for his 386/AT, +- # to get the SysV transport functions. +- # chad@anasazi.com says the Pyramis MIS-ES running DC/OSx (SVR4) +- # needs -lnsl. +- # The nsl library prevents programs from opening the X display +- # on Irix 5.2, according to dickey@clark.net. +- echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6 +-echo "configure:2570: checking for gethostbyname" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char gethostbyname(); +- +-int main() { +- +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname) +-choke me +-#else +-gethostbyname(); +-#endif +- +-; return 0; } +-EOF +-if { (eval echo configure:2598: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_gethostbyname=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_gethostbyname=no" +-fi +-rm -f conftest* +-fi +- +-if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- : +-else +- echo "$ac_t""no" 1>&6 +-fi +- +- if test $ac_cv_func_gethostbyname = no; then +- echo $ac_n "checking for gethostbyname in -lnsl""... $ac_c" 1>&6 +-echo "configure:2619: checking for gethostbyname in -lnsl" >&5 +-ac_lib_var=`echo nsl'_'gethostbyname | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- ac_save_LIBS="$LIBS" +-LIBS="-lnsl $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" +- +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl" +-else +- echo "$ac_t""no" 1>&6 +-fi +- +- fi +- +- # lieder@skyler.mavd.honeywell.com says without -lsocket, +- # socket/setsockopt and other routines are undefined under SCO ODT +- # 2.0. But -lsocket is broken on IRIX 5.2 (and is not necessary +- # on later versions), says simon@lia.di.epfl.ch: it contains +- # gethostby* variants that don't use the nameserver (or something). +- # -lsocket must be given before -lnsl if both are needed. +- # We assume that if connect needs -lnsl, so does gethostbyname. +- echo $ac_n "checking for connect""... $ac_c" 1>&6 +-echo "configure:2668: checking for connect" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char connect(); +- +-int main() { +- +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_connect) || defined (__stub___connect) +-choke me +-#else +-connect(); +-#endif +- +-; return 0; } +-EOF +-if { (eval echo configure:2696: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_connect=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_connect=no" +-fi +-rm -f conftest* +-fi +- +-if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- : +-else +- echo "$ac_t""no" 1>&6 +-fi +- +- if test $ac_cv_func_connect = no; then +- echo $ac_n "checking for connect in -lsocket""... $ac_c" 1>&6 +-echo "configure:2717: checking for connect in -lsocket" >&5 +-ac_lib_var=`echo socket'_'connect | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- ac_save_LIBS="$LIBS" +-LIBS="-lsocket $X_EXTRA_LIBS $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" +- +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- X_EXTRA_LIBS="-lsocket $X_EXTRA_LIBS" +-else +- echo "$ac_t""no" 1>&6 +-fi +- +- fi +- +- # gomez@mi.uni-erlangen.de says -lposix is necessary on A/UX. +- echo $ac_n "checking for remove""... $ac_c" 1>&6 +-echo "configure:2760: checking for remove" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_remove'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char remove(); +- +-int main() { +- +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_remove) || defined (__stub___remove) +-choke me +-#else +-remove(); +-#endif +- +-; return 0; } +-EOF +-if { (eval echo configure:2788: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_remove=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_remove=no" +-fi +-rm -f conftest* +-fi +- +-if eval "test \"`echo '$ac_cv_func_'remove`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- : +-else +- echo "$ac_t""no" 1>&6 +-fi +- +- if test $ac_cv_func_remove = no; then +- echo $ac_n "checking for remove in -lposix""... $ac_c" 1>&6 +-echo "configure:2809: checking for remove in -lposix" >&5 +-ac_lib_var=`echo posix'_'remove | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- ac_save_LIBS="$LIBS" +-LIBS="-lposix $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" +- +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- X_EXTRA_LIBS="$X_EXTRA_LIBS -lposix" +-else +- echo "$ac_t""no" 1>&6 +-fi +- +- fi +- +- # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay. +- echo $ac_n "checking for shmat""... $ac_c" 1>&6 +-echo "configure:2852: checking for shmat" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_shmat'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char shmat(); +- +-int main() { +- +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_shmat) || defined (__stub___shmat) +-choke me +-#else +-shmat(); +-#endif +- +-; return 0; } +-EOF +-if { (eval echo configure:2880: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_shmat=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_shmat=no" +-fi +-rm -f conftest* +-fi +- +-if eval "test \"`echo '$ac_cv_func_'shmat`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- : +-else +- echo "$ac_t""no" 1>&6 +-fi +- +- if test $ac_cv_func_shmat = no; then +- echo $ac_n "checking for shmat in -lipc""... $ac_c" 1>&6 +-echo "configure:2901: checking for shmat in -lipc" >&5 +-ac_lib_var=`echo ipc'_'shmat | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- ac_save_LIBS="$LIBS" +-LIBS="-lipc $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" +- +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- X_EXTRA_LIBS="$X_EXTRA_LIBS -lipc" +-else +- echo "$ac_t""no" 1>&6 +-fi +- +- fi +- fi +- +- # Check for libraries that X11R6 Xt/Xaw programs need. +- ac_save_LDFLAGS="$LDFLAGS" +- test -n "$x_libraries" && LDFLAGS="$LDFLAGS -L$x_libraries" +- # SM needs ICE to (dynamically) link under SunOS 4.x (so we have to +- # check for ICE first), but we must link in the order -lSM -lICE or +- # we get undefined symbols. So assume we have SM if we have ICE. +- # These have to be linked with before -lX11, unlike the other +- # libraries we check for below, so use a different variable. +- # --interran@uluru.Stanford.EDU, kb@cs.umb.edu. +- echo $ac_n "checking for IceConnectionNumber in -lICE""... $ac_c" 1>&6 +-echo "configure:2953: checking for IceConnectionNumber in -lICE" >&5 +-ac_lib_var=`echo ICE'_'IceConnectionNumber | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- ac_save_LIBS="$LIBS" +-LIBS="-lICE $X_EXTRA_LIBS $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" +- +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- X_PRE_LIBS="$X_PRE_LIBS -lSM -lICE" +-else +- echo "$ac_t""no" 1>&6 +-fi +- +- LDFLAGS="$ac_save_LDFLAGS" +- +-fi +- +-echo $X_CFLAGS +-echo $X_LIBS +-echo $X_EXTRA_LIBS +-echo $X_PRE_LIBS +- +-miss=0 +-echo $ac_n "checking for main in -lXmu""... $ac_c" 1>&6 +-echo "configure:3003: checking for main in -lXmu" >&5 +-ac_lib_var=`echo Xmu'_'main | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- ac_save_LIBS="$LIBS" +-LIBS="-lXmu $X_LIBS $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" +- +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- X_LIBS="$X_LIBS -lXmu" +-else +- echo "$ac_t""no" 1>&6 +-miss=1 +-fi +- +-echo $ac_n "checking for main in -lXt""... $ac_c" 1>&6 +-echo "configure:3040: checking for main in -lXt" >&5 +-ac_lib_var=`echo Xt'_'main | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- ac_save_LIBS="$LIBS" +-LIBS="-lXt $X_LIBS $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" +- +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- X_LIBS="$X_LIBS -lXt" +-else +- echo "$ac_t""no" 1>&6 +-miss=1 +-fi +- +-echo $ac_n "checking for main in -lXext""... $ac_c" 1>&6 +-echo "configure:3077: checking for main in -lXext" >&5 +-ac_lib_var=`echo Xext'_'main | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- ac_save_LIBS="$LIBS" +-LIBS="-lXext $X_LIBS $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" +- +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- X_LIBS="$X_LIBS -lXext" +-else +- echo "$ac_t""no" 1>&6 +-miss=1 +-fi +- +-echo $ac_n "checking for main in -lXaw""... $ac_c" 1>&6 +-echo "configure:3114: checking for main in -lXaw" >&5 +-ac_lib_var=`echo Xaw'_'main | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- ac_save_LIBS="$LIBS" +-LIBS="-lXaw $X_LIBS $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" +- +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- X_LIBS="$X_LIBS -lXaw" +-else +- echo "$ac_t""no" 1>&6 +-miss=1 +-fi +- +-echo $ac_n "checking for main in -lX11""... $ac_c" 1>&6 +-echo "configure:3151: checking for main in -lX11" >&5 +-ac_lib_var=`echo X11'_'main | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- ac_save_LIBS="$LIBS" ++ ac_check_lib_save_LIBS=$LIBS + LIBS="-lX11 $X_LIBS $LIBS" +-cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + +-int main() { +-main() +-; return 0; } +-EOF +-if { (eval echo configure:3166: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" + +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 ++int ++main () ++{ ++return main (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_X11_main=yes ++else ++ ac_cv_lib_X11_main=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_X11_main" >&5 ++$as_echo "$ac_cv_lib_X11_main" >&6; } ++if test "x$ac_cv_lib_X11_main" = xyes; then : + X_LIBS="$X_LIBS -lX11" + else +- echo "$ac_t""no" 1>&6 +-miss=1 ++ miss=1 + fi + +- +-if test "$miss" = "1" ; then +- X_CFLAGS= +- X_LIBS= +- echo missing x libraries -- cannot compile xgcl ++ ++ if test "$miss" = "1" ; then ++ X_CFLAGS= ++ X_LIBS= ++ X_EXTRA_LIBS= ++ X_PRE_LIBS= ++ echo missing x libraries -- cannot compile xgcl ++ else ++ $as_echo "#define HAVE_XGCL 1" >>confdefs.h ++ ++ fi + fi + + +@@ -3200,45 +5301,46 @@ fi + + if test "$enable_dlopen" = "yes" ; then + +- echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6 +-echo "configure:3205: checking for dlopen in -ldl" >&5 +-ac_lib_var=`echo dl'_'dlopen | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 ++$as_echo_n "checking for dlopen in -ldl... " >&6; } ++if ${ac_cv_lib_dl_dlopen+:} false; then : ++ $as_echo_n "(cached) " >&6 + else +- ac_save_LIBS="$LIBS" ++ ac_check_lib_save_LIBS=$LIBS + LIBS="-ldl $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 ++/* Override any GCC internal prototype to avoid an error. ++ Use char because int might match the return type of a GCC ++ builtin and then its argument prototype would still apply. */ ++#ifdef __cplusplus ++extern "C" ++#endif ++char dlopen (); ++int ++main () ++{ ++return dlopen (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_dl_dlopen=yes ++else ++ ac_cv_lib_dl_dlopen=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 ++$as_echo "$ac_cv_lib_dl_dlopen" >&6; } ++if test "x$ac_cv_lib_dl_dlopen" = xyes; then : + have_dl=1 + else +- echo "$ac_t""no" 1>&6 +-have_dl=0 ++ have_dl=0 + fi + + if test "$have_dl" = "0" ; then +@@ -3247,312 +5349,310 @@ fi + fi + + TLIBS="$TLIBS -ldl -rdynamic" +- cat >> confdefs.h <<\EOF +-#define USE_DLOPEN 1 +-EOF ++ $as_echo "#define USE_DLOPEN 1" >>confdefs.h + + fi + + if test "$enable_statsysbfd" = "yes" || test "$enable_dynsysbfd" = "yes" ; then +- ac_safe=`echo "bfd.h" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for bfd.h""... $ac_c" 1>&6 +-echo "configure:3260: checking for bfd.h" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:3270: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" +-fi +-rm -f conftest* +-fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- echo $ac_n "checking for bfd_init in -lbfd""... $ac_c" 1>&6 +-echo "configure:3287: checking for bfd_init in -lbfd" >&5 +-ac_lib_var=`echo bfd'_'bfd_init | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++ ac_fn_c_check_header_mongrel "$LINENO" "bfd.h" "ac_cv_header_bfd_h" "$ac_includes_default" ++if test "x$ac_cv_header_bfd_h" = xyes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_init in -lbfd" >&5 ++$as_echo_n "checking for bfd_init in -lbfd... " >&6; } ++if ${ac_cv_lib_bfd_bfd_init+:} false; then : ++ $as_echo_n "(cached) " >&6 + else +- ac_save_LIBS="$LIBS" ++ ac_check_lib_save_LIBS=$LIBS + LIBS="-lbfd -liberty $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 ++/* Override any GCC internal prototype to avoid an error. ++ Use char because int might match the return type of a GCC ++ builtin and then its argument prototype would still apply. */ ++#ifdef __cplusplus ++extern "C" ++#endif ++char bfd_init (); ++int ++main () ++{ ++return bfd_init (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_bfd_bfd_init=yes ++else ++ ac_cv_lib_bfd_bfd_init=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_init" >&5 ++$as_echo "$ac_cv_lib_bfd_bfd_init" >&6; } ++if test "x$ac_cv_lib_bfd_bfd_init" = xyes; then : + # + # Old binutils appear to need CONST defined to const + # +- echo $ac_n "checking if need to define CONST for bfd""... $ac_c" 1>&6 +-echo "configure:3325: checking if need to define CONST for bfd" >&5 +- if test "$cross_compiling" = yes; then +- echo "$ac_t""cannot use bfd" 1>&6 exit 1; +-else +- cat > conftest.$ac_ext <&5 ++$as_echo_n "checking if need to define CONST for bfd... " >&6; } ++ if test "$cross_compiling" = yes; then : ++ as_fn_error $? "cannot use bfd" "$LINENO" 5 ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + #define IN_GCC + #include + int main() { symbol_info t; return 0;} +-EOF +-if { (eval echo configure:3336: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- echo "$ac_t""no" 1>&6 +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- if test "$cross_compiling" = yes; then +- echo "$ac_t""cannot use bfd" 1>&6 exit 1; ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ++else ++ if test "$cross_compiling" = yes; then : ++ as_fn_error $? "cannot use bfd" "$LINENO" 5 + else +- cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + #define CONST const + #define IN_GCC + #include + int main() {symbol_info t; return 0;} +-EOF +-if { (eval echo configure:3354: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- echo "$ac_t""yes" 1>&6 +- cat >> confdefs.h <<\EOF +-#define NEED_CONST 1 +-EOF ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++ $as_echo "#define NEED_CONST 1" >>confdefs.h + + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- echo "$ac_t""cannot use bfd" 1>&6 exit 1; ++ as_fn_error $? "cannot use bfd" "$LINENO" 5 + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- +-else +- echo "$ac_t""no" 1>&6 ++ + fi + +-else +- echo "$ac_t""no" 1>&6 + fi + + +- cat >> confdefs.h <<\EOF +-#define HAVE_LIBBFD 1 +-EOF ++ ++ $as_echo "#define HAVE_LIBBFD 1" >>confdefs.h + + + # + # BFD boolean syntax + # + +- echo $ac_n "checking for useable bfd_boolean""... $ac_c" 1>&6 +-echo "configure:3394: checking for useable bfd_boolean" >&5 +- if test "$cross_compiling" = yes; then +- echo "$ac_t""no" 1>&6 +-else +- cat > conftest.$ac_ext <&5 ++$as_echo_n "checking for useable bfd_boolean... " >&6; } ++ if test "$cross_compiling" = yes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + #define IN_GCC + #include + bfd_boolean foo() {return FALSE;} + int main() {return 0;} +-EOF +-if { (eval echo configure:3406: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- echo "$ac_t""yes" 1>&6 +- cat >> confdefs.h <<\EOF +-#define HAVE_BFD_BOOLEAN 1 +-EOF ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++ $as_echo "#define HAVE_BFD_BOOLEAN 1" >>confdefs.h + + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + + + # ++# bfd_link_info.output_bfd minimal configure change check ++# ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bfd_link_info.output_bfd" >&5 ++$as_echo_n "checking for bfd_link_info.output_bfd... " >&6; } ++ if test "$cross_compiling" = yes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++ #include ++ int main() {struct bfd_link_info i;i.output_bfd=0;return 0;} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++ $as_echo "#define HAVE_OUTPUT_BFD 1" >>confdefs.h ++ ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ++fi ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++fi ++ ++ ++# + # FIXME: Need to workaround mingw before this point -- CM + # + if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then + echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c +- MP=`$CC -Wl,-M -static -o foo foo.c -lbfd -liberty 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` ++ MP=`$CC -Wl,-M -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` + rm -f foo.c foo + if echo $MP | tr ' ' '\012' | grep -q libbfd.a ; then +- TLIBS="$TLIBS `echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[j]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[j],j!=i ? "/" : "")}'`" ++ LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[j]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[j],j!=i ? "/" : "")}'`" + else + echo Guessing path to libbfd.a due to gcc bug +- TLIBS="$TLIBS /usr/lib/libbfd.a" +- fi ++ LIBBFD="/usr/lib/libbfd.a" ++ fi + if echo $MP | tr ' ' '\012' | grep -q libiberty.a ; then +- TLIBS="$TLIBS `echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[j]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[j],j!=i ? "/" : "")}'`" ++ LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[j]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[j],j!=i ? "/" : "")}'`" + else + echo Guessing path to libiberty.a due to gcc bug +- TLIBS="$TLIBS /usr/lib/libiberty.a" +- fi +- else +- TLIBS="$TLIBS -lbfd -liberty" +- fi +-fi +- +-if test "$enable_locbfd" = "yes" ; then +- +- # check for gettext. It is part of glibc, but others +- # need GNU gettext separately. +- ac_safe=`echo "libintl.h" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for libintl.h""... $ac_c" 1>&6 +-echo "configure:3454: checking for libintl.h" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:3464: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" ++ LIBIBERTY="/usr/lib/libiberty.a" ++ fi ++ BUILD_BFD=copy_bfd ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inflate in -lz" >&5 ++$as_echo_n "checking for inflate in -lz... " >&6; } ++if ${ac_cv_lib_z_inflate+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ ac_check_lib_save_LIBS=$LIBS ++LIBS="-lz $LIBS" ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++/* Override any GCC internal prototype to avoid an error. ++ Use char because int might match the return type of a GCC ++ builtin and then its argument prototype would still apply. */ ++#ifdef __cplusplus ++extern "C" ++#endif ++char inflate (); ++int ++main () ++{ ++return inflate (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_z_inflate=yes ++else ++ ac_cv_lib_z_inflate=no + fi +-rm -f conftest* ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS + fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- true ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_z_inflate" >&5 ++$as_echo "$ac_cv_lib_z_inflate" >&6; } ++if test "x$ac_cv_lib_z_inflate" = xyes; then : ++ TLIBS="$TLIBS -lz" + else +- echo "$ac_t""no" 1>&6 +-{ echo "configure: error: libintl.h (gettext) not found" 1>&2; exit 1; } ++ as_fn_error $? "Need zlib for bfd linking" "$LINENO" 5 + fi + +- +-echo $ac_n "checking for library containing dgettext""... $ac_c" 1>&6 +-echo "configure:3488: checking for library containing dgettext" >&5 +-if eval "test \"`echo '$''{'ac_cv_search_dgettext'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- ac_func_search_save_LIBS="$LIBS" +-ac_cv_search_dgettext="no" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- ac_cv_search_dgettext="none required" ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlsym in -ldl" >&5 ++$as_echo_n "checking for dlsym in -ldl... " >&6; } ++if ${ac_cv_lib_dl_dlsym+:} false; then : ++ $as_echo_n "(cached) " >&6 + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +-fi +-rm -f conftest* +-test "$ac_cv_search_dgettext" = "no" && for i in intl; do +-LIBS="-l$i $ac_func_search_save_LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- ac_cv_search_dgettext="-l$i" +-break ++ ac_check_lib_save_LIBS=$LIBS ++LIBS="-ldl $LIBS" ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++/* Override any GCC internal prototype to avoid an error. ++ Use char because int might match the return type of a GCC ++ builtin and then its argument prototype would still apply. */ ++#ifdef __cplusplus ++extern "C" ++#endif ++char dlsym (); ++int ++main () ++{ ++return dlsym (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_dl_dlsym=yes ++else ++ ac_cv_lib_dl_dlsym=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlsym" >&5 ++$as_echo "$ac_cv_lib_dl_dlsym" >&6; } ++if test "x$ac_cv_lib_dl_dlsym" = xyes; then : ++ TLIBS="$TLIBS -ldl" + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +-fi +-rm -f conftest* +-done +-LIBS="$ac_func_search_save_LIBS" ++ as_fn_error $? "Need libdl for bfd linking" "$LINENO" 5 + fi + +-echo "$ac_t""$ac_cv_search_dgettext" 1>&6 +-if test "$ac_cv_search_dgettext" != "no"; then +- test "$ac_cv_search_dgettext" = "none required" || LIBS="$ac_cv_search_dgettext $LIBS" +- true +-else : +- { echo "configure: error: gettext library not found" 1>&2; exit 1; } ++ ++ ++ ++ ++ else ++ TLIBS="$TLIBS -lbfd -liberty -ldl" ++ fi + fi +- ++ ++if test "$enable_locbfd" = "yes" ; then ++ ++ # check for gettext. It is part of glibc, but others ++ # need GNU gettext separately. ++# AC_CHECK_HEADER(libintl.h, true, ++# AC_MSG_ERROR(libintl.h (gettext) not found)) ++# AC_SEARCH_LIBS(dgettext, intl, true, AC_MSG_ERROR(gettext library not found)) ++ ++ echo "#" ++ echo "#" ++ echo "# -------------------------" ++ echo "# Subconfigure of LIBINTL" ++ echo "#" ++ echo "#" ++ cd binutils/intl && chmod +x configure && ./configure --disable-nls && cd ../.. ++# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " ++ echo "#" ++ echo "#" ++ echo "#" ++ echo "# Subconfigure of LIBINTL done" ++ echo "# ------------------------------" ++ echo "#" + echo "#" + echo "#" + echo "# -------------------------" + echo "# Subconfigure of LIBIBERTY" + echo "#" + echo "#" +- cd binutils/libiberty && chmod +x configure && ./configure && cd ../.. +-# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " ++ cd binutils/libiberty && chmod +x configure && ./configure --disable-nls && cd ../.. ++# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " + echo "#" + echo "#" + echo "#" +@@ -3565,8 +5665,8 @@ fi + echo "# Subconfigure of BFD" + echo "#" + echo "#" +- cd binutils/bfd && chmod +x configure && ./configure && cd ../.. +-# MY_SUBDIRS="$MY_SUBDIRS binutils/bfd " ++ cd binutils/bfd && chmod +x configure && ./configure --with-included-gettext --disable-nls && cd ../.. ++# MY_SUBDIRS="$MY_SUBDIRS binutils/bfd " + echo "#" + echo "#" + echo "#" +@@ -3574,71 +5674,112 @@ fi + echo "# ------------------------" + echo "#" + # TLIBS="$TLIBS `pwd`/binutils/bfd/libbfd.a `pwd`/binutils/libiberty/libiberty.a" +- cat >> confdefs.h <<\EOF +-#define HAVE_LIBBFD 1 +-EOF ++ $as_echo "#define HAVE_LIBBFD 1" >>confdefs.h + + BUILD_BFD="h/bfd.h h/bfdlink.h h/ansidecl.h h/symcat.h" +- ++ + fi + +-#AC_CONFIG_SUBDIRS($MY_SUBDIRS) + +-# Find where Data begins. This is used by the storage allocation +-# mechanism, in the PAGE macro. This offset is subtracted from +-# addresses, in calculating a page for an address in the heap. ++ac_fn_c_check_func "$LINENO" "xdr_double" "ac_cv_func_xdr_double" ++if test "x$ac_cv_func_xdr_double" = xyes; then : + +-echo $ac_n "checking size of long""... $ac_c" 1>&6 +-echo "configure:3593: checking size of long" >&5 +-if eval "test \"`echo '$''{'ac_cv_sizeof_long'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- if test "$cross_compiling" = yes; then +- ac_cv_sizeof_long=0 + else +- cat > conftest.$ac_ext < +-#include +-main() ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -ltirpc" >&5 ++$as_echo_n "checking for xdr_double in -ltirpc... " >&6; } ++if ${ac_cv_lib_tirpc_xdr_double+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ ac_check_lib_save_LIBS=$LIBS ++LIBS="-ltirpc $LIBS" ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++/* Override any GCC internal prototype to avoid an error. ++ Use char because int might match the return type of a GCC ++ builtin and then its argument prototype would still apply. */ ++#ifdef __cplusplus ++extern "C" ++#endif ++char xdr_double (); ++int ++main () + { +- FILE *f=fopen("conftestval", "w"); +- if (!f) exit(1); +- fprintf(f, "%d\n", sizeof(long)); +- exit(0); ++return xdr_double (); ++ ; ++ return 0; + } +-EOF +-if { (eval echo configure:3613: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- ac_cv_sizeof_long=`cat conftestval` ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_tirpc_xdr_double=yes ++else ++ ac_cv_lib_tirpc_xdr_double=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tirpc_xdr_double" >&5 ++$as_echo "$ac_cv_lib_tirpc_xdr_double" >&6; } ++if test "x$ac_cv_lib_tirpc_xdr_double" = xyes; then : ++ TLIBS="$TLIBS -ltirpc" + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- ac_cv_sizeof_long=0 ++ as_fn_error $? "Need xdr_double" "$LINENO" 5 ++fi ++ + fi +-rm -fr conftest* ++ ++ ++ ++#AC_CONFIG_SUBDIRS($MY_SUBDIRS) ++ ++# Find where Data begins. This is used by the storage allocation ++# mechanism, in the PAGE macro. This offset is subtracted from ++# addresses, in calculating a page for an address in the heap. ++ ++# The cast to long int works around a bug in the HP C Compiler ++# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects ++# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. ++# This bug is HP SR number 8606223364. ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of long" >&5 ++$as_echo_n "checking size of long... " >&6; } ++if ${ac_cv_sizeof_long+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (long))" "ac_cv_sizeof_long" "$ac_includes_default"; then : ++ ++else ++ if test "$ac_cv_type_long" = yes; then ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error 77 "cannot compute sizeof (long) ++See \`config.log' for more details" "$LINENO" 5; } ++ else ++ ac_cv_sizeof_long=0 ++ fi + fi + + fi +-echo "$ac_t""$ac_cv_sizeof_long" 1>&6 +-cat >> confdefs.h <&5 ++$as_echo "$ac_cv_sizeof_long" >&6; } ++ ++ ++ ++cat >>confdefs.h <<_ACEOF + #define SIZEOF_LONG $ac_cv_sizeof_long +-EOF ++_ACEOF + + +-echo $ac_n "checking sizeof struct contblock""... $ac_c" 1>&6 +-echo "configure:3633: checking sizeof struct contblock" >&5 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking sizeof struct contblock" >&5 ++$as_echo_n "checking sizeof struct contblock... " >&6; } + + # work around MSYS pwd result incompatibility + if test "$use" = "mingw" ; then +-if test "$cross_compiling" = yes; then ++if test "$cross_compiling" = yes; then : + echo Cannot find sizeof struct contblock;exit 1 + else +- cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + #include + #define EXTER + #include "$MP_INCLUDE" +@@ -3650,26 +5791,22 @@ else + fclose(f); + return 0; + } +-EOF +-if { (eval echo configure:3655: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : + sizeof_contblock=`cat conftest1` + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* + echo Cannot find sizeof struct contblock;exit 1 + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + else +-if test "$cross_compiling" = yes; then ++if test "$cross_compiling" = yes; then : + echo Cannot find sizeof struct contblock;exit 1 + else +- cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + #include + #define EXTER + #include "$MP_INCLUDE" +@@ -3681,93 +5818,60 @@ else + fclose(f); + return 0; + } +-EOF +-if { (eval echo configure:3686: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : + sizeof_contblock=`cat conftest1` + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* + echo Cannot find sizeof struct contblock;exit 1 + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + fi +-echo "$ac_t""$sizeof_contblock" 1>&6 +-cat >> confdefs.h <&5 ++$as_echo "$sizeof_contblock" >&6; } ++cat >>confdefs.h <<_ACEOF + #define SIZEOF_CONTBLOCK $sizeof_contblock +-EOF ++_ACEOF + + + ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for word order" >&5 ++$as_echo_n "checking for word order... " >&6; } ++if test "$cross_compiling" = yes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: WARNING: ASSUMING LITTLE ENDIAN FOR CROSS COMPILING !!! ++ $as_echo \"#define LITTLE_END 1\" >>confdefs.h ++" >&5 ++$as_echo "WARNING: ASSUMING LITTLE ENDIAN FOR CROSS COMPILING !!! ++ $as_echo \"#define LITTLE_END 1\" >>confdefs.h ++" >&6; } ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++int main () { ++ /* Are we little or big endian? Adapted from Harbison&Steele. */ ++ union ++ { ++ double d; ++ int l[sizeof(double)/sizeof(int)]; ++ } u; ++ u.d = 1.0; ++ return u.l[sizeof(double)/sizeof(int)-1] ? 0 : 1; ++} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: little" >&5 ++$as_echo "little" >&6; } ++ $as_echo "#define LITTLE_END 1" >>confdefs.h + +-for ac_hdr in endian.h +-do +-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 +-echo "configure:3711: checking for $ac_hdr" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:3721: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" +-fi +-rm -f conftest* +-fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` +- cat >> confdefs.h <&6 +-echo "configure:3742: checking "endianness"" >&5 +- if test "$cross_compiling" = yes; then +- echo "$ac_t""big" 1>&6 +-else +- cat > conftest.$ac_ext < +- int main() { return BYTE_ORDER == __LITTLE_ENDIAN ? 0 : 1;} +-EOF +-if { (eval echo configure:3753: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- cat >> confdefs.h <<\EOF +-#define LITTLE_END 1 +-EOF +- echo "$ac_t""little" 1>&6 + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- echo "$ac_t""big" 1>&6 +-fi +-rm -fr conftest* ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: big" >&5 ++$as_echo "big" >&6; } + fi +- +-else +- echo "$ac_t""no" 1>&6 ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi +-done + + + +@@ -3775,15 +5879,15 @@ done + # On systems with execshield, brk is randomized. We need to catch + # this and restore the traditional behavior here + +-echo $ac_n "checking for sbrk""... $ac_c" 1>&6 +-echo "configure:3780: checking for sbrk" >&5 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sbrk" >&5 ++$as_echo_n "checking for sbrk... " >&6; } + HAVE_SBRK="" +-if test "$cross_compiling" = yes; then +- echo "$ac_t""no: WARNING you must be able to emulate sbrk: as on mingw or macosx" 1>&6 ++if test "$cross_compiling" = yes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no: WARNING you must be able to emulate sbrk: as on mingw or macosx" >&5 ++$as_echo "no: WARNING you must be able to emulate sbrk: as on mingw or macosx" >&6; } + else +- cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + #include + #include + int main() { +@@ -3793,221 +5897,227 @@ else + fprintf(f,"%u",sbrk(0)); + return 0; + } +-EOF +-if { (eval echo configure:3798: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : + HAVE_SBRK=1 +- echo "$ac_t""yes" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- echo "$ac_t""no: WARNING you must be able to emulate sbrk: as on mingw or macosx" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no: WARNING you must be able to emulate sbrk: as on mingw or macosx" >&5 ++$as_echo "no: WARNING you must be able to emulate sbrk: as on mingw or macosx" >&6; } + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + + if test "$HAVE_SBRK" = "1" ; then +- echo $ac_n "checking for randomized sbrk""... $ac_c" 1>&6 +-echo "configure:3814: checking for randomized sbrk" >&5 +- if test "$cross_compiling" = yes; then ++ ++# AC_CHECK_HEADER(sys/personality.h, true, ++# AC_MSG_RESULT(sys/personality.h not found)) ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_NO_RANDOMIZE constant" >&5 ++$as_echo_n "checking for ADDR_NO_RANDOMIZE constant... " >&6; } ++ if test "$cross_compiling" = yes; then : ++ ADDR_NO_RANDOMIZE=0 ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++ #include ++ int main(int argc,char *argv[],char *envp[]) { ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) return -1; ++ fprintf(f,"%x",ADDR_NO_RANDOMIZE); ++ return 0; ++ } ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ ADDR_NO_RANDOMIZE=`cat conftest1` ++else ++ ADDR_NO_RANDOMIZE=0 ++fi ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++fi ++ ++ if test "$ADDR_NO_RANDOMIZE" = "0" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no, assuming 0x40000" >&5 ++$as_echo "no, assuming 0x40000" >&6; } ++ cat >>confdefs.h <<_ACEOF ++#define ADDR_NO_RANDOMIZE 0x40000 ++_ACEOF ++ ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes, $ADDR_NO_RANDOMIZE" >&5 ++$as_echo "yes, $ADDR_NO_RANDOMIZE" >&6; } ++ fi ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for personality(ADDR_NO_RANDOMIZE) support" >&5 ++$as_echo_n "checking for personality(ADDR_NO_RANDOMIZE) support... " >&6; } ++ if test "$cross_compiling" = yes; then : ++ CAN_UNRANDOMIZE_SBRK=0 ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++void gprof_cleanup() {}; ++ int main(int argc,char *argv[],char *envp[]) { ++ #include "h/unrandomize.h" ++ return 0;} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ CAN_UNRANDOMIZE_SBRK=1 ++else ++ CAN_UNRANDOMIZE_SBRK=0 ++fi ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++fi ++ ++ ++ if test "$CAN_UNRANDOMIZE_SBRK" != 0 ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++ $as_echo "#define CAN_UNRANDOMIZE_SBRK 1" >>confdefs.h ++ ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ++ fi ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking that sbrk is (now) non-random" >&5 ++$as_echo_n "checking that sbrk is (now) non-random... " >&6; } ++ if test "$cross_compiling" = yes; then : + SBRK=0 + else +- cat > conftest.$ac_ext < +- #include +- int main() { ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++ void gprof_cleanup() {}; ++ int main(int argc,char * argv[],char * envp[]) { + FILE *f; +- if (!(f=fopen("conftest1","w"))) +- return -1; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ if (!(f=fopen("conftest1","w"))) return -1; + fprintf(f,"%u",sbrk(0)); +- return 0; +- } +-EOF +-if { (eval echo configure:3831: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then ++ return 0;} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : + SBRK=`cat conftest1` + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* + SBRK=0 + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + if test "$SBRK" = "0" ; then +- echo "$ac_t""cannot trap sbrk" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot trap sbrk" >&5 ++$as_echo "cannot trap sbrk" >&6; } + exit 1 + fi +- if test "$cross_compiling" = yes; then ++ if test "$cross_compiling" = yes; then : + SBRK1=0 + else +- cat > conftest.$ac_ext < +- #include +- int main() { ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++ void gprof_cleanup() {}; ++ int main(int argc,char * argv[],char * envp[]) { + FILE *f; +- if (!(f=fopen("conftest1","w"))) +- return -1; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ if (!(f=fopen("conftest1","w"))) return -1; + fprintf(f,"%u",sbrk(0)); +- return 0; +- } +-EOF +-if { (eval echo configure:3863: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then ++ return 0;} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : + SBRK1=`cat conftest1` + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* + SBRK1=0 + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + if test "$SBRK1" = "0" ; then +- echo "$ac_t""cannot trap sbrk" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot trap sbrk" >&5 ++$as_echo "cannot trap sbrk" >&6; } ++ exit 1 ++ fi ++ if test "$SBRK" = "$SBRK1" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ++ echo "Cannot build with randomized sbrk. Your options:" ++ echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" ++ echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" ++ echo " - run sysctl kernel.randomize_va_space=0 before using gcl" + exit 1 + fi +- +- if test "$SBRK" != "$SBRK1" ; then +- echo "$ac_t""yes" 1>&6 +- echo $ac_n "checking for randomized brk remedy""... $ac_c" 1>&6 +-echo "configure:3883: checking for randomized brk remedy" >&5 +- if test "$cross_compiling" = yes; then +- SBRK=0 +-else +- cat > conftest.$ac_ext < +- #include +- #include +- #include +- int main(int argc,char * argv[]) { +- FILE *f; +- #if SIZEOF_LONG == 4 +- if (!syscall(SYS_personality,PER_LINUX32)) +- #else +- if (!syscall(SYS_personality,PER_LINUX)) +- #endif +- execvp(argv[0],argv); +- if (!(f=fopen("conftest1","w"))) +- return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0; +- } +-EOF +-if { (eval echo configure:3908: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- SBRK=`cat conftest1` +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- SBRK=0 +-fi +-rm -fr conftest* + fi + +- if test "$SBRK" = "0" ; then +- echo "$ac_t""cannot trap sbrk" 1>&6 +- exit 1 +- fi +- if test "$cross_compiling" = yes; then +- SBRK1=0 ++# pagewidth ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for pagewidth" >&5 ++$as_echo_n "checking for pagewidth... " >&6; } ++if test "$cross_compiling" = yes; then : ++ PAGEWIDTH=0 + else +- cat > conftest.$ac_ext < +- #include +- #include +- #include +- int main(int argc,char * argv[]) { +- FILE *f; +- #if SIZEOF_LONG == 4 +- if (!syscall(SYS_personality,PER_LINUX32)) +- #else +- if (!syscall(SYS_personality,PER_LINUX)) +- #endif +- execvp(argv[0],argv); +- if (!(f=fopen("conftest1","w"))) +- return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0; +- } +-EOF +-if { (eval echo configure:3948: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- SBRK1=`cat conftest1` ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++ #include ++int main() {size_t i=getpagesize(),j; ++ FILE *fp=fopen("conftest1","w"); ++ for (j=0;i>>=1;j++); ++ if (j<12) {printf("pagewidth %u is too small\n",j);return -1;} ++ fprintf(fp,"%u",j); ++ return 0;} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ PAGEWIDTH=`cat conftest1` + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- SBRK1=0 ++ PAGEWIDTH=0 + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- if test "$SBRK1" = "0" ; then +- echo "$ac_t""cannot trap sbrk" 1>&6 +- exit 1 +- fi +- if test "$SBRK" = "$SBRK1" ; then +- echo "$ac_t""yes" 1>&6 +- cat >> confdefs.h <<\EOF +-#define NEED_NONRANDOM_SBRK 1 +-EOF ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $PAGEWIDTH" >&5 ++$as_echo "$PAGEWIDTH" >&6; } ++cat >>confdefs.h <<_ACEOF ++#define PAGEWIDTH $PAGEWIDTH ++_ACEOF ++ + +- else +- echo "$ac_t""no" 1>&6 +- echo "Cannot build with randomized sbrk" +- exit 1 +- fi +- else +- echo "$ac_t""no" 1>&6 +- fi +-fi + + + old_LDFLAGS="$LDFLAGS" + LDFLAGS="$TLDFLAGS" +-echo $ac_n "checking "finding DBEGIN"""... $ac_c" 1>&6 +-echo "configure:3984: checking "finding DBEGIN"" >&5 +-if test "$cross_compiling" = yes; then ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking \"finding DBEGIN\"" >&5 ++$as_echo_n "checking \"finding DBEGIN\"... " >&6; } ++if test "$cross_compiling" = yes; then : + dbegin=0 + else +- cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + #include + #include +- #ifdef NEED_NONRANDOM_SBRK +- #include +- #include +- #include +- #endif ++ ++void gprof_cleanup() {}; + int +-main(int argc,char * argv[]) ++main(int argc,char * argv[],char *envp[]) + { +- char *b; ++ char *b,*b1; + FILE *fp; + +-#ifdef NEED_NONRANDOM_SBRK +-#if SIZEOF_LONG == 4 +-if (!syscall(SYS_personality,PER_LINUX32)) +-#else +-if (!syscall(SYS_personality,PER_LINUX)) ++#ifdef CAN_UNRANDOMIZE_SBRK ++#include "h/unrandomize.h" + #endif +- execvp(argv[0],argv); +-#endif + b = (void *) malloc(1000); + fp = fopen("conftest1","w"); + +@@ -4015,45 +6125,41 @@ if (!syscall(SYS_personality,PER_LINUX)) + fprintf(fp,"_dbegin"); + #else + #if defined (__APPLE__) && defined (__MACH__) +- fprintf(fp,"get_dbegin()"); ++ fprintf(fp,"mach_mapstart"); + #else +- fprintf(fp,"0x%lx",((unsigned long) b) & ~(unsigned long)0xffffff); ++ b1=((unsigned long) b) & ~(unsigned long)0xffffff;b=(void *)b1<(void *)&b1 && (void *)b>(void *)&b ? ((unsigned long) b) & ~(unsigned long)((1<&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : + dbegin=`cat conftest1` + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* + dbegin=0 + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +-cat >> confdefs.h <>confdefs.h <<_ACEOF ++#define DBEGIN $dbegin /* where data begins */ ++_ACEOF + +-EOF +- +-echo "$ac_t""got $dbegin" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: got $dbegin" >&5 ++$as_echo "got $dbegin" >&6; } + LDFLAGS="$old_LDFLAGS" + + +-echo $ac_n "checking "finding CSTACK_ADDRESS"""... $ac_c" 1>&6 +-echo "configure:4051: checking "finding CSTACK_ADDRESS"" >&5 +-if test "$cross_compiling" = yes; then ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking \"finding CSTACK_ADDRESS\"" >&5 ++$as_echo_n "checking \"finding CSTACK_ADDRESS\"... " >&6; } ++if test "$cross_compiling" = yes; then : + cstack_address=0 + else +- cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + #include + main() + { +@@ -4063,37 +6169,35 @@ main() + fclose(fp); + return 0; + } +-EOF +-if { (eval echo configure:4068: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : + cstack_address=`cat conftest1` + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* + cstack_address=0 + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +-cat >> confdefs.h <>confdefs.h <<_ACEOF + #define CSTACK_ADDRESS $cstack_address \ + +-EOF ++_ACEOF + +-echo "$ac_t""got $cstack_address" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: got $cstack_address" >&5 ++$as_echo "got $cstack_address" >&6; } + + + +-echo $ac_n "checking "sizeof long long int"""... $ac_c" 1>&6 +-echo "configure:4090: checking "sizeof long long int"" >&5 +-if test "$cross_compiling" = yes; then +- echo "$ac_t""no" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking \"sizeof long long int\"" >&5 ++$as_echo_n "checking \"sizeof long long int\"... " >&6; } ++if test "$cross_compiling" = yes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + + else +- cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + #include + main() + { +@@ -4101,96 +6205,53 @@ main() + return 1; + } + +-EOF +-if { (eval echo configure:4106: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- cat >> confdefs.h <<\EOF +-#define HAVE_LONG_LONG 1 +-EOF ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ $as_echo "#define HAVE_LONG_LONG 1" >>confdefs.h + +-echo "$ac_t""yes" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + + + + # readline +-# Check whether --enable-readline or --disable-readline was given. +-if test "${enable_readline+set}" = set; then +- enableval="$enable_readline" +- : +-else +- enable_readline="yes" +-fi +- +- +-# ansi lisp +-# Check whether --enable-ansi or --disable-ansi was given. +-if test "${enable_ansi+set}" = set; then +- enableval="$enable_ansi" +- : +-else +- enable_ansi="no" +-fi +- +- +-if test "$enable_ansi" = "yes" ; then +- SYSTEM=ansi_gcl +- cat >> confdefs.h <<\EOF +-#define ANSI_COMMON_LISP 1 +-EOF +- +- CLSTANDARD=ANSI +-else +- SYSTEM=gcl +- CLSTANDARD=CLtL1 +-fi +- +-FLISP="saved_$SYSTEM" +- +- +- +- +-# pagewidth +-echo $ac_n "checking for pagewidth""... $ac_c" 1>&6 +-echo "configure:4164: checking for pagewidth" >&5 +-if test "$cross_compiling" = yes; then +- PAGEWIDTH=0 ++# Check whether --enable-readline was given. ++if test "${enable_readline+set}" = set; then : ++ enableval=$enable_readline; + else +- cat > conftest.$ac_ext < +- #include +-int main() {size_t i=getpagesize(),j; +- FILE *fp=fopen("conftest1","w"); +- for (j=0;i>>=1;j++); +- fprintf(fp,"%u",j); +- return 0;} +-EOF +-if { (eval echo configure:4179: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- PAGEWIDTH=`cat conftest1` ++ enable_readline="yes" ++fi ++ ++ ++# ansi lisp ++# Check whether --enable-ansi was given. ++if test "${enable_ansi+set}" = set; then : ++ enableval=$enable_ansi; + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- PAGEWIDTH=0 ++ enable_ansi="no" + fi +-rm -fr conftest* ++ ++ ++if test "$enable_ansi" = "yes" ; then ++ SYSTEM=ansi_gcl ++ $as_echo "#define ANSI_COMMON_LISP 1" >>confdefs.h ++ ++ CLSTANDARD=ANSI ++else ++ SYSTEM=gcl ++ CLSTANDARD=CLtL1 + fi + +-echo "$ac_t""$PAGEWIDTH" 1>&6 +-cat >> confdefs.h <&6 +-echo "configure:4206: checking for $ac_func" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char $ac_func(); +- +-int main() { +- +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +-choke me +-#else +-$ac_func(); +-#endif +- +-; return 0; } +-EOF +-if { (eval echo configure:4234: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_$ac_func=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_$ac_func=no" +-fi +-rm -f conftest* +-fi ++do : ++ ac_fn_c_check_func "$LINENO" "getcwd" "ac_cv_func_getcwd" ++if test "x$ac_cv_func_getcwd" = xyes; then : ++ cat >>confdefs.h <<_ACEOF ++#define HAVE_GETCWD 1 ++_ACEOF + +-if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` +- cat >> confdefs.h <&6 + fi + done + + for ac_func in getwd +-do +-echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 +-echo "configure:4261: checking for $ac_func" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char $ac_func(); +- +-int main() { +- +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +-choke me +-#else +-$ac_func(); +-#endif +- +-; return 0; } +-EOF +-if { (eval echo configure:4289: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_$ac_func=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_$ac_func=no" +-fi +-rm -f conftest* +-fi ++do : ++ ac_fn_c_check_func "$LINENO" "getwd" "ac_cv_func_getwd" ++if test "x$ac_cv_func_getwd" = xyes; then : ++ cat >>confdefs.h <<_ACEOF ++#define HAVE_GETWD 1 ++_ACEOF + +-if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` +- cat >> confdefs.h <&6 + fi + done + +-echo $ac_n "checking for uname""... $ac_c" 1>&6 +-echo "configure:4314: checking for uname" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_uname'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char uname(); +- +-int main() { ++ac_fn_c_check_func "$LINENO" "uname" "ac_cv_func_uname" ++if test "x$ac_cv_func_uname" = xyes; then : + +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_uname) || defined (__stub___uname) +-choke me +-#else +-uname(); +-#endif ++else ++ $as_echo "#define NO_UNAME 1" >>confdefs.h + +-; return 0; } +-EOF +-if { (eval echo configure:4342: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_uname=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_uname=no" +-fi +-rm -f conftest* + fi + +-if eval "test \"`echo '$ac_cv_func_'uname`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- : ++ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday" ++if test "x$ac_cv_func_gettimeofday" = xyes; then : ++ + else +- echo "$ac_t""no" 1>&6 +-cat >> confdefs.h <<\EOF +-#define NO_UNAME 1 +-EOF ++ $as_echo "#define NO_GETTOD 1" >>confdefs.h + + fi + +-echo $ac_n "checking for gettimeofday""... $ac_c" 1>&6 +-echo "configure:4366: checking for gettimeofday" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_gettimeofday'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char gettimeofday(); + +-int main() { + +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_gettimeofday) || defined (__stub___gettimeofday) +-choke me +-#else +-gettimeofday(); +-#endif ++for ac_header in sys/ioctl.h ++do : ++ ac_fn_c_check_header_mongrel "$LINENO" "sys/ioctl.h" "ac_cv_header_sys_ioctl_h" "$ac_includes_default" ++if test "x$ac_cv_header_sys_ioctl_h" = xyes; then : ++ cat >>confdefs.h <<_ACEOF ++#define HAVE_SYS_IOCTL_H 1 ++_ACEOF + +-; return 0; } +-EOF +-if { (eval echo configure:4394: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_gettimeofday=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_gettimeofday=no" +-fi +-rm -f conftest* + fi + +-if eval "test \"`echo '$ac_cv_func_'gettimeofday`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- : +-else +- echo "$ac_t""no" 1>&6 +-cat >> confdefs.h <<\EOF +-#define NO_GETTOD 1 +-EOF +- +-fi ++done + + ++# OpenBSD has elf_abi.h instead of elf.h ++for ac_header in elf.h elf_abi.h ++do : ++ as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ++ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" ++if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : ++ cat >>confdefs.h <<_ACEOF ++#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 ++_ACEOF + +-for ac_hdr in sys/ioctl.h +-do +-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 +-echo "configure:4423: checking for $ac_hdr" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:4433: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" +-fi +-rm -f conftest* +-fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` +- cat >> confdefs.h <&6 + fi ++ + done + + +-# OpenBSD has elf_abi.h instead of elf.h +-for ac_hdr in elf.h elf_abi.h +-do +-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 +-echo "configure:4465: checking for $ac_hdr" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:4475: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" +-fi +-rm -f conftest* +-fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` +- cat >> confdefs.h <&6 ++for ac_header in sys/sockio.h ++do : ++ ac_fn_c_check_header_mongrel "$LINENO" "sys/sockio.h" "ac_cv_header_sys_sockio_h" "$ac_includes_default" ++if test "x$ac_cv_header_sys_sockio_h" = xyes; then : ++ cat >>confdefs.h <<_ACEOF ++#define HAVE_SYS_SOCKIO_H 1 ++_ACEOF ++ + fi ++ + done + + +@@ -4510,495 +6353,225 @@ done + # declare it. + #-------------------------------------------------------------------- + +-echo $ac_n "checking for BSDgettimeofday""... $ac_c" 1>&6 +-echo "configure:4515: checking for BSDgettimeofday" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_BSDgettimeofday'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char BSDgettimeofday(); +- +-int main() { +- +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_BSDgettimeofday) || defined (__stub___BSDgettimeofday) +-choke me +-#else +-BSDgettimeofday(); +-#endif +- +-; return 0; } +-EOF +-if { (eval echo configure:4543: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_BSDgettimeofday=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_BSDgettimeofday=no" +-fi +-rm -f conftest* +-fi +- +-if eval "test \"`echo '$ac_cv_func_'BSDgettimeofday`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- cat >> confdefs.h <<\EOF +-#define HAVE_BSDGETTIMEOFDAY 1 +-EOF ++ac_fn_c_check_func "$LINENO" "BSDgettimeofday" "ac_cv_func_BSDgettimeofday" ++if test "x$ac_cv_func_BSDgettimeofday" = xyes; then : ++ $as_echo "#define HAVE_BSDGETTIMEOFDAY 1" >>confdefs.h + + else +- echo "$ac_t""no" 1>&6 +-echo $ac_n "checking for gettimeofday""... $ac_c" 1>&6 +-echo "configure:4564: checking for gettimeofday" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_gettimeofday'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char gettimeofday(); +- +-int main() { +- +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_gettimeofday) || defined (__stub___gettimeofday) +-choke me +-#else +-gettimeofday(); +-#endif +- +-; return 0; } +-EOF +-if { (eval echo configure:4592: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_gettimeofday=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_gettimeofday=no" +-fi +-rm -f conftest* +-fi ++ ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday" ++if test "x$ac_cv_func_gettimeofday" = xyes; then : + +-if eval "test \"`echo '$ac_cv_func_'gettimeofday`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- : + else +- echo "$ac_t""no" 1>&6 +-cat >> confdefs.h <<\EOF +-#define NO_GETTOD 1 +-EOF ++ $as_echo "#define NO_GETTOD 1" >>confdefs.h + + fi + + fi + + +-echo $ac_n "checking for gettimeofday declaration""... $ac_c" 1>&6 +-echo "configure:4619: checking for gettimeofday declaration" >&5 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gettimeofday declaration" >&5 ++$as_echo_n "checking for gettimeofday declaration... " >&6; } + +-cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + #include +-EOF ++ ++_ACEOF + if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | +- egrep "gettimeofday" >/dev/null 2>&1; then +- rm -rf conftest* +- echo "$ac_t""present" 1>&6 +-else +- rm -rf conftest* +- echo "$ac_t""missing" 1>&6 +- cat >> confdefs.h <<\EOF +-#define GETTOD_NOT_DECLARED 1 +-EOF ++ $EGREP "gettimeofday" >/dev/null 2>&1; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: present" >&5 ++$as_echo "present" >&6; } ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: missing" >&5 ++$as_echo "missing" >&6; } ++ $as_echo "#define GETTOD_NOT_DECLARED 1" >>confdefs.h + + fi + rm -f conftest* + + + +-echo $ac_n "checking for sin in -lm""... $ac_c" 1>&6 +-echo "configure:4643: checking for sin in -lm" >&5 +-ac_lib_var=`echo m'_'sin | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sin in -lm" >&5 ++$as_echo_n "checking for sin in -lm... " >&6; } ++if ${ac_cv_lib_m_sin+:} false; then : ++ $as_echo_n "(cached) " >&6 + else +- ac_save_LIBS="$LIBS" ++ ac_check_lib_save_LIBS=$LIBS + LIBS="-lm $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 ++/* Override any GCC internal prototype to avoid an error. ++ Use char because int might match the return type of a GCC ++ builtin and then its argument prototype would still apply. */ ++#ifdef __cplusplus ++extern "C" ++#endif ++char sin (); ++int ++main () ++{ ++return sin (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_m_sin=yes ++else ++ ac_cv_lib_m_sin=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sin" >&5 ++$as_echo "$ac_cv_lib_m_sin" >&6; } ++if test "x$ac_cv_lib_m_sin" = xyes; then : + LIBS="${LIBS} -lm" + else +- echo "$ac_t""no" 1>&6 +-true ++ true + fi + +-echo $ac_n "checking for main in -lmingwex""... $ac_c" 1>&6 +-echo "configure:4684: checking for main in -lmingwex" >&5 +-ac_lib_var=`echo mingwex'_'main | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lmingwex" >&5 ++$as_echo_n "checking for main in -lmingwex... " >&6; } ++if ${ac_cv_lib_mingwex_main+:} false; then : ++ $as_echo_n "(cached) " >&6 + else +- ac_save_LIBS="$LIBS" ++ ac_check_lib_save_LIBS=$LIBS + LIBS="-lmingwex $LIBS" +-cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + +-int main() { +-main() +-; return 0; } +-EOF +-if { (eval echo configure:4699: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" + +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 ++int ++main () ++{ ++return main (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_mingwex_main=yes ++else ++ ac_cv_lib_mingwex_main=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mingwex_main" >&5 ++$as_echo "$ac_cv_lib_mingwex_main" >&6; } ++if test "x$ac_cv_lib_mingwex_main" = xyes; then : + LIBS="${LIBS} -lmingwex" + else +- echo "$ac_t""no" 1>&6 +-true ++ true + fi + + + EXTRA_LOBJS= + if test "$try_japi" = "yes" ; then +- for ac_hdr in japi.h +-do +-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 +-echo "configure:4727: checking for $ac_hdr" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:4737: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" +-fi +-rm -f conftest* +-fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` +- cat >> confdefs.h <> confdefs.h <<\EOF ++ for ac_header in japi.h ++do : ++ ac_fn_c_check_header_mongrel "$LINENO" "japi.h" "ac_cv_header_japi_h" "$ac_includes_default" ++if test "x$ac_cv_header_japi_h" = xyes; then : ++ cat >>confdefs.h <<_ACEOF + #define HAVE_JAPI_H 1 +-EOF ++_ACEOF ++ $as_echo "#define HAVE_JAPI_H 1" >>confdefs.h + + EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" +- LIBS="${LIBS} -ljapi -lwsock32" +-else +- echo "$ac_t""no" 1>&6 ++ LIBS="${LIBS} -ljapi -lwsock32" + fi ++ + done + + fi + if test "$use" = "mingw" ; then + if test "$try_xdr" = "yes" ; then +- for ac_hdr in rpc/rpc.h +-do +-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 +-echo "configure:4775: checking for $ac_hdr" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:4785: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" +-fi +-rm -f conftest* +-fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` +- cat >> confdefs.h <> confdefs.h <<\EOF +-#define HAVE_XDR 1 +-EOF ++ for ac_header in rpc/rpc.h ++do : ++ ac_fn_c_check_header_mongrel "$LINENO" "rpc/rpc.h" "ac_cv_header_rpc_rpc_h" "$ac_includes_default" ++if test "x$ac_cv_header_rpc_rpc_h" = xyes; then : ++ cat >>confdefs.h <<_ACEOF ++#define HAVE_RPC_RPC_H 1 ++_ACEOF ++ $as_echo "#define HAVE_XDR 1" >>confdefs.h + +- LIBS="${LIBS} -loncrpc" +-else +- echo "$ac_t""no" 1>&6 ++ LIBS="${LIBS} -loncrpc" + fi ++ + done + + fi + else + if test "$try_xdr" = "yes" ; then +- for ac_hdr in rpc/rpc.h +-do +-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 +-echo "configure:4822: checking for $ac_hdr" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:4832: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" +-fi +-rm -f conftest* +-fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` +- cat >> confdefs.h <> confdefs.h <<\EOF +-#define HAVE_XDR 1 +-EOF ++ for ac_header in rpc/rpc.h ++do : ++ ac_fn_c_check_header_mongrel "$LINENO" "rpc/rpc.h" "ac_cv_header_rpc_rpc_h" "$ac_includes_default" ++if test "x$ac_cv_header_rpc_rpc_h" = xyes; then : ++ cat >>confdefs.h <<_ACEOF ++#define HAVE_RPC_RPC_H 1 ++_ACEOF ++ $as_echo "#define HAVE_XDR 1" >>confdefs.h + +- LIBS="${LIBS} -lrpc" +-else +- echo "$ac_t""no" 1>&6 ++ LIBS="${LIBS} -lrpc" + fi ++ + done + + fi + fi + +-# Should really find a way to check for prototypes, but this ++# Should really find a way to check for prototypes, but this + # basically works for now. CM + # +-for ac_hdr in math.h +-do +-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 +-echo "configure:4872: checking for $ac_hdr" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:4882: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" +-fi +-rm -f conftest* +-fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` +- cat >> confdefs.h <> confdefs.h <<\EOF ++for ac_header in math.h ++do : ++ ac_fn_c_check_header_mongrel "$LINENO" "math.h" "ac_cv_header_math_h" "$ac_includes_default" ++if test "x$ac_cv_header_math_h" = xyes; then : ++ cat >>confdefs.h <<_ACEOF + #define HAVE_MATH_H 1 +-EOF ++_ACEOF ++ $as_echo "#define HAVE_MATH_H 1" >>confdefs.h + +-else +- echo "$ac_t""no" 1>&6 + fi ++ + done + + + # + # For DBL_MAX et. al. on (only) certain Linux arches, apparently CM + # +-for ac_hdr in values.h +-do +-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 +-echo "configure:4919: checking for $ac_hdr" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:4929: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" +-fi +-rm -f conftest* +-fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` +- cat >> confdefs.h <> confdefs.h <<\EOF ++for ac_header in values.h ++do : ++ ac_fn_c_check_header_mongrel "$LINENO" "values.h" "ac_cv_header_values_h" "$ac_includes_default" ++if test "x$ac_cv_header_values_h" = xyes; then : ++ cat >>confdefs.h <<_ACEOF + #define HAVE_VALUES_H 1 +-EOF ++_ACEOF ++ $as_echo "#define HAVE_VALUES_H 1" >>confdefs.h + +-else +- echo "$ac_t""no" 1>&6 + fi ++ + done + + + # + # Sparc solaris keeps this in float.h, rework either/or with values.h later + # +-for ac_hdr in float.h +-do +-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 +-echo "configure:4966: checking for $ac_hdr" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:4976: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" +-fi +-rm -f conftest* +-fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` +- cat >> confdefs.h <> confdefs.h <<\EOF ++for ac_header in float.h ++do : ++ ac_fn_c_check_header_mongrel "$LINENO" "float.h" "ac_cv_header_float_h" "$ac_includes_default" ++if test "x$ac_cv_header_float_h" = xyes; then : ++ cat >>confdefs.h <<_ACEOF + #define HAVE_FLOAT_H 1 +-EOF ++_ACEOF ++ $as_echo "#define HAVE_FLOAT_H 1" >>confdefs.h + +-else +- echo "$ac_t""no" 1>&6 + fi ++ + done + + +@@ -5007,129 +6580,154 @@ done + # a more comprehensive later, i.e. checking that the fpclass + # test makes sense. CM + # +-echo $ac_n "checking for isnormal""... $ac_c" 1>&6 +-echo "configure:5012: checking for isnormal" >&5 +-if test "$cross_compiling" = yes; then +- HAVE_ISNORMAL=0 echo "$ac_t""no" 1>&6 +-else +- cat > conftest.$ac_ext <&5 ++$as_echo_n "checking for isnormal... " >&6; } ++if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++ #define _GNU_SOURCE + #include +- int main() { +- float f; +- return isnormal(f) || !isnormal(f) ? 0 : 1; +- } +-EOF +-if { (eval echo configure:5026: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- cat >> confdefs.h <<\EOF +-#define HAVE_ISNORMAL 1 +-EOF +- echo "$ac_t""yes" 1>&6 ++ ++int ++main () ++{ ++ ++ float f; ++ return isnormal(f) || !isnormal(f) ? 0 : 1; ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ ++$as_echo "#define HAVE_ISNORMAL 1" >>confdefs.h ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fpclass in ieeefp.h" >&5 ++$as_echo_n "checking for fpclass in ieeefp.h... " >&6; } ++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- echo $ac_n "checking for fpclass in ieeefp.h""... $ac_c" 1>&6 +-echo "configure:5037: checking for fpclass in ieeefp.h" >&5 +- if test "$cross_compiling" = yes; then +- HAVE_IEEEFP=0 echo "$ac_t""no" 1>&6 +-else +- cat > conftest.$ac_ext < +- int main() { +- float f; +- return fpclass(f)>=FP_NZERO || fpclass(f)&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- cat >> confdefs.h <<\EOF +-#define HAVE_IEEEFP 1 +-EOF +- echo "$ac_t""yes" 1>&6 ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++ #include ++ ++int ++main () ++{ ++ ++ float f; ++ return fpclass(f)>=FP_NZERO || fpclass(f)>confdefs.h ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- HAVE_IEEEFP=0 echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + +-echo $ac_n "checking for isfinite""... $ac_c" 1>&6 +-echo "configure:5072: checking for isfinite" >&5 +-if test "$cross_compiling" = yes; then +- HAVE_ISFINITE=0 echo "$ac_t""no" 1>&6 +-else +- cat > conftest.$ac_ext < +- int main() { ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for isfinite" >&5 ++$as_echo_n "checking for isfinite... " >&6; } ++if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++ #define _GNU_SOURCE ++ #include ++ ++int ++main () ++{ ++ ++ float f; ++ return isfinite(f) || !isfinite(f) ? 0 : 1; ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ ++$as_echo "#define HAVE_ISFINITE 1" >>confdefs.h ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for finite()" >&5 ++$as_echo_n "checking for finite()... " >&6; } ++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++ #include ++ #include ++ ++int ++main () ++{ ++ + float f; +- return isfinite(f) || !isfinite(f) ? 0 : 1; +- } +-EOF +-if { (eval echo configure:5086: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- cat >> confdefs.h <<\EOF +-#define HAVE_ISFINITE 1 +-EOF +- echo "$ac_t""yes" 1>&6 +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- echo $ac_n "checking for finite()""... $ac_c" 1>&6 +-echo "configure:5097: checking for finite()" >&5 +- if test "$cross_compiling" = yes; then +- HAVE_FINITE=0 echo "$ac_t""no" 1>&6 +-else +- cat > conftest.$ac_ext < +- #include +- int main() { +- float f; +- return finite(f) || !finite(f) ? 0 : 1; +- } +-EOF +-if { (eval echo configure:5111: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- cat >> confdefs.h <<\EOF +-#define HAVE_FINITE 1 +-EOF +- echo "$ac_t""yes" 1>&6 ++ return finite(f) || !finite(f) ? 0 : 1; ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ ++$as_echo "#define HAVE_FINITE 1" >>confdefs.h ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* +- HAVE_FINITE=0 echo "$ac_t""no" 1>&6 ++ as_fn_error $? "no" "$LINENO" 5 + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + +- +- + #-------------------------------------------------------------------- + # Check for the existence of the -lsocket and -lnsl libraries. + # The order here is important, so that they end up in the right +@@ -5147,94 +6745,51 @@ fi + # To get around this problem, check for both libraries together + # if -lsocket doesn't work by itself. + #-------------------------------------------------------------------- +-echo $ac_n "checking for sockets""... $ac_c" 1>&6 +-echo "configure:5152: checking for sockets" >&5 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sockets" >&5 ++$as_echo_n "checking for sockets... " >&6; } + tcl_checkBoth=0 +-echo $ac_n "checking for connect""... $ac_c" 1>&6 +-echo "configure:5155: checking for connect" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char connect(); +- +-int main() { +- +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_connect) || defined (__stub___connect) +-choke me +-#else +-connect(); +-#endif +- +-; return 0; } +-EOF +-if { (eval echo configure:5183: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_connect=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_connect=no" +-fi +-rm -f conftest* +-fi +- +-if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then +- echo "$ac_t""yes" 1>&6 ++ac_fn_c_check_func "$LINENO" "connect" "ac_cv_func_connect" ++if test "x$ac_cv_func_connect" = xyes; then : + tcl_checkSocket=0 + else +- echo "$ac_t""no" 1>&6 +-tcl_checkSocket=1 ++ tcl_checkSocket=1 + fi + + if test "$tcl_checkSocket" = 1; then +- echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6 +-echo "configure:5205: checking for main in -lsocket" >&5 +-ac_lib_var=`echo socket'_'main | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lsocket" >&5 ++$as_echo_n "checking for main in -lsocket... " >&6; } ++if ${ac_cv_lib_socket_main+:} false; then : ++ $as_echo_n "(cached) " >&6 + else +- ac_save_LIBS="$LIBS" ++ ac_check_lib_save_LIBS=$LIBS + LIBS="-lsocket $LIBS" +-cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + +-int main() { +-main() +-; return 0; } +-EOF +-if { (eval echo configure:5220: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" + +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 ++int ++main () ++{ ++return main (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_socket_main=yes ++else ++ ac_cv_lib_socket_main=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_main" >&5 ++$as_echo "$ac_cv_lib_socket_main" >&6; } ++if test "x$ac_cv_lib_socket_main" = xyes; then : + TLIBS="$TLIBS -lsocket" + else +- echo "$ac_t""no" 1>&6 +-tcl_checkBoth=1 ++ tcl_checkBoth=1 + fi + + fi +@@ -5243,136 +6798,50 @@ fi + if test "$tcl_checkBoth" = 1; then + tk_oldLibs=$TLIBS + TLIBS="$TLIBS -lsocket -lnsl" +- echo $ac_n "checking for accept""... $ac_c" 1>&6 +-echo "configure:5248: checking for accept" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_accept'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char accept(); +- +-int main() { +- +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_accept) || defined (__stub___accept) +-choke me +-#else +-accept(); +-#endif +- +-; return 0; } +-EOF +-if { (eval echo configure:5276: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_accept=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_accept=no" +-fi +-rm -f conftest* +-fi +- +-if eval "test \"`echo '$ac_cv_func_'accept`\" = yes"; then +- echo "$ac_t""yes" 1>&6 ++ ac_fn_c_check_func "$LINENO" "accept" "ac_cv_func_accept" ++if test "x$ac_cv_func_accept" = xyes; then : + tcl_checkNsl=0 + else +- echo "$ac_t""no" 1>&6 +-TLIBS=$tk_oldLibs ++ TLIBS=$tk_oldLibs + fi + + fi +-echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6 +-echo "configure:5298: checking for gethostbyname" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char gethostbyname(); +- +-int main() { +- +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname) +-choke me +-#else +-gethostbyname(); +-#endif +- +-; return 0; } +-EOF +-if { (eval echo configure:5326: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_gethostbyname=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_gethostbyname=no" +-fi +-rm -f conftest* +-fi ++ac_fn_c_check_func "$LINENO" "gethostbyname" "ac_cv_func_gethostbyname" ++if test "x$ac_cv_func_gethostbyname" = xyes; then : + +-if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- : + else +- echo "$ac_t""no" 1>&6 +-echo $ac_n "checking for main in -lnsl""... $ac_c" 1>&6 +-echo "configure:5344: checking for main in -lnsl" >&5 +-ac_lib_var=`echo nsl'_'main | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lnsl" >&5 ++$as_echo_n "checking for main in -lnsl... " >&6; } ++if ${ac_cv_lib_nsl_main+:} false; then : ++ $as_echo_n "(cached) " >&6 + else +- ac_save_LIBS="$LIBS" ++ ac_check_lib_save_LIBS=$LIBS + LIBS="-lnsl $LIBS" +-cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + +-int main() { +-main() +-; return 0; } +-EOF +-if { (eval echo configure:5359: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" + +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 ++int ++main () ++{ ++return main (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_nsl_main=yes ++else ++ ac_cv_lib_nsl_main=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_nsl_main" >&5 ++$as_echo "$ac_cv_lib_nsl_main" >&6; } ++if test "x$ac_cv_lib_nsl_main" = xyes; then : + TLIBS="$TLIBS -lnsl" +-else +- echo "$ac_t""no" 1>&6 + fi + + fi +@@ -5381,137 +6850,107 @@ fi + RL_OBJS="" + RL_LIB="" + if test "$enable_readline" = "yes" ; then +- for ac_hdr in readline/readline.h +-do +-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 +-echo "configure:5389: checking for $ac_hdr" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:5399: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" +-fi +-rm -f conftest* +-fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` +- cat >> confdefs.h <&6 +-echo "configure:5420: checking for main in -lreadline" >&5 +-ac_lib_var=`echo readline'_'main | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++ for ac_header in readline/readline.h ++do : ++ ac_fn_c_check_header_mongrel "$LINENO" "readline/readline.h" "ac_cv_header_readline_readline_h" "$ac_includes_default" ++if test "x$ac_cv_header_readline_readline_h" = xyes; then : ++ cat >>confdefs.h <<_ACEOF ++#define HAVE_READLINE_READLINE_H 1 ++_ACEOF ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for rl_initialize in -lreadline" >&5 ++$as_echo_n "checking for rl_initialize in -lreadline... " >&6; } ++if ${ac_cv_lib_readline_rl_initialize+:} false; then : ++ $as_echo_n "(cached) " >&6 + else +- ac_save_LIBS="$LIBS" ++ ac_check_lib_save_LIBS=$LIBS + LIBS="-lreadline -lncurses $LIBS" +-cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + +-int main() { +-main() +-; return 0; } +-EOF +-if { (eval echo configure:5435: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" ++/* Override any GCC internal prototype to avoid an error. ++ Use char because int might match the return type of a GCC ++ builtin and then its argument prototype would still apply. */ ++#ifdef __cplusplus ++extern "C" ++#endif ++char rl_initialize (); ++int ++main () ++{ ++return rl_initialize (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_readline_rl_initialize=yes ++else ++ ac_cv_lib_readline_rl_initialize=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_readline_rl_initialize" >&5 ++$as_echo "$ac_cv_lib_readline_rl_initialize" >&6; } ++if test "x$ac_cv_lib_readline_rl_initialize" = xyes; then : ++ $as_echo "#define HAVE_READLINE 1" >>confdefs.h + +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- cat >> confdefs.h <<\EOF +-#define HAVE_READLINE 1 +-EOF +- +- TLIBS="$TLIBS -lreadline -lncurses" ++ TLIBS="$TLIBS -lreadline -lncurses" #some machines don't link this, e.g. Slackware + RL_OBJS=gcl_readline.o + # Readline support now initialized automatically when compiled in, this lisp + # object no longer needed -- 20040102 CM + # RL_LIB=lsp/gcl_readline.o +- +-else +- echo "$ac_t""no" 1>&6 ++ + fi + +-else +- echo "$ac_t""no" 1>&6 + fi ++ + done + + + # These tests discover differences between readline 4.1 and 4.3 +- echo $ac_n "checking for rl_completion_matches in -lreadline""... $ac_c" 1>&6 +-echo "configure:5472: checking for rl_completion_matches in -lreadline" >&5 +-ac_lib_var=`echo readline'_'rl_completion_matches | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- ac_save_LIBS="$LIBS" +-LIBS="-lreadline $LIBS" +-cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for rl_completion_matches in -lreadline" >&5 ++$as_echo_n "checking for rl_completion_matches in -lreadline... " >&6; } ++if ${ac_cv_lib_readline_rl_completion_matches+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ ac_check_lib_save_LIBS=$LIBS ++LIBS="-lreadline -lncurses $LIBS" ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + ++/* Override any GCC internal prototype to avoid an error. ++ Use char because int might match the return type of a GCC ++ builtin and then its argument prototype would still apply. */ ++#ifdef __cplusplus ++extern "C" ++#endif ++char rl_completion_matches (); ++int ++main () ++{ ++return rl_completion_matches (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_readline_rl_completion_matches=yes ++else ++ ac_cv_lib_readline_rl_completion_matches=no + fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- cat >> confdefs.h <<\EOF +-#define HAVE_DECL_RL_COMPLETION_MATCHES 1 +-EOF ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_readline_rl_completion_matches" >&5 ++$as_echo "$ac_cv_lib_readline_rl_completion_matches" >&6; } ++if test "x$ac_cv_lib_readline_rl_completion_matches" = xyes; then : ++ $as_echo "#define HAVE_DECL_RL_COMPLETION_MATCHES 1" >>confdefs.h + +- cat >> confdefs.h <<\EOF +-#define HAVE_RL_COMPENTRY_FUNC_T 1 +-EOF ++ $as_echo "#define HAVE_RL_COMPENTRY_FUNC_T 1" >>confdefs.h + +-else +- echo "$ac_t""no" 1>&6 + fi + + fi +@@ -5519,11 +6958,10 @@ fi + + + +-echo $ac_n "checking For network code for nsocket.c""... $ac_c" 1>&6 +-echo "configure:5524: checking For network code for nsocket.c" >&5 +-cat > conftest.$ac_ext <&5 ++$as_echo_n "checking For network code for nsocket.c... " >&6; } ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + + #include + #include +@@ -5533,7 +6971,7 @@ cat > conftest.$ac_ext < + #include + +-/************* for the sockets ******************/ ++/************* for the sockets ******************/ + #include /* struct sockaddr, SOCK_STREAM, ... */ + #ifndef NO_UNAME + # include /* uname system call. */ +@@ -5542,297 +6980,115 @@ cat > conftest.$ac_ext < /* inet_ntoa() */ + #include /* gethostbyname() */ + +-int main() { ++int ++main () ++{ + connect(0,(struct sockaddr *)0,0); + gethostbyname("jil"); + socket(AF_INET, SOCK_STREAM, 0); +- +-; return 0; } +-EOF +-if { (eval echo configure:5553: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- cat >> confdefs.h <<\EOF +-#define HAVE_NSOCKET 1 +-EOF + +- echo "$ac_t""yes" 1>&6 ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ $as_echo "#define HAVE_NSOCKET 1" >>confdefs.h ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi +-rm -f conftest* ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext + + +-echo $ac_n "checking check for listen using fcntl""... $ac_c" 1>&6 +-echo "configure:5570: checking check for listen using fcntl" >&5 +-cat > conftest.$ac_ext <&5 ++$as_echo_n "checking check for listen using fcntl... " >&6; } ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + #include + #include + +-int main() { ++int ++main () ++{ + FILE *fp=fopen("configure.in","r"); + int orig; + orig = fcntl(fileno(fp), F_GETFL); + if (! (orig & O_NONBLOCK )) return 0; + +-; return 0; } +-EOF +-if { (eval echo configure:5585: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +- rm -rf conftest* +- cat >> confdefs.h <<\EOF +-#define LISTEN_USE_FCNTL 1 +-EOF ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ $as_echo "#define LISTEN_USE_FCNTL 1" >>confdefs.h + +- echo "$ac_t""yes" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi +-rm -f conftest* +- +- +- ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +-echo $ac_n "checking for profil""... $ac_c" 1>&6 +-echo "configure:5604: checking for profil" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_profil'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char profil(); + +-int main() { + +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_profil) || defined (__stub___profil) +-choke me +-#else +-profil(); +-#endif + +-; return 0; } +-EOF +-if { (eval echo configure:5632: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_profil=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_profil=no" +-fi +-rm -f conftest* +-fi ++ac_fn_c_check_func "$LINENO" "profil" "ac_cv_func_profil" ++if test "x$ac_cv_func_profil" = xyes; then : + +-if eval "test \"`echo '$ac_cv_func_'profil`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- : + else +- echo "$ac_t""no" 1>&6 +-cat >> confdefs.h <<\EOF +-#define NO_PROFILE 1 +-EOF ++ $as_echo "#define NO_PROFILE 1" >>confdefs.h + + fi + + +-echo $ac_n "checking for setenv""... $ac_c" 1>&6 +-echo "configure:5657: checking for setenv" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_setenv'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char setenv(); +- +-int main() { +- +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_setenv) || defined (__stub___setenv) +-choke me +-#else +-setenv(); +-#endif +- +-; return 0; } +-EOF +-if { (eval echo configure:5685: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_setenv=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_setenv=no" +-fi +-rm -f conftest* +-fi +- +-if eval "test \"`echo '$ac_cv_func_'setenv`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- cat >> confdefs.h <<\EOF +-#define HAVE_SETENV 1 +-EOF ++ac_fn_c_check_func "$LINENO" "setenv" "ac_cv_func_setenv" ++if test "x$ac_cv_func_setenv" = xyes; then : ++ $as_echo "#define HAVE_SETENV 1" >>confdefs.h + + else +- echo "$ac_t""no" 1>&6 +-no_setenv=1 ++ no_setenv=1 + fi + + + if test "$no_setenv" = "1" ; then +-echo $ac_n "checking for putenv""... $ac_c" 1>&6 +-echo "configure:5711: checking for putenv" >&5 +-if eval "test \"`echo '$''{'ac_cv_func_putenv'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char putenv(); +- +-int main() { +- +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub_putenv) || defined (__stub___putenv) +-choke me +-#else +-putenv(); +-#endif +- +-; return 0; } +-EOF +-if { (eval echo configure:5739: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func_putenv=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func_putenv=no" +-fi +-rm -f conftest* +-fi +- +-if eval "test \"`echo '$ac_cv_func_'putenv`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- cat >> confdefs.h <<\EOF +-#define HAVE_PUTENV 1 +-EOF +- +-else +- echo "$ac_t""no" 1>&6 +-fi +- ++ac_fn_c_check_func "$LINENO" "putenv" "ac_cv_func_putenv" ++if test "x$ac_cv_func_putenv" = xyes; then : ++ $as_echo "#define HAVE_PUTENV 1" >>confdefs.h + + fi + +-echo $ac_n "checking for _cleanup""... $ac_c" 1>&6 +-echo "configure:5765: checking for _cleanup" >&5 +-if eval "test \"`echo '$''{'ac_cv_func__cleanup'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-/* Override any gcc2 internal prototype to avoid an error. */ +-/* We use char because int might match the return type of a gcc2 +- builtin and then its argument prototype would still apply. */ +-char _cleanup(); +- +-int main() { +- +-/* The GNU C library defines this for functions which it implements +- to always fail with ENOSYS. Some functions are actually named +- something starting with __ and the normal name is an alias. */ +-#if defined (__stub__cleanup) || defined (__stub____cleanup) +-choke me +-#else +-_cleanup(); +-#endif + +-; return 0; } +-EOF +-if { (eval echo configure:5793: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_func__cleanup=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_func__cleanup=no" +-fi +-rm -f conftest* + fi + +-if eval "test \"`echo '$ac_cv_func_'_cleanup`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- cat >> confdefs.h <<\EOF +-#define USE_CLEANUP 1 +-EOF ++ac_fn_c_check_func "$LINENO" "_cleanup" "ac_cv_func__cleanup" ++if test "x$ac_cv_func__cleanup" = xyes; then : ++ $as_echo "#define USE_CLEANUP 1" >>confdefs.h + +-else +- echo "$ac_t""no" 1>&6 + fi + + + gcl_ok=no + +-cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + #include +-EOF ++ ++_ACEOF + if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | +- egrep "LITTLE_ENDIAN" >/dev/null 2>&1; then +- rm -rf conftest* ++ $EGREP "LITTLE_ENDIAN" >/dev/null 2>&1; then : + gcl_ok=yes + else +- rm -rf conftest* + gcl_ok=noo + fi + rm -f conftest* + + if test $gcl_ok = yes ; then +-cat >> confdefs.h <<\EOF +-#define ENDIAN_ALREADY_DEFINED 1 +-EOF ++$as_echo "#define ENDIAN_ALREADY_DEFINED 1" >>confdefs.h + + fi + +@@ -5842,282 +7098,219 @@ fi + + + # if test "x$enable_machine" = "x" ; then +-echo $ac_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O""... $ac_c" 1>&6 +-echo "configure:5847: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 ++$as_echo_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... " >&6; } + + case $system in + OSF*) +- cat >> confdefs.h <<\EOF +-#define USE_FIONBIO 1 +-EOF ++ $as_echo "#define USE_FIONBIO 1" >>confdefs.h + +- echo "$ac_t""FIONBIO" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5 ++$as_echo "FIONBIO" >&6; } + ;; + SunOS-4*) +- cat >> confdefs.h <<\EOF +-#define USE_FIONBIO 1 +-EOF ++ $as_echo "#define USE_FIONBIO 1" >>confdefs.h + +- echo "$ac_t""FIONBIO" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5 ++$as_echo "FIONBIO" >&6; } + ;; + ULTRIX-4.*) +- cat >> confdefs.h <<\EOF +-#define USE_FIONBIO 1 +-EOF ++ $as_echo "#define USE_FIONBIO 1" >>confdefs.h + +- echo "$ac_t""FIONBIO" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5 ++$as_echo "FIONBIO" >&6; } + ;; + *) +- echo "$ac_t""O_NONBLOCK" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: O_NONBLOCK" >&5 ++$as_echo "O_NONBLOCK" >&6; } + ;; + esac + + +-echo $ac_n "checking check for SV_ONSTACK""... $ac_c" 1>&6 +-echo "configure:5878: checking check for SV_ONSTACK" >&5 +-cat > conftest.$ac_ext <&5 ++$as_echo_n "checking check for SV_ONSTACK... " >&6; } ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + #include + int joe=SV_ONSTACK; + +-int main() { ++int ++main () ++{ ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ $as_echo "#define HAVE_SV_ONSTACK 1" >>confdefs.h + +-; return 0; } +-EOF +-if { (eval echo configure:5889: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +- rm -rf conftest* +- cat >> confdefs.h <<\EOF +-#define HAVE_SV_ONSTACK 1 +-EOF + +- +- echo "$ac_t""yes" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi +-rm -f conftest* ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +-echo $ac_n "checking check for SIGSYS""... $ac_c" 1>&6 +-echo "configure:5906: checking check for SIGSYS" >&5 +-cat > conftest.$ac_ext <&5 ++$as_echo_n "checking check for SIGSYS... " >&6; } ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + #include + int joe=SIGSYS; + +-int main() { ++int ++main () ++{ ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ $as_echo "#define HAVE_SIGSYS 1" >>confdefs.h + +-; return 0; } +-EOF +-if { (eval echo configure:5917: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +- rm -rf conftest* +- cat >> confdefs.h <<\EOF +-#define HAVE_SIGSYS 1 +-EOF + +- +- echo "$ac_t""yes" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi +-rm -f conftest* ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + + +-echo $ac_n "checking check for SIGEMT""... $ac_c" 1>&6 +-echo "configure:5935: checking check for SIGEMT" >&5 +-cat > conftest.$ac_ext <&5 ++$as_echo_n "checking check for SIGEMT... " >&6; } ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + #include + int joe=SIGEMT; + +-int main() { ++int ++main () ++{ ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ $as_echo "#define HAVE_SIGEMT 1" >>confdefs.h + +-; return 0; } +-EOF +-if { (eval echo configure:5946: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +- rm -rf conftest* +- cat >> confdefs.h <<\EOF +-#define HAVE_SIGEMT 1 +-EOF + +- +- echo "$ac_t""yes" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi +-rm -f conftest* ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + + + + + #if test $use = "386-linux" ; then +- for ac_hdr in asm/sigcontext.h +-do +-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 +-echo "configure:5970: checking for $ac_hdr" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:5980: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" +-fi +-rm -f conftest* +-fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` +- cat >> confdefs.h <&6 ++ for ac_header in asm/sigcontext.h ++do : ++ ac_fn_c_check_header_mongrel "$LINENO" "asm/sigcontext.h" "ac_cv_header_asm_sigcontext_h" "$ac_includes_default" ++if test "x$ac_cv_header_asm_sigcontext_h" = xyes; then : ++ cat >>confdefs.h <<_ACEOF ++#define HAVE_ASM_SIGCONTEXT_H 1 ++_ACEOF ++ + fi ++ + done + +- for ac_hdr in asm/signal.h +-do +-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` +-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 +-echo "configure:6010: checking for $ac_hdr" >&5 +-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 +-else +- cat > conftest.$ac_ext < +-EOF +-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +-{ (eval echo configure:6020: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +-if test -z "$ac_err"; then +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=yes" +-else +- echo "$ac_err" >&5 +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_header_$ac_safe=no" +-fi +-rm -f conftest* +-fi +-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then +- echo "$ac_t""yes" 1>&6 +- ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` +- cat >> confdefs.h <&6 ++ for ac_header in asm/signal.h ++do : ++ ac_fn_c_check_header_mongrel "$LINENO" "asm/signal.h" "ac_cv_header_asm_signal_h" "$ac_includes_default" ++if test "x$ac_cv_header_asm_signal_h" = xyes; then : ++ cat >>confdefs.h <<_ACEOF ++#define HAVE_ASM_SIGNAL_H 1 ++_ACEOF ++ + fi ++ + done + +- echo $ac_n "checking for sigcontext...""... $ac_c" 1>&6 +-echo "configure:6047: checking for sigcontext..." >&5 +- cat > conftest.$ac_ext <&5 ++$as_echo_n "checking for sigcontext...... " >&6; } ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + #include +- +-int main() { ++ ++int ++main () ++{ + + struct sigcontext foo; +- +-; return 0; } +-EOF +-if { (eval echo configure:6059: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +- rm -rf conftest* +- ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ + sigcontext_works=1; +- cat >> confdefs.h <<\EOF +-#define SIGNAL_H_HAS_SIGCONTEXT 1 +-EOF ++ $as_echo "#define SIGNAL_H_HAS_SIGCONTEXT 1" >>confdefs.h ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext in signal.h" >&5 ++$as_echo "sigcontext in signal.h" >&6; } + +- echo "$ac_t""sigcontext in signal.h" 1>&6 +- + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* + sigcontext_works=0; +- echo "$ac_t""sigcontext NOT in signal.h" 1>&6 +- ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext NOT in signal.h" >&5 ++$as_echo "sigcontext NOT in signal.h" >&6; } ++ + fi +-rm -f conftest* ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + if test "$sigcontext_works" = 0 ; then +- echo $ac_n "checking for sigcontext...""... $ac_c" 1>&6 +-echo "configure:6080: checking for sigcontext..." >&5 +- cat > conftest.$ac_ext <&5 ++$as_echo_n "checking for sigcontext...... " >&6; } ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ + #include +- #ifdef HAVE_ASM_SIGCONTEXT_H ++ #ifdef HAVE_ASM_SIGCONTEXT_H + #include + #endif +- #ifdef HAVE_ASM_SIGNAL_H ++ #ifdef HAVE_ASM_SIGNAL_H + #include + #endif +- +-int main() { +- ++ ++int ++main () ++{ ++ + struct sigcontext foo; +- +-; return 0; } +-EOF +-if { (eval echo configure:6098: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +- rm -rf conftest* +- +- cat >> confdefs.h <<\EOF +-#define HAVE_SIGCONTEXT 1 +-EOF + +- echo "$ac_t""sigcontext in asm files" 1>&6 +- ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ ++ $as_echo "#define HAVE_SIGCONTEXT 1" >>confdefs.h ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext in asm files" >&5 ++$as_echo "sigcontext in asm files" >&6; } ++ + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- +- echo "$ac_t""no sigcontext found" 1>&6 +- ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no sigcontext found" >&5 ++$as_echo "no sigcontext found" >&6; } ++ + fi +-rm -f conftest* ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + + + fi + # echo 'foo() {}' > conftest1.c + # $CC -S conftest1.c +-# use_underscore=0 ++# use_underscore=0 + # if fgrep _foo conftest1.s ; then use_underscore=1 ; fi + # if test $use_underscore = 0 ; then + # MPI_FILE=mpi-386_no_under.o +@@ -6135,41 +7328,46 @@ rm -f conftest* + + # Extract the first word of "emacs", so it can be a program name with args. + set dummy emacs; ac_word=$2 +-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +-echo "configure:6140: checking for $ac_word" >&5 +-if eval "test \"`echo '$''{'ac_cv_path_EMACS'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 ++$as_echo_n "checking for $ac_word... " >&6; } ++if ${ac_cv_path_EMACS+:} false; then : ++ $as_echo_n "(cached) " >&6 + else +- case "$EMACS" in +- /*) ++ case $EMACS in ++ [\\/]* | ?:[\\/]*) + ac_cv_path_EMACS="$EMACS" # Let the user override the test with a path. + ;; +- ?:/*) +- ac_cv_path_EMACS="$EMACS" # Let the user override the test with a dos path. +- ;; + *) +- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" +- ac_dummy="$PATH" +- for ac_dir in $ac_dummy; do +- test -z "$ac_dir" && ac_dir=. +- if test -f $ac_dir/$ac_word; then +- ac_cv_path_EMACS="$ac_dir/$ac_word" +- break +- fi ++ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ for ac_exec_ext in '' $ac_executable_extensions; do ++ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ++ ac_cv_path_EMACS="$as_dir/$ac_word$ac_exec_ext" ++ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 ++ break 2 ++ fi ++done + done +- IFS="$ac_save_ifs" ++IFS=$as_save_IFS ++ + ;; + esac + fi +-EMACS="$ac_cv_path_EMACS" ++EMACS=$ac_cv_path_EMACS + if test -n "$EMACS"; then +- echo "$ac_t""$EMACS" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $EMACS" >&5 ++$as_echo "$EMACS" >&6; } + else +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi + + + ++ + # check for where the emacs site lisp directory is. + rm -f conftest.el + cat >> conftest.el <> conftest.el <&6 +-echo "configure:6188: checking emacs site lisp directory" >&5 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking emacs site lisp directory" >&5 ++$as_echo_n "checking emacs site lisp directory... " >&6; } + if [ "$EMACS_SITE_LISP" = "unknown" ] ; then + if [ "$EMACS" != "" ] ; then +- EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d ` ++ EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | grep -v ^Warning: | sed -e /Loading/d | sed -e /load/d ` + else + EMACS_SITE_LISP="" + fi + fi +-echo "$ac_t""$EMACS_SITE_LISP" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $EMACS_SITE_LISP" >&5 ++$as_echo "$EMACS_SITE_LISP" >&6; } + + + # check for where the emacs site lisp default.el is +@@ -6207,8 +7406,8 @@ cat >> conftest.el <&6 +-echo "configure:6212: checking emacs default.el" >&5 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking emacs default.el" >&5 ++$as_echo_n "checking emacs default.el... " >&6; } + if [ "$EMACS" != "" ] ; then + EMACS_DEFAULT_EL=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d ` + else +@@ -6219,7 +7418,8 @@ if test -f "${EMACS_DEFAULT_EL}" ; the + EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el + fi + fi +-echo "$ac_t""$EMACS_DEFAULT_EL" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $EMACS_DEFAULT_EL" >&5 ++$as_echo "$EMACS_DEFAULT_EL" >&6; } + + + +@@ -6230,14 +7430,14 @@ cat >> conftest.el <&6 +-echo "configure:6241: checking emacs info/dir" >&5 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking emacs info/dir" >&5 ++$as_echo_n "checking emacs info/dir... " >&6; } + if test "$use" = "mingw" ; then + INFO_DIR=\$\(prefix\)/lib/gcl-$VERSION/info/ + else +@@ -6245,17 +7445,15 @@ else + INFO_DIR=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d ` + fi + fi +-if test -f "${INFO_DIR}dir" ; then true;else +-if test -f /usr/share/info/dir ; then +- INFO_DIR=/usr/share/info/ +-else true; +-fi +-fi +-echo "$ac_t""$INFO_DIR" 1>&6 ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INFO_DIR" >&5 ++$as_echo "$INFO_DIR" >&6; } + + +-echo $ac_n "checking for tcl/tk""... $ac_c" 1>&6 +-echo "configure:6259: checking for tcl/tk" >&5 ++if test "$enable_tcltk" = "yes" ; then ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for tcl/tk" >&5 ++$as_echo_n "checking for tcl/tk... " >&6; } + + + if test -d "${TCL_CONFIG_PREFIX}" ; then true ; else +@@ -6265,7 +7463,7 @@ cat >> conftest.tcl <&6 +-echo "configure:6282: checking for $ac_word" >&5 +-if eval "test \"`echo '$''{'ac_cv_prog_TCLSH'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 ++$as_echo_n "checking for $ac_word... " >&6; } ++if ${ac_cv_prog_TCLSH+:} false; then : ++ $as_echo_n "(cached) " >&6 + else + if test -n "$TCLSH"; then + ac_cv_prog_TCLSH="$TCLSH" # Let the user override the test. + else +- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" +- ac_dummy="$PATH" +- for ac_dir in $ac_dummy; do +- test -z "$ac_dir" && ac_dir=. +- if test -f $ac_dir/$ac_word; then +- ac_cv_prog_TCLSH="tclsh" +- break +- fi ++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ for ac_exec_ext in '' $ac_executable_extensions; do ++ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ++ ac_cv_prog_TCLSH="tclsh" ++ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 ++ break 2 ++ fi ++done + done +- IFS="$ac_save_ifs" ++IFS=$as_save_IFS ++ + test -z "$ac_cv_prog_TCLSH" && ac_cv_prog_TCLSH="${TCLSH}" + fi + fi +-TCLSH="$ac_cv_prog_TCLSH" ++TCLSH=$ac_cv_prog_TCLSH + if test -n "$TCLSH"; then +- echo "$ac_t""$TCLSH" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH" >&5 ++$as_echo "$TCLSH" >&6; } + else +- echo "$ac_t""no" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi + ++ + #AC_CHECK_PROG(TCLSH,tclsh8.0,tclsh8.0,${TCLSH}) + + if test "${TCLSH}" = "" ; then true ; else +@@ -6368,7 +7574,7 @@ if test -f ${TK_CONFIG_PREFIX}/../includ + else + if test -f /usr/include/tcl${TCL_VERSION}/tk.h ; then + TK_INCLUDE=-I/usr/include/tcl${TCL_VERSION} +- fi ++ fi + fi + if test -f ${TCL_CONFIG_PREFIX}/../include/tcl.h ; then + TCL_INCLUDE=-I${TCL_CONFIG_PREFIX}/../include +@@ -6377,41 +7583,43 @@ if test -f ${TCL_CONFIG_PREFIX}/../inclu + TCL_INCLUDE=-I/usr/include/tcl${TCL_VERSION} + fi + fi +-echo $ac_n "checking for main in -llieee""... $ac_c" 1>&6 +-echo "configure:6382: checking for main in -llieee" >&5 +-ac_lib_var=`echo lieee'_'main | sed 'y%./+-%__p_%'` +-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then +- echo $ac_n "(cached) $ac_c" 1>&6 ++ ++fi ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -llieee" >&5 ++$as_echo_n "checking for main in -llieee... " >&6; } ++if ${ac_cv_lib_lieee_main+:} false; then : ++ $as_echo_n "(cached) " >&6 + else +- ac_save_LIBS="$LIBS" ++ ac_check_lib_save_LIBS=$LIBS + LIBS="-llieee $LIBS" +-cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + +-int main() { +-main() +-; return 0; } +-EOF +-if { (eval echo configure:6397: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=yes" +-else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -rf conftest* +- eval "ac_cv_lib_$ac_lib_var=no" +-fi +-rm -f conftest* +-LIBS="$ac_save_LIBS" + +-fi +-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then +- echo "$ac_t""yes" 1>&6 ++int ++main () ++{ ++return main (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_lieee_main=yes ++else ++ ac_cv_lib_lieee_main=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_lieee_main" >&5 ++$as_echo "$ac_cv_lib_lieee_main" >&6; } ++if test "x$ac_cv_lib_lieee_main" = xyes; then : + have_ieee=1 + else +- echo "$ac_t""no" 1>&6 +-have_ieee=0 ++ have_ieee=0 + fi + + if test "$have_ieee" = "0" ; then +@@ -6442,84 +7650,75 @@ fi + + + if test -d "${TK_CONFIG_PREFIX}" ; then +-echo "$ac_t""using TK_VERSION=${TK_VERSION} in ${TK_CONFIG_PREFIX}" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: using TK_VERSION=${TK_VERSION} in ${TK_CONFIG_PREFIX}" >&5 ++$as_echo "using TK_VERSION=${TK_VERSION} in ${TK_CONFIG_PREFIX}" >&6; } + else +-echo "$ac_t""not found" 1>&6 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 ++$as_echo "not found" >&6; } + fi + + NOTIFY=$enable_notify + + +- ++ + + + # for sgbc the mprotect capabilities. + + # the time handling for unixtime, add timezone + +-echo $ac_n "checking alloca""... $ac_c" 1>&6 +-echo "configure:6462: checking alloca" >&5 +-if test "$cross_compiling" = yes; then ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking alloca" >&5 ++$as_echo_n "checking alloca... " >&6; } ++if test "$cross_compiling" = yes; then : + gcl_ok=no + else +- cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + int main() { exit(alloca(500) != NULL ? 0 : 1);} +-EOF +-if { (eval echo configure:6471: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- : ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* + gcl_ok=yes + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + if test $gcl_ok = yes ; then +- echo "$ac_t""yes" 1>&6 +- cat >> confdefs.h <<\EOF +-#define HAVE_ALLOCA 1 +-EOF ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++ $as_echo "#define HAVE_ALLOCA 1" >>confdefs.h + + else +- if test "$cross_compiling" = yes; then ++ if test "$cross_compiling" = yes; then : + gcl_ok=no + else +- cat > conftest.$ac_ext <conftest.$ac_ext ++/* end confdefs.h. */ + #include +- int main() { exit(alloca(500) != NULL ? 0 : 1)} +-EOF +-if { (eval echo configure:6499: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +-then +- : ++ int main() { exit(alloca(500) != NULL ? 0 : 1);} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ + else +- echo "configure: failed program was:" >&5 +- cat conftest.$ac_ext >&5 +- rm -fr conftest* + gcl_ok=yes + fi +-rm -fr conftest* ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + if test $gcl_ok = yes ; then +- echo "$ac_t""yes" 1>&6 +- cat >> confdefs.h <<\EOF +-#define HAVE_ALLOCA 1 +-EOF ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++ $as_echo "#define HAVE_ALLOCA 1" >>confdefs.h + +- cat >> confdefs.h <<\EOF +-#define NEED_ALLOCA_H 1 +-EOF ++ $as_echo "#define NEED_ALLOCA_H 1" >>confdefs.h + + fi + fi +-if test $gcl_ok = no ; then echo "$ac_t""no" 1>&6 ; fi ++if test $gcl_ok = no ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ; fi + + + +@@ -6535,7 +7734,7 @@ if test $gcl_ok = no ; then echo "$a + # dlopen etc + # idea make it so you do something dlopen(libX.so,RTLD_GLOBAL) + # then dlload("foo.o") a lisp file can refer to things in libX.so +-# ++# + + # what machine this is, and include then a machine specific hdr. + # and machine specific defs. +@@ -6555,26 +7754,28 @@ if test $gcl_ok = no ; then echo "$a + + # redhat/cygnus released for some reason a buggy version of gcc, + # which no one else released. Catch that here. +-echo $ac_n "checking Checking for buggy gcc version from redhat""... $ac_c" 1>&6 +-echo "configure:6560: checking Checking for buggy gcc version from redhat" >&5 +-if 2>&1 $CC -v | fgrep "gcc version 2.96" > /dev/null +- then ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Checking for buggy gcc version from redhat" >&5 ++$as_echo_n "checking Checking for buggy gcc version from redhat... " >&6; } ++if 2>&1 $CC -v | fgrep "gcc version 2.96" > /dev/null ++ then + BROKEN_O4_OPT=1 +- cat >> confdefs.h <<\EOF +-#define BROKEN_O4_OPT 1 +-EOF ++ $as_echo "#define BROKEN_O4_OPT 1" >>confdefs.h ++ + +- + echo ODIR_DEBUG=-O >> makedefsafter + echo >> makedefsafter +- echo "$ac_t""yes .. turning off -O4" 1>&6 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes .. turning off -O4" >&5 ++$as_echo "yes .. turning off -O4" >&6; } + else +- echo "$ac_t""no" 1>&6 +-fi ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ++fi ++ ++LDFLAGS="$LDFLAGS $TLDFLAGS" + +-LIBS="$LDFLAGS $TLDFLAGS $LIBS $TLIBS" ++LIBS="$LDFLAGS $X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $TLDFLAGS $LIBS $TLIBS" + +-FINAL_CFLAGS="$CFLAGS $TCFLAGS $PROCESSOR_FLAGS" ++FINAL_CFLAGS="$CFLAGS $X_CFLAGS $TCFLAGS $PROCESSOR_FLAGS" + + # Work around bug with gcc on ppc -- CM + NIFLAGS="$CFLAGS $TCFLAGS $TONIFLAGS $PROCESSOR_FLAGS -I\$(GCLDIR)/o" +@@ -6591,413 +7792,1295 @@ O2FLAGS=$TO2FLAGS + + if test -f h/$use.defs ; then + +- +- trap '' 1 2 15 +-cat > confcache <<\EOF ++ ++ ac_config_files="$ac_config_files makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp" ++ ++cat >confcache <<\_ACEOF + # This file is a shell script that caches the results of configure + # tests run on this system so they can be shared between configure +-# scripts and configure runs. It is not useful on other systems. +-# If it contains results you don't want to keep, you may remove or edit it. ++# scripts and configure runs, see configure's option --config-cache. ++# It is not useful on other systems. If it contains results you don't ++# want to keep, you may remove or edit it. + # +-# By default, configure uses ./config.cache as the cache file, +-# creating it if it does not exist already. You can give configure +-# the --cache-file=FILE option to use a different cache file; that is +-# what configure does when it calls configure scripts in +-# subdirectories, so they share the cache. +-# Giving --cache-file=/dev/null disables caching, for debugging configure. +-# config.status only pays attention to the cache file if you give it the +-# --recheck option to rerun configure. ++# config.status only pays attention to the cache file if you give it ++# the --recheck option to rerun configure. + # +-EOF ++# `ac_cv_env_foo' variables (set or unset) will be overridden when ++# loading this file, other *unset* `ac_cv_foo' will be assigned the ++# following values. ++ ++_ACEOF ++ + # The following way of writing the cache mishandles newlines in values, + # but we know of no workaround that is simple, portable, and efficient. +-# So, don't put newlines in cache variables' values. ++# So, we kill variables containing newlines. + # Ultrix sh set writes to stderr and can't be redirected directly, + # and sets the high bit in the cache file unless we assign to the vars. +-(set) 2>&1 | +- case `(ac_space=' '; set | grep ac_space) 2>&1` in +- *ac_space=\ *) +- # `set' does not quote correctly, so add quotes (double-quote substitution +- # turns \\\\ into \\, and sed turns \\ into \). +- sed -n \ +- -e "s/'/'\\\\''/g" \ +- -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p" +- ;; +- *) +- # `set' quotes correctly as required by POSIX, so do not add quotes. +- sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p' +- ;; +- esac >> confcache +-if cmp -s $cache_file confcache; then +- : +-else +- if test -w $cache_file; then +- echo "updating cache $cache_file" +- cat confcache > $cache_file ++( ++ for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do ++ eval ac_val=\$$ac_var ++ case $ac_val in #( ++ *${as_nl}*) ++ case $ac_var in #( ++ *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 ++$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; ++ esac ++ case $ac_var in #( ++ _ | IFS | as_nl) ;; #( ++ BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( ++ *) { eval $ac_var=; unset $ac_var;} ;; ++ esac ;; ++ esac ++ done ++ ++ (set) 2>&1 | ++ case $as_nl`(ac_space=' '; set) 2>&1` in #( ++ *${as_nl}ac_space=\ *) ++ # `set' does not quote correctly, so add quotes: double-quote ++ # substitution turns \\\\ into \\, and sed turns \\ into \. ++ sed -n \ ++ "s/'/'\\\\''/g; ++ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ++ ;; #( ++ *) ++ # `set' quotes correctly as required by POSIX, so do not add quotes. ++ sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ++ ;; ++ esac | ++ sort ++) | ++ sed ' ++ /^ac_cv_env_/b end ++ t clear ++ :clear ++ s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ ++ t end ++ s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ ++ :end' >>confcache ++if diff "$cache_file" confcache >/dev/null 2>&1; then :; else ++ if test -w "$cache_file"; then ++ if test "x$cache_file" != "x/dev/null"; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 ++$as_echo "$as_me: updating cache $cache_file" >&6;} ++ if test ! -f "$cache_file" || test -h "$cache_file"; then ++ cat confcache >"$cache_file" ++ else ++ case $cache_file in #( ++ */* | ?:*) ++ mv -f confcache "$cache_file"$$ && ++ mv -f "$cache_file"$$ "$cache_file" ;; #( ++ *) ++ mv -f confcache "$cache_file" ;; ++ esac ++ fi ++ fi + else +- echo "not updating unwritable cache $cache_file" ++ { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 ++$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi + fi + rm -f confcache + +-trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 +- + test "x$prefix" = xNONE && prefix=$ac_default_prefix + # Let make expand exec_prefix. + test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +-# Any assignment to VPATH causes Sun make to only execute +-# the first set of double-colon rules, so remove it if not needed. +-# If there is a colon in the path, we need to keep it. +-if test "x$srcdir" = x.; then +- ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d' +-fi ++DEFS=-DHAVE_CONFIG_H + +-trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 ++ac_libobjs= ++ac_ltlibobjs= ++U= ++for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue ++ # 1. Remove the extension, and $U if already installed. ++ ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ++ ac_i=`$as_echo "$ac_i" | sed "$ac_script"` ++ # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR ++ # will be set to the directory where LIBOBJS objects are built. ++ as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" ++ as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' ++done ++LIBOBJS=$ac_libobjs + +-DEFS=-DHAVE_CONFIG_H ++LTLIBOBJS=$ac_ltlibobjs + +-# Without the "./", some shells look in PATH for config.status. +-: ${CONFIG_STATUS=./config.status} + +-echo creating $CONFIG_STATUS +-rm -f $CONFIG_STATUS +-cat > $CONFIG_STATUS <&5 ++$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} ++as_write_fail=0 ++cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 ++#! $SHELL ++# Generated by $as_me. + # Run this file to recreate the current configuration. +-# This directory was configured as follows, +-# on host `(hostname || uname -n) 2>/dev/null | sed 1q`: +-# +-# $0 $ac_configure_args +-# + # Compiler output produced by configure, useful for debugging +-# configure, is in ./config.log if it exists. ++# configure, is in config.log if it exists. + +-ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" +-for ac_option ++debug=false ++ac_cs_recheck=false ++ac_cs_silent=false ++ ++SHELL=\${CONFIG_SHELL-$SHELL} ++export SHELL ++_ASEOF ++cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 ++## -------------------- ## ++## M4sh Initialization. ## ++## -------------------- ## ++ ++# Be more Bourne compatible ++DUALCASE=1; export DUALCASE # for MKS sh ++if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : ++ emulate sh ++ NULLCMD=: ++ # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which ++ # is contrary to our usage. Disable this feature. ++ alias -g '${1+"$@"}'='"$@"' ++ setopt NO_GLOB_SUBST ++else ++ case `(set -o) 2>/dev/null` in #( ++ *posix*) : ++ set -o posix ;; #( ++ *) : ++ ;; ++esac ++fi ++ ++ ++as_nl=' ++' ++export as_nl ++# Printing a long string crashes Solaris 7 /usr/bin/printf. ++as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' ++as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo ++as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo ++# Prefer a ksh shell builtin over an external printf program on Solaris, ++# but without wasting forks for bash or zsh. ++if test -z "$BASH_VERSION$ZSH_VERSION" \ ++ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then ++ as_echo='print -r --' ++ as_echo_n='print -rn --' ++elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then ++ as_echo='printf %s\n' ++ as_echo_n='printf %s' ++else ++ if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then ++ as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' ++ as_echo_n='/usr/ucb/echo -n' ++ else ++ as_echo_body='eval expr "X$1" : "X\\(.*\\)"' ++ as_echo_n_body='eval ++ arg=$1; ++ case $arg in #( ++ *"$as_nl"*) ++ expr "X$arg" : "X\\(.*\\)$as_nl"; ++ arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; ++ esac; ++ expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" ++ ' ++ export as_echo_n_body ++ as_echo_n='sh -c $as_echo_n_body as_echo' ++ fi ++ export as_echo_body ++ as_echo='sh -c $as_echo_body as_echo' ++fi ++ ++# The user is always right. ++if test "${PATH_SEPARATOR+set}" != set; then ++ PATH_SEPARATOR=: ++ (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { ++ (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || ++ PATH_SEPARATOR=';' ++ } ++fi ++ ++ ++# IFS ++# We need space, tab and new line, in precisely that order. Quoting is ++# there to prevent editors from complaining about space-tab. ++# (If _AS_PATH_WALK were called with IFS unset, it would disable word ++# splitting by setting IFS to empty value.) ++IFS=" "" $as_nl" ++ ++# Find who we are. Look in the path if we contain no directory separator. ++as_myself= ++case $0 in #(( ++ *[\\/]* ) as_myself=$0 ;; ++ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH + do +- case "\$ac_option" in +- -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) +- echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" +- exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; +- -version | --version | --versio | --versi | --vers | --ver | --ve | --v) +- echo "$CONFIG_STATUS generated by autoconf version 2.13" +- exit 0 ;; +- -help | --help | --hel | --he | --h) +- echo "\$ac_cs_usage"; exit 0 ;; +- *) echo "\$ac_cs_usage"; exit 1 ;; +- esac ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break ++ done ++IFS=$as_save_IFS ++ ++ ;; ++esac ++# We did not find ourselves, most probably we were run as `sh COMMAND' ++# in which case we are not to be found in the path. ++if test "x$as_myself" = x; then ++ as_myself=$0 ++fi ++if test ! -f "$as_myself"; then ++ $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 ++ exit 1 ++fi ++ ++# Unset variables that we do not need and which cause bugs (e.g. in ++# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" ++# suppresses any "Segmentation fault" message there. '((' could ++# trigger a bug in pdksh 5.2.14. ++for as_var in BASH_ENV ENV MAIL MAILPATH ++do eval test x\${$as_var+set} = xset \ ++ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : + done ++PS1='$ ' ++PS2='> ' ++PS4='+ ' + +-ac_given_srcdir=$srcdir ++# NLS nuisances. ++LC_ALL=C ++export LC_ALL ++LANGUAGE=C ++export LANGUAGE ++ ++# CDPATH. ++(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +-trap 'rm -fr `echo "makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp h/gclincl.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 +-EOF +-cat >> $CONFIG_STATUS < conftest.subs <<\\CEOF +-$ac_vpsub +-$extrasub +-s%@SHELL@%$SHELL%g +-s%@CFLAGS@%$CFLAGS%g +-s%@CPPFLAGS@%$CPPFLAGS%g +-s%@CXXFLAGS@%$CXXFLAGS%g +-s%@FFLAGS@%$FFLAGS%g +-s%@DEFS@%$DEFS%g +-s%@LDFLAGS@%$LDFLAGS%g +-s%@LIBS@%$LIBS%g +-s%@exec_prefix@%$exec_prefix%g +-s%@prefix@%$prefix%g +-s%@program_transform_name@%$program_transform_name%g +-s%@bindir@%$bindir%g +-s%@sbindir@%$sbindir%g +-s%@libexecdir@%$libexecdir%g +-s%@datadir@%$datadir%g +-s%@sysconfdir@%$sysconfdir%g +-s%@sharedstatedir@%$sharedstatedir%g +-s%@localstatedir@%$localstatedir%g +-s%@libdir@%$libdir%g +-s%@includedir@%$includedir%g +-s%@oldincludedir@%$oldincludedir%g +-s%@infodir@%$infodir%g +-s%@mandir@%$mandir%g +-s%@VERSION@%$VERSION%g +-s%@host@%$host%g +-s%@host_alias@%$host_alias%g +-s%@host_cpu@%$host_cpu%g +-s%@host_vendor@%$host_vendor%g +-s%@host_os@%$host_os%g +-s%@PROCESSOR_FLAGS@%$PROCESSOR_FLAGS%g +-s%@CC@%$CC%g +-s%@CPP@%$CPP%g +-s%@AWK@%$AWK%g +-s%@MAKEINFO@%$MAKEINFO%g +-s%@GMP@%$GMP%g +-s%@GMPDIR@%$GMPDIR%g +-s%@X_CFLAGS@%$X_CFLAGS%g +-s%@X_PRE_LIBS@%$X_PRE_LIBS%g +-s%@X_LIBS@%$X_LIBS%g +-s%@X_EXTRA_LIBS@%$X_EXTRA_LIBS%g +-s%@BUILD_BFD@%$BUILD_BFD%g +-s%@LITTLE_END@%$LITTLE_END%g +-s%@HAVE_LONG_LONG@%$HAVE_LONG_LONG%g +-s%@FLISP@%$FLISP%g +-s%@SYSTEM@%$SYSTEM%g +-s%@CLSTANDARD@%$CLSTANDARD%g +-s%@PAGEWIDTH@%$PAGEWIDTH%g +-s%@RL_OBJS@%$RL_OBJS%g +-s%@RL_LIB@%$RL_LIB%g +-s%@NO_PROFILE@%$NO_PROFILE%g +-s%@HAVE_SETENV@%$HAVE_SETENV%g +-s%@HAVE_PUTENV@%$HAVE_PUTENV%g +-s%@USE_CLEANUP@%$USE_CLEANUP%g +-s%@ENDIAN_ALREADY_DEFINED@%$ENDIAN_ALREADY_DEFINED%g +-s%@HAVE_SV_ONSTACK@%$HAVE_SV_ONSTACK%g +-s%@HAVE_SIGSYS@%$HAVE_SIGSYS%g +-s%@HAVE_SIGEMT@%$HAVE_SIGEMT%g +-s%@EMACS@%$EMACS%g +-s%@EMACS_SITE_LISP@%$EMACS_SITE_LISP%g +-s%@EMACS_DEFAULT_EL@%$EMACS_DEFAULT_EL%g +-s%@INFO_DIR@%$INFO_DIR%g +-s%@TCLSH@%$TCLSH%g +-s%@TK_CONFIG_PREFIX@%$TK_CONFIG_PREFIX%g +-s%@TK_LIBRARY@%$TK_LIBRARY%g +-s%@TCL_LIBRARY@%$TCL_LIBRARY%g +-s%@TK_XINCLUDES@%$TK_XINCLUDES%g +-s%@TK_INCLUDE@%$TK_INCLUDE%g +-s%@TCL_INCLUDE@%$TCL_INCLUDE%g +-s%@TK_LIB_SPEC@%$TK_LIB_SPEC%g +-s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%g +-s%@TK_XLIBSW@%$TK_XLIBSW%g +-s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g +-s%@TCL_DL_LIBS@%$TCL_DL_LIBS%g +-s%@TCL_LIBS@%$TCL_LIBS%g +-s%@NOTIFY@%$NOTIFY%g +-s%@BROKEN_O4_OPT@%$BROKEN_O4_OPT%g +-s%@FINAL_CFLAGS@%$FINAL_CFLAGS%g +-s%@NIFLAGS@%$NIFLAGS%g +-s%@O3FLAGS@%$O3FLAGS%g +-s%@O2FLAGS@%$O2FLAGS%g +-s%@EXTRA_LOBJS@%$EXTRA_LOBJS%g +-s%@LEADING_UNDERSCORE@%$LEADING_UNDERSCORE%g +-s%@GNU_LD@%$GNU_LD%g +-s%@use@%$use%g ++# as_fn_error STATUS ERROR [LINENO LOG_FD] ++# ---------------------------------------- ++# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are ++# provided, also output the error to LOG_FD, referencing LINENO. Then exit the ++# script with STATUS, using 1 if that was 0. ++as_fn_error () ++{ ++ as_status=$1; test $as_status -eq 0 && as_status=1 ++ if test "$4"; then ++ as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 ++ fi ++ $as_echo "$as_me: error: $2" >&2 ++ as_fn_exit $as_status ++} # as_fn_error + +-CEOF +-EOF + +-cat >> $CONFIG_STATUS <<\EOF ++# as_fn_set_status STATUS ++# ----------------------- ++# Set $? to STATUS, without forking. ++as_fn_set_status () ++{ ++ return $1 ++} # as_fn_set_status + +-# Split the substitutions into bite-sized pieces for seds with +-# small command number limits, like on Digital OSF/1 and HP-UX. +-ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script. +-ac_file=1 # Number of current file. +-ac_beg=1 # First line for current file. +-ac_end=$ac_max_sed_cmds # Line after last line for current file. +-ac_more_lines=: +-ac_sed_cmds="" +-while $ac_more_lines; do +- if test $ac_beg -gt 1; then +- sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file +- else +- sed "${ac_end}q" conftest.subs > conftest.s$ac_file +- fi +- if test ! -s conftest.s$ac_file; then +- ac_more_lines=false +- rm -f conftest.s$ac_file ++# as_fn_exit STATUS ++# ----------------- ++# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. ++as_fn_exit () ++{ ++ set +e ++ as_fn_set_status $1 ++ exit $1 ++} # as_fn_exit ++ ++# as_fn_unset VAR ++# --------------- ++# Portably unset VAR. ++as_fn_unset () ++{ ++ { eval $1=; unset $1;} ++} ++as_unset=as_fn_unset ++# as_fn_append VAR VALUE ++# ---------------------- ++# Append the text in VALUE to the end of the definition contained in VAR. Take ++# advantage of any shell optimizations that allow amortized linear growth over ++# repeated appends, instead of the typical quadratic growth present in naive ++# implementations. ++if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : ++ eval 'as_fn_append () ++ { ++ eval $1+=\$2 ++ }' ++else ++ as_fn_append () ++ { ++ eval $1=\$$1\$2 ++ } ++fi # as_fn_append ++ ++# as_fn_arith ARG... ++# ------------------ ++# Perform arithmetic evaluation on the ARGs, and store the result in the ++# global $as_val. Take advantage of shells that can avoid forks. The arguments ++# must be portable across $(()) and expr. ++if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : ++ eval 'as_fn_arith () ++ { ++ as_val=$(( $* )) ++ }' ++else ++ as_fn_arith () ++ { ++ as_val=`expr "$@" || test $? -eq 1` ++ } ++fi # as_fn_arith ++ ++ ++if expr a : '\(a\)' >/dev/null 2>&1 && ++ test "X`expr 00001 : '.*\(...\)'`" = X001; then ++ as_expr=expr ++else ++ as_expr=false ++fi ++ ++if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then ++ as_basename=basename ++else ++ as_basename=false ++fi ++ ++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then ++ as_dirname=dirname ++else ++ as_dirname=false ++fi ++ ++as_me=`$as_basename -- "$0" || ++$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ ++ X"$0" : 'X\(//\)$' \| \ ++ X"$0" : 'X\(/\)' \| . 2>/dev/null || ++$as_echo X/"$0" | ++ sed '/^.*\/\([^/][^/]*\)\/*$/{ ++ s//\1/ ++ q ++ } ++ /^X\/\(\/\/\)$/{ ++ s//\1/ ++ q ++ } ++ /^X\/\(\/\).*/{ ++ s//\1/ ++ q ++ } ++ s/.*/./; q'` ++ ++# Avoid depending upon Character Ranges. ++as_cr_letters='abcdefghijklmnopqrstuvwxyz' ++as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' ++as_cr_Letters=$as_cr_letters$as_cr_LETTERS ++as_cr_digits='0123456789' ++as_cr_alnum=$as_cr_Letters$as_cr_digits ++ ++ECHO_C= ECHO_N= ECHO_T= ++case `echo -n x` in #((((( ++-n*) ++ case `echo 'xy\c'` in ++ *c*) ECHO_T=' ';; # ECHO_T is single tab character. ++ xy) ECHO_C='\c';; ++ *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ++ ECHO_T=' ';; ++ esac;; ++*) ++ ECHO_N='-n';; ++esac ++ ++rm -f conf$$ conf$$.exe conf$$.file ++if test -d conf$$.dir; then ++ rm -f conf$$.dir/conf$$.file ++else ++ rm -f conf$$.dir ++ mkdir conf$$.dir 2>/dev/null ++fi ++if (echo >conf$$.file) 2>/dev/null; then ++ if ln -s conf$$.file conf$$ 2>/dev/null; then ++ as_ln_s='ln -s' ++ # ... but there are two gotchas: ++ # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. ++ # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. ++ # In both cases, we have to default to `cp -p'. ++ ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || ++ as_ln_s='cp -p' ++ elif ln conf$$.file conf$$ 2>/dev/null; then ++ as_ln_s=ln + else +- if test -z "$ac_sed_cmds"; then +- ac_sed_cmds="sed -f conftest.s$ac_file" +- else +- ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file" +- fi +- ac_file=`expr $ac_file + 1` +- ac_beg=$ac_end +- ac_end=`expr $ac_end + $ac_max_sed_cmds` ++ as_ln_s='cp -p' + fi +-done +-if test -z "$ac_sed_cmds"; then +- ac_sed_cmds=cat ++else ++ as_ln_s='cp -p' + fi +-EOF ++rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file ++rmdir conf$$.dir 2>/dev/null + +-cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF +-for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then +- # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". +- case "$ac_file" in +- *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` +- ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; +- *) ac_file_in="${ac_file}.in" ;; ++# as_fn_mkdir_p ++# ------------- ++# Create "$as_dir" as a directory, including parents if necessary. ++as_fn_mkdir_p () ++{ ++ ++ case $as_dir in #( ++ -*) as_dir=./$as_dir;; + esac ++ test -d "$as_dir" || eval $as_mkdir_p || { ++ as_dirs= ++ while :; do ++ case $as_dir in #( ++ *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( ++ *) as_qdir=$as_dir;; ++ esac ++ as_dirs="'$as_qdir' $as_dirs" ++ as_dir=`$as_dirname -- "$as_dir" || ++$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ ++ X"$as_dir" : 'X\(//\)[^/]' \| \ ++ X"$as_dir" : 'X\(//\)$' \| \ ++ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || ++$as_echo X"$as_dir" | ++ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ ++ s//\1/ ++ q ++ } ++ /^X\(\/\/\)[^/].*/{ ++ s//\1/ ++ q ++ } ++ /^X\(\/\/\)$/{ ++ s//\1/ ++ q ++ } ++ /^X\(\/\).*/{ ++ s//\1/ ++ q ++ } ++ s/.*/./; q'` ++ test -d "$as_dir" && break ++ done ++ test -z "$as_dirs" || eval "mkdir $as_dirs" ++ } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + +- # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. + +- # Remove last slash and all that follows it. Not all systems have dirname. +- ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` +- if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then +- # The file is in a subdirectory. +- test ! -d "$ac_dir" && mkdir "$ac_dir" +- ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" +- # A "../" for each directory in $ac_dir_suffix. +- ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` ++} # as_fn_mkdir_p ++if mkdir -p . 2>/dev/null; then ++ as_mkdir_p='mkdir -p "$as_dir"' ++else ++ test -d ./-p && rmdir ./-p ++ as_mkdir_p=false ++fi ++ ++if test -x / >/dev/null 2>&1; then ++ as_test_x='test -x' ++else ++ if ls -dL / >/dev/null 2>&1; then ++ as_ls_L_option=L + else +- ac_dir_suffix= ac_dots= ++ as_ls_L_option= + fi ++ as_test_x=' ++ eval sh -c '\'' ++ if test -d "$1"; then ++ test -d "$1/."; ++ else ++ case $1 in #( ++ -*)set "./$1";; ++ esac; ++ case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( ++ ???[sx]*):;;*)false;;esac;fi ++ '\'' sh ++ ' ++fi ++as_executable_p=$as_test_x ++ ++# Sed expression to map a string onto a valid CPP name. ++as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" ++ ++# Sed expression to map a string onto a valid variable name. ++as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" ++ ++ ++exec 6>&1 ++## ----------------------------------- ## ++## Main body of $CONFIG_STATUS script. ## ++## ----------------------------------- ## ++_ASEOF ++test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 ++ ++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ++# Save the log message, to keep $0 and so on meaningful, and to ++# report actual input values of CONFIG_FILES etc. instead of their ++# values after options handling. ++ac_log=" ++This file was extended by $as_me, which was ++generated by GNU Autoconf 2.68. Invocation command line was ++ ++ CONFIG_FILES = $CONFIG_FILES ++ CONFIG_HEADERS = $CONFIG_HEADERS ++ CONFIG_LINKS = $CONFIG_LINKS ++ CONFIG_COMMANDS = $CONFIG_COMMANDS ++ $ $0 $@ ++ ++on `(hostname || uname -n) 2>/dev/null | sed 1q` ++" + +- case "$ac_given_srcdir" in +- .) srcdir=. +- if test -z "$ac_dots"; then top_srcdir=. +- else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; +- /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; +- *) # Relative path. +- srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" +- top_srcdir="$ac_dots$ac_given_srcdir" ;; ++_ACEOF ++ ++case $ac_config_files in *" ++"*) set x $ac_config_files; shift; ac_config_files=$*;; ++esac ++ ++case $ac_config_headers in *" ++"*) set x $ac_config_headers; shift; ac_config_headers=$*;; ++esac ++ ++ ++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ++# Files that config.status was made for. ++config_files="$ac_config_files" ++config_headers="$ac_config_headers" ++ ++_ACEOF ++ ++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ++ac_cs_usage="\ ++\`$as_me' instantiates files and other configuration actions ++from templates according to the current configuration. Unless the files ++and actions are specified as TAGs, all are instantiated by default. ++ ++Usage: $0 [OPTION]... [TAG]... ++ ++ -h, --help print this help, then exit ++ -V, --version print version number and configuration settings, then exit ++ --config print configuration, then exit ++ -q, --quiet, --silent ++ do not print progress messages ++ -d, --debug don't remove temporary files ++ --recheck update $as_me by reconfiguring in the same conditions ++ --file=FILE[:TEMPLATE] ++ instantiate the configuration file FILE ++ --header=FILE[:TEMPLATE] ++ instantiate the configuration header FILE ++ ++Configuration files: ++$config_files ++ ++Configuration headers: ++$config_headers ++ ++Report bugs to the package provider." ++ ++_ACEOF ++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ++ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ++ac_cs_version="\\ ++config.status ++configured by $0, generated by GNU Autoconf 2.68, ++ with options \\"\$ac_cs_config\\" ++ ++Copyright (C) 2010 Free Software Foundation, Inc. ++This config.status script is free software; the Free Software Foundation ++gives unlimited permission to copy, distribute and modify it." ++ ++ac_pwd='$ac_pwd' ++srcdir='$srcdir' ++test -n "\$AWK" || AWK=awk ++_ACEOF ++ ++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ++# The default lists apply if the user does not specify any file. ++ac_need_defaults=: ++while test $# != 0 ++do ++ case $1 in ++ --*=?*) ++ ac_option=`expr "X$1" : 'X\([^=]*\)='` ++ ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ++ ac_shift=: ++ ;; ++ --*=) ++ ac_option=`expr "X$1" : 'X\([^=]*\)='` ++ ac_optarg= ++ ac_shift=: ++ ;; ++ *) ++ ac_option=$1 ++ ac_optarg=$2 ++ ac_shift=shift ++ ;; + esac + ++ case $ac_option in ++ # Handling of the options. ++ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ++ ac_cs_recheck=: ;; ++ --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) ++ $as_echo "$ac_cs_version"; exit ;; ++ --config | --confi | --conf | --con | --co | --c ) ++ $as_echo "$ac_cs_config"; exit ;; ++ --debug | --debu | --deb | --de | --d | -d ) ++ debug=: ;; ++ --file | --fil | --fi | --f ) ++ $ac_shift ++ case $ac_optarg in ++ *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; ++ '') as_fn_error $? "missing file argument" ;; ++ esac ++ as_fn_append CONFIG_FILES " '$ac_optarg'" ++ ac_need_defaults=false;; ++ --header | --heade | --head | --hea ) ++ $ac_shift ++ case $ac_optarg in ++ *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; ++ esac ++ as_fn_append CONFIG_HEADERS " '$ac_optarg'" ++ ac_need_defaults=false;; ++ --he | --h) ++ # Conflict between --help and --header ++ as_fn_error $? "ambiguous option: \`$1' ++Try \`$0 --help' for more information.";; ++ --help | --hel | -h ) ++ $as_echo "$ac_cs_usage"; exit ;; ++ -q | -quiet | --quiet | --quie | --qui | --qu | --q \ ++ | -silent | --silent | --silen | --sile | --sil | --si | --s) ++ ac_cs_silent=: ;; ++ ++ # This is an error. ++ -*) as_fn_error $? "unrecognized option: \`$1' ++Try \`$0 --help' for more information." ;; ++ ++ *) as_fn_append ac_config_targets " $1" ++ ac_need_defaults=false ;; + +- echo creating "$ac_file" +- rm -f "$ac_file" +- configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." +- case "$ac_file" in +- *Makefile*) ac_comsub="1i\\ +-# $configure_input" ;; +- *) ac_comsub= ;; + esac ++ shift ++done + +- ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` +- sed -e "$ac_comsub +-s%@configure_input@%$configure_input%g +-s%@srcdir@%$srcdir%g +-s%@top_srcdir@%$top_srcdir%g +-" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file +-fi; done +-rm -f conftest.s* ++ac_configure_extra_args= + +-# These sed commands are passed to sed as "A NAME B NAME C VALUE D", where +-# NAME is the cpp macro being defined and VALUE is the value it is being given. +-# +-# ac_d sets the value in "#define NAME VALUE" lines. +-ac_dA='s%^\([ ]*\)#\([ ]*define[ ][ ]*\)' +-ac_dB='\([ ][ ]*\)[^ ]*%\1#\2' +-ac_dC='\3' +-ac_dD='%g' +-# ac_u turns "#undef NAME" with trailing blanks into "#define NAME VALUE". +-ac_uA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' +-ac_uB='\([ ]\)%\1#\2define\3' +-ac_uC=' ' +-ac_uD='\4%g' +-# ac_e turns "#undef NAME" without trailing blanks into "#define NAME VALUE". +-ac_eA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' +-ac_eB='$%\1#\2define\3' +-ac_eC=' ' +-ac_eD='%g' ++if $ac_cs_silent; then ++ exec 6>/dev/null ++ ac_configure_extra_args="$ac_configure_extra_args --silent" ++fi + +-if test "${CONFIG_HEADERS+set}" != set; then +-EOF +-cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF ++_ACEOF ++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ++if \$ac_cs_recheck; then ++ set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion ++ shift ++ \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 ++ CONFIG_SHELL='$SHELL' ++ export CONFIG_SHELL ++ exec "\$@" + fi +-for ac_file in .. $CONFIG_HEADERS; do if test "x$ac_file" != x..; then +- # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". +- case "$ac_file" in +- *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` +- ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; +- *) ac_file_in="${ac_file}.in" ;; ++ ++_ACEOF ++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ++exec 5>>config.log ++{ ++ echo ++ sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ++## Running $as_me. ## ++_ASBOX ++ $as_echo "$ac_log" ++} >&5 ++ ++_ACEOF ++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ++_ACEOF ++ ++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ++ ++# Handling of arguments. ++for ac_config_target in $ac_config_targets ++do ++ case $ac_config_target in ++ "h/gclincl.h") CONFIG_HEADERS="$CONFIG_HEADERS h/gclincl.h" ;; ++ "makedefc") CONFIG_FILES="$CONFIG_FILES makedefc" ;; ++ "windows/gcl.iss") CONFIG_FILES="$CONFIG_FILES windows/gcl.iss" ;; ++ "windows/sysdir.bat") CONFIG_FILES="$CONFIG_FILES windows/sysdir.bat" ;; ++ "windows/install.lsp") CONFIG_FILES="$CONFIG_FILES windows/install.lsp" ;; ++ ++ *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac ++done + +- echo creating $ac_file + +- rm -f conftest.frag conftest.in conftest.out +- ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` +- cat $ac_file_inputs > conftest.in ++# If the user did not use the arguments to specify the items to instantiate, ++# then the envvar interface is used. Set only those that are not. ++# We use the long form for the default assignment because of an extremely ++# bizarre bug on SunOS 4.1.3. ++if $ac_need_defaults; then ++ test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files ++ test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers ++fi ++ ++# Have a temporary directory for convenience. Make it in the build tree ++# simply because there is no reason against having it here, and in addition, ++# creating and moving files from /tmp can sometimes cause problems. ++# Hook for its removal unless debugging. ++# Note that there is a small window in which the directory will not be cleaned: ++# after its creation but before its name has been assigned to `$tmp'. ++$debug || ++{ ++ tmp= ac_tmp= ++ trap 'exit_status=$? ++ : "${ac_tmp:=$tmp}" ++ { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status ++' 0 ++ trap 'as_fn_exit 1' 1 2 13 15 ++} ++# Create a (secure) tmp directory for tmp files. + +-EOF ++{ ++ tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && ++ test -d "$tmp" ++} || ++{ ++ tmp=./conf$$-$RANDOM ++ (umask 077 && mkdir "$tmp") ++} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 ++ac_tmp=$tmp + +-# Transform confdefs.h into a sed script conftest.vals that substitutes +-# the proper values into config.h.in to produce config.h. And first: +-# Protect against being on the right side of a sed subst in config.status. +-# Protect against being in an unquoted here document in config.status. +-rm -f conftest.vals +-cat > conftest.hdr <<\EOF +-s/[\\&%]/\\&/g +-s%[\\$`]%\\&%g +-s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD}%gp +-s%ac_d%ac_u%gp +-s%ac_u%ac_e%gp +-EOF +-sed -n -f conftest.hdr confdefs.h > conftest.vals +-rm -f conftest.hdr ++# Set up the scripts for CONFIG_FILES section. ++# No need to generate them if there are no CONFIG_FILES. ++# This happens for instance with `./config.status config.h'. ++if test -n "$CONFIG_FILES"; then + +-# This sed command replaces #undef with comments. This is necessary, for +-# example, in the case of _POSIX_SOURCE, which is predefined and required +-# on some systems where configure will not decide to define it. +-cat >> conftest.vals <<\EOF +-s%^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*%/* & */% +-EOF + +-# Break up conftest.vals because some shells have a limit on +-# the size of here documents, and old seds have small limits too. ++ac_cr=`echo X | tr X '\015'` ++# On cygwin, bash can eat \r inside `` if the user requested igncr. ++# But we know of no other shell where ac_cr would be empty at this ++# point, so we can use a bashism as a fallback. ++if test "x$ac_cr" = x; then ++ eval ac_cr=\$\'\\r\' ++fi ++ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` ++if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then ++ ac_cs_awk_cr='\\r' ++else ++ ac_cs_awk_cr=$ac_cr ++fi ++ ++echo 'BEGIN {' >"$ac_tmp/subs1.awk" && ++_ACEOF + +-rm -f conftest.tail +-while : +-do +- ac_lines=`grep -c . conftest.vals` +- # grep -c gives empty output for an empty file on some AIX systems. +- if test -z "$ac_lines" || test "$ac_lines" -eq 0; then break; fi +- # Write a limited-size here document to conftest.frag. +- echo ' cat > conftest.frag <> $CONFIG_STATUS +- sed ${ac_max_here_lines}q conftest.vals >> $CONFIG_STATUS +- echo 'CEOF +- sed -f conftest.frag conftest.in > conftest.out +- rm -f conftest.in +- mv conftest.out conftest.in +-' >> $CONFIG_STATUS +- sed 1,${ac_max_here_lines}d conftest.vals > conftest.tail +- rm -f conftest.vals +- mv conftest.tail conftest.vals +-done +-rm -f conftest.vals +- +-cat >> $CONFIG_STATUS <<\EOF +- rm -f conftest.frag conftest.h +- echo "/* $ac_file. Generated automatically by configure. */" > conftest.h +- cat conftest.in >> conftest.h +- rm -f conftest.in +- if cmp -s $ac_file conftest.h 2>/dev/null; then +- echo "$ac_file is unchanged" +- rm -f conftest.h ++ ++{ ++ echo "cat >conf$$subs.awk <<_ACEOF" && ++ echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && ++ echo "_ACEOF" ++} >conf$$subs.sh || ++ as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 ++ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` ++ac_delim='%!_!# ' ++for ac_last_try in false false false false false :; do ++ . ./conf$$subs.sh || ++ as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 ++ ++ ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` ++ if test $ac_delim_n = $ac_delim_num; then ++ break ++ elif $ac_last_try; then ++ as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else +- # Remove last slash and all that follows it. Not all systems have dirname. +- ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` +- if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then +- # The file is in a subdirectory. +- test ! -d "$ac_dir" && mkdir "$ac_dir" ++ ac_delim="$ac_delim!$ac_delim _$ac_delim!! " ++ fi ++done ++rm -f conf$$subs.sh ++ ++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ++cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && ++_ACEOF ++sed -n ' ++h ++s/^/S["/; s/!.*/"]=/ ++p ++g ++s/^[^!]*!// ++:repl ++t repl ++s/'"$ac_delim"'$// ++t delim ++:nl ++h ++s/\(.\{148\}\)..*/\1/ ++t more1 ++s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ ++p ++n ++b repl ++:more1 ++s/["\\]/\\&/g; s/^/"/; s/$/"\\/ ++p ++g ++s/.\{148\}// ++t nl ++:delim ++h ++s/\(.\{148\}\)..*/\1/ ++t more2 ++s/["\\]/\\&/g; s/^/"/; s/$/"/ ++p ++b ++:more2 ++s/["\\]/\\&/g; s/^/"/; s/$/"\\/ ++p ++g ++s/.\{148\}// ++t delim ++' >$CONFIG_STATUS || ac_write_fail=1 ++rm -f conf$$subs.awk ++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ++_ACAWK ++cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && ++ for (key in S) S_is_set[key] = 1 ++ FS = "" ++ ++} ++{ ++ line = $ 0 ++ nfields = split(line, field, "@") ++ substed = 0 ++ len = length(field[1]) ++ for (i = 2; i < nfields; i++) { ++ key = field[i] ++ keylen = length(key) ++ if (S_is_set[key]) { ++ value = S[key] ++ line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) ++ len += length(value) + length(field[++i]) ++ substed = 1 ++ } else ++ len += 1 + keylen ++ } ++ ++ print line ++} ++ ++_ACAWK ++_ACEOF ++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ++if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then ++ sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" ++else ++ cat ++fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ ++ || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 ++_ACEOF ++ ++# VPATH may cause trouble with some makes, so we remove sole $(srcdir), ++# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and ++# trailing colons and then remove the whole line if VPATH becomes empty ++# (actually we leave an empty line to preserve line numbers). ++if test "x$srcdir" = x.; then ++ ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ ++h ++s/// ++s/^/:/ ++s/[ ]*$/:/ ++s/:\$(srcdir):/:/g ++s/:\${srcdir}:/:/g ++s/:@srcdir@:/:/g ++s/^:*// ++s/:*$// ++x ++s/\(=[ ]*\).*/\1/ ++G ++s/\n// ++s/^[^=]*=[ ]*$// ++}' ++fi ++ ++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ++fi # test -n "$CONFIG_FILES" ++ ++# Set up the scripts for CONFIG_HEADERS section. ++# No need to generate them if there are no CONFIG_HEADERS. ++# This happens for instance with `./config.status Makefile'. ++if test -n "$CONFIG_HEADERS"; then ++cat >"$ac_tmp/defines.awk" <<\_ACAWK || ++BEGIN { ++_ACEOF ++ ++# Transform confdefs.h into an awk script `defines.awk', embedded as ++# here-document in config.status, that substitutes the proper values into ++# config.h.in to produce config.h. ++ ++# Create a delimiter string that does not exist in confdefs.h, to ease ++# handling of long lines. ++ac_delim='%!_!# ' ++for ac_last_try in false false :; do ++ ac_tt=`sed -n "/$ac_delim/p" confdefs.h` ++ if test -z "$ac_tt"; then ++ break ++ elif $ac_last_try; then ++ as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 ++ else ++ ac_delim="$ac_delim!$ac_delim _$ac_delim!! " ++ fi ++done ++ ++# For the awk script, D is an array of macro values keyed by name, ++# likewise P contains macro parameters if any. Preserve backslash ++# newline sequences. ++ ++ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* ++sed -n ' ++s/.\{148\}/&'"$ac_delim"'/g ++t rset ++:rset ++s/^[ ]*#[ ]*define[ ][ ]*/ / ++t def ++d ++:def ++s/\\$// ++t bsnl ++s/["\\]/\\&/g ++s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ ++D["\1"]=" \3"/p ++s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2"/p ++d ++:bsnl ++s/["\\]/\\&/g ++s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ ++D["\1"]=" \3\\\\\\n"\\/p ++t cont ++s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p ++t cont ++d ++:cont ++n ++s/.\{148\}/&'"$ac_delim"'/g ++t clear ++:clear ++s/\\$// ++t bsnlc ++s/["\\]/\\&/g; s/^/"/; s/$/"/p ++d ++:bsnlc ++s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p ++b cont ++' >$CONFIG_STATUS || ac_write_fail=1 ++ ++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ++ for (key in D) D_is_set[key] = 1 ++ FS = "" ++} ++/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ { ++ line = \$ 0 ++ split(line, arg, " ") ++ if (arg[1] == "#") { ++ defundef = arg[2] ++ mac1 = arg[3] ++ } else { ++ defundef = substr(arg[1], 2) ++ mac1 = arg[2] ++ } ++ split(mac1, mac2, "(") #) ++ macro = mac2[1] ++ prefix = substr(line, 1, index(line, defundef) - 1) ++ if (D_is_set[macro]) { ++ # Preserve the white space surrounding the "#". ++ print prefix "define", macro P[macro] D[macro] ++ next ++ } else { ++ # Replace #undef with comments. This is necessary, for example, ++ # in the case of _POSIX_SOURCE, which is predefined and required ++ # on some systems where configure will not decide to define it. ++ if (defundef == "undef") { ++ print "/*", prefix defundef, macro, "*/" ++ next ++ } ++ } ++} ++{ print } ++_ACAWK ++_ACEOF ++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ++ as_fn_error $? "could not setup config headers machinery" "$LINENO" 5 ++fi # test -n "$CONFIG_HEADERS" ++ ++ ++eval set X " :F $CONFIG_FILES :H $CONFIG_HEADERS " ++shift ++for ac_tag ++do ++ case $ac_tag in ++ :[FHLC]) ac_mode=$ac_tag; continue;; ++ esac ++ case $ac_mode$ac_tag in ++ :[FHL]*:*);; ++ :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; ++ :[FH]-) ac_tag=-:-;; ++ :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; ++ esac ++ ac_save_IFS=$IFS ++ IFS=: ++ set x $ac_tag ++ IFS=$ac_save_IFS ++ shift ++ ac_file=$1 ++ shift ++ ++ case $ac_mode in ++ :L) ac_source=$1;; ++ :[FH]) ++ ac_file_inputs= ++ for ac_f ++ do ++ case $ac_f in ++ -) ac_f="$ac_tmp/stdin";; ++ *) # Look for the file first in the build tree, then in the source tree ++ # (if the path is not absolute). The absolute path cannot be DOS-style, ++ # because $ac_f cannot contain `:'. ++ test -f "$ac_f" || ++ case $ac_f in ++ [\\/$]*) false;; ++ *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; ++ esac || ++ as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; ++ esac ++ case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac ++ as_fn_append ac_file_inputs " '$ac_f'" ++ done ++ ++ # Let's still pretend it is `configure' which instantiates (i.e., don't ++ # use $as_me), people would be surprised to read: ++ # /* config.h. Generated by config.status. */ ++ configure_input='Generated from '` ++ $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' ++ `' by configure.' ++ if test x"$ac_file" != x-; then ++ configure_input="$ac_file. $configure_input" ++ { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 ++$as_echo "$as_me: creating $ac_file" >&6;} ++ fi ++ # Neutralize special characters interpreted by sed in replacement strings. ++ case $configure_input in #( ++ *\&* | *\|* | *\\* ) ++ ac_sed_conf_input=`$as_echo "$configure_input" | ++ sed 's/[\\\\&|]/\\\\&/g'`;; #( ++ *) ac_sed_conf_input=$configure_input;; ++ esac ++ ++ case $ac_tag in ++ *:-:* | *:-) cat >"$ac_tmp/stdin" \ ++ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; ++ esac ++ ;; ++ esac ++ ++ ac_dir=`$as_dirname -- "$ac_file" || ++$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ ++ X"$ac_file" : 'X\(//\)[^/]' \| \ ++ X"$ac_file" : 'X\(//\)$' \| \ ++ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || ++$as_echo X"$ac_file" | ++ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ ++ s//\1/ ++ q ++ } ++ /^X\(\/\/\)[^/].*/{ ++ s//\1/ ++ q ++ } ++ /^X\(\/\/\)$/{ ++ s//\1/ ++ q ++ } ++ /^X\(\/\).*/{ ++ s//\1/ ++ q ++ } ++ s/.*/./; q'` ++ as_dir="$ac_dir"; as_fn_mkdir_p ++ ac_builddir=. ++ ++case "$ac_dir" in ++.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; ++*) ++ ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` ++ # A ".." for each directory in $ac_dir_suffix. ++ ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` ++ case $ac_top_builddir_sub in ++ "") ac_top_builddir_sub=. ac_top_build_prefix= ;; ++ *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; ++ esac ;; ++esac ++ac_abs_top_builddir=$ac_pwd ++ac_abs_builddir=$ac_pwd$ac_dir_suffix ++# for backward compatibility: ++ac_top_builddir=$ac_top_build_prefix ++ ++case $srcdir in ++ .) # We are building in place. ++ ac_srcdir=. ++ ac_top_srcdir=$ac_top_builddir_sub ++ ac_abs_top_srcdir=$ac_pwd ;; ++ [\\/]* | ?:[\\/]* ) # Absolute name. ++ ac_srcdir=$srcdir$ac_dir_suffix; ++ ac_top_srcdir=$srcdir ++ ac_abs_top_srcdir=$srcdir ;; ++ *) # Relative name. ++ ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ++ ac_top_srcdir=$ac_top_build_prefix$srcdir ++ ac_abs_top_srcdir=$ac_pwd/$srcdir ;; ++esac ++ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix ++ ++ ++ case $ac_mode in ++ :F) ++ # ++ # CONFIG_FILE ++ # ++ ++_ACEOF ++ ++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ++# If the template does not know about datarootdir, expand it. ++# FIXME: This hack should be removed a few years after 2.60. ++ac_datarootdir_hack=; ac_datarootdir_seen= ++ac_sed_dataroot=' ++/datarootdir/ { ++ p ++ q ++} ++/@datadir@/p ++/@docdir@/p ++/@infodir@/p ++/@localedir@/p ++/@mandir@/p' ++case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in ++*datarootdir*) ac_datarootdir_seen=yes;; ++*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 ++$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} ++_ACEOF ++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ++ ac_datarootdir_hack=' ++ s&@datadir@&$datadir&g ++ s&@docdir@&$docdir&g ++ s&@infodir@&$infodir&g ++ s&@localedir@&$localedir&g ++ s&@mandir@&$mandir&g ++ s&\\\${datarootdir}&$datarootdir&g' ;; ++esac ++_ACEOF ++ ++# Neutralize VPATH when `$srcdir' = `.'. ++# Shell code in configure.ac might set extrasub. ++# FIXME: do we really want to maintain this feature? ++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ++ac_sed_extra="$ac_vpsub ++$extrasub ++_ACEOF ++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ++:t ++/@[a-zA-Z_][a-zA-Z_0-9]*@/!b ++s|@configure_input@|$ac_sed_conf_input|;t t ++s&@top_builddir@&$ac_top_builddir_sub&;t t ++s&@top_build_prefix@&$ac_top_build_prefix&;t t ++s&@srcdir@&$ac_srcdir&;t t ++s&@abs_srcdir@&$ac_abs_srcdir&;t t ++s&@top_srcdir@&$ac_top_srcdir&;t t ++s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t ++s&@builddir@&$ac_builddir&;t t ++s&@abs_builddir@&$ac_abs_builddir&;t t ++s&@abs_top_builddir@&$ac_abs_top_builddir&;t t ++$ac_datarootdir_hack ++" ++eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ ++ >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ++ ++test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && ++ { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && ++ { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ ++ "$ac_tmp/out"`; test -z "$ac_out"; } && ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' ++which seems to be undefined. Please make sure it is defined" >&5 ++$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' ++which seems to be undefined. Please make sure it is defined" >&2;} ++ ++ rm -f "$ac_tmp/stdin" ++ case $ac_file in ++ -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; ++ *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; ++ esac \ ++ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ++ ;; ++ :H) ++ # ++ # CONFIG_HEADER ++ # ++ if test x"$ac_file" != x-; then ++ { ++ $as_echo "/* $configure_input */" \ ++ && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" ++ } >"$ac_tmp/config.h" \ ++ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ++ if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 ++$as_echo "$as_me: $ac_file is unchanged" >&6;} ++ else ++ rm -f "$ac_file" ++ mv "$ac_tmp/config.h" "$ac_file" \ ++ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + fi +- rm -f $ac_file +- mv conftest.h $ac_file ++ else ++ $as_echo "/* $configure_input */" \ ++ && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ ++ || as_fn_error $? "could not create -" "$LINENO" 5 + fi +-fi; done ++ ;; + +-EOF +-cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF ++ esac + +-exit 0 +-EOF +-chmod +x $CONFIG_STATUS +-rm -fr confdefs* $ac_clean_files +-test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 ++done # for ac_tag ++ ++ ++as_fn_exit 0 ++_ACEOF ++ac_clean_files=$ac_clean_files_save ++ ++test $ac_write_fail = 0 || ++ as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 ++ ++ ++# configure is writing to config.log, and then calls config.status. ++# config.status does its own redirection, appending to config.log. ++# Unfortunately, on DOS this fails, as config.log is still kept open ++# by configure, so config.status won't be able to write to it; its ++# output is simply discarded. So we exec the FD to /dev/null, ++# effectively closing config.log, so it can be properly (re)opened and ++# appended to by config.status. When coming back to configure, we ++# need to make the FD available again. ++if test "$no_create" != yes; then ++ ac_cs_success=: ++ ac_config_status_args= ++ test "$silent" = yes && ++ ac_config_status_args="$ac_config_status_args --quiet" ++ exec 5>/dev/null ++ $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false ++ exec 5>>config.log ++ # Use ||, not &&, to avoid exiting from the if with $? = 1, which ++ # would make configure fail if this is the last instruction. ++ $ac_cs_success || as_fn_exit 1 ++fi ++if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 ++$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} ++fi + + echo makedefc + cat makedefc +--- gcl-2.6.7.orig/japitest.lsp ++++ gcl-2.6.7/japitest.lsp +@@ -1,369 +1,369 @@ +-;;; +-;;; Japi is a cross-platform, easy to use (rough and ready) Java based GUI library +-;;; Download a library and headers for your platform, and get the C examples +-;;; and documentation from: +-;;; +-;;; http://www.japi.de/ +-;;; +-;;; This file shows how to use some of the available functions. You may assume +-;;; that the only functions tested so far in the binding are those which appear +-;;; below, as this file doubles as the test program. The binding is so simple +-;;; however that so far no binding (APART FROM J_PRINT) has gone wrong of those +-;;; tested so far! +-;;; +-;;; +-;;; HOW TO USE THIS FILE +-;;; +-;;; (compile-file "c:/cvs/gcl/japitest.lsp") (load "c:/cvs/gcl/japitest.o") +-;;; +-;;; Requires either "java" or "jre" in the path to work. +-;;; +- +-(in-package :japi-primitives) +- +-;; Start up the Japi server (needs to find either "java" or "jre" in your path +-(defmacro with-server ((app-name debug-level) . body) +- (multiple-value-bind (ds b) +- (si::find-declarations body) +- `(if (= 0 (jpr::j_start)) +- (format t (format nil "~S can't connect to the Japi GUI server." ,app-name)) +- (progn +- (j_setdebug ,debug-level) +- ,@ds +- (unwind-protect +- (progn ,@b) +- (j_quit)))))) +- +-;; Use a frame and clean up afterwards even if trouble ensues +-(defmacro with-frame ((frame-var-name title) . body) +- (multiple-value-bind (ds b) +- (si::find-declarations body) +- `(let ((,frame-var-name (j_frame ,title))) +- ,@ds +- (unwind-protect +- (progn ,@b) +- (j_dispose ,frame-var-name))))) +- +-;; Use a canvas and clean up afterwards even if trouble ensues +-(defmacro with-canvas ((canvas-var-name frame-obj x-size y-size) . body) +- (multiple-value-bind (ds b) +- (si::find-declarations body) +- `(let ((,canvas-var-name (j_canvas ,frame-obj ,x-size ,y-size))) +- ,@ds +- (unwind-protect +- (progn ,@b) +- (j_dispose ,canvas-var-name))))) +- +-;; Use a text area and clean up afterwards even if trouble ensues +-(defmacro with-text-area ((text-area-var-name panel-obj x-size y-size) . body) +- (multiple-value-bind (ds b) +- (si::find-declarations body) +- `(let ((,text-area-var-name (j_textarea ,panel-obj ,x-size ,y-size))) +- ,@ds +- (unwind-protect +- (progn ,@b) +- (j_dispose ,text-area-var-name))))) +- +-;; Use a pulldown menu bar and clean up afterwards even if trouble ensues +-(defmacro with-menu-bar ((bar-var-name frame-obj) . body) +- (multiple-value-bind (ds b) +- (si::find-declarations body) +- `(let ((,bar-var-name (j_menubar ,frame-obj))) +- ,@ds +- (unwind-protect +- (progn ,@b) +- (j_dispose ,bar-var-name))))) +- +-;; Add a pulldown menu and clean up afterwards even if trouble ensues +-(defmacro with-menu ((menu-var-name bar-obj title) . body) +- (multiple-value-bind (ds b) +- (si::find-declarations body) +- `(let ((,menu-var-name (j_menu ,bar-obj ,title))) +- ,@ds +- (unwind-protect +- (progn ,@b) +- (j_dispose ,menu-var-name))))) +- +-;; Add a pulldown menu item and clean up afterwards even if trouble ensues +-(defmacro with-menu-item ((item-var-name menu-obj title) . body) +- (multiple-value-bind (ds b) +- (si::find-declarations body) +- `(let ((,item-var-name (j_menuitem ,menu-obj ,title))) +- ,@ds +- (unwind-protect +- (progn ,@b) +- (j_dispose ,item-var-name))))) +- +-;; Add a mouse listener and clean up afterwards even if trouble ensues +-(defmacro with-mouse-listener ((var-name obj type) . body) +- (multiple-value-bind (ds b) +- (si::find-declarations body) +- `(let ((,var-name (j_mouselistener ,obj ,type))) +- ,@ds +- (unwind-protect +- (progn ,@b) +- (j_dispose ,var-name))))) +- +-;; Use a panel and clean up afterwards even if trouble ensues +-(defmacro with-panel ((panel-var-name frame-obj) . body) +- (multiple-value-bind (ds b) +- (si::find-declarations body) +- `(let ((,panel-var-name (j_panel ,frame-obj))) +- ,@ds +- (unwind-protect +- (progn ,@b) +- (j_dispose ,panel-var-name))))) +- +- +-;; Run a five second frame in a Japi server +-(with-server ("GCL Japi library test GUI 1" 0) +- (with-frame (frame "Five Second Blank Test Frame") +- (j_show frame) +- (j_sleep 5000))) +- +-;; Get a pointer to an array of ints +-(defCfun "static void* inta_ptr(object s)" 0 +- " return(s->fixa.fixa_self);") +-(defentry inta-ptr (object) (int "inta_ptr")) +- +-;; Draw function +-(defun drawgraphics (drawable xmin ymin xmax ymax) +- (let* ((fntsize 10) +- (tmpstrx (format nil "XMax = ~D" xmax)) +- (tmpstry (format nil "YMax = ~D" ymax)) +- (tmpstrwidx (j_getstringwidth drawable tmpstrx))) +- (j_setfontsize drawable fntsize) +- (j_setnamedcolor drawable J_RED) +- +- (j_drawline drawable xmin ymin (- xmax 1) (- ymax 1)) +- (j_drawline drawable xmin (- ymax 1) (- xmax 1) ymin) +- (j_drawrect drawable xmin ymin (- xmax xmin 1) (- ymax xmin 1)) +- +- (j_setnamedcolor drawable J_BLACK) +- (j_drawline drawable xmin (- ymax 30) (- xmax 1) (- ymax 30)) +- (j_drawstring drawable (- (/ xmax 2) (/ tmpstrwidx 2)) (- ymax 40) tmpstrx) +- +- (j_drawline drawable (+ xmin 30) ymin (+ xmin 30) (- ymax 1)) +- (j_drawstring drawable (+ xmin 50) 40 tmpstry) +- +- (j_setnamedcolor drawable J_MAGENTA) +- (loop for i from 1 to 10 +- do (j_drawoval drawable +- (+ xmin (/ (- xmax xmin) 2)) +- (+ ymin (/ (- ymax ymin) 2)) +- (* (/ (- xmax xmin) 20) i) +- (* (/ (- ymax ymin) 20) i))) +- +- (j_setnamedcolor drawable J_BLUE) +- (let ((y ymin) +- (teststr "JAPI Test Text")) +- (loop for i from 5 to 21 do +- (j_setfontsize drawable i) +- (let ((x (- xmax (j_getstringwidth drawable teststr)))) +- (setf y (+ y (j_getfontheight drawable))) +- (j_drawstring drawable x y teststr)))))) +- +-;; Run some more extensive tests +-(with-server +- ("GCL Japi library test GUI 2" 0) +- (with-frame +- (frame "Draw") +- (j_show frame) +- (let ((alert (j_messagebox frame "Two second alert box" "label"))) +- (j_sleep 2000) +- (j_dispose alert)) +- (let ((result1 (j_alertbox frame "label1" "label2" "OK")) +- (result2 (j_choicebox2 frame "label1" "label2" "Yes" "No")) +- (result3 (j_choicebox3 frame "label1" "label2" "Yes" "No" "Cancel"))) +- (format t "Requestor results were: ~D, ~D, ~D~%" result1 result2 result3)) +- (j_setborderlayout frame) +- (with-menu-bar +- (menubar frame) +- (with-menu +- (file menubar "File") +- (with-menu-item +- (print file "Print") +- (with-menu-item +- (save file "Save BMP") +- (with-menu-item +- (quit file "Quit") +- (with-canvas +- (canvas frame 400 600) +- (j_pack frame) +- (drawgraphics canvas 0 0 (j_getwidth canvas) (j_getheight canvas)) +- (j_show frame) +- (do ((obj (j_nextaction) (j_nextaction))) +- ((or (= obj frame) (= obj quit)) t) +- (when (= obj canvas) +- (j_setnamedcolorbg canvas J_WHITE) +- (drawgraphics canvas 10 10 +- (- (j_getwidth canvas) 10) +- (- (j_getheight canvas) 10))) +- (when (= obj print) +- (let ((printer (j_printer frame))) +- (when (> 0 printer) +- (drawgraphics printer 40 40 +- (- (j_getwidth printer) 80) +- (- (j_getheight printer) 80)) +- (j_print printer)))) +- (when (= obj save) +- (let ((image (j_image 600 800))) +- (drawgraphics image 0 0 600 800) +- (when (= 0 (j_saveimage image "test.bmp" J_BMP)) +- (j_alertbox frame "Problems" "Can't save the image" "OK"))))))))))))) +-;; Try some mouse handling +-(with-server +- ("GCL Japi library test GUI 3" 0) +- (with-frame +- (frame "Move and drag the mouse") +- (j_setsize frame 430 240) +- (j_setnamedcolorbg frame J_LIGHT_GRAY) +- (with-canvas +- (canvas1 frame 200 200) +- (with-canvas +- (canvas2 frame 200 200) +- (j_setpos canvas1 10 30) +- (j_setpos canvas2 220 30) +- (with-mouse-listener +- (pressed canvas1 J_PRESSED) +- (with-mouse-listener +- (dragged canvas1 J_DRAGGED) +- (with-mouse-listener +- (released canvas1 J_RELEASED) +- (with-mouse-listener +- (entered canvas2 J_ENTERERD) +- (with-mouse-listener +- (moved canvas2 J_MOVED) +- (with-mouse-listener +- (exited canvas2 J_EXITED) +- (j_show frame) +- ;; Allocate immovable storage for passing data back from C land. +- ;; Uses the GCL only make-array keyword :static +- (let* ((xa (make-array 1 :initial-element 0 :element-type 'fixnum :static t)) +- (ya (make-array 1 :initial-element 0 :element-type 'fixnum :static t)) +- (pxa (inta-ptr xa)) +- (pya (inta-ptr ya)) +- (x 0) +- (y 0) +- (get-mouse-xy (lambda (obj) +- (progn (j_getmousepos obj pxa pya) +- (setf x (aref xa 0)) +- (setf y (aref ya 0))))) +- (startx 0) +- (starty 0)) +- (do ((obj (j_nextaction) (j_nextaction))) +- ((= obj frame) t) +- (when (= obj pressed) +- (funcall get-mouse-xy pressed) +- (setf startx x) +- (setf starty y)) +- (when (= obj dragged) +- (funcall get-mouse-xy dragged) +- (j_drawrect canvas1 startx starty (- x startx) (- y starty))) +- (when (= obj released) +- (funcall get-mouse-xy released) +- (j_drawrect canvas1 startx starty (- x startx) (- y starty))) +- (when (= obj entered) +- (funcall get-mouse-xy entered) +- (setf startx x) +- (setf starty y)) +- (when (= obj moved) +- (funcall get-mouse-xy moved) +- (j_drawline canvas2 startx starty x y)) +- (setf startx x) +- (setf starty y) +- (when (= obj exited) +- (funcall get-mouse-xy exited) +- (j_drawline canvas2 startx starty x y)))))))))))))) +- +-;; Text editor demo +-(with-server +- ("GCL Japi library test text editor" 0) +- (with-frame +- (frame "A simple editor") +- (j_setgridlayout frame 1 1) +- (with-panel +- (panel frame) +- (j_setgridlayout panel 1 1) +- (with-menu-bar +- (menubar frame) +- (with-menu +- (file-mi menubar "File") +- (with-menu-item +- (new-mi file-mi "New") +- (with-menu-item +- (save-mi file-mi "Save") +- (j_seperator file-mi) +- (with-menu-item +- (quit-mi file-mi "Quit") +- +- (with-menu +- (edit-mi menubar "Edit") +- (with-menu-item +- (select-all-mi edit-mi "Select All") +- (j_seperator edit-mi) +- (with-menu-item +- (cut-mi edit-mi "Cut") +- (with-menu-item +- (copy-mi edit-mi "Copy") +- (with-menu-item +- (paste-mi edit-mi "Paste") +- +- (with-text-area +- (text panel 15 4) +- (j_setfont text J_DIALOGIN J_BOLD 18) +- (let ((new-text (format nil "JAPI (Java Application~%Programming Interface)~%a platform and language~%independent API"))) +- (j_settext text new-text) +- (j_show frame) +- (j_pack frame) +- (j_setrows text 4) +- (j_setcolumns text 15) +- (j_pack frame) +- ;; Allocate immovable storage for passing data back from C land. +- ;; Uses the GCL only make-array keyword :static +- (let* ((xa (make-array 1 :initial-element 0 :element-type 'fixnum :static t)) +- (ya (make-array 1 :initial-element 0 :element-type 'fixnum :static t)) +- (pxa (inta-ptr xa)) +- (pya (inta-ptr ya)) +- (x 0) +- (y 0) +- (get-mouse-xy (lambda (obj) +- (progn (j_getmousepos obj pxa pya) +- (setf x (aref xa 0)) +- (setf y (aref ya 0))))) +- (startx 0) +- (starty 0) +- (selstart 0) +- (selend 0) +- (text-buffer (make-array 64000 :initial-element 0 :element-type 'character :static t)) +-; (text-buffer (make-string 64000 :initial-element #\0)) +- (p-text-buffer (inta-ptr text-buffer))) +- (do ((obj (j_nextaction) (j_nextaction))) +- ((or (= obj frame) (= obj quit-mi))t) +- (when (= obj panel) +- (format t "Size changed to ~D rows ~D columns~%" (j_getrows text) (j_getcolumns text)) +- (format t "Size changed to ~D x ~D pixels~%" (j_getwidth text) (j_getheight text))) +- (when (= obj text) (format t "Text changed (len=~D)~%" (j_getlength text) )) +- (when (= obj new-mi) (j_settext new-text)) +- (when (= obj save-mi) (j_gettext text text-buffer)) +- (when (= obj select-all-mi) (j_selectall text)) +- (when (or (= obj cut-mi) +- (= obj copy-mi) +- (= obj paste-mi)) +- (setf selstart (1- (j_getselstart text))) +- (setf selend (1- (j_getselend text)))) +- (when (= obj cut-mi) +- (j_getseltext text p-text-buffer) +- (j_delete text (1- (j_getselstart text)) (1- (j_getselend text))) +- (setf selend selstart)) +- (when (= obj copy-mi) +- (j_getseltext text p-text-buffer)) +- (when (= obj paste-mi) +- (if (= selstart selend) +- (j_inserttext text p-text-buffer (1- (j_getcurpos text))) +- (j_replacetext text p-text-buffer (1- (j_getselstart text)) (1- (j_getselend text)))) +- )))))))))))))))))) +- +- +- ++;;; ++;;; Japi is a cross-platform, easy to use (rough and ready) Java based GUI library ++;;; Download a library and headers for your platform, and get the C examples ++;;; and documentation from: ++;;; ++;;; http://www.japi.de/ ++;;; ++;;; This file shows how to use some of the available functions. You may assume ++;;; that the only functions tested so far in the binding are those which appear ++;;; below, as this file doubles as the test program. The binding is so simple ++;;; however that so far no binding (APART FROM J_PRINT) has gone wrong of those ++;;; tested so far! ++;;; ++;;; ++;;; HOW TO USE THIS FILE ++;;; ++;;; (compile-file "c:/cvs/gcl/japitest.lsp") (load "c:/cvs/gcl/japitest.o") ++;;; ++;;; Requires either "java" or "jre" in the path to work. ++;;; ++ ++(in-package :japi-primitives) ++ ++;; Start up the Japi server (needs to find either "java" or "jre" in your path ++(defmacro with-server ((app-name debug-level) . body) ++ (multiple-value-bind (ds b) ++ (si::find-declarations body) ++ `(if (= 0 (jpr::j_start)) ++ (format t (format nil "~S can't connect to the Japi GUI server." ,app-name)) ++ (progn ++ (j_setdebug ,debug-level) ++ ,@ds ++ (unwind-protect ++ (progn ,@b) ++ (j_quit)))))) ++ ++;; Use a frame and clean up afterwards even if trouble ensues ++(defmacro with-frame ((frame-var-name title) . body) ++ (multiple-value-bind (ds b) ++ (si::find-declarations body) ++ `(let ((,frame-var-name (j_frame ,title))) ++ ,@ds ++ (unwind-protect ++ (progn ,@b) ++ (j_dispose ,frame-var-name))))) ++ ++;; Use a canvas and clean up afterwards even if trouble ensues ++(defmacro with-canvas ((canvas-var-name frame-obj x-size y-size) . body) ++ (multiple-value-bind (ds b) ++ (si::find-declarations body) ++ `(let ((,canvas-var-name (j_canvas ,frame-obj ,x-size ,y-size))) ++ ,@ds ++ (unwind-protect ++ (progn ,@b) ++ (j_dispose ,canvas-var-name))))) ++ ++;; Use a text area and clean up afterwards even if trouble ensues ++(defmacro with-text-area ((text-area-var-name panel-obj x-size y-size) . body) ++ (multiple-value-bind (ds b) ++ (si::find-declarations body) ++ `(let ((,text-area-var-name (j_textarea ,panel-obj ,x-size ,y-size))) ++ ,@ds ++ (unwind-protect ++ (progn ,@b) ++ (j_dispose ,text-area-var-name))))) ++ ++;; Use a pulldown menu bar and clean up afterwards even if trouble ensues ++(defmacro with-menu-bar ((bar-var-name frame-obj) . body) ++ (multiple-value-bind (ds b) ++ (si::find-declarations body) ++ `(let ((,bar-var-name (j_menubar ,frame-obj))) ++ ,@ds ++ (unwind-protect ++ (progn ,@b) ++ (j_dispose ,bar-var-name))))) ++ ++;; Add a pulldown menu and clean up afterwards even if trouble ensues ++(defmacro with-menu ((menu-var-name bar-obj title) . body) ++ (multiple-value-bind (ds b) ++ (si::find-declarations body) ++ `(let ((,menu-var-name (j_menu ,bar-obj ,title))) ++ ,@ds ++ (unwind-protect ++ (progn ,@b) ++ (j_dispose ,menu-var-name))))) ++ ++;; Add a pulldown menu item and clean up afterwards even if trouble ensues ++(defmacro with-menu-item ((item-var-name menu-obj title) . body) ++ (multiple-value-bind (ds b) ++ (si::find-declarations body) ++ `(let ((,item-var-name (j_menuitem ,menu-obj ,title))) ++ ,@ds ++ (unwind-protect ++ (progn ,@b) ++ (j_dispose ,item-var-name))))) ++ ++;; Add a mouse listener and clean up afterwards even if trouble ensues ++(defmacro with-mouse-listener ((var-name obj type) . body) ++ (multiple-value-bind (ds b) ++ (si::find-declarations body) ++ `(let ((,var-name (j_mouselistener ,obj ,type))) ++ ,@ds ++ (unwind-protect ++ (progn ,@b) ++ (j_dispose ,var-name))))) ++ ++;; Use a panel and clean up afterwards even if trouble ensues ++(defmacro with-panel ((panel-var-name frame-obj) . body) ++ (multiple-value-bind (ds b) ++ (si::find-declarations body) ++ `(let ((,panel-var-name (j_panel ,frame-obj))) ++ ,@ds ++ (unwind-protect ++ (progn ,@b) ++ (j_dispose ,panel-var-name))))) ++ ++ ++;; Run a five second frame in a Japi server ++(with-server ("GCL Japi library test GUI 1" 0) ++ (with-frame (frame "Five Second Blank Test Frame") ++ (j_show frame) ++ (j_sleep 5000))) ++ ++;; Get a pointer to an array of ints ++(defCfun "static void* inta_ptr(object s)" 0 ++ " return(s->fixa.fixa_self);") ++(defentry inta-ptr (object) (int "inta_ptr")) ++ ++;; Draw function ++(defun drawgraphics (drawable xmin ymin xmax ymax) ++ (let* ((fntsize 10) ++ (tmpstrx (format nil "XMax = ~D" xmax)) ++ (tmpstry (format nil "YMax = ~D" ymax)) ++ (tmpstrwidx (j_getstringwidth drawable tmpstrx))) ++ (j_setfontsize drawable fntsize) ++ (j_setnamedcolor drawable J_RED) ++ ++ (j_drawline drawable xmin ymin (- xmax 1) (- ymax 1)) ++ (j_drawline drawable xmin (- ymax 1) (- xmax 1) ymin) ++ (j_drawrect drawable xmin ymin (- xmax xmin 1) (- ymax xmin 1)) ++ ++ (j_setnamedcolor drawable J_BLACK) ++ (j_drawline drawable xmin (- ymax 30) (- xmax 1) (- ymax 30)) ++ (j_drawstring drawable (- (/ xmax 2) (/ tmpstrwidx 2)) (- ymax 40) tmpstrx) ++ ++ (j_drawline drawable (+ xmin 30) ymin (+ xmin 30) (- ymax 1)) ++ (j_drawstring drawable (+ xmin 50) 40 tmpstry) ++ ++ (j_setnamedcolor drawable J_MAGENTA) ++ (loop for i from 1 to 10 ++ do (j_drawoval drawable ++ (+ xmin (/ (- xmax xmin) 2)) ++ (+ ymin (/ (- ymax ymin) 2)) ++ (* (/ (- xmax xmin) 20) i) ++ (* (/ (- ymax ymin) 20) i))) ++ ++ (j_setnamedcolor drawable J_BLUE) ++ (let ((y ymin) ++ (teststr "JAPI Test Text")) ++ (loop for i from 5 to 21 do ++ (j_setfontsize drawable i) ++ (let ((x (- xmax (j_getstringwidth drawable teststr)))) ++ (setf y (+ y (j_getfontheight drawable))) ++ (j_drawstring drawable x y teststr)))))) ++ ++;; Run some more extensive tests ++(with-server ++ ("GCL Japi library test GUI 2" 0) ++ (with-frame ++ (frame "Draw") ++ (j_show frame) ++ (let ((alert (j_messagebox frame "Two second alert box" "label"))) ++ (j_sleep 2000) ++ (j_dispose alert)) ++ (let ((result1 (j_alertbox frame "label1" "label2" "OK")) ++ (result2 (j_choicebox2 frame "label1" "label2" "Yes" "No")) ++ (result3 (j_choicebox3 frame "label1" "label2" "Yes" "No" "Cancel"))) ++ (format t "Requestor results were: ~D, ~D, ~D~%" result1 result2 result3)) ++ (j_setborderlayout frame) ++ (with-menu-bar ++ (menubar frame) ++ (with-menu ++ (file menubar "File") ++ (with-menu-item ++ (print file "Print") ++ (with-menu-item ++ (save file "Save BMP") ++ (with-menu-item ++ (quit file "Quit") ++ (with-canvas ++ (canvas frame 400 600) ++ (j_pack frame) ++ (drawgraphics canvas 0 0 (j_getwidth canvas) (j_getheight canvas)) ++ (j_show frame) ++ (do ((obj (j_nextaction) (j_nextaction))) ++ ((or (= obj frame) (= obj quit)) t) ++ (when (= obj canvas) ++ (j_setnamedcolorbg canvas J_WHITE) ++ (drawgraphics canvas 10 10 ++ (- (j_getwidth canvas) 10) ++ (- (j_getheight canvas) 10))) ++ (when (= obj print) ++ (let ((printer (j_printer frame))) ++ (when (> 0 printer) ++ (drawgraphics printer 40 40 ++ (- (j_getwidth printer) 80) ++ (- (j_getheight printer) 80)) ++ (j_print printer)))) ++ (when (= obj save) ++ (let ((image (j_image 600 800))) ++ (drawgraphics image 0 0 600 800) ++ (when (= 0 (j_saveimage image "test.bmp" J_BMP)) ++ (j_alertbox frame "Problems" "Can't save the image" "OK"))))))))))))) ++;; Try some mouse handling ++(with-server ++ ("GCL Japi library test GUI 3" 0) ++ (with-frame ++ (frame "Move and drag the mouse") ++ (j_setsize frame 430 240) ++ (j_setnamedcolorbg frame J_LIGHT_GRAY) ++ (with-canvas ++ (canvas1 frame 200 200) ++ (with-canvas ++ (canvas2 frame 200 200) ++ (j_setpos canvas1 10 30) ++ (j_setpos canvas2 220 30) ++ (with-mouse-listener ++ (pressed canvas1 J_PRESSED) ++ (with-mouse-listener ++ (dragged canvas1 J_DRAGGED) ++ (with-mouse-listener ++ (released canvas1 J_RELEASED) ++ (with-mouse-listener ++ (entered canvas2 J_ENTERERD) ++ (with-mouse-listener ++ (moved canvas2 J_MOVED) ++ (with-mouse-listener ++ (exited canvas2 J_EXITED) ++ (j_show frame) ++ ;; Allocate immovable storage for passing data back from C land. ++ ;; Uses the GCL only make-array keyword :static ++ (let* ((xa (make-array 1 :initial-element 0 :element-type 'fixnum :static t)) ++ (ya (make-array 1 :initial-element 0 :element-type 'fixnum :static t)) ++ (pxa (inta-ptr xa)) ++ (pya (inta-ptr ya)) ++ (x 0) ++ (y 0) ++ (get-mouse-xy (lambda (obj) ++ (progn (j_getmousepos obj pxa pya) ++ (setf x (aref xa 0)) ++ (setf y (aref ya 0))))) ++ (startx 0) ++ (starty 0)) ++ (do ((obj (j_nextaction) (j_nextaction))) ++ ((= obj frame) t) ++ (when (= obj pressed) ++ (funcall get-mouse-xy pressed) ++ (setf startx x) ++ (setf starty y)) ++ (when (= obj dragged) ++ (funcall get-mouse-xy dragged) ++ (j_drawrect canvas1 startx starty (- x startx) (- y starty))) ++ (when (= obj released) ++ (funcall get-mouse-xy released) ++ (j_drawrect canvas1 startx starty (- x startx) (- y starty))) ++ (when (= obj entered) ++ (funcall get-mouse-xy entered) ++ (setf startx x) ++ (setf starty y)) ++ (when (= obj moved) ++ (funcall get-mouse-xy moved) ++ (j_drawline canvas2 startx starty x y)) ++ (setf startx x) ++ (setf starty y) ++ (when (= obj exited) ++ (funcall get-mouse-xy exited) ++ (j_drawline canvas2 startx starty x y)))))))))))))) ++ ++;; Text editor demo ++(with-server ++ ("GCL Japi library test text editor" 0) ++ (with-frame ++ (frame "A simple editor") ++ (j_setgridlayout frame 1 1) ++ (with-panel ++ (panel frame) ++ (j_setgridlayout panel 1 1) ++ (with-menu-bar ++ (menubar frame) ++ (with-menu ++ (file-mi menubar "File") ++ (with-menu-item ++ (new-mi file-mi "New") ++ (with-menu-item ++ (save-mi file-mi "Save") ++ (j_seperator file-mi) ++ (with-menu-item ++ (quit-mi file-mi "Quit") ++ ++ (with-menu ++ (edit-mi menubar "Edit") ++ (with-menu-item ++ (select-all-mi edit-mi "Select All") ++ (j_seperator edit-mi) ++ (with-menu-item ++ (cut-mi edit-mi "Cut") ++ (with-menu-item ++ (copy-mi edit-mi "Copy") ++ (with-menu-item ++ (paste-mi edit-mi "Paste") ++ ++ (with-text-area ++ (text panel 15 4) ++ (j_setfont text J_DIALOGIN J_BOLD 18) ++ (let ((new-text (format nil "JAPI (Java Application~%Programming Interface)~%a platform and language~%independent API"))) ++ (j_settext text new-text) ++ (j_show frame) ++ (j_pack frame) ++ (j_setrows text 4) ++ (j_setcolumns text 15) ++ (j_pack frame) ++ ;; Allocate immovable storage for passing data back from C land. ++ ;; Uses the GCL only make-array keyword :static ++ (let* ((xa (make-array 1 :initial-element 0 :element-type 'fixnum :static t)) ++ (ya (make-array 1 :initial-element 0 :element-type 'fixnum :static t)) ++ (pxa (inta-ptr xa)) ++ (pya (inta-ptr ya)) ++ (x 0) ++ (y 0) ++ (get-mouse-xy (lambda (obj) ++ (progn (j_getmousepos obj pxa pya) ++ (setf x (aref xa 0)) ++ (setf y (aref ya 0))))) ++ (startx 0) ++ (starty 0) ++ (selstart 0) ++ (selend 0) ++ (text-buffer (make-array 64000 :initial-element 0 :element-type 'character :static t)) ++; (text-buffer (make-string 64000 :initial-element #\0)) ++ (p-text-buffer (inta-ptr text-buffer))) ++ (do ((obj (j_nextaction) (j_nextaction))) ++ ((or (= obj frame) (= obj quit-mi))t) ++ (when (= obj panel) ++ (format t "Size changed to ~D rows ~D columns~%" (j_getrows text) (j_getcolumns text)) ++ (format t "Size changed to ~D x ~D pixels~%" (j_getwidth text) (j_getheight text))) ++ (when (= obj text) (format t "Text changed (len=~D)~%" (j_getlength text) )) ++ (when (= obj new-mi) (j_settext new-text)) ++ (when (= obj save-mi) (j_gettext text text-buffer)) ++ (when (= obj select-all-mi) (j_selectall text)) ++ (when (or (= obj cut-mi) ++ (= obj copy-mi) ++ (= obj paste-mi)) ++ (setf selstart (1- (j_getselstart text))) ++ (setf selend (1- (j_getselend text)))) ++ (when (= obj cut-mi) ++ (j_getseltext text p-text-buffer) ++ (j_delete text (1- (j_getselstart text)) (1- (j_getselend text))) ++ (setf selend selstart)) ++ (when (= obj copy-mi) ++ (j_getseltext text p-text-buffer)) ++ (when (= obj paste-mi) ++ (if (= selstart selend) ++ (j_inserttext text p-text-buffer (1- (j_getcurpos text))) ++ (j_replacetext text p-text-buffer (1- (j_getselstart text)) (1- (j_getselend text)))) ++ )))))))))))))))))) ++ ++ ++ + +\ No newline at end of file +--- gcl-2.6.7.orig/readme-bin.mingw ++++ gcl-2.6.7/readme-bin.mingw +@@ -1,32 +1,32 @@ +-Hi there! +- +-WHAT NOW: +- +-You are installing GNU Common Lisp for Windows, 2.6.7 +-This compiler uses the Minimalist GNU Windows 32 +-compiler tools (MinGW32, see below). +- +-IF YOU INSTALL INTO A DIRECTORY WITH SPACES IN THE NAME, +-MAKE SURE you use the DOSified form eg: +- +- c:/Progra~1/somewhere. +- +- +-MINGW32 GCC: +- +-The MinGW compiler is provided subject to the terms +-of the files: +- +- "COPYING" and "COPYING.LIB" +- +-located in the mingw sub-directory. The source +-code and updated binary packages can be obtained via +-the official MinGW web site: +- +-http://sourceforge.net/projects/mingw/ +- +-We recommend that you use the compiler provided when +-working with this GCL package for compatibility. +- +-Clean and rebuild pre-existing projects whenever you +-upgrade the GCL binary package for this reason. ++Hi there! ++ ++WHAT NOW: ++ ++You are installing GNU Common Lisp for Windows, 2.6.8 ++This compiler uses the Minimalist GNU Windows 32 ++compiler tools (MinGW32, see below). ++ ++IF YOU INSTALL INTO A DIRECTORY WITH SPACES IN THE NAME, ++MAKE SURE you use the DOSified form eg: ++ ++ c:/Progra~1/somewhere. ++ ++ ++MINGW32 GCC: ++ ++The MinGW compiler is provided subject to the terms ++of the files: ++ ++ "COPYING" and "COPYING.LIB" ++ ++located in the mingw sub-directory. The source ++code and updated binary packages can be obtained via ++the official MinGW web site: ++ ++http://sourceforge.net/projects/mingw/ ++ ++We recommend that you use the compiler provided when ++working with this GCL package for compatibility. ++ ++Clean and rebuild pre-existing projects whenever you ++upgrade the GCL binary package for this reason. +--- gcl-2.6.7.orig/acconfig.h ++++ gcl-2.6.7/acconfig.h +@@ -10,7 +10,7 @@ is usually 4K or 8K bytes. From 1 to 3 + preallocated in a table at compile time. this must be a power of 2 if + SGC is enabled. */ + +-#define MAXPAGE 128*1024 ++#define MAXPAGE (128*1024*(SIZEOF_LONG>>2)/(1<<(PAGEWIDTH-12))) + #define VSSIZE 128*1024 + #define BDSSIZE 2*1024 + #define IHSSIZE 4*1024 +@@ -140,7 +140,7 @@ SGC is enabled. */ + /* bfd support */ + #undef HAVE_LIBBFD + #undef NEED_CONST +-#undef HAVE_BFD_BOOLEAN ++#define HAVE_BFD_BOOLEAN + + #ifdef HAVE_BFD_BOOLEAN + #define MY_BFD_BOOLEAN bfd_boolean +@@ -245,9 +245,16 @@ SGC is enabled. */ + #undef HAVE_DECL_RL_COMPLETION_MATCHES + #undef HAVE_RL_COMPENTRY_FUNC_T + #undef HAVE_GNU_LD +-#undef NEED_NONRANDOM_SBRK ++#undef CAN_UNRANDOMIZE_SBRK + #undef HOST_CPU + #undef HOST_KERNEL + #undef HOST_SYSTEM + #undef GCL_GPROF_START + #undef HZ ++#undef ADDR_NO_RANDOMIZE ++#undef LEADING_UNDERSCORE ++#undef HAVE_XGCL ++#undef HAVE_SYS_SOCKIO_H ++#undef HAVE_MALLOC_MALLOC_H ++#undef HAVE_OBJC_MALLOC_H ++#undef HAVE_OUTPUT_BFD +--- /dev/null ++++ gcl-2.6.7/README.macosx +@@ -0,0 +1,9 @@ ++On some recent mac boxes (e.g. 10.6) running 64bit capable processors, ++the default configure scripts detect the cpu as 32bit only. To get a ++64bit build, do: ++ ++./configure --build=x86_64-apple-darwin10.4.0 .... ++ ++where the key item is the x86_64, and some darwin string in the last ++place. ++ +--- gcl-2.6.7.orig/readme.mingw ++++ gcl-2.6.7/readme.mingw +@@ -1,119 +1,119 @@ +-=============================================== +-BUILDING NATIVE WIN32 GNU COMMON LISP FROM CVS +-=============================================== +- +-The preferred build host system for the Mingw32 compiler is MSYS. +- +-I use gcc version 3.3.1 and binutils 2.14.90, but earlier versions +-of gcc back to 2.95 are OK provided that you remove the +-"-fno-zero-initialized-in-bss" flag in "h/mingw.defs" before running +-"configure". +- +-Note that gcc 3.3.3 and gcc 3.4.0 do NOT work; likewise binutils 2.13.90 +-and 2.15.90. +- +-The working binutils version can be found at: +- +-ftp://ftp.sf.net/m/mi/mingw/binutils-2.14.90-20030807-1.tar.gz +- +- +-=============================================== +-BUILDING GCL USING MSYS AS THE HOST +-=============================================== +- +-BUILD TOOLS +- +-- Mingw32 Version 2 Windows native gcc: +- http://www.mingw.org/ +- +-- MSYS Mingw build environment, including the MSYS DTK +- http://www.mingw.org/ +- +-- Source code for GCL. +- http://savannah.gnu.org/projects/gcl/ +- +-Subject to the above warnings, it is usually a good idea to keep up to +-date with Mingw32 and MSYS. Updates for various parts of these packages +-are available on the web site. +- +- +-SHORT SETUP NOTES +- +-- Install Mingw32 and MSYS using the instructions at those sites. +- +- +-DETAILED SETUP NOTES +- +-- Start by installing the latest version of MinGW2.exe. +- +-- By looking at the dates and version numbers appended to the other +- packages on the download page, get any versions of gcc 3.2, binutils, +- mingw-runtime, and w32api that are later than the Mingw2 package. +- +-- Go to the top level Mingw32 installation directory - the one in which you +- can see "bin", "lib" etc +- +-- Extract those other packages in that directory eg: +- +- tar xzf rumpty-dumpty.tar.gz +- +-- Remove the Mingw version of "make" from the bin directory - it has serious +- bugs and will not work properly for most tasks including building GCL and +- Maxima. We will be using the MSYS version. +- +-- Get MSYS and install it - follow the instructions - subscribe to the +- mailing list and read the archives. +- +-- In the MSYS directory install the "msysDTK-1.0.0-alpha-1.tar.gz" package +- which gives you cvs, ssh, rlogin, etc. +- +- +- +-BUILDING +- +-- Change to your GCL source directory eg: +- +- cd /c/cvs/gcl +- +-- You are now ready to configure GCL: +- +- ./configure --prefix="c:/gcl" > configure.log 2>&1 +- +- Change the prefix directory as required for your final installation path. +- I find it helpful to redirect output from "configure" and "make" into log +- files for debugging and checking. +- +-- Check the log. +- +-- Type: +- +- make >& make.log +- +-- The "saved_gcl.exe" should turn up eventually in the unixport directory. You +- can try it out directly by typing: +- +- ./unixport/saved_gcl.exe +- +- at the command prompt. +- +-- To install: +- +- make install >& install.log +- +- It is necessary to install GCL before building Maxima. +- +-- The batch file "gclm.bat" can be used to make a Windows desktop +- shortcut. +- +-- BFD fasloading, Stratified Garbage Collection (SGC) readline and GCL-TK +- don't work under Windows. The configuration options above provide a +- "traditional" GCL executable which will build the current CVS version of +- Maxima. The BFD option will depend on someone with knowledge of BFD and +- PE-COFF linking fixing some problems with the BFD library - I am slowly +- absorbing the info needed, but we really need input from an expert. My +- inclination is to stick with custom relocation as BFD is less efficient. +- +- +-Mike Thomas +- +-15 June 2004 ++=============================================== ++BUILDING NATIVE WIN32 GNU COMMON LISP FROM CVS ++=============================================== ++ ++The preferred build host system for the Mingw32 compiler is MSYS. ++ ++I use gcc version 3.3.1 and binutils 2.14.90, but earlier versions ++of gcc back to 2.95 are OK provided that you remove the ++"-fno-zero-initialized-in-bss" flag in "h/mingw.defs" before running ++"configure". ++ ++Note that gcc 3.3.3 and gcc 3.4.0 do NOT work; likewise binutils 2.13.90 ++and 2.15.90. ++ ++The working binutils version can be found at: ++ ++ftp://ftp.sf.net/m/mi/mingw/binutils-2.14.90-20030807-1.tar.gz ++ ++ ++=============================================== ++BUILDING GCL USING MSYS AS THE HOST ++=============================================== ++ ++BUILD TOOLS ++ ++- Mingw32 Version 2 Windows native gcc: ++ http://www.mingw.org/ ++ ++- MSYS Mingw build environment, including the MSYS DTK ++ http://www.mingw.org/ ++ ++- Source code for GCL. ++ http://savannah.gnu.org/projects/gcl/ ++ ++Subject to the above warnings, it is usually a good idea to keep up to ++date with Mingw32 and MSYS. Updates for various parts of these packages ++are available on the web site. ++ ++ ++SHORT SETUP NOTES ++ ++- Install Mingw32 and MSYS using the instructions at those sites. ++ ++ ++DETAILED SETUP NOTES ++ ++- Start by installing the latest version of MinGW2.exe. ++ ++- By looking at the dates and version numbers appended to the other ++ packages on the download page, get any versions of gcc 3.2, binutils, ++ mingw-runtime, and w32api that are later than the Mingw2 package. ++ ++- Go to the top level Mingw32 installation directory - the one in which you ++ can see "bin", "lib" etc ++ ++- Extract those other packages in that directory eg: ++ ++ tar xzf rumpty-dumpty.tar.gz ++ ++- Remove the Mingw version of "make" from the bin directory - it has serious ++ bugs and will not work properly for most tasks including building GCL and ++ Maxima. We will be using the MSYS version. ++ ++- Get MSYS and install it - follow the instructions - subscribe to the ++ mailing list and read the archives. ++ ++- In the MSYS directory install the "msysDTK-1.0.0-alpha-1.tar.gz" package ++ which gives you cvs, ssh, rlogin, etc. ++ ++ ++ ++BUILDING ++ ++- Change to your GCL source directory eg: ++ ++ cd /c/cvs/gcl ++ ++- You are now ready to configure GCL: ++ ++ ./configure --prefix="c:/gcl" > configure.log 2>&1 ++ ++ Change the prefix directory as required for your final installation path. ++ I find it helpful to redirect output from "configure" and "make" into log ++ files for debugging and checking. ++ ++- Check the log. ++ ++- Type: ++ ++ make >& make.log ++ ++- The "saved_gcl.exe" should turn up eventually in the unixport directory. You ++ can try it out directly by typing: ++ ++ ./unixport/saved_gcl.exe ++ ++ at the command prompt. ++ ++- To install: ++ ++ make install >& install.log ++ ++ It is necessary to install GCL before building Maxima. ++ ++- The batch file "gclm.bat" can be used to make a Windows desktop ++ shortcut. ++ ++- BFD fasloading, Stratified Garbage Collection (SGC) readline and GCL-TK ++ don't work under Windows. The configuration options above provide a ++ "traditional" GCL executable which will build the current CVS version of ++ Maxima. The BFD option will depend on someone with knowledge of BFD and ++ PE-COFF linking fixing some problems with the BFD library - I am slowly ++ absorbing the info needed, but we really need input from an expert. My ++ inclination is to stick with custom relocation as BFD is less efficient. ++ ++ ++Mike Thomas ++ ++15 June 2004 +--- gcl-2.6.7.orig/ChangeLog ++++ gcl-2.6.7/ChangeLog +@@ -1,3 +1,10 @@ ++2006-10-26 Gabriel Dos Reis ++ ++ * configure.in: Don't be overly eager about setting INFO_DIR. ++ Fix quotations, as new Autoconf are pickier. ++ ++ * configure: Regenerate. ++ + 2002-01-25 Camm Maguire + + * /cvsroot/gcl/gcl/ChangeLog, /cvsroot/gcl/gcl/ChangeLog.orig: +--- gcl-2.6.7.orig/config.sub ++++ gcl-2.6.7/config.sub +@@ -1,9 +1,10 @@ + #! /bin/sh + # Configuration validation subroutine script. + # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +-# 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ++# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 ++# Free Software Foundation, Inc. + +-timestamp='2005-04-22' ++timestamp='2010-01-22' + + # This file is (in principle) common to ALL GNU software. + # The presence of a machine in this file suggests that SOME GNU software +@@ -21,22 +22,26 @@ timestamp='2005-04-22' + # + # You should have received a copy of the GNU General Public License + # along with this program; if not, write to the Free Software +-# Foundation, Inc., 59 Temple Place - Suite 330, +-# Boston, MA 02111-1307, USA. +- ++# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA ++# 02110-1301, USA. ++# + # As a special exception to the GNU General Public License, if you + # distribute this file as part of a program that contains a + # configuration script generated by Autoconf, you may include it under + # the same distribution terms that you use for the rest of that program. + ++ + # Please send patches to . Submit a context +-# diff and a properly formatted ChangeLog entry. ++# diff and a properly formatted GNU ChangeLog entry. + # + # Configuration subroutine to validate and canonicalize a configuration type. + # Supply the specified configuration type as an argument. + # If it is invalid, we print an error message on stderr and exit with code 1. + # Otherwise, we print the canonical config type on stdout and succeed. + ++# You can get the latest version of this script from: ++# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD ++ + # This file is supposed to be the same for all GNU packages + # and recognize all the CPU types, system types and aliases + # that are meaningful with *any* GNU software. +@@ -70,8 +75,9 @@ Report bugs and patches to &1 | tail -n 1 | grep -q "gcc version 4.6.1" ; then ++ case "$use" in ++ arm*) ++ #FIXME report and remove this when done ++ AC_MSG_RESULT(Reducing optimization on arm build to workaround gcc 4.6 bug) ++ enable_debug=yes;; ++ esac ++fi ++ ++ + if test "$enable_debug" = "yes" ; then + TCFLAGS="$TCFLAGS -g" + # for subconfigurations + CFLAGS="$CFLAGS -g" + else +-# FIXME -- remove when mingw compiler issues are fixed +- case "$use" in +- *mingw*) +- TO3FLAGS="-O3 $TFPFLAG";; +- *) +- TO3FLAGS="-O3 $TFPFLAG";; +- esac +-# TO3FLAGS="-O3 $TFPFLAG" ++ TO3FLAGS="-O3 $TFPFLAG" + TO2FLAGS="-O" + fi + + # gcc on ppc cannot compile our new_init.c with full opts --CM + TONIFLAGS="" + case $use in ++ powerpc*macosx) ++ TCFLAGS="$TCFLAGS -mlongcall";; + *linux) + case $use in + # amd64*) # stack-boundary option does not work +@@ -491,30 +546,74 @@ case $use in + # m68k*) + # TCFLAGS="$TCFLAGS -ffloat-store";; + hppa*) +- TCFLAGS="$TCFLAGS -ffunction-sections" +- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O $TFPFLAG" ; fi +- if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi ++ TCFLAGS="$TCFLAGS -mlong-calls " ++# TCFLAGS="$TCFLAGS -ffunction-sections" ++# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O $TFPFLAG" ; fi ++# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi + ;; + arm*) +- TCFLAGS="$TCFLAGS -mlong-calls";; ++ TCFLAGS="$TCFLAGS -mlong-calls -fdollars-in-identifiers -g " ++# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; fi ++# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi ++ ;; + powerpc*) +- if $CC -v 2>&1 | grep -q "gcc version 3.2" ; then +- echo Reducing optimization for buggy gcc-3.2 +- if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi +- fi; +- echo Probing for longcall +- if ! $CC -v 2>&1 | $AWK '/^gcc version / {split($3,A,".");if (A[[1]]+0>=3 && A[[2]]+0>=3) exit 1;}'; then +- echo Enabling longcall on gcc 3.3 or later +- TCFLAGS="$TCFLAGS -mlongcall" +- echo Reducing optimization for buggy gcc 3.3 or later +- if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi +- fi;; ++ TCFLAGS="$TCFLAGS -mlongcall" ++ ;; ++# if $CC -v 2>&1 | grep -q "gcc version 3.2" ; then ++# echo Reducing optimization for buggy gcc-3.2 ++# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi ++# fi; ++# echo Probing for longcall ++# if ! $CC -v 2>&1 | $AWK '/^gcc version / {split($3,A,".");if (A[[1]]+0>3 || (A[[1]]+0>=3 && A[[2]]+0>=3)) exit 1;}'; then ++# echo Enabling longcall on gcc 3.3 or later ++# TCFLAGS="$TCFLAGS -mlongcall" ++# echo Reducing optimization for buggy gcc 3.3 or later ++# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi ++# fi;; + esac;; + esac + if test "$enable_pic" = "yes" ; then + TCFLAGS="$TCFLAGS -fPIC" + fi + ++FDEBUG=`echo $CFLAGS | tr ' ' '\012' |grep "^\-g$"|tr '\012' ' '` ++#CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-g$"` ++FOMITF=`echo $CFLAGS | tr ' ' '\012' |grep "^\-fomit-frame-pointer$"|tr '\012' ' '` ++CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-fomit-frame-pointer$"|tr '\012' ' '` ++FOOPT3=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O3$"|tr '\012' ' '` ++CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O3$"|tr '\012' ' '` ++FOOPT2=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O2$"|tr '\012' ' '` ++CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O2$"|tr '\012' ' '` ++FOOPT1=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O1$"|tr '\012' ' '` ++TMP=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O$"|tr '\012' ' '` ++FOOPT1="$FOOPT1$TMP" ++CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O1$"|grep -v "^\-O$"|tr '\012' ' '` ++FOOPT0=`echo $CFLAGS | tr ' ' '\012' |grep "^\-O0$"|tr '\012' ' '` ++CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O0$"|tr '\012' ' '` ++ ++if test "$FOOPT0" != "" ; then ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` ++else ++if test "$FOOPT1" != "" ; then ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[2-3]],-O1,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[2-3]],-O1,g'` ++else ++if test "$FOOPT2" != "" ; then ++ TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` ++ TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` ++fi ++fi ++fi ++ ++if test "$FDEBUG" != "" ; then ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++fi ++ ++if test "$FOMITF" != "" ; then ++ TO3FLAGS="$TO3FLAGS $FOMITF" ++fi + + # Step 1: set the variable "system" to hold the name and version number + # for the system. This can usually be done via the "uname" command, but +@@ -538,7 +637,7 @@ else + # results, and the version is kept in special file). + + if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then +- system=MP-RAS-`${AWK} '{print $3}' /etc/.relid'` ++ system="MP-RAS-`${AWK} '{print $3}' '/etc/.relid'`" + fi + if test "`uname -s`" = "AIX" ; then + system=AIX-`uname -v`.`uname -r` +@@ -547,6 +646,21 @@ else + fi + fi + ++case $use in ++ *macosx) ++ AC_CHECK_HEADER(malloc/malloc.h,,[AC_MSG_ERROR([need malloc.h on macosx])]) ++ AC_CHECK_MEMBER([struct _malloc_zone_t.memalign], ++ AC_DEFINE(HAVE_MALLOC_ZONE_MEMALIGN,1,[memalign element present]), [], ++ [ ++ #include ++ ]) ++ AC_SUBST(HAVE_MALLOC_ZONE_MEMALIGN) ++ ;; ++esac ++ ++ ++ ++ + # sysconf + + AC_CHECK_HEADER(unistd.h, +@@ -564,7 +678,7 @@ AC_CHECK_HEADER(unistd.h, + hz=`cat conftest1` + AC_DEFINE_UNQUOTED(HZ,$hz) + ,hz=0,hz=0) +- AC_MSG_RESULT($hz))) ++ [AC_MSG_RESULT($hz)])) + + + #MY_SUBDIRS= +@@ -578,7 +692,6 @@ rm -f makedefsafter + MP_INCLUDE="" + if test $use_gmp = yes ; then + +- GMPDIR=gmp3 + PATCHED_SYMBOLS="" + if test "$enable_dynsysgmp" = "yes" ; then + AC_CHECK_HEADER(gmp.h, +@@ -586,7 +699,7 @@ if test $use_gmp = yes ; then + AC_MSG_CHECKING("for external gmp version") + AC_TRY_RUN([#include + int main() { +- #if __GNU_MP_VERSION == 4 ++ #if __GNU_MP_VERSION == 4 || __GNU_MP_VERSION == 5 + return 0; + #else + return -1; +@@ -596,10 +709,10 @@ if test $use_gmp = yes ; then + # PATCHED_SYMBOLS=__gmpn_toom3_mul_n + MPFILES= + PATCHED_SYMBOLS= +- if test "$use" = "m68k-linux" ; then +- MPFILES="$MPFILES $GMPDIR/mpn/lshift.o $GMPDIR/mpn/rshift.o" +- PATCHED_SYMBOLS="$PATCHED_SYMBOLS __gmpn_lshift __gmpn_rshift" +- fi ++# if test "$use" = "m68k-linux" ; then ++# MPFILES="$MPFILES $GMPDIR/mpn/lshift.o $GMPDIR/mpn/rshift.o" ++# PATCHED_SYMBOLS="$PATCHED_SYMBOLS __gmpn_lshift __gmpn_rshift" ++# fi + TLIBS="$TLIBS -lgmp" + echo "#include \"gmp.h\"" >foo.c + echo "int main() {return 0;}" >>foo.c +@@ -620,6 +733,7 @@ fi + + if test "$NEED_LOCAL_GMP" != "" ; then + ++ GMPDIR=gmp4 + AC_MSG_CHECKING([use_gmp=yes, doing configure in gmp directory]) + echo + echo "#" +@@ -630,7 +744,7 @@ if test "$NEED_LOCAL_GMP" != "" ; then + echo "#" + + if test "$use_common_binary" = "yes"; then +- cd $GMPDIR && ./configure --host=$host && cd .. ++ cd $GMPDIR && ./configure --build=$host && cd .. + else + cd $GMPDIR && ./configure && cd .. + fi +@@ -654,11 +768,13 @@ fi + AC_MSG_CHECKING("for leading underscore in object symbols") + cat>foo.c < +-int main() {double d=0.0;cos(d);return 0;} ++#include ++int main() {FILE *f;double d=0.0;getc(f);cos(d);return 0;} + EOFF + $CC -c foo.c -o foo.o +-if nm foo.o |grep " U " | grep "_cos" >/dev/null ; then ++if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then + LEADING_UNDERSCORE=1 ++ AC_DEFINE(LEADING_UNDERSCORE) + AC_MSG_RESULT("yes") + else + LEADING_UNDERSCORE="" +@@ -729,23 +845,31 @@ fi + # X windows + # + +-AC_PATH_XTRA +-echo $X_CFLAGS +-echo $X_LIBS +-echo $X_EXTRA_LIBS +-echo $X_PRE_LIBS +- +-miss=0 +-AC_CHECK_LIB(Xmu,main,X_LIBS="$X_LIBS -lXmu",miss=1,$X_LIBS) +-AC_CHECK_LIB(Xt,main,X_LIBS="$X_LIBS -lXt",miss=1,$X_LIBS) +-AC_CHECK_LIB(Xext,main,X_LIBS="$X_LIBS -lXext",miss=1,$X_LIBS) +-AC_CHECK_LIB(Xaw,main,X_LIBS="$X_LIBS -lXaw",miss=1,$X_LIBS) +-AC_CHECK_LIB(X11,main,X_LIBS="$X_LIBS -lX11",miss=1,$X_LIBS) ++if test "$enable_xgcl" = "yes" ; then ++ ++ AC_PATH_X ++# AC_PATH_XTRA ++# echo $X_CFLAGS ++# echo $X_LIBS ++# echo $X_EXTRA_LIBS ++# echo $X_PRE_LIBS ++ ++ miss=0 ++# AC_CHECK_LIB(Xmu,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#FIXME remove these ++# AC_CHECK_LIB(Xt,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) ++# AC_CHECK_LIB(Xext,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) ++# AC_CHECK_LIB(Xaw,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#until here ++ AC_CHECK_LIB(X11,main,X_LIBS="$X_LIBS -lX11",miss=1,$X_LIBS) + +-if test "$miss" = "1" ; then +- X_CFLAGS= +- X_LIBS= +- echo missing x libraries -- cannot compile xgcl ++ if test "$miss" = "1" ; then ++ X_CFLAGS= ++ X_LIBS= ++ X_EXTRA_LIBS= ++ X_PRE_LIBS= ++ echo missing x libraries -- cannot compile xgcl ++ else ++ AC_DEFINE(HAVE_XGCL) ++ fi + fi + + +@@ -788,9 +912,9 @@ if test "$enable_statsysbfd" = "yes" || + int main() {symbol_info t; return 0;}], + AC_MSG_RESULT(yes) + AC_DEFINE(NEED_CONST), +- AC_MSG_RESULT(cannot use bfd) exit 1;, +- AC_MSG_RESULT(cannot use bfd) exit 1;), +- AC_MSG_RESULT(cannot use bfd) exit 1;) ++ AC_MSG_ERROR([cannot use bfd]), ++ AC_MSG_ERROR([cannot use bfd])), ++ AC_MSG_ERROR([cannot use bfd])) + ,,-liberty)) + + AC_DEFINE(HAVE_LIBBFD) +@@ -811,26 +935,50 @@ if test "$enable_statsysbfd" = "yes" || + + + # ++# bfd_link_info.output_bfd minimal configure change check ++# ++ ++ AC_MSG_CHECKING(for bfd_link_info.output_bfd) ++ AC_TRY_RUN([#include ++ #include ++ int main() {struct bfd_link_info i;i.output_bfd=0;return 0;}], ++ AC_MSG_RESULT(yes) ++ AC_DEFINE(HAVE_OUTPUT_BFD), ++ AC_MSG_RESULT(no), ++ AC_MSG_RESULT(no)) ++ ++# + # FIXME: Need to workaround mingw before this point -- CM + # + if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then + echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c +- MP=`$CC [ -Wl,-M ] -static -o foo foo.c -lbfd -liberty 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` ++ MP=`$CC [ -Wl,-M ] -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` + rm -f foo.c foo + if echo $MP | tr ' ' '\012' | grep -q libbfd.a ; then +- TLIBS="$TLIBS `echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[[j]]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[[j]],j!=i ? "/" : "")}'`" ++ LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[[j]]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[[j]],j!=i ? "/" : "")}'`" + else + echo Guessing path to libbfd.a due to gcc bug +- TLIBS="$TLIBS /usr/lib/libbfd.a" ++ LIBBFD="/usr/lib/libbfd.a" + fi + if echo $MP | tr ' ' '\012' | grep -q libiberty.a ; then +- TLIBS="$TLIBS `echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[[j]]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[[j]],j!=i ? "/" : "")}'`" ++ LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[[j]]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[[j]],j!=i ? "/" : "")}'`" + else + echo Guessing path to libiberty.a due to gcc bug +- TLIBS="$TLIBS /usr/lib/libiberty.a" ++ LIBIBERTY="/usr/lib/libiberty.a" + fi ++ BUILD_BFD=copy_bfd ++ AC_CHECK_LIB(z,inflate, ++ [TLIBS="$TLIBS -lz"], ++ AC_MSG_ERROR([Need zlib for bfd linking]),[]) ++ AC_CHECK_LIB(dl,dlsym, ++ [TLIBS="$TLIBS -ldl"], ++ AC_MSG_ERROR([Need libdl for bfd linking]),[]) ++ AC_SUBST(BUILD_BFD) ++ AC_SUBST(LIBBFD) ++ AC_SUBST(LIBIBERTY) ++ + else +- TLIBS="$TLIBS -lbfd -liberty" ++ TLIBS="$TLIBS -lbfd -liberty -ldl" + fi + fi + +@@ -838,17 +986,31 @@ if test "$enable_locbfd" = "yes" ; then + + # check for gettext. It is part of glibc, but others + # need GNU gettext separately. +- AC_CHECK_HEADER(libintl.h, true, +- AC_MSG_ERROR(libintl.h (gettext) not found)) +- AC_SEARCH_LIBS(dgettext, intl, true, AC_MSG_ERROR(gettext library not found)) ++# AC_CHECK_HEADER(libintl.h, true, ++# AC_MSG_ERROR(libintl.h (gettext) not found)) ++# AC_SEARCH_LIBS(dgettext, intl, true, AC_MSG_ERROR(gettext library not found)) + + echo "#" + echo "#" + echo "# -------------------------" ++ echo "# Subconfigure of LIBINTL" ++ echo "#" ++ echo "#" ++ cd binutils/intl && chmod +x configure && ./configure --disable-nls && cd ../.. ++# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " ++ echo "#" ++ echo "#" ++ echo "#" ++ echo "# Subconfigure of LIBINTL done" ++ echo "# ------------------------------" ++ echo "#" ++ echo "#" ++ echo "#" ++ echo "# -------------------------" + echo "# Subconfigure of LIBIBERTY" + echo "#" + echo "#" +- cd binutils/libiberty && chmod +x configure && ./configure && cd ../.. ++ cd binutils/libiberty && chmod +x configure && ./configure --disable-nls && cd ../.. + # MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " + echo "#" + echo "#" +@@ -862,7 +1024,7 @@ if test "$enable_locbfd" = "yes" ; then + echo "# Subconfigure of BFD" + echo "#" + echo "#" +- cd binutils/bfd && chmod +x configure && ./configure && cd ../.. ++ cd binutils/bfd && chmod +x configure && ./configure --with-included-gettext --disable-nls && cd ../.. + # MY_SUBDIRS="$MY_SUBDIRS binutils/bfd " + echo "#" + echo "#" +@@ -876,6 +1038,11 @@ if test "$enable_locbfd" = "yes" ; then + AC_SUBST(BUILD_BFD) + fi + ++ ++AC_CHECK_FUNC(xdr_double,, ++ AC_CHECK_LIB(tirpc,xdr_double,TLIBS="$TLIBS -ltirpc",AC_MSG_ERROR([Need xdr_double]))) ++ ++ + #AC_CONFIG_SUBDIRS($MY_SUBDIRS) + + # Find where Data begins. This is used by the storage allocation +@@ -919,14 +1086,21 @@ AC_MSG_RESULT($sizeof_contblock) + AC_DEFINE_UNQUOTED(SIZEOF_CONTBLOCK,$sizeof_contblock) + + +- +-AC_CHECK_HEADERS(endian.h, +- AC_MSG_CHECKING("endianness") +- AC_TRY_RUN([#define __ARMEB__ +- #include +- int main() { return BYTE_ORDER == __LITTLE_ENDIAN ? 0 : 1;}], +- AC_DEFINE(LITTLE_END) AC_MSG_RESULT(little), +- AC_MSG_RESULT(big),AC_MSG_RESULT(big))) ++AC_MSG_CHECKING(for word order) ++AC_TRY_RUN([int main () { ++ /* Are we little or big endian? Adapted from Harbison&Steele. */ ++ union ++ { ++ double d; ++ int l[sizeof(double)/sizeof(int)]; ++ } u; ++ u.d = 1.0; ++ return u.l[sizeof(double)/sizeof(int)-1] ? 0 : 1; ++}],AC_MSG_RESULT(little) ++ AC_DEFINE(LITTLE_END), ++ AC_MSG_RESULT(big), ++ AC_MSG_RESULT([WARNING: ASSUMING LITTLE ENDIAN FOR CROSS COMPILING !!!] ++ AC_DEFINE(LITTLE_END))) + AC_SUBST(LITTLE_END) + + +@@ -950,121 +1124,112 @@ AC_TRY_RUN([#include + AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx])) + + if test "$HAVE_SBRK" = "1" ; then +- AC_MSG_CHECKING([for randomized sbrk]) +- AC_TRY_RUN([#include +- #include +- int main() { ++ ++# AC_CHECK_HEADER(sys/personality.h, true, ++# AC_MSG_RESULT(sys/personality.h not found)) ++ ++ AC_MSG_CHECKING([for ADDR_NO_RANDOMIZE constant]) ++ AC_TRY_RUN([#include ++ #include ++ int main(int argc,char *argv[],char *envp[]) { + FILE *f; +- if (!(f=fopen("conftest1","w"))) +- return -1; +- fprintf(f,"%u",sbrk(0)); ++ if (!(f=fopen("conftest1","w"))) return -1; ++ fprintf(f,"%x",ADDR_NO_RANDOMIZE); + return 0; + }], +- SBRK=`cat conftest1`,SBRK=0,SBRK=0) ++ ADDR_NO_RANDOMIZE=`cat conftest1`,ADDR_NO_RANDOMIZE=0,ADDR_NO_RANDOMIZE=0) ++ if test "$ADDR_NO_RANDOMIZE" = "0" ; then ++ AC_MSG_RESULT([no, assuming 0x40000]) ++ AC_DEFINE_UNQUOTED(ADDR_NO_RANDOMIZE,0x40000) ++ else ++ AC_MSG_RESULT([yes, $ADDR_NO_RANDOMIZE]) ++ fi ++ ++ AC_MSG_CHECKING([for personality(ADDR_NO_RANDOMIZE) support]) ++ AC_TRY_RUN([void gprof_cleanup() {}; ++ int main(int argc,char *argv[],char *envp[]) { ++ #include "h/unrandomize.h" ++ return 0;}],CAN_UNRANDOMIZE_SBRK=1,CAN_UNRANDOMIZE_SBRK=0,CAN_UNRANDOMIZE_SBRK=0) ++ ++ if test "$CAN_UNRANDOMIZE_SBRK" != 0 ; then ++ AC_MSG_RESULT(yes) ++ AC_DEFINE(CAN_UNRANDOMIZE_SBRK) ++ else ++ AC_MSG_RESULT(no) ++ fi ++ ++ AC_MSG_CHECKING([that sbrk is (now) non-random]) ++ AC_TRY_RUN([#include ++ void gprof_cleanup() {}; ++ int main(int argc,char * argv[],char * envp[]) { ++ FILE *f; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ if (!(f=fopen("conftest1","w"))) return -1; ++ fprintf(f,"%u",sbrk(0)); ++ return 0;}],SBRK=`cat conftest1`,SBRK=0,SBRK=0) + if test "$SBRK" = "0" ; then + AC_MSG_RESULT(cannot trap sbrk) + exit 1 + fi +- AC_TRY_RUN([#include +- #include +- int main() { ++ AC_TRY_RUN([#include ++ void gprof_cleanup() {}; ++ int main(int argc,char * argv[],char * envp[]) { + FILE *f; +- if (!(f=fopen("conftest1","w"))) +- return -1; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ if (!(f=fopen("conftest1","w"))) return -1; + fprintf(f,"%u",sbrk(0)); +- return 0; +- }], +- SBRK1=`cat conftest1`,SBRK1=0,SBRK1=0) ++ return 0;}],SBRK1=`cat conftest1`,SBRK1=0,SBRK1=0) + if test "$SBRK1" = "0" ; then + AC_MSG_RESULT(cannot trap sbrk) + exit 1 + fi +- +- if test "$SBRK" != "$SBRK1" ; then ++ if test "$SBRK" = "$SBRK1" ; then + AC_MSG_RESULT(yes) +- AC_MSG_CHECKING([for randomized brk remedy]) +- AC_TRY_RUN([#include +- #include +- #include +- #include +- int main(int argc,char * argv[]) { +- FILE *f; +- #if SIZEOF_LONG == 4 +- if (!syscall(SYS_personality,PER_LINUX32)) +- #else +- if (!syscall(SYS_personality,PER_LINUX)) +- #endif +- execvp(argv[0],argv); +- if (!(f=fopen("conftest1","w"))) +- return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0; +- }], +- SBRK=`cat conftest1`,SBRK=0,SBRK=0) +- if test "$SBRK" = "0" ; then +- AC_MSG_RESULT(cannot trap sbrk) +- exit 1 +- fi +- AC_TRY_RUN([#include +- #include +- #include +- #include +- int main(int argc,char * argv[]) { +- FILE *f; +- #if SIZEOF_LONG == 4 +- if (!syscall(SYS_personality,PER_LINUX32)) +- #else +- if (!syscall(SYS_personality,PER_LINUX)) +- #endif +- execvp(argv[0],argv); +- if (!(f=fopen("conftest1","w"))) +- return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0; +- }], +- SBRK1=`cat conftest1`,SBRK1=0,SBRK1=0) +- if test "$SBRK1" = "0" ; then +- AC_MSG_RESULT(cannot trap sbrk) +- exit 1 +- fi +- if test "$SBRK" = "$SBRK1" ; then +- AC_MSG_RESULT(yes) +- AC_DEFINE(NEED_NONRANDOM_SBRK) +- else +- AC_MSG_RESULT(no) +- echo "Cannot build with randomized sbrk" +- exit 1 +- fi + else + AC_MSG_RESULT(no) ++ echo "Cannot build with randomized sbrk. Your options:" ++ echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" ++ echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" ++ echo " - run sysctl kernel.randomize_va_space=0 before using gcl" ++ exit 1 + fi + fi + ++# pagewidth ++AC_MSG_CHECKING(for pagewidth) ++AC_TRY_RUN([#include ++ #include ++int main() {size_t i=getpagesize(),j; ++ FILE *fp=fopen("conftest1","w"); ++ for (j=0;i>>=1;j++); ++ if (j<12) {printf("pagewidth %u is too small\n",j);return -1;} ++ fprintf(fp,"%u",j); ++ return 0;}],PAGEWIDTH=`cat conftest1`,PAGEWIDTH=0,PAGEWIDTH=0) ++AC_MSG_RESULT($PAGEWIDTH) ++AC_DEFINE_UNQUOTED(PAGEWIDTH,$PAGEWIDTH) ++AC_SUBST(PAGEWIDTH) ++ + + old_LDFLAGS="$LDFLAGS" + LDFLAGS="$TLDFLAGS" + AC_MSG_CHECKING("finding DBEGIN") + AC_TRY_RUN([#include + #include +- #ifdef NEED_NONRANDOM_SBRK +- #include +- #include +- #include +- #endif ++ ++void gprof_cleanup() {}; + int +-main(int argc,char * argv[]) ++main(int argc,char * argv[],char *envp[]) + { +- char *b; ++ char *b,*b1; + FILE *fp; + +-#ifdef NEED_NONRANDOM_SBRK +-#if SIZEOF_LONG == 4 +-if (!syscall(SYS_personality,PER_LINUX32)) +-#else +-if (!syscall(SYS_personality,PER_LINUX)) ++#ifdef CAN_UNRANDOMIZE_SBRK ++#include "h/unrandomize.h" + #endif +- execvp(argv[0],argv); +-#endif + b = (void *) malloc(1000); + fp = fopen("conftest1","w"); + +@@ -1072,17 +1237,16 @@ if (!syscall(SYS_personality,PER_LINUX)) + fprintf(fp,"_dbegin"); + #else + #if defined (__APPLE__) && defined (__MACH__) +- fprintf(fp,"get_dbegin()"); ++ fprintf(fp,"mach_mapstart"); + #else +- fprintf(fp,"0x%lx",((unsigned long) b) & ~(unsigned long)0xffffff); ++ b1=((unsigned long) b) & ~(unsigned long)0xffffff;b=(void *)b1<(void *)&b1 && (void *)b>(void *)&b ? ((unsigned long) b) & ~(unsigned long)((1< +- #include +-int main() {size_t i=getpagesize(),j; +- FILE *fp=fopen("conftest1","w"); +- for (j=0;i>>=1;j++); +- fprintf(fp,"%u",j); +- return 0;}],PAGEWIDTH=`cat conftest1`,PAGEWIDTH=0,PAGEWIDTH=0) +-AC_MSG_RESULT($PAGEWIDTH) +-AC_DEFINE_UNQUOTED(PAGEWIDTH,$PAGEWIDTH) +-AC_SUBST(PAGEWIDTH) +- + # Maximum number of pages + + +@@ -1170,6 +1321,8 @@ AC_CHECK_HEADERS(sys/ioctl.h) + # OpenBSD has elf_abi.h instead of elf.h + AC_CHECK_HEADERS(elf.h elf_abi.h) + ++AC_CHECK_HEADERS(sys/sockio.h) ++ + + #-------------------------------------------------------------------- + # The code below deals with several issues related to gettimeofday: +@@ -1238,43 +1391,40 @@ AC_CHECK_HEADERS(float.h,AC_DEFINE(HAVE_ + # test makes sense. CM + # + AC_MSG_CHECKING([for isnormal]) +-AC_TRY_RUN([#define _GNU_SOURCE ++AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++ #define _GNU_SOURCE + #include +- int main() { +- float f; +- return isnormal(f) || !isnormal(f) ? 0 : 1; +- }], +- AC_DEFINE(HAVE_ISNORMAL) AC_MSG_RESULT(yes), +- AC_MSG_CHECKING([for fpclass in ieeefp.h]) +- AC_TRY_RUN([#include +- int main() { +- float f; +- return fpclass(f)>=FP_NZERO || fpclass(f) ++ ]],[[ ++ float f; ++ return fpclass(f)>=FP_NZERO || fpclass(f) +- int main() { ++AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++ #define _GNU_SOURCE ++ #include ++ ]],[[ ++ float f; ++ return isfinite(f) || !isfinite(f) ? 0 : 1; ++ ]])],[AC_DEFINE(HAVE_ISFINITE,1,[Have isfinite function]) AC_MSG_RESULT(yes)], ++ [AC_MSG_CHECKING([for finite()]) ++ AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++ #include ++ #include ++ ]],[[ + float f; +- return isfinite(f) || !isfinite(f) ? 0 : 1; +- }], +- AC_DEFINE(HAVE_ISFINITE) AC_MSG_RESULT(yes), +- AC_MSG_CHECKING([for finite()]) +- AC_TRY_RUN([#include +- #include +- int main() { +- float f; +- return finite(f) || !finite(f) ? 0 : 1; +- }], +- AC_DEFINE(HAVE_FINITE) AC_MSG_RESULT(yes), +- HAVE_FINITE=0 AC_MSG_RESULT(no),HAVE_FINITE=0 AC_MSG_RESULT(no)) +- ,HAVE_ISFINITE=0 AC_MSG_RESULT(no),HAVE_ISFINITE=0 AC_MSG_RESULT(no)) +- +- ++ return finite(f) || !finite(f) ? 0 : 1; ++ ]])],[AC_DEFINE(HAVE_FINITE,1,[Have finite function]) AC_MSG_RESULT(yes)], ++ [AC_MSG_ERROR(no)])]) + + #-------------------------------------------------------------------- + # Check for the existence of the -lsocket and -lnsl libraries. +@@ -1312,9 +1462,9 @@ RL_OBJS="" + RL_LIB="" + if test "$enable_readline" = "yes" ; then + AC_CHECK_HEADERS(readline/readline.h, +- AC_CHECK_LIB(readline,main, ++ AC_CHECK_LIB(readline,rl_initialize, + AC_DEFINE(HAVE_READLINE) +- TLIBS="$TLIBS -lreadline -lncurses" ++ TLIBS="$TLIBS -lreadline -lncurses" #some machines don't link this, e.g. Slackware + RL_OBJS=gcl_readline.o + # Readline support now initialized automatically when compiled in, this lisp + # object no longer needed -- 20040102 CM +@@ -1324,7 +1474,7 @@ if test "$enable_readline" = "yes" ; the + # These tests discover differences between readline 4.1 and 4.3 + AC_CHECK_LIB(readline,rl_completion_matches, + AC_DEFINE(HAVE_DECL_RL_COMPLETION_MATCHES) +- AC_DEFINE(HAVE_RL_COMPENTRY_FUNC_T),,) ++ AC_DEFINE(HAVE_RL_COMPENTRY_FUNC_T),,-lncurses) + fi + + AC_SUBST(RL_OBJS) +@@ -1530,7 +1680,7 @@ EOF + AC_MSG_CHECKING([emacs site lisp directory]) + if [[ "$EMACS_SITE_LISP" = "unknown" ]] ; then + if [[ "$EMACS" != "" ]] ; then +- EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d ` ++ EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | grep -v ^Warning: | sed -e /Loading/d | sed -e /load/d ` + else + EMACS_SITE_LISP="" + fi +@@ -1586,15 +1736,12 @@ else + INFO_DIR=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d ` + fi + fi +-if test -f "${INFO_DIR}dir" ; then true;else +-if test -f /usr/share/info/dir ; then +- INFO_DIR=/usr/share/info/ +-else true; +-fi +-fi ++ + AC_MSG_RESULT($INFO_DIR) + AC_SUBST(INFO_DIR) + ++if test "$enable_tcltk" = "yes" ; then ++ + AC_MSG_CHECKING([for tcl/tk]) + + +@@ -1688,6 +1835,9 @@ if test -f ${TCL_CONFIG_PREFIX}/../inclu + TCL_INCLUDE=-I/usr/include/tcl${TCL_VERSION} + fi + fi ++ ++fi ++ + AC_CHECK_LIB(lieee,main,have_ieee=1,have_ieee=0) + if test "$have_ieee" = "0" ; then + TCL_LIBS=`echo ${TCL_LIBS} | sed -e "s:-lieee::g" ` +@@ -1740,7 +1890,7 @@ if test $gcl_ok = yes ; then + AC_DEFINE(HAVE_ALLOCA) + else + AC_TRY_RUN([#include +- int main() { exit(alloca(500) != NULL ? 0 : 1)}], ++ int main() { exit(alloca(500) != NULL ? 0 : 1);}], + ,gcl_ok=yes, gcl_ok=no,gcl_ok=no) + if test $gcl_ok = yes ; then + AC_MSG_RESULT(yes) +@@ -1797,9 +1947,11 @@ if 2>&1 $CC -v | fgrep "gcc version 2.9 + AC_MSG_RESULT([no]) + fi + +-LIBS="$LDFLAGS $TLDFLAGS $LIBS $TLIBS" ++LDFLAGS="$LDFLAGS $TLDFLAGS" ++AC_SUBST(LDFLAGS) ++LIBS="$LDFLAGS $X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $TLDFLAGS $LIBS $TLIBS" + AC_SUBST(LIBS) +-FINAL_CFLAGS="$CFLAGS $TCFLAGS $PROCESSOR_FLAGS" ++FINAL_CFLAGS="$CFLAGS $X_CFLAGS $TCFLAGS $PROCESSOR_FLAGS" + AC_SUBST(FINAL_CFLAGS) + # Work around bug with gcc on ppc -- CM + NIFLAGS="$CFLAGS $TCFLAGS $TONIFLAGS $PROCESSOR_FLAGS -I\$(GCLDIR)/o" +--- /dev/null ++++ gcl-2.6.7/README.wine +@@ -0,0 +1,17 @@ ++On Debian, for example, gcl can be run and tested under wine as follows: ++ ++(as root) ++ ++aptitude install mingw32 mingw32-runtime mingw32-binutils wine ++ ++If necessary, as root ++ ++update-binfmts --enable wine ++ ++Then as a normal user, ++ ++export PATH=/usr/i586-mingw32msvc/bin:$PATH ++export CC=/usr/bin/i586-mingw32msvc-gcc ++ ++./configure --host=mingw32 && make ++ +--- gcl-2.6.7.orig/config.guess ++++ gcl-2.6.7/config.guess +@@ -1,9 +1,10 @@ + #! /bin/sh + # Attempt to guess a canonical system name. + # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +-# 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ++# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 ++# Free Software Foundation, Inc. + +-timestamp='2005-04-22' ++timestamp='2009-12-30' + + # This file is free software; you can redistribute it and/or modify it + # under the terms of the GNU General Public License as published by +@@ -17,23 +18,25 @@ timestamp='2005-04-22' + # + # You should have received a copy of the GNU General Public License + # along with this program; if not, write to the Free Software +-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA ++# 02110-1301, USA. + # + # As a special exception to the GNU General Public License, if you + # distribute this file as part of a program that contains a + # configuration script generated by Autoconf, you may include it under + # the same distribution terms that you use for the rest of that program. + +-# Originally written by Per Bothner . +-# Please send patches to . Submit a context +-# diff and a properly formatted ChangeLog entry. ++ ++# Originally written by Per Bothner. Please send patches (context ++# diff format) to and include a ChangeLog ++# entry. + # + # This script attempts to guess a canonical system name similar to + # config.sub. If it succeeds, it prints the system name on stdout, and + # exits with 0. Otherwise, it exits with 1. + # +-# The plan is that this can be called by configure scripts if you +-# don't specify an explicit build system type. ++# You can get the latest version of this script from: ++# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD + + me=`echo "$0" | sed -e 's,.*/,,'` + +@@ -53,8 +56,9 @@ version="\ + GNU config.guess ($timestamp) + + Originally written by Per Bothner. +-Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 +-Free Software Foundation, Inc. ++Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, ++2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free ++Software Foundation, Inc. + + This is free software; see the source for copying conditions. There is NO + warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." +@@ -66,11 +70,11 @@ Try \`$me --help' for more information." + while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) +- echo "$timestamp" ; exit 0 ;; ++ echo "$timestamp" ; exit ;; + --version | -v ) +- echo "$version" ; exit 0 ;; ++ echo "$version" ; exit ;; + --help | --h* | -h ) +- echo "$usage"; exit 0 ;; ++ echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. +@@ -104,7 +108,7 @@ set_cc_for_build=' + trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; + trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; + : ${TMPDIR=/tmp} ; +- { tmp=`(umask 077 && mktemp -d -q "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || ++ { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || + { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || + { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || + { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; +@@ -123,7 +127,7 @@ case $CC_FOR_BUILD,$HOST_CC,$CC in + ;; + ,,*) CC_FOR_BUILD=$CC ;; + ,*,*) CC_FOR_BUILD=$HOST_CC ;; +-esac ;' ++esac ; set_cc_for_build= ;' + + # This is needed to find uname on a Pyramid OSx when run in the BSD universe. + # (ghazi@noc.rutgers.edu 1994-08-24) +@@ -158,6 +162,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + arm*) machine=arm-unknown ;; + sh3el) machine=shl-unknown ;; + sh3eb) machine=sh-unknown ;; ++ sh5el) machine=sh5le-unknown ;; + *) machine=${UNAME_MACHINE_ARCH}-unknown ;; + esac + # The Operating System including object format, if it has switched +@@ -166,7 +171,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + arm*|i386|m68k|ns32k|sh3*|sparc|vax) + eval $set_cc_for_build + if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ +- | grep __ELF__ >/dev/null ++ | grep -q __ELF__ + then + # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). + # Return netbsd for either. FIX? +@@ -196,55 +201,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + # contains redundant information, the shorter form: + # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. + echo "${machine}-${os}${release}" +- exit 0 ;; +- amd64:OpenBSD:*:*) +- echo x86_64-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- amiga:OpenBSD:*:*) +- echo m68k-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- cats:OpenBSD:*:*) +- echo arm-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- hp300:OpenBSD:*:*) +- echo m68k-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- luna88k:OpenBSD:*:*) +- echo m88k-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- mac68k:OpenBSD:*:*) +- echo m68k-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- macppc:OpenBSD:*:*) +- echo powerpc-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- mvme68k:OpenBSD:*:*) +- echo m68k-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- mvme88k:OpenBSD:*:*) +- echo m88k-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- mvmeppc:OpenBSD:*:*) +- echo powerpc-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- sgi:OpenBSD:*:*) +- echo mips64-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- sun3:OpenBSD:*:*) +- echo m68k-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:OpenBSD:*:*) +- echo ${UNAME_MACHINE}-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; ++ UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` ++ echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} ++ exit ;; + *:ekkoBSD:*:*) + echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; ++ *:SolidBSD:*:*) ++ echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} ++ exit ;; + macppc:MirBSD:*:*) +- echo powerppc-unknown-mirbsd${UNAME_RELEASE} +- exit 0 ;; ++ echo powerpc-unknown-mirbsd${UNAME_RELEASE} ++ exit ;; + *:MirBSD:*:*) + echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + alpha:OSF1:*:*) + case $UNAME_RELEASE in + *4.0) +@@ -297,40 +270,43 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + # A Xn.n version is an unreleased experimental baselevel. + # 1.2 uses "1.2" for uname -r. + echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` +- exit 0 ;; ++ exit ;; + Alpha\ *:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # Should we change UNAME_MACHINE based on the output of uname instead + # of the specific Alpha model? + echo alpha-pc-interix +- exit 0 ;; ++ exit ;; + 21064:Windows_NT:50:3) + echo alpha-dec-winnt3.5 +- exit 0 ;; ++ exit ;; + Amiga*:UNIX_System_V:4.0:*) + echo m68k-unknown-sysv4 +- exit 0;; ++ exit ;; + *:[Aa]miga[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-amigaos +- exit 0 ;; ++ exit ;; + *:[Mm]orph[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-morphos +- exit 0 ;; ++ exit ;; + *:OS/390:*:*) + echo i370-ibm-openedition +- exit 0 ;; ++ exit ;; + *:z/VM:*:*) + echo s390-ibm-zvmoe +- exit 0 ;; ++ exit ;; + *:OS400:*:*) + echo powerpc-ibm-os400 +- exit 0 ;; ++ exit ;; + arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) + echo arm-acorn-riscix${UNAME_RELEASE} +- exit 0;; ++ exit ;; ++ arm:riscos:*:*|arm:RISCOS:*:*) ++ echo arm-unknown-riscos ++ exit ;; + SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) + echo hppa1.1-hitachi-hiuxmpp +- exit 0;; ++ exit ;; + Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) + # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. + if test "`(/bin/universe) 2>/dev/null`" = att ; then +@@ -338,32 +314,51 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + else + echo pyramid-pyramid-bsd + fi +- exit 0 ;; ++ exit ;; + NILE*:*:*:dcosx) + echo pyramid-pyramid-svr4 +- exit 0 ;; ++ exit ;; + DRS?6000:unix:4.0:6*) + echo sparc-icl-nx6 +- exit 0 ;; ++ exit ;; + DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) + case `/usr/bin/uname -p` in +- sparc) echo sparc-icl-nx7 && exit 0 ;; ++ sparc) echo sparc-icl-nx7; exit ;; + esac ;; ++ s390x:SunOS:*:*) ++ echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` ++ exit ;; + sun4H:SunOS:5.*:*) + echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` +- exit 0 ;; ++ exit ;; + sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) + echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` +- exit 0 ;; +- i86pc:SunOS:5.*:*) +- echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` +- exit 0 ;; ++ exit ;; ++ i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) ++ echo i386-pc-auroraux${UNAME_RELEASE} ++ exit ;; ++ i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) ++ eval $set_cc_for_build ++ SUN_ARCH="i386" ++ # If there is a compiler, see if it is configured for 64-bit objects. ++ # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. ++ # This test works for both compilers. ++ if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then ++ if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ ++ (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ ++ grep IS_64BIT_ARCH >/dev/null ++ then ++ SUN_ARCH="x86_64" ++ fi ++ fi ++ echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` ++ exit ;; + sun4*:SunOS:6*:*) + # According to config.sub, this is the proper way to canonicalize + # SunOS6. Hard to guess exactly what SunOS6 will be like, but + # it's likely to be more like Solaris than SunOS4. + echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` +- exit 0 ;; ++ exit ;; + sun4*:SunOS:*:*) + case "`/usr/bin/arch -k`" in + Series*|S4*) +@@ -372,10 +367,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + esac + # Japanese Language versions have a version number like `4.1.3-JL'. + echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` +- exit 0 ;; ++ exit ;; + sun3*:SunOS:*:*) + echo m68k-sun-sunos${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + sun*:*:4.2BSD:*) + UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` + test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 +@@ -387,10 +382,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + echo sparc-sun-sunos${UNAME_RELEASE} + ;; + esac +- exit 0 ;; ++ exit ;; + aushp:SunOS:*:*) + echo sparc-auspex-sunos${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + # The situation for MiNT is a little confusing. The machine name + # can be virtually everything (everything which is not + # "atarist" or "atariste" at least should have a processor +@@ -401,40 +396,40 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + # be no problem. + atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) + echo m68k-milan-mint${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) + echo m68k-hades-mint${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) + echo m68k-unknown-mint${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + m68k:machten:*:*) + echo m68k-apple-machten${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + powerpc:machten:*:*) + echo powerpc-apple-machten${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + RISC*:Mach:*:*) + echo mips-dec-mach_bsd4.3 +- exit 0 ;; ++ exit ;; + RISC*:ULTRIX:*:*) + echo mips-dec-ultrix${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + VAX*:ULTRIX*:*:*) + echo vax-dec-ultrix${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + 2020:CLIX:*:* | 2430:CLIX:*:*) + echo clipper-intergraph-clix${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + mips:*:*:UMIPS | mips:*:*:RISCos) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c +@@ -458,32 +453,33 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + exit (-1); + } + EOF +- $CC_FOR_BUILD -o $dummy $dummy.c \ +- && $dummy `echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` \ +- && exit 0 ++ $CC_FOR_BUILD -o $dummy $dummy.c && ++ dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && ++ SYSTEM_NAME=`$dummy $dummyarg` && ++ { echo "$SYSTEM_NAME"; exit; } + echo mips-mips-riscos${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + Motorola:PowerMAX_OS:*:*) + echo powerpc-motorola-powermax +- exit 0 ;; ++ exit ;; + Motorola:*:4.3:PL8-*) + echo powerpc-harris-powermax +- exit 0 ;; ++ exit ;; + Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) + echo powerpc-harris-powermax +- exit 0 ;; ++ exit ;; + Night_Hawk:Power_UNIX:*:*) + echo powerpc-harris-powerunix +- exit 0 ;; ++ exit ;; + m88k:CX/UX:7*:*) + echo m88k-harris-cxux7 +- exit 0 ;; ++ exit ;; + m88k:*:4*:R4*) + echo m88k-motorola-sysv4 +- exit 0 ;; ++ exit ;; + m88k:*:3*:R3*) + echo m88k-motorola-sysv3 +- exit 0 ;; ++ exit ;; + AViiON:dgux:*:*) + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` +@@ -499,29 +495,29 @@ EOF + else + echo i586-dg-dgux${UNAME_RELEASE} + fi +- exit 0 ;; ++ exit ;; + M88*:DolphinOS:*:*) # DolphinOS (SVR3) + echo m88k-dolphin-sysv3 +- exit 0 ;; ++ exit ;; + M88*:*:R3*:*) + # Delta 88k system running SVR3 + echo m88k-motorola-sysv3 +- exit 0 ;; ++ exit ;; + XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) + echo m88k-tektronix-sysv3 +- exit 0 ;; ++ exit ;; + Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) + echo m68k-tektronix-bsd +- exit 0 ;; ++ exit ;; + *:IRIX*:*:*) + echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` +- exit 0 ;; ++ exit ;; + ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. +- echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id +- exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX ' ++ echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id ++ exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' + i*86:AIX:*:*) + echo i386-ibm-aix +- exit 0 ;; ++ exit ;; + ia64:AIX:*:*) + if [ -x /usr/bin/oslevel ] ; then + IBM_REV=`/usr/bin/oslevel` +@@ -529,7 +525,7 @@ EOF + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} +- exit 0 ;; ++ exit ;; + *:AIX:2:3) + if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then + eval $set_cc_for_build +@@ -544,15 +540,19 @@ EOF + exit(0); + } + EOF +- $CC_FOR_BUILD -o $dummy $dummy.c && $dummy && exit 0 +- echo rs6000-ibm-aix3.2.5 ++ if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` ++ then ++ echo "$SYSTEM_NAME" ++ else ++ echo rs6000-ibm-aix3.2.5 ++ fi + elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then + echo rs6000-ibm-aix3.2.4 + else + echo rs6000-ibm-aix3.2 + fi +- exit 0 ;; +- *:AIX:*:[45]) ++ exit ;; ++ *:AIX:*:[456]) + IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` + if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then + IBM_ARCH=rs6000 +@@ -565,28 +565,28 @@ EOF + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${IBM_ARCH}-ibm-aix${IBM_REV} +- exit 0 ;; ++ exit ;; + *:AIX:*:*) + echo rs6000-ibm-aix +- exit 0 ;; ++ exit ;; + ibmrt:4.4BSD:*|romp-ibm:BSD:*) + echo romp-ibm-bsd4.4 +- exit 0 ;; ++ exit ;; + ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and + echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to +- exit 0 ;; # report: romp-ibm BSD 4.3 ++ exit ;; # report: romp-ibm BSD 4.3 + *:BOSX:*:*) + echo rs6000-bull-bosx +- exit 0 ;; ++ exit ;; + DPX/2?00:B.O.S.:*:*) + echo m68k-bull-sysv3 +- exit 0 ;; ++ exit ;; + 9000/[34]??:4.3bsd:1.*:*) + echo m68k-hp-bsd +- exit 0 ;; ++ exit ;; + hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) + echo m68k-hp-bsd4.4 +- exit 0 ;; ++ exit ;; + 9000/[34678]??:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + case "${UNAME_MACHINE}" in +@@ -648,9 +648,19 @@ EOF + esac + if [ ${HP_ARCH} = "hppa2.0w" ] + then +- # avoid double evaluation of $set_cc_for_build +- test -n "$CC_FOR_BUILD" || eval $set_cc_for_build +- if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E -) | grep __LP64__ >/dev/null ++ eval $set_cc_for_build ++ ++ # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating ++ # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler ++ # generating 64-bit code. GNU and HP use different nomenclature: ++ # ++ # $ CC_FOR_BUILD=cc ./config.guess ++ # => hppa2.0w-hp-hpux11.23 ++ # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess ++ # => hppa64-hp-hpux11.23 ++ ++ if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | ++ grep -q __LP64__ + then + HP_ARCH="hppa2.0w" + else +@@ -658,11 +668,11 @@ EOF + fi + fi + echo ${HP_ARCH}-hp-hpux${HPUX_REV} +- exit 0 ;; ++ exit ;; + ia64:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + echo ia64-hp-hpux${HPUX_REV} +- exit 0 ;; ++ exit ;; + 3050*:HI-UX:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c +@@ -690,219 +700,248 @@ EOF + exit (0); + } + EOF +- $CC_FOR_BUILD -o $dummy $dummy.c && $dummy && exit 0 ++ $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && ++ { echo "$SYSTEM_NAME"; exit; } + echo unknown-hitachi-hiuxwe2 +- exit 0 ;; ++ exit ;; + 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) + echo hppa1.1-hp-bsd +- exit 0 ;; ++ exit ;; + 9000/8??:4.3bsd:*:*) + echo hppa1.0-hp-bsd +- exit 0 ;; ++ exit ;; + *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) + echo hppa1.0-hp-mpeix +- exit 0 ;; ++ exit ;; + hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) + echo hppa1.1-hp-osf +- exit 0 ;; ++ exit ;; + hp8??:OSF1:*:*) + echo hppa1.0-hp-osf +- exit 0 ;; ++ exit ;; + i*86:OSF1:*:*) + if [ -x /usr/sbin/sysversion ] ; then + echo ${UNAME_MACHINE}-unknown-osf1mk + else + echo ${UNAME_MACHINE}-unknown-osf1 + fi +- exit 0 ;; ++ exit ;; + parisc*:Lites*:*:*) + echo hppa1.1-hp-lites +- exit 0 ;; ++ exit ;; + C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) + echo c1-convex-bsd +- exit 0 ;; ++ exit ;; + C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi +- exit 0 ;; ++ exit ;; + C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) + echo c34-convex-bsd +- exit 0 ;; ++ exit ;; + C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) + echo c38-convex-bsd +- exit 0 ;; ++ exit ;; + C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) + echo c4-convex-bsd +- exit 0 ;; ++ exit ;; + CRAY*Y-MP:*:*:*) + echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' +- exit 0 ;; ++ exit ;; + CRAY*[A-Z]90:*:*:*) + echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ + | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ + -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ + -e 's/\.[^.]*$/.X/' +- exit 0 ;; ++ exit ;; + CRAY*TS:*:*:*) + echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' +- exit 0 ;; ++ exit ;; + CRAY*T3E:*:*:*) + echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' +- exit 0 ;; ++ exit ;; + CRAY*SV1:*:*:*) + echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' +- exit 0 ;; ++ exit ;; + *:UNICOS/mp:*:*) + echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' +- exit 0 ;; ++ exit ;; + F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) + FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" +- exit 0 ;; ++ exit ;; + 5000:UNIX_System_V:4.*:*) + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" +- exit 0 ;; ++ exit ;; + i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) + echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + sparc*:BSD/OS:*:*) + echo sparc-unknown-bsdi${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:BSD/OS:*:*) + echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:FreeBSD:*:*) +- echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` +- exit 0 ;; ++ case ${UNAME_MACHINE} in ++ pc98) ++ echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; ++ amd64) ++ echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; ++ *) ++ echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; ++ esac ++ exit ;; + i*:CYGWIN*:*) + echo ${UNAME_MACHINE}-pc-cygwin +- exit 0 ;; +- i*:MINGW*:*) ++ exit ;; ++ *:MINGW*:*) + echo ${UNAME_MACHINE}-pc-mingw32 +- exit 0 ;; ++ exit ;; ++ i*:windows32*:*) ++ # uname -m includes "-pc" on this system. ++ echo ${UNAME_MACHINE}-mingw32 ++ exit ;; + i*:PW*:*) + echo ${UNAME_MACHINE}-pc-pw32 +- exit 0 ;; +- x86:Interix*:[34]*) +- echo i586-pc-interix${UNAME_RELEASE}|sed -e 's/\..*//' +- exit 0 ;; ++ exit ;; ++ *:Interix*:*) ++ case ${UNAME_MACHINE} in ++ x86) ++ echo i586-pc-interix${UNAME_RELEASE} ++ exit ;; ++ authenticamd | genuineintel | EM64T) ++ echo x86_64-unknown-interix${UNAME_RELEASE} ++ exit ;; ++ IA64) ++ echo ia64-unknown-interix${UNAME_RELEASE} ++ exit ;; ++ esac ;; + [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) + echo i${UNAME_MACHINE}-pc-mks +- exit 0 ;; ++ exit ;; ++ 8664:Windows_NT:*) ++ echo x86_64-pc-mks ++ exit ;; + i*:Windows_NT*:* | Pentium*:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we + # UNAME_MACHINE based on the output of uname instead of i386? + echo i586-pc-interix +- exit 0 ;; ++ exit ;; + i*:UWIN*:*) + echo ${UNAME_MACHINE}-pc-uwin +- exit 0 ;; +- amd64:CYGWIN*:*:*) ++ exit ;; ++ amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) + echo x86_64-unknown-cygwin +- exit 0 ;; ++ exit ;; + p*:CYGWIN*:*) + echo powerpcle-unknown-cygwin +- exit 0 ;; ++ exit ;; + prep*:SunOS:5.*:*) + echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` +- exit 0 ;; ++ exit ;; + *:GNU:*:*) + # the GNU system + echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` +- exit 0 ;; ++ exit ;; + *:GNU/*:*:*) + # other systems with GNU libc and userland + echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu +- exit 0 ;; ++ exit ;; + i*86:Minix:*:*) + echo ${UNAME_MACHINE}-pc-minix +- exit 0 ;; ++ exit ;; ++ alpha:Linux:*:*) ++ case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in ++ EV5) UNAME_MACHINE=alphaev5 ;; ++ EV56) UNAME_MACHINE=alphaev56 ;; ++ PCA56) UNAME_MACHINE=alphapca56 ;; ++ PCA57) UNAME_MACHINE=alphapca56 ;; ++ EV6) UNAME_MACHINE=alphaev6 ;; ++ EV67) UNAME_MACHINE=alphaev67 ;; ++ EV68*) UNAME_MACHINE=alphaev68 ;; ++ esac ++ objdump --private-headers /bin/sh | grep -q ld.so.1 ++ if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi ++ echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} ++ exit ;; + arm*:Linux:*:*) ++ eval $set_cc_for_build ++ if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ ++ | grep -q __ARM_EABI__ ++ then ++ echo ${UNAME_MACHINE}-unknown-linux-gnu ++ else ++ echo ${UNAME_MACHINE}-unknown-linux-gnueabi ++ fi ++ exit ;; ++ avr32*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu +- exit 0 ;; ++ exit ;; + cris:Linux:*:*) + echo cris-axis-linux-gnu +- exit 0 ;; ++ exit ;; + crisv32:Linux:*:*) + echo crisv32-axis-linux-gnu +- exit 0 ;; ++ exit ;; + frv:Linux:*:*) + echo frv-unknown-linux-gnu +- exit 0 ;; ++ exit ;; ++ i*86:Linux:*:*) ++ LIBC=gnu ++ eval $set_cc_for_build ++ sed 's/^ //' << EOF >$dummy.c ++ #ifdef __dietlibc__ ++ LIBC=dietlibc ++ #endif ++EOF ++ eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` ++ echo "${UNAME_MACHINE}-pc-linux-${LIBC}" ++ exit ;; + ia64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu +- exit 0 ;; ++ exit ;; + m32r*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu +- exit 0 ;; ++ exit ;; + m68*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu +- exit 0 ;; +- mips:Linux:*:*) ++ exit ;; ++ mips:Linux:*:* | mips64:Linux:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #undef CPU +- #undef mips +- #undef mipsel ++ #undef ${UNAME_MACHINE} ++ #undef ${UNAME_MACHINE}el + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) +- CPU=mipsel ++ CPU=${UNAME_MACHINE}el + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) +- CPU=mips ++ CPU=${UNAME_MACHINE} + #else + CPU= + #endif + #endif + EOF +- eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^CPU=` +- test x"${CPU}" != x && echo "${CPU}-unknown-linux-gnu" && exit 0 ++ eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` ++ test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } + ;; +- mips64:Linux:*:*) +- eval $set_cc_for_build +- sed 's/^ //' << EOF >$dummy.c +- #undef CPU +- #undef mips64 +- #undef mips64el +- #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) +- CPU=mips64el +- #else +- #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) +- CPU=mips64 +- #else +- CPU= +- #endif +- #endif +-EOF +- eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^CPU=` +- test x"${CPU}" != x && echo "${CPU}-unknown-linux-gnu" && exit 0 +- ;; +- ppc:Linux:*:*) +- echo powerpc-unknown-linux-gnu +- exit 0 ;; +- ppc64:Linux:*:*) +- echo powerpc64-unknown-linux-gnu +- exit 0 ;; +- alpha:Linux:*:*) +- case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in +- EV5) UNAME_MACHINE=alphaev5 ;; +- EV56) UNAME_MACHINE=alphaev56 ;; +- PCA56) UNAME_MACHINE=alphapca56 ;; +- PCA57) UNAME_MACHINE=alphapca56 ;; +- EV6) UNAME_MACHINE=alphaev6 ;; +- EV67) UNAME_MACHINE=alphaev67 ;; +- EV68*) UNAME_MACHINE=alphaev68 ;; +- esac +- objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null +- if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi +- echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} +- exit 0 ;; ++ or32:Linux:*:*) ++ echo or32-unknown-linux-gnu ++ exit ;; ++ padre:Linux:*:*) ++ echo sparc-unknown-linux-gnu ++ exit ;; ++ parisc64:Linux:*:* | hppa64:Linux:*:*) ++ echo hppa64-unknown-linux-gnu ++ exit ;; + parisc:Linux:*:* | hppa:Linux:*:*) + # Look for CPU level + case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in +@@ -910,87 +949,40 @@ EOF + PA8*) echo hppa2.0-unknown-linux-gnu ;; + *) echo hppa-unknown-linux-gnu ;; + esac +- exit 0 ;; +- parisc64:Linux:*:* | hppa64:Linux:*:*) +- echo hppa64-unknown-linux-gnu +- exit 0 ;; ++ exit ;; ++ ppc64:Linux:*:*) ++ echo powerpc64-unknown-linux-gnu ++ exit ;; ++ ppc:Linux:*:*) ++ echo powerpc-unknown-linux-gnu ++ exit ;; + s390:Linux:*:* | s390x:Linux:*:*) + echo ${UNAME_MACHINE}-ibm-linux +- exit 0 ;; ++ exit ;; + sh64*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu +- exit 0 ;; ++ exit ;; + sh*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu +- exit 0 ;; ++ exit ;; + sparc:Linux:*:* | sparc64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu +- exit 0 ;; ++ exit ;; ++ vax:Linux:*:*) ++ echo ${UNAME_MACHINE}-dec-linux-gnu ++ exit ;; + x86_64:Linux:*:*) + echo x86_64-unknown-linux-gnu +- exit 0 ;; +- i*86:Linux:*:*) +- # The BFD linker knows what the default object file format is, so +- # first see if it will tell us. cd to the root directory to prevent +- # problems with other programs or directories called `ld' in the path. +- # Set LC_ALL=C to ensure ld outputs messages in English. +- ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ +- | sed -ne '/supported targets:/!d +- s/[ ][ ]*/ /g +- s/.*supported targets: *// +- s/ .*// +- p'` +- case "$ld_supported_targets" in +- elf32-i386) +- TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" +- ;; +- a.out-i386-linux) +- echo "${UNAME_MACHINE}-pc-linux-gnuaout" +- exit 0 ;; +- coff-i386) +- echo "${UNAME_MACHINE}-pc-linux-gnucoff" +- exit 0 ;; +- "") +- # Either a pre-BFD a.out linker (linux-gnuoldld) or +- # one that does not give us useful --help. +- echo "${UNAME_MACHINE}-pc-linux-gnuoldld" +- exit 0 ;; +- esac +- # Determine whether the default compiler is a.out or elf +- eval $set_cc_for_build +- sed 's/^ //' << EOF >$dummy.c +- #include +- #ifdef __ELF__ +- # ifdef __GLIBC__ +- # if __GLIBC__ >= 2 +- LIBC=gnu +- # else +- LIBC=gnulibc1 +- # endif +- # else +- LIBC=gnulibc1 +- # endif +- #else +- #ifdef __INTEL_COMPILER +- LIBC=gnu +- #else +- LIBC=gnuaout +- #endif +- #endif +- #ifdef __dietlibc__ +- LIBC=dietlibc +- #endif +-EOF +- eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^LIBC=` +- test x"${LIBC}" != x && echo "${UNAME_MACHINE}-pc-linux-${LIBC}" && exit 0 +- test x"${TENTATIVE}" != x && echo "${TENTATIVE}" && exit 0 +- ;; ++ exit ;; ++ xtensa*:Linux:*:*) ++ echo ${UNAME_MACHINE}-unknown-linux-gnu ++ exit ;; + i*86:DYNIX/ptx:4*:*) + # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. + # earlier versions are messed up and put the nodename in both + # sysname and nodename. + echo i386-sequent-sysv4 +- exit 0 ;; ++ exit ;; + i*86:UNIX_SV:4.2MP:2.*) + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... +@@ -998,27 +990,27 @@ EOF + # I just have to hope. -- rms. + # Use sysv4.2uw... so that sysv4* matches it. + echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} +- exit 0 ;; ++ exit ;; + i*86:OS/2:*:*) + # If we were able to find `uname', then EMX Unix compatibility + # is probably installed. + echo ${UNAME_MACHINE}-pc-os2-emx +- exit 0 ;; ++ exit ;; + i*86:XTS-300:*:STOP) + echo ${UNAME_MACHINE}-unknown-stop +- exit 0 ;; ++ exit ;; + i*86:atheos:*:*) + echo ${UNAME_MACHINE}-unknown-atheos +- exit 0 ;; +- i*86:syllable:*:*) ++ exit ;; ++ i*86:syllable:*:*) + echo ${UNAME_MACHINE}-pc-syllable +- exit 0 ;; +- i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) ++ exit ;; ++ i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) + echo i386-unknown-lynxos${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + i*86:*DOS:*:*) + echo ${UNAME_MACHINE}-pc-msdosdjgpp +- exit 0 ;; ++ exit ;; + i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) + UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` + if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then +@@ -1026,15 +1018,16 @@ EOF + else + echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} + fi +- exit 0 ;; +- i*86:*:5:[78]*) ++ exit ;; ++ i*86:*:5:[678]*) ++ # UnixWare 7.x, OpenUNIX and OpenServer 6. + case `/bin/uname -X | grep "^Machine"` in + *486*) UNAME_MACHINE=i486 ;; + *Pentium) UNAME_MACHINE=i586 ;; + *Pent*|*Celeron) UNAME_MACHINE=i686 ;; + esac + echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} +- exit 0 ;; ++ exit ;; + i*86:*:3.2:*) + if test -f /usr/options/cb.name; then + UNAME_REL=`sed -n 's/.*Version //p' /dev/null 2>&1 ; then + echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 + else # Add other i860-SVR4 vendors below as they are discovered. + echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 + fi +- exit 0 ;; ++ exit ;; + mini*:CTIX:SYS*5:*) + # "miniframe" + echo m68010-convergent-sysv +- exit 0 ;; ++ exit ;; + mc68k:UNIX:SYSTEM5:3.51m) + echo m68k-convergent-sysv +- exit 0 ;; ++ exit ;; + M680?0:D-NIX:5.3:*) + echo m68k-diab-dnix +- exit 0 ;; ++ exit ;; + M68*:*:R3V[5678]*:*) +- test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;; ++ test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; + 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) + OS_REL='' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ +- && echo i486-ncr-sysv4.3${OS_REL} && exit 0 ++ && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ +- && echo i586-ncr-sysv4.3${OS_REL} && exit 0 ;; ++ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; + 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ +- && echo i486-ncr-sysv4 && exit 0 ;; ++ && { echo i486-ncr-sysv4; exit; } ;; ++ NCR*:*:4.2:* | MPRAS*:*:4.2:*) ++ OS_REL='.3' ++ test -r /etc/.relid \ ++ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` ++ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ ++ && { echo i486-ncr-sysv4.3${OS_REL}; exit; } ++ /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ ++ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ++ /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ ++ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; + m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) + echo m68k-unknown-lynxos${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + mc68030:UNIX_System_V:4.*:*) + echo m68k-atari-sysv4 +- exit 0 ;; ++ exit ;; + TSUNAMI:LynxOS:2.*:*) + echo sparc-unknown-lynxos${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + rs6000:LynxOS:2.*:*) + echo rs6000-unknown-lynxos${UNAME_RELEASE} +- exit 0 ;; +- PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) ++ exit ;; ++ PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) + echo powerpc-unknown-lynxos${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + SM[BE]S:UNIX_SV:*:*) + echo mips-dde-sysv${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + RM*:ReliantUNIX-*:*:*) + echo mips-sni-sysv4 +- exit 0 ;; ++ exit ;; + RM*:SINIX-*:*:*) + echo mips-sni-sysv4 +- exit 0 ;; ++ exit ;; + *:SINIX-*:*:*) + if uname -p 2>/dev/null >/dev/null ; then + UNAME_MACHINE=`(uname -p) 2>/dev/null` +@@ -1126,73 +1132,94 @@ EOF + else + echo ns32k-sni-sysv + fi +- exit 0 ;; ++ exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says + echo i586-unisys-sysv4 +- exit 0 ;; ++ exit ;; + *:UNIX_System_V:4*:FTX*) + # From Gerald Hewes . + # How about differentiating between stratus architectures? -djm + echo hppa1.1-stratus-sysv4 +- exit 0 ;; ++ exit ;; + *:*:*:FTX*) + # From seanf@swdc.stratus.com. + echo i860-stratus-sysv4 +- exit 0 ;; ++ exit ;; + i*86:VOS:*:*) + # From Paul.Green@stratus.com. + echo ${UNAME_MACHINE}-stratus-vos +- exit 0 ;; ++ exit ;; + *:VOS:*:*) + # From Paul.Green@stratus.com. + echo hppa1.1-stratus-vos +- exit 0 ;; ++ exit ;; + mc68*:A/UX:*:*) + echo m68k-apple-aux${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + news*:NEWS-OS:6*:*) + echo mips-sony-newsos6 +- exit 0 ;; ++ exit ;; + R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) + if [ -d /usr/nec ]; then + echo mips-nec-sysv${UNAME_RELEASE} + else + echo mips-unknown-sysv${UNAME_RELEASE} + fi +- exit 0 ;; ++ exit ;; + BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. + echo powerpc-be-beos +- exit 0 ;; ++ exit ;; + BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. + echo powerpc-apple-beos +- exit 0 ;; ++ exit ;; + BePC:BeOS:*:*) # BeOS running on Intel PC compatible. + echo i586-pc-beos +- exit 0 ;; ++ exit ;; ++ BePC:Haiku:*:*) # Haiku running on Intel PC compatible. ++ echo i586-pc-haiku ++ exit ;; + SX-4:SUPER-UX:*:*) + echo sx4-nec-superux${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + SX-5:SUPER-UX:*:*) + echo sx5-nec-superux${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + SX-6:SUPER-UX:*:*) + echo sx6-nec-superux${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; ++ SX-7:SUPER-UX:*:*) ++ echo sx7-nec-superux${UNAME_RELEASE} ++ exit ;; ++ SX-8:SUPER-UX:*:*) ++ echo sx8-nec-superux${UNAME_RELEASE} ++ exit ;; ++ SX-8R:SUPER-UX:*:*) ++ echo sx8r-nec-superux${UNAME_RELEASE} ++ exit ;; + Power*:Rhapsody:*:*) + echo powerpc-apple-rhapsody${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:Rhapsody:*:*) + echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:Darwin:*:*) + UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown + case $UNAME_PROCESSOR in +- *86) UNAME_PROCESSOR=i686 ;; ++ i386) ++ eval $set_cc_for_build ++ if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then ++ if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ ++ (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ ++ grep IS_64BIT_ARCH >/dev/null ++ then ++ UNAME_PROCESSOR="x86_64" ++ fi ++ fi ;; + unknown) UNAME_PROCESSOR=powerpc ;; + esac + echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:procnto*:*:* | *:QNX:[0123456789]*:*) + UNAME_PROCESSOR=`uname -p` + if test "$UNAME_PROCESSOR" = "x86"; then +@@ -1200,25 +1227,25 @@ EOF + UNAME_MACHINE=pc + fi + echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:QNX:*:4*) + echo i386-pc-qnx +- exit 0 ;; ++ exit ;; + NSE-?:NONSTOP_KERNEL:*:*) + echo nse-tandem-nsk${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + NSR-?:NONSTOP_KERNEL:*:*) + echo nsr-tandem-nsk${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:NonStop-UX:*:*) + echo mips-compaq-nonstopux +- exit 0 ;; ++ exit ;; + BS2000:POSIX*:*:*) + echo bs2000-siemens-sysv +- exit 0 ;; ++ exit ;; + DS/*:UNIX_System_V:*:*) + echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:Plan9:*:*) + # "uname -m" is not consistent, so use $cputype instead. 386 + # is converted to i386 for consistency with other x86 +@@ -1229,41 +1256,50 @@ EOF + UNAME_MACHINE="$cputype" + fi + echo ${UNAME_MACHINE}-unknown-plan9 +- exit 0 ;; ++ exit ;; + *:TOPS-10:*:*) + echo pdp10-unknown-tops10 +- exit 0 ;; ++ exit ;; + *:TENEX:*:*) + echo pdp10-unknown-tenex +- exit 0 ;; ++ exit ;; + KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) + echo pdp10-dec-tops20 +- exit 0 ;; ++ exit ;; + XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) + echo pdp10-xkl-tops20 +- exit 0 ;; ++ exit ;; + *:TOPS-20:*:*) + echo pdp10-unknown-tops20 +- exit 0 ;; ++ exit ;; + *:ITS:*:*) + echo pdp10-unknown-its +- exit 0 ;; ++ exit ;; + SEI:*:*:SEIUX) + echo mips-sei-seiux${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:DragonFly:*:*) + echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` +- exit 0 ;; ++ exit ;; + *:*VMS:*:*) + UNAME_MACHINE=`(uname -p) 2>/dev/null` + case "${UNAME_MACHINE}" in +- A*) echo alpha-dec-vms && exit 0 ;; +- I*) echo ia64-dec-vms && exit 0 ;; +- V*) echo vax-dec-vms && exit 0 ;; ++ A*) echo alpha-dec-vms ; exit ;; ++ I*) echo ia64-dec-vms ; exit ;; ++ V*) echo vax-dec-vms ; exit ;; + esac ;; + *:XENIX:*:SysV) + echo i386-pc-xenix +- exit 0 ;; ++ exit ;; ++ i*86:skyos:*:*) ++ echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' ++ exit ;; ++ i*86:rdos:*:*) ++ echo ${UNAME_MACHINE}-pc-rdos ++ exit ;; ++ i*86:AROS:*:*) ++ echo ${UNAME_MACHINE}-pc-aros ++ exit ;; + esac + + #echo '(No uname command or uname output not recognized.)' 1>&2 +@@ -1295,7 +1331,7 @@ main () + #endif + + #if defined (__arm) && defined (__acorn) && defined (__unix) +- printf ("arm-acorn-riscix"); exit (0); ++ printf ("arm-acorn-riscix\n"); exit (0); + #endif + + #if defined (hp300) && !defined (hpux) +@@ -1384,11 +1420,12 @@ main () + } + EOF + +-$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && $dummy && exit 0 ++$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && ++ { echo "$SYSTEM_NAME"; exit; } + + # Apollos put the system type in the environment. + +-test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; } ++test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } + + # Convex versions that predate uname can use getsysinfo(1) + +@@ -1397,22 +1434,22 @@ then + case `getsysinfo -f cpu_type` in + c1*) + echo c1-convex-bsd +- exit 0 ;; ++ exit ;; + c2*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi +- exit 0 ;; ++ exit ;; + c34*) + echo c34-convex-bsd +- exit 0 ;; ++ exit ;; + c38*) + echo c38-convex-bsd +- exit 0 ;; ++ exit ;; + c4*) + echo c4-convex-bsd +- exit 0 ;; ++ exit ;; + esac + fi + +@@ -1423,9 +1460,9 @@ This script, last modified $timestamp, h + the operating system you are using. It is advised that you + download the most up to date version of the config scripts from + +- http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess ++ http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD + and +- http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub ++ http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + + If the version you run ($0) is already up to date, please + send the following data and any information you think might be +--- gcl-2.6.7.orig/makefile ++++ gcl-2.6.7/makefile +@@ -34,21 +34,34 @@ TESTDIR = ansi-tests + + VERSION=`cat majvers`.`cat minvers` + +-all: $(BUILD_BFD) $(PORTDIR)/$(FLISP) command cmpnew/gcl_collectfn.o lsp/gcl_info.o do-gcl-tk do-info ++all: $(BUILD_BFD) system command cmpnew/gcl_collectfn.o lsp/gcl_info.o do-gcl-tk do-info ++ ++system: $(PORTDIR)/$(FLISP) ++# [ "$(X_LIBS)" == "" ] || (cd xgcl-2 && make saved_xgcl LISP=../$< && mv saved_xgcl ../$(PORTDIR)/$(FLISP)) ++ touch $@ + + xgcl: $(PORTDIR)/saved_xgcl + + $(PORTDIR)/saved_xgcl: $(PORTDIR)/saved_gcl + cd xgcl-2 && $(MAKE) + +-binutils/bfd/libbfd.a binutils/libiberty/libiberty.a: +- cd $(@D) && $(MAKE) ++#binutils/intl/libintl.a: ++# cd $(@D) && $(MAKE) ++ ++#binutils/bfd/libbfd.a binutils/libiberty/libiberty.a: binutils/intl/libintl.a ++# cd $(@D) && $(MAKE) ++ ++copy_iberty: $(LIBIBERTY) ++ mkdir -p binutils/libiberty && cd binutils/libiberty && ar x $< ++ ++copy_bfd: $(LIBBFD) copy_iberty ++ mkdir -p binutils/bfd && cd binutils/bfd && ar x $< + +-h/bfd.h: binutils/bfd/libbfd.a binutils/libiberty/libiberty.a +- cp $(/dev/null 2>&1 ; then if grep -i oncrpc makedefs >/dev/null 2>&1 ; then cp /mingw/bin/oncrpc.dll $(DESTDIR)$(INSTALL_LIB_DIR)/$(PORTDIR); fi ; fi + cd $(DESTDIR)$(INSTALL_LIB_DIR)/$(PORTDIR) && \ + mv $(FLISP)$(EXE) temp$(EXE) && \ +- echo '(reset-sys-paths "$(INSTALL_LIB_DIR)/")\ +- (si::save-system "$(FLISP)$(EXE)")' | ./temp$(EXE) && \ ++ echo '(reset-sys-paths "$(INSTALL_LIB_DIR)/")(si::save-system "$(FLISP)$(EXE)")' | ./temp$(EXE) && \ + rm -f temp$(EXE) + if [ -e "unixport/rsym$(EXE)" ] ; then cp unixport/rsym$(EXE) $(DESTDIR)$(INSTALL_LIB_DIR)/unixport/ ; fi + # ln $(SYMB) $(INSTALL_LIB_DIR)/$(PORTDIR)/$(FLISP)$(EXE) \ +@@ -190,6 +203,7 @@ install1: + # echo '(load "../tkl.o")(TK::GET-AUTOLOADS (directory "*.lisp"))' | ../../$(PORTDIR)/$(FLISP)$(EXE)) ; fi + if test "$(EMACS_SITE_LISP)" != "" ; then (cd elisp ; $(MAKE) install DESTDIR=$(DESTDIR)) ; fi + if test "$(INFO_DIR)" != "unknown"; then (cd info ; $(MAKE) ; $(MAKE) install DESTDIR=$(DESTDIR)) ; fi ++ if test "$(INFO_DIR)" != "unknown"; then (cd xgcl-2 ; $(MAKE) install DESTDIR=$(DESTDIR)) ; fi + if gcc --version | grep -i mingw >/dev/null 2>&1 ; then cp COPYING.LIB-2.0 readme-bin.mingw $(prefix) ; fi + if gcc --version | grep -i mingw >/dev/null 2>&1 ; then cp gcl.ico $(prefix)/bin ; fi + if gcc --version | grep -i mingw >/dev/null 2>&1 ; then rm -rf $(prefix)/install; mkdir $(prefix)/install ; cp windows/install.lsp $(prefix)/install ; windows/instdos.sh windows/sysdir.bat $(prefix)/bin/sysdir.bat ; fi +@@ -210,6 +224,8 @@ gclclean: + cd xgcl-2 && $(MAKE) clean + (cd $(TESTDIR); $(MAKE) clean) + (cd info ; $(MAKE) clean) ++# find binutils -name "*.o" -exec rm {} \; ++ rm -rf binutils + rm -f foo.tcl config.log makedefs makedefsafter config.cache config.status makedefc + rm -f h/config.h h/gclincl.h h/cmpinclude.h h/gmp.h + rm -f xbin/gcl foo foo.c bin/gclm.bat gmp_all +@@ -218,13 +234,15 @@ gclclean: + windows/install.lsp windows/sysdir.bat + rm -rf windows/Output + rm -f ansi-tests/test_results ansi-tests/gazonk*lsp +- rm -f config.log config.cache config.status tmpx $(PORTDIR)/gmon.out ++ rm -rf autom4te.cache ++ rm -f config.log config.cache config.status tmpx $(PORTDIR)/gmon.out machine system + + clean: gclclean +- -(cd $(GMPDIR) ; $(MAKE) distclean) +- rm -rf $(GMPDIR)/.deps $(GMPDIR)/libgmp.a +- -cd binutils/bfd && $(MAKE) distclean +- -cd binutils/libiberty && $(MAKE) distclean ++ -[ -z "$(GMPDIR)" ] || (cd $(GMPDIR) && $(MAKE) distclean) ++ -[ -z "$(GMPDIR)" ] || rm -rf $(GMPDIR)/.deps $(GMPDIR)/libgmp.a ++# -cd binutils/intl && $(MAKE) distclean ++# -cd binutils/bfd && $(MAKE) distclean ++# -cd binutils/libiberty && $(MAKE) distclean + + CMPINCLUDE_FILES=$(HDIR)cmpincl1.h $(HDIR)gclincl.h $(HDIR)compbas.h $(HDIR)enum.h $(HDIR)mgmp.h $(HDIR)object.h $(HDIR)vs.h \ + $(HDIR)bds.h $(HDIR)frame.h \ +@@ -240,7 +258,7 @@ $(HDIR)new_decl.h: + $(HDIR)cmpinclude.h: $(CMPINCLUDE_FILES) $(HDIR)config.h + cat $(HDIR)config.h | sed -e "1,/Begin for cmpincl/d" \ + -e "/End for cmpinclude/,50000d" > tmpx +- echo -e '#include "h/config.h"\n#ifdef SGC\n"#define SGC"\n#else\n"#undef SGC"\n#endif' | cpp 2>/dev/null| grep -v '^ *$$' | tail -1l | tr -d '"' >>tmpx ++ cd h && cpp tsgc.h 2>/dev/null| grep -v '^ *$$' | tail -1l | tr -d '"' >>../tmpx + cat $(CMPINCLUDE_FILES) >> tmpx + ./xbin/move-if-changed mv tmpx h/cmpinclude.h + ./xbin/move-if-changed cp h/cmpinclude.h o/cmpinclude.h +@@ -262,4 +280,4 @@ kcp: + (cd go ; $(MAKE) "CFLAGS = -I../h -pg -c -g ") + (cd unixport ; $(MAKE) gcp) + +-#.INTERMEDIATE: unixport/saved_pcl_gcl +\ No newline at end of file ++#.INTERMEDIATE: unixport/saved_pcl_gcl +--- gcl-2.6.7.orig/machines ++++ gcl-2.6.7/machines +@@ -6,12 +6,11 @@ names for various supported machines. + * alpha-osf1: Dec alpha DEC OSF/1 V3.2 Worksystem Software (Rev. 214) + * dec3100: Decstation 3100,5000, OS=Ultrix V3.1C-0 (Rev. 42) [akcl 505] + ULTRIX V4.2 (Rev. 96)[akcl 602] (VOL= ) +-* gnuwin95: Windows 95 or Windows NT, using gcc and cygwinb19.dll (NOT b20) + * hp300-bsd: Hp 350, 370 [motorola 68K] under 4.3 BSD (mt xinu) + * hp300: Hp 350, 370 under HPUX. + * hp800: Hp 720,730 under HPUX (version 8). Possibly hp 800 also + * mac2: Macintosh under AUX (unix) +-* mingw: Windows NT (Win9? untested) with Mingw32 gcc hosted by Cygwin ++* mingw: Windows built with MSYS hosted Mingw32 gcc + * mp386: intel 386 under System V 3 (eg microport,interactive) + * NeXT30-m68k: NeXT (M68K) under NeXTSTEP 3.0 + * NeXT32-m68k: NeXT (M68K) under NeXTSTEP 3.2, 3.3 (gcc-2.6.3 is required) +--- gcl-2.6.7.orig/clcs/makefile ++++ gcl-2.6.7/clcs/makefile +@@ -1,13 +1,13 @@ + -include ../makedefs + +-COMPILE_FILE=./saved_clcs_gcl ./ -system-p -c-file -data-file \ ++COMPILE_FILE=./saved_clcs_gcl$(EXE) ./ -system-p -c-file -data-file \ + -o-file nil -h-file -compile + + FILES:=$(shell ls -1 gcl_clcs_*.lisp | sed 's,\.lisp,,1') + + all: $(addsuffix .c,$(FILES)) $(addsuffix .o,$(FILES)) + +-saved_clcs_gcl: ../unixport/saved_pcl_gcl ++saved_clcs_gcl: ../unixport/saved_pcl_gcl$(EXE) + echo '(load "package.lisp")(load "myload.lisp")(si::save-system "$@")' | $< $(= k nc) j) ++ (write-char (code-char (logand i ff)) s)))) ++ ++(defun read-byte (s &optional (eof-error-p t) eof-value) ++ (declare (optimize (safety 1))) ++ (let ((nc (get-byte-stream-nchars s))) ++ (do ((j 0 (1+ j)) ++ (i 0 (logior i ++ (ash (char-code (let ((ch (read-char s eof-error-p eof-value))) ++ (if (and (not eof-error-p) (eq ch eof-value)) ++ (return-from read-byte ch) ++ ch))) (* j char-length))))) ++ ((>= j nc) i)))) ++ ++ ++(defun read-sequence (seq strm &key (start 0) end) ++ (declare (optimize (safety 1))) ++ (check-type seq sequence) ++ (check-type start (integer 0)) ++ (check-type end (or null (integer 0))) ++ (let* ((start (min start array-dimension-limit)) ++ (end (if end (min end array-dimension-limit) (length seq))) ++ (l (listp seq)) ++ (seq (if (and l (> start 0)) (nthcdr start seq) seq)) ++ (tp (subtypep (stream-element-type strm) 'character))) ++ (do ((i start (1+ i))(seq seq (if l (cdr seq) seq))) ++ ((or (>= i end) (when l (endp seq))) i) ++ (declare (fixnum i)) ++ (let ((el (if tp (read-char strm nil 'eof) (read-byte strm nil 'eof)))) ++ (when (eq el 'eof) (return i)) ++ (if l (setf (car seq) el) (setf (aref seq i) el)))))) ++ ++ ++(defun write-sequence (seq strm &key (start 0) end) ++ (declare (optimize (safety 1))) ++ (check-type seq sequence) ++ (check-type start (integer 0)) ++ (check-type end (or null (integer 0))) ++ (let* ((start (min start array-dimension-limit)) ++ (end (if end (min end array-dimension-limit) (length seq))) ++ (l (listp seq)) ++ (tp (subtypep (stream-element-type strm) 'character))) ++ (do ((i start (1+ i)) ++ (seq (if (and l (> start 0)) (nthcdr start seq) seq) (if l (cdr seq) seq))) ++ ((or (>= i end) (when l (endp seq)))) ++ (declare (fixnum i)) ++ (let ((el (if l (car seq) (aref seq i)))) ++ (if tp (write-char el strm) (write-byte el strm)))) ++ seq)) + +--- gcl-2.6.7.orig/lsp/gcl_listlib.lsp ++++ gcl-2.6.7/lsp/gcl_listlib.lsp +@@ -29,7 +29,7 @@ + + (export '(union nunion intersection nintersection + set-difference nset-difference set-exclusive-or nset-exclusive-or +- subsetp)) ++ subsetp nth nth-value nthcdr first second third fourth fifth sixth seventh eighth ninth tenth)) + + (in-package 'system) + +@@ -192,3 +192,67 @@ + (if (not (apply #'member1 (car l) list2 (key-list key test test-not))) (return nil)))) + + ++ ++ ++(defmacro tp-error (x y) ++ `(specific-error :wrong-type-argument "~S is not of type ~S." ,x ',y)) ++ ++(defun smallnthcdr (n x) ++ (declare (fixnum n)) ++ (cond ((atom x) (when x (tp-error x proper-list))) ++ ((= n 0) x) ++ ((smallnthcdr (1- n) (cdr x))))) ++ ++(defun bignthcdr (n i s f) ++ (declare (fixnum i)) ++ (cond ((atom f) (when f (tp-error f proper-list))) ++ ((atom (cdr f)) (when (cdr f) (tp-error (cdr f) proper-list))) ++ ((eq s f) (smallnthcdr (mod n i) s)) ++ ((bignthcdr n (1+ i) (cdr s) (cddr f))))) ++ ++(defun nthcdr (n x) ++ (declare (optimize (safety 1))) ++ (cond ((or (not (integerp n)) (minusp n)) (tp-error n (integer 0))) ++ ((< n array-dimension-limit) (smallnthcdr n x)) ++ ((atom x) (when x (tp-error x proper-list))) ++ ((atom (cdr x)) (when (cdr x) (tp-error (cdr x) proper-list))) ++ ((bignthcdr n 1 (cdr x) (cddr x))))) ++ ++(defun nth (n x) ++ (declare (optimize (safety 2))) ++ (car (nthcdr n x))) ++(defun first (x) ++ (declare (optimize (safety 2))) ++ (car x)) ++(defun second (x) ++ (declare (optimize (safety 2))) ++ (cadr x)) ++(defun third (x) ++ (declare (optimize (safety 2))) ++ (caddr x)) ++(defun fourth (x) ++ (declare (optimize (safety 2))) ++ (cadddr x)) ++(defun fifth (x) ++ (declare (optimize (safety 2))) ++ (car (cddddr x))) ++(defun sixth (x) ++ (declare (optimize (safety 2))) ++ (cadr (cddddr x))) ++(defun seventh (x) ++ (declare (optimize (safety 2))) ++ (caddr (cddddr x))) ++(defun eighth (x) ++ (declare (optimize (safety 2))) ++ (cadddr (cddddr x))) ++(defun ninth (x) ++ (declare (optimize (safety 2))) ++ (car (cddddr (cddddr x)))) ++(defun tenth (x) ++ (declare (optimize (safety 2))) ++ (cadr (cddddr (cddddr x)))) ++ ++; Courtesy Paul Dietz ++(defmacro nth-value (n expr) ++ (declare (optimize (safety 1))) ++ `(nth ,n (multiple-value-list ,expr))) +--- gcl-2.6.7.orig/lsp/gcl_japi.lsp ++++ gcl-2.6.7/lsp/gcl_japi.lsp +@@ -1,308 +1,308 @@ +-;;; Binding to the cross platform Japi GUI library from http://www.japi.de/ +- +-(eval-when (load eval) +- (make-package :japi-primitives :nicknames '(jpr) :use '(lisp))) +-(in-package :japi-primitives) +- +- +-(clines "#include ") +- +-;; BOOLEAN +-(defconstant J_TRUE 1) +-(defconstant J_FALSE 0) +- +-;; ALIGNMENT +-(defconstant J_LEFT 0) +-(defconstant J_CENTER 1) +-(defconstant J_RIGHT 2) +-(defconstant J_TOP 3) +-(defconstant J_BOTTOM 4) +-(defconstant J_TOPLEFT 5) +-(defconstant J_TOPRIGHT 6) +-(defconstant J_BOTTOMLEFT 7) +-(defconstant J_BOTTOMRIGHT 8) +- +-;; CURSOR +-(defconstant J_DEFAULT_CURSOR 0) +-(defconstant J_CROSSHAIR_CURSOR 1) +-(defconstant J_TEXT_CURSOR 2) +-(defconstant J_WAIT_CURSOR 3) +-(defconstant J_SW_RESIZE_CURSOR 4) +-(defconstant J_SE_RESIZE_CURSOR 5) +-(defconstant J_NW_RESIZE_CURSOR 6) +-(defconstant J_NE_RESIZE_CURSOR 7) +-(defconstant J_N_RESIZE_CURSOR 8) +-(defconstant J_S_RESIZE_CURSOR 9) +-(defconstant J_W_RESIZE_CURSOR 10) +-(defconstant J_E_RESIZE_CURSOR 11) +-(defconstant J_HAND_CURSOR 12) +-(defconstant J_MOVE_CURSOR 13) +- +-;; ORIENTATION +-(defconstant J_HORIZONTAL 0) +-(defconstant J_VERTICAL 1) +- +-;; FONTS +-(defconstant J_PLAIN 0) +-(defconstant J_BOLD 1) +-(defconstant J_ITALIC 2) +-(defconstant J_COURIER 1) +-(defconstant J_HELVETIA 2) +-(defconstant J_TIMES 3) +-(defconstant J_DIALOGIN 4) +-(defconstant J_DIALOGOUT 5) +- +-;; COLORS +-(defconstant J_BLACK 0) +-(defconstant J_WHITE 1) +-(defconstant J_RED 2) +-(defconstant J_GREEN 3) +-(defconstant J_BLUE 4) +-(defconstant J_CYAN 5) +-(defconstant J_MAGENTA 6) +-(defconstant J_YELLOW 7) +-(defconstant J_ORANGE 8) +-(defconstant J_GREEN_YELLOW 9) +-(defconstant J_GREEN_CYAN 10) +-(defconstant J_BLUE_CYAN 11) +-(defconstant J_BLUE_MAGENTA 12) +-(defconstant J_RED_MAGENTA 13) +-(defconstant J_DARK_GRAY 14) +-(defconstant J_LIGHT_GRAY 15) +-(defconstant J_GRAY 16) +- +-;; BORDERSTYLE +-(defconstant J_NONE 0) +-(defconstant J_LINEDOWN 1) +-(defconstant J_LINEUP 2) +-(defconstant J_AREADOWN 3) +-(defconstant J_AREAUP 4) +- +-;; MOUSELISTENER +-(defconstant J_MOVED 0) +-(defconstant J_DRAGGED 1) +-(defconstant J_PRESSED 2) +-(defconstant J_RELEASED 3) +-(defconstant J_ENTERERD 4) +-(defconstant J_EXITED 5) +-(defconstant J_DOUBLECLICK 6) +- +-;; J_MOVED +-(defconstant J_RESIZED 1) +-(defconstant J_HIDDEN 2) +-(defconstant J_SHOWN 3) +- +-;; WINDOWLISTENER +-(defconstant J_ACTIVATED 0) +-(defconstant J_DEACTIVATED 1) +-(defconstant J_OPENED 2) +-(defconstant J_CLOSED 3) +-(defconstant J_ICONIFIED 4) +-(defconstant J_DEICONIFIED 5) +-(defconstant J_CLOSING 6) +- +-;; IMAGEFILEFORMAT +-(defconstant J_GIF 0) +-(defconstant J_JPG 1) +-(defconstant J_PPM 2) +-(defconstant J_BMP 3) +- +-(defentry j_start () ( int "j_start" )) +-(defentry j_connect ( string ) ( int "j_connect" )) +-(defentry j_setdebug ( int ) ( void "j_setdebug" )) +-(defentry j_frame ( string ) ( int "j_frame" )) +-(defentry j_button ( int string ) ( int "j_button" )) +-(defentry j_graphicbutton ( int string ) ( int "j_graphicbutton" )) +-(defentry j_checkbox ( int string ) ( int "j_checkbox" )) +-(defentry j_label ( int string ) ( int "j_label" )) +-(defentry j_graphiclabel ( int string ) ( int "j_graphiclabel" )) +-(defentry j_canvas ( int int int ) ( int "j_canvas" )) +-(defentry j_panel ( int ) ( int "j_panel" )) +-(defentry j_borderpanel ( int int ) ( int "j_borderpanel" )) +-(defentry j_radiogroup ( int ) ( int "j_radiogroup" )) +-(defentry j_radiobutton ( int string ) ( int "j_radiobutton" )) +-(defentry j_list ( int int ) ( int "j_list" )) +-(defentry j_choice ( int ) ( int "j_choice" )) +-(defentry j_dialog ( int string ) ( int "j_dialog" )) +-(defentry j_window ( int ) ( int "j_window" )) +-(defentry j_popupmenu ( int string ) ( int "j_popupmenu" )) +-(defentry j_scrollpane ( int ) ( int "j_scrollpane" )) +-(defentry j_hscrollbar ( int ) ( int "j_hscrollbar" )) +-(defentry j_vscrollbar ( int ) ( int "j_vscrollbar" )) +-(defentry j_line ( int int int int ) ( int "j_line" )) +-(defentry j_printer ( int ) ( int "j_printer" )) +-(defentry j_image ( int int ) ( int "j_image" )) +-(defentry j_filedialog ( int string string string ) ( string "j_filedialog" )) +-(defentry j_fileselect ( int string string string ) ( string "j_fileselect" )) +-(defentry j_messagebox ( int string string ) ( int "j_messagebox" )) +-(defentry j_alertbox ( int string string string ) ( int "j_alertbox" )) +-(defentry j_choicebox2 ( int string string string string ) ( int "j_choicebox2" )) +-(defentry j_choicebox3 ( int string string string string string ) ( int "j_choicebox3" )) +-(defentry j_additem ( int string ) ( void "j_additem" )) +-(defentry j_textfield ( int int ) ( int "j_textfield" )) +-(defentry j_textarea ( int int int ) ( int "j_textarea" )) +-(defentry j_menubar ( int ) ( int "j_menubar" )) +-(defentry j_menu ( int string ) ( int "j_menu" )) +-(defentry j_helpmenu ( int string ) ( int "j_helpmenu" )) +-(defentry j_menuitem ( int string ) ( int "j_menuitem" )) +-(defentry j_checkmenuitem ( int string ) ( int "j_checkmenuitem" )) +-(defentry j_pack ( int ) ( void "j_pack" )) +-(defentry j_print ( int ) ( void "j_print" )) +-(defentry j_playsoundfile ( string ) ( void "j_playsoundfile" )) +-(defentry j_play ( int ) ( void "j_play" )) +-(defentry j_sound ( string ) ( int "j_sound" )) +-(defentry j_setfont ( int int int int ) ( void "j_setfont" )) +-(defentry j_setfontname ( int int ) ( void "j_setfontname" )) +-(defentry j_setfontsize ( int int ) ( void "j_setfontsize" )) +-(defentry j_setfontstyle ( int int ) ( void "j_setfontstyle" )) +-(defentry j_seperator ( int ) ( void "j_seperator" )) +-(defentry j_disable ( int ) ( void "j_disable" )) +-(defentry j_enable ( int ) ( void "j_enable" )) +-(defentry j_getstate ( int ) ( int "j_getstate" )) +-(defentry j_getrows ( int ) ( int "j_getrows" )) +-(defentry j_getcolumns ( int ) ( int "j_getcolumns" )) +-(defentry j_getselect ( int ) ( int "j_getselect" )) +-(defentry j_isselect ( int int ) ( int "j_isselect" )) +-(defentry j_isvisible ( int ) ( int "j_isvisible" )) +-(defentry j_isparent ( int int ) ( int "j_isparent" )) +-(defentry j_isresizable ( int ) ( int "j_isresizable" )) +-(defentry j_select ( int int ) ( void "j_select" )) +-(defentry j_deselect ( int int ) ( void "j_deselect" )) +-(defentry j_multiplemode ( int int ) ( void "j_multiplemode" )) +-(defentry j_insert ( int int string ) ( void "j_insert" )) +-(defentry j_remove ( int int ) ( void "j_remove" )) +-(defentry j_removeitem ( int string ) ( void "j_removeitem" )) +-(defentry j_removeall ( int ) ( void "j_removeall" )) +-(defentry j_setstate ( int int ) ( void "j_setstate" )) +-(defentry j_setrows ( int int ) ( void "j_setrows" )) +-(defentry j_setcolumns ( int int ) ( void "j_setcolumns" )) +-(defentry j_seticon ( int int ) ( void "j_seticon" )) +-(defentry j_setimage ( int int ) ( void "j_setimage" )) +-(defentry j_setvalue ( int int ) ( void "j_setvalue" )) +-(defentry j_setradiogroup ( int int ) ( void "j_setradiogroup" )) +-(defentry j_setunitinc ( int int ) ( void "j_setunitinc" )) +-(defentry j_setblockinc ( int int ) ( void "j_setblockinc" )) +-(defentry j_setmin ( int int ) ( void "j_setmin" )) +-(defentry j_setmax ( int int ) ( void "j_setmax" )) +-(defentry j_setslidesize ( int int ) ( void "j_setslidesize" )) +-(defentry j_setcursor ( int int ) ( void "j_setcursor" )) +-(defentry j_setresizable ( int int ) ( void "j_setresizable" )) +-(defentry j_getlength ( int ) ( int "j_getlength" )) +-(defentry j_getvalue ( int ) ( int "j_getvalue" )) +-(defentry j_getscreenheight () ( int "j_getscreenheight" )) +-(defentry j_getscreenwidth () ( int "j_getscreenwidth" )) +-(defentry j_getheight ( int ) ( int "j_getheight" )) +-(defentry j_getwidth ( int ) ( int "j_getwidth" )) +-(defentry j_getinsets ( int int ) ( int "j_getinsets" )) +-(defentry j_getlayoutid ( int ) ( int "j_getlayoutid" )) +-(defentry j_getinheight ( int ) ( int "j_getinheight" )) +-(defentry j_getinwidth ( int ) ( int "j_getinwidth" )) +-(defentry j_gettext ( int string ) ( string "j_gettext" )) +-(defentry j_getitem ( int int string ) ( string "j_getitem" )) +-(defentry j_getitemcount ( int ) ( int "j_getitemcount" )) +-(defentry j_delete ( int int int ) ( void "j_delete" )) +-(defentry j_replacetext ( int int int int ) ( void "j_replacetext" )) +-(defentry j_appendtext ( int int ) ( void "j_appendtext" )) +-(defentry j_inserttext ( int int int ) ( void "j_inserttext" )) +-(defentry j_settext ( int string ) ( void "j_settext" )) +-(defentry j_selectall ( int ) ( void "j_selectall" )) +-(defentry j_selecttext ( int int int ) ( void "j_selecttext" )) +-(defentry j_getselstart ( int ) ( int "j_getselstart" )) +-(defentry j_getselend ( int ) ( int "j_getselend" )) +-;(defentry j_getseltext ( int string ) ( string "j_getseltext" )) +-(defentry j_getseltext ( int int ) ( int "j_getseltext" )) +-(defentry j_getcurpos ( int ) ( int "j_getcurpos" )) +-(defentry j_setcurpos ( int int ) ( void "j_setcurpos" )) +-(defentry j_setechochar ( int char ) ( void "j_setechochar" )) +-(defentry j_seteditable ( int int ) ( void "j_seteditable" )) +-(defentry j_setshortcut ( int char ) ( void "j_setshortcut" )) +-(defentry j_quit () ( void "j_quit" )) +-(defentry j_kill () ( void "j_kill" )) +-(defentry j_setsize ( int int int ) ( void "j_setsize" )) +-(defentry j_getaction () ( int "j_getaction" )) +-(defentry j_nextaction () ( int "j_nextaction" )) +-(defentry j_show ( int ) ( void "j_show" )) +-(defentry j_showpopup ( int int int ) ( void "j_showpopup" )) +-(defentry j_add ( int int ) ( void "j_add" )) +-(defentry j_release ( int ) ( void "j_release" )) +-(defentry j_releaseall ( int ) ( void "j_releaseall" )) +-(defentry j_hide ( int ) ( void "j_hide" )) +-(defentry j_dispose ( int ) ( void "j_dispose" )) +-(defentry j_setpos ( int int int ) ( void "j_setpos" )) +-(defentry j_getviewportheight ( int ) ( int "j_getviewportheight" )) +-(defentry j_getviewportwidth ( int ) ( int "j_getviewportwidth" )) +-(defentry j_getxpos ( int ) ( int "j_getxpos" )) +-(defentry j_getypos ( int ) ( int "j_getypos" )) +-;(defentry j_getpos ( int int* int* ) ( void "j_getpos" )) +-(defentry j_getpos ( int int int ) ( void "j_getpos" )) +-(defentry j_getparentid ( int ) ( int "j_getparentid" )) +-(defentry j_setfocus ( int ) ( void "j_setfocus" )) +-(defentry j_hasfocus ( int ) ( int "j_hasfocus" )) +-(defentry j_getstringwidth ( int string ) ( int "j_getstringwidth" )) +-(defentry j_getfontheight ( int ) ( int "j_getfontheight" )) +-(defentry j_getfontascent ( int ) ( int "j_getfontascent" )) +-(defentry j_keylistener ( int ) ( int "j_keylistener" )) +-(defentry j_getkeycode ( int ) ( int "j_getkeycode" )) +-(defentry j_getkeychar ( int ) ( int "j_getkeychar" )) +-(defentry j_mouselistener ( int int ) ( int "j_mouselistener" )) +-(defentry j_getmousex ( int ) ( int "j_getmousex" )) +-(defentry j_getmousey ( int ) ( int "j_getmousey" )) +-;(defentry j_getmousepos ( int int* int* ) ( void "j_getmousepos" )) +-(defentry j_getmousepos ( int int int ) ( void "j_getmousepos" )) +-(defentry j_getmousebutton ( int ) ( int "j_getmousebutton" )) +-(defentry j_focuslistener ( int ) ( int "j_focuslistener" )) +-(defentry j_componentlistener ( int int ) ( int "j_componentlistener" )) +-(defentry j_windowlistener ( int int ) ( int "j_windowlistener" )) +-(defentry j_setflowlayout ( int int ) ( void "j_setflowlayout" )) +-(defentry j_setborderlayout ( int ) ( void "j_setborderlayout" )) +-(defentry j_setgridlayout ( int int int ) ( void "j_setgridlayout" )) +-(defentry j_setfixlayout ( int ) ( void "j_setfixlayout" )) +-(defentry j_setnolayout ( int ) ( void "j_setnolayout" )) +-(defentry j_setborderpos ( int int ) ( void "j_setborderpos" )) +-(defentry j_sethgap ( int int ) ( void "j_sethgap" )) +-(defentry j_setvgap ( int int ) ( void "j_setvgap" )) +-(defentry j_setinsets ( int int int int int ) ( void "j_setinsets" )) +-(defentry j_setalign ( int int ) ( void "j_setalign" )) +-(defentry j_setflowfill ( int int ) ( void "j_setflowfill" )) +-(defentry j_translate ( int int int ) ( void "j_translate" )) +-(defentry j_cliprect ( int int int int int ) ( void "j_cliprect" )) +-(defentry j_drawrect ( int int int int int ) ( void "j_drawrect" )) +-(defentry j_fillrect ( int int int int int ) ( void "j_fillrect" )) +-(defentry j_drawroundrect ( int int int int int int int ) ( void "j_drawroundrect" )) +-(defentry j_fillroundrect ( int int int int int int int ) ( void "j_fillroundrect" )) +-(defentry j_drawoval ( int int int int int ) ( void "j_drawoval" )) +-(defentry j_filloval ( int int int int int ) ( void "j_filloval" )) +-(defentry j_drawcircle ( int int int int ) ( void "j_drawcircle" )) +-(defentry j_fillcircle ( int int int int ) ( void "j_fillcircle" )) +-(defentry j_drawarc ( int int int int int int int ) ( void "j_drawarc" )) +-(defentry j_fillarc ( int int int int int int int ) ( void "j_fillarc" )) +-(defentry j_drawline ( int int int int int ) ( void "j_drawline" )) +-;(defentry j_drawpolyline ( int int int* int* ) ( void "j_drawpolyline" )) +-;(defentry j_drawpolygon ( int int int* int* ) ( void "j_drawpolygon" )) +-;(defentry j_fillpolygon ( int int int* int* ) ( void "j_fillpolygon" )) +-(defentry j_drawpolyline ( int int int int ) ( void "j_drawpolyline" )) +-(defentry j_drawpolygon ( int int int int ) ( void "j_drawpolygon" )) +-(defentry j_fillpolygon ( int int int int ) ( void "j_fillpolygon" )) +-(defentry j_drawpixel ( int int int ) ( void "j_drawpixel" )) +-(defentry j_drawstring ( int int int string ) ( void "j_drawstring" )) +-(defentry j_setxor ( int int ) ( void "j_setxor" )) +-(defentry j_getimage ( int ) ( int "j_getimage" )) +-;(defentry j_getimagesource ( int int int int int int* int* int* ) ( void "j_getimagesource" )) +-;(defentry j_drawimagesource ( int int int int int int* int* int* ) ( void "j_drawimagesource" )) +-(defentry j_getimagesource ( int int int int int int int int ) ( void "j_getimagesource" )) +-(defentry j_drawimagesource ( int int int int int int int int ) ( void "j_drawimagesource" )) +-(defentry j_getscaledimage ( int int int int int int int ) ( int "j_getscaledimage" )) +-(defentry j_drawimage ( int int int int ) ( void "j_drawimage" )) +-(defentry j_drawscaledimage ( int int int int int int int int int int ) ( void "j_drawscaledimage" )) +-(defentry j_setcolor ( int int int int ) ( void "j_setcolor" )) +-(defentry j_setcolorbg ( int int int int ) ( void "j_setcolorbg" )) +-(defentry j_setnamedcolor ( int int ) ( void "j_setnamedcolor" )) +-(defentry j_setnamedcolorbg ( int int ) ( void "j_setnamedcolorbg" )) +-(defentry j_loadimage ( string ) ( int "j_loadimage" )) +-(defentry j_saveimage ( int string int ) ( int "j_saveimage" )) +-(defentry j_sync () ( void "j_sync" )) +-(defentry j_beep () ( void "j_beep" )) +-(defentry j_random () ( int "j_random" )) +-(defentry j_sleep ( int ) ( void "j_sleep" )) +- +- ++;;; Binding to the cross platform Japi GUI library from http://www.japi.de/ ++ ++(eval-when (load eval) ++ (make-package :japi-primitives :nicknames '(jpr) :use '(lisp))) ++(in-package :japi-primitives) ++ ++ ++(clines "#include ") ++ ++;; BOOLEAN ++(defconstant J_TRUE 1) ++(defconstant J_FALSE 0) ++ ++;; ALIGNMENT ++(defconstant J_LEFT 0) ++(defconstant J_CENTER 1) ++(defconstant J_RIGHT 2) ++(defconstant J_TOP 3) ++(defconstant J_BOTTOM 4) ++(defconstant J_TOPLEFT 5) ++(defconstant J_TOPRIGHT 6) ++(defconstant J_BOTTOMLEFT 7) ++(defconstant J_BOTTOMRIGHT 8) ++ ++;; CURSOR ++(defconstant J_DEFAULT_CURSOR 0) ++(defconstant J_CROSSHAIR_CURSOR 1) ++(defconstant J_TEXT_CURSOR 2) ++(defconstant J_WAIT_CURSOR 3) ++(defconstant J_SW_RESIZE_CURSOR 4) ++(defconstant J_SE_RESIZE_CURSOR 5) ++(defconstant J_NW_RESIZE_CURSOR 6) ++(defconstant J_NE_RESIZE_CURSOR 7) ++(defconstant J_N_RESIZE_CURSOR 8) ++(defconstant J_S_RESIZE_CURSOR 9) ++(defconstant J_W_RESIZE_CURSOR 10) ++(defconstant J_E_RESIZE_CURSOR 11) ++(defconstant J_HAND_CURSOR 12) ++(defconstant J_MOVE_CURSOR 13) ++ ++;; ORIENTATION ++(defconstant J_HORIZONTAL 0) ++(defconstant J_VERTICAL 1) ++ ++;; FONTS ++(defconstant J_PLAIN 0) ++(defconstant J_BOLD 1) ++(defconstant J_ITALIC 2) ++(defconstant J_COURIER 1) ++(defconstant J_HELVETIA 2) ++(defconstant J_TIMES 3) ++(defconstant J_DIALOGIN 4) ++(defconstant J_DIALOGOUT 5) ++ ++;; COLORS ++(defconstant J_BLACK 0) ++(defconstant J_WHITE 1) ++(defconstant J_RED 2) ++(defconstant J_GREEN 3) ++(defconstant J_BLUE 4) ++(defconstant J_CYAN 5) ++(defconstant J_MAGENTA 6) ++(defconstant J_YELLOW 7) ++(defconstant J_ORANGE 8) ++(defconstant J_GREEN_YELLOW 9) ++(defconstant J_GREEN_CYAN 10) ++(defconstant J_BLUE_CYAN 11) ++(defconstant J_BLUE_MAGENTA 12) ++(defconstant J_RED_MAGENTA 13) ++(defconstant J_DARK_GRAY 14) ++(defconstant J_LIGHT_GRAY 15) ++(defconstant J_GRAY 16) ++ ++;; BORDERSTYLE ++(defconstant J_NONE 0) ++(defconstant J_LINEDOWN 1) ++(defconstant J_LINEUP 2) ++(defconstant J_AREADOWN 3) ++(defconstant J_AREAUP 4) ++ ++;; MOUSELISTENER ++(defconstant J_MOVED 0) ++(defconstant J_DRAGGED 1) ++(defconstant J_PRESSED 2) ++(defconstant J_RELEASED 3) ++(defconstant J_ENTERERD 4) ++(defconstant J_EXITED 5) ++(defconstant J_DOUBLECLICK 6) ++ ++;; J_MOVED ++(defconstant J_RESIZED 1) ++(defconstant J_HIDDEN 2) ++(defconstant J_SHOWN 3) ++ ++;; WINDOWLISTENER ++(defconstant J_ACTIVATED 0) ++(defconstant J_DEACTIVATED 1) ++(defconstant J_OPENED 2) ++(defconstant J_CLOSED 3) ++(defconstant J_ICONIFIED 4) ++(defconstant J_DEICONIFIED 5) ++(defconstant J_CLOSING 6) ++ ++;; IMAGEFILEFORMAT ++(defconstant J_GIF 0) ++(defconstant J_JPG 1) ++(defconstant J_PPM 2) ++(defconstant J_BMP 3) ++ ++(defentry j_start () ( int "j_start" )) ++(defentry j_connect ( string ) ( int "j_connect" )) ++(defentry j_setdebug ( int ) ( void "j_setdebug" )) ++(defentry j_frame ( string ) ( int "j_frame" )) ++(defentry j_button ( int string ) ( int "j_button" )) ++(defentry j_graphicbutton ( int string ) ( int "j_graphicbutton" )) ++(defentry j_checkbox ( int string ) ( int "j_checkbox" )) ++(defentry j_label ( int string ) ( int "j_label" )) ++(defentry j_graphiclabel ( int string ) ( int "j_graphiclabel" )) ++(defentry j_canvas ( int int int ) ( int "j_canvas" )) ++(defentry j_panel ( int ) ( int "j_panel" )) ++(defentry j_borderpanel ( int int ) ( int "j_borderpanel" )) ++(defentry j_radiogroup ( int ) ( int "j_radiogroup" )) ++(defentry j_radiobutton ( int string ) ( int "j_radiobutton" )) ++(defentry j_list ( int int ) ( int "j_list" )) ++(defentry j_choice ( int ) ( int "j_choice" )) ++(defentry j_dialog ( int string ) ( int "j_dialog" )) ++(defentry j_window ( int ) ( int "j_window" )) ++(defentry j_popupmenu ( int string ) ( int "j_popupmenu" )) ++(defentry j_scrollpane ( int ) ( int "j_scrollpane" )) ++(defentry j_hscrollbar ( int ) ( int "j_hscrollbar" )) ++(defentry j_vscrollbar ( int ) ( int "j_vscrollbar" )) ++(defentry j_line ( int int int int ) ( int "j_line" )) ++(defentry j_printer ( int ) ( int "j_printer" )) ++(defentry j_image ( int int ) ( int "j_image" )) ++(defentry j_filedialog ( int string string string ) ( string "j_filedialog" )) ++(defentry j_fileselect ( int string string string ) ( string "j_fileselect" )) ++(defentry j_messagebox ( int string string ) ( int "j_messagebox" )) ++(defentry j_alertbox ( int string string string ) ( int "j_alertbox" )) ++(defentry j_choicebox2 ( int string string string string ) ( int "j_choicebox2" )) ++(defentry j_choicebox3 ( int string string string string string ) ( int "j_choicebox3" )) ++(defentry j_additem ( int string ) ( void "j_additem" )) ++(defentry j_textfield ( int int ) ( int "j_textfield" )) ++(defentry j_textarea ( int int int ) ( int "j_textarea" )) ++(defentry j_menubar ( int ) ( int "j_menubar" )) ++(defentry j_menu ( int string ) ( int "j_menu" )) ++(defentry j_helpmenu ( int string ) ( int "j_helpmenu" )) ++(defentry j_menuitem ( int string ) ( int "j_menuitem" )) ++(defentry j_checkmenuitem ( int string ) ( int "j_checkmenuitem" )) ++(defentry j_pack ( int ) ( void "j_pack" )) ++(defentry j_print ( int ) ( void "j_print" )) ++(defentry j_playsoundfile ( string ) ( void "j_playsoundfile" )) ++(defentry j_play ( int ) ( void "j_play" )) ++(defentry j_sound ( string ) ( int "j_sound" )) ++(defentry j_setfont ( int int int int ) ( void "j_setfont" )) ++(defentry j_setfontname ( int int ) ( void "j_setfontname" )) ++(defentry j_setfontsize ( int int ) ( void "j_setfontsize" )) ++(defentry j_setfontstyle ( int int ) ( void "j_setfontstyle" )) ++(defentry j_seperator ( int ) ( void "j_seperator" )) ++(defentry j_disable ( int ) ( void "j_disable" )) ++(defentry j_enable ( int ) ( void "j_enable" )) ++(defentry j_getstate ( int ) ( int "j_getstate" )) ++(defentry j_getrows ( int ) ( int "j_getrows" )) ++(defentry j_getcolumns ( int ) ( int "j_getcolumns" )) ++(defentry j_getselect ( int ) ( int "j_getselect" )) ++(defentry j_isselect ( int int ) ( int "j_isselect" )) ++(defentry j_isvisible ( int ) ( int "j_isvisible" )) ++(defentry j_isparent ( int int ) ( int "j_isparent" )) ++(defentry j_isresizable ( int ) ( int "j_isresizable" )) ++(defentry j_select ( int int ) ( void "j_select" )) ++(defentry j_deselect ( int int ) ( void "j_deselect" )) ++(defentry j_multiplemode ( int int ) ( void "j_multiplemode" )) ++(defentry j_insert ( int int string ) ( void "j_insert" )) ++(defentry j_remove ( int int ) ( void "j_remove" )) ++(defentry j_removeitem ( int string ) ( void "j_removeitem" )) ++(defentry j_removeall ( int ) ( void "j_removeall" )) ++(defentry j_setstate ( int int ) ( void "j_setstate" )) ++(defentry j_setrows ( int int ) ( void "j_setrows" )) ++(defentry j_setcolumns ( int int ) ( void "j_setcolumns" )) ++(defentry j_seticon ( int int ) ( void "j_seticon" )) ++(defentry j_setimage ( int int ) ( void "j_setimage" )) ++(defentry j_setvalue ( int int ) ( void "j_setvalue" )) ++(defentry j_setradiogroup ( int int ) ( void "j_setradiogroup" )) ++(defentry j_setunitinc ( int int ) ( void "j_setunitinc" )) ++(defentry j_setblockinc ( int int ) ( void "j_setblockinc" )) ++(defentry j_setmin ( int int ) ( void "j_setmin" )) ++(defentry j_setmax ( int int ) ( void "j_setmax" )) ++(defentry j_setslidesize ( int int ) ( void "j_setslidesize" )) ++(defentry j_setcursor ( int int ) ( void "j_setcursor" )) ++(defentry j_setresizable ( int int ) ( void "j_setresizable" )) ++(defentry j_getlength ( int ) ( int "j_getlength" )) ++(defentry j_getvalue ( int ) ( int "j_getvalue" )) ++(defentry j_getscreenheight () ( int "j_getscreenheight" )) ++(defentry j_getscreenwidth () ( int "j_getscreenwidth" )) ++(defentry j_getheight ( int ) ( int "j_getheight" )) ++(defentry j_getwidth ( int ) ( int "j_getwidth" )) ++(defentry j_getinsets ( int int ) ( int "j_getinsets" )) ++(defentry j_getlayoutid ( int ) ( int "j_getlayoutid" )) ++(defentry j_getinheight ( int ) ( int "j_getinheight" )) ++(defentry j_getinwidth ( int ) ( int "j_getinwidth" )) ++(defentry j_gettext ( int string ) ( string "j_gettext" )) ++(defentry j_getitem ( int int string ) ( string "j_getitem" )) ++(defentry j_getitemcount ( int ) ( int "j_getitemcount" )) ++(defentry j_delete ( int int int ) ( void "j_delete" )) ++(defentry j_replacetext ( int int int int ) ( void "j_replacetext" )) ++(defentry j_appendtext ( int int ) ( void "j_appendtext" )) ++(defentry j_inserttext ( int int int ) ( void "j_inserttext" )) ++(defentry j_settext ( int string ) ( void "j_settext" )) ++(defentry j_selectall ( int ) ( void "j_selectall" )) ++(defentry j_selecttext ( int int int ) ( void "j_selecttext" )) ++(defentry j_getselstart ( int ) ( int "j_getselstart" )) ++(defentry j_getselend ( int ) ( int "j_getselend" )) ++;(defentry j_getseltext ( int string ) ( string "j_getseltext" )) ++(defentry j_getseltext ( int int ) ( int "j_getseltext" )) ++(defentry j_getcurpos ( int ) ( int "j_getcurpos" )) ++(defentry j_setcurpos ( int int ) ( void "j_setcurpos" )) ++(defentry j_setechochar ( int char ) ( void "j_setechochar" )) ++(defentry j_seteditable ( int int ) ( void "j_seteditable" )) ++(defentry j_setshortcut ( int char ) ( void "j_setshortcut" )) ++(defentry j_quit () ( void "j_quit" )) ++(defentry j_kill () ( void "j_kill" )) ++(defentry j_setsize ( int int int ) ( void "j_setsize" )) ++(defentry j_getaction () ( int "j_getaction" )) ++(defentry j_nextaction () ( int "j_nextaction" )) ++(defentry j_show ( int ) ( void "j_show" )) ++(defentry j_showpopup ( int int int ) ( void "j_showpopup" )) ++(defentry j_add ( int int ) ( void "j_add" )) ++(defentry j_release ( int ) ( void "j_release" )) ++(defentry j_releaseall ( int ) ( void "j_releaseall" )) ++(defentry j_hide ( int ) ( void "j_hide" )) ++(defentry j_dispose ( int ) ( void "j_dispose" )) ++(defentry j_setpos ( int int int ) ( void "j_setpos" )) ++(defentry j_getviewportheight ( int ) ( int "j_getviewportheight" )) ++(defentry j_getviewportwidth ( int ) ( int "j_getviewportwidth" )) ++(defentry j_getxpos ( int ) ( int "j_getxpos" )) ++(defentry j_getypos ( int ) ( int "j_getypos" )) ++;(defentry j_getpos ( int int* int* ) ( void "j_getpos" )) ++(defentry j_getpos ( int int int ) ( void "j_getpos" )) ++(defentry j_getparentid ( int ) ( int "j_getparentid" )) ++(defentry j_setfocus ( int ) ( void "j_setfocus" )) ++(defentry j_hasfocus ( int ) ( int "j_hasfocus" )) ++(defentry j_getstringwidth ( int string ) ( int "j_getstringwidth" )) ++(defentry j_getfontheight ( int ) ( int "j_getfontheight" )) ++(defentry j_getfontascent ( int ) ( int "j_getfontascent" )) ++(defentry j_keylistener ( int ) ( int "j_keylistener" )) ++(defentry j_getkeycode ( int ) ( int "j_getkeycode" )) ++(defentry j_getkeychar ( int ) ( int "j_getkeychar" )) ++(defentry j_mouselistener ( int int ) ( int "j_mouselistener" )) ++(defentry j_getmousex ( int ) ( int "j_getmousex" )) ++(defentry j_getmousey ( int ) ( int "j_getmousey" )) ++;(defentry j_getmousepos ( int int* int* ) ( void "j_getmousepos" )) ++(defentry j_getmousepos ( int int int ) ( void "j_getmousepos" )) ++(defentry j_getmousebutton ( int ) ( int "j_getmousebutton" )) ++(defentry j_focuslistener ( int ) ( int "j_focuslistener" )) ++(defentry j_componentlistener ( int int ) ( int "j_componentlistener" )) ++(defentry j_windowlistener ( int int ) ( int "j_windowlistener" )) ++(defentry j_setflowlayout ( int int ) ( void "j_setflowlayout" )) ++(defentry j_setborderlayout ( int ) ( void "j_setborderlayout" )) ++(defentry j_setgridlayout ( int int int ) ( void "j_setgridlayout" )) ++(defentry j_setfixlayout ( int ) ( void "j_setfixlayout" )) ++(defentry j_setnolayout ( int ) ( void "j_setnolayout" )) ++(defentry j_setborderpos ( int int ) ( void "j_setborderpos" )) ++(defentry j_sethgap ( int int ) ( void "j_sethgap" )) ++(defentry j_setvgap ( int int ) ( void "j_setvgap" )) ++(defentry j_setinsets ( int int int int int ) ( void "j_setinsets" )) ++(defentry j_setalign ( int int ) ( void "j_setalign" )) ++(defentry j_setflowfill ( int int ) ( void "j_setflowfill" )) ++(defentry j_translate ( int int int ) ( void "j_translate" )) ++(defentry j_cliprect ( int int int int int ) ( void "j_cliprect" )) ++(defentry j_drawrect ( int int int int int ) ( void "j_drawrect" )) ++(defentry j_fillrect ( int int int int int ) ( void "j_fillrect" )) ++(defentry j_drawroundrect ( int int int int int int int ) ( void "j_drawroundrect" )) ++(defentry j_fillroundrect ( int int int int int int int ) ( void "j_fillroundrect" )) ++(defentry j_drawoval ( int int int int int ) ( void "j_drawoval" )) ++(defentry j_filloval ( int int int int int ) ( void "j_filloval" )) ++(defentry j_drawcircle ( int int int int ) ( void "j_drawcircle" )) ++(defentry j_fillcircle ( int int int int ) ( void "j_fillcircle" )) ++(defentry j_drawarc ( int int int int int int int ) ( void "j_drawarc" )) ++(defentry j_fillarc ( int int int int int int int ) ( void "j_fillarc" )) ++(defentry j_drawline ( int int int int int ) ( void "j_drawline" )) ++;(defentry j_drawpolyline ( int int int* int* ) ( void "j_drawpolyline" )) ++;(defentry j_drawpolygon ( int int int* int* ) ( void "j_drawpolygon" )) ++;(defentry j_fillpolygon ( int int int* int* ) ( void "j_fillpolygon" )) ++(defentry j_drawpolyline ( int int int int ) ( void "j_drawpolyline" )) ++(defentry j_drawpolygon ( int int int int ) ( void "j_drawpolygon" )) ++(defentry j_fillpolygon ( int int int int ) ( void "j_fillpolygon" )) ++(defentry j_drawpixel ( int int int ) ( void "j_drawpixel" )) ++(defentry j_drawstring ( int int int string ) ( void "j_drawstring" )) ++(defentry j_setxor ( int int ) ( void "j_setxor" )) ++(defentry j_getimage ( int ) ( int "j_getimage" )) ++;(defentry j_getimagesource ( int int int int int int* int* int* ) ( void "j_getimagesource" )) ++;(defentry j_drawimagesource ( int int int int int int* int* int* ) ( void "j_drawimagesource" )) ++(defentry j_getimagesource ( int int int int int int int int ) ( void "j_getimagesource" )) ++(defentry j_drawimagesource ( int int int int int int int int ) ( void "j_drawimagesource" )) ++(defentry j_getscaledimage ( int int int int int int int ) ( int "j_getscaledimage" )) ++(defentry j_drawimage ( int int int int ) ( void "j_drawimage" )) ++(defentry j_drawscaledimage ( int int int int int int int int int int ) ( void "j_drawscaledimage" )) ++(defentry j_setcolor ( int int int int ) ( void "j_setcolor" )) ++(defentry j_setcolorbg ( int int int int ) ( void "j_setcolorbg" )) ++(defentry j_setnamedcolor ( int int ) ( void "j_setnamedcolor" )) ++(defentry j_setnamedcolorbg ( int int ) ( void "j_setnamedcolorbg" )) ++(defentry j_loadimage ( string ) ( int "j_loadimage" )) ++(defentry j_saveimage ( int string int ) ( int "j_saveimage" )) ++(defentry j_sync () ( void "j_sync" )) ++(defentry j_beep () ( void "j_beep" )) ++(defentry j_random () ( int "j_random" )) ++(defentry j_sleep ( int ) ( void "j_sleep" )) ++ ++ +--- gcl-2.6.7.orig/lsp/gcl_mislib.lsp ++++ gcl-2.6.7/lsp/gcl_mislib.lsp +@@ -24,7 +24,6 @@ + + + (export 'time) +-(export 'nth-value) + (export '(reset-sys-paths decode-universal-time encode-universal-time compile-file-pathname complement constantly)) + + +@@ -112,9 +111,6 @@ + seconds-per-day) + (* h 3600) (* min 60) sec)) + +-; Courtesy Paul Dietz +-(defmacro nth-value (n expr) +- `(nth ,n (multiple-value-list ,expr))) + (defun compile-file-pathname (pathname) + (make-pathname :defaults pathname :type "o")) + (defun constantly (x) +@@ -126,7 +122,7 @@ x)) + + (defun default-system-banner () + (let (gpled-modules) +- (dolist (l '(:unexec :bfd :readline)) ++ (dolist (l '(:unexec :bfd :readline :xgcl)) + (when (member l *features*) + (push l gpled-modules))) + (format nil "GCL (GNU Common Lisp) ~a.~a.~a ~a ~a ~a~%~a~%~a ~a~%~a~%~a~%~%~a~%" +@@ -134,7 +130,7 @@ x)) + (if (member :ansi-cl *features*) "ANSI" "CLtL1") + (if (member :gprof *features*) "profiling" "") + (si::gcl-compile-time) +- "Source License: LGPL(gcl,gmp), GPL(unexec,bfd)" ++ "Source License: LGPL(gcl,gmp), GPL(unexec,bfd,xgcl)" + "Binary License: " + (if gpled-modules (format nil "GPL due to GPL'ed components: ~a" gpled-modules) + "LGPL") +@@ -161,7 +157,7 @@ x)) + (setq si::*lib-directory* s) + (setq si::*system-directory* (si::string-concatenate s "unixport/")) + (let (nl) +- (dolist (l '("cmpnew/" "gcl-tk/" "lsp/")) ++ (dolist (l '("cmpnew/" "gcl-tk/" "lsp/" "xgcl-2/")) + (push (si::string-concatenate s l) nl)) + (setq si::*load-path* nl)) + nil) +--- gcl-2.6.7.orig/lsp/gcl_loop.lsp ++++ gcl-2.6.7/lsp/gcl_loop.lsp +@@ -49,7 +49,7 @@ + + #+cmu + (ext:file-comment +- "$Header: /cvsroot/gcl/gcl/lsp/Attic/gcl_loop.lsp,v 1.1.2.2 2003/09/24 15:49:43 camm Exp $") ++ "$Header: /sources/gcl/gcl/lsp/Attic/gcl_loop.lsp,v 1.1.2.2 2003/09/24 15:49:43 camm Exp $") + + ;;;; LOOP Iteration Macro + +--- gcl-2.6.7.orig/lsp/gcl_top.lsp ++++ gcl-2.6.7/lsp/gcl_top.lsp +@@ -88,8 +88,7 @@ + (let ((+ nil) (++ nil) (+++ nil) + (- nil) + (* nil) (** nil) (*** nil) +- (/ nil) (// nil) (/// nil) +- ) ++ (/ nil) (// nil) (/// nil)) + (setq *lisp-initialized* t) + (catch *quit-tag* + (progn +@@ -722,35 +721,63 @@ First directory is checked for first nam + + (defun set-dir (sym flag) + (let ((tem (or (si::get-command-arg flag) (and (boundp sym) (symbol-value sym))))) +- (if tem (set sym (si::coerce-slash-terminated tem))))) ++ (if tem (set sym (coerce-slash-terminated tem))))) ++ ++(defvar *tmp-dir*) ++ ++(defun wine-tmp-redirect () ++ (let* ((s (find-symbol "*WINE-DETECTED*" (find-package "SYSTEM")))) ++ (when (and s (symbol-value s)) ++ (list *system-directory*)))) ++ ++(defun get-temp-dir () ++ (dolist (x `(,@(wine-tmp-redirect) ++ ,@(mapcar 'getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) ++ (when x ++ (let* ((x (pathname x)) ++ (x (if (pathname-name x) x ++ (merge-pathnames ++ (make-pathname :directory (butlast (pathname-directory x)) ++ :name (car (last (pathname-directory x)))) ++ x)))) ++ (when (stat x) ++ (return-from ++ get-temp-dir ++ (namestring ++ (make-pathname ++ :device (pathname-device x) ++ :directory (when (or (pathname-directory x) (pathname-name x)) ++ (append (pathname-directory x) (list (pathname-name x)))))))))))) ++ + +-(defun set-up-top-level ( &aux (i (si::argc)) tem) ++(defun set-up-top-level ( &aux (i (argc)) tem) + (declare (fixnum i)) + (loop (setq i (- i 1)) + (cond ((< i 0)(return nil)) + (t (setq tem (cons (argv i) tem))))) + (setq *command-args* tem) ++ (setq *tmp-dir* (get-temp-dir)) + (setq tem *lib-directory*) +- (let ((dir (si::getenv "GCL_LIBDIR"))) +- (or (set-dir 'si::*lib-directory* "-libdir") ++ (let ((dir (getenv "GCL_LIBDIR"))) ++ (or (set-dir '*lib-directory* "-libdir") + (if dir (setq *lib-directory* (coerce-slash-terminated dir)))) + (unless + (and *load-path* (equal tem *lib-directory*)) +- (setq *load-path* (cons (si::string-concatenate *lib-directory* ++ (setq *load-path* (cons (string-concatenate *lib-directory* + "lsp/") *load-path*)) +- (setq *load-path* (cons (si::string-concatenate *lib-directory* ++ (setq *load-path* (cons (string-concatenate *lib-directory* + "gcl-tk/") *load-path*)) +- ) +- (when (not (boundp 'si::*system-directory*)) +- (setq si::*system-directory* (namestring +- (truename (make-pathname :name nil :type nil :defaults (si::argv 0)))))) +- (set-dir 'si::*system-directory* "-dir") ++ (setq *load-path* (cons (string-concatenate *lib-directory* ++ "xgcl-2/") *load-path*))) ++ (when (not (boundp '*system-directory*)) ++ (setq *system-directory* (namestring ++ (truename (make-pathname :name nil :type nil :defaults (argv 0)))))) ++ (set-dir '*system-directory* "-dir") + (if (multiple-value-setq (tem tem) (get-command-arg "-f")) + (let (*load-verbose*) +- (si::process-some-args si::*command-args*) +- (setq si::*command-args* tem) +- (si::do-f (car si::*command-args*)))) +- )) ++ (process-some-args *command-args*) ++ (setq *command-args* tem) ++ (do-f (car *command-args*)))))) + + (defun do-f (file ) + (let ((eof '(nil)) tem +--- gcl-2.6.7.orig/lsp/gcl_auto_new.lsp ++++ gcl-2.6.7/lsp/gcl_auto_new.lsp +@@ -198,8 +198,10 @@ + (AUTOLOAD 'offer-choices '|tinfo|) + (AUTOLOAD 'tkconnect '|tkl|) + +- +- ++(AUTOLOAD 'user::xgcl-demo '|gcl_dwtest|) ++(defun user::xgcl nil ++ (use-package :xlib) ++ (format t "Welcome to xgcl! Try (xgcl-demo) for a demonstration.")) + + ;; the sun has a broken ypbind business, if one wants to save. + ;; So to stop users from invoking this +--- gcl-2.6.7.orig/lsp/makefile ++++ gcl-2.6.7/lsp/makefile +@@ -19,17 +19,17 @@ OBJS = gcl_arraylib.o gcl_assert.o gcl_d + # export.o autoload.o auto_new.o + + +-COMPILE_FILE=$(PORTDIR)/saved_pre_gcl $(PORTDIR) -system-p -c-file -data-file \ ++COMPILE_FILE=$(PORTDIR)/saved_pre_gcl$(EXE) $(PORTDIR) -system-p -c-file -data-file \ + -o-file nil -h-file -compile + #CFLAGS = -c -O -I../h + + .lsp.c: +- @ ../xbin/if-exists $(PORTDIR)/saved_pre_gcl \ ++ @ ../xbin/if-exists $(PORTDIR)/saved_pre_gcl$(EXE) \ + "rm -f $*.c $*.h $*.data $*.o" \ + "$(COMPILE_FILE) $* " + + .lsp.o: +- @ ../xbin/if-exists $(PORTDIR)/saved_pre_gcl \ ++ @ ../xbin/if-exists $(PORTDIR)/saved_pre_gcl$(EXE) \ + "rm -f $*.c $*.h $*.data $*.o" \ + "$(COMPILE_FILE) $* " \ + "$(CC) $(OFLAG) $(CFLAGS) -c $*.c " \ +--- gcl-2.6.7.orig/lsp/gcl_predlib.lsp ++++ gcl-2.6.7/lsp/gcl_predlib.lsp +@@ -220,10 +220,10 @@ + (or (endp i) (match-dimensions (array-dimensions object) i)))) + (simple-vector + (and (simple-vector-p object) +- (or (endp i) (eq (car i) '*) +- (and (eq (car i) t) (not (stringp object)) (not (bit-vector-p object))) +- (equal (array-element-type object) (best-array-element-type (car i)))) +- (or (endp (cdr i)) (match-dimensions (array-dimensions object) (cdr i))))) ++ (or (endp i) ++ (and (not (stringp object)) (not (bit-vector-p object))) ++ (equal (best-array-element-type (array-element-type object)) t)) ++ (or (endp i) (match-dimensions (array-dimensions object) i)))) + (vector + (and (vectorp object) + (or (endp i) (eq (car i) '*) +@@ -233,7 +233,7 @@ + (simple-array + (and (simple-array-p object) + (or (endp i) (eq (car i) '*) +- (equal (array-element-type object)(best-array-element-type (car i)))) ++ (equal (array-element-type object) (best-array-element-type (car i)))) + (or (endp (cdr i)) (eq (cadr i) '*) + (if (listp (cadr i)) + (match-dimensions (array-dimensions object) (cadr i)) +--- gcl-2.6.7.orig/lsp/gcl_numlib.lsp ++++ gcl-2.6.7/lsp/gcl_numlib.lsp +@@ -168,7 +168,11 @@ + (error "The argument, ~s, is a logarithmic singularity.~ + ~%Don't be foolish, GLS." + x)) +- (log (/ (1+ x) (sqrt (- 1.0d0 (* x x)))))) ++ (log (/ (1+ x) (sqrt (- 1 (* x x)))))) ++;; (let ((y (log (/ (1+ x) (sqrt (- 1 (* x x))))))) ++;; (if (and (= (imagpart x) 0) (complexp y)) ++;; (complex (realpart y) (- (imagpart y))) ++;; y))) + + + (defun rational (x) +--- gcl-2.6.7.orig/lsp/gcl_debug.lsp ++++ gcl-2.6.7/lsp/gcl_debug.lsp +@@ -344,15 +344,14 @@ + + (eval-when (eval) + +-(defun stream-name (str) (namestring (pathname str))) +-) +-(clines "static object stream_name(str) object str;{ ++(defun stream-name (str) (namestring (pathname str)))) ++(clines "object stream_name(str) object str;{ + if (str->sm.sm_object1 != 0 && type_of(str->sm.sm_object1)==t_string) +- return str->sm.sm_object1; else return Cnil; }") ++ return str->sm.sm_object1; else return Cnil;}") + + (defentry stream-name (object) (object "stream_name")) + +-(clines "static object closedp(str) object str;{return (str->sm.sm_fp==0 ? Ct :Cnil); }") ++(clines "object closedp(str) object str;{return (str->sm.sm_fp==0 ? Ct :Cnil);}") + + (defentry closedp (object) (object "closedp")) + +--- gcl-2.6.7.orig/windows/sysdir.bat.in ++++ gcl-2.6.7/windows/sysdir.bat.in +@@ -1,5 +1,5 @@ +-cd %1 +-echo (setq si::*system-directory* (namestring(truename (make-pathname :name nil :type nil :defaults (si::argv 0))))) (si::save-system "modified.exe") | @FLISP@.exe +-del @FLISP@.exe +-ren modified.exe @FLISP@.exe +-pause ++cd %1 ++echo (setq si::*system-directory* (namestring(truename (make-pathname :name nil :type nil :defaults (si::argv 0))))) (si::save-system "modified.exe") | @FLISP@.exe ++del @FLISP@.exe ++ren modified.exe @FLISP@.exe ++pause +--- gcl-2.6.7.orig/windows/instdos.sh ++++ gcl-2.6.7/windows/instdos.sh +@@ -1,6 +1,6 @@ +-#!/bin/sh -ef +- +-# Copy a file so that it ends up with dos line endings so that for example, +-# batch files will run properly under Windows 98. +- +-cat $1 | awk '{sub(/$/,"\r");print}' > $2 ++#!/bin/sh -ef ++ ++# Copy a file so that it ends up with dos line endings so that for example, ++# batch files will run properly under Windows 98. ++ ++cat $1 | awk '{sub(/$/,"\r");print}' > $2 +--- gcl-2.6.7.orig/windows/gcl.iss.in ++++ gcl-2.6.7/windows/gcl.iss.in +@@ -1,47 +1,47 @@ +-; -*-mode: text; fill-column: 75; tab-width: 8; coding: iso-latin-1-dos -*- +-; Script originally generated by the Inno Setup Script Wizard. +-; -- $Id: gcl.iss.in,v 1.6.6.3 2004/02/27 07:35:21 mjthomas Exp $ -- +- +-[Setup] +-AppName=GNU Common Lisp (@CLSTANDARD@ build) +-AppVerName=GNU Common Lisp @VERSION@ (@CLSTANDARD@ build) +-AppPublisher=The GNU Common Lisp Development Team +-AppPublisherURL=http://savannah.gnu.org/projects/gcl/ +-AppSupportURL=http://savannah.gnu.org/projects/gcl/ +-AppUpdatesURL=http://savannah.gnu.org/projects/gcl/ +-AppVersion=@VERSION@ +-OutputBaseFilename=gcl-@VERSION@-@CLSTANDARD@ +-DefaultDirName={sd}\Progra~1\GCL-@VERSION@-@CLSTANDARD@ +-DefaultGroupName=GCL-@VERSION@-@CLSTANDARD@ +-AllowNoIcons=yes +-; AlwaysCreateUninstallIcon=yes +-LicenseFile=@prefix@\COPYING.LIB-2.0 +-InfoBeforeFile=@prefix@\readme-bin.mingw +-Uninstallable=yes +-UninstallFilesDir={app}\uninst +-; uncomment the following line if you want your installation to run on NT 3.51 too. +-; MinVersion=4,3.51 +- +-[Tasks] +-Name: "desktopicon"; Description: "Create a &desktop icon"; GroupDescription: "Additional icons:"; MinVersion: 4,4 +- +-[Files] +-Source: "@prefix@\*.*"; DestDir: "{app}\"; Flags: recursesubdirs +-Source: "c:\lang\MinGW32-gcl\*.*"; DestDir: "{app}\mingw"; Flags: recursesubdirs +- +-[Icons] +-Name: "{group}\GNU Common Lisp @VERSION@ @CLSTANDARD@"; Filename: "{app}\bin\gcl.bat"; IconFilename: "{app}\bin\gcl.ico" +-Name: "{group}\GCL System Manual"; Filename: "{app}\lib\gcl-@VERSION@\doc\gcl-si\index.html" +-Name: "{group}\Common Lisp HyperSpec"; Filename: "{app}\lib\gcl-@VERSION@\doc\gcl\index.html" +-Name: "{userdesktop}\GNU Common Lisp"; Filename: "{app}\bin\gcl.bat"; MinVersion: 4,4; Tasks: desktopicon; IconFilename: "{app}\bin\gcl.ico" +- +-[Run] +-Filename: "{app}\bin\sysdir.bat"; Parameters: "{app}\lib\gcl-@VERSION@\unixport\" +-Filename: "{app}\lib\gcl-@VERSION@\unixport\@FLISP@.exe"; Parameters: -load {app}/install/install.lsp +-Filename: "{app}\bin\gcl.bat"; Description: "Launch GNU Common Lisp"; Flags: postinstall skipifsilent +- +-[UninstallDelete] +-Type: files; Name: "{app}\bin\gcl.bat" +-Type: files; Name: "{app}\bin\gcl" +-Type: files; Name: "{app}\lib\gcl-@VERSION@\unixport\@FLISP@_orig.exe" +- ++; -*-mode: text; fill-column: 75; tab-width: 8; coding: iso-latin-1-dos -*- ++; Script originally generated by the Inno Setup Script Wizard. ++; -- $Id: gcl.iss.in,v 1.6.6.3.14.1 2010/11/03 19:27:10 camm Exp $ -- ++ ++[Setup] ++AppName=GNU Common Lisp (@CLSTANDARD@ build) ++AppVerName=GNU Common Lisp @VERSION@ (@CLSTANDARD@ build) ++AppPublisher=The GNU Common Lisp Development Team ++AppPublisherURL=http://savannah.gnu.org/projects/gcl/ ++AppSupportURL=http://savannah.gnu.org/projects/gcl/ ++AppUpdatesURL=http://savannah.gnu.org/projects/gcl/ ++AppVersion=@VERSION@ ++OutputBaseFilename=gcl-@VERSION@-@CLSTANDARD@ ++DefaultDirName={sd}\Progra~1\GCL-@VERSION@-@CLSTANDARD@ ++DefaultGroupName=GCL-@VERSION@-@CLSTANDARD@ ++AllowNoIcons=yes ++; AlwaysCreateUninstallIcon=yes ++LicenseFile=@prefix@\COPYING.LIB-2.0 ++InfoBeforeFile=@prefix@\readme-bin.mingw ++Uninstallable=yes ++UninstallFilesDir={app}\uninst ++; uncomment the following line if you want your installation to run on NT 3.51 too. ++; MinVersion=4,3.51 ++ ++[Tasks] ++Name: "desktopicon"; Description: "Create a &desktop icon"; GroupDescription: "Additional icons:"; MinVersion: 4,4 ++ ++[Files] ++Source: "@prefix@\*.*"; DestDir: "{app}\"; Flags: recursesubdirs ++Source: "c:\lang\MinGW32-gcl\*.*"; DestDir: "{app}\mingw"; Flags: recursesubdirs ++ ++[Icons] ++Name: "{group}\GNU Common Lisp @VERSION@ @CLSTANDARD@"; Filename: "{app}\bin\gcl.bat"; IconFilename: "{app}\bin\gcl.ico" ++Name: "{group}\GCL System Manual"; Filename: "{app}\lib\gcl-@VERSION@\doc\gcl-si\index.html" ++Name: "{group}\Common Lisp HyperSpec"; Filename: "{app}\lib\gcl-@VERSION@\doc\gcl\index.html" ++Name: "{userdesktop}\GNU Common Lisp"; Filename: "{app}\bin\gcl.bat"; MinVersion: 4,4; Tasks: desktopicon; IconFilename: "{app}\bin\gcl.ico" ++ ++[Run] ++Filename: "{app}\bin\sysdir.bat"; Parameters: "{app}\lib\gcl-@VERSION@\unixport\" ++Filename: "{app}\lib\gcl-@VERSION@\unixport\@FLISP@.exe"; Parameters: -load {app}/install/install.lsp ++Filename: "{app}\bin\gcl.bat"; Description: "Launch GNU Common Lisp"; Flags: postinstall skipifsilent ++ ++[UninstallDelete] ++Type: files; Name: "{app}\bin\gcl.bat" ++Type: files; Name: "{app}\bin\gcl" ++Type: files; Name: "{app}\lib\gcl-@VERSION@\unixport\@FLISP@_orig.exe" ++ +--- gcl-2.6.7.orig/windows/install.lsp.in ++++ gcl-2.6.7/windows/install.lsp.in +@@ -1,165 +1,165 @@ +-;;; +-;;; Help the Windows installer +-;;; +- +- +-;; In the final destination bin directory, make a Bourne shell script +-;; to launch GCL. +- +-(defun kill-backs ( s ) +- (let ((pos (search "\\" s))) +- (if pos +- (let ((start (subseq s 0 pos)) +- (finish (subseq s (1+ pos)))) +- (kill-backs (concatenate 'string start "/" finish))) +- s))) +- +-(defun kill-double-forwards ( s ) +- (let ((pos (search "//" s))) +- (if pos +- (let ((start (subseq s 0 pos)) +- (finish (subseq s (+ pos 2)))) +- (kill-double-forwards (concatenate 'string start "/" finish))) +- s))) +- +-(defun kill-forwards ( s ) +- (let ((pos (search "/" s))) +- (if pos +- (let ((start (subseq s 0 pos)) +- (finish (subseq s (1+ pos)))) +- (kill-forwards (concatenate 'string start "\\" finish))) +- s))) +- +-(defun kill-double-backs ( s ) +- (let ((pos (search "\\\\" s))) +- (if pos +- (let ((start (subseq s 0 pos)) +- (finish (subseq s (+ pos 2)))) +- (kill-double-backs (concatenate 'string start "\\" finish))) +- s))) +- +-(defun split-by-one-fs (string) +- (loop for i = 0 then (1+ j) +- as j = (position #\/ string :start i) +- collect (subseq string i j) +- while j)) +- +- +-; Remove dos colon for MSYS and \\ +-(defun msysarise (s) +- (if (equal (char s 1) #\:) +- (kill-double-forwards (kill-backs (concatenate 'string "/" (subseq s 0 1) (subseq s 2)))) +- (kill-double-forwards (kill-backs s)))) +- +-(setq *msys-system-directory* (msysarise *system-directory*)) +- +-;; The following few lines remove the lib/gcl-???/unixport string. +-;; Can't do this by simple string substitution as W98 paths are shortened. +-;; All depends on path format including end separator. +- +-; Canonicalise directory separators +-(setq *root-directory* +- (kill-double-forwards (kill-backs *system-directory*))) +- +-; Remove end dir separator +-(setq *root-directory* +- (subseq *root-directory* 0 (search "/" *root-directory* :from-end t))) +- +-; Remove unixport and dir separator +-(setq *root-directory* +- (subseq *root-directory* 0 (search "/" *root-directory* :from-end t))) +- +-; Remove gcl-?.?.? and dir separator +-(setq *root-directory* +- (subseq *root-directory* 0 (search "/" *root-directory* :from-end t))) +- +-; Remove lib but not the dir separator +-(setq *root-directory* +- (subseq *root-directory* 0 (1+ (search "/" *root-directory* :from-end t)))) +- +-; Canonicalise directory separators +-(setq *msys-root-directory* +- (kill-double-forwards (kill-backs *msys-system-directory*))) +- +-; Remove end dir separator +-(setq *msys-root-directory* +- (subseq *msys-root-directory* 0 (search "/" *msys-root-directory* :from-end t))) +- +-; Remove unixport and dir separator +-(setq *msys-root-directory* +- (subseq *msys-root-directory* 0 (search "/" *msys-root-directory* :from-end t))) +- +-; Remove gcl-?.?.? and dir separator +-(setq *msys-root-directory* +- (subseq *msys-root-directory* 0 (search "/" *msys-root-directory* :from-end t))) +- +-; Remove lib but not the dir separator +-(setq *msys-root-directory* +- (subseq *msys-root-directory* 0 (1+ (search "/" *msys-root-directory* :from-end t)))) +- +-(setq *lib-directory* +- (format nil "~a~a" *root-directory* "lib/gcl-@VERSION@/")) +- +-(setq *h-directory* +- (format nil "~a~a" *msys-root-directory* "/lib/gcl-@VERSION@/h")) +- +-(setq *bin-directory* +- (format nil "~a~a" *root-directory* "bin/")) +- +-(setq gclscript (format nil "~a~a" *bin-directory* "gcl")) +- +-(with-open-file (s gclscript :direction :output :if-exists :supersede) +- (format s "#!/bin/sh~%") +- (format s "# export C_INCLUDE_PATH=~a~%" *h-directory* ) +- (format s "export PATH=~a/mingw/bin:~a/lib/gcl-@VERSION@/unixport:${PATH}~%" *msys-root-directory* *msys-root-directory* ) +- (format s "exec ~a@FLISP@.exe -dir ~a -libdir ~a -eval \"(setq si::*allow-gzipped-file* t)\" \"$@\"" +- *msys-system-directory* +- (kill-double-forwards *system-directory*) +- *lib-directory* )) +- +-; Now make a batch file to launch GCL +-(setq *dos-system-directory* (kill-double-backs (kill-forwards *system-directory*))) +- +-; Now make a batch file to launch GCL +-(setq *dos-root-directory* (kill-double-backs (kill-forwards *dos-system-directory*))) +- +-; Remove end dir separator +-(setq *dos-root-directory* +- (subseq *dos-root-directory* 0 (search "\\" *dos-root-directory* :from-end t))) +- +-; Remove unixport and dir separator +-(setq *dos-root-directory* +- (subseq *dos-root-directory* 0 (search "\\" *dos-root-directory* :from-end t))) +- +-; Remove gcl-?.?.? and dir separator +-(setq *dos-root-directory* +- (subseq *dos-root-directory* 0 (search "\\" *dos-root-directory* :from-end t))) +- +-; Remove lib but not the dir separator +-(setq *dos-root-directory* +- (subseq *dos-root-directory* 0 (1+ (search "\\" *dos-root-directory* :from-end t)))) +- +-(setq *dos-h-directory* +- (format nil "~a~a" *dos-root-directory* "lib\\gcl-@VERSION@\\h")) +- +-(setq *dos-bin-directory* +- (format nil "~a~a" *dos-root-directory* "bin\\")) +- +-(setq gclbatch (format nil "~a~a" *bin-directory* "gcl.bat")) +- +-;; Output CRLF line terminated batch file +- +-(setf crstr (make-string 1 :initial-element #\Return)) +-(setf lfstr (make-string 1 :initial-element #\Linefeed)) +-(defun crlf (s) (format s "~a~a" crstr lfstr)) +- +-(with-open-file (s gclbatch :direction :output :if-exists :supersede) +- (format s "@echo off") (crlf s) +- (format s "REM set C_INCLUDE_PATH=~a" *dos-h-directory* ) (crlf s) +- (format s "path ~amingw\\bin;~alib\\gcl-@VERSION@\\unixport;%PATH%" *dos-root-directory* *dos-root-directory* ) (crlf s) +- (format s "start ~a@FLISP@.exe -dir ~a -libdir ~a -eval \"(setq si::*allow-gzipped-file* t)\" %1 %2 %3 %4 %5 %6 %7 %8 %9" +- *dos-system-directory* +- (kill-double-forwards *system-directory*) +- *lib-directory* ) (crlf s)) +- +-(quit) ++;;; ++;;; Help the Windows installer ++;;; ++ ++ ++;; In the final destination bin directory, make a Bourne shell script ++;; to launch GCL. ++ ++(defun kill-backs ( s ) ++ (let ((pos (search "\\" s))) ++ (if pos ++ (let ((start (subseq s 0 pos)) ++ (finish (subseq s (1+ pos)))) ++ (kill-backs (concatenate 'string start "/" finish))) ++ s))) ++ ++(defun kill-double-forwards ( s ) ++ (let ((pos (search "//" s))) ++ (if pos ++ (let ((start (subseq s 0 pos)) ++ (finish (subseq s (+ pos 2)))) ++ (kill-double-forwards (concatenate 'string start "/" finish))) ++ s))) ++ ++(defun kill-forwards ( s ) ++ (let ((pos (search "/" s))) ++ (if pos ++ (let ((start (subseq s 0 pos)) ++ (finish (subseq s (1+ pos)))) ++ (kill-forwards (concatenate 'string start "\\" finish))) ++ s))) ++ ++(defun kill-double-backs ( s ) ++ (let ((pos (search "\\\\" s))) ++ (if pos ++ (let ((start (subseq s 0 pos)) ++ (finish (subseq s (+ pos 2)))) ++ (kill-double-backs (concatenate 'string start "\\" finish))) ++ s))) ++ ++(defun split-by-one-fs (string) ++ (loop for i = 0 then (1+ j) ++ as j = (position #\/ string :start i) ++ collect (subseq string i j) ++ while j)) ++ ++ ++; Remove dos colon for MSYS and \\ ++(defun msysarise (s) ++ (if (equal (char s 1) #\:) ++ (kill-double-forwards (kill-backs (concatenate 'string "/" (subseq s 0 1) (subseq s 2)))) ++ (kill-double-forwards (kill-backs s)))) ++ ++(setq *msys-system-directory* (msysarise *system-directory*)) ++ ++;; The following few lines remove the lib/gcl-???/unixport string. ++;; Can't do this by simple string substitution as W98 paths are shortened. ++;; All depends on path format including end separator. ++ ++; Canonicalise directory separators ++(setq *root-directory* ++ (kill-double-forwards (kill-backs *system-directory*))) ++ ++; Remove end dir separator ++(setq *root-directory* ++ (subseq *root-directory* 0 (search "/" *root-directory* :from-end t))) ++ ++; Remove unixport and dir separator ++(setq *root-directory* ++ (subseq *root-directory* 0 (search "/" *root-directory* :from-end t))) ++ ++; Remove gcl-?.?.? and dir separator ++(setq *root-directory* ++ (subseq *root-directory* 0 (search "/" *root-directory* :from-end t))) ++ ++; Remove lib but not the dir separator ++(setq *root-directory* ++ (subseq *root-directory* 0 (1+ (search "/" *root-directory* :from-end t)))) ++ ++; Canonicalise directory separators ++(setq *msys-root-directory* ++ (kill-double-forwards (kill-backs *msys-system-directory*))) ++ ++; Remove end dir separator ++(setq *msys-root-directory* ++ (subseq *msys-root-directory* 0 (search "/" *msys-root-directory* :from-end t))) ++ ++; Remove unixport and dir separator ++(setq *msys-root-directory* ++ (subseq *msys-root-directory* 0 (search "/" *msys-root-directory* :from-end t))) ++ ++; Remove gcl-?.?.? and dir separator ++(setq *msys-root-directory* ++ (subseq *msys-root-directory* 0 (search "/" *msys-root-directory* :from-end t))) ++ ++; Remove lib but not the dir separator ++(setq *msys-root-directory* ++ (subseq *msys-root-directory* 0 (1+ (search "/" *msys-root-directory* :from-end t)))) ++ ++(setq *lib-directory* ++ (format nil "~a~a" *root-directory* "lib/gcl-@VERSION@/")) ++ ++(setq *h-directory* ++ (format nil "~a~a" *msys-root-directory* "/lib/gcl-@VERSION@/h")) ++ ++(setq *bin-directory* ++ (format nil "~a~a" *root-directory* "bin/")) ++ ++(setq gclscript (format nil "~a~a" *bin-directory* "gcl")) ++ ++(with-open-file (s gclscript :direction :output :if-exists :supersede) ++ (format s "#!/bin/sh~%") ++ (format s "# export C_INCLUDE_PATH=~a~%" *h-directory* ) ++ (format s "export PATH=~a/mingw/bin:~a/lib/gcl-@VERSION@/unixport:${PATH}~%" *msys-root-directory* *msys-root-directory* ) ++ (format s "exec ~a@FLISP@.exe -dir ~a -libdir ~a -eval \"(setq si::*allow-gzipped-file* t)\" \"$@\"" ++ *msys-system-directory* ++ (kill-double-forwards *system-directory*) ++ *lib-directory* )) ++ ++; Now make a batch file to launch GCL ++(setq *dos-system-directory* (kill-double-backs (kill-forwards *system-directory*))) ++ ++; Now make a batch file to launch GCL ++(setq *dos-root-directory* (kill-double-backs (kill-forwards *dos-system-directory*))) ++ ++; Remove end dir separator ++(setq *dos-root-directory* ++ (subseq *dos-root-directory* 0 (search "\\" *dos-root-directory* :from-end t))) ++ ++; Remove unixport and dir separator ++(setq *dos-root-directory* ++ (subseq *dos-root-directory* 0 (search "\\" *dos-root-directory* :from-end t))) ++ ++; Remove gcl-?.?.? and dir separator ++(setq *dos-root-directory* ++ (subseq *dos-root-directory* 0 (search "\\" *dos-root-directory* :from-end t))) ++ ++; Remove lib but not the dir separator ++(setq *dos-root-directory* ++ (subseq *dos-root-directory* 0 (1+ (search "\\" *dos-root-directory* :from-end t)))) ++ ++(setq *dos-h-directory* ++ (format nil "~a~a" *dos-root-directory* "lib\\gcl-@VERSION@\\h")) ++ ++(setq *dos-bin-directory* ++ (format nil "~a~a" *dos-root-directory* "bin\\")) ++ ++(setq gclbatch (format nil "~a~a" *bin-directory* "gcl.bat")) ++ ++;; Output CRLF line terminated batch file ++ ++(setf crstr (make-string 1 :initial-element #\Return)) ++(setf lfstr (make-string 1 :initial-element #\Linefeed)) ++(defun crlf (s) (format s "~a~a" crstr lfstr)) ++ ++(with-open-file (s gclbatch :direction :output :if-exists :supersede) ++ (format s "@echo off") (crlf s) ++ (format s "REM set C_INCLUDE_PATH=~a" *dos-h-directory* ) (crlf s) ++ (format s "path ~amingw\\bin;~alib\\gcl-@VERSION@\\unixport;%PATH%" *dos-root-directory* *dos-root-directory* ) (crlf s) ++ (format s "start ~a@FLISP@.exe -dir ~a -libdir ~a -eval \"(setq si::*allow-gzipped-file* t)\" %1 %2 %3 %4 %5 %6 %7 %8 %9" ++ *dos-system-directory* ++ (kill-double-forwards *system-directory*) ++ *lib-directory* ) (crlf s)) ++ ++(quit) +--- gcl-2.6.7.orig/gcl-tk/tkMain.c ++++ gcl-2.6.7/gcl-tk/tkMain.c +@@ -495,8 +495,8 @@ StdinProc(clientData, mask) + if (msg->type == m_tcl_command_wait_response + || code) + { +- unsigned char buf[4]; +- unsigned char *p = buf; ++ char buf[4]; ++ char *p = buf; + /*header */ + *p++ = (code ? '1' : '0'); + bcopy(msg->msg_id,p,3); +--- gcl-2.6.7.orig/gcl-tk/guis.c ++++ gcl-2.6.7/gcl-tk/guis.c +@@ -84,11 +84,11 @@ extern char *inet_ntoa ( struct in_addr + FILE *pstreamDebug; + int fDebugSockets; + +-#ifdef PLATFORM_SUNOS +-static void notice_input( ); +-#else +-static void notice_input(); +-#endif ++/* #ifdef PLATFORM_SUNOS */ ++/* static void notice_input( ); */ ++/* #else */ ++/* static void notice_input(); */ ++/* #endif */ + + int hdl = -1; + +@@ -285,7 +285,7 @@ char *envp[]; + #define SET_SESSION_ID() setsid() + #else + #ifdef BSD +-#define SET_SESSION_ID() (setpgrp(0,0) ? -1 : 0) ++#define SET_SESSION_ID() (setpgrp() ? -1 : 0) + #endif + #endif + #endif +@@ -369,19 +369,19 @@ struct connection_state *sfd; + } + + +-#ifdef PLATFORM_SUNOS +-static void +-notice_input( int sig, int code, struct sigcontext *s, char *a ) +-#else +-static void +-notice_input( sig ) +- int sig; +-#endif +-{ +- signal( SIGIO, notice_input ); +- dfprintf(stderr, "\nNoticed input!\n" ); ++/* #ifdef PLATFORM_SUNOS */ ++/* static void */ ++/* notice_input( int sig, int code, struct sigcontext *s, char *a ) */ ++/* #else */ ++/* static void */ ++/* notice_input( sig ) */ ++/* int sig; */ ++/* #endif */ ++/* { */ ++/* signal( SIGIO, notice_input ); */ ++/* dfprintf(stderr, "\nNoticed input!\n" ); */ + +-} ++/* } */ + + static int message_id; + +--- gcl-2.6.7.orig/gcl-tk/makefile ++++ gcl-2.6.7/gcl-tk/makefile +@@ -44,7 +44,7 @@ clean:: + # for some reason -lieee is on various linux systems in the list of requireds.. + + gcltkaux: $(GUIOS) +- $(LD_ORDINARY_CC) $(GUIOS) -o gcltkaux ${TK_LIB_SPEC} ${TK_BUILD_LIB_SPEC} ${TK_XLIBSW} ${TK_XINCLUDES} ${TCL_LIB_SPEC} `echo ${TCL_LIBS} | sed -e s:-lieee::g` ${LIBS} ${GCLIB} ++ $(LD_ORDINARY_CC) $(GUIOS) $(LDFLAGS) -o gcltkaux ${TK_LIB_SPEC} ${TK_BUILD_LIB_SPEC} ${TK_XLIBSW} ${TK_XINCLUDES} ${TCL_LIB_SPEC} `echo ${TCL_LIBS} | sed -e s:-lieee::g` ${LIBS} ${GCLIB} + + gcltksrv: makefile + cat gcltksrv.in | sed -e "s!TK_LIBRARY=.*!TK_LIBRARY=${TK_LIBRARY}!g" \ +--- gcl-2.6.7.orig/unixport/init_ansi_gcl.lsp.in ++++ gcl-2.6.7/unixport/init_ansi_gcl.lsp.in +@@ -44,7 +44,7 @@ + (dolist (d (list lsp cmpnew pcl clcs)) + (load (make-pathname :name "sys-proclaim" :type "lisp" :directory d))) + (load (make-pathname :name "tk-package" :type "lsp" :directory gtk)) +- (load (make-pathname :name "gcl_cmpmain" :type "lsp" :directory cmpnew)) ++; (load (make-pathname :name "gcl_cmpmain" :type "lsp" :directory cmpnew)) + (load (make-pathname :name "gcl_lfun_list" :type "lsp" :directory cmpnew)) + (load (make-pathname :name "gcl_cmpopt" :type "lsp" :directory cmpnew)) + (load (make-pathname :name "gcl_auto_new" :type "lsp" :directory lsp)) +@@ -98,7 +98,8 @@ + (cond ((si::get-command-arg "-batch") + (setq si::*top-level-hook* 'bye)) + ((si::get-command-arg "-f")) +- (t (format t si::*system-banner*))) ++ (t (format t si::*system-banner*) ++ (format t "Temporary directory for compiler files set to ~a~%" *tmp-dir*))) + (setq si::*ihs-top* 1) + (in-package 'system::user) (incf system::*ihs-top* 2) + (funcall system::*old-top-level*)) +@@ -243,7 +244,7 @@ + pprint-dispatch pprint-exit-if-list-exhausted pprint-fill + pprint-indent pprint-linear pprint-logical-block pprint-newline + pprint-pop pprint-tab pprint-tabular print-not-readable-object +- print-unreadable-object read-sequence readtable-case row-major-aref ++ print-unreadable-object readtable-case row-major-aref + set-pprint-dispatch simple-condition-format-control + stream-external-format synonym-stream-symbol + translate-logical-pathname translate-pathname +@@ -251,7 +252,7 @@ + unbound-slot-instance + upgraded-complex-part-type wild-pathname-p with-compilation-unit + with-condition-restarts with-package-iterator with-standard-io-syntax +- write-sequence )) ++ )) + (shadowing-import (list s) "COMMON-LISP")) + + (use-package "ANSI-LOOP" "COMMON-LISP") +--- gcl-2.6.7.orig/unixport/sys_pre_gcl.c ++++ gcl-2.6.7/unixport/sys_pre_gcl.c +@@ -1,58 +1,6 @@ +-#include +-#include +-#include "../h/include.h" +- +-extern object user_init(); +- +- +-void gcl_init_or_load1 (void (*)(void),char *); +-#define init_or_load(fn,file) do {extern void fn(void); gcl_init_or_load1(fn,file);} \ +- while(0) +- +-/* #define mjoin(a,b) a ## b */ +-/* #define Mjoin(a,b) mjoin(a,b) */ +- +-#define ar_init(a) do {\ +- char b[200];\ +- \ +- if (snprintf(b,sizeof(b),"ar x %-*.*slibpre_gcl.a %s.o",\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_self,#a)<=0)\ +- error("Cannot unpack module " #a "o\n");\ +- if (system(b)) \ +- error("Cannot run ar command to unpack module " #a ".o\n");\ +- init_or_load(Mjoin(init_,a),#a ".o");\ +- if (unlink(#a ".o"))\ +- error("Cannot unlink " #a ".o\n");\ +-} while(0) +- +-#define ar_check_init(a,b) do {\ +- object t;\ +- \ +- for (t=b->s.s_dbind;!endp(t) && type_of(t->c.c_car)==t_string && strcmp(#a,t->c.c_car->st.st_self);t=t->c.c_cdr);\ +- if (endp(t))\ +- ar_init(a);\ +-} while(0) +- +- +-static void +-load1(x) +- char *x; +-{printf("loading %s\n",x); +- fflush(stdout); +- load(x);} +- +-#define lsp_init(a) do {\ +- char b[200];\ +- \ +- if (snprintf(b,sizeof(b),"%-*.*s%s",\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_self,a)<=0)\ +- error("Cannot append system directory\n");\ +- load1(b);\ +-} while(0) ++#define FLAVOR "" ++ ++#include "sys.c" + + void + gcl_init_init() +@@ -78,6 +26,7 @@ gcl_init_system(object no_init) + if (type_of(no_init)!=t_symbol) + error("Supplied no_init is not of type symbol\n"); + ++ lsp_init("../lsp/gcl_listlib.lsp"); + lsp_init("../lsp/gcl_predlib.lsp"); + lsp_init("../lsp/gcl_setf.lsp"); + lsp_init("../lsp/gcl_arraylib.lsp"); +@@ -88,7 +37,7 @@ gcl_init_system(object no_init) + lsp_init("../lsp/gcl_japi.lsp"); + #endif + lsp_init("../lsp/gcl_iolib.lsp"); +- lsp_init("../lsp/gcl_listlib.lsp"); ++/* lsp_init("../lsp/gcl_listlib.lsp"); */ + lsp_init("../lsp/gcl_mislib.lsp"); + lsp_init("../lsp/gcl_numlib.lsp"); + lsp_init("../lsp/gcl_packlib.lsp"); +--- gcl-2.6.7.orig/unixport/rsym_macosx.c ++++ gcl-2.6.7/unixport/rsym_macosx.c +@@ -14,212 +14,86 @@ + + #include + #include +- + #include + +-#ifdef STANDALONE + #include +-#define SPECIAL_RSYM +-#endif +- + #include + #include + #include + #include + #include ++#include + + #define IN_RSYM 1 + +-/* #include "config.h" */ + #include "ext_sym.h" + +-int verbose = 0; ++#define massert(a_) if (!(a_)) {fprintf(stderr,"The assertion %s on line %d of %s in function %s failed", \ ++ #a_,__LINE__,__FILE__,__FUNCTION__);exit(-1);} + +-void rsym_error (char *format, ...) +-{ +- va_list ap; +- +- va_start (ap, format); +- fprintf (stderr, "rsym: "); +- vfprintf (stderr, format, ap); +- /* fprintf (stderr, " (%s)", strerror(errno)); */ +- fprintf (stderr, "\n"); +- va_end (ap); +- exit (1); +-} ++int ++main(int argc,char * argv[],char **envp) { + +-int rsym_select_symbol(struct nlist *symbol) +-{ +- if (symbol->n_type & N_STAB) { +- return (FALSE); +- } +- if (!(symbol->n_type & N_EXT)) { +- return (FALSE); +- } +- /* if (symbol->n_type == N_UNDF) { +- return (FALSE); +- } +- if (symbol->n_sect == NO_SECT) { +- return (FALSE); +- } +- */ +- return (TRUE); +-} ++ struct stat ss; ++ struct mach_header *mh; ++ struct load_command *lc; ++ struct symtab_command *st=NULL; ++ struct nlist *sym1,*sym,*syme; ++ struct lsymbol_table tab; ++ char *strtab; ++ void *addr; ++ int i,l; ++ FILE *f; ++ ++ massert(!stat(argv[1],&ss)); ++ massert((l=open(argv[1],O_RDONLY,0))>0); ++ massert((addr=mmap(0,ss.st_size,PROT_READ|PROT_WRITE,MAP_PRIVATE,l,0))!=(void *)-1); ++ ++ mh=addr; ++ lc=addr+sizeof(*mh); ++ ++ for (i=0;incmds;i++,lc=(void *)lc+lc->cmdsize) ++ if (lc->cmd==LC_SYMTAB) { ++ st=(void *) lc; ++ break; ++ } ++ ++ massert(st); ++ sym1=addr+st->symoff; ++ syme=sym1+st->nsyms; ++ strtab=addr+st->stroff; ++ ++ tab.n_symbols=0; ++ tab.tot_leng=0; ++ ++ massert(f=fopen (argv[2], "wb")); ++ fseek(f,sizeof(tab),0); ++ ++ for (sym=sym1;symn_un.n_strx + strtab; ++ ++ if (sym->n_type & N_STAB) ++ continue; ++ if (!(sym->n_type & N_EXT)) ++ continue; ++ ++ fwrite (&sym->n_value,sizeof(sym->n_value),1,f); ++ tab.n_symbols++; ++ ++ fprintf(f,"%s",name); ++ putc (0, f); ++ tab.tot_leng+=strlen(name)+1; ++ ++ } ++ ++ fseek (f, 0, 0); ++ fwrite (&tab, sizeof(tab), 1, f); ++ fclose (f); + +-void rsym_doit2 (struct nlist *symbols, unsigned long nsyms, char *outfile) +-{ +- unsigned long i; +- struct lsymbol_table tab; +- FILE *symout; +- +- if (!(symout = fopen (outfile, "wb"))) { +- rsym_error ("cannot open file for writing: %s", outfile); +- } ++ munmap(addr,ss.st_size); ++ close (l); + +- tab.n_symbols=0; +- tab.tot_leng=0; +- +- fseek (symout, sizeof(tab), 0); +- +- for (i=0 ; i < nsyms ; i++) +- { +- int addr = (int) symbols[i].n_value; +- char *name = symbols[i].n_un.n_name; +- +- if (name) +- { +- tab.n_symbols++; +- fwrite (&addr, sizeof (int), 1, symout); +- while (tab.tot_leng++, *name) +- putc (*name++, symout); +- putc (0, symout); +- } +- else { +- fprintf (stderr, "warning: malformed symbol\n"); +- } +- } +- +- if (verbose) { +- fprintf (stdout, "%d/%ld symbol(s) reviewed\n", tab.n_symbols, nsyms); +- } +- +- fseek (symout, 0, 0); +- fwrite (&tab, sizeof(tab), 1, symout); +- +- fclose (symout); +-} ++ return 0; + +-void rsym_doit1 (char *infile, char *outfile) +-{ +- struct stat stat_buf; +- struct mach_header *mh; +- struct load_command *lc; +- struct symtab_command *st; +- struct dysymtab_command *dyst; +- unsigned long nsyms, i, size; +- unsigned long strsize; +- struct nlist *symtab, *selected_symbols; +- kern_return_t r; +- char *strtab; +- vm_size_t s; +- char *addr; +- int fd; +- +- if ((fd = open (infile, O_RDONLY, 0)) < 0) { +- rsym_error ("cannot open input file: %s", infile); +- } +- +- if (fstat (fd, &stat_buf) == -1) { +- rsym_error ("cannot fstat file: %s", infile); +- } +- +- size = stat_buf.st_size; +- +- if ((r = map_fd (fd, (vm_offset_t) 0, (vm_offset_t *) &addr, +- (boolean_t) TRUE, (vm_size_t) size)) != KERN_SUCCESS) { +- rsym_error ("cannot map file in memory: %s", infile); +- } +- +- mh = (struct mach_header *) addr; +- lc = (struct load_command *) ((char *) addr + sizeof(struct mach_header)); +- +- for (i=0 ; i < mh->ncmds ; i++) { +- if (lc->cmd == LC_SYMTAB) { +- st = (struct symtab_command *) lc; +- } +- else if (lc->cmd == LC_DYSYMTAB) { +- dyst = (struct dysymtab_command *) lc; +- } +- lc = (struct load_command *) ((char *) lc + lc->cmdsize); +- } +- +- if (!st) { +- rsym_error ("no symbol table information"); +- } +- +- symtab = (struct nlist *) ((char *) addr + st->symoff); +- +- s = sizeof(struct nlist) * st->nsyms; +- if (vm_allocate (mach_task_self (), (vm_address_t *) &selected_symbols, s, 1) != KERN_SUCCESS) { +- rsym_error ("could not vm_allocate"); +- } +- +- nsyms = 0; +- +- for (i = 0 ; i < st->nsyms ; i++) { +- if (rsym_select_symbol (symtab + i)) +- selected_symbols[nsyms++] = symtab[i]; +- } +- +- strtab = addr + st->stroff; +- strsize = st->strsize; +- +- for (i = 0 ; i < nsyms ; i++) { +- if (selected_symbols[i].n_un.n_strx == 0) +- selected_symbols[i].n_un.n_name = ""; +- else if (selected_symbols[i].n_un.n_strx < 0 || +- selected_symbols[i].n_un.n_strx > strsize) +- selected_symbols[i].n_un.n_name = "bad string index"; +- else +- selected_symbols[i].n_un.n_name = selected_symbols[i].n_un.n_strx + strtab; +- +- if (verbose) { +- fprintf (stdout, "%8x %s\n", (unsigned int) selected_symbols[i].n_value, +- selected_symbols[i].n_un.n_name); +- } +- } +- +- rsym_doit2 (selected_symbols, nsyms, outfile); +- +- if (vm_deallocate (mach_task_self (), (vm_address_t) selected_symbols, s) != KERN_SUCCESS) { +- fprintf (stderr, "warning: failed to free memory\n"); +- } +- +- if (vm_deallocate (mach_task_self (), (vm_address_t) addr, (vm_size_t) size) != KERN_SUCCESS) { +- fprintf (stderr, "warning: failed to deallocate mapped file\n"); +- } +- +- close (fd); +-} +- +-int main (int argc, char **argv, char **envp) +-{ +- int ch; +- +- while ((ch = getopt (argc, argv, "-v")) != -1) { +- if (ch == 'v') +- verbose = 1; +- } +- +- argc -= optind; +- argv += optind; +- +- if (argc < 2) { +- fprintf (stderr, "usage: rsym [-v(erbose)] \n"); +- exit (1); +- } +- +- rsym_doit1 (argv[0], argv[1]); +- +- return 0; + } +--- gcl-2.6.7.orig/unixport/init_gcl.lsp.in ++++ gcl-2.6.7/unixport/init_gcl.lsp.in +@@ -31,7 +31,7 @@ + (dolist (d (list lsp cmpnew)) + (load (make-pathname :name "sys-proclaim" :type "lisp" :directory d))) + (load (make-pathname :name "tk-package" :type "lsp" :directory gtk)) +- (load (make-pathname :name "gcl_cmpmain" :type "lsp" :directory cmpnew)) ++; (load (make-pathname :name "gcl_cmpmain" :type "lsp" :directory cmpnew)) + (load (make-pathname :name "gcl_lfun_list" :type "lsp" :directory cmpnew)) + (load (make-pathname :name "gcl_cmpopt" :type "lsp" :directory cmpnew)) + (load (make-pathname :name "gcl_auto_new" :type "lsp" :directory lsp)) +@@ -85,7 +85,8 @@ + (cond ((si::get-command-arg "-batch") + (setq si::*top-level-hook* 'bye)) + ((si::get-command-arg "-f")) +- (t (format t si::*system-banner*))) ++ (t (format t si::*system-banner*) ++ (format t "Temporary directory for compiler files set to ~a~%" *tmp-dir*))) + (setq si::*ihs-top* 1) + (in-package 'system::user) (incf system::*ihs-top* 2) + (funcall system::*old-top-level*)) +--- /dev/null ++++ gcl-2.6.7/unixport/sys.c +@@ -0,0 +1,64 @@ ++#include ++#include ++#include ++#include ++#include "../h/include.h" ++ ++static void ++ar_init_fn(void (fn)(void),const char *s) { ++ ++ char b[200]; ++ struct stat ss; ++ object sysd=sSAsystem_directoryA->s.s_dbind; ++ ++ if (stat(s,&ss)) { ++ assert(snprintf(b,sizeof(b),"ar x %-.*slib%sgcl.a %s",sysd->st.st_fillp,sysd->st.st_self,FLAVOR,s)>0); ++ assert(!msystem(b)); ++#ifdef _WIN32 ++ if (sSAwine_detectedA->s.s_dbind!=Cnil) { ++ char *n; ++ unsigned l; ++ l=strlen(s)+6; ++ n=alloca(l); ++ snprintf(n,l,"/tmp/%s",s); ++ s=(void *)n; ++ } ++#endif ++ } ++ gcl_init_or_load1(fn,s); ++ assert(!unlink(s)); ++ ++} ++ ++static void ++ar_check_init_fn(void (fn)(void),char *s,object b,char *o) { ++ ++ object t; ++ ++ for (t=b->s.s_dbind; ++ !endp(t) && ++ type_of(t->c.c_car)==t_string && ++ strcmp(s,t->c.c_car->st.st_self);t=t->c.c_cdr); ++ if (endp(t)) ++ ar_init_fn(fn,o); ++ ++} ++ ++#define proc(init,fn,args...) {extern void init(void);fn(init,##args);} ++ ++#define ar_init(a) proc(Mjoin(init_,a),ar_init_fn,#a ".o") ++#define ar_check_init(a,b) proc(Mjoin(init_,a),ar_check_init_fn,#a,b,#a ".o") ++ ++ ++static void ++lsp_init(const char *a) { ++ ++ char b[200]; ++ object sysd=sSAsystem_directoryA->s.s_dbind; ++ ++ assert(snprintf(b,sizeof(b),"%-.*s%s",sysd->st.st_fillp,sysd->st.st_self,a)>0) ++ printf("loading %s\n",b); ++ fflush(stdout); ++ load(b); ++ ++} +--- gcl-2.6.7.orig/unixport/sys_gcl.c ++++ gcl-2.6.7/unixport/sys_gcl.c +@@ -1,62 +1,9 @@ +-#include +-#include +-#include "../h/include.h" +- +-extern object user_init(); +- +- +-void gcl_init_or_load1 (void (*)(void),char *); +-#define init_or_load(fn,file) do {extern void fn(void); gcl_init_or_load1(fn,file);} \ +- while(0) +- +-/* #define mjoin(a,b) a ## b */ +-/* #define Mjoin(a,b) mjoin(a,b) */ +- +-#define ar_init(a) do {\ +- char b[200];\ +- \ +- if (snprintf(b,sizeof(b),"ar x %-*.*slibgcl.a %s.o",\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_self,#a)<=0)\ +- error("Cannot unpack module " #a "o\n");\ +- if (system(b)) \ +- error("Cannot run ar command to unpack module " #a ".o\n");\ +- init_or_load(Mjoin(init_,a),#a ".o");\ +- if (unlink(#a ".o"))\ +- error("Cannot unlink " #a ".o\n");\ +-} while(0) +- +-#define ar_check_init(a,b) do {\ +- object t;\ +- \ +- for (t=b->s.s_dbind;!endp(t) && type_of(t->c.c_car)==t_string && strcmp(#a,t->c.c_car->st.st_self);t=t->c.c_cdr);\ +- if (endp(t))\ +- ar_init(a);\ +-} while(0) +- +- +-static void +-load1(x) +- char *x; +-{printf("loading %s\n",x); +- fflush(stdout); +- load(x);} +- +-#define lsp_init(a) do {\ +- char b[200];\ +- \ +- if (snprintf(b,sizeof(b),"%-*.*s%s",\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_self,a)<=0)\ +- error("Cannot append system directory\n");\ +- load1(b);\ +-} while(0) ++#define FLAVOR "" ++ ++#include "sys.c" + + void +-gcl_init_init() +-{ ++gcl_init_init() { + + build_symbol_table(); + +@@ -72,8 +19,7 @@ gcl_init_init() + } + + void +-gcl_init_system(object no_init) +-{ ++gcl_init_system(object no_init) { + + if (type_of(no_init)!=t_symbol) + error("Supplied no_init is not of type symbol\n"); +@@ -131,7 +77,25 @@ gcl_init_system(object no_init) + ar_check_init(gcl_cmpvar,no_init); + ar_check_init(gcl_cmpvs,no_init); + ar_check_init(gcl_cmpwt,no_init); ++ ar_check_init(gcl_cmpmain,no_init); + ++#ifdef HAVE_XGCL ++ lsp_init("../xgcl-2/sysdef.lisp"); ++ ar_check_init(gcl_Xlib,no_init); ++ ar_check_init(gcl_Xutil,no_init); ++ ar_check_init(gcl_X,no_init); ++ ar_check_init(gcl_XAtom,no_init); ++ ar_check_init(gcl_defentry_events,no_init); ++ ar_check_init(gcl_Xstruct,no_init); ++ ar_check_init(gcl_XStruct_l_3,no_init); ++ ar_check_init(gcl_general,no_init); ++ ar_check_init(gcl_keysymdef,no_init); ++ ar_check_init(gcl_X10,no_init); ++ ar_check_init(gcl_Xinit,no_init); ++ ar_check_init(gcl_dwtrans,no_init); ++ ar_check_init(gcl_tohtml,no_init); ++ ar_check_init(gcl_index,no_init); ++#endif + + } + +--- gcl-2.6.7.orig/unixport/sys_ansi_gcl.c ++++ gcl-2.6.7/unixport/sys_ansi_gcl.c +@@ -1,58 +1,7 @@ +-#include +-#include +-#include "../h/include.h" +- +-extern object user_init(); +- +- +-void gcl_init_or_load1 (void (*)(void),char *); +-#define init_or_load(fn,file) do {extern void fn(void); gcl_init_or_load1(fn,file);} \ +- while(0) +- +-/* #define mjoin(a,b) a ## b */ +-/* #define Mjoin(a,b) mjoin(a,b) */ +- +-#define ar_init(a) do {\ +- char b[200];\ +- \ +- if (snprintf(b,sizeof(b),"ar x %-*.*slibansi_gcl.a %s.o",\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_self,#a)<=0)\ +- error("Cannot unpack module " #a "o\n");\ +- if (system(b)) \ +- error("Cannot run ar command to unpack module " #a ".o\n");\ +- init_or_load(Mjoin(init_,a),#a ".o");\ +- if (unlink(#a ".o"))\ +- error("Cannot unlink " #a ".o\n");\ +-} while(0) +- +-#define ar_check_init(a,b) do {\ +- object t;\ +- \ +- for (t=b->s.s_dbind;!endp(t) && type_of(t->c.c_car)==t_string && strcmp(#a,t->c.c_car->st.st_self);t=t->c.c_cdr);\ +- if (endp(t))\ +- ar_init(a);\ +-} while(0) +- +- +-static void +-load1(x) +- char *x; +-{printf("loading %s\n",x); +- fflush(stdout); +- load(x);} +- +-#define lsp_init(a) do {\ +- char b[200];\ +- \ +- if (snprintf(b,sizeof(b),"%-*.*s%s",\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_self,a)<=0)\ +- error("Cannot append system directory\n");\ +- load1(b);\ +-} while(0) ++#define FLAVOR "ansi_" ++ ++#include "sys.c" ++ + + void + gcl_init_init() +@@ -131,7 +80,26 @@ gcl_init_system(object no_init) + ar_check_init(gcl_cmpvar,no_init); + ar_check_init(gcl_cmpvs,no_init); + ar_check_init(gcl_cmpwt,no_init); ++ ar_check_init(gcl_cmpmain,no_init); + ++#ifdef HAVE_XGCL ++ lsp_init("../xgcl-2/sysdef.lisp"); ++ ar_check_init(gcl_Xlib,no_init); ++ ar_check_init(gcl_Xutil,no_init); ++ ar_check_init(gcl_X,no_init); ++ ar_check_init(gcl_XAtom,no_init); ++ ar_check_init(gcl_defentry_events,no_init); ++ ar_check_init(gcl_Xstruct,no_init); ++ ar_check_init(gcl_XStruct_l_3,no_init); ++ ar_check_init(gcl_general,no_init); ++ ar_check_init(gcl_keysymdef,no_init); ++ ar_check_init(gcl_X10,no_init); ++ ar_check_init(gcl_Xinit,no_init); ++ ar_check_init(gcl_dwtrans,no_init); ++ ar_check_init(gcl_tohtml,no_init); ++ ar_check_init(gcl_index,no_init); ++#endif ++ + ar_check_init(gcl_pcl_pkg,no_init); + ar_check_init(gcl_pcl_walk,no_init); + ar_check_init(gcl_pcl_iterate,no_init); +--- gcl-2.6.7.orig/unixport/init_pcl_gcl.lsp.in ++++ gcl-2.6.7/unixport/init_pcl_gcl.lsp.in +@@ -39,7 +39,7 @@ + (dolist (d (list lsp cmpnew pcl)) + (load (make-pathname :name "sys-proclaim" :type "lisp" :directory d))) + (load (make-pathname :name "tk-package" :type "lsp" :directory gtk)) +- (load (make-pathname :name "gcl_cmpmain" :type "lsp" :directory cmpnew)) ++; (load (make-pathname :name "gcl_cmpmain" :type "lsp" :directory cmpnew)) + (load (make-pathname :name "gcl_lfun_list" :type "lsp" :directory cmpnew)) + (load (make-pathname :name "gcl_cmpopt" :type "lsp" :directory cmpnew)) + (load (make-pathname :name "gcl_auto_new" :type "lsp" :directory lsp)) +@@ -93,7 +93,8 @@ + (cond ((si::get-command-arg "-batch") + (setq si::*top-level-hook* 'bye)) + ((si::get-command-arg "-f")) +- (t (format t si::*system-banner*))) ++ (t (format t si::*system-banner*) ++ (format t "Temporary directory for compiler files set to ~a~%" *tmp-dir*))) + (setq si::*ihs-top* 1) + (in-package 'system::user) (incf system::*ihs-top* 2) + (funcall system::*old-top-level*)) +--- /dev/null ++++ gcl-2.6.7/unixport/msys.c +@@ -0,0 +1,85 @@ ++#include ++#include ++#include ++ ++#define massert(a_) if (!(a_)) msys_err(l,#a_,__LINE__,__FILE__,__FUNCTION__) ++ ++static int ++msys_err(FILE *l,const char *a,unsigned n,const char *f,const char *fn) { ++ ++ if (l) { ++ fprintf(l,"The assertion %s on line %d of %s in function %s failed", a,n,f,fn); ++ fflush(l); ++ fclose(l); ++ } ++ ++ exit(-1); ++ ++} ++ ++int ++main(int argc,char * argv[]) { ++ ++#ifdef _WIN32 ++ return 0; ++#else ++ ++ char b[4096]; ++ FILE *f,*l=NULL; ++ char *n=argv[2],*t=argv[3],*ln=argc>4 ? argv[4] : NULL,c,c1; ++ int r=0; ++ ++ if (fork()) return 0; ++ ++ if (chdir(argv[1])) exit(-1); ++ ++ if (ln) ++ l=fopen(ln,"w"); ++ ++ massert(f=fopen(n,"w")); ++ massert(fprintf(f,"%c\n",c=c1='0')==2); ++ massert(!fclose(f)); ++ ++ for (;;usleep(10000)) { ++ ++ massert(f=fopen(n,"r")); ++ c=fgetc(f); ++ massert(!fclose(f)); ++ ++ if (c==EOF) { ++ if (l) ++ fclose(l); ++ exit(0); ++ } ++ ++ if (c==c1) ++ continue; ++ ++ massert(f=fopen(n,"r")); ++ massert(fgets(b,sizeof(b),f)==b); ++ massert(!fclose(f)); ++ ++ r=system(b); ++ ++ if (l) { ++ fprintf(l,"%d %s\n",r,b); ++ fflush(l); ++ } ++ ++ massert(f=fopen(t,"w")); ++ massert(fprintf(f,"%d\n",r)>0); ++ massert(!fclose(f)); ++ ++ massert(f=fopen(t,"r")); ++ c1=fgetc(f); ++ massert(!fclose(f)); ++ ++ massert(!rename(t,n)); ++ ++ } ++ ++ return 0; ++ ++#endif ++ ++} +--- gcl-2.6.7.orig/unixport/makefile ++++ gcl-2.6.7/unixport/makefile +@@ -4,16 +4,20 @@ LIBC = -lc + + -include ../makedefs + ++RSYM= ++ + HDIR = ../h + ODIR = ../o + MDIR = ../mod + LSPDIR = ../lsp + CMPDIR = ../cmpnew ++XDIR = ../xgcl-2 + CLCSDIR = ../clcs + PCLDIR = ../pcl + PORTDIR = $(shell pwd) + +-LD_LIBS_PRE=$(FIRST_FILE) $(addprefix -u ,$(PATCHED_SYMBOLS)) ++LD_FLAGS=$(LDFLAGS) $(FIRST_FILE) ++LD_LIBS_PRE=$(addprefix -u ,$(PATCHED_SYMBOLS)) + LD_LIBS_POST=$(LIBS) $(LIBC) -lgclp $(LAST_FILE) + + ifeq ($(ARRS),) +@@ -24,7 +28,7 @@ libgclp.a: $(ODIR)/gcllib.a + cp $< $@ + ranlib $@ + +-gmpfiles: $(shell find ../$(GMPDIR) -name "*.o" |grep -v '\.lib') ++gmpfiles: $(shell [ -z "$(GMPDIR)" ] || find ../$(GMPDIR) -name "*.o" |grep -v '\.lib') + rm -rf gmp + mkdir gmp + a="$^" ; \ +@@ -33,7 +37,7 @@ gmpfiles: $(shell find ../$(GMPDIR) -nam + done + touch $@ + +-bfdfiles: $(shell find ../binutils -name "*.o") ++bfdfiles: $(shell ! [ -d ../binutils ] || find ../binutils -name "*.o") + rm -rf bfd + mkdir bfd + a="$^" ; \ +@@ -42,16 +46,17 @@ bfdfiles: $(shell find ../binutils -name + done + touch $@ + +-OOBJS:=$(shell j=$$(ar t $(ODIR)/gcllib.a) ; for i in $$(ls -1 $(ODIR)/*.o) ; do if ! echo $$j |grep $$(basename $$i) >/dev/null 2>&1 ; then echo $$i ; fi ; done) ++OOBJS:=$(shell j=$$(ar t $(ODIR)/gcllib.a) ; for i in $$(find $(ODIR) -name "*.o") ; do if ! echo $$j |grep $$(basename $$i) >/dev/null 2>&1 ; then echo $$i ; fi ; done) + OOBJS:=$(filter-out $(FIRST_FILE),$(OOBJS)) + OOBJS:=$(filter-out $(LAST_FILE),$(OOBJS)) + OOBJS:=$(filter-out $(ODIR)/plttest.o,$(OOBJS)) +-OBJS:=$(OOBJS) $(shell ls -1 $(LSPDIR)/*.o) +-OBJS:=$(OBJS) $(shell ls -1 $(CMPDIR)/*.o | grep -v collectfn.o) +- +-MODOBJS:=$(shell ls -1 $(MDIR)/*.o) +-PCLOBJS:=$(MODOBJS) $(shell ls -1 $(PCLDIR)/*.o) +-ANSIOBJS:=$(PCLOBJS) $(shell ls -1 $(CLCSDIR)/*.o) ++OBJS:=$(OOBJS) $(shell find $(LSPDIR) -name "*.o") ++OBJS:=$(OBJS) $(shell find $(XDIR) -name "*.o") ++OBJS:=$(OBJS) $(shell find $(CMPDIR) -name "*.o" | grep -v collectfn.o) ++ ++#MODOBJS:=$(shell find $(MDIR) -name "*.o") ++PCLOBJS:=$(shell find $(PCLDIR) -name "*.o") ++ANSIOBJS:=$(PCLOBJS) $(shell find $(CLCSDIR) -name "*.o") + + $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.lsp + cp $< $@ +@@ -72,10 +77,10 @@ init_xgcl.lsp.tmp: init_gcl.lsp.tmp + + init_pcl_gcl.lsp.tmp: init_pcl_gcl.lsp.in ../cmpnew/gcl_cmpmain.lsp \ + ../pcl/sys-package.lisp ../clcs/package.lisp \ +- $(shell ls -1 ../clcs/clcs_*.lisp) ++ $(shell find ../clcs/ -name "clcs_*.lisp") + + awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} {if (i==0) print}' $< >$@ +- cat ../cmpnew/gcl_cmpmain.lsp >>$@ ++# cat ../cmpnew/gcl_cmpmain.lsp >>$@ + cat ../pcl/sys-package.lisp >>$@ + awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} {if (i==1) print}' $< >>$@ + +@@ -84,7 +89,7 @@ init_ansi_gcl.lsp.tmp: init_ansi_gcl.lsp + + awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \ + /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==0) print}' $< >$@ +- cat ../cmpnew/gcl_cmpmain.lsp >>$@ ++# cat ../cmpnew/gcl_cmpmain.lsp >>$@ + cat ../pcl/sys-package.lisp >>$@ + awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \ + /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==1) print}' $< >>$@ +@@ -101,13 +106,13 @@ init_%.lsp: init_%.lsp.tmp + -e "s#@LI-MINVERS@#`cat ../minvers | cut -f1 -d.`#1" \ + -e "s#@LI-MAJVERS@#`cat ../majvers`#1" \ + -e "s#@LI-CC@#\"$(CC) -c $(FINAL_CFLAGS)\"#1" \ +- -e "s#@LI-LD@#\"$(CC) -o \"#1" \ ++ -e "s#@LI-LD@#\"$(CC) $(LD_FLAGS) -o \"#1" \ + -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST)\"#1" \ + -e "s#@LI-OPT-THREE@#\"$(O3FLAGS)\"#1" \ + -e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \ + -e "s#@LI-INIT-LSP@#\"$@\"#1" >$@ + +-saved_%:raw_% $(RSYM) init_%.lsp raw_%_map \ ++saved_%:raw_% $(RSYM) init_%.lsp raw_%_map msys \ + $(CMPDIR)/gcl_cmpmain.lsp \ + $(CMPDIR)/gcl_lfun_list.lsp \ + $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \ +@@ -115,10 +120,14 @@ saved_%:raw_% $(RSYM) init_%.lsp raw_%_m + + cp init_$*.lsp foo + echo " (in-package \"USER\")(system:save-system \"$@\")" >>foo ++ ar x lib$*.a $$(ar t lib$*.a |grep ^gcl_) + $(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo + + $(RSYM): $(SPECIAL_RSYM) $(HDIR)/mdefs.h +- $(CC) $(CFLAGS) -I$(HDIR) -I$(ODIR) -o $(RSYM) $(SPECIAL_RSYM) ++ $(CC) $(LD_FLAGS) $(CFLAGS) -I$(HDIR) -I$(ODIR) -o $(RSYM) $(SPECIAL_RSYM) ++ ++msys: msys.c ++ PATH=/usr/bin:$$PATH gcc $< -o $@ # Unix binary if running wine + + $(HDIR)/mdefs.h: $(HDIR)/include.h + cat $(HDIR)/include.h | sed -e "/include/d" > $(HDIR)/mdefs.h +@@ -131,9 +140,9 @@ libpre_gcl.a: $(OOBJS) sys_pre_gcl.o gmp + rm -rf $@ + $(ARRS) $@ $(filter %.o,$^) $(shell find gmp bfd -name "*.o") + +-libmod_gcl.a: $(OBJS) $(MODOBJS) sys_mod_gcl.o gmpfiles bfdfiles # plt_mod_gcl.o +- rm -rf $@ +- $(ARRS) $@ $(filter %.o,$^) $(shell find gmp bfd -name "*.o") ++#libmod_gcl.a: $(OBJS) $(MODOBJS) sys_mod_gcl.o gmpfiles bfdfiles # plt_mod_gcl.o ++# rm -rf $@ ++# $(ARRS) $@ $(filter %.o,$^) $(shell find gmp bfd -name "*.o") + + libxgcl.a: libgcl.a + ln -snf $< $@ +@@ -146,14 +155,12 @@ libpcl_gcl.a: $(OBJS) $(PCLOBJS) sys_pcl + rm -rf $@ + $(ARRS) $@ $(filter %.o,$^) $(shell find gmp bfd -name "*.o") + +-raw_%_map raw_%: lib%.a libgclp.a $(SYSTEM_OBJS) $(EXTRAS) ++raw_%_map raw_%: lib%.a libgclp.a $(SYSTEM_OBJS) #$(EXTRAS) + touch raw_$*_map + ifeq ($(GNU_LD),1) +- $(CC) -o raw_$*$(EXE) $(filter %.o,$^) \ +- -L. $(EXTRA_LD_LIBS) -Wl,-Map raw_$*_map $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST) ++ $(CC) $(LD_FLAGS) -o raw_$*$(EXE) $(filter %.o,$^) -L. $(EXTRA_LD_LIBS) -Wl,-Map raw_$*_map $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST) + else +- $(CC) -o raw_$*$(EXE) $(filter %.o,$^) \ +- -L. $(EXTRA_LD_LIBS) $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST) ++ $(CC) $(LD_FLAGS) -o raw_$*$(EXE) $(filter %.o,$^) -L. $(EXTRA_LD_LIBS) $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST) + endif + # diff map_$* map_$*.old >/dev/null || (cp map_$* map_$*.old && rm -f $@ && $(MAKE) $@) + # cp map_$*.old map_$* +@@ -161,21 +168,21 @@ endif + map_%: + touch $@ + +-plt_%.h: map_% +- cat $< | awk '/^ .plt/ {if (NF==4) i=1;next;} \ +- {if (!NF) i=0; if (!i) next; } \ +- {b=$$2; sub("@.*$$","",b);print "{\"" b "\"," $$1 "}"}' | \ +- sort | awk '{A[++k]=$$0} END {for (i=1;i<=k;i++) \ ++#plt_%.h: map_% ++# cat $< | awk '/^ .plt/ {if (NF==4) i=1;next;} \ ++# {if (!NF) i=0; if (!i) next; } \ ++# {b=$$2; sub("@.*$$","",b);print "{\"" b "\"," $$1 "}"}' | \ ++# sort | awk '{A[++k]=$$0} END {for (i=1;i<=k;i++) \ + printf("%s%s\n",A[i],i==k ? "" : ",")}' >$@ + +-plt_%.o: plt_%.h plt.c +- ln -snf $< plt.h +- $(CC) -c -o $@ plt.c $(CFLAGS) -I$(HDIR) -I$(ODIR) ++#plt_%.o: plt_%.h plt.c ++# ln -snf $< plt.h ++# $(CC) $(LD_FLAGS) -c -o $@ plt.c $(CFLAGS) -I$(HDIR) -I$(ODIR) + + clean: + rm -rf saved_*$(EXE) raw_*$(EXE) *.o core a.out $(RSYM) \ + $(LSPDIR)/auto_new.lsp foo *maxima* init_*.lsp lib*.a gmp* bfd* *.lsp.tmp \ +- gazonk*.lsp plt*h *_map saved_* lib* raw_* ++ gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* + + .INTERMEDIATE: init_ansi_gcl.lsp.tmp init_gcl.lsp.tmp raw_gcl raw_ansi_gcl +-.PRECIOUS: init_gcl.lsp init_ansi_gcl.lsp ++.PRECIOUS: init_pre_gcl.lsp init_gcl.lsp init_ansi_gcl.lsp +--- gcl-2.6.7.orig/unixport/init_pre_gcl.lsp.in ++++ gcl-2.6.7/unixport/init_pre_gcl.lsp.in +@@ -86,7 +86,8 @@ + (cond ((si::get-command-arg "-batch") + (setq si::*top-level-hook* 'bye)) + ((si::get-command-arg "-f")) +- (t (format t si::*system-banner*))) ++ (t (format t si::*system-banner*) ++ (format t "Temporary directory for compiler files set to ~a~%" *tmp-dir*))) + (setq si::*ihs-top* 1) + (in-package 'system::user) (incf system::*ihs-top* 2) + (funcall system::*old-top-level*)) +--- gcl-2.6.7.orig/unixport/ansi_cl.lisp ++++ gcl-2.6.7/unixport/ansi_cl.lisp +@@ -126,7 +126,7 @@ make-load-form-saving-slots make-method + pprint-dispatch pprint-exit-if-list-exhausted pprint-fill + pprint-indent pprint-linear pprint-logical-block pprint-newline + pprint-pop pprint-tab pprint-tabular print-not-readable-object +-print-unreadable-object read-sequence readtable-case row-major-aref ++print-unreadable-object readtable-case row-major-aref + set-pprint-dispatch simple-condition-format-control + stream-external-format synonym-stream-symbol + translate-logical-pathname translate-pathname +@@ -134,7 +134,7 @@ two-way-stream-input-stream two-way-stre + unbound-slot-instance + upgraded-complex-part-type wild-pathname-p with-compilation-unit + with-condition-restarts with-package-iterator with-standard-io-syntax +-write-sequence )) ++ )) + (shadowing-import (list s) "COMMON-LISP")) + + (use-package "ANSI-LOOP" "COMMON-LISP") +--- gcl-2.6.7.orig/unixport/sys_pcl_gcl.c ++++ gcl-2.6.7/unixport/sys_pcl_gcl.c +@@ -1,58 +1,7 @@ +-#include +-#include +-#include "../h/include.h" +- +-extern object user_init(); +- +- +-void gcl_init_or_load1 (void (*)(void),char *); +-#define init_or_load(fn,file) do {extern void fn(void); gcl_init_or_load1(fn,file);} \ +- while(0) +- +-/* #define mjoin(a,b) a ## b */ +-/* #define Mjoin(a,b) mjoin(a,b) */ +- +-#define ar_init(a) do {\ +- char b[200];\ +- \ +- if (snprintf(b,sizeof(b),"ar x %-*.*slibpcl_gcl.a %s.o",\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_self,#a)<=0)\ +- error("Cannot unpack module " #a "o\n");\ +- if (system(b)) \ +- error("Cannot run ar command to unpack module " #a ".o\n");\ +- init_or_load(Mjoin(init_,a),#a ".o");\ +- if (unlink(#a ".o"))\ +- error("Cannot unlink " #a ".o\n");\ +-} while(0) +- +-#define ar_check_init(a,b) do {\ +- object t;\ +- \ +- for (t=b->s.s_dbind;!endp(t) && type_of(t->c.c_car)==t_string && strcmp(#a,t->c.c_car->st.st_self);t=t->c.c_cdr);\ +- if (endp(t))\ +- ar_init(a);\ +-} while(0) +- +- +-static void +-load1(x) +- char *x; +-{printf("loading %s\n",x); +- fflush(stdout); +- load(x);} +- +-#define lsp_init(a) do {\ +- char b[200];\ +- \ +- if (snprintf(b,sizeof(b),"%-*.*s%s",\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ +- sSAsystem_directoryA->s.s_dbind->st.st_self,a)<=0)\ +- error("Cannot append system directory\n");\ +- load1(b);\ +-} while(0) ++#define FLAVOR "pcl_" ++ ++#include "sys.c" ++ + + void + gcl_init_init() +@@ -131,7 +80,26 @@ gcl_init_system(object no_init) + ar_check_init(gcl_cmpvar,no_init); + ar_check_init(gcl_cmpvs,no_init); + ar_check_init(gcl_cmpwt,no_init); ++ ar_check_init(gcl_cmpmain,no_init); + ++#ifdef HAVE_XGCL ++ lsp_init("../xgcl-2/sysdef.lisp"); ++ ar_check_init(gcl_Xlib,no_init); ++ ar_check_init(gcl_Xutil,no_init); ++ ar_check_init(gcl_X,no_init); ++ ar_check_init(gcl_XAtom,no_init); ++ ar_check_init(gcl_defentry_events,no_init); ++ ar_check_init(gcl_Xstruct,no_init); ++ ar_check_init(gcl_XStruct_l_3,no_init); ++ ar_check_init(gcl_general,no_init); ++ ar_check_init(gcl_keysymdef,no_init); ++ ar_check_init(gcl_X10,no_init); ++ ar_check_init(gcl_Xinit,no_init); ++ ar_check_init(gcl_dwtrans,no_init); ++ ar_check_init(gcl_tohtml,no_init); ++ ar_check_init(gcl_index,no_init); ++#endif ++ + ar_check_init(gcl_pcl_pkg,no_init); + ar_check_init(gcl_pcl_walk,no_init); + ar_check_init(gcl_pcl_iterate,no_init); +--- gcl-2.6.7.orig/cmpnew/gcl_cmplam.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmplam.lsp +@@ -929,8 +929,7 @@ + (dolist** (kwd keywords) + (let ((cvar1 (next-cvar))) + (wt-nl +- "{object V" cvar1 "=getf(V" cvar ",VV[" (add-symbol (car kwd)) +- "],OBJNULL);") ++ "{object V" cvar1 "=getf(V" cvar "," (vv-str (add-symbol (car kwd))) ",OBJNULL);") + (wt-nl "if(V" cvar1 "==OBJNULL){") + (let ((*clink* *clink*) + (*unwind-exit* *unwind-exit*) +@@ -950,7 +949,7 @@ + (not allow-other-keys)) + (wt-nl "check_other_key(V" cvar "," (length keywords)) + (dolist** (kwd keywords) +- (wt ",VV[" (add-symbol (car kwd)) "]")) ++ (wt "," (vv-str (add-symbol (car kwd))))) + (wt ");")) + (dolist** (aux auxs) + (c2dm-bind-init (car aux) (cadr aux))) +--- gcl-2.6.7.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmpmain.lsp +@@ -28,6 +28,7 @@ + + + (export '(*compile-print* *compile-verbose*)) ++(import 'si::*tmp-dir* 'compiler) + + ;;; This had been true with Linux 1.2.13 a.out or even older + ;;; #+linux (push :ld-not-accept-data *features*) +@@ -76,10 +77,9 @@ + name) + :type ext)))) + +- + (defun safe-system (string) + (multiple-value-bind +- (code result) (system string) ++ (code result) (system (ts string)) + (unless (and (zerop code) (zerop result)) + (cerror "Continues anyway." + "(SYSTEM ~S) returned a non-zero value ~D." +@@ -149,7 +149,7 @@ + (setq args (append args (list :output-file (car args))))) + (return + (prog1 (apply 'compile-file gaz (cdr args)) +- (unless *keep-gaz* (delete-file gaz)))) ++ (unless *keep-gaz* (mdelete-file gaz)))) + )) + (t nil)) + (if (consp *split-files*) +@@ -279,41 +279,47 @@ Cannot compile ~a.~%" + + (wt-data-begin) + +- (let* ((rtb *readtable*) +- (prev (and (eq (get-macro-character #\# rtb) +- (get-macro-character +- #\# (si:standard-readtable))) +- (get-dispatch-macro-character #\# #\, rtb)))) +- (if (and prev (eq prev (get-dispatch-macro-character +- #\# #\, (si:standard-readtable)))) +- (set-dispatch-macro-character #\# #\, +- 'si:sharp-comma-reader-for-compiler rtb) +- (setq prev nil)) ++ (if *compiler-compile* ++ (t1expr *compiler-compile*) ++ (let* ((rtb *readtable*) ++ (prev (and (eq (get-macro-character #\# rtb) ++ (get-macro-character ++ #\# (si:standard-readtable))) ++ (get-dispatch-macro-character #\# #\, rtb)))) ++ (if (and prev (eq prev (get-dispatch-macro-character ++ #\# #\, (si:standard-readtable)))) ++ (set-dispatch-macro-character #\# #\, ++ 'si:sharp-comma-reader-for-compiler rtb) ++ (setq prev nil)) + + ;; t1expr the package ops again.. + (if (consp *split-files*) + (dolist (v (fourth *split-files*)) (t1expr v))) +- (unwind-protect +- (do ((form (read *compiler-input* nil eof) +- (read *compiler-input* nil eof)) +- (load-flag (or (eq :defaults *eval-when-defaults*) +- (member 'load *eval-when-defaults*)))) +- (nil) +- (cond +- ((eq form eof)) +- (load-flag (t1expr form)) +- ((maybe-eval nil form))) +- (cond +- ((and *split-files* (check-end form eof)) +- (setf (fourth *split-files*) (reverse (third *data*))) +- (return nil)) +- ((eq form eof) (return nil))) +- ) ++ (unwind-protect ++ (do ((form (read *compiler-input* nil eof) ++ (read *compiler-input* nil eof)) ++ (load-flag (or (eq :defaults *eval-when-defaults*) ++ (member 'load *eval-when-defaults*)))) ++ (nil) ++ (cond ++ ((eq form eof)) ++ (load-flag (t1expr form)) ++ ((maybe-eval nil form))) ++ (cond ++ ((and *split-files* (check-end form eof)) ++ (setf (fourth *split-files*) (reverse (third *data*))) ++ (return nil)) ++ ((eq form eof) (return nil))) ++ ) + +- +- (when prev (set-dispatch-macro-character #\# #\, prev rtb))))) +- +- (setq *init-name* (init-name input-pathname system-p)) ++ ++ (when prev (set-dispatch-macro-character #\# #\, prev rtb)))))) ++ ++ (setq *init-name* (init-name input-pathname system-p)) ++; (let ((x (merge-pathnames #".o" o-pathname))) ++; (with-open-file (s x :if-does-not-exist :create) ++; (setq *init-name* (init-name x system-p))) ++; (mdelete-file x)) + + (when (zerop *error-count*) + (when *compile-verbose* (format t "~&End of Pass 1. ~%")) +@@ -341,7 +347,7 @@ Cannot compile ~a.~%" + (when fasl-file + (compiler-build ob-pathname fasl-pathname) + (when load (load fasl-pathname))) +- (unless ob-file (delete-file ob-pathname)) ++ (unless ob-file (mdelete-file ob-pathname)) + (when *compile-verbose* + (print-compiler-info) + (format t "~&Finished compiling ~a.~%" (namestring output-file)) +@@ -352,9 +358,9 @@ Cannot compile ~a.~%" + (print-compiler-info) + (format t "~&Finished compiling ~a.~%" (namestring output-file) + ))) +- (unless c-file (delete-file c-pathname)) +- (unless h-file (delete-file h-pathname)) +- (unless fasl-file (delete-file fasl-pathname))) ++ (unless c-file (mdelete-file c-pathname)) ++ (unless h-file (mdelete-file h-pathname)) ++ (unless fasl-file (mdelete-file fasl-pathname))) + + + (progn +@@ -377,25 +383,27 @@ Cannot compile ~a.~%" + (print-compiler-info) + (format t "~&Finished compiling ~a.~%" (namestring output-file) + ))) +- (unless c-file (delete-file c-pathname)) +- (unless h-file (delete-file h-pathname)) +- (unless (or data-file #+ld-not-accept-data t system-p) (delete-file data-pathname)) ++ (unless c-file (mdelete-file c-pathname)) ++ (unless h-file (mdelete-file h-pathname)) ++ (unless (or data-file #+ld-not-accept-data t system-p) (mdelete-file data-pathname)) + o-pathname) + + (progn +- (when (probe-file c-pathname) (delete-file c-pathname)) +- (when (probe-file h-pathname) (delete-file h-pathname)) +- (when (probe-file data-pathname) (delete-file data-pathname)) ++ (when (probe-file c-pathname) (mdelete-file c-pathname)) ++ (when (probe-file h-pathname) (mdelete-file h-pathname)) ++ (when (probe-file data-pathname) (mdelete-file data-pathname)) + (format t "~&No FASL generated.~%") + (setq *error-p* t) + (values) + )))))) + +-(defun gazonk-name ( &aux tem) ++(defun gazonk-name () + (dotimes (i 1000) +- (unless (probe-file (setq tem (merge-pathnames (format nil "gazonk~d.lsp" i)))) +- (return-from gazonk-name (pathname tem)))) +- (error "1000 gazonk names used already!")) ++ (let ((tem (merge-pathnames ++ (format nil "~agazonk_~d_~d.lsp" (if (boundp '*tmp-dir*) *tmp-dir* "") (abs (si::getpid)) i)))) ++ (unless (probe-file tem) ++ (return-from gazonk-name (pathname tem))))) ++ (error "1000 gazonk names used already!")) + + (defun prin1-cmp (form strm) + (let ((*compiler-output-data* strm) +@@ -421,20 +429,17 @@ Cannot compile ~a.~%" + (values name nil nil)) + ((and (setq tem (symbol-function name)) + (consp tem)) +- (let ((na (if (symbol-package name) name 'cmp-anon)) +- (tem (if *keep-gaz* tem (wrap-literals tem)))) ++ (let ((na (if (symbol-package name) name 'cmp-anon))) + (unless (and (fboundp 'si::init-cmp-anon) (or (si::init-cmp-anon) (fmakunbound 'si::init-cmp-anon))) + (with-open-file +- (st (setq gaz (gazonk-name)) :direction :output) +- (prin1-cmp `(defun ,na ,@ (ecase (car tem) +- (lambda (cdr tem)) +- (lambda-block (cddr tem)) +- )) st)) +- (let ((fi (let ((*compiler-compile* t)) ++ (st (setq gaz (gazonk-name)) :direction :output)) ++ (let ((fi (let ((*compiler-compile* `(defun ,na ,@ (ecase (car tem) ++ (lambda (cdr tem)) ++ (lambda-block (cddr tem)))))) + (compile-file gaz)))) + (load fi) +- (delete-file fi)) +- (unless *keep-gaz* (delete-file gaz))) ++ (mdelete-file fi)) ++ (unless *keep-gaz* (mdelete-file gaz))) + (or (eq na name) (setf (symbol-function name) (symbol-function na))) + ;; FIXME -- support warnings-p and failures-p. CM 20041119 + (values (symbol-function name) nil nil) +@@ -471,7 +476,7 @@ Cannot compile ~a.~%" + (on (get-output-pathname gaz "o" gaz ))) + (with-open-file (st cn) + (do () ((let ((a (read-line st))) +- (when (>= (si::string-match "gazonk[0-9]*.h" a) 0) ++ (when (>= (si::string-match "gazonk_[0-9]*_[0-9]*.h" a) 0) + (format t "~%~d~%" a) + a)))) + (si::copy-stream st *standard-output*)) +@@ -479,17 +484,22 @@ Cannot compile ~a.~%" + (si::copy-stream st *standard-output*)) + (with-open-file (st hn) + (si::copy-stream st *standard-output*)) +- (system (si::string-concatenate "objdump -d -l " +- (namestring on))) +- (delete-file cn) +- (delete-file dn) +- (delete-file hn) +- (delete-file on) +- (unless *keep-gaz* (delete-file gaz))))) ++ (safe-system (si::string-concatenate "objdump -d -l " (namestring on))) ++ (mdelete-file cn) ++ (mdelete-file dn) ++ (mdelete-file hn) ++ (mdelete-file on) ++ (unless *keep-gaz* (mdelete-file gaz))))) + (t (error "can't disassemble ~a" name)))) + + +-(defun compiler-pass2 (c-pathname h-pathname system-p ) ++(defun compiler-pass2 (c-pathname h-pathname system-p ++ &aux ++ (ci *cmpinclude*) ++ (ci (when (stringp ci) (subseq ci 1 (1- (length ci))))) ++ (ci (concatenate 'string si::*system-directory* "../h/" ci)) ++ (system-p (when (or (eq system-p 'disassemble) (probe-file ci)) system-p))) ++ (declare (special *init-name*)) + (with-open-file (st c-pathname :direction :output) + (let ((*compiler-output1* (if (eq system-p 'disassemble) *standard-output* + st))) +@@ -598,17 +608,29 @@ SYSTEM_SPECIAL_INIT + (finish (subseq s (1+ pos)))) + (prep-win-path-acc finish (concatenate 'string acc start "~"))) + (concatenate 'string acc s)))) +-#+winnt (defun prep-win-path ( s ) (prep-win-path-acc s "")) + +-(defun compiler-cc (c-pathname o-pathname ) ++#+winnt ++(defun no-device (c) ++ (let* ((c (namestring (truename c))) ++ (p (search ":" c))) ++ (if p (subseq c (1+ p)) c))) ++ ++;; #+winnt ++;; (defun prep-win-path (c o) ++;; (let* ((w si::*wine-detected*) ++;; (c (if w (no-device c) c)) ++;; (o (if w (no-device o) o))) ++;; (prep-win-path-acc (compiler-command c o) ""))) ++ ++(defun compiler-cc (c-pathname o-pathname) + (safe-system +- (format ++ (format + nil + (prog1 + #+irix5 (compiler-command c-pathname o-pathname ) + #+vax "~a ~@[~*-O ~]-S -I. -w ~a ; as -J -W -o ~A ~A" + #+(or system-v e15 dgux sgi ) "~a ~@[~*-O ~]-c -I. ~a 2> /dev/null" +- #+winnt (prep-win-path (compiler-command c-pathname o-pathname )) ++ #+winnt (prep-win-path-acc (compiler-command c-pathname o-pathname) "") + #-winnt (compiler-command c-pathname o-pathname) + ) + *cc* +@@ -687,7 +709,7 @@ SYSTEM_SPECIAL_INIT + :name (or (pathname-name pa) :wild) + :type (pathname-type pa))) + (setq name (namestring pa)) +- (system (format nil "ls -d ~a > ~a" name temp)) ++ (safe-system (format nil "ls -d ~a > ~a" name temp)) + (with-open-file (st temp) + (loop (setq tem (read-line st nil nil)) + (if (and tem (setq tem (probe-file tem))) +@@ -718,7 +740,7 @@ SYSTEM_SPECIAL_INIT + ; the loading of binary objects on systems relocating with dlopen. + ; + +-(defun make-user-init (files outn &aux tem) ++(defun make-user-init (files outn) + + (let* ((c (pathname outn)) + (c (merge-pathnames c (make-pathname :directory '(:current)))) +@@ -726,7 +748,6 @@ SYSTEM_SPECIAL_INIT + (c (merge-pathnames (make-pathname :type "c") c))) + + (with-open-file (st c :direction :output) +- (format st "#include ~%") + (format st "#include ~a~%~%" *cmpinclude*) + + (format st "#define load2(a) do {") +@@ -737,15 +758,13 @@ SYSTEM_SPECIAL_INIT + (let ((p nil)) + (dolist (tem files) + (when (equal (pathname-type tem) "o") +- (push (list +- (init-name tem t) +- (namestring tem)) +- p))) ++ (let ((tem (namestring tem))) ++ (push (list (si::find-init-name tem) tem) p)))) + + (setq p (nreverse p)) + + (dolist (tem p) +- (format st "extern void init_~a(void);~%" (car tem))) ++ (format st "extern void ~a(void);~%" (car tem))) + (format st "~%") + + (format st "typedef struct {void (*fn)(void);char *s;} Fnlst;~%") +@@ -754,14 +773,18 @@ SYSTEM_SPECIAL_INIT + (dolist (tem p) + (when (not (eq tem (car p))) + (format st ",~%")) +- (format st "{init_~a,\"~a\"}" (car tem) (cadr tem))) ++ (format st "{~a,\"~a\"}" (car tem) (cadr tem))) + (format st "};~%~%") + ++ (format st "static int user_init_run;~%") ++ (format st "#define my_load(a_,b_) {if (!user_init_run && (a_) && (b_)) gcl_init_or_load1((a_),(b_));(a_)=0;(b_)=0;}~%~%") ++ + (format st "object user_init(void) {~%") ++ (format st "user_init_run=1;~%") + (dolist (tem files) + (let ((tem (namestring tem))) + (cond ((equal (cadr (car p)) tem) +- (format st "gcl_init_or_load1(init_~a,\"~a\");~%" ++ (format st "gcl_init_or_load1(~a,\"~a\");~%" + (car (car p)) tem) + (setq p (cdr p))) + (t +@@ -769,10 +792,10 @@ SYSTEM_SPECIAL_INIT + (format st "return Cnil;}~%~%") + + (format st "int user_match(const char *s,int n) {~%") +- (format st " const Fnlst *f;~%") ++ (format st " Fnlst *f;~%") + (format st " for (f=my_fnlst;fs,n)) {~%") +- (format st " gcl_init_or_load1(f->fn,f->s);~%") ++ (format st " if (f->s && !strncmp(s,f->s,n)) {~%") ++ (format st " my_load(f->fn,f->s);~%") + (format st " return 1;~%") + (format st " }~%") + (format st " }~%") +@@ -780,11 +803,10 @@ SYSTEM_SPECIAL_INIT + (format st "}~%~%"))) + + (compiler-cc c o) +-; (system (format nil "~a ~a" *cc* tem)) +- (delete-file c) ++ (mdelete-file c) + + o)) +- ++ + (defun mysub (str it new) + (let ((x (search it str))) + (unless x +@@ -796,14 +818,41 @@ SYSTEM_SPECIAL_INIT + new + (mysub (subseq str y) it new))))) + +-(defun link (files image &optional post extra-libs (run-user-init t) &aux raw init) ++ ++(eval-when (compile eval) ++(defmacro fcr (x) `(load-time-value (si::compile-regexp ,x))) ++(defmacro sml (x y &optional z) ++ (let ((q (gensym))) ++ `(let ((,q (si::string-match ,x ,y ,@(when z (list z))))) ++ (if (= ,q -1) (length ,y) ,q))))) ++ ++(defun ts (s &optional (r "")) ++ (declare (string s) (ignorable r)) ++ #+winnt ++ (if (not si::*wine-detected*) s ++ (let* ((x (sml (fcr #u"[^ \n\t]") s)) ++ (y (sml (fcr #u"[ \n\t]") s x)) ++ (f (subseq s x y)) ++ (l (subseq s y)) ++ (k (when (> (length f) 0) (aref f 0))) ++ (q (if (eql k #\") (string k) "")) ++ (f (if (eql k #\") (subseq f 1 (1- (length f))) f)) ++ (f (if (and k (not (eql k #\-))) (namestring (no-device f)) f))) ++ (if k (concatenate 'string r q f q (ts l " ")) ""))) ++ #-winnt s) ++ ++(defun mdelete-file (x) ++ (delete-file (ts (namestring x)))) ++ ++ ++(defun link (files image &optional post extra-libs (run-user-init t)) + + (let* ((ui (make-user-init files "user-init")) + (raw (pathname image)) + (init (merge-pathnames (make-pathname + :name (concatenate 'string "init_" (pathname-name raw)) + :type "lsp") raw)) +- (raw (merge-pathnames raw (make-pathname :directory (list :current)))) ++ (raw (merge-pathnames raw (truename "./"))) + (raw (merge-pathnames (make-pathname + :name (concatenate 'string "raw_" (pathname-name raw))) + raw)) +@@ -813,25 +862,25 @@ SYSTEM_SPECIAL_INIT + ) + + (with-open-file (st (namestring map) :direction :output)) +- (system +- (format nil "~a ~a ~a ~a -L~a ~a ~a ~a" +- *ld* +- (namestring raw) +- (namestring ui) +- (let ((sfiles "")) +- (dolist (tem files) +- (if (equal (pathname-type tem) "o") +- (setq sfiles (concatenate 'string sfiles " " (namestring tem))))) +- sfiles) +- si::*system-directory* +- #+gnu-ld (format nil "-Wl,-Map ~a" (namestring map)) #-gnu-ld "" +- (let* ((par (namestring (make-pathname :directory '(:parent)))) +- (i (concatenate 'string " " par)) +- (j (concatenate 'string " " si::*system-directory* par))) +- (mysub *ld-libs* i j)) +- (if (stringp extra-libs) extra-libs ""))) ++ (safe-system ++ (let* ((par (namestring (make-pathname :directory '(:parent)))) ++ (i (concatenate 'string " " par)) ++ (j (concatenate 'string " " si::*system-directory* par))) ++ (format nil "~a ~a ~a ~a -L~a ~a ~a ~a" ++ (mysub *ld* i j) ++ (namestring raw) ++ (namestring ui) ++ (let ((sfiles "")) ++ (dolist (tem files) ++ (if (equal (pathname-type tem) "o") ++ (setq sfiles (concatenate 'string sfiles " " (namestring tem))))) ++ sfiles) ++ si::*system-directory* ++ #+gnu-ld (format nil "-Wl,-Map ~a" (namestring map)) #-gnu-ld "" ++ (if (stringp extra-libs) extra-libs "") ++ (mysub *ld-libs* i j)))) + +- (delete-file ui) ++ (mdelete-file ui) + + (with-open-file (st init :direction :output) + (unless run-user-init +@@ -844,14 +893,14 @@ SYSTEM_SPECIAL_INIT + (format nil "~a~a" si::*system-directory* *init-lsp*)) + (si::copy-stream st1 st)) + (if (stringp post) (format st "~a~%" post)) +- (format st "(si::save-system \"~a\")~%" (namestring image))) ++ (format st "(si::save-system \"~a\")~%" (ts (namestring image)))) + +- (system (format nil "~a ~a < ~a" ++ (safe-system (format nil "~a ~a < ~a" + (namestring raw) + si::*system-directory* + (namestring init))) + +- (delete-file raw) +- (delete-file init)) ++ (mdelete-file raw) ++ (mdelete-file init)) + + image) +--- gcl-2.6.7.orig/cmpnew/gcl_cmpfun.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmpfun.lsp +@@ -74,11 +74,11 @@ + (cond ((eq *value-to-go* 'trash) + (cond ((characterp string) + (wt-nl "princ_char(" (char-code string)) +- (if (null vv-index) (wt ",Cnil") (wt ",VV[" vv-index "]")) ++ (if (null vv-index) (wt ",Cnil") (wt "," (vv-str vv-index))) + (wt ");")) + ((= (length string) 1) + (wt-nl "princ_char(" (char-code (aref string 0))) +- (if (null vv-index) (wt ",Cnil") (wt ",VV[" vv-index "]")) ++ (if (null vv-index) (wt ",Cnil") (wt "," (vv-str vv-index))) + (wt ");")) + (t + (wt-nl "princ_str(\"") +@@ -89,7 +89,7 @@ + ((char= char #\Newline) (wt "\\n")) + (t (wt char))))) + (wt "\",") +- (if (null vv-index) (wt "Cnil") (wt "VV[" vv-index "]")) ++ (if (null vv-index) (wt "Cnil") (wt (vv-str vv-index))) + (wt ");"))) + (unwind-exit nil)) + ((eql string #\Newline) (c2call-global 'terpri (list stream) nil t)) +@@ -909,11 +909,13 @@ + + + (defun sublis1-inline (a b c) +- (let ((tst (car (find (cadr c) *objects* :key 'cadr)))) ++ (let ((tst (or (car (find (cadr c) *objects* :key 'cadr)) ++ (let ((v (member (cadr c) *top-level-forms* :key 'cadr))) ++ (and v ++ (eq (caar v) 'sharp-comma) ++ (cmp-eval (caddar v))))))) + (or (member tst '(eq equal eql)) (error "bad test")) +- (wt "(check_alist(" +- a +- "),sublis1("a "," b "," (format nil "~(&~a~)))" tst)))) ++ (wt "(check_alist(" a "),sublis1("a "," b "," (format nil "~(&~a~)))" tst)))) + + + ;; end new +--- gcl-2.6.7.orig/cmpnew/gcl_cmptag.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmptag.lsp +@@ -207,7 +207,7 @@ + (setf (tag-unwind-exit tag) label) + (when (tag-ref-clb tag) + (setf (tag-ref-clb tag) ref-clb) +- (wt-nl "if(eql(nlj_tag,VV[" (tag-var tag) "])) {") ++ (wt-nl "if(eql(nlj_tag," (vv-str (tag-var tag)) ")) {") + (wt-nl " ") + (reset-top) + (wt-nl " ") +@@ -238,7 +238,7 @@ + (when (or (tag-ref-clb tag) (tag-ref-ccb tag)) + (setf (tag-ref-clb tag) ref-clb) + (when (tag-ref-ccb tag) (setf (tag-ref-ccb tag) ref-ccb)) +- (wt-nl "if(eql(nlj_tag,VV[" (tag-var tag) "])) {") ++ (wt-nl "if(eql(nlj_tag," (vv-str (tag-var tag)) ")) {") + (wt-nl " ") + (reset-top) + (wt-nl " ") +@@ -284,15 +284,14 @@ + (if (tag-ref-ccb tag) + (wt-vs* (tag-ref-clb tag)) + (wt-vs (tag-ref-clb tag))) +- (wt "),VV[" (tag-var tag) "]);")) ++ (wt ")," (vv-str (tag-var tag)) ");")) + + (defun c2go-ccb (tag) + (wt-nl "{frame_ptr fr;") + (wt-nl "fr=frs_sch(") (wt-ccb-vs (tag-ref-ccb tag)) (wt ");") +- (wt-nl "if(fr==NULL)FEerror(\"The GO tag ~s is missing.\",1,VV[" +- (tag-var tag) "]);") ++ (wt-nl "if(fr==NULL)FEerror(\"The GO tag ~s is missing.\",1," (vv-str (tag-var tag)) ");") + (wt-nl "vs_base=vs_top;") +- (wt-nl "unwind(fr,VV[" (tag-var tag) "]);}")) ++ (wt-nl "unwind(fr," (vv-str (tag-var tag)) ");}")) + + + (defun wt-switch-case (x) +--- gcl-2.6.7.orig/cmpnew/gcl_cmpbind.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmpbind.lsp +@@ -38,7 +38,7 @@ + (clink (var-ref var)) + (setf (var-ref-ccb var) (ccb-vs-push)))) + (SPECIAL +- (wt-nl "bds_bind(VV[" (var-loc var) "],") (wt-vs (var-ref var)) ++ (wt-nl "bds_bind(" (vv-str (var-loc var)) ",") (wt-vs (var-ref var)) + (wt ");") + (push 'bds-bind *unwind-exit*)) + (DOWN +@@ -76,7 +76,7 @@ + (t + (wt-nl) (wt-vs (var-ref var)) (wt "= " loc ";")))) + (SPECIAL +- (wt-nl "bds_bind(VV[" (var-loc var) "]," loc ");") ++ (wt-nl "bds_bind(" (vv-str (var-loc var)) "," loc ");") + (push 'bds-bind *unwind-exit*)) + + (DOWN +@@ -128,4 +128,4 @@ + ) + + (defun set-bds-bind (loc vv) +- (wt-nl "bds_bind(VV[" vv "]," loc ");")) ++ (wt-nl "bds_bind(" (vv-str vv) "," loc ");")) +--- gcl-2.6.7.orig/cmpnew/gcl_cmpenv.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmpenv.lsp +@@ -389,6 +389,8 @@ + (loop + (when (endp body) (return)) + (setq form (cmp-macroexpand (car body))) ++ (when (and (consp form) (eq (car form) 'load-time-value)) ++ (setq form (cmp-eval form))) + (cond + ((stringp form) + (when (or (null doc-p) (endp (cdr body)) doc) (return)) +--- gcl-2.6.7.orig/cmpnew/sys-proclaim.lisp ++++ gcl-2.6.7/cmpnew/sys-proclaim.lisp +@@ -1,4 +1,3 @@ +- + (IN-PACKAGE "COMPILER") + + (PROCLAIM '(FTYPE (FUNCTION (T FIXNUM FIXNUM) T) DASH-TO-UNDERSCORE-INT)) +@@ -40,11 +39,11 @@ + (PROCLAIM + '(FTYPE (FUNCTION (T T T T T) T) T3DEFUN-LOCAL-ENTRY T3DEFUN + C1APPLY-OPTIMIZE C2STRUCTURE-SET +- T2DEFUN T2DEFENTRY T3DEFENTRY)) ++ T2DEFUN)) + (PROCLAIM + '(FTYPE (FUNCTION (T T T T T *) T) T3LOCAL-DCFUN T3LOCAL-FUN)) + (PROCLAIM +- '(FTYPE (FUNCTION (T T T T T T) T) DEFSYSFUN T2DEFMACRO T3DEFMACRO)) ++ '(FTYPE (FUNCTION (T T T T T T) T) DEFSYSFUN T2DEFMACRO T3DEFMACRO T2DEFENTRY T3DEFENTRY)) + (PROCLAIM '(FTYPE (FUNCTION (T T T *) T) WT-SIMPLE-CALL)) + (PROCLAIM '(FTYPE (FUNCTION NIL *) WT-FASD-DATA-FILE WT-DATA-FILE)) + (PROCLAIM +@@ -154,4 +153,27 @@ + CO1SUBLIS GET-INLINE-LOC C2STACK-LET NEED-TO-PROTECT SET-VS + TYPE-AND SET-JUMP-FALSE C2CALL-LOCAL + COERCE-LOC-STRUCTURE-REF C2CALL-LAMBDA C1SETQ1 TYPE>= +- C2PSETQ C2SETQ CHECK-FNAME-ARGS)) +\ No newline at end of file ++ C2PSETQ C2SETQ CHECK-FNAME-ARGS)) ++(PROCLAIM '(FTYPE (FUNCTION (T T *) T) LINK)) ++(PROCLAIM ++ '(FTYPE (FUNCTION (T T T) T) COMPILER-PASS2 ++ MYSUB)) ++(PROCLAIM ++ '(FTYPE (FUNCTION (T T T *) T) GET-OUTPUT-PATHNAME)) ++(PROCLAIM ++ '(FTYPE (FUNCTION NIL T) GAZONK-NAME ++ PRINT-COMPILER-INFO)) ++(PROCLAIM ++ '(FTYPE (FUNCTION (*) T) COMPILER-COMMAND COMPILE-FILE)) ++(PROCLAIM ++ '(FTYPE (FUNCTION (T) T) MDELETE-FILE ++ SAFE-SYSTEM DISASSEMBLE)) ++(PROCLAIM '(FTYPE (FUNCTION (T *) *) COMPILE-FILE1 COMPILE)) ++(PROCLAIM '(FTYPE (FUNCTION (STRING *) STRING) TS)) ++(PROCLAIM ++ '(FTYPE (FUNCTION (T T) *) COMPILER-BUILD ++ NCONC-FILES)) ++(PROCLAIM ++ '(FTYPE (FUNCTION (T T) T) CHECK-END ++ COMPILER-CC PRIN1-CMP ++ MAKE-USER-INIT)) +\ No newline at end of file +--- gcl-2.6.7.orig/cmpnew/gcl_cmpvar.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmpvar.lsp +@@ -235,12 +235,12 @@ + (setf (var-kind var) 'object) + (wt-var var ccb)) + (t (wt-vs (var-ref var))))) +- (SPECIAL (wt "(VV[" (var-loc var) "]->s.s_dbind)")) ++ (SPECIAL (wt "(" (vv-str (var-loc var)) "->s.s_dbind)")) + (REPLACED (wt (var-loc var))) + (DOWN (wt-down (var-loc var))) + (GLOBAL (if *safe-compile* +- (wt "symbol_value(VV[" (var-loc var) "])") +- (wt "(VV[" (var-loc var) "]->s.s_dbind)"))) ++ (wt "symbol_value(" (vv-str (var-loc var)) ")") ++ (wt "(" (vv-str (var-loc var)) "->s.s_dbind)"))) + (t (case (var-kind var) + (FIXNUM (when (zerop *space*) (wt "CMP")) + (wt "make_fixnum")) +@@ -272,11 +272,11 @@ + ((var-ref-ccb var) (wt-vs* (var-ref var))) + (t (wt-vs (var-ref var)))) + (wt "= " loc ";")) +- (SPECIAL (wt-nl "(VV[" (var-loc var) "]->s.s_dbind)= " loc ";")) ++ (SPECIAL (wt-nl "(" (vv-str (var-loc var)) "->s.s_dbind)= " loc ";")) + (GLOBAL + (if *safe-compile* +- (wt-nl "setq(VV[" (var-loc var) "]," loc ");") +- (wt-nl "(VV[" (var-loc var) "]->s.s_dbind)= " loc ";"))) ++ (wt-nl "setq(" (vv-str (var-loc var)) "," loc ");") ++ (wt-nl "(" (vv-str (var-loc var)) "->s.s_dbind)= " loc ";"))) + (DOWN + (wt-nl "") (wt-down (var-loc var)) + (wt "=" loc ";")) +--- gcl-2.6.7.orig/cmpnew/gcl_cmpeval.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmpeval.lsp +@@ -73,16 +73,6 @@ + (defun c1sharp-comma (arg) + (c1constant-value (cons 'si:|#,| arg) t)) + +-(defun wrap-literals (form) +- (cond ((consp form) +- (if (eq (car form) 'quote ) +- `(load-time-value (si::nani ,(si::address (cadr form)))) +- (cons (wrap-literals (car form)) (wrap-literals (cdr form))))) +- ((or (symbolp form) (integerp form)) +- form) +- (t +- `(load-time-value (si::nani ,(si::address form)))))) +- + (defun c1load-time-value (arg) + (c1constant-value + (cons 'si:|#,| +@@ -621,23 +611,19 @@ + (list 'CHARACTER-VALUE (add-object val) (char-code val)))) + ((typep val 'long-float) + ;; We can't read in long-floats which are too big: +- (let (tem x) +- (unless (setq tem (cadr (assoc val *objects*))) +- (cond((or +- (and +- (> (setq x (abs val)) (/ most-positive-long-float 2)) +- (c1expr `(si::|#,| * ,(/ val most-positive-long-float) +- most-positive-long-float))) +- (and +- (< x (* least-positive-long-float 1.0d20)) +- (c1expr `(si::|#,| * ,(/ val least-positive-long-float) +- least-positive-long-float)))) +- (push (list val (setq tem *next-vv*)) *objects*)))) +- (list 'LOCATION (make-info :type 'long-float) +- (list 'LONG-FLOAT-VALUE (or tem (add-object val)) val)))) ++ (let* (sc (vv (cond ((> (abs val) (/ most-positive-long-float 2)) ++ (add-object `(si::|#,| * ,(/ val most-positive-long-float) most-positive-long-float))) ++ ((< (abs val) (* least-positive-long-float 1.0d20)) ++ (add-object `(si::|#,| * ,(/ val least-positive-long-float) least-positive-long-float))) ++ ((setq sc t) (add-object val))))) ++ `(location ,(make-info :type 'long-float) ++ ,(if sc (list 'LONG-FLOAT-VALUE vv val) (list 'vv vv))))) + ((typep val 'short-float) + (list 'LOCATION (make-info :type 'short-float) + (list 'SHORT-FLOAT-VALUE (add-object val) val))) ++ ((and *compiler-compile* (not *keep-gaz*)) ++ (list 'LOCATION (make-info :type (object-type val)) ++ (list 'VV (add-object (cons 'si::|#,| `(si::nani ,(si::address val))))))) + (always-p + (list 'LOCATION (make-info :type (object-type val)) + (list 'VV (add-object val)))) +--- gcl-2.6.7.orig/cmpnew/gcl_cmpspecial.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmpspecial.lsp +@@ -59,7 +59,10 @@ + (setq info (copy-info (cadr form))) + (setq type (type-and (type-filter (car args)) (info-type info))) + (when (null type) +- (cmpwarn "Type mismatch was found in ~s." (cons 'the args))) ++ (when (and (type>= 'boolean (type-filter (car args))) ++ (type>= (type-filter (car args)) 'boolean)) ++ (return-from c1the (c1the (list 'boolean `(unless (eq nil ,(cadr args)) t))))) ++ (cmpwarn "Type mismatch was found in ~s." (cons 'the args))) + (setf (info-type info) type) + (list* (car form) info (cddr form)) + ) +@@ -143,8 +146,8 @@ + + (defun wt-symbol-function (vv) + (if *safe-compile* +- (wt "symbol_function(VV[" vv "])") +- (wt "(VV[" vv "]->s.s_gfdef)"))) ++ (wt "symbol_function(" (vv-str vv) ")") ++ (wt "(" (vv-str vv) "->s.s_gfdef)"))) + + (defun wt-make-cclosure (cfun clink fname) + (wt-nl "make_cclosure_new(" (c-function-name "LC" cfun fname) ",Cnil,") +--- gcl-2.6.7.orig/cmpnew/gcl_cmpcall.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmpcall.lsp +@@ -408,11 +408,10 @@ + (cond + ((null type) + (wt-nl1 "static void LnkT" +- num "(){ call_or_link(VV[" num "],(void **)(void *)&Lnk" num");}" +- )) ++ num "(){ call_or_link(" (vv-str num) ",(void **)(void *)&Lnk" num");}")) + ((eql type 'proclaimed-closure) + (wt-nl1 "static void LnkT" num +- "(ptr) object *ptr;{ call_or_link_closure(VV[" num "],(void **)(void *)&Lnk" num",(void **)(void *)&Lclptr" num");}")) ++ "(ptr) object *ptr;{ call_or_link_closure(" (vv-str num) ",(void **)(void *)&Lnk" num",(void **)(void *)&Lclptr" num");}")) + (t + ;;change later to include above. + ;;(setq type (cdr (assoc type '((t . "object")(:btpr . "bptr"))))) +@@ -422,12 +421,10 @@ + (wt "(object first,...){" + (declaration-type (rep-type type)) "V1;" + "va_list ap;va_start(ap,first);V1=call_" +- (if vararg "v" "") "proc_new(VV[" +- (add-object name)"],(void **)(void *)&Lnk" num ) ++ (if vararg "v" "") "proc_new(" (vv-str (add-object name)) ",(void **)(void *)&Lnk" num) + (or vararg (wt "," (proclaimed-argd args type))) + (wt ",first,ap);va_end(ap);return V1;}" ))) +- (t (wt "(){return call_proc0(VV[" (add-object name) +- "],(void **)(void *)&Lnk" num ");}" )))) ++ (t (wt "(){return call_proc0(" (vv-str (add-object name)) ",(void **)(void *)&Lnk" num ");}" )))) + (t (error "unknown link type ~a" type))) + (setq name (symbol-name name)) + (if (find #\/ name) (setq name (remove #\/ name))) +@@ -470,16 +467,16 @@ + (let ((result + (case n + ;(0 (list () t (flags ans set) (format nil "ifuncall0(VV[~d])" obj))) +- (1 (list '(t) t (flags ans set) (format nil "ifuncall1(VV[~d],(#0))" obj) ++ (1 (list '(t) t (flags ans set) (format nil "ifuncall1(~a,(#0))" (vv-str obj)) + 'ifuncall)) + (2 (list '(t t) t (flags ans set) +- (format nil "ifuncall2(VV[~d],(#0),(#1))" obj) ++ (format nil "ifuncall2(~a,(#0),(#1))" (vv-str obj)) + 'ifuncall)) + (t + (list (make-list n :initial-element t) + t (flags ans set) +- (format nil "ifuncall(VV[~a],~a~{,#~a~})" +- obj n ++ (format nil "ifuncall(~a,~a~{,#~a~})" ++ (vv-str obj) n + (dotimes (i n(nreverse res)) + (push i res))) + 'ifuncall))))) +@@ -492,7 +489,7 @@ + + (defun wt-simple-call (cfun base n &optional (vv-index nil)) + (wt "simple_" cfun "(") +- (when vv-index (wt "VV[" vv-index "],")) ++ (when vv-index (wt (vv-str vv-index) ",")) + (wt "base+" base "," n ")") + (base-used)) + +@@ -509,9 +506,8 @@ + (if *safe-compile* + (wt-nl + temp +- "=symbol_function(VV[" (add-symbol (caddr funob)) "]);") +- (wt-nl temp +- "=VV[" (add-symbol (caddr funob)) "]->s.s_gfdef;")) ++ "=symbol_function(" (vv-str (add-symbol (caddr funob))) ");") ++ (wt-nl temp "=" (vv-str (add-symbol (caddr funob))) "->s.s_gfdef;")) + temp))) + (ordinary (let* ((temp (list 'vs (vs-push))) + (*value-to-go* temp)) +@@ -540,9 +536,9 @@ + ;;; Want to set up the return catcher. + (unless loc + (setq loc (list 'vs (vs-push))) +- (wt-nl loc "=symbol_function(VV[" (add-symbol fname) "]);")) ++ (wt-nl loc "=symbol_function(" (vv-str (add-symbol fname)) ");")) + (push-args args) +- (wt-nl "funcall_with_catcher(VV[" (add-symbol fname) "]," loc ");") ++ (wt-nl "funcall_with_catcher(" (vv-str (add-symbol fname)) "," loc ");") + (unwind-exit 'fun-val nil fname)) + (loc + ;;; The function was already pushed. +@@ -559,8 +555,8 @@ + (let ((base *vs*)) + (setq loc (list 'vs (vs-push))) + (if *safe-compile* +- (wt-nl loc "=symbol_function(VV[" (add-symbol fname) "]);") +- (wt-nl loc "=(VV[" (add-symbol fname) "]->s.s_gfdef);")) ++ (wt-nl loc "=symbol_function(" (vv-str (add-symbol fname)) ");") ++ (wt-nl loc "=(" (vv-str (add-symbol fname)) "->s.s_gfdef);")) + (push-args-lispcall args) + (cond ((or (eq *value-to-go* 'return) + (eq *value-to-go* 'top)) +@@ -583,7 +579,7 @@ + (eq *value-to-go* 'top)) + (wt-nl "symlispcall") + (when inline-p (wt "_no_event")) +- (wt "(VV[" (add-symbol fname) "],base+" base "," ++ (wt "(" (vv-str (add-symbol fname)) ",base+" base "," + (length args) ");") + (base-used) + (unwind-exit 'fun-val nil fname)) +--- gcl-2.6.7.orig/cmpnew/gcl_cmptop.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmptop.lsp +@@ -215,7 +215,7 @@ + :directory (pathname-directory p) + :name (pathname-name p) + :version (pathname-version p)) sp gp dc nt)) +- #-aosvs(dc (string-downcase (init-name p sp gp nil nt))) ++; #-aosvs(dc (string-downcase (init-name p sp gp nil nt))) + ((and nt + (let* ((pn (pathname-name p)) + (pp (make-pathname :name pn))) +@@ -296,7 +296,7 @@ + ;;; Initialization function. + (wt-nl1 "void init_" name "(){" + #+sgi3d "Init_Links ();" +- "do_init(VV);" ++ "do_init((void *)VV);" + "}") + + +@@ -364,14 +364,14 @@ + ;; last entry in the VV vector. + + +- (wt-h "static char * VVi[" (+ 1 *next-vv*) "]={") ++ (wt-h "static void * VVi[" (+ 1 *next-vv*) "]={") + (wt-h "#define Cdata VV[" *next-vv* "]") + (or *vaddress-list* (wt-h 0)) + (do ((v (nreverse *Vaddress-List*) (cdr v))) + ((null v) (wt-h "};")) +- (wt-h "(char *)(" (caar v) (if (cdr v) ")," ")"))) ++ (wt-h "(void *)(" (caar v) (if (cdr v) ")," ")"))) + +- (wt-h "#define VV ((object *)VVi)") ++ (wt-h "#define VV (VVi)") + + + (wt-data-file) +@@ -400,7 +400,6 @@ + (wt-h "static " (declaration-type newtype) " LnkT" num "();") + #-sgi3d (wt-h "static " (declaration-type newtype) " (*Lnk" num ")() = LnkT" num ";") + #+sgi3d (wt-h "static " (declaration-type newtype) " (*Lnk" num ")();")))))) +-) + + + ;; this default will be as close to the the decision of the x3j13 committee +@@ -798,7 +797,7 @@ + (wt-nl "goto TTL;") (wt-nl1 "TTL:;")) + (dolist + (v specials) +- (wt-nl "bds_bind(VV[" (cdr v)"],V" (var-loc (car v))");") ++ (wt-nl "bds_bind(" (vv-str (cdr v)) ",V" (var-loc (car v)) ");") + (push 'bds-bind *unwind-exit*) + (setf (var-kind (car v)) 'SPECIAL) + (setf (var-loc (car v)) (cdr v))) +@@ -1428,10 +1427,8 @@ + + (defun t2ordinary (form) + (cond ((atom form)) +- ((constantp form) ) ++ ((constantp form)) + (t (add-init form )))) +- +- ) + + (defun add-load-time-sharp-comma () + (dolist* (vv (reverse *sharp-commas*)) +@@ -1461,7 +1458,7 @@ + (si:putprop 'dbind 'set-dbind 'set-loc) + + (defun set-dbind (loc vv) +- (wt-nl "VV[" vv "]->s.s_dbind = " loc ";")) ++ (wt-nl (vv-str vv) "->s.s_dbind = " loc ";")) + + (defun t1clines (args) + (dolist** (s args) +@@ -1517,10 +1514,10 @@ + ((eq (caar s) 'quote) + (wt-nl1 (cadadr s)) + (case (caadr s) +- (object (wt "=VV[" (cadar s) "];")) ++ (object (wt "=" (vv-str (cadar s)) ";")) + (otherwise + (wt "=object_to_" (string-downcase (symbol-name (caadr s))) +- "(VV[" (cadar s) "]);")))) ++ "(" (vv-str (cadar s)) ");")))) + (t (wt-nl1 "{vs_base=vs_top=old_top;") + (dolist** (arg (cdar s)) + (wt-nl1 "vs_push(") +@@ -1534,17 +1531,15 @@ + (wt ");")) + (cond ((setq fd (assoc (caar s) *global-funs*)) + (cond (*compiler-push-events* +- (wt-nl1 "ihs_push(VV[" (add-symbol (caar s)) "]);") ++ (wt-nl1 "ihs_push(" (vv-str (add-symbol (caar s))) ");") + (wt-nl1 (c-function-name "L" (cdr fd) (caar s)) "();") + (wt-nl1 "ihs_pop();")) + (t (wt-nl1 (c-function-name "L" (cdr fd) (caar s)) "();")))) + (*compiler-push-events* +- (wt-nl1 "super_funcall(VV[" (add-symbol (caar s)) "]);")) ++ (wt-nl1 "super_funcall(" (vv-str (add-symbol (caar s))) ");")) + (*safe-compile* +- (wt-nl1 "super_funcall_no_event(VV[" (add-symbol (caar s)) +- "]);")) +- (t (wt-nl1 "CMPfuncall(VV[" (add-symbol (caar s)) +- "]->s.s_gfdef);")) ++ (wt-nl1 "super_funcall_no_event(" (vv-str (add-symbol (caar s))) ");")) ++ (t (wt-nl1 "CMPfuncall(" (vv-str (add-symbol (caar s))) "->s.s_gfdef);")) + ) + (unless (endp (cdr s)) + (wt-nl1 (cadadr s)) +@@ -1571,13 +1566,13 @@ + (wt-nl1 "}") + ) + +-(defun t1defentry (args &aux type cname (cfun (next-cfun)) cfspec) ++(defun t1defentry (args &aux static type cname (cfun (next-cfun)) cfspec) + (when (or (endp args) (endp (cdr args)) (endp (cddr args))) + (too-few-args 'defentry 3 (length args))) + (cmpck (not (symbolp (car args))) + "The function name ~s is not a symbol." (car args)) + (dolist** (x (cadr args)) +- (cmpck (not (member x '(object char int float double string))) ++ (cmpck (not (member x '(object char fixnum int float double string))) + "The C-type ~s is illegal." x)) + (setq cfspec (caddr args)) + (cond ((symbolp cfspec) +@@ -1587,7 +1582,8 @@ + (setq type 'object) + (setq cname cfspec)) + ((and (consp cfspec) +- (member (car cfspec) '(void object char int float double ++ (or (not (eq (car cfspec) 'static)) (setq static (pop cfspec))) ++ (member (car cfspec) '(void object char fixnum int float double + string)) + (consp (cdr cfspec)) + (or (symbolp (cadr cfspec)) (stringp (cadr cfspec))) +@@ -1597,18 +1593,26 @@ + (cadr cfspec))) + (setq type (car cfspec))) + (t (cmperr "The C function specification ~s is illegal." cfspec))) +- (push (list 'defentry (car args) cfun (cadr args) type cname) ++ (push (list 'defentry (car args) cfun (cadr args) type cname static) + *top-level-forms*) + (push (cons (car args) cfun) *global-funs*) + ) + +-(defun t2defentry (fname cfun arg-types type cname) +- (declare (ignore arg-types type cname)) ++(defun t2defentry (fname cfun arg-types type cname static) ++ (declare (ignore arg-types type cname static)) + (wt-h "static void " (c-function-name "L" cfun fname) "();") + (add-init `(si::mf ',fname ,(add-address (c-function-name "L" cfun fname))) ) + ) + +-(defun t3defentry (fname cfun arg-types type cname) ++(defun t3defentry (fname cfun arg-types type cname static) ++ (wt-h (if static "static " "") ++ (if (eq type 'string) "char *" (string-downcase (symbol-name type))) ++ " " cname "(" ++ (with-output-to-string ++ (s) ++ (do ((l arg-types (cdr l))) ((not l) (princ ");"s )) ++ (princ (if (eq (car l) 'string) "char *" (string-downcase (symbol-name (car l)))) s) ++ (when (cdr l) (princ "," s))))) + (wt-comment "function definition for " fname) + (wt-nl1 "static void " (c-function-name "L" cfun fname) "()") + (wt-nl1 "{ object *old_base=vs_base;") +@@ -1639,7 +1643,7 @@ + (void (wt "Cnil")) + (object (wt "x")) + (char (wt "code_char(x)")) +- (int (when (zerop *space*) (wt "CMP")) ++ ((fixnum int) (when (zerop *space*) (wt "CMP")) + (wt "make_fixnum(x)")) + (string + (wt "make_simple_string(x)")) +--- gcl-2.6.7.orig/cmpnew/gcl_cmpflet.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmpflet.lsp +@@ -1,404 +1,404 @@ +-;;; CMPFLET Flet, Labels, and Macrolet. +-;;; +-;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa +- +-;; This file is part of GNU Common Lisp, herein referred to as GCL +-;; +-;; GCL is free software; you can redistribute it and/or modify it under +-;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by +-;; the Free Software Foundation; either version 2, or (at your option) +-;; any later version. +-;; +-;; GCL 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 Library General Public +-;; License for more details. +-;; +-;; You should have received a copy of the GNU Library General Public License +-;; along with GCL; see the file COPYING. If not, write to the Free Software +-;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +- +- +-(in-package 'compiler) +- +-(si:putprop 'flet 'c1flet 'c1special) +-(si:putprop 'flet 'c2flet 'c2) +-(si:putprop 'labels 'c1labels 'c1special) +-(si:putprop 'labels 'c2labels 'c2) +-(si:putprop 'macrolet 'c1macrolet 'c1special) +-;;; c2macrolet is not defined, because MACROLET is replaced by PROGN +-;;; during Pass 1. +-(si:putprop 'call-local 'c2call-local 'c2) +- +-(defstruct fun +- name ;;; Function name. +- ref ;;; Referenced or not. +- ;;; During Pass1, T or NIL. +- ;;; During Pass2, the vs-address for the +- ;;; function closure, or NIL. +- ref-ccb ;;; Cross closure reference. +- ;;; During Pass1, T or NIL. +- ;;; During Pass2, the vs-address for the +- ;;; function closure, or NIL. +- cfun ;;; The cfun for the function. +- level ;;; The level of the function. +- +- info ;;; fun-info; CM, 20031008 +- ;;; collect info structure when processing +- ;;; function lambda list in flet and labels +- ;;; and pass upwards to call-local and call-global +- ;;; to determine more accurately when +- ;;; args-info-changed-vars should prevent certain +- ;;; inlining +- ;;; examples: (defun foo (a) (flet ((%f8 nil (setq a 0))) +- ;;; (let ((v9 a)) (- (%f8) v9)))) +- ;;; (defun foo (a) (flet ((%f8 nil (setq a 2))) +- ;;; (* a (%f8)))) +- ) +- +-(defvar *funs* nil) +- +-;;; During Pass 1, *funs* holds a list of fun objects, local macro definitions +-;;; and the symbol 'CB' (Closure Boundary). 'CB' will be pushed on *funs* +-;;; when the compiler begins to process a closure. A local macro definition +-;;; is a list ( macro-name expansion-function). +- +-(defun c1flet (args &aux body ss ts is other-decl info +- (defs1 nil) (local-funs nil) (closures nil) (*info* (copy-info *info*))) +- (when (endp args) (too-few-args 'flet 1 0)) +- +- (let ((*funs* *funs*)) +- (dolist** (def (car args)) +- (cmpck (or (endp def) +- (not (symbolp (car def))) +- (endp (cdr def))) +- "The function definition ~s is illegal." def) +- (let ((fun (make-fun :name (car def) :ref nil :ref-ccb nil :info (make-info :sp-change t)))) +- (push fun *funs*) +- (push (list fun (cdr def)) defs1))) +- +- (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t)) +- +- (let ((*vars* *vars*)) +- (c1add-globals ss) +- (check-vdecl nil ts is) +- (setq body (c1decl-body other-decl body))) +- +- (setq info (copy-info (cadr body)))) +- +- (dolist* (def (reverse defs1)) +- (when (fun-ref-ccb (car def)) +- (let ((*vars* (cons 'cb *vars*)) +- (*funs* (cons 'cb *funs*)) +- (*blocks* (cons 'cb *blocks*)) +- (*tags* (cons 'cb *tags*))) +- (let ((lam (c1lambda-expr (cadr def) (fun-name (car def))))) +- (add-info info (cadr lam)) +- ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, +- ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args +- ;; via args-info-changed-vars +- (add-info (fun-info (car def)) (cadr lam)) +- (push (list (car def) lam) closures)))) +- +- (when (fun-ref (car def)) +- (let ((*blocks* (cons 'lb *blocks*)) +- (*tags* (cons 'lb *tags*)) +- (*vars* (cons 'lb *vars*))) +- (let ((lam (c1lambda-expr (cadr def) (fun-name (car def))))) +- (add-info info (cadr lam)) +- ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, +- ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args +- ;; via args-info-changed-vars +- (add-info (fun-info (car def)) (cadr lam)) +- (push (list (car def) lam) local-funs)))) +- +- (when (or (fun-ref (car def)) (fun-ref-ccb (car def))) +- (setf (fun-cfun (car def)) (next-cfun)))) +- +- ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, +- ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args +- ;; via args-info-changed-vars +- ;; +- ;; walk body a second time to incorporate changed variable info from local function +- ;; lambda lists +- +- (let ((*funs* *funs*)) +- (dolist* (def defs1) +- (push (car def) *funs*)) +- +- (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t)) +- +- (let ((*vars* *vars*)) +- (c1add-globals ss) +- (check-vdecl nil ts is) +- (setq body (c1decl-body other-decl body))) +- +- ;; Apparently this is not scricttly necessary, just changes to body +- (add-info info (cadr body))) +- +- (if (or local-funs closures) +- (list 'flet info (reverse local-funs) (reverse closures) body) +- body)) +- +-(defun c2flet (local-funs closures body +- &aux (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*)) +- +- (dolist** (def local-funs) +- (setf (fun-level (car def)) *level*) +- ;; Append *initial-ccb-vs* here and use it to initialize *initial-ccb-vs* when writing +- ;; the code for this function. Local functions, unlike closures, get an envinment +- ;; level with the *initial-ccb-vs* at this point, and *ccb-vs* can be further incremented +- ;; here, in c2tagbody-ccb, and in c2block-ccb. CM 20031130 +- (push (list nil *clink* *ccb-vs* (car def) (cadr def) *initial-ccb-vs*) *local-funs*)) +- +- ;;; Setup closures. +- (dolist** (def closures) +- (push (list 'closure +- (if (null *clink*) nil (cons 0 0)) +- *ccb-vs* (car def) (cadr def)) +- *local-funs*) +- (push (car def) *closures*) +- (let ((fun (car def))) +- (declare (object fun)) +- (setf (fun-ref fun) (vs-push)) +- (wt-nl) +- (wt-vs (fun-ref fun)) +- (wt "=make_cclosure_new(" (c-function-name "LC" (fun-cfun fun) (fun-name fun)) ",Cnil,") (wt-clink) +- (wt ",Cdata);") +- (wt-nl) +- (wt-vs (fun-ref fun)) +- (wt "=MMcons(") (wt-vs (fun-ref fun)) (wt ",") (wt-clink) (wt ");") +- (clink (fun-ref fun)) +- (setf (fun-ref-ccb fun) (ccb-vs-push)) +- )) +- +- (c2expr body) +- ) +- +-(defun c1labels (args &aux body ss ts is other-decl info +- (defs1 nil) (local-funs nil) (closures nil) +- (fnames nil) (processed-flag nil) (*funs* *funs*) (*info* (copy-info *info*))) +- (when (endp args) (too-few-args 'labels 1 0)) +- +- ;;; bind local-functions +- (dolist** (def (car args)) +- (cmpck (or (endp def) (not (symbolp (car def))) (endp (cdr def))) +- "The local function definition ~s is illegal." def) +- (cmpck (member (car def) fnames) +- "The function ~s was already defined." (car def)) +- (push (car def) fnames) +- (let ((fun (make-fun :name (car def) :ref nil :ref-ccb nil :info (make-info :sp-change t)))) +- (push fun *funs*) +- (push (list fun nil nil (cdr def)) defs1))) +- +- (setq defs1 (reverse defs1)) +- +- ;;; Now DEFS1 holds ( { ( fun-object NIL NIL body ) }* ). +- +- (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t)) +- (let ((*vars* *vars*)) +- (c1add-globals ss) +- (check-vdecl nil ts is) +- (setq body (c1decl-body other-decl body))) +- (setq info (copy-info (cadr body))) +- +- (block local-process +- (loop +- (setq processed-flag nil) +- (dolist** (def defs1) +- (when (and (fun-ref (car def)) ;;; referred locally and +- (null (cadr def))) ;;; not processed yet +- (setq processed-flag t) +- (setf (cadr def) t) +- (let ((*blocks* (cons 'lb *blocks*)) +- (*tags* (cons 'lb *tags*)) +- (*vars* (cons 'lb *vars*))) +- (let ((lam (c1lambda-expr (cadddr def) (fun-name (car def))))) +- (add-info info (cadr lam)) +- ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, +- ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args +- ;; via args-info-changed-vars +- (add-info (fun-info (car def)) (cadr lam)) +- (push (list (car def) lam) local-funs))))) +- (unless processed-flag (return-from local-process)) +- )) ;;; end local process +- +- (block closure-process +- (loop +- (setq processed-flag nil) +- (dolist** (def defs1) +- (when (and (fun-ref-ccb (car def)) ; referred across closure +- (null (caddr def))) ; and not processed +- (setq processed-flag t) +- (setf (caddr def) t) +- (let ((*vars* (cons 'cb *vars*)) +- (*funs* (cons 'cb *funs*)) +- (*blocks* (cons 'cb *blocks*)) +- (*tags* (cons 'cb *tags*))) +- (let ((lam (c1lambda-expr (cadddr def) (fun-name (car def))))) +- (add-info info (cadr lam)) +- ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, +- ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args +- ;; via args-info-changed-vars +- (add-info (fun-info (car def)) (cadr lam)) +- (push (list (car def) lam) closures)))) +- ) +- (unless processed-flag (return-from closure-process)) +- )) ;;; end closure process +- +- (dolist** (def defs1) +- (when (or (fun-ref (car def)) (fun-ref-ccb (car def))) +- (setf (fun-cfun (car def)) (next-cfun)))) +- +- ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, +- ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args +- ;; via args-info-changed-vars +- ;; +- ;; walk body a second time to gather info in labels lambda lists +- +- (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t)) +- (let ((*vars* *vars*)) +- (c1add-globals ss) +- (check-vdecl nil ts is) +- (setq body (c1decl-body other-decl body))) +- (add-info info (cadr body)) +- +- (if (or local-funs closures) +- (list 'labels info (reverse local-funs) (reverse closures) body) +- body)) +- +-(defun c2labels (local-funs closures body &aux (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*)) +- +- ;;; Prepare for cross-referencing closures. +- (dolist** (def closures) +- (let ((fun (car def))) +- (declare (object fun)) +- (setf (fun-ref fun) (vs-push)) +- (wt-nl) +- (wt-vs (fun-ref fun)) +- (wt "=MMcons(Cnil,") (wt-clink) (wt ");") +- (clink (fun-ref fun)) +- (setf (fun-ref-ccb fun) (ccb-vs-push)) +- )) +- +- (dolist** (def local-funs) +- (setf (fun-level (car def)) *level*) +- ;; Append *initial-ccb-vs* here and use it to initialize *initial-ccb-vs* when writing +- ;; the code for this function. Local functions, unlike closures, get an envinment +- ;; level with the *initial-ccb-vs* at this point, and *ccb-vs* can be further incremented +- ;; here, in c2tagbody-ccb, and in c2block-ccb. CM 20031130 +- (push (list nil *clink* *ccb-vs* (car def) (cadr def) *initial-ccb-vs*) *local-funs*)) +- +- ;;; Then make closures. +- (dolist** (def closures) +- (push (list 'closure (if (null *clink*) nil (cons 0 0)) +- *ccb-vs* (car def) (cadr def)) +- *local-funs*) +- (push (car def) *closures*) +- (wt-nl) +- (wt-vs* (fun-ref (car def))) +- (wt "=make_cclosure_new(" (c-function-name "LC" (fun-cfun (car def)) (fun-name (car def))) ",Cnil,") (wt-clink) +- (wt ",Cdata);") +- ) +- +- ;;; now the body of flet +- +- (c2expr body) +- ) +- +-(defun c1macrolet (args &aux body ss ts is other-decl +- (*funs* *funs*) (*vars* *vars*)) +- (when (endp args) (too-few-args 'macrolet 1 0)) +- (dolist** (def (car args)) +- (cmpck (or (endp def) (not (symbolp (car def))) (endp (cdr def))) +- "The macro definition ~s is illegal." def) +- (push (list (car def) +- (caddr (si:defmacro* (car def) (cadr def) (cddr def)))) +- *funs*)) +- (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t)) +- (c1add-globals ss) +- (check-vdecl nil ts is) +- (c1decl-body other-decl body) +- ) +- +-(defun c1local-fun (fname &aux (ccb nil)) +- (declare (object ccb)) +- (dolist* (fun *funs* nil) +- (cond ((eq fun 'CB) (setq ccb t)) +- ((consp fun) +- (when (eq (car fun) fname) (return (cadr fun)))) +- ((eq (fun-name fun) fname) +- (if ccb +- (setf (fun-ref-ccb fun) t) +- (setf (fun-ref fun) t)) +- ;; Add fun-info here at the bottom of the call-local processing tree +- ;; FIXME -- understand why special variable *info* is used in certain +- ;; cases and copy-info in othes. +- ;; This extends local call arg side-effect protection (via args-info-changed-vars) +- ;; through c1funob to other call methods than previously supported c1symbol-fun, +- ;; e.g. c1multiple-value-call, etc. CM 20031030 +- (add-info *info* (fun-info fun)) +- (return (list 'call-local *info* fun ccb)))))) +- +-(defun sch-local-fun (fname) +- ;;; Returns fun-ob for the local function (not locat macro) named FNAME, +- ;;; if any. Otherwise, returns FNAME itself. +- (dolist* (fun *funs* fname) +- (when (and (not (eq fun 'CB)) +- (not (consp fun)) +- (eq (fun-name fun) fname)) +- (return fun))) +- ) +- +-(defun c1local-closure (fname &aux (ccb nil)) +- (declare (object ccb)) +- ;;; Called only from C1FUNCTION. +- (dolist* (fun *funs* nil) +- (cond ((eq fun 'CB) (setq ccb t)) +- ((consp fun) +- (when (eq (car fun) fname) (return (cadr fun)))) +- ((eq (fun-name fun) fname) +- (setf (fun-ref-ccb fun) t) +- ;; Add fun-info here at the bottom of the call-local processing tree +- ;; FIXME -- understand why special variable *info* is used in certain +- ;; cases and copy-info in othes. +- ;; This extends local call arg side-effect protection (via args-info-changed-vars) +- ;; through c1funob to other call methods than previously supported c1symbol-fun, +- ;; e.g. c1multiple-value-call, etc. CM 20031030 +- (add-info *info* (fun-info fun)) +- (return (list 'call-local *info* fun ccb)))))) +- +-(defun c2call-local (fd args &aux (*vs* *vs*)) +- ;;; FD is a list ( fun-object ccb ). +- (cond +- ((cadr fd) +- (push-args args) +- (wt-nl "cclosure_call(") (wt-ccb-vs (fun-ref-ccb (car fd))) (wt ");")) +- ((and (listp args) +- *do-tail-recursion* +- *tail-recursion-info* +- (eq (car *tail-recursion-info*) (car fd)) +- (eq *exit* 'RETURN) +- (tail-recursion-possible) +- (= (length args) (length (cdr *tail-recursion-info*)))) +- (let* ((*value-to-go* 'trash) +- (*exit* (next-label)) +- (*unwind-exit* (cons *exit* *unwind-exit*))) +- (c2psetq (mapcar #'(lambda (v) (list v nil)) +- (cdr *tail-recursion-info*)) +- args) +- (wt-label *exit*)) +- (unwind-no-exit 'tail-recursion-mark) +- (wt-nl "goto TTL;") +- (cmpnote "Tail-recursive call of ~s was replaced by iteration." +- (fun-name (car fd)))) +- (t (push-args args) +- (wt-nl (c-function-name "L" (fun-cfun (car fd)) (fun-name (car fd))) "(") +- (dotimes** (n (fun-level (car fd))) (wt "base" n ",")) +- (wt "base") +- (unless (= (fun-level (car fd)) *level*) (wt (fun-level (car fd)))) +- (wt ");") +- (base-used))) +- (unwind-exit 'fun-val) +- ) +- ++;;; CMPFLET Flet, Labels, and Macrolet. ++;;; ++;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa ++ ++;; This file is part of GNU Common Lisp, herein referred to as GCL ++;; ++;; GCL is free software; you can redistribute it and/or modify it under ++;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by ++;; the Free Software Foundation; either version 2, or (at your option) ++;; any later version. ++;; ++;; GCL 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 Library General Public ++;; License for more details. ++;; ++;; You should have received a copy of the GNU Library General Public License ++;; along with GCL; see the file COPYING. If not, write to the Free Software ++;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++(in-package 'compiler) ++ ++(si:putprop 'flet 'c1flet 'c1special) ++(si:putprop 'flet 'c2flet 'c2) ++(si:putprop 'labels 'c1labels 'c1special) ++(si:putprop 'labels 'c2labels 'c2) ++(si:putprop 'macrolet 'c1macrolet 'c1special) ++;;; c2macrolet is not defined, because MACROLET is replaced by PROGN ++;;; during Pass 1. ++(si:putprop 'call-local 'c2call-local 'c2) ++ ++(defstruct fun ++ name ;;; Function name. ++ ref ;;; Referenced or not. ++ ;;; During Pass1, T or NIL. ++ ;;; During Pass2, the vs-address for the ++ ;;; function closure, or NIL. ++ ref-ccb ;;; Cross closure reference. ++ ;;; During Pass1, T or NIL. ++ ;;; During Pass2, the vs-address for the ++ ;;; function closure, or NIL. ++ cfun ;;; The cfun for the function. ++ level ;;; The level of the function. ++ ++ info ;;; fun-info; CM, 20031008 ++ ;;; collect info structure when processing ++ ;;; function lambda list in flet and labels ++ ;;; and pass upwards to call-local and call-global ++ ;;; to determine more accurately when ++ ;;; args-info-changed-vars should prevent certain ++ ;;; inlining ++ ;;; examples: (defun foo (a) (flet ((%f8 nil (setq a 0))) ++ ;;; (let ((v9 a)) (- (%f8) v9)))) ++ ;;; (defun foo (a) (flet ((%f8 nil (setq a 2))) ++ ;;; (* a (%f8)))) ++ ) ++ ++(defvar *funs* nil) ++ ++;;; During Pass 1, *funs* holds a list of fun objects, local macro definitions ++;;; and the symbol 'CB' (Closure Boundary). 'CB' will be pushed on *funs* ++;;; when the compiler begins to process a closure. A local macro definition ++;;; is a list ( macro-name expansion-function). ++ ++(defun c1flet (args &aux body ss ts is other-decl info ++ (defs1 nil) (local-funs nil) (closures nil) (*info* (copy-info *info*))) ++ (when (endp args) (too-few-args 'flet 1 0)) ++ ++ (let ((*funs* *funs*)) ++ (dolist** (def (car args)) ++ (cmpck (or (endp def) ++ (not (symbolp (car def))) ++ (endp (cdr def))) ++ "The function definition ~s is illegal." def) ++ (let ((fun (make-fun :name (car def) :ref nil :ref-ccb nil :info (make-info :sp-change t)))) ++ (push fun *funs*) ++ (push (list fun (cdr def)) defs1))) ++ ++ (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t)) ++ ++ (let ((*vars* *vars*)) ++ (c1add-globals ss) ++ (check-vdecl nil ts is) ++ (setq body (c1decl-body other-decl body))) ++ ++ (setq info (copy-info (cadr body)))) ++ ++ (dolist* (def (reverse defs1)) ++ (when (fun-ref-ccb (car def)) ++ (let ((*vars* (cons 'cb *vars*)) ++ (*funs* (cons 'cb *funs*)) ++ (*blocks* (cons 'cb *blocks*)) ++ (*tags* (cons 'cb *tags*))) ++ (let ((lam (c1lambda-expr (cadr def) (fun-name (car def))))) ++ (add-info info (cadr lam)) ++ ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, ++ ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args ++ ;; via args-info-changed-vars ++ (add-info (fun-info (car def)) (cadr lam)) ++ (push (list (car def) lam) closures)))) ++ ++ (when (fun-ref (car def)) ++ (let ((*blocks* (cons 'lb *blocks*)) ++ (*tags* (cons 'lb *tags*)) ++ (*vars* (cons 'lb *vars*))) ++ (let ((lam (c1lambda-expr (cadr def) (fun-name (car def))))) ++ (add-info info (cadr lam)) ++ ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, ++ ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args ++ ;; via args-info-changed-vars ++ (add-info (fun-info (car def)) (cadr lam)) ++ (push (list (car def) lam) local-funs)))) ++ ++ (when (or (fun-ref (car def)) (fun-ref-ccb (car def))) ++ (setf (fun-cfun (car def)) (next-cfun)))) ++ ++ ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, ++ ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args ++ ;; via args-info-changed-vars ++ ;; ++ ;; walk body a second time to incorporate changed variable info from local function ++ ;; lambda lists ++ ++ (let ((*funs* *funs*)) ++ (dolist* (def defs1) ++ (push (car def) *funs*)) ++ ++ (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t)) ++ ++ (let ((*vars* *vars*)) ++ (c1add-globals ss) ++ (check-vdecl nil ts is) ++ (setq body (c1decl-body other-decl body))) ++ ++ ;; Apparently this is not scricttly necessary, just changes to body ++ (add-info info (cadr body))) ++ ++ (if (or local-funs closures) ++ (list 'flet info (reverse local-funs) (reverse closures) body) ++ body)) ++ ++(defun c2flet (local-funs closures body ++ &aux (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*)) ++ ++ (dolist** (def local-funs) ++ (setf (fun-level (car def)) *level*) ++ ;; Append *initial-ccb-vs* here and use it to initialize *initial-ccb-vs* when writing ++ ;; the code for this function. Local functions, unlike closures, get an envinment ++ ;; level with the *initial-ccb-vs* at this point, and *ccb-vs* can be further incremented ++ ;; here, in c2tagbody-ccb, and in c2block-ccb. CM 20031130 ++ (push (list nil *clink* *ccb-vs* (car def) (cadr def) *initial-ccb-vs*) *local-funs*)) ++ ++ ;;; Setup closures. ++ (dolist** (def closures) ++ (push (list 'closure ++ (if (null *clink*) nil (cons 0 0)) ++ *ccb-vs* (car def) (cadr def)) ++ *local-funs*) ++ (push (car def) *closures*) ++ (let ((fun (car def))) ++ (declare (object fun)) ++ (setf (fun-ref fun) (vs-push)) ++ (wt-nl) ++ (wt-vs (fun-ref fun)) ++ (wt "=make_cclosure_new(" (c-function-name "LC" (fun-cfun fun) (fun-name fun)) ",Cnil,") (wt-clink) ++ (wt ",Cdata);") ++ (wt-nl) ++ (wt-vs (fun-ref fun)) ++ (wt "=MMcons(") (wt-vs (fun-ref fun)) (wt ",") (wt-clink) (wt ");") ++ (clink (fun-ref fun)) ++ (setf (fun-ref-ccb fun) (ccb-vs-push)) ++ )) ++ ++ (c2expr body) ++ ) ++ ++(defun c1labels (args &aux body ss ts is other-decl info ++ (defs1 nil) (local-funs nil) (closures nil) ++ (fnames nil) (processed-flag nil) (*funs* *funs*) (*info* (copy-info *info*))) ++ (when (endp args) (too-few-args 'labels 1 0)) ++ ++ ;;; bind local-functions ++ (dolist** (def (car args)) ++ (cmpck (or (endp def) (not (symbolp (car def))) (endp (cdr def))) ++ "The local function definition ~s is illegal." def) ++ (cmpck (member (car def) fnames) ++ "The function ~s was already defined." (car def)) ++ (push (car def) fnames) ++ (let ((fun (make-fun :name (car def) :ref nil :ref-ccb nil :info (make-info :sp-change t)))) ++ (push fun *funs*) ++ (push (list fun nil nil (cdr def)) defs1))) ++ ++ (setq defs1 (reverse defs1)) ++ ++ ;;; Now DEFS1 holds ( { ( fun-object NIL NIL body ) }* ). ++ ++ (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t)) ++ (let ((*vars* *vars*)) ++ (c1add-globals ss) ++ (check-vdecl nil ts is) ++ (setq body (c1decl-body other-decl body))) ++ (setq info (copy-info (cadr body))) ++ ++ (block local-process ++ (loop ++ (setq processed-flag nil) ++ (dolist** (def defs1) ++ (when (and (fun-ref (car def)) ;;; referred locally and ++ (null (cadr def))) ;;; not processed yet ++ (setq processed-flag t) ++ (setf (cadr def) t) ++ (let ((*blocks* (cons 'lb *blocks*)) ++ (*tags* (cons 'lb *tags*)) ++ (*vars* (cons 'lb *vars*))) ++ (let ((lam (c1lambda-expr (cadddr def) (fun-name (car def))))) ++ (add-info info (cadr lam)) ++ ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, ++ ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args ++ ;; via args-info-changed-vars ++ (add-info (fun-info (car def)) (cadr lam)) ++ (push (list (car def) lam) local-funs))))) ++ (unless processed-flag (return-from local-process)) ++ )) ;;; end local process ++ ++ (block closure-process ++ (loop ++ (setq processed-flag nil) ++ (dolist** (def defs1) ++ (when (and (fun-ref-ccb (car def)) ; referred across closure ++ (null (caddr def))) ; and not processed ++ (setq processed-flag t) ++ (setf (caddr def) t) ++ (let ((*vars* (cons 'cb *vars*)) ++ (*funs* (cons 'cb *funs*)) ++ (*blocks* (cons 'cb *blocks*)) ++ (*tags* (cons 'cb *tags*))) ++ (let ((lam (c1lambda-expr (cadddr def) (fun-name (car def))))) ++ (add-info info (cadr lam)) ++ ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, ++ ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args ++ ;; via args-info-changed-vars ++ (add-info (fun-info (car def)) (cadr lam)) ++ (push (list (car def) lam) closures)))) ++ ) ++ (unless processed-flag (return-from closure-process)) ++ )) ;;; end closure process ++ ++ (dolist** (def defs1) ++ (when (or (fun-ref (car def)) (fun-ref-ccb (car def))) ++ (setf (fun-cfun (car def)) (next-cfun)))) ++ ++ ;; fun-info, CM 20031008 accumulate local function info, particularly changed-vars, ++ ;; and pass upwards to call-local and call-global to prevent certain inlining in inline-args ++ ;; via args-info-changed-vars ++ ;; ++ ;; walk body a second time to gather info in labels lambda lists ++ ++ (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t)) ++ (let ((*vars* *vars*)) ++ (c1add-globals ss) ++ (check-vdecl nil ts is) ++ (setq body (c1decl-body other-decl body))) ++ (add-info info (cadr body)) ++ ++ (if (or local-funs closures) ++ (list 'labels info (reverse local-funs) (reverse closures) body) ++ body)) ++ ++(defun c2labels (local-funs closures body &aux (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*)) ++ ++ ;;; Prepare for cross-referencing closures. ++ (dolist** (def closures) ++ (let ((fun (car def))) ++ (declare (object fun)) ++ (setf (fun-ref fun) (vs-push)) ++ (wt-nl) ++ (wt-vs (fun-ref fun)) ++ (wt "=MMcons(Cnil,") (wt-clink) (wt ");") ++ (clink (fun-ref fun)) ++ (setf (fun-ref-ccb fun) (ccb-vs-push)) ++ )) ++ ++ (dolist** (def local-funs) ++ (setf (fun-level (car def)) *level*) ++ ;; Append *initial-ccb-vs* here and use it to initialize *initial-ccb-vs* when writing ++ ;; the code for this function. Local functions, unlike closures, get an envinment ++ ;; level with the *initial-ccb-vs* at this point, and *ccb-vs* can be further incremented ++ ;; here, in c2tagbody-ccb, and in c2block-ccb. CM 20031130 ++ (push (list nil *clink* *ccb-vs* (car def) (cadr def) *initial-ccb-vs*) *local-funs*)) ++ ++ ;;; Then make closures. ++ (dolist** (def closures) ++ (push (list 'closure (if (null *clink*) nil (cons 0 0)) ++ *ccb-vs* (car def) (cadr def)) ++ *local-funs*) ++ (push (car def) *closures*) ++ (wt-nl) ++ (wt-vs* (fun-ref (car def))) ++ (wt "=make_cclosure_new(" (c-function-name "LC" (fun-cfun (car def)) (fun-name (car def))) ",Cnil,") (wt-clink) ++ (wt ",Cdata);") ++ ) ++ ++ ;;; now the body of flet ++ ++ (c2expr body) ++ ) ++ ++(defun c1macrolet (args &aux body ss ts is other-decl ++ (*funs* *funs*) (*vars* *vars*)) ++ (when (endp args) (too-few-args 'macrolet 1 0)) ++ (dolist** (def (car args)) ++ (cmpck (or (endp def) (not (symbolp (car def))) (endp (cdr def))) ++ "The macro definition ~s is illegal." def) ++ (push (list (car def) ++ (caddr (si:defmacro* (car def) (cadr def) (cddr def)))) ++ *funs*)) ++ (multiple-value-setq (body ss ts is other-decl) (c1body (cdr args) t)) ++ (c1add-globals ss) ++ (check-vdecl nil ts is) ++ (c1decl-body other-decl body) ++ ) ++ ++(defun c1local-fun (fname &aux (ccb nil)) ++ (declare (object ccb)) ++ (dolist* (fun *funs* nil) ++ (cond ((eq fun 'CB) (setq ccb t)) ++ ((consp fun) ++ (when (eq (car fun) fname) (return (cadr fun)))) ++ ((eq (fun-name fun) fname) ++ (if ccb ++ (setf (fun-ref-ccb fun) t) ++ (setf (fun-ref fun) t)) ++ ;; Add fun-info here at the bottom of the call-local processing tree ++ ;; FIXME -- understand why special variable *info* is used in certain ++ ;; cases and copy-info in othes. ++ ;; This extends local call arg side-effect protection (via args-info-changed-vars) ++ ;; through c1funob to other call methods than previously supported c1symbol-fun, ++ ;; e.g. c1multiple-value-call, etc. CM 20031030 ++ (add-info *info* (fun-info fun)) ++ (return (list 'call-local *info* fun ccb)))))) ++ ++(defun sch-local-fun (fname) ++ ;;; Returns fun-ob for the local function (not locat macro) named FNAME, ++ ;;; if any. Otherwise, returns FNAME itself. ++ (dolist* (fun *funs* fname) ++ (when (and (not (eq fun 'CB)) ++ (not (consp fun)) ++ (eq (fun-name fun) fname)) ++ (return fun))) ++ ) ++ ++(defun c1local-closure (fname &aux (ccb nil)) ++ (declare (object ccb)) ++ ;;; Called only from C1FUNCTION. ++ (dolist* (fun *funs* nil) ++ (cond ((eq fun 'CB) (setq ccb t)) ++ ((consp fun) ++ (when (eq (car fun) fname) (return (cadr fun)))) ++ ((eq (fun-name fun) fname) ++ (setf (fun-ref-ccb fun) t) ++ ;; Add fun-info here at the bottom of the call-local processing tree ++ ;; FIXME -- understand why special variable *info* is used in certain ++ ;; cases and copy-info in othes. ++ ;; This extends local call arg side-effect protection (via args-info-changed-vars) ++ ;; through c1funob to other call methods than previously supported c1symbol-fun, ++ ;; e.g. c1multiple-value-call, etc. CM 20031030 ++ (add-info *info* (fun-info fun)) ++ (return (list 'call-local *info* fun ccb)))))) ++ ++(defun c2call-local (fd args &aux (*vs* *vs*)) ++ ;;; FD is a list ( fun-object ccb ). ++ (cond ++ ((cadr fd) ++ (push-args args) ++ (wt-nl "cclosure_call(") (wt-ccb-vs (fun-ref-ccb (car fd))) (wt ");")) ++ ((and (listp args) ++ *do-tail-recursion* ++ *tail-recursion-info* ++ (eq (car *tail-recursion-info*) (car fd)) ++ (eq *exit* 'RETURN) ++ (tail-recursion-possible) ++ (= (length args) (length (cdr *tail-recursion-info*)))) ++ (let* ((*value-to-go* 'trash) ++ (*exit* (next-label)) ++ (*unwind-exit* (cons *exit* *unwind-exit*))) ++ (c2psetq (mapcar #'(lambda (v) (list v nil)) ++ (cdr *tail-recursion-info*)) ++ args) ++ (wt-label *exit*)) ++ (unwind-no-exit 'tail-recursion-mark) ++ (wt-nl "goto TTL;") ++ (cmpnote "Tail-recursive call of ~s was replaced by iteration." ++ (fun-name (car fd)))) ++ (t (push-args args) ++ (wt-nl (c-function-name "L" (fun-cfun (car fd)) (fun-name (car fd))) "(") ++ (dotimes** (n (fun-level (car fd))) (wt "base" n ",")) ++ (wt "base") ++ (unless (= (fun-level (car fd)) *level*) (wt (fun-level (car fd)))) ++ (wt ");") ++ (base-used))) ++ (unwind-exit 'fun-val) ++ ) ++ +--- gcl-2.6.7.orig/cmpnew/gcl_cmpopt.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmpopt.lsp +@@ -371,12 +371,12 @@ + (get 'append 'inline-always)) + + ;;AREF +- (push '((t t) t #.(flags ans)"aref1(#0,fixint(#1))") +- (get 'aref 'inline-always)) +-(push '((t fixnum) t #.(flags ans)"aref1(#0,#1)") +- (get 'aref 'inline-always)) +-(push '((t t) t #.(flags ans)"aref1(#0,fix(#1))") +- (get 'aref 'inline-unsafe)) ++;; (push '((t t) t #.(flags ans)"aref1(#0,fixint(#1))") ++;; (get 'aref 'inline-always)) ++;; (push '((t fixnum) t #.(flags ans)"aref1(#0,#1)") ++;; (get 'aref 'inline-always)) ++;; (push '((t t) t #.(flags ans)"aref1(#0,fix(#1))") ++;; (get 'aref 'inline-unsafe)) + (push '(((array t) fixnum) t #.(flags)"(#0)->v.v_self[#1]") + (get 'aref 'inline-unsafe)) + (push '(((array string-char) fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]") +@@ -396,9 +396,9 @@ + (get 'aref 'inline-unsafe)) + (push '(((array long-float) fixnum) long-float #.(flags rfa)"(#0)->lfa.lfa_self[#1]") + (get 'aref 'inline-unsafe)) +-(push '((t t t) t #.(flags ans) +- "@0;aref(#0,fix(#1)*(#0)->a.a_dims[1]+fix(#2))") +- (get 'aref 'inline-unsafe)) ++;; (push '((t t t) t #.(flags ans) ++;; "@0;aref(#0,fix(#1)*(#0)->a.a_dims[1]+fix(#2))") ++;; (get 'aref 'inline-unsafe)) + (push '(((array t) fixnum fixnum) t #.(flags ) + "@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]") + (get 'aref 'inline-unsafe)) +@@ -936,20 +936,39 @@ type_of(#0)==t_bitvector") + (get 'nreverse 'inline-always)) + + ;;NTH +- (push '((t t) t #.(flags)"nth(fixint(#0),#1)") +- (get 'nth 'inline-always)) +-(push '((fixnum t) t #.(flags)"nth(#0,#1)") +- (get 'nth 'inline-always)) +-(push '((t t) t #.(flags)"nth(fix(#0),#1)") ++; (push '((t t) t #.(flags)"nth(fixint(#0),#1)") ++; (get 'nth 'inline-always)) ++; (push '((fixnum t) t #.(flags)"nth(#0,#1)") ++; (get 'nth 'inline-always)) ++; (push '((t t) t #.(flags)"nth(fix(#0),#1)") ++; (get 'nth 'inline-unsafe)) ++ ++;(push '((fixnum proper-list) proper-list #.(flags rfa)"({register fixnum _i=#0;register object _x=#1;for (;_i--;_x=_x->c.c_cdr);_x->c.c_car;})") ++; (get 'nth 'inline-always)) ++;(push '(((and (integer 0) (not fixnum)) proper-list) null #.(flags rfa)"Cnil") ++; (get 'nth 'inline-always)) ++(push '((fixnum t) t #.(flags)"({register fixnum _i=#0;register object _x=#1;for (;_i--;_x=_x->c.c_cdr);_x->c.c_car;})") + (get 'nth 'inline-unsafe)) ++;(push '(((not fixnum) proper-list) null #.(flags rfa)"Cnil") ++; (get 'nth 'inline-unsafe)) + + ;;NTHCDR +- (push '((t t) t #.(flags)"nthcdr(fixint(#0),#1)") +- (get 'nthcdr 'inline-always)) +-(push '((fixnum t) t #.(flags)"nthcdr(#0,#1)") +- (get 'nthcdr 'inline-always)) +-(push '((t t) t #.(flags)"nthcdr(fix(#0),#1)") ++; (push '((t t) t #.(flags)"nthcdr(fixint(#0),#1)") ++; (get 'nthcdr 'inline-always)) ++; (push '((fixnum t) t #.(flags)"nthcdr(#0,#1)") ++; (get 'nthcdr 'inline-always)) ++; (push '((t t) t #.(flags)"nthcdr(fix(#0),#1)") ++; (get 'nthcdr 'inline-unsafe)) ++ ++;(push '((fixnum proper-list) proper-list #.(flags rfa)"({register fixnum _i=#0;register object _x=#1;for (;_i--;_x=_x->c.c_cdr);_x;})") ++; (get 'nthcdr 'inline-always)) ++;(push '(((and (integer 0) (not fixnum)) proper-list) null #.(flags rfa)"Cnil") ++; (get 'nthcdr 'inline-always)) ++(push '((fixnum t) t #.(flags)"({register fixnum _i=#0;register object _x=#1;for (;_i--;_x=_x->c.c_cdr);_x;})") + (get 'nthcdr 'inline-unsafe)) ++;(push '(((not fixnum) proper-list) null #.(flags rfa)"Cnil") ++; (get 'nthcdr 'inline-unsafe)) ++ + + ;;NULL + (push '((t) boolean #.(flags)"(#0)==Cnil") +@@ -1051,10 +1070,10 @@ TRUNCATE_USE_C + (get 'stringp 'inline-always)) + + ;;SVREF +- (push '((t t) t #.(flags ans)"aref1(#0,fixint(#1))") +- (get 'svref 'inline-always)) +-(push '((t fixnum) t #.(flags ans)"aref1(#0,#1)") +- (get 'svref 'inline-always)) ++;; (push '((t t) t #.(flags ans)"aref1(#0,fixint(#1))") ++;; (get 'svref 'inline-always)) ++;; (push '((t fixnum) t #.(flags ans)"aref1(#0,#1)") ++;; (get 'svref 'inline-always)) + (push '((t t) t #.(flags)"(#0)->v.v_self[fix(#1)]") + (get 'svref 'inline-unsafe)) + (push '((t fixnum) t #.(flags)"(#0)->v.v_self[#1]") +--- gcl-2.6.7.orig/cmpnew/gcl_cmpblock.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmpblock.lsp +@@ -163,8 +163,7 @@ + (defun c2return-ccb (blk val) + (wt-nl "{frame_ptr fr;") + (wt-nl "fr=frs_sch(") (wt-ccb-vs (blk-ref-ccb blk)) (wt ");") +- (wt-nl "if(fr==NULL) FEerror(\"The block ~s is missing.\",1,VV[" +- (blk-var blk) "]);") ++ (wt-nl "if(fr==NULL) FEerror(\"The block ~s is missing.\",1," (vv-str (blk-var blk)) ");") + (let ((*value-to-go* 'top)) (c2expr* val)) + (wt-nl "unwind(fr,Cnil);}") + ) +--- gcl-2.6.7.orig/cmpnew/gcl_cmpif.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmpif.lsp +@@ -376,9 +376,9 @@ + (case (car keylist) + ((t) (wt "Ct")) + ((nil) (wt "Cnil")) +- (otherwise (wt "VV[" (add-symbol (car keylist)) "]"))) ++ (otherwise (wt (vv-str (add-symbol (car keylist)))))) + (wt ")")) +- (t (wt "eql(V" cvar ",VV[" (car keylist) "])"))) ++ (t (wt "eql(V" cvar "," (vv-str (car keylist)) ")"))) + (when (< i 4) (wt-nl "|| ")) + (pop keylist)) + (wt ")") +@@ -392,9 +392,9 @@ + (case (car keylist) + ((t) (wt "Ct")) + ((nil) (wt "Cnil")) +- (otherwise (wt "VV[" (add-symbol (car keylist)) "]"))) ++ (otherwise (wt (vv-str (add-symbol (car keylist)))))) + (wt ")")) +- (t (wt "!eql(V" cvar ",VV[" (car keylist) "])"))) ++ (t (wt "!eql(V" cvar "," (vv-str (car keylist)) ")"))) + (unless (endp (cdr keylist)) (wt-nl "&& ")) + (pop keylist)) + (wt ")") +--- gcl-2.6.7.orig/cmpnew/makefile ++++ gcl-2.6.7/cmpnew/makefile +@@ -11,21 +11,21 @@ APPEND=../xbin/append + OBJS = gcl_cmpbind.o gcl_cmpblock.o gcl_cmpcall.o gcl_cmpcatch.o gcl_cmpenv.o gcl_cmpeval.o \ + gcl_cmpflet.o gcl_cmpfun.o gcl_cmpif.o gcl_cmpinline.o gcl_cmplabel.o gcl_cmplam.o gcl_cmplet.o \ + gcl_cmploc.o gcl_cmpmap.o gcl_cmpmulti.o gcl_cmpspecial.o gcl_cmptag.o gcl_cmptop.o \ +- gcl_cmptype.o gcl_cmputil.o gcl_cmpvar.o gcl_cmpvs.o gcl_cmpwt.o # gcl_cmpmain.o gcl_cmpopt.o gcl_lfun_list.o ++ gcl_cmptype.o gcl_cmputil.o gcl_cmpvar.o gcl_cmpvs.o gcl_cmpwt.o gcl_cmpmain.o #gcl_cmpopt.o gcl_lfun_list.o + + FNS:= $(OBJS:.o=.fn) + +-COMPILE_FILE=$(PORTDIR)/saved_pre_gcl $(PORTDIR) -system-p -c-file -data-file \ ++COMPILE_FILE=$(PORTDIR)/saved_pre_gcl$(EXE) $(PORTDIR) -system-p -c-file -data-file \ + -o-file nil -h-file -compile + #CFLAGS = -c -O -I../h + + .lsp.c: +- @ ../xbin/if-exists $(PORTDIR)/saved_pre_gcl \ ++ @ ../xbin/if-exists $(PORTDIR)/saved_pre_gcl$(EXE) \ + "rm -f $*.c $*.h $*.data $*.o" \ + "$(COMPILE_FILE) $* " + + .lsp.o: +- @ ../xbin/if-exists $(PORTDIR)/saved_pre_gcl \ ++ @ ../xbin/if-exists $(PORTDIR)/saved_pre_gcl$(EXE) \ + "rm -f $*.c $*.h $*.data $*.o" \ + "$(COMPILE_FILE) $* " \ + "$(CC) $(OFLAG) $(CFLAGS) -c $*.c" \ +@@ -42,11 +42,11 @@ all: $(OBJS) + ${APPEND} ${NULLFILE} $*.data $*.o + + gcl_collectfn.o: +- $(PORTDIR)/saved_pre_gcl $(PORTDIR)/ -compile $*.lsp ++ $(PORTDIR)/saved_pre_gcl$(EXE) $(PORTDIR)/ -compile $*.lsp + + .lisp.o: +- @ ../xbin/if-exists $(PORTDIR)/saved_pre_gcl \ +- "$(PORTDIR)/saved_pre_gcl $(PORTDIR)/ -compile $*.lisp " ++ @ ../xbin/if-exists $(PORTDIR)/saved_pre_gcl$(EXE) \ ++ "$(PORTDIR)/saved_pre_gcl$(EXE) $(PORTDIR)/ -compile $*.lisp " + sys-proclaim.lisp: $(FNS) + echo '(in-package "COMPILER")' \ + '(load "../cmpnew/gcl_collectfn")(load "../lsp/sys-proclaim.lisp")'\ +--- gcl-2.6.7.orig/cmpnew/gcl_cmploc.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmploc.lsp +@@ -178,7 +178,9 @@ + (if type (wt "/* " (symbol-name type) " */")) + (wt "V" cvar)) + +-(defun wt-vv (vv) (wt "VV[" vv "]")) ++(defun vv-str (vv) (si::string-concatenate "((object)VV[" (write-to-string vv) "])")) ++ ++(defun wt-vv (vv) (wt (vv-str vv))) + + (defun wt-fixnum-loc (loc) + (cond ((and (consp loc) +@@ -224,7 +226,7 @@ + (eq (car loc) 'fixnum-value)))) + + (defun wt-fixnum-value (vv fixnum-value) +- (if vv (wt "VV[" vv "]") ++ (if vv (wt (vv-str vv)) + (wt "small_fixnum(" fixnum-value ")"))) + + +@@ -248,7 +250,7 @@ + + (defun wt-character-value (vv character-code) + (declare (ignore character-code)) +- (wt "VV[" vv "]")) ++ (wt (vv-str vv))) + + (defun wt-long-float-loc (loc) + (cond ((and (consp loc) +@@ -270,7 +272,7 @@ + + (defun wt-long-float-value (vv long-float-value) + (declare (ignore long-float-value)) +- (wt "VV[" vv "]")) ++ (wt (vv-str vv))) + + (defun wt-short-float-loc (loc) + (cond ((and (consp loc) +@@ -292,4 +294,4 @@ + + (defun wt-short-float-value (vv short-float-value) + (declare (ignore short-float-value)) +- (wt "VV[" vv "]")) ++ (wt (vv-str vv))) +--- gcl-2.6.7.orig/cmpnew/gcl_lfun_list.lsp ++++ gcl-2.6.7/cmpnew/gcl_lfun_list.lsp +@@ -22,7 +22,7 @@ + (DEFSYSFUN 'MAKE-LIST "Lmake_list" '(T *) 'T NIL NIL) + (DEFSYSFUN 'HOST-NAMESTRING "Lhost_namestring" '(T) 'STRING NIL NIL) + (DEFSYSFUN 'MAKE-ECHO-STREAM "Lmake_echo_stream" '(T T) 'T NIL NIL) +-(DEFSYSFUN 'NTH "Lnth" '(T T) 'T NIL NIL) ++;(DEFSYSFUN 'NTH "Lnth" '(T T) 'T NIL NIL) + (DEFSYSFUN 'SIN "Lsin" '(T) 'T NIL NIL) + (DEFSYSFUN 'NUMERATOR "Lnumerator" '(T) 'T NIL NIL) + (DEFSYSFUN 'ARRAY-RANK "Larray_rank" '(T) 'FIXNUM NIL NIL) +@@ -48,14 +48,14 @@ + (DEFSYSFUN 'PATHNAME-HOST "Lpathname_host" '(T) 'T NIL NIL) + (DEFSYSFUN 'NSUBST-IF-NOT "Lnsubst_if_not" '(T T T *) 'T NIL NIL) + (DEFSYSFUN 'FILE-POSITION "Lfile_position" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'STRING< "Lstring_l" '(T T *) 'T NIL T) ++(DEFSYSFUN 'STRING< "Lstring_l" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'REVERSE "Lreverse" '(T) 'T NIL NIL) + (DEFSYSFUN 'STREAMP "Lstreamp" '(T) 'T NIL T) + (DEFSYSFUN 'SYSTEM::PUTPROP "siLputprop" '(T T T) 'T NIL NIL) + (DEFSYSFUN 'REMPROP "Lremprop" '(T T) 'T NIL NIL) + (DEFSYSFUN 'SYMBOL-PACKAGE "Lsymbol_package" '(T) 'T NIL NIL) + (DEFSYSFUN 'NSTRING-UPCASE "Lnstring_upcase" '(T *) 'STRING NIL NIL) +-(DEFSYSFUN 'STRING>= "Lstring_ge" '(T T *) 'T NIL T) ++(DEFSYSFUN 'STRING>= "Lstring_ge" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'REALPART "Lrealpart" '(T) 'T NIL NIL) + ;;broken on suns.. + ;(DEFSYSFUN 'USER-HOMEDIR-PATHNAME "Luser_homedir_pathname" '(*) 'T NIL +@@ -66,7 +66,7 @@ + (DEFSYSFUN 'EQL "Leql" '(T T) 'T NIL T) + (DEFSYSFUN 'LOG "Llog" '(T *) 'T NIL NIL) + (DEFSYSFUN 'DIRECTORY "Ldirectory" '(T) 'T NIL NIL) +-(DEFSYSFUN 'STRING-NOT-EQUAL "Lstring_not_equal" '(T T *) 'T NIL T) ++(DEFSYSFUN 'STRING-NOT-EQUAL "Lstring_not_equal" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'SHADOWING-IMPORT "Lshadowing_import" '(T *) 'T NIL NIL) + (DEFSYSFUN 'MAPC "Lmapc" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'MAPL "Lmapl" '(T T *) 'T NIL NIL) +@@ -90,7 +90,7 @@ + (DEFSYSFUN 'SET-MACRO-CHARACTER "Lset_macro_character" '(T T *) 'T NIL + NIL) + (DEFSYSFUN 'FORCE-OUTPUT "Lforce_output" '(*) 'T NIL NIL) +-(DEFSYSFUN 'NTHCDR "Lnthcdr" '(T T) 'T NIL NIL) ++;(DEFSYSFUN 'NTHCDR "Lnthcdr" '(T T) 'T NIL NIL) + (DEFSYSFUN 'LOGIOR "Llogior" '(*) 'T NIL NIL) + (DEFSYSFUN 'CHAR-DOWNCASE "Lchar_downcase" '(T) 'CHARACTER NIL NIL) + (DEFSYSFUN 'STRING-CHAR-P "Lstring_char_p" '(T) 'T NIL T) +@@ -126,9 +126,8 @@ + (DEFSYSFUN 'TERPRI "Lterpri" '(*) 'T NIL NIL) + (DEFSYSFUN 'NSUBST "Lnsubst" '(T T T *) 'T NIL NIL) + (DEFSYSFUN 'UNUSE-PACKAGE "Lunuse_package" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'STRING-NOT-GREATERP "Lstring_not_greaterp" '(T T *) 'T NIL +- T) +-(DEFSYSFUN 'STRING> "Lstring_g" '(T T *) 'T NIL T) ++(DEFSYSFUN 'STRING-NOT-GREATERP "Lstring_not_greaterp" '(T T *) 'T NIL NIL) ++(DEFSYSFUN 'STRING> "Lstring_g" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'FINISH-OUTPUT "Lfinish_output" '(*) 'T NIL NIL) + (DEFSYSFUN 'SPECIAL-FORM-P "Lspecial_form_p" '(T) 'T NIL T) + (DEFSYSFUN 'STRINGP "Lstringp" '(T) 'T NIL T) +@@ -169,7 +168,7 @@ + (DEFSYSFUN 'BUTLAST "Lbutlast" '(T *) 'T NIL NIL) + (DEFSYSFUN '1- "Lone_minus" '(T) 'T NIL NIL) + (DEFSYSFUN 'MAKE-HASH-TABLE "Lmake_hash_table" '(*) 'T NIL NIL) +-(DEFSYSFUN 'STRING/= "Lstring_neq" '(T T *) 'T NIL T) ++(DEFSYSFUN 'STRING/= "Lstring_neq" '(T T *) 'T NIL NIL) + (DEFSYSFUN '<= "Lmonotonically_nondecreasing" '(T *) 'T NIL T) + (DEFSYSFUN 'MAKE-BROADCAST-STREAM "Lmake_broadcast_stream" '(*) 'T NIL + NIL) +@@ -178,7 +177,7 @@ + (DEFSYSFUN 'READ-CHAR "Lread_char" '(*) 'T NIL NIL) + (DEFSYSFUN 'PEEK-CHAR "Lpeek_char" '(*) 'T NIL NIL) + (DEFSYSFUN 'CHAR-FONT "Lchar_font" '(T) 'FIXNUM NIL NIL) +-(DEFSYSFUN 'STRING-GREATERP "Lstring_greaterp" '(T T *) 'T NIL T) ++(DEFSYSFUN 'STRING-GREATERP "Lstring_greaterp" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'OUTPUT-STREAM-P "Loutput_stream_p" '(T) 'T NIL T) + (DEFSYSFUN 'ASH "Lash" '(T T) 'T NIL NIL) + (DEFSYSFUN 'LCM "Llcm" '(T *) 'T NIL NIL) +@@ -247,7 +246,7 @@ + (DEFSYSFUN 'CLOSE "Lclose" '(T *) 'T NIL NIL) + (DEFSYSFUN 'DENOMINATOR "Ldenominator" '(T) 'T NIL NIL) + (DEFSYSFUN 'FLOAT "Lfloat" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'FIRST "Lcar" '(T) 'T NIL NIL) ++;(DEFSYSFUN 'FIRST "Lcar" '(T) 'T NIL NIL) + (DEFSYSFUN 'ROUND "Lround" '(T *) '(VALUES T T) NIL NIL) + (DEFSYSFUN 'SUBST "Lsubst" '(T T T *) 'T NIL NIL) + (DEFSYSFUN 'UPPER-CASE-P "Lupper_case_p" '(T) 'T NIL T) +@@ -326,7 +325,7 @@ + (DEFSYSFUN 'FRESH-LINE "Lfresh_line" '(*) 'T NIL NIL) + (DEFSYSFUN 'WRITE-CHAR "Lwrite_char" '(T *) 'T NIL NIL) + (DEFSYSFUN 'PARSE-NAMESTRING "Lparse_namestring" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'STRING-NOT-LESSP "Lstring_not_lessp" '(T T *) 'T NIL T) ++(DEFSYSFUN 'STRING-NOT-LESSP "Lstring_not_lessp" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'CHAR "Lchar" '(T T) 'CHARACTER NIL NIL) + (DEFSYSFUN 'AREF "Laref" '(T *) 'T NIL NIL) + (DEFSYSFUN 'PACKAGE-NICKNAMES "Lpackage_nicknames" '(T) 'T NIL NIL) +@@ -365,7 +364,7 @@ + (DEFSYSFUN 'VECTORP "Lvectorp" '(T) 'T NIL T) + (DEFSYSFUN 'ASSOC-IF "Lassoc_if" '(T T) 'T NIL NIL) + (DEFSYSFUN 'GET-PROPERTIES "Lget_properties" '(T T) '* NIL NIL) +-(DEFSYSFUN 'STRING<= "Lstring_le" '(T T *) 'T NIL T) ++(DEFSYSFUN 'STRING<= "Lstring_le" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'EVALHOOK "Levalhook" '(T T T *) 'T NIL NIL) + (DEFSYSFUN 'FILE-WRITE-DATE "Lfile_write_date" '(T) 'T NIL NIL) + (DEFSYSFUN 'LOGCOUNT "Llogcount" '(T) 'T NIL NIL) +@@ -406,7 +405,7 @@ + NIL) + (DEFSYSFUN 'APPEND "Lappend" '(*) 'T NIL NIL) + (DEFSYSFUN 'MEMBER "Lmember" '(T T *) 'T NIL NIL) +-(DEFSYSFUN 'STRING-LESSP "Lstring_lessp" '(T T *) 'T NIL T) ++(DEFSYSFUN 'STRING-LESSP "Lstring_lessp" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'RANDOM "Lrandom" '(T *) 'T NIL NIL) + (DEFSYSFUN 'SYSTEM::SPECIALP "siLspecialp" '(T) 'T NIL T) + (DEFSYSFUN 'SYSTEM::OUTPUT-STREAM-STRING "siLoutput_stream_string" '(T) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_dwexports.lsp +@@ -0,0 +1,153 @@ ++; dwexports.lsp Gordon S. Novak Jr. 26 Jan 2006 ++ ++ ++(setf (get 'xlib::int-pos 'user::glfnresulttype) 'lisp::integer) ++ ++(in-package :xlib) ++ ++; exported symbols: from dwimports.lsp ++(dolist (x '( menu stringify window picmenu textmenu editmenu barmenu ++ window-get-mouse-position window-create window-set-font ++ window-font-info window-gcontext window-parent ++ window-drawable-height window-drawable-width window-label ++ window-font window-foreground window-set-foreground ++ window-background window-set-background window-wfunction ++ window-get-geometry window-get-geometry-b window-sync ++ window-screen-height window-geometry window-size ++ window-left window-top-neg-y window-reset-geometry ++ window-force-output window-query-pointer window-set-xor ++ window-unset window-reset window-set-erase ++ window-set-copy window-set-invert window-set-line-width ++ window-set-line-attr window-std-line-attr window-draw-line ++ window-draw-line-xy window-draw-arrowhead-xy ++ window-draw-arrow-xy window-draw-arrow2-xy window-draw-box ++ window-draw-box-xy window-xor-box-xy window-draw-box-corners ++ window-draw-rcbox-xy window-draw-arc-xy ++ window-draw-circle-xy window-draw-circle window-erase-area ++ window-erase-area-xy window-erase-box-xy ++ window-draw-ellipse-xy window-copy-area-xy window-invertarea ++ window-invert-area window-invert-area-xy ++ window-prettyprintat window-prettyprintat-xy window-printat ++ window-printat-xy window-string-width window-string-height ++ window-string-extents window-font-string-width ++ window-yposition window-centeroffset dowindowcom ++ window-menu window-close window-unmap window-open ++ window-map window-destroy window-destroy-selected-window ++ window-clear window-moveto-xy window-paint ++ window-move window-draw-border window-track-mouse ++ window-wait-exposure window-wait-unmap ++ window-init-mouse-poll window-poll-mouse menu-init ++ menu-calculate-size menu-adjust-offset menu-draw ++ menu-item-value menu-find-item-width menu-find-item-height ++ menu-clear menu-display-item menu-choose menu-box-item ++ menu-unbox-item menu-item-position menu-select ++ menu-select! menu-select-b menu-destroy ++ menu-create menu-offset menu-size menu-moveto-xy ++ menu-reposition picmenu-create picmenu-create-spec ++ picmenu-create-from-spec picmenu-calculate-size picmenu-init ++ picmenu-draw picmenu-draw-button picmenu-delete-named-button ++ picmenu-select picmenu-box-item picmenu-unbox-item ++ picmenu-destroy picmenu-button-containsxy? ++ picmenu-item-position barmenu-create ++ barmenu-calculate-size barmenu-init barmenu-draw ++ barmenu-select barmenu-update-value window-get-point ++ window-get-click window-get-line-position ++ window-get-latex-position window-get-box-position ++ window-get-icon-position window-get-region ++ window-get-box-size window-track-mouse-in-region ++ window-adjust-box-side window-adj-box-xy window-get-circle ++ window-circle-radius window-draw-circle-pt ++ window-get-ellipse window-draw-ellipse-pt ++ window-draw-vector-pt window-get-vector-end ++ window-get-crosshairs window-draw-crosshairs-xy ++ window-get-cross window-draw-cross-xy window-draw-dot-xy ++ window-draw-latex-xy window-reset-color ++ window-set-color-rgb window-set-xcolor window-set-color ++ window-set-color window-free-color window-get-chars ++ window-process-char-event window-input-string ++ window-input-char-fn window-draw-carat window-init-keymap ++ window-set-cursor window-positive-y window-code-char ++ window-get-raw-char ++ window-print-line window-print-lines textmenu-create ++ textmenu-calculate-size textmenu-init textmenu-draw ++ textmenu-select textmenu-set-text textmenu ++ editmenu editmenu-create editmenu-calculate-size ++ editmenu-init editmenu-draw editmenu-display ++ window-edit ++ window-edit-display editmenu-carat editmenu-erase ++ window-edit-erase editmenu-select editmenu-edit-fn ++ window-edit-fn editmenu-setxy editmenu-char ++ editmenu-edit ++ *window-editmenu-kill-strings* ++*window-add-menu-title* ++*window-menu* ++*mouse-x* ++*mouse-y* ++*mouse-window* ++*window-fonts* ++*window-display* ++*window-screen* ++*root-window* ++*black-pixel* ++*white-pixel* ++*default-fg-color* ++*default-bg-color* ++*default-size-hints* ++*default-GC* ++*default-colormap* ++*window-event* ++*window-default-pos-x* ++*window-default-pos-y* ++*window-default-border* ++*window-default-font-name* ++*window-default-cursor* ++*window-save-foreground* ++*window-save-function* ++*window-attributes* ++*window-attr* ++*menu-title-pad* ++*root-return* ++*child-return* ++*root-x-return* ++*root-y-return* ++*win-x-return* ++*win-y-return* ++*mask-return* ++*x-return* ++*y-return* ++*width-return* ++*height-return* ++*depth-return* ++*border-width-return* ++*text-width-return* ++*direction-return* ++*ascent-return* ++*descent-return* ++*overall-return* ++*GC-Values* ++*window-xcolor* ++*window-menu-code* ++ ++*window-keymap* ++*window-shiftkeymap* ++*window-keyinit* ++*window-meta* ++*window-ctrl* ++*window-shift* ++*window-string* ++*window-string-count* ++*window-string-max* ++*window-input-string-x* ++*window-input-string-y* ++*window-input-string-charwidth* ++ ++*window-shift-keys* ++*window-control-keys* ++*window-meta-keys* ++*barmenu-update-value-cons* ++*picmenu-no-selection* ++*min-keycodes-return* ++*max-keycodes-return* ++*keycodes-return* ++ )) ++ (export x)) ; export the above symbols +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_imports.lsp +@@ -0,0 +1,728 @@ ++; From: Bill Schelter imports.lsp 16 Nov 94 ++ ++; Copyright (c) 1994 William Schelter and The University of Texas at Austin. ++ ++; See the file gnu.license . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++; The following will make ALL currently defined functions and special variables ++; in the xlib package be imported into user. ++ ++(in-package :XLIB) ++ ++(import '(SET-XGCVALUES-SUBWINDOW_MODE SET-XGCVALUES-ARC_MODE WINDOW-SET-CURSOR ++ MAKE-XVISUALINFO XCOLORMAPEVENT-SERIAL XGCVALUES-LINE_WIDTH ++ WINDOW-CIRCLE-RADIUS XVISIBILITYEVENT-SERIAL XCOLOR-GREEN ++ XTEXTPROPERTY-VALUE XCREATEREGION XGCVALUES-SUBWINDOW_MODE ++ MAKE-XTEXTPROPERTY PICMENU-CREATE XDISPLAYKEYCODES XGCVALUES-DASHES ++ WINDOW-CLOSE SET-XGCVALUES-BACKGROUND SET-XGCVALUES-FOREGROUND ++ XUNIONRECTWITHREGION XTEXTITEM-DELTA XCONNECTIONNUMBER ++ MAKE-XEXTCODES SCREENFORMAT-SCANLINE_PAD XFREEGC XARC-HEIGHT ++ XPARSECOLOR XKEYCODETOKEYSYM XBUTTONEVENT-TIME WINDOW-SET-INVERT ++ XPROTOCOLREVISION XPROTOCOLVERSION SET-XFOCUSCHANGEEVENT-TYPE ++ BARMENU-INIT XSTANDARDCOLORMAP-BLUE_MULT ++ XSTANDARDCOLORMAP-GREEN_MULT XSTANDARDCOLORMAP-RED_MULT ++ SET-XCOLOR-FLAGS XQUERYTREE XQUERYCOLOR MAKE-DEPTH XCHANGESAVESET ++ XCOLORMAPEVENT-COLORMAP SET-XRECTANGLE-HEIGHT XBUTTONEVENT-TYPE ++ XALLOWEVENTS XDRAWRECTANGLES XSETFILLRULE ++ XGCVALUES-GRAPHICS_EXPOSURES XSETFILLSTYLE XCOLOR-FLAGS ++ SET-XKEYBOARDCONTROL-LED_MODE XSETSTATE XBUTTONEVENT-STATE ++ XQUERYTEXTEXTENTS SCREEN-DEPTHS SCREEN-NDEPTHS MENU-INIT ++ SET-XGCVALUES-LINE_WIDTH SCREENFORMAT-DEPTH XINSTALLCOLORMAP XARC-Y ++ SET-XFOCUSCHANGEEVENT-SERIAL XOFFSETREGION SET-XFONTPROP-CARD32 ++ XIMAGE-BITMAP_BIT_ORDER SET-XWMHINTS-INITIAL_STATE XSTORECOLOR ++ MAKE-XMAPEVENT XBUTTONEVENT-SERIAL SET-XKEYBOARDCONTROL-BELL_PITCH ++ SET-XKEYBOARDSTATE-BELL_PITCH SET-XKEYEVENT-KEYCODE ++ SCREENFORMAT-BITS_PER_PIXEL XKEYSYMTOSTRING ++ SET-XCLIENTMESSAGEEVENT-FORMAT SET-XRESIZEREQUESTEVENT-WIDTH ++ WINDOW-DRAW-LINE XGCVALUES-PLANE_MASK XFILLRECTANGLES XDRAWSEGMENTS ++ WINDOW-DRAW-CIRCLE SET-XUNMAPEVENT-TYPE XEXPOSEEVENT-HEIGHT ++ XSTANDARDCOLORMAP-BLUE_MAX XSTANDARDCOLORMAP-GREEN_MAX ++ XSTANDARDCOLORMAP-RED_MAX XSETWMSIZEHINTS XKEYEVENT-KEYCODE ++ WINDOW-FORCE-OUTPUT WINDOW-UNMAP XCHARSTRUCT-WIDTH ++ XDEFAULTCOLORMAPOFSCREEN SET-XFOCUSCHANGEEVENT-DETAIL XSEGMENT-X1 ++ SCREEN-ROOT XEDATAOBJECT-SCREEN XSEGMENT-Y1 ++ SET-XMODIFIERKEYMAP-MAX_KEYPERMOD SET-XGCVALUES-CLIP_Y_ORIGIN ++ SET-XGCVALUES-CLIP_X_ORIGIN SET-XGCVALUES-TS_Y_ORIGIN ++ SET-XGCVALUES-TS_X_ORIGIN SET-XGCVALUES-CLIP_MASK ++ SET-XGCVALUES-PLANE_MASK XCHECKMASKEVENT XDEFAULTCOLORMAP ++ XSEGMENT-X2 SCREEN-DISPLAY XBUTTONEVENT-SAME_SCREEN XSEGMENT-Y2 ++ XCREATEWINDOWEVENT-BORDER_WIDTH XCREATEWINDOWEVENT-WIDTH ++ WINDOW-CLEAR SET-SCREEN-EXT_DATA XEXPOSEEVENT-COUNT ++ SET-XUNMAPEVENT-SERIAL SET-XCLIENTMESSAGEEVENT-SEND_EVENT ++ XGCVALUES-TS_Y_ORIGIN XGCVALUES-TS_X_ORIGIN XDRAWARCS ++ XDEFAULTGCOFSCREEN XIMAGE-XOFFSET SET-SCREEN-DEFAULT_GC ++ SET-XCLIENTMESSAGEEVENT-DISPLAY XCOLORMAPEVENT-SEND_EVENT ++ XHOSTADDRESS-FAMILY XPROPERTYEVENT-ATOM XMAPPINGEVENT-TYPE ++ WINDOW-PRINTAT XVISIBILITYEVENT-SEND_EVENT XCOLORMAPEVENT-DISPLAY ++ XCHANGEPROPERTY XDEFAULTDEPTHOFSCREEN XBUTTONEVENT-BUTTON ++ XSETWINDOWATTRIBUTES-BACKING_STORE SET-XCLIENTMESSAGEEVENT-WINDOW ++ XIMAGE-FORMAT XVISIBILITYEVENT-DISPLAY WINDOW-LEFT WINDOW-UNSET ++ VERTEX-ARRAY XCOLORMAPEVENT-WINDOW XBUTTONEVENT-X ++ SET-XWMHINTS-ICON_PIXMAP XEDATAOBJECT-PIXMAP_FORMAT ++ XSELECTIONEVENT-REQUESTOR WINDOW-FONT PICMENU-INIT WINDOW-SET-FONT ++ XEDATAOBJECT-GC XVISIBILITYEVENT-WINDOW XDELETEPROPERTY ++ XFINDONEXTENSIONLIST XGETFONTPATH XBUTTONEVENT-Y ++ WINDOW-CENTEROFFSET SET-XKEYBOARDSTATE-LED_MASK XEDATAOBJECT-FONT ++ XREBINDKEYSYM SCREEN-SAVE_UNDERS SET-XGCVALUES-DASHES ++ XMAPPINGEVENT-SERIAL SET-XARC-Y SET-XARC-X WINDOW-INPUT-STRING ++ SET-XGCVALUES-GRAPHICS_EXPOSURES SET-XCOLOR-BLUE ++ XDEFAULTVISUALOFSCREEN SET-XWMHINTS-FLAGS VISUAL-CLASS ++ SET-XRESIZEREQUESTEVENT-HEIGHT WINDOW-PARENT XMATCHVISUALINFO ++ SET-SCREEN-BACKING_STORE WINDOW-XOR-BOX-XY XFONTSTRUCT-PER_CHAR ++ XFONTSTRUCT-DEFAULT_CHAR SET-XMODIFIERKEYMAP-MODIFIERMAP ++ SET-XWMHINTS-WINDOW_GROUP FREE ++ SET-XSETWINDOWATTRIBUTES-BACKING_PIXEL ++ SET-XSETWINDOWATTRIBUTES-BORDER_PIXEL ++ SET-XSETWINDOWATTRIBUTES-BACKGROUND_PIXEL XMOTIONEVENT-TIME ++ XCHARSTRUCT-DESCENT XCHARSTRUCT-ASCENT SET-XNOEXPOSEEVENT-TYPE ++ XCHARSTRUCT-ATTRIBUTES XARC-WIDTH SET-XFOCUSCHANGEEVENT-SEND_EVENT ++ WINDOW-INIT-MOUSE-POLL XBUTTONEVENT-ROOT XBUTTONEVENT-X_ROOT ++ XBUTTONEVENT-Y_ROOT XMOTIONEVENT-TYPE XCOPYCOLORMAPANDFREE ++ SET-XFOCUSCHANGEEVENT-DISPLAY XBUTTONEVENT-SEND_EVENT ++ XCREATEWINDOWEVENT-HEIGHT XSETWINDOWATTRIBUTES-COLORMAP ++ SET-XKEYBOARDCONTROL-KEY XCHANGEWINDOWATTRIBUTES WINDOW-GCONTEXT ++ WINDOW-DRAW-BORDER XBUTTONEVENT-DISPLAY XSELECTIONEVENT-PROPERTY ++ XNOOP XERROREVENT-MINOR_CODE XERROREVENT-REQUEST_CODE ++ XERROREVENT-ERROR_CODE XMOTIONEVENT-STATE XERROREVENT-RESOURCEID ++ XFREEMODIFIERMAP SET-XFOCUSCHANGEEVENT-WINDOW XGETATOMNAME ++ XGETICONNAME SET-XCONFIGUREEVENT-ABOVE ++ SET-XCONFIGUREREQUESTEVENT-ABOVE WINDOW-INPUT-CHAR-FN ++ WINDOW-PROCESS-CHAR-EVENT XSETWINDOWATTRIBUTES-BORDER_PIXMAP ++ XSETWINDOWATTRIBUTES-BACKGROUND_PIXMAP MAKE-XMOTIONEVENT ++ SET-XKEYBOARDCONTROL-BELL_PERCENT ++ SET-XKEYBOARDCONTROL-KEY_CLICK_PERCENT ++ SET-XKEYBOARDSTATE-BELL_PERCENT ++ SET-XKEYBOARDSTATE-KEY_CLICK_PERCENT XBUTTONEVENT-WINDOW ++ XBUTTONEVENT-SUBWINDOW SET-XWMHINTS-INPUT SET-XNOEXPOSEEVENT-SERIAL ++ SET-XSETWINDOWATTRIBUTES-DO_NOT_PROPAGATE_MASK ++ SET-XSETWINDOWATTRIBUTES-EVENT_MASK SET-XTEXTITEM-DELTA ++ SET-XTEXTITEM16-DELTA XSETWINDOWCOLORMAP XSETWINDOWBACKGROUNDPIXMAP ++ XSETWINDOWBORDERPIXMAP XSETWINDOWATTRIBUTES-SAVE_UNDER ++ XVISUALINFO-SCREEN SET-XKEYBOARDSTATE-AUTO_REPEATS ++ XMOTIONEVENT-SERIAL XGETDEFAULT XQUERYEXTENSION DEPTH-VISUALS ++ SET-XSELECTIONREQUESTEVENT-OWNER XMAPWINDOW WINDOW-DESTROY ++ SET-XCONFIGUREEVENT-TYPE SET-XCONFIGUREREQUESTEVENT-TYPE ++ XCELLSOFSCREEN SET-XWMHINTS-ICON_WINDOW XFONTSTRUCT-MAX_BOUNDS ++ XFONTSTRUCT-MIN_BOUNDS XDEFAULTROOTWINDOW XFONTSTRUCT-DESCENT ++ XFONTSTRUCT-ASCENT SET-XTEXTPROPERTY-VALUE WINDOW-DRAW-BOX-CORNERS ++ SET-XUNMAPEVENT-EVENT SET-XUNMAPEVENT-SEND_EVENT ++ WINDOW-DESTROY-SELECTED-WINDOW WINDOW-POSITIVE-Y XFREEFONTPATH ++ XSETWINDOWBORDER SET-XSETWINDOWATTRIBUTES-BACKING_PLANES ++ XWMHINTS-ICON_MASK SET-XSELECTIONREQUESTEVENT-REQUESTOR ++ SET-XSELECTIONEVENT-REQUESTOR SET-XUNMAPEVENT-DISPLAY XGETWMNAME ++ XSETWINDOWATTRIBUTES-OVERRIDE_REDIRECT WINDOW-DRAW-VECTOR-PT ++ SET-XANYEVENT-TYPE XREMOVEFROMSAVESET XSETWMNAME ++ XDEFAULTSCREENOFDISPLAY XMOTIONEVENT-SAME_SCREEN ++ SET-XUNMAPEVENT-WINDOW XSETWINDOWATTRIBUTES-CURSOR ++ SET-XCONFIGUREEVENT-SERIAL SET-XCONFIGUREREQUESTEVENT-SERIAL ++ WINDOW-DRAW-ARROW2-XY XSELECTIONREQUESTEVENT-OWNER ++ SET-XCOLORMAPEVENT-TYPE MAKE-XPIXMAPFORMATVALUES XNEXTREQUEST ++ MAKE-XWMHINTS SET-XCOLORMAPEVENT-STATE XALLOCWMHINTS SET-XPOINT-X ++ XFREECOLORMAP SET-XANYEVENT-SERIAL XSELECTIONREQUESTEVENT-REQUESTOR ++ XMAPPINGEVENT-SEND_EVENT SET-XCONFIGUREREQUESTEVENT-DETAIL ++ SET-SCREEN-DEPTHS SET-SCREEN-NDEPTHS XFONTPROP-CARD32 ++ SET-SCREEN-SAVE_UNDERS XMAPPINGEVENT-DISPLAY SET-XPOINT-Y ++ SET-XCOLORMAPEVENT-SERIAL XMOTIONEVENT-X WINDOW-DRAW-ARROWHEAD-XY ++ SET-XHOSTADDRESS-LENGTH XMAPPINGEVENT-WINDOW XVISUALINFO-CLASS ++ XREMOVEHOSTS SET-XFONTSTRUCT-EXT_DATA ++ SET-XSELECTIONREQUESTEVENT-PROPERTY SET-XSELECTIONEVENT-PROPERTY ++ XMOTIONEVENT-Y WINDOW-ERASE-BOX-XY MENU-CHOOSE ++ XCONFIGUREEVENT-BORDER_WIDTH XCONFIGUREEVENT-WIDTH XGRABPOINTER ++ SET-XCHARSTRUCT-WIDTH XSETFONTPATH MAKE-XWINDOWATTRIBUTES ++ WINDOW-QUERY-POINTER XMOTIONEVENT-IS_HINT MAKE-XIMAGE ++ SET-XCONFIGUREEVENT-X SET-XCONFIGUREREQUESTEVENT-X ++ SET-XFONTPROP-NAME WINDOW-DRAW-DOT-XY XCOPYAREA SET-SCREEN-DISPLAY ++ SET-XEXTCODES-MAJOR_OPCODE WINDOW-DRAW-RCBOX-XY ++ WINDOW-DRAW-LATEX-XY WINDOW-DRAW-BOX-XY SET-XCONFIGUREEVENT-Y ++ SET-XCONFIGUREREQUESTEVENT-Y SET-XCOLORMAPEVENT-COLORMAP ++ MAKE-XNOEXPOSEEVENT XDRAWLINE XDRAWLINES XSCREENNUMBEROFSCREEN ++ WINDOW-PRETTYPRINTAT XSELECTIONREQUESTEVENT-PROPERTY ++ XWMHINTS-ICON_X SET-XNOEXPOSEEVENT-SEND_EVENT XFREECOLORS ++ XMOTIONEVENT-ROOT XMOTIONEVENT-X_ROOT XMOTIONEVENT-Y_ROOT ++ SET-XCONFIGUREEVENT-OVERRIDE_REDIRECT XMOTIONEVENT-SEND_EVENT ++ SET-XNOEXPOSEEVENT-DISPLAY XWMHINTS-ICON_Y ++ XSETWINDOWATTRIBUTES-WIN_GRAVITY XSETWINDOWATTRIBUTES-BIT_GRAVITY ++ XBLACKPIXELOFSCREEN XRECTANGLE-X XMOTIONEVENT-DISPLAY ++ XDESTROYWINDOW WINDOW-WFUNCTION XRECTANGLE-Y XADDPIXEL ++ SET-SCREENFORMAT-EXT_DATA XGETPIXEL XMOTIONEVENT-WINDOW ++ XMOTIONEVENT-SUBWINDOW SET-XEXPOSEEVENT-WIDTH ++ XWINDOWCHANGES-STACK_MODE XPUTPIXEL XBITMAPBITORDER ++ XDOESBACKINGSTORE XSETFUNCTION XSETICONNAME ++ SET-XCONFIGUREREQUESTEVENT-PARENT SET-XMOTIONEVENT-TIME ++ MAKE-XICONSIZE SET-XCONFIGUREEVENT-EVENT ++ SET-XCONFIGUREEVENT-SEND_EVENT ++ SET-XCONFIGUREREQUESTEVENT-SEND_EVENT SET-XMOTIONEVENT-TYPE ++ XALLOCICONSIZE XDISPLAYNAME XFINDCONTEXT XSIZEHINTS-HEIGHT_INC ++ XSIZEHINTS-WIDTH_INC SET-XCONFIGUREEVENT-DISPLAY ++ SET-XCONFIGUREREQUESTEVENT-DISPLAY XKEYMAPEVENT-TYPE MAKE-VISUAL ++ WINDOW-WAIT-UNMAP SET-XMOTIONEVENT-STATE XTIMECOORD-TIME ++ WINDOW-PRINTAT-XY SET-XCONFIGUREEVENT-WINDOW ++ SET-XCONFIGUREREQUESTEVENT-WINDOW SET-XGRAPHICSEXPOSEEVENT-TYPE ++ SET-XANYEVENT-SEND_EVENT XCONFIGUREEVENT-HEIGHT ++ SET-XANYEVENT-DISPLAY SET-XCHARSTRUCT-DESCENT ++ SET-XCHARSTRUCT-ASCENT XEHEADOFEXTENSIONLIST ++ SET-XCHARSTRUCT-ATTRIBUTES XSIZEHINTS-BASE_WIDTH ++ XSIZEHINTS-MAX_WIDTH XSIZEHINTS-MIN_WIDTH XSIZEHINTS-WIDTH ++ SET-XMOTIONEVENT-SERIAL SET-XIMAGE-BITMAP_PAD XBELL ++ SET-XCREATEWINDOWEVENT-TYPE SET-XHOSTADDRESS-ADDRESS XLOOKUPSTRING ++ XDISPLAYSTRING SET-XCOLORMAPEVENT-SEND_EVENT XKEYMAPEVENT-SERIAL ++ SET-XANYEVENT-WINDOW XRESIZEREQUESTEVENT-WIDTH ++ SET-XCOLORMAPEVENT-DISPLAY VISUAL-MAP_ENTRIES ++ SET-XGRAPHICSEXPOSEEVENT-SERIAL XWINDOWCHANGES-BORDER_WIDTH ++ XWINDOWCHANGES-WIDTH SET-XCOLORMAPEVENT-WINDOW SET-VISUAL-EXT_DATA ++ ISPFKEY WINDOW-YPOSITION XWIDTHMMOFSCREEN XWINDOWATTRIBUTES-DEPTH ++ SET-XCREATEWINDOWEVENT-SERIAL SET-XMOTIONEVENT-SAME_SCREEN ++ XGRAPHICSEXPOSEEVENT-MINOR_CODE XGRAPHICSEXPOSEEVENT-MAJOR_CODE ++ XCONFIGUREREQUESTEVENT-BORDER_WIDTH XCONFIGUREREQUESTEVENT-WIDTH ++ XWINDOWATTRIBUTES-BORDER_WIDTH XWINDOWATTRIBUTES-WIDTH ++ MAKE-XRECTANGLE XWINDOWATTRIBUTES-BACKING_PIXEL XINITEXTENSION ++ SET-XFONTSTRUCT-DIRECTION SET-XIMAGE-DEPTH SET-XMAPEVENT-TYPE ++ XDESTROYWINDOWEVENT-TYPE XWINDOWATTRIBUTES-VISUAL ++ SET-XEXPOSEEVENT-HEIGHT WINDOW-PRETTYPRINTAT-XY ++ XGRAPHICSEXPOSEEVENT-DRAWABLE SET-XIMAGE-WIDTH XDESTROYSUBWINDOWS ++ SET-XIMAGE-BITS_PER_PIXEL XUNMAPEVENT-FROM_CONFIGURE XGETWMHINTS ++ GET_C_STRING_2 XGETIMAGE SET-XMOTIONEVENT-X ++ SET-XFONTSTRUCT-PROPERTIES SET-XFONTSTRUCT-N_PROPERTIES ++ XDISPLAYWIDTHMM SET-XEXTCODES-EXTENSION XPUTIMAGE ++ XCONFIGUREREQUESTEVENT-VALUE_MASK XDRAWSTRING16 XSUBIMAGE ++ XWINDOWATTRIBUTES-DO_NOT_PROPAGATE_MASK ++ XWINDOWATTRIBUTES-YOUR_EVENT_MASK MAKE-XPROPERTYEVENT ++ SET-XMAPEVENT-SERIAL XDESTROYWINDOWEVENT-SERIAL ++ SET-XEXPOSEEVENT-COUNT SET-XMOTIONEVENT-Y XWINDOWCHANGES-X ++ SET-XSTANDARDCOLORMAP-KILLID SET-XGRAPHICSEXPOSEEVENT-X ++ WINDOW-GET-VECTOR-END SET-XIMAGE-BLUE_MASK SET-XIMAGE-GREEN_MASK ++ SET-XIMAGE-RED_MASK _XQEVENT-EVENT XRECOLORCURSOR XWINDOWCHANGES-Y ++ XWIDTHOFSCREEN XWINDOWATTRIBUTES-X SET-XVISUALINFO-VISUALID ++ XTIMECOORD-X XSIZEHINTS-BASE_HEIGHT XSIZEHINTS-MAX_HEIGHT ++ XSIZEHINTS-MIN_HEIGHT XSIZEHINTS-HEIGHT MENU-DISPLAY-ITEM ++ LISP-STRING-2 SET-XGRAPHICSEXPOSEEVENT-Y ++ XWINDOWATTRIBUTES-BACKING_PLANES MENU-FIND-ITEM-WIDTH ++ XSTRINGTOKEYSYM _XQEVENT-NEXT SET-XCREATEWINDOWEVENT-X ++ SET-XMOTIONEVENT-IS_HINT MAKE-XANYEVENT XWINDOWATTRIBUTES-Y ++ SET-XGRAVITYEVENT-TYPE XTIMECOORD-Y XRESIZEREQUESTEVENT-HEIGHT ++ XDOESSAVEUNDERS SET-XCREATEWINDOWEVENT-Y ++ XWINDOWATTRIBUTES-ALL_EVENT_MASKS XFONTPROP-NAME XSCREENOFDISPLAY ++ XLISTEXTENSIONS XWINDOWCHANGES-HEIGHT XGRAPHICSEXPOSEEVENT-WIDTH ++ SET-XCREATEWINDOWEVENT-OVERRIDE_REDIRECT XPARSEGEOMETRY ++ SET-XMOTIONEVENT-ROOT SET-XMOTIONEVENT-X_ROOT ++ SET-XMOTIONEVENT-Y_ROOT PICMENU-DRAW-BUTTON ++ SET-XFONTSTRUCT-ALL_CHARS_EXIST SET-XVISUALINFO-BITS_PER_RGB ++ SET-VERTEX-ARRAY SET-XMOTIONEVENT-SEND_EVENT ++ XCONFIGUREREQUESTEVENT-HEIGHT XWINDOWATTRIBUTES-HEIGHT XWARPPOINTER ++ XKEYMAPEVENT-SEND_EVENT SET-XMOTIONEVENT-DISPLAY ++ SET-XGRAVITYEVENT-SERIAL XCROSSINGEVENT-MODE SET-XMAPPINGEVENT-TYPE ++ XKEYMAPEVENT-DISPLAY SET-_XQEVENT-EVENT XRESOURCEMANAGERSTRING ++ SET-XIMAGE-HEIGHT SET-XGRAPHICSEXPOSEEVENT-SEND_EVENT ++ SET-XMOTIONEVENT-WINDOW SET-XMOTIONEVENT-SUBWINDOW ++ SET-XCREATEWINDOWEVENT-PARENT XKEYMAPEVENT-WINDOW ++ SET-XGRAPHICSEXPOSEEVENT-DISPLAY SET-_XQEVENT-NEXT XQUERYPOINTER ++ SET-CHAR-ARRAY ISCURSORKEY SET-XCREATEWINDOWEVENT-SEND_EVENT ++ XSAVECONTEXT SET-XWINDOWCHANGES-STACK_MODE ++ SET-XMAPEVENT-OVERRIDE_REDIRECT XGETCLASSHINT WINDOW-GET-ELLIPSE ++ PICMENU-ITEM-POSITION SET-XCREATEWINDOWEVENT-DISPLAY ++ XQUERYTEXTEXTENTS16 SET-XMAPPINGEVENT-SERIAL ++ SET-XMAPREQUESTEVENT-TYPE SET-XIMAGE-BITMAP_UNIT ++ SET-XVISUALINFO-DEPTH SET-XCROSSINGEVENT-TIME ++ SET-XCREATEWINDOWEVENT-WINDOW XNOEXPOSEEVENT-TYPE ++ SET-XVISUALINFO-COLORMAP_SIZE SET-XCROSSINGEVENT-TYPE ++ SET-XERROREVENT-TYPE XSIZEHINTS-MAX_ASPECT_X ++ XSIZEHINTS-MIN_ASPECT_X XGETTRANSIENTFORHINT MENU-FIND-ITEM-HEIGHT ++ XADDHOSTS SET-XVISUALINFO-VISUAL SET-XCROSSINGEVENT-STATE ++ XSIZEHINTS-MAX_ASPECT_Y XSIZEHINTS-MIN_ASPECT_Y SET-XMAPEVENT-EVENT ++ SET-XMAPEVENT-SEND_EVENT SET-XMAPREQUESTEVENT-SERIAL ++ XDESTROYWINDOWEVENT-EVENT XDESTROYWINDOWEVENT-SEND_EVENT ++ SET-XGRAVITYEVENT-X XFOCUSCHANGEEVENT-TYPE ++ SET-XSTANDARDCOLORMAP-COLORMAP SET-VISUAL-MAP_ENTRIES XDRAWTEXT16 ++ WINDOW-GET-BOX-SIZE MAKE-XSELECTIONCLEAREVENT ++ MAKE-XSELECTIONREQUESTEVENT MAKE-XSELECTIONEVENT ++ SET-XMAPEVENT-DISPLAY XDESTROYWINDOWEVENT-DISPLAY ++ XNOEXPOSEEVENT-SERIAL SET-XGRAVITYEVENT-Y XFETCHBUFFER ++ XGRAPHICSEXPOSEEVENT-HEIGHT WINDOW-SET-COLOR-RGB ++ SET-XCROSSINGEVENT-SERIAL SET-XERROREVENT-SERIAL ++ SET-XVISUALINFO-BLUE_MASK SET-XVISUALINFO-GREEN_MASK ++ SET-XVISUALINFO-RED_MASK SET-XWINDOWATTRIBUTES-DEPTH ++ SET-XMAPEVENT-WINDOW XDESTROYWINDOWEVENT-WINDOW ++ SET-XSIZEHINTS-HEIGHT_INC SET-XSIZEHINTS-WIDTH_INC XPOINTINREGION ++ GET-ST-POINT2 SET-XWINDOWATTRIBUTES-BORDER_WIDTH ++ SET-XWINDOWATTRIBUTES-WIDTH SET-XWINDOWCHANGES-BORDER_WIDTH ++ SET-XWINDOWCHANGES-WIDTH SET-VISUAL-CLASS GET-C-STRING XSETWMHINTS ++ SET-XWINDOWATTRIBUTES-BACKING_PIXEL MAKE-SCREEN SET-XEDATAOBJECT-GC ++ XFOCUSCHANGEEVENT-SERIAL XWHITEPIXELOFSCREEN XTEXTEXTENTS ++ SET-XWINDOWATTRIBUTES-VISUAL PICMENU-DELETE-NAMED-BUTTON ++ XARC-ANGLE1 SET-XCROSSINGEVENT-DETAIL XGRAPHICSEXPOSEEVENT-COUNT ++ XWRITEBITMAPFILE XMINCMAPSOFSCREEN ++ SET-XPIXMAPFORMATVALUES-SCANLINE_PAD WINDOW-GET-REGION ++ SET-XCROSSINGEVENT-SAME_SCREEN XMAXCMAPSOFSCREEN ++ SET-XSIZEHINTS-BASE_WIDTH SET-XSIZEHINTS-MAX_WIDTH ++ SET-XSIZEHINTS-MIN_WIDTH SET-XSIZEHINTS-WIDTH SET-XSEGMENT-X1 ++ XARC-ANGLE2 MAKE-XREPARENTEVENT SET-XSEGMENT-Y1 SET-SCREEN-ROOT ++ XFOCUSCHANGEEVENT-DETAIL XSETCLIPORIGIN SET-XSEGMENT-X2 ++ SET-XGRAVITYEVENT-EVENT SET-XGRAVITYEVENT-SEND_EVENT XPOINT-Y ++ XSETCLIPMASK SET-XSEGMENT-Y2 ++ SET-XWINDOWATTRIBUTES-DO_NOT_PROPAGATE_MASK ++ SET-XWINDOWATTRIBUTES-YOUR_EVENT_MASK XFILLARCS XDISPLAYHEIGHTMM ++ SET-XGRAVITYEVENT-DISPLAY XGETSTANDARDCOLORMAP XQUERYBESTTILE ++ XIMAGEBYTEORDER SET-XPROPERTYEVENT-TIME SCREEN-BLACK_PIXEL ++ SET-XGRAVITYEVENT-WINDOW SET-XPROPERTYEVENT-TYPE ++ SET-XCROSSINGEVENT-X XICONSIZE-HEIGHT_INC SET-XWINDOWATTRIBUTES-X ++ SET-XWINDOWCHANGES-X SET-XPIXMAPFORMATVALUES-DEPTH XGETSIZEHINTS ++ SET-XWINDOWATTRIBUTES-BACKING_PLANES XQUERYBESTCURSOR ++ SET-XPROPERTYEVENT-STATE SET-XCROSSINGEVENT-Y XSETWMPROPERTIES ++ WINDOW-GET-CROSSHAIRS SET-XWINDOWATTRIBUTES-Y SET-XWINDOWCHANGES-Y ++ SET-XMAPPINGEVENT-SEND_EVENT SET-XPIXMAPFORMATVALUES-BITS_PER_PIXEL ++ MAKE-XCLASSHINT XCREATEBITMAPFROMDATA XALLOCCLASSHINT ++ SET-XMAPPINGEVENT-DISPLAY SET-XWINDOWATTRIBUTES-ALL_EVENT_MASKS ++ XQUERYBESTSTIPPLE SET-XPROPERTYEVENT-SERIAL ++ SET-XMAPPINGEVENT-WINDOW SET-XMAPREQUESTEVENT-PARENT ++ WINDOW-SET-FOREGROUND WINDOW-SET-BACKGROUND WINDOW-GET-POINT ++ SET-XWINDOWATTRIBUTES-HEIGHT SET-XWINDOWCHANGES-HEIGHT ++ XGETWMCLIENTMACHINE XGETERRORDATABASETEXT XSTRINGLISTTOTEXTPROPERTY ++ SET-XMAPREQUESTEVENT-SEND_EVENT XGETERRORTEXT XSETCLIPRECTANGLES ++ XGETTEXTPROPERTY XSETCLASSHINT XCROSSINGEVENT-FOCUS ++ SET-XMAPREQUESTEVENT-DISPLAY XDRAWSTRING XNOEXPOSEEVENT-SEND_EVENT ++ MAKE-XRESIZEREQUESTEVENT XGETMODIFIERMAPPING XDEFAULTDEPTH ++ SET-XCROSSINGEVENT-ROOT SET-XCROSSINGEVENT-X_ROOT ++ SET-XCROSSINGEVENT-Y_ROOT XLISTPROPERTIES SET-XEDATAOBJECT-SCREEN ++ XSTANDARDCOLORMAP-KILLID MAKE-XEDATAOBJECT XNOEXPOSEEVENT-DISPLAY ++ SET-XSIZEHINTS-BASE_HEIGHT SET-XSIZEHINTS-MAX_HEIGHT ++ SET-XSIZEHINTS-MIN_HEIGHT SET-XSIZEHINTS-HEIGHT ++ SET-XCROSSINGEVENT-SEND_EVENT MAKE-XSTANDARDCOLORMAP ++ XALLOCSTANDARDCOLORMAP SET-XMAPREQUESTEVENT-WINDOW CALLOC ++ XNEXTEVENT ISKEYPADKEY XSENDEVENT SET-XCROSSINGEVENT-DISPLAY ++ SET-XERROREVENT-DISPLAY WINDOW-INVERT-AREA WINDOW-INVERTAREA ++ XADDHOST XSETFONT XGCVALUES-CAP_STYLE XDEFAULTVISUAL ++ XFOCUSCHANGEEVENT-SEND_EVENT XSETTRANSIENTFORHINT MENU ++ SET-XCROSSINGEVENT-WINDOW SET-XCROSSINGEVENT-SUBWINDOW ++ XICONSIZE-MAX_WIDTH XICONSIZE-MIN_WIDTH XENABLEACCESSCONTROL ++ XMAPSUBWINDOWS XFOCUSCHANGEEVENT-DISPLAY WINDOW-GET-GEOMETRY ++ XCONVERTSELECTION WINDOW-SET-LINE-WIDTH MENU-CLEAR ++ XKEYBOARDCONTROL-BELL_DURATION XFOCUSCHANGEEVENT-WINDOW ++ XSETACCESSCONTROL MAKE-XCHARSTRUCT XCHANGEKEYBOARDMAPPING ++ XDISPLAYOFSCREEN XGCVALUES-FILL_RULE XAUTOREPEATOFF ++ XEXTCODES-FIRST_ERROR XGCVALUES-FILL_STYLE ++ SET-XEDATAOBJECT-PIXMAP_FORMAT WINDOW-FOREGROUND XSETERRORHANDLER ++ XSTOREBUFFER XFILLARC WINDOW-BACKGROUND SET-XEDATAOBJECT-FONT ++ XMAPREQUESTEVENT-TYPE XANYEVENT-TYPE MENU-DRAW MAKE-XCONFIGUREEVENT ++ MAKE-XCONFIGUREREQUESTEVENT XEXTCODES-FIRST_EVENT LISP-STRING ++ XDRAWRECTANGLE XIMAGE-BITMAP_PAD XIMAGE-BLUE_MASK ++ MAKE-XCLIENTMESSAGEEVENT XTEXTITEM16-FONT VISUAL-BLUE_MASK ++ XKEYBOARDSTATE-BELL_DURATION XGCVALUES-JOIN_STYLE ++ XGETSELECTIONOWNER XTEXTITEM16-NCHARS XTEXTITEM16-CHARS ++ XUNGRABBUTTON XMAPREQUESTEVENT-SERIAL SET-XCOLOR-PIXEL ++ SET-XSIZEHINTS-MAX_ASPECT_X SET-XSIZEHINTS-MIN_ASPECT_X ++ XUNGRABPOINTER SET-XPROPERTYEVENT-SEND_EVENT XSETSTANDARDCOLORMAP ++ XSERVERVENDOR XRECTANGLE-WIDTH XCLASSHINT-RES_NAME SCREEN-MWIDTH ++ SCREEN-WIDTH XICONSIZE-WIDTH_INC XPLANESOFSCREEN ++ XCIRCULATESUBWINDOWSUP WINDOW-ERASE-AREA XUNGRABSERVER ++ MAKE-XBUTTONEVENT XCHANGEKEYBOARDCONTROL ++ SET-XSIZEHINTS-MAX_ASPECT_Y SET-XSIZEHINTS-MIN_ASPECT_Y ++ SET-XPROPERTYEVENT-DISPLAY XKEYBOARDSTATE-GLOBAL_AUTO_REPEAT ++ VISUAL-VISUALID XFILLRECTANGLE XHEIGHTOFSCREEN XCOLOR-PIXEL ++ XLOADFONT XLISTFONTS XHOSTADDRESS-LENGTH XEXPOSEEVENT-TYPE ++ XGCVALUES-LINE_STYLE WINDOW-TOP-NEG-Y MAKE-XCIRCULATEEVENT ++ MAKE-XCIRCULATEREQUESTEVENT XTRANSLATECOORDINATES ++ MENU-ITEM-POSITION XSETSIZEHINTS XSTANDARDCOLORMAP-COLORMAP ++ SET-XPROPERTYEVENT-WINDOW XICONSIZE-MAX_HEIGHT XICONSIZE-MIN_HEIGHT ++ XGETCOMMAND WINDOW-STD-LINE-ATTR WINDOW-SET-LINE-ATTR ++ XUNINSTALLCOLORMAP MAKE-SCREENFORMAT XGRAVITYEVENT-X SCREEN-CMAP ++ XSELECTIONCLEAREVENT-TIME XALLOCNAMEDCOLOR XHEIGHTMMOFSCREEN ++ XQUERYFONT SCREENFORMAT-EXT_DATA SET-XFOCUSCHANGEEVENT-MODE ++ WINDOW-SET-XCOLOR WINDOW-SET-COLOR XBITMAPPAD ++ XCLIENTMESSAGEEVENT-MESSAGE_TYPE XCLIENTMESSAGEEVENT-TYPE ++ XGRAVITYEVENT-Y XSELECTIONCLEAREVENT-TYPE MAKE-XDESTROYWINDOWEVENT ++ WINDOW-SYNC XGCVALUES-TILE XCLOSEDISPLAY XGCVALUES-DASH_OFFSET ++ XEXPOSEEVENT-SERIAL XQUERYKEYMAP WINDOW-ADJUST-BOX-SIDE ++ VISUAL-BITS_PER_RGB WINDOW-CREATE XSETSTANDARDPROPERTIES ++ XSELECTIONEVENT-TIME XIMAGE-GREEN_MASK XGCVALUES-FUNCTION ++ XSETWMCLIENTMACHINE SET-XREPARENTEVENT-TYPE XSELECTIONEVENT-TYPE ++ XTEXTPROPERTY-ENCODING XCREATECOLORMAP XSHRINKREGION SET-INT-ARRAY ++ VISUAL-GREEN_MASK XCREATEPIXMAPFROMBITMAPDATA CHAR-ARRAY ++ SET-XRECTANGLE-X XSETTEXTPROPERTY XCLIENTMESSAGEEVENT-SERIAL ++ MAKE-XCOLORMAPEVENT SET-XGCVALUES-STIPPLE XFREESTRINGLIST ++ XSELECTIONCLEAREVENT-SERIAL XSETMODIFIERMAPPING WINDOW-MOVE ++ XCREATEPIXMAP BARMENU-SELECT SET-XGCVALUES-FILL_RULE ++ SET-XRECTANGLE-Y WINDOW-LABEL SET-XGCVALUES-TILE ++ SET-XGCVALUES-FILL_STYLE SET-XGCVALUES-JOIN_STYLE ++ SET-XGCVALUES-CAP_STYLE SET-XGCVALUES-LINE_STYLE XPENDING ++ XIMAGE-DEPTH XGCVALUES-STIPPLE BARMENU-DRAW XSYNC XIMAGE-WIDTH ++ SET-XREPARENTEVENT-SERIAL XSELECTIONEVENT-SERIAL WINDOW-SIZE ++ XLISTHOSTS XIMAGE-BITS_PER_PIXEL XQUERYCOLORS MAKE-XMODIFIERKEYMAP ++ XCOLORMAPEVENT-NEW XLISTPIXMAPFORMATS XFONTSTRUCT-EXT_DATA ++ XRMINITIALIZE XRECTANGLE-HEIGHT XKEYEVENT-TIME SCREEN-MHEIGHT ++ SCREEN-HEIGHT SET-XRESIZEREQUESTEVENT-TYPE SET-XKEYEVENT-X ++ SET-XCOLOR-PAD WINDOW-FREE-COLOR XEDATAOBJECT-VISUAL ++ XMAPPINGEVENT-FIRST_KEYCODE XARC-X XPUTBACKEVENT XKEYEVENT-TYPE ++ SET-XUNMAPEVENT-FROM_CONFIGURE XNEWMODIFIERMAP XGRAVITYEVENT-TYPE ++ SET-XKEYEVENT-Y SET-XCOLOR-RED XRESTACKWINDOWS XWITHDRAWWINDOW ++ XCHANGEGC MENU-REPOSITION XMAPREQUESTEVENT-PARENT MAKE-XEVENT ++ XEXPOSEEVENT-X VERTEX-POS-X SCREEN-MIN_MAPS SCREEN-MAX_MAPS ++ XKEYEVENT-STATE XPROPERTYEVENT-TIME WINDOW-QUERY-POINTER-B ++ MAKE-XCROSSINGEVENT XFREEFONT XKILLCLIENT ++ XMAPREQUESTEVENT-SEND_EVENT WINDOW-OPEN XIMAGE-RED_MASK ++ WINDOW-SET-XOR XCHARSTRUCT-RBEARING XCHARSTRUCT-LBEARING ++ XGETWINDOWATTRIBUTES XEXPOSEEVENT-Y XPROPERTYEVENT-TYPE ++ VERTEX-POS-Y XSTORECOLORS XCREATEWINDOWEVENT-TYPE ++ XMAPREQUESTEVENT-DISPLAY MENU-SELECT XSELECTIONCLEAREVENT-SELECTION ++ MAKE-XCREATEWINDOWEVENT SET-XRESIZEREQUESTEVENT-SERIAL ++ XDEFINECURSOR XMAPEVENT-TYPE VISUAL-RED_MASK XTEXTWIDTH XGRABBUTTON ++ XREFRESHKEYBOARDMAPPING XHOSTADDRESS-ADDRESS XGETWMCOLORMAPWINDOWS ++ XPROPERTYEVENT-STATE MENU-ADJUST-OFFSET XGRAVITYEVENT-SERIAL ++ XMAPREQUESTEVENT-WINDOW XVISUALINFO-VISUALID GET-ST-POINT ++ XGRABSERVER XANYEVENT-DISPLAY XIMAGE-BITMAP_UNIT ++ XCLIENTMESSAGEEVENT-FORMAT XSELECTIONEVENT-SELECTION ++ SET-XSELECTIONCLEAREVENT-TIME SET-XSELECTIONREQUESTEVENT-TIME ++ SET-XSELECTIONEVENT-TIME MAKE-XVISIBILITYEVENT XKEYSYMTOKEYCODE ++ SET-XREPARENTEVENT-X WINDOW-TRACK-MOUSE XPROPERTYEVENT-SERIAL ++ XCREATEWINDOWEVENT-SERIAL XSETWINDOWBACKGROUND ++ SET-XSELECTIONCLEAREVENT-TYPE SET-XSELECTIONREQUESTEVENT-TYPE ++ SET-XSELECTIONEVENT-TYPE WINDOW-FONT-STRING-WIDTH XFREECURSOR ++ XCREATEGLYPHCURSOR XSETSELECTIONOWNER SET-XWMHINTS-ICON_MASK ++ XCREATEWINDOW WINDOW-DRAWABLE-WIDTH STRINGIFY XCLASSHINT-RES_CLASS ++ SET-XREPARENTEVENT-Y XQLENGTH WINDOW-RESET MENU-UNBOX-ITEM ++ SET-XNOEXPOSEEVENT-MINOR_CODE SET-XNOEXPOSEEVENT-MAJOR_CODE ++ XEXPOSEEVENT-SEND_EVENT XANYEVENT-SERIAL XGEOMETRY ++ XVISUALINFO-BITS_PER_RGB MAKE-XFONTPROP XGCVALUES-FONT ++ SET-XKEYEVENT-TIME XEXPOSEEVENT-DISPLAY ++ SET-XREPARENTEVENT-OVERRIDE_REDIRECT SET-XGCVALUES-FUNCTION ++ XIMAGE-HEIGHT XDELETECONTEXT PICMENU-SELECT WINDOW-PAINT ++ SET-XFONTSTRUCT-MAX_BYTE1 SET-XFONTSTRUCT-MIN_BYTE1 ++ XSELECTIONEVENT-TARGET SET-XKEYEVENT-TYPE WINDOW-XINIT ++ SET-XNOEXPOSEEVENT-DRAWABLE SET-XGCVALUES-DASH_OFFSET ++ XSELECTIONREQUESTEVENT-TIME XCREATEFONTCURSOR WINDOW-DRAW-BOX ++ XSETCOMMAND XEXPOSEEVENT-WINDOW XTEXTPROPERTY-FORMAT ++ SET-XSELECTIONCLEAREVENT-SERIAL SET-XSELECTIONREQUESTEVENT-SERIAL ++ SET-XSELECTIONEVENT-SERIAL XCLIENTMESSAGEEVENT-SEND_EVENT ++ WINDOW-POLL-MOUSE PICMENU-DRAW SET-XFONTSTRUCT-MAX_CHAR_OR_BYTE2 ++ SET-XFONTSTRUCT-MIN_CHAR_OR_BYTE2 XDESTROYIMAGE ++ XSELECTIONCLEAREVENT-SEND_EVENT SET-XKEYEVENT-STATE ++ XSELECTIONREQUESTEVENT-TYPE WINDOW-FONT-INFO ++ XSETWINDOWATTRIBUTES-BACKING_PIXEL ++ XSETWINDOWATTRIBUTES-BORDER_PIXEL ++ XSETWINDOWATTRIBUTES-BACKGROUND_PIXEL XCLIENTMESSAGEEVENT-DISPLAY ++ XSELECTIONCLEAREVENT-DISPLAY XCHECKTYPEDEVENT ++ XCHECKTYPEDWINDOWEVENT SET-XBUTTONEVENT-TIME XKEYEVENT-X ++ XCHANGEPOINTERCONTROL XSETWINDOWBORDERWIDTH ++ SET-XDESTROYWINDOWEVENT-TYPE SET-XREPARENTEVENT-PARENT ++ SET-XBUTTONEVENT-TYPE SET-XGCVALUES-FONT XCLIENTMESSAGEEVENT-WINDOW ++ XSELECTIONCLEAREVENT-WINDOW SET-XSETWINDOWATTRIBUTES-BACKING_STORE ++ XKEYEVENT-Y XTEXTPROPERTY-NITEMS SET-XREPARENTEVENT-EVENT ++ SET-XREPARENTEVENT-SEND_EVENT SET-XKEYEVENT-SERIAL ++ XSELECTIONEVENT-SEND_EVENT WINDOW-MENU WINDOW-INVERT-AREA-XY ++ SET-XBUTTONEVENT-STATE XVISUALINFO-DEPTH SET-XREPARENTEVENT-DISPLAY ++ XSELECTIONEVENT-DISPLAY WINDOW-TRACK-MOUSE-IN-REGION ++ XINSERTMODIFIERMAPENTRY WINDOW-DRAW-CARAT XCREATEWINDOWEVENT-X ++ XTEXTPROPERTYTOSTRINGLIST SET-SCREEN-ROOT_DEPTH ++ XSELECTIONREQUESTEVENT-SERIAL WINDOW-STRING-WIDTH MENU-DESTROY ++ XSETWINDOWATTRIBUTES-DO_NOT_PROPAGATE_MASK ++ XSETWINDOWATTRIBUTES-EVENT_MASK SET-XREPARENTEVENT-WINDOW ++ XVISUALINFO-COLORMAP_SIZE SET-SCREEN-MWIDTH SET-SCREEN-WIDTH ++ XINTERNATOM SET-XKEYBOARDCONTROL-BELL_DURATION ++ SET-XKEYBOARDSTATE-BELL_DURATION XCREATEWINDOWEVENT-Y MENU-OFFSET ++ SET-XDESTROYWINDOWEVENT-SERIAL SET-SCREEN-BLACK_PIXEL ++ SET-SCREEN-WHITE_PIXEL SCREEN-ROOT_DEPTH XLISTDEPTHS XLOADQUERYFONT ++ SET-XBUTTONEVENT-SERIAL XVISUALINFO-VISUAL XFREE WINDOW-SET-COPY ++ SET-SCREEN-ROOT_VISUAL XTEXTITEM-NCHARS SET-XKEYEVENT-SAME_SCREEN ++ XTEXTITEM-FONT XCREATEWINDOWEVENT-OVERRIDE_REDIRECT XTEXTITEM-CHARS ++ SET-XSELECTIONCLEAREVENT-SELECTION ++ SET-XSELECTIONREQUESTEVENT-SELECTION SET-XSELECTIONEVENT-SELECTION ++ SET-XKEYBOARDSTATE-GLOBAL_AUTO_REPEAT XFONTSTRUCT-DIRECTION ++ WINDOW-GEOMETRY XCREATEPIXMAPCURSOR ++ XSETWINDOWATTRIBUTES-BACKING_PLANES XUNLOADFONT SCREEN-ROOT_VISUAL ++ SET-XRESIZEREQUESTEVENT-SEND_EVENT MAKE-XUNMAPEVENT ++ WINDOW-DRAWABLE-HEIGHT XKEYEVENT-ROOT XDELETEMODIFIERMAPENTRY ++ XSELECTINPUT SET-XRESIZEREQUESTEVENT-DISPLAY XWMHINTS-FLAGS ++ XGETGCVALUES XVISUALINFO-BLUE_MASK XVISUALINFO-GREEN_MASK ++ XVISUALINFO-RED_MASK XGRAVITYEVENT-EVENT XGRAVITYEVENT-SEND_EVENT ++ CHAR-POS WINDOW-INIT-KEYMAP SET-SCREEN-ROOT_INPUT_MASK ++ WINDOW-DRAW-ELLIPSE-PT WINDOW-DRAW-CIRCLE-PT ++ SET-XBUTTONEVENT-SAME_SCREEN XVISUALIDFROMVISUAL DEPTH-NVISUALS ++ XGRAVITYEVENT-DISPLAY WINDOW-RESET-COLOR ++ SET-XRESIZEREQUESTEVENT-WINDOW ISFUNCTIONKEY ++ XCREATEWINDOWEVENT-PARENT WINDOW-SCREEN-HEIGHT ++ XFONTSTRUCT-PROPERTIES XFONTSTRUCT-N_PROPERTIES MENU-BOX-ITEM ++ SET-XSETWINDOWATTRIBUTES-COLORMAP SCREEN-ROOT_INPUT_MASK ++ PICMENU-DESTROY XPROPERTYEVENT-SEND_EVENT ++ XCREATEWINDOWEVENT-SEND_EVENT SET-XSELECTIONREQUESTEVENT-TARGET ++ SET-XSELECTIONEVENT-TARGET XGRAVITYEVENT-WINDOW XSTORENAMEDCOLOR ++ MAKE-XGCVALUES XKEYEVENT-DISPLAY XSELECTIONREQUESTEVENT-SELECTION ++ XMAPEVENT-EVENT XPROPERTYEVENT-DISPLAY SET-XTEXTPROPERTY-ENCODING ++ XCREATEWINDOWEVENT-DISPLAY SET-XSETWINDOWATTRIBUTES-BORDER_PIXMAP ++ SET-XSETWINDOWATTRIBUTES-BACKGROUND_PIXMAP XGETWMNORMALHINTS ++ SET-XCONFIGUREEVENT-BORDER_WIDTH SET-XCONFIGUREEVENT-WIDTH ++ SET-XCONFIGUREREQUESTEVENT-BORDER_WIDTH ++ SET-XCONFIGUREREQUESTEVENT-WIDTH XANYEVENT-SEND_EVENT ++ XDESTROYREGION SET-XKEYMAPEVENT-TYPE SET-XARC-ANGLE1 ++ WINDOW-MOVETO-XY XPROPERTYEVENT-WINDOW SET-XBUTTONEVENT-BUTTON ++ XCREATEWINDOWEVENT-WINDOW XSETWMCOLORMAPWINDOWS ++ SET-XSETWINDOWATTRIBUTES-SAVE_UNDER SET-XBUTTONEVENT-X ++ SET-XFONTSTRUCT-FID WINDOW-ERASE-AREA-XY XMAPEVENT-DISPLAY ++ XKEYEVENT-SERIAL XFREEFONTINFO SET-XARC-ANGLE2 XMAPPINGEVENT-COUNT ++ SET-XCOMPOSESTATUS-CHARS_MATCHED XCHAR2B-BYTE1 ++ SET-XSELECTIONCLEAREVENT-SEND_EVENT ++ SET-XSELECTIONREQUESTEVENT-SEND_EVENT ++ SET-XSELECTIONEVENT-SEND_EVENT XERROREVENT-TYPE SET-XBUTTONEVENT-Y ++ XWMHINTS-INPUT XWMHINTS-ICON_PIXMAP SCREEN-WHITE_PIXEL ++ XCONFIGUREEVENT-ABOVE XUNMAPSUBWINDOWS ++ XSELECTIONREQUESTEVENT-TARGET SET-XSELECTIONCLEAREVENT-DISPLAY ++ SET-XSELECTIONREQUESTEVENT-DISPLAY SET-XSELECTIONEVENT-DISPLAY ++ XCHAR2B-BYTE2 SET-SCREEN-MHEIGHT SET-SCREEN-HEIGHT ++ SET-XSETWINDOWATTRIBUTES-OVERRIDE_REDIRECT XROTATEBUFFERS ++ SET-XKEYMAPEVENT-SERIAL XBLACKPIXEL XTEXTEXTENTS16 ++ SET-XCONFIGUREREQUESTEVENT-VALUE_MASK SET-XWMHINTS-ICON_X ++ MAKE-XERROREVENT COMPILE-DWINDOW WINDOW-STRING-EXTENTS ++ SET-XSELECTIONCLEAREVENT-WINDOW XFREEFONTNAMES ++ XFONTSTRUCT-ALL_CHARS_EXIST XMAPEVENT-SERIAL SET-XKEYEVENT-ROOT ++ SET-XKEYEVENT-X_ROOT SET-XKEYEVENT-Y_ROOT WINDOW-RESET-GEOMETRY ++ SET-XSETWINDOWATTRIBUTES-CURSOR XCONFIGUREEVENT-TYPE ++ XMAPPINGEVENT-REQUEST SET-XKEYEVENT-SEND_EVENT XFLUSH ++ WINDOW-DRAW-ARC-XY MAKE-XARC XREMOVEHOST XKEYEVENT-SAME_SCREEN ++ WINDOW-COPY-AREA-XY SET-XWMHINTS-ICON_Y WINDOW-DRAW-ELLIPSE-XY ++ WINDOW-DRAW-CIRCLE-XY WINDOW-DRAW-LINE-XY XERROREVENT-SERIAL ++ SET-SCREEN-MIN_MAPS SET-SCREEN-MAX_MAPS SET-XKEYEVENT-DISPLAY ++ MAKE-XWINDOWCHANGES XSELECTIONREQUESTEVENT-SEND_EVENT ++ SET-DEPTH-DEPTH SET-XCHARSTRUCT-RBEARING SET-XCHARSTRUCT-LBEARING ++ XGETWINDOWPROPERTY XANYEVENT-WINDOW XFILLPOLYGON ++ XSELECTIONREQUESTEVENT-DISPLAY XWMHINTS-INITIAL_STATE ++ SET-XKEYEVENT-WINDOW SET-XKEYEVENT-SUBWINDOW XDRAWPOINTS INT-POS ++ SET-XBUTTONEVENT-ROOT SET-XBUTTONEVENT-X_ROOT ++ SET-XBUTTONEVENT-Y_ROOT SET-XDESTROYWINDOWEVENT-EVENT ++ SET-XDESTROYWINDOWEVENT-SEND_EVENT XICONIFYWINDOW ++ SET-XBUTTONEVENT-SEND_EVENT XLASTKNOWNREQUESTPROCESSED ++ SET-XDESTROYWINDOWEVENT-DISPLAY XADDTOEXTENSIONLIST ++ XCONFIGUREEVENT-SERIAL XGETICONSIZES WINDOW-DRAW-CROSS-XY ++ WINDOW-DRAW-CROSSHAIRS-XY XCREATESIMPLEWINDOW ++ SET-XBUTTONEVENT-DISPLAY XRECTINREGION XREPARENTWINDOW ++ MAKE-XFONTSTRUCT XRESIZEWINDOW SET-XDESTROYWINDOWEVENT-WINDOW ++ WINDOW-DRAW-ARROW-XY WINDOW-WAIT-EXPOSURE MENU-SIZE ++ XMAPEVENT-OVERRIDE_REDIRECT SET-XBUTTONEVENT-WINDOW ++ SET-XBUTTONEVENT-SUBWINDOW SET-XGRAPHICSEXPOSEEVENT-MINOR_CODE ++ SET-XGRAPHICSEXPOSEEVENT-MAJOR_CODE XCLEARWINDOW ++ BARMENU-UPDATE-VALUE SET-XCONFIGUREEVENT-HEIGHT ++ SET-XCONFIGUREREQUESTEVENT-HEIGHT SET-XCOLORMAPEVENT-NEW ++ SET-XEXPOSEEVENT-TYPE SET-XGRAPHICSEXPOSEEVENT-DRAWABLE ++ XMOVERESIZEWINDOW XREPARENTEVENT-TYPE XCOLOR-PAD ++ XWMHINTS-ICON_WINDOW XGETZOOMHINTS MAKE-XFOCUSCHANGEEVENT ++ MAKE-XTEXTITEM16 XUNIQUECONTEXT XWMHINTS-WINDOW_GROUP ++ SET-XTEXTPROPERTY-FORMAT XWINDOWATTRIBUTES-MAP_INSTALLED XDRAWPOINT ++ XCOPYGC SET-XEXPOSEEVENT-SERIAL MAKE-XEXPOSEEVENT SET-XIMAGE-OBDATA ++ XCHECKWINDOWEVENT SET-XSETWINDOWATTRIBUTES-WIN_GRAVITY ++ SET-XSETWINDOWATTRIBUTES-BIT_GRAVITY XCONFIGUREEVENT-X XCOLOR-RED ++ XREPARENTEVENT-SERIAL XKEYEVENT-SEND_EVENT MAKE-XPOINT XTEXTWIDTH16 ++ MAKE-XHOSTADDRESS XCONFIGUREEVENT-Y SET-XTEXTPROPERTY-NITEMS ++ SET-SCREENFORMAT-SCANLINE_PAD WINDOW-MAP ++ XCOMPOSESTATUS-CHARS_MATCHED MAKE-_XQEVENT SET-XTEXTITEM-FONT ++ SET-XTEXTITEM16-FONT MAKE-XGRAPHICSEXPOSEEVENT ++ XRESIZEREQUESTEVENT-TYPE XWMGEOMETRY XKEYEVENT-SUBWINDOW ++ XCONFIGUREREQUESTEVENT-ABOVE SET-XKEYMAPEVENT-SEND_EVENT ++ SET-XTEXTITEM-NCHARS SET-XTEXTITEM-CHARS SET-XTEXTITEM16-NCHARS ++ SET-XTEXTITEM16-CHARS XMODIFIERKEYMAP-MAX_KEYPERMOD XBITMAPUNIT ++ XCONFIGUREEVENT-OVERRIDE_REDIRECT XGETGEOMETRY XMAPEVENT-SEND_EVENT ++ XWINDOWCHANGES-SIBLING SET-XKEYMAPEVENT-DISPLAY XPOLYGONREGION ++ XROTATEWINDOWPROPERTIES MAKE-XGRAVITYEVENT XSETWMNORMALHINTS ++ MENU-MOVETO-XY DOWINDOWCOM SET-XGRAPHICSEXPOSEEVENT-WIDTH ++ SET-XIMAGE-BYTES_PER_LINE XSCREENCOUNT XALLPLANES ++ SET-XKEYMAPEVENT-WINDOW XDISPLAYWIDTH XCONFIGUREREQUESTEVENT-TYPE ++ SET-XFONTSTRUCT-PER_CHAR SET-XFONTSTRUCT-DEFAULT_CHAR ++ XGETWMICONNAME XERROREVENT-DISPLAY XWINDOWATTRIBUTES-BACKING_STORE ++ MAKE-XCHAR2B SET-VISUAL-VISUALID PICMENU-CREATE-FROM-SPEC ++ PICMENU-CREATE-SPEC XRESIZEREQUESTEVENT-SERIAL ++ XPIXMAPFORMATVALUES-SCANLINE_PAD XKEYEVENT-X_ROOT ++ SET-XCREATEWINDOWEVENT-BORDER_WIDTH SET-XCREATEWINDOWEVENT-WIDTH ++ XWINDOWATTRIBUTES-MAP_STATE SET-SCREENFORMAT-DEPTH XGETWMPROTOCOLS ++ SET-XEXPOSEEVENT-X XKEYEVENT-Y_ROOT XCONFIGUREEVENT-EVENT ++ XCONFIGUREEVENT-SEND_EVENT XSETTSORIGIN XKEYEVENT-WINDOW ++ SET-SCREENFORMAT-BITS_PER_PIXEL SET-XHOSTADDRESS-FAMILY ++ XGETKEYBOARDMAPPING XCONFIGUREEVENT-DISPLAY XREPARENTEVENT-X ++ SET-XEXPOSEEVENT-Y ISMODIFIERKEY XCONFIGUREREQUESTEVENT-SERIAL ++ XSETLINEATTRIBUTES XSETIOERRORHANDLER WINDOW-GET-GEOMETRY-B ++ XREPARENTEVENT-Y XCONFIGUREEVENT-WINDOW SET-VISUAL-BITS_PER_RGB ++ MENU-SELECT! BARMENU-CALCULATE-SIZE XLOWERWINDOW XSTORENAME ++ XMAPEVENT-WINDOW XUNGRABKEY XPIXMAPFORMATVALUES-DEPTH ++ SET-XSTANDARDCOLORMAP-VISUALID XREPARENTEVENT-OVERRIDE_REDIRECT ++ SET-XFONTSTRUCT-MAX_BOUNDS SET-XFONTSTRUCT-MIN_BOUNDS ++ XCONFIGUREREQUESTEVENT-DETAIL SET-XFONTSTRUCT-DESCENT ++ SET-XFONTSTRUCT-ASCENT XLISTINSTALLEDCOLORMAPS ++ XPIXMAPFORMATVALUES-BITS_PER_PIXEL XDISPLAYPLANES ++ SET-XMAPPINGEVENT-FIRST_KEYCODE XGETINPUTFOCUS PICMENU-UNBOX-ITEM ++ XUNMAPEVENT-TYPE XWINDOWATTRIBUTES-SCREEN XSETICONSIZES ++ XMODIFIERKEYMAP-MODIFIERMAP XWINDOWATTRIBUTES-COLORMAP ++ XSIZEHINTS-FLAGS XINIT SET-XEXPOSEEVENT-SEND_EVENT XCOPYPLANE ++ XREPARENTEVENT-PARENT SET-XCOMPOSESTATUS-COMPOSE_PTR ++ SET-XCIRCULATEEVENT-PLACE SET-XCIRCULATEREQUESTEVENT-PLACE ++ SET-XEXPOSEEVENT-DISPLAY XGRAPHICSEXPOSEEVENT-TYPE XFREEPIXMAP ++ XDISPLAYCELLS SET-XTIMECOORD-TIME XREPARENTEVENT-EVENT ++ XREPARENTEVENT-SEND_EVENT MENU-CREATE XGETKEYBOARDCONTROL ++ MENU-CALCULATE-SIZE SET-XGRAPHICSEXPOSEEVENT-HEIGHT ++ XGETFONTPROPERTY XUNMAPEVENT-SERIAL XREPARENTEVENT-DISPLAY ++ XDISPLAYHEIGHT SET-XEXPOSEEVENT-WINDOW XCIRCULATEEVENT-PLACE ++ SET-XEXTCODES-FIRST_ERROR XCONFIGUREREQUESTEVENT-X XGETSUBIMAGE ++ XLOOKUPKEYSYM XACTIVATESCREENSAVER XWINDOWATTRIBUTES-SAVE_UNDER ++ XNOEXPOSEEVENT-MINOR_CODE XNOEXPOSEEVENT-MAJOR_CODE ++ XRECONFIGUREWMWINDOW XLOOKUPCOLOR XSETZOOMHINTS ++ SET-XCREATEWINDOWEVENT-HEIGHT XREPARENTEVENT-WINDOW ++ XCONFIGUREREQUESTEVENT-Y SET-XERROREVENT-MINOR_CODE ++ SET-XERROREVENT-REQUEST_CODE SET-XERROREVENT-ERROR_CODE ++ SET-XERROREVENT-RESOURCEID SET-XARC-WIDTH XSETREGION ++ SET-XVISIBILITYEVENT-TYPE XGRAPHICSEXPOSEEVENT-SERIAL ++ XNOEXPOSEEVENT-DRAWABLE XXORREGION SET-XGRAPHICSEXPOSEEVENT-COUNT ++ SET-XIMAGE-XOFFSET SET-XIMAGE-BITMAP_BIT_ORDER ++ SET-XIMAGE-BYTE_ORDER XWINDOWATTRIBUTES-OVERRIDE_REDIRECT ++ SET-XEXTCODES-FIRST_EVENT XSETCLOSEDOWNMODE XRAISEWINDOW ++ SET-XVISIBILITYEVENT-STATE SET-XCROSSINGEVENT-MODE XREADBITMAPFILE ++ SET-VISUAL-BLUE_MASK SET-VISUAL-GREEN_MASK SET-VISUAL-RED_MASK ++ SET-XIMAGE-FORMAT SET-SCREEN-CMAP SET-XCIRCULATEEVENT-TYPE ++ SET-XCIRCULATEREQUESTEVENT-TYPE XMAXREQUESTSIZE ++ XRESIZEREQUESTEVENT-SEND_EVENT XGRABKEY ++ SET-XWINDOWATTRIBUTES-MAP_INSTALLED ++ SET-XSTANDARDCOLORMAP-BASE_PIXEL XWINDOWATTRIBUTES-CLASS ++ XLISTFONTSWITHINFO XRESIZEREQUESTEVENT-DISPLAY ++ XFOCUSCHANGEEVENT-MODE XEVENTSQUEUED SET-XVISIBILITYEVENT-SERIAL ++ XDRAWTEXT XCIRCULATEEVENT-TYPE INT-ARRAY XMAPRAISED ++ XCONFIGUREREQUESTEVENT-PARENT WINDOW-GET-CIRCLE ++ XKEYBOARDCONTROL-LED XWINDOWATTRIBUTES-ROOT ++ XRESIZEREQUESTEVENT-WINDOW XWHITEPIXEL XCREATEGC ++ XCONFIGUREREQUESTEVENT-SEND_EVENT PICMENU-CALCULATE-SIZE ++ XDRAWIMAGESTRING16 XCROSSINGEVENT-TIME ++ XCONFIGUREREQUESTEVENT-DISPLAY SET-XCIRCULATEEVENT-SERIAL ++ SET-XCIRCULATEREQUESTEVENT-SERIAL XUNMAPWINDOW XCROSSINGEVENT-TYPE ++ SET-XCLASSHINT-RES_NAME MAKE-XKEYMAPEVENT XSETWMICONNAME ++ MAKE-XKEYBOARDSTATE XEMPTYREGION XCLIPBOX XSETSTIPPLE XEQUALREGION ++ XFORCESCREENSAVER XCONFIGUREREQUESTEVENT-WINDOW ++ XCIRCULATEEVENT-SERIAL PICMENU-BUTTON-CONTAINSXY? XWINDOWEVENT ++ WINDOW-GET-CLICK XCROSSINGEVENT-STATE XGRAPHICSEXPOSEEVENT-X ++ XSETWMPROTOCOLS XSIZEHINTS-WIN_GRAVITY XGRAPHICSEXPOSEEVENT-Y ++ SET-XWINDOWCHANGES-SIBLING XGETPOINTERMAPPING XFETCHNAME ++ XCHANGEACTIVEPOINTERGRAB SET-XWINDOWATTRIBUTES-BACKING_STORE ++ SET-XTIMECOORD-X XCROSSINGEVENT-SERIAL ++ SET-XWINDOWATTRIBUTES-MAP_STATE SCREEN-DEFAULT_GC SET-XARC-HEIGHT ++ XGETSCREENSAVER SET-XVISUALINFO-SCREEN SET-XTIMECOORD-Y ++ SET-DEPTH-NVISUALS XCOMPOSESTATUS-COMPOSE_PTR ++ MAKE-XSETWINDOWATTRIBUTES XUNMAPEVENT-EVENT XUNMAPEVENT-SEND_EVENT ++ XMASKEVENT XPEEKEVENT XKEYBOARDCONTROL-AUTO_REPEAT_MODE ++ XKEYBOARDCONTROL-LED_MODE XCROSSINGEVENT-DETAIL XTEXTITEM16-DELTA ++ XUNMAPEVENT-DISPLAY XWINDOWATTRIBUTES-WIN_GRAVITY ++ XWINDOWATTRIBUTES-BIT_GRAVITY XCONFIGUREWINDOW XSETINPUTFOCUS ++ XCROSSINGEVENT-SAME_SCREEN MAKE-XKEYBOARDCONTROL ++ XCIRCULATEREQUESTEVENT-PLACE XCLEARAREA XFONTSTRUCT-FID ++ XUNMAPEVENT-WINDOW XGRAPHICSEXPOSEEVENT-SEND_EVENT ++ XKEYBOARDCONTROL-BELL_PITCH XGETRGBCOLORMAPS XPOINT-X XSETPLANEMASK ++ XFETCHBYTES XGRAPHICSEXPOSEEVENT-DISPLAY XSUBTRACTREGION ++ XEXTCODES-MAJOR_OPCODE SET-XSTANDARDCOLORMAP-BLUE_MULT ++ SET-XSTANDARDCOLORMAP-GREEN_MULT SET-XSTANDARDCOLORMAP-RED_MULT ++ MAKE-XTIMECOORD SET-XWINDOWATTRIBUTES-SCREEN XADDTOSAVESET ++ XGETPOINTERCONTROL WINDOW-GET-LATEX-POSITION ++ WINDOW-GET-LINE-POSITION WINDOW-GET-ICON-POSITION ++ WINDOW-GET-BOX-POSITION WINDOW-GET-MOUSE-POSITION ++ SET-XWINDOWATTRIBUTES-COLORMAP XCROSSINGEVENT-X ++ XDISABLEACCESSCONTROL SET-XMAPPINGEVENT-COUNT XGETNORMALHINTS ++ SET-XVISIBILITYEVENT-SEND_EVENT XCROSSINGEVENT-Y XSETFOREGROUND ++ SET-XVISIBILITYEVENT-DISPLAY SET-XICONSIZE-HEIGHT_INC ++ SET-XICONSIZE-WIDTH_INC MAKE-XCOLOR ++ SET-XCIRCULATEREQUESTEVENT-PARENT XMOVEWINDOW ++ XCIRCULATEREQUESTEVENT-TYPE XALLOCCOLOR XSETDASHES ++ XGCVALUES-ARC_MODE XDRAWARC MENU-SELECT-B SET-XVISUALINFO-CLASS ++ SET-XWINDOWATTRIBUTES-SAVE_UNDER SET-XCIRCULATEEVENT-EVENT ++ SET-XCIRCULATEEVENT-SEND_EVENT ++ SET-XCIRCULATEREQUESTEVENT-SEND_EVENT SET-XVISIBILITYEVENT-WINDOW ++ XOPENDISPLAY XQUERYBESTSIZE MAKE-XSIZEHINTS ++ SET-XMAPPINGEVENT-REQUEST PICMENU-BOX-ITEM SET-DEPTH-VISUALS ++ WINDOW-GET-CHARS SET-XEDATAOBJECT-VISUAL XKEYBOARDSTATE-BELL_PITCH ++ MAKE-XSEGMENT XALLOCSIZEHINTS SET-XCIRCULATEEVENT-DISPLAY ++ SET-XCIRCULATEREQUESTEVENT-DISPLAY XFREEEXTENSIONLIST ++ SET-XSTANDARDCOLORMAP-BLUE_MAX SET-XSTANDARDCOLORMAP-GREEN_MAX ++ SET-XSTANDARDCOLORMAP-RED_MAX ISMISCFUNCTIONKEY XSIZEHINTS-X ++ XCIRCULATEEVENT-EVENT XCIRCULATEEVENT-SEND_EVENT ++ XSTANDARDCOLORMAP-VISUALID MAKE-XTEXTITEM SET-XICONSIZE-MAX_WIDTH ++ SET-XICONSIZE-MIN_WIDTH XGETVISUALINFO MENU-ITEM-VALUE ++ SET-XCIRCULATEEVENT-WINDOW SET-XCIRCULATEREQUESTEVENT-WINDOW ++ XCIRCULATEEVENT-DISPLAY XUNGRABKEYBOARD SET-XPROPERTYEVENT-ATOM ++ XSIZEHINTS-Y SET-XWINDOWATTRIBUTES-OVERRIDE_REDIRECT MAKE-XKEYEVENT ++ XCIRCULATEREQUESTEVENT-SERIAL XGCVALUES-BACKGROUND WINDOW-GET-CROSS ++ WINDOW-ADJ-BOX-XY XEXTCODES-EXTENSION XCROSSINGEVENT-ROOT ++ XCROSSINGEVENT-X_ROOT XCROSSINGEVENT-Y_ROOT XCIRCULATEEVENT-WINDOW ++ OPEN-WINDOW XVENDORRELEASE SET-XSIZEHINTS-X SET-XSIZEHINTS-FLAGS ++ SET-XCROSSINGEVENT-FOCUS XIMAGE-BYTES_PER_LINE ++ XCROSSINGEVENT-SEND_EVENT SET-XCLASSHINT-RES_CLASS ++ SCREEN-BACKING_STORE XCROSSINGEVENT-DISPLAY SET-XSIZEHINTS-Y ++ SET-XWINDOWATTRIBUTES-CLASS XDEFAULTGC WINDOW-SET-ERASE ++ XDISPLAYMOTIONBUFFERSIZE XUNDEFINECURSOR DEPTH-DEPTH ++ SCREEN-EXT_DATA XRESETSCREENSAVER XSETGRAPHICSEXPOSURES ++ SET-XWINDOWATTRIBUTES-ROOT XCROSSINGEVENT-WINDOW ++ XCROSSINGEVENT-SUBWINDOW SET-XCHAR2B-BYTE1 XROOTWINDOW ++ XFONTSTRUCT-MAX_BYTE1 XFONTSTRUCT-MIN_BYTE1 SET-XCHAR2B-BYTE2 ++ XGCVALUES-FOREGROUND XADDEXTENSION XSTRINGTOCONTEXT ++ XSETPOINTERMAPPING SET-XIMAGE-DATA XFONTSTRUCT-MAX_CHAR_OR_BYTE2 ++ XFONTSTRUCT-MIN_CHAR_OR_BYTE2 BARMENU-CREATE XSETARCMODE ++ XCREATEIMAGE XKEYBOARDCONTROL-KEY XDEFAULTSCREEN XSETSCREENSAVER ++ XCIRCULATESUBWINDOWSDOWN XKEYBOARDSTATE-LED_MASK XINTERSECTREGION ++ MAKE-XMAPREQUESTEVENT XGETWMSIZEHINTS XKEYBOARDCONTROL-BELL_PERCENT ++ XKEYBOARDCONTROL-KEY_CLICK_PERCENT XCOLOR-BLUE XSETBACKGROUND ++ XSTANDARDCOLORMAP-BASE_PIXEL XUNIONREGION VERTEX-POS-FLAG ++ SET-XICONSIZE-MAX_HEIGHT SET-XICONSIZE-MIN_HEIGHT XSETSUBWINDOWMODE ++ XGCVALUES-CLIP_Y_ORIGIN XGCVALUES-CLIP_X_ORIGIN XGCVALUES-CLIP_MASK ++ SET-XRECTANGLE-WIDTH XSETRGBCOLORMAPS XGCONTEXTFROMGC ++ XALLOCCOLORPLANES SET-XWINDOWATTRIBUTES-WIN_GRAVITY ++ SET-XWINDOWATTRIBUTES-BIT_GRAVITY MAKE-XMAPPINGEVENT ++ XDRAWIMAGESTRING MAKE-XCOMPOSESTATUS XIMAGE-OBDATA XIMAGE-DATA ++ XCIRCULATESUBWINDOWS SET-XCLIENTMESSAGEEVENT-MESSAGE_TYPE ++ SET-XCLIENTMESSAGEEVENT-TYPE XSTOREBYTES ++ XCIRCULATEREQUESTEVENT-PARENT XCOLORMAPEVENT-TYPE VISUAL-EXT_DATA ++ SET-XSIZEHINTS-WIN_GRAVITY XCIRCULATEREQUESTEVENT-SEND_EVENT ++ XKEYBOARDSTATE-BELL_PERCENT XKEYBOARDSTATE-KEY_CLICK_PERCENT ++ XSETNORMALHINTS XVISIBILITYEVENT-TYPE XSETTILE XAUTOREPEATON ++ XALLOCCOLORCELLS XGETMOTIONEVENTS XCOLORMAPEVENT-STATE PICMENU-SPEC ++ XCIRCULATEREQUESTEVENT-DISPLAY XEVENTMASKOFSCREEN ++ SET-XKEYBOARDCONTROL-LED XGRABKEYBOARD XKEYBOARDSTATE-AUTO_REPEATS ++ XIMAGE-BYTE_ORDER XVISIBILITYEVENT-STATE XROOTWINDOWOFSCREEN ++ XEXPOSEEVENT-WIDTH XCIRCULATEREQUESTEVENT-WINDOW ++ SET-XCLIENTMESSAGEEVENT-SERIAL SET-XCOLOR-GREEN window-code-char ++ gcfunction gcforeground gcbackground GXxor GXcopy LineSolid CapButt ++ JoinMiter XK_Shift_R XK_Shift_L XK_Control_L XK_Control_R XK_Alt_R ++ XK_Alt_L XK_Return XK_Tab XK_BackSpace window-get-raw-char ++ ) :user) ++ ++(import '(*WINDOW-META* *TEXT-WIDTH-RETURN* *WINDOW-STRING* *WINDOW-SCREEN* ++ *WINDOW-EVENT* *WINDOW-MENU* *WINDOW-KEYMAP* *WINDOW-SHIFT* ++ *BORDER-WIDTH* *ROOT-X-RETURN* *POS-X* *ROOT-Y-RETURN* *DEFAULT-GC* ++ *DEFAULT-EVENT* *GC-VALUES* *MENU-TITLE-PAD* *DEFAULT-SCREEN* ++ *CHILD-RETURN* *DEPTH-RETURN* *WINDOW-ADD-MENU-TITLE* ++ *OVERALL-RETURN* *WINDOW-DEFAULT-BORDER* ++ *BORDER-WIDTH-RETURN* *DEFAULT-COLORMAP* *MOUSE-X* *MOUSE-Y* ++ *WINDOW-INPUT-STRING-CHARWIDTH* A-WINDOW *WINDOW-DISPLAY* ++ *WINDOW-ATTRIBUTES* *DESCENT-RETURN* ++ *WIDTH-RETURN* *WIN-Y-RETURN* *WIN-X-RETURN* *WINDOW-KEYINIT* ++ *BARMENU-UPDATE-VALUE-CONS* *ROOT-WINDOW* *PICMENU-NO-SELECTION* ++ *WINDOW-CTRL* *WINDOW-XCOLOR* *DIRECTION-RETURN* *WINDOW-FONTS* ++ *WINDOW-ATTR* *POS-Y* *X-RETURN* *Y-RETURN* *WIN-WIDTH* ++ *MASK-RETURN* *ASCENT-RETURN* *ROOT-RETURN* *HEIGHT-RETURN* ++ *BLACK-PIXEL* *WINDOW-DEFAULT-FONT-NAME* *DEFAULT-BG-COLOR* ++ *DEFAULT-FG-COLOR* *DEFAULT-SIZE-HINTS* *DEFAULT-DISPLAY* ++ *WINDOW-DEFAULT-CURSOR* *WINDOW-SHIFTKEYMAP* *WINDOW-DEFAULT-POS-X* ++ *WINDOW-DEFAULT-POS-Y* *WINDOW-MENU-CODE* *MOUSE-WINDOW* ++ *WINDOW-INPUT-STRING-X* *WINDOW-INPUT-STRING-Y* *WINDOW-STRING-MAX* ++ *WINDOW-STRING-COUNT* *WINDOW-SAVE-FOREGROUND* ++ *WINDOW-SAVE-FUNCTION* *WIN-HEIGHT* *WHITE-PIXEL* ++ *min-keycodes-return* *max-keycodes-return* *keycodes-return* ++ *window-shift-keys* *window-control-keys* *window-meta-keys* ++ ) :user) ++ ++(import '(courier-bold-12 8x10 9x15 top bottom ++ left right center paint xor erase ++ copy close move clear display-size ++ menu window picmenu picmenu-spec barmenu ++ picmenu-button) :user) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_ice-cream.lsp +@@ -0,0 +1,37 @@ ++; ice-cream.lsp 14 Nov 1994 16:16:15 ++ ++ ++(SETF (GET 'ICE-CREAM 'DRAW-DESCR) ++ '(DRAW-DESC ICE-CREAM ++ ((DRAW-DOT (79 294) (4 4) NIL 0) ++ (DRAW-CIRCLE (7 222) (148 148) NIL 0) ++ (DRAW-ELLIPSE (7 274) (148 44) NIL 0) ++ (DRAW-LINE (81 296) (0 -278) NIL 0) ++ (DRAW-LINE (81 18) (74 278) NIL 0) ++ (DRAW-LINE (81 18) (-74 278) NIL 0) ++ (DRAW-ELLIPSE (0 269) (162 54) NIL 0) ++ (DRAW-ARROW (154 391) (-27 -35) NIL 0) ++ (DRAW-TEXT (140 395) (63 14) "Ice Cream" 0) ++ (DRAW-ARROW (81 296) (-74 0) NIL 0) ++ (DRAW-TEXT (47 299) (7 14) "r" 0) ++ (DRAW-TEXT (86 186) (7 14) "h" 0) ++ (DRAW-LINE (81 0) (81 296) NIL 0) ++ (DRAW-LINE (81 0) (-81 296) NIL 0)) ++ (0 0) (203 409))) ++ ++(DEFUN DRAW-ICE-CREAM (W X Y) ++ (WINDOW-DRAW-DOT-XY W (+ 81 X) (+ 296 Y)) ++ (WINDOW-DRAW-CIRCLE-XY W (+ 81 X) (+ 296 Y) 74) ++ (WINDOW-DRAW-ELLIPSE-XY W (+ 81 X) (+ 296 Y) 74 22) ++ (WINDOW-DRAW-LINE-XY W (+ 81 X) (+ 296 Y) (+ 81 X) (+ 18 Y)) ++ (WINDOW-DRAW-LINE-XY W (+ 81 X) (+ 18 Y) (+ 155 X) (+ 296 Y)) ++ (WINDOW-DRAW-LINE-XY W (+ 81 X) (+ 18 Y) (+ 7 X) (+ 296 Y)) ++ (WINDOW-DRAW-ELLIPSE-XY W (+ 81 X) (+ 296 Y) 81 27) ++ (WINDOW-DRAW-ARROW-XY W (+ 154 X) (+ 391 Y) (+ 127 X) (+ 356 Y)) ++ (WINDOW-PRINTAT-XY W "Ice Cream" (+ 140 X) (+ 395 Y)) ++ (WINDOW-DRAW-ARROW-XY W (+ 81 X) (+ 296 Y) (+ 7 X) (+ 296 Y)) ++ (WINDOW-PRINTAT-XY W "r" (+ 47 X) (+ 299 Y)) ++ (WINDOW-PRINTAT-XY W "h" (+ 86 X) (+ 186 Y)) ++ (WINDOW-DRAW-LINE-XY W (+ 81 X) Y (+ 162 X) (+ 296 Y)) ++ (WINDOW-DRAW-LINE-XY W (+ 81 X) Y X (+ 296 Y)) ++ (WINDOW-FORCE-OUTPUT W)) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_Xakcl.example.lsp +@@ -0,0 +1,326 @@ ++(in-package :XLIB) ++; Xakcl.example.lsp Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++;;;;;;;;;;;;;;;;;;;;;; ++;;this is an example of getting a geometry feature of a drawable there ++;;is also XGetWindowAttributes for just windows. See reference manual ++;;on X lib. it is probably more efficient to use XGetGeometry function ++;;once when a lot of geometry information is needed since, XGetGeometry ++;;returns many values. also as can be noticed, XGetGeometry needs C ++;;Pointers, so it is best to allocate these pointers as globals so that ++;;they won't have to be created and destroyed all the time, taking time ++;;and fragmenting memory ++ ++(defun drawable-height (a-drawable &key (display *default-display*)) ++ (XGetGeometry display a-drawable *root-return* *x-return* *y-return* *width-return* ++ *height-return* *border-width-return* *depth-return*) ++ (int-pos *height-return* 0)) ++ ++ ++ ++;;;;;;;;;;;;;;;;;;;;;; ++;;this function is a simple application of line drawing. it uses the ++;;drawable-height function and the default globals like ++;;*default-display* and *default-GC* ++ ++(defun graph-x-y (info &key (test #'first) (scale 10) (displ 0) (invert t)) ++ ++ (let* ((info (sort info #'< :key test)) ++ (first-x-y (first info)) ++ (prev-x (* (first first-x-y) scale)) ++ (mid-height ( / (drawable-height a-window) 2)) ++ (prev-y (if invert ++ (- mid-height (* (+ (second first-x-y) displ) scale)) ++ (* (+ (second first-x-y) displ) scale)))) ++ (print info) ++ (dolist (next-x-y (rest info)) ++ (let ((pres-x (* (first next-x-y) scale)) ++ (pres-y (if invert ++ (- mid-height (* (+ (second next-x-y) displ) scale)) ++ (* (+ (second next-x-y) displ) scale)))) ++ ++ ;; (format t "~%prev-x : ~a prev-y: ~a pres-x: ~a pres-y: ~a" prev-x prev-y pres-x pres-y) ++ (Xdrawline *default-display* a-window *default-GC* ++ prev-x prev-y pres-x pres-y) ++ (Xflush *default-display*) ++ (setq prev-x pres-x) ++ (setq prev-y pres-y))))) ++ ++ ++ ++;;;;;;;;;;;;;;;;;;;;;; ++;; here's an example of getting values stored in a certain GC ++;; the structure XGCValues contain values for a GC ++(defun get-foreground-of-gc (display GC) ++ (XGetGCValues display GC (+ GCForeground) *GC-Values*) ++ (XGCValues-foreground *GC-Values*)) ++ ++ ++;;;;;;;;;;;;;;;;;;;;;; ++;;this is an example of changing the graphics context and allocating a ++;;color for drawing. this is also an example of setting the line ++;;attributes this function changes the graphics context so becareful. ++;;also notice that c-types Xcolor is created and freed. again it is ++;;possible to make them global, because they could be used often. this ++;;function was fixed to have no side effects. Side effects are a danger ++;;with passing C structures. the structures could be changed as a side ++;;effect if you're not careful ++ ++(defun my-draw-line (&key (display *default-display*) (GC *default-GC*) x1 y1 x2 y2 (width 0) (color "BLACK") ++ (line-style LineSolid) (cap-style CapRound) (join-style JoinRound) (colormap *default-colormap*) ++ window) ++ ++ (let ((pixel-xcolor (make-Xcolor)) ++ (exact-rgb (make-Xcolor)) ++ (prev-fore-pixel (get-foreground-of-gc display GC))) ++ (XSetLineAttributes display GC width line-style cap-style join-style) ++ (XAllocNamedColor display colormap (get-c-string color) pixel-xcolor exact-rgb) ++ (Xsetforeground display GC (Xcolor-pixel pixel-xcolor)) ++ (XDrawLine display window GC x1 y1 x2 y2) ++ (Xflush display) ++ (free pixel-xcolor) ++ (free exact-rgb) ++ (XSetForeground display GC prev-fore-pixel))) ++ ++ ++ ++(defun colors () ++ (let ((pixel-xcolor (make-Xcolor)) ++ (y 0) ++ (r 0) ++ (b 0) ++ (g 0)) ++ (dotimes (g 65535) ++;; (format t "~% ~a ~a ~a" r b g) ++ (set-Xcolor-red pixel-xcolor r) ++ (set-Xcolor-blue pixel-xcolor b) ++ (set-Xcolor-green pixel-xcolor g) ++ (if (not (eql 0 (XallocColor *default-display* *default-colormap* pixel-xcolor))) ++ (progn (Xsetforeground *default-display* *default-GC* (Xcolor-pixel pixel-xcolor)) ++ (XDrawLine *default-display* a-window *default-GC* 0 0 200 y) ++ (Xflush *default-display*) ++ (incf y 1)) ++ ;; (format t "~%error in reading color") ++ )))) ++ ++ ++(defun return-r-b-g (color &key (display *default-display*) (GC *default-GC*) (colormap *default-colormap*) ++ ) ++ (let ((pixel-xcolor (make-Xcolor)) ++ (exact-rgb (make-Xcolor))) ++ (XAllocNamedColor display colormap (get-c-string color) pixel-xcolor pixel-xcolor) ++ (format t "~% red: ~a blue: ~a green: ~a" (Xcolor-red pixel-xcolor) ++ (Xcolor-blue pixel-xcolor) (Xcolor-green pixel-xcolor)))) ++ ++;;;;;;;;;;;;;;;;;;;;;; ++;;this function tracks the mouse. when the mouse button is pressed a ++;;line is drawn from the previous position to the current position. ++;;this funciton also shows a way of handling exposure events. the ++;;positions are remebered in order to redraw the contents of the window ++;;when it is exposed. this function handles events in two windows, the ++;;quit window and the draw window. there is an example of setting the ++;;input for a window. the draw window can have button press events, ++;;pointer motion events and exposure events, while the quit window ++;;(button) only needs button press events, and exposure events. notice ++;;that the event queue is actually flushed at the beginng of the ++;;functions. There is also an example of drawing and inverting text. ++;;and handling sub windows. the sub windows are destroyed at the end of ++;;the function. ++ ++(defun track-mouse (a-window) ++ (Xsync *default-display* 1) ;; this clears the event queue so that previous ++ ;; motion events won't show up ++ (XClearWindow *default-display* a-window) ++ ++ ;; create two sub window ++ ++ (let ((quit-window (XCreateSimpleWindow ++ *default-display* a-window ++ 2 2 50 20 1 *black-pixel* *white-pixel*)) ++ (draw-window (XCreateSimpleWindow ++ *default-display* a-window ++ 2 32 220 350 1 *black-pixel* *white-pixel*))) ++ (Xselectinput *default-display* quit-window (+ ButtonpressMask ExposureMask)) ++ (Xselectinput *default-display* draw-window ++ (+ ButtonpressMask PointerMotionMask ExposureMask)) ++ ++ (XMapWindow *default-display* quit-window) ++ (XMapWindow *default-display* draw-window) ++ (Xflush *default-display* ) ++ (XDrawString *default-display* quit-window *default-GC* 10 15 (get-c-string "Quit") 4) ++ (Xflush *default-display* ) ++ (do ((exit nil) ++ (lines-list nil) ++ (prev-x nil) ++ (prev-y nil)) ++ (exit) ++ (XNextEvent *default-display* *default-event*) ++ (let ((type (XAnyEvent-type *default-event*)) ++ (active-window (XAnyevent-window *default-event*))) ++ (cond ((eql draw-window active-window) ++ (cond ++;;; draw a line ++ ((eql type ButtonPress) ++ (let ((x (XButtonEvent-x *default-event*)) ++ (y (XButtonEvent-y *default-event*))) ++ (if prev-x ++ (XDrawLine *default-display* draw-window *default-GC* prev-x prev-y x y)) ++ (setq prev-x x) ++ (setq prev-y y) ++ (push (list x y) lines-list))) ++;;; track the mouse ++ ((eql type MotionNotify) ++ (let ((x (XMotionEvent-x *default-event*)) ++ (y (XMotionEvent-y *default-event*)) ++ (time (XmotionEvent-time *default-event*))) ++ ;;trace the mouse ++ ;;(format t "~% pos-x: ~a pos-y: ~a" x y) ++ ;;(format t "~%time: ~a" time) ++ )) ++ ++;;;; redraw window after expose event ++ ++ ((eql type Expose) ++ (let* ((first-xy (first lines-list)) ++ (prev-x (first first-xy)) ++ (prev-y (second first-xy))) ++ (dolist (an-xy (rest lines-list)) ++ (let ((x (first an-xy)) ++ (y (second an-xy))) ++ (XDrawLine *default-display* draw-window *default-GC* prev-x prev-y x y) ++ (setq prev-x x) ++ (setq prev-y y))))))) ++ ++ ;; exit if the quit button is pressed ++ ++ ((eql quit-window active-window) ++ (cond ((eql type ButtonPress) ++ (setq exit t) ++ (XSetForeground *default-display* ++ *default-GC* *white-pixel*) ++ (XSetBackground *default-display* ++ *default-GC* *black-pixel*) ++ (XDrawImageString *default-display* quit-window *default-GC* 10 15 (get-c-string "Quit") 4) ++ (Xflush *default-display*) ++ ++;;the drawing goes so fast that you can't see the text invert, so the ++;;function wiats for for about .2 seconds. but it would be better to ++;;keep the text inverted until the button is released this is done by ++;;setting the quit window to have buton release events as well and ++;;handling it appropriately ++ ++ (dotimes (i 1500)) ++ ++ ++ (XSetForeground *default-display* ++ *default-GC* *black-pixel*) ++ (XSetBackground *default-display* ++ *default-GC* *white-pixel*) ++ (XDrawImageString *default-display* quit-window *default-GC* 10 15 (get-c-string "Quit") 4) ++ (Xflush *default-display*)) ++ ++;; do quit window expose event ++ ((eql type Expose) ++ (XDrawString *default-display* quit-window *default-GC* 10 15 (get-c-string "Quit") 4))))))) ++ (XDestroySubWindows *default-display* a-window) ++ (Xflush *default-display*))) ++ ++ ++;;;;;;;;;;;;;;;;;;;;;; ++;;this function demonstrtes using different fonts of text ++ ++(defun basic-text (a-window &key (display *default-display*) (GC *default-GC* )) ++ (my-load-font "9x15" :display display :GC GC) ++ (Xdrawstring display a-window GC 50 100 (get-c-string "hello") 5) ++ (my-load-font "*-*-courier-bold-r-*-*-12-*-*-*-*-*-iso8859-1" :display display :GC GC) ++ (Xdrawstring display a-window GC 50 150 (get-c-string "hello") 5) ++ (Xflush display)) ++ ++ ++;;;;;;;;;;;;;;;;;;;;;; ++;;this function demonstartes getting different fonts and setting them in a GC ++ ++(defun my-load-font (a-string &key (display *default-display*) (GC *default-GC* )) ++ (let ((font-info (XloadQueryFont display (get-c-string a-string)))) ++ (if (not (eql 0 font-info)) ++ (XsetFont display GC (Xfontstruct-fid font-info)) ++ (format t "~%can't open font ~a" a-string)))) ++ ++ ++;;;;;;;;;;;;;;;;;;;;;; ++;;this function draws a ghst line by setting the X function to GXXor. and the ++;;foreground color to th logxor of the back and foreground pixel ++;;this function actually changes the graphics context. and does not change it back ++;;to use the ghost method and switch back to regular drawing. set the funciton ++;;back to GXcopy and the foregorund pixel appropriately ++ ++(defun do-ghost-line-1 (a-window) ++ (Xsync *default-display* 1);; this clears the event queue so that previous ++ ;; motion events won't show up ++ (XClearWindow *default-display* a-window) ++ ++ (XdrawRectangle *default-display* a-window *default-GC* ++ 0 0 100 100) ++ (Xdrawarc *default-display* a-window *default-GC* 100 200 100 100 0 (* 360 64)) ++ ++ (Xsetfunction *default-display* *default-GC* GXxor) ++ (Xsetforeground *default-display* *default-GC* (logxor *black-pixel* *white-pixel*)) ++ (Xselectinput *default-display* a-window PointerMotionMask ) ++ (do ((exit nil) ++ (prev-x 0) ++ (prev-y 0)) ++ (exit) ++ (XNextEvent *default-display* *default-event*) ++ (let ((type (XAnyEvent-type *default-event*))) ++ (cond ++ ++ ;;draw ghost line ++ ((eql type MotionNotify) ++ (let ((x (XMotionEvent-x *default-event*)) ++ (y (XMotionEvent-y *default-event*)) ++ (time (XmotionEvent-time *default-event*))) ++ (Xdrawline *default-display* a-window *default-GC* 0 0 prev-x prev-y) ++ (Xdrawline *default-display* a-window *default-GC* 0 0 x y) ++ (setq prev-x x) ++ (setq prev-y y) ++ )))))) ++ ++ ++ ++ ++ ++ ;;example of a circle ++ ;;position 100 100 diameter 100 ++ ++ ;;(XdrawArc *default-display* a-window *default-GC* 100 100 100 100 0 (* 360 64)) ++ ++ ;;example of font ++ ++ ;;(XloadFont *default-display* (get-c-string "8x10")) ++ ++ ++ ++ ;; set a pixel ++ ++ ;;(XallocNamedColor *default-display* *default-colormap* (get-c-string "aquamarine") a b) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_draw-gates.lsp +@@ -0,0 +1,101 @@ ++; draw-gates.lsp Gordon S. Novak Jr. 20 Oct 94 ++ ++; Copyright (c) 1995 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; See the file gnu.license . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++(defun draw-nand (w x y) ++ (window-draw-arc-xy w (+ x 24) (+ y 16) 16 16 -90 180) ++ (window-draw-circle-xy w (+ x 45) (+ y 16) 4) ++ (window-draw-line-xy w (+ x 24) (+ y 32) x (+ y 32)) ++ (window-draw-line-xy w x (+ y 32) x y) ++ (window-draw-line-xy w x y (+ x 24) y) ++ (window-force-output w)) ++ ++(setf (get 'nand 'picmenu-spec) ++ '(picmenu-spec 52 32 ((in1 (0 26)) (in2 (0 6)) (out (50 16))) t ++ draw-nand 9x15)) ++ ++(defun draw-and (w x y) ++ (window-draw-arc-xy w (+ x 24) (+ y 16) 16 16 -90 180) ++ (window-draw-line-xy w (+ x 24) (+ y 32) x (+ y 32)) ++ (window-draw-line-xy w x (+ y 32) x y) ++ (window-draw-line-xy w x y (+ x 24) y) ++ (window-force-output w)) ++ ++(setf (get 'and 'picmenu-spec) ++ '(picmenu-spec 40 32 ((in1 (0 26)) (in2 (0 6)) (out (40 16))) t ++ draw-and 9x15)) ++ ++(defun draw-not (w x y) ++ (window-draw-line-xy w x (+ y 24) (+ x 21) (+ y 12)) ++ (window-draw-line-xy w x y (+ x 21) (+ y 12)) ++ (window-draw-line-xy w x y x (+ y 24)) ++ (window-draw-circle-xy w (+ x 23) (+ y 12) 3) ++ (window-force-output w)) ++ ++(setf (get 'not 'picmenu-spec) ++ '(picmenu-spec 27 24 ((in (0 12)) (out (27 12))) t ++ draw-not 9x15)) ++ ++(defun draw-or (w x y) ++ (window-draw-arc-xy w x (- y 26) 58 58 46.4 43.6) ++ (window-draw-arc-xy w x (+ y 58) 58 58 270.0 43.6) ++ (window-draw-arc-xy w (- x 16) (+ y 16) 23 23 315 90) ++ (window-force-output w) ) ++ ++(setf (get 'or 'picmenu-spec) ++ '(picmenu-spec 40 32 ((in1 (6 26)) (in2 (6 6)) (out (40 16))) t ++ draw-or 9x15)) ++ ++(defun draw-xor (w x y) ++ (window-draw-arc-xy w (- x 16) (+ y 16) 23 23 315 90) ++ (draw-or w (+ x 6) y))) ++ ++(setf (get 'xor 'picmenu-spec) ++ '(picmenu-spec 46 32 ((in1 (6 26)) (in2 (6 6)) (out (46 16))) t ++ draw-xor 9x15)) ++ ++(defun draw-nor (w x y) ++ (window-draw-circle-xy w (+ x 44) (+ y 16) 4) ++ (draw-or w x y))) ++ ++(setf (get 'nor 'picmenu-spec) ++ '(picmenu-spec 48 32 ((in1 (0 26)) (in2 (0 6)) (out (48 16))) t ++ draw-nor 9x15)) ++ ++ ++(defun draw-nor2 (w x y) ++ (window-draw-circle-xy w (+ x 4) (+ y 6) 4) ++ (window-draw-circle-xy w (+ x 4) (+ y 26) 4) ++ (draw-and w (+ x 8) y))) ++ ++(setf (get 'nor2 'picmenu-spec) ++ '(picmenu-spec 48 32 ((in1 (0 26)) (in2 (0 6)) (out (48 16))) t ++ draw-nor2 9x15)) ++ ++(defun draw-nand2 (w x y) ++ (window-draw-circle-xy w (+ x 4) (+ y 6) 4) ++ (window-draw-circle-xy w (+ x 4) (+ y 26) 4) ++ (draw-or w (+ x 4) y))) ++ ++(setf (get 'nand2 'picmenu-spec) ++ '(picmenu-spec 44 32 ((in1 (0 26)) (in2 (0 6)) (out (44 16))) t ++ draw-nand2 9x15)) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_dispatch-events.lsp +@@ -0,0 +1,50 @@ ++(in-package :XLIB) ++; dispatch-events.lsp Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++ ++;;have to make each type have it's own eventlist ++;;and eventmask ++(defun dispatch-events () ++ (setq *exit* nil) ++ (mapcar #'(lambda (x) ++ (Xsync x 1)) ++ *display-list*) ++ (do ((window nil) ++ (call-back-fn nil) ++ (type nil)) ++ (*exit*) ++ (dolist (a-display *display-list*) ++ (unless (= (XPending a-display) 0) ++ (XNextEvent a-display *default-event*) ++ (setq type (XAnyEvent-type *default-event*)) ++ (setq window ++ (gethash (XAnyEvent-window *default-event*) ++ *window-table*)) ++ (setq call-back-fns ++ (rest (assoc type (slot-value window 'eventlist)))) ++ (if call-back-fns ++ (dolist (call-back-fn call-back-fns) ++ (eval `(,call-back-fn ',window)))))))) ++ ++ +--- gcl-2.6.7.orig/xgcl-2/Events.c ++++ gcl-2.6.7/xgcl-2/Events.c +@@ -1,7 +1,7 @@ +-/* Events.c Hiep Huu Nguyen 27 Aug 92 */ ++/* Events.c Hiep Huu Nguyen 27 Jun 06 */ + + /*; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. +- ++; edited 27 Aug 92; 12 Aug 2002; 23 Jun 06 by GSN; 27 Jun 06 by GSN + ; See the files gnu.license and dec.copyright . + + ; This program is free software; you can redistribute it and/or modify +@@ -24,12 +24,10 @@ + #include + #include + +-#include "include.h" +- + /********* XKeyEvent funcions *****/ + +-int make_XKeyEvent (){ +- return ((int) calloc(1, sizeof(XKeyEvent))); ++long make_XKeyEvent (){ ++ return ((long) calloc(1, sizeof(XKeyEvent))); + } + + int XKeyEvent_same_screen(i) +@@ -175,17 +173,17 @@ int j; + i->window = j; + } + +-Display *XKeyEvent_display(i) ++long XKeyEvent_display(i) + XKeyEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XKeyEvent_display(i, j) + XKeyEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XKeyEvent_send_event(i) +@@ -230,8 +228,8 @@ int j; + + /********* XButtonEvent funcions *****/ + +-int make_XButtonEvent (){ +- return ((int) calloc(1, sizeof(XButtonEvent))); ++long make_XButtonEvent (){ ++ return ((long) calloc(1, sizeof(XButtonEvent))); + } + + int XButtonEvent_same_screen(i) +@@ -377,17 +375,17 @@ int j; + i->window = j; + } + +-Display *XButtonEvent_display(i) ++long XButtonEvent_display(i) + XButtonEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XButtonEvent_display(i, j) + XButtonEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XButtonEvent_send_event(i) +@@ -432,8 +430,8 @@ int j; + + /********* XMotionEvent funcions *****/ + +-int make_XMotionEvent (){ +- return ((int) calloc(1, sizeof(XMotionEvent))); ++long make_XMotionEvent (){ ++ return ((long) calloc(1, sizeof(XMotionEvent))); + } + + int XMotionEvent_same_screen(i) +@@ -579,17 +577,17 @@ int j; + i->window = j; + } + +-Display *XMotionEvent_display(i) ++long XMotionEvent_display(i) + XMotionEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XMotionEvent_display(i, j) + XMotionEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XMotionEvent_send_event(i) +@@ -634,8 +632,8 @@ int j; + + /********* XCrossingEvent funcions *****/ + +-int make_XCrossingEvent (){ +- return ((int) calloc(1, sizeof(XCrossingEvent))); ++long make_XCrossingEvent (){ ++ return ((long) calloc(1, sizeof(XCrossingEvent))); + } + + int XCrossingEvent_state(i) +@@ -807,17 +805,17 @@ int j; + i->window = j; + } + +-Display *XCrossingEvent_display(i) ++long XCrossingEvent_display(i) + XCrossingEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XCrossingEvent_display(i, j) + XCrossingEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XCrossingEvent_send_event(i) +@@ -862,8 +860,8 @@ int j; + + /********* XFocusChangeEvent funcions *****/ + +-int make_XFocusChangeEvent (){ +- return ((int) calloc(1, sizeof(XFocusChangeEvent))); ++long make_XFocusChangeEvent (){ ++ return ((long) calloc(1, sizeof(XFocusChangeEvent))); + } + + int XFocusChangeEvent_detail(i) +@@ -905,17 +903,17 @@ int j; + i->window = j; + } + +-Display *XFocusChangeEvent_display(i) ++long XFocusChangeEvent_display(i) + XFocusChangeEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XFocusChangeEvent_display(i, j) + XFocusChangeEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XFocusChangeEvent_send_event(i) +@@ -960,8 +958,8 @@ int j; + + /********* XKeymapEvent funcions *****/ + +-int make_XKeymapEvent (){ +- return ((int) calloc(1, sizeof(XKeymapEvent))); ++long make_XKeymapEvent (){ ++ return ((long) calloc(1, sizeof(XKeymapEvent))); + } + + char* XKeymapEvent_key_vector(i) +@@ -982,17 +980,17 @@ int j; + i->window = j; + } + +-Display * XKeymapEvent_display(i) ++long XKeymapEvent_display(i) + XKeymapEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XKeymapEvent_display(i, j) + XKeymapEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XKeymapEvent_send_event(i) +@@ -1037,8 +1035,8 @@ int j; + + /********* XExposeEvent funcions *****/ + +-int make_XExposeEvent (){ +- return ((int) calloc(1, sizeof(XExposeEvent))); ++long make_XExposeEvent (){ ++ return ((long) calloc(1, sizeof(XExposeEvent))); + } + + int XExposeEvent_count(i) +@@ -1119,17 +1117,17 @@ int j; + i->window = j; + } + +-Display *XExposeEvent_display(i) ++long XExposeEvent_display(i) + XExposeEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XExposeEvent_display(i, j) + XExposeEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XExposeEvent_send_event(i) +@@ -1174,8 +1172,8 @@ int j; + + /********* XGraphicsExposeEvent funcions *****/ + +-int make_XGraphicsExposeEvent (){ +- return ((int) calloc(1, sizeof(XGraphicsExposeEvent))); ++long make_XGraphicsExposeEvent (){ ++ return ((long) calloc(1, sizeof(XGraphicsExposeEvent))); + } + + int XGraphicsExposeEvent_minor_code(i) +@@ -1282,17 +1280,17 @@ Drawable j; + i->drawable = j; + } + +-Display * XGraphicsExposeEvent_display(i) ++long XGraphicsExposeEvent_display(i) + XGraphicsExposeEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XGraphicsExposeEvent_display(i, j) + XGraphicsExposeEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XGraphicsExposeEvent_send_event(i) +@@ -1337,8 +1335,8 @@ int j; + + /********* XNoExposeEvent funcions *****/ + +-int make_XNoExposeEvent (){ +- return ((int) calloc(1, sizeof(XNoExposeEvent))); ++long make_XNoExposeEvent (){ ++ return ((long) calloc(1, sizeof(XNoExposeEvent))); + } + + int XNoExposeEvent_minor_code(i) +@@ -1380,17 +1378,17 @@ Drawable j; + i->drawable = j; + } + +-Display *XNoExposeEvent_display(i) ++long XNoExposeEvent_display(i) + XNoExposeEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XNoExposeEvent_display(i, j) + XNoExposeEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XNoExposeEvent_send_event(i) +@@ -1435,8 +1433,8 @@ int j; + + /********* XVisibilityEvent funcions *****/ + +-int make_XVisibilityEvent (){ +- return ((int) calloc(1, sizeof(XVisibilityEvent))); ++long make_XVisibilityEvent (){ ++ return ((long) calloc(1, sizeof(XVisibilityEvent))); + } + + int XVisibilityEvent_state(i) +@@ -1465,17 +1463,17 @@ int j; + i->window = j; + } + +-Display *XVisibilityEvent_display(i) ++long XVisibilityEvent_display(i) + XVisibilityEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XVisibilityEvent_display(i, j) + XVisibilityEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XVisibilityEvent_send_event(i) +@@ -1520,8 +1518,8 @@ int j; + + /********* XCreateWindowEvent funcions *****/ + +-int make_XCreateWindowEvent (){ +- return ((int) calloc(1, sizeof(XCreateWindowEvent))); ++long make_XCreateWindowEvent (){ ++ return ((long) calloc(1, sizeof(XCreateWindowEvent))); + } + + int XCreateWindowEvent_override_redirect(i) +@@ -1628,17 +1626,17 @@ int j; + i->parent = j; + } + +-Display *XCreateWindowEvent_display(i) ++long XCreateWindowEvent_display(i) + XCreateWindowEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XCreateWindowEvent_display(i, j) + XCreateWindowEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XCreateWindowEvent_send_event(i) +@@ -1683,8 +1681,8 @@ int j; + + /********* XDestroyWindowEvent funcions *****/ + +-int make_XDestroyWindowEvent (){ +- return ((int) calloc(1, sizeof(XDestroyWindowEvent))); ++long make_XDestroyWindowEvent (){ ++ return ((long) calloc(1, sizeof(XDestroyWindowEvent))); + } + + int XDestroyWindowEvent_window(i) +@@ -1713,17 +1711,17 @@ int j; + i->event = j; + } + +-Display *XDestroyWindowEvent_display(i) ++long XDestroyWindowEvent_display(i) + XDestroyWindowEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XDestroyWindowEvent_display(i, j) + XDestroyWindowEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XDestroyWindowEvent_send_event(i) +@@ -1768,8 +1766,8 @@ int j; + + /********* XUnmapEvent funcions *****/ + +-int make_XUnmapEvent (){ +- return ((int) calloc(1, sizeof(XUnmapEvent))); ++long make_XUnmapEvent (){ ++ return ((long) calloc(1, sizeof(XUnmapEvent))); + } + + int XUnmapEvent_from_configure(i) +@@ -1811,17 +1809,17 @@ int j; + i->event = j; + } + +-Display *XUnmapEvent_display(i) ++long XUnmapEvent_display(i) + XUnmapEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XUnmapEvent_display(i, j) + XUnmapEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XUnmapEvent_send_event(i) +@@ -1866,8 +1864,8 @@ int j; + + /********* XMapEvent funcions *****/ + +-int make_XMapEvent (){ +- return ((int) calloc(1, sizeof(XMapEvent))); ++long make_XMapEvent (){ ++ return ((long) calloc(1, sizeof(XMapEvent))); + } + + int XMapEvent_override_redirect(i) +@@ -1909,17 +1907,17 @@ int j; + i->event = j; + } + +-Display *XMapEvent_display(i) ++long XMapEvent_display(i) + XMapEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XMapEvent_display(i, j) + XMapEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XMapEvent_send_event(i) +@@ -1964,8 +1962,8 @@ int j; + + /********* XMapRequestEvent funcions *****/ + +-int make_XMapRequestEvent (){ +- return ((int) calloc(1, sizeof(XMapRequestEvent))); ++long make_XMapRequestEvent (){ ++ return ((long) calloc(1, sizeof(XMapRequestEvent))); + } + + int XMapRequestEvent_window(i) +@@ -1994,17 +1992,17 @@ int j; + i->parent = j; + } + +-Display *XMapRequestEvent_display(i) ++long XMapRequestEvent_display(i) + XMapRequestEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XMapRequestEvent_display(i, j) + XMapRequestEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XMapRequestEvent_send_event(i) +@@ -2049,8 +2047,8 @@ int j; + + /********* XReparentEvent funcions *****/ + +-int make_XReparentEvent (){ +- return ((int) calloc(1, sizeof(XReparentEvent))); ++long make_XReparentEvent (){ ++ return ((long) calloc(1, sizeof(XReparentEvent))); + } + + int XReparentEvent_override_redirect(i) +@@ -2131,17 +2129,17 @@ int j; + i->event = j; + } + +-Display *XReparentEvent_display(i) ++long XReparentEvent_display(i) + XReparentEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XReparentEvent_display(i, j) + XReparentEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XReparentEvent_send_event(i) +@@ -2186,8 +2184,8 @@ int j; + + /********* XConfigureEvent funcions *****/ + +-int make_XConfigureEvent (){ +- return ((int) calloc(1, sizeof(XConfigureEvent))); ++long make_XConfigureEvent (){ ++ return ((long) calloc(1, sizeof(XConfigureEvent))); + } + + int XConfigureEvent_override_redirect(i) +@@ -2307,17 +2305,17 @@ int j; + i->event = j; + } + +-Display *XConfigureEvent_display(i) ++long XConfigureEvent_display(i) + XConfigureEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XConfigureEvent_display(i, j) + XConfigureEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XConfigureEvent_send_event(i) +@@ -2362,8 +2360,8 @@ int j; + + /********* XGravityEvent funcions *****/ + +-int make_XGravityEvent (){ +- return ((int) calloc(1, sizeof(XGravityEvent))); ++long make_XGravityEvent (){ ++ return ((long) calloc(1, sizeof(XGravityEvent))); + } + + int XGravityEvent_y(i) +@@ -2418,17 +2416,17 @@ int j; + i->event = j; + } + +-Display *XGravityEvent_display(i) ++long XGravityEvent_display(i) + XGravityEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XGravityEvent_display(i, j) + XGravityEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XGravityEvent_send_event(i) +@@ -2473,8 +2471,8 @@ int j; + + /********* XResizeRequestEvent funcions *****/ + +-int make_XResizeRequestEvent (){ +- return ((int) calloc(1, sizeof(XResizeRequestEvent))); ++long make_XResizeRequestEvent (){ ++ return ((long) calloc(1, sizeof(XResizeRequestEvent))); + } + + int XResizeRequestEvent_height(i) +@@ -2516,17 +2514,17 @@ int j; + i->window = j; + } + +-Display *XResizeRequestEvent_display(i) ++long XResizeRequestEvent_display(i) + XResizeRequestEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XResizeRequestEvent_display(i, j) + XResizeRequestEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XResizeRequestEvent_send_event(i) +@@ -2571,8 +2569,8 @@ int j; + + /********* XConfigureRequestEvent funcions *****/ + +-int make_XConfigureRequestEvent (){ +- return ((int) calloc(1, sizeof(XConfigureRequestEvent))); ++long make_XConfigureRequestEvent (){ ++ return ((long) calloc(1, sizeof(XConfigureRequestEvent))); + } + + int XConfigureRequestEvent_value_mask(i) +@@ -2705,17 +2703,17 @@ int j; + i->parent = j; + } + +-Display *XConfigureRequestEvent_display(i) ++long XConfigureRequestEvent_display(i) + XConfigureRequestEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XConfigureRequestEvent_display(i, j) + XConfigureRequestEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XConfigureRequestEvent_send_event(i) +@@ -2760,8 +2758,8 @@ int j; + + /********* XCirculateEvent funcions *****/ + +-int make_XCirculateEvent (){ +- return ((int) calloc(1, sizeof(XCirculateEvent))); ++long make_XCirculateEvent (){ ++ return ((long) calloc(1, sizeof(XCirculateEvent))); + } + + int XCirculateEvent_place(i) +@@ -2803,17 +2801,17 @@ int j; + i->event = j; + } + +-Display *XCirculateEvent_display(i) ++long XCirculateEvent_display(i) + XCirculateEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XCirculateEvent_display(i, j) + XCirculateEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XCirculateEvent_send_event(i) +@@ -2858,8 +2856,8 @@ int j; + + /********* XCirculateRequestEvent funcions *****/ + +-int make_XCirculateRequestEvent (){ +- return ((int) calloc(1, sizeof(XCirculateRequestEvent))); ++long make_XCirculateRequestEvent (){ ++ return ((long) calloc(1, sizeof(XCirculateRequestEvent))); + } + + int XCirculateRequestEvent_place(i) +@@ -2901,17 +2899,17 @@ int j; + i->parent = j; + } + +-Display *XCirculateRequestEvent_display(i) ++long XCirculateRequestEvent_display(i) + XCirculateRequestEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XCirculateRequestEvent_display(i, j) + XCirculateRequestEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XCirculateRequestEvent_send_event(i) +@@ -2956,8 +2954,8 @@ int j; + + /********* XPropertyEvent funcions *****/ + +-int make_XPropertyEvent (){ +- return ((int) calloc(1, sizeof(XPropertyEvent))); ++long make_XPropertyEvent (){ ++ return ((long) calloc(1, sizeof(XPropertyEvent))); + } + + int XPropertyEvent_state(i) +@@ -3012,17 +3010,17 @@ int j; + i->window = j; + } + +-Display *XPropertyEvent_display(i) ++long XPropertyEvent_display(i) + XPropertyEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XPropertyEvent_display(i, j) + XPropertyEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XPropertyEvent_send_event(i) +@@ -3067,8 +3065,8 @@ int j; + + /********* XSelectionClearEvent funcions *****/ + +-int make_XSelectionClearEvent (){ +- return ((int) calloc(1, sizeof(XSelectionClearEvent))); ++long make_XSelectionClearEvent (){ ++ return ((long) calloc(1, sizeof(XSelectionClearEvent))); + } + + int XSelectionClearEvent_time(i) +@@ -3110,17 +3108,17 @@ int j; + i->window = j; + } + +-Display *XSelectionClearEvent_display(i) ++long XSelectionClearEvent_display(i) + XSelectionClearEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XSelectionClearEvent_display(i, j) + XSelectionClearEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XSelectionClearEvent_send_event(i) +@@ -3165,8 +3163,8 @@ int j; + + /********* XSelectionRequestEvent funcions *****/ + +-int make_XSelectionRequestEvent (){ +- return ((int) calloc(1, sizeof(XSelectionRequestEvent))); ++long make_XSelectionRequestEvent (){ ++ return ((long) calloc(1, sizeof(XSelectionRequestEvent))); + } + + int XSelectionRequestEvent_time(i) +@@ -3247,17 +3245,17 @@ int j; + i->owner = j; + } + +-Display *XSelectionRequestEvent_display(i) ++long XSelectionRequestEvent_display(i) + XSelectionRequestEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XSelectionRequestEvent_display(i, j) + XSelectionRequestEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XSelectionRequestEvent_send_event(i) +@@ -3302,8 +3300,8 @@ int j; + + /********* XSelectionEvent funcions *****/ + +-int make_XSelectionEvent (){ +- return ((int) calloc(1, sizeof(XSelectionEvent))); ++long make_XSelectionEvent (){ ++ return ((long) calloc(1, sizeof(XSelectionEvent))); + } + + int XSelectionEvent_time(i) +@@ -3371,17 +3369,17 @@ int j; + i->requestor = j; + } + +-Display *XSelectionEvent_display(i) ++long XSelectionEvent_display(i) + XSelectionEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XSelectionEvent_display(i, j) + XSelectionEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XSelectionEvent_send_event(i) +@@ -3426,8 +3424,8 @@ int j; + + /********* XColormapEvent funcions *****/ + +-int make_XColormapEvent (){ +- return ((int) calloc(1, sizeof(XColormapEvent))); ++long make_XColormapEvent (){ ++ return ((long) calloc(1, sizeof(XColormapEvent))); + } + + int XColormapEvent_state(i) +@@ -3482,17 +3480,17 @@ int j; + i->window = j; + } + +-Display *XColormapEvent_display(i) ++long XColormapEvent_display(i) + XColormapEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XColormapEvent_display(i, j) + XColormapEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XColormapEvent_send_event(i) +@@ -3537,8 +3535,8 @@ int j; + + /********* XClientMessageEvent funcions *****/ + +-int make_XClientMessageEvent (){ +- return ((int) calloc(1, sizeof(XClientMessageEvent))); ++long make_XClientMessageEvent (){ ++ return ((long) calloc(1, sizeof(XClientMessageEvent))); + } + + int XClientMessageEvent_format(i) +@@ -3581,17 +3579,17 @@ int j; + i->window = j; + } + +-Display *XClientMessageEvent_display(i) ++long XClientMessageEvent_display(i) + XClientMessageEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XClientMessageEvent_display(i, j) + XClientMessageEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XClientMessageEvent_send_event(i) +@@ -3636,8 +3634,8 @@ int j; + + /********* XMappingEvent funcions *****/ + +-int make_XMappingEvent (){ +- return ((int) calloc(1, sizeof(XMappingEvent))); ++long make_XMappingEvent (){ ++ return ((long) calloc(1, sizeof(XMappingEvent))); + } + + int XMappingEvent_count(i) +@@ -3692,17 +3690,17 @@ int j; + i->window = j; + } + +-Display *XMappingEvent_display(i) ++long XMappingEvent_display(i) + XMappingEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XMappingEvent_display(i, j) + XMappingEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XMappingEvent_send_event(i) +@@ -3747,8 +3745,8 @@ int j; + + /********* XErrorEvent funcions *****/ + +-int make_XErrorEvent (){ +- return ((int) calloc(1, sizeof(XErrorEvent))); ++long make_XErrorEvent (){ ++ return ((long) calloc(1, sizeof(XErrorEvent))); + } + + char XErrorEvent_minor_code(i) +@@ -3816,17 +3814,17 @@ int j; + i->resourceid = j; + } + +-Display *XErrorEvent_display(i) ++long XErrorEvent_display(i) + XErrorEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XErrorEvent_display(i, j) + XErrorEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XErrorEvent_type(i) +@@ -3845,8 +3843,8 @@ int j; + + /********* XAnyEvent funcions *****/ + +-int make_XAnyEvent (){ +- return ((int) calloc(1, sizeof(XAnyEvent))); ++long make_XAnyEvent (){ ++ return ((long) calloc(1, sizeof(XAnyEvent))); + } + + int XAnyEvent_window(i) +@@ -3862,17 +3860,17 @@ int j; + i->window = j; + } + +-Display *XAnyEvent_display(i) ++long XAnyEvent_display(i) + XAnyEvent* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_XAnyEvent_display(i, j) + XAnyEvent* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (Display *) j; + } + + int XAnyEvent_send_event(i) +@@ -3917,6 +3915,6 @@ int j; + + /********* XEvent funcions *****/ + +-int make_XEvent (){ +- return ((int) calloc(1, sizeof(XEvent))); ++long make_XEvent (){ ++ return ((long) calloc(1, sizeof(XEvent))); + } +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_dwimports.lsp +@@ -0,0 +1,77 @@ ++; dwimports.lsp Gordon S. Novak Jr. 08 Sep 06 ++ ++; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; This file imports symbols of the XGCL package; these symbols may be ++; needed by a more serious user of some of the XGCL functions. ++ ++; See the file gnu.license . ++ ++; This program 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 program 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 program; if not, write to the Free Software ++; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++; This file should be loaded immediately after starting Lisp: ++; If Lisp has seen any of these symbols, loading this file will cause an error. ++ ++(dolist (x '( xlib::picmenu-spec xlib::picmenu-button xlib::rgb ++ xlib::menu-window xlib::flat xlib::parent-window xlib::parent-offset-x ++ xlib::parent-offset-y xlib::picture-width xlib::picture-height ++ xlib::title xlib::permanent xlib::menu-font xlib::item-width xlib::item-height ++ xlib::items xlib::menuw xlib::title-present xlib::width xlib::height ++ xlib::base-x xlib::base-y xlib::offset xlib::size xlib::region xlib::voffset ++ xlib::vsize xlib::init xlib::init? xlib::contains? xlib::create xlib::clear ++ xlib::select xlib::select! xlib::choose xlib::draw xlib::destroy ++ xlib::moveto-xy xlib::reposition xlib::box-item xlib::unbox-item ++ xlib::display-item xlib::item-value xlib::item-position xlib::find-item-width ++ xlib::find-item-height xlib::adjust-offset xlib::calculate-size ++ xlib::menu-x xlib::menu-y xlib::spec xlib::boxflg xlib::deleted-buttons ++ xlib::draw-button xlib::delete-named-button xlib::drawing-width ++ xlib::drawing-height xlib::buttons xlib::dotflg xlib::drawfn xlib::menu-font ++ xlib::offset xlib::size xlib::highlightfn xlib::unhighlightfn ++ xlib::containsxy? xlib::color xlib::value xlib::maxval xlib::barwidth ++ xlib::horizontal xlib::subtrackfn xlib::subtrackparms xlib::update-value ++ xlib::gcontext xlib::parent xlib::drawable-height xlib::drawable-width ++ xlib::label xlib::font xlib::width xlib::height xlib::left xlib::right ++ xlib::top-neg-y xlib::leftmargin xlib::rightmargin xlib::yposition ++ xlib::wfunction xlib::foreground xlib::background xlib::force-output ++ xlib::set-font xlib::set-foreground xlib::set-background ++ xlib::set-cursor xlib::set-erase xlib::set-xor xlib::set-invert xlib::set-copy ++ xlib::set-line-width xlib::set-line-attr xlib::std-line-attr xlib::unset ++ xlib::reset xlib::sync xlib::geometry xlib::size xlib::get-geometry ++ xlib::reset-geometry xlib::query-pointer xlib::wait-exposure xlib::wait-unmap ++ xlib::clear xlib::mapw xlib::unmap xlib::destroy ++ xlib::positive-y xlib::drawline xlib::draw-line xlib::draw-line-xy ++ xlib::draw-latex-xy xlib::draw-arrow-xy xlib::draw-arrow2-xy ++ xlib::draw-arrowhead-xy xlib::draw-box xlib::draw-box-xy ++ xlib::draw-box-corners xlib::draw-rcbox-xy xlib::xor-box-xy xlib::draw-circle ++ xlib::draw-circle-xy xlib::draw-ellipse-xy xlib::draw-arc-xy xlib::invertarea ++ xlib::invert-area xlib::invert-area-xy xlib::copy-area-xy xlib::printat ++ xlib::printat-xy xlib::prettyprintat-xy xlib::prettyprintat xlib::string-width ++ xlib::string-extents xlib::erase-area xlib::erase-area-xy xlib::erase-box-xy ++ xlib::moveto-xy xlib::move xlib::paint xlib::centeroffset xlib::draw-border ++ xlib::track-mouse xlib::track-mouse-in-region xlib::init-mouse-poll ++ xlib::poll-mouse xlib::get-point xlib::get-click xlib::get-line-position ++ xlib::get-latex-position xlib::get-icon-position xlib::get-box-position ++ xlib::get-box-size xlib::get-region xlib::adjust-box-side ++ xlib::get-mouse-position xlib::get-circle xlib::get-ellipse ++ xlib::get-crosshairs xlib::draw-crosshairs-xy xlib::get-cross ++ xlib::draw-cross-xy xlib::draw-dot-xy xlib::draw-vector-pt ++ xlib::get-vector-end xlib::reset-color xlib::set-color-rgb xlib::set-color ++ xlib::set-xcolor xlib::free-color xlib::get-chars xlib::input-string ++ xlib::courier-bold-12 xlib::8x10 xlib::9x15 xlib::center xlib::top ++ xlib::bottom xlib::xor xlib::erase xlib::copy xlib::buttonname ++ )) (import x)) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_menu-set.lsp +@@ -0,0 +1,521 @@ ++; menu-set.lsp Gordon S. Novak Jr. ; 17 Jan 08 ++ ++; Functions to handle a set of menus within a single window. ++ ++; Copyright (c) 2008 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; See the file gnu.license . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++; 12 Aug 96; 04 Nov 97; 28 Feb 02; 05 Jan 04; 03 Mar 04; 30 Jul 04; 02 Aug 04 ++; 27 Jan 06 ++ ++; (wtesta) ; in dwtest.lsp, to create window myw ++; (setq ms (menu-set-create myw nil)) ++; (menu-set-add-menu ms 'flag1 nil "Colors" '(red white blue)) ++; position w/mouse ++; (menu-set-add-menu ms 'Test1 nil "Choice" '(yes no)) ++; position w/mouse ++; do (wteste) to create the square picmenu ++; (menu-set-add-picmenu ms 'square1 nil "Square" mypms) ++; following is alternative -- window is too small to hold both square and cone ++; create cone with draw ++; (menu-set-add-picmenu ms 'cone1 'cone "Cone" 'cone) ++; (menu-set-add-component ms 'nand) ; load draw-gates for nand and cone ++; ++; (menu-set-draw ms) ++; (menu-set-select ms) ; click a menu or background ++; (setq mc (menu-conns-create ms)) ; make a menu-conns object from menu set ++; (menu-conns-add-conn mc) ; click two buttons/menu items ++; repeat above as desired ++; (menu-conns-move mc) ; click a menu and move it ++ ++(glispobjects ++ ++(menu-set (listobject (window window) ++ (menu-items (listof menu-set-item)) ++ (commandfn anything)) ++ msg ((draw menu-set-draw) ++ (select menu-set-select) ++ (named-menu menu-set-named-menu) ++ (named-item menu-set-named-item) ++ (add-menu menu-set-add-menu) ++ (add-picmenu menu-set-add-picmenu) ++ (add-component menu-set-add-component) ++ (add-barmenu menu-set-add-barmenu) ++ (add-item menu-set-add-item) ++ (find-item menu-set-find-item) ++ (delete-item menu-set-delete-item) ++ (remove-items menu-set-remove-items) ++ (item-position menu-set-item-position) ++ (itemp menu-set-itemp) ++ (adjust menu-set-adjust) ++ (move menu-set-move) ++ (draw-conn menu-set-draw-conn) ) ) ++ ++(menu-set-item (list (menu-name symbol) ++ (sym anything) ; extra info ++ (menu menu-set-menu) ) ++ prop ((left ((parent-offset-x menu))) ++ (bottom ((parent-offset-y menu))) ++ (width ((picture-width menu))) ++ (height ((picture-height menu))) ) ++ supers (region) ) ++ ++(menu-set-menu (transparent menu) ; menu or picmenu ++ msg ((draw menu-mdraw)) ) ++ ++(menu-port (list (port symbol) (menu-name symbol)) ) ++ ++(menu-selection (list (port symbol) (menu-name symbol) (button integer)) ) ++ ++(menu-set-conn (list (from menu-port) ++ (to menu-port))) ++ ++(menu-conns (listobject (menu-set menu-set) ++ (connections (listof menu-set-conn))) ++ prop ((window ((window (menu-set self))))) ++ msg ((draw menu-conns-draw) ++ (redraw menu-conns-redraw) ++ (move menu-conns-move) ++ (add-conn menu-conns-add-conn) ++ (add-item menu-conns-add-item open t) ++ (find-conn menu-conns-find-conn) ++ (find-item menu-conns-find-item) ++ (delete-item menu-conns-delete-item) ++ (delete-conn menu-conns-delete-conn) ++ (remove-items menu-conns-remove-items) ++ (find-conns menu-conns-find-conns) ++ (connected-ports menu-conns-connected-ports) ++ (new-conn menu-conns-new-conn) ++ (named-menu menu-conns-named-menu) ++ (named-item menu-conns-named-item) ) ) ++ ++ ) ; glispobjects ++ ++; 04 Sep 92; 09 Feb 94; 12 Oct 94 ++(gldefun menu-set-create ((w window) &optional fn) ++ (a menu-set with window = w commandfn = fn)) ++ ++; 05 Sep 92; 09 Sep 92; 10 Sep 92; 02 Nov 92; 05 May 93; 07 May 93; 04 Aug 93 ++; 03 Jan 94; 07 Jan 94; 03 May 94; 05 Jan 95; 11 Apr 95; 03 Nov 97; 05 Jan 04 ++; Select from multiple menu-like regions within a window. ++; Result is a menu-selection, i.e., a list of the value selected, ++; menu name, and button used, ++; e.g., (QUIT COMMAND 1) for selecting the QUIT item from the COMMAND menu. ++; A click outside any menu returns ((x y) BACKGROUND button-code). ++; enabled, if specified, is a list of names of menus enabled for selection. ++(gldefun menu-set-select ((ms menu-set) &optional (redraw boolean) ++ (enabled (listof symbol))) ++ (result menu-selection) ++ (let ((res menu-selection) resb (itm menu-set-item) (sel symbol) lastx lasty) ++ (if redraw (draw ms)) ++ (while ~ (or res resb) ++ (setq itm (window-track-mouse (window ms) ++ #'(lambda (x y code) ++ (or (and (> code 0) ++ (setq lastx x) ++ (setq lasty y) ++ code) ++ (that menu-item with ++ (contains-xy (that menu-item) x y)))))) ++ (if (numberp itm) ++ (resb = (a menu-selection with ++ port (a vector with x = lastx y = lasty) ++ menu-name 'background ++ button itm)) ++ (if (or (atom enabled) ++ (member (menu-name itm) enabled)) ++ (progn (sel = (menu-mselect (menu itm) (eq enabled t))) ++ (if sel ++ (res = (a menu-selection with ++ menu-name (menu-name itm) ++ port sel ++ button *window-menu-code*)) ++ (if (and *window-menu-code* ++ (*window-menu-code* <> 0)) ++ (res = (a menu-selection with ++ menu-name (menu-name itm) ++ port nil ++ button *window-menu-code*)))) ) ) )) ++ (force-output (window ms)) ++ (or res resb) )) ++ ++; 05 Sep 92; 25 Sep 92; 29 Sep 92 ++; Add a menu to a menu set. ++; name is the name of the menu. sym is extra info such as data type. ++(gldefun menu-set-add-menu ((ms menu-set) (name symbol) (sym symbol) ++ (title string) items ++ &optional (offset vector)) ++ (let (menu) ++ (menu = (menu-create items title (window ms) (x offset) (y offset) t t)) ++ (init menu) ++ (if ~ offset (offset = (get-box-position (window ms) ++ (picture-width menu) ++ (picture-height menu)))) ++ ((parent-offset-x menu) = (x offset)) ++ ((parent-offset-y menu) = (y offset)) ++ (add-item ms name sym menu) )) ++ ++; 25 Sep 92; 29 Sep 92; 07 May 93 ++(gldefun menu-set-add-item ((ms menu-set) (name symbol) (sym symbol) ++ (menu menu)) ++ ((menu-items ms) _+ (a menu-set-item with menu-name = name sym = sym ++ menu = menu)) ) ++ ++; 25 Sep 92 ++(gldefun menu-set-remove-items ((ms menu-set)) ++ ((menu-items ms) = nil) ) ++ ++; 06 Sep 92; 08 Sep 92; 14 Sep 92; 25 Sep 92; 29 Sep 92; 05 Jan 04; 23 Jun 04 ++(gldefun menu-set-add-picmenu ((ms menu-set) (name symbol) (sym symbol) ++ (title string) ++ (spec picmenu-spec) ++ &optional (offset vector) ++ (nobox boolean)) ++ (let (menu maxwidth maxheight) ++ (if (and spec (symbolp spec)) ++ (spec = (get spec 'picmenu-spec)) ) ++ (menu = (picmenu-create-from-spec spec title (window ms) ++ (x offset) (y offset) t t (not nobox))) ++ (maxwidth = (max (if title ((* 9 (length title)) + 6) 0) ++ (drawing-width spec))) ++ (maxheight = (if title 15 0) + (drawing-height spec)) ++ (if ~ offset (offset = (get-box-position (window ms) maxwidth maxheight))) ++ ((parent-offset-x menu) = (x offset)) ++ ((parent-offset-y menu) = (y offset)) ++ (add-item ms name sym menu) )) ++ ++; 11 Oct 93 ++(gldefun menu-set-add-component ((ms menu-set) (name symbol) ++ &optional (offset vector)) ++ (menu-set-add-picmenu ms (menu-set-name name) name nil name offset t)) ++ ++; 03 Jan 94; 05 Jan 04 ++; Add a barmenu to a menu set. ++(gldefun menu-set-add-barmenu ((ms menu-set) (name symbol) (sym symbol) ++ (menu barmenu) ++ (title string) &optional (offset vector)) ++ (let () ++ (init menu) ++ (if ~ offset ++ (offset = (get-box-position (window ms) ++ (picture-width menu) (picture-height menu)))) ++ ((parent-offset-x menu) = (x offset)) ++ ((parent-offset-y menu) = (y offset)) ++ (add-item ms name sym menu) )) ++ ++; 11 Oct 93 ++(gldefun menu-set-name ((nm symbol)) (result symbol) ++ (intern (symbol-name (gensym (symbol-name nm)))) ) ++ ++; 29 Sep 92; 07 May 93; 28 Feb 02 ++(gldefun menu-set-named-item ((ms menu-set) (name symbol)) ++ (result menu-set-item) ++ (that menu-item with (menu-name (that menu-item)) == name) ) ++ ++; 08 Sep 92; 29 Sep 92 ++(gldefun menu-set-named-menu ((ms menu-set) (name symbol)) ++ (result menu-set-menu) ++ (menu (named-item ms name))) ++ ++; 17 Jan 08 ++(gldefun menu-set-itemp ((ms menu-set) (name symbol) (itemname symbol)) ++ (let ((thismenu (named-menu ms name))) ++ (if thismenu is a menu ++ (some #'(lambda (x) (or (eq x itemname) ++ (and (consp x) (eq (car x) itemname)))) ++ (items thismenu)) ++ (if thismenu is a picmenu ++ (assoc itemname (buttons thismenu)) ) ) )) ++ ++; 30 Jul 04 ++(gldefun menu-conns-named-item ((mc menu-conns) (name symbol)) ++ (result menu-set-item) ++ (named-item (menu-set mc) name) ) ++ ++; 01 Feb 94 ++(gldefun menu-conns-named-menu ((mc menu-conns) (name symbol)) ++ (result menu-set-menu) ++ (named-menu (menu-set mc) name) ) ++ ++; 29 Apr 93; 30 Apr 93; 05 Jan 04 ++; Find the item at specified position, if any ++(gldefun menu-set-find-item ((ms menu-set) (pos vector)) ++ (result menu-set-item) ++ (let (mitem) ++ (for mi in (menu-items ms) do ++ (if (contains? (menu mi) pos) ++ (mitem = mi))) ++ mitem)) ++ ++; 29 Apr 93 ++; Delete an item ++(gldefun menu-set-delete-item ((ms menu-set) (mi menu-set-item)) ++ ((menu-items ms) _- mi)) ++ ++; 08 Sep 92; 10 Sep 92; 05 May 93; 06 May 93; 07 May 93 ++(gldefun menu-set-move ((ms menu-set)) ++ (let (sel m) ++ (sel = (menu-set-select ms nil t)) ++ (m = (named-menu ms (menu-name sel))) ++ (menu-reposition m) )) ++ ++; 10 Sep 92; 05 Jan 94; 06 Jan 94; 20 Apr 95; 12 Aug 96 ++; Draw either a menu or picmenu ++(gldefun menu-mdraw (m) ++ (case (first m) ++ (menu (menu-draw m)) ++ (picmenu (picmenu-draw m)) ++ (barmenu (barmenu-draw m)) ++ (textmenu (textmenu-draw m)) ++ (editmenu (editmenu-draw m)) ++ (t (glsend m draw)) ) ) ++ ++; 10 Sep 92; 29 Sep 92; 05 May 93; 03 Jan 94; 06 Jan 94; 20 Apr 95; 21 Apr 95 ++; 12 Aug 96 ++; Select from either a menu or picmenu ++(gldefun menu-mselect (m &optional anyclick) ++ (case (first m) ++ (menu (menu-select m t)) ++ (picmenu (picmenu-select m t anyclick)) ++ (barmenu (barmenu-select m)) ++ (textmenu (textmenu-select m t)) ++ (editmenu (editmenu-select m t)) ++ (t (glsend m select)) ) ) ++ ++; 10 Sep 92; 06 Jan 94 ++; Get item position from either a menu or picmenu; 20 Apr 95 ++(gldefun menu-mitem-position (m name loc) ++ (case (first m) ++ (menu (menu-item-position m name loc)) ++ (picmenu (picmenu-item-position m name loc)) ++ (t (glsend m item-position name loc)) ) ) ++ ++; 05 Sep 92; 08 Sep 92 ++(gldefun menu-set-draw ((ms menu-set)) ++ (let () ++ (open (window ms)) ++ (for item in (menu-items ms) do (draw (menu item))) )) ++ ++; 08 Sep 92; 28 Sep 92; 07 May 93; 25 Jan 94 ++(gldefun menu-set-item-position ((ms menu-set) (desc menu-port) ++ &optional (loc symbol)) ++ (result vector) ++ (let (m) ++ (m = (named-menu ms (menu-name desc))) ++ (or (menu-mitem-position m (port desc) loc) ++ (menu-mitem-position m nil loc)) )) ; header if it cannot be found ++ ++; 08 Sep 92; 05 Jan 04 ++(gldefun menu-set-draw-conn ((ms menu-set) (conn menu-set-conn)) ++ (let (pa pb tmp (desca (from conn)) (descb (to conn))) ++ (pa = (menu-set-item-position ms desca 'center)) ++ (pb = (menu-set-item-position ms descb 'center)) ++ (if ((x pa) > (x pb)) ++ (progn (tmp = desca) ++ (desca = descb) ++ (descb = tmp))) ++ (pa = (menu-set-item-position ms desca 'right)) ++ (pb = (menu-set-item-position ms descb 'left)) ++ (draw-circle (window ms) pa 3) ++ (draw-line (window ms) pa pb) ++ (draw-circle (window ms) pb 3) ++ (force-output (window ms)) )) ++ ++; 02 Dec 93; 07 Jan 94; 05 Jan 04 ++(gldefun menu-set-adjust ((ms menu-set) (name symbol) (edge symbol) ++ (from symbol) (offset integer)) ++ (let (m fromm place) ++ (if (m = (named-item ms name)) ++ (progn ++ (if from ++ (progn (fromm = (named-item ms from)) ++ (place = (case edge ++ (top (bottom fromm)) ++ (bottom (top fromm)) ++ (left (right fromm)) ++ (right (left fromm))))) ++ (place = (case edge ++ (top (height (window ms))) ++ ((bottom left) 0) ++ (right (width (window ms))) )) ) ++ (case edge (top ((bottom m) = place - (height m) - offset)) ++ (bottom ((bottom m) = place + offset)) ++ (left ((left m) = place + offset)) ++ (right ((left m) = place - (width m) - offset)))) ) )) ++ ++; 21 Nov 08 ++; align the vector approx with the vector fixed if within tolerance ++(gldefun vector-snap ((fixed vector) (approx vector) ++ &optional tolerance) ++ (let () ++ (or tolerance (tolerance = 10)) ++ (if (< (abs (- (x fixed) (x approx))) tolerance) ++ (a vector x = (x fixed) y = (y approx)) ++ (if (< (abs (- (y fixed) (y approx))) tolerance) ++ (a vector x = (x approx) y = (y fixed)) ++ approx) ) )) ++ ++; 12 Oct 94; 28 Feb 02 ++(gldefun menu-conns-create ((ms menu-set)) ++ (a menu-conns with menu-set = ms)) ++ ++; 08 Sep 92 ++(gldefun menu-conns-draw ((mc menu-conns)) ++ (let () ++ (draw (menu-set mc)) ++ (for c in (connections mc) (draw-conn (menu-set mc) c)) )) ++ ++; 08 Sep 92 ++(gldefun menu-conns-move ((mc menu-conns)) ++ (let () ++ (menu-set-move (menu-set mc)) ++ (clear (window mc)) ++ (draw mc) )) ++ ++; 29 Apr 93 ++(gldefun menu-conns-redraw ((mc menu-conns)) ++ (let () ++ (clear (window mc)) ++ (draw mc) )) ++ ++; 08 Sep 92; 07 May 93; 21 Oct 93; 05 Jan 95; 28 Feb 02; 05 Jan 04 ++(gldefun menu-conns-add-conn ((mc menu-conns)) ++ (let (sel selb conn) ++ (sel = (select (menu-set mc))) ++ (if ((menu-name sel) == 'background) ++ sel ++ (progn (selb = (select (menu-set mc))) ++ (if ((menu-name selb) <> 'background) ++ (progn (conn = (a menu-set-conn with from = sel to = selb)) ++ (draw-conn (menu-set mc) conn) ++ ((connections mc) _+ conn))) ++ nil) ) )) ++ ++; 02 Aug 04 ++(gldefun menu-conns-new-conn ((mc menu-conns) (fromname symbol) ++ (fromport symbol) (toname symbol) ++ (toport symbol)) ++ (let (conn) ++ (conn = (a menu-set-conn with ++ from = (a menu-port with menu-name = fromname port = fromport) ++ to = (a menu-port with menu-name = toname port = toport))) ++ ((connections mc) _+ conn) )) ++ ++; 30 Apr 93 ++(gldefun menu-conns-add-item ++ ((mc menu-conns) (name symbol) (sym symbol) (menu menu)) ++ (add-item (menu-set mc) name sym menu)) ++ ++; 29 Apr 93; 05 Jan 04 ++; Find the connection that is selected by the given point, if any. ++(gldefun menu-conns-find-conn ((mc menu-conns) (pt vector)) ++ (result menu-set-conn) ++ (let (ms ls found res pa pb tmp desca descb) ++ (ls = (a line-segment)) ++ (ms = (menu-set mc)) ++ (for conn in (connections mc) when (not found) do ++ (desca = (from conn)) ++ (descb = (to conn)) ++ (pa = (menu-set-item-position ms desca 'center)) ++ (pb = (menu-set-item-position ms descb 'center)) ++ (if ((x pa) > (x pb)) ++ (progn (tmp = desca) ++ (desca = descb) ++ (descb = tmp))) ++ ((p1 ls) = (menu-set-item-position ms desca 'right)) ++ ((p2 ls) = (menu-set-item-position ms descb 'left)) ++ (if (< (distance ls pt) 5) ++ (progn (found = t) ++ (res = conn)) )) ++ res)) ++ ++; 29 Apr 93; 30 Apr 93 ++; Find the menu item that is selected by the given point, if any. ++(gldefun menu-conns-find-item ((mc menu-conns) (pt vector)) ++ (result menu-set-item) ++ (find-item (menu-set mc) pt)) ++ ++; 29 Apr 93 ++; Delete a connection ++(gldefun menu-conns-delete-conn ((mc menu-conns) (conn menu-set-conn)) ++ ((connections mc) _- conn)) ++ ++; 29 Apr 93; 07 May 93; 28 Feb 02; 05 Jan 04 ++; Delete a menu item and all its connections ++(gldefun menu-conns-delete-item ((mc menu-conns) (mi menu-set-item)) ++ (let (ms) ++ (ms = (menu-set mc)) ++ (delete-item ms mi) ++ (for conn in (connections mc) do ++ (if (or ((menu-name (from conn)) == (menu-name mi)) ++ ((menu-name (to conn)) == (menu-name mi))) ++ (delete-conn mc conn))) )) ++ ++; 30 Apr 93 ++(gldefun menu-conns-remove-items ((mc menu-conns)) ++ (remove-items (menu-set mc)) ++ ((connections mc) = nil)) ++ ++; 30 Apr 93; 07 May 93; 28 Feb 02; 05 Jan 04 ++; find all ports of a given named menu that are connected to something ++(gldefun menu-conns-connected-ports ((mc menu-conns) (boxname symbol)) ++ (let (ports) ++ (for conn in (connections mc) do ++ (if (boxname == (menu-name (to conn))) ++ (pushnew (port (to conn)) ports) ++ (if (boxname == (menu-name (from conn))) ++ (pushnew (port (from conn)) ports)))) ++ ports)) ++ ++; 30 Apr 93; 07 May 93; 28 Feb 02 ++; Find connections of a given port of a named box ++(gldefun menu-conns-find-conns ((mc menu-conns) (boxname symbol) (port symbol)) ++ (result (listof menu-port)) ++ (let (res) ++ (for conn in (connections mc) do ++ (if (and (boxname == (menu-name (to conn))) ++ (port == (port (to conn)))) ++ (res _+ (from conn))) ++ (if (and (boxname == (menu-name (from conn))) ++ (port == (port (from conn)))) ++ (res _+ (to conn))) ) ++ res)) ++ ++; 03 May 94 ++; Compile menu-set.lsp into a plain Lisp file ++(defun compile-menu-set () ++ (glcompfiles *directory* ++ '("glisp/vector.lsp" ; auxiliary files ++ "X/dwindow.lsp") ++ '("glisp/menu-set.lsp") ; translated files ++ "glisp/menu-settrans.lsp" ; output file ++ "glisp/menu-set-header.lsp") ; header file ++ (compile-file "glisp/menu-settrans.lsp") ) ++ ++; Compile menu-set.lsp into a plain Lisp file for XGCL distribution ++(defun compile-menu-setb () ++ (glcompfiles *directory* ++ '("glisp/vector.lsp" ; auxiliary files ++ "X/dwindow.lsp" "X/dwnoopen.lsp") ++ '("glisp/menu-set.lsp") ; translated files ++ "glisp/menu-settrans.lsp" ; output file ++ "glisp/menu-set-header.lsp") ; header file ++ ) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_index.lsp +@@ -0,0 +1,88 @@ ++; index.lsp Gordon S. Novak Jr. 08 Dec 00; 18 May 06 ++ ++; This program processes LaTeX index entries, printing an index in ++; either LaTeX or HTML form. ++ ++; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; This program 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 program 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 program; if not, write to the Free Software ++; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ++ ++ ++; To use: Gather the LaTeX index data: use \index{foo} within the ++; text and include a \makeindex command at the top of the file, ++; producing a file .idx when the file is run through LaTeX. ++; Use an editor to change the index data from LaTeX form to Lisp: ++; \indexentry{combination}{37} LaTeX ++; ((combination) 37) Lisp ++ ++; We assume that indexdata is a list of such entries, as illustrated ++; at the end of this file. ++ ++; Warning: quote characters or apostrophes within the indexed ++; entries will not read into Lisp as expected. ++; Get rid of ' or change it to \' ++ ++; Start /p/bin/gcl ++; (load "index.lsp") ++; (printindex indexdata) ; for LaTeX output ++; (printindex indexdata "prefix") ; for HTML output ++; where "prefix" is the file name prefix for HTML files. ++ ++; Print index for LaTeX given a list of items ((words ...) page-number) ++(in-package 'xlib) ++(defun printindex (origlst &optional html) ++ (let (lst top) ++ (setq lst ++ (sort origlst ++ #'(lambda (x y) (or (wordlist< (car x) (car y)) ++ (and (equal (car x) (car y)) ++ (< (cadr x) (cadr y))))))) ++ (terpri) ++ (while lst ++ (setq top (pop lst)) ++ (if (not html) ++ (princ "\\item ")) ++ (dolist (word (car top)) ++ (princ (string-downcase (symbol-name word))) (princ " ")) ++ (printindexn (cadr top) html nil) ++ (while (equal (caar lst) (car top)) ++ (setq top (pop lst)) ++ (printindexn (cadr top) html t) ) ++ (if html ++ (format t "

~%") ++ (terpri)) ) )) ++ ++(defun wordlist< (x y) ++ (and (consp x) (consp y) ++ (or (string< (symbol-name (car x)) ++ (symbol-name (car y))) ++ (and (eq (car x) (car y)) ++ (or (and (null (cdr x)) (cdr y)) ++ (and (cdr x) (cdr y) ++ (wordlist< (cdr x) (cdr y)))))))) ++ ++(defun printindexn (n html comma) ++ (if comma (princ ", ")) ++ (if html ++ (format t "~D" html n n) ++ (princ n)) ) ++ ++(setq indexdata '( ++ ++; Insert index entry data here. Data should look like: ++; ((isomorphism) 20) ++; ((artificial intelligence) 30) ++ ++)) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_dwindow.lsp +@@ -0,0 +1,3020 @@ ++; dwindow.lsp Gordon S. Novak Jr. ; 13 Jan 10 ++ ++; Window types and interface functions for using X windows from GNU Common Lisp ++ ++; Copyright (c) 2010 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; 08 Jan 97; 17 May 02; 17 May 04; 18 May 04; 01 Jun 04; 18 Aug 04; 21 Jan 06 ++; 24 Jan 06; 24 Jun 06; 25 Jun 06; 17 Jul 06; 23 Aug 06; 08 Sep 06; 21 May 09 ++; 28 Aug 09; 31 Aug 09; 28 Oct 09; 07 Nov 09; 12 Jan 10 ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 program 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 program; if not, write to the Free Software ++; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++; These functions use the convention that positive y is upwards, ++; (0 0) is the lower-left corner of a window. ++ ++; derived from {DSK}DWINDOW.CL;1 1-Mar-89 13:16:20 ++; Modified for AKCL/X using Hiep Huu Nguyen's interfaces from AKCL -> C -> X. ++; Parts of Nguyen's file Xinit.lsp are included. ++ ++ ++(defvar *window-add-menu-title* nil) ; t to add title bar within menu area ++(defvar *window-menu* nil) ++(defvar *mouse-x* nil) ++(defvar *mouse-y* nil) ++(defvar *mouse-window* nil) ++ ++(defvar *window-fonts* (list ++ (list 'courier-bold-12 ++ "*-*-courier-bold-r-*-*-12-*-*-*-*-*-iso8859-1") ++ (list 'courier-medium-12 ++ "*-*-courier-medium-r-*-*-12-*-*-*-*-*-iso8859-1") ++ (list '6x12 "6x12") ++ (list '8x13 "8x13") ++ (list '9x15 "9x15"))) ++ ++(glispglobals (*window-menu* menu) ++ (*mouse-x* integer) ++ (*mouse-y* integer) ++ (*mouse-window* window) ++ (*picmenu-no-selection* picmenu-button) ) ++ ++(defvar *window-display* nil) ++(defvar *window-screen* nil) ++(defvar *root-window*) ++(defvar *black-pixel*) ++(defvar *white-pixel*) ++(defvar *default-fg-color*) ++(defvar *default-bg-color*) ++(defvar *default-size-hints*) ++(defvar *default-GC*) ++(defvar *default-colormap*) ++(defvar *window-event*) ++(defvar *window-default-pos-x* 10) ++(defvar *window-default-pos-y* 20) ++(defvar *window-default-border* 1) ++(defvar *window-default-font-name* 'courier-bold-12) ++(defvar *window-default-cursor* 68) ++(defvar *window-save-foreground*) ++(defvar *window-save-function*) ++(defvar *window-attributes*) ++(defvar *window-attr*) ++(defvar *menu-title-pad* 30) ; extra space for title bar of menu ++; The following -return globals are used in calls to Xlib ++; routines. ++; Where the Xlib parameter is int*, the parameter must be ++; initialized to (int-array 1) and is accessed with ++; (int-pos param 0). ++; The following X types are CARD32: (from Xproto.h) ++; Window Drawable Font Pixmap Cursor Colormap GContext ++; Atom VisualID Time KeySym ++; KeyCode = CARD8 ++(defvar *root-return* (fixnum-array 1)) ++(defvar *child-return* (fixnum-array 1)) ++(defvar *root-x-return* (int-array 1)) ++(defvar *root-y-return* (int-array 1)) ++(defvar *win-x-return* (int-array 1)) ++(defvar *win-y-return* (int-array 1)) ++(defvar *mask-return* (int-array 1)) ++(defvar *x-return* (int-array 1)) ++(defvar *y-return* (int-array 1)) ++(defvar *width-return* (int-array 1)) ++(defvar *height-return* (int-array 1)) ++(defvar *depth-return* (int-array 1)) ++(defvar *border-width-return* (int-array 1)) ++(defvar *text-width-return* (int-array 1)) ++(defvar *direction-return* (int-array 1)) ++(defvar *ascent-return* (int-array 1)) ++(defvar *descent-return* (int-array 1)) ++(defvar *overall-return* (int-array 1)) ++(defvar *GC-Values*) ++(defvar *window-xcolor* nil) ++(defvar *window-menu-code* nil) ++ ++(defvar *window-keymap* (make-array 256)) ++(defvar *window-shiftkeymap* (make-array 256)) ++(defvar *window-keyinit* nil) ++(defvar *window-meta*) ; set if meta down when char is pressed ++(defvar *window-ctrl*) ; set if ctrl down when char is pressed ++(defvar *window-shift*) ; set if shift down when char is pressed ++ ++(defvar *window-shift-keys* nil) ++(defvar *window-control-keys* nil) ++(defvar *window-meta-keys* nil) ++(defvar *min-keycodes-return* (int-array 1)) ++(defvar *max-keycodes-return* (int-array 1)) ++(defvar *keycodes-return* (int-array 1)) ++ ++(setq *window-keyinit* nil) ++ ++(defmacro picmenu-spec (symbol) `(get ,symbol 'picmenu-spec)) ++ ++(glispobjects ++ ++(drawable anything) ++ ++(menu (listobject (menu-window window) ++ (flat boolean) ++ (parent-window drawable) ++ (parent-offset-x integer) ++ (parent-offset-y integer) ++ (picture-width integer) ++ (picture-height integer) ++ (title string) ++ (permanent boolean) ++ (menu-font symbol) ++ (item-width integer) ++ (items (listof symbol)) ) ++ prop ((menuw (menu-window or (menu-init self)) result window) ++ (title-present (title and ((length title) > 0))) ++ (width (picture-width)) ++ (height (picture-height)) ++ (base-x ((if flat parent-offset-x 0))) ++ (base-y ((if flat parent-offset-y 0))) ++ (offset menu-offset) ++ (size menu-size) ++ (region ((virtual region with start = voffset size = vsize))) ++ (voffset ((virtual vector with x = base-x y = base-y))) ++ (vsize ((virtual vector with x = picture-width ++ y = picture-height))) ) ++ msg ((init menu-init) ++ (init? ((menu-window and (picture-height > 0)) or (init self))) ++ (contains? (glambda (m p) (contains? (region m) p))) ++ (create menu-create result menu) ++ (clear menu-clear) ++ (select menu-select) ++ (select! menu-select!) ++ (choose menu-choose) ++ (draw menu-draw) ++ (destroy menu-destroy) ++ (moveto-xy menu-moveto-xy) ++ (reposition menu-reposition) ++ (reposition-line menu-reposition-line) ++ (box-item menu-box-item) ++ (unbox-item menu-box-item) ; same since it uses xor ++ (display-item menu-display-item) ++ (item-value menu-item-value open t) ++ (item-position menu-item-position result vector) ++ (find-item-width menu-find-item-width) ++ (find-item-height menu-find-item-height) ++ (adjust-offset menu-adjust-offset) ++ (calculate-size menu-calculate-size) ++ (menu-x (glambda (m x) ((base-x m) + x))) ++ (menu-y (glambda (m y) ((base-y m) + y))) ) ) ++ ++; picture menu: a drawn object with "hot buttons" at certain points. ++; note: the first 10 data items of picmenu must be the same as in menu. ++(picmenu (listobject (menu-window window) ++ (flat boolean) ++ (parent-window drawable) ++ (parent-offset-x integer) ++ (parent-offset-y integer) ++ (picture-width integer) ++ (picture-height integer) ++ (title string) ++ (permanent boolean) ++ (spec (transparent picmenu-spec)) ++ (boxflg boolean) ++ (deleted-buttons (listof symbol)) ++ (button-colors (listof (list (name symbol) (color rgb)))) ++ ) ++ prop ((menuw (menu-window or (picmenu-init self)) result window) ) ++ msg ((init picmenu-init) ++ (init? ((menu-window and (picture-height > 0)) or (init self))) ++ (create picmenu-create result picmenu) ++ (select picmenu-select) ++ (draw picmenu-draw) ++ (draw-button picmenu-draw-button) ++ (draw-named-button picmenu-draw-named-button) ++ (set-named-button-color picmenu-set-named-button-color) ++ (delete-named-button picmenu-delete-named-button) ++ (box-item picmenu-box-item) ++ (unbox-item picmenu-unbox-item) ++ (calculate-size picmenu-calculate-size) ++ (item-position picmenu-item-position result vector) ) ++ supers (menu) ) ++ ++(picmenu-spec (listobject (drawing-width integer) ++ (drawing-height integer) ++ (buttons (listof picmenu-button)) ++ (dotflg boolean) ++ (drawfn anything) ++ (menu-font symbol) )) ++ ++(picmenu-button (list (buttonname symbol) ++ (offset vector) ++ (size vector) ++ (highlightfn anything) ++ (unhighlightfn anything)) ++ msg ((containsxy? picmenu-button-containsxy?)) ) ++ ++(barmenu (listobject (menu-window window) ++ (flat boolean) ++ (parent-window drawable) ++ (parent-offset-x integer) ++ (parent-offset-y integer) ++ (picture-width integer) ++ (picture-height integer) ++ (title string) ++ (permanent boolean) ++ (color rgb) ++ (value integer) ++ (maxval integer) ++ (barwidth integer) ++ (horizontal boolean) ++ (subtrackfn anything) ++ (subtrackparms (listof anything))) ++ prop ((menuw (menu-window or (barmenu-init self)) result window) ++ (picture-width ((if (horizontal m) (maxval m) ++ (barwidth m)) )) ++ (picture-height ((if (horizontal m) (barwidth m) ++ (maxval m)) )) ) ++ msg ((init barmenu-init) ++ (init? ((menu-window and (picture-height > 0)) ++ or (init self))) ++ (create barmenu-create result barmenu) ++ (select barmenu-select) ++ (draw barmenu-draw) ++ (update-value barmenu-update-value) ++ (calculate-size barmenu-calculate-size) ) ++supers (menu)) ++ ++; Note: data through 'permanent' must be same as in menu. ++(textmenu (listobject (menu-window window) ++ (flat boolean) ++ (parent-window drawable) ++ (parent-offset-x integer) ++ (parent-offset-y integer) ++ (picture-width integer) ++ (picture-height integer) ++ (title string) ++ (permanent boolean) ++ (text string) ++ (drawing-width integer) ++ (drawing-height integer) ++ (boxflg boolean) ++ (menu-font symbol) ) ++ ++ prop ((menuw (menu-window or (textmenu-init self)) result window) ) ++ msg ((init textmenu-init) ++ (init? ((menu-window and (picture-height > 0)) or (init self))) ++ (create textmenu-create result textmenu) ++ (select textmenu-select) ++ (draw textmenu-draw) ++ (calculate-size textmenu-calculate-size) ++ (set-text textmenu-set-text open t) ) ++ supers (menu) ) ++ ++; Note: data through 'permanent' must be same as in menu. ++(editmenu (listobject (menu-window window) ++ (flat boolean) ++ (parent-window drawable) ++ (parent-offset-x integer) ++ (parent-offset-y integer) ++ (picture-width integer) ++ (picture-height integer) ++ (title string) ++ (permanent boolean) ++ (text (listof string)) ++ (drawing-width integer) ++ (drawing-height integer) ++ (boxflg boolean) ++ (menu-font symbol) ++ (column integer) ++ (line integer) ++ (scrollval integer) ) ++ prop ((menuw (menu-window or (editmenu-init self)) result window) ++ (scroll ((if (numberp scrollval) ++ scrollval ++ 0))) ) ++ ++ msg ((init editmenu-init) ++ (init? ((menu-window and (picture-height > 0)) or (init self))) ++ (create editmenu-create result editmenu) ++ (select editmenu-select) ++ (draw editmenu-draw) ++ (edit editmenu-edit) ++ (carat editmenu-carat) ++ (display editmenu-display) ++ (calculate-size editmenu-calculate-size) ++ (line-y editmenu-line-y open t) ) ++ supers (menu) ) ++ ++(window (listobject (parent drawable) ++ (gcontext anything) ++ (drawable-height integer) ++ (drawable-width integer) ++ (label string) ++ (font anything) ) ++default ((self nil)) ++prop ((width (drawable-width)) ++ (height (drawable-height)) ++ (left window-left open t result integer) ++ (right (left + width)) ++ (top-neg-y window-top-neg-y open t result integer) ++ (leftmargin (1)) ++ (rightmargin (width - 1)) ++ (yposition window-yposition result integer open t) ++ (wfunction window-wfunction open t) ++ (foreground window-foreground open t) ++ (background window-background open t) ++ (font-width ((string-width self "W"))) ++ (font-height ((string-height self "Tg"))) ) ++msg ((force-output window-force-output open t) ++ (set-font window-set-font) ++ (set-foreground window-set-foreground open t) ++ (set-background window-set-background open t) ++ (set-cursor window-set-cursor open t) ++ (set-erase window-set-erase open t) ++ (set-xor window-set-xor open t) ++ (set-invert window-set-invert open t) ++ (set-copy window-set-copy open t) ++ (set-line-width window-set-line-width open t) ++ (set-line-attr window-set-line-attr open t) ++ (std-line-attr window-std-line-attr open t) ++ (unset window-unset open t) ++ (reset window-reset open t) ++ (sync window-sync open t) ++ (geometry window-geometry open t) ++ (size window-size) ++ (get-geometry window-get-geometry open t) ++ (reset-geometry window-reset-geometry open t) ++ (query-pointer window-query-pointer open t) ++ (wait-exposure window-wait-exposure) ++ (wait-unmap window-wait-unmap) ++ (clear window-clear open t) ++ (mapw window-map open t) ++ (unmap window-unmap open t) ++ (open window-open open t) ++ (close window-close open t) ++ (destroy window-destroy open t) ++ (positive-y window-positive-y open t) ++ (drawline window-draw-line open t) ++ (draw-line window-draw-line open t) ++ (draw-line-xy window-draw-line-xy open t) ++ (draw-latex-xy window-draw-latex-xy) ++ (draw-arrow-xy window-draw-arrow-xy ) ++ (draw-arrow2-xy window-draw-arrow2-xy ) ++ (draw-arrowhead-xy window-draw-arrowhead-xy ) ++ (draw-box window-draw-box open t) ++ (draw-box-xy window-draw-box-xy) ++ (draw-box-corners window-draw-box-corners open t) ++ (draw-rcbox-xy window-draw-rcbox-xy) ++ (draw-box-line-xy window-draw-box-line-xy) ++ (xor-box-xy window-xor-box-xy open t) ++ (draw-circle window-draw-circle open t) ++ (draw-circle-xy window-draw-circle-xy open t) ++ (draw-ellipse-xy window-draw-ellipse-xy open t) ++ (draw-arc-xy window-draw-arc-xy open t) ++ (invertarea window-invertarea open t) ++ (invert-area window-invert-area open t) ++ (invert-area-xy window-invert-area-xy open t) ++ (copy-area-xy window-copy-area-xy open t) ++ (printat window-printat open t) ++ (printat-xy window-printat-xy open t) ++ (print-line window-print-line) ++ (print-lines window-print-lines) ++ (prettyprintat window-prettyprintat open t) ++ (prettyprintat-xy window-prettyprintat-xy open t) ++ (string-width window-string-width open t) ++ (string-extents window-string-extents open t) ++ (erase-area window-erase-area open t) ++ (erase-area-xy window-erase-area-xy open t) ++ (erase-box-xy window-erase-box-xy open t) ++ (moveto-xy window-moveto-xy) ++ (move window-move) ++ (paint window-paint) ++ (centeroffset window-centeroffset open t) ++ (draw-border window-draw-border open t) ++ (track-mouse window-track-mouse) ++ (track-mouse-in-region window-track-mouse-in-region) ++ (init-mouse-poll window-init-mouse-poll) ++ (poll-mouse window-poll-mouse) ++ (get-point window-get-point) ++ (get-click window-get-click) ++ (get-line-position window-get-line-position) ++ (get-latex-position window-get-latex-position) ++ (get-icon-position window-get-icon-position) ++ (get-box-position window-get-box-position) ++ (get-box-line-position window-get-box-line-position) ++ (get-box-size window-get-box-size) ++ (get-region window-get-region) ++ (adjust-box-side window-adjust-box-side) ++ (get-mouse-position window-get-mouse-position) ++ (get-circle window-get-circle) ++ (get-ellipse window-get-ellipse) ++ (get-crosshairs window-get-crosshairs) ++ (draw-crosshairs-xy window-draw-crosshairs-xy) ++ (get-cross window-get-cross) ++ (draw-cross-xy window-draw-cross-xy) ++ (draw-dot-xy window-draw-dot-xy) ++ (draw-vector-pt window-draw-vector-pt) ++ (get-vector-end window-get-vector-end) ++ (reset-color window-reset-color) ++ (set-color-rgb window-set-color-rgb) ++ (set-color window-set-color) ++ (set-xcolor window-set-xcolor) ++ (free-color window-free-color) ++ (get-chars window-get-chars) ++ (input-string window-input-string) ++ (string-width window-string-width) ++ (string-extents window-string-extents) ++ (string-height window-string-height) ++ (draw-carat window-draw-carat) ++ )) ++ ++(rgb (list (red integer) (green integer) (blue integer))) ++ ++ ) ; glispobjects ++ ++(glispconstants ; used by GEV ++ (windowcharwidth 9 integer) ++ (windowlineyspacing 17 integer) ++) ++ ++(defvar *picmenu-no-selection* '(no-selection (0 0) (0 0) nil nil)) ++ ++; 14 Mar 95 ++; Make something into a string. ++; The copy-seq avoids an error with get-c-string on Sun. ++(defun stringify (x) ++ (cond ((stringp x) x) ++ ((symbolp x) (copy-seq (symbol-name x))) ++ (t (princ-to-string x)))) ++ ++; 24 Jun 06 ++; This function initializes variables needed by most applications. ++; It uses all defaults inherited from the root window, and screen. ; H. Nguyen ++(defun window-Xinit () ++ (setq *window-display* (XOpenDisplay (get-c-string ""))) ++ (if (or (not (numberp *window-display*)) ; 22 Jun 06 ++ (< *window-display* 10000)) ++ (error "DISPLAY did not open: return value ~A~%" *window-display*)) ++ (setq *window-screen* (XdefaultScreen *window-display*)) ++ (setq *root-window* (XRootWindow *window-display* *window-screen*)) ++ (setq *black-pixel* (XBlackPixel *window-display* *window-screen*)) ++ (setq *white-pixel* (XWhitePixel *window-display* *window-screen*)) ++ (setq *default-fg-color* *black-pixel*) ++ (setq *default-bg-color* *white-pixel*) ++ (setq *default-GC* (XDefaultGC *window-display* *window-screen*)) ++ (setq *default-colormap* (XDefaultColormap *window-display* ++ *window-screen*)) ++ (setq *window-attributes* (make-XsetWindowAttributes)) ++ (set-XsetWindowAttributes-backing_store *window-attributes* ++ WhenMapped) ++ (set-XsetWindowAttributes-save_under *window-attributes* 1) ; True ++ (setq *window-attr* (make-XWindowAttributes)) ++ (Xflush *window-display*) ++ (setq *default-size-hints* (make-XsizeHints)) ++ (setq *window-event* (make-XEvent)) ++ (setq *GC-Values* (make-XGCValues)) ) ++ ++(defun window-get-mouse-position () ++ (XQueryPointer *window-display* *root-window* ++ *root-return* *child-return* *root-x-return* *root-y-return* ++ *win-x-return* *win-y-return* *mask-return*) ++ (setq *mouse-x* (int-pos *root-x-return* 0)) ++ (setq *mouse-y* (int-pos *root-y-return* 0)) ++ (setq *mouse-window* (fixnum-pos *child-return* 0)) ) ; 22 Jun 06 ++ ++; 13 Aug 91; 14 Aug 91; 06 Sep 91; 12 Sep 91; 06 Dec 91; 01 May 92; 01 Sep 92 ++; 08 Sep 06 ++(setf (glfnresulttype 'window-create) 'window) ++(gldefun window-create (width height &optional str parentw pos-x pos-y font) ++ (let (w pw fg-color bg-color (null 0)) ++ (or *window-display* (window-Xinit)) ++ (setq fg-color *default-fg-color*) ++ (setq bg-color *default-bg-color*) ++ (unless pos-x (pos-x = *window-default-pos-x*)) ++ (unless pos-y (pos-y = *window-default-pos-y*)) ++ (w = (a window with ++ drawable-width = width ++ drawable-height = height ++ label = (if str (stringify str) " ") )) ++ (pw = (or parentw *root-window*)) ++ (window-get-geometry-b pw) ++ ((parent w) = ++ (XCreateSimpleWindow *window-display* pw ++ pos-x ++ ((int-pos *height-return* 0) ++ - pos-y - height) ++ width height ++ *window-default-border* ++ fg-color bg-color)) ++ (set-xsizehints-x *default-size-hints* pos-x) ++ (set-xsizehints-y *default-size-hints* pos-y) ++ (set-xsizehints-width *default-size-hints* (width w)) ++ (set-xsizehints-height *default-size-hints* (height w)) ++ (set-xsizehints-flags *default-size-hints* ++ (+ Psize Pposition)) ++ (XsetStandardProperties *window-display* (parent w) ++ (get-c-string (label w)) ++ (get-c-string (label w)) ; icon name ++ none null null ++ *default-size-hints*) ++ ((gcontext w) = (XCreateGC *window-display* (parent w) 0 null)) ++ (set-foreground w fg-color) ++ (set-background w bg-color) ++ (set-font w (or font *window-default-font-name*)) ++ (set-cursor w *window-default-cursor*) ++ (set-line-width w 1) ++ (XChangeWindowAttributes *window-display* (parent w) ++ (+ CWSaveUnder CWBackingStore) ++ *window-attributes*) ++ (Xselectinput *window-display* (parent w) ++ (+ leavewindowmask buttonpressmask ++ buttonreleasemask ++ pointermotionmask exposuremask)) ++ (open w) ++ w )) ++ ++; 06 Aug 91; 17 May 04 ++; Set the font for a window to the one specified by fontsymbol. ++; derived from Nguyen's my-load-font. ++(gldefun window-set-font ((w window) (fontsymbol symbol)) ++ (let (fontstring font-info (display *window-display*)) ++ (fontstring = (or (cadr (assoc fontsymbol *window-fonts*)) ++ (stringify fontsymbol))) ++ (font-info = (XloadQueryFont display ++ (get-c-string fontstring))) ++ (if (eql 0 font-info) ++ (format t "~%can't open font ~a ~a~%" fontsymbol fontstring) ++ (progn (XsetFont display (gcontext w) (Xfontstruct-fid font-info)) ++ ((font w) = font-info)) ) )) ++ ++; 15 Oct 91 ++(defun window-font-info (fontsymbol) ++ (XloadQueryFont *window-display* ++ (get-c-string ++ (or (cadr (assoc fontsymbol *window-fonts*)) ++ (stringify fontsymbol))))) ++ ++ ++; Functions to allow access to window properties from plain Lisp ++(gldefun window-gcontext ((w window)) (gcontext w)) ++(gldefun window-parent ((w window)) (parent w)) ++(gldefun window-drawable-height ((w window)) (drawable-height w)) ++(gldefun window-drawable-width ((w window)) (drawable-width w)) ++(gldefun window-label ((w window)) (label w)) ++(gldefun window-font ((w window)) (font w)) ++ ++; 07 Aug 91; 14 Aug 91 ++(gldefun window-foreground ((w window)) ++ (XGetGCValues *window-display* (gcontext w) GCForeground ++ *GC-Values*) ++ (XGCValues-foreground *GC-Values*) ) ++ ++(gldefun window-set-foreground ((w window) (fg-color integer)) ++ (XsetForeground *window-display* (gcontext w) fg-color)) ++ ++(gldefun window-background ((w window)) ++ (XGetGCValues *window-display* (gcontext w) GCBackground ++ *GC-Values*) ++ (XGCValues-Background *GC-Values*) ) ++ ++(gldefun window-set-background ((w window) (bg-color integer)) ++ (XsetBackground *window-display* (gcontext w) bg-color)) ++ ++; 08 Aug 91 ++(gldefun window-wfunction ((w window)) ++ (XGetGCValues *window-display* (gcontext w) GCFunction ++ *GC-Values*) ++ (XGCValues-function *GC-Values*) ) ++ ++; 08 Aug 91 ++; Get the geometry parameters of a window into global variables ++(gldefun window-get-geometry ((w window)) (window-get-geometry-b (parent w))) ++ ++; 06 Dec 91 ++; Set cursor to a selected cursor number ++(gldefun window-set-cursor ((w window) (n integer)) ++ (let (c) ++ (c = (XCreateFontCursor *window-display* n) ) ++ (XDefineCursor *window-display* (parent w) c) )) ++ ++(defun window-get-geometry-b (w) ++ (XGetGeometry *window-display* w ++ *root-return* *x-return* *y-return* *width-return* ++ *height-return* *border-width-return* *depth-return*) ) ++ ++; 15 Aug 91 ++; clear event queue of previous motion events ++(gldefun window-sync ((w window)) ++ (Xsync *window-display* 1) ) ++ ++; 03 Oct 91; 06 Oct 94 ++(gldefun window-screen-height () ++ (window-get-geometry-b *root-window*) ++ (int-pos *height-return* 0) ) ++ ++; 08 Aug 91; 12 Sep 91; 28 Oct 91 ++; Make a list of window geometry, (x y width height border-width). ++(gldefun window-geometry ((w window)) ++ (let (sh) ++ (sh = (window-screen-height)) ++ (get-geometry w) ++ ((drawable-width w) = (int-pos *width-return* 0)) ++ ((drawable-height w) = (int-pos *height-return* 0)) ++ (list (int-pos *x-return* 0) ++ (sh - (int-pos *y-return* 0) ++ - (int-pos *height-return* 0)) ++ (int-pos *width-return* 0) ++ (int-pos *height-return* 0) ++ (int-pos *border-width-return* 0)) )) ++ ++; 27 Nov 91 ++(gldefun window-size ((w window)) (result vector) ++ (get-geometry w) ++ (list ((drawable-width w) = (int-pos *width-return* 0)) ++ ((drawable-height w) = (int-pos *height-return* 0)) ) ) ++ ++(gldefun window-left ((w window)) ++ (get-geometry w) ++ (int-pos *x-return* 0)) ++ ++; Get top of window in X (y increasing downwards) coordinates. ++(gldefun window-top-neg-y ((w window)) ++ (get-geometry w) ++ (int-pos *y-return* 0)) ++ ++; 08 Aug 91 ++; Reset the local geometry parameters of a window from its X values. ++; Needed, for example, if the user resizes the window by mouse command. ++(gldefun window-reset-geometry ((w window)) ++ (get-geometry w) ++ ((drawable-width w) = (int-pos *width-return* 0)) ++ ((drawable-height w) = (int-pos *height-return* 0)) ) ++ ++(gldefun window-force-output (&optional (w window)) ++ (Xflush *window-display*)) ++ ++(gldefun window-query-pointer ((w window)) ++ (window-query-pointer-b (parent w)) ) ++ ++(defun window-query-pointer-b (w) ++ (XQueryPointer *window-display* w ++ *root-return* *child-return* *root-x-return* *root-y-return* ++ *win-x-return* *win-y-return* *mask-return*) ) ++ ++(gldefun window-positive-y ((w window) (y integer)) ((height w) - y)) ++ ++; 08 Aug 91 ++; Set parameters of a window for drawing by XOR, saving old values. ++(gldefun window-set-xor ((w window)) ++ (let ((gc (gcontext w)) ) ++ (setq *window-save-function* (wfunction w)) ++ (XsetFunction *window-display* gc GXxor) ++ (setq *window-save-foreground* (foreground w)) ++ (XsetForeground *window-display* gc ++ (logxor *window-save-foreground* (background w))) )) ++ ++; 08 Aug 91 ++; Reset parameters of a window after change, using saved values. ++(gldefun window-unset ((w window)) ++ (let ((gc (gcontext w)) ) ++ (XsetFunction *window-display* gc *window-save-function*) ++ (XsetForeground *window-display* gc *window-save-foreground*) )) ++ ++; 04 Sep 91 ++; Reset parameters of a window, using default values. ++(gldefun window-reset ((w window)) ++ (let ((gc (gcontext w)) ) ++ (XsetFunction *window-display* gc GXcopy) ++ (XsetForeground *window-display* gc *default-fg-color*) ++ (XsetBackground *window-display* gc *default-bg-color*) )) ++ ++; 09 Aug 91; 03 Sep 92 ++; Set parameters of a window for erasing, saving old values. ++(gldefun window-set-erase ((w window)) ++ (let ((gc (gcontext w)) ) ++ (setq *window-save-function* (wfunction w)) ++ (XsetFunction *window-display* gc GXcopy) ++ (setq *window-save-foreground* (foreground w)) ++ (XsetForeground *window-display* gc (background w)) )) ++ ++(gldefun window-set-copy ((w window)) ++ (let ((gc (gcontext w)) ) ++ (setq *window-save-function* (wfunction w)) ++ (XsetFunction *window-display* gc GXcopy) ++ (setq *window-save-foreground* (foreground w)) )) ++ ++; 12 Aug 91 ++; Set parameters of a window for inversion, saving old values. ++(gldefun window-set-invert ((w window)) ++ (let ((gc (gcontext w)) ) ++ (setq *window-save-function* (wfunction w)) ++ (XsetFunction *window-display* gc GXxor) ++ (setq *window-save-foreground* (foreground w)) ++ (XsetForeground *window-display* gc ++ (logxor *window-save-foreground* (background w))) )) ++ ++; 13 Aug 91 ++(gldefun window-set-line-width ((w window) (width integer)) ++ (set-line-attr w width nil nil nil)) ++ ++; 13 Aug 91; 12 Sep 91 ++(gldefun window-set-line-attr ++ (w\:window width &optional line-style cap-style join-style) ++ (XsetLineAttributes *window-display* (gcontext w) ++ (or width 1) ++ (or line-style LineSolid) ++ (or cap-style CapButt) ++ (or join-style JoinMiter) ) ) ++ ++; 13 Aug 91 ++; Set standard line attributes ++(gldefun window-std-line-attr ((w window)) ++ (XsetLineAttributes *window-display* (gcontext w) ++ 1 LineSolid CapButt JoinMiter) ) ++ ++; 06 Aug 91; 08 Aug 91; 12 Sep 91 ++(gldefun window-draw-line ((w window) (from vector) (to vector) ++ &optional linewidth) ++ (window-draw-line-xy w (x from) (y from) (x to) (y to) linewidth) ) ++ ++; 19 Dec 90; 07 Aug 91; 08 Aug 91; 09 Aug 91; 13 Aug 91; 12 Sep 91; 28 Sep 94 ++(gldefun window-draw-line-xy ((w window) (fromx integer) ++ (fromy integer) ++ (tox integer) (toy integer) ++ &optional linewidth ++ (operation atom)) ++ (let ( (qqwheight (drawable-height w)) ) ++ (if (linewidth and (linewidth <> 1)) (set-line-width w linewidth)) ++ (case operation ++ (xor (set-xor w)) ++ (erase (set-erase w)) ++ (t nil)) ++ (XDrawLine *window-display* (parent w) (gcontext w) ++ fromx (- qqwheight fromy) tox (- qqwheight toy) ) ++ (case operation ++ ((xor erase) (unset w)) ++ (t nil)) ++ (if (linewidth and (linewidth <> 1)) (set-line-width w 1)) )) ++ ++; 09 Oct 91 ++(defun window-draw-arrowhead-xy (w x1 y1 x2 y2 &optional (linewidth 1) size) ++ (let (th theta ysth ycth (y2dela 0) (y2delb 0) (x2dela 0) (x2delb 0)) ++ (or size (setq size (+ 20 (* linewidth 5)))) ++ (setq th (atan (- y2 y1) (- x2 x1))) ++ (setq theta (* th (/ 180.0 pi))) ++ (setq ysth (round (* (1+ size) (sin th)))) ++ (setq ycth (round (* (1+ size) (cos th)))) ++ (if (and (eql y1 y2) (evenp linewidth)) ; correct for even-size lines ++ (if (> x2 x1) (setq y2delb 1) (setq y2dela 1))) ++ (if (and (eql x1 x2) (evenp linewidth)) ; correct for even-size lines ++ (if (> y2 y1) (setq x2delb 1) (setq x2dela 1))) ++ (window-draw-arc-xy w (- (- x2 ysth) x2dela) ++ (+ (+ y2 ycth) y2dela) size size ++ (+ 240 theta) 30 linewidth) ++ (window-draw-arc-xy w (- (+ x2 ysth) x2delb) ++ (+ (- y2 ycth) y2delb) size size ++ (+ 90 theta) 30 linewidth) )) ++ ++(defun window-draw-arrow-xy (w x1 y1 x2 y2 ++ &optional (linewidth 1) size) ++ (window-draw-line-xy w x1 y1 x2 y2 linewidth) ++ (window-draw-arrowhead-xy w x1 y1 x2 y2 linewidth size) ) ++ ++(defun window-draw-arrow2-xy (w x1 y1 x2 y2 ++ &optional (linewidth 1) size) ++ (window-draw-line-xy w x1 y1 x2 y2 linewidth) ++ (window-draw-arrowhead-xy w x1 y1 x2 y2 linewidth size) ++ (window-draw-arrowhead-xy w x2 y2 x1 y1 linewidth size) ) ++ ++; 08 Aug 91; 14 Aug 91; 12 Sep 91 ++(gldefun window-draw-box ++ ((w window) (offset vector) (size vector) &optional linewidth) ++ (window-draw-box-xy w (x offset) (y offset) (x size) (y size) linewidth) ) ++ ++; 08 Aug 91; 12 Sep 91; 11 Dec 91; 01 Sep 92; 02 Sep 92; 17 Jul 06 ++; New version avoids XDrawRectangle, which messes up when used with XOR. ++; was (XDrawRectangle *window-display* (parent w) (gcontext w) ++; offsetx (- qqwheight (offsety + sizey)) sizex sizey) ++(gldefun window-draw-box-xy ++ ((w window) (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer) &optional linewidth) ++ (let ((qqwheight (drawable-height w)) lw lw2 lw2b (pw (parent w)) ++ (gc (gcontext w))) ++ (if (linewidth and (linewidth <> 1)) (set-line-width w linewidth)) ++ (lw = (or linewidth 1)) ++ (lw2 = (truncate lw 2)) ++ (lw2b = (truncate (lw + 1) 2)) ++ (XdrawLine *window-display* pw gc ++ (- offsetx lw2) (- qqwheight offsety) ++ (- (+ offsetx sizex) lw2) (- qqwheight offsety)) ++ (XdrawLine *window-display* pw gc ++ (+ offsetx sizex) (- qqwheight (- offsety lw2b)) ++ (+ offsetx sizex) (- qqwheight (+ sizey (- offsety lw2b)))) ++ (XdrawLine *window-display* pw gc ++ (+ offsetx sizex lw2b) (- qqwheight (+ offsety sizey)) ++ (+ offsetx lw2b) (- qqwheight (+ offsety sizey))) ++ (XdrawLine *window-display* pw gc ++ offsetx (- qqwheight (+ offsety sizey lw2)) ++ offsetx (- qqwheight (+ offsety lw2)) ) ++ (if (linewidth and (linewidth <> 1)) (set-line-width w 1)) )) ++ ++; 26 Nov 91 ++(gldefun window-xor-box-xy ++ ((w window) (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer) ++ &optional linewidth) ++ (window-set-xor w) ++ (window-draw-box-xy w offsetx offsety sizex sizey linewidth) ++ (window-unset w)) ++ ++; 15 Aug 91; 12 Sep 91 ++; Draw a box whose corners are specified ++(gldefun window-draw-box-corners ((w window) (xa integer) (ya integer) ++ (xb integer) (yb integer) ++ &optional lw) ++ (draw-box-xy w (min xa xb) (min ya yb) (abs (- xa xb)) (abs (- ya yb)) lw) ) ++ ++; 13 Sep 91; 17 Jul 06 ++; Draw a box with round corners ++(gldefun window-draw-rcbox-xy ((w window) (x integer) (y integer) ++ (width integer) ++ (height integer) (radius integer) ++ &optional linewidth) ++ (let (x1 x2 y1 y2 r lw2 lw2b fudge) ++ (r = (max 0 (min radius (truncate (abs width) 2) ++ (truncate (abs height) 2)))) ++ (if (not (numberp linewidth)) (linewidth = 1)) ++ (lw2 = (truncate linewidth 2)) ++ (lw2b = (truncate (1+ linewidth) 2)) ++ (fudge = (if (oddp linewidth) 0 1)) ++ (x1 = x + r) ++ (x2 = x + width - r) ++ (y1 = y + r) ++ (y2 = y + height - r) ++ (draw-line-xy w (- (- x1 1) lw2) y x2 y linewidth) ; bottom ++ (draw-line-xy w (x + width) (- y1 lw2b) (x + width) (+ y2 1) ++ linewidth) ; right ++ (draw-line-xy w (- x1 1) (+ y height) (+ x2 lw2) (+ y height) linewidth) ++ (draw-line-xy w x y1 x (+ y2 1) linewidth) ; left ++ (draw-arc-xy w (- x1 fudge) y1 r r 180 90 linewidth) ++ (draw-arc-xy w x2 y1 r r 270 90 linewidth) ++ (draw-arc-xy w x2 (+ y2 fudge) r r 0 90 linewidth) ++ (draw-arc-xy w (- x1 fudge) (+ y2 fudge) r r 90 90 linewidth) )) ++ ++; 13 Aug 91; 15 Aug 91; 12 Sep 91 ++(gldefun window-draw-arc-xy ((w window) (x integer) (y integer) ++ (radiusx integer) (radiusy integer) ++ (anglea number) (angleb number) ++ &optional linewidth) ++ (if (linewidth and (linewidth <> 1)) (set-line-width w linewidth)) ++ (XdrawArc *window-display* (parent w) (gcontext w) ++ (x - radiusx) (positive-y w (y + radiusy)) ++ (radiusx * 2) (radiusy * 2) ++ (truncate (* anglea 64)) (truncate (* angleb 64))) ++ (if (linewidth and (linewidth <> 1)) (set-line-width w 1)) ) ++ ++; 08 Aug 91; 12 Sep 91 ++(gldefun window-draw-circle-xy ((w window) (x integer) (y integer) ++ (radius integer) ++ &optional linewidth) ++ (if (linewidth and (linewidth <> 1)) (set-line-width w linewidth)) ++ (XdrawArc *window-display* (parent w) (gcontext w) ++ (x - radius) (positive-y w (y + radius)) ++ (radius * 2) (radius * 2) 0 (* 360 64)) ++ (if (linewidth and (linewidth <> 1)) (set-line-width w 1)) ) ++ ++; 06 Aug 91; 14 Aug 91; 12 Sep 91 ++(gldefun window-draw-circle ((w window) (pos vector) (radius integer) ++ &optional linewidth) ++ (window-draw-circle-xy w (x pos) (y pos) radius linewidth) ) ++ ++; 08 Aug 91; 09 Sep 91 ++(gldefun window-erase-area ((w window) (offset vector) (size vector)) ++ (window-erase-area-xy w (x offset) (y offset) (x size) (y size))) ++ ++; 09 Sep 91; 11 Dec 91 ++(gldefun window-erase-area-xy ((w window) (xoff integer) (yoff integer) ++ (xsize integer) (ysize integer)) ++ (XClearArea *window-display* (parent w) ++ xoff (positive-y w (yoff + ysize - 1)) ++ xsize ysize ++ 0 )) ; exposures ++ ++; 21 Dec 93; 08 Sep 06 ++(gldefun window-erase-box-xy ((w window) (xoff integer) (yoff integer) ++ (xsize integer) (ysize integer) ++ &optional (linewidth integer)) ++ (XClearArea *window-display* (parent w) ++ (xoff - (truncate (or linewidth 1) 2)) ++ (positive-y w (+ yoff ysize (truncate (or linewidth 1) 2))) ++ (xsize + (or linewidth 1)) ++ (ysize + (or linewidth 1)) ++ 0 )) ; exposures ++ ++; 15 Aug 91; 12 Sep 91 ++(gldefun window-draw-ellipse-xy ((w window) (x integer) (y integer) ++ (rx integer) (ry integer) &optional lw) ++ (draw-arc-xy w x y rx ry 0 360 lw)) ++ ++; 09 Aug 91 ++(gldefun window-copy-area-xy ((w window) fromx (fromy integer) ++ tox (toy integer) width height) ++ (let ((qqwheight (drawable-height w))) ++ (set-copy w) ++ (XCopyArea *window-display* (parent w) (parent w) (gcontext w) ++ fromx (- qqwheight (+ fromy height)) ++ width height ++ tox (- qqwheight (+ toy height))) ++ (unset w) )) ++ ++; 07 Dec 90; 09 Aug 91; 12 Sep 91 ++(gldefun window-invertarea ((w window) (area region)) ++ (window-invert-area-xy w (left area) (bottom area) ++ (width area) (height area))) ++ ++; 07 Dec 90; 09 Aug 91; 12 Sep 91 ++(gldefun window-invert-area ((w window) (offset vector) (size vector)) ++ (window-invert-area-xy w (x offset) (y offset) (x size) (y size)) ) ++ ++; 12 Aug 91; 15 Aug 91; 13 Dec 91 ++(gldefun window-invert-area-xy ((w window) left (bottom integer) width height) ++ (set-invert w) ++ (XFillRectangle *window-display* (parent w) (gcontext w) ++ left (- (drawable-height w) (bottom + height - 1)) ++ width height) ++ (unset w) ) ++ ++; 05 Dec 90; 15 Aug 91 ++(gldefun window-prettyprintat ((w window) (s string) (pos vector)) ++ (printat w s pos) ) ++ ++(gldefun window-prettyprintat-xy ((w window) (s string) (x integer) ++ (y integer)) ++ (printat-xy w s x y)) ++ ++; 06 Aug 91; 08 Aug 91; 15 Aug 91 ++(gldefun window-printat ((w window) (s string) (pos vector)) ++ (printat-xy w s (x pos) (y pos)) ) ++ ++; 06 Aug 91; 08 Aug 91; 12 Aug 91 ++(gldefun window-printat-xy ((w window) (s string) (x integer) (y integer)) ++ (let ( (sstr (stringify s)) ) ++ (XdrawImageString *window-display* (parent w) (gcontext w) ++ x (- (drawable-height w) y) ++ (get-c-string sstr) (length sstr)) )) ++ ++; 19 Apr 95; 02 May 95; 17 May 04 ++; Print a string that may contain #\Newline characters in a window. ++(gldefun window-print-line ((w window) (str string) (x integer) (y integer) ++ &optional (deltay integer)) ++ (let ((lng (length str)) (n 0) end strb done) ++ (while ~done ++ (end = (position #\Newline str :test #'char= :start n)) ++ (strb = (subseq str n end)) ++ (printat-xy w strb x y) ++ (if (numberp end) ++ (n = (1+ end)) ++ (done = t)) ++ (y _- (or deltay 16)) ++ (if (y < 0) (done = t))) ++ (force-output w) )) ++ ++; 02 May 95; 08 May 95 ++; Print a list of strings in a window. ++(gldefun window-print-lines ((w window) (lines (listof string)) ++ (x integer) (y integer) ++ &optional (deltay integer)) ++ (for str in lines when (y > 0) (printat-xy w str x y) (y _- (or deltay 16))) ) ++ ++; 08 Aug 91 ++; Find the width of a string when printed in a given window ++(gldefun window-string-width ((w window) (s string)) ++ (let ((sstr (stringify s))) ++ (XTextWidth (font w) (get-c-string sstr) (length sstr)) )) ++ ++; 01 Dec 93 ++; Find the ascent and descent of a string when printed in a given window ++(gldefun window-string-extents ((w window) (s string)) ++ (let ((sstr (stringify s))) ++ (XTextExtents (font w) (get-c-string sstr) (length sstr) ++ *direction-return* *ascent-return* *descent-return* *overall-return*) ++ (list (int-pos *ascent-return* 0) ++ (int-pos *descent-return* 0)) )) ++ ++; Find the height (ascent + descent) of a string when printed in a given window ++(gldefun window-string-height ((w window) (s string)) ++ (let ((sstr (stringify s))) ++ (XTextExtents (font w) (get-c-string sstr) (length sstr) ++ *direction-return* *ascent-return* *descent-return* *overall-return*) ++ (+ (int-pos *ascent-return* 0) ++ (int-pos *descent-return* 0)) )) ++ ++; 15 Oct 91 ++(gldefun window-font-string-width (font (s string)) ++ (let ((sstr (stringify s))) ++ (XTextWidth font (get-c-string sstr) (length sstr)) )) ++ ++(gldefun window-yposition ((w window)) ++ (window-get-mouse-position) ++ (positive-y w (- *mouse-y* (top-neg-y w))) ) ++ ++(gldefun window-centeroffset ((w window) (v vector)) ++ (a vector with x = (truncate ((width w) - (x v)) 2) ++ y = (truncate ((height w) - (y v)) 2))) ++ ++; 18 Aug 89; 15 Aug 91 ++; Command to a window display manager ++(gldefun dowindowcom ((w window)) ++ (let (comm) ++ (comm = (select (window-menu)) ) ++ (case comm ++ (close (close w)) ++ (paint (paint w)) ++ (clear (clear w)) ++ (move (move w)) ++ (t (when comm ++ (princ "This command not implemented.") (terpri))) ) )) ++ ++(gldefun window-menu () ++ (result menu) ++ (or *window-menu* ++ (setq *window-menu* ++ (a menu with items = '(close paint clear move)))) ) ++ ++; 06 Dec 90; 11 Mar 93 ++(gldefun window-close ((w window)) ++ (unmap w) ++ (force-output w) ++ (window-wait-unmap w)) ++ ++(gldefun window-unmap ((w window)) ++ (XUnMapWindow *window-display* (parent w)) ) ++ ++; 06 Aug 91; 22 Aug 91 ++(gldefun window-open ((w window)) ++ (mapw w) ++ (force-output w) ++ (wait-exposure w) ) ++ ++(gldefun window-map ((w window)) ++ (XMapWindow *window-display* (parent w)) ) ++ ++; 08 Aug 91; 02 Sep 91 ++(gldefun window-destroy ((w window)) ++ (XDestroyWindow *window-display* (parent w)) ++ (force-output w) ++ ((parent w) = nil) ++ (XFreeGC *window-display* (gcontext w)) ++ ((gcontext w) = nil) ) ++ ++; 09 Sep 91 ++; Wait 3 seconds, then destroy the window where the mouse is. Use with care. ++(defun window-destroy-selected-window () ++ (prog (ww child) ++ (sleep 3) ++ (setq ww *root-window*) ++ lp (window-query-pointer-b ww) ++ (setq child (fixnum-pos *child-return* 0)) ; 22 Jun 06 ++ (if (> child 0) ++ (progn (setq ww child) (go lp))) ++ (if (/= ww *root-window*) ++ (progn (XDestroyWindow *window-display* ww) ++ (Xflush *window-display*))) )) ++ ++; 07 Aug 91 ++(gldefun window-clear ((w window)) ++ (XClearWindow *window-display* (parent w)) ++ (force-output w) ) ++ ++; 08 Aug 91 ++(gldefun window-moveto-xy ((w window) (x integer) (y integer)) ++ (XMoveWindow *window-display* (parent w) ++ x (- (window-screen-height) y)) ) ++ ++; 15 Aug 91; 05 Sep 91 ++; Paint in window with mouse: Left paints, Middle erases, Right quits. ++(defun window-paint (window) ++ (let (state) ++ (window-track-mouse window ++ #'(lambda (x y code) ++ (if (= code 1) (if (= state 1) (setq state 0) (setq state 1)) ++ (if (= code 2) (if (= state 2) (setq state 0) (setq state 2)))) ++ (if (= state 1) (window-draw-line-xy window x y x y 1 'paint) ++ (if (= state 2) (window-draw-line-xy window x y x y 1 'erase))) ++ (= code 3)) ) )) ++ ++; 15 Aug 91; 06 May 93 ++; Move a window. ++(gldefun window-move ((w window)) ++ (window-get-mouse-position) ++ (XMoveWindow *window-display* (parent w) ++ *mouse-x* (- (window-screen-height) *mouse-y*)) ) ++ ++; 15 Sep 93; 06 Jan 94 ++(gldefun window-draw-border ((w window)) ++ (draw-box-xy w 0 1 ((x (size w)) - 1) ((y (size w)) - 1)) ++ (force-output w) ) ++ ++; 13 Aug 91; 22 Aug 91; 27 Aug 91; 14 Oct 91 ++; Track the mouse within a window, calling function fn with args (x y event). ++; event is 0 = no button, 1 = left button, 2 = middle, 3 = right button. ++; Tracking continues until fn returns non-nil; result is that value. ++; Partly adapted from Hiep Nguyen's code. ++(defun window-track-mouse (w fn &optional outflg) ++ (let (win h) ++ (setq win (window-parent w)) ++ (setq h (window-drawable-height w)) ++ (Xsync *window-display* 1) ; clear event queue of prev motion events ++ (Xselectinput *window-display* win ++ (+ ButtonPressMask PointerMotionMask)) ++ ;; Event processing loop: stop when function returns non-nil. ++ (do ((res nil)) (res res) ++ (XNextEvent *window-display* *window-event*) ++ (let ((type (XAnyEvent-type *window-event*)) ++ (eventwindow (XAnyEvent-window *window-event*))) ++ (when (or (and (eql eventwindow win) ++ (or (eql type MotionNotify) ++ (eql type ButtonPress))) ++ (and outflg (eql type ButtonPress))) ++ (let ((x (XMotionEvent-x *window-event*)) ++ (y (XMotionEvent-y *window-event*)) ++ (code (if (eql type ButtonPress) ++ (XButtonEvent-button *window-event*) ++ 0))) ++ (setq res (if (eql eventwindow win) ++ (funcall fn x (- h y) code) ++ (funcall fn -1 -1 code))) ) ) ) ) )) ++ ++; 22 Aug 91; 23 Aug 91; 27 Aug 91; 04 Sep 92; 11 Mar 93 ++; Wait for a window to become exposed, but not more than 1 second. ++(defun window-wait-exposure (w) ++ (prog (win start-time max-time eventwindow type) ++ (setq win (window-parent w)) ++ (XGetWindowAttributes *window-display* win *window-attr*) ++ (unless (eql (XWindowAttributes-map_state *window-attr*) ++ ISUnmapped) ++ (return t)) ++ (setq start-time (get-internal-real-time)) ++ (setq max-time internal-time-units-per-second) ++ (Xselectinput *window-display* win (+ ExposureMask)) ++ ; Event processing loop: stop when exposure is seen or time out ++ lp (cond ((> (XPending *window-display*) 0) ++ (XNextEvent *window-display* *window-event*) ++ (setq type (XAnyEvent-type *window-event*)) ++ (setq eventwindow (XAnyEvent-window *window-event*)) ++ (if (and (eql eventwindow win) ++ (eql type Expose)) ++ (return t))) ++ ((> (- (get-internal-real-time) start-time) ++ max-time) ++ (return nil)) ) ++ (go lp) )) ++ ++; 11 Mar 93; 06 May 93 ++; Wait for a window to become unmapped, but not more than 1 second. ++(defun window-wait-unmap (w) ++ (prog (win start-time max-time) ++ (setq win (window-parent w)) ++ (setq start-time (get-internal-real-time)) ++ (setq max-time internal-time-units-per-second) ++lp (XGetWindowAttributes *window-display* win *window-attr*) ++ (if (eql (XWindowAttributes-map_state *window-attr*) ++ ISUnmapped) ++ (return t) ++ (if (> (- (get-internal-real-time) start-time) max-time) ++ (return nil))) ++ (go lp) )) ++ ++; 07 Oct 93 ++; Initialize to poll the mouse for a specified window ++(defun window-init-mouse-poll (w) ++ (let (win) ++ (setq win (window-parent w)) ++ (Xsync *window-display* 1) ; clear event queue of prev motion events ++ (Xselectinput *window-display* win ++ (+ ButtonPressMask PointerMotionMask)) )) ++ ++; 07 Oct 93 ++; Poll the mouse for a position change or button push ++; Returns nil if no mouse activity, ++; else (x y code), where x and y are positions, or nil if no movement, ++; and code is 0 if no button else button number ++(defun window-poll-mouse (w) ++ (let (win h eventtype eventwindow x y cd (code 0)) ++ (setq win (window-parent w)) ++ (setq h (window-drawable-height w)) ++ (while (> (XPending *window-display*) 0) ++ (XNextEvent *window-display* *window-event*) ++ (setq eventtype (XAnyEvent-type *window-event*)) ++ (setq eventwindow (XAnyEvent-window *window-event*)) ++ (if (eql eventwindow win) ++ (if (eql eventtype MotionNotify) ++ (progn (setq x (XMotionEvent-x *window-event*)) ++ (setq y (XMotionEvent-y *window-event*))) ++ (if (eql eventtype ButtonPress) ++ (if (> (setq cd (XButtonEvent-button *window-event*)) ++ 0) ++ (setq code cd))))) ) ++ (if (or x (> code 0)) (list x (if y (- h y)) code)) )) ++ ++; 14 Dec 90; 17 Dec 90; 13 Aug 91; 20 Aug 91; 30 Aug 91; 09 Sep 91; 11 Sep 91 ++; 15 Oct 91; 16 Oct 91; 10 Feb 92; 25 Sep 92; 26 Sep 92 ++; Initialize a menu ++(gldefun menu-init ((m menu)) ++ (let () ++ (or *window-display* (window-Xinit)) ; init windows if necessary ++ (calculate-size m) ++ (if ~ (flat m) ++ ((menu-window m) = (window-create (picture-width m) ++ (picture-height m) ++ ((title m) or "") ++ (parent-window m) ++ (parent-offset-x m) ++ (parent-offset-y m) ++ (menu-font m) )) ) )) ++ ++; 25 Sep 92; 26 Sep 92; 11 Mar 93; 05 Oct 93; 08 Oct 93; 17 May 04; 12 Jan 10 ++; Calculate the displayed size of a menu ++(gldefun menu-calculate-size ((m menu)) ++ (let (maxwidth totalheight nitems) ++ (or (menu-font m) ((menu-font m) = '9x15)) ++ (maxwidth = (find-item-width m (title m)) ++ + (if (or (flat m) *window-add-menu-title*) ++ 0 ++ *menu-title-pad*)) ++ (nitems = (if (and (title-present m) ++ (or (flat m) *window-add-menu-title*)) ++ 1 0)) ++ (totalheight = (* nitems 13)) ; ***** fix for font ++ (for item in (items m) do ++ (nitems _+ 1) ++ (maxwidth = (max maxwidth (find-item-width m item))) ++ (totalheight =+ (menu-find-item-height m item)) ) ++ ((item-width m) = maxwidth + 6) ++ ((picture-width m) = (item-width m) + 1) ++ ((picture-height m) = totalheight + 2) ++ (adjust-offset m) )) ++ ++; 06 Sep 91; 09 Sep 91; 10 Sep 91; 21 May 93; 30 May 02; 17 May 04; 08 Sep 06 ++; Adjust a menu's offset position if necessary to keep it in parent window. ++(gldefun menu-adjust-offset ((m menu)) ++ (let (xbase ybase wbase hbase xoff yoff wgm width height) ++ (width = (picture-width m)) ++ (height = (picture-height m)) ++ (if ~ (parent-window m) ++ (progn (window-get-mouse-position) ; put it where the mouse is ++ (wgm = t) ; set flag that we got mouse position ++ ((parent-window m) = *root-window*))) ; 21 May 93 was *mouse-window* ++ (window-get-geometry-b (parent-window m)) ++ (setq xbase (int-pos *x-return* 0)) ++ (setq ybase (int-pos *y-return* 0)) ++ (setq wbase (int-pos *width-return* 0)) ++ (setq hbase (int-pos *height-return* 0)) ++ (if (~ (parent-offset-x m) or (parent-offset-x m) == 0) ++ (progn (or wgm (window-get-mouse-position)) ++ (xoff = ((*mouse-x* - xbase) - (truncate width 2) - 4)) ++ (yoff = ((hbase - (*mouse-y* - ybase)) - (truncate height 2)))) ++ (progn (xoff = (parent-offset-x m)) ++ (yoff = (parent-offset-y m)))) ++ ((parent-offset-x m) = (max 0 (min xoff (wbase - width)))) ++ ((parent-offset-y m) = (max 0 (min yoff (hbase - height)))) )) ++ ++; 07 Dec 90; 14 Dec 90; 12 Aug 91; 22 Aug 91; 09 Sep 91; 10 Sep 91; 28 Jan 92; ++; 10 Feb 92; 26 Sep 92; 11 Mar 93; 08 Oct 93; 17 May 04; 12 Jan 10 ++(gldefun menu-draw ((m menu)) ++ (let (mw xzero yzero bottom) ++ (init? m) ++ (xzero = (menu-x m 0)) ++ (yzero = (menu-y m 0)) ++ (mw = (menu-window m)) ++ (open mw) ++ (clear m) ++ (if (flat m) (draw-box-xy mw (xzero - 1) yzero ((picture-width m) + 2) ++ ((picture-height m) + 1) 1)) ++ (bottom = (yzero + (picture-height m) + 3)) ++ (if (and (title-present m) ++ (or (flat m) *window-add-menu-title*)) ++ (progn (bottom _- 15) ; ***** fix for font ++ (printat-xy mw (stringify (title m)) (+ xzero 3) bottom) ++ (invert-area-xy mw xzero (bottom - 2) ++ ((picture-width m) + 1) 15))) ++ (for item in (items m) do ++ (bottom _- (menu-find-item-height m item)) ++ (display-item m item (+ xzero 3) bottom) ) ++ (force-output mw) )) ++ ++; 17 May 04 ++(gldefun menu-item-value (self item) ++ (if (consp item) (cdr item) item)) ++ ++; 06 Sep 91; 11 Sep 91; 15 Oct 91; 16 Oct 91; 23 Oct 91; 17 May 04 ++(gldefun menu-find-item-width ((self menu) item) ++ (let ((tmp vector)) ++ (if (and (consp item) ++ (symbolp (car item)) ++ (fboundp (car item))) ++ (or (and (tmp = (get (car item) 'display-size)) ++ (x tmp)) ++ 40) ++ (window-font-string-width ++ (or (and (flat self) ++ (menu-window self) ++ (font (menu-window self))) ++ (window-font-info (menu-font self))) ++ (stringify (if (consp item) (car item) item)))) )) ++ ++ ++; 09 Sep 91; 10 Sep 91; 11 Sep 91; 17 mAY 04 ++(gldefun menu-find-item-height ((self menu) item) ; ***** fix for font ++ (let ((tmp vector)) ++ (if (and (consp item) ++ (symbolp (car item)) ++ (tmp = (get (car item) 'display-size))) ++ ((y tmp) + 3) ++ 15) )) ++ ++; 09 Sep 91; 10 Sep 91; 10 Feb 92; 17 May 04 ++(gldefun menu-clear ((m menu)) ++ (if (flat m) ++ (erase-area-xy (menu-window m) ((base-x m) - 1) ((base-y m) - 1) ++ ((picture-width m) + 3) ((picture-height m) + 3)) ++ (clear (menu-window m))) ) ++ ++; 06 Sep 91; 04 Dec 91; 17 May 04 ++(gldefun menu-display-item ((self menu) item x y) ++ (let ((mw (menu-window self))) ++ (if (consp item) ++ (if (and (symbolp (car item)) ++ (fboundp (car item))) ++ (funcall (car item) mw x y) ++ (if (or (stringp (car item)) (symbolp (car item)) ++ (numberp (car item))) ++ (printat-xy mw (car item) x y) ++ (printat-xy mw (stringify item) x y))) ++ (printat-xy mw (stringify item) x y)) )) ++ ++; 07 Dec 90; 18 Dec 90; 15 Aug 91; 27 Aug 91; 06 Sep 91; 10 Sep 91; 29 Sep 92 ++; 04 Aug 93; 07 Jan 94; 17 May 04; 18 May 04; 12 Jan 10; 13 Jan 10 ++(gldefun menu-choose ((m menu) (inside boolean)) ++ (let (mw current-item ybase itemh val maxx maxy xzero yzero) ++ (init? m) ++ (mw = (menu-window m)) ++ (draw m) ++ (xzero = (menu-x m 0)) ++ (yzero = (menu-y m 0)) ++ (maxx = (+ xzero (picture-width m))) ++ (maxy = (+ yzero (picture-height m))) ++ (if (and (title-present m) ++ (or (flat m) *window-add-menu-title*)) ++ (maxy =- 15)) ++ (track-mouse mw ++ #'(lambda (x y code) ++ (setq *window-menu-code* code) ++ (if (and (>= x xzero) (<= x maxx) ; is mouse in menu area? ++ (>= y yzero) (<= y maxy)) ++ (if (or (null current-item) ; is mouse in a new item? ++ (< y ybase) ++ (> y (+ ybase itemh)) ) ++ (progn ++ (if current-item ++ (unbox-item m current-item ybase)) ++ (current-item = (menu-find-item-y m (- y yzero))) ++ (if current-item ++ (progn (ybase = (menu-item-y m current-item)) ++ (itemh = (menu-find-item-height ++ m current-item)) ++ (box-item m current-item ybase) ++ (inside = t))) ++ (if (> code 0) ; same item: click? ++ (progn (unbox-item m current-item ybase) ++ (val = 1)))) ++ (if (> code 0) ; same item: click? ++ (progn (unbox-item m current-item ybase) ++ (val = 1)))) ++ (progn (if current-item ; mouse outside area ++ (progn (unbox-item m current-item ybase) ++ (current-item = nil))) ++ (if (or (> code 0) ++ (and inside ++ (or (< x xzero) (> x maxx) ++ (< y yzero) (> y maxy)))) ++ (val = -777))))) ++ t) ++ (if (not (eql val -777)) (item-value m current-item)) )) ++ ++; 07 Dec 90; 12 Aug 91; 10 Sep 91; 05 Oct 92; 12 Jan 10 ++(gldefun menu-box-item ((m menu) (item menu-item) (ybase integer)) ++ (let ( (mw (menuw m)) ) ++ (set-xor mw) ++ (draw-box-xy mw (menu-x m 1) ((menu-y m ybase) + 2) ++ ((item-width m) - 2) ++ (menu-find-item-height m item) ++ 1) ++ (unset mw) )) ++ ++; 07 Dec 90; 12 Aug 91; 14 Aug 91; 15 Aug 91; 05 Oct 92; 12 Jan 10 ++(gldefun menu-unbox-item ((m menu) (item menu-item) (ybase integer)) ++ (box-item m item ybase) ) ++ ++; 11 Sep 91; 08 Sep 92; 28 Sep 92; 18 Jan 94; 08 Sep 06; 12 Jan 10; 13 Jan 10 ++(gldefun menu-item-position ((m menu) (itemname symbol) ++ &optional (place symbol)) ++ (let ( (xsize (item-width m)) ybase item ysize) ++ (item = (menu-find-item m itemname)) ++ (ysize = (menu-find-item-height m item)) ++ (ybase = (menu-item-y m item)) ++ (a vector with ++ x = ((menu-x m 0) + ++ (case place ++ ((center top bottom) (truncate xsize 2)) ++ (left -1) ++ (right xsize + 2) ++ else 0)) ++ y = ((menu-y m ybase) + ++ (case place ++ ((center right left) (truncate ysize 2)) ++ (bottom 0) ++ (top ysize) ++ else 0)) ) )) ++ ++; 13 Jan 10 ++; find the y position of bottom of item with given name ++(gldefun menu-find-item ((m menu) (itemname symbol)) ++ (let (found itms item) ++ (itms = (items m)) ++ (found = (null itemname)) ++ (while (and itms (not found)) ++ (item -_ itms) ++ (if (or (eq item itemname) ++ (and (consp item) ++ (or (eq itemname (car item)) ++ (and (stringp (car item)) ++ (string= (stringify itemname) (car item))) ++ (eq (cdr item) itemname) ++ (and (consp (cdr item)) ++ (eq (cadr item) itemname))))) ++ (found = t))) ++ item)) ++ ++; 12 Jan 10 ++; find the y position of bottom of a given item ++(gldefun menu-item-y ((m menu) (item menu-item)) ++ (let (found itms itm ybase) ++ (ybase = (picture-height m) - 1) ++ (if (and (title-present m) ++ (or (flat m) *window-add-menu-title*)) ++ (ybase =- 15)) ++ (itms = (items m)) ++ (while (and itms (not found)) ++ (itm -_ itms) ++ (ybase =- (menu-find-item-height m itm)) ++ (found = (eq item itm)) ) ++ ybase)) ++ ++; 12 Jan 10 ++; find item based on y position ++(gldefun menu-find-item-y ((m menu) (y integer)) ++ (let (found itms itm ybase) ++ (ybase = (picture-height m) - 1) ++ (if (and (title-present m) ++ (or (flat m) *window-add-menu-title*)) ++ (ybase =- 15)) ++ (itms = (items m)) ++ (while (and itms (not found)) ++ (itm -_ itms) ++ (ybase =- (menu-find-item-height m itm)) ++ (found = (and (>= y ybase) ++ (<= y (+ ybase (menu-find-item-height m itm)))))) ++ (and found itm))) ++ ++; 10 Dec 90; 13 Dec 90; 10 Sep 91; 29 Sep 92; 17 May 04 ++; Choose from menu, then close it ++(gldefun menu-select ((m menu) &optional inside) (menu-select-b m nil inside)) ++(gldefun menu-select! ((m menu)) (menu-select-b m t nil)) ++(gldefun menu-select-b ((m menu) (flg boolean) (inside boolean)) ++ (prog (res) ++lp (res = (choose m inside)) ++ (if (flg and ~res) (go lp)) ++ (if ~(permanent m) ++ (if (flat m) ++ (progn (clear m) ++ (force-output (menu-window m))) ++ (close (menu-window m)))) ++ (return res))) ++ ++; 12 Aug 91; 17 May 04 ++(gldefun menu-destroy ((m menu)) ++ (if ~ (flat m) ++ (progn (destroy (menu-window m)) ++ ((menu-window m) = nil) ))) ++ ++; 19 Aug 91; 02 Sep 91 ++; Easy interface to make a menu, select from it, and destroy it. ++(defun menu (items &optional title) ++ (let (m res) ++ (setq m (menu-create items title)) ++ (setq res (menu-select m)) ++ (menu-destroy m) ++ res )) ++ ++; 12 Aug 91; 15 Aug 91; 06 Sep 91; 09 Sep 91; 12 Sep 91; 23 Oct 91; 17 May 04 ++; Simple call from plain Lisp to make a menu. ++(setf (glfnresulttype 'menu-create) 'menu) ++(gldefun menu-create (items &optional title (parentw window) x y ++ (perm boolean) (flat boolean) (font symbol)) ++ (a menu with title = (if title (stringify title) "") ++ menu-window = (if flat parentw) ++ items = items ++ parent-window = (parent parentw) ++ parent-offset-x = x ++ parent-offset-y = y ++ permanent = perm ++ flat = flat ++ menu-font = font )) ++ ++; 15 Oct 91; 30 Oct 91 ++(gldefun menu-offset ((m menu)) ++ (result vector) ++ (a vector with x = (base-x m) y = (base-y m))) ++ ++; 15 Oct 91; 30 Oct 91; 25 Sep 92; 29 Sep 92; 18 Apr 95; 25 Jul 96 ++(gldefun menu-size ((m menu)) ++ (result vector) ++ (if ((picture-width m) <= 0) ++ (case (first m) ++ (picmenu (picmenu-calculate-size m)) ++ (barmenu (barmenu-calculate-size m)) ++ (textmenu (textmenu-calculate-size m)) ++ (editmenu (editmenu-calculate-size m)) ++ (t (menu-calculate-size m)))) ++ (a vector with x = (picture-width m) y = (picture-height m)) ) ++ ++; 15 Oct 91; 17 May 04 ++(gldefun menu-moveto-xy ((m menu) (x integer) (y integer)) ++ (if (flat m) ++ (progn ((parent-offset-x m) = x) ++ ((parent-offset-y m) = y) ++ (adjust-offset m)) )) ++ ++; 27 Nov 92; 17 May 04 ++; Reposition a menu to a position specified by the user by mouse click ++(gldefun menu-reposition ((m menu)) ++ (let (sizev pos) ++ (if (flat m) ++ (progn (sizev = (size m)) ++ (pos = (get-box-position (menu-window m) (x sizev) (y sizev))) ++ (moveto-xy m (x pos) (y pos)) ) ))) ++ ++; 31 Aug 09 ++; Reposition a menu to a position specified by the user by mouse click ++(gldefun menu-reposition-line ((m menu) (offset vector) (target vector)) ++ (let (sizev pos) ++ (if (flat m) ++ (progn (sizev = (size m)) ++ (pos = (get-box-line-position (menu-window m) ++ (x sizev) (y sizev) (x offset) (y offset) ++ (x target) (y target))) ++ (moveto-xy m (x pos) (y pos)) ) ))) ++ ++; 09 Sep 91; 11 Sep 91; 12 Sep 91; 14 Sep 91 ++; Simple call from plain Lisp to make a picture menu. ++(setf (glfnresulttype 'picmenu-create) 'picmenu) ++(gldefun picmenu-create ++ (buttons (width integer) (height integer) drawfn ++ &optional title (dotflg boolean) (parentw window) x y (perm boolean) ++ (flat boolean) (font symbol) (boxflg boolean)) ++ (picmenu-create-from-spec ++ (picmenu-create-spec buttons width height drawfn dotflg font) ++ title parentw x y perm flat boxflg)) ++ ++; 14 Sep 91 ++(setf (glfnresulttype 'picmenu-create-spec) 'picmenu-spec) ++(gldefun picmenu-create-spec (buttons (width integer) (height integer) drawfn ++ &optional (dotflg boolean) (font symbol)) ++ (a picmenu-spec with drawing-width = width ++ drawing-height = height ++ buttons = buttons ++ dotflg = dotflg ++ drawfn = drawfn ++ menu-font = (font or '9x15))) ++ ++; 14 Sep 91; 17 May 04 ++(setf (glfnresulttype 'picmenu-create-from-spec) 'picmenu) ++(gldefun picmenu-create-from-spec ++ ((spec picmenu-spec) &optional title (parentw window) x y ++ (perm boolean) (flat boolean) (boxflg boolean)) ++ (a picmenu with title = (if title (stringify title) "") ++ menu-window = (if flat parentw) ++ parent-window = (if parentw (parent parentw)) ++ parent-offset-x = x ++ parent-offset-y = y ++ permanent = perm ++ flat = flat ++ spec = spec ++ boxflg = boxflg ++)) ++ ++; 29 Sep 92; 13 Oct 93; 17 May 04 ++(gldefun picmenu-calculate-size ((m picmenu)) ++ (let (maxwidth maxheight) ++ (maxwidth = (max (if (title m) ((* 9 (length (title m))) + 6) ++ 0) ++ (drawing-width m))) ++ (maxheight = (if (and (title-present m) ++ (or (flat m) *window-add-menu-title*)) ++ 15 0) ++ + (drawing-height m)) ++ ((picture-width m) = maxwidth) ++ ((picture-height m) = maxheight) )) ++ ++; 09 Sep 91; 10 Sep 91; 29 Sep 92 ++; Initialize a picture menu ++(gldefun picmenu-init ((m picmenu)) ++ (let () ++ (calculate-size m) ++ (adjust-offset m) ++ (if ~ (flat m) ++ ((menu-window m) = (window-create (picture-width m) ++ (picture-height m) ++ ((title m) or "") ++ (parent-window m) ++ (parent-offset-x m) ++ (parent-offset-y m) ++ (menu-font m) )) ) )) ++ ++; 09 Sep 91; 10 Sep 91; 11 Sep 91; 10 Feb 92; 05 Oct 92; 30 Oct 92; 13 Oct 93 ++; 17 May 04 ++; Draw a picture menu ++(gldefun picmenu-draw ((m picmenu)) ++ (let (mw bottom xzero yzero) ++ (init? m) ++ (mw = (menu-window m)) ++ (open mw) ++ (clear m) ++ (xzero = (menu-x m 0)) ++ (yzero = (menu-y m 0)) ++ (bottom = yzero + (picture-height m)) ++ (if (and (title-present m) ++ (or (flat m) *window-add-menu-title*)) ++ (progn (printat-xy mw (stringify (title m)) (xzero + 3) (bottom - 13)) ++ (invert-area-xy mw xzero (bottom - 15) (picture-width m) 16))) ++ (funcall (drawfn m) mw xzero yzero) ++ (if (boxflg m) (draw-box-xy mw xzero yzero ++ (picture-width m) (picture-height m) 1)) ++ (if (dotflg m) ++ (for b in (buttons m) do (draw-button m b)) ) ++ ((deleted-buttons m) = nil) ++ (force-output mw) )) ++ ++; 28 Oct 09 ++(gldefun picmenu-draw-named-button ((m picmenu) (nm symbol)) ++ (draw-button m (assoc nm (buttons m)))) ++ ++; 28 Oct 09 ++(gldefun picmenu-set-named-button-color ((m picmenu) (nm symbol) (color rgb)) ++ (let (lst) ++ (if (lst = (assoc nm (button-colors m))) ++ ((color lst) = color) ++ ((button-colors m) +_ (list nm color)) ) )) ++ ++; 05 Oct 92; 28 Oct 09 ++(gldefun picmenu-draw-button ((m picmenu) (b picmenu-button)) ++ (let ((mw (menu-window m)) col) ++ (set-invert mw) ++ (draw-box-xy mw ((menu-x m 0) + (x (offset b)) - 2) ++ ((menu-y m 0) + (y (offset b)) - 2) ++ 4 4 1) ++ (unset mw) ++ (if (setq col (assoc (buttonname b) (button-colors m))) ++ (progn (window-set-color-rgb mw (red (color col)) (green (color col)) ++ (blue (color col))) ++ (draw-box-xy mw ((menu-x m 0) + (x (offset b)) - 1) ++ ((menu-y m 0) + (y (offset b)) - 1) ++ 3 3 2) ++ (window-reset-color mw)) ) )) ++ ++; 05 Oct 92; 30 Oct 92; 17 May 04 ++; Delete a button and erase it from the display ++(gldefun picmenu-delete-named-button ((m picmenu) (name symbol)) ++ (let (b) ++ (if (and (b = (assoc name (buttons m))) ++ ~ (name <= (deleted-buttons m))) ++ (progn (if (dotflg m) (draw-button m b)) ++ ((deleted-buttons m) +_ name) )) ++ (force-output (menu-window m)) )) ++ ++; 09 Sep 91; 10 Sep 91; 18 Sep 91; 29 Sep 92; 26 Oct 92; 30 Oct 92; 06 May 93 ++; 04 Aug 93; 07 Jan 94; 30 May 02; 17 May 04; 18 May 04; 01 Jun 04; 24 Jan 06 ++; inside = t if the mouse is already inside the menu area ++; anyclick = value to return for a mouse click that is not on a button. ++(gldefun picmenu-select ((m picmenu) &optional inside anyclick) ++ (let (mw (current-button picmenu-button) item items (val picmenu-button) ++ xzero yzero codeval) ++ (mw = (menuw m)) ++ (if ~ (permanent m) (draw m)) ++ (xzero = (menu-x m 0)) ++ (yzero = (menu-y m 0)) ++ (track-mouse mw ++ #'(lambda (x y code) ++ (setq *window-menu-code* code) ++ (x = (x - xzero)) ++ (y = (y - yzero)) ++ (if ((x >= 0) and (x <= (picture-width m)) ++ and (y >= 0) and (y <= (picture-height m))) ++ (inside = t)) ++ (if current-button ++ (if ~ (containsxy? current-button x y) ++ (progn (unbox-item m current-button) ++ (current-button = nil)))) ++ (if ~ current-button ++ (progn (items = (buttons m)) ++ (while ~ current-button and (item -_ items) do ++ (if (and (containsxy? item x y) ++ (not ((buttonname item) <= ++ (deleted-buttons m)))) ++ (progn (box-item m item) ++ (current-button = item)))))) ++ (if (or (> code 0) ++ (and inside (or (x < 0) (x > (picture-width m)) ++ (y < 0) (y > (picture-height m))))) ++ (progn (if current-button (unbox-item m current-button)) ++ (codeval = code) ++ (val = (if (and (> code 0) current-button) ++ current-button ++ *picmenu-no-selection*)) ))) ++ t) ++ (if ~(permanent m) ++ (if (flat m) (progn (clear m) ++ (force-output (menu-window m))) ++ (close (menu-window m)))) ++ (if (val == *picmenu-no-selection*) ++ (and (> codeval 0) anyclick) ++ (buttonname val)) )) ++ ++ ++; 09 Sep 91; 10 Sep 91; 17 May 04; 08 Sep 06 ++(gldefun picmenu-box-item ((m picmenu) (item picmenu-button)) ++ (let ((mw (menuw m)) xoff yoff siz) ++ (xoff = (menu-x m (x (offset item)))) ++ (yoff = (menu-y m (y (offset item)))) ++ (if (highlightfn item) ++ (funcall (highlightfn item) (menuw m) xoff yoff) ++ (progn (set-xor mw) ++ (if (siz = (size item)) ++ (draw-box-xy mw (xoff - (truncate (x siz) 2)) ++ (yoff - (truncate (y siz) 2)) ++ (x siz) (y siz) 1) ++ (draw-box-xy mw (xoff - 6) (yoff - 6) 12 12 1)) ++ (unset mw) ++ (force-output mw) ) ))) ++ ++; 09 Sep 91; 06 May 93; 17 May 04 ++(gldefun picmenu-unbox-item ((m picmenu) (item picmenu-button)) ++ (let ((mw (menuw m))) ++ (if (unhighlightfn item) ++ (progn (funcall (unhighlightfn item) (menuw m) ++ (x (offset item)) (y (offset item))) ++ (force-output mw)) ++ (box-item m item) ) )) ++ ++(defun picmenu-destroy (m) (menu-destroy m)) ++ ++; 09 Sep 91; 10 Sep 91; 11 Sep 91; 08 Sep 06 ++(gldefun picmenu-button-containsxy? ((b picmenu-button) (x integer) ++ (y integer)) ++ (let ((xsize 6) (ysize 6)) ++ (if (size b) (progn (xsize = (truncate (x (size b)) 2)) ++ (ysize = (truncate (y (size b)) 2)))) ++ ((x >= ((x (offset b)) - xsize)) and (x <= ((x (offset b)) + xsize)) and ++ (y >= ((y (offset b)) - ysize)) and (y <= ((y (offset b)) + ysize)) ) )) ++ ++; 11 Sep 91; 08 Sep 92; 18 Jan 94; 30 May 02; 17 May 04; 24 Jan 06; 08 Sep 06 ++(gldefun picmenu-item-position ((m picmenu) (itemname symbol) ++ &optional (place symbol)) ++ (let ((b picmenu-button) (xsize 0) (ysize 0) xoff yoff) ++ (if (null itemname) ++ (progn (xsize = (picture-width m)) ++ (ysize = (truncate ((picture-height m) - (drawing-height m)) 2)) ++ (xoff = (truncate xsize 2)) ++ (yoff = (drawing-height m) + (truncate ysize 2))) ++ (if (b = (that (buttons m) with buttonname == itemname)) ++ (progn (if (size b) ++ (progn (xsize = (x (size b))) ++ (ysize = (y (size b))))) ++ (xoff = (x (offset b))) ++ (yoff = (y (offset b))) ) )) ++ (if xoff (a vector with ++ x = ((menu-x m xoff) + (case place ++ ((center top bottom) 0) ++ (left (- (truncate xsize 2))) ++ (right (truncate xsize 2)) ++ else 0)) ++ y = ((menu-y m yoff) + (case place ++ ((center right left) 0) ++ (bottom (- (truncate ysize 2))) ++ (top (truncate ysize 2)) ++ else 0))) ) )) ++ ++; 03 Jan 94; 18 Jan 94; 17 May 04 ++; Simple call from plain Lisp to make a picture menu. ++(setf (glfnresulttype 'barmenu-create) 'barmenu) ++(gldefun barmenu-create ++ ((maxval integer) (initval integer) (barwidth integer) ++ &optional title (horizontal boolean) subtrackfn subtrackparms ++ (parentw window) x y (perm boolean) (flat boolean) (color rgb)) ++ (a barmenu with title = (if title (stringify title) "") ++ menu-window = (if flat parentw) ++ parent-window = (if parentw (parent parentw)) ++ parent-offset-x = (or x 0) ++ parent-offset-y = (or y 0) ++ permanent = perm ++ flat = flat ++ value = initval ++ maxval = maxval ++ barwidth = barwidth ++ horizontal = horizontal ++ subtrackfn = subtrackfn ++ subtrackparms = subtrackparms ++ color = color) ) ++ ++; 03 Jan 94; 17 May 04 ++(gldefun barmenu-calculate-size ((m barmenu)) ++ (let (maxwidth maxheight) ++ (maxwidth = (max (if (title m) ((* 9 (length (title m))) + 6) ++ 0) ++ (barwidth m))) ++ (maxheight = (if (and (title-present m) ++ (or (flat m) *window-add-menu-title*)) ++ 15 0) ++ + (maxval m)) ++ ((picture-width m) = maxwidth) ++ ((picture-height m) = maxheight) )) ++ ++; 03 Jan 94 ++; Initialize a picture menu ++(gldefun barmenu-init ((m barmenu)) ++ (let () ++ (calculate-size m) ++ (adjust-offset m) ++ (if ~ (flat m) ++ ((menu-window m) = (window-create (picture-width m) ++ (picture-height m) ++ ((title m) or "") ++ (parent-window m) ++ (parent-offset-x m) ++ (parent-offset-y m) )) ) )) ++ ++; 03 Jan 94; 18 Jan 94; 17 May 04; 18 May 04; 08 Sep 06 ++; Draw a picture menu ++(gldefun barmenu-draw ((m barmenu)) ++ (let (mw xzero yzero) ++ (init? m) ++ (mw = (menu-window m)) ++ (open mw) ++ (clear m) ++ (xzero = (menu-x m (truncate (picture-width m) 2))) ++ (yzero = (menu-y m 0)) ++ (if (color m) (window-set-color mw (color m))) ++ (if (horizontal m) ++ (draw-line-xy (menu-window m) xzero yzero ++ (xzero + (value m)) yzero (barwidth m)) ++ (draw-line-xy (menu-window m) xzero yzero ++ xzero (+ yzero (value m)) (barwidth m)) ) ++ (if (color m) (window-reset-color mw)) ++ (force-output mw) )) ++ ++; 03 Jan 94; 04 Jan 94; 07 Jan 94; 18 Jan 94; 08 Sep 06 ++; inside = t if the mouse is already inside the menu area ++(gldefun barmenu-select ((m barmenu) &optional inside) ++ (let (mw xzero yzero val) ++ (mw = (menuw m)) ++ (if ~ (permanent m) (draw m)) ++ (xzero = (menu-x m (truncate (picture-width m) 2))) ++ (yzero = (menu-y m 0)) ++ (when (window-track-mouse-in-region mw (menu-x m 0) yzero ++ (picture-width m) (picture-height m) t t) ++ (track-mouse mw ++ #'(lambda (x y code) ++ (setq *window-menu-code* code) ++ (val = (if (horizontal m) (x - xzero) (y - yzero))) ++ (update-value m val) ++ (if (> code 0) code) )) ++ val) )) ++ ++; 03 Jan 93; 17 May 04; 08 Sep 06 ++(defvar *barmenu-update-value-cons* (cons nil nil)) ; reusable cons ++(gldefun barmenu-update-value ((m barmenu) (val integer)) ++ (let ((mw (menuw m)) xzero yzero) ++ (val = (max 0 (min val (maxval m)))) ++ (if (val <> (value m)) ++ (progn (if (val < (value m)) ++ (set-erase mw) ++ (if (color m) (window-set-color mw (color m)))) ++ (xzero = (menu-x m (truncate (picture-width m) 2))) ++ (yzero = (menu-y m 0)) ++ (if (horizontal m) ++ (draw-line-xy (menu-window m) ++ (+ xzero (value m)) yzero ++ (+ xzero val) yzero (barwidth m)) ++ (draw-line-xy (menu-window m) ++ xzero (+ yzero (value m)) ++ xzero (+ yzero val) (barwidth m)) ) ++ (if (val < (value m)) ++ (unset mw) ++ (if (color m) (window-reset-color mw)) ) ++ ((value m) = val) ++ (if (subtrackfn m) ++ (progn ((car *barmenu-update-value-cons*) = val) ++ ((cdr *barmenu-update-value-cons*) = (subtrackparms m)) ++ (apply (subtrackfn m) *barmenu-update-value-cons*))) ++ (force-output mw) ) ))) ++ ++; Functions for text input "menus". Derived from picmenu code. ++; Making text input analogous to menus allows use with menu-sets. ++ ++; 18 Apr 95; 17 May 04 ++; (setq tm (textmenu-create 200 30 nil myw 50 50 t t '9x15 t "Rutabagas")) ++; Simple call from plain Lisp to make a text menu. ++(setf (glfnresulttype 'textmenu-create) 'textmenu) ++(gldefun textmenu-create ((width integer) (height integer) ++ &optional title (parentw window) x y ++ (perm boolean) (flat boolean) ++ (font symbol) (boxflg boolean) ++ (initial-text string)) ++ (a textmenu with title = (if title (stringify title) "") ++ menu-window = (if flat parentw) ++ parent-window = (if parentw (parent parentw)) ++ parent-offset-x = (or x 0) ++ parent-offset-y = (or y 0) ++ permanent = perm ++ flat = flat ++ drawing-width = width ++ drawing-height = height ++ menu-font = (font or '9x15) ++ boxflg = boxflg ++ text = initial-text) ) ++ ++; 18 Apr 95; 17 May 04 ++(gldefun textmenu-calculate-size ((m textmenu)) ++ (let (maxwidth maxheight) ++ (maxwidth = (max (if (title m) ((* 9 (length (title m))) + 6) ++ 0) ++ (drawing-width m))) ++ (maxheight = (if (and (title-present m) ++ (or (flat m) *window-add-menu-title*)) ++ 15 0) ++ + (drawing-height m)) ++ ((picture-width m) = maxwidth) ++ ((picture-height m) = maxheight) )) ++ ++; 18 Apr 95 ++; Initialize a picture menu ++(gldefun textmenu-init ((m textmenu)) ++ (let () ++ (calculate-size m) ++ (adjust-offset m) ++ (if ~ (flat m) ++ ((menu-window m) = ++ (window-create (picture-width m) (picture-height m) ++ ((title m) or "") (parent-window m) ++ (parent-offset-x m) (parent-offset-y m) ++ (menu-font m) )) ) )) ++ ++; 18 Apr 95; 14 Aug 96; 17 May 04; 08 Sep 06 ++; Draw a picture menu ++(gldefun textmenu-draw ((m textmenu)) ++ (let (mw bottom xzero yzero) ++ (init? m) ++ (mw = (menu-window m)) ++ (open mw) ++ (clear m) ++ (xzero = (menu-x m 0)) ++ (yzero = (menu-y m 0)) ++ (bottom = yzero + (picture-height m)) ++ (if (and (title-present m) ++ (or (flat m) *window-add-menu-title*)) ++ (progn (printat-xy mw (stringify (title m)) (xzero + 3) (bottom - 13)) ++ (invert-area-xy mw xzero (bottom - 15) (picture-width m) 16))) ++ (if (text m) ++ (printat-xy mw (text m) (xzero + 10) ++ (yzero + (truncate (picture-height m) 2) - 8))) ++ (if (boxflg m) (draw-box-xy mw xzero yzero ++ (picture-width m) (picture-height m) 1)) ++ (force-output mw) )) ++ ++; 18 Apr 95; 20 Apr 95; 21 Apr 95; 14 Aug 96; 17 May 04; 01 Jun 04; 08 Sep 06 ++(gldefun textmenu-select ((m textmenu) &optional inside) ++ (let (mw xzero yzero codeval res) ++ (mw = (menuw m)) ++ (if ~ (permanent m) (draw m)) ++ (xzero = (menu-x m 0)) ++ (yzero = (menu-y m 0)) ++ (track-mouse mw ++ #'(lambda (x y code) ++ (setq *window-menu-code* code) ++ (x = (x - xzero)) ++ (y = (y - yzero)) ++ (if (or (> code 0) ++ (or (x < 0) (x > (picture-width m)) ++ (y < 0) (y > (picture-height m)))) ++ (codeval = code)) ) ++ t) ++ (if (and (not (permanent m)) (not (flat m))) ++ (close (menu-window m))) ++ (if (codeval > 0) ++ (progn (draw m) ++ (input-string mw (text m) (xzero + 10) ++ (yzero + (truncate (picture-height m) 2) - 8) ++ ((picture-width m) - 12)) ) ))) ++ ++(gldefun textmenu-set-text ((m textmenu) &optional (s string)) ++ ((text m) = (or s ""))) ++ ++; 15 Aug 91 ++; Get a point position by mouse click. Returns (x y). ++(setf (glfnresulttype 'window-get-point) 'vector) ++(defun window-get-point (w) ++ (let (orgx orgy) ++ (window-track-mouse w ; get one point ++ #'(lambda (x y code) ++ (when (not (zerop code)) ++ (setq orgx x) ++ (setq orgy y)))) ++ (list orgx orgy) )) ++ ++; 23 Aug 91 ++; Get a point position by mouse click. Returns (button (x y)). ++(setf (glfnresulttype 'window-get-click) ++ '(list (button integer) (pos vector))) ++(defun window-get-click (w) ++ (let (orgx orgy button) ++ (window-track-mouse w ; get one point ++ #'(lambda (x y code) ++ (when (not (zerop code)) ++ (setq button code) ++ (setq orgx x) ++ (setq orgy y)))) ++ (list button (list orgx orgy)) )) ++ ++; 13 Aug 91; 06 Aug 91 ++; Get a position indicated by a line from a specified origin position. ++; Returns (x y) at end of line. ++(setf (glfnresulttype 'window-get-line-position) 'vector) ++(defun window-get-line-position (w orgx orgy) ++ (window-get-icon-position w #'window-draw-line-xy (list orgx orgy 1 'paint))) ++ ++; 17 Dec 93 ++; Get a position indicated by a line from a specified origin position. ++; The visual feedback is restricted to lines that LaTex can draw. ++; Returns (x y) at end of line. flg is T for a vector position, nil for line. ++(setf (glfnresulttype 'window-get-latex-position) 'vector) ++(defun window-get-latex-position (w orgx orgy &optional flg) ++ (window-get-icon-position w #'window-draw-latex-xy (list orgx orgy flg))) ++ ++; 13 Aug 91; 15 Aug 91; 05 Sep 91 ++; Get a position indicated by a box of a specified size. ++; (dx dy) is offset of lower-left corner of box from mouse ++; Returns (x y) of lower-left corner of box. ++(setf (glfnresulttype 'window-get-box-position) 'vector) ++(defun window-get-box-position (w width height &optional (dx 0) (dy 0)) ++ (window-get-icon-position w #'window-draw-box-xy ++ (list width height 1) dx dy)) ++ ++; 28 Aug 09 ++; Get a position indicated by a box and line to a specified point ++(setf (glfnresulttype 'window-get-box-line-position) 'vector) ++(defun window-get-box-line-position (w width height offx offy tox toy ++ &optional (dx 0) (dy 0)) ++ (window-get-icon-position w #'window-draw-box-line-xy ++ (list width height offx offy tox toy) dx dy)) ++ ++; 01 Sep 09 ++(defun window-draw-box-line-xy (w x y width height offx offy tox toy) ++ (window-draw-box-xy w x y width height) ++ (window-draw-line-xy w (+ x offx) (+ y offy) tox toy)) ++ ++; 05 Sep 91 ++; Get a position indicated by an icon. ++; fn is the function to draw the icon: (fn w x y . args) . ++; fn must simply draw the icon, not set window parameters. ++; (dx dy) is offset of lower-left corner of icon (x y) from mouse. ++; Returns (x y) of mouse. ++(setf (glfnresulttype 'window-get-icon-position) 'vector) ++(defun window-get-icon-position (w fn args &optional (dx 0) (dy 0)) ++ (let (lastx lasty argl) ++ (setq argl (cons w (cons 0 (cons 0 args)))) ; arg list for fn ++ (window-set-xor w) ++ (window-track-mouse w ++ #'(lambda (x y code) ++ (when (or (null lastx) (/= x lastx) (/= y lasty)) ++ (if lastx (apply fn argl)) ; undraw ++ (rplaca (cdr argl) (+ x dx)) ++ (rplaca (cddr argl) (+ y dy)) ++ (apply fn argl) ; draw ++ (setq lastx x) ++ (setq lasty y)) ++ (not (zerop code)) )) ++ (apply fn argl) ; undraw ++ (window-unset w) ++ (window-force-output w) ++ (list lastx lasty) )) ++ ++; 13 Aug 91; 06 Sep 91; 06 Nov 91 ++; Get a box size and position. ++; Click for top right, then click for bottom left, then move it. ++; Returns ((x y) (width height)) where (x y) is lower-left corner of box. ++(setf (glfnresulttype 'window-get-region) 'region) ++(defun window-get-region (w &optional wid ht) ++ (let (lastx lasty start end width height place offx offy stx sty) ++ (if (and (numberp wid) (numberp ht)) ++ (progn (setq start (window-get-box-position w wid ht (- wid) (- ht))) ++ (setq stx (- (car start) wid)) ++ (setq sty (- (cadr start) ht)) ) ++ (progn (setq start (window-get-point w)) ++ (setq stx (car start)) ++ (setq sty (cadr start)))) ++ (setq end (window-get-icon-position w #'window-draw-box-corners ++ (list stx sty 1))) ++ (setq lastx (car end)) ++ (setq lasty (cadr end)) ++ (setq width (abs (- stx lastx))) ++ (setq height (abs (- sty lasty))) ++ (setq offx (- (min stx lastx) lastx)) ++ (setq offy (- (min sty lasty) lasty)) ++ (setq place (window-get-box-position w width height offx offy)) ++ (list (list (+ offx (first place)) ++ (+ offy (second place))) ++ (list width height)) )) ++ ++; 27 Nov 91; 10 Sep 92 ++; Get box size and echo the size in pixels. Click for top right. ++; Returns (width height) of box. ++(setf (glfnresulttype 'window-get-box-size) 'vector) ++(defun window-get-box-size (w offsetx offsety) ++ (let (legendy lastx lasty dx dy) ++ (setq offsety (max offsety 30)) ++ (setq legendy (- offsety 25)) ++ (window-erase-area-xy w offsetx legendy 71 21) ++ (window-draw-box-xy w offsetx legendy 70 20) ++ (window-track-mouse w ++ #'(lambda (x y code) ++ (when (or (null lastx) (/= x lastx) (/= y lasty)) ++ (if lastx (window-xor-box-xy w offsetx offsety ++ (- lastx offsetx) ++ (- lasty offsety))) ++ (setq lastx nil) ++ (setq dx (- x offsetx)) ++ (setq dy (- y offsety)) ++ (when (and (> dx 0) (> dy 0)) ++ (window-xor-box-xy w offsetx offsety dx dy) ++ (window-printat-xy w (format nil "~3D x ~3D" dx dy) ++ (+ offsetx 3) (+ legendy 5)) ++ (setq lastx x) ++ (setq lasty y))) ++ (not (zerop code)) )) ++ (if lastx (window-xor-box-xy w offsetx offsety (- lastx offsetx) ++ (- lasty offsety))) ++ (window-erase-area-xy w offsetx legendy 71 21) ++ (window-force-output w) ++ (list dx dy) )) ++ ++; 29 Oct 91; 30 Oct 91; 04 Jan 94 ++; Track mouse until a button is pressed or it leaves specified region. ++; Returns (x y code) or nil. boxflg is T to box the region. ++(setf (glfnresulttype 'window-track-mouse-in-region) ++ '(list (code integer) ++ (position (transparent vector)))) ++(defun window-track-mouse-in-region (w offsetx offsety sizex sizey ++ &optional boxflg inside) ++ (let (res) ++ (when boxflg ++ (window-set-xor w) ++ (window-draw-box-xy w (- offsetx 4) (- offsety 4) ++ (+ sizex 8) (+ sizey 8)) ++ (window-unset w) ++ (window-force-output w) ) ++ (setq res (window-track-mouse w ++ #'(lambda (x y code) ++ (if (> code 0) ++ (if inside (list code (list x y)) t) ++ (if (or (< x offsetx) ++ (> x (+ offsetx sizex)) ++ (< y offsety) ++ (> y (+ offsety sizey))) ++ inside ++ (and (setq inside t) nil)))) ) ) ++ (when boxflg ++ (window-set-xor w) ++ (window-draw-box-xy w (- offsetx 4) (- offsety 4) ++ (+ sizex 8) (+ sizey 8)) ++ (window-unset w) ++ (window-force-output w) ) ++ (if (consp res) res) )) ++ ++; 04 Nov 91 ++; Adjust one side of a box by mouse movement. Returns ((x y) (width height)). ++(setf (glfnresulttype 'window-adjust-box-side) 'region) ++(defun window-adjust-box-side (w orgx orgy width height side) ++ (let (new (xx orgx) (yy orgy) (ww width) (hh height)) ++ (setq new (window-get-icon-position w #'window-adj-box-xy ++ (list orgx orgy width height side))) ++ (case side (left (setq xx (car new)) ++ (setq ww (+ width (- orgx (car new))))) ++ (right (setq ww (- (car new) orgx))) ++ (top (setq hh (- (cadr new) orgy))) ++ (bottom (setq yy (cadr new)) ++ (setq hh (+ height (- orgy (cadr new))))) ) ++ (list (list xx yy) (list ww hh)) )) ++ ++; 04 Nov 91 ++(defun window-adj-box-xy (w x y orgx orgy width height side) ++ (let ((xx orgx) (yy orgy) (ww width) (hh height)) ++ (case side (left (setq xx x) (setq ww (+ width (- orgx x)))) ++ (right (setq ww (- x orgx))) ++ (top (setq hh (- y orgy))) ++ (bottom (setq yy y) (setq hh (+ height (- orgy y)))) ) ++ (window-draw-box-xy w xx yy ww hh) )) ++ ++ ++; 10 Sep 92 ++; Get a circle with a specified center and size. ++; center is initial center position, if specified. ++; Returns ((x y) radius) ++(setf (glfnresulttype 'window-get-circle) ++ '(list (center vector) (radius integer))) ++(defun window-get-circle (w &optional center) ++ (let (pt) ++ (or center (setq center (window-get-crosshairs w))) ++ (setq pt (window-get-icon-position w #'window-draw-circle-pt ++ (list center))) ++ (list center (window-circle-radius (car pt) (cadr pt) center)) )) ++ ++; 10 Sep 92 ++(defun window-circle-radius (x y center) ++ (let ((dx (- x (car center))) (dy (- y (cadr center)))) ++ (truncate (+ 0.5 (sqrt (+ (* dx dx) (* dy dy))))) )) ++ ++; 10 Sep 92 ++(defun window-draw-circle-pt (w x y center) ++ (window-draw-circle w center (window-circle-radius x y center) 1)) ++ ++; 10 Sep 92; 15 Sep 92; 06 Nov 92 ++; Get an ellipse with a specified center and sizes. ++; center is initial center position, if specified. ++; First gets a circle whose radius is x size, then adjusts it. ++; Returns ((x y) (radiusx radiusy)) ++(setf (glfnresulttype 'window-get-ellipse) ++ '(list (center vector) (halfsize vector))) ++(defun window-get-ellipse (w &optional center) ++ (let (cir radiusx pt) ++ (setq cir (window-get-circle w center)) ++ (setq center (car cir)) ++ (setq radiusx (cadr cir)) ++ (setq pt (window-get-icon-position w #'window-draw-ellipse-pt ++ (list center radiusx))) ++ (list center (list radiusx (abs (- (cadr pt) (cadr center))))) )) ++ ++; 10 Sep 92 ++(defun window-draw-ellipse-pt (w x y center radiusx) ++ (window-draw-ellipse-xy w (car center) (cadr center) ++ radiusx (abs (- y (cadr center)))) ) ++ ++; 30 Dec 93 ++(defun window-draw-vector-pt (w x y center radius) ++ (let (dx dy theta) ++ (setq dy (- y (cadr center))) ++ (setq dx (- x (car center))) ++ (when (or (/= dx 0) (/= dy 0)) ++ (setq theta (atan (- y (cadr center)) (- x (car center)))) ++ (window-draw-line-xy w (car center) (cadr center) ++ (+ (car center) (* radius (cos theta))) ++ (+ (cadr center) (* radius (sin theta))) ) ) )) ++ ++; 30 Dec 93 ++(setf (glfnresulttype 'window-get-vector-end) 'vector) ++(defun window-get-vector-end (w center radius) ++ (window-get-icon-position w #'window-draw-vector-pt (list center radius)) ) ++ ++; 12 Sep 92 ++(setf (glfnresulttype 'window-get-crosshairs) 'vector) ++(defun window-get-crosshairs (w) ++ (window-get-icon-position w #'window-draw-crosshairs-xy nil) ) ++ ++; 12 Sep 92 ++(defun window-draw-crosshairs-xy (w x y) ++ (window-draw-line-xy w (- x 12) y (- x 3) y) ++ (window-draw-line-xy w (+ x 3) y (+ x 12) y) ++ (window-draw-line-xy w x (- y 12) x (- y 3)) ++ (window-draw-line-xy w x (+ y 3) x (+ y 12)) ) ++ ++; 12 Sep 92 ++(setf (glfnresulttype 'window-get-cross) 'vector) ++(defun window-get-cross (w) ++ (window-get-icon-position w #'window-draw-cross-xy nil) ) ++ ++; 12 Sep 92 ++(defun window-draw-cross-xy (w x y) ++ (window-draw-line-xy w (- x 10) (- y 10) (+ x 10) (+ y 10) 2) ++ (window-draw-line-xy w (+ x 10) (- y 10) (- x 10) (+ y 10) 2) ) ++ ++; 11 Sep 92; 14 Sep 92 ++; Draw a dot whose center is at (x y) ++(defun window-draw-dot-xy (w x y) ++ (window-draw-circle-xy w x y 1) ++ (window-draw-circle-xy w x y 2) ++ (window-draw-line-xy w x y (+ x 1) y 1) ) ++ ++; 17 Dec 93; 19 Dec 93 ++; Draw a line close to the specified coordinates, but restricted to slopes ++; that can be drawn by LaTex. flg = T to restrict slopes for vector. ++(defun window-draw-latex-xy (w x y orgx orgy flg) ++ (let (dx dy delx dely n ratio cd nrat) ++ (setq dx (- x orgx)) ++ (setq dy (- y orgy)) ++ (if (or (= dx 0) (= dy 0)) ++ (window-draw-line-xy w x y orgx orgy) ++ (progn (setq n (if flg 4 6)) ++ (if (> (abs dy) (abs dx)) ++ (progn (setq ratio (round (/ (* (abs dx) n) (abs dy)))) ++ (setq cd (gcd n ratio)) ++ (setq n (/ n cd)) ++ (setq ratio (/ ratio cd)) ++ (setq nrat (round (/ (abs dy) n))) ++ (setq dely (* (signum dy) nrat n)) ++ (setq delx (* (signum dx) nrat ratio)) ) ++ (progn (setq ratio (round (/ (* (abs dy) n) (abs dx)))) ++ (setq cd (gcd n ratio)) ++ (setq n (/ n cd)) ++ (setq ratio (/ ratio cd)) ++ (setq nrat (round (/ (abs dx) n))) ++ (setq delx (* (signum dx) nrat n)) ++ (setq dely (* (signum dy) nrat ratio)) )) ++ (window-draw-line-xy w (+ orgx delx) (+ orgy dely) orgx orgy)) ) ++ )) ++ ++; 31 Dec 93 ++; Reset window colors to default foreground and background. ++(gldefun window-reset-color ((w window)) ++ (XSetForeground *window-display* (gcontext w) *default-fg-color*) ++ (XSetBackground *window-display* (gcontext w) *default-bg-color*) ) ++ ++; 31 Dec 93; 04 Jan 94; 05 Jan 94 ++; Set color to be used in a window to specified red/green/blue values. ++; Values of r, g, b are integers on scale of 65535. ++; Background is t if the background color is to be set, else foreground is set. ++; Returns an xcolor. ++(defun window-set-color-rgb (w r g b &optional background) ++ (let (ret) ++ (or *window-xcolor* (setq *window-xcolor* (Make-Xcolor))) ++ (set-Xcolor-red *window-xcolor* (+ r 0)) ++ (set-Xcolor-green *window-xcolor* (+ g 0)) ++ (set-Xcolor-blue *window-xcolor* (+ b 0)) ++ (setq ret (XAllocColor *window-display* ++ *default-colormap* *window-xcolor*)) ++ (if (not (eql ret 0)) ++ (window-set-xcolor w *window-xcolor* background)) )) ++ ++; 05 Jan 94 ++(defun window-set-xcolor (w &optional xcolor background) ++ (if background ++ (window-set-background w (XColor-Pixel xcolor)) ++ (window-set-foreground w (XColor-Pixel xcolor))) ++ xcolor) ++ ++; 03 Jan 94 ++(defun window-set-color (w rgb &optional background) ++ (window-set-color-rgb w (first rgb) (second rgb) (third rgb) background) ) ++ ++; 31 Dec 93; 03 Jan 94; 05 Jan 94 ++; Free the last xcolor used ++(defun window-free-color (w &optional xcolor) ++ (or xcolor (setq xcolor *window-xcolor*)) ++ (if xcolor ++ (unless (or (eql xcolor *default-fg-color*) ++ (eql xcolor *default-bg-color*)) ++ (XFreeColors *window-display* ++ *default-colormap* xcolor 1 0)) ) ) ++ ++; 31 Dec 93; 18 Jul 96; 25 Jul 96 ++; Get characters or mouse clicks within a window, calling function fn ++; with arguments (char button x y args). ++; Tracking continues until fn returns non-nil; result is that value. ++(defun window-get-chars (w fn &optional args) ++ (let (win res) ++ (or *window-keyinit* (window-init-keymap)) ++ (setq *window-shift* nil) ++ (setq *window-ctrl* nil) ++ (setq *window-meta* nil) ++ (setq win (window-parent w)) ++ (Xsync *window-display* 1) ; clear event queue of prev motion events ++ (Xselectinput *window-display* win ++ (+ KeyPressMask KeyReleaseMask ButtonPressMask)) ++ ;; Event processing loop: stop when function returns non-nil. ++ (while (null res) ++ (XNextEvent *window-display* *window-event*) ++ (let ((type (XAnyEvent-type *window-event*)) ++ (eventwindow (XAnyEvent-window *window-event*))) ++ (if (eql eventwindow win) ++ (setq res (window-process-char-event w type fn args))) )) ++ res)) ++ ++; 31 Dec 93; 18 Jan 94; 04 Oct 94; 18 Jul 96; 19 Jul 96; 22 Jul 96; 23 Jul 96 ++; 25 Jul 96; 08 Sep 06 ++; Process a character event. type is event type. ++; For Control, Shift, and Meta, global flags are set. ++; (fn char button x y) is called for other characters. ++(defun window-process-char-event (w type fn args) ++ (let (code) ++ (if (eql type KeyRelease) ++ (progn ++ (setq code (XButtonEvent-button *window-event*)) ++ (if (member code *window-shift-keys*) ++ (setq *window-shift* nil) ++ (if (member code *window-control-keys*) ++ (setq *window-ctrl* nil) ++ (if (member code *window-meta-keys*) ++ (setq *window-meta* nil))))) ++ (if (eql type KeyPress ) ++ (progn ++ (setq code (XButtonEvent-button *window-event*)) ++ (if (member code *window-shift-keys*) ++ (progn (setq *window-shift* t) nil) ++ (if (member code *window-control-keys*) ++ (progn (setq *window-ctrl* t) nil) ++ (if (member code *window-meta-keys*) ++ (progn (setq *window-meta* t) nil) ++ (funcall fn w (window-char-decode code) 0 0 0 ++ args) )))) ++ (if (eql type ButtonPress) ++ (funcall fn w 0 (XButtonEvent-button *window-event*) ++ (XMotionEvent-x *window-event*) ++ (- (window-drawable-height w) ++ (XMotionEvent-y *window-event*)) ++ args)) ) ) )) ++ ++; 23 Jul 96; 23 Dec 96 ++; Change keyboard code into character; assumes ASCII for control chars ++(defun window-char-decode (code) ++ (let (char) ++ (setq char (aref (if *window-shift* *window-shiftkeymap* *window-keymap*) ++ code)) ++ (if (and char *window-ctrl*) ++ (setq char (code-char (- (char-code (char-upcase char)) 64)))) ++ (if (and char *window-meta*) ; simulate meta using 128 ++ (setq char (code-char (+ (char-code (char-upcase char)) 128)))) ++ (or char #\Space) )) ++ ++; 31 Dec 93; 04 Oct 94; 16 Nov 94 ++; Get character within a window, calling function fn with arg (char). ++; Tracking continues until fn returns non-nil; result is that value. ++(defun window-get-raw-char (w) ++ (let (win res) ++ (or *window-keyinit* (window-init-keymap)) ++ (setq *window-shift* nil) ++ (setq *window-ctrl* nil) ++ (setq *window-meta* nil) ++ (setq win (window-parent w)) ++ (Xsync *window-display* 1) ; clear event queue of prev motion events ++ (Xselectinput *window-display* win ++ (+ KeyPressMask KeyReleaseMask)) ++ ;; Event processing loop: stop when function returns non-nil. ++ (while (null res) ++ (XNextEvent *window-display* *window-event*) ++ (let ((type (XAnyEvent-type *window-event*)) ++ (eventwindow (XAnyEvent-window *window-event*))) ++ (if (and (eql eventwindow win) ++ (eql type KeyPress)) ++ (setq res (XButtonEvent-button *window-event*)) ) )) ++ res)) ++ ++; 31 Dec 93; 19 Jul 96; 12 Aug 96; 13 Aug 96 ++; Input a string from keyboard, echo in window. str is initial string. ++; Backspace is handled; terminate with return. Size is max width in pixels. ++(defun window-input-string (w str x y &optional size) ++ (car (window-edit w x y (or size 100) 16 (list (or str "")) nil t t) ) ) ++ ++; 19 Jul 96; 22 Jul 96; 12 Aug 96; 13 Aug 96 ++; Edit strings in a window area with Emacs-subset editor ++; strings is a list of strings, which is the return value ++; scroll is number of lines to scroll down before displaying text, ++; or t to have one line only and terminate on return. ++; endp is T to begin edit at end of first line ++; e.g. (window-draw-box-xy myw 48 48 204 204) ++; (window-edit myw 50 50 200 200 '("Now is the time" "for all" "good")) ++(gldefun window-edit (w x y width height &optional strings boxflg scroll endp) ++ (let (em) ++ (em = (editmenu-create width height nil w x y nil t '9x15 boxflg ++ strings scroll endp)) ++ (edit em) ++ (carat em) ; erase the carat ++ (text em) )) ++ ++; 25 Jul 96; 26 Jul 96; 12 Aug 96; 13 Aug 96; 15 Aug 96; 17 May 04 ++; (setq em (editmenu-create 200 30 nil myw 50 50 t t '9x15 t ("Rutabagas"))) ++; Simple call from plain Lisp to make an edit menu. ++(setf (glfnresulttype 'editmenu-create) 'editmenu) ++(gldefun editmenu-create ((width integer) (height integer) ++ &optional title (parentw window) x y ++ (perm boolean) (flat boolean) ++ (font symbol) (boxflg boolean) ++ (initial-text (listof string)) ++ scrollval (endp boolean)) ++ (an editmenu with title = (if title (stringify title) "") ++ menu-window = (if flat parentw) ++ parent-window = (if parentw (parent parentw)) ++ parent-offset-x = (or x 0) ++ parent-offset-y = (or y 0) ++ permanent = perm ++ flat = flat ++ drawing-width = width ++ drawing-height = height ++ menu-font = (font or '9x15) ++ boxflg = boxflg ++ text = (or initial-text (list "")) ++ scrollval = (or scrollval 0) ++ line = (if (numberp scrollval) ++ scrollval ++ 0) ++ column = (if endp ++ (length (car (nthcdr ++ (if (numberp scrollval) ++ scrollval ++ 0) ++ initial-text))) ++ 0)) ) ++ ++; 25 Jul 96 ++(gldefun editmenu-calculate-size ((m editmenu)) ++ ((picture-width m) = (drawing-width m)) ++ ((picture-height m) = (drawing-height m)) ) ++ ++; 18 Apr 95 ++; Initialize a picture menu ++(gldefun editmenu-init ((m editmenu)) ++ (let () ++ (calculate-size m) ++ (adjust-offset m) ++ (if ~ (flat m) ++ ((menu-window m) = ++ (window-create (picture-width m) (picture-height m) ++ ((title m) or "") (parent-window m) ++ (parent-offset-x m) (parent-offset-y m) ++ (menu-font m) )) ) )) ++ ++; 25 Jul 96; 31 July 96; 14 Aug 96 ++(gldefun editmenu-draw ((m editmenu)) ++ (let (mw xzero yzero) ++ (init? m) ++ (mw = (menu-window m)) ++ (open mw) ++ (clear m) ++ (xzero = (menu-x m 0)) ++ (yzero = (menu-y m 0)) ++ (if (boxflg m) (draw-box-xy mw xzero yzero ++ (picture-width m) (picture-height m) 1)) ++ (display m 0 0 (not (numberp scrollval))) )) ++ ++; 19 Jul 96; 22 Jul 96; 23 Jul 96; 25 Jul 96; 31 July 96; 01 Aug 96; 17 May 04 ++; 18 Aug 04; 27 Jan 06 ++; Display contents of edit area ++; Begin with the specified line and char number; one line only if only is T. ++(gldefun editmenu-display ((m editmenu) line char only) ++ (let (lines y maxwidth linewidth (w (menuw m))) ++ (setq lines (nthcdr line (text m))) ++ (setq y (line-y m (- line (scroll m)))) ++ (setq maxwidth (truncate (- (picture-width m) 6) (font-width (menuw m)))) ++ (while (and lines (>= y (menu-y m 4))) ++ (when (< char maxwidth) ++ (if (> char 0) ++ (printat-xy w (subseq (first lines) char ++ (min maxwidth (length (first lines)))) ++ (menu-x m (+ 2 (* char (font-width (menuw m))))) ++ y) ++ (printat-xy w (if (<= (length (first lines)) maxwidth) ++ (first lines) ++ (subseq (first lines) 0 maxwidth)) ++ (menu-x m 2) y))) ++ (setq linewidth (+ 2 (* (font-width (menuw m)) (length (first lines))))) ++ (window-erase-area-xy w (menu-x m linewidth) ++ (- y 2) ++ (- (picture-width m) (+ linewidth 2)) ++ (font-height (menuw m))) ++ (y _- (font-height (menuw m))) ++ (if only (setq lines nil) ++ (progn (pop lines) ++ (if (and (null lines) (>= y (menu-y m 4))) ++ ; erase an extra line at the end ++ (window-erase-area-xy w (menu-x m 2) ++ (- y 2) ++ (- (picture-width m) 4) ++ (font-height (menuw m))) ) )) ++ (setq char 0) ) ++ (force-output w) )) ++ ++; 19 Jul 96; 22 Jul 96; 25 Jul 96; 31 Jul 96; 01 Aug 96 ++; draw/erase carat at the specified position ++(gldefun editmenu-carat ((m editmenu)) ++ (let ((w (menuw m))) ++ (draw-carat w (menu-x m (+ 2 (* (column m) (font-width (menuw m))))) ++ (- (line-y m (line m)) 2)) ++ (force-output w) )) ++ ++; 19 Jul 96; 25 Jul 96; 31 Jul 96; 01 Aug 96; 17 May 04 ++; erase at the current position. onep = t to erase only one char ++(gldefun editmenu-erase ((m editmenu) onep) ++ (let ((w (menuw m)) xw) ++ (xw = (+ 2 (* (font-width w) (column m)))) ++ (erase-area-xy w (menu-x m xw) ++ (- (line-y m (line m)) (cadr (string-extents w "Tg"))) ++ (if onep (font-width w) ++ (- (picture-width m) xw)) ++ (font-height w)) ++ (force-output w) )) ++ ++; 01 Aug 96 ++; Calculate the y position of the current line ++(gldefun editmenu-line-y ((m editmenu) (line integer)) ++ (menu-y m (- (picture-height m) ++ (+ -1 (* (font-height (menuw m)) ++ (1+ (- line (scroll m))))))) ) ++ ++; 25 Jul 96; 30 Jul 96; 31 Jul 96; 01 Aug 96; 13 Aug 96; 24 Sep 96; 08 Jan 97 ++; 17 May 04 ++(gldefun editmenu-select ((m editmenu) &optional inside) ++ (let (mw codeval res xval yval) ++ (mw = (menuw m)) ++ (if ~ (permanent m) (draw m)) ++ (track-mouse mw ++ #'(lambda (x y code) ++ (setq *window-menu-code* code) ++ (if (or (> code 0) ++ (x < (parent-offset-x m)) ++ (x > (+ (parent-offset-x m) (picture-width m))) ++ (y < (parent-offset-y m)) ++ (y > (+ (parent-offset-y m) (picture-height m)))) ++ (progn (codeval = code) ++ (xval = x) ++ (yval = y)) )) ++ t) ++; (if (and (not (permanent m)) (not (flat m)) (close (menu-window m)))) ; ?? ++ (if (codeval > 0) ++ (editmenu-edit m codeval xval yval)) )) ++ ++(defvar *window-editmenu-kill-strings* nil) ++ ++; 13 Aug 96; 15 Aug 96 ++; begin active editing of an editmenu. ++; (code x y), if present, represent a mouse click in the window. ++(gldefun editmenu-edit ((m editmenu) &optional code x y) ++ (let ((mw (menuw m))) ++ (draw m) ++ (carat m) ++ (if code (editmenu-edit-fn mw nil code x y (list m)) ) ++ (setq *window-editmenu-kill-strings* nil) ++ (window-get-chars mw #'editmenu-edit-fn (list m)) ++ (text m) )) ++ ++ ++; 31 Dec 93; 18 Jul 96; 19 Jul 96; 22 Jul 96; 23 Jul 96; 25 Jul 96; 26 Jul 96 ++; 30 Jul 96; 13 Aug 96; 14 Aug 96; 23 Dec 96; 17 May 04; 18 May 04 ++; Process input characters and mouse clicks for editmenu eidting ++(gldefun editmenu-edit-fn ((w window) char (button integer) (buttonx integer) ++ (buttony integer) args) ++ (let (m\:editmenu inside done) ++ (m = (car args)) ++ (carat m) ; erase carat ++ (if (and (numberp button) ++ (not (zerop button))) ++ (progn (inside = (editmenu-setxy m buttonx buttony)) ++ (case button ++ (1 (if inside ++ (progn (carat m) nil) ; return nil to continue input ++ t)) ; quit on click outside the editing area ++ (2 (if inside ++ (progn (editmenu-yank m) ++ (carat m) ++ nil)) ))) ++ (progn (if (< (char-code char) 32) ++ (case char of ++ (#\Return (if (numberp (scrollval m)) ++ (editmenu-return m) ++ (done = t)) ) ++ (#\Backspace (editmenu-backspace m)) ++ (#\^D (editmenu-delete m)) ++ (#\^N (if (numberp (scrollval m)) ++ (editmenu-next m))) ++ (#\^P (editmenu-previous m)) ++ (#\^F (editmenu-forward m)) ++ (#\^B (editmenu-backward m)) ++ (#\^A (editmenu-beginning m)) ++ (#\^E (editmenu-end m)) ++ (#\^K (editmenu-kill m)) ++ (#\^Y (editmenu-yank m)) ++ else nil) ++ (if (> (char-code char) 128) ++ (progn (setq char (code-char ++ (- (char-code char) 128))) ++ (case char of ++ (#\B (editmenu-meta-b m)) ++ (#\F (editmenu-meta-f m)) ++ else nil)) ++ (editmenu-char m char))) ++ (carat m) ++ done) ))) ; return nil to continue input ++ ++; 31 Jul 96; 15 Aug 96; 17 May 04 ++; Set cursor location based on mouse click; returns T if inside menu region ++(gldefun editmenu-setxy ((m editmenu) (buttonx integer) (buttony integer)) ++ (let (linecons okay) ++ (setq okay ++ (and (>= buttonx (parent-offset-x m)) ++ (<= buttonx (+ (parent-offset-x m) (picture-width m))) ++ (>= buttony (parent-offset-y m)) ++ (<= buttony (+ (parent-offset-y m) (picture-height m))) )) ++ (if okay ++ (progn ((line m) = (min (1- (length (text m))) ++ (+ (scroll m) ++ (truncate (- (menu-y m (- (picture-height m) 6)) ++ buttony) ++ (font-height (menuw m)))))) ++ (linecons = (nthcdr (line m) (text m))) ++ ((column m) = (min (length (car linecons)) ++ (truncate (- buttonx (menu-x m 2)) ++ (font-width (menuw m))))) )) ++ okay)) ++ ++; 19 Jul 96; 22 Jul 96; 25 Jul 96; 17 May 04 ++; Process an ordinary input character ++(gldefun editmenu-char ((m editmenu) char) ++ (let ((linecons (nthcdr (line m) (text m))) ) ++ (if (<= (length (car linecons)) (column m)) ++ ((car linecons) = ; insert char at end of line ++ (concatenate 'string (car linecons) (string char))) ++ ((car linecons) = ; insert char in middle of line ++ (concatenate 'string ++ (subseq (car linecons) 0 (column m)) ++ (string char) ++ (subseq (car linecons) (column m)))) ) ++ (display m (line m) (column m) t) ++ ((column m) _+ 1) )) ++ ++; 23 Dec 96 ++; Get the current character in an editment ++(gldefun editmenu-current-char ((m editmenu)) ++ (let ((linecons (nthcdr (line m) (text m))) ) ++ (char (car linecons) (column m)) )) ++ ++; 19 Jul 96; 22 Jul 96; 25 Jul 96; 17 May 04 ++; Process a Return character ++(gldefun editmenu-return ((m editmenu)) ++ (let ((linecons (nthcdr (line m) (text m)))) ++ (if (<= (length (car linecons)) (column m)) ++ ((cdr linecons) = (cons "" (cdr linecons))) ; end of line ++ (progn ((cdr linecons) = (cons (subseq (car linecons) (column m)) ++ (cdr linecons))) ++ ((car linecons) = (subseq (car linecons) 0 (column m))))) ++ (display m (line m) 0 nil) ++ ((line m) _+ 1) ++ ((column m) = 0) )) ++ ++; 19 Jul 96; 22 Jul 96; 25 Jul 96; 30 Jul 96; 31 Jul 96; 17 May 04 ++; Process a backspace ++(gldefun editmenu-backspace ((m editmenu)) ++ (let (tmp linedel (linecons (nthcdr (line m) (text m)))) ++ (if (> (column m) 0) ++ (progn ((column m) _- 1) ; middle/end of line ++ ((car linecons) = ++ (concatenate 'string ++ (subseq (car linecons) 0 (column m)) ++ (subseq (car linecons) ++ (1+ (column m)))))) ++ (if (> (line m) 0) ++ (progn ((line m) _- 1) ++ (linedel = t) ++ (linecons = (nthcdr (line m) (text m))) ++ ((column m) = (length (car linecons))) ++ (tmp = (concatenate 'string (car linecons) ++ (cadr linecons))) ++ ((cdr linecons) = (cddr linecons)) ++ ((car linecons) = tmp) ) )) ++ (display m (line m) (column m) (not linedel)) )) ++ ++; 23 Jul 96; 25 Jul 96 ++; Move cursor to end of line: C-E ++(gldefun editmenu-end ((m editmenu)) ++ (let ((linecons (nthcdr (line m) (text m))) ) ++ ((column m) = (length (car linecons))) )) ++ ++; 23 Jul 96; 25 Jul 96 ++; Move cursor to beginning of line: C-A ++(gldefun editmenu-beginning ((m editmenu)) ++ ((column m) = 0)) ++ ++; 22 Jul 96; 25 Jul 96; 14 Aug 96; 17 May 04 ++; Move cursor forward: C-F ++(gldefun editmenu-forward ((m editmenu)) ++ (let ((linecons (nthcdr (line m) (text m)))) ++ (if (< (column m) (length (car linecons))) ++ ((column m) _+ 1) ++ (if (numberp (scrollval m)) ++ (progn ((line m) _+ 1) ++ (if (null (cdr linecons)) ++ ((cdr linecons) = (list ""))) ++ ((column m) = 0)) ) ))) ++ ++; 23 Dec 96; 17 May 04 ++; Move cursor forward over a word: M-F ++(gldefun editmenu-meta-f ((m editmenu)) ++ (let (found done) ++ (while (and (or (< (line m) (1- (length (text m)))) ++ (< (column m) (length (nth (line m) (text m))))) ++ (not found)) ++ (if (editmenu-alphanumbericp (editmenu-current-char m)) ++ (found = t) ++ (editmenu-forward m) ) ) ++ (if found ++ (while (and (or (< (line m) (1- (length (text m)))) ++ (< (column m) (length (nth (line m) (text m))))) ++ (not done)) ++ (if (editmenu-alphanumbericp (editmenu-current-char m)) ++ (editmenu-forward m) ++ (done = t) )) ) )) ++ ++; 23 Dec 96 ++; alphanumbericp not defined in gcl ++(defun editmenu-alphanumbericp (x) ++ (or (alpha-char-p x) (not (null (digit-char-p x)))) ) ++ ++; 22 Jul 96; 25 Jul 96 ++; Move cursor to next line: C-N ++(gldefun editmenu-next ((m editmenu)) ++ (let ((linecons (nthcdr (line m) (text m)))) ++ ((line m)_+ 1) ++ (if (null (cdr linecons)) ++ ((cdr linecons) = (list ""))) ++ (setq linecons (cdr linecons)) ++ ((column m) = (min (column m) (length (car linecons)))) )) ++ ++; 22 Jul 96; 23 Jul 96; 25 Jul 96; 30 Jul 96; 17 May 04 ++; Move cursor backward: C-B ++(gldefun editmenu-backward ((m editmenu)) ++ (if (> (column m) 0) ++ ((column m) _- 1) ++ (if (> (line m) 0) ++ (progn ((line m) _- 1) ++ ((column m) = (length (nth (line m) (text m)))) ) ) )) ++ ++; 23 Dec 96; 17 May 04 ++; Move cursor backward over a word: M-B ++(gldefun editmenu-meta-b ((m editmenu)) ++ (let (found done) ++ (while (and (or (> (column m) 0) (> (line m) 0)) ++ (not found)) ++ (editmenu-backward m) ++ (if (editmenu-alphanumbericp (editmenu-current-char m)) ++ (found = t))) ++ (if found ++ (progn (while (and (or (> (column m) 0) (> (line m) 0)) ++ (not done)) ++ (if (editmenu-alphanumbericp (editmenu-current-char m)) ++ (editmenu-backward m) ++ (done = t) )) ++ (unless (editmenu-alphanumbericp (editmenu-current-char m)) ++ (editmenu-forward m)) ) ))) ++ ++; 22 Jul 96; 23 Jul 96; 25 Jul 96; 17 May 04 ++; Move cursor to previous line: C-P ++(gldefun editmenu-previous ((m editmenu)) ++ (if (> (line m) 0) ++ (progn ((line m) _- 1) ++ ((column m) = (min (column m) ++ (length (nth (line m) (text m)))))))) ++ ++; 23 Jul 96; 25 Jul 96 ++; Delete character ahead of cursor: C-D ++(gldefun editmenu-delete ((m editmenu)) ++ (editmenu-forward m) ++ (editmenu-backspace m)) ++ ++; 31 Jul 96; 17 May 04 ++(gldefun editmenu-kill ((m editmenu)) ++ (let ((linecons (nthcdr (line m) (text m)))) ++ (if ((column m) < (length (car linecons))) ++ (progn (setq *window-editmenu-kill-strings* ++ (list (subseq (car linecons) (column m)))) ++ ((car linecons) = (subseq (car linecons) 0 (column m))) ++ (display m (line m) (column m) t)) ++ (editmenu-delete m) ) )) ++ ++; 31 Jul 96; 01 Aug 96; 17 May 04 ++(gldefun editmenu-yank ((m editmenu)) ++ (let ((linecons (nthcdr (line m) (text m))) (col (column m))) ++ (when *window-editmenu-kill-strings* ++ (if (<= (length (car linecons)) (column m)) ++ (progn ((car linecons) = ; insert at end of line ++ (concatenate 'string (car linecons) ++ (car *window-editmenu-kill-strings*))) ++ ((column m) = (length (car linecons)))) ++ (progn ((car linecons) = ; insert in middle of line ++ (concatenate 'string ++ (subseq (car linecons) 0 col) ++ (car *window-editmenu-kill-strings*) ++ (subseq (car linecons) col))) ++ ((column m) _+ (length (car *window-editmenu-kill-strings*))) )) ++ (display m (line m) col t) ) )) ++ ++; 31 Dec 93; 19 Jul 96 ++; Draw a carat symbol /\ centered at x and with top at y. ++(defun window-draw-carat (w x y) ++ (window-set-xor w) ++ (window-draw-line-xy w (- x 5) (- y 2) x y) ++ (window-draw-line-xy w x y (+ x 5) (- y 2)) ++ (window-unset w) ++ (window-force-output w) ) ++ ++; 31 Dec 93; 04 Oct 94; 15 Nov 94; 16 Nov 94; 14 Mar 95; 25 Jun 06 ++; Initialize mapping between keys and ASCII. ++(defun window-init-keymap () ++ (let (mincode maxcode keycode keysym keynum shiftkeynum char) ++ ; Get the min and max keycodes for this keyboard ++ (XDisplayKeycodes *window-display* *min-keycodes-return* ++ *max-keycodes-return*) ++ (setq mincode (int-pos *min-keycodes-return* 0)) ++ (setq maxcode (int-pos *max-keycodes-return* 0)) ++ (setq *window-keymap* (make-array (1+ maxcode) :initial-element nil)) ++ (setq *window-shiftkeymap* (make-array (1+ maxcode) :initial-element nil)) ++ (setq *window-shift-keys* nil) ++ (setq *window-control-keys* nil) ++ (setq *window-meta-keys* nil) ++ ; Get the ASCII corresponding to these keycodes ++ (dotimes (i (1+ (- maxcode mincode))) ++ (setq keycode (+ i mincode)) ++ (setq keysym (XGetKeyboardMapping *window-display* keycode 1 ++ *keycodes-return*)) ++ (setq keynum (fixnum-pos keysym 0)) ; ascii integer code ++ (setq shiftkeynum (fixnum-pos keysym 1)) ++ ; (XFree keysym) ; ***** commented out -- causes error on Sun ++ ; Following is a Kludge (TM) for Sun keyboard ++ (if (and (>= keynum 65) (<= keynum 90) (eql shiftkeynum NoSymbol)) ++ (progn (setq shiftkeynum keynum) ++ (setq keynum (+ keynum 32)))) ++ (if (> keynum 0) ++ (if (setq char (window-code-char keynum)) ++ (setf (aref *window-keymap* keycode) char) ++ (if (> keynum 256) ++ (cond ((or (eql keynum XK_Shift_R) (eql keynum XK_Shift_L)) ++ (push keycode *window-shift-keys*)) ++ ((or (eql keynum XK_Control_L) (eql keynum XK_Control_R)) ++ (push keycode *window-control-keys*)) ++ ((or (eql keynum XK_Alt_R) (eql keynum XK_Alt_L)) ++ (push keycode *window-meta-keys*)))))) ++ (if (> shiftkeynum 0) ++ (if (setq char (window-code-char shiftkeynum)) ++ (setf (aref *window-shiftkeymap* keycode) char) ++ )) ) ++ (setq *window-keyinit* t) )) ; signify initialization done ++ ++; 15 Nov 94 ++(defun window-code-char (code) ++ (if (> code 0) ++ (if (< code 256) ++ (code-char code) ++ (cond ((eql code XK_Return) #\Return) ++ ((eql code XK_Tab) #\Tab) ++ ((eql code XK_BackSpace) #\Backspace)) ) ) ) ++ ++; 14 Dec 90; 12 Aug 91; 09 Oct 91; 09 Sep 92; 04 Aug 93; 06 Oct 94 ++; Compile the dwindow file into a plain Lisp file ++(defun compile-dwindow () ++ (glcompfiles *directory* ++ '("glisp/vector.lsp") ; auxiliary files ++ '("X/dwindow.lsp") ; translated files ++ "X/dwtrans.lsp" ; output file ++ "X/dwhead.lsp" ; header file ++ '(glfnresulttype glmacro glispobjects ++ glispconstants glispglobals compile-dwindow compile-dwindowb)) ++ (compile-file (concatenate 'string *directory* "X/dwtrans.lsp")) ) ++ ++(defun compile-dwindowb () ++ (glcompfiles *directory* ++ '("glisp/vector.lsp") ; auxiliary files ++ '("X/dwindow.lsp") ; translated files ++ "X/dwtransb.lsp") ; output file ++ (compile-file (concatenate 'string *directory* "X/dwtransb.lsp")) ) ++ ++; Note: when compiling dwtrans.lsp, be sure glmacros.lsp is loaded. +--- gcl-2.6.7.orig/xgcl-2/sysdef.lisp ++++ gcl-2.6.7/xgcl-2/sysdef.lisp +@@ -23,31 +23,47 @@ + (in-package :XLIB) + (sys::use-package '(:lisp :system :sys)) + +-(defvar *files* '( "Xlib" +- "Xutil" +- "X" +- "XAtom" +- "defentry-events" +- "Xstruct" +- "XStruct-l-3" +- "general" +- "keysymdef" +- "X10" +- "Xinit" +- "dwtrans" +- "sysinit" ++(defvar *files* '( "gcl_Xlib" ++ "gcl_Xutil" ++ "gcl_X" ++ "gcl_XAtom" ++ "gcl_defentry_events" ++ "gcl_Xstruct" ++ "gcl_XStruct_l_3" ++ "gcl_general" ++ "gcl_keysymdef" ++ "gcl_X10" ++ "gcl_Xinit" ++ "gcl_dwtrans" ++ "gcl_tohtml" ++ "gcl_index" ++; "gcl_sysinit" + )) + + + (defun compile-xgcl() +- (mapcar #'(lambda (x) +- (compile-file (format nil "~a.lsp" x) :system-p t)) *files*) +- ) ++ (mapc (lambda (x) ++ (let ((x (concatenate 'string compiler::*cc* " -I../h " (namestring x)))) ++ (unless (zerop (system x)) ++ (error "compile failure: ~s~%" x)))) ++ (directory "*.c")) ++ (mapc (lambda (x) ++ (compile-file (format nil "~a.lsp" x) :system-p t)) *files*)) + + + (defun load-xgcl() +- (mapcar #'(lambda (x) (load (format nil "~a.o" x))) *files*)) ++ (mapcar (lambda (x) (load (format nil "~a.o" x))) *files*)) + ++(defun load-xgcl-interp() ++ (mapcar (lambda (x) (load (format nil "~a.lsp" x))) *files*)) ++ ++(defun save-xgcl (pn) ++ (let* ((x (mapcar (lambda (x) (probe-file (concatenate 'string x ".o"))) *files*)) ++ (y (directory "*.o")) ++ (z (set-difference y x :test 'equal))) ++ (compiler::link x (namestring pn) (format nil "(load ~s)(mapc 'load '~s)" "sysdef.lisp" x) ++ (reduce (lambda (&rest xy) (when xy (concatenate 'string (namestring (car xy)) " " (cadr xy)))) z ++ :initial-value " -lXmu -lXt -lXext -lXaw -lX11" :from-end t) nil))) + + + +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_XAtom.lsp +@@ -0,0 +1,118 @@ ++(in-package :XLIB) ++; XAtom.lsp modified by Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++ ++ ++;; THIS IS A GENERATED FILE ++ ;; ++ ;; Do not change! Changing this file implies a protocol change! ++ ++ ++(defconstant XA_PRIMARY 1) ++(defconstant XA_SECONDARY 2) ++(defconstant XA_ARC 3) ++(defconstant XA_ATOM 4) ++(defconstant XA_BITMAP 5) ++(defconstant XA_CARDINAL 6) ++(defconstant XA_COLORMAP 7) ++(defconstant XA_CURSOR 8) ++(defconstant XA_CUT_BUFFER0 9) ++(defconstant XA_CUT_BUFFER1 10) ++(defconstant XA_CUT_BUFFER2 11) ++(defconstant XA_CUT_BUFFER3 12) ++(defconstant XA_CUT_BUFFER4 13) ++(defconstant XA_CUT_BUFFER5 14) ++(defconstant XA_CUT_BUFFER6 15) ++(defconstant XA_CUT_BUFFER7 16) ++(defconstant XA_DRAWABLE 17) ++(defconstant XA_FONT 18) ++(defconstant XA_INTEGER 19) ++(defconstant XA_PIXMAP 20) ++(defconstant XA_POINT 21) ++(defconstant XA_RECTANGLE 22) ++(defconstant XA_RESOURCE_MANAGER 23) ++(defconstant XA_RGB_COLOR_MAP 24) ++(defconstant XA_RGB_BEST_MAP 25) ++(defconstant XA_RGB_BLUE_MAP 26) ++(defconstant XA_RGB_DEFAULT_MAP 27) ++(defconstant XA_RGB_GRAY_MAP 28) ++(defconstant XA_RGB_GREEN_MAP 29) ++(defconstant XA_RGB_RED_MAP 30) ++(defconstant XA_STRING 31) ++(defconstant XA_VISUALID 32) ++(defconstant XA_WINDOW 33) ++(defconstant XA_WM_COMMAND 34) ++(defconstant XA_WM_HINTS 35) ++(defconstant XA_WM_CLIENT_MACHINE 36) ++(defconstant XA_WM_ICON_NAME 37) ++(defconstant XA_WM_ICON_SIZE 38) ++(defconstant XA_WM_NAME 39) ++(defconstant XA_WM_NORMAL_HINTS 40) ++(defconstant XA_WM_SIZE_HINTS 41) ++(defconstant XA_WM_ZOOM_HINTS 42) ++(defconstant XA_MIN_SPACE 43) ++(defconstant XA_NORM_SPACE 44) ++(defconstant XA_MAX_SPACE 45) ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++(defconstant XA_END_SPACE 46) ++(defconstant XA_SUPERSCRIPT_X 47) ++(defconstant XA_SUPERSCRIPT_Y 48) ++(defconstant XA_SUBSCRIPT_X 49) ++(defconstant XA_SUBSCRIPT_Y 50) ++(defconstant XA_UNDERLINE_POSITION 51) ++(defconstant XA_UNDERLINE_THICKNESS 52) ++(defconstant XA_STRIKEOUT_ASCENT 53) ++(defconstant XA_STRIKEOUT_DESCENT 54) ++(defconstant XA_ITALIC_ANGLE 55) ++(defconstant XA_X_HEIGHT 56) ++(defconstant XA_QUAD_WIDTH 57) ++(defconstant XA_WEIGHT 58) ++(defconstant XA_POINT_SIZE 59) ++(defconstant XA_RESOLUTION 60) ++(defconstant XA_COPYRIGHT 61) ++(defconstant XA_NOTICE 62) ++(defconstant XA_FONT_NAME 63) ++(defconstant XA_FAMILY_NAME 64) ++(defconstant XA_FULL_NAME 65) ++(defconstant XA_CAP_HEIGHT 66) ++(defconstant XA_WM_CLASS 67) ++(defconstant XA_WM_TRANSIENT_FOR 68) ++ ++(defconstant XA_LAST_PREDEFINED 68) ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_dwsyms.lsp +@@ -0,0 +1,148 @@ ++; dwsyms.lsp Gordon S. Novak Jr. 14 Mar 95 ++ ++; Copyright (c) 1995 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; See the file gnu.license . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; This file imports symbols from the X library (in XLIB: package) ++; to the current package (such as the :USER package). ++; This will allow these symbols to be accessed by just their ++; names and without any package qualifier. ++; This file may be useful if you wish to modify dwindow.lsp or dwtrans.lsp . ++ ++; This file should be loaded immediately after starting Lisp: ++; If Lisp has seen any of these symbols, loading this file will cause an error. ++ ++(import '( ++xlib::BUTTONPRESS ++xlib::BUTTONPRESSMASK ++xlib::BUTTONRELEASEMASK ++xlib::CAPBUTT ++xlib::CWBACKINGSTORE ++xlib::CWSAVEUNDER ++xlib::EXPOSE ++xlib::EXPOSUREMASK ++xlib::GCBACKGROUND ++xlib::GCFOREGROUND ++xlib::GCFUNCTION ++xlib::GET-C-STRING ++xlib::GXCOPY ++xlib::GXXOR ++xlib::INT-ARRAY ++xlib::INT-POS ++xlib::ISUNMAPPED ++xlib::JOINMITER ++xlib::KEYPRESS ++xlib::KEYPRESSMASK ++xlib::KEYRELEASE ++xlib::KEYRELEASEMASK ++xlib::LEAVEWINDOWMASK ++xlib::LINESOLID ++xlib::MAKE-XCOLOR ++xlib::MAKE-XEVENT ++xlib::MAKE-XGCVALUES ++xlib::MAKE-XSETWINDOWATTRIBUTES ++xlib::MAKE-XSIZEHINTS ++xlib::MAKE-XWINDOWATTRIBUTES ++xlib::MOTIONNOTIFY ++xlib::NONE ++xlib::NoSymbol ++xlib::POINTERMOTIONMASK ++xlib::PPOSITION ++xlib::PSIZE ++xlib::SET-XCOLOR-BLUE ++xlib::SET-XCOLOR-GREEN ++xlib::SET-XCOLOR-RED ++xlib::SET-XSETWINDOWATTRIBUTES-BACKING_STORE ++xlib::SET-XSETWINDOWATTRIBUTES-SAVE_UNDER ++xlib::SET-XSIZEHINTS-HEIGHT ++xlib::SET-XSIZEHINTS-FLAGS ++xlib::SET-XSIZEHINTS-WIDTH ++xlib::SET-XSIZEHINTS-X ++xlib::SET-XSIZEHINTS-Y ++xlib::WHENMAPPED ++xlib::XALLOCCOLOR ++xlib::XANYEVENT-TYPE ++xlib::XANYEVENT-WINDOW ++xlib::XBLACKPIXEL ++xlib::XBUTTONEVENT-BUTTON ++xlib::XCHANGEWINDOWATTRIBUTES ++xlib::XCLEARAREA ++xlib::XCLEARWINDOW ++xlib::XCOLOR-PIXEL ++xlib::XCOPYAREA ++xlib::XCREATEFONTCURSOR ++xlib::XCREATEGC ++xlib::XCREATESIMPLEWINDOW ++xlib::XDEFAULTCOLORMAP ++xlib::XDEFAULTGC ++xlib::XDEFAULTSCREEN ++xlib::XDEFINECURSOR ++xlib::XDESTROYWINDOW ++xlib::XDRAWARC ++xlib::XDRAWIMAGESTRING ++xlib::XDRAWLINE ++xlib::XFILLRECTANGLE ++xlib::XFONTSTRUCT-FID ++xlib::XFLUSH ++xlib::XFREECOLORS ++xlib::XFREEGC ++xlib::XGCVALUES-BACKGROUND ++xlib::XGCVALUES-FOREGROUND ++xlib::XGCVALUES-FUNCTION ++xlib::XGETGCVALUES ++xlib::XGETGEOMETRY ++xlib::XGETWINDOWATTRIBUTES ++xlib::XLOADQUERYFONT ++xlib::XMAPWINDOW ++xlib::XMOTIONEVENT-X ++xlib::XMOTIONEVENT-Y ++xlib::XMOVEWINDOW ++xlib::XNEXTEVENT ++xlib::XOPENDISPLAY ++xlib::XPENDING ++xlib::XQUERYPOINTER ++xlib::XRECOLORCURSOR ++xlib::XROOTWINDOW ++xlib::XSELECTINPUT ++xlib::XSETBACKGROUND ++xlib::XSETFONT ++xlib::XSETFOREGROUND ++xlib::XSETFUNCTION ++xlib::XSETLINEATTRIBUTES ++xlib::XSETSTANDARDPROPERTIES ++xlib::XSYNC ++xlib::XTEXTEXTENTS ++xlib::XTEXTWIDTH ++xlib::XUNMAPWINDOW ++xlib::XWHITEPIXEL ++xlib::XWINDOWATTRIBUTES-MAP_STATE ++xlib::XDisplayKeycodes ++xlib::XGetKeyboardMapping ++xlib::XFree ++xlib::XK_Shift_R ++xlib::XK_Shift_L ++xlib::XK_Control_L ++xlib::XK_Control_R ++xlib::XK_Alt_R ++xlib::XK_Alt_L ++xlib::XK_Return ++xlib::XK_Tab ++xlib::XK_BackSpace ++)) ++ ++(setf (get 'xlib::int-pos 'glfnresulttype) 'integer) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_dwtrans.lsp +@@ -0,0 +1,2894 @@ ++; 13 Jan 2010 17:40:33 EST ++; dwtrans.lsp -- translation of dwindow.lsp ; 07 Jan 10 ++ ++; Copyright (c) 2010 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 program 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 program; if not, write to the Free Software ++; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++ ++(in-package :xlib) ++ ++(defmacro while (test &rest forms) `(loop (unless ,test (return)) ,@forms) ) ++ ++(setf (get 'xlib::int-pos 'user::glfnresulttype) 'lisp::integer) ++(setf (get 'xlib::fixnum-pos 'user::glfnresulttype) 'lisp::integer) ++ ++; exported symbols: from dwimports.lsp ++(dolist (x '( menu stringify window picmenu textmenu editmenu barmenu ++ display-size ++ window-get-mouse-position window-create window-set-font ++ window-font-info window-gcontext window-parent ++ window-drawable-height window-drawable-width window-label ++ window-font window-foreground window-set-foreground ++ window-background window-set-background window-wfunction ++ window-get-geometry window-get-geometry-b window-sync ++ window-screen-height window-geometry window-size ++ window-left window-top-neg-y window-reset-geometry ++ window-force-output window-query-pointer window-set-xor ++ window-unset window-reset window-set-erase ++ window-set-copy window-set-invert window-set-line-width ++ window-set-line-attr window-std-line-attr window-draw-line ++ window-draw-line-xy window-draw-arrowhead-xy ++ window-draw-arrow-xy window-draw-arrow2-xy window-draw-box ++ window-draw-box-xy window-xor-box-xy window-draw-box-corners ++ window-draw-rcbox-xy window-draw-arc-xy ++ window-draw-circle-xy window-draw-circle window-erase-area ++ window-erase-area-xy window-erase-box-xy ++ window-draw-ellipse-xy window-copy-area-xy window-invertarea ++ window-invert-area window-invert-area-xy ++ window-prettyprintat window-prettyprintat-xy window-printat ++ window-printat-xy window-string-width window-string-height ++ window-string-extents window-font-string-width ++ window-yposition window-centeroffset dowindowcom ++ window-menu window-close window-unmap window-open ++ window-map window-destroy window-destroy-selected-window ++ window-clear window-moveto-xy window-paint ++ window-move window-draw-border window-track-mouse ++ window-wait-exposure window-wait-unmap ++ window-init-mouse-poll window-poll-mouse menu-init ++ menu-calculate-size menu-adjust-offset menu-draw ++ menu-item-value menu-find-item-width menu-find-item-height ++ menu-clear menu-display-item menu-choose menu-box-item ++ menu-unbox-item menu-item-position menu-select ++ menu-select! menu-select-b menu-destroy ++ menu-create menu-offset menu-size menu-moveto-xy ++ menu-reposition picmenu-create picmenu-create-spec ++ picmenu-create-from-spec picmenu-calculate-size picmenu-init ++ picmenu-draw picmenu-draw-button picmenu-delete-named-button ++ picmenu-select picmenu-box-item picmenu-unbox-item ++ picmenu-destroy picmenu-button-containsxy? ++ picmenu-item-position barmenu-create ++ barmenu-calculate-size barmenu-init barmenu-draw ++ barmenu-select barmenu-update-value window-get-point ++ window-get-click window-get-line-position ++ window-get-latex-position window-get-box-position ++ window-get-icon-position window-get-region ++ window-get-box-size window-track-mouse-in-region ++ window-adjust-box-side window-adj-box-xy window-get-circle ++ window-circle-radius window-draw-circle-pt ++ window-get-ellipse window-draw-ellipse-pt ++ window-draw-vector-pt window-get-vector-end ++ window-get-crosshairs window-draw-crosshairs-xy ++ window-get-cross window-draw-cross-xy window-draw-dot-xy ++ window-draw-latex-xy window-reset-color ++ window-set-color-rgb window-set-xcolor window-set-color ++ window-set-color window-free-color window-get-chars ++ window-process-char-event window-input-string ++ window-input-char-fn window-draw-carat window-init-keymap ++ window-set-cursor window-positive-y window-code-char ++ window-get-raw-char ++ window-print-line window-print-lines textmenu-create ++ textmenu-calculate-size textmenu-init textmenu-draw ++ textmenu-select textmenu-set-text textmenu ++ editmenu editmenu-create editmenu-calculate-size ++ editmenu-init editmenu-draw editmenu-display ++ window-edit ++ window-edit-display editmenu-carat editmenu-erase ++ window-edit-erase editmenu-select editmenu-edit-fn ++ window-edit-fn editmenu-setxy editmenu-char ++ editmenu-edit ++ *window-editmenu-kill-strings* ++*window-add-menu-title* ++*window-menu* ++*mouse-x* ++*mouse-y* ++*mouse-window* ++*window-fonts* ++*window-display* ++*window-screen* ++*root-window* ++*black-pixel* ++*white-pixel* ++*default-fg-color* ++*default-bg-color* ++*default-size-hints* ++*default-GC* ++*default-colormap* ++*window-event* ++*window-default-pos-x* ++*window-default-pos-y* ++*window-default-border* ++*window-default-font-name* ++*window-default-cursor* ++*window-save-foreground* ++*window-save-function* ++*window-attributes* ++*window-attr* ++*menu-title-pad* ++*root-return* ++*child-return* ++*root-x-return* ++*root-y-return* ++*win-x-return* ++*win-y-return* ++*mask-return* ++*x-return* ++*y-return* ++*width-return* ++*height-return* ++*depth-return* ++*border-width-return* ++*text-width-return* ++*direction-return* ++*ascent-return* ++*descent-return* ++*overall-return* ++*GC-Values* ++*window-xcolor* ++*window-menu-code* ++ ++*window-keymap* ++*window-shiftkeymap* ++*window-keyinit* ++*window-meta* ++*window-ctrl* ++*window-shift* ++*window-string* ++*window-string-count* ++*window-string-max* ++*window-input-string-x* ++*window-input-string-y* ++*window-input-string-charwidth* ++ ++*window-shift-keys* ++*window-control-keys* ++*window-meta-keys* ++*barmenu-update-value-cons* ++*picmenu-no-selection* ++*min-keycodes-return* ++*max-keycodes-return* ++*keycodes-return* ++ )) ++ (export x)) ; export the above symbols ++ ++(DEFVAR *WINDOW-ADD-MENU-TITLE* NIL) ++ ++(DEFVAR *WINDOW-MENU* NIL) ++ ++(DEFVAR *MOUSE-X* NIL) ++ ++(DEFVAR *MOUSE-Y* NIL) ++ ++(DEFVAR *MOUSE-WINDOW* NIL) ++ ++(DEFVAR *WINDOW-FONTS* ++ (LIST (LIST 'COURIER-BOLD-12 ++ "*-*-courier-bold-r-*-*-12-*-*-*-*-*-iso8859-1") ++ (LIST 'COURIER-MEDIUM-12 ++ "*-*-courier-medium-r-*-*-12-*-*-*-*-*-iso8859-1") ++ (LIST '6X12 "6x12") (LIST '8X13 "8x13") ++ (LIST '9X15 "9x15"))) ++ ++ ++ ++(DEFVAR *WINDOW-DISPLAY* NIL) ++ ++(DEFVAR *WINDOW-SCREEN* NIL) ++ ++(DEFVAR *ROOT-WINDOW*) ++ ++(DEFVAR *BLACK-PIXEL*) ++ ++(DEFVAR *WHITE-PIXEL*) ++ ++(DEFVAR *DEFAULT-FG-COLOR*) ++ ++(DEFVAR *DEFAULT-BG-COLOR*) ++ ++(DEFVAR *DEFAULT-SIZE-HINTS*) ++ ++(DEFVAR *DEFAULT-GC*) ++ ++(DEFVAR *DEFAULT-COLORMAP*) ++ ++(DEFVAR *WINDOW-EVENT*) ++ ++(DEFVAR *WINDOW-DEFAULT-POS-X* 10) ++ ++(DEFVAR *WINDOW-DEFAULT-POS-Y* 20) ++ ++(DEFVAR *WINDOW-DEFAULT-BORDER* 1) ++ ++(DEFVAR *WINDOW-DEFAULT-FONT-NAME* 'COURIER-BOLD-12) ++ ++(DEFVAR *WINDOW-DEFAULT-CURSOR* 68) ++ ++(DEFVAR *WINDOW-SAVE-FOREGROUND*) ++ ++(DEFVAR *WINDOW-SAVE-FUNCTION*) ++ ++(DEFVAR *WINDOW-ATTRIBUTES*) ++ ++(DEFVAR *WINDOW-ATTR*) ++ ++(DEFVAR *MENU-TITLE-PAD* 30) ++ ++(DEFVAR *ROOT-RETURN* (FIXNUM-ARRAY 1)) ++ ++(DEFVAR *CHILD-RETURN* (FIXNUM-ARRAY 1)) ++ ++(DEFVAR *ROOT-X-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *ROOT-Y-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *WIN-X-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *WIN-Y-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *MASK-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *X-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *Y-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *WIDTH-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *HEIGHT-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *DEPTH-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *BORDER-WIDTH-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *TEXT-WIDTH-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *DIRECTION-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *ASCENT-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *DESCENT-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *OVERALL-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *GC-VALUES*) ++ ++(DEFVAR *WINDOW-XCOLOR* NIL) ++ ++(DEFVAR *WINDOW-MENU-CODE* NIL) ++ ++(DEFVAR *WINDOW-KEYMAP* (MAKE-ARRAY 256)) ++ ++(DEFVAR *WINDOW-SHIFTKEYMAP* (MAKE-ARRAY 256)) ++ ++(DEFVAR *WINDOW-KEYINIT* NIL) ++ ++(DEFVAR *WINDOW-META*) ++ ++(DEFVAR *WINDOW-CTRL*) ++ ++(DEFVAR *WINDOW-SHIFT*) ++ ++(DEFVAR *WINDOW-SHIFT-KEYS* NIL) ++ ++(DEFVAR *WINDOW-CONTROL-KEYS* NIL) ++ ++(DEFVAR *WINDOW-META-KEYS* NIL) ++ ++(DEFVAR *MIN-KEYCODES-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *MAX-KEYCODES-RETURN* (INT-ARRAY 1)) ++ ++(DEFVAR *KEYCODES-RETURN* (INT-ARRAY 1)) ++ ++(SETQ *WINDOW-KEYINIT* NIL) ++ ++(DEFMACRO PICMENU-SPEC (SYMBOL) (LIST 'GET SYMBOL ''PICMENU-SPEC)) ++ ++ ++ ++ ++ ++(DEFVAR *PICMENU-NO-SELECTION* '(NO-SELECTION (0 0) (0 0) NIL NIL)) ++ ++(DEFUN STRINGIFY (X) ++ (COND ++ ((STRINGP X) X) ++ ((SYMBOLP X) (COPY-SEQ (SYMBOL-NAME X))) ++ (T (PRINC-TO-STRING X)))) ++ ++(DEFUN WINDOW-XINIT () ++ (SETQ *WINDOW-DISPLAY* (XOPENDISPLAY (GET-C-STRING ""))) ++ (IF (OR (NOT (NUMBERP *WINDOW-DISPLAY*)) (< *WINDOW-DISPLAY* 10000)) ++ (ERROR "DISPLAY did not open: return value ~A~%" ++ *WINDOW-DISPLAY*)) ++ (SETQ *WINDOW-SCREEN* (XDEFAULTSCREEN *WINDOW-DISPLAY*)) ++ (SETQ *ROOT-WINDOW* (XROOTWINDOW *WINDOW-DISPLAY* *WINDOW-SCREEN*)) ++ (SETQ *BLACK-PIXEL* (XBLACKPIXEL *WINDOW-DISPLAY* *WINDOW-SCREEN*)) ++ (SETQ *WHITE-PIXEL* (XWHITEPIXEL *WINDOW-DISPLAY* *WINDOW-SCREEN*)) ++ (SETQ *DEFAULT-FG-COLOR* *BLACK-PIXEL*) ++ (SETQ *DEFAULT-BG-COLOR* *WHITE-PIXEL*) ++ (SETQ *DEFAULT-GC* (XDEFAULTGC *WINDOW-DISPLAY* *WINDOW-SCREEN*)) ++ (SETQ *DEFAULT-COLORMAP* ++ (XDEFAULTCOLORMAP *WINDOW-DISPLAY* *WINDOW-SCREEN*)) ++ (SETQ *WINDOW-ATTRIBUTES* (MAKE-XSETWINDOWATTRIBUTES)) ++ (SET-XSETWINDOWATTRIBUTES-BACKING_STORE *WINDOW-ATTRIBUTES* ++ WHENMAPPED) ++ (SET-XSETWINDOWATTRIBUTES-SAVE_UNDER *WINDOW-ATTRIBUTES* 1) ++ (SETQ *WINDOW-ATTR* (MAKE-XWINDOWATTRIBUTES)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (SETQ *DEFAULT-SIZE-HINTS* (MAKE-XSIZEHINTS)) ++ (SETQ *WINDOW-EVENT* (MAKE-XEVENT)) ++ (SETQ *GC-VALUES* (MAKE-XGCVALUES))) ++ ++(DEFUN WINDOW-GET-MOUSE-POSITION () ++ (XQUERYPOINTER *WINDOW-DISPLAY* *ROOT-WINDOW* *ROOT-RETURN* ++ *CHILD-RETURN* *ROOT-X-RETURN* *ROOT-Y-RETURN* *WIN-X-RETURN* ++ *WIN-Y-RETURN* *MASK-RETURN*) ++ (SETQ *MOUSE-X* (INT-POS *ROOT-X-RETURN* 0)) ++ (SETQ *MOUSE-Y* (INT-POS *ROOT-Y-RETURN* 0)) ++ (SETQ *MOUSE-WINDOW* (FIXNUM-POS *CHILD-RETURN* 0))) ++ ++ ++ ++(DEFUN WINDOW-CREATE ++ (WIDTH HEIGHT &OPTIONAL STR PARENTW POS-X POS-Y FONT) ++ (LET (W PW FG-COLOR BG-COLOR) ++ (OR *WINDOW-DISPLAY* (WINDOW-XINIT)) ++ (SETQ FG-COLOR *DEFAULT-FG-COLOR*) ++ (SETQ BG-COLOR *DEFAULT-BG-COLOR*) ++ (UNLESS POS-X (SETQ POS-X *WINDOW-DEFAULT-POS-X*)) ++ (UNLESS POS-Y (SETQ POS-Y *WINDOW-DEFAULT-POS-Y*)) ++ (SETQ W ++ (LIST 'WINDOW NIL NIL HEIGHT WIDTH ++ (IF STR (STRINGIFY STR) " ") NIL)) ++ (SETQ PW (OR PARENTW *ROOT-WINDOW*)) ++ (WINDOW-GET-GEOMETRY-B PW) ++ (SETF (CADR W) ++ (XCREATESIMPLEWINDOW *WINDOW-DISPLAY* PW POS-X ++ (- (- (INT-POS *HEIGHT-RETURN* 0) POS-Y) HEIGHT) WIDTH ++ HEIGHT *WINDOW-DEFAULT-BORDER* FG-COLOR BG-COLOR)) ++ (SET-XSIZEHINTS-X *DEFAULT-SIZE-HINTS* POS-X) ++ (SET-XSIZEHINTS-Y *DEFAULT-SIZE-HINTS* POS-Y) ++ (SET-XSIZEHINTS-WIDTH *DEFAULT-SIZE-HINTS* (FIFTH W)) ++ (SET-XSIZEHINTS-HEIGHT *DEFAULT-SIZE-HINTS* (CADDDR W)) ++ (SET-XSIZEHINTS-FLAGS *DEFAULT-SIZE-HINTS* 12) ++ (XSETSTANDARDPROPERTIES *WINDOW-DISPLAY* (CADR W) ++ (GET-C-STRING (SIXTH W)) (GET-C-STRING (SIXTH W)) 0 0 0 ++ *DEFAULT-SIZE-HINTS*) ++ (SETF (CADDR W) (XCREATEGC *WINDOW-DISPLAY* (CADR W) 0 0)) ++ (XSETFOREGROUND *WINDOW-DISPLAY* (CADDR W) FG-COLOR) ++ (XSETBACKGROUND *WINDOW-DISPLAY* (CADDR W) BG-COLOR) ++ (WINDOW-SET-FONT W (OR FONT *WINDOW-DEFAULT-FONT-NAME*)) ++ (LET (C) ++ (SETQ C ++ (XCREATEFONTCURSOR *WINDOW-DISPLAY* ++ *WINDOW-DEFAULT-CURSOR*)) ++ (XDEFINECURSOR *WINDOW-DISPLAY* (CADR W) C)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0) ++ (XCHANGEWINDOWATTRIBUTES *WINDOW-DISPLAY* (CADR W) 1088 ++ *WINDOW-ATTRIBUTES*) ++ (XSELECTINPUT *WINDOW-DISPLAY* (CADR W) 32876) ++ (XMAPWINDOW *WINDOW-DISPLAY* (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-EXPOSURE W) ++ W)) ++ ++(DEFUN WINDOW-SET-FONT (W FONTSYMBOL) ++ (LET (FONTSTRING FONT-INFO) ++ (SETQ FONTSTRING ++ (OR (CADR (ASSOC FONTSYMBOL *WINDOW-FONTS*)) ++ (STRINGIFY FONTSYMBOL))) ++ (SETQ FONT-INFO ++ (XLOADQUERYFONT *WINDOW-DISPLAY* (GET-C-STRING FONTSTRING))) ++ (IF (ZEROP FONT-INFO) ++ (FORMAT T "~%can't open font ~a ~a~%" FONTSYMBOL FONTSTRING) ++ (PROGN ++ (XSETFONT *WINDOW-DISPLAY* (CADDR W) ++ (XFONTSTRUCT-FID FONT-INFO)) ++ (SETF (SEVENTH W) FONT-INFO))))) ++ ++(DEFUN WINDOW-FONT-INFO (FONTSYMBOL) ++ (XLOADQUERYFONT *WINDOW-DISPLAY* ++ (GET-C-STRING ++ (OR (CADR (ASSOC FONTSYMBOL *WINDOW-FONTS*)) ++ (STRINGIFY FONTSYMBOL))))) ++ ++(DEFUN WINDOW-GCONTEXT (W) (CADDR W)) ++ ++(DEFUN WINDOW-PARENT (W) (CADR W)) ++ ++(DEFUN WINDOW-DRAWABLE-HEIGHT (W) (CADDDR W)) ++ ++(DEFUN WINDOW-DRAWABLE-WIDTH (W) (FIFTH W)) ++ ++(DEFUN WINDOW-LABEL (W) (SIXTH W)) ++ ++(DEFUN WINDOW-FONT (W) (SEVENTH W)) ++ ++(DEFUN WINDOW-FOREGROUND (W) ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*)) ++ ++(DEFUN WINDOW-SET-FOREGROUND (W FG-COLOR) ++ (XSETFOREGROUND *WINDOW-DISPLAY* (CADDR W) FG-COLOR)) ++ ++(DEFUN WINDOW-BACKGROUND (W) ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*)) ++ ++(DEFUN WINDOW-SET-BACKGROUND (W BG-COLOR) ++ (XSETBACKGROUND *WINDOW-DISPLAY* (CADDR W) BG-COLOR)) ++ ++(DEFUN WINDOW-WFUNCTION (W) ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*)) ++ ++(DEFUN WINDOW-GET-GEOMETRY (W) (WINDOW-GET-GEOMETRY-B (CADR W))) ++ ++(DEFUN WINDOW-SET-CURSOR (W N) ++ (LET (C) ++ (SETQ C (XCREATEFONTCURSOR *WINDOW-DISPLAY* N)) ++ (XDEFINECURSOR *WINDOW-DISPLAY* (CADR W) C))) ++ ++(DEFUN WINDOW-GET-GEOMETRY-B (W) ++ (XGETGEOMETRY *WINDOW-DISPLAY* W *ROOT-RETURN* *X-RETURN* *Y-RETURN* ++ *WIDTH-RETURN* *HEIGHT-RETURN* *BORDER-WIDTH-RETURN* ++ *DEPTH-RETURN*)) ++ ++(DEFUN WINDOW-SYNC (W) (declare (ignore w)) (XSYNC *WINDOW-DISPLAY* 1)) ++ ++(DEFUN WINDOW-SCREEN-HEIGHT () ++ (WINDOW-GET-GEOMETRY-B *ROOT-WINDOW*) ++ (INT-POS *HEIGHT-RETURN* 0)) ++ ++(DEFUN WINDOW-GEOMETRY (W) ++ (LET (SH) ++ (SETQ SH (WINDOW-SCREEN-HEIGHT)) ++ (WINDOW-GET-GEOMETRY-B (CADR W)) ++ (SETF (FIFTH W) (INT-POS *WIDTH-RETURN* 0)) ++ (SETF (CADDDR W) (INT-POS *HEIGHT-RETURN* 0)) ++ (LIST (INT-POS *X-RETURN* 0) ++ (- (- SH (INT-POS *Y-RETURN* 0)) (INT-POS *HEIGHT-RETURN* 0)) ++ (INT-POS *WIDTH-RETURN* 0) (INT-POS *HEIGHT-RETURN* 0) ++ (INT-POS *BORDER-WIDTH-RETURN* 0)))) ++ ++(DEFUN WINDOW-SIZE (W) ++ (WINDOW-GET-GEOMETRY-B (CADR W)) ++ (LIST (SETF (FIFTH W) (INT-POS *WIDTH-RETURN* 0)) ++ (SETF (CADDDR W) (INT-POS *HEIGHT-RETURN* 0)))) ++ ++(DEFUN WINDOW-LEFT (W) ++ (WINDOW-GET-GEOMETRY-B (CADR W)) ++ (INT-POS *X-RETURN* 0)) ++ ++(DEFUN WINDOW-TOP-NEG-Y (W) ++ (WINDOW-GET-GEOMETRY-B (CADR W)) ++ (INT-POS *Y-RETURN* 0)) ++ ++(DEFUN WINDOW-RESET-GEOMETRY (W) ++ (WINDOW-GET-GEOMETRY-B (CADR W)) ++ (SETF (FIFTH W) (INT-POS *WIDTH-RETURN* 0)) ++ (SETF (CADDDR W) (INT-POS *HEIGHT-RETURN* 0))) ++ ++(DEFUN WINDOW-FORCE-OUTPUT (&OPTIONAL W) (declare (ignore w)) (XFLUSH *WINDOW-DISPLAY*)) ++ ++(DEFUN WINDOW-QUERY-POINTER (W) (WINDOW-QUERY-POINTER-B (CADR W))) ++ ++(DEFUN WINDOW-QUERY-POINTER-B (W) ++ (XQUERYPOINTER *WINDOW-DISPLAY* W *ROOT-RETURN* *CHILD-RETURN* ++ *ROOT-X-RETURN* *ROOT-Y-RETURN* *WIN-X-RETURN* *WIN-Y-RETURN* ++ *MASK-RETURN*)) ++ ++(DEFUN WINDOW-POSITIVE-Y (W Y) (- (CADDDR W) Y)) ++ ++(DEFUN WINDOW-SET-XOR (W) ++ (LET ((GC (CADDR W))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (LOGXOR *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*)))))) ++ ++(DEFUN WINDOW-UNSET (W) ++ (LET ((GC (CADDR W))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) ++ ++(DEFUN WINDOW-RESET (W) ++ (LET ((GC (CADDR W))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 3) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *DEFAULT-FG-COLOR*) ++ (XSETBACKGROUND *WINDOW-DISPLAY* GC *DEFAULT-BG-COLOR*))) ++ ++(DEFUN WINDOW-SET-ERASE (W) ++ (LET ((GC (CADDR W))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 3) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*))))) ++ ++(DEFUN WINDOW-SET-COPY (W) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* (CADDR W) 3) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*)))) ++ ++(DEFUN WINDOW-SET-INVERT (W) ++ (LET ((GC (CADDR W))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (LOGXOR *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*)))))) ++ ++(DEFUN WINDOW-SET-LINE-WIDTH (W WIDTH) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR WIDTH 1) 0 1 0)) ++ ++(DEFUN WINDOW-SET-LINE-ATTR ++ (W WIDTH &OPTIONAL LINE-STYLE CAP-STYLE JOIN-STYLE) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR WIDTH 1) ++ (OR LINE-STYLE 0) (OR CAP-STYLE 1) (OR JOIN-STYLE 0))) ++ ++(DEFUN WINDOW-STD-LINE-ATTR (W) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) ++ ++(DEFUN WINDOW-DRAW-LINE (W FROM TO &OPTIONAL LINEWIDTH) ++ (WINDOW-DRAW-LINE-XY W (CAR FROM) (CADR FROM) (CAR TO) (CADR TO) ++ LINEWIDTH)) ++ ++(DEFUN WINDOW-DRAW-LINE-XY ++ (W FROMX FROMY TOX TOY &OPTIONAL LINEWIDTH OPERATION) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) ++ 0 1 0)) ++ (CASE OPERATION ++ (XOR (LET ((GC (CADDR W))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 ++ *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 ++ *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (LOGXOR *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*)))))) ++ (ERASE (LET ((GC (CADDR W))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 ++ *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 3) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 ++ *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*))))) ++ (T)) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) FROMX ++ (- QQWHEIGHT FROMY) TOX (- QQWHEIGHT TOY)) ++ (CASE OPERATION ++ ((XOR ERASE) ++ (LET ((GC (CADDR W))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) ++ (T)) ++ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)))) ++ ++(DEFUN WINDOW-DRAW-ARROWHEAD-XY ++ (W X1 Y1 X2 Y2 &OPTIONAL (LINEWIDTH 1) SIZE) ++ (LET (TH THETA YSTH YCTH (Y2DELA 0) (Y2DELB 0) (X2DELA 0) (X2DELB 0)) ++ (OR SIZE (SETQ SIZE (+ 20 (* LINEWIDTH 5)))) ++ (SETQ TH (ATAN (- Y2 Y1) (- X2 X1))) ++ (SETQ THETA (* TH (/ 180.0 PI))) ++ (SETQ YSTH (ROUND (* (1+ SIZE) (SIN TH)))) ++ (SETQ YCTH (ROUND (* (1+ SIZE) (COS TH)))) ++ (IF (AND (EQL Y1 Y2) (EVENP LINEWIDTH)) ++ (IF (> X2 X1) (SETQ Y2DELB 1) (SETQ Y2DELA 1))) ++ (IF (AND (EQL X1 X2) (EVENP LINEWIDTH)) ++ (IF (> Y2 Y1) (SETQ X2DELB 1) (SETQ X2DELA 1))) ++ (WINDOW-DRAW-ARC-XY W (- (- X2 YSTH) X2DELA) (+ (+ Y2 YCTH) Y2DELA) ++ SIZE SIZE (+ 240 THETA) 30 LINEWIDTH) ++ (WINDOW-DRAW-ARC-XY W (- (+ X2 YSTH) X2DELB) (+ (- Y2 YCTH) Y2DELB) ++ SIZE SIZE (+ 90 THETA) 30 LINEWIDTH))) ++ ++(DEFUN WINDOW-DRAW-ARROW-XY ++ (W X1 Y1 X2 Y2 &OPTIONAL (LINEWIDTH 1) SIZE) ++ (WINDOW-DRAW-LINE-XY W X1 Y1 X2 Y2 LINEWIDTH) ++ (WINDOW-DRAW-ARROWHEAD-XY W X1 Y1 X2 Y2 LINEWIDTH SIZE)) ++ ++(DEFUN WINDOW-DRAW-ARROW2-XY ++ (W X1 Y1 X2 Y2 &OPTIONAL (LINEWIDTH 1) SIZE) ++ (WINDOW-DRAW-LINE-XY W X1 Y1 X2 Y2 LINEWIDTH) ++ (WINDOW-DRAW-ARROWHEAD-XY W X1 Y1 X2 Y2 LINEWIDTH SIZE) ++ (WINDOW-DRAW-ARROWHEAD-XY W X2 Y2 X1 Y1 LINEWIDTH SIZE)) ++ ++(DEFUN WINDOW-DRAW-BOX (W OFFSET SIZE &OPTIONAL LINEWIDTH) ++ (WINDOW-DRAW-BOX-XY W (CAR OFFSET) (CADR OFFSET) (CAR SIZE) ++ (CADR SIZE) LINEWIDTH)) ++ ++(DEFUN WINDOW-DRAW-BOX-XY ++ (W OFFSETX OFFSETY SIZEX SIZEY &OPTIONAL LINEWIDTH) ++ (LET ((QQWHEIGHT (CADDDR W)) LW LW2 LW2B (PW (CADR W)) ++ (GC (CADDR W))) ++ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) ++ 0 1 0)) ++ (SETQ LW (OR LINEWIDTH 1)) ++ (SETQ LW2 (TRUNCATE LW 2)) ++ (SETQ LW2B (TRUNCATE (1+ LW) 2)) ++ (XDRAWLINE *WINDOW-DISPLAY* PW GC (- OFFSETX LW2) ++ (- QQWHEIGHT OFFSETY) (- (+ OFFSETX SIZEX) LW2) ++ (- QQWHEIGHT OFFSETY)) ++ (XDRAWLINE *WINDOW-DISPLAY* PW GC (+ OFFSETX SIZEX) ++ (- QQWHEIGHT (- OFFSETY LW2B)) (+ OFFSETX SIZEX) ++ (- QQWHEIGHT (+ SIZEY (- OFFSETY LW2B)))) ++ (XDRAWLINE *WINDOW-DISPLAY* PW GC (+ OFFSETX SIZEX LW2B) ++ (- QQWHEIGHT (+ OFFSETY SIZEY)) (+ OFFSETX LW2B) ++ (- QQWHEIGHT (+ OFFSETY SIZEY))) ++ (XDRAWLINE *WINDOW-DISPLAY* PW GC OFFSETX ++ (- QQWHEIGHT (+ OFFSETY SIZEY LW2)) OFFSETX ++ (- QQWHEIGHT (+ OFFSETY LW2))) ++ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)))) ++ ++(DEFUN WINDOW-XOR-BOX-XY ++ (W OFFSETX OFFSETY SIZEX SIZEY &OPTIONAL LINEWIDTH) ++ (WINDOW-SET-XOR W) ++ (WINDOW-DRAW-BOX-XY W OFFSETX OFFSETY SIZEX SIZEY LINEWIDTH) ++ (WINDOW-UNSET W)) ++ ++(DEFUN WINDOW-DRAW-BOX-CORNERS (W XA YA XB YB &OPTIONAL LW) ++ (WINDOW-DRAW-BOX-XY W (MIN XA XB) (MIN YA YB) (ABS (- XA XB)) ++ (ABS (- YA YB)) LW)) ++ ++(DEFUN WINDOW-DRAW-RCBOX-XY ++ (W X Y WIDTH HEIGHT RADIUS &OPTIONAL LINEWIDTH) ++ (LET (X1 X2 Y1 Y2 R LW2 LW2B FUDGE) ++ (SETQ R ++ (MAX 0 ++ (MIN RADIUS (TRUNCATE (ABS WIDTH) 2) ++ (TRUNCATE (ABS HEIGHT) 2)))) ++ (IF (NOT (NUMBERP LINEWIDTH)) (SETQ LINEWIDTH 1)) ++ (SETQ LW2 (TRUNCATE LINEWIDTH 2)) ++ (SETQ LW2B (TRUNCATE (1+ LINEWIDTH) 2)) ++ (SETQ FUDGE (IF (ODDP LINEWIDTH) 0 1)) ++ (SETQ X1 (+ X R)) ++ (SETQ X2 (- (+ X WIDTH) R)) ++ (SETQ Y1 (+ Y R)) ++ (SETQ Y2 (- (+ Y HEIGHT) R)) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) ++ (OR LINEWIDTH 1) 0 1 0)) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (- (1- X1) LW2) ++ (- QQWHEIGHT Y) X2 (- QQWHEIGHT Y)) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) ++ (OR LINEWIDTH 1) 0 1 0)) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ X WIDTH) ++ (- QQWHEIGHT (- Y1 LW2B)) (+ X WIDTH) (- QQWHEIGHT (1+ Y2))) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) ++ (OR LINEWIDTH 1) 0 1 0)) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (1- X1) ++ (- QQWHEIGHT (+ Y HEIGHT)) (+ X2 LW2) ++ (- QQWHEIGHT (+ Y HEIGHT))) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) ++ (OR LINEWIDTH 1) 0 1 0)) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) X (- QQWHEIGHT Y1) ++ X (- QQWHEIGHT (1+ Y2))) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) ++ 0 1 0)) ++ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- (- X1 FUDGE) R) ++ (- (CADDDR W) (+ Y1 R)) (* 2 R) (* 2 R) 11520 5760) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) ++ 0 1 0)) ++ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- X2 R) ++ (- (CADDDR W) (+ Y1 R)) (* 2 R) (* 2 R) 17280 5760) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) ++ 0 1 0)) ++ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- X2 R) ++ (- (CADDDR W) (+ (+ Y2 FUDGE) R)) (* 2 R) (* 2 R) 0 5760) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) ++ 0 1 0)) ++ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- (- X1 FUDGE) R) ++ (- (CADDDR W) (+ (+ Y2 FUDGE) R)) (* 2 R) (* 2 R) 5760 5760) ++ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)))) ++ ++(DEFUN WINDOW-DRAW-ARC-XY ++ (W X Y RADIUSX RADIUSY ANGLEA ANGLEB &OPTIONAL LINEWIDTH) ++ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) 0 ++ 1 0)) ++ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- X RADIUSX) ++ (- (CADDDR W) (+ Y RADIUSY)) (* 2 RADIUSX) (* 2 RADIUSY) ++ (TRUNCATE (* 64 ANGLEA)) (TRUNCATE (* 64 ANGLEB))) ++ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) ++ ++(DEFUN WINDOW-DRAW-CIRCLE-XY (W X Y RADIUS &OPTIONAL LINEWIDTH) ++ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) 0 ++ 1 0)) ++ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- X RADIUS) ++ (- (CADDDR W) (+ Y RADIUS)) (* 2 RADIUS) (* 2 RADIUS) 0 23040) ++ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) ++ ++(DEFUN WINDOW-DRAW-CIRCLE (W POS RADIUS &OPTIONAL LINEWIDTH) ++ (WINDOW-DRAW-CIRCLE-XY W (CAR POS) (CADR POS) RADIUS LINEWIDTH)) ++ ++(DEFUN WINDOW-ERASE-AREA (W OFFSET SIZE) ++ (WINDOW-ERASE-AREA-XY W (CAR OFFSET) (CADR OFFSET) (CAR SIZE) ++ (CADR SIZE))) ++ ++(DEFUN WINDOW-ERASE-AREA-XY (W XOFF YOFF XSIZE YSIZE) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) XOFF ++ (- (CADDDR W) (1- (+ YOFF YSIZE))) XSIZE YSIZE 0)) ++ ++(DEFUN WINDOW-ERASE-BOX-XY ++ (W XOFF YOFF XSIZE YSIZE &OPTIONAL LINEWIDTH) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) ++ (- XOFF (TRUNCATE (OR LINEWIDTH 1) 2)) ++ (- (CADDDR W) (+ YOFF YSIZE (TRUNCATE (OR LINEWIDTH 1) 2))) ++ (+ XSIZE (OR LINEWIDTH 1)) (+ YSIZE (OR LINEWIDTH 1)) 0)) ++ ++(DEFUN WINDOW-DRAW-ELLIPSE-XY (W X Y RX RY &OPTIONAL LW) ++ (IF (AND LW (NOT (EQL LW 1))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LW 1) 0 1 0)) ++ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- X RX) ++ (- (CADDDR W) (+ Y RY)) (* 2 RX) (* 2 RY) 0 23040) ++ (IF (AND LW (NOT (EQL LW 1))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) ++ ++(DEFUN WINDOW-COPY-AREA-XY (W FROMX FROMY TOX TOY WIDTH HEIGHT) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* (CADDR W) 3) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XCOPYAREA *WINDOW-DISPLAY* (CADR W) (CADR W) (CADDR W) FROMX ++ (- QQWHEIGHT (+ FROMY HEIGHT)) WIDTH HEIGHT TOX ++ (- QQWHEIGHT (+ TOY HEIGHT))) ++ (LET ((GC (CADDR W))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)))) ++ ++(DEFUN WINDOW-INVERTAREA (W AREA) ++ (WINDOW-INVERT-AREA-XY W (CAAR AREA) (CADAR AREA) (CAADR AREA) ++ (CADADR AREA))) ++ ++(DEFUN WINDOW-INVERT-AREA (W OFFSET SIZE) ++ (WINDOW-INVERT-AREA-XY W (CAR OFFSET) (CADR OFFSET) (CAR SIZE) ++ (CADR SIZE))) ++ ++(DEFUN WINDOW-INVERT-AREA-XY (W LEFT BOTTOM WIDTH HEIGHT) ++ (LET ((GC (CADDR W))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (LOGXOR *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*))))) ++ (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR W) (CADDR W) LEFT ++ (- (CADDDR W) (1- (+ BOTTOM HEIGHT))) WIDTH HEIGHT) ++ (LET ((GC (CADDR W))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) ++ ++(DEFUN WINDOW-PRETTYPRINTAT (W S POS) ++ (LET ((SSTR (STRINGIFY S))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) (CAR POS) ++ (- (CADDDR W) (CADR POS)) (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ ++(DEFUN WINDOW-PRETTYPRINTAT-XY (W S X Y) ++ (LET ((SSTR (STRINGIFY S))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) X ++ (- (CADDDR W) Y) (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ ++(DEFUN WINDOW-PRINTAT (W S POS) ++ (LET ((SSTR (STRINGIFY S))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) (CAR POS) ++ (- (CADDDR W) (CADR POS)) (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ ++(DEFUN WINDOW-PRINTAT-XY (W S X Y) ++ (LET ((SSTR (STRINGIFY S))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) X ++ (- (CADDDR W) Y) (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ ++(DEFUN WINDOW-PRINT-LINE (W STR X Y &OPTIONAL DELTAY) ++ (LET ((N 0) END STRB DONE) ++ (WHILE (NOT DONE) ++ (SETQ END (POSITION #\Newline STR :TEST #'CHAR= :START N)) ++ (SETQ STRB (SUBSEQ STR N END)) ++ (LET ((SSTR (STRINGIFY STRB))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) X ++ (- (CADDDR W) Y) (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (IF (NUMBERP END) (SETQ N (1+ END)) (SETQ DONE T)) ++ (DECF Y (OR DELTAY 16)) (IF (MINUSP Y) (SETQ DONE T))) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN WINDOW-PRINT-LINES (W LINES X Y &OPTIONAL DELTAY) ++ (DOLIST (STR LINES) ++ (WHEN (PLUSP Y) ++ (LET ((SSTR (STRINGIFY STR))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) X ++ (- (CADDDR W) Y) (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (DECF Y (OR DELTAY 16))))) ++ ++(DEFUN WINDOW-STRING-WIDTH (W S) ++ (LET ((SSTR (STRINGIFY S))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ ++(DEFUN WINDOW-STRING-EXTENTS (W S) ++ (LET ((SSTR (STRINGIFY S))) ++ (XTEXTEXTENTS (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR) ++ *DIRECTION-RETURN* *ASCENT-RETURN* *DESCENT-RETURN* ++ *OVERALL-RETURN*) ++ (LIST (INT-POS *ASCENT-RETURN* 0) (INT-POS *DESCENT-RETURN* 0)))) ++ ++(DEFUN WINDOW-STRING-HEIGHT (W S) ++ (LET ((SSTR (STRINGIFY S))) ++ (XTEXTEXTENTS (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR) ++ *DIRECTION-RETURN* *ASCENT-RETURN* *DESCENT-RETURN* ++ *OVERALL-RETURN*) ++ (+ (INT-POS *ASCENT-RETURN* 0) (INT-POS *DESCENT-RETURN* 0)))) ++ ++(DEFUN WINDOW-FONT-STRING-WIDTH (FONT S) ++ (LET ((SSTR (STRINGIFY S))) ++ (XTEXTWIDTH FONT (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ ++(DEFUN WINDOW-YPOSITION (W) ++ (WINDOW-GET-MOUSE-POSITION) ++ (- (CADDDR W) ++ (- *MOUSE-Y* ++ (PROGN ++ (WINDOW-GET-GEOMETRY-B (CADR W)) ++ (INT-POS *Y-RETURN* 0))))) ++ ++(DEFUN WINDOW-CENTEROFFSET (W V) ++ (LIST (TRUNCATE (- (FIFTH W) (CAR V)) 2) ++ (TRUNCATE (- (CADDDR W) (CADR V)) 2))) ++ ++(DEFUN DOWINDOWCOM (W) ++ (LET (COMM) ++ (SETQ COMM (MENU-SELECT (WINDOW-MENU))) ++ (CASE COMM ++ (CLOSE (XUNMAPWINDOW *WINDOW-DISPLAY* (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*) (WINDOW-WAIT-UNMAP W)) ++ (PAINT (WINDOW-PAINT W)) ++ (CLEAR (XCLEARWINDOW *WINDOW-DISPLAY* (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*)) ++ (MOVE (WINDOW-MOVE W)) ++ (T (WHEN COMM (PRINC "This command not implemented.") (TERPRI)))))) ++ ++(DEFUN WINDOW-MENU () ++ (OR *WINDOW-MENU* ++ (SETQ *WINDOW-MENU* ++ (LIST 'MENU (COPY-LIST '(WINDOW NIL NIL 0 0 "" NIL)) NIL ++ NIL 0 0 0 0 "" NIL NIL 0 '(CLOSE PAINT CLEAR MOVE))))) ++ ++(DEFUN WINDOW-CLOSE (W) ++ (XUNMAPWINDOW *WINDOW-DISPLAY* (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-UNMAP W)) ++ ++(DEFUN WINDOW-UNMAP (W) (XUNMAPWINDOW *WINDOW-DISPLAY* (CADR W))) ++ ++(DEFUN WINDOW-OPEN (W) ++ (XMAPWINDOW *WINDOW-DISPLAY* (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-EXPOSURE W)) ++ ++(DEFUN WINDOW-MAP (W) (XMAPWINDOW *WINDOW-DISPLAY* (CADR W))) ++ ++(DEFUN WINDOW-DESTROY (W) ++ (XDESTROYWINDOW *WINDOW-DISPLAY* (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (SETF (CADR W) NIL) ++ (XFREEGC *WINDOW-DISPLAY* (CADDR W)) ++ (SETF (CADDR W) NIL)) ++ ++(DEFUN WINDOW-DESTROY-SELECTED-WINDOW () ++ (PROG (WW CHILD) ++ (SLEEP 3) ++ (SETQ WW *ROOT-WINDOW*) ++ LP ++ (WINDOW-QUERY-POINTER-B WW) ++ (SETQ CHILD (FIXNUM-POS *CHILD-RETURN* 0)) ++ (IF (> CHILD 0) (PROGN (SETQ WW CHILD) (GO LP))) ++ (IF (/= WW *ROOT-WINDOW*) ++ (PROGN ++ (XDESTROYWINDOW *WINDOW-DISPLAY* WW) ++ (XFLUSH *WINDOW-DISPLAY*))))) ++ ++(DEFUN WINDOW-CLEAR (W) ++ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*)) ++ ++(DEFUN WINDOW-MOVETO-XY (W X Y) ++ (XMOVEWINDOW *WINDOW-DISPLAY* (CADR W) X ++ (- (WINDOW-SCREEN-HEIGHT) Y))) ++ ++(DEFUN WINDOW-PAINT (WINDOW) ++ (LET (STATE) ++ (WINDOW-TRACK-MOUSE WINDOW ++ #'(LAMBDA (X Y CODE) ++ (IF (= CODE 1) ++ (IF (= STATE 1) (SETQ STATE 0) (SETQ STATE 1)) ++ (IF (= CODE 2) ++ (IF (= STATE 2) (SETQ STATE 0) (SETQ STATE 2)))) ++ (IF (= STATE 1) ++ (WINDOW-DRAW-LINE-XY WINDOW X Y X Y 1 'PAINT) ++ (IF (= STATE 2) ++ (WINDOW-DRAW-LINE-XY WINDOW X Y X Y 1 'ERASE))) ++ (= CODE 3))))) ++ ++(DEFUN WINDOW-MOVE (W) ++ (WINDOW-GET-MOUSE-POSITION) ++ (XMOVEWINDOW *WINDOW-DISPLAY* (CADR W) *MOUSE-X* ++ (- (WINDOW-SCREEN-HEIGHT) *MOUSE-Y*))) ++ ++(DEFUN WINDOW-DRAW-BORDER (W) ++ (WINDOW-DRAW-BOX-XY W 0 1 (1- (CAR (WINDOW-SIZE W))) ++ (1- (CADR (WINDOW-SIZE W)))) ++ (XFLUSH *WINDOW-DISPLAY*)) ++ ++(DEFUN WINDOW-TRACK-MOUSE (W FN &OPTIONAL OUTFLG) ++ (LET (WIN H) ++ (SETQ WIN (WINDOW-PARENT W)) ++ (SETQ H (WINDOW-DRAWABLE-HEIGHT W)) ++ (XSYNC *WINDOW-DISPLAY* 1) ++ (XSELECTINPUT *WINDOW-DISPLAY* WIN ++ (+ BUTTONPRESSMASK POINTERMOTIONMASK)) ++ (DO ((RES NIL)) (RES RES) ++ (XNEXTEVENT *WINDOW-DISPLAY* *WINDOW-EVENT*) ++ (LET ((TYPE (XANYEVENT-TYPE *WINDOW-EVENT*)) ++ (EVENTWINDOW (XANYEVENT-WINDOW *WINDOW-EVENT*))) ++ (WHEN (OR (AND (EQL EVENTWINDOW WIN) ++ (OR (EQL TYPE MOTIONNOTIFY) ++ (EQL TYPE BUTTONPRESS))) ++ (AND OUTFLG (EQL TYPE BUTTONPRESS))) ++ (LET ((X (XMOTIONEVENT-X *WINDOW-EVENT*)) ++ (Y (XMOTIONEVENT-Y *WINDOW-EVENT*)) ++ (CODE (IF (EQL TYPE BUTTONPRESS) ++ (XBUTTONEVENT-BUTTON *WINDOW-EVENT*) 0))) ++ (SETQ RES ++ (IF (EQL EVENTWINDOW WIN) (FUNCALL FN X (- H Y) CODE) ++ (FUNCALL FN -1 -1 CODE))))))))) ++ ++(DEFUN WINDOW-WAIT-EXPOSURE (W) ++ (PROG (WIN START-TIME MAX-TIME EVENTWINDOW TYPE) ++ (SETQ WIN (WINDOW-PARENT W)) ++ (XGETWINDOWATTRIBUTES *WINDOW-DISPLAY* WIN *WINDOW-ATTR*) ++ (UNLESS (EQL (XWINDOWATTRIBUTES-MAP_STATE *WINDOW-ATTR*) ++ ISUNMAPPED) ++ (RETURN T)) ++ (SETQ START-TIME (GET-INTERNAL-REAL-TIME)) ++ (SETQ MAX-TIME INTERNAL-TIME-UNITS-PER-SECOND) ++ (XSELECTINPUT *WINDOW-DISPLAY* WIN (+ EXPOSUREMASK)) ++ LP ++ (COND ++ ((> (XPENDING *WINDOW-DISPLAY*) 0) ++ (XNEXTEVENT *WINDOW-DISPLAY* *WINDOW-EVENT*) ++ (SETQ TYPE (XANYEVENT-TYPE *WINDOW-EVENT*)) ++ (SETQ EVENTWINDOW (XANYEVENT-WINDOW *WINDOW-EVENT*)) ++ (IF (AND (EQL EVENTWINDOW WIN) (EQL TYPE EXPOSE)) (RETURN T))) ++ ((> (- (GET-INTERNAL-REAL-TIME) START-TIME) MAX-TIME) ++ (RETURN NIL))) ++ (GO LP))) ++ ++(DEFUN WINDOW-WAIT-UNMAP (W) ++ (PROG (WIN START-TIME MAX-TIME) ++ (SETQ WIN (WINDOW-PARENT W)) ++ (SETQ START-TIME (GET-INTERNAL-REAL-TIME)) ++ (SETQ MAX-TIME INTERNAL-TIME-UNITS-PER-SECOND) ++ LP ++ (XGETWINDOWATTRIBUTES *WINDOW-DISPLAY* WIN *WINDOW-ATTR*) ++ (IF (EQL (XWINDOWATTRIBUTES-MAP_STATE *WINDOW-ATTR*) ISUNMAPPED) ++ (RETURN T) ++ (IF (> (- (GET-INTERNAL-REAL-TIME) START-TIME) MAX-TIME) ++ (RETURN NIL))) ++ (GO LP))) ++ ++(DEFUN WINDOW-INIT-MOUSE-POLL (W) ++ (LET (WIN) ++ (SETQ WIN (WINDOW-PARENT W)) ++ (XSYNC *WINDOW-DISPLAY* 1) ++ (XSELECTINPUT *WINDOW-DISPLAY* WIN ++ (+ BUTTONPRESSMASK POINTERMOTIONMASK)))) ++ ++(DEFUN WINDOW-POLL-MOUSE (W) ++ (LET (WIN H EVENTTYPE EVENTWINDOW X Y CD (CODE 0)) ++ (SETQ WIN (WINDOW-PARENT W)) ++ (SETQ H (WINDOW-DRAWABLE-HEIGHT W)) ++ (WHILE (> (XPENDING *WINDOW-DISPLAY*) 0) ++ (XNEXTEVENT *WINDOW-DISPLAY* *WINDOW-EVENT*) ++ (SETQ EVENTTYPE (XANYEVENT-TYPE *WINDOW-EVENT*)) ++ (SETQ EVENTWINDOW (XANYEVENT-WINDOW *WINDOW-EVENT*)) ++ (IF (EQL EVENTWINDOW WIN) ++ (IF (EQL EVENTTYPE MOTIONNOTIFY) ++ (PROGN ++ (SETQ X (XMOTIONEVENT-X *WINDOW-EVENT*)) ++ (SETQ Y (XMOTIONEVENT-Y *WINDOW-EVENT*))) ++ (IF (EQL EVENTTYPE BUTTONPRESS) ++ (IF (> (SETQ CD ++ (XBUTTONEVENT-BUTTON ++ *WINDOW-EVENT*)) ++ 0) ++ (SETQ CODE CD)))))) ++ (IF (OR X (> CODE 0)) (LIST X (IF Y (- H Y)) CODE)))) ++ ++(DEFUN MENU-INIT (M) ++ (OR *WINDOW-DISPLAY* (WINDOW-XINIT)) ++ (MENU-CALCULATE-SIZE M) ++ (IF (NOT (CADDR M)) ++ (SETF (CADR M) ++ (WINDOW-CREATE (SEVENTH M) (EIGHTH M) (OR (NINTH M) "") ++ (CADDDR M) (FIFTH M) (SIXTH M) (NTH 10 M))))) ++ ++(DEFUN MENU-CALCULATE-SIZE (M) ++ (LET (MAXWIDTH TOTALHEIGHT NITEMS) ++ (OR (NTH 10 M) (SETF (NTH 10 M) '9X15)) ++ (SETQ MAXWIDTH ++ (+ (MENU-FIND-ITEM-WIDTH M (NINTH M)) ++ (IF (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*) 0 ++ *MENU-TITLE-PAD*))) ++ (SETQ NITEMS ++ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) ++ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) ++ 1 0)) ++ (SETQ TOTALHEIGHT (* 13 NITEMS)) ++ (DOLIST (ITEM (NTH 12 M)) ++ (INCF NITEMS) ++ (SETQ MAXWIDTH (MAX MAXWIDTH (MENU-FIND-ITEM-WIDTH M ITEM))) ++ (INCF TOTALHEIGHT (MENU-FIND-ITEM-HEIGHT M ITEM))) ++ (SETF (NTH 11 M) (+ 6 MAXWIDTH)) ++ (SETF (SEVENTH M) (1+ (NTH 11 M))) ++ (SETF (EIGHTH M) (+ 2 TOTALHEIGHT)) ++ (MENU-ADJUST-OFFSET M))) ++ ++(DEFUN MENU-ADJUST-OFFSET (M) ++ (LET (XBASE YBASE WBASE HBASE XOFF YOFF WGM WIDTH HEIGHT) ++ (SETQ WIDTH (SEVENTH M)) ++ (SETQ HEIGHT (EIGHTH M)) ++ (WHEN (NOT (CADDDR M)) ++ (WINDOW-GET-MOUSE-POSITION) ++ (SETQ WGM T) ++ (SETF (CADDDR M) *ROOT-WINDOW*)) ++ (WINDOW-GET-GEOMETRY-B (CADDDR M)) ++ (SETQ XBASE (INT-POS *X-RETURN* 0)) ++ (SETQ YBASE (INT-POS *Y-RETURN* 0)) ++ (SETQ WBASE (INT-POS *WIDTH-RETURN* 0)) ++ (SETQ HBASE (INT-POS *HEIGHT-RETURN* 0)) ++ (IF (OR (NOT (FIFTH M)) (ZEROP (FIFTH M))) ++ (PROGN ++ (OR WGM (WINDOW-GET-MOUSE-POSITION)) ++ (SETQ XOFF (+ -4 (- (- *MOUSE-X* XBASE) (TRUNCATE WIDTH 2)))) ++ (SETQ YOFF ++ (- (- HBASE (- *MOUSE-Y* YBASE)) (TRUNCATE HEIGHT 2)))) ++ (PROGN (SETQ XOFF (FIFTH M)) (SETQ YOFF (SIXTH M)))) ++ (SETF (FIFTH M) (MAX 0 (MIN XOFF (- WBASE WIDTH)))) ++ (SETF (SIXTH M) (MAX 0 (MIN YOFF (- HBASE HEIGHT)))))) ++ ++(DEFUN MENU-DRAW (M) ++ (LET (MW XZERO YZERO BOTTOM) ++ (OR (AND (CADR M) (PLUSP (EIGHTH M))) (MENU-INIT M)) ++ (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) ++ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) ++ (SETQ MW (CADR M)) ++ (XMAPWINDOW *WINDOW-DISPLAY* (CADR MW)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-EXPOSURE MW) ++ (MENU-CLEAR M) ++ (IF (CADDR M) ++ (WINDOW-DRAW-BOX-XY MW (1- XZERO) YZERO (+ 2 (SEVENTH M)) ++ (1+ (EIGHTH M)) 1)) ++ (SETQ BOTTOM (+ 3 (+ YZERO (EIGHTH M)))) ++ (WHEN (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) ++ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) ++ (INCF BOTTOM -15) ++ (LET ((SSTR (STRINGIFY (STRINGIFY (NINTH M))))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) (CADDR MW) ++ (+ 3 XZERO) (- (CADDDR MW) BOTTOM) (GET-C-STRING SSTR) ++ (LENGTH SSTR))) ++ (LET ((GC (CADDR MW))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 ++ *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 ++ *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (LOGXOR *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*))))) ++ (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR MW) (CADDR MW) XZERO ++ (+ -12 (- (CADDDR MW) BOTTOM)) (1+ (SEVENTH M)) 15) ++ (LET ((GC (CADDR MW))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) ++ (DOLIST (ITEM (NTH 12 M)) ++ (DECF BOTTOM (MENU-FIND-ITEM-HEIGHT M ITEM)) ++ (MENU-DISPLAY-ITEM M ITEM (+ 3 XZERO) BOTTOM)) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN MENU-ITEM-VALUE (SELF ITEM) (declare (ignore self)) (IF (CONSP ITEM) (CDR ITEM) ITEM)) ++ ++(DEFUN MENU-FIND-ITEM-WIDTH (SELF ITEM) ++ (LET (TMP) ++ (IF (AND (CONSP ITEM) (SYMBOLP (CAR ITEM)) (FBOUNDP (CAR ITEM))) ++ (OR (AND (SETQ TMP (GET (CAR ITEM) 'DISPLAY-SIZE)) (CAR TMP)) ++ 40) ++ (WINDOW-FONT-STRING-WIDTH ++ (OR (AND (CADDR SELF) (CADR SELF) (SEVENTH (CADR SELF))) ++ (WINDOW-FONT-INFO (NTH 10 SELF))) ++ (STRINGIFY (IF (CONSP ITEM) (CAR ITEM) ITEM)))))) ++ ++(DEFUN MENU-FIND-ITEM-HEIGHT (SELF ITEM) ++ (declare (ignore self)) ++ (LET (TMP) ++ (IF (AND (CONSP ITEM) (SYMBOLP (CAR ITEM)) ++ (SETQ TMP (GET (CAR ITEM) 'DISPLAY-SIZE))) ++ (+ 3 (CADR TMP)) 15))) ++ ++(DEFUN MENU-CLEAR (M) ++ (IF (CADDR M) ++ (LET ((GLVAR386 (+ 3 (EIGHTH M)))) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADADR M) ++ (1- (IF (CADDR M) (FIFTH M) 0)) ++ (- (CADDDR (CADR M)) ++ (1- (+ (1- (IF (CADDR M) (SIXTH M) 0)) GLVAR386))) ++ (+ 3 (SEVENTH M)) GLVAR386 0)) ++ (PROGN ++ (XCLEARWINDOW *WINDOW-DISPLAY* (CADADR M)) ++ (XFLUSH *WINDOW-DISPLAY*)))) ++ ++(DEFUN MENU-DISPLAY-ITEM (SELF ITEM X Y) ++ (LET ((MW (CADR SELF))) ++ (IF (CONSP ITEM) ++ (IF (AND (SYMBOLP (CAR ITEM)) (FBOUNDP (CAR ITEM))) ++ (FUNCALL (CAR ITEM) MW X Y) ++ (IF (OR (STRINGP (CAR ITEM)) (SYMBOLP (CAR ITEM)) ++ (NUMBERP (CAR ITEM))) ++ (LET ((SSTR (STRINGIFY (CAR ITEM)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) ++ (CADDR MW) X (- (CADDDR MW) Y) ++ (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (LET ((SSTR (STRINGIFY (STRINGIFY ITEM)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) ++ (CADDR MW) X (- (CADDDR MW) Y) ++ (GET-C-STRING SSTR) (LENGTH SSTR))))) ++ (LET ((SSTR (STRINGIFY (STRINGIFY ITEM)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) (CADDR MW) X ++ (- (CADDDR MW) Y) (GET-C-STRING SSTR) (LENGTH SSTR)))))) ++ ++(DEFUN MENU-CHOOSE (M INSIDE) ++ (LET (MW CURRENT-ITEM YBASE ITEMH VAL MAXX MAXY XZERO YZERO) ++ (OR (AND (CADR M) (PLUSP (EIGHTH M))) (MENU-INIT M)) ++ (SETQ MW (CADR M)) ++ (MENU-DRAW M) ++ (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) ++ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) ++ (SETQ MAXX (+ XZERO (SEVENTH M))) ++ (SETQ MAXY (+ YZERO (EIGHTH M))) ++ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) ++ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) ++ (INCF MAXY -15)) ++ (WINDOW-TRACK-MOUSE MW ++ #'(LAMBDA (X Y CODE) ++ (SETQ *WINDOW-MENU-CODE* CODE) ++ (IF (AND (>= X XZERO) (<= X MAXX) (>= Y YZERO) (<= Y MAXY)) ++ (IF (OR (NULL CURRENT-ITEM) (< Y YBASE) ++ (> Y (+ YBASE ITEMH))) ++ (PROGN ++ (IF CURRENT-ITEM ++ (MENU-BOX-ITEM M CURRENT-ITEM YBASE)) ++ (SETQ CURRENT-ITEM ++ (MENU-FIND-ITEM-Y M (- Y YZERO))) ++ (WHEN CURRENT-ITEM ++ (SETQ YBASE (MENU-ITEM-Y M CURRENT-ITEM)) ++ (SETQ ITEMH ++ (MENU-FIND-ITEM-HEIGHT M CURRENT-ITEM)) ++ (MENU-BOX-ITEM M CURRENT-ITEM YBASE) ++ (SETQ INSIDE T)) ++ (WHEN (PLUSP CODE) ++ (MENU-BOX-ITEM M CURRENT-ITEM YBASE) ++ (SETQ VAL 1))) ++ (WHEN (PLUSP CODE) ++ (MENU-BOX-ITEM M CURRENT-ITEM YBASE) ++ (SETQ VAL 1))) ++ (PROGN ++ (WHEN CURRENT-ITEM ++ (MENU-BOX-ITEM M CURRENT-ITEM YBASE) ++ (SETQ CURRENT-ITEM NIL)) ++ (IF (OR (PLUSP CODE) ++ (AND INSIDE ++ (OR (< X XZERO) (> X MAXX) (< Y YZERO) ++ (> Y MAXY)))) ++ (SETQ VAL -777))))) ++ T) ++ (IF (NOT (EQL VAL -777)) ++ (IF (CONSP CURRENT-ITEM) (CDR CURRENT-ITEM) CURRENT-ITEM)))) ++ ++(DEFUN MENU-BOX-ITEM (M ITEM YBASE) ++ (LET ((MW (OR (CADR M) (MENU-INIT M)))) ++ (LET ((GC (CADDR MW))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (LOGXOR *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*))))) ++ (WINDOW-DRAW-BOX-XY MW (1+ (IF (CADDR M) (FIFTH M) 0)) ++ (+ 2 (+ (IF (CADDR M) (SIXTH M) 0) YBASE)) (+ -2 (NTH 11 M)) ++ (MENU-FIND-ITEM-HEIGHT M ITEM) 1) ++ (LET ((GC (CADDR MW))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)))) ++ ++(DEFUN MENU-UNBOX-ITEM (M ITEM YBASE) (MENU-BOX-ITEM M ITEM YBASE)) ++ ++(DEFUN MENU-ITEM-POSITION (M ITEMNAME &OPTIONAL PLACE) ++ (LET ((XSIZE (NTH 11 M)) YBASE ITEM YSIZE) ++ (SETQ ITEM (MENU-FIND-ITEM M ITEMNAME)) ++ (SETQ YSIZE (MENU-FIND-ITEM-HEIGHT M ITEM)) ++ (SETQ YBASE (MENU-ITEM-Y M ITEM)) ++ (LIST (+ (IF (CADDR M) (FIFTH M) 0) ++ (CASE PLACE ++ ((CENTER TOP BOTTOM) (TRUNCATE XSIZE 2)) ++ (LEFT -1) ++ (RIGHT (+ 2 XSIZE)) ++ (T 0))) ++ (+ (+ (IF (CADDR M) (SIXTH M) 0) YBASE) ++ (CASE PLACE ++ ((CENTER RIGHT LEFT) (TRUNCATE YSIZE 2)) ++ (BOTTOM 0) ++ (TOP YSIZE) ++ (T 0)))))) ++ ++(DEFUN MENU-FIND-ITEM (M ITEMNAME) ++ (LET (FOUND ITMS ITEM) ++ (SETQ ITMS (NTH 12 M)) ++ (SETQ FOUND (NULL ITEMNAME)) ++ (WHILE (AND ITMS (NOT FOUND)) (SETQ ITEM (POP ITMS)) ++ (IF (OR (EQ ITEM ITEMNAME) ++ (AND (CONSP ITEM) ++ (OR (EQ ITEMNAME (CAR ITEM)) ++ (AND (STRINGP (CAR ITEM)) ++ (STRING= (STRINGIFY ITEMNAME) ++ (CAR ITEM))) ++ (EQ (CDR ITEM) ITEMNAME) ++ (AND (CONSP (CDR ITEM)) ++ (EQ (CADR ITEM) ITEMNAME))))) ++ (SETQ FOUND T))) ++ ITEM)) ++ ++(DEFUN MENU-ITEM-Y (M ITEM) ++ (LET (FOUND ITMS ITM YBASE) ++ (SETQ YBASE (1- (EIGHTH M))) ++ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) ++ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) ++ (INCF YBASE -15)) ++ (SETQ ITMS (NTH 12 M)) ++ (WHILE (AND ITMS (NOT FOUND)) (SETQ ITM (POP ITMS)) ++ (DECF YBASE (MENU-FIND-ITEM-HEIGHT M ITM)) ++ (SETQ FOUND (EQ ITEM ITM))) ++ YBASE)) ++ ++(DEFUN MENU-FIND-ITEM-Y (M Y) ++ (LET (FOUND ITMS ITM YBASE) ++ (SETQ YBASE (1- (EIGHTH M))) ++ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) ++ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) ++ (INCF YBASE -15)) ++ (SETQ ITMS (NTH 12 M)) ++ (WHILE (AND ITMS (NOT FOUND)) (SETQ ITM (POP ITMS)) ++ (DECF YBASE (MENU-FIND-ITEM-HEIGHT M ITM)) ++ (SETQ FOUND ++ (AND (>= Y YBASE) ++ (<= Y (+ YBASE (MENU-FIND-ITEM-HEIGHT M ITM)))))) ++ (AND FOUND ITM))) ++ ++(DEFUN MENU-SELECT (M &OPTIONAL INSIDE) (MENU-SELECT-B M NIL INSIDE)) ++ ++(DEFUN MENU-SELECT! (M) (MENU-SELECT-B M T NIL)) ++ ++(DEFUN MENU-SELECT-B (M FLG INSIDE) ++ (PROG (RES) ++ LP ++ (SETQ RES (MENU-CHOOSE M INSIDE)) ++ (IF (AND FLG (NOT RES)) (GO LP)) ++ (IF (NOT (TENTH M)) ++ (IF (CADDR M) (PROGN (MENU-CLEAR M) (XFLUSH *WINDOW-DISPLAY*)) ++ (PROGN ++ (XUNMAPWINDOW *WINDOW-DISPLAY* (CADADR M)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-UNMAP (CADR M))))) ++ (RETURN RES))) ++ ++(DEFUN MENU-DESTROY (M) ++ (WHEN (NOT (CADDR M)) ++ (XDESTROYWINDOW *WINDOW-DISPLAY* (CADADR M)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (SETF (CADADR M) NIL) ++ (XFREEGC *WINDOW-DISPLAY* (CADDR (CADR M))) ++ (SETF (CADDR (CADR M)) NIL) ++ (SETF (CADR M) NIL))) ++ ++(DEFUN MENU (ITEMS &OPTIONAL TITLE) ++ (LET (M RES) ++ (SETQ M (MENU-CREATE ITEMS TITLE)) ++ (SETQ RES (MENU-SELECT M)) ++ (MENU-DESTROY M) ++ RES)) ++ ++ ++ ++(DEFUN MENU-CREATE (ITEMS &OPTIONAL TITLE PARENTW X Y PERM FLAT FONT) ++ (LIST 'MENU (IF FLAT PARENTW) FLAT (CADR PARENTW) X Y 0 0 ++ (IF TITLE (STRINGIFY TITLE) "") PERM FONT 0 ITEMS)) ++ ++(DEFUN MENU-OFFSET (M) ++ (LIST (IF (CADDR M) (FIFTH M) 0) (IF (CADDR M) (SIXTH M) 0))) ++ ++(DEFUN MENU-SIZE (M) ++ (IF (<= (SEVENTH M) 0) ++ (CASE (FIRST M) ++ (PICMENU (PICMENU-CALCULATE-SIZE M)) ++ (BARMENU (BARMENU-CALCULATE-SIZE M)) ++ (TEXTMENU (TEXTMENU-CALCULATE-SIZE M)) ++ (EDITMENU (EDITMENU-CALCULATE-SIZE M)) ++ (T (MENU-CALCULATE-SIZE M)))) ++ (LIST (SEVENTH M) (EIGHTH M))) ++ ++(DEFUN MENU-MOVETO-XY (M X Y) ++ (WHEN (CADDR M) ++ (SETF (FIFTH M) X) ++ (SETF (SIXTH M) Y) ++ (MENU-ADJUST-OFFSET M))) ++ ++(DEFUN MENU-REPOSITION (M) ++ (LET (SIZEV POS) ++ (WHEN (CADDR M) ++ (SETQ SIZEV (MENU-SIZE M)) ++ (SETQ POS ++ (WINDOW-GET-BOX-POSITION (CADR M) (CAR SIZEV) (CADR SIZEV))) ++ (MENU-MOVETO-XY M (CAR POS) (CADR POS))))) ++ ++(DEFUN MENU-REPOSITION-LINE (M OFFSET TARGET) ++ (LET (SIZEV POS) ++ (WHEN (CADDR M) ++ (SETQ SIZEV (MENU-SIZE M)) ++ (SETQ POS ++ (WINDOW-GET-BOX-LINE-POSITION (CADR M) (CAR SIZEV) ++ (CADR SIZEV) (CAR OFFSET) (CADR OFFSET) (CAR TARGET) ++ (CADR TARGET))) ++ (MENU-MOVETO-XY M (CAR POS) (CADR POS))))) ++ ++ ++ ++(DEFUN PICMENU-CREATE ++ (BUTTONS WIDTH HEIGHT DRAWFN &OPTIONAL TITLE DOTFLG PARENTW X Y ++ PERM FLAT FONT BOXFLG) ++ (PICMENU-CREATE-FROM-SPEC ++ (PICMENU-CREATE-SPEC BUTTONS WIDTH HEIGHT DRAWFN DOTFLG FONT) ++ TITLE PARENTW X Y PERM FLAT BOXFLG)) ++ ++ ++ ++(DEFUN PICMENU-CREATE-SPEC ++ (BUTTONS WIDTH HEIGHT DRAWFN &OPTIONAL DOTFLG FONT) ++ (LIST 'PICMENU-SPEC WIDTH HEIGHT BUTTONS DOTFLG DRAWFN ++ (OR FONT '9X15))) ++ ++ ++ ++(DEFUN PICMENU-CREATE-FROM-SPEC ++ (SPEC &OPTIONAL TITLE PARENTW X Y PERM FLAT BOXFLG) ++ (LIST 'PICMENU (IF FLAT PARENTW) FLAT (IF PARENTW (CADR PARENTW)) X Y ++ 0 0 (IF TITLE (STRINGIFY TITLE) "") PERM SPEC BOXFLG NIL NIL)) ++ ++(DEFUN PICMENU-CALCULATE-SIZE (M) ++ (LET (MAXWIDTH MAXHEIGHT) ++ (SETQ MAXWIDTH ++ (MAX (IF (NINTH M) (+ 6 (* 9 (LENGTH (NINTH M)))) 0) ++ (CADR (NTH 10 M)))) ++ (SETQ MAXHEIGHT ++ (+ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) ++ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) ++ 15 0) ++ (CADDR (NTH 10 M)))) ++ (SETF (SEVENTH M) MAXWIDTH) ++ (SETF (EIGHTH M) MAXHEIGHT))) ++ ++(DEFUN PICMENU-INIT (M) ++ (PICMENU-CALCULATE-SIZE M) ++ (MENU-ADJUST-OFFSET M) ++ (IF (NOT (CADDR M)) ++ (SETF (CADR M) ++ (WINDOW-CREATE (SEVENTH M) (EIGHTH M) (OR (NINTH M) "") ++ (CADDDR M) (FIFTH M) (SIXTH M) (SEVENTH (NTH 10 M)))))) ++ ++(DEFUN PICMENU-DRAW (M) ++ (LET (MW BOTTOM XZERO YZERO) ++ (OR (AND (CADR M) (PLUSP (EIGHTH M))) (PICMENU-INIT M)) ++ (SETQ MW (CADR M)) ++ (XMAPWINDOW *WINDOW-DISPLAY* (CADR MW)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-EXPOSURE MW) ++ (MENU-CLEAR M) ++ (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) ++ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) ++ (SETQ BOTTOM (+ YZERO (EIGHTH M))) ++ (WHEN (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) ++ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) ++ (LET ((SSTR (STRINGIFY (STRINGIFY (NINTH M))))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) (CADDR MW) ++ (+ 3 XZERO) (+ 13 (- (CADDDR MW) BOTTOM)) ++ (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (LET ((GC (CADDR MW))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 ++ *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 ++ *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (LOGXOR *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*))))) ++ (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR MW) (CADDR MW) XZERO ++ (- (CADDDR MW) BOTTOM) (SEVENTH M) 16) ++ (LET ((GC (CADDR MW))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) ++ (FUNCALL (SIXTH (NTH 10 M)) MW XZERO YZERO) ++ (IF (NTH 11 M) ++ (WINDOW-DRAW-BOX-XY MW XZERO YZERO (SEVENTH M) (EIGHTH M) 1)) ++ (IF (FIFTH (NTH 10 M)) ++ (DOLIST (B (CADDDR (NTH 10 M))) (PICMENU-DRAW-BUTTON M B))) ++ (SETF (NTH 12 M) NIL) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN PICMENU-DRAW-NAMED-BUTTON (M NM) ++ (PICMENU-DRAW-BUTTON M (ASSOC NM (CADDDR (NTH 10 M))))) ++ ++(DEFUN PICMENU-SET-NAMED-BUTTON-COLOR (M NM COLOR) ++ (LET (LST) ++ (IF (SETQ LST (ASSOC NM (NTH 13 M))) (SETF (CADR LST) COLOR) ++ (PUSH (LIST NM COLOR) (NTH 13 M))))) ++ ++(DEFUN PICMENU-DRAW-BUTTON (M B) ++ (LET ((MW (CADR M)) COL) ++ (LET ((GC (CADDR MW))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (LOGXOR *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*))))) ++ (WINDOW-DRAW-BOX-XY MW ++ (+ -2 (+ (IF (CADDR M) (FIFTH M) 0) (CAADR B))) ++ (+ -2 (+ (IF (CADDR M) (SIXTH M) 0) (CADADR B))) 4 4 1) ++ (LET ((GC (CADDR MW))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)) ++ (WHEN (SETQ COL (ASSOC (CAR B) (NTH 13 M))) ++ (WINDOW-SET-COLOR-RGB MW (CAADR COL) (CADADR COL) ++ (CADDR (CADR COL))) ++ (WINDOW-DRAW-BOX-XY MW ++ (1- (+ (IF (CADDR M) (FIFTH M) 0) (CAADR B))) ++ (1- (+ (IF (CADDR M) (SIXTH M) 0) (CADADR B))) 3 3 2) ++ (WINDOW-RESET-COLOR MW)))) ++ ++(DEFUN PICMENU-DELETE-NAMED-BUTTON (M NAME) ++ (LET (B) ++ (WHEN (AND (SETQ B (ASSOC NAME (CADDDR (NTH 10 M)))) ++ (NOT (MEMBER NAME (NTH 12 M) :TEST #'EQUAL))) ++ (IF (FIFTH (NTH 10 M)) (PICMENU-DRAW-BUTTON M B)) ++ (PUSH NAME (NTH 12 M))) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN PICMENU-SELECT (M &OPTIONAL INSIDE ANYCLICK) ++ (LET (MW CURRENT-BUTTON ITEM ITEMS VAL XZERO YZERO CODEVAL) ++ (SETQ MW (OR (CADR M) (PICMENU-INIT M))) ++ (IF (NOT (TENTH M)) (PICMENU-DRAW M)) ++ (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) ++ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) ++ (WINDOW-TRACK-MOUSE MW ++ #'(LAMBDA (X Y CODE) ++ (SETQ *WINDOW-MENU-CODE* CODE) ++ (DECF X XZERO) ++ (DECF Y YZERO) ++ (IF (AND (>= X 0) (<= X (SEVENTH M)) (>= Y 0) ++ (<= Y (EIGHTH M))) ++ (SETQ INSIDE T)) ++ (IF CURRENT-BUTTON ++ (WHEN (NOT (PICMENU-BUTTON-CONTAINSXY? CURRENT-BUTTON X ++ Y)) ++ (PICMENU-UNBOX-ITEM M CURRENT-BUTTON) ++ (SETQ CURRENT-BUTTON NIL))) ++ (WHEN (NOT CURRENT-BUTTON) ++ (SETQ ITEMS (CADDDR (NTH 10 M))) ++ (WHILE (AND (NOT CURRENT-BUTTON) (SETQ ITEM (POP ITEMS))) ++ (WHEN (AND (PICMENU-BUTTON-CONTAINSXY? ITEM X Y) ++ (NOT (MEMBER (CAR ITEM) (NTH 12 M) ++ :TEST #'EQUAL))) ++ (PICMENU-BOX-ITEM M ITEM) ++ (SETQ CURRENT-BUTTON ITEM)))) ++ (WHEN (OR (PLUSP CODE) ++ (AND INSIDE ++ (OR (MINUSP X) (> X (SEVENTH M)) (MINUSP Y) ++ (> Y (EIGHTH M))))) ++ (IF CURRENT-BUTTON (PICMENU-UNBOX-ITEM M CURRENT-BUTTON)) ++ (SETQ CODEVAL CODE) ++ (SETQ VAL ++ (IF (AND (PLUSP CODE) CURRENT-BUTTON) ++ CURRENT-BUTTON *PICMENU-NO-SELECTION*)))) ++ T) ++ (IF (NOT (TENTH M)) ++ (IF (CADDR M) (PROGN (MENU-CLEAR M) (XFLUSH *WINDOW-DISPLAY*)) ++ (PROGN ++ (XUNMAPWINDOW *WINDOW-DISPLAY* (CADADR M)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-UNMAP (CADR M))))) ++ (IF (EQUAL VAL *PICMENU-NO-SELECTION*) ++ (AND (PLUSP CODEVAL) ANYCLICK) (CAR VAL)))) ++ ++(DEFUN PICMENU-BOX-ITEM (M ITEM) ++ (LET ((MW (OR (CADR M) (PICMENU-INIT M))) XOFF YOFF SIZ) ++ (SETQ XOFF (+ (IF (CADDR M) (FIFTH M) 0) (CAADR ITEM))) ++ (SETQ YOFF (+ (IF (CADDR M) (SIXTH M) 0) (CADADR ITEM))) ++ (IF (CADDDR ITEM) ++ (FUNCALL (CADDDR ITEM) (OR (CADR M) (PICMENU-INIT M)) XOFF ++ YOFF) ++ (PROGN ++ (LET ((GC (CADDR MW))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 ++ *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 ++ *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (LOGXOR *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*))))) ++ (IF (SETQ SIZ (CADDR ITEM)) ++ (WINDOW-DRAW-BOX-XY MW (- XOFF (TRUNCATE (CAR SIZ) 2)) ++ (- YOFF (TRUNCATE (CADR SIZ) 2)) (CAR SIZ) (CADR SIZ) ++ 1) ++ (WINDOW-DRAW-BOX-XY MW (+ -6 XOFF) (+ -6 YOFF) 12 12 1)) ++ (LET ((GC (CADDR MW))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ *WINDOW-SAVE-FOREGROUND*)) ++ (XFLUSH *WINDOW-DISPLAY*))))) ++ ++(DEFUN PICMENU-UNBOX-ITEM (M ITEM) ++ (IF (FIFTH ITEM) ++ (PROGN ++ (FUNCALL (FIFTH ITEM) (OR (CADR M) (PICMENU-INIT M)) ++ (CAADR ITEM) (CADADR ITEM)) ++ (XFLUSH *WINDOW-DISPLAY*)) ++ (PICMENU-BOX-ITEM M ITEM))) ++ ++(DEFUN PICMENU-DESTROY (M) (MENU-DESTROY M)) ++ ++(DEFUN PICMENU-BUTTON-CONTAINSXY? (B X Y) ++ (LET ((XSIZE 6) (YSIZE 6)) ++ (WHEN (CADDR B) ++ (SETQ XSIZE (TRUNCATE (CAADDR B) 2)) ++ (SETQ YSIZE (TRUNCATE (CADR (CADDR B)) 2))) ++ (AND (>= X (- (CAADR B) XSIZE)) (<= X (+ (CAADR B) XSIZE)) ++ (>= Y (- (CADADR B) YSIZE)) (<= Y (+ (CADADR B) YSIZE))))) ++ ++(DEFUN PICMENU-ITEM-POSITION (M ITEMNAME &OPTIONAL PLACE) ++ (LET (B (XSIZE 0) (YSIZE 0) XOFF YOFF) ++ (IF (NULL ITEMNAME) ++ (PROGN ++ (SETQ XSIZE (SEVENTH M)) ++ (SETQ YSIZE (TRUNCATE (- (EIGHTH M) (CADDR (NTH 10 M))) 2)) ++ (SETQ XOFF (TRUNCATE XSIZE 2)) ++ (SETQ YOFF (+ (CADDR (NTH 10 M)) (TRUNCATE YSIZE 2)))) ++ (WHEN (SETQ B (ASSOC ITEMNAME (CADDDR (NTH 10 M)))) ++ (WHEN (CADDR B) ++ (SETQ XSIZE (CAADDR B)) ++ (SETQ YSIZE (CADR (CADDR B)))) ++ (SETQ XOFF (CAADR B)) ++ (SETQ YOFF (CADADR B)))) ++ (IF XOFF ++ (LIST (+ (+ (IF (CADDR M) (FIFTH M) 0) XOFF) ++ (CASE PLACE ++ ((CENTER TOP BOTTOM) 0) ++ (LEFT (- (TRUNCATE XSIZE 2))) ++ (RIGHT (TRUNCATE XSIZE 2)) ++ (T 0))) ++ (+ (+ (IF (CADDR M) (SIXTH M) 0) YOFF) ++ (CASE PLACE ++ ((CENTER RIGHT LEFT) 0) ++ (BOTTOM (- (TRUNCATE YSIZE 2))) ++ (TOP (TRUNCATE YSIZE 2)) ++ (T 0))))))) ++ ++ ++ ++(DEFUN BARMENU-CREATE ++ (MAXVAL INITVAL BARWIDTH &OPTIONAL TITLE HORIZONTAL SUBTRACKFN ++ SUBTRACKPARMS PARENTW X Y PERM FLAT COLOR) ++ (LIST 'BARMENU (IF FLAT PARENTW) FLAT (IF PARENTW (CADR PARENTW)) ++ (OR X 0) (OR Y 0) 0 0 (IF TITLE (STRINGIFY TITLE) "") PERM ++ COLOR INITVAL MAXVAL BARWIDTH HORIZONTAL SUBTRACKFN ++ SUBTRACKPARMS)) ++ ++(DEFUN BARMENU-CALCULATE-SIZE (M) ++ (LET (MAXWIDTH MAXHEIGHT) ++ (SETQ MAXWIDTH ++ (MAX (IF (NINTH M) (+ 6 (* 9 (LENGTH (NINTH M)))) 0) ++ (NTH 13 M))) ++ (SETQ MAXHEIGHT ++ (+ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) ++ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) ++ 15 0) ++ (NTH 12 M))) ++ (SETF (SEVENTH M) MAXWIDTH) ++ (SETF (EIGHTH M) MAXHEIGHT))) ++ ++(DEFUN BARMENU-INIT (M) ++ (BARMENU-CALCULATE-SIZE M) ++ (MENU-ADJUST-OFFSET M) ++ (IF (NOT (CADDR M)) ++ (SETF (CADR M) ++ (WINDOW-CREATE (SEVENTH M) (EIGHTH M) (OR (NINTH M) "") ++ (CADDDR M) (FIFTH M) (SIXTH M))))) ++ ++(DEFUN BARMENU-DRAW (M) ++ (LET (MW XZERO YZERO) ++ (OR (AND (CADR M) (PLUSP (EIGHTH M))) (BARMENU-INIT M)) ++ (SETQ MW (CADR M)) ++ (XMAPWINDOW *WINDOW-DISPLAY* (CADR MW)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-EXPOSURE MW) ++ (MENU-CLEAR M) ++ (SETQ XZERO ++ (+ (IF (CADDR M) (FIFTH M) 0) (TRUNCATE (SEVENTH M) 2))) ++ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) ++ (IF (NTH 10 M) (WINDOW-SET-COLOR MW (NTH 10 M))) ++ (IF (NTH 14 M) ++ (LET ((QQWHEIGHT (CADDDR (CADR M)))) ++ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) ++ (OR (NTH 13 M) 1) 0 1 0)) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADADR M) (CADDR (CADR M)) XZERO ++ (- QQWHEIGHT YZERO) (+ XZERO (NTH 11 M)) ++ (- QQWHEIGHT YZERO)) ++ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) 1 0 ++ 1 0))) ++ (LET ((QQWHEIGHT (CADDDR (CADR M)))) ++ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) ++ (OR (NTH 13 M) 1) 0 1 0)) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADADR M) (CADDR (CADR M)) XZERO ++ (- QQWHEIGHT YZERO) XZERO ++ (- QQWHEIGHT (+ YZERO (NTH 11 M)))) ++ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) 1 0 ++ 1 0)))) ++ (IF (NTH 10 M) (WINDOW-RESET-COLOR MW)) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN BARMENU-SELECT (M &OPTIONAL INSIDE) ++ (declare (ignore inside)) ++ (LET (MW XZERO YZERO VAL) ++ (SETQ MW (OR (CADR M) (BARMENU-INIT M))) ++ (IF (NOT (TENTH M)) (BARMENU-DRAW M)) ++ (SETQ XZERO ++ (+ (IF (CADDR M) (FIFTH M) 0) (TRUNCATE (SEVENTH M) 2))) ++ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) ++ (WHEN (WINDOW-TRACK-MOUSE-IN-REGION MW (IF (CADDR M) (FIFTH M) 0) ++ YZERO (SEVENTH M) (EIGHTH M) T T) ++ (WINDOW-TRACK-MOUSE MW ++ #'(LAMBDA (X Y CODE) ++ (SETQ *WINDOW-MENU-CODE* CODE) ++ (SETQ VAL (IF (NTH 14 M) (- X XZERO) (- Y YZERO))) ++ (BARMENU-UPDATE-VALUE M VAL) ++ (IF (PLUSP CODE) CODE))) ++ VAL))) ++ ++(DEFVAR *BARMENU-UPDATE-VALUE-CONS* (CONS NIL NIL)) ++ ++(DEFUN BARMENU-UPDATE-VALUE (M VAL) ++ (LET ((MW (OR (CADR M) (BARMENU-INIT M))) XZERO YZERO) ++ (SETQ VAL (MAX 0 (MIN VAL (NTH 12 M)))) ++ (WHEN (/= VAL (NTH 11 M)) ++ (IF (< VAL (NTH 11 M)) ++ (LET ((GC (CADDR MW))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 ++ *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 3) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 ++ *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*)))) ++ (IF (NTH 10 M) (WINDOW-SET-COLOR MW (NTH 10 M)))) ++ (SETQ XZERO ++ (+ (IF (CADDR M) (FIFTH M) 0) (TRUNCATE (SEVENTH M) 2))) ++ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) ++ (IF (NTH 14 M) ++ (LET ((QQWHEIGHT (CADDDR (CADR M)))) ++ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) ++ (OR (NTH 13 M) 1) 0 1 0)) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADADR M) (CADDR (CADR M)) ++ (+ XZERO (NTH 11 M)) (- QQWHEIGHT YZERO) (+ XZERO VAL) ++ (- QQWHEIGHT YZERO)) ++ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) 1 ++ 0 1 0))) ++ (LET ((QQWHEIGHT (CADDDR (CADR M)))) ++ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) ++ (OR (NTH 13 M) 1) 0 1 0)) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADADR M) (CADDR (CADR M)) ++ XZERO (- QQWHEIGHT (+ YZERO (NTH 11 M))) XZERO ++ (- QQWHEIGHT (+ YZERO VAL))) ++ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) 1 ++ 0 1 0)))) ++ (IF (< VAL (NTH 11 M)) ++ (LET ((GC (CADDR MW))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ *WINDOW-SAVE-FOREGROUND*)) ++ (IF (NTH 10 M) (WINDOW-RESET-COLOR MW))) ++ (SETF (NTH 11 M) VAL) ++ (WHEN (NTH 15 M) ++ (SETF (CAR *BARMENU-UPDATE-VALUE-CONS*) VAL) ++ (SETF (CDR *BARMENU-UPDATE-VALUE-CONS*) (NTH 16 M)) ++ (APPLY (NTH 15 M) *BARMENU-UPDATE-VALUE-CONS*)) ++ (XFLUSH *WINDOW-DISPLAY*)))) ++ ++ ++ ++(DEFUN TEXTMENU-CREATE ++ (WIDTH HEIGHT &OPTIONAL TITLE PARENTW X Y PERM FLAT FONT BOXFLG ++ INITIAL-TEXT) ++ (LIST 'TEXTMENU (IF FLAT PARENTW) FLAT (IF PARENTW (CADR PARENTW)) ++ (OR X 0) (OR Y 0) 0 0 (IF TITLE (STRINGIFY TITLE) "") PERM ++ INITIAL-TEXT WIDTH HEIGHT BOXFLG (OR FONT '9X15))) ++ ++(DEFUN TEXTMENU-CALCULATE-SIZE (M) ++ (LET (MAXWIDTH MAXHEIGHT) ++ (SETQ MAXWIDTH ++ (MAX (IF (NINTH M) (+ 6 (* 9 (LENGTH (NINTH M)))) 0) ++ (NTH 11 M))) ++ (SETQ MAXHEIGHT ++ (+ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) ++ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) ++ 15 0) ++ (NTH 12 M))) ++ (SETF (SEVENTH M) MAXWIDTH) ++ (SETF (EIGHTH M) MAXHEIGHT))) ++ ++(DEFUN TEXTMENU-INIT (M) ++ (TEXTMENU-CALCULATE-SIZE M) ++ (MENU-ADJUST-OFFSET M) ++ (IF (NOT (CADDR M)) ++ (SETF (CADR M) ++ (WINDOW-CREATE (SEVENTH M) (EIGHTH M) (OR (NINTH M) "") ++ (CADDDR M) (FIFTH M) (SIXTH M) (NTH 14 M))))) ++ ++(DEFUN TEXTMENU-DRAW (M) ++ (LET (MW BOTTOM XZERO YZERO) ++ (OR (AND (CADR M) (PLUSP (EIGHTH M))) (TEXTMENU-INIT M)) ++ (SETQ MW (CADR M)) ++ (XMAPWINDOW *WINDOW-DISPLAY* (CADR MW)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-EXPOSURE MW) ++ (MENU-CLEAR M) ++ (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) ++ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) ++ (SETQ BOTTOM (+ YZERO (EIGHTH M))) ++ (WHEN (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) ++ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) ++ (LET ((SSTR (STRINGIFY (STRINGIFY (NINTH M))))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) (CADDR MW) ++ (+ 3 XZERO) (+ 13 (- (CADDDR MW) BOTTOM)) ++ (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (LET ((GC (CADDR MW))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 ++ *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 ++ *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (LOGXOR *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*))))) ++ (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR MW) (CADDR MW) XZERO ++ (- (CADDDR MW) BOTTOM) (SEVENTH M) 16) ++ (LET ((GC (CADDR MW))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) ++ (IF (NTH 10 M) ++ (LET ((SSTR (STRINGIFY (NTH 10 M)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) (CADDR MW) ++ (+ 10 XZERO) ++ (+ 8 (- (CADDDR MW) (+ YZERO (TRUNCATE (EIGHTH M) 2)))) ++ (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ (IF (NTH 13 M) ++ (WINDOW-DRAW-BOX-XY MW XZERO YZERO (SEVENTH M) (EIGHTH M) 1)) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN TEXTMENU-SELECT (M &OPTIONAL INSIDE) ++ (declare (ignore inside)) ++ (LET (MW XZERO YZERO CODEVAL) ++ (SETQ MW (OR (CADR M) (TEXTMENU-INIT M))) ++ (IF (NOT (TENTH M)) (TEXTMENU-DRAW M)) ++ (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) ++ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) ++ (WINDOW-TRACK-MOUSE MW ++ #'(LAMBDA (X Y CODE) ++ (SETQ *WINDOW-MENU-CODE* CODE) ++ (DECF X XZERO) ++ (DECF Y YZERO) ++ (IF (OR (PLUSP CODE) (MINUSP X) (> X (SEVENTH M)) ++ (MINUSP Y) (> Y (EIGHTH M))) ++ (SETQ CODEVAL CODE))) ++ T) ++ (WHEN (AND (NOT (TENTH M)) (NOT (CADDR M))) ++ (XUNMAPWINDOW *WINDOW-DISPLAY* (CADADR M)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-UNMAP (CADR M))) ++ (WHEN (PLUSP CODEVAL) ++ (TEXTMENU-DRAW M) ++ (WINDOW-INPUT-STRING MW (NTH 10 M) (+ 10 XZERO) ++ (+ -8 (+ YZERO (TRUNCATE (EIGHTH M) 2))) (+ -12 (SEVENTH M)))))) ++ ++(DEFUN TEXTMENU-SET-TEXT (M &OPTIONAL S) (SETF (NTH 10 M) (OR S ""))) ++ ++ ++ ++(DEFUN WINDOW-GET-POINT (W) ++ (LET (ORGX ORGY) ++ (WINDOW-TRACK-MOUSE W ++ #'(LAMBDA (X Y CODE) ++ (WHEN (NOT (ZEROP CODE)) (SETQ ORGX X) (SETQ ORGY Y)))) ++ (LIST ORGX ORGY))) ++ ++ ++ ++(DEFUN WINDOW-GET-CLICK (W) ++ (LET (ORGX ORGY BUTTON) ++ (WINDOW-TRACK-MOUSE W ++ #'(LAMBDA (X Y CODE) ++ (WHEN (NOT (ZEROP CODE)) ++ (SETQ BUTTON CODE) ++ (SETQ ORGX X) ++ (SETQ ORGY Y)))) ++ (LIST BUTTON (LIST ORGX ORGY)))) ++ ++ ++ ++(DEFUN WINDOW-GET-LINE-POSITION (W ORGX ORGY) ++ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-LINE-XY ++ (LIST ORGX ORGY 1 'PAINT))) ++ ++ ++ ++(DEFUN WINDOW-GET-LATEX-POSITION (W ORGX ORGY &OPTIONAL FLG) ++ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-LATEX-XY ++ (LIST ORGX ORGY FLG))) ++ ++ ++ ++(DEFUN WINDOW-GET-BOX-POSITION (W WIDTH HEIGHT &OPTIONAL (DX 0) (DY 0)) ++ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-BOX-XY ++ (LIST WIDTH HEIGHT 1) DX DY)) ++ ++ ++ ++(DEFUN WINDOW-GET-BOX-LINE-POSITION ++ (W WIDTH HEIGHT OFFX OFFY TOX TOY &OPTIONAL (DX 0) (DY 0)) ++ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-BOX-LINE-XY ++ (LIST WIDTH HEIGHT OFFX OFFY TOX TOY) DX DY)) ++ ++(DEFUN WINDOW-DRAW-BOX-LINE-XY (W X Y WIDTH HEIGHT OFFX OFFY TOX TOY) ++ (WINDOW-DRAW-BOX-XY W X Y WIDTH HEIGHT) ++ (WINDOW-DRAW-LINE-XY W (+ X OFFX) (+ Y OFFY) TOX TOY)) ++ ++ ++ ++(DEFUN WINDOW-GET-ICON-POSITION (W FN ARGS &OPTIONAL (DX 0) (DY 0)) ++ (LET (LASTX LASTY ARGL) ++ (SETQ ARGL (CONS W (CONS 0 (CONS 0 ARGS)))) ++ (WINDOW-SET-XOR W) ++ (WINDOW-TRACK-MOUSE W ++ #'(LAMBDA (X Y CODE) ++ (WHEN (OR (NULL LASTX) (/= X LASTX) (/= Y LASTY)) ++ (IF LASTX (APPLY FN ARGL)) ++ (RPLACA (CDR ARGL) (+ X DX)) ++ (RPLACA (CDDR ARGL) (+ Y DY)) ++ (APPLY FN ARGL) ++ (SETQ LASTX X) ++ (SETQ LASTY Y)) ++ (NOT (ZEROP CODE)))) ++ (APPLY FN ARGL) ++ (WINDOW-UNSET W) ++ (WINDOW-FORCE-OUTPUT W) ++ (LIST LASTX LASTY))) ++ ++ ++ ++(DEFUN WINDOW-GET-REGION (W &OPTIONAL WID HT) ++ (LET (LASTX LASTY START END WIDTH HEIGHT PLACE OFFX OFFY STX STY) ++ (IF (AND (NUMBERP WID) (NUMBERP HT)) ++ (PROGN ++ (SETQ START ++ (WINDOW-GET-BOX-POSITION W WID HT (- WID) (- HT))) ++ (SETQ STX (- (CAR START) WID)) ++ (SETQ STY (- (CADR START) HT))) ++ (PROGN ++ (SETQ START (WINDOW-GET-POINT W)) ++ (SETQ STX (CAR START)) ++ (SETQ STY (CADR START)))) ++ (SETQ END ++ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-BOX-CORNERS ++ (LIST STX STY 1))) ++ (SETQ LASTX (CAR END)) ++ (SETQ LASTY (CADR END)) ++ (SETQ WIDTH (ABS (- STX LASTX))) ++ (SETQ HEIGHT (ABS (- STY LASTY))) ++ (SETQ OFFX (- (MIN STX LASTX) LASTX)) ++ (SETQ OFFY (- (MIN STY LASTY) LASTY)) ++ (SETQ PLACE (WINDOW-GET-BOX-POSITION W WIDTH HEIGHT OFFX OFFY)) ++ (LIST (LIST (+ OFFX (FIRST PLACE)) (+ OFFY (SECOND PLACE))) ++ (LIST WIDTH HEIGHT)))) ++ ++ ++ ++(DEFUN WINDOW-GET-BOX-SIZE (W OFFSETX OFFSETY) ++ (LET (LEGENDY LASTX LASTY DX DY) ++ (SETQ OFFSETY (MAX OFFSETY 30)) ++ (SETQ LEGENDY (- OFFSETY 25)) ++ (WINDOW-ERASE-AREA-XY W OFFSETX LEGENDY 71 21) ++ (WINDOW-DRAW-BOX-XY W OFFSETX LEGENDY 70 20) ++ (WINDOW-TRACK-MOUSE W ++ #'(LAMBDA (X Y CODE) ++ (WHEN (OR (NULL LASTX) (/= X LASTX) (/= Y LASTY)) ++ (IF LASTX ++ (WINDOW-XOR-BOX-XY W OFFSETX OFFSETY ++ (- LASTX OFFSETX) (- LASTY OFFSETY))) ++ (SETQ LASTX NIL) ++ (SETQ DX (- X OFFSETX)) ++ (SETQ DY (- Y OFFSETY)) ++ (WHEN (AND (> DX 0) (> DY 0)) ++ (WINDOW-XOR-BOX-XY W OFFSETX OFFSETY DX DY) ++ (WINDOW-PRINTAT-XY W (FORMAT NIL "~3D x ~3D" DX DY) ++ (+ OFFSETX 3) (+ LEGENDY 5)) ++ (SETQ LASTX X) ++ (SETQ LASTY Y))) ++ (NOT (ZEROP CODE)))) ++ (IF LASTX ++ (WINDOW-XOR-BOX-XY W OFFSETX OFFSETY (- LASTX OFFSETX) ++ (- LASTY OFFSETY))) ++ (WINDOW-ERASE-AREA-XY W OFFSETX LEGENDY 71 21) ++ (WINDOW-FORCE-OUTPUT W) ++ (LIST DX DY))) ++ ++ ++ ++(DEFUN WINDOW-TRACK-MOUSE-IN-REGION ++ (W OFFSETX OFFSETY SIZEX SIZEY &OPTIONAL BOXFLG INSIDE) ++ (LET (RES) ++ (WHEN BOXFLG ++ (WINDOW-SET-XOR W) ++ (WINDOW-DRAW-BOX-XY W (- OFFSETX 4) (- OFFSETY 4) (+ SIZEX 8) ++ (+ SIZEY 8)) ++ (WINDOW-UNSET W) ++ (WINDOW-FORCE-OUTPUT W)) ++ (SETQ RES ++ (WINDOW-TRACK-MOUSE W ++ #'(LAMBDA (X Y CODE) ++ (IF (> CODE 0) (IF INSIDE (LIST CODE (LIST X Y)) T) ++ (IF (OR (< X OFFSETX) (> X (+ OFFSETX SIZEX)) ++ (< Y OFFSETY) (> Y (+ OFFSETY SIZEY))) ++ INSIDE (AND (SETQ INSIDE T) NIL)))))) ++ (WHEN BOXFLG ++ (WINDOW-SET-XOR W) ++ (WINDOW-DRAW-BOX-XY W (- OFFSETX 4) (- OFFSETY 4) (+ SIZEX 8) ++ (+ SIZEY 8)) ++ (WINDOW-UNSET W) ++ (WINDOW-FORCE-OUTPUT W)) ++ (IF (CONSP RES) RES))) ++ ++ ++ ++(DEFUN WINDOW-ADJUST-BOX-SIDE (W ORGX ORGY WIDTH HEIGHT SIDE) ++ (LET (NEW (XX ORGX) (YY ORGY) (WW WIDTH) (HH HEIGHT)) ++ (SETQ NEW ++ (WINDOW-GET-ICON-POSITION W #'WINDOW-ADJ-BOX-XY ++ (LIST ORGX ORGY WIDTH HEIGHT SIDE))) ++ (CASE SIDE ++ (LEFT (SETQ XX (CAR NEW)) (SETQ WW (+ WIDTH (- ORGX (CAR NEW))))) ++ (RIGHT (SETQ WW (- (CAR NEW) ORGX))) ++ (TOP (SETQ HH (- (CADR NEW) ORGY))) ++ (BOTTOM (SETQ YY (CADR NEW)) ++ (SETQ HH (+ HEIGHT (- ORGY (CADR NEW)))))) ++ (LIST (LIST XX YY) (LIST WW HH)))) ++ ++(DEFUN WINDOW-ADJ-BOX-XY (W X Y ORGX ORGY WIDTH HEIGHT SIDE) ++ (LET ((XX ORGX) (YY ORGY) (WW WIDTH) (HH HEIGHT)) ++ (CASE SIDE ++ (LEFT (SETQ XX X) (SETQ WW (+ WIDTH (- ORGX X)))) ++ (RIGHT (SETQ WW (- X ORGX))) ++ (TOP (SETQ HH (- Y ORGY))) ++ (BOTTOM (SETQ YY Y) (SETQ HH (+ HEIGHT (- ORGY Y))))) ++ (WINDOW-DRAW-BOX-XY W XX YY WW HH))) ++ ++ ++ ++(DEFUN WINDOW-GET-CIRCLE (W &OPTIONAL CENTER) ++ (LET (PT) ++ (OR CENTER (SETQ CENTER (WINDOW-GET-CROSSHAIRS W))) ++ (SETQ PT ++ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-CIRCLE-PT ++ (LIST CENTER))) ++ (LIST CENTER (WINDOW-CIRCLE-RADIUS (CAR PT) (CADR PT) CENTER)))) ++ ++(DEFUN WINDOW-CIRCLE-RADIUS (X Y CENTER) ++ (LET ((DX (- X (CAR CENTER))) (DY (- Y (CADR CENTER)))) ++ (TRUNCATE (+ 0.5 (SQRT (+ (* DX DX) (* DY DY))))))) ++ ++(DEFUN WINDOW-DRAW-CIRCLE-PT (W X Y CENTER) ++ (WINDOW-DRAW-CIRCLE W CENTER (WINDOW-CIRCLE-RADIUS X Y CENTER) 1)) ++ ++ ++ ++(DEFUN WINDOW-GET-ELLIPSE (W &OPTIONAL CENTER) ++ (LET (CIR RADIUSX PT) ++ (SETQ CIR (WINDOW-GET-CIRCLE W CENTER)) ++ (SETQ CENTER (CAR CIR)) ++ (SETQ RADIUSX (CADR CIR)) ++ (SETQ PT ++ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-ELLIPSE-PT ++ (LIST CENTER RADIUSX))) ++ (LIST CENTER (LIST RADIUSX (ABS (- (CADR PT) (CADR CENTER))))))) ++ ++(DEFUN WINDOW-DRAW-ELLIPSE-PT (W X Y CENTER RADIUSX) ++ (declare (ignore x)) ++ (WINDOW-DRAW-ELLIPSE-XY W (CAR CENTER) (CADR CENTER) RADIUSX ++ (ABS (- Y (CADR CENTER))))) ++ ++(DEFUN WINDOW-DRAW-VECTOR-PT (W X Y CENTER RADIUS) ++ (LET (DX DY THETA) ++ (SETQ DY (- Y (CADR CENTER))) ++ (SETQ DX (- X (CAR CENTER))) ++ (WHEN (OR (/= DX 0) (/= DY 0)) ++ (SETQ THETA (ATAN (- Y (CADR CENTER)) (- X (CAR CENTER)))) ++ (WINDOW-DRAW-LINE-XY W (CAR CENTER) (CADR CENTER) ++ (+ (CAR CENTER) (* RADIUS (COS THETA))) ++ (+ (CADR CENTER) (* RADIUS (SIN THETA))))))) ++ ++ ++ ++(DEFUN WINDOW-GET-VECTOR-END (W CENTER RADIUS) ++ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-VECTOR-PT ++ (LIST CENTER RADIUS))) ++ ++ ++ ++(DEFUN WINDOW-GET-CROSSHAIRS (W) ++ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-CROSSHAIRS-XY NIL)) ++ ++(DEFUN WINDOW-DRAW-CROSSHAIRS-XY (W X Y) ++ (WINDOW-DRAW-LINE-XY W (- X 12) Y (- X 3) Y) ++ (WINDOW-DRAW-LINE-XY W (+ X 3) Y (+ X 12) Y) ++ (WINDOW-DRAW-LINE-XY W X (- Y 12) X (- Y 3)) ++ (WINDOW-DRAW-LINE-XY W X (+ Y 3) X (+ Y 12))) ++ ++ ++ ++(DEFUN WINDOW-GET-CROSS (W) ++ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-CROSS-XY NIL)) ++ ++(DEFUN WINDOW-DRAW-CROSS-XY (W X Y) ++ (WINDOW-DRAW-LINE-XY W (- X 10) (- Y 10) (+ X 10) (+ Y 10) 2) ++ (WINDOW-DRAW-LINE-XY W (+ X 10) (- Y 10) (- X 10) (+ Y 10) 2)) ++ ++(DEFUN WINDOW-DRAW-DOT-XY (W X Y) ++ (WINDOW-DRAW-CIRCLE-XY W X Y 1) ++ (WINDOW-DRAW-CIRCLE-XY W X Y 2) ++ (WINDOW-DRAW-LINE-XY W X Y (+ X 1) Y 1)) ++ ++(DEFUN WINDOW-DRAW-LATEX-XY (W X Y ORGX ORGY FLG) ++ (LET (DX DY DELX DELY N RATIO CD NRAT) ++ (SETQ DX (- X ORGX)) ++ (SETQ DY (- Y ORGY)) ++ (IF (OR (= DX 0) (= DY 0)) (WINDOW-DRAW-LINE-XY W X Y ORGX ORGY) ++ (PROGN ++ (SETQ N (IF FLG 4 6)) ++ (IF (> (ABS DY) (ABS DX)) ++ (PROGN ++ (SETQ RATIO (ROUND (/ (* (ABS DX) N) (ABS DY)))) ++ (SETQ CD (GCD N RATIO)) ++ (SETQ N (/ N CD)) ++ (SETQ RATIO (/ RATIO CD)) ++ (SETQ NRAT (ROUND (/ (ABS DY) N))) ++ (SETQ DELY (* (SIGNUM DY) NRAT N)) ++ (SETQ DELX (* (SIGNUM DX) NRAT RATIO))) ++ (PROGN ++ (SETQ RATIO (ROUND (/ (* (ABS DY) N) (ABS DX)))) ++ (SETQ CD (GCD N RATIO)) ++ (SETQ N (/ N CD)) ++ (SETQ RATIO (/ RATIO CD)) ++ (SETQ NRAT (ROUND (/ (ABS DX) N))) ++ (SETQ DELX (* (SIGNUM DX) NRAT N)) ++ (SETQ DELY (* (SIGNUM DY) NRAT RATIO)))) ++ (WINDOW-DRAW-LINE-XY W (+ ORGX DELX) (+ ORGY DELY) ORGX ORGY))))) ++ ++(DEFUN WINDOW-RESET-COLOR (W) ++ (XSETFOREGROUND *WINDOW-DISPLAY* (CADDR W) *DEFAULT-FG-COLOR*) ++ (XSETBACKGROUND *WINDOW-DISPLAY* (CADDR W) *DEFAULT-BG-COLOR*)) ++ ++(DEFUN WINDOW-SET-COLOR-RGB (W R G B &OPTIONAL BACKGROUND) ++ (LET (RET) ++ (OR *WINDOW-XCOLOR* (SETQ *WINDOW-XCOLOR* (MAKE-XCOLOR))) ++ (SET-XCOLOR-RED *WINDOW-XCOLOR* (+ R 0)) ++ (SET-XCOLOR-GREEN *WINDOW-XCOLOR* (+ G 0)) ++ (SET-XCOLOR-BLUE *WINDOW-XCOLOR* (+ B 0)) ++ (SETQ RET ++ (XALLOCCOLOR *WINDOW-DISPLAY* *DEFAULT-COLORMAP* ++ *WINDOW-XCOLOR*)) ++ (IF (NOT (EQL RET 0)) ++ (WINDOW-SET-XCOLOR W *WINDOW-XCOLOR* BACKGROUND)))) ++ ++(DEFUN WINDOW-SET-XCOLOR (W &OPTIONAL XCOLOR BACKGROUND) ++ (IF BACKGROUND (WINDOW-SET-BACKGROUND W (XCOLOR-PIXEL XCOLOR)) ++ (WINDOW-SET-FOREGROUND W (XCOLOR-PIXEL XCOLOR))) ++ XCOLOR) ++ ++(DEFUN WINDOW-SET-COLOR (W RGB &OPTIONAL BACKGROUND) ++ (WINDOW-SET-COLOR-RGB W (FIRST RGB) (SECOND RGB) (THIRD RGB) ++ BACKGROUND)) ++ ++(DEFUN WINDOW-FREE-COLOR (W &OPTIONAL XCOLOR) ++ (declare (ignore w)) ++ (OR XCOLOR (SETQ XCOLOR *WINDOW-XCOLOR*)) ++ (IF XCOLOR ++ (UNLESS (OR (EQL XCOLOR *DEFAULT-FG-COLOR*) ++ (EQL XCOLOR *DEFAULT-BG-COLOR*)) ++ (XFREECOLORS *WINDOW-DISPLAY* *DEFAULT-COLORMAP* XCOLOR 1 0)))) ++ ++(DEFUN WINDOW-GET-CHARS (W FN &OPTIONAL ARGS) ++ (LET (WIN RES) ++ (OR *WINDOW-KEYINIT* (WINDOW-INIT-KEYMAP)) ++ (SETQ *WINDOW-SHIFT* NIL) ++ (SETQ *WINDOW-CTRL* NIL) ++ (SETQ *WINDOW-META* NIL) ++ (SETQ WIN (WINDOW-PARENT W)) ++ (XSYNC *WINDOW-DISPLAY* 1) ++ (XSELECTINPUT *WINDOW-DISPLAY* WIN ++ (+ KEYPRESSMASK KEYRELEASEMASK BUTTONPRESSMASK)) ++ (WHILE (NULL RES) (XNEXTEVENT *WINDOW-DISPLAY* *WINDOW-EVENT*) ++ (LET ((TYPE (XANYEVENT-TYPE *WINDOW-EVENT*)) ++ (EVENTWINDOW (XANYEVENT-WINDOW *WINDOW-EVENT*))) ++ (IF (EQL EVENTWINDOW WIN) ++ (SETQ RES (WINDOW-PROCESS-CHAR-EVENT W TYPE FN ARGS))))) ++ RES)) ++ ++(DEFUN WINDOW-PROCESS-CHAR-EVENT (W TYPE FN ARGS) ++ (LET (CODE) ++ (IF (EQL TYPE KEYRELEASE) ++ (PROGN ++ (SETQ CODE (XBUTTONEVENT-BUTTON *WINDOW-EVENT*)) ++ (IF (MEMBER CODE *WINDOW-SHIFT-KEYS*) ++ (SETQ *WINDOW-SHIFT* NIL) ++ (IF (MEMBER CODE *WINDOW-CONTROL-KEYS*) ++ (SETQ *WINDOW-CTRL* NIL) ++ (IF (MEMBER CODE *WINDOW-META-KEYS*) ++ (SETQ *WINDOW-META* NIL))))) ++ (IF (EQL TYPE KEYPRESS) ++ (PROGN ++ (SETQ CODE (XBUTTONEVENT-BUTTON *WINDOW-EVENT*)) ++ (IF (MEMBER CODE *WINDOW-SHIFT-KEYS*) ++ (PROGN (SETQ *WINDOW-SHIFT* T) NIL) ++ (IF (MEMBER CODE *WINDOW-CONTROL-KEYS*) ++ (PROGN (SETQ *WINDOW-CTRL* T) NIL) ++ (IF (MEMBER CODE *WINDOW-META-KEYS*) ++ (PROGN (SETQ *WINDOW-META* T) NIL) ++ (FUNCALL FN W (WINDOW-CHAR-DECODE CODE) 0 0 0 ++ ARGS))))) ++ (IF (EQL TYPE BUTTONPRESS) ++ (FUNCALL FN W 0 (XBUTTONEVENT-BUTTON *WINDOW-EVENT*) ++ (XMOTIONEVENT-X *WINDOW-EVENT*) ++ (- (WINDOW-DRAWABLE-HEIGHT W) ++ (XMOTIONEVENT-Y *WINDOW-EVENT*)) ++ ARGS)))))) ++ ++(DEFUN WINDOW-CHAR-DECODE (CODE) ++ (LET (CHAR) ++ (SETQ CHAR ++ (AREF (IF *WINDOW-SHIFT* *WINDOW-SHIFTKEYMAP* ++ *WINDOW-KEYMAP*) ++ CODE)) ++ (IF (AND CHAR *WINDOW-CTRL*) ++ (SETQ CHAR (CODE-CHAR (- (CHAR-CODE (CHAR-UPCASE CHAR)) 64)))) ++ (IF (AND CHAR *WINDOW-META*) ++ (SETQ CHAR (CODE-CHAR (+ (CHAR-CODE (CHAR-UPCASE CHAR)) 128)))) ++ (OR CHAR #\Space))) ++ ++(DEFUN WINDOW-GET-RAW-CHAR (W) ++ (LET (WIN RES) ++ (OR *WINDOW-KEYINIT* (WINDOW-INIT-KEYMAP)) ++ (SETQ *WINDOW-SHIFT* NIL) ++ (SETQ *WINDOW-CTRL* NIL) ++ (SETQ *WINDOW-META* NIL) ++ (SETQ WIN (WINDOW-PARENT W)) ++ (XSYNC *WINDOW-DISPLAY* 1) ++ (XSELECTINPUT *WINDOW-DISPLAY* WIN (+ KEYPRESSMASK KEYRELEASEMASK)) ++ (WHILE (NULL RES) (XNEXTEVENT *WINDOW-DISPLAY* *WINDOW-EVENT*) ++ (LET ((TYPE (XANYEVENT-TYPE *WINDOW-EVENT*)) ++ (EVENTWINDOW (XANYEVENT-WINDOW *WINDOW-EVENT*))) ++ (IF (AND (EQL EVENTWINDOW WIN) (EQL TYPE KEYPRESS)) ++ (SETQ RES (XBUTTONEVENT-BUTTON *WINDOW-EVENT*))))) ++ RES)) ++ ++(DEFUN WINDOW-INPUT-STRING (W STR X Y &OPTIONAL SIZE) ++ (CAR (WINDOW-EDIT W X Y (OR SIZE 100) 16 (LIST (OR STR "")) NIL T T))) ++ ++(DEFUN WINDOW-EDIT ++ (W X Y WIDTH HEIGHT &OPTIONAL STRINGS BOXFLG SCROLL ENDP) ++ (LET (EM) ++ (SETQ EM ++ (EDITMENU-CREATE WIDTH HEIGHT NIL W X Y NIL T '9X15 BOXFLG ++ STRINGS SCROLL ENDP)) ++ (EDITMENU-EDIT EM) ++ (EDITMENU-CARAT EM) ++ (NTH 10 EM))) ++ ++ ++ ++(DEFUN EDITMENU-CREATE ++ (WIDTH HEIGHT &OPTIONAL TITLE PARENTW X Y PERM FLAT FONT BOXFLG ++ INITIAL-TEXT SCROLLVAL ENDP) ++ (LIST 'EDITMENU (IF FLAT PARENTW) FLAT (IF PARENTW (CADR PARENTW)) ++ (OR X 0) (OR Y 0) 0 0 (IF TITLE (STRINGIFY TITLE) "") PERM ++ (OR INITIAL-TEXT (LIST "")) WIDTH HEIGHT BOXFLG (OR FONT '9X15) ++ (IF ENDP ++ (LENGTH (NTH (IF (NUMBERP SCROLLVAL) SCROLLVAL 0) ++ INITIAL-TEXT)) ++ 0) ++ (IF (NUMBERP SCROLLVAL) SCROLLVAL 0) (OR SCROLLVAL 0))) ++ ++(DEFUN EDITMENU-CALCULATE-SIZE (M) ++ (SETF (SEVENTH M) (NTH 11 M)) ++ (SETF (EIGHTH M) (NTH 12 M))) ++ ++(DEFUN EDITMENU-INIT (M) ++ (EDITMENU-CALCULATE-SIZE M) ++ (MENU-ADJUST-OFFSET M) ++ (IF (NOT (CADDR M)) ++ (SETF (CADR M) ++ (WINDOW-CREATE (SEVENTH M) (EIGHTH M) (OR (NINTH M) "") ++ (CADDDR M) (FIFTH M) (SIXTH M) (NTH 14 M))))) ++ ++(DEFUN EDITMENU-DRAW (M) ++ (LET (MW XZERO YZERO) ++ (OR (AND (CADR M) (PLUSP (EIGHTH M))) (EDITMENU-INIT M)) ++ (SETQ MW (CADR M)) ++ (XMAPWINDOW *WINDOW-DISPLAY* (CADR MW)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-EXPOSURE MW) ++ (MENU-CLEAR M) ++ (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) ++ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) ++ (IF (NTH 13 M) ++ (WINDOW-DRAW-BOX-XY MW XZERO YZERO (SEVENTH M) (EIGHTH M) 1)) ++ (EDITMENU-DISPLAY M 0 0 (NOT (NUMBERP (NTH 17 M)))))) ++ ++(DEFUN EDITMENU-DISPLAY (M LINE CHAR ONLY) ++ (LET (LINES Y MAXWIDTH LINEWIDTH (W (OR (CADR M) (EDITMENU-INIT M)))) ++ (SETQ LINES (NTHCDR LINE (NTH 10 M))) ++ (SETQ Y ++ (+ (IF (CADDR M) (SIXTH M) 0) ++ (- (EIGHTH M) ++ (1- (* (WINDOW-STRING-HEIGHT ++ (OR (CADR M) (EDITMENU-INIT M)) "Tg") ++ (1+ (- (- LINE ++ (IF (NUMBERP (NTH 17 M)) (NTH 17 M) 0)) ++ (IF (NUMBERP (NTH 17 M)) (NTH 17 M) 0)))))))) ++ (SETQ MAXWIDTH ++ (TRUNCATE (+ -6 (SEVENTH M)) ++ (LET ((SSTR (STRINGIFY "W"))) ++ (XTEXTWIDTH (SEVENTH (OR (CADR M) (EDITMENU-INIT M))) ++ (GET-C-STRING SSTR) (LENGTH SSTR))))) ++ (WHILE (AND LINES (>= Y (+ 4 (IF (CADDR M) (SIXTH M) 0)))) ++ (IF (< CHAR MAXWIDTH) ++ (IF (PLUSP CHAR) ++ (LET ((SSTR (STRINGIFY ++ (SUBSEQ (FIRST LINES) CHAR ++ (MIN MAXWIDTH ++ (LENGTH (FIRST LINES))))))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) ++ (CADDR W) ++ (+ (IF (CADDR M) (FIFTH M) 0) ++ (+ 2 ++ (* CHAR ++ (LET ((SSTR (STRINGIFY "W"))) ++ (XTEXTWIDTH ++ (SEVENTH ++ (OR (CADR M) (EDITMENU-INIT M))) ++ (GET-C-STRING SSTR) (LENGTH SSTR)))))) ++ (- (CADDDR W) Y) (GET-C-STRING SSTR) ++ (LENGTH SSTR))) ++ (LET ((SSTR (STRINGIFY ++ (IF ++ (<= (LENGTH (FIRST LINES)) ++ MAXWIDTH) ++ (FIRST LINES) ++ (SUBSEQ (FIRST LINES) 0 MAXWIDTH))))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) ++ (CADDR W) (+ 2 (IF (CADDR M) (FIFTH M) 0)) ++ (- (CADDDR W) Y) (GET-C-STRING SSTR) ++ (LENGTH SSTR))))) ++ (SETQ LINEWIDTH ++ (+ 2 ++ (* (LET ((SSTR (STRINGIFY "W"))) ++ (XTEXTWIDTH ++ (SEVENTH (OR (CADR M) (EDITMENU-INIT M))) ++ (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (LENGTH (FIRST LINES))))) ++ (WINDOW-ERASE-AREA-XY W ++ (+ (IF (CADDR M) (FIFTH M) 0) LINEWIDTH) (+ -2 Y) ++ (+ -2 (- (SEVENTH M) LINEWIDTH)) ++ (WINDOW-STRING-HEIGHT (OR (CADR M) (EDITMENU-INIT M)) ++ "Tg")) ++ (DECF Y ++ (WINDOW-STRING-HEIGHT (OR (CADR M) (EDITMENU-INIT M)) ++ "Tg")) ++ (IF ONLY (SETQ LINES NIL) ++ (PROGN ++ (POP LINES) ++ (IF (AND (NULL LINES) ++ (>= Y (+ 4 (IF (CADDR M) (SIXTH M) 0)))) ++ (WINDOW-ERASE-AREA-XY W ++ (+ 2 (IF (CADDR M) (FIFTH M) 0)) (+ -2 Y) ++ (+ -4 (SEVENTH M)) ++ (WINDOW-STRING-HEIGHT ++ (OR (CADR M) (EDITMENU-INIT M)) "Tg"))))) ++ (SETQ CHAR 0)) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN EDITMENU-CARAT (M) ++ (WINDOW-DRAW-CARAT (OR (CADR M) (EDITMENU-INIT M)) ++ (+ (IF (CADDR M) (FIFTH M) 0) ++ (+ 2 ++ (* (NTH 15 M) ++ (LET ((SSTR (STRINGIFY "W"))) ++ (XTEXTWIDTH (SEVENTH (OR (CADR M) (EDITMENU-INIT M))) ++ (GET-C-STRING SSTR) (LENGTH SSTR)))))) ++ (+ -2 ++ (+ (IF (CADDR M) (SIXTH M) 0) ++ (- (EIGHTH M) ++ (1- (* (WINDOW-STRING-HEIGHT ++ (OR (CADR M) (EDITMENU-INIT M)) "Tg") ++ (1+ (- (NTH 16 M) ++ (IF (NUMBERP (NTH 17 M)) (NTH 17 M) 0))))))))) ++ (XFLUSH *WINDOW-DISPLAY*)) ++ ++(DEFUN EDITMENU-ERASE (M ONEP) ++ (LET ((W (OR (CADR M) (EDITMENU-INIT M))) XW) ++ (SETQ XW ++ (+ 2 ++ (* (LET ((SSTR (STRINGIFY "W"))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) ++ (LENGTH SSTR))) ++ (NTH 15 M)))) ++ (LET ((GLVAR423 (WINDOW-STRING-HEIGHT W "Tg"))) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) ++ (+ (IF (CADDR M) (FIFTH M) 0) XW) ++ (- (CADDDR W) ++ (1- (+ (- (+ (IF (CADDR M) (SIXTH M) 0) ++ (- (EIGHTH M) ++ (1- (* (WINDOW-STRING-HEIGHT ++ (OR (CADR M) (EDITMENU-INIT M)) ++ "Tg") ++ (1+ ++ (- (NTH 16 M) ++ (IF (NUMBERP (NTH 17 M)) ++ (NTH 17 M) 0))))))) ++ (CADR (LET ((SSTR (STRINGIFY "Tg"))) ++ (XTEXTEXTENTS (SEVENTH W) ++ (GET-C-STRING SSTR) (LENGTH SSTR) ++ *DIRECTION-RETURN* *ASCENT-RETURN* ++ *DESCENT-RETURN* *OVERALL-RETURN*) ++ (LIST (INT-POS *ASCENT-RETURN* 0) ++ (INT-POS *DESCENT-RETURN* 0))))) ++ GLVAR423))) ++ (IF ONEP ++ (LET ((SSTR (STRINGIFY "W"))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) ++ (LENGTH SSTR))) ++ (- (SEVENTH M) XW)) ++ GLVAR423 0)) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN EDITMENU-LINE-Y (M LINE) ++ (+ (IF (CADDR M) (SIXTH M) 0) ++ (- (EIGHTH M) ++ (1- (* (WINDOW-STRING-HEIGHT (OR (CADR M) (EDITMENU-INIT M)) ++ "Tg") ++ (1+ (- LINE (IF (NUMBERP (NTH 17 M)) (NTH 17 M) 0)))))))) ++ ++(DEFUN EDITMENU-SELECT (M &OPTIONAL INSIDE) ++ (declare (ignore inside)) ++ (LET (MW CODEVAL XVAL YVAL) ++ (SETQ MW (OR (CADR M) (EDITMENU-INIT M))) ++ (IF (NOT (TENTH M)) (EDITMENU-DRAW M)) ++ (WINDOW-TRACK-MOUSE MW ++ #'(LAMBDA (X Y CODE) ++ (SETQ *WINDOW-MENU-CODE* CODE) ++ (WHEN (OR (PLUSP CODE) (< X (FIFTH M)) ++ (> X (+ (FIFTH M) (SEVENTH M))) (< Y (SIXTH M)) ++ (> Y (+ (SIXTH M) (EIGHTH M)))) ++ (SETQ CODEVAL CODE) ++ (SETQ XVAL X) ++ (SETQ YVAL Y))) ++ T) ++ (IF (PLUSP CODEVAL) (EDITMENU-EDIT M CODEVAL XVAL YVAL)))) ++ ++(DEFVAR *WINDOW-EDITMENU-KILL-STRINGS* NIL) ++ ++(DEFUN EDITMENU-EDIT (M &OPTIONAL CODE X Y) ++ (LET ((MW (OR (CADR M) (EDITMENU-INIT M)))) ++ (EDITMENU-DRAW M) ++ (EDITMENU-CARAT M) ++ (IF CODE (EDITMENU-EDIT-FN MW NIL CODE X Y (LIST M))) ++ (SETQ *WINDOW-EDITMENU-KILL-STRINGS* NIL) ++ (WINDOW-GET-CHARS MW #'EDITMENU-EDIT-FN (LIST M)) ++ (NTH 10 M))) ++ ++(DEFUN EDITMENU-EDIT-FN (W CHAR BUTTON BUTTONX BUTTONY ARGS) ++ (declare (ignore w)) ++ (LET (M INSIDE DONE) ++ (SETQ M (CAR ARGS)) ++ (EDITMENU-CARAT M) ++ (IF (AND (NUMBERP BUTTON) (NOT (ZEROP BUTTON))) ++ (PROGN ++ (SETQ INSIDE (EDITMENU-SETXY M BUTTONX BUTTONY)) ++ (CASE BUTTON ++ (1 (IF INSIDE (PROGN (EDITMENU-CARAT M) NIL) T)) ++ (2 (WHEN INSIDE (EDITMENU-YANK M) (EDITMENU-CARAT M) NIL)))) ++ (PROGN ++ (IF (< (CHAR-CODE CHAR) 32) ++ (CASE CHAR ++ (#\Return ++ (IF (NUMBERP (NTH 17 M)) (EDITMENU-RETURN M) ++ (SETQ DONE T))) ++ (#\Backspace (EDITMENU-BACKSPACE M)) ++ (#\^D (EDITMENU-DELETE M)) ++ (#\^N (IF (NUMBERP (NTH 17 M)) (EDITMENU-NEXT M))) ++ (#\^P (EDITMENU-PREVIOUS M)) ++ (#\^F (EDITMENU-FORWARD M)) ++ (#\^B (EDITMENU-BACKWARD M)) ++ (#\^A (EDITMENU-BEGINNING M)) ++ (#\^E (EDITMENU-END M)) ++ (#\^K (EDITMENU-KILL M)) ++ (#\^Y (EDITMENU-YANK M)) ++ (T NIL)) ++ (IF (> (CHAR-CODE CHAR) 128) ++ (PROGN ++ (SETQ CHAR (CODE-CHAR (+ -128 (CHAR-CODE CHAR)))) ++ (CASE CHAR ++ (#\B (EDITMENU-META-B M)) ++ (#\F (EDITMENU-META-F M)) ++ (T NIL))) ++ (EDITMENU-CHAR M CHAR))) ++ (EDITMENU-CARAT M) ++ DONE)))) ++ ++(DEFUN EDITMENU-SETXY (M BUTTONX BUTTONY) ++ (LET (LINECONS OKAY) ++ (SETQ OKAY ++ (AND (>= BUTTONX (FIFTH M)) ++ (<= BUTTONX (+ (FIFTH M) (SEVENTH M))) ++ (>= BUTTONY (SIXTH M)) ++ (<= BUTTONY (+ (SIXTH M) (EIGHTH M))))) ++ (WHEN OKAY ++ (SETF (NTH 16 M) ++ (MIN (1- (LENGTH (NTH 10 M))) ++ (+ (IF (NUMBERP (NTH 17 M)) (NTH 17 M) 0) ++ (TRUNCATE ++ (- (+ (IF (CADDR M) (SIXTH M) 0) ++ (+ -6 (EIGHTH M))) ++ BUTTONY) ++ (WINDOW-STRING-HEIGHT ++ (OR (CADR M) (EDITMENU-INIT M)) "Tg"))))) ++ (SETQ LINECONS (NTHCDR (NTH 16 M) (NTH 10 M))) ++ (SETF (NTH 15 M) ++ (MIN (LENGTH (CAR LINECONS)) ++ (TRUNCATE ++ (+ -2 (- BUTTONX (IF (CADDR M) (FIFTH M) 0))) ++ (LET ((SSTR (STRINGIFY "W"))) ++ (XTEXTWIDTH ++ (SEVENTH (OR (CADR M) (EDITMENU-INIT M))) ++ (GET-C-STRING SSTR) (LENGTH SSTR))))))) ++ OKAY)) ++ ++(DEFUN EDITMENU-CHAR (M CHAR) ++ (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) ++ (IF (<= (LENGTH (CAR LINECONS)) (NTH 15 M)) ++ (SETF (CAR LINECONS) ++ (CONCATENATE 'STRING (CAR LINECONS) (STRING CHAR))) ++ (SETF (CAR LINECONS) ++ (CONCATENATE 'STRING (SUBSEQ (CAR LINECONS) 0 (NTH 15 M)) ++ (STRING CHAR) (SUBSEQ (CAR LINECONS) (NTH 15 M))))) ++ (EDITMENU-DISPLAY M (NTH 16 M) (NTH 15 M) T) ++ (INCF (NTH 15 M)))) ++ ++(DEFUN EDITMENU-CURRENT-CHAR (M) ++ (CHAR (NTH (NTH 16 M) (NTH 10 M)) (NTH 15 M))) ++ ++(DEFUN EDITMENU-RETURN (M) ++ (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) ++ (IF (<= (LENGTH (CAR LINECONS)) (NTH 15 M)) ++ (PUSH "" (CDR LINECONS)) ++ (PROGN ++ (PUSH (SUBSEQ (CAR LINECONS) (NTH 15 M)) (CDR LINECONS)) ++ (SETF (CAR LINECONS) (SUBSEQ (CAR LINECONS) 0 (NTH 15 M))))) ++ (EDITMENU-DISPLAY M (NTH 16 M) 0 NIL) ++ (INCF (NTH 16 M)) ++ (SETF (NTH 15 M) 0))) ++ ++(DEFUN EDITMENU-BACKSPACE (M) ++ (LET (TMP LINEDEL (LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) ++ (IF (PLUSP (NTH 15 M)) ++ (PROGN ++ (DECF (NTH 15 M)) ++ (SETF (CAR LINECONS) ++ (CONCATENATE 'STRING ++ (SUBSEQ (CAR LINECONS) 0 (NTH 15 M)) ++ (SUBSEQ (CAR LINECONS) (1+ (NTH 15 M)))))) ++ (WHEN (PLUSP (NTH 16 M)) ++ (DECF (NTH 16 M)) ++ (SETQ LINEDEL T) ++ (SETQ LINECONS (NTHCDR (NTH 16 M) (NTH 10 M))) ++ (SETF (NTH 15 M) (LENGTH (CAR LINECONS))) ++ (SETQ TMP ++ (CONCATENATE 'STRING (CAR LINECONS) (CADR LINECONS))) ++ (SETF (CDR LINECONS) (CDDR LINECONS)) ++ (SETF (CAR LINECONS) TMP))) ++ (EDITMENU-DISPLAY M (NTH 16 M) (NTH 15 M) (NOT LINEDEL)))) ++ ++(DEFUN EDITMENU-END (M) ++ (SETF (NTH 15 M) (LENGTH (NTH (NTH 16 M) (NTH 10 M))))) ++ ++(DEFUN EDITMENU-BEGINNING (M) (SETF (NTH 15 M) 0)) ++ ++(DEFUN EDITMENU-FORWARD (M) ++ (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) ++ (IF (< (NTH 15 M) (LENGTH (CAR LINECONS))) (INCF (NTH 15 M)) ++ (WHEN (NUMBERP (NTH 17 M)) ++ (INCF (NTH 16 M)) ++ (IF (NULL (CDR LINECONS)) (SETF (CDR LINECONS) (LIST ""))) ++ (SETF (NTH 15 M) 0))))) ++ ++(DEFUN EDITMENU-META-F (M) ++ (LET (FOUND DONE) ++ (WHILE (AND (OR (< (NTH 16 M) (1- (LENGTH (NTH 10 M)))) ++ (< (NTH 15 M) (LENGTH (NTH (NTH 16 M) (NTH 10 M))))) ++ (NOT FOUND)) ++ (IF (EDITMENU-ALPHANUMBERICP (EDITMENU-CURRENT-CHAR M)) ++ (SETQ FOUND T) (EDITMENU-FORWARD M))) ++ (IF FOUND ++ (WHILE (AND (OR (< (NTH 16 M) (1- (LENGTH (NTH 10 M)))) ++ (< (NTH 15 M) ++ (LENGTH (NTH (NTH 16 M) (NTH 10 M))))) ++ (NOT DONE)) ++ (IF (EDITMENU-ALPHANUMBERICP (EDITMENU-CURRENT-CHAR M)) ++ (EDITMENU-FORWARD M) (SETQ DONE T)))))) ++ ++(DEFUN EDITMENU-ALPHANUMBERICP (X) ++ (OR (ALPHA-CHAR-P X) (NOT (NULL (DIGIT-CHAR-P X))))) ++ ++(DEFUN EDITMENU-NEXT (M) ++ (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) ++ (INCF (NTH 16 M)) ++ (IF (NULL (CDR LINECONS)) (SETF (CDR LINECONS) (LIST ""))) ++ (SETQ LINECONS (CDR LINECONS)) ++ (SETF (NTH 15 M) (MIN (NTH 15 M) (LENGTH (CAR LINECONS)))))) ++ ++(DEFUN EDITMENU-BACKWARD (M) ++ (IF (PLUSP (NTH 15 M)) (DECF (NTH 15 M)) ++ (WHEN (PLUSP (NTH 16 M)) ++ (DECF (NTH 16 M)) ++ (SETF (NTH 15 M) (LENGTH (NTH (NTH 16 M) (NTH 10 M))))))) ++ ++(DEFUN EDITMENU-META-B (M) ++ (LET (FOUND DONE) ++ (WHILE (AND (OR (PLUSP (NTH 15 M)) (PLUSP (NTH 16 M))) (NOT FOUND)) ++ (EDITMENU-BACKWARD M) ++ (IF (EDITMENU-ALPHANUMBERICP (EDITMENU-CURRENT-CHAR M)) ++ (SETQ FOUND T))) ++ (WHEN FOUND ++ (WHILE (AND (OR (PLUSP (NTH 15 M)) (PLUSP (NTH 16 M))) ++ (NOT DONE)) ++ (IF (EDITMENU-ALPHANUMBERICP (EDITMENU-CURRENT-CHAR M)) ++ (EDITMENU-BACKWARD M) (SETQ DONE T))) ++ (UNLESS (EDITMENU-ALPHANUMBERICP (EDITMENU-CURRENT-CHAR M)) ++ (EDITMENU-FORWARD M))))) ++ ++(DEFUN EDITMENU-PREVIOUS (M) ++ (WHEN (PLUSP (NTH 16 M)) ++ (DECF (NTH 16 M)) ++ (SETF (NTH 15 M) ++ (MIN (NTH 15 M) (LENGTH (NTH (NTH 16 M) (NTH 10 M))))))) ++ ++(DEFUN EDITMENU-DELETE (M) ++ (EDITMENU-FORWARD M) ++ (EDITMENU-BACKSPACE M)) ++ ++(DEFUN EDITMENU-KILL (M) ++ (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) ++ (IF (< (NTH 15 M) (LENGTH (CAR LINECONS))) ++ (PROGN ++ (SETQ *WINDOW-EDITMENU-KILL-STRINGS* ++ (LIST (SUBSEQ (CAR LINECONS) (NTH 15 M)))) ++ (SETF (CAR LINECONS) (SUBSEQ (CAR LINECONS) 0 (NTH 15 M))) ++ (EDITMENU-DISPLAY M (NTH 16 M) (NTH 15 M) T)) ++ (EDITMENU-DELETE M)))) ++ ++(DEFUN EDITMENU-YANK (M) ++ (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M))) (COL (NTH 15 M))) ++ (WHEN *WINDOW-EDITMENU-KILL-STRINGS* ++ (IF (<= (LENGTH (CAR LINECONS)) (NTH 15 M)) ++ (PROGN ++ (SETF (CAR LINECONS) ++ (CONCATENATE 'STRING (CAR LINECONS) ++ (CAR *WINDOW-EDITMENU-KILL-STRINGS*))) ++ (SETF (NTH 15 M) (LENGTH (CAR LINECONS)))) ++ (PROGN ++ (SETF (CAR LINECONS) ++ (CONCATENATE 'STRING (SUBSEQ (CAR LINECONS) 0 COL) ++ (CAR *WINDOW-EDITMENU-KILL-STRINGS*) ++ (SUBSEQ (CAR LINECONS) COL))) ++ (INCF (NTH 15 M) ++ (LENGTH (CAR *WINDOW-EDITMENU-KILL-STRINGS*))))) ++ (EDITMENU-DISPLAY M (NTH 16 M) COL T)))) ++ ++(DEFUN WINDOW-DRAW-CARAT (W X Y) ++ (WINDOW-SET-XOR W) ++ (WINDOW-DRAW-LINE-XY W (- X 5) (- Y 2) X Y) ++ (WINDOW-DRAW-LINE-XY W X Y (+ X 5) (- Y 2)) ++ (WINDOW-UNSET W) ++ (WINDOW-FORCE-OUTPUT W)) ++ ++(DEFUN WINDOW-INIT-KEYMAP () ++ (LET (MINCODE MAXCODE KEYCODE KEYSYM KEYNUM SHIFTKEYNUM CHAR) ++ (XDISPLAYKEYCODES *WINDOW-DISPLAY* *MIN-KEYCODES-RETURN* ++ *MAX-KEYCODES-RETURN*) ++ (SETQ MINCODE (INT-POS *MIN-KEYCODES-RETURN* 0)) ++ (SETQ MAXCODE (INT-POS *MAX-KEYCODES-RETURN* 0)) ++ (SETQ *WINDOW-KEYMAP* ++ (MAKE-ARRAY (1+ MAXCODE) :INITIAL-ELEMENT NIL)) ++ (SETQ *WINDOW-SHIFTKEYMAP* ++ (MAKE-ARRAY (1+ MAXCODE) :INITIAL-ELEMENT NIL)) ++ (SETQ *WINDOW-SHIFT-KEYS* NIL) ++ (SETQ *WINDOW-CONTROL-KEYS* NIL) ++ (SETQ *WINDOW-META-KEYS* NIL) ++ (DOTIMES (I (1+ (- MAXCODE MINCODE))) ++ (SETQ KEYCODE (+ I MINCODE)) ++ (SETQ KEYSYM ++ (XGETKEYBOARDMAPPING *WINDOW-DISPLAY* KEYCODE 1 ++ *KEYCODES-RETURN*)) ++ (SETQ KEYNUM (FIXNUM-POS KEYSYM 0)) ++ (SETQ SHIFTKEYNUM (FIXNUM-POS KEYSYM 1)) ++ (IF (AND (>= KEYNUM 65) (<= KEYNUM 90) ++ (EQL SHIFTKEYNUM NOSYMBOL)) ++ (PROGN ++ (SETQ SHIFTKEYNUM KEYNUM) ++ (SETQ KEYNUM (+ KEYNUM 32)))) ++ (IF (> KEYNUM 0) ++ (IF (SETQ CHAR (WINDOW-CODE-CHAR KEYNUM)) ++ (SETF (AREF *WINDOW-KEYMAP* KEYCODE) CHAR) ++ (IF (> KEYNUM 256) ++ (COND ++ ((OR (EQL KEYNUM XK_SHIFT_R) ++ (EQL KEYNUM XK_SHIFT_L)) ++ (PUSH KEYCODE *WINDOW-SHIFT-KEYS*)) ++ ((OR (EQL KEYNUM XK_CONTROL_L) ++ (EQL KEYNUM XK_CONTROL_R)) ++ (PUSH KEYCODE *WINDOW-CONTROL-KEYS*)) ++ ((OR (EQL KEYNUM XK_ALT_R) (EQL KEYNUM XK_ALT_L)) ++ (PUSH KEYCODE *WINDOW-META-KEYS*)))))) ++ (IF (> SHIFTKEYNUM 0) ++ (IF (SETQ CHAR (WINDOW-CODE-CHAR SHIFTKEYNUM)) ++ (SETF (AREF *WINDOW-SHIFTKEYMAP* KEYCODE) CHAR)))) ++ (SETQ *WINDOW-KEYINIT* T))) ++ ++(DEFUN WINDOW-CODE-CHAR (CODE) ++ (IF (> CODE 0) ++ (IF (< CODE 256) (CODE-CHAR CODE) ++ (COND ++ ((EQL CODE XK_RETURN) #\Return) ++ ((EQL CODE XK_TAB) #\Tab) ++ ((EQL CODE XK_BACKSPACE) #\Backspace))))) ++ ++ ++ ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_X10.lsp +@@ -0,0 +1,30 @@ ++(in-package :XLIB) ++; X10.lsp modified by Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++ ++(defconstant VertexRelative #x01 ) ;; else absolute ++(defconstant VertexDontDraw #x02 ) ;; else draw ++(defconstant VertexCurved #x04 ) ;; else straight ++(defconstant VertexStartClosed #x08 ) ;; else not ++(defconstant VertexEndClosed #x10 ) ;; else not +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_tohtml.lsp +@@ -0,0 +1,502 @@ ++; tohtml.lsp Gordon S. Novak Jr. ; 13 Jan 06 ++ ++; Translate LaTex file to HTML web pages ++ ++; Make table of contents for LaTex files of slides ++ ++; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; This program 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 program 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 program; if not, write to the Free Software ++; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ++ ++; 21 Aug 00; 07 Sep 00; 11 Sep 00; 07 Dec 00; 24 Jul 02; 25 Jul 02; 29 Jul 02 ++; 12 Feb 03; 28 Aug 03; 29 Aug 03; 15 Jan 04; 11 May 04; 29 Aug 05 ++ ++; This program converts a LaTeX file into one or more HTML files. ++; The HTML file may need some minor hand editing. ++ ++; The program produces a new file in response to \pagebreak ++; and puts in links to other pages. ++ ++; I have used it to put class lecture slides on the web; ++; see http://www.cs.utexas.edu/users/novak/cs375contents.html ++; See the README for notes on how this is all created. ++; See also the file index.lsp for making indexes. ++ ++; To use: ++; Start Lisp: e.g. /p/bin/gcl ++; (load "tohtml.lsp") ++ ++; To translate LaTeX to HTML web pages: ++; (tohtml "myfile.tex" "myprefix" ) ++; where "myfile.tex" = LaTeX file ++; "myprefix" = file name prefix for HTML files ++; = number of first page if not 1 ++; \setcounter{page} will override this ++ ++; To make contents: ++; The contents program looks for header lines, which ++; in my files look something like: ++; \begin{center} {\bf Lexical Analysis} \end{center} ++ ++; (makecont "myfile.tex" ) ++; where "myfile.tex" = LaTeX file ++; = number of first page if not 1 ++; = t for html output, nil for LaTeX output ++ ++ ++; 22 Aug 97; 28 Apr 00; 07 Aug 00; 08 Aug 00; 17 Aug 00; 18 Aug 00; 07 Dec 00 ++; 24 Jul 02; 26 Aug 03; 28 Aug 03; 11 Jan 05 ++; Make a contents list for a file of LaTex slides ++; n is first page number: required if first page is not 1. ++; html is prefix string to make html contents ++(in-package 'xlib) ++ ++(defvar *line*) ++(defvar *ptr*) ++(defvar *lng*) ++ ++(defun makecont (filenm &optional (n 1) html) ++ (let (line ptr lng done depth pagebr lastbr doit (first t)) ++ (with-open-file (infile filenm :direction :input ++ :if-does-not-exist nil) ++ (while (not (or (null infile) ++ (eq (setq line (read-line infile nil 'zzeofvalue)) ++ 'zzeofvalue) )) ++ (setq lng (length line)) ++ (setq lastbr pagebr) ++ (setq pagebr ++ (and (>= lng 10) ++ (string= line "\\pagebreak" :end1 10))) ++ (if (and pagebr (not first)) (incf n)) ++ (when (and (> lng 18) ++ (string= line "\\setcounter{page}{" :end1 18)) ++ (setq *line* line) ++ (setq *lng* lng) ++ (setq *ptr* 18) ++ (setq n (parse-int))) ++ (when (and (> lng 20) ++ (string= line "\\addtocounter{page}{" :end1 20)) ++ (setq *line* line) ++ (setq *lng* lng) ++ (setq *ptr* 20) ++ (setq n (+ n (parse-int))) ) ++ (setq doit nil) ++ (if (and (> lng 30) ++ (or (string= line "\\begin{center} {\\bf " :end1 20) ++ (string= line "\\begin{center} {\\bf " :end1 21))) ++ (progn (setq doit t) (setq ptr 20)) ) ++ (if (and (> lng 6) lastbr ++ (string= line "{\\bf " :end1 5)) ++ (progn (setq doit t) (setq ptr 5)) ) ++ (when doit ++ (setq first nil) ++ (if html ++ (format t "~D. " html n n)) ++ (setq lng (length line)) ++ (setq done nil) ++ (setq depth 0) ++ (if (char= (char line ptr) #\Space) (incf ptr)) ++ (while (and (< ptr lng) (not done)) ++ (if (char= (char line ptr) #\\) ++ (if (string= line "\\index" :start1 ptr :end1 (min lng (+ ptr 6))) ++ (progn (while (and (< ptr lng) ++ (not (char= (char line ptr) #\}))) ++ (incf ptr)) ++ (incf ptr)))) ++ (if (char= (char line ptr) #\{) ++ (progn (incf depth) (princ (char line ptr))) ++ (if (char= (char line ptr) #\}) ++ (if (> depth 0) ++ (progn (decf depth) (princ (char line ptr))) ++ (setq done t)) ++ (princ (char line ptr))) ) ++ (incf ptr)) ++ (if html ++ (format t "

~%") ++ (format t "~60T& ~D \\\\~%" n)) ) ) ) )) ++ ++(defvar *prefix* "") ++(defvar *feof* nil) ++(defvar *done* nil) ++(defvar *pagenumber* 0) ++(defvar *firstpage* 1) ++(defvar *lastpage* 999) ++(defvar *center* nil) ++(defvar *modestack* nil) ++(defvar *verbatim* nil) ++(defvar *ignore* t) ++(defvar *specials* nil) ++; ¬in &there4 &nsub © ° ++(setq *specials* '(("pm" "±") ("cdot" "·") ("cap" "&cap") ++ ("cup" "&cup") ("vee" "&or") ("wedge" "&and") ("leq" "&le") ("geq" "&ge") ++ ("subset" "&sub") ("subseteq" "&sube") ("supset" "&sup") ++ ("supseteq" "&supe") ("in" "&isin") ("perp" "&perp") ("cong" "&cong") ++ ("sim" "&tilde") ("neq" "&ne") ("mid" "|") ("leftarrow" "&larr") ++ ("rightarrow" "&rarr") ("leftrightarrow" "&harr") ("Leftarrow" "&lArr") ++ ("Rightarrow" "&rArr") ("Leftrightarrow" "&hArr") ("uparrow" "&uarr") ++ ("downarrow" "&darr") ("surd" "&radic ") ("emptyset" "&empty") ++ ("forall" "&forall") ("exists" "&exist") ("neg" "¬") ("Box" "□") ++ ("models" "⊨") ("vdash" "⊢") ++ ("filledBox" "■") ("sum" "&sum") ("prod" "&prod") ("int" "&int") ++ ("infty" "&infin") ("times" "X") ("sqrt" "&radic ") ("ll" "< < ") ++ ("alpha" "&alpha") ("beta" "&beta") ("gamma" "&gamma") ("delta" "&delta") ++ ("epsilon" "&epsilon") ("zeta" "&zeta") ("eta" "&eta") ("theta" "&theta") ++ ("iota" "&iota") ("kappa" "&kappa") ("lambda" "&lambda") ("mu" "&mu") ++ ("nu" "&nu") ("xi" "&xi") ("pi" "&pi") ("rho" "&rho") ("sigma" "&sigma") ++ ("tau" "&tau") ("upsilon" "&upsilon") ("phi" "&phi") ("chi" "&chi") ++ ("psi" "&psi") ("omega" "&omega") ++ ("Alpha" "&Alpha") ("Beta" "&Beta") ("Gamma" "&Gamma") ("Delta" "&Delta") ++ ("Epsilon" "&Epsilon") ("Zeta" "&Zeta") ("Eta" "&Eta") ("Theta" "&Theta") ++ ("Iota" "&Iota") ("Kappa" "&Kappa") ("Lambda" "&Lambda") ("Mu" "&Mu") ++ ("Nu" "&Nu") ("Xi" "&Xi") ("Pi" "&Pi") ("Rho" "&Rho") ("Sigma" "&Sigma") ++ ("Tau" "&Tau") ("Upsilon" "&Upsilon") ("Phi" "&Phi") ("Chi" "&Chi") ++ ("Psi" "&Psi") ("Omega" "&Omega") ("vert" "|") ++) ) ++ ++; 28 Apr 00; 07 Aug 00 ++; Translate a file of LaTex slides to HTML ++; prefix is a prefix string for output files ++; pagenumber is first page number. ++(defun tohtml (filenm prefix &optional (pagenumber 1)) ++ (let (c) ++ (setq *pagenumber* pagenumber) ++ (setq *prefix* (stringify prefix)) ++ (setq *feof* nil) ++ (setq *ignore* t) ++ (setq *center* nil) ++ (setq *modestack* nil) ++ (setq *verbatim* nil) ++ (with-open-file (infile filenm :direction :input :if-does-not-exist nil) ++ ; skip initial stuff ++ (while (and *ignore* ++ (not (or (null infile) ++ (eq (setq *line* (read-line infile nil 'zzeofvalue)) ++ 'zzeofvalue) ))) ++ (setq *lng* (length *line*)) ++ (setq *ptr* 0) ++ (while (< *ptr* *lng*) ++ (setq c (char *line* *ptr*)) ++ (incf *ptr*) ++ (if (and (char= c #\%) (not *verbatim*)) ++ (flushline) ++ (if (char= c #\\) ++ (if (alpha-char-p (safe-char)) ++ (docommand nil) ) ) ) ) ) ++ (while (not *feof*) (dohtml infile)) ) )) ++ ++; 08 Aug 00; 18 Aug 00; 21 Aug 00; 07 Sep 00; 24 Jul 02; 25 Jul 02; 13 Jan 06 ++; Process input to produce one .html file ++(defvar c) ++(defun dohtml (infile) ++ (let (c) ++ (setq *done* nil) ++ (with-open-file (outfile (concatenate 'string *prefix* ++ (stringify *pagenumber*) ".html") ++ :direction :output :if-exists :supersede) ++ (princ " " outfile) ++ (princ *prefix* outfile) ++ (princ " p. " outfile) ++ (princ (stringify *pagenumber*) outfile) ++ (princ " " outfile) ++ (terpri outfile) ++ (princ "" outfile) (terpri outfile) ++ (terpri outfile) ++ (while (not (or *done* *feof* ++ (setq *feof* ++ (eq (setq *line* (read-line infile nil 'zzeofvalue)) ++ 'zzeofvalue)))) ++ (doline outfile) ++ (terpri outfile) ) ++ ; *pagenumber* is too large by 1 at this point... ++ (if *feof* (incf *pagenumber*)) ++ (format outfile ++ "Contents   ~%" ++ *prefix*) ++ (if (>= *pagenumber* (+ *firstpage* 11)) ++ (format outfile "Page-10   ~%" ++ *prefix* (- *pagenumber* 11))) ++ (if (>= *pagenumber* (+ *firstpage* 2)) ++ (format outfile "Prev   ~%" ++ *prefix* (- *pagenumber* 2))) ++ (if (<= *pagenumber* *lastpage*) ++ (format outfile "Next   ~%" ++ *prefix* *pagenumber*)) ++ (if (<= *pagenumber* (- *lastpage* 9)) ++ (format outfile "Page+10   ~%" ++ *prefix* (+ *pagenumber* 9))) ++ (format outfile ++ "Index   ~%" *prefix*) ++ (princ "" outfile) (terpri outfile) ++ ) ++ )) ++ ++; 13 Jan 06 ++; process *line* ++(defun doline (outfile) ++ (let () ++ (setq *lng* (length *line*)) ++ (setq *ptr* 0) ++ (if (and (= *lng* 0) (not *verbatim*)) ++ (princ "

" outfile)) ++ (while (< *ptr* *lng*) ++ (setq c (char *line* *ptr*)) ++ (incf *ptr*) ++ (if (and (char= c #\%) (not *verbatim*)) ++ (flushline) ++ (if (char= c #\\) ++ (if (alpha-char-p (setq c (safe-char))) ++ (docommand outfile) ++ (if (char= c #\\) ++ (progn (termline outfile) (incf *ptr*)) ++ (if (char= c #\/) ++ (progn (princ " " outfile) (incf *ptr*)) ++ (if (char= c #\[) ++ (progn (pushfont '$ outfile) (incf *ptr*)) ++ (if (char= c #\]) ++ (progn (popenv outfile) (incf *ptr*)) ++ (progn (if *verbatim* (princ #\\ outfile)) ++ (princ c outfile) (incf *ptr*))))))) ++ (if (char= c #\&) ++ (princ "" outfile) ++ (if (char= c #\{) ++ (if *verbatim* ++ (princ #\{ outfile) ++ (pushenv nil)) ++ (if (char= c #\}) ++ (if *verbatim* ++ (princ #\} outfile) ++ (popenv outfile)) ++ (if (and (char= c #\$) (not *verbatim*)) ++ (if (eq (car *modestack*) '$) ++ (popenv outfile) ++ (pushfont '$ outfile)) ++ (if (and (or (char= c #\^) (char= c #\_)) ++ (eq (car *modestack*) '$)) ++ (progn ++ (pushfont (if (char= c #\^) 'sup 'sub) outfile) ++ (searchfor #\{)) ++ (princ (if (char= c #\>) "> " ++ (if (char= c #\<) "< " ++ c)) ++ outfile))))))))) )) ++ ++; 24 Jul 02; 25 Jul 02; 29 Jul 02; 12 Feb 03; 28 Aug 03 ++(defun docommand (outfile) ++ (let (wordstring word subword termch done tmp c pair (saveptr (1- *ptr*))) ++ (setq wordstring (car (parse-word nil))) ++ (setq word (intern (string-upcase wordstring))) ++ (case word ++ ((documentstyle pagestyle setlength hyphenpenalty sloppy ++ large) ++ (flushline)) ++ (setcounter (searchfor #\{) ++ (setq subword (intern (car (parse-word t)))) ++ (when (eq subword 'page) ++ (searchfor #\{) ++ (setq *pagenumber* (1- (parse-int))) ; assumes pagebreak ++ (flushline)) ) ++ (addtocounter (searchfor #\{) ++ (setq subword (intern (car (parse-word t)))) ++ (when (eq subword 'page) ++ (searchfor #\{) ++ (setq *pagenumber* (+ *pagenumber* (parse-int))) ++ (flushline)) ) ++ (includegraphics (searchfor #\{) (searchforalpha) ++ (setq done nil) ++ (while (not done) ++ (setq tmp (parse-word nil)) ++ (if (char= (cadr tmp) #\}) ++ (setq done t) ++ (if (char= (cadr tmp) #\.) ++ (progn (setq done t) ++ (princ "" outfile) ++ (terpri outfile) ++ (flushline) ) ++ (incf *ptr*))))) ++ (begin (searchfor #\{) ++ (setq subword (intern (car (parse-word t)))) ++ (searchfor #\}) ++ ; (format t "subword = ~s~%" subword) ++ (case subword ++ (document (setq *ignore* nil)) ++ (center (pushenv 'center)) ++ (itemize (princ "

    " outfile) (terpri outfile)) ++ (enumerate (princ "
      " outfile) (terpri outfile)) ++ (verbatim (princ "
      " outfile) (terpri outfile)
++		    (setq *verbatim* t))
++	  (tabular (dotabular outfile))
++	  ((quotation abstract quote)
++	    (princ "
      " outfile) (terpri outfile))
++	  ))
++      (end (searchfor #\{)
++	(setq subword (intern (car (parse-word t))))
++	(searchfor #\})
++	(case subword
++	  (document (setq *feof* t))
++	  (center (popenv outfile))
++	  (itemize (princ "
" outfile) (terpri outfile)) ++ (enumerate (princ "" outfile) (terpri outfile)) ++ (verbatim (princ "" outfile) (terpri outfile) ++ (setq *verbatim* nil)) ++ (tabular (princ "" outfile) (terpri outfile) ++ (popenv outfile)) ++ ((quotation abstract quote) ++ (princ "" outfile) (terpri outfile)) ++ )) ++ (item (princ "
  • " outfile)) ++ (pagebreak (setq *done* t) (incf *pagenumber*)) ++ ((bf tt em it) (pushfont word outfile)) ++ ((title section subsection subsubsection paragraph) ++ (searchfor #\{) ++ (pushfont (cadr (assoc word '((title h1) (section h2) ++ (subsection h3) (subsubsection h4) ++ (paragraph b)))) ++ outfile)) ++ ((vspace vspace*) (searchfor #\}) ++ (princ "

    " outfile) (terpri outfile)) ++ ((hspace hspace*) (searchfor #\}) ++ (dotimes (i 8) (princ " " outfile))) ++ ((index) (searchfor #\})) ; ignore and consume ++ (verb (setq termch (char *line* *ptr*)) ++ (incf *ptr*) ++ (pushfont 'tt outfile) ++ (xferchars outfile termch) ++ (popenv outfile) ) ++ ((cite bibitem) (searchfor #\{) ++ (princ "[" outfile) ++ (xferchars outfile #\}) ++ (princ "]" outfile) ) ++ (footnote (searchfor #\{) ++ (princ "[" outfile) ++ (pushenv 'footnote)) ++ (t (if *verbatim* ++ (while (< saveptr *ptr*) ++ (princ (char *line* saveptr) outfile) ++ (incf saveptr)) ++ (if (setq pair (assoc wordstring *specials* :test #'string=)) ++ (princ (cadr pair) outfile)) ) ) ) )) ++ ++; push a new item on the mode stack ++(defun pushenv (item) ++ (if (and *modestack* (eq (car *modestack*) nil)) ++ (setf (car *modestack*) item) ++ (push item *modestack*))) ++ ++; 24 Jul 02; 25 Jul 02 ++(defun popenv (outfile) ++ (let ((item (pop *modestack*)) new) ++ (setq new (cadr (assoc item '((em i) (bf b) (it i) ($ i))))) ++ (case item ++ ((bf tt it em $ h1 h2 h3 h4 sub sup) ++ (princ "" outfile)) ++ (footnote (princ "]" outfile)) ++ ) ++ item)) ++ ++(defun pushfont (word outfile) ++ (let ((new (cadr (assoc word '((em i) (bf b) (it i) ($ i)))))) ++ (pushenv word) ++ (princ "<" outfile) (princ (or new word) outfile) ++ (princ ">" outfile) )) ++ ++; transfer chars to output until termch ++(defun xferchars (outfile termch) ++ (let (done) ++ (while (and (< *ptr* *lng*) (not done)) ++ (setq c (char *line* *ptr*)) ++ (incf *ptr*) ++ (if (char= c termch) ++ (setq done t) ++ (princ c outfile)) ) )) ++ ++(defun dotabular (outfile) ++ (let ((ncols 0) done) ++ (searchfor #\{) ++ (while (and (< *ptr* *lng*) (not done)) ++ (setq c (char *line* *ptr*)) ++ (incf *ptr*) ++ (if (char= c #\}) ++ (setq done t) ++ (if (or (char= c #\l) (char= c #\r) (char= c #\c)) ++ (incf ncols))) ) ++ (princ "" outfile) ++ (terpri outfile) ++ (princ "" outfile) ++ (terpri outfile) ++ (princ "
    " outfile) ++ (pushenv 'table) ++ )) ++ ++(defun termline (outfile) ++ (if (eq (car *modestack*) 'table) ++ (progn (princ "
    " outfile)) ++ (progn (princ "
    " outfile) (terpri outfile) ))) ++ ++(defun safe-char () ++ (if (< *ptr* *lng*) ++ (char *line* *ptr*) ++ #\Space)) ++ ++; Parse a word of alpha/num characters ++; Returns ("word" ch) where ch is the terminating character ++(defun parse-word (upper) ++ (let (c res) ++ (while (and (< *ptr* *lng*) ++ (or (alpha-char-p (setq c (char *line* *ptr*))) ++ (and res (digit-char-p c)) ++ (char= c #\*))) ++ (push (if upper (char-upcase c) c) res) ++ (incf *ptr*)) ++ (if res (list (coerce (nreverse res) 'string) ++ (and (not (alpha-char-p c)) c))) )) ++ ++(defun searchfor (ch) ++ (let (c) ++ (while (and (< *ptr* *lng*) ++ (setq c (char *line* *ptr*)) ++ (not (char= ch c))) ++ (incf *ptr*)) ++ (if (and c (char= ch c)) (incf *ptr*)) ++ c)) ++ ++(defun searchforalpha () ++ (while (and (< *ptr* *lng*) ++ (not (alpha-char-p (char *line* *ptr*)))) ++ (incf *ptr*))) ++ ++(defun flushline () (setq *lng* 0)) ++ ++(defun stringify (x) ++ (cond ((stringp x) x) ++ ((symbolp x) (symbol-name x)) ++ (t (princ-to-string x)))) ++ ++; Parse an integer ++(defun parse-int () ++ (let (c (n 0) digit found) ++ (while (and (< *ptr* *lng*) ++ (setq digit (digit-char-p ++ (setq c (char *line* *ptr*))))) ++ (setq found (or found digit)) ++ (setq n (+ (* n 10) digit)) ++ (incf *ptr*)) ++ (if found n) )) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_keysymdef.lsp +@@ -0,0 +1,1151 @@ ++(in-package :XLIB) ++; keysymdef.lsp modified by Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++;; $XConsortium: keysymdef.h,v 1.13 89/12/12 16:23:30 rws Exp $ ++ ++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ++ ++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ++ ++(defconstant XK_VoidSymbol #xFFFFFF ;; void symbol ++ ++;;#ifdef XK_MISCELLANY ++;; ++ ; TTY Functions, cleverly chosen to map to ascii, for convenience of ++ ; programming, but could have been arbitrary at the cost of lookup ++ ; tables in client code. ++ ++ ++)(defconstant XK_BackSpace #xFF08 ;; back space, back char ++)(defconstant XK_Tab #xFF09 ++)(defconstant XK_Linefeed #xFF0A ;; Linefeed, LF ++)(defconstant XK_Clear #xFF0B ++)(defconstant XK_Return #xFF0D ;; Return, enter ++)(defconstant XK_Pause #xFF13 ;; Pause, hold ++)(defconstant XK_Scroll_Lock #xFF14 ++)(defconstant XK_Escape #xFF1B ++)(defconstant XK_Delete #xFFFF ;; Delete, rubout ++ ++ ++ ++;; International & multi-key character composition ++ ++)(defconstant XK_Multi_key #xFF20 ;; Multi-key character compose ++ ++;; Japanese keyboard support ++ ++)(defconstant XK_Kanji #xFF21 ;; Kanji, Kanji convert ++)(defconstant XK_Muhenkan #xFF22 ;; Cancel Conversion ++)(defconstant XK_Henkan_Mode #xFF23 ;; Start/Stop Conversion ++)(defconstant XK_Henkan #xFF23 ;; Alias for Henkan_Mode ++)(defconstant XK_Romaji #xFF24 ;; to Romaji ++)(defconstant XK_Hiragana #xFF25 ;; to Hiragana ++)(defconstant XK_Katakana #xFF26 ;; to Katakana ++)(defconstant XK_Hiragana_Katakana #xFF27 ;; Hiragana/Katakana toggle ++)(defconstant XK_Zenkaku #xFF28 ;; to Zenkaku ++)(defconstant XK_Hankaku #xFF29 ;; to Hankaku ++)(defconstant XK_Zenkaku_Hankaku #xFF2A ;; Zenkaku/Hankaku toggle ++)(defconstant XK_Touroku #xFF2B ;; Add to Dictionary ++)(defconstant XK_Massyo #xFF2C ;; Delete from Dictionary ++)(defconstant XK_Kana_Lock #xFF2D ;; Kana Lock ++)(defconstant XK_Kana_Shift #xFF2E ;; Kana Shift ++)(defconstant XK_Eisu_Shift #xFF2F ;; Alphanumeric Shift ++)(defconstant XK_Eisu_toggle #xFF30 ;; Alphanumeric toggle ++ ++;; Cursor control & motion ++ ++)(defconstant XK_Home #xFF50 ++)(defconstant XK_Left #xFF51 ;; Move left, left arrow ++)(defconstant XK_Up #xFF52 ;; Move up, up arrow ++)(defconstant XK_Right #xFF53 ;; Move right, right arrow ++)(defconstant XK_Down #xFF54 ;; Move down, down arrow ++)(defconstant XK_Prior #xFF55 ;; Prior, previous ++)(defconstant XK_Next #xFF56 ;; Next ++)(defconstant XK_End #xFF57 ;; EOL ++)(defconstant XK_Begin #xFF58 ;; BOL ++ ++ ++;; Misc Functions ++ ++)(defconstant XK_Select #xFF60 ;; Select, mark ++)(defconstant XK_Print #xFF61 ++)(defconstant XK_Execute #xFF62 ;; Execute, run, do ++)(defconstant XK_Insert #xFF63 ;; Insert, insert here ++)(defconstant XK_Undo #xFF65 ;; Undo, oops ++)(defconstant XK_Redo #xFF66 ;; redo, again ++)(defconstant XK_Menu #xFF67 ++)(defconstant XK_Find #xFF68 ;; Find, search ++)(defconstant XK_Cancel #xFF69 ;; Cancel, stop, abort, exit ++)(defconstant XK_Help #xFF6A ;; Help, ? ++)(defconstant XK_Break #xFF6B ++)(defconstant XK_Mode_switch #xFF7E ;; Character set switch ++)(defconstant XK_script_switch #xFF7E ;; Alias for mode_switch ++)(defconstant XK_Num_Lock #xFF7F ++ ++;; Keypad Functions, keypad numbers cleverly chosen to map to ascii ++ ++)(defconstant XK_KP_Space #xFF80 ;; space ++)(defconstant XK_KP_Tab #xFF89 ++)(defconstant XK_KP_Enter #xFF8D ;; enter ++)(defconstant XK_KP_F1 #xFF91 ;; PF1, KP_A, ... ++)(defconstant XK_KP_F2 #xFF92 ++)(defconstant XK_KP_F3 #xFF93 ++)(defconstant XK_KP_F4 #xFF94 ++)(defconstant XK_KP_Equal #xFFBD ;; equals ++)(defconstant XK_KP_Multiply #xFFAA ++)(defconstant XK_KP_Add #xFFAB ++)(defconstant XK_KP_Separator #xFFAC ;; separator, often comma ++)(defconstant XK_KP_Subtract #xFFAD ++)(defconstant XK_KP_Decimal #xFFAE ++)(defconstant XK_KP_Divide #xFFAF ++)(defconstant XK_KP_0 #xFFB0 ++)(defconstant XK_KP_1 #xFFB1 ++)(defconstant XK_KP_2 #xFFB2 ++)(defconstant XK_KP_3 #xFFB3 ++)(defconstant XK_KP_4 #xFFB4 ++)(defconstant XK_KP_5 #xFFB5 ++)(defconstant XK_KP_6 #xFFB6 ++)(defconstant XK_KP_7 #xFFB7 ++)(defconstant XK_KP_8 #xFFB8 ++)(defconstant XK_KP_9 #xFFB9 ++ ++ ++ ++;; ++ ; Auxilliary Functions; note the duplicate definitions for left and right ++ ; function keys; Sun keyboards and a few other manufactures have such ++ ; function key groups on the left and/or right sides of the keyboard. ++ ; We've not found a keyboard with more than 35 function keys total. ++ ++ ++)(defconstant XK_F1 #xFFBE ++)(defconstant XK_F2 #xFFBF ++)(defconstant XK_F3 #xFFC0 ++)(defconstant XK_F4 #xFFC1 ++)(defconstant XK_F5 #xFFC2 ++)(defconstant XK_F6 #xFFC3 ++)(defconstant XK_F7 #xFFC4 ++)(defconstant XK_F8 #xFFC5 ++)(defconstant XK_F9 #xFFC6 ++)(defconstant XK_F10 #xFFC7 ++)(defconstant XK_F11 #xFFC8 ++)(defconstant XK_L1 #xFFC8 ++)(defconstant XK_F12 #xFFC9 ++)(defconstant XK_L2 #xFFC9 ++)(defconstant XK_F13 #xFFCA ++)(defconstant XK_L3 #xFFCA ++)(defconstant XK_F14 #xFFCB ++)(defconstant XK_L4 #xFFCB ++)(defconstant XK_F15 #xFFCC ++)(defconstant XK_L5 #xFFCC ++)(defconstant XK_F16 #xFFCD ++)(defconstant XK_L6 #xFFCD ++)(defconstant XK_F17 #xFFCE ++)(defconstant XK_L7 #xFFCE ++)(defconstant XK_F18 #xFFCF ++)(defconstant XK_L8 #xFFCF ++)(defconstant XK_F19 #xFFD0 ++)(defconstant XK_L9 #xFFD0 ++)(defconstant XK_F20 #xFFD1 ++)(defconstant XK_L10 #xFFD1 ++)(defconstant XK_F21 #xFFD2 ++)(defconstant XK_R1 #xFFD2 ++)(defconstant XK_F22 #xFFD3 ++)(defconstant XK_R2 #xFFD3 ++)(defconstant XK_F23 #xFFD4 ++)(defconstant XK_R3 #xFFD4 ++)(defconstant XK_F24 #xFFD5 ++)(defconstant XK_R4 #xFFD5 ++)(defconstant XK_F25 #xFFD6 ++)(defconstant XK_R5 #xFFD6 ++)(defconstant XK_F26 #xFFD7 ++)(defconstant XK_R6 #xFFD7 ++)(defconstant XK_F27 #xFFD8 ++)(defconstant XK_R7 #xFFD8 ++)(defconstant XK_F28 #xFFD9 ++)(defconstant XK_R8 #xFFD9 ++)(defconstant XK_F29 #xFFDA ++)(defconstant XK_R9 #xFFDA ++)(defconstant XK_F30 #xFFDB ++)(defconstant XK_R10 #xFFDB ++)(defconstant XK_F31 #xFFDC ++)(defconstant XK_R11 #xFFDC ++)(defconstant XK_F32 #xFFDD ++)(defconstant XK_R12 #xFFDD ++)(defconstant XK_R13 #xFFDE ++)(defconstant XK_F33 #xFFDE ++)(defconstant XK_F34 #xFFDF ++)(defconstant XK_R14 #xFFDF ++)(defconstant XK_F35 #xFFE0 ++)(defconstant XK_R15 #xFFE0 ++ ++;; Modifiers ++ ++)(defconstant XK_Shift_L #xFFE1 ;; Left shift ++)(defconstant XK_Shift_R #xFFE2 ;; Right shift ++)(defconstant XK_Control_L #xFFE3 ;; Left control ++)(defconstant XK_Control_R #xFFE4 ;; Right control ++)(defconstant XK_Caps_Lock #xFFE5 ;; Caps lock ++)(defconstant XK_Shift_Lock #xFFE6 ;; Shift lock ++ ++)(defconstant XK_Meta_L #xFFE7 ;; Left meta ++)(defconstant XK_Meta_R #xFFE8 ;; Right meta ++)(defconstant XK_Alt_L #xFFE9 ;; Left alt ++)(defconstant XK_Alt_R #xFFEA ;; Right alt ++)(defconstant XK_Super_L #xFFEB ;; Left super ++)(defconstant XK_Super_R #xFFEC ;; Right super ++)(defconstant XK_Hyper_L #xFFED ;; Left hyper ++)(defconstant XK_Hyper_R #xFFEE ;; Right hyper ++;;#endif ;; XK_MISCELLANY ++ ++;; ++ ; Latin 1 ++ ; Byte 3 = 0 ++ ++;;ifdef XK_LATIN1 ++)(defconstant XK_space #x020 ++)(defconstant XK_exclam #x021 ++)(defconstant XK_quotedbl #x022 ++)(defconstant XK_numbersign #x023 ++)(defconstant XK_dollar #x024 ++)(defconstant XK_percent #x025 ++)(defconstant XK_ampersand #x026 ++)(defconstant XK_apostrophe #x027 ++)(defconstant XK_quoteright #x027 ;; deprecated ++)(defconstant XK_parenleft #x028 ++)(defconstant XK_parenright #x029 ++)(defconstant XK_asterisk #x02a ++)(defconstant XK_plus #x02b ++)(defconstant XK_comma #x02c ++)(defconstant XK_minus #x02d ++)(defconstant XK_period #x02e ++)(defconstant XK_slash #x02f ++)(defconstant XK_0 #x030 ++)(defconstant XK_1 #x031 ++)(defconstant XK_2 #x032 ++)(defconstant XK_3 #x033 ++)(defconstant XK_4 #x034 ++)(defconstant XK_5 #x035 ++)(defconstant XK_6 #x036 ++)(defconstant XK_7 #x037 ++)(defconstant XK_8 #x038 ++)(defconstant XK_9 #x039 ++)(defconstant XK_colon #x03a ++)(defconstant XK_semicolon #x03b ++)(defconstant XK_less #x03c ++)(defconstant XK_equal #x03d ++)(defconstant XK_greater #x03e ++)(defconstant XK_question #x03f ++)(defconstant XK_at #x040 ++)(defconstant XK_A #x041 ++)(defconstant XK_B #x042 ++)(defconstant XK_C #x043 ++)(defconstant XK_D #x044 ++)(defconstant XK_E #x045 ++)(defconstant XK_F #x046 ++)(defconstant XK_G #x047 ++)(defconstant XK_H #x048 ++)(defconstant XK_I #x049 ++)(defconstant XK_J #x04a ++)(defconstant XK_K #x04b ++)(defconstant XK_L #x04c ++)(defconstant XK_M #x04d ++)(defconstant XK_N #x04e ++)(defconstant XK_O #x04f ++)(defconstant XK_P #x050 ++)(defconstant XK_Q #x051 ++)(defconstant XK_R #x052 ++)(defconstant XK_S #x053 ++)(defconstant XK_T #x054 ++)(defconstant XK_U #x055 ++)(defconstant XK_V #x056 ++)(defconstant XK_W #x057 ++)(defconstant XK_X #x058 ++)(defconstant XK_Y #x059 ++)(defconstant XK_Z #x05a ++)(defconstant XK_bracketleft #x05b ++)(defconstant XK_backslash #x05c ++)(defconstant XK_bracketright #x05d ++)(defconstant XK_asciicircum #x05e ++)(defconstant XK_underscore #x05f ++)(defconstant XK_grave #x060 ++)(defconstant XK_quoteleft #x060 ;; deprecated ++)(defconstant XK_a #x061 ++)(defconstant XK_b #x062 ++)(defconstant XK_c #x063 ++)(defconstant XK_d #x064 ++)(defconstant XK_e #x065 ++)(defconstant XK_f #x066 ++)(defconstant XK_g #x067 ++)(defconstant XK_h #x068 ++)(defconstant XK_i #x069 ++)(defconstant XK_j #x06a ++)(defconstant XK_k #x06b ++)(defconstant XK_l #x06c ++)(defconstant XK_m #x06d ++)(defconstant XK_n #x06e ++)(defconstant XK_o #x06f ++)(defconstant XK_p #x070 ++)(defconstant XK_q #x071 ++)(defconstant XK_r #x072 ++)(defconstant XK_s #x073 ++)(defconstant XK_t #x074 ++)(defconstant XK_u #x075 ++)(defconstant XK_v #x076 ++)(defconstant XK_w #x077 ++)(defconstant XK_x #x078 ++)(defconstant XK_y #x079 ++)(defconstant XK_z #x07a ++)(defconstant XK_braceleft #x07b ++)(defconstant XK_bar #x07c ++)(defconstant XK_braceright #x07d ++)(defconstant XK_asciitilde #x07e ++ ++)(defconstant XK_nobreakspace #x0a0 ++)(defconstant XK_exclamdown #x0a1 ++)(defconstant XK_cent #x0a2 ++)(defconstant XK_sterling #x0a3 ++)(defconstant XK_currency #x0a4 ++)(defconstant XK_yen #x0a5 ++)(defconstant XK_brokenbar #x0a6 ++)(defconstant XK_section #x0a7 ++)(defconstant XK_diaeresis #x0a8 ++)(defconstant XK_copyright #x0a9 ++)(defconstant XK_ordfeminine #x0aa ++)(defconstant XK_guillemotleft #x0ab ;; left angle quotation mark ++)(defconstant XK_notsign #x0ac ++)(defconstant XK_hyphen #x0ad ++)(defconstant XK_registered #x0ae ++)(defconstant XK_macron #x0af ++)(defconstant XK_degree #x0b0 ++)(defconstant XK_plusminus #x0b1 ++)(defconstant XK_twosuperior #x0b2 ++)(defconstant XK_threesuperior #x0b3 ++)(defconstant XK_acute #x0b4 ++)(defconstant XK_mu #x0b5 ++)(defconstant XK_paragraph #x0b6 ++)(defconstant XK_periodcentered #x0b7 ++)(defconstant XK_cedilla #x0b8 ++)(defconstant XK_onesuperior #x0b9 ++)(defconstant XK_masculine #x0ba ++)(defconstant XK_guillemotright #x0bb ;; right angle quotation mark ++)(defconstant XK_onequarter #x0bc ++)(defconstant XK_onehalf #x0bd ++)(defconstant XK_threequarters #x0be ++)(defconstant XK_questiondown #x0bf ++)(defconstant XK_Agrave #x0c0 ++)(defconstant XK_Aacute #x0c1 ++)(defconstant XK_Acircumflex #x0c2 ++)(defconstant XK_Atilde #x0c3 ++)(defconstant XK_Adiaeresis #x0c4 ++)(defconstant XK_Aring #x0c5 ++)(defconstant XK_AE #x0c6 ++)(defconstant XK_Ccedilla #x0c7 ++)(defconstant XK_Egrave #x0c8 ++)(defconstant XK_Eacute #x0c9 ++)(defconstant XK_Ecircumflex #x0ca ++)(defconstant XK_Ediaeresis #x0cb ++)(defconstant XK_Igrave #x0cc ++)(defconstant XK_Iacute #x0cd ++)(defconstant XK_Icircumflex #x0ce ++)(defconstant XK_Idiaeresis #x0cf ++)(defconstant XK_ETH #x0d0 ++)(defconstant XK_Eth #x0d0 ;; deprecated ++)(defconstant XK_Ntilde #x0d1 ++)(defconstant XK_Ograve #x0d2 ++)(defconstant XK_Oacute #x0d3 ++)(defconstant XK_Ocircumflex #x0d4 ++)(defconstant XK_Otilde #x0d5 ++)(defconstant XK_Odiaeresis #x0d6 ++)(defconstant XK_multiply #x0d7 ++)(defconstant XK_Ooblique #x0d8 ++)(defconstant XK_Ugrave #x0d9 ++)(defconstant XK_Uacute #x0da ++)(defconstant XK_Ucircumflex #x0db ++)(defconstant XK_Udiaeresis #x0dc ++)(defconstant XK_Yacute #x0dd ++)(defconstant XK_THORN #x0de ++)(defconstant XK_Thorn #x0de ;; deprecated ++)(defconstant XK_ssharp #x0df ++)(defconstant XK_agrave #x0e0 ++)(defconstant XK_aacute #x0e1 ++)(defconstant XK_acircumflex #x0e2 ++)(defconstant XK_atilde #x0e3 ++)(defconstant XK_adiaeresis #x0e4 ++)(defconstant XK_aring #x0e5 ++)(defconstant XK_ae #x0e6 ++)(defconstant XK_ccedilla #x0e7 ++)(defconstant XK_egrave #x0e8 ++)(defconstant XK_eacute #x0e9 ++)(defconstant XK_ecircumflex #x0ea ++)(defconstant XK_ediaeresis #x0eb ++)(defconstant XK_igrave #x0ec ++)(defconstant XK_iacute #x0ed ++)(defconstant XK_icircumflex #x0ee ++)(defconstant XK_idiaeresis #x0ef ++)(defconstant XK_eth #x0f0 ++)(defconstant XK_ntilde #x0f1 ++)(defconstant XK_ograve #x0f2 ++)(defconstant XK_oacute #x0f3 ++)(defconstant XK_ocircumflex #x0f4 ++)(defconstant XK_otilde #x0f5 ++)(defconstant XK_odiaeresis #x0f6 ++)(defconstant XK_division #x0f7 ++)(defconstant XK_oslash #x0f8 ++)(defconstant XK_ugrave #x0f9 ++)(defconstant XK_uacute #x0fa ++)(defconstant XK_ucircumflex #x0fb ++)(defconstant XK_udiaeresis #x0fc ++)(defconstant XK_yacute #x0fd ++)(defconstant XK_thorn #x0fe ++)(defconstant XK_ydiaeresis #x0ff ++;;endif ;; XK_LATIN1 ++ ++;; ++ ; Latin 2 ++ ; Byte 3 = 1 ++ ++ ++;;ifdef XK_LATIN2 ++)(defconstant XK_Aogonek #x1a1 ++)(defconstant XK_breve #x1a2 ++)(defconstant XK_Lstroke #x1a3 ++)(defconstant XK_Lcaron #x1a5 ++)(defconstant XK_Sacute #x1a6 ++)(defconstant XK_Scaron #x1a9 ++)(defconstant XK_Scedilla #x1aa ++)(defconstant XK_Tcaron #x1ab ++)(defconstant XK_Zacute #x1ac ++)(defconstant XK_Zcaron #x1ae ++)(defconstant XK_Zabovedot #x1af ++)(defconstant XK_aogonek #x1b1 ++)(defconstant XK_ogonek #x1b2 ++)(defconstant XK_lstroke #x1b3 ++)(defconstant XK_lcaron #x1b5 ++)(defconstant XK_sacute #x1b6 ++)(defconstant XK_caron #x1b7 ++)(defconstant XK_scaron #x1b9 ++)(defconstant XK_scedilla #x1ba ++)(defconstant XK_tcaron #x1bb ++)(defconstant XK_zacute #x1bc ++)(defconstant XK_doubleacute #x1bd ++)(defconstant XK_zcaron #x1be ++)(defconstant XK_zabovedot #x1bf ++)(defconstant XK_Racute #x1c0 ++)(defconstant XK_Abreve #x1c3 ++)(defconstant XK_Lacute #x1c5 ++)(defconstant XK_Cacute #x1c6 ++)(defconstant XK_Ccaron #x1c8 ++)(defconstant XK_Eogonek #x1ca ++)(defconstant XK_Ecaron #x1cc ++)(defconstant XK_Dcaron #x1cf ++)(defconstant XK_Dstroke #x1d0 ++)(defconstant XK_Nacute #x1d1 ++)(defconstant XK_Ncaron #x1d2 ++)(defconstant XK_Odoubleacute #x1d5 ++)(defconstant XK_Rcaron #x1d8 ++)(defconstant XK_Uring #x1d9 ++)(defconstant XK_Udoubleacute #x1db ++)(defconstant XK_Tcedilla #x1de ++)(defconstant XK_racute #x1e0 ++)(defconstant XK_abreve #x1e3 ++)(defconstant XK_lacute #x1e5 ++)(defconstant XK_cacute #x1e6 ++)(defconstant XK_ccaron #x1e8 ++)(defconstant XK_eogonek #x1ea ++)(defconstant XK_ecaron #x1ec ++)(defconstant XK_dcaron #x1ef ++)(defconstant XK_dstroke #x1f0 ++)(defconstant XK_nacute #x1f1 ++)(defconstant XK_ncaron #x1f2 ++)(defconstant XK_odoubleacute #x1f5 ++)(defconstant XK_udoubleacute #x1fb ++)(defconstant XK_rcaron #x1f8 ++)(defconstant XK_uring #x1f9 ++)(defconstant XK_tcedilla #x1fe ++)(defconstant XK_abovedot #x1ff ++;;endif ;; XK_LATIN2 ++ ++;; ++ ; Latin 3 ++ ; Byte 3 = 2 ++ ++ ++;;ifdef XK_LATIN3 ++)(defconstant XK_Hstroke #x2a1 ++)(defconstant XK_Hcircumflex #x2a6 ++)(defconstant XK_Iabovedot #x2a9 ++)(defconstant XK_Gbreve #x2ab ++)(defconstant XK_Jcircumflex #x2ac ++)(defconstant XK_hstroke #x2b1 ++)(defconstant XK_hcircumflex #x2b6 ++)(defconstant XK_idotless #x2b9 ++)(defconstant XK_gbreve #x2bb ++)(defconstant XK_jcircumflex #x2bc ++)(defconstant XK_Cabovedot #x2c5 ++)(defconstant XK_Ccircumflex #x2c6 ++)(defconstant XK_Gabovedot #x2d5 ++)(defconstant XK_Gcircumflex #x2d8 ++)(defconstant XK_Ubreve #x2dd ++)(defconstant XK_Scircumflex #x2de ++)(defconstant XK_cabovedot #x2e5 ++)(defconstant XK_ccircumflex #x2e6 ++)(defconstant XK_gabovedot #x2f5 ++)(defconstant XK_gcircumflex #x2f8 ++)(defconstant XK_ubreve #x2fd ++)(defconstant XK_scircumflex #x2fe ++;;endif ;; XK_LATIN3 ++ ++ ++;; ++ ; Latin 4 ++ ; Byte 3 = 3 ++ ++ ++;;ifdef XK_LATIN4 ++)(defconstant XK_kra #x3a2 ++)(defconstant XK_kappa #x3a2 ;; deprecated ++)(defconstant XK_Rcedilla #x3a3 ++)(defconstant XK_Itilde #x3a5 ++)(defconstant XK_Lcedilla #x3a6 ++)(defconstant XK_Emacron #x3aa ++)(defconstant XK_Gcedilla #x3ab ++)(defconstant XK_Tslash #x3ac ++)(defconstant XK_rcedilla #x3b3 ++)(defconstant XK_itilde #x3b5 ++)(defconstant XK_lcedilla #x3b6 ++)(defconstant XK_emacron #x3ba ++)(defconstant XK_gcedilla #x3bb ++)(defconstant XK_tslash #x3bc ++)(defconstant XK_ENG #x3bd ++)(defconstant XK_eng #x3bf ++)(defconstant XK_Amacron #x3c0 ++)(defconstant XK_Iogonek #x3c7 ++)(defconstant XK_Eabovedot #x3cc ++)(defconstant XK_Imacron #x3cf ++)(defconstant XK_Ncedilla #x3d1 ++)(defconstant XK_Omacron #x3d2 ++)(defconstant XK_Kcedilla #x3d3 ++)(defconstant XK_Uogonek #x3d9 ++)(defconstant XK_Utilde #x3dd ++)(defconstant XK_Umacron #x3de ++)(defconstant XK_amacron #x3e0 ++)(defconstant XK_iogonek #x3e7 ++)(defconstant XK_eabovedot #x3ec ++)(defconstant XK_imacron #x3ef ++)(defconstant XK_ncedilla #x3f1 ++)(defconstant XK_omacron #x3f2 ++)(defconstant XK_kcedilla #x3f3 ++)(defconstant XK_uogonek #x3f9 ++)(defconstant XK_utilde #x3fd ++)(defconstant XK_umacron #x3fe ++;;endif ;; XK_LATIN4 ++ ++;; ++ ; Katakana ++ ; Byte 3 = 4 ++ ++ ++;;ifdef XK_KATAKANA ++)(defconstant XK_overline #x47e ++)(defconstant XK_kana_fullstop #x4a1 ++)(defconstant XK_kana_openingbracket #x4a2 ++)(defconstant XK_kana_closingbracket #x4a3 ++)(defconstant XK_kana_comma #x4a4 ++)(defconstant XK_kana_conjunctive #x4a5 ++)(defconstant XK_kana_middledot #x4a5 ;; deprecated ++)(defconstant XK_kana_WO #x4a6 ++)(defconstant XK_kana_a #x4a7 ++)(defconstant XK_kana_i #x4a8 ++)(defconstant XK_kana_u #x4a9 ++)(defconstant XK_kana_e #x4aa ++)(defconstant XK_kana_o #x4ab ++)(defconstant XK_kana_ya #x4ac ++)(defconstant XK_kana_yu #x4ad ++)(defconstant XK_kana_yo #x4ae ++)(defconstant XK_kana_tsu #x4af ++)(defconstant XK_kana_tu #x4af ;; deprecated ++)(defconstant XK_prolongedsound #x4b0 ++)(defconstant XK_kana_A #x4b1 ++)(defconstant XK_kana_I #x4b2 ++)(defconstant XK_kana_U #x4b3 ++)(defconstant XK_kana_E #x4b4 ++)(defconstant XK_kana_O #x4b5 ++)(defconstant XK_kana_KA #x4b6 ++)(defconstant XK_kana_KI #x4b7 ++)(defconstant XK_kana_KU #x4b8 ++)(defconstant XK_kana_KE #x4b9 ++)(defconstant XK_kana_KO #x4ba ++)(defconstant XK_kana_SA #x4bb ++)(defconstant XK_kana_SHI #x4bc ++)(defconstant XK_kana_SU #x4bd ++)(defconstant XK_kana_SE #x4be ++)(defconstant XK_kana_SO #x4bf ++)(defconstant XK_kana_TA #x4c0 ++)(defconstant XK_kana_CHI #x4c1 ++)(defconstant XK_kana_TI #x4c1 ;; deprecated ++)(defconstant XK_kana_TSU #x4c2 ++)(defconstant XK_kana_TU #x4c2 ;; deprecated ++)(defconstant XK_kana_TE #x4c3 ++)(defconstant XK_kana_TO #x4c4 ++)(defconstant XK_kana_NA #x4c5 ++)(defconstant XK_kana_NI #x4c6 ++)(defconstant XK_kana_NU #x4c7 ++)(defconstant XK_kana_NE #x4c8 ++)(defconstant XK_kana_NO #x4c9 ++)(defconstant XK_kana_HA #x4ca ++)(defconstant XK_kana_HI #x4cb ++)(defconstant XK_kana_FU #x4cc ++)(defconstant XK_kana_HU #x4cc ;; deprecated ++)(defconstant XK_kana_HE #x4cd ++)(defconstant XK_kana_HO #x4ce ++)(defconstant XK_kana_MA #x4cf ++)(defconstant XK_kana_MI #x4d0 ++)(defconstant XK_kana_MU #x4d1 ++)(defconstant XK_kana_ME #x4d2 ++)(defconstant XK_kana_MO #x4d3 ++)(defconstant XK_kana_YA #x4d4 ++)(defconstant XK_kana_YU #x4d5 ++)(defconstant XK_kana_YO #x4d6 ++)(defconstant XK_kana_RA #x4d7 ++)(defconstant XK_kana_RI #x4d8 ++)(defconstant XK_kana_RU #x4d9 ++)(defconstant XK_kana_RE #x4da ++)(defconstant XK_kana_RO #x4db ++)(defconstant XK_kana_WA #x4dc ++)(defconstant XK_kana_N #x4dd ++)(defconstant XK_voicedsound #x4de ++)(defconstant XK_semivoicedsound #x4df ++)(defconstant XK_kana_switch #xFF7E ;; Alias for mode_switch ++;;endif ;; XK_KATAKANA ++ ++;; ++ ; Arabic ++ ; Byte 3 = 5 ++ ++ ++;;ifdef XK_ARABIC ++)(defconstant XK_Arabic_comma #x5ac ++)(defconstant XK_Arabic_semicolon #x5bb ++)(defconstant XK_Arabic_question_mark #x5bf ++)(defconstant XK_Arabic_hamza #x5c1 ++)(defconstant XK_Arabic_maddaonalef #x5c2 ++)(defconstant XK_Arabic_hamzaonalef #x5c3 ++)(defconstant XK_Arabic_hamzaonwaw #x5c4 ++)(defconstant XK_Arabic_hamzaunderalef #x5c5 ++)(defconstant XK_Arabic_hamzaonyeh #x5c6 ++)(defconstant XK_Arabic_alef #x5c7 ++)(defconstant XK_Arabic_beh #x5c8 ++)(defconstant XK_Arabic_tehmarbuta #x5c9 ++)(defconstant XK_Arabic_teh #x5ca ++)(defconstant XK_Arabic_theh #x5cb ++)(defconstant XK_Arabic_jeem #x5cc ++)(defconstant XK_Arabic_hah #x5cd ++)(defconstant XK_Arabic_khah #x5ce ++)(defconstant XK_Arabic_dal #x5cf ++)(defconstant XK_Arabic_thal #x5d0 ++)(defconstant XK_Arabic_ra #x5d1 ++)(defconstant XK_Arabic_zain #x5d2 ++)(defconstant XK_Arabic_seen #x5d3 ++)(defconstant XK_Arabic_sheen #x5d4 ++)(defconstant XK_Arabic_sad #x5d5 ++)(defconstant XK_Arabic_dad #x5d6 ++)(defconstant XK_Arabic_tah #x5d7 ++)(defconstant XK_Arabic_zah #x5d8 ++)(defconstant XK_Arabic_ain #x5d9 ++)(defconstant XK_Arabic_ghain #x5da ++)(defconstant XK_Arabic_tatweel #x5e0 ++)(defconstant XK_Arabic_feh #x5e1 ++)(defconstant XK_Arabic_qaf #x5e2 ++)(defconstant XK_Arabic_kaf #x5e3 ++)(defconstant XK_Arabic_lam #x5e4 ++)(defconstant XK_Arabic_meem #x5e5 ++)(defconstant XK_Arabic_noon #x5e6 ++)(defconstant XK_Arabic_ha #x5e7 ++)(defconstant XK_Arabic_heh #x5e7 ;; deprecated ++)(defconstant XK_Arabic_waw #x5e8 ++)(defconstant XK_Arabic_alefmaksura #x5e9 ++)(defconstant XK_Arabic_yeh #x5ea ++)(defconstant XK_Arabic_fathatan #x5eb ++)(defconstant XK_Arabic_dammatan #x5ec ++)(defconstant XK_Arabic_kasratan #x5ed ++)(defconstant XK_Arabic_fatha #x5ee ++)(defconstant XK_Arabic_damma #x5ef ++)(defconstant XK_Arabic_kasra #x5f0 ++)(defconstant XK_Arabic_shadda #x5f1 ++)(defconstant XK_Arabic_sukun #x5f2 ++)(defconstant XK_Arabic_switch #xFF7E ;; Alias for mode_switch ++;;endif ;; XK_ARABIC ++ ++;; ++ ; Cyrillic ++ ; Byte 3 = 6 ++ ++;;ifdef XK_CYRILLIC ++)(defconstant XK_Serbian_dje #x6a1 ++)(defconstant XK_Macedonia_gje #x6a2 ++)(defconstant XK_Cyrillic_io #x6a3 ++)(defconstant XK_Ukrainian_ie #x6a4 ++)(defconstant XK_Ukranian_je #x6a4 ;; deprecated ++)(defconstant XK_Macedonia_dse #x6a5 ++)(defconstant XK_Ukrainian_i #x6a6 ++)(defconstant XK_Ukranian_i #x6a6 ;; deprecated ++)(defconstant XK_Ukrainian_yi #x6a7 ++)(defconstant XK_Ukranian_yi #x6a7 ;; deprecated ++)(defconstant XK_Cyrillic_je #x6a8 ++)(defconstant XK_Serbian_je #x6a8 ;; deprecated ++)(defconstant XK_Cyrillic_lje #x6a9 ++)(defconstant XK_Serbian_lje #x6a9 ;; deprecated ++)(defconstant XK_Cyrillic_nje #x6aa ++)(defconstant XK_Serbian_nje #x6aa ;; deprecated ++)(defconstant XK_Serbian_tshe #x6ab ++)(defconstant XK_Macedonia_kje #x6ac ++)(defconstant XK_Byelorussian_shortu #x6ae ++)(defconstant XK_Cyrillic_dzhe #x6af ++)(defconstant XK_Serbian_dze #x6af ;; deprecated ++)(defconstant XK_numerosign #x6b0 ++)(defconstant XK_Serbian_DJE #x6b1 ++)(defconstant XK_Macedonia_GJE #x6b2 ++)(defconstant XK_Cyrillic_IO #x6b3 ++)(defconstant XK_Ukrainian_IE #x6b4 ++)(defconstant XK_Ukranian_JE #x6b4 ;; deprecated ++)(defconstant XK_Macedonia_DSE #x6b5 ++)(defconstant XK_Ukrainian_I #x6b6 ++)(defconstant XK_Ukranian_I #x6b6 ;; deprecated ++)(defconstant XK_Ukrainian_YI #x6b7 ++)(defconstant XK_Ukranian_YI #x6b7 ;; deprecated ++)(defconstant XK_Cyrillic_JE #x6b8 ++)(defconstant XK_Serbian_JE #x6b8 ;; deprecated ++)(defconstant XK_Cyrillic_LJE #x6b9 ++)(defconstant XK_Serbian_LJE #x6b9 ;; deprecated ++)(defconstant XK_Cyrillic_NJE #x6ba ++)(defconstant XK_Serbian_NJE #x6ba ;; deprecated ++)(defconstant XK_Serbian_TSHE #x6bb ++)(defconstant XK_Macedonia_KJE #x6bc ++)(defconstant XK_Byelorussian_SHORTU #x6be ++)(defconstant XK_Cyrillic_DZHE #x6bf ++)(defconstant XK_Serbian_DZE #x6bf ;; deprecated ++)(defconstant XK_Cyrillic_yu #x6c0 ++)(defconstant XK_Cyrillic_a #x6c1 ++)(defconstant XK_Cyrillic_be #x6c2 ++)(defconstant XK_Cyrillic_tse #x6c3 ++)(defconstant XK_Cyrillic_de #x6c4 ++)(defconstant XK_Cyrillic_ie #x6c5 ++)(defconstant XK_Cyrillic_ef #x6c6 ++)(defconstant XK_Cyrillic_ghe #x6c7 ++)(defconstant XK_Cyrillic_ha #x6c8 ++)(defconstant XK_Cyrillic_i #x6c9 ++)(defconstant XK_Cyrillic_shorti #x6ca ++)(defconstant XK_Cyrillic_ka #x6cb ++)(defconstant XK_Cyrillic_el #x6cc ++)(defconstant XK_Cyrillic_em #x6cd ++)(defconstant XK_Cyrillic_en #x6ce ++)(defconstant XK_Cyrillic_o #x6cf ++)(defconstant XK_Cyrillic_pe #x6d0 ++)(defconstant XK_Cyrillic_ya #x6d1 ++)(defconstant XK_Cyrillic_er #x6d2 ++)(defconstant XK_Cyrillic_es #x6d3 ++)(defconstant XK_Cyrillic_te #x6d4 ++)(defconstant XK_Cyrillic_u #x6d5 ++)(defconstant XK_Cyrillic_zhe #x6d6 ++)(defconstant XK_Cyrillic_ve #x6d7 ++)(defconstant XK_Cyrillic_softsign #x6d8 ++)(defconstant XK_Cyrillic_yeru #x6d9 ++)(defconstant XK_Cyrillic_ze #x6da ++)(defconstant XK_Cyrillic_sha #x6db ++)(defconstant XK_Cyrillic_e #x6dc ++)(defconstant XK_Cyrillic_shcha #x6dd ++)(defconstant XK_Cyrillic_che #x6de ++)(defconstant XK_Cyrillic_hardsign #x6df ++)(defconstant XK_Cyrillic_YU #x6e0 ++)(defconstant XK_Cyrillic_A #x6e1 ++)(defconstant XK_Cyrillic_BE #x6e2 ++)(defconstant XK_Cyrillic_TSE #x6e3 ++)(defconstant XK_Cyrillic_DE #x6e4 ++)(defconstant XK_Cyrillic_IE #x6e5 ++)(defconstant XK_Cyrillic_EF #x6e6 ++)(defconstant XK_Cyrillic_GHE #x6e7 ++)(defconstant XK_Cyrillic_HA #x6e8 ++)(defconstant XK_Cyrillic_I #x6e9 ++)(defconstant XK_Cyrillic_SHORTI #x6ea ++)(defconstant XK_Cyrillic_KA #x6eb ++)(defconstant XK_Cyrillic_EL #x6ec ++)(defconstant XK_Cyrillic_EM #x6ed ++)(defconstant XK_Cyrillic_EN #x6ee ++)(defconstant XK_Cyrillic_O #x6ef ++)(defconstant XK_Cyrillic_PE #x6f0 ++)(defconstant XK_Cyrillic_YA #x6f1 ++)(defconstant XK_Cyrillic_ER #x6f2 ++)(defconstant XK_Cyrillic_ES #x6f3 ++)(defconstant XK_Cyrillic_TE #x6f4 ++)(defconstant XK_Cyrillic_U #x6f5 ++)(defconstant XK_Cyrillic_ZHE #x6f6 ++)(defconstant XK_Cyrillic_VE #x6f7 ++)(defconstant XK_Cyrillic_SOFTSIGN #x6f8 ++)(defconstant XK_Cyrillic_YERU #x6f9 ++)(defconstant XK_Cyrillic_ZE #x6fa ++)(defconstant XK_Cyrillic_SHA #x6fb ++)(defconstant XK_Cyrillic_E #x6fc ++)(defconstant XK_Cyrillic_SHCHA #x6fd ++)(defconstant XK_Cyrillic_CHE #x6fe ++)(defconstant XK_Cyrillic_HARDSIGN #x6ff ++;;endif ;; XK_CYRILLIC ++ ++;; ++ ; Greek ++ ; Byte 3 = 7 ++ ++ ++;;ifdef XK_GREEK ++)(defconstant XK_Greek_ALPHAaccent #x7a1 ++)(defconstant XK_Greek_EPSILONaccent #x7a2 ++)(defconstant XK_Greek_ETAaccent #x7a3 ++)(defconstant XK_Greek_IOTAaccent #x7a4 ++)(defconstant XK_Greek_IOTAdiaeresis #x7a5 ++)(defconstant XK_Greek_OMICRONaccent #x7a7 ++)(defconstant XK_Greek_UPSILONaccent #x7a8 ++)(defconstant XK_Greek_UPSILONdieresis #x7a9 ++)(defconstant XK_Greek_OMEGAaccent #x7ab ++)(defconstant XK_Greek_accentdieresis #x7ae ++)(defconstant XK_Greek_horizbar #x7af ++)(defconstant XK_Greek_alphaaccent #x7b1 ++)(defconstant XK_Greek_epsilonaccent #x7b2 ++)(defconstant XK_Greek_etaaccent #x7b3 ++)(defconstant XK_Greek_iotaaccent #x7b4 ++)(defconstant XK_Greek_iotadieresis #x7b5 ++)(defconstant XK_Greek_iotaaccentdieresis #x7b6 ++)(defconstant XK_Greek_omicronaccent #x7b7 ++)(defconstant XK_Greek_upsilonaccent #x7b8 ++)(defconstant XK_Greek_upsilondieresis #x7b9 ++)(defconstant XK_Greek_upsilonaccentdieresis #x7ba ++)(defconstant XK_Greek_omegaaccent #x7bb ++)(defconstant XK_Greek_ALPHA #x7c1 ++)(defconstant XK_Greek_BETA #x7c2 ++)(defconstant XK_Greek_GAMMA #x7c3 ++)(defconstant XK_Greek_DELTA #x7c4 ++)(defconstant XK_Greek_EPSILON #x7c5 ++)(defconstant XK_Greek_ZETA #x7c6 ++)(defconstant XK_Greek_ETA #x7c7 ++)(defconstant XK_Greek_THETA #x7c8 ++)(defconstant XK_Greek_IOTA #x7c9 ++)(defconstant XK_Greek_KAPPA #x7ca ++)(defconstant XK_Greek_LAMDA #x7cb ++)(defconstant XK_Greek_LAMBDA #x7cb ++)(defconstant XK_Greek_MU #x7cc ++)(defconstant XK_Greek_NU #x7cd ++)(defconstant XK_Greek_XI #x7ce ++)(defconstant XK_Greek_OMICRON #x7cf ++)(defconstant XK_Greek_PI #x7d0 ++)(defconstant XK_Greek_RHO #x7d1 ++)(defconstant XK_Greek_SIGMA #x7d2 ++)(defconstant XK_Greek_TAU #x7d4 ++)(defconstant XK_Greek_UPSILON #x7d5 ++)(defconstant XK_Greek_PHI #x7d6 ++)(defconstant XK_Greek_CHI #x7d7 ++)(defconstant XK_Greek_PSI #x7d8 ++)(defconstant XK_Greek_OMEGA #x7d9 ++)(defconstant XK_Greek_alpha #x7e1 ++)(defconstant XK_Greek_beta #x7e2 ++)(defconstant XK_Greek_gamma #x7e3 ++)(defconstant XK_Greek_delta #x7e4 ++)(defconstant XK_Greek_epsilon #x7e5 ++)(defconstant XK_Greek_zeta #x7e6 ++)(defconstant XK_Greek_eta #x7e7 ++)(defconstant XK_Greek_theta #x7e8 ++)(defconstant XK_Greek_iota #x7e9 ++)(defconstant XK_Greek_kappa #x7ea ++)(defconstant XK_Greek_lamda #x7eb ++)(defconstant XK_Greek_lambda #x7eb ++)(defconstant XK_Greek_mu #x7ec ++)(defconstant XK_Greek_nu #x7ed ++)(defconstant XK_Greek_xi #x7ee ++)(defconstant XK_Greek_omicron #x7ef ++)(defconstant XK_Greek_pi #x7f0 ++)(defconstant XK_Greek_rho #x7f1 ++)(defconstant XK_Greek_sigma #x7f2 ++)(defconstant XK_Greek_finalsmallsigma #x7f3 ++)(defconstant XK_Greek_tau #x7f4 ++)(defconstant XK_Greek_upsilon #x7f5 ++)(defconstant XK_Greek_phi #x7f6 ++)(defconstant XK_Greek_chi #x7f7 ++)(defconstant XK_Greek_psi #x7f8 ++)(defconstant XK_Greek_omega #x7f9 ++)(defconstant XK_Greek_switch #xFF7E ;; Alias for mode_switch ++;;endif ;; XK_GREEK ++ ++;; ++ ; Technical ++ ; Byte 3 = 8 ++ ++ ++;;ifdef XK_TECHNICAL ++)(defconstant XK_leftradical #x8a1 ++)(defconstant XK_topleftradical #x8a2 ++)(defconstant XK_horizconnector #x8a3 ++)(defconstant XK_topintegral #x8a4 ++)(defconstant XK_botintegral #x8a5 ++)(defconstant XK_vertconnector #x8a6 ++)(defconstant XK_topleftsqbracket #x8a7 ++)(defconstant XK_botleftsqbracket #x8a8 ++)(defconstant XK_toprightsqbracket #x8a9 ++)(defconstant XK_botrightsqbracket #x8aa ++)(defconstant XK_topleftparens #x8ab ++)(defconstant XK_botleftparens #x8ac ++)(defconstant XK_toprightparens #x8ad ++)(defconstant XK_botrightparens #x8ae ++)(defconstant XK_leftmiddlecurlybrace #x8af ++)(defconstant XK_rightmiddlecurlybrace #x8b0 ++)(defconstant XK_topleftsummation #x8b1 ++)(defconstant XK_botleftsummation #x8b2 ++)(defconstant XK_topvertsummationconnector #x8b3 ++)(defconstant XK_botvertsummationconnector #x8b4 ++)(defconstant XK_toprightsummation #x8b5 ++)(defconstant XK_botrightsummation #x8b6 ++)(defconstant XK_rightmiddlesummation #x8b7 ++)(defconstant XK_lessthanequal #x8bc ++)(defconstant XK_notequal #x8bd ++)(defconstant XK_greaterthanequal #x8be ++)(defconstant XK_integral #x8bf ++)(defconstant XK_therefore #x8c0 ++)(defconstant XK_variation #x8c1 ++)(defconstant XK_infinity #x8c2 ++)(defconstant XK_nabla #x8c5 ++)(defconstant XK_approximate #x8c8 ++)(defconstant XK_similarequal #x8c9 ++)(defconstant XK_ifonlyif #x8cd ++)(defconstant XK_implies #x8ce ++)(defconstant XK_identical #x8cf ++)(defconstant XK_radical #x8d6 ++)(defconstant XK_includedin #x8da ++)(defconstant XK_includes #x8db ++)(defconstant XK_intersection #x8dc ++)(defconstant XK_union #x8dd ++)(defconstant XK_logicaland #x8de ++)(defconstant XK_logicalor #x8df ++)(defconstant XK_partialderivative #x8ef ++)(defconstant XK_function #x8f6 ++)(defconstant XK_leftarrow #x8fb ++)(defconstant XK_uparrow #x8fc ++)(defconstant XK_rightarrow #x8fd ++)(defconstant XK_downarrow #x8fe ++;;endif ;; XK_TECHNICAL ++ ++;; ++ ; Special ++ ; Byte 3 = 9 ++ ++ ++;;ifdef XK_SPECIAL ++)(defconstant XK_blank #x9df ++)(defconstant XK_soliddiamond #x9e0 ++)(defconstant XK_checkerboard #x9e1 ++)(defconstant XK_ht #x9e2 ++)(defconstant XK_ff #x9e3 ++)(defconstant XK_cr #x9e4 ++)(defconstant XK_lf #x9e5 ++)(defconstant XK_nl #x9e8 ++)(defconstant XK_vt #x9e9 ++)(defconstant XK_lowrightcorner #x9ea ++)(defconstant XK_uprightcorner #x9eb ++)(defconstant XK_upleftcorner #x9ec ++)(defconstant XK_lowleftcorner #x9ed ++)(defconstant XK_crossinglines #x9ee ++)(defconstant XK_horizlinescan1 #x9ef ++)(defconstant XK_horizlinescan3 #x9f0 ++)(defconstant XK_horizlinescan5 #x9f1 ++)(defconstant XK_horizlinescan7 #x9f2 ++)(defconstant XK_horizlinescan9 #x9f3 ++)(defconstant XK_leftt #x9f4 ++)(defconstant XK_rightt #x9f5 ++)(defconstant XK_bott #x9f6 ++)(defconstant XK_topt #x9f7 ++)(defconstant XK_vertbar #x9f8 ++;;endif ;; XK_SPECIAL ++ ++;; ++ ; Publishing ++ ; Byte 3 = a ++ ++ ++;;ifdef XK_PUBLISHING ++)(defconstant XK_emspace #xaa1 ++)(defconstant XK_enspace #xaa2 ++)(defconstant XK_em3space #xaa3 ++)(defconstant XK_em4space #xaa4 ++)(defconstant XK_digitspace #xaa5 ++)(defconstant XK_punctspace #xaa6 ++)(defconstant XK_thinspace #xaa7 ++)(defconstant XK_hairspace #xaa8 ++)(defconstant XK_emdash #xaa9 ++)(defconstant XK_endash #xaaa ++)(defconstant XK_signifblank #xaac ++)(defconstant XK_ellipsis #xaae ++)(defconstant XK_doubbaselinedot #xaaf ++)(defconstant XK_onethird #xab0 ++)(defconstant XK_twothirds #xab1 ++)(defconstant XK_onefifth #xab2 ++)(defconstant XK_twofifths #xab3 ++)(defconstant XK_threefifths #xab4 ++)(defconstant XK_fourfifths #xab5 ++)(defconstant XK_onesixth #xab6 ++)(defconstant XK_fivesixths #xab7 ++)(defconstant XK_careof #xab8 ++)(defconstant XK_figdash #xabb ++)(defconstant XK_leftanglebracket #xabc ++)(defconstant XK_decimalpoint #xabd ++)(defconstant XK_rightanglebracket #xabe ++)(defconstant XK_marker #xabf ++)(defconstant XK_oneeighth #xac3 ++)(defconstant XK_threeeighths #xac4 ++)(defconstant XK_fiveeighths #xac5 ++)(defconstant XK_seveneighths #xac6 ++)(defconstant XK_trademark #xac9 ++)(defconstant XK_signaturemark #xaca ++)(defconstant XK_trademarkincircle #xacb ++)(defconstant XK_leftopentriangle #xacc ++)(defconstant XK_rightopentriangle #xacd ++)(defconstant XK_emopencircle #xace ++)(defconstant XK_emopenrectangle #xacf ++)(defconstant XK_leftsinglequotemark #xad0 ++)(defconstant XK_rightsinglequotemark #xad1 ++)(defconstant XK_leftdoublequotemark #xad2 ++)(defconstant XK_rightdoublequotemark #xad3 ++)(defconstant XK_prescription #xad4 ++)(defconstant XK_minutes #xad6 ++)(defconstant XK_seconds #xad7 ++)(defconstant XK_latincross #xad9 ++)(defconstant XK_hexagram #xada ++)(defconstant XK_filledrectbullet #xadb ++)(defconstant XK_filledlefttribullet #xadc ++)(defconstant XK_filledrighttribullet #xadd ++)(defconstant XK_emfilledcircle #xade ++)(defconstant XK_emfilledrect #xadf ++)(defconstant XK_enopencircbullet #xae0 ++)(defconstant XK_enopensquarebullet #xae1 ++)(defconstant XK_openrectbullet #xae2 ++)(defconstant XK_opentribulletup #xae3 ++)(defconstant XK_opentribulletdown #xae4 ++)(defconstant XK_openstar #xae5 ++)(defconstant XK_enfilledcircbullet #xae6 ++)(defconstant XK_enfilledsqbullet #xae7 ++)(defconstant XK_filledtribulletup #xae8 ++)(defconstant XK_filledtribulletdown #xae9 ++)(defconstant XK_leftpointer #xaea ++)(defconstant XK_rightpointer #xaeb ++)(defconstant XK_club #xaec ++)(defconstant XK_diamond #xaed ++)(defconstant XK_heart #xaee ++)(defconstant XK_maltesecross #xaf0 ++)(defconstant XK_dagger #xaf1 ++)(defconstant XK_doubledagger #xaf2 ++)(defconstant XK_checkmark #xaf3 ++)(defconstant XK_ballotcross #xaf4 ++)(defconstant XK_musicalsharp #xaf5 ++)(defconstant XK_musicalflat #xaf6 ++)(defconstant XK_malesymbol #xaf7 ++)(defconstant XK_femalesymbol #xaf8 ++)(defconstant XK_telephone #xaf9 ++)(defconstant XK_telephonerecorder #xafa ++)(defconstant XK_phonographcopyright #xafb ++)(defconstant XK_caret #xafc ++)(defconstant XK_singlelowquotemark #xafd ++)(defconstant XK_doublelowquotemark #xafe ++)(defconstant XK_cursor #xaff ++;;endif ;; XK_PUBLISHING ++ ++;; ++ ; APL ++ ; Byte 3 = b ++ ++ ++;;ifdef XK_APL ++)(defconstant XK_leftcaret #xba3 ++)(defconstant XK_rightcaret #xba6 ++)(defconstant XK_downcaret #xba8 ++)(defconstant XK_upcaret #xba9 ++)(defconstant XK_overbar #xbc0 ++)(defconstant XK_downtack #xbc2 ++)(defconstant XK_upshoe #xbc3 ++)(defconstant XK_downstile #xbc4 ++)(defconstant XK_underbar #xbc6 ++)(defconstant XK_jot #xbca ++)(defconstant XK_quad #xbcc ++)(defconstant XK_uptack #xbce ++)(defconstant XK_circle #xbcf ++)(defconstant XK_upstile #xbd3 ++)(defconstant XK_downshoe #xbd6 ++)(defconstant XK_rightshoe #xbd8 ++)(defconstant XK_leftshoe #xbda ++)(defconstant XK_lefttack #xbdc ++)(defconstant XK_righttack #xbfc ++;;endif ;; XK_APL ++ ++;; ++ ; Hebrew ++ ; Byte 3 = c ++ ++ ++;;ifdef XK_HEBREW ++)(defconstant XK_hebrew_doublelowline #xcdf ++)(defconstant XK_hebrew_aleph #xce0 ++)(defconstant XK_hebrew_bet #xce1 ++)(defconstant XK_hebrew_beth #xce1 ;; deprecated ++)(defconstant XK_hebrew_gimel #xce2 ++)(defconstant XK_hebrew_gimmel #xce2 ;; deprecated ++)(defconstant XK_hebrew_dalet #xce3 ++)(defconstant XK_hebrew_daleth #xce3 ;; deprecated ++)(defconstant XK_hebrew_he #xce4 ++)(defconstant XK_hebrew_waw #xce5 ++)(defconstant XK_hebrew_zain #xce6 ++)(defconstant XK_hebrew_zayin #xce6 ;; deprecated ++)(defconstant XK_hebrew_chet #xce7 ++)(defconstant XK_hebrew_het #xce7 ;; deprecated ++)(defconstant XK_hebrew_tet #xce8 ++)(defconstant XK_hebrew_teth #xce8 ;; deprecated ++)(defconstant XK_hebrew_yod #xce9 ++)(defconstant XK_hebrew_finalkaph #xcea ++)(defconstant XK_hebrew_kaph #xceb ++)(defconstant XK_hebrew_lamed #xcec ++)(defconstant XK_hebrew_finalmem #xced ++)(defconstant XK_hebrew_mem #xcee ++)(defconstant XK_hebrew_finalnun #xcef ++)(defconstant XK_hebrew_nun #xcf0 ++)(defconstant XK_hebrew_samech #xcf1 ++)(defconstant XK_hebrew_samekh #xcf1 ;; deprecated ++)(defconstant XK_hebrew_ayin #xcf2 ++)(defconstant XK_hebrew_finalpe #xcf3 ++)(defconstant XK_hebrew_pe #xcf4 ++)(defconstant XK_hebrew_finalzade #xcf5 ++)(defconstant XK_hebrew_finalzadi #xcf5 ;; deprecated ++)(defconstant XK_hebrew_zade #xcf6 ++)(defconstant XK_hebrew_zadi #xcf6 ;; deprecated ++)(defconstant XK_hebrew_qoph #xcf7 ++)(defconstant XK_hebrew_kuf #xcf7 ;; deprecated ++)(defconstant XK_hebrew_resh #xcf8 ++)(defconstant XK_hebrew_shin #xcf9 ++)(defconstant XK_hebrew_taw #xcfa ++)(defconstant XK_hebrew_taf #xcfa ;; deprecated ++)(defconstant XK_Hebrew_switch #xFF7E ;; Alias for mode_switch ++;;endif ;; XK_HEBREW ++) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_Xinit.lsp +@@ -0,0 +1,147 @@ ++(in-package :XLIB) ++; Xinit.lsp Hiep Huu Nguyen 27 Aug 92; GSN 07 Mar 95 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++;;a word about Xakcl: ++;;Since Xakcl is a direct translation of the X library in C to lisp to a ++;;large extent. it would be beneficial to use a X 11 version 4, manual ++;;in order to look up functions. the only unique functions of Xakcl are those ++;;that involove manipulating C structs. all functions involved in creating ++;;a C struct in X starts with a 'make' followed by the structure name. all ++;;functions involved in getting a field of a C struct strats with the ++;;name of the C struct followed by the name of the field. the ++;;parameters it excepts is the varaible contaning the structure. all ++;;functions to set a field of a C struct starts with 'set' followed by ++;;the C struct name followed by the field name. these functions accept ++;;as parameter, the varaible containing the struct and the value to be ++;;put in the field. ++ ++;;;; ++;;contents of this file: ++;;;; ++;;this files has examples of initializing the display, screen, ++;;root-window, pixel value, gc, and colormap. ++;;;; ++;;gives an example of opening windows, setting size's and sizehints for ++;;the window manager getting drawbles' geometry ++;;;; ++;;drawing lines , drawing in color, changing line, attributes ++;;;; ++;;tracking the mouse and handling events and manipulating the event ++;;queue ++;;;; ++;;there is also some basic text handling stuff ++;;;; ++ ++;;globals ++(defvar *default-display* ) ++(defvar *default-screen* ) ++(defvar *default-colormap*) ++(defvar *root-window* ) ++(defvar *black-pixel* ) ++(defvar *white-pixel* ) ++(defvar *default-size-hints* (make-XsizeHints) ) ++(defvar *default-GC* ) ++(defvar *default-event* (make-XEvent)) ++(defvar *pos-x* 10) ++(defvar *pos-y* 20) ++(defvar *win-width* 225) ++(defvar *win-height* 400) ++(defvar *border-width* 1) ++(defvar *root-return* (int-array 1)) ++(defvar *x-return* (int-array 1)) ++(defvar *y-return* (int-array 1) ) ++(defvar *width-return* (int-array 1)) ++(defvar *height-return* (int-array 1)) ++(defvar *border-width-return* (int-array 1)) ++(defvar *depth-return* (int-array 1)) ++(defvar *GC-Values* (make-XGCValues)) ++ ++;;an example window ++(defvar a-window) ++ ++ ++;;;;;;;;;;;;;;;;;;;;;; ++;;this function initializes all varaibles needed by most applications. ++;;it uses all defaults which is inherited from the root window, and ++;;screen. ++ ++(defun Xinit() ++ (setq *default-display* (XOpenDisplay (get-c-string ""))) ++ (setq *default-screen* (XdefaultScreen *default-display*)) ++ (setq *root-window* (XRootWindow *default-display* *default-screen*)) ++ (setq *black-pixel* (XBlackPixel *default-display* ++ *default-screen*)) ++ (setq *white-pixel* (XWhitePixel *default-display* ++ *default-screen*)) ++ (setq *default-GC* (XDefaultGC *default-display* *default-screen*)) ++ (setq *default-colormap* ( XDefaultColormap *default-display* *default-screen*)) ++ (Xflush *default-display* )) ++ ++ ++ ++ ++;;;;;;;;;;;;;;;;;;;;;; ++;;this is an example of creating a window. this function takes care of ++;;positioning, size and other attirbutes of the window. ++ ++(defun open-window(&key (pos-x *pos-x* ) (pos-y *pos-y*) (win-width *win-width*) ++ (win-height *win-height* ) ++ (border-width *border-width*) (window-name "My Window") ++ (icon-name "My Icon")) ++;;create the window ++ ++ (let (( a-window (XCreateSimpleWindow ++ *default-display* *root-window* ++ pos-x pos-y win-width win-height border-width *black-pixel* *white-pixel*))) ++ ++;; all children of the root window needs a XSizeHints to tell the window manager ++;; how to position it, etc ++ ++ (set-Xsizehints-x *default-size-hints* pos-x) ++ (set-xsizehints-y *default-size-hints* pos-y) ++ (set-xsizehints-width *default-size-hints* win-width) ++ (set-xsizehints-height *default-size-hints* win-height) ++ (set-xsizehints-flags *default-size-hints* (+ Psize Pposition)) ++ (XsetStandardProperties *default-display* a-window (get-c-string window-name) ++ (get-c-string icon-name) none 0 0 *default-size-hints*) ++ ++;; the events or input a window can have are set with Xselectinput ++;; (Xselectinput *default-display* a-window ++;; (+ ButtonpressMask PointerMotionMask ExposureMask)) ++ ++;; the window needs to be mapped ++ (Xmapwindow *default-display* a-window) ++ ++;;the X server needs to have the output buffer sent to it before it can ++;;process requests. this is acomplished with XFlush or functions that ++;;read and manipulate the event queue. remember to do this after ++;;operations that won't be calling an eventhandling function ++ ++ (Xflush *default-display* ) ++ ++;;after flushing the request buffer the X server draws window as requested ++ ++ a-window)) ++ ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_dwtestcases.lsp +@@ -0,0 +1,32 @@ ++(load "/stage/ftp/pub/novak/xgcl-4/gcl_dwtrans.lsp") ++(use-package 'xlib) ++(load "/stage/ftp/pub/novak/xgcl-4/gcl_drawtrans.lsp") ++(load "/stage/ftp/pub/novak/xgcl-4/gcl_editorstrans.lsp") ++(load "/stage/ftp/pub/novak/xgcl-4/gcl_lispservertrans.lsp") ++(load "/stage/ftp/pub/novak/xgcl-4/gcl_menu-settrans.lsp") ++(load "/stage/ftp/pub/novak/xgcl-4/gcl_dwtest.lsp") ++(load "/stage/ftp/pub/novak/xgcl-4/gcl_draw-gates.lsp") ++ ++(wtesta) ++(wtestb) ++(wtestc) ++(wtestd) ++(wteste) ++(wtestf) ++(wtestg) ++(wtesth) ++(wtesti) ++(wtestj) ++(wtestk) ++ ++(window-clear myw) ++(edit-color myw) ++ ++(lisp-server) ++ ++(draw 'foo) ++ ++(window-draw-box-xy myw 48 48 204 204) ++(window-edit myw 50 50 200 200 '("Now is the time" "for all" "good")) ++ ++(draw-nand myw 50 50) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_editorstrans.lsp +@@ -0,0 +1,589 @@ ++; 07 Jan 2010 16:43:40 EST ++; This program 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 program 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 program; if not, see . ++ ++ ++(DEFUN EDIT-THERMOM (NUM W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) ++ (PROG (NMIN NDEL NDIV RANGE PTEN DRANGE PAIR NEWW (RES NUM) OFF) ++ (WHEN (NOT SIZEX) (SETQ SIZEX 150) (SETQ SIZEY 250)) ++ (WHEN (NOT OFFSETX) ++ (SETQ OFF ++ (LET ((GLVAR168 (LIST SIZEX SIZEY))) ++ (LIST (TRUNCATE (- (FIFTH W) (CAR GLVAR168)) 2) ++ (TRUNCATE (- (CADDDR W) (CADR GLVAR168)) 2)))) ++ (SETQ OFFSETX (CAR OFF)) ++ (SETQ OFFSETY (CADR OFF))) ++ (SETQ NEWW ++ (WINDOW-CREATE SIZEX SIZEY NIL (CADR W) OFFSETX OFFSETY)) ++ (WINDOW-DRAW-BUTTON NEWW "Typein" 80 20 50 25) ++ (WINDOW-DRAW-BUTTON NEWW "Adjust" 80 70 50 25) ++ (WINDOW-DRAW-BUTTON NEWW "Done" 80 120 50 25) ++ RN ++ (SETQ RANGE (* 2 (ABS RES))) ++ (IF (ZEROP RANGE) (SETQ RANGE 50)) ++ (IF (AND (< RANGE 8) (INTEGERP NUM)) (SETQ RANGE 10)) ++ (SETQ PTEN (EXPT 10 (TRUNCATE (LOG RANGE 10)))) ++ (SETQ DRANGE (/ (* 10 RANGE) PTEN)) ++ (SETQ PAIR ++ (CAR (SOME #'(LAMBDA (X) (> (CAR X) DRANGE)) ++ '((14 2) (20 4) (40 5) (70 10) (101 20))))) ++ (SETQ NDEL (* 1/10 (* (CADR PAIR) PTEN))) ++ (SETQ NDIV (CEILING (/ RANGE NDEL))) ++ (SETQ NMIN (IF (>= RES 0) 0 (- (* NDEL NDIV)))) ++ (WINDOW-DRAW-THERMOMETER NEWW NMIN NDEL NDIV RES 10 10 ++ (+ -20 SIZEY)) ++ LP ++ (CASE (BUTTON-SELECT NEWW ++ '((DONE (84 124) (42 17)) (ADJUST (84 74) (42 17)) ++ (TYPEIN (84 24) (42 17)))) ++ (DONE (XDESTROYWINDOW *WINDOW-DISPLAY* (CADR NEWW)) ++ (XFLUSH *WINDOW-DISPLAY*) (SETF (CADR NEWW) NIL) ++ (XFREEGC *WINDOW-DISPLAY* (CADDR NEWW)) ++ (SETF (CADDR NEWW) NIL) (RETURN RES)) ++ (ADJUST (SETQ RES ++ (WINDOW-ADJUST-THERMOMETER NEWW NMIN NDEL NDIV RES ++ 10 10 (+ -20 SIZEY))) ++ (GO LP)) ++ (TYPEIN (PRINC "Enter new value: ") (SETQ RES (READ)) ++ (IF (AND (>= RES NMIN) (<= RES (+ NMIN (* NDEL NDIV)))) ++ (PROGN ++ (WINDOW-SET-THERMOMETER NEWW NMIN NDEL NDIV RES 10 ++ 10 (+ -20 SIZEY)) ++ (GO LP)) ++ (GO RN)))))) ++(SETF (GET 'EDIT-THERMOM 'GLARGUMENTS) ++ '((NUM NUMBER) (W WINDOW) (&OPTIONAL INTEGER) (OFFSETX INTEGER) ++ (OFFSETY INTEGER) (SIZEX INTEGER))) ++(SETF (GET 'EDIT-THERMOM 'GLFNRESULTTYPE) 'NUMBER) ++ ++ ++(DEFUN WINDOW-DRAW-BUTTON (W S OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (SW) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX ++ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) ++ (WINDOW-DRAW-RCBOX-XY W OFFSETX OFFSETY SIZEX SIZEY 8) ++ (SETQ SW ++ (LET ((SSTR (STRINGIFY S))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ (LET ((SSTR (STRINGIFY S))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) ++ (+ OFFSETX (* 1/2 (- SIZEX SW))) ++ (+ -8 (- (CADDDR W) OFFSETY)) (GET-C-STRING SSTR) ++ (LENGTH SSTR))) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN WINDOW-CENTER-PRINT (W S OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (SW) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX ++ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) ++ (SETQ SW ++ (LET ((SSTR (STRINGIFY S))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ (LET ((SSTR (STRINGIFY S))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) ++ (+ OFFSETX (* 1/2 (- SIZEX SW))) ++ (- (CADDDR W) (+ OFFSETY (+ -5 (* 1/2 SIZEY)))) ++ (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN WINDOW-DRAW-THERMOMETER ++ (W NMIN NDEL NDIV VAL OFFSETX OFFSETY SIZEY) ++ (LET (HDEL MARKY) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX ++ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) 66 SIZEY 0) ++ (EDITORS-PRINT-IN-BOX VAL W OFFSETX OFFSETY 40 20) ++ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) OFFSETX ++ (+ -48 (- (CADDDR W) OFFSETY)) 24 24 8448 17664) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) ++ (+ -44 (- QQWHEIGHT OFFSETY)) (+ 4 OFFSETX) ++ (+ 8 (- QQWHEIGHT (+ OFFSETY SIZEY))))) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 20 OFFSETX) ++ (+ -44 (- QQWHEIGHT OFFSETY)) (+ 20 OFFSETX) ++ (+ 8 (- QQWHEIGHT (+ OFFSETY SIZEY))))) ++ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) ++ (- (CADDDR W) (+ OFFSETY SIZEY)) 16 16 0 11520) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 1 0) ++ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 8 OFFSETX) ++ (+ -40 (- (CADDDR W) OFFSETY)) 8 8 0 23040) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0) ++ (SETQ HDEL (/ (+ -56 SIZEY) NDIV)) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 1 0) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 12 OFFSETX) ++ (+ -35 (- QQWHEIGHT OFFSETY)) (+ 12 OFFSETX) ++ (- QQWHEIGHT ++ (+ (+ 48 OFFSETY) (* HDEL (/ (- VAL NMIN) NDEL))))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) ++ (DOTIMES (I (1+ NDIV)) ++ (SETQ MARKY (+ (+ 48 OFFSETY) (* I HDEL))) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 24 OFFSETX) ++ (- QQWHEIGHT MARKY) (+ 34 OFFSETX) (- QQWHEIGHT MARKY)) ++ NIL) ++ (LET ((SSTR (STRINGIFY (+ NMIN (* I NDEL))))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) ++ (+ 36 OFFSETX) (+ 6 (- (CADDDR W) MARKY)) ++ (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN WINDOW-SET-THERMOMETER ++ (W NMIN NDEL NDIV VAL OFFSETX OFFSETY SIZEY) ++ (LET (HDEL) ++ (SETQ HDEL (/ (+ -56 SIZEY) NDIV)) ++ (LET ((GLVAR204 (+ -56 SIZEY))) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) (+ 7 OFFSETX) ++ (- (CADDDR W) (1- (+ (+ 48 OFFSETY) GLVAR204))) 10 GLVAR204 ++ 0)) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 1 0) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 12 OFFSETX) ++ (+ -35 (- QQWHEIGHT OFFSETY)) (+ 12 OFFSETX) ++ (- QQWHEIGHT ++ (+ (+ 48 OFFSETY) (* HDEL (/ (- VAL NMIN) NDEL))))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) ++ (EDITORS-UPDATE-IN-BOX VAL W OFFSETX OFFSETY 40 20))) ++ ++(DEFUN WINDOW-ADJUST-THERMOMETER ++ (W NMIN NDEL NDIV VAL OFFSETX OFFSETY SIZEY) ++ (LET (HDEL LASTY XMIN XMAX YMIN YMAX INSIDE NEWVAL) ++ (SETQ HDEL (/ (+ -56 SIZEY) NDIV)) ++ (SETQ LASTY ++ (TRUNCATE (+ (+ 48 OFFSETY) (* HDEL (/ (- VAL NMIN) NDEL))))) ++ (SETQ XMIN (+ 4 OFFSETX)) ++ (SETQ XMAX (+ 20 OFFSETX)) ++ (SETQ YMIN (+ 48 OFFSETY)) ++ (SETQ YMAX (+ -8 (+ OFFSETY SIZEY))) ++ (WINDOW-TRACK-MOUSE W ++ #'(LAMBDA (X Y CODE) ++ (SETQ INSIDE ++ (AND (>= X XMIN) (<= X XMAX) (>= Y YMIN) (<= Y YMAX))) ++ (WHEN (AND INSIDE (/= Y LASTY)) ++ (IF (> Y LASTY) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 ++ 1 0) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) ++ (+ 12 OFFSETX) (- QQWHEIGHT LASTY) ++ (+ 12 OFFSETX) (- QQWHEIGHT Y)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 ++ 1 0)) ++ (LET ((GLVAR214 (- LASTY Y))) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) (+ 7 OFFSETX) ++ (- (CADDDR W) (1- (+ (1+ Y) GLVAR214))) 10 ++ GLVAR214 0))) ++ (SETQ LASTY Y) ++ (SETQ NEWVAL ++ (+ (* (/ (+ -48 (- LASTY OFFSETY)) (FLOAT HDEL)) ++ NDEL) ++ NMIN)) ++ (IF (INTEGERP VAL) (SETQ NEWVAL (TRUNCATE NEWVAL))) ++ (EDITORS-UPDATE-IN-BOX NEWVAL W OFFSETX OFFSETY 40 20)) ++ (NOT (ZEROP CODE)))) ++ (IF INSIDE NEWVAL VAL))) ++(SETF (GET 'WINDOW-ADJUST-THERMOMETER 'GLARGUMENTS) ++ '((W WINDOW) (NMIN INTEGER) (NDEL INTEGER) (NDIV INTEGER) ++ (VAL NUMBER) (OFFSETX INTEGER) (OFFSETY INTEGER) ++ (SIZEY INTEGER))) ++(SETF (GET 'WINDOW-ADJUST-THERMOMETER 'GLFNRESULTTYPE) 'NUMBER) ++ ++ ++(DEFUN BUTTON-SELECT (MW BUTTONS) ++ (LET (CURRENT-BUTTON ITEM ITEMS VAL XZERO YZERO) ++ (SETQ XZERO 0) ++ (SETQ YZERO 0) ++ (WINDOW-TRACK-MOUSE MW ++ #'(LAMBDA (X Y CODE) ++ (DECF X XZERO) ++ (DECF Y YZERO) ++ (AND (>= X 0) (>= Y 0)) ++ (IF CURRENT-BUTTON ++ (WHEN (NOT (BUTTON-CONTAINSXY? CURRENT-BUTTON X Y)) ++ (BUTTON-INVERT MW CURRENT-BUTTON) ++ (SETQ CURRENT-BUTTON NIL))) ++ (WHEN (NOT CURRENT-BUTTON) ++ (SETQ ITEMS BUTTONS) ++ (WHILE (AND (NOT CURRENT-BUTTON) (SETQ ITEM (POP ITEMS))) ++ (WHEN (BUTTON-CONTAINSXY? ITEM X Y) ++ (SETQ CURRENT-BUTTON ITEM) ++ (BUTTON-INVERT MW CURRENT-BUTTON)))) ++ (WHEN (PLUSP CODE) ++ (IF CURRENT-BUTTON (BUTTON-INVERT MW CURRENT-BUTTON)) ++ (SETQ VAL (OR CURRENT-BUTTON *PICMENU-NO-SELECTION*)))) ++ T) ++ (IF (NOT (EQUAL VAL *PICMENU-NO-SELECTION*)) (CAR VAL)))) ++(SETF (GET 'BUTTON-SELECT 'GLARGUMENTS) ++ '((MW WINDOW) (BUTTONS (LISTOF PICMENU-BUTTON)))) ++(SETF (GET 'BUTTON-SELECT 'GLFNRESULTTYPE) 'SYMBOL) ++ ++ ++(DEFUN BUTTON-INVERT (W BUTTON) ++ (WINDOW-INVERT-AREA W (CADR BUTTON) (CADDR BUTTON))) ++ ++(DEFUN WINDOW-UNDRAW-BOX (W OFFSET SIZE &OPTIONAL LW) ++ (LET ((GC (CADDR W))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 3) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*)))) ++ (WINDOW-DRAW-BOX W OFFSET SIZE LW) ++ (LET ((GC (CADDR W))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) ++ ++(DEFUN BUTTON-CONTAINSXY? (B X Y) ++ (LET ((XSIZE 6) (YSIZE 6)) ++ (WHEN (CADDR B) ++ (SETQ XSIZE (CAADDR B)) ++ (SETQ YSIZE (CADR (CADDR B)))) ++ (AND (>= X (CAADR B)) (<= X (+ (CAADR B) XSIZE)) (>= Y (CADADR B)) ++ (<= Y (+ (CADADR B) YSIZE))))) ++(SETF (GET 'BUTTON-CONTAINSXY? 'GLARGUMENTS) ++ '((B PICMENU-BUTTON) (X INTEGER) (Y INTEGER))) ++(SETF (GET 'BUTTON-CONTAINSXY? 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(SETF (GET 'MENU-ITEM 'GLSTRUCTURE) ++ '((Z ANYTHING) PROP ((VALUE ((IF Z IS ATOMIC Z (CDR Z))))) MSG ++ ((PRINT-SIZE MENU-ITEM-PRINT-SIZE) (DRAW MENU-ITEM-DRAW)))) ++ ++ ++(DEFUN MENU-ITEM-PRINT-SIZE (ITEM W) ++ (LET (SIZ) ++ (IF (ATOM ITEM) ++ (LIST (LET ((SSTR (STRINGIFY ITEM))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) ++ (LENGTH SSTR))) ++ 11) ++ (IF (STRINGP (CAR ITEM)) ++ (LIST (LET ((SSTR (STRINGIFY (CAR ITEM)))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) ++ (LENGTH SSTR))) ++ 11) ++ (IF (AND (SYMBOLP (CAR ITEM)) ++ (SETQ SIZ (GET (CAR ITEM) 'DISPLAY-SIZE))) ++ SIZ (COPY-LIST '(50 11))))))) ++(SETF (GET 'MENU-ITEM-PRINT-SIZE 'GLARGUMENTS) ++ '((ITEM MENU-ITEM) (W WINDOW))) ++(SETF (GET 'MENU-ITEM-PRINT-SIZE 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN MENU-ITEM-DRAW (ITEM W OFFSETX OFFSETY SIZEX SIZEY) ++ (IF (ATOM ITEM) ++ (WINDOW-CENTER-PRINT W ITEM OFFSETX OFFSETY SIZEX SIZEY) ++ (IF (AND (SYMBOLP (CAR ITEM)) (FBOUNDP (CAR ITEM))) ++ (FUNCALL (CAR ITEM) W OFFSETX OFFSETY) ++ (WINDOW-CENTER-PRINT W (CAR ITEM) OFFSETX OFFSETY SIZEX ++ SIZEY)))) ++ ++(DEFUN PICK-ONE-SIZE (ITEMS W) ++ (LET (WID) ++ (DOLIST (ITEM ITEMS) ++ (SETQ WID ++ (IF WID (MAX WID (CAR (MENU-ITEM-PRINT-SIZE ITEM W))) ++ (CAR (MENU-ITEM-PRINT-SIZE ITEM W))))) ++ (LIST WID 11))) ++(SETF (GET 'PICK-ONE-SIZE 'GLARGUMENTS) ++ '((ITEMS (LISTOF MENU-ITEM)) (W WINDOW))) ++(SETF (GET 'PICK-ONE-SIZE 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-PICK-ONE ++ (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (ITM) ++ (IF (SETQ ITM ++ (SOME #'(LAMBDA (GLVAR216) ++ (IF (EQUAL (IF (ATOM GLVAR216) GLVAR216 ++ (CDR GLVAR216)) ++ VAL) ++ GLVAR216)) ++ ITEMS)) ++ (MENU-ITEM-DRAW ITM W OFFSETX OFFSETY SIZEX SIZEY)))) ++ ++(DEFUN EDIT-PICK-ONE ++ (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (NEWVAL) ++ (IF (<= (LENGTH ITEMS) 3) ++ (IF (EQUAL VAL ++ (LET ((SELF (FIRST ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))) ++ (SETQ NEWVAL ++ (LET ((SELF (SECOND ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))) ++ (IF (EQUAL VAL ++ (LET ((SELF (SECOND ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))) ++ (SETQ NEWVAL ++ (IF (THIRD ITEMS) ++ (LET ((SELF (THIRD ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF))) ++ (LET ((SELF (FIRST ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF))))) ++ (SETQ NEWVAL ++ (LET ((SELF (FIRST ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))))) ++ (SETQ NEWVAL (MENU ITEMS))) ++ (DRAW-PICK-ONE NEWVAL W ITEMS OFFSETX OFFSETY SIZEX SIZEY) ++ NEWVAL)) ++ ++(DEFUN DRAW-BLACK-WHITE ++ (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (ITM) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX ++ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) ++ (IF (SETQ ITM ++ (SOME #'(LAMBDA (GLVAR218) ++ (IF (EQUAL (IF (ATOM GLVAR218) GLVAR218 ++ (CDR GLVAR218)) ++ VAL) ++ GLVAR218)) ++ ITEMS)) ++ (WHEN (EQL (IF (CONSP ITM) (CAR ITM) ITM) 1) ++ (LET ((GC (CADDR W))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 ++ *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 ++ *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (LOGXOR *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*))))) ++ (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR W) (CADDR W) OFFSETX ++ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY) ++ (LET ((GC (CADDR W))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ *WINDOW-SAVE-FOREGROUND*)))))) ++ ++(DEFUN EDIT-BLACK-WHITE ++ (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (NEWVAL) ++ (IF (EQUAL VAL ++ (LET ((SELF (FIRST ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))) ++ (SETQ NEWVAL ++ (LET ((SELF (SECOND ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))) ++ (IF (EQUAL VAL ++ (LET ((SELF (SECOND ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))) ++ (SETQ NEWVAL ++ (LET ((SELF (FIRST ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))))) ++ (DRAW-BLACK-WHITE ITEMS NEWVAL W OFFSETX OFFSETY SIZEX SIZEY) ++ NEWVAL)) ++ ++(DEFUN DRAW-INTEGER (VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) ++ (EDITORS-ANYTHING-PRINT VAL W OFFSETX OFFSETY SIZEX SIZEY)) ++ ++(DEFUN DRAW-REAL (VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (STR NC LNG FMT) ++ (IF (NULL SIZEX) (SETQ SIZEX 50)) ++ (SETQ NC (MAX 1 (TRUNCATE SIZEX 7))) ++ (SETQ STR (PRINC-TO-STRING VAL)) ++ (SETQ LNG (LENGTH STR)) ++ (IF (> LNG NC) ++ (IF (OR (FIND #\. STR :START NC) (FIND #\E STR) (FIND #\L STR)) ++ (IF (>= NC 8) ++ (PROGN ++ (SETQ FMT ++ (CADR (OR (ASSOC NC ++ '((8 "~8,2E") (9 "~9,2E") ++ (10 "~10,2E") (11 "~11,2E") ++ (12 "~12,2E") (13 "~13,2E") ++ (14 "~14,2E"))) ++ '(15 "~15,2E")))) ++ (SETQ STR (FORMAT NIL FMT VAL))) ++ (SETQ STR "*******")) ++ (SETQ STR (SUBSEQ STR 0 NC)))) ++ (EDITORS-ANYTHING-PRINT W STR OFFSETX OFFSETY SIZEX SIZEY))) ++ ++(DEFUN EDITORS-ANYTHING-PRINT (OBJ W OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (SWIDTH SMAX DX DY) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX ++ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) ++ (SETQ SWIDTH ++ (LET ((SSTR (STRINGIFY (STRINGIFY OBJ)))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ (SETQ SMAX (MIN SWIDTH SIZEX)) ++ (SETQ DX (* 1/2 (- SIZEX SMAX))) ++ (SETQ DY (MAX 0 (+ -5 (* 1/2 SIZEY)))) ++ (LET ((SSTR (STRINGIFY (EDITORS-STRING-LIMIT OBJ W SMAX)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) ++ (+ OFFSETX DX) (- (CADDDR W) (+ OFFSETY DY)) ++ (GET-C-STRING SSTR) (LENGTH SSTR))))) ++ ++(DEFUN EDITORS-PRINT-IN-BOX (OBJ W OFFSETX OFFSETY SIZEX SIZEY) ++ (LET ((SSTR (STRINGIFY (EDITORS-STRING-LIMIT OBJ W SIZEX)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) ++ (- (CADDDR W) (+ OFFSETY (+ -5 (* 1/2 SIZEY)))) ++ (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (WINDOW-DRAW-BOX-XY W OFFSETX OFFSETY SIZEX SIZEY)) ++ ++(DEFUN EDITORS-UPDATE-IN-BOX (OBJ W OFFSETX OFFSETY SIZEX SIZEY) ++ (LET ((GLVAR229 (+ -6 SIZEY))) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) (+ 3 OFFSETX) ++ (- (CADDDR W) (1- (+ (+ 3 OFFSETY) GLVAR229))) (+ -6 SIZEX) ++ GLVAR229 0)) ++ (LET ((SSTR (STRINGIFY (EDITORS-STRING-LIMIT OBJ W SIZEX)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) ++ (- (CADDDR W) (+ OFFSETY (+ -5 (* 1/2 SIZEY)))) ++ (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ ++(DEFUN EDITORS-STRING-LIMIT (S W MAX) ++ (LET ((STR (STRINGIFY S)) LNG NC) ++ (SETQ LNG ++ (LET ((SSTR (STRINGIFY STR))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ (IF (> LNG MAX) ++ (PROGN ++ (SETQ NC (/ (* (LENGTH STR) MAX) LNG)) ++ (SUBSEQ STR 0 NC)) ++ STR))) ++(SETF (GET 'EDITORS-STRING-LIMIT 'GLARGUMENTS) ++ '((S STRING) (W WINDOW) (MAX INTEGER))) ++(SETF (GET 'EDITORS-STRING-LIMIT 'GLFNRESULTTYPE) 'STRING) ++ ++ ++(DEFVAR *EDIT-COLOR-MENU-SET* NIL) ++ ++(DEFVAR *EDIT-COLOR-RMENU* NIL) ++ ++(DEFVAR *EDIT-COLOR-OLD-COLOR* NIL) ++ ++(DEFVAR *EDIT-COLOR-MENU-SET*) ++(SETF (GET '*EDIT-COLOR-MENU-SET* 'GLISPGLOBALVAR) T) ++(SETF (GET '*EDIT-COLOR-MENU-SET* 'GLISPGLOBALVARTYPE) 'MENU-SET) ++(DEFVAR *EDIT-COLOR-RMENU*) ++(SETF (GET '*EDIT-COLOR-RMENU* 'GLISPGLOBALVAR) T) ++(SETF (GET '*EDIT-COLOR-RMENU* 'GLISPGLOBALVARTYPE) 'BARMENU) ++ ++ ++(DEFUN EDIT-COLOR-INIT (W) ++ (LET (RM GM BM RGB) ++ (SETQ RGB (COPY-LIST '(0 0 0))) ++ (GLCC 'EDIT-COLOR-RED) ++ (GLCC 'EDIT-COLOR-GREEN) ++ (GLCC 'EDIT-COLOR-BLUE) ++ (SETQ *EDIT-COLOR-MENU-SET* (MENU-SET-CREATE W NIL)) ++ (SETQ RM ++ (BARMENU-CREATE 256 200 10 "" NIL #'EDIT-COLOR-RED (LIST RGB) ++ W 120 40 NIL T (COPY-LIST '(65535 0 0)))) ++ (SETQ *EDIT-COLOR-RMENU* RM) ++ (SETQ GM ++ (BARMENU-CREATE 256 50 10 "" NIL #'EDIT-COLOR-GREEN ++ (LIST RGB) W 170 40 NIL T (COPY-LIST '(0 65535 0)))) ++ (SETQ BM ++ (BARMENU-CREATE 256 250 10 "" NIL #'EDIT-COLOR-BLUE ++ (LIST RGB) W 220 40 NIL T (COPY-LIST '(0 0 65535)))) ++ (MENU-SET-ADD-BARMENU *EDIT-COLOR-MENU-SET* 'RED NIL RM "Red" ++ '(120 40)) ++ (MENU-SET-ADD-BARMENU *EDIT-COLOR-MENU-SET* 'GREEN NIL GM "Green" ++ '(170 40)) ++ (MENU-SET-ADD-BARMENU *EDIT-COLOR-MENU-SET* 'BLUE NIL BM "Blue" ++ '(220 40)) ++ (MENU-SET-ADD-MENU *EDIT-COLOR-MENU-SET* 'DONE NIL "" ++ '(("Done" . DONE)) '(30 150)) ++ (EDIT-COLOR-RED 200 RGB) ++ (EDIT-COLOR-GREEN 50 RGB) ++ (EDIT-COLOR-BLUE 250 RGB))) ++ ++(DEFUN EDIT-COLOR-RED (VAL COLOR) ++ (LET ((W (CADR *EDIT-COLOR-MENU-SET*))) ++ (LET ((SSTR (STRINGIFY (FORMAT NIL "~3D" VAL)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) 113 ++ (+ -20 (CADDDR W)) (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (SETF (CAR COLOR) (MAX 0 (1- (* 256 VAL)))) ++ (EDIT-DISPLAY-COLOR W COLOR))) ++ ++(DEFUN EDIT-COLOR-GREEN (VAL COLOR) ++ (LET ((W (CADR *EDIT-COLOR-MENU-SET*))) ++ (LET ((SSTR (STRINGIFY (FORMAT NIL "~3D" VAL)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) 163 ++ (+ -20 (CADDDR W)) (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (SETF (CADR COLOR) (MAX 0 (1- (* 256 VAL)))) ++ (EDIT-DISPLAY-COLOR W COLOR))) ++ ++(DEFUN EDIT-COLOR-BLUE (VAL COLOR) ++ (LET ((W (CADR *EDIT-COLOR-MENU-SET*))) ++ (LET ((SSTR (STRINGIFY (FORMAT NIL "~3D" VAL)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) 213 ++ (+ -20 (CADDDR W)) (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (SETF (CADDR COLOR) (MAX 0 (1- (* 256 VAL)))) ++ (EDIT-DISPLAY-COLOR W COLOR))) ++ ++(DEFUN EDIT-DISPLAY-COLOR (W COLOR) ++ (WINDOW-SET-COLOR W COLOR) ++ (WINDOW-DRAW-LINE-XY W 50 40 50 100 60) ++ (WINDOW-RESET-COLOR W) ++ (IF *EDIT-COLOR-OLD-COLOR* ++ (WINDOW-FREE-COLOR W *EDIT-COLOR-OLD-COLOR*)) ++ (SETQ *EDIT-COLOR-OLD-COLOR* *WINDOW-XCOLOR*)) ++ ++(DEFUN EDIT-COLOR (W) ++ (LET (DONE COLOR SEL) ++ (IF (OR (NULL *EDIT-COLOR-MENU-SET*) ++ (NOT (EQ W (CADR (CADDR (CAADDR *EDIT-COLOR-MENU-SET*)))))) ++ (EDIT-COLOR-INIT W)) ++ (SETQ COLOR (FIRST (NTH 16 *EDIT-COLOR-RMENU*))) ++ (MENU-SET-DRAW *EDIT-COLOR-MENU-SET*) ++ (EDIT-COLOR-RED (TRUNCATE (1+ (CAR COLOR)) 256) COLOR) ++ (EDIT-COLOR-GREEN (TRUNCATE (1+ (CADR COLOR)) 256) COLOR) ++ (EDIT-COLOR-BLUE (TRUNCATE (1+ (CADDR COLOR)) 256) COLOR) ++ (WHILE (NOT DONE) ++ (SETQ SEL (MENU-SET-SELECT *EDIT-COLOR-MENU-SET*)) ++ (SETQ DONE (AND SEL (EQ (FIRST SEL) 'DONE)))) ++ COLOR)) ++(SETF (GET 'EDIT-COLOR 'GLARGUMENTS) '((W WINDOW))) ++(SETF (GET 'EDIT-COLOR 'GLFNRESULTTYPE) 'RGB) ++ ++ ++(DEFUN COLOR-DOT (W X Y COLOR) ++ (LET (RGB) ++ (SETQ RGB ++ (CDR (ASSOC COLOR ++ '((RED 65535 0 0) (YELLOW 65535 57600 0) ++ (GREEN 0 50175 12287) (BLUE 0 0 65535))))) ++ (OR RGB (SETQ RGB '(30000 30000 30000))) ++ (WINDOW-SET-COLOR W RGB) ++ (WINDOW-DRAW-DOT-XY W X Y) ++ (WINDOW-RESET-COLOR W))) ++ ++(DEFUN COMPILE-EDITORS () ++ (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") ++ '("glisp/editors.lsp") "glisp/editorstrans.lsp" "glisp/gpl.txt") ++ (CF EDITORSTRANS)) ++ ++(DEFUN COMPILE-EDITORSB () ++ (GLCOMPFILES *DIRECTORY* ++ '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") ++ '("glisp/editors.lsp") "glisp/editorstrans.lsp" "glisp/gpl.txt")) +--- gcl-2.6.7.orig/xgcl-2/general-c.c ++++ gcl-2.6.7/xgcl-2/general-c.c +@@ -1,5 +1,5 @@ +-/* general-c.c Hiep Huu Nguyen 27 Aug 92 */ +- ++/* general-c.c Hiep Huu Nguyen 24 Jun 06 */ ++/* 27 Aug 92; 24 Jan 06; 22 Jun 06 */ + /* ; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + + ; See the files gnu.license and dec.copyright . +@@ -21,101 +21,45 @@ + ; Some of the files that interface to the Xlib are adapted from DEC/MIT files. + ; See the file dec.copyright for details. */ + +-#include +-#include +-#include +-#include +-#include +- +- +-int char_array(size) +-int size; +-{ +- return ((int) calloc (size, sizeof(char))); +-} +- +-char char_pos (array, pos) +-char* array; +-int pos; +-{ +- return (array[pos]); +-} +- ++/* 24 Jan 06: edited by G. Novak to remove vertex_array functions, ++ remove includes, change function arg lists to new form */ ++/* 22 Jun 06: edited by G. Novak to be compatible with 64-bit machines */ + +-int int_array(size) +-int size; +-{ +- return ((int) calloc (size, sizeof(int))); ++#include ++#define fixnum long ++fixnum char_array(int size) { ++ return ((fixnum) calloc (size, sizeof(char))); + } + +- +- +-int int_pos (array, pos) +-int* array; +-int pos; +-{ ++char char_pos (char* array, int pos) { + return (array[pos]); + } + +- +-void set_char_array (array, pos, val) +-char* array; +-int pos; +-char val; +-{ +-array[pos] = val; ++void set_char_array (char* array, int pos, char val) { ++ array[pos] = val; + } + +-void set_int_array (array, pos, val) +-int* array; +-int pos; +-int val; +-{ +-array[pos] = val; ++fixnum int_array(int size) { ++ return ((fixnum) calloc (size, sizeof(int))); + } + +- +- +- +-int vertex_array (size) +-int size; +-{ +- return ((int) calloc (size, sizeof(Vertex))); +- ++int int_pos (int* array, int pos) { ++ return (array[pos]); + } + +-int vertex_pos_x (array, pos) +-Vertex* array; +-int pos; +-{ +- return ((int) array[pos].x); ++void set_int_array (int* array, int pos, int val) { ++ array[pos] = val; + } + +-int vertex_pos_y (array, pos) +-Vertex* array; +-int pos; +-{ +- return ((int) array[pos].y); ++fixnum fixnum_array(int size) { ++ return ((fixnum) calloc (size, sizeof(fixnum))); + } + +-int vertex_pos_flag (array, pos) +-Vertex* array; +-int pos; +-{ +- return ((int) array[pos].flags); ++fixnum fixnum_pos (fixnum* array, int pos) { ++ return (array[pos]); + } + +- +- +- +-void set_vertex_array (array, pos, x, y, flag) +-Vertex* array; +-int pos; +-int x, y; +-int flag; +-{ +- array[pos].x = x; +- array[pos].y = y; +- array[pos].flags = flag; +- ++void set_fixnum_array (fixnum* array, int pos, fixnum val) { ++ array[pos] = val; + } ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_Xstruct.lsp +@@ -0,0 +1,311 @@ ++(in-package :XLIB) ++; Xstruct.lsp Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++ ++ ++ ++;;;;;; _XQEvent funcions ;;;;;; ++ ++(defentry make-_XQEvent () ( fixnum "make__XQEvent" )) ++(defentry _XQEvent-event (fixnum) ( fixnum "_XQEvent_event" )) ++(defentry set-_XQEvent-event (fixnum fixnum) ( void "set__XQEvent_event" )) ++(defentry _XQEvent-next (fixnum) ( fixnum "_XQEvent_next" )) ++(defentry set-_XQEvent-next (fixnum fixnum) ( void "set__XQEvent_next" )) ++ ++ ++;;;;;; XCharStruct funcions ;;;;;; ++ ++(defentry make-XCharStruct () ( fixnum "make_XCharStruct" )) ++(defentry XCharStruct-attributes (fixnum) ( fixnum "XCharStruct_attributes" )) ++(defentry set-XCharStruct-attributes (fixnum fixnum) ( void "set_XCharStruct_attributes" )) ++(defentry XCharStruct-descent (fixnum) ( fixnum "XCharStruct_descent" )) ++(defentry set-XCharStruct-descent (fixnum fixnum) ( void "set_XCharStruct_descent" )) ++(defentry XCharStruct-ascent (fixnum) ( fixnum "XCharStruct_ascent" )) ++(defentry set-XCharStruct-ascent (fixnum fixnum) ( void "set_XCharStruct_ascent" )) ++(defentry XCharStruct-width (fixnum) ( fixnum "XCharStruct_width" )) ++(defentry set-XCharStruct-width (fixnum fixnum) ( void "set_XCharStruct_width" )) ++(defentry XCharStruct-rbearing (fixnum) ( fixnum "XCharStruct_rbearing" )) ++(defentry set-XCharStruct-rbearing (fixnum fixnum) ( void "set_XCharStruct_rbearing" )) ++(defentry XCharStruct-lbearing (fixnum) ( fixnum "XCharStruct_lbearing" )) ++(defentry set-XCharStruct-lbearing (fixnum fixnum) ( void "set_XCharStruct_lbearing" )) ++ ++ ++;;;;;; XFontProp funcions ;;;;;; ++ ++(defentry make-XFontProp () ( fixnum "make_XFontProp" )) ++(defentry XFontProp-card32 (fixnum) ( fixnum "XFontProp_card32" )) ++(defentry set-XFontProp-card32 (fixnum fixnum) ( void "set_XFontProp_card32" )) ++(defentry XFontProp-name (fixnum) ( fixnum "XFontProp_name" )) ++(defentry set-XFontProp-name (fixnum fixnum) ( void "set_XFontProp_name" )) ++ ++ ++;;;;;; XFontStruct funcions ;;;;;; ++ ++(defentry make-XFontStruct () ( fixnum "make_XFontStruct" )) ++(defentry XFontStruct-descent (fixnum) ( fixnum "XFontStruct_descent" )) ++(defentry set-XFontStruct-descent (fixnum fixnum) ( void "set_XFontStruct_descent" )) ++(defentry XFontStruct-ascent (fixnum) ( fixnum "XFontStruct_ascent" )) ++(defentry set-XFontStruct-ascent (fixnum fixnum) ( void "set_XFontStruct_ascent" )) ++(defentry XFontStruct-per_char (fixnum) ( fixnum "XFontStruct_per_char" )) ++(defentry set-XFontStruct-per_char (fixnum fixnum) ( void "set_XFontStruct_per_char" )) ++(defentry XFontStruct-max_bounds (fixnum) ( fixnum "XFontStruct_max_bounds" )) ++(defentry set-XFontStruct-max_bounds (fixnum fixnum) ( void "set_XFontStruct_max_bounds" )) ++(defentry XFontStruct-min_bounds (fixnum) ( fixnum "XFontStruct_min_bounds" )) ++(defentry set-XFontStruct-min_bounds (fixnum fixnum) ( void "set_XFontStruct_min_bounds" )) ++(defentry XFontStruct-properties (fixnum) ( fixnum "XFontStruct_properties" )) ++(defentry set-XFontStruct-properties (fixnum fixnum) ( void "set_XFontStruct_properties" )) ++(defentry XFontStruct-n_properties (fixnum) ( fixnum "XFontStruct_n_properties" )) ++(defentry set-XFontStruct-n_properties (fixnum fixnum) ( void "set_XFontStruct_n_properties" )) ++(defentry XFontStruct-default_char (fixnum) ( fixnum "XFontStruct_default_char" )) ++(defentry set-XFontStruct-default_char (fixnum fixnum) ( void "set_XFontStruct_default_char" )) ++(defentry XFontStruct-all_chars_exist (fixnum) ( fixnum "XFontStruct_all_chars_exist" )) ++(defentry set-XFontStruct-all_chars_exist (fixnum fixnum) ( void "set_XFontStruct_all_chars_exist" )) ++(defentry XFontStruct-max_byte1 (fixnum) ( fixnum "XFontStruct_max_byte1" )) ++(defentry set-XFontStruct-max_byte1 (fixnum fixnum) ( void "set_XFontStruct_max_byte1" )) ++(defentry XFontStruct-min_byte1 (fixnum) ( fixnum "XFontStruct_min_byte1" )) ++(defentry set-XFontStruct-min_byte1 (fixnum fixnum) ( void "set_XFontStruct_min_byte1" )) ++(defentry XFontStruct-max_char_or_byte2 (fixnum) ( fixnum "XFontStruct_max_char_or_byte2" )) ++(defentry set-XFontStruct-max_char_or_byte2 (fixnum fixnum) ( void "set_XFontStruct_max_char_or_byte2" )) ++(defentry XFontStruct-min_char_or_byte2 (fixnum) ( fixnum "XFontStruct_min_char_or_byte2" )) ++(defentry set-XFontStruct-min_char_or_byte2 (fixnum fixnum) ( void "set_XFontStruct_min_char_or_byte2" )) ++(defentry XFontStruct-direction (fixnum) ( fixnum "XFontStruct_direction" )) ++(defentry set-XFontStruct-direction (fixnum fixnum) ( void "set_XFontStruct_direction" )) ++(defentry XFontStruct-fid (fixnum) ( fixnum "XFontStruct_fid" )) ++(defentry set-XFontStruct-fid (fixnum fixnum) ( void "set_XFontStruct_fid" )) ++(defentry XFontStruct-ext_data (fixnum) ( fixnum "XFontStruct_ext_data" )) ++(defentry set-XFontStruct-ext_data (fixnum fixnum) ( void "set_XFontStruct_ext_data" )) ++ ++ ++;;;;;; XTextItem funcions ;;;;;; ++ ++(defentry make-XTextItem () ( fixnum "make_XTextItem" )) ++(defentry XTextItem-font (fixnum) ( fixnum "XTextItem_font" )) ++(defentry set-XTextItem-font (fixnum fixnum) ( void "set_XTextItem_font" )) ++(defentry XTextItem-delta (fixnum) ( fixnum "XTextItem_delta" )) ++(defentry set-XTextItem-delta (fixnum fixnum) ( void "set_XTextItem_delta" )) ++(defentry XTextItem-nchars (fixnum) ( fixnum "XTextItem_nchars" )) ++(defentry set-XTextItem-nchars (fixnum fixnum) ( void "set_XTextItem_nchars" )) ++(defentry XTextItem-chars (fixnum) ( fixnum "XTextItem_chars" )) ++(defentry set-XTextItem-chars (fixnum fixnum) ( void "set_XTextItem_chars" )) ++ ++ ++;;;;;; XChar2b funcions ;;;;;; ++ ++(defentry make-XChar2b () ( fixnum "make_XChar2b" )) ++(defentry XChar2b-byte2 (fixnum) ( char "XChar2b_byte2" )) ++(defentry set-XChar2b-byte2 (fixnum char) ( void "set_XChar2b_byte2" )) ++(defentry XChar2b-byte1 (fixnum) ( char "XChar2b_byte1" )) ++(defentry set-XChar2b-byte1 (fixnum char) ( void "set_XChar2b_byte1" )) ++ ++ ++;;;;;; XTextItem16 funcions ;;;;;; ++ ++(defentry make-XTextItem16 () ( fixnum "make_XTextItem16" )) ++(defentry XTextItem16-font (fixnum) ( fixnum "XTextItem16_font" )) ++(defentry set-XTextItem16-font (fixnum fixnum) ( void "set_XTextItem16_font" )) ++(defentry XTextItem16-delta (fixnum) ( fixnum "XTextItem16_delta" )) ++(defentry set-XTextItem16-delta (fixnum fixnum) ( void "set_XTextItem16_delta" )) ++(defentry XTextItem16-nchars (fixnum) ( fixnum "XTextItem16_nchars" )) ++(defentry set-XTextItem16-nchars (fixnum fixnum) ( void "set_XTextItem16_nchars" )) ++(defentry XTextItem16-chars (fixnum) ( fixnum "XTextItem16_chars" )) ++(defentry set-XTextItem16-chars (fixnum fixnum) ( void "set_XTextItem16_chars" )) ++ ++ ++;;;;;; XEDataObject funcions ;;;;;; ++ ++(defentry make-XEDataObject () ( fixnum "make_XEDataObject" )) ++(defentry XEDataObject-font (fixnum) ( fixnum "XEDataObject_font" )) ++(defentry set-XEDataObject-font (fixnum fixnum) ( void "set_XEDataObject_font" )) ++(defentry XEDataObject-pixmap_format (fixnum) ( fixnum "XEDataObject_pixmap_format" )) ++(defentry set-XEDataObject-pixmap_format (fixnum fixnum) ( void "set_XEDataObject_pixmap_format" )) ++(defentry XEDataObject-screen (fixnum) ( fixnum "XEDataObject_screen" )) ++(defentry set-XEDataObject-screen (fixnum fixnum) ( void "set_XEDataObject_screen" )) ++(defentry XEDataObject-visual (fixnum) ( fixnum "XEDataObject_visual" )) ++(defentry set-XEDataObject-visual (fixnum fixnum) ( void "set_XEDataObject_visual" )) ++(defentry XEDataObject-gc (fixnum) ( fixnum "XEDataObject_gc" )) ++(defentry set-XEDataObject-gc (fixnum fixnum) ( void "set_XEDataObject_gc" )) ++ ++ ++;;;;;; XSizeHints funcions ;;;;;; ++ ++(defentry make-XSizeHints () ( fixnum "make_XSizeHints" )) ++(defentry XSizeHints-win_gravity (fixnum) ( fixnum "XSizeHints_win_gravity" )) ++(defentry set-XSizeHints-win_gravity (fixnum fixnum) ( void "set_XSizeHints_win_gravity" )) ++(defentry XSizeHints-base_height (fixnum) ( fixnum "XSizeHints_base_height" )) ++(defentry set-XSizeHints-base_height (fixnum fixnum) ( void "set_XSizeHints_base_height" )) ++(defentry XSizeHints-base_width (fixnum) ( fixnum "XSizeHints_base_width" )) ++(defentry set-XSizeHints-base_width (fixnum fixnum) ( void "set_XSizeHints_base_width" )) ++ ++(defentry XSizeHints-max_aspect_x (fixnum) ( fixnum "XSizeHints_max_aspect_x" )) ++(defentry set-XSizeHints-max_aspect_x (fixnum fixnum) ( void "set_XSizeHints_max_aspect_x" )) ++(defentry XSizeHints-max_aspect_y (fixnum) ( fixnum "XSizeHints_max_aspect_y" )) ++(defentry set-XSizeHints-max_aspect_y (fixnum fixnum) ( void "set_XSizeHints_max_aspect_y" )) ++(defentry XSizeHints-min_aspect_x (fixnum) ( fixnum "XSizeHints_min_aspect_x" )) ++(defentry set-XSizeHints-min_aspect_x (fixnum fixnum) ( void "set_XSizeHints_min_aspect_x" )) ++(defentry XSizeHints-min_aspect_y (fixnum) ( fixnum "XSizeHints_min_aspect_y" )) ++(defentry set-XSizeHints-min_aspect_y (fixnum fixnum) ( void "set_XSizeHints_min_aspect_y" )) ++ ++(defentry XSizeHints-height_inc (fixnum) ( fixnum "XSizeHints_height_inc" )) ++(defentry set-XSizeHints-height_inc (fixnum fixnum) ( void "set_XSizeHints_height_inc" )) ++(defentry XSizeHints-width_inc (fixnum) ( fixnum "XSizeHints_width_inc" )) ++(defentry set-XSizeHints-width_inc (fixnum fixnum) ( void "set_XSizeHints_width_inc" )) ++(defentry XSizeHints-max_height (fixnum) ( fixnum "XSizeHints_max_height" )) ++(defentry set-XSizeHints-max_height (fixnum fixnum) ( void "set_XSizeHints_max_height" )) ++(defentry XSizeHints-max_width (fixnum) ( fixnum "XSizeHints_max_width" )) ++(defentry set-XSizeHints-max_width (fixnum fixnum) ( void "set_XSizeHints_max_width" )) ++(defentry XSizeHints-min_height (fixnum) ( fixnum "XSizeHints_min_height" )) ++(defentry set-XSizeHints-min_height (fixnum fixnum) ( void "set_XSizeHints_min_height" )) ++(defentry XSizeHints-min_width (fixnum) ( fixnum "XSizeHints_min_width" )) ++(defentry set-XSizeHints-min_width (fixnum fixnum) ( void "set_XSizeHints_min_width" )) ++(defentry XSizeHints-height (fixnum) ( fixnum "XSizeHints_height" )) ++(defentry set-XSizeHints-height (fixnum fixnum) ( void "set_XSizeHints_height" )) ++(defentry XSizeHints-width (fixnum) ( fixnum "XSizeHints_width" )) ++(defentry set-XSizeHints-width (fixnum fixnum) ( void "set_XSizeHints_width" )) ++(defentry XSizeHints-y (fixnum) ( fixnum "XSizeHints_y" )) ++(defentry set-XSizeHints-y (fixnum fixnum) ( void "set_XSizeHints_y" )) ++(defentry XSizeHints-x (fixnum) ( fixnum "XSizeHints_x" )) ++(defentry set-XSizeHints-x (fixnum fixnum) ( void "set_XSizeHints_x" )) ++(defentry XSizeHints-flags (fixnum) ( fixnum "XSizeHints_flags" )) ++(defentry set-XSizeHints-flags (fixnum fixnum) ( void "set_XSizeHints_flags" )) ++ ++ ++;;;;;; XWMHints funcions ;;;;;; ++ ++(defentry make-XWMHints () ( fixnum "make_XWMHints" )) ++(defentry XWMHints-window_group (fixnum) ( fixnum "XWMHints_window_group" )) ++(defentry set-XWMHints-window_group (fixnum fixnum) ( void "set_XWMHints_window_group" )) ++(defentry XWMHints-icon_mask (fixnum) ( fixnum "XWMHints_icon_mask" )) ++(defentry set-XWMHints-icon_mask (fixnum fixnum) ( void "set_XWMHints_icon_mask" )) ++(defentry XWMHints-icon_y (fixnum) ( fixnum "XWMHints_icon_y" )) ++(defentry set-XWMHints-icon_y (fixnum fixnum) ( void "set_XWMHints_icon_y" )) ++(defentry XWMHints-icon_x (fixnum) ( fixnum "XWMHints_icon_x" )) ++(defentry set-XWMHints-icon_x (fixnum fixnum) ( void "set_XWMHints_icon_x" )) ++(defentry XWMHints-icon_window (fixnum) ( fixnum "XWMHints_icon_window" )) ++(defentry set-XWMHints-icon_window (fixnum fixnum) ( void "set_XWMHints_icon_window" )) ++(defentry XWMHints-icon_pixmap (fixnum) ( fixnum "XWMHints_icon_pixmap" )) ++(defentry set-XWMHints-icon_pixmap (fixnum fixnum) ( void "set_XWMHints_icon_pixmap" )) ++(defentry XWMHints-initial_state (fixnum) ( fixnum "XWMHints_initial_state" )) ++(defentry set-XWMHints-initial_state (fixnum fixnum) ( void "set_XWMHints_initial_state" )) ++(defentry XWMHints-input (fixnum) ( fixnum "XWMHints_input" )) ++(defentry set-XWMHints-input (fixnum fixnum) ( void "set_XWMHints_input" )) ++(defentry XWMHints-flags (fixnum) ( fixnum "XWMHints_flags" )) ++(defentry set-XWMHints-flags (fixnum fixnum) ( void "set_XWMHints_flags" )) ++ ++ ++;;;;;; XTextProperty funcions ;;;;;; ++ ++(defentry make-XTextProperty () ( fixnum "make_XTextProperty" )) ++(defentry XTextProperty-nitems (fixnum) ( fixnum "XTextProperty_nitems" )) ++(defentry set-XTextProperty-nitems (fixnum fixnum) ( void "set_XTextProperty_nitems" )) ++(defentry XTextProperty-format (fixnum) ( fixnum "XTextProperty_format" )) ++(defentry set-XTextProperty-format (fixnum fixnum) ( void "set_XTextProperty_format" )) ++(defentry XTextProperty-encoding (fixnum) ( fixnum "XTextProperty_encoding" )) ++(defentry set-XTextProperty-encoding (fixnum fixnum) ( void "set_XTextProperty_encoding" )) ++(defentry XTextProperty-value (fixnum) ( fixnum "XTextProperty_value" )) ++(defentry set-XTextProperty-value (fixnum fixnum) ( void "set_XTextProperty_value" )) ++ ++ ++;;;;;; XIconSize funcions ;;;;;; ++ ++(defentry make-XIconSize () ( fixnum "make_XIconSize" )) ++(defentry XIconSize-height_inc (fixnum) ( fixnum "XIconSize_height_inc" )) ++(defentry set-XIconSize-height_inc (fixnum fixnum) ( void "set_XIconSize_height_inc" )) ++(defentry XIconSize-width_inc (fixnum) ( fixnum "XIconSize_width_inc" )) ++(defentry set-XIconSize-width_inc (fixnum fixnum) ( void "set_XIconSize_width_inc" )) ++(defentry XIconSize-max_height (fixnum) ( fixnum "XIconSize_max_height" )) ++(defentry set-XIconSize-max_height (fixnum fixnum) ( void "set_XIconSize_max_height" )) ++(defentry XIconSize-max_width (fixnum) ( fixnum "XIconSize_max_width" )) ++(defentry set-XIconSize-max_width (fixnum fixnum) ( void "set_XIconSize_max_width" )) ++(defentry XIconSize-min_height (fixnum) ( fixnum "XIconSize_min_height" )) ++(defentry set-XIconSize-min_height (fixnum fixnum) ( void "set_XIconSize_min_height" )) ++(defentry XIconSize-min_width (fixnum) ( fixnum "XIconSize_min_width" )) ++(defentry set-XIconSize-min_width (fixnum fixnum) ( void "set_XIconSize_min_width" )) ++ ++ ++;;;;;; XClassHint funcions ;;;;;; ++ ++(defentry make-XClassHint () ( fixnum "make_XClassHint" )) ++(defentry XClassHint-res_class (fixnum) ( fixnum "XClassHint_res_class" )) ++(defentry set-XClassHint-res_class (fixnum fixnum) ( void "set_XClassHint_res_class" )) ++(defentry XClassHint-res_name (fixnum) ( fixnum "XClassHint_res_name" )) ++(defentry set-XClassHint-res_name (fixnum fixnum) ( void "set_XClassHint_res_name" )) ++ ++ ++;;;;;; XComposeStatus funcions ;;;;;; ++ ++(defentry make-XComposeStatus () ( fixnum "make_XComposeStatus" )) ++(defentry XComposeStatus-chars_matched (fixnum) ( fixnum "XComposeStatus_chars_matched" )) ++(defentry set-XComposeStatus-chars_matched (fixnum fixnum) ( void "set_XComposeStatus_chars_matched" )) ++(defentry XComposeStatus-compose_ptr (fixnum) ( fixnum "XComposeStatus_compose_ptr" )) ++(defentry set-XComposeStatus-compose_ptr (fixnum fixnum) ( void "set_XComposeStatus_compose_ptr" )) ++ ++ ++;;;;;; XVisualInfo funcions ;;;;;; ++ ++(defentry make-XVisualInfo () ( fixnum "make_XVisualInfo" )) ++(defentry XVisualInfo-bits_per_rgb (fixnum) ( fixnum "XVisualInfo_bits_per_rgb" )) ++(defentry set-XVisualInfo-bits_per_rgb (fixnum fixnum) ( void "set_XVisualInfo_bits_per_rgb" )) ++(defentry XVisualInfo-colormap_size (fixnum) ( fixnum "XVisualInfo_colormap_size" )) ++(defentry set-XVisualInfo-colormap_size (fixnum fixnum) ( void "set_XVisualInfo_colormap_size" )) ++(defentry XVisualInfo-blue_mask (fixnum) ( fixnum "XVisualInfo_blue_mask" )) ++(defentry set-XVisualInfo-blue_mask (fixnum fixnum) ( void "set_XVisualInfo_blue_mask" )) ++(defentry XVisualInfo-green_mask (fixnum) ( fixnum "XVisualInfo_green_mask" )) ++(defentry set-XVisualInfo-green_mask (fixnum fixnum) ( void "set_XVisualInfo_green_mask" )) ++(defentry XVisualInfo-red_mask (fixnum) ( fixnum "XVisualInfo_red_mask" )) ++(defentry set-XVisualInfo-red_mask (fixnum fixnum) ( void "set_XVisualInfo_red_mask" )) ++(defentry XVisualInfo-class (fixnum) ( fixnum "XVisualInfo_class" )) ++(defentry set-XVisualInfo-class (fixnum fixnum) ( void "set_XVisualInfo_class" )) ++(defentry XVisualInfo-depth (fixnum) ( fixnum "XVisualInfo_depth" )) ++(defentry set-XVisualInfo-depth (fixnum fixnum) ( void "set_XVisualInfo_depth" )) ++(defentry XVisualInfo-screen (fixnum) ( fixnum "XVisualInfo_screen" )) ++(defentry set-XVisualInfo-screen (fixnum fixnum) ( void "set_XVisualInfo_screen" )) ++(defentry XVisualInfo-visualid (fixnum) ( fixnum "XVisualInfo_visualid" )) ++(defentry set-XVisualInfo-visualid (fixnum fixnum) ( void "set_XVisualInfo_visualid" )) ++(defentry XVisualInfo-visual (fixnum) ( fixnum "XVisualInfo_visual" )) ++(defentry set-XVisualInfo-visual (fixnum fixnum) ( void "set_XVisualInfo_visual" )) ++ ++ ++;;;;;; XStandardColormap funcions ;;;;;; ++ ++(defentry make-XStandardColormap () ( fixnum "make_XStandardColormap" )) ++(defentry XStandardColormap-killid (fixnum) ( fixnum "XStandardColormap_killid" )) ++(defentry set-XStandardColormap-killid (fixnum fixnum) ( void "set_XStandardColormap_killid" )) ++(defentry XStandardColormap-visualid (fixnum) ( fixnum "XStandardColormap_visualid" )) ++(defentry set-XStandardColormap-visualid (fixnum fixnum) ( void "set_XStandardColormap_visualid" )) ++(defentry XStandardColormap-base_pixel (fixnum) ( fixnum "XStandardColormap_base_pixel" )) ++(defentry set-XStandardColormap-base_pixel (fixnum fixnum) ( void "set_XStandardColormap_base_pixel" )) ++(defentry XStandardColormap-blue_mult (fixnum) ( fixnum "XStandardColormap_blue_mult" )) ++(defentry set-XStandardColormap-blue_mult (fixnum fixnum) ( void "set_XStandardColormap_blue_mult" )) ++(defentry XStandardColormap-blue_max (fixnum) ( fixnum "XStandardColormap_blue_max" )) ++(defentry set-XStandardColormap-blue_max (fixnum fixnum) ( void "set_XStandardColormap_blue_max" )) ++(defentry XStandardColormap-green_mult (fixnum) ( fixnum "XStandardColormap_green_mult" )) ++(defentry set-XStandardColormap-green_mult (fixnum fixnum) ( void "set_XStandardColormap_green_mult" )) ++(defentry XStandardColormap-green_max (fixnum) ( fixnum "XStandardColormap_green_max" )) ++(defentry set-XStandardColormap-green_max (fixnum fixnum) ( void "set_XStandardColormap_green_max" )) ++(defentry XStandardColormap-red_mult (fixnum) ( fixnum "XStandardColormap_red_mult" )) ++(defentry set-XStandardColormap-red_mult (fixnum fixnum) ( void "set_XStandardColormap_red_mult" )) ++(defentry XStandardColormap-red_max (fixnum) ( fixnum "XStandardColormap_red_max" )) ++(defentry set-XStandardColormap-red_max (fixnum fixnum) ( void "set_XStandardColormap_red_max" )) ++(defentry XStandardColormap-colormap (fixnum) ( fixnum "XStandardColormap_colormap" )) ++(defentry set-XStandardColormap-colormap (fixnum fixnum) ( void "set_XStandardColormap_colormap" )) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_menu-settrans.lsp +@@ -0,0 +1,531 @@ ++; 07 Jan 2010 16:46:11 EST ++ ++; menu-settrans.lsp -- translation of menu-set.lsp Gordon S. Novak Jr. ++ ++; Copyright 2006 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; This program 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 program 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 program; if not, write to the Free Software ++; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++(defmacro nconc1 (lst x) `(nconc ,lst (cons ,x nil))) ++ ++(defmacro glmethod (class selector) ++ `(cadr (assoc ,selector (getf (cdr (get ,class 'glstructure)) 'msg))) ) ++ ++(SETF (GET 'MENU-SET 'GLSTRUCTURE) ++ '((LISTOBJECT (WINDOW WINDOW) (MENU-ITEMS (LISTOF MENU-SET-ITEM)) ++ (COMMANDFN ANYTHING)) ++ MSG ++ ((DRAW MENU-SET-DRAW) (SELECT MENU-SET-SELECT) ++ (NAMED-MENU MENU-SET-NAMED-MENU) ++ (NAMED-ITEM MENU-SET-NAMED-ITEM) (ADD-MENU MENU-SET-ADD-MENU) ++ (ADD-PICMENU MENU-SET-ADD-PICMENU) ++ (ADD-COMPONENT MENU-SET-ADD-COMPONENT) ++ (ADD-BARMENU MENU-SET-ADD-BARMENU) ++ (ADD-ITEM MENU-SET-ADD-ITEM) (FIND-ITEM MENU-SET-FIND-ITEM) ++ (DELETE-ITEM MENU-SET-DELETE-ITEM) ++ (REMOVE-ITEMS MENU-SET-REMOVE-ITEMS) ++ (ITEM-POSITION MENU-SET-ITEM-POSITION) (ITEMP MENU-SET-ITEMP) ++ (ADJUST MENU-SET-ADJUST) (MOVE MENU-SET-MOVE) ++ (DRAW-CONN MENU-SET-DRAW-CONN)))) ++(SETF (GET 'MENU-SET-ITEM 'GLSTRUCTURE) ++ '((LIST (MENU-NAME SYMBOL) (SYM ANYTHING) (MENU MENU-SET-MENU)) ++ PROP ++ ((LEFT ((PARENT-OFFSET-X MENU))) ++ (BOTTOM ((PARENT-OFFSET-Y MENU))) ++ (WIDTH ((PICTURE-WIDTH MENU))) ++ (HEIGHT ((PICTURE-HEIGHT MENU)))) ++ SUPERS (REGION))) ++(SETF (GET 'MENU-SET-MENU 'GLSTRUCTURE) ++ '((TRANSPARENT MENU) MSG ((DRAW MENU-MDRAW)))) ++(SETF (GET 'MENU-PORT 'GLSTRUCTURE) ++ '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL)))) ++(SETF (GET 'MENU-SELECTION 'GLSTRUCTURE) ++ '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL) (BUTTON INTEGER)))) ++(SETF (GET 'MENU-SET-CONN 'GLSTRUCTURE) ++ '((LIST (FROM MENU-PORT) (TO MENU-PORT)))) ++(SETF (GET 'MENU-CONNS 'GLSTRUCTURE) ++ '((LISTOBJECT (MENU-SET MENU-SET) ++ (CONNECTIONS (LISTOF MENU-SET-CONN))) ++ PROP ((WINDOW ((WINDOW (MENU-SET SELF))))) MSG ++ ((DRAW MENU-CONNS-DRAW) (REDRAW MENU-CONNS-REDRAW) ++ (MOVE MENU-CONNS-MOVE) (ADD-CONN MENU-CONNS-ADD-CONN) ++ (ADD-ITEM MENU-CONNS-ADD-ITEM OPEN T) ++ (FIND-CONN MENU-CONNS-FIND-CONN) ++ (FIND-ITEM MENU-CONNS-FIND-ITEM) ++ (DELETE-ITEM MENU-CONNS-DELETE-ITEM) ++ (DELETE-CONN MENU-CONNS-DELETE-CONN) ++ (REMOVE-ITEMS MENU-CONNS-REMOVE-ITEMS) ++ (FIND-CONNS MENU-CONNS-FIND-CONNS) ++ (CONNECTED-PORTS MENU-CONNS-CONNECTED-PORTS) ++ (NEW-CONN MENU-CONNS-NEW-CONN) ++ (NAMED-MENU MENU-CONNS-NAMED-MENU) ++ (NAMED-ITEM MENU-CONNS-NAMED-ITEM)))) ++ ++ ++(DEFUN MENU-SET-CREATE (W &OPTIONAL FN) (LIST 'MENU-SET W NIL FN)) ++(SETF (GET 'MENU-SET-CREATE 'GLARGUMENTS) ++ '((W WINDOW) (&OPTIONAL NIL))) ++(SETF (GET 'MENU-SET-CREATE 'GLFNRESULTTYPE) 'MENU-SET) ++ ++ ++(DEFUN MENU-SET-SELECT (MS &OPTIONAL REDRAW ENABLED) ++ (LET (RES RESB ITM SEL LASTX LASTY) ++ (IF REDRAW (MENU-SET-DRAW MS)) ++ (WHILE (NOT (OR RES RESB)) ++ (SETQ ITM ++ (WINDOW-TRACK-MOUSE (CADR MS) ++ #'(LAMBDA (X Y CODE) ++ (OR (AND (PLUSP CODE) (SETQ LASTX X) ++ (SETQ LASTY Y) CODE) ++ (SOME #'(LAMBDA (GLVAR237) ++ (IF ++ (AND ++ (BETWEEN X ++ (FIFTH (CADDR GLVAR237)) ++ (+ (FIFTH (CADDR GLVAR237)) ++ (SEVENTH (CADDR GLVAR237)))) ++ (BETWEEN Y ++ (SIXTH (CADDR GLVAR237)) ++ (+ (SIXTH (CADDR GLVAR237)) ++ (EIGHTH (CADDR GLVAR237))))) ++ GLVAR237)) ++ (CADDR MS)))))) ++ (IF (NUMBERP ITM) ++ (SETQ RESB (LIST (LIST LASTX LASTY) 'BACKGROUND ITM)) ++ (WHEN (OR (ATOM ENABLED) (MEMBER (CAR ITM) ENABLED)) ++ (SETQ SEL (MENU-MSELECT (CADDR ITM) (EQ ENABLED T))) ++ (IF SEL ++ (SETQ RES (LIST SEL (CAR ITM) *WINDOW-MENU-CODE*)) ++ (IF (AND *WINDOW-MENU-CODE* ++ (NOT (ZEROP *WINDOW-MENU-CODE*))) ++ (SETQ RES ++ (LIST NIL (CAR ITM) *WINDOW-MENU-CODE*))))))) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (OR RES RESB))) ++(SETF (GET 'MENU-SET-SELECT 'GLARGUMENTS) ++ '((MS MENU-SET) (&OPTIONAL BOOLEAN) (REDRAW (LISTOF SYMBOL)))) ++(SETF (GET 'MENU-SET-SELECT 'GLFNRESULTTYPE) 'MENU-SELECTION) ++ ++ ++(DEFUN MENU-SET-ADD-MENU (MS NAME SYM TITLE ITEMS &OPTIONAL OFFSET) ++ (LET (MENU) ++ (SETQ MENU ++ (MENU-CREATE ITEMS TITLE (CADR MS) (CAR OFFSET) (CADR OFFSET) ++ T T)) ++ (MENU-INIT MENU) ++ (IF (NOT OFFSET) ++ (SETQ OFFSET ++ (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) ++ (EIGHTH MENU)))) ++ (SETF (FIFTH MENU) (CAR OFFSET)) ++ (SETF (SIXTH MENU) (CADR OFFSET)) ++ (MENU-SET-ADD-ITEM MS NAME SYM MENU))) ++(SETF (GET 'MENU-SET-ADD-MENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) ++ (ITEMS NIL) (&OPTIONAL VECTOR))) ++(SETF (GET 'MENU-SET-ADD-MENU 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-ITEM (MS NAME SYM MENU) ++ (SETF (CADDR MS) (NCONC (CADDR MS) (CONS (LIST NAME SYM MENU) NIL)))) ++(SETF (GET 'MENU-SET-ADD-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) ++(SETF (GET 'MENU-SET-ADD-ITEM 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-REMOVE-ITEMS (MS) (SETF (CADDR MS) NIL)) ++(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLARGUMENTS) '((MS MENU-SET))) ++(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-PICMENU ++ (MS NAME SYM TITLE SPEC &OPTIONAL OFFSET NOBOX) ++ (LET (MENU MAXWIDTH MAXHEIGHT) ++ (IF (AND SPEC (SYMBOLP SPEC)) (SETQ SPEC (GET SPEC 'PICMENU-SPEC))) ++ (SETQ MENU ++ (PICMENU-CREATE-FROM-SPEC SPEC TITLE (CADR MS) (CAR OFFSET) ++ (CADR OFFSET) T T (NOT NOBOX))) ++ (SETQ MAXWIDTH ++ (MAX (IF TITLE (+ 6 (* 9 (LENGTH TITLE))) 0) (CADR SPEC))) ++ (SETQ MAXHEIGHT (+ (IF TITLE 15 0) (CADDR SPEC))) ++ (IF (NOT OFFSET) ++ (SETQ OFFSET ++ (WINDOW-GET-BOX-POSITION (CADR MS) MAXWIDTH MAXHEIGHT))) ++ (SETF (FIFTH MENU) (CAR OFFSET)) ++ (SETF (SIXTH MENU) (CADR OFFSET)) ++ (MENU-SET-ADD-ITEM MS NAME SYM MENU))) ++(SETF (GET 'MENU-SET-ADD-PICMENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) ++ (SPEC PICMENU-SPEC) (&OPTIONAL VECTOR) (OFFSET BOOLEAN))) ++(SETF (GET 'MENU-SET-ADD-PICMENU 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-COMPONENT (MS NAME &OPTIONAL OFFSET) ++ (MENU-SET-ADD-PICMENU MS (MENU-SET-NAME NAME) NAME NIL NAME OFFSET T)) ++(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (&OPTIONAL VECTOR))) ++(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-BARMENU (MS NAME SYM MENU TITLE &OPTIONAL OFFSET) ++ (BARMENU-INIT MENU) ++ (IF (NOT OFFSET) ++ (SETQ OFFSET ++ (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) ++ (EIGHTH MENU)))) ++ (SETF (FIFTH MENU) (CAR OFFSET)) ++ (SETF (SIXTH MENU) (CADR OFFSET)) ++ (MENU-SET-ADD-ITEM MS NAME SYM MENU)) ++(SETF (GET 'MENU-SET-ADD-BARMENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU BARMENU) ++ (TITLE STRING) (&OPTIONAL VECTOR))) ++(SETF (GET 'MENU-SET-ADD-BARMENU 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-NAME (NM) ++ (INTERN (SYMBOL-NAME (GENSYM (SYMBOL-NAME NM))))) ++(SETF (GET 'MENU-SET-NAME 'GLARGUMENTS) '((NM SYMBOL))) ++(SETF (GET 'MENU-SET-NAME 'GLFNRESULTTYPE) 'SYMBOL) ++ ++ ++(DEFUN MENU-SET-NAMED-ITEM (MS NAME) (ASSOC NAME (CADDR MS))) ++(SETF (GET 'MENU-SET-NAMED-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL))) ++(SETF (GET 'MENU-SET-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-SET-NAMED-MENU (MS NAME) ++ (CADDR (MENU-SET-NAMED-ITEM MS NAME))) ++(SETF (GET 'MENU-SET-NAMED-MENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL))) ++(SETF (GET 'MENU-SET-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) ++ ++ ++(DEFUN MENU-SET-ITEMP (MS NAME ITEMNAME) ++ (LET ((THISMENU (MENU-SET-NAMED-MENU MS NAME))) ++ (IF (EQ (FIRST THISMENU) 'MENU) ++ (SOME #'(LAMBDA (X) ++ (OR (EQ X ITEMNAME) ++ (AND (CONSP X) (EQ (CAR X) ITEMNAME)))) ++ (NTH 13 THISMENU)) ++ (IF (EQ (FIRST THISMENU) 'PICMENU) ++ (ASSOC ITEMNAME (CADDDR (NTH 10 THISMENU))))))) ++(SETF (GET 'MENU-SET-ITEMP 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (ITEMNAME SYMBOL))) ++(SETF (GET 'MENU-SET-ITEMP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN MENU-CONNS-NAMED-ITEM (MC NAME) ++ (MENU-SET-NAMED-ITEM (CADR MC) NAME)) ++(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLARGUMENTS) ++ '((MC MENU-CONNS) (NAME SYMBOL))) ++(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-CONNS-NAMED-MENU (MC NAME) ++ (MENU-SET-NAMED-MENU (CADR MC) NAME)) ++(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLARGUMENTS) ++ '((MC MENU-CONNS) (NAME SYMBOL))) ++(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) ++ ++ ++(DEFUN MENU-SET-FIND-ITEM (MS POS) ++ (LET (MITEM) ++ (DOLIST (MI (CADDR MS)) ++ (IF (AND (BETWEEN (CAR POS) ++ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (FIFTH SELF) 0)) ++ (+ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (FIFTH SELF) 0)) ++ (SEVENTH (CADDR MI)))) ++ (BETWEEN (CADR POS) ++ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (SIXTH SELF) 0)) ++ (+ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (SIXTH SELF) 0)) ++ (EIGHTH (CADDR MI))))) ++ (SETQ MITEM MI))) ++ MITEM)) ++(SETF (GET 'MENU-SET-FIND-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (POS VECTOR))) ++(SETF (GET 'MENU-SET-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-SET-DELETE-ITEM (MS MI) ++ (SETF (CADDR MS) (REMOVE MI (CADDR MS)))) ++(SETF (GET 'MENU-SET-DELETE-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (MI MENU-SET-ITEM))) ++(SETF (GET 'MENU-SET-DELETE-ITEM 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-MOVE (MS) ++ (LET (SEL M) ++ (SETQ SEL (MENU-SET-SELECT MS NIL T)) ++ (SETQ M (MENU-SET-NAMED-MENU MS (CADR SEL))) ++ (MENU-REPOSITION M))) ++ ++(DEFUN MENU-MDRAW (M) ++ (CASE (FIRST M) ++ (MENU (MENU-DRAW M)) ++ (PICMENU (PICMENU-DRAW M)) ++ (BARMENU (BARMENU-DRAW M)) ++ (TEXTMENU (TEXTMENU-DRAW M)) ++ (EDITMENU (EDITMENU-DRAW M)) ++ (T (GLSEND M DRAW)))) ++ ++(DEFUN MENU-MSELECT (M &OPTIONAL ANYCLICK) ++ (CASE (FIRST M) ++ (MENU (MENU-SELECT M T)) ++ (PICMENU (PICMENU-SELECT M T ANYCLICK)) ++ (BARMENU (BARMENU-SELECT M)) ++ (TEXTMENU (TEXTMENU-SELECT M T)) ++ (EDITMENU (EDITMENU-SELECT M T)) ++ (T (GLSEND M SELECT)))) ++ ++(DEFUN MENU-MITEM-POSITION (M NAME LOC) ++ (CASE (FIRST M) ++ (MENU (MENU-ITEM-POSITION M NAME LOC)) ++ (PICMENU (PICMENU-ITEM-POSITION M NAME LOC)) ++ (T (GLSEND M ITEM-POSITION NAME LOC)))) ++ ++(DEFUN MENU-SET-DRAW (MS) ++ (XMAPWINDOW *WINDOW-DISPLAY* (CADADR MS)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-EXPOSURE (CADR MS)) ++ (DOLIST (ITEM (CADDR MS)) (MENU-MDRAW (CADDR ITEM)))) ++ ++(DEFUN MENU-SET-ITEM-POSITION (MS DESC &OPTIONAL LOC) ++ (LET (M) ++ (SETQ M (MENU-SET-NAMED-MENU MS (CADR DESC))) ++ (OR (MENU-MITEM-POSITION M (CAR DESC) LOC) ++ (MENU-MITEM-POSITION M NIL LOC)))) ++(SETF (GET 'MENU-SET-ITEM-POSITION 'GLARGUMENTS) ++ '((MS MENU-SET) (DESC MENU-PORT) (&OPTIONAL SYMBOL))) ++(SETF (GET 'MENU-SET-ITEM-POSITION 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN MENU-SET-DRAW-CONN (MS CONN) ++ (LET (PA PB TMP (DESCA (CAR CONN)) (DESCB (CADR CONN))) ++ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) ++ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) ++ (WHEN (> (CAR PA) (CAR PB)) ++ (SETQ TMP DESCA) ++ (SETQ DESCA DESCB) ++ (SETQ DESCB TMP)) ++ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) ++ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) ++ (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PA) (CADR PA) 3 NIL) ++ (WINDOW-DRAW-LINE-XY (CADR MS) (CAR PA) (CADR PA) (CAR PB) ++ (CADR PB) NIL) ++ (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PB) (CADR PB) 3 NIL) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN MENU-SET-ADJUST (MS NAME EDGE FROM OFFSET) ++ (LET (M FROMM PLACE) ++ (WHEN (SETQ M (MENU-SET-NAMED-ITEM MS NAME)) ++ (IF FROM ++ (PROGN ++ (SETQ FROMM (MENU-SET-NAMED-ITEM MS FROM)) ++ (SETQ PLACE ++ (CASE EDGE ++ (TOP (SIXTH (CADDR FROMM))) ++ (BOTTOM (+ (SIXTH (CADDR FROMM)) ++ (EIGHTH (CADDR FROMM)))) ++ (LEFT (+ (FIFTH (CADDR FROMM)) ++ (SEVENTH (CADDR FROMM)))) ++ (RIGHT (FIFTH (CADDR FROMM)))))) ++ (SETQ PLACE ++ (CASE EDGE ++ (TOP (CADDDR (CADR MS))) ++ ((BOTTOM LEFT) 0) ++ (RIGHT (FIFTH (CADR MS)))))) ++ (CASE EDGE ++ (TOP (SETF (SIXTH (CADDR M)) ++ (- (- PLACE (EIGHTH (CADDR M))) OFFSET))) ++ (BOTTOM (SETF (SIXTH (CADDR M)) (+ PLACE OFFSET))) ++ (LEFT (SETF (FIFTH (CADDR M)) (+ PLACE OFFSET))) ++ (RIGHT (SETF (FIFTH (CADDR M)) ++ (- (- PLACE (SEVENTH (CADDR M))) OFFSET))))))) ++(SETF (GET 'MENU-SET-ADJUST 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (EDGE SYMBOL) (FROM SYMBOL) ++ (OFFSET INTEGER))) ++(SETF (GET 'MENU-SET-ADJUST 'GLFNRESULTTYPE) 'INTEGER) ++ ++ ++(DEFUN VECTOR-SNAP (FIXED APPROX &OPTIONAL TOLERANCE) ++ (OR TOLERANCE (SETQ TOLERANCE 10)) ++ (IF (< (ABS (- (CAR FIXED) (CAR APPROX))) TOLERANCE) ++ (LIST (CAR FIXED) (CADR APPROX)) ++ (IF (< (ABS (- (CADR FIXED) (CADR APPROX))) TOLERANCE) ++ (LIST (CAR APPROX) (CADR FIXED)) APPROX))) ++(SETF (GET 'VECTOR-SNAP 'GLARGUMENTS) ++ '((FIXED VECTOR) (APPROX VECTOR) (&OPTIONAL NIL))) ++(SETF (GET 'VECTOR-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN MENU-CONNS-CREATE (MS) (LIST 'MENU-CONNS MS NIL)) ++(SETF (GET 'MENU-CONNS-CREATE 'GLARGUMENTS) '((MS MENU-SET))) ++(SETF (GET 'MENU-CONNS-CREATE 'GLFNRESULTTYPE) 'MENU-CONNS) ++ ++ ++(DEFUN MENU-CONNS-DRAW (MC) ++ (MENU-SET-DRAW (CADR MC)) ++ (DOLIST (C (CADDR MC)) (MENU-SET-DRAW-CONN (CADR MC) C))) ++ ++(DEFUN MENU-CONNS-MOVE (MC) ++ (MENU-SET-MOVE (CADR MC)) ++ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (MENU-CONNS-DRAW MC)) ++ ++(DEFUN MENU-CONNS-REDRAW (MC) ++ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (MENU-CONNS-DRAW MC)) ++ ++(DEFUN MENU-CONNS-ADD-CONN (MC) ++ (LET (SEL SELB CONN) ++ (SETQ SEL (MENU-SET-SELECT (CADR MC))) ++ (IF (EQ (CADR SEL) 'BACKGROUND) SEL ++ (PROGN ++ (SETQ SELB (MENU-SET-SELECT (CADR MC))) ++ (WHEN (NOT (EQ (CADR SELB) 'BACKGROUND)) ++ (SETQ CONN (LIST SEL SELB)) ++ (MENU-SET-DRAW-CONN (CADR MC) CONN) ++ (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL)))) ++ NIL)))) ++(SETF (GET 'MENU-CONNS-ADD-CONN 'GLARGUMENTS) '((MC MENU-CONNS))) ++(SETF (GET 'MENU-CONNS-ADD-CONN 'GLFNRESULTTYPE) 'MENU-SELECTION) ++ ++ ++(DEFUN MENU-CONNS-NEW-CONN (MC FROMNAME FROMPORT TONAME TOPORT) ++ (LET (CONN) ++ (SETQ CONN (LIST (LIST FROMPORT FROMNAME) (LIST TOPORT TONAME))) ++ (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL))))) ++(SETF (GET 'MENU-CONNS-NEW-CONN 'GLARGUMENTS) ++ '((MC MENU-CONNS) (FROMNAME SYMBOL) (FROMPORT SYMBOL) ++ (TONAME SYMBOL) (TOPORT SYMBOL))) ++(SETF (GET 'MENU-CONNS-NEW-CONN 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-CONN)) ++ ++ ++(DEFUN MENU-CONNS-ADD-ITEM (MC NAME SYM MENU) ++ (MENU-SET-ADD-ITEM (CADR MC) NAME SYM MENU)) ++(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLARGUMENTS) ++ '((MC MENU-CONNS) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) ++(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-CONNS-FIND-CONN (MC PT) ++ (LET (MS LS FOUND RES PA PB TMP DESCA DESCB) ++ (SETQ LS (LIST (COPY-LIST '(0 0)) (COPY-LIST '(0 0)))) ++ (SETQ MS (CADR MC)) ++ (DOLIST (CONN (CADDR MC)) ++ (UNLESS FOUND ++ (SETQ DESCA (CAR CONN)) ++ (SETQ DESCB (CADR CONN)) ++ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) ++ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) ++ (WHEN (> (CAR PA) (CAR PB)) ++ (SETQ TMP DESCA) ++ (SETQ DESCA DESCB) ++ (SETQ DESCB TMP)) ++ (SETF (CAR LS) (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) ++ (SETF (CADR LS) (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) ++ (WHEN (< (ABS (/ (- (* (- (CAADR LS) (CAAR LS)) ++ (- (CADR PT) (CADAR LS))) ++ (* (- (CADADR LS) (CADAR LS)) ++ (- (CAR PT) (CAAR LS)))) ++ (SQRT (+ (EXPT (- (CAADR LS) (CAAR LS)) 2) ++ (EXPT (- (CADADR LS) (CADAR LS)) 2))))) ++ 5) ++ (SETQ FOUND T) ++ (SETQ RES CONN)))) ++ RES)) ++(SETF (GET 'MENU-CONNS-FIND-CONN 'GLARGUMENTS) ++ '((MC MENU-CONNS) (PT VECTOR))) ++(SETF (GET 'MENU-CONNS-FIND-CONN 'GLFNRESULTTYPE) 'MENU-SET-CONN) ++ ++ ++(DEFUN MENU-CONNS-FIND-ITEM (MC PT) (MENU-SET-FIND-ITEM (CADR MC) PT)) ++(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLARGUMENTS) ++ '((MC MENU-CONNS) (PT VECTOR))) ++(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-CONNS-DELETE-CONN (MC CONN) ++ (SETF (CADDR MC) (REMOVE CONN (CADDR MC)))) ++(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLARGUMENTS) ++ '((MC MENU-CONNS) (CONN MENU-SET-CONN))) ++(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-CONN)) ++ ++ ++(DEFUN MENU-CONNS-DELETE-ITEM (MC MI) ++ (LET (MS) ++ (SETQ MS (CADR MC)) ++ (MENU-SET-DELETE-ITEM MS MI) ++ (DOLIST (CONN (CADDR MC)) ++ (IF (OR (EQ (CADAR CONN) (CAR MI)) (EQ (CADADR CONN) (CAR MI))) ++ (MENU-CONNS-DELETE-CONN MC CONN))))) ++ ++(DEFUN MENU-CONNS-REMOVE-ITEMS (MC) ++ (MENU-SET-REMOVE-ITEMS (CADR MC)) ++ (SETF (CADDR MC) NIL)) ++(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLARGUMENTS) '((MC MENU-CONNS))) ++(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-CONN)) ++ ++ ++(DEFUN MENU-CONNS-CONNECTED-PORTS (MC BOXNAME) ++ (LET (PORTS) ++ (DOLIST (CONN (CADDR MC)) ++ (IF (EQ BOXNAME (CADADR CONN)) (PUSHNEW (CAADR CONN) PORTS) ++ (IF (EQ BOXNAME (CADAR CONN)) (PUSHNEW (CAAR CONN) PORTS)))) ++ PORTS)) ++ ++(DEFUN MENU-CONNS-FIND-CONNS (MC BOXNAME PORT) ++ (LET (RES) ++ (DOLIST (CONN (CADDR MC)) ++ (IF (AND (EQ BOXNAME (CADADR CONN)) (EQ PORT (CAADR CONN))) ++ (SETQ RES (NCONC RES (CONS (CAR CONN) NIL)))) ++ (IF (AND (EQ BOXNAME (CADAR CONN)) (EQ PORT (CAAR CONN))) ++ (SETQ RES (NCONC RES (CONS (CADR CONN) NIL))))) ++ RES)) ++(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLARGUMENTS) ++ '((MC MENU-CONNS) (BOXNAME SYMBOL) (PORT SYMBOL))) ++(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLFNRESULTTYPE) '(LISTOF MENU-PORT)) ++ ++ ++(DEFUN COMPILE-MENU-SET () ++ (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") ++ '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" ++ "glisp/menu-set-header.lsp") ++ (COMPILE-FILE "glisp/menu-settrans.lsp")) ++ ++(DEFUN COMPILE-MENU-SETB () ++ (GLCOMPFILES *DIRECTORY* ++ '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") ++ '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" ++ "glisp/menu-set-header.lsp")) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_init_xgcl.lsp +@@ -0,0 +1,118 @@ ++; Copyright (c) 1994 William F. Schelter ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++(in-package :XLIB) ++(in-package "COMPILER") ++(in-package "SYSTEM") ++(defvar *command-args* nil) ++(in-package "USER") ++(in-package "LISP") ++ ++(lisp::in-package "SLOOP") ++;;Appropriate for Austin ++#-winnt ++(setq SYSTEM:*DEFAULT-TIME-ZONE* 6) ++#+winnt ++(setq SYSTEM:*DEFAULT-TIME-ZONE* (GET-SYSTEM-TIME-ZONE)) ++ ++(in-package "USER") ++(progn (allocate 'cons 100) (allocate 'string 40) ++ (system:init-system) (gbc t) ++ (si::multiply-bignum-stack 25) ++ (or lisp::*link-array* ++ (setq lisp::*link-array* ++ (make-array 500 :element-type 'fixnum :fill-pointer 0))) ++ (use-fast-links t) ++(setq compiler::*cmpinclude* "") (load #"../cmpnew/cmpmain.lsp") (gbc t) (load #"../cmpnew/lfun_list.lsp") ++ (gbc t) (load #"../cmpnew/cmpopt.lsp") (gbc t) ++(load #"../lsp/auto.lsp") (gbc t) ++(defun si::src-path (x) ++ (si::string-concatenate (or si::*lib-directory* "GCLDIR/") x)) ++ ++ (when compiler::*cmpinclude-string* ++ (with-open-file (st "../h/cmpinclude.h") ++ (let ++ ((tem (make-array (file-length st) :element-type 'standard-char ++ :static t))) ++ (if (si::fread tem 0 (length tem) st) ++ (setq compiler::*cmpinclude-string* tem))))) ++ ;;compile-file is in cmpmain.lsp ++ ++ (setf (symbol-function 'si:clear-compiler-properties) ++ (symbol-function 'compiler::compiler-clear-compiler-properties)) ++; (load "../lsp/setdoc.lsp") ++ (setq system::*old-top-level* (symbol-function 'system:top-level)) ++(defvar si::*command-args* nil) ++(defun si::get-command-arg (a &optional val-if-there) ++ ;; return non nil if a is in si::*command-args* and return ++ ;; the string which is after it if there is one" ++ (let ((tem (member a si::*command-args* :test 'equal))) ++ (if tem (or val-if-there (cadr tem) t)))) ++(defvar si::*lib-directory* nil) ++(defun system::gcl-top-level (&aux tem) ++ (dotimes (i (si::argc)) ++ (setq si::*command-args* (cons (si::argv i) si::*command-args*))) ++ (setq si::*command-args* (nreverse si::*command-args* )) ++ (setq si::*system-directory* ++ (or (si::get-command-arg "-dir") ++ (car si::*command-args*))) ++ (setq si::*lib-directory* (si::get-command-arg "-libdir")) ++ ++ (when (si::get-command-arg "-compile") ++ (let ((system::*quit-tag* (cons nil nil)) ++ (system::*quit-tags* nil) (system::*break-level* '()) ++ (system::*break-env* nil) (system::*ihs-base* 1) ++ (system::*ihs-top* 1) (system::*current-ihs* 1) ++ (*break-enable* nil)) ++ (system:error-set ++ '(progn ++ (compile-file (si::get-command-arg "-compile") ++ :output-file ++ (or (si::get-command-arg "-o") ++ (si::get-command-arg "-compile")) ++ :o-file (not (si::get-command-arg "-no-o" t)) ++ :c-file (si::get-command-arg "-system-p" t) ++ :h-file (si::get-command-arg "-system-p" t) ++ :data-file (si::get-command-arg "-system-p" t) ++ :system-p (si::get-command-arg "-system-p" t)))) ++ (bye (if compiler::*error-p* 1 0)))) ++ (format t "GCL (GNU Common Lisp) ~A~%~a~%~a~%" "DATE" ++ "Licensed under GNU Public Library License" ++ "Contains Enhancements by W. Schelter") ++ (setq si::*ihs-top* 1) ++ (in-package 'system::user) (incf system::*ihs-top* 2) ++ (funcall system::*old-top-level*)) ++ (setq si::*gcl-version* 600) ++ (defun lisp-implementation-version nil (format nil "1-~a" si::*gcl-version*)) ++ (setq si:*inhibit-macro-special* t) ++ ;(setq *modules* nil) ++ (gbc t) (system:reset-gbc-count) ++ (allocate 'cons 200) ++ (defun system:top-level nil (system::gcl-top-level)) ++ (unintern 'system) ++ (unintern 'lisp) ++ (unintern 'compiler) ++ (unintern 'user) ++ (si::chdir "/d19/staff/wfs/novak-xgcl")(user::user-init)(si::save-system "saved_xgcl") ++ (if (fboundp 'user-init) (user-init)) ++ (system:save-system "saved_gcl") (bye) ++ (defun system:top-level nil (system::gcl-top-level)) ++ (save "saved_gcl") (bye)) ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_defentry_events.lsp +@@ -0,0 +1,817 @@ ++(in-package :XLIB) ++; defentry-events.lsp Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++ ++;;;;;; XKeyEvent funcions ;;;;;; ++ ++(defentry make-XKeyEvent () ( fixnum "make_XKeyEvent" )) ++(defentry XKeyEvent-same_screen (fixnum) ( fixnum "XKeyEvent_same_screen" )) ++(defentry set-XKeyEvent-same_screen (fixnum fixnum) ( void "set_XKeyEvent_same_screen" )) ++(defentry XKeyEvent-keycode (fixnum) ( fixnum "XKeyEvent_keycode" )) ++(defentry set-XKeyEvent-keycode (fixnum fixnum) ( void "set_XKeyEvent_keycode" )) ++(defentry XKeyEvent-state (fixnum) ( fixnum "XKeyEvent_state" )) ++(defentry set-XKeyEvent-state (fixnum fixnum) ( void "set_XKeyEvent_state" )) ++(defentry XKeyEvent-y_root (fixnum) ( fixnum "XKeyEvent_y_root" )) ++(defentry set-XKeyEvent-y_root (fixnum fixnum) ( void "set_XKeyEvent_y_root" )) ++(defentry XKeyEvent-x_root (fixnum) ( fixnum "XKeyEvent_x_root" )) ++(defentry set-XKeyEvent-x_root (fixnum fixnum) ( void "set_XKeyEvent_x_root" )) ++(defentry XKeyEvent-y (fixnum) ( fixnum "XKeyEvent_y" )) ++(defentry set-XKeyEvent-y (fixnum fixnum) ( void "set_XKeyEvent_y" )) ++(defentry XKeyEvent-x (fixnum) ( fixnum "XKeyEvent_x" )) ++(defentry set-XKeyEvent-x (fixnum fixnum) ( void "set_XKeyEvent_x" )) ++(defentry XKeyEvent-time (fixnum) ( fixnum "XKeyEvent_time" )) ++(defentry set-XKeyEvent-time (fixnum fixnum) ( void "set_XKeyEvent_time" )) ++(defentry XKeyEvent-subwindow (fixnum) ( fixnum "XKeyEvent_subwindow" )) ++(defentry set-XKeyEvent-subwindow (fixnum fixnum) ( void "set_XKeyEvent_subwindow" )) ++(defentry XKeyEvent-root (fixnum) ( fixnum "XKeyEvent_root" )) ++(defentry set-XKeyEvent-root (fixnum fixnum) ( void "set_XKeyEvent_root" )) ++(defentry XKeyEvent-window (fixnum) ( fixnum "XKeyEvent_window" )) ++(defentry set-XKeyEvent-window (fixnum fixnum) ( void "set_XKeyEvent_window" )) ++(defentry XKeyEvent-display (fixnum) ( fixnum "XKeyEvent_display" )) ++(defentry set-XKeyEvent-display (fixnum fixnum) ( void "set_XKeyEvent_display" )) ++(defentry XKeyEvent-send_event (fixnum) ( fixnum "XKeyEvent_send_event" )) ++(defentry set-XKeyEvent-send_event (fixnum fixnum) ( void "set_XKeyEvent_send_event" )) ++(defentry XKeyEvent-serial (fixnum) ( fixnum "XKeyEvent_serial" )) ++(defentry set-XKeyEvent-serial (fixnum fixnum) ( void "set_XKeyEvent_serial" )) ++(defentry XKeyEvent-type (fixnum) ( fixnum "XKeyEvent_type" )) ++(defentry set-XKeyEvent-type (fixnum fixnum) ( void "set_XKeyEvent_type" )) ++ ++ ++;;;;;; XButtonEvent funcions ;;;;;; ++ ++(defentry make-XButtonEvent () ( fixnum "make_XButtonEvent" )) ++(defentry XButtonEvent-same_screen (fixnum) ( fixnum "XButtonEvent_same_screen" )) ++(defentry set-XButtonEvent-same_screen (fixnum fixnum) ( void "set_XButtonEvent_same_screen" )) ++(defentry XButtonEvent-button (fixnum) ( fixnum "XButtonEvent_button" )) ++(defentry set-XButtonEvent-button (fixnum fixnum) ( void "set_XButtonEvent_button" )) ++(defentry XButtonEvent-state (fixnum) ( fixnum "XButtonEvent_state" )) ++(defentry set-XButtonEvent-state (fixnum fixnum) ( void "set_XButtonEvent_state" )) ++(defentry XButtonEvent-y_root (fixnum) ( fixnum "XButtonEvent_y_root" )) ++(defentry set-XButtonEvent-y_root (fixnum fixnum) ( void "set_XButtonEvent_y_root" )) ++(defentry XButtonEvent-x_root (fixnum) ( fixnum "XButtonEvent_x_root" )) ++(defentry set-XButtonEvent-x_root (fixnum fixnum) ( void "set_XButtonEvent_x_root" )) ++(defentry XButtonEvent-y (fixnum) ( fixnum "XButtonEvent_y" )) ++(defentry set-XButtonEvent-y (fixnum fixnum) ( void "set_XButtonEvent_y" )) ++(defentry XButtonEvent-x (fixnum) ( fixnum "XButtonEvent_x" )) ++(defentry set-XButtonEvent-x (fixnum fixnum) ( void "set_XButtonEvent_x" )) ++(defentry XButtonEvent-time (fixnum) ( fixnum "XButtonEvent_time" )) ++(defentry set-XButtonEvent-time (fixnum fixnum) ( void "set_XButtonEvent_time" )) ++(defentry XButtonEvent-subwindow (fixnum) ( fixnum "XButtonEvent_subwindow" )) ++(defentry set-XButtonEvent-subwindow (fixnum fixnum) ( void "set_XButtonEvent_subwindow" )) ++(defentry XButtonEvent-root (fixnum) ( fixnum "XButtonEvent_root" )) ++(defentry set-XButtonEvent-root (fixnum fixnum) ( void "set_XButtonEvent_root" )) ++(defentry XButtonEvent-window (fixnum) ( fixnum "XButtonEvent_window" )) ++(defentry set-XButtonEvent-window (fixnum fixnum) ( void "set_XButtonEvent_window" )) ++(defentry XButtonEvent-display (fixnum) ( fixnum "XButtonEvent_display" )) ++(defentry set-XButtonEvent-display (fixnum fixnum) ( void "set_XButtonEvent_display" )) ++(defentry XButtonEvent-send_event (fixnum) ( fixnum "XButtonEvent_send_event" )) ++(defentry set-XButtonEvent-send_event (fixnum fixnum) ( void "set_XButtonEvent_send_event" )) ++(defentry XButtonEvent-serial (fixnum) ( fixnum "XButtonEvent_serial" )) ++(defentry set-XButtonEvent-serial (fixnum fixnum) ( void "set_XButtonEvent_serial" )) ++(defentry XButtonEvent-type (fixnum) ( fixnum "XButtonEvent_type" )) ++(defentry set-XButtonEvent-type (fixnum fixnum) ( void "set_XButtonEvent_type" )) ++ ++ ++;;;;;; XMotionEvent funcions ;;;;;; ++ ++(defentry make-XMotionEvent () ( fixnum "make_XMotionEvent" )) ++(defentry XMotionEvent-same_screen (fixnum) ( fixnum "XMotionEvent_same_screen" )) ++(defentry set-XMotionEvent-same_screen (fixnum fixnum) ( void "set_XMotionEvent_same_screen" )) ++(defentry XMotionEvent-is_hint (fixnum) ( char "XMotionEvent_is_hint" )) ++(defentry set-XMotionEvent-is_hint (fixnum char) ( void "set_XMotionEvent_is_hint" )) ++(defentry XMotionEvent-state (fixnum) ( fixnum "XMotionEvent_state" )) ++(defentry set-XMotionEvent-state (fixnum fixnum) ( void "set_XMotionEvent_state" )) ++(defentry XMotionEvent-y_root (fixnum) ( fixnum "XMotionEvent_y_root" )) ++(defentry set-XMotionEvent-y_root (fixnum fixnum) ( void "set_XMotionEvent_y_root" )) ++(defentry XMotionEvent-x_root (fixnum) ( fixnum "XMotionEvent_x_root" )) ++(defentry set-XMotionEvent-x_root (fixnum fixnum) ( void "set_XMotionEvent_x_root" )) ++(defentry XMotionEvent-y (fixnum) ( fixnum "XMotionEvent_y" )) ++(defentry set-XMotionEvent-y (fixnum fixnum) ( void "set_XMotionEvent_y" )) ++(defentry XMotionEvent-x (fixnum) ( fixnum "XMotionEvent_x" )) ++(defentry set-XMotionEvent-x (fixnum fixnum) ( void "set_XMotionEvent_x" )) ++(defentry XMotionEvent-time (fixnum) ( fixnum "XMotionEvent_time" )) ++(defentry set-XMotionEvent-time (fixnum fixnum) ( void "set_XMotionEvent_time" )) ++(defentry XMotionEvent-subwindow (fixnum) ( fixnum "XMotionEvent_subwindow" )) ++(defentry set-XMotionEvent-subwindow (fixnum fixnum) ( void "set_XMotionEvent_subwindow" )) ++(defentry XMotionEvent-root (fixnum) ( fixnum "XMotionEvent_root" )) ++(defentry set-XMotionEvent-root (fixnum fixnum) ( void "set_XMotionEvent_root" )) ++(defentry XMotionEvent-window (fixnum) ( fixnum "XMotionEvent_window" )) ++(defentry set-XMotionEvent-window (fixnum fixnum) ( void "set_XMotionEvent_window" )) ++(defentry XMotionEvent-display (fixnum) ( fixnum "XMotionEvent_display" )) ++(defentry set-XMotionEvent-display (fixnum fixnum) ( void "set_XMotionEvent_display" )) ++(defentry XMotionEvent-send_event (fixnum) ( fixnum "XMotionEvent_send_event" )) ++(defentry set-XMotionEvent-send_event (fixnum fixnum) ( void "set_XMotionEvent_send_event" )) ++(defentry XMotionEvent-serial (fixnum) ( fixnum "XMotionEvent_serial" )) ++(defentry set-XMotionEvent-serial (fixnum fixnum) ( void "set_XMotionEvent_serial" )) ++(defentry XMotionEvent-type (fixnum) ( fixnum "XMotionEvent_type" )) ++(defentry set-XMotionEvent-type (fixnum fixnum) ( void "set_XMotionEvent_type" )) ++ ++ ++;;;;;; XCrossingEvent funcions ;;;;;; ++ ++(defentry make-XCrossingEvent () ( fixnum "make_XCrossingEvent" )) ++(defentry XCrossingEvent-state (fixnum) ( fixnum "XCrossingEvent_state" )) ++(defentry set-XCrossingEvent-state (fixnum fixnum) ( void "set_XCrossingEvent_state" )) ++(defentry XCrossingEvent-focus (fixnum) ( fixnum "XCrossingEvent_focus" )) ++(defentry set-XCrossingEvent-focus (fixnum fixnum) ( void "set_XCrossingEvent_focus" )) ++(defentry XCrossingEvent-same_screen (fixnum) ( fixnum "XCrossingEvent_same_screen" )) ++(defentry set-XCrossingEvent-same_screen (fixnum fixnum) ( void "set_XCrossingEvent_same_screen" )) ++(defentry XCrossingEvent-detail (fixnum) ( fixnum "XCrossingEvent_detail" )) ++(defentry set-XCrossingEvent-detail (fixnum fixnum) ( void "set_XCrossingEvent_detail" )) ++(defentry XCrossingEvent-mode (fixnum) ( fixnum "XCrossingEvent_mode" )) ++(defentry set-XCrossingEvent-mode (fixnum fixnum) ( void "set_XCrossingEvent_mode" )) ++(defentry XCrossingEvent-y_root (fixnum) ( fixnum "XCrossingEvent_y_root" )) ++(defentry set-XCrossingEvent-y_root (fixnum fixnum) ( void "set_XCrossingEvent_y_root" )) ++(defentry XCrossingEvent-x_root (fixnum) ( fixnum "XCrossingEvent_x_root" )) ++(defentry set-XCrossingEvent-x_root (fixnum fixnum) ( void "set_XCrossingEvent_x_root" )) ++(defentry XCrossingEvent-y (fixnum) ( fixnum "XCrossingEvent_y" )) ++(defentry set-XCrossingEvent-y (fixnum fixnum) ( void "set_XCrossingEvent_y" )) ++(defentry XCrossingEvent-x (fixnum) ( fixnum "XCrossingEvent_x" )) ++(defentry set-XCrossingEvent-x (fixnum fixnum) ( void "set_XCrossingEvent_x" )) ++(defentry XCrossingEvent-time (fixnum) ( fixnum "XCrossingEvent_time" )) ++(defentry set-XCrossingEvent-time (fixnum fixnum) ( void "set_XCrossingEvent_time" )) ++(defentry XCrossingEvent-subwindow (fixnum) ( fixnum "XCrossingEvent_subwindow" )) ++(defentry set-XCrossingEvent-subwindow (fixnum fixnum) ( void "set_XCrossingEvent_subwindow" )) ++(defentry XCrossingEvent-root (fixnum) ( fixnum "XCrossingEvent_root" )) ++(defentry set-XCrossingEvent-root (fixnum fixnum) ( void "set_XCrossingEvent_root" )) ++(defentry XCrossingEvent-window (fixnum) ( fixnum "XCrossingEvent_window" )) ++(defentry set-XCrossingEvent-window (fixnum fixnum) ( void "set_XCrossingEvent_window" )) ++(defentry XCrossingEvent-display (fixnum) ( fixnum "XCrossingEvent_display" )) ++(defentry set-XCrossingEvent-display (fixnum fixnum) ( void "set_XCrossingEvent_display" )) ++(defentry XCrossingEvent-send_event (fixnum) ( fixnum "XCrossingEvent_send_event" )) ++(defentry set-XCrossingEvent-send_event (fixnum fixnum) ( void "set_XCrossingEvent_send_event" )) ++(defentry XCrossingEvent-serial (fixnum) ( fixnum "XCrossingEvent_serial" )) ++(defentry set-XCrossingEvent-serial (fixnum fixnum) ( void "set_XCrossingEvent_serial" )) ++(defentry XCrossingEvent-type (fixnum) ( fixnum "XCrossingEvent_type" )) ++(defentry set-XCrossingEvent-type (fixnum fixnum) ( void "set_XCrossingEvent_type" )) ++ ++ ++;;;;;; XFocusChangeEvent funcions ;;;;;; ++ ++(defentry make-XFocusChangeEvent () ( fixnum "make_XFocusChangeEvent" )) ++(defentry XFocusChangeEvent-detail (fixnum) ( fixnum "XFocusChangeEvent_detail" )) ++(defentry set-XFocusChangeEvent-detail (fixnum fixnum) ( void "set_XFocusChangeEvent_detail" )) ++(defentry XFocusChangeEvent-mode (fixnum) ( fixnum "XFocusChangeEvent_mode" )) ++(defentry set-XFocusChangeEvent-mode (fixnum fixnum) ( void "set_XFocusChangeEvent_mode" )) ++(defentry XFocusChangeEvent-window (fixnum) ( fixnum "XFocusChangeEvent_window" )) ++(defentry set-XFocusChangeEvent-window (fixnum fixnum) ( void "set_XFocusChangeEvent_window" )) ++(defentry XFocusChangeEvent-display (fixnum) ( fixnum "XFocusChangeEvent_display" )) ++(defentry set-XFocusChangeEvent-display (fixnum fixnum) ( void "set_XFocusChangeEvent_display" )) ++(defentry XFocusChangeEvent-send_event (fixnum) ( fixnum "XFocusChangeEvent_send_event" )) ++(defentry set-XFocusChangeEvent-send_event (fixnum fixnum) ( void "set_XFocusChangeEvent_send_event" )) ++(defentry XFocusChangeEvent-serial (fixnum) ( fixnum "XFocusChangeEvent_serial" )) ++(defentry set-XFocusChangeEvent-serial (fixnum fixnum) ( void "set_XFocusChangeEvent_serial" )) ++(defentry XFocusChangeEvent-type (fixnum) ( fixnum "XFocusChangeEvent_type" )) ++(defentry set-XFocusChangeEvent-type (fixnum fixnum) ( void "set_XFocusChangeEvent_type" )) ++ ++ ++;;;;;; XKeymapEvent funcions ;;;;;; ++ ++(defentry make-XKeymapEvent () ( fixnum "make_XKeymapEvent" )) ++;;(defentry XKeymapEvent-key_vector[32] (fixnum) ( char "XKeymapEvent_key_vector[32]" )) ++;;(defentry set-XKeymapEvent-key_vector[32] (fixnum char) ( void "set_XKeymapEvent_key_vector[32]" )) ++(defentry XKeymapEvent-window (fixnum) ( fixnum "XKeymapEvent_window" )) ++(defentry set-XKeymapEvent-window (fixnum fixnum) ( void "set_XKeymapEvent_window" )) ++(defentry XKeymapEvent-display (fixnum) ( fixnum "XKeymapEvent_display" )) ++(defentry set-XKeymapEvent-display (fixnum fixnum) ( void "set_XKeymapEvent_display" )) ++(defentry XKeymapEvent-send_event (fixnum) ( fixnum "XKeymapEvent_send_event" )) ++(defentry set-XKeymapEvent-send_event (fixnum fixnum) ( void "set_XKeymapEvent_send_event" )) ++(defentry XKeymapEvent-serial (fixnum) ( fixnum "XKeymapEvent_serial" )) ++(defentry set-XKeymapEvent-serial (fixnum fixnum) ( void "set_XKeymapEvent_serial" )) ++(defentry XKeymapEvent-type (fixnum) ( fixnum "XKeymapEvent_type" )) ++(defentry set-XKeymapEvent-type (fixnum fixnum) ( void "set_XKeymapEvent_type" )) ++ ++ ++;;;;;; XExposeEvent funcions ;;;;;; ++ ++(defentry make-XExposeEvent () ( fixnum "make_XExposeEvent" )) ++(defentry XExposeEvent-count (fixnum) ( fixnum "XExposeEvent_count" )) ++(defentry set-XExposeEvent-count (fixnum fixnum) ( void "set_XExposeEvent_count" )) ++(defentry XExposeEvent-height (fixnum) ( fixnum "XExposeEvent_height" )) ++(defentry set-XExposeEvent-height (fixnum fixnum) ( void "set_XExposeEvent_height" )) ++(defentry XExposeEvent-width (fixnum) ( fixnum "XExposeEvent_width" )) ++(defentry set-XExposeEvent-width (fixnum fixnum) ( void "set_XExposeEvent_width" )) ++(defentry XExposeEvent-y (fixnum) ( fixnum "XExposeEvent_y" )) ++(defentry set-XExposeEvent-y (fixnum fixnum) ( void "set_XExposeEvent_y" )) ++(defentry XExposeEvent-x (fixnum) ( fixnum "XExposeEvent_x" )) ++(defentry set-XExposeEvent-x (fixnum fixnum) ( void "set_XExposeEvent_x" )) ++(defentry XExposeEvent-window (fixnum) ( fixnum "XExposeEvent_window" )) ++(defentry set-XExposeEvent-window (fixnum fixnum) ( void "set_XExposeEvent_window" )) ++(defentry XExposeEvent-display (fixnum) ( fixnum "XExposeEvent_display" )) ++(defentry set-XExposeEvent-display (fixnum fixnum) ( void "set_XExposeEvent_display" )) ++(defentry XExposeEvent-send_event (fixnum) ( fixnum "XExposeEvent_send_event" )) ++(defentry set-XExposeEvent-send_event (fixnum fixnum) ( void "set_XExposeEvent_send_event" )) ++(defentry XExposeEvent-serial (fixnum) ( fixnum "XExposeEvent_serial" )) ++(defentry set-XExposeEvent-serial (fixnum fixnum) ( void "set_XExposeEvent_serial" )) ++(defentry XExposeEvent-type (fixnum) ( fixnum "XExposeEvent_type" )) ++(defentry set-XExposeEvent-type (fixnum fixnum) ( void "set_XExposeEvent_type" )) ++ ++ ++;;;;;; XGraphicsExposeEvent funcions ;;;;;; ++ ++(defentry make-XGraphicsExposeEvent () ( fixnum "make_XGraphicsExposeEvent" )) ++(defentry XGraphicsExposeEvent-minor_code (fixnum) ( fixnum "XGraphicsExposeEvent_minor_code" )) ++(defentry set-XGraphicsExposeEvent-minor_code (fixnum fixnum) ( void "set_XGraphicsExposeEvent_minor_code" )) ++(defentry XGraphicsExposeEvent-major_code (fixnum) ( fixnum "XGraphicsExposeEvent_major_code" )) ++(defentry set-XGraphicsExposeEvent-major_code (fixnum fixnum) ( void "set_XGraphicsExposeEvent_major_code" )) ++(defentry XGraphicsExposeEvent-count (fixnum) ( fixnum "XGraphicsExposeEvent_count" )) ++(defentry set-XGraphicsExposeEvent-count (fixnum fixnum) ( void "set_XGraphicsExposeEvent_count" )) ++(defentry XGraphicsExposeEvent-height (fixnum) ( fixnum "XGraphicsExposeEvent_height" )) ++(defentry set-XGraphicsExposeEvent-height (fixnum fixnum) ( void "set_XGraphicsExposeEvent_height" )) ++(defentry XGraphicsExposeEvent-width (fixnum) ( fixnum "XGraphicsExposeEvent_width" )) ++(defentry set-XGraphicsExposeEvent-width (fixnum fixnum) ( void "set_XGraphicsExposeEvent_width" )) ++(defentry XGraphicsExposeEvent-y (fixnum) ( fixnum "XGraphicsExposeEvent_y" )) ++(defentry set-XGraphicsExposeEvent-y (fixnum fixnum) ( void "set_XGraphicsExposeEvent_y" )) ++(defentry XGraphicsExposeEvent-x (fixnum) ( fixnum "XGraphicsExposeEvent_x" )) ++(defentry set-XGraphicsExposeEvent-x (fixnum fixnum) ( void "set_XGraphicsExposeEvent_x" )) ++(defentry XGraphicsExposeEvent-drawable (fixnum) (fixnum "XGraphicsExposeEvent_drawable" )) ++(defentry set-XGraphicsExposeEvent-drawable (fixnum fixnum) ( void "set_XGraphicsExposeEvent_drawable" )) ++(defentry XGraphicsExposeEvent-display (fixnum) ( fixnum "XGraphicsExposeEvent_display" )) ++(defentry set-XGraphicsExposeEvent-display (fixnum fixnum) ( void "set_XGraphicsExposeEvent_display" )) ++(defentry XGraphicsExposeEvent-send_event (fixnum) ( fixnum "XGraphicsExposeEvent_send_event" )) ++(defentry set-XGraphicsExposeEvent-send_event (fixnum fixnum) ( void "set_XGraphicsExposeEvent_send_event" )) ++(defentry XGraphicsExposeEvent-serial (fixnum) ( fixnum "XGraphicsExposeEvent_serial" )) ++(defentry set-XGraphicsExposeEvent-serial (fixnum fixnum) ( void "set_XGraphicsExposeEvent_serial" )) ++(defentry XGraphicsExposeEvent-type (fixnum) ( fixnum "XGraphicsExposeEvent_type" )) ++(defentry set-XGraphicsExposeEvent-type (fixnum fixnum) ( void "set_XGraphicsExposeEvent_type" )) ++ ++ ++;;;;;; XNoExposeEvent funcions ;;;;;; ++ ++(defentry make-XNoExposeEvent () ( fixnum "make_XNoExposeEvent" )) ++(defentry XNoExposeEvent-minor_code (fixnum) ( fixnum "XNoExposeEvent_minor_code" )) ++(defentry set-XNoExposeEvent-minor_code (fixnum fixnum) ( void "set_XNoExposeEvent_minor_code" )) ++(defentry XNoExposeEvent-major_code (fixnum) ( fixnum "XNoExposeEvent_major_code" )) ++(defentry set-XNoExposeEvent-major_code (fixnum fixnum) ( void "set_XNoExposeEvent_major_code" )) ++(defentry XNoExposeEvent-drawable (fixnum) ( fixnum "XNoExposeEvent_drawable" )) ++(defentry set-XNoExposeEvent-drawable (fixnum fixnum) ( void "set_XNoExposeEvent_drawable" )) ++(defentry XNoExposeEvent-display (fixnum) ( fixnum "XNoExposeEvent_display" )) ++(defentry set-XNoExposeEvent-display (fixnum fixnum) ( void "set_XNoExposeEvent_display" )) ++(defentry XNoExposeEvent-send_event (fixnum) ( fixnum "XNoExposeEvent_send_event" )) ++(defentry set-XNoExposeEvent-send_event (fixnum fixnum) ( void "set_XNoExposeEvent_send_event" )) ++(defentry XNoExposeEvent-serial (fixnum) ( fixnum "XNoExposeEvent_serial" )) ++(defentry set-XNoExposeEvent-serial (fixnum fixnum) ( void "set_XNoExposeEvent_serial" )) ++(defentry XNoExposeEvent-type (fixnum) ( fixnum "XNoExposeEvent_type" )) ++(defentry set-XNoExposeEvent-type (fixnum fixnum) ( void "set_XNoExposeEvent_type" )) ++ ++ ++;;;;;; XVisibilityEvent funcions ;;;;;; ++ ++(defentry make-XVisibilityEvent () ( fixnum "make_XVisibilityEvent" )) ++(defentry XVisibilityEvent-state (fixnum) ( fixnum "XVisibilityEvent_state" )) ++(defentry set-XVisibilityEvent-state (fixnum fixnum) ( void "set_XVisibilityEvent_state" )) ++(defentry XVisibilityEvent-window (fixnum) ( fixnum "XVisibilityEvent_window" )) ++(defentry set-XVisibilityEvent-window (fixnum fixnum) ( void "set_XVisibilityEvent_window" )) ++(defentry XVisibilityEvent-display (fixnum) ( fixnum "XVisibilityEvent_display" )) ++(defentry set-XVisibilityEvent-display (fixnum fixnum) ( void "set_XVisibilityEvent_display" )) ++(defentry XVisibilityEvent-send_event (fixnum) ( fixnum "XVisibilityEvent_send_event" )) ++(defentry set-XVisibilityEvent-send_event (fixnum fixnum) ( void "set_XVisibilityEvent_send_event" )) ++(defentry XVisibilityEvent-serial (fixnum) ( fixnum "XVisibilityEvent_serial" )) ++(defentry set-XVisibilityEvent-serial (fixnum fixnum) ( void "set_XVisibilityEvent_serial" )) ++(defentry XVisibilityEvent-type (fixnum) ( fixnum "XVisibilityEvent_type" )) ++(defentry set-XVisibilityEvent-type (fixnum fixnum) ( void "set_XVisibilityEvent_type" )) ++ ++ ++;;;;;; XCreateWindowEvent funcions ;;;;;; ++ ++(defentry make-XCreateWindowEvent () ( fixnum "make_XCreateWindowEvent" )) ++(defentry XCreateWindowEvent-override_redirect (fixnum) ( fixnum "XCreateWindowEvent_override_redirect" )) ++(defentry set-XCreateWindowEvent-override_redirect (fixnum fixnum) ( void "set_XCreateWindowEvent_override_redirect" )) ++(defentry XCreateWindowEvent-border_width (fixnum) ( fixnum "XCreateWindowEvent_border_width" )) ++(defentry set-XCreateWindowEvent-border_width (fixnum fixnum) ( void "set_XCreateWindowEvent_border_width" )) ++(defentry XCreateWindowEvent-height (fixnum) ( fixnum "XCreateWindowEvent_height" )) ++(defentry set-XCreateWindowEvent-height (fixnum fixnum) ( void "set_XCreateWindowEvent_height" )) ++(defentry XCreateWindowEvent-width (fixnum) ( fixnum "XCreateWindowEvent_width" )) ++(defentry set-XCreateWindowEvent-width (fixnum fixnum) ( void "set_XCreateWindowEvent_width" )) ++(defentry XCreateWindowEvent-y (fixnum) ( fixnum "XCreateWindowEvent_y" )) ++(defentry set-XCreateWindowEvent-y (fixnum fixnum) ( void "set_XCreateWindowEvent_y" )) ++(defentry XCreateWindowEvent-x (fixnum) ( fixnum "XCreateWindowEvent_x" )) ++(defentry set-XCreateWindowEvent-x (fixnum fixnum) ( void "set_XCreateWindowEvent_x" )) ++(defentry XCreateWindowEvent-window (fixnum) ( fixnum "XCreateWindowEvent_window" )) ++(defentry set-XCreateWindowEvent-window (fixnum fixnum) ( void "set_XCreateWindowEvent_window" )) ++(defentry XCreateWindowEvent-parent (fixnum) ( fixnum "XCreateWindowEvent_parent" )) ++(defentry set-XCreateWindowEvent-parent (fixnum fixnum) ( void "set_XCreateWindowEvent_parent" )) ++(defentry XCreateWindowEvent-display (fixnum) ( fixnum "XCreateWindowEvent_display" )) ++(defentry set-XCreateWindowEvent-display (fixnum fixnum) ( void "set_XCreateWindowEvent_display" )) ++(defentry XCreateWindowEvent-send_event (fixnum) ( fixnum "XCreateWindowEvent_send_event" )) ++(defentry set-XCreateWindowEvent-send_event (fixnum fixnum) ( void "set_XCreateWindowEvent_send_event" )) ++(defentry XCreateWindowEvent-serial (fixnum) ( fixnum "XCreateWindowEvent_serial" )) ++(defentry set-XCreateWindowEvent-serial (fixnum fixnum) ( void "set_XCreateWindowEvent_serial" )) ++(defentry XCreateWindowEvent-type (fixnum) ( fixnum "XCreateWindowEvent_type" )) ++(defentry set-XCreateWindowEvent-type (fixnum fixnum) ( void "set_XCreateWindowEvent_type" )) ++ ++ ++;;;;;; XDestroyWindowEvent funcions ;;;;;; ++ ++(defentry make-XDestroyWindowEvent () ( fixnum "make_XDestroyWindowEvent" )) ++(defentry XDestroyWindowEvent-window (fixnum) ( fixnum "XDestroyWindowEvent_window" )) ++(defentry set-XDestroyWindowEvent-window (fixnum fixnum) ( void "set_XDestroyWindowEvent_window" )) ++(defentry XDestroyWindowEvent-event (fixnum) ( fixnum "XDestroyWindowEvent_event" )) ++(defentry set-XDestroyWindowEvent-event (fixnum fixnum) ( void "set_XDestroyWindowEvent_event" )) ++(defentry XDestroyWindowEvent-display (fixnum) ( fixnum "XDestroyWindowEvent_display" )) ++(defentry set-XDestroyWindowEvent-display (fixnum fixnum) ( void "set_XDestroyWindowEvent_display" )) ++(defentry XDestroyWindowEvent-send_event (fixnum) ( fixnum "XDestroyWindowEvent_send_event" )) ++(defentry set-XDestroyWindowEvent-send_event (fixnum fixnum) ( void "set_XDestroyWindowEvent_send_event" )) ++(defentry XDestroyWindowEvent-serial (fixnum) ( fixnum "XDestroyWindowEvent_serial" )) ++(defentry set-XDestroyWindowEvent-serial (fixnum fixnum) ( void "set_XDestroyWindowEvent_serial" )) ++(defentry XDestroyWindowEvent-type (fixnum) ( fixnum "XDestroyWindowEvent_type" )) ++(defentry set-XDestroyWindowEvent-type (fixnum fixnum) ( void "set_XDestroyWindowEvent_type" )) ++ ++ ++;;;;;; XUnmapEvent funcions ;;;;;; ++ ++(defentry make-XUnmapEvent () ( fixnum "make_XUnmapEvent" )) ++(defentry XUnmapEvent-from_configure (fixnum) ( fixnum "XUnmapEvent_from_configure" )) ++(defentry set-XUnmapEvent-from_configure (fixnum fixnum) ( void "set_XUnmapEvent_from_configure" )) ++(defentry XUnmapEvent-window (fixnum) ( fixnum "XUnmapEvent_window" )) ++(defentry set-XUnmapEvent-window (fixnum fixnum) ( void "set_XUnmapEvent_window" )) ++(defentry XUnmapEvent-event (fixnum) ( fixnum "XUnmapEvent_event" )) ++(defentry set-XUnmapEvent-event (fixnum fixnum) ( void "set_XUnmapEvent_event" )) ++(defentry XUnmapEvent-display (fixnum) ( fixnum "XUnmapEvent_display" )) ++(defentry set-XUnmapEvent-display (fixnum fixnum) ( void "set_XUnmapEvent_display" )) ++(defentry XUnmapEvent-send_event (fixnum) ( fixnum "XUnmapEvent_send_event" )) ++(defentry set-XUnmapEvent-send_event (fixnum fixnum) ( void "set_XUnmapEvent_send_event" )) ++(defentry XUnmapEvent-serial (fixnum) ( fixnum "XUnmapEvent_serial" )) ++(defentry set-XUnmapEvent-serial (fixnum fixnum) ( void "set_XUnmapEvent_serial" )) ++(defentry XUnmapEvent-type (fixnum) ( fixnum "XUnmapEvent_type" )) ++(defentry set-XUnmapEvent-type (fixnum fixnum) ( void "set_XUnmapEvent_type" )) ++ ++ ++;;;;;; XMapEvent funcions ;;;;;; ++ ++(defentry make-XMapEvent () ( fixnum "make_XMapEvent" )) ++(defentry XMapEvent-override_redirect (fixnum) ( fixnum "XMapEvent_override_redirect" )) ++(defentry set-XMapEvent-override_redirect (fixnum fixnum) ( void "set_XMapEvent_override_redirect" )) ++(defentry XMapEvent-window (fixnum) ( fixnum "XMapEvent_window" )) ++(defentry set-XMapEvent-window (fixnum fixnum) ( void "set_XMapEvent_window" )) ++(defentry XMapEvent-event (fixnum) ( fixnum "XMapEvent_event" )) ++(defentry set-XMapEvent-event (fixnum fixnum) ( void "set_XMapEvent_event" )) ++(defentry XMapEvent-display (fixnum) ( fixnum "XMapEvent_display" )) ++(defentry set-XMapEvent-display (fixnum fixnum) ( void "set_XMapEvent_display" )) ++(defentry XMapEvent-send_event (fixnum) ( fixnum "XMapEvent_send_event" )) ++(defentry set-XMapEvent-send_event (fixnum fixnum) ( void "set_XMapEvent_send_event" )) ++(defentry XMapEvent-serial (fixnum) ( fixnum "XMapEvent_serial" )) ++(defentry set-XMapEvent-serial (fixnum fixnum) ( void "set_XMapEvent_serial" )) ++(defentry XMapEvent-type (fixnum) ( fixnum "XMapEvent_type" )) ++(defentry set-XMapEvent-type (fixnum fixnum) ( void "set_XMapEvent_type" )) ++ ++ ++;;;;;; XMapRequestEvent funcions ;;;;;; ++ ++(defentry make-XMapRequestEvent () ( fixnum "make_XMapRequestEvent" )) ++(defentry XMapRequestEvent-window (fixnum) ( fixnum "XMapRequestEvent_window" )) ++(defentry set-XMapRequestEvent-window (fixnum fixnum) ( void "set_XMapRequestEvent_window" )) ++(defentry XMapRequestEvent-parent (fixnum) ( fixnum "XMapRequestEvent_parent" )) ++(defentry set-XMapRequestEvent-parent (fixnum fixnum) ( void "set_XMapRequestEvent_parent" )) ++(defentry XMapRequestEvent-display (fixnum) ( fixnum "XMapRequestEvent_display" )) ++(defentry set-XMapRequestEvent-display (fixnum fixnum) ( void "set_XMapRequestEvent_display" )) ++(defentry XMapRequestEvent-send_event (fixnum) ( fixnum "XMapRequestEvent_send_event" )) ++(defentry set-XMapRequestEvent-send_event (fixnum fixnum) ( void "set_XMapRequestEvent_send_event" )) ++(defentry XMapRequestEvent-serial (fixnum) ( fixnum "XMapRequestEvent_serial" )) ++(defentry set-XMapRequestEvent-serial (fixnum fixnum) ( void "set_XMapRequestEvent_serial" )) ++(defentry XMapRequestEvent-type (fixnum) ( fixnum "XMapRequestEvent_type" )) ++(defentry set-XMapRequestEvent-type (fixnum fixnum) ( void "set_XMapRequestEvent_type" )) ++ ++ ++;;;;;; XReparentEvent funcions ;;;;;; ++ ++(defentry make-XReparentEvent () ( fixnum "make_XReparentEvent" )) ++(defentry XReparentEvent-override_redirect (fixnum) ( fixnum "XReparentEvent_override_redirect" )) ++(defentry set-XReparentEvent-override_redirect (fixnum fixnum) ( void "set_XReparentEvent_override_redirect" )) ++(defentry XReparentEvent-y (fixnum) ( fixnum "XReparentEvent_y" )) ++(defentry set-XReparentEvent-y (fixnum fixnum) ( void "set_XReparentEvent_y" )) ++(defentry XReparentEvent-x (fixnum) ( fixnum "XReparentEvent_x" )) ++(defentry set-XReparentEvent-x (fixnum fixnum) ( void "set_XReparentEvent_x" )) ++(defentry XReparentEvent-parent (fixnum) ( fixnum "XReparentEvent_parent" )) ++(defentry set-XReparentEvent-parent (fixnum fixnum) ( void "set_XReparentEvent_parent" )) ++(defentry XReparentEvent-window (fixnum) ( fixnum "XReparentEvent_window" )) ++(defentry set-XReparentEvent-window (fixnum fixnum) ( void "set_XReparentEvent_window" )) ++(defentry XReparentEvent-event (fixnum) ( fixnum "XReparentEvent_event" )) ++(defentry set-XReparentEvent-event (fixnum fixnum) ( void "set_XReparentEvent_event" )) ++(defentry XReparentEvent-display (fixnum) ( fixnum "XReparentEvent_display" )) ++(defentry set-XReparentEvent-display (fixnum fixnum) ( void "set_XReparentEvent_display" )) ++(defentry XReparentEvent-send_event (fixnum) ( fixnum "XReparentEvent_send_event" )) ++(defentry set-XReparentEvent-send_event (fixnum fixnum) ( void "set_XReparentEvent_send_event" )) ++(defentry XReparentEvent-serial (fixnum) ( fixnum "XReparentEvent_serial" )) ++(defentry set-XReparentEvent-serial (fixnum fixnum) ( void "set_XReparentEvent_serial" )) ++(defentry XReparentEvent-type (fixnum) ( fixnum "XReparentEvent_type" )) ++(defentry set-XReparentEvent-type (fixnum fixnum) ( void "set_XReparentEvent_type" )) ++ ++ ++;;;;;; XConfigureEvent funcions ;;;;;; ++ ++(defentry make-XConfigureEvent () ( fixnum "make_XConfigureEvent" )) ++(defentry XConfigureEvent-override_redirect (fixnum) ( fixnum "XConfigureEvent_override_redirect" )) ++(defentry set-XConfigureEvent-override_redirect (fixnum fixnum) ( void "set_XConfigureEvent_override_redirect" )) ++(defentry XConfigureEvent-above (fixnum) ( fixnum "XConfigureEvent_above" )) ++(defentry set-XConfigureEvent-above (fixnum fixnum) ( void "set_XConfigureEvent_above" )) ++(defentry XConfigureEvent-border_width (fixnum) ( fixnum "XConfigureEvent_border_width" )) ++(defentry set-XConfigureEvent-border_width (fixnum fixnum) ( void "set_XConfigureEvent_border_width" )) ++(defentry XConfigureEvent-height (fixnum) ( fixnum "XConfigureEvent_height" )) ++(defentry set-XConfigureEvent-height (fixnum fixnum) ( void "set_XConfigureEvent_height" )) ++(defentry XConfigureEvent-width (fixnum) ( fixnum "XConfigureEvent_width" )) ++(defentry set-XConfigureEvent-width (fixnum fixnum) ( void "set_XConfigureEvent_width" )) ++(defentry XConfigureEvent-y (fixnum) ( fixnum "XConfigureEvent_y" )) ++(defentry set-XConfigureEvent-y (fixnum fixnum) ( void "set_XConfigureEvent_y" )) ++(defentry XConfigureEvent-x (fixnum) ( fixnum "XConfigureEvent_x" )) ++(defentry set-XConfigureEvent-x (fixnum fixnum) ( void "set_XConfigureEvent_x" )) ++(defentry XConfigureEvent-window (fixnum) ( fixnum "XConfigureEvent_window" )) ++(defentry set-XConfigureEvent-window (fixnum fixnum) ( void "set_XConfigureEvent_window" )) ++(defentry XConfigureEvent-event (fixnum) ( fixnum "XConfigureEvent_event" )) ++(defentry set-XConfigureEvent-event (fixnum fixnum) ( void "set_XConfigureEvent_event" )) ++(defentry XConfigureEvent-display (fixnum) ( fixnum "XConfigureEvent_display" )) ++(defentry set-XConfigureEvent-display (fixnum fixnum) ( void "set_XConfigureEvent_display" )) ++(defentry XConfigureEvent-send_event (fixnum) ( fixnum "XConfigureEvent_send_event" )) ++(defentry set-XConfigureEvent-send_event (fixnum fixnum) ( void "set_XConfigureEvent_send_event" )) ++(defentry XConfigureEvent-serial (fixnum) ( fixnum "XConfigureEvent_serial" )) ++(defentry set-XConfigureEvent-serial (fixnum fixnum) ( void "set_XConfigureEvent_serial" )) ++(defentry XConfigureEvent-type (fixnum) ( fixnum "XConfigureEvent_type" )) ++(defentry set-XConfigureEvent-type (fixnum fixnum) ( void "set_XConfigureEvent_type" )) ++ ++ ++;;;;;; XGravityEvent funcions ;;;;;; ++ ++(defentry make-XGravityEvent () ( fixnum "make_XGravityEvent" )) ++(defentry XGravityEvent-y (fixnum) ( fixnum "XGravityEvent_y" )) ++(defentry set-XGravityEvent-y (fixnum fixnum) ( void "set_XGravityEvent_y" )) ++(defentry XGravityEvent-x (fixnum) ( fixnum "XGravityEvent_x" )) ++(defentry set-XGravityEvent-x (fixnum fixnum) ( void "set_XGravityEvent_x" )) ++(defentry XGravityEvent-window (fixnum) ( fixnum "XGravityEvent_window" )) ++(defentry set-XGravityEvent-window (fixnum fixnum) ( void "set_XGravityEvent_window" )) ++(defentry XGravityEvent-event (fixnum) ( fixnum "XGravityEvent_event" )) ++(defentry set-XGravityEvent-event (fixnum fixnum) ( void "set_XGravityEvent_event" )) ++(defentry XGravityEvent-display (fixnum) ( fixnum "XGravityEvent_display" )) ++(defentry set-XGravityEvent-display (fixnum fixnum) ( void "set_XGravityEvent_display" )) ++(defentry XGravityEvent-send_event (fixnum) ( fixnum "XGravityEvent_send_event" )) ++(defentry set-XGravityEvent-send_event (fixnum fixnum) ( void "set_XGravityEvent_send_event" )) ++(defentry XGravityEvent-serial (fixnum) ( fixnum "XGravityEvent_serial" )) ++(defentry set-XGravityEvent-serial (fixnum fixnum) ( void "set_XGravityEvent_serial" )) ++(defentry XGravityEvent-type (fixnum) ( fixnum "XGravityEvent_type" )) ++(defentry set-XGravityEvent-type (fixnum fixnum) ( void "set_XGravityEvent_type" )) ++ ++ ++;;;;;; XResizeRequestEvent funcions ;;;;;; ++ ++(defentry make-XResizeRequestEvent () ( fixnum "make_XResizeRequestEvent" )) ++(defentry XResizeRequestEvent-height (fixnum) ( fixnum "XResizeRequestEvent_height" )) ++(defentry set-XResizeRequestEvent-height (fixnum fixnum) ( void "set_XResizeRequestEvent_height" )) ++(defentry XResizeRequestEvent-width (fixnum) ( fixnum "XResizeRequestEvent_width" )) ++(defentry set-XResizeRequestEvent-width (fixnum fixnum) ( void "set_XResizeRequestEvent_width" )) ++(defentry XResizeRequestEvent-window (fixnum) ( fixnum "XResizeRequestEvent_window" )) ++(defentry set-XResizeRequestEvent-window (fixnum fixnum) ( void "set_XResizeRequestEvent_window" )) ++(defentry XResizeRequestEvent-display (fixnum) ( fixnum "XResizeRequestEvent_display" )) ++(defentry set-XResizeRequestEvent-display (fixnum fixnum) ( void "set_XResizeRequestEvent_display" )) ++(defentry XResizeRequestEvent-send_event (fixnum) ( fixnum "XResizeRequestEvent_send_event" )) ++(defentry set-XResizeRequestEvent-send_event (fixnum fixnum) ( void "set_XResizeRequestEvent_send_event" )) ++(defentry XResizeRequestEvent-serial (fixnum) ( fixnum "XResizeRequestEvent_serial" )) ++(defentry set-XResizeRequestEvent-serial (fixnum fixnum) ( void "set_XResizeRequestEvent_serial" )) ++(defentry XResizeRequestEvent-type (fixnum) ( fixnum "XResizeRequestEvent_type" )) ++(defentry set-XResizeRequestEvent-type (fixnum fixnum) ( void "set_XResizeRequestEvent_type" )) ++ ++ ++;;;;;; XConfigureRequestEvent funcions ;;;;;; ++ ++(defentry make-XConfigureRequestEvent () ( fixnum "make_XConfigureRequestEvent" )) ++(defentry XConfigureRequestEvent-value_mask (fixnum) ( fixnum "XConfigureRequestEvent_value_mask" )) ++(defentry set-XConfigureRequestEvent-value_mask (fixnum fixnum) ( void "set_XConfigureRequestEvent_value_mask" )) ++(defentry XConfigureRequestEvent-detail (fixnum) ( fixnum "XConfigureRequestEvent_detail" )) ++(defentry set-XConfigureRequestEvent-detail (fixnum fixnum) ( void "set_XConfigureRequestEvent_detail" )) ++(defentry XConfigureRequestEvent-above (fixnum) ( fixnum "XConfigureRequestEvent_above" )) ++(defentry set-XConfigureRequestEvent-above (fixnum fixnum) ( void "set_XConfigureRequestEvent_above" )) ++(defentry XConfigureRequestEvent-border_width (fixnum) ( fixnum "XConfigureRequestEvent_border_width" )) ++(defentry set-XConfigureRequestEvent-border_width (fixnum fixnum) ( void "set_XConfigureRequestEvent_border_width" )) ++(defentry XConfigureRequestEvent-height (fixnum) ( fixnum "XConfigureRequestEvent_height" )) ++(defentry set-XConfigureRequestEvent-height (fixnum fixnum) ( void "set_XConfigureRequestEvent_height" )) ++(defentry XConfigureRequestEvent-width (fixnum) ( fixnum "XConfigureRequestEvent_width" )) ++(defentry set-XConfigureRequestEvent-width (fixnum fixnum) ( void "set_XConfigureRequestEvent_width" )) ++(defentry XConfigureRequestEvent-y (fixnum) ( fixnum "XConfigureRequestEvent_y" )) ++(defentry set-XConfigureRequestEvent-y (fixnum fixnum) ( void "set_XConfigureRequestEvent_y" )) ++(defentry XConfigureRequestEvent-x (fixnum) ( fixnum "XConfigureRequestEvent_x" )) ++(defentry set-XConfigureRequestEvent-x (fixnum fixnum) ( void "set_XConfigureRequestEvent_x" )) ++(defentry XConfigureRequestEvent-window (fixnum) ( fixnum "XConfigureRequestEvent_window" )) ++(defentry set-XConfigureRequestEvent-window (fixnum fixnum) ( void "set_XConfigureRequestEvent_window" )) ++(defentry XConfigureRequestEvent-parent (fixnum) ( fixnum "XConfigureRequestEvent_parent" )) ++(defentry set-XConfigureRequestEvent-parent (fixnum fixnum) ( void "set_XConfigureRequestEvent_parent" )) ++(defentry XConfigureRequestEvent-display (fixnum) ( fixnum "XConfigureRequestEvent_display" )) ++(defentry set-XConfigureRequestEvent-display (fixnum fixnum) ( void "set_XConfigureRequestEvent_display" )) ++(defentry XConfigureRequestEvent-send_event (fixnum) ( fixnum "XConfigureRequestEvent_send_event" )) ++(defentry set-XConfigureRequestEvent-send_event (fixnum fixnum) ( void "set_XConfigureRequestEvent_send_event" )) ++(defentry XConfigureRequestEvent-serial (fixnum) ( fixnum "XConfigureRequestEvent_serial" )) ++(defentry set-XConfigureRequestEvent-serial (fixnum fixnum) ( void "set_XConfigureRequestEvent_serial" )) ++(defentry XConfigureRequestEvent-type (fixnum) ( fixnum "XConfigureRequestEvent_type" )) ++(defentry set-XConfigureRequestEvent-type (fixnum fixnum) ( void "set_XConfigureRequestEvent_type" )) ++ ++ ++;;;;;; XCirculateEvent funcions ;;;;;; ++ ++(defentry make-XCirculateEvent () ( fixnum "make_XCirculateEvent" )) ++(defentry XCirculateEvent-place (fixnum) ( fixnum "XCirculateEvent_place" )) ++(defentry set-XCirculateEvent-place (fixnum fixnum) ( void "set_XCirculateEvent_place" )) ++(defentry XCirculateEvent-window (fixnum) ( fixnum "XCirculateEvent_window" )) ++(defentry set-XCirculateEvent-window (fixnum fixnum) ( void "set_XCirculateEvent_window" )) ++(defentry XCirculateEvent-event (fixnum) ( fixnum "XCirculateEvent_event" )) ++(defentry set-XCirculateEvent-event (fixnum fixnum) ( void "set_XCirculateEvent_event" )) ++(defentry XCirculateEvent-display (fixnum) ( fixnum "XCirculateEvent_display" )) ++(defentry set-XCirculateEvent-display (fixnum fixnum) ( void "set_XCirculateEvent_display" )) ++(defentry XCirculateEvent-send_event (fixnum) ( fixnum "XCirculateEvent_send_event" )) ++(defentry set-XCirculateEvent-send_event (fixnum fixnum) ( void "set_XCirculateEvent_send_event" )) ++(defentry XCirculateEvent-serial (fixnum) ( fixnum "XCirculateEvent_serial" )) ++(defentry set-XCirculateEvent-serial (fixnum fixnum) ( void "set_XCirculateEvent_serial" )) ++(defentry XCirculateEvent-type (fixnum) ( fixnum "XCirculateEvent_type" )) ++(defentry set-XCirculateEvent-type (fixnum fixnum) ( void "set_XCirculateEvent_type" )) ++ ++ ++;;;;;; XCirculateRequestEvent funcions ;;;;;; ++ ++(defentry make-XCirculateRequestEvent () ( fixnum "make_XCirculateRequestEvent" )) ++(defentry XCirculateRequestEvent-place (fixnum) ( fixnum "XCirculateRequestEvent_place" )) ++(defentry set-XCirculateRequestEvent-place (fixnum fixnum) ( void "set_XCirculateRequestEvent_place" )) ++(defentry XCirculateRequestEvent-window (fixnum) ( fixnum "XCirculateRequestEvent_window" )) ++(defentry set-XCirculateRequestEvent-window (fixnum fixnum) ( void "set_XCirculateRequestEvent_window" )) ++(defentry XCirculateRequestEvent-parent (fixnum) ( fixnum "XCirculateRequestEvent_parent" )) ++(defentry set-XCirculateRequestEvent-parent (fixnum fixnum) ( void "set_XCirculateRequestEvent_parent" )) ++(defentry XCirculateRequestEvent-display (fixnum) ( fixnum "XCirculateRequestEvent_display" )) ++(defentry set-XCirculateRequestEvent-display (fixnum fixnum) ( void "set_XCirculateRequestEvent_display" )) ++(defentry XCirculateRequestEvent-send_event (fixnum) ( fixnum "XCirculateRequestEvent_send_event" )) ++(defentry set-XCirculateRequestEvent-send_event (fixnum fixnum) ( void "set_XCirculateRequestEvent_send_event" )) ++(defentry XCirculateRequestEvent-serial (fixnum) ( fixnum "XCirculateRequestEvent_serial" )) ++(defentry set-XCirculateRequestEvent-serial (fixnum fixnum) ( void "set_XCirculateRequestEvent_serial" )) ++(defentry XCirculateRequestEvent-type (fixnum) ( fixnum "XCirculateRequestEvent_type" )) ++(defentry set-XCirculateRequestEvent-type (fixnum fixnum) ( void "set_XCirculateRequestEvent_type" )) ++ ++ ++;;;;;; XPropertyEvent funcions ;;;;;; ++ ++(defentry make-XPropertyEvent () ( fixnum "make_XPropertyEvent" )) ++(defentry XPropertyEvent-state (fixnum) ( fixnum "XPropertyEvent_state" )) ++(defentry set-XPropertyEvent-state (fixnum fixnum) ( void "set_XPropertyEvent_state" )) ++(defentry XPropertyEvent-time (fixnum) ( fixnum "XPropertyEvent_time" )) ++(defentry set-XPropertyEvent-time (fixnum fixnum) ( void "set_XPropertyEvent_time" )) ++(defentry XPropertyEvent-atom (fixnum) ( fixnum "XPropertyEvent_atom" )) ++(defentry set-XPropertyEvent-atom (fixnum fixnum) ( void "set_XPropertyEvent_atom" )) ++(defentry XPropertyEvent-window (fixnum) ( fixnum "XPropertyEvent_window" )) ++(defentry set-XPropertyEvent-window (fixnum fixnum) ( void "set_XPropertyEvent_window" )) ++(defentry XPropertyEvent-display (fixnum) ( fixnum "XPropertyEvent_display" )) ++(defentry set-XPropertyEvent-display (fixnum fixnum) ( void "set_XPropertyEvent_display" )) ++(defentry XPropertyEvent-send_event (fixnum) ( fixnum "XPropertyEvent_send_event" )) ++(defentry set-XPropertyEvent-send_event (fixnum fixnum) ( void "set_XPropertyEvent_send_event" )) ++(defentry XPropertyEvent-serial (fixnum) ( fixnum "XPropertyEvent_serial" )) ++(defentry set-XPropertyEvent-serial (fixnum fixnum) ( void "set_XPropertyEvent_serial" )) ++(defentry XPropertyEvent-type (fixnum) ( fixnum "XPropertyEvent_type" )) ++(defentry set-XPropertyEvent-type (fixnum fixnum) ( void "set_XPropertyEvent_type" )) ++ ++ ++;;;;;; XSelectionClearEvent funcions ;;;;;; ++ ++(defentry make-XSelectionClearEvent () ( fixnum "make_XSelectionClearEvent" )) ++(defentry XSelectionClearEvent-time (fixnum) ( fixnum "XSelectionClearEvent_time" )) ++(defentry set-XSelectionClearEvent-time (fixnum fixnum) ( void "set_XSelectionClearEvent_time" )) ++(defentry XSelectionClearEvent-selection (fixnum) ( fixnum "XSelectionClearEvent_selection" )) ++(defentry set-XSelectionClearEvent-selection (fixnum fixnum) ( void "set_XSelectionClearEvent_selection" )) ++(defentry XSelectionClearEvent-window (fixnum) ( fixnum "XSelectionClearEvent_window" )) ++(defentry set-XSelectionClearEvent-window (fixnum fixnum) ( void "set_XSelectionClearEvent_window" )) ++(defentry XSelectionClearEvent-display (fixnum) ( fixnum "XSelectionClearEvent_display" )) ++(defentry set-XSelectionClearEvent-display (fixnum fixnum) ( void "set_XSelectionClearEvent_display" )) ++(defentry XSelectionClearEvent-send_event (fixnum) ( fixnum "XSelectionClearEvent_send_event" )) ++(defentry set-XSelectionClearEvent-send_event (fixnum fixnum) ( void "set_XSelectionClearEvent_send_event" )) ++(defentry XSelectionClearEvent-serial (fixnum) ( fixnum "XSelectionClearEvent_serial" )) ++(defentry set-XSelectionClearEvent-serial (fixnum fixnum) ( void "set_XSelectionClearEvent_serial" )) ++(defentry XSelectionClearEvent-type (fixnum) ( fixnum "XSelectionClearEvent_type" )) ++(defentry set-XSelectionClearEvent-type (fixnum fixnum) ( void "set_XSelectionClearEvent_type" )) ++ ++ ++;;;;;; XSelectionRequestEvent funcions ;;;;;; ++ ++(defentry make-XSelectionRequestEvent () ( fixnum "make_XSelectionRequestEvent" )) ++(defentry XSelectionRequestEvent-time (fixnum) ( fixnum "XSelectionRequestEvent_time" )) ++(defentry set-XSelectionRequestEvent-time (fixnum fixnum) ( void "set_XSelectionRequestEvent_time" )) ++(defentry XSelectionRequestEvent-property (fixnum) ( fixnum "XSelectionRequestEvent_property" )) ++(defentry set-XSelectionRequestEvent-property (fixnum fixnum) ( void "set_XSelectionRequestEvent_property" )) ++(defentry XSelectionRequestEvent-target (fixnum) ( fixnum "XSelectionRequestEvent_target" )) ++(defentry set-XSelectionRequestEvent-target (fixnum fixnum) ( void "set_XSelectionRequestEvent_target" )) ++(defentry XSelectionRequestEvent-selection (fixnum) ( fixnum "XSelectionRequestEvent_selection" )) ++(defentry set-XSelectionRequestEvent-selection (fixnum fixnum) ( void "set_XSelectionRequestEvent_selection" )) ++(defentry XSelectionRequestEvent-requestor (fixnum) ( fixnum "XSelectionRequestEvent_requestor" )) ++(defentry set-XSelectionRequestEvent-requestor (fixnum fixnum) ( void "set_XSelectionRequestEvent_requestor" )) ++(defentry XSelectionRequestEvent-owner (fixnum) ( fixnum "XSelectionRequestEvent_owner" )) ++(defentry set-XSelectionRequestEvent-owner (fixnum fixnum) ( void "set_XSelectionRequestEvent_owner" )) ++(defentry XSelectionRequestEvent-display (fixnum) ( fixnum "XSelectionRequestEvent_display" )) ++(defentry set-XSelectionRequestEvent-display (fixnum fixnum) ( void "set_XSelectionRequestEvent_display" )) ++(defentry XSelectionRequestEvent-send_event (fixnum) ( fixnum "XSelectionRequestEvent_send_event" )) ++(defentry set-XSelectionRequestEvent-send_event (fixnum fixnum) ( void "set_XSelectionRequestEvent_send_event" )) ++(defentry XSelectionRequestEvent-serial (fixnum) ( fixnum "XSelectionRequestEvent_serial" )) ++(defentry set-XSelectionRequestEvent-serial (fixnum fixnum) ( void "set_XSelectionRequestEvent_serial" )) ++(defentry XSelectionRequestEvent-type (fixnum) ( fixnum "XSelectionRequestEvent_type" )) ++(defentry set-XSelectionRequestEvent-type (fixnum fixnum) ( void "set_XSelectionRequestEvent_type" )) ++ ++ ++;;;;;; XSelectionEvent funcions ;;;;;; ++ ++(defentry make-XSelectionEvent () ( fixnum "make_XSelectionEvent" )) ++(defentry XSelectionEvent-time (fixnum) ( fixnum "XSelectionEvent_time" )) ++(defentry set-XSelectionEvent-time (fixnum fixnum) ( void "set_XSelectionEvent_time" )) ++(defentry XSelectionEvent-property (fixnum) ( fixnum "XSelectionEvent_property" )) ++(defentry set-XSelectionEvent-property (fixnum fixnum) ( void "set_XSelectionEvent_property" )) ++(defentry XSelectionEvent-target (fixnum) ( fixnum "XSelectionEvent_target" )) ++(defentry set-XSelectionEvent-target (fixnum fixnum) ( void "set_XSelectionEvent_target" )) ++(defentry XSelectionEvent-selection (fixnum) ( fixnum "XSelectionEvent_selection" )) ++(defentry set-XSelectionEvent-selection (fixnum fixnum) ( void "set_XSelectionEvent_selection" )) ++(defentry XSelectionEvent-requestor (fixnum) ( fixnum "XSelectionEvent_requestor" )) ++(defentry set-XSelectionEvent-requestor (fixnum fixnum) ( void "set_XSelectionEvent_requestor" )) ++(defentry XSelectionEvent-display (fixnum) ( fixnum "XSelectionEvent_display" )) ++(defentry set-XSelectionEvent-display (fixnum fixnum) ( void "set_XSelectionEvent_display" )) ++(defentry XSelectionEvent-send_event (fixnum) ( fixnum "XSelectionEvent_send_event" )) ++(defentry set-XSelectionEvent-send_event (fixnum fixnum) ( void "set_XSelectionEvent_send_event" )) ++(defentry XSelectionEvent-serial (fixnum) ( fixnum "XSelectionEvent_serial" )) ++(defentry set-XSelectionEvent-serial (fixnum fixnum) ( void "set_XSelectionEvent_serial" )) ++(defentry XSelectionEvent-type (fixnum) ( fixnum "XSelectionEvent_type" )) ++(defentry set-XSelectionEvent-type (fixnum fixnum) ( void "set_XSelectionEvent_type" )) ++ ++ ++;;;;;; XColormapEvent funcions ;;;;;; ++ ++(defentry make-XColormapEvent () ( fixnum "make_XColormapEvent" )) ++(defentry XColormapEvent-state (fixnum) ( fixnum "XColormapEvent_state" )) ++(defentry set-XColormapEvent-state (fixnum fixnum) ( void "set_XColormapEvent_state" )) ++(defentry XColormapEvent-new (fixnum) ( fixnum "XColormapEvent_new" )) ++(defentry set-XColormapEvent-new (fixnum fixnum) ( void "set_XColormapEvent_new" )) ++(defentry XColormapEvent-colormap (fixnum) ( fixnum "XColormapEvent_colormap" )) ++(defentry set-XColormapEvent-colormap (fixnum fixnum) ( void "set_XColormapEvent_colormap" )) ++(defentry XColormapEvent-window (fixnum) ( fixnum "XColormapEvent_window" )) ++(defentry set-XColormapEvent-window (fixnum fixnum) ( void "set_XColormapEvent_window" )) ++(defentry XColormapEvent-display (fixnum) ( fixnum "XColormapEvent_display" )) ++(defentry set-XColormapEvent-display (fixnum fixnum) ( void "set_XColormapEvent_display" )) ++(defentry XColormapEvent-send_event (fixnum) ( fixnum "XColormapEvent_send_event" )) ++(defentry set-XColormapEvent-send_event (fixnum fixnum) ( void "set_XColormapEvent_send_event" )) ++(defentry XColormapEvent-serial (fixnum) ( fixnum "XColormapEvent_serial" )) ++(defentry set-XColormapEvent-serial (fixnum fixnum) ( void "set_XColormapEvent_serial" )) ++(defentry XColormapEvent-type (fixnum) ( fixnum "XColormapEvent_type" )) ++(defentry set-XColormapEvent-type (fixnum fixnum) ( void "set_XColormapEvent_type" )) ++ ++ ++;;;;;; XClientMessageEvent funcions ;;;;;; ++ ++(defentry make-XClientMessageEvent () ( fixnum "make_XClientMessageEvent" )) ++(defentry XClientMessageEvent-format (fixnum) ( fixnum "XClientMessageEvent_format" )) ++(defentry set-XClientMessageEvent-format (fixnum fixnum) ( void "set_XClientMessageEvent_format" )) ++(defentry XClientMessageEvent-message_type (fixnum) ( fixnum "XClientMessageEvent_message_type" )) ++(defentry set-XClientMessageEvent-message_type (fixnum fixnum) ( void "set_XClientMessageEvent_message_type" )) ++(defentry XClientMessageEvent-window (fixnum) ( fixnum "XClientMessageEvent_window" )) ++(defentry set-XClientMessageEvent-window (fixnum fixnum) ( void "set_XClientMessageEvent_window" )) ++(defentry XClientMessageEvent-display (fixnum) ( fixnum "XClientMessageEvent_display" )) ++(defentry set-XClientMessageEvent-display (fixnum fixnum) ( void "set_XClientMessageEvent_display" )) ++(defentry XClientMessageEvent-send_event (fixnum) ( fixnum "XClientMessageEvent_send_event" )) ++(defentry set-XClientMessageEvent-send_event (fixnum fixnum) ( void "set_XClientMessageEvent_send_event" )) ++(defentry XClientMessageEvent-serial (fixnum) ( fixnum "XClientMessageEvent_serial" )) ++(defentry set-XClientMessageEvent-serial (fixnum fixnum) ( void "set_XClientMessageEvent_serial" )) ++(defentry XClientMessageEvent-type (fixnum) ( fixnum "XClientMessageEvent_type" )) ++(defentry set-XClientMessageEvent-type (fixnum fixnum) ( void "set_XClientMessageEvent_type" )) ++ ++ ++;;;;;; XMappingEvent funcions ;;;;;; ++ ++(defentry make-XMappingEvent () ( fixnum "make_XMappingEvent" )) ++(defentry XMappingEvent-count (fixnum) ( fixnum "XMappingEvent_count" )) ++(defentry set-XMappingEvent-count (fixnum fixnum) ( void "set_XMappingEvent_count" )) ++(defentry XMappingEvent-first_keycode (fixnum) ( fixnum "XMappingEvent_first_keycode" )) ++(defentry set-XMappingEvent-first_keycode (fixnum fixnum) ( void "set_XMappingEvent_first_keycode" )) ++(defentry XMappingEvent-request (fixnum) ( fixnum "XMappingEvent_request" )) ++(defentry set-XMappingEvent-request (fixnum fixnum) ( void "set_XMappingEvent_request" )) ++(defentry XMappingEvent-window (fixnum) ( fixnum "XMappingEvent_window" )) ++(defentry set-XMappingEvent-window (fixnum fixnum) ( void "set_XMappingEvent_window" )) ++(defentry XMappingEvent-display (fixnum) ( fixnum "XMappingEvent_display" )) ++(defentry set-XMappingEvent-display (fixnum fixnum) ( void "set_XMappingEvent_display" )) ++(defentry XMappingEvent-send_event (fixnum) ( fixnum "XMappingEvent_send_event" )) ++(defentry set-XMappingEvent-send_event (fixnum fixnum) ( void "set_XMappingEvent_send_event" )) ++(defentry XMappingEvent-serial (fixnum) ( fixnum "XMappingEvent_serial" )) ++(defentry set-XMappingEvent-serial (fixnum fixnum) ( void "set_XMappingEvent_serial" )) ++(defentry XMappingEvent-type (fixnum) ( fixnum "XMappingEvent_type" )) ++(defentry set-XMappingEvent-type (fixnum fixnum) ( void "set_XMappingEvent_type" )) ++ ++ ++;;;;;; XErrorEvent funcions ;;;;;; ++ ++(defentry make-XErrorEvent () ( fixnum "make_XErrorEvent" )) ++(defentry XErrorEvent-minor_code (fixnum) ( char "XErrorEvent_minor_code" )) ++(defentry set-XErrorEvent-minor_code (fixnum char) ( void "set_XErrorEvent_minor_code" )) ++(defentry XErrorEvent-request_code (fixnum) ( char "XErrorEvent_request_code" )) ++(defentry set-XErrorEvent-request_code (fixnum char) ( void "set_XErrorEvent_request_code" )) ++(defentry XErrorEvent-error_code (fixnum) ( char "XErrorEvent_error_code" )) ++(defentry set-XErrorEvent-error_code (fixnum char) ( void "set_XErrorEvent_error_code" )) ++(defentry XErrorEvent-serial (fixnum) ( fixnum "XErrorEvent_serial" )) ++(defentry set-XErrorEvent-serial (fixnum fixnum) ( void "set_XErrorEvent_serial" )) ++(defentry XErrorEvent-resourceid (fixnum) ( fixnum "XErrorEvent_resourceid" )) ++(defentry set-XErrorEvent-resourceid (fixnum fixnum) ( void "set_XErrorEvent_resourceid" )) ++(defentry XErrorEvent-display (fixnum) ( fixnum "XErrorEvent_display" )) ++(defentry set-XErrorEvent-display (fixnum fixnum) ( void "set_XErrorEvent_display" )) ++(defentry XErrorEvent-type (fixnum) ( fixnum "XErrorEvent_type" )) ++(defentry set-XErrorEvent-type (fixnum fixnum) ( void "set_XErrorEvent_type" )) ++ ++ ++;;;;;; XAnyEvent funcions ;;;;;; ++ ++(defentry make-XAnyEvent () ( fixnum "make_XAnyEvent" )) ++(defentry XAnyEvent-window (fixnum) ( fixnum "XAnyEvent_window" )) ++(defentry set-XAnyEvent-window (fixnum fixnum) ( void "set_XAnyEvent_window" )) ++(defentry XAnyEvent-display (fixnum) ( fixnum "XAnyEvent_display" )) ++(defentry set-XAnyEvent-display (fixnum fixnum) ( void "set_XAnyEvent_display" )) ++(defentry XAnyEvent-send_event (fixnum) ( fixnum "XAnyEvent_send_event" )) ++(defentry set-XAnyEvent-send_event (fixnum fixnum) ( void "set_XAnyEvent_send_event" )) ++(defentry XAnyEvent-serial (fixnum) ( fixnum "XAnyEvent_serial" )) ++(defentry set-XAnyEvent-serial (fixnum fixnum) ( void "set_XAnyEvent_serial" )) ++(defentry XAnyEvent-type (fixnum) ( fixnum "XAnyEvent_type" )) ++(defentry set-XAnyEvent-type (fixnum fixnum) ( void "set_XAnyEvent_type" )) ++ ++ ++;;;;;; XEvent funcions ;;;;;; ++ ++(defentry make-XEvent () ( fixnum "make_XEvent" )) ++;;(defentry XEvent-pad[24] (fixnum) ( fixnum "XEvent_pad[24]" )) ++;;(defentry set-XEvent-pad[24] (fixnum fixnum) ( void "set_XEvent_pad[24]" )) ++;;(defentry XEvent-xkeymap (fixnum) ( XKeymapEvent "XEvent_xkeymap" )) ++;;(defentry set-XEvent-xkeymap (fixnum XKeymapEvent) ( void "set_XEvent_xkeymap" )) ++;;(defentry XEvent-xerror (fixnum) ( XErrorEvent "XEvent_xerror" )) ++;;(defentry set-XEvent-xerror (fixnum XErrorEvent) ( void "set_XEvent_xerror" )) ++;;(defentry XEvent-xmapping (fixnum) ( XMappingEvent "XEvent_xmapping" )) ++;;(defentry set-XEvent-xmapping (fixnum XMappingEvent) ( void "set_XEvent_xmapping" )) ++;;(defentry XEvent-xclient (fixnum) ( XClientMessageEvent "XEvent_xclient" )) ++;;(defentry set-XEvent-xclient (fixnum XClientMessageEvent) ( void "set_XEvent_xclient" )) ++;;(defentry XEvent-xcolormap (fixnum) ( XColormapEvent "XEvent_xcolormap" )) ++;;(defentry set-XEvent-xcolormap (fixnum XColormapEvent) ( void "set_XEvent_xcolormap" )) ++;;(defentry XEvent-xselection (fixnum) ( XSelectionEvent "XEvent_xselection" )) ++;;(defentry set-XEvent-xselection (fixnum XSelectionEvent) ( void "set_XEvent_xselection" )) ++;;(defentry XEvent-xselectionrequest (fixnum) ( XSelectionRequestEvent "XEvent_xselectionrequest" )) ++;;(defentry set-XEvent-xselectionrequest (fixnum XSelectionRequestEvent) ( void "set_XEvent_xselectionrequest" )) ++;;(defentry XEvent-xselectionclear (fixnum) ( XSelectionClearEvent "XEvent_xselectionclear" )) ++;;(defentry set-XEvent-xselectionclear (fixnum XSelectionClearEvent) ( void "set_XEvent_xselectionclear" )) ++;;(defentry XEvent-xproperty (fixnum) ( XPropertyEvent "XEvent_xproperty" )) ++;;(defentry set-XEvent-xproperty (fixnum XPropertyEvent) ( void "set_XEvent_xproperty" )) ++;;(defentry XEvent-xcirculaterequest (fixnum) ( XCirculateRequestEvent "XEvent_xcirculaterequest" )) ++;;(defentry set-XEvent-xcirculaterequest (fixnum XCirculateRequestEvent) ( void "set_XEvent_xcirculaterequest" )) ++;;(defentry XEvent-xcirculate (fixnum) ( XCirculateEvent "XEvent_xcirculate" )) ++;;(defentry set-XEvent-xcirculate (fixnum XCirculateEvent) ( void "set_XEvent_xcirculate" )) ++;;(defentry XEvent-xconfigurerequest (fixnum) ( XConfigureRequestEvent "XEvent_xconfigurerequest" )) ++;;(defentry set-XEvent-xconfigurerequest (fixnum XConfigureRequestEvent) ( void "set_XEvent_xconfigurerequest" )) ++;;(defentry XEvent-xresizerequest (fixnum) ( XResizeRequestEvent "XEvent_xresizerequest" )) ++;;(defentry set-XEvent-xresizerequest (fixnum XResizeRequestEvent) ( void "set_XEvent_xresizerequest" )) ++;;(defentry XEvent-xgravity (fixnum) ( XGravityEvent "XEvent_xgravity" )) ++;;(defentry set-XEvent-xgravity (fixnum XGravityEvent) ( void "set_XEvent_xgravity" )) ++;;(defentry XEvent-xconfigure (fixnum) ( XConfigureEvent "XEvent_xconfigure" )) ++;;(defentry set-XEvent-xconfigure (fixnum XConfigureEvent) ( void "set_XEvent_xconfigure" )) ++;;(defentry XEvent-xreparent (fixnum) ( XReparentEvent "XEvent_xreparent" )) ++;;(defentry set-XEvent-xreparent (fixnum XReparentEvent) ( void "set_XEvent_xreparent" )) ++;;(defentry XEvent-xmaprequest (fixnum) ( XMapRequestEvent "XEvent_xmaprequest" )) ++;;(defentry set-XEvent-xmaprequest (fixnum XMapRequestEvent) ( void "set_XEvent_xmaprequest" )) ++;;(defentry XEvent-xmap (fixnum) ( XMapEvent "XEvent_xmap" )) ++;;(defentry set-XEvent-xmap (fixnum XMapEvent) ( void "set_XEvent_xmap" )) ++;;(defentry XEvent-xunmap (fixnum) ( XUnmapEvent "XEvent_xunmap" )) ++;;(defentry set-XEvent-xunmap (fixnum XUnmapEvent) ( void "set_XEvent_xunmap" )) ++;;(defentry XEvent-xdestroywindow (fixnum) ( XDestroyWindowEvent "XEvent_xdestroywindow" )) ++;;(defentry set-XEvent-xdestroywindow (fixnum XDestroyWindowEvent) ( void "set_XEvent_xdestroywindow" )) ++;;(defentry XEvent-xcreatewindow (fixnum) ( XCreateWindowEvent "XEvent_xcreatewindow" )) ++;;(defentry set-XEvent-xcreatewindow (fixnum XCreateWindowEvent) ( void "set_XEvent_xcreatewindow" )) ++;;(defentry XEvent-xvisibility (fixnum) ( XVisibilityEvent "XEvent_xvisibility" )) ++;;(defentry set-XEvent-xvisibility (fixnum XVisibilityEvent) ( void "set_XEvent_xvisibility" )) ++;;(defentry XEvent-xnoexpose (fixnum) ( XNoExposeEvent "XEvent_xnoexpose" )) ++;;(defentry set-XEvent-xnoexpose (fixnum XNoExposeEvent) ( void "set_XEvent_xnoexpose" )) ++;;(defentry XEvent-xgraphicsexpose (fixnum) ( XGraphicsExposeEvent "XEvent_xgraphicsexpose" )) ++;;(defentry set-XEvent-xgraphicsexpose (fixnum XGraphicsExposeEvent) ( void "set_XEvent_xgraphicsexpose" )) ++;;(defentry XEvent-xexpose (fixnum) ( XExposeEvent "XEvent_xexpose" )) ++;;(defentry set-XEvent-xexpose (fixnum XExposeEvent) ( void "set_XEvent_xexpose" )) ++;;(defentry XEvent-xfocus (fixnum) ( XFocusChangeEvent "XEvent_xfocus" )) ++;;(defentry set-XEvent-xfocus (fixnum XFocusChangeEvent) ( void "set_XEvent_xfocus" )) ++;;(defentry XEvent-xcrossing (fixnum) ( XCrossingEvent "XEvent_xcrossing" )) ++;;(defentry set-XEvent-xcrossing (fixnum XCrossingEvent) ( void "set_XEvent_xcrossing" )) ++;;(defentry XEvent-xmotion (fixnum) ( XMotionEvent "XEvent_xmotion" )) ++;;(defentry set-XEvent-xmotion (fixnum XMotionEvent) ( void "set_XEvent_xmotion" )) ++;;(defentry XEvent-xbutton (fixnum) ( XButtonEvent "XEvent_xbutton" )) ++;;(defentry set-XEvent-xbutton (fixnum XButtonEvent) ( void "set_XEvent_xbutton" )) ++;;(defentry XEvent-xkey (fixnum) ( XKeyEvent "XEvent_xkey" )) ++;;(defentry set-XEvent-xkey (fixnum XKeyEvent) ( void "set_XEvent_xkey" )) ++;;(defentry XEvent-xany (fixnum) ( XAnyEvent "XEvent_xany" )) ++;;(defentry set-XEvent-xany (fixnum XAnyEvent) ( void "set_XEvent_xany" )) ++;;(defentry XEvent-type (fixnum) ( fixnum "XEvent_type" )) ++;;(defentry set-XEvent-type (fixnum fixnum) ( void "set_XEvent_type" )) ++ ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_draw.lsp +@@ -0,0 +1,1089 @@ ++; draw.lsp Gordon S. Novak Jr. ; 06 Dec 07 ++ ++; Functions to make drawings interactively ++ ++; Copyright (c) 2007 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; 11 Nov 94; 05 Jan 95; 15 Jan 98; 09 Feb 99; 04 Dec 00; 28 Feb 02; 05 Jan 04 ++; 27 Jan 06 ++ ++; See the file gnu.license ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++ ++; Use (draw 'foo) to make a drawing named foo. ++; When finished with the drawing, give commands "Origin - to zero", "Program". ++; This will produce a program (DRAW-FOO w x y) to make the drawing. ++; The LaTex command will print Latex input to make the drawing ++; (but LaTex cannot draw things as well as the draw program). ++; (draw-output &optional names) will save things in a file for later. ++ ++; The small square in the drawing menu is a "button" for picture menus. ++; If buttons are used, a picmenu-spec will be produced with the program. ++ ++(defvar *draw-window* nil) ++(defvar *draw-window-width* 600) ++(defvar *draw-window-height* 600) ++(defvar *draw-leave-window* nil) ; t to leave window displayed at end ++(defvar *draw-menu-set* nil) ++(defvar *draw-zero-vector* '(0 0) ) ++(defvar *draw-latex-factor* 1) ; multiplier from pixels to LaTex ++(defvar *draw-snap-flag* t) ++(defvar *draw-objects* nil) ++(defvar *draw-latex-mode* nil) ++ ++(glispglobals (*draw-window* window) ) ++ ++(defmacro draw-descr (name) `(get ,name 'draw-descr)) ++ ++(glispobjects ++ ++(draw-desc (listobject (name symbol) ++ (objects (listof draw-object)) ++ (offset vector) ++ (size vector)) ++ prop ((fnname draw-desc-fnname) ++ (refpt draw-desc-refpt)) ++ msg ((draw draw-desc-draw) ++ (snap draw-desc-snap) ++ (find draw-desc-find) ++ (delete draw-desc-delete)) ) ++ ++(draw-object (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ default ((linewidth 1)) ++ prop ((region ((virtual region with start = offset size = size))) ++ (vregion ((virtual region with start = vstart size = vsize))) ++ (vstart ((virtual vector with ++ x = (min (x offset) ((x offset) + (x size))) - 2 ++ y = (min (y offset) ((y offset) + (y size))) - 2))) ++ (vsize ((virtual vector with x = (abs (x size)) + 4 ++ y = (abs (y size)) + 4))) ) ++ msg ((erase draw-object-erase) ++ (draw draw-object-draw) ++ (snap draw-object-snap) ++ (selectedp draw-object-selectedp) ++ (move draw-object-move)) ) ++ ++(draw-line (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ prop ((line ((virtual line-segment with p1 = offset ++ p2 = (offset + size))))) ++ msg ((draw draw-line-draw) ++ (snap draw-line-snap) ++ (selectedp draw-line-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-arrow (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ prop ((line ((virtual line-segment with p1 = offset ++ p2 = (offset + size))))) ++ msg ((draw draw-arrow-draw) ++ (snap draw-line-snap) ++ (selectedp draw-line-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-box (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-box-draw) ++ (snap draw-box-snap) ++ (selectedp draw-box-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-rcbox (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-rcbox-draw) ++ (snap draw-rcbox-snap) ++ (selectedp draw-rcbox-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-erase (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-erase-draw) ++ (snap draw-no-snap) ++ (selectedp draw-erase-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-circle (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ prop ((radius ((x size) / 2)) ++ (center (offset + size / 2))) ++ msg ((draw draw-circle-draw) ++ (snap draw-circle-snap) ++ (selectedp draw-circle-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-ellipse (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ prop ((radiusx ((x size) / 2)) ++ (radiusy ((y size) / 2)) ++ (radius ((max radiusx radiusy))) ++ (center (offset + size / 2)) ++ (delta ((sqrt (abs (radiusx ^ 2 - radiusy ^ 2))))) ++ (p1 ((if (radiusx > radiusy) ; 05 Jan 04 ++ (a vector x = (x center) - delta ++ y = (y center)) ++ (a vector x = (x center) ++ y = (y center) - delta)))) ++ (p2 ((if (radiusx > radiusy) ++ (a vector x = (x center) + delta ++ y = (y center)) ++ (a vector x = (x center) ++ y = (y center) + delta)))) ) ++ msg ((draw draw-ellipse-draw) ++ (snap draw-ellipse-snap) ++ (selectedp draw-ellipse-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-dot (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-dot-draw) ++ (snap draw-dot-snap) ++ (selectedp draw-button-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-button (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-button-draw) ++ (snap draw-dot-snap) ++ (selectedp draw-button-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-text (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-text-draw) ++ (snap draw-no-snap) ++ (selectedp draw-text-selectedp) ) ++ supers (draw-object) ) ++ ++; null object: no image, cannot be selected. ++(draw-null (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-null-draw) ++ (snap draw-no-snap) ++ (selectedp draw-null-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-refpt (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-refpt-draw) ++ (snap draw-refpt-snap) ++ (selectedp draw-refpt-selectedp) ) ++ supers (draw-object) ) ++ ++; multi-item drawing group ++(draw-multi (listobject (offset vector) ++ (size vector) ++ (contents (listof draw-object)) ++ (linewidth integer)) ++ msg ((draw draw-multi-draw) ++ (snap draw-no-snap) ++ (selectedp draw-multi-selectedp) ) ++ supers (draw-object) ) ++ ++ ++) ; glispobjects ++ ++; 05 Jan 04 ++; Get drawing description associated with name ++(gldefun draw-desc ((name symbol)) ++ (result draw-desc) ++ (let ((dd draw-desc)) ++ (dd = (draw-descr name)) ++ (if ~ dd (progn (dd = (a draw-desc with name = name)) ++ (setf (draw-descr name) dd))) ++ dd)) ++ ++; Make a window to draw in. ++(setf (glfnresulttype 'draw-window) 'window) ++(defun draw-window () ++ (or *draw-window* ++ (setq *draw-window* ++ (window-create *draw-window-width* *draw-window-height* ++ "Draw window"))) ) ++ ++; 09 Sep 92; 11 Sep 92; 14 Sep 92; 16 Sep 92; 21 Oct 92; 21 May 93; 17 Dec 93 ++; 05 Jan 04 ++(gldefun draw ((name symbol)) ++ (let (w dd done sel (redraw t) (new draw-object)) ++ (w = (draw-window)) ++ (open w) ++ (or *draw-menu-set* (draw-init-menus)) ++ (dd = (draw-desc name)) ++ (unless (member name *draw-objects*) ++ (setq *draw-objects* (nconc *draw-objects* (list name)))) ++ (draw dd w) ++ (while ~ done do ++ (sel = (menu-set-select *draw-menu-set* redraw)) ++ (redraw = nil) ++ (case (menu-name sel) ++ (command ++ (case (port sel) ++ (done (done = t)) ++ (move (draw-desc-move dd w)) ++ (delete (draw-desc-delete dd w)) ++ (copy (draw-desc-copy dd w)) ++ (redraw (clear w) ++ (setq redraw t) ++ (draw dd w)) ++ (origin (draw-desc-origin dd w) ++ (clear w) ++ (setq redraw t) ++ (draw dd w)) ++ (program (draw-desc-program dd)) ++ (latex (draw-desc-latex dd)) ++ (latexmode (setq *draw-latex-mode* (not *draw-latex-mode*)) ++ (format t "Latex Mode is now ~A~%" *draw-latex-mode*)) ++ )) ++ (draw ++ (new = nil) ++ (case (port sel) ++ (rectangle (new = (draw-box-get dd w))) ++ (rcbox (new = (draw-rcbox-get dd w))) ++ (circle (new = (draw-circle-get dd w))) ++ (ellipse (new = (draw-ellipse-get dd w))) ++ (line (new = (draw-line-get dd w))) ++ (arrow (new = (draw-arrow-get dd w))) ++ (dot (new = (draw-dot-get dd w))) ++ (erase (new = (draw-erase-get dd w))) ++ (button (new = (draw-button-get dd w))) ++ (text (new = (draw-text-get dd w))) ++ (refpt (new = (draw-refpt-get dd w)))) ++ (if new ++ (progn ((offset new) _- (offset dd)) ++ ((objects dd) _+ new) ++ (draw new w (offset dd))))) ++ (background nil)) ) ++ (setf (draw-descr name) dd) ++ (unless *draw-leave-window* (close w)) ++ name )) ++ ++; 06 Dec 07 ++; Copy a draw description to another name ++(defun copy-draw-desc (from to) ++ (let (old) ++ (setq old (copy-tree (get from 'draw-descr))) ++ (setf (get to 'draw-descr) ++ (cons (car old) (cons to (cddr old))) ) )) ++ ++; 09 Sep 92 ++(gldefun draw-desc-draw ((dd draw-desc) (w window)) ++ (let ( (off (offset dd)) ) ++ (clear w) ++ (for obj in (objects dd) (draw obj w off)) ++ (force-output w) )) ++ ++; 11 Sep 92; 12 Sep 92; 06 Oct 92; 05 Jan 04 ++; Find a draw-object such that point p selects it ++(gldefun draw-desc-selected ((dd draw-desc) (p vector)) ++ (result draw-object) ++ (let (objs objsb obj) ++ (objs = (for obj in objects when (selectedp obj p (offset dd)) ++ collect obj)) ++ (if objs ++ (if (null (rest objs)) ++ (obj = (first objs)) ++ (progn (objsb = (for z in objs ++ when (member (first z) ++ '(draw-button draw-dot)) ++ collect z)) ++ (if (and objsb (null (rest objsb))) ++ (obj = (first objsb)))) ) ) ++ obj)) ++ ++; 11 Sep 92; 12 Sep 92; 13 Sep 92; 05 Jan 04 ++; Find a draw-object such that point p selects it ++(gldefun draw-desc-find ((dd draw-desc) (w window) &optional (crossflg boolean)) ++ (result draw-object) ++ (let (p obj) ++ (while ~ obj do ++ (p = (if crossflg (draw-get-cross dd w) ++ (draw-get-crosshairs dd w))) ++ (obj = (draw-desc-selected dd p)) ) ++ obj)) ++ ++; 15 Sep 92 ++(gldefun draw-get-cross ((dd draw-desc) (w window)) ++ (result vector) ++ (draw-desc-snap dd (window-get-cross w))) ++ ++; 15 Sep 92 ++(gldefun draw-get-crosshairs ((dd draw-desc) (w window)) ++ (result vector) ++ (draw-desc-snap dd (window-get-crosshairs w))) ++ ++; 12 Sep 92; 14 Sep 92; 06 Oct 92 ++; Delete selected object ++(gldefun draw-desc-delete ((dd draw-desc) (w window)) ++ (let (obj) ++ (obj = (draw-desc-find dd w t)) ++ (erase obj w (offset dd)) ++ ((objects dd) _- obj) )) ++ ++; 12 Sep 92; 07 Oct 92 ++; Copy selected object ++(gldefun draw-desc-copy ((dd draw-desc) (w window)) ++ (let (obj (objb draw-object)) ++ (obj = (draw-desc-find dd w)) ++ (objb = (copy-tree obj)) ++ (draw-get-object-pos objb w) ++ ((offset objb) _- (offset dd)) ++ (draw objb w (offset dd)) ++ (force-output w) ++ ((objects dd) _+ objb) )) ++ ++; 12 Sep 92; 13 Sep 92; 07 Oct 92; 05 Jan 04 ++; Move selected object ++(gldefun draw-desc-move ((dd draw-desc) (w window)) ++ (let (obj) ++ (if (obj = (draw-desc-find dd w)) ++ (move obj w (offset dd))) )) ++ ++; 14 Sep 92; 28 Feb 02; 05 Jan 04; 27 Jan 06 ++; Reset origin of object group ++(gldefun draw-desc-origin ((dd draw-desc) (w window)) ++ (let (sel) ++ (draw-desc-bounds dd) ++ (sel = (menu '(("To zero" . tozero) ("Select" . select)))) ++ (if (sel == 'select) ++ ((offset dd) = (get-box-position w (x (size dd)) (y (size dd)))) ++ (if (sel == 'tozero) ((offset dd) = (a vector x 0 y 0)) ) ))) ++ ++; 14 Sep 92 ++; Compute boundaries of objects in a drawing; set offset and size of ++; the draw-desc and reset offsets of items relative to it. ++(gldefun draw-desc-bounds ((dd draw-desc)) ++ (let ((xmin 9999) (ymin 9999) (xmax 0) (ymax 0) basev) ++ (for obj in objects do ++ (xmin = (min xmin (x (offset obj)) ++ ((x (offset obj)) + (x (size obj))))) ++ (ymin = (min ymin (y (offset obj)) ++ ((y (offset obj)) + (y (size obj))))) ++ (xmax = (max xmax (x (offset obj)) ++ ((x (offset obj)) + (x (size obj))))) ++ (ymax = (max ymax (y (offset obj)) ++ ((y (offset obj)) + (y (size obj))))) ) ++ ((x (size dd)) = (xmax - xmin)) ++ ((y (size dd)) = (ymax - ymin)) ++ (basev = (a vector with x = xmin y = ymin)) ++ ((offset dd) = basev) ++ (for obj in objects do ((offset obj) _- basev)) )) ++ ++; 14 Sep 92; 16 Sep 92; 19 Dec 93; 15 Jan 98; 06 Dec 07 ++; Produce LaTex output for object group. ++; LaTex can only *approximately* reproduce the picture. ++(gldefun draw-desc-latex ((dd draw-desc)) ++ (let (base bx by sx sy) ++ (format t " \\begin{picture}(~5,0F,~5,0F)(0,0)~%" ++ (* (x (size dd)) *draw-latex-factor*) ++ (* (y (size dd)) *draw-latex-factor*) ) ++ (for obj in (objects dd) do ++ (base = (offset dd) + (offset obj)) ++ (bx = (x base) * *draw-latex-factor*) ++ (by = (y base) * *draw-latex-factor*) ++ (sx = (x (size obj)) * *draw-latex-factor*) ++ (sy = (y (size obj)) * *draw-latex-factor*) ++ (case (first obj) ++ (draw-line (latex-line (x base) (y base) ++ ((x base) + sx) ((y base) + sy))) ++ (draw-arrow (latex-line (x base) (y base) ++ ((x base) + sx) ((y base) + sy) t) ) ++ (draw-box ++ (format t " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" ++ bx by sx sy)) ++ (draw-rcbox ++ (format t " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" ++ (bx + sx / 2) (by + sy / 2) sx sy)) ++ (draw-circle ++ (format t " \\put(~5,0F,~5,0F) {\\circle{~5,0F}}~%" ++ (bx + sx / 2) (by + sy / 2) sx)) ++ (draw-ellipse ++ (format t " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" ++ (bx + sx / 2) (by + sy / 2) sx sy)) ++ (draw-button ++ (format t " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" ++ bx by sx sy)) ++ (draw-erase ) ++ (draw-dot ++ (format t " \\put(~5,0F,~5,0F) {\\circle*{~5,0F}}~%" ++ (bx + sx / 2) (by + sy / 2) sx)) ++ (draw-text ++ (format t " \\put(~5,0F,~5,0F) {~A}~%" ++ bx (by + 4 * *draw-latex-factor*) (contents obj)) ) ) ) ++ (format t " \\end{picture}~%") )) ++ ++; 14 Sep 92; 15 Sep 92; 16 Sep 92; 05 Oct 92; 17 Dec 93; 21 Dec 93; 28 Feb 02 ++; 05 Jan 04 ++; Produce program to draw object group ++(gldefun draw-desc-program ((dd draw-desc)) ++ (let (base bx by sx sy tox toy r rx ry s code fncode fnname cd) ++ (code = (for obj in (objects dd) when ++ (cd = (progn ++ (base = (offset dd) + (offset obj) - (refpt dd)) ++ (bx = (x base)) ++ (by = (y base)) ++ (sx = (x (size obj))) ++ (sy = (y (size obj))) ++ (tox = bx + sx) ++ (toy = by + sy) ++ (if ((car obj) == 'draw-circle) ++ (r = (x (size obj)) / 2)) ++ (if ((car obj) == 'draw-ellipse) ++ (progn (rx = (x (size obj)) / 2) ++ (ry = (y (size obj)) / 2))) ++ (draw-optimize ++ (case (first obj) ++ (draw-line `(window-draw-line-xy w (+ x ,bx) (+ y ,by) ++ (+ x ,tox) (+ y ,toy))) ++ (draw-arrow `(window-draw-arrow-xy w (+ x ,bx) (+ y ,by) ++ (+ x ,tox) (+ y ,toy))) ++ (draw-box `(window-draw-box-xy w (+ x ,bx) (+ y ,by) ++ ,sx ,sy)) ++ (draw-rcbox `(window-draw-rcbox-xy w (+ x ,bx) (+ y ,by) ++ ,sx ,sy 8)) ++ (draw-circle `(window-draw-circle-xy w (+ x ,(+ r bx)) ++ (+ y ,(+ r by)) ,r)) ++ (draw-ellipse `(window-draw-ellipse-xy w (+ x ,(+ rx bx)) ++ (+ y ,(+ ry by)) ++ ,rx ,ry)) ++ ((draw-button draw-refpt) ++ nil) ; let picmenu draw the buttons ++ (draw-erase `(window-erase-area-xy w (+ x ,bx) (+ y ,by) ++ ,sx ,sy)) ++ (draw-dot `(window-draw-dot-xy w (+ x ,(+ 2 bx)) ++ (+ y ,(+ 2 by)))) ++ (draw-text (s = (stringify (contents obj))) ++ `(window-printat-xy w ,s (+ x ,bx) (+ y ,by))) ++ )) )) ++ collect cd)) ++ (fncode = (cons 'lambda (cons (list 'w 'x 'y) ++ (nconc code ++ (list (list 'window-force-output ++ 'w)))))) ++ (fnname = (fnname dd)) ++ (setf (symbol-function fnname) fncode) ++ (format t "Constructed program (~A w x y)~%" fnname) ++ (draw-desc-picmenu dd) ++ )) ++ ++; 21 Dec 93 ++; Optimize code if GLISP is present ++(defun draw-optimize (x) (if (fboundp 'glunwrap) (glunwrap x nil) x)) ++ ++; 14 Sep 92 ++(gldefun draw-desc-fnname ((dd draw-desc)) ++ (intern (concatenate 'string "DRAW-" (symbol-name (name dd)))) ) ++ ++; 14 Sep 92; 06 Oct 92; 08 Apr 93; 28 Feb 02; 05 Jan 04 ++; Produce a picmenu-spec from the buttons of a drawing description ++(gldefun draw-desc-picmenu ((dd draw-desc)) ++ (let (buttons) ++ (buttons = (for obj in (objects dd) when ((first obj) == 'draw-button) ++ collect (list (contents obj) ++ ((a vector x 2 y 2) + (offset obj) ++ + (offset dd) )) ) ) ++ (if buttons ++ (setf (get (name dd) 'picmenu-spec) ++ (list 'picmenu-spec (x (size dd)) (y (size dd)) buttons ++ t (fnname dd) '9x15))) )) ++ ++; 15 Sep 92; 05 Jan 04 ++(gldefun draw-desc-snap ((dd draw-desc) (p vector)) ++ (result vector) ++ (let (psnap obj (objs (objects dd)) ) ++ (if *draw-snap-flag* ++ (while objs and ~ psnap do ++ (obj = (pop objs)) ++ (psnap = (draw-object-snap obj p (offset dd))) ) ) ++ (or psnap p) )) ++ ++; 10 Sep 92; 12 Sep 92 ++; Move specified object ++(gldefun draw-object-move ((d draw-object) (w window) (off vector)) ++ (let () ++ (erase d w off) ++ (draw-get-object-pos d w) ++ ((offset d) _- off) ++ (draw d w off) ++ (force-output w) )) ++ ++; 12 Sep 92; 13 Sep 92; 15 Sep 92 ++; Draw an object at specified (x y) by calling its drawing function ++(defun draw-object-draw-at (w x y d) ++ (setf (second d) (list x y)) ++ (draw-object-draw d w *draw-zero-vector*) ) ++ ++; 15 Sep 92 ++; Simulate glsend of draw message to an object ++(defun draw-object-draw (d w off) ++ (funcall (glmethod (car d) 'draw) d w off) ) ++ ++; 15 Sep 92 ++; Simulate glsend of snap message to an object ++(defun draw-object-snap (d p off) ++ (funcall (glmethod (car d) 'snap) d p off) ) ++ ++; 15 Sep 92 ++; Simulate glsend of selectedp message to an object ++(defun draw-object-selectedp (d w off) ++ (funcall (glmethod (car d) 'selectedp) d w off) ) ++ ++; 12 Sep 92; 07 Oct 92; 28 Feb 02; 05 Jan 04; 06 Dec 07 ++(gldefun draw-get-object-pos ((d draw-object) (w window)) ++ (window-get-icon-position w ++ (if ((first d) == 'draw-text) #'draw-text-draw-outline ++ #'draw-object-draw-at) ++ (list d)) ) ++ ++; 10 Sep 92; 15 Sep 92; 05 Jan 04 ++(gldefun draw-object-erase ((d draw-object) (w window) (off vector)) ++ (let () ++ (if ((first d) <> 'draw-erase) ++ (progn (set-xor w) ++ (draw d w off) ++ (unset w)) ))) ++ ++; 09 Sep 92; 17 Dec 93; 19 Dec 93; 04 Dec 00 ++(gldefun draw-line-draw ((d draw-line) (w window) (off vector)) ++ (let ((from (off + (offset d))) (to ((off + (offset d)) + (size d))) ) ++ (draw-line-xy w (x from) (y from) (x to) (y to)) )) ++ ++; 11 Sep 92; 17 Dec 93; 19 Dec 93; 04 Dec 00 ++(gldefun draw-arrow-draw ((d draw-arrow) (w window) (off vector)) ++ (let ((from (off + (offset d))) (to ((off + (offset d)) + (size d))) ) ++ (draw-arrow-xy w (x from) (y from) (x to) (y to)) )) ++ ++; 09 Sep 92; 10 Sep 92; 12 Sep 92 ++(gldefun draw-line-selectedp ((d draw-line) (pt vector) (off vector)) ++ (let ((ptp (pt - off))) ++ (and (contains? (vregion d) ptp) ++ ((distance (line d) ptp) < 5) ) )) ++ ++; 09 Sep 92; 10 Sep 92; 15 Sep 92; 17 Dec 93; 05 Jan 04 ++(gldefun draw-line-get ((dd draw-desc) (w window)) ++ (let (from to) ++ (from = (draw-get-crosshairs dd w)) ++ (to = (if *draw-latex-mode* ++ (window-get-latex-position w (x from) (y from) nil) ++ (draw-desc-snap dd ++ (window-get-line-position w (x from) (y from))))) ++ (a draw-line with offset = from size = (to - from)) )) ++ ++; 11 Sep 92; 15 Sep 92; 17 Dec 93; 05 Jan 04 ++(gldefun draw-arrow-get ((dd draw-desc) (w window)) ++ (let (from to) ++ (from = (draw-get-crosshairs dd w)) ++ (to = (if *draw-latex-mode* ++ (window-get-latex-position w (x from) (y from) nil) ++ (draw-desc-snap dd ++ (window-get-line-position w (x from) (y from))))) ++ (a draw-arrow with offset = from size = (to - from)) )) ++ ++; 09 Sep 92 ++(gldefun draw-box-draw ((d draw-box) (w window) (off vector)) ++ (draw-box w (off + (offset d)) (size d)) ) ++ ++; 09 Sep 92; 11 Sep 92 ++(gldefun draw-box-selectedp ((d draw-box) (p vector) (off vector)) ++ (let ((pt (p - off))) ++ (or (and ((y pt) < (top (vregion d)) + 5) ++ ((y pt) > (bottom (vregion d)) - 5) ++ (or ((abs (x pt) - (left (vregion d))) < 5) ++ ((abs (x pt) - (right (vregion d))) < 5))) ++ (and ((x pt) < (right (vregion d)) + 5) ++ ((x pt) > (left (vregion d)) - 5) ++ (or ((abs (y pt) - (top (vregion d))) < 5) ++ ((abs (y pt) - (bottom (vregion d))) < 5))) ) )) ++ ++; 11 Sep 92 ++(gldefun draw-box-get ((dd draw-desc) (w window)) ++ (let (box) ++ (box = (window-get-region w)) ++ (a draw-box with offset = (start box) size = (size box)) )) ++ ++; (dotimes (i 10) (print (draw-box-selectedp db (window-get-point dw)))) ++ ++; 16 Sep 92 ++(gldefun draw-rcbox-draw ((d draw-box) (w window) (off vector)) ++ (draw-rcbox-xy w ((x off) + (x (offset d))) ((y off) + (y (offset d))) ++ (x (size d)) (y (size d)) 8) ) ++ ++; 16 Sep 92 ++(gldefun draw-rcbox-selectedp ((d draw-box) (p vector) (off vector)) ++ (let ((pt (p - off))) ++ (or (and ((y pt) < (top (vregion d)) - 3) ++ ((y pt) > (bottom (vregion d)) + 3) ++ (or ((abs (x pt) - (left (vregion d))) < 5) ++ ((abs (x pt) - (right (vregion d))) < 5))) ++ (and ((x pt) < (right (vregion d)) - 3) ++ ((x pt) > (left (vregion d)) + 3) ++ (or ((abs (y pt) - (top (vregion d))) < 5) ++ ((abs (y pt) - (bottom (vregion d))) < 5))) ) )) ++ ++; 16 Sep 92 ++(gldefun draw-rcbox-get ((dd draw-desc) (w window)) ++ (let (box) ++ (box = (window-get-region w)) ++ (a draw-rcbox with offset = (start box) size = (size box)) )) ++ ++; 09 Sep 92 ++(gldefun draw-circle-draw ((d draw-circle) (w window) (off vector)) ++ (draw-circle w (off + (center d)) (radius d)) ) ++ ++; 09 Sep 92; 11 Sep 92; 17 Sep 92 ++(gldefun draw-circle-selectedp ((d draw-circle) (p vector) (off vector)) ++ ((abs (radius d) - (magnitude ((center d) + off) - p)) < 5) ) ++ ++; 11 Sep 92; 15 Sep 92 ++(gldefun draw-circle-get ((dd draw-desc) (w window)) ++ (let (cir cent) ++ (cent = (draw-get-crosshairs dd w)) ++ (cir = (window-get-circle w cent)) ++ (a draw-circle with ++ offset = (a vector with x = ( (x (center cir)) - (radius cir) ) ++ y = ( (y (center cir)) - (radius cir) )) ++ size = (a vector with x = 2 * (radius cir) y = 2 * (radius cir))) )) ++ ++; 11 Sep 92 ++(gldefun draw-ellipse-draw ((d draw-ellipse) (w window) (off vector)) ++ (let ((c (off + (center d)))) ++ (draw-ellipse-xy w (x c) (y c) (radiusx d) (radiusy d)) )) ++ ++; 11 Sep 92; 15 Sep 92; 17 Sep 92 ++; Uses the fact that sum of distances from foci is constant. ++(gldefun draw-ellipse-selectedp ((d draw-ellipse) (p vector) (off vector)) ++ (let ((pt (p - off))) ++ ( (abs ( (magnitude ((p1 d) - pt)) + (magnitude ((p2 d) - pt)) ) ++ - 2 * (radius d)) < 2) )) ++ ++; print out what the "boundary" of an ellipse looks like via selectedp ++(defun draw-test-ellipse-selectedp (e) ++ (let ( (size (third e)) (offset (second e)) ) ++ (dotimes (y (+ (cadr size) 10)) ++ (dotimes (x (+ (car size) 10)) ++ (princ (if (draw-ellipse-selectedp e ++ (list (+ x (car offset) -5) (+ y (cadr offset) -5)) ++ (list 0 0)) ++ "T" " "))) ++ (terpri)) )) ++ ++; 11 Sep 92 ++(gldefun draw-ellipse-get ((dd draw-desc) (w window)) ++ (let (ell cent) ++ (cent = (draw-get-crosshairs dd w)) ++ (ell = (window-get-ellipse w cent)) ++ (a draw-ellipse with ++ offset = (a vector with x = ( (x (center ell)) - (x (halfsize ell)) ) ++ y = ( (y (center ell)) - (y (halfsize ell)) )) ++ size = (a vector with x = 2 * (x (halfsize ell)) ++ y = 2 * (y (halfsize ell)))) )) ++ ++; 10 Sep 92 ++(gldefun draw-null-draw ((d draw-null) (w window) (off vector)) nil) ++ ++; 10 Sep 92; 11 Sep 92 ++(gldefun draw-null-selectedp ((d draw-null) (pt vector) (off vector)) nil) ++ ++; 11 Sep 92 ++(gldefun draw-button-draw ((d draw-button) (w window) (off vector)) ++ (draw-box w (off + (offset d)) (a vector x = 4 y = 4)) ) ++ ++; 11 Sep 92 ++(gldefun draw-button-selectedp ((d draw-button) (p vector) (off vector)) ++ (let ( (ptx (((x p) - (x off)) - (x (offset d)))) ++ (pty (((y p) - (y off)) - (y (offset d)))) ) ++ (and (ptx > -2) (ptx < 6) (pty > -2) (pty < 6) ) )) ++ )) ++ ++; 11 Sep 92 ++(gldefun draw-button-get ((dd draw-desc) (w window)) ++ (let (cent var) ++ (princ "Enter button name: ") ++ (var = (read)) ++ (cent = (draw-get-crosshairs dd w)) ++ (a draw-button with ++ offset = (a vector with x = ((x cent) - 2) y = ((y cent) - 2)) ++ size = (a vector with x = 4 y = 4) ++ contents = var) )) ++ ++; 14 Sep 92 ++(gldefun draw-erase-draw ((d draw-box) (w window) (off vector)) ++ (erase-area w (off + (offset d)) (size d)) ) ++ ++; 14 Sep 92 ++(gldefun draw-erase-selectedp ((d draw-box) (p vector) (off vector)) ++ (let ((pt (p - off))) ++ (contains? (region d) pt) )) ++ ++; 14 Sep 92 ++(gldefun draw-erase-get ((dd draw-desc) (w window)) ++ (let (box) ++ (box = (window-get-region w)) ++ (a draw-erase with offset = (start box) size = (size box)) )) ++ ++; 11 Sep 92; 14 Sep 92 ++(gldefun draw-dot-draw ((d draw-dot) (w window) (off vector)) ++ (window-draw-dot-xy w ((x off) + (x (offset d)) + 2) ++ ((y off) + (y (offset d)) + 2) ) ) ++ ++; 11 Sep 92; 15 Sep 92 ++(gldefun draw-dot-get ((dd draw-desc) (w window)) ++ (let (cent) ++ (cent = (draw-get-crosshairs dd w)) ++ (a draw-dot with ++ offset = (a vector with x = ((x cent) - 2) y = ((y cent) - 2)) ++ size = (a vector with x = 4 y = 4)) )) ++ ++; 17 Dec 93 ++(gldefun draw-refpt-draw ((d draw-refpt) (w window) (off vector)) ++ (window-draw-crosshairs-xy w ((x off) + (x (offset d))) ++ ((y off) + (y (offset d))) ) ) ++ ++; 17 Dec 93 ++(gldefun draw-refpt-selectedp ((d draw-button) (p vector) (off vector)) ++ (let ( (ptx (((x p) - (x off)) - (x (offset d)))) ++ (pty (((y p) - (y off)) - (y (offset d)))) ) ++ (and (ptx > -3) (ptx < 3) (pty > -3) (pty < 3) ) )) ++ ++; 17 Dec 93; 05 Jan 04 ++(gldefun draw-refpt-get ((dd draw-desc) (w window)) ++ (let (cent refpt) ++ (if (refpt = (assoc 'draw-refpt (objects dd))) ++ (progn (set-erase *draw-window*) ++ (draw refpt *draw-window* (a vector with x = 0 y = 0)) ++ (unset *draw-window*) ++ ((objects dd) _- refpt) ) ) ++ (cent = (draw-get-crosshairs dd w)) ++ (a draw-refpt with offset = cent ++ size = (a vector with x = 0 y = 0)) )) ++ ++; 17 Dec 93; 05 Jan 04 ++(gldefun draw-desc-refpt ((dd draw-desc)) (result vector) ++ (let (refpt) ++ (refpt = (assoc 'draw-refpt (objects dd))) ++ (if refpt (offset refpt) ++ (a vector x = 0 y = 0)) )) ++ ++; 11 Sep 92; 06 Oct 92; 19 Dec 93; 11 Nov 94 ++(gldefun draw-text-draw ((d draw-text) (w window) (off vector)) ++ (printat-xy w (contents d) ((x off) + (x (offset d))) ++ ((y off) + (y (offset d)))) ) ++ ++; 07 Oct 92 ++(gldefun draw-text-draw-outline ((w window) (x integer) (y integer) (d draw-text)) ++ (setf (second d) (list x y)) ++ (draw-box-xy w x (y + 2) (x (size d)) (y (size d))) ) ++ ++; define compiled version directly to avoid repeated recompilation ++(defun draw-text-draw-outline (W X Y D) ++ (SETF (SECOND D) (LIST X Y)) ++ (WINDOW-DRAW-BOX-XY W X (+ 2 Y) (CAADDR D) (CADR (CADDR D)))) ++ ++; 11 Sep 92 ++(gldefun draw-text-selectedp ((d draw-text) (pt vector) (off vector)) ++ (let ((ptp (pt - off))) ++ (contains? (vregion d) ptp))) ++ ++; 11 Sep 92; 17 Sep 92; 06 Oct 92; 11 Nov 94 ++(gldefun draw-text-get ((dd draw-desc) (w window)) ++ (let (txt lng off) ++ (princ "Enter text string: ") ++ (txt = (stringify (read))) ++ (lng = (string-width w txt)) ++ (off = (get-box-position w lng 14)) ++ (a draw-text with offset = (off + (a vector x 0 y 4)) ++ size = (a vector with x = lng y = 14) ++ contents = txt) )) ++ ++; 15 Sep 92; 05 Jan 04 ++; Test if a point p1 is close to a point p2. If so, result is p2, else nil. ++(gldefun draw-snapp ((p1 vector) (off vector) (p2x integer) (p2y integer)) ++ (if (and ((abs ((x p1) - (x off) - p2x)) < 4) ++ ((abs ((y p1) - (y off) - p2y)) < 4) ) ++ (a vector with x = ((x off) + p2x) y = ((y off) + p2y)) )) ++ ++; 15 Sep 92 ++(gldefun draw-dot-snap ((d draw-dot) (p vector) (off vector)) ++ (draw-snapp p off ((x (offset d)) + 2) ++ ((y (offset d)) + 2) ) ) ++ ++; 17 Dec 93 ++(gldefun draw-refpt-snap ((d draw-refpt) (p vector) (off vector)) ++ (draw-snapp p off (x (offset d)) (y (offset d)) ) ) ++ ++; 15 Sep 92 ++(gldefun draw-line-snap ((d draw-line) (p vector) (off vector)) ++ (or (draw-snapp p off (x (offset d)) (y (offset d))) ++ (draw-snapp p off ( (x (offset d)) + (x (size d)) ) ++ ( (y (offset d)) + (y (size d)) ) ) )) ++ ++; 15 Sep 92; 19 Dec 93 ++; Snap for square: corners, middle of sides. ++(gldefun draw-box-snap ((d draw-box) (p vector) (off vector)) ++ (let ((xoff (x (offset d))) (yoff (y (offset d))) ++ (xsize (x (size d)) ) (ysize (y (size d)) ) ) ++ (or (draw-snapp p off xoff yoff) ++ (draw-snapp p off (xoff + xsize) (yoff + ysize)) ++ (draw-snapp p off (xoff + xsize) yoff) ++ (draw-snapp p off xoff (yoff + ysize)) ++ (draw-snapp p off (xoff + xsize / 2) yoff) ++ (draw-snapp p off xoff (yoff + ysize / 2)) ++ (draw-snapp p off (xoff + xsize / 2) (yoff + ysize)) ++ (draw-snapp p off (xoff + xsize) (yoff + ysize / 2)) ) )) ++ ++; 15 Sep 92 ++(gldefun draw-circle-snap ((d draw-circle) (p vector) (off vector)) ++ (or (draw-snapp p off ( (x (offset d)) + (radius d) ) ++ ( (y (offset d)) + (radius d) ) ) ++ (draw-snapp p off ( (x (offset d)) + (radius d) ) ++ (y (offset d)) ) ++ (draw-snapp p off (x (offset d)) ++ ( (y (offset d)) + (radius d) ) ) ++ (draw-snapp p off ( (x (offset d)) + (radius d) ) ++ ( (y (offset d)) + (y (size d)) ) ) ++ (draw-snapp p off ( (x (offset d)) + (x (size d)) ) ++ ( (y (offset d)) + (radius d) ) ) )) ++ ++; 15 Sep 92 ++(gldefun draw-ellipse-snap ((d draw-ellipse) (p vector) (off vector)) ++ (or (draw-snapp p off ( (x (offset d)) + (radiusx d) ) ++ ( (y (offset d)) + (radiusy d) ) ) ++ (draw-snapp p off ( (x (offset d)) + (radiusx d) ) ++ (y (offset d)) ) ++ (draw-snapp p off (x (offset d)) ++ ( (y (offset d)) + (radiusy d) ) ) ++ (draw-snapp p off ( (x (offset d)) + (radiusx d) ) ++ ( (y (offset d)) + (y (size d)) ) ) ++ (draw-snapp p off ( (x (offset d)) + (x (size d)) ) ++ ( (y (offset d)) + (radiusy d) ) ) )) ++ ++; 16 Sep 92 ++(gldefun draw-rcbox-snap ((d draw-rcbox) (p vector) (off vector)) ++ (let ( (rx ((x (size d)) / 2)) (ry ((y (size d)) / 2)) ) ++ (or (draw-snapp p off ( (x (offset d)) + rx ) (y (offset d)) ) ++ (draw-snapp p off (x (offset d)) ( (y (offset d)) + ry ) ) ++ (draw-snapp p off ( (x (offset d)) + rx ) ++ ( (y (offset d)) + (y (size d)) ) ) ++ (draw-snapp p off ( (x (offset d)) + (x (size d)) ) ++ ( (y (offset d)) + ry ) ) ) )) ++ ++; 15 Sep 92 ++(gldefun draw-no-snap ((d draw-ellipse) (p vector) (off vector)) nil) ++ ++; 11 Sep 92 ++(gldefun draw-multi-draw ((d draw-multi) (w window) (off vector)) ++ (let ( (totaloff ((offset d) + off)) ) ++ (for subd in (contents d) do ++ (draw subd w totaloff)) )) ++ ++; 11 Sep 92; 13 Sep 92; 15 Sep 92; 16 Sep 92; 29 Sep 92; 17 Dec 93; 07 Jan 94 ++; Initialize drawing and command menus ++(defun draw-init-menus () ++ (let ((w (draw-window))) ++ (window-clear w) ++ (dolist (fn '(draw-menu-rectangle draw-menu-circle draw-menu-ellipse ++ draw-menu-line draw-menu-arrow draw-menu-dot ++ draw-menu-button draw-menu-text)) ++ (setf (get fn 'display-size) '(30 20)) ) ++ (setq *draw-menu-set* (menu-set-create w nil)) ++ (menu-set-add-menu *draw-menu-set* 'draw nil "Draw" ++ '((draw-menu-rectangle . rectangle) ++ (draw-menu-rcbox . rcbox) ++ (draw-menu-circle . circle) ++ (draw-menu-ellipse . ellipse) ++ (draw-menu-line . line) ++ (draw-menu-arrow . arrow) ++ (draw-menu-dot . dot) ++ (" " . erase) ++ (draw-menu-button . button) ++ (draw-menu-text . text) ++ (draw-menu-refpt . refpt)) ++ (list 0 0)) ++ (menu-set-adjust *draw-menu-set* 'draw 'top nil 1) ++ (menu-set-adjust *draw-menu-set* 'draw 'right nil 2) ++ (menu-set-add-menu *draw-menu-set* 'command nil "Commands" ++ '(("Done" . done) ("Move" . move) ++ ("Delete" . delete) ("Copy" . copy) ++ ("Redraw" . redraw) ("Origin" . origin) ++ ("LaTex Mode" . latexmode) ++ ("Make Program" . program) ("Make LaTex" . latex)) ++ (list 0 0)) ++ (menu-set-adjust *draw-menu-set* 'command 'top 'draw 5) ++ (menu-set-adjust *draw-menu-set* 'command 'right nil 2) )) ++ ++ ++; 10 Sep 92 ++(defun draw-menu-rectangle (w x y) ++ (window-draw-box-xy w (+ x 3) (+ y 3) 24 14 1)) ++(defun draw-menu-rcbox (w x y) ++ (window-draw-rcbox-xy w (+ x 3) (+ y 3) 24 14 3 1)) ++(defun draw-menu-circle (w x y) ++ (window-draw-circle-xy w (+ x 15) (+ y 10) 8 1)) ++(defun draw-menu-ellipse (w x y) ++ (window-draw-ellipse-xy w (+ x 15) (+ y 10) 12 8 1)) ++(defun draw-menu-line (w x y) ++ (window-draw-line-xy w (+ x 4) (+ y 4) (+ x 26) (+ y 16) 1)) ++(defun draw-menu-arrow (w x y) ++ (window-draw-arrow-xy w (+ x 4) (+ y 4) (+ x 26) (+ y 16) 1)) ++(defun draw-menu-dot (w x y) (window-draw-dot-xy w (+ x 15) (+ y 10)) ) ++(defun draw-menu-button (w x y) ++ (window-draw-box-xy w (+ x 14) (+ y 5) 4 4 1)) ++(defun draw-menu-text (w x y) ++ (window-printat-xy w "A" (+ x 12) (+ y 5))) ++(defun draw-menu-refpt (w x y) ++ (window-draw-crosshairs-xy w (+ x 15) (+ y 9)) ++ (window-draw-circle-xy w (+ x 15) (+ y 9) 2)) ++ ++; 14 Sep 92; 15 Jan 98 ++; Draw a line or arrow in LaTex form ++(defun latex-line (fromx fromy x y &optional arrowflg) ++ (let (dx dy sx sy siz err errb) ++ (setq dx (- x fromx)) ++ (setq dy (- y fromy)) ++ (if (= dx 0) ++ (progn (setq sx 0) ++ (setq sy (if (>= dy 0) 1 -1)) ++ (setq siz (* (abs dy) *draw-latex-factor*))) ++ (if (= dy 0) ++ (progn (setq sx (if (>= dx 0) 1 -1)) ++ (setq sy 0) ++ (setq siz (* (abs dx) *draw-latex-factor*))) ++ (progn ++ (setq err 9999) ++ (setq siz (* (abs dx) *draw-latex-factor*)) ++ (dotimes (i (if arrowflg 4 6)) ++ (dotimes (j (if arrowflg 4 6)) ++ (setq errb (abs (- (/ (float (1+ i)) ++ (float (1+ j))) ++ (abs (/ (float dx) ++ (float dy)))))) ++ (if (and (= (gcd (1+ i) (1+ j)) 1) ++ (< errb err)) ++ (progn (setq err errb) ++ (setq sx (1+ i)) ++ (setq sy (1+ j)))))) ++ (setq sx (* sx (latex-sign dx))) ++ (setq sy (* sy (latex-sign dy))) ))) ++ (format t " \\put(~5,0F,~5,0F) {\\~A(~D,~D){~5,0F}}~%" ++ (* fromx *draw-latex-factor*) (* fromy *draw-latex-factor*) ++ (if arrowflg "vector" "line") sx sy siz) )) ++ ++(defun latex-sign (x) (if (>= x 0) 1 -1)) ++ ++ ++; 16 Sep 92; 30 Sep 92; 02 Oct 92; 07 Oct 92 ++(defun draw-output (outfilename &optional names) ++ (prog (prettysave lengthsave d fnname code) ++ (or names (setq names *draw-objects*)) ++ (if (symbolp names) (setq names (list names))) ++ (with-open-file (outfile outfilename ++ :direction :output ++ :if-exists :supersede) ++ (setq prettysave *print-pretty*) ++ (setq lengthsave *print-length*) ++ (setq *print-pretty* t) ++ (setq *print-length* 80) ++ (format outfile "; ~A ~A~%" ++ outfilename (draw-get-time-string)) ++ (dolist (name names) ++ (if (setq d (get name 'draw-descr)) ++ (progn (terpri outfile) ++ (print `(setf (get ',name 'draw-descr) ',d) outfile) ++ (if (and (setq fnname (draw-desc-fnname d)) ++ (setq code (symbol-function fnname))) ++ (progn (terpri outfile) ++ (print (cons 'defun ++ (if (eq (car code) 'lambda-block) ++ (cdr code) ++ (cons fnname (cdr code)))) ++ outfile)) ))) ++ (if (setq d (get name 'picmenu-spec)) ++ (progn (terpri outfile) ++ (print `(setf (get ',name 'picmenu-spec) ',d) outfile)))) ++ (terpri outfile) ++ (setq *print-pretty* prettysave) ++ (setq *print-length* lengthsave) ) ++ (return outfilename) )) ++ ++; 09 Sep 92 ++(defun draw-get-time-string () ++ (let (second minute hour date month year) ++ (multiple-value-setq (second minute hour date month year) ++ (get-decoded-time)) ++ (format nil "~2D ~A ~4D ~2D:~2D:~2D" ++ date (nth (1- month) '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" ++ "Aug" "Sep" "Oct" "Nov" "Dec")) ++ year hour minute second) )) ++ ++; 14 Sep 92; 16 Sep 92; 13 July 93 ++; Compile the draw.lsp and menu-set files into a plain Lisp file ++(defun compile-draw () ++ (glcompfiles *directory* ++ '("glisp/vector.lsp" ; auxiliary files ++ "X/dwindow.lsp") ++ '("glisp/menu-set.lsp" ; translated files ++ "glisp/draw.lsp") ++ "glisp/drawtrans.lsp" ; output file ++ "glisp/draw-header.lsp") ; header file ++ (cf drawtrans) ) ++ ++(defun compile-drawb () ++ (glcompfiles *directory* ++ '("glisp/vector.lsp" ; auxiliary files ++ "X/dwindow.lsp" "X/dwnoopen.lsp") ++ '("glisp/menu-set.lsp" ; translated files ++ "glisp/draw.lsp") ++ "glisp/drawtrans.lsp" ; output file ++ "glisp/draw-header.lsp") ; header file ++ ) ++ ++; 16 Nov 92; 08 Apr 93; 08 Oct 93; 20 Apr 94; 29 Oct 94; 09 Feb 99 ++; Output drawing descriptions and functions to the specified file ++(defun draw-out (&optional names file) ++ (or names (setq names *draw-objects*)) ++ (if (not (consp names)) (setq names (list names))) ++ (draw-output (or file "glisp/draw.del") names) ++ (setq *draw-objects* (set-difference *draw-objects* names)) ++ names ) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_dwimportsb.lsp +@@ -0,0 +1,76 @@ ++; dwimportsb.lsp Gordon S. Novak Jr. 11 Sep 06 ++ ++; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; This file imports symbols of the XGCL package; these symbols may be ++; needed by a hard-core user of the Xlib functions. ++ ++; See the file gnu.license . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; This file imports symbols from the dwindow.lsp file (in XLIB: package) ++; to the current package (such as the :USER package). ++; This will allow the dwindow.lsp functions to be called by just their ++; names and without any package qualifier. ++ ++; This file should be loaded immediately after starting Lisp: ++; If Lisp has seen any of these symbols, loading this file will cause an error. ++ ++(dolist (x '(xlib::XRecolorCursor ++xlib::XFlush xlib::XUnMapWindow xlib::XClearWindow xlib::XMapWindow ++xlib::XTextWidth xlib::XOpenDisplay xlib::XdefaultScreen xlib::XRootWindow ++xlib::XBlackPixel xlib::XWhitePixel xlib::XDefaultGC xlib::XDefaultColormap ++xlib::make-XsetWindowAttributes xlib::set-XsetWindowAttributes-backing_store ++xlib::set-XsetWindowAttributes-save_under xlib::make-XWindowAttributes ++xlib::make-XsizeHints xlib::make-XEvent xlib::make-XGCValues ++xlib::XQueryPointer xlib::XCreateSimpleWindow xlib::XsetStandardProperties ++xlib::XCreateGC xlib::CWSaveUnder xlib::CWBackingStore ++xlib::XloadQueryFont xlib::XsetFont xlib::XGetGCValues ++xlib::XGCValues-foreground xlib::XsetForeground xlib::XGCValues-Background ++xlib::XsetBackground xlib::XGCValues-function xlib::XCreateFontCursor ++xlib::XDefineCursor xlib::XGetGeometry ++xlib::Xsync xlib::XsetFunction xlib::GXxor xlib::GXcopy ++xlib::XsetLineAttributes xlib::LineSolid xlib::CapButt xlib::JoinMiter ++xlib::XDrawLine xlib::XdrawArc xlib::XClearArea xlib::XCopyArea ++xlib::XFillRectangle xlib::XdrawImageString xlib::XTextExtents ++xlib::XDestroyWindow xlib::XFreeGC xlib::XMoveWindow xlib::Xsync ++xlib::Xselectinput xlib::ButtonPressMask xlib::PointerMotionMask ++xlib::XNextEvent xlib::XAnyEvent-type xlib::XAnyEvent-window ++xlib::MotionNotify xlib::ButtonPress ++xlib::XMotionEvent-x xlib::XMotionEvent-y xlib::XButtonEvent-button ++xlib::XAnyEvent-window ++xlib::XButtonEvent-button xlib::XWindowAttributes-map_state ++xlib::ISUnmapped xlib::XPending ++xlib::Expose xlib::XAllocColor xlib::XColor-Pixel xlib::XFreeColors ++xlib::KeyPressMask xlib::KeyReleaseMask xlib::KeyRelease ++xlib::KeyPress xlib::ButtonPress xlib::XDisplayKeycodes ++xlib::XGetKeyboardMapping ++xlib::XFree xlib::XK_Shift_R xlib::XK_Shift_L xlib::XK_Control_L ++xlib::XK_Control_R xlib::XK_Alt_R xlib::XK_Alt_L xlib::XK_Return ++xlib::XK_Tab xlib::XK_BackSpace xlib::get-c-string xlib::int-pos ++xlib::fixnum-array xlib::int-array xlib::fixnum-pos ++xlib::set-xsizehints-x xlib::set-xsizehints-y xlib::set-xsizehints-width ++xlib::set-xsizehints-height xlib::set-xsizehints-flags xlib::set-foreground ++xlib::set-background xlib::set-font ++xlib::set-cursor xlib::set-line-width xlib::set-line-attr ++xlib::set-Xcolor-red xlib::set-Xcolor-green xlib::set-Xcolor-blue ++xlib::WhenMapped xlib::Psize xlib::Pposition xlib::CWSaveUnder ++xlib::CWBackingStore xlib::NoSymbol ++xlib::leavewindowmask xlib::buttonreleasemask xlib::exposuremask ++xlib::GCForeground xlib::GCBackground xlib::GCFunction ++xlib::None xlib::Xfontstruct-fid xlib::XChangeWindowAttributes ++xlib::XGetWindowAttributes lisp::null xlib::Make-Xcolor ++ )) (import x) ) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_Xlib.lsp +@@ -0,0 +1,3456 @@ ++(in-package :XLIB) ++; Xlib.lsp Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++;;typedef unsigned long XID) ; ++ ++;;typedef XID Window) ; ++;;typedef XID Drawable) ; ++;;typedef XID Font) ; ++;;typedef XID Pixmap) ; ++;;typedef XID Cursor) ; ++;;typedef XID Colormap) ; ++;;typedef XID GContext) ; ++;;typedef XID KeySym) ; ++ ++;;typedef unsigned long Mask) ; ++ ++;;typedef unsigned long Atom) ; ++ ++;;typedef unsigned long VisualID) ; ++ ++;;typedef unsigned long Time) ; ++ ++;;typedef unsigned char KeyCode) ; ++ ++(defconstant True 1) ++(defconstant False 0) ++ ++(defconstant QueuedAlready 0) ++(defconstant QueuedAfterReading 1) ++(defconstant QueuedAfterFlush 2) ++ ++(defentry XLoadQueryFont( ++ ++ fixnum ;; display ++ object ;; name ++ ++)( fixnum "XLoadQueryFont")) ++ ++ ++ ++(defentry XQueryFont( ++ ++ fixnum ;; display ++ fixnum ;; font_ID ++ ++)( fixnum "XQueryFont")) ++ ++ ++ ++ ++(defentry XGetMotionEvents( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; start ++ fixnum ;; stop ++ fixnum ;; nevents_return ++ ++)( fixnum "XGetMotionEvents")) ++ ++ ++ ++(defentry XDeleteModifiermapEntry( ++ ++ fixnum ;; modmap ++ ++ fixnum ;; keycode_entry ++ ++ fixnum ;; modifier ++ ++)( fixnum "XDeleteModifiermapEntry")) ++ ++ ++ ++(defentry XGetModifierMapping( ++ ++ fixnum ;; display ++ ++)( fixnum "XGetModifierMapping")) ++ ++ ++ ++(defentry XInsertModifiermapEntry( ++ ++ fixnum ;; modmap ++ ++ fixnum ;; keycode_entry ++ ++ fixnum ;; modifier ++ ++)( fixnum "XInsertModifiermapEntry")) ++ ++ ++ ++(defentry XNewModifiermap( ++ ++ fixnum ;; max_keys_per_mod ++ ++)( fixnum "XNewModifiermap")) ++ ++ ++ ++(defentry XCreateImage( ++ ++ fixnum ;; display ++ fixnum ;; visual ++ fixnum ;; depth ++ fixnum ;; format ++ fixnum ;; offset ++ object ;; data ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; bitmap_pad ++ fixnum ;; bytes_per_line ++ ++)( fixnum "XCreateImage")) ++ ++ ++(defentry XGetImage( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; plane_mask ++ fixnum ;; format ++ ++)( fixnum "XGetImage")) ++ ++ ++(defentry XGetSubImage( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; plane_mask ++ fixnum ;; format ++ fixnum ;; dest_image ++ fixnum ;; dest_x ++ fixnum ;; dest_y ++ ++)( fixnum "XGetSubImage")) ++ ++;;Window X function declarations. ++ ++ ++ ++(defentry XOpenDisplay( ++ ++ object ;; display_name ++ ++)( fixnum "XOpenDisplay")) ++ ++ ++ ++(defentry XrmInitialize( ++ ++;; void ++ ++)( void "XrmInitialize")) ++ ++ ++ ++(defentry XFetchBytes( ++ ++ fixnum ;; display ++ fixnum ;; nbytes_return ++ ++)( fixnum "XFetchBytes")) ++ ++ ++(defentry XFetchBuffer( ++ ++ fixnum ;; display ++ fixnum ;; nbytes_return ++ fixnum ;; buffer ++ ++)( fixnum "XFetchBuffer")) ++ ++ ++(defentry XGetAtomName( ++ ++ fixnum ;; display ++ fixnum ;; atom ++ ++)( fixnum "XGetAtomName")) ++ ++ ++(defentry XGetDefault( ++ ++ fixnum ;; display ++ object ;; program ++ object ;; option ++ ++)( fixnum "XGetDefault")) ++ ++ ++(defentry XDisplayName( ++ ++ object ;; string ++ ++)( fixnum "XDisplayName")) ++ ++ ++(defentry XKeysymToString( ++ ++ fixnum ;; keysym ++ ++)( fixnum "XKeysymToString")) ++ ++ ++ ++ ++(defentry XInternAtom( ++ ++ fixnum ;; display ++ object ;; atom_name ++ fixnum ;; only_if_exists ++ ++)( fixnum "XInternAtom")) ++ ++ ++(defentry XCopyColormapAndFree( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ ++)( fixnum "XCopyColormapAndFree")) ++ ++ ++(defentry XCreateColormap( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; visual ++ fixnum ;; alloc ++ ++)( fixnum "XCreateColormap")) ++ ++ ++(defentry XCreatePixmapCursor( ++ ++ fixnum ;; display ++ fixnum ;; source ++ fixnum ;; mask ++ fixnum ;; foreground_color ++ fixnum ;; background_color ++ fixnum ;; x ++ fixnum ;; y ++ ++)( fixnum "XCreatePixmapCursor")) ++ ++ ++(defentry XCreateGlyphCursor( ++ ++ fixnum ;; display ++ fixnum ;; source_font ++ fixnum ;; mask_font ++ fixnum ;; source_char ++ fixnum ;; mask_char ++ fixnum ;; foreground_color ++ fixnum ;; background_color ++ ++)( fixnum "XCreateGlyphCursor")) ++ ++ ++(defentry XCreateFontCursor( ++ ++ fixnum ;; display ++ fixnum ;; shape ++ ++)( fixnum "XCreateFontCursor")) ++ ++ ++(defentry XLoadFont( ++ ++ fixnum ;; display ++ object ;; name ++ ++)( fixnum "XLoadFont")) ++ ++ ++(defentry XCreateGC( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; valuemask ++ fixnum ;; values ++ ++)( fixnum "XCreateGC")) ++ ++ ++(defentry XGContextFromGC( ++ ++ fixnum ;; gc ++ ++)( fixnum "XGContextFromGC")) ++ ++ ++(defentry XCreatePixmap( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; depth ++ ++)( fixnum "XCreatePixmap")) ++ ++ ++(defentry XCreateBitmapFromData( ++ ++ fixnum ;; display ++ fixnum ;; d ++ object ;; data ++ fixnum ;; width ++ fixnum ;; height ++ ++)( fixnum "XCreateBitmapFromData")) ++ ++ ++(defentry XCreatePixmapFromBitmapData( ++ ++ fixnum ;; display ++ fixnum ;; d ++ object ;; data ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; fg ++ fixnum ;; bg ++ fixnum ;; depth ++ ++)( fixnum "XCreatePixmapFromBitmapData")) ++ ++ ++(defentry XCreateSimpleWindow( ++ ++ fixnum ;; display ++ fixnum ;; parent ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; border_width ++ fixnum ;; border ++ fixnum ;; background ++ ++)( fixnum "XCreateSimpleWindow")) ++ ++ ++(defentry XGetSelectionOwner( ++ ++ fixnum ;; display ++ fixnum ;; selection ++ ++)( fixnum "XGetSelectionOwner")) ++ ++ ++(defentry XCreateWindow( ++ ++ fixnum ;; display ++ fixnum ;; parent ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; border_width ++ fixnum ;; depth ++ fixnum ;; class ++ fixnum ;; visual ++ fixnum ;; valuemask ++ fixnum ;; attributes ++ ++)( fixnum "XCreateWindow")) ++ ++ ++(defentry XListInstalledColormaps( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; num_return ++ ++)( fixnum "XListInstalledColormaps")) ++ ++ ++(defentry XListFonts( ++ ++ fixnum ;; display ++ object ;; pattern ++ fixnum ;; maxnames ++ fixnum ;; actual_count_return ++ ++)( fixnum "XListFonts")) ++ ++ ++(defentry XListFontsWithInfo( ++ ++ fixnum ;; display ++ object ;; pattern ++ fixnum ;; maxnames ++ fixnum ;; count_return ++ fixnum ;; info_return ++ ++)( fixnum "XListFontsWithInfo")) ++ ++ ++(defentry XGetFontPath( ++ ++ fixnum ;; display ++ fixnum ;; npaths_return ++ ++)( fixnum "XGetFontPath")) ++ ++ ++(defentry XListExtensions( ++ ++ fixnum ;; display ++ fixnum ;; nextensions_return ++ ++)( fixnum "XListExtensions")) ++ ++ ++(defentry XListProperties( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; num_prop_return ++ ++)( fixnum "XListProperties")) ++ ++ ++(defentry XListHosts( ++ ++ fixnum ;; display ++ fixnum ;; nhosts_return ++ fixnum ;; state_return ++ ++)( fixnum "XListHosts")) ++ ++ ++(defentry XKeycodeToKeysym( ++ ++ fixnum ;; display ++ ++ fixnum ;; fixnum ++ ++ fixnum ;; index ++ ++)( fixnum "XKeycodeToKeysym")) ++ ++ ++(defentry XLookupKeysym( ++ ++ fixnum ;; key_event ++ fixnum ;; index ++ ++)( fixnum "XLookupKeysym")) ++ ++ ++(defentry XGetKeyboardMapping( ++ ++ fixnum ;; display ++ ++ fixnum ;; first_keycode ++ ++ fixnum ;; keycode_count ++ fixnum ;; keysyms_per_keycode_return ++ ++)( fixnum "XGetKeyboardMapping")) ++ ++ ++(defentry XStringToKeysym( ++ ++ object ;; string ++ ++)( fixnum "XStringToKeysym")) ++ ++ ++(defentry XMaxRequestSize( ++ ++ fixnum ;; display ++ ++)( fixnum "XMaxRequestSize")) ++ ++ ++(defentry XResourceManagerString( ++ ++ fixnum ;; display ++ ++)( fixnum "XResourceManagerString")) ++ ++ ++(defentry XDisplayMotionBufferSize( ++ ++ fixnum ;; display ++ ++)( fixnum "XDisplayMotionBufferSize")) ++ ++ ++(defentry XVisualIDFromVisual( ++ ++ fixnum ;; visual ++ ++)( fixnum "XVisualIDFromVisual")) ++ ++;; routines for dealing with extensions ++ ++ ++ ++(defentry XInitExtension( ++ ++ fixnum ;; display ++ object ;; name ++ ++)( fixnum "XInitExtension")) ++ ++ ++ ++(defentry XAddExtension( ++ ++ fixnum ;; display ++ ++)( fixnum "XAddExtension")) ++ ++ ++(defentry XFindOnExtensionList( ++ ++ fixnum ;; structure ++ fixnum ;; number ++ ++)( fixnum "XFindOnExtensionList")) ++ ++ ++ ++;;;fix ++ ++ ++;(defentry XEHeadOfExtensionList( ++ ++; fixnum ;;object ++ ++;)( fixnum "XEHeadOfExtensionList")) ++ ++;; these are routines for which there are also macros ++ ++ ++(defentry XRootWindow( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XRootWindow")) ++ ++ ++(defentry XDefaultRootWindow( ++ ++ fixnum ;; display ++ ++)( fixnum "XDefaultRootWindow")) ++ ++ ++(defentry XRootWindowOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XRootWindowOfScreen")) ++ ++ ++(defentry XDefaultVisual( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDefaultVisual")) ++ ++ ++(defentry XDefaultVisualOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XDefaultVisualOfScreen")) ++ ++ ++(defentry XDefaultGC( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDefaultGC")) ++ ++ ++(defentry XDefaultGCOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XDefaultGCOfScreen")) ++ ++ ++(defentry XBlackPixel( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XBlackPixel")) ++ ++ ++(defentry XWhitePixel( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XWhitePixel")) ++ ++ ++(defentry XAllPlanes( ++ ++;; void ++ ++)( fixnum "XAllPlanes")) ++ ++ ++(defentry XBlackPixelOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XBlackPixelOfScreen")) ++ ++ ++(defentry XWhitePixelOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XWhitePixelOfScreen")) ++ ++ ++(defentry XNextRequest( ++ ++ fixnum ;; display ++ ++)( fixnum "XNextRequest")) ++ ++ ++(defentry XLastKnownRequestProcessed( ++ ++ fixnum ;; display ++ ++)( fixnum "XLastKnownRequestProcessed")) ++ ++ ++(defentry XServerVendor( ++ ++ fixnum ;; display ++ ++)( fixnum "XServerVendor")) ++ ++ ++(defentry XDisplayString( ++ ++ fixnum ;; display ++ ++)( fixnum "XDisplayString")) ++ ++ ++(defentry XDefaultColormap( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDefaultColormap")) ++ ++ ++(defentry XDefaultColormapOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XDefaultColormapOfScreen")) ++ ++ ++(defentry XDisplayOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XDisplayOfScreen")) ++ ++ ++(defentry XScreenOfDisplay( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XScreenOfDisplay")) ++ ++ ++(defentry XDefaultScreenOfDisplay( ++ ++ fixnum ;; display ++ ++)( fixnum "XDefaultScreenOfDisplay")) ++ ++ ++(defentry XEventMaskOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XEventMaskOfScreen")) ++ ++ ++ ++(defentry XScreenNumberOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XScreenNumberOfScreen")) ++ ++ ++ ++(defentry XSetErrorHandler ( ++ ++ fixnum ;; handler ++ ++)( fixnum "XSetErrorHandler" )) ++ ++ ++;;fix ++ ++ ++(defentry XSetIOErrorHandler ( ++ ++ fixnum ;; handler ++ ++)( fixnum "XSetIOErrorHandler" )) ++ ++ ++ ++ ++(defentry XListPixmapFormats( ++ ++ fixnum ;; display ++ fixnum ;; count_return ++ ++)( fixnum "XListPixmapFormats")) ++ ++ ++(defentry XListDepths( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ fixnum ;; count_return ++ ++)( fixnum "XListDepths")) ++ ++;; ICCCM routines for things that don't require special include files; ++;; other declarations are given in Xutil.h ++ ++ ++(defentry XReconfigureWMWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; screen_number ++ fixnum ;; mask ++ fixnum ;; changes ++ ++)( fixnum "XReconfigureWMWindow")) ++ ++ ++ ++(defentry XGetWMProtocols( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; protocols_return ++ fixnum ;; count_return ++ ++)( fixnum "XGetWMProtocols")) ++ ++ ++(defentry XSetWMProtocols( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; protocols ++ fixnum ;; count ++ ++)( fixnum "XSetWMProtocols")) ++ ++ ++(defentry XIconifyWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; screen_number ++ ++)( fixnum "XIconifyWindow")) ++ ++ ++(defentry XWithdrawWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; screen_number ++ ++)( fixnum "XWithdrawWindow")) ++ ++;;;fix ++ ++ ++(defentry XGetCommand( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; argv_return ++ fixnum ;; argc_return ++ ++)( fixnum "XGetCommand")) ++ ++ ++(defentry XGetWMColormapWindows( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; windows_return ++ fixnum ;; count_return ++ ++)( fixnum "XGetWMColormapWindows")) ++ ++ ++(defentry XSetWMColormapWindows( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; colormap_windows ++ fixnum ;; count ++ ++)( fixnum "XSetWMColormapWindows")) ++ ++ ++(defentry XFreeStringList( ++ ++ fixnum ;; list ++ ++)( void "XFreeStringList")) ++ ++ ++(defentry XSetTransientForHint( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; prop_window ++ ++)( void "XSetTransientForHint")) ++ ++;; The following are given in alphabetical order ++ ++ ++ ++(defentry XActivateScreenSaver( ++ ++ fixnum ;; display ++ ++)( void "XActivateScreenSaver")) ++ ++ ++ ++(defentry XAddHost( ++ ++ fixnum ;; display ++ fixnum ;; host ++ ++)( void "XAddHost")) ++ ++ ++ ++(defentry XAddHosts( ++ ++ fixnum ;; display ++ fixnum ;; hosts ++ fixnum ;; num_hosts ++ ++)( void "XAddHosts")) ++ ++ ++ ++(defentry XAddToExtensionList( ++ ++ fixnum ;; structure ++ fixnum ;; ext_data ++ ++)( void "XAddToExtensionList")) ++ ++ ++ ++(defentry XAddToSaveSet( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XAddToSaveSet")) ++ ++ ++ ++(defentry XAllocColor( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; screen_in_out ++ ++)( fixnum "XAllocColor")) ++ ++;;;fix ++ ++ ++(defentry XAllocColorCells( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; contig ++ fixnum ;; plane_masks_return ++ fixnum ;; nplanes ++ fixnum ;; pixels_return ++ fixnum ;; npixels ++ ++)( fixnum "XAllocColorCells")) ++ ++ ++ ++(defentry XAllocColorPlanes( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; contig ++ fixnum ;; pixels_return ++ fixnum ;; ncolors ++ fixnum ;; nreds ++ fixnum ;; ngreens ++ fixnum ;; nblues ++ fixnum ;; rmask_return ++ fixnum ;; gmask_return ++ fixnum ;; bmask_return ++ ++)( fixnum "XAllocColorPlanes")) ++ ++ ++ ++(defentry XAllocNamedColor( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ object ;; color_name ++ fixnum ;; screen_def_return ++ fixnum ;; exact_def_return ++ ++)( fixnum "XAllocNamedColor")) ++ ++ ++ ++(defentry XAllowEvents( ++ ++ fixnum ;; display ++ fixnum ;; event_mode ++ fixnum ;; time ++ ++)( void "XAllowEvents")) ++ ++ ++ ++(defentry XAutoRepeatOff( ++ ++ fixnum ;; display ++ ++)( void "XAutoRepeatOff")) ++ ++ ++ ++(defentry XAutoRepeatOn( ++ ++ fixnum ;; display ++ ++)( void "XAutoRepeatOn")) ++ ++ ++ ++(defentry XBell( ++ ++ fixnum ;; display ++ fixnum ;; percent ++ ++)( void "XBell")) ++ ++ ++ ++(defentry XBitmapBitOrder( ++ ++ fixnum ;; display ++ ++)( fixnum "XBitmapBitOrder")) ++ ++ ++ ++(defentry XBitmapPad( ++ ++ fixnum ;; display ++ ++)( fixnum "XBitmapPad")) ++ ++ ++ ++(defentry XBitmapUnit( ++ ++ fixnum ;; display ++ ++)( fixnum "XBitmapUnit")) ++ ++ ++ ++(defentry XCellsOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XCellsOfScreen")) ++ ++ ++ ++(defentry XChangeActivePointerGrab( ++ ++ fixnum ;; display ++ fixnum ;; event_mask ++ fixnum ;; cursor ++ fixnum ;; time ++ ++)( void "XChangeActivePointerGrab")) ++ ++ ++ ++(defentry XChangeGC( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; valuemask ++ fixnum ;; values ++ ++)( void "XChangeGC")) ++ ++ ++ ++(defentry XChangeKeyboardControl( ++ ++ fixnum ;; display ++ fixnum ;; value_mask ++ fixnum ;; values ++ ++)( void "XChangeKeyboardControl")) ++ ++ ++ ++(defentry XChangeKeyboardMapping( ++ ++ fixnum ;; display ++ fixnum ;; first_keycode ++ fixnum ;; keysyms_per_keycode ++ fixnum ;; keysyms ++ fixnum ;; num_codes ++ ++)( void "XChangeKeyboardMapping")) ++ ++ ++ ++(defentry XChangePointerControl( ++ ++ fixnum ;; display ++ fixnum ;; do_accel ++ fixnum ;; do_threshold ++ fixnum ;; accel_numerator ++ fixnum ;; accel_denominator ++ fixnum ;; threshold ++ ++)( void "XChangePointerControl")) ++ ++ ++ ++(defentry XChangeProperty( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; property ++ fixnum ;; type ++ fixnum ;; format ++ fixnum ;; mode ++ fixnum ;; data ++ fixnum ;; nelements ++ ++)( void "XChangeProperty")) ++ ++ ++ ++(defentry XChangeSaveSet( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; change_mode ++ ++)( void "XChangeSaveSet")) ++ ++ ++ ++(defentry XChangeWindowAttributes( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; valuemask ++ fixnum ;; attributes ++ ++)( void "XChangeWindowAttributes")) ++ ++ ++ ++(defentry XCheckMaskEvent( ++ ++ fixnum ;; display ++ fixnum ;; event_mask ++ fixnum ;; event_return ++ ++)( fixnum "XCheckMaskEvent")) ++ ++ ++ ++(defentry XCheckTypedEvent( ++ ++ fixnum ;; display ++ fixnum ;; event_type ++ fixnum ;; event_return ++ ++)( fixnum "XCheckTypedEvent")) ++ ++ ++ ++(defentry XCheckTypedWindowEvent( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; event_type ++ fixnum ;; event_return ++ ++)( fixnum "XCheckTypedWindowEvent")) ++ ++ ++ ++(defentry XCheckWindowEvent( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; event_mask ++ fixnum ;; event_return ++ ++)( fixnum "XCheckWindowEvent")) ++ ++ ++ ++(defentry XCirculateSubwindows( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; direction ++ ++)( void "XCirculateSubwindows")) ++ ++ ++ ++(defentry XCirculateSubwindowsDown( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XCirculateSubwindowsDown")) ++ ++ ++ ++(defentry XCirculateSubwindowsUp( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XCirculateSubwindowsUp")) ++ ++ ++ ++(defentry XClearArea( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; exposures ++ ++)( void "XClearArea")) ++ ++ ++ ++(defentry XClearWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XClearWindow")) ++ ++ ++ ++(defentry XCloseDisplay( ++ ++ fixnum ;; display ++ ++)( void "XCloseDisplay")) ++ ++ ++ ++(defentry XConfigureWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; value_mask ++ fixnum ;; values ++ ++)( void "XConfigureWindow")) ++ ++ ++ ++(defentry XConnectionNumber( ++ ++ fixnum ;; display ++ ++)( fixnum "XConnectionNumber")) ++ ++ ++ ++(defentry XConvertSelection( ++ ++ fixnum ;; display ++ fixnum ;; selection ++ fixnum ;; target ++ fixnum ;; property ++ fixnum ;; requestor ++ fixnum ;; time ++ ++)( void "XConvertSelection")) ++ ++ ++ ++(defentry XCopyArea( ++ ++ fixnum ;; display ++ fixnum ;; src ++ fixnum ;; dest ++ fixnum ;; gc ++ fixnum ;; src_x ++ fixnum ;; src_y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; dest_x ++ fixnum ;; dest_y ++ ++)( void "XCopyArea")) ++ ++ ++ ++(defentry XCopyGC( ++ ++ fixnum ;; display ++ fixnum ;; src ++ fixnum ;; valuemask ++ fixnum ;; dest ++ ++)( void "XCopyGC")) ++ ++ ++ ++(defentry XCopyPlane( ++ ++ fixnum ;; display ++ fixnum ;; src ++ fixnum ;; dest ++ fixnum ;; gc ++ fixnum ;; src_x ++ fixnum ;; src_y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; dest_x ++ fixnum ;; dest_y ++ fixnum ;; plane ++ ++)( void "XCopyPlane")) ++ ++ ++ ++(defentry XDefaultDepth( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDefaultDepth")) ++ ++ ++ ++(defentry XDefaultDepthOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XDefaultDepthOfScreen")) ++ ++ ++ ++(defentry XDefaultScreen( ++ ++ fixnum ;; display ++ ++)( fixnum "XDefaultScreen")) ++ ++ ++ ++(defentry XDefineCursor( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; cursor ++ ++)( void "XDefineCursor")) ++ ++ ++ ++(defentry XDeleteProperty( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; property ++ ++)( void "XDeleteProperty")) ++ ++ ++ ++(defentry XDestroyWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XDestroyWindow")) ++ ++ ++ ++(defentry XDestroySubwindows( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XDestroySubwindows")) ++ ++ ++ ++(defentry XDoesBackingStore( ++ ++ fixnum ;; screen ++ ++)( fixnum "XDoesBackingStore")) ++ ++ ++ ++(defentry XDoesSaveUnders( ++ ++ fixnum ;; screen ++ ++)( fixnum "XDoesSaveUnders")) ++ ++ ++ ++(defentry XDisableAccessControl( ++ ++ fixnum ;; display ++ ++)( void "XDisableAccessControl")) ++ ++ ++ ++ ++(defentry XDisplayCells( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDisplayCells")) ++ ++ ++ ++(defentry XDisplayHeight( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDisplayHeight")) ++ ++ ++ ++(defentry XDisplayHeightMM( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDisplayHeightMM")) ++ ++ ++ ++(defentry XDisplayKeycodes( ++ ++ fixnum ;; display ++ fixnum ;; min_keycodes_return ++ fixnum ;; max_keycodes_return ++ ++)( void "XDisplayKeycodes")) ++ ++ ++ ++(defentry XDisplayPlanes( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDisplayPlanes")) ++ ++ ++ ++(defentry XDisplayWidth( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDisplayWidth")) ++ ++ ++ ++(defentry XDisplayWidthMM( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDisplayWidthMM")) ++ ++ ++ ++(defentry XDrawArc( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; angle1 ++ fixnum ;; angle2 ++ ++)( void "XDrawArc")) ++ ++ ++ ++(defentry XDrawArcs( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; arcs ++ fixnum ;; narcs ++ ++)( void "XDrawArcs")) ++ ++ ++ ++(defentry XDrawImageString( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ object ;; string ++ fixnum ;; length ++ ++)( void "XDrawImageString")) ++ ++ ++ ++(defentry XDrawImageString16( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; string ++ fixnum ;; length ++ ++)( void "XDrawImageString16")) ++ ++ ++ ++(defentry XDrawLine( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x1 ++ fixnum ;; x2 ++ fixnum ;; y1 ++ fixnum ;; y2 ++ ++)( void "XDrawLine")) ++ ++ ++ ++(defentry XDrawLines( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; points ++ fixnum ;; npoints ++ fixnum ;; mode ++ ++)( void "XDrawLines")) ++ ++ ++ ++(defentry XDrawPoint( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ ++)( void "XDrawPoint")) ++ ++ ++ ++(defentry XDrawPoints( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; points ++ fixnum ;; npoints ++ fixnum ;; mode ++ ++)( void "XDrawPoints")) ++ ++ ++ ++(defentry XDrawRectangle( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ ++)( void "XDrawRectangle")) ++ ++ ++ ++(defentry XDrawRectangles( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; rectangles ++ fixnum ;; nrectangles ++ ++)( void "XDrawRectangles")) ++ ++ ++ ++(defentry XDrawSegments( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; segments ++ fixnum ;; nsegments ++ ++)( void "XDrawSegments")) ++ ++ ++ ++(defentry XDrawString( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ object ;; string ++ fixnum ;; length ++ ++)( void "XDrawString")) ++ ++ ++ ++(defentry XDrawString16( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; string ++ fixnum ;; length ++ ++)( void "XDrawString16")) ++ ++ ++ ++(defentry XDrawText( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; items ++ fixnum ;; nitems ++ ++)( void "XDrawText")) ++ ++ ++ ++(defentry XDrawText16( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; items ++ fixnum ;; nitems ++ ++)( void "XDrawText16")) ++ ++ ++ ++(defentry XEnableAccessControl( ++ ++ fixnum ;; display ++ ++)( void "XEnableAccessControl")) ++ ++ ++ ++(defentry XEventsQueued( ++ ++ fixnum ;; display ++ fixnum ;; mode ++ ++)( fixnum "XEventsQueued")) ++ ++ ++ ++(defentry XFetchName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; window_name_return ++ ++)( fixnum "XFetchName")) ++ ++ ++ ++(defentry XFillArc( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; angle1 ++ fixnum ;; angle2 ++ ++)( void "XFillArc")) ++ ++ ++ ++(defentry XFillArcs( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; arcs ++ fixnum ;; narcs ++ ++)( void "XFillArcs")) ++ ++ ++ ++(defentry XFillPolygon( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; points ++ fixnum ;; npoints ++ fixnum ;; shape ++ fixnum ;; mode ++ ++)( void "XFillPolygon")) ++ ++ ++ ++(defentry XFillRectangle( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ ++)( void "XFillRectangle")) ++ ++ ++ ++(defentry XFillRectangles( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; rectangles ++ fixnum ;; nrectangles ++ ++)( void "XFillRectangles")) ++ ++ ++ ++(defentry XFlush( ++ ++ fixnum ;; display ++ ++)( void "XFlush")) ++ ++ ++ ++(defentry XForceScreenSaver( ++ ++ fixnum ;; display ++ fixnum ;; mode ++ ++)( void "XForceScreenSaver")) ++ ++ ++ ++(defentry XFree( ++ ++ object ;; data ++ ++)( void "XFree")) ++ ++ ++ ++(defentry XFreeColormap( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ ++)( void "XFreeColormap")) ++ ++ ++ ++(defentry XFreeColors( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; pixels ++ fixnum ;; npixels ++ fixnum ;; planes ++ ++)( void "XFreeColors")) ++ ++ ++ ++(defentry XFreeCursor( ++ ++ fixnum ;; display ++ fixnum ;; cursor ++ ++)( void "XFreeCursor")) ++ ++ ++ ++(defentry XFreeExtensionList( ++ ++ fixnum ;; list ++ ++)( void "XFreeExtensionList")) ++ ++ ++ ++(defentry XFreeFont( ++ ++ fixnum ;; display ++ fixnum ;; font_struct ++ ++)( void "XFreeFont")) ++ ++ ++ ++(defentry XFreeFontInfo( ++ ++ fixnum ;; names ++ fixnum ;; free_info ++ fixnum ;; actual_count ++ ++)( void "XFreeFontInfo")) ++ ++ ++ ++(defentry XFreeFontNames( ++ ++ fixnum ;; list ++ ++)( void "XFreeFontNames")) ++ ++ ++ ++(defentry XFreeFontPath( ++ ++ fixnum ;; list ++ ++)( void "XFreeFontPath")) ++ ++ ++ ++(defentry XFreeGC( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ ++)( void "XFreeGC")) ++ ++ ++ ++(defentry XFreeModifiermap( ++ ++ fixnum ;; modmap ++ ++)( void "XFreeModifiermap")) ++ ++ ++ ++(defentry XFreePixmap( ++ ++ fixnum ;; display ++ fixnum ;; fixnum ++ ++)( void "XFreePixmap")) ++ ++ ++ ++(defentry XGeometry( ++ ++ fixnum ;; display ++ fixnum ;; screen ++ object ;; position ++ object ;; default_position ++ fixnum ;; bwidth ++ fixnum ;; fwidth ++ fixnum ;; fheight ++ fixnum ;; xadder ++ fixnum ;; yadder ++ fixnum ;; x_return ++ fixnum ;; y_return ++ fixnum ;; width_return ++ fixnum ;; height_return ++ ++)( fixnum "XGeometry")) ++ ++ ++ ++(defentry XGetErrorDatabaseText( ++ ++ fixnum ;; display ++ object ;; name ++ object ;; message ++ object ;; default_string ++ object ;; buffer_return ++ fixnum ;; length ++ ++)( void "XGetErrorDatabaseText")) ++ ++ ++ ++(defentry XGetErrorText( ++ ++ fixnum ;; display ++ fixnum ;; code ++ object ;; buffer_return ++ fixnum ;; length ++ ++)( void "XGetErrorText")) ++ ++ ++ ++(defentry XGetFontProperty( ++ ++ fixnum ;; font_struct ++ fixnum ;; atom ++ fixnum ;; value_return ++ ++)( fixnum "XGetFontProperty")) ++ ++ ++ ++(defentry XGetGCValues( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; valuemask ++ fixnum ;; values_return ++ ++)( fixnum "XGetGCValues")) ++ ++ ++ ++(defentry XGetGeometry( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; root_return ++ fixnum ;; x_return ++ fixnum ;; y_return ++ fixnum ;; width_return ++ fixnum ;; height_return ++ fixnum ;; border_width_return ++ fixnum ;; depth_return ++ ++)( fixnum "XGetGeometry")) ++ ++ ++ ++(defentry XGetIconName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; icon_name_return ++ ++)( fixnum "XGetIconName")) ++ ++ ++ ++(defentry XGetInputFocus( ++ ++ fixnum ;; display ++ fixnum ;; focus_return ++ fixnum ;; revert_to_return ++ ++)( void "XGetInputFocus")) ++ ++ ++ ++(defentry XGetKeyboardControl( ++ ++ fixnum ;; display ++ fixnum ;; values_return ++ ++)( void "XGetKeyboardControl")) ++ ++ ++ ++(defentry XGetPointerControl( ++ ++ fixnum ;; display ++ fixnum ;; accel_numerator_return ++ fixnum ;; accel_denominator_return ++ fixnum ;; threshold_return ++ ++)( void "XGetPointerControl")) ++ ++ ++ ++(defentry XGetPointerMapping( ++ ++ fixnum ;; display ++ object ;; map_return ++ fixnum ;; nmap ++ ++)( fixnum "XGetPointerMapping")) ++ ++ ++ ++(defentry XGetScreenSaver( ++ ++ fixnum ;; display ++ fixnum ;; intout_return ++ fixnum ;; interval_return ++ fixnum ;; prefer_blanking_return ++ fixnum ;; allow_exposures_return ++ ++)( void "XGetScreenSaver")) ++ ++ ++ ++(defentry XGetTransientForHint( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; prop_window_return ++ ++)( fixnum "XGetTransientForHint")) ++ ++ ++ ++(defentry XGetWindowProperty( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; property ++ fixnum ;; int_offset ++ fixnum ;; int_length ++ fixnum ;; delete ++ fixnum ;; req_type ++ fixnum ;; actual_type_return ++ fixnum ;; actual_format_return ++ fixnum ;; nitems_return ++ fixnum ;; bytes_after_return ++ fixnum ;; prop_return ++ ++)( fixnum "XGetWindowProperty")) ++ ++ ++ ++(defentry XGetWindowAttributes( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; Window_attributes_return ++ ++)( fixnum "XGetWindowAttributes")) ++ ++ ++ ++(defentry XGrabButton( ++ ++ fixnum ;; display ++ fixnum ;; button ++ fixnum ;; modifiers ++ fixnum ;; grab_window ++ fixnum ;; owner_events ++ fixnum ;; event_mask ++ fixnum ;; pointer_mode ++ fixnum ;; keyboard_mode ++ fixnum ;; confine_to ++ fixnum ;; cursor ++ ++)( void "XGrabButton")) ++ ++ ++ ++(defentry XGrabKey( ++ ++ fixnum ;; display ++ fixnum ;; keycode ++ fixnum ;; modifiers ++ fixnum ;; grab_window ++ fixnum ;; owner_events ++ fixnum ;; pointer_mode ++ fixnum ;; keyboard_mode ++ ++)( void "XGrabKey")) ++ ++ ++ ++(defentry XGrabKeyboard( ++ ++ fixnum ;; display ++ fixnum ;; grab_window ++ fixnum ;; owner_events ++ fixnum ;; pointer_mode ++ fixnum ;; keyboard_mode ++ fixnum ;; fixnum ++ ++)( fixnum "XGrabKeyboard")) ++ ++ ++ ++(defentry XGrabPointer( ++ ++ fixnum ;; display ++ fixnum ;; grab_window ++ fixnum ;; owner_events ++ fixnum ;; event_mask ++ fixnum ;; pointer_mode ++ fixnum ;; keyboard_mode ++ fixnum ;; confine_to ++ fixnum ;; cursor ++ fixnum ;; fixnum ++ ++)( fixnum "XGrabPointer")) ++ ++ ++ ++(defentry XGrabServer( ++ ++ fixnum ;; display ++ ++)( void "XGrabServer")) ++ ++ ++ ++(defentry XHeightMMOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XHeightMMOfScreen")) ++ ++ ++ ++(defentry XHeightOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XHeightOfScreen")) ++ ++ ++ ++(defentry XImageByteOrder( ++ ++ fixnum ;; display ++ ++)( fixnum "XImageByteOrder")) ++ ++ ++ ++(defentry XInstallColormap( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ ++)( void "XInstallColormap")) ++ ++ ++ ++(defentry XKeysymToKeycode( ++ ++ fixnum ;; display ++ fixnum ;; keysym ++ ++)( fixnum "XKeysymToKeycode")) ++ ++ ++ ++(defentry XKillClient( ++ ++ fixnum ;; display ++ fixnum ;; resource ++ ++)( void "XKillClient")) ++ ++ ++ ++(defentry XLookupColor( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ object ;; color_name ++ fixnum ;; exact_def_return ++ fixnum ;; screen_def_return ++ ++)( fixnum "XLookupColor")) ++ ++ ++ ++(defentry XLowerWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XLowerWindow")) ++ ++ ++ ++(defentry XMapRaised( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XMapRaised")) ++ ++ ++ ++(defentry XMapSubwindows( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XMapSubwindows")) ++ ++ ++ ++(defentry XMapWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XMapWindow")) ++ ++ ++ ++(defentry XMaskEvent( ++ ++ fixnum ;; display ++ fixnum ;; event_mask ++ fixnum ;; event_return ++ ++)( void "XMaskEvent")) ++ ++ ++ ++(defentry XMaxCmapsOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XMaxCmapsOfScreen")) ++ ++ ++ ++(defentry XMinCmapsOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XMinCmapsOfScreen")) ++ ++ ++ ++(defentry XMoveResizeWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ ++)( void "XMoveResizeWindow")) ++ ++ ++ ++(defentry XMoveWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; x ++ fixnum ;; y ++ ++)( void "XMoveWindow")) ++ ++ ++ ++(defentry XNextEvent( ++ ++ fixnum ;; display ++ fixnum ;; event_return ++ ++)( void "XNextEvent")) ++ ++ ++ ++(defentry XNoOp( ++ ++ fixnum ;; display ++ ++)( void "XNoOp")) ++ ++ ++ ++(defentry XParseColor( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ object ;; spec ++ fixnum ;; exact_def_return ++ ++)( fixnum "XParseColor")) ++ ++ ++ ++(defentry XParseGeometry( ++ ++ object ;; parsestring ++ fixnum ;; x_return ++ fixnum ;; y_return ++ fixnum ;; width_return ++ fixnum ;; height_return ++ ++)( fixnum "XParseGeometry")) ++ ++ ++ ++(defentry XPeekEvent( ++ ++ fixnum ;; display ++ fixnum ;; event_return ++ ++)( void "XPeekEvent")) ++ ++ ++ ++ ++(defentry XPending( ++ ++ fixnum ;; display ++ ++)( fixnum "XPending")) ++ ++ ++ ++(defentry XPlanesOfScreen( ++ ++ fixnum ;; screen ++ ++ ++)( fixnum "XPlanesOfScreen")) ++ ++ ++ ++(defentry XProtocolRevision( ++ ++ fixnum ;; display ++ ++)( fixnum "XProtocolRevision")) ++ ++ ++ ++(defentry XProtocolVersion( ++ ++ fixnum ;; display ++ ++)( fixnum "XProtocolVersion")) ++ ++ ++ ++ ++(defentry XPutBackEvent( ++ ++ fixnum ;; display ++ fixnum ;; event ++ ++)( void "XPutBackEvent")) ++ ++ ++ ++(defentry XPutImage( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; image ++ fixnum ;; src_x ++ fixnum ;; src_y ++ fixnum ;; dest_x ++ fixnum ;; dest_y ++ fixnum ;; width ++ fixnum ;; height ++ ++)( void "XPutImage")) ++ ++ ++ ++(defentry XQLength( ++ ++ fixnum ;; display ++ ++)( fixnum "XQLength")) ++ ++ ++ ++(defentry XQueryBestCursor( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; width_return ++ fixnum ;; height_return ++ ++)( fixnum "XQueryBestCursor")) ++ ++ ++ ++(defentry XQueryBestSize( ++ ++ fixnum ;; display ++ fixnum ;; class ++ fixnum ;; which_screen ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; width_return ++ fixnum ;; height_return ++ ++)( fixnum "XQueryBestSize")) ++ ++ ++ ++(defentry XQueryBestStipple( ++ ++ fixnum ;; display ++ fixnum ;; which_screen ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; width_return ++ fixnum ;; height_return ++ ++)( fixnum "XQueryBestStipple")) ++ ++ ++ ++(defentry XQueryBestTile( ++ ++ fixnum ;; display ++ fixnum ;; which_screen ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; width_return ++ fixnum ;; height_return ++ ++)( fixnum "XQueryBestTile")) ++ ++ ++ ++(defentry XQueryColor( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; def_in_out ++ ++)( void "XQueryColor")) ++ ++ ++ ++(defentry XQueryColors( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; defs_in_out ++ fixnum ;; ncolors ++ ++)( void "XQueryColors")) ++ ++ ++ ++(defentry XQueryExtension( ++ ++ fixnum ;; display ++ object ;; name ++ fixnum ;; major_opcode_return ++ fixnum ;; first_event_return ++ fixnum ;; first_error_return ++ ++)( fixnum "XQueryExtension")) ++ ++ ++;;fix ++(defentry XQueryKeymap( ++ ++ fixnum ;; display ++ fixnum ;; keys_return ++ ++)( void "XQueryKeymap")) ++ ++ ++ ++(defentry XQueryPointer( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; root_return ++ fixnum ;; child_return ++ fixnum ;; root_x_return ++ fixnum ;; root_y_return ++ fixnum ;; win_x_return ++ fixnum ;; win_y_return ++ fixnum ;; mask_return ++ ++)( fixnum "XQueryPointer")) ++ ++ ++ ++(defentry XQueryTextExtents( ++ ++ fixnum ;; display ++ fixnum ;; font_ID ++ object ;; string ++ fixnum ;; nchars ++ fixnum ;; direction_return ++ fixnum ;; font_ascent_return ++ fixnum ;; font_descent_return ++ fixnum ;; overall_return ++ ++)( void "XQueryTextExtents")) ++ ++ ++ ++(defentry XQueryTextExtents16( ++ ++ fixnum ;; display ++ fixnum ;; font_ID ++ fixnum ;; string ++ fixnum ;; nchars ++ fixnum ;; direction_return ++ fixnum ;; font_ascent_return ++ fixnum ;; font_descent_return ++ fixnum ;; overall_return ++ ++)( void "XQueryTextExtents16")) ++ ++ ++ ++(defentry XQueryTree( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; root_return ++ fixnum ;; parent_return ++ fixnum ;; children_return ++ fixnum ;; nchildren_return ++ ++)( fixnum "XQueryTree")) ++ ++ ++ ++(defentry XRaiseWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XRaiseWindow")) ++ ++ ++ ++(defentry XReadBitmapFile( ++ ++ fixnum ;; display ++ fixnum ;; d ++ object ;; filename ++ fixnum ;; width_return ++ fixnum ;; height_return ++ fixnum ;; bitmap_return ++ fixnum ;; x_hot_return ++ fixnum ;; y_hot_return ++ ++)( fixnum "XReadBitmapFile")) ++ ++ ++ ++(defentry XRebindKeysym( ++ ++ fixnum ;; display ++ fixnum ;; keysym ++ fixnum ;; list ++ fixnum ;; mod_count ++ object ;; string ++ fixnum ;; bytes_string ++ ++)( void "XRebindKeysym")) ++ ++ ++ ++(defentry XRecolorCursor( ++ ++ fixnum ;; display ++ fixnum ;; cursor ++ fixnum ;; foreground_color ++ fixnum ;; background_color ++ ++)( void "XRecolorCursor")) ++ ++ ++ ++(defentry XRefreshKeyboardMapping( ++ ++ fixnum ;; event_map ++ ++)( void "XRefreshKeyboardMapping")) ++ ++ ++ ++(defentry XRemoveFromSaveSet( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XRemoveFromSaveSet")) ++ ++ ++ ++(defentry XRemoveHost( ++ ++ fixnum ;; display ++ fixnum ;; host ++ ++)( void "XRemoveHost")) ++ ++ ++ ++(defentry XRemoveHosts( ++ ++ fixnum ;; display ++ fixnum ;; hosts ++ fixnum ;; num_hosts ++ ++)( void "XRemoveHosts")) ++ ++ ++ ++(defentry XReparentWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; parent ++ fixnum ;; x ++ fixnum ;; y ++ ++)( void "XReparentWindow")) ++ ++ ++ ++(defentry XResetScreenSaver( ++ ++ fixnum ;; display ++ ++)( void "XResetScreenSaver")) ++ ++ ++ ++(defentry XResizeWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; width ++ fixnum ;; height ++ ++)( void "XResizeWindow")) ++ ++ ++ ++(defentry XRestackWindows( ++ ++ fixnum ;; display ++ fixnum ;; windows ++ fixnum ;; nwindows ++ ++)( void "XRestackWindows")) ++ ++ ++ ++(defentry XRotateBuffers( ++ ++ fixnum ;; display ++ fixnum ;; rotate ++ ++)( void "XRotateBuffers")) ++ ++ ++ ++(defentry XRotateWindowProperties( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; properties ++ fixnum ;; num_prop ++ fixnum ;; npositions ++ ++)( void "XRotateWindowProperties")) ++ ++ ++ ++(defentry XScreenCount( ++ ++ fixnum ;; display ++ ++)( fixnum "XScreenCount")) ++ ++ ++ ++(defentry XSelectInput( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; event_mask ++ ++)( void "XSelectInput")) ++ ++ ++ ++(defentry XSendEvent( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; propagate ++ fixnum ;; event_mask ++ fixnum ;; event_send ++ ++)( fixnum "XSendEvent")) ++ ++ ++ ++(defentry XSetAccessControl( ++ ++ fixnum ;; display ++ fixnum ;; mode ++ ++)( void "XSetAccessControl")) ++ ++ ++ ++(defentry XSetArcMode( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; arc_mode ++ ++)( void "XSetArcMode")) ++ ++ ++ ++(defentry XSetBackground( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; background ++ ++)( void "XSetBackground")) ++ ++ ++ ++(defentry XSetClipMask( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; fixnum ++ ++)( void "XSetClipMask")) ++ ++ ++ ++(defentry XSetClipOrigin( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; clip_x_origin ++ fixnum ;; clip_y_origin ++ ++)( void "XSetClipOrigin")) ++ ++ ++ ++(defentry XSetClipRectangles( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; clip_x_origin ++ fixnum ;; clip_y_origin ++ fixnum ;; rectangles ++ fixnum ;; n ++ fixnum ;; ordering ++ ++)( void "XSetClipRectangles")) ++ ++ ++ ++(defentry XSetCloseDownMode( ++ ++ fixnum ;; display ++ fixnum ;; close_mode ++ ++)( void "XSetCloseDownMode")) ++ ++ ++ ++(defentry XSetCommand( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; argv ++ fixnum ;; argc ++ ++)( void "XSetCommand")) ++ ++ ++ ++(defentry XSetDashes( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; dash_offset ++ object ;; dash_list ++ fixnum ;; n ++ ++)( void "XSetDashes")) ++ ++ ++ ++(defentry XSetFillRule( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; fill_rule ++ ++)( void "XSetFillRule")) ++ ++ ++ ++(defentry XSetFillStyle( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; fill_style ++ ++)( void "XSetFillStyle")) ++ ++ ++ ++(defentry XSetFont( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; font ++ ++)( void "XSetFont")) ++ ++ ++ ++(defentry XSetFontPath( ++ ++ fixnum ;; display ++ fixnum ;; directories ++ fixnum ;; ndirs ++ ++)( void "XSetFontPath")) ++ ++ ++ ++(defentry XSetForeground( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; foreground ++ ++)( void "XSetForeground")) ++ ++ ++ ++(defentry XSetFunction( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; function ++ ++)( void "XSetFunction")) ++ ++ ++ ++(defentry XSetGraphicsExposures( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; graphics_exposures ++ ++)( void "XSetGraphicsExposures")) ++ ++ ++ ++(defentry XSetIconName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ object ;; icon_name ++ ++)( void "XSetIconName")) ++ ++ ++ ++(defentry XSetInputFocus( ++ ++ fixnum ;; display ++ fixnum ;; focus ++ fixnum ;; revert_to ++ fixnum ;; fixnum ++ ++)( void "XSetInputFocus")) ++ ++ ++ ++(defentry XSetLineAttributes( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; line_width ++ fixnum ;; line_style ++ fixnum ;; cap_style ++ fixnum ;; join_style ++ ++)( void "XSetLineAttributes")) ++ ++ ++ ++(defentry XSetModifierMapping( ++ ++ fixnum ;; display ++ fixnum ;; modmap ++ ++)( fixnum "XSetModifierMapping")) ++ ++ ++ ++(defentry XSetPlaneMask( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; plane_mask ++ ++)( void "XSetPlaneMask")) ++ ++ ++ ++(defentry XSetPointerMapping( ++ ++ fixnum ;; display ++ object ;; map ++ fixnum ;; nmap ++ ++)( fixnum "XSetPointerMapping")) ++ ++ ++ ++(defentry XSetScreenSaver( ++ ++ fixnum ;; display ++ fixnum ;; intout ++ fixnum ;; interval ++ fixnum ;; prefer_blanking ++ fixnum ;; allow_exposures ++ ++)( void "XSetScreenSaver")) ++ ++ ++ ++(defentry XSetSelectionOwner( ++ ++ fixnum ;; display ++ fixnum ;; selection ++ fixnum ;; owner ++ fixnum ;; fixnum ++ ++)( void "XSetSelectionOwner")) ++ ++ ++ ++(defentry XSetState( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; foreground ++ fixnum ;; background ++ fixnum ;; function ++ fixnum ;; plane_mask ++ ++)( void "XSetState")) ++ ++ ++ ++(defentry XSetStipple( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; stipple ++ ++)( void "XSetStipple")) ++ ++ ++ ++(defentry XSetSubwindowMode( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; subwindow_mode ++ ++)( void "XSetSubwindowMode")) ++ ++ ++ ++(defentry XSetTSOrigin( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; ts_x_origin ++ fixnum ;; ts_y_origin ++ ++)( void "XSetTSOrigin")) ++ ++ ++ ++(defentry XSetTile( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; tile ++ ++)( void "XSetTile")) ++ ++ ++ ++(defentry XSetWindowBackground( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; background_pixel ++ ++)( void "XSetWindowBackground")) ++ ++ ++ ++(defentry XSetWindowBackgroundPixmap( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; background_pixmap ++ ++)( void "XSetWindowBackgroundPixmap")) ++ ++ ++ ++(defentry XSetWindowBorder( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; border_pixel ++ ++)( void "XSetWindowBorder")) ++ ++ ++ ++(defentry XSetWindowBorderPixmap( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; border_pixmap ++ ++)( void "XSetWindowBorderPixmap")) ++ ++ ++ ++(defentry XSetWindowBorderWidth( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; width ++ ++)( void "XSetWindowBorderWidth")) ++ ++ ++ ++(defentry XSetWindowColormap( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; colormap ++ ++)( void "XSetWindowColormap")) ++ ++ ++ ++(defentry XStoreBuffer( ++ ++ fixnum ;; display ++ object ;; bytes ++ fixnum ;; nbytes ++ fixnum ;; buffer ++ ++)( void "XStoreBuffer")) ++ ++ ++ ++(defentry XStoreBytes( ++ ++ fixnum ;; display ++ object ;; bytes ++ fixnum ;; nbytes ++ ++)( void "XStoreBytes")) ++ ++ ++ ++(defentry XStoreColor( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; color ++ ++)( void "XStoreColor")) ++ ++ ++ ++(defentry XStoreColors( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; color ++ fixnum ;; ncolors ++ ++)( void "XStoreColors")) ++ ++ ++ ++(defentry XStoreName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ object ;; window_name ++ ++)( void "XStoreName")) ++ ++ ++ ++(defentry XStoreNamedColor( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ object ;; color ++ fixnum ;; pixel ++ fixnum ;; flags ++ ++)( void "XStoreNamedColor")) ++ ++ ++ ++(defentry XSync( ++ ++ fixnum ;; display ++ fixnum ;; discard ++ ++)( void "XSync")) ++ ++ ++ ++(defentry XTextExtents( ++ ++ fixnum ;; font_struct ++ object ;; string ++ fixnum ;; nchars ++ fixnum ;; direction_return ++ fixnum ;; font_ascent_return ++ fixnum ;; font_descent_return ++ fixnum ;; overall_return ++ ++)( void "XTextExtents")) ++ ++ ++ ++(defentry XTextExtents16( ++ ++ fixnum ;; font_struct ++ fixnum ;; string ++ fixnum ;; nchars ++ fixnum ;; direction_return ++ fixnum ;; font_ascent_return ++ fixnum ;; font_descent_return ++ fixnum ;; overall_return ++ ++)( void "XTextExtents16")) ++ ++ ++ ++(defentry XTextWidth( ++ ++ fixnum ;; font_struct ++ object ;; string ++ fixnum ;; count ++ ++)( fixnum "XTextWidth")) ++ ++ ++ ++(defentry XTextWidth16( ++ ++ fixnum ;; font_struct ++ fixnum ;; string ++ fixnum ;; count ++ ++)( fixnum "XTextWidth16")) ++ ++ ++ ++(defentry XTranslateCoordinates( ++ ++ fixnum ;; display ++ fixnum ;; src_w ++ fixnum ;; dest_w ++ fixnum ;; src_x ++ fixnum ;; src_y ++ fixnum ;; dest_x_return ++ fixnum ;; dest_y_return ++ fixnum ;; child_return ++ ++)( fixnum "XTranslateCoordinates")) ++ ++ ++ ++(defentry XUndefineCursor( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XUndefineCursor")) ++ ++ ++ ++(defentry XUngrabButton( ++ ++ fixnum ;; display ++ fixnum ;; button ++ fixnum ;; modifiers ++ fixnum ;; grab_window ++ ++)( void "XUngrabButton")) ++ ++ ++ ++(defentry XUngrabKey( ++ ++ fixnum ;; display ++ fixnum ;; keycode ++ fixnum ;; modifiers ++ fixnum ;; grab_window ++ ++)( void "XUngrabKey")) ++ ++ ++ ++(defentry XUngrabKeyboard( ++ ++ fixnum ;; display ++ fixnum ;; fixnum ++ ++)( void "XUngrabKeyboard")) ++ ++ ++ ++(defentry XUngrabPointer( ++ ++ fixnum ;; display ++ fixnum ;; fixnum ++ ++)( void "XUngrabPointer")) ++ ++ ++ ++(defentry XUngrabServer( ++ ++ fixnum ;; display ++ ++)( void "XUngrabServer")) ++ ++ ++ ++(defentry XUninstallColormap( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ ++)( void "XUninstallColormap")) ++ ++ ++ ++(defentry XUnloadFont( ++ ++ fixnum ;; display ++ fixnum ;; font ++ ++)( void "XUnloadFont")) ++ ++ ++ ++(defentry XUnmapSubwindows( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XUnmapSubwindows")) ++ ++ ++ ++(defentry XUnmapWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XUnmapWindow")) ++ ++ ++ ++(defentry XVendorRelease( ++ ++ fixnum ;; display ++ ++)( fixnum "XVendorRelease")) ++ ++ ++ ++(defentry XWarpPointer( ++ ++ fixnum ;; display ++ fixnum ;; src_w ++ fixnum ;; dest_w ++ fixnum ;; src_x ++ fixnum ;; src_y ++ fixnum ;; src_width ++ fixnum ;; src_height ++ fixnum ;; dest_x ++ fixnum ;; dest_y ++ ++)( void "XWarpPointer")) ++ ++ ++ ++(defentry XWidthMMOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XWidthMMOfScreen")) ++ ++ ++ ++(defentry XWidthOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XWidthOfScreen")) ++ ++ ++ ++(defentry XWindowEvent( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; event_mask ++ fixnum ;; event_return ++ ++)( void "XWindowEvent")) ++ ++ ++ ++(defentry XWriteBitmapFile( ++ ++ fixnum ;; display ++ object ;; filename ++ fixnum ;; bitmap ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; x_hot ++ fixnum ;; y_hot ++ ++)( fixnum "XWriteBitmapFile")) ++ ++ ++ ++;;;;;;;;;problems ++ ++ ++ ++ ++;;(defentry fixnum (int Synchronize( ++ ++;; fixnum ;; display ++;; fixnum ;; onoff ++ ++;;))()()) ++;;(defentry fixnum (int SetAfterFunction( ++ ++;; fixnum ;; display ++;; fixnum (int ( fixnum ;; display ++;; ) ;; procedure ++ ++;;))()()) ++ ++ ++;;(defentry void XPeekIfEvent( ++ ++;; fixnum ;; display ++;; fixnum ;; event_return ++;; fixnum (int ( fixnum ;; display ++;; fixnum ;; event ++;; object ;; arg ++;; ) ;; predicate ++;; object ;; arg ++ ++;;)()) ++ ++;;(defentry fixnum XCheckIfEvent( ++ ++;; fixnum ;; display ++;; fixnum ;; event_return ++;; fixnum (int ( fixnum ;; display ++;; fixnum ;; event ++;; object ;; arg ++;; ) ;; predicate ++;; object ;; arg ++ ++;;)()) ++ ++;;(defentry void XIfEvent( ++ ++;; fixnum ;; display ++;; fixnum ;; event_return ++;; fixnum (int ( fixnum ;; display ++;; fixnum ;; event ++;; object ;; arg ++;; ) ;; predicate ++;; object ;; arg ++ ++;;)()) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_lispserver.lsp +@@ -0,0 +1,130 @@ ++; lispserver.lsp Gordon S. Novak Jr. ; 26 Jan 06 ++ ++; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; 06 Jun 02 ++ ++; See the file gnu.license . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++;------------------------------------------------------------------------ ++ ++; This is an example of a simple interactive graphical interface ++; to a Lisp program. It reads Lisp expressions from the user, ++; evaluates them, and prints the result. ++ ++; Stand-alone usage using XGCL (edit file paths as appropriate): ++; (load "/u/novak/X/xgcl-2/dwsyms.lsp") ++; (load "/u/novak/X/xgcl-2/dwimports.lsp") ++; (load "/u/novak/X/solaris/dwtrans.o") ++; (load "/u/novak/glisp/menu-settrans.lsp") ++; (load "/u/novak/glisp/lispservertrans.lsp") ++; (lisp-server) ++ ++; Usage with the WeirdX Java emulation of an X server begins with ++; the web page example.html and uses the files lispserver.cgi , ++; nph-lisp-action.cgi , and lispdemo.lsp . ++ ++;------------------------------------------------------------------------ ++ ++(defvar *wio-window* nil) ++(defvar *wio-window-width* 500) ++(defvar *wio-window-height* 300) ++(defvar *wio-menu-set* nil) ++(defvar *wio-font* '8x13) ++ ++(glispglobals (*wio-window* window) ++ (*wio-window-width* integer) ++ (*wio-window-height* integer) ++ (*wio-menu-set* menu-set) ) ++ ++(defmacro while (test &rest forms) ++ `(loop (unless ,test (return)) ,@forms) ) ++ ++; 18 Apr 95; 20 Apr 95; 08 May 95; 31 May 02 ++; Make a window to use. ++(setf (glfnresulttype 'wio-window) 'window) ++(defun wio-window (&optional title width height (posx 0) (posy 0) font) ++ (if width (setq *wio-window-width* width)) ++ (if height (setq *wio-window-height* height)) ++ (or *wio-window* ++ (setq *wio-window* ++ (window-create *wio-window-width* *wio-window-height* title ++ nil posx posy font))) ) ++ ++; 19 Apr 95 ++(defun wio-init-menus (w commands) ++ (let () ++ (window-clear w) ++ (setq *wio-menu-set* (menu-set-create w nil)) ++ (menu-set-add-menu *wio-menu-set* 'command nil "Commands" ++ commands (list 0 0)) ++ (menu-set-adjust *wio-menu-set* 'command 'top nil 2) ++ (menu-set-adjust *wio-menu-set* 'command 'right nil 2) ++ )) ++ ++; 19 Apr 95; 20 Apr 95; 25 Apr 95; 02 May 95; 29 May 02 ++; Lisp server example ++(gldefun lisp-server () ++ (let (w inputm done sel (redraw t) str result) ++ (w = (wio-window "Lisp Server")) ++ (open w) ++ (clear w) ++ (set-font w *wio-font*) ++ (wio-init-menus w '(("Quit" . quit))) ++ (window-print-lines w ++ '("Click mouse in the input box, then enter" ++ "a Lisp expression followed by Return." ++ "" ++ "Input: e.g. (+ 3 4) or (sqrt 2)") ++ 10 (- *wio-window-height* 20)) ++ (window-printat-xy w "Result:" 10 (- *wio-window-height* 150)) ++ (inputm = (textmenu-create (- *wio-window-width* 100) 30 nil w ++ 20 (- *wio-window-height* 110) t t '9x15 t)) ++ (add-item *wio-menu-set* 'input nil inputm) ++ (while ~ done do ++ (sel = (menu-set-select *wio-menu-set* redraw)) ++ (redraw = nil) ++ (case (menu-name sel) ++ (command ++ (case (port sel) ++ (quit (done = t)) ++ )) ++ (input (str = (port sel)) ++ (result = (catch 'error ++ (eval (safe-read-from-string str)))) ++ (erase-area-xy w 20 2 (- *wio-window-width* 20) ++ (- *wio-window-height* 160)) ++ (window-print-line w (write-to-string result :pretty t) ++ 20 (- *wio-window-height* 170))) ++ ) ) ++ (close w) ++ )) ++ ++; 25 Apr 95; 14 Mar 01 ++(defun safe-read-from-string (str) ++ (if (and (stringp str) (> (length str) 0)) ++ (read-from-string str nil 'read-error))) ++ ++(defun compile-lispserver () ++ (glcompfiles *directory* ++ '("glisp/vector.lsp") ; auxiliary files ++ '("glisp/lispserver.lsp") ; translated files ++ "glisp/lispservertrans.lsp") ; output file ++ ) +--- gcl-2.6.7.orig/xgcl-2/XStruct-4.c ++++ gcl-2.6.7/xgcl-2/XStruct-4.c +@@ -1,7 +1,7 @@ +-/* XStruct-4.c Hiep Huu Nguyen 27 Aug 92 */ ++/* XStruct-4.c Hiep Huu Nguyen 27 Jun 06 */ + + /* ; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. +- ++; edited 27 Aug 92; 12 Aug 2002 by G. Novak; 24 Jun 06 by GSN + ; See the files gnu.license and dec.copyright . + + ; This program is free software; you can redistribute it and/or modify +@@ -22,15 +22,15 @@ + ; See the file dec.copyright for details. */ + + #include ++#include + #include + #include + +-#include "include.h" + + /********* XExtCodes funcions *****/ + +-int make_XExtCodes (){ +- return ((int) calloc(1, sizeof(XExtCodes))); ++long make_XExtCodes (){ ++ return ((long) calloc(1, sizeof(XExtCodes))); + } + + int XExtCodes_first_error(i) +@@ -88,8 +88,8 @@ int j; + + /********* XPixmapFormatValues funcions *****/ + +-int make_XPixmapFormatValues (){ +- return ((int) calloc(1, sizeof(XPixmapFormatValues))); ++long make_XPixmapFormatValues (){ ++ return ((long) calloc(1, sizeof(XPixmapFormatValues))); + } + + int XPixmapFormatValues_scanline_pad(i) +@@ -134,8 +134,8 @@ int j; + + /********* XGCValues funcions *****/ + +-int make_XGCValues (){ +- return ((int) calloc(1, sizeof(XGCValues))); ++long make_XGCValues (){ ++ return ((long) calloc(1, sizeof(XGCValues))); + } + + char XGCValues_dashes(i) +@@ -527,8 +527,8 @@ int j; + + /********* Visual funcions *****/ + +-int make_Visual (){ +- return ((int) calloc(1, sizeof(Visual))); ++long make_Visual (){ ++ return ((long) calloc(1, sizeof(Visual))); + } + + int Visual_map_entries(i) +@@ -622,37 +622,37 @@ int j; + i->visualid = j; + } + +-XExtData *Visual_ext_data(i) ++long Visual_ext_data(i) + Visual* i; + { +- return(i->ext_data); ++ return((long) i->ext_data); + } + + void set_Visual_ext_data(i, j) + Visual* i; +-XExtData *j; ++long j; + { +- i->ext_data = j; ++ i->ext_data = (XExtData *) j; + } + + + /********* Depth funcions *****/ + +-int make_Depth (){ +- return ((int) calloc(1, sizeof(Depth))); ++long make_Depth (){ ++ return ((long) calloc(1, sizeof(Depth))); + } + +-Visual *Depth_visuals(i) ++long Depth_visuals(i) + Depth* i; + { +- return(i->visuals); ++ return((long) i->visuals); + } + + void set_Depth_visuals(i, j) + Depth* i; +-Visual *j; ++long j; + { +- i->visuals = j; ++ i->visuals = (Visual *) j; + } + + int Depth_nvisuals(i) +@@ -684,8 +684,8 @@ int j; + + /********* Screen funcions *****/ + +-int make_Screen (){ +- return ((int) calloc(1, sizeof(Screen))); ++long make_Screen (){ ++ return ((long) calloc(1, sizeof(Screen))); + } + + int Screen_root_input_mask(i) +@@ -792,30 +792,30 @@ int j; + i->cmap = j; + } + +-GC Screen_default_gc(i) ++long Screen_default_gc(i) + Screen* i; + { +- return(i->default_gc); ++ return((long) i->default_gc); + } + + void set_Screen_default_gc(i, j) + Screen* i; +-GC j; ++long j; + { +- i->default_gc = j; ++ i->default_gc = (GC) j; + } + +-Visual *Screen_root_visual(i) ++long Screen_root_visual(i) + Screen* i; + { +- return(i->root_visual); ++ return((long) i->root_visual); + } + + void set_Screen_root_visual(i, j) + Screen* i; +-Visual *j; ++long j; + { +- i->root_visual = j; ++ i->root_visual = (Visual *) j; + } + + int Screen_root_depth(i) +@@ -831,17 +831,17 @@ int j; + i->root_depth = j; + } + +-Depth *Screen_depths(i) ++long Screen_depths(i) + Screen* i; + { +- return(i->depths); ++ return((long) i->depths); + } + + void set_Screen_depths(i, j) + Screen* i; +-Depth *j; ++long j; + { +- i->depths = j; ++ i->depths = (Depth *) j; + } + + int Screen_ndepths(i) +@@ -922,37 +922,37 @@ int j; + i->root = j; + } + +-Display *Screen_display(i) ++long Screen_display(i) + Screen* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_Screen_display(i, j) + Screen* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (struct _XDisplay *) j; + } + +-XExtData *Screen_ext_data(i) ++long Screen_ext_data(i) + Screen* i; + { +- return(i->ext_data); ++ return((long) i->ext_data); + } + + void set_Screen_ext_data(i, j) + Screen* i; +-XExtData *j; ++long j; + { +- i->ext_data = j; ++ i->ext_data = (XExtData *) j; + } + + + /********* ScreenFormat funcions *****/ + +-int make_ScreenFormat (){ +- return ((int) calloc(1, sizeof(ScreenFormat))); ++long make_ScreenFormat (){ ++ return ((long) calloc(1, sizeof(ScreenFormat))); + } + + int ScreenFormat_scanline_pad(i) +@@ -994,24 +994,24 @@ int j; + i->depth = j; + } + +-XExtData *ScreenFormat_ext_data(i) ++long ScreenFormat_ext_data(i) + ScreenFormat* i; + { +- return(i->ext_data); ++ return((long) i->ext_data); + } + + void set_ScreenFormat_ext_data(i, j) + ScreenFormat* i; +-XExtData *j; ++long j; + { +- i->ext_data = j; ++ i->ext_data = (XExtData *) j; + } + + + /********* XSetWindowAttributes funcions *****/ + +-int make_XSetWindowAttributes (){ +- return ((int) calloc(1, sizeof(XSetWindowAttributes))); ++long make_XSetWindowAttributes (){ ++ return ((long) calloc(1, sizeof(XSetWindowAttributes))); + } + + int XSetWindowAttributes_cursor(i) +@@ -1212,21 +1212,21 @@ int j; + + /********* XWindowAttributes funcions *****/ + +-int make_XWindowAttributes (){ +- return ((int) calloc(1, sizeof(XWindowAttributes))); ++long make_XWindowAttributes (){ ++ return ((long) calloc(1, sizeof(XWindowAttributes))); + } + +-Screen *XWindowAttributes_screen(i) ++long XWindowAttributes_screen(i) + XWindowAttributes* i; + { +- return(i->screen); ++ return((long) i->screen); + } + + void set_XWindowAttributes_screen(i, j) + XWindowAttributes* i; +-Screen *j; ++long j; + { +- i->screen = j; ++ i->screen = (Screen *) j; + } + + int XWindowAttributes_override_redirect(i) +@@ -1424,17 +1424,17 @@ int j; + i->root = j; + } + +-Visual *XWindowAttributes_visual(i) ++long XWindowAttributes_visual(i) + XWindowAttributes* i; + { +- return(i->visual); ++ return((long) i->visual); + } + + void set_XWindowAttributes_visual(i, j) + XWindowAttributes* i; +-Visual *j; ++long j; + { +- i->visual = j; ++ i->visual = (Visual *) j; + } + + int XWindowAttributes_depth(i) +@@ -1518,21 +1518,21 @@ int j; + + /********* XHostAddress funcions *****/ + +-int make_XHostAddress (){ +- return ((int) calloc(1, sizeof(XHostAddress))); ++long make_XHostAddress (){ ++ return ((long) calloc(1, sizeof(XHostAddress))); + } + +-char *XHostAddress_address(i) ++long XHostAddress_address(i) + XHostAddress* i; + { +- return(i->address); ++ return((long) i->address); + } + + void set_XHostAddress_address(i, j) + XHostAddress* i; +-char *j; ++long j; + { +- i->address = j; ++ i->address = (char *) j; + } + + int XHostAddress_length(i) +@@ -1564,21 +1564,21 @@ int j; + + /********* XImage funcions *****/ + +-int make_XImage (){ +- return ((int) calloc(1, sizeof(XImage))); ++long make_XImage (){ ++ return ((long) calloc(1, sizeof(XImage))); + } + +-XPointer XImage_obdata(i) ++long XImage_obdata(i) + XImage* i; + { +- return(i->obdata); ++ return((long) i->obdata); + } + + void set_XImage_obdata(i, j) + XImage* i; +-XPointer j; ++long j; + { +- i->obdata = j; ++ i->obdata = (XPointer) j; + } + + int XImage_blue_mask(i) +@@ -1711,17 +1711,17 @@ int j; + i->byte_order = j; + } + +-char *XImage_data(i) ++long XImage_data(i) + XImage* i; + { +- return(i->data); ++ return((long) i->data); + } + + void set_XImage_data(i, j) + XImage* i; +-char *j; ++long j; + { +- i->data = j; ++ i->data = (char *) j; + } + + int XImage_format(i) +@@ -1779,8 +1779,8 @@ int j; + + /********* XWindowChanges funcions *****/ + +-int make_XWindowChanges (){ +- return ((int) calloc(1, sizeof(XWindowChanges))); ++long make_XWindowChanges (){ ++ return ((long) calloc(1, sizeof(XWindowChanges))); + } + + int XWindowChanges_stack_mode(i) +@@ -1877,8 +1877,8 @@ int j; + + /********* XColor funcions *****/ + +-int make_XColor (){ +- return ((int) calloc(1, sizeof(XColor))); ++long make_XColor (){ ++ return ((long) calloc(1, sizeof(XColor))); + } + + char XColor_pad(i) +@@ -1962,8 +1962,8 @@ int j; + + /********* XSegment funcions *****/ + +-int make_XSegment (){ +- return ((int) calloc(1, sizeof(XSegment))); ++long make_XSegment (){ ++ return ((long) calloc(1, sizeof(XSegment))); + } + + int XSegment_y2(i) +@@ -2021,8 +2021,8 @@ int j; + + /********* XPoint funcions *****/ + +-int make_XPoint (){ +- return ((int) calloc(1, sizeof(XPoint))); ++long make_XPoint (){ ++ return ((long) calloc(1, sizeof(XPoint))); + } + + int XPoint_y(i) +@@ -2054,8 +2054,8 @@ int j; + + /********* XRectangle funcions *****/ + +-int make_XRectangle (){ +- return ((int) calloc(1, sizeof(XRectangle))); ++long make_XRectangle (){ ++ return ((long) calloc(1, sizeof(XRectangle))); + } + + int XRectangle_height(i) +@@ -2113,8 +2113,8 @@ int j; + + /********* XArc funcions *****/ + +-int make_XArc (){ +- return ((int) calloc(1, sizeof(XArc))); ++long make_XArc (){ ++ return ((long) calloc(1, sizeof(XArc))); + } + + int XArc_angle2(i) +@@ -2198,8 +2198,8 @@ int j; + + /********* XKeyboardControl funcions *****/ + +-int make_XKeyboardControl (){ +- return ((int) calloc(1, sizeof(XKeyboardControl))); ++long make_XKeyboardControl (){ ++ return ((long) calloc(1, sizeof(XKeyboardControl))); + } + + int XKeyboardControl_auto_repeat_mode(i) +@@ -2309,8 +2309,8 @@ int j; + + /********* XKeyboardState funcions *****/ + +-int make_XKeyboardState (){ +- return ((int) calloc(1, sizeof(XKeyboardState))); ++long make_XKeyboardState (){ ++ return ((long) calloc(1, sizeof(XKeyboardState))); + } + + char *XKeyboardState_auto_repeats(i) +@@ -2407,8 +2407,8 @@ int j; + + /********* XTimeCoord funcions *****/ + +-int make_XTimeCoord (){ +- return ((int) calloc(1, sizeof(XTimeCoord))); ++long make_XTimeCoord (){ ++ return ((long) calloc(1, sizeof(XTimeCoord))); + } + + int XTimeCoord_y(i) +@@ -2453,21 +2453,21 @@ int j; + + /********* XModifierKeymap funcions *****/ + +-int make_XModifierKeymap (){ +- return ((int) calloc(1, sizeof(XModifierKeymap))); ++long make_XModifierKeymap (){ ++ return ((long) calloc(1, sizeof(XModifierKeymap))); + } + +-KeyCode *XModifierKeymap_modifiermap(i) ++long XModifierKeymap_modifiermap(i) + XModifierKeymap* i; + { +- return(i->modifiermap); ++ return((long) i->modifiermap); + } + + void set_XModifierKeymap_modifiermap(i, j) + XModifierKeymap* i; +-KeyCode *j; ++long j; + { +- i->modifiermap = j; ++ i->modifiermap = (KeyCode *) j; + } + + int XModifierKeymap_max_keypermod(i) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_XStruct_l_3.lsp +@@ -0,0 +1,491 @@ ++(in-package :XLIB) ++; XStruct-l-3.lsp modified by Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++ ++ ++ ++;;;;;; XExtCodes funcions ;;;;;; ++ ++(defentry make-XExtCodes () ( fixnum "make_XExtCodes" )) ++(defentry XExtCodes-first_error (fixnum) ( fixnum "XExtCodes_first_error" )) ++(defentry set-XExtCodes-first_error (fixnum fixnum) ( void "set_XExtCodes_first_error" )) ++(defentry XExtCodes-first_event (fixnum) ( fixnum "XExtCodes_first_event" )) ++(defentry set-XExtCodes-first_event (fixnum fixnum) ( void "set_XExtCodes_first_event" )) ++(defentry XExtCodes-major_opcode (fixnum) ( fixnum "XExtCodes_major_opcode" )) ++(defentry set-XExtCodes-major_opcode (fixnum fixnum) ( void "set_XExtCodes_major_opcode" )) ++(defentry XExtCodes-extension (fixnum) ( fixnum "XExtCodes_extension" )) ++(defentry set-XExtCodes-extension (fixnum fixnum) ( void "set_XExtCodes_extension" )) ++ ++ ++;;;;;; XPixmapFormatValues funcions ;;;;;; ++ ++(defentry make-XPixmapFormatValues () ( fixnum "make_XPixmapFormatValues" )) ++(defentry XPixmapFormatValues-scanline_pad (fixnum) ( fixnum "XPixmapFormatValues_scanline_pad" )) ++(defentry set-XPixmapFormatValues-scanline_pad (fixnum fixnum) ( void "set_XPixmapFormatValues_scanline_pad" )) ++(defentry XPixmapFormatValues-bits_per_pixel (fixnum) ( fixnum "XPixmapFormatValues_bits_per_pixel" )) ++(defentry set-XPixmapFormatValues-bits_per_pixel (fixnum fixnum) ( void "set_XPixmapFormatValues_bits_per_pixel" )) ++(defentry XPixmapFormatValues-depth (fixnum) ( fixnum "XPixmapFormatValues_depth" )) ++(defentry set-XPixmapFormatValues-depth (fixnum fixnum) ( void "set_XPixmapFormatValues_depth" )) ++ ++ ++;;;;;; XGCValues funcions ;;;;;; ++ ++(defentry make-XGCValues () ( fixnum "make_XGCValues" )) ++(defentry XGCValues-dashes (fixnum) ( char "XGCValues_dashes" )) ++(defentry set-XGCValues-dashes (fixnum char) ( void "set_XGCValues_dashes" )) ++(defentry XGCValues-dash_offset (fixnum) ( fixnum "XGCValues_dash_offset" )) ++(defentry set-XGCValues-dash_offset (fixnum fixnum) ( void "set_XGCValues_dash_offset" )) ++(defentry XGCValues-clip_mask (fixnum) ( fixnum "XGCValues_clip_mask" )) ++(defentry set-XGCValues-clip_mask (fixnum fixnum) ( void "set_XGCValues_clip_mask" )) ++(defentry XGCValues-clip_y_origin (fixnum) ( fixnum "XGCValues_clip_y_origin" )) ++(defentry set-XGCValues-clip_y_origin (fixnum fixnum) ( void "set_XGCValues_clip_y_origin" )) ++(defentry XGCValues-clip_x_origin (fixnum) ( fixnum "XGCValues_clip_x_origin" )) ++(defentry set-XGCValues-clip_x_origin (fixnum fixnum) ( void "set_XGCValues_clip_x_origin" )) ++(defentry XGCValues-graphics_exposures (fixnum) ( fixnum "XGCValues_graphics_exposures" )) ++(defentry set-XGCValues-graphics_exposures (fixnum fixnum) ( void "set_XGCValues_graphics_exposures" )) ++(defentry XGCValues-subwindow_mode (fixnum) ( fixnum "XGCValues_subwindow_mode" )) ++(defentry set-XGCValues-subwindow_mode (fixnum fixnum) ( void "set_XGCValues_subwindow_mode" )) ++(defentry XGCValues-font (fixnum) ( fixnum "XGCValues_font" )) ++(defentry set-XGCValues-font (fixnum fixnum) ( void "set_XGCValues_font" )) ++(defentry XGCValues-ts_y_origin (fixnum) ( fixnum "XGCValues_ts_y_origin" )) ++(defentry set-XGCValues-ts_y_origin (fixnum fixnum) ( void "set_XGCValues_ts_y_origin" )) ++(defentry XGCValues-ts_x_origin (fixnum) ( fixnum "XGCValues_ts_x_origin" )) ++(defentry set-XGCValues-ts_x_origin (fixnum fixnum) ( void "set_XGCValues_ts_x_origin" )) ++(defentry XGCValues-stipple (fixnum) ( fixnum "XGCValues_stipple" )) ++(defentry set-XGCValues-stipple (fixnum fixnum) ( void "set_XGCValues_stipple" )) ++(defentry XGCValues-tile (fixnum) ( fixnum "XGCValues_tile" )) ++(defentry set-XGCValues-tile (fixnum fixnum) ( void "set_XGCValues_tile" )) ++(defentry XGCValues-arc_mode (fixnum) ( fixnum "XGCValues_arc_mode" )) ++(defentry set-XGCValues-arc_mode (fixnum fixnum) ( void "set_XGCValues_arc_mode" )) ++(defentry XGCValues-fill_rule (fixnum) ( fixnum "XGCValues_fill_rule" )) ++(defentry set-XGCValues-fill_rule (fixnum fixnum) ( void "set_XGCValues_fill_rule" )) ++(defentry XGCValues-fill_style (fixnum) ( fixnum "XGCValues_fill_style" )) ++(defentry set-XGCValues-fill_style (fixnum fixnum) ( void "set_XGCValues_fill_style" )) ++(defentry XGCValues-join_style (fixnum) ( fixnum "XGCValues_join_style" )) ++(defentry set-XGCValues-join_style (fixnum fixnum) ( void "set_XGCValues_join_style" )) ++(defentry XGCValues-cap_style (fixnum) ( fixnum "XGCValues_cap_style" )) ++(defentry set-XGCValues-cap_style (fixnum fixnum) ( void "set_XGCValues_cap_style" )) ++(defentry XGCValues-line_style (fixnum) ( fixnum "XGCValues_line_style" )) ++(defentry set-XGCValues-line_style (fixnum fixnum) ( void "set_XGCValues_line_style" )) ++(defentry XGCValues-line_width (fixnum) ( fixnum "XGCValues_line_width" )) ++(defentry set-XGCValues-line_width (fixnum fixnum) ( void "set_XGCValues_line_width" )) ++(defentry XGCValues-background (fixnum) ( fixnum "XGCValues_background" )) ++(defentry set-XGCValues-background (fixnum fixnum) ( void "set_XGCValues_background" )) ++(defentry XGCValues-foreground (fixnum) ( fixnum "XGCValues_foreground" )) ++(defentry set-XGCValues-foreground (fixnum fixnum) ( void "set_XGCValues_foreground" )) ++(defentry XGCValues-plane_mask (fixnum) ( fixnum "XGCValues_plane_mask" )) ++(defentry set-XGCValues-plane_mask (fixnum fixnum) ( void "set_XGCValues_plane_mask" )) ++(defentry XGCValues-function (fixnum) ( fixnum "XGCValues_function" )) ++(defentry set-XGCValues-function (fixnum fixnum) ( void "set_XGCValues_function" )) ++ ++ ++;;;;;; *GC funcions ;;;;;; ++ ++;;(defentry make-*GC () ( fixnum "make_*GC" )) ++;;(defentry *GC-values (fixnum) ( fixnum "*GC_values" )) ++;;(defentry set-*GC-values (fixnum fixnum) ( void "set_*GC_values" )) ++;;(defentry *GC-dirty (fixnum) ( fixnum "*GC_dirty" )) ++;;(defentry set-*GC-dirty (fixnum fixnum) ( void "set_*GC_dirty" )) ++;;(defentry *GC-dashes (fixnum) ( fixnum "*GC_dashes" )) ++;;(defentry set-*GC-dashes (fixnum fixnum) ( void "set_*GC_dashes" )) ++;;(defentry *GC-rects (fixnum) ( fixnum "*GC_rects" )) ++;;(defentry set-*GC-rects (fixnum fixnum) ( void "set_*GC_rects" )) ++;;(defentry *GC-gid (fixnum) ( fixnum "*GC_gid" )) ++;;(defentry set-*GC-gid (fixnum fixnum) ( void "set_*GC_gid" )) ++;;(defentry *GC-ext_data (fixnum) ( fixnum "*GC_ext_data" )) ++;;(defentry set-*GC-ext_data (fixnum fixnum) ( void "set_*GC_ext_data" )) ++ ++ ++;;;;;; Visual funcions ;;;;;; ++ ++(defentry make-Visual () ( fixnum "make_Visual" )) ++(defentry Visual-map_entries (fixnum) ( fixnum "Visual_map_entries" )) ++(defentry set-Visual-map_entries (fixnum fixnum) ( void "set_Visual_map_entries" )) ++(defentry Visual-bits_per_rgb (fixnum) ( fixnum "Visual_bits_per_rgb" )) ++(defentry set-Visual-bits_per_rgb (fixnum fixnum) ( void "set_Visual_bits_per_rgb" )) ++(defentry Visual-blue_mask (fixnum) ( fixnum "Visual_blue_mask" )) ++(defentry set-Visual-blue_mask (fixnum fixnum) ( void "set_Visual_blue_mask" )) ++(defentry Visual-green_mask (fixnum) ( fixnum "Visual_green_mask" )) ++(defentry set-Visual-green_mask (fixnum fixnum) ( void "set_Visual_green_mask" )) ++(defentry Visual-red_mask (fixnum) ( fixnum "Visual_red_mask" )) ++(defentry set-Visual-red_mask (fixnum fixnum) ( void "set_Visual_red_mask" )) ++(defentry Visual-class (fixnum) ( fixnum "Visual_class" )) ++(defentry set-Visual-class (fixnum fixnum) ( void "set_Visual_class" )) ++(defentry Visual-visualid (fixnum) ( fixnum "Visual_visualid" )) ++(defentry set-Visual-visualid (fixnum fixnum) ( void "set_Visual_visualid" )) ++(defentry Visual-ext_data (fixnum) ( fixnum "Visual_ext_data" )) ++(defentry set-Visual-ext_data (fixnum fixnum) ( void "set_Visual_ext_data" )) ++ ++ ++;;;;;; Depth funcions ;;;;;; ++ ++(defentry make-Depth () ( fixnum "make_Depth" )) ++(defentry Depth-visuals (fixnum) ( fixnum "Depth_visuals" )) ++(defentry set-Depth-visuals (fixnum fixnum) ( void "set_Depth_visuals" )) ++(defentry Depth-nvisuals (fixnum) ( fixnum "Depth_nvisuals" )) ++(defentry set-Depth-nvisuals (fixnum fixnum) ( void "set_Depth_nvisuals" )) ++(defentry Depth-depth (fixnum) ( fixnum "Depth_depth" )) ++(defentry set-Depth-depth (fixnum fixnum) ( void "set_Depth_depth" )) ++ ++ ++;;;;;; Screen funcions ;;;;;; ++ ++(defentry make-Screen () ( fixnum "make_Screen" )) ++(defentry Screen-root_input_mask (fixnum) ( fixnum "Screen_root_input_mask" )) ++(defentry set-Screen-root_input_mask (fixnum fixnum) ( void "set_Screen_root_input_mask" )) ++(defentry Screen-save_unders (fixnum) ( fixnum "Screen_save_unders" )) ++(defentry set-Screen-save_unders (fixnum fixnum) ( void "set_Screen_save_unders" )) ++(defentry Screen-backing_store (fixnum) ( fixnum "Screen_backing_store" )) ++(defentry set-Screen-backing_store (fixnum fixnum) ( void "set_Screen_backing_store" )) ++(defentry Screen-min_maps (fixnum) ( fixnum "Screen_min_maps" )) ++(defentry set-Screen-min_maps (fixnum fixnum) ( void "set_Screen_min_maps" )) ++(defentry Screen-max_maps (fixnum) ( fixnum "Screen_max_maps" )) ++(defentry set-Screen-max_maps (fixnum fixnum) ( void "set_Screen_max_maps" )) ++(defentry Screen-black_pixel (fixnum) ( fixnum "Screen_black_pixel" )) ++(defentry set-Screen-black_pixel (fixnum fixnum) ( void "set_Screen_black_pixel" )) ++(defentry Screen-white_pixel (fixnum) ( fixnum "Screen_white_pixel" )) ++(defentry set-Screen-white_pixel (fixnum fixnum) ( void "set_Screen_white_pixel" )) ++(defentry Screen-cmap (fixnum) ( fixnum "Screen_cmap" )) ++(defentry set-Screen-cmap (fixnum fixnum) ( void "set_Screen_cmap" )) ++(defentry Screen-default_gc (fixnum) ( fixnum "Screen_default_gc" )) ++(defentry set-Screen-default_gc (fixnum fixnum) ( void "set_Screen_default_gc" )) ++(defentry Screen-root_visual (fixnum) ( fixnum "Screen_root_visual" )) ++(defentry set-Screen-root_visual (fixnum fixnum) ( void "set_Screen_root_visual" )) ++(defentry Screen-root_depth (fixnum) ( fixnum "Screen_root_depth" )) ++(defentry set-Screen-root_depth (fixnum fixnum) ( void "set_Screen_root_depth" )) ++(defentry Screen-depths (fixnum) ( fixnum "Screen_depths" )) ++(defentry set-Screen-depths (fixnum fixnum) ( void "set_Screen_depths" )) ++(defentry Screen-ndepths (fixnum) ( fixnum "Screen_ndepths" )) ++(defentry set-Screen-ndepths (fixnum fixnum) ( void "set_Screen_ndepths" )) ++(defentry Screen-mheight (fixnum) ( fixnum "Screen_mheight" )) ++(defentry set-Screen-mheight (fixnum fixnum) ( void "set_Screen_mheight" )) ++(defentry Screen-mwidth (fixnum) ( fixnum "Screen_mwidth" )) ++(defentry set-Screen-mwidth (fixnum fixnum) ( void "set_Screen_mwidth" )) ++(defentry Screen-height (fixnum) ( fixnum "Screen_height" )) ++(defentry set-Screen-height (fixnum fixnum) ( void "set_Screen_height" )) ++(defentry Screen-width (fixnum) ( fixnum "Screen_width" )) ++(defentry set-Screen-width (fixnum fixnum) ( void "set_Screen_width" )) ++(defentry Screen-root (fixnum) ( fixnum "Screen_root" )) ++(defentry set-Screen-root (fixnum fixnum) ( void "set_Screen_root" )) ++(defentry Screen-display (fixnum) ( fixnum "Screen_display" )) ++(defentry set-Screen-display (fixnum fixnum) ( void "set_Screen_display" )) ++(defentry Screen-ext_data (fixnum) ( fixnum "Screen_ext_data" )) ++(defentry set-Screen-ext_data (fixnum fixnum) ( void "set_Screen_ext_data" )) ++ ++ ++;;;;;; ScreenFormat funcions ;;;;;; ++ ++(defentry make-ScreenFormat () ( fixnum "make_ScreenFormat" )) ++(defentry ScreenFormat-scanline_pad (fixnum) ( fixnum "ScreenFormat_scanline_pad" )) ++(defentry set-ScreenFormat-scanline_pad (fixnum fixnum) ( void "set_ScreenFormat_scanline_pad" )) ++(defentry ScreenFormat-bits_per_pixel (fixnum) ( fixnum "ScreenFormat_bits_per_pixel" )) ++(defentry set-ScreenFormat-bits_per_pixel (fixnum fixnum) ( void "set_ScreenFormat_bits_per_pixel" )) ++(defentry ScreenFormat-depth (fixnum) ( fixnum "ScreenFormat_depth" )) ++(defentry set-ScreenFormat-depth (fixnum fixnum) ( void "set_ScreenFormat_depth" )) ++(defentry ScreenFormat-ext_data (fixnum) ( fixnum "ScreenFormat_ext_data" )) ++(defentry set-ScreenFormat-ext_data (fixnum fixnum) ( void "set_ScreenFormat_ext_data" )) ++ ++ ++;;;;;; XSetWindowAttributes funcions ;;;;;; ++ ++(defentry make-XSetWindowAttributes () ( fixnum "make_XSetWindowAttributes" )) ++(defentry XSetWindowAttributes-cursor (fixnum) ( fixnum "XSetWindowAttributes_cursor" )) ++(defentry set-XSetWindowAttributes-cursor (fixnum fixnum) ( void "set_XSetWindowAttributes_cursor" )) ++(defentry XSetWindowAttributes-colormap (fixnum) ( fixnum "XSetWindowAttributes_colormap" )) ++(defentry set-XSetWindowAttributes-colormap (fixnum fixnum) ( void "set_XSetWindowAttributes_colormap" )) ++(defentry XSetWindowAttributes-override_redirect (fixnum) ( fixnum "XSetWindowAttributes_override_redirect" )) ++(defentry set-XSetWindowAttributes-override_redirect (fixnum fixnum) ( void "set_XSetWindowAttributes_override_redirect" )) ++(defentry XSetWindowAttributes-do_not_propagate_mask (fixnum) ( fixnum "XSetWindowAttributes_do_not_propagate_mask" )) ++(defentry set-XSetWindowAttributes-do_not_propagate_mask (fixnum fixnum) ( void "set_XSetWindowAttributes_do_not_propagate_mask" )) ++(defentry XSetWindowAttributes-event_mask (fixnum) ( fixnum "XSetWindowAttributes_event_mask" )) ++(defentry set-XSetWindowAttributes-event_mask (fixnum fixnum) ( void "set_XSetWindowAttributes_event_mask" )) ++(defentry XSetWindowAttributes-save_under (fixnum) ( fixnum "XSetWindowAttributes_save_under" )) ++(defentry set-XSetWindowAttributes-save_under (fixnum fixnum) ( void "set_XSetWindowAttributes_save_under" )) ++(defentry XSetWindowAttributes-backing_pixel (fixnum) ( fixnum "XSetWindowAttributes_backing_pixel" )) ++(defentry set-XSetWindowAttributes-backing_pixel (fixnum fixnum) ( void "set_XSetWindowAttributes_backing_pixel" )) ++(defentry XSetWindowAttributes-backing_planes (fixnum) ( fixnum "XSetWindowAttributes_backing_planes" )) ++(defentry set-XSetWindowAttributes-backing_planes (fixnum fixnum) ( void "set_XSetWindowAttributes_backing_planes" )) ++(defentry XSetWindowAttributes-backing_store (fixnum) ( fixnum "XSetWindowAttributes_backing_store" )) ++(defentry set-XSetWindowAttributes-backing_store (fixnum fixnum) ( void "set_XSetWindowAttributes_backing_store" )) ++(defentry XSetWindowAttributes-win_gravity (fixnum) ( fixnum "XSetWindowAttributes_win_gravity" )) ++(defentry set-XSetWindowAttributes-win_gravity (fixnum fixnum) ( void "set_XSetWindowAttributes_win_gravity" )) ++(defentry XSetWindowAttributes-bit_gravity (fixnum) ( fixnum "XSetWindowAttributes_bit_gravity" )) ++(defentry set-XSetWindowAttributes-bit_gravity (fixnum fixnum) ( void "set_XSetWindowAttributes_bit_gravity" )) ++(defentry XSetWindowAttributes-border_pixel (fixnum) ( fixnum "XSetWindowAttributes_border_pixel" )) ++(defentry set-XSetWindowAttributes-border_pixel (fixnum fixnum) ( void "set_XSetWindowAttributes_border_pixel" )) ++(defentry XSetWindowAttributes-border_pixmap (fixnum) ( fixnum "XSetWindowAttributes_border_pixmap" )) ++(defentry set-XSetWindowAttributes-border_pixmap (fixnum fixnum) ( void "set_XSetWindowAttributes_border_pixmap" )) ++(defentry XSetWindowAttributes-background_pixel (fixnum) ( fixnum "XSetWindowAttributes_background_pixel" )) ++(defentry set-XSetWindowAttributes-background_pixel (fixnum fixnum) ( void "set_XSetWindowAttributes_background_pixel" )) ++(defentry XSetWindowAttributes-background_pixmap (fixnum) ( fixnum "XSetWindowAttributes_background_pixmap" )) ++(defentry set-XSetWindowAttributes-background_pixmap (fixnum fixnum) ( void "set_XSetWindowAttributes_background_pixmap" )) ++ ++ ++;;;;;; XWindowAttributes funcions ;;;;;; ++ ++(defentry make-XWindowAttributes () ( fixnum "make_XWindowAttributes" )) ++(defentry XWindowAttributes-screen (fixnum) ( fixnum "XWindowAttributes_screen" )) ++(defentry set-XWindowAttributes-screen (fixnum fixnum) ( void "set_XWindowAttributes_screen" )) ++(defentry XWindowAttributes-override_redirect (fixnum) ( fixnum "XWindowAttributes_override_redirect" )) ++(defentry set-XWindowAttributes-override_redirect (fixnum fixnum) ( void "set_XWindowAttributes_override_redirect" )) ++(defentry XWindowAttributes-do_not_propagate_mask (fixnum) ( fixnum "XWindowAttributes_do_not_propagate_mask" )) ++(defentry set-XWindowAttributes-do_not_propagate_mask (fixnum fixnum) ( void "set_XWindowAttributes_do_not_propagate_mask" )) ++(defentry XWindowAttributes-your_event_mask (fixnum) ( fixnum "XWindowAttributes_your_event_mask" )) ++(defentry set-XWindowAttributes-your_event_mask (fixnum fixnum) ( void "set_XWindowAttributes_your_event_mask" )) ++(defentry XWindowAttributes-all_event_masks (fixnum) ( fixnum "XWindowAttributes_all_event_masks" )) ++(defentry set-XWindowAttributes-all_event_masks (fixnum fixnum) ( void "set_XWindowAttributes_all_event_masks" )) ++(defentry XWindowAttributes-map_state (fixnum) ( fixnum "XWindowAttributes_map_state" )) ++(defentry set-XWindowAttributes-map_state (fixnum fixnum) ( void "set_XWindowAttributes_map_state" )) ++(defentry XWindowAttributes-map_installed (fixnum) ( fixnum "XWindowAttributes_map_installed" )) ++(defentry set-XWindowAttributes-map_installed (fixnum fixnum) ( void "set_XWindowAttributes_map_installed" )) ++(defentry XWindowAttributes-colormap (fixnum) ( fixnum "XWindowAttributes_colormap" )) ++(defentry set-XWindowAttributes-colormap (fixnum fixnum) ( void "set_XWindowAttributes_colormap" )) ++(defentry XWindowAttributes-save_under (fixnum) ( fixnum "XWindowAttributes_save_under" )) ++(defentry set-XWindowAttributes-save_under (fixnum fixnum) ( void "set_XWindowAttributes_save_under" )) ++(defentry XWindowAttributes-backing_pixel (fixnum) ( fixnum "XWindowAttributes_backing_pixel" )) ++(defentry set-XWindowAttributes-backing_pixel (fixnum fixnum) ( void "set_XWindowAttributes_backing_pixel" )) ++(defentry XWindowAttributes-backing_planes (fixnum) ( fixnum "XWindowAttributes_backing_planes" )) ++(defentry set-XWindowAttributes-backing_planes (fixnum fixnum) ( void "set_XWindowAttributes_backing_planes" )) ++(defentry XWindowAttributes-backing_store (fixnum) ( fixnum "XWindowAttributes_backing_store" )) ++(defentry set-XWindowAttributes-backing_store (fixnum fixnum) ( void "set_XWindowAttributes_backing_store" )) ++(defentry XWindowAttributes-win_gravity (fixnum) ( fixnum "XWindowAttributes_win_gravity" )) ++(defentry set-XWindowAttributes-win_gravity (fixnum fixnum) ( void "set_XWindowAttributes_win_gravity" )) ++(defentry XWindowAttributes-bit_gravity (fixnum) ( fixnum "XWindowAttributes_bit_gravity" )) ++(defentry set-XWindowAttributes-bit_gravity (fixnum fixnum) ( void "set_XWindowAttributes_bit_gravity" )) ++(defentry XWindowAttributes-class (fixnum) ( fixnum "XWindowAttributes_class" )) ++(defentry set-XWindowAttributes-class (fixnum fixnum) ( void "set_XWindowAttributes_class" )) ++(defentry XWindowAttributes-root (fixnum) ( fixnum "XWindowAttributes_root" )) ++(defentry set-XWindowAttributes-root (fixnum fixnum) ( void "set_XWindowAttributes_root" )) ++(defentry XWindowAttributes-visual (fixnum) ( fixnum "XWindowAttributes_visual" )) ++(defentry set-XWindowAttributes-visual (fixnum fixnum) ( void "set_XWindowAttributes_visual" )) ++(defentry XWindowAttributes-depth (fixnum) ( fixnum "XWindowAttributes_depth" )) ++(defentry set-XWindowAttributes-depth (fixnum fixnum) ( void "set_XWindowAttributes_depth" )) ++(defentry XWindowAttributes-border_width (fixnum) ( fixnum "XWindowAttributes_border_width" )) ++(defentry set-XWindowAttributes-border_width (fixnum fixnum) ( void "set_XWindowAttributes_border_width" )) ++(defentry XWindowAttributes-height (fixnum) ( fixnum "XWindowAttributes_height" )) ++(defentry set-XWindowAttributes-height (fixnum fixnum) ( void "set_XWindowAttributes_height" )) ++(defentry XWindowAttributes-width (fixnum) ( fixnum "XWindowAttributes_width" )) ++(defentry set-XWindowAttributes-width (fixnum fixnum) ( void "set_XWindowAttributes_width" )) ++(defentry XWindowAttributes-y (fixnum) ( fixnum "XWindowAttributes_y" )) ++(defentry set-XWindowAttributes-y (fixnum fixnum) ( void "set_XWindowAttributes_y" )) ++(defentry XWindowAttributes-x (fixnum) ( fixnum "XWindowAttributes_x" )) ++(defentry set-XWindowAttributes-x (fixnum fixnum) ( void "set_XWindowAttributes_x" )) ++ ++ ++;;;;;; XHostAddress funcions ;;;;;; ++ ++(defentry make-XHostAddress () ( fixnum "make_XHostAddress" )) ++(defentry XHostAddress-address (fixnum) ( fixnum "XHostAddress_address" )) ++(defentry set-XHostAddress-address (fixnum fixnum) ( void "set_XHostAddress_address" )) ++(defentry XHostAddress-length (fixnum) ( fixnum "XHostAddress_length" )) ++(defentry set-XHostAddress-length (fixnum fixnum) ( void "set_XHostAddress_length" )) ++(defentry XHostAddress-family (fixnum) ( fixnum "XHostAddress_family" )) ++(defentry set-XHostAddress-family (fixnum fixnum) ( void "set_XHostAddress_family" )) ++ ++ ++;;;;;; XImage funcions ;;;;;; ++ ++(defentry make-XImage () ( fixnum "make_XImage" )) ++;;(defentry XImage-f (fixnum) ( fixnum "XImage_f" )) ++;;(defentry set-XImage-f (fixnum fixnum) ( void "set_XImage_f" )) ++(defentry XImage-obdata (fixnum) ( fixnum "XImage_obdata" )) ++(defentry set-XImage-obdata (fixnum fixnum) ( void "set_XImage_obdata" )) ++(defentry XImage-blue_mask (fixnum) ( fixnum "XImage_blue_mask" )) ++(defentry set-XImage-blue_mask (fixnum fixnum) ( void "set_XImage_blue_mask" )) ++(defentry XImage-green_mask (fixnum) ( fixnum "XImage_green_mask" )) ++(defentry set-XImage-green_mask (fixnum fixnum) ( void "set_XImage_green_mask" )) ++(defentry XImage-red_mask (fixnum) ( fixnum "XImage_red_mask" )) ++(defentry set-XImage-red_mask (fixnum fixnum) ( void "set_XImage_red_mask" )) ++(defentry XImage-bits_per_pixel (fixnum) ( fixnum "XImage_bits_per_pixel" )) ++(defentry set-XImage-bits_per_pixel (fixnum fixnum) ( void "set_XImage_bits_per_pixel" )) ++(defentry XImage-bytes_per_line (fixnum) ( fixnum "XImage_bytes_per_line" )) ++(defentry set-XImage-bytes_per_line (fixnum fixnum) ( void "set_XImage_bytes_per_line" )) ++(defentry XImage-depth (fixnum) ( fixnum "XImage_depth" )) ++(defentry set-XImage-depth (fixnum fixnum) ( void "set_XImage_depth" )) ++(defentry XImage-bitmap_pad (fixnum) ( fixnum "XImage_bitmap_pad" )) ++(defentry set-XImage-bitmap_pad (fixnum fixnum) ( void "set_XImage_bitmap_pad" )) ++(defentry XImage-bitmap_bit_order (fixnum) ( fixnum "XImage_bitmap_bit_order" )) ++(defentry set-XImage-bitmap_bit_order (fixnum fixnum) ( void "set_XImage_bitmap_bit_order" )) ++(defentry XImage-bitmap_unit (fixnum) ( fixnum "XImage_bitmap_unit" )) ++(defentry set-XImage-bitmap_unit (fixnum fixnum) ( void "set_XImage_bitmap_unit" )) ++(defentry XImage-byte_order (fixnum) ( fixnum "XImage_byte_order" )) ++(defentry set-XImage-byte_order (fixnum fixnum) ( void "set_XImage_byte_order" )) ++(defentry XImage-data (fixnum) ( fixnum "XImage_data" )) ++(defentry set-XImage-data (fixnum fixnum) ( void "set_XImage_data" )) ++(defentry XImage-format (fixnum) ( fixnum "XImage_format" )) ++(defentry set-XImage-format (fixnum fixnum) ( void "set_XImage_format" )) ++(defentry XImage-xoffset (fixnum) ( fixnum "XImage_xoffset" )) ++(defentry set-XImage-xoffset (fixnum fixnum) ( void "set_XImage_xoffset" )) ++(defentry XImage-height (fixnum) ( fixnum "XImage_height" )) ++(defentry set-XImage-height (fixnum fixnum) ( void "set_XImage_height" )) ++(defentry XImage-width (fixnum) ( fixnum "XImage_width" )) ++(defentry set-XImage-width (fixnum fixnum) ( void "set_XImage_width" )) ++ ++ ++;;;;;; XWindowChanges funcions ;;;;;; ++ ++(defentry make-XWindowChanges () ( fixnum "make_XWindowChanges" )) ++(defentry XWindowChanges-stack_mode (fixnum) ( fixnum "XWindowChanges_stack_mode" )) ++(defentry set-XWindowChanges-stack_mode (fixnum fixnum) ( void "set_XWindowChanges_stack_mode" )) ++(defentry XWindowChanges-sibling (fixnum) ( fixnum "XWindowChanges_sibling" )) ++(defentry set-XWindowChanges-sibling (fixnum fixnum) ( void "set_XWindowChanges_sibling" )) ++(defentry XWindowChanges-border_width (fixnum) ( fixnum "XWindowChanges_border_width" )) ++(defentry set-XWindowChanges-border_width (fixnum fixnum) ( void "set_XWindowChanges_border_width" )) ++(defentry XWindowChanges-height (fixnum) ( fixnum "XWindowChanges_height" )) ++(defentry set-XWindowChanges-height (fixnum fixnum) ( void "set_XWindowChanges_height" )) ++(defentry XWindowChanges-width (fixnum) ( fixnum "XWindowChanges_width" )) ++(defentry set-XWindowChanges-width (fixnum fixnum) ( void "set_XWindowChanges_width" )) ++(defentry XWindowChanges-y (fixnum) ( fixnum "XWindowChanges_y" )) ++(defentry set-XWindowChanges-y (fixnum fixnum) ( void "set_XWindowChanges_y" )) ++(defentry XWindowChanges-x (fixnum) ( fixnum "XWindowChanges_x" )) ++(defentry set-XWindowChanges-x (fixnum fixnum) ( void "set_XWindowChanges_x" )) ++ ++ ++;;;;;; XColor funcions ;;;;;; ++ ++(defentry make-XColor () ( fixnum "make_XColor" )) ++(defentry XColor-pad (fixnum) ( char "XColor_pad" )) ++(defentry set-XColor-pad (fixnum char) ( void "set_XColor_pad" )) ++(defentry XColor-flags (fixnum) ( char "XColor_flags" )) ++(defentry set-XColor-flags (fixnum char) ( void "set_XColor_flags" )) ++(defentry XColor-blue (fixnum) ( fixnum "XColor_blue" )) ++(defentry set-XColor-blue (fixnum fixnum) ( void "set_XColor_blue" )) ++(defentry XColor-green (fixnum) ( fixnum "XColor_green" )) ++(defentry set-XColor-green (fixnum fixnum) ( void "set_XColor_green" )) ++(defentry XColor-red (fixnum) ( fixnum "XColor_red" )) ++(defentry set-XColor-red (fixnum fixnum) ( void "set_XColor_red" )) ++(defentry XColor-pixel (fixnum) ( fixnum "XColor_pixel" )) ++(defentry set-XColor-pixel (fixnum fixnum) ( void "set_XColor_pixel" )) ++ ++ ++;;;;;; XSegment funcions ;;;;;; ++ ++(defentry make-XSegment () ( fixnum "make_XSegment" )) ++(defentry XSegment-y2 (fixnum) ( fixnum "XSegment_y2" )) ++(defentry set-XSegment-y2 (fixnum fixnum) ( void "set_XSegment_y2" )) ++(defentry XSegment-x2 (fixnum) ( fixnum "XSegment_x2" )) ++(defentry set-XSegment-x2 (fixnum fixnum) ( void "set_XSegment_x2" )) ++(defentry XSegment-y1 (fixnum) ( fixnum "XSegment_y1" )) ++(defentry set-XSegment-y1 (fixnum fixnum) ( void "set_XSegment_y1" )) ++(defentry XSegment-x1 (fixnum) ( fixnum "XSegment_x1" )) ++(defentry set-XSegment-x1 (fixnum fixnum) ( void "set_XSegment_x1" )) ++ ++ ++;;;;;; XPoint funcions ;;;;;; ++ ++(defentry make-XPoint () ( fixnum "make_XPoint" )) ++(defentry XPoint-y (fixnum) ( fixnum "XPoint_y" )) ++(defentry set-XPoint-y (fixnum fixnum) ( void "set_XPoint_y" )) ++(defentry XPoint-x (fixnum) ( fixnum "XPoint_x" )) ++(defentry set-XPoint-x (fixnum fixnum) ( void "set_XPoint_x" )) ++ ++ ++;;;;;; XRectangle funcions ;;;;;; ++ ++(defentry make-XRectangle () ( fixnum "make_XRectangle" )) ++(defentry XRectangle-height (fixnum) ( fixnum "XRectangle_height" )) ++(defentry set-XRectangle-height (fixnum fixnum) ( void "set_XRectangle_height" )) ++(defentry XRectangle-width (fixnum) ( fixnum "XRectangle_width" )) ++(defentry set-XRectangle-width (fixnum fixnum) ( void "set_XRectangle_width" )) ++(defentry XRectangle-y (fixnum) ( fixnum "XRectangle_y" )) ++(defentry set-XRectangle-y (fixnum fixnum) ( void "set_XRectangle_y" )) ++(defentry XRectangle-x (fixnum) ( fixnum "XRectangle_x" )) ++(defentry set-XRectangle-x (fixnum fixnum) ( void "set_XRectangle_x" )) ++ ++ ++;;;;;; XArc funcions ;;;;;; ++ ++(defentry make-XArc () ( fixnum "make_XArc" )) ++(defentry XArc-angle2 (fixnum) ( fixnum "XArc_angle2" )) ++(defentry set-XArc-angle2 (fixnum fixnum) ( void "set_XArc_angle2" )) ++(defentry XArc-angle1 (fixnum) ( fixnum "XArc_angle1" )) ++(defentry set-XArc-angle1 (fixnum fixnum) ( void "set_XArc_angle1" )) ++(defentry XArc-height (fixnum) ( fixnum "XArc_height" )) ++(defentry set-XArc-height (fixnum fixnum) ( void "set_XArc_height" )) ++(defentry XArc-width (fixnum) ( fixnum "XArc_width" )) ++(defentry set-XArc-width (fixnum fixnum) ( void "set_XArc_width" )) ++(defentry XArc-y (fixnum) ( fixnum "XArc_y" )) ++(defentry set-XArc-y (fixnum fixnum) ( void "set_XArc_y" )) ++(defentry XArc-x (fixnum) ( fixnum "XArc_x" )) ++(defentry set-XArc-x (fixnum fixnum) ( void "set_XArc_x" )) ++ ++ ++;;;;;; XKeyboardControl funcions ;;;;;; ++ ++(defentry make-XKeyboardControl () ( fixnum "make_XKeyboardControl" )) ++(defentry XKeyboardControl-auto_repeat_mode (fixnum) ( fixnum "XKeyboardControl_auto_repeat_mode" )) ++;;(defentry set-XKeyboardControl-auto_repeat_mode (fixnum fixnum) ( void "set_XKeyboardControl_auto_repeat_mode" )) ++(defentry XKeyboardControl-key (fixnum) ( fixnum "XKeyboardControl_key" )) ++(defentry set-XKeyboardControl-key (fixnum fixnum) ( void "set_XKeyboardControl_key" )) ++(defentry XKeyboardControl-led_mode (fixnum) ( fixnum "XKeyboardControl_led_mode" )) ++(defentry set-XKeyboardControl-led_mode (fixnum fixnum) ( void "set_XKeyboardControl_led_mode" )) ++(defentry XKeyboardControl-led (fixnum) ( fixnum "XKeyboardControl_led" )) ++(defentry set-XKeyboardControl-led (fixnum fixnum) ( void "set_XKeyboardControl_led" )) ++(defentry XKeyboardControl-bell_duration (fixnum) ( fixnum "XKeyboardControl_bell_duration" )) ++(defentry set-XKeyboardControl-bell_duration (fixnum fixnum) ( void "set_XKeyboardControl_bell_duration" )) ++(defentry XKeyboardControl-bell_pitch (fixnum) ( fixnum "XKeyboardControl_bell_pitch" )) ++(defentry set-XKeyboardControl-bell_pitch (fixnum fixnum) ( void "set_XKeyboardControl_bell_pitch" )) ++(defentry XKeyboardControl-bell_percent (fixnum) ( fixnum "XKeyboardControl_bell_percent" )) ++(defentry set-XKeyboardControl-bell_percent (fixnum fixnum) ( void "set_XKeyboardControl_bell_percent" )) ++(defentry XKeyboardControl-key_click_percent (fixnum) ( fixnum "XKeyboardControl_key_click_percent" )) ++(defentry set-XKeyboardControl-key_click_percent (fixnum fixnum) ( void "set_XKeyboardControl_key_click_percent" )) ++ ++ ++;;;;;; XKeyboardState funcions ;;;;;; ++ ++(defentry make-XKeyboardState () ( fixnum "make_XKeyboardState" )) ++(defentry XKeyboardState-auto_repeats (fixnum) ( fixnum "XKeyboardState_auto_repeats" )) ++(defentry set-XKeyboardState-auto_repeats (fixnum object) ( void "set_XKeyboardState_auto_repeats" )) ++(defentry XKeyboardState-global_auto_repeat (fixnum) ( fixnum "XKeyboardState_global_auto_repeat" )) ++(defentry set-XKeyboardState-global_auto_repeat (fixnum fixnum) ( void "set_XKeyboardState_global_auto_repeat" )) ++(defentry XKeyboardState-led_mask (fixnum) ( fixnum "XKeyboardState_led_mask" )) ++(defentry set-XKeyboardState-led_mask (fixnum fixnum) ( void "set_XKeyboardState_led_mask" )) ++(defentry XKeyboardState-bell_duration (fixnum) ( fixnum "XKeyboardState_bell_duration" )) ++(defentry set-XKeyboardState-bell_duration (fixnum fixnum) ( void "set_XKeyboardState_bell_duration" )) ++(defentry XKeyboardState-bell_pitch (fixnum) ( fixnum "XKeyboardState_bell_pitch" )) ++(defentry set-XKeyboardState-bell_pitch (fixnum fixnum) ( void "set_XKeyboardState_bell_pitch" )) ++(defentry XKeyboardState-bell_percent (fixnum) ( fixnum "XKeyboardState_bell_percent" )) ++(defentry set-XKeyboardState-bell_percent (fixnum fixnum) ( void "set_XKeyboardState_bell_percent" )) ++(defentry XKeyboardState-key_click_percent (fixnum) ( fixnum "XKeyboardState_key_click_percent" )) ++(defentry set-XKeyboardState-key_click_percent (fixnum fixnum) ( void "set_XKeyboardState_key_click_percent" )) ++ ++ ++;;;;;; XTimeCoord funcions ;;;;;; ++ ++(defentry make-XTimeCoord () ( fixnum "make_XTimeCoord" )) ++(defentry XTimeCoord-y (fixnum) ( fixnum "XTimeCoord_y" )) ++(defentry set-XTimeCoord-y (fixnum fixnum) ( void "set_XTimeCoord_y" )) ++(defentry XTimeCoord-x (fixnum) ( fixnum "XTimeCoord_x" )) ++(defentry set-XTimeCoord-x (fixnum fixnum) ( void "set_XTimeCoord_x" )) ++(defentry XTimeCoord-time (fixnum) ( fixnum "XTimeCoord_time" )) ++(defentry set-XTimeCoord-time (fixnum fixnum) ( void "set_XTimeCoord_time" )) ++ ++ ++;;;;;; XModifierKeymap funcions ;;;;;; ++ ++(defentry make-XModifierKeymap () ( fixnum "make_XModifierKeymap" )) ++(defentry XModifierKeymap-modifiermap (fixnum) ( fixnum "XModifierKeymap_modifiermap" )) ++(defentry set-XModifierKeymap-modifiermap (fixnum fixnum) ( void "set_XModifierKeymap_modifiermap" )) ++(defentry XModifierKeymap-max_keypermod (fixnum) ( fixnum "XModifierKeymap_max_keypermod" )) ++(defentry set-XModifierKeymap-max_keypermod (fixnum fixnum) ( void "set_XModifierKeymap_max_keypermod" )) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_dwtest.lsp +@@ -0,0 +1,192 @@ ++; dwtest.lsp Gordon S. Novak Jr. 10 Jan 96 ++ ++; Some examples for testing the window interface in dwindow.lsp / dwtrans.lsp ++ ++; Copyright (c) 1996 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; See the file gnu.license . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++(use-package :xlib) ++(defun user::xgcl-demo nil ++ (wtesta) ++ (wtestb) ++ (format t "Try (wtestc) ... (wtestk) for more examples.")) ++ ++(defmacro while (test &rest forms) ++ `(loop (unless ,test (return)) ,@forms) ) ++ ++(defvar *myw*) ; my window ++(defvar myw) ++ ++; Make a window to play in. ++(defun wtesta () ++ (setq myw (setq *myw* (window-create 300 300 "test window"))) ) ++ ++; 15 Aug 91; 12 Sep 91; 05 Oct 94; 06 Oct 94 ++; Draw some basic things in the window ++(defun wtestb () ++ (window-clear *myw*) ++ (window-draw-box-xy *myw* 50 50 50 20 1) ++ (window-printat *myw* "howdy" '(58 55)) ++ (window-draw-line *myw* '(100 70) '(200 170)) ++ (window-draw-arrow-xy *myw* 200 170 165 205) ++ (window-draw-circle-xy *myw* 200 170 50 2) ++ (window-draw-ellipse-xy *myw* 100 170 40 20 1) ++ (window-printat-xy *myw* "ellipse" 70 165) ++ (window-draw-arc-xy *myw* 100 250 20 20 0 90 1) ++ (window-draw-arc-xy *myw* 100 250 20 20 0 -90 1) ++ (window-printat-xy *myw* "arcs" 80 244) ++ (window-printat-xy *myw* "invert" 54 200) ++ (window-invert-area-xy *myw* 50 160 60 60) ++ (window-copy-area-xy *myw* 40 150 200 50 60 40) ++ (window-printat-xy *myw* "copy" 210 100) ++ (window-set-color-rgb *myw* 65535 0 0) ; red foreground ++ (window-printat-xy *myw* "Red" 20 20) ++ (window-draw-rcbox-xy *myw* 15 15 32 20 5) ++ (window-set-color-rgb *myw* 0 0 65535 t) ; blue background ++ (window-set-color-rgb *myw* 0 65535 0) ; green foreground ++ (window-printat-xy *myw* "Green" 120 20) ++ (window-set-color-rgb *myw* 0 65535 0 t) ; green background ++ (window-set-color-rgb *myw* 0 0 65535) ; blue foreground ++ (window-printat-xy *myw* "Blue" 220 20) ++ (window-reset-color *myw*) ++ (window-force-output *myw*) ) ++ ++; 15 Aug 91; 19 Aug 91; 03 Sep 91; 21 Apr 95 ++; Illustrate mouse interaction: ++; click in window *myw* (2 times for line, 3 times for region). ++(defun wtestc () ++ (let (mymenu result start done) ++ (setq mymenu (menu-create '(quit point line box region) "Choose One:")) ++ (while (not done) ++ (setq result ++ (case (menu-select mymenu) ++ (quit (setq done t)) ++ (point (window-get-point *myw*)) ++ (line (setq start (window-get-point *myw*)) ++ (list start ++ (window-get-line-position *myw* (car start) ++ (cadr start)))) ++ (box (window-get-box-position *myw* 40 20)) ++ (region (window-get-region *myw*)) )) ++ (format t "Result: ~A~%" result) ) ++ (menu-destroy mymenu) )) ++ ++; 09 Sep 91 ++; Illustrate icons in menus ++(defun wtestd () ++ (menu '(("Triangle" . triangle) ++ (dwtest-square . square) ++ (dwtest-circle . circle) ++ hexagon) ++ "Icons in Menu") ) ++ ++(defun dwtest-square (w x y) (window-draw-box-xy w x y 20 20 1)) ++(setf (get 'dwtest-square 'display-size) '(20 20)) ++ ++(defun dwtest-circle (w x y) (window-draw-circle-xy w (+ x 10) (+ y 10) 10 1)) ++(setf (get 'dwtest-circle 'display-size) '(20 20)) ++ ++(defvar mypms nil) ++; 09 Sep 91; 11 Sep 91; 12 Sep 91; 14 Sep 91 ++; Illustrate a diagrammatic menu-like object: square with sensitive spots ++(defun wteste () ++ (let (pm val) ++ (or mypms (mypms-init)) ++ (setq pm (picmenu-create-from-spec mypms "Points on Square")) ++ (setq val (picmenu-select pm)) ++ (picmenu-destroy pm) ++ val )) ++ ++; 14 Sep 91 ++(defun mypms-init () ++ (setq mypms (picmenu-create-spec ++ '((bottom-left ( 20 20)) ++ (center-left ( 20 70)) ++ (top-left ( 20 120)) ++ (bottom-center ( 70 20)) ++ (center ( 70 70) (20 20)) ; larger ++ (top-center ( 70 120)) ++ (bottom-right (120 20)) ++ (center-right (120 70)) ++ (top-right (120 120))) ++ 140 140 'wteste-draw-square t)) ) ++ ++(defvar mypm nil) ++; 10 Sep 91; 11 Sep 91; 12 Sep 91; 14 Sep 91; 17 Sep 91 ++; A picmenu that is "flat" within another window, in this case *myw*. ++; Must do (wtesta) first. ++(defun wtestf () ++ (or mypms (mypms-init)) ++ (or mypm (setq mypm (picmenu-create-from-spec mypms "Points on Square" ++ *myw* 50 50 nil t t))) ++ (picmenu-select mypm)) ++ ++(defun wteste-draw-square (w x y) ++ (window-draw-box-xy w (+ x 20) (+ y 20) 100 100 1)) ++ ++(defvar mym nil) ++; 10 Sep 91; 17 Sep 91 ++; A menu that is "flat" within another window, in this case *myw*. ++; Must do (wtesta) first. ++(defun wtestg () ++ (or mym (setq mym (menu-create '(red white blue) "Flag" *myw* 50 50 nil t))) ++ (menu-select mym)) ++ ++; 09 Oct 91 ++; Demonstrate arrows. Optional arg is line width. ++(defun wtesth ( &optional (lw 1)) ++ (window-clear *myw*) ++ (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 (+ 40 (* i 30)) 160 lw)) ++ (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 (+ 40 (* i 30)) 40 lw)) ++ (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 40 (+ 40 (* i 30)) lw)) ++ (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 160 (+ 40 (* i 30)) lw)) ++ (dotimes (i 5) (window-draw-arrow-xy *myw* 200 (+ 40 (* i 30)) ++ 240 (+ 40 (* i 30)) ++ (1+ i) )) ++ (window-force-output *myw*) ) ++ ++; 04 Jan 94 ++; Redo some of the arrows from wtesth in color ++(defun wtesti () ++ (window-set-color-rgb *myw* 65535 0 0) ++ (window-draw-arrow-xy *myw* 200 70 240 70 2) ++ (window-set-color-rgb *myw* 0 65535 0) ++ (window-draw-arrow-xy *myw* 200 100 240 100 3) ++ (window-set-color-rgb *myw* 0 0 65535) ++ (window-draw-arrow-xy *myw* 200 130 240 130 4) ++ (window-reset-color *myw*) ++ (window-force-output *myw*) ) ++ ++; 04 Jan 94 ++; Get text from a window. Move mouse pointer into test window. ++; Add characters and/or backspace, Return. ++; Note: it might be necessary to change the keyboard mapping, using ++; (window-init-keyboard-mapping *myw*) and (window-print-keyboard-mapping) ++(defun wtestj () (window-input-string *myw* "Foo" 50 200 200)) ++ ++; 04 Jan 94 ++; Change foreground and background colors and input a string ++(defun wtestk () ++ (window-set-color-rgb *myw* 0 65535 0) ; green foreground ++ (window-set-color-rgb *myw* 0 0 65535 t) ; blue background ++ (prog1 (window-input-string *myw* "Foo" 50 200 200) ++ (window-reset-color *myw*) ++ (window-force-output *myw*) ) ) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_lispservertrans.lsp +@@ -0,0 +1,110 @@ ++; 27 Jan 2006 14:38:08 CST ++; This program 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 program 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 program; if not, write to the Free Software ++; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ++ ++ ++(DEFVAR *WIO-WINDOW* NIL) ++ ++(DEFVAR *WIO-WINDOW-WIDTH* 500) ++ ++(DEFVAR *WIO-WINDOW-HEIGHT* 300) ++ ++(DEFVAR *WIO-MENU-SET* NIL) ++ ++(DEFVAR *WIO-FONT* '8X13) ++ ++(DEFVAR *WIO-WINDOW*) ++(SETF (GET '*WIO-WINDOW* 'GLISPGLOBALVAR) T) ++(SETF (GET '*WIO-WINDOW* 'GLISPGLOBALVARTYPE) 'WINDOW) ++(DEFVAR *WIO-WINDOW-WIDTH*) ++(SETF (GET '*WIO-WINDOW-WIDTH* 'GLISPGLOBALVAR) T) ++(SETF (GET '*WIO-WINDOW-WIDTH* 'GLISPGLOBALVARTYPE) 'INTEGER) ++(DEFVAR *WIO-WINDOW-HEIGHT*) ++(SETF (GET '*WIO-WINDOW-HEIGHT* 'GLISPGLOBALVAR) T) ++(SETF (GET '*WIO-WINDOW-HEIGHT* 'GLISPGLOBALVARTYPE) 'INTEGER) ++(DEFVAR *WIO-MENU-SET*) ++(SETF (GET '*WIO-MENU-SET* 'GLISPGLOBALVAR) T) ++(SETF (GET '*WIO-MENU-SET* 'GLISPGLOBALVARTYPE) 'MENU-SET) ++ ++ ++(DEFMACRO WHILE (TEST &REST FORMS) ++ (LIST* 'LOOP (LIST 'UNLESS TEST '(RETURN)) FORMS)) ++ ++(SETF (GET 'WIO-WINDOW 'GLFNRESULTTYPE) 'WINDOW) ++ ++(DEFUN WIO-WINDOW (&OPTIONAL TITLE WIDTH HEIGHT (POSX 0) (POSY 0) FONT) ++ (IF WIDTH (SETQ *WIO-WINDOW-WIDTH* WIDTH)) ++ (IF HEIGHT (SETQ *WIO-WINDOW-HEIGHT* HEIGHT)) ++ (OR *WIO-WINDOW* ++ (SETQ *WIO-WINDOW* ++ (WINDOW-CREATE *WIO-WINDOW-WIDTH* *WIO-WINDOW-HEIGHT* TITLE ++ NIL POSX POSY FONT)))) ++ ++(DEFUN WIO-INIT-MENUS (W COMMANDS) ++ (LET () ++ (WINDOW-CLEAR W) ++ (SETQ *WIO-MENU-SET* (MENU-SET-CREATE W NIL)) ++ (MENU-SET-ADD-MENU *WIO-MENU-SET* 'COMMAND NIL "Commands" COMMANDS ++ (LIST 0 0)) ++ (MENU-SET-ADJUST *WIO-MENU-SET* 'COMMAND 'TOP NIL 2) ++ (MENU-SET-ADJUST *WIO-MENU-SET* 'COMMAND 'RIGHT NIL 2))) ++ ++(DEFUN LISP-SERVER () ++ (LET (W INPUTM DONE SEL (REDRAW T) STR RESULT) ++ (SETQ W (WIO-WINDOW "Lisp Server")) ++ (WINDOW-OPEN W) ++ (WINDOW-CLEAR W) ++ (WINDOW-SET-FONT W *WIO-FONT*) ++ (WIO-INIT-MENUS W '(("Quit" . QUIT))) ++ (WINDOW-PRINT-LINES W ++ '("Click mouse in the input box, then enter" ++ "a Lisp expression followed by Return." "" ++ "Input: e.g. (+ 3 4) or (sqrt 2)") ++ 10 (+ -20 *WIO-WINDOW-HEIGHT*)) ++ (WINDOW-PRINTAT-XY W "Result:" 10 (+ -150 *WIO-WINDOW-HEIGHT*)) ++ (SETQ INPUTM ++ (TEXTMENU-CREATE (+ -100 *WIO-WINDOW-WIDTH*) 30 NIL W 20 ++ (+ -110 *WIO-WINDOW-HEIGHT*) T T '9X15 T)) ++ (MENU-SET-ADD-ITEM *WIO-MENU-SET* 'INPUT NIL INPUTM) ++ (WHILE (NOT DONE) ++ (SETQ SEL (MENU-SET-SELECT *WIO-MENU-SET* REDRAW)) ++ (SETQ REDRAW NIL) ++ (CASE (CADR SEL) ++ (COMMAND (CASE (CAR SEL) (QUIT (SETQ DONE T)))) ++ (INPUT (SETQ STR (CAR SEL)) ++ (SETQ RESULT ++ (CATCH 'ERROR ++ (EVAL (SAFE-READ-FROM-STRING STR)))) ++ (WINDOW-ERASE-AREA-XY W 20 2 ++ (+ -20 *WIO-WINDOW-WIDTH*) ++ (+ -160 *WIO-WINDOW-HEIGHT*)) ++ (WINDOW-PRINT-LINE W ++ (WRITE-TO-STRING RESULT :PRETTY T) 20 ++ (+ -170 *WIO-WINDOW-HEIGHT*))))) ++ (WINDOW-CLOSE W))) ++ ++(DEFUN SAFE-READ-FROM-STRING (STR) ++ (IF (AND (STRINGP STR) (> (LENGTH STR) 0)) ++ (READ-FROM-STRING STR NIL 'READ-ERROR))) ++ ++(DEFUN COMPILE-LISPSERVER () ++ (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp") ++ '("glisp/lispserver.lsp") "glisp/lispservertrans.lsp" ++ "glisp/gpl.txt")) ++ ++(DEFUN COMPILE-LISPSERVERB () ++ (GLCOMPFILES *DIRECTORY* ++ '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") ++ '("glisp/lispserver.lsp") "glisp/lispservertrans.lsp" ++ "glisp/gpl.txt")) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_pcalc.lsp +@@ -0,0 +1,133 @@ ++; pcalc.lsp Gordon S. Novak Jr. 20 Oct 94 ++ ++; Pocket calculator implemented using a picmenu. Entry is (pcalc) . ++ ++; Copyright (c) 1994 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; See the file gnu.license . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++ ++(defvar *pcalcw* nil) ; window ++(defvar *pcalcm* nil) ; picmenu ++ ++(defun pcalc-draw (w x y) ++ (let (items item over up) ++ (window-open w) ++ (window-clear w) ++ (window-draw-rcbox-xy *pcalcw* 0 0 170 215 10 2) ++ (window-draw-rcbox-xy *pcalcw* 10 180 150 25 6) ++ (setq items '(0 \. = + 1 2 3 - 4 5 6 * 7 8 9 / off ac ce +-)) ++ (dotimes (i 5) ++ (setq up (+ 10 (* i 35))) ++ (dotimes (j 4) ++ (setq over (+ 10 (* j 40))) ++ (setq item (pop items)) ++ (window-printat-xy *pcalcw* item ++ (+ over 15 (* (if (numberp item) 1 ++ (length (stringify item))) ++ -5)) (+ up 3)) ++ (window-draw-rcbox-xy *pcalcw* over up 28 20 6) )) ++ (window-force-output) )) ++ ++(defun pcalc-init () ++ (prog ((n 15)) ++ (setq *pcalcw* (window-create 170 215 "pcalc" nil nil nil '9x15)) ++ lp (when (and (> n 0) (null (window-wait-exposure *pcalcw*))) ++ (sleep 1.0) (decf n) (go lp)) ++ (setq *pcalcm* ++ (picmenu-create ++ '((0 (24 20) (24 16)) ++ (\. (64 20) (24 16)) ++ (= (104 20) (24 16)) ++ (+ (144 20) (24 16)) ++ (1 (24 55) (24 16)) ++ (2 (64 55) (24 16)) ++ (3 (104 55) (24 16)) ++ (- (144 55) (24 16)) ++ (4 (24 90) (24 16)) ++ (5 (64 90) (24 16)) ++ (6 (104 90) (24 16)) ++ (* (144 90) (24 16)) ++ (7 (24 125) (24 16)) ++ (8 (64 125) (24 16)) ++ (9 (104 125) (24 16)) ++ (/ (144 125) (24 16)) ++ (off (24 160) (24 16)) ++ (ac (64 160) (24 16)) ++ (ce (104 160) (24 16)) ++ (+- (144 160) (24 16))) ++ 170 215 'pcalc-draw nil nil *pcalcw* 0 0 t t)) )) ++ ++(defun pcalc-display (val) ++ (let (str) ++ (window-erase-area-xy *pcalcw* 15 182 140 20) ++ (setq str (if (integerp val) ++ (princ-to-string val) ++ (format nil "~8,4F" val))) ++ (window-printat-xy *pcalcw* str (- 131 (* 9 (length str))) 185) ++ (window-force-output) )) ++ ++ ++(defun pcalc () ++ (prog (key (ent 0) (ac 0) decpt lastop lastkey) ++ (or *pcalcw* (pcalc-init)) ++ (pcalc-draw *pcalcw* 0 0) ++ (pcalc-display ent) ++ lp (setq key (picmenu-select *pcalcm*)) ++ (if (numberp key) ++ (progn (when (eq lastkey '=) ++ (setq ent 0) (setq decpt nil) (setq ac 0) (setq lastop nil)) ++ (if decpt ++ (progn (setq ent (+ ent (* key decpt))) ++ (setq decpt (/ decpt 10.0)) ) ++ (setq ent (+ key (* ent 10))) ) ++ (pcalc-display ent)) ++ (case key ++ ((+ - * /) ++ (if lastop ++ (progn (setq ac (if (eq lastop '/) ++ (/ (float ac) ent) ++ (funcall lastop ac ent))) ++ (pcalc-display ac)) ++ (setq ac ent)) ++ (setq lastop key) ++ (setq ent 0) ++ (setq decpt nil)) ++ (= (if lastop ++ (progn (setq ent (if (eq lastop '/) ++ (/ (float ac) ent) ++ (funcall lastop ac ent))) ++ (pcalc-display ent))) ++ (setq lastop nil)) ++ (\. (when (eq lastkey '=) ++ (setq ent 0) (setq ac 0) (setq lastop nil)) ++ (setq decpt 0.1) ++ (setq ent (float ent)) ++ (pcalc-display ent)) ++ (+- (setq ent (- ent)) ++ (pcalc-display ent)) ++ (ce (setq ent 0) (setq decpt nil) (pcalc-display ent)) ++ (ac (setq ent 0) (setq decpt nil) (setq ac 0) (setq lastop nil) ++ (pcalc-display ent)) ++ (off (window-close *pcalcw*) ++ (return nil)) ) ) ++ (setq lastkey key) ++ (go lp) )) ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_general.lsp +@@ -0,0 +1,85 @@ ++(in-package :XLIB) ++; general.lsp Hiep Huu Nguyen ; 24 Jun 06 ++; 15 Sep 05; 24 Jan 06 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++; 27 Aug 92 ++; 15 Sep 05: Edited by G. Novak to change C function headers to new form ++; 24 Jan 06: Edited by G. Novak to remove vertex-array entries. ++; 22 Jun 06: Edited by G. Novak to fix entry types ++ ++;(defentry free (string) (void free)) ++;(defentry calloc(fixnum fixnum) (string calloc)) ++(defentry char-array (int) (fixnum char_array)) ++(defentry char-pos (fixnum int) (char char_pos)) ++(defentry set-char-array (fixnum int char) (void set_char_array)) ++ ++(defentry int-array (int) (fixnum int_array)) ++(defentry int-pos (fixnum int) (int int_pos)) ++(defentry set-int-array (fixnum int int) (void set_int_array)) ++ ++(defentry fixnum-array (int) (fixnum fixnum_array)) ++(defentry fixnum-pos (fixnum int) (fixnum fixnum_pos)) ++(defentry set-fixnum-array (fixnum int fixnum) (void set_fixnum_array)) ++ ++;;from mark ring's function ++;; General routines. ++(defCfun "object get_c_string(object s)" 0 ++ " return((object)s->st.st_self);" ++ ) ++(defCfun "object get_c_string1(object s)" 0 ++ " return((object)object_to_string(s));" ++ ) ++(defCfun "fixnum get_c_string2(object s)" 0 ++ " return((fixnum)get_c_string(s));" ++ ) ++(defentry get_c_string_2 (object) (object get_c_string)) ++ ++;; make sure string is null terminated ++ ++(defentry get-c-string (object) (object get_c_string1));"(object)object_to_string")) ++ ++;; General routines. ++(defCfun "object lisp_string(object a_string, fixnum c_string) " 0 ++ "fixnum len = strlen((void *)c_string);" ++ "a_string->st.st_dim = len;" ++ "a_string->st.st_fillp = len;" ++ "a_string->st.st_self = (void *)c_string;" ++ "return(a_string);" ++ ) ++ ++(defentry lisp-string-2 (object fixnum ) (object lisp_string)) ++(defun lisp-string (a-string ) ++ (lisp-string-2 "" a-string )) ++ ++;;modified from mark ring's function ++;; General routines. ++(defCfun "fixnum get_st_point(object s)" 0 ++ " return((fixnum) s->st.st_self);" ++ ) ++(defentry get-st-point2 (object) (fixnum get_c_string2));"(fixnum)get_c_string")) ++ ++;; make sure string is null terminated ++(defun get-st-point (string) ++ ( get-st-point2 (concatenate 'string string ""))) ++ +--- gcl-2.6.7.orig/xgcl-2/makefile ++++ gcl-2.6.7/xgcl-2/makefile +@@ -1,76 +1,33 @@ +-############ BEGIN Things you may have to change ########## +- + -include ../makedefs + +-# The main gcl source directory. Expects to find $(GCLDIR)/o/*.o etc. +-# and it will put saved_xgcl in $(GCLDIR)/unixport/saved_xgcl +-#GCLDIR = /fix/t2/camm/b/gcl +- +-# The current directory: +-SYSDIR = $(GCLDIR)/xgcl-2 +-# way to get xlibraries: +-#X_LIBS = -L/usr/X11R6/lib -lXaw -lXmu -lXt -lXext -lX11 +-# for RS6000 at UT: +-#X_LIBS = -L/usr/local/X11R5/lib -lXaw -lXmu -lXt -lXext -lX11 +- +-# for Sun's at UT use -I/usr/local/X11R5/include +-IFLAGS = -I../h -I../o $(X_CFLAGS) +- +-############ END Things you may have to change ############### +- +-SYSTEM=xgcl +- +-# How to invoke gcl +-LISP = $(PORTDIR)/saved_gcl $(PORTDIR)/ +- +-SRC = . +-PORTDIR =$(GCLDIR)/unixport +- +-CFLAGS += $(IFLAGS) +- +-C_OBJS=$(SYSDIR)/Xutil-2.o $(SYSDIR)/Events.o $(SYSDIR)/XStruct-2.o \ +- $(SYSDIR)/XStruct-4.o $(SYSDIR)/general-c.o +- +-all: $(PORTDIR)/saved_$(SYSTEM) Xgcl +- +-maxobjs: $(shell echo *.lsp) $(PORTDIR)/saved_gcl +- echo '(load "sysdef.lisp")(setq si::*multiply-stacks* 2)'\ +- '(xlib::compile-xgcl)' | $(LISP) +- +-$(PORTDIR)/saved_$(SYSTEM): $(C_OBJS) maxobjs +- (cd $(PORTDIR) ; $(MAKE) saved_xgcl "INIT_SYSTEM_LSP=init_gcl.lsp" "SYSTEM=$(SYSTEM)" "SYSTEM_OBJS=`cat $(SYSDIR)/maxobjs` $(C_OBJS) " "EXTRA_LD_LIBS= $(X_LIBS) " "PORTDIR=$(PORTDIR)") +- rm -f $(PORTDIR)/raw_$(SYSTEM) +- +-Xgcl: +- echo $(PORTDIR)/saved_$(SYSTEM) $(PORTDIR)/ > Xgcl +- chmod a+x Xgcl +- +-############ the C code ############### +- +-cmpinclude.h: ../h/cmpinclude.h +- ln -snf $< $@ + +-$(SYSDIR)/Xutil-2.o: cmpinclude.h $(SYSDIR)/Xutil-2.c +- $(CC) -c Xutil-2.c $(CFLAGS) ++all: objects docs + +-$(SYSDIR)/Events.o: cmpinclude.h $(SYSDIR)/Events.c +- $(CC) -c Events.c $(CFLAGS) ++objects: $(LISP) ++ echo '(load "sysdef.lisp")(xlib::compile-xgcl)' | $(LISP) + +-$(SYSDIR)/XStruct-2.o: cmpinclude.h $(SYSDIR)/XStruct-2.c +- $(CC) -c XStruct-2.c $(CFLAGS) ++saved_xgcl: $(LISP) ++ echo '(load "sysdef.lisp")(xlib::compile-xgcl)(xlib::save-xgcl "$@")' | $(LISP) + +-$(SYSDIR)/XStruct-4.o: cmpinclude.h $(SYSDIR)/XStruct-4.c +- $(CC) -c XStruct-4.c $(CFLAGS) ++docs: dwdoc/dwdoccontents.html dwdoc.pdf + +-general-c.o: cmpinclude.h general-c.c +- $(CC) -c general-c.c $(CFLAGS) ++dwdoc/dwdoccontents.html: $(LISP) ++ mkdir -p $(@D) && \ ++ cd $(@D) && \ ++ echo '(load "../sysdef.lisp")(in-package :xlib)(defmacro while (test &rest forms) `(loop (unless ,test (return)) ,@forms))(load "../gcl_tohtml.lsp")(load "../gcl_index.lsp")(tohtml "../dwdoc.tex" "dwdoc")(with-open-file (s "dwdoccontents.html" :direction :output) (let ((*standard-output* s)) (xlib::makecont "../dwdoc.tex" 1 "dwdoc")))(with-open-file (s "dwdocindex.html" :direction :output) (let ((*standard-output* s)) (xlib::printindex indexdata "dwdoc")))' | ../$< + +-tar: +- $(MAKE) tar1 TARD=xgcl-`cat version` + +-tar1: +- (cd .. ; tar cvf - $(TARD)/*.lsp $(TARD)/*.lisp $(TARD)/*.c $(TARD)/*.paper $(TARD)/README $(TARD)/makefile $(TARD)/version | gzip -c > $(TARD).tgz) ++dwdoc.pdf: dwdoc.tex ++ pdflatex $< + + clean: +- rm -f *.o *.data Xgcl maxobjs $(PORTDIR)/saved_$(SYSTEM) cmpinclude.h ++ rm -f *.o *.data saved_* cmpinclude.h dwdoc.pdf dwdoc.aux dwdoc.log gmon.out ++ rm -f gcl*c gcl*h gcl*data gcl_xrecompile* user-init* ++ rm -rf dwdoc ++ ++install: ++ -mkdir -p $(DESTDIR)$(INFO_DIR)../doc ++ -cp -r dwdoc $(DESTDIR)$(INFO_DIR)../doc ++ -cp *tex *.pdf $(DESTDIR)$(INFO_DIR)../doc + ++#.INTERMEDIATE: saved_xgcl +--- gcl-2.6.7.orig/xgcl-2/XStruct-2.c ++++ gcl-2.6.7/xgcl-2/XStruct-2.c +@@ -1,7 +1,7 @@ +-/* XStruct-2.c Hiep Huu Nguyen 27 Aug 92 */ ++/* XStruct-2.c Hiep Huu Nguyen 27 Jun 06 */ + + /* ; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. +- ++; edited 27 Aug 92; 12 Aug 02 by G. Novak; 24 Jun 06 by GSN + ; See the files gnu.license and dec.copyright . + + ; This program is free software; you can redistribute it and/or modify +@@ -29,8 +29,8 @@ + #include + + +-int make__XQEvent (){ +- return ((int) calloc(1, sizeof(_XQEvent))); ++long make__XQEvent (){ ++ return ((long) calloc(1, sizeof(_XQEvent))); + } + + XEvent _XQEvent_event(i) +@@ -46,24 +46,24 @@ XEvent j; + i->event = j; + } + +-_XQEvent *_XQEvent_next(i) ++long _XQEvent_next(i) + _XQEvent* i; + { +- return(i->next); ++ return((long) i->next); + } + + void set__XQEvent_next(i, j) + _XQEvent* i; +-_XQEvent *j; ++long j; + { +- i->next = j; ++ i->next = (struct _XSQEvent *) j; + } + + + /********* XCharStruct funcions *****/ + +-int make_XCharStruct (){ +- return ((int) calloc(1, sizeof(XCharStruct))); ++long make_XCharStruct (){ ++ return ((long) calloc(1, sizeof(XCharStruct))); + } + + int XCharStruct_attributes(i) +@@ -147,8 +147,8 @@ int j; + + /********* XFontProp funcions *****/ + +-int make_XFontProp (){ +- return ((int) calloc(1, sizeof(XFontProp))); ++long make_XFontProp (){ ++ return ((long) calloc(1, sizeof(XFontProp))); + } + + int XFontProp_card32(i) +@@ -180,8 +180,8 @@ int j; + + /********* XFontStruct funcions *****/ + +-int make_XFontStruct (){ +- return ((int) calloc(1, sizeof(XFontStruct))); ++long make_XFontStruct (){ ++ return ((long) calloc(1, sizeof(XFontStruct))); + } + + int XFontStruct_descent(i) +@@ -210,28 +210,28 @@ int j; + i->ascent = j; + } + +-XCharStruct *XFontStruct_per_char(i) ++long XFontStruct_per_char(i) + XFontStruct* i; + { +- return(i->per_char); ++ return((long) i->per_char); + } + + void set_XFontStruct_per_char(i, j) + XFontStruct* i; +-XCharStruct *j; ++long j; + { +- i->per_char = j; ++ i->per_char = (XCharStruct *) j; + } + +-XCharStruct *XFontStruct_max_bounds(i) ++long XFontStruct_max_bounds(i) + XFontStruct* i; + { +- return(&i->max_bounds); ++ return((long) &i->max_bounds); + } +-XCharStruct *XFontStruct_min_bounds(i) ++long XFontStruct_min_bounds(i) + XFontStruct* i; + { +- return(&i->min_bounds); ++ return((long) &i->min_bounds); + } + void set_XFontStruct_max_bounds(i, j) + XFontStruct* i; +@@ -246,17 +246,17 @@ XCharStruct j; + i->min_bounds = j; + } + +-XFontProp *XFontStruct_properties(i) ++long XFontStruct_properties(i) + XFontStruct* i; + { +- return(i->properties); ++ return((long) i->properties); + } + + void set_XFontStruct_properties(i, j) + XFontStruct* i; +-XFontProp *j; ++long j; + { +- i->properties = j; ++ i->properties = (XFontProp *) j; + } + + int XFontStruct_n_properties(i) +@@ -376,24 +376,24 @@ int j; + i->fid = j; + } + +-XExtData * XFontStruct_ext_data(i) ++long XFontStruct_ext_data(i) + XFontStruct* i; + { +- return(i->ext_data); ++ return((long) i->ext_data); + } + + void set_XFontStruct_ext_data(i, j) + XFontStruct* i; +-XExtData *j; ++long j; + { +- i->ext_data = j; ++ i->ext_data = (XExtData *) j; + } + + + /********* XTextItem funcions *****/ + +-int make_XTextItem (){ +- return ((int) calloc(1, sizeof(XTextItem))); ++long make_XTextItem (){ ++ return ((long) calloc(1, sizeof(XTextItem))); + } + + int XTextItem_font(i) +@@ -435,24 +435,24 @@ int j; + i->nchars = j; + } + +-char * XTextItem_chars(i) ++long XTextItem_chars(i) + XTextItem* i; + { +- return(i->chars); ++ return((long) i->chars); + } + + void set_XTextItem_chars(i, j) + XTextItem* i; +-char *j; ++long j; + { +- i->chars = j; ++ i->chars = (char *) j; + } + + + /********* XChar2b funcions *****/ + +-int make_XChar2b (){ +- return ((int) calloc(1, sizeof(XChar2b))); ++long make_XChar2b (){ ++ return ((long) calloc(1, sizeof(XChar2b))); + } + + char XChar2b_byte2(i) +@@ -484,8 +484,8 @@ char j; + + /********* XTextItem16 funcions *****/ + +-int make_XTextItem16 (){ +- return ((int) calloc(1, sizeof(XTextItem16))); ++long make_XTextItem16 (){ ++ return ((long) calloc(1, sizeof(XTextItem16))); + } + + int XTextItem16_font(i) +@@ -527,76 +527,76 @@ int j; + i->nchars = j; + } + +-XChar2b * XTextItem16_chars(i) ++long XTextItem16_chars(i) + XTextItem16* i; + { +- return(i->chars); ++ return((long) i->chars); + } + + void set_XTextItem16_chars(i, j) + XTextItem16* i; +-XChar2b *j; ++long j; + { +- i->chars = j; ++ i->chars = (XChar2b *) j; + } + + + /********* XEDataObject funcions *****/ + +-int make_XEDataObject (){ +- return ((int) calloc(1, sizeof(XEDataObject))); ++long make_XEDataObject (){ ++ return ((long) calloc(1, sizeof(XEDataObject))); + } + +-XFontStruct *XEDataObject_font(i) ++long XEDataObject_font(i) + XEDataObject* i; + { +- return(i->font); ++ return((long) i->font); + } + + void set_XEDataObject_font(i, j) + XEDataObject* i; +-XFontStruct *j; ++long j; + { +- i->font = j; ++ i->font = (XFontStruct *) j; + } + +-ScreenFormat *XEDataObject_pixmap_format(i) ++long XEDataObject_pixmap_format(i) + XEDataObject* i; + { +- return(i->pixmap_format); ++ return((long) i->pixmap_format); + } + + void set_XEDataObject_pixmap_format(i, j) + XEDataObject* i; +-ScreenFormat *j; ++long j; + { +- i->pixmap_format = j; ++ i->pixmap_format = (ScreenFormat *) j; + } + +-Screen *XEDataObject_screen(i) ++long XEDataObject_screen(i) + XEDataObject* i; + { +- return(i->screen); ++ return((long) i->screen); + } + + void set_XEDataObject_screen(i, j) + XEDataObject* i; +-Screen *j; ++long j; + { +- i->screen = j; ++ i->screen = (Screen *) j; + } + +-Visual *XEDataObject_visual(i) ++long XEDataObject_visual(i) + XEDataObject* i; + { +- return(i->visual); ++ return((long) i->visual); + } + + void set_XEDataObject_visual(i, j) + XEDataObject* i; +-Visual *j; ++long j; + { +- i->visual = j; ++ i->visual = (Visual *) j; + } + + GC XEDataObject_gc(i) +@@ -615,8 +615,8 @@ GC j; + + /********* XSizeHints funcions *****/ + +-int make_XSizeHints (){ +- return ((int) calloc(1, sizeof(XSizeHints))); ++long make_XSizeHints (){ ++ return ((long) calloc(1, sizeof(XSizeHints))); + } + + int XSizeHints_win_gravity(i) +@@ -858,8 +858,8 @@ int j; + + /********* XWMHints funcions *****/ + +-int make_XWMHints (){ +- return ((int) calloc(1, sizeof(XWMHints))); ++long make_XWMHints (){ ++ return ((long) calloc(1, sizeof(XWMHints))); + } + + int XWMHints_window_group(i) +@@ -982,8 +982,8 @@ int j; + + /********* XTextProperty funcions *****/ + +-int make_XTextProperty (){ +- return ((int) calloc(1, sizeof(XTextProperty))); ++long make_XTextProperty (){ ++ return ((long) calloc(1, sizeof(XTextProperty))); + } + + int XTextProperty_nitems(i) +@@ -1025,24 +1025,24 @@ int j; + i->encoding = j; + } + +-unsigned char *XTextProperty_value(i) ++long XTextProperty_value(i) + XTextProperty* i; + { +- return(i->value); ++ return((long) i->value); + } + + void set_XTextProperty_value(i, j) + XTextProperty* i; +-unsigned char *j; ++long j; + { +- i->value = j; ++ i->value = (unsigned char *) j; + } + + + /********* XIconSize funcions *****/ + +-int make_XIconSize (){ +- return ((int) calloc(1, sizeof(XIconSize))); ++long make_XIconSize (){ ++ return ((long) calloc(1, sizeof(XIconSize))); + } + + int XIconSize_height_inc(i) +@@ -1126,41 +1126,41 @@ int j; + + /********* XClassHint funcions *****/ + +-int make_XClassHint (){ +- return ((int) calloc(1, sizeof(XClassHint))); ++long make_XClassHint (){ ++ return ((long) calloc(1, sizeof(XClassHint))); + } + +-char *XClassHint_res_class(i) ++long XClassHint_res_class(i) + XClassHint* i; + { +- return(i->res_class); ++ return((long) i->res_class); + } + + void set_XClassHint_res_class(i, j) + XClassHint* i; +-char *j; ++long j; + { +- i->res_class = j; ++ i->res_class = (char *) j; + } + +-char *XClassHint_res_name(i) ++long XClassHint_res_name(i) + XClassHint* i; + { +- return(i->res_name); ++ return((long) i->res_name); + } + + void set_XClassHint_res_name(i, j) + XClassHint* i; +-char *j; ++long j; + { +- i->res_name = j; ++ i->res_name = (char *) j; + } + + + /********* XComposeStatus funcions *****/ + +-int make_XComposeStatus (){ +- return ((int) calloc(1, sizeof(XComposeStatus))); ++long make_XComposeStatus (){ ++ return ((long) calloc(1, sizeof(XComposeStatus))); + } + + int XComposeStatus_chars_matched(i) +@@ -1176,24 +1176,24 @@ int j; + i->chars_matched = j; + } + +-XPointer XComposeStatus_compose_ptr(i) ++long XComposeStatus_compose_ptr(i) + XComposeStatus* i; + { +- return(i->compose_ptr); ++ return((long) i->compose_ptr); + } + + void set_XComposeStatus_compose_ptr(i, j) + XComposeStatus* i; +-XPointer j; ++long j; + { +- i->compose_ptr = j; ++ i->compose_ptr = (XPointer) j; + } + + + /********* XVisualInfo funcions *****/ + +-int make_XVisualInfo (){ +- return ((int) calloc(1, sizeof(XVisualInfo))); ++long make_XVisualInfo (){ ++ return ((long) calloc(1, sizeof(XVisualInfo))); + } + + int XVisualInfo_bits_per_rgb(i) +@@ -1313,24 +1313,24 @@ int j; + i->visualid = j; + } + +-Visual *XVisualInfo_visual(i) ++long XVisualInfo_visual(i) + XVisualInfo* i; + { +- return(i->visual); ++ return((long) i->visual); + } + + void set_XVisualInfo_visual(i, j) + XVisualInfo* i; +-Visual *j; ++long j; + { +- i->visual = j; ++ i->visual = (Visual *) j; + } + + + /********* XStandardColormap funcions *****/ + +-int make_XStandardColormap (){ +- return ((int) calloc(1, sizeof(XStandardColormap))); ++long make_XStandardColormap (){ ++ return ((long) calloc(1, sizeof(XStandardColormap))); + } + + int XStandardColormap_killid(i) +--- gcl-2.6.7.orig/xgcl-2/dwdoc.tex ++++ gcl-2.6.7/xgcl-2/dwdoc.tex +@@ -1,5 +1,5 @@ + % dwdoc.tex Gordon S. Novak Jr. +-% 08 Oct 92; 08 Oct 93; 16 Nov 94; 05 Jan 95 ++% 08 Oct 92; 08 Oct 93; 16 Nov 94; 05 Jan 95; 25 Jan 06; 26 Jan 06; 08 Dec 08 + + \documentstyle[12pt]{article} + \setlength{\oddsidemargin}{0 in} +@@ -12,17 +12,21 @@ + + \begin{document} + +-\begin{center}\Large{{\bf Interface from GCL to X Windows}} \\ ++\Large ++\begin{center} {\bf Interface from GCL to X Windows} \\ \end{center} ++ ++\normalsize + + \vspace*{0.1in} + ++\begin{center} + \large{Gordon S. Novak Jr. \\ + Department of Computer Sciences \\ + University of Texas at Austin \\ + Austin, TX 78712} \\ + \end{center} + +-Software copyright \copyright 1994 by Gordon S. Novak Jr. and ++Software copyright \copyright \/ by Gordon S. Novak Jr. and + The University of Texas at Austin. Distribution and use are allowed + under the Gnu Public License. Also see the copyright section at the end + of this document for the copyright on X Consortium software. +@@ -33,7 +37,7 @@ of this document for the copyright on X + + This document describes a relatively easy-to-use interface between + XGCL (X version of Gnu Common Lisp) and X windows. The interface +-consists of two parts: ++consists of several parts: + \begin{enumerate} + \item Hiep Huu Nguyen has written (and adapted from X Consortium software) + an interface between GCL and Xlib, the X library in C. +@@ -44,6 +48,9 @@ the {\tt dwindow} functions can be exami + + \item The {\tt dwindow} functions described in this document, which call + the Xlib functions and provide an easier interface for Lisp programs. ++ ++\item It is possible to make an interactive graphical interface ++within a web page; this is described in a section below. + \end{enumerate} + The source file for the interface (written in GLISP) is + {\tt dwindow.lsp}; this file is compiled into a file in plain Lisp, +@@ -62,8 +69,8 @@ The type {\tt vector} is a list {\tt (x + ({\tt window} is a Lisp data structure used by the {\tt dwindow} functions). + + Both the Xlib and {\tt dwindow} functions are in the package {\tt xlib:}. +-The file {\tt imports.lsp} may be used to import the {\tt dwindow} symbols +-to the {\tt :user} package. ++In order to use these functions, the Lisp command {\tt (use-package 'xlib)} ++should be used to import the {\tt dwindow} symbols. + + + \section{Examples and Utilities} +@@ -93,6 +100,16 @@ recreate the drawing; use {\tt origin to + {\tt (draw-out file names)} will write definitions of drawings in the + list {\tt names} to the file {\tt file}. + ++\subsection{{\tt editors}} ++ ++The file {\tt editorstrans.lsp} contains some interactive editing programs; ++it is a translation of the file {\tt editors.lsp} . ++One useful editor is the color editor; after entering {\tt (wtesta)} ++(in file {\tt dwtest.lsp}), enter {\tt (edit-color myw)} to edit a ++color. The result is an {\tt rgb} list as used in {\tt window-set-color}. ++ ++A simple line editor and an Emacs-like text editor are described in sections ++\ref{texted} and \ref{emacsed} below. + + \section{Menus} + +@@ -227,10 +244,10 @@ The remaining arguments are as described + Each of the {\tt buttons} in a picmenu is a list: \\ + + \vspace{-0.1in} +-{\tt \hspace*{0.5in} (name offset size highlightfn unhighlightfn)} \\ ++{\tt \hspace*{0.5in} (buttonname offset size highlightfn unhighlightfn)} \\ + + \vspace{-0.1in} +-{\tt name} is the name of the button; it is the value returned when that ++{\tt buttonname} is the name of the button; it is the value returned when that + button is selected. + {\tt offset} is a vector {\tt (x y)} that gives the offset of the center + of the button from the lower-left corner of the picture. +@@ -535,11 +552,15 @@ The color of the foreground (things that + characters) is set by: + + {\tt \hspace*{0.5in} (window-set-color w rgb \&optional background)} \\ ++{\tt \hspace*{0.5in} (window-set-color-rgb w r g b \&optional background)} \\ + + {\tt rgb} is a list {\tt (red green blue)} of 16-bit unsigned integers in + the range {\tt 0} to {\tt 65535}. {\tt background} is non-{\tt nil} + to set the background color rather than the foreground color. + ++{\tt \hspace*{0.5in} (window-reset-color w)} \\ ++{\tt window-reset-color} resets a window's colors to the default values. ++ + Colors are a scarce resource; there is only a finite number of + available colors, such as 256 colors. If you only use a small, fixed set + of colors, the finite set of colors will not be a problem. However, +@@ -556,7 +577,7 @@ the color after it is no longer needed. + {\tt *window-xcolor*}, or the specified color. + + +-\subsection{Character Input} ++\subsection{Character Input} \label{texted} + + Characters can be input within a window by the call: + +@@ -572,6 +593,27 @@ including those from the initial string + {\tt size} (default 100) is erased to the right of the initial caret. + + ++\subsection{Emacs-like Editing} \label{emacsed} ++ ++{\tt window-edit} allows editing of text using an Emacs-subset editor. ++Only a few simple Emacs commands are implemented. ++\begin{verbatim} ++ (window-edit w x y width height &optional strings boxflg scroll endp) ++\end{verbatim} ++{\tt x y width height} specify the offset and size of the editing ++area; it is a good idea to draw a box around this area first. ++{\tt strings} is an initial list of strings; the return value is a list ++of strings. ++{\tt scroll} is number of lines to scroll down before displaying text, ++ or {\tt T} to have one line only and terminate on return. ++{\tt endp} is {\tt T} to begin editing at the end of the first line. ++Example: ++\begin{verbatim} ++ (window-draw-box-xy myw 48 48 204 204) ++ (window-edit myw 50 50 200 200 '("Now is the time" "for all" "good")) ++\end{verbatim} ++ ++ + \section{Mouse Interaction} + + {\tt \hspace*{0.5in} (window-get-point w)} \\ +@@ -676,7 +718,7 @@ the implementation of menus and the mous + this section. + + {\tt \hspace*{0.5in} (window-track-mouse w fn \&optional outflg)} +- ++ + \vspace{-0.05in} + Each time the mouse position changes or a mouse button is pressed, + the function {\tt fn} is called with +@@ -703,6 +745,22 @@ should be used with care; it can destroy + processes associated with the window to be destroyed. It is useful + primarily in debugging, to get rid of a window that is left on the screen + due to an error. ++ ++ ++\section{Examples} ++ ++Several interactive programs using this software for their graphical ++interface can be found at {\tt http://www.cs.utexas.edu/users/novak/} ++under the heading Software Demos. ++ ++ ++\section{Web Interface} ++ ++This software allows a Lisp program to be used interactively within ++a web page. There are two approaches, either using an X server on ++the computer of the person viewing the web page, or using WeirdX, a ++Java program that emulates an X server. Details can be found at: ++{\tt http://www.cs.utexas.edu/users/novak/dwindow.html} + + + \section{Files} +@@ -713,13 +771,19 @@ due to an error. + {\tt drawtrans.lsp} & {\tt draw.lsp} translated into plain Lisp \\ + {\tt draw-gates.lsp} & Code to draw {\tt nand} gates etc. \\ + {\tt dwdoc.tex} & \LaTeX \ source for this document \\ ++{\tt dwexports.lsp} & exported symbols \\ ++{\tt dwimportsb.lsp} & imported symbols \\ + {\tt dwindow.lsp} & GLISP source code for {\tt dwindow} functions \\ + {\tt dwtest.lsp} & Examples of use of {\tt dwindow} functions \\ + {\tt dwtrans.lsp} & {\tt dwindow.lsp} translated into plain Lisp \\ ++{\tt editors.lsp} & Editors for colors etc. \\ ++{\tt editorstrans.lsp} & translation of {\tt editors.lsp} \\ + {\tt gnu.license} & GNU General Public License \\ + {\tt ice-cream.lsp} & Drawing of an ice cream cone made with {\tt draw} \\ +-{\tt imports.lsp} & file to import symbols to {\tt :user} package \\ ++{\tt lispserver.lsp} & Example web demo: a Lisp server \\ ++{\tt lispservertrans.lsp} & translation of {\tt lispserver.lsp} \\ + {\tt menu-set.lsp} & GLISP source code for menu-set functions \\ ++{\tt menu-settrans.lsp} & translation of {\tt menu-set.lsp} \\ + {\tt pcalc.lsp} & Pocket calculator implemented as a {\tt picmenu} \\ + \end{tabular} + +@@ -786,7 +850,7 @@ due to an error. + \vspace*{-.2in} + + \begin{verbatim} +-(picmenu-button (list (name symbol) ++(picmenu-button (list (buttonname symbol) + (offset vector) + (size vector) + (highlightfn anything) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_editors.lsp +@@ -0,0 +1,483 @@ ++; editors.lsp Gordon S. Novak Jr. ; 08 Dec 08 ++ ++; Copyright (c) 2008 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; 13 Apr 95; 02 Jan 97; 28 Feb 02; 08 Jan 04; 03 Mar 04; 26 Jan 06; 27 Jan 06 ++ ++; This program 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 program 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 program; if not, write to the Free Software ++; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ++ ++; Graphical editor functions ++ ++; (edit-thermom 75 myw 20 20 150 250) ++; (window-draw-thermometer myw 0 20 5 50 50 50 232) ++; (window-adjust-thermometer myw 0 20 5 50 50 50 232) ++ ++; 20 Nov 91; 03 Dec 91; 27 Dec 91; 26 Dec 93; 28 Feb 02; 08 Jan 04 ++; Edit an integer with a thermometer-like display ++(gldefun edit-thermom ((num number) (w window) ++ &optional (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (prog (nmin ndel ndiv range pten drange pair neww (res num) off) ++ (if ~ sizex (progn (sizex = 150) (sizey = 250))) ++ (if ~ offsetx ++ (progn (off = (centeroffset w (a vector with x = sizex y = sizey))) ++ (offsetx = (x off)) ++ (offsety = (y off)))) ++ (neww = (window-create sizex sizey nil (parent w) offsetx offsety)) ++ (window-draw-button neww "Typein" 80 20 50 25) ++ (window-draw-button neww "Adjust" 80 70 50 25) ++ (window-draw-button neww "Done" 80 120 50 25) ++ rn (range = (abs res) * 2) ++ (if (range == 0) (range = 50)) ++ (if ((range < 8) and (integerp num)) (range = 10)) ++ (pten = (expt 10 (truncate (log range 10)))) ++ (drange = (range * 10) / pten) ++ (setq pair (car (some #'(lambda (x) (> (car x) drange)) ++ '((14 2) (20 4) (40 5) (70 10) (101 20))))) ++ (setq ndel ((cadr pair) * pten / 10)) ++ (setq ndiv (ceiling (range / ndel))) ++ (setq nmin (if (>= res 0) ++ 0 ++ (- ndel * ndiv))) ++ (window-draw-thermometer neww nmin ndel ndiv res 10 10 (sizey - 20)) ++ lp (case (button-select neww '((done (84 124) (42 17)) ++ (adjust (84 74) (42 17)) ++ (typein (84 24) (42 17)))) ++ (done (destroy neww) (return res)) ++ (adjust (setq res (window-adjust-thermometer neww nmin ndel ndiv res ++ 10 10 (sizey - 20))) ++ (go lp)) ++ (typein (princ "Enter new value: ") ++ (setq res (read)) ++ (if ((res >= nmin) and (res <= (nmin + ndel * ndiv))) ++ (progn (window-set-thermometer neww nmin ndel ndiv res ++ 10 10 (sizey - 20)) ++ (go lp)) ++ (go rn)) ) ) )) ++ ++; 20 Nov 91; 04 Dec 91 ++; Draw a button-like icon ++(gldefun window-draw-button ((w window) (s string) ++ (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (let (sw) ++ (erase-area-xy w offsetx offsety sizex sizey 8) ++ (draw-rcbox-xy w offsetx offsety sizex sizey 8) ++ (sw = (string-width w s)) ++ (printat-xy w s (offsetx + (sizex - sw) / 2) (offsety + 8)) ++ (force-output w))) ++ ++; 17 Dec 91 ++; Print in the center of a specified region ++(gldefun window-center-print ((w window) (s string) ++ (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (let (sw) ++ (erase-area-xy w offsetx offsety sizex sizey 8) ++ (sw = (string-width w s)) ++ (printat-xy w s (offsetx + (sizex - sw) / 2) ++ (offsety + (sizey - 10) / 2) ) ++ (force-output w))) ++ ++; 20 Nov 91; 03 Dec 91; 26 Dec 93 ++; Draw a thermometer-like icon ++(gldefun window-draw-thermometer ((w window) (nmin integer) (ndel integer) ++ (ndiv integer) (val number) ++ (offsetx integer) (offsety integer) ++ (sizey integer)) ++ (let (hdel marky) ++ (erase-area-xy w offsetx offsety 66 sizey) ++ (editors-print-in-box val w offsetx offsety 40 20) ++ (draw-arc-xy w (offsetx + 12) (offsety + 36) 12 12 132 276) ++ (draw-line-xy w (offsetx + 4) (offsety + 44) ++ (offsetx + 4) (offsety + sizey - 8) ) ++ (draw-line-xy w (offsetx + 20) (offsety + 44) ++ (offsetx + 20) (offsety + sizey - 8) ) ++ (draw-arc-xy w (offsetx + 12) (offsety + sizey - 8) 8 8 0 180) ++ (draw-circle-xy w (offsetx + 12) (offsety + 36) 4 7) ++ (hdel = (sizey - 56) / ndiv) ++ (draw-line-xy w (offsetx + 12) (offsety + 35) ++ (offsetx + 12) ++ (offsety + 48 + hdel * ((val - nmin) / ndel)) 7) ++ (dotimes (i (1+ ndiv)) ++ (marky = (offsety + 48 + i * hdel)) ++ (draw-line-xy w (offsetx + 24) marky (offsetx + 34) marky) ++ (printat-xy w (nmin + i * ndel) (offsetx + 36) (marky - 6)) ) ++ (force-output w))) ++ ++ ++; 20 Nov 91; 03 Dec 91; 13 Apr 95 ++; Draw value for a thermometer-like icon ++(gldefun window-set-thermometer ((w window) (nmin integer) (ndel integer) ++ (ndiv integer) (val number) ++ (offsetx integer) (offsety integer) ++ (sizey integer)) ++ (let (hdel) ++ (hdel = (sizey - 56) / ndiv) ++ (erase-area-xy w (offsetx + 7) (offsety + 48) ++ 10 (sizey - 56)) ++ (draw-line-xy w (offsetx + 12) (offsety + 35) ++ (offsetx + 12) ++ (offsety + 48 + hdel * ((val - nmin) / ndel)) 7) ++ (editors-update-in-box val w offsetx offsety 40 20)))) ++ ++ ++; 20 Nov 91; 03 Dec 91; 15 Oct 93; 02 Dec 93; 08 Jan 04 ++; Adjust a thermometer-like icon with the mouse. Returns new value. ++(gldefun window-adjust-thermometer ((w window) (nmin integer) (ndel integer) ++ (ndiv integer) (val number) ++ (offsetx integer) (offsety integer) ++ (sizey integer)) ++ (let (hdel (lasty integer) xmin xmax ymin ymax inside (newval number)) ++ (hdel = (sizey - 56) / ndiv) ++ (lasty = (truncate (offsety + 48 + hdel * ((val - nmin) / ndel)))) ++ (xmin = offsetx + 4) ++ (xmax = offsetx + 20) ++ (ymin = offsety + 48) ++ (ymax = offsety + sizey - 8) ++ (window-track-mouse w ++ #'(lambda (x y code) ++ (inside = (and (>= x xmin) (<= x xmax) ++ (>= y ymin) (<= y ymax))) ++ (when (and inside (/= y lasty)) ++ (if (> y lasty) ++ (draw-line-xy w (offsetx + 12) lasty (offsetx + 12) y 7) ++ (erase-area-xy w (offsetx + 7) (y + 1) ++ 10 (- lasty y))) ++ (lasty = y) ++ (newval = ( ( (lasty - (offsety + 48)) ++ / (float hdel)) * ndel) + nmin) ++ (if (integerp val) (newval = (truncate newval))) ++ (editors-update-in-box newval w offsetx offsety 40 20)) ++ (not (zerop code)))) ++ (if inside ++ newval ++ val) )) ++ ++; 20 Nov 91; 15 Oct 93; 08 Jan 04; 26 Jan 06 ++; Get a mouse selection from a button area. cf. picmenu-select ++(gldefun button-select ((mw window) (buttons (listof picmenu-button))) ++ (let ((current-button picmenu-button) item items (val picmenu-button) ++ xzero yzero inside) ++ (xzero = 0) ; (menu-x m 0) ++ (yzero = 0) ; (menu-y m 0) ++ (track-mouse mw ++ #'(lambda (x y code) ++ (x = (x - xzero)) ++ (y = (y - yzero)) ++ (if ((x >= 0) and (y >= 0)) ++ (inside = t)) ++ (if current-button ++ (if ~ (button-containsxy? current-button x y) ++ (progn (button-invert mw current-button) ++ (current-button = nil)))) ++ (if ~ current-button ++ (progn (items = buttons) ++ (while ~ current-button and (item -_ items) do ++ (if (button-containsxy? item x y) ++ (progn (current-button = item) ++ (button-invert mw current-button) ))))) ++ (if (> code 0) ++ (progn (if current-button ++ (button-invert mw current-button) ) ++ (val = (or current-button *picmenu-no-selection*)) ))) ++ t) ++ (if (val <> *picmenu-no-selection*) (buttonname val)) )) ++ ++; 03 Dec 91 ++(gldefun button-invert ((w window) (button picmenu-button)) ++ (window-invert-area w (offset button) (size button)) ) ++ ++(gldefun window-undraw-box ((w window) offset size &optional lw) ++ (set-erase w) ++ (window-draw-box w offset size lw) ++ (unset w) ) ++ ++; 20 Nov 91; 08 Jan 04 ++(gldefun button-containsxy? ((b picmenu-button) (x integer) (y integer)) ++ (let ((xsize 6) (ysize 6)) ++ (if (size b) ++ (progn (xsize = (x (size b))) ++ (ysize = (y (size b))))) ++ ((x >= (x (offset b))) and (x <= ((x (offset b)) + xsize)) and ++ (y >= (y (offset b))) and (y <= ((y (offset b)) + ysize)) ) )) ++ ++ ++(glispobjects ++ ++(menu-item (z anything) ++ prop ((value ((if z is atomic ++ z ++ (cdr z)))) ) ++ msg ((print-size menu-item-print-size) ++ (draw menu-item-draw)) ) ++ ++) ; glispobjects ++ ++(gldefun menu-item-print-size ((item menu-item) (w window)) ++ (result vector) ++ (let (siz) ++ (if item is atomic ++ (a vector with x = (string-width w item) y = 11) ++ (if (car item) is a string ++ (a vector with x = (string-width w (car item)) y = 11) ++ (if ((symbolp (car item)) ++ and (siz = (get (car item) 'display-size))) ++ siz ++ (a vector with x = 50 y = 11)))) )) ++ ++; 17 Dec 91; 08 Jan 04 ++(gldefun menu-item-draw ((item menu-item) (w window) ++ (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (if item is atomic ++ (window-center-print w item offsetx offsety sizex sizey) ++ (if ((symbolp (car item)) and (fboundp (car item))) ++ (funcall (car item) w offsetx offsety) ++ (window-center-print w (car item) offsetx offsety ++ sizex sizey))) ) ++ ++; 03 Dec 91; 26 Dec 93; 08 Jan 04 ++(gldefun pick-one-size ((items (listof menu-item)) (w window)) ++ (let (wid) ++ (for item in items do ++ (wid = (if wid ++ (max wid (x (print-size item w))) ++ (x (print-size item w))) ) ) ++ (a vector with x = wid y = 11) )) ++ ++; 03 Dec 91; 26 Dec 93; 29 Jul 94; 28 Feb 02 ++(gldefun draw-pick-one ((items (listof menu-item)) (val anything) (w window) ++ &optional (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (let (itm) ++ (if (itm = (that item with (value (that item)) == val)) ++ (draw itm w offsetx offsety sizex sizey)))) ++ ++; 04 Dec 91; 26 Dec 93; 29 Jul 94; 08 Jan 04 ++(gldefun edit-pick-one ((items (listof menu-item)) (val anything) (w window) ++ &optional (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (let (newval) ++ (if ((length items) <= 3) ++ (if (equal val (value (first items))) ++ (newval = (value (second items))) ++ (if (equal val (value (second items))) ++ (newval = (if (third items) ++ (value (third items)) ++ (value (first items)))) ++ (newval = (value (first items))))) ++ (newval = (menu items)) ) ++ (draw-pick-one newval w items offsetx offsety sizex sizey) ++ newval )) ++ ++ ++; 13 Dec 91; 26 Dec 93; 28 Jul 94; 28 Feb 02; 08 Jan 04 ++(gldefun draw-black-white ((items (listof menu-item)) (val anything) (w window) ++ &optional (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (let (itm) ++ (erase-area-xy w offsetx offsety sizex sizey) ++ (if (itm = (that item with (value (that item)) == val)) ++ (if (eql (if (consp itm) ++ (car itm) ++ itm) ++ 1) ++ (invert-area-xy w offsetx offsety sizex sizey)) ) )) ++ ++; 13 Dec 91; 15 Dec 91; 26 Dec 93; 28 Jul 94; 08 Jan 04 ++(gldefun edit-black-white ((items (listof menu-item)) (val anything) (w window) ++ &optional (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (let (newval) ++ (if (equal val (value (first items))) ++ (newval = (value (second items))) ++ (if (equal val (value (second items))) ++ (newval = (value (first items))))) ++ (draw-black-white items newval w offsetx offsety sizex sizey) ++ newval )) ++ ++; 23 Dec 91; 26 Dec 93 ++(gldefun draw-integer ((val integer) (w window) ++ &optional (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (editors-anything-print val w offsetx offsety sizex sizey) ) ++ ++; 24 Dec 91; 26 Dec 93 ++(defun draw-real (val w &optional offsetx offsety sizex sizey) ++ (let (str nc lng fmt) ++ (if (null sizex) (setq sizex 50)) ++ (setq nc (max 1 (truncate sizex 7))) ++ (setq str (princ-to-string val)) ++ (setq lng (length str)) ++ (if (> lng nc) ++ (if (or (find #\. str :start nc) ++ (find #\E str) ++ (find #\L str)) ++ (if (>= nc 8) ++ (progn (setq fmt (cadr (or (assoc nc '((8 "~8,2E") ++ (9 "~9,2E") (10 "~10,2E") ++ (11 "~11,2E") (12 "~12,2E") ++ (13 "~13,2E") (14 "~14,2E"))) ++ '(15 "~15,2E")))) ++ (setq str (format nil fmt val))) ++ (setq str "*******")) ++ (setq str (subseq str 0 nc)) )) ++ (editors-anything-print w str offsetx offsety sizex sizey) )) ++ ++; 09 Dec 91; 10 Dec 91; 23 Dec 91; 26 Dec 93; 22 Jul 94 ++; Display function for use when a more specific one is not found. ++(gldefun editors-anything-print (obj (w window) offsetx offsety sizex sizey) ++ (let ((s (stringify obj)) swidth smax dx dy) ++ (erase-area-xy w offsetx offsety sizex sizey) ++ (swidth = (string-width w s)) ++ (smax = (min swidth sizex)) ++ (dx = (sizex - smax) / 2) ++ (dy = (max 0 ((sizey - 10) / 2))) ++ (printat-xy w (editors-string-limit obj w smax) ++ (offsetx + dx) (offsety + dy)) ++ )) ++ ++; 26 Dec 93 ++(gldefun editors-print-in-box (obj (w window) offsetx offsety sizex sizey) ++ (printat-xy w (editors-string-limit obj w sizex) ++ (offsetx + 4) (offsety + (sizey - 10) / 2)) ++ (draw-box-xy w offsetx offsety sizex sizey) ) ++ ++; 26 Dec 93 ++(gldefun editors-update-in-box (obj (w window) offsetx offsety sizex sizey) ++ (erase-area-xy w (offsetx + 3) (offsety + 3) (sizex - 6) (sizey - 6)) ++ (printat-xy w (editors-string-limit obj w sizex) ++ (offsetx + 4) (offsety + (sizey - 10) / 2)) ) ++ ++; 28 Oct 91; 26 Dec 93; 08 Jan 04 ++; Limit string to a specified number of pixels ++(gldefun editors-string-limit ((s string) (w window) (max integer)) ++ (result string) ++ (let ((str (stringify s)) (lng integer) (nc integer)) ++ (lng = (string-width w str)) ++ (if (lng > max) ++ (progn (nc = (((length str) * max) / lng)) ++ (subseq str 0 nc)) ++ str) )) ++ ++(defvar *edit-color-menu-set* nil) ++(defvar *edit-color-rmenu* nil) ++(defvar *edit-color-old-color* nil) ++(glispglobals (*edit-color-menu-set* menu-set) ++ (*edit-color-rmenu* barmenu)) ++ ++; 03 Jan 94; 04 Jan 94; 05 Jan 94; 08 Dec 08 ++(gldefun edit-color-init ((w window)) ++ (let (rm gm bm rgb) ++ (rgb = (a rgb)) ++ (glcc 'edit-color-red) ++ (glcc 'edit-color-green) ++ (glcc 'edit-color-blue) ++ (*edit-color-menu-set* = (menu-set-create w nil)) ++ (rm = (barmenu-create 256 200 10 "" nil #'edit-color-red (list rgb) w ++ 120 40 nil t (a rgb with red = 65535))) ++ (*edit-color-rmenu* = rm) ++ (gm = (barmenu-create 256 50 10 "" nil #'edit-color-green (list rgb) w ++ 170 40 nil t (a rgb with green = 65535))) ++ (bm = (barmenu-create 256 250 10 "" nil #'edit-color-blue (list rgb) w ++ 220 40 nil t (a rgb with blue = 65535))) ++ (add-barmenu *edit-color-menu-set* 'red nil rm "Red" '(120 40)) ++ (add-barmenu *edit-color-menu-set* 'green nil gm "Green" '(170 40)) ++ (add-barmenu *edit-color-menu-set* 'blue nil bm "Blue" '(220 40)) ++ (add-menu *edit-color-menu-set* 'done nil "" '(("Done" . done)) '(30 150)) ++ (edit-color-red 200 rgb) ++ (edit-color-green 50 rgb) ++ (edit-color-blue 250 rgb) ++ )) ++ ++; 03 Jan 94; 04 Jan 94 ++(gldefun edit-color-red ((val integer) (color rgb)) ++ (let ((w (window *edit-color-menu-set*))) ++ (printat-xy w (format nil "~3D" val) 113 20) ++ ((red color) = (max 0 (val * 256 - 1))) ++ (edit-display-color w color) )) ++ ++; 03 Jan 94; 04 Jan 94 ++(gldefun edit-color-green ((val integer) (color rgb)) ++ (let ((w (window *edit-color-menu-set*))) ++ (printat-xy w (format nil "~3D" val) 163 20) ++ ((green color) = (max 0 (val * 256 - 1))) ++ (edit-display-color w color) )) ++ ++; 03 Jan 94; 04 Jan 94 ++(gldefun edit-color-blue ((val integer) (color rgb)) ++ (let ((w (window *edit-color-menu-set*))) ++ (printat-xy w (format nil "~3D" val) 213 20) ++ ((blue color) = (max 0 (val * 256 - 1))) ++ (edit-display-color w color) )) ++ ++; 03 Jan 94 ++(gldefun edit-display-color ((w window) (color rgb)) ++ (window-set-color w color) ++ (window-draw-line-xy w 50 40 50 100 60) ++ (window-reset-color w) ++ (if *edit-color-old-color* (window-free-color w *edit-color-old-color*)) ++ (*edit-color-old-color* = *window-xcolor*) ) ++ ++; 03 Jan 94; 04 Jan 94; 05 Jan 94; 28 Feb 02 ++(gldefun edit-color ((w window)) ++ (let (done (color rgb) sel) ++ (if (or (null *edit-color-menu-set*) ++ (not (eq w (menu-window (menu (first (menu-items ++ *edit-color-menu-set*))))))) ++ (edit-color-init w)) ++ (color = (first (subtrackparms *edit-color-rmenu*))) ++ (draw *edit-color-menu-set*) ++ (edit-color-red (truncate (1+ (red color)) 256) color) ++ (edit-color-green (truncate (1+ (green color)) 256) color) ++ (edit-color-blue (truncate (1+ (blue color)) 256) color) ++ (while ~ done ++ (sel = (select *edit-color-menu-set*)) ++ (done = (and sel ((first sel) == 'done))) ) ++ color)) ++ ++; 08 Dec 08 ++(gldefun color-dot ((w window) (x integer) (y integer) (color symbol)) ++ (let (rgb) ++ (setq rgb (cdr (assoc color '((red 65535 0 0) ++ (yellow 65535 57600 0) ++ (green 0 50175 12287) ++ (blue 0 0 65535))))) ++ (or rgb (setq rgb '(30000 30000 30000))) ++ (set-color w rgb) ++ (draw-dot-xy w x y) ++ (reset-color w) )) ++ ++; 15 Oct 93; 26 Jan 06 ++; Compile the editors.lsp file into a plain Lisp file ++(defun compile-editors () ++ (glcompfiles *directory* ++ '("glisp/vector.lsp" ; auxiliary files ++ "X/dwindow.lsp") ++ '("glisp/editors.lsp") ; translated files ++ "glisp/editorstrans.lsp" ; output file ++ "glisp/gpl.txt") ; header file ++ (cf editorstrans) ) ++ ++; Compile the editors.lsp file into a plain Lisp file for XGCL ++(defun compile-editorsb () ++ (glcompfiles *directory* ++ '("glisp/vector.lsp" ; auxiliary files ++ "X/dwindow.lsp" "X/dwnoopen.lsp") ++ '("glisp/editors.lsp") ; translated files ++ "glisp/editorstrans.lsp" ; output file ++ "glisp/gpl.txt") ; header file ++ ) +--- gcl-2.6.7.orig/xgcl-2/README ++++ gcl-2.6.7/xgcl-2/README +@@ -1,7 +1,88 @@ +-README for Xgcl: Gnu Common Lisp with interface to X windows. 15 Mar 95 ++README for xgcl: Gnu Common Lisp interface to X windows. 28 Aug 2006 + +-Copyright (c) 1995 Gordon S. Novak Jr., Hiep Huu Nguyen, William F. Schelter, +-and The University of Texas at Austin. ++Distributed under GNU Public License; copyright notices at the bottom. ++ ++xgcl is an interface from Gnu Common Lisp to the X library, Xlib. ++ ++This software provides a lightweight and fairy easy-to-use way to: ++ * Draw diagrams from Lisp ++ * Create interactive graphical interfaces ++ * Make the interactive Lisp interfaces available via the Web ++ ++Beginning with release 2.6.8, xgcl is built into the make of GCL. ++ ++There is a "raw" interface to the Xlib, and an "easy-to-use" ++interface built on top of it; we will only discuss the "easy-to-use" ++version. ++ ++To use xgcl, start GCL and enter: (xgcl) ++This will load xgcl and print a message inviting you to try (xgcl-demo). ++(xgcl-demo) will create a small window and draw some examples in it. ++You can try (wtestc), (wtestd), ... (wtestk) to try some other things. ++ ++The xgcl files are located in the directory xgcl-2/ relative to the ++GCL directory. ++ ++The file gcl_dwtest.lsp contains the test examples; one way to ++get started quickly is by using this file for examples. ++ ++There is also documentation: ++ dwdoc.tex ++ dwdoc.dvi ++ dwdoc.html http://www.cs.utexas.edu/users/novak/dwdoc.html ++ dwdoc.pdf ++ dwdoc.ps ++ ++To use the basic xgcl, you only need to invoke (xgcl). ++To use some of the more advanced features such as menu-set, described ++below, also load the file gcl_dwimportsb.lsp immediately after ++invoking (xgcl), to import symbols. ++ ++Additional files that may be useful: ++ ++ gcl_menu-set.lsp Source and some comments for menu-set ++ gcl_menu-settrans.lsp menu-set translated to Common Lisp ++ gcl_pcalc.lsp Pocket calculator example ++ gcl_draw-gates.lsp Draw boolean gate symbols ++ gcl_draw.lsp Interactive drawing program source ++ gcl_drawtrans.lsp Drawing program translated to Common Lisp ++ gcl_dwindow.lsp Easy-to-use interface source with comments ++ gcl_dwtrans.lsp Easy-to-use interface translated to Common Lisp ++ gcl_editors.lsp Editors for colors etc. ++ gcl_editorstrans.lsp Editors translated to Common Lisp ++ gcl_ice-cream.lsp Example created using Draw ++ lispserver.lsp Example web demo: a Lisp server ++ lispservertrans.lsp Lisp server translated to Common Lisp ++ Xakcl.paper Documentation on the "raw" Xlib interface ++ Xakcl.example.lsp some PRIMITIVE examples ++ ++ ++This software provides a way to interface Lisp programs to the Web; see: ++ ++ http://www.cs.utexas.edu/users/novak/dwindow.html ++ ++There are two ways to accomplish a Web interface. ++ ++The first uses X directly, and requires that the user have an X server; ++this is reliable and fast, but it only works for the Linux/Mac/Cygwin ++subset of the world. There can also be firewall issues. ++ ++The other option uses WeirdX, an X server written in Java. ++The WeirdX interface is often slow, and sometimes doesn't work at all, ++but when it works, it works with any web browser, even on Windows. ++The WeirdX interface tends to leave "mouse droppings" on interactive ++drawings. ++ ++There are numerous examples of these web interfaces at: ++ ++ http://www.cs.utexas.edu/users/novak/ ++ ++The Draw demo is a good one to try. ++ ++--------------------------------------------------------------------------- ++ ++Copyright (c) 2006 Gordon S. Novak Jr., Hiep Huu Nguyen, ++William F. Schelter, Camm Maguire, and The University of Texas at Austin. + + Copyright 1987 by Digital Equipment Corporation and Massachusetts Institute + of Technology. +@@ -10,8 +91,8 @@ See the files gnu.license and dec.copyri + + This program 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 1, or (at your option) +-any later version. ++the Free Software Foundation; either version 2 of the License, or ++(at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of +@@ -20,193 +101,19 @@ GNU General Public License for more deta + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software +-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ++ ++Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++See the file dec.copyright for details. + + Written by: Gordon S. Novak Jr., Hiep Huu Nguyen, and William F. Schelter, +-Department of Computer Sciences, University of Texas at Austin 78712. ++Department of Computer Sciences, University of Texas at Austin 78712, ++and Camm Maguire. + +-Xgcl contains an interface from Gnu Common Lisp to the X library, Xlib, ++Xgcl is an interface from Gnu Common Lisp to the X library, Xlib, + adapted from X Consortium code by Hiep Huu Nguyen (hiep@cs.utexas.edu). +-Xgcl has been tested on the HP9000, SUN4, and IBM RS/6000. +-It has been modified by W. Schelter to make on machines that do not +-support the faslink. In order to compile it you must have gcl sources. + + dwindow.lsp is an "easy to use" interface from Lisp to the Xlib, + written by Gordon S. Novak Jr. (novak@cs.utexas.edu) It is written in + GLISP and has been translated into the Common Lisp file dwtrans.lsp, +-which is incorporated into the make of Xgcl. Documentation is +-provided in the LaTeX file dwdoc.tex . Test files are dwtest.lsp, +-pcalc.lsp , and drawtrans.lsp . +- +- +-This software and GCL can be ftp'ed from: +- math.utexas.edu /pub/gcl/ +- cli.com 192.31.85.1 /pub/gcl/ +- +-The file is called xgcl-2.tgz . ftp it to your site and uncompress it: +- gzip -dc xgcl-2.tgz | tar xvf - +- +-The directory xgcl-2 will then contain the files: +- +-Events.c +-README +-X.lsp +-X10.lsp +-XAtom.lsp +-XStruct-2.c +-XStruct-4.c +-XStruct-l-3.lsp +-Xakcl.example.lsp +-Xakcl.paper +-Xinit.lsp +-Xlib.lsp +-Xstruct.lsp +-Xutil-2.c +-Xutil.lsp +-dec.copyright +-defentry-events.lsp +-dispatch-events.lsp +-draw-gates.lsp +-draw.lsp +-drawtrans.lsp +-dwdoc.tex +-dwimports.lsp +-dwindow.lsp +-dwsyms.lsp +-dwtest.lsp +-dwtrans.lsp +-general-c.c +-general.lsp +-gnu.license +-ice-cream.lsp +-imports.lsp +-init_xgcl.lsp +-keysymdef.lsp +-makefile +-menu-set.lsp +-pcalc.lsp +-sysdef.lisp +-sysinit.lsp +-version +- +- +-These files contain: +- +-c code necesary for some general facilities and interface into X, in the files: +- +-Events.c +-XStruct-4.c +-XStruct-2.c +-Xutil-2.c +-general-c.c +- +- +-The shell makefile that compiles and creates Xgcl is: +- +-makefile +- +- +-For reference the lisp interfaces to functions reside in: +- +-Xlib.lsp +-Xstruct.lsp +-general.lsp +-Xutil.lsp +-XStruct-l-3.lsp +-defentry-events.lsp +- +- +-Constant declarations are in: +- +-X.lsp +-XAtom.lsp +-keysymdef.lsp +-X10.lsp +- +- +-These files correspond to C header files for X windows: +- +-Xlib.lsp +-Xutil.lsp +-X.lsp +-XAtom.lsp +-keysymdef.lsp +-X10.lsp +- +-What little documentation there is: Xakcl.paper +-Also see Xakcl.example.lsp for some PRIMITIVE examples. +- +-The dwindow files are as follows: +- +-dwindow.lsp source code, written in GLISP ("documentation" of dwtrans.lsp) +-dwtrans.lsp dwindow.lsp translated to plain Common Lisp +-dwdoc.tex documentation in LaTeX +-dwtest.lsp examples of use of dwindow +-pcalc.lsp pocket calculator +-menu-set.lsp multiple active menus in a single window (GLISP) +-draw.lsp interactive drawing program (GLISP) +-draw-gates.lsp draw nand gates etc. +-drawtrans.lsp draw.lsp and menu-set.lsp translated to plain Common Lisp +-imports.lsp imports the window symbols into the :user package +-dwimports.lsp a shorter set of imports used by the dwindow package +-dwsyms.lsp imports symbols needed to run dwtrans from Lisp source +- +-To make Xgcl: +- +-1. Make GCL first. A running GCL is required to make Xgcl. +- +-2. Put the xgcl-2.tgz file in the gcl-1.1 directory. +- +-3. Uncompress it with: gzip -dc xgcl-2.tgz | tar xvf - +- +-4. cd xgcl-2 +- +-5. edit the makefile and change the variables GCLDIR and SYSDIR +- to point to the gcl-1.1 and xgcl-2 directories, respectively. +- If needed, edit the X library paths. +- +-6. make +- This makes an image saved_xgcl in the GCLDIR/unixport directory. +- It will also make a one-line command Xgcl that will execute it. +- +-7. You can try out the basic system as follows (where % is the Unix prompt): +- % Xgcl +- +- GCL (GNU Common Lisp) Version(1.1) Tue Sep 27 19:37:50 CDT 1994 +- Contains Enhancements by W. Schelter +- >(in-package "XLIB") +- +- XLIB>(Xinit) +- NIL +- +- XLIB>(open-window) +- 10485761 +- +- >(bye) +- Bye. +- +-As you can see, all that happened was that a simple window appeared. +-Read the paper Xakcl.paper for more details. +- +- +-To try the dwindow package, do the following (in xgcl-2 directory): +- +-% Xgcl +-(load "imports.lsp") ; import window symbols -- do this before anything else +-(load "dwtest.lsp") ; load the test functions +-(wtesta) ; make a window +-(wtestb) ; draw some stuff +-(wtestc) ; choose from menu, then click in window +-(wtestd) ; a menu with icons +-(wteste) ; a picture menu with sensitive points +-(wtesth) ; arrows +-(wtesti) ; arrows in color +-(wtestj) ; character input: type with cursor in the window +-(wtestk) ; character input in color +-(load "pcalc.lsp") +-(pcalc) ; pocket calculator +-(load "drawtrans.lsp") +-(load "ice-cream.lsp"); an existing drawing +-(draw 'ice-cream) ; examine / edit the drawing +-(draw 'foo) ; make a drawing named foo. +- ; when done, do Origin (to Zero), Program, LaTex ++which is incorporated into the make of Xgcl. +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_X.lsp +@@ -0,0 +1,689 @@ ++(in-package :XLIB) ++; X.lsp modified by Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++;; ++;; $XConsortium: X.h,v 1.66 88/09/06 15:55:56 jim Exp $ ++ ++ ++;; Definitions for the X window system likely to be used by applications ++ ++ ++;;********************************************************** ++;;Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts, ++;;and the Massachusetts Institute of Technology, Cambridge, Massachusetts. ++ ++;;modified by Hiep H Nguyen 28 Jul 91 ++ ++;; All Rights Reserved ++ ++;;Permission to use, copy, modify, and distribute this software and its ++;;documentation for any purpose and without fee is hereby granted, ++;;provided that the above copyright notice appear in all copies and that ++;;both that copyright notice and this permission notice appear in ++;;supporting documentation, and that the names of Digital or MIT not be ++;;used in advertising or publicity pertaining to distribution of the ++;;software without specific, written prior permission. ++ ++;;DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ++;;ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL ++;;DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ++;;ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, ++;;WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ++;;ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS ++;;SOFTWARE. ++ ++;;***************************************************************** ++(defconstant X_PROTOCOL 11 ) ;; current protocol version ++(defconstant X_PROTOCOL_REVISION 0 ) ;; current minor version ++ ++(defconstant True 1) ++(defconstant False 0) ++ ++;; Resources ++ ++;;typedef unsigned long XID) ; ++ ++;;typedef XID Window) ; ++;;typedef XID Drawable) ; ++;;typedef XID Font) ; ++;;typedef XID Pixmap) ; ++;;typedef XID Cursor) ; ++;;typedef XID Colormap) ; ++;;typedef XID GContext) ; ++;;typedef XID KeySym) ; ++ ++;;typedef unsigned long Mask) ; ++ ++;;typedef unsigned long Atom) ; ++ ++;;typedef unsigned long VisualID) ; ++ ++;;typedef unsigned long Time) ; ++ ++;;typedef unsigned char KeyCode) ; ++ ++;;**************************************************************** ++;; * RESERVED RESOURCE AND CONSTANT DEFINITIONS ++;; **************************************************************** ++ ++(defconstant None 0 ) ;; universal null resource or null atom ++ ++(defconstant ParentRelative 1 ) ;; background pixmap in CreateWindow ++ ;;and ChangeWindowAttributes ++ ++(defconstant CopyFromParent 0 ) ;; border pixmap in CreateWindow ++ ;;and ChangeWindowAttributes ++ ;;special VisualID and special window ++ ;; class passed to CreateWindow ++ ++(defconstant PointerWindow 0 ) ;; destination window in SendEvent ++(defconstant InputFocus 1 ) ;; destination window in SendEvent ++ ++(defconstant PointerRoot 1 ) ;; focus window in SetInputFocus ++ ++(defconstant AnyPropertyType 0 ) ;; special Atom, passed to GetProperty ++ ++(defconstant AnyKey 0 ) ;; special Key Code, passed to GrabKey ++ ++(defconstant AnyButton 0 ) ;; special Button Code, passed to GrabButton ++ ++(defconstant AllTemporary 0 ) ;; special Resource ID passed to KillClient ++ ++(defconstant CurrentTime 0 ) ;; special Time ++ ++(defconstant NoSymbol 0 ) ;; special KeySym ++ ++;;**************************************************************** ++;; * EVENT DEFINITIONS ++;; **************************************************************** ++ ++;; Input Event Masks. Used as event-mask window attribute and as arguments ++;; to Grab requests. Not to be confused with event names. ++ ++(defconstant NoEventMask 0) ++(defconstant KeyPressMask (expt 2 0) ) ++(defconstant KeyReleaseMask (expt 2 1) ) ++(defconstant ButtonPressMask (expt 2 2) ) ++(defconstant ButtonReleaseMask (expt 2 3) ) ++(defconstant EnterWindowMask (expt 2 4) ) ++(defconstant LeaveWindowMask (expt 2 5) ) ++(defconstant PointerMotionMask (expt 2 6) ) ++(defconstant PointerMotionHintMask (expt 2 7) ) ++(defconstant Button1MotionMask (expt 2 8) ) ++(defconstant Button2MotionMask (expt 2 9) ) ++(defconstant Button3MotionMask (expt 2 10) ) ++(defconstant Button4MotionMask (expt 2 11) ) ++(defconstant Button5MotionMask (expt 2 12) ) ++(defconstant ButtonMotionMask (expt 2 13) ) ++(defconstant KeymapStateMask (expt 2 14)) ++(defconstant ExposureMask (expt 2 15) ) ++(defconstant VisibilityChangeMask (expt 2 16) ) ++(defconstant StructureNotifyMask (expt 2 17) ) ++(defconstant ResizeRedirectMask (expt 2 18) ) ++(defconstant SubstructureNotifyMask (expt 2 19) ) ++(defconstant SubstructureRedirectMask (expt 2 20) ) ++(defconstant FocusChangeMask (expt 2 21) ) ++(defconstant PropertyChangeMask (expt 2 22) ) ++(defconstant ColormapChangeMask (expt 2 23) ) ++(defconstant OwnerGrabButtonMask (expt 2 24) ) ++ ++;; Event names. Used in "type" field in XEvent structures. Not to be ++;;confused with event masks above. They start from 2 because 0 and 1 ++;;are reserved in the protocol for errors and replies. ++ ++(defconstant KeyPress 2) ++(defconstant KeyRelease 3) ++(defconstant ButtonPress 4) ++(defconstant ButtonRelease 5) ++(defconstant MotionNotify 6) ++(defconstant EnterNotify 7) ++(defconstant LeaveNotify 8) ++(defconstant FocusIn 9) ++(defconstant FocusOut 10) ++(defconstant KeymapNotify 11) ++(defconstant Expose 12) ++(defconstant GraphicsExpose 13) ++(defconstant NoExpose 14) ++(defconstant VisibilityNotify 15) ++(defconstant CreateNotify 16) ++(defconstant DestroyNotify 17) ++(defconstant UnmapNotify 18) ++(defconstant MapNotify 19) ++(defconstant MapRequest 20) ++(defconstant ReparentNotify 21) ++(defconstant ConfigureNotify 22) ++(defconstant ConfigureRequest 23) ++(defconstant GravityNotify 24) ++(defconstant ResizeRequest 25) ++(defconstant CirculateNotify 26) ++(defconstant CirculateRequest 27) ++(defconstant PropertyNotify 28) ++(defconstant SelectionClear 29) ++(defconstant SelectionRequest 30) ++(defconstant SelectionNotify 31) ++(defconstant ColormapNotify 32) ++(defconstant ClientMessage 33) ++(defconstant MappingNotify 34) ++(defconstant LASTEvent 35 ) ;; must be bigger than any event # ++ ++ ++;; Key masks. Used as modifiers to GrabButton and GrabKey, results of QueryPointer, ++;; state in various key-, mouse-, and button-related events. ++ ++(defconstant ShiftMask (expt 2 0)) ++(defconstant LockMask (expt 2 1)) ++(defconstant ControlMask (expt 2 2)) ++(defconstant Mod1Mask (expt 2 3)) ++(defconstant Mod2Mask (expt 2 4)) ++(defconstant Mod3Mask (expt 2 5)) ++(defconstant Mod4Mask (expt 2 6)) ++(defconstant Mod5Mask (expt 2 7)) ++ ++;; modifier names. Used to build a SetModifierMapping request or ++;; to read a GetModifierMapping request. These correspond to the ++;; masks defined above. ++(defconstant ShiftMapIndex 0) ++(defconstant LockMapIndex 1) ++(defconstant ControlMapIndex 2) ++(defconstant Mod1MapIndex 3) ++(defconstant Mod2MapIndex 4) ++(defconstant Mod3MapIndex 5) ++(defconstant Mod4MapIndex 6) ++(defconstant Mod5MapIndex 7) ++ ++ ++;; button masks. Used in same manner as Key masks above. Not to be confused ++;; with button names below. ++ ++(defconstant Button1Mask (expt 2 8)) ++(defconstant Button2Mask (expt 2 9)) ++(defconstant Button3Mask (expt 2 10)) ++(defconstant Button4Mask (expt 2 11)) ++(defconstant Button5Mask (expt 2 12)) ++ ++(defconstant AnyModifier (expt 2 15) ) ;; used in GrabButton, GrabKey ++ ++ ++;; button names. Used as arguments to GrabButton and as detail in ButtonPress ++;; and ButtonRelease events. Not to be confused with button masks above. ++;; Note that 0 is already defined above as "AnyButton". ++ ++(defconstant Button1 1) ++(defconstant Button2 2) ++(defconstant Button3 3) ++(defconstant Button4 4) ++(defconstant Button5 5) ++ ++;; Notify modes ++ ++(defconstant NotifyNormal 0) ++(defconstant NotifyGrab 1) ++(defconstant NotifyUngrab 2) ++(defconstant NotifyWhileGrabbed 3) ++ ++(defconstant NotifyHint 1 ) ;; for MotionNotify events ++ ++;; Notify detail ++ ++(defconstant NotifyAncestor 0) ++(defconstant NotifyVirtual 1) ++(defconstant NotifyInferior 2) ++(defconstant NotifyNonlinear 3) ++(defconstant NotifyNonlinearVirtual 4) ++(defconstant NotifyPointer 5) ++(defconstant NotifyPointerRoot 6) ++(defconstant NotifyDetailNone 7) ++ ++;; Visibility notify ++ ++(defconstant VisibilityUnobscured 0) ++(defconstant VisibilityPartiallyObscured 1) ++(defconstant VisibilityFullyObscured 2) ++ ++;; Circulation request ++ ++(defconstant PlaceOnTop 0) ++(defconstant PlaceOnBottom 1) ++ ++;; protocol families ++ ++(defconstant FamilyInternet 0) ++(defconstant FamilyDECnet 1) ++(defconstant FamilyChaos 2) ++ ++;; Property notification ++ ++(defconstant PropertyNewValue 0) ++(defconstant PropertyDelete 1) ++ ++;; Color Map notification ++ ++(defconstant ColormapUninstalled 0) ++(defconstant ColormapInstalled 1) ++ ++;; GrabPointer, GrabButton, GrabKeyboard, GrabKey Modes ++ ++(defconstant GrabModeSync 0) ++(defconstant GrabModeAsync 1) ++ ++;; GrabPointer, GrabKeyboard reply status ++ ++(defconstant GrabSuccess 0) ++(defconstant AlreadyGrabbed 1) ++(defconstant GrabInvalidTime 2) ++(defconstant GrabNotViewable 3) ++(defconstant GrabFrozen 4) ++ ++;; AllowEvents modes ++ ++(defconstant AsyncPointer 0) ++(defconstant SyncPointer 1) ++(defconstant ReplayPointer 2) ++(defconstant AsyncKeyboard 3) ++(defconstant SyncKeyboard 4) ++(defconstant ReplayKeyboard 5) ++(defconstant AsyncBoth 6) ++(defconstant SyncBoth 7) ++ ++;; Used in SetInputFocus, GetInputFocus ++ ++(defconstant RevertToNone None) ++(defconstant RevertToPointerRoot PointerRoot) ++(defconstant RevertToParent 2) ++ ++;;**************************************************************** ++;; * ERROR CODES ++;; **************************************************************** ++ ++(defconstant Success 0 ) ;; everything's okay ++(defconstant BadRequest 1 ) ;; bad request code ++(defconstant BadValue 2 ) ;; int parameter out of range ++(defconstant BadWindow 3 ) ;; parameter not a Window ++(defconstant BadPixmap 4 ) ;; parameter not a Pixmap ++(defconstant BadAtom 5 ) ;; parameter not an Atom ++(defconstant BadCursor 6 ) ;; parameter not a Cursor ++(defconstant BadFont 7 ) ;; parameter not a Font ++(defconstant BadMatch 8 ) ;; parameter mismatch ++(defconstant BadDrawable 9 ) ;; parameter not a Pixmap or Window ++(defconstant BadAccess 10 ) ;; depending on context: ++ ;;- key/button already grabbed ++ ;;- attempt to free an illegal ++ ;; cmap entry ++ ;;- attempt to store into a read-only ++ ;; color map entry. ++ ;;- attempt to modify the access control ++ ;; list from other than the local host. ++ ++(defconstant BadAlloc 11 ) ;; insufficient resources ++(defconstant BadColor 12 ) ;; no such colormap ++(defconstant BadGC 13 ) ;; parameter not a GC ++(defconstant BadIDChoice 14 ) ;; choice not in range or already used ++(defconstant BadName 15 ) ;; font or color name doesn't exist ++(defconstant BadLength 16 ) ;; Request length incorrect ++(defconstant BadImplementation 17 ) ;; server is defective ++ ++(defconstant FirstExtensionError 128) ++(defconstant LastExtensionError 255) ++ ++;;**************************************************************** ++;; * WINDOW DEFINITIONS ++;; **************************************************************** ++ ++;; Window classes used by CreateWindow ++;; Note that CopyFromParent is already defined as 0 above ++ ++(defconstant InputOutput 1) ++(defconstant InputOnly 2) ++ ++;; Window attributes for CreateWindow and ChangeWindowAttributes ++ ++(defconstant CWBackPixmap (expt 2 0)) ++(defconstant CWBackPixel (expt 2 1)) ++(defconstant CWBorderPixmap (expt 2 2)) ++(defconstant CWBorderPixel (expt 2 3)) ++(defconstant CWBitGravity (expt 2 4)) ++(defconstant CWWinGravity (expt 2 5)) ++(defconstant CWBackingStore (expt 2 6)) ++(defconstant CWBackingPlanes (expt 2 7)) ++(defconstant CWBackingPixel (expt 2 8)) ++(defconstant CWOverrideRedirect (expt 2 9)) ++(defconstant CWSaveUnder (expt 2 10)) ++(defconstant CWEventMask (expt 2 11)) ++(defconstant CWDontPropagate (expt 2 12)) ++(defconstant CWColormap (expt 2 13)) ++(defconstant CWCursor (expt 2 14)) ++ ++;; ConfigureWindow structure ++ ++(defconstant CWX (expt 2 0)) ++(defconstant CWY (expt 2 1)) ++(defconstant CWWidth (expt 2 2)) ++(defconstant CWHeight (expt 2 3)) ++(defconstant CWBorderWidth (expt 2 4)) ++(defconstant CWSibling (expt 2 5)) ++(defconstant CWStackMode (expt 2 6)) ++ ++ ++;; Bit Gravity ++ ++(defconstant ForgetGravity 0) ++(defconstant NorthWestGravity 1) ++(defconstant NorthGravity 2) ++(defconstant NorthEastGravity 3) ++(defconstant WestGravity 4) ++(defconstant CenterGravity 5) ++(defconstant EastGravity 6) ++(defconstant SouthWestGravity 7) ++(defconstant SouthGravity 8) ++(defconstant SouthEastGravity 9) ++(defconstant StaticGravity 10) ++ ++;; Window gravity + bit gravity above ++ ++(defconstant UnmapGravity 0) ++ ++;; Used in CreateWindow for backing-store hint ++ ++(defconstant NotUseful 0) ++(defconstant WhenMapped 1) ++(defconstant Always 2) ++ ++;; Used in GetWindowAttributes reply ++ ++(defconstant IsUnmapped 0) ++(defconstant IsUnviewable 1) ++(defconstant IsViewable 2) ++ ++;; Used in ChangeSaveSet ++ ++(defconstant SetModeInsert 0) ++(defconstant SetModeDelete 1) ++ ++;; Used in ChangeCloseDownMode ++ ++(defconstant DestroyAll 0) ++(defconstant RetainPermanent 1) ++(defconstant RetainTemporary 2) ++ ++;; Window stacking method (in configureWindow) ++ ++(defconstant Above 0) ++(defconstant Below 1) ++(defconstant TopIf 2) ++(defconstant BottomIf 3) ++(defconstant Opposite 4) ++ ++;; Circulation direction ++ ++(defconstant RaiseLowest 0) ++(defconstant LowerHighest 1) ++ ++;; Property modes ++ ++(defconstant PropModeReplace 0) ++(defconstant PropModePrepend 1) ++(defconstant PropModeAppend 2) ++ ++;;**************************************************************** ++;; * GRAPHICS DEFINITIONS ++;; **************************************************************** ++ ++;; graphics functions, as in GC.alu ++ ++(defconstant GXclear 0 ) ;; 0 ++(defconstant GXand 1 ) ;; src AND dst ++(defconstant GXandReverse 2 ) ;; src AND NOT dst ++(defconstant GXcopy 3 ) ;; src ++(defconstant GXandInverted 4 ) ;; NOT src AND dst ++(defconstant GXnoop 5 ) ;; dst ++(defconstant GXxor 6 ) ;; src XOR dst ++(defconstant GXor 7 ) ;; src OR dst ++(defconstant GXnor 8 ) ;; NOT src AND NOT dst ++(defconstant GXequiv 9 ) ;; NOT src XOR dst ++(defconstant GXinvert 10 ) ;; NOT dst ++(defconstant GXorReverse 11 ) ;; src OR NOT dst ++(defconstant GXcopyInverted 12 ) ;; NOT src ++(defconstant GXorInverted 13 ) ;; NOT src OR dst ++(defconstant GXnand 14 ) ;; NOT src OR NOT dst ++(defconstant GXset 15 ) ;; 1 ++ ++;; LineStyle ++ ++(defconstant LineSolid 0) ++(defconstant LineOnOffDash 1) ++(defconstant LineDoubleDash 2) ++ ++;; capStyle ++ ++(defconstant CapNotLast 0) ++(defconstant CapButt 1) ++(defconstant CapRound 2) ++(defconstant CapProjecting 3) ++ ++;; joinStyle ++ ++(defconstant JoinMiter 0) ++(defconstant JoinRound 1) ++(defconstant JoinBevel 2) ++ ++;; fillStyle ++ ++(defconstant FillSolid 0) ++(defconstant FillTiled 1) ++(defconstant FillStippled 2) ++(defconstant FillOpaqueStippled 3) ++ ++;; fillRule ++ ++(defconstant EvenOddRule 0) ++(defconstant WindingRule 1) ++ ++;; subwindow mode ++ ++(defconstant ClipByChildren 0) ++(defconstant IncludeInferiors 1) ++ ++;; SetClipRectangles ordering ++ ++(defconstant Unsorted 0) ++(defconstant YSorted 1) ++(defconstant YXSorted 2) ++(defconstant YXBanded 3) ++ ++;; CoordinateMode for drawing routines ++ ++(defconstant CoordModeOrigin 0 ) ;; relative to the origin ++(defconstant CoordModePrevious 1 ) ;; relative to previous point ++ ++;; Polygon shapes ++ ++;(defconstant Complex 0 ) ;; paths may intersect ++(defconstant Nonconvex 1 ) ;; no paths intersect, but not convex ++(defconstant Convex 2 ) ;; wholly convex ++ ++;; Arc modes for PolyFillArc ++ ++(defconstant ArcChord 0 ) ;; join endpoints of arc ++(defconstant ArcPieSlice 1 ) ;; join endpoints to center of arc ++ ++;; GC components: masks used in CreateGC, CopyGC, ChangeGC, OR'ed into ++;; GC.stateChanges ++ ++(defconstant GCFunction (expt 2 0)) ++(defconstant GCPlaneMask (expt 2 1)) ++(defconstant GCForeground (expt 2 2)) ++(defconstant GCBackground (expt 2 3)) ++(defconstant GCLineWidth (expt 2 4)) ++(defconstant GCLineStyle (expt 2 5)) ++(defconstant GCCapStyle (expt 2 6)) ++(defconstant GCJoinStyle (expt 2 7)) ++(defconstant GCFillStyle (expt 2 8)) ++(defconstant GCFillRule (expt 2 9) ) ++(defconstant GCTile (expt 2 10)) ++(defconstant GCStipple (expt 2 11)) ++(defconstant GCTileStipXOrigin (expt 2 12)) ++(defconstant GCTileStipYOrigin (expt 2 13)) ++(defconstant GCFont (expt 2 14)) ++(defconstant GCSubwindowMode (expt 2 15)) ++(defconstant GCGraphicsExposures (expt 2 16)) ++(defconstant GCClipXOrigin (expt 2 17)) ++(defconstant GCClipYOrigin (expt 2 18)) ++(defconstant GCClipMask (expt 2 19)) ++(defconstant GCDashOffset (expt 2 20)) ++(defconstant GCDashList (expt 2 21)) ++(defconstant GCArcMode (expt 2 22)) ++ ++(defconstant GCLastBit 22) ++;;**************************************************************** ++;; * FONTS ++;; **************************************************************** ++ ++;; used in QueryFont -- draw direction ++ ++(defconstant FontLeftToRight 0) ++(defconstant FontRightToLeft 1) ++ ++(defconstant FontChange 255) ++ ++;;**************************************************************** ++;; * IMAGING ++;; **************************************************************** ++ ++;; ImageFormat -- PutImage, GetImage ++ ++(defconstant XYBitmap 0 ) ;; depth 1, XYFormat ++(defconstant XYPixmap 1 ) ;; depth == drawable depth ++(defconstant ZPixmap 2 ) ;; depth == drawable depth ++ ++;;**************************************************************** ++;; * COLOR MAP STUFF ++;; **************************************************************** ++ ++;; For CreateColormap ++ ++(defconstant AllocNone 0 ) ;; create map with no entries ++(defconstant AllocAll 1 ) ;; allocate entire map writeable ++ ++ ++;; Flags used in StoreNamedColor, StoreColors ++ ++(defconstant DoRed (expt 2 0)) ++(defconstant DoGreen (expt 2 1)) ++(defconstant DoBlue (expt 2 2)) ++ ++;;**************************************************************** ++;; * CURSOR STUFF ++;; **************************************************************** ++ ++;; QueryBestSize Class ++ ++(defconstant CursorShape 0 ) ;; largest size that can be displayed ++(defconstant TileShape 1 ) ;; size tiled fastest ++(defconstant StippleShape 2 ) ;; size stippled fastest ++ ++;;**************************************************************** ++;; * KEYBOARD/POINTER STUFF ++;; **************************************************************** ++ ++(defconstant AutoRepeatModeOff 0) ++(defconstant AutoRepeatModeOn 1) ++(defconstant AutoRepeatModeDefault 2) ++ ++(defconstant LedModeOff 0) ++(defconstant LedModeOn 1) ++ ++;; masks for ChangeKeyboardControl ++ ++(defconstant KBKeyClickPercent (expt 2 0)) ++(defconstant KBBellPercent (expt 2 1)) ++(defconstant KBBellPitch (expt 2 2)) ++(defconstant KBBellDuration (expt 2 3)) ++(defconstant KBLed (expt 2 4)) ++(defconstant KBLedMode (expt 2 5)) ++(defconstant KBKey (expt 2 6)) ++(defconstant KBAutoRepeatMode (expt 2 7)) ++ ++(defconstant MappingSuccess 0) ++(defconstant MappingBusy 1) ++(defconstant MappingFailed 2) ++ ++(defconstant MappingModifier 0) ++(defconstant MappingKeyboard 1) ++(defconstant MappingPointer 2) ++ ++;;**************************************************************** ++;; * SCREEN SAVER STUFF ++;; **************************************************************** ++ ++(defconstant DontPreferBlanking 0) ++(defconstant PreferBlanking 1) ++(defconstant DefaultBlanking 2) ++ ++(defconstant DisableScreenSaver 0) ++(defconstant DisableScreenInterval 0) ++ ++(defconstant DontAllowExposures 0) ++(defconstant AllowExposures 1) ++(defconstant DefaultExposures 2) ++ ++;; for ForceScreenSaver ++ ++(defconstant ScreenSaverReset 0) ++(defconstant ScreenSaverActive 1) ++ ++;;**************************************************************** ++;; * HOSTS AND CONNECTIONS ++;; **************************************************************** ++ ++;; for ChangeHosts ++ ++(defconstant HostInsert 0) ++(defconstant HostDelete 1) ++ ++;; for ChangeAccessControl ++ ++(defconstant EnableAccess 1 ) ++(defconstant DisableAccess 0) ++ ++;; Display classes used in opening the connection ++;; * Note that the statically allocated ones are even numbered and the ++;; * dynamically changeable ones are odd numbered ++ ++(defconstant StaticGray 0) ++(defconstant GrayScale 1) ++(defconstant StaticColor 2) ++(defconstant PseudoColor 3) ++(defconstant TrueColor 4) ++(defconstant DirectColor 5) ++ ++ ++;; Byte order used in imageByteOrder and bitmapBitOrder ++ ++(defconstant LSBFirst 0) ++(defconstant MSBFirst 1) ++ ++ ++;(defconstant NULL 0) ++ ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_Xutil.lsp +@@ -0,0 +1,797 @@ ++(in-package :XLIB) ++; Xutil.lsp modified by Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++;; $XConsortium: Xutil.h,v 11.58 89/12/12 20:15:40 jim Exp $ */ ++ ++;;********************************************************** ++;;Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts, ++;;and the Massachusetts Institute of Technology, Cambridge, Massachusetts. ++ ++;;modified by Hiep H Nguyen 28 Jul 91 ++ ++;; All Rights Reserved ++ ++;;Permission to use, copy, modify, and distribute this software and its ++;;documentation for any purpose and without fee is hereby granted, ++;;provided that the above copyright notice appear in all copies and that ++;;both that copyright notice and this permission notice appear in ++;;supporting documentation, and that the names of Digital or MIT not be ++;;used in advertising or publicity pertaining to distribution of the ++;;software without specific, written prior permission. ++ ++;;DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ++;;ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL ++;;DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ++;;ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, ++;;WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ++;;ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS ++;;SOFTWARE. ++ ++;;***************************************************************** ++ ++;; ++;; * Bitmask returned by XParseGeometry(). Each bit tells if the corresponding) ++;; * value (x, y, width, height) was found in the parsed string.) ++ ++(defconstant NoValue 0000) ++(defconstant XValue 0001) ++(defconstant YValue 0002) ++(defconstant WidthValue 0004) ++(defconstant HeightValue 0008) ++(defconstant AllValues 15) ++(defconstant XNegative 16) ++(defconstant YNegative 32) ++ ++;; ++ ;; The next block of definitions are for window manager properties that ++ ;; clients and applications use for communication. ++ ++ ++;; flags argument in size hints ++(defconstant USPosition (expt 2 0) ) ;; user specified x, y ++(defconstant USSize (expt 2 1) ) ;; user specified width, height ++ ++(defconstant PPosition (expt 2 2) ) ;; program specified position ++(defconstant PSize (expt 2 3) ) ;; program specified size ++(defconstant PMinSize (expt 2 4) ) ;; program specified minimum size ++(defconstant PMaxSize (expt 2 5) ) ;; program specified maximum size ++(defconstant PResizeInc (expt 2 6) ) ;; program specified resize increments ++(defconstant PAspect (expt 2 7) ) ;; program specified min and max aspect ratios ++(defconstant PBaseSize (expt 2 8) ) ;; program specified base for incrementing ++(defconstant PWinGravity (expt 2 9) ) ;; program specified window gravity ++ ++;; obsolete ++(defconstant PAllHints (+ PPosition PSize PMinSize PMaxSize PResizeInc PAspect)) ++ ++;; definition for flags of XWMHints ++ ++(defconstant InputHint (expt 2 0)) ++(defconstant StateHint (expt 2 1)) ++(defconstant IconPixmapHint (expt 2 2)) ++(defconstant IconWindowHint (expt 2 3)) ++(defconstant IconPositionHint (expt 2 4)) ++(defconstant IconMaskHint (expt 2 5)) ++(defconstant WindowGroupHint (expt 2 6)) ++(defconstant AllHints ( + InputHint StateHint IconPixmapHint IconWindowHint ++IconPositionHint IconMaskHint WindowGroupHint)) ++ ++;; definitions for initial window state ++(defconstant WithdrawnState 0 ) ;; for windows that are not mapped ++(defconstant NormalState 1 ) ;; most applications want to start this way ++(defconstant IconicState 3 ) ;; application wants to start as an icon ++ ++;; ++ ;; Obsolete states no longer defined by ICCCM ++ ++(defconstant DontCareState 0 ) ;; don't know or care ++(defconstant ZoomState 2 ) ;; application wants to start zoomed ++(defconstant InactiveState 4 ) ;; application believes it is seldom used; ++ ;; some wm's may put it on inactive menu ++ ++ ++ ++;; ++ ;; opaque reference to Region data type ++ ++;;typedef struct _XRegion *Region; ++ ++;; Return values from XRectInRegion() ++ ++(defconstant RectangleOut 0) ++(defconstant RectangleIn 1) ++(defconstant RectanglePart 2) ++ ++ ++(defconstant VisualNoMask 0) ++(defconstant VisualIDMask 1) ++(defconstant VisualScreenMask 2) ++(defconstant VisualDepthMask 4) ++(defconstant VisualClassMask 8) ++(defconstant VisualRedMaskMask 16) ++(defconstant VisualGreenMaskMask 32) ++(defconstant VisualBlueMaskMask 64) ++(defconstant VisualColormapSizeMask 128) ++(defconstant VisualBitsPerRGBMask 256) ++(defconstant VisualAllMask 511) ++ ++(defconstant ReleaseByFreeingColormap 1) ;; for killid field above ++ ++ ++;; ++;; return codes for XReadBitmapFile and XWriteBitmapFile ++ ++(defconstant BitmapSuccess 0) ++(defconstant BitmapOpenFailed 1) ++(defconstant BitmapFileInvalid 2) ++(defconstant BitmapNoMemory 3) ++;; ++ ;; Declare the routines that don't return int. ++ ++ ++;; *************************************************************** ++;; * ++;; * Context Management ++;; * ++;; *************************************************************** ++ ++ ++;; Associative lookup table return codes ++ ++(defconstant XCSUCCESS 0 ) ;; No error. ++(defconstant XCNOMEM 1 ) ;; Out of memory ++(defconstant XCNOENT 2 ) ;; No entry in table ++ ++;;typedef fixnum XContext; ++ ++(defentry XSaveContext( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; context ++ fixnum ;; data ++ ++)( fixnum "XSaveContext")) ++ ++ ++ ++(defentry XFindContext( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; context ++ fixnum ;; data_return ++ ++)( fixnum "XFindContext")) ++ ++ ++ ++(defentry XDeleteContext( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; context ++ ++)( fixnum "XDeleteContext")) ++ ++ ++ ++ ++(defentry XGetWMHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( fixnum "XGetWMHints")) ++ ++ ++(defentry XCreateRegion( ++ ++;; void ++ ++)( fixnum "XCreateRegion")) ++ ++ ++(defentry XPolygonRegion( ++ ++ fixnum ;; points ++ fixnum ;; n ++ fixnum ;; fill_rule ++ ++)( fixnum "XPolygonRegion")) ++ ++ ++ ++(defentry XGetVisualInfo( ++ ++ fixnum ;; display ++ fixnum ;; vinfo_mask ++ fixnum ;; vinfo_template ++ fixnum ;; nitems_return ++ ++)( fixnum "XGetVisualInfo")) ++ ++;; Allocation routines for properties that may get longer ++ ++ ++(defentry XAllocSizeHints ( ++ ++;; void ++ ++)( fixnum "XAllocSizeHints" )) ++ ++ ++(defentry XAllocStandardColormap ( ++ ++;; void ++ ++)( fixnum "XAllocStandardColormap" )) ++ ++ ++(defentry XAllocWMHints ( ++ ++;; void ++ ++)( fixnum "XAllocWMHints" )) ++ ++ ++(defentry XAllocClassHint ( ++ ++;; void ++ ++)( fixnum "XAllocClassHint" )) ++ ++ ++(defentry XAllocIconSize ( ++ ++;; void ++ ++)( fixnum "XAllocIconSize" )) ++ ++;; ICCCM routines for data structures defined in this file ++ ++ ++(defentry XGetWMSizeHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints_return ++ fixnum ;; supplied_return ++ fixnum ;; property ++ ++)( fixnum "XGetWMSizeHints")) ++ ++ ++(defentry XGetWMNormalHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints_return ++ fixnum ;; supplied_return ++ ++)( fixnum "XGetWMNormalHints")) ++ ++ ++(defentry XGetRGBColormaps( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; stdcmap_return ++ fixnum ;; count_return ++ fixnum ;; property ++ ++)( fixnum "XGetRGBColormaps")) ++ ++ ++(defentry XGetTextProperty( ++ ++ fixnum ;; display ++ fixnum ;; window ++ fixnum ;; text_prop_return ++ fixnum ;; property ++ ++)( fixnum "XGetTextProperty")) ++ ++ ++(defentry XGetWMName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; text_prop_return ++ ++)( fixnum "XGetWMName")) ++ ++ ++(defentry XGetWMIconName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; text_prop_return ++ ++)( fixnum "XGetWMIconName")) ++ ++ ++(defentry XGetWMClientMachine( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; text_prop_return ++ ++)( fixnum "XGetWMClientMachine")) ++ ++ ++(defentry XSetWMProperties( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; window_name ++ fixnum ;; icon_name ++ fixnum ;; argv ++ fixnum ;; argc ++ fixnum ;; normal_hints ++ fixnum ;; wm_hints ++ fixnum ;; class_hints ++ ++)( void "XSetWMProperties")) ++ ++ ++(defentry XSetWMSizeHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints ++ fixnum ;; property ++ ++)( void "XSetWMSizeHints")) ++ ++ ++(defentry XSetWMNormalHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints ++ ++)( void "XSetWMNormalHints")) ++ ++ ++(defentry XSetRGBColormaps( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; stdcmaps ++ fixnum ;; count ++ fixnum ;; property ++ ++)( void "XSetRGBColormaps")) ++ ++ ++(defentry XSetTextProperty( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; text_prop ++ fixnum ;; property ++ ++)( void "XSetTextProperty")) ++ ++ ++(defentry XSetWMName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; text_prop ++ ++)( void "XSetWMName")) ++ ++ ++(defentry XSetWMIconName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; text_prop ++ ++)( void "XSetWMIconName")) ++ ++ ++(defentry XSetWMClientMachine( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; text_prop ++ ++)( void "XSetWMClientMachine")) ++ ++ ++(defentry XStringListToTextProperty( ++ ++ fixnum ;; list ++ fixnum ;; count ++ fixnum ;; text_prop_return ++ ++)( fixnum "XStringListToTextProperty")) ++ ++ ++(defentry XTextPropertyToStringList( ++ ++ fixnum ;; text_prop ++ fixnum ;; list_return ++ fixnum ;; count_return ++ ++)( fixnum "XTextPropertyToStringList")) ++ ++;; The following declarations are alphabetized. ++ ++ ++ ++(defentry XClipBox( ++ ++ fixnum ;; r ++ fixnum ;; rect_return ++ ++)( void "XClipBox")) ++ ++ ++ ++(defentry XDestroyRegion( ++ ++ fixnum ;; r ++ ++)( void "XDestroyRegion")) ++ ++ ++ ++(defentry XEmptyRegion( ++ ++ fixnum ;; r ++ ++)( void "XEmptyRegion")) ++ ++ ++ ++(defentry XEqualRegion( ++ ++ fixnum ;; r1 ++ fixnum ;; r2 ++ ++)( void "XEqualRegion")) ++ ++ ++ ++(defentry XGetClassHint( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; class_hints_return ++ ++)( fixnum "XGetClassHint")) ++ ++ ++ ++(defentry XGetIconSizes( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; size_list_return ++ fixnum ;; count_return ++ ++)( fixnum "XGetIconSizes")) ++ ++ ++ ++(defentry XGetNormalHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints_return ++ ++)( fixnum "XGetNormalHints")) ++ ++ ++ ++(defentry XGetSizeHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints_return ++ fixnum ;; property ++ ++)( fixnum "XGetSizeHints")) ++ ++ ++ ++(defentry XGetStandardColormap( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; colormap_return ++ fixnum ;; property ++ ++)( fixnum "XGetStandardColormap")) ++ ++ ++ ++(defentry XGetZoomHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; zhints_return ++ ++)( fixnum "XGetZoomHints")) ++ ++ ++ ++(defentry XIntersectRegion( ++ ++ fixnum ;; sra ++ fixnum ;; srb ++ fixnum ;; dr_return ++ ++)( void "XIntersectRegion")) ++ ++ ++ ++(defentry XLookupString( ++ ++ fixnum ;; event_struct ++ object ;; buffer_return ++ fixnum ;; bytes_buffer ++ fixnum ;; keysym_return ++ fixnum ;; int_in_out ++ ++)( fixnum "XLookupString")) ++ ++ ++ ++(defentry XMatchVisualInfo( ++ ++ fixnum ;; display ++ fixnum ;; screen ++ fixnum ;; depth ++ fixnum ;; class ++ fixnum ;; vinfo_return ++ ++)( fixnum "XMatchVisualInfo")) ++ ++ ++ ++(defentry XOffsetRegion( ++ ++ fixnum ;; r ++ fixnum ;; dx ++ fixnum ;; dy ++ ++)( void "XOffsetRegion")) ++ ++ ++ ++(defentry XPointInRegion( ++ ++ fixnum ;; r ++ fixnum ;; x ++ fixnum ;; y ++ ++)( fixnum "XPointInRegion")) ++ ++ ++ ++(defentry XRectInRegion( ++ ++ fixnum ;; r ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ ++)( fixnum "XRectInRegion")) ++ ++ ++ ++(defentry XSetClassHint( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; class_hints ++ ++)( void "XSetClassHint")) ++ ++ ++ ++(defentry XSetIconSizes( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; size_list ++ fixnum ;; count ++ ++)( void "XSetIconSizes")) ++ ++ ++ ++(defentry XSetNormalHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints ++ ++)( void "XSetNormalHints")) ++ ++ ++ ++(defentry XSetSizeHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints ++ fixnum ;; property ++ ++)( void "XSetSizeHints")) ++ ++ ++ ++(defentry XSetStandardProperties( ++ ++ fixnum ;; display ++ fixnum ;; w ++ object ;; window_name ++ object ;; icon_name ++ fixnum ;; icon_pixmap ++ fixnum ;; argv ++ fixnum ;; argc ++ fixnum ;; hints ++ ++)( void "XSetStandardProperties")) ++ ++ ++ ++(defentry XSetWMHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; wm_hints ++ ++)( void "XSetWMHints")) ++ ++ ++ ++(defentry XSetRegion( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; r ++ ++)( void "XSetRegion")) ++ ++ ++ ++(defentry XSetStandardColormap( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; colormap ++ fixnum ;; property ++ ++)( void "XSetStandardColormap")) ++ ++ ++ ++(defentry XSetZoomHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; zhints ++ ++)( void "XSetZoomHints")) ++ ++ ++ ++(defentry XShrinkRegion( ++ ++ fixnum ;; r ++ fixnum ;; dx ++ fixnum ;; dy ++ ++)( void "XShrinkRegion")) ++ ++ ++ ++(defentry XSubtractRegion( ++ ++ fixnum ;; sra ++ fixnum ;; srb ++ fixnum ;; dr_return ++ ++)( void "XSubtractRegion")) ++ ++ ++ ++(defentry XUnionRectWithRegion( ++ ++ fixnum ;; rectangle ++ fixnum ;; src_region ++ fixnum ;; dest_region_return ++ ++)( void "XUnionRectWithRegion")) ++ ++ ++ ++(defentry XUnionRegion( ++ ++ fixnum ;; sra ++ fixnum ;; srb ++ fixnum ;; dr_return ++ ++)( void "XUnionRegion")) ++ ++ ++ ++(defentry XWMGeometry( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ object ;; user_geometry ++ object ;; default_geometry ++ fixnum ;; border_width ++ fixnum ;; hints ++ fixnum ;; x_return ++ fixnum ;; y_return ++ fixnum ;; width_return ++ fixnum ;; height_return ++ fixnum ;; gravity_return ++ ++)( fixnum "XWMGeometry")) ++ ++ ++ ++(defentry XXorRegion( ++ ++ fixnum ;; sra ++ fixnum ;; srb ++ fixnum ;; dr_return ++ ++)( void "XXorRegion")) ++;; ++ ;; These macros are used to give some sugar to the image routines so that ++ ;; naive people are more comfortable with them. ++ ++(defentry XDestroyImage(fixnum) (fixnum "XDestroyImage")) ++(defentry XGetPixel(fixnum fixnum fixnum) (fixnum "XGetPixel" )) ++(defentry XPutPixel(fixnum fixnum int fixnum) ( fixnum "XPutPixel")) ++(defentry XSubImage(fixnum fixnum int fixnum fixnum) (fixnum "XSubImage")) ++(defentry XAddPixel(fixnum fixnum) (fixnum "XAddPixel")) ++;; ++ ;; Keysym macros, used on Keysyms to test for classes of symbols ++ ++(defentry IsKeypadKey(fixnum) (fixnum "IsKeypadKey")) ++ ++(defentry IsCursorKey(fixnum) (fixnum "IsCursorKey")) ++ ++(defentry IsPFKey(fixnum) (fixnum "IsPFKey")) ++ ++(defentry IsFunctionKey(fixnum) (fixnum "IsFunctionKey")) ++ ++(defentry IsMiscFunctionKey(fixnum) (fixnum "IsMiscFunctionKey")) ++ ++(defentry IsModifierKey(fixnum) (fixnum "IsModifierKey")) ++(defentry XUniqueContext() (fixnum "XUniqueContext")) ++(defentry XStringToContext(object) (fixnum "XStringToContext")) ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_drawtrans.lsp +@@ -0,0 +1,1890 @@ ++; 07 Jan 2010 16:40:19 EST ++; drawtrans.lsp -- translation of draw.lsp Gordon S. Novak Jr. ++ ++; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; This program 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 program 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 program; if not, write to the Free Software ++; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++(IN-PACKAGE :USER) ++ ++(defmacro while (test &rest forms) `(loop (unless ,test (return)) ,@forms) ) ++ ++(defmacro nconc1 (lst x) `(nconc ,lst (cons ,x nil))) ++ ++(defmacro glmethod (class selector) ++ `(cadr (assoc ,selector (getf (cdr (get ,class 'glstructure)) 'msg))) ) ++ ++(SETF (GET 'MENU-SET 'GLSTRUCTURE) ++ '((LISTOBJECT (WINDOW WINDOW) (MENU-ITEMS (LISTOF MENU-SET-ITEM)) ++ (COMMANDFN ANYTHING)) ++ MSG ++ ((DRAW MENU-SET-DRAW) (SELECT MENU-SET-SELECT) ++ (NAMED-MENU MENU-SET-NAMED-MENU) ++ (NAMED-ITEM MENU-SET-NAMED-ITEM) (ADD-MENU MENU-SET-ADD-MENU) ++ (ADD-PICMENU MENU-SET-ADD-PICMENU) ++ (ADD-COMPONENT MENU-SET-ADD-COMPONENT) ++ (ADD-BARMENU MENU-SET-ADD-BARMENU) ++ (ADD-ITEM MENU-SET-ADD-ITEM) (FIND-ITEM MENU-SET-FIND-ITEM) ++ (DELETE-ITEM MENU-SET-DELETE-ITEM) ++ (REMOVE-ITEMS MENU-SET-REMOVE-ITEMS) ++ (ITEM-POSITION MENU-SET-ITEM-POSITION) (ITEMP MENU-SET-ITEMP) ++ (ADJUST MENU-SET-ADJUST) (MOVE MENU-SET-MOVE) ++ (DRAW-CONN MENU-SET-DRAW-CONN)))) ++(SETF (GET 'MENU-SET-ITEM 'GLSTRUCTURE) ++ '((LIST (MENU-NAME SYMBOL) (SYM ANYTHING) (MENU MENU-SET-MENU)) ++ PROP ++ ((LEFT ((PARENT-OFFSET-X MENU))) ++ (BOTTOM ((PARENT-OFFSET-Y MENU))) ++ (WIDTH ((PICTURE-WIDTH MENU))) ++ (HEIGHT ((PICTURE-HEIGHT MENU)))) ++ SUPERS (REGION))) ++(SETF (GET 'MENU-SET-MENU 'GLSTRUCTURE) ++ '((TRANSPARENT MENU) MSG ((DRAW MENU-MDRAW)))) ++(SETF (GET 'MENU-PORT 'GLSTRUCTURE) ++ '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL)))) ++(SETF (GET 'MENU-SELECTION 'GLSTRUCTURE) ++ '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL) (BUTTON INTEGER)))) ++(SETF (GET 'MENU-SET-CONN 'GLSTRUCTURE) ++ '((LIST (FROM MENU-PORT) (TO MENU-PORT)))) ++(SETF (GET 'MENU-CONNS 'GLSTRUCTURE) ++ '((LISTOBJECT (MENU-SET MENU-SET) ++ (CONNECTIONS (LISTOF MENU-SET-CONN))) ++ PROP ((WINDOW ((WINDOW (MENU-SET SELF))))) MSG ++ ((DRAW MENU-CONNS-DRAW) (REDRAW MENU-CONNS-REDRAW) ++ (MOVE MENU-CONNS-MOVE) (ADD-CONN MENU-CONNS-ADD-CONN) ++ (ADD-ITEM MENU-CONNS-ADD-ITEM OPEN T) ++ (FIND-CONN MENU-CONNS-FIND-CONN) ++ (FIND-ITEM MENU-CONNS-FIND-ITEM) ++ (DELETE-ITEM MENU-CONNS-DELETE-ITEM) ++ (DELETE-CONN MENU-CONNS-DELETE-CONN) ++ (REMOVE-ITEMS MENU-CONNS-REMOVE-ITEMS) ++ (FIND-CONNS MENU-CONNS-FIND-CONNS) ++ (CONNECTED-PORTS MENU-CONNS-CONNECTED-PORTS) ++ (NEW-CONN MENU-CONNS-NEW-CONN) ++ (NAMED-MENU MENU-CONNS-NAMED-MENU) ++ (NAMED-ITEM MENU-CONNS-NAMED-ITEM)))) ++ ++ ++(DEFUN MENU-SET-CREATE (W &OPTIONAL FN) (LIST 'MENU-SET W NIL FN)) ++(SETF (GET 'MENU-SET-CREATE 'GLARGUMENTS) ++ '((W WINDOW) (&OPTIONAL NIL))) ++(SETF (GET 'MENU-SET-CREATE 'GLFNRESULTTYPE) 'MENU-SET) ++ ++ ++(DEFUN MENU-SET-SELECT (MS &OPTIONAL REDRAW ENABLED) ++ (LET (RES RESB ITM SEL LASTX LASTY) ++ (IF REDRAW (MENU-SET-DRAW MS)) ++ (WHILE (NOT (OR RES RESB)) ++ (SETQ ITM ++ (WINDOW-TRACK-MOUSE (CADR MS) ++ #'(LAMBDA (X Y CODE) ++ (OR (AND (PLUSP CODE) (SETQ LASTX X) ++ (SETQ LASTY Y) CODE) ++ (SOME #'(LAMBDA (GLVAR128) ++ (IF ++ (AND ++ (BETWEEN X ++ (FIFTH (CADDR GLVAR128)) ++ (+ (FIFTH (CADDR GLVAR128)) ++ (SEVENTH (CADDR GLVAR128)))) ++ (BETWEEN Y ++ (SIXTH (CADDR GLVAR128)) ++ (+ (SIXTH (CADDR GLVAR128)) ++ (EIGHTH (CADDR GLVAR128))))) ++ GLVAR128)) ++ (CADDR MS)))))) ++ (IF (NUMBERP ITM) ++ (SETQ RESB (LIST (LIST LASTX LASTY) 'BACKGROUND ITM)) ++ (WHEN (OR (ATOM ENABLED) (MEMBER (CAR ITM) ENABLED)) ++ (SETQ SEL (MENU-MSELECT (CADDR ITM) (EQ ENABLED T))) ++ (IF SEL ++ (SETQ RES (LIST SEL (CAR ITM) *WINDOW-MENU-CODE*)) ++ (IF (AND *WINDOW-MENU-CODE* ++ (NOT (ZEROP *WINDOW-MENU-CODE*))) ++ (SETQ RES ++ (LIST NIL (CAR ITM) *WINDOW-MENU-CODE*))))))) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (OR RES RESB))) ++(SETF (GET 'MENU-SET-SELECT 'GLARGUMENTS) ++ '((MS MENU-SET) (&OPTIONAL BOOLEAN) (REDRAW (LISTOF SYMBOL)))) ++(SETF (GET 'MENU-SET-SELECT 'GLFNRESULTTYPE) 'MENU-SELECTION) ++ ++ ++(DEFUN MENU-SET-ADD-MENU (MS NAME SYM TITLE ITEMS &OPTIONAL OFFSET) ++ (LET (MENU) ++ (SETQ MENU ++ (MENU-CREATE ITEMS TITLE (CADR MS) (CAR OFFSET) (CADR OFFSET) ++ T T)) ++ (MENU-INIT MENU) ++ (IF (NOT OFFSET) ++ (SETQ OFFSET ++ (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) ++ (EIGHTH MENU)))) ++ (SETF (FIFTH MENU) (CAR OFFSET)) ++ (SETF (SIXTH MENU) (CADR OFFSET)) ++ (MENU-SET-ADD-ITEM MS NAME SYM MENU))) ++(SETF (GET 'MENU-SET-ADD-MENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) ++ (ITEMS NIL) (&OPTIONAL VECTOR))) ++(SETF (GET 'MENU-SET-ADD-MENU 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-ITEM (MS NAME SYM MENU) ++ (SETF (CADDR MS) (NCONC (CADDR MS) (CONS (LIST NAME SYM MENU) NIL)))) ++(SETF (GET 'MENU-SET-ADD-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) ++(SETF (GET 'MENU-SET-ADD-ITEM 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-REMOVE-ITEMS (MS) (SETF (CADDR MS) NIL)) ++(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLARGUMENTS) '((MS MENU-SET))) ++(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-PICMENU ++ (MS NAME SYM TITLE SPEC &OPTIONAL OFFSET NOBOX) ++ (LET (MENU MAXWIDTH MAXHEIGHT) ++ (IF (AND SPEC (SYMBOLP SPEC)) (SETQ SPEC (GET SPEC 'PICMENU-SPEC))) ++ (SETQ MENU ++ (PICMENU-CREATE-FROM-SPEC SPEC TITLE (CADR MS) (CAR OFFSET) ++ (CADR OFFSET) T T (NOT NOBOX))) ++ (SETQ MAXWIDTH ++ (MAX (IF TITLE (+ 6 (* 9 (LENGTH TITLE))) 0) (CADR SPEC))) ++ (SETQ MAXHEIGHT (+ (IF TITLE 15 0) (CADDR SPEC))) ++ (IF (NOT OFFSET) ++ (SETQ OFFSET ++ (WINDOW-GET-BOX-POSITION (CADR MS) MAXWIDTH MAXHEIGHT))) ++ (SETF (FIFTH MENU) (CAR OFFSET)) ++ (SETF (SIXTH MENU) (CADR OFFSET)) ++ (MENU-SET-ADD-ITEM MS NAME SYM MENU))) ++(SETF (GET 'MENU-SET-ADD-PICMENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) ++ (SPEC PICMENU-SPEC) (&OPTIONAL VECTOR) (OFFSET BOOLEAN))) ++(SETF (GET 'MENU-SET-ADD-PICMENU 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-COMPONENT (MS NAME &OPTIONAL OFFSET) ++ (MENU-SET-ADD-PICMENU MS (MENU-SET-NAME NAME) NAME NIL NAME OFFSET T)) ++(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (&OPTIONAL VECTOR))) ++(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-BARMENU (MS NAME SYM MENU TITLE &OPTIONAL OFFSET) ++ (BARMENU-INIT MENU) ++ (IF (NOT OFFSET) ++ (SETQ OFFSET ++ (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) ++ (EIGHTH MENU)))) ++ (SETF (FIFTH MENU) (CAR OFFSET)) ++ (SETF (SIXTH MENU) (CADR OFFSET)) ++ (MENU-SET-ADD-ITEM MS NAME SYM MENU)) ++(SETF (GET 'MENU-SET-ADD-BARMENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU BARMENU) ++ (TITLE STRING) (&OPTIONAL VECTOR))) ++(SETF (GET 'MENU-SET-ADD-BARMENU 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-NAME (NM) ++ (INTERN (SYMBOL-NAME (GENSYM (SYMBOL-NAME NM))))) ++(SETF (GET 'MENU-SET-NAME 'GLARGUMENTS) '((NM SYMBOL))) ++(SETF (GET 'MENU-SET-NAME 'GLFNRESULTTYPE) 'SYMBOL) ++ ++ ++(DEFUN MENU-SET-NAMED-ITEM (MS NAME) (ASSOC NAME (CADDR MS))) ++(SETF (GET 'MENU-SET-NAMED-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL))) ++(SETF (GET 'MENU-SET-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-SET-NAMED-MENU (MS NAME) ++ (CADDR (MENU-SET-NAMED-ITEM MS NAME))) ++(SETF (GET 'MENU-SET-NAMED-MENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL))) ++(SETF (GET 'MENU-SET-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) ++ ++ ++(DEFUN MENU-SET-ITEMP (MS NAME ITEMNAME) ++ (LET ((THISMENU (MENU-SET-NAMED-MENU MS NAME))) ++ (IF (EQ (FIRST THISMENU) 'MENU) ++ (SOME #'(LAMBDA (X) ++ (OR (EQ X ITEMNAME) ++ (AND (CONSP X) (EQ (CAR X) ITEMNAME)))) ++ (NTH 13 THISMENU)) ++ (IF (EQ (FIRST THISMENU) 'PICMENU) ++ (ASSOC ITEMNAME (CADDDR (NTH 10 THISMENU))))))) ++(SETF (GET 'MENU-SET-ITEMP 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (ITEMNAME SYMBOL))) ++(SETF (GET 'MENU-SET-ITEMP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN MENU-CONNS-NAMED-ITEM (MC NAME) ++ (MENU-SET-NAMED-ITEM (CADR MC) NAME)) ++(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLARGUMENTS) ++ '((MC MENU-CONNS) (NAME SYMBOL))) ++(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-CONNS-NAMED-MENU (MC NAME) ++ (MENU-SET-NAMED-MENU (CADR MC) NAME)) ++(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLARGUMENTS) ++ '((MC MENU-CONNS) (NAME SYMBOL))) ++(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) ++ ++ ++(DEFUN MENU-SET-FIND-ITEM (MS POS) ++ (LET (MITEM) ++ (DOLIST (MI (CADDR MS)) ++ (IF (AND (BETWEEN (CAR POS) ++ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (FIFTH SELF) 0)) ++ (+ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (FIFTH SELF) 0)) ++ (SEVENTH (CADDR MI)))) ++ (BETWEEN (CADR POS) ++ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (SIXTH SELF) 0)) ++ (+ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (SIXTH SELF) 0)) ++ (EIGHTH (CADDR MI))))) ++ (SETQ MITEM MI))) ++ MITEM)) ++(SETF (GET 'MENU-SET-FIND-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (POS VECTOR))) ++(SETF (GET 'MENU-SET-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-SET-DELETE-ITEM (MS MI) ++ (SETF (CADDR MS) (REMOVE MI (CADDR MS)))) ++(SETF (GET 'MENU-SET-DELETE-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (MI MENU-SET-ITEM))) ++(SETF (GET 'MENU-SET-DELETE-ITEM 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-MOVE (MS) ++ (LET (SEL M) ++ (SETQ SEL (MENU-SET-SELECT MS NIL T)) ++ (SETQ M (MENU-SET-NAMED-MENU MS (CADR SEL))) ++ (MENU-REPOSITION M))) ++ ++(DEFUN MENU-MDRAW (M) ++ (CASE (FIRST M) ++ (MENU (MENU-DRAW M)) ++ (PICMENU (PICMENU-DRAW M)) ++ (BARMENU (BARMENU-DRAW M)) ++ (TEXTMENU (TEXTMENU-DRAW M)) ++ (EDITMENU (EDITMENU-DRAW M)) ++ (T (GLSEND M DRAW)))) ++ ++(DEFUN MENU-MSELECT (M &OPTIONAL ANYCLICK) ++ (CASE (FIRST M) ++ (MENU (MENU-SELECT M T)) ++ (PICMENU (PICMENU-SELECT M T ANYCLICK)) ++ (BARMENU (BARMENU-SELECT M)) ++ (TEXTMENU (TEXTMENU-SELECT M T)) ++ (EDITMENU (EDITMENU-SELECT M T)) ++ (T (GLSEND M SELECT)))) ++ ++(DEFUN MENU-MITEM-POSITION (M NAME LOC) ++ (CASE (FIRST M) ++ (MENU (MENU-ITEM-POSITION M NAME LOC)) ++ (PICMENU (PICMENU-ITEM-POSITION M NAME LOC)) ++ (T (GLSEND M ITEM-POSITION NAME LOC)))) ++ ++(DEFUN MENU-SET-DRAW (MS) ++ (XMAPWINDOW *WINDOW-DISPLAY* (CADADR MS)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-EXPOSURE (CADR MS)) ++ (DOLIST (ITEM (CADDR MS)) (MENU-MDRAW (CADDR ITEM)))) ++ ++(DEFUN MENU-SET-ITEM-POSITION (MS DESC &OPTIONAL LOC) ++ (LET (M) ++ (SETQ M (MENU-SET-NAMED-MENU MS (CADR DESC))) ++ (OR (MENU-MITEM-POSITION M (CAR DESC) LOC) ++ (MENU-MITEM-POSITION M NIL LOC)))) ++(SETF (GET 'MENU-SET-ITEM-POSITION 'GLARGUMENTS) ++ '((MS MENU-SET) (DESC MENU-PORT) (&OPTIONAL SYMBOL))) ++(SETF (GET 'MENU-SET-ITEM-POSITION 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN MENU-SET-DRAW-CONN (MS CONN) ++ (LET (PA PB TMP (DESCA (CAR CONN)) (DESCB (CADR CONN))) ++ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) ++ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) ++ (WHEN (> (CAR PA) (CAR PB)) ++ (SETQ TMP DESCA) ++ (SETQ DESCA DESCB) ++ (SETQ DESCB TMP)) ++ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) ++ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) ++ (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PA) (CADR PA) 3 NIL) ++ (WINDOW-DRAW-LINE-XY (CADR MS) (CAR PA) (CADR PA) (CAR PB) ++ (CADR PB) NIL) ++ (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PB) (CADR PB) 3 NIL) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN MENU-SET-ADJUST (MS NAME EDGE FROM OFFSET) ++ (LET (M FROMM PLACE) ++ (WHEN (SETQ M (MENU-SET-NAMED-ITEM MS NAME)) ++ (IF FROM ++ (PROGN ++ (SETQ FROMM (MENU-SET-NAMED-ITEM MS FROM)) ++ (SETQ PLACE ++ (CASE EDGE ++ (TOP (SIXTH (CADDR FROMM))) ++ (BOTTOM (+ (SIXTH (CADDR FROMM)) ++ (EIGHTH (CADDR FROMM)))) ++ (LEFT (+ (FIFTH (CADDR FROMM)) ++ (SEVENTH (CADDR FROMM)))) ++ (RIGHT (FIFTH (CADDR FROMM)))))) ++ (SETQ PLACE ++ (CASE EDGE ++ (TOP (CADDDR (CADR MS))) ++ ((BOTTOM LEFT) 0) ++ (RIGHT (FIFTH (CADR MS)))))) ++ (CASE EDGE ++ (TOP (SETF (SIXTH (CADDR M)) ++ (- (- PLACE (EIGHTH (CADDR M))) OFFSET))) ++ (BOTTOM (SETF (SIXTH (CADDR M)) (+ PLACE OFFSET))) ++ (LEFT (SETF (FIFTH (CADDR M)) (+ PLACE OFFSET))) ++ (RIGHT (SETF (FIFTH (CADDR M)) ++ (- (- PLACE (SEVENTH (CADDR M))) OFFSET))))))) ++(SETF (GET 'MENU-SET-ADJUST 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (EDGE SYMBOL) (FROM SYMBOL) ++ (OFFSET INTEGER))) ++(SETF (GET 'MENU-SET-ADJUST 'GLFNRESULTTYPE) 'INTEGER) ++ ++ ++(DEFUN VECTOR-SNAP (FIXED APPROX &OPTIONAL TOLERANCE) ++ (OR TOLERANCE (SETQ TOLERANCE 10)) ++ (IF (< (ABS (- (CAR FIXED) (CAR APPROX))) TOLERANCE) ++ (LIST (CAR FIXED) (CADR APPROX)) ++ (IF (< (ABS (- (CADR FIXED) (CADR APPROX))) TOLERANCE) ++ (LIST (CAR APPROX) (CADR FIXED)) APPROX))) ++(SETF (GET 'VECTOR-SNAP 'GLARGUMENTS) ++ '((FIXED VECTOR) (APPROX VECTOR) (&OPTIONAL NIL))) ++(SETF (GET 'VECTOR-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN MENU-CONNS-CREATE (MS) (LIST 'MENU-CONNS MS NIL)) ++(SETF (GET 'MENU-CONNS-CREATE 'GLARGUMENTS) '((MS MENU-SET))) ++(SETF (GET 'MENU-CONNS-CREATE 'GLFNRESULTTYPE) 'MENU-CONNS) ++ ++ ++(DEFUN MENU-CONNS-DRAW (MC) ++ (MENU-SET-DRAW (CADR MC)) ++ (DOLIST (C (CADDR MC)) (MENU-SET-DRAW-CONN (CADR MC) C))) ++ ++(DEFUN MENU-CONNS-MOVE (MC) ++ (MENU-SET-MOVE (CADR MC)) ++ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (MENU-CONNS-DRAW MC)) ++ ++(DEFUN MENU-CONNS-REDRAW (MC) ++ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (MENU-CONNS-DRAW MC)) ++ ++(DEFUN MENU-CONNS-ADD-CONN (MC) ++ (LET (SEL SELB CONN) ++ (SETQ SEL (MENU-SET-SELECT (CADR MC))) ++ (IF (EQ (CADR SEL) 'BACKGROUND) SEL ++ (PROGN ++ (SETQ SELB (MENU-SET-SELECT (CADR MC))) ++ (WHEN (NOT (EQ (CADR SELB) 'BACKGROUND)) ++ (SETQ CONN (LIST SEL SELB)) ++ (MENU-SET-DRAW-CONN (CADR MC) CONN) ++ (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL)))) ++ NIL)))) ++(SETF (GET 'MENU-CONNS-ADD-CONN 'GLARGUMENTS) '((MC MENU-CONNS))) ++(SETF (GET 'MENU-CONNS-ADD-CONN 'GLFNRESULTTYPE) 'MENU-SELECTION) ++ ++ ++(DEFUN MENU-CONNS-NEW-CONN (MC FROMNAME FROMPORT TONAME TOPORT) ++ (LET (CONN) ++ (SETQ CONN (LIST (LIST FROMPORT FROMNAME) (LIST TOPORT TONAME))) ++ (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL))))) ++(SETF (GET 'MENU-CONNS-NEW-CONN 'GLARGUMENTS) ++ '((MC MENU-CONNS) (FROMNAME SYMBOL) (FROMPORT SYMBOL) ++ (TONAME SYMBOL) (TOPORT SYMBOL))) ++(SETF (GET 'MENU-CONNS-NEW-CONN 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-CONN)) ++ ++ ++(DEFUN MENU-CONNS-ADD-ITEM (MC NAME SYM MENU) ++ (MENU-SET-ADD-ITEM (CADR MC) NAME SYM MENU)) ++(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLARGUMENTS) ++ '((MC MENU-CONNS) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) ++(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-CONNS-FIND-CONN (MC PT) ++ (LET (MS LS FOUND RES PA PB TMP DESCA DESCB) ++ (SETQ LS (LIST (COPY-LIST '(0 0)) (COPY-LIST '(0 0)))) ++ (SETQ MS (CADR MC)) ++ (DOLIST (CONN (CADDR MC)) ++ (UNLESS FOUND ++ (SETQ DESCA (CAR CONN)) ++ (SETQ DESCB (CADR CONN)) ++ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) ++ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) ++ (WHEN (> (CAR PA) (CAR PB)) ++ (SETQ TMP DESCA) ++ (SETQ DESCA DESCB) ++ (SETQ DESCB TMP)) ++ (SETF (CAR LS) (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) ++ (SETF (CADR LS) (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) ++ (WHEN (< (ABS (/ (- (* (- (CAADR LS) (CAAR LS)) ++ (- (CADR PT) (CADAR LS))) ++ (* (- (CADADR LS) (CADAR LS)) ++ (- (CAR PT) (CAAR LS)))) ++ (SQRT (+ (EXPT (- (CAADR LS) (CAAR LS)) 2) ++ (EXPT (- (CADADR LS) (CADAR LS)) 2))))) ++ 5) ++ (SETQ FOUND T) ++ (SETQ RES CONN)))) ++ RES)) ++(SETF (GET 'MENU-CONNS-FIND-CONN 'GLARGUMENTS) ++ '((MC MENU-CONNS) (PT VECTOR))) ++(SETF (GET 'MENU-CONNS-FIND-CONN 'GLFNRESULTTYPE) 'MENU-SET-CONN) ++ ++ ++(DEFUN MENU-CONNS-FIND-ITEM (MC PT) (MENU-SET-FIND-ITEM (CADR MC) PT)) ++(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLARGUMENTS) ++ '((MC MENU-CONNS) (PT VECTOR))) ++(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-CONNS-DELETE-CONN (MC CONN) ++ (SETF (CADDR MC) (REMOVE CONN (CADDR MC)))) ++(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLARGUMENTS) ++ '((MC MENU-CONNS) (CONN MENU-SET-CONN))) ++(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-CONN)) ++ ++ ++(DEFUN MENU-CONNS-DELETE-ITEM (MC MI) ++ (LET (MS) ++ (SETQ MS (CADR MC)) ++ (MENU-SET-DELETE-ITEM MS MI) ++ (DOLIST (CONN (CADDR MC)) ++ (IF (OR (EQ (CADAR CONN) (CAR MI)) (EQ (CADADR CONN) (CAR MI))) ++ (MENU-CONNS-DELETE-CONN MC CONN))))) ++ ++(DEFUN MENU-CONNS-REMOVE-ITEMS (MC) ++ (MENU-SET-REMOVE-ITEMS (CADR MC)) ++ (SETF (CADDR MC) NIL)) ++(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLARGUMENTS) '((MC MENU-CONNS))) ++(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-CONN)) ++ ++ ++(DEFUN MENU-CONNS-CONNECTED-PORTS (MC BOXNAME) ++ (LET (PORTS) ++ (DOLIST (CONN (CADDR MC)) ++ (IF (EQ BOXNAME (CADADR CONN)) (PUSHNEW (CAADR CONN) PORTS) ++ (IF (EQ BOXNAME (CADAR CONN)) (PUSHNEW (CAAR CONN) PORTS)))) ++ PORTS)) ++ ++(DEFUN MENU-CONNS-FIND-CONNS (MC BOXNAME PORT) ++ (LET (RES) ++ (DOLIST (CONN (CADDR MC)) ++ (IF (AND (EQ BOXNAME (CADADR CONN)) (EQ PORT (CAADR CONN))) ++ (SETQ RES (NCONC RES (CONS (CAR CONN) NIL)))) ++ (IF (AND (EQ BOXNAME (CADAR CONN)) (EQ PORT (CAAR CONN))) ++ (SETQ RES (NCONC RES (CONS (CADR CONN) NIL))))) ++ RES)) ++(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLARGUMENTS) ++ '((MC MENU-CONNS) (BOXNAME SYMBOL) (PORT SYMBOL))) ++(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLFNRESULTTYPE) '(LISTOF MENU-PORT)) ++ ++ ++(DEFUN COMPILE-MENU-SET () ++ (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") ++ '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" ++ "glisp/menu-set-header.lsp") ++ (COMPILE-FILE "glisp/menu-settrans.lsp")) ++ ++(DEFUN COMPILE-MENU-SETB () ++ (GLCOMPFILES *DIRECTORY* ++ '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") ++ '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" ++ "glisp/menu-set-header.lsp")) ++ ++(DEFVAR *DRAW-WINDOW* NIL) ++ ++(DEFVAR *DRAW-WINDOW-WIDTH* 600) ++ ++(DEFVAR *DRAW-WINDOW-HEIGHT* 600) ++ ++(DEFVAR *DRAW-LEAVE-WINDOW* NIL) ++ ++(DEFVAR *DRAW-MENU-SET* NIL) ++ ++(DEFVAR *DRAW-ZERO-VECTOR* '(0 0)) ++ ++(DEFVAR *DRAW-LATEX-FACTOR* 1) ++ ++(DEFVAR *DRAW-SNAP-FLAG* T) ++ ++(DEFVAR *DRAW-OBJECTS* NIL) ++ ++(DEFVAR *DRAW-LATEX-MODE* NIL) ++ ++(DEFVAR *DRAW-WINDOW*) ++(SETF (GET '*DRAW-WINDOW* 'GLISPGLOBALVAR) T) ++(SETF (GET '*DRAW-WINDOW* 'GLISPGLOBALVARTYPE) 'WINDOW) ++ ++ ++(DEFMACRO DRAW-DESCR (NAME) (LIST 'GET NAME ''DRAW-DESCR)) ++ ++(SETF (GET 'DRAW-DESC 'GLSTRUCTURE) ++ '((LISTOBJECT (NAME SYMBOL) (OBJECTS (LISTOF DRAW-OBJECT)) ++ (OFFSET VECTOR) (SIZE VECTOR)) ++ PROP ((FNNAME DRAW-DESC-FNNAME) (REFPT DRAW-DESC-REFPT)) MSG ++ ((DRAW DRAW-DESC-DRAW) (SNAP DRAW-DESC-SNAP) ++ (FIND DRAW-DESC-FIND) (DELETE DRAW-DESC-DELETE)))) ++(SETF (GET 'DRAW-OBJECT 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ DEFAULT ((LINEWIDTH 1)) PROP ++ ((REGION ((VIRTUAL REGION WITH START = OFFSET SIZE = SIZE))) ++ (VREGION ((VIRTUAL REGION WITH START = VSTART SIZE = VSIZE))) ++ (VSTART ((VIRTUAL VECTOR WITH X = ++ (MIN (X OFFSET) ((X OFFSET) + (X SIZE))) - 2 ++ Y = (MIN (Y OFFSET) ((Y OFFSET) + (Y SIZE))) ++ - 2))) ++ (VSIZE ((VIRTUAL VECTOR WITH X = (ABS (X SIZE)) + 4 Y = ++ (ABS (Y SIZE)) + 4)))) ++ MSG ++ ((ERASE DRAW-OBJECT-ERASE) (DRAW DRAW-OBJECT-DRAW) ++ (SNAP DRAW-OBJECT-SNAP) (SELECTEDP DRAW-OBJECT-SELECTEDP) ++ (MOVE DRAW-OBJECT-MOVE)))) ++(SETF (GET 'DRAW-LINE 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ PROP ++ ((LINE ((VIRTUAL LINE-SEGMENT WITH P1 = OFFSET P2 = ++ (OFFSET + SIZE))))) ++ MSG ++ ((DRAW DRAW-LINE-DRAW) (SNAP DRAW-LINE-SNAP) ++ (SELECTEDP DRAW-LINE-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-ARROW 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ PROP ++ ((LINE ((VIRTUAL LINE-SEGMENT WITH P1 = OFFSET P2 = ++ (OFFSET + SIZE))))) ++ MSG ++ ((DRAW DRAW-ARROW-DRAW) (SNAP DRAW-LINE-SNAP) ++ (SELECTEDP DRAW-LINE-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-BOX 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-BOX-DRAW) (SNAP DRAW-BOX-SNAP) ++ (SELECTEDP DRAW-BOX-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-RCBOX 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-RCBOX-DRAW) (SNAP DRAW-RCBOX-SNAP) ++ (SELECTEDP DRAW-RCBOX-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-ERASE 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-ERASE-DRAW) (SNAP DRAW-NO-SNAP) ++ (SELECTEDP DRAW-ERASE-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-CIRCLE 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ PROP ((RADIUS ((X SIZE) / 2)) (CENTER (OFFSET + SIZE / 2))) MSG ++ ((DRAW DRAW-CIRCLE-DRAW) (SNAP DRAW-CIRCLE-SNAP) ++ (SELECTEDP DRAW-CIRCLE-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-ELLIPSE 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ PROP ++ ((RADIUSX ((X SIZE) / 2)) (RADIUSY ((Y SIZE) / 2)) ++ (RADIUS ((MAX RADIUSX RADIUSY))) (CENTER (OFFSET + SIZE / 2)) ++ (DELTA ((SQRT (ABS (RADIUSX ^ 2 - RADIUSY ^ 2))))) ++ (P1 ((IF (RADIUSX > RADIUSY) ++ (A VECTOR X = (X CENTER) - DELTA Y = (Y CENTER)) ++ (A VECTOR X = (X CENTER) Y = (Y CENTER) - DELTA)))) ++ (P2 ((IF (RADIUSX > RADIUSY) ++ (A VECTOR X = (X CENTER) + DELTA Y = (Y CENTER)) ++ (A VECTOR X = (X CENTER) Y = (Y CENTER) + DELTA))))) ++ MSG ++ ((DRAW DRAW-ELLIPSE-DRAW) (SNAP DRAW-ELLIPSE-SNAP) ++ (SELECTEDP DRAW-ELLIPSE-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-DOT 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-DOT-DRAW) (SNAP DRAW-DOT-SNAP) ++ (SELECTEDP DRAW-BUTTON-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-BUTTON 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-BUTTON-DRAW) (SNAP DRAW-DOT-SNAP) ++ (SELECTEDP DRAW-BUTTON-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-TEXT 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-TEXT-DRAW) (SNAP DRAW-NO-SNAP) ++ (SELECTEDP DRAW-TEXT-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-NULL 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-NULL-DRAW) (SNAP DRAW-NO-SNAP) ++ (SELECTEDP DRAW-NULL-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-REFPT 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-REFPT-DRAW) (SNAP DRAW-REFPT-SNAP) ++ (SELECTEDP DRAW-REFPT-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-MULTI 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) ++ (CONTENTS (LISTOF DRAW-OBJECT)) (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-MULTI-DRAW) (SNAP DRAW-NO-SNAP) ++ (SELECTEDP DRAW-MULTI-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++ ++ ++(DEFUN DRAW-DESC (NAME) ++ (LET (DD) ++ (SETQ DD (DRAW-DESCR NAME)) ++ (WHEN (NOT DD) ++ (SETQ DD ++ (LIST 'DRAW-DESC NAME NIL (COPY-LIST '(0 0)) ++ (COPY-LIST '(0 0)))) ++ (SETF (DRAW-DESCR NAME) DD)) ++ DD)) ++(SETF (GET 'DRAW-DESC 'GLARGUMENTS) '((NAME SYMBOL))) ++(SETF (GET 'DRAW-DESC 'GLFNRESULTTYPE) 'DRAW-DESC) ++ ++ ++(SETF (GET 'DRAW-WINDOW 'GLFNRESULTTYPE) 'WINDOW) ++ ++(DEFUN DRAW-WINDOW () ++ (OR *DRAW-WINDOW* ++ (SETQ *DRAW-WINDOW* ++ (WINDOW-CREATE *DRAW-WINDOW-WIDTH* *DRAW-WINDOW-HEIGHT* ++ "Draw window")))) ++ ++(DEFUN DRAW (NAME) ++ (LET (W DD DONE SEL (REDRAW T) NEW) ++ (SETQ W (DRAW-WINDOW)) ++ (XMAPWINDOW *WINDOW-DISPLAY* (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-EXPOSURE W) ++ (OR *DRAW-MENU-SET* (DRAW-INIT-MENUS)) ++ (SETQ DD (DRAW-DESC NAME)) ++ (UNLESS (MEMBER NAME *DRAW-OBJECTS*) ++ (SETQ *DRAW-OBJECTS* (NCONC *DRAW-OBJECTS* (LIST NAME)))) ++ (DRAW-DESC-DRAW DD W) ++ (WHILE (NOT DONE) ++ (SETQ SEL (MENU-SET-SELECT *DRAW-MENU-SET* REDRAW)) ++ (SETQ REDRAW NIL) ++ (CASE (CADR SEL) ++ (COMMAND (CASE (CAR SEL) ++ (DONE (SETQ DONE T)) ++ (MOVE (DRAW-DESC-MOVE DD W)) ++ (DELETE (DRAW-DESC-DELETE DD W)) ++ (COPY (DRAW-DESC-COPY DD W)) ++ (REDRAW (XCLEARWINDOW *WINDOW-DISPLAY* ++ (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (SETQ REDRAW T) (DRAW-DESC-DRAW DD W)) ++ (ORIGIN (DRAW-DESC-ORIGIN DD W) ++ (XCLEARWINDOW *WINDOW-DISPLAY* ++ (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (SETQ REDRAW T) (DRAW-DESC-DRAW DD W)) ++ (PROGRAM (DRAW-DESC-PROGRAM DD)) ++ (LATEX (DRAW-DESC-LATEX DD)) ++ (LATEXMODE ++ (SETQ *DRAW-LATEX-MODE* ++ (NOT *DRAW-LATEX-MODE*)) ++ (FORMAT T "Latex Mode is now ~A~%" ++ *DRAW-LATEX-MODE*)))) ++ (DRAW (SETQ NEW NIL) ++ (CASE (CAR SEL) ++ (RECTANGLE (SETQ NEW (DRAW-BOX-GET DD W))) ++ (RCBOX (SETQ NEW (DRAW-RCBOX-GET DD W))) ++ (CIRCLE (SETQ NEW (DRAW-CIRCLE-GET DD W))) ++ (ELLIPSE (SETQ NEW (DRAW-ELLIPSE-GET DD W))) ++ (LINE (SETQ NEW (DRAW-LINE-GET DD W))) ++ (ARROW (SETQ NEW (DRAW-ARROW-GET DD W))) ++ (DOT (SETQ NEW (DRAW-DOT-GET DD W))) ++ (ERASE (SETQ NEW (DRAW-ERASE-GET DD W))) ++ (BUTTON (SETQ NEW (DRAW-BUTTON-GET DD W))) ++ (TEXT (SETQ NEW (DRAW-TEXT-GET DD W))) ++ (REFPT (SETQ NEW (DRAW-REFPT-GET DD W)))) ++ (WHEN NEW ++ (SETF (CADR NEW) ++ (LIST (- (CAADR NEW) (CAR (CADDDR DD))) ++ (- (CADADR NEW) (CADR (CADDDR DD))))) ++ (SETF (CADDR DD) ++ (NCONC (CADDR DD) (CONS NEW NIL))) ++ (DRAW-OBJECT-DRAW NEW W (CADDDR DD)))) ++ (BACKGROUND))) ++ (SETF (DRAW-DESCR NAME) DD) ++ (UNLESS *DRAW-LEAVE-WINDOW* ++ (PROGN ++ (XUNMAPWINDOW *WINDOW-DISPLAY* (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-UNMAP W))) ++ NAME)) ++(SETF (GET 'DRAW 'GLARGUMENTS) '((NAME SYMBOL))) ++(SETF (GET 'DRAW 'GLFNRESULTTYPE) 'SYMBOL) ++ ++ ++(DEFUN COPY-DRAW-DESC (FROM TO) ++ (LET (OLD) ++ (SETQ OLD (COPY-TREE (GET FROM 'DRAW-DESCR))) ++ (SETF (GET TO 'DRAW-DESCR) (CONS (CAR OLD) (CONS TO (CDDR OLD)))))) ++ ++(DEFUN DRAW-DESC-DRAW (DD W) ++ (LET ((OFF (CADDDR DD))) ++ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (DOLIST (OBJ (CADDR DD)) (DRAW-OBJECT-DRAW OBJ W OFF)) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN DRAW-DESC-SELECTED (DD P) ++ (LET (OBJS OBJSB OBJ) ++ (SETQ OBJS ++ (MAPCAN #'(LAMBDA (OBJ) ++ (AND (DRAW-OBJECT-SELECTEDP OBJ P (CADDDR DD)) ++ (CONS OBJ NIL))) ++ (CADDR DD))) ++ (IF OBJS ++ (IF (NULL (REST OBJS)) (SETQ OBJ (FIRST OBJS)) ++ (PROGN ++ (SETQ OBJSB ++ (MAPCAN #'(LAMBDA (Z) ++ (AND (MEMBER (FIRST Z) ++ '(DRAW-BUTTON DRAW-DOT)) ++ (CONS Z NIL))) ++ OBJS)) ++ (IF (AND OBJSB (NULL (REST OBJSB))) ++ (SETQ OBJ (FIRST OBJSB)))))) ++ OBJ)) ++(SETF (GET 'DRAW-DESC-SELECTED 'GLARGUMENTS) ++ '((DD DRAW-DESC) (P VECTOR))) ++(SETF (GET 'DRAW-DESC-SELECTED 'GLFNRESULTTYPE) 'DRAW-OBJECT) ++ ++ ++(DEFUN DRAW-DESC-FIND (DD W &OPTIONAL CROSSFLG) ++ (LET (P OBJ) ++ (WHILE (NOT OBJ) ++ (SETQ P ++ (IF CROSSFLG (DRAW-GET-CROSS DD W) ++ (DRAW-GET-CROSSHAIRS DD W))) ++ (SETQ OBJ (DRAW-DESC-SELECTED DD P))) ++ OBJ)) ++(SETF (GET 'DRAW-DESC-FIND 'GLARGUMENTS) ++ '((DD DRAW-DESC) (W WINDOW) (&OPTIONAL BOOLEAN))) ++(SETF (GET 'DRAW-DESC-FIND 'GLFNRESULTTYPE) 'DRAW-OBJECT) ++ ++ ++(DEFUN DRAW-GET-CROSS (DD W) (DRAW-DESC-SNAP DD (WINDOW-GET-CROSS W))) ++(SETF (GET 'DRAW-GET-CROSS 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-GET-CROSS 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-GET-CROSSHAIRS (DD W) ++ (DRAW-DESC-SNAP DD (WINDOW-GET-CROSSHAIRS W))) ++(SETF (GET 'DRAW-GET-CROSSHAIRS 'GLARGUMENTS) ++ '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-GET-CROSSHAIRS 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-DESC-DELETE (DD W) ++ (LET (OBJ) ++ (SETQ OBJ (DRAW-DESC-FIND DD W T)) ++ (DRAW-OBJECT-ERASE OBJ W (CADDDR DD)) ++ (SETF (CADDR DD) (REMOVE OBJ (CADDR DD))))) ++(SETF (GET 'DRAW-DESC-DELETE 'GLARGUMENTS) ++ '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-DESC-DELETE 'GLFNRESULTTYPE) '(LISTOF DRAW-OBJECT)) ++ ++ ++(DEFUN DRAW-DESC-COPY (DD W) ++ (LET (OBJ OBJB) ++ (SETQ OBJ (DRAW-DESC-FIND DD W)) ++ (SETQ OBJB (COPY-TREE OBJ)) ++ (DRAW-GET-OBJECT-POS OBJB W) ++ (SETF (CADR OBJB) ++ (LIST (- (CAADR OBJB) (CAR (CADDDR DD))) ++ (- (CADADR OBJB) (CADR (CADDDR DD))))) ++ (DRAW-OBJECT-DRAW OBJB W (CADDDR DD)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (SETF (CADDR DD) (NCONC (CADDR DD) (CONS OBJB NIL))))) ++(SETF (GET 'DRAW-DESC-COPY 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-DESC-COPY 'GLFNRESULTTYPE) '(LISTOF DRAW-OBJECT)) ++ ++ ++(DEFUN DRAW-DESC-MOVE (DD W) ++ (LET (OBJ) ++ (IF (SETQ OBJ (DRAW-DESC-FIND DD W)) ++ (DRAW-OBJECT-MOVE OBJ W (CADDDR DD))))) ++ ++(DEFUN DRAW-DESC-ORIGIN (DD W) ++ (LET (SEL) ++ (DRAW-DESC-BOUNDS DD) ++ (SETQ SEL (MENU '(("To zero" . TOZERO) ("Select" . SELECT)))) ++ (IF (EQ SEL 'SELECT) ++ (SETF (CADDDR DD) ++ (WINDOW-GET-BOX-POSITION W (CAR (FIFTH DD)) ++ (CADR (FIFTH DD)))) ++ (IF (EQ SEL 'TOZERO) (SETF (CADDDR DD) (COPY-LIST '(0 0))))))) ++(SETF (GET 'DRAW-DESC-ORIGIN 'GLARGUMENTS) ++ '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-DESC-ORIGIN 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-DESC-BOUNDS (DD) ++ (LET ((XMIN 9999) (YMIN 9999) (XMAX 0) (YMAX 0) BASEV) ++ (DOLIST (OBJ (CADDR DD)) ++ (SETQ XMIN (MIN XMIN (CAADR OBJ) (+ (CAADR OBJ) (CAADDR OBJ)))) ++ (SETQ YMIN ++ (MIN YMIN (CADADR OBJ) (+ (CADADR OBJ) (CADR (CADDR OBJ))))) ++ (SETQ XMAX (MAX XMAX (CAADR OBJ) (+ (CAADR OBJ) (CAADDR OBJ)))) ++ (SETQ YMAX ++ (MAX YMAX (CADADR OBJ) (+ (CADADR OBJ) (CADR (CADDR OBJ)))))) ++ (SETF (CAR (FIFTH DD)) (- XMAX XMIN)) ++ (SETF (CADR (FIFTH DD)) (- YMAX YMIN)) ++ (SETQ BASEV (LIST XMIN YMIN)) ++ (SETF (CADDDR DD) BASEV) ++ (DOLIST (OBJ (CADDR DD)) ++ (SETF (CADR OBJ) ++ (LIST (- (CAADR OBJ) (CAR BASEV)) ++ (- (CADADR OBJ) (CADR BASEV))))))) ++ ++(DEFUN DRAW-DESC-LATEX (DD) ++ (LET (BASE BX BY SX SY) ++ (FORMAT T " \\begin{picture}(~5,0F,~5,0F)(0,0)~%" ++ (* (CAR (FIFTH DD)) *DRAW-LATEX-FACTOR*) ++ (* (CADR (FIFTH DD)) *DRAW-LATEX-FACTOR*)) ++ (DOLIST (OBJ (CADDR DD)) ++ (SETQ BASE ++ (LIST (+ (CAR (CADDDR DD)) (CAADR OBJ)) ++ (+ (CADR (CADDDR DD)) (CADADR OBJ)))) ++ (SETQ BX (* (CAR BASE) *DRAW-LATEX-FACTOR*)) ++ (SETQ BY (* (CADR BASE) *DRAW-LATEX-FACTOR*)) ++ (SETQ SX (* (CAADDR OBJ) *DRAW-LATEX-FACTOR*)) ++ (SETQ SY (* (CADR (CADDR OBJ)) *DRAW-LATEX-FACTOR*)) ++ (CASE (FIRST OBJ) ++ (DRAW-LINE ++ (LATEX-LINE (CAR BASE) (CADR BASE) (+ (CAR BASE) SX) ++ (+ (CADR BASE) SY))) ++ (DRAW-ARROW ++ (LATEX-LINE (CAR BASE) (CADR BASE) (+ (CAR BASE) SX) ++ (+ (CADR BASE) SY) T)) ++ (DRAW-BOX ++ (FORMAT T ++ " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" ++ BX BY SX SY)) ++ (DRAW-RCBOX ++ (FORMAT T " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" ++ (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX SY)) ++ (DRAW-CIRCLE ++ (FORMAT T " \\put(~5,0F,~5,0F) {\\circle{~5,0F}}~%" ++ (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX)) ++ (DRAW-ELLIPSE ++ (FORMAT T " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" ++ (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX SY)) ++ (DRAW-BUTTON ++ (FORMAT T ++ " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" ++ BX BY SX SY)) ++ (DRAW-ERASE) ++ (DRAW-DOT ++ (FORMAT T " \\put(~5,0F,~5,0F) {\\circle*{~5,0F}}~%" ++ (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX)) ++ (DRAW-TEXT ++ (FORMAT T " \\put(~5,0F,~5,0F) {~A}~%" BX ++ (+ BY (* 4 *DRAW-LATEX-FACTOR*)) (CADDDR OBJ))))) ++ (FORMAT T " \\end{picture}~%"))) ++ ++(DEFUN DRAW-DESC-PROGRAM (DD) ++ (LET (BASE BX BY SX SY TOX TOY R RX RY S CODE FNCODE FNNAME CD) ++ (SETQ CODE ++ (MAPCAN #'(LAMBDA (OBJ) ++ (AND (SETQ CD ++ (PROGN ++ (SETQ BASE ++ (LET ++ ((GLVAR133 ++ (LIST ++ (+ (CAR (CADDDR DD)) ++ (CAADR OBJ)) ++ (+ (CADR (CADDDR DD)) ++ (CADADR OBJ)))) ++ (GLVAR134 (DRAW-DESC-REFPT DD))) ++ (LIST ++ (- (CAR GLVAR133) ++ (CAR GLVAR134)) ++ (- (CADR GLVAR133) ++ (CADR GLVAR134))))) ++ (SETQ BX (CAR BASE)) ++ (SETQ BY (CADR BASE)) ++ (SETQ SX (CAADDR OBJ)) ++ (SETQ SY (CADR (CADDR OBJ))) ++ (SETQ TOX (+ BX SX)) ++ (SETQ TOY (+ BY SY)) ++ (IF (EQ (CAR OBJ) 'DRAW-CIRCLE) ++ (SETQ R (* 1/2 (CAADDR OBJ)))) ++ (WHEN (EQ (CAR OBJ) 'DRAW-ELLIPSE) ++ (SETQ RX (* 1/2 (CAADDR OBJ))) ++ (SETQ RY ++ (* 1/2 (CADR (CADDR OBJ))))) ++ (DRAW-OPTIMIZE ++ (CASE (FIRST OBJ) ++ (DRAW-LINE ++ (LIST 'WINDOW-DRAW-LINE-XY 'W ++ (LIST '+ 'X BX) (LIST '+ 'Y BY) ++ (LIST '+ 'X TOX) ++ (LIST '+ 'Y TOY))) ++ (DRAW-ARROW ++ (LIST 'WINDOW-DRAW-ARROW-XY 'W ++ (LIST '+ 'X BX) (LIST '+ 'Y BY) ++ (LIST '+ 'X TOX) ++ (LIST '+ 'Y TOY))) ++ (DRAW-BOX ++ (LIST 'WINDOW-DRAW-BOX-XY 'W ++ (LIST '+ 'X BX) (LIST '+ 'Y BY) ++ SX SY)) ++ (DRAW-RCBOX ++ (LIST 'WINDOW-DRAW-RCBOX-XY 'W ++ (LIST '+ 'X BX) (LIST '+ 'Y BY) ++ SX SY 8)) ++ (DRAW-CIRCLE ++ (LIST 'WINDOW-DRAW-CIRCLE-XY 'W ++ (LIST '+ 'X (+ R BX)) ++ (LIST '+ 'Y (+ R BY)) R)) ++ (DRAW-ELLIPSE ++ (LIST 'WINDOW-DRAW-ELLIPSE-XY 'W ++ (LIST '+ 'X (+ RX BX)) ++ (LIST '+ 'Y (+ RY BY)) RX RY)) ++ ((DRAW-BUTTON DRAW-REFPT) NIL) ++ (DRAW-ERASE ++ (LIST 'WINDOW-ERASE-AREA-XY 'W ++ (LIST '+ 'X BX) (LIST '+ 'Y BY) ++ SX SY)) ++ (DRAW-DOT ++ (LIST 'WINDOW-DRAW-DOT-XY 'W ++ (LIST '+ 'X (+ 2 BX)) ++ (LIST '+ 'Y (+ 2 BY)))) ++ (DRAW-TEXT ++ (SETQ S ++ (STRINGIFY (CADDDR OBJ))) ++ (LIST 'WINDOW-PRINTAT-XY 'W S ++ (LIST '+ 'X BX) ++ (LIST '+ 'Y BY))))))) ++ (CONS CD NIL))) ++ (CADDR DD))) ++ (SETQ FNCODE ++ (CONS 'LAMBDA ++ (CONS (LIST 'W 'X 'Y) ++ (NCONC CODE ++ (LIST (LIST 'WINDOW-FORCE-OUTPUT 'W)))))) ++ (SETQ FNNAME (DRAW-DESC-FNNAME DD)) ++ (SETF (SYMBOL-FUNCTION FNNAME) FNCODE) ++ (FORMAT T "Constructed program (~A w x y)~%" FNNAME) ++ (DRAW-DESC-PICMENU DD))) ++ ++(DEFUN DRAW-OPTIMIZE (X) (IF (FBOUNDP 'GLUNWRAP) (GLUNWRAP X NIL) X)) ++ ++(DEFUN DRAW-DESC-FNNAME (DD) ++ (INTERN (CONCATENATE 'STRING "DRAW-" (SYMBOL-NAME (CADR DD))))) ++(SETF (GET 'DRAW-DESC-FNNAME 'GLARGUMENTS) '((DD DRAW-DESC))) ++(SETF (GET 'DRAW-DESC-FNNAME 'GLFNRESULTTYPE) 'SYMBOL) ++ ++ ++(DEFUN DRAW-DESC-PICMENU (DD) ++ (LET (BUTTONS) ++ (SETQ BUTTONS ++ (MAPCAN #'(LAMBDA (OBJ) ++ (AND (EQ (FIRST OBJ) 'DRAW-BUTTON) ++ (CONS (LIST (CADDDR OBJ) ++ (LET ++ ((GLVAR136 ++ (LET ++ ((GLVAR135 ++ (COPY-LIST '(2 2)))) ++ (LIST ++ (+ (CAR GLVAR135) ++ (CAADR OBJ)) ++ (+ (CADR GLVAR135) ++ (CADADR OBJ)))))) ++ (LIST ++ (+ (CAR GLVAR136) ++ (CAR (CADDDR DD))) ++ (+ (CADR GLVAR136) ++ (CADR (CADDDR DD)))))) ++ NIL))) ++ (CADDR DD))) ++ (IF BUTTONS ++ (SETF (GET (CADR DD) 'PICMENU-SPEC) ++ (LIST 'PICMENU-SPEC (CAR (FIFTH DD)) (CADR (FIFTH DD)) ++ BUTTONS T (DRAW-DESC-FNNAME DD) '9X15))))) ++(SETF (GET 'DRAW-DESC-PICMENU 'GLARGUMENTS) '((DD DRAW-DESC))) ++(SETF (GET 'DRAW-DESC-PICMENU 'GLFNRESULTTYPE) ++ '(LIST GLTYPE INTEGER INTEGER (LISTOF (LIST ANYTHING VECTOR)) ++ BOOLEAN SYMBOL SYMBOL)) ++ ++ ++(DEFUN DRAW-DESC-SNAP (DD P) ++ (LET (PSNAP OBJ (OBJS (CADDR DD))) ++ (IF *DRAW-SNAP-FLAG* ++ (WHILE (AND OBJS (NOT PSNAP)) (SETQ OBJ (POP OBJS)) ++ (SETQ PSNAP (DRAW-OBJECT-SNAP OBJ P (CADDDR DD))))) ++ (OR PSNAP P))) ++(SETF (GET 'DRAW-DESC-SNAP 'GLARGUMENTS) '((DD DRAW-DESC) (P VECTOR))) ++(SETF (GET 'DRAW-DESC-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-OBJECT-MOVE (D W OFF) ++ (DRAW-OBJECT-ERASE D W OFF) ++ (DRAW-GET-OBJECT-POS D W) ++ (SETF (CADR D) ++ (LIST (- (CAADR D) (CAR OFF)) (- (CADADR D) (CADR OFF)))) ++ (DRAW-OBJECT-DRAW D W OFF) ++ (XFLUSH *WINDOW-DISPLAY*)) ++ ++(DEFUN DRAW-OBJECT-DRAW-AT (W X Y D) ++ (SETF (SECOND D) (LIST X Y)) ++ (DRAW-OBJECT-DRAW D W *DRAW-ZERO-VECTOR*)) ++ ++(DEFUN DRAW-OBJECT-DRAW (D W OFF) ++ (FUNCALL (GLMETHOD (CAR D) 'DRAW) D W OFF)) ++ ++(DEFUN DRAW-OBJECT-SNAP (D P OFF) ++ (FUNCALL (GLMETHOD (CAR D) 'SNAP) D P OFF)) ++ ++(DEFUN DRAW-OBJECT-SELECTEDP (D W OFF) ++ (FUNCALL (GLMETHOD (CAR D) 'SELECTEDP) D W OFF)) ++ ++(DEFUN DRAW-GET-OBJECT-POS (D W) ++ (WINDOW-GET-ICON-POSITION W ++ (IF (EQ (FIRST D) 'DRAW-TEXT) #'DRAW-TEXT-DRAW-OUTLINE ++ #'DRAW-OBJECT-DRAW-AT) ++ (LIST D))) ++(SETF (GET 'DRAW-GET-OBJECT-POS 'GLARGUMENTS) ++ '((D DRAW-OBJECT) (W WINDOW))) ++(SETF (GET 'DRAW-GET-OBJECT-POS 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-OBJECT-ERASE (D W OFF) ++ (WHEN (NOT (EQ (FIRST D) 'DRAW-ERASE)) ++ (LET ((GC (CADDR W))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (LOGXOR *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*))))) ++ (DRAW-OBJECT-DRAW D W OFF) ++ (LET ((GC (CADDR W))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)))) ++ ++(DEFUN DRAW-LINE-DRAW (D W OFF) ++ (LET ((FROM (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D)))) ++ (TO (LET ((GLVAR137 ++ (LIST (+ (CAR OFF) (CAADR D)) ++ (+ (CADR OFF) (CADADR D))))) ++ (LIST (+ (CAR GLVAR137) (CAADDR D)) ++ (+ (CADR GLVAR137) (CADR (CADDR D))))))) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (CAR FROM) ++ (- QQWHEIGHT (CADR FROM)) (CAR TO) (- QQWHEIGHT (CADR TO))) ++ NIL))) ++ ++(DEFUN DRAW-ARROW-DRAW (D W OFF) ++ (LET ((FROM (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D)))) ++ (TO (LET ((GLVAR138 ++ (LIST (+ (CAR OFF) (CAADR D)) ++ (+ (CADR OFF) (CADADR D))))) ++ (LIST (+ (CAR GLVAR138) (CAADDR D)) ++ (+ (CADR GLVAR138) (CADR (CADDR D))))))) ++ (WINDOW-DRAW-ARROW-XY W (CAR FROM) (CADR FROM) (CAR TO) (CADR TO)))) ++ ++(DEFUN DRAW-LINE-SELECTEDP (D PT OFF) ++ (LET ((PTP (LIST (- (CAR PT) (CAR OFF)) (- (CADR PT) (CADR OFF))))) ++ (AND (BETWEEN (CAR PTP) (+ -2 (+ (CAADR D) (MIN 0 (CAADDR D)))) ++ (+ 2 ++ (+ (+ (CAADR D) (MIN 0 (CAADDR D))) ++ (ABS (CAADDR D))))) ++ (BETWEEN (CADR PTP) ++ (+ -2 (+ (CADADR D) (MIN 0 (CADR (CADDR D))))) ++ (+ 2 ++ (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) ++ (ABS (CADR (CADDR D)))))) ++ (< (ABS (/ (- (* (CAADDR D) (- (CADR PTP) (CADADR D))) ++ (* (CADR (CADDR D)) (- (CAR PTP) (CAADR D)))) ++ (SQRT (+ (EXPT (CAADDR D) 2) ++ (EXPT (CADR (CADDR D)) 2))))) ++ 5)))) ++(SETF (GET 'DRAW-LINE-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-LINE) (PT VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-LINE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-LINE-GET (DD W) ++ (LET (FROM TO) ++ (SETQ FROM (DRAW-GET-CROSSHAIRS DD W)) ++ (SETQ TO ++ (IF *DRAW-LATEX-MODE* ++ (WINDOW-GET-LATEX-POSITION W (CAR FROM) (CADR FROM) NIL) ++ (DRAW-DESC-SNAP DD ++ (WINDOW-GET-LINE-POSITION W (CAR FROM) (CADR FROM))))) ++ (LIST 'DRAW-LINE FROM ++ (LIST (- (CAR TO) (CAR FROM)) (- (CADR TO) (CADR FROM))) NIL ++ 1))) ++(SETF (GET 'DRAW-LINE-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-LINE-GET 'GLFNRESULTTYPE) 'DRAW-LINE) ++ ++ ++(DEFUN DRAW-ARROW-GET (DD W) ++ (LET (FROM TO) ++ (SETQ FROM (DRAW-GET-CROSSHAIRS DD W)) ++ (SETQ TO ++ (IF *DRAW-LATEX-MODE* ++ (WINDOW-GET-LATEX-POSITION W (CAR FROM) (CADR FROM) NIL) ++ (DRAW-DESC-SNAP DD ++ (WINDOW-GET-LINE-POSITION W (CAR FROM) (CADR FROM))))) ++ (LIST 'DRAW-ARROW FROM ++ (LIST (- (CAR TO) (CAR FROM)) (- (CADR TO) (CADR FROM))) NIL ++ 1))) ++(SETF (GET 'DRAW-ARROW-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-ARROW-GET 'GLFNRESULTTYPE) 'DRAW-ARROW) ++ ++ ++(DEFUN DRAW-BOX-DRAW (D W OFF) ++ (LET ((GLVAR139 ++ (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D))))) ++ (WINDOW-DRAW-BOX-XY W (CAR GLVAR139) (CADR GLVAR139) (CAADDR D) ++ (CADR (CADDR D)) NIL))) ++ ++(DEFUN DRAW-BOX-SELECTEDP (D P OFF) ++ (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) ++ (OR (AND (< (CADR PT) ++ (+ 7 ++ (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) ++ (ABS (CADR (CADDR D)))))) ++ (> (CADR PT) ++ (+ -7 (+ (CADADR D) (MIN 0 (CADR (CADDR D)))))) ++ (OR (< (ABS (+ 2 ++ (- (CAR PT) ++ (+ (CAADR D) (MIN 0 (CAADDR D)))))) ++ 5) ++ (< (ABS (+ -2 ++ (- (CAR PT) ++ (+ (+ (CAADR D) (MIN 0 (CAADDR D))) ++ (ABS (CAADDR D)))))) ++ 5))) ++ (AND (< (CAR PT) ++ (+ 7 ++ (+ (+ (CAADR D) (MIN 0 (CAADDR D))) ++ (ABS (CAADDR D))))) ++ (> (CAR PT) (+ -7 (+ (CAADR D) (MIN 0 (CAADDR D))))) ++ (OR (< (ABS (+ -2 ++ (- (CADR PT) ++ (+ (+ (CADADR D) ++ (MIN 0 (CADR (CADDR D)))) ++ (ABS (CADR (CADDR D))))))) ++ 5) ++ (< (ABS (+ 2 ++ (- (CADR PT) ++ (+ (CADADR D) (MIN 0 (CADR (CADDR D))))))) ++ 5)))))) ++(SETF (GET 'DRAW-BOX-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-BOX-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-BOX-GET (DD W) ++ (LET (BOX) ++ (SETQ BOX (WINDOW-GET-REGION W)) ++ (LIST 'DRAW-BOX (CAR BOX) (CADR BOX) NIL 1))) ++(SETF (GET 'DRAW-BOX-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-BOX-GET 'GLFNRESULTTYPE) 'DRAW-BOX) ++ ++ ++(DEFUN DRAW-RCBOX-DRAW (D W OFF) ++ (WINDOW-DRAW-RCBOX-XY W (+ (CAR OFF) (CAADR D)) ++ (+ (CADR OFF) (CADADR D)) (CAADDR D) (CADR (CADDR D)) 8)) ++ ++(DEFUN DRAW-RCBOX-SELECTEDP (D P OFF) ++ (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) ++ (OR (AND (< (CADR PT) ++ (1- (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) ++ (ABS (CADR (CADDR D)))))) ++ (> (CADR PT) (1+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))))) ++ (OR (< (ABS (+ 2 ++ (- (CAR PT) ++ (+ (CAADR D) (MIN 0 (CAADDR D)))))) ++ 5) ++ (< (ABS (+ -2 ++ (- (CAR PT) ++ (+ (+ (CAADR D) (MIN 0 (CAADDR D))) ++ (ABS (CAADDR D)))))) ++ 5))) ++ (AND (< (CAR PT) ++ (1- (+ (+ (CAADR D) (MIN 0 (CAADDR D))) ++ (ABS (CAADDR D))))) ++ (> (CAR PT) (1+ (+ (CAADR D) (MIN 0 (CAADDR D))))) ++ (OR (< (ABS (+ -2 ++ (- (CADR PT) ++ (+ (+ (CADADR D) ++ (MIN 0 (CADR (CADDR D)))) ++ (ABS (CADR (CADDR D))))))) ++ 5) ++ (< (ABS (+ 2 ++ (- (CADR PT) ++ (+ (CADADR D) (MIN 0 (CADR (CADDR D))))))) ++ 5)))))) ++(SETF (GET 'DRAW-RCBOX-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-RCBOX-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-RCBOX-GET (DD W) ++ (LET (BOX) ++ (SETQ BOX (WINDOW-GET-REGION W)) ++ (LIST 'DRAW-RCBOX (CAR BOX) (CADR BOX) NIL 1))) ++(SETF (GET 'DRAW-RCBOX-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-RCBOX-GET 'GLFNRESULTTYPE) 'DRAW-RCBOX) ++ ++ ++(DEFUN DRAW-CIRCLE-DRAW (D W OFF) ++ (LET ((GLVAR142 ++ (LET ((GLVAR141 ++ (LET ((GLVAR140 ++ (LIST (* 1/2 (CAADDR D)) ++ (* 1/2 (CADR (CADDR D)))))) ++ (LIST (+ (CAADR D) (CAR GLVAR140)) ++ (+ (CADADR D) (CADR GLVAR140)))))) ++ (LIST (+ (CAR OFF) (CAR GLVAR141)) ++ (+ (CADR OFF) (CADR GLVAR141)))))) ++ (WINDOW-DRAW-CIRCLE-XY W (CAR GLVAR142) (CADR GLVAR142) ++ (* 1/2 (CAADDR D)) NIL))) ++ ++(DEFUN DRAW-CIRCLE-SELECTEDP (D P OFF) ++ (< (ABS (- (* 1/2 (CAADDR D)) ++ (LET ((SELF (LET ((GLVAR146 ++ (LET ++ ((GLVAR145 ++ (LET ++ ((GLVAR144 ++ (LIST (* 1/2 (CAADDR D)) ++ (* 1/2 (CADR (CADDR D)))))) ++ (LIST ++ (+ (CAADR D) (CAR GLVAR144)) ++ (+ (CADADR D) (CADR GLVAR144)))))) ++ (LIST (+ (CAR GLVAR145) (CAR OFF)) ++ (+ (CADR GLVAR145) (CADR OFF)))))) ++ (LIST (- (CAR GLVAR146) (CAR P)) ++ (- (CADR GLVAR146) (CADR P)))))) ++ (SQRT (+ (EXPT (CAR SELF) 2) (EXPT (CADR SELF) 2)))))) ++ 5)) ++(SETF (GET 'DRAW-CIRCLE-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-CIRCLE) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-CIRCLE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-CIRCLE-GET (DD W) ++ (LET (CIR CENT) ++ (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) ++ (SETQ CIR (WINDOW-GET-CIRCLE W CENT)) ++ (LIST 'DRAW-CIRCLE ++ (LIST (- (CAAR CIR) (CADR CIR)) (- (CADAR CIR) (CADR CIR))) ++ (LIST (* 2 (CADR CIR)) (* 2 (CADR CIR))) NIL 1))) ++(SETF (GET 'DRAW-CIRCLE-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-CIRCLE-GET 'GLFNRESULTTYPE) 'DRAW-CIRCLE) ++ ++ ++(DEFUN DRAW-ELLIPSE-DRAW (D W OFF) ++ (LET ((C (LET ((GLVAR148 ++ (LET ((GLVAR147 ++ (LIST (* 1/2 (CAADDR D)) ++ (* 1/2 (CADR (CADDR D)))))) ++ (LIST (+ (CAADR D) (CAR GLVAR147)) ++ (+ (CADADR D) (CADR GLVAR147)))))) ++ (LIST (+ (CAR OFF) (CAR GLVAR148)) ++ (+ (CADR OFF) (CADR GLVAR148)))))) ++ (LET ((GLVAR149 (* 1/2 (CAADDR D))) ++ (GLVAR150 (* 1/2 (CADR (CADDR D))))) ++ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) ++ (- (CAR C) GLVAR149) (- (CADDDR W) (+ (CADR C) GLVAR150)) ++ (* 2 GLVAR149) (* 2 GLVAR150) 0 23040) ++ NIL))) ++ ++(DEFUN DRAW-ELLIPSE-SELECTEDP (D P OFF) ++ (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) ++ (< (ABS (- (+ (LET ((SELF (LET ((GLVAR156 ++ (IF ++ (> (CAADDR D) (CADR (CADDR D))) ++ (LIST ++ (ROUND ++ (- ++ (+ (CAADR D) ++ (* 1/2 (CAADDR D))) ++ (SQRT ++ (ABS ++ (* 1/4 ++ (- (EXPT (CAADDR D) 2) ++ (EXPT (CADR (CADDR D)) 2))))))) ++ (+ (CADADR D) ++ (* 1/2 (CADR (CADDR D))))) ++ (LIST ++ (+ (CAADR D) (* 1/2 (CAADDR D))) ++ (ROUND ++ (- ++ (+ (CADADR D) ++ (* 1/2 (CADR (CADDR D)))) ++ (SQRT ++ (ABS ++ (* 1/4 ++ (- (EXPT (CAADDR D) 2) ++ (EXPT (CADR (CADDR D)) 2))))))))))) ++ (LIST (- (CAR GLVAR156) (CAR PT)) ++ (- (CADR GLVAR156) (CADR PT)))))) ++ (SQRT (+ (EXPT (CAR SELF) 2) (EXPT (CADR SELF) 2)))) ++ (LET ((SELF (LET ((GLVAR161 ++ (IF ++ (> (CAADDR D) (CADR (CADDR D))) ++ (LIST ++ (ROUND ++ (+ ++ (+ (CAADR D) ++ (* 1/2 (CAADDR D))) ++ (SQRT ++ (ABS ++ (* 1/4 ++ (- (EXPT (CAADDR D) 2) ++ (EXPT (CADR (CADDR D)) 2))))))) ++ (+ (CADADR D) ++ (* 1/2 (CADR (CADDR D))))) ++ (LIST ++ (+ (CAADR D) (* 1/2 (CAADDR D))) ++ (ROUND ++ (+ ++ (+ (CADADR D) ++ (* 1/2 (CADR (CADDR D)))) ++ (SQRT ++ (ABS ++ (* 1/4 ++ (- (EXPT (CAADDR D) 2) ++ (EXPT (CADR (CADDR D)) 2))))))))))) ++ (LIST (- (CAR GLVAR161) (CAR PT)) ++ (- (CADR GLVAR161) (CADR PT)))))) ++ (SQRT (+ (EXPT (CAR SELF) 2) (EXPT (CADR SELF) 2))))) ++ (* 2 (MAX (* 1/2 (CAADDR D)) (* 1/2 (CADR (CADDR D))))))) ++ 2))) ++(SETF (GET 'DRAW-ELLIPSE-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-ELLIPSE) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-ELLIPSE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-TEST-ELLIPSE-SELECTEDP (E) ++ (LET ((SIZE (THIRD E)) (OFFSET (SECOND E))) ++ (DOTIMES (Y (+ (CADR SIZE) 10)) ++ (DOTIMES (X (+ (CAR SIZE) 10)) ++ (PRINC (IF (DRAW-ELLIPSE-SELECTEDP E ++ (LIST (+ X (CAR OFFSET) -5) ++ (+ Y (CADR OFFSET) -5)) ++ (LIST 0 0)) ++ "T" " "))) ++ (TERPRI)))) ++ ++(DEFUN DRAW-ELLIPSE-GET (DD W) ++ (LET (ELL CENT) ++ (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) ++ (SETQ ELL (WINDOW-GET-ELLIPSE W CENT)) ++ (LIST 'DRAW-ELLIPSE ++ (LIST (- (CAAR ELL) (CAADR ELL)) ++ (- (CADAR ELL) (CADADR ELL))) ++ (LIST (* 2 (CAADR ELL)) (* 2 (CADADR ELL))) NIL 1))) ++(SETF (GET 'DRAW-ELLIPSE-GET 'GLARGUMENTS) ++ '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-ELLIPSE-GET 'GLFNRESULTTYPE) 'DRAW-ELLIPSE) ++ ++ ++(DEFUN DRAW-NULL-DRAW (D W OFF) NIL) ++ ++(DEFUN DRAW-NULL-SELECTEDP (D PT OFF) NIL) ++ ++(DEFUN DRAW-BUTTON-DRAW (D W OFF) ++ (LET ((GLVAR162 ++ (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D)))) ++ (GLVAR163 (COPY-LIST '(4 4)))) ++ (WINDOW-DRAW-BOX-XY W (CAR GLVAR162) (CADR GLVAR162) (CAR GLVAR163) ++ (CADR GLVAR163) NIL))) ++ ++(DEFUN DRAW-BUTTON-SELECTEDP (D P OFF) ++ (LET ((PTX (- (- (CAR P) (CAR OFF)) (CAADR D))) ++ (PTY (- (- (CADR P) (CADR OFF)) (CADADR D)))) ++ (AND (> PTX -2) (< PTX 6) (> PTY -2) (< PTY 6)))) ++(SETF (GET 'DRAW-BUTTON-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-BUTTON) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-BUTTON-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-BUTTON-GET (DD W) ++ (LET (CENT VAR) ++ (PRINC "Enter button name: ") ++ (SETQ VAR (READ)) ++ (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) ++ (LIST 'DRAW-BUTTON (LIST (+ -2 (CAR CENT)) (+ -2 (CADR CENT))) ++ (COPY-LIST '(4 4)) VAR 1))) ++(SETF (GET 'DRAW-BUTTON-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-BUTTON-GET 'GLFNRESULTTYPE) 'DRAW-BUTTON) ++ ++ ++(DEFUN DRAW-ERASE-DRAW (D W OFF) ++ (LET ((GLVAR164 ++ (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D))))) ++ (WINDOW-ERASE-AREA-XY W (CAR GLVAR164) (CADR GLVAR164) (CAADDR D) ++ (CADR (CADDR D))))) ++ ++(DEFUN DRAW-ERASE-SELECTEDP (D P OFF) ++ (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) ++ (AND (BETWEEN (CAR PT) (CAADR D) (+ (CAADR D) (CAADDR D))) ++ (BETWEEN (CADR PT) (CADADR D) (+ (CADADR D) (CADR (CADDR D))))))) ++(SETF (GET 'DRAW-ERASE-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-ERASE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-ERASE-GET (DD W) ++ (LET (BOX) ++ (SETQ BOX (WINDOW-GET-REGION W)) ++ (LIST 'DRAW-ERASE (CAR BOX) (CADR BOX) NIL 1))) ++(SETF (GET 'DRAW-ERASE-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-ERASE-GET 'GLFNRESULTTYPE) 'DRAW-ERASE) ++ ++ ++(DEFUN DRAW-DOT-DRAW (D W OFF) ++ (WINDOW-DRAW-DOT-XY W (+ 2 (+ (CAR OFF) (CAADR D))) ++ (+ 2 (+ (CADR OFF) (CADADR D))))) ++ ++(DEFUN DRAW-DOT-GET (DD W) ++ (LET (CENT) ++ (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) ++ (LIST 'DRAW-DOT (LIST (+ -2 (CAR CENT)) (+ -2 (CADR CENT))) ++ (COPY-LIST '(4 4)) NIL 1))) ++(SETF (GET 'DRAW-DOT-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-DOT-GET 'GLFNRESULTTYPE) 'DRAW-DOT) ++ ++ ++(DEFUN DRAW-REFPT-DRAW (D W OFF) ++ (WINDOW-DRAW-CROSSHAIRS-XY W (+ (CAR OFF) (CAADR D)) ++ (+ (CADR OFF) (CADADR D)))) ++ ++(DEFUN DRAW-REFPT-SELECTEDP (D P OFF) ++ (LET ((PTX (- (- (CAR P) (CAR OFF)) (CAADR D))) ++ (PTY (- (- (CADR P) (CADR OFF)) (CADADR D)))) ++ (AND (> PTX -3) (< PTX 3) (> PTY -3) (< PTY 3)))) ++(SETF (GET 'DRAW-REFPT-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-BUTTON) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-REFPT-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-REFPT-GET (DD W) ++ (LET (CENT REFPT) ++ (WHEN (SETQ REFPT (ASSOC 'DRAW-REFPT (CADDR DD))) ++ (LET ((GC (CADDR *DRAW-WINDOW*))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR *DRAW-WINDOW*) 1 ++ *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 3) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR *DRAW-WINDOW*) 4 ++ *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR *DRAW-WINDOW*) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*)))) ++ (DRAW-OBJECT-DRAW REFPT *DRAW-WINDOW* (COPY-LIST '(0 0))) ++ (LET ((GC (CADDR *DRAW-WINDOW*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)) ++ (SETF (CADDR DD) (REMOVE REFPT (CADDR DD)))) ++ (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) ++ (LIST 'DRAW-REFPT CENT (COPY-LIST '(0 0)) NIL 1))) ++(SETF (GET 'DRAW-REFPT-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-REFPT-GET 'GLFNRESULTTYPE) 'DRAW-REFPT) ++ ++ ++(DEFUN DRAW-DESC-REFPT (DD) ++ (LET (REFPT) ++ (SETQ REFPT (ASSOC 'DRAW-REFPT (CADDR DD))) ++ (IF REFPT (CADR REFPT) (COPY-LIST '(0 0))))) ++(SETF (GET 'DRAW-DESC-REFPT 'GLARGUMENTS) '((DD DRAW-DESC))) ++(SETF (GET 'DRAW-DESC-REFPT 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-TEXT-DRAW (D W OFF) ++ (LET ((SSTR (STRINGIFY (CADDDR D)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) ++ (+ (CAR OFF) (CAADR D)) ++ (- (CADDDR W) (+ (CADR OFF) (CADADR D))) (GET-C-STRING SSTR) ++ (LENGTH SSTR)))) ++ ++(DEFUN DRAW-TEXT-DRAW-OUTLINE (W X Y D) ++ (SETF (SECOND D) (LIST X Y)) ++ (WINDOW-DRAW-BOX-XY W X (+ 2 Y) (CAADDR D) (CADR (CADDR D)))) ++ ++(DEFUN DRAW-TEXT-DRAW-OUTLINE (W X Y D) ++ (SETF (SECOND D) (LIST X Y)) ++ (WINDOW-DRAW-BOX-XY W X (+ 2 Y) (CAADDR D) (CADR (CADDR D)))) ++ ++(DEFUN DRAW-TEXT-SELECTEDP (D PT OFF) ++ (LET ((PTP (LIST (- (CAR PT) (CAR OFF)) (- (CADR PT) (CADR OFF))))) ++ (AND (BETWEEN (CAR PTP) (+ -2 (+ (CAADR D) (MIN 0 (CAADDR D)))) ++ (+ 2 ++ (+ (+ (CAADR D) (MIN 0 (CAADDR D))) ++ (ABS (CAADDR D))))) ++ (BETWEEN (CADR PTP) ++ (+ -2 (+ (CADADR D) (MIN 0 (CADR (CADDR D))))) ++ (+ 2 ++ (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) ++ (ABS (CADR (CADDR D))))))))) ++(SETF (GET 'DRAW-TEXT-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-TEXT) (PT VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-TEXT-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-TEXT-GET (DD W) ++ (LET (TXT LNG OFF) ++ (PRINC "Enter text string: ") ++ (SETQ TXT (STRINGIFY (READ))) ++ (SETQ LNG ++ (LET ((SSTR (STRINGIFY TXT))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ (SETQ OFF (WINDOW-GET-BOX-POSITION W LNG 14)) ++ (LIST 'DRAW-TEXT ++ (LET ((GLVAR167 (COPY-LIST '(0 4)))) ++ (LIST (+ (CAR OFF) (CAR GLVAR167)) ++ (+ (CADR OFF) (CADR GLVAR167)))) ++ (LIST LNG 14) TXT 1))) ++(SETF (GET 'DRAW-TEXT-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-TEXT-GET 'GLFNRESULTTYPE) 'DRAW-TEXT) ++ ++ ++(DEFUN DRAW-SNAPP (P1 OFF P2X P2Y) ++ (IF (AND (< (ABS (- (- (CAR P1) (CAR OFF)) P2X)) 4) ++ (< (ABS (- (- (CADR P1) (CADR OFF)) P2Y)) 4)) ++ (LIST (+ (CAR OFF) P2X) (+ (CADR OFF) P2Y)))) ++(SETF (GET 'DRAW-SNAPP 'GLARGUMENTS) ++ '((P1 VECTOR) (OFF VECTOR) (P2X INTEGER) (P2Y INTEGER))) ++(SETF (GET 'DRAW-SNAPP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-DOT-SNAP (D P OFF) ++ (DRAW-SNAPP P OFF (+ 2 (CAADR D)) (+ 2 (CADADR D)))) ++(SETF (GET 'DRAW-DOT-SNAP 'GLARGUMENTS) ++ '((D DRAW-DOT) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-DOT-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-REFPT-SNAP (D P OFF) ++ (DRAW-SNAPP P OFF (CAADR D) (CADADR D))) ++(SETF (GET 'DRAW-REFPT-SNAP 'GLARGUMENTS) ++ '((D DRAW-REFPT) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-REFPT-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-LINE-SNAP (D P OFF) ++ (OR (DRAW-SNAPP P OFF (CAADR D) (CADADR D)) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) ++ (+ (CADADR D) (CADR (CADDR D)))))) ++(SETF (GET 'DRAW-LINE-SNAP 'GLARGUMENTS) ++ '((D DRAW-LINE) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-LINE-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-BOX-SNAP (D P OFF) ++ (LET ((XOFF (CAADR D)) (YOFF (CADADR D)) (XSIZE (CAADDR D)) ++ (YSIZE (CADR (CADDR D)))) ++ (OR (DRAW-SNAPP P OFF XOFF YOFF) ++ (DRAW-SNAPP P OFF (+ XOFF XSIZE) (+ YOFF YSIZE)) ++ (DRAW-SNAPP P OFF (+ XOFF XSIZE) YOFF) ++ (DRAW-SNAPP P OFF XOFF (+ YOFF YSIZE)) ++ (DRAW-SNAPP P OFF (+ XOFF (* 1/2 XSIZE)) YOFF) ++ (DRAW-SNAPP P OFF XOFF (+ YOFF (* 1/2 YSIZE))) ++ (DRAW-SNAPP P OFF (+ XOFF (* 1/2 XSIZE)) (+ YOFF YSIZE)) ++ (DRAW-SNAPP P OFF (+ XOFF XSIZE) (+ YOFF (* 1/2 YSIZE)))))) ++(SETF (GET 'DRAW-BOX-SNAP 'GLARGUMENTS) ++ '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-BOX-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-CIRCLE-SNAP (D P OFF) ++ (OR (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) ++ (+ (CADADR D) (* 1/2 (CAADDR D)))) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) (CADADR D)) ++ (DRAW-SNAPP P OFF (CAADR D) (+ (CADADR D) (* 1/2 (CAADDR D)))) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) ++ (+ (CADADR D) (CADR (CADDR D)))) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) ++ (+ (CADADR D) (* 1/2 (CAADDR D)))))) ++(SETF (GET 'DRAW-CIRCLE-SNAP 'GLARGUMENTS) ++ '((D DRAW-CIRCLE) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-CIRCLE-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-ELLIPSE-SNAP (D P OFF) ++ (OR (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) ++ (+ (CADADR D) (* 1/2 (CADR (CADDR D))))) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) (CADADR D)) ++ (DRAW-SNAPP P OFF (CAADR D) ++ (+ (CADADR D) (* 1/2 (CADR (CADDR D))))) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) ++ (+ (CADADR D) (CADR (CADDR D)))) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) ++ (+ (CADADR D) (* 1/2 (CADR (CADDR D))))))) ++(SETF (GET 'DRAW-ELLIPSE-SNAP 'GLARGUMENTS) ++ '((D DRAW-ELLIPSE) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-ELLIPSE-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-RCBOX-SNAP (D P OFF) ++ (LET ((RX (* 1/2 (CAADDR D))) (RY (* 1/2 (CADR (CADDR D))))) ++ (OR (DRAW-SNAPP P OFF (+ (CAADR D) RX) (CADADR D)) ++ (DRAW-SNAPP P OFF (CAADR D) (+ (CADADR D) RY)) ++ (DRAW-SNAPP P OFF (+ (CAADR D) RX) ++ (+ (CADADR D) (CADR (CADDR D)))) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) (+ (CADADR D) RY))))) ++(SETF (GET 'DRAW-RCBOX-SNAP 'GLARGUMENTS) ++ '((D DRAW-RCBOX) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-RCBOX-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-NO-SNAP (D P OFF) NIL) ++ ++(DEFUN DRAW-MULTI-DRAW (D W OFF) ++ (LET ((TOTALOFF ++ (LIST (+ (CAADR D) (CAR OFF)) (+ (CADADR D) (CADR OFF))))) ++ (DOLIST (SUBD (CADDDR D)) (DRAW-OBJECT-DRAW SUBD W TOTALOFF)))) ++ ++(DEFUN DRAW-INIT-MENUS () ++ (LET ((W (DRAW-WINDOW))) ++ (WINDOW-CLEAR W) ++ (DOLIST (FN '(DRAW-MENU-RECTANGLE DRAW-MENU-CIRCLE ++ DRAW-MENU-ELLIPSE DRAW-MENU-LINE DRAW-MENU-ARROW ++ DRAW-MENU-DOT DRAW-MENU-BUTTON DRAW-MENU-TEXT)) ++ (SETF (GET FN 'DISPLAY-SIZE) '(30 20))) ++ (SETQ *DRAW-MENU-SET* (MENU-SET-CREATE W NIL)) ++ (MENU-SET-ADD-MENU *DRAW-MENU-SET* 'DRAW NIL "Draw" ++ '((DRAW-MENU-RECTANGLE . RECTANGLE) (DRAW-MENU-RCBOX . RCBOX) ++ (DRAW-MENU-CIRCLE . CIRCLE) (DRAW-MENU-ELLIPSE . ELLIPSE) ++ (DRAW-MENU-LINE . LINE) (DRAW-MENU-ARROW . ARROW) ++ (DRAW-MENU-DOT . DOT) (" " . ERASE) ++ (DRAW-MENU-BUTTON . BUTTON) (DRAW-MENU-TEXT . TEXT) ++ (DRAW-MENU-REFPT . REFPT)) ++ (LIST 0 0)) ++ (MENU-SET-ADJUST *DRAW-MENU-SET* 'DRAW 'TOP NIL 1) ++ (MENU-SET-ADJUST *DRAW-MENU-SET* 'DRAW 'RIGHT NIL 2) ++ (MENU-SET-ADD-MENU *DRAW-MENU-SET* 'COMMAND NIL "Commands" ++ '(("Done" . DONE) ("Move" . MOVE) ("Delete" . DELETE) ++ ("Copy" . COPY) ("Redraw" . REDRAW) ("Origin" . ORIGIN) ++ ("LaTex Mode" . LATEXMODE) ("Make Program" . PROGRAM) ++ ("Make LaTex" . LATEX)) ++ (LIST 0 0)) ++ (MENU-SET-ADJUST *DRAW-MENU-SET* 'COMMAND 'TOP 'DRAW 5) ++ (MENU-SET-ADJUST *DRAW-MENU-SET* 'COMMAND 'RIGHT NIL 2))) ++ ++(DEFUN DRAW-MENU-RECTANGLE (W X Y) ++ (WINDOW-DRAW-BOX-XY W (+ X 3) (+ Y 3) 24 14 1)) ++ ++(DEFUN DRAW-MENU-RCBOX (W X Y) ++ (WINDOW-DRAW-RCBOX-XY W (+ X 3) (+ Y 3) 24 14 3 1)) ++ ++(DEFUN DRAW-MENU-CIRCLE (W X Y) ++ (WINDOW-DRAW-CIRCLE-XY W (+ X 15) (+ Y 10) 8 1)) ++ ++(DEFUN DRAW-MENU-ELLIPSE (W X Y) ++ (WINDOW-DRAW-ELLIPSE-XY W (+ X 15) (+ Y 10) 12 8 1)) ++ ++(DEFUN DRAW-MENU-LINE (W X Y) ++ (WINDOW-DRAW-LINE-XY W (+ X 4) (+ Y 4) (+ X 26) (+ Y 16) 1)) ++ ++(DEFUN DRAW-MENU-ARROW (W X Y) ++ (WINDOW-DRAW-ARROW-XY W (+ X 4) (+ Y 4) (+ X 26) (+ Y 16) 1)) ++ ++(DEFUN DRAW-MENU-DOT (W X Y) (WINDOW-DRAW-DOT-XY W (+ X 15) (+ Y 10))) ++ ++(DEFUN DRAW-MENU-BUTTON (W X Y) ++ (WINDOW-DRAW-BOX-XY W (+ X 14) (+ Y 5) 4 4 1)) ++ ++(DEFUN DRAW-MENU-TEXT (W X Y) ++ (WINDOW-PRINTAT-XY W "A" (+ X 12) (+ Y 5))) ++ ++(DEFUN DRAW-MENU-REFPT (W X Y) ++ (WINDOW-DRAW-CROSSHAIRS-XY W (+ X 15) (+ Y 9)) ++ (WINDOW-DRAW-CIRCLE-XY W (+ X 15) (+ Y 9) 2)) ++ ++(DEFUN LATEX-LINE (FROMX FROMY X Y &OPTIONAL ARROWFLG) ++ (LET (DX DY SX SY SIZ ERR ERRB) ++ (SETQ DX (- X FROMX)) ++ (SETQ DY (- Y FROMY)) ++ (IF (= DX 0) ++ (PROGN ++ (SETQ SX 0) ++ (SETQ SY (IF (>= DY 0) 1 -1)) ++ (SETQ SIZ (* (ABS DY) *DRAW-LATEX-FACTOR*))) ++ (IF (= DY 0) ++ (PROGN ++ (SETQ SX (IF (>= DX 0) 1 -1)) ++ (SETQ SY 0) ++ (SETQ SIZ (* (ABS DX) *DRAW-LATEX-FACTOR*))) ++ (PROGN ++ (SETQ ERR 9999) ++ (SETQ SIZ (* (ABS DX) *DRAW-LATEX-FACTOR*)) ++ (DOTIMES (I (IF ARROWFLG 4 6)) ++ (DOTIMES (J (IF ARROWFLG 4 6)) ++ (SETQ ERRB ++ (ABS (- (/ (FLOAT (1+ I)) (FLOAT (1+ J))) ++ (ABS (/ (FLOAT DX) (FLOAT DY)))))) ++ (IF (AND (= (GCD (1+ I) (1+ J)) 1) (< ERRB ERR)) ++ (PROGN ++ (SETQ ERR ERRB) ++ (SETQ SX (1+ I)) ++ (SETQ SY (1+ J)))))) ++ (SETQ SX (* SX (LATEX-SIGN DX))) ++ (SETQ SY (* SY (LATEX-SIGN DY)))))) ++ (FORMAT T " \\put(~5,0F,~5,0F) {\\~A(~D,~D){~5,0F}}~%" ++ (* FROMX *DRAW-LATEX-FACTOR*) (* FROMY *DRAW-LATEX-FACTOR*) ++ (IF ARROWFLG "vector" "line") SX SY SIZ))) ++ ++(DEFUN LATEX-SIGN (X) (IF (>= X 0) 1 -1)) ++ ++(DEFUN DRAW-OUTPUT (OUTFILENAME &OPTIONAL NAMES) ++ (PROG (PRETTYSAVE LENGTHSAVE D FNNAME CODE) ++ (OR NAMES (SETQ NAMES *DRAW-OBJECTS*)) ++ (IF (SYMBOLP NAMES) (SETQ NAMES (LIST NAMES))) ++ (WITH-OPEN-FILE ++ (OUTFILE OUTFILENAME :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE) ++ (SETQ PRETTYSAVE *PRINT-PRETTY*) ++ (SETQ LENGTHSAVE *PRINT-LENGTH*) ++ (SETQ *PRINT-PRETTY* T) ++ (SETQ *PRINT-LENGTH* 80) ++ (FORMAT OUTFILE "; ~A ~A~%" OUTFILENAME (DRAW-GET-TIME-STRING)) ++ (DOLIST (NAME NAMES) ++ (IF (SETQ D (GET NAME 'DRAW-DESCR)) ++ (PROGN ++ (TERPRI OUTFILE) ++ (PRINT (LIST 'SETF ++ (LIST 'GET (LIST 'QUOTE NAME) ''DRAW-DESCR) ++ (LIST 'QUOTE D)) ++ OUTFILE) ++ (IF (AND (SETQ FNNAME (DRAW-DESC-FNNAME D)) ++ (SETQ CODE (SYMBOL-FUNCTION FNNAME))) ++ (PROGN ++ (TERPRI OUTFILE) ++ (PRINT (CONS 'DEFUN ++ (IF (EQ (CAR CODE) 'LAMBDA-BLOCK) ++ (CDR CODE) ++ (CONS FNNAME (CDR CODE)))) ++ OUTFILE))))) ++ (IF (SETQ D (GET NAME 'PICMENU-SPEC)) ++ (PROGN ++ (TERPRI OUTFILE) ++ (PRINT (LIST 'SETF ++ (LIST 'GET (LIST 'QUOTE NAME) ++ ''PICMENU-SPEC) ++ (LIST 'QUOTE D)) ++ OUTFILE)))) ++ (TERPRI OUTFILE) ++ (SETQ *PRINT-PRETTY* PRETTYSAVE) ++ (SETQ *PRINT-LENGTH* LENGTHSAVE)) ++ (RETURN OUTFILENAME))) ++ ++(DEFUN DRAW-GET-TIME-STRING () ++ (LET (SECOND MINUTE HOUR DATE MONTH YEAR) ++ (MULTIPLE-VALUE-SETQ (SECOND MINUTE HOUR DATE MONTH YEAR) ++ (GET-DECODED-TIME)) ++ (FORMAT NIL "~2D ~A ~4D ~2D:~2D:~2D" DATE ++ (NTH (1- MONTH) ++ '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" ++ "Sep" "Oct" "Nov" "Dec")) ++ YEAR HOUR MINUTE SECOND))) ++ ++(DEFUN COMPILE-DRAW () ++ (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") ++ '("glisp/menu-set.lsp" "glisp/draw.lsp") "glisp/drawtrans.lsp" ++ "glisp/draw-header.lsp") ++ (CF DRAWTRANS)) ++ ++(DEFUN COMPILE-DRAWB () ++ (GLCOMPFILES *DIRECTORY* ++ '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") ++ '("glisp/menu-set.lsp" "glisp/draw.lsp") "glisp/drawtrans.lsp" ++ "glisp/draw-header.lsp")) ++ ++(DEFUN DRAW-OUT (&OPTIONAL NAMES FILE) ++ (OR NAMES (SETQ NAMES *DRAW-OBJECTS*)) ++ (IF (NOT (CONSP NAMES)) (SETQ NAMES (LIST NAMES))) ++ (DRAW-OUTPUT (OR FILE "glisp/draw.del") NAMES) ++ (SETQ *DRAW-OBJECTS* (SET-DIFFERENCE *DRAW-OBJECTS* NAMES)) ++ NAMES) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_sysinit.lsp +@@ -0,0 +1,69 @@ ++; Copyright (c) 1994 William F. Schelter ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++(in-package :XLIB) ++ ++;; This file is used for defining the C function user_init, to run the ++;; initialization code from a list of files in *files*. These files ++;; should have been compiled with (compile-file "foo.lsp" :system-p t) ++;; and have been linked into the image. It presumes the .o files ++;; are in the current directory, and the files *files* are in the proper ++;; order to be loaded. ++ ++;;define a function USER::USER-INIT, which will run the init code for a set ++;;of files which are linked into an image. ++ ++(clines "#define init_or_load(fn,file) do {extern void fn(void); gcl_init_or_load1(fn,file);} while(0)") ++(clines "static void") ++(clines "load1(char *x) {") ++(clines "printf(\"loading %s\\n\",x);") ++(clines "fflush(stdout);") ++(clines "load(x);") ++(clines "}") ++ ++#. ++(let ((files *files*)) ++ (declare (special object-path)) ++ (with-open-file (st "maxobjs" :direction :output) ++ `(progn ++ (clines "object user_init() {") ++ (clines "load1(\"../xgcl-2/sysdef.lisp\");") ++ ,@(sloop::sloop for x in files ++ for f = (substitute #\_ #\- x) ++ for ff = (namestring (merge-pathnames (make-pathname :type "o") (pathname (format nil "~a.lsp" x)))) ++ do (princ ff st) (princ " " st) ++ collect ++ `(clines ,(Format nil "init_or_load(init_~a,\"~a\");" (string-downcase f) ff)) ++ finally (terpri st) ++ )) ++ ++ )) ++ ++(clines "return Cnil;}") ++ ++;; invoke this to initialize maxima. ++ ++;; make this if you dont want the invocation done automatically. ++;(defentry user::user-init () "user_init") ++ ++ ++ ++ +--- gcl-2.6.7.orig/ansi-tests/makefile ++++ gcl-2.6.7/ansi-tests/makefile +@@ -1,9 +1,10 @@ ++-include ../makedefs ++ ++test-unixport: ++ echo "(load \"gclload.lsp\")" | ../unixport/saved_ansi_gcl$(EXE) | tee test.out + + test: + echo "(load \"gclload.lsp\")" | gcl | tee test.out + +-test-unixport: +- echo "(load \"gclload.lsp\")" | ../unixport/saved_ansi_gcl | tee test.out +- + clean: + rm -f test.out *.fasl *.o *.so *~ *.fn *.x86f *.fasl *.ufsl +--- /dev/null ++++ gcl-2.6.7/gmp4/randmts.c +@@ -0,0 +1,157 @@ ++/* Mersenne Twister pseudo-random number generator functions. ++ ++Copyright 2002, 2003 Free Software Foundation, Inc. ++ ++This file is part of the GNU MP Library. ++ ++The GNU MP Library is free software; you can redistribute it and/or modify ++it under the terms of the GNU Lesser General Public License as published by ++the Free Software Foundation; either version 3 of the License, or (at your ++option) any later version. ++ ++The GNU MP Library 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 Lesser General Public ++License for more details. ++ ++You should have received a copy of the GNU Lesser General Public License ++along with the GNU MP Library. If not, see http://www.gnu.org/licenses/. */ ++ ++#include "gmp.h" ++#include "gmp-impl.h" ++#include "randmt.h" ++ ++ ++/* Calculate (b^e) mod (2^n-k) for e=1074888996, n=19937 and k=20023, ++ needed by the seeding function below. */ ++static void ++mangle_seed (mpz_ptr r, mpz_srcptr b_orig) ++{ ++ mpz_t t, b; ++ unsigned long e = 0x40118124; ++ unsigned long bit = 0x20000000; ++ ++ mpz_init (t); ++ mpz_init_set (b, b_orig); /* in case r==b_orig */ ++ ++ mpz_set (r, b); ++ do ++ { ++ mpz_mul (r, r, r); ++ ++ reduce: ++ for (;;) ++ { ++ mpz_tdiv_q_2exp (t, r, 19937L); ++ if (mpz_sgn (t) == 0) ++ break; ++ mpz_tdiv_r_2exp (r, r, 19937L); ++ mpz_addmul_ui (r, t, 20023L); ++ } ++ ++ if ((e & bit) != 0) ++ { ++ e &= ~bit; ++ mpz_mul (r, r, b); ++ goto reduce; ++ } ++ ++ bit >>= 1; ++ } ++ while (bit != 0); ++ ++ mpz_clear (t); ++ mpz_clear (b); ++} ++ ++ ++/* Seeding function. Uses powering modulo a non-Mersenne prime to obtain ++ a permutation of the input seed space. The modulus is 2^19937-20023, ++ which is probably prime. The power is 1074888996. In order to avoid ++ seeds 0 and 1 generating invalid or strange output, the input seed is ++ first manipulated as follows: ++ ++ seed1 = seed mod (2^19937-20027) + 2 ++ ++ so that seed1 lies between 2 and 2^19937-20026 inclusive. Then the ++ powering is performed as follows: ++ ++ seed2 = (seed1^1074888996) mod (2^19937-20023) ++ ++ and then seed2 is used to bootstrap the buffer. ++ ++ This method aims to give guarantees that: ++ a) seed2 will never be zero, ++ b) seed2 will very seldom have a very low population of ones in its ++ binary representation, and ++ c) every seed between 0 and 2^19937-20028 (inclusive) will yield a ++ different sequence. ++ ++ CAVEATS: ++ ++ The period of the seeding function is 2^19937-20027. This means that ++ with seeds 2^19937-20027, 2^19937-20026, ... the exact same sequences ++ are obtained as with seeds 0, 1, etc.; it also means that seed -1 ++ produces the same sequence as seed 2^19937-20028, etc. ++ */ ++ ++static void ++randseed_mt (gmp_randstate_t rstate, mpz_srcptr seed) ++{ ++ int i; ++ size_t cnt; ++ ++ gmp_rand_mt_struct *p; ++ mpz_t mod; /* Modulus. */ ++ mpz_t seed1; /* Intermediate result. */ ++ ++ p = (gmp_rand_mt_struct *) RNG_STATE (rstate); ++ ++ mpz_init (mod); ++ mpz_init (seed1); ++ ++ mpz_set_ui (mod, 0L); ++ mpz_setbit (mod, 19937L); ++ mpz_sub_ui (mod, mod, 20027L); ++ mpz_mod (seed1, seed, mod); /* Reduce `seed' modulo `mod'. */ ++ mpz_add_ui (seed1, seed1, 2L); /* seed1 is now ready. */ ++ mangle_seed (seed1, seed1); /* Perform the mangling by powering. */ ++ ++ /* Copy the last bit into bit 31 of mt[0] and clear it. */ ++ p->mt[0] = (mpz_tstbit (seed1, 19936L) != 0) ? 0x80000000 : 0; ++ mpz_clrbit (seed1, 19936L); ++ ++ /* Split seed1 into N-1 32-bit chunks. */ ++ mpz_export (&p->mt[1], &cnt, -1, sizeof (p->mt[1]), 0, ++ 8 * sizeof (p->mt[1]) - 32, seed1); ++ cnt++; ++ ASSERT (cnt <= N); ++ while (cnt < N) ++ p->mt[cnt++] = 0; ++ ++ mpz_clear (mod); ++ mpz_clear (seed1); ++ ++ /* Warm the generator up if necessary. */ ++ if (WARM_UP != 0) ++ for (i = 0; i < WARM_UP / N; i++) ++ __gmp_mt_recalc_buffer (p->mt); ++ ++ p->mti = WARM_UP % N; ++} ++ ++ ++static const gmp_randfnptr_t Mersenne_Twister_Generator = { ++ randseed_mt, ++ __gmp_randget_mt, ++ __gmp_randclear_mt, ++ __gmp_randiset_mt ++}; ++ ++/* Initialize MT-specific data. */ ++void ++gmp_randinit_mt (gmp_randstate_t rstate) ++{ ++ __gmp_randinit_mt_noseed (rstate); ++ RNG_FNPTR (rstate) = (void *) &Mersenne_Twister_Generator; ++} +--- /dev/null ++++ gcl-2.6.7/gmp4/acinclude.m4 +@@ -0,0 +1,3868 @@ ++dnl GMP specific autoconf macros ++ ++ ++dnl Copyright 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2009 Free Software ++dnl Foundation, Inc. ++dnl ++dnl This file is part of the GNU MP Library. ++dnl ++dnl The GNU MP Library is free software; you can redistribute it and/or modify ++dnl it under the terms of the GNU Lesser General Public License as published ++dnl by the Free Software Foundation; either version 3 of the License, or (at ++dnl your option) any later version. ++dnl ++dnl The GNU MP Library is distributed in the hope that it will be useful, but ++dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ++dnl or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public ++dnl License for more details. ++dnl ++dnl You should have received a copy of the GNU Lesser General Public License ++dnl along with the GNU MP Library. If not, see http://www.gnu.org/licenses/. ++ ++ ++dnl Some tests use, or must delete, the default compiler output. The ++dnl possible filenames are based on what autoconf looks for, namely ++dnl ++dnl a.out - normal unix style ++dnl b.out - i960 systems, including gcc there ++dnl a.exe - djgpp ++dnl a_out.exe - OpenVMS DEC C called via GNV wrapper (gnv.sourceforge.net) ++dnl conftest.exe - various DOS compilers ++ ++ ++define(IA64_PATTERN, ++[[ia64*-*-* | itanium-*-* | itanium2-*-*]]) ++ ++dnl Need to be careful not to match m6811, m6812, m68hc11 and m68hc12, all ++dnl of which config.sub accepts. (Though none of which are likely to work ++dnl with GMP.) ++dnl ++define(M68K_PATTERN, ++[[m68k-*-* | m68[0-9][0-9][0-9]-*-*]]) ++ ++define(POWERPC64_PATTERN, ++[[powerpc64-*-* | powerpc64le-*-* | powerpc620-*-* | powerpc630-*-* | powerpc970-*-* | power[3-9]-*-*]]) ++ ++define(X86_PATTERN, ++[[i?86*-*-* | k[5-8]*-*-* | pentium*-*-* | athlon-*-* | viac3*-*-* | geode*-*-*]]) ++ ++ ++dnl GMP_FAT_SUFFIX(DSTVAR, DIRECTORY) ++dnl --------------------------------- ++dnl Emit code to set shell variable DSTVAR to the suffix for a fat binary ++dnl routine from DIRECTORY. DIRECTORY can be a shell expression like $foo ++dnl etc. ++dnl ++dnl The suffix is directory separators / or \ changed to underscores, and ++dnl if there's more than one directory part, then the first is dropped. ++dnl ++dnl For instance, ++dnl ++dnl x86 -> x86 ++dnl x86/k6 -> k6 ++dnl x86/k6/mmx -> k6_mmx ++ ++define(GMP_FAT_SUFFIX, ++[[$1=`echo $2 | sed -e '/\//s:^[^/]*/::' -e 's:[\\/]:_:g'`]]) ++ ++ ++dnl GMP_REMOVE_FROM_LIST(listvar,item) ++dnl ---------------------------------- ++dnl Emit code to remove any occurrence of ITEM from $LISTVAR. ITEM can be a ++dnl shell expression like $foo if desired. ++ ++define(GMP_REMOVE_FROM_LIST, ++[remove_from_list_tmp= ++for remove_from_list_i in $[][$1]; do ++ if test $remove_from_list_i = [$2]; then :; ++ else ++ remove_from_list_tmp="$remove_from_list_tmp $remove_from_list_i" ++ fi ++done ++[$1]=$remove_from_list_tmp ++]) ++ ++ ++dnl GMP_STRIP_PATH(subdir) ++dnl ---------------------- ++dnl Strip entries */subdir from $path and $fat_path. ++ ++define(GMP_STRIP_PATH, ++[GMP_STRIP_PATH_VAR(path, [$1]) ++GMP_STRIP_PATH_VAR(fat_path, [$1]) ++]) ++ ++define(GMP_STRIP_PATH_VAR, ++[tmp_path= ++for i in $[][$1]; do ++ case $i in ++ */[$2]) ;; ++ *) tmp_path="$tmp_path $i" ;; ++ esac ++done ++[$1]="$tmp_path" ++]) ++ ++ ++dnl GMP_INCLUDE_GMP_H ++dnl ----------------- ++dnl Expand to the right way to #include gmp-h.in. This must be used ++dnl instead of gmp.h, since that file isn't generated until the end of the ++dnl configure. ++dnl ++dnl Dummy values for __GMP_BITS_PER_MP_LIMB and GMP_LIMB_BITS are enough ++dnl for all current configure-time uses of gmp.h. ++ ++define(GMP_INCLUDE_GMP_H, ++[[#define __GMP_WITHIN_CONFIGURE 1 /* ignore template stuff */ ++#define GMP_NAIL_BITS $GMP_NAIL_BITS ++#define __GMP_BITS_PER_MP_LIMB 123 /* dummy for GMP_NUMB_BITS etc */ ++#define GMP_LIMB_BITS 123 ++$DEFN_LONG_LONG_LIMB ++#include "$srcdir/gmp-h.in"] ++]) ++ ++ ++dnl GMP_HEADER_GETVAL(NAME,FILE) ++dnl ---------------------------- ++dnl Expand at autoconf time to the value of a "#define NAME" from the given ++dnl FILE. The regexps here aren't very rugged, but are enough for gmp. ++dnl /dev/null as a parameter prevents a hang if $2 is accidentally omitted. ++ ++define(GMP_HEADER_GETVAL, ++[patsubst(patsubst( ++esyscmd([grep "^#define $1 " $2 /dev/null 2>/dev/null]), ++[^.*$1[ ]+],[]), ++[[ ++ ]*$],[])]) ++ ++ ++dnl GMP_VERSION ++dnl ----------- ++dnl The gmp version number, extracted from the #defines in gmp-h.in at ++dnl autoconf time. Two digits like 3.0 if patchlevel <= 0, or three digits ++dnl like 3.0.1 if patchlevel > 0. ++ ++define(GMP_VERSION, ++[GMP_HEADER_GETVAL(__GNU_MP_VERSION,gmp-h.in)[]dnl ++.GMP_HEADER_GETVAL(__GNU_MP_VERSION_MINOR,gmp-h.in)[]dnl ++.GMP_HEADER_GETVAL(__GNU_MP_VERSION_PATCHLEVEL,gmp-h.in)]) ++ ++ ++dnl GMP_SUBST_CHECK_FUNCS(func,...) ++dnl ------------------------------ ++dnl Setup an AC_SUBST of HAVE_FUNC_01 for each argument. ++ ++AC_DEFUN([GMP_SUBST_CHECK_FUNCS], ++[m4_if([$1],,, ++[_GMP_SUBST_CHECK_FUNCS(ac_cv_func_[$1],HAVE_[]m4_translit([$1],[a-z],[A-Z])_01) ++GMP_SUBST_CHECK_FUNCS(m4_shift($@))])]) ++ ++dnl Called: _GMP_SUBST_CHECK_FUNCS(cachevar,substvar) ++AC_DEFUN([_GMP_SUBST_CHECK_FUNCS], ++[case $[$1] in ++yes) AC_SUBST([$2],1) ;; ++no) [$2]=0 ;; ++esac ++]) ++ ++ ++dnl GMP_SUBST_CHECK_HEADERS(foo.h,...) ++dnl ---------------------------------- ++dnl Setup an AC_SUBST of HAVE_FOO_H_01 for each argument. ++ ++AC_DEFUN([GMP_SUBST_CHECK_HEADERS], ++[m4_if([$1],,, ++[_GMP_SUBST_CHECK_HEADERS(ac_cv_header_[]m4_translit([$1],[./],[__]), ++HAVE_[]m4_translit([$1],[a-z./],[A-Z__])_01) ++GMP_SUBST_CHECK_HEADERS(m4_shift($@))])]) ++ ++dnl Called: _GMP_SUBST_CHECK_HEADERS(cachevar,substvar) ++AC_DEFUN([_GMP_SUBST_CHECK_HEADERS], ++[case $[$1] in ++yes) AC_SUBST([$2],1) ;; ++no) [$2]=0 ;; ++esac ++]) ++ ++ ++dnl GMP_COMPARE_GE(A1,B1, A2,B2, ...) ++dnl --------------------------------- ++dnl Compare two version numbers A1.A2.etc and B1.B2.etc. Set ++dnl $gmp_compare_ge to yes or no according to the result. The A parts ++dnl should be variables, the B parts fixed numbers. As many parts as ++dnl desired can be included. An empty string in an A part is taken to be ++dnl zero, the B parts should be non-empty and non-zero. ++dnl ++dnl For example, ++dnl ++dnl GMP_COMPARE($major,10, $minor,3, $subminor,1) ++dnl ++dnl would test whether $major.$minor.$subminor is greater than or equal to ++dnl 10.3.1. ++ ++AC_DEFUN([GMP_COMPARE_GE], ++[gmp_compare_ge=no ++GMP_COMPARE_GE_INTERNAL($@) ++]) ++ ++AC_DEFUN([GMP_COMPARE_GE_INTERNAL], ++[ifelse(len([$3]),0, ++[if test -n "$1" && test "$1" -ge $2; then ++ gmp_compare_ge=yes ++fi], ++[if test -n "$1"; then ++ if test "$1" -gt $2; then ++ gmp_compare_ge=yes ++ else ++ if test "$1" -eq $2; then ++ GMP_COMPARE_GE_INTERNAL(m4_shift(m4_shift($@))) ++ fi ++ fi ++fi]) ++]) ++ ++ ++dnl GMP_PROG_AR ++dnl ----------- ++dnl GMP additions to $AR. ++dnl ++dnl A cross-"ar" may be necessary when cross-compiling since the build ++dnl system "ar" might try to interpret the object files to build a symbol ++dnl table index, hence the use of AC_CHECK_TOOL. ++dnl ++dnl A user-selected $AR is always left unchanged. AC_CHECK_TOOL is still ++dnl run to get the "checking" message printed though. ++dnl ++dnl If extra flags are added to AR, then ac_cv_prog_AR and ++dnl ac_cv_prog_ac_ct_AR are set too, since libtool (cvs 2003-03-31 at ++dnl least) will do an AC_CHECK_TOOL and that will AR from one of those two ++dnl cached variables. (ac_cv_prog_AR is used if there's an ac_tool_prefix, ++dnl or ac_cv_prog_ac_ct_AR is used otherwise.) FIXME: This is highly ++dnl dependent on autoconf internals, perhaps it'd work to put our extra ++dnl flags into AR_FLAGS instead. ++dnl ++dnl $AR_FLAGS is set to "cq" rather than leaving it to libtool "cru". The ++dnl latter fails when libtool goes into piecewise mode and is unlucky ++dnl enough to have two same-named objects in separate pieces, as happens ++dnl for instance to random.o (and others) on vax-dec-ultrix4.5. Naturally ++dnl a user-selected $AR_FLAGS is left unchanged. ++dnl ++dnl For reference, $ARFLAGS is used by automake (1.8) for its ".a" archive ++dnl file rules. This doesn't get used by the piecewise linking, so we ++dnl leave it at the default "cru". ++dnl ++dnl FIXME: Libtool 1.5.2 has its own arrangements for "cq", but that version ++dnl is broken in other ways. When we can upgrade, remove the forcible ++dnl AR_FLAGS=cq. ++ ++AC_DEFUN([GMP_PROG_AR], ++[dnl Want to establish $AR before libtool initialization. ++AC_BEFORE([$0],[AC_PROG_LIBTOOL]) ++gmp_user_AR=$AR ++AC_CHECK_TOOL(AR, ar, ar) ++if test -z "$gmp_user_AR"; then ++ eval arflags=\"\$ar${abi1}_flags\" ++ test -n "$arflags" || eval arflags=\"\$ar${abi2}_flags\" ++ if test -n "$arflags"; then ++ AC_MSG_CHECKING([for extra ar flags]) ++ AR="$AR $arflags" ++ ac_cv_prog_AR="$AR $arflags" ++ ac_cv_prog_ac_ct_AR="$AR $arflags" ++ AC_MSG_RESULT([$arflags]) ++ fi ++fi ++if test -z "$AR_FLAGS"; then ++ AR_FLAGS=cq ++fi ++]) ++ ++ ++dnl GMP_PROG_M4 ++dnl ----------- ++dnl Find a working m4, either in $PATH or likely locations, and setup $M4 ++dnl and an AC_SUBST accordingly. If $M4 is already set then it's a user ++dnl choice and is accepted with no checks. GMP_PROG_M4 is like ++dnl AC_PATH_PROG or AC_CHECK_PROG, but tests each m4 found to see if it's ++dnl good enough. ++dnl ++dnl See mpn/asm-defs.m4 for details on the known bad m4s. ++ ++AC_DEFUN([GMP_PROG_M4], ++[AC_ARG_VAR(M4,[m4 macro processor]) ++AC_CACHE_CHECK([for suitable m4], ++ gmp_cv_prog_m4, ++[if test -n "$M4"; then ++ gmp_cv_prog_m4="$M4" ++else ++ cat >conftest.m4 <<\EOF ++dnl Must protect this against being expanded during autoconf m4! ++dnl Dont put "dnl"s in this as autoconf will flag an error for unexpanded ++dnl macros. ++[define(dollarhash,``$][#'')ifelse(dollarhash(x),1,`define(t1,Y)', ++``bad: $][# not supported (SunOS /usr/bin/m4) ++'')ifelse(eval(89),89,`define(t2,Y)', ++`bad: eval() doesnt support 8 or 9 in a constant (OpenBSD 2.6 m4) ++')ifelse(t1`'t2,YY,`good ++')] ++EOF ++dnl ' <- balance the quotes for emacs sh-mode ++ echo "trying m4" >&AC_FD_CC ++ gmp_tmp_val=`(m4 conftest.m4) 2>&AC_FD_CC` ++ echo "$gmp_tmp_val" >&AC_FD_CC ++ if test "$gmp_tmp_val" = good; then ++ gmp_cv_prog_m4="m4" ++ else ++ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ++dnl $ac_dummy forces splitting on constant user-supplied paths. ++dnl POSIX.2 word splitting is done only on the output of word expansions, ++dnl not every word. This closes a longstanding sh security hole. ++ ac_dummy="$PATH:/usr/5bin" ++ for ac_dir in $ac_dummy; do ++ test -z "$ac_dir" && ac_dir=. ++ echo "trying $ac_dir/m4" >&AC_FD_CC ++ gmp_tmp_val=`($ac_dir/m4 conftest.m4) 2>&AC_FD_CC` ++ echo "$gmp_tmp_val" >&AC_FD_CC ++ if test "$gmp_tmp_val" = good; then ++ gmp_cv_prog_m4="$ac_dir/m4" ++ break ++ fi ++ done ++ IFS="$ac_save_ifs" ++ if test -z "$gmp_cv_prog_m4"; then ++ AC_MSG_ERROR([No usable m4 in \$PATH or /usr/5bin (see config.log for reasons).]) ++ fi ++ fi ++ rm -f conftest.m4 ++fi]) ++M4="$gmp_cv_prog_m4" ++AC_SUBST(M4) ++]) ++ ++ ++dnl GMP_M4_M4WRAP_SPURIOUS ++dnl ---------------------- ++dnl Check for spurious output from m4wrap(), as described in mpn/asm-defs.m4. ++dnl ++dnl The following systems have been seen with the problem. ++dnl ++dnl - Unicos alpha, but its assembler doesn't seem to mind. ++dnl - MacOS X Darwin, its assembler fails. ++dnl - NetBSD 1.4.1 m68k, and gas 1.92.3 there gives a warning and ignores ++dnl the bad last line since it doesn't have a newline. ++dnl - NetBSD 1.4.2 alpha, but its assembler doesn't seem to mind. ++dnl - HP-UX ia64. ++dnl ++dnl Enhancement: Maybe this could be in GMP_PROG_M4, and attempt to prefer ++dnl an m4 with a working m4wrap, if it can be found. ++ ++AC_DEFUN([GMP_M4_M4WRAP_SPURIOUS], ++[AC_REQUIRE([GMP_PROG_M4]) ++AC_CACHE_CHECK([if m4wrap produces spurious output], ++ gmp_cv_m4_m4wrap_spurious, ++[# hide the d-n-l from autoconf's error checking ++tmp_d_n_l=d""nl ++cat >conftest.m4 <&AC_FD_CC ++cat conftest.m4 >&AC_FD_CC ++tmp_chars=`$M4 conftest.m4 | wc -c` ++echo produces $tmp_chars chars output >&AC_FD_CC ++rm -f conftest.m4 ++if test $tmp_chars = 0; then ++ gmp_cv_m4_m4wrap_spurious=no ++else ++ gmp_cv_m4_m4wrap_spurious=yes ++fi ++]) ++GMP_DEFINE_RAW(["define(,<$gmp_cv_m4_m4wrap_spurious>)"]) ++]) ++ ++ ++dnl GMP_PROG_NM ++dnl ----------- ++dnl GMP additions to libtool AC_PROG_NM. ++dnl ++dnl Note that if AC_PROG_NM can't find a working nm it still leaves ++dnl $NM set to "nm", so $NM can't be assumed to actually work. ++dnl ++dnl A user-selected $NM is always left unchanged. AC_PROG_NM is still run ++dnl to get the "checking" message printed though. ++dnl ++dnl Perhaps it'd be worthwhile checking that nm works, by running it on an ++dnl actual object file. For instance on sparcv9 solaris old versions of ++dnl GNU nm don't recognise 64-bit objects. Checking would give a better ++dnl error message than just a failure in later tests like GMP_ASM_W32 etc. ++dnl ++dnl On the other hand it's not really normal autoconf practice to take too ++dnl much trouble over detecting a broken set of tools. And libtool doesn't ++dnl do anything at all for say ranlib or strip. So for now we're inclined ++dnl to just demand that the user provides a coherent environment. ++ ++AC_DEFUN([GMP_PROG_NM], ++[dnl Make sure we're the first to call AC_PROG_NM, so our extra flags are ++dnl used by everyone. ++AC_BEFORE([$0],[AC_PROG_NM]) ++gmp_user_NM=$NM ++AC_PROG_NM ++ ++# FIXME: When cross compiling (ie. $ac_tool_prefix not empty), libtool ++# defaults to plain "nm" if a "${ac_tool_prefix}nm" is not found. In this ++# case run it again to try the native "nm", firstly so that likely locations ++# are searched, secondly so that -B or -p are added if necessary for BSD ++# format. This is necessary for instance on OSF with "./configure ++# --build=alphaev5-dec-osf --host=alphaev6-dec-osf". ++# ++if test -z "$gmp_user_NM" && test -n "$ac_tool_prefix" && test "$NM" = nm; then ++ $as_unset lt_cv_path_NM ++ gmp_save_ac_tool_prefix=$ac_tool_prefix ++ ac_tool_prefix= ++ NM= ++ AC_PROG_NM ++ ac_tool_prefix=$gmp_save_ac_tool_prefix ++fi ++ ++if test -z "$gmp_user_NM"; then ++ eval nmflags=\"\$nm${abi1}_flags\" ++ test -n "$nmflags" || eval nmflags=\"\$nm${abi2}_flags\" ++ if test -n "$nmflags"; then ++ AC_MSG_CHECKING([for extra nm flags]) ++ NM="$NM $nmflags" ++ AC_MSG_RESULT([$nmflags]) ++ fi ++fi ++]) ++ ++ ++dnl GMP_PROG_CC_WORKS(cc+cflags,[ACTION-IF-WORKS][,ACTION-IF-NOT-WORKS]) ++dnl -------------------------------------------------------------------- ++dnl Check if cc+cflags can compile and link. ++dnl ++dnl This test is designed to be run repeatedly with different cc+cflags ++dnl selections, so the result is not cached. ++dnl ++dnl For a native build, meaning $cross_compiling == no, we require that the ++dnl generated program will run. This is the same as AC_PROG_CC does in ++dnl _AC_COMPILER_EXEEXT_WORKS, and checking here will ensure we don't pass ++dnl a CC/CFLAGS combination that it rejects. ++dnl ++dnl sparc-*-solaris2.7 can compile ABI=64 but won't run it if the kernel ++dnl was booted in 32-bit mode. The effect of requiring the compiler output ++dnl will run is that a plain native "./configure" falls back on ABI=32, but ++dnl ABI=64 is still available as a cross-compile. ++dnl ++dnl The various specific problems we try to detect are done in separate ++dnl compiles. Although this is probably a bit slower than one test ++dnl program, it makes it easy to indicate the problem in AC_MSG_RESULT, ++dnl hence giving the user a clue about why we rejected the compiler. ++ ++AC_DEFUN([GMP_PROG_CC_WORKS], ++[AC_MSG_CHECKING([compiler $1]) ++gmp_prog_cc_works=yes ++ ++# first see a simple "main()" works, then go on to other checks ++GMP_PROG_CC_WORKS_PART([$1], []) ++ ++GMP_PROG_CC_WORKS_PART([$1], [function pointer return], ++[/* The following provokes an internal error from gcc 2.95.2 -mpowerpc64 ++ (without -maix64), hence detecting an unusable compiler */ ++void *g() { return (void *) 0; } ++void *f() { return g(); } ++]) ++ ++GMP_PROG_CC_WORKS_PART([$1], [cmov instruction], ++[/* The following provokes an invalid instruction syntax from i386 gcc ++ -march=pentiumpro on Solaris 2.8. The native sun assembler ++ requires a non-standard syntax for cmov which gcc (as of 2.95.2 at ++ least) doesn't know. */ ++int n; ++int cmov () { return (n >= 0 ? n : 0); } ++]) ++ ++GMP_PROG_CC_WORKS_PART([$1], [double -> ulong conversion], ++[/* The following provokes a linker invocation problem with gcc 3.0.3 ++ on AIX 4.3 under "-maix64 -mpowerpc64 -mcpu=630". The -mcpu=630 ++ option causes gcc to incorrectly select the 32-bit libgcc.a, not ++ the 64-bit one, and consequently it misses out on the __fixunsdfdi ++ helper (double -> uint64 conversion). */ ++double d; ++unsigned long gcc303 () { return (unsigned long) d; } ++]) ++ ++GMP_PROG_CC_WORKS_PART([$1], [double negation], ++[/* The following provokes an error from hppa gcc 2.95 under -mpa-risc-2-0 if ++ the assembler doesn't know hppa 2.0 instructions. fneg is a 2.0 ++ instruction, and a negation like this comes out using it. */ ++double fneg_data; ++unsigned long fneg () { return -fneg_data; } ++]) ++ ++GMP_PROG_CC_WORKS_PART([$1], [double -> float conversion], ++[/* The following makes gcc 3.3 -march=pentium4 generate an SSE2 xmm insn ++ (cvtsd2ss) which will provoke an error if the assembler doesn't recognise ++ those instructions. Not sure how much of the gmp code will come out ++ wanting sse2, but it's easiest to reject an option we know is bad. */ ++double ftod_data; ++float ftod () { return (float) ftod_data; } ++]) ++ ++GMP_PROG_CC_WORKS_PART([$1], [gnupro alpha ev6 char spilling], ++[/* The following provokes an internal compiler error from gcc version ++ "2.9-gnupro-99r1" under "-O2 -mcpu=ev6", apparently relating to char ++ values being spilled into floating point registers. The problem doesn't ++ show up all the time, but has occurred enough in GMP for us to reject ++ this compiler+flags. */ ++#include /* for memcpy */ ++struct try_t ++{ ++ char dst[2]; ++ char size; ++ long d0, d1, d2, d3, d4, d5, d6; ++ char overlap; ++}; ++struct try_t param[6]; ++int ++param_init () ++{ ++ struct try_t *p; ++ memcpy (p, ¶m[ 2 ], sizeof (*p)); ++ memcpy (p, ¶m[ 2 ], sizeof (*p)); ++ p->size = 2; ++ memcpy (p, ¶m[ 1 ], sizeof (*p)); ++ p->dst[0] = 1; ++ p->overlap = 2; ++ memcpy (p, ¶m[ 3 ], sizeof (*p)); ++ p->dst[0] = 1; ++ p->overlap = 8; ++ memcpy (p, ¶m[ 4 ], sizeof (*p)); ++ memcpy (p, ¶m[ 4 ], sizeof (*p)); ++ p->overlap = 8; ++ memcpy (p, ¶m[ 5 ], sizeof (*p)); ++ memcpy (p, ¶m[ 5 ], sizeof (*p)); ++ memcpy (p, ¶m[ 5 ], sizeof (*p)); ++ return 0; ++} ++]) ++ ++# __builtin_alloca is not available everywhere, check it exists before ++# seeing that it works ++GMP_PROG_CC_WORKS_PART_TEST([$1],[__builtin_alloca availability], ++[int k; int foo () { __builtin_alloca (k); }], ++ [GMP_PROG_CC_WORKS_PART([$1], [alloca array], ++[/* The following provokes an internal compiler error from Itanium HP-UX cc ++ under +O2 or higher. We use this sort of code in mpn/generic/mul_fft.c. */ ++int k; ++int foo () ++{ ++ int i, **a; ++ a = __builtin_alloca (k); ++ for (i = 0; i <= k; i++) ++ a[i] = __builtin_alloca (1 << i); ++} ++])]) ++ ++GMP_PROG_CC_WORKS_PART([$1], [abs int -> double conversion], ++[/* The following provokes an internal error from the assembler on ++ power2-ibm-aix4.3.1.0. gcc -mrios2 compiles to nabs+fcirz, and this ++ results in "Internal error related to the source program domain". ++ ++ For reference it seems to be the combination of nabs+fcirz which is bad, ++ not either alone. This sort of thing occurs in mpz/get_str.c with the ++ way double chars_per_bit_exactly is applied in MPN_SIZEINBASE. Perhaps ++ if that code changes to a scaled-integer style then we won't need this ++ test. */ ++ ++double fp[1]; ++int x; ++int f () ++{ ++ int a; ++ a = (x >= 0 ? x : -x); ++ return a * fp[0]; ++} ++]) ++ ++GMP_PROG_CC_WORKS_PART([$1], [long long reliability test 1], ++[/* The following provokes a segfault in the compiler on powerpc-apple-darwin. ++ Extracted from tests/mpn/t-iord_u.c. Causes Apple's gcc 3.3 build 1640 and ++ 1666 to segfault with e.g., -O2 -mpowerpc64. */ ++ ++#if defined (__GNUC__) && ! defined (__cplusplus) ++typedef unsigned long long t1;typedef t1*t2; ++static __inline__ t1 e(t2 rp,t2 up,int n,t1 v0) ++{t1 c,x,r;int i;if(v0){c=1;for(i=1;i> tnc; ++ high_limb = low_limb << cnt; ++ for (i = n - 1; i != 0; i--) ++ { ++ low_limb = *up++; ++ *rp++ = ~(high_limb | (low_limb >> tnc)); ++ high_limb = low_limb << cnt; ++ } ++ return retval; ++} ++int ++main () ++{ ++ unsigned long cy, rp[2], up[2]; ++ up[0] = ~ 0L; ++ up[1] = 0; ++ cy = lshift_com (rp, up, 2L, 1); ++ if (cy != 1L) ++ return 1; ++ return 0; ++} ++#else ++int ++main () ++{ ++ return 0; ++} ++#endif ++]) ++ ++GMP_PROG_CC_WORKS_PART_MAIN([$1], [mpn_lshift_com optimization 2], ++[/* The following is mis-compiled by Intel ia-64 icc version 1.8 under ++ "icc -O3", After several calls, the function writes parial garbage to ++ the result vector. Perhaps relates to the chk.a.nc insn. This code needs ++ to be run to show the problem, but that's fine, the offending cc is a ++ native-only compiler so we don't have to worry about cross compiling. */ ++ ++#if ! defined (__cplusplus) ++#include ++void ++lshift_com (rp, up, n, cnt) ++ unsigned long *rp; ++ unsigned long *up; ++ long n; ++ unsigned cnt; ++{ ++ unsigned long high_limb, low_limb; ++ unsigned tnc; ++ long i; ++ up += n; ++ rp += n; ++ tnc = 8 * sizeof (unsigned long) - cnt; ++ low_limb = *--up; ++ high_limb = low_limb << cnt; ++ for (i = n - 1; i != 0; i--) ++ { ++ low_limb = *--up; ++ *--rp = ~(high_limb | (low_limb >> tnc)); ++ high_limb = low_limb << cnt; ++ } ++ *--rp = ~high_limb; ++} ++int ++main () ++{ ++ unsigned long *r, *r2; ++ unsigned long a[88 + 1]; ++ long i; ++ for (i = 0; i < 88 + 1; i++) ++ a[i] = ~0L; ++ r = malloc (10000 * sizeof (unsigned long)); ++ r2 = r; ++ for (i = 0; i < 528; i += 22) ++ { ++ lshift_com (r2, a, ++ i / (8 * sizeof (unsigned long)) + 1, ++ i % (8 * sizeof (unsigned long))); ++ r2 += 88 + 1; ++ } ++ if (r[2048] != 0 || r[2049] != 0 || r[2050] != 0 || r[2051] != 0 || ++ r[2052] != 0 || r[2053] != 0 || r[2054] != 0) ++ abort (); ++ return 0; ++} ++#else ++int ++main () ++{ ++ return 0; ++} ++#endif ++]) ++ ++ ++# A certain _GLOBAL_OFFSET_TABLE_ problem in past versions of gas, tickled ++# by recent versions of gcc. ++# ++if test "$gmp_prog_cc_works" = yes; then ++ case $host in ++ X86_PATTERN) ++ # this problem only arises in PIC code, so don't need to test when ++ # --disable-shared. We don't necessarily have $enable_shared set to ++ # yes at this point, it will still be unset for the default (which is ++ # yes); hence the use of "!= no". ++ if test "$enable_shared" != no; then ++ GMP_PROG_CC_X86_GOT_EAX_EMITTED([$1], ++ [GMP_ASM_X86_GOT_EAX_OK([$1],, ++ [gmp_prog_cc_works="no, bad gas GOT with eax"])]) ++ fi ++ ;; ++ esac ++fi ++ ++AC_MSG_RESULT($gmp_prog_cc_works) ++case $gmp_prog_cc_works in ++ yes) ++ [$2] ++ ;; ++ *) ++ [$3] ++ ;; ++esac ++]) ++ ++dnl Called: GMP_PROG_CC_WORKS_PART(CC+CFLAGS,FAIL-MESSAGE [,CODE]) ++dnl A dummy main() is appended to the CODE given. ++dnl ++AC_DEFUN([GMP_PROG_CC_WORKS_PART], ++[GMP_PROG_CC_WORKS_PART_MAIN([$1],[$2], ++[$3] ++[int main () { return 0; }]) ++]) ++ ++dnl Called: GMP_PROG_CC_WORKS_PART_MAIN(CC+CFLAGS,FAIL-MESSAGE,CODE) ++dnl CODE must include a main(). ++dnl ++AC_DEFUN([GMP_PROG_CC_WORKS_PART_MAIN], ++[GMP_PROG_CC_WORKS_PART_TEST([$1],[$2],[$3], ++ [], ++ gmp_prog_cc_works="no[]m4_if([$2],,,[[, ]])[$2]", ++ gmp_prog_cc_works="no[]m4_if([$2],,,[[, ]])[$2][[, program does not run]]") ++]) ++ ++dnl Called: GMP_PROG_CC_WORKS_PART_TEST(CC+CFLAGS,TITLE,[CODE], ++dnl [ACTION-GOOD],[ACTION-BAD][ACTION-NORUN]) ++dnl ++AC_DEFUN([GMP_PROG_CC_WORKS_PART_TEST], ++[if test "$gmp_prog_cc_works" = yes; then ++ # remove anything that might look like compiler output to our "||" expression ++ rm -f conftest* a.out b.out a.exe a_out.exe ++ cat >conftest.c <&AC_FD_CC ++ gmp_compile="$1 conftest.c >&AC_FD_CC" ++ if AC_TRY_EVAL(gmp_compile); then ++ cc_works_part=yes ++ if test "$cross_compiling" = no; then ++ if AC_TRY_COMMAND([./a.out || ./b.out || ./a.exe || ./a_out.exe || ./conftest]); then :; ++ else ++ cc_works_part=norun ++ fi ++ fi ++ else ++ cc_works_part=no ++ fi ++ if test "$cc_works_part" != yes; then ++ echo "failed program was:" >&AC_FD_CC ++ cat conftest.c >&AC_FD_CC ++ fi ++ rm -f conftest* a.out b.out a.exe a_out.exe ++ case $cc_works_part in ++ yes) ++ $4 ++ ;; ++ no) ++ $5 ++ ;; ++ norun) ++ $6 ++ ;; ++ esac ++fi ++]) ++ ++ ++dnl GMP_PROG_CC_WORKS_LONGLONG(cc+cflags,[ACTION-YES][,ACTION-NO]) ++dnl -------------------------------------------------------------- ++dnl Check that cc+cflags accepts "long long". ++dnl ++dnl This test is designed to be run repeatedly with different cc+cflags ++dnl selections, so the result is not cached. ++ ++AC_DEFUN([GMP_PROG_CC_WORKS_LONGLONG], ++[AC_MSG_CHECKING([compiler $1 has long long]) ++cat >conftest.c <&AC_FD_CC ++ cat conftest.c >&AC_FD_CC ++fi ++rm -f conftest* a.out b.out a.exe a_out.exe ++AC_MSG_RESULT($gmp_prog_cc_works) ++if test $gmp_prog_cc_works = yes; then ++ ifelse([$2],,:,[$2]) ++else ++ ifelse([$3],,:,[$3]) ++fi ++]) ++ ++ ++dnl GMP_C_TEST_SIZEOF(cc/cflags,test,[ACTION-GOOD][,ACTION-BAD]) ++dnl ------------------------------------------------------------ ++dnl The given cc/cflags compiler is run to check the size of a type ++dnl specified by the "test" argument. "test" can either be a string, or a ++dnl variable like $foo. The value should be for instance "sizeof-long-4", ++dnl to test that sizeof(long)==4. ++dnl ++dnl This test is designed to be run for different compiler and/or flags ++dnl combinations, so the result is not cached. ++dnl ++dnl The idea for making an array that has a negative size if the desired ++dnl condition test is false comes from autoconf AC_CHECK_SIZEOF. The cast ++dnl to "long" in the array dimension also follows autoconf, apparently it's ++dnl a workaround for a HP compiler bug. ++ ++AC_DEFUN([GMP_C_TEST_SIZEOF], ++[echo "configure: testlist $2" >&AC_FD_CC ++[gmp_sizeof_type=`echo "$2" | sed 's/sizeof-\([a-z]*\).*/\1/'`] ++[gmp_sizeof_want=`echo "$2" | sed 's/sizeof-[a-z]*-\([0-9]*\).*/\1/'`] ++AC_MSG_CHECKING([compiler $1 has sizeof($gmp_sizeof_type)==$gmp_sizeof_want]) ++cat >conftest.c <conftest.c <    		" outfile) ++ (if (char= c #\{) ++ (if *verbatim* ++ (princ #\{ outfile) ++ (pushenv nil)) ++ (if (char= c #\}) ++ (if *verbatim* ++ (princ #\} outfile) ++ (popenv outfile)) ++ (if (and (char= c #\$) (not *verbatim*)) ++ (if (eq (car *modestack*) '$) ++ (popenv outfile) ++ (pushfont '$ outfile)) ++ (if (and (or (char= c #\^) (char= c #\_)) ++ (eq (car *modestack*) '$)) ++ (progn ++ (pushfont (if (char= c #\^) 'sup 'sub) outfile) ++ (searchfor #\{)) ++ (princ (if (char= c #\>) "> " ++ (if (char= c #\<) "< " ++ c)) ++ outfile))))))))) )) ++ ++; 24 Jul 02; 25 Jul 02; 29 Jul 02; 12 Feb 03; 28 Aug 03 ++(defun docommand (outfile) ++ (let (wordstring word subword termch done tmp c pair (saveptr (1- *ptr*))) ++ (setq wordstring (car (parse-word nil))) ++ (setq word (intern (string-upcase wordstring))) ++ (case word ++ ((documentstyle pagestyle setlength hyphenpenalty sloppy ++ large) ++ (flushline)) ++ (setcounter (searchfor #\{) ++ (setq subword (intern (car (parse-word t)))) ++ (when (eq subword 'page) ++ (searchfor #\{) ++ (setq *pagenumber* (1- (parse-int))) ; assumes pagebreak ++ (flushline)) ) ++ (addtocounter (searchfor #\{) ++ (setq subword (intern (car (parse-word t)))) ++ (when (eq subword 'page) ++ (searchfor #\{) ++ (setq *pagenumber* (+ *pagenumber* (parse-int))) ++ (flushline)) ) ++ (includegraphics (searchfor #\{) (searchforalpha) ++ (setq done nil) ++ (while (not done) ++ (setq tmp (parse-word nil)) ++ (if (char= (cadr tmp) #\}) ++ (setq done t) ++ (if (char= (cadr tmp) #\.) ++ (progn (setq done t) ++ (princ "" outfile) ++ (terpri outfile) ++ (flushline) ) ++ (incf *ptr*))))) ++ (begin (searchfor #\{) ++ (setq subword (intern (car (parse-word t)))) ++ (searchfor #\}) ++ ; (format t "subword = ~s~%" subword) ++ (case subword ++ (document (setq *ignore* nil)) ++ (center (pushenv 'center)) ++ (itemize (princ "
      " outfile) (terpri outfile)) ++ (enumerate (princ "
        " outfile) (terpri outfile)) ++ (verbatim (princ "
        " outfile) (terpri outfile)
++		    (setq *verbatim* t))
++	  (tabular (dotabular outfile))
++	  ((quotation abstract quote)
++	    (princ "
        " outfile) (terpri outfile))
++	  ))
++      (end (searchfor #\{)
++	(setq subword (intern (car (parse-word t))))
++	(searchfor #\})
++	(case subword
++	  (document (setq *feof* t))
++	  (center (popenv outfile))
++	  (itemize (princ "
    " outfile) (terpri outfile)) ++ (enumerate (princ "" outfile) (terpri outfile)) ++ (verbatim (princ "" outfile) (terpri outfile) ++ (setq *verbatim* nil)) ++ (tabular (princ "
    " outfile) (terpri outfile) ++ (popenv outfile)) ++ ((quotation abstract quote) ++ (princ "" outfile) (terpri outfile)) ++ )) ++ (item (princ "

  • " outfile)) ++ (pagebreak (setq *done* t) (incf *pagenumber*)) ++ ((bf tt em it) (pushfont word outfile)) ++ ((title section subsection subsubsection paragraph) ++ (searchfor #\{) ++ (pushfont (cadr (assoc word '((title h1) (section h2) ++ (subsection h3) (subsubsection h4) ++ (paragraph b)))) ++ outfile)) ++ ((vspace vspace*) (searchfor #\}) ++ (princ "

    " outfile) (terpri outfile)) ++ ((hspace hspace*) (searchfor #\}) ++ (dotimes (i 8) (princ " " outfile))) ++ ((index) (searchfor #\})) ; ignore and consume ++ (verb (setq termch (char *line* *ptr*)) ++ (incf *ptr*) ++ (pushfont 'tt outfile) ++ (xferchars outfile termch) ++ (popenv outfile) ) ++ ((cite bibitem) (searchfor #\{) ++ (princ "[" outfile) ++ (xferchars outfile #\}) ++ (princ "]" outfile) ) ++ (footnote (searchfor #\{) ++ (princ "[" outfile) ++ (pushenv 'footnote)) ++ (t (if *verbatim* ++ (while (< saveptr *ptr*) ++ (princ (char *line* saveptr) outfile) ++ (incf saveptr)) ++ (if (setq pair (assoc wordstring *specials* :test #'string=)) ++ (princ (cadr pair) outfile)) ) ) ) )) ++ ++; push a new item on the mode stack ++(defun pushenv (item) ++ (if (and *modestack* (eq (car *modestack*) nil)) ++ (setf (car *modestack*) item) ++ (push item *modestack*))) ++ ++; 24 Jul 02; 25 Jul 02 ++(defun popenv (outfile) ++ (let ((item (pop *modestack*)) new) ++ (setq new (cadr (assoc item '((em i) (bf b) (it i) ($ i))))) ++ (case item ++ ((bf tt it em $ h1 h2 h3 h4 sub sup) ++ (princ "" outfile)) ++ (footnote (princ "]" outfile)) ++ ) ++ item)) ++ ++(defun pushfont (word outfile) ++ (let ((new (cadr (assoc word '((em i) (bf b) (it i) ($ i)))))) ++ (pushenv word) ++ (princ "<" outfile) (princ (or new word) outfile) ++ (princ ">" outfile) )) ++ ++; transfer chars to output until termch ++(defun xferchars (outfile termch) ++ (let (done) ++ (while (and (< *ptr* *lng*) (not done)) ++ (setq c (char *line* *ptr*)) ++ (incf *ptr*) ++ (if (char= c termch) ++ (setq done t) ++ (princ c outfile)) ) )) ++ ++(defun dotabular (outfile) ++ (let ((ncols 0) done) ++ (searchfor #\{) ++ (while (and (< *ptr* *lng*) (not done)) ++ (setq c (char *line* *ptr*)) ++ (incf *ptr*) ++ (if (char= c #\}) ++ (setq done t) ++ (if (or (char= c #\l) (char= c #\r) (char= c #\c)) ++ (incf ncols))) ) ++ (princ "" outfile) ++ (terpri outfile) ++ (princ "" outfile) ++ (terpri outfile) ++ (princ "
    " outfile) ++ (pushenv 'table) ++ )) ++ ++(defun termline (outfile) ++ (if (eq (car *modestack*) 'table) ++ (progn (princ "
    " outfile)) ++ (progn (princ "
    " outfile) (terpri outfile) ))) ++ ++(defun safe-char () ++ (if (< *ptr* *lng*) ++ (char *line* *ptr*) ++ #\Space)) ++ ++; Parse a word of alpha/num characters ++; Returns ("word" ch) where ch is the terminating character ++(defun parse-word (upper) ++ (let (c res) ++ (while (and (< *ptr* *lng*) ++ (or (alpha-char-p (setq c (char *line* *ptr*))) ++ (and res (digit-char-p c)) ++ (char= c #\*))) ++ (push (if upper (char-upcase c) c) res) ++ (incf *ptr*)) ++ (if res (list (coerce (nreverse res) 'string) ++ (and (not (alpha-char-p c)) c))) )) ++ ++(defun searchfor (ch) ++ (let (c) ++ (while (and (< *ptr* *lng*) ++ (setq c (char *line* *ptr*)) ++ (not (char= ch c))) ++ (incf *ptr*)) ++ (if (and c (char= ch c)) (incf *ptr*)) ++ c)) ++ ++(defun searchforalpha () ++ (while (and (< *ptr* *lng*) ++ (not (alpha-char-p (char *line* *ptr*)))) ++ (incf *ptr*))) ++ ++(defun flushline () (setq *lng* 0)) ++ ++(defun stringify (x) ++ (cond ((stringp x) x) ++ ((symbolp x) (symbol-name x)) ++ (t (princ-to-string x)))) ++ ++; Parse an integer ++(defun parse-int () ++ (let (c (n 0) digit found) ++ (while (and (< *ptr* *lng*) ++ (setq digit (digit-char-p ++ (setq c (char *line* *ptr*))))) ++ (setq found (or found digit)) ++ (setq n (+ (* n 10) digit)) ++ (incf *ptr*)) ++ (if found n) )) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_keysymdef.lsp +@@ -0,0 +1,1151 @@ ++(in-package :XLIB) ++; keysymdef.lsp modified by Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++;; $XConsortium: keysymdef.h,v 1.13 89/12/12 16:23:30 rws Exp $ ++ ++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ++ ++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ++ ++(defconstant XK_VoidSymbol #xFFFFFF ;; void symbol ++ ++;;#ifdef XK_MISCELLANY ++;; ++ ; TTY Functions, cleverly chosen to map to ascii, for convenience of ++ ; programming, but could have been arbitrary at the cost of lookup ++ ; tables in client code. ++ ++ ++)(defconstant XK_BackSpace #xFF08 ;; back space, back char ++)(defconstant XK_Tab #xFF09 ++)(defconstant XK_Linefeed #xFF0A ;; Linefeed, LF ++)(defconstant XK_Clear #xFF0B ++)(defconstant XK_Return #xFF0D ;; Return, enter ++)(defconstant XK_Pause #xFF13 ;; Pause, hold ++)(defconstant XK_Scroll_Lock #xFF14 ++)(defconstant XK_Escape #xFF1B ++)(defconstant XK_Delete #xFFFF ;; Delete, rubout ++ ++ ++ ++;; International & multi-key character composition ++ ++)(defconstant XK_Multi_key #xFF20 ;; Multi-key character compose ++ ++;; Japanese keyboard support ++ ++)(defconstant XK_Kanji #xFF21 ;; Kanji, Kanji convert ++)(defconstant XK_Muhenkan #xFF22 ;; Cancel Conversion ++)(defconstant XK_Henkan_Mode #xFF23 ;; Start/Stop Conversion ++)(defconstant XK_Henkan #xFF23 ;; Alias for Henkan_Mode ++)(defconstant XK_Romaji #xFF24 ;; to Romaji ++)(defconstant XK_Hiragana #xFF25 ;; to Hiragana ++)(defconstant XK_Katakana #xFF26 ;; to Katakana ++)(defconstant XK_Hiragana_Katakana #xFF27 ;; Hiragana/Katakana toggle ++)(defconstant XK_Zenkaku #xFF28 ;; to Zenkaku ++)(defconstant XK_Hankaku #xFF29 ;; to Hankaku ++)(defconstant XK_Zenkaku_Hankaku #xFF2A ;; Zenkaku/Hankaku toggle ++)(defconstant XK_Touroku #xFF2B ;; Add to Dictionary ++)(defconstant XK_Massyo #xFF2C ;; Delete from Dictionary ++)(defconstant XK_Kana_Lock #xFF2D ;; Kana Lock ++)(defconstant XK_Kana_Shift #xFF2E ;; Kana Shift ++)(defconstant XK_Eisu_Shift #xFF2F ;; Alphanumeric Shift ++)(defconstant XK_Eisu_toggle #xFF30 ;; Alphanumeric toggle ++ ++;; Cursor control & motion ++ ++)(defconstant XK_Home #xFF50 ++)(defconstant XK_Left #xFF51 ;; Move left, left arrow ++)(defconstant XK_Up #xFF52 ;; Move up, up arrow ++)(defconstant XK_Right #xFF53 ;; Move right, right arrow ++)(defconstant XK_Down #xFF54 ;; Move down, down arrow ++)(defconstant XK_Prior #xFF55 ;; Prior, previous ++)(defconstant XK_Next #xFF56 ;; Next ++)(defconstant XK_End #xFF57 ;; EOL ++)(defconstant XK_Begin #xFF58 ;; BOL ++ ++ ++;; Misc Functions ++ ++)(defconstant XK_Select #xFF60 ;; Select, mark ++)(defconstant XK_Print #xFF61 ++)(defconstant XK_Execute #xFF62 ;; Execute, run, do ++)(defconstant XK_Insert #xFF63 ;; Insert, insert here ++)(defconstant XK_Undo #xFF65 ;; Undo, oops ++)(defconstant XK_Redo #xFF66 ;; redo, again ++)(defconstant XK_Menu #xFF67 ++)(defconstant XK_Find #xFF68 ;; Find, search ++)(defconstant XK_Cancel #xFF69 ;; Cancel, stop, abort, exit ++)(defconstant XK_Help #xFF6A ;; Help, ? ++)(defconstant XK_Break #xFF6B ++)(defconstant XK_Mode_switch #xFF7E ;; Character set switch ++)(defconstant XK_script_switch #xFF7E ;; Alias for mode_switch ++)(defconstant XK_Num_Lock #xFF7F ++ ++;; Keypad Functions, keypad numbers cleverly chosen to map to ascii ++ ++)(defconstant XK_KP_Space #xFF80 ;; space ++)(defconstant XK_KP_Tab #xFF89 ++)(defconstant XK_KP_Enter #xFF8D ;; enter ++)(defconstant XK_KP_F1 #xFF91 ;; PF1, KP_A, ... ++)(defconstant XK_KP_F2 #xFF92 ++)(defconstant XK_KP_F3 #xFF93 ++)(defconstant XK_KP_F4 #xFF94 ++)(defconstant XK_KP_Equal #xFFBD ;; equals ++)(defconstant XK_KP_Multiply #xFFAA ++)(defconstant XK_KP_Add #xFFAB ++)(defconstant XK_KP_Separator #xFFAC ;; separator, often comma ++)(defconstant XK_KP_Subtract #xFFAD ++)(defconstant XK_KP_Decimal #xFFAE ++)(defconstant XK_KP_Divide #xFFAF ++)(defconstant XK_KP_0 #xFFB0 ++)(defconstant XK_KP_1 #xFFB1 ++)(defconstant XK_KP_2 #xFFB2 ++)(defconstant XK_KP_3 #xFFB3 ++)(defconstant XK_KP_4 #xFFB4 ++)(defconstant XK_KP_5 #xFFB5 ++)(defconstant XK_KP_6 #xFFB6 ++)(defconstant XK_KP_7 #xFFB7 ++)(defconstant XK_KP_8 #xFFB8 ++)(defconstant XK_KP_9 #xFFB9 ++ ++ ++ ++;; ++ ; Auxilliary Functions; note the duplicate definitions for left and right ++ ; function keys; Sun keyboards and a few other manufactures have such ++ ; function key groups on the left and/or right sides of the keyboard. ++ ; We've not found a keyboard with more than 35 function keys total. ++ ++ ++)(defconstant XK_F1 #xFFBE ++)(defconstant XK_F2 #xFFBF ++)(defconstant XK_F3 #xFFC0 ++)(defconstant XK_F4 #xFFC1 ++)(defconstant XK_F5 #xFFC2 ++)(defconstant XK_F6 #xFFC3 ++)(defconstant XK_F7 #xFFC4 ++)(defconstant XK_F8 #xFFC5 ++)(defconstant XK_F9 #xFFC6 ++)(defconstant XK_F10 #xFFC7 ++)(defconstant XK_F11 #xFFC8 ++)(defconstant XK_L1 #xFFC8 ++)(defconstant XK_F12 #xFFC9 ++)(defconstant XK_L2 #xFFC9 ++)(defconstant XK_F13 #xFFCA ++)(defconstant XK_L3 #xFFCA ++)(defconstant XK_F14 #xFFCB ++)(defconstant XK_L4 #xFFCB ++)(defconstant XK_F15 #xFFCC ++)(defconstant XK_L5 #xFFCC ++)(defconstant XK_F16 #xFFCD ++)(defconstant XK_L6 #xFFCD ++)(defconstant XK_F17 #xFFCE ++)(defconstant XK_L7 #xFFCE ++)(defconstant XK_F18 #xFFCF ++)(defconstant XK_L8 #xFFCF ++)(defconstant XK_F19 #xFFD0 ++)(defconstant XK_L9 #xFFD0 ++)(defconstant XK_F20 #xFFD1 ++)(defconstant XK_L10 #xFFD1 ++)(defconstant XK_F21 #xFFD2 ++)(defconstant XK_R1 #xFFD2 ++)(defconstant XK_F22 #xFFD3 ++)(defconstant XK_R2 #xFFD3 ++)(defconstant XK_F23 #xFFD4 ++)(defconstant XK_R3 #xFFD4 ++)(defconstant XK_F24 #xFFD5 ++)(defconstant XK_R4 #xFFD5 ++)(defconstant XK_F25 #xFFD6 ++)(defconstant XK_R5 #xFFD6 ++)(defconstant XK_F26 #xFFD7 ++)(defconstant XK_R6 #xFFD7 ++)(defconstant XK_F27 #xFFD8 ++)(defconstant XK_R7 #xFFD8 ++)(defconstant XK_F28 #xFFD9 ++)(defconstant XK_R8 #xFFD9 ++)(defconstant XK_F29 #xFFDA ++)(defconstant XK_R9 #xFFDA ++)(defconstant XK_F30 #xFFDB ++)(defconstant XK_R10 #xFFDB ++)(defconstant XK_F31 #xFFDC ++)(defconstant XK_R11 #xFFDC ++)(defconstant XK_F32 #xFFDD ++)(defconstant XK_R12 #xFFDD ++)(defconstant XK_R13 #xFFDE ++)(defconstant XK_F33 #xFFDE ++)(defconstant XK_F34 #xFFDF ++)(defconstant XK_R14 #xFFDF ++)(defconstant XK_F35 #xFFE0 ++)(defconstant XK_R15 #xFFE0 ++ ++;; Modifiers ++ ++)(defconstant XK_Shift_L #xFFE1 ;; Left shift ++)(defconstant XK_Shift_R #xFFE2 ;; Right shift ++)(defconstant XK_Control_L #xFFE3 ;; Left control ++)(defconstant XK_Control_R #xFFE4 ;; Right control ++)(defconstant XK_Caps_Lock #xFFE5 ;; Caps lock ++)(defconstant XK_Shift_Lock #xFFE6 ;; Shift lock ++ ++)(defconstant XK_Meta_L #xFFE7 ;; Left meta ++)(defconstant XK_Meta_R #xFFE8 ;; Right meta ++)(defconstant XK_Alt_L #xFFE9 ;; Left alt ++)(defconstant XK_Alt_R #xFFEA ;; Right alt ++)(defconstant XK_Super_L #xFFEB ;; Left super ++)(defconstant XK_Super_R #xFFEC ;; Right super ++)(defconstant XK_Hyper_L #xFFED ;; Left hyper ++)(defconstant XK_Hyper_R #xFFEE ;; Right hyper ++;;#endif ;; XK_MISCELLANY ++ ++;; ++ ; Latin 1 ++ ; Byte 3 = 0 ++ ++;;ifdef XK_LATIN1 ++)(defconstant XK_space #x020 ++)(defconstant XK_exclam #x021 ++)(defconstant XK_quotedbl #x022 ++)(defconstant XK_numbersign #x023 ++)(defconstant XK_dollar #x024 ++)(defconstant XK_percent #x025 ++)(defconstant XK_ampersand #x026 ++)(defconstant XK_apostrophe #x027 ++)(defconstant XK_quoteright #x027 ;; deprecated ++)(defconstant XK_parenleft #x028 ++)(defconstant XK_parenright #x029 ++)(defconstant XK_asterisk #x02a ++)(defconstant XK_plus #x02b ++)(defconstant XK_comma #x02c ++)(defconstant XK_minus #x02d ++)(defconstant XK_period #x02e ++)(defconstant XK_slash #x02f ++)(defconstant XK_0 #x030 ++)(defconstant XK_1 #x031 ++)(defconstant XK_2 #x032 ++)(defconstant XK_3 #x033 ++)(defconstant XK_4 #x034 ++)(defconstant XK_5 #x035 ++)(defconstant XK_6 #x036 ++)(defconstant XK_7 #x037 ++)(defconstant XK_8 #x038 ++)(defconstant XK_9 #x039 ++)(defconstant XK_colon #x03a ++)(defconstant XK_semicolon #x03b ++)(defconstant XK_less #x03c ++)(defconstant XK_equal #x03d ++)(defconstant XK_greater #x03e ++)(defconstant XK_question #x03f ++)(defconstant XK_at #x040 ++)(defconstant XK_A #x041 ++)(defconstant XK_B #x042 ++)(defconstant XK_C #x043 ++)(defconstant XK_D #x044 ++)(defconstant XK_E #x045 ++)(defconstant XK_F #x046 ++)(defconstant XK_G #x047 ++)(defconstant XK_H #x048 ++)(defconstant XK_I #x049 ++)(defconstant XK_J #x04a ++)(defconstant XK_K #x04b ++)(defconstant XK_L #x04c ++)(defconstant XK_M #x04d ++)(defconstant XK_N #x04e ++)(defconstant XK_O #x04f ++)(defconstant XK_P #x050 ++)(defconstant XK_Q #x051 ++)(defconstant XK_R #x052 ++)(defconstant XK_S #x053 ++)(defconstant XK_T #x054 ++)(defconstant XK_U #x055 ++)(defconstant XK_V #x056 ++)(defconstant XK_W #x057 ++)(defconstant XK_X #x058 ++)(defconstant XK_Y #x059 ++)(defconstant XK_Z #x05a ++)(defconstant XK_bracketleft #x05b ++)(defconstant XK_backslash #x05c ++)(defconstant XK_bracketright #x05d ++)(defconstant XK_asciicircum #x05e ++)(defconstant XK_underscore #x05f ++)(defconstant XK_grave #x060 ++)(defconstant XK_quoteleft #x060 ;; deprecated ++)(defconstant XK_a #x061 ++)(defconstant XK_b #x062 ++)(defconstant XK_c #x063 ++)(defconstant XK_d #x064 ++)(defconstant XK_e #x065 ++)(defconstant XK_f #x066 ++)(defconstant XK_g #x067 ++)(defconstant XK_h #x068 ++)(defconstant XK_i #x069 ++)(defconstant XK_j #x06a ++)(defconstant XK_k #x06b ++)(defconstant XK_l #x06c ++)(defconstant XK_m #x06d ++)(defconstant XK_n #x06e ++)(defconstant XK_o #x06f ++)(defconstant XK_p #x070 ++)(defconstant XK_q #x071 ++)(defconstant XK_r #x072 ++)(defconstant XK_s #x073 ++)(defconstant XK_t #x074 ++)(defconstant XK_u #x075 ++)(defconstant XK_v #x076 ++)(defconstant XK_w #x077 ++)(defconstant XK_x #x078 ++)(defconstant XK_y #x079 ++)(defconstant XK_z #x07a ++)(defconstant XK_braceleft #x07b ++)(defconstant XK_bar #x07c ++)(defconstant XK_braceright #x07d ++)(defconstant XK_asciitilde #x07e ++ ++)(defconstant XK_nobreakspace #x0a0 ++)(defconstant XK_exclamdown #x0a1 ++)(defconstant XK_cent #x0a2 ++)(defconstant XK_sterling #x0a3 ++)(defconstant XK_currency #x0a4 ++)(defconstant XK_yen #x0a5 ++)(defconstant XK_brokenbar #x0a6 ++)(defconstant XK_section #x0a7 ++)(defconstant XK_diaeresis #x0a8 ++)(defconstant XK_copyright #x0a9 ++)(defconstant XK_ordfeminine #x0aa ++)(defconstant XK_guillemotleft #x0ab ;; left angle quotation mark ++)(defconstant XK_notsign #x0ac ++)(defconstant XK_hyphen #x0ad ++)(defconstant XK_registered #x0ae ++)(defconstant XK_macron #x0af ++)(defconstant XK_degree #x0b0 ++)(defconstant XK_plusminus #x0b1 ++)(defconstant XK_twosuperior #x0b2 ++)(defconstant XK_threesuperior #x0b3 ++)(defconstant XK_acute #x0b4 ++)(defconstant XK_mu #x0b5 ++)(defconstant XK_paragraph #x0b6 ++)(defconstant XK_periodcentered #x0b7 ++)(defconstant XK_cedilla #x0b8 ++)(defconstant XK_onesuperior #x0b9 ++)(defconstant XK_masculine #x0ba ++)(defconstant XK_guillemotright #x0bb ;; right angle quotation mark ++)(defconstant XK_onequarter #x0bc ++)(defconstant XK_onehalf #x0bd ++)(defconstant XK_threequarters #x0be ++)(defconstant XK_questiondown #x0bf ++)(defconstant XK_Agrave #x0c0 ++)(defconstant XK_Aacute #x0c1 ++)(defconstant XK_Acircumflex #x0c2 ++)(defconstant XK_Atilde #x0c3 ++)(defconstant XK_Adiaeresis #x0c4 ++)(defconstant XK_Aring #x0c5 ++)(defconstant XK_AE #x0c6 ++)(defconstant XK_Ccedilla #x0c7 ++)(defconstant XK_Egrave #x0c8 ++)(defconstant XK_Eacute #x0c9 ++)(defconstant XK_Ecircumflex #x0ca ++)(defconstant XK_Ediaeresis #x0cb ++)(defconstant XK_Igrave #x0cc ++)(defconstant XK_Iacute #x0cd ++)(defconstant XK_Icircumflex #x0ce ++)(defconstant XK_Idiaeresis #x0cf ++)(defconstant XK_ETH #x0d0 ++)(defconstant XK_Eth #x0d0 ;; deprecated ++)(defconstant XK_Ntilde #x0d1 ++)(defconstant XK_Ograve #x0d2 ++)(defconstant XK_Oacute #x0d3 ++)(defconstant XK_Ocircumflex #x0d4 ++)(defconstant XK_Otilde #x0d5 ++)(defconstant XK_Odiaeresis #x0d6 ++)(defconstant XK_multiply #x0d7 ++)(defconstant XK_Ooblique #x0d8 ++)(defconstant XK_Ugrave #x0d9 ++)(defconstant XK_Uacute #x0da ++)(defconstant XK_Ucircumflex #x0db ++)(defconstant XK_Udiaeresis #x0dc ++)(defconstant XK_Yacute #x0dd ++)(defconstant XK_THORN #x0de ++)(defconstant XK_Thorn #x0de ;; deprecated ++)(defconstant XK_ssharp #x0df ++)(defconstant XK_agrave #x0e0 ++)(defconstant XK_aacute #x0e1 ++)(defconstant XK_acircumflex #x0e2 ++)(defconstant XK_atilde #x0e3 ++)(defconstant XK_adiaeresis #x0e4 ++)(defconstant XK_aring #x0e5 ++)(defconstant XK_ae #x0e6 ++)(defconstant XK_ccedilla #x0e7 ++)(defconstant XK_egrave #x0e8 ++)(defconstant XK_eacute #x0e9 ++)(defconstant XK_ecircumflex #x0ea ++)(defconstant XK_ediaeresis #x0eb ++)(defconstant XK_igrave #x0ec ++)(defconstant XK_iacute #x0ed ++)(defconstant XK_icircumflex #x0ee ++)(defconstant XK_idiaeresis #x0ef ++)(defconstant XK_eth #x0f0 ++)(defconstant XK_ntilde #x0f1 ++)(defconstant XK_ograve #x0f2 ++)(defconstant XK_oacute #x0f3 ++)(defconstant XK_ocircumflex #x0f4 ++)(defconstant XK_otilde #x0f5 ++)(defconstant XK_odiaeresis #x0f6 ++)(defconstant XK_division #x0f7 ++)(defconstant XK_oslash #x0f8 ++)(defconstant XK_ugrave #x0f9 ++)(defconstant XK_uacute #x0fa ++)(defconstant XK_ucircumflex #x0fb ++)(defconstant XK_udiaeresis #x0fc ++)(defconstant XK_yacute #x0fd ++)(defconstant XK_thorn #x0fe ++)(defconstant XK_ydiaeresis #x0ff ++;;endif ;; XK_LATIN1 ++ ++;; ++ ; Latin 2 ++ ; Byte 3 = 1 ++ ++ ++;;ifdef XK_LATIN2 ++)(defconstant XK_Aogonek #x1a1 ++)(defconstant XK_breve #x1a2 ++)(defconstant XK_Lstroke #x1a3 ++)(defconstant XK_Lcaron #x1a5 ++)(defconstant XK_Sacute #x1a6 ++)(defconstant XK_Scaron #x1a9 ++)(defconstant XK_Scedilla #x1aa ++)(defconstant XK_Tcaron #x1ab ++)(defconstant XK_Zacute #x1ac ++)(defconstant XK_Zcaron #x1ae ++)(defconstant XK_Zabovedot #x1af ++)(defconstant XK_aogonek #x1b1 ++)(defconstant XK_ogonek #x1b2 ++)(defconstant XK_lstroke #x1b3 ++)(defconstant XK_lcaron #x1b5 ++)(defconstant XK_sacute #x1b6 ++)(defconstant XK_caron #x1b7 ++)(defconstant XK_scaron #x1b9 ++)(defconstant XK_scedilla #x1ba ++)(defconstant XK_tcaron #x1bb ++)(defconstant XK_zacute #x1bc ++)(defconstant XK_doubleacute #x1bd ++)(defconstant XK_zcaron #x1be ++)(defconstant XK_zabovedot #x1bf ++)(defconstant XK_Racute #x1c0 ++)(defconstant XK_Abreve #x1c3 ++)(defconstant XK_Lacute #x1c5 ++)(defconstant XK_Cacute #x1c6 ++)(defconstant XK_Ccaron #x1c8 ++)(defconstant XK_Eogonek #x1ca ++)(defconstant XK_Ecaron #x1cc ++)(defconstant XK_Dcaron #x1cf ++)(defconstant XK_Dstroke #x1d0 ++)(defconstant XK_Nacute #x1d1 ++)(defconstant XK_Ncaron #x1d2 ++)(defconstant XK_Odoubleacute #x1d5 ++)(defconstant XK_Rcaron #x1d8 ++)(defconstant XK_Uring #x1d9 ++)(defconstant XK_Udoubleacute #x1db ++)(defconstant XK_Tcedilla #x1de ++)(defconstant XK_racute #x1e0 ++)(defconstant XK_abreve #x1e3 ++)(defconstant XK_lacute #x1e5 ++)(defconstant XK_cacute #x1e6 ++)(defconstant XK_ccaron #x1e8 ++)(defconstant XK_eogonek #x1ea ++)(defconstant XK_ecaron #x1ec ++)(defconstant XK_dcaron #x1ef ++)(defconstant XK_dstroke #x1f0 ++)(defconstant XK_nacute #x1f1 ++)(defconstant XK_ncaron #x1f2 ++)(defconstant XK_odoubleacute #x1f5 ++)(defconstant XK_udoubleacute #x1fb ++)(defconstant XK_rcaron #x1f8 ++)(defconstant XK_uring #x1f9 ++)(defconstant XK_tcedilla #x1fe ++)(defconstant XK_abovedot #x1ff ++;;endif ;; XK_LATIN2 ++ ++;; ++ ; Latin 3 ++ ; Byte 3 = 2 ++ ++ ++;;ifdef XK_LATIN3 ++)(defconstant XK_Hstroke #x2a1 ++)(defconstant XK_Hcircumflex #x2a6 ++)(defconstant XK_Iabovedot #x2a9 ++)(defconstant XK_Gbreve #x2ab ++)(defconstant XK_Jcircumflex #x2ac ++)(defconstant XK_hstroke #x2b1 ++)(defconstant XK_hcircumflex #x2b6 ++)(defconstant XK_idotless #x2b9 ++)(defconstant XK_gbreve #x2bb ++)(defconstant XK_jcircumflex #x2bc ++)(defconstant XK_Cabovedot #x2c5 ++)(defconstant XK_Ccircumflex #x2c6 ++)(defconstant XK_Gabovedot #x2d5 ++)(defconstant XK_Gcircumflex #x2d8 ++)(defconstant XK_Ubreve #x2dd ++)(defconstant XK_Scircumflex #x2de ++)(defconstant XK_cabovedot #x2e5 ++)(defconstant XK_ccircumflex #x2e6 ++)(defconstant XK_gabovedot #x2f5 ++)(defconstant XK_gcircumflex #x2f8 ++)(defconstant XK_ubreve #x2fd ++)(defconstant XK_scircumflex #x2fe ++;;endif ;; XK_LATIN3 ++ ++ ++;; ++ ; Latin 4 ++ ; Byte 3 = 3 ++ ++ ++;;ifdef XK_LATIN4 ++)(defconstant XK_kra #x3a2 ++)(defconstant XK_kappa #x3a2 ;; deprecated ++)(defconstant XK_Rcedilla #x3a3 ++)(defconstant XK_Itilde #x3a5 ++)(defconstant XK_Lcedilla #x3a6 ++)(defconstant XK_Emacron #x3aa ++)(defconstant XK_Gcedilla #x3ab ++)(defconstant XK_Tslash #x3ac ++)(defconstant XK_rcedilla #x3b3 ++)(defconstant XK_itilde #x3b5 ++)(defconstant XK_lcedilla #x3b6 ++)(defconstant XK_emacron #x3ba ++)(defconstant XK_gcedilla #x3bb ++)(defconstant XK_tslash #x3bc ++)(defconstant XK_ENG #x3bd ++)(defconstant XK_eng #x3bf ++)(defconstant XK_Amacron #x3c0 ++)(defconstant XK_Iogonek #x3c7 ++)(defconstant XK_Eabovedot #x3cc ++)(defconstant XK_Imacron #x3cf ++)(defconstant XK_Ncedilla #x3d1 ++)(defconstant XK_Omacron #x3d2 ++)(defconstant XK_Kcedilla #x3d3 ++)(defconstant XK_Uogonek #x3d9 ++)(defconstant XK_Utilde #x3dd ++)(defconstant XK_Umacron #x3de ++)(defconstant XK_amacron #x3e0 ++)(defconstant XK_iogonek #x3e7 ++)(defconstant XK_eabovedot #x3ec ++)(defconstant XK_imacron #x3ef ++)(defconstant XK_ncedilla #x3f1 ++)(defconstant XK_omacron #x3f2 ++)(defconstant XK_kcedilla #x3f3 ++)(defconstant XK_uogonek #x3f9 ++)(defconstant XK_utilde #x3fd ++)(defconstant XK_umacron #x3fe ++;;endif ;; XK_LATIN4 ++ ++;; ++ ; Katakana ++ ; Byte 3 = 4 ++ ++ ++;;ifdef XK_KATAKANA ++)(defconstant XK_overline #x47e ++)(defconstant XK_kana_fullstop #x4a1 ++)(defconstant XK_kana_openingbracket #x4a2 ++)(defconstant XK_kana_closingbracket #x4a3 ++)(defconstant XK_kana_comma #x4a4 ++)(defconstant XK_kana_conjunctive #x4a5 ++)(defconstant XK_kana_middledot #x4a5 ;; deprecated ++)(defconstant XK_kana_WO #x4a6 ++)(defconstant XK_kana_a #x4a7 ++)(defconstant XK_kana_i #x4a8 ++)(defconstant XK_kana_u #x4a9 ++)(defconstant XK_kana_e #x4aa ++)(defconstant XK_kana_o #x4ab ++)(defconstant XK_kana_ya #x4ac ++)(defconstant XK_kana_yu #x4ad ++)(defconstant XK_kana_yo #x4ae ++)(defconstant XK_kana_tsu #x4af ++)(defconstant XK_kana_tu #x4af ;; deprecated ++)(defconstant XK_prolongedsound #x4b0 ++)(defconstant XK_kana_A #x4b1 ++)(defconstant XK_kana_I #x4b2 ++)(defconstant XK_kana_U #x4b3 ++)(defconstant XK_kana_E #x4b4 ++)(defconstant XK_kana_O #x4b5 ++)(defconstant XK_kana_KA #x4b6 ++)(defconstant XK_kana_KI #x4b7 ++)(defconstant XK_kana_KU #x4b8 ++)(defconstant XK_kana_KE #x4b9 ++)(defconstant XK_kana_KO #x4ba ++)(defconstant XK_kana_SA #x4bb ++)(defconstant XK_kana_SHI #x4bc ++)(defconstant XK_kana_SU #x4bd ++)(defconstant XK_kana_SE #x4be ++)(defconstant XK_kana_SO #x4bf ++)(defconstant XK_kana_TA #x4c0 ++)(defconstant XK_kana_CHI #x4c1 ++)(defconstant XK_kana_TI #x4c1 ;; deprecated ++)(defconstant XK_kana_TSU #x4c2 ++)(defconstant XK_kana_TU #x4c2 ;; deprecated ++)(defconstant XK_kana_TE #x4c3 ++)(defconstant XK_kana_TO #x4c4 ++)(defconstant XK_kana_NA #x4c5 ++)(defconstant XK_kana_NI #x4c6 ++)(defconstant XK_kana_NU #x4c7 ++)(defconstant XK_kana_NE #x4c8 ++)(defconstant XK_kana_NO #x4c9 ++)(defconstant XK_kana_HA #x4ca ++)(defconstant XK_kana_HI #x4cb ++)(defconstant XK_kana_FU #x4cc ++)(defconstant XK_kana_HU #x4cc ;; deprecated ++)(defconstant XK_kana_HE #x4cd ++)(defconstant XK_kana_HO #x4ce ++)(defconstant XK_kana_MA #x4cf ++)(defconstant XK_kana_MI #x4d0 ++)(defconstant XK_kana_MU #x4d1 ++)(defconstant XK_kana_ME #x4d2 ++)(defconstant XK_kana_MO #x4d3 ++)(defconstant XK_kana_YA #x4d4 ++)(defconstant XK_kana_YU #x4d5 ++)(defconstant XK_kana_YO #x4d6 ++)(defconstant XK_kana_RA #x4d7 ++)(defconstant XK_kana_RI #x4d8 ++)(defconstant XK_kana_RU #x4d9 ++)(defconstant XK_kana_RE #x4da ++)(defconstant XK_kana_RO #x4db ++)(defconstant XK_kana_WA #x4dc ++)(defconstant XK_kana_N #x4dd ++)(defconstant XK_voicedsound #x4de ++)(defconstant XK_semivoicedsound #x4df ++)(defconstant XK_kana_switch #xFF7E ;; Alias for mode_switch ++;;endif ;; XK_KATAKANA ++ ++;; ++ ; Arabic ++ ; Byte 3 = 5 ++ ++ ++;;ifdef XK_ARABIC ++)(defconstant XK_Arabic_comma #x5ac ++)(defconstant XK_Arabic_semicolon #x5bb ++)(defconstant XK_Arabic_question_mark #x5bf ++)(defconstant XK_Arabic_hamza #x5c1 ++)(defconstant XK_Arabic_maddaonalef #x5c2 ++)(defconstant XK_Arabic_hamzaonalef #x5c3 ++)(defconstant XK_Arabic_hamzaonwaw #x5c4 ++)(defconstant XK_Arabic_hamzaunderalef #x5c5 ++)(defconstant XK_Arabic_hamzaonyeh #x5c6 ++)(defconstant XK_Arabic_alef #x5c7 ++)(defconstant XK_Arabic_beh #x5c8 ++)(defconstant XK_Arabic_tehmarbuta #x5c9 ++)(defconstant XK_Arabic_teh #x5ca ++)(defconstant XK_Arabic_theh #x5cb ++)(defconstant XK_Arabic_jeem #x5cc ++)(defconstant XK_Arabic_hah #x5cd ++)(defconstant XK_Arabic_khah #x5ce ++)(defconstant XK_Arabic_dal #x5cf ++)(defconstant XK_Arabic_thal #x5d0 ++)(defconstant XK_Arabic_ra #x5d1 ++)(defconstant XK_Arabic_zain #x5d2 ++)(defconstant XK_Arabic_seen #x5d3 ++)(defconstant XK_Arabic_sheen #x5d4 ++)(defconstant XK_Arabic_sad #x5d5 ++)(defconstant XK_Arabic_dad #x5d6 ++)(defconstant XK_Arabic_tah #x5d7 ++)(defconstant XK_Arabic_zah #x5d8 ++)(defconstant XK_Arabic_ain #x5d9 ++)(defconstant XK_Arabic_ghain #x5da ++)(defconstant XK_Arabic_tatweel #x5e0 ++)(defconstant XK_Arabic_feh #x5e1 ++)(defconstant XK_Arabic_qaf #x5e2 ++)(defconstant XK_Arabic_kaf #x5e3 ++)(defconstant XK_Arabic_lam #x5e4 ++)(defconstant XK_Arabic_meem #x5e5 ++)(defconstant XK_Arabic_noon #x5e6 ++)(defconstant XK_Arabic_ha #x5e7 ++)(defconstant XK_Arabic_heh #x5e7 ;; deprecated ++)(defconstant XK_Arabic_waw #x5e8 ++)(defconstant XK_Arabic_alefmaksura #x5e9 ++)(defconstant XK_Arabic_yeh #x5ea ++)(defconstant XK_Arabic_fathatan #x5eb ++)(defconstant XK_Arabic_dammatan #x5ec ++)(defconstant XK_Arabic_kasratan #x5ed ++)(defconstant XK_Arabic_fatha #x5ee ++)(defconstant XK_Arabic_damma #x5ef ++)(defconstant XK_Arabic_kasra #x5f0 ++)(defconstant XK_Arabic_shadda #x5f1 ++)(defconstant XK_Arabic_sukun #x5f2 ++)(defconstant XK_Arabic_switch #xFF7E ;; Alias for mode_switch ++;;endif ;; XK_ARABIC ++ ++;; ++ ; Cyrillic ++ ; Byte 3 = 6 ++ ++;;ifdef XK_CYRILLIC ++)(defconstant XK_Serbian_dje #x6a1 ++)(defconstant XK_Macedonia_gje #x6a2 ++)(defconstant XK_Cyrillic_io #x6a3 ++)(defconstant XK_Ukrainian_ie #x6a4 ++)(defconstant XK_Ukranian_je #x6a4 ;; deprecated ++)(defconstant XK_Macedonia_dse #x6a5 ++)(defconstant XK_Ukrainian_i #x6a6 ++)(defconstant XK_Ukranian_i #x6a6 ;; deprecated ++)(defconstant XK_Ukrainian_yi #x6a7 ++)(defconstant XK_Ukranian_yi #x6a7 ;; deprecated ++)(defconstant XK_Cyrillic_je #x6a8 ++)(defconstant XK_Serbian_je #x6a8 ;; deprecated ++)(defconstant XK_Cyrillic_lje #x6a9 ++)(defconstant XK_Serbian_lje #x6a9 ;; deprecated ++)(defconstant XK_Cyrillic_nje #x6aa ++)(defconstant XK_Serbian_nje #x6aa ;; deprecated ++)(defconstant XK_Serbian_tshe #x6ab ++)(defconstant XK_Macedonia_kje #x6ac ++)(defconstant XK_Byelorussian_shortu #x6ae ++)(defconstant XK_Cyrillic_dzhe #x6af ++)(defconstant XK_Serbian_dze #x6af ;; deprecated ++)(defconstant XK_numerosign #x6b0 ++)(defconstant XK_Serbian_DJE #x6b1 ++)(defconstant XK_Macedonia_GJE #x6b2 ++)(defconstant XK_Cyrillic_IO #x6b3 ++)(defconstant XK_Ukrainian_IE #x6b4 ++)(defconstant XK_Ukranian_JE #x6b4 ;; deprecated ++)(defconstant XK_Macedonia_DSE #x6b5 ++)(defconstant XK_Ukrainian_I #x6b6 ++)(defconstant XK_Ukranian_I #x6b6 ;; deprecated ++)(defconstant XK_Ukrainian_YI #x6b7 ++)(defconstant XK_Ukranian_YI #x6b7 ;; deprecated ++)(defconstant XK_Cyrillic_JE #x6b8 ++)(defconstant XK_Serbian_JE #x6b8 ;; deprecated ++)(defconstant XK_Cyrillic_LJE #x6b9 ++)(defconstant XK_Serbian_LJE #x6b9 ;; deprecated ++)(defconstant XK_Cyrillic_NJE #x6ba ++)(defconstant XK_Serbian_NJE #x6ba ;; deprecated ++)(defconstant XK_Serbian_TSHE #x6bb ++)(defconstant XK_Macedonia_KJE #x6bc ++)(defconstant XK_Byelorussian_SHORTU #x6be ++)(defconstant XK_Cyrillic_DZHE #x6bf ++)(defconstant XK_Serbian_DZE #x6bf ;; deprecated ++)(defconstant XK_Cyrillic_yu #x6c0 ++)(defconstant XK_Cyrillic_a #x6c1 ++)(defconstant XK_Cyrillic_be #x6c2 ++)(defconstant XK_Cyrillic_tse #x6c3 ++)(defconstant XK_Cyrillic_de #x6c4 ++)(defconstant XK_Cyrillic_ie #x6c5 ++)(defconstant XK_Cyrillic_ef #x6c6 ++)(defconstant XK_Cyrillic_ghe #x6c7 ++)(defconstant XK_Cyrillic_ha #x6c8 ++)(defconstant XK_Cyrillic_i #x6c9 ++)(defconstant XK_Cyrillic_shorti #x6ca ++)(defconstant XK_Cyrillic_ka #x6cb ++)(defconstant XK_Cyrillic_el #x6cc ++)(defconstant XK_Cyrillic_em #x6cd ++)(defconstant XK_Cyrillic_en #x6ce ++)(defconstant XK_Cyrillic_o #x6cf ++)(defconstant XK_Cyrillic_pe #x6d0 ++)(defconstant XK_Cyrillic_ya #x6d1 ++)(defconstant XK_Cyrillic_er #x6d2 ++)(defconstant XK_Cyrillic_es #x6d3 ++)(defconstant XK_Cyrillic_te #x6d4 ++)(defconstant XK_Cyrillic_u #x6d5 ++)(defconstant XK_Cyrillic_zhe #x6d6 ++)(defconstant XK_Cyrillic_ve #x6d7 ++)(defconstant XK_Cyrillic_softsign #x6d8 ++)(defconstant XK_Cyrillic_yeru #x6d9 ++)(defconstant XK_Cyrillic_ze #x6da ++)(defconstant XK_Cyrillic_sha #x6db ++)(defconstant XK_Cyrillic_e #x6dc ++)(defconstant XK_Cyrillic_shcha #x6dd ++)(defconstant XK_Cyrillic_che #x6de ++)(defconstant XK_Cyrillic_hardsign #x6df ++)(defconstant XK_Cyrillic_YU #x6e0 ++)(defconstant XK_Cyrillic_A #x6e1 ++)(defconstant XK_Cyrillic_BE #x6e2 ++)(defconstant XK_Cyrillic_TSE #x6e3 ++)(defconstant XK_Cyrillic_DE #x6e4 ++)(defconstant XK_Cyrillic_IE #x6e5 ++)(defconstant XK_Cyrillic_EF #x6e6 ++)(defconstant XK_Cyrillic_GHE #x6e7 ++)(defconstant XK_Cyrillic_HA #x6e8 ++)(defconstant XK_Cyrillic_I #x6e9 ++)(defconstant XK_Cyrillic_SHORTI #x6ea ++)(defconstant XK_Cyrillic_KA #x6eb ++)(defconstant XK_Cyrillic_EL #x6ec ++)(defconstant XK_Cyrillic_EM #x6ed ++)(defconstant XK_Cyrillic_EN #x6ee ++)(defconstant XK_Cyrillic_O #x6ef ++)(defconstant XK_Cyrillic_PE #x6f0 ++)(defconstant XK_Cyrillic_YA #x6f1 ++)(defconstant XK_Cyrillic_ER #x6f2 ++)(defconstant XK_Cyrillic_ES #x6f3 ++)(defconstant XK_Cyrillic_TE #x6f4 ++)(defconstant XK_Cyrillic_U #x6f5 ++)(defconstant XK_Cyrillic_ZHE #x6f6 ++)(defconstant XK_Cyrillic_VE #x6f7 ++)(defconstant XK_Cyrillic_SOFTSIGN #x6f8 ++)(defconstant XK_Cyrillic_YERU #x6f9 ++)(defconstant XK_Cyrillic_ZE #x6fa ++)(defconstant XK_Cyrillic_SHA #x6fb ++)(defconstant XK_Cyrillic_E #x6fc ++)(defconstant XK_Cyrillic_SHCHA #x6fd ++)(defconstant XK_Cyrillic_CHE #x6fe ++)(defconstant XK_Cyrillic_HARDSIGN #x6ff ++;;endif ;; XK_CYRILLIC ++ ++;; ++ ; Greek ++ ; Byte 3 = 7 ++ ++ ++;;ifdef XK_GREEK ++)(defconstant XK_Greek_ALPHAaccent #x7a1 ++)(defconstant XK_Greek_EPSILONaccent #x7a2 ++)(defconstant XK_Greek_ETAaccent #x7a3 ++)(defconstant XK_Greek_IOTAaccent #x7a4 ++)(defconstant XK_Greek_IOTAdiaeresis #x7a5 ++)(defconstant XK_Greek_OMICRONaccent #x7a7 ++)(defconstant XK_Greek_UPSILONaccent #x7a8 ++)(defconstant XK_Greek_UPSILONdieresis #x7a9 ++)(defconstant XK_Greek_OMEGAaccent #x7ab ++)(defconstant XK_Greek_accentdieresis #x7ae ++)(defconstant XK_Greek_horizbar #x7af ++)(defconstant XK_Greek_alphaaccent #x7b1 ++)(defconstant XK_Greek_epsilonaccent #x7b2 ++)(defconstant XK_Greek_etaaccent #x7b3 ++)(defconstant XK_Greek_iotaaccent #x7b4 ++)(defconstant XK_Greek_iotadieresis #x7b5 ++)(defconstant XK_Greek_iotaaccentdieresis #x7b6 ++)(defconstant XK_Greek_omicronaccent #x7b7 ++)(defconstant XK_Greek_upsilonaccent #x7b8 ++)(defconstant XK_Greek_upsilondieresis #x7b9 ++)(defconstant XK_Greek_upsilonaccentdieresis #x7ba ++)(defconstant XK_Greek_omegaaccent #x7bb ++)(defconstant XK_Greek_ALPHA #x7c1 ++)(defconstant XK_Greek_BETA #x7c2 ++)(defconstant XK_Greek_GAMMA #x7c3 ++)(defconstant XK_Greek_DELTA #x7c4 ++)(defconstant XK_Greek_EPSILON #x7c5 ++)(defconstant XK_Greek_ZETA #x7c6 ++)(defconstant XK_Greek_ETA #x7c7 ++)(defconstant XK_Greek_THETA #x7c8 ++)(defconstant XK_Greek_IOTA #x7c9 ++)(defconstant XK_Greek_KAPPA #x7ca ++)(defconstant XK_Greek_LAMDA #x7cb ++)(defconstant XK_Greek_LAMBDA #x7cb ++)(defconstant XK_Greek_MU #x7cc ++)(defconstant XK_Greek_NU #x7cd ++)(defconstant XK_Greek_XI #x7ce ++)(defconstant XK_Greek_OMICRON #x7cf ++)(defconstant XK_Greek_PI #x7d0 ++)(defconstant XK_Greek_RHO #x7d1 ++)(defconstant XK_Greek_SIGMA #x7d2 ++)(defconstant XK_Greek_TAU #x7d4 ++)(defconstant XK_Greek_UPSILON #x7d5 ++)(defconstant XK_Greek_PHI #x7d6 ++)(defconstant XK_Greek_CHI #x7d7 ++)(defconstant XK_Greek_PSI #x7d8 ++)(defconstant XK_Greek_OMEGA #x7d9 ++)(defconstant XK_Greek_alpha #x7e1 ++)(defconstant XK_Greek_beta #x7e2 ++)(defconstant XK_Greek_gamma #x7e3 ++)(defconstant XK_Greek_delta #x7e4 ++)(defconstant XK_Greek_epsilon #x7e5 ++)(defconstant XK_Greek_zeta #x7e6 ++)(defconstant XK_Greek_eta #x7e7 ++)(defconstant XK_Greek_theta #x7e8 ++)(defconstant XK_Greek_iota #x7e9 ++)(defconstant XK_Greek_kappa #x7ea ++)(defconstant XK_Greek_lamda #x7eb ++)(defconstant XK_Greek_lambda #x7eb ++)(defconstant XK_Greek_mu #x7ec ++)(defconstant XK_Greek_nu #x7ed ++)(defconstant XK_Greek_xi #x7ee ++)(defconstant XK_Greek_omicron #x7ef ++)(defconstant XK_Greek_pi #x7f0 ++)(defconstant XK_Greek_rho #x7f1 ++)(defconstant XK_Greek_sigma #x7f2 ++)(defconstant XK_Greek_finalsmallsigma #x7f3 ++)(defconstant XK_Greek_tau #x7f4 ++)(defconstant XK_Greek_upsilon #x7f5 ++)(defconstant XK_Greek_phi #x7f6 ++)(defconstant XK_Greek_chi #x7f7 ++)(defconstant XK_Greek_psi #x7f8 ++)(defconstant XK_Greek_omega #x7f9 ++)(defconstant XK_Greek_switch #xFF7E ;; Alias for mode_switch ++;;endif ;; XK_GREEK ++ ++;; ++ ; Technical ++ ; Byte 3 = 8 ++ ++ ++;;ifdef XK_TECHNICAL ++)(defconstant XK_leftradical #x8a1 ++)(defconstant XK_topleftradical #x8a2 ++)(defconstant XK_horizconnector #x8a3 ++)(defconstant XK_topintegral #x8a4 ++)(defconstant XK_botintegral #x8a5 ++)(defconstant XK_vertconnector #x8a6 ++)(defconstant XK_topleftsqbracket #x8a7 ++)(defconstant XK_botleftsqbracket #x8a8 ++)(defconstant XK_toprightsqbracket #x8a9 ++)(defconstant XK_botrightsqbracket #x8aa ++)(defconstant XK_topleftparens #x8ab ++)(defconstant XK_botleftparens #x8ac ++)(defconstant XK_toprightparens #x8ad ++)(defconstant XK_botrightparens #x8ae ++)(defconstant XK_leftmiddlecurlybrace #x8af ++)(defconstant XK_rightmiddlecurlybrace #x8b0 ++)(defconstant XK_topleftsummation #x8b1 ++)(defconstant XK_botleftsummation #x8b2 ++)(defconstant XK_topvertsummationconnector #x8b3 ++)(defconstant XK_botvertsummationconnector #x8b4 ++)(defconstant XK_toprightsummation #x8b5 ++)(defconstant XK_botrightsummation #x8b6 ++)(defconstant XK_rightmiddlesummation #x8b7 ++)(defconstant XK_lessthanequal #x8bc ++)(defconstant XK_notequal #x8bd ++)(defconstant XK_greaterthanequal #x8be ++)(defconstant XK_integral #x8bf ++)(defconstant XK_therefore #x8c0 ++)(defconstant XK_variation #x8c1 ++)(defconstant XK_infinity #x8c2 ++)(defconstant XK_nabla #x8c5 ++)(defconstant XK_approximate #x8c8 ++)(defconstant XK_similarequal #x8c9 ++)(defconstant XK_ifonlyif #x8cd ++)(defconstant XK_implies #x8ce ++)(defconstant XK_identical #x8cf ++)(defconstant XK_radical #x8d6 ++)(defconstant XK_includedin #x8da ++)(defconstant XK_includes #x8db ++)(defconstant XK_intersection #x8dc ++)(defconstant XK_union #x8dd ++)(defconstant XK_logicaland #x8de ++)(defconstant XK_logicalor #x8df ++)(defconstant XK_partialderivative #x8ef ++)(defconstant XK_function #x8f6 ++)(defconstant XK_leftarrow #x8fb ++)(defconstant XK_uparrow #x8fc ++)(defconstant XK_rightarrow #x8fd ++)(defconstant XK_downarrow #x8fe ++;;endif ;; XK_TECHNICAL ++ ++;; ++ ; Special ++ ; Byte 3 = 9 ++ ++ ++;;ifdef XK_SPECIAL ++)(defconstant XK_blank #x9df ++)(defconstant XK_soliddiamond #x9e0 ++)(defconstant XK_checkerboard #x9e1 ++)(defconstant XK_ht #x9e2 ++)(defconstant XK_ff #x9e3 ++)(defconstant XK_cr #x9e4 ++)(defconstant XK_lf #x9e5 ++)(defconstant XK_nl #x9e8 ++)(defconstant XK_vt #x9e9 ++)(defconstant XK_lowrightcorner #x9ea ++)(defconstant XK_uprightcorner #x9eb ++)(defconstant XK_upleftcorner #x9ec ++)(defconstant XK_lowleftcorner #x9ed ++)(defconstant XK_crossinglines #x9ee ++)(defconstant XK_horizlinescan1 #x9ef ++)(defconstant XK_horizlinescan3 #x9f0 ++)(defconstant XK_horizlinescan5 #x9f1 ++)(defconstant XK_horizlinescan7 #x9f2 ++)(defconstant XK_horizlinescan9 #x9f3 ++)(defconstant XK_leftt #x9f4 ++)(defconstant XK_rightt #x9f5 ++)(defconstant XK_bott #x9f6 ++)(defconstant XK_topt #x9f7 ++)(defconstant XK_vertbar #x9f8 ++;;endif ;; XK_SPECIAL ++ ++;; ++ ; Publishing ++ ; Byte 3 = a ++ ++ ++;;ifdef XK_PUBLISHING ++)(defconstant XK_emspace #xaa1 ++)(defconstant XK_enspace #xaa2 ++)(defconstant XK_em3space #xaa3 ++)(defconstant XK_em4space #xaa4 ++)(defconstant XK_digitspace #xaa5 ++)(defconstant XK_punctspace #xaa6 ++)(defconstant XK_thinspace #xaa7 ++)(defconstant XK_hairspace #xaa8 ++)(defconstant XK_emdash #xaa9 ++)(defconstant XK_endash #xaaa ++)(defconstant XK_signifblank #xaac ++)(defconstant XK_ellipsis #xaae ++)(defconstant XK_doubbaselinedot #xaaf ++)(defconstant XK_onethird #xab0 ++)(defconstant XK_twothirds #xab1 ++)(defconstant XK_onefifth #xab2 ++)(defconstant XK_twofifths #xab3 ++)(defconstant XK_threefifths #xab4 ++)(defconstant XK_fourfifths #xab5 ++)(defconstant XK_onesixth #xab6 ++)(defconstant XK_fivesixths #xab7 ++)(defconstant XK_careof #xab8 ++)(defconstant XK_figdash #xabb ++)(defconstant XK_leftanglebracket #xabc ++)(defconstant XK_decimalpoint #xabd ++)(defconstant XK_rightanglebracket #xabe ++)(defconstant XK_marker #xabf ++)(defconstant XK_oneeighth #xac3 ++)(defconstant XK_threeeighths #xac4 ++)(defconstant XK_fiveeighths #xac5 ++)(defconstant XK_seveneighths #xac6 ++)(defconstant XK_trademark #xac9 ++)(defconstant XK_signaturemark #xaca ++)(defconstant XK_trademarkincircle #xacb ++)(defconstant XK_leftopentriangle #xacc ++)(defconstant XK_rightopentriangle #xacd ++)(defconstant XK_emopencircle #xace ++)(defconstant XK_emopenrectangle #xacf ++)(defconstant XK_leftsinglequotemark #xad0 ++)(defconstant XK_rightsinglequotemark #xad1 ++)(defconstant XK_leftdoublequotemark #xad2 ++)(defconstant XK_rightdoublequotemark #xad3 ++)(defconstant XK_prescription #xad4 ++)(defconstant XK_minutes #xad6 ++)(defconstant XK_seconds #xad7 ++)(defconstant XK_latincross #xad9 ++)(defconstant XK_hexagram #xada ++)(defconstant XK_filledrectbullet #xadb ++)(defconstant XK_filledlefttribullet #xadc ++)(defconstant XK_filledrighttribullet #xadd ++)(defconstant XK_emfilledcircle #xade ++)(defconstant XK_emfilledrect #xadf ++)(defconstant XK_enopencircbullet #xae0 ++)(defconstant XK_enopensquarebullet #xae1 ++)(defconstant XK_openrectbullet #xae2 ++)(defconstant XK_opentribulletup #xae3 ++)(defconstant XK_opentribulletdown #xae4 ++)(defconstant XK_openstar #xae5 ++)(defconstant XK_enfilledcircbullet #xae6 ++)(defconstant XK_enfilledsqbullet #xae7 ++)(defconstant XK_filledtribulletup #xae8 ++)(defconstant XK_filledtribulletdown #xae9 ++)(defconstant XK_leftpointer #xaea ++)(defconstant XK_rightpointer #xaeb ++)(defconstant XK_club #xaec ++)(defconstant XK_diamond #xaed ++)(defconstant XK_heart #xaee ++)(defconstant XK_maltesecross #xaf0 ++)(defconstant XK_dagger #xaf1 ++)(defconstant XK_doubledagger #xaf2 ++)(defconstant XK_checkmark #xaf3 ++)(defconstant XK_ballotcross #xaf4 ++)(defconstant XK_musicalsharp #xaf5 ++)(defconstant XK_musicalflat #xaf6 ++)(defconstant XK_malesymbol #xaf7 ++)(defconstant XK_femalesymbol #xaf8 ++)(defconstant XK_telephone #xaf9 ++)(defconstant XK_telephonerecorder #xafa ++)(defconstant XK_phonographcopyright #xafb ++)(defconstant XK_caret #xafc ++)(defconstant XK_singlelowquotemark #xafd ++)(defconstant XK_doublelowquotemark #xafe ++)(defconstant XK_cursor #xaff ++;;endif ;; XK_PUBLISHING ++ ++;; ++ ; APL ++ ; Byte 3 = b ++ ++ ++;;ifdef XK_APL ++)(defconstant XK_leftcaret #xba3 ++)(defconstant XK_rightcaret #xba6 ++)(defconstant XK_downcaret #xba8 ++)(defconstant XK_upcaret #xba9 ++)(defconstant XK_overbar #xbc0 ++)(defconstant XK_downtack #xbc2 ++)(defconstant XK_upshoe #xbc3 ++)(defconstant XK_downstile #xbc4 ++)(defconstant XK_underbar #xbc6 ++)(defconstant XK_jot #xbca ++)(defconstant XK_quad #xbcc ++)(defconstant XK_uptack #xbce ++)(defconstant XK_circle #xbcf ++)(defconstant XK_upstile #xbd3 ++)(defconstant XK_downshoe #xbd6 ++)(defconstant XK_rightshoe #xbd8 ++)(defconstant XK_leftshoe #xbda ++)(defconstant XK_lefttack #xbdc ++)(defconstant XK_righttack #xbfc ++;;endif ;; XK_APL ++ ++;; ++ ; Hebrew ++ ; Byte 3 = c ++ ++ ++;;ifdef XK_HEBREW ++)(defconstant XK_hebrew_doublelowline #xcdf ++)(defconstant XK_hebrew_aleph #xce0 ++)(defconstant XK_hebrew_bet #xce1 ++)(defconstant XK_hebrew_beth #xce1 ;; deprecated ++)(defconstant XK_hebrew_gimel #xce2 ++)(defconstant XK_hebrew_gimmel #xce2 ;; deprecated ++)(defconstant XK_hebrew_dalet #xce3 ++)(defconstant XK_hebrew_daleth #xce3 ;; deprecated ++)(defconstant XK_hebrew_he #xce4 ++)(defconstant XK_hebrew_waw #xce5 ++)(defconstant XK_hebrew_zain #xce6 ++)(defconstant XK_hebrew_zayin #xce6 ;; deprecated ++)(defconstant XK_hebrew_chet #xce7 ++)(defconstant XK_hebrew_het #xce7 ;; deprecated ++)(defconstant XK_hebrew_tet #xce8 ++)(defconstant XK_hebrew_teth #xce8 ;; deprecated ++)(defconstant XK_hebrew_yod #xce9 ++)(defconstant XK_hebrew_finalkaph #xcea ++)(defconstant XK_hebrew_kaph #xceb ++)(defconstant XK_hebrew_lamed #xcec ++)(defconstant XK_hebrew_finalmem #xced ++)(defconstant XK_hebrew_mem #xcee ++)(defconstant XK_hebrew_finalnun #xcef ++)(defconstant XK_hebrew_nun #xcf0 ++)(defconstant XK_hebrew_samech #xcf1 ++)(defconstant XK_hebrew_samekh #xcf1 ;; deprecated ++)(defconstant XK_hebrew_ayin #xcf2 ++)(defconstant XK_hebrew_finalpe #xcf3 ++)(defconstant XK_hebrew_pe #xcf4 ++)(defconstant XK_hebrew_finalzade #xcf5 ++)(defconstant XK_hebrew_finalzadi #xcf5 ;; deprecated ++)(defconstant XK_hebrew_zade #xcf6 ++)(defconstant XK_hebrew_zadi #xcf6 ;; deprecated ++)(defconstant XK_hebrew_qoph #xcf7 ++)(defconstant XK_hebrew_kuf #xcf7 ;; deprecated ++)(defconstant XK_hebrew_resh #xcf8 ++)(defconstant XK_hebrew_shin #xcf9 ++)(defconstant XK_hebrew_taw #xcfa ++)(defconstant XK_hebrew_taf #xcfa ;; deprecated ++)(defconstant XK_Hebrew_switch #xFF7E ;; Alias for mode_switch ++;;endif ;; XK_HEBREW ++) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_Xinit.lsp +@@ -0,0 +1,147 @@ ++(in-package :XLIB) ++; Xinit.lsp Hiep Huu Nguyen 27 Aug 92; GSN 07 Mar 95 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++;;a word about Xakcl: ++;;Since Xakcl is a direct translation of the X library in C to lisp to a ++;;large extent. it would be beneficial to use a X 11 version 4, manual ++;;in order to look up functions. the only unique functions of Xakcl are those ++;;that involove manipulating C structs. all functions involved in creating ++;;a C struct in X starts with a 'make' followed by the structure name. all ++;;functions involved in getting a field of a C struct strats with the ++;;name of the C struct followed by the name of the field. the ++;;parameters it excepts is the varaible contaning the structure. all ++;;functions to set a field of a C struct starts with 'set' followed by ++;;the C struct name followed by the field name. these functions accept ++;;as parameter, the varaible containing the struct and the value to be ++;;put in the field. ++ ++;;;; ++;;contents of this file: ++;;;; ++;;this files has examples of initializing the display, screen, ++;;root-window, pixel value, gc, and colormap. ++;;;; ++;;gives an example of opening windows, setting size's and sizehints for ++;;the window manager getting drawbles' geometry ++;;;; ++;;drawing lines , drawing in color, changing line, attributes ++;;;; ++;;tracking the mouse and handling events and manipulating the event ++;;queue ++;;;; ++;;there is also some basic text handling stuff ++;;;; ++ ++;;globals ++(defvar *default-display* ) ++(defvar *default-screen* ) ++(defvar *default-colormap*) ++(defvar *root-window* ) ++(defvar *black-pixel* ) ++(defvar *white-pixel* ) ++(defvar *default-size-hints* (make-XsizeHints) ) ++(defvar *default-GC* ) ++(defvar *default-event* (make-XEvent)) ++(defvar *pos-x* 10) ++(defvar *pos-y* 20) ++(defvar *win-width* 225) ++(defvar *win-height* 400) ++(defvar *border-width* 1) ++(defvar *root-return* (int-array 1)) ++(defvar *x-return* (int-array 1)) ++(defvar *y-return* (int-array 1) ) ++(defvar *width-return* (int-array 1)) ++(defvar *height-return* (int-array 1)) ++(defvar *border-width-return* (int-array 1)) ++(defvar *depth-return* (int-array 1)) ++(defvar *GC-Values* (make-XGCValues)) ++ ++;;an example window ++(defvar a-window) ++ ++ ++;;;;;;;;;;;;;;;;;;;;;; ++;;this function initializes all varaibles needed by most applications. ++;;it uses all defaults which is inherited from the root window, and ++;;screen. ++ ++(defun Xinit() ++ (setq *default-display* (XOpenDisplay (get-c-string ""))) ++ (setq *default-screen* (XdefaultScreen *default-display*)) ++ (setq *root-window* (XRootWindow *default-display* *default-screen*)) ++ (setq *black-pixel* (XBlackPixel *default-display* ++ *default-screen*)) ++ (setq *white-pixel* (XWhitePixel *default-display* ++ *default-screen*)) ++ (setq *default-GC* (XDefaultGC *default-display* *default-screen*)) ++ (setq *default-colormap* ( XDefaultColormap *default-display* *default-screen*)) ++ (Xflush *default-display* )) ++ ++ ++ ++ ++;;;;;;;;;;;;;;;;;;;;;; ++;;this is an example of creating a window. this function takes care of ++;;positioning, size and other attirbutes of the window. ++ ++(defun open-window(&key (pos-x *pos-x* ) (pos-y *pos-y*) (win-width *win-width*) ++ (win-height *win-height* ) ++ (border-width *border-width*) (window-name "My Window") ++ (icon-name "My Icon")) ++;;create the window ++ ++ (let (( a-window (XCreateSimpleWindow ++ *default-display* *root-window* ++ pos-x pos-y win-width win-height border-width *black-pixel* *white-pixel*))) ++ ++;; all children of the root window needs a XSizeHints to tell the window manager ++;; how to position it, etc ++ ++ (set-Xsizehints-x *default-size-hints* pos-x) ++ (set-xsizehints-y *default-size-hints* pos-y) ++ (set-xsizehints-width *default-size-hints* win-width) ++ (set-xsizehints-height *default-size-hints* win-height) ++ (set-xsizehints-flags *default-size-hints* (+ Psize Pposition)) ++ (XsetStandardProperties *default-display* a-window (get-c-string window-name) ++ (get-c-string icon-name) none 0 0 *default-size-hints*) ++ ++;; the events or input a window can have are set with Xselectinput ++;; (Xselectinput *default-display* a-window ++;; (+ ButtonpressMask PointerMotionMask ExposureMask)) ++ ++;; the window needs to be mapped ++ (Xmapwindow *default-display* a-window) ++ ++;;the X server needs to have the output buffer sent to it before it can ++;;process requests. this is acomplished with XFlush or functions that ++;;read and manipulate the event queue. remember to do this after ++;;operations that won't be calling an eventhandling function ++ ++ (Xflush *default-display* ) ++ ++;;after flushing the request buffer the X server draws window as requested ++ ++ a-window)) ++ ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_dwtestcases.lsp +@@ -0,0 +1,32 @@ ++(load "/stage/ftp/pub/novak/xgcl-4/gcl_dwtrans.lsp") ++(use-package 'xlib) ++(load "/stage/ftp/pub/novak/xgcl-4/gcl_drawtrans.lsp") ++(load "/stage/ftp/pub/novak/xgcl-4/gcl_editorstrans.lsp") ++(load "/stage/ftp/pub/novak/xgcl-4/gcl_lispservertrans.lsp") ++(load "/stage/ftp/pub/novak/xgcl-4/gcl_menu-settrans.lsp") ++(load "/stage/ftp/pub/novak/xgcl-4/gcl_dwtest.lsp") ++(load "/stage/ftp/pub/novak/xgcl-4/gcl_draw-gates.lsp") ++ ++(wtesta) ++(wtestb) ++(wtestc) ++(wtestd) ++(wteste) ++(wtestf) ++(wtestg) ++(wtesth) ++(wtesti) ++(wtestj) ++(wtestk) ++ ++(window-clear myw) ++(edit-color myw) ++ ++(lisp-server) ++ ++(draw 'foo) ++ ++(window-draw-box-xy myw 48 48 204 204) ++(window-edit myw 50 50 200 200 '("Now is the time" "for all" "good")) ++ ++(draw-nand myw 50 50) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_editorstrans.lsp +@@ -0,0 +1,589 @@ ++; 07 Jan 2010 16:43:40 EST ++; This program 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 program 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 program; if not, see . ++ ++ ++(DEFUN EDIT-THERMOM (NUM W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) ++ (PROG (NMIN NDEL NDIV RANGE PTEN DRANGE PAIR NEWW (RES NUM) OFF) ++ (WHEN (NOT SIZEX) (SETQ SIZEX 150) (SETQ SIZEY 250)) ++ (WHEN (NOT OFFSETX) ++ (SETQ OFF ++ (LET ((GLVAR168 (LIST SIZEX SIZEY))) ++ (LIST (TRUNCATE (- (FIFTH W) (CAR GLVAR168)) 2) ++ (TRUNCATE (- (CADDDR W) (CADR GLVAR168)) 2)))) ++ (SETQ OFFSETX (CAR OFF)) ++ (SETQ OFFSETY (CADR OFF))) ++ (SETQ NEWW ++ (WINDOW-CREATE SIZEX SIZEY NIL (CADR W) OFFSETX OFFSETY)) ++ (WINDOW-DRAW-BUTTON NEWW "Typein" 80 20 50 25) ++ (WINDOW-DRAW-BUTTON NEWW "Adjust" 80 70 50 25) ++ (WINDOW-DRAW-BUTTON NEWW "Done" 80 120 50 25) ++ RN ++ (SETQ RANGE (* 2 (ABS RES))) ++ (IF (ZEROP RANGE) (SETQ RANGE 50)) ++ (IF (AND (< RANGE 8) (INTEGERP NUM)) (SETQ RANGE 10)) ++ (SETQ PTEN (EXPT 10 (TRUNCATE (LOG RANGE 10)))) ++ (SETQ DRANGE (/ (* 10 RANGE) PTEN)) ++ (SETQ PAIR ++ (CAR (SOME #'(LAMBDA (X) (> (CAR X) DRANGE)) ++ '((14 2) (20 4) (40 5) (70 10) (101 20))))) ++ (SETQ NDEL (* 1/10 (* (CADR PAIR) PTEN))) ++ (SETQ NDIV (CEILING (/ RANGE NDEL))) ++ (SETQ NMIN (IF (>= RES 0) 0 (- (* NDEL NDIV)))) ++ (WINDOW-DRAW-THERMOMETER NEWW NMIN NDEL NDIV RES 10 10 ++ (+ -20 SIZEY)) ++ LP ++ (CASE (BUTTON-SELECT NEWW ++ '((DONE (84 124) (42 17)) (ADJUST (84 74) (42 17)) ++ (TYPEIN (84 24) (42 17)))) ++ (DONE (XDESTROYWINDOW *WINDOW-DISPLAY* (CADR NEWW)) ++ (XFLUSH *WINDOW-DISPLAY*) (SETF (CADR NEWW) NIL) ++ (XFREEGC *WINDOW-DISPLAY* (CADDR NEWW)) ++ (SETF (CADDR NEWW) NIL) (RETURN RES)) ++ (ADJUST (SETQ RES ++ (WINDOW-ADJUST-THERMOMETER NEWW NMIN NDEL NDIV RES ++ 10 10 (+ -20 SIZEY))) ++ (GO LP)) ++ (TYPEIN (PRINC "Enter new value: ") (SETQ RES (READ)) ++ (IF (AND (>= RES NMIN) (<= RES (+ NMIN (* NDEL NDIV)))) ++ (PROGN ++ (WINDOW-SET-THERMOMETER NEWW NMIN NDEL NDIV RES 10 ++ 10 (+ -20 SIZEY)) ++ (GO LP)) ++ (GO RN)))))) ++(SETF (GET 'EDIT-THERMOM 'GLARGUMENTS) ++ '((NUM NUMBER) (W WINDOW) (&OPTIONAL INTEGER) (OFFSETX INTEGER) ++ (OFFSETY INTEGER) (SIZEX INTEGER))) ++(SETF (GET 'EDIT-THERMOM 'GLFNRESULTTYPE) 'NUMBER) ++ ++ ++(DEFUN WINDOW-DRAW-BUTTON (W S OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (SW) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX ++ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) ++ (WINDOW-DRAW-RCBOX-XY W OFFSETX OFFSETY SIZEX SIZEY 8) ++ (SETQ SW ++ (LET ((SSTR (STRINGIFY S))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ (LET ((SSTR (STRINGIFY S))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) ++ (+ OFFSETX (* 1/2 (- SIZEX SW))) ++ (+ -8 (- (CADDDR W) OFFSETY)) (GET-C-STRING SSTR) ++ (LENGTH SSTR))) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN WINDOW-CENTER-PRINT (W S OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (SW) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX ++ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) ++ (SETQ SW ++ (LET ((SSTR (STRINGIFY S))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ (LET ((SSTR (STRINGIFY S))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) ++ (+ OFFSETX (* 1/2 (- SIZEX SW))) ++ (- (CADDDR W) (+ OFFSETY (+ -5 (* 1/2 SIZEY)))) ++ (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN WINDOW-DRAW-THERMOMETER ++ (W NMIN NDEL NDIV VAL OFFSETX OFFSETY SIZEY) ++ (LET (HDEL MARKY) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX ++ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) 66 SIZEY 0) ++ (EDITORS-PRINT-IN-BOX VAL W OFFSETX OFFSETY 40 20) ++ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) OFFSETX ++ (+ -48 (- (CADDDR W) OFFSETY)) 24 24 8448 17664) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) ++ (+ -44 (- QQWHEIGHT OFFSETY)) (+ 4 OFFSETX) ++ (+ 8 (- QQWHEIGHT (+ OFFSETY SIZEY))))) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 20 OFFSETX) ++ (+ -44 (- QQWHEIGHT OFFSETY)) (+ 20 OFFSETX) ++ (+ 8 (- QQWHEIGHT (+ OFFSETY SIZEY))))) ++ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) ++ (- (CADDDR W) (+ OFFSETY SIZEY)) 16 16 0 11520) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 1 0) ++ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 8 OFFSETX) ++ (+ -40 (- (CADDDR W) OFFSETY)) 8 8 0 23040) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0) ++ (SETQ HDEL (/ (+ -56 SIZEY) NDIV)) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 1 0) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 12 OFFSETX) ++ (+ -35 (- QQWHEIGHT OFFSETY)) (+ 12 OFFSETX) ++ (- QQWHEIGHT ++ (+ (+ 48 OFFSETY) (* HDEL (/ (- VAL NMIN) NDEL))))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) ++ (DOTIMES (I (1+ NDIV)) ++ (SETQ MARKY (+ (+ 48 OFFSETY) (* I HDEL))) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 24 OFFSETX) ++ (- QQWHEIGHT MARKY) (+ 34 OFFSETX) (- QQWHEIGHT MARKY)) ++ NIL) ++ (LET ((SSTR (STRINGIFY (+ NMIN (* I NDEL))))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) ++ (+ 36 OFFSETX) (+ 6 (- (CADDDR W) MARKY)) ++ (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN WINDOW-SET-THERMOMETER ++ (W NMIN NDEL NDIV VAL OFFSETX OFFSETY SIZEY) ++ (LET (HDEL) ++ (SETQ HDEL (/ (+ -56 SIZEY) NDIV)) ++ (LET ((GLVAR204 (+ -56 SIZEY))) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) (+ 7 OFFSETX) ++ (- (CADDDR W) (1- (+ (+ 48 OFFSETY) GLVAR204))) 10 GLVAR204 ++ 0)) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 1 0) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 12 OFFSETX) ++ (+ -35 (- QQWHEIGHT OFFSETY)) (+ 12 OFFSETX) ++ (- QQWHEIGHT ++ (+ (+ 48 OFFSETY) (* HDEL (/ (- VAL NMIN) NDEL))))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) ++ (EDITORS-UPDATE-IN-BOX VAL W OFFSETX OFFSETY 40 20))) ++ ++(DEFUN WINDOW-ADJUST-THERMOMETER ++ (W NMIN NDEL NDIV VAL OFFSETX OFFSETY SIZEY) ++ (LET (HDEL LASTY XMIN XMAX YMIN YMAX INSIDE NEWVAL) ++ (SETQ HDEL (/ (+ -56 SIZEY) NDIV)) ++ (SETQ LASTY ++ (TRUNCATE (+ (+ 48 OFFSETY) (* HDEL (/ (- VAL NMIN) NDEL))))) ++ (SETQ XMIN (+ 4 OFFSETX)) ++ (SETQ XMAX (+ 20 OFFSETX)) ++ (SETQ YMIN (+ 48 OFFSETY)) ++ (SETQ YMAX (+ -8 (+ OFFSETY SIZEY))) ++ (WINDOW-TRACK-MOUSE W ++ #'(LAMBDA (X Y CODE) ++ (SETQ INSIDE ++ (AND (>= X XMIN) (<= X XMAX) (>= Y YMIN) (<= Y YMAX))) ++ (WHEN (AND INSIDE (/= Y LASTY)) ++ (IF (> Y LASTY) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 ++ 1 0) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) ++ (+ 12 OFFSETX) (- QQWHEIGHT LASTY) ++ (+ 12 OFFSETX) (- QQWHEIGHT Y)) ++ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 ++ 1 0)) ++ (LET ((GLVAR214 (- LASTY Y))) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) (+ 7 OFFSETX) ++ (- (CADDDR W) (1- (+ (1+ Y) GLVAR214))) 10 ++ GLVAR214 0))) ++ (SETQ LASTY Y) ++ (SETQ NEWVAL ++ (+ (* (/ (+ -48 (- LASTY OFFSETY)) (FLOAT HDEL)) ++ NDEL) ++ NMIN)) ++ (IF (INTEGERP VAL) (SETQ NEWVAL (TRUNCATE NEWVAL))) ++ (EDITORS-UPDATE-IN-BOX NEWVAL W OFFSETX OFFSETY 40 20)) ++ (NOT (ZEROP CODE)))) ++ (IF INSIDE NEWVAL VAL))) ++(SETF (GET 'WINDOW-ADJUST-THERMOMETER 'GLARGUMENTS) ++ '((W WINDOW) (NMIN INTEGER) (NDEL INTEGER) (NDIV INTEGER) ++ (VAL NUMBER) (OFFSETX INTEGER) (OFFSETY INTEGER) ++ (SIZEY INTEGER))) ++(SETF (GET 'WINDOW-ADJUST-THERMOMETER 'GLFNRESULTTYPE) 'NUMBER) ++ ++ ++(DEFUN BUTTON-SELECT (MW BUTTONS) ++ (LET (CURRENT-BUTTON ITEM ITEMS VAL XZERO YZERO) ++ (SETQ XZERO 0) ++ (SETQ YZERO 0) ++ (WINDOW-TRACK-MOUSE MW ++ #'(LAMBDA (X Y CODE) ++ (DECF X XZERO) ++ (DECF Y YZERO) ++ (AND (>= X 0) (>= Y 0)) ++ (IF CURRENT-BUTTON ++ (WHEN (NOT (BUTTON-CONTAINSXY? CURRENT-BUTTON X Y)) ++ (BUTTON-INVERT MW CURRENT-BUTTON) ++ (SETQ CURRENT-BUTTON NIL))) ++ (WHEN (NOT CURRENT-BUTTON) ++ (SETQ ITEMS BUTTONS) ++ (WHILE (AND (NOT CURRENT-BUTTON) (SETQ ITEM (POP ITEMS))) ++ (WHEN (BUTTON-CONTAINSXY? ITEM X Y) ++ (SETQ CURRENT-BUTTON ITEM) ++ (BUTTON-INVERT MW CURRENT-BUTTON)))) ++ (WHEN (PLUSP CODE) ++ (IF CURRENT-BUTTON (BUTTON-INVERT MW CURRENT-BUTTON)) ++ (SETQ VAL (OR CURRENT-BUTTON *PICMENU-NO-SELECTION*)))) ++ T) ++ (IF (NOT (EQUAL VAL *PICMENU-NO-SELECTION*)) (CAR VAL)))) ++(SETF (GET 'BUTTON-SELECT 'GLARGUMENTS) ++ '((MW WINDOW) (BUTTONS (LISTOF PICMENU-BUTTON)))) ++(SETF (GET 'BUTTON-SELECT 'GLFNRESULTTYPE) 'SYMBOL) ++ ++ ++(DEFUN BUTTON-INVERT (W BUTTON) ++ (WINDOW-INVERT-AREA W (CADR BUTTON) (CADDR BUTTON))) ++ ++(DEFUN WINDOW-UNDRAW-BOX (W OFFSET SIZE &OPTIONAL LW) ++ (LET ((GC (CADDR W))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 3) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*)))) ++ (WINDOW-DRAW-BOX W OFFSET SIZE LW) ++ (LET ((GC (CADDR W))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) ++ ++(DEFUN BUTTON-CONTAINSXY? (B X Y) ++ (LET ((XSIZE 6) (YSIZE 6)) ++ (WHEN (CADDR B) ++ (SETQ XSIZE (CAADDR B)) ++ (SETQ YSIZE (CADR (CADDR B)))) ++ (AND (>= X (CAADR B)) (<= X (+ (CAADR B) XSIZE)) (>= Y (CADADR B)) ++ (<= Y (+ (CADADR B) YSIZE))))) ++(SETF (GET 'BUTTON-CONTAINSXY? 'GLARGUMENTS) ++ '((B PICMENU-BUTTON) (X INTEGER) (Y INTEGER))) ++(SETF (GET 'BUTTON-CONTAINSXY? 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(SETF (GET 'MENU-ITEM 'GLSTRUCTURE) ++ '((Z ANYTHING) PROP ((VALUE ((IF Z IS ATOMIC Z (CDR Z))))) MSG ++ ((PRINT-SIZE MENU-ITEM-PRINT-SIZE) (DRAW MENU-ITEM-DRAW)))) ++ ++ ++(DEFUN MENU-ITEM-PRINT-SIZE (ITEM W) ++ (LET (SIZ) ++ (IF (ATOM ITEM) ++ (LIST (LET ((SSTR (STRINGIFY ITEM))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) ++ (LENGTH SSTR))) ++ 11) ++ (IF (STRINGP (CAR ITEM)) ++ (LIST (LET ((SSTR (STRINGIFY (CAR ITEM)))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) ++ (LENGTH SSTR))) ++ 11) ++ (IF (AND (SYMBOLP (CAR ITEM)) ++ (SETQ SIZ (GET (CAR ITEM) 'DISPLAY-SIZE))) ++ SIZ (COPY-LIST '(50 11))))))) ++(SETF (GET 'MENU-ITEM-PRINT-SIZE 'GLARGUMENTS) ++ '((ITEM MENU-ITEM) (W WINDOW))) ++(SETF (GET 'MENU-ITEM-PRINT-SIZE 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN MENU-ITEM-DRAW (ITEM W OFFSETX OFFSETY SIZEX SIZEY) ++ (IF (ATOM ITEM) ++ (WINDOW-CENTER-PRINT W ITEM OFFSETX OFFSETY SIZEX SIZEY) ++ (IF (AND (SYMBOLP (CAR ITEM)) (FBOUNDP (CAR ITEM))) ++ (FUNCALL (CAR ITEM) W OFFSETX OFFSETY) ++ (WINDOW-CENTER-PRINT W (CAR ITEM) OFFSETX OFFSETY SIZEX ++ SIZEY)))) ++ ++(DEFUN PICK-ONE-SIZE (ITEMS W) ++ (LET (WID) ++ (DOLIST (ITEM ITEMS) ++ (SETQ WID ++ (IF WID (MAX WID (CAR (MENU-ITEM-PRINT-SIZE ITEM W))) ++ (CAR (MENU-ITEM-PRINT-SIZE ITEM W))))) ++ (LIST WID 11))) ++(SETF (GET 'PICK-ONE-SIZE 'GLARGUMENTS) ++ '((ITEMS (LISTOF MENU-ITEM)) (W WINDOW))) ++(SETF (GET 'PICK-ONE-SIZE 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-PICK-ONE ++ (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (ITM) ++ (IF (SETQ ITM ++ (SOME #'(LAMBDA (GLVAR216) ++ (IF (EQUAL (IF (ATOM GLVAR216) GLVAR216 ++ (CDR GLVAR216)) ++ VAL) ++ GLVAR216)) ++ ITEMS)) ++ (MENU-ITEM-DRAW ITM W OFFSETX OFFSETY SIZEX SIZEY)))) ++ ++(DEFUN EDIT-PICK-ONE ++ (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (NEWVAL) ++ (IF (<= (LENGTH ITEMS) 3) ++ (IF (EQUAL VAL ++ (LET ((SELF (FIRST ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))) ++ (SETQ NEWVAL ++ (LET ((SELF (SECOND ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))) ++ (IF (EQUAL VAL ++ (LET ((SELF (SECOND ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))) ++ (SETQ NEWVAL ++ (IF (THIRD ITEMS) ++ (LET ((SELF (THIRD ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF))) ++ (LET ((SELF (FIRST ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF))))) ++ (SETQ NEWVAL ++ (LET ((SELF (FIRST ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))))) ++ (SETQ NEWVAL (MENU ITEMS))) ++ (DRAW-PICK-ONE NEWVAL W ITEMS OFFSETX OFFSETY SIZEX SIZEY) ++ NEWVAL)) ++ ++(DEFUN DRAW-BLACK-WHITE ++ (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (ITM) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX ++ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) ++ (IF (SETQ ITM ++ (SOME #'(LAMBDA (GLVAR218) ++ (IF (EQUAL (IF (ATOM GLVAR218) GLVAR218 ++ (CDR GLVAR218)) ++ VAL) ++ GLVAR218)) ++ ITEMS)) ++ (WHEN (EQL (IF (CONSP ITM) (CAR ITM) ITM) 1) ++ (LET ((GC (CADDR W))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 ++ *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 ++ *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (LOGXOR *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*))))) ++ (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR W) (CADDR W) OFFSETX ++ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY) ++ (LET ((GC (CADDR W))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ *WINDOW-SAVE-FOREGROUND*)))))) ++ ++(DEFUN EDIT-BLACK-WHITE ++ (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (NEWVAL) ++ (IF (EQUAL VAL ++ (LET ((SELF (FIRST ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))) ++ (SETQ NEWVAL ++ (LET ((SELF (SECOND ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))) ++ (IF (EQUAL VAL ++ (LET ((SELF (SECOND ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))) ++ (SETQ NEWVAL ++ (LET ((SELF (FIRST ITEMS))) ++ (IF (ATOM SELF) SELF (CDR SELF)))))) ++ (DRAW-BLACK-WHITE ITEMS NEWVAL W OFFSETX OFFSETY SIZEX SIZEY) ++ NEWVAL)) ++ ++(DEFUN DRAW-INTEGER (VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) ++ (EDITORS-ANYTHING-PRINT VAL W OFFSETX OFFSETY SIZEX SIZEY)) ++ ++(DEFUN DRAW-REAL (VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (STR NC LNG FMT) ++ (IF (NULL SIZEX) (SETQ SIZEX 50)) ++ (SETQ NC (MAX 1 (TRUNCATE SIZEX 7))) ++ (SETQ STR (PRINC-TO-STRING VAL)) ++ (SETQ LNG (LENGTH STR)) ++ (IF (> LNG NC) ++ (IF (OR (FIND #\. STR :START NC) (FIND #\E STR) (FIND #\L STR)) ++ (IF (>= NC 8) ++ (PROGN ++ (SETQ FMT ++ (CADR (OR (ASSOC NC ++ '((8 "~8,2E") (9 "~9,2E") ++ (10 "~10,2E") (11 "~11,2E") ++ (12 "~12,2E") (13 "~13,2E") ++ (14 "~14,2E"))) ++ '(15 "~15,2E")))) ++ (SETQ STR (FORMAT NIL FMT VAL))) ++ (SETQ STR "*******")) ++ (SETQ STR (SUBSEQ STR 0 NC)))) ++ (EDITORS-ANYTHING-PRINT W STR OFFSETX OFFSETY SIZEX SIZEY))) ++ ++(DEFUN EDITORS-ANYTHING-PRINT (OBJ W OFFSETX OFFSETY SIZEX SIZEY) ++ (LET (SWIDTH SMAX DX DY) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX ++ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) ++ (SETQ SWIDTH ++ (LET ((SSTR (STRINGIFY (STRINGIFY OBJ)))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ (SETQ SMAX (MIN SWIDTH SIZEX)) ++ (SETQ DX (* 1/2 (- SIZEX SMAX))) ++ (SETQ DY (MAX 0 (+ -5 (* 1/2 SIZEY)))) ++ (LET ((SSTR (STRINGIFY (EDITORS-STRING-LIMIT OBJ W SMAX)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) ++ (+ OFFSETX DX) (- (CADDDR W) (+ OFFSETY DY)) ++ (GET-C-STRING SSTR) (LENGTH SSTR))))) ++ ++(DEFUN EDITORS-PRINT-IN-BOX (OBJ W OFFSETX OFFSETY SIZEX SIZEY) ++ (LET ((SSTR (STRINGIFY (EDITORS-STRING-LIMIT OBJ W SIZEX)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) ++ (- (CADDDR W) (+ OFFSETY (+ -5 (* 1/2 SIZEY)))) ++ (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (WINDOW-DRAW-BOX-XY W OFFSETX OFFSETY SIZEX SIZEY)) ++ ++(DEFUN EDITORS-UPDATE-IN-BOX (OBJ W OFFSETX OFFSETY SIZEX SIZEY) ++ (LET ((GLVAR229 (+ -6 SIZEY))) ++ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) (+ 3 OFFSETX) ++ (- (CADDDR W) (1- (+ (+ 3 OFFSETY) GLVAR229))) (+ -6 SIZEX) ++ GLVAR229 0)) ++ (LET ((SSTR (STRINGIFY (EDITORS-STRING-LIMIT OBJ W SIZEX)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) ++ (- (CADDDR W) (+ OFFSETY (+ -5 (* 1/2 SIZEY)))) ++ (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ ++(DEFUN EDITORS-STRING-LIMIT (S W MAX) ++ (LET ((STR (STRINGIFY S)) LNG NC) ++ (SETQ LNG ++ (LET ((SSTR (STRINGIFY STR))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ (IF (> LNG MAX) ++ (PROGN ++ (SETQ NC (/ (* (LENGTH STR) MAX) LNG)) ++ (SUBSEQ STR 0 NC)) ++ STR))) ++(SETF (GET 'EDITORS-STRING-LIMIT 'GLARGUMENTS) ++ '((S STRING) (W WINDOW) (MAX INTEGER))) ++(SETF (GET 'EDITORS-STRING-LIMIT 'GLFNRESULTTYPE) 'STRING) ++ ++ ++(DEFVAR *EDIT-COLOR-MENU-SET* NIL) ++ ++(DEFVAR *EDIT-COLOR-RMENU* NIL) ++ ++(DEFVAR *EDIT-COLOR-OLD-COLOR* NIL) ++ ++(DEFVAR *EDIT-COLOR-MENU-SET*) ++(SETF (GET '*EDIT-COLOR-MENU-SET* 'GLISPGLOBALVAR) T) ++(SETF (GET '*EDIT-COLOR-MENU-SET* 'GLISPGLOBALVARTYPE) 'MENU-SET) ++(DEFVAR *EDIT-COLOR-RMENU*) ++(SETF (GET '*EDIT-COLOR-RMENU* 'GLISPGLOBALVAR) T) ++(SETF (GET '*EDIT-COLOR-RMENU* 'GLISPGLOBALVARTYPE) 'BARMENU) ++ ++ ++(DEFUN EDIT-COLOR-INIT (W) ++ (LET (RM GM BM RGB) ++ (SETQ RGB (COPY-LIST '(0 0 0))) ++ (GLCC 'EDIT-COLOR-RED) ++ (GLCC 'EDIT-COLOR-GREEN) ++ (GLCC 'EDIT-COLOR-BLUE) ++ (SETQ *EDIT-COLOR-MENU-SET* (MENU-SET-CREATE W NIL)) ++ (SETQ RM ++ (BARMENU-CREATE 256 200 10 "" NIL #'EDIT-COLOR-RED (LIST RGB) ++ W 120 40 NIL T (COPY-LIST '(65535 0 0)))) ++ (SETQ *EDIT-COLOR-RMENU* RM) ++ (SETQ GM ++ (BARMENU-CREATE 256 50 10 "" NIL #'EDIT-COLOR-GREEN ++ (LIST RGB) W 170 40 NIL T (COPY-LIST '(0 65535 0)))) ++ (SETQ BM ++ (BARMENU-CREATE 256 250 10 "" NIL #'EDIT-COLOR-BLUE ++ (LIST RGB) W 220 40 NIL T (COPY-LIST '(0 0 65535)))) ++ (MENU-SET-ADD-BARMENU *EDIT-COLOR-MENU-SET* 'RED NIL RM "Red" ++ '(120 40)) ++ (MENU-SET-ADD-BARMENU *EDIT-COLOR-MENU-SET* 'GREEN NIL GM "Green" ++ '(170 40)) ++ (MENU-SET-ADD-BARMENU *EDIT-COLOR-MENU-SET* 'BLUE NIL BM "Blue" ++ '(220 40)) ++ (MENU-SET-ADD-MENU *EDIT-COLOR-MENU-SET* 'DONE NIL "" ++ '(("Done" . DONE)) '(30 150)) ++ (EDIT-COLOR-RED 200 RGB) ++ (EDIT-COLOR-GREEN 50 RGB) ++ (EDIT-COLOR-BLUE 250 RGB))) ++ ++(DEFUN EDIT-COLOR-RED (VAL COLOR) ++ (LET ((W (CADR *EDIT-COLOR-MENU-SET*))) ++ (LET ((SSTR (STRINGIFY (FORMAT NIL "~3D" VAL)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) 113 ++ (+ -20 (CADDDR W)) (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (SETF (CAR COLOR) (MAX 0 (1- (* 256 VAL)))) ++ (EDIT-DISPLAY-COLOR W COLOR))) ++ ++(DEFUN EDIT-COLOR-GREEN (VAL COLOR) ++ (LET ((W (CADR *EDIT-COLOR-MENU-SET*))) ++ (LET ((SSTR (STRINGIFY (FORMAT NIL "~3D" VAL)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) 163 ++ (+ -20 (CADDDR W)) (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (SETF (CADR COLOR) (MAX 0 (1- (* 256 VAL)))) ++ (EDIT-DISPLAY-COLOR W COLOR))) ++ ++(DEFUN EDIT-COLOR-BLUE (VAL COLOR) ++ (LET ((W (CADR *EDIT-COLOR-MENU-SET*))) ++ (LET ((SSTR (STRINGIFY (FORMAT NIL "~3D" VAL)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) 213 ++ (+ -20 (CADDDR W)) (GET-C-STRING SSTR) (LENGTH SSTR))) ++ (SETF (CADDR COLOR) (MAX 0 (1- (* 256 VAL)))) ++ (EDIT-DISPLAY-COLOR W COLOR))) ++ ++(DEFUN EDIT-DISPLAY-COLOR (W COLOR) ++ (WINDOW-SET-COLOR W COLOR) ++ (WINDOW-DRAW-LINE-XY W 50 40 50 100 60) ++ (WINDOW-RESET-COLOR W) ++ (IF *EDIT-COLOR-OLD-COLOR* ++ (WINDOW-FREE-COLOR W *EDIT-COLOR-OLD-COLOR*)) ++ (SETQ *EDIT-COLOR-OLD-COLOR* *WINDOW-XCOLOR*)) ++ ++(DEFUN EDIT-COLOR (W) ++ (LET (DONE COLOR SEL) ++ (IF (OR (NULL *EDIT-COLOR-MENU-SET*) ++ (NOT (EQ W (CADR (CADDR (CAADDR *EDIT-COLOR-MENU-SET*)))))) ++ (EDIT-COLOR-INIT W)) ++ (SETQ COLOR (FIRST (NTH 16 *EDIT-COLOR-RMENU*))) ++ (MENU-SET-DRAW *EDIT-COLOR-MENU-SET*) ++ (EDIT-COLOR-RED (TRUNCATE (1+ (CAR COLOR)) 256) COLOR) ++ (EDIT-COLOR-GREEN (TRUNCATE (1+ (CADR COLOR)) 256) COLOR) ++ (EDIT-COLOR-BLUE (TRUNCATE (1+ (CADDR COLOR)) 256) COLOR) ++ (WHILE (NOT DONE) ++ (SETQ SEL (MENU-SET-SELECT *EDIT-COLOR-MENU-SET*)) ++ (SETQ DONE (AND SEL (EQ (FIRST SEL) 'DONE)))) ++ COLOR)) ++(SETF (GET 'EDIT-COLOR 'GLARGUMENTS) '((W WINDOW))) ++(SETF (GET 'EDIT-COLOR 'GLFNRESULTTYPE) 'RGB) ++ ++ ++(DEFUN COLOR-DOT (W X Y COLOR) ++ (LET (RGB) ++ (SETQ RGB ++ (CDR (ASSOC COLOR ++ '((RED 65535 0 0) (YELLOW 65535 57600 0) ++ (GREEN 0 50175 12287) (BLUE 0 0 65535))))) ++ (OR RGB (SETQ RGB '(30000 30000 30000))) ++ (WINDOW-SET-COLOR W RGB) ++ (WINDOW-DRAW-DOT-XY W X Y) ++ (WINDOW-RESET-COLOR W))) ++ ++(DEFUN COMPILE-EDITORS () ++ (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") ++ '("glisp/editors.lsp") "glisp/editorstrans.lsp" "glisp/gpl.txt") ++ (CF EDITORSTRANS)) ++ ++(DEFUN COMPILE-EDITORSB () ++ (GLCOMPFILES *DIRECTORY* ++ '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") ++ '("glisp/editors.lsp") "glisp/editorstrans.lsp" "glisp/gpl.txt")) +--- gcl-2.6.7.orig/xgcl-2/general-c.c ++++ gcl-2.6.7/xgcl-2/general-c.c +@@ -1,5 +1,5 @@ +-/* general-c.c Hiep Huu Nguyen 27 Aug 92 */ +- ++/* general-c.c Hiep Huu Nguyen 24 Jun 06 */ ++/* 27 Aug 92; 24 Jan 06; 22 Jun 06 */ + /* ; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. + + ; See the files gnu.license and dec.copyright . +@@ -21,101 +21,45 @@ + ; Some of the files that interface to the Xlib are adapted from DEC/MIT files. + ; See the file dec.copyright for details. */ + +-#include +-#include +-#include +-#include +-#include +- +- +-int char_array(size) +-int size; +-{ +- return ((int) calloc (size, sizeof(char))); +-} +- +-char char_pos (array, pos) +-char* array; +-int pos; +-{ +- return (array[pos]); +-} +- ++/* 24 Jan 06: edited by G. Novak to remove vertex_array functions, ++ remove includes, change function arg lists to new form */ ++/* 22 Jun 06: edited by G. Novak to be compatible with 64-bit machines */ + +-int int_array(size) +-int size; +-{ +- return ((int) calloc (size, sizeof(int))); ++#include ++#define fixnum long ++fixnum char_array(int size) { ++ return ((fixnum) calloc (size, sizeof(char))); + } + +- +- +-int int_pos (array, pos) +-int* array; +-int pos; +-{ ++char char_pos (char* array, int pos) { + return (array[pos]); + } + +- +-void set_char_array (array, pos, val) +-char* array; +-int pos; +-char val; +-{ +-array[pos] = val; ++void set_char_array (char* array, int pos, char val) { ++ array[pos] = val; + } + +-void set_int_array (array, pos, val) +-int* array; +-int pos; +-int val; +-{ +-array[pos] = val; ++fixnum int_array(int size) { ++ return ((fixnum) calloc (size, sizeof(int))); + } + +- +- +- +-int vertex_array (size) +-int size; +-{ +- return ((int) calloc (size, sizeof(Vertex))); +- ++int int_pos (int* array, int pos) { ++ return (array[pos]); + } + +-int vertex_pos_x (array, pos) +-Vertex* array; +-int pos; +-{ +- return ((int) array[pos].x); ++void set_int_array (int* array, int pos, int val) { ++ array[pos] = val; + } + +-int vertex_pos_y (array, pos) +-Vertex* array; +-int pos; +-{ +- return ((int) array[pos].y); ++fixnum fixnum_array(int size) { ++ return ((fixnum) calloc (size, sizeof(fixnum))); + } + +-int vertex_pos_flag (array, pos) +-Vertex* array; +-int pos; +-{ +- return ((int) array[pos].flags); ++fixnum fixnum_pos (fixnum* array, int pos) { ++ return (array[pos]); + } + +- +- +- +-void set_vertex_array (array, pos, x, y, flag) +-Vertex* array; +-int pos; +-int x, y; +-int flag; +-{ +- array[pos].x = x; +- array[pos].y = y; +- array[pos].flags = flag; +- ++void set_fixnum_array (fixnum* array, int pos, fixnum val) { ++ array[pos] = val; + } ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_Xstruct.lsp +@@ -0,0 +1,311 @@ ++(in-package :XLIB) ++; Xstruct.lsp Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++ ++ ++ ++;;;;;; _XQEvent funcions ;;;;;; ++ ++(defentry make-_XQEvent () ( fixnum "make__XQEvent" )) ++(defentry _XQEvent-event (fixnum) ( fixnum "_XQEvent_event" )) ++(defentry set-_XQEvent-event (fixnum fixnum) ( void "set__XQEvent_event" )) ++(defentry _XQEvent-next (fixnum) ( fixnum "_XQEvent_next" )) ++(defentry set-_XQEvent-next (fixnum fixnum) ( void "set__XQEvent_next" )) ++ ++ ++;;;;;; XCharStruct funcions ;;;;;; ++ ++(defentry make-XCharStruct () ( fixnum "make_XCharStruct" )) ++(defentry XCharStruct-attributes (fixnum) ( fixnum "XCharStruct_attributes" )) ++(defentry set-XCharStruct-attributes (fixnum fixnum) ( void "set_XCharStruct_attributes" )) ++(defentry XCharStruct-descent (fixnum) ( fixnum "XCharStruct_descent" )) ++(defentry set-XCharStruct-descent (fixnum fixnum) ( void "set_XCharStruct_descent" )) ++(defentry XCharStruct-ascent (fixnum) ( fixnum "XCharStruct_ascent" )) ++(defentry set-XCharStruct-ascent (fixnum fixnum) ( void "set_XCharStruct_ascent" )) ++(defentry XCharStruct-width (fixnum) ( fixnum "XCharStruct_width" )) ++(defentry set-XCharStruct-width (fixnum fixnum) ( void "set_XCharStruct_width" )) ++(defentry XCharStruct-rbearing (fixnum) ( fixnum "XCharStruct_rbearing" )) ++(defentry set-XCharStruct-rbearing (fixnum fixnum) ( void "set_XCharStruct_rbearing" )) ++(defentry XCharStruct-lbearing (fixnum) ( fixnum "XCharStruct_lbearing" )) ++(defentry set-XCharStruct-lbearing (fixnum fixnum) ( void "set_XCharStruct_lbearing" )) ++ ++ ++;;;;;; XFontProp funcions ;;;;;; ++ ++(defentry make-XFontProp () ( fixnum "make_XFontProp" )) ++(defentry XFontProp-card32 (fixnum) ( fixnum "XFontProp_card32" )) ++(defentry set-XFontProp-card32 (fixnum fixnum) ( void "set_XFontProp_card32" )) ++(defentry XFontProp-name (fixnum) ( fixnum "XFontProp_name" )) ++(defentry set-XFontProp-name (fixnum fixnum) ( void "set_XFontProp_name" )) ++ ++ ++;;;;;; XFontStruct funcions ;;;;;; ++ ++(defentry make-XFontStruct () ( fixnum "make_XFontStruct" )) ++(defentry XFontStruct-descent (fixnum) ( fixnum "XFontStruct_descent" )) ++(defentry set-XFontStruct-descent (fixnum fixnum) ( void "set_XFontStruct_descent" )) ++(defentry XFontStruct-ascent (fixnum) ( fixnum "XFontStruct_ascent" )) ++(defentry set-XFontStruct-ascent (fixnum fixnum) ( void "set_XFontStruct_ascent" )) ++(defentry XFontStruct-per_char (fixnum) ( fixnum "XFontStruct_per_char" )) ++(defentry set-XFontStruct-per_char (fixnum fixnum) ( void "set_XFontStruct_per_char" )) ++(defentry XFontStruct-max_bounds (fixnum) ( fixnum "XFontStruct_max_bounds" )) ++(defentry set-XFontStruct-max_bounds (fixnum fixnum) ( void "set_XFontStruct_max_bounds" )) ++(defentry XFontStruct-min_bounds (fixnum) ( fixnum "XFontStruct_min_bounds" )) ++(defentry set-XFontStruct-min_bounds (fixnum fixnum) ( void "set_XFontStruct_min_bounds" )) ++(defentry XFontStruct-properties (fixnum) ( fixnum "XFontStruct_properties" )) ++(defentry set-XFontStruct-properties (fixnum fixnum) ( void "set_XFontStruct_properties" )) ++(defentry XFontStruct-n_properties (fixnum) ( fixnum "XFontStruct_n_properties" )) ++(defentry set-XFontStruct-n_properties (fixnum fixnum) ( void "set_XFontStruct_n_properties" )) ++(defentry XFontStruct-default_char (fixnum) ( fixnum "XFontStruct_default_char" )) ++(defentry set-XFontStruct-default_char (fixnum fixnum) ( void "set_XFontStruct_default_char" )) ++(defentry XFontStruct-all_chars_exist (fixnum) ( fixnum "XFontStruct_all_chars_exist" )) ++(defentry set-XFontStruct-all_chars_exist (fixnum fixnum) ( void "set_XFontStruct_all_chars_exist" )) ++(defentry XFontStruct-max_byte1 (fixnum) ( fixnum "XFontStruct_max_byte1" )) ++(defentry set-XFontStruct-max_byte1 (fixnum fixnum) ( void "set_XFontStruct_max_byte1" )) ++(defentry XFontStruct-min_byte1 (fixnum) ( fixnum "XFontStruct_min_byte1" )) ++(defentry set-XFontStruct-min_byte1 (fixnum fixnum) ( void "set_XFontStruct_min_byte1" )) ++(defentry XFontStruct-max_char_or_byte2 (fixnum) ( fixnum "XFontStruct_max_char_or_byte2" )) ++(defentry set-XFontStruct-max_char_or_byte2 (fixnum fixnum) ( void "set_XFontStruct_max_char_or_byte2" )) ++(defentry XFontStruct-min_char_or_byte2 (fixnum) ( fixnum "XFontStruct_min_char_or_byte2" )) ++(defentry set-XFontStruct-min_char_or_byte2 (fixnum fixnum) ( void "set_XFontStruct_min_char_or_byte2" )) ++(defentry XFontStruct-direction (fixnum) ( fixnum "XFontStruct_direction" )) ++(defentry set-XFontStruct-direction (fixnum fixnum) ( void "set_XFontStruct_direction" )) ++(defentry XFontStruct-fid (fixnum) ( fixnum "XFontStruct_fid" )) ++(defentry set-XFontStruct-fid (fixnum fixnum) ( void "set_XFontStruct_fid" )) ++(defentry XFontStruct-ext_data (fixnum) ( fixnum "XFontStruct_ext_data" )) ++(defentry set-XFontStruct-ext_data (fixnum fixnum) ( void "set_XFontStruct_ext_data" )) ++ ++ ++;;;;;; XTextItem funcions ;;;;;; ++ ++(defentry make-XTextItem () ( fixnum "make_XTextItem" )) ++(defentry XTextItem-font (fixnum) ( fixnum "XTextItem_font" )) ++(defentry set-XTextItem-font (fixnum fixnum) ( void "set_XTextItem_font" )) ++(defentry XTextItem-delta (fixnum) ( fixnum "XTextItem_delta" )) ++(defentry set-XTextItem-delta (fixnum fixnum) ( void "set_XTextItem_delta" )) ++(defentry XTextItem-nchars (fixnum) ( fixnum "XTextItem_nchars" )) ++(defentry set-XTextItem-nchars (fixnum fixnum) ( void "set_XTextItem_nchars" )) ++(defentry XTextItem-chars (fixnum) ( fixnum "XTextItem_chars" )) ++(defentry set-XTextItem-chars (fixnum fixnum) ( void "set_XTextItem_chars" )) ++ ++ ++;;;;;; XChar2b funcions ;;;;;; ++ ++(defentry make-XChar2b () ( fixnum "make_XChar2b" )) ++(defentry XChar2b-byte2 (fixnum) ( char "XChar2b_byte2" )) ++(defentry set-XChar2b-byte2 (fixnum char) ( void "set_XChar2b_byte2" )) ++(defentry XChar2b-byte1 (fixnum) ( char "XChar2b_byte1" )) ++(defentry set-XChar2b-byte1 (fixnum char) ( void "set_XChar2b_byte1" )) ++ ++ ++;;;;;; XTextItem16 funcions ;;;;;; ++ ++(defentry make-XTextItem16 () ( fixnum "make_XTextItem16" )) ++(defentry XTextItem16-font (fixnum) ( fixnum "XTextItem16_font" )) ++(defentry set-XTextItem16-font (fixnum fixnum) ( void "set_XTextItem16_font" )) ++(defentry XTextItem16-delta (fixnum) ( fixnum "XTextItem16_delta" )) ++(defentry set-XTextItem16-delta (fixnum fixnum) ( void "set_XTextItem16_delta" )) ++(defentry XTextItem16-nchars (fixnum) ( fixnum "XTextItem16_nchars" )) ++(defentry set-XTextItem16-nchars (fixnum fixnum) ( void "set_XTextItem16_nchars" )) ++(defentry XTextItem16-chars (fixnum) ( fixnum "XTextItem16_chars" )) ++(defentry set-XTextItem16-chars (fixnum fixnum) ( void "set_XTextItem16_chars" )) ++ ++ ++;;;;;; XEDataObject funcions ;;;;;; ++ ++(defentry make-XEDataObject () ( fixnum "make_XEDataObject" )) ++(defentry XEDataObject-font (fixnum) ( fixnum "XEDataObject_font" )) ++(defentry set-XEDataObject-font (fixnum fixnum) ( void "set_XEDataObject_font" )) ++(defentry XEDataObject-pixmap_format (fixnum) ( fixnum "XEDataObject_pixmap_format" )) ++(defentry set-XEDataObject-pixmap_format (fixnum fixnum) ( void "set_XEDataObject_pixmap_format" )) ++(defentry XEDataObject-screen (fixnum) ( fixnum "XEDataObject_screen" )) ++(defentry set-XEDataObject-screen (fixnum fixnum) ( void "set_XEDataObject_screen" )) ++(defentry XEDataObject-visual (fixnum) ( fixnum "XEDataObject_visual" )) ++(defentry set-XEDataObject-visual (fixnum fixnum) ( void "set_XEDataObject_visual" )) ++(defentry XEDataObject-gc (fixnum) ( fixnum "XEDataObject_gc" )) ++(defentry set-XEDataObject-gc (fixnum fixnum) ( void "set_XEDataObject_gc" )) ++ ++ ++;;;;;; XSizeHints funcions ;;;;;; ++ ++(defentry make-XSizeHints () ( fixnum "make_XSizeHints" )) ++(defentry XSizeHints-win_gravity (fixnum) ( fixnum "XSizeHints_win_gravity" )) ++(defentry set-XSizeHints-win_gravity (fixnum fixnum) ( void "set_XSizeHints_win_gravity" )) ++(defentry XSizeHints-base_height (fixnum) ( fixnum "XSizeHints_base_height" )) ++(defentry set-XSizeHints-base_height (fixnum fixnum) ( void "set_XSizeHints_base_height" )) ++(defentry XSizeHints-base_width (fixnum) ( fixnum "XSizeHints_base_width" )) ++(defentry set-XSizeHints-base_width (fixnum fixnum) ( void "set_XSizeHints_base_width" )) ++ ++(defentry XSizeHints-max_aspect_x (fixnum) ( fixnum "XSizeHints_max_aspect_x" )) ++(defentry set-XSizeHints-max_aspect_x (fixnum fixnum) ( void "set_XSizeHints_max_aspect_x" )) ++(defentry XSizeHints-max_aspect_y (fixnum) ( fixnum "XSizeHints_max_aspect_y" )) ++(defentry set-XSizeHints-max_aspect_y (fixnum fixnum) ( void "set_XSizeHints_max_aspect_y" )) ++(defentry XSizeHints-min_aspect_x (fixnum) ( fixnum "XSizeHints_min_aspect_x" )) ++(defentry set-XSizeHints-min_aspect_x (fixnum fixnum) ( void "set_XSizeHints_min_aspect_x" )) ++(defentry XSizeHints-min_aspect_y (fixnum) ( fixnum "XSizeHints_min_aspect_y" )) ++(defentry set-XSizeHints-min_aspect_y (fixnum fixnum) ( void "set_XSizeHints_min_aspect_y" )) ++ ++(defentry XSizeHints-height_inc (fixnum) ( fixnum "XSizeHints_height_inc" )) ++(defentry set-XSizeHints-height_inc (fixnum fixnum) ( void "set_XSizeHints_height_inc" )) ++(defentry XSizeHints-width_inc (fixnum) ( fixnum "XSizeHints_width_inc" )) ++(defentry set-XSizeHints-width_inc (fixnum fixnum) ( void "set_XSizeHints_width_inc" )) ++(defentry XSizeHints-max_height (fixnum) ( fixnum "XSizeHints_max_height" )) ++(defentry set-XSizeHints-max_height (fixnum fixnum) ( void "set_XSizeHints_max_height" )) ++(defentry XSizeHints-max_width (fixnum) ( fixnum "XSizeHints_max_width" )) ++(defentry set-XSizeHints-max_width (fixnum fixnum) ( void "set_XSizeHints_max_width" )) ++(defentry XSizeHints-min_height (fixnum) ( fixnum "XSizeHints_min_height" )) ++(defentry set-XSizeHints-min_height (fixnum fixnum) ( void "set_XSizeHints_min_height" )) ++(defentry XSizeHints-min_width (fixnum) ( fixnum "XSizeHints_min_width" )) ++(defentry set-XSizeHints-min_width (fixnum fixnum) ( void "set_XSizeHints_min_width" )) ++(defentry XSizeHints-height (fixnum) ( fixnum "XSizeHints_height" )) ++(defentry set-XSizeHints-height (fixnum fixnum) ( void "set_XSizeHints_height" )) ++(defentry XSizeHints-width (fixnum) ( fixnum "XSizeHints_width" )) ++(defentry set-XSizeHints-width (fixnum fixnum) ( void "set_XSizeHints_width" )) ++(defentry XSizeHints-y (fixnum) ( fixnum "XSizeHints_y" )) ++(defentry set-XSizeHints-y (fixnum fixnum) ( void "set_XSizeHints_y" )) ++(defentry XSizeHints-x (fixnum) ( fixnum "XSizeHints_x" )) ++(defentry set-XSizeHints-x (fixnum fixnum) ( void "set_XSizeHints_x" )) ++(defentry XSizeHints-flags (fixnum) ( fixnum "XSizeHints_flags" )) ++(defentry set-XSizeHints-flags (fixnum fixnum) ( void "set_XSizeHints_flags" )) ++ ++ ++;;;;;; XWMHints funcions ;;;;;; ++ ++(defentry make-XWMHints () ( fixnum "make_XWMHints" )) ++(defentry XWMHints-window_group (fixnum) ( fixnum "XWMHints_window_group" )) ++(defentry set-XWMHints-window_group (fixnum fixnum) ( void "set_XWMHints_window_group" )) ++(defentry XWMHints-icon_mask (fixnum) ( fixnum "XWMHints_icon_mask" )) ++(defentry set-XWMHints-icon_mask (fixnum fixnum) ( void "set_XWMHints_icon_mask" )) ++(defentry XWMHints-icon_y (fixnum) ( fixnum "XWMHints_icon_y" )) ++(defentry set-XWMHints-icon_y (fixnum fixnum) ( void "set_XWMHints_icon_y" )) ++(defentry XWMHints-icon_x (fixnum) ( fixnum "XWMHints_icon_x" )) ++(defentry set-XWMHints-icon_x (fixnum fixnum) ( void "set_XWMHints_icon_x" )) ++(defentry XWMHints-icon_window (fixnum) ( fixnum "XWMHints_icon_window" )) ++(defentry set-XWMHints-icon_window (fixnum fixnum) ( void "set_XWMHints_icon_window" )) ++(defentry XWMHints-icon_pixmap (fixnum) ( fixnum "XWMHints_icon_pixmap" )) ++(defentry set-XWMHints-icon_pixmap (fixnum fixnum) ( void "set_XWMHints_icon_pixmap" )) ++(defentry XWMHints-initial_state (fixnum) ( fixnum "XWMHints_initial_state" )) ++(defentry set-XWMHints-initial_state (fixnum fixnum) ( void "set_XWMHints_initial_state" )) ++(defentry XWMHints-input (fixnum) ( fixnum "XWMHints_input" )) ++(defentry set-XWMHints-input (fixnum fixnum) ( void "set_XWMHints_input" )) ++(defentry XWMHints-flags (fixnum) ( fixnum "XWMHints_flags" )) ++(defentry set-XWMHints-flags (fixnum fixnum) ( void "set_XWMHints_flags" )) ++ ++ ++;;;;;; XTextProperty funcions ;;;;;; ++ ++(defentry make-XTextProperty () ( fixnum "make_XTextProperty" )) ++(defentry XTextProperty-nitems (fixnum) ( fixnum "XTextProperty_nitems" )) ++(defentry set-XTextProperty-nitems (fixnum fixnum) ( void "set_XTextProperty_nitems" )) ++(defentry XTextProperty-format (fixnum) ( fixnum "XTextProperty_format" )) ++(defentry set-XTextProperty-format (fixnum fixnum) ( void "set_XTextProperty_format" )) ++(defentry XTextProperty-encoding (fixnum) ( fixnum "XTextProperty_encoding" )) ++(defentry set-XTextProperty-encoding (fixnum fixnum) ( void "set_XTextProperty_encoding" )) ++(defentry XTextProperty-value (fixnum) ( fixnum "XTextProperty_value" )) ++(defentry set-XTextProperty-value (fixnum fixnum) ( void "set_XTextProperty_value" )) ++ ++ ++;;;;;; XIconSize funcions ;;;;;; ++ ++(defentry make-XIconSize () ( fixnum "make_XIconSize" )) ++(defentry XIconSize-height_inc (fixnum) ( fixnum "XIconSize_height_inc" )) ++(defentry set-XIconSize-height_inc (fixnum fixnum) ( void "set_XIconSize_height_inc" )) ++(defentry XIconSize-width_inc (fixnum) ( fixnum "XIconSize_width_inc" )) ++(defentry set-XIconSize-width_inc (fixnum fixnum) ( void "set_XIconSize_width_inc" )) ++(defentry XIconSize-max_height (fixnum) ( fixnum "XIconSize_max_height" )) ++(defentry set-XIconSize-max_height (fixnum fixnum) ( void "set_XIconSize_max_height" )) ++(defentry XIconSize-max_width (fixnum) ( fixnum "XIconSize_max_width" )) ++(defentry set-XIconSize-max_width (fixnum fixnum) ( void "set_XIconSize_max_width" )) ++(defentry XIconSize-min_height (fixnum) ( fixnum "XIconSize_min_height" )) ++(defentry set-XIconSize-min_height (fixnum fixnum) ( void "set_XIconSize_min_height" )) ++(defentry XIconSize-min_width (fixnum) ( fixnum "XIconSize_min_width" )) ++(defentry set-XIconSize-min_width (fixnum fixnum) ( void "set_XIconSize_min_width" )) ++ ++ ++;;;;;; XClassHint funcions ;;;;;; ++ ++(defentry make-XClassHint () ( fixnum "make_XClassHint" )) ++(defentry XClassHint-res_class (fixnum) ( fixnum "XClassHint_res_class" )) ++(defentry set-XClassHint-res_class (fixnum fixnum) ( void "set_XClassHint_res_class" )) ++(defentry XClassHint-res_name (fixnum) ( fixnum "XClassHint_res_name" )) ++(defentry set-XClassHint-res_name (fixnum fixnum) ( void "set_XClassHint_res_name" )) ++ ++ ++;;;;;; XComposeStatus funcions ;;;;;; ++ ++(defentry make-XComposeStatus () ( fixnum "make_XComposeStatus" )) ++(defentry XComposeStatus-chars_matched (fixnum) ( fixnum "XComposeStatus_chars_matched" )) ++(defentry set-XComposeStatus-chars_matched (fixnum fixnum) ( void "set_XComposeStatus_chars_matched" )) ++(defentry XComposeStatus-compose_ptr (fixnum) ( fixnum "XComposeStatus_compose_ptr" )) ++(defentry set-XComposeStatus-compose_ptr (fixnum fixnum) ( void "set_XComposeStatus_compose_ptr" )) ++ ++ ++;;;;;; XVisualInfo funcions ;;;;;; ++ ++(defentry make-XVisualInfo () ( fixnum "make_XVisualInfo" )) ++(defentry XVisualInfo-bits_per_rgb (fixnum) ( fixnum "XVisualInfo_bits_per_rgb" )) ++(defentry set-XVisualInfo-bits_per_rgb (fixnum fixnum) ( void "set_XVisualInfo_bits_per_rgb" )) ++(defentry XVisualInfo-colormap_size (fixnum) ( fixnum "XVisualInfo_colormap_size" )) ++(defentry set-XVisualInfo-colormap_size (fixnum fixnum) ( void "set_XVisualInfo_colormap_size" )) ++(defentry XVisualInfo-blue_mask (fixnum) ( fixnum "XVisualInfo_blue_mask" )) ++(defentry set-XVisualInfo-blue_mask (fixnum fixnum) ( void "set_XVisualInfo_blue_mask" )) ++(defentry XVisualInfo-green_mask (fixnum) ( fixnum "XVisualInfo_green_mask" )) ++(defentry set-XVisualInfo-green_mask (fixnum fixnum) ( void "set_XVisualInfo_green_mask" )) ++(defentry XVisualInfo-red_mask (fixnum) ( fixnum "XVisualInfo_red_mask" )) ++(defentry set-XVisualInfo-red_mask (fixnum fixnum) ( void "set_XVisualInfo_red_mask" )) ++(defentry XVisualInfo-class (fixnum) ( fixnum "XVisualInfo_class" )) ++(defentry set-XVisualInfo-class (fixnum fixnum) ( void "set_XVisualInfo_class" )) ++(defentry XVisualInfo-depth (fixnum) ( fixnum "XVisualInfo_depth" )) ++(defentry set-XVisualInfo-depth (fixnum fixnum) ( void "set_XVisualInfo_depth" )) ++(defentry XVisualInfo-screen (fixnum) ( fixnum "XVisualInfo_screen" )) ++(defentry set-XVisualInfo-screen (fixnum fixnum) ( void "set_XVisualInfo_screen" )) ++(defentry XVisualInfo-visualid (fixnum) ( fixnum "XVisualInfo_visualid" )) ++(defentry set-XVisualInfo-visualid (fixnum fixnum) ( void "set_XVisualInfo_visualid" )) ++(defentry XVisualInfo-visual (fixnum) ( fixnum "XVisualInfo_visual" )) ++(defentry set-XVisualInfo-visual (fixnum fixnum) ( void "set_XVisualInfo_visual" )) ++ ++ ++;;;;;; XStandardColormap funcions ;;;;;; ++ ++(defentry make-XStandardColormap () ( fixnum "make_XStandardColormap" )) ++(defentry XStandardColormap-killid (fixnum) ( fixnum "XStandardColormap_killid" )) ++(defentry set-XStandardColormap-killid (fixnum fixnum) ( void "set_XStandardColormap_killid" )) ++(defentry XStandardColormap-visualid (fixnum) ( fixnum "XStandardColormap_visualid" )) ++(defentry set-XStandardColormap-visualid (fixnum fixnum) ( void "set_XStandardColormap_visualid" )) ++(defentry XStandardColormap-base_pixel (fixnum) ( fixnum "XStandardColormap_base_pixel" )) ++(defentry set-XStandardColormap-base_pixel (fixnum fixnum) ( void "set_XStandardColormap_base_pixel" )) ++(defentry XStandardColormap-blue_mult (fixnum) ( fixnum "XStandardColormap_blue_mult" )) ++(defentry set-XStandardColormap-blue_mult (fixnum fixnum) ( void "set_XStandardColormap_blue_mult" )) ++(defentry XStandardColormap-blue_max (fixnum) ( fixnum "XStandardColormap_blue_max" )) ++(defentry set-XStandardColormap-blue_max (fixnum fixnum) ( void "set_XStandardColormap_blue_max" )) ++(defentry XStandardColormap-green_mult (fixnum) ( fixnum "XStandardColormap_green_mult" )) ++(defentry set-XStandardColormap-green_mult (fixnum fixnum) ( void "set_XStandardColormap_green_mult" )) ++(defentry XStandardColormap-green_max (fixnum) ( fixnum "XStandardColormap_green_max" )) ++(defentry set-XStandardColormap-green_max (fixnum fixnum) ( void "set_XStandardColormap_green_max" )) ++(defentry XStandardColormap-red_mult (fixnum) ( fixnum "XStandardColormap_red_mult" )) ++(defentry set-XStandardColormap-red_mult (fixnum fixnum) ( void "set_XStandardColormap_red_mult" )) ++(defentry XStandardColormap-red_max (fixnum) ( fixnum "XStandardColormap_red_max" )) ++(defentry set-XStandardColormap-red_max (fixnum fixnum) ( void "set_XStandardColormap_red_max" )) ++(defentry XStandardColormap-colormap (fixnum) ( fixnum "XStandardColormap_colormap" )) ++(defentry set-XStandardColormap-colormap (fixnum fixnum) ( void "set_XStandardColormap_colormap" )) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_menu-settrans.lsp +@@ -0,0 +1,531 @@ ++; 07 Jan 2010 16:46:11 EST ++ ++; menu-settrans.lsp -- translation of menu-set.lsp Gordon S. Novak Jr. ++ ++; Copyright 2006 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; This program 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 program 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 program; if not, write to the Free Software ++; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++(defmacro nconc1 (lst x) `(nconc ,lst (cons ,x nil))) ++ ++(defmacro glmethod (class selector) ++ `(cadr (assoc ,selector (getf (cdr (get ,class 'glstructure)) 'msg))) ) ++ ++(SETF (GET 'MENU-SET 'GLSTRUCTURE) ++ '((LISTOBJECT (WINDOW WINDOW) (MENU-ITEMS (LISTOF MENU-SET-ITEM)) ++ (COMMANDFN ANYTHING)) ++ MSG ++ ((DRAW MENU-SET-DRAW) (SELECT MENU-SET-SELECT) ++ (NAMED-MENU MENU-SET-NAMED-MENU) ++ (NAMED-ITEM MENU-SET-NAMED-ITEM) (ADD-MENU MENU-SET-ADD-MENU) ++ (ADD-PICMENU MENU-SET-ADD-PICMENU) ++ (ADD-COMPONENT MENU-SET-ADD-COMPONENT) ++ (ADD-BARMENU MENU-SET-ADD-BARMENU) ++ (ADD-ITEM MENU-SET-ADD-ITEM) (FIND-ITEM MENU-SET-FIND-ITEM) ++ (DELETE-ITEM MENU-SET-DELETE-ITEM) ++ (REMOVE-ITEMS MENU-SET-REMOVE-ITEMS) ++ (ITEM-POSITION MENU-SET-ITEM-POSITION) (ITEMP MENU-SET-ITEMP) ++ (ADJUST MENU-SET-ADJUST) (MOVE MENU-SET-MOVE) ++ (DRAW-CONN MENU-SET-DRAW-CONN)))) ++(SETF (GET 'MENU-SET-ITEM 'GLSTRUCTURE) ++ '((LIST (MENU-NAME SYMBOL) (SYM ANYTHING) (MENU MENU-SET-MENU)) ++ PROP ++ ((LEFT ((PARENT-OFFSET-X MENU))) ++ (BOTTOM ((PARENT-OFFSET-Y MENU))) ++ (WIDTH ((PICTURE-WIDTH MENU))) ++ (HEIGHT ((PICTURE-HEIGHT MENU)))) ++ SUPERS (REGION))) ++(SETF (GET 'MENU-SET-MENU 'GLSTRUCTURE) ++ '((TRANSPARENT MENU) MSG ((DRAW MENU-MDRAW)))) ++(SETF (GET 'MENU-PORT 'GLSTRUCTURE) ++ '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL)))) ++(SETF (GET 'MENU-SELECTION 'GLSTRUCTURE) ++ '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL) (BUTTON INTEGER)))) ++(SETF (GET 'MENU-SET-CONN 'GLSTRUCTURE) ++ '((LIST (FROM MENU-PORT) (TO MENU-PORT)))) ++(SETF (GET 'MENU-CONNS 'GLSTRUCTURE) ++ '((LISTOBJECT (MENU-SET MENU-SET) ++ (CONNECTIONS (LISTOF MENU-SET-CONN))) ++ PROP ((WINDOW ((WINDOW (MENU-SET SELF))))) MSG ++ ((DRAW MENU-CONNS-DRAW) (REDRAW MENU-CONNS-REDRAW) ++ (MOVE MENU-CONNS-MOVE) (ADD-CONN MENU-CONNS-ADD-CONN) ++ (ADD-ITEM MENU-CONNS-ADD-ITEM OPEN T) ++ (FIND-CONN MENU-CONNS-FIND-CONN) ++ (FIND-ITEM MENU-CONNS-FIND-ITEM) ++ (DELETE-ITEM MENU-CONNS-DELETE-ITEM) ++ (DELETE-CONN MENU-CONNS-DELETE-CONN) ++ (REMOVE-ITEMS MENU-CONNS-REMOVE-ITEMS) ++ (FIND-CONNS MENU-CONNS-FIND-CONNS) ++ (CONNECTED-PORTS MENU-CONNS-CONNECTED-PORTS) ++ (NEW-CONN MENU-CONNS-NEW-CONN) ++ (NAMED-MENU MENU-CONNS-NAMED-MENU) ++ (NAMED-ITEM MENU-CONNS-NAMED-ITEM)))) ++ ++ ++(DEFUN MENU-SET-CREATE (W &OPTIONAL FN) (LIST 'MENU-SET W NIL FN)) ++(SETF (GET 'MENU-SET-CREATE 'GLARGUMENTS) ++ '((W WINDOW) (&OPTIONAL NIL))) ++(SETF (GET 'MENU-SET-CREATE 'GLFNRESULTTYPE) 'MENU-SET) ++ ++ ++(DEFUN MENU-SET-SELECT (MS &OPTIONAL REDRAW ENABLED) ++ (LET (RES RESB ITM SEL LASTX LASTY) ++ (IF REDRAW (MENU-SET-DRAW MS)) ++ (WHILE (NOT (OR RES RESB)) ++ (SETQ ITM ++ (WINDOW-TRACK-MOUSE (CADR MS) ++ #'(LAMBDA (X Y CODE) ++ (OR (AND (PLUSP CODE) (SETQ LASTX X) ++ (SETQ LASTY Y) CODE) ++ (SOME #'(LAMBDA (GLVAR237) ++ (IF ++ (AND ++ (BETWEEN X ++ (FIFTH (CADDR GLVAR237)) ++ (+ (FIFTH (CADDR GLVAR237)) ++ (SEVENTH (CADDR GLVAR237)))) ++ (BETWEEN Y ++ (SIXTH (CADDR GLVAR237)) ++ (+ (SIXTH (CADDR GLVAR237)) ++ (EIGHTH (CADDR GLVAR237))))) ++ GLVAR237)) ++ (CADDR MS)))))) ++ (IF (NUMBERP ITM) ++ (SETQ RESB (LIST (LIST LASTX LASTY) 'BACKGROUND ITM)) ++ (WHEN (OR (ATOM ENABLED) (MEMBER (CAR ITM) ENABLED)) ++ (SETQ SEL (MENU-MSELECT (CADDR ITM) (EQ ENABLED T))) ++ (IF SEL ++ (SETQ RES (LIST SEL (CAR ITM) *WINDOW-MENU-CODE*)) ++ (IF (AND *WINDOW-MENU-CODE* ++ (NOT (ZEROP *WINDOW-MENU-CODE*))) ++ (SETQ RES ++ (LIST NIL (CAR ITM) *WINDOW-MENU-CODE*))))))) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (OR RES RESB))) ++(SETF (GET 'MENU-SET-SELECT 'GLARGUMENTS) ++ '((MS MENU-SET) (&OPTIONAL BOOLEAN) (REDRAW (LISTOF SYMBOL)))) ++(SETF (GET 'MENU-SET-SELECT 'GLFNRESULTTYPE) 'MENU-SELECTION) ++ ++ ++(DEFUN MENU-SET-ADD-MENU (MS NAME SYM TITLE ITEMS &OPTIONAL OFFSET) ++ (LET (MENU) ++ (SETQ MENU ++ (MENU-CREATE ITEMS TITLE (CADR MS) (CAR OFFSET) (CADR OFFSET) ++ T T)) ++ (MENU-INIT MENU) ++ (IF (NOT OFFSET) ++ (SETQ OFFSET ++ (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) ++ (EIGHTH MENU)))) ++ (SETF (FIFTH MENU) (CAR OFFSET)) ++ (SETF (SIXTH MENU) (CADR OFFSET)) ++ (MENU-SET-ADD-ITEM MS NAME SYM MENU))) ++(SETF (GET 'MENU-SET-ADD-MENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) ++ (ITEMS NIL) (&OPTIONAL VECTOR))) ++(SETF (GET 'MENU-SET-ADD-MENU 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-ITEM (MS NAME SYM MENU) ++ (SETF (CADDR MS) (NCONC (CADDR MS) (CONS (LIST NAME SYM MENU) NIL)))) ++(SETF (GET 'MENU-SET-ADD-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) ++(SETF (GET 'MENU-SET-ADD-ITEM 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-REMOVE-ITEMS (MS) (SETF (CADDR MS) NIL)) ++(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLARGUMENTS) '((MS MENU-SET))) ++(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-PICMENU ++ (MS NAME SYM TITLE SPEC &OPTIONAL OFFSET NOBOX) ++ (LET (MENU MAXWIDTH MAXHEIGHT) ++ (IF (AND SPEC (SYMBOLP SPEC)) (SETQ SPEC (GET SPEC 'PICMENU-SPEC))) ++ (SETQ MENU ++ (PICMENU-CREATE-FROM-SPEC SPEC TITLE (CADR MS) (CAR OFFSET) ++ (CADR OFFSET) T T (NOT NOBOX))) ++ (SETQ MAXWIDTH ++ (MAX (IF TITLE (+ 6 (* 9 (LENGTH TITLE))) 0) (CADR SPEC))) ++ (SETQ MAXHEIGHT (+ (IF TITLE 15 0) (CADDR SPEC))) ++ (IF (NOT OFFSET) ++ (SETQ OFFSET ++ (WINDOW-GET-BOX-POSITION (CADR MS) MAXWIDTH MAXHEIGHT))) ++ (SETF (FIFTH MENU) (CAR OFFSET)) ++ (SETF (SIXTH MENU) (CADR OFFSET)) ++ (MENU-SET-ADD-ITEM MS NAME SYM MENU))) ++(SETF (GET 'MENU-SET-ADD-PICMENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) ++ (SPEC PICMENU-SPEC) (&OPTIONAL VECTOR) (OFFSET BOOLEAN))) ++(SETF (GET 'MENU-SET-ADD-PICMENU 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-COMPONENT (MS NAME &OPTIONAL OFFSET) ++ (MENU-SET-ADD-PICMENU MS (MENU-SET-NAME NAME) NAME NIL NAME OFFSET T)) ++(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (&OPTIONAL VECTOR))) ++(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-BARMENU (MS NAME SYM MENU TITLE &OPTIONAL OFFSET) ++ (BARMENU-INIT MENU) ++ (IF (NOT OFFSET) ++ (SETQ OFFSET ++ (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) ++ (EIGHTH MENU)))) ++ (SETF (FIFTH MENU) (CAR OFFSET)) ++ (SETF (SIXTH MENU) (CADR OFFSET)) ++ (MENU-SET-ADD-ITEM MS NAME SYM MENU)) ++(SETF (GET 'MENU-SET-ADD-BARMENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU BARMENU) ++ (TITLE STRING) (&OPTIONAL VECTOR))) ++(SETF (GET 'MENU-SET-ADD-BARMENU 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-NAME (NM) ++ (INTERN (SYMBOL-NAME (GENSYM (SYMBOL-NAME NM))))) ++(SETF (GET 'MENU-SET-NAME 'GLARGUMENTS) '((NM SYMBOL))) ++(SETF (GET 'MENU-SET-NAME 'GLFNRESULTTYPE) 'SYMBOL) ++ ++ ++(DEFUN MENU-SET-NAMED-ITEM (MS NAME) (ASSOC NAME (CADDR MS))) ++(SETF (GET 'MENU-SET-NAMED-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL))) ++(SETF (GET 'MENU-SET-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-SET-NAMED-MENU (MS NAME) ++ (CADDR (MENU-SET-NAMED-ITEM MS NAME))) ++(SETF (GET 'MENU-SET-NAMED-MENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL))) ++(SETF (GET 'MENU-SET-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) ++ ++ ++(DEFUN MENU-SET-ITEMP (MS NAME ITEMNAME) ++ (LET ((THISMENU (MENU-SET-NAMED-MENU MS NAME))) ++ (IF (EQ (FIRST THISMENU) 'MENU) ++ (SOME #'(LAMBDA (X) ++ (OR (EQ X ITEMNAME) ++ (AND (CONSP X) (EQ (CAR X) ITEMNAME)))) ++ (NTH 13 THISMENU)) ++ (IF (EQ (FIRST THISMENU) 'PICMENU) ++ (ASSOC ITEMNAME (CADDDR (NTH 10 THISMENU))))))) ++(SETF (GET 'MENU-SET-ITEMP 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (ITEMNAME SYMBOL))) ++(SETF (GET 'MENU-SET-ITEMP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN MENU-CONNS-NAMED-ITEM (MC NAME) ++ (MENU-SET-NAMED-ITEM (CADR MC) NAME)) ++(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLARGUMENTS) ++ '((MC MENU-CONNS) (NAME SYMBOL))) ++(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-CONNS-NAMED-MENU (MC NAME) ++ (MENU-SET-NAMED-MENU (CADR MC) NAME)) ++(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLARGUMENTS) ++ '((MC MENU-CONNS) (NAME SYMBOL))) ++(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) ++ ++ ++(DEFUN MENU-SET-FIND-ITEM (MS POS) ++ (LET (MITEM) ++ (DOLIST (MI (CADDR MS)) ++ (IF (AND (BETWEEN (CAR POS) ++ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (FIFTH SELF) 0)) ++ (+ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (FIFTH SELF) 0)) ++ (SEVENTH (CADDR MI)))) ++ (BETWEEN (CADR POS) ++ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (SIXTH SELF) 0)) ++ (+ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (SIXTH SELF) 0)) ++ (EIGHTH (CADDR MI))))) ++ (SETQ MITEM MI))) ++ MITEM)) ++(SETF (GET 'MENU-SET-FIND-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (POS VECTOR))) ++(SETF (GET 'MENU-SET-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-SET-DELETE-ITEM (MS MI) ++ (SETF (CADDR MS) (REMOVE MI (CADDR MS)))) ++(SETF (GET 'MENU-SET-DELETE-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (MI MENU-SET-ITEM))) ++(SETF (GET 'MENU-SET-DELETE-ITEM 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-MOVE (MS) ++ (LET (SEL M) ++ (SETQ SEL (MENU-SET-SELECT MS NIL T)) ++ (SETQ M (MENU-SET-NAMED-MENU MS (CADR SEL))) ++ (MENU-REPOSITION M))) ++ ++(DEFUN MENU-MDRAW (M) ++ (CASE (FIRST M) ++ (MENU (MENU-DRAW M)) ++ (PICMENU (PICMENU-DRAW M)) ++ (BARMENU (BARMENU-DRAW M)) ++ (TEXTMENU (TEXTMENU-DRAW M)) ++ (EDITMENU (EDITMENU-DRAW M)) ++ (T (GLSEND M DRAW)))) ++ ++(DEFUN MENU-MSELECT (M &OPTIONAL ANYCLICK) ++ (CASE (FIRST M) ++ (MENU (MENU-SELECT M T)) ++ (PICMENU (PICMENU-SELECT M T ANYCLICK)) ++ (BARMENU (BARMENU-SELECT M)) ++ (TEXTMENU (TEXTMENU-SELECT M T)) ++ (EDITMENU (EDITMENU-SELECT M T)) ++ (T (GLSEND M SELECT)))) ++ ++(DEFUN MENU-MITEM-POSITION (M NAME LOC) ++ (CASE (FIRST M) ++ (MENU (MENU-ITEM-POSITION M NAME LOC)) ++ (PICMENU (PICMENU-ITEM-POSITION M NAME LOC)) ++ (T (GLSEND M ITEM-POSITION NAME LOC)))) ++ ++(DEFUN MENU-SET-DRAW (MS) ++ (XMAPWINDOW *WINDOW-DISPLAY* (CADADR MS)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-EXPOSURE (CADR MS)) ++ (DOLIST (ITEM (CADDR MS)) (MENU-MDRAW (CADDR ITEM)))) ++ ++(DEFUN MENU-SET-ITEM-POSITION (MS DESC &OPTIONAL LOC) ++ (LET (M) ++ (SETQ M (MENU-SET-NAMED-MENU MS (CADR DESC))) ++ (OR (MENU-MITEM-POSITION M (CAR DESC) LOC) ++ (MENU-MITEM-POSITION M NIL LOC)))) ++(SETF (GET 'MENU-SET-ITEM-POSITION 'GLARGUMENTS) ++ '((MS MENU-SET) (DESC MENU-PORT) (&OPTIONAL SYMBOL))) ++(SETF (GET 'MENU-SET-ITEM-POSITION 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN MENU-SET-DRAW-CONN (MS CONN) ++ (LET (PA PB TMP (DESCA (CAR CONN)) (DESCB (CADR CONN))) ++ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) ++ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) ++ (WHEN (> (CAR PA) (CAR PB)) ++ (SETQ TMP DESCA) ++ (SETQ DESCA DESCB) ++ (SETQ DESCB TMP)) ++ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) ++ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) ++ (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PA) (CADR PA) 3 NIL) ++ (WINDOW-DRAW-LINE-XY (CADR MS) (CAR PA) (CADR PA) (CAR PB) ++ (CADR PB) NIL) ++ (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PB) (CADR PB) 3 NIL) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN MENU-SET-ADJUST (MS NAME EDGE FROM OFFSET) ++ (LET (M FROMM PLACE) ++ (WHEN (SETQ M (MENU-SET-NAMED-ITEM MS NAME)) ++ (IF FROM ++ (PROGN ++ (SETQ FROMM (MENU-SET-NAMED-ITEM MS FROM)) ++ (SETQ PLACE ++ (CASE EDGE ++ (TOP (SIXTH (CADDR FROMM))) ++ (BOTTOM (+ (SIXTH (CADDR FROMM)) ++ (EIGHTH (CADDR FROMM)))) ++ (LEFT (+ (FIFTH (CADDR FROMM)) ++ (SEVENTH (CADDR FROMM)))) ++ (RIGHT (FIFTH (CADDR FROMM)))))) ++ (SETQ PLACE ++ (CASE EDGE ++ (TOP (CADDDR (CADR MS))) ++ ((BOTTOM LEFT) 0) ++ (RIGHT (FIFTH (CADR MS)))))) ++ (CASE EDGE ++ (TOP (SETF (SIXTH (CADDR M)) ++ (- (- PLACE (EIGHTH (CADDR M))) OFFSET))) ++ (BOTTOM (SETF (SIXTH (CADDR M)) (+ PLACE OFFSET))) ++ (LEFT (SETF (FIFTH (CADDR M)) (+ PLACE OFFSET))) ++ (RIGHT (SETF (FIFTH (CADDR M)) ++ (- (- PLACE (SEVENTH (CADDR M))) OFFSET))))))) ++(SETF (GET 'MENU-SET-ADJUST 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (EDGE SYMBOL) (FROM SYMBOL) ++ (OFFSET INTEGER))) ++(SETF (GET 'MENU-SET-ADJUST 'GLFNRESULTTYPE) 'INTEGER) ++ ++ ++(DEFUN VECTOR-SNAP (FIXED APPROX &OPTIONAL TOLERANCE) ++ (OR TOLERANCE (SETQ TOLERANCE 10)) ++ (IF (< (ABS (- (CAR FIXED) (CAR APPROX))) TOLERANCE) ++ (LIST (CAR FIXED) (CADR APPROX)) ++ (IF (< (ABS (- (CADR FIXED) (CADR APPROX))) TOLERANCE) ++ (LIST (CAR APPROX) (CADR FIXED)) APPROX))) ++(SETF (GET 'VECTOR-SNAP 'GLARGUMENTS) ++ '((FIXED VECTOR) (APPROX VECTOR) (&OPTIONAL NIL))) ++(SETF (GET 'VECTOR-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN MENU-CONNS-CREATE (MS) (LIST 'MENU-CONNS MS NIL)) ++(SETF (GET 'MENU-CONNS-CREATE 'GLARGUMENTS) '((MS MENU-SET))) ++(SETF (GET 'MENU-CONNS-CREATE 'GLFNRESULTTYPE) 'MENU-CONNS) ++ ++ ++(DEFUN MENU-CONNS-DRAW (MC) ++ (MENU-SET-DRAW (CADR MC)) ++ (DOLIST (C (CADDR MC)) (MENU-SET-DRAW-CONN (CADR MC) C))) ++ ++(DEFUN MENU-CONNS-MOVE (MC) ++ (MENU-SET-MOVE (CADR MC)) ++ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (MENU-CONNS-DRAW MC)) ++ ++(DEFUN MENU-CONNS-REDRAW (MC) ++ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (MENU-CONNS-DRAW MC)) ++ ++(DEFUN MENU-CONNS-ADD-CONN (MC) ++ (LET (SEL SELB CONN) ++ (SETQ SEL (MENU-SET-SELECT (CADR MC))) ++ (IF (EQ (CADR SEL) 'BACKGROUND) SEL ++ (PROGN ++ (SETQ SELB (MENU-SET-SELECT (CADR MC))) ++ (WHEN (NOT (EQ (CADR SELB) 'BACKGROUND)) ++ (SETQ CONN (LIST SEL SELB)) ++ (MENU-SET-DRAW-CONN (CADR MC) CONN) ++ (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL)))) ++ NIL)))) ++(SETF (GET 'MENU-CONNS-ADD-CONN 'GLARGUMENTS) '((MC MENU-CONNS))) ++(SETF (GET 'MENU-CONNS-ADD-CONN 'GLFNRESULTTYPE) 'MENU-SELECTION) ++ ++ ++(DEFUN MENU-CONNS-NEW-CONN (MC FROMNAME FROMPORT TONAME TOPORT) ++ (LET (CONN) ++ (SETQ CONN (LIST (LIST FROMPORT FROMNAME) (LIST TOPORT TONAME))) ++ (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL))))) ++(SETF (GET 'MENU-CONNS-NEW-CONN 'GLARGUMENTS) ++ '((MC MENU-CONNS) (FROMNAME SYMBOL) (FROMPORT SYMBOL) ++ (TONAME SYMBOL) (TOPORT SYMBOL))) ++(SETF (GET 'MENU-CONNS-NEW-CONN 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-CONN)) ++ ++ ++(DEFUN MENU-CONNS-ADD-ITEM (MC NAME SYM MENU) ++ (MENU-SET-ADD-ITEM (CADR MC) NAME SYM MENU)) ++(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLARGUMENTS) ++ '((MC MENU-CONNS) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) ++(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-CONNS-FIND-CONN (MC PT) ++ (LET (MS LS FOUND RES PA PB TMP DESCA DESCB) ++ (SETQ LS (LIST (COPY-LIST '(0 0)) (COPY-LIST '(0 0)))) ++ (SETQ MS (CADR MC)) ++ (DOLIST (CONN (CADDR MC)) ++ (UNLESS FOUND ++ (SETQ DESCA (CAR CONN)) ++ (SETQ DESCB (CADR CONN)) ++ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) ++ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) ++ (WHEN (> (CAR PA) (CAR PB)) ++ (SETQ TMP DESCA) ++ (SETQ DESCA DESCB) ++ (SETQ DESCB TMP)) ++ (SETF (CAR LS) (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) ++ (SETF (CADR LS) (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) ++ (WHEN (< (ABS (/ (- (* (- (CAADR LS) (CAAR LS)) ++ (- (CADR PT) (CADAR LS))) ++ (* (- (CADADR LS) (CADAR LS)) ++ (- (CAR PT) (CAAR LS)))) ++ (SQRT (+ (EXPT (- (CAADR LS) (CAAR LS)) 2) ++ (EXPT (- (CADADR LS) (CADAR LS)) 2))))) ++ 5) ++ (SETQ FOUND T) ++ (SETQ RES CONN)))) ++ RES)) ++(SETF (GET 'MENU-CONNS-FIND-CONN 'GLARGUMENTS) ++ '((MC MENU-CONNS) (PT VECTOR))) ++(SETF (GET 'MENU-CONNS-FIND-CONN 'GLFNRESULTTYPE) 'MENU-SET-CONN) ++ ++ ++(DEFUN MENU-CONNS-FIND-ITEM (MC PT) (MENU-SET-FIND-ITEM (CADR MC) PT)) ++(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLARGUMENTS) ++ '((MC MENU-CONNS) (PT VECTOR))) ++(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-CONNS-DELETE-CONN (MC CONN) ++ (SETF (CADDR MC) (REMOVE CONN (CADDR MC)))) ++(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLARGUMENTS) ++ '((MC MENU-CONNS) (CONN MENU-SET-CONN))) ++(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-CONN)) ++ ++ ++(DEFUN MENU-CONNS-DELETE-ITEM (MC MI) ++ (LET (MS) ++ (SETQ MS (CADR MC)) ++ (MENU-SET-DELETE-ITEM MS MI) ++ (DOLIST (CONN (CADDR MC)) ++ (IF (OR (EQ (CADAR CONN) (CAR MI)) (EQ (CADADR CONN) (CAR MI))) ++ (MENU-CONNS-DELETE-CONN MC CONN))))) ++ ++(DEFUN MENU-CONNS-REMOVE-ITEMS (MC) ++ (MENU-SET-REMOVE-ITEMS (CADR MC)) ++ (SETF (CADDR MC) NIL)) ++(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLARGUMENTS) '((MC MENU-CONNS))) ++(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-CONN)) ++ ++ ++(DEFUN MENU-CONNS-CONNECTED-PORTS (MC BOXNAME) ++ (LET (PORTS) ++ (DOLIST (CONN (CADDR MC)) ++ (IF (EQ BOXNAME (CADADR CONN)) (PUSHNEW (CAADR CONN) PORTS) ++ (IF (EQ BOXNAME (CADAR CONN)) (PUSHNEW (CAAR CONN) PORTS)))) ++ PORTS)) ++ ++(DEFUN MENU-CONNS-FIND-CONNS (MC BOXNAME PORT) ++ (LET (RES) ++ (DOLIST (CONN (CADDR MC)) ++ (IF (AND (EQ BOXNAME (CADADR CONN)) (EQ PORT (CAADR CONN))) ++ (SETQ RES (NCONC RES (CONS (CAR CONN) NIL)))) ++ (IF (AND (EQ BOXNAME (CADAR CONN)) (EQ PORT (CAAR CONN))) ++ (SETQ RES (NCONC RES (CONS (CADR CONN) NIL))))) ++ RES)) ++(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLARGUMENTS) ++ '((MC MENU-CONNS) (BOXNAME SYMBOL) (PORT SYMBOL))) ++(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLFNRESULTTYPE) '(LISTOF MENU-PORT)) ++ ++ ++(DEFUN COMPILE-MENU-SET () ++ (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") ++ '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" ++ "glisp/menu-set-header.lsp") ++ (COMPILE-FILE "glisp/menu-settrans.lsp")) ++ ++(DEFUN COMPILE-MENU-SETB () ++ (GLCOMPFILES *DIRECTORY* ++ '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") ++ '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" ++ "glisp/menu-set-header.lsp")) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_init_xgcl.lsp +@@ -0,0 +1,118 @@ ++; Copyright (c) 1994 William F. Schelter ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++(in-package :XLIB) ++(in-package "COMPILER") ++(in-package "SYSTEM") ++(defvar *command-args* nil) ++(in-package "USER") ++(in-package "LISP") ++ ++(lisp::in-package "SLOOP") ++;;Appropriate for Austin ++#-winnt ++(setq SYSTEM:*DEFAULT-TIME-ZONE* 6) ++#+winnt ++(setq SYSTEM:*DEFAULT-TIME-ZONE* (GET-SYSTEM-TIME-ZONE)) ++ ++(in-package "USER") ++(progn (allocate 'cons 100) (allocate 'string 40) ++ (system:init-system) (gbc t) ++ (si::multiply-bignum-stack 25) ++ (or lisp::*link-array* ++ (setq lisp::*link-array* ++ (make-array 500 :element-type 'fixnum :fill-pointer 0))) ++ (use-fast-links t) ++(setq compiler::*cmpinclude* "") (load #"../cmpnew/cmpmain.lsp") (gbc t) (load #"../cmpnew/lfun_list.lsp") ++ (gbc t) (load #"../cmpnew/cmpopt.lsp") (gbc t) ++(load #"../lsp/auto.lsp") (gbc t) ++(defun si::src-path (x) ++ (si::string-concatenate (or si::*lib-directory* "GCLDIR/") x)) ++ ++ (when compiler::*cmpinclude-string* ++ (with-open-file (st "../h/cmpinclude.h") ++ (let ++ ((tem (make-array (file-length st) :element-type 'standard-char ++ :static t))) ++ (if (si::fread tem 0 (length tem) st) ++ (setq compiler::*cmpinclude-string* tem))))) ++ ;;compile-file is in cmpmain.lsp ++ ++ (setf (symbol-function 'si:clear-compiler-properties) ++ (symbol-function 'compiler::compiler-clear-compiler-properties)) ++; (load "../lsp/setdoc.lsp") ++ (setq system::*old-top-level* (symbol-function 'system:top-level)) ++(defvar si::*command-args* nil) ++(defun si::get-command-arg (a &optional val-if-there) ++ ;; return non nil if a is in si::*command-args* and return ++ ;; the string which is after it if there is one" ++ (let ((tem (member a si::*command-args* :test 'equal))) ++ (if tem (or val-if-there (cadr tem) t)))) ++(defvar si::*lib-directory* nil) ++(defun system::gcl-top-level (&aux tem) ++ (dotimes (i (si::argc)) ++ (setq si::*command-args* (cons (si::argv i) si::*command-args*))) ++ (setq si::*command-args* (nreverse si::*command-args* )) ++ (setq si::*system-directory* ++ (or (si::get-command-arg "-dir") ++ (car si::*command-args*))) ++ (setq si::*lib-directory* (si::get-command-arg "-libdir")) ++ ++ (when (si::get-command-arg "-compile") ++ (let ((system::*quit-tag* (cons nil nil)) ++ (system::*quit-tags* nil) (system::*break-level* '()) ++ (system::*break-env* nil) (system::*ihs-base* 1) ++ (system::*ihs-top* 1) (system::*current-ihs* 1) ++ (*break-enable* nil)) ++ (system:error-set ++ '(progn ++ (compile-file (si::get-command-arg "-compile") ++ :output-file ++ (or (si::get-command-arg "-o") ++ (si::get-command-arg "-compile")) ++ :o-file (not (si::get-command-arg "-no-o" t)) ++ :c-file (si::get-command-arg "-system-p" t) ++ :h-file (si::get-command-arg "-system-p" t) ++ :data-file (si::get-command-arg "-system-p" t) ++ :system-p (si::get-command-arg "-system-p" t)))) ++ (bye (if compiler::*error-p* 1 0)))) ++ (format t "GCL (GNU Common Lisp) ~A~%~a~%~a~%" "DATE" ++ "Licensed under GNU Public Library License" ++ "Contains Enhancements by W. Schelter") ++ (setq si::*ihs-top* 1) ++ (in-package 'system::user) (incf system::*ihs-top* 2) ++ (funcall system::*old-top-level*)) ++ (setq si::*gcl-version* 600) ++ (defun lisp-implementation-version nil (format nil "1-~a" si::*gcl-version*)) ++ (setq si:*inhibit-macro-special* t) ++ ;(setq *modules* nil) ++ (gbc t) (system:reset-gbc-count) ++ (allocate 'cons 200) ++ (defun system:top-level nil (system::gcl-top-level)) ++ (unintern 'system) ++ (unintern 'lisp) ++ (unintern 'compiler) ++ (unintern 'user) ++ (si::chdir "/d19/staff/wfs/novak-xgcl")(user::user-init)(si::save-system "saved_xgcl") ++ (if (fboundp 'user-init) (user-init)) ++ (system:save-system "saved_gcl") (bye) ++ (defun system:top-level nil (system::gcl-top-level)) ++ (save "saved_gcl") (bye)) ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_defentry_events.lsp +@@ -0,0 +1,817 @@ ++(in-package :XLIB) ++; defentry-events.lsp Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++ ++;;;;;; XKeyEvent funcions ;;;;;; ++ ++(defentry make-XKeyEvent () ( fixnum "make_XKeyEvent" )) ++(defentry XKeyEvent-same_screen (fixnum) ( fixnum "XKeyEvent_same_screen" )) ++(defentry set-XKeyEvent-same_screen (fixnum fixnum) ( void "set_XKeyEvent_same_screen" )) ++(defentry XKeyEvent-keycode (fixnum) ( fixnum "XKeyEvent_keycode" )) ++(defentry set-XKeyEvent-keycode (fixnum fixnum) ( void "set_XKeyEvent_keycode" )) ++(defentry XKeyEvent-state (fixnum) ( fixnum "XKeyEvent_state" )) ++(defentry set-XKeyEvent-state (fixnum fixnum) ( void "set_XKeyEvent_state" )) ++(defentry XKeyEvent-y_root (fixnum) ( fixnum "XKeyEvent_y_root" )) ++(defentry set-XKeyEvent-y_root (fixnum fixnum) ( void "set_XKeyEvent_y_root" )) ++(defentry XKeyEvent-x_root (fixnum) ( fixnum "XKeyEvent_x_root" )) ++(defentry set-XKeyEvent-x_root (fixnum fixnum) ( void "set_XKeyEvent_x_root" )) ++(defentry XKeyEvent-y (fixnum) ( fixnum "XKeyEvent_y" )) ++(defentry set-XKeyEvent-y (fixnum fixnum) ( void "set_XKeyEvent_y" )) ++(defentry XKeyEvent-x (fixnum) ( fixnum "XKeyEvent_x" )) ++(defentry set-XKeyEvent-x (fixnum fixnum) ( void "set_XKeyEvent_x" )) ++(defentry XKeyEvent-time (fixnum) ( fixnum "XKeyEvent_time" )) ++(defentry set-XKeyEvent-time (fixnum fixnum) ( void "set_XKeyEvent_time" )) ++(defentry XKeyEvent-subwindow (fixnum) ( fixnum "XKeyEvent_subwindow" )) ++(defentry set-XKeyEvent-subwindow (fixnum fixnum) ( void "set_XKeyEvent_subwindow" )) ++(defentry XKeyEvent-root (fixnum) ( fixnum "XKeyEvent_root" )) ++(defentry set-XKeyEvent-root (fixnum fixnum) ( void "set_XKeyEvent_root" )) ++(defentry XKeyEvent-window (fixnum) ( fixnum "XKeyEvent_window" )) ++(defentry set-XKeyEvent-window (fixnum fixnum) ( void "set_XKeyEvent_window" )) ++(defentry XKeyEvent-display (fixnum) ( fixnum "XKeyEvent_display" )) ++(defentry set-XKeyEvent-display (fixnum fixnum) ( void "set_XKeyEvent_display" )) ++(defentry XKeyEvent-send_event (fixnum) ( fixnum "XKeyEvent_send_event" )) ++(defentry set-XKeyEvent-send_event (fixnum fixnum) ( void "set_XKeyEvent_send_event" )) ++(defentry XKeyEvent-serial (fixnum) ( fixnum "XKeyEvent_serial" )) ++(defentry set-XKeyEvent-serial (fixnum fixnum) ( void "set_XKeyEvent_serial" )) ++(defentry XKeyEvent-type (fixnum) ( fixnum "XKeyEvent_type" )) ++(defentry set-XKeyEvent-type (fixnum fixnum) ( void "set_XKeyEvent_type" )) ++ ++ ++;;;;;; XButtonEvent funcions ;;;;;; ++ ++(defentry make-XButtonEvent () ( fixnum "make_XButtonEvent" )) ++(defentry XButtonEvent-same_screen (fixnum) ( fixnum "XButtonEvent_same_screen" )) ++(defentry set-XButtonEvent-same_screen (fixnum fixnum) ( void "set_XButtonEvent_same_screen" )) ++(defentry XButtonEvent-button (fixnum) ( fixnum "XButtonEvent_button" )) ++(defentry set-XButtonEvent-button (fixnum fixnum) ( void "set_XButtonEvent_button" )) ++(defentry XButtonEvent-state (fixnum) ( fixnum "XButtonEvent_state" )) ++(defentry set-XButtonEvent-state (fixnum fixnum) ( void "set_XButtonEvent_state" )) ++(defentry XButtonEvent-y_root (fixnum) ( fixnum "XButtonEvent_y_root" )) ++(defentry set-XButtonEvent-y_root (fixnum fixnum) ( void "set_XButtonEvent_y_root" )) ++(defentry XButtonEvent-x_root (fixnum) ( fixnum "XButtonEvent_x_root" )) ++(defentry set-XButtonEvent-x_root (fixnum fixnum) ( void "set_XButtonEvent_x_root" )) ++(defentry XButtonEvent-y (fixnum) ( fixnum "XButtonEvent_y" )) ++(defentry set-XButtonEvent-y (fixnum fixnum) ( void "set_XButtonEvent_y" )) ++(defentry XButtonEvent-x (fixnum) ( fixnum "XButtonEvent_x" )) ++(defentry set-XButtonEvent-x (fixnum fixnum) ( void "set_XButtonEvent_x" )) ++(defentry XButtonEvent-time (fixnum) ( fixnum "XButtonEvent_time" )) ++(defentry set-XButtonEvent-time (fixnum fixnum) ( void "set_XButtonEvent_time" )) ++(defentry XButtonEvent-subwindow (fixnum) ( fixnum "XButtonEvent_subwindow" )) ++(defentry set-XButtonEvent-subwindow (fixnum fixnum) ( void "set_XButtonEvent_subwindow" )) ++(defentry XButtonEvent-root (fixnum) ( fixnum "XButtonEvent_root" )) ++(defentry set-XButtonEvent-root (fixnum fixnum) ( void "set_XButtonEvent_root" )) ++(defentry XButtonEvent-window (fixnum) ( fixnum "XButtonEvent_window" )) ++(defentry set-XButtonEvent-window (fixnum fixnum) ( void "set_XButtonEvent_window" )) ++(defentry XButtonEvent-display (fixnum) ( fixnum "XButtonEvent_display" )) ++(defentry set-XButtonEvent-display (fixnum fixnum) ( void "set_XButtonEvent_display" )) ++(defentry XButtonEvent-send_event (fixnum) ( fixnum "XButtonEvent_send_event" )) ++(defentry set-XButtonEvent-send_event (fixnum fixnum) ( void "set_XButtonEvent_send_event" )) ++(defentry XButtonEvent-serial (fixnum) ( fixnum "XButtonEvent_serial" )) ++(defentry set-XButtonEvent-serial (fixnum fixnum) ( void "set_XButtonEvent_serial" )) ++(defentry XButtonEvent-type (fixnum) ( fixnum "XButtonEvent_type" )) ++(defentry set-XButtonEvent-type (fixnum fixnum) ( void "set_XButtonEvent_type" )) ++ ++ ++;;;;;; XMotionEvent funcions ;;;;;; ++ ++(defentry make-XMotionEvent () ( fixnum "make_XMotionEvent" )) ++(defentry XMotionEvent-same_screen (fixnum) ( fixnum "XMotionEvent_same_screen" )) ++(defentry set-XMotionEvent-same_screen (fixnum fixnum) ( void "set_XMotionEvent_same_screen" )) ++(defentry XMotionEvent-is_hint (fixnum) ( char "XMotionEvent_is_hint" )) ++(defentry set-XMotionEvent-is_hint (fixnum char) ( void "set_XMotionEvent_is_hint" )) ++(defentry XMotionEvent-state (fixnum) ( fixnum "XMotionEvent_state" )) ++(defentry set-XMotionEvent-state (fixnum fixnum) ( void "set_XMotionEvent_state" )) ++(defentry XMotionEvent-y_root (fixnum) ( fixnum "XMotionEvent_y_root" )) ++(defentry set-XMotionEvent-y_root (fixnum fixnum) ( void "set_XMotionEvent_y_root" )) ++(defentry XMotionEvent-x_root (fixnum) ( fixnum "XMotionEvent_x_root" )) ++(defentry set-XMotionEvent-x_root (fixnum fixnum) ( void "set_XMotionEvent_x_root" )) ++(defentry XMotionEvent-y (fixnum) ( fixnum "XMotionEvent_y" )) ++(defentry set-XMotionEvent-y (fixnum fixnum) ( void "set_XMotionEvent_y" )) ++(defentry XMotionEvent-x (fixnum) ( fixnum "XMotionEvent_x" )) ++(defentry set-XMotionEvent-x (fixnum fixnum) ( void "set_XMotionEvent_x" )) ++(defentry XMotionEvent-time (fixnum) ( fixnum "XMotionEvent_time" )) ++(defentry set-XMotionEvent-time (fixnum fixnum) ( void "set_XMotionEvent_time" )) ++(defentry XMotionEvent-subwindow (fixnum) ( fixnum "XMotionEvent_subwindow" )) ++(defentry set-XMotionEvent-subwindow (fixnum fixnum) ( void "set_XMotionEvent_subwindow" )) ++(defentry XMotionEvent-root (fixnum) ( fixnum "XMotionEvent_root" )) ++(defentry set-XMotionEvent-root (fixnum fixnum) ( void "set_XMotionEvent_root" )) ++(defentry XMotionEvent-window (fixnum) ( fixnum "XMotionEvent_window" )) ++(defentry set-XMotionEvent-window (fixnum fixnum) ( void "set_XMotionEvent_window" )) ++(defentry XMotionEvent-display (fixnum) ( fixnum "XMotionEvent_display" )) ++(defentry set-XMotionEvent-display (fixnum fixnum) ( void "set_XMotionEvent_display" )) ++(defentry XMotionEvent-send_event (fixnum) ( fixnum "XMotionEvent_send_event" )) ++(defentry set-XMotionEvent-send_event (fixnum fixnum) ( void "set_XMotionEvent_send_event" )) ++(defentry XMotionEvent-serial (fixnum) ( fixnum "XMotionEvent_serial" )) ++(defentry set-XMotionEvent-serial (fixnum fixnum) ( void "set_XMotionEvent_serial" )) ++(defentry XMotionEvent-type (fixnum) ( fixnum "XMotionEvent_type" )) ++(defentry set-XMotionEvent-type (fixnum fixnum) ( void "set_XMotionEvent_type" )) ++ ++ ++;;;;;; XCrossingEvent funcions ;;;;;; ++ ++(defentry make-XCrossingEvent () ( fixnum "make_XCrossingEvent" )) ++(defentry XCrossingEvent-state (fixnum) ( fixnum "XCrossingEvent_state" )) ++(defentry set-XCrossingEvent-state (fixnum fixnum) ( void "set_XCrossingEvent_state" )) ++(defentry XCrossingEvent-focus (fixnum) ( fixnum "XCrossingEvent_focus" )) ++(defentry set-XCrossingEvent-focus (fixnum fixnum) ( void "set_XCrossingEvent_focus" )) ++(defentry XCrossingEvent-same_screen (fixnum) ( fixnum "XCrossingEvent_same_screen" )) ++(defentry set-XCrossingEvent-same_screen (fixnum fixnum) ( void "set_XCrossingEvent_same_screen" )) ++(defentry XCrossingEvent-detail (fixnum) ( fixnum "XCrossingEvent_detail" )) ++(defentry set-XCrossingEvent-detail (fixnum fixnum) ( void "set_XCrossingEvent_detail" )) ++(defentry XCrossingEvent-mode (fixnum) ( fixnum "XCrossingEvent_mode" )) ++(defentry set-XCrossingEvent-mode (fixnum fixnum) ( void "set_XCrossingEvent_mode" )) ++(defentry XCrossingEvent-y_root (fixnum) ( fixnum "XCrossingEvent_y_root" )) ++(defentry set-XCrossingEvent-y_root (fixnum fixnum) ( void "set_XCrossingEvent_y_root" )) ++(defentry XCrossingEvent-x_root (fixnum) ( fixnum "XCrossingEvent_x_root" )) ++(defentry set-XCrossingEvent-x_root (fixnum fixnum) ( void "set_XCrossingEvent_x_root" )) ++(defentry XCrossingEvent-y (fixnum) ( fixnum "XCrossingEvent_y" )) ++(defentry set-XCrossingEvent-y (fixnum fixnum) ( void "set_XCrossingEvent_y" )) ++(defentry XCrossingEvent-x (fixnum) ( fixnum "XCrossingEvent_x" )) ++(defentry set-XCrossingEvent-x (fixnum fixnum) ( void "set_XCrossingEvent_x" )) ++(defentry XCrossingEvent-time (fixnum) ( fixnum "XCrossingEvent_time" )) ++(defentry set-XCrossingEvent-time (fixnum fixnum) ( void "set_XCrossingEvent_time" )) ++(defentry XCrossingEvent-subwindow (fixnum) ( fixnum "XCrossingEvent_subwindow" )) ++(defentry set-XCrossingEvent-subwindow (fixnum fixnum) ( void "set_XCrossingEvent_subwindow" )) ++(defentry XCrossingEvent-root (fixnum) ( fixnum "XCrossingEvent_root" )) ++(defentry set-XCrossingEvent-root (fixnum fixnum) ( void "set_XCrossingEvent_root" )) ++(defentry XCrossingEvent-window (fixnum) ( fixnum "XCrossingEvent_window" )) ++(defentry set-XCrossingEvent-window (fixnum fixnum) ( void "set_XCrossingEvent_window" )) ++(defentry XCrossingEvent-display (fixnum) ( fixnum "XCrossingEvent_display" )) ++(defentry set-XCrossingEvent-display (fixnum fixnum) ( void "set_XCrossingEvent_display" )) ++(defentry XCrossingEvent-send_event (fixnum) ( fixnum "XCrossingEvent_send_event" )) ++(defentry set-XCrossingEvent-send_event (fixnum fixnum) ( void "set_XCrossingEvent_send_event" )) ++(defentry XCrossingEvent-serial (fixnum) ( fixnum "XCrossingEvent_serial" )) ++(defentry set-XCrossingEvent-serial (fixnum fixnum) ( void "set_XCrossingEvent_serial" )) ++(defentry XCrossingEvent-type (fixnum) ( fixnum "XCrossingEvent_type" )) ++(defentry set-XCrossingEvent-type (fixnum fixnum) ( void "set_XCrossingEvent_type" )) ++ ++ ++;;;;;; XFocusChangeEvent funcions ;;;;;; ++ ++(defentry make-XFocusChangeEvent () ( fixnum "make_XFocusChangeEvent" )) ++(defentry XFocusChangeEvent-detail (fixnum) ( fixnum "XFocusChangeEvent_detail" )) ++(defentry set-XFocusChangeEvent-detail (fixnum fixnum) ( void "set_XFocusChangeEvent_detail" )) ++(defentry XFocusChangeEvent-mode (fixnum) ( fixnum "XFocusChangeEvent_mode" )) ++(defentry set-XFocusChangeEvent-mode (fixnum fixnum) ( void "set_XFocusChangeEvent_mode" )) ++(defentry XFocusChangeEvent-window (fixnum) ( fixnum "XFocusChangeEvent_window" )) ++(defentry set-XFocusChangeEvent-window (fixnum fixnum) ( void "set_XFocusChangeEvent_window" )) ++(defentry XFocusChangeEvent-display (fixnum) ( fixnum "XFocusChangeEvent_display" )) ++(defentry set-XFocusChangeEvent-display (fixnum fixnum) ( void "set_XFocusChangeEvent_display" )) ++(defentry XFocusChangeEvent-send_event (fixnum) ( fixnum "XFocusChangeEvent_send_event" )) ++(defentry set-XFocusChangeEvent-send_event (fixnum fixnum) ( void "set_XFocusChangeEvent_send_event" )) ++(defentry XFocusChangeEvent-serial (fixnum) ( fixnum "XFocusChangeEvent_serial" )) ++(defentry set-XFocusChangeEvent-serial (fixnum fixnum) ( void "set_XFocusChangeEvent_serial" )) ++(defentry XFocusChangeEvent-type (fixnum) ( fixnum "XFocusChangeEvent_type" )) ++(defentry set-XFocusChangeEvent-type (fixnum fixnum) ( void "set_XFocusChangeEvent_type" )) ++ ++ ++;;;;;; XKeymapEvent funcions ;;;;;; ++ ++(defentry make-XKeymapEvent () ( fixnum "make_XKeymapEvent" )) ++;;(defentry XKeymapEvent-key_vector[32] (fixnum) ( char "XKeymapEvent_key_vector[32]" )) ++;;(defentry set-XKeymapEvent-key_vector[32] (fixnum char) ( void "set_XKeymapEvent_key_vector[32]" )) ++(defentry XKeymapEvent-window (fixnum) ( fixnum "XKeymapEvent_window" )) ++(defentry set-XKeymapEvent-window (fixnum fixnum) ( void "set_XKeymapEvent_window" )) ++(defentry XKeymapEvent-display (fixnum) ( fixnum "XKeymapEvent_display" )) ++(defentry set-XKeymapEvent-display (fixnum fixnum) ( void "set_XKeymapEvent_display" )) ++(defentry XKeymapEvent-send_event (fixnum) ( fixnum "XKeymapEvent_send_event" )) ++(defentry set-XKeymapEvent-send_event (fixnum fixnum) ( void "set_XKeymapEvent_send_event" )) ++(defentry XKeymapEvent-serial (fixnum) ( fixnum "XKeymapEvent_serial" )) ++(defentry set-XKeymapEvent-serial (fixnum fixnum) ( void "set_XKeymapEvent_serial" )) ++(defentry XKeymapEvent-type (fixnum) ( fixnum "XKeymapEvent_type" )) ++(defentry set-XKeymapEvent-type (fixnum fixnum) ( void "set_XKeymapEvent_type" )) ++ ++ ++;;;;;; XExposeEvent funcions ;;;;;; ++ ++(defentry make-XExposeEvent () ( fixnum "make_XExposeEvent" )) ++(defentry XExposeEvent-count (fixnum) ( fixnum "XExposeEvent_count" )) ++(defentry set-XExposeEvent-count (fixnum fixnum) ( void "set_XExposeEvent_count" )) ++(defentry XExposeEvent-height (fixnum) ( fixnum "XExposeEvent_height" )) ++(defentry set-XExposeEvent-height (fixnum fixnum) ( void "set_XExposeEvent_height" )) ++(defentry XExposeEvent-width (fixnum) ( fixnum "XExposeEvent_width" )) ++(defentry set-XExposeEvent-width (fixnum fixnum) ( void "set_XExposeEvent_width" )) ++(defentry XExposeEvent-y (fixnum) ( fixnum "XExposeEvent_y" )) ++(defentry set-XExposeEvent-y (fixnum fixnum) ( void "set_XExposeEvent_y" )) ++(defentry XExposeEvent-x (fixnum) ( fixnum "XExposeEvent_x" )) ++(defentry set-XExposeEvent-x (fixnum fixnum) ( void "set_XExposeEvent_x" )) ++(defentry XExposeEvent-window (fixnum) ( fixnum "XExposeEvent_window" )) ++(defentry set-XExposeEvent-window (fixnum fixnum) ( void "set_XExposeEvent_window" )) ++(defentry XExposeEvent-display (fixnum) ( fixnum "XExposeEvent_display" )) ++(defentry set-XExposeEvent-display (fixnum fixnum) ( void "set_XExposeEvent_display" )) ++(defentry XExposeEvent-send_event (fixnum) ( fixnum "XExposeEvent_send_event" )) ++(defentry set-XExposeEvent-send_event (fixnum fixnum) ( void "set_XExposeEvent_send_event" )) ++(defentry XExposeEvent-serial (fixnum) ( fixnum "XExposeEvent_serial" )) ++(defentry set-XExposeEvent-serial (fixnum fixnum) ( void "set_XExposeEvent_serial" )) ++(defentry XExposeEvent-type (fixnum) ( fixnum "XExposeEvent_type" )) ++(defentry set-XExposeEvent-type (fixnum fixnum) ( void "set_XExposeEvent_type" )) ++ ++ ++;;;;;; XGraphicsExposeEvent funcions ;;;;;; ++ ++(defentry make-XGraphicsExposeEvent () ( fixnum "make_XGraphicsExposeEvent" )) ++(defentry XGraphicsExposeEvent-minor_code (fixnum) ( fixnum "XGraphicsExposeEvent_minor_code" )) ++(defentry set-XGraphicsExposeEvent-minor_code (fixnum fixnum) ( void "set_XGraphicsExposeEvent_minor_code" )) ++(defentry XGraphicsExposeEvent-major_code (fixnum) ( fixnum "XGraphicsExposeEvent_major_code" )) ++(defentry set-XGraphicsExposeEvent-major_code (fixnum fixnum) ( void "set_XGraphicsExposeEvent_major_code" )) ++(defentry XGraphicsExposeEvent-count (fixnum) ( fixnum "XGraphicsExposeEvent_count" )) ++(defentry set-XGraphicsExposeEvent-count (fixnum fixnum) ( void "set_XGraphicsExposeEvent_count" )) ++(defentry XGraphicsExposeEvent-height (fixnum) ( fixnum "XGraphicsExposeEvent_height" )) ++(defentry set-XGraphicsExposeEvent-height (fixnum fixnum) ( void "set_XGraphicsExposeEvent_height" )) ++(defentry XGraphicsExposeEvent-width (fixnum) ( fixnum "XGraphicsExposeEvent_width" )) ++(defentry set-XGraphicsExposeEvent-width (fixnum fixnum) ( void "set_XGraphicsExposeEvent_width" )) ++(defentry XGraphicsExposeEvent-y (fixnum) ( fixnum "XGraphicsExposeEvent_y" )) ++(defentry set-XGraphicsExposeEvent-y (fixnum fixnum) ( void "set_XGraphicsExposeEvent_y" )) ++(defentry XGraphicsExposeEvent-x (fixnum) ( fixnum "XGraphicsExposeEvent_x" )) ++(defentry set-XGraphicsExposeEvent-x (fixnum fixnum) ( void "set_XGraphicsExposeEvent_x" )) ++(defentry XGraphicsExposeEvent-drawable (fixnum) (fixnum "XGraphicsExposeEvent_drawable" )) ++(defentry set-XGraphicsExposeEvent-drawable (fixnum fixnum) ( void "set_XGraphicsExposeEvent_drawable" )) ++(defentry XGraphicsExposeEvent-display (fixnum) ( fixnum "XGraphicsExposeEvent_display" )) ++(defentry set-XGraphicsExposeEvent-display (fixnum fixnum) ( void "set_XGraphicsExposeEvent_display" )) ++(defentry XGraphicsExposeEvent-send_event (fixnum) ( fixnum "XGraphicsExposeEvent_send_event" )) ++(defentry set-XGraphicsExposeEvent-send_event (fixnum fixnum) ( void "set_XGraphicsExposeEvent_send_event" )) ++(defentry XGraphicsExposeEvent-serial (fixnum) ( fixnum "XGraphicsExposeEvent_serial" )) ++(defentry set-XGraphicsExposeEvent-serial (fixnum fixnum) ( void "set_XGraphicsExposeEvent_serial" )) ++(defentry XGraphicsExposeEvent-type (fixnum) ( fixnum "XGraphicsExposeEvent_type" )) ++(defentry set-XGraphicsExposeEvent-type (fixnum fixnum) ( void "set_XGraphicsExposeEvent_type" )) ++ ++ ++;;;;;; XNoExposeEvent funcions ;;;;;; ++ ++(defentry make-XNoExposeEvent () ( fixnum "make_XNoExposeEvent" )) ++(defentry XNoExposeEvent-minor_code (fixnum) ( fixnum "XNoExposeEvent_minor_code" )) ++(defentry set-XNoExposeEvent-minor_code (fixnum fixnum) ( void "set_XNoExposeEvent_minor_code" )) ++(defentry XNoExposeEvent-major_code (fixnum) ( fixnum "XNoExposeEvent_major_code" )) ++(defentry set-XNoExposeEvent-major_code (fixnum fixnum) ( void "set_XNoExposeEvent_major_code" )) ++(defentry XNoExposeEvent-drawable (fixnum) ( fixnum "XNoExposeEvent_drawable" )) ++(defentry set-XNoExposeEvent-drawable (fixnum fixnum) ( void "set_XNoExposeEvent_drawable" )) ++(defentry XNoExposeEvent-display (fixnum) ( fixnum "XNoExposeEvent_display" )) ++(defentry set-XNoExposeEvent-display (fixnum fixnum) ( void "set_XNoExposeEvent_display" )) ++(defentry XNoExposeEvent-send_event (fixnum) ( fixnum "XNoExposeEvent_send_event" )) ++(defentry set-XNoExposeEvent-send_event (fixnum fixnum) ( void "set_XNoExposeEvent_send_event" )) ++(defentry XNoExposeEvent-serial (fixnum) ( fixnum "XNoExposeEvent_serial" )) ++(defentry set-XNoExposeEvent-serial (fixnum fixnum) ( void "set_XNoExposeEvent_serial" )) ++(defentry XNoExposeEvent-type (fixnum) ( fixnum "XNoExposeEvent_type" )) ++(defentry set-XNoExposeEvent-type (fixnum fixnum) ( void "set_XNoExposeEvent_type" )) ++ ++ ++;;;;;; XVisibilityEvent funcions ;;;;;; ++ ++(defentry make-XVisibilityEvent () ( fixnum "make_XVisibilityEvent" )) ++(defentry XVisibilityEvent-state (fixnum) ( fixnum "XVisibilityEvent_state" )) ++(defentry set-XVisibilityEvent-state (fixnum fixnum) ( void "set_XVisibilityEvent_state" )) ++(defentry XVisibilityEvent-window (fixnum) ( fixnum "XVisibilityEvent_window" )) ++(defentry set-XVisibilityEvent-window (fixnum fixnum) ( void "set_XVisibilityEvent_window" )) ++(defentry XVisibilityEvent-display (fixnum) ( fixnum "XVisibilityEvent_display" )) ++(defentry set-XVisibilityEvent-display (fixnum fixnum) ( void "set_XVisibilityEvent_display" )) ++(defentry XVisibilityEvent-send_event (fixnum) ( fixnum "XVisibilityEvent_send_event" )) ++(defentry set-XVisibilityEvent-send_event (fixnum fixnum) ( void "set_XVisibilityEvent_send_event" )) ++(defentry XVisibilityEvent-serial (fixnum) ( fixnum "XVisibilityEvent_serial" )) ++(defentry set-XVisibilityEvent-serial (fixnum fixnum) ( void "set_XVisibilityEvent_serial" )) ++(defentry XVisibilityEvent-type (fixnum) ( fixnum "XVisibilityEvent_type" )) ++(defentry set-XVisibilityEvent-type (fixnum fixnum) ( void "set_XVisibilityEvent_type" )) ++ ++ ++;;;;;; XCreateWindowEvent funcions ;;;;;; ++ ++(defentry make-XCreateWindowEvent () ( fixnum "make_XCreateWindowEvent" )) ++(defentry XCreateWindowEvent-override_redirect (fixnum) ( fixnum "XCreateWindowEvent_override_redirect" )) ++(defentry set-XCreateWindowEvent-override_redirect (fixnum fixnum) ( void "set_XCreateWindowEvent_override_redirect" )) ++(defentry XCreateWindowEvent-border_width (fixnum) ( fixnum "XCreateWindowEvent_border_width" )) ++(defentry set-XCreateWindowEvent-border_width (fixnum fixnum) ( void "set_XCreateWindowEvent_border_width" )) ++(defentry XCreateWindowEvent-height (fixnum) ( fixnum "XCreateWindowEvent_height" )) ++(defentry set-XCreateWindowEvent-height (fixnum fixnum) ( void "set_XCreateWindowEvent_height" )) ++(defentry XCreateWindowEvent-width (fixnum) ( fixnum "XCreateWindowEvent_width" )) ++(defentry set-XCreateWindowEvent-width (fixnum fixnum) ( void "set_XCreateWindowEvent_width" )) ++(defentry XCreateWindowEvent-y (fixnum) ( fixnum "XCreateWindowEvent_y" )) ++(defentry set-XCreateWindowEvent-y (fixnum fixnum) ( void "set_XCreateWindowEvent_y" )) ++(defentry XCreateWindowEvent-x (fixnum) ( fixnum "XCreateWindowEvent_x" )) ++(defentry set-XCreateWindowEvent-x (fixnum fixnum) ( void "set_XCreateWindowEvent_x" )) ++(defentry XCreateWindowEvent-window (fixnum) ( fixnum "XCreateWindowEvent_window" )) ++(defentry set-XCreateWindowEvent-window (fixnum fixnum) ( void "set_XCreateWindowEvent_window" )) ++(defentry XCreateWindowEvent-parent (fixnum) ( fixnum "XCreateWindowEvent_parent" )) ++(defentry set-XCreateWindowEvent-parent (fixnum fixnum) ( void "set_XCreateWindowEvent_parent" )) ++(defentry XCreateWindowEvent-display (fixnum) ( fixnum "XCreateWindowEvent_display" )) ++(defentry set-XCreateWindowEvent-display (fixnum fixnum) ( void "set_XCreateWindowEvent_display" )) ++(defentry XCreateWindowEvent-send_event (fixnum) ( fixnum "XCreateWindowEvent_send_event" )) ++(defentry set-XCreateWindowEvent-send_event (fixnum fixnum) ( void "set_XCreateWindowEvent_send_event" )) ++(defentry XCreateWindowEvent-serial (fixnum) ( fixnum "XCreateWindowEvent_serial" )) ++(defentry set-XCreateWindowEvent-serial (fixnum fixnum) ( void "set_XCreateWindowEvent_serial" )) ++(defentry XCreateWindowEvent-type (fixnum) ( fixnum "XCreateWindowEvent_type" )) ++(defentry set-XCreateWindowEvent-type (fixnum fixnum) ( void "set_XCreateWindowEvent_type" )) ++ ++ ++;;;;;; XDestroyWindowEvent funcions ;;;;;; ++ ++(defentry make-XDestroyWindowEvent () ( fixnum "make_XDestroyWindowEvent" )) ++(defentry XDestroyWindowEvent-window (fixnum) ( fixnum "XDestroyWindowEvent_window" )) ++(defentry set-XDestroyWindowEvent-window (fixnum fixnum) ( void "set_XDestroyWindowEvent_window" )) ++(defentry XDestroyWindowEvent-event (fixnum) ( fixnum "XDestroyWindowEvent_event" )) ++(defentry set-XDestroyWindowEvent-event (fixnum fixnum) ( void "set_XDestroyWindowEvent_event" )) ++(defentry XDestroyWindowEvent-display (fixnum) ( fixnum "XDestroyWindowEvent_display" )) ++(defentry set-XDestroyWindowEvent-display (fixnum fixnum) ( void "set_XDestroyWindowEvent_display" )) ++(defentry XDestroyWindowEvent-send_event (fixnum) ( fixnum "XDestroyWindowEvent_send_event" )) ++(defentry set-XDestroyWindowEvent-send_event (fixnum fixnum) ( void "set_XDestroyWindowEvent_send_event" )) ++(defentry XDestroyWindowEvent-serial (fixnum) ( fixnum "XDestroyWindowEvent_serial" )) ++(defentry set-XDestroyWindowEvent-serial (fixnum fixnum) ( void "set_XDestroyWindowEvent_serial" )) ++(defentry XDestroyWindowEvent-type (fixnum) ( fixnum "XDestroyWindowEvent_type" )) ++(defentry set-XDestroyWindowEvent-type (fixnum fixnum) ( void "set_XDestroyWindowEvent_type" )) ++ ++ ++;;;;;; XUnmapEvent funcions ;;;;;; ++ ++(defentry make-XUnmapEvent () ( fixnum "make_XUnmapEvent" )) ++(defentry XUnmapEvent-from_configure (fixnum) ( fixnum "XUnmapEvent_from_configure" )) ++(defentry set-XUnmapEvent-from_configure (fixnum fixnum) ( void "set_XUnmapEvent_from_configure" )) ++(defentry XUnmapEvent-window (fixnum) ( fixnum "XUnmapEvent_window" )) ++(defentry set-XUnmapEvent-window (fixnum fixnum) ( void "set_XUnmapEvent_window" )) ++(defentry XUnmapEvent-event (fixnum) ( fixnum "XUnmapEvent_event" )) ++(defentry set-XUnmapEvent-event (fixnum fixnum) ( void "set_XUnmapEvent_event" )) ++(defentry XUnmapEvent-display (fixnum) ( fixnum "XUnmapEvent_display" )) ++(defentry set-XUnmapEvent-display (fixnum fixnum) ( void "set_XUnmapEvent_display" )) ++(defentry XUnmapEvent-send_event (fixnum) ( fixnum "XUnmapEvent_send_event" )) ++(defentry set-XUnmapEvent-send_event (fixnum fixnum) ( void "set_XUnmapEvent_send_event" )) ++(defentry XUnmapEvent-serial (fixnum) ( fixnum "XUnmapEvent_serial" )) ++(defentry set-XUnmapEvent-serial (fixnum fixnum) ( void "set_XUnmapEvent_serial" )) ++(defentry XUnmapEvent-type (fixnum) ( fixnum "XUnmapEvent_type" )) ++(defentry set-XUnmapEvent-type (fixnum fixnum) ( void "set_XUnmapEvent_type" )) ++ ++ ++;;;;;; XMapEvent funcions ;;;;;; ++ ++(defentry make-XMapEvent () ( fixnum "make_XMapEvent" )) ++(defentry XMapEvent-override_redirect (fixnum) ( fixnum "XMapEvent_override_redirect" )) ++(defentry set-XMapEvent-override_redirect (fixnum fixnum) ( void "set_XMapEvent_override_redirect" )) ++(defentry XMapEvent-window (fixnum) ( fixnum "XMapEvent_window" )) ++(defentry set-XMapEvent-window (fixnum fixnum) ( void "set_XMapEvent_window" )) ++(defentry XMapEvent-event (fixnum) ( fixnum "XMapEvent_event" )) ++(defentry set-XMapEvent-event (fixnum fixnum) ( void "set_XMapEvent_event" )) ++(defentry XMapEvent-display (fixnum) ( fixnum "XMapEvent_display" )) ++(defentry set-XMapEvent-display (fixnum fixnum) ( void "set_XMapEvent_display" )) ++(defentry XMapEvent-send_event (fixnum) ( fixnum "XMapEvent_send_event" )) ++(defentry set-XMapEvent-send_event (fixnum fixnum) ( void "set_XMapEvent_send_event" )) ++(defentry XMapEvent-serial (fixnum) ( fixnum "XMapEvent_serial" )) ++(defentry set-XMapEvent-serial (fixnum fixnum) ( void "set_XMapEvent_serial" )) ++(defentry XMapEvent-type (fixnum) ( fixnum "XMapEvent_type" )) ++(defentry set-XMapEvent-type (fixnum fixnum) ( void "set_XMapEvent_type" )) ++ ++ ++;;;;;; XMapRequestEvent funcions ;;;;;; ++ ++(defentry make-XMapRequestEvent () ( fixnum "make_XMapRequestEvent" )) ++(defentry XMapRequestEvent-window (fixnum) ( fixnum "XMapRequestEvent_window" )) ++(defentry set-XMapRequestEvent-window (fixnum fixnum) ( void "set_XMapRequestEvent_window" )) ++(defentry XMapRequestEvent-parent (fixnum) ( fixnum "XMapRequestEvent_parent" )) ++(defentry set-XMapRequestEvent-parent (fixnum fixnum) ( void "set_XMapRequestEvent_parent" )) ++(defentry XMapRequestEvent-display (fixnum) ( fixnum "XMapRequestEvent_display" )) ++(defentry set-XMapRequestEvent-display (fixnum fixnum) ( void "set_XMapRequestEvent_display" )) ++(defentry XMapRequestEvent-send_event (fixnum) ( fixnum "XMapRequestEvent_send_event" )) ++(defentry set-XMapRequestEvent-send_event (fixnum fixnum) ( void "set_XMapRequestEvent_send_event" )) ++(defentry XMapRequestEvent-serial (fixnum) ( fixnum "XMapRequestEvent_serial" )) ++(defentry set-XMapRequestEvent-serial (fixnum fixnum) ( void "set_XMapRequestEvent_serial" )) ++(defentry XMapRequestEvent-type (fixnum) ( fixnum "XMapRequestEvent_type" )) ++(defentry set-XMapRequestEvent-type (fixnum fixnum) ( void "set_XMapRequestEvent_type" )) ++ ++ ++;;;;;; XReparentEvent funcions ;;;;;; ++ ++(defentry make-XReparentEvent () ( fixnum "make_XReparentEvent" )) ++(defentry XReparentEvent-override_redirect (fixnum) ( fixnum "XReparentEvent_override_redirect" )) ++(defentry set-XReparentEvent-override_redirect (fixnum fixnum) ( void "set_XReparentEvent_override_redirect" )) ++(defentry XReparentEvent-y (fixnum) ( fixnum "XReparentEvent_y" )) ++(defentry set-XReparentEvent-y (fixnum fixnum) ( void "set_XReparentEvent_y" )) ++(defentry XReparentEvent-x (fixnum) ( fixnum "XReparentEvent_x" )) ++(defentry set-XReparentEvent-x (fixnum fixnum) ( void "set_XReparentEvent_x" )) ++(defentry XReparentEvent-parent (fixnum) ( fixnum "XReparentEvent_parent" )) ++(defentry set-XReparentEvent-parent (fixnum fixnum) ( void "set_XReparentEvent_parent" )) ++(defentry XReparentEvent-window (fixnum) ( fixnum "XReparentEvent_window" )) ++(defentry set-XReparentEvent-window (fixnum fixnum) ( void "set_XReparentEvent_window" )) ++(defentry XReparentEvent-event (fixnum) ( fixnum "XReparentEvent_event" )) ++(defentry set-XReparentEvent-event (fixnum fixnum) ( void "set_XReparentEvent_event" )) ++(defentry XReparentEvent-display (fixnum) ( fixnum "XReparentEvent_display" )) ++(defentry set-XReparentEvent-display (fixnum fixnum) ( void "set_XReparentEvent_display" )) ++(defentry XReparentEvent-send_event (fixnum) ( fixnum "XReparentEvent_send_event" )) ++(defentry set-XReparentEvent-send_event (fixnum fixnum) ( void "set_XReparentEvent_send_event" )) ++(defentry XReparentEvent-serial (fixnum) ( fixnum "XReparentEvent_serial" )) ++(defentry set-XReparentEvent-serial (fixnum fixnum) ( void "set_XReparentEvent_serial" )) ++(defentry XReparentEvent-type (fixnum) ( fixnum "XReparentEvent_type" )) ++(defentry set-XReparentEvent-type (fixnum fixnum) ( void "set_XReparentEvent_type" )) ++ ++ ++;;;;;; XConfigureEvent funcions ;;;;;; ++ ++(defentry make-XConfigureEvent () ( fixnum "make_XConfigureEvent" )) ++(defentry XConfigureEvent-override_redirect (fixnum) ( fixnum "XConfigureEvent_override_redirect" )) ++(defentry set-XConfigureEvent-override_redirect (fixnum fixnum) ( void "set_XConfigureEvent_override_redirect" )) ++(defentry XConfigureEvent-above (fixnum) ( fixnum "XConfigureEvent_above" )) ++(defentry set-XConfigureEvent-above (fixnum fixnum) ( void "set_XConfigureEvent_above" )) ++(defentry XConfigureEvent-border_width (fixnum) ( fixnum "XConfigureEvent_border_width" )) ++(defentry set-XConfigureEvent-border_width (fixnum fixnum) ( void "set_XConfigureEvent_border_width" )) ++(defentry XConfigureEvent-height (fixnum) ( fixnum "XConfigureEvent_height" )) ++(defentry set-XConfigureEvent-height (fixnum fixnum) ( void "set_XConfigureEvent_height" )) ++(defentry XConfigureEvent-width (fixnum) ( fixnum "XConfigureEvent_width" )) ++(defentry set-XConfigureEvent-width (fixnum fixnum) ( void "set_XConfigureEvent_width" )) ++(defentry XConfigureEvent-y (fixnum) ( fixnum "XConfigureEvent_y" )) ++(defentry set-XConfigureEvent-y (fixnum fixnum) ( void "set_XConfigureEvent_y" )) ++(defentry XConfigureEvent-x (fixnum) ( fixnum "XConfigureEvent_x" )) ++(defentry set-XConfigureEvent-x (fixnum fixnum) ( void "set_XConfigureEvent_x" )) ++(defentry XConfigureEvent-window (fixnum) ( fixnum "XConfigureEvent_window" )) ++(defentry set-XConfigureEvent-window (fixnum fixnum) ( void "set_XConfigureEvent_window" )) ++(defentry XConfigureEvent-event (fixnum) ( fixnum "XConfigureEvent_event" )) ++(defentry set-XConfigureEvent-event (fixnum fixnum) ( void "set_XConfigureEvent_event" )) ++(defentry XConfigureEvent-display (fixnum) ( fixnum "XConfigureEvent_display" )) ++(defentry set-XConfigureEvent-display (fixnum fixnum) ( void "set_XConfigureEvent_display" )) ++(defentry XConfigureEvent-send_event (fixnum) ( fixnum "XConfigureEvent_send_event" )) ++(defentry set-XConfigureEvent-send_event (fixnum fixnum) ( void "set_XConfigureEvent_send_event" )) ++(defentry XConfigureEvent-serial (fixnum) ( fixnum "XConfigureEvent_serial" )) ++(defentry set-XConfigureEvent-serial (fixnum fixnum) ( void "set_XConfigureEvent_serial" )) ++(defentry XConfigureEvent-type (fixnum) ( fixnum "XConfigureEvent_type" )) ++(defentry set-XConfigureEvent-type (fixnum fixnum) ( void "set_XConfigureEvent_type" )) ++ ++ ++;;;;;; XGravityEvent funcions ;;;;;; ++ ++(defentry make-XGravityEvent () ( fixnum "make_XGravityEvent" )) ++(defentry XGravityEvent-y (fixnum) ( fixnum "XGravityEvent_y" )) ++(defentry set-XGravityEvent-y (fixnum fixnum) ( void "set_XGravityEvent_y" )) ++(defentry XGravityEvent-x (fixnum) ( fixnum "XGravityEvent_x" )) ++(defentry set-XGravityEvent-x (fixnum fixnum) ( void "set_XGravityEvent_x" )) ++(defentry XGravityEvent-window (fixnum) ( fixnum "XGravityEvent_window" )) ++(defentry set-XGravityEvent-window (fixnum fixnum) ( void "set_XGravityEvent_window" )) ++(defentry XGravityEvent-event (fixnum) ( fixnum "XGravityEvent_event" )) ++(defentry set-XGravityEvent-event (fixnum fixnum) ( void "set_XGravityEvent_event" )) ++(defentry XGravityEvent-display (fixnum) ( fixnum "XGravityEvent_display" )) ++(defentry set-XGravityEvent-display (fixnum fixnum) ( void "set_XGravityEvent_display" )) ++(defentry XGravityEvent-send_event (fixnum) ( fixnum "XGravityEvent_send_event" )) ++(defentry set-XGravityEvent-send_event (fixnum fixnum) ( void "set_XGravityEvent_send_event" )) ++(defentry XGravityEvent-serial (fixnum) ( fixnum "XGravityEvent_serial" )) ++(defentry set-XGravityEvent-serial (fixnum fixnum) ( void "set_XGravityEvent_serial" )) ++(defentry XGravityEvent-type (fixnum) ( fixnum "XGravityEvent_type" )) ++(defentry set-XGravityEvent-type (fixnum fixnum) ( void "set_XGravityEvent_type" )) ++ ++ ++;;;;;; XResizeRequestEvent funcions ;;;;;; ++ ++(defentry make-XResizeRequestEvent () ( fixnum "make_XResizeRequestEvent" )) ++(defentry XResizeRequestEvent-height (fixnum) ( fixnum "XResizeRequestEvent_height" )) ++(defentry set-XResizeRequestEvent-height (fixnum fixnum) ( void "set_XResizeRequestEvent_height" )) ++(defentry XResizeRequestEvent-width (fixnum) ( fixnum "XResizeRequestEvent_width" )) ++(defentry set-XResizeRequestEvent-width (fixnum fixnum) ( void "set_XResizeRequestEvent_width" )) ++(defentry XResizeRequestEvent-window (fixnum) ( fixnum "XResizeRequestEvent_window" )) ++(defentry set-XResizeRequestEvent-window (fixnum fixnum) ( void "set_XResizeRequestEvent_window" )) ++(defentry XResizeRequestEvent-display (fixnum) ( fixnum "XResizeRequestEvent_display" )) ++(defentry set-XResizeRequestEvent-display (fixnum fixnum) ( void "set_XResizeRequestEvent_display" )) ++(defentry XResizeRequestEvent-send_event (fixnum) ( fixnum "XResizeRequestEvent_send_event" )) ++(defentry set-XResizeRequestEvent-send_event (fixnum fixnum) ( void "set_XResizeRequestEvent_send_event" )) ++(defentry XResizeRequestEvent-serial (fixnum) ( fixnum "XResizeRequestEvent_serial" )) ++(defentry set-XResizeRequestEvent-serial (fixnum fixnum) ( void "set_XResizeRequestEvent_serial" )) ++(defentry XResizeRequestEvent-type (fixnum) ( fixnum "XResizeRequestEvent_type" )) ++(defentry set-XResizeRequestEvent-type (fixnum fixnum) ( void "set_XResizeRequestEvent_type" )) ++ ++ ++;;;;;; XConfigureRequestEvent funcions ;;;;;; ++ ++(defentry make-XConfigureRequestEvent () ( fixnum "make_XConfigureRequestEvent" )) ++(defentry XConfigureRequestEvent-value_mask (fixnum) ( fixnum "XConfigureRequestEvent_value_mask" )) ++(defentry set-XConfigureRequestEvent-value_mask (fixnum fixnum) ( void "set_XConfigureRequestEvent_value_mask" )) ++(defentry XConfigureRequestEvent-detail (fixnum) ( fixnum "XConfigureRequestEvent_detail" )) ++(defentry set-XConfigureRequestEvent-detail (fixnum fixnum) ( void "set_XConfigureRequestEvent_detail" )) ++(defentry XConfigureRequestEvent-above (fixnum) ( fixnum "XConfigureRequestEvent_above" )) ++(defentry set-XConfigureRequestEvent-above (fixnum fixnum) ( void "set_XConfigureRequestEvent_above" )) ++(defentry XConfigureRequestEvent-border_width (fixnum) ( fixnum "XConfigureRequestEvent_border_width" )) ++(defentry set-XConfigureRequestEvent-border_width (fixnum fixnum) ( void "set_XConfigureRequestEvent_border_width" )) ++(defentry XConfigureRequestEvent-height (fixnum) ( fixnum "XConfigureRequestEvent_height" )) ++(defentry set-XConfigureRequestEvent-height (fixnum fixnum) ( void "set_XConfigureRequestEvent_height" )) ++(defentry XConfigureRequestEvent-width (fixnum) ( fixnum "XConfigureRequestEvent_width" )) ++(defentry set-XConfigureRequestEvent-width (fixnum fixnum) ( void "set_XConfigureRequestEvent_width" )) ++(defentry XConfigureRequestEvent-y (fixnum) ( fixnum "XConfigureRequestEvent_y" )) ++(defentry set-XConfigureRequestEvent-y (fixnum fixnum) ( void "set_XConfigureRequestEvent_y" )) ++(defentry XConfigureRequestEvent-x (fixnum) ( fixnum "XConfigureRequestEvent_x" )) ++(defentry set-XConfigureRequestEvent-x (fixnum fixnum) ( void "set_XConfigureRequestEvent_x" )) ++(defentry XConfigureRequestEvent-window (fixnum) ( fixnum "XConfigureRequestEvent_window" )) ++(defentry set-XConfigureRequestEvent-window (fixnum fixnum) ( void "set_XConfigureRequestEvent_window" )) ++(defentry XConfigureRequestEvent-parent (fixnum) ( fixnum "XConfigureRequestEvent_parent" )) ++(defentry set-XConfigureRequestEvent-parent (fixnum fixnum) ( void "set_XConfigureRequestEvent_parent" )) ++(defentry XConfigureRequestEvent-display (fixnum) ( fixnum "XConfigureRequestEvent_display" )) ++(defentry set-XConfigureRequestEvent-display (fixnum fixnum) ( void "set_XConfigureRequestEvent_display" )) ++(defentry XConfigureRequestEvent-send_event (fixnum) ( fixnum "XConfigureRequestEvent_send_event" )) ++(defentry set-XConfigureRequestEvent-send_event (fixnum fixnum) ( void "set_XConfigureRequestEvent_send_event" )) ++(defentry XConfigureRequestEvent-serial (fixnum) ( fixnum "XConfigureRequestEvent_serial" )) ++(defentry set-XConfigureRequestEvent-serial (fixnum fixnum) ( void "set_XConfigureRequestEvent_serial" )) ++(defentry XConfigureRequestEvent-type (fixnum) ( fixnum "XConfigureRequestEvent_type" )) ++(defentry set-XConfigureRequestEvent-type (fixnum fixnum) ( void "set_XConfigureRequestEvent_type" )) ++ ++ ++;;;;;; XCirculateEvent funcions ;;;;;; ++ ++(defentry make-XCirculateEvent () ( fixnum "make_XCirculateEvent" )) ++(defentry XCirculateEvent-place (fixnum) ( fixnum "XCirculateEvent_place" )) ++(defentry set-XCirculateEvent-place (fixnum fixnum) ( void "set_XCirculateEvent_place" )) ++(defentry XCirculateEvent-window (fixnum) ( fixnum "XCirculateEvent_window" )) ++(defentry set-XCirculateEvent-window (fixnum fixnum) ( void "set_XCirculateEvent_window" )) ++(defentry XCirculateEvent-event (fixnum) ( fixnum "XCirculateEvent_event" )) ++(defentry set-XCirculateEvent-event (fixnum fixnum) ( void "set_XCirculateEvent_event" )) ++(defentry XCirculateEvent-display (fixnum) ( fixnum "XCirculateEvent_display" )) ++(defentry set-XCirculateEvent-display (fixnum fixnum) ( void "set_XCirculateEvent_display" )) ++(defentry XCirculateEvent-send_event (fixnum) ( fixnum "XCirculateEvent_send_event" )) ++(defentry set-XCirculateEvent-send_event (fixnum fixnum) ( void "set_XCirculateEvent_send_event" )) ++(defentry XCirculateEvent-serial (fixnum) ( fixnum "XCirculateEvent_serial" )) ++(defentry set-XCirculateEvent-serial (fixnum fixnum) ( void "set_XCirculateEvent_serial" )) ++(defentry XCirculateEvent-type (fixnum) ( fixnum "XCirculateEvent_type" )) ++(defentry set-XCirculateEvent-type (fixnum fixnum) ( void "set_XCirculateEvent_type" )) ++ ++ ++;;;;;; XCirculateRequestEvent funcions ;;;;;; ++ ++(defentry make-XCirculateRequestEvent () ( fixnum "make_XCirculateRequestEvent" )) ++(defentry XCirculateRequestEvent-place (fixnum) ( fixnum "XCirculateRequestEvent_place" )) ++(defentry set-XCirculateRequestEvent-place (fixnum fixnum) ( void "set_XCirculateRequestEvent_place" )) ++(defentry XCirculateRequestEvent-window (fixnum) ( fixnum "XCirculateRequestEvent_window" )) ++(defentry set-XCirculateRequestEvent-window (fixnum fixnum) ( void "set_XCirculateRequestEvent_window" )) ++(defentry XCirculateRequestEvent-parent (fixnum) ( fixnum "XCirculateRequestEvent_parent" )) ++(defentry set-XCirculateRequestEvent-parent (fixnum fixnum) ( void "set_XCirculateRequestEvent_parent" )) ++(defentry XCirculateRequestEvent-display (fixnum) ( fixnum "XCirculateRequestEvent_display" )) ++(defentry set-XCirculateRequestEvent-display (fixnum fixnum) ( void "set_XCirculateRequestEvent_display" )) ++(defentry XCirculateRequestEvent-send_event (fixnum) ( fixnum "XCirculateRequestEvent_send_event" )) ++(defentry set-XCirculateRequestEvent-send_event (fixnum fixnum) ( void "set_XCirculateRequestEvent_send_event" )) ++(defentry XCirculateRequestEvent-serial (fixnum) ( fixnum "XCirculateRequestEvent_serial" )) ++(defentry set-XCirculateRequestEvent-serial (fixnum fixnum) ( void "set_XCirculateRequestEvent_serial" )) ++(defentry XCirculateRequestEvent-type (fixnum) ( fixnum "XCirculateRequestEvent_type" )) ++(defentry set-XCirculateRequestEvent-type (fixnum fixnum) ( void "set_XCirculateRequestEvent_type" )) ++ ++ ++;;;;;; XPropertyEvent funcions ;;;;;; ++ ++(defentry make-XPropertyEvent () ( fixnum "make_XPropertyEvent" )) ++(defentry XPropertyEvent-state (fixnum) ( fixnum "XPropertyEvent_state" )) ++(defentry set-XPropertyEvent-state (fixnum fixnum) ( void "set_XPropertyEvent_state" )) ++(defentry XPropertyEvent-time (fixnum) ( fixnum "XPropertyEvent_time" )) ++(defentry set-XPropertyEvent-time (fixnum fixnum) ( void "set_XPropertyEvent_time" )) ++(defentry XPropertyEvent-atom (fixnum) ( fixnum "XPropertyEvent_atom" )) ++(defentry set-XPropertyEvent-atom (fixnum fixnum) ( void "set_XPropertyEvent_atom" )) ++(defentry XPropertyEvent-window (fixnum) ( fixnum "XPropertyEvent_window" )) ++(defentry set-XPropertyEvent-window (fixnum fixnum) ( void "set_XPropertyEvent_window" )) ++(defentry XPropertyEvent-display (fixnum) ( fixnum "XPropertyEvent_display" )) ++(defentry set-XPropertyEvent-display (fixnum fixnum) ( void "set_XPropertyEvent_display" )) ++(defentry XPropertyEvent-send_event (fixnum) ( fixnum "XPropertyEvent_send_event" )) ++(defentry set-XPropertyEvent-send_event (fixnum fixnum) ( void "set_XPropertyEvent_send_event" )) ++(defentry XPropertyEvent-serial (fixnum) ( fixnum "XPropertyEvent_serial" )) ++(defentry set-XPropertyEvent-serial (fixnum fixnum) ( void "set_XPropertyEvent_serial" )) ++(defentry XPropertyEvent-type (fixnum) ( fixnum "XPropertyEvent_type" )) ++(defentry set-XPropertyEvent-type (fixnum fixnum) ( void "set_XPropertyEvent_type" )) ++ ++ ++;;;;;; XSelectionClearEvent funcions ;;;;;; ++ ++(defentry make-XSelectionClearEvent () ( fixnum "make_XSelectionClearEvent" )) ++(defentry XSelectionClearEvent-time (fixnum) ( fixnum "XSelectionClearEvent_time" )) ++(defentry set-XSelectionClearEvent-time (fixnum fixnum) ( void "set_XSelectionClearEvent_time" )) ++(defentry XSelectionClearEvent-selection (fixnum) ( fixnum "XSelectionClearEvent_selection" )) ++(defentry set-XSelectionClearEvent-selection (fixnum fixnum) ( void "set_XSelectionClearEvent_selection" )) ++(defentry XSelectionClearEvent-window (fixnum) ( fixnum "XSelectionClearEvent_window" )) ++(defentry set-XSelectionClearEvent-window (fixnum fixnum) ( void "set_XSelectionClearEvent_window" )) ++(defentry XSelectionClearEvent-display (fixnum) ( fixnum "XSelectionClearEvent_display" )) ++(defentry set-XSelectionClearEvent-display (fixnum fixnum) ( void "set_XSelectionClearEvent_display" )) ++(defentry XSelectionClearEvent-send_event (fixnum) ( fixnum "XSelectionClearEvent_send_event" )) ++(defentry set-XSelectionClearEvent-send_event (fixnum fixnum) ( void "set_XSelectionClearEvent_send_event" )) ++(defentry XSelectionClearEvent-serial (fixnum) ( fixnum "XSelectionClearEvent_serial" )) ++(defentry set-XSelectionClearEvent-serial (fixnum fixnum) ( void "set_XSelectionClearEvent_serial" )) ++(defentry XSelectionClearEvent-type (fixnum) ( fixnum "XSelectionClearEvent_type" )) ++(defentry set-XSelectionClearEvent-type (fixnum fixnum) ( void "set_XSelectionClearEvent_type" )) ++ ++ ++;;;;;; XSelectionRequestEvent funcions ;;;;;; ++ ++(defentry make-XSelectionRequestEvent () ( fixnum "make_XSelectionRequestEvent" )) ++(defentry XSelectionRequestEvent-time (fixnum) ( fixnum "XSelectionRequestEvent_time" )) ++(defentry set-XSelectionRequestEvent-time (fixnum fixnum) ( void "set_XSelectionRequestEvent_time" )) ++(defentry XSelectionRequestEvent-property (fixnum) ( fixnum "XSelectionRequestEvent_property" )) ++(defentry set-XSelectionRequestEvent-property (fixnum fixnum) ( void "set_XSelectionRequestEvent_property" )) ++(defentry XSelectionRequestEvent-target (fixnum) ( fixnum "XSelectionRequestEvent_target" )) ++(defentry set-XSelectionRequestEvent-target (fixnum fixnum) ( void "set_XSelectionRequestEvent_target" )) ++(defentry XSelectionRequestEvent-selection (fixnum) ( fixnum "XSelectionRequestEvent_selection" )) ++(defentry set-XSelectionRequestEvent-selection (fixnum fixnum) ( void "set_XSelectionRequestEvent_selection" )) ++(defentry XSelectionRequestEvent-requestor (fixnum) ( fixnum "XSelectionRequestEvent_requestor" )) ++(defentry set-XSelectionRequestEvent-requestor (fixnum fixnum) ( void "set_XSelectionRequestEvent_requestor" )) ++(defentry XSelectionRequestEvent-owner (fixnum) ( fixnum "XSelectionRequestEvent_owner" )) ++(defentry set-XSelectionRequestEvent-owner (fixnum fixnum) ( void "set_XSelectionRequestEvent_owner" )) ++(defentry XSelectionRequestEvent-display (fixnum) ( fixnum "XSelectionRequestEvent_display" )) ++(defentry set-XSelectionRequestEvent-display (fixnum fixnum) ( void "set_XSelectionRequestEvent_display" )) ++(defentry XSelectionRequestEvent-send_event (fixnum) ( fixnum "XSelectionRequestEvent_send_event" )) ++(defentry set-XSelectionRequestEvent-send_event (fixnum fixnum) ( void "set_XSelectionRequestEvent_send_event" )) ++(defentry XSelectionRequestEvent-serial (fixnum) ( fixnum "XSelectionRequestEvent_serial" )) ++(defentry set-XSelectionRequestEvent-serial (fixnum fixnum) ( void "set_XSelectionRequestEvent_serial" )) ++(defentry XSelectionRequestEvent-type (fixnum) ( fixnum "XSelectionRequestEvent_type" )) ++(defentry set-XSelectionRequestEvent-type (fixnum fixnum) ( void "set_XSelectionRequestEvent_type" )) ++ ++ ++;;;;;; XSelectionEvent funcions ;;;;;; ++ ++(defentry make-XSelectionEvent () ( fixnum "make_XSelectionEvent" )) ++(defentry XSelectionEvent-time (fixnum) ( fixnum "XSelectionEvent_time" )) ++(defentry set-XSelectionEvent-time (fixnum fixnum) ( void "set_XSelectionEvent_time" )) ++(defentry XSelectionEvent-property (fixnum) ( fixnum "XSelectionEvent_property" )) ++(defentry set-XSelectionEvent-property (fixnum fixnum) ( void "set_XSelectionEvent_property" )) ++(defentry XSelectionEvent-target (fixnum) ( fixnum "XSelectionEvent_target" )) ++(defentry set-XSelectionEvent-target (fixnum fixnum) ( void "set_XSelectionEvent_target" )) ++(defentry XSelectionEvent-selection (fixnum) ( fixnum "XSelectionEvent_selection" )) ++(defentry set-XSelectionEvent-selection (fixnum fixnum) ( void "set_XSelectionEvent_selection" )) ++(defentry XSelectionEvent-requestor (fixnum) ( fixnum "XSelectionEvent_requestor" )) ++(defentry set-XSelectionEvent-requestor (fixnum fixnum) ( void "set_XSelectionEvent_requestor" )) ++(defentry XSelectionEvent-display (fixnum) ( fixnum "XSelectionEvent_display" )) ++(defentry set-XSelectionEvent-display (fixnum fixnum) ( void "set_XSelectionEvent_display" )) ++(defentry XSelectionEvent-send_event (fixnum) ( fixnum "XSelectionEvent_send_event" )) ++(defentry set-XSelectionEvent-send_event (fixnum fixnum) ( void "set_XSelectionEvent_send_event" )) ++(defentry XSelectionEvent-serial (fixnum) ( fixnum "XSelectionEvent_serial" )) ++(defentry set-XSelectionEvent-serial (fixnum fixnum) ( void "set_XSelectionEvent_serial" )) ++(defentry XSelectionEvent-type (fixnum) ( fixnum "XSelectionEvent_type" )) ++(defentry set-XSelectionEvent-type (fixnum fixnum) ( void "set_XSelectionEvent_type" )) ++ ++ ++;;;;;; XColormapEvent funcions ;;;;;; ++ ++(defentry make-XColormapEvent () ( fixnum "make_XColormapEvent" )) ++(defentry XColormapEvent-state (fixnum) ( fixnum "XColormapEvent_state" )) ++(defentry set-XColormapEvent-state (fixnum fixnum) ( void "set_XColormapEvent_state" )) ++(defentry XColormapEvent-new (fixnum) ( fixnum "XColormapEvent_new" )) ++(defentry set-XColormapEvent-new (fixnum fixnum) ( void "set_XColormapEvent_new" )) ++(defentry XColormapEvent-colormap (fixnum) ( fixnum "XColormapEvent_colormap" )) ++(defentry set-XColormapEvent-colormap (fixnum fixnum) ( void "set_XColormapEvent_colormap" )) ++(defentry XColormapEvent-window (fixnum) ( fixnum "XColormapEvent_window" )) ++(defentry set-XColormapEvent-window (fixnum fixnum) ( void "set_XColormapEvent_window" )) ++(defentry XColormapEvent-display (fixnum) ( fixnum "XColormapEvent_display" )) ++(defentry set-XColormapEvent-display (fixnum fixnum) ( void "set_XColormapEvent_display" )) ++(defentry XColormapEvent-send_event (fixnum) ( fixnum "XColormapEvent_send_event" )) ++(defentry set-XColormapEvent-send_event (fixnum fixnum) ( void "set_XColormapEvent_send_event" )) ++(defentry XColormapEvent-serial (fixnum) ( fixnum "XColormapEvent_serial" )) ++(defentry set-XColormapEvent-serial (fixnum fixnum) ( void "set_XColormapEvent_serial" )) ++(defentry XColormapEvent-type (fixnum) ( fixnum "XColormapEvent_type" )) ++(defentry set-XColormapEvent-type (fixnum fixnum) ( void "set_XColormapEvent_type" )) ++ ++ ++;;;;;; XClientMessageEvent funcions ;;;;;; ++ ++(defentry make-XClientMessageEvent () ( fixnum "make_XClientMessageEvent" )) ++(defentry XClientMessageEvent-format (fixnum) ( fixnum "XClientMessageEvent_format" )) ++(defentry set-XClientMessageEvent-format (fixnum fixnum) ( void "set_XClientMessageEvent_format" )) ++(defentry XClientMessageEvent-message_type (fixnum) ( fixnum "XClientMessageEvent_message_type" )) ++(defentry set-XClientMessageEvent-message_type (fixnum fixnum) ( void "set_XClientMessageEvent_message_type" )) ++(defentry XClientMessageEvent-window (fixnum) ( fixnum "XClientMessageEvent_window" )) ++(defentry set-XClientMessageEvent-window (fixnum fixnum) ( void "set_XClientMessageEvent_window" )) ++(defentry XClientMessageEvent-display (fixnum) ( fixnum "XClientMessageEvent_display" )) ++(defentry set-XClientMessageEvent-display (fixnum fixnum) ( void "set_XClientMessageEvent_display" )) ++(defentry XClientMessageEvent-send_event (fixnum) ( fixnum "XClientMessageEvent_send_event" )) ++(defentry set-XClientMessageEvent-send_event (fixnum fixnum) ( void "set_XClientMessageEvent_send_event" )) ++(defentry XClientMessageEvent-serial (fixnum) ( fixnum "XClientMessageEvent_serial" )) ++(defentry set-XClientMessageEvent-serial (fixnum fixnum) ( void "set_XClientMessageEvent_serial" )) ++(defentry XClientMessageEvent-type (fixnum) ( fixnum "XClientMessageEvent_type" )) ++(defentry set-XClientMessageEvent-type (fixnum fixnum) ( void "set_XClientMessageEvent_type" )) ++ ++ ++;;;;;; XMappingEvent funcions ;;;;;; ++ ++(defentry make-XMappingEvent () ( fixnum "make_XMappingEvent" )) ++(defentry XMappingEvent-count (fixnum) ( fixnum "XMappingEvent_count" )) ++(defentry set-XMappingEvent-count (fixnum fixnum) ( void "set_XMappingEvent_count" )) ++(defentry XMappingEvent-first_keycode (fixnum) ( fixnum "XMappingEvent_first_keycode" )) ++(defentry set-XMappingEvent-first_keycode (fixnum fixnum) ( void "set_XMappingEvent_first_keycode" )) ++(defentry XMappingEvent-request (fixnum) ( fixnum "XMappingEvent_request" )) ++(defentry set-XMappingEvent-request (fixnum fixnum) ( void "set_XMappingEvent_request" )) ++(defentry XMappingEvent-window (fixnum) ( fixnum "XMappingEvent_window" )) ++(defentry set-XMappingEvent-window (fixnum fixnum) ( void "set_XMappingEvent_window" )) ++(defentry XMappingEvent-display (fixnum) ( fixnum "XMappingEvent_display" )) ++(defentry set-XMappingEvent-display (fixnum fixnum) ( void "set_XMappingEvent_display" )) ++(defentry XMappingEvent-send_event (fixnum) ( fixnum "XMappingEvent_send_event" )) ++(defentry set-XMappingEvent-send_event (fixnum fixnum) ( void "set_XMappingEvent_send_event" )) ++(defentry XMappingEvent-serial (fixnum) ( fixnum "XMappingEvent_serial" )) ++(defentry set-XMappingEvent-serial (fixnum fixnum) ( void "set_XMappingEvent_serial" )) ++(defentry XMappingEvent-type (fixnum) ( fixnum "XMappingEvent_type" )) ++(defentry set-XMappingEvent-type (fixnum fixnum) ( void "set_XMappingEvent_type" )) ++ ++ ++;;;;;; XErrorEvent funcions ;;;;;; ++ ++(defentry make-XErrorEvent () ( fixnum "make_XErrorEvent" )) ++(defentry XErrorEvent-minor_code (fixnum) ( char "XErrorEvent_minor_code" )) ++(defentry set-XErrorEvent-minor_code (fixnum char) ( void "set_XErrorEvent_minor_code" )) ++(defentry XErrorEvent-request_code (fixnum) ( char "XErrorEvent_request_code" )) ++(defentry set-XErrorEvent-request_code (fixnum char) ( void "set_XErrorEvent_request_code" )) ++(defentry XErrorEvent-error_code (fixnum) ( char "XErrorEvent_error_code" )) ++(defentry set-XErrorEvent-error_code (fixnum char) ( void "set_XErrorEvent_error_code" )) ++(defentry XErrorEvent-serial (fixnum) ( fixnum "XErrorEvent_serial" )) ++(defentry set-XErrorEvent-serial (fixnum fixnum) ( void "set_XErrorEvent_serial" )) ++(defentry XErrorEvent-resourceid (fixnum) ( fixnum "XErrorEvent_resourceid" )) ++(defentry set-XErrorEvent-resourceid (fixnum fixnum) ( void "set_XErrorEvent_resourceid" )) ++(defentry XErrorEvent-display (fixnum) ( fixnum "XErrorEvent_display" )) ++(defentry set-XErrorEvent-display (fixnum fixnum) ( void "set_XErrorEvent_display" )) ++(defentry XErrorEvent-type (fixnum) ( fixnum "XErrorEvent_type" )) ++(defentry set-XErrorEvent-type (fixnum fixnum) ( void "set_XErrorEvent_type" )) ++ ++ ++;;;;;; XAnyEvent funcions ;;;;;; ++ ++(defentry make-XAnyEvent () ( fixnum "make_XAnyEvent" )) ++(defentry XAnyEvent-window (fixnum) ( fixnum "XAnyEvent_window" )) ++(defentry set-XAnyEvent-window (fixnum fixnum) ( void "set_XAnyEvent_window" )) ++(defentry XAnyEvent-display (fixnum) ( fixnum "XAnyEvent_display" )) ++(defentry set-XAnyEvent-display (fixnum fixnum) ( void "set_XAnyEvent_display" )) ++(defentry XAnyEvent-send_event (fixnum) ( fixnum "XAnyEvent_send_event" )) ++(defentry set-XAnyEvent-send_event (fixnum fixnum) ( void "set_XAnyEvent_send_event" )) ++(defentry XAnyEvent-serial (fixnum) ( fixnum "XAnyEvent_serial" )) ++(defentry set-XAnyEvent-serial (fixnum fixnum) ( void "set_XAnyEvent_serial" )) ++(defentry XAnyEvent-type (fixnum) ( fixnum "XAnyEvent_type" )) ++(defentry set-XAnyEvent-type (fixnum fixnum) ( void "set_XAnyEvent_type" )) ++ ++ ++;;;;;; XEvent funcions ;;;;;; ++ ++(defentry make-XEvent () ( fixnum "make_XEvent" )) ++;;(defentry XEvent-pad[24] (fixnum) ( fixnum "XEvent_pad[24]" )) ++;;(defentry set-XEvent-pad[24] (fixnum fixnum) ( void "set_XEvent_pad[24]" )) ++;;(defentry XEvent-xkeymap (fixnum) ( XKeymapEvent "XEvent_xkeymap" )) ++;;(defentry set-XEvent-xkeymap (fixnum XKeymapEvent) ( void "set_XEvent_xkeymap" )) ++;;(defentry XEvent-xerror (fixnum) ( XErrorEvent "XEvent_xerror" )) ++;;(defentry set-XEvent-xerror (fixnum XErrorEvent) ( void "set_XEvent_xerror" )) ++;;(defentry XEvent-xmapping (fixnum) ( XMappingEvent "XEvent_xmapping" )) ++;;(defentry set-XEvent-xmapping (fixnum XMappingEvent) ( void "set_XEvent_xmapping" )) ++;;(defentry XEvent-xclient (fixnum) ( XClientMessageEvent "XEvent_xclient" )) ++;;(defentry set-XEvent-xclient (fixnum XClientMessageEvent) ( void "set_XEvent_xclient" )) ++;;(defentry XEvent-xcolormap (fixnum) ( XColormapEvent "XEvent_xcolormap" )) ++;;(defentry set-XEvent-xcolormap (fixnum XColormapEvent) ( void "set_XEvent_xcolormap" )) ++;;(defentry XEvent-xselection (fixnum) ( XSelectionEvent "XEvent_xselection" )) ++;;(defentry set-XEvent-xselection (fixnum XSelectionEvent) ( void "set_XEvent_xselection" )) ++;;(defentry XEvent-xselectionrequest (fixnum) ( XSelectionRequestEvent "XEvent_xselectionrequest" )) ++;;(defentry set-XEvent-xselectionrequest (fixnum XSelectionRequestEvent) ( void "set_XEvent_xselectionrequest" )) ++;;(defentry XEvent-xselectionclear (fixnum) ( XSelectionClearEvent "XEvent_xselectionclear" )) ++;;(defentry set-XEvent-xselectionclear (fixnum XSelectionClearEvent) ( void "set_XEvent_xselectionclear" )) ++;;(defentry XEvent-xproperty (fixnum) ( XPropertyEvent "XEvent_xproperty" )) ++;;(defentry set-XEvent-xproperty (fixnum XPropertyEvent) ( void "set_XEvent_xproperty" )) ++;;(defentry XEvent-xcirculaterequest (fixnum) ( XCirculateRequestEvent "XEvent_xcirculaterequest" )) ++;;(defentry set-XEvent-xcirculaterequest (fixnum XCirculateRequestEvent) ( void "set_XEvent_xcirculaterequest" )) ++;;(defentry XEvent-xcirculate (fixnum) ( XCirculateEvent "XEvent_xcirculate" )) ++;;(defentry set-XEvent-xcirculate (fixnum XCirculateEvent) ( void "set_XEvent_xcirculate" )) ++;;(defentry XEvent-xconfigurerequest (fixnum) ( XConfigureRequestEvent "XEvent_xconfigurerequest" )) ++;;(defentry set-XEvent-xconfigurerequest (fixnum XConfigureRequestEvent) ( void "set_XEvent_xconfigurerequest" )) ++;;(defentry XEvent-xresizerequest (fixnum) ( XResizeRequestEvent "XEvent_xresizerequest" )) ++;;(defentry set-XEvent-xresizerequest (fixnum XResizeRequestEvent) ( void "set_XEvent_xresizerequest" )) ++;;(defentry XEvent-xgravity (fixnum) ( XGravityEvent "XEvent_xgravity" )) ++;;(defentry set-XEvent-xgravity (fixnum XGravityEvent) ( void "set_XEvent_xgravity" )) ++;;(defentry XEvent-xconfigure (fixnum) ( XConfigureEvent "XEvent_xconfigure" )) ++;;(defentry set-XEvent-xconfigure (fixnum XConfigureEvent) ( void "set_XEvent_xconfigure" )) ++;;(defentry XEvent-xreparent (fixnum) ( XReparentEvent "XEvent_xreparent" )) ++;;(defentry set-XEvent-xreparent (fixnum XReparentEvent) ( void "set_XEvent_xreparent" )) ++;;(defentry XEvent-xmaprequest (fixnum) ( XMapRequestEvent "XEvent_xmaprequest" )) ++;;(defentry set-XEvent-xmaprequest (fixnum XMapRequestEvent) ( void "set_XEvent_xmaprequest" )) ++;;(defentry XEvent-xmap (fixnum) ( XMapEvent "XEvent_xmap" )) ++;;(defentry set-XEvent-xmap (fixnum XMapEvent) ( void "set_XEvent_xmap" )) ++;;(defentry XEvent-xunmap (fixnum) ( XUnmapEvent "XEvent_xunmap" )) ++;;(defentry set-XEvent-xunmap (fixnum XUnmapEvent) ( void "set_XEvent_xunmap" )) ++;;(defentry XEvent-xdestroywindow (fixnum) ( XDestroyWindowEvent "XEvent_xdestroywindow" )) ++;;(defentry set-XEvent-xdestroywindow (fixnum XDestroyWindowEvent) ( void "set_XEvent_xdestroywindow" )) ++;;(defentry XEvent-xcreatewindow (fixnum) ( XCreateWindowEvent "XEvent_xcreatewindow" )) ++;;(defentry set-XEvent-xcreatewindow (fixnum XCreateWindowEvent) ( void "set_XEvent_xcreatewindow" )) ++;;(defentry XEvent-xvisibility (fixnum) ( XVisibilityEvent "XEvent_xvisibility" )) ++;;(defentry set-XEvent-xvisibility (fixnum XVisibilityEvent) ( void "set_XEvent_xvisibility" )) ++;;(defentry XEvent-xnoexpose (fixnum) ( XNoExposeEvent "XEvent_xnoexpose" )) ++;;(defentry set-XEvent-xnoexpose (fixnum XNoExposeEvent) ( void "set_XEvent_xnoexpose" )) ++;;(defentry XEvent-xgraphicsexpose (fixnum) ( XGraphicsExposeEvent "XEvent_xgraphicsexpose" )) ++;;(defentry set-XEvent-xgraphicsexpose (fixnum XGraphicsExposeEvent) ( void "set_XEvent_xgraphicsexpose" )) ++;;(defentry XEvent-xexpose (fixnum) ( XExposeEvent "XEvent_xexpose" )) ++;;(defentry set-XEvent-xexpose (fixnum XExposeEvent) ( void "set_XEvent_xexpose" )) ++;;(defentry XEvent-xfocus (fixnum) ( XFocusChangeEvent "XEvent_xfocus" )) ++;;(defentry set-XEvent-xfocus (fixnum XFocusChangeEvent) ( void "set_XEvent_xfocus" )) ++;;(defentry XEvent-xcrossing (fixnum) ( XCrossingEvent "XEvent_xcrossing" )) ++;;(defentry set-XEvent-xcrossing (fixnum XCrossingEvent) ( void "set_XEvent_xcrossing" )) ++;;(defentry XEvent-xmotion (fixnum) ( XMotionEvent "XEvent_xmotion" )) ++;;(defentry set-XEvent-xmotion (fixnum XMotionEvent) ( void "set_XEvent_xmotion" )) ++;;(defentry XEvent-xbutton (fixnum) ( XButtonEvent "XEvent_xbutton" )) ++;;(defentry set-XEvent-xbutton (fixnum XButtonEvent) ( void "set_XEvent_xbutton" )) ++;;(defentry XEvent-xkey (fixnum) ( XKeyEvent "XEvent_xkey" )) ++;;(defentry set-XEvent-xkey (fixnum XKeyEvent) ( void "set_XEvent_xkey" )) ++;;(defentry XEvent-xany (fixnum) ( XAnyEvent "XEvent_xany" )) ++;;(defentry set-XEvent-xany (fixnum XAnyEvent) ( void "set_XEvent_xany" )) ++;;(defentry XEvent-type (fixnum) ( fixnum "XEvent_type" )) ++;;(defentry set-XEvent-type (fixnum fixnum) ( void "set_XEvent_type" )) ++ ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_draw.lsp +@@ -0,0 +1,1089 @@ ++; draw.lsp Gordon S. Novak Jr. ; 06 Dec 07 ++ ++; Functions to make drawings interactively ++ ++; Copyright (c) 2007 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; 11 Nov 94; 05 Jan 95; 15 Jan 98; 09 Feb 99; 04 Dec 00; 28 Feb 02; 05 Jan 04 ++; 27 Jan 06 ++ ++; See the file gnu.license ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++ ++; Use (draw 'foo) to make a drawing named foo. ++; When finished with the drawing, give commands "Origin - to zero", "Program". ++; This will produce a program (DRAW-FOO w x y) to make the drawing. ++; The LaTex command will print Latex input to make the drawing ++; (but LaTex cannot draw things as well as the draw program). ++; (draw-output &optional names) will save things in a file for later. ++ ++; The small square in the drawing menu is a "button" for picture menus. ++; If buttons are used, a picmenu-spec will be produced with the program. ++ ++(defvar *draw-window* nil) ++(defvar *draw-window-width* 600) ++(defvar *draw-window-height* 600) ++(defvar *draw-leave-window* nil) ; t to leave window displayed at end ++(defvar *draw-menu-set* nil) ++(defvar *draw-zero-vector* '(0 0) ) ++(defvar *draw-latex-factor* 1) ; multiplier from pixels to LaTex ++(defvar *draw-snap-flag* t) ++(defvar *draw-objects* nil) ++(defvar *draw-latex-mode* nil) ++ ++(glispglobals (*draw-window* window) ) ++ ++(defmacro draw-descr (name) `(get ,name 'draw-descr)) ++ ++(glispobjects ++ ++(draw-desc (listobject (name symbol) ++ (objects (listof draw-object)) ++ (offset vector) ++ (size vector)) ++ prop ((fnname draw-desc-fnname) ++ (refpt draw-desc-refpt)) ++ msg ((draw draw-desc-draw) ++ (snap draw-desc-snap) ++ (find draw-desc-find) ++ (delete draw-desc-delete)) ) ++ ++(draw-object (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ default ((linewidth 1)) ++ prop ((region ((virtual region with start = offset size = size))) ++ (vregion ((virtual region with start = vstart size = vsize))) ++ (vstart ((virtual vector with ++ x = (min (x offset) ((x offset) + (x size))) - 2 ++ y = (min (y offset) ((y offset) + (y size))) - 2))) ++ (vsize ((virtual vector with x = (abs (x size)) + 4 ++ y = (abs (y size)) + 4))) ) ++ msg ((erase draw-object-erase) ++ (draw draw-object-draw) ++ (snap draw-object-snap) ++ (selectedp draw-object-selectedp) ++ (move draw-object-move)) ) ++ ++(draw-line (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ prop ((line ((virtual line-segment with p1 = offset ++ p2 = (offset + size))))) ++ msg ((draw draw-line-draw) ++ (snap draw-line-snap) ++ (selectedp draw-line-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-arrow (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ prop ((line ((virtual line-segment with p1 = offset ++ p2 = (offset + size))))) ++ msg ((draw draw-arrow-draw) ++ (snap draw-line-snap) ++ (selectedp draw-line-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-box (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-box-draw) ++ (snap draw-box-snap) ++ (selectedp draw-box-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-rcbox (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-rcbox-draw) ++ (snap draw-rcbox-snap) ++ (selectedp draw-rcbox-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-erase (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-erase-draw) ++ (snap draw-no-snap) ++ (selectedp draw-erase-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-circle (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ prop ((radius ((x size) / 2)) ++ (center (offset + size / 2))) ++ msg ((draw draw-circle-draw) ++ (snap draw-circle-snap) ++ (selectedp draw-circle-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-ellipse (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ prop ((radiusx ((x size) / 2)) ++ (radiusy ((y size) / 2)) ++ (radius ((max radiusx radiusy))) ++ (center (offset + size / 2)) ++ (delta ((sqrt (abs (radiusx ^ 2 - radiusy ^ 2))))) ++ (p1 ((if (radiusx > radiusy) ; 05 Jan 04 ++ (a vector x = (x center) - delta ++ y = (y center)) ++ (a vector x = (x center) ++ y = (y center) - delta)))) ++ (p2 ((if (radiusx > radiusy) ++ (a vector x = (x center) + delta ++ y = (y center)) ++ (a vector x = (x center) ++ y = (y center) + delta)))) ) ++ msg ((draw draw-ellipse-draw) ++ (snap draw-ellipse-snap) ++ (selectedp draw-ellipse-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-dot (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-dot-draw) ++ (snap draw-dot-snap) ++ (selectedp draw-button-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-button (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-button-draw) ++ (snap draw-dot-snap) ++ (selectedp draw-button-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-text (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-text-draw) ++ (snap draw-no-snap) ++ (selectedp draw-text-selectedp) ) ++ supers (draw-object) ) ++ ++; null object: no image, cannot be selected. ++(draw-null (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-null-draw) ++ (snap draw-no-snap) ++ (selectedp draw-null-selectedp) ) ++ supers (draw-object) ) ++ ++(draw-refpt (listobject (offset vector) ++ (size vector) ++ (contents anything) ++ (linewidth integer)) ++ msg ((draw draw-refpt-draw) ++ (snap draw-refpt-snap) ++ (selectedp draw-refpt-selectedp) ) ++ supers (draw-object) ) ++ ++; multi-item drawing group ++(draw-multi (listobject (offset vector) ++ (size vector) ++ (contents (listof draw-object)) ++ (linewidth integer)) ++ msg ((draw draw-multi-draw) ++ (snap draw-no-snap) ++ (selectedp draw-multi-selectedp) ) ++ supers (draw-object) ) ++ ++ ++) ; glispobjects ++ ++; 05 Jan 04 ++; Get drawing description associated with name ++(gldefun draw-desc ((name symbol)) ++ (result draw-desc) ++ (let ((dd draw-desc)) ++ (dd = (draw-descr name)) ++ (if ~ dd (progn (dd = (a draw-desc with name = name)) ++ (setf (draw-descr name) dd))) ++ dd)) ++ ++; Make a window to draw in. ++(setf (glfnresulttype 'draw-window) 'window) ++(defun draw-window () ++ (or *draw-window* ++ (setq *draw-window* ++ (window-create *draw-window-width* *draw-window-height* ++ "Draw window"))) ) ++ ++; 09 Sep 92; 11 Sep 92; 14 Sep 92; 16 Sep 92; 21 Oct 92; 21 May 93; 17 Dec 93 ++; 05 Jan 04 ++(gldefun draw ((name symbol)) ++ (let (w dd done sel (redraw t) (new draw-object)) ++ (w = (draw-window)) ++ (open w) ++ (or *draw-menu-set* (draw-init-menus)) ++ (dd = (draw-desc name)) ++ (unless (member name *draw-objects*) ++ (setq *draw-objects* (nconc *draw-objects* (list name)))) ++ (draw dd w) ++ (while ~ done do ++ (sel = (menu-set-select *draw-menu-set* redraw)) ++ (redraw = nil) ++ (case (menu-name sel) ++ (command ++ (case (port sel) ++ (done (done = t)) ++ (move (draw-desc-move dd w)) ++ (delete (draw-desc-delete dd w)) ++ (copy (draw-desc-copy dd w)) ++ (redraw (clear w) ++ (setq redraw t) ++ (draw dd w)) ++ (origin (draw-desc-origin dd w) ++ (clear w) ++ (setq redraw t) ++ (draw dd w)) ++ (program (draw-desc-program dd)) ++ (latex (draw-desc-latex dd)) ++ (latexmode (setq *draw-latex-mode* (not *draw-latex-mode*)) ++ (format t "Latex Mode is now ~A~%" *draw-latex-mode*)) ++ )) ++ (draw ++ (new = nil) ++ (case (port sel) ++ (rectangle (new = (draw-box-get dd w))) ++ (rcbox (new = (draw-rcbox-get dd w))) ++ (circle (new = (draw-circle-get dd w))) ++ (ellipse (new = (draw-ellipse-get dd w))) ++ (line (new = (draw-line-get dd w))) ++ (arrow (new = (draw-arrow-get dd w))) ++ (dot (new = (draw-dot-get dd w))) ++ (erase (new = (draw-erase-get dd w))) ++ (button (new = (draw-button-get dd w))) ++ (text (new = (draw-text-get dd w))) ++ (refpt (new = (draw-refpt-get dd w)))) ++ (if new ++ (progn ((offset new) _- (offset dd)) ++ ((objects dd) _+ new) ++ (draw new w (offset dd))))) ++ (background nil)) ) ++ (setf (draw-descr name) dd) ++ (unless *draw-leave-window* (close w)) ++ name )) ++ ++; 06 Dec 07 ++; Copy a draw description to another name ++(defun copy-draw-desc (from to) ++ (let (old) ++ (setq old (copy-tree (get from 'draw-descr))) ++ (setf (get to 'draw-descr) ++ (cons (car old) (cons to (cddr old))) ) )) ++ ++; 09 Sep 92 ++(gldefun draw-desc-draw ((dd draw-desc) (w window)) ++ (let ( (off (offset dd)) ) ++ (clear w) ++ (for obj in (objects dd) (draw obj w off)) ++ (force-output w) )) ++ ++; 11 Sep 92; 12 Sep 92; 06 Oct 92; 05 Jan 04 ++; Find a draw-object such that point p selects it ++(gldefun draw-desc-selected ((dd draw-desc) (p vector)) ++ (result draw-object) ++ (let (objs objsb obj) ++ (objs = (for obj in objects when (selectedp obj p (offset dd)) ++ collect obj)) ++ (if objs ++ (if (null (rest objs)) ++ (obj = (first objs)) ++ (progn (objsb = (for z in objs ++ when (member (first z) ++ '(draw-button draw-dot)) ++ collect z)) ++ (if (and objsb (null (rest objsb))) ++ (obj = (first objsb)))) ) ) ++ obj)) ++ ++; 11 Sep 92; 12 Sep 92; 13 Sep 92; 05 Jan 04 ++; Find a draw-object such that point p selects it ++(gldefun draw-desc-find ((dd draw-desc) (w window) &optional (crossflg boolean)) ++ (result draw-object) ++ (let (p obj) ++ (while ~ obj do ++ (p = (if crossflg (draw-get-cross dd w) ++ (draw-get-crosshairs dd w))) ++ (obj = (draw-desc-selected dd p)) ) ++ obj)) ++ ++; 15 Sep 92 ++(gldefun draw-get-cross ((dd draw-desc) (w window)) ++ (result vector) ++ (draw-desc-snap dd (window-get-cross w))) ++ ++; 15 Sep 92 ++(gldefun draw-get-crosshairs ((dd draw-desc) (w window)) ++ (result vector) ++ (draw-desc-snap dd (window-get-crosshairs w))) ++ ++; 12 Sep 92; 14 Sep 92; 06 Oct 92 ++; Delete selected object ++(gldefun draw-desc-delete ((dd draw-desc) (w window)) ++ (let (obj) ++ (obj = (draw-desc-find dd w t)) ++ (erase obj w (offset dd)) ++ ((objects dd) _- obj) )) ++ ++; 12 Sep 92; 07 Oct 92 ++; Copy selected object ++(gldefun draw-desc-copy ((dd draw-desc) (w window)) ++ (let (obj (objb draw-object)) ++ (obj = (draw-desc-find dd w)) ++ (objb = (copy-tree obj)) ++ (draw-get-object-pos objb w) ++ ((offset objb) _- (offset dd)) ++ (draw objb w (offset dd)) ++ (force-output w) ++ ((objects dd) _+ objb) )) ++ ++; 12 Sep 92; 13 Sep 92; 07 Oct 92; 05 Jan 04 ++; Move selected object ++(gldefun draw-desc-move ((dd draw-desc) (w window)) ++ (let (obj) ++ (if (obj = (draw-desc-find dd w)) ++ (move obj w (offset dd))) )) ++ ++; 14 Sep 92; 28 Feb 02; 05 Jan 04; 27 Jan 06 ++; Reset origin of object group ++(gldefun draw-desc-origin ((dd draw-desc) (w window)) ++ (let (sel) ++ (draw-desc-bounds dd) ++ (sel = (menu '(("To zero" . tozero) ("Select" . select)))) ++ (if (sel == 'select) ++ ((offset dd) = (get-box-position w (x (size dd)) (y (size dd)))) ++ (if (sel == 'tozero) ((offset dd) = (a vector x 0 y 0)) ) ))) ++ ++; 14 Sep 92 ++; Compute boundaries of objects in a drawing; set offset and size of ++; the draw-desc and reset offsets of items relative to it. ++(gldefun draw-desc-bounds ((dd draw-desc)) ++ (let ((xmin 9999) (ymin 9999) (xmax 0) (ymax 0) basev) ++ (for obj in objects do ++ (xmin = (min xmin (x (offset obj)) ++ ((x (offset obj)) + (x (size obj))))) ++ (ymin = (min ymin (y (offset obj)) ++ ((y (offset obj)) + (y (size obj))))) ++ (xmax = (max xmax (x (offset obj)) ++ ((x (offset obj)) + (x (size obj))))) ++ (ymax = (max ymax (y (offset obj)) ++ ((y (offset obj)) + (y (size obj))))) ) ++ ((x (size dd)) = (xmax - xmin)) ++ ((y (size dd)) = (ymax - ymin)) ++ (basev = (a vector with x = xmin y = ymin)) ++ ((offset dd) = basev) ++ (for obj in objects do ((offset obj) _- basev)) )) ++ ++; 14 Sep 92; 16 Sep 92; 19 Dec 93; 15 Jan 98; 06 Dec 07 ++; Produce LaTex output for object group. ++; LaTex can only *approximately* reproduce the picture. ++(gldefun draw-desc-latex ((dd draw-desc)) ++ (let (base bx by sx sy) ++ (format t " \\begin{picture}(~5,0F,~5,0F)(0,0)~%" ++ (* (x (size dd)) *draw-latex-factor*) ++ (* (y (size dd)) *draw-latex-factor*) ) ++ (for obj in (objects dd) do ++ (base = (offset dd) + (offset obj)) ++ (bx = (x base) * *draw-latex-factor*) ++ (by = (y base) * *draw-latex-factor*) ++ (sx = (x (size obj)) * *draw-latex-factor*) ++ (sy = (y (size obj)) * *draw-latex-factor*) ++ (case (first obj) ++ (draw-line (latex-line (x base) (y base) ++ ((x base) + sx) ((y base) + sy))) ++ (draw-arrow (latex-line (x base) (y base) ++ ((x base) + sx) ((y base) + sy) t) ) ++ (draw-box ++ (format t " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" ++ bx by sx sy)) ++ (draw-rcbox ++ (format t " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" ++ (bx + sx / 2) (by + sy / 2) sx sy)) ++ (draw-circle ++ (format t " \\put(~5,0F,~5,0F) {\\circle{~5,0F}}~%" ++ (bx + sx / 2) (by + sy / 2) sx)) ++ (draw-ellipse ++ (format t " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" ++ (bx + sx / 2) (by + sy / 2) sx sy)) ++ (draw-button ++ (format t " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" ++ bx by sx sy)) ++ (draw-erase ) ++ (draw-dot ++ (format t " \\put(~5,0F,~5,0F) {\\circle*{~5,0F}}~%" ++ (bx + sx / 2) (by + sy / 2) sx)) ++ (draw-text ++ (format t " \\put(~5,0F,~5,0F) {~A}~%" ++ bx (by + 4 * *draw-latex-factor*) (contents obj)) ) ) ) ++ (format t " \\end{picture}~%") )) ++ ++; 14 Sep 92; 15 Sep 92; 16 Sep 92; 05 Oct 92; 17 Dec 93; 21 Dec 93; 28 Feb 02 ++; 05 Jan 04 ++; Produce program to draw object group ++(gldefun draw-desc-program ((dd draw-desc)) ++ (let (base bx by sx sy tox toy r rx ry s code fncode fnname cd) ++ (code = (for obj in (objects dd) when ++ (cd = (progn ++ (base = (offset dd) + (offset obj) - (refpt dd)) ++ (bx = (x base)) ++ (by = (y base)) ++ (sx = (x (size obj))) ++ (sy = (y (size obj))) ++ (tox = bx + sx) ++ (toy = by + sy) ++ (if ((car obj) == 'draw-circle) ++ (r = (x (size obj)) / 2)) ++ (if ((car obj) == 'draw-ellipse) ++ (progn (rx = (x (size obj)) / 2) ++ (ry = (y (size obj)) / 2))) ++ (draw-optimize ++ (case (first obj) ++ (draw-line `(window-draw-line-xy w (+ x ,bx) (+ y ,by) ++ (+ x ,tox) (+ y ,toy))) ++ (draw-arrow `(window-draw-arrow-xy w (+ x ,bx) (+ y ,by) ++ (+ x ,tox) (+ y ,toy))) ++ (draw-box `(window-draw-box-xy w (+ x ,bx) (+ y ,by) ++ ,sx ,sy)) ++ (draw-rcbox `(window-draw-rcbox-xy w (+ x ,bx) (+ y ,by) ++ ,sx ,sy 8)) ++ (draw-circle `(window-draw-circle-xy w (+ x ,(+ r bx)) ++ (+ y ,(+ r by)) ,r)) ++ (draw-ellipse `(window-draw-ellipse-xy w (+ x ,(+ rx bx)) ++ (+ y ,(+ ry by)) ++ ,rx ,ry)) ++ ((draw-button draw-refpt) ++ nil) ; let picmenu draw the buttons ++ (draw-erase `(window-erase-area-xy w (+ x ,bx) (+ y ,by) ++ ,sx ,sy)) ++ (draw-dot `(window-draw-dot-xy w (+ x ,(+ 2 bx)) ++ (+ y ,(+ 2 by)))) ++ (draw-text (s = (stringify (contents obj))) ++ `(window-printat-xy w ,s (+ x ,bx) (+ y ,by))) ++ )) )) ++ collect cd)) ++ (fncode = (cons 'lambda (cons (list 'w 'x 'y) ++ (nconc code ++ (list (list 'window-force-output ++ 'w)))))) ++ (fnname = (fnname dd)) ++ (setf (symbol-function fnname) fncode) ++ (format t "Constructed program (~A w x y)~%" fnname) ++ (draw-desc-picmenu dd) ++ )) ++ ++; 21 Dec 93 ++; Optimize code if GLISP is present ++(defun draw-optimize (x) (if (fboundp 'glunwrap) (glunwrap x nil) x)) ++ ++; 14 Sep 92 ++(gldefun draw-desc-fnname ((dd draw-desc)) ++ (intern (concatenate 'string "DRAW-" (symbol-name (name dd)))) ) ++ ++; 14 Sep 92; 06 Oct 92; 08 Apr 93; 28 Feb 02; 05 Jan 04 ++; Produce a picmenu-spec from the buttons of a drawing description ++(gldefun draw-desc-picmenu ((dd draw-desc)) ++ (let (buttons) ++ (buttons = (for obj in (objects dd) when ((first obj) == 'draw-button) ++ collect (list (contents obj) ++ ((a vector x 2 y 2) + (offset obj) ++ + (offset dd) )) ) ) ++ (if buttons ++ (setf (get (name dd) 'picmenu-spec) ++ (list 'picmenu-spec (x (size dd)) (y (size dd)) buttons ++ t (fnname dd) '9x15))) )) ++ ++; 15 Sep 92; 05 Jan 04 ++(gldefun draw-desc-snap ((dd draw-desc) (p vector)) ++ (result vector) ++ (let (psnap obj (objs (objects dd)) ) ++ (if *draw-snap-flag* ++ (while objs and ~ psnap do ++ (obj = (pop objs)) ++ (psnap = (draw-object-snap obj p (offset dd))) ) ) ++ (or psnap p) )) ++ ++; 10 Sep 92; 12 Sep 92 ++; Move specified object ++(gldefun draw-object-move ((d draw-object) (w window) (off vector)) ++ (let () ++ (erase d w off) ++ (draw-get-object-pos d w) ++ ((offset d) _- off) ++ (draw d w off) ++ (force-output w) )) ++ ++; 12 Sep 92; 13 Sep 92; 15 Sep 92 ++; Draw an object at specified (x y) by calling its drawing function ++(defun draw-object-draw-at (w x y d) ++ (setf (second d) (list x y)) ++ (draw-object-draw d w *draw-zero-vector*) ) ++ ++; 15 Sep 92 ++; Simulate glsend of draw message to an object ++(defun draw-object-draw (d w off) ++ (funcall (glmethod (car d) 'draw) d w off) ) ++ ++; 15 Sep 92 ++; Simulate glsend of snap message to an object ++(defun draw-object-snap (d p off) ++ (funcall (glmethod (car d) 'snap) d p off) ) ++ ++; 15 Sep 92 ++; Simulate glsend of selectedp message to an object ++(defun draw-object-selectedp (d w off) ++ (funcall (glmethod (car d) 'selectedp) d w off) ) ++ ++; 12 Sep 92; 07 Oct 92; 28 Feb 02; 05 Jan 04; 06 Dec 07 ++(gldefun draw-get-object-pos ((d draw-object) (w window)) ++ (window-get-icon-position w ++ (if ((first d) == 'draw-text) #'draw-text-draw-outline ++ #'draw-object-draw-at) ++ (list d)) ) ++ ++; 10 Sep 92; 15 Sep 92; 05 Jan 04 ++(gldefun draw-object-erase ((d draw-object) (w window) (off vector)) ++ (let () ++ (if ((first d) <> 'draw-erase) ++ (progn (set-xor w) ++ (draw d w off) ++ (unset w)) ))) ++ ++; 09 Sep 92; 17 Dec 93; 19 Dec 93; 04 Dec 00 ++(gldefun draw-line-draw ((d draw-line) (w window) (off vector)) ++ (let ((from (off + (offset d))) (to ((off + (offset d)) + (size d))) ) ++ (draw-line-xy w (x from) (y from) (x to) (y to)) )) ++ ++; 11 Sep 92; 17 Dec 93; 19 Dec 93; 04 Dec 00 ++(gldefun draw-arrow-draw ((d draw-arrow) (w window) (off vector)) ++ (let ((from (off + (offset d))) (to ((off + (offset d)) + (size d))) ) ++ (draw-arrow-xy w (x from) (y from) (x to) (y to)) )) ++ ++; 09 Sep 92; 10 Sep 92; 12 Sep 92 ++(gldefun draw-line-selectedp ((d draw-line) (pt vector) (off vector)) ++ (let ((ptp (pt - off))) ++ (and (contains? (vregion d) ptp) ++ ((distance (line d) ptp) < 5) ) )) ++ ++; 09 Sep 92; 10 Sep 92; 15 Sep 92; 17 Dec 93; 05 Jan 04 ++(gldefun draw-line-get ((dd draw-desc) (w window)) ++ (let (from to) ++ (from = (draw-get-crosshairs dd w)) ++ (to = (if *draw-latex-mode* ++ (window-get-latex-position w (x from) (y from) nil) ++ (draw-desc-snap dd ++ (window-get-line-position w (x from) (y from))))) ++ (a draw-line with offset = from size = (to - from)) )) ++ ++; 11 Sep 92; 15 Sep 92; 17 Dec 93; 05 Jan 04 ++(gldefun draw-arrow-get ((dd draw-desc) (w window)) ++ (let (from to) ++ (from = (draw-get-crosshairs dd w)) ++ (to = (if *draw-latex-mode* ++ (window-get-latex-position w (x from) (y from) nil) ++ (draw-desc-snap dd ++ (window-get-line-position w (x from) (y from))))) ++ (a draw-arrow with offset = from size = (to - from)) )) ++ ++; 09 Sep 92 ++(gldefun draw-box-draw ((d draw-box) (w window) (off vector)) ++ (draw-box w (off + (offset d)) (size d)) ) ++ ++; 09 Sep 92; 11 Sep 92 ++(gldefun draw-box-selectedp ((d draw-box) (p vector) (off vector)) ++ (let ((pt (p - off))) ++ (or (and ((y pt) < (top (vregion d)) + 5) ++ ((y pt) > (bottom (vregion d)) - 5) ++ (or ((abs (x pt) - (left (vregion d))) < 5) ++ ((abs (x pt) - (right (vregion d))) < 5))) ++ (and ((x pt) < (right (vregion d)) + 5) ++ ((x pt) > (left (vregion d)) - 5) ++ (or ((abs (y pt) - (top (vregion d))) < 5) ++ ((abs (y pt) - (bottom (vregion d))) < 5))) ) )) ++ ++; 11 Sep 92 ++(gldefun draw-box-get ((dd draw-desc) (w window)) ++ (let (box) ++ (box = (window-get-region w)) ++ (a draw-box with offset = (start box) size = (size box)) )) ++ ++; (dotimes (i 10) (print (draw-box-selectedp db (window-get-point dw)))) ++ ++; 16 Sep 92 ++(gldefun draw-rcbox-draw ((d draw-box) (w window) (off vector)) ++ (draw-rcbox-xy w ((x off) + (x (offset d))) ((y off) + (y (offset d))) ++ (x (size d)) (y (size d)) 8) ) ++ ++; 16 Sep 92 ++(gldefun draw-rcbox-selectedp ((d draw-box) (p vector) (off vector)) ++ (let ((pt (p - off))) ++ (or (and ((y pt) < (top (vregion d)) - 3) ++ ((y pt) > (bottom (vregion d)) + 3) ++ (or ((abs (x pt) - (left (vregion d))) < 5) ++ ((abs (x pt) - (right (vregion d))) < 5))) ++ (and ((x pt) < (right (vregion d)) - 3) ++ ((x pt) > (left (vregion d)) + 3) ++ (or ((abs (y pt) - (top (vregion d))) < 5) ++ ((abs (y pt) - (bottom (vregion d))) < 5))) ) )) ++ ++; 16 Sep 92 ++(gldefun draw-rcbox-get ((dd draw-desc) (w window)) ++ (let (box) ++ (box = (window-get-region w)) ++ (a draw-rcbox with offset = (start box) size = (size box)) )) ++ ++; 09 Sep 92 ++(gldefun draw-circle-draw ((d draw-circle) (w window) (off vector)) ++ (draw-circle w (off + (center d)) (radius d)) ) ++ ++; 09 Sep 92; 11 Sep 92; 17 Sep 92 ++(gldefun draw-circle-selectedp ((d draw-circle) (p vector) (off vector)) ++ ((abs (radius d) - (magnitude ((center d) + off) - p)) < 5) ) ++ ++; 11 Sep 92; 15 Sep 92 ++(gldefun draw-circle-get ((dd draw-desc) (w window)) ++ (let (cir cent) ++ (cent = (draw-get-crosshairs dd w)) ++ (cir = (window-get-circle w cent)) ++ (a draw-circle with ++ offset = (a vector with x = ( (x (center cir)) - (radius cir) ) ++ y = ( (y (center cir)) - (radius cir) )) ++ size = (a vector with x = 2 * (radius cir) y = 2 * (radius cir))) )) ++ ++; 11 Sep 92 ++(gldefun draw-ellipse-draw ((d draw-ellipse) (w window) (off vector)) ++ (let ((c (off + (center d)))) ++ (draw-ellipse-xy w (x c) (y c) (radiusx d) (radiusy d)) )) ++ ++; 11 Sep 92; 15 Sep 92; 17 Sep 92 ++; Uses the fact that sum of distances from foci is constant. ++(gldefun draw-ellipse-selectedp ((d draw-ellipse) (p vector) (off vector)) ++ (let ((pt (p - off))) ++ ( (abs ( (magnitude ((p1 d) - pt)) + (magnitude ((p2 d) - pt)) ) ++ - 2 * (radius d)) < 2) )) ++ ++; print out what the "boundary" of an ellipse looks like via selectedp ++(defun draw-test-ellipse-selectedp (e) ++ (let ( (size (third e)) (offset (second e)) ) ++ (dotimes (y (+ (cadr size) 10)) ++ (dotimes (x (+ (car size) 10)) ++ (princ (if (draw-ellipse-selectedp e ++ (list (+ x (car offset) -5) (+ y (cadr offset) -5)) ++ (list 0 0)) ++ "T" " "))) ++ (terpri)) )) ++ ++; 11 Sep 92 ++(gldefun draw-ellipse-get ((dd draw-desc) (w window)) ++ (let (ell cent) ++ (cent = (draw-get-crosshairs dd w)) ++ (ell = (window-get-ellipse w cent)) ++ (a draw-ellipse with ++ offset = (a vector with x = ( (x (center ell)) - (x (halfsize ell)) ) ++ y = ( (y (center ell)) - (y (halfsize ell)) )) ++ size = (a vector with x = 2 * (x (halfsize ell)) ++ y = 2 * (y (halfsize ell)))) )) ++ ++; 10 Sep 92 ++(gldefun draw-null-draw ((d draw-null) (w window) (off vector)) nil) ++ ++; 10 Sep 92; 11 Sep 92 ++(gldefun draw-null-selectedp ((d draw-null) (pt vector) (off vector)) nil) ++ ++; 11 Sep 92 ++(gldefun draw-button-draw ((d draw-button) (w window) (off vector)) ++ (draw-box w (off + (offset d)) (a vector x = 4 y = 4)) ) ++ ++; 11 Sep 92 ++(gldefun draw-button-selectedp ((d draw-button) (p vector) (off vector)) ++ (let ( (ptx (((x p) - (x off)) - (x (offset d)))) ++ (pty (((y p) - (y off)) - (y (offset d)))) ) ++ (and (ptx > -2) (ptx < 6) (pty > -2) (pty < 6) ) )) ++ )) ++ ++; 11 Sep 92 ++(gldefun draw-button-get ((dd draw-desc) (w window)) ++ (let (cent var) ++ (princ "Enter button name: ") ++ (var = (read)) ++ (cent = (draw-get-crosshairs dd w)) ++ (a draw-button with ++ offset = (a vector with x = ((x cent) - 2) y = ((y cent) - 2)) ++ size = (a vector with x = 4 y = 4) ++ contents = var) )) ++ ++; 14 Sep 92 ++(gldefun draw-erase-draw ((d draw-box) (w window) (off vector)) ++ (erase-area w (off + (offset d)) (size d)) ) ++ ++; 14 Sep 92 ++(gldefun draw-erase-selectedp ((d draw-box) (p vector) (off vector)) ++ (let ((pt (p - off))) ++ (contains? (region d) pt) )) ++ ++; 14 Sep 92 ++(gldefun draw-erase-get ((dd draw-desc) (w window)) ++ (let (box) ++ (box = (window-get-region w)) ++ (a draw-erase with offset = (start box) size = (size box)) )) ++ ++; 11 Sep 92; 14 Sep 92 ++(gldefun draw-dot-draw ((d draw-dot) (w window) (off vector)) ++ (window-draw-dot-xy w ((x off) + (x (offset d)) + 2) ++ ((y off) + (y (offset d)) + 2) ) ) ++ ++; 11 Sep 92; 15 Sep 92 ++(gldefun draw-dot-get ((dd draw-desc) (w window)) ++ (let (cent) ++ (cent = (draw-get-crosshairs dd w)) ++ (a draw-dot with ++ offset = (a vector with x = ((x cent) - 2) y = ((y cent) - 2)) ++ size = (a vector with x = 4 y = 4)) )) ++ ++; 17 Dec 93 ++(gldefun draw-refpt-draw ((d draw-refpt) (w window) (off vector)) ++ (window-draw-crosshairs-xy w ((x off) + (x (offset d))) ++ ((y off) + (y (offset d))) ) ) ++ ++; 17 Dec 93 ++(gldefun draw-refpt-selectedp ((d draw-button) (p vector) (off vector)) ++ (let ( (ptx (((x p) - (x off)) - (x (offset d)))) ++ (pty (((y p) - (y off)) - (y (offset d)))) ) ++ (and (ptx > -3) (ptx < 3) (pty > -3) (pty < 3) ) )) ++ ++; 17 Dec 93; 05 Jan 04 ++(gldefun draw-refpt-get ((dd draw-desc) (w window)) ++ (let (cent refpt) ++ (if (refpt = (assoc 'draw-refpt (objects dd))) ++ (progn (set-erase *draw-window*) ++ (draw refpt *draw-window* (a vector with x = 0 y = 0)) ++ (unset *draw-window*) ++ ((objects dd) _- refpt) ) ) ++ (cent = (draw-get-crosshairs dd w)) ++ (a draw-refpt with offset = cent ++ size = (a vector with x = 0 y = 0)) )) ++ ++; 17 Dec 93; 05 Jan 04 ++(gldefun draw-desc-refpt ((dd draw-desc)) (result vector) ++ (let (refpt) ++ (refpt = (assoc 'draw-refpt (objects dd))) ++ (if refpt (offset refpt) ++ (a vector x = 0 y = 0)) )) ++ ++; 11 Sep 92; 06 Oct 92; 19 Dec 93; 11 Nov 94 ++(gldefun draw-text-draw ((d draw-text) (w window) (off vector)) ++ (printat-xy w (contents d) ((x off) + (x (offset d))) ++ ((y off) + (y (offset d)))) ) ++ ++; 07 Oct 92 ++(gldefun draw-text-draw-outline ((w window) (x integer) (y integer) (d draw-text)) ++ (setf (second d) (list x y)) ++ (draw-box-xy w x (y + 2) (x (size d)) (y (size d))) ) ++ ++; define compiled version directly to avoid repeated recompilation ++(defun draw-text-draw-outline (W X Y D) ++ (SETF (SECOND D) (LIST X Y)) ++ (WINDOW-DRAW-BOX-XY W X (+ 2 Y) (CAADDR D) (CADR (CADDR D)))) ++ ++; 11 Sep 92 ++(gldefun draw-text-selectedp ((d draw-text) (pt vector) (off vector)) ++ (let ((ptp (pt - off))) ++ (contains? (vregion d) ptp))) ++ ++; 11 Sep 92; 17 Sep 92; 06 Oct 92; 11 Nov 94 ++(gldefun draw-text-get ((dd draw-desc) (w window)) ++ (let (txt lng off) ++ (princ "Enter text string: ") ++ (txt = (stringify (read))) ++ (lng = (string-width w txt)) ++ (off = (get-box-position w lng 14)) ++ (a draw-text with offset = (off + (a vector x 0 y 4)) ++ size = (a vector with x = lng y = 14) ++ contents = txt) )) ++ ++; 15 Sep 92; 05 Jan 04 ++; Test if a point p1 is close to a point p2. If so, result is p2, else nil. ++(gldefun draw-snapp ((p1 vector) (off vector) (p2x integer) (p2y integer)) ++ (if (and ((abs ((x p1) - (x off) - p2x)) < 4) ++ ((abs ((y p1) - (y off) - p2y)) < 4) ) ++ (a vector with x = ((x off) + p2x) y = ((y off) + p2y)) )) ++ ++; 15 Sep 92 ++(gldefun draw-dot-snap ((d draw-dot) (p vector) (off vector)) ++ (draw-snapp p off ((x (offset d)) + 2) ++ ((y (offset d)) + 2) ) ) ++ ++; 17 Dec 93 ++(gldefun draw-refpt-snap ((d draw-refpt) (p vector) (off vector)) ++ (draw-snapp p off (x (offset d)) (y (offset d)) ) ) ++ ++; 15 Sep 92 ++(gldefun draw-line-snap ((d draw-line) (p vector) (off vector)) ++ (or (draw-snapp p off (x (offset d)) (y (offset d))) ++ (draw-snapp p off ( (x (offset d)) + (x (size d)) ) ++ ( (y (offset d)) + (y (size d)) ) ) )) ++ ++; 15 Sep 92; 19 Dec 93 ++; Snap for square: corners, middle of sides. ++(gldefun draw-box-snap ((d draw-box) (p vector) (off vector)) ++ (let ((xoff (x (offset d))) (yoff (y (offset d))) ++ (xsize (x (size d)) ) (ysize (y (size d)) ) ) ++ (or (draw-snapp p off xoff yoff) ++ (draw-snapp p off (xoff + xsize) (yoff + ysize)) ++ (draw-snapp p off (xoff + xsize) yoff) ++ (draw-snapp p off xoff (yoff + ysize)) ++ (draw-snapp p off (xoff + xsize / 2) yoff) ++ (draw-snapp p off xoff (yoff + ysize / 2)) ++ (draw-snapp p off (xoff + xsize / 2) (yoff + ysize)) ++ (draw-snapp p off (xoff + xsize) (yoff + ysize / 2)) ) )) ++ ++; 15 Sep 92 ++(gldefun draw-circle-snap ((d draw-circle) (p vector) (off vector)) ++ (or (draw-snapp p off ( (x (offset d)) + (radius d) ) ++ ( (y (offset d)) + (radius d) ) ) ++ (draw-snapp p off ( (x (offset d)) + (radius d) ) ++ (y (offset d)) ) ++ (draw-snapp p off (x (offset d)) ++ ( (y (offset d)) + (radius d) ) ) ++ (draw-snapp p off ( (x (offset d)) + (radius d) ) ++ ( (y (offset d)) + (y (size d)) ) ) ++ (draw-snapp p off ( (x (offset d)) + (x (size d)) ) ++ ( (y (offset d)) + (radius d) ) ) )) ++ ++; 15 Sep 92 ++(gldefun draw-ellipse-snap ((d draw-ellipse) (p vector) (off vector)) ++ (or (draw-snapp p off ( (x (offset d)) + (radiusx d) ) ++ ( (y (offset d)) + (radiusy d) ) ) ++ (draw-snapp p off ( (x (offset d)) + (radiusx d) ) ++ (y (offset d)) ) ++ (draw-snapp p off (x (offset d)) ++ ( (y (offset d)) + (radiusy d) ) ) ++ (draw-snapp p off ( (x (offset d)) + (radiusx d) ) ++ ( (y (offset d)) + (y (size d)) ) ) ++ (draw-snapp p off ( (x (offset d)) + (x (size d)) ) ++ ( (y (offset d)) + (radiusy d) ) ) )) ++ ++; 16 Sep 92 ++(gldefun draw-rcbox-snap ((d draw-rcbox) (p vector) (off vector)) ++ (let ( (rx ((x (size d)) / 2)) (ry ((y (size d)) / 2)) ) ++ (or (draw-snapp p off ( (x (offset d)) + rx ) (y (offset d)) ) ++ (draw-snapp p off (x (offset d)) ( (y (offset d)) + ry ) ) ++ (draw-snapp p off ( (x (offset d)) + rx ) ++ ( (y (offset d)) + (y (size d)) ) ) ++ (draw-snapp p off ( (x (offset d)) + (x (size d)) ) ++ ( (y (offset d)) + ry ) ) ) )) ++ ++; 15 Sep 92 ++(gldefun draw-no-snap ((d draw-ellipse) (p vector) (off vector)) nil) ++ ++; 11 Sep 92 ++(gldefun draw-multi-draw ((d draw-multi) (w window) (off vector)) ++ (let ( (totaloff ((offset d) + off)) ) ++ (for subd in (contents d) do ++ (draw subd w totaloff)) )) ++ ++; 11 Sep 92; 13 Sep 92; 15 Sep 92; 16 Sep 92; 29 Sep 92; 17 Dec 93; 07 Jan 94 ++; Initialize drawing and command menus ++(defun draw-init-menus () ++ (let ((w (draw-window))) ++ (window-clear w) ++ (dolist (fn '(draw-menu-rectangle draw-menu-circle draw-menu-ellipse ++ draw-menu-line draw-menu-arrow draw-menu-dot ++ draw-menu-button draw-menu-text)) ++ (setf (get fn 'display-size) '(30 20)) ) ++ (setq *draw-menu-set* (menu-set-create w nil)) ++ (menu-set-add-menu *draw-menu-set* 'draw nil "Draw" ++ '((draw-menu-rectangle . rectangle) ++ (draw-menu-rcbox . rcbox) ++ (draw-menu-circle . circle) ++ (draw-menu-ellipse . ellipse) ++ (draw-menu-line . line) ++ (draw-menu-arrow . arrow) ++ (draw-menu-dot . dot) ++ (" " . erase) ++ (draw-menu-button . button) ++ (draw-menu-text . text) ++ (draw-menu-refpt . refpt)) ++ (list 0 0)) ++ (menu-set-adjust *draw-menu-set* 'draw 'top nil 1) ++ (menu-set-adjust *draw-menu-set* 'draw 'right nil 2) ++ (menu-set-add-menu *draw-menu-set* 'command nil "Commands" ++ '(("Done" . done) ("Move" . move) ++ ("Delete" . delete) ("Copy" . copy) ++ ("Redraw" . redraw) ("Origin" . origin) ++ ("LaTex Mode" . latexmode) ++ ("Make Program" . program) ("Make LaTex" . latex)) ++ (list 0 0)) ++ (menu-set-adjust *draw-menu-set* 'command 'top 'draw 5) ++ (menu-set-adjust *draw-menu-set* 'command 'right nil 2) )) ++ ++ ++; 10 Sep 92 ++(defun draw-menu-rectangle (w x y) ++ (window-draw-box-xy w (+ x 3) (+ y 3) 24 14 1)) ++(defun draw-menu-rcbox (w x y) ++ (window-draw-rcbox-xy w (+ x 3) (+ y 3) 24 14 3 1)) ++(defun draw-menu-circle (w x y) ++ (window-draw-circle-xy w (+ x 15) (+ y 10) 8 1)) ++(defun draw-menu-ellipse (w x y) ++ (window-draw-ellipse-xy w (+ x 15) (+ y 10) 12 8 1)) ++(defun draw-menu-line (w x y) ++ (window-draw-line-xy w (+ x 4) (+ y 4) (+ x 26) (+ y 16) 1)) ++(defun draw-menu-arrow (w x y) ++ (window-draw-arrow-xy w (+ x 4) (+ y 4) (+ x 26) (+ y 16) 1)) ++(defun draw-menu-dot (w x y) (window-draw-dot-xy w (+ x 15) (+ y 10)) ) ++(defun draw-menu-button (w x y) ++ (window-draw-box-xy w (+ x 14) (+ y 5) 4 4 1)) ++(defun draw-menu-text (w x y) ++ (window-printat-xy w "A" (+ x 12) (+ y 5))) ++(defun draw-menu-refpt (w x y) ++ (window-draw-crosshairs-xy w (+ x 15) (+ y 9)) ++ (window-draw-circle-xy w (+ x 15) (+ y 9) 2)) ++ ++; 14 Sep 92; 15 Jan 98 ++; Draw a line or arrow in LaTex form ++(defun latex-line (fromx fromy x y &optional arrowflg) ++ (let (dx dy sx sy siz err errb) ++ (setq dx (- x fromx)) ++ (setq dy (- y fromy)) ++ (if (= dx 0) ++ (progn (setq sx 0) ++ (setq sy (if (>= dy 0) 1 -1)) ++ (setq siz (* (abs dy) *draw-latex-factor*))) ++ (if (= dy 0) ++ (progn (setq sx (if (>= dx 0) 1 -1)) ++ (setq sy 0) ++ (setq siz (* (abs dx) *draw-latex-factor*))) ++ (progn ++ (setq err 9999) ++ (setq siz (* (abs dx) *draw-latex-factor*)) ++ (dotimes (i (if arrowflg 4 6)) ++ (dotimes (j (if arrowflg 4 6)) ++ (setq errb (abs (- (/ (float (1+ i)) ++ (float (1+ j))) ++ (abs (/ (float dx) ++ (float dy)))))) ++ (if (and (= (gcd (1+ i) (1+ j)) 1) ++ (< errb err)) ++ (progn (setq err errb) ++ (setq sx (1+ i)) ++ (setq sy (1+ j)))))) ++ (setq sx (* sx (latex-sign dx))) ++ (setq sy (* sy (latex-sign dy))) ))) ++ (format t " \\put(~5,0F,~5,0F) {\\~A(~D,~D){~5,0F}}~%" ++ (* fromx *draw-latex-factor*) (* fromy *draw-latex-factor*) ++ (if arrowflg "vector" "line") sx sy siz) )) ++ ++(defun latex-sign (x) (if (>= x 0) 1 -1)) ++ ++ ++; 16 Sep 92; 30 Sep 92; 02 Oct 92; 07 Oct 92 ++(defun draw-output (outfilename &optional names) ++ (prog (prettysave lengthsave d fnname code) ++ (or names (setq names *draw-objects*)) ++ (if (symbolp names) (setq names (list names))) ++ (with-open-file (outfile outfilename ++ :direction :output ++ :if-exists :supersede) ++ (setq prettysave *print-pretty*) ++ (setq lengthsave *print-length*) ++ (setq *print-pretty* t) ++ (setq *print-length* 80) ++ (format outfile "; ~A ~A~%" ++ outfilename (draw-get-time-string)) ++ (dolist (name names) ++ (if (setq d (get name 'draw-descr)) ++ (progn (terpri outfile) ++ (print `(setf (get ',name 'draw-descr) ',d) outfile) ++ (if (and (setq fnname (draw-desc-fnname d)) ++ (setq code (symbol-function fnname))) ++ (progn (terpri outfile) ++ (print (cons 'defun ++ (if (eq (car code) 'lambda-block) ++ (cdr code) ++ (cons fnname (cdr code)))) ++ outfile)) ))) ++ (if (setq d (get name 'picmenu-spec)) ++ (progn (terpri outfile) ++ (print `(setf (get ',name 'picmenu-spec) ',d) outfile)))) ++ (terpri outfile) ++ (setq *print-pretty* prettysave) ++ (setq *print-length* lengthsave) ) ++ (return outfilename) )) ++ ++; 09 Sep 92 ++(defun draw-get-time-string () ++ (let (second minute hour date month year) ++ (multiple-value-setq (second minute hour date month year) ++ (get-decoded-time)) ++ (format nil "~2D ~A ~4D ~2D:~2D:~2D" ++ date (nth (1- month) '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" ++ "Aug" "Sep" "Oct" "Nov" "Dec")) ++ year hour minute second) )) ++ ++; 14 Sep 92; 16 Sep 92; 13 July 93 ++; Compile the draw.lsp and menu-set files into a plain Lisp file ++(defun compile-draw () ++ (glcompfiles *directory* ++ '("glisp/vector.lsp" ; auxiliary files ++ "X/dwindow.lsp") ++ '("glisp/menu-set.lsp" ; translated files ++ "glisp/draw.lsp") ++ "glisp/drawtrans.lsp" ; output file ++ "glisp/draw-header.lsp") ; header file ++ (cf drawtrans) ) ++ ++(defun compile-drawb () ++ (glcompfiles *directory* ++ '("glisp/vector.lsp" ; auxiliary files ++ "X/dwindow.lsp" "X/dwnoopen.lsp") ++ '("glisp/menu-set.lsp" ; translated files ++ "glisp/draw.lsp") ++ "glisp/drawtrans.lsp" ; output file ++ "glisp/draw-header.lsp") ; header file ++ ) ++ ++; 16 Nov 92; 08 Apr 93; 08 Oct 93; 20 Apr 94; 29 Oct 94; 09 Feb 99 ++; Output drawing descriptions and functions to the specified file ++(defun draw-out (&optional names file) ++ (or names (setq names *draw-objects*)) ++ (if (not (consp names)) (setq names (list names))) ++ (draw-output (or file "glisp/draw.del") names) ++ (setq *draw-objects* (set-difference *draw-objects* names)) ++ names ) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_dwimportsb.lsp +@@ -0,0 +1,76 @@ ++; dwimportsb.lsp Gordon S. Novak Jr. 11 Sep 06 ++ ++; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; This file imports symbols of the XGCL package; these symbols may be ++; needed by a hard-core user of the Xlib functions. ++ ++; See the file gnu.license . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; This file imports symbols from the dwindow.lsp file (in XLIB: package) ++; to the current package (such as the :USER package). ++; This will allow the dwindow.lsp functions to be called by just their ++; names and without any package qualifier. ++ ++; This file should be loaded immediately after starting Lisp: ++; If Lisp has seen any of these symbols, loading this file will cause an error. ++ ++(dolist (x '(xlib::XRecolorCursor ++xlib::XFlush xlib::XUnMapWindow xlib::XClearWindow xlib::XMapWindow ++xlib::XTextWidth xlib::XOpenDisplay xlib::XdefaultScreen xlib::XRootWindow ++xlib::XBlackPixel xlib::XWhitePixel xlib::XDefaultGC xlib::XDefaultColormap ++xlib::make-XsetWindowAttributes xlib::set-XsetWindowAttributes-backing_store ++xlib::set-XsetWindowAttributes-save_under xlib::make-XWindowAttributes ++xlib::make-XsizeHints xlib::make-XEvent xlib::make-XGCValues ++xlib::XQueryPointer xlib::XCreateSimpleWindow xlib::XsetStandardProperties ++xlib::XCreateGC xlib::CWSaveUnder xlib::CWBackingStore ++xlib::XloadQueryFont xlib::XsetFont xlib::XGetGCValues ++xlib::XGCValues-foreground xlib::XsetForeground xlib::XGCValues-Background ++xlib::XsetBackground xlib::XGCValues-function xlib::XCreateFontCursor ++xlib::XDefineCursor xlib::XGetGeometry ++xlib::Xsync xlib::XsetFunction xlib::GXxor xlib::GXcopy ++xlib::XsetLineAttributes xlib::LineSolid xlib::CapButt xlib::JoinMiter ++xlib::XDrawLine xlib::XdrawArc xlib::XClearArea xlib::XCopyArea ++xlib::XFillRectangle xlib::XdrawImageString xlib::XTextExtents ++xlib::XDestroyWindow xlib::XFreeGC xlib::XMoveWindow xlib::Xsync ++xlib::Xselectinput xlib::ButtonPressMask xlib::PointerMotionMask ++xlib::XNextEvent xlib::XAnyEvent-type xlib::XAnyEvent-window ++xlib::MotionNotify xlib::ButtonPress ++xlib::XMotionEvent-x xlib::XMotionEvent-y xlib::XButtonEvent-button ++xlib::XAnyEvent-window ++xlib::XButtonEvent-button xlib::XWindowAttributes-map_state ++xlib::ISUnmapped xlib::XPending ++xlib::Expose xlib::XAllocColor xlib::XColor-Pixel xlib::XFreeColors ++xlib::KeyPressMask xlib::KeyReleaseMask xlib::KeyRelease ++xlib::KeyPress xlib::ButtonPress xlib::XDisplayKeycodes ++xlib::XGetKeyboardMapping ++xlib::XFree xlib::XK_Shift_R xlib::XK_Shift_L xlib::XK_Control_L ++xlib::XK_Control_R xlib::XK_Alt_R xlib::XK_Alt_L xlib::XK_Return ++xlib::XK_Tab xlib::XK_BackSpace xlib::get-c-string xlib::int-pos ++xlib::fixnum-array xlib::int-array xlib::fixnum-pos ++xlib::set-xsizehints-x xlib::set-xsizehints-y xlib::set-xsizehints-width ++xlib::set-xsizehints-height xlib::set-xsizehints-flags xlib::set-foreground ++xlib::set-background xlib::set-font ++xlib::set-cursor xlib::set-line-width xlib::set-line-attr ++xlib::set-Xcolor-red xlib::set-Xcolor-green xlib::set-Xcolor-blue ++xlib::WhenMapped xlib::Psize xlib::Pposition xlib::CWSaveUnder ++xlib::CWBackingStore xlib::NoSymbol ++xlib::leavewindowmask xlib::buttonreleasemask xlib::exposuremask ++xlib::GCForeground xlib::GCBackground xlib::GCFunction ++xlib::None xlib::Xfontstruct-fid xlib::XChangeWindowAttributes ++xlib::XGetWindowAttributes lisp::null xlib::Make-Xcolor ++ )) (import x) ) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_Xlib.lsp +@@ -0,0 +1,3456 @@ ++(in-package :XLIB) ++; Xlib.lsp Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++;;typedef unsigned long XID) ; ++ ++;;typedef XID Window) ; ++;;typedef XID Drawable) ; ++;;typedef XID Font) ; ++;;typedef XID Pixmap) ; ++;;typedef XID Cursor) ; ++;;typedef XID Colormap) ; ++;;typedef XID GContext) ; ++;;typedef XID KeySym) ; ++ ++;;typedef unsigned long Mask) ; ++ ++;;typedef unsigned long Atom) ; ++ ++;;typedef unsigned long VisualID) ; ++ ++;;typedef unsigned long Time) ; ++ ++;;typedef unsigned char KeyCode) ; ++ ++(defconstant True 1) ++(defconstant False 0) ++ ++(defconstant QueuedAlready 0) ++(defconstant QueuedAfterReading 1) ++(defconstant QueuedAfterFlush 2) ++ ++(defentry XLoadQueryFont( ++ ++ fixnum ;; display ++ object ;; name ++ ++)( fixnum "XLoadQueryFont")) ++ ++ ++ ++(defentry XQueryFont( ++ ++ fixnum ;; display ++ fixnum ;; font_ID ++ ++)( fixnum "XQueryFont")) ++ ++ ++ ++ ++(defentry XGetMotionEvents( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; start ++ fixnum ;; stop ++ fixnum ;; nevents_return ++ ++)( fixnum "XGetMotionEvents")) ++ ++ ++ ++(defentry XDeleteModifiermapEntry( ++ ++ fixnum ;; modmap ++ ++ fixnum ;; keycode_entry ++ ++ fixnum ;; modifier ++ ++)( fixnum "XDeleteModifiermapEntry")) ++ ++ ++ ++(defentry XGetModifierMapping( ++ ++ fixnum ;; display ++ ++)( fixnum "XGetModifierMapping")) ++ ++ ++ ++(defentry XInsertModifiermapEntry( ++ ++ fixnum ;; modmap ++ ++ fixnum ;; keycode_entry ++ ++ fixnum ;; modifier ++ ++)( fixnum "XInsertModifiermapEntry")) ++ ++ ++ ++(defentry XNewModifiermap( ++ ++ fixnum ;; max_keys_per_mod ++ ++)( fixnum "XNewModifiermap")) ++ ++ ++ ++(defentry XCreateImage( ++ ++ fixnum ;; display ++ fixnum ;; visual ++ fixnum ;; depth ++ fixnum ;; format ++ fixnum ;; offset ++ object ;; data ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; bitmap_pad ++ fixnum ;; bytes_per_line ++ ++)( fixnum "XCreateImage")) ++ ++ ++(defentry XGetImage( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; plane_mask ++ fixnum ;; format ++ ++)( fixnum "XGetImage")) ++ ++ ++(defentry XGetSubImage( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; plane_mask ++ fixnum ;; format ++ fixnum ;; dest_image ++ fixnum ;; dest_x ++ fixnum ;; dest_y ++ ++)( fixnum "XGetSubImage")) ++ ++;;Window X function declarations. ++ ++ ++ ++(defentry XOpenDisplay( ++ ++ object ;; display_name ++ ++)( fixnum "XOpenDisplay")) ++ ++ ++ ++(defentry XrmInitialize( ++ ++;; void ++ ++)( void "XrmInitialize")) ++ ++ ++ ++(defentry XFetchBytes( ++ ++ fixnum ;; display ++ fixnum ;; nbytes_return ++ ++)( fixnum "XFetchBytes")) ++ ++ ++(defentry XFetchBuffer( ++ ++ fixnum ;; display ++ fixnum ;; nbytes_return ++ fixnum ;; buffer ++ ++)( fixnum "XFetchBuffer")) ++ ++ ++(defentry XGetAtomName( ++ ++ fixnum ;; display ++ fixnum ;; atom ++ ++)( fixnum "XGetAtomName")) ++ ++ ++(defentry XGetDefault( ++ ++ fixnum ;; display ++ object ;; program ++ object ;; option ++ ++)( fixnum "XGetDefault")) ++ ++ ++(defentry XDisplayName( ++ ++ object ;; string ++ ++)( fixnum "XDisplayName")) ++ ++ ++(defentry XKeysymToString( ++ ++ fixnum ;; keysym ++ ++)( fixnum "XKeysymToString")) ++ ++ ++ ++ ++(defentry XInternAtom( ++ ++ fixnum ;; display ++ object ;; atom_name ++ fixnum ;; only_if_exists ++ ++)( fixnum "XInternAtom")) ++ ++ ++(defentry XCopyColormapAndFree( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ ++)( fixnum "XCopyColormapAndFree")) ++ ++ ++(defentry XCreateColormap( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; visual ++ fixnum ;; alloc ++ ++)( fixnum "XCreateColormap")) ++ ++ ++(defentry XCreatePixmapCursor( ++ ++ fixnum ;; display ++ fixnum ;; source ++ fixnum ;; mask ++ fixnum ;; foreground_color ++ fixnum ;; background_color ++ fixnum ;; x ++ fixnum ;; y ++ ++)( fixnum "XCreatePixmapCursor")) ++ ++ ++(defentry XCreateGlyphCursor( ++ ++ fixnum ;; display ++ fixnum ;; source_font ++ fixnum ;; mask_font ++ fixnum ;; source_char ++ fixnum ;; mask_char ++ fixnum ;; foreground_color ++ fixnum ;; background_color ++ ++)( fixnum "XCreateGlyphCursor")) ++ ++ ++(defentry XCreateFontCursor( ++ ++ fixnum ;; display ++ fixnum ;; shape ++ ++)( fixnum "XCreateFontCursor")) ++ ++ ++(defentry XLoadFont( ++ ++ fixnum ;; display ++ object ;; name ++ ++)( fixnum "XLoadFont")) ++ ++ ++(defentry XCreateGC( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; valuemask ++ fixnum ;; values ++ ++)( fixnum "XCreateGC")) ++ ++ ++(defentry XGContextFromGC( ++ ++ fixnum ;; gc ++ ++)( fixnum "XGContextFromGC")) ++ ++ ++(defentry XCreatePixmap( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; depth ++ ++)( fixnum "XCreatePixmap")) ++ ++ ++(defentry XCreateBitmapFromData( ++ ++ fixnum ;; display ++ fixnum ;; d ++ object ;; data ++ fixnum ;; width ++ fixnum ;; height ++ ++)( fixnum "XCreateBitmapFromData")) ++ ++ ++(defentry XCreatePixmapFromBitmapData( ++ ++ fixnum ;; display ++ fixnum ;; d ++ object ;; data ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; fg ++ fixnum ;; bg ++ fixnum ;; depth ++ ++)( fixnum "XCreatePixmapFromBitmapData")) ++ ++ ++(defentry XCreateSimpleWindow( ++ ++ fixnum ;; display ++ fixnum ;; parent ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; border_width ++ fixnum ;; border ++ fixnum ;; background ++ ++)( fixnum "XCreateSimpleWindow")) ++ ++ ++(defentry XGetSelectionOwner( ++ ++ fixnum ;; display ++ fixnum ;; selection ++ ++)( fixnum "XGetSelectionOwner")) ++ ++ ++(defentry XCreateWindow( ++ ++ fixnum ;; display ++ fixnum ;; parent ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; border_width ++ fixnum ;; depth ++ fixnum ;; class ++ fixnum ;; visual ++ fixnum ;; valuemask ++ fixnum ;; attributes ++ ++)( fixnum "XCreateWindow")) ++ ++ ++(defentry XListInstalledColormaps( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; num_return ++ ++)( fixnum "XListInstalledColormaps")) ++ ++ ++(defentry XListFonts( ++ ++ fixnum ;; display ++ object ;; pattern ++ fixnum ;; maxnames ++ fixnum ;; actual_count_return ++ ++)( fixnum "XListFonts")) ++ ++ ++(defentry XListFontsWithInfo( ++ ++ fixnum ;; display ++ object ;; pattern ++ fixnum ;; maxnames ++ fixnum ;; count_return ++ fixnum ;; info_return ++ ++)( fixnum "XListFontsWithInfo")) ++ ++ ++(defentry XGetFontPath( ++ ++ fixnum ;; display ++ fixnum ;; npaths_return ++ ++)( fixnum "XGetFontPath")) ++ ++ ++(defentry XListExtensions( ++ ++ fixnum ;; display ++ fixnum ;; nextensions_return ++ ++)( fixnum "XListExtensions")) ++ ++ ++(defentry XListProperties( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; num_prop_return ++ ++)( fixnum "XListProperties")) ++ ++ ++(defentry XListHosts( ++ ++ fixnum ;; display ++ fixnum ;; nhosts_return ++ fixnum ;; state_return ++ ++)( fixnum "XListHosts")) ++ ++ ++(defentry XKeycodeToKeysym( ++ ++ fixnum ;; display ++ ++ fixnum ;; fixnum ++ ++ fixnum ;; index ++ ++)( fixnum "XKeycodeToKeysym")) ++ ++ ++(defentry XLookupKeysym( ++ ++ fixnum ;; key_event ++ fixnum ;; index ++ ++)( fixnum "XLookupKeysym")) ++ ++ ++(defentry XGetKeyboardMapping( ++ ++ fixnum ;; display ++ ++ fixnum ;; first_keycode ++ ++ fixnum ;; keycode_count ++ fixnum ;; keysyms_per_keycode_return ++ ++)( fixnum "XGetKeyboardMapping")) ++ ++ ++(defentry XStringToKeysym( ++ ++ object ;; string ++ ++)( fixnum "XStringToKeysym")) ++ ++ ++(defentry XMaxRequestSize( ++ ++ fixnum ;; display ++ ++)( fixnum "XMaxRequestSize")) ++ ++ ++(defentry XResourceManagerString( ++ ++ fixnum ;; display ++ ++)( fixnum "XResourceManagerString")) ++ ++ ++(defentry XDisplayMotionBufferSize( ++ ++ fixnum ;; display ++ ++)( fixnum "XDisplayMotionBufferSize")) ++ ++ ++(defentry XVisualIDFromVisual( ++ ++ fixnum ;; visual ++ ++)( fixnum "XVisualIDFromVisual")) ++ ++;; routines for dealing with extensions ++ ++ ++ ++(defentry XInitExtension( ++ ++ fixnum ;; display ++ object ;; name ++ ++)( fixnum "XInitExtension")) ++ ++ ++ ++(defentry XAddExtension( ++ ++ fixnum ;; display ++ ++)( fixnum "XAddExtension")) ++ ++ ++(defentry XFindOnExtensionList( ++ ++ fixnum ;; structure ++ fixnum ;; number ++ ++)( fixnum "XFindOnExtensionList")) ++ ++ ++ ++;;;fix ++ ++ ++;(defentry XEHeadOfExtensionList( ++ ++; fixnum ;;object ++ ++;)( fixnum "XEHeadOfExtensionList")) ++ ++;; these are routines for which there are also macros ++ ++ ++(defentry XRootWindow( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XRootWindow")) ++ ++ ++(defentry XDefaultRootWindow( ++ ++ fixnum ;; display ++ ++)( fixnum "XDefaultRootWindow")) ++ ++ ++(defentry XRootWindowOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XRootWindowOfScreen")) ++ ++ ++(defentry XDefaultVisual( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDefaultVisual")) ++ ++ ++(defentry XDefaultVisualOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XDefaultVisualOfScreen")) ++ ++ ++(defentry XDefaultGC( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDefaultGC")) ++ ++ ++(defentry XDefaultGCOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XDefaultGCOfScreen")) ++ ++ ++(defentry XBlackPixel( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XBlackPixel")) ++ ++ ++(defentry XWhitePixel( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XWhitePixel")) ++ ++ ++(defentry XAllPlanes( ++ ++;; void ++ ++)( fixnum "XAllPlanes")) ++ ++ ++(defentry XBlackPixelOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XBlackPixelOfScreen")) ++ ++ ++(defentry XWhitePixelOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XWhitePixelOfScreen")) ++ ++ ++(defentry XNextRequest( ++ ++ fixnum ;; display ++ ++)( fixnum "XNextRequest")) ++ ++ ++(defentry XLastKnownRequestProcessed( ++ ++ fixnum ;; display ++ ++)( fixnum "XLastKnownRequestProcessed")) ++ ++ ++(defentry XServerVendor( ++ ++ fixnum ;; display ++ ++)( fixnum "XServerVendor")) ++ ++ ++(defentry XDisplayString( ++ ++ fixnum ;; display ++ ++)( fixnum "XDisplayString")) ++ ++ ++(defentry XDefaultColormap( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDefaultColormap")) ++ ++ ++(defentry XDefaultColormapOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XDefaultColormapOfScreen")) ++ ++ ++(defentry XDisplayOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XDisplayOfScreen")) ++ ++ ++(defentry XScreenOfDisplay( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XScreenOfDisplay")) ++ ++ ++(defentry XDefaultScreenOfDisplay( ++ ++ fixnum ;; display ++ ++)( fixnum "XDefaultScreenOfDisplay")) ++ ++ ++(defentry XEventMaskOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XEventMaskOfScreen")) ++ ++ ++ ++(defentry XScreenNumberOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XScreenNumberOfScreen")) ++ ++ ++ ++(defentry XSetErrorHandler ( ++ ++ fixnum ;; handler ++ ++)( fixnum "XSetErrorHandler" )) ++ ++ ++;;fix ++ ++ ++(defentry XSetIOErrorHandler ( ++ ++ fixnum ;; handler ++ ++)( fixnum "XSetIOErrorHandler" )) ++ ++ ++ ++ ++(defentry XListPixmapFormats( ++ ++ fixnum ;; display ++ fixnum ;; count_return ++ ++)( fixnum "XListPixmapFormats")) ++ ++ ++(defentry XListDepths( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ fixnum ;; count_return ++ ++)( fixnum "XListDepths")) ++ ++;; ICCCM routines for things that don't require special include files; ++;; other declarations are given in Xutil.h ++ ++ ++(defentry XReconfigureWMWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; screen_number ++ fixnum ;; mask ++ fixnum ;; changes ++ ++)( fixnum "XReconfigureWMWindow")) ++ ++ ++ ++(defentry XGetWMProtocols( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; protocols_return ++ fixnum ;; count_return ++ ++)( fixnum "XGetWMProtocols")) ++ ++ ++(defentry XSetWMProtocols( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; protocols ++ fixnum ;; count ++ ++)( fixnum "XSetWMProtocols")) ++ ++ ++(defentry XIconifyWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; screen_number ++ ++)( fixnum "XIconifyWindow")) ++ ++ ++(defentry XWithdrawWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; screen_number ++ ++)( fixnum "XWithdrawWindow")) ++ ++;;;fix ++ ++ ++(defentry XGetCommand( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; argv_return ++ fixnum ;; argc_return ++ ++)( fixnum "XGetCommand")) ++ ++ ++(defentry XGetWMColormapWindows( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; windows_return ++ fixnum ;; count_return ++ ++)( fixnum "XGetWMColormapWindows")) ++ ++ ++(defentry XSetWMColormapWindows( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; colormap_windows ++ fixnum ;; count ++ ++)( fixnum "XSetWMColormapWindows")) ++ ++ ++(defentry XFreeStringList( ++ ++ fixnum ;; list ++ ++)( void "XFreeStringList")) ++ ++ ++(defentry XSetTransientForHint( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; prop_window ++ ++)( void "XSetTransientForHint")) ++ ++;; The following are given in alphabetical order ++ ++ ++ ++(defentry XActivateScreenSaver( ++ ++ fixnum ;; display ++ ++)( void "XActivateScreenSaver")) ++ ++ ++ ++(defentry XAddHost( ++ ++ fixnum ;; display ++ fixnum ;; host ++ ++)( void "XAddHost")) ++ ++ ++ ++(defentry XAddHosts( ++ ++ fixnum ;; display ++ fixnum ;; hosts ++ fixnum ;; num_hosts ++ ++)( void "XAddHosts")) ++ ++ ++ ++(defentry XAddToExtensionList( ++ ++ fixnum ;; structure ++ fixnum ;; ext_data ++ ++)( void "XAddToExtensionList")) ++ ++ ++ ++(defentry XAddToSaveSet( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XAddToSaveSet")) ++ ++ ++ ++(defentry XAllocColor( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; screen_in_out ++ ++)( fixnum "XAllocColor")) ++ ++;;;fix ++ ++ ++(defentry XAllocColorCells( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; contig ++ fixnum ;; plane_masks_return ++ fixnum ;; nplanes ++ fixnum ;; pixels_return ++ fixnum ;; npixels ++ ++)( fixnum "XAllocColorCells")) ++ ++ ++ ++(defentry XAllocColorPlanes( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; contig ++ fixnum ;; pixels_return ++ fixnum ;; ncolors ++ fixnum ;; nreds ++ fixnum ;; ngreens ++ fixnum ;; nblues ++ fixnum ;; rmask_return ++ fixnum ;; gmask_return ++ fixnum ;; bmask_return ++ ++)( fixnum "XAllocColorPlanes")) ++ ++ ++ ++(defentry XAllocNamedColor( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ object ;; color_name ++ fixnum ;; screen_def_return ++ fixnum ;; exact_def_return ++ ++)( fixnum "XAllocNamedColor")) ++ ++ ++ ++(defentry XAllowEvents( ++ ++ fixnum ;; display ++ fixnum ;; event_mode ++ fixnum ;; time ++ ++)( void "XAllowEvents")) ++ ++ ++ ++(defentry XAutoRepeatOff( ++ ++ fixnum ;; display ++ ++)( void "XAutoRepeatOff")) ++ ++ ++ ++(defentry XAutoRepeatOn( ++ ++ fixnum ;; display ++ ++)( void "XAutoRepeatOn")) ++ ++ ++ ++(defentry XBell( ++ ++ fixnum ;; display ++ fixnum ;; percent ++ ++)( void "XBell")) ++ ++ ++ ++(defentry XBitmapBitOrder( ++ ++ fixnum ;; display ++ ++)( fixnum "XBitmapBitOrder")) ++ ++ ++ ++(defentry XBitmapPad( ++ ++ fixnum ;; display ++ ++)( fixnum "XBitmapPad")) ++ ++ ++ ++(defentry XBitmapUnit( ++ ++ fixnum ;; display ++ ++)( fixnum "XBitmapUnit")) ++ ++ ++ ++(defentry XCellsOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XCellsOfScreen")) ++ ++ ++ ++(defentry XChangeActivePointerGrab( ++ ++ fixnum ;; display ++ fixnum ;; event_mask ++ fixnum ;; cursor ++ fixnum ;; time ++ ++)( void "XChangeActivePointerGrab")) ++ ++ ++ ++(defentry XChangeGC( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; valuemask ++ fixnum ;; values ++ ++)( void "XChangeGC")) ++ ++ ++ ++(defentry XChangeKeyboardControl( ++ ++ fixnum ;; display ++ fixnum ;; value_mask ++ fixnum ;; values ++ ++)( void "XChangeKeyboardControl")) ++ ++ ++ ++(defentry XChangeKeyboardMapping( ++ ++ fixnum ;; display ++ fixnum ;; first_keycode ++ fixnum ;; keysyms_per_keycode ++ fixnum ;; keysyms ++ fixnum ;; num_codes ++ ++)( void "XChangeKeyboardMapping")) ++ ++ ++ ++(defentry XChangePointerControl( ++ ++ fixnum ;; display ++ fixnum ;; do_accel ++ fixnum ;; do_threshold ++ fixnum ;; accel_numerator ++ fixnum ;; accel_denominator ++ fixnum ;; threshold ++ ++)( void "XChangePointerControl")) ++ ++ ++ ++(defentry XChangeProperty( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; property ++ fixnum ;; type ++ fixnum ;; format ++ fixnum ;; mode ++ fixnum ;; data ++ fixnum ;; nelements ++ ++)( void "XChangeProperty")) ++ ++ ++ ++(defentry XChangeSaveSet( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; change_mode ++ ++)( void "XChangeSaveSet")) ++ ++ ++ ++(defentry XChangeWindowAttributes( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; valuemask ++ fixnum ;; attributes ++ ++)( void "XChangeWindowAttributes")) ++ ++ ++ ++(defentry XCheckMaskEvent( ++ ++ fixnum ;; display ++ fixnum ;; event_mask ++ fixnum ;; event_return ++ ++)( fixnum "XCheckMaskEvent")) ++ ++ ++ ++(defentry XCheckTypedEvent( ++ ++ fixnum ;; display ++ fixnum ;; event_type ++ fixnum ;; event_return ++ ++)( fixnum "XCheckTypedEvent")) ++ ++ ++ ++(defentry XCheckTypedWindowEvent( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; event_type ++ fixnum ;; event_return ++ ++)( fixnum "XCheckTypedWindowEvent")) ++ ++ ++ ++(defentry XCheckWindowEvent( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; event_mask ++ fixnum ;; event_return ++ ++)( fixnum "XCheckWindowEvent")) ++ ++ ++ ++(defentry XCirculateSubwindows( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; direction ++ ++)( void "XCirculateSubwindows")) ++ ++ ++ ++(defentry XCirculateSubwindowsDown( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XCirculateSubwindowsDown")) ++ ++ ++ ++(defentry XCirculateSubwindowsUp( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XCirculateSubwindowsUp")) ++ ++ ++ ++(defentry XClearArea( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; exposures ++ ++)( void "XClearArea")) ++ ++ ++ ++(defentry XClearWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XClearWindow")) ++ ++ ++ ++(defentry XCloseDisplay( ++ ++ fixnum ;; display ++ ++)( void "XCloseDisplay")) ++ ++ ++ ++(defentry XConfigureWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; value_mask ++ fixnum ;; values ++ ++)( void "XConfigureWindow")) ++ ++ ++ ++(defentry XConnectionNumber( ++ ++ fixnum ;; display ++ ++)( fixnum "XConnectionNumber")) ++ ++ ++ ++(defentry XConvertSelection( ++ ++ fixnum ;; display ++ fixnum ;; selection ++ fixnum ;; target ++ fixnum ;; property ++ fixnum ;; requestor ++ fixnum ;; time ++ ++)( void "XConvertSelection")) ++ ++ ++ ++(defentry XCopyArea( ++ ++ fixnum ;; display ++ fixnum ;; src ++ fixnum ;; dest ++ fixnum ;; gc ++ fixnum ;; src_x ++ fixnum ;; src_y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; dest_x ++ fixnum ;; dest_y ++ ++)( void "XCopyArea")) ++ ++ ++ ++(defentry XCopyGC( ++ ++ fixnum ;; display ++ fixnum ;; src ++ fixnum ;; valuemask ++ fixnum ;; dest ++ ++)( void "XCopyGC")) ++ ++ ++ ++(defentry XCopyPlane( ++ ++ fixnum ;; display ++ fixnum ;; src ++ fixnum ;; dest ++ fixnum ;; gc ++ fixnum ;; src_x ++ fixnum ;; src_y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; dest_x ++ fixnum ;; dest_y ++ fixnum ;; plane ++ ++)( void "XCopyPlane")) ++ ++ ++ ++(defentry XDefaultDepth( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDefaultDepth")) ++ ++ ++ ++(defentry XDefaultDepthOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XDefaultDepthOfScreen")) ++ ++ ++ ++(defentry XDefaultScreen( ++ ++ fixnum ;; display ++ ++)( fixnum "XDefaultScreen")) ++ ++ ++ ++(defentry XDefineCursor( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; cursor ++ ++)( void "XDefineCursor")) ++ ++ ++ ++(defentry XDeleteProperty( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; property ++ ++)( void "XDeleteProperty")) ++ ++ ++ ++(defentry XDestroyWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XDestroyWindow")) ++ ++ ++ ++(defentry XDestroySubwindows( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XDestroySubwindows")) ++ ++ ++ ++(defentry XDoesBackingStore( ++ ++ fixnum ;; screen ++ ++)( fixnum "XDoesBackingStore")) ++ ++ ++ ++(defentry XDoesSaveUnders( ++ ++ fixnum ;; screen ++ ++)( fixnum "XDoesSaveUnders")) ++ ++ ++ ++(defentry XDisableAccessControl( ++ ++ fixnum ;; display ++ ++)( void "XDisableAccessControl")) ++ ++ ++ ++ ++(defentry XDisplayCells( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDisplayCells")) ++ ++ ++ ++(defentry XDisplayHeight( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDisplayHeight")) ++ ++ ++ ++(defentry XDisplayHeightMM( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDisplayHeightMM")) ++ ++ ++ ++(defentry XDisplayKeycodes( ++ ++ fixnum ;; display ++ fixnum ;; min_keycodes_return ++ fixnum ;; max_keycodes_return ++ ++)( void "XDisplayKeycodes")) ++ ++ ++ ++(defentry XDisplayPlanes( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDisplayPlanes")) ++ ++ ++ ++(defentry XDisplayWidth( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDisplayWidth")) ++ ++ ++ ++(defentry XDisplayWidthMM( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ ++)( fixnum "XDisplayWidthMM")) ++ ++ ++ ++(defentry XDrawArc( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; angle1 ++ fixnum ;; angle2 ++ ++)( void "XDrawArc")) ++ ++ ++ ++(defentry XDrawArcs( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; arcs ++ fixnum ;; narcs ++ ++)( void "XDrawArcs")) ++ ++ ++ ++(defentry XDrawImageString( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ object ;; string ++ fixnum ;; length ++ ++)( void "XDrawImageString")) ++ ++ ++ ++(defentry XDrawImageString16( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; string ++ fixnum ;; length ++ ++)( void "XDrawImageString16")) ++ ++ ++ ++(defentry XDrawLine( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x1 ++ fixnum ;; x2 ++ fixnum ;; y1 ++ fixnum ;; y2 ++ ++)( void "XDrawLine")) ++ ++ ++ ++(defentry XDrawLines( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; points ++ fixnum ;; npoints ++ fixnum ;; mode ++ ++)( void "XDrawLines")) ++ ++ ++ ++(defentry XDrawPoint( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ ++)( void "XDrawPoint")) ++ ++ ++ ++(defentry XDrawPoints( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; points ++ fixnum ;; npoints ++ fixnum ;; mode ++ ++)( void "XDrawPoints")) ++ ++ ++ ++(defentry XDrawRectangle( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ ++)( void "XDrawRectangle")) ++ ++ ++ ++(defentry XDrawRectangles( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; rectangles ++ fixnum ;; nrectangles ++ ++)( void "XDrawRectangles")) ++ ++ ++ ++(defentry XDrawSegments( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; segments ++ fixnum ;; nsegments ++ ++)( void "XDrawSegments")) ++ ++ ++ ++(defentry XDrawString( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ object ;; string ++ fixnum ;; length ++ ++)( void "XDrawString")) ++ ++ ++ ++(defentry XDrawString16( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; string ++ fixnum ;; length ++ ++)( void "XDrawString16")) ++ ++ ++ ++(defentry XDrawText( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; items ++ fixnum ;; nitems ++ ++)( void "XDrawText")) ++ ++ ++ ++(defentry XDrawText16( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; items ++ fixnum ;; nitems ++ ++)( void "XDrawText16")) ++ ++ ++ ++(defentry XEnableAccessControl( ++ ++ fixnum ;; display ++ ++)( void "XEnableAccessControl")) ++ ++ ++ ++(defentry XEventsQueued( ++ ++ fixnum ;; display ++ fixnum ;; mode ++ ++)( fixnum "XEventsQueued")) ++ ++ ++ ++(defentry XFetchName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; window_name_return ++ ++)( fixnum "XFetchName")) ++ ++ ++ ++(defentry XFillArc( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; angle1 ++ fixnum ;; angle2 ++ ++)( void "XFillArc")) ++ ++ ++ ++(defentry XFillArcs( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; arcs ++ fixnum ;; narcs ++ ++)( void "XFillArcs")) ++ ++ ++ ++(defentry XFillPolygon( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; points ++ fixnum ;; npoints ++ fixnum ;; shape ++ fixnum ;; mode ++ ++)( void "XFillPolygon")) ++ ++ ++ ++(defentry XFillRectangle( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ ++)( void "XFillRectangle")) ++ ++ ++ ++(defentry XFillRectangles( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; rectangles ++ fixnum ;; nrectangles ++ ++)( void "XFillRectangles")) ++ ++ ++ ++(defentry XFlush( ++ ++ fixnum ;; display ++ ++)( void "XFlush")) ++ ++ ++ ++(defentry XForceScreenSaver( ++ ++ fixnum ;; display ++ fixnum ;; mode ++ ++)( void "XForceScreenSaver")) ++ ++ ++ ++(defentry XFree( ++ ++ object ;; data ++ ++)( void "XFree")) ++ ++ ++ ++(defentry XFreeColormap( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ ++)( void "XFreeColormap")) ++ ++ ++ ++(defentry XFreeColors( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; pixels ++ fixnum ;; npixels ++ fixnum ;; planes ++ ++)( void "XFreeColors")) ++ ++ ++ ++(defentry XFreeCursor( ++ ++ fixnum ;; display ++ fixnum ;; cursor ++ ++)( void "XFreeCursor")) ++ ++ ++ ++(defentry XFreeExtensionList( ++ ++ fixnum ;; list ++ ++)( void "XFreeExtensionList")) ++ ++ ++ ++(defentry XFreeFont( ++ ++ fixnum ;; display ++ fixnum ;; font_struct ++ ++)( void "XFreeFont")) ++ ++ ++ ++(defentry XFreeFontInfo( ++ ++ fixnum ;; names ++ fixnum ;; free_info ++ fixnum ;; actual_count ++ ++)( void "XFreeFontInfo")) ++ ++ ++ ++(defentry XFreeFontNames( ++ ++ fixnum ;; list ++ ++)( void "XFreeFontNames")) ++ ++ ++ ++(defentry XFreeFontPath( ++ ++ fixnum ;; list ++ ++)( void "XFreeFontPath")) ++ ++ ++ ++(defentry XFreeGC( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ ++)( void "XFreeGC")) ++ ++ ++ ++(defentry XFreeModifiermap( ++ ++ fixnum ;; modmap ++ ++)( void "XFreeModifiermap")) ++ ++ ++ ++(defentry XFreePixmap( ++ ++ fixnum ;; display ++ fixnum ;; fixnum ++ ++)( void "XFreePixmap")) ++ ++ ++ ++(defentry XGeometry( ++ ++ fixnum ;; display ++ fixnum ;; screen ++ object ;; position ++ object ;; default_position ++ fixnum ;; bwidth ++ fixnum ;; fwidth ++ fixnum ;; fheight ++ fixnum ;; xadder ++ fixnum ;; yadder ++ fixnum ;; x_return ++ fixnum ;; y_return ++ fixnum ;; width_return ++ fixnum ;; height_return ++ ++)( fixnum "XGeometry")) ++ ++ ++ ++(defentry XGetErrorDatabaseText( ++ ++ fixnum ;; display ++ object ;; name ++ object ;; message ++ object ;; default_string ++ object ;; buffer_return ++ fixnum ;; length ++ ++)( void "XGetErrorDatabaseText")) ++ ++ ++ ++(defentry XGetErrorText( ++ ++ fixnum ;; display ++ fixnum ;; code ++ object ;; buffer_return ++ fixnum ;; length ++ ++)( void "XGetErrorText")) ++ ++ ++ ++(defentry XGetFontProperty( ++ ++ fixnum ;; font_struct ++ fixnum ;; atom ++ fixnum ;; value_return ++ ++)( fixnum "XGetFontProperty")) ++ ++ ++ ++(defentry XGetGCValues( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; valuemask ++ fixnum ;; values_return ++ ++)( fixnum "XGetGCValues")) ++ ++ ++ ++(defentry XGetGeometry( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; root_return ++ fixnum ;; x_return ++ fixnum ;; y_return ++ fixnum ;; width_return ++ fixnum ;; height_return ++ fixnum ;; border_width_return ++ fixnum ;; depth_return ++ ++)( fixnum "XGetGeometry")) ++ ++ ++ ++(defentry XGetIconName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; icon_name_return ++ ++)( fixnum "XGetIconName")) ++ ++ ++ ++(defentry XGetInputFocus( ++ ++ fixnum ;; display ++ fixnum ;; focus_return ++ fixnum ;; revert_to_return ++ ++)( void "XGetInputFocus")) ++ ++ ++ ++(defentry XGetKeyboardControl( ++ ++ fixnum ;; display ++ fixnum ;; values_return ++ ++)( void "XGetKeyboardControl")) ++ ++ ++ ++(defentry XGetPointerControl( ++ ++ fixnum ;; display ++ fixnum ;; accel_numerator_return ++ fixnum ;; accel_denominator_return ++ fixnum ;; threshold_return ++ ++)( void "XGetPointerControl")) ++ ++ ++ ++(defentry XGetPointerMapping( ++ ++ fixnum ;; display ++ object ;; map_return ++ fixnum ;; nmap ++ ++)( fixnum "XGetPointerMapping")) ++ ++ ++ ++(defentry XGetScreenSaver( ++ ++ fixnum ;; display ++ fixnum ;; intout_return ++ fixnum ;; interval_return ++ fixnum ;; prefer_blanking_return ++ fixnum ;; allow_exposures_return ++ ++)( void "XGetScreenSaver")) ++ ++ ++ ++(defentry XGetTransientForHint( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; prop_window_return ++ ++)( fixnum "XGetTransientForHint")) ++ ++ ++ ++(defentry XGetWindowProperty( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; property ++ fixnum ;; int_offset ++ fixnum ;; int_length ++ fixnum ;; delete ++ fixnum ;; req_type ++ fixnum ;; actual_type_return ++ fixnum ;; actual_format_return ++ fixnum ;; nitems_return ++ fixnum ;; bytes_after_return ++ fixnum ;; prop_return ++ ++)( fixnum "XGetWindowProperty")) ++ ++ ++ ++(defentry XGetWindowAttributes( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; Window_attributes_return ++ ++)( fixnum "XGetWindowAttributes")) ++ ++ ++ ++(defentry XGrabButton( ++ ++ fixnum ;; display ++ fixnum ;; button ++ fixnum ;; modifiers ++ fixnum ;; grab_window ++ fixnum ;; owner_events ++ fixnum ;; event_mask ++ fixnum ;; pointer_mode ++ fixnum ;; keyboard_mode ++ fixnum ;; confine_to ++ fixnum ;; cursor ++ ++)( void "XGrabButton")) ++ ++ ++ ++(defentry XGrabKey( ++ ++ fixnum ;; display ++ fixnum ;; keycode ++ fixnum ;; modifiers ++ fixnum ;; grab_window ++ fixnum ;; owner_events ++ fixnum ;; pointer_mode ++ fixnum ;; keyboard_mode ++ ++)( void "XGrabKey")) ++ ++ ++ ++(defentry XGrabKeyboard( ++ ++ fixnum ;; display ++ fixnum ;; grab_window ++ fixnum ;; owner_events ++ fixnum ;; pointer_mode ++ fixnum ;; keyboard_mode ++ fixnum ;; fixnum ++ ++)( fixnum "XGrabKeyboard")) ++ ++ ++ ++(defentry XGrabPointer( ++ ++ fixnum ;; display ++ fixnum ;; grab_window ++ fixnum ;; owner_events ++ fixnum ;; event_mask ++ fixnum ;; pointer_mode ++ fixnum ;; keyboard_mode ++ fixnum ;; confine_to ++ fixnum ;; cursor ++ fixnum ;; fixnum ++ ++)( fixnum "XGrabPointer")) ++ ++ ++ ++(defentry XGrabServer( ++ ++ fixnum ;; display ++ ++)( void "XGrabServer")) ++ ++ ++ ++(defentry XHeightMMOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XHeightMMOfScreen")) ++ ++ ++ ++(defentry XHeightOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XHeightOfScreen")) ++ ++ ++ ++(defentry XImageByteOrder( ++ ++ fixnum ;; display ++ ++)( fixnum "XImageByteOrder")) ++ ++ ++ ++(defentry XInstallColormap( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ ++)( void "XInstallColormap")) ++ ++ ++ ++(defentry XKeysymToKeycode( ++ ++ fixnum ;; display ++ fixnum ;; keysym ++ ++)( fixnum "XKeysymToKeycode")) ++ ++ ++ ++(defentry XKillClient( ++ ++ fixnum ;; display ++ fixnum ;; resource ++ ++)( void "XKillClient")) ++ ++ ++ ++(defentry XLookupColor( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ object ;; color_name ++ fixnum ;; exact_def_return ++ fixnum ;; screen_def_return ++ ++)( fixnum "XLookupColor")) ++ ++ ++ ++(defentry XLowerWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XLowerWindow")) ++ ++ ++ ++(defentry XMapRaised( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XMapRaised")) ++ ++ ++ ++(defentry XMapSubwindows( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XMapSubwindows")) ++ ++ ++ ++(defentry XMapWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XMapWindow")) ++ ++ ++ ++(defentry XMaskEvent( ++ ++ fixnum ;; display ++ fixnum ;; event_mask ++ fixnum ;; event_return ++ ++)( void "XMaskEvent")) ++ ++ ++ ++(defentry XMaxCmapsOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XMaxCmapsOfScreen")) ++ ++ ++ ++(defentry XMinCmapsOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XMinCmapsOfScreen")) ++ ++ ++ ++(defentry XMoveResizeWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ ++)( void "XMoveResizeWindow")) ++ ++ ++ ++(defentry XMoveWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; x ++ fixnum ;; y ++ ++)( void "XMoveWindow")) ++ ++ ++ ++(defentry XNextEvent( ++ ++ fixnum ;; display ++ fixnum ;; event_return ++ ++)( void "XNextEvent")) ++ ++ ++ ++(defentry XNoOp( ++ ++ fixnum ;; display ++ ++)( void "XNoOp")) ++ ++ ++ ++(defentry XParseColor( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ object ;; spec ++ fixnum ;; exact_def_return ++ ++)( fixnum "XParseColor")) ++ ++ ++ ++(defentry XParseGeometry( ++ ++ object ;; parsestring ++ fixnum ;; x_return ++ fixnum ;; y_return ++ fixnum ;; width_return ++ fixnum ;; height_return ++ ++)( fixnum "XParseGeometry")) ++ ++ ++ ++(defentry XPeekEvent( ++ ++ fixnum ;; display ++ fixnum ;; event_return ++ ++)( void "XPeekEvent")) ++ ++ ++ ++ ++(defentry XPending( ++ ++ fixnum ;; display ++ ++)( fixnum "XPending")) ++ ++ ++ ++(defentry XPlanesOfScreen( ++ ++ fixnum ;; screen ++ ++ ++)( fixnum "XPlanesOfScreen")) ++ ++ ++ ++(defentry XProtocolRevision( ++ ++ fixnum ;; display ++ ++)( fixnum "XProtocolRevision")) ++ ++ ++ ++(defentry XProtocolVersion( ++ ++ fixnum ;; display ++ ++)( fixnum "XProtocolVersion")) ++ ++ ++ ++ ++(defentry XPutBackEvent( ++ ++ fixnum ;; display ++ fixnum ;; event ++ ++)( void "XPutBackEvent")) ++ ++ ++ ++(defentry XPutImage( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; gc ++ fixnum ;; image ++ fixnum ;; src_x ++ fixnum ;; src_y ++ fixnum ;; dest_x ++ fixnum ;; dest_y ++ fixnum ;; width ++ fixnum ;; height ++ ++)( void "XPutImage")) ++ ++ ++ ++(defentry XQLength( ++ ++ fixnum ;; display ++ ++)( fixnum "XQLength")) ++ ++ ++ ++(defentry XQueryBestCursor( ++ ++ fixnum ;; display ++ fixnum ;; d ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; width_return ++ fixnum ;; height_return ++ ++)( fixnum "XQueryBestCursor")) ++ ++ ++ ++(defentry XQueryBestSize( ++ ++ fixnum ;; display ++ fixnum ;; class ++ fixnum ;; which_screen ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; width_return ++ fixnum ;; height_return ++ ++)( fixnum "XQueryBestSize")) ++ ++ ++ ++(defentry XQueryBestStipple( ++ ++ fixnum ;; display ++ fixnum ;; which_screen ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; width_return ++ fixnum ;; height_return ++ ++)( fixnum "XQueryBestStipple")) ++ ++ ++ ++(defentry XQueryBestTile( ++ ++ fixnum ;; display ++ fixnum ;; which_screen ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; width_return ++ fixnum ;; height_return ++ ++)( fixnum "XQueryBestTile")) ++ ++ ++ ++(defentry XQueryColor( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; def_in_out ++ ++)( void "XQueryColor")) ++ ++ ++ ++(defentry XQueryColors( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; defs_in_out ++ fixnum ;; ncolors ++ ++)( void "XQueryColors")) ++ ++ ++ ++(defentry XQueryExtension( ++ ++ fixnum ;; display ++ object ;; name ++ fixnum ;; major_opcode_return ++ fixnum ;; first_event_return ++ fixnum ;; first_error_return ++ ++)( fixnum "XQueryExtension")) ++ ++ ++;;fix ++(defentry XQueryKeymap( ++ ++ fixnum ;; display ++ fixnum ;; keys_return ++ ++)( void "XQueryKeymap")) ++ ++ ++ ++(defentry XQueryPointer( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; root_return ++ fixnum ;; child_return ++ fixnum ;; root_x_return ++ fixnum ;; root_y_return ++ fixnum ;; win_x_return ++ fixnum ;; win_y_return ++ fixnum ;; mask_return ++ ++)( fixnum "XQueryPointer")) ++ ++ ++ ++(defentry XQueryTextExtents( ++ ++ fixnum ;; display ++ fixnum ;; font_ID ++ object ;; string ++ fixnum ;; nchars ++ fixnum ;; direction_return ++ fixnum ;; font_ascent_return ++ fixnum ;; font_descent_return ++ fixnum ;; overall_return ++ ++)( void "XQueryTextExtents")) ++ ++ ++ ++(defentry XQueryTextExtents16( ++ ++ fixnum ;; display ++ fixnum ;; font_ID ++ fixnum ;; string ++ fixnum ;; nchars ++ fixnum ;; direction_return ++ fixnum ;; font_ascent_return ++ fixnum ;; font_descent_return ++ fixnum ;; overall_return ++ ++)( void "XQueryTextExtents16")) ++ ++ ++ ++(defentry XQueryTree( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; root_return ++ fixnum ;; parent_return ++ fixnum ;; children_return ++ fixnum ;; nchildren_return ++ ++)( fixnum "XQueryTree")) ++ ++ ++ ++(defentry XRaiseWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XRaiseWindow")) ++ ++ ++ ++(defentry XReadBitmapFile( ++ ++ fixnum ;; display ++ fixnum ;; d ++ object ;; filename ++ fixnum ;; width_return ++ fixnum ;; height_return ++ fixnum ;; bitmap_return ++ fixnum ;; x_hot_return ++ fixnum ;; y_hot_return ++ ++)( fixnum "XReadBitmapFile")) ++ ++ ++ ++(defentry XRebindKeysym( ++ ++ fixnum ;; display ++ fixnum ;; keysym ++ fixnum ;; list ++ fixnum ;; mod_count ++ object ;; string ++ fixnum ;; bytes_string ++ ++)( void "XRebindKeysym")) ++ ++ ++ ++(defentry XRecolorCursor( ++ ++ fixnum ;; display ++ fixnum ;; cursor ++ fixnum ;; foreground_color ++ fixnum ;; background_color ++ ++)( void "XRecolorCursor")) ++ ++ ++ ++(defentry XRefreshKeyboardMapping( ++ ++ fixnum ;; event_map ++ ++)( void "XRefreshKeyboardMapping")) ++ ++ ++ ++(defentry XRemoveFromSaveSet( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XRemoveFromSaveSet")) ++ ++ ++ ++(defentry XRemoveHost( ++ ++ fixnum ;; display ++ fixnum ;; host ++ ++)( void "XRemoveHost")) ++ ++ ++ ++(defentry XRemoveHosts( ++ ++ fixnum ;; display ++ fixnum ;; hosts ++ fixnum ;; num_hosts ++ ++)( void "XRemoveHosts")) ++ ++ ++ ++(defentry XReparentWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; parent ++ fixnum ;; x ++ fixnum ;; y ++ ++)( void "XReparentWindow")) ++ ++ ++ ++(defentry XResetScreenSaver( ++ ++ fixnum ;; display ++ ++)( void "XResetScreenSaver")) ++ ++ ++ ++(defentry XResizeWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; width ++ fixnum ;; height ++ ++)( void "XResizeWindow")) ++ ++ ++ ++(defentry XRestackWindows( ++ ++ fixnum ;; display ++ fixnum ;; windows ++ fixnum ;; nwindows ++ ++)( void "XRestackWindows")) ++ ++ ++ ++(defentry XRotateBuffers( ++ ++ fixnum ;; display ++ fixnum ;; rotate ++ ++)( void "XRotateBuffers")) ++ ++ ++ ++(defentry XRotateWindowProperties( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; properties ++ fixnum ;; num_prop ++ fixnum ;; npositions ++ ++)( void "XRotateWindowProperties")) ++ ++ ++ ++(defentry XScreenCount( ++ ++ fixnum ;; display ++ ++)( fixnum "XScreenCount")) ++ ++ ++ ++(defentry XSelectInput( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; event_mask ++ ++)( void "XSelectInput")) ++ ++ ++ ++(defentry XSendEvent( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; propagate ++ fixnum ;; event_mask ++ fixnum ;; event_send ++ ++)( fixnum "XSendEvent")) ++ ++ ++ ++(defentry XSetAccessControl( ++ ++ fixnum ;; display ++ fixnum ;; mode ++ ++)( void "XSetAccessControl")) ++ ++ ++ ++(defentry XSetArcMode( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; arc_mode ++ ++)( void "XSetArcMode")) ++ ++ ++ ++(defentry XSetBackground( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; background ++ ++)( void "XSetBackground")) ++ ++ ++ ++(defentry XSetClipMask( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; fixnum ++ ++)( void "XSetClipMask")) ++ ++ ++ ++(defentry XSetClipOrigin( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; clip_x_origin ++ fixnum ;; clip_y_origin ++ ++)( void "XSetClipOrigin")) ++ ++ ++ ++(defentry XSetClipRectangles( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; clip_x_origin ++ fixnum ;; clip_y_origin ++ fixnum ;; rectangles ++ fixnum ;; n ++ fixnum ;; ordering ++ ++)( void "XSetClipRectangles")) ++ ++ ++ ++(defentry XSetCloseDownMode( ++ ++ fixnum ;; display ++ fixnum ;; close_mode ++ ++)( void "XSetCloseDownMode")) ++ ++ ++ ++(defentry XSetCommand( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; argv ++ fixnum ;; argc ++ ++)( void "XSetCommand")) ++ ++ ++ ++(defentry XSetDashes( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; dash_offset ++ object ;; dash_list ++ fixnum ;; n ++ ++)( void "XSetDashes")) ++ ++ ++ ++(defentry XSetFillRule( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; fill_rule ++ ++)( void "XSetFillRule")) ++ ++ ++ ++(defentry XSetFillStyle( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; fill_style ++ ++)( void "XSetFillStyle")) ++ ++ ++ ++(defentry XSetFont( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; font ++ ++)( void "XSetFont")) ++ ++ ++ ++(defentry XSetFontPath( ++ ++ fixnum ;; display ++ fixnum ;; directories ++ fixnum ;; ndirs ++ ++)( void "XSetFontPath")) ++ ++ ++ ++(defentry XSetForeground( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; foreground ++ ++)( void "XSetForeground")) ++ ++ ++ ++(defentry XSetFunction( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; function ++ ++)( void "XSetFunction")) ++ ++ ++ ++(defentry XSetGraphicsExposures( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; graphics_exposures ++ ++)( void "XSetGraphicsExposures")) ++ ++ ++ ++(defentry XSetIconName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ object ;; icon_name ++ ++)( void "XSetIconName")) ++ ++ ++ ++(defentry XSetInputFocus( ++ ++ fixnum ;; display ++ fixnum ;; focus ++ fixnum ;; revert_to ++ fixnum ;; fixnum ++ ++)( void "XSetInputFocus")) ++ ++ ++ ++(defentry XSetLineAttributes( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; line_width ++ fixnum ;; line_style ++ fixnum ;; cap_style ++ fixnum ;; join_style ++ ++)( void "XSetLineAttributes")) ++ ++ ++ ++(defentry XSetModifierMapping( ++ ++ fixnum ;; display ++ fixnum ;; modmap ++ ++)( fixnum "XSetModifierMapping")) ++ ++ ++ ++(defentry XSetPlaneMask( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; plane_mask ++ ++)( void "XSetPlaneMask")) ++ ++ ++ ++(defentry XSetPointerMapping( ++ ++ fixnum ;; display ++ object ;; map ++ fixnum ;; nmap ++ ++)( fixnum "XSetPointerMapping")) ++ ++ ++ ++(defentry XSetScreenSaver( ++ ++ fixnum ;; display ++ fixnum ;; intout ++ fixnum ;; interval ++ fixnum ;; prefer_blanking ++ fixnum ;; allow_exposures ++ ++)( void "XSetScreenSaver")) ++ ++ ++ ++(defentry XSetSelectionOwner( ++ ++ fixnum ;; display ++ fixnum ;; selection ++ fixnum ;; owner ++ fixnum ;; fixnum ++ ++)( void "XSetSelectionOwner")) ++ ++ ++ ++(defentry XSetState( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; foreground ++ fixnum ;; background ++ fixnum ;; function ++ fixnum ;; plane_mask ++ ++)( void "XSetState")) ++ ++ ++ ++(defentry XSetStipple( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; stipple ++ ++)( void "XSetStipple")) ++ ++ ++ ++(defentry XSetSubwindowMode( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; subwindow_mode ++ ++)( void "XSetSubwindowMode")) ++ ++ ++ ++(defentry XSetTSOrigin( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; ts_x_origin ++ fixnum ;; ts_y_origin ++ ++)( void "XSetTSOrigin")) ++ ++ ++ ++(defentry XSetTile( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; tile ++ ++)( void "XSetTile")) ++ ++ ++ ++(defentry XSetWindowBackground( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; background_pixel ++ ++)( void "XSetWindowBackground")) ++ ++ ++ ++(defentry XSetWindowBackgroundPixmap( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; background_pixmap ++ ++)( void "XSetWindowBackgroundPixmap")) ++ ++ ++ ++(defentry XSetWindowBorder( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; border_pixel ++ ++)( void "XSetWindowBorder")) ++ ++ ++ ++(defentry XSetWindowBorderPixmap( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; border_pixmap ++ ++)( void "XSetWindowBorderPixmap")) ++ ++ ++ ++(defentry XSetWindowBorderWidth( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; width ++ ++)( void "XSetWindowBorderWidth")) ++ ++ ++ ++(defentry XSetWindowColormap( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; colormap ++ ++)( void "XSetWindowColormap")) ++ ++ ++ ++(defentry XStoreBuffer( ++ ++ fixnum ;; display ++ object ;; bytes ++ fixnum ;; nbytes ++ fixnum ;; buffer ++ ++)( void "XStoreBuffer")) ++ ++ ++ ++(defentry XStoreBytes( ++ ++ fixnum ;; display ++ object ;; bytes ++ fixnum ;; nbytes ++ ++)( void "XStoreBytes")) ++ ++ ++ ++(defentry XStoreColor( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; color ++ ++)( void "XStoreColor")) ++ ++ ++ ++(defentry XStoreColors( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ fixnum ;; color ++ fixnum ;; ncolors ++ ++)( void "XStoreColors")) ++ ++ ++ ++(defentry XStoreName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ object ;; window_name ++ ++)( void "XStoreName")) ++ ++ ++ ++(defentry XStoreNamedColor( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ object ;; color ++ fixnum ;; pixel ++ fixnum ;; flags ++ ++)( void "XStoreNamedColor")) ++ ++ ++ ++(defentry XSync( ++ ++ fixnum ;; display ++ fixnum ;; discard ++ ++)( void "XSync")) ++ ++ ++ ++(defentry XTextExtents( ++ ++ fixnum ;; font_struct ++ object ;; string ++ fixnum ;; nchars ++ fixnum ;; direction_return ++ fixnum ;; font_ascent_return ++ fixnum ;; font_descent_return ++ fixnum ;; overall_return ++ ++)( void "XTextExtents")) ++ ++ ++ ++(defentry XTextExtents16( ++ ++ fixnum ;; font_struct ++ fixnum ;; string ++ fixnum ;; nchars ++ fixnum ;; direction_return ++ fixnum ;; font_ascent_return ++ fixnum ;; font_descent_return ++ fixnum ;; overall_return ++ ++)( void "XTextExtents16")) ++ ++ ++ ++(defentry XTextWidth( ++ ++ fixnum ;; font_struct ++ object ;; string ++ fixnum ;; count ++ ++)( fixnum "XTextWidth")) ++ ++ ++ ++(defentry XTextWidth16( ++ ++ fixnum ;; font_struct ++ fixnum ;; string ++ fixnum ;; count ++ ++)( fixnum "XTextWidth16")) ++ ++ ++ ++(defentry XTranslateCoordinates( ++ ++ fixnum ;; display ++ fixnum ;; src_w ++ fixnum ;; dest_w ++ fixnum ;; src_x ++ fixnum ;; src_y ++ fixnum ;; dest_x_return ++ fixnum ;; dest_y_return ++ fixnum ;; child_return ++ ++)( fixnum "XTranslateCoordinates")) ++ ++ ++ ++(defentry XUndefineCursor( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XUndefineCursor")) ++ ++ ++ ++(defentry XUngrabButton( ++ ++ fixnum ;; display ++ fixnum ;; button ++ fixnum ;; modifiers ++ fixnum ;; grab_window ++ ++)( void "XUngrabButton")) ++ ++ ++ ++(defentry XUngrabKey( ++ ++ fixnum ;; display ++ fixnum ;; keycode ++ fixnum ;; modifiers ++ fixnum ;; grab_window ++ ++)( void "XUngrabKey")) ++ ++ ++ ++(defentry XUngrabKeyboard( ++ ++ fixnum ;; display ++ fixnum ;; fixnum ++ ++)( void "XUngrabKeyboard")) ++ ++ ++ ++(defentry XUngrabPointer( ++ ++ fixnum ;; display ++ fixnum ;; fixnum ++ ++)( void "XUngrabPointer")) ++ ++ ++ ++(defentry XUngrabServer( ++ ++ fixnum ;; display ++ ++)( void "XUngrabServer")) ++ ++ ++ ++(defentry XUninstallColormap( ++ ++ fixnum ;; display ++ fixnum ;; colormap ++ ++)( void "XUninstallColormap")) ++ ++ ++ ++(defentry XUnloadFont( ++ ++ fixnum ;; display ++ fixnum ;; font ++ ++)( void "XUnloadFont")) ++ ++ ++ ++(defentry XUnmapSubwindows( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XUnmapSubwindows")) ++ ++ ++ ++(defentry XUnmapWindow( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( void "XUnmapWindow")) ++ ++ ++ ++(defentry XVendorRelease( ++ ++ fixnum ;; display ++ ++)( fixnum "XVendorRelease")) ++ ++ ++ ++(defentry XWarpPointer( ++ ++ fixnum ;; display ++ fixnum ;; src_w ++ fixnum ;; dest_w ++ fixnum ;; src_x ++ fixnum ;; src_y ++ fixnum ;; src_width ++ fixnum ;; src_height ++ fixnum ;; dest_x ++ fixnum ;; dest_y ++ ++)( void "XWarpPointer")) ++ ++ ++ ++(defentry XWidthMMOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XWidthMMOfScreen")) ++ ++ ++ ++(defentry XWidthOfScreen( ++ ++ fixnum ;; screen ++ ++)( fixnum "XWidthOfScreen")) ++ ++ ++ ++(defentry XWindowEvent( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; event_mask ++ fixnum ;; event_return ++ ++)( void "XWindowEvent")) ++ ++ ++ ++(defentry XWriteBitmapFile( ++ ++ fixnum ;; display ++ object ;; filename ++ fixnum ;; bitmap ++ fixnum ;; width ++ fixnum ;; height ++ fixnum ;; x_hot ++ fixnum ;; y_hot ++ ++)( fixnum "XWriteBitmapFile")) ++ ++ ++ ++;;;;;;;;;problems ++ ++ ++ ++ ++;;(defentry fixnum (int Synchronize( ++ ++;; fixnum ;; display ++;; fixnum ;; onoff ++ ++;;))()()) ++;;(defentry fixnum (int SetAfterFunction( ++ ++;; fixnum ;; display ++;; fixnum (int ( fixnum ;; display ++;; ) ;; procedure ++ ++;;))()()) ++ ++ ++;;(defentry void XPeekIfEvent( ++ ++;; fixnum ;; display ++;; fixnum ;; event_return ++;; fixnum (int ( fixnum ;; display ++;; fixnum ;; event ++;; object ;; arg ++;; ) ;; predicate ++;; object ;; arg ++ ++;;)()) ++ ++;;(defentry fixnum XCheckIfEvent( ++ ++;; fixnum ;; display ++;; fixnum ;; event_return ++;; fixnum (int ( fixnum ;; display ++;; fixnum ;; event ++;; object ;; arg ++;; ) ;; predicate ++;; object ;; arg ++ ++;;)()) ++ ++;;(defentry void XIfEvent( ++ ++;; fixnum ;; display ++;; fixnum ;; event_return ++;; fixnum (int ( fixnum ;; display ++;; fixnum ;; event ++;; object ;; arg ++;; ) ;; predicate ++;; object ;; arg ++ ++;;)()) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_lispserver.lsp +@@ -0,0 +1,130 @@ ++; lispserver.lsp Gordon S. Novak Jr. ; 26 Jan 06 ++ ++; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; 06 Jun 02 ++ ++; See the file gnu.license . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++;------------------------------------------------------------------------ ++ ++; This is an example of a simple interactive graphical interface ++; to a Lisp program. It reads Lisp expressions from the user, ++; evaluates them, and prints the result. ++ ++; Stand-alone usage using XGCL (edit file paths as appropriate): ++; (load "/u/novak/X/xgcl-2/dwsyms.lsp") ++; (load "/u/novak/X/xgcl-2/dwimports.lsp") ++; (load "/u/novak/X/solaris/dwtrans.o") ++; (load "/u/novak/glisp/menu-settrans.lsp") ++; (load "/u/novak/glisp/lispservertrans.lsp") ++; (lisp-server) ++ ++; Usage with the WeirdX Java emulation of an X server begins with ++; the web page example.html and uses the files lispserver.cgi , ++; nph-lisp-action.cgi , and lispdemo.lsp . ++ ++;------------------------------------------------------------------------ ++ ++(defvar *wio-window* nil) ++(defvar *wio-window-width* 500) ++(defvar *wio-window-height* 300) ++(defvar *wio-menu-set* nil) ++(defvar *wio-font* '8x13) ++ ++(glispglobals (*wio-window* window) ++ (*wio-window-width* integer) ++ (*wio-window-height* integer) ++ (*wio-menu-set* menu-set) ) ++ ++(defmacro while (test &rest forms) ++ `(loop (unless ,test (return)) ,@forms) ) ++ ++; 18 Apr 95; 20 Apr 95; 08 May 95; 31 May 02 ++; Make a window to use. ++(setf (glfnresulttype 'wio-window) 'window) ++(defun wio-window (&optional title width height (posx 0) (posy 0) font) ++ (if width (setq *wio-window-width* width)) ++ (if height (setq *wio-window-height* height)) ++ (or *wio-window* ++ (setq *wio-window* ++ (window-create *wio-window-width* *wio-window-height* title ++ nil posx posy font))) ) ++ ++; 19 Apr 95 ++(defun wio-init-menus (w commands) ++ (let () ++ (window-clear w) ++ (setq *wio-menu-set* (menu-set-create w nil)) ++ (menu-set-add-menu *wio-menu-set* 'command nil "Commands" ++ commands (list 0 0)) ++ (menu-set-adjust *wio-menu-set* 'command 'top nil 2) ++ (menu-set-adjust *wio-menu-set* 'command 'right nil 2) ++ )) ++ ++; 19 Apr 95; 20 Apr 95; 25 Apr 95; 02 May 95; 29 May 02 ++; Lisp server example ++(gldefun lisp-server () ++ (let (w inputm done sel (redraw t) str result) ++ (w = (wio-window "Lisp Server")) ++ (open w) ++ (clear w) ++ (set-font w *wio-font*) ++ (wio-init-menus w '(("Quit" . quit))) ++ (window-print-lines w ++ '("Click mouse in the input box, then enter" ++ "a Lisp expression followed by Return." ++ "" ++ "Input: e.g. (+ 3 4) or (sqrt 2)") ++ 10 (- *wio-window-height* 20)) ++ (window-printat-xy w "Result:" 10 (- *wio-window-height* 150)) ++ (inputm = (textmenu-create (- *wio-window-width* 100) 30 nil w ++ 20 (- *wio-window-height* 110) t t '9x15 t)) ++ (add-item *wio-menu-set* 'input nil inputm) ++ (while ~ done do ++ (sel = (menu-set-select *wio-menu-set* redraw)) ++ (redraw = nil) ++ (case (menu-name sel) ++ (command ++ (case (port sel) ++ (quit (done = t)) ++ )) ++ (input (str = (port sel)) ++ (result = (catch 'error ++ (eval (safe-read-from-string str)))) ++ (erase-area-xy w 20 2 (- *wio-window-width* 20) ++ (- *wio-window-height* 160)) ++ (window-print-line w (write-to-string result :pretty t) ++ 20 (- *wio-window-height* 170))) ++ ) ) ++ (close w) ++ )) ++ ++; 25 Apr 95; 14 Mar 01 ++(defun safe-read-from-string (str) ++ (if (and (stringp str) (> (length str) 0)) ++ (read-from-string str nil 'read-error))) ++ ++(defun compile-lispserver () ++ (glcompfiles *directory* ++ '("glisp/vector.lsp") ; auxiliary files ++ '("glisp/lispserver.lsp") ; translated files ++ "glisp/lispservertrans.lsp") ; output file ++ ) +--- gcl-2.6.7.orig/xgcl-2/XStruct-4.c ++++ gcl-2.6.7/xgcl-2/XStruct-4.c +@@ -1,7 +1,7 @@ +-/* XStruct-4.c Hiep Huu Nguyen 27 Aug 92 */ ++/* XStruct-4.c Hiep Huu Nguyen 27 Jun 06 */ + + /* ; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. +- ++; edited 27 Aug 92; 12 Aug 2002 by G. Novak; 24 Jun 06 by GSN + ; See the files gnu.license and dec.copyright . + + ; This program is free software; you can redistribute it and/or modify +@@ -22,15 +22,15 @@ + ; See the file dec.copyright for details. */ + + #include ++#include + #include + #include + +-#include "include.h" + + /********* XExtCodes funcions *****/ + +-int make_XExtCodes (){ +- return ((int) calloc(1, sizeof(XExtCodes))); ++long make_XExtCodes (){ ++ return ((long) calloc(1, sizeof(XExtCodes))); + } + + int XExtCodes_first_error(i) +@@ -88,8 +88,8 @@ int j; + + /********* XPixmapFormatValues funcions *****/ + +-int make_XPixmapFormatValues (){ +- return ((int) calloc(1, sizeof(XPixmapFormatValues))); ++long make_XPixmapFormatValues (){ ++ return ((long) calloc(1, sizeof(XPixmapFormatValues))); + } + + int XPixmapFormatValues_scanline_pad(i) +@@ -134,8 +134,8 @@ int j; + + /********* XGCValues funcions *****/ + +-int make_XGCValues (){ +- return ((int) calloc(1, sizeof(XGCValues))); ++long make_XGCValues (){ ++ return ((long) calloc(1, sizeof(XGCValues))); + } + + char XGCValues_dashes(i) +@@ -527,8 +527,8 @@ int j; + + /********* Visual funcions *****/ + +-int make_Visual (){ +- return ((int) calloc(1, sizeof(Visual))); ++long make_Visual (){ ++ return ((long) calloc(1, sizeof(Visual))); + } + + int Visual_map_entries(i) +@@ -622,37 +622,37 @@ int j; + i->visualid = j; + } + +-XExtData *Visual_ext_data(i) ++long Visual_ext_data(i) + Visual* i; + { +- return(i->ext_data); ++ return((long) i->ext_data); + } + + void set_Visual_ext_data(i, j) + Visual* i; +-XExtData *j; ++long j; + { +- i->ext_data = j; ++ i->ext_data = (XExtData *) j; + } + + + /********* Depth funcions *****/ + +-int make_Depth (){ +- return ((int) calloc(1, sizeof(Depth))); ++long make_Depth (){ ++ return ((long) calloc(1, sizeof(Depth))); + } + +-Visual *Depth_visuals(i) ++long Depth_visuals(i) + Depth* i; + { +- return(i->visuals); ++ return((long) i->visuals); + } + + void set_Depth_visuals(i, j) + Depth* i; +-Visual *j; ++long j; + { +- i->visuals = j; ++ i->visuals = (Visual *) j; + } + + int Depth_nvisuals(i) +@@ -684,8 +684,8 @@ int j; + + /********* Screen funcions *****/ + +-int make_Screen (){ +- return ((int) calloc(1, sizeof(Screen))); ++long make_Screen (){ ++ return ((long) calloc(1, sizeof(Screen))); + } + + int Screen_root_input_mask(i) +@@ -792,30 +792,30 @@ int j; + i->cmap = j; + } + +-GC Screen_default_gc(i) ++long Screen_default_gc(i) + Screen* i; + { +- return(i->default_gc); ++ return((long) i->default_gc); + } + + void set_Screen_default_gc(i, j) + Screen* i; +-GC j; ++long j; + { +- i->default_gc = j; ++ i->default_gc = (GC) j; + } + +-Visual *Screen_root_visual(i) ++long Screen_root_visual(i) + Screen* i; + { +- return(i->root_visual); ++ return((long) i->root_visual); + } + + void set_Screen_root_visual(i, j) + Screen* i; +-Visual *j; ++long j; + { +- i->root_visual = j; ++ i->root_visual = (Visual *) j; + } + + int Screen_root_depth(i) +@@ -831,17 +831,17 @@ int j; + i->root_depth = j; + } + +-Depth *Screen_depths(i) ++long Screen_depths(i) + Screen* i; + { +- return(i->depths); ++ return((long) i->depths); + } + + void set_Screen_depths(i, j) + Screen* i; +-Depth *j; ++long j; + { +- i->depths = j; ++ i->depths = (Depth *) j; + } + + int Screen_ndepths(i) +@@ -922,37 +922,37 @@ int j; + i->root = j; + } + +-Display *Screen_display(i) ++long Screen_display(i) + Screen* i; + { +- return(i->display); ++ return((long) i->display); + } + + void set_Screen_display(i, j) + Screen* i; +-Display *j; ++long j; + { +- i->display = j; ++ i->display = (struct _XDisplay *) j; + } + +-XExtData *Screen_ext_data(i) ++long Screen_ext_data(i) + Screen* i; + { +- return(i->ext_data); ++ return((long) i->ext_data); + } + + void set_Screen_ext_data(i, j) + Screen* i; +-XExtData *j; ++long j; + { +- i->ext_data = j; ++ i->ext_data = (XExtData *) j; + } + + + /********* ScreenFormat funcions *****/ + +-int make_ScreenFormat (){ +- return ((int) calloc(1, sizeof(ScreenFormat))); ++long make_ScreenFormat (){ ++ return ((long) calloc(1, sizeof(ScreenFormat))); + } + + int ScreenFormat_scanline_pad(i) +@@ -994,24 +994,24 @@ int j; + i->depth = j; + } + +-XExtData *ScreenFormat_ext_data(i) ++long ScreenFormat_ext_data(i) + ScreenFormat* i; + { +- return(i->ext_data); ++ return((long) i->ext_data); + } + + void set_ScreenFormat_ext_data(i, j) + ScreenFormat* i; +-XExtData *j; ++long j; + { +- i->ext_data = j; ++ i->ext_data = (XExtData *) j; + } + + + /********* XSetWindowAttributes funcions *****/ + +-int make_XSetWindowAttributes (){ +- return ((int) calloc(1, sizeof(XSetWindowAttributes))); ++long make_XSetWindowAttributes (){ ++ return ((long) calloc(1, sizeof(XSetWindowAttributes))); + } + + int XSetWindowAttributes_cursor(i) +@@ -1212,21 +1212,21 @@ int j; + + /********* XWindowAttributes funcions *****/ + +-int make_XWindowAttributes (){ +- return ((int) calloc(1, sizeof(XWindowAttributes))); ++long make_XWindowAttributes (){ ++ return ((long) calloc(1, sizeof(XWindowAttributes))); + } + +-Screen *XWindowAttributes_screen(i) ++long XWindowAttributes_screen(i) + XWindowAttributes* i; + { +- return(i->screen); ++ return((long) i->screen); + } + + void set_XWindowAttributes_screen(i, j) + XWindowAttributes* i; +-Screen *j; ++long j; + { +- i->screen = j; ++ i->screen = (Screen *) j; + } + + int XWindowAttributes_override_redirect(i) +@@ -1424,17 +1424,17 @@ int j; + i->root = j; + } + +-Visual *XWindowAttributes_visual(i) ++long XWindowAttributes_visual(i) + XWindowAttributes* i; + { +- return(i->visual); ++ return((long) i->visual); + } + + void set_XWindowAttributes_visual(i, j) + XWindowAttributes* i; +-Visual *j; ++long j; + { +- i->visual = j; ++ i->visual = (Visual *) j; + } + + int XWindowAttributes_depth(i) +@@ -1518,21 +1518,21 @@ int j; + + /********* XHostAddress funcions *****/ + +-int make_XHostAddress (){ +- return ((int) calloc(1, sizeof(XHostAddress))); ++long make_XHostAddress (){ ++ return ((long) calloc(1, sizeof(XHostAddress))); + } + +-char *XHostAddress_address(i) ++long XHostAddress_address(i) + XHostAddress* i; + { +- return(i->address); ++ return((long) i->address); + } + + void set_XHostAddress_address(i, j) + XHostAddress* i; +-char *j; ++long j; + { +- i->address = j; ++ i->address = (char *) j; + } + + int XHostAddress_length(i) +@@ -1564,21 +1564,21 @@ int j; + + /********* XImage funcions *****/ + +-int make_XImage (){ +- return ((int) calloc(1, sizeof(XImage))); ++long make_XImage (){ ++ return ((long) calloc(1, sizeof(XImage))); + } + +-XPointer XImage_obdata(i) ++long XImage_obdata(i) + XImage* i; + { +- return(i->obdata); ++ return((long) i->obdata); + } + + void set_XImage_obdata(i, j) + XImage* i; +-XPointer j; ++long j; + { +- i->obdata = j; ++ i->obdata = (XPointer) j; + } + + int XImage_blue_mask(i) +@@ -1711,17 +1711,17 @@ int j; + i->byte_order = j; + } + +-char *XImage_data(i) ++long XImage_data(i) + XImage* i; + { +- return(i->data); ++ return((long) i->data); + } + + void set_XImage_data(i, j) + XImage* i; +-char *j; ++long j; + { +- i->data = j; ++ i->data = (char *) j; + } + + int XImage_format(i) +@@ -1779,8 +1779,8 @@ int j; + + /********* XWindowChanges funcions *****/ + +-int make_XWindowChanges (){ +- return ((int) calloc(1, sizeof(XWindowChanges))); ++long make_XWindowChanges (){ ++ return ((long) calloc(1, sizeof(XWindowChanges))); + } + + int XWindowChanges_stack_mode(i) +@@ -1877,8 +1877,8 @@ int j; + + /********* XColor funcions *****/ + +-int make_XColor (){ +- return ((int) calloc(1, sizeof(XColor))); ++long make_XColor (){ ++ return ((long) calloc(1, sizeof(XColor))); + } + + char XColor_pad(i) +@@ -1962,8 +1962,8 @@ int j; + + /********* XSegment funcions *****/ + +-int make_XSegment (){ +- return ((int) calloc(1, sizeof(XSegment))); ++long make_XSegment (){ ++ return ((long) calloc(1, sizeof(XSegment))); + } + + int XSegment_y2(i) +@@ -2021,8 +2021,8 @@ int j; + + /********* XPoint funcions *****/ + +-int make_XPoint (){ +- return ((int) calloc(1, sizeof(XPoint))); ++long make_XPoint (){ ++ return ((long) calloc(1, sizeof(XPoint))); + } + + int XPoint_y(i) +@@ -2054,8 +2054,8 @@ int j; + + /********* XRectangle funcions *****/ + +-int make_XRectangle (){ +- return ((int) calloc(1, sizeof(XRectangle))); ++long make_XRectangle (){ ++ return ((long) calloc(1, sizeof(XRectangle))); + } + + int XRectangle_height(i) +@@ -2113,8 +2113,8 @@ int j; + + /********* XArc funcions *****/ + +-int make_XArc (){ +- return ((int) calloc(1, sizeof(XArc))); ++long make_XArc (){ ++ return ((long) calloc(1, sizeof(XArc))); + } + + int XArc_angle2(i) +@@ -2198,8 +2198,8 @@ int j; + + /********* XKeyboardControl funcions *****/ + +-int make_XKeyboardControl (){ +- return ((int) calloc(1, sizeof(XKeyboardControl))); ++long make_XKeyboardControl (){ ++ return ((long) calloc(1, sizeof(XKeyboardControl))); + } + + int XKeyboardControl_auto_repeat_mode(i) +@@ -2309,8 +2309,8 @@ int j; + + /********* XKeyboardState funcions *****/ + +-int make_XKeyboardState (){ +- return ((int) calloc(1, sizeof(XKeyboardState))); ++long make_XKeyboardState (){ ++ return ((long) calloc(1, sizeof(XKeyboardState))); + } + + char *XKeyboardState_auto_repeats(i) +@@ -2407,8 +2407,8 @@ int j; + + /********* XTimeCoord funcions *****/ + +-int make_XTimeCoord (){ +- return ((int) calloc(1, sizeof(XTimeCoord))); ++long make_XTimeCoord (){ ++ return ((long) calloc(1, sizeof(XTimeCoord))); + } + + int XTimeCoord_y(i) +@@ -2453,21 +2453,21 @@ int j; + + /********* XModifierKeymap funcions *****/ + +-int make_XModifierKeymap (){ +- return ((int) calloc(1, sizeof(XModifierKeymap))); ++long make_XModifierKeymap (){ ++ return ((long) calloc(1, sizeof(XModifierKeymap))); + } + +-KeyCode *XModifierKeymap_modifiermap(i) ++long XModifierKeymap_modifiermap(i) + XModifierKeymap* i; + { +- return(i->modifiermap); ++ return((long) i->modifiermap); + } + + void set_XModifierKeymap_modifiermap(i, j) + XModifierKeymap* i; +-KeyCode *j; ++long j; + { +- i->modifiermap = j; ++ i->modifiermap = (KeyCode *) j; + } + + int XModifierKeymap_max_keypermod(i) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_XStruct_l_3.lsp +@@ -0,0 +1,491 @@ ++(in-package :XLIB) ++; XStruct-l-3.lsp modified by Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++ ++ ++ ++;;;;;; XExtCodes funcions ;;;;;; ++ ++(defentry make-XExtCodes () ( fixnum "make_XExtCodes" )) ++(defentry XExtCodes-first_error (fixnum) ( fixnum "XExtCodes_first_error" )) ++(defentry set-XExtCodes-first_error (fixnum fixnum) ( void "set_XExtCodes_first_error" )) ++(defentry XExtCodes-first_event (fixnum) ( fixnum "XExtCodes_first_event" )) ++(defentry set-XExtCodes-first_event (fixnum fixnum) ( void "set_XExtCodes_first_event" )) ++(defentry XExtCodes-major_opcode (fixnum) ( fixnum "XExtCodes_major_opcode" )) ++(defentry set-XExtCodes-major_opcode (fixnum fixnum) ( void "set_XExtCodes_major_opcode" )) ++(defentry XExtCodes-extension (fixnum) ( fixnum "XExtCodes_extension" )) ++(defentry set-XExtCodes-extension (fixnum fixnum) ( void "set_XExtCodes_extension" )) ++ ++ ++;;;;;; XPixmapFormatValues funcions ;;;;;; ++ ++(defentry make-XPixmapFormatValues () ( fixnum "make_XPixmapFormatValues" )) ++(defentry XPixmapFormatValues-scanline_pad (fixnum) ( fixnum "XPixmapFormatValues_scanline_pad" )) ++(defentry set-XPixmapFormatValues-scanline_pad (fixnum fixnum) ( void "set_XPixmapFormatValues_scanline_pad" )) ++(defentry XPixmapFormatValues-bits_per_pixel (fixnum) ( fixnum "XPixmapFormatValues_bits_per_pixel" )) ++(defentry set-XPixmapFormatValues-bits_per_pixel (fixnum fixnum) ( void "set_XPixmapFormatValues_bits_per_pixel" )) ++(defentry XPixmapFormatValues-depth (fixnum) ( fixnum "XPixmapFormatValues_depth" )) ++(defentry set-XPixmapFormatValues-depth (fixnum fixnum) ( void "set_XPixmapFormatValues_depth" )) ++ ++ ++;;;;;; XGCValues funcions ;;;;;; ++ ++(defentry make-XGCValues () ( fixnum "make_XGCValues" )) ++(defentry XGCValues-dashes (fixnum) ( char "XGCValues_dashes" )) ++(defentry set-XGCValues-dashes (fixnum char) ( void "set_XGCValues_dashes" )) ++(defentry XGCValues-dash_offset (fixnum) ( fixnum "XGCValues_dash_offset" )) ++(defentry set-XGCValues-dash_offset (fixnum fixnum) ( void "set_XGCValues_dash_offset" )) ++(defentry XGCValues-clip_mask (fixnum) ( fixnum "XGCValues_clip_mask" )) ++(defentry set-XGCValues-clip_mask (fixnum fixnum) ( void "set_XGCValues_clip_mask" )) ++(defentry XGCValues-clip_y_origin (fixnum) ( fixnum "XGCValues_clip_y_origin" )) ++(defentry set-XGCValues-clip_y_origin (fixnum fixnum) ( void "set_XGCValues_clip_y_origin" )) ++(defentry XGCValues-clip_x_origin (fixnum) ( fixnum "XGCValues_clip_x_origin" )) ++(defentry set-XGCValues-clip_x_origin (fixnum fixnum) ( void "set_XGCValues_clip_x_origin" )) ++(defentry XGCValues-graphics_exposures (fixnum) ( fixnum "XGCValues_graphics_exposures" )) ++(defentry set-XGCValues-graphics_exposures (fixnum fixnum) ( void "set_XGCValues_graphics_exposures" )) ++(defentry XGCValues-subwindow_mode (fixnum) ( fixnum "XGCValues_subwindow_mode" )) ++(defentry set-XGCValues-subwindow_mode (fixnum fixnum) ( void "set_XGCValues_subwindow_mode" )) ++(defentry XGCValues-font (fixnum) ( fixnum "XGCValues_font" )) ++(defentry set-XGCValues-font (fixnum fixnum) ( void "set_XGCValues_font" )) ++(defentry XGCValues-ts_y_origin (fixnum) ( fixnum "XGCValues_ts_y_origin" )) ++(defentry set-XGCValues-ts_y_origin (fixnum fixnum) ( void "set_XGCValues_ts_y_origin" )) ++(defentry XGCValues-ts_x_origin (fixnum) ( fixnum "XGCValues_ts_x_origin" )) ++(defentry set-XGCValues-ts_x_origin (fixnum fixnum) ( void "set_XGCValues_ts_x_origin" )) ++(defentry XGCValues-stipple (fixnum) ( fixnum "XGCValues_stipple" )) ++(defentry set-XGCValues-stipple (fixnum fixnum) ( void "set_XGCValues_stipple" )) ++(defentry XGCValues-tile (fixnum) ( fixnum "XGCValues_tile" )) ++(defentry set-XGCValues-tile (fixnum fixnum) ( void "set_XGCValues_tile" )) ++(defentry XGCValues-arc_mode (fixnum) ( fixnum "XGCValues_arc_mode" )) ++(defentry set-XGCValues-arc_mode (fixnum fixnum) ( void "set_XGCValues_arc_mode" )) ++(defentry XGCValues-fill_rule (fixnum) ( fixnum "XGCValues_fill_rule" )) ++(defentry set-XGCValues-fill_rule (fixnum fixnum) ( void "set_XGCValues_fill_rule" )) ++(defentry XGCValues-fill_style (fixnum) ( fixnum "XGCValues_fill_style" )) ++(defentry set-XGCValues-fill_style (fixnum fixnum) ( void "set_XGCValues_fill_style" )) ++(defentry XGCValues-join_style (fixnum) ( fixnum "XGCValues_join_style" )) ++(defentry set-XGCValues-join_style (fixnum fixnum) ( void "set_XGCValues_join_style" )) ++(defentry XGCValues-cap_style (fixnum) ( fixnum "XGCValues_cap_style" )) ++(defentry set-XGCValues-cap_style (fixnum fixnum) ( void "set_XGCValues_cap_style" )) ++(defentry XGCValues-line_style (fixnum) ( fixnum "XGCValues_line_style" )) ++(defentry set-XGCValues-line_style (fixnum fixnum) ( void "set_XGCValues_line_style" )) ++(defentry XGCValues-line_width (fixnum) ( fixnum "XGCValues_line_width" )) ++(defentry set-XGCValues-line_width (fixnum fixnum) ( void "set_XGCValues_line_width" )) ++(defentry XGCValues-background (fixnum) ( fixnum "XGCValues_background" )) ++(defentry set-XGCValues-background (fixnum fixnum) ( void "set_XGCValues_background" )) ++(defentry XGCValues-foreground (fixnum) ( fixnum "XGCValues_foreground" )) ++(defentry set-XGCValues-foreground (fixnum fixnum) ( void "set_XGCValues_foreground" )) ++(defentry XGCValues-plane_mask (fixnum) ( fixnum "XGCValues_plane_mask" )) ++(defentry set-XGCValues-plane_mask (fixnum fixnum) ( void "set_XGCValues_plane_mask" )) ++(defentry XGCValues-function (fixnum) ( fixnum "XGCValues_function" )) ++(defentry set-XGCValues-function (fixnum fixnum) ( void "set_XGCValues_function" )) ++ ++ ++;;;;;; *GC funcions ;;;;;; ++ ++;;(defentry make-*GC () ( fixnum "make_*GC" )) ++;;(defentry *GC-values (fixnum) ( fixnum "*GC_values" )) ++;;(defentry set-*GC-values (fixnum fixnum) ( void "set_*GC_values" )) ++;;(defentry *GC-dirty (fixnum) ( fixnum "*GC_dirty" )) ++;;(defentry set-*GC-dirty (fixnum fixnum) ( void "set_*GC_dirty" )) ++;;(defentry *GC-dashes (fixnum) ( fixnum "*GC_dashes" )) ++;;(defentry set-*GC-dashes (fixnum fixnum) ( void "set_*GC_dashes" )) ++;;(defentry *GC-rects (fixnum) ( fixnum "*GC_rects" )) ++;;(defentry set-*GC-rects (fixnum fixnum) ( void "set_*GC_rects" )) ++;;(defentry *GC-gid (fixnum) ( fixnum "*GC_gid" )) ++;;(defentry set-*GC-gid (fixnum fixnum) ( void "set_*GC_gid" )) ++;;(defentry *GC-ext_data (fixnum) ( fixnum "*GC_ext_data" )) ++;;(defentry set-*GC-ext_data (fixnum fixnum) ( void "set_*GC_ext_data" )) ++ ++ ++;;;;;; Visual funcions ;;;;;; ++ ++(defentry make-Visual () ( fixnum "make_Visual" )) ++(defentry Visual-map_entries (fixnum) ( fixnum "Visual_map_entries" )) ++(defentry set-Visual-map_entries (fixnum fixnum) ( void "set_Visual_map_entries" )) ++(defentry Visual-bits_per_rgb (fixnum) ( fixnum "Visual_bits_per_rgb" )) ++(defentry set-Visual-bits_per_rgb (fixnum fixnum) ( void "set_Visual_bits_per_rgb" )) ++(defentry Visual-blue_mask (fixnum) ( fixnum "Visual_blue_mask" )) ++(defentry set-Visual-blue_mask (fixnum fixnum) ( void "set_Visual_blue_mask" )) ++(defentry Visual-green_mask (fixnum) ( fixnum "Visual_green_mask" )) ++(defentry set-Visual-green_mask (fixnum fixnum) ( void "set_Visual_green_mask" )) ++(defentry Visual-red_mask (fixnum) ( fixnum "Visual_red_mask" )) ++(defentry set-Visual-red_mask (fixnum fixnum) ( void "set_Visual_red_mask" )) ++(defentry Visual-class (fixnum) ( fixnum "Visual_class" )) ++(defentry set-Visual-class (fixnum fixnum) ( void "set_Visual_class" )) ++(defentry Visual-visualid (fixnum) ( fixnum "Visual_visualid" )) ++(defentry set-Visual-visualid (fixnum fixnum) ( void "set_Visual_visualid" )) ++(defentry Visual-ext_data (fixnum) ( fixnum "Visual_ext_data" )) ++(defentry set-Visual-ext_data (fixnum fixnum) ( void "set_Visual_ext_data" )) ++ ++ ++;;;;;; Depth funcions ;;;;;; ++ ++(defentry make-Depth () ( fixnum "make_Depth" )) ++(defentry Depth-visuals (fixnum) ( fixnum "Depth_visuals" )) ++(defentry set-Depth-visuals (fixnum fixnum) ( void "set_Depth_visuals" )) ++(defentry Depth-nvisuals (fixnum) ( fixnum "Depth_nvisuals" )) ++(defentry set-Depth-nvisuals (fixnum fixnum) ( void "set_Depth_nvisuals" )) ++(defentry Depth-depth (fixnum) ( fixnum "Depth_depth" )) ++(defentry set-Depth-depth (fixnum fixnum) ( void "set_Depth_depth" )) ++ ++ ++;;;;;; Screen funcions ;;;;;; ++ ++(defentry make-Screen () ( fixnum "make_Screen" )) ++(defentry Screen-root_input_mask (fixnum) ( fixnum "Screen_root_input_mask" )) ++(defentry set-Screen-root_input_mask (fixnum fixnum) ( void "set_Screen_root_input_mask" )) ++(defentry Screen-save_unders (fixnum) ( fixnum "Screen_save_unders" )) ++(defentry set-Screen-save_unders (fixnum fixnum) ( void "set_Screen_save_unders" )) ++(defentry Screen-backing_store (fixnum) ( fixnum "Screen_backing_store" )) ++(defentry set-Screen-backing_store (fixnum fixnum) ( void "set_Screen_backing_store" )) ++(defentry Screen-min_maps (fixnum) ( fixnum "Screen_min_maps" )) ++(defentry set-Screen-min_maps (fixnum fixnum) ( void "set_Screen_min_maps" )) ++(defentry Screen-max_maps (fixnum) ( fixnum "Screen_max_maps" )) ++(defentry set-Screen-max_maps (fixnum fixnum) ( void "set_Screen_max_maps" )) ++(defentry Screen-black_pixel (fixnum) ( fixnum "Screen_black_pixel" )) ++(defentry set-Screen-black_pixel (fixnum fixnum) ( void "set_Screen_black_pixel" )) ++(defentry Screen-white_pixel (fixnum) ( fixnum "Screen_white_pixel" )) ++(defentry set-Screen-white_pixel (fixnum fixnum) ( void "set_Screen_white_pixel" )) ++(defentry Screen-cmap (fixnum) ( fixnum "Screen_cmap" )) ++(defentry set-Screen-cmap (fixnum fixnum) ( void "set_Screen_cmap" )) ++(defentry Screen-default_gc (fixnum) ( fixnum "Screen_default_gc" )) ++(defentry set-Screen-default_gc (fixnum fixnum) ( void "set_Screen_default_gc" )) ++(defentry Screen-root_visual (fixnum) ( fixnum "Screen_root_visual" )) ++(defentry set-Screen-root_visual (fixnum fixnum) ( void "set_Screen_root_visual" )) ++(defentry Screen-root_depth (fixnum) ( fixnum "Screen_root_depth" )) ++(defentry set-Screen-root_depth (fixnum fixnum) ( void "set_Screen_root_depth" )) ++(defentry Screen-depths (fixnum) ( fixnum "Screen_depths" )) ++(defentry set-Screen-depths (fixnum fixnum) ( void "set_Screen_depths" )) ++(defentry Screen-ndepths (fixnum) ( fixnum "Screen_ndepths" )) ++(defentry set-Screen-ndepths (fixnum fixnum) ( void "set_Screen_ndepths" )) ++(defentry Screen-mheight (fixnum) ( fixnum "Screen_mheight" )) ++(defentry set-Screen-mheight (fixnum fixnum) ( void "set_Screen_mheight" )) ++(defentry Screen-mwidth (fixnum) ( fixnum "Screen_mwidth" )) ++(defentry set-Screen-mwidth (fixnum fixnum) ( void "set_Screen_mwidth" )) ++(defentry Screen-height (fixnum) ( fixnum "Screen_height" )) ++(defentry set-Screen-height (fixnum fixnum) ( void "set_Screen_height" )) ++(defentry Screen-width (fixnum) ( fixnum "Screen_width" )) ++(defentry set-Screen-width (fixnum fixnum) ( void "set_Screen_width" )) ++(defentry Screen-root (fixnum) ( fixnum "Screen_root" )) ++(defentry set-Screen-root (fixnum fixnum) ( void "set_Screen_root" )) ++(defentry Screen-display (fixnum) ( fixnum "Screen_display" )) ++(defentry set-Screen-display (fixnum fixnum) ( void "set_Screen_display" )) ++(defentry Screen-ext_data (fixnum) ( fixnum "Screen_ext_data" )) ++(defentry set-Screen-ext_data (fixnum fixnum) ( void "set_Screen_ext_data" )) ++ ++ ++;;;;;; ScreenFormat funcions ;;;;;; ++ ++(defentry make-ScreenFormat () ( fixnum "make_ScreenFormat" )) ++(defentry ScreenFormat-scanline_pad (fixnum) ( fixnum "ScreenFormat_scanline_pad" )) ++(defentry set-ScreenFormat-scanline_pad (fixnum fixnum) ( void "set_ScreenFormat_scanline_pad" )) ++(defentry ScreenFormat-bits_per_pixel (fixnum) ( fixnum "ScreenFormat_bits_per_pixel" )) ++(defentry set-ScreenFormat-bits_per_pixel (fixnum fixnum) ( void "set_ScreenFormat_bits_per_pixel" )) ++(defentry ScreenFormat-depth (fixnum) ( fixnum "ScreenFormat_depth" )) ++(defentry set-ScreenFormat-depth (fixnum fixnum) ( void "set_ScreenFormat_depth" )) ++(defentry ScreenFormat-ext_data (fixnum) ( fixnum "ScreenFormat_ext_data" )) ++(defentry set-ScreenFormat-ext_data (fixnum fixnum) ( void "set_ScreenFormat_ext_data" )) ++ ++ ++;;;;;; XSetWindowAttributes funcions ;;;;;; ++ ++(defentry make-XSetWindowAttributes () ( fixnum "make_XSetWindowAttributes" )) ++(defentry XSetWindowAttributes-cursor (fixnum) ( fixnum "XSetWindowAttributes_cursor" )) ++(defentry set-XSetWindowAttributes-cursor (fixnum fixnum) ( void "set_XSetWindowAttributes_cursor" )) ++(defentry XSetWindowAttributes-colormap (fixnum) ( fixnum "XSetWindowAttributes_colormap" )) ++(defentry set-XSetWindowAttributes-colormap (fixnum fixnum) ( void "set_XSetWindowAttributes_colormap" )) ++(defentry XSetWindowAttributes-override_redirect (fixnum) ( fixnum "XSetWindowAttributes_override_redirect" )) ++(defentry set-XSetWindowAttributes-override_redirect (fixnum fixnum) ( void "set_XSetWindowAttributes_override_redirect" )) ++(defentry XSetWindowAttributes-do_not_propagate_mask (fixnum) ( fixnum "XSetWindowAttributes_do_not_propagate_mask" )) ++(defentry set-XSetWindowAttributes-do_not_propagate_mask (fixnum fixnum) ( void "set_XSetWindowAttributes_do_not_propagate_mask" )) ++(defentry XSetWindowAttributes-event_mask (fixnum) ( fixnum "XSetWindowAttributes_event_mask" )) ++(defentry set-XSetWindowAttributes-event_mask (fixnum fixnum) ( void "set_XSetWindowAttributes_event_mask" )) ++(defentry XSetWindowAttributes-save_under (fixnum) ( fixnum "XSetWindowAttributes_save_under" )) ++(defentry set-XSetWindowAttributes-save_under (fixnum fixnum) ( void "set_XSetWindowAttributes_save_under" )) ++(defentry XSetWindowAttributes-backing_pixel (fixnum) ( fixnum "XSetWindowAttributes_backing_pixel" )) ++(defentry set-XSetWindowAttributes-backing_pixel (fixnum fixnum) ( void "set_XSetWindowAttributes_backing_pixel" )) ++(defentry XSetWindowAttributes-backing_planes (fixnum) ( fixnum "XSetWindowAttributes_backing_planes" )) ++(defentry set-XSetWindowAttributes-backing_planes (fixnum fixnum) ( void "set_XSetWindowAttributes_backing_planes" )) ++(defentry XSetWindowAttributes-backing_store (fixnum) ( fixnum "XSetWindowAttributes_backing_store" )) ++(defentry set-XSetWindowAttributes-backing_store (fixnum fixnum) ( void "set_XSetWindowAttributes_backing_store" )) ++(defentry XSetWindowAttributes-win_gravity (fixnum) ( fixnum "XSetWindowAttributes_win_gravity" )) ++(defentry set-XSetWindowAttributes-win_gravity (fixnum fixnum) ( void "set_XSetWindowAttributes_win_gravity" )) ++(defentry XSetWindowAttributes-bit_gravity (fixnum) ( fixnum "XSetWindowAttributes_bit_gravity" )) ++(defentry set-XSetWindowAttributes-bit_gravity (fixnum fixnum) ( void "set_XSetWindowAttributes_bit_gravity" )) ++(defentry XSetWindowAttributes-border_pixel (fixnum) ( fixnum "XSetWindowAttributes_border_pixel" )) ++(defentry set-XSetWindowAttributes-border_pixel (fixnum fixnum) ( void "set_XSetWindowAttributes_border_pixel" )) ++(defentry XSetWindowAttributes-border_pixmap (fixnum) ( fixnum "XSetWindowAttributes_border_pixmap" )) ++(defentry set-XSetWindowAttributes-border_pixmap (fixnum fixnum) ( void "set_XSetWindowAttributes_border_pixmap" )) ++(defentry XSetWindowAttributes-background_pixel (fixnum) ( fixnum "XSetWindowAttributes_background_pixel" )) ++(defentry set-XSetWindowAttributes-background_pixel (fixnum fixnum) ( void "set_XSetWindowAttributes_background_pixel" )) ++(defentry XSetWindowAttributes-background_pixmap (fixnum) ( fixnum "XSetWindowAttributes_background_pixmap" )) ++(defentry set-XSetWindowAttributes-background_pixmap (fixnum fixnum) ( void "set_XSetWindowAttributes_background_pixmap" )) ++ ++ ++;;;;;; XWindowAttributes funcions ;;;;;; ++ ++(defentry make-XWindowAttributes () ( fixnum "make_XWindowAttributes" )) ++(defentry XWindowAttributes-screen (fixnum) ( fixnum "XWindowAttributes_screen" )) ++(defentry set-XWindowAttributes-screen (fixnum fixnum) ( void "set_XWindowAttributes_screen" )) ++(defentry XWindowAttributes-override_redirect (fixnum) ( fixnum "XWindowAttributes_override_redirect" )) ++(defentry set-XWindowAttributes-override_redirect (fixnum fixnum) ( void "set_XWindowAttributes_override_redirect" )) ++(defentry XWindowAttributes-do_not_propagate_mask (fixnum) ( fixnum "XWindowAttributes_do_not_propagate_mask" )) ++(defentry set-XWindowAttributes-do_not_propagate_mask (fixnum fixnum) ( void "set_XWindowAttributes_do_not_propagate_mask" )) ++(defentry XWindowAttributes-your_event_mask (fixnum) ( fixnum "XWindowAttributes_your_event_mask" )) ++(defentry set-XWindowAttributes-your_event_mask (fixnum fixnum) ( void "set_XWindowAttributes_your_event_mask" )) ++(defentry XWindowAttributes-all_event_masks (fixnum) ( fixnum "XWindowAttributes_all_event_masks" )) ++(defentry set-XWindowAttributes-all_event_masks (fixnum fixnum) ( void "set_XWindowAttributes_all_event_masks" )) ++(defentry XWindowAttributes-map_state (fixnum) ( fixnum "XWindowAttributes_map_state" )) ++(defentry set-XWindowAttributes-map_state (fixnum fixnum) ( void "set_XWindowAttributes_map_state" )) ++(defentry XWindowAttributes-map_installed (fixnum) ( fixnum "XWindowAttributes_map_installed" )) ++(defentry set-XWindowAttributes-map_installed (fixnum fixnum) ( void "set_XWindowAttributes_map_installed" )) ++(defentry XWindowAttributes-colormap (fixnum) ( fixnum "XWindowAttributes_colormap" )) ++(defentry set-XWindowAttributes-colormap (fixnum fixnum) ( void "set_XWindowAttributes_colormap" )) ++(defentry XWindowAttributes-save_under (fixnum) ( fixnum "XWindowAttributes_save_under" )) ++(defentry set-XWindowAttributes-save_under (fixnum fixnum) ( void "set_XWindowAttributes_save_under" )) ++(defentry XWindowAttributes-backing_pixel (fixnum) ( fixnum "XWindowAttributes_backing_pixel" )) ++(defentry set-XWindowAttributes-backing_pixel (fixnum fixnum) ( void "set_XWindowAttributes_backing_pixel" )) ++(defentry XWindowAttributes-backing_planes (fixnum) ( fixnum "XWindowAttributes_backing_planes" )) ++(defentry set-XWindowAttributes-backing_planes (fixnum fixnum) ( void "set_XWindowAttributes_backing_planes" )) ++(defentry XWindowAttributes-backing_store (fixnum) ( fixnum "XWindowAttributes_backing_store" )) ++(defentry set-XWindowAttributes-backing_store (fixnum fixnum) ( void "set_XWindowAttributes_backing_store" )) ++(defentry XWindowAttributes-win_gravity (fixnum) ( fixnum "XWindowAttributes_win_gravity" )) ++(defentry set-XWindowAttributes-win_gravity (fixnum fixnum) ( void "set_XWindowAttributes_win_gravity" )) ++(defentry XWindowAttributes-bit_gravity (fixnum) ( fixnum "XWindowAttributes_bit_gravity" )) ++(defentry set-XWindowAttributes-bit_gravity (fixnum fixnum) ( void "set_XWindowAttributes_bit_gravity" )) ++(defentry XWindowAttributes-class (fixnum) ( fixnum "XWindowAttributes_class" )) ++(defentry set-XWindowAttributes-class (fixnum fixnum) ( void "set_XWindowAttributes_class" )) ++(defentry XWindowAttributes-root (fixnum) ( fixnum "XWindowAttributes_root" )) ++(defentry set-XWindowAttributes-root (fixnum fixnum) ( void "set_XWindowAttributes_root" )) ++(defentry XWindowAttributes-visual (fixnum) ( fixnum "XWindowAttributes_visual" )) ++(defentry set-XWindowAttributes-visual (fixnum fixnum) ( void "set_XWindowAttributes_visual" )) ++(defentry XWindowAttributes-depth (fixnum) ( fixnum "XWindowAttributes_depth" )) ++(defentry set-XWindowAttributes-depth (fixnum fixnum) ( void "set_XWindowAttributes_depth" )) ++(defentry XWindowAttributes-border_width (fixnum) ( fixnum "XWindowAttributes_border_width" )) ++(defentry set-XWindowAttributes-border_width (fixnum fixnum) ( void "set_XWindowAttributes_border_width" )) ++(defentry XWindowAttributes-height (fixnum) ( fixnum "XWindowAttributes_height" )) ++(defentry set-XWindowAttributes-height (fixnum fixnum) ( void "set_XWindowAttributes_height" )) ++(defentry XWindowAttributes-width (fixnum) ( fixnum "XWindowAttributes_width" )) ++(defentry set-XWindowAttributes-width (fixnum fixnum) ( void "set_XWindowAttributes_width" )) ++(defentry XWindowAttributes-y (fixnum) ( fixnum "XWindowAttributes_y" )) ++(defentry set-XWindowAttributes-y (fixnum fixnum) ( void "set_XWindowAttributes_y" )) ++(defentry XWindowAttributes-x (fixnum) ( fixnum "XWindowAttributes_x" )) ++(defentry set-XWindowAttributes-x (fixnum fixnum) ( void "set_XWindowAttributes_x" )) ++ ++ ++;;;;;; XHostAddress funcions ;;;;;; ++ ++(defentry make-XHostAddress () ( fixnum "make_XHostAddress" )) ++(defentry XHostAddress-address (fixnum) ( fixnum "XHostAddress_address" )) ++(defentry set-XHostAddress-address (fixnum fixnum) ( void "set_XHostAddress_address" )) ++(defentry XHostAddress-length (fixnum) ( fixnum "XHostAddress_length" )) ++(defentry set-XHostAddress-length (fixnum fixnum) ( void "set_XHostAddress_length" )) ++(defentry XHostAddress-family (fixnum) ( fixnum "XHostAddress_family" )) ++(defentry set-XHostAddress-family (fixnum fixnum) ( void "set_XHostAddress_family" )) ++ ++ ++;;;;;; XImage funcions ;;;;;; ++ ++(defentry make-XImage () ( fixnum "make_XImage" )) ++;;(defentry XImage-f (fixnum) ( fixnum "XImage_f" )) ++;;(defentry set-XImage-f (fixnum fixnum) ( void "set_XImage_f" )) ++(defentry XImage-obdata (fixnum) ( fixnum "XImage_obdata" )) ++(defentry set-XImage-obdata (fixnum fixnum) ( void "set_XImage_obdata" )) ++(defentry XImage-blue_mask (fixnum) ( fixnum "XImage_blue_mask" )) ++(defentry set-XImage-blue_mask (fixnum fixnum) ( void "set_XImage_blue_mask" )) ++(defentry XImage-green_mask (fixnum) ( fixnum "XImage_green_mask" )) ++(defentry set-XImage-green_mask (fixnum fixnum) ( void "set_XImage_green_mask" )) ++(defentry XImage-red_mask (fixnum) ( fixnum "XImage_red_mask" )) ++(defentry set-XImage-red_mask (fixnum fixnum) ( void "set_XImage_red_mask" )) ++(defentry XImage-bits_per_pixel (fixnum) ( fixnum "XImage_bits_per_pixel" )) ++(defentry set-XImage-bits_per_pixel (fixnum fixnum) ( void "set_XImage_bits_per_pixel" )) ++(defentry XImage-bytes_per_line (fixnum) ( fixnum "XImage_bytes_per_line" )) ++(defentry set-XImage-bytes_per_line (fixnum fixnum) ( void "set_XImage_bytes_per_line" )) ++(defentry XImage-depth (fixnum) ( fixnum "XImage_depth" )) ++(defentry set-XImage-depth (fixnum fixnum) ( void "set_XImage_depth" )) ++(defentry XImage-bitmap_pad (fixnum) ( fixnum "XImage_bitmap_pad" )) ++(defentry set-XImage-bitmap_pad (fixnum fixnum) ( void "set_XImage_bitmap_pad" )) ++(defentry XImage-bitmap_bit_order (fixnum) ( fixnum "XImage_bitmap_bit_order" )) ++(defentry set-XImage-bitmap_bit_order (fixnum fixnum) ( void "set_XImage_bitmap_bit_order" )) ++(defentry XImage-bitmap_unit (fixnum) ( fixnum "XImage_bitmap_unit" )) ++(defentry set-XImage-bitmap_unit (fixnum fixnum) ( void "set_XImage_bitmap_unit" )) ++(defentry XImage-byte_order (fixnum) ( fixnum "XImage_byte_order" )) ++(defentry set-XImage-byte_order (fixnum fixnum) ( void "set_XImage_byte_order" )) ++(defentry XImage-data (fixnum) ( fixnum "XImage_data" )) ++(defentry set-XImage-data (fixnum fixnum) ( void "set_XImage_data" )) ++(defentry XImage-format (fixnum) ( fixnum "XImage_format" )) ++(defentry set-XImage-format (fixnum fixnum) ( void "set_XImage_format" )) ++(defentry XImage-xoffset (fixnum) ( fixnum "XImage_xoffset" )) ++(defentry set-XImage-xoffset (fixnum fixnum) ( void "set_XImage_xoffset" )) ++(defentry XImage-height (fixnum) ( fixnum "XImage_height" )) ++(defentry set-XImage-height (fixnum fixnum) ( void "set_XImage_height" )) ++(defentry XImage-width (fixnum) ( fixnum "XImage_width" )) ++(defentry set-XImage-width (fixnum fixnum) ( void "set_XImage_width" )) ++ ++ ++;;;;;; XWindowChanges funcions ;;;;;; ++ ++(defentry make-XWindowChanges () ( fixnum "make_XWindowChanges" )) ++(defentry XWindowChanges-stack_mode (fixnum) ( fixnum "XWindowChanges_stack_mode" )) ++(defentry set-XWindowChanges-stack_mode (fixnum fixnum) ( void "set_XWindowChanges_stack_mode" )) ++(defentry XWindowChanges-sibling (fixnum) ( fixnum "XWindowChanges_sibling" )) ++(defentry set-XWindowChanges-sibling (fixnum fixnum) ( void "set_XWindowChanges_sibling" )) ++(defentry XWindowChanges-border_width (fixnum) ( fixnum "XWindowChanges_border_width" )) ++(defentry set-XWindowChanges-border_width (fixnum fixnum) ( void "set_XWindowChanges_border_width" )) ++(defentry XWindowChanges-height (fixnum) ( fixnum "XWindowChanges_height" )) ++(defentry set-XWindowChanges-height (fixnum fixnum) ( void "set_XWindowChanges_height" )) ++(defentry XWindowChanges-width (fixnum) ( fixnum "XWindowChanges_width" )) ++(defentry set-XWindowChanges-width (fixnum fixnum) ( void "set_XWindowChanges_width" )) ++(defentry XWindowChanges-y (fixnum) ( fixnum "XWindowChanges_y" )) ++(defentry set-XWindowChanges-y (fixnum fixnum) ( void "set_XWindowChanges_y" )) ++(defentry XWindowChanges-x (fixnum) ( fixnum "XWindowChanges_x" )) ++(defentry set-XWindowChanges-x (fixnum fixnum) ( void "set_XWindowChanges_x" )) ++ ++ ++;;;;;; XColor funcions ;;;;;; ++ ++(defentry make-XColor () ( fixnum "make_XColor" )) ++(defentry XColor-pad (fixnum) ( char "XColor_pad" )) ++(defentry set-XColor-pad (fixnum char) ( void "set_XColor_pad" )) ++(defentry XColor-flags (fixnum) ( char "XColor_flags" )) ++(defentry set-XColor-flags (fixnum char) ( void "set_XColor_flags" )) ++(defentry XColor-blue (fixnum) ( fixnum "XColor_blue" )) ++(defentry set-XColor-blue (fixnum fixnum) ( void "set_XColor_blue" )) ++(defentry XColor-green (fixnum) ( fixnum "XColor_green" )) ++(defentry set-XColor-green (fixnum fixnum) ( void "set_XColor_green" )) ++(defentry XColor-red (fixnum) ( fixnum "XColor_red" )) ++(defentry set-XColor-red (fixnum fixnum) ( void "set_XColor_red" )) ++(defentry XColor-pixel (fixnum) ( fixnum "XColor_pixel" )) ++(defentry set-XColor-pixel (fixnum fixnum) ( void "set_XColor_pixel" )) ++ ++ ++;;;;;; XSegment funcions ;;;;;; ++ ++(defentry make-XSegment () ( fixnum "make_XSegment" )) ++(defentry XSegment-y2 (fixnum) ( fixnum "XSegment_y2" )) ++(defentry set-XSegment-y2 (fixnum fixnum) ( void "set_XSegment_y2" )) ++(defentry XSegment-x2 (fixnum) ( fixnum "XSegment_x2" )) ++(defentry set-XSegment-x2 (fixnum fixnum) ( void "set_XSegment_x2" )) ++(defentry XSegment-y1 (fixnum) ( fixnum "XSegment_y1" )) ++(defentry set-XSegment-y1 (fixnum fixnum) ( void "set_XSegment_y1" )) ++(defentry XSegment-x1 (fixnum) ( fixnum "XSegment_x1" )) ++(defentry set-XSegment-x1 (fixnum fixnum) ( void "set_XSegment_x1" )) ++ ++ ++;;;;;; XPoint funcions ;;;;;; ++ ++(defentry make-XPoint () ( fixnum "make_XPoint" )) ++(defentry XPoint-y (fixnum) ( fixnum "XPoint_y" )) ++(defentry set-XPoint-y (fixnum fixnum) ( void "set_XPoint_y" )) ++(defentry XPoint-x (fixnum) ( fixnum "XPoint_x" )) ++(defentry set-XPoint-x (fixnum fixnum) ( void "set_XPoint_x" )) ++ ++ ++;;;;;; XRectangle funcions ;;;;;; ++ ++(defentry make-XRectangle () ( fixnum "make_XRectangle" )) ++(defentry XRectangle-height (fixnum) ( fixnum "XRectangle_height" )) ++(defentry set-XRectangle-height (fixnum fixnum) ( void "set_XRectangle_height" )) ++(defentry XRectangle-width (fixnum) ( fixnum "XRectangle_width" )) ++(defentry set-XRectangle-width (fixnum fixnum) ( void "set_XRectangle_width" )) ++(defentry XRectangle-y (fixnum) ( fixnum "XRectangle_y" )) ++(defentry set-XRectangle-y (fixnum fixnum) ( void "set_XRectangle_y" )) ++(defentry XRectangle-x (fixnum) ( fixnum "XRectangle_x" )) ++(defentry set-XRectangle-x (fixnum fixnum) ( void "set_XRectangle_x" )) ++ ++ ++;;;;;; XArc funcions ;;;;;; ++ ++(defentry make-XArc () ( fixnum "make_XArc" )) ++(defentry XArc-angle2 (fixnum) ( fixnum "XArc_angle2" )) ++(defentry set-XArc-angle2 (fixnum fixnum) ( void "set_XArc_angle2" )) ++(defentry XArc-angle1 (fixnum) ( fixnum "XArc_angle1" )) ++(defentry set-XArc-angle1 (fixnum fixnum) ( void "set_XArc_angle1" )) ++(defentry XArc-height (fixnum) ( fixnum "XArc_height" )) ++(defentry set-XArc-height (fixnum fixnum) ( void "set_XArc_height" )) ++(defentry XArc-width (fixnum) ( fixnum "XArc_width" )) ++(defentry set-XArc-width (fixnum fixnum) ( void "set_XArc_width" )) ++(defentry XArc-y (fixnum) ( fixnum "XArc_y" )) ++(defentry set-XArc-y (fixnum fixnum) ( void "set_XArc_y" )) ++(defentry XArc-x (fixnum) ( fixnum "XArc_x" )) ++(defentry set-XArc-x (fixnum fixnum) ( void "set_XArc_x" )) ++ ++ ++;;;;;; XKeyboardControl funcions ;;;;;; ++ ++(defentry make-XKeyboardControl () ( fixnum "make_XKeyboardControl" )) ++(defentry XKeyboardControl-auto_repeat_mode (fixnum) ( fixnum "XKeyboardControl_auto_repeat_mode" )) ++;;(defentry set-XKeyboardControl-auto_repeat_mode (fixnum fixnum) ( void "set_XKeyboardControl_auto_repeat_mode" )) ++(defentry XKeyboardControl-key (fixnum) ( fixnum "XKeyboardControl_key" )) ++(defentry set-XKeyboardControl-key (fixnum fixnum) ( void "set_XKeyboardControl_key" )) ++(defentry XKeyboardControl-led_mode (fixnum) ( fixnum "XKeyboardControl_led_mode" )) ++(defentry set-XKeyboardControl-led_mode (fixnum fixnum) ( void "set_XKeyboardControl_led_mode" )) ++(defentry XKeyboardControl-led (fixnum) ( fixnum "XKeyboardControl_led" )) ++(defentry set-XKeyboardControl-led (fixnum fixnum) ( void "set_XKeyboardControl_led" )) ++(defentry XKeyboardControl-bell_duration (fixnum) ( fixnum "XKeyboardControl_bell_duration" )) ++(defentry set-XKeyboardControl-bell_duration (fixnum fixnum) ( void "set_XKeyboardControl_bell_duration" )) ++(defentry XKeyboardControl-bell_pitch (fixnum) ( fixnum "XKeyboardControl_bell_pitch" )) ++(defentry set-XKeyboardControl-bell_pitch (fixnum fixnum) ( void "set_XKeyboardControl_bell_pitch" )) ++(defentry XKeyboardControl-bell_percent (fixnum) ( fixnum "XKeyboardControl_bell_percent" )) ++(defentry set-XKeyboardControl-bell_percent (fixnum fixnum) ( void "set_XKeyboardControl_bell_percent" )) ++(defentry XKeyboardControl-key_click_percent (fixnum) ( fixnum "XKeyboardControl_key_click_percent" )) ++(defentry set-XKeyboardControl-key_click_percent (fixnum fixnum) ( void "set_XKeyboardControl_key_click_percent" )) ++ ++ ++;;;;;; XKeyboardState funcions ;;;;;; ++ ++(defentry make-XKeyboardState () ( fixnum "make_XKeyboardState" )) ++(defentry XKeyboardState-auto_repeats (fixnum) ( fixnum "XKeyboardState_auto_repeats" )) ++(defentry set-XKeyboardState-auto_repeats (fixnum object) ( void "set_XKeyboardState_auto_repeats" )) ++(defentry XKeyboardState-global_auto_repeat (fixnum) ( fixnum "XKeyboardState_global_auto_repeat" )) ++(defentry set-XKeyboardState-global_auto_repeat (fixnum fixnum) ( void "set_XKeyboardState_global_auto_repeat" )) ++(defentry XKeyboardState-led_mask (fixnum) ( fixnum "XKeyboardState_led_mask" )) ++(defentry set-XKeyboardState-led_mask (fixnum fixnum) ( void "set_XKeyboardState_led_mask" )) ++(defentry XKeyboardState-bell_duration (fixnum) ( fixnum "XKeyboardState_bell_duration" )) ++(defentry set-XKeyboardState-bell_duration (fixnum fixnum) ( void "set_XKeyboardState_bell_duration" )) ++(defentry XKeyboardState-bell_pitch (fixnum) ( fixnum "XKeyboardState_bell_pitch" )) ++(defentry set-XKeyboardState-bell_pitch (fixnum fixnum) ( void "set_XKeyboardState_bell_pitch" )) ++(defentry XKeyboardState-bell_percent (fixnum) ( fixnum "XKeyboardState_bell_percent" )) ++(defentry set-XKeyboardState-bell_percent (fixnum fixnum) ( void "set_XKeyboardState_bell_percent" )) ++(defentry XKeyboardState-key_click_percent (fixnum) ( fixnum "XKeyboardState_key_click_percent" )) ++(defentry set-XKeyboardState-key_click_percent (fixnum fixnum) ( void "set_XKeyboardState_key_click_percent" )) ++ ++ ++;;;;;; XTimeCoord funcions ;;;;;; ++ ++(defentry make-XTimeCoord () ( fixnum "make_XTimeCoord" )) ++(defentry XTimeCoord-y (fixnum) ( fixnum "XTimeCoord_y" )) ++(defentry set-XTimeCoord-y (fixnum fixnum) ( void "set_XTimeCoord_y" )) ++(defentry XTimeCoord-x (fixnum) ( fixnum "XTimeCoord_x" )) ++(defentry set-XTimeCoord-x (fixnum fixnum) ( void "set_XTimeCoord_x" )) ++(defentry XTimeCoord-time (fixnum) ( fixnum "XTimeCoord_time" )) ++(defentry set-XTimeCoord-time (fixnum fixnum) ( void "set_XTimeCoord_time" )) ++ ++ ++;;;;;; XModifierKeymap funcions ;;;;;; ++ ++(defentry make-XModifierKeymap () ( fixnum "make_XModifierKeymap" )) ++(defentry XModifierKeymap-modifiermap (fixnum) ( fixnum "XModifierKeymap_modifiermap" )) ++(defentry set-XModifierKeymap-modifiermap (fixnum fixnum) ( void "set_XModifierKeymap_modifiermap" )) ++(defentry XModifierKeymap-max_keypermod (fixnum) ( fixnum "XModifierKeymap_max_keypermod" )) ++(defentry set-XModifierKeymap-max_keypermod (fixnum fixnum) ( void "set_XModifierKeymap_max_keypermod" )) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_dwtest.lsp +@@ -0,0 +1,192 @@ ++; dwtest.lsp Gordon S. Novak Jr. 10 Jan 96 ++ ++; Some examples for testing the window interface in dwindow.lsp / dwtrans.lsp ++ ++; Copyright (c) 1996 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; See the file gnu.license . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++(use-package :xlib) ++(defun user::xgcl-demo nil ++ (wtesta) ++ (wtestb) ++ (format t "Try (wtestc) ... (wtestk) for more examples.")) ++ ++(defmacro while (test &rest forms) ++ `(loop (unless ,test (return)) ,@forms) ) ++ ++(defvar *myw*) ; my window ++(defvar myw) ++ ++; Make a window to play in. ++(defun wtesta () ++ (setq myw (setq *myw* (window-create 300 300 "test window"))) ) ++ ++; 15 Aug 91; 12 Sep 91; 05 Oct 94; 06 Oct 94 ++; Draw some basic things in the window ++(defun wtestb () ++ (window-clear *myw*) ++ (window-draw-box-xy *myw* 50 50 50 20 1) ++ (window-printat *myw* "howdy" '(58 55)) ++ (window-draw-line *myw* '(100 70) '(200 170)) ++ (window-draw-arrow-xy *myw* 200 170 165 205) ++ (window-draw-circle-xy *myw* 200 170 50 2) ++ (window-draw-ellipse-xy *myw* 100 170 40 20 1) ++ (window-printat-xy *myw* "ellipse" 70 165) ++ (window-draw-arc-xy *myw* 100 250 20 20 0 90 1) ++ (window-draw-arc-xy *myw* 100 250 20 20 0 -90 1) ++ (window-printat-xy *myw* "arcs" 80 244) ++ (window-printat-xy *myw* "invert" 54 200) ++ (window-invert-area-xy *myw* 50 160 60 60) ++ (window-copy-area-xy *myw* 40 150 200 50 60 40) ++ (window-printat-xy *myw* "copy" 210 100) ++ (window-set-color-rgb *myw* 65535 0 0) ; red foreground ++ (window-printat-xy *myw* "Red" 20 20) ++ (window-draw-rcbox-xy *myw* 15 15 32 20 5) ++ (window-set-color-rgb *myw* 0 0 65535 t) ; blue background ++ (window-set-color-rgb *myw* 0 65535 0) ; green foreground ++ (window-printat-xy *myw* "Green" 120 20) ++ (window-set-color-rgb *myw* 0 65535 0 t) ; green background ++ (window-set-color-rgb *myw* 0 0 65535) ; blue foreground ++ (window-printat-xy *myw* "Blue" 220 20) ++ (window-reset-color *myw*) ++ (window-force-output *myw*) ) ++ ++; 15 Aug 91; 19 Aug 91; 03 Sep 91; 21 Apr 95 ++; Illustrate mouse interaction: ++; click in window *myw* (2 times for line, 3 times for region). ++(defun wtestc () ++ (let (mymenu result start done) ++ (setq mymenu (menu-create '(quit point line box region) "Choose One:")) ++ (while (not done) ++ (setq result ++ (case (menu-select mymenu) ++ (quit (setq done t)) ++ (point (window-get-point *myw*)) ++ (line (setq start (window-get-point *myw*)) ++ (list start ++ (window-get-line-position *myw* (car start) ++ (cadr start)))) ++ (box (window-get-box-position *myw* 40 20)) ++ (region (window-get-region *myw*)) )) ++ (format t "Result: ~A~%" result) ) ++ (menu-destroy mymenu) )) ++ ++; 09 Sep 91 ++; Illustrate icons in menus ++(defun wtestd () ++ (menu '(("Triangle" . triangle) ++ (dwtest-square . square) ++ (dwtest-circle . circle) ++ hexagon) ++ "Icons in Menu") ) ++ ++(defun dwtest-square (w x y) (window-draw-box-xy w x y 20 20 1)) ++(setf (get 'dwtest-square 'display-size) '(20 20)) ++ ++(defun dwtest-circle (w x y) (window-draw-circle-xy w (+ x 10) (+ y 10) 10 1)) ++(setf (get 'dwtest-circle 'display-size) '(20 20)) ++ ++(defvar mypms nil) ++; 09 Sep 91; 11 Sep 91; 12 Sep 91; 14 Sep 91 ++; Illustrate a diagrammatic menu-like object: square with sensitive spots ++(defun wteste () ++ (let (pm val) ++ (or mypms (mypms-init)) ++ (setq pm (picmenu-create-from-spec mypms "Points on Square")) ++ (setq val (picmenu-select pm)) ++ (picmenu-destroy pm) ++ val )) ++ ++; 14 Sep 91 ++(defun mypms-init () ++ (setq mypms (picmenu-create-spec ++ '((bottom-left ( 20 20)) ++ (center-left ( 20 70)) ++ (top-left ( 20 120)) ++ (bottom-center ( 70 20)) ++ (center ( 70 70) (20 20)) ; larger ++ (top-center ( 70 120)) ++ (bottom-right (120 20)) ++ (center-right (120 70)) ++ (top-right (120 120))) ++ 140 140 'wteste-draw-square t)) ) ++ ++(defvar mypm nil) ++; 10 Sep 91; 11 Sep 91; 12 Sep 91; 14 Sep 91; 17 Sep 91 ++; A picmenu that is "flat" within another window, in this case *myw*. ++; Must do (wtesta) first. ++(defun wtestf () ++ (or mypms (mypms-init)) ++ (or mypm (setq mypm (picmenu-create-from-spec mypms "Points on Square" ++ *myw* 50 50 nil t t))) ++ (picmenu-select mypm)) ++ ++(defun wteste-draw-square (w x y) ++ (window-draw-box-xy w (+ x 20) (+ y 20) 100 100 1)) ++ ++(defvar mym nil) ++; 10 Sep 91; 17 Sep 91 ++; A menu that is "flat" within another window, in this case *myw*. ++; Must do (wtesta) first. ++(defun wtestg () ++ (or mym (setq mym (menu-create '(red white blue) "Flag" *myw* 50 50 nil t))) ++ (menu-select mym)) ++ ++; 09 Oct 91 ++; Demonstrate arrows. Optional arg is line width. ++(defun wtesth ( &optional (lw 1)) ++ (window-clear *myw*) ++ (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 (+ 40 (* i 30)) 160 lw)) ++ (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 (+ 40 (* i 30)) 40 lw)) ++ (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 40 (+ 40 (* i 30)) lw)) ++ (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 160 (+ 40 (* i 30)) lw)) ++ (dotimes (i 5) (window-draw-arrow-xy *myw* 200 (+ 40 (* i 30)) ++ 240 (+ 40 (* i 30)) ++ (1+ i) )) ++ (window-force-output *myw*) ) ++ ++; 04 Jan 94 ++; Redo some of the arrows from wtesth in color ++(defun wtesti () ++ (window-set-color-rgb *myw* 65535 0 0) ++ (window-draw-arrow-xy *myw* 200 70 240 70 2) ++ (window-set-color-rgb *myw* 0 65535 0) ++ (window-draw-arrow-xy *myw* 200 100 240 100 3) ++ (window-set-color-rgb *myw* 0 0 65535) ++ (window-draw-arrow-xy *myw* 200 130 240 130 4) ++ (window-reset-color *myw*) ++ (window-force-output *myw*) ) ++ ++; 04 Jan 94 ++; Get text from a window. Move mouse pointer into test window. ++; Add characters and/or backspace, Return. ++; Note: it might be necessary to change the keyboard mapping, using ++; (window-init-keyboard-mapping *myw*) and (window-print-keyboard-mapping) ++(defun wtestj () (window-input-string *myw* "Foo" 50 200 200)) ++ ++; 04 Jan 94 ++; Change foreground and background colors and input a string ++(defun wtestk () ++ (window-set-color-rgb *myw* 0 65535 0) ; green foreground ++ (window-set-color-rgb *myw* 0 0 65535 t) ; blue background ++ (prog1 (window-input-string *myw* "Foo" 50 200 200) ++ (window-reset-color *myw*) ++ (window-force-output *myw*) ) ) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_lispservertrans.lsp +@@ -0,0 +1,110 @@ ++; 27 Jan 2006 14:38:08 CST ++; This program 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 program 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 program; if not, write to the Free Software ++; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ++ ++ ++(DEFVAR *WIO-WINDOW* NIL) ++ ++(DEFVAR *WIO-WINDOW-WIDTH* 500) ++ ++(DEFVAR *WIO-WINDOW-HEIGHT* 300) ++ ++(DEFVAR *WIO-MENU-SET* NIL) ++ ++(DEFVAR *WIO-FONT* '8X13) ++ ++(DEFVAR *WIO-WINDOW*) ++(SETF (GET '*WIO-WINDOW* 'GLISPGLOBALVAR) T) ++(SETF (GET '*WIO-WINDOW* 'GLISPGLOBALVARTYPE) 'WINDOW) ++(DEFVAR *WIO-WINDOW-WIDTH*) ++(SETF (GET '*WIO-WINDOW-WIDTH* 'GLISPGLOBALVAR) T) ++(SETF (GET '*WIO-WINDOW-WIDTH* 'GLISPGLOBALVARTYPE) 'INTEGER) ++(DEFVAR *WIO-WINDOW-HEIGHT*) ++(SETF (GET '*WIO-WINDOW-HEIGHT* 'GLISPGLOBALVAR) T) ++(SETF (GET '*WIO-WINDOW-HEIGHT* 'GLISPGLOBALVARTYPE) 'INTEGER) ++(DEFVAR *WIO-MENU-SET*) ++(SETF (GET '*WIO-MENU-SET* 'GLISPGLOBALVAR) T) ++(SETF (GET '*WIO-MENU-SET* 'GLISPGLOBALVARTYPE) 'MENU-SET) ++ ++ ++(DEFMACRO WHILE (TEST &REST FORMS) ++ (LIST* 'LOOP (LIST 'UNLESS TEST '(RETURN)) FORMS)) ++ ++(SETF (GET 'WIO-WINDOW 'GLFNRESULTTYPE) 'WINDOW) ++ ++(DEFUN WIO-WINDOW (&OPTIONAL TITLE WIDTH HEIGHT (POSX 0) (POSY 0) FONT) ++ (IF WIDTH (SETQ *WIO-WINDOW-WIDTH* WIDTH)) ++ (IF HEIGHT (SETQ *WIO-WINDOW-HEIGHT* HEIGHT)) ++ (OR *WIO-WINDOW* ++ (SETQ *WIO-WINDOW* ++ (WINDOW-CREATE *WIO-WINDOW-WIDTH* *WIO-WINDOW-HEIGHT* TITLE ++ NIL POSX POSY FONT)))) ++ ++(DEFUN WIO-INIT-MENUS (W COMMANDS) ++ (LET () ++ (WINDOW-CLEAR W) ++ (SETQ *WIO-MENU-SET* (MENU-SET-CREATE W NIL)) ++ (MENU-SET-ADD-MENU *WIO-MENU-SET* 'COMMAND NIL "Commands" COMMANDS ++ (LIST 0 0)) ++ (MENU-SET-ADJUST *WIO-MENU-SET* 'COMMAND 'TOP NIL 2) ++ (MENU-SET-ADJUST *WIO-MENU-SET* 'COMMAND 'RIGHT NIL 2))) ++ ++(DEFUN LISP-SERVER () ++ (LET (W INPUTM DONE SEL (REDRAW T) STR RESULT) ++ (SETQ W (WIO-WINDOW "Lisp Server")) ++ (WINDOW-OPEN W) ++ (WINDOW-CLEAR W) ++ (WINDOW-SET-FONT W *WIO-FONT*) ++ (WIO-INIT-MENUS W '(("Quit" . QUIT))) ++ (WINDOW-PRINT-LINES W ++ '("Click mouse in the input box, then enter" ++ "a Lisp expression followed by Return." "" ++ "Input: e.g. (+ 3 4) or (sqrt 2)") ++ 10 (+ -20 *WIO-WINDOW-HEIGHT*)) ++ (WINDOW-PRINTAT-XY W "Result:" 10 (+ -150 *WIO-WINDOW-HEIGHT*)) ++ (SETQ INPUTM ++ (TEXTMENU-CREATE (+ -100 *WIO-WINDOW-WIDTH*) 30 NIL W 20 ++ (+ -110 *WIO-WINDOW-HEIGHT*) T T '9X15 T)) ++ (MENU-SET-ADD-ITEM *WIO-MENU-SET* 'INPUT NIL INPUTM) ++ (WHILE (NOT DONE) ++ (SETQ SEL (MENU-SET-SELECT *WIO-MENU-SET* REDRAW)) ++ (SETQ REDRAW NIL) ++ (CASE (CADR SEL) ++ (COMMAND (CASE (CAR SEL) (QUIT (SETQ DONE T)))) ++ (INPUT (SETQ STR (CAR SEL)) ++ (SETQ RESULT ++ (CATCH 'ERROR ++ (EVAL (SAFE-READ-FROM-STRING STR)))) ++ (WINDOW-ERASE-AREA-XY W 20 2 ++ (+ -20 *WIO-WINDOW-WIDTH*) ++ (+ -160 *WIO-WINDOW-HEIGHT*)) ++ (WINDOW-PRINT-LINE W ++ (WRITE-TO-STRING RESULT :PRETTY T) 20 ++ (+ -170 *WIO-WINDOW-HEIGHT*))))) ++ (WINDOW-CLOSE W))) ++ ++(DEFUN SAFE-READ-FROM-STRING (STR) ++ (IF (AND (STRINGP STR) (> (LENGTH STR) 0)) ++ (READ-FROM-STRING STR NIL 'READ-ERROR))) ++ ++(DEFUN COMPILE-LISPSERVER () ++ (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp") ++ '("glisp/lispserver.lsp") "glisp/lispservertrans.lsp" ++ "glisp/gpl.txt")) ++ ++(DEFUN COMPILE-LISPSERVERB () ++ (GLCOMPFILES *DIRECTORY* ++ '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") ++ '("glisp/lispserver.lsp") "glisp/lispservertrans.lsp" ++ "glisp/gpl.txt")) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_pcalc.lsp +@@ -0,0 +1,133 @@ ++; pcalc.lsp Gordon S. Novak Jr. 20 Oct 94 ++ ++; Pocket calculator implemented using a picmenu. Entry is (pcalc) . ++ ++; Copyright (c) 1994 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; See the file gnu.license . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++ ++(defvar *pcalcw* nil) ; window ++(defvar *pcalcm* nil) ; picmenu ++ ++(defun pcalc-draw (w x y) ++ (let (items item over up) ++ (window-open w) ++ (window-clear w) ++ (window-draw-rcbox-xy *pcalcw* 0 0 170 215 10 2) ++ (window-draw-rcbox-xy *pcalcw* 10 180 150 25 6) ++ (setq items '(0 \. = + 1 2 3 - 4 5 6 * 7 8 9 / off ac ce +-)) ++ (dotimes (i 5) ++ (setq up (+ 10 (* i 35))) ++ (dotimes (j 4) ++ (setq over (+ 10 (* j 40))) ++ (setq item (pop items)) ++ (window-printat-xy *pcalcw* item ++ (+ over 15 (* (if (numberp item) 1 ++ (length (stringify item))) ++ -5)) (+ up 3)) ++ (window-draw-rcbox-xy *pcalcw* over up 28 20 6) )) ++ (window-force-output) )) ++ ++(defun pcalc-init () ++ (prog ((n 15)) ++ (setq *pcalcw* (window-create 170 215 "pcalc" nil nil nil '9x15)) ++ lp (when (and (> n 0) (null (window-wait-exposure *pcalcw*))) ++ (sleep 1.0) (decf n) (go lp)) ++ (setq *pcalcm* ++ (picmenu-create ++ '((0 (24 20) (24 16)) ++ (\. (64 20) (24 16)) ++ (= (104 20) (24 16)) ++ (+ (144 20) (24 16)) ++ (1 (24 55) (24 16)) ++ (2 (64 55) (24 16)) ++ (3 (104 55) (24 16)) ++ (- (144 55) (24 16)) ++ (4 (24 90) (24 16)) ++ (5 (64 90) (24 16)) ++ (6 (104 90) (24 16)) ++ (* (144 90) (24 16)) ++ (7 (24 125) (24 16)) ++ (8 (64 125) (24 16)) ++ (9 (104 125) (24 16)) ++ (/ (144 125) (24 16)) ++ (off (24 160) (24 16)) ++ (ac (64 160) (24 16)) ++ (ce (104 160) (24 16)) ++ (+- (144 160) (24 16))) ++ 170 215 'pcalc-draw nil nil *pcalcw* 0 0 t t)) )) ++ ++(defun pcalc-display (val) ++ (let (str) ++ (window-erase-area-xy *pcalcw* 15 182 140 20) ++ (setq str (if (integerp val) ++ (princ-to-string val) ++ (format nil "~8,4F" val))) ++ (window-printat-xy *pcalcw* str (- 131 (* 9 (length str))) 185) ++ (window-force-output) )) ++ ++ ++(defun pcalc () ++ (prog (key (ent 0) (ac 0) decpt lastop lastkey) ++ (or *pcalcw* (pcalc-init)) ++ (pcalc-draw *pcalcw* 0 0) ++ (pcalc-display ent) ++ lp (setq key (picmenu-select *pcalcm*)) ++ (if (numberp key) ++ (progn (when (eq lastkey '=) ++ (setq ent 0) (setq decpt nil) (setq ac 0) (setq lastop nil)) ++ (if decpt ++ (progn (setq ent (+ ent (* key decpt))) ++ (setq decpt (/ decpt 10.0)) ) ++ (setq ent (+ key (* ent 10))) ) ++ (pcalc-display ent)) ++ (case key ++ ((+ - * /) ++ (if lastop ++ (progn (setq ac (if (eq lastop '/) ++ (/ (float ac) ent) ++ (funcall lastop ac ent))) ++ (pcalc-display ac)) ++ (setq ac ent)) ++ (setq lastop key) ++ (setq ent 0) ++ (setq decpt nil)) ++ (= (if lastop ++ (progn (setq ent (if (eq lastop '/) ++ (/ (float ac) ent) ++ (funcall lastop ac ent))) ++ (pcalc-display ent))) ++ (setq lastop nil)) ++ (\. (when (eq lastkey '=) ++ (setq ent 0) (setq ac 0) (setq lastop nil)) ++ (setq decpt 0.1) ++ (setq ent (float ent)) ++ (pcalc-display ent)) ++ (+- (setq ent (- ent)) ++ (pcalc-display ent)) ++ (ce (setq ent 0) (setq decpt nil) (pcalc-display ent)) ++ (ac (setq ent 0) (setq decpt nil) (setq ac 0) (setq lastop nil) ++ (pcalc-display ent)) ++ (off (window-close *pcalcw*) ++ (return nil)) ) ) ++ (setq lastkey key) ++ (go lp) )) ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_general.lsp +@@ -0,0 +1,85 @@ ++(in-package :XLIB) ++; general.lsp Hiep Huu Nguyen ; 24 Jun 06 ++; 15 Sep 05; 24 Jan 06 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++; 27 Aug 92 ++; 15 Sep 05: Edited by G. Novak to change C function headers to new form ++; 24 Jan 06: Edited by G. Novak to remove vertex-array entries. ++; 22 Jun 06: Edited by G. Novak to fix entry types ++ ++;(defentry free (string) (void free)) ++;(defentry calloc(fixnum fixnum) (string calloc)) ++(defentry char-array (int) (fixnum char_array)) ++(defentry char-pos (fixnum int) (char char_pos)) ++(defentry set-char-array (fixnum int char) (void set_char_array)) ++ ++(defentry int-array (int) (fixnum int_array)) ++(defentry int-pos (fixnum int) (int int_pos)) ++(defentry set-int-array (fixnum int int) (void set_int_array)) ++ ++(defentry fixnum-array (int) (fixnum fixnum_array)) ++(defentry fixnum-pos (fixnum int) (fixnum fixnum_pos)) ++(defentry set-fixnum-array (fixnum int fixnum) (void set_fixnum_array)) ++ ++;;from mark ring's function ++;; General routines. ++(defCfun "object get_c_string(object s)" 0 ++ " return((object)s->st.st_self);" ++ ) ++(defCfun "object get_c_string1(object s)" 0 ++ " return((object)object_to_string(s));" ++ ) ++(defCfun "fixnum get_c_string2(object s)" 0 ++ " return((fixnum)get_c_string(s));" ++ ) ++(defentry get_c_string_2 (object) (object get_c_string)) ++ ++;; make sure string is null terminated ++ ++(defentry get-c-string (object) (object get_c_string1));"(object)object_to_string")) ++ ++;; General routines. ++(defCfun "object lisp_string(object a_string, fixnum c_string) " 0 ++ "fixnum len = strlen((void *)c_string);" ++ "a_string->st.st_dim = len;" ++ "a_string->st.st_fillp = len;" ++ "a_string->st.st_self = (void *)c_string;" ++ "return(a_string);" ++ ) ++ ++(defentry lisp-string-2 (object fixnum ) (object lisp_string)) ++(defun lisp-string (a-string ) ++ (lisp-string-2 "" a-string )) ++ ++;;modified from mark ring's function ++;; General routines. ++(defCfun "fixnum get_st_point(object s)" 0 ++ " return((fixnum) s->st.st_self);" ++ ) ++(defentry get-st-point2 (object) (fixnum get_c_string2));"(fixnum)get_c_string")) ++ ++;; make sure string is null terminated ++(defun get-st-point (string) ++ ( get-st-point2 (concatenate 'string string ""))) ++ +--- gcl-2.6.7.orig/xgcl-2/makefile ++++ gcl-2.6.7/xgcl-2/makefile +@@ -1,76 +1,33 @@ +-############ BEGIN Things you may have to change ########## +- + -include ../makedefs + +-# The main gcl source directory. Expects to find $(GCLDIR)/o/*.o etc. +-# and it will put saved_xgcl in $(GCLDIR)/unixport/saved_xgcl +-#GCLDIR = /fix/t2/camm/b/gcl +- +-# The current directory: +-SYSDIR = $(GCLDIR)/xgcl-2 +-# way to get xlibraries: +-#X_LIBS = -L/usr/X11R6/lib -lXaw -lXmu -lXt -lXext -lX11 +-# for RS6000 at UT: +-#X_LIBS = -L/usr/local/X11R5/lib -lXaw -lXmu -lXt -lXext -lX11 +- +-# for Sun's at UT use -I/usr/local/X11R5/include +-IFLAGS = -I../h -I../o $(X_CFLAGS) +- +-############ END Things you may have to change ############### +- +-SYSTEM=xgcl +- +-# How to invoke gcl +-LISP = $(PORTDIR)/saved_gcl $(PORTDIR)/ +- +-SRC = . +-PORTDIR =$(GCLDIR)/unixport +- +-CFLAGS += $(IFLAGS) +- +-C_OBJS=$(SYSDIR)/Xutil-2.o $(SYSDIR)/Events.o $(SYSDIR)/XStruct-2.o \ +- $(SYSDIR)/XStruct-4.o $(SYSDIR)/general-c.o +- +-all: $(PORTDIR)/saved_$(SYSTEM) Xgcl +- +-maxobjs: $(shell echo *.lsp) $(PORTDIR)/saved_gcl +- echo '(load "sysdef.lisp")(setq si::*multiply-stacks* 2)'\ +- '(xlib::compile-xgcl)' | $(LISP) +- +-$(PORTDIR)/saved_$(SYSTEM): $(C_OBJS) maxobjs +- (cd $(PORTDIR) ; $(MAKE) saved_xgcl "INIT_SYSTEM_LSP=init_gcl.lsp" "SYSTEM=$(SYSTEM)" "SYSTEM_OBJS=`cat $(SYSDIR)/maxobjs` $(C_OBJS) " "EXTRA_LD_LIBS= $(X_LIBS) " "PORTDIR=$(PORTDIR)") +- rm -f $(PORTDIR)/raw_$(SYSTEM) +- +-Xgcl: +- echo $(PORTDIR)/saved_$(SYSTEM) $(PORTDIR)/ > Xgcl +- chmod a+x Xgcl +- +-############ the C code ############### +- +-cmpinclude.h: ../h/cmpinclude.h +- ln -snf $< $@ + +-$(SYSDIR)/Xutil-2.o: cmpinclude.h $(SYSDIR)/Xutil-2.c +- $(CC) -c Xutil-2.c $(CFLAGS) ++all: objects docs + +-$(SYSDIR)/Events.o: cmpinclude.h $(SYSDIR)/Events.c +- $(CC) -c Events.c $(CFLAGS) ++objects: $(LISP) ++ echo '(load "sysdef.lisp")(xlib::compile-xgcl)' | $(LISP) + +-$(SYSDIR)/XStruct-2.o: cmpinclude.h $(SYSDIR)/XStruct-2.c +- $(CC) -c XStruct-2.c $(CFLAGS) ++saved_xgcl: $(LISP) ++ echo '(load "sysdef.lisp")(xlib::compile-xgcl)(xlib::save-xgcl "$@")' | $(LISP) + +-$(SYSDIR)/XStruct-4.o: cmpinclude.h $(SYSDIR)/XStruct-4.c +- $(CC) -c XStruct-4.c $(CFLAGS) ++docs: dwdoc/dwdoccontents.html dwdoc.pdf + +-general-c.o: cmpinclude.h general-c.c +- $(CC) -c general-c.c $(CFLAGS) ++dwdoc/dwdoccontents.html: $(LISP) ++ mkdir -p $(@D) && \ ++ cd $(@D) && \ ++ echo '(load "../sysdef.lisp")(in-package :xlib)(defmacro while (test &rest forms) `(loop (unless ,test (return)) ,@forms))(load "../gcl_tohtml.lsp")(load "../gcl_index.lsp")(tohtml "../dwdoc.tex" "dwdoc")(with-open-file (s "dwdoccontents.html" :direction :output) (let ((*standard-output* s)) (xlib::makecont "../dwdoc.tex" 1 "dwdoc")))(with-open-file (s "dwdocindex.html" :direction :output) (let ((*standard-output* s)) (xlib::printindex indexdata "dwdoc")))' | ../$< + +-tar: +- $(MAKE) tar1 TARD=xgcl-`cat version` + +-tar1: +- (cd .. ; tar cvf - $(TARD)/*.lsp $(TARD)/*.lisp $(TARD)/*.c $(TARD)/*.paper $(TARD)/README $(TARD)/makefile $(TARD)/version | gzip -c > $(TARD).tgz) ++dwdoc.pdf: dwdoc.tex ++ pdflatex $< + + clean: +- rm -f *.o *.data Xgcl maxobjs $(PORTDIR)/saved_$(SYSTEM) cmpinclude.h ++ rm -f *.o *.data saved_* cmpinclude.h dwdoc.pdf dwdoc.aux dwdoc.log gmon.out ++ rm -f gcl*c gcl*h gcl*data gcl_xrecompile* user-init* ++ rm -rf dwdoc ++ ++install: ++ -mkdir -p $(DESTDIR)$(INFO_DIR)../doc ++ -cp -r dwdoc $(DESTDIR)$(INFO_DIR)../doc ++ -cp *tex *.pdf $(DESTDIR)$(INFO_DIR)../doc + ++#.INTERMEDIATE: saved_xgcl +--- gcl-2.6.7.orig/xgcl-2/XStruct-2.c ++++ gcl-2.6.7/xgcl-2/XStruct-2.c +@@ -1,7 +1,7 @@ +-/* XStruct-2.c Hiep Huu Nguyen 27 Aug 92 */ ++/* XStruct-2.c Hiep Huu Nguyen 27 Jun 06 */ + + /* ; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. +- ++; edited 27 Aug 92; 12 Aug 02 by G. Novak; 24 Jun 06 by GSN + ; See the files gnu.license and dec.copyright . + + ; This program is free software; you can redistribute it and/or modify +@@ -29,8 +29,8 @@ + #include + + +-int make__XQEvent (){ +- return ((int) calloc(1, sizeof(_XQEvent))); ++long make__XQEvent (){ ++ return ((long) calloc(1, sizeof(_XQEvent))); + } + + XEvent _XQEvent_event(i) +@@ -46,24 +46,24 @@ XEvent j; + i->event = j; + } + +-_XQEvent *_XQEvent_next(i) ++long _XQEvent_next(i) + _XQEvent* i; + { +- return(i->next); ++ return((long) i->next); + } + + void set__XQEvent_next(i, j) + _XQEvent* i; +-_XQEvent *j; ++long j; + { +- i->next = j; ++ i->next = (struct _XSQEvent *) j; + } + + + /********* XCharStruct funcions *****/ + +-int make_XCharStruct (){ +- return ((int) calloc(1, sizeof(XCharStruct))); ++long make_XCharStruct (){ ++ return ((long) calloc(1, sizeof(XCharStruct))); + } + + int XCharStruct_attributes(i) +@@ -147,8 +147,8 @@ int j; + + /********* XFontProp funcions *****/ + +-int make_XFontProp (){ +- return ((int) calloc(1, sizeof(XFontProp))); ++long make_XFontProp (){ ++ return ((long) calloc(1, sizeof(XFontProp))); + } + + int XFontProp_card32(i) +@@ -180,8 +180,8 @@ int j; + + /********* XFontStruct funcions *****/ + +-int make_XFontStruct (){ +- return ((int) calloc(1, sizeof(XFontStruct))); ++long make_XFontStruct (){ ++ return ((long) calloc(1, sizeof(XFontStruct))); + } + + int XFontStruct_descent(i) +@@ -210,28 +210,28 @@ int j; + i->ascent = j; + } + +-XCharStruct *XFontStruct_per_char(i) ++long XFontStruct_per_char(i) + XFontStruct* i; + { +- return(i->per_char); ++ return((long) i->per_char); + } + + void set_XFontStruct_per_char(i, j) + XFontStruct* i; +-XCharStruct *j; ++long j; + { +- i->per_char = j; ++ i->per_char = (XCharStruct *) j; + } + +-XCharStruct *XFontStruct_max_bounds(i) ++long XFontStruct_max_bounds(i) + XFontStruct* i; + { +- return(&i->max_bounds); ++ return((long) &i->max_bounds); + } +-XCharStruct *XFontStruct_min_bounds(i) ++long XFontStruct_min_bounds(i) + XFontStruct* i; + { +- return(&i->min_bounds); ++ return((long) &i->min_bounds); + } + void set_XFontStruct_max_bounds(i, j) + XFontStruct* i; +@@ -246,17 +246,17 @@ XCharStruct j; + i->min_bounds = j; + } + +-XFontProp *XFontStruct_properties(i) ++long XFontStruct_properties(i) + XFontStruct* i; + { +- return(i->properties); ++ return((long) i->properties); + } + + void set_XFontStruct_properties(i, j) + XFontStruct* i; +-XFontProp *j; ++long j; + { +- i->properties = j; ++ i->properties = (XFontProp *) j; + } + + int XFontStruct_n_properties(i) +@@ -376,24 +376,24 @@ int j; + i->fid = j; + } + +-XExtData * XFontStruct_ext_data(i) ++long XFontStruct_ext_data(i) + XFontStruct* i; + { +- return(i->ext_data); ++ return((long) i->ext_data); + } + + void set_XFontStruct_ext_data(i, j) + XFontStruct* i; +-XExtData *j; ++long j; + { +- i->ext_data = j; ++ i->ext_data = (XExtData *) j; + } + + + /********* XTextItem funcions *****/ + +-int make_XTextItem (){ +- return ((int) calloc(1, sizeof(XTextItem))); ++long make_XTextItem (){ ++ return ((long) calloc(1, sizeof(XTextItem))); + } + + int XTextItem_font(i) +@@ -435,24 +435,24 @@ int j; + i->nchars = j; + } + +-char * XTextItem_chars(i) ++long XTextItem_chars(i) + XTextItem* i; + { +- return(i->chars); ++ return((long) i->chars); + } + + void set_XTextItem_chars(i, j) + XTextItem* i; +-char *j; ++long j; + { +- i->chars = j; ++ i->chars = (char *) j; + } + + + /********* XChar2b funcions *****/ + +-int make_XChar2b (){ +- return ((int) calloc(1, sizeof(XChar2b))); ++long make_XChar2b (){ ++ return ((long) calloc(1, sizeof(XChar2b))); + } + + char XChar2b_byte2(i) +@@ -484,8 +484,8 @@ char j; + + /********* XTextItem16 funcions *****/ + +-int make_XTextItem16 (){ +- return ((int) calloc(1, sizeof(XTextItem16))); ++long make_XTextItem16 (){ ++ return ((long) calloc(1, sizeof(XTextItem16))); + } + + int XTextItem16_font(i) +@@ -527,76 +527,76 @@ int j; + i->nchars = j; + } + +-XChar2b * XTextItem16_chars(i) ++long XTextItem16_chars(i) + XTextItem16* i; + { +- return(i->chars); ++ return((long) i->chars); + } + + void set_XTextItem16_chars(i, j) + XTextItem16* i; +-XChar2b *j; ++long j; + { +- i->chars = j; ++ i->chars = (XChar2b *) j; + } + + + /********* XEDataObject funcions *****/ + +-int make_XEDataObject (){ +- return ((int) calloc(1, sizeof(XEDataObject))); ++long make_XEDataObject (){ ++ return ((long) calloc(1, sizeof(XEDataObject))); + } + +-XFontStruct *XEDataObject_font(i) ++long XEDataObject_font(i) + XEDataObject* i; + { +- return(i->font); ++ return((long) i->font); + } + + void set_XEDataObject_font(i, j) + XEDataObject* i; +-XFontStruct *j; ++long j; + { +- i->font = j; ++ i->font = (XFontStruct *) j; + } + +-ScreenFormat *XEDataObject_pixmap_format(i) ++long XEDataObject_pixmap_format(i) + XEDataObject* i; + { +- return(i->pixmap_format); ++ return((long) i->pixmap_format); + } + + void set_XEDataObject_pixmap_format(i, j) + XEDataObject* i; +-ScreenFormat *j; ++long j; + { +- i->pixmap_format = j; ++ i->pixmap_format = (ScreenFormat *) j; + } + +-Screen *XEDataObject_screen(i) ++long XEDataObject_screen(i) + XEDataObject* i; + { +- return(i->screen); ++ return((long) i->screen); + } + + void set_XEDataObject_screen(i, j) + XEDataObject* i; +-Screen *j; ++long j; + { +- i->screen = j; ++ i->screen = (Screen *) j; + } + +-Visual *XEDataObject_visual(i) ++long XEDataObject_visual(i) + XEDataObject* i; + { +- return(i->visual); ++ return((long) i->visual); + } + + void set_XEDataObject_visual(i, j) + XEDataObject* i; +-Visual *j; ++long j; + { +- i->visual = j; ++ i->visual = (Visual *) j; + } + + GC XEDataObject_gc(i) +@@ -615,8 +615,8 @@ GC j; + + /********* XSizeHints funcions *****/ + +-int make_XSizeHints (){ +- return ((int) calloc(1, sizeof(XSizeHints))); ++long make_XSizeHints (){ ++ return ((long) calloc(1, sizeof(XSizeHints))); + } + + int XSizeHints_win_gravity(i) +@@ -858,8 +858,8 @@ int j; + + /********* XWMHints funcions *****/ + +-int make_XWMHints (){ +- return ((int) calloc(1, sizeof(XWMHints))); ++long make_XWMHints (){ ++ return ((long) calloc(1, sizeof(XWMHints))); + } + + int XWMHints_window_group(i) +@@ -982,8 +982,8 @@ int j; + + /********* XTextProperty funcions *****/ + +-int make_XTextProperty (){ +- return ((int) calloc(1, sizeof(XTextProperty))); ++long make_XTextProperty (){ ++ return ((long) calloc(1, sizeof(XTextProperty))); + } + + int XTextProperty_nitems(i) +@@ -1025,24 +1025,24 @@ int j; + i->encoding = j; + } + +-unsigned char *XTextProperty_value(i) ++long XTextProperty_value(i) + XTextProperty* i; + { +- return(i->value); ++ return((long) i->value); + } + + void set_XTextProperty_value(i, j) + XTextProperty* i; +-unsigned char *j; ++long j; + { +- i->value = j; ++ i->value = (unsigned char *) j; + } + + + /********* XIconSize funcions *****/ + +-int make_XIconSize (){ +- return ((int) calloc(1, sizeof(XIconSize))); ++long make_XIconSize (){ ++ return ((long) calloc(1, sizeof(XIconSize))); + } + + int XIconSize_height_inc(i) +@@ -1126,41 +1126,41 @@ int j; + + /********* XClassHint funcions *****/ + +-int make_XClassHint (){ +- return ((int) calloc(1, sizeof(XClassHint))); ++long make_XClassHint (){ ++ return ((long) calloc(1, sizeof(XClassHint))); + } + +-char *XClassHint_res_class(i) ++long XClassHint_res_class(i) + XClassHint* i; + { +- return(i->res_class); ++ return((long) i->res_class); + } + + void set_XClassHint_res_class(i, j) + XClassHint* i; +-char *j; ++long j; + { +- i->res_class = j; ++ i->res_class = (char *) j; + } + +-char *XClassHint_res_name(i) ++long XClassHint_res_name(i) + XClassHint* i; + { +- return(i->res_name); ++ return((long) i->res_name); + } + + void set_XClassHint_res_name(i, j) + XClassHint* i; +-char *j; ++long j; + { +- i->res_name = j; ++ i->res_name = (char *) j; + } + + + /********* XComposeStatus funcions *****/ + +-int make_XComposeStatus (){ +- return ((int) calloc(1, sizeof(XComposeStatus))); ++long make_XComposeStatus (){ ++ return ((long) calloc(1, sizeof(XComposeStatus))); + } + + int XComposeStatus_chars_matched(i) +@@ -1176,24 +1176,24 @@ int j; + i->chars_matched = j; + } + +-XPointer XComposeStatus_compose_ptr(i) ++long XComposeStatus_compose_ptr(i) + XComposeStatus* i; + { +- return(i->compose_ptr); ++ return((long) i->compose_ptr); + } + + void set_XComposeStatus_compose_ptr(i, j) + XComposeStatus* i; +-XPointer j; ++long j; + { +- i->compose_ptr = j; ++ i->compose_ptr = (XPointer) j; + } + + + /********* XVisualInfo funcions *****/ + +-int make_XVisualInfo (){ +- return ((int) calloc(1, sizeof(XVisualInfo))); ++long make_XVisualInfo (){ ++ return ((long) calloc(1, sizeof(XVisualInfo))); + } + + int XVisualInfo_bits_per_rgb(i) +@@ -1313,24 +1313,24 @@ int j; + i->visualid = j; + } + +-Visual *XVisualInfo_visual(i) ++long XVisualInfo_visual(i) + XVisualInfo* i; + { +- return(i->visual); ++ return((long) i->visual); + } + + void set_XVisualInfo_visual(i, j) + XVisualInfo* i; +-Visual *j; ++long j; + { +- i->visual = j; ++ i->visual = (Visual *) j; + } + + + /********* XStandardColormap funcions *****/ + +-int make_XStandardColormap (){ +- return ((int) calloc(1, sizeof(XStandardColormap))); ++long make_XStandardColormap (){ ++ return ((long) calloc(1, sizeof(XStandardColormap))); + } + + int XStandardColormap_killid(i) +--- gcl-2.6.7.orig/xgcl-2/dwdoc.tex ++++ gcl-2.6.7/xgcl-2/dwdoc.tex +@@ -1,5 +1,5 @@ + % dwdoc.tex Gordon S. Novak Jr. +-% 08 Oct 92; 08 Oct 93; 16 Nov 94; 05 Jan 95 ++% 08 Oct 92; 08 Oct 93; 16 Nov 94; 05 Jan 95; 25 Jan 06; 26 Jan 06; 08 Dec 08 + + \documentstyle[12pt]{article} + \setlength{\oddsidemargin}{0 in} +@@ -12,17 +12,21 @@ + + \begin{document} + +-\begin{center}\Large{{\bf Interface from GCL to X Windows}} \\ ++\Large ++\begin{center} {\bf Interface from GCL to X Windows} \\ \end{center} ++ ++\normalsize + + \vspace*{0.1in} + ++\begin{center} + \large{Gordon S. Novak Jr. \\ + Department of Computer Sciences \\ + University of Texas at Austin \\ + Austin, TX 78712} \\ + \end{center} + +-Software copyright \copyright 1994 by Gordon S. Novak Jr. and ++Software copyright \copyright \/ by Gordon S. Novak Jr. and + The University of Texas at Austin. Distribution and use are allowed + under the Gnu Public License. Also see the copyright section at the end + of this document for the copyright on X Consortium software. +@@ -33,7 +37,7 @@ of this document for the copyright on X + + This document describes a relatively easy-to-use interface between + XGCL (X version of Gnu Common Lisp) and X windows. The interface +-consists of two parts: ++consists of several parts: + \begin{enumerate} + \item Hiep Huu Nguyen has written (and adapted from X Consortium software) + an interface between GCL and Xlib, the X library in C. +@@ -44,6 +48,9 @@ the {\tt dwindow} functions can be exami + + \item The {\tt dwindow} functions described in this document, which call + the Xlib functions and provide an easier interface for Lisp programs. ++ ++\item It is possible to make an interactive graphical interface ++within a web page; this is described in a section below. + \end{enumerate} + The source file for the interface (written in GLISP) is + {\tt dwindow.lsp}; this file is compiled into a file in plain Lisp, +@@ -62,8 +69,8 @@ The type {\tt vector} is a list {\tt (x + ({\tt window} is a Lisp data structure used by the {\tt dwindow} functions). + + Both the Xlib and {\tt dwindow} functions are in the package {\tt xlib:}. +-The file {\tt imports.lsp} may be used to import the {\tt dwindow} symbols +-to the {\tt :user} package. ++In order to use these functions, the Lisp command {\tt (use-package 'xlib)} ++should be used to import the {\tt dwindow} symbols. + + + \section{Examples and Utilities} +@@ -93,6 +100,16 @@ recreate the drawing; use {\tt origin to + {\tt (draw-out file names)} will write definitions of drawings in the + list {\tt names} to the file {\tt file}. + ++\subsection{{\tt editors}} ++ ++The file {\tt editorstrans.lsp} contains some interactive editing programs; ++it is a translation of the file {\tt editors.lsp} . ++One useful editor is the color editor; after entering {\tt (wtesta)} ++(in file {\tt dwtest.lsp}), enter {\tt (edit-color myw)} to edit a ++color. The result is an {\tt rgb} list as used in {\tt window-set-color}. ++ ++A simple line editor and an Emacs-like text editor are described in sections ++\ref{texted} and \ref{emacsed} below. + + \section{Menus} + +@@ -227,10 +244,10 @@ The remaining arguments are as described + Each of the {\tt buttons} in a picmenu is a list: \\ + + \vspace{-0.1in} +-{\tt \hspace*{0.5in} (name offset size highlightfn unhighlightfn)} \\ ++{\tt \hspace*{0.5in} (buttonname offset size highlightfn unhighlightfn)} \\ + + \vspace{-0.1in} +-{\tt name} is the name of the button; it is the value returned when that ++{\tt buttonname} is the name of the button; it is the value returned when that + button is selected. + {\tt offset} is a vector {\tt (x y)} that gives the offset of the center + of the button from the lower-left corner of the picture. +@@ -535,11 +552,15 @@ The color of the foreground (things that + characters) is set by: + + {\tt \hspace*{0.5in} (window-set-color w rgb \&optional background)} \\ ++{\tt \hspace*{0.5in} (window-set-color-rgb w r g b \&optional background)} \\ + + {\tt rgb} is a list {\tt (red green blue)} of 16-bit unsigned integers in + the range {\tt 0} to {\tt 65535}. {\tt background} is non-{\tt nil} + to set the background color rather than the foreground color. + ++{\tt \hspace*{0.5in} (window-reset-color w)} \\ ++{\tt window-reset-color} resets a window's colors to the default values. ++ + Colors are a scarce resource; there is only a finite number of + available colors, such as 256 colors. If you only use a small, fixed set + of colors, the finite set of colors will not be a problem. However, +@@ -556,7 +577,7 @@ the color after it is no longer needed. + {\tt *window-xcolor*}, or the specified color. + + +-\subsection{Character Input} ++\subsection{Character Input} \label{texted} + + Characters can be input within a window by the call: + +@@ -572,6 +593,27 @@ including those from the initial string + {\tt size} (default 100) is erased to the right of the initial caret. + + ++\subsection{Emacs-like Editing} \label{emacsed} ++ ++{\tt window-edit} allows editing of text using an Emacs-subset editor. ++Only a few simple Emacs commands are implemented. ++\begin{verbatim} ++ (window-edit w x y width height &optional strings boxflg scroll endp) ++\end{verbatim} ++{\tt x y width height} specify the offset and size of the editing ++area; it is a good idea to draw a box around this area first. ++{\tt strings} is an initial list of strings; the return value is a list ++of strings. ++{\tt scroll} is number of lines to scroll down before displaying text, ++ or {\tt T} to have one line only and terminate on return. ++{\tt endp} is {\tt T} to begin editing at the end of the first line. ++Example: ++\begin{verbatim} ++ (window-draw-box-xy myw 48 48 204 204) ++ (window-edit myw 50 50 200 200 '("Now is the time" "for all" "good")) ++\end{verbatim} ++ ++ + \section{Mouse Interaction} + + {\tt \hspace*{0.5in} (window-get-point w)} \\ +@@ -676,7 +718,7 @@ the implementation of menus and the mous + this section. + + {\tt \hspace*{0.5in} (window-track-mouse w fn \&optional outflg)} +- ++ + \vspace{-0.05in} + Each time the mouse position changes or a mouse button is pressed, + the function {\tt fn} is called with +@@ -703,6 +745,22 @@ should be used with care; it can destroy + processes associated with the window to be destroyed. It is useful + primarily in debugging, to get rid of a window that is left on the screen + due to an error. ++ ++ ++\section{Examples} ++ ++Several interactive programs using this software for their graphical ++interface can be found at {\tt http://www.cs.utexas.edu/users/novak/} ++under the heading Software Demos. ++ ++ ++\section{Web Interface} ++ ++This software allows a Lisp program to be used interactively within ++a web page. There are two approaches, either using an X server on ++the computer of the person viewing the web page, or using WeirdX, a ++Java program that emulates an X server. Details can be found at: ++{\tt http://www.cs.utexas.edu/users/novak/dwindow.html} + + + \section{Files} +@@ -713,13 +771,19 @@ due to an error. + {\tt drawtrans.lsp} & {\tt draw.lsp} translated into plain Lisp \\ + {\tt draw-gates.lsp} & Code to draw {\tt nand} gates etc. \\ + {\tt dwdoc.tex} & \LaTeX \ source for this document \\ ++{\tt dwexports.lsp} & exported symbols \\ ++{\tt dwimportsb.lsp} & imported symbols \\ + {\tt dwindow.lsp} & GLISP source code for {\tt dwindow} functions \\ + {\tt dwtest.lsp} & Examples of use of {\tt dwindow} functions \\ + {\tt dwtrans.lsp} & {\tt dwindow.lsp} translated into plain Lisp \\ ++{\tt editors.lsp} & Editors for colors etc. \\ ++{\tt editorstrans.lsp} & translation of {\tt editors.lsp} \\ + {\tt gnu.license} & GNU General Public License \\ + {\tt ice-cream.lsp} & Drawing of an ice cream cone made with {\tt draw} \\ +-{\tt imports.lsp} & file to import symbols to {\tt :user} package \\ ++{\tt lispserver.lsp} & Example web demo: a Lisp server \\ ++{\tt lispservertrans.lsp} & translation of {\tt lispserver.lsp} \\ + {\tt menu-set.lsp} & GLISP source code for menu-set functions \\ ++{\tt menu-settrans.lsp} & translation of {\tt menu-set.lsp} \\ + {\tt pcalc.lsp} & Pocket calculator implemented as a {\tt picmenu} \\ + \end{tabular} + +@@ -786,7 +850,7 @@ due to an error. + \vspace*{-.2in} + + \begin{verbatim} +-(picmenu-button (list (name symbol) ++(picmenu-button (list (buttonname symbol) + (offset vector) + (size vector) + (highlightfn anything) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_editors.lsp +@@ -0,0 +1,483 @@ ++; editors.lsp Gordon S. Novak Jr. ; 08 Dec 08 ++ ++; Copyright (c) 2008 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; 13 Apr 95; 02 Jan 97; 28 Feb 02; 08 Jan 04; 03 Mar 04; 26 Jan 06; 27 Jan 06 ++ ++; This program 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 program 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 program; if not, write to the Free Software ++; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ++ ++; Graphical editor functions ++ ++; (edit-thermom 75 myw 20 20 150 250) ++; (window-draw-thermometer myw 0 20 5 50 50 50 232) ++; (window-adjust-thermometer myw 0 20 5 50 50 50 232) ++ ++; 20 Nov 91; 03 Dec 91; 27 Dec 91; 26 Dec 93; 28 Feb 02; 08 Jan 04 ++; Edit an integer with a thermometer-like display ++(gldefun edit-thermom ((num number) (w window) ++ &optional (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (prog (nmin ndel ndiv range pten drange pair neww (res num) off) ++ (if ~ sizex (progn (sizex = 150) (sizey = 250))) ++ (if ~ offsetx ++ (progn (off = (centeroffset w (a vector with x = sizex y = sizey))) ++ (offsetx = (x off)) ++ (offsety = (y off)))) ++ (neww = (window-create sizex sizey nil (parent w) offsetx offsety)) ++ (window-draw-button neww "Typein" 80 20 50 25) ++ (window-draw-button neww "Adjust" 80 70 50 25) ++ (window-draw-button neww "Done" 80 120 50 25) ++ rn (range = (abs res) * 2) ++ (if (range == 0) (range = 50)) ++ (if ((range < 8) and (integerp num)) (range = 10)) ++ (pten = (expt 10 (truncate (log range 10)))) ++ (drange = (range * 10) / pten) ++ (setq pair (car (some #'(lambda (x) (> (car x) drange)) ++ '((14 2) (20 4) (40 5) (70 10) (101 20))))) ++ (setq ndel ((cadr pair) * pten / 10)) ++ (setq ndiv (ceiling (range / ndel))) ++ (setq nmin (if (>= res 0) ++ 0 ++ (- ndel * ndiv))) ++ (window-draw-thermometer neww nmin ndel ndiv res 10 10 (sizey - 20)) ++ lp (case (button-select neww '((done (84 124) (42 17)) ++ (adjust (84 74) (42 17)) ++ (typein (84 24) (42 17)))) ++ (done (destroy neww) (return res)) ++ (adjust (setq res (window-adjust-thermometer neww nmin ndel ndiv res ++ 10 10 (sizey - 20))) ++ (go lp)) ++ (typein (princ "Enter new value: ") ++ (setq res (read)) ++ (if ((res >= nmin) and (res <= (nmin + ndel * ndiv))) ++ (progn (window-set-thermometer neww nmin ndel ndiv res ++ 10 10 (sizey - 20)) ++ (go lp)) ++ (go rn)) ) ) )) ++ ++; 20 Nov 91; 04 Dec 91 ++; Draw a button-like icon ++(gldefun window-draw-button ((w window) (s string) ++ (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (let (sw) ++ (erase-area-xy w offsetx offsety sizex sizey 8) ++ (draw-rcbox-xy w offsetx offsety sizex sizey 8) ++ (sw = (string-width w s)) ++ (printat-xy w s (offsetx + (sizex - sw) / 2) (offsety + 8)) ++ (force-output w))) ++ ++; 17 Dec 91 ++; Print in the center of a specified region ++(gldefun window-center-print ((w window) (s string) ++ (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (let (sw) ++ (erase-area-xy w offsetx offsety sizex sizey 8) ++ (sw = (string-width w s)) ++ (printat-xy w s (offsetx + (sizex - sw) / 2) ++ (offsety + (sizey - 10) / 2) ) ++ (force-output w))) ++ ++; 20 Nov 91; 03 Dec 91; 26 Dec 93 ++; Draw a thermometer-like icon ++(gldefun window-draw-thermometer ((w window) (nmin integer) (ndel integer) ++ (ndiv integer) (val number) ++ (offsetx integer) (offsety integer) ++ (sizey integer)) ++ (let (hdel marky) ++ (erase-area-xy w offsetx offsety 66 sizey) ++ (editors-print-in-box val w offsetx offsety 40 20) ++ (draw-arc-xy w (offsetx + 12) (offsety + 36) 12 12 132 276) ++ (draw-line-xy w (offsetx + 4) (offsety + 44) ++ (offsetx + 4) (offsety + sizey - 8) ) ++ (draw-line-xy w (offsetx + 20) (offsety + 44) ++ (offsetx + 20) (offsety + sizey - 8) ) ++ (draw-arc-xy w (offsetx + 12) (offsety + sizey - 8) 8 8 0 180) ++ (draw-circle-xy w (offsetx + 12) (offsety + 36) 4 7) ++ (hdel = (sizey - 56) / ndiv) ++ (draw-line-xy w (offsetx + 12) (offsety + 35) ++ (offsetx + 12) ++ (offsety + 48 + hdel * ((val - nmin) / ndel)) 7) ++ (dotimes (i (1+ ndiv)) ++ (marky = (offsety + 48 + i * hdel)) ++ (draw-line-xy w (offsetx + 24) marky (offsetx + 34) marky) ++ (printat-xy w (nmin + i * ndel) (offsetx + 36) (marky - 6)) ) ++ (force-output w))) ++ ++ ++; 20 Nov 91; 03 Dec 91; 13 Apr 95 ++; Draw value for a thermometer-like icon ++(gldefun window-set-thermometer ((w window) (nmin integer) (ndel integer) ++ (ndiv integer) (val number) ++ (offsetx integer) (offsety integer) ++ (sizey integer)) ++ (let (hdel) ++ (hdel = (sizey - 56) / ndiv) ++ (erase-area-xy w (offsetx + 7) (offsety + 48) ++ 10 (sizey - 56)) ++ (draw-line-xy w (offsetx + 12) (offsety + 35) ++ (offsetx + 12) ++ (offsety + 48 + hdel * ((val - nmin) / ndel)) 7) ++ (editors-update-in-box val w offsetx offsety 40 20)))) ++ ++ ++; 20 Nov 91; 03 Dec 91; 15 Oct 93; 02 Dec 93; 08 Jan 04 ++; Adjust a thermometer-like icon with the mouse. Returns new value. ++(gldefun window-adjust-thermometer ((w window) (nmin integer) (ndel integer) ++ (ndiv integer) (val number) ++ (offsetx integer) (offsety integer) ++ (sizey integer)) ++ (let (hdel (lasty integer) xmin xmax ymin ymax inside (newval number)) ++ (hdel = (sizey - 56) / ndiv) ++ (lasty = (truncate (offsety + 48 + hdel * ((val - nmin) / ndel)))) ++ (xmin = offsetx + 4) ++ (xmax = offsetx + 20) ++ (ymin = offsety + 48) ++ (ymax = offsety + sizey - 8) ++ (window-track-mouse w ++ #'(lambda (x y code) ++ (inside = (and (>= x xmin) (<= x xmax) ++ (>= y ymin) (<= y ymax))) ++ (when (and inside (/= y lasty)) ++ (if (> y lasty) ++ (draw-line-xy w (offsetx + 12) lasty (offsetx + 12) y 7) ++ (erase-area-xy w (offsetx + 7) (y + 1) ++ 10 (- lasty y))) ++ (lasty = y) ++ (newval = ( ( (lasty - (offsety + 48)) ++ / (float hdel)) * ndel) + nmin) ++ (if (integerp val) (newval = (truncate newval))) ++ (editors-update-in-box newval w offsetx offsety 40 20)) ++ (not (zerop code)))) ++ (if inside ++ newval ++ val) )) ++ ++; 20 Nov 91; 15 Oct 93; 08 Jan 04; 26 Jan 06 ++; Get a mouse selection from a button area. cf. picmenu-select ++(gldefun button-select ((mw window) (buttons (listof picmenu-button))) ++ (let ((current-button picmenu-button) item items (val picmenu-button) ++ xzero yzero inside) ++ (xzero = 0) ; (menu-x m 0) ++ (yzero = 0) ; (menu-y m 0) ++ (track-mouse mw ++ #'(lambda (x y code) ++ (x = (x - xzero)) ++ (y = (y - yzero)) ++ (if ((x >= 0) and (y >= 0)) ++ (inside = t)) ++ (if current-button ++ (if ~ (button-containsxy? current-button x y) ++ (progn (button-invert mw current-button) ++ (current-button = nil)))) ++ (if ~ current-button ++ (progn (items = buttons) ++ (while ~ current-button and (item -_ items) do ++ (if (button-containsxy? item x y) ++ (progn (current-button = item) ++ (button-invert mw current-button) ))))) ++ (if (> code 0) ++ (progn (if current-button ++ (button-invert mw current-button) ) ++ (val = (or current-button *picmenu-no-selection*)) ))) ++ t) ++ (if (val <> *picmenu-no-selection*) (buttonname val)) )) ++ ++; 03 Dec 91 ++(gldefun button-invert ((w window) (button picmenu-button)) ++ (window-invert-area w (offset button) (size button)) ) ++ ++(gldefun window-undraw-box ((w window) offset size &optional lw) ++ (set-erase w) ++ (window-draw-box w offset size lw) ++ (unset w) ) ++ ++; 20 Nov 91; 08 Jan 04 ++(gldefun button-containsxy? ((b picmenu-button) (x integer) (y integer)) ++ (let ((xsize 6) (ysize 6)) ++ (if (size b) ++ (progn (xsize = (x (size b))) ++ (ysize = (y (size b))))) ++ ((x >= (x (offset b))) and (x <= ((x (offset b)) + xsize)) and ++ (y >= (y (offset b))) and (y <= ((y (offset b)) + ysize)) ) )) ++ ++ ++(glispobjects ++ ++(menu-item (z anything) ++ prop ((value ((if z is atomic ++ z ++ (cdr z)))) ) ++ msg ((print-size menu-item-print-size) ++ (draw menu-item-draw)) ) ++ ++) ; glispobjects ++ ++(gldefun menu-item-print-size ((item menu-item) (w window)) ++ (result vector) ++ (let (siz) ++ (if item is atomic ++ (a vector with x = (string-width w item) y = 11) ++ (if (car item) is a string ++ (a vector with x = (string-width w (car item)) y = 11) ++ (if ((symbolp (car item)) ++ and (siz = (get (car item) 'display-size))) ++ siz ++ (a vector with x = 50 y = 11)))) )) ++ ++; 17 Dec 91; 08 Jan 04 ++(gldefun menu-item-draw ((item menu-item) (w window) ++ (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (if item is atomic ++ (window-center-print w item offsetx offsety sizex sizey) ++ (if ((symbolp (car item)) and (fboundp (car item))) ++ (funcall (car item) w offsetx offsety) ++ (window-center-print w (car item) offsetx offsety ++ sizex sizey))) ) ++ ++; 03 Dec 91; 26 Dec 93; 08 Jan 04 ++(gldefun pick-one-size ((items (listof menu-item)) (w window)) ++ (let (wid) ++ (for item in items do ++ (wid = (if wid ++ (max wid (x (print-size item w))) ++ (x (print-size item w))) ) ) ++ (a vector with x = wid y = 11) )) ++ ++; 03 Dec 91; 26 Dec 93; 29 Jul 94; 28 Feb 02 ++(gldefun draw-pick-one ((items (listof menu-item)) (val anything) (w window) ++ &optional (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (let (itm) ++ (if (itm = (that item with (value (that item)) == val)) ++ (draw itm w offsetx offsety sizex sizey)))) ++ ++; 04 Dec 91; 26 Dec 93; 29 Jul 94; 08 Jan 04 ++(gldefun edit-pick-one ((items (listof menu-item)) (val anything) (w window) ++ &optional (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (let (newval) ++ (if ((length items) <= 3) ++ (if (equal val (value (first items))) ++ (newval = (value (second items))) ++ (if (equal val (value (second items))) ++ (newval = (if (third items) ++ (value (third items)) ++ (value (first items)))) ++ (newval = (value (first items))))) ++ (newval = (menu items)) ) ++ (draw-pick-one newval w items offsetx offsety sizex sizey) ++ newval )) ++ ++ ++; 13 Dec 91; 26 Dec 93; 28 Jul 94; 28 Feb 02; 08 Jan 04 ++(gldefun draw-black-white ((items (listof menu-item)) (val anything) (w window) ++ &optional (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (let (itm) ++ (erase-area-xy w offsetx offsety sizex sizey) ++ (if (itm = (that item with (value (that item)) == val)) ++ (if (eql (if (consp itm) ++ (car itm) ++ itm) ++ 1) ++ (invert-area-xy w offsetx offsety sizex sizey)) ) )) ++ ++; 13 Dec 91; 15 Dec 91; 26 Dec 93; 28 Jul 94; 08 Jan 04 ++(gldefun edit-black-white ((items (listof menu-item)) (val anything) (w window) ++ &optional (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (let (newval) ++ (if (equal val (value (first items))) ++ (newval = (value (second items))) ++ (if (equal val (value (second items))) ++ (newval = (value (first items))))) ++ (draw-black-white items newval w offsetx offsety sizex sizey) ++ newval )) ++ ++; 23 Dec 91; 26 Dec 93 ++(gldefun draw-integer ((val integer) (w window) ++ &optional (offsetx integer) (offsety integer) ++ (sizex integer) (sizey integer)) ++ (editors-anything-print val w offsetx offsety sizex sizey) ) ++ ++; 24 Dec 91; 26 Dec 93 ++(defun draw-real (val w &optional offsetx offsety sizex sizey) ++ (let (str nc lng fmt) ++ (if (null sizex) (setq sizex 50)) ++ (setq nc (max 1 (truncate sizex 7))) ++ (setq str (princ-to-string val)) ++ (setq lng (length str)) ++ (if (> lng nc) ++ (if (or (find #\. str :start nc) ++ (find #\E str) ++ (find #\L str)) ++ (if (>= nc 8) ++ (progn (setq fmt (cadr (or (assoc nc '((8 "~8,2E") ++ (9 "~9,2E") (10 "~10,2E") ++ (11 "~11,2E") (12 "~12,2E") ++ (13 "~13,2E") (14 "~14,2E"))) ++ '(15 "~15,2E")))) ++ (setq str (format nil fmt val))) ++ (setq str "*******")) ++ (setq str (subseq str 0 nc)) )) ++ (editors-anything-print w str offsetx offsety sizex sizey) )) ++ ++; 09 Dec 91; 10 Dec 91; 23 Dec 91; 26 Dec 93; 22 Jul 94 ++; Display function for use when a more specific one is not found. ++(gldefun editors-anything-print (obj (w window) offsetx offsety sizex sizey) ++ (let ((s (stringify obj)) swidth smax dx dy) ++ (erase-area-xy w offsetx offsety sizex sizey) ++ (swidth = (string-width w s)) ++ (smax = (min swidth sizex)) ++ (dx = (sizex - smax) / 2) ++ (dy = (max 0 ((sizey - 10) / 2))) ++ (printat-xy w (editors-string-limit obj w smax) ++ (offsetx + dx) (offsety + dy)) ++ )) ++ ++; 26 Dec 93 ++(gldefun editors-print-in-box (obj (w window) offsetx offsety sizex sizey) ++ (printat-xy w (editors-string-limit obj w sizex) ++ (offsetx + 4) (offsety + (sizey - 10) / 2)) ++ (draw-box-xy w offsetx offsety sizex sizey) ) ++ ++; 26 Dec 93 ++(gldefun editors-update-in-box (obj (w window) offsetx offsety sizex sizey) ++ (erase-area-xy w (offsetx + 3) (offsety + 3) (sizex - 6) (sizey - 6)) ++ (printat-xy w (editors-string-limit obj w sizex) ++ (offsetx + 4) (offsety + (sizey - 10) / 2)) ) ++ ++; 28 Oct 91; 26 Dec 93; 08 Jan 04 ++; Limit string to a specified number of pixels ++(gldefun editors-string-limit ((s string) (w window) (max integer)) ++ (result string) ++ (let ((str (stringify s)) (lng integer) (nc integer)) ++ (lng = (string-width w str)) ++ (if (lng > max) ++ (progn (nc = (((length str) * max) / lng)) ++ (subseq str 0 nc)) ++ str) )) ++ ++(defvar *edit-color-menu-set* nil) ++(defvar *edit-color-rmenu* nil) ++(defvar *edit-color-old-color* nil) ++(glispglobals (*edit-color-menu-set* menu-set) ++ (*edit-color-rmenu* barmenu)) ++ ++; 03 Jan 94; 04 Jan 94; 05 Jan 94; 08 Dec 08 ++(gldefun edit-color-init ((w window)) ++ (let (rm gm bm rgb) ++ (rgb = (a rgb)) ++ (glcc 'edit-color-red) ++ (glcc 'edit-color-green) ++ (glcc 'edit-color-blue) ++ (*edit-color-menu-set* = (menu-set-create w nil)) ++ (rm = (barmenu-create 256 200 10 "" nil #'edit-color-red (list rgb) w ++ 120 40 nil t (a rgb with red = 65535))) ++ (*edit-color-rmenu* = rm) ++ (gm = (barmenu-create 256 50 10 "" nil #'edit-color-green (list rgb) w ++ 170 40 nil t (a rgb with green = 65535))) ++ (bm = (barmenu-create 256 250 10 "" nil #'edit-color-blue (list rgb) w ++ 220 40 nil t (a rgb with blue = 65535))) ++ (add-barmenu *edit-color-menu-set* 'red nil rm "Red" '(120 40)) ++ (add-barmenu *edit-color-menu-set* 'green nil gm "Green" '(170 40)) ++ (add-barmenu *edit-color-menu-set* 'blue nil bm "Blue" '(220 40)) ++ (add-menu *edit-color-menu-set* 'done nil "" '(("Done" . done)) '(30 150)) ++ (edit-color-red 200 rgb) ++ (edit-color-green 50 rgb) ++ (edit-color-blue 250 rgb) ++ )) ++ ++; 03 Jan 94; 04 Jan 94 ++(gldefun edit-color-red ((val integer) (color rgb)) ++ (let ((w (window *edit-color-menu-set*))) ++ (printat-xy w (format nil "~3D" val) 113 20) ++ ((red color) = (max 0 (val * 256 - 1))) ++ (edit-display-color w color) )) ++ ++; 03 Jan 94; 04 Jan 94 ++(gldefun edit-color-green ((val integer) (color rgb)) ++ (let ((w (window *edit-color-menu-set*))) ++ (printat-xy w (format nil "~3D" val) 163 20) ++ ((green color) = (max 0 (val * 256 - 1))) ++ (edit-display-color w color) )) ++ ++; 03 Jan 94; 04 Jan 94 ++(gldefun edit-color-blue ((val integer) (color rgb)) ++ (let ((w (window *edit-color-menu-set*))) ++ (printat-xy w (format nil "~3D" val) 213 20) ++ ((blue color) = (max 0 (val * 256 - 1))) ++ (edit-display-color w color) )) ++ ++; 03 Jan 94 ++(gldefun edit-display-color ((w window) (color rgb)) ++ (window-set-color w color) ++ (window-draw-line-xy w 50 40 50 100 60) ++ (window-reset-color w) ++ (if *edit-color-old-color* (window-free-color w *edit-color-old-color*)) ++ (*edit-color-old-color* = *window-xcolor*) ) ++ ++; 03 Jan 94; 04 Jan 94; 05 Jan 94; 28 Feb 02 ++(gldefun edit-color ((w window)) ++ (let (done (color rgb) sel) ++ (if (or (null *edit-color-menu-set*) ++ (not (eq w (menu-window (menu (first (menu-items ++ *edit-color-menu-set*))))))) ++ (edit-color-init w)) ++ (color = (first (subtrackparms *edit-color-rmenu*))) ++ (draw *edit-color-menu-set*) ++ (edit-color-red (truncate (1+ (red color)) 256) color) ++ (edit-color-green (truncate (1+ (green color)) 256) color) ++ (edit-color-blue (truncate (1+ (blue color)) 256) color) ++ (while ~ done ++ (sel = (select *edit-color-menu-set*)) ++ (done = (and sel ((first sel) == 'done))) ) ++ color)) ++ ++; 08 Dec 08 ++(gldefun color-dot ((w window) (x integer) (y integer) (color symbol)) ++ (let (rgb) ++ (setq rgb (cdr (assoc color '((red 65535 0 0) ++ (yellow 65535 57600 0) ++ (green 0 50175 12287) ++ (blue 0 0 65535))))) ++ (or rgb (setq rgb '(30000 30000 30000))) ++ (set-color w rgb) ++ (draw-dot-xy w x y) ++ (reset-color w) )) ++ ++; 15 Oct 93; 26 Jan 06 ++; Compile the editors.lsp file into a plain Lisp file ++(defun compile-editors () ++ (glcompfiles *directory* ++ '("glisp/vector.lsp" ; auxiliary files ++ "X/dwindow.lsp") ++ '("glisp/editors.lsp") ; translated files ++ "glisp/editorstrans.lsp" ; output file ++ "glisp/gpl.txt") ; header file ++ (cf editorstrans) ) ++ ++; Compile the editors.lsp file into a plain Lisp file for XGCL ++(defun compile-editorsb () ++ (glcompfiles *directory* ++ '("glisp/vector.lsp" ; auxiliary files ++ "X/dwindow.lsp" "X/dwnoopen.lsp") ++ '("glisp/editors.lsp") ; translated files ++ "glisp/editorstrans.lsp" ; output file ++ "glisp/gpl.txt") ; header file ++ ) +--- gcl-2.6.7.orig/xgcl-2/README ++++ gcl-2.6.7/xgcl-2/README +@@ -1,7 +1,88 @@ +-README for Xgcl: Gnu Common Lisp with interface to X windows. 15 Mar 95 ++README for xgcl: Gnu Common Lisp interface to X windows. 28 Aug 2006 + +-Copyright (c) 1995 Gordon S. Novak Jr., Hiep Huu Nguyen, William F. Schelter, +-and The University of Texas at Austin. ++Distributed under GNU Public License; copyright notices at the bottom. ++ ++xgcl is an interface from Gnu Common Lisp to the X library, Xlib. ++ ++This software provides a lightweight and fairy easy-to-use way to: ++ * Draw diagrams from Lisp ++ * Create interactive graphical interfaces ++ * Make the interactive Lisp interfaces available via the Web ++ ++Beginning with release 2.6.8, xgcl is built into the make of GCL. ++ ++There is a "raw" interface to the Xlib, and an "easy-to-use" ++interface built on top of it; we will only discuss the "easy-to-use" ++version. ++ ++To use xgcl, start GCL and enter: (xgcl) ++This will load xgcl and print a message inviting you to try (xgcl-demo). ++(xgcl-demo) will create a small window and draw some examples in it. ++You can try (wtestc), (wtestd), ... (wtestk) to try some other things. ++ ++The xgcl files are located in the directory xgcl-2/ relative to the ++GCL directory. ++ ++The file gcl_dwtest.lsp contains the test examples; one way to ++get started quickly is by using this file for examples. ++ ++There is also documentation: ++ dwdoc.tex ++ dwdoc.dvi ++ dwdoc.html http://www.cs.utexas.edu/users/novak/dwdoc.html ++ dwdoc.pdf ++ dwdoc.ps ++ ++To use the basic xgcl, you only need to invoke (xgcl). ++To use some of the more advanced features such as menu-set, described ++below, also load the file gcl_dwimportsb.lsp immediately after ++invoking (xgcl), to import symbols. ++ ++Additional files that may be useful: ++ ++ gcl_menu-set.lsp Source and some comments for menu-set ++ gcl_menu-settrans.lsp menu-set translated to Common Lisp ++ gcl_pcalc.lsp Pocket calculator example ++ gcl_draw-gates.lsp Draw boolean gate symbols ++ gcl_draw.lsp Interactive drawing program source ++ gcl_drawtrans.lsp Drawing program translated to Common Lisp ++ gcl_dwindow.lsp Easy-to-use interface source with comments ++ gcl_dwtrans.lsp Easy-to-use interface translated to Common Lisp ++ gcl_editors.lsp Editors for colors etc. ++ gcl_editorstrans.lsp Editors translated to Common Lisp ++ gcl_ice-cream.lsp Example created using Draw ++ lispserver.lsp Example web demo: a Lisp server ++ lispservertrans.lsp Lisp server translated to Common Lisp ++ Xakcl.paper Documentation on the "raw" Xlib interface ++ Xakcl.example.lsp some PRIMITIVE examples ++ ++ ++This software provides a way to interface Lisp programs to the Web; see: ++ ++ http://www.cs.utexas.edu/users/novak/dwindow.html ++ ++There are two ways to accomplish a Web interface. ++ ++The first uses X directly, and requires that the user have an X server; ++this is reliable and fast, but it only works for the Linux/Mac/Cygwin ++subset of the world. There can also be firewall issues. ++ ++The other option uses WeirdX, an X server written in Java. ++The WeirdX interface is often slow, and sometimes doesn't work at all, ++but when it works, it works with any web browser, even on Windows. ++The WeirdX interface tends to leave "mouse droppings" on interactive ++drawings. ++ ++There are numerous examples of these web interfaces at: ++ ++ http://www.cs.utexas.edu/users/novak/ ++ ++The Draw demo is a good one to try. ++ ++--------------------------------------------------------------------------- ++ ++Copyright (c) 2006 Gordon S. Novak Jr., Hiep Huu Nguyen, ++William F. Schelter, Camm Maguire, and The University of Texas at Austin. + + Copyright 1987 by Digital Equipment Corporation and Massachusetts Institute + of Technology. +@@ -10,8 +91,8 @@ See the files gnu.license and dec.copyri + + This program 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 1, or (at your option) +-any later version. ++the Free Software Foundation; either version 2 of the License, or ++(at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of +@@ -20,193 +101,19 @@ GNU General Public License for more deta + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software +-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ++ ++Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++See the file dec.copyright for details. + + Written by: Gordon S. Novak Jr., Hiep Huu Nguyen, and William F. Schelter, +-Department of Computer Sciences, University of Texas at Austin 78712. ++Department of Computer Sciences, University of Texas at Austin 78712, ++and Camm Maguire. + +-Xgcl contains an interface from Gnu Common Lisp to the X library, Xlib, ++Xgcl is an interface from Gnu Common Lisp to the X library, Xlib, + adapted from X Consortium code by Hiep Huu Nguyen (hiep@cs.utexas.edu). +-Xgcl has been tested on the HP9000, SUN4, and IBM RS/6000. +-It has been modified by W. Schelter to make on machines that do not +-support the faslink. In order to compile it you must have gcl sources. + + dwindow.lsp is an "easy to use" interface from Lisp to the Xlib, + written by Gordon S. Novak Jr. (novak@cs.utexas.edu) It is written in + GLISP and has been translated into the Common Lisp file dwtrans.lsp, +-which is incorporated into the make of Xgcl. Documentation is +-provided in the LaTeX file dwdoc.tex . Test files are dwtest.lsp, +-pcalc.lsp , and drawtrans.lsp . +- +- +-This software and GCL can be ftp'ed from: +- math.utexas.edu /pub/gcl/ +- cli.com 192.31.85.1 /pub/gcl/ +- +-The file is called xgcl-2.tgz . ftp it to your site and uncompress it: +- gzip -dc xgcl-2.tgz | tar xvf - +- +-The directory xgcl-2 will then contain the files: +- +-Events.c +-README +-X.lsp +-X10.lsp +-XAtom.lsp +-XStruct-2.c +-XStruct-4.c +-XStruct-l-3.lsp +-Xakcl.example.lsp +-Xakcl.paper +-Xinit.lsp +-Xlib.lsp +-Xstruct.lsp +-Xutil-2.c +-Xutil.lsp +-dec.copyright +-defentry-events.lsp +-dispatch-events.lsp +-draw-gates.lsp +-draw.lsp +-drawtrans.lsp +-dwdoc.tex +-dwimports.lsp +-dwindow.lsp +-dwsyms.lsp +-dwtest.lsp +-dwtrans.lsp +-general-c.c +-general.lsp +-gnu.license +-ice-cream.lsp +-imports.lsp +-init_xgcl.lsp +-keysymdef.lsp +-makefile +-menu-set.lsp +-pcalc.lsp +-sysdef.lisp +-sysinit.lsp +-version +- +- +-These files contain: +- +-c code necesary for some general facilities and interface into X, in the files: +- +-Events.c +-XStruct-4.c +-XStruct-2.c +-Xutil-2.c +-general-c.c +- +- +-The shell makefile that compiles and creates Xgcl is: +- +-makefile +- +- +-For reference the lisp interfaces to functions reside in: +- +-Xlib.lsp +-Xstruct.lsp +-general.lsp +-Xutil.lsp +-XStruct-l-3.lsp +-defentry-events.lsp +- +- +-Constant declarations are in: +- +-X.lsp +-XAtom.lsp +-keysymdef.lsp +-X10.lsp +- +- +-These files correspond to C header files for X windows: +- +-Xlib.lsp +-Xutil.lsp +-X.lsp +-XAtom.lsp +-keysymdef.lsp +-X10.lsp +- +-What little documentation there is: Xakcl.paper +-Also see Xakcl.example.lsp for some PRIMITIVE examples. +- +-The dwindow files are as follows: +- +-dwindow.lsp source code, written in GLISP ("documentation" of dwtrans.lsp) +-dwtrans.lsp dwindow.lsp translated to plain Common Lisp +-dwdoc.tex documentation in LaTeX +-dwtest.lsp examples of use of dwindow +-pcalc.lsp pocket calculator +-menu-set.lsp multiple active menus in a single window (GLISP) +-draw.lsp interactive drawing program (GLISP) +-draw-gates.lsp draw nand gates etc. +-drawtrans.lsp draw.lsp and menu-set.lsp translated to plain Common Lisp +-imports.lsp imports the window symbols into the :user package +-dwimports.lsp a shorter set of imports used by the dwindow package +-dwsyms.lsp imports symbols needed to run dwtrans from Lisp source +- +-To make Xgcl: +- +-1. Make GCL first. A running GCL is required to make Xgcl. +- +-2. Put the xgcl-2.tgz file in the gcl-1.1 directory. +- +-3. Uncompress it with: gzip -dc xgcl-2.tgz | tar xvf - +- +-4. cd xgcl-2 +- +-5. edit the makefile and change the variables GCLDIR and SYSDIR +- to point to the gcl-1.1 and xgcl-2 directories, respectively. +- If needed, edit the X library paths. +- +-6. make +- This makes an image saved_xgcl in the GCLDIR/unixport directory. +- It will also make a one-line command Xgcl that will execute it. +- +-7. You can try out the basic system as follows (where % is the Unix prompt): +- % Xgcl +- +- GCL (GNU Common Lisp) Version(1.1) Tue Sep 27 19:37:50 CDT 1994 +- Contains Enhancements by W. Schelter +- >(in-package "XLIB") +- +- XLIB>(Xinit) +- NIL +- +- XLIB>(open-window) +- 10485761 +- +- >(bye) +- Bye. +- +-As you can see, all that happened was that a simple window appeared. +-Read the paper Xakcl.paper for more details. +- +- +-To try the dwindow package, do the following (in xgcl-2 directory): +- +-% Xgcl +-(load "imports.lsp") ; import window symbols -- do this before anything else +-(load "dwtest.lsp") ; load the test functions +-(wtesta) ; make a window +-(wtestb) ; draw some stuff +-(wtestc) ; choose from menu, then click in window +-(wtestd) ; a menu with icons +-(wteste) ; a picture menu with sensitive points +-(wtesth) ; arrows +-(wtesti) ; arrows in color +-(wtestj) ; character input: type with cursor in the window +-(wtestk) ; character input in color +-(load "pcalc.lsp") +-(pcalc) ; pocket calculator +-(load "drawtrans.lsp") +-(load "ice-cream.lsp"); an existing drawing +-(draw 'ice-cream) ; examine / edit the drawing +-(draw 'foo) ; make a drawing named foo. +- ; when done, do Origin (to Zero), Program, LaTex ++which is incorporated into the make of Xgcl. +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_X.lsp +@@ -0,0 +1,689 @@ ++(in-package :XLIB) ++; X.lsp modified by Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++;; ++;; $XConsortium: X.h,v 1.66 88/09/06 15:55:56 jim Exp $ ++ ++ ++;; Definitions for the X window system likely to be used by applications ++ ++ ++;;********************************************************** ++;;Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts, ++;;and the Massachusetts Institute of Technology, Cambridge, Massachusetts. ++ ++;;modified by Hiep H Nguyen 28 Jul 91 ++ ++;; All Rights Reserved ++ ++;;Permission to use, copy, modify, and distribute this software and its ++;;documentation for any purpose and without fee is hereby granted, ++;;provided that the above copyright notice appear in all copies and that ++;;both that copyright notice and this permission notice appear in ++;;supporting documentation, and that the names of Digital or MIT not be ++;;used in advertising or publicity pertaining to distribution of the ++;;software without specific, written prior permission. ++ ++;;DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ++;;ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL ++;;DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ++;;ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, ++;;WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ++;;ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS ++;;SOFTWARE. ++ ++;;***************************************************************** ++(defconstant X_PROTOCOL 11 ) ;; current protocol version ++(defconstant X_PROTOCOL_REVISION 0 ) ;; current minor version ++ ++(defconstant True 1) ++(defconstant False 0) ++ ++;; Resources ++ ++;;typedef unsigned long XID) ; ++ ++;;typedef XID Window) ; ++;;typedef XID Drawable) ; ++;;typedef XID Font) ; ++;;typedef XID Pixmap) ; ++;;typedef XID Cursor) ; ++;;typedef XID Colormap) ; ++;;typedef XID GContext) ; ++;;typedef XID KeySym) ; ++ ++;;typedef unsigned long Mask) ; ++ ++;;typedef unsigned long Atom) ; ++ ++;;typedef unsigned long VisualID) ; ++ ++;;typedef unsigned long Time) ; ++ ++;;typedef unsigned char KeyCode) ; ++ ++;;**************************************************************** ++;; * RESERVED RESOURCE AND CONSTANT DEFINITIONS ++;; **************************************************************** ++ ++(defconstant None 0 ) ;; universal null resource or null atom ++ ++(defconstant ParentRelative 1 ) ;; background pixmap in CreateWindow ++ ;;and ChangeWindowAttributes ++ ++(defconstant CopyFromParent 0 ) ;; border pixmap in CreateWindow ++ ;;and ChangeWindowAttributes ++ ;;special VisualID and special window ++ ;; class passed to CreateWindow ++ ++(defconstant PointerWindow 0 ) ;; destination window in SendEvent ++(defconstant InputFocus 1 ) ;; destination window in SendEvent ++ ++(defconstant PointerRoot 1 ) ;; focus window in SetInputFocus ++ ++(defconstant AnyPropertyType 0 ) ;; special Atom, passed to GetProperty ++ ++(defconstant AnyKey 0 ) ;; special Key Code, passed to GrabKey ++ ++(defconstant AnyButton 0 ) ;; special Button Code, passed to GrabButton ++ ++(defconstant AllTemporary 0 ) ;; special Resource ID passed to KillClient ++ ++(defconstant CurrentTime 0 ) ;; special Time ++ ++(defconstant NoSymbol 0 ) ;; special KeySym ++ ++;;**************************************************************** ++;; * EVENT DEFINITIONS ++;; **************************************************************** ++ ++;; Input Event Masks. Used as event-mask window attribute and as arguments ++;; to Grab requests. Not to be confused with event names. ++ ++(defconstant NoEventMask 0) ++(defconstant KeyPressMask (expt 2 0) ) ++(defconstant KeyReleaseMask (expt 2 1) ) ++(defconstant ButtonPressMask (expt 2 2) ) ++(defconstant ButtonReleaseMask (expt 2 3) ) ++(defconstant EnterWindowMask (expt 2 4) ) ++(defconstant LeaveWindowMask (expt 2 5) ) ++(defconstant PointerMotionMask (expt 2 6) ) ++(defconstant PointerMotionHintMask (expt 2 7) ) ++(defconstant Button1MotionMask (expt 2 8) ) ++(defconstant Button2MotionMask (expt 2 9) ) ++(defconstant Button3MotionMask (expt 2 10) ) ++(defconstant Button4MotionMask (expt 2 11) ) ++(defconstant Button5MotionMask (expt 2 12) ) ++(defconstant ButtonMotionMask (expt 2 13) ) ++(defconstant KeymapStateMask (expt 2 14)) ++(defconstant ExposureMask (expt 2 15) ) ++(defconstant VisibilityChangeMask (expt 2 16) ) ++(defconstant StructureNotifyMask (expt 2 17) ) ++(defconstant ResizeRedirectMask (expt 2 18) ) ++(defconstant SubstructureNotifyMask (expt 2 19) ) ++(defconstant SubstructureRedirectMask (expt 2 20) ) ++(defconstant FocusChangeMask (expt 2 21) ) ++(defconstant PropertyChangeMask (expt 2 22) ) ++(defconstant ColormapChangeMask (expt 2 23) ) ++(defconstant OwnerGrabButtonMask (expt 2 24) ) ++ ++;; Event names. Used in "type" field in XEvent structures. Not to be ++;;confused with event masks above. They start from 2 because 0 and 1 ++;;are reserved in the protocol for errors and replies. ++ ++(defconstant KeyPress 2) ++(defconstant KeyRelease 3) ++(defconstant ButtonPress 4) ++(defconstant ButtonRelease 5) ++(defconstant MotionNotify 6) ++(defconstant EnterNotify 7) ++(defconstant LeaveNotify 8) ++(defconstant FocusIn 9) ++(defconstant FocusOut 10) ++(defconstant KeymapNotify 11) ++(defconstant Expose 12) ++(defconstant GraphicsExpose 13) ++(defconstant NoExpose 14) ++(defconstant VisibilityNotify 15) ++(defconstant CreateNotify 16) ++(defconstant DestroyNotify 17) ++(defconstant UnmapNotify 18) ++(defconstant MapNotify 19) ++(defconstant MapRequest 20) ++(defconstant ReparentNotify 21) ++(defconstant ConfigureNotify 22) ++(defconstant ConfigureRequest 23) ++(defconstant GravityNotify 24) ++(defconstant ResizeRequest 25) ++(defconstant CirculateNotify 26) ++(defconstant CirculateRequest 27) ++(defconstant PropertyNotify 28) ++(defconstant SelectionClear 29) ++(defconstant SelectionRequest 30) ++(defconstant SelectionNotify 31) ++(defconstant ColormapNotify 32) ++(defconstant ClientMessage 33) ++(defconstant MappingNotify 34) ++(defconstant LASTEvent 35 ) ;; must be bigger than any event # ++ ++ ++;; Key masks. Used as modifiers to GrabButton and GrabKey, results of QueryPointer, ++;; state in various key-, mouse-, and button-related events. ++ ++(defconstant ShiftMask (expt 2 0)) ++(defconstant LockMask (expt 2 1)) ++(defconstant ControlMask (expt 2 2)) ++(defconstant Mod1Mask (expt 2 3)) ++(defconstant Mod2Mask (expt 2 4)) ++(defconstant Mod3Mask (expt 2 5)) ++(defconstant Mod4Mask (expt 2 6)) ++(defconstant Mod5Mask (expt 2 7)) ++ ++;; modifier names. Used to build a SetModifierMapping request or ++;; to read a GetModifierMapping request. These correspond to the ++;; masks defined above. ++(defconstant ShiftMapIndex 0) ++(defconstant LockMapIndex 1) ++(defconstant ControlMapIndex 2) ++(defconstant Mod1MapIndex 3) ++(defconstant Mod2MapIndex 4) ++(defconstant Mod3MapIndex 5) ++(defconstant Mod4MapIndex 6) ++(defconstant Mod5MapIndex 7) ++ ++ ++;; button masks. Used in same manner as Key masks above. Not to be confused ++;; with button names below. ++ ++(defconstant Button1Mask (expt 2 8)) ++(defconstant Button2Mask (expt 2 9)) ++(defconstant Button3Mask (expt 2 10)) ++(defconstant Button4Mask (expt 2 11)) ++(defconstant Button5Mask (expt 2 12)) ++ ++(defconstant AnyModifier (expt 2 15) ) ;; used in GrabButton, GrabKey ++ ++ ++;; button names. Used as arguments to GrabButton and as detail in ButtonPress ++;; and ButtonRelease events. Not to be confused with button masks above. ++;; Note that 0 is already defined above as "AnyButton". ++ ++(defconstant Button1 1) ++(defconstant Button2 2) ++(defconstant Button3 3) ++(defconstant Button4 4) ++(defconstant Button5 5) ++ ++;; Notify modes ++ ++(defconstant NotifyNormal 0) ++(defconstant NotifyGrab 1) ++(defconstant NotifyUngrab 2) ++(defconstant NotifyWhileGrabbed 3) ++ ++(defconstant NotifyHint 1 ) ;; for MotionNotify events ++ ++;; Notify detail ++ ++(defconstant NotifyAncestor 0) ++(defconstant NotifyVirtual 1) ++(defconstant NotifyInferior 2) ++(defconstant NotifyNonlinear 3) ++(defconstant NotifyNonlinearVirtual 4) ++(defconstant NotifyPointer 5) ++(defconstant NotifyPointerRoot 6) ++(defconstant NotifyDetailNone 7) ++ ++;; Visibility notify ++ ++(defconstant VisibilityUnobscured 0) ++(defconstant VisibilityPartiallyObscured 1) ++(defconstant VisibilityFullyObscured 2) ++ ++;; Circulation request ++ ++(defconstant PlaceOnTop 0) ++(defconstant PlaceOnBottom 1) ++ ++;; protocol families ++ ++(defconstant FamilyInternet 0) ++(defconstant FamilyDECnet 1) ++(defconstant FamilyChaos 2) ++ ++;; Property notification ++ ++(defconstant PropertyNewValue 0) ++(defconstant PropertyDelete 1) ++ ++;; Color Map notification ++ ++(defconstant ColormapUninstalled 0) ++(defconstant ColormapInstalled 1) ++ ++;; GrabPointer, GrabButton, GrabKeyboard, GrabKey Modes ++ ++(defconstant GrabModeSync 0) ++(defconstant GrabModeAsync 1) ++ ++;; GrabPointer, GrabKeyboard reply status ++ ++(defconstant GrabSuccess 0) ++(defconstant AlreadyGrabbed 1) ++(defconstant GrabInvalidTime 2) ++(defconstant GrabNotViewable 3) ++(defconstant GrabFrozen 4) ++ ++;; AllowEvents modes ++ ++(defconstant AsyncPointer 0) ++(defconstant SyncPointer 1) ++(defconstant ReplayPointer 2) ++(defconstant AsyncKeyboard 3) ++(defconstant SyncKeyboard 4) ++(defconstant ReplayKeyboard 5) ++(defconstant AsyncBoth 6) ++(defconstant SyncBoth 7) ++ ++;; Used in SetInputFocus, GetInputFocus ++ ++(defconstant RevertToNone None) ++(defconstant RevertToPointerRoot PointerRoot) ++(defconstant RevertToParent 2) ++ ++;;**************************************************************** ++;; * ERROR CODES ++;; **************************************************************** ++ ++(defconstant Success 0 ) ;; everything's okay ++(defconstant BadRequest 1 ) ;; bad request code ++(defconstant BadValue 2 ) ;; int parameter out of range ++(defconstant BadWindow 3 ) ;; parameter not a Window ++(defconstant BadPixmap 4 ) ;; parameter not a Pixmap ++(defconstant BadAtom 5 ) ;; parameter not an Atom ++(defconstant BadCursor 6 ) ;; parameter not a Cursor ++(defconstant BadFont 7 ) ;; parameter not a Font ++(defconstant BadMatch 8 ) ;; parameter mismatch ++(defconstant BadDrawable 9 ) ;; parameter not a Pixmap or Window ++(defconstant BadAccess 10 ) ;; depending on context: ++ ;;- key/button already grabbed ++ ;;- attempt to free an illegal ++ ;; cmap entry ++ ;;- attempt to store into a read-only ++ ;; color map entry. ++ ;;- attempt to modify the access control ++ ;; list from other than the local host. ++ ++(defconstant BadAlloc 11 ) ;; insufficient resources ++(defconstant BadColor 12 ) ;; no such colormap ++(defconstant BadGC 13 ) ;; parameter not a GC ++(defconstant BadIDChoice 14 ) ;; choice not in range or already used ++(defconstant BadName 15 ) ;; font or color name doesn't exist ++(defconstant BadLength 16 ) ;; Request length incorrect ++(defconstant BadImplementation 17 ) ;; server is defective ++ ++(defconstant FirstExtensionError 128) ++(defconstant LastExtensionError 255) ++ ++;;**************************************************************** ++;; * WINDOW DEFINITIONS ++;; **************************************************************** ++ ++;; Window classes used by CreateWindow ++;; Note that CopyFromParent is already defined as 0 above ++ ++(defconstant InputOutput 1) ++(defconstant InputOnly 2) ++ ++;; Window attributes for CreateWindow and ChangeWindowAttributes ++ ++(defconstant CWBackPixmap (expt 2 0)) ++(defconstant CWBackPixel (expt 2 1)) ++(defconstant CWBorderPixmap (expt 2 2)) ++(defconstant CWBorderPixel (expt 2 3)) ++(defconstant CWBitGravity (expt 2 4)) ++(defconstant CWWinGravity (expt 2 5)) ++(defconstant CWBackingStore (expt 2 6)) ++(defconstant CWBackingPlanes (expt 2 7)) ++(defconstant CWBackingPixel (expt 2 8)) ++(defconstant CWOverrideRedirect (expt 2 9)) ++(defconstant CWSaveUnder (expt 2 10)) ++(defconstant CWEventMask (expt 2 11)) ++(defconstant CWDontPropagate (expt 2 12)) ++(defconstant CWColormap (expt 2 13)) ++(defconstant CWCursor (expt 2 14)) ++ ++;; ConfigureWindow structure ++ ++(defconstant CWX (expt 2 0)) ++(defconstant CWY (expt 2 1)) ++(defconstant CWWidth (expt 2 2)) ++(defconstant CWHeight (expt 2 3)) ++(defconstant CWBorderWidth (expt 2 4)) ++(defconstant CWSibling (expt 2 5)) ++(defconstant CWStackMode (expt 2 6)) ++ ++ ++;; Bit Gravity ++ ++(defconstant ForgetGravity 0) ++(defconstant NorthWestGravity 1) ++(defconstant NorthGravity 2) ++(defconstant NorthEastGravity 3) ++(defconstant WestGravity 4) ++(defconstant CenterGravity 5) ++(defconstant EastGravity 6) ++(defconstant SouthWestGravity 7) ++(defconstant SouthGravity 8) ++(defconstant SouthEastGravity 9) ++(defconstant StaticGravity 10) ++ ++;; Window gravity + bit gravity above ++ ++(defconstant UnmapGravity 0) ++ ++;; Used in CreateWindow for backing-store hint ++ ++(defconstant NotUseful 0) ++(defconstant WhenMapped 1) ++(defconstant Always 2) ++ ++;; Used in GetWindowAttributes reply ++ ++(defconstant IsUnmapped 0) ++(defconstant IsUnviewable 1) ++(defconstant IsViewable 2) ++ ++;; Used in ChangeSaveSet ++ ++(defconstant SetModeInsert 0) ++(defconstant SetModeDelete 1) ++ ++;; Used in ChangeCloseDownMode ++ ++(defconstant DestroyAll 0) ++(defconstant RetainPermanent 1) ++(defconstant RetainTemporary 2) ++ ++;; Window stacking method (in configureWindow) ++ ++(defconstant Above 0) ++(defconstant Below 1) ++(defconstant TopIf 2) ++(defconstant BottomIf 3) ++(defconstant Opposite 4) ++ ++;; Circulation direction ++ ++(defconstant RaiseLowest 0) ++(defconstant LowerHighest 1) ++ ++;; Property modes ++ ++(defconstant PropModeReplace 0) ++(defconstant PropModePrepend 1) ++(defconstant PropModeAppend 2) ++ ++;;**************************************************************** ++;; * GRAPHICS DEFINITIONS ++;; **************************************************************** ++ ++;; graphics functions, as in GC.alu ++ ++(defconstant GXclear 0 ) ;; 0 ++(defconstant GXand 1 ) ;; src AND dst ++(defconstant GXandReverse 2 ) ;; src AND NOT dst ++(defconstant GXcopy 3 ) ;; src ++(defconstant GXandInverted 4 ) ;; NOT src AND dst ++(defconstant GXnoop 5 ) ;; dst ++(defconstant GXxor 6 ) ;; src XOR dst ++(defconstant GXor 7 ) ;; src OR dst ++(defconstant GXnor 8 ) ;; NOT src AND NOT dst ++(defconstant GXequiv 9 ) ;; NOT src XOR dst ++(defconstant GXinvert 10 ) ;; NOT dst ++(defconstant GXorReverse 11 ) ;; src OR NOT dst ++(defconstant GXcopyInverted 12 ) ;; NOT src ++(defconstant GXorInverted 13 ) ;; NOT src OR dst ++(defconstant GXnand 14 ) ;; NOT src OR NOT dst ++(defconstant GXset 15 ) ;; 1 ++ ++;; LineStyle ++ ++(defconstant LineSolid 0) ++(defconstant LineOnOffDash 1) ++(defconstant LineDoubleDash 2) ++ ++;; capStyle ++ ++(defconstant CapNotLast 0) ++(defconstant CapButt 1) ++(defconstant CapRound 2) ++(defconstant CapProjecting 3) ++ ++;; joinStyle ++ ++(defconstant JoinMiter 0) ++(defconstant JoinRound 1) ++(defconstant JoinBevel 2) ++ ++;; fillStyle ++ ++(defconstant FillSolid 0) ++(defconstant FillTiled 1) ++(defconstant FillStippled 2) ++(defconstant FillOpaqueStippled 3) ++ ++;; fillRule ++ ++(defconstant EvenOddRule 0) ++(defconstant WindingRule 1) ++ ++;; subwindow mode ++ ++(defconstant ClipByChildren 0) ++(defconstant IncludeInferiors 1) ++ ++;; SetClipRectangles ordering ++ ++(defconstant Unsorted 0) ++(defconstant YSorted 1) ++(defconstant YXSorted 2) ++(defconstant YXBanded 3) ++ ++;; CoordinateMode for drawing routines ++ ++(defconstant CoordModeOrigin 0 ) ;; relative to the origin ++(defconstant CoordModePrevious 1 ) ;; relative to previous point ++ ++;; Polygon shapes ++ ++;(defconstant Complex 0 ) ;; paths may intersect ++(defconstant Nonconvex 1 ) ;; no paths intersect, but not convex ++(defconstant Convex 2 ) ;; wholly convex ++ ++;; Arc modes for PolyFillArc ++ ++(defconstant ArcChord 0 ) ;; join endpoints of arc ++(defconstant ArcPieSlice 1 ) ;; join endpoints to center of arc ++ ++;; GC components: masks used in CreateGC, CopyGC, ChangeGC, OR'ed into ++;; GC.stateChanges ++ ++(defconstant GCFunction (expt 2 0)) ++(defconstant GCPlaneMask (expt 2 1)) ++(defconstant GCForeground (expt 2 2)) ++(defconstant GCBackground (expt 2 3)) ++(defconstant GCLineWidth (expt 2 4)) ++(defconstant GCLineStyle (expt 2 5)) ++(defconstant GCCapStyle (expt 2 6)) ++(defconstant GCJoinStyle (expt 2 7)) ++(defconstant GCFillStyle (expt 2 8)) ++(defconstant GCFillRule (expt 2 9) ) ++(defconstant GCTile (expt 2 10)) ++(defconstant GCStipple (expt 2 11)) ++(defconstant GCTileStipXOrigin (expt 2 12)) ++(defconstant GCTileStipYOrigin (expt 2 13)) ++(defconstant GCFont (expt 2 14)) ++(defconstant GCSubwindowMode (expt 2 15)) ++(defconstant GCGraphicsExposures (expt 2 16)) ++(defconstant GCClipXOrigin (expt 2 17)) ++(defconstant GCClipYOrigin (expt 2 18)) ++(defconstant GCClipMask (expt 2 19)) ++(defconstant GCDashOffset (expt 2 20)) ++(defconstant GCDashList (expt 2 21)) ++(defconstant GCArcMode (expt 2 22)) ++ ++(defconstant GCLastBit 22) ++;;**************************************************************** ++;; * FONTS ++;; **************************************************************** ++ ++;; used in QueryFont -- draw direction ++ ++(defconstant FontLeftToRight 0) ++(defconstant FontRightToLeft 1) ++ ++(defconstant FontChange 255) ++ ++;;**************************************************************** ++;; * IMAGING ++;; **************************************************************** ++ ++;; ImageFormat -- PutImage, GetImage ++ ++(defconstant XYBitmap 0 ) ;; depth 1, XYFormat ++(defconstant XYPixmap 1 ) ;; depth == drawable depth ++(defconstant ZPixmap 2 ) ;; depth == drawable depth ++ ++;;**************************************************************** ++;; * COLOR MAP STUFF ++;; **************************************************************** ++ ++;; For CreateColormap ++ ++(defconstant AllocNone 0 ) ;; create map with no entries ++(defconstant AllocAll 1 ) ;; allocate entire map writeable ++ ++ ++;; Flags used in StoreNamedColor, StoreColors ++ ++(defconstant DoRed (expt 2 0)) ++(defconstant DoGreen (expt 2 1)) ++(defconstant DoBlue (expt 2 2)) ++ ++;;**************************************************************** ++;; * CURSOR STUFF ++;; **************************************************************** ++ ++;; QueryBestSize Class ++ ++(defconstant CursorShape 0 ) ;; largest size that can be displayed ++(defconstant TileShape 1 ) ;; size tiled fastest ++(defconstant StippleShape 2 ) ;; size stippled fastest ++ ++;;**************************************************************** ++;; * KEYBOARD/POINTER STUFF ++;; **************************************************************** ++ ++(defconstant AutoRepeatModeOff 0) ++(defconstant AutoRepeatModeOn 1) ++(defconstant AutoRepeatModeDefault 2) ++ ++(defconstant LedModeOff 0) ++(defconstant LedModeOn 1) ++ ++;; masks for ChangeKeyboardControl ++ ++(defconstant KBKeyClickPercent (expt 2 0)) ++(defconstant KBBellPercent (expt 2 1)) ++(defconstant KBBellPitch (expt 2 2)) ++(defconstant KBBellDuration (expt 2 3)) ++(defconstant KBLed (expt 2 4)) ++(defconstant KBLedMode (expt 2 5)) ++(defconstant KBKey (expt 2 6)) ++(defconstant KBAutoRepeatMode (expt 2 7)) ++ ++(defconstant MappingSuccess 0) ++(defconstant MappingBusy 1) ++(defconstant MappingFailed 2) ++ ++(defconstant MappingModifier 0) ++(defconstant MappingKeyboard 1) ++(defconstant MappingPointer 2) ++ ++;;**************************************************************** ++;; * SCREEN SAVER STUFF ++;; **************************************************************** ++ ++(defconstant DontPreferBlanking 0) ++(defconstant PreferBlanking 1) ++(defconstant DefaultBlanking 2) ++ ++(defconstant DisableScreenSaver 0) ++(defconstant DisableScreenInterval 0) ++ ++(defconstant DontAllowExposures 0) ++(defconstant AllowExposures 1) ++(defconstant DefaultExposures 2) ++ ++;; for ForceScreenSaver ++ ++(defconstant ScreenSaverReset 0) ++(defconstant ScreenSaverActive 1) ++ ++;;**************************************************************** ++;; * HOSTS AND CONNECTIONS ++;; **************************************************************** ++ ++;; for ChangeHosts ++ ++(defconstant HostInsert 0) ++(defconstant HostDelete 1) ++ ++;; for ChangeAccessControl ++ ++(defconstant EnableAccess 1 ) ++(defconstant DisableAccess 0) ++ ++;; Display classes used in opening the connection ++;; * Note that the statically allocated ones are even numbered and the ++;; * dynamically changeable ones are odd numbered ++ ++(defconstant StaticGray 0) ++(defconstant GrayScale 1) ++(defconstant StaticColor 2) ++(defconstant PseudoColor 3) ++(defconstant TrueColor 4) ++(defconstant DirectColor 5) ++ ++ ++;; Byte order used in imageByteOrder and bitmapBitOrder ++ ++(defconstant LSBFirst 0) ++(defconstant MSBFirst 1) ++ ++ ++;(defconstant NULL 0) ++ ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_Xutil.lsp +@@ -0,0 +1,797 @@ ++(in-package :XLIB) ++; Xutil.lsp modified by Hiep Huu Nguyen 27 Aug 92 ++ ++; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++;; $XConsortium: Xutil.h,v 11.58 89/12/12 20:15:40 jim Exp $ */ ++ ++;;********************************************************** ++;;Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts, ++;;and the Massachusetts Institute of Technology, Cambridge, Massachusetts. ++ ++;;modified by Hiep H Nguyen 28 Jul 91 ++ ++;; All Rights Reserved ++ ++;;Permission to use, copy, modify, and distribute this software and its ++;;documentation for any purpose and without fee is hereby granted, ++;;provided that the above copyright notice appear in all copies and that ++;;both that copyright notice and this permission notice appear in ++;;supporting documentation, and that the names of Digital or MIT not be ++;;used in advertising or publicity pertaining to distribution of the ++;;software without specific, written prior permission. ++ ++;;DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ++;;ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL ++;;DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ++;;ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, ++;;WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ++;;ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS ++;;SOFTWARE. ++ ++;;***************************************************************** ++ ++;; ++;; * Bitmask returned by XParseGeometry(). Each bit tells if the corresponding) ++;; * value (x, y, width, height) was found in the parsed string.) ++ ++(defconstant NoValue 0000) ++(defconstant XValue 0001) ++(defconstant YValue 0002) ++(defconstant WidthValue 0004) ++(defconstant HeightValue 0008) ++(defconstant AllValues 15) ++(defconstant XNegative 16) ++(defconstant YNegative 32) ++ ++;; ++ ;; The next block of definitions are for window manager properties that ++ ;; clients and applications use for communication. ++ ++ ++;; flags argument in size hints ++(defconstant USPosition (expt 2 0) ) ;; user specified x, y ++(defconstant USSize (expt 2 1) ) ;; user specified width, height ++ ++(defconstant PPosition (expt 2 2) ) ;; program specified position ++(defconstant PSize (expt 2 3) ) ;; program specified size ++(defconstant PMinSize (expt 2 4) ) ;; program specified minimum size ++(defconstant PMaxSize (expt 2 5) ) ;; program specified maximum size ++(defconstant PResizeInc (expt 2 6) ) ;; program specified resize increments ++(defconstant PAspect (expt 2 7) ) ;; program specified min and max aspect ratios ++(defconstant PBaseSize (expt 2 8) ) ;; program specified base for incrementing ++(defconstant PWinGravity (expt 2 9) ) ;; program specified window gravity ++ ++;; obsolete ++(defconstant PAllHints (+ PPosition PSize PMinSize PMaxSize PResizeInc PAspect)) ++ ++;; definition for flags of XWMHints ++ ++(defconstant InputHint (expt 2 0)) ++(defconstant StateHint (expt 2 1)) ++(defconstant IconPixmapHint (expt 2 2)) ++(defconstant IconWindowHint (expt 2 3)) ++(defconstant IconPositionHint (expt 2 4)) ++(defconstant IconMaskHint (expt 2 5)) ++(defconstant WindowGroupHint (expt 2 6)) ++(defconstant AllHints ( + InputHint StateHint IconPixmapHint IconWindowHint ++IconPositionHint IconMaskHint WindowGroupHint)) ++ ++;; definitions for initial window state ++(defconstant WithdrawnState 0 ) ;; for windows that are not mapped ++(defconstant NormalState 1 ) ;; most applications want to start this way ++(defconstant IconicState 3 ) ;; application wants to start as an icon ++ ++;; ++ ;; Obsolete states no longer defined by ICCCM ++ ++(defconstant DontCareState 0 ) ;; don't know or care ++(defconstant ZoomState 2 ) ;; application wants to start zoomed ++(defconstant InactiveState 4 ) ;; application believes it is seldom used; ++ ;; some wm's may put it on inactive menu ++ ++ ++ ++;; ++ ;; opaque reference to Region data type ++ ++;;typedef struct _XRegion *Region; ++ ++;; Return values from XRectInRegion() ++ ++(defconstant RectangleOut 0) ++(defconstant RectangleIn 1) ++(defconstant RectanglePart 2) ++ ++ ++(defconstant VisualNoMask 0) ++(defconstant VisualIDMask 1) ++(defconstant VisualScreenMask 2) ++(defconstant VisualDepthMask 4) ++(defconstant VisualClassMask 8) ++(defconstant VisualRedMaskMask 16) ++(defconstant VisualGreenMaskMask 32) ++(defconstant VisualBlueMaskMask 64) ++(defconstant VisualColormapSizeMask 128) ++(defconstant VisualBitsPerRGBMask 256) ++(defconstant VisualAllMask 511) ++ ++(defconstant ReleaseByFreeingColormap 1) ;; for killid field above ++ ++ ++;; ++;; return codes for XReadBitmapFile and XWriteBitmapFile ++ ++(defconstant BitmapSuccess 0) ++(defconstant BitmapOpenFailed 1) ++(defconstant BitmapFileInvalid 2) ++(defconstant BitmapNoMemory 3) ++;; ++ ;; Declare the routines that don't return int. ++ ++ ++;; *************************************************************** ++;; * ++;; * Context Management ++;; * ++;; *************************************************************** ++ ++ ++;; Associative lookup table return codes ++ ++(defconstant XCSUCCESS 0 ) ;; No error. ++(defconstant XCNOMEM 1 ) ;; Out of memory ++(defconstant XCNOENT 2 ) ;; No entry in table ++ ++;;typedef fixnum XContext; ++ ++(defentry XSaveContext( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; context ++ fixnum ;; data ++ ++)( fixnum "XSaveContext")) ++ ++ ++ ++(defentry XFindContext( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; context ++ fixnum ;; data_return ++ ++)( fixnum "XFindContext")) ++ ++ ++ ++(defentry XDeleteContext( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; context ++ ++)( fixnum "XDeleteContext")) ++ ++ ++ ++ ++(defentry XGetWMHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ ++)( fixnum "XGetWMHints")) ++ ++ ++(defentry XCreateRegion( ++ ++;; void ++ ++)( fixnum "XCreateRegion")) ++ ++ ++(defentry XPolygonRegion( ++ ++ fixnum ;; points ++ fixnum ;; n ++ fixnum ;; fill_rule ++ ++)( fixnum "XPolygonRegion")) ++ ++ ++ ++(defentry XGetVisualInfo( ++ ++ fixnum ;; display ++ fixnum ;; vinfo_mask ++ fixnum ;; vinfo_template ++ fixnum ;; nitems_return ++ ++)( fixnum "XGetVisualInfo")) ++ ++;; Allocation routines for properties that may get longer ++ ++ ++(defentry XAllocSizeHints ( ++ ++;; void ++ ++)( fixnum "XAllocSizeHints" )) ++ ++ ++(defentry XAllocStandardColormap ( ++ ++;; void ++ ++)( fixnum "XAllocStandardColormap" )) ++ ++ ++(defentry XAllocWMHints ( ++ ++;; void ++ ++)( fixnum "XAllocWMHints" )) ++ ++ ++(defentry XAllocClassHint ( ++ ++;; void ++ ++)( fixnum "XAllocClassHint" )) ++ ++ ++(defentry XAllocIconSize ( ++ ++;; void ++ ++)( fixnum "XAllocIconSize" )) ++ ++;; ICCCM routines for data structures defined in this file ++ ++ ++(defentry XGetWMSizeHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints_return ++ fixnum ;; supplied_return ++ fixnum ;; property ++ ++)( fixnum "XGetWMSizeHints")) ++ ++ ++(defentry XGetWMNormalHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints_return ++ fixnum ;; supplied_return ++ ++)( fixnum "XGetWMNormalHints")) ++ ++ ++(defentry XGetRGBColormaps( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; stdcmap_return ++ fixnum ;; count_return ++ fixnum ;; property ++ ++)( fixnum "XGetRGBColormaps")) ++ ++ ++(defentry XGetTextProperty( ++ ++ fixnum ;; display ++ fixnum ;; window ++ fixnum ;; text_prop_return ++ fixnum ;; property ++ ++)( fixnum "XGetTextProperty")) ++ ++ ++(defentry XGetWMName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; text_prop_return ++ ++)( fixnum "XGetWMName")) ++ ++ ++(defentry XGetWMIconName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; text_prop_return ++ ++)( fixnum "XGetWMIconName")) ++ ++ ++(defentry XGetWMClientMachine( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; text_prop_return ++ ++)( fixnum "XGetWMClientMachine")) ++ ++ ++(defentry XSetWMProperties( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; window_name ++ fixnum ;; icon_name ++ fixnum ;; argv ++ fixnum ;; argc ++ fixnum ;; normal_hints ++ fixnum ;; wm_hints ++ fixnum ;; class_hints ++ ++)( void "XSetWMProperties")) ++ ++ ++(defentry XSetWMSizeHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints ++ fixnum ;; property ++ ++)( void "XSetWMSizeHints")) ++ ++ ++(defentry XSetWMNormalHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints ++ ++)( void "XSetWMNormalHints")) ++ ++ ++(defentry XSetRGBColormaps( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; stdcmaps ++ fixnum ;; count ++ fixnum ;; property ++ ++)( void "XSetRGBColormaps")) ++ ++ ++(defentry XSetTextProperty( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; text_prop ++ fixnum ;; property ++ ++)( void "XSetTextProperty")) ++ ++ ++(defentry XSetWMName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; text_prop ++ ++)( void "XSetWMName")) ++ ++ ++(defentry XSetWMIconName( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; text_prop ++ ++)( void "XSetWMIconName")) ++ ++ ++(defentry XSetWMClientMachine( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; text_prop ++ ++)( void "XSetWMClientMachine")) ++ ++ ++(defentry XStringListToTextProperty( ++ ++ fixnum ;; list ++ fixnum ;; count ++ fixnum ;; text_prop_return ++ ++)( fixnum "XStringListToTextProperty")) ++ ++ ++(defentry XTextPropertyToStringList( ++ ++ fixnum ;; text_prop ++ fixnum ;; list_return ++ fixnum ;; count_return ++ ++)( fixnum "XTextPropertyToStringList")) ++ ++;; The following declarations are alphabetized. ++ ++ ++ ++(defentry XClipBox( ++ ++ fixnum ;; r ++ fixnum ;; rect_return ++ ++)( void "XClipBox")) ++ ++ ++ ++(defentry XDestroyRegion( ++ ++ fixnum ;; r ++ ++)( void "XDestroyRegion")) ++ ++ ++ ++(defentry XEmptyRegion( ++ ++ fixnum ;; r ++ ++)( void "XEmptyRegion")) ++ ++ ++ ++(defentry XEqualRegion( ++ ++ fixnum ;; r1 ++ fixnum ;; r2 ++ ++)( void "XEqualRegion")) ++ ++ ++ ++(defentry XGetClassHint( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; class_hints_return ++ ++)( fixnum "XGetClassHint")) ++ ++ ++ ++(defentry XGetIconSizes( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; size_list_return ++ fixnum ;; count_return ++ ++)( fixnum "XGetIconSizes")) ++ ++ ++ ++(defentry XGetNormalHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints_return ++ ++)( fixnum "XGetNormalHints")) ++ ++ ++ ++(defentry XGetSizeHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints_return ++ fixnum ;; property ++ ++)( fixnum "XGetSizeHints")) ++ ++ ++ ++(defentry XGetStandardColormap( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; colormap_return ++ fixnum ;; property ++ ++)( fixnum "XGetStandardColormap")) ++ ++ ++ ++(defentry XGetZoomHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; zhints_return ++ ++)( fixnum "XGetZoomHints")) ++ ++ ++ ++(defentry XIntersectRegion( ++ ++ fixnum ;; sra ++ fixnum ;; srb ++ fixnum ;; dr_return ++ ++)( void "XIntersectRegion")) ++ ++ ++ ++(defentry XLookupString( ++ ++ fixnum ;; event_struct ++ object ;; buffer_return ++ fixnum ;; bytes_buffer ++ fixnum ;; keysym_return ++ fixnum ;; int_in_out ++ ++)( fixnum "XLookupString")) ++ ++ ++ ++(defentry XMatchVisualInfo( ++ ++ fixnum ;; display ++ fixnum ;; screen ++ fixnum ;; depth ++ fixnum ;; class ++ fixnum ;; vinfo_return ++ ++)( fixnum "XMatchVisualInfo")) ++ ++ ++ ++(defentry XOffsetRegion( ++ ++ fixnum ;; r ++ fixnum ;; dx ++ fixnum ;; dy ++ ++)( void "XOffsetRegion")) ++ ++ ++ ++(defentry XPointInRegion( ++ ++ fixnum ;; r ++ fixnum ;; x ++ fixnum ;; y ++ ++)( fixnum "XPointInRegion")) ++ ++ ++ ++(defentry XRectInRegion( ++ ++ fixnum ;; r ++ fixnum ;; x ++ fixnum ;; y ++ fixnum ;; width ++ fixnum ;; height ++ ++)( fixnum "XRectInRegion")) ++ ++ ++ ++(defentry XSetClassHint( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; class_hints ++ ++)( void "XSetClassHint")) ++ ++ ++ ++(defentry XSetIconSizes( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; size_list ++ fixnum ;; count ++ ++)( void "XSetIconSizes")) ++ ++ ++ ++(defentry XSetNormalHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints ++ ++)( void "XSetNormalHints")) ++ ++ ++ ++(defentry XSetSizeHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; hints ++ fixnum ;; property ++ ++)( void "XSetSizeHints")) ++ ++ ++ ++(defentry XSetStandardProperties( ++ ++ fixnum ;; display ++ fixnum ;; w ++ object ;; window_name ++ object ;; icon_name ++ fixnum ;; icon_pixmap ++ fixnum ;; argv ++ fixnum ;; argc ++ fixnum ;; hints ++ ++)( void "XSetStandardProperties")) ++ ++ ++ ++(defentry XSetWMHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; wm_hints ++ ++)( void "XSetWMHints")) ++ ++ ++ ++(defentry XSetRegion( ++ ++ fixnum ;; display ++ fixnum ;; gc ++ fixnum ;; r ++ ++)( void "XSetRegion")) ++ ++ ++ ++(defentry XSetStandardColormap( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; colormap ++ fixnum ;; property ++ ++)( void "XSetStandardColormap")) ++ ++ ++ ++(defentry XSetZoomHints( ++ ++ fixnum ;; display ++ fixnum ;; w ++ fixnum ;; zhints ++ ++)( void "XSetZoomHints")) ++ ++ ++ ++(defentry XShrinkRegion( ++ ++ fixnum ;; r ++ fixnum ;; dx ++ fixnum ;; dy ++ ++)( void "XShrinkRegion")) ++ ++ ++ ++(defentry XSubtractRegion( ++ ++ fixnum ;; sra ++ fixnum ;; srb ++ fixnum ;; dr_return ++ ++)( void "XSubtractRegion")) ++ ++ ++ ++(defentry XUnionRectWithRegion( ++ ++ fixnum ;; rectangle ++ fixnum ;; src_region ++ fixnum ;; dest_region_return ++ ++)( void "XUnionRectWithRegion")) ++ ++ ++ ++(defentry XUnionRegion( ++ ++ fixnum ;; sra ++ fixnum ;; srb ++ fixnum ;; dr_return ++ ++)( void "XUnionRegion")) ++ ++ ++ ++(defentry XWMGeometry( ++ ++ fixnum ;; display ++ fixnum ;; screen_number ++ object ;; user_geometry ++ object ;; default_geometry ++ fixnum ;; border_width ++ fixnum ;; hints ++ fixnum ;; x_return ++ fixnum ;; y_return ++ fixnum ;; width_return ++ fixnum ;; height_return ++ fixnum ;; gravity_return ++ ++)( fixnum "XWMGeometry")) ++ ++ ++ ++(defentry XXorRegion( ++ ++ fixnum ;; sra ++ fixnum ;; srb ++ fixnum ;; dr_return ++ ++)( void "XXorRegion")) ++;; ++ ;; These macros are used to give some sugar to the image routines so that ++ ;; naive people are more comfortable with them. ++ ++(defentry XDestroyImage(fixnum) (fixnum "XDestroyImage")) ++(defentry XGetPixel(fixnum fixnum fixnum) (fixnum "XGetPixel" )) ++(defentry XPutPixel(fixnum fixnum int fixnum) ( fixnum "XPutPixel")) ++(defentry XSubImage(fixnum fixnum int fixnum fixnum) (fixnum "XSubImage")) ++(defentry XAddPixel(fixnum fixnum) (fixnum "XAddPixel")) ++;; ++ ;; Keysym macros, used on Keysyms to test for classes of symbols ++ ++(defentry IsKeypadKey(fixnum) (fixnum "IsKeypadKey")) ++ ++(defentry IsCursorKey(fixnum) (fixnum "IsCursorKey")) ++ ++(defentry IsPFKey(fixnum) (fixnum "IsPFKey")) ++ ++(defentry IsFunctionKey(fixnum) (fixnum "IsFunctionKey")) ++ ++(defentry IsMiscFunctionKey(fixnum) (fixnum "IsMiscFunctionKey")) ++ ++(defentry IsModifierKey(fixnum) (fixnum "IsModifierKey")) ++(defentry XUniqueContext() (fixnum "XUniqueContext")) ++(defentry XStringToContext(object) (fixnum "XStringToContext")) ++ +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_drawtrans.lsp +@@ -0,0 +1,1890 @@ ++; 07 Jan 2010 16:40:19 EST ++; drawtrans.lsp -- translation of draw.lsp Gordon S. Novak Jr. ++ ++; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. ++ ++; This program 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 program 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 program; if not, write to the Free Software ++; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ++ ++; Written by: Gordon S. Novak Jr., Department of Computer Sciences, ++; University of Texas at Austin 78712. novak@cs.utexas.edu ++ ++(IN-PACKAGE :USER) ++ ++(defmacro while (test &rest forms) `(loop (unless ,test (return)) ,@forms) ) ++ ++(defmacro nconc1 (lst x) `(nconc ,lst (cons ,x nil))) ++ ++(defmacro glmethod (class selector) ++ `(cadr (assoc ,selector (getf (cdr (get ,class 'glstructure)) 'msg))) ) ++ ++(SETF (GET 'MENU-SET 'GLSTRUCTURE) ++ '((LISTOBJECT (WINDOW WINDOW) (MENU-ITEMS (LISTOF MENU-SET-ITEM)) ++ (COMMANDFN ANYTHING)) ++ MSG ++ ((DRAW MENU-SET-DRAW) (SELECT MENU-SET-SELECT) ++ (NAMED-MENU MENU-SET-NAMED-MENU) ++ (NAMED-ITEM MENU-SET-NAMED-ITEM) (ADD-MENU MENU-SET-ADD-MENU) ++ (ADD-PICMENU MENU-SET-ADD-PICMENU) ++ (ADD-COMPONENT MENU-SET-ADD-COMPONENT) ++ (ADD-BARMENU MENU-SET-ADD-BARMENU) ++ (ADD-ITEM MENU-SET-ADD-ITEM) (FIND-ITEM MENU-SET-FIND-ITEM) ++ (DELETE-ITEM MENU-SET-DELETE-ITEM) ++ (REMOVE-ITEMS MENU-SET-REMOVE-ITEMS) ++ (ITEM-POSITION MENU-SET-ITEM-POSITION) (ITEMP MENU-SET-ITEMP) ++ (ADJUST MENU-SET-ADJUST) (MOVE MENU-SET-MOVE) ++ (DRAW-CONN MENU-SET-DRAW-CONN)))) ++(SETF (GET 'MENU-SET-ITEM 'GLSTRUCTURE) ++ '((LIST (MENU-NAME SYMBOL) (SYM ANYTHING) (MENU MENU-SET-MENU)) ++ PROP ++ ((LEFT ((PARENT-OFFSET-X MENU))) ++ (BOTTOM ((PARENT-OFFSET-Y MENU))) ++ (WIDTH ((PICTURE-WIDTH MENU))) ++ (HEIGHT ((PICTURE-HEIGHT MENU)))) ++ SUPERS (REGION))) ++(SETF (GET 'MENU-SET-MENU 'GLSTRUCTURE) ++ '((TRANSPARENT MENU) MSG ((DRAW MENU-MDRAW)))) ++(SETF (GET 'MENU-PORT 'GLSTRUCTURE) ++ '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL)))) ++(SETF (GET 'MENU-SELECTION 'GLSTRUCTURE) ++ '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL) (BUTTON INTEGER)))) ++(SETF (GET 'MENU-SET-CONN 'GLSTRUCTURE) ++ '((LIST (FROM MENU-PORT) (TO MENU-PORT)))) ++(SETF (GET 'MENU-CONNS 'GLSTRUCTURE) ++ '((LISTOBJECT (MENU-SET MENU-SET) ++ (CONNECTIONS (LISTOF MENU-SET-CONN))) ++ PROP ((WINDOW ((WINDOW (MENU-SET SELF))))) MSG ++ ((DRAW MENU-CONNS-DRAW) (REDRAW MENU-CONNS-REDRAW) ++ (MOVE MENU-CONNS-MOVE) (ADD-CONN MENU-CONNS-ADD-CONN) ++ (ADD-ITEM MENU-CONNS-ADD-ITEM OPEN T) ++ (FIND-CONN MENU-CONNS-FIND-CONN) ++ (FIND-ITEM MENU-CONNS-FIND-ITEM) ++ (DELETE-ITEM MENU-CONNS-DELETE-ITEM) ++ (DELETE-CONN MENU-CONNS-DELETE-CONN) ++ (REMOVE-ITEMS MENU-CONNS-REMOVE-ITEMS) ++ (FIND-CONNS MENU-CONNS-FIND-CONNS) ++ (CONNECTED-PORTS MENU-CONNS-CONNECTED-PORTS) ++ (NEW-CONN MENU-CONNS-NEW-CONN) ++ (NAMED-MENU MENU-CONNS-NAMED-MENU) ++ (NAMED-ITEM MENU-CONNS-NAMED-ITEM)))) ++ ++ ++(DEFUN MENU-SET-CREATE (W &OPTIONAL FN) (LIST 'MENU-SET W NIL FN)) ++(SETF (GET 'MENU-SET-CREATE 'GLARGUMENTS) ++ '((W WINDOW) (&OPTIONAL NIL))) ++(SETF (GET 'MENU-SET-CREATE 'GLFNRESULTTYPE) 'MENU-SET) ++ ++ ++(DEFUN MENU-SET-SELECT (MS &OPTIONAL REDRAW ENABLED) ++ (LET (RES RESB ITM SEL LASTX LASTY) ++ (IF REDRAW (MENU-SET-DRAW MS)) ++ (WHILE (NOT (OR RES RESB)) ++ (SETQ ITM ++ (WINDOW-TRACK-MOUSE (CADR MS) ++ #'(LAMBDA (X Y CODE) ++ (OR (AND (PLUSP CODE) (SETQ LASTX X) ++ (SETQ LASTY Y) CODE) ++ (SOME #'(LAMBDA (GLVAR128) ++ (IF ++ (AND ++ (BETWEEN X ++ (FIFTH (CADDR GLVAR128)) ++ (+ (FIFTH (CADDR GLVAR128)) ++ (SEVENTH (CADDR GLVAR128)))) ++ (BETWEEN Y ++ (SIXTH (CADDR GLVAR128)) ++ (+ (SIXTH (CADDR GLVAR128)) ++ (EIGHTH (CADDR GLVAR128))))) ++ GLVAR128)) ++ (CADDR MS)))))) ++ (IF (NUMBERP ITM) ++ (SETQ RESB (LIST (LIST LASTX LASTY) 'BACKGROUND ITM)) ++ (WHEN (OR (ATOM ENABLED) (MEMBER (CAR ITM) ENABLED)) ++ (SETQ SEL (MENU-MSELECT (CADDR ITM) (EQ ENABLED T))) ++ (IF SEL ++ (SETQ RES (LIST SEL (CAR ITM) *WINDOW-MENU-CODE*)) ++ (IF (AND *WINDOW-MENU-CODE* ++ (NOT (ZEROP *WINDOW-MENU-CODE*))) ++ (SETQ RES ++ (LIST NIL (CAR ITM) *WINDOW-MENU-CODE*))))))) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (OR RES RESB))) ++(SETF (GET 'MENU-SET-SELECT 'GLARGUMENTS) ++ '((MS MENU-SET) (&OPTIONAL BOOLEAN) (REDRAW (LISTOF SYMBOL)))) ++(SETF (GET 'MENU-SET-SELECT 'GLFNRESULTTYPE) 'MENU-SELECTION) ++ ++ ++(DEFUN MENU-SET-ADD-MENU (MS NAME SYM TITLE ITEMS &OPTIONAL OFFSET) ++ (LET (MENU) ++ (SETQ MENU ++ (MENU-CREATE ITEMS TITLE (CADR MS) (CAR OFFSET) (CADR OFFSET) ++ T T)) ++ (MENU-INIT MENU) ++ (IF (NOT OFFSET) ++ (SETQ OFFSET ++ (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) ++ (EIGHTH MENU)))) ++ (SETF (FIFTH MENU) (CAR OFFSET)) ++ (SETF (SIXTH MENU) (CADR OFFSET)) ++ (MENU-SET-ADD-ITEM MS NAME SYM MENU))) ++(SETF (GET 'MENU-SET-ADD-MENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) ++ (ITEMS NIL) (&OPTIONAL VECTOR))) ++(SETF (GET 'MENU-SET-ADD-MENU 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-ITEM (MS NAME SYM MENU) ++ (SETF (CADDR MS) (NCONC (CADDR MS) (CONS (LIST NAME SYM MENU) NIL)))) ++(SETF (GET 'MENU-SET-ADD-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) ++(SETF (GET 'MENU-SET-ADD-ITEM 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-REMOVE-ITEMS (MS) (SETF (CADDR MS) NIL)) ++(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLARGUMENTS) '((MS MENU-SET))) ++(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-PICMENU ++ (MS NAME SYM TITLE SPEC &OPTIONAL OFFSET NOBOX) ++ (LET (MENU MAXWIDTH MAXHEIGHT) ++ (IF (AND SPEC (SYMBOLP SPEC)) (SETQ SPEC (GET SPEC 'PICMENU-SPEC))) ++ (SETQ MENU ++ (PICMENU-CREATE-FROM-SPEC SPEC TITLE (CADR MS) (CAR OFFSET) ++ (CADR OFFSET) T T (NOT NOBOX))) ++ (SETQ MAXWIDTH ++ (MAX (IF TITLE (+ 6 (* 9 (LENGTH TITLE))) 0) (CADR SPEC))) ++ (SETQ MAXHEIGHT (+ (IF TITLE 15 0) (CADDR SPEC))) ++ (IF (NOT OFFSET) ++ (SETQ OFFSET ++ (WINDOW-GET-BOX-POSITION (CADR MS) MAXWIDTH MAXHEIGHT))) ++ (SETF (FIFTH MENU) (CAR OFFSET)) ++ (SETF (SIXTH MENU) (CADR OFFSET)) ++ (MENU-SET-ADD-ITEM MS NAME SYM MENU))) ++(SETF (GET 'MENU-SET-ADD-PICMENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) ++ (SPEC PICMENU-SPEC) (&OPTIONAL VECTOR) (OFFSET BOOLEAN))) ++(SETF (GET 'MENU-SET-ADD-PICMENU 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-COMPONENT (MS NAME &OPTIONAL OFFSET) ++ (MENU-SET-ADD-PICMENU MS (MENU-SET-NAME NAME) NAME NIL NAME OFFSET T)) ++(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (&OPTIONAL VECTOR))) ++(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-ADD-BARMENU (MS NAME SYM MENU TITLE &OPTIONAL OFFSET) ++ (BARMENU-INIT MENU) ++ (IF (NOT OFFSET) ++ (SETQ OFFSET ++ (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) ++ (EIGHTH MENU)))) ++ (SETF (FIFTH MENU) (CAR OFFSET)) ++ (SETF (SIXTH MENU) (CADR OFFSET)) ++ (MENU-SET-ADD-ITEM MS NAME SYM MENU)) ++(SETF (GET 'MENU-SET-ADD-BARMENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU BARMENU) ++ (TITLE STRING) (&OPTIONAL VECTOR))) ++(SETF (GET 'MENU-SET-ADD-BARMENU 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-NAME (NM) ++ (INTERN (SYMBOL-NAME (GENSYM (SYMBOL-NAME NM))))) ++(SETF (GET 'MENU-SET-NAME 'GLARGUMENTS) '((NM SYMBOL))) ++(SETF (GET 'MENU-SET-NAME 'GLFNRESULTTYPE) 'SYMBOL) ++ ++ ++(DEFUN MENU-SET-NAMED-ITEM (MS NAME) (ASSOC NAME (CADDR MS))) ++(SETF (GET 'MENU-SET-NAMED-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL))) ++(SETF (GET 'MENU-SET-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-SET-NAMED-MENU (MS NAME) ++ (CADDR (MENU-SET-NAMED-ITEM MS NAME))) ++(SETF (GET 'MENU-SET-NAMED-MENU 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL))) ++(SETF (GET 'MENU-SET-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) ++ ++ ++(DEFUN MENU-SET-ITEMP (MS NAME ITEMNAME) ++ (LET ((THISMENU (MENU-SET-NAMED-MENU MS NAME))) ++ (IF (EQ (FIRST THISMENU) 'MENU) ++ (SOME #'(LAMBDA (X) ++ (OR (EQ X ITEMNAME) ++ (AND (CONSP X) (EQ (CAR X) ITEMNAME)))) ++ (NTH 13 THISMENU)) ++ (IF (EQ (FIRST THISMENU) 'PICMENU) ++ (ASSOC ITEMNAME (CADDDR (NTH 10 THISMENU))))))) ++(SETF (GET 'MENU-SET-ITEMP 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (ITEMNAME SYMBOL))) ++(SETF (GET 'MENU-SET-ITEMP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN MENU-CONNS-NAMED-ITEM (MC NAME) ++ (MENU-SET-NAMED-ITEM (CADR MC) NAME)) ++(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLARGUMENTS) ++ '((MC MENU-CONNS) (NAME SYMBOL))) ++(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-CONNS-NAMED-MENU (MC NAME) ++ (MENU-SET-NAMED-MENU (CADR MC) NAME)) ++(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLARGUMENTS) ++ '((MC MENU-CONNS) (NAME SYMBOL))) ++(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) ++ ++ ++(DEFUN MENU-SET-FIND-ITEM (MS POS) ++ (LET (MITEM) ++ (DOLIST (MI (CADDR MS)) ++ (IF (AND (BETWEEN (CAR POS) ++ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (FIFTH SELF) 0)) ++ (+ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (FIFTH SELF) 0)) ++ (SEVENTH (CADDR MI)))) ++ (BETWEEN (CADR POS) ++ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (SIXTH SELF) 0)) ++ (+ (LET ((SELF (CADDR MI))) ++ (IF (CADDR SELF) (SIXTH SELF) 0)) ++ (EIGHTH (CADDR MI))))) ++ (SETQ MITEM MI))) ++ MITEM)) ++(SETF (GET 'MENU-SET-FIND-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (POS VECTOR))) ++(SETF (GET 'MENU-SET-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-SET-DELETE-ITEM (MS MI) ++ (SETF (CADDR MS) (REMOVE MI (CADDR MS)))) ++(SETF (GET 'MENU-SET-DELETE-ITEM 'GLARGUMENTS) ++ '((MS MENU-SET) (MI MENU-SET-ITEM))) ++(SETF (GET 'MENU-SET-DELETE-ITEM 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-SET-MOVE (MS) ++ (LET (SEL M) ++ (SETQ SEL (MENU-SET-SELECT MS NIL T)) ++ (SETQ M (MENU-SET-NAMED-MENU MS (CADR SEL))) ++ (MENU-REPOSITION M))) ++ ++(DEFUN MENU-MDRAW (M) ++ (CASE (FIRST M) ++ (MENU (MENU-DRAW M)) ++ (PICMENU (PICMENU-DRAW M)) ++ (BARMENU (BARMENU-DRAW M)) ++ (TEXTMENU (TEXTMENU-DRAW M)) ++ (EDITMENU (EDITMENU-DRAW M)) ++ (T (GLSEND M DRAW)))) ++ ++(DEFUN MENU-MSELECT (M &OPTIONAL ANYCLICK) ++ (CASE (FIRST M) ++ (MENU (MENU-SELECT M T)) ++ (PICMENU (PICMENU-SELECT M T ANYCLICK)) ++ (BARMENU (BARMENU-SELECT M)) ++ (TEXTMENU (TEXTMENU-SELECT M T)) ++ (EDITMENU (EDITMENU-SELECT M T)) ++ (T (GLSEND M SELECT)))) ++ ++(DEFUN MENU-MITEM-POSITION (M NAME LOC) ++ (CASE (FIRST M) ++ (MENU (MENU-ITEM-POSITION M NAME LOC)) ++ (PICMENU (PICMENU-ITEM-POSITION M NAME LOC)) ++ (T (GLSEND M ITEM-POSITION NAME LOC)))) ++ ++(DEFUN MENU-SET-DRAW (MS) ++ (XMAPWINDOW *WINDOW-DISPLAY* (CADADR MS)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-EXPOSURE (CADR MS)) ++ (DOLIST (ITEM (CADDR MS)) (MENU-MDRAW (CADDR ITEM)))) ++ ++(DEFUN MENU-SET-ITEM-POSITION (MS DESC &OPTIONAL LOC) ++ (LET (M) ++ (SETQ M (MENU-SET-NAMED-MENU MS (CADR DESC))) ++ (OR (MENU-MITEM-POSITION M (CAR DESC) LOC) ++ (MENU-MITEM-POSITION M NIL LOC)))) ++(SETF (GET 'MENU-SET-ITEM-POSITION 'GLARGUMENTS) ++ '((MS MENU-SET) (DESC MENU-PORT) (&OPTIONAL SYMBOL))) ++(SETF (GET 'MENU-SET-ITEM-POSITION 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN MENU-SET-DRAW-CONN (MS CONN) ++ (LET (PA PB TMP (DESCA (CAR CONN)) (DESCB (CADR CONN))) ++ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) ++ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) ++ (WHEN (> (CAR PA) (CAR PB)) ++ (SETQ TMP DESCA) ++ (SETQ DESCA DESCB) ++ (SETQ DESCB TMP)) ++ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) ++ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) ++ (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PA) (CADR PA) 3 NIL) ++ (WINDOW-DRAW-LINE-XY (CADR MS) (CAR PA) (CADR PA) (CAR PB) ++ (CADR PB) NIL) ++ (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PB) (CADR PB) 3 NIL) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN MENU-SET-ADJUST (MS NAME EDGE FROM OFFSET) ++ (LET (M FROMM PLACE) ++ (WHEN (SETQ M (MENU-SET-NAMED-ITEM MS NAME)) ++ (IF FROM ++ (PROGN ++ (SETQ FROMM (MENU-SET-NAMED-ITEM MS FROM)) ++ (SETQ PLACE ++ (CASE EDGE ++ (TOP (SIXTH (CADDR FROMM))) ++ (BOTTOM (+ (SIXTH (CADDR FROMM)) ++ (EIGHTH (CADDR FROMM)))) ++ (LEFT (+ (FIFTH (CADDR FROMM)) ++ (SEVENTH (CADDR FROMM)))) ++ (RIGHT (FIFTH (CADDR FROMM)))))) ++ (SETQ PLACE ++ (CASE EDGE ++ (TOP (CADDDR (CADR MS))) ++ ((BOTTOM LEFT) 0) ++ (RIGHT (FIFTH (CADR MS)))))) ++ (CASE EDGE ++ (TOP (SETF (SIXTH (CADDR M)) ++ (- (- PLACE (EIGHTH (CADDR M))) OFFSET))) ++ (BOTTOM (SETF (SIXTH (CADDR M)) (+ PLACE OFFSET))) ++ (LEFT (SETF (FIFTH (CADDR M)) (+ PLACE OFFSET))) ++ (RIGHT (SETF (FIFTH (CADDR M)) ++ (- (- PLACE (SEVENTH (CADDR M))) OFFSET))))))) ++(SETF (GET 'MENU-SET-ADJUST 'GLARGUMENTS) ++ '((MS MENU-SET) (NAME SYMBOL) (EDGE SYMBOL) (FROM SYMBOL) ++ (OFFSET INTEGER))) ++(SETF (GET 'MENU-SET-ADJUST 'GLFNRESULTTYPE) 'INTEGER) ++ ++ ++(DEFUN VECTOR-SNAP (FIXED APPROX &OPTIONAL TOLERANCE) ++ (OR TOLERANCE (SETQ TOLERANCE 10)) ++ (IF (< (ABS (- (CAR FIXED) (CAR APPROX))) TOLERANCE) ++ (LIST (CAR FIXED) (CADR APPROX)) ++ (IF (< (ABS (- (CADR FIXED) (CADR APPROX))) TOLERANCE) ++ (LIST (CAR APPROX) (CADR FIXED)) APPROX))) ++(SETF (GET 'VECTOR-SNAP 'GLARGUMENTS) ++ '((FIXED VECTOR) (APPROX VECTOR) (&OPTIONAL NIL))) ++(SETF (GET 'VECTOR-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN MENU-CONNS-CREATE (MS) (LIST 'MENU-CONNS MS NIL)) ++(SETF (GET 'MENU-CONNS-CREATE 'GLARGUMENTS) '((MS MENU-SET))) ++(SETF (GET 'MENU-CONNS-CREATE 'GLFNRESULTTYPE) 'MENU-CONNS) ++ ++ ++(DEFUN MENU-CONNS-DRAW (MC) ++ (MENU-SET-DRAW (CADR MC)) ++ (DOLIST (C (CADDR MC)) (MENU-SET-DRAW-CONN (CADR MC) C))) ++ ++(DEFUN MENU-CONNS-MOVE (MC) ++ (MENU-SET-MOVE (CADR MC)) ++ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (MENU-CONNS-DRAW MC)) ++ ++(DEFUN MENU-CONNS-REDRAW (MC) ++ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (MENU-CONNS-DRAW MC)) ++ ++(DEFUN MENU-CONNS-ADD-CONN (MC) ++ (LET (SEL SELB CONN) ++ (SETQ SEL (MENU-SET-SELECT (CADR MC))) ++ (IF (EQ (CADR SEL) 'BACKGROUND) SEL ++ (PROGN ++ (SETQ SELB (MENU-SET-SELECT (CADR MC))) ++ (WHEN (NOT (EQ (CADR SELB) 'BACKGROUND)) ++ (SETQ CONN (LIST SEL SELB)) ++ (MENU-SET-DRAW-CONN (CADR MC) CONN) ++ (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL)))) ++ NIL)))) ++(SETF (GET 'MENU-CONNS-ADD-CONN 'GLARGUMENTS) '((MC MENU-CONNS))) ++(SETF (GET 'MENU-CONNS-ADD-CONN 'GLFNRESULTTYPE) 'MENU-SELECTION) ++ ++ ++(DEFUN MENU-CONNS-NEW-CONN (MC FROMNAME FROMPORT TONAME TOPORT) ++ (LET (CONN) ++ (SETQ CONN (LIST (LIST FROMPORT FROMNAME) (LIST TOPORT TONAME))) ++ (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL))))) ++(SETF (GET 'MENU-CONNS-NEW-CONN 'GLARGUMENTS) ++ '((MC MENU-CONNS) (FROMNAME SYMBOL) (FROMPORT SYMBOL) ++ (TONAME SYMBOL) (TOPORT SYMBOL))) ++(SETF (GET 'MENU-CONNS-NEW-CONN 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-CONN)) ++ ++ ++(DEFUN MENU-CONNS-ADD-ITEM (MC NAME SYM MENU) ++ (MENU-SET-ADD-ITEM (CADR MC) NAME SYM MENU)) ++(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLARGUMENTS) ++ '((MC MENU-CONNS) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) ++(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-ITEM)) ++ ++ ++(DEFUN MENU-CONNS-FIND-CONN (MC PT) ++ (LET (MS LS FOUND RES PA PB TMP DESCA DESCB) ++ (SETQ LS (LIST (COPY-LIST '(0 0)) (COPY-LIST '(0 0)))) ++ (SETQ MS (CADR MC)) ++ (DOLIST (CONN (CADDR MC)) ++ (UNLESS FOUND ++ (SETQ DESCA (CAR CONN)) ++ (SETQ DESCB (CADR CONN)) ++ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) ++ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) ++ (WHEN (> (CAR PA) (CAR PB)) ++ (SETQ TMP DESCA) ++ (SETQ DESCA DESCB) ++ (SETQ DESCB TMP)) ++ (SETF (CAR LS) (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) ++ (SETF (CADR LS) (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) ++ (WHEN (< (ABS (/ (- (* (- (CAADR LS) (CAAR LS)) ++ (- (CADR PT) (CADAR LS))) ++ (* (- (CADADR LS) (CADAR LS)) ++ (- (CAR PT) (CAAR LS)))) ++ (SQRT (+ (EXPT (- (CAADR LS) (CAAR LS)) 2) ++ (EXPT (- (CADADR LS) (CADAR LS)) 2))))) ++ 5) ++ (SETQ FOUND T) ++ (SETQ RES CONN)))) ++ RES)) ++(SETF (GET 'MENU-CONNS-FIND-CONN 'GLARGUMENTS) ++ '((MC MENU-CONNS) (PT VECTOR))) ++(SETF (GET 'MENU-CONNS-FIND-CONN 'GLFNRESULTTYPE) 'MENU-SET-CONN) ++ ++ ++(DEFUN MENU-CONNS-FIND-ITEM (MC PT) (MENU-SET-FIND-ITEM (CADR MC) PT)) ++(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLARGUMENTS) ++ '((MC MENU-CONNS) (PT VECTOR))) ++(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) ++ ++ ++(DEFUN MENU-CONNS-DELETE-CONN (MC CONN) ++ (SETF (CADDR MC) (REMOVE CONN (CADDR MC)))) ++(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLARGUMENTS) ++ '((MC MENU-CONNS) (CONN MENU-SET-CONN))) ++(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-CONN)) ++ ++ ++(DEFUN MENU-CONNS-DELETE-ITEM (MC MI) ++ (LET (MS) ++ (SETQ MS (CADR MC)) ++ (MENU-SET-DELETE-ITEM MS MI) ++ (DOLIST (CONN (CADDR MC)) ++ (IF (OR (EQ (CADAR CONN) (CAR MI)) (EQ (CADADR CONN) (CAR MI))) ++ (MENU-CONNS-DELETE-CONN MC CONN))))) ++ ++(DEFUN MENU-CONNS-REMOVE-ITEMS (MC) ++ (MENU-SET-REMOVE-ITEMS (CADR MC)) ++ (SETF (CADDR MC) NIL)) ++(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLARGUMENTS) '((MC MENU-CONNS))) ++(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLFNRESULTTYPE) ++ '(LISTOF MENU-SET-CONN)) ++ ++ ++(DEFUN MENU-CONNS-CONNECTED-PORTS (MC BOXNAME) ++ (LET (PORTS) ++ (DOLIST (CONN (CADDR MC)) ++ (IF (EQ BOXNAME (CADADR CONN)) (PUSHNEW (CAADR CONN) PORTS) ++ (IF (EQ BOXNAME (CADAR CONN)) (PUSHNEW (CAAR CONN) PORTS)))) ++ PORTS)) ++ ++(DEFUN MENU-CONNS-FIND-CONNS (MC BOXNAME PORT) ++ (LET (RES) ++ (DOLIST (CONN (CADDR MC)) ++ (IF (AND (EQ BOXNAME (CADADR CONN)) (EQ PORT (CAADR CONN))) ++ (SETQ RES (NCONC RES (CONS (CAR CONN) NIL)))) ++ (IF (AND (EQ BOXNAME (CADAR CONN)) (EQ PORT (CAAR CONN))) ++ (SETQ RES (NCONC RES (CONS (CADR CONN) NIL))))) ++ RES)) ++(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLARGUMENTS) ++ '((MC MENU-CONNS) (BOXNAME SYMBOL) (PORT SYMBOL))) ++(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLFNRESULTTYPE) '(LISTOF MENU-PORT)) ++ ++ ++(DEFUN COMPILE-MENU-SET () ++ (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") ++ '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" ++ "glisp/menu-set-header.lsp") ++ (COMPILE-FILE "glisp/menu-settrans.lsp")) ++ ++(DEFUN COMPILE-MENU-SETB () ++ (GLCOMPFILES *DIRECTORY* ++ '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") ++ '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" ++ "glisp/menu-set-header.lsp")) ++ ++(DEFVAR *DRAW-WINDOW* NIL) ++ ++(DEFVAR *DRAW-WINDOW-WIDTH* 600) ++ ++(DEFVAR *DRAW-WINDOW-HEIGHT* 600) ++ ++(DEFVAR *DRAW-LEAVE-WINDOW* NIL) ++ ++(DEFVAR *DRAW-MENU-SET* NIL) ++ ++(DEFVAR *DRAW-ZERO-VECTOR* '(0 0)) ++ ++(DEFVAR *DRAW-LATEX-FACTOR* 1) ++ ++(DEFVAR *DRAW-SNAP-FLAG* T) ++ ++(DEFVAR *DRAW-OBJECTS* NIL) ++ ++(DEFVAR *DRAW-LATEX-MODE* NIL) ++ ++(DEFVAR *DRAW-WINDOW*) ++(SETF (GET '*DRAW-WINDOW* 'GLISPGLOBALVAR) T) ++(SETF (GET '*DRAW-WINDOW* 'GLISPGLOBALVARTYPE) 'WINDOW) ++ ++ ++(DEFMACRO DRAW-DESCR (NAME) (LIST 'GET NAME ''DRAW-DESCR)) ++ ++(SETF (GET 'DRAW-DESC 'GLSTRUCTURE) ++ '((LISTOBJECT (NAME SYMBOL) (OBJECTS (LISTOF DRAW-OBJECT)) ++ (OFFSET VECTOR) (SIZE VECTOR)) ++ PROP ((FNNAME DRAW-DESC-FNNAME) (REFPT DRAW-DESC-REFPT)) MSG ++ ((DRAW DRAW-DESC-DRAW) (SNAP DRAW-DESC-SNAP) ++ (FIND DRAW-DESC-FIND) (DELETE DRAW-DESC-DELETE)))) ++(SETF (GET 'DRAW-OBJECT 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ DEFAULT ((LINEWIDTH 1)) PROP ++ ((REGION ((VIRTUAL REGION WITH START = OFFSET SIZE = SIZE))) ++ (VREGION ((VIRTUAL REGION WITH START = VSTART SIZE = VSIZE))) ++ (VSTART ((VIRTUAL VECTOR WITH X = ++ (MIN (X OFFSET) ((X OFFSET) + (X SIZE))) - 2 ++ Y = (MIN (Y OFFSET) ((Y OFFSET) + (Y SIZE))) ++ - 2))) ++ (VSIZE ((VIRTUAL VECTOR WITH X = (ABS (X SIZE)) + 4 Y = ++ (ABS (Y SIZE)) + 4)))) ++ MSG ++ ((ERASE DRAW-OBJECT-ERASE) (DRAW DRAW-OBJECT-DRAW) ++ (SNAP DRAW-OBJECT-SNAP) (SELECTEDP DRAW-OBJECT-SELECTEDP) ++ (MOVE DRAW-OBJECT-MOVE)))) ++(SETF (GET 'DRAW-LINE 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ PROP ++ ((LINE ((VIRTUAL LINE-SEGMENT WITH P1 = OFFSET P2 = ++ (OFFSET + SIZE))))) ++ MSG ++ ((DRAW DRAW-LINE-DRAW) (SNAP DRAW-LINE-SNAP) ++ (SELECTEDP DRAW-LINE-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-ARROW 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ PROP ++ ((LINE ((VIRTUAL LINE-SEGMENT WITH P1 = OFFSET P2 = ++ (OFFSET + SIZE))))) ++ MSG ++ ((DRAW DRAW-ARROW-DRAW) (SNAP DRAW-LINE-SNAP) ++ (SELECTEDP DRAW-LINE-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-BOX 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-BOX-DRAW) (SNAP DRAW-BOX-SNAP) ++ (SELECTEDP DRAW-BOX-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-RCBOX 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-RCBOX-DRAW) (SNAP DRAW-RCBOX-SNAP) ++ (SELECTEDP DRAW-RCBOX-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-ERASE 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-ERASE-DRAW) (SNAP DRAW-NO-SNAP) ++ (SELECTEDP DRAW-ERASE-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-CIRCLE 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ PROP ((RADIUS ((X SIZE) / 2)) (CENTER (OFFSET + SIZE / 2))) MSG ++ ((DRAW DRAW-CIRCLE-DRAW) (SNAP DRAW-CIRCLE-SNAP) ++ (SELECTEDP DRAW-CIRCLE-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-ELLIPSE 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ PROP ++ ((RADIUSX ((X SIZE) / 2)) (RADIUSY ((Y SIZE) / 2)) ++ (RADIUS ((MAX RADIUSX RADIUSY))) (CENTER (OFFSET + SIZE / 2)) ++ (DELTA ((SQRT (ABS (RADIUSX ^ 2 - RADIUSY ^ 2))))) ++ (P1 ((IF (RADIUSX > RADIUSY) ++ (A VECTOR X = (X CENTER) - DELTA Y = (Y CENTER)) ++ (A VECTOR X = (X CENTER) Y = (Y CENTER) - DELTA)))) ++ (P2 ((IF (RADIUSX > RADIUSY) ++ (A VECTOR X = (X CENTER) + DELTA Y = (Y CENTER)) ++ (A VECTOR X = (X CENTER) Y = (Y CENTER) + DELTA))))) ++ MSG ++ ((DRAW DRAW-ELLIPSE-DRAW) (SNAP DRAW-ELLIPSE-SNAP) ++ (SELECTEDP DRAW-ELLIPSE-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-DOT 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-DOT-DRAW) (SNAP DRAW-DOT-SNAP) ++ (SELECTEDP DRAW-BUTTON-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-BUTTON 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-BUTTON-DRAW) (SNAP DRAW-DOT-SNAP) ++ (SELECTEDP DRAW-BUTTON-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-TEXT 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-TEXT-DRAW) (SNAP DRAW-NO-SNAP) ++ (SELECTEDP DRAW-TEXT-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-NULL 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-NULL-DRAW) (SNAP DRAW-NO-SNAP) ++ (SELECTEDP DRAW-NULL-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-REFPT 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) ++ (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-REFPT-DRAW) (SNAP DRAW-REFPT-SNAP) ++ (SELECTEDP DRAW-REFPT-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++(SETF (GET 'DRAW-MULTI 'GLSTRUCTURE) ++ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) ++ (CONTENTS (LISTOF DRAW-OBJECT)) (LINEWIDTH INTEGER)) ++ MSG ++ ((DRAW DRAW-MULTI-DRAW) (SNAP DRAW-NO-SNAP) ++ (SELECTEDP DRAW-MULTI-SELECTEDP)) ++ SUPERS (DRAW-OBJECT))) ++ ++ ++(DEFUN DRAW-DESC (NAME) ++ (LET (DD) ++ (SETQ DD (DRAW-DESCR NAME)) ++ (WHEN (NOT DD) ++ (SETQ DD ++ (LIST 'DRAW-DESC NAME NIL (COPY-LIST '(0 0)) ++ (COPY-LIST '(0 0)))) ++ (SETF (DRAW-DESCR NAME) DD)) ++ DD)) ++(SETF (GET 'DRAW-DESC 'GLARGUMENTS) '((NAME SYMBOL))) ++(SETF (GET 'DRAW-DESC 'GLFNRESULTTYPE) 'DRAW-DESC) ++ ++ ++(SETF (GET 'DRAW-WINDOW 'GLFNRESULTTYPE) 'WINDOW) ++ ++(DEFUN DRAW-WINDOW () ++ (OR *DRAW-WINDOW* ++ (SETQ *DRAW-WINDOW* ++ (WINDOW-CREATE *DRAW-WINDOW-WIDTH* *DRAW-WINDOW-HEIGHT* ++ "Draw window")))) ++ ++(DEFUN DRAW (NAME) ++ (LET (W DD DONE SEL (REDRAW T) NEW) ++ (SETQ W (DRAW-WINDOW)) ++ (XMAPWINDOW *WINDOW-DISPLAY* (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-EXPOSURE W) ++ (OR *DRAW-MENU-SET* (DRAW-INIT-MENUS)) ++ (SETQ DD (DRAW-DESC NAME)) ++ (UNLESS (MEMBER NAME *DRAW-OBJECTS*) ++ (SETQ *DRAW-OBJECTS* (NCONC *DRAW-OBJECTS* (LIST NAME)))) ++ (DRAW-DESC-DRAW DD W) ++ (WHILE (NOT DONE) ++ (SETQ SEL (MENU-SET-SELECT *DRAW-MENU-SET* REDRAW)) ++ (SETQ REDRAW NIL) ++ (CASE (CADR SEL) ++ (COMMAND (CASE (CAR SEL) ++ (DONE (SETQ DONE T)) ++ (MOVE (DRAW-DESC-MOVE DD W)) ++ (DELETE (DRAW-DESC-DELETE DD W)) ++ (COPY (DRAW-DESC-COPY DD W)) ++ (REDRAW (XCLEARWINDOW *WINDOW-DISPLAY* ++ (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (SETQ REDRAW T) (DRAW-DESC-DRAW DD W)) ++ (ORIGIN (DRAW-DESC-ORIGIN DD W) ++ (XCLEARWINDOW *WINDOW-DISPLAY* ++ (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (SETQ REDRAW T) (DRAW-DESC-DRAW DD W)) ++ (PROGRAM (DRAW-DESC-PROGRAM DD)) ++ (LATEX (DRAW-DESC-LATEX DD)) ++ (LATEXMODE ++ (SETQ *DRAW-LATEX-MODE* ++ (NOT *DRAW-LATEX-MODE*)) ++ (FORMAT T "Latex Mode is now ~A~%" ++ *DRAW-LATEX-MODE*)))) ++ (DRAW (SETQ NEW NIL) ++ (CASE (CAR SEL) ++ (RECTANGLE (SETQ NEW (DRAW-BOX-GET DD W))) ++ (RCBOX (SETQ NEW (DRAW-RCBOX-GET DD W))) ++ (CIRCLE (SETQ NEW (DRAW-CIRCLE-GET DD W))) ++ (ELLIPSE (SETQ NEW (DRAW-ELLIPSE-GET DD W))) ++ (LINE (SETQ NEW (DRAW-LINE-GET DD W))) ++ (ARROW (SETQ NEW (DRAW-ARROW-GET DD W))) ++ (DOT (SETQ NEW (DRAW-DOT-GET DD W))) ++ (ERASE (SETQ NEW (DRAW-ERASE-GET DD W))) ++ (BUTTON (SETQ NEW (DRAW-BUTTON-GET DD W))) ++ (TEXT (SETQ NEW (DRAW-TEXT-GET DD W))) ++ (REFPT (SETQ NEW (DRAW-REFPT-GET DD W)))) ++ (WHEN NEW ++ (SETF (CADR NEW) ++ (LIST (- (CAADR NEW) (CAR (CADDDR DD))) ++ (- (CADADR NEW) (CADR (CADDDR DD))))) ++ (SETF (CADDR DD) ++ (NCONC (CADDR DD) (CONS NEW NIL))) ++ (DRAW-OBJECT-DRAW NEW W (CADDDR DD)))) ++ (BACKGROUND))) ++ (SETF (DRAW-DESCR NAME) DD) ++ (UNLESS *DRAW-LEAVE-WINDOW* ++ (PROGN ++ (XUNMAPWINDOW *WINDOW-DISPLAY* (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (WINDOW-WAIT-UNMAP W))) ++ NAME)) ++(SETF (GET 'DRAW 'GLARGUMENTS) '((NAME SYMBOL))) ++(SETF (GET 'DRAW 'GLFNRESULTTYPE) 'SYMBOL) ++ ++ ++(DEFUN COPY-DRAW-DESC (FROM TO) ++ (LET (OLD) ++ (SETQ OLD (COPY-TREE (GET FROM 'DRAW-DESCR))) ++ (SETF (GET TO 'DRAW-DESCR) (CONS (CAR OLD) (CONS TO (CDDR OLD)))))) ++ ++(DEFUN DRAW-DESC-DRAW (DD W) ++ (LET ((OFF (CADDDR DD))) ++ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR W)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (DOLIST (OBJ (CADDR DD)) (DRAW-OBJECT-DRAW OBJ W OFF)) ++ (XFLUSH *WINDOW-DISPLAY*))) ++ ++(DEFUN DRAW-DESC-SELECTED (DD P) ++ (LET (OBJS OBJSB OBJ) ++ (SETQ OBJS ++ (MAPCAN #'(LAMBDA (OBJ) ++ (AND (DRAW-OBJECT-SELECTEDP OBJ P (CADDDR DD)) ++ (CONS OBJ NIL))) ++ (CADDR DD))) ++ (IF OBJS ++ (IF (NULL (REST OBJS)) (SETQ OBJ (FIRST OBJS)) ++ (PROGN ++ (SETQ OBJSB ++ (MAPCAN #'(LAMBDA (Z) ++ (AND (MEMBER (FIRST Z) ++ '(DRAW-BUTTON DRAW-DOT)) ++ (CONS Z NIL))) ++ OBJS)) ++ (IF (AND OBJSB (NULL (REST OBJSB))) ++ (SETQ OBJ (FIRST OBJSB)))))) ++ OBJ)) ++(SETF (GET 'DRAW-DESC-SELECTED 'GLARGUMENTS) ++ '((DD DRAW-DESC) (P VECTOR))) ++(SETF (GET 'DRAW-DESC-SELECTED 'GLFNRESULTTYPE) 'DRAW-OBJECT) ++ ++ ++(DEFUN DRAW-DESC-FIND (DD W &OPTIONAL CROSSFLG) ++ (LET (P OBJ) ++ (WHILE (NOT OBJ) ++ (SETQ P ++ (IF CROSSFLG (DRAW-GET-CROSS DD W) ++ (DRAW-GET-CROSSHAIRS DD W))) ++ (SETQ OBJ (DRAW-DESC-SELECTED DD P))) ++ OBJ)) ++(SETF (GET 'DRAW-DESC-FIND 'GLARGUMENTS) ++ '((DD DRAW-DESC) (W WINDOW) (&OPTIONAL BOOLEAN))) ++(SETF (GET 'DRAW-DESC-FIND 'GLFNRESULTTYPE) 'DRAW-OBJECT) ++ ++ ++(DEFUN DRAW-GET-CROSS (DD W) (DRAW-DESC-SNAP DD (WINDOW-GET-CROSS W))) ++(SETF (GET 'DRAW-GET-CROSS 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-GET-CROSS 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-GET-CROSSHAIRS (DD W) ++ (DRAW-DESC-SNAP DD (WINDOW-GET-CROSSHAIRS W))) ++(SETF (GET 'DRAW-GET-CROSSHAIRS 'GLARGUMENTS) ++ '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-GET-CROSSHAIRS 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-DESC-DELETE (DD W) ++ (LET (OBJ) ++ (SETQ OBJ (DRAW-DESC-FIND DD W T)) ++ (DRAW-OBJECT-ERASE OBJ W (CADDDR DD)) ++ (SETF (CADDR DD) (REMOVE OBJ (CADDR DD))))) ++(SETF (GET 'DRAW-DESC-DELETE 'GLARGUMENTS) ++ '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-DESC-DELETE 'GLFNRESULTTYPE) '(LISTOF DRAW-OBJECT)) ++ ++ ++(DEFUN DRAW-DESC-COPY (DD W) ++ (LET (OBJ OBJB) ++ (SETQ OBJ (DRAW-DESC-FIND DD W)) ++ (SETQ OBJB (COPY-TREE OBJ)) ++ (DRAW-GET-OBJECT-POS OBJB W) ++ (SETF (CADR OBJB) ++ (LIST (- (CAADR OBJB) (CAR (CADDDR DD))) ++ (- (CADADR OBJB) (CADR (CADDDR DD))))) ++ (DRAW-OBJECT-DRAW OBJB W (CADDDR DD)) ++ (XFLUSH *WINDOW-DISPLAY*) ++ (SETF (CADDR DD) (NCONC (CADDR DD) (CONS OBJB NIL))))) ++(SETF (GET 'DRAW-DESC-COPY 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-DESC-COPY 'GLFNRESULTTYPE) '(LISTOF DRAW-OBJECT)) ++ ++ ++(DEFUN DRAW-DESC-MOVE (DD W) ++ (LET (OBJ) ++ (IF (SETQ OBJ (DRAW-DESC-FIND DD W)) ++ (DRAW-OBJECT-MOVE OBJ W (CADDDR DD))))) ++ ++(DEFUN DRAW-DESC-ORIGIN (DD W) ++ (LET (SEL) ++ (DRAW-DESC-BOUNDS DD) ++ (SETQ SEL (MENU '(("To zero" . TOZERO) ("Select" . SELECT)))) ++ (IF (EQ SEL 'SELECT) ++ (SETF (CADDDR DD) ++ (WINDOW-GET-BOX-POSITION W (CAR (FIFTH DD)) ++ (CADR (FIFTH DD)))) ++ (IF (EQ SEL 'TOZERO) (SETF (CADDDR DD) (COPY-LIST '(0 0))))))) ++(SETF (GET 'DRAW-DESC-ORIGIN 'GLARGUMENTS) ++ '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-DESC-ORIGIN 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-DESC-BOUNDS (DD) ++ (LET ((XMIN 9999) (YMIN 9999) (XMAX 0) (YMAX 0) BASEV) ++ (DOLIST (OBJ (CADDR DD)) ++ (SETQ XMIN (MIN XMIN (CAADR OBJ) (+ (CAADR OBJ) (CAADDR OBJ)))) ++ (SETQ YMIN ++ (MIN YMIN (CADADR OBJ) (+ (CADADR OBJ) (CADR (CADDR OBJ))))) ++ (SETQ XMAX (MAX XMAX (CAADR OBJ) (+ (CAADR OBJ) (CAADDR OBJ)))) ++ (SETQ YMAX ++ (MAX YMAX (CADADR OBJ) (+ (CADADR OBJ) (CADR (CADDR OBJ)))))) ++ (SETF (CAR (FIFTH DD)) (- XMAX XMIN)) ++ (SETF (CADR (FIFTH DD)) (- YMAX YMIN)) ++ (SETQ BASEV (LIST XMIN YMIN)) ++ (SETF (CADDDR DD) BASEV) ++ (DOLIST (OBJ (CADDR DD)) ++ (SETF (CADR OBJ) ++ (LIST (- (CAADR OBJ) (CAR BASEV)) ++ (- (CADADR OBJ) (CADR BASEV))))))) ++ ++(DEFUN DRAW-DESC-LATEX (DD) ++ (LET (BASE BX BY SX SY) ++ (FORMAT T " \\begin{picture}(~5,0F,~5,0F)(0,0)~%" ++ (* (CAR (FIFTH DD)) *DRAW-LATEX-FACTOR*) ++ (* (CADR (FIFTH DD)) *DRAW-LATEX-FACTOR*)) ++ (DOLIST (OBJ (CADDR DD)) ++ (SETQ BASE ++ (LIST (+ (CAR (CADDDR DD)) (CAADR OBJ)) ++ (+ (CADR (CADDDR DD)) (CADADR OBJ)))) ++ (SETQ BX (* (CAR BASE) *DRAW-LATEX-FACTOR*)) ++ (SETQ BY (* (CADR BASE) *DRAW-LATEX-FACTOR*)) ++ (SETQ SX (* (CAADDR OBJ) *DRAW-LATEX-FACTOR*)) ++ (SETQ SY (* (CADR (CADDR OBJ)) *DRAW-LATEX-FACTOR*)) ++ (CASE (FIRST OBJ) ++ (DRAW-LINE ++ (LATEX-LINE (CAR BASE) (CADR BASE) (+ (CAR BASE) SX) ++ (+ (CADR BASE) SY))) ++ (DRAW-ARROW ++ (LATEX-LINE (CAR BASE) (CADR BASE) (+ (CAR BASE) SX) ++ (+ (CADR BASE) SY) T)) ++ (DRAW-BOX ++ (FORMAT T ++ " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" ++ BX BY SX SY)) ++ (DRAW-RCBOX ++ (FORMAT T " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" ++ (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX SY)) ++ (DRAW-CIRCLE ++ (FORMAT T " \\put(~5,0F,~5,0F) {\\circle{~5,0F}}~%" ++ (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX)) ++ (DRAW-ELLIPSE ++ (FORMAT T " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" ++ (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX SY)) ++ (DRAW-BUTTON ++ (FORMAT T ++ " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" ++ BX BY SX SY)) ++ (DRAW-ERASE) ++ (DRAW-DOT ++ (FORMAT T " \\put(~5,0F,~5,0F) {\\circle*{~5,0F}}~%" ++ (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX)) ++ (DRAW-TEXT ++ (FORMAT T " \\put(~5,0F,~5,0F) {~A}~%" BX ++ (+ BY (* 4 *DRAW-LATEX-FACTOR*)) (CADDDR OBJ))))) ++ (FORMAT T " \\end{picture}~%"))) ++ ++(DEFUN DRAW-DESC-PROGRAM (DD) ++ (LET (BASE BX BY SX SY TOX TOY R RX RY S CODE FNCODE FNNAME CD) ++ (SETQ CODE ++ (MAPCAN #'(LAMBDA (OBJ) ++ (AND (SETQ CD ++ (PROGN ++ (SETQ BASE ++ (LET ++ ((GLVAR133 ++ (LIST ++ (+ (CAR (CADDDR DD)) ++ (CAADR OBJ)) ++ (+ (CADR (CADDDR DD)) ++ (CADADR OBJ)))) ++ (GLVAR134 (DRAW-DESC-REFPT DD))) ++ (LIST ++ (- (CAR GLVAR133) ++ (CAR GLVAR134)) ++ (- (CADR GLVAR133) ++ (CADR GLVAR134))))) ++ (SETQ BX (CAR BASE)) ++ (SETQ BY (CADR BASE)) ++ (SETQ SX (CAADDR OBJ)) ++ (SETQ SY (CADR (CADDR OBJ))) ++ (SETQ TOX (+ BX SX)) ++ (SETQ TOY (+ BY SY)) ++ (IF (EQ (CAR OBJ) 'DRAW-CIRCLE) ++ (SETQ R (* 1/2 (CAADDR OBJ)))) ++ (WHEN (EQ (CAR OBJ) 'DRAW-ELLIPSE) ++ (SETQ RX (* 1/2 (CAADDR OBJ))) ++ (SETQ RY ++ (* 1/2 (CADR (CADDR OBJ))))) ++ (DRAW-OPTIMIZE ++ (CASE (FIRST OBJ) ++ (DRAW-LINE ++ (LIST 'WINDOW-DRAW-LINE-XY 'W ++ (LIST '+ 'X BX) (LIST '+ 'Y BY) ++ (LIST '+ 'X TOX) ++ (LIST '+ 'Y TOY))) ++ (DRAW-ARROW ++ (LIST 'WINDOW-DRAW-ARROW-XY 'W ++ (LIST '+ 'X BX) (LIST '+ 'Y BY) ++ (LIST '+ 'X TOX) ++ (LIST '+ 'Y TOY))) ++ (DRAW-BOX ++ (LIST 'WINDOW-DRAW-BOX-XY 'W ++ (LIST '+ 'X BX) (LIST '+ 'Y BY) ++ SX SY)) ++ (DRAW-RCBOX ++ (LIST 'WINDOW-DRAW-RCBOX-XY 'W ++ (LIST '+ 'X BX) (LIST '+ 'Y BY) ++ SX SY 8)) ++ (DRAW-CIRCLE ++ (LIST 'WINDOW-DRAW-CIRCLE-XY 'W ++ (LIST '+ 'X (+ R BX)) ++ (LIST '+ 'Y (+ R BY)) R)) ++ (DRAW-ELLIPSE ++ (LIST 'WINDOW-DRAW-ELLIPSE-XY 'W ++ (LIST '+ 'X (+ RX BX)) ++ (LIST '+ 'Y (+ RY BY)) RX RY)) ++ ((DRAW-BUTTON DRAW-REFPT) NIL) ++ (DRAW-ERASE ++ (LIST 'WINDOW-ERASE-AREA-XY 'W ++ (LIST '+ 'X BX) (LIST '+ 'Y BY) ++ SX SY)) ++ (DRAW-DOT ++ (LIST 'WINDOW-DRAW-DOT-XY 'W ++ (LIST '+ 'X (+ 2 BX)) ++ (LIST '+ 'Y (+ 2 BY)))) ++ (DRAW-TEXT ++ (SETQ S ++ (STRINGIFY (CADDDR OBJ))) ++ (LIST 'WINDOW-PRINTAT-XY 'W S ++ (LIST '+ 'X BX) ++ (LIST '+ 'Y BY))))))) ++ (CONS CD NIL))) ++ (CADDR DD))) ++ (SETQ FNCODE ++ (CONS 'LAMBDA ++ (CONS (LIST 'W 'X 'Y) ++ (NCONC CODE ++ (LIST (LIST 'WINDOW-FORCE-OUTPUT 'W)))))) ++ (SETQ FNNAME (DRAW-DESC-FNNAME DD)) ++ (SETF (SYMBOL-FUNCTION FNNAME) FNCODE) ++ (FORMAT T "Constructed program (~A w x y)~%" FNNAME) ++ (DRAW-DESC-PICMENU DD))) ++ ++(DEFUN DRAW-OPTIMIZE (X) (IF (FBOUNDP 'GLUNWRAP) (GLUNWRAP X NIL) X)) ++ ++(DEFUN DRAW-DESC-FNNAME (DD) ++ (INTERN (CONCATENATE 'STRING "DRAW-" (SYMBOL-NAME (CADR DD))))) ++(SETF (GET 'DRAW-DESC-FNNAME 'GLARGUMENTS) '((DD DRAW-DESC))) ++(SETF (GET 'DRAW-DESC-FNNAME 'GLFNRESULTTYPE) 'SYMBOL) ++ ++ ++(DEFUN DRAW-DESC-PICMENU (DD) ++ (LET (BUTTONS) ++ (SETQ BUTTONS ++ (MAPCAN #'(LAMBDA (OBJ) ++ (AND (EQ (FIRST OBJ) 'DRAW-BUTTON) ++ (CONS (LIST (CADDDR OBJ) ++ (LET ++ ((GLVAR136 ++ (LET ++ ((GLVAR135 ++ (COPY-LIST '(2 2)))) ++ (LIST ++ (+ (CAR GLVAR135) ++ (CAADR OBJ)) ++ (+ (CADR GLVAR135) ++ (CADADR OBJ)))))) ++ (LIST ++ (+ (CAR GLVAR136) ++ (CAR (CADDDR DD))) ++ (+ (CADR GLVAR136) ++ (CADR (CADDDR DD)))))) ++ NIL))) ++ (CADDR DD))) ++ (IF BUTTONS ++ (SETF (GET (CADR DD) 'PICMENU-SPEC) ++ (LIST 'PICMENU-SPEC (CAR (FIFTH DD)) (CADR (FIFTH DD)) ++ BUTTONS T (DRAW-DESC-FNNAME DD) '9X15))))) ++(SETF (GET 'DRAW-DESC-PICMENU 'GLARGUMENTS) '((DD DRAW-DESC))) ++(SETF (GET 'DRAW-DESC-PICMENU 'GLFNRESULTTYPE) ++ '(LIST GLTYPE INTEGER INTEGER (LISTOF (LIST ANYTHING VECTOR)) ++ BOOLEAN SYMBOL SYMBOL)) ++ ++ ++(DEFUN DRAW-DESC-SNAP (DD P) ++ (LET (PSNAP OBJ (OBJS (CADDR DD))) ++ (IF *DRAW-SNAP-FLAG* ++ (WHILE (AND OBJS (NOT PSNAP)) (SETQ OBJ (POP OBJS)) ++ (SETQ PSNAP (DRAW-OBJECT-SNAP OBJ P (CADDDR DD))))) ++ (OR PSNAP P))) ++(SETF (GET 'DRAW-DESC-SNAP 'GLARGUMENTS) '((DD DRAW-DESC) (P VECTOR))) ++(SETF (GET 'DRAW-DESC-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-OBJECT-MOVE (D W OFF) ++ (DRAW-OBJECT-ERASE D W OFF) ++ (DRAW-GET-OBJECT-POS D W) ++ (SETF (CADR D) ++ (LIST (- (CAADR D) (CAR OFF)) (- (CADADR D) (CADR OFF)))) ++ (DRAW-OBJECT-DRAW D W OFF) ++ (XFLUSH *WINDOW-DISPLAY*)) ++ ++(DEFUN DRAW-OBJECT-DRAW-AT (W X Y D) ++ (SETF (SECOND D) (LIST X Y)) ++ (DRAW-OBJECT-DRAW D W *DRAW-ZERO-VECTOR*)) ++ ++(DEFUN DRAW-OBJECT-DRAW (D W OFF) ++ (FUNCALL (GLMETHOD (CAR D) 'DRAW) D W OFF)) ++ ++(DEFUN DRAW-OBJECT-SNAP (D P OFF) ++ (FUNCALL (GLMETHOD (CAR D) 'SNAP) D P OFF)) ++ ++(DEFUN DRAW-OBJECT-SELECTEDP (D W OFF) ++ (FUNCALL (GLMETHOD (CAR D) 'SELECTEDP) D W OFF)) ++ ++(DEFUN DRAW-GET-OBJECT-POS (D W) ++ (WINDOW-GET-ICON-POSITION W ++ (IF (EQ (FIRST D) 'DRAW-TEXT) #'DRAW-TEXT-DRAW-OUTLINE ++ #'DRAW-OBJECT-DRAW-AT) ++ (LIST D))) ++(SETF (GET 'DRAW-GET-OBJECT-POS 'GLARGUMENTS) ++ '((D DRAW-OBJECT) (W WINDOW))) ++(SETF (GET 'DRAW-GET-OBJECT-POS 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-OBJECT-ERASE (D W OFF) ++ (WHEN (NOT (EQ (FIRST D) 'DRAW-ERASE)) ++ (LET ((GC (CADDR W))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (LOGXOR *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*))))) ++ (DRAW-OBJECT-DRAW D W OFF) ++ (LET ((GC (CADDR W))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)))) ++ ++(DEFUN DRAW-LINE-DRAW (D W OFF) ++ (LET ((FROM (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D)))) ++ (TO (LET ((GLVAR137 ++ (LIST (+ (CAR OFF) (CAADR D)) ++ (+ (CADR OFF) (CADADR D))))) ++ (LIST (+ (CAR GLVAR137) (CAADDR D)) ++ (+ (CADR GLVAR137) (CADR (CADDR D))))))) ++ (LET ((QQWHEIGHT (CADDDR W))) ++ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (CAR FROM) ++ (- QQWHEIGHT (CADR FROM)) (CAR TO) (- QQWHEIGHT (CADR TO))) ++ NIL))) ++ ++(DEFUN DRAW-ARROW-DRAW (D W OFF) ++ (LET ((FROM (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D)))) ++ (TO (LET ((GLVAR138 ++ (LIST (+ (CAR OFF) (CAADR D)) ++ (+ (CADR OFF) (CADADR D))))) ++ (LIST (+ (CAR GLVAR138) (CAADDR D)) ++ (+ (CADR GLVAR138) (CADR (CADDR D))))))) ++ (WINDOW-DRAW-ARROW-XY W (CAR FROM) (CADR FROM) (CAR TO) (CADR TO)))) ++ ++(DEFUN DRAW-LINE-SELECTEDP (D PT OFF) ++ (LET ((PTP (LIST (- (CAR PT) (CAR OFF)) (- (CADR PT) (CADR OFF))))) ++ (AND (BETWEEN (CAR PTP) (+ -2 (+ (CAADR D) (MIN 0 (CAADDR D)))) ++ (+ 2 ++ (+ (+ (CAADR D) (MIN 0 (CAADDR D))) ++ (ABS (CAADDR D))))) ++ (BETWEEN (CADR PTP) ++ (+ -2 (+ (CADADR D) (MIN 0 (CADR (CADDR D))))) ++ (+ 2 ++ (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) ++ (ABS (CADR (CADDR D)))))) ++ (< (ABS (/ (- (* (CAADDR D) (- (CADR PTP) (CADADR D))) ++ (* (CADR (CADDR D)) (- (CAR PTP) (CAADR D)))) ++ (SQRT (+ (EXPT (CAADDR D) 2) ++ (EXPT (CADR (CADDR D)) 2))))) ++ 5)))) ++(SETF (GET 'DRAW-LINE-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-LINE) (PT VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-LINE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-LINE-GET (DD W) ++ (LET (FROM TO) ++ (SETQ FROM (DRAW-GET-CROSSHAIRS DD W)) ++ (SETQ TO ++ (IF *DRAW-LATEX-MODE* ++ (WINDOW-GET-LATEX-POSITION W (CAR FROM) (CADR FROM) NIL) ++ (DRAW-DESC-SNAP DD ++ (WINDOW-GET-LINE-POSITION W (CAR FROM) (CADR FROM))))) ++ (LIST 'DRAW-LINE FROM ++ (LIST (- (CAR TO) (CAR FROM)) (- (CADR TO) (CADR FROM))) NIL ++ 1))) ++(SETF (GET 'DRAW-LINE-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-LINE-GET 'GLFNRESULTTYPE) 'DRAW-LINE) ++ ++ ++(DEFUN DRAW-ARROW-GET (DD W) ++ (LET (FROM TO) ++ (SETQ FROM (DRAW-GET-CROSSHAIRS DD W)) ++ (SETQ TO ++ (IF *DRAW-LATEX-MODE* ++ (WINDOW-GET-LATEX-POSITION W (CAR FROM) (CADR FROM) NIL) ++ (DRAW-DESC-SNAP DD ++ (WINDOW-GET-LINE-POSITION W (CAR FROM) (CADR FROM))))) ++ (LIST 'DRAW-ARROW FROM ++ (LIST (- (CAR TO) (CAR FROM)) (- (CADR TO) (CADR FROM))) NIL ++ 1))) ++(SETF (GET 'DRAW-ARROW-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-ARROW-GET 'GLFNRESULTTYPE) 'DRAW-ARROW) ++ ++ ++(DEFUN DRAW-BOX-DRAW (D W OFF) ++ (LET ((GLVAR139 ++ (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D))))) ++ (WINDOW-DRAW-BOX-XY W (CAR GLVAR139) (CADR GLVAR139) (CAADDR D) ++ (CADR (CADDR D)) NIL))) ++ ++(DEFUN DRAW-BOX-SELECTEDP (D P OFF) ++ (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) ++ (OR (AND (< (CADR PT) ++ (+ 7 ++ (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) ++ (ABS (CADR (CADDR D)))))) ++ (> (CADR PT) ++ (+ -7 (+ (CADADR D) (MIN 0 (CADR (CADDR D)))))) ++ (OR (< (ABS (+ 2 ++ (- (CAR PT) ++ (+ (CAADR D) (MIN 0 (CAADDR D)))))) ++ 5) ++ (< (ABS (+ -2 ++ (- (CAR PT) ++ (+ (+ (CAADR D) (MIN 0 (CAADDR D))) ++ (ABS (CAADDR D)))))) ++ 5))) ++ (AND (< (CAR PT) ++ (+ 7 ++ (+ (+ (CAADR D) (MIN 0 (CAADDR D))) ++ (ABS (CAADDR D))))) ++ (> (CAR PT) (+ -7 (+ (CAADR D) (MIN 0 (CAADDR D))))) ++ (OR (< (ABS (+ -2 ++ (- (CADR PT) ++ (+ (+ (CADADR D) ++ (MIN 0 (CADR (CADDR D)))) ++ (ABS (CADR (CADDR D))))))) ++ 5) ++ (< (ABS (+ 2 ++ (- (CADR PT) ++ (+ (CADADR D) (MIN 0 (CADR (CADDR D))))))) ++ 5)))))) ++(SETF (GET 'DRAW-BOX-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-BOX-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-BOX-GET (DD W) ++ (LET (BOX) ++ (SETQ BOX (WINDOW-GET-REGION W)) ++ (LIST 'DRAW-BOX (CAR BOX) (CADR BOX) NIL 1))) ++(SETF (GET 'DRAW-BOX-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-BOX-GET 'GLFNRESULTTYPE) 'DRAW-BOX) ++ ++ ++(DEFUN DRAW-RCBOX-DRAW (D W OFF) ++ (WINDOW-DRAW-RCBOX-XY W (+ (CAR OFF) (CAADR D)) ++ (+ (CADR OFF) (CADADR D)) (CAADDR D) (CADR (CADDR D)) 8)) ++ ++(DEFUN DRAW-RCBOX-SELECTEDP (D P OFF) ++ (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) ++ (OR (AND (< (CADR PT) ++ (1- (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) ++ (ABS (CADR (CADDR D)))))) ++ (> (CADR PT) (1+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))))) ++ (OR (< (ABS (+ 2 ++ (- (CAR PT) ++ (+ (CAADR D) (MIN 0 (CAADDR D)))))) ++ 5) ++ (< (ABS (+ -2 ++ (- (CAR PT) ++ (+ (+ (CAADR D) (MIN 0 (CAADDR D))) ++ (ABS (CAADDR D)))))) ++ 5))) ++ (AND (< (CAR PT) ++ (1- (+ (+ (CAADR D) (MIN 0 (CAADDR D))) ++ (ABS (CAADDR D))))) ++ (> (CAR PT) (1+ (+ (CAADR D) (MIN 0 (CAADDR D))))) ++ (OR (< (ABS (+ -2 ++ (- (CADR PT) ++ (+ (+ (CADADR D) ++ (MIN 0 (CADR (CADDR D)))) ++ (ABS (CADR (CADDR D))))))) ++ 5) ++ (< (ABS (+ 2 ++ (- (CADR PT) ++ (+ (CADADR D) (MIN 0 (CADR (CADDR D))))))) ++ 5)))))) ++(SETF (GET 'DRAW-RCBOX-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-RCBOX-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-RCBOX-GET (DD W) ++ (LET (BOX) ++ (SETQ BOX (WINDOW-GET-REGION W)) ++ (LIST 'DRAW-RCBOX (CAR BOX) (CADR BOX) NIL 1))) ++(SETF (GET 'DRAW-RCBOX-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-RCBOX-GET 'GLFNRESULTTYPE) 'DRAW-RCBOX) ++ ++ ++(DEFUN DRAW-CIRCLE-DRAW (D W OFF) ++ (LET ((GLVAR142 ++ (LET ((GLVAR141 ++ (LET ((GLVAR140 ++ (LIST (* 1/2 (CAADDR D)) ++ (* 1/2 (CADR (CADDR D)))))) ++ (LIST (+ (CAADR D) (CAR GLVAR140)) ++ (+ (CADADR D) (CADR GLVAR140)))))) ++ (LIST (+ (CAR OFF) (CAR GLVAR141)) ++ (+ (CADR OFF) (CADR GLVAR141)))))) ++ (WINDOW-DRAW-CIRCLE-XY W (CAR GLVAR142) (CADR GLVAR142) ++ (* 1/2 (CAADDR D)) NIL))) ++ ++(DEFUN DRAW-CIRCLE-SELECTEDP (D P OFF) ++ (< (ABS (- (* 1/2 (CAADDR D)) ++ (LET ((SELF (LET ((GLVAR146 ++ (LET ++ ((GLVAR145 ++ (LET ++ ((GLVAR144 ++ (LIST (* 1/2 (CAADDR D)) ++ (* 1/2 (CADR (CADDR D)))))) ++ (LIST ++ (+ (CAADR D) (CAR GLVAR144)) ++ (+ (CADADR D) (CADR GLVAR144)))))) ++ (LIST (+ (CAR GLVAR145) (CAR OFF)) ++ (+ (CADR GLVAR145) (CADR OFF)))))) ++ (LIST (- (CAR GLVAR146) (CAR P)) ++ (- (CADR GLVAR146) (CADR P)))))) ++ (SQRT (+ (EXPT (CAR SELF) 2) (EXPT (CADR SELF) 2)))))) ++ 5)) ++(SETF (GET 'DRAW-CIRCLE-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-CIRCLE) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-CIRCLE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-CIRCLE-GET (DD W) ++ (LET (CIR CENT) ++ (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) ++ (SETQ CIR (WINDOW-GET-CIRCLE W CENT)) ++ (LIST 'DRAW-CIRCLE ++ (LIST (- (CAAR CIR) (CADR CIR)) (- (CADAR CIR) (CADR CIR))) ++ (LIST (* 2 (CADR CIR)) (* 2 (CADR CIR))) NIL 1))) ++(SETF (GET 'DRAW-CIRCLE-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-CIRCLE-GET 'GLFNRESULTTYPE) 'DRAW-CIRCLE) ++ ++ ++(DEFUN DRAW-ELLIPSE-DRAW (D W OFF) ++ (LET ((C (LET ((GLVAR148 ++ (LET ((GLVAR147 ++ (LIST (* 1/2 (CAADDR D)) ++ (* 1/2 (CADR (CADDR D)))))) ++ (LIST (+ (CAADR D) (CAR GLVAR147)) ++ (+ (CADADR D) (CADR GLVAR147)))))) ++ (LIST (+ (CAR OFF) (CAR GLVAR148)) ++ (+ (CADR OFF) (CADR GLVAR148)))))) ++ (LET ((GLVAR149 (* 1/2 (CAADDR D))) ++ (GLVAR150 (* 1/2 (CADR (CADDR D))))) ++ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) ++ (- (CAR C) GLVAR149) (- (CADDDR W) (+ (CADR C) GLVAR150)) ++ (* 2 GLVAR149) (* 2 GLVAR150) 0 23040) ++ NIL))) ++ ++(DEFUN DRAW-ELLIPSE-SELECTEDP (D P OFF) ++ (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) ++ (< (ABS (- (+ (LET ((SELF (LET ((GLVAR156 ++ (IF ++ (> (CAADDR D) (CADR (CADDR D))) ++ (LIST ++ (ROUND ++ (- ++ (+ (CAADR D) ++ (* 1/2 (CAADDR D))) ++ (SQRT ++ (ABS ++ (* 1/4 ++ (- (EXPT (CAADDR D) 2) ++ (EXPT (CADR (CADDR D)) 2))))))) ++ (+ (CADADR D) ++ (* 1/2 (CADR (CADDR D))))) ++ (LIST ++ (+ (CAADR D) (* 1/2 (CAADDR D))) ++ (ROUND ++ (- ++ (+ (CADADR D) ++ (* 1/2 (CADR (CADDR D)))) ++ (SQRT ++ (ABS ++ (* 1/4 ++ (- (EXPT (CAADDR D) 2) ++ (EXPT (CADR (CADDR D)) 2))))))))))) ++ (LIST (- (CAR GLVAR156) (CAR PT)) ++ (- (CADR GLVAR156) (CADR PT)))))) ++ (SQRT (+ (EXPT (CAR SELF) 2) (EXPT (CADR SELF) 2)))) ++ (LET ((SELF (LET ((GLVAR161 ++ (IF ++ (> (CAADDR D) (CADR (CADDR D))) ++ (LIST ++ (ROUND ++ (+ ++ (+ (CAADR D) ++ (* 1/2 (CAADDR D))) ++ (SQRT ++ (ABS ++ (* 1/4 ++ (- (EXPT (CAADDR D) 2) ++ (EXPT (CADR (CADDR D)) 2))))))) ++ (+ (CADADR D) ++ (* 1/2 (CADR (CADDR D))))) ++ (LIST ++ (+ (CAADR D) (* 1/2 (CAADDR D))) ++ (ROUND ++ (+ ++ (+ (CADADR D) ++ (* 1/2 (CADR (CADDR D)))) ++ (SQRT ++ (ABS ++ (* 1/4 ++ (- (EXPT (CAADDR D) 2) ++ (EXPT (CADR (CADDR D)) 2))))))))))) ++ (LIST (- (CAR GLVAR161) (CAR PT)) ++ (- (CADR GLVAR161) (CADR PT)))))) ++ (SQRT (+ (EXPT (CAR SELF) 2) (EXPT (CADR SELF) 2))))) ++ (* 2 (MAX (* 1/2 (CAADDR D)) (* 1/2 (CADR (CADDR D))))))) ++ 2))) ++(SETF (GET 'DRAW-ELLIPSE-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-ELLIPSE) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-ELLIPSE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-TEST-ELLIPSE-SELECTEDP (E) ++ (LET ((SIZE (THIRD E)) (OFFSET (SECOND E))) ++ (DOTIMES (Y (+ (CADR SIZE) 10)) ++ (DOTIMES (X (+ (CAR SIZE) 10)) ++ (PRINC (IF (DRAW-ELLIPSE-SELECTEDP E ++ (LIST (+ X (CAR OFFSET) -5) ++ (+ Y (CADR OFFSET) -5)) ++ (LIST 0 0)) ++ "T" " "))) ++ (TERPRI)))) ++ ++(DEFUN DRAW-ELLIPSE-GET (DD W) ++ (LET (ELL CENT) ++ (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) ++ (SETQ ELL (WINDOW-GET-ELLIPSE W CENT)) ++ (LIST 'DRAW-ELLIPSE ++ (LIST (- (CAAR ELL) (CAADR ELL)) ++ (- (CADAR ELL) (CADADR ELL))) ++ (LIST (* 2 (CAADR ELL)) (* 2 (CADADR ELL))) NIL 1))) ++(SETF (GET 'DRAW-ELLIPSE-GET 'GLARGUMENTS) ++ '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-ELLIPSE-GET 'GLFNRESULTTYPE) 'DRAW-ELLIPSE) ++ ++ ++(DEFUN DRAW-NULL-DRAW (D W OFF) NIL) ++ ++(DEFUN DRAW-NULL-SELECTEDP (D PT OFF) NIL) ++ ++(DEFUN DRAW-BUTTON-DRAW (D W OFF) ++ (LET ((GLVAR162 ++ (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D)))) ++ (GLVAR163 (COPY-LIST '(4 4)))) ++ (WINDOW-DRAW-BOX-XY W (CAR GLVAR162) (CADR GLVAR162) (CAR GLVAR163) ++ (CADR GLVAR163) NIL))) ++ ++(DEFUN DRAW-BUTTON-SELECTEDP (D P OFF) ++ (LET ((PTX (- (- (CAR P) (CAR OFF)) (CAADR D))) ++ (PTY (- (- (CADR P) (CADR OFF)) (CADADR D)))) ++ (AND (> PTX -2) (< PTX 6) (> PTY -2) (< PTY 6)))) ++(SETF (GET 'DRAW-BUTTON-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-BUTTON) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-BUTTON-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-BUTTON-GET (DD W) ++ (LET (CENT VAR) ++ (PRINC "Enter button name: ") ++ (SETQ VAR (READ)) ++ (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) ++ (LIST 'DRAW-BUTTON (LIST (+ -2 (CAR CENT)) (+ -2 (CADR CENT))) ++ (COPY-LIST '(4 4)) VAR 1))) ++(SETF (GET 'DRAW-BUTTON-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-BUTTON-GET 'GLFNRESULTTYPE) 'DRAW-BUTTON) ++ ++ ++(DEFUN DRAW-ERASE-DRAW (D W OFF) ++ (LET ((GLVAR164 ++ (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D))))) ++ (WINDOW-ERASE-AREA-XY W (CAR GLVAR164) (CADR GLVAR164) (CAADDR D) ++ (CADR (CADDR D))))) ++ ++(DEFUN DRAW-ERASE-SELECTEDP (D P OFF) ++ (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) ++ (AND (BETWEEN (CAR PT) (CAADR D) (+ (CAADR D) (CAADDR D))) ++ (BETWEEN (CADR PT) (CADADR D) (+ (CADADR D) (CADR (CADDR D))))))) ++(SETF (GET 'DRAW-ERASE-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-ERASE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-ERASE-GET (DD W) ++ (LET (BOX) ++ (SETQ BOX (WINDOW-GET-REGION W)) ++ (LIST 'DRAW-ERASE (CAR BOX) (CADR BOX) NIL 1))) ++(SETF (GET 'DRAW-ERASE-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-ERASE-GET 'GLFNRESULTTYPE) 'DRAW-ERASE) ++ ++ ++(DEFUN DRAW-DOT-DRAW (D W OFF) ++ (WINDOW-DRAW-DOT-XY W (+ 2 (+ (CAR OFF) (CAADR D))) ++ (+ 2 (+ (CADR OFF) (CADADR D))))) ++ ++(DEFUN DRAW-DOT-GET (DD W) ++ (LET (CENT) ++ (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) ++ (LIST 'DRAW-DOT (LIST (+ -2 (CAR CENT)) (+ -2 (CADR CENT))) ++ (COPY-LIST '(4 4)) NIL 1))) ++(SETF (GET 'DRAW-DOT-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-DOT-GET 'GLFNRESULTTYPE) 'DRAW-DOT) ++ ++ ++(DEFUN DRAW-REFPT-DRAW (D W OFF) ++ (WINDOW-DRAW-CROSSHAIRS-XY W (+ (CAR OFF) (CAADR D)) ++ (+ (CADR OFF) (CADADR D)))) ++ ++(DEFUN DRAW-REFPT-SELECTEDP (D P OFF) ++ (LET ((PTX (- (- (CAR P) (CAR OFF)) (CAADR D))) ++ (PTY (- (- (CADR P) (CADR OFF)) (CADADR D)))) ++ (AND (> PTX -3) (< PTX 3) (> PTY -3) (< PTY 3)))) ++(SETF (GET 'DRAW-REFPT-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-BUTTON) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-REFPT-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-REFPT-GET (DD W) ++ (LET (CENT REFPT) ++ (WHEN (SETQ REFPT (ASSOC 'DRAW-REFPT (CADDR DD))) ++ (LET ((GC (CADDR *DRAW-WINDOW*))) ++ (SETQ *WINDOW-SAVE-FUNCTION* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR *DRAW-WINDOW*) 1 ++ *GC-VALUES*) ++ (XGCVALUES-FUNCTION *GC-VALUES*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC 3) ++ (SETQ *WINDOW-SAVE-FOREGROUND* ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR *DRAW-WINDOW*) 4 ++ *GC-VALUES*) ++ (XGCVALUES-FOREGROUND *GC-VALUES*))) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC ++ (PROGN ++ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR *DRAW-WINDOW*) 8 ++ *GC-VALUES*) ++ (XGCVALUES-BACKGROUND *GC-VALUES*)))) ++ (DRAW-OBJECT-DRAW REFPT *DRAW-WINDOW* (COPY-LIST '(0 0))) ++ (LET ((GC (CADDR *DRAW-WINDOW*))) ++ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) ++ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)) ++ (SETF (CADDR DD) (REMOVE REFPT (CADDR DD)))) ++ (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) ++ (LIST 'DRAW-REFPT CENT (COPY-LIST '(0 0)) NIL 1))) ++(SETF (GET 'DRAW-REFPT-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-REFPT-GET 'GLFNRESULTTYPE) 'DRAW-REFPT) ++ ++ ++(DEFUN DRAW-DESC-REFPT (DD) ++ (LET (REFPT) ++ (SETQ REFPT (ASSOC 'DRAW-REFPT (CADDR DD))) ++ (IF REFPT (CADR REFPT) (COPY-LIST '(0 0))))) ++(SETF (GET 'DRAW-DESC-REFPT 'GLARGUMENTS) '((DD DRAW-DESC))) ++(SETF (GET 'DRAW-DESC-REFPT 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-TEXT-DRAW (D W OFF) ++ (LET ((SSTR (STRINGIFY (CADDDR D)))) ++ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) ++ (+ (CAR OFF) (CAADR D)) ++ (- (CADDDR W) (+ (CADR OFF) (CADADR D))) (GET-C-STRING SSTR) ++ (LENGTH SSTR)))) ++ ++(DEFUN DRAW-TEXT-DRAW-OUTLINE (W X Y D) ++ (SETF (SECOND D) (LIST X Y)) ++ (WINDOW-DRAW-BOX-XY W X (+ 2 Y) (CAADDR D) (CADR (CADDR D)))) ++ ++(DEFUN DRAW-TEXT-DRAW-OUTLINE (W X Y D) ++ (SETF (SECOND D) (LIST X Y)) ++ (WINDOW-DRAW-BOX-XY W X (+ 2 Y) (CAADDR D) (CADR (CADDR D)))) ++ ++(DEFUN DRAW-TEXT-SELECTEDP (D PT OFF) ++ (LET ((PTP (LIST (- (CAR PT) (CAR OFF)) (- (CADR PT) (CADR OFF))))) ++ (AND (BETWEEN (CAR PTP) (+ -2 (+ (CAADR D) (MIN 0 (CAADDR D)))) ++ (+ 2 ++ (+ (+ (CAADR D) (MIN 0 (CAADDR D))) ++ (ABS (CAADDR D))))) ++ (BETWEEN (CADR PTP) ++ (+ -2 (+ (CADADR D) (MIN 0 (CADR (CADDR D))))) ++ (+ 2 ++ (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) ++ (ABS (CADR (CADDR D))))))))) ++(SETF (GET 'DRAW-TEXT-SELECTEDP 'GLARGUMENTS) ++ '((D DRAW-TEXT) (PT VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-TEXT-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) ++ ++ ++(DEFUN DRAW-TEXT-GET (DD W) ++ (LET (TXT LNG OFF) ++ (PRINC "Enter text string: ") ++ (SETQ TXT (STRINGIFY (READ))) ++ (SETQ LNG ++ (LET ((SSTR (STRINGIFY TXT))) ++ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) ++ (SETQ OFF (WINDOW-GET-BOX-POSITION W LNG 14)) ++ (LIST 'DRAW-TEXT ++ (LET ((GLVAR167 (COPY-LIST '(0 4)))) ++ (LIST (+ (CAR OFF) (CAR GLVAR167)) ++ (+ (CADR OFF) (CADR GLVAR167)))) ++ (LIST LNG 14) TXT 1))) ++(SETF (GET 'DRAW-TEXT-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) ++(SETF (GET 'DRAW-TEXT-GET 'GLFNRESULTTYPE) 'DRAW-TEXT) ++ ++ ++(DEFUN DRAW-SNAPP (P1 OFF P2X P2Y) ++ (IF (AND (< (ABS (- (- (CAR P1) (CAR OFF)) P2X)) 4) ++ (< (ABS (- (- (CADR P1) (CADR OFF)) P2Y)) 4)) ++ (LIST (+ (CAR OFF) P2X) (+ (CADR OFF) P2Y)))) ++(SETF (GET 'DRAW-SNAPP 'GLARGUMENTS) ++ '((P1 VECTOR) (OFF VECTOR) (P2X INTEGER) (P2Y INTEGER))) ++(SETF (GET 'DRAW-SNAPP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-DOT-SNAP (D P OFF) ++ (DRAW-SNAPP P OFF (+ 2 (CAADR D)) (+ 2 (CADADR D)))) ++(SETF (GET 'DRAW-DOT-SNAP 'GLARGUMENTS) ++ '((D DRAW-DOT) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-DOT-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-REFPT-SNAP (D P OFF) ++ (DRAW-SNAPP P OFF (CAADR D) (CADADR D))) ++(SETF (GET 'DRAW-REFPT-SNAP 'GLARGUMENTS) ++ '((D DRAW-REFPT) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-REFPT-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-LINE-SNAP (D P OFF) ++ (OR (DRAW-SNAPP P OFF (CAADR D) (CADADR D)) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) ++ (+ (CADADR D) (CADR (CADDR D)))))) ++(SETF (GET 'DRAW-LINE-SNAP 'GLARGUMENTS) ++ '((D DRAW-LINE) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-LINE-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-BOX-SNAP (D P OFF) ++ (LET ((XOFF (CAADR D)) (YOFF (CADADR D)) (XSIZE (CAADDR D)) ++ (YSIZE (CADR (CADDR D)))) ++ (OR (DRAW-SNAPP P OFF XOFF YOFF) ++ (DRAW-SNAPP P OFF (+ XOFF XSIZE) (+ YOFF YSIZE)) ++ (DRAW-SNAPP P OFF (+ XOFF XSIZE) YOFF) ++ (DRAW-SNAPP P OFF XOFF (+ YOFF YSIZE)) ++ (DRAW-SNAPP P OFF (+ XOFF (* 1/2 XSIZE)) YOFF) ++ (DRAW-SNAPP P OFF XOFF (+ YOFF (* 1/2 YSIZE))) ++ (DRAW-SNAPP P OFF (+ XOFF (* 1/2 XSIZE)) (+ YOFF YSIZE)) ++ (DRAW-SNAPP P OFF (+ XOFF XSIZE) (+ YOFF (* 1/2 YSIZE)))))) ++(SETF (GET 'DRAW-BOX-SNAP 'GLARGUMENTS) ++ '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-BOX-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-CIRCLE-SNAP (D P OFF) ++ (OR (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) ++ (+ (CADADR D) (* 1/2 (CAADDR D)))) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) (CADADR D)) ++ (DRAW-SNAPP P OFF (CAADR D) (+ (CADADR D) (* 1/2 (CAADDR D)))) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) ++ (+ (CADADR D) (CADR (CADDR D)))) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) ++ (+ (CADADR D) (* 1/2 (CAADDR D)))))) ++(SETF (GET 'DRAW-CIRCLE-SNAP 'GLARGUMENTS) ++ '((D DRAW-CIRCLE) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-CIRCLE-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-ELLIPSE-SNAP (D P OFF) ++ (OR (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) ++ (+ (CADADR D) (* 1/2 (CADR (CADDR D))))) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) (CADADR D)) ++ (DRAW-SNAPP P OFF (CAADR D) ++ (+ (CADADR D) (* 1/2 (CADR (CADDR D))))) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) ++ (+ (CADADR D) (CADR (CADDR D)))) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) ++ (+ (CADADR D) (* 1/2 (CADR (CADDR D))))))) ++(SETF (GET 'DRAW-ELLIPSE-SNAP 'GLARGUMENTS) ++ '((D DRAW-ELLIPSE) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-ELLIPSE-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-RCBOX-SNAP (D P OFF) ++ (LET ((RX (* 1/2 (CAADDR D))) (RY (* 1/2 (CADR (CADDR D))))) ++ (OR (DRAW-SNAPP P OFF (+ (CAADR D) RX) (CADADR D)) ++ (DRAW-SNAPP P OFF (CAADR D) (+ (CADADR D) RY)) ++ (DRAW-SNAPP P OFF (+ (CAADR D) RX) ++ (+ (CADADR D) (CADR (CADDR D)))) ++ (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) (+ (CADADR D) RY))))) ++(SETF (GET 'DRAW-RCBOX-SNAP 'GLARGUMENTS) ++ '((D DRAW-RCBOX) (P VECTOR) (OFF VECTOR))) ++(SETF (GET 'DRAW-RCBOX-SNAP 'GLFNRESULTTYPE) 'VECTOR) ++ ++ ++(DEFUN DRAW-NO-SNAP (D P OFF) NIL) ++ ++(DEFUN DRAW-MULTI-DRAW (D W OFF) ++ (LET ((TOTALOFF ++ (LIST (+ (CAADR D) (CAR OFF)) (+ (CADADR D) (CADR OFF))))) ++ (DOLIST (SUBD (CADDDR D)) (DRAW-OBJECT-DRAW SUBD W TOTALOFF)))) ++ ++(DEFUN DRAW-INIT-MENUS () ++ (LET ((W (DRAW-WINDOW))) ++ (WINDOW-CLEAR W) ++ (DOLIST (FN '(DRAW-MENU-RECTANGLE DRAW-MENU-CIRCLE ++ DRAW-MENU-ELLIPSE DRAW-MENU-LINE DRAW-MENU-ARROW ++ DRAW-MENU-DOT DRAW-MENU-BUTTON DRAW-MENU-TEXT)) ++ (SETF (GET FN 'DISPLAY-SIZE) '(30 20))) ++ (SETQ *DRAW-MENU-SET* (MENU-SET-CREATE W NIL)) ++ (MENU-SET-ADD-MENU *DRAW-MENU-SET* 'DRAW NIL "Draw" ++ '((DRAW-MENU-RECTANGLE . RECTANGLE) (DRAW-MENU-RCBOX . RCBOX) ++ (DRAW-MENU-CIRCLE . CIRCLE) (DRAW-MENU-ELLIPSE . ELLIPSE) ++ (DRAW-MENU-LINE . LINE) (DRAW-MENU-ARROW . ARROW) ++ (DRAW-MENU-DOT . DOT) (" " . ERASE) ++ (DRAW-MENU-BUTTON . BUTTON) (DRAW-MENU-TEXT . TEXT) ++ (DRAW-MENU-REFPT . REFPT)) ++ (LIST 0 0)) ++ (MENU-SET-ADJUST *DRAW-MENU-SET* 'DRAW 'TOP NIL 1) ++ (MENU-SET-ADJUST *DRAW-MENU-SET* 'DRAW 'RIGHT NIL 2) ++ (MENU-SET-ADD-MENU *DRAW-MENU-SET* 'COMMAND NIL "Commands" ++ '(("Done" . DONE) ("Move" . MOVE) ("Delete" . DELETE) ++ ("Copy" . COPY) ("Redraw" . REDRAW) ("Origin" . ORIGIN) ++ ("LaTex Mode" . LATEXMODE) ("Make Program" . PROGRAM) ++ ("Make LaTex" . LATEX)) ++ (LIST 0 0)) ++ (MENU-SET-ADJUST *DRAW-MENU-SET* 'COMMAND 'TOP 'DRAW 5) ++ (MENU-SET-ADJUST *DRAW-MENU-SET* 'COMMAND 'RIGHT NIL 2))) ++ ++(DEFUN DRAW-MENU-RECTANGLE (W X Y) ++ (WINDOW-DRAW-BOX-XY W (+ X 3) (+ Y 3) 24 14 1)) ++ ++(DEFUN DRAW-MENU-RCBOX (W X Y) ++ (WINDOW-DRAW-RCBOX-XY W (+ X 3) (+ Y 3) 24 14 3 1)) ++ ++(DEFUN DRAW-MENU-CIRCLE (W X Y) ++ (WINDOW-DRAW-CIRCLE-XY W (+ X 15) (+ Y 10) 8 1)) ++ ++(DEFUN DRAW-MENU-ELLIPSE (W X Y) ++ (WINDOW-DRAW-ELLIPSE-XY W (+ X 15) (+ Y 10) 12 8 1)) ++ ++(DEFUN DRAW-MENU-LINE (W X Y) ++ (WINDOW-DRAW-LINE-XY W (+ X 4) (+ Y 4) (+ X 26) (+ Y 16) 1)) ++ ++(DEFUN DRAW-MENU-ARROW (W X Y) ++ (WINDOW-DRAW-ARROW-XY W (+ X 4) (+ Y 4) (+ X 26) (+ Y 16) 1)) ++ ++(DEFUN DRAW-MENU-DOT (W X Y) (WINDOW-DRAW-DOT-XY W (+ X 15) (+ Y 10))) ++ ++(DEFUN DRAW-MENU-BUTTON (W X Y) ++ (WINDOW-DRAW-BOX-XY W (+ X 14) (+ Y 5) 4 4 1)) ++ ++(DEFUN DRAW-MENU-TEXT (W X Y) ++ (WINDOW-PRINTAT-XY W "A" (+ X 12) (+ Y 5))) ++ ++(DEFUN DRAW-MENU-REFPT (W X Y) ++ (WINDOW-DRAW-CROSSHAIRS-XY W (+ X 15) (+ Y 9)) ++ (WINDOW-DRAW-CIRCLE-XY W (+ X 15) (+ Y 9) 2)) ++ ++(DEFUN LATEX-LINE (FROMX FROMY X Y &OPTIONAL ARROWFLG) ++ (LET (DX DY SX SY SIZ ERR ERRB) ++ (SETQ DX (- X FROMX)) ++ (SETQ DY (- Y FROMY)) ++ (IF (= DX 0) ++ (PROGN ++ (SETQ SX 0) ++ (SETQ SY (IF (>= DY 0) 1 -1)) ++ (SETQ SIZ (* (ABS DY) *DRAW-LATEX-FACTOR*))) ++ (IF (= DY 0) ++ (PROGN ++ (SETQ SX (IF (>= DX 0) 1 -1)) ++ (SETQ SY 0) ++ (SETQ SIZ (* (ABS DX) *DRAW-LATEX-FACTOR*))) ++ (PROGN ++ (SETQ ERR 9999) ++ (SETQ SIZ (* (ABS DX) *DRAW-LATEX-FACTOR*)) ++ (DOTIMES (I (IF ARROWFLG 4 6)) ++ (DOTIMES (J (IF ARROWFLG 4 6)) ++ (SETQ ERRB ++ (ABS (- (/ (FLOAT (1+ I)) (FLOAT (1+ J))) ++ (ABS (/ (FLOAT DX) (FLOAT DY)))))) ++ (IF (AND (= (GCD (1+ I) (1+ J)) 1) (< ERRB ERR)) ++ (PROGN ++ (SETQ ERR ERRB) ++ (SETQ SX (1+ I)) ++ (SETQ SY (1+ J)))))) ++ (SETQ SX (* SX (LATEX-SIGN DX))) ++ (SETQ SY (* SY (LATEX-SIGN DY)))))) ++ (FORMAT T " \\put(~5,0F,~5,0F) {\\~A(~D,~D){~5,0F}}~%" ++ (* FROMX *DRAW-LATEX-FACTOR*) (* FROMY *DRAW-LATEX-FACTOR*) ++ (IF ARROWFLG "vector" "line") SX SY SIZ))) ++ ++(DEFUN LATEX-SIGN (X) (IF (>= X 0) 1 -1)) ++ ++(DEFUN DRAW-OUTPUT (OUTFILENAME &OPTIONAL NAMES) ++ (PROG (PRETTYSAVE LENGTHSAVE D FNNAME CODE) ++ (OR NAMES (SETQ NAMES *DRAW-OBJECTS*)) ++ (IF (SYMBOLP NAMES) (SETQ NAMES (LIST NAMES))) ++ (WITH-OPEN-FILE ++ (OUTFILE OUTFILENAME :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE) ++ (SETQ PRETTYSAVE *PRINT-PRETTY*) ++ (SETQ LENGTHSAVE *PRINT-LENGTH*) ++ (SETQ *PRINT-PRETTY* T) ++ (SETQ *PRINT-LENGTH* 80) ++ (FORMAT OUTFILE "; ~A ~A~%" OUTFILENAME (DRAW-GET-TIME-STRING)) ++ (DOLIST (NAME NAMES) ++ (IF (SETQ D (GET NAME 'DRAW-DESCR)) ++ (PROGN ++ (TERPRI OUTFILE) ++ (PRINT (LIST 'SETF ++ (LIST 'GET (LIST 'QUOTE NAME) ''DRAW-DESCR) ++ (LIST 'QUOTE D)) ++ OUTFILE) ++ (IF (AND (SETQ FNNAME (DRAW-DESC-FNNAME D)) ++ (SETQ CODE (SYMBOL-FUNCTION FNNAME))) ++ (PROGN ++ (TERPRI OUTFILE) ++ (PRINT (CONS 'DEFUN ++ (IF (EQ (CAR CODE) 'LAMBDA-BLOCK) ++ (CDR CODE) ++ (CONS FNNAME (CDR CODE)))) ++ OUTFILE))))) ++ (IF (SETQ D (GET NAME 'PICMENU-SPEC)) ++ (PROGN ++ (TERPRI OUTFILE) ++ (PRINT (LIST 'SETF ++ (LIST 'GET (LIST 'QUOTE NAME) ++ ''PICMENU-SPEC) ++ (LIST 'QUOTE D)) ++ OUTFILE)))) ++ (TERPRI OUTFILE) ++ (SETQ *PRINT-PRETTY* PRETTYSAVE) ++ (SETQ *PRINT-LENGTH* LENGTHSAVE)) ++ (RETURN OUTFILENAME))) ++ ++(DEFUN DRAW-GET-TIME-STRING () ++ (LET (SECOND MINUTE HOUR DATE MONTH YEAR) ++ (MULTIPLE-VALUE-SETQ (SECOND MINUTE HOUR DATE MONTH YEAR) ++ (GET-DECODED-TIME)) ++ (FORMAT NIL "~2D ~A ~4D ~2D:~2D:~2D" DATE ++ (NTH (1- MONTH) ++ '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" ++ "Sep" "Oct" "Nov" "Dec")) ++ YEAR HOUR MINUTE SECOND))) ++ ++(DEFUN COMPILE-DRAW () ++ (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") ++ '("glisp/menu-set.lsp" "glisp/draw.lsp") "glisp/drawtrans.lsp" ++ "glisp/draw-header.lsp") ++ (CF DRAWTRANS)) ++ ++(DEFUN COMPILE-DRAWB () ++ (GLCOMPFILES *DIRECTORY* ++ '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") ++ '("glisp/menu-set.lsp" "glisp/draw.lsp") "glisp/drawtrans.lsp" ++ "glisp/draw-header.lsp")) ++ ++(DEFUN DRAW-OUT (&OPTIONAL NAMES FILE) ++ (OR NAMES (SETQ NAMES *DRAW-OBJECTS*)) ++ (IF (NOT (CONSP NAMES)) (SETQ NAMES (LIST NAMES))) ++ (DRAW-OUTPUT (OR FILE "glisp/draw.del") NAMES) ++ (SETQ *DRAW-OBJECTS* (SET-DIFFERENCE *DRAW-OBJECTS* NAMES)) ++ NAMES) +--- /dev/null ++++ gcl-2.6.7/xgcl-2/gcl_sysinit.lsp +@@ -0,0 +1,69 @@ ++; Copyright (c) 1994 William F. Schelter ++ ++; See the files gnu.license and dec.copyright . ++ ++; This program 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 1, or (at your option) ++; any later version. ++ ++; This program 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 program; if not, write to the Free Software ++; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++; See the file dec.copyright for details. ++ ++(in-package :XLIB) ++ ++;; This file is used for defining the C function user_init, to run the ++;; initialization code from a list of files in *files*. These files ++;; should have been compiled with (compile-file "foo.lsp" :system-p t) ++;; and have been linked into the image. It presumes the .o files ++;; are in the current directory, and the files *files* are in the proper ++;; order to be loaded. ++ ++;;define a function USER::USER-INIT, which will run the init code for a set ++;;of files which are linked into an image. ++ ++(clines "#define init_or_load(fn,file) do {extern void fn(void); gcl_init_or_load1(fn,file);} while(0)") ++(clines "static void") ++(clines "load1(char *x) {") ++(clines "printf(\"loading %s\\n\",x);") ++(clines "fflush(stdout);") ++(clines "load(x);") ++(clines "}") ++ ++#. ++(let ((files *files*)) ++ (declare (special object-path)) ++ (with-open-file (st "maxobjs" :direction :output) ++ `(progn ++ (clines "object user_init() {") ++ (clines "load1(\"../xgcl-2/sysdef.lisp\");") ++ ,@(sloop::sloop for x in files ++ for f = (substitute #\_ #\- x) ++ for ff = (namestring (merge-pathnames (make-pathname :type "o") (pathname (format nil "~a.lsp" x)))) ++ do (princ ff st) (princ " " st) ++ collect ++ `(clines ,(Format nil "init_or_load(init_~a,\"~a\");" (string-downcase f) ff)) ++ finally (terpri st) ++ )) ++ ++ )) ++ ++(clines "return Cnil;}") ++ ++;; invoke this to initialize maxima. ++ ++;; make this if you dont want the invocation done automatically. ++;(defentry user::user-init () "user_init") ++ ++ ++ ++ +--- gcl-2.6.7.orig/ansi-tests/makefile ++++ gcl-2.6.7/ansi-tests/makefile +@@ -1,9 +1,10 @@ ++-include ../makedefs ++ ++test-unixport: ++ echo "(load \"gclload.lsp\")" | ../unixport/saved_ansi_gcl$(EXE) | tee test.out + + test: + echo "(load \"gclload.lsp\")" | gcl | tee test.out + +-test-unixport: +- echo "(load \"gclload.lsp\")" | ../unixport/saved_ansi_gcl | tee test.out +- + clean: + rm -f test.out *.fasl *.o *.so *~ *.fn *.x86f *.fasl *.ufsl +--- /dev/null ++++ gcl-2.6.7/gmp4/randmts.c +@@ -0,0 +1,157 @@ ++/* Mersenne Twister pseudo-random number generator functions. ++ ++Copyright 2002, 2003 Free Software Foundation, Inc. ++ ++This file is part of the GNU MP Library. ++ ++The GNU MP Library is free software; you can redistribute it and/or modify ++it under the terms of the GNU Lesser General Public License as published by ++the Free Software Foundation; either version 3 of the License, or (at your ++option) any later version. ++ ++The GNU MP Library 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 Lesser General Public ++License for more details. ++ ++You should have received a copy of the GNU Lesser General Public License ++along with the GNU MP Library. If not, see http://www.gnu.org/licenses/. */ ++ ++#include "gmp.h" ++#include "gmp-impl.h" ++#include "randmt.h" ++ ++ ++/* Calculate (b^e) mod (2^n-k) for e=1074888996, n=19937 and k=20023, ++ needed by the seeding function below. */ ++static void ++mangle_seed (mpz_ptr r, mpz_srcptr b_orig) ++{ ++ mpz_t t, b; ++ unsigned long e = 0x40118124; ++ unsigned long bit = 0x20000000; ++ ++ mpz_init (t); ++ mpz_init_set (b, b_orig); /* in case r==b_orig */ ++ ++ mpz_set (r, b); ++ do ++ { ++ mpz_mul (r, r, r); ++ ++ reduce: ++ for (;;) ++ { ++ mpz_tdiv_q_2exp (t, r, 19937L); ++ if (mpz_sgn (t) == 0) ++ break; ++ mpz_tdiv_r_2exp (r, r, 19937L); ++ mpz_addmul_ui (r, t, 20023L); ++ } ++ ++ if ((e & bit) != 0) ++ { ++ e &= ~bit; ++ mpz_mul (r, r, b); ++ goto reduce; ++ } ++ ++ bit >>= 1; ++ } ++ while (bit != 0); ++ ++ mpz_clear (t); ++ mpz_clear (b); ++} ++ ++ ++/* Seeding function. Uses powering modulo a non-Mersenne prime to obtain ++ a permutation of the input seed space. The modulus is 2^19937-20023, ++ which is probably prime. The power is 1074888996. In order to avoid ++ seeds 0 and 1 generating invalid or strange output, the input seed is ++ first manipulated as follows: ++ ++ seed1 = seed mod (2^19937-20027) + 2 ++ ++ so that seed1 lies between 2 and 2^19937-20026 inclusive. Then the ++ powering is performed as follows: ++ ++ seed2 = (seed1^1074888996) mod (2^19937-20023) ++ ++ and then seed2 is used to bootstrap the buffer. ++ ++ This method aims to give guarantees that: ++ a) seed2 will never be zero, ++ b) seed2 will very seldom have a very low population of ones in its ++ binary representation, and ++ c) every seed between 0 and 2^19937-20028 (inclusive) will yield a ++ different sequence. ++ ++ CAVEATS: ++ ++ The period of the seeding function is 2^19937-20027. This means that ++ with seeds 2^19937-20027, 2^19937-20026, ... the exact same sequences ++ are obtained as with seeds 0, 1, etc.; it also means that seed -1 ++ produces the same sequence as seed 2^19937-20028, etc. ++ */ ++ ++static void ++randseed_mt (gmp_randstate_t rstate, mpz_srcptr seed) ++{ ++ int i; ++ size_t cnt; ++ ++ gmp_rand_mt_struct *p; ++ mpz_t mod; /* Modulus. */ ++ mpz_t seed1; /* Intermediate result. */ ++ ++ p = (gmp_rand_mt_struct *) RNG_STATE (rstate); ++ ++ mpz_init (mod); ++ mpz_init (seed1); ++ ++ mpz_set_ui (mod, 0L); ++ mpz_setbit (mod, 19937L); ++ mpz_sub_ui (mod, mod, 20027L); ++ mpz_mod (seed1, seed, mod); /* Reduce `seed' modulo `mod'. */ ++ mpz_add_ui (seed1, seed1, 2L); /* seed1 is now ready. */ ++ mangle_seed (seed1, seed1); /* Perform the mangling by powering. */ ++ ++ /* Copy the last bit into bit 31 of mt[0] and clear it. */ ++ p->mt[0] = (mpz_tstbit (seed1, 19936L) != 0) ? 0x80000000 : 0; ++ mpz_clrbit (seed1, 19936L); ++ ++ /* Split seed1 into N-1 32-bit chunks. */ ++ mpz_export (&p->mt[1], &cnt, -1, sizeof (p->mt[1]), 0, ++ 8 * sizeof (p->mt[1]) - 32, seed1); ++ cnt++; ++ ASSERT (cnt <= N); ++ while (cnt < N) ++ p->mt[cnt++] = 0; ++ ++ mpz_clear (mod); ++ mpz_clear (seed1); ++ ++ /* Warm the generator up if necessary. */ ++ if (WARM_UP != 0) ++ for (i = 0; i < WARM_UP / N; i++) ++ __gmp_mt_recalc_buffer (p->mt); ++ ++ p->mti = WARM_UP % N; ++} ++ ++ ++static const gmp_randfnptr_t Mersenne_Twister_Generator = { ++ randseed_mt, ++ __gmp_randget_mt, ++ __gmp_randclear_mt, ++ __gmp_randiset_mt ++}; ++ ++/* Initialize MT-specific data. */ ++void ++gmp_randinit_mt (gmp_randstate_t rstate) ++{ ++ __gmp_randinit_mt_noseed (rstate); ++ RNG_FNPTR (rstate) = (void *) &Mersenne_Twister_Generator; ++} +--- /dev/null ++++ gcl-2.6.7/gmp4/acinclude.m4 +@@ -0,0 +1,3868 @@ ++dnl GMP specific autoconf macros ++ ++ ++dnl Copyright 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2009 Free Software ++dnl Foundation, Inc. ++dnl ++dnl This file is part of the GNU MP Library. ++dnl ++dnl The GNU MP Library is free software; you can redistribute it and/or modify ++dnl it under the terms of the GNU Lesser General Public License as published ++dnl by the Free Software Foundation; either version 3 of the License, or (at ++dnl your option) any later version. ++dnl ++dnl The GNU MP Library is distributed in the hope that it will be useful, but ++dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ++dnl or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public ++dnl License for more details. ++dnl ++dnl You should have received a copy of the GNU Lesser General Public License ++dnl along with the GNU MP Library. If not, see http://www.gnu.org/licenses/. ++ ++ ++dnl Some tests use, or must delete, the default compiler output. The ++dnl possible filenames are based on what autoconf looks for, namely ++dnl ++dnl a.out - normal unix style ++dnl b.out - i960 systems, including gcc there ++dnl a.exe - djgpp ++dnl a_out.exe - OpenVMS DEC C called via GNV wrapper (gnv.sourceforge.net) ++dnl conftest.exe - various DOS compilers ++ ++ ++define(IA64_PATTERN, ++[[ia64*-*-* | itanium-*-* | itanium2-*-*]]) ++ ++dnl Need to be careful not to match m6811, m6812, m68hc11 and m68hc12, all ++dnl of which config.sub accepts. (Though none of which are likely to work ++dnl with GMP.) ++dnl ++define(M68K_PATTERN, ++[[m68k-*-* | m68[0-9][0-9][0-9]-*-*]]) ++ ++define(POWERPC64_PATTERN, ++[[powerpc64-*-* | powerpc64le-*-* | powerpc620-*-* | powerpc630-*-* | powerpc970-*-* | power[3-9]-*-*]]) ++ ++define(X86_PATTERN, ++[[i?86*-*-* | k[5-8]*-*-* | pentium*-*-* | athlon-*-* | viac3*-*-* | geode*-*-*]]) ++ ++ ++dnl GMP_FAT_SUFFIX(DSTVAR, DIRECTORY) ++dnl --------------------------------- ++dnl Emit code to set shell variable DSTVAR to the suffix for a fat binary ++dnl routine from DIRECTORY. DIRECTORY can be a shell expression like $foo ++dnl etc. ++dnl ++dnl The suffix is directory separators / or \ changed to underscores, and ++dnl if there's more than one directory part, then the first is dropped. ++dnl ++dnl For instance, ++dnl ++dnl x86 -> x86 ++dnl x86/k6 -> k6 ++dnl x86/k6/mmx -> k6_mmx ++ ++define(GMP_FAT_SUFFIX, ++[[$1=`echo $2 | sed -e '/\//s:^[^/]*/::' -e 's:[\\/]:_:g'`]]) ++ ++ ++dnl GMP_REMOVE_FROM_LIST(listvar,item) ++dnl ---------------------------------- ++dnl Emit code to remove any occurrence of ITEM from $LISTVAR. ITEM can be a ++dnl shell expression like $foo if desired. ++ ++define(GMP_REMOVE_FROM_LIST, ++[remove_from_list_tmp= ++for remove_from_list_i in $[][$1]; do ++ if test $remove_from_list_i = [$2]; then :; ++ else ++ remove_from_list_tmp="$remove_from_list_tmp $remove_from_list_i" ++ fi ++done ++[$1]=$remove_from_list_tmp ++]) ++ ++ ++dnl GMP_STRIP_PATH(subdir) ++dnl ---------------------- ++dnl Strip entries */subdir from $path and $fat_path. ++ ++define(GMP_STRIP_PATH, ++[GMP_STRIP_PATH_VAR(path, [$1]) ++GMP_STRIP_PATH_VAR(fat_path, [$1]) ++]) ++ ++define(GMP_STRIP_PATH_VAR, ++[tmp_path= ++for i in $[][$1]; do ++ case $i in ++ */[$2]) ;; ++ *) tmp_path="$tmp_path $i" ;; ++ esac ++done ++[$1]="$tmp_path" ++]) ++ ++ ++dnl GMP_INCLUDE_GMP_H ++dnl ----------------- ++dnl Expand to the right way to #include gmp-h.in. This must be used ++dnl instead of gmp.h, since that file isn't generated until the end of the ++dnl configure. ++dnl ++dnl Dummy values for __GMP_BITS_PER_MP_LIMB and GMP_LIMB_BITS are enough ++dnl for all current configure-time uses of gmp.h. ++ ++define(GMP_INCLUDE_GMP_H, ++[[#define __GMP_WITHIN_CONFIGURE 1 /* ignore template stuff */ ++#define GMP_NAIL_BITS $GMP_NAIL_BITS ++#define __GMP_BITS_PER_MP_LIMB 123 /* dummy for GMP_NUMB_BITS etc */ ++#define GMP_LIMB_BITS 123 ++$DEFN_LONG_LONG_LIMB ++#include "$srcdir/gmp-h.in"] ++]) ++ ++ ++dnl GMP_HEADER_GETVAL(NAME,FILE) ++dnl ---------------------------- ++dnl Expand at autoconf time to the value of a "#define NAME" from the given ++dnl FILE. The regexps here aren't very rugged, but are enough for gmp. ++dnl /dev/null as a parameter prevents a hang if $2 is accidentally omitted. ++ ++define(GMP_HEADER_GETVAL, ++[patsubst(patsubst( ++esyscmd([grep "^#define $1 " $2 /dev/null 2>/dev/null]), ++[^.*$1[ ]+],[]), ++[[ ++ ]*$],[])]) ++ ++ ++dnl GMP_VERSION ++dnl ----------- ++dnl The gmp version number, extracted from the #defines in gmp-h.in at ++dnl autoconf time. Two digits like 3.0 if patchlevel <= 0, or three digits ++dnl like 3.0.1 if patchlevel > 0. ++ ++define(GMP_VERSION, ++[GMP_HEADER_GETVAL(__GNU_MP_VERSION,gmp-h.in)[]dnl ++.GMP_HEADER_GETVAL(__GNU_MP_VERSION_MINOR,gmp-h.in)[]dnl ++.GMP_HEADER_GETVAL(__GNU_MP_VERSION_PATCHLEVEL,gmp-h.in)]) ++ ++ ++dnl GMP_SUBST_CHECK_FUNCS(func,...) ++dnl ------------------------------ ++dnl Setup an AC_SUBST of HAVE_FUNC_01 for each argument. ++ ++AC_DEFUN([GMP_SUBST_CHECK_FUNCS], ++[m4_if([$1],,, ++[_GMP_SUBST_CHECK_FUNCS(ac_cv_func_[$1],HAVE_[]m4_translit([$1],[a-z],[A-Z])_01) ++GMP_SUBST_CHECK_FUNCS(m4_shift($@))])]) ++ ++dnl Called: _GMP_SUBST_CHECK_FUNCS(cachevar,substvar) ++AC_DEFUN([_GMP_SUBST_CHECK_FUNCS], ++[case $[$1] in ++yes) AC_SUBST([$2],1) ;; ++no) [$2]=0 ;; ++esac ++]) ++ ++ ++dnl GMP_SUBST_CHECK_HEADERS(foo.h,...) ++dnl ---------------------------------- ++dnl Setup an AC_SUBST of HAVE_FOO_H_01 for each argument. ++ ++AC_DEFUN([GMP_SUBST_CHECK_HEADERS], ++[m4_if([$1],,, ++[_GMP_SUBST_CHECK_HEADERS(ac_cv_header_[]m4_translit([$1],[./],[__]), ++HAVE_[]m4_translit([$1],[a-z./],[A-Z__])_01) ++GMP_SUBST_CHECK_HEADERS(m4_shift($@))])]) ++ ++dnl Called: _GMP_SUBST_CHECK_HEADERS(cachevar,substvar) ++AC_DEFUN([_GMP_SUBST_CHECK_HEADERS], ++[case $[$1] in ++yes) AC_SUBST([$2],1) ;; ++no) [$2]=0 ;; ++esac ++]) ++ ++ ++dnl GMP_COMPARE_GE(A1,B1, A2,B2, ...) ++dnl --------------------------------- ++dnl Compare two version numbers A1.A2.etc and B1.B2.etc. Set ++dnl $gmp_compare_ge to yes or no according to the result. The A parts ++dnl should be variables, the B parts fixed numbers. As many parts as ++dnl desired can be included. An empty string in an A part is taken to be ++dnl zero, the B parts should be non-empty and non-zero. ++dnl ++dnl For example, ++dnl ++dnl GMP_COMPARE($major,10, $minor,3, $subminor,1) ++dnl ++dnl would test whether $major.$minor.$subminor is greater than or equal to ++dnl 10.3.1. ++ ++AC_DEFUN([GMP_COMPARE_GE], ++[gmp_compare_ge=no ++GMP_COMPARE_GE_INTERNAL($@) ++]) ++ ++AC_DEFUN([GMP_COMPARE_GE_INTERNAL], ++[ifelse(len([$3]),0, ++[if test -n "$1" && test "$1" -ge $2; then ++ gmp_compare_ge=yes ++fi], ++[if test -n "$1"; then ++ if test "$1" -gt $2; then ++ gmp_compare_ge=yes ++ else ++ if test "$1" -eq $2; then ++ GMP_COMPARE_GE_INTERNAL(m4_shift(m4_shift($@))) ++ fi ++ fi ++fi]) ++]) ++ ++ ++dnl GMP_PROG_AR ++dnl ----------- ++dnl GMP additions to $AR. ++dnl ++dnl A cross-"ar" may be necessary when cross-compiling since the build ++dnl system "ar" might try to interpret the object files to build a symbol ++dnl table index, hence the use of AC_CHECK_TOOL. ++dnl ++dnl A user-selected $AR is always left unchanged. AC_CHECK_TOOL is still ++dnl run to get the "checking" message printed though. ++dnl ++dnl If extra flags are added to AR, then ac_cv_prog_AR and ++dnl ac_cv_prog_ac_ct_AR are set too, since libtool (cvs 2003-03-31 at ++dnl least) will do an AC_CHECK_TOOL and that will AR from one of those two ++dnl cached variables. (ac_cv_prog_AR is used if there's an ac_tool_prefix, ++dnl or ac_cv_prog_ac_ct_AR is used otherwise.) FIXME: This is highly ++dnl dependent on autoconf internals, perhaps it'd work to put our extra ++dnl flags into AR_FLAGS instead. ++dnl ++dnl $AR_FLAGS is set to "cq" rather than leaving it to libtool "cru". The ++dnl latter fails when libtool goes into piecewise mode and is unlucky ++dnl enough to have two same-named objects in separate pieces, as happens ++dnl for instance to random.o (and others) on vax-dec-ultrix4.5. Naturally ++dnl a user-selected $AR_FLAGS is left unchanged. ++dnl ++dnl For reference, $ARFLAGS is used by automake (1.8) for its ".a" archive ++dnl file rules. This doesn't get used by the piecewise linking, so we ++dnl leave it at the default "cru". ++dnl ++dnl FIXME: Libtool 1.5.2 has its own arrangements for "cq", but that version ++dnl is broken in other ways. When we can upgrade, remove the forcible ++dnl AR_FLAGS=cq. ++ ++AC_DEFUN([GMP_PROG_AR], ++[dnl Want to establish $AR before libtool initialization. ++AC_BEFORE([$0],[AC_PROG_LIBTOOL]) ++gmp_user_AR=$AR ++AC_CHECK_TOOL(AR, ar, ar) ++if test -z "$gmp_user_AR"; then ++ eval arflags=\"\$ar${abi1}_flags\" ++ test -n "$arflags" || eval arflags=\"\$ar${abi2}_flags\" ++ if test -n "$arflags"; then ++ AC_MSG_CHECKING([for extra ar flags]) ++ AR="$AR $arflags" ++ ac_cv_prog_AR="$AR $arflags" ++ ac_cv_prog_ac_ct_AR="$AR $arflags" ++ AC_MSG_RESULT([$arflags]) ++ fi ++fi ++if test -z "$AR_FLAGS"; then ++ AR_FLAGS=cq ++fi ++]) ++ ++ ++dnl GMP_PROG_M4 ++dnl ----------- ++dnl Find a working m4, either in $PATH or likely locations, and setup $M4 ++dnl and an AC_SUBST accordingly. If $M4 is already set then it's a user ++dnl choice and is accepted with no checks. GMP_PROG_M4 is like ++dnl AC_PATH_PROG or AC_CHECK_PROG, but tests each m4 found to see if it's ++dnl good enough. ++dnl ++dnl See mpn/asm-defs.m4 for details on the known bad m4s. ++ ++AC_DEFUN([GMP_PROG_M4], ++[AC_ARG_VAR(M4,[m4 macro processor]) ++AC_CACHE_CHECK([for suitable m4], ++ gmp_cv_prog_m4, ++[if test -n "$M4"; then ++ gmp_cv_prog_m4="$M4" ++else ++ cat >conftest.m4 <<\EOF ++dnl Must protect this against being expanded during autoconf m4! ++dnl Dont put "dnl"s in this as autoconf will flag an error for unexpanded ++dnl macros. ++[define(dollarhash,``$][#'')ifelse(dollarhash(x),1,`define(t1,Y)', ++``bad: $][# not supported (SunOS /usr/bin/m4) ++'')ifelse(eval(89),89,`define(t2,Y)', ++`bad: eval() doesnt support 8 or 9 in a constant (OpenBSD 2.6 m4) ++')ifelse(t1`'t2,YY,`good ++')] ++EOF ++dnl ' <- balance the quotes for emacs sh-mode ++ echo "trying m4" >&AC_FD_CC ++ gmp_tmp_val=`(m4 conftest.m4) 2>&AC_FD_CC` ++ echo "$gmp_tmp_val" >&AC_FD_CC ++ if test "$gmp_tmp_val" = good; then ++ gmp_cv_prog_m4="m4" ++ else ++ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ++dnl $ac_dummy forces splitting on constant user-supplied paths. ++dnl POSIX.2 word splitting is done only on the output of word expansions, ++dnl not every word. This closes a longstanding sh security hole. ++ ac_dummy="$PATH:/usr/5bin" ++ for ac_dir in $ac_dummy; do ++ test -z "$ac_dir" && ac_dir=. ++ echo "trying $ac_dir/m4" >&AC_FD_CC ++ gmp_tmp_val=`($ac_dir/m4 conftest.m4) 2>&AC_FD_CC` ++ echo "$gmp_tmp_val" >&AC_FD_CC ++ if test "$gmp_tmp_val" = good; then ++ gmp_cv_prog_m4="$ac_dir/m4" ++ break ++ fi ++ done ++ IFS="$ac_save_ifs" ++ if test -z "$gmp_cv_prog_m4"; then ++ AC_MSG_ERROR([No usable m4 in \$PATH or /usr/5bin (see config.log for reasons).]) ++ fi ++ fi ++ rm -f conftest.m4 ++fi]) ++M4="$gmp_cv_prog_m4" ++AC_SUBST(M4) ++]) ++ ++ ++dnl GMP_M4_M4WRAP_SPURIOUS ++dnl ---------------------- ++dnl Check for spurious output from m4wrap(), as described in mpn/asm-defs.m4. ++dnl ++dnl The following systems have been seen with the problem. ++dnl ++dnl - Unicos alpha, but its assembler doesn't seem to mind. ++dnl - MacOS X Darwin, its assembler fails. ++dnl - NetBSD 1.4.1 m68k, and gas 1.92.3 there gives a warning and ignores ++dnl the bad last line since it doesn't have a newline. ++dnl - NetBSD 1.4.2 alpha, but its assembler doesn't seem to mind. ++dnl - HP-UX ia64. ++dnl ++dnl Enhancement: Maybe this could be in GMP_PROG_M4, and attempt to prefer ++dnl an m4 with a working m4wrap, if it can be found. ++ ++AC_DEFUN([GMP_M4_M4WRAP_SPURIOUS], ++[AC_REQUIRE([GMP_PROG_M4]) ++AC_CACHE_CHECK([if m4wrap produces spurious output], ++ gmp_cv_m4_m4wrap_spurious, ++[# hide the d-n-l from autoconf's error checking ++tmp_d_n_l=d""nl ++cat >conftest.m4 <&AC_FD_CC ++cat conftest.m4 >&AC_FD_CC ++tmp_chars=`$M4 conftest.m4 | wc -c` ++echo produces $tmp_chars chars output >&AC_FD_CC ++rm -f conftest.m4 ++if test $tmp_chars = 0; then ++ gmp_cv_m4_m4wrap_spurious=no ++else ++ gmp_cv_m4_m4wrap_spurious=yes ++fi ++]) ++GMP_DEFINE_RAW(["define(,<$gmp_cv_m4_m4wrap_spurious>)"]) ++]) ++ ++ ++dnl GMP_PROG_NM ++dnl ----------- ++dnl GMP additions to libtool AC_PROG_NM. ++dnl ++dnl Note that if AC_PROG_NM can't find a working nm it still leaves ++dnl $NM set to "nm", so $NM can't be assumed to actually work. ++dnl ++dnl A user-selected $NM is always left unchanged. AC_PROG_NM is still run ++dnl to get the "checking" message printed though. ++dnl ++dnl Perhaps it'd be worthwhile checking that nm works, by running it on an ++dnl actual object file. For instance on sparcv9 solaris old versions of ++dnl GNU nm don't recognise 64-bit objects. Checking would give a better ++dnl error message than just a failure in later tests like GMP_ASM_W32 etc. ++dnl ++dnl On the other hand it's not really normal autoconf practice to take too ++dnl much trouble over detecting a broken set of tools. And libtool doesn't ++dnl do anything at all for say ranlib or strip. So for now we're inclined ++dnl to just demand that the user provides a coherent environment. ++ ++AC_DEFUN([GMP_PROG_NM], ++[dnl Make sure we're the first to call AC_PROG_NM, so our extra flags are ++dnl used by everyone. ++AC_BEFORE([$0],[AC_PROG_NM]) ++gmp_user_NM=$NM ++AC_PROG_NM ++ ++# FIXME: When cross compiling (ie. $ac_tool_prefix not empty), libtool ++# defaults to plain "nm" if a "${ac_tool_prefix}nm" is not found. In this ++# case run it again to try the native "nm", firstly so that likely locations ++# are searched, secondly so that -B or -p are added if necessary for BSD ++# format. This is necessary for instance on OSF with "./configure ++# --build=alphaev5-dec-osf --host=alphaev6-dec-osf". ++# ++if test -z "$gmp_user_NM" && test -n "$ac_tool_prefix" && test "$NM" = nm; then ++ $as_unset lt_cv_path_NM ++ gmp_save_ac_tool_prefix=$ac_tool_prefix ++ ac_tool_prefix= ++ NM= ++ AC_PROG_NM ++ ac_tool_prefix=$gmp_save_ac_tool_prefix ++fi ++ ++if test -z "$gmp_user_NM"; then ++ eval nmflags=\"\$nm${abi1}_flags\" ++ test -n "$nmflags" || eval nmflags=\"\$nm${abi2}_flags\" ++ if test -n "$nmflags"; then ++ AC_MSG_CHECKING([for extra nm flags]) ++ NM="$NM $nmflags" ++ AC_MSG_RESULT([$nmflags]) ++ fi ++fi ++]) ++ ++ ++dnl GMP_PROG_CC_WORKS(cc+cflags,[ACTION-IF-WORKS][,ACTION-IF-NOT-WORKS]) ++dnl -------------------------------------------------------------------- ++dnl Check if cc+cflags can compile and link. ++dnl ++dnl This test is designed to be run repeatedly with different cc+cflags ++dnl selections, so the result is not cached. ++dnl ++dnl For a native build, meaning $cross_compiling == no, we require that the ++dnl generated program will run. This is the same as AC_PROG_CC does in ++dnl _AC_COMPILER_EXEEXT_WORKS, and checking here will ensure we don't pass ++dnl a CC/CFLAGS combination that it rejects. ++dnl ++dnl sparc-*-solaris2.7 can compile ABI=64 but won't run it if the kernel ++dnl was booted in 32-bit mode. The effect of requiring the compiler output ++dnl will run is that a plain native "./configure" falls back on ABI=32, but ++dnl ABI=64 is still available as a cross-compile. ++dnl ++dnl The various specific problems we try to detect are done in separate ++dnl compiles. Although this is probably a bit slower than one test ++dnl program, it makes it easy to indicate the problem in AC_MSG_RESULT, ++dnl hence giving the user a clue about why we rejected the compiler. ++ ++AC_DEFUN([GMP_PROG_CC_WORKS], ++[AC_MSG_CHECKING([compiler $1]) ++gmp_prog_cc_works=yes ++ ++# first see a simple "main()" works, then go on to other checks ++GMP_PROG_CC_WORKS_PART([$1], []) ++ ++GMP_PROG_CC_WORKS_PART([$1], [function pointer return], ++[/* The following provokes an internal error from gcc 2.95.2 -mpowerpc64 ++ (without -maix64), hence detecting an unusable compiler */ ++void *g() { return (void *) 0; } ++void *f() { return g(); } ++]) ++ ++GMP_PROG_CC_WORKS_PART([$1], [cmov instruction], ++[/* The following provokes an invalid instruction syntax from i386 gcc ++ -march=pentiumpro on Solaris 2.8. The native sun assembler ++ requires a non-standard syntax for cmov which gcc (as of 2.95.2 at ++ least) doesn't know. */ ++int n; ++int cmov () { return (n >= 0 ? n : 0); } ++]) ++ ++GMP_PROG_CC_WORKS_PART([$1], [double -> ulong conversion], ++[/* The following provokes a linker invocation problem with gcc 3.0.3 ++ on AIX 4.3 under "-maix64 -mpowerpc64 -mcpu=630". The -mcpu=630 ++ option causes gcc to incorrectly select the 32-bit libgcc.a, not ++ the 64-bit one, and consequently it misses out on the __fixunsdfdi ++ helper (double -> uint64 conversion). */ ++double d; ++unsigned long gcc303 () { return (unsigned long) d; } ++]) ++ ++GMP_PROG_CC_WORKS_PART([$1], [double negation], ++[/* The following provokes an error from hppa gcc 2.95 under -mpa-risc-2-0 if ++ the assembler doesn't know hppa 2.0 instructions. fneg is a 2.0 ++ instruction, and a negation like this comes out using it. */ ++double fneg_data; ++unsigned long fneg () { return -fneg_data; } ++]) ++ ++GMP_PROG_CC_WORKS_PART([$1], [double -> float conversion], ++[/* The following makes gcc 3.3 -march=pentium4 generate an SSE2 xmm insn ++ (cvtsd2ss) which will provoke an error if the assembler doesn't recognise ++ those instructions. Not sure how much of the gmp code will come out ++ wanting sse2, but it's easiest to reject an option we know is bad. */ ++double ftod_data; ++float ftod () { return (float) ftod_data; } ++]) ++ ++GMP_PROG_CC_WORKS_PART([$1], [gnupro alpha ev6 char spilling], ++[/* The following provokes an internal compiler error from gcc version ++ "2.9-gnupro-99r1" under "-O2 -mcpu=ev6", apparently relating to char ++ values being spilled into floating point registers. The problem doesn't ++ show up all the time, but has occurred enough in GMP for us to reject ++ this compiler+flags. */ ++#include /* for memcpy */ ++struct try_t ++{ ++ char dst[2]; ++ char size; ++ long d0, d1, d2, d3, d4, d5, d6; ++ char overlap; ++}; ++struct try_t param[6]; ++int ++param_init () ++{ ++ struct try_t *p; ++ memcpy (p, ¶m[ 2 ], sizeof (*p)); ++ memcpy (p, ¶m[ 2 ], sizeof (*p)); ++ p->size = 2; ++ memcpy (p, ¶m[ 1 ], sizeof (*p)); ++ p->dst[0] = 1; ++ p->overlap = 2; ++ memcpy (p, ¶m[ 3 ], sizeof (*p)); ++ p->dst[0] = 1; ++ p->overlap = 8; ++ memcpy (p, ¶m[ 4 ], sizeof (*p)); ++ memcpy (p, ¶m[ 4 ], sizeof (*p)); ++ p->overlap = 8; ++ memcpy (p, ¶m[ 5 ], sizeof (*p)); ++ memcpy (p, ¶m[ 5 ], sizeof (*p)); ++ memcpy (p, ¶m[ 5 ], sizeof (*p)); ++ return 0; ++} ++]) ++ ++# __builtin_alloca is not available everywhere, check it exists before ++# seeing that it works ++GMP_PROG_CC_WORKS_PART_TEST([$1],[__builtin_alloca availability], ++[int k; int foo () { __builtin_alloca (k); }], ++ [GMP_PROG_CC_WORKS_PART([$1], [alloca array], ++[/* The following provokes an internal compiler error from Itanium HP-UX cc ++ under +O2 or higher. We use this sort of code in mpn/generic/mul_fft.c. */ ++int k; ++int foo () ++{ ++ int i, **a; ++ a = __builtin_alloca (k); ++ for (i = 0; i <= k; i++) ++ a[i] = __builtin_alloca (1 << i); ++} ++])]) ++ ++GMP_PROG_CC_WORKS_PART([$1], [abs int -> double conversion], ++[/* The following provokes an internal error from the assembler on ++ power2-ibm-aix4.3.1.0. gcc -mrios2 compiles to nabs+fcirz, and this ++ results in "Internal error related to the source program domain". ++ ++ For reference it seems to be the combination of nabs+fcirz which is bad, ++ not either alone. This sort of thing occurs in mpz/get_str.c with the ++ way double chars_per_bit_exactly is applied in MPN_SIZEINBASE. Perhaps ++ if that code changes to a scaled-integer style then we won't need this ++ test. */ ++ ++double fp[1]; ++int x; ++int f () ++{ ++ int a; ++ a = (x >= 0 ? x : -x); ++ return a * fp[0]; ++} ++]) ++ ++GMP_PROG_CC_WORKS_PART([$1], [long long reliability test 1], ++[/* The following provokes a segfault in the compiler on powerpc-apple-darwin. ++ Extracted from tests/mpn/t-iord_u.c. Causes Apple's gcc 3.3 build 1640 and ++ 1666 to segfault with e.g., -O2 -mpowerpc64. */ ++ ++#if defined (__GNUC__) && ! defined (__cplusplus) ++typedef unsigned long long t1;typedef t1*t2; ++static __inline__ t1 e(t2 rp,t2 up,int n,t1 v0) ++{t1 c,x,r;int i;if(v0){c=1;for(i=1;i> tnc; ++ high_limb = low_limb << cnt; ++ for (i = n - 1; i != 0; i--) ++ { ++ low_limb = *up++; ++ *rp++ = ~(high_limb | (low_limb >> tnc)); ++ high_limb = low_limb << cnt; ++ } ++ return retval; ++} ++int ++main () ++{ ++ unsigned long cy, rp[2], up[2]; ++ up[0] = ~ 0L; ++ up[1] = 0; ++ cy = lshift_com (rp, up, 2L, 1); ++ if (cy != 1L) ++ return 1; ++ return 0; ++} ++#else ++int ++main () ++{ ++ return 0; ++} ++#endif ++]) ++ ++GMP_PROG_CC_WORKS_PART_MAIN([$1], [mpn_lshift_com optimization 2], ++[/* The following is mis-compiled by Intel ia-64 icc version 1.8 under ++ "icc -O3", After several calls, the function writes parial garbage to ++ the result vector. Perhaps relates to the chk.a.nc insn. This code needs ++ to be run to show the problem, but that's fine, the offending cc is a ++ native-only compiler so we don't have to worry about cross compiling. */ ++ ++#if ! defined (__cplusplus) ++#include ++void ++lshift_com (rp, up, n, cnt) ++ unsigned long *rp; ++ unsigned long *up; ++ long n; ++ unsigned cnt; ++{ ++ unsigned long high_limb, low_limb; ++ unsigned tnc; ++ long i; ++ up += n; ++ rp += n; ++ tnc = 8 * sizeof (unsigned long) - cnt; ++ low_limb = *--up; ++ high_limb = low_limb << cnt; ++ for (i = n - 1; i != 0; i--) ++ { ++ low_limb = *--up; ++ *--rp = ~(high_limb | (low_limb >> tnc)); ++ high_limb = low_limb << cnt; ++ } ++ *--rp = ~high_limb; ++} ++int ++main () ++{ ++ unsigned long *r, *r2; ++ unsigned long a[88 + 1]; ++ long i; ++ for (i = 0; i < 88 + 1; i++) ++ a[i] = ~0L; ++ r = malloc (10000 * sizeof (unsigned long)); ++ r2 = r; ++ for (i = 0; i < 528; i += 22) ++ { ++ lshift_com (r2, a, ++ i / (8 * sizeof (unsigned long)) + 1, ++ i % (8 * sizeof (unsigned long))); ++ r2 += 88 + 1; ++ } ++ if (r[2048] != 0 || r[2049] != 0 || r[2050] != 0 || r[2051] != 0 || ++ r[2052] != 0 || r[2053] != 0 || r[2054] != 0) ++ abort (); ++ return 0; ++} ++#else ++int ++main () ++{ ++ return 0; ++} ++#endif ++]) ++ ++ ++# A certain _GLOBAL_OFFSET_TABLE_ problem in past versions of gas, tickled ++# by recent versions of gcc. ++# ++if test "$gmp_prog_cc_works" = yes; then ++ case $host in ++ X86_PATTERN) ++ # this problem only arises in PIC code, so don't need to test when ++ # --disable-shared. We don't necessarily have $enable_shared set to ++ # yes at this point, it will still be unset for the default (which is ++ # yes); hence the use of "!= no". ++ if test "$enable_shared" != no; then ++ GMP_PROG_CC_X86_GOT_EAX_EMITTED([$1], ++ [GMP_ASM_X86_GOT_EAX_OK([$1],, ++ [gmp_prog_cc_works="no, bad gas GOT with eax"])]) ++ fi ++ ;; ++ esac ++fi ++ ++AC_MSG_RESULT($gmp_prog_cc_works) ++case $gmp_prog_cc_works in ++ yes) ++ [$2] ++ ;; ++ *) ++ [$3] ++ ;; ++esac ++]) ++ ++dnl Called: GMP_PROG_CC_WORKS_PART(CC+CFLAGS,FAIL-MESSAGE [,CODE]) ++dnl A dummy main() is appended to the CODE given. ++dnl ++AC_DEFUN([GMP_PROG_CC_WORKS_PART], ++[GMP_PROG_CC_WORKS_PART_MAIN([$1],[$2], ++[$3] ++[int main () { return 0; }]) ++]) ++ ++dnl Called: GMP_PROG_CC_WORKS_PART_MAIN(CC+CFLAGS,FAIL-MESSAGE,CODE) ++dnl CODE must include a main(). ++dnl ++AC_DEFUN([GMP_PROG_CC_WORKS_PART_MAIN], ++[GMP_PROG_CC_WORKS_PART_TEST([$1],[$2],[$3], ++ [], ++ gmp_prog_cc_works="no[]m4_if([$2],,,[[, ]])[$2]", ++ gmp_prog_cc_works="no[]m4_if([$2],,,[[, ]])[$2][[, program does not run]]") ++]) ++ ++dnl Called: GMP_PROG_CC_WORKS_PART_TEST(CC+CFLAGS,TITLE,[CODE], ++dnl [ACTION-GOOD],[ACTION-BAD][ACTION-NORUN]) ++dnl ++AC_DEFUN([GMP_PROG_CC_WORKS_PART_TEST], ++[if test "$gmp_prog_cc_works" = yes; then ++ # remove anything that might look like compiler output to our "||" expression ++ rm -f conftest* a.out b.out a.exe a_out.exe ++ cat >conftest.c <&AC_FD_CC ++ gmp_compile="$1 conftest.c >&AC_FD_CC" ++ if AC_TRY_EVAL(gmp_compile); then ++ cc_works_part=yes ++ if test "$cross_compiling" = no; then ++ if AC_TRY_COMMAND([./a.out || ./b.out || ./a.exe || ./a_out.exe || ./conftest]); then :; ++ else ++ cc_works_part=norun ++ fi ++ fi ++ else ++ cc_works_part=no ++ fi ++ if test "$cc_works_part" != yes; then ++ echo "failed program was:" >&AC_FD_CC ++ cat conftest.c >&AC_FD_CC ++ fi ++ rm -f conftest* a.out b.out a.exe a_out.exe ++ case $cc_works_part in ++ yes) ++ $4 ++ ;; ++ no) ++ $5 ++ ;; ++ norun) ++ $6 ++ ;; ++ esac ++fi ++]) ++ ++ ++dnl GMP_PROG_CC_WORKS_LONGLONG(cc+cflags,[ACTION-YES][,ACTION-NO]) ++dnl -------------------------------------------------------------- ++dnl Check that cc+cflags accepts "long long". ++dnl ++dnl This test is designed to be run repeatedly with different cc+cflags ++dnl selections, so the result is not cached. ++ ++AC_DEFUN([GMP_PROG_CC_WORKS_LONGLONG], ++[AC_MSG_CHECKING([compiler $1 has long long]) ++cat >conftest.c <&AC_FD_CC ++ cat conftest.c >&AC_FD_CC ++fi ++rm -f conftest* a.out b.out a.exe a_out.exe ++AC_MSG_RESULT($gmp_prog_cc_works) ++if test $gmp_prog_cc_works = yes; then ++ ifelse([$2],,:,[$2]) ++else ++ ifelse([$3],,:,[$3]) ++fi ++]) ++ ++ ++dnl GMP_C_TEST_SIZEOF(cc/cflags,test,[ACTION-GOOD][,ACTION-BAD]) ++dnl ------------------------------------------------------------ ++dnl The given cc/cflags compiler is run to check the size of a type ++dnl specified by the "test" argument. "test" can either be a string, or a ++dnl variable like $foo. The value should be for instance "sizeof-long-4", ++dnl to test that sizeof(long)==4. ++dnl ++dnl This test is designed to be run for different compiler and/or flags ++dnl combinations, so the result is not cached. ++dnl ++dnl The idea for making an array that has a negative size if the desired ++dnl condition test is false comes from autoconf AC_CHECK_SIZEOF. The cast ++dnl to "long" in the array dimension also follows autoconf, apparently it's ++dnl a workaround for a HP compiler bug. ++ ++AC_DEFUN([GMP_C_TEST_SIZEOF], ++[echo "configure: testlist $2" >&AC_FD_CC ++[gmp_sizeof_type=`echo "$2" | sed 's/sizeof-\([a-z]*\).*/\1/'`] ++[gmp_sizeof_want=`echo "$2" | sed 's/sizeof-[a-z]*-\([0-9]*\).*/\1/'`] ++AC_MSG_CHECKING([compiler $1 has sizeof($gmp_sizeof_type)==$gmp_sizeof_want]) ++cat >conftest.c <conftest.c <    		" outfile) -+ (if (char= c #\{) -+ (if *verbatim* -+ (princ #\{ outfile) -+ (pushenv nil)) -+ (if (char= c #\}) -+ (if *verbatim* -+ (princ #\} outfile) -+ (popenv outfile)) -+ (if (and (char= c #\$) (not *verbatim*)) -+ (if (eq (car *modestack*) '$) -+ (popenv outfile) -+ (pushfont '$ outfile)) -+ (if (and (or (char= c #\^) (char= c #\_)) -+ (eq (car *modestack*) '$)) -+ (progn -+ (pushfont (if (char= c #\^) 'sup 'sub) outfile) -+ (searchfor #\{)) -+ (princ (if (char= c #\>) "> " -+ (if (char= c #\<) "< " -+ c)) -+ outfile))))))))) )) -+ -+; 24 Jul 02; 25 Jul 02; 29 Jul 02; 12 Feb 03; 28 Aug 03 -+(defun docommand (outfile) -+ (let (wordstring word subword termch done tmp c pair (saveptr (1- *ptr*))) -+ (setq wordstring (car (parse-word nil))) -+ (setq word (intern (string-upcase wordstring))) -+ (case word -+ ((documentstyle pagestyle setlength hyphenpenalty sloppy -+ large) -+ (flushline)) -+ (setcounter (searchfor #\{) -+ (setq subword (intern (car (parse-word t)))) -+ (when (eq subword 'page) -+ (searchfor #\{) -+ (setq *pagenumber* (1- (parse-int))) ; assumes pagebreak -+ (flushline)) ) -+ (addtocounter (searchfor #\{) -+ (setq subword (intern (car (parse-word t)))) -+ (when (eq subword 'page) -+ (searchfor #\{) -+ (setq *pagenumber* (+ *pagenumber* (parse-int))) -+ (flushline)) ) -+ (includegraphics (searchfor #\{) (searchforalpha) -+ (setq done nil) -+ (while (not done) -+ (setq tmp (parse-word nil)) -+ (if (char= (cadr tmp) #\}) -+ (setq done t) -+ (if (char= (cadr tmp) #\.) -+ (progn (setq done t) -+ (princ "" outfile) -+ (terpri outfile) -+ (flushline) ) -+ (incf *ptr*))))) -+ (begin (searchfor #\{) -+ (setq subword (intern (car (parse-word t)))) -+ (searchfor #\}) -+ ; (format t "subword = ~s~%" subword) -+ (case subword -+ (document (setq *ignore* nil)) -+ (center (pushenv 'center)) -+ (itemize (princ "
      " outfile) (terpri outfile)) -+ (enumerate (princ "
        " outfile) (terpri outfile)) -+ (verbatim (princ "
        " outfile) (terpri outfile)
-+		    (setq *verbatim* t))
-+	  (tabular (dotabular outfile))
-+	  ((quotation abstract quote)
-+	    (princ "
        " outfile) (terpri outfile))
-+	  ))
-+      (end (searchfor #\{)
-+	(setq subword (intern (car (parse-word t))))
-+	(searchfor #\})
-+	(case subword
-+	  (document (setq *feof* t))
-+	  (center (popenv outfile))
-+	  (itemize (princ "
    " outfile) (terpri outfile)) -+ (enumerate (princ "" outfile) (terpri outfile)) -+ (verbatim (princ "" outfile) (terpri outfile) -+ (setq *verbatim* nil)) -+ (tabular (princ "
    " outfile) (terpri outfile) -+ (popenv outfile)) -+ ((quotation abstract quote) -+ (princ "" outfile) (terpri outfile)) -+ )) -+ (item (princ "

  • " outfile)) -+ (pagebreak (setq *done* t) (incf *pagenumber*)) -+ ((bf tt em it) (pushfont word outfile)) -+ ((title section subsection subsubsection paragraph) -+ (searchfor #\{) -+ (pushfont (cadr (assoc word '((title h1) (section h2) -+ (subsection h3) (subsubsection h4) -+ (paragraph b)))) -+ outfile)) -+ ((vspace vspace*) (searchfor #\}) -+ (princ "

    " outfile) (terpri outfile)) -+ ((hspace hspace*) (searchfor #\}) -+ (dotimes (i 8) (princ " " outfile))) -+ ((index) (searchfor #\})) ; ignore and consume -+ (verb (setq termch (char *line* *ptr*)) -+ (incf *ptr*) -+ (pushfont 'tt outfile) -+ (xferchars outfile termch) -+ (popenv outfile) ) -+ ((cite bibitem) (searchfor #\{) -+ (princ "[" outfile) -+ (xferchars outfile #\}) -+ (princ "]" outfile) ) -+ (footnote (searchfor #\{) -+ (princ "[" outfile) -+ (pushenv 'footnote)) -+ (t (if *verbatim* -+ (while (< saveptr *ptr*) -+ (princ (char *line* saveptr) outfile) -+ (incf saveptr)) -+ (if (setq pair (assoc wordstring *specials* :test #'string=)) -+ (princ (cadr pair) outfile)) ) ) ) )) -+ -+; push a new item on the mode stack -+(defun pushenv (item) -+ (if (and *modestack* (eq (car *modestack*) nil)) -+ (setf (car *modestack*) item) -+ (push item *modestack*))) -+ -+; 24 Jul 02; 25 Jul 02 -+(defun popenv (outfile) -+ (let ((item (pop *modestack*)) new) -+ (setq new (cadr (assoc item '((em i) (bf b) (it i) ($ i))))) -+ (case item -+ ((bf tt it em $ h1 h2 h3 h4 sub sup) -+ (princ "" outfile)) -+ (footnote (princ "]" outfile)) -+ ) -+ item)) -+ -+(defun pushfont (word outfile) -+ (let ((new (cadr (assoc word '((em i) (bf b) (it i) ($ i)))))) -+ (pushenv word) -+ (princ "<" outfile) (princ (or new word) outfile) -+ (princ ">" outfile) )) -+ -+; transfer chars to output until termch -+(defun xferchars (outfile termch) -+ (let (done) -+ (while (and (< *ptr* *lng*) (not done)) -+ (setq c (char *line* *ptr*)) -+ (incf *ptr*) -+ (if (char= c termch) -+ (setq done t) -+ (princ c outfile)) ) )) -+ -+(defun dotabular (outfile) -+ (let ((ncols 0) done) -+ (searchfor #\{) -+ (while (and (< *ptr* *lng*) (not done)) -+ (setq c (char *line* *ptr*)) -+ (incf *ptr*) -+ (if (char= c #\}) -+ (setq done t) -+ (if (or (char= c #\l) (char= c #\r) (char= c #\c)) -+ (incf ncols))) ) -+ (princ "" outfile) -+ (terpri outfile) -+ (princ "" outfile) -+ (terpri outfile) -+ (princ "
    " outfile) -+ (pushenv 'table) -+ )) -+ -+(defun termline (outfile) -+ (if (eq (car *modestack*) 'table) -+ (progn (princ "
    " outfile)) -+ (progn (princ "
    " outfile) (terpri outfile) ))) -+ -+(defun safe-char () -+ (if (< *ptr* *lng*) -+ (char *line* *ptr*) -+ #\Space)) -+ -+; Parse a word of alpha/num characters -+; Returns ("word" ch) where ch is the terminating character -+(defun parse-word (upper) -+ (let (c res) -+ (while (and (< *ptr* *lng*) -+ (or (alpha-char-p (setq c (char *line* *ptr*))) -+ (and res (digit-char-p c)) -+ (char= c #\*))) -+ (push (if upper (char-upcase c) c) res) -+ (incf *ptr*)) -+ (if res (list (coerce (nreverse res) 'string) -+ (and (not (alpha-char-p c)) c))) )) -+ -+(defun searchfor (ch) -+ (let (c) -+ (while (and (< *ptr* *lng*) -+ (setq c (char *line* *ptr*)) -+ (not (char= ch c))) -+ (incf *ptr*)) -+ (if (and c (char= ch c)) (incf *ptr*)) -+ c)) -+ -+(defun searchforalpha () -+ (while (and (< *ptr* *lng*) -+ (not (alpha-char-p (char *line* *ptr*)))) -+ (incf *ptr*))) -+ -+(defun flushline () (setq *lng* 0)) -+ -+(defun stringify (x) -+ (cond ((stringp x) x) -+ ((symbolp x) (symbol-name x)) -+ (t (princ-to-string x)))) -+ -+; Parse an integer -+(defun parse-int () -+ (let (c (n 0) digit found) -+ (while (and (< *ptr* *lng*) -+ (setq digit (digit-char-p -+ (setq c (char *line* *ptr*))))) -+ (setq found (or found digit)) -+ (setq n (+ (* n 10) digit)) -+ (incf *ptr*)) -+ (if found n) )) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_draw.lsp -@@ -0,0 +1,1089 @@ -+; draw.lsp Gordon S. Novak Jr. ; 06 Dec 07 -+ -+; Functions to make drawings interactively -+ -+; Copyright (c) 2007 Gordon S. Novak Jr. and The University of Texas at Austin. -+ -+; 11 Nov 94; 05 Jan 95; 15 Jan 98; 09 Feb 99; 04 Dec 00; 28 Feb 02; 05 Jan 04 -+; 27 Jan 06 -+ -+; See the file gnu.license -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Written by: Gordon S. Novak Jr., Department of Computer Sciences, -+; University of Texas at Austin 78712. novak@cs.utexas.edu -+ -+ -+; Use (draw 'foo) to make a drawing named foo. -+; When finished with the drawing, give commands "Origin - to zero", "Program". -+; This will produce a program (DRAW-FOO w x y) to make the drawing. -+; The LaTex command will print Latex input to make the drawing -+; (but LaTex cannot draw things as well as the draw program). -+; (draw-output &optional names) will save things in a file for later. -+ -+; The small square in the drawing menu is a "button" for picture menus. -+; If buttons are used, a picmenu-spec will be produced with the program. -+ -+(defvar *draw-window* nil) -+(defvar *draw-window-width* 600) -+(defvar *draw-window-height* 600) -+(defvar *draw-leave-window* nil) ; t to leave window displayed at end -+(defvar *draw-menu-set* nil) -+(defvar *draw-zero-vector* '(0 0) ) -+(defvar *draw-latex-factor* 1) ; multiplier from pixels to LaTex -+(defvar *draw-snap-flag* t) -+(defvar *draw-objects* nil) -+(defvar *draw-latex-mode* nil) -+ -+(glispglobals (*draw-window* window) ) -+ -+(defmacro draw-descr (name) `(get ,name 'draw-descr)) -+ -+(glispobjects -+ -+(draw-desc (listobject (name symbol) -+ (objects (listof draw-object)) -+ (offset vector) -+ (size vector)) -+ prop ((fnname draw-desc-fnname) -+ (refpt draw-desc-refpt)) -+ msg ((draw draw-desc-draw) -+ (snap draw-desc-snap) -+ (find draw-desc-find) -+ (delete draw-desc-delete)) ) -+ -+(draw-object (listobject (offset vector) -+ (size vector) -+ (contents anything) -+ (linewidth integer)) -+ default ((linewidth 1)) -+ prop ((region ((virtual region with start = offset size = size))) -+ (vregion ((virtual region with start = vstart size = vsize))) -+ (vstart ((virtual vector with -+ x = (min (x offset) ((x offset) + (x size))) - 2 -+ y = (min (y offset) ((y offset) + (y size))) - 2))) -+ (vsize ((virtual vector with x = (abs (x size)) + 4 -+ y = (abs (y size)) + 4))) ) -+ msg ((erase draw-object-erase) -+ (draw draw-object-draw) -+ (snap draw-object-snap) -+ (selectedp draw-object-selectedp) -+ (move draw-object-move)) ) -+ -+(draw-line (listobject (offset vector) -+ (size vector) -+ (contents anything) -+ (linewidth integer)) -+ prop ((line ((virtual line-segment with p1 = offset -+ p2 = (offset + size))))) -+ msg ((draw draw-line-draw) -+ (snap draw-line-snap) -+ (selectedp draw-line-selectedp) ) -+ supers (draw-object) ) -+ -+(draw-arrow (listobject (offset vector) -+ (size vector) -+ (contents anything) -+ (linewidth integer)) -+ prop ((line ((virtual line-segment with p1 = offset -+ p2 = (offset + size))))) -+ msg ((draw draw-arrow-draw) -+ (snap draw-line-snap) -+ (selectedp draw-line-selectedp) ) -+ supers (draw-object) ) -+ -+(draw-box (listobject (offset vector) -+ (size vector) -+ (contents anything) -+ (linewidth integer)) -+ msg ((draw draw-box-draw) -+ (snap draw-box-snap) -+ (selectedp draw-box-selectedp) ) -+ supers (draw-object) ) -+ -+(draw-rcbox (listobject (offset vector) -+ (size vector) -+ (contents anything) -+ (linewidth integer)) -+ msg ((draw draw-rcbox-draw) -+ (snap draw-rcbox-snap) -+ (selectedp draw-rcbox-selectedp) ) -+ supers (draw-object) ) -+ -+(draw-erase (listobject (offset vector) -+ (size vector) -+ (contents anything) -+ (linewidth integer)) -+ msg ((draw draw-erase-draw) -+ (snap draw-no-snap) -+ (selectedp draw-erase-selectedp) ) -+ supers (draw-object) ) -+ -+(draw-circle (listobject (offset vector) -+ (size vector) -+ (contents anything) -+ (linewidth integer)) -+ prop ((radius ((x size) / 2)) -+ (center (offset + size / 2))) -+ msg ((draw draw-circle-draw) -+ (snap draw-circle-snap) -+ (selectedp draw-circle-selectedp) ) -+ supers (draw-object) ) -+ -+(draw-ellipse (listobject (offset vector) -+ (size vector) -+ (contents anything) -+ (linewidth integer)) -+ prop ((radiusx ((x size) / 2)) -+ (radiusy ((y size) / 2)) -+ (radius ((max radiusx radiusy))) -+ (center (offset + size / 2)) -+ (delta ((sqrt (abs (radiusx ^ 2 - radiusy ^ 2))))) -+ (p1 ((if (radiusx > radiusy) ; 05 Jan 04 -+ (a vector x = (x center) - delta -+ y = (y center)) -+ (a vector x = (x center) -+ y = (y center) - delta)))) -+ (p2 ((if (radiusx > radiusy) -+ (a vector x = (x center) + delta -+ y = (y center)) -+ (a vector x = (x center) -+ y = (y center) + delta)))) ) -+ msg ((draw draw-ellipse-draw) -+ (snap draw-ellipse-snap) -+ (selectedp draw-ellipse-selectedp) ) -+ supers (draw-object) ) -+ -+(draw-dot (listobject (offset vector) -+ (size vector) -+ (contents anything) -+ (linewidth integer)) -+ msg ((draw draw-dot-draw) -+ (snap draw-dot-snap) -+ (selectedp draw-button-selectedp) ) -+ supers (draw-object) ) -+ -+(draw-button (listobject (offset vector) -+ (size vector) -+ (contents anything) -+ (linewidth integer)) -+ msg ((draw draw-button-draw) -+ (snap draw-dot-snap) -+ (selectedp draw-button-selectedp) ) -+ supers (draw-object) ) -+ -+(draw-text (listobject (offset vector) -+ (size vector) -+ (contents anything) -+ (linewidth integer)) -+ msg ((draw draw-text-draw) -+ (snap draw-no-snap) -+ (selectedp draw-text-selectedp) ) -+ supers (draw-object) ) -+ -+; null object: no image, cannot be selected. -+(draw-null (listobject (offset vector) -+ (size vector) -+ (contents anything) -+ (linewidth integer)) -+ msg ((draw draw-null-draw) -+ (snap draw-no-snap) -+ (selectedp draw-null-selectedp) ) -+ supers (draw-object) ) -+ -+(draw-refpt (listobject (offset vector) -+ (size vector) -+ (contents anything) -+ (linewidth integer)) -+ msg ((draw draw-refpt-draw) -+ (snap draw-refpt-snap) -+ (selectedp draw-refpt-selectedp) ) -+ supers (draw-object) ) -+ -+; multi-item drawing group -+(draw-multi (listobject (offset vector) -+ (size vector) -+ (contents (listof draw-object)) -+ (linewidth integer)) -+ msg ((draw draw-multi-draw) -+ (snap draw-no-snap) -+ (selectedp draw-multi-selectedp) ) -+ supers (draw-object) ) -+ -+ -+) ; glispobjects -+ -+; 05 Jan 04 -+; Get drawing description associated with name -+(gldefun draw-desc ((name symbol)) -+ (result draw-desc) -+ (let ((dd draw-desc)) -+ (dd = (draw-descr name)) -+ (if ~ dd (progn (dd = (a draw-desc with name = name)) -+ (setf (draw-descr name) dd))) -+ dd)) -+ -+; Make a window to draw in. -+(setf (glfnresulttype 'draw-window) 'window) -+(defun draw-window () -+ (or *draw-window* -+ (setq *draw-window* -+ (window-create *draw-window-width* *draw-window-height* -+ "Draw window"))) ) -+ -+; 09 Sep 92; 11 Sep 92; 14 Sep 92; 16 Sep 92; 21 Oct 92; 21 May 93; 17 Dec 93 -+; 05 Jan 04 -+(gldefun draw ((name symbol)) -+ (let (w dd done sel (redraw t) (new draw-object)) -+ (w = (draw-window)) -+ (open w) -+ (or *draw-menu-set* (draw-init-menus)) -+ (dd = (draw-desc name)) -+ (unless (member name *draw-objects*) -+ (setq *draw-objects* (nconc *draw-objects* (list name)))) -+ (draw dd w) -+ (while ~ done do -+ (sel = (menu-set-select *draw-menu-set* redraw)) -+ (redraw = nil) -+ (case (menu-name sel) -+ (command -+ (case (port sel) -+ (done (done = t)) -+ (move (draw-desc-move dd w)) -+ (delete (draw-desc-delete dd w)) -+ (copy (draw-desc-copy dd w)) -+ (redraw (clear w) -+ (setq redraw t) -+ (draw dd w)) -+ (origin (draw-desc-origin dd w) -+ (clear w) -+ (setq redraw t) -+ (draw dd w)) -+ (program (draw-desc-program dd)) -+ (latex (draw-desc-latex dd)) -+ (latexmode (setq *draw-latex-mode* (not *draw-latex-mode*)) -+ (format t "Latex Mode is now ~A~%" *draw-latex-mode*)) -+ )) -+ (draw -+ (new = nil) -+ (case (port sel) -+ (rectangle (new = (draw-box-get dd w))) -+ (rcbox (new = (draw-rcbox-get dd w))) -+ (circle (new = (draw-circle-get dd w))) -+ (ellipse (new = (draw-ellipse-get dd w))) -+ (line (new = (draw-line-get dd w))) -+ (arrow (new = (draw-arrow-get dd w))) -+ (dot (new = (draw-dot-get dd w))) -+ (erase (new = (draw-erase-get dd w))) -+ (button (new = (draw-button-get dd w))) -+ (text (new = (draw-text-get dd w))) -+ (refpt (new = (draw-refpt-get dd w)))) -+ (if new -+ (progn ((offset new) _- (offset dd)) -+ ((objects dd) _+ new) -+ (draw new w (offset dd))))) -+ (background nil)) ) -+ (setf (draw-descr name) dd) -+ (unless *draw-leave-window* (close w)) -+ name )) -+ -+; 06 Dec 07 -+; Copy a draw description to another name -+(defun copy-draw-desc (from to) -+ (let (old) -+ (setq old (copy-tree (get from 'draw-descr))) -+ (setf (get to 'draw-descr) -+ (cons (car old) (cons to (cddr old))) ) )) -+ -+; 09 Sep 92 -+(gldefun draw-desc-draw ((dd draw-desc) (w window)) -+ (let ( (off (offset dd)) ) -+ (clear w) -+ (for obj in (objects dd) (draw obj w off)) -+ (force-output w) )) -+ -+; 11 Sep 92; 12 Sep 92; 06 Oct 92; 05 Jan 04 -+; Find a draw-object such that point p selects it -+(gldefun draw-desc-selected ((dd draw-desc) (p vector)) -+ (result draw-object) -+ (let (objs objsb obj) -+ (objs = (for obj in objects when (selectedp obj p (offset dd)) -+ collect obj)) -+ (if objs -+ (if (null (rest objs)) -+ (obj = (first objs)) -+ (progn (objsb = (for z in objs -+ when (member (first z) -+ '(draw-button draw-dot)) -+ collect z)) -+ (if (and objsb (null (rest objsb))) -+ (obj = (first objsb)))) ) ) -+ obj)) -+ -+; 11 Sep 92; 12 Sep 92; 13 Sep 92; 05 Jan 04 -+; Find a draw-object such that point p selects it -+(gldefun draw-desc-find ((dd draw-desc) (w window) &optional (crossflg boolean)) -+ (result draw-object) -+ (let (p obj) -+ (while ~ obj do -+ (p = (if crossflg (draw-get-cross dd w) -+ (draw-get-crosshairs dd w))) -+ (obj = (draw-desc-selected dd p)) ) -+ obj)) -+ -+; 15 Sep 92 -+(gldefun draw-get-cross ((dd draw-desc) (w window)) -+ (result vector) -+ (draw-desc-snap dd (window-get-cross w))) -+ -+; 15 Sep 92 -+(gldefun draw-get-crosshairs ((dd draw-desc) (w window)) -+ (result vector) -+ (draw-desc-snap dd (window-get-crosshairs w))) -+ -+; 12 Sep 92; 14 Sep 92; 06 Oct 92 -+; Delete selected object -+(gldefun draw-desc-delete ((dd draw-desc) (w window)) -+ (let (obj) -+ (obj = (draw-desc-find dd w t)) -+ (erase obj w (offset dd)) -+ ((objects dd) _- obj) )) -+ -+; 12 Sep 92; 07 Oct 92 -+; Copy selected object -+(gldefun draw-desc-copy ((dd draw-desc) (w window)) -+ (let (obj (objb draw-object)) -+ (obj = (draw-desc-find dd w)) -+ (objb = (copy-tree obj)) -+ (draw-get-object-pos objb w) -+ ((offset objb) _- (offset dd)) -+ (draw objb w (offset dd)) -+ (force-output w) -+ ((objects dd) _+ objb) )) -+ -+; 12 Sep 92; 13 Sep 92; 07 Oct 92; 05 Jan 04 -+; Move selected object -+(gldefun draw-desc-move ((dd draw-desc) (w window)) -+ (let (obj) -+ (if (obj = (draw-desc-find dd w)) -+ (move obj w (offset dd))) )) -+ -+; 14 Sep 92; 28 Feb 02; 05 Jan 04; 27 Jan 06 -+; Reset origin of object group -+(gldefun draw-desc-origin ((dd draw-desc) (w window)) -+ (let (sel) -+ (draw-desc-bounds dd) -+ (sel = (menu '(("To zero" . tozero) ("Select" . select)))) -+ (if (sel == 'select) -+ ((offset dd) = (get-box-position w (x (size dd)) (y (size dd)))) -+ (if (sel == 'tozero) ((offset dd) = (a vector x 0 y 0)) ) ))) -+ -+; 14 Sep 92 -+; Compute boundaries of objects in a drawing; set offset and size of -+; the draw-desc and reset offsets of items relative to it. -+(gldefun draw-desc-bounds ((dd draw-desc)) -+ (let ((xmin 9999) (ymin 9999) (xmax 0) (ymax 0) basev) -+ (for obj in objects do -+ (xmin = (min xmin (x (offset obj)) -+ ((x (offset obj)) + (x (size obj))))) -+ (ymin = (min ymin (y (offset obj)) -+ ((y (offset obj)) + (y (size obj))))) -+ (xmax = (max xmax (x (offset obj)) -+ ((x (offset obj)) + (x (size obj))))) -+ (ymax = (max ymax (y (offset obj)) -+ ((y (offset obj)) + (y (size obj))))) ) -+ ((x (size dd)) = (xmax - xmin)) -+ ((y (size dd)) = (ymax - ymin)) -+ (basev = (a vector with x = xmin y = ymin)) -+ ((offset dd) = basev) -+ (for obj in objects do ((offset obj) _- basev)) )) -+ -+; 14 Sep 92; 16 Sep 92; 19 Dec 93; 15 Jan 98; 06 Dec 07 -+; Produce LaTex output for object group. -+; LaTex can only *approximately* reproduce the picture. -+(gldefun draw-desc-latex ((dd draw-desc)) -+ (let (base bx by sx sy) -+ (format t " \\begin{picture}(~5,0F,~5,0F)(0,0)~%" -+ (* (x (size dd)) *draw-latex-factor*) -+ (* (y (size dd)) *draw-latex-factor*) ) -+ (for obj in (objects dd) do -+ (base = (offset dd) + (offset obj)) -+ (bx = (x base) * *draw-latex-factor*) -+ (by = (y base) * *draw-latex-factor*) -+ (sx = (x (size obj)) * *draw-latex-factor*) -+ (sy = (y (size obj)) * *draw-latex-factor*) -+ (case (first obj) -+ (draw-line (latex-line (x base) (y base) -+ ((x base) + sx) ((y base) + sy))) -+ (draw-arrow (latex-line (x base) (y base) -+ ((x base) + sx) ((y base) + sy) t) ) -+ (draw-box -+ (format t " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" -+ bx by sx sy)) -+ (draw-rcbox -+ (format t " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" -+ (bx + sx / 2) (by + sy / 2) sx sy)) -+ (draw-circle -+ (format t " \\put(~5,0F,~5,0F) {\\circle{~5,0F}}~%" -+ (bx + sx / 2) (by + sy / 2) sx)) -+ (draw-ellipse -+ (format t " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" -+ (bx + sx / 2) (by + sy / 2) sx sy)) -+ (draw-button -+ (format t " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" -+ bx by sx sy)) -+ (draw-erase ) -+ (draw-dot -+ (format t " \\put(~5,0F,~5,0F) {\\circle*{~5,0F}}~%" -+ (bx + sx / 2) (by + sy / 2) sx)) -+ (draw-text -+ (format t " \\put(~5,0F,~5,0F) {~A}~%" -+ bx (by + 4 * *draw-latex-factor*) (contents obj)) ) ) ) -+ (format t " \\end{picture}~%") )) -+ -+; 14 Sep 92; 15 Sep 92; 16 Sep 92; 05 Oct 92; 17 Dec 93; 21 Dec 93; 28 Feb 02 -+; 05 Jan 04 -+; Produce program to draw object group -+(gldefun draw-desc-program ((dd draw-desc)) -+ (let (base bx by sx sy tox toy r rx ry s code fncode fnname cd) -+ (code = (for obj in (objects dd) when -+ (cd = (progn -+ (base = (offset dd) + (offset obj) - (refpt dd)) -+ (bx = (x base)) -+ (by = (y base)) -+ (sx = (x (size obj))) -+ (sy = (y (size obj))) -+ (tox = bx + sx) -+ (toy = by + sy) -+ (if ((car obj) == 'draw-circle) -+ (r = (x (size obj)) / 2)) -+ (if ((car obj) == 'draw-ellipse) -+ (progn (rx = (x (size obj)) / 2) -+ (ry = (y (size obj)) / 2))) -+ (draw-optimize -+ (case (first obj) -+ (draw-line `(window-draw-line-xy w (+ x ,bx) (+ y ,by) -+ (+ x ,tox) (+ y ,toy))) -+ (draw-arrow `(window-draw-arrow-xy w (+ x ,bx) (+ y ,by) -+ (+ x ,tox) (+ y ,toy))) -+ (draw-box `(window-draw-box-xy w (+ x ,bx) (+ y ,by) -+ ,sx ,sy)) -+ (draw-rcbox `(window-draw-rcbox-xy w (+ x ,bx) (+ y ,by) -+ ,sx ,sy 8)) -+ (draw-circle `(window-draw-circle-xy w (+ x ,(+ r bx)) -+ (+ y ,(+ r by)) ,r)) -+ (draw-ellipse `(window-draw-ellipse-xy w (+ x ,(+ rx bx)) -+ (+ y ,(+ ry by)) -+ ,rx ,ry)) -+ ((draw-button draw-refpt) -+ nil) ; let picmenu draw the buttons -+ (draw-erase `(window-erase-area-xy w (+ x ,bx) (+ y ,by) -+ ,sx ,sy)) -+ (draw-dot `(window-draw-dot-xy w (+ x ,(+ 2 bx)) -+ (+ y ,(+ 2 by)))) -+ (draw-text (s = (stringify (contents obj))) -+ `(window-printat-xy w ,s (+ x ,bx) (+ y ,by))) -+ )) )) -+ collect cd)) -+ (fncode = (cons 'lambda (cons (list 'w 'x 'y) -+ (nconc code -+ (list (list 'window-force-output -+ 'w)))))) -+ (fnname = (fnname dd)) -+ (setf (symbol-function fnname) fncode) -+ (format t "Constructed program (~A w x y)~%" fnname) -+ (draw-desc-picmenu dd) -+ )) -+ -+; 21 Dec 93 -+; Optimize code if GLISP is present -+(defun draw-optimize (x) (if (fboundp 'glunwrap) (glunwrap x nil) x)) -+ -+; 14 Sep 92 -+(gldefun draw-desc-fnname ((dd draw-desc)) -+ (intern (concatenate 'string "DRAW-" (symbol-name (name dd)))) ) -+ -+; 14 Sep 92; 06 Oct 92; 08 Apr 93; 28 Feb 02; 05 Jan 04 -+; Produce a picmenu-spec from the buttons of a drawing description -+(gldefun draw-desc-picmenu ((dd draw-desc)) -+ (let (buttons) -+ (buttons = (for obj in (objects dd) when ((first obj) == 'draw-button) -+ collect (list (contents obj) -+ ((a vector x 2 y 2) + (offset obj) -+ + (offset dd) )) ) ) -+ (if buttons -+ (setf (get (name dd) 'picmenu-spec) -+ (list 'picmenu-spec (x (size dd)) (y (size dd)) buttons -+ t (fnname dd) '9x15))) )) -+ -+; 15 Sep 92; 05 Jan 04 -+(gldefun draw-desc-snap ((dd draw-desc) (p vector)) -+ (result vector) -+ (let (psnap obj (objs (objects dd)) ) -+ (if *draw-snap-flag* -+ (while objs and ~ psnap do -+ (obj = (pop objs)) -+ (psnap = (draw-object-snap obj p (offset dd))) ) ) -+ (or psnap p) )) -+ -+; 10 Sep 92; 12 Sep 92 -+; Move specified object -+(gldefun draw-object-move ((d draw-object) (w window) (off vector)) -+ (let () -+ (erase d w off) -+ (draw-get-object-pos d w) -+ ((offset d) _- off) -+ (draw d w off) -+ (force-output w) )) -+ -+; 12 Sep 92; 13 Sep 92; 15 Sep 92 -+; Draw an object at specified (x y) by calling its drawing function -+(defun draw-object-draw-at (w x y d) -+ (setf (second d) (list x y)) -+ (draw-object-draw d w *draw-zero-vector*) ) -+ -+; 15 Sep 92 -+; Simulate glsend of draw message to an object -+(defun draw-object-draw (d w off) -+ (funcall (glmethod (car d) 'draw) d w off) ) -+ -+; 15 Sep 92 -+; Simulate glsend of snap message to an object -+(defun draw-object-snap (d p off) -+ (funcall (glmethod (car d) 'snap) d p off) ) -+ -+; 15 Sep 92 -+; Simulate glsend of selectedp message to an object -+(defun draw-object-selectedp (d w off) -+ (funcall (glmethod (car d) 'selectedp) d w off) ) -+ -+; 12 Sep 92; 07 Oct 92; 28 Feb 02; 05 Jan 04; 06 Dec 07 -+(gldefun draw-get-object-pos ((d draw-object) (w window)) -+ (window-get-icon-position w -+ (if ((first d) == 'draw-text) #'draw-text-draw-outline -+ #'draw-object-draw-at) -+ (list d)) ) -+ -+; 10 Sep 92; 15 Sep 92; 05 Jan 04 -+(gldefun draw-object-erase ((d draw-object) (w window) (off vector)) -+ (let () -+ (if ((first d) <> 'draw-erase) -+ (progn (set-xor w) -+ (draw d w off) -+ (unset w)) ))) -+ -+; 09 Sep 92; 17 Dec 93; 19 Dec 93; 04 Dec 00 -+(gldefun draw-line-draw ((d draw-line) (w window) (off vector)) -+ (let ((from (off + (offset d))) (to ((off + (offset d)) + (size d))) ) -+ (draw-line-xy w (x from) (y from) (x to) (y to)) )) -+ -+; 11 Sep 92; 17 Dec 93; 19 Dec 93; 04 Dec 00 -+(gldefun draw-arrow-draw ((d draw-arrow) (w window) (off vector)) -+ (let ((from (off + (offset d))) (to ((off + (offset d)) + (size d))) ) -+ (draw-arrow-xy w (x from) (y from) (x to) (y to)) )) -+ -+; 09 Sep 92; 10 Sep 92; 12 Sep 92 -+(gldefun draw-line-selectedp ((d draw-line) (pt vector) (off vector)) -+ (let ((ptp (pt - off))) -+ (and (contains? (vregion d) ptp) -+ ((distance (line d) ptp) < 5) ) )) -+ -+; 09 Sep 92; 10 Sep 92; 15 Sep 92; 17 Dec 93; 05 Jan 04 -+(gldefun draw-line-get ((dd draw-desc) (w window)) -+ (let (from to) -+ (from = (draw-get-crosshairs dd w)) -+ (to = (if *draw-latex-mode* -+ (window-get-latex-position w (x from) (y from) nil) -+ (draw-desc-snap dd -+ (window-get-line-position w (x from) (y from))))) -+ (a draw-line with offset = from size = (to - from)) )) -+ -+; 11 Sep 92; 15 Sep 92; 17 Dec 93; 05 Jan 04 -+(gldefun draw-arrow-get ((dd draw-desc) (w window)) -+ (let (from to) -+ (from = (draw-get-crosshairs dd w)) -+ (to = (if *draw-latex-mode* -+ (window-get-latex-position w (x from) (y from) nil) -+ (draw-desc-snap dd -+ (window-get-line-position w (x from) (y from))))) -+ (a draw-arrow with offset = from size = (to - from)) )) -+ -+; 09 Sep 92 -+(gldefun draw-box-draw ((d draw-box) (w window) (off vector)) -+ (draw-box w (off + (offset d)) (size d)) ) -+ -+; 09 Sep 92; 11 Sep 92 -+(gldefun draw-box-selectedp ((d draw-box) (p vector) (off vector)) -+ (let ((pt (p - off))) -+ (or (and ((y pt) < (top (vregion d)) + 5) -+ ((y pt) > (bottom (vregion d)) - 5) -+ (or ((abs (x pt) - (left (vregion d))) < 5) -+ ((abs (x pt) - (right (vregion d))) < 5))) -+ (and ((x pt) < (right (vregion d)) + 5) -+ ((x pt) > (left (vregion d)) - 5) -+ (or ((abs (y pt) - (top (vregion d))) < 5) -+ ((abs (y pt) - (bottom (vregion d))) < 5))) ) )) -+ -+; 11 Sep 92 -+(gldefun draw-box-get ((dd draw-desc) (w window)) -+ (let (box) -+ (box = (window-get-region w)) -+ (a draw-box with offset = (start box) size = (size box)) )) -+ -+; (dotimes (i 10) (print (draw-box-selectedp db (window-get-point dw)))) -+ -+; 16 Sep 92 -+(gldefun draw-rcbox-draw ((d draw-box) (w window) (off vector)) -+ (draw-rcbox-xy w ((x off) + (x (offset d))) ((y off) + (y (offset d))) -+ (x (size d)) (y (size d)) 8) ) -+ -+; 16 Sep 92 -+(gldefun draw-rcbox-selectedp ((d draw-box) (p vector) (off vector)) -+ (let ((pt (p - off))) -+ (or (and ((y pt) < (top (vregion d)) - 3) -+ ((y pt) > (bottom (vregion d)) + 3) -+ (or ((abs (x pt) - (left (vregion d))) < 5) -+ ((abs (x pt) - (right (vregion d))) < 5))) -+ (and ((x pt) < (right (vregion d)) - 3) -+ ((x pt) > (left (vregion d)) + 3) -+ (or ((abs (y pt) - (top (vregion d))) < 5) -+ ((abs (y pt) - (bottom (vregion d))) < 5))) ) )) -+ -+; 16 Sep 92 -+(gldefun draw-rcbox-get ((dd draw-desc) (w window)) -+ (let (box) -+ (box = (window-get-region w)) -+ (a draw-rcbox with offset = (start box) size = (size box)) )) -+ -+; 09 Sep 92 -+(gldefun draw-circle-draw ((d draw-circle) (w window) (off vector)) -+ (draw-circle w (off + (center d)) (radius d)) ) -+ -+; 09 Sep 92; 11 Sep 92; 17 Sep 92 -+(gldefun draw-circle-selectedp ((d draw-circle) (p vector) (off vector)) -+ ((abs (radius d) - (magnitude ((center d) + off) - p)) < 5) ) -+ -+; 11 Sep 92; 15 Sep 92 -+(gldefun draw-circle-get ((dd draw-desc) (w window)) -+ (let (cir cent) -+ (cent = (draw-get-crosshairs dd w)) -+ (cir = (window-get-circle w cent)) -+ (a draw-circle with -+ offset = (a vector with x = ( (x (center cir)) - (radius cir) ) -+ y = ( (y (center cir)) - (radius cir) )) -+ size = (a vector with x = 2 * (radius cir) y = 2 * (radius cir))) )) -+ -+; 11 Sep 92 -+(gldefun draw-ellipse-draw ((d draw-ellipse) (w window) (off vector)) -+ (let ((c (off + (center d)))) -+ (draw-ellipse-xy w (x c) (y c) (radiusx d) (radiusy d)) )) -+ -+; 11 Sep 92; 15 Sep 92; 17 Sep 92 -+; Uses the fact that sum of distances from foci is constant. -+(gldefun draw-ellipse-selectedp ((d draw-ellipse) (p vector) (off vector)) -+ (let ((pt (p - off))) -+ ( (abs ( (magnitude ((p1 d) - pt)) + (magnitude ((p2 d) - pt)) ) -+ - 2 * (radius d)) < 2) )) -+ -+; print out what the "boundary" of an ellipse looks like via selectedp -+(defun draw-test-ellipse-selectedp (e) -+ (let ( (size (third e)) (offset (second e)) ) -+ (dotimes (y (+ (cadr size) 10)) -+ (dotimes (x (+ (car size) 10)) -+ (princ (if (draw-ellipse-selectedp e -+ (list (+ x (car offset) -5) (+ y (cadr offset) -5)) -+ (list 0 0)) -+ "T" " "))) -+ (terpri)) )) -+ -+; 11 Sep 92 -+(gldefun draw-ellipse-get ((dd draw-desc) (w window)) -+ (let (ell cent) -+ (cent = (draw-get-crosshairs dd w)) -+ (ell = (window-get-ellipse w cent)) -+ (a draw-ellipse with -+ offset = (a vector with x = ( (x (center ell)) - (x (halfsize ell)) ) -+ y = ( (y (center ell)) - (y (halfsize ell)) )) -+ size = (a vector with x = 2 * (x (halfsize ell)) -+ y = 2 * (y (halfsize ell)))) )) -+ -+; 10 Sep 92 -+(gldefun draw-null-draw ((d draw-null) (w window) (off vector)) nil) -+ -+; 10 Sep 92; 11 Sep 92 -+(gldefun draw-null-selectedp ((d draw-null) (pt vector) (off vector)) nil) -+ -+; 11 Sep 92 -+(gldefun draw-button-draw ((d draw-button) (w window) (off vector)) -+ (draw-box w (off + (offset d)) (a vector x = 4 y = 4)) ) -+ -+; 11 Sep 92 -+(gldefun draw-button-selectedp ((d draw-button) (p vector) (off vector)) -+ (let ( (ptx (((x p) - (x off)) - (x (offset d)))) -+ (pty (((y p) - (y off)) - (y (offset d)))) ) -+ (and (ptx > -2) (ptx < 6) (pty > -2) (pty < 6) ) )) -+ )) -+ -+; 11 Sep 92 -+(gldefun draw-button-get ((dd draw-desc) (w window)) -+ (let (cent var) -+ (princ "Enter button name: ") -+ (var = (read)) -+ (cent = (draw-get-crosshairs dd w)) -+ (a draw-button with -+ offset = (a vector with x = ((x cent) - 2) y = ((y cent) - 2)) -+ size = (a vector with x = 4 y = 4) -+ contents = var) )) -+ -+; 14 Sep 92 -+(gldefun draw-erase-draw ((d draw-box) (w window) (off vector)) -+ (erase-area w (off + (offset d)) (size d)) ) -+ -+; 14 Sep 92 -+(gldefun draw-erase-selectedp ((d draw-box) (p vector) (off vector)) -+ (let ((pt (p - off))) -+ (contains? (region d) pt) )) -+ -+; 14 Sep 92 -+(gldefun draw-erase-get ((dd draw-desc) (w window)) -+ (let (box) -+ (box = (window-get-region w)) -+ (a draw-erase with offset = (start box) size = (size box)) )) -+ -+; 11 Sep 92; 14 Sep 92 -+(gldefun draw-dot-draw ((d draw-dot) (w window) (off vector)) -+ (window-draw-dot-xy w ((x off) + (x (offset d)) + 2) -+ ((y off) + (y (offset d)) + 2) ) ) -+ -+; 11 Sep 92; 15 Sep 92 -+(gldefun draw-dot-get ((dd draw-desc) (w window)) -+ (let (cent) -+ (cent = (draw-get-crosshairs dd w)) -+ (a draw-dot with -+ offset = (a vector with x = ((x cent) - 2) y = ((y cent) - 2)) -+ size = (a vector with x = 4 y = 4)) )) -+ -+; 17 Dec 93 -+(gldefun draw-refpt-draw ((d draw-refpt) (w window) (off vector)) -+ (window-draw-crosshairs-xy w ((x off) + (x (offset d))) -+ ((y off) + (y (offset d))) ) ) -+ -+; 17 Dec 93 -+(gldefun draw-refpt-selectedp ((d draw-button) (p vector) (off vector)) -+ (let ( (ptx (((x p) - (x off)) - (x (offset d)))) -+ (pty (((y p) - (y off)) - (y (offset d)))) ) -+ (and (ptx > -3) (ptx < 3) (pty > -3) (pty < 3) ) )) -+ -+; 17 Dec 93; 05 Jan 04 -+(gldefun draw-refpt-get ((dd draw-desc) (w window)) -+ (let (cent refpt) -+ (if (refpt = (assoc 'draw-refpt (objects dd))) -+ (progn (set-erase *draw-window*) -+ (draw refpt *draw-window* (a vector with x = 0 y = 0)) -+ (unset *draw-window*) -+ ((objects dd) _- refpt) ) ) -+ (cent = (draw-get-crosshairs dd w)) -+ (a draw-refpt with offset = cent -+ size = (a vector with x = 0 y = 0)) )) -+ -+; 17 Dec 93; 05 Jan 04 -+(gldefun draw-desc-refpt ((dd draw-desc)) (result vector) -+ (let (refpt) -+ (refpt = (assoc 'draw-refpt (objects dd))) -+ (if refpt (offset refpt) -+ (a vector x = 0 y = 0)) )) -+ -+; 11 Sep 92; 06 Oct 92; 19 Dec 93; 11 Nov 94 -+(gldefun draw-text-draw ((d draw-text) (w window) (off vector)) -+ (printat-xy w (contents d) ((x off) + (x (offset d))) -+ ((y off) + (y (offset d)))) ) -+ -+; 07 Oct 92 -+(gldefun draw-text-draw-outline ((w window) (x integer) (y integer) (d draw-text)) -+ (setf (second d) (list x y)) -+ (draw-box-xy w x (y + 2) (x (size d)) (y (size d))) ) -+ -+; define compiled version directly to avoid repeated recompilation -+(defun draw-text-draw-outline (W X Y D) -+ (SETF (SECOND D) (LIST X Y)) -+ (WINDOW-DRAW-BOX-XY W X (+ 2 Y) (CAADDR D) (CADR (CADDR D)))) -+ -+; 11 Sep 92 -+(gldefun draw-text-selectedp ((d draw-text) (pt vector) (off vector)) -+ (let ((ptp (pt - off))) -+ (contains? (vregion d) ptp))) -+ -+; 11 Sep 92; 17 Sep 92; 06 Oct 92; 11 Nov 94 -+(gldefun draw-text-get ((dd draw-desc) (w window)) -+ (let (txt lng off) -+ (princ "Enter text string: ") -+ (txt = (stringify (read))) -+ (lng = (string-width w txt)) -+ (off = (get-box-position w lng 14)) -+ (a draw-text with offset = (off + (a vector x 0 y 4)) -+ size = (a vector with x = lng y = 14) -+ contents = txt) )) -+ -+; 15 Sep 92; 05 Jan 04 -+; Test if a point p1 is close to a point p2. If so, result is p2, else nil. -+(gldefun draw-snapp ((p1 vector) (off vector) (p2x integer) (p2y integer)) -+ (if (and ((abs ((x p1) - (x off) - p2x)) < 4) -+ ((abs ((y p1) - (y off) - p2y)) < 4) ) -+ (a vector with x = ((x off) + p2x) y = ((y off) + p2y)) )) -+ -+; 15 Sep 92 -+(gldefun draw-dot-snap ((d draw-dot) (p vector) (off vector)) -+ (draw-snapp p off ((x (offset d)) + 2) -+ ((y (offset d)) + 2) ) ) -+ -+; 17 Dec 93 -+(gldefun draw-refpt-snap ((d draw-refpt) (p vector) (off vector)) -+ (draw-snapp p off (x (offset d)) (y (offset d)) ) ) -+ -+; 15 Sep 92 -+(gldefun draw-line-snap ((d draw-line) (p vector) (off vector)) -+ (or (draw-snapp p off (x (offset d)) (y (offset d))) -+ (draw-snapp p off ( (x (offset d)) + (x (size d)) ) -+ ( (y (offset d)) + (y (size d)) ) ) )) -+ -+; 15 Sep 92; 19 Dec 93 -+; Snap for square: corners, middle of sides. -+(gldefun draw-box-snap ((d draw-box) (p vector) (off vector)) -+ (let ((xoff (x (offset d))) (yoff (y (offset d))) -+ (xsize (x (size d)) ) (ysize (y (size d)) ) ) -+ (or (draw-snapp p off xoff yoff) -+ (draw-snapp p off (xoff + xsize) (yoff + ysize)) -+ (draw-snapp p off (xoff + xsize) yoff) -+ (draw-snapp p off xoff (yoff + ysize)) -+ (draw-snapp p off (xoff + xsize / 2) yoff) -+ (draw-snapp p off xoff (yoff + ysize / 2)) -+ (draw-snapp p off (xoff + xsize / 2) (yoff + ysize)) -+ (draw-snapp p off (xoff + xsize) (yoff + ysize / 2)) ) )) -+ -+; 15 Sep 92 -+(gldefun draw-circle-snap ((d draw-circle) (p vector) (off vector)) -+ (or (draw-snapp p off ( (x (offset d)) + (radius d) ) -+ ( (y (offset d)) + (radius d) ) ) -+ (draw-snapp p off ( (x (offset d)) + (radius d) ) -+ (y (offset d)) ) -+ (draw-snapp p off (x (offset d)) -+ ( (y (offset d)) + (radius d) ) ) -+ (draw-snapp p off ( (x (offset d)) + (radius d) ) -+ ( (y (offset d)) + (y (size d)) ) ) -+ (draw-snapp p off ( (x (offset d)) + (x (size d)) ) -+ ( (y (offset d)) + (radius d) ) ) )) -+ -+; 15 Sep 92 -+(gldefun draw-ellipse-snap ((d draw-ellipse) (p vector) (off vector)) -+ (or (draw-snapp p off ( (x (offset d)) + (radiusx d) ) -+ ( (y (offset d)) + (radiusy d) ) ) -+ (draw-snapp p off ( (x (offset d)) + (radiusx d) ) -+ (y (offset d)) ) -+ (draw-snapp p off (x (offset d)) -+ ( (y (offset d)) + (radiusy d) ) ) -+ (draw-snapp p off ( (x (offset d)) + (radiusx d) ) -+ ( (y (offset d)) + (y (size d)) ) ) -+ (draw-snapp p off ( (x (offset d)) + (x (size d)) ) -+ ( (y (offset d)) + (radiusy d) ) ) )) -+ -+; 16 Sep 92 -+(gldefun draw-rcbox-snap ((d draw-rcbox) (p vector) (off vector)) -+ (let ( (rx ((x (size d)) / 2)) (ry ((y (size d)) / 2)) ) -+ (or (draw-snapp p off ( (x (offset d)) + rx ) (y (offset d)) ) -+ (draw-snapp p off (x (offset d)) ( (y (offset d)) + ry ) ) -+ (draw-snapp p off ( (x (offset d)) + rx ) -+ ( (y (offset d)) + (y (size d)) ) ) -+ (draw-snapp p off ( (x (offset d)) + (x (size d)) ) -+ ( (y (offset d)) + ry ) ) ) )) -+ -+; 15 Sep 92 -+(gldefun draw-no-snap ((d draw-ellipse) (p vector) (off vector)) nil) -+ -+; 11 Sep 92 -+(gldefun draw-multi-draw ((d draw-multi) (w window) (off vector)) -+ (let ( (totaloff ((offset d) + off)) ) -+ (for subd in (contents d) do -+ (draw subd w totaloff)) )) -+ -+; 11 Sep 92; 13 Sep 92; 15 Sep 92; 16 Sep 92; 29 Sep 92; 17 Dec 93; 07 Jan 94 -+; Initialize drawing and command menus -+(defun draw-init-menus () -+ (let ((w (draw-window))) -+ (window-clear w) -+ (dolist (fn '(draw-menu-rectangle draw-menu-circle draw-menu-ellipse -+ draw-menu-line draw-menu-arrow draw-menu-dot -+ draw-menu-button draw-menu-text)) -+ (setf (get fn 'display-size) '(30 20)) ) -+ (setq *draw-menu-set* (menu-set-create w nil)) -+ (menu-set-add-menu *draw-menu-set* 'draw nil "Draw" -+ '((draw-menu-rectangle . rectangle) -+ (draw-menu-rcbox . rcbox) -+ (draw-menu-circle . circle) -+ (draw-menu-ellipse . ellipse) -+ (draw-menu-line . line) -+ (draw-menu-arrow . arrow) -+ (draw-menu-dot . dot) -+ (" " . erase) -+ (draw-menu-button . button) -+ (draw-menu-text . text) -+ (draw-menu-refpt . refpt)) -+ (list 0 0)) -+ (menu-set-adjust *draw-menu-set* 'draw 'top nil 1) -+ (menu-set-adjust *draw-menu-set* 'draw 'right nil 2) -+ (menu-set-add-menu *draw-menu-set* 'command nil "Commands" -+ '(("Done" . done) ("Move" . move) -+ ("Delete" . delete) ("Copy" . copy) -+ ("Redraw" . redraw) ("Origin" . origin) -+ ("LaTex Mode" . latexmode) -+ ("Make Program" . program) ("Make LaTex" . latex)) -+ (list 0 0)) -+ (menu-set-adjust *draw-menu-set* 'command 'top 'draw 5) -+ (menu-set-adjust *draw-menu-set* 'command 'right nil 2) )) -+ -+ -+; 10 Sep 92 -+(defun draw-menu-rectangle (w x y) -+ (window-draw-box-xy w (+ x 3) (+ y 3) 24 14 1)) -+(defun draw-menu-rcbox (w x y) -+ (window-draw-rcbox-xy w (+ x 3) (+ y 3) 24 14 3 1)) -+(defun draw-menu-circle (w x y) -+ (window-draw-circle-xy w (+ x 15) (+ y 10) 8 1)) -+(defun draw-menu-ellipse (w x y) -+ (window-draw-ellipse-xy w (+ x 15) (+ y 10) 12 8 1)) -+(defun draw-menu-line (w x y) -+ (window-draw-line-xy w (+ x 4) (+ y 4) (+ x 26) (+ y 16) 1)) -+(defun draw-menu-arrow (w x y) -+ (window-draw-arrow-xy w (+ x 4) (+ y 4) (+ x 26) (+ y 16) 1)) -+(defun draw-menu-dot (w x y) (window-draw-dot-xy w (+ x 15) (+ y 10)) ) -+(defun draw-menu-button (w x y) -+ (window-draw-box-xy w (+ x 14) (+ y 5) 4 4 1)) -+(defun draw-menu-text (w x y) -+ (window-printat-xy w "A" (+ x 12) (+ y 5))) -+(defun draw-menu-refpt (w x y) -+ (window-draw-crosshairs-xy w (+ x 15) (+ y 9)) -+ (window-draw-circle-xy w (+ x 15) (+ y 9) 2)) -+ -+; 14 Sep 92; 15 Jan 98 -+; Draw a line or arrow in LaTex form -+(defun latex-line (fromx fromy x y &optional arrowflg) -+ (let (dx dy sx sy siz err errb) -+ (setq dx (- x fromx)) -+ (setq dy (- y fromy)) -+ (if (= dx 0) -+ (progn (setq sx 0) -+ (setq sy (if (>= dy 0) 1 -1)) -+ (setq siz (* (abs dy) *draw-latex-factor*))) -+ (if (= dy 0) -+ (progn (setq sx (if (>= dx 0) 1 -1)) -+ (setq sy 0) -+ (setq siz (* (abs dx) *draw-latex-factor*))) -+ (progn -+ (setq err 9999) -+ (setq siz (* (abs dx) *draw-latex-factor*)) -+ (dotimes (i (if arrowflg 4 6)) -+ (dotimes (j (if arrowflg 4 6)) -+ (setq errb (abs (- (/ (float (1+ i)) -+ (float (1+ j))) -+ (abs (/ (float dx) -+ (float dy)))))) -+ (if (and (= (gcd (1+ i) (1+ j)) 1) -+ (< errb err)) -+ (progn (setq err errb) -+ (setq sx (1+ i)) -+ (setq sy (1+ j)))))) -+ (setq sx (* sx (latex-sign dx))) -+ (setq sy (* sy (latex-sign dy))) ))) -+ (format t " \\put(~5,0F,~5,0F) {\\~A(~D,~D){~5,0F}}~%" -+ (* fromx *draw-latex-factor*) (* fromy *draw-latex-factor*) -+ (if arrowflg "vector" "line") sx sy siz) )) -+ -+(defun latex-sign (x) (if (>= x 0) 1 -1)) -+ -+ -+; 16 Sep 92; 30 Sep 92; 02 Oct 92; 07 Oct 92 -+(defun draw-output (outfilename &optional names) -+ (prog (prettysave lengthsave d fnname code) -+ (or names (setq names *draw-objects*)) -+ (if (symbolp names) (setq names (list names))) -+ (with-open-file (outfile outfilename -+ :direction :output -+ :if-exists :supersede) -+ (setq prettysave *print-pretty*) -+ (setq lengthsave *print-length*) -+ (setq *print-pretty* t) -+ (setq *print-length* 80) -+ (format outfile "; ~A ~A~%" -+ outfilename (draw-get-time-string)) -+ (dolist (name names) -+ (if (setq d (get name 'draw-descr)) -+ (progn (terpri outfile) -+ (print `(setf (get ',name 'draw-descr) ',d) outfile) -+ (if (and (setq fnname (draw-desc-fnname d)) -+ (setq code (symbol-function fnname))) -+ (progn (terpri outfile) -+ (print (cons 'defun -+ (if (eq (car code) 'lambda-block) -+ (cdr code) -+ (cons fnname (cdr code)))) -+ outfile)) ))) -+ (if (setq d (get name 'picmenu-spec)) -+ (progn (terpri outfile) -+ (print `(setf (get ',name 'picmenu-spec) ',d) outfile)))) -+ (terpri outfile) -+ (setq *print-pretty* prettysave) -+ (setq *print-length* lengthsave) ) -+ (return outfilename) )) -+ -+; 09 Sep 92 -+(defun draw-get-time-string () -+ (let (second minute hour date month year) -+ (multiple-value-setq (second minute hour date month year) -+ (get-decoded-time)) -+ (format nil "~2D ~A ~4D ~2D:~2D:~2D" -+ date (nth (1- month) '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" -+ "Aug" "Sep" "Oct" "Nov" "Dec")) -+ year hour minute second) )) -+ -+; 14 Sep 92; 16 Sep 92; 13 July 93 -+; Compile the draw.lsp and menu-set files into a plain Lisp file -+(defun compile-draw () -+ (glcompfiles *directory* -+ '("glisp/vector.lsp" ; auxiliary files -+ "X/dwindow.lsp") -+ '("glisp/menu-set.lsp" ; translated files -+ "glisp/draw.lsp") -+ "glisp/drawtrans.lsp" ; output file -+ "glisp/draw-header.lsp") ; header file -+ (cf drawtrans) ) -+ -+(defun compile-drawb () -+ (glcompfiles *directory* -+ '("glisp/vector.lsp" ; auxiliary files -+ "X/dwindow.lsp" "X/dwnoopen.lsp") -+ '("glisp/menu-set.lsp" ; translated files -+ "glisp/draw.lsp") -+ "glisp/drawtrans.lsp" ; output file -+ "glisp/draw-header.lsp") ; header file -+ ) -+ -+; 16 Nov 92; 08 Apr 93; 08 Oct 93; 20 Apr 94; 29 Oct 94; 09 Feb 99 -+; Output drawing descriptions and functions to the specified file -+(defun draw-out (&optional names file) -+ (or names (setq names *draw-objects*)) -+ (if (not (consp names)) (setq names (list names))) -+ (draw-output (or file "glisp/draw.del") names) -+ (setq *draw-objects* (set-difference *draw-objects* names)) -+ names ) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_keysymdef.lsp -@@ -0,0 +1,1151 @@ -+(in-package :XLIB) -+; keysymdef.lsp modified by Hiep Huu Nguyen 27 Aug 92 -+ -+; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. -+ -+; See the files gnu.license and dec.copyright . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Some of the files that interface to the Xlib are adapted from DEC/MIT files. -+; See the file dec.copyright for details. -+ -+;; $XConsortium: keysymdef.h,v 1.13 89/12/12 16:23:30 rws Exp $ -+ -+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -+ -+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -+ -+(defconstant XK_VoidSymbol #xFFFFFF ;; void symbol -+ -+;;#ifdef XK_MISCELLANY -+;; -+ ; TTY Functions, cleverly chosen to map to ascii, for convenience of -+ ; programming, but could have been arbitrary at the cost of lookup -+ ; tables in client code. -+ -+ -+)(defconstant XK_BackSpace #xFF08 ;; back space, back char -+)(defconstant XK_Tab #xFF09 -+)(defconstant XK_Linefeed #xFF0A ;; Linefeed, LF -+)(defconstant XK_Clear #xFF0B -+)(defconstant XK_Return #xFF0D ;; Return, enter -+)(defconstant XK_Pause #xFF13 ;; Pause, hold -+)(defconstant XK_Scroll_Lock #xFF14 -+)(defconstant XK_Escape #xFF1B -+)(defconstant XK_Delete #xFFFF ;; Delete, rubout -+ -+ -+ -+;; International & multi-key character composition -+ -+)(defconstant XK_Multi_key #xFF20 ;; Multi-key character compose -+ -+;; Japanese keyboard support -+ -+)(defconstant XK_Kanji #xFF21 ;; Kanji, Kanji convert -+)(defconstant XK_Muhenkan #xFF22 ;; Cancel Conversion -+)(defconstant XK_Henkan_Mode #xFF23 ;; Start/Stop Conversion -+)(defconstant XK_Henkan #xFF23 ;; Alias for Henkan_Mode -+)(defconstant XK_Romaji #xFF24 ;; to Romaji -+)(defconstant XK_Hiragana #xFF25 ;; to Hiragana -+)(defconstant XK_Katakana #xFF26 ;; to Katakana -+)(defconstant XK_Hiragana_Katakana #xFF27 ;; Hiragana/Katakana toggle -+)(defconstant XK_Zenkaku #xFF28 ;; to Zenkaku -+)(defconstant XK_Hankaku #xFF29 ;; to Hankaku -+)(defconstant XK_Zenkaku_Hankaku #xFF2A ;; Zenkaku/Hankaku toggle -+)(defconstant XK_Touroku #xFF2B ;; Add to Dictionary -+)(defconstant XK_Massyo #xFF2C ;; Delete from Dictionary -+)(defconstant XK_Kana_Lock #xFF2D ;; Kana Lock -+)(defconstant XK_Kana_Shift #xFF2E ;; Kana Shift -+)(defconstant XK_Eisu_Shift #xFF2F ;; Alphanumeric Shift -+)(defconstant XK_Eisu_toggle #xFF30 ;; Alphanumeric toggle -+ -+;; Cursor control & motion -+ -+)(defconstant XK_Home #xFF50 -+)(defconstant XK_Left #xFF51 ;; Move left, left arrow -+)(defconstant XK_Up #xFF52 ;; Move up, up arrow -+)(defconstant XK_Right #xFF53 ;; Move right, right arrow -+)(defconstant XK_Down #xFF54 ;; Move down, down arrow -+)(defconstant XK_Prior #xFF55 ;; Prior, previous -+)(defconstant XK_Next #xFF56 ;; Next -+)(defconstant XK_End #xFF57 ;; EOL -+)(defconstant XK_Begin #xFF58 ;; BOL -+ -+ -+;; Misc Functions -+ -+)(defconstant XK_Select #xFF60 ;; Select, mark -+)(defconstant XK_Print #xFF61 -+)(defconstant XK_Execute #xFF62 ;; Execute, run, do -+)(defconstant XK_Insert #xFF63 ;; Insert, insert here -+)(defconstant XK_Undo #xFF65 ;; Undo, oops -+)(defconstant XK_Redo #xFF66 ;; redo, again -+)(defconstant XK_Menu #xFF67 -+)(defconstant XK_Find #xFF68 ;; Find, search -+)(defconstant XK_Cancel #xFF69 ;; Cancel, stop, abort, exit -+)(defconstant XK_Help #xFF6A ;; Help, ? -+)(defconstant XK_Break #xFF6B -+)(defconstant XK_Mode_switch #xFF7E ;; Character set switch -+)(defconstant XK_script_switch #xFF7E ;; Alias for mode_switch -+)(defconstant XK_Num_Lock #xFF7F -+ -+;; Keypad Functions, keypad numbers cleverly chosen to map to ascii -+ -+)(defconstant XK_KP_Space #xFF80 ;; space -+)(defconstant XK_KP_Tab #xFF89 -+)(defconstant XK_KP_Enter #xFF8D ;; enter -+)(defconstant XK_KP_F1 #xFF91 ;; PF1, KP_A, ... -+)(defconstant XK_KP_F2 #xFF92 -+)(defconstant XK_KP_F3 #xFF93 -+)(defconstant XK_KP_F4 #xFF94 -+)(defconstant XK_KP_Equal #xFFBD ;; equals -+)(defconstant XK_KP_Multiply #xFFAA -+)(defconstant XK_KP_Add #xFFAB -+)(defconstant XK_KP_Separator #xFFAC ;; separator, often comma -+)(defconstant XK_KP_Subtract #xFFAD -+)(defconstant XK_KP_Decimal #xFFAE -+)(defconstant XK_KP_Divide #xFFAF -+)(defconstant XK_KP_0 #xFFB0 -+)(defconstant XK_KP_1 #xFFB1 -+)(defconstant XK_KP_2 #xFFB2 -+)(defconstant XK_KP_3 #xFFB3 -+)(defconstant XK_KP_4 #xFFB4 -+)(defconstant XK_KP_5 #xFFB5 -+)(defconstant XK_KP_6 #xFFB6 -+)(defconstant XK_KP_7 #xFFB7 -+)(defconstant XK_KP_8 #xFFB8 -+)(defconstant XK_KP_9 #xFFB9 -+ -+ -+ -+;; -+ ; Auxilliary Functions; note the duplicate definitions for left and right -+ ; function keys; Sun keyboards and a few other manufactures have such -+ ; function key groups on the left and/or right sides of the keyboard. -+ ; We've not found a keyboard with more than 35 function keys total. -+ -+ -+)(defconstant XK_F1 #xFFBE -+)(defconstant XK_F2 #xFFBF -+)(defconstant XK_F3 #xFFC0 -+)(defconstant XK_F4 #xFFC1 -+)(defconstant XK_F5 #xFFC2 -+)(defconstant XK_F6 #xFFC3 -+)(defconstant XK_F7 #xFFC4 -+)(defconstant XK_F8 #xFFC5 -+)(defconstant XK_F9 #xFFC6 -+)(defconstant XK_F10 #xFFC7 -+)(defconstant XK_F11 #xFFC8 -+)(defconstant XK_L1 #xFFC8 -+)(defconstant XK_F12 #xFFC9 -+)(defconstant XK_L2 #xFFC9 -+)(defconstant XK_F13 #xFFCA -+)(defconstant XK_L3 #xFFCA -+)(defconstant XK_F14 #xFFCB -+)(defconstant XK_L4 #xFFCB -+)(defconstant XK_F15 #xFFCC -+)(defconstant XK_L5 #xFFCC -+)(defconstant XK_F16 #xFFCD -+)(defconstant XK_L6 #xFFCD -+)(defconstant XK_F17 #xFFCE -+)(defconstant XK_L7 #xFFCE -+)(defconstant XK_F18 #xFFCF -+)(defconstant XK_L8 #xFFCF -+)(defconstant XK_F19 #xFFD0 -+)(defconstant XK_L9 #xFFD0 -+)(defconstant XK_F20 #xFFD1 -+)(defconstant XK_L10 #xFFD1 -+)(defconstant XK_F21 #xFFD2 -+)(defconstant XK_R1 #xFFD2 -+)(defconstant XK_F22 #xFFD3 -+)(defconstant XK_R2 #xFFD3 -+)(defconstant XK_F23 #xFFD4 -+)(defconstant XK_R3 #xFFD4 -+)(defconstant XK_F24 #xFFD5 -+)(defconstant XK_R4 #xFFD5 -+)(defconstant XK_F25 #xFFD6 -+)(defconstant XK_R5 #xFFD6 -+)(defconstant XK_F26 #xFFD7 -+)(defconstant XK_R6 #xFFD7 -+)(defconstant XK_F27 #xFFD8 -+)(defconstant XK_R7 #xFFD8 -+)(defconstant XK_F28 #xFFD9 -+)(defconstant XK_R8 #xFFD9 -+)(defconstant XK_F29 #xFFDA -+)(defconstant XK_R9 #xFFDA -+)(defconstant XK_F30 #xFFDB -+)(defconstant XK_R10 #xFFDB -+)(defconstant XK_F31 #xFFDC -+)(defconstant XK_R11 #xFFDC -+)(defconstant XK_F32 #xFFDD -+)(defconstant XK_R12 #xFFDD -+)(defconstant XK_R13 #xFFDE -+)(defconstant XK_F33 #xFFDE -+)(defconstant XK_F34 #xFFDF -+)(defconstant XK_R14 #xFFDF -+)(defconstant XK_F35 #xFFE0 -+)(defconstant XK_R15 #xFFE0 -+ -+;; Modifiers -+ -+)(defconstant XK_Shift_L #xFFE1 ;; Left shift -+)(defconstant XK_Shift_R #xFFE2 ;; Right shift -+)(defconstant XK_Control_L #xFFE3 ;; Left control -+)(defconstant XK_Control_R #xFFE4 ;; Right control -+)(defconstant XK_Caps_Lock #xFFE5 ;; Caps lock -+)(defconstant XK_Shift_Lock #xFFE6 ;; Shift lock -+ -+)(defconstant XK_Meta_L #xFFE7 ;; Left meta -+)(defconstant XK_Meta_R #xFFE8 ;; Right meta -+)(defconstant XK_Alt_L #xFFE9 ;; Left alt -+)(defconstant XK_Alt_R #xFFEA ;; Right alt -+)(defconstant XK_Super_L #xFFEB ;; Left super -+)(defconstant XK_Super_R #xFFEC ;; Right super -+)(defconstant XK_Hyper_L #xFFED ;; Left hyper -+)(defconstant XK_Hyper_R #xFFEE ;; Right hyper -+;;#endif ;; XK_MISCELLANY -+ -+;; -+ ; Latin 1 -+ ; Byte 3 = 0 -+ -+;;ifdef XK_LATIN1 -+)(defconstant XK_space #x020 -+)(defconstant XK_exclam #x021 -+)(defconstant XK_quotedbl #x022 -+)(defconstant XK_numbersign #x023 -+)(defconstant XK_dollar #x024 -+)(defconstant XK_percent #x025 -+)(defconstant XK_ampersand #x026 -+)(defconstant XK_apostrophe #x027 -+)(defconstant XK_quoteright #x027 ;; deprecated -+)(defconstant XK_parenleft #x028 -+)(defconstant XK_parenright #x029 -+)(defconstant XK_asterisk #x02a -+)(defconstant XK_plus #x02b -+)(defconstant XK_comma #x02c -+)(defconstant XK_minus #x02d -+)(defconstant XK_period #x02e -+)(defconstant XK_slash #x02f -+)(defconstant XK_0 #x030 -+)(defconstant XK_1 #x031 -+)(defconstant XK_2 #x032 -+)(defconstant XK_3 #x033 -+)(defconstant XK_4 #x034 -+)(defconstant XK_5 #x035 -+)(defconstant XK_6 #x036 -+)(defconstant XK_7 #x037 -+)(defconstant XK_8 #x038 -+)(defconstant XK_9 #x039 -+)(defconstant XK_colon #x03a -+)(defconstant XK_semicolon #x03b -+)(defconstant XK_less #x03c -+)(defconstant XK_equal #x03d -+)(defconstant XK_greater #x03e -+)(defconstant XK_question #x03f -+)(defconstant XK_at #x040 -+)(defconstant XK_A #x041 -+)(defconstant XK_B #x042 -+)(defconstant XK_C #x043 -+)(defconstant XK_D #x044 -+)(defconstant XK_E #x045 -+)(defconstant XK_F #x046 -+)(defconstant XK_G #x047 -+)(defconstant XK_H #x048 -+)(defconstant XK_I #x049 -+)(defconstant XK_J #x04a -+)(defconstant XK_K #x04b -+)(defconstant XK_L #x04c -+)(defconstant XK_M #x04d -+)(defconstant XK_N #x04e -+)(defconstant XK_O #x04f -+)(defconstant XK_P #x050 -+)(defconstant XK_Q #x051 -+)(defconstant XK_R #x052 -+)(defconstant XK_S #x053 -+)(defconstant XK_T #x054 -+)(defconstant XK_U #x055 -+)(defconstant XK_V #x056 -+)(defconstant XK_W #x057 -+)(defconstant XK_X #x058 -+)(defconstant XK_Y #x059 -+)(defconstant XK_Z #x05a -+)(defconstant XK_bracketleft #x05b -+)(defconstant XK_backslash #x05c -+)(defconstant XK_bracketright #x05d -+)(defconstant XK_asciicircum #x05e -+)(defconstant XK_underscore #x05f -+)(defconstant XK_grave #x060 -+)(defconstant XK_quoteleft #x060 ;; deprecated -+)(defconstant XK_a #x061 -+)(defconstant XK_b #x062 -+)(defconstant XK_c #x063 -+)(defconstant XK_d #x064 -+)(defconstant XK_e #x065 -+)(defconstant XK_f #x066 -+)(defconstant XK_g #x067 -+)(defconstant XK_h #x068 -+)(defconstant XK_i #x069 -+)(defconstant XK_j #x06a -+)(defconstant XK_k #x06b -+)(defconstant XK_l #x06c -+)(defconstant XK_m #x06d -+)(defconstant XK_n #x06e -+)(defconstant XK_o #x06f -+)(defconstant XK_p #x070 -+)(defconstant XK_q #x071 -+)(defconstant XK_r #x072 -+)(defconstant XK_s #x073 -+)(defconstant XK_t #x074 -+)(defconstant XK_u #x075 -+)(defconstant XK_v #x076 -+)(defconstant XK_w #x077 -+)(defconstant XK_x #x078 -+)(defconstant XK_y #x079 -+)(defconstant XK_z #x07a -+)(defconstant XK_braceleft #x07b -+)(defconstant XK_bar #x07c -+)(defconstant XK_braceright #x07d -+)(defconstant XK_asciitilde #x07e -+ -+)(defconstant XK_nobreakspace #x0a0 -+)(defconstant XK_exclamdown #x0a1 -+)(defconstant XK_cent #x0a2 -+)(defconstant XK_sterling #x0a3 -+)(defconstant XK_currency #x0a4 -+)(defconstant XK_yen #x0a5 -+)(defconstant XK_brokenbar #x0a6 -+)(defconstant XK_section #x0a7 -+)(defconstant XK_diaeresis #x0a8 -+)(defconstant XK_copyright #x0a9 -+)(defconstant XK_ordfeminine #x0aa -+)(defconstant XK_guillemotleft #x0ab ;; left angle quotation mark -+)(defconstant XK_notsign #x0ac -+)(defconstant XK_hyphen #x0ad -+)(defconstant XK_registered #x0ae -+)(defconstant XK_macron #x0af -+)(defconstant XK_degree #x0b0 -+)(defconstant XK_plusminus #x0b1 -+)(defconstant XK_twosuperior #x0b2 -+)(defconstant XK_threesuperior #x0b3 -+)(defconstant XK_acute #x0b4 -+)(defconstant XK_mu #x0b5 -+)(defconstant XK_paragraph #x0b6 -+)(defconstant XK_periodcentered #x0b7 -+)(defconstant XK_cedilla #x0b8 -+)(defconstant XK_onesuperior #x0b9 -+)(defconstant XK_masculine #x0ba -+)(defconstant XK_guillemotright #x0bb ;; right angle quotation mark -+)(defconstant XK_onequarter #x0bc -+)(defconstant XK_onehalf #x0bd -+)(defconstant XK_threequarters #x0be -+)(defconstant XK_questiondown #x0bf -+)(defconstant XK_Agrave #x0c0 -+)(defconstant XK_Aacute #x0c1 -+)(defconstant XK_Acircumflex #x0c2 -+)(defconstant XK_Atilde #x0c3 -+)(defconstant XK_Adiaeresis #x0c4 -+)(defconstant XK_Aring #x0c5 -+)(defconstant XK_AE #x0c6 -+)(defconstant XK_Ccedilla #x0c7 -+)(defconstant XK_Egrave #x0c8 -+)(defconstant XK_Eacute #x0c9 -+)(defconstant XK_Ecircumflex #x0ca -+)(defconstant XK_Ediaeresis #x0cb -+)(defconstant XK_Igrave #x0cc -+)(defconstant XK_Iacute #x0cd -+)(defconstant XK_Icircumflex #x0ce -+)(defconstant XK_Idiaeresis #x0cf -+)(defconstant XK_ETH #x0d0 -+)(defconstant XK_Eth #x0d0 ;; deprecated -+)(defconstant XK_Ntilde #x0d1 -+)(defconstant XK_Ograve #x0d2 -+)(defconstant XK_Oacute #x0d3 -+)(defconstant XK_Ocircumflex #x0d4 -+)(defconstant XK_Otilde #x0d5 -+)(defconstant XK_Odiaeresis #x0d6 -+)(defconstant XK_multiply #x0d7 -+)(defconstant XK_Ooblique #x0d8 -+)(defconstant XK_Ugrave #x0d9 -+)(defconstant XK_Uacute #x0da -+)(defconstant XK_Ucircumflex #x0db -+)(defconstant XK_Udiaeresis #x0dc -+)(defconstant XK_Yacute #x0dd -+)(defconstant XK_THORN #x0de -+)(defconstant XK_Thorn #x0de ;; deprecated -+)(defconstant XK_ssharp #x0df -+)(defconstant XK_agrave #x0e0 -+)(defconstant XK_aacute #x0e1 -+)(defconstant XK_acircumflex #x0e2 -+)(defconstant XK_atilde #x0e3 -+)(defconstant XK_adiaeresis #x0e4 -+)(defconstant XK_aring #x0e5 -+)(defconstant XK_ae #x0e6 -+)(defconstant XK_ccedilla #x0e7 -+)(defconstant XK_egrave #x0e8 -+)(defconstant XK_eacute #x0e9 -+)(defconstant XK_ecircumflex #x0ea -+)(defconstant XK_ediaeresis #x0eb -+)(defconstant XK_igrave #x0ec -+)(defconstant XK_iacute #x0ed -+)(defconstant XK_icircumflex #x0ee -+)(defconstant XK_idiaeresis #x0ef -+)(defconstant XK_eth #x0f0 -+)(defconstant XK_ntilde #x0f1 -+)(defconstant XK_ograve #x0f2 -+)(defconstant XK_oacute #x0f3 -+)(defconstant XK_ocircumflex #x0f4 -+)(defconstant XK_otilde #x0f5 -+)(defconstant XK_odiaeresis #x0f6 -+)(defconstant XK_division #x0f7 -+)(defconstant XK_oslash #x0f8 -+)(defconstant XK_ugrave #x0f9 -+)(defconstant XK_uacute #x0fa -+)(defconstant XK_ucircumflex #x0fb -+)(defconstant XK_udiaeresis #x0fc -+)(defconstant XK_yacute #x0fd -+)(defconstant XK_thorn #x0fe -+)(defconstant XK_ydiaeresis #x0ff -+;;endif ;; XK_LATIN1 -+ -+;; -+ ; Latin 2 -+ ; Byte 3 = 1 -+ -+ -+;;ifdef XK_LATIN2 -+)(defconstant XK_Aogonek #x1a1 -+)(defconstant XK_breve #x1a2 -+)(defconstant XK_Lstroke #x1a3 -+)(defconstant XK_Lcaron #x1a5 -+)(defconstant XK_Sacute #x1a6 -+)(defconstant XK_Scaron #x1a9 -+)(defconstant XK_Scedilla #x1aa -+)(defconstant XK_Tcaron #x1ab -+)(defconstant XK_Zacute #x1ac -+)(defconstant XK_Zcaron #x1ae -+)(defconstant XK_Zabovedot #x1af -+)(defconstant XK_aogonek #x1b1 -+)(defconstant XK_ogonek #x1b2 -+)(defconstant XK_lstroke #x1b3 -+)(defconstant XK_lcaron #x1b5 -+)(defconstant XK_sacute #x1b6 -+)(defconstant XK_caron #x1b7 -+)(defconstant XK_scaron #x1b9 -+)(defconstant XK_scedilla #x1ba -+)(defconstant XK_tcaron #x1bb -+)(defconstant XK_zacute #x1bc -+)(defconstant XK_doubleacute #x1bd -+)(defconstant XK_zcaron #x1be -+)(defconstant XK_zabovedot #x1bf -+)(defconstant XK_Racute #x1c0 -+)(defconstant XK_Abreve #x1c3 -+)(defconstant XK_Lacute #x1c5 -+)(defconstant XK_Cacute #x1c6 -+)(defconstant XK_Ccaron #x1c8 -+)(defconstant XK_Eogonek #x1ca -+)(defconstant XK_Ecaron #x1cc -+)(defconstant XK_Dcaron #x1cf -+)(defconstant XK_Dstroke #x1d0 -+)(defconstant XK_Nacute #x1d1 -+)(defconstant XK_Ncaron #x1d2 -+)(defconstant XK_Odoubleacute #x1d5 -+)(defconstant XK_Rcaron #x1d8 -+)(defconstant XK_Uring #x1d9 -+)(defconstant XK_Udoubleacute #x1db -+)(defconstant XK_Tcedilla #x1de -+)(defconstant XK_racute #x1e0 -+)(defconstant XK_abreve #x1e3 -+)(defconstant XK_lacute #x1e5 -+)(defconstant XK_cacute #x1e6 -+)(defconstant XK_ccaron #x1e8 -+)(defconstant XK_eogonek #x1ea -+)(defconstant XK_ecaron #x1ec -+)(defconstant XK_dcaron #x1ef -+)(defconstant XK_dstroke #x1f0 -+)(defconstant XK_nacute #x1f1 -+)(defconstant XK_ncaron #x1f2 -+)(defconstant XK_odoubleacute #x1f5 -+)(defconstant XK_udoubleacute #x1fb -+)(defconstant XK_rcaron #x1f8 -+)(defconstant XK_uring #x1f9 -+)(defconstant XK_tcedilla #x1fe -+)(defconstant XK_abovedot #x1ff -+;;endif ;; XK_LATIN2 -+ -+;; -+ ; Latin 3 -+ ; Byte 3 = 2 -+ -+ -+;;ifdef XK_LATIN3 -+)(defconstant XK_Hstroke #x2a1 -+)(defconstant XK_Hcircumflex #x2a6 -+)(defconstant XK_Iabovedot #x2a9 -+)(defconstant XK_Gbreve #x2ab -+)(defconstant XK_Jcircumflex #x2ac -+)(defconstant XK_hstroke #x2b1 -+)(defconstant XK_hcircumflex #x2b6 -+)(defconstant XK_idotless #x2b9 -+)(defconstant XK_gbreve #x2bb -+)(defconstant XK_jcircumflex #x2bc -+)(defconstant XK_Cabovedot #x2c5 -+)(defconstant XK_Ccircumflex #x2c6 -+)(defconstant XK_Gabovedot #x2d5 -+)(defconstant XK_Gcircumflex #x2d8 -+)(defconstant XK_Ubreve #x2dd -+)(defconstant XK_Scircumflex #x2de -+)(defconstant XK_cabovedot #x2e5 -+)(defconstant XK_ccircumflex #x2e6 -+)(defconstant XK_gabovedot #x2f5 -+)(defconstant XK_gcircumflex #x2f8 -+)(defconstant XK_ubreve #x2fd -+)(defconstant XK_scircumflex #x2fe -+;;endif ;; XK_LATIN3 -+ -+ -+;; -+ ; Latin 4 -+ ; Byte 3 = 3 -+ -+ -+;;ifdef XK_LATIN4 -+)(defconstant XK_kra #x3a2 -+)(defconstant XK_kappa #x3a2 ;; deprecated -+)(defconstant XK_Rcedilla #x3a3 -+)(defconstant XK_Itilde #x3a5 -+)(defconstant XK_Lcedilla #x3a6 -+)(defconstant XK_Emacron #x3aa -+)(defconstant XK_Gcedilla #x3ab -+)(defconstant XK_Tslash #x3ac -+)(defconstant XK_rcedilla #x3b3 -+)(defconstant XK_itilde #x3b5 -+)(defconstant XK_lcedilla #x3b6 -+)(defconstant XK_emacron #x3ba -+)(defconstant XK_gcedilla #x3bb -+)(defconstant XK_tslash #x3bc -+)(defconstant XK_ENG #x3bd -+)(defconstant XK_eng #x3bf -+)(defconstant XK_Amacron #x3c0 -+)(defconstant XK_Iogonek #x3c7 -+)(defconstant XK_Eabovedot #x3cc -+)(defconstant XK_Imacron #x3cf -+)(defconstant XK_Ncedilla #x3d1 -+)(defconstant XK_Omacron #x3d2 -+)(defconstant XK_Kcedilla #x3d3 -+)(defconstant XK_Uogonek #x3d9 -+)(defconstant XK_Utilde #x3dd -+)(defconstant XK_Umacron #x3de -+)(defconstant XK_amacron #x3e0 -+)(defconstant XK_iogonek #x3e7 -+)(defconstant XK_eabovedot #x3ec -+)(defconstant XK_imacron #x3ef -+)(defconstant XK_ncedilla #x3f1 -+)(defconstant XK_omacron #x3f2 -+)(defconstant XK_kcedilla #x3f3 -+)(defconstant XK_uogonek #x3f9 -+)(defconstant XK_utilde #x3fd -+)(defconstant XK_umacron #x3fe -+;;endif ;; XK_LATIN4 -+ -+;; -+ ; Katakana -+ ; Byte 3 = 4 -+ -+ -+;;ifdef XK_KATAKANA -+)(defconstant XK_overline #x47e -+)(defconstant XK_kana_fullstop #x4a1 -+)(defconstant XK_kana_openingbracket #x4a2 -+)(defconstant XK_kana_closingbracket #x4a3 -+)(defconstant XK_kana_comma #x4a4 -+)(defconstant XK_kana_conjunctive #x4a5 -+)(defconstant XK_kana_middledot #x4a5 ;; deprecated -+)(defconstant XK_kana_WO #x4a6 -+)(defconstant XK_kana_a #x4a7 -+)(defconstant XK_kana_i #x4a8 -+)(defconstant XK_kana_u #x4a9 -+)(defconstant XK_kana_e #x4aa -+)(defconstant XK_kana_o #x4ab -+)(defconstant XK_kana_ya #x4ac -+)(defconstant XK_kana_yu #x4ad -+)(defconstant XK_kana_yo #x4ae -+)(defconstant XK_kana_tsu #x4af -+)(defconstant XK_kana_tu #x4af ;; deprecated -+)(defconstant XK_prolongedsound #x4b0 -+)(defconstant XK_kana_A #x4b1 -+)(defconstant XK_kana_I #x4b2 -+)(defconstant XK_kana_U #x4b3 -+)(defconstant XK_kana_E #x4b4 -+)(defconstant XK_kana_O #x4b5 -+)(defconstant XK_kana_KA #x4b6 -+)(defconstant XK_kana_KI #x4b7 -+)(defconstant XK_kana_KU #x4b8 -+)(defconstant XK_kana_KE #x4b9 -+)(defconstant XK_kana_KO #x4ba -+)(defconstant XK_kana_SA #x4bb -+)(defconstant XK_kana_SHI #x4bc -+)(defconstant XK_kana_SU #x4bd -+)(defconstant XK_kana_SE #x4be -+)(defconstant XK_kana_SO #x4bf -+)(defconstant XK_kana_TA #x4c0 -+)(defconstant XK_kana_CHI #x4c1 -+)(defconstant XK_kana_TI #x4c1 ;; deprecated -+)(defconstant XK_kana_TSU #x4c2 -+)(defconstant XK_kana_TU #x4c2 ;; deprecated -+)(defconstant XK_kana_TE #x4c3 -+)(defconstant XK_kana_TO #x4c4 -+)(defconstant XK_kana_NA #x4c5 -+)(defconstant XK_kana_NI #x4c6 -+)(defconstant XK_kana_NU #x4c7 -+)(defconstant XK_kana_NE #x4c8 -+)(defconstant XK_kana_NO #x4c9 -+)(defconstant XK_kana_HA #x4ca -+)(defconstant XK_kana_HI #x4cb -+)(defconstant XK_kana_FU #x4cc -+)(defconstant XK_kana_HU #x4cc ;; deprecated -+)(defconstant XK_kana_HE #x4cd -+)(defconstant XK_kana_HO #x4ce -+)(defconstant XK_kana_MA #x4cf -+)(defconstant XK_kana_MI #x4d0 -+)(defconstant XK_kana_MU #x4d1 -+)(defconstant XK_kana_ME #x4d2 -+)(defconstant XK_kana_MO #x4d3 -+)(defconstant XK_kana_YA #x4d4 -+)(defconstant XK_kana_YU #x4d5 -+)(defconstant XK_kana_YO #x4d6 -+)(defconstant XK_kana_RA #x4d7 -+)(defconstant XK_kana_RI #x4d8 -+)(defconstant XK_kana_RU #x4d9 -+)(defconstant XK_kana_RE #x4da -+)(defconstant XK_kana_RO #x4db -+)(defconstant XK_kana_WA #x4dc -+)(defconstant XK_kana_N #x4dd -+)(defconstant XK_voicedsound #x4de -+)(defconstant XK_semivoicedsound #x4df -+)(defconstant XK_kana_switch #xFF7E ;; Alias for mode_switch -+;;endif ;; XK_KATAKANA -+ -+;; -+ ; Arabic -+ ; Byte 3 = 5 -+ -+ -+;;ifdef XK_ARABIC -+)(defconstant XK_Arabic_comma #x5ac -+)(defconstant XK_Arabic_semicolon #x5bb -+)(defconstant XK_Arabic_question_mark #x5bf -+)(defconstant XK_Arabic_hamza #x5c1 -+)(defconstant XK_Arabic_maddaonalef #x5c2 -+)(defconstant XK_Arabic_hamzaonalef #x5c3 -+)(defconstant XK_Arabic_hamzaonwaw #x5c4 -+)(defconstant XK_Arabic_hamzaunderalef #x5c5 -+)(defconstant XK_Arabic_hamzaonyeh #x5c6 -+)(defconstant XK_Arabic_alef #x5c7 -+)(defconstant XK_Arabic_beh #x5c8 -+)(defconstant XK_Arabic_tehmarbuta #x5c9 -+)(defconstant XK_Arabic_teh #x5ca -+)(defconstant XK_Arabic_theh #x5cb -+)(defconstant XK_Arabic_jeem #x5cc -+)(defconstant XK_Arabic_hah #x5cd -+)(defconstant XK_Arabic_khah #x5ce -+)(defconstant XK_Arabic_dal #x5cf -+)(defconstant XK_Arabic_thal #x5d0 -+)(defconstant XK_Arabic_ra #x5d1 -+)(defconstant XK_Arabic_zain #x5d2 -+)(defconstant XK_Arabic_seen #x5d3 -+)(defconstant XK_Arabic_sheen #x5d4 -+)(defconstant XK_Arabic_sad #x5d5 -+)(defconstant XK_Arabic_dad #x5d6 -+)(defconstant XK_Arabic_tah #x5d7 -+)(defconstant XK_Arabic_zah #x5d8 -+)(defconstant XK_Arabic_ain #x5d9 -+)(defconstant XK_Arabic_ghain #x5da -+)(defconstant XK_Arabic_tatweel #x5e0 -+)(defconstant XK_Arabic_feh #x5e1 -+)(defconstant XK_Arabic_qaf #x5e2 -+)(defconstant XK_Arabic_kaf #x5e3 -+)(defconstant XK_Arabic_lam #x5e4 -+)(defconstant XK_Arabic_meem #x5e5 -+)(defconstant XK_Arabic_noon #x5e6 -+)(defconstant XK_Arabic_ha #x5e7 -+)(defconstant XK_Arabic_heh #x5e7 ;; deprecated -+)(defconstant XK_Arabic_waw #x5e8 -+)(defconstant XK_Arabic_alefmaksura #x5e9 -+)(defconstant XK_Arabic_yeh #x5ea -+)(defconstant XK_Arabic_fathatan #x5eb -+)(defconstant XK_Arabic_dammatan #x5ec -+)(defconstant XK_Arabic_kasratan #x5ed -+)(defconstant XK_Arabic_fatha #x5ee -+)(defconstant XK_Arabic_damma #x5ef -+)(defconstant XK_Arabic_kasra #x5f0 -+)(defconstant XK_Arabic_shadda #x5f1 -+)(defconstant XK_Arabic_sukun #x5f2 -+)(defconstant XK_Arabic_switch #xFF7E ;; Alias for mode_switch -+;;endif ;; XK_ARABIC -+ -+;; -+ ; Cyrillic -+ ; Byte 3 = 6 -+ -+;;ifdef XK_CYRILLIC -+)(defconstant XK_Serbian_dje #x6a1 -+)(defconstant XK_Macedonia_gje #x6a2 -+)(defconstant XK_Cyrillic_io #x6a3 -+)(defconstant XK_Ukrainian_ie #x6a4 -+)(defconstant XK_Ukranian_je #x6a4 ;; deprecated -+)(defconstant XK_Macedonia_dse #x6a5 -+)(defconstant XK_Ukrainian_i #x6a6 -+)(defconstant XK_Ukranian_i #x6a6 ;; deprecated -+)(defconstant XK_Ukrainian_yi #x6a7 -+)(defconstant XK_Ukranian_yi #x6a7 ;; deprecated -+)(defconstant XK_Cyrillic_je #x6a8 -+)(defconstant XK_Serbian_je #x6a8 ;; deprecated -+)(defconstant XK_Cyrillic_lje #x6a9 -+)(defconstant XK_Serbian_lje #x6a9 ;; deprecated -+)(defconstant XK_Cyrillic_nje #x6aa -+)(defconstant XK_Serbian_nje #x6aa ;; deprecated -+)(defconstant XK_Serbian_tshe #x6ab -+)(defconstant XK_Macedonia_kje #x6ac -+)(defconstant XK_Byelorussian_shortu #x6ae -+)(defconstant XK_Cyrillic_dzhe #x6af -+)(defconstant XK_Serbian_dze #x6af ;; deprecated -+)(defconstant XK_numerosign #x6b0 -+)(defconstant XK_Serbian_DJE #x6b1 -+)(defconstant XK_Macedonia_GJE #x6b2 -+)(defconstant XK_Cyrillic_IO #x6b3 -+)(defconstant XK_Ukrainian_IE #x6b4 -+)(defconstant XK_Ukranian_JE #x6b4 ;; deprecated -+)(defconstant XK_Macedonia_DSE #x6b5 -+)(defconstant XK_Ukrainian_I #x6b6 -+)(defconstant XK_Ukranian_I #x6b6 ;; deprecated -+)(defconstant XK_Ukrainian_YI #x6b7 -+)(defconstant XK_Ukranian_YI #x6b7 ;; deprecated -+)(defconstant XK_Cyrillic_JE #x6b8 -+)(defconstant XK_Serbian_JE #x6b8 ;; deprecated -+)(defconstant XK_Cyrillic_LJE #x6b9 -+)(defconstant XK_Serbian_LJE #x6b9 ;; deprecated -+)(defconstant XK_Cyrillic_NJE #x6ba -+)(defconstant XK_Serbian_NJE #x6ba ;; deprecated -+)(defconstant XK_Serbian_TSHE #x6bb -+)(defconstant XK_Macedonia_KJE #x6bc -+)(defconstant XK_Byelorussian_SHORTU #x6be -+)(defconstant XK_Cyrillic_DZHE #x6bf -+)(defconstant XK_Serbian_DZE #x6bf ;; deprecated -+)(defconstant XK_Cyrillic_yu #x6c0 -+)(defconstant XK_Cyrillic_a #x6c1 -+)(defconstant XK_Cyrillic_be #x6c2 -+)(defconstant XK_Cyrillic_tse #x6c3 -+)(defconstant XK_Cyrillic_de #x6c4 -+)(defconstant XK_Cyrillic_ie #x6c5 -+)(defconstant XK_Cyrillic_ef #x6c6 -+)(defconstant XK_Cyrillic_ghe #x6c7 -+)(defconstant XK_Cyrillic_ha #x6c8 -+)(defconstant XK_Cyrillic_i #x6c9 -+)(defconstant XK_Cyrillic_shorti #x6ca -+)(defconstant XK_Cyrillic_ka #x6cb -+)(defconstant XK_Cyrillic_el #x6cc -+)(defconstant XK_Cyrillic_em #x6cd -+)(defconstant XK_Cyrillic_en #x6ce -+)(defconstant XK_Cyrillic_o #x6cf -+)(defconstant XK_Cyrillic_pe #x6d0 -+)(defconstant XK_Cyrillic_ya #x6d1 -+)(defconstant XK_Cyrillic_er #x6d2 -+)(defconstant XK_Cyrillic_es #x6d3 -+)(defconstant XK_Cyrillic_te #x6d4 -+)(defconstant XK_Cyrillic_u #x6d5 -+)(defconstant XK_Cyrillic_zhe #x6d6 -+)(defconstant XK_Cyrillic_ve #x6d7 -+)(defconstant XK_Cyrillic_softsign #x6d8 -+)(defconstant XK_Cyrillic_yeru #x6d9 -+)(defconstant XK_Cyrillic_ze #x6da -+)(defconstant XK_Cyrillic_sha #x6db -+)(defconstant XK_Cyrillic_e #x6dc -+)(defconstant XK_Cyrillic_shcha #x6dd -+)(defconstant XK_Cyrillic_che #x6de -+)(defconstant XK_Cyrillic_hardsign #x6df -+)(defconstant XK_Cyrillic_YU #x6e0 -+)(defconstant XK_Cyrillic_A #x6e1 -+)(defconstant XK_Cyrillic_BE #x6e2 -+)(defconstant XK_Cyrillic_TSE #x6e3 -+)(defconstant XK_Cyrillic_DE #x6e4 -+)(defconstant XK_Cyrillic_IE #x6e5 -+)(defconstant XK_Cyrillic_EF #x6e6 -+)(defconstant XK_Cyrillic_GHE #x6e7 -+)(defconstant XK_Cyrillic_HA #x6e8 -+)(defconstant XK_Cyrillic_I #x6e9 -+)(defconstant XK_Cyrillic_SHORTI #x6ea -+)(defconstant XK_Cyrillic_KA #x6eb -+)(defconstant XK_Cyrillic_EL #x6ec -+)(defconstant XK_Cyrillic_EM #x6ed -+)(defconstant XK_Cyrillic_EN #x6ee -+)(defconstant XK_Cyrillic_O #x6ef -+)(defconstant XK_Cyrillic_PE #x6f0 -+)(defconstant XK_Cyrillic_YA #x6f1 -+)(defconstant XK_Cyrillic_ER #x6f2 -+)(defconstant XK_Cyrillic_ES #x6f3 -+)(defconstant XK_Cyrillic_TE #x6f4 -+)(defconstant XK_Cyrillic_U #x6f5 -+)(defconstant XK_Cyrillic_ZHE #x6f6 -+)(defconstant XK_Cyrillic_VE #x6f7 -+)(defconstant XK_Cyrillic_SOFTSIGN #x6f8 -+)(defconstant XK_Cyrillic_YERU #x6f9 -+)(defconstant XK_Cyrillic_ZE #x6fa -+)(defconstant XK_Cyrillic_SHA #x6fb -+)(defconstant XK_Cyrillic_E #x6fc -+)(defconstant XK_Cyrillic_SHCHA #x6fd -+)(defconstant XK_Cyrillic_CHE #x6fe -+)(defconstant XK_Cyrillic_HARDSIGN #x6ff -+;;endif ;; XK_CYRILLIC -+ -+;; -+ ; Greek -+ ; Byte 3 = 7 -+ -+ -+;;ifdef XK_GREEK -+)(defconstant XK_Greek_ALPHAaccent #x7a1 -+)(defconstant XK_Greek_EPSILONaccent #x7a2 -+)(defconstant XK_Greek_ETAaccent #x7a3 -+)(defconstant XK_Greek_IOTAaccent #x7a4 -+)(defconstant XK_Greek_IOTAdiaeresis #x7a5 -+)(defconstant XK_Greek_OMICRONaccent #x7a7 -+)(defconstant XK_Greek_UPSILONaccent #x7a8 -+)(defconstant XK_Greek_UPSILONdieresis #x7a9 -+)(defconstant XK_Greek_OMEGAaccent #x7ab -+)(defconstant XK_Greek_accentdieresis #x7ae -+)(defconstant XK_Greek_horizbar #x7af -+)(defconstant XK_Greek_alphaaccent #x7b1 -+)(defconstant XK_Greek_epsilonaccent #x7b2 -+)(defconstant XK_Greek_etaaccent #x7b3 -+)(defconstant XK_Greek_iotaaccent #x7b4 -+)(defconstant XK_Greek_iotadieresis #x7b5 -+)(defconstant XK_Greek_iotaaccentdieresis #x7b6 -+)(defconstant XK_Greek_omicronaccent #x7b7 -+)(defconstant XK_Greek_upsilonaccent #x7b8 -+)(defconstant XK_Greek_upsilondieresis #x7b9 -+)(defconstant XK_Greek_upsilonaccentdieresis #x7ba -+)(defconstant XK_Greek_omegaaccent #x7bb -+)(defconstant XK_Greek_ALPHA #x7c1 -+)(defconstant XK_Greek_BETA #x7c2 -+)(defconstant XK_Greek_GAMMA #x7c3 -+)(defconstant XK_Greek_DELTA #x7c4 -+)(defconstant XK_Greek_EPSILON #x7c5 -+)(defconstant XK_Greek_ZETA #x7c6 -+)(defconstant XK_Greek_ETA #x7c7 -+)(defconstant XK_Greek_THETA #x7c8 -+)(defconstant XK_Greek_IOTA #x7c9 -+)(defconstant XK_Greek_KAPPA #x7ca -+)(defconstant XK_Greek_LAMDA #x7cb -+)(defconstant XK_Greek_LAMBDA #x7cb -+)(defconstant XK_Greek_MU #x7cc -+)(defconstant XK_Greek_NU #x7cd -+)(defconstant XK_Greek_XI #x7ce -+)(defconstant XK_Greek_OMICRON #x7cf -+)(defconstant XK_Greek_PI #x7d0 -+)(defconstant XK_Greek_RHO #x7d1 -+)(defconstant XK_Greek_SIGMA #x7d2 -+)(defconstant XK_Greek_TAU #x7d4 -+)(defconstant XK_Greek_UPSILON #x7d5 -+)(defconstant XK_Greek_PHI #x7d6 -+)(defconstant XK_Greek_CHI #x7d7 -+)(defconstant XK_Greek_PSI #x7d8 -+)(defconstant XK_Greek_OMEGA #x7d9 -+)(defconstant XK_Greek_alpha #x7e1 -+)(defconstant XK_Greek_beta #x7e2 -+)(defconstant XK_Greek_gamma #x7e3 -+)(defconstant XK_Greek_delta #x7e4 -+)(defconstant XK_Greek_epsilon #x7e5 -+)(defconstant XK_Greek_zeta #x7e6 -+)(defconstant XK_Greek_eta #x7e7 -+)(defconstant XK_Greek_theta #x7e8 -+)(defconstant XK_Greek_iota #x7e9 -+)(defconstant XK_Greek_kappa #x7ea -+)(defconstant XK_Greek_lamda #x7eb -+)(defconstant XK_Greek_lambda #x7eb -+)(defconstant XK_Greek_mu #x7ec -+)(defconstant XK_Greek_nu #x7ed -+)(defconstant XK_Greek_xi #x7ee -+)(defconstant XK_Greek_omicron #x7ef -+)(defconstant XK_Greek_pi #x7f0 -+)(defconstant XK_Greek_rho #x7f1 -+)(defconstant XK_Greek_sigma #x7f2 -+)(defconstant XK_Greek_finalsmallsigma #x7f3 -+)(defconstant XK_Greek_tau #x7f4 -+)(defconstant XK_Greek_upsilon #x7f5 -+)(defconstant XK_Greek_phi #x7f6 -+)(defconstant XK_Greek_chi #x7f7 -+)(defconstant XK_Greek_psi #x7f8 -+)(defconstant XK_Greek_omega #x7f9 -+)(defconstant XK_Greek_switch #xFF7E ;; Alias for mode_switch -+;;endif ;; XK_GREEK -+ -+;; -+ ; Technical -+ ; Byte 3 = 8 -+ -+ -+;;ifdef XK_TECHNICAL -+)(defconstant XK_leftradical #x8a1 -+)(defconstant XK_topleftradical #x8a2 -+)(defconstant XK_horizconnector #x8a3 -+)(defconstant XK_topintegral #x8a4 -+)(defconstant XK_botintegral #x8a5 -+)(defconstant XK_vertconnector #x8a6 -+)(defconstant XK_topleftsqbracket #x8a7 -+)(defconstant XK_botleftsqbracket #x8a8 -+)(defconstant XK_toprightsqbracket #x8a9 -+)(defconstant XK_botrightsqbracket #x8aa -+)(defconstant XK_topleftparens #x8ab -+)(defconstant XK_botleftparens #x8ac -+)(defconstant XK_toprightparens #x8ad -+)(defconstant XK_botrightparens #x8ae -+)(defconstant XK_leftmiddlecurlybrace #x8af -+)(defconstant XK_rightmiddlecurlybrace #x8b0 -+)(defconstant XK_topleftsummation #x8b1 -+)(defconstant XK_botleftsummation #x8b2 -+)(defconstant XK_topvertsummationconnector #x8b3 -+)(defconstant XK_botvertsummationconnector #x8b4 -+)(defconstant XK_toprightsummation #x8b5 -+)(defconstant XK_botrightsummation #x8b6 -+)(defconstant XK_rightmiddlesummation #x8b7 -+)(defconstant XK_lessthanequal #x8bc -+)(defconstant XK_notequal #x8bd -+)(defconstant XK_greaterthanequal #x8be -+)(defconstant XK_integral #x8bf -+)(defconstant XK_therefore #x8c0 -+)(defconstant XK_variation #x8c1 -+)(defconstant XK_infinity #x8c2 -+)(defconstant XK_nabla #x8c5 -+)(defconstant XK_approximate #x8c8 -+)(defconstant XK_similarequal #x8c9 -+)(defconstant XK_ifonlyif #x8cd -+)(defconstant XK_implies #x8ce -+)(defconstant XK_identical #x8cf -+)(defconstant XK_radical #x8d6 -+)(defconstant XK_includedin #x8da -+)(defconstant XK_includes #x8db -+)(defconstant XK_intersection #x8dc -+)(defconstant XK_union #x8dd -+)(defconstant XK_logicaland #x8de -+)(defconstant XK_logicalor #x8df -+)(defconstant XK_partialderivative #x8ef -+)(defconstant XK_function #x8f6 -+)(defconstant XK_leftarrow #x8fb -+)(defconstant XK_uparrow #x8fc -+)(defconstant XK_rightarrow #x8fd -+)(defconstant XK_downarrow #x8fe -+;;endif ;; XK_TECHNICAL -+ -+;; -+ ; Special -+ ; Byte 3 = 9 -+ -+ -+;;ifdef XK_SPECIAL -+)(defconstant XK_blank #x9df -+)(defconstant XK_soliddiamond #x9e0 -+)(defconstant XK_checkerboard #x9e1 -+)(defconstant XK_ht #x9e2 -+)(defconstant XK_ff #x9e3 -+)(defconstant XK_cr #x9e4 -+)(defconstant XK_lf #x9e5 -+)(defconstant XK_nl #x9e8 -+)(defconstant XK_vt #x9e9 -+)(defconstant XK_lowrightcorner #x9ea -+)(defconstant XK_uprightcorner #x9eb -+)(defconstant XK_upleftcorner #x9ec -+)(defconstant XK_lowleftcorner #x9ed -+)(defconstant XK_crossinglines #x9ee -+)(defconstant XK_horizlinescan1 #x9ef -+)(defconstant XK_horizlinescan3 #x9f0 -+)(defconstant XK_horizlinescan5 #x9f1 -+)(defconstant XK_horizlinescan7 #x9f2 -+)(defconstant XK_horizlinescan9 #x9f3 -+)(defconstant XK_leftt #x9f4 -+)(defconstant XK_rightt #x9f5 -+)(defconstant XK_bott #x9f6 -+)(defconstant XK_topt #x9f7 -+)(defconstant XK_vertbar #x9f8 -+;;endif ;; XK_SPECIAL -+ -+;; -+ ; Publishing -+ ; Byte 3 = a -+ -+ -+;;ifdef XK_PUBLISHING -+)(defconstant XK_emspace #xaa1 -+)(defconstant XK_enspace #xaa2 -+)(defconstant XK_em3space #xaa3 -+)(defconstant XK_em4space #xaa4 -+)(defconstant XK_digitspace #xaa5 -+)(defconstant XK_punctspace #xaa6 -+)(defconstant XK_thinspace #xaa7 -+)(defconstant XK_hairspace #xaa8 -+)(defconstant XK_emdash #xaa9 -+)(defconstant XK_endash #xaaa -+)(defconstant XK_signifblank #xaac -+)(defconstant XK_ellipsis #xaae -+)(defconstant XK_doubbaselinedot #xaaf -+)(defconstant XK_onethird #xab0 -+)(defconstant XK_twothirds #xab1 -+)(defconstant XK_onefifth #xab2 -+)(defconstant XK_twofifths #xab3 -+)(defconstant XK_threefifths #xab4 -+)(defconstant XK_fourfifths #xab5 -+)(defconstant XK_onesixth #xab6 -+)(defconstant XK_fivesixths #xab7 -+)(defconstant XK_careof #xab8 -+)(defconstant XK_figdash #xabb -+)(defconstant XK_leftanglebracket #xabc -+)(defconstant XK_decimalpoint #xabd -+)(defconstant XK_rightanglebracket #xabe -+)(defconstant XK_marker #xabf -+)(defconstant XK_oneeighth #xac3 -+)(defconstant XK_threeeighths #xac4 -+)(defconstant XK_fiveeighths #xac5 -+)(defconstant XK_seveneighths #xac6 -+)(defconstant XK_trademark #xac9 -+)(defconstant XK_signaturemark #xaca -+)(defconstant XK_trademarkincircle #xacb -+)(defconstant XK_leftopentriangle #xacc -+)(defconstant XK_rightopentriangle #xacd -+)(defconstant XK_emopencircle #xace -+)(defconstant XK_emopenrectangle #xacf -+)(defconstant XK_leftsinglequotemark #xad0 -+)(defconstant XK_rightsinglequotemark #xad1 -+)(defconstant XK_leftdoublequotemark #xad2 -+)(defconstant XK_rightdoublequotemark #xad3 -+)(defconstant XK_prescription #xad4 -+)(defconstant XK_minutes #xad6 -+)(defconstant XK_seconds #xad7 -+)(defconstant XK_latincross #xad9 -+)(defconstant XK_hexagram #xada -+)(defconstant XK_filledrectbullet #xadb -+)(defconstant XK_filledlefttribullet #xadc -+)(defconstant XK_filledrighttribullet #xadd -+)(defconstant XK_emfilledcircle #xade -+)(defconstant XK_emfilledrect #xadf -+)(defconstant XK_enopencircbullet #xae0 -+)(defconstant XK_enopensquarebullet #xae1 -+)(defconstant XK_openrectbullet #xae2 -+)(defconstant XK_opentribulletup #xae3 -+)(defconstant XK_opentribulletdown #xae4 -+)(defconstant XK_openstar #xae5 -+)(defconstant XK_enfilledcircbullet #xae6 -+)(defconstant XK_enfilledsqbullet #xae7 -+)(defconstant XK_filledtribulletup #xae8 -+)(defconstant XK_filledtribulletdown #xae9 -+)(defconstant XK_leftpointer #xaea -+)(defconstant XK_rightpointer #xaeb -+)(defconstant XK_club #xaec -+)(defconstant XK_diamond #xaed -+)(defconstant XK_heart #xaee -+)(defconstant XK_maltesecross #xaf0 -+)(defconstant XK_dagger #xaf1 -+)(defconstant XK_doubledagger #xaf2 -+)(defconstant XK_checkmark #xaf3 -+)(defconstant XK_ballotcross #xaf4 -+)(defconstant XK_musicalsharp #xaf5 -+)(defconstant XK_musicalflat #xaf6 -+)(defconstant XK_malesymbol #xaf7 -+)(defconstant XK_femalesymbol #xaf8 -+)(defconstant XK_telephone #xaf9 -+)(defconstant XK_telephonerecorder #xafa -+)(defconstant XK_phonographcopyright #xafb -+)(defconstant XK_caret #xafc -+)(defconstant XK_singlelowquotemark #xafd -+)(defconstant XK_doublelowquotemark #xafe -+)(defconstant XK_cursor #xaff -+;;endif ;; XK_PUBLISHING -+ -+;; -+ ; APL -+ ; Byte 3 = b -+ -+ -+;;ifdef XK_APL -+)(defconstant XK_leftcaret #xba3 -+)(defconstant XK_rightcaret #xba6 -+)(defconstant XK_downcaret #xba8 -+)(defconstant XK_upcaret #xba9 -+)(defconstant XK_overbar #xbc0 -+)(defconstant XK_downtack #xbc2 -+)(defconstant XK_upshoe #xbc3 -+)(defconstant XK_downstile #xbc4 -+)(defconstant XK_underbar #xbc6 -+)(defconstant XK_jot #xbca -+)(defconstant XK_quad #xbcc -+)(defconstant XK_uptack #xbce -+)(defconstant XK_circle #xbcf -+)(defconstant XK_upstile #xbd3 -+)(defconstant XK_downshoe #xbd6 -+)(defconstant XK_rightshoe #xbd8 -+)(defconstant XK_leftshoe #xbda -+)(defconstant XK_lefttack #xbdc -+)(defconstant XK_righttack #xbfc -+;;endif ;; XK_APL -+ -+;; -+ ; Hebrew -+ ; Byte 3 = c -+ -+ -+;;ifdef XK_HEBREW -+)(defconstant XK_hebrew_doublelowline #xcdf -+)(defconstant XK_hebrew_aleph #xce0 -+)(defconstant XK_hebrew_bet #xce1 -+)(defconstant XK_hebrew_beth #xce1 ;; deprecated -+)(defconstant XK_hebrew_gimel #xce2 -+)(defconstant XK_hebrew_gimmel #xce2 ;; deprecated -+)(defconstant XK_hebrew_dalet #xce3 -+)(defconstant XK_hebrew_daleth #xce3 ;; deprecated -+)(defconstant XK_hebrew_he #xce4 -+)(defconstant XK_hebrew_waw #xce5 -+)(defconstant XK_hebrew_zain #xce6 -+)(defconstant XK_hebrew_zayin #xce6 ;; deprecated -+)(defconstant XK_hebrew_chet #xce7 -+)(defconstant XK_hebrew_het #xce7 ;; deprecated -+)(defconstant XK_hebrew_tet #xce8 -+)(defconstant XK_hebrew_teth #xce8 ;; deprecated -+)(defconstant XK_hebrew_yod #xce9 -+)(defconstant XK_hebrew_finalkaph #xcea -+)(defconstant XK_hebrew_kaph #xceb -+)(defconstant XK_hebrew_lamed #xcec -+)(defconstant XK_hebrew_finalmem #xced -+)(defconstant XK_hebrew_mem #xcee -+)(defconstant XK_hebrew_finalnun #xcef -+)(defconstant XK_hebrew_nun #xcf0 -+)(defconstant XK_hebrew_samech #xcf1 -+)(defconstant XK_hebrew_samekh #xcf1 ;; deprecated -+)(defconstant XK_hebrew_ayin #xcf2 -+)(defconstant XK_hebrew_finalpe #xcf3 -+)(defconstant XK_hebrew_pe #xcf4 -+)(defconstant XK_hebrew_finalzade #xcf5 -+)(defconstant XK_hebrew_finalzadi #xcf5 ;; deprecated -+)(defconstant XK_hebrew_zade #xcf6 -+)(defconstant XK_hebrew_zadi #xcf6 ;; deprecated -+)(defconstant XK_hebrew_qoph #xcf7 -+)(defconstant XK_hebrew_kuf #xcf7 ;; deprecated -+)(defconstant XK_hebrew_resh #xcf8 -+)(defconstant XK_hebrew_shin #xcf9 -+)(defconstant XK_hebrew_taw #xcfa -+)(defconstant XK_hebrew_taf #xcfa ;; deprecated -+)(defconstant XK_Hebrew_switch #xFF7E ;; Alias for mode_switch -+;;endif ;; XK_HEBREW -+) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_dwtestcases.lsp -@@ -0,0 +1,32 @@ -+(load "/stage/ftp/pub/novak/xgcl-4/gcl_dwtrans.lsp") -+(use-package 'xlib) -+(load "/stage/ftp/pub/novak/xgcl-4/gcl_drawtrans.lsp") -+(load "/stage/ftp/pub/novak/xgcl-4/gcl_editorstrans.lsp") -+(load "/stage/ftp/pub/novak/xgcl-4/gcl_lispservertrans.lsp") -+(load "/stage/ftp/pub/novak/xgcl-4/gcl_menu-settrans.lsp") -+(load "/stage/ftp/pub/novak/xgcl-4/gcl_dwtest.lsp") -+(load "/stage/ftp/pub/novak/xgcl-4/gcl_draw-gates.lsp") -+ -+(wtesta) -+(wtestb) -+(wtestc) -+(wtestd) -+(wteste) -+(wtestf) -+(wtestg) -+(wtesth) -+(wtesti) -+(wtestj) -+(wtestk) -+ -+(window-clear myw) -+(edit-color myw) -+ -+(lisp-server) -+ -+(draw 'foo) -+ -+(window-draw-box-xy myw 48 48 204 204) -+(window-edit myw 50 50 200 200 '("Now is the time" "for all" "good")) -+ -+(draw-nand myw 50 50) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_lispserver.lsp -@@ -0,0 +1,130 @@ -+; lispserver.lsp Gordon S. Novak Jr. ; 26 Jan 06 -+ -+; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. -+ -+; 06 Jun 02 -+ -+; See the file gnu.license . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Written by: Gordon S. Novak Jr., Department of Computer Sciences, -+; University of Texas at Austin 78712. novak@cs.utexas.edu -+ -+;------------------------------------------------------------------------ -+ -+; This is an example of a simple interactive graphical interface -+; to a Lisp program. It reads Lisp expressions from the user, -+; evaluates them, and prints the result. -+ -+; Stand-alone usage using XGCL (edit file paths as appropriate): -+; (load "/u/novak/X/xgcl-2/dwsyms.lsp") -+; (load "/u/novak/X/xgcl-2/dwimports.lsp") -+; (load "/u/novak/X/solaris/dwtrans.o") -+; (load "/u/novak/glisp/menu-settrans.lsp") -+; (load "/u/novak/glisp/lispservertrans.lsp") -+; (lisp-server) -+ -+; Usage with the WeirdX Java emulation of an X server begins with -+; the web page example.html and uses the files lispserver.cgi , -+; nph-lisp-action.cgi , and lispdemo.lsp . -+ -+;------------------------------------------------------------------------ -+ -+(defvar *wio-window* nil) -+(defvar *wio-window-width* 500) -+(defvar *wio-window-height* 300) -+(defvar *wio-menu-set* nil) -+(defvar *wio-font* '8x13) -+ -+(glispglobals (*wio-window* window) -+ (*wio-window-width* integer) -+ (*wio-window-height* integer) -+ (*wio-menu-set* menu-set) ) -+ -+(defmacro while (test &rest forms) -+ `(loop (unless ,test (return)) ,@forms) ) -+ -+; 18 Apr 95; 20 Apr 95; 08 May 95; 31 May 02 -+; Make a window to use. -+(setf (glfnresulttype 'wio-window) 'window) -+(defun wio-window (&optional title width height (posx 0) (posy 0) font) -+ (if width (setq *wio-window-width* width)) -+ (if height (setq *wio-window-height* height)) -+ (or *wio-window* -+ (setq *wio-window* -+ (window-create *wio-window-width* *wio-window-height* title -+ nil posx posy font))) ) -+ -+; 19 Apr 95 -+(defun wio-init-menus (w commands) -+ (let () -+ (window-clear w) -+ (setq *wio-menu-set* (menu-set-create w nil)) -+ (menu-set-add-menu *wio-menu-set* 'command nil "Commands" -+ commands (list 0 0)) -+ (menu-set-adjust *wio-menu-set* 'command 'top nil 2) -+ (menu-set-adjust *wio-menu-set* 'command 'right nil 2) -+ )) -+ -+; 19 Apr 95; 20 Apr 95; 25 Apr 95; 02 May 95; 29 May 02 -+; Lisp server example -+(gldefun lisp-server () -+ (let (w inputm done sel (redraw t) str result) -+ (w = (wio-window "Lisp Server")) -+ (open w) -+ (clear w) -+ (set-font w *wio-font*) -+ (wio-init-menus w '(("Quit" . quit))) -+ (window-print-lines w -+ '("Click mouse in the input box, then enter" -+ "a Lisp expression followed by Return." -+ "" -+ "Input: e.g. (+ 3 4) or (sqrt 2)") -+ 10 (- *wio-window-height* 20)) -+ (window-printat-xy w "Result:" 10 (- *wio-window-height* 150)) -+ (inputm = (textmenu-create (- *wio-window-width* 100) 30 nil w -+ 20 (- *wio-window-height* 110) t t '9x15 t)) -+ (add-item *wio-menu-set* 'input nil inputm) -+ (while ~ done do -+ (sel = (menu-set-select *wio-menu-set* redraw)) -+ (redraw = nil) -+ (case (menu-name sel) -+ (command -+ (case (port sel) -+ (quit (done = t)) -+ )) -+ (input (str = (port sel)) -+ (result = (catch 'error -+ (eval (safe-read-from-string str)))) -+ (erase-area-xy w 20 2 (- *wio-window-width* 20) -+ (- *wio-window-height* 160)) -+ (window-print-line w (write-to-string result :pretty t) -+ 20 (- *wio-window-height* 170))) -+ ) ) -+ (close w) -+ )) -+ -+; 25 Apr 95; 14 Mar 01 -+(defun safe-read-from-string (str) -+ (if (and (stringp str) (> (length str) 0)) -+ (read-from-string str nil 'read-error))) -+ -+(defun compile-lispserver () -+ (glcompfiles *directory* -+ '("glisp/vector.lsp") ; auxiliary files -+ '("glisp/lispserver.lsp") ; translated files -+ "glisp/lispservertrans.lsp") ; output file -+ ) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_draw-gates.lsp -@@ -0,0 +1,101 @@ -+; draw-gates.lsp Gordon S. Novak Jr. 20 Oct 94 -+ -+; Copyright (c) 1995 Gordon S. Novak Jr. and The University of Texas at Austin. -+ -+; See the file gnu.license . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Written by: Gordon S. Novak Jr., Department of Computer Sciences, -+; University of Texas at Austin 78712. novak@cs.utexas.edu -+ -+(defun draw-nand (w x y) -+ (window-draw-arc-xy w (+ x 24) (+ y 16) 16 16 -90 180) -+ (window-draw-circle-xy w (+ x 45) (+ y 16) 4) -+ (window-draw-line-xy w (+ x 24) (+ y 32) x (+ y 32)) -+ (window-draw-line-xy w x (+ y 32) x y) -+ (window-draw-line-xy w x y (+ x 24) y) -+ (window-force-output w)) -+ -+(setf (get 'nand 'picmenu-spec) -+ '(picmenu-spec 52 32 ((in1 (0 26)) (in2 (0 6)) (out (50 16))) t -+ draw-nand 9x15)) -+ -+(defun draw-and (w x y) -+ (window-draw-arc-xy w (+ x 24) (+ y 16) 16 16 -90 180) -+ (window-draw-line-xy w (+ x 24) (+ y 32) x (+ y 32)) -+ (window-draw-line-xy w x (+ y 32) x y) -+ (window-draw-line-xy w x y (+ x 24) y) -+ (window-force-output w)) -+ -+(setf (get 'and 'picmenu-spec) -+ '(picmenu-spec 40 32 ((in1 (0 26)) (in2 (0 6)) (out (40 16))) t -+ draw-and 9x15)) -+ -+(defun draw-not (w x y) -+ (window-draw-line-xy w x (+ y 24) (+ x 21) (+ y 12)) -+ (window-draw-line-xy w x y (+ x 21) (+ y 12)) -+ (window-draw-line-xy w x y x (+ y 24)) -+ (window-draw-circle-xy w (+ x 23) (+ y 12) 3) -+ (window-force-output w)) -+ -+(setf (get 'not 'picmenu-spec) -+ '(picmenu-spec 27 24 ((in (0 12)) (out (27 12))) t -+ draw-not 9x15)) -+ -+(defun draw-or (w x y) -+ (window-draw-arc-xy w x (- y 26) 58 58 46.4 43.6) -+ (window-draw-arc-xy w x (+ y 58) 58 58 270.0 43.6) -+ (window-draw-arc-xy w (- x 16) (+ y 16) 23 23 315 90) -+ (window-force-output w) ) -+ -+(setf (get 'or 'picmenu-spec) -+ '(picmenu-spec 40 32 ((in1 (6 26)) (in2 (6 6)) (out (40 16))) t -+ draw-or 9x15)) -+ -+(defun draw-xor (w x y) -+ (window-draw-arc-xy w (- x 16) (+ y 16) 23 23 315 90) -+ (draw-or w (+ x 6) y))) -+ -+(setf (get 'xor 'picmenu-spec) -+ '(picmenu-spec 46 32 ((in1 (6 26)) (in2 (6 6)) (out (46 16))) t -+ draw-xor 9x15)) -+ -+(defun draw-nor (w x y) -+ (window-draw-circle-xy w (+ x 44) (+ y 16) 4) -+ (draw-or w x y))) -+ -+(setf (get 'nor 'picmenu-spec) -+ '(picmenu-spec 48 32 ((in1 (0 26)) (in2 (0 6)) (out (48 16))) t -+ draw-nor 9x15)) -+ -+ -+(defun draw-nor2 (w x y) -+ (window-draw-circle-xy w (+ x 4) (+ y 6) 4) -+ (window-draw-circle-xy w (+ x 4) (+ y 26) 4) -+ (draw-and w (+ x 8) y))) -+ -+(setf (get 'nor2 'picmenu-spec) -+ '(picmenu-spec 48 32 ((in1 (0 26)) (in2 (0 6)) (out (48 16))) t -+ draw-nor2 9x15)) -+ -+(defun draw-nand2 (w x y) -+ (window-draw-circle-xy w (+ x 4) (+ y 6) 4) -+ (window-draw-circle-xy w (+ x 4) (+ y 26) 4) -+ (draw-or w (+ x 4) y))) -+ -+(setf (get 'nand2 'picmenu-spec) -+ '(picmenu-spec 44 32 ((in1 (0 26)) (in2 (0 6)) (out (44 16))) t -+ draw-nand2 9x15)) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_dwimports.lsp -@@ -0,0 +1,77 @@ -+; dwimports.lsp Gordon S. Novak Jr. 08 Sep 06 -+ -+; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. -+ -+; This file imports symbols of the XGCL package; these symbols may be -+; needed by a more serious user of some of the XGCL functions. -+ -+; See the file gnu.license . -+ -+; This program 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 program 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 program; if not, write to the Free Software -+; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -+ -+; Some of the files that interface to the Xlib are adapted from DEC/MIT files. -+; See the file dec.copyright for details. -+ -+; This file should be loaded immediately after starting Lisp: -+; If Lisp has seen any of these symbols, loading this file will cause an error. -+ -+(dolist (x '( xlib::picmenu-spec xlib::picmenu-button xlib::rgb -+ xlib::menu-window xlib::flat xlib::parent-window xlib::parent-offset-x -+ xlib::parent-offset-y xlib::picture-width xlib::picture-height -+ xlib::title xlib::permanent xlib::menu-font xlib::item-width xlib::item-height -+ xlib::items xlib::menuw xlib::title-present xlib::width xlib::height -+ xlib::base-x xlib::base-y xlib::offset xlib::size xlib::region xlib::voffset -+ xlib::vsize xlib::init xlib::init? xlib::contains? xlib::create xlib::clear -+ xlib::select xlib::select! xlib::choose xlib::draw xlib::destroy -+ xlib::moveto-xy xlib::reposition xlib::box-item xlib::unbox-item -+ xlib::display-item xlib::item-value xlib::item-position xlib::find-item-width -+ xlib::find-item-height xlib::adjust-offset xlib::calculate-size -+ xlib::menu-x xlib::menu-y xlib::spec xlib::boxflg xlib::deleted-buttons -+ xlib::draw-button xlib::delete-named-button xlib::drawing-width -+ xlib::drawing-height xlib::buttons xlib::dotflg xlib::drawfn xlib::menu-font -+ xlib::offset xlib::size xlib::highlightfn xlib::unhighlightfn -+ xlib::containsxy? xlib::color xlib::value xlib::maxval xlib::barwidth -+ xlib::horizontal xlib::subtrackfn xlib::subtrackparms xlib::update-value -+ xlib::gcontext xlib::parent xlib::drawable-height xlib::drawable-width -+ xlib::label xlib::font xlib::width xlib::height xlib::left xlib::right -+ xlib::top-neg-y xlib::leftmargin xlib::rightmargin xlib::yposition -+ xlib::wfunction xlib::foreground xlib::background xlib::force-output -+ xlib::set-font xlib::set-foreground xlib::set-background -+ xlib::set-cursor xlib::set-erase xlib::set-xor xlib::set-invert xlib::set-copy -+ xlib::set-line-width xlib::set-line-attr xlib::std-line-attr xlib::unset -+ xlib::reset xlib::sync xlib::geometry xlib::size xlib::get-geometry -+ xlib::reset-geometry xlib::query-pointer xlib::wait-exposure xlib::wait-unmap -+ xlib::clear xlib::mapw xlib::unmap xlib::destroy -+ xlib::positive-y xlib::drawline xlib::draw-line xlib::draw-line-xy -+ xlib::draw-latex-xy xlib::draw-arrow-xy xlib::draw-arrow2-xy -+ xlib::draw-arrowhead-xy xlib::draw-box xlib::draw-box-xy -+ xlib::draw-box-corners xlib::draw-rcbox-xy xlib::xor-box-xy xlib::draw-circle -+ xlib::draw-circle-xy xlib::draw-ellipse-xy xlib::draw-arc-xy xlib::invertarea -+ xlib::invert-area xlib::invert-area-xy xlib::copy-area-xy xlib::printat -+ xlib::printat-xy xlib::prettyprintat-xy xlib::prettyprintat xlib::string-width -+ xlib::string-extents xlib::erase-area xlib::erase-area-xy xlib::erase-box-xy -+ xlib::moveto-xy xlib::move xlib::paint xlib::centeroffset xlib::draw-border -+ xlib::track-mouse xlib::track-mouse-in-region xlib::init-mouse-poll -+ xlib::poll-mouse xlib::get-point xlib::get-click xlib::get-line-position -+ xlib::get-latex-position xlib::get-icon-position xlib::get-box-position -+ xlib::get-box-size xlib::get-region xlib::adjust-box-side -+ xlib::get-mouse-position xlib::get-circle xlib::get-ellipse -+ xlib::get-crosshairs xlib::draw-crosshairs-xy xlib::get-cross -+ xlib::draw-cross-xy xlib::draw-dot-xy xlib::draw-vector-pt -+ xlib::get-vector-end xlib::reset-color xlib::set-color-rgb xlib::set-color -+ xlib::set-xcolor xlib::free-color xlib::get-chars xlib::input-string -+ xlib::courier-bold-12 xlib::8x10 xlib::9x15 xlib::center xlib::top -+ xlib::bottom xlib::xor xlib::erase xlib::copy xlib::buttonname -+ )) (import x)) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_Xutil.lsp -@@ -0,0 +1,797 @@ -+(in-package :XLIB) -+; Xutil.lsp modified by Hiep Huu Nguyen 27 Aug 92 -+ -+; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. -+ -+; See the files gnu.license and dec.copyright . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Some of the files that interface to the Xlib are adapted from DEC/MIT files. -+; See the file dec.copyright for details. -+ -+;; $XConsortium: Xutil.h,v 11.58 89/12/12 20:15:40 jim Exp $ */ -+ -+;;********************************************************** -+;;Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts, -+;;and the Massachusetts Institute of Technology, Cambridge, Massachusetts. -+ -+;;modified by Hiep H Nguyen 28 Jul 91 -+ -+;; All Rights Reserved -+ -+;;Permission to use, copy, modify, and distribute this software and its -+;;documentation for any purpose and without fee is hereby granted, -+;;provided that the above copyright notice appear in all copies and that -+;;both that copyright notice and this permission notice appear in -+;;supporting documentation, and that the names of Digital or MIT not be -+;;used in advertising or publicity pertaining to distribution of the -+;;software without specific, written prior permission. -+ -+;;DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -+;;ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL -+;;DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -+;;ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -+;;WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, -+;;ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -+;;SOFTWARE. -+ -+;;***************************************************************** -+ -+;; -+;; * Bitmask returned by XParseGeometry(). Each bit tells if the corresponding) -+;; * value (x, y, width, height) was found in the parsed string.) -+ -+(defconstant NoValue 0000) -+(defconstant XValue 0001) -+(defconstant YValue 0002) -+(defconstant WidthValue 0004) -+(defconstant HeightValue 0008) -+(defconstant AllValues 15) -+(defconstant XNegative 16) -+(defconstant YNegative 32) -+ -+;; -+ ;; The next block of definitions are for window manager properties that -+ ;; clients and applications use for communication. -+ -+ -+;; flags argument in size hints -+(defconstant USPosition (expt 2 0) ) ;; user specified x, y -+(defconstant USSize (expt 2 1) ) ;; user specified width, height -+ -+(defconstant PPosition (expt 2 2) ) ;; program specified position -+(defconstant PSize (expt 2 3) ) ;; program specified size -+(defconstant PMinSize (expt 2 4) ) ;; program specified minimum size -+(defconstant PMaxSize (expt 2 5) ) ;; program specified maximum size -+(defconstant PResizeInc (expt 2 6) ) ;; program specified resize increments -+(defconstant PAspect (expt 2 7) ) ;; program specified min and max aspect ratios -+(defconstant PBaseSize (expt 2 8) ) ;; program specified base for incrementing -+(defconstant PWinGravity (expt 2 9) ) ;; program specified window gravity -+ -+;; obsolete -+(defconstant PAllHints (+ PPosition PSize PMinSize PMaxSize PResizeInc PAspect)) -+ -+;; definition for flags of XWMHints -+ -+(defconstant InputHint (expt 2 0)) -+(defconstant StateHint (expt 2 1)) -+(defconstant IconPixmapHint (expt 2 2)) -+(defconstant IconWindowHint (expt 2 3)) -+(defconstant IconPositionHint (expt 2 4)) -+(defconstant IconMaskHint (expt 2 5)) -+(defconstant WindowGroupHint (expt 2 6)) -+(defconstant AllHints ( + InputHint StateHint IconPixmapHint IconWindowHint -+IconPositionHint IconMaskHint WindowGroupHint)) -+ -+;; definitions for initial window state -+(defconstant WithdrawnState 0 ) ;; for windows that are not mapped -+(defconstant NormalState 1 ) ;; most applications want to start this way -+(defconstant IconicState 3 ) ;; application wants to start as an icon -+ -+;; -+ ;; Obsolete states no longer defined by ICCCM -+ -+(defconstant DontCareState 0 ) ;; don't know or care -+(defconstant ZoomState 2 ) ;; application wants to start zoomed -+(defconstant InactiveState 4 ) ;; application believes it is seldom used; -+ ;; some wm's may put it on inactive menu -+ -+ -+ -+;; -+ ;; opaque reference to Region data type -+ -+;;typedef struct _XRegion *Region; -+ -+;; Return values from XRectInRegion() -+ -+(defconstant RectangleOut 0) -+(defconstant RectangleIn 1) -+(defconstant RectanglePart 2) -+ -+ -+(defconstant VisualNoMask 0) -+(defconstant VisualIDMask 1) -+(defconstant VisualScreenMask 2) -+(defconstant VisualDepthMask 4) -+(defconstant VisualClassMask 8) -+(defconstant VisualRedMaskMask 16) -+(defconstant VisualGreenMaskMask 32) -+(defconstant VisualBlueMaskMask 64) -+(defconstant VisualColormapSizeMask 128) -+(defconstant VisualBitsPerRGBMask 256) -+(defconstant VisualAllMask 511) -+ -+(defconstant ReleaseByFreeingColormap 1) ;; for killid field above -+ -+ -+;; -+;; return codes for XReadBitmapFile and XWriteBitmapFile -+ -+(defconstant BitmapSuccess 0) -+(defconstant BitmapOpenFailed 1) -+(defconstant BitmapFileInvalid 2) -+(defconstant BitmapNoMemory 3) -+;; -+ ;; Declare the routines that don't return int. -+ -+ -+;; *************************************************************** -+;; * -+;; * Context Management -+;; * -+;; *************************************************************** -+ -+ -+;; Associative lookup table return codes -+ -+(defconstant XCSUCCESS 0 ) ;; No error. -+(defconstant XCNOMEM 1 ) ;; Out of memory -+(defconstant XCNOENT 2 ) ;; No entry in table -+ -+;;typedef fixnum XContext; -+ -+(defentry XSaveContext( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; context -+ fixnum ;; data -+ -+)( fixnum "XSaveContext")) -+ -+ -+ -+(defentry XFindContext( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; context -+ fixnum ;; data_return -+ -+)( fixnum "XFindContext")) -+ -+ -+ -+(defentry XDeleteContext( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; context -+ -+)( fixnum "XDeleteContext")) -+ -+ -+ -+ -+(defentry XGetWMHints( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( fixnum "XGetWMHints")) -+ -+ -+(defentry XCreateRegion( -+ -+;; void -+ -+)( fixnum "XCreateRegion")) -+ -+ -+(defentry XPolygonRegion( -+ -+ fixnum ;; points -+ fixnum ;; n -+ fixnum ;; fill_rule -+ -+)( fixnum "XPolygonRegion")) -+ -+ -+ -+(defentry XGetVisualInfo( -+ -+ fixnum ;; display -+ fixnum ;; vinfo_mask -+ fixnum ;; vinfo_template -+ fixnum ;; nitems_return -+ -+)( fixnum "XGetVisualInfo")) -+ -+;; Allocation routines for properties that may get longer -+ -+ -+(defentry XAllocSizeHints ( -+ -+;; void -+ -+)( fixnum "XAllocSizeHints" )) -+ -+ -+(defentry XAllocStandardColormap ( -+ -+;; void -+ -+)( fixnum "XAllocStandardColormap" )) -+ -+ -+(defentry XAllocWMHints ( -+ -+;; void -+ -+)( fixnum "XAllocWMHints" )) -+ -+ -+(defentry XAllocClassHint ( -+ -+;; void -+ -+)( fixnum "XAllocClassHint" )) -+ -+ -+(defentry XAllocIconSize ( -+ -+;; void -+ -+)( fixnum "XAllocIconSize" )) -+ -+;; ICCCM routines for data structures defined in this file -+ -+ -+(defentry XGetWMSizeHints( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; hints_return -+ fixnum ;; supplied_return -+ fixnum ;; property -+ -+)( fixnum "XGetWMSizeHints")) -+ -+ -+(defentry XGetWMNormalHints( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; hints_return -+ fixnum ;; supplied_return -+ -+)( fixnum "XGetWMNormalHints")) -+ -+ -+(defentry XGetRGBColormaps( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; stdcmap_return -+ fixnum ;; count_return -+ fixnum ;; property -+ -+)( fixnum "XGetRGBColormaps")) -+ -+ -+(defentry XGetTextProperty( -+ -+ fixnum ;; display -+ fixnum ;; window -+ fixnum ;; text_prop_return -+ fixnum ;; property -+ -+)( fixnum "XGetTextProperty")) -+ -+ -+(defentry XGetWMName( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; text_prop_return -+ -+)( fixnum "XGetWMName")) -+ -+ -+(defentry XGetWMIconName( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; text_prop_return -+ -+)( fixnum "XGetWMIconName")) -+ -+ -+(defentry XGetWMClientMachine( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; text_prop_return -+ -+)( fixnum "XGetWMClientMachine")) -+ -+ -+(defentry XSetWMProperties( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; window_name -+ fixnum ;; icon_name -+ fixnum ;; argv -+ fixnum ;; argc -+ fixnum ;; normal_hints -+ fixnum ;; wm_hints -+ fixnum ;; class_hints -+ -+)( void "XSetWMProperties")) -+ -+ -+(defentry XSetWMSizeHints( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; hints -+ fixnum ;; property -+ -+)( void "XSetWMSizeHints")) -+ -+ -+(defentry XSetWMNormalHints( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; hints -+ -+)( void "XSetWMNormalHints")) -+ -+ -+(defentry XSetRGBColormaps( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; stdcmaps -+ fixnum ;; count -+ fixnum ;; property -+ -+)( void "XSetRGBColormaps")) -+ -+ -+(defentry XSetTextProperty( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; text_prop -+ fixnum ;; property -+ -+)( void "XSetTextProperty")) -+ -+ -+(defentry XSetWMName( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; text_prop -+ -+)( void "XSetWMName")) -+ -+ -+(defentry XSetWMIconName( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; text_prop -+ -+)( void "XSetWMIconName")) -+ -+ -+(defentry XSetWMClientMachine( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; text_prop -+ -+)( void "XSetWMClientMachine")) -+ -+ -+(defentry XStringListToTextProperty( -+ -+ fixnum ;; list -+ fixnum ;; count -+ fixnum ;; text_prop_return -+ -+)( fixnum "XStringListToTextProperty")) -+ -+ -+(defentry XTextPropertyToStringList( -+ -+ fixnum ;; text_prop -+ fixnum ;; list_return -+ fixnum ;; count_return -+ -+)( fixnum "XTextPropertyToStringList")) -+ -+;; The following declarations are alphabetized. -+ -+ -+ -+(defentry XClipBox( -+ -+ fixnum ;; r -+ fixnum ;; rect_return -+ -+)( void "XClipBox")) -+ -+ -+ -+(defentry XDestroyRegion( -+ -+ fixnum ;; r -+ -+)( void "XDestroyRegion")) -+ -+ -+ -+(defentry XEmptyRegion( -+ -+ fixnum ;; r -+ -+)( void "XEmptyRegion")) -+ -+ -+ -+(defentry XEqualRegion( -+ -+ fixnum ;; r1 -+ fixnum ;; r2 -+ -+)( void "XEqualRegion")) -+ -+ -+ -+(defentry XGetClassHint( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; class_hints_return -+ -+)( fixnum "XGetClassHint")) -+ -+ -+ -+(defentry XGetIconSizes( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; size_list_return -+ fixnum ;; count_return -+ -+)( fixnum "XGetIconSizes")) -+ -+ -+ -+(defentry XGetNormalHints( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; hints_return -+ -+)( fixnum "XGetNormalHints")) -+ -+ -+ -+(defentry XGetSizeHints( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; hints_return -+ fixnum ;; property -+ -+)( fixnum "XGetSizeHints")) -+ -+ -+ -+(defentry XGetStandardColormap( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; colormap_return -+ fixnum ;; property -+ -+)( fixnum "XGetStandardColormap")) -+ -+ -+ -+(defentry XGetZoomHints( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; zhints_return -+ -+)( fixnum "XGetZoomHints")) -+ -+ -+ -+(defentry XIntersectRegion( -+ -+ fixnum ;; sra -+ fixnum ;; srb -+ fixnum ;; dr_return -+ -+)( void "XIntersectRegion")) -+ -+ -+ -+(defentry XLookupString( -+ -+ fixnum ;; event_struct -+ object ;; buffer_return -+ fixnum ;; bytes_buffer -+ fixnum ;; keysym_return -+ fixnum ;; int_in_out -+ -+)( fixnum "XLookupString")) -+ -+ -+ -+(defentry XMatchVisualInfo( -+ -+ fixnum ;; display -+ fixnum ;; screen -+ fixnum ;; depth -+ fixnum ;; class -+ fixnum ;; vinfo_return -+ -+)( fixnum "XMatchVisualInfo")) -+ -+ -+ -+(defentry XOffsetRegion( -+ -+ fixnum ;; r -+ fixnum ;; dx -+ fixnum ;; dy -+ -+)( void "XOffsetRegion")) -+ -+ -+ -+(defentry XPointInRegion( -+ -+ fixnum ;; r -+ fixnum ;; x -+ fixnum ;; y -+ -+)( fixnum "XPointInRegion")) -+ -+ -+ -+(defentry XRectInRegion( -+ -+ fixnum ;; r -+ fixnum ;; x -+ fixnum ;; y -+ fixnum ;; width -+ fixnum ;; height -+ -+)( fixnum "XRectInRegion")) -+ -+ -+ -+(defentry XSetClassHint( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; class_hints -+ -+)( void "XSetClassHint")) -+ -+ -+ -+(defentry XSetIconSizes( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; size_list -+ fixnum ;; count -+ -+)( void "XSetIconSizes")) -+ -+ -+ -+(defentry XSetNormalHints( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; hints -+ -+)( void "XSetNormalHints")) -+ -+ -+ -+(defentry XSetSizeHints( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; hints -+ fixnum ;; property -+ -+)( void "XSetSizeHints")) -+ -+ -+ -+(defentry XSetStandardProperties( -+ -+ fixnum ;; display -+ fixnum ;; w -+ object ;; window_name -+ object ;; icon_name -+ fixnum ;; icon_pixmap -+ fixnum ;; argv -+ fixnum ;; argc -+ fixnum ;; hints -+ -+)( void "XSetStandardProperties")) -+ -+ -+ -+(defentry XSetWMHints( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; wm_hints -+ -+)( void "XSetWMHints")) -+ -+ -+ -+(defentry XSetRegion( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; r -+ -+)( void "XSetRegion")) -+ -+ -+ -+(defentry XSetStandardColormap( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; colormap -+ fixnum ;; property -+ -+)( void "XSetStandardColormap")) -+ -+ -+ -+(defentry XSetZoomHints( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; zhints -+ -+)( void "XSetZoomHints")) -+ -+ -+ -+(defentry XShrinkRegion( -+ -+ fixnum ;; r -+ fixnum ;; dx -+ fixnum ;; dy -+ -+)( void "XShrinkRegion")) -+ -+ -+ -+(defentry XSubtractRegion( -+ -+ fixnum ;; sra -+ fixnum ;; srb -+ fixnum ;; dr_return -+ -+)( void "XSubtractRegion")) -+ -+ -+ -+(defentry XUnionRectWithRegion( -+ -+ fixnum ;; rectangle -+ fixnum ;; src_region -+ fixnum ;; dest_region_return -+ -+)( void "XUnionRectWithRegion")) -+ -+ -+ -+(defentry XUnionRegion( -+ -+ fixnum ;; sra -+ fixnum ;; srb -+ fixnum ;; dr_return -+ -+)( void "XUnionRegion")) -+ -+ -+ -+(defentry XWMGeometry( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ object ;; user_geometry -+ object ;; default_geometry -+ fixnum ;; border_width -+ fixnum ;; hints -+ fixnum ;; x_return -+ fixnum ;; y_return -+ fixnum ;; width_return -+ fixnum ;; height_return -+ fixnum ;; gravity_return -+ -+)( fixnum "XWMGeometry")) -+ -+ -+ -+(defentry XXorRegion( -+ -+ fixnum ;; sra -+ fixnum ;; srb -+ fixnum ;; dr_return -+ -+)( void "XXorRegion")) -+;; -+ ;; These macros are used to give some sugar to the image routines so that -+ ;; naive people are more comfortable with them. -+ -+(defentry XDestroyImage(fixnum) (fixnum "XDestroyImage")) -+(defentry XGetPixel(fixnum fixnum fixnum) (fixnum "XGetPixel" )) -+(defentry XPutPixel(fixnum fixnum int fixnum) ( fixnum "XPutPixel")) -+(defentry XSubImage(fixnum fixnum int fixnum fixnum) (fixnum "XSubImage")) -+(defentry XAddPixel(fixnum fixnum) (fixnum "XAddPixel")) -+;; -+ ;; Keysym macros, used on Keysyms to test for classes of symbols -+ -+(defentry IsKeypadKey(fixnum) (fixnum "IsKeypadKey")) -+ -+(defentry IsCursorKey(fixnum) (fixnum "IsCursorKey")) -+ -+(defentry IsPFKey(fixnum) (fixnum "IsPFKey")) -+ -+(defentry IsFunctionKey(fixnum) (fixnum "IsFunctionKey")) -+ -+(defentry IsMiscFunctionKey(fixnum) (fixnum "IsMiscFunctionKey")) -+ -+(defentry IsModifierKey(fixnum) (fixnum "IsModifierKey")) -+(defentry XUniqueContext() (fixnum "XUniqueContext")) -+(defentry XStringToContext(object) (fixnum "XStringToContext")) -+ ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_Xlib.lsp -@@ -0,0 +1,3456 @@ -+(in-package :XLIB) -+; Xlib.lsp Hiep Huu Nguyen 27 Aug 92 -+ -+; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. -+ -+; See the files gnu.license and dec.copyright . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Some of the files that interface to the Xlib are adapted from DEC/MIT files. -+; See the file dec.copyright for details. -+ -+;;typedef unsigned long XID) ; -+ -+;;typedef XID Window) ; -+;;typedef XID Drawable) ; -+;;typedef XID Font) ; -+;;typedef XID Pixmap) ; -+;;typedef XID Cursor) ; -+;;typedef XID Colormap) ; -+;;typedef XID GContext) ; -+;;typedef XID KeySym) ; -+ -+;;typedef unsigned long Mask) ; -+ -+;;typedef unsigned long Atom) ; -+ -+;;typedef unsigned long VisualID) ; -+ -+;;typedef unsigned long Time) ; -+ -+;;typedef unsigned char KeyCode) ; -+ -+(defconstant True 1) -+(defconstant False 0) -+ -+(defconstant QueuedAlready 0) -+(defconstant QueuedAfterReading 1) -+(defconstant QueuedAfterFlush 2) -+ -+(defentry XLoadQueryFont( -+ -+ fixnum ;; display -+ object ;; name -+ -+)( fixnum "XLoadQueryFont")) -+ -+ -+ -+(defentry XQueryFont( -+ -+ fixnum ;; display -+ fixnum ;; font_ID -+ -+)( fixnum "XQueryFont")) -+ -+ -+ -+ -+(defentry XGetMotionEvents( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; start -+ fixnum ;; stop -+ fixnum ;; nevents_return -+ -+)( fixnum "XGetMotionEvents")) -+ -+ -+ -+(defentry XDeleteModifiermapEntry( -+ -+ fixnum ;; modmap -+ -+ fixnum ;; keycode_entry -+ -+ fixnum ;; modifier -+ -+)( fixnum "XDeleteModifiermapEntry")) -+ -+ -+ -+(defentry XGetModifierMapping( -+ -+ fixnum ;; display -+ -+)( fixnum "XGetModifierMapping")) -+ -+ -+ -+(defentry XInsertModifiermapEntry( -+ -+ fixnum ;; modmap -+ -+ fixnum ;; keycode_entry -+ -+ fixnum ;; modifier -+ -+)( fixnum "XInsertModifiermapEntry")) -+ -+ -+ -+(defentry XNewModifiermap( -+ -+ fixnum ;; max_keys_per_mod -+ -+)( fixnum "XNewModifiermap")) -+ -+ -+ -+(defentry XCreateImage( -+ -+ fixnum ;; display -+ fixnum ;; visual -+ fixnum ;; depth -+ fixnum ;; format -+ fixnum ;; offset -+ object ;; data -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; bitmap_pad -+ fixnum ;; bytes_per_line -+ -+)( fixnum "XCreateImage")) -+ -+ -+(defentry XGetImage( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; x -+ fixnum ;; y -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; plane_mask -+ fixnum ;; format -+ -+)( fixnum "XGetImage")) -+ -+ -+(defentry XGetSubImage( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; x -+ fixnum ;; y -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; plane_mask -+ fixnum ;; format -+ fixnum ;; dest_image -+ fixnum ;; dest_x -+ fixnum ;; dest_y -+ -+)( fixnum "XGetSubImage")) -+ -+;;Window X function declarations. -+ -+ -+ -+(defentry XOpenDisplay( -+ -+ object ;; display_name -+ -+)( fixnum "XOpenDisplay")) -+ -+ -+ -+(defentry XrmInitialize( -+ -+;; void -+ -+)( void "XrmInitialize")) -+ -+ -+ -+(defentry XFetchBytes( -+ -+ fixnum ;; display -+ fixnum ;; nbytes_return -+ -+)( fixnum "XFetchBytes")) -+ -+ -+(defentry XFetchBuffer( -+ -+ fixnum ;; display -+ fixnum ;; nbytes_return -+ fixnum ;; buffer -+ -+)( fixnum "XFetchBuffer")) -+ -+ -+(defentry XGetAtomName( -+ -+ fixnum ;; display -+ fixnum ;; atom -+ -+)( fixnum "XGetAtomName")) -+ -+ -+(defentry XGetDefault( -+ -+ fixnum ;; display -+ object ;; program -+ object ;; option -+ -+)( fixnum "XGetDefault")) -+ -+ -+(defentry XDisplayName( -+ -+ object ;; string -+ -+)( fixnum "XDisplayName")) -+ -+ -+(defentry XKeysymToString( -+ -+ fixnum ;; keysym -+ -+)( fixnum "XKeysymToString")) -+ -+ -+ -+ -+(defentry XInternAtom( -+ -+ fixnum ;; display -+ object ;; atom_name -+ fixnum ;; only_if_exists -+ -+)( fixnum "XInternAtom")) -+ -+ -+(defentry XCopyColormapAndFree( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ -+)( fixnum "XCopyColormapAndFree")) -+ -+ -+(defentry XCreateColormap( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; visual -+ fixnum ;; alloc -+ -+)( fixnum "XCreateColormap")) -+ -+ -+(defentry XCreatePixmapCursor( -+ -+ fixnum ;; display -+ fixnum ;; source -+ fixnum ;; mask -+ fixnum ;; foreground_color -+ fixnum ;; background_color -+ fixnum ;; x -+ fixnum ;; y -+ -+)( fixnum "XCreatePixmapCursor")) -+ -+ -+(defentry XCreateGlyphCursor( -+ -+ fixnum ;; display -+ fixnum ;; source_font -+ fixnum ;; mask_font -+ fixnum ;; source_char -+ fixnum ;; mask_char -+ fixnum ;; foreground_color -+ fixnum ;; background_color -+ -+)( fixnum "XCreateGlyphCursor")) -+ -+ -+(defentry XCreateFontCursor( -+ -+ fixnum ;; display -+ fixnum ;; shape -+ -+)( fixnum "XCreateFontCursor")) -+ -+ -+(defentry XLoadFont( -+ -+ fixnum ;; display -+ object ;; name -+ -+)( fixnum "XLoadFont")) -+ -+ -+(defentry XCreateGC( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; valuemask -+ fixnum ;; values -+ -+)( fixnum "XCreateGC")) -+ -+ -+(defentry XGContextFromGC( -+ -+ fixnum ;; gc -+ -+)( fixnum "XGContextFromGC")) -+ -+ -+(defentry XCreatePixmap( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; depth -+ -+)( fixnum "XCreatePixmap")) -+ -+ -+(defentry XCreateBitmapFromData( -+ -+ fixnum ;; display -+ fixnum ;; d -+ object ;; data -+ fixnum ;; width -+ fixnum ;; height -+ -+)( fixnum "XCreateBitmapFromData")) -+ -+ -+(defentry XCreatePixmapFromBitmapData( -+ -+ fixnum ;; display -+ fixnum ;; d -+ object ;; data -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; fg -+ fixnum ;; bg -+ fixnum ;; depth -+ -+)( fixnum "XCreatePixmapFromBitmapData")) -+ -+ -+(defentry XCreateSimpleWindow( -+ -+ fixnum ;; display -+ fixnum ;; parent -+ fixnum ;; x -+ fixnum ;; y -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; border_width -+ fixnum ;; border -+ fixnum ;; background -+ -+)( fixnum "XCreateSimpleWindow")) -+ -+ -+(defentry XGetSelectionOwner( -+ -+ fixnum ;; display -+ fixnum ;; selection -+ -+)( fixnum "XGetSelectionOwner")) -+ -+ -+(defentry XCreateWindow( -+ -+ fixnum ;; display -+ fixnum ;; parent -+ fixnum ;; x -+ fixnum ;; y -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; border_width -+ fixnum ;; depth -+ fixnum ;; class -+ fixnum ;; visual -+ fixnum ;; valuemask -+ fixnum ;; attributes -+ -+)( fixnum "XCreateWindow")) -+ -+ -+(defentry XListInstalledColormaps( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; num_return -+ -+)( fixnum "XListInstalledColormaps")) -+ -+ -+(defentry XListFonts( -+ -+ fixnum ;; display -+ object ;; pattern -+ fixnum ;; maxnames -+ fixnum ;; actual_count_return -+ -+)( fixnum "XListFonts")) -+ -+ -+(defentry XListFontsWithInfo( -+ -+ fixnum ;; display -+ object ;; pattern -+ fixnum ;; maxnames -+ fixnum ;; count_return -+ fixnum ;; info_return -+ -+)( fixnum "XListFontsWithInfo")) -+ -+ -+(defentry XGetFontPath( -+ -+ fixnum ;; display -+ fixnum ;; npaths_return -+ -+)( fixnum "XGetFontPath")) -+ -+ -+(defentry XListExtensions( -+ -+ fixnum ;; display -+ fixnum ;; nextensions_return -+ -+)( fixnum "XListExtensions")) -+ -+ -+(defentry XListProperties( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; num_prop_return -+ -+)( fixnum "XListProperties")) -+ -+ -+(defentry XListHosts( -+ -+ fixnum ;; display -+ fixnum ;; nhosts_return -+ fixnum ;; state_return -+ -+)( fixnum "XListHosts")) -+ -+ -+(defentry XKeycodeToKeysym( -+ -+ fixnum ;; display -+ -+ fixnum ;; fixnum -+ -+ fixnum ;; index -+ -+)( fixnum "XKeycodeToKeysym")) -+ -+ -+(defentry XLookupKeysym( -+ -+ fixnum ;; key_event -+ fixnum ;; index -+ -+)( fixnum "XLookupKeysym")) -+ -+ -+(defentry XGetKeyboardMapping( -+ -+ fixnum ;; display -+ -+ fixnum ;; first_keycode -+ -+ fixnum ;; keycode_count -+ fixnum ;; keysyms_per_keycode_return -+ -+)( fixnum "XGetKeyboardMapping")) -+ -+ -+(defentry XStringToKeysym( -+ -+ object ;; string -+ -+)( fixnum "XStringToKeysym")) -+ -+ -+(defentry XMaxRequestSize( -+ -+ fixnum ;; display -+ -+)( fixnum "XMaxRequestSize")) -+ -+ -+(defentry XResourceManagerString( -+ -+ fixnum ;; display -+ -+)( fixnum "XResourceManagerString")) -+ -+ -+(defentry XDisplayMotionBufferSize( -+ -+ fixnum ;; display -+ -+)( fixnum "XDisplayMotionBufferSize")) -+ -+ -+(defentry XVisualIDFromVisual( -+ -+ fixnum ;; visual -+ -+)( fixnum "XVisualIDFromVisual")) -+ -+;; routines for dealing with extensions -+ -+ -+ -+(defentry XInitExtension( -+ -+ fixnum ;; display -+ object ;; name -+ -+)( fixnum "XInitExtension")) -+ -+ -+ -+(defentry XAddExtension( -+ -+ fixnum ;; display -+ -+)( fixnum "XAddExtension")) -+ -+ -+(defentry XFindOnExtensionList( -+ -+ fixnum ;; structure -+ fixnum ;; number -+ -+)( fixnum "XFindOnExtensionList")) -+ -+ -+ -+;;;fix -+ -+ -+;(defentry XEHeadOfExtensionList( -+ -+; fixnum ;;object -+ -+;)( fixnum "XEHeadOfExtensionList")) -+ -+;; these are routines for which there are also macros -+ -+ -+(defentry XRootWindow( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ -+)( fixnum "XRootWindow")) -+ -+ -+(defentry XDefaultRootWindow( -+ -+ fixnum ;; display -+ -+)( fixnum "XDefaultRootWindow")) -+ -+ -+(defentry XRootWindowOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XRootWindowOfScreen")) -+ -+ -+(defentry XDefaultVisual( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ -+)( fixnum "XDefaultVisual")) -+ -+ -+(defentry XDefaultVisualOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XDefaultVisualOfScreen")) -+ -+ -+(defentry XDefaultGC( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ -+)( fixnum "XDefaultGC")) -+ -+ -+(defentry XDefaultGCOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XDefaultGCOfScreen")) -+ -+ -+(defentry XBlackPixel( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ -+)( fixnum "XBlackPixel")) -+ -+ -+(defentry XWhitePixel( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ -+)( fixnum "XWhitePixel")) -+ -+ -+(defentry XAllPlanes( -+ -+;; void -+ -+)( fixnum "XAllPlanes")) -+ -+ -+(defentry XBlackPixelOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XBlackPixelOfScreen")) -+ -+ -+(defentry XWhitePixelOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XWhitePixelOfScreen")) -+ -+ -+(defentry XNextRequest( -+ -+ fixnum ;; display -+ -+)( fixnum "XNextRequest")) -+ -+ -+(defentry XLastKnownRequestProcessed( -+ -+ fixnum ;; display -+ -+)( fixnum "XLastKnownRequestProcessed")) -+ -+ -+(defentry XServerVendor( -+ -+ fixnum ;; display -+ -+)( fixnum "XServerVendor")) -+ -+ -+(defentry XDisplayString( -+ -+ fixnum ;; display -+ -+)( fixnum "XDisplayString")) -+ -+ -+(defentry XDefaultColormap( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ -+)( fixnum "XDefaultColormap")) -+ -+ -+(defentry XDefaultColormapOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XDefaultColormapOfScreen")) -+ -+ -+(defentry XDisplayOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XDisplayOfScreen")) -+ -+ -+(defentry XScreenOfDisplay( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ -+)( fixnum "XScreenOfDisplay")) -+ -+ -+(defentry XDefaultScreenOfDisplay( -+ -+ fixnum ;; display -+ -+)( fixnum "XDefaultScreenOfDisplay")) -+ -+ -+(defentry XEventMaskOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XEventMaskOfScreen")) -+ -+ -+ -+(defentry XScreenNumberOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XScreenNumberOfScreen")) -+ -+ -+ -+(defentry XSetErrorHandler ( -+ -+ fixnum ;; handler -+ -+)( fixnum "XSetErrorHandler" )) -+ -+ -+;;fix -+ -+ -+(defentry XSetIOErrorHandler ( -+ -+ fixnum ;; handler -+ -+)( fixnum "XSetIOErrorHandler" )) -+ -+ -+ -+ -+(defentry XListPixmapFormats( -+ -+ fixnum ;; display -+ fixnum ;; count_return -+ -+)( fixnum "XListPixmapFormats")) -+ -+ -+(defentry XListDepths( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ fixnum ;; count_return -+ -+)( fixnum "XListDepths")) -+ -+;; ICCCM routines for things that don't require special include files; -+;; other declarations are given in Xutil.h -+ -+ -+(defentry XReconfigureWMWindow( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; screen_number -+ fixnum ;; mask -+ fixnum ;; changes -+ -+)( fixnum "XReconfigureWMWindow")) -+ -+ -+ -+(defentry XGetWMProtocols( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; protocols_return -+ fixnum ;; count_return -+ -+)( fixnum "XGetWMProtocols")) -+ -+ -+(defentry XSetWMProtocols( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; protocols -+ fixnum ;; count -+ -+)( fixnum "XSetWMProtocols")) -+ -+ -+(defentry XIconifyWindow( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; screen_number -+ -+)( fixnum "XIconifyWindow")) -+ -+ -+(defentry XWithdrawWindow( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; screen_number -+ -+)( fixnum "XWithdrawWindow")) -+ -+;;;fix -+ -+ -+(defentry XGetCommand( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; argv_return -+ fixnum ;; argc_return -+ -+)( fixnum "XGetCommand")) -+ -+ -+(defentry XGetWMColormapWindows( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; windows_return -+ fixnum ;; count_return -+ -+)( fixnum "XGetWMColormapWindows")) -+ -+ -+(defentry XSetWMColormapWindows( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; colormap_windows -+ fixnum ;; count -+ -+)( fixnum "XSetWMColormapWindows")) -+ -+ -+(defentry XFreeStringList( -+ -+ fixnum ;; list -+ -+)( void "XFreeStringList")) -+ -+ -+(defentry XSetTransientForHint( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; prop_window -+ -+)( void "XSetTransientForHint")) -+ -+;; The following are given in alphabetical order -+ -+ -+ -+(defentry XActivateScreenSaver( -+ -+ fixnum ;; display -+ -+)( void "XActivateScreenSaver")) -+ -+ -+ -+(defentry XAddHost( -+ -+ fixnum ;; display -+ fixnum ;; host -+ -+)( void "XAddHost")) -+ -+ -+ -+(defentry XAddHosts( -+ -+ fixnum ;; display -+ fixnum ;; hosts -+ fixnum ;; num_hosts -+ -+)( void "XAddHosts")) -+ -+ -+ -+(defentry XAddToExtensionList( -+ -+ fixnum ;; structure -+ fixnum ;; ext_data -+ -+)( void "XAddToExtensionList")) -+ -+ -+ -+(defentry XAddToSaveSet( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( void "XAddToSaveSet")) -+ -+ -+ -+(defentry XAllocColor( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ fixnum ;; screen_in_out -+ -+)( fixnum "XAllocColor")) -+ -+;;;fix -+ -+ -+(defentry XAllocColorCells( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ fixnum ;; contig -+ fixnum ;; plane_masks_return -+ fixnum ;; nplanes -+ fixnum ;; pixels_return -+ fixnum ;; npixels -+ -+)( fixnum "XAllocColorCells")) -+ -+ -+ -+(defentry XAllocColorPlanes( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ fixnum ;; contig -+ fixnum ;; pixels_return -+ fixnum ;; ncolors -+ fixnum ;; nreds -+ fixnum ;; ngreens -+ fixnum ;; nblues -+ fixnum ;; rmask_return -+ fixnum ;; gmask_return -+ fixnum ;; bmask_return -+ -+)( fixnum "XAllocColorPlanes")) -+ -+ -+ -+(defentry XAllocNamedColor( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ object ;; color_name -+ fixnum ;; screen_def_return -+ fixnum ;; exact_def_return -+ -+)( fixnum "XAllocNamedColor")) -+ -+ -+ -+(defentry XAllowEvents( -+ -+ fixnum ;; display -+ fixnum ;; event_mode -+ fixnum ;; time -+ -+)( void "XAllowEvents")) -+ -+ -+ -+(defentry XAutoRepeatOff( -+ -+ fixnum ;; display -+ -+)( void "XAutoRepeatOff")) -+ -+ -+ -+(defentry XAutoRepeatOn( -+ -+ fixnum ;; display -+ -+)( void "XAutoRepeatOn")) -+ -+ -+ -+(defentry XBell( -+ -+ fixnum ;; display -+ fixnum ;; percent -+ -+)( void "XBell")) -+ -+ -+ -+(defentry XBitmapBitOrder( -+ -+ fixnum ;; display -+ -+)( fixnum "XBitmapBitOrder")) -+ -+ -+ -+(defentry XBitmapPad( -+ -+ fixnum ;; display -+ -+)( fixnum "XBitmapPad")) -+ -+ -+ -+(defentry XBitmapUnit( -+ -+ fixnum ;; display -+ -+)( fixnum "XBitmapUnit")) -+ -+ -+ -+(defentry XCellsOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XCellsOfScreen")) -+ -+ -+ -+(defentry XChangeActivePointerGrab( -+ -+ fixnum ;; display -+ fixnum ;; event_mask -+ fixnum ;; cursor -+ fixnum ;; time -+ -+)( void "XChangeActivePointerGrab")) -+ -+ -+ -+(defentry XChangeGC( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; valuemask -+ fixnum ;; values -+ -+)( void "XChangeGC")) -+ -+ -+ -+(defentry XChangeKeyboardControl( -+ -+ fixnum ;; display -+ fixnum ;; value_mask -+ fixnum ;; values -+ -+)( void "XChangeKeyboardControl")) -+ -+ -+ -+(defentry XChangeKeyboardMapping( -+ -+ fixnum ;; display -+ fixnum ;; first_keycode -+ fixnum ;; keysyms_per_keycode -+ fixnum ;; keysyms -+ fixnum ;; num_codes -+ -+)( void "XChangeKeyboardMapping")) -+ -+ -+ -+(defentry XChangePointerControl( -+ -+ fixnum ;; display -+ fixnum ;; do_accel -+ fixnum ;; do_threshold -+ fixnum ;; accel_numerator -+ fixnum ;; accel_denominator -+ fixnum ;; threshold -+ -+)( void "XChangePointerControl")) -+ -+ -+ -+(defentry XChangeProperty( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; property -+ fixnum ;; type -+ fixnum ;; format -+ fixnum ;; mode -+ fixnum ;; data -+ fixnum ;; nelements -+ -+)( void "XChangeProperty")) -+ -+ -+ -+(defentry XChangeSaveSet( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; change_mode -+ -+)( void "XChangeSaveSet")) -+ -+ -+ -+(defentry XChangeWindowAttributes( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; valuemask -+ fixnum ;; attributes -+ -+)( void "XChangeWindowAttributes")) -+ -+ -+ -+(defentry XCheckMaskEvent( -+ -+ fixnum ;; display -+ fixnum ;; event_mask -+ fixnum ;; event_return -+ -+)( fixnum "XCheckMaskEvent")) -+ -+ -+ -+(defentry XCheckTypedEvent( -+ -+ fixnum ;; display -+ fixnum ;; event_type -+ fixnum ;; event_return -+ -+)( fixnum "XCheckTypedEvent")) -+ -+ -+ -+(defentry XCheckTypedWindowEvent( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; event_type -+ fixnum ;; event_return -+ -+)( fixnum "XCheckTypedWindowEvent")) -+ -+ -+ -+(defentry XCheckWindowEvent( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; event_mask -+ fixnum ;; event_return -+ -+)( fixnum "XCheckWindowEvent")) -+ -+ -+ -+(defentry XCirculateSubwindows( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; direction -+ -+)( void "XCirculateSubwindows")) -+ -+ -+ -+(defentry XCirculateSubwindowsDown( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( void "XCirculateSubwindowsDown")) -+ -+ -+ -+(defentry XCirculateSubwindowsUp( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( void "XCirculateSubwindowsUp")) -+ -+ -+ -+(defentry XClearArea( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; x -+ fixnum ;; y -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; exposures -+ -+)( void "XClearArea")) -+ -+ -+ -+(defentry XClearWindow( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( void "XClearWindow")) -+ -+ -+ -+(defentry XCloseDisplay( -+ -+ fixnum ;; display -+ -+)( void "XCloseDisplay")) -+ -+ -+ -+(defentry XConfigureWindow( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; value_mask -+ fixnum ;; values -+ -+)( void "XConfigureWindow")) -+ -+ -+ -+(defentry XConnectionNumber( -+ -+ fixnum ;; display -+ -+)( fixnum "XConnectionNumber")) -+ -+ -+ -+(defentry XConvertSelection( -+ -+ fixnum ;; display -+ fixnum ;; selection -+ fixnum ;; target -+ fixnum ;; property -+ fixnum ;; requestor -+ fixnum ;; time -+ -+)( void "XConvertSelection")) -+ -+ -+ -+(defentry XCopyArea( -+ -+ fixnum ;; display -+ fixnum ;; src -+ fixnum ;; dest -+ fixnum ;; gc -+ fixnum ;; src_x -+ fixnum ;; src_y -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; dest_x -+ fixnum ;; dest_y -+ -+)( void "XCopyArea")) -+ -+ -+ -+(defentry XCopyGC( -+ -+ fixnum ;; display -+ fixnum ;; src -+ fixnum ;; valuemask -+ fixnum ;; dest -+ -+)( void "XCopyGC")) -+ -+ -+ -+(defentry XCopyPlane( -+ -+ fixnum ;; display -+ fixnum ;; src -+ fixnum ;; dest -+ fixnum ;; gc -+ fixnum ;; src_x -+ fixnum ;; src_y -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; dest_x -+ fixnum ;; dest_y -+ fixnum ;; plane -+ -+)( void "XCopyPlane")) -+ -+ -+ -+(defentry XDefaultDepth( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ -+)( fixnum "XDefaultDepth")) -+ -+ -+ -+(defentry XDefaultDepthOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XDefaultDepthOfScreen")) -+ -+ -+ -+(defentry XDefaultScreen( -+ -+ fixnum ;; display -+ -+)( fixnum "XDefaultScreen")) -+ -+ -+ -+(defentry XDefineCursor( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; cursor -+ -+)( void "XDefineCursor")) -+ -+ -+ -+(defentry XDeleteProperty( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; property -+ -+)( void "XDeleteProperty")) -+ -+ -+ -+(defentry XDestroyWindow( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( void "XDestroyWindow")) -+ -+ -+ -+(defentry XDestroySubwindows( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( void "XDestroySubwindows")) -+ -+ -+ -+(defentry XDoesBackingStore( -+ -+ fixnum ;; screen -+ -+)( fixnum "XDoesBackingStore")) -+ -+ -+ -+(defentry XDoesSaveUnders( -+ -+ fixnum ;; screen -+ -+)( fixnum "XDoesSaveUnders")) -+ -+ -+ -+(defentry XDisableAccessControl( -+ -+ fixnum ;; display -+ -+)( void "XDisableAccessControl")) -+ -+ -+ -+ -+(defentry XDisplayCells( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ -+)( fixnum "XDisplayCells")) -+ -+ -+ -+(defentry XDisplayHeight( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ -+)( fixnum "XDisplayHeight")) -+ -+ -+ -+(defentry XDisplayHeightMM( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ -+)( fixnum "XDisplayHeightMM")) -+ -+ -+ -+(defentry XDisplayKeycodes( -+ -+ fixnum ;; display -+ fixnum ;; min_keycodes_return -+ fixnum ;; max_keycodes_return -+ -+)( void "XDisplayKeycodes")) -+ -+ -+ -+(defentry XDisplayPlanes( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ -+)( fixnum "XDisplayPlanes")) -+ -+ -+ -+(defentry XDisplayWidth( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ -+)( fixnum "XDisplayWidth")) -+ -+ -+ -+(defentry XDisplayWidthMM( -+ -+ fixnum ;; display -+ fixnum ;; screen_number -+ -+)( fixnum "XDisplayWidthMM")) -+ -+ -+ -+(defentry XDrawArc( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; x -+ fixnum ;; y -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; angle1 -+ fixnum ;; angle2 -+ -+)( void "XDrawArc")) -+ -+ -+ -+(defentry XDrawArcs( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; arcs -+ fixnum ;; narcs -+ -+)( void "XDrawArcs")) -+ -+ -+ -+(defentry XDrawImageString( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; x -+ fixnum ;; y -+ object ;; string -+ fixnum ;; length -+ -+)( void "XDrawImageString")) -+ -+ -+ -+(defentry XDrawImageString16( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; x -+ fixnum ;; y -+ fixnum ;; string -+ fixnum ;; length -+ -+)( void "XDrawImageString16")) -+ -+ -+ -+(defentry XDrawLine( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; x1 -+ fixnum ;; x2 -+ fixnum ;; y1 -+ fixnum ;; y2 -+ -+)( void "XDrawLine")) -+ -+ -+ -+(defentry XDrawLines( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; points -+ fixnum ;; npoints -+ fixnum ;; mode -+ -+)( void "XDrawLines")) -+ -+ -+ -+(defentry XDrawPoint( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; x -+ fixnum ;; y -+ -+)( void "XDrawPoint")) -+ -+ -+ -+(defentry XDrawPoints( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; points -+ fixnum ;; npoints -+ fixnum ;; mode -+ -+)( void "XDrawPoints")) -+ -+ -+ -+(defentry XDrawRectangle( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; x -+ fixnum ;; y -+ fixnum ;; width -+ fixnum ;; height -+ -+)( void "XDrawRectangle")) -+ -+ -+ -+(defentry XDrawRectangles( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; rectangles -+ fixnum ;; nrectangles -+ -+)( void "XDrawRectangles")) -+ -+ -+ -+(defentry XDrawSegments( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; segments -+ fixnum ;; nsegments -+ -+)( void "XDrawSegments")) -+ -+ -+ -+(defentry XDrawString( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; x -+ fixnum ;; y -+ object ;; string -+ fixnum ;; length -+ -+)( void "XDrawString")) -+ -+ -+ -+(defentry XDrawString16( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; x -+ fixnum ;; y -+ fixnum ;; string -+ fixnum ;; length -+ -+)( void "XDrawString16")) -+ -+ -+ -+(defentry XDrawText( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; x -+ fixnum ;; y -+ fixnum ;; items -+ fixnum ;; nitems -+ -+)( void "XDrawText")) -+ -+ -+ -+(defentry XDrawText16( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; x -+ fixnum ;; y -+ fixnum ;; items -+ fixnum ;; nitems -+ -+)( void "XDrawText16")) -+ -+ -+ -+(defentry XEnableAccessControl( -+ -+ fixnum ;; display -+ -+)( void "XEnableAccessControl")) -+ -+ -+ -+(defentry XEventsQueued( -+ -+ fixnum ;; display -+ fixnum ;; mode -+ -+)( fixnum "XEventsQueued")) -+ -+ -+ -+(defentry XFetchName( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; window_name_return -+ -+)( fixnum "XFetchName")) -+ -+ -+ -+(defentry XFillArc( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; x -+ fixnum ;; y -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; angle1 -+ fixnum ;; angle2 -+ -+)( void "XFillArc")) -+ -+ -+ -+(defentry XFillArcs( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; arcs -+ fixnum ;; narcs -+ -+)( void "XFillArcs")) -+ -+ -+ -+(defentry XFillPolygon( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; points -+ fixnum ;; npoints -+ fixnum ;; shape -+ fixnum ;; mode -+ -+)( void "XFillPolygon")) -+ -+ -+ -+(defentry XFillRectangle( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; x -+ fixnum ;; y -+ fixnum ;; width -+ fixnum ;; height -+ -+)( void "XFillRectangle")) -+ -+ -+ -+(defentry XFillRectangles( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; rectangles -+ fixnum ;; nrectangles -+ -+)( void "XFillRectangles")) -+ -+ -+ -+(defentry XFlush( -+ -+ fixnum ;; display -+ -+)( void "XFlush")) -+ -+ -+ -+(defentry XForceScreenSaver( -+ -+ fixnum ;; display -+ fixnum ;; mode -+ -+)( void "XForceScreenSaver")) -+ -+ -+ -+(defentry XFree( -+ -+ object ;; data -+ -+)( void "XFree")) -+ -+ -+ -+(defentry XFreeColormap( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ -+)( void "XFreeColormap")) -+ -+ -+ -+(defentry XFreeColors( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ fixnum ;; pixels -+ fixnum ;; npixels -+ fixnum ;; planes -+ -+)( void "XFreeColors")) -+ -+ -+ -+(defentry XFreeCursor( -+ -+ fixnum ;; display -+ fixnum ;; cursor -+ -+)( void "XFreeCursor")) -+ -+ -+ -+(defentry XFreeExtensionList( -+ -+ fixnum ;; list -+ -+)( void "XFreeExtensionList")) -+ -+ -+ -+(defentry XFreeFont( -+ -+ fixnum ;; display -+ fixnum ;; font_struct -+ -+)( void "XFreeFont")) -+ -+ -+ -+(defentry XFreeFontInfo( -+ -+ fixnum ;; names -+ fixnum ;; free_info -+ fixnum ;; actual_count -+ -+)( void "XFreeFontInfo")) -+ -+ -+ -+(defentry XFreeFontNames( -+ -+ fixnum ;; list -+ -+)( void "XFreeFontNames")) -+ -+ -+ -+(defentry XFreeFontPath( -+ -+ fixnum ;; list -+ -+)( void "XFreeFontPath")) -+ -+ -+ -+(defentry XFreeGC( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ -+)( void "XFreeGC")) -+ -+ -+ -+(defentry XFreeModifiermap( -+ -+ fixnum ;; modmap -+ -+)( void "XFreeModifiermap")) -+ -+ -+ -+(defentry XFreePixmap( -+ -+ fixnum ;; display -+ fixnum ;; fixnum -+ -+)( void "XFreePixmap")) -+ -+ -+ -+(defentry XGeometry( -+ -+ fixnum ;; display -+ fixnum ;; screen -+ object ;; position -+ object ;; default_position -+ fixnum ;; bwidth -+ fixnum ;; fwidth -+ fixnum ;; fheight -+ fixnum ;; xadder -+ fixnum ;; yadder -+ fixnum ;; x_return -+ fixnum ;; y_return -+ fixnum ;; width_return -+ fixnum ;; height_return -+ -+)( fixnum "XGeometry")) -+ -+ -+ -+(defentry XGetErrorDatabaseText( -+ -+ fixnum ;; display -+ object ;; name -+ object ;; message -+ object ;; default_string -+ object ;; buffer_return -+ fixnum ;; length -+ -+)( void "XGetErrorDatabaseText")) -+ -+ -+ -+(defentry XGetErrorText( -+ -+ fixnum ;; display -+ fixnum ;; code -+ object ;; buffer_return -+ fixnum ;; length -+ -+)( void "XGetErrorText")) -+ -+ -+ -+(defentry XGetFontProperty( -+ -+ fixnum ;; font_struct -+ fixnum ;; atom -+ fixnum ;; value_return -+ -+)( fixnum "XGetFontProperty")) -+ -+ -+ -+(defentry XGetGCValues( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; valuemask -+ fixnum ;; values_return -+ -+)( fixnum "XGetGCValues")) -+ -+ -+ -+(defentry XGetGeometry( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; root_return -+ fixnum ;; x_return -+ fixnum ;; y_return -+ fixnum ;; width_return -+ fixnum ;; height_return -+ fixnum ;; border_width_return -+ fixnum ;; depth_return -+ -+)( fixnum "XGetGeometry")) -+ -+ -+ -+(defentry XGetIconName( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; icon_name_return -+ -+)( fixnum "XGetIconName")) -+ -+ -+ -+(defentry XGetInputFocus( -+ -+ fixnum ;; display -+ fixnum ;; focus_return -+ fixnum ;; revert_to_return -+ -+)( void "XGetInputFocus")) -+ -+ -+ -+(defentry XGetKeyboardControl( -+ -+ fixnum ;; display -+ fixnum ;; values_return -+ -+)( void "XGetKeyboardControl")) -+ -+ -+ -+(defentry XGetPointerControl( -+ -+ fixnum ;; display -+ fixnum ;; accel_numerator_return -+ fixnum ;; accel_denominator_return -+ fixnum ;; threshold_return -+ -+)( void "XGetPointerControl")) -+ -+ -+ -+(defentry XGetPointerMapping( -+ -+ fixnum ;; display -+ object ;; map_return -+ fixnum ;; nmap -+ -+)( fixnum "XGetPointerMapping")) -+ -+ -+ -+(defentry XGetScreenSaver( -+ -+ fixnum ;; display -+ fixnum ;; intout_return -+ fixnum ;; interval_return -+ fixnum ;; prefer_blanking_return -+ fixnum ;; allow_exposures_return -+ -+)( void "XGetScreenSaver")) -+ -+ -+ -+(defentry XGetTransientForHint( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; prop_window_return -+ -+)( fixnum "XGetTransientForHint")) -+ -+ -+ -+(defentry XGetWindowProperty( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; property -+ fixnum ;; int_offset -+ fixnum ;; int_length -+ fixnum ;; delete -+ fixnum ;; req_type -+ fixnum ;; actual_type_return -+ fixnum ;; actual_format_return -+ fixnum ;; nitems_return -+ fixnum ;; bytes_after_return -+ fixnum ;; prop_return -+ -+)( fixnum "XGetWindowProperty")) -+ -+ -+ -+(defentry XGetWindowAttributes( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; Window_attributes_return -+ -+)( fixnum "XGetWindowAttributes")) -+ -+ -+ -+(defentry XGrabButton( -+ -+ fixnum ;; display -+ fixnum ;; button -+ fixnum ;; modifiers -+ fixnum ;; grab_window -+ fixnum ;; owner_events -+ fixnum ;; event_mask -+ fixnum ;; pointer_mode -+ fixnum ;; keyboard_mode -+ fixnum ;; confine_to -+ fixnum ;; cursor -+ -+)( void "XGrabButton")) -+ -+ -+ -+(defentry XGrabKey( -+ -+ fixnum ;; display -+ fixnum ;; keycode -+ fixnum ;; modifiers -+ fixnum ;; grab_window -+ fixnum ;; owner_events -+ fixnum ;; pointer_mode -+ fixnum ;; keyboard_mode -+ -+)( void "XGrabKey")) -+ -+ -+ -+(defentry XGrabKeyboard( -+ -+ fixnum ;; display -+ fixnum ;; grab_window -+ fixnum ;; owner_events -+ fixnum ;; pointer_mode -+ fixnum ;; keyboard_mode -+ fixnum ;; fixnum -+ -+)( fixnum "XGrabKeyboard")) -+ -+ -+ -+(defentry XGrabPointer( -+ -+ fixnum ;; display -+ fixnum ;; grab_window -+ fixnum ;; owner_events -+ fixnum ;; event_mask -+ fixnum ;; pointer_mode -+ fixnum ;; keyboard_mode -+ fixnum ;; confine_to -+ fixnum ;; cursor -+ fixnum ;; fixnum -+ -+)( fixnum "XGrabPointer")) -+ -+ -+ -+(defentry XGrabServer( -+ -+ fixnum ;; display -+ -+)( void "XGrabServer")) -+ -+ -+ -+(defentry XHeightMMOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XHeightMMOfScreen")) -+ -+ -+ -+(defentry XHeightOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XHeightOfScreen")) -+ -+ -+ -+(defentry XImageByteOrder( -+ -+ fixnum ;; display -+ -+)( fixnum "XImageByteOrder")) -+ -+ -+ -+(defentry XInstallColormap( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ -+)( void "XInstallColormap")) -+ -+ -+ -+(defentry XKeysymToKeycode( -+ -+ fixnum ;; display -+ fixnum ;; keysym -+ -+)( fixnum "XKeysymToKeycode")) -+ -+ -+ -+(defentry XKillClient( -+ -+ fixnum ;; display -+ fixnum ;; resource -+ -+)( void "XKillClient")) -+ -+ -+ -+(defentry XLookupColor( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ object ;; color_name -+ fixnum ;; exact_def_return -+ fixnum ;; screen_def_return -+ -+)( fixnum "XLookupColor")) -+ -+ -+ -+(defentry XLowerWindow( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( void "XLowerWindow")) -+ -+ -+ -+(defentry XMapRaised( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( void "XMapRaised")) -+ -+ -+ -+(defentry XMapSubwindows( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( void "XMapSubwindows")) -+ -+ -+ -+(defentry XMapWindow( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( void "XMapWindow")) -+ -+ -+ -+(defentry XMaskEvent( -+ -+ fixnum ;; display -+ fixnum ;; event_mask -+ fixnum ;; event_return -+ -+)( void "XMaskEvent")) -+ -+ -+ -+(defentry XMaxCmapsOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XMaxCmapsOfScreen")) -+ -+ -+ -+(defentry XMinCmapsOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XMinCmapsOfScreen")) -+ -+ -+ -+(defentry XMoveResizeWindow( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; x -+ fixnum ;; y -+ fixnum ;; width -+ fixnum ;; height -+ -+)( void "XMoveResizeWindow")) -+ -+ -+ -+(defentry XMoveWindow( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; x -+ fixnum ;; y -+ -+)( void "XMoveWindow")) -+ -+ -+ -+(defentry XNextEvent( -+ -+ fixnum ;; display -+ fixnum ;; event_return -+ -+)( void "XNextEvent")) -+ -+ -+ -+(defentry XNoOp( -+ -+ fixnum ;; display -+ -+)( void "XNoOp")) -+ -+ -+ -+(defentry XParseColor( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ object ;; spec -+ fixnum ;; exact_def_return -+ -+)( fixnum "XParseColor")) -+ -+ -+ -+(defentry XParseGeometry( -+ -+ object ;; parsestring -+ fixnum ;; x_return -+ fixnum ;; y_return -+ fixnum ;; width_return -+ fixnum ;; height_return -+ -+)( fixnum "XParseGeometry")) -+ -+ -+ -+(defentry XPeekEvent( -+ -+ fixnum ;; display -+ fixnum ;; event_return -+ -+)( void "XPeekEvent")) -+ -+ -+ -+ -+(defentry XPending( -+ -+ fixnum ;; display -+ -+)( fixnum "XPending")) -+ -+ -+ -+(defentry XPlanesOfScreen( -+ -+ fixnum ;; screen -+ -+ -+)( fixnum "XPlanesOfScreen")) -+ -+ -+ -+(defentry XProtocolRevision( -+ -+ fixnum ;; display -+ -+)( fixnum "XProtocolRevision")) -+ -+ -+ -+(defentry XProtocolVersion( -+ -+ fixnum ;; display -+ -+)( fixnum "XProtocolVersion")) -+ -+ -+ -+ -+(defentry XPutBackEvent( -+ -+ fixnum ;; display -+ fixnum ;; event -+ -+)( void "XPutBackEvent")) -+ -+ -+ -+(defentry XPutImage( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; gc -+ fixnum ;; image -+ fixnum ;; src_x -+ fixnum ;; src_y -+ fixnum ;; dest_x -+ fixnum ;; dest_y -+ fixnum ;; width -+ fixnum ;; height -+ -+)( void "XPutImage")) -+ -+ -+ -+(defentry XQLength( -+ -+ fixnum ;; display -+ -+)( fixnum "XQLength")) -+ -+ -+ -+(defentry XQueryBestCursor( -+ -+ fixnum ;; display -+ fixnum ;; d -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; width_return -+ fixnum ;; height_return -+ -+)( fixnum "XQueryBestCursor")) -+ -+ -+ -+(defentry XQueryBestSize( -+ -+ fixnum ;; display -+ fixnum ;; class -+ fixnum ;; which_screen -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; width_return -+ fixnum ;; height_return -+ -+)( fixnum "XQueryBestSize")) -+ -+ -+ -+(defentry XQueryBestStipple( -+ -+ fixnum ;; display -+ fixnum ;; which_screen -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; width_return -+ fixnum ;; height_return -+ -+)( fixnum "XQueryBestStipple")) -+ -+ -+ -+(defentry XQueryBestTile( -+ -+ fixnum ;; display -+ fixnum ;; which_screen -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; width_return -+ fixnum ;; height_return -+ -+)( fixnum "XQueryBestTile")) -+ -+ -+ -+(defentry XQueryColor( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ fixnum ;; def_in_out -+ -+)( void "XQueryColor")) -+ -+ -+ -+(defentry XQueryColors( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ fixnum ;; defs_in_out -+ fixnum ;; ncolors -+ -+)( void "XQueryColors")) -+ -+ -+ -+(defentry XQueryExtension( -+ -+ fixnum ;; display -+ object ;; name -+ fixnum ;; major_opcode_return -+ fixnum ;; first_event_return -+ fixnum ;; first_error_return -+ -+)( fixnum "XQueryExtension")) -+ -+ -+;;fix -+(defentry XQueryKeymap( -+ -+ fixnum ;; display -+ fixnum ;; keys_return -+ -+)( void "XQueryKeymap")) -+ -+ -+ -+(defentry XQueryPointer( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; root_return -+ fixnum ;; child_return -+ fixnum ;; root_x_return -+ fixnum ;; root_y_return -+ fixnum ;; win_x_return -+ fixnum ;; win_y_return -+ fixnum ;; mask_return -+ -+)( fixnum "XQueryPointer")) -+ -+ -+ -+(defentry XQueryTextExtents( -+ -+ fixnum ;; display -+ fixnum ;; font_ID -+ object ;; string -+ fixnum ;; nchars -+ fixnum ;; direction_return -+ fixnum ;; font_ascent_return -+ fixnum ;; font_descent_return -+ fixnum ;; overall_return -+ -+)( void "XQueryTextExtents")) -+ -+ -+ -+(defentry XQueryTextExtents16( -+ -+ fixnum ;; display -+ fixnum ;; font_ID -+ fixnum ;; string -+ fixnum ;; nchars -+ fixnum ;; direction_return -+ fixnum ;; font_ascent_return -+ fixnum ;; font_descent_return -+ fixnum ;; overall_return -+ -+)( void "XQueryTextExtents16")) -+ -+ -+ -+(defentry XQueryTree( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; root_return -+ fixnum ;; parent_return -+ fixnum ;; children_return -+ fixnum ;; nchildren_return -+ -+)( fixnum "XQueryTree")) -+ -+ -+ -+(defentry XRaiseWindow( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( void "XRaiseWindow")) -+ -+ -+ -+(defentry XReadBitmapFile( -+ -+ fixnum ;; display -+ fixnum ;; d -+ object ;; filename -+ fixnum ;; width_return -+ fixnum ;; height_return -+ fixnum ;; bitmap_return -+ fixnum ;; x_hot_return -+ fixnum ;; y_hot_return -+ -+)( fixnum "XReadBitmapFile")) -+ -+ -+ -+(defentry XRebindKeysym( -+ -+ fixnum ;; display -+ fixnum ;; keysym -+ fixnum ;; list -+ fixnum ;; mod_count -+ object ;; string -+ fixnum ;; bytes_string -+ -+)( void "XRebindKeysym")) -+ -+ -+ -+(defentry XRecolorCursor( -+ -+ fixnum ;; display -+ fixnum ;; cursor -+ fixnum ;; foreground_color -+ fixnum ;; background_color -+ -+)( void "XRecolorCursor")) -+ -+ -+ -+(defentry XRefreshKeyboardMapping( -+ -+ fixnum ;; event_map -+ -+)( void "XRefreshKeyboardMapping")) -+ -+ -+ -+(defentry XRemoveFromSaveSet( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( void "XRemoveFromSaveSet")) -+ -+ -+ -+(defentry XRemoveHost( -+ -+ fixnum ;; display -+ fixnum ;; host -+ -+)( void "XRemoveHost")) -+ -+ -+ -+(defentry XRemoveHosts( -+ -+ fixnum ;; display -+ fixnum ;; hosts -+ fixnum ;; num_hosts -+ -+)( void "XRemoveHosts")) -+ -+ -+ -+(defentry XReparentWindow( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; parent -+ fixnum ;; x -+ fixnum ;; y -+ -+)( void "XReparentWindow")) -+ -+ -+ -+(defentry XResetScreenSaver( -+ -+ fixnum ;; display -+ -+)( void "XResetScreenSaver")) -+ -+ -+ -+(defentry XResizeWindow( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; width -+ fixnum ;; height -+ -+)( void "XResizeWindow")) -+ -+ -+ -+(defentry XRestackWindows( -+ -+ fixnum ;; display -+ fixnum ;; windows -+ fixnum ;; nwindows -+ -+)( void "XRestackWindows")) -+ -+ -+ -+(defentry XRotateBuffers( -+ -+ fixnum ;; display -+ fixnum ;; rotate -+ -+)( void "XRotateBuffers")) -+ -+ -+ -+(defentry XRotateWindowProperties( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; properties -+ fixnum ;; num_prop -+ fixnum ;; npositions -+ -+)( void "XRotateWindowProperties")) -+ -+ -+ -+(defentry XScreenCount( -+ -+ fixnum ;; display -+ -+)( fixnum "XScreenCount")) -+ -+ -+ -+(defentry XSelectInput( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; event_mask -+ -+)( void "XSelectInput")) -+ -+ -+ -+(defentry XSendEvent( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; propagate -+ fixnum ;; event_mask -+ fixnum ;; event_send -+ -+)( fixnum "XSendEvent")) -+ -+ -+ -+(defentry XSetAccessControl( -+ -+ fixnum ;; display -+ fixnum ;; mode -+ -+)( void "XSetAccessControl")) -+ -+ -+ -+(defentry XSetArcMode( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; arc_mode -+ -+)( void "XSetArcMode")) -+ -+ -+ -+(defentry XSetBackground( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; background -+ -+)( void "XSetBackground")) -+ -+ -+ -+(defentry XSetClipMask( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; fixnum -+ -+)( void "XSetClipMask")) -+ -+ -+ -+(defentry XSetClipOrigin( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; clip_x_origin -+ fixnum ;; clip_y_origin -+ -+)( void "XSetClipOrigin")) -+ -+ -+ -+(defentry XSetClipRectangles( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; clip_x_origin -+ fixnum ;; clip_y_origin -+ fixnum ;; rectangles -+ fixnum ;; n -+ fixnum ;; ordering -+ -+)( void "XSetClipRectangles")) -+ -+ -+ -+(defentry XSetCloseDownMode( -+ -+ fixnum ;; display -+ fixnum ;; close_mode -+ -+)( void "XSetCloseDownMode")) -+ -+ -+ -+(defentry XSetCommand( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; argv -+ fixnum ;; argc -+ -+)( void "XSetCommand")) -+ -+ -+ -+(defentry XSetDashes( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; dash_offset -+ object ;; dash_list -+ fixnum ;; n -+ -+)( void "XSetDashes")) -+ -+ -+ -+(defentry XSetFillRule( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; fill_rule -+ -+)( void "XSetFillRule")) -+ -+ -+ -+(defentry XSetFillStyle( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; fill_style -+ -+)( void "XSetFillStyle")) -+ -+ -+ -+(defentry XSetFont( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; font -+ -+)( void "XSetFont")) -+ -+ -+ -+(defentry XSetFontPath( -+ -+ fixnum ;; display -+ fixnum ;; directories -+ fixnum ;; ndirs -+ -+)( void "XSetFontPath")) -+ -+ -+ -+(defentry XSetForeground( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; foreground -+ -+)( void "XSetForeground")) -+ -+ -+ -+(defentry XSetFunction( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; function -+ -+)( void "XSetFunction")) -+ -+ -+ -+(defentry XSetGraphicsExposures( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; graphics_exposures -+ -+)( void "XSetGraphicsExposures")) -+ -+ -+ -+(defentry XSetIconName( -+ -+ fixnum ;; display -+ fixnum ;; w -+ object ;; icon_name -+ -+)( void "XSetIconName")) -+ -+ -+ -+(defentry XSetInputFocus( -+ -+ fixnum ;; display -+ fixnum ;; focus -+ fixnum ;; revert_to -+ fixnum ;; fixnum -+ -+)( void "XSetInputFocus")) -+ -+ -+ -+(defentry XSetLineAttributes( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; line_width -+ fixnum ;; line_style -+ fixnum ;; cap_style -+ fixnum ;; join_style -+ -+)( void "XSetLineAttributes")) -+ -+ -+ -+(defentry XSetModifierMapping( -+ -+ fixnum ;; display -+ fixnum ;; modmap -+ -+)( fixnum "XSetModifierMapping")) -+ -+ -+ -+(defentry XSetPlaneMask( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; plane_mask -+ -+)( void "XSetPlaneMask")) -+ -+ -+ -+(defentry XSetPointerMapping( -+ -+ fixnum ;; display -+ object ;; map -+ fixnum ;; nmap -+ -+)( fixnum "XSetPointerMapping")) -+ -+ -+ -+(defentry XSetScreenSaver( -+ -+ fixnum ;; display -+ fixnum ;; intout -+ fixnum ;; interval -+ fixnum ;; prefer_blanking -+ fixnum ;; allow_exposures -+ -+)( void "XSetScreenSaver")) -+ -+ -+ -+(defentry XSetSelectionOwner( -+ -+ fixnum ;; display -+ fixnum ;; selection -+ fixnum ;; owner -+ fixnum ;; fixnum -+ -+)( void "XSetSelectionOwner")) -+ -+ -+ -+(defentry XSetState( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; foreground -+ fixnum ;; background -+ fixnum ;; function -+ fixnum ;; plane_mask -+ -+)( void "XSetState")) -+ -+ -+ -+(defentry XSetStipple( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; stipple -+ -+)( void "XSetStipple")) -+ -+ -+ -+(defentry XSetSubwindowMode( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; subwindow_mode -+ -+)( void "XSetSubwindowMode")) -+ -+ -+ -+(defentry XSetTSOrigin( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; ts_x_origin -+ fixnum ;; ts_y_origin -+ -+)( void "XSetTSOrigin")) -+ -+ -+ -+(defentry XSetTile( -+ -+ fixnum ;; display -+ fixnum ;; gc -+ fixnum ;; tile -+ -+)( void "XSetTile")) -+ -+ -+ -+(defentry XSetWindowBackground( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; background_pixel -+ -+)( void "XSetWindowBackground")) -+ -+ -+ -+(defentry XSetWindowBackgroundPixmap( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; background_pixmap -+ -+)( void "XSetWindowBackgroundPixmap")) -+ -+ -+ -+(defentry XSetWindowBorder( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; border_pixel -+ -+)( void "XSetWindowBorder")) -+ -+ -+ -+(defentry XSetWindowBorderPixmap( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; border_pixmap -+ -+)( void "XSetWindowBorderPixmap")) -+ -+ -+ -+(defentry XSetWindowBorderWidth( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; width -+ -+)( void "XSetWindowBorderWidth")) -+ -+ -+ -+(defentry XSetWindowColormap( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; colormap -+ -+)( void "XSetWindowColormap")) -+ -+ -+ -+(defentry XStoreBuffer( -+ -+ fixnum ;; display -+ object ;; bytes -+ fixnum ;; nbytes -+ fixnum ;; buffer -+ -+)( void "XStoreBuffer")) -+ -+ -+ -+(defentry XStoreBytes( -+ -+ fixnum ;; display -+ object ;; bytes -+ fixnum ;; nbytes -+ -+)( void "XStoreBytes")) -+ -+ -+ -+(defentry XStoreColor( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ fixnum ;; color -+ -+)( void "XStoreColor")) -+ -+ -+ -+(defentry XStoreColors( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ fixnum ;; color -+ fixnum ;; ncolors -+ -+)( void "XStoreColors")) -+ -+ -+ -+(defentry XStoreName( -+ -+ fixnum ;; display -+ fixnum ;; w -+ object ;; window_name -+ -+)( void "XStoreName")) -+ -+ -+ -+(defentry XStoreNamedColor( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ object ;; color -+ fixnum ;; pixel -+ fixnum ;; flags -+ -+)( void "XStoreNamedColor")) -+ -+ -+ -+(defentry XSync( -+ -+ fixnum ;; display -+ fixnum ;; discard -+ -+)( void "XSync")) -+ -+ -+ -+(defentry XTextExtents( -+ -+ fixnum ;; font_struct -+ object ;; string -+ fixnum ;; nchars -+ fixnum ;; direction_return -+ fixnum ;; font_ascent_return -+ fixnum ;; font_descent_return -+ fixnum ;; overall_return -+ -+)( void "XTextExtents")) -+ -+ -+ -+(defentry XTextExtents16( -+ -+ fixnum ;; font_struct -+ fixnum ;; string -+ fixnum ;; nchars -+ fixnum ;; direction_return -+ fixnum ;; font_ascent_return -+ fixnum ;; font_descent_return -+ fixnum ;; overall_return -+ -+)( void "XTextExtents16")) -+ -+ -+ -+(defentry XTextWidth( -+ -+ fixnum ;; font_struct -+ object ;; string -+ fixnum ;; count -+ -+)( fixnum "XTextWidth")) -+ -+ -+ -+(defentry XTextWidth16( -+ -+ fixnum ;; font_struct -+ fixnum ;; string -+ fixnum ;; count -+ -+)( fixnum "XTextWidth16")) -+ -+ -+ -+(defentry XTranslateCoordinates( -+ -+ fixnum ;; display -+ fixnum ;; src_w -+ fixnum ;; dest_w -+ fixnum ;; src_x -+ fixnum ;; src_y -+ fixnum ;; dest_x_return -+ fixnum ;; dest_y_return -+ fixnum ;; child_return -+ -+)( fixnum "XTranslateCoordinates")) -+ -+ -+ -+(defentry XUndefineCursor( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( void "XUndefineCursor")) -+ -+ -+ -+(defentry XUngrabButton( -+ -+ fixnum ;; display -+ fixnum ;; button -+ fixnum ;; modifiers -+ fixnum ;; grab_window -+ -+)( void "XUngrabButton")) -+ -+ -+ -+(defentry XUngrabKey( -+ -+ fixnum ;; display -+ fixnum ;; keycode -+ fixnum ;; modifiers -+ fixnum ;; grab_window -+ -+)( void "XUngrabKey")) -+ -+ -+ -+(defentry XUngrabKeyboard( -+ -+ fixnum ;; display -+ fixnum ;; fixnum -+ -+)( void "XUngrabKeyboard")) -+ -+ -+ -+(defentry XUngrabPointer( -+ -+ fixnum ;; display -+ fixnum ;; fixnum -+ -+)( void "XUngrabPointer")) -+ -+ -+ -+(defentry XUngrabServer( -+ -+ fixnum ;; display -+ -+)( void "XUngrabServer")) -+ -+ -+ -+(defentry XUninstallColormap( -+ -+ fixnum ;; display -+ fixnum ;; colormap -+ -+)( void "XUninstallColormap")) -+ -+ -+ -+(defentry XUnloadFont( -+ -+ fixnum ;; display -+ fixnum ;; font -+ -+)( void "XUnloadFont")) -+ -+ -+ -+(defentry XUnmapSubwindows( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( void "XUnmapSubwindows")) -+ -+ -+ -+(defentry XUnmapWindow( -+ -+ fixnum ;; display -+ fixnum ;; w -+ -+)( void "XUnmapWindow")) -+ -+ -+ -+(defentry XVendorRelease( -+ -+ fixnum ;; display -+ -+)( fixnum "XVendorRelease")) -+ -+ -+ -+(defentry XWarpPointer( -+ -+ fixnum ;; display -+ fixnum ;; src_w -+ fixnum ;; dest_w -+ fixnum ;; src_x -+ fixnum ;; src_y -+ fixnum ;; src_width -+ fixnum ;; src_height -+ fixnum ;; dest_x -+ fixnum ;; dest_y -+ -+)( void "XWarpPointer")) -+ -+ -+ -+(defentry XWidthMMOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XWidthMMOfScreen")) -+ -+ -+ -+(defentry XWidthOfScreen( -+ -+ fixnum ;; screen -+ -+)( fixnum "XWidthOfScreen")) -+ -+ -+ -+(defentry XWindowEvent( -+ -+ fixnum ;; display -+ fixnum ;; w -+ fixnum ;; event_mask -+ fixnum ;; event_return -+ -+)( void "XWindowEvent")) -+ -+ -+ -+(defentry XWriteBitmapFile( -+ -+ fixnum ;; display -+ object ;; filename -+ fixnum ;; bitmap -+ fixnum ;; width -+ fixnum ;; height -+ fixnum ;; x_hot -+ fixnum ;; y_hot -+ -+)( fixnum "XWriteBitmapFile")) -+ -+ -+ -+;;;;;;;;;problems -+ -+ -+ -+ -+;;(defentry fixnum (int Synchronize( -+ -+;; fixnum ;; display -+;; fixnum ;; onoff -+ -+;;))()()) -+;;(defentry fixnum (int SetAfterFunction( -+ -+;; fixnum ;; display -+;; fixnum (int ( fixnum ;; display -+;; ) ;; procedure -+ -+;;))()()) -+ -+ -+;;(defentry void XPeekIfEvent( -+ -+;; fixnum ;; display -+;; fixnum ;; event_return -+;; fixnum (int ( fixnum ;; display -+;; fixnum ;; event -+;; object ;; arg -+;; ) ;; predicate -+;; object ;; arg -+ -+;;)()) -+ -+;;(defentry fixnum XCheckIfEvent( -+ -+;; fixnum ;; display -+;; fixnum ;; event_return -+;; fixnum (int ( fixnum ;; display -+;; fixnum ;; event -+;; object ;; arg -+;; ) ;; predicate -+;; object ;; arg -+ -+;;)()) -+ -+;;(defentry void XIfEvent( -+ -+;; fixnum ;; display -+;; fixnum ;; event_return -+;; fixnum (int ( fixnum ;; display -+;; fixnum ;; event -+;; object ;; arg -+;; ) ;; predicate -+;; object ;; arg -+ -+;;)()) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_dwtrans.lsp -@@ -0,0 +1,2894 @@ -+; 13 Jan 2010 17:40:33 EST -+; dwtrans.lsp -- translation of dwindow.lsp ; 07 Jan 10 -+ -+; Copyright (c) 2010 Gordon S. Novak Jr. and The University of Texas at Austin. -+ -+; See the files gnu.license and dec.copyright . -+ -+; This program 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 program 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 program; if not, write to the Free Software -+; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -+ -+; Some of the files that interface to the Xlib are adapted from DEC/MIT files. -+; See the file dec.copyright for details. -+ -+; Written by: Gordon S. Novak Jr., Department of Computer Sciences, -+; University of Texas at Austin 78712. novak@cs.utexas.edu -+ -+ -+(in-package :xlib) -+ -+(defmacro while (test &rest forms) `(loop (unless ,test (return)) ,@forms) ) -+ -+(setf (get 'xlib::int-pos 'user::glfnresulttype) 'lisp::integer) -+(setf (get 'xlib::fixnum-pos 'user::glfnresulttype) 'lisp::integer) -+ -+; exported symbols: from dwimports.lsp -+(dolist (x '( menu stringify window picmenu textmenu editmenu barmenu -+ display-size -+ window-get-mouse-position window-create window-set-font -+ window-font-info window-gcontext window-parent -+ window-drawable-height window-drawable-width window-label -+ window-font window-foreground window-set-foreground -+ window-background window-set-background window-wfunction -+ window-get-geometry window-get-geometry-b window-sync -+ window-screen-height window-geometry window-size -+ window-left window-top-neg-y window-reset-geometry -+ window-force-output window-query-pointer window-set-xor -+ window-unset window-reset window-set-erase -+ window-set-copy window-set-invert window-set-line-width -+ window-set-line-attr window-std-line-attr window-draw-line -+ window-draw-line-xy window-draw-arrowhead-xy -+ window-draw-arrow-xy window-draw-arrow2-xy window-draw-box -+ window-draw-box-xy window-xor-box-xy window-draw-box-corners -+ window-draw-rcbox-xy window-draw-arc-xy -+ window-draw-circle-xy window-draw-circle window-erase-area -+ window-erase-area-xy window-erase-box-xy -+ window-draw-ellipse-xy window-copy-area-xy window-invertarea -+ window-invert-area window-invert-area-xy -+ window-prettyprintat window-prettyprintat-xy window-printat -+ window-printat-xy window-string-width window-string-height -+ window-string-extents window-font-string-width -+ window-yposition window-centeroffset dowindowcom -+ window-menu window-close window-unmap window-open -+ window-map window-destroy window-destroy-selected-window -+ window-clear window-moveto-xy window-paint -+ window-move window-draw-border window-track-mouse -+ window-wait-exposure window-wait-unmap -+ window-init-mouse-poll window-poll-mouse menu-init -+ menu-calculate-size menu-adjust-offset menu-draw -+ menu-item-value menu-find-item-width menu-find-item-height -+ menu-clear menu-display-item menu-choose menu-box-item -+ menu-unbox-item menu-item-position menu-select -+ menu-select! menu-select-b menu-destroy -+ menu-create menu-offset menu-size menu-moveto-xy -+ menu-reposition picmenu-create picmenu-create-spec -+ picmenu-create-from-spec picmenu-calculate-size picmenu-init -+ picmenu-draw picmenu-draw-button picmenu-delete-named-button -+ picmenu-select picmenu-box-item picmenu-unbox-item -+ picmenu-destroy picmenu-button-containsxy? -+ picmenu-item-position barmenu-create -+ barmenu-calculate-size barmenu-init barmenu-draw -+ barmenu-select barmenu-update-value window-get-point -+ window-get-click window-get-line-position -+ window-get-latex-position window-get-box-position -+ window-get-icon-position window-get-region -+ window-get-box-size window-track-mouse-in-region -+ window-adjust-box-side window-adj-box-xy window-get-circle -+ window-circle-radius window-draw-circle-pt -+ window-get-ellipse window-draw-ellipse-pt -+ window-draw-vector-pt window-get-vector-end -+ window-get-crosshairs window-draw-crosshairs-xy -+ window-get-cross window-draw-cross-xy window-draw-dot-xy -+ window-draw-latex-xy window-reset-color -+ window-set-color-rgb window-set-xcolor window-set-color -+ window-set-color window-free-color window-get-chars -+ window-process-char-event window-input-string -+ window-input-char-fn window-draw-carat window-init-keymap -+ window-set-cursor window-positive-y window-code-char -+ window-get-raw-char -+ window-print-line window-print-lines textmenu-create -+ textmenu-calculate-size textmenu-init textmenu-draw -+ textmenu-select textmenu-set-text textmenu -+ editmenu editmenu-create editmenu-calculate-size -+ editmenu-init editmenu-draw editmenu-display -+ window-edit -+ window-edit-display editmenu-carat editmenu-erase -+ window-edit-erase editmenu-select editmenu-edit-fn -+ window-edit-fn editmenu-setxy editmenu-char -+ editmenu-edit -+ *window-editmenu-kill-strings* -+*window-add-menu-title* -+*window-menu* -+*mouse-x* -+*mouse-y* -+*mouse-window* -+*window-fonts* -+*window-display* -+*window-screen* -+*root-window* -+*black-pixel* -+*white-pixel* -+*default-fg-color* -+*default-bg-color* -+*default-size-hints* -+*default-GC* -+*default-colormap* -+*window-event* -+*window-default-pos-x* -+*window-default-pos-y* -+*window-default-border* -+*window-default-font-name* -+*window-default-cursor* -+*window-save-foreground* -+*window-save-function* -+*window-attributes* -+*window-attr* -+*menu-title-pad* -+*root-return* -+*child-return* -+*root-x-return* -+*root-y-return* -+*win-x-return* -+*win-y-return* -+*mask-return* -+*x-return* -+*y-return* -+*width-return* -+*height-return* -+*depth-return* -+*border-width-return* -+*text-width-return* -+*direction-return* -+*ascent-return* -+*descent-return* -+*overall-return* -+*GC-Values* -+*window-xcolor* -+*window-menu-code* -+ -+*window-keymap* -+*window-shiftkeymap* -+*window-keyinit* -+*window-meta* -+*window-ctrl* -+*window-shift* -+*window-string* -+*window-string-count* -+*window-string-max* -+*window-input-string-x* -+*window-input-string-y* -+*window-input-string-charwidth* -+ -+*window-shift-keys* -+*window-control-keys* -+*window-meta-keys* -+*barmenu-update-value-cons* -+*picmenu-no-selection* -+*min-keycodes-return* -+*max-keycodes-return* -+*keycodes-return* -+ )) -+ (export x)) ; export the above symbols -+ -+(DEFVAR *WINDOW-ADD-MENU-TITLE* NIL) -+ -+(DEFVAR *WINDOW-MENU* NIL) -+ -+(DEFVAR *MOUSE-X* NIL) -+ -+(DEFVAR *MOUSE-Y* NIL) -+ -+(DEFVAR *MOUSE-WINDOW* NIL) -+ -+(DEFVAR *WINDOW-FONTS* -+ (LIST (LIST 'COURIER-BOLD-12 -+ "*-*-courier-bold-r-*-*-12-*-*-*-*-*-iso8859-1") -+ (LIST 'COURIER-MEDIUM-12 -+ "*-*-courier-medium-r-*-*-12-*-*-*-*-*-iso8859-1") -+ (LIST '6X12 "6x12") (LIST '8X13 "8x13") -+ (LIST '9X15 "9x15"))) -+ -+ -+ -+(DEFVAR *WINDOW-DISPLAY* NIL) -+ -+(DEFVAR *WINDOW-SCREEN* NIL) -+ -+(DEFVAR *ROOT-WINDOW*) -+ -+(DEFVAR *BLACK-PIXEL*) -+ -+(DEFVAR *WHITE-PIXEL*) -+ -+(DEFVAR *DEFAULT-FG-COLOR*) -+ -+(DEFVAR *DEFAULT-BG-COLOR*) -+ -+(DEFVAR *DEFAULT-SIZE-HINTS*) -+ -+(DEFVAR *DEFAULT-GC*) -+ -+(DEFVAR *DEFAULT-COLORMAP*) -+ -+(DEFVAR *WINDOW-EVENT*) -+ -+(DEFVAR *WINDOW-DEFAULT-POS-X* 10) -+ -+(DEFVAR *WINDOW-DEFAULT-POS-Y* 20) -+ -+(DEFVAR *WINDOW-DEFAULT-BORDER* 1) -+ -+(DEFVAR *WINDOW-DEFAULT-FONT-NAME* 'COURIER-BOLD-12) -+ -+(DEFVAR *WINDOW-DEFAULT-CURSOR* 68) -+ -+(DEFVAR *WINDOW-SAVE-FOREGROUND*) -+ -+(DEFVAR *WINDOW-SAVE-FUNCTION*) -+ -+(DEFVAR *WINDOW-ATTRIBUTES*) -+ -+(DEFVAR *WINDOW-ATTR*) -+ -+(DEFVAR *MENU-TITLE-PAD* 30) -+ -+(DEFVAR *ROOT-RETURN* (FIXNUM-ARRAY 1)) -+ -+(DEFVAR *CHILD-RETURN* (FIXNUM-ARRAY 1)) -+ -+(DEFVAR *ROOT-X-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *ROOT-Y-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *WIN-X-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *WIN-Y-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *MASK-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *X-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *Y-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *WIDTH-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *HEIGHT-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *DEPTH-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *BORDER-WIDTH-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *TEXT-WIDTH-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *DIRECTION-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *ASCENT-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *DESCENT-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *OVERALL-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *GC-VALUES*) -+ -+(DEFVAR *WINDOW-XCOLOR* NIL) -+ -+(DEFVAR *WINDOW-MENU-CODE* NIL) -+ -+(DEFVAR *WINDOW-KEYMAP* (MAKE-ARRAY 256)) -+ -+(DEFVAR *WINDOW-SHIFTKEYMAP* (MAKE-ARRAY 256)) -+ -+(DEFVAR *WINDOW-KEYINIT* NIL) -+ -+(DEFVAR *WINDOW-META*) -+ -+(DEFVAR *WINDOW-CTRL*) -+ -+(DEFVAR *WINDOW-SHIFT*) -+ -+(DEFVAR *WINDOW-SHIFT-KEYS* NIL) -+ -+(DEFVAR *WINDOW-CONTROL-KEYS* NIL) -+ -+(DEFVAR *WINDOW-META-KEYS* NIL) -+ -+(DEFVAR *MIN-KEYCODES-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *MAX-KEYCODES-RETURN* (INT-ARRAY 1)) -+ -+(DEFVAR *KEYCODES-RETURN* (INT-ARRAY 1)) -+ -+(SETQ *WINDOW-KEYINIT* NIL) -+ -+(DEFMACRO PICMENU-SPEC (SYMBOL) (LIST 'GET SYMBOL ''PICMENU-SPEC)) -+ -+ -+ -+ -+ -+(DEFVAR *PICMENU-NO-SELECTION* '(NO-SELECTION (0 0) (0 0) NIL NIL)) -+ -+(DEFUN STRINGIFY (X) -+ (COND -+ ((STRINGP X) X) -+ ((SYMBOLP X) (COPY-SEQ (SYMBOL-NAME X))) -+ (T (PRINC-TO-STRING X)))) -+ -+(DEFUN WINDOW-XINIT () -+ (SETQ *WINDOW-DISPLAY* (XOPENDISPLAY (GET-C-STRING ""))) -+ (IF (OR (NOT (NUMBERP *WINDOW-DISPLAY*)) (< *WINDOW-DISPLAY* 10000)) -+ (ERROR "DISPLAY did not open: return value ~A~%" -+ *WINDOW-DISPLAY*)) -+ (SETQ *WINDOW-SCREEN* (XDEFAULTSCREEN *WINDOW-DISPLAY*)) -+ (SETQ *ROOT-WINDOW* (XROOTWINDOW *WINDOW-DISPLAY* *WINDOW-SCREEN*)) -+ (SETQ *BLACK-PIXEL* (XBLACKPIXEL *WINDOW-DISPLAY* *WINDOW-SCREEN*)) -+ (SETQ *WHITE-PIXEL* (XWHITEPIXEL *WINDOW-DISPLAY* *WINDOW-SCREEN*)) -+ (SETQ *DEFAULT-FG-COLOR* *BLACK-PIXEL*) -+ (SETQ *DEFAULT-BG-COLOR* *WHITE-PIXEL*) -+ (SETQ *DEFAULT-GC* (XDEFAULTGC *WINDOW-DISPLAY* *WINDOW-SCREEN*)) -+ (SETQ *DEFAULT-COLORMAP* -+ (XDEFAULTCOLORMAP *WINDOW-DISPLAY* *WINDOW-SCREEN*)) -+ (SETQ *WINDOW-ATTRIBUTES* (MAKE-XSETWINDOWATTRIBUTES)) -+ (SET-XSETWINDOWATTRIBUTES-BACKING_STORE *WINDOW-ATTRIBUTES* -+ WHENMAPPED) -+ (SET-XSETWINDOWATTRIBUTES-SAVE_UNDER *WINDOW-ATTRIBUTES* 1) -+ (SETQ *WINDOW-ATTR* (MAKE-XWINDOWATTRIBUTES)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (SETQ *DEFAULT-SIZE-HINTS* (MAKE-XSIZEHINTS)) -+ (SETQ *WINDOW-EVENT* (MAKE-XEVENT)) -+ (SETQ *GC-VALUES* (MAKE-XGCVALUES))) -+ -+(DEFUN WINDOW-GET-MOUSE-POSITION () -+ (XQUERYPOINTER *WINDOW-DISPLAY* *ROOT-WINDOW* *ROOT-RETURN* -+ *CHILD-RETURN* *ROOT-X-RETURN* *ROOT-Y-RETURN* *WIN-X-RETURN* -+ *WIN-Y-RETURN* *MASK-RETURN*) -+ (SETQ *MOUSE-X* (INT-POS *ROOT-X-RETURN* 0)) -+ (SETQ *MOUSE-Y* (INT-POS *ROOT-Y-RETURN* 0)) -+ (SETQ *MOUSE-WINDOW* (FIXNUM-POS *CHILD-RETURN* 0))) -+ -+ -+ -+(DEFUN WINDOW-CREATE -+ (WIDTH HEIGHT &OPTIONAL STR PARENTW POS-X POS-Y FONT) -+ (LET (W PW FG-COLOR BG-COLOR) -+ (OR *WINDOW-DISPLAY* (WINDOW-XINIT)) -+ (SETQ FG-COLOR *DEFAULT-FG-COLOR*) -+ (SETQ BG-COLOR *DEFAULT-BG-COLOR*) -+ (UNLESS POS-X (SETQ POS-X *WINDOW-DEFAULT-POS-X*)) -+ (UNLESS POS-Y (SETQ POS-Y *WINDOW-DEFAULT-POS-Y*)) -+ (SETQ W -+ (LIST 'WINDOW NIL NIL HEIGHT WIDTH -+ (IF STR (STRINGIFY STR) " ") NIL)) -+ (SETQ PW (OR PARENTW *ROOT-WINDOW*)) -+ (WINDOW-GET-GEOMETRY-B PW) -+ (SETF (CADR W) -+ (XCREATESIMPLEWINDOW *WINDOW-DISPLAY* PW POS-X -+ (- (- (INT-POS *HEIGHT-RETURN* 0) POS-Y) HEIGHT) WIDTH -+ HEIGHT *WINDOW-DEFAULT-BORDER* FG-COLOR BG-COLOR)) -+ (SET-XSIZEHINTS-X *DEFAULT-SIZE-HINTS* POS-X) -+ (SET-XSIZEHINTS-Y *DEFAULT-SIZE-HINTS* POS-Y) -+ (SET-XSIZEHINTS-WIDTH *DEFAULT-SIZE-HINTS* (FIFTH W)) -+ (SET-XSIZEHINTS-HEIGHT *DEFAULT-SIZE-HINTS* (CADDDR W)) -+ (SET-XSIZEHINTS-FLAGS *DEFAULT-SIZE-HINTS* 12) -+ (XSETSTANDARDPROPERTIES *WINDOW-DISPLAY* (CADR W) -+ (GET-C-STRING (SIXTH W)) (GET-C-STRING (SIXTH W)) 0 0 0 -+ *DEFAULT-SIZE-HINTS*) -+ (SETF (CADDR W) (XCREATEGC *WINDOW-DISPLAY* (CADR W) 0 0)) -+ (XSETFOREGROUND *WINDOW-DISPLAY* (CADDR W) FG-COLOR) -+ (XSETBACKGROUND *WINDOW-DISPLAY* (CADDR W) BG-COLOR) -+ (WINDOW-SET-FONT W (OR FONT *WINDOW-DEFAULT-FONT-NAME*)) -+ (LET (C) -+ (SETQ C -+ (XCREATEFONTCURSOR *WINDOW-DISPLAY* -+ *WINDOW-DEFAULT-CURSOR*)) -+ (XDEFINECURSOR *WINDOW-DISPLAY* (CADR W) C)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0) -+ (XCHANGEWINDOWATTRIBUTES *WINDOW-DISPLAY* (CADR W) 1088 -+ *WINDOW-ATTRIBUTES*) -+ (XSELECTINPUT *WINDOW-DISPLAY* (CADR W) 32876) -+ (XMAPWINDOW *WINDOW-DISPLAY* (CADR W)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (WINDOW-WAIT-EXPOSURE W) -+ W)) -+ -+(DEFUN WINDOW-SET-FONT (W FONTSYMBOL) -+ (LET (FONTSTRING FONT-INFO) -+ (SETQ FONTSTRING -+ (OR (CADR (ASSOC FONTSYMBOL *WINDOW-FONTS*)) -+ (STRINGIFY FONTSYMBOL))) -+ (SETQ FONT-INFO -+ (XLOADQUERYFONT *WINDOW-DISPLAY* (GET-C-STRING FONTSTRING))) -+ (IF (ZEROP FONT-INFO) -+ (FORMAT T "~%can't open font ~a ~a~%" FONTSYMBOL FONTSTRING) -+ (PROGN -+ (XSETFONT *WINDOW-DISPLAY* (CADDR W) -+ (XFONTSTRUCT-FID FONT-INFO)) -+ (SETF (SEVENTH W) FONT-INFO))))) -+ -+(DEFUN WINDOW-FONT-INFO (FONTSYMBOL) -+ (XLOADQUERYFONT *WINDOW-DISPLAY* -+ (GET-C-STRING -+ (OR (CADR (ASSOC FONTSYMBOL *WINDOW-FONTS*)) -+ (STRINGIFY FONTSYMBOL))))) -+ -+(DEFUN WINDOW-GCONTEXT (W) (CADDR W)) -+ -+(DEFUN WINDOW-PARENT (W) (CADR W)) -+ -+(DEFUN WINDOW-DRAWABLE-HEIGHT (W) (CADDDR W)) -+ -+(DEFUN WINDOW-DRAWABLE-WIDTH (W) (FIFTH W)) -+ -+(DEFUN WINDOW-LABEL (W) (SIXTH W)) -+ -+(DEFUN WINDOW-FONT (W) (SEVENTH W)) -+ -+(DEFUN WINDOW-FOREGROUND (W) -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*)) -+ -+(DEFUN WINDOW-SET-FOREGROUND (W FG-COLOR) -+ (XSETFOREGROUND *WINDOW-DISPLAY* (CADDR W) FG-COLOR)) -+ -+(DEFUN WINDOW-BACKGROUND (W) -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*)) -+ -+(DEFUN WINDOW-SET-BACKGROUND (W BG-COLOR) -+ (XSETBACKGROUND *WINDOW-DISPLAY* (CADDR W) BG-COLOR)) -+ -+(DEFUN WINDOW-WFUNCTION (W) -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*)) -+ -+(DEFUN WINDOW-GET-GEOMETRY (W) (WINDOW-GET-GEOMETRY-B (CADR W))) -+ -+(DEFUN WINDOW-SET-CURSOR (W N) -+ (LET (C) -+ (SETQ C (XCREATEFONTCURSOR *WINDOW-DISPLAY* N)) -+ (XDEFINECURSOR *WINDOW-DISPLAY* (CADR W) C))) -+ -+(DEFUN WINDOW-GET-GEOMETRY-B (W) -+ (XGETGEOMETRY *WINDOW-DISPLAY* W *ROOT-RETURN* *X-RETURN* *Y-RETURN* -+ *WIDTH-RETURN* *HEIGHT-RETURN* *BORDER-WIDTH-RETURN* -+ *DEPTH-RETURN*)) -+ -+(DEFUN WINDOW-SYNC (W) (declare (ignore w)) (XSYNC *WINDOW-DISPLAY* 1)) -+ -+(DEFUN WINDOW-SCREEN-HEIGHT () -+ (WINDOW-GET-GEOMETRY-B *ROOT-WINDOW*) -+ (INT-POS *HEIGHT-RETURN* 0)) -+ -+(DEFUN WINDOW-GEOMETRY (W) -+ (LET (SH) -+ (SETQ SH (WINDOW-SCREEN-HEIGHT)) -+ (WINDOW-GET-GEOMETRY-B (CADR W)) -+ (SETF (FIFTH W) (INT-POS *WIDTH-RETURN* 0)) -+ (SETF (CADDDR W) (INT-POS *HEIGHT-RETURN* 0)) -+ (LIST (INT-POS *X-RETURN* 0) -+ (- (- SH (INT-POS *Y-RETURN* 0)) (INT-POS *HEIGHT-RETURN* 0)) -+ (INT-POS *WIDTH-RETURN* 0) (INT-POS *HEIGHT-RETURN* 0) -+ (INT-POS *BORDER-WIDTH-RETURN* 0)))) -+ -+(DEFUN WINDOW-SIZE (W) -+ (WINDOW-GET-GEOMETRY-B (CADR W)) -+ (LIST (SETF (FIFTH W) (INT-POS *WIDTH-RETURN* 0)) -+ (SETF (CADDDR W) (INT-POS *HEIGHT-RETURN* 0)))) -+ -+(DEFUN WINDOW-LEFT (W) -+ (WINDOW-GET-GEOMETRY-B (CADR W)) -+ (INT-POS *X-RETURN* 0)) -+ -+(DEFUN WINDOW-TOP-NEG-Y (W) -+ (WINDOW-GET-GEOMETRY-B (CADR W)) -+ (INT-POS *Y-RETURN* 0)) -+ -+(DEFUN WINDOW-RESET-GEOMETRY (W) -+ (WINDOW-GET-GEOMETRY-B (CADR W)) -+ (SETF (FIFTH W) (INT-POS *WIDTH-RETURN* 0)) -+ (SETF (CADDDR W) (INT-POS *HEIGHT-RETURN* 0))) -+ -+(DEFUN WINDOW-FORCE-OUTPUT (&OPTIONAL W) (declare (ignore w)) (XFLUSH *WINDOW-DISPLAY*)) -+ -+(DEFUN WINDOW-QUERY-POINTER (W) (WINDOW-QUERY-POINTER-B (CADR W))) -+ -+(DEFUN WINDOW-QUERY-POINTER-B (W) -+ (XQUERYPOINTER *WINDOW-DISPLAY* W *ROOT-RETURN* *CHILD-RETURN* -+ *ROOT-X-RETURN* *ROOT-Y-RETURN* *WIN-X-RETURN* *WIN-Y-RETURN* -+ *MASK-RETURN*)) -+ -+(DEFUN WINDOW-POSITIVE-Y (W Y) (- (CADDDR W) Y)) -+ -+(DEFUN WINDOW-SET-XOR (W) -+ (LET ((GC (CADDR W))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (LOGXOR *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 -+ *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*)))))) -+ -+(DEFUN WINDOW-UNSET (W) -+ (LET ((GC (CADDR W))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) -+ -+(DEFUN WINDOW-RESET (W) -+ (LET ((GC (CADDR W))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 3) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC *DEFAULT-FG-COLOR*) -+ (XSETBACKGROUND *WINDOW-DISPLAY* GC *DEFAULT-BG-COLOR*))) -+ -+(DEFUN WINDOW-SET-ERASE (W) -+ (LET ((GC (CADDR W))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 3) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*))))) -+ -+(DEFUN WINDOW-SET-COPY (W) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* (CADDR W) 3) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*)))) -+ -+(DEFUN WINDOW-SET-INVERT (W) -+ (LET ((GC (CADDR W))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (LOGXOR *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 -+ *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*)))))) -+ -+(DEFUN WINDOW-SET-LINE-WIDTH (W WIDTH) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR WIDTH 1) 0 1 0)) -+ -+(DEFUN WINDOW-SET-LINE-ATTR -+ (W WIDTH &OPTIONAL LINE-STYLE CAP-STYLE JOIN-STYLE) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR WIDTH 1) -+ (OR LINE-STYLE 0) (OR CAP-STYLE 1) (OR JOIN-STYLE 0))) -+ -+(DEFUN WINDOW-STD-LINE-ATTR (W) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) -+ -+(DEFUN WINDOW-DRAW-LINE (W FROM TO &OPTIONAL LINEWIDTH) -+ (WINDOW-DRAW-LINE-XY W (CAR FROM) (CADR FROM) (CAR TO) (CADR TO) -+ LINEWIDTH)) -+ -+(DEFUN WINDOW-DRAW-LINE-XY -+ (W FROMX FROMY TOX TOY &OPTIONAL LINEWIDTH OPERATION) -+ (LET ((QQWHEIGHT (CADDDR W))) -+ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) -+ 0 1 0)) -+ (CASE OPERATION -+ (XOR (LET ((GC (CADDR W))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 -+ *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 -+ *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (LOGXOR *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 -+ *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*)))))) -+ (ERASE (LET ((GC (CADDR W))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 -+ *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 3) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 -+ *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 -+ *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*))))) -+ (T)) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) FROMX -+ (- QQWHEIGHT FROMY) TOX (- QQWHEIGHT TOY)) -+ (CASE OPERATION -+ ((XOR ERASE) -+ (LET ((GC (CADDR W))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) -+ (T)) -+ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)))) -+ -+(DEFUN WINDOW-DRAW-ARROWHEAD-XY -+ (W X1 Y1 X2 Y2 &OPTIONAL (LINEWIDTH 1) SIZE) -+ (LET (TH THETA YSTH YCTH (Y2DELA 0) (Y2DELB 0) (X2DELA 0) (X2DELB 0)) -+ (OR SIZE (SETQ SIZE (+ 20 (* LINEWIDTH 5)))) -+ (SETQ TH (ATAN (- Y2 Y1) (- X2 X1))) -+ (SETQ THETA (* TH (/ 180.0 PI))) -+ (SETQ YSTH (ROUND (* (1+ SIZE) (SIN TH)))) -+ (SETQ YCTH (ROUND (* (1+ SIZE) (COS TH)))) -+ (IF (AND (EQL Y1 Y2) (EVENP LINEWIDTH)) -+ (IF (> X2 X1) (SETQ Y2DELB 1) (SETQ Y2DELA 1))) -+ (IF (AND (EQL X1 X2) (EVENP LINEWIDTH)) -+ (IF (> Y2 Y1) (SETQ X2DELB 1) (SETQ X2DELA 1))) -+ (WINDOW-DRAW-ARC-XY W (- (- X2 YSTH) X2DELA) (+ (+ Y2 YCTH) Y2DELA) -+ SIZE SIZE (+ 240 THETA) 30 LINEWIDTH) -+ (WINDOW-DRAW-ARC-XY W (- (+ X2 YSTH) X2DELB) (+ (- Y2 YCTH) Y2DELB) -+ SIZE SIZE (+ 90 THETA) 30 LINEWIDTH))) -+ -+(DEFUN WINDOW-DRAW-ARROW-XY -+ (W X1 Y1 X2 Y2 &OPTIONAL (LINEWIDTH 1) SIZE) -+ (WINDOW-DRAW-LINE-XY W X1 Y1 X2 Y2 LINEWIDTH) -+ (WINDOW-DRAW-ARROWHEAD-XY W X1 Y1 X2 Y2 LINEWIDTH SIZE)) -+ -+(DEFUN WINDOW-DRAW-ARROW2-XY -+ (W X1 Y1 X2 Y2 &OPTIONAL (LINEWIDTH 1) SIZE) -+ (WINDOW-DRAW-LINE-XY W X1 Y1 X2 Y2 LINEWIDTH) -+ (WINDOW-DRAW-ARROWHEAD-XY W X1 Y1 X2 Y2 LINEWIDTH SIZE) -+ (WINDOW-DRAW-ARROWHEAD-XY W X2 Y2 X1 Y1 LINEWIDTH SIZE)) -+ -+(DEFUN WINDOW-DRAW-BOX (W OFFSET SIZE &OPTIONAL LINEWIDTH) -+ (WINDOW-DRAW-BOX-XY W (CAR OFFSET) (CADR OFFSET) (CAR SIZE) -+ (CADR SIZE) LINEWIDTH)) -+ -+(DEFUN WINDOW-DRAW-BOX-XY -+ (W OFFSETX OFFSETY SIZEX SIZEY &OPTIONAL LINEWIDTH) -+ (LET ((QQWHEIGHT (CADDDR W)) LW LW2 LW2B (PW (CADR W)) -+ (GC (CADDR W))) -+ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) -+ 0 1 0)) -+ (SETQ LW (OR LINEWIDTH 1)) -+ (SETQ LW2 (TRUNCATE LW 2)) -+ (SETQ LW2B (TRUNCATE (1+ LW) 2)) -+ (XDRAWLINE *WINDOW-DISPLAY* PW GC (- OFFSETX LW2) -+ (- QQWHEIGHT OFFSETY) (- (+ OFFSETX SIZEX) LW2) -+ (- QQWHEIGHT OFFSETY)) -+ (XDRAWLINE *WINDOW-DISPLAY* PW GC (+ OFFSETX SIZEX) -+ (- QQWHEIGHT (- OFFSETY LW2B)) (+ OFFSETX SIZEX) -+ (- QQWHEIGHT (+ SIZEY (- OFFSETY LW2B)))) -+ (XDRAWLINE *WINDOW-DISPLAY* PW GC (+ OFFSETX SIZEX LW2B) -+ (- QQWHEIGHT (+ OFFSETY SIZEY)) (+ OFFSETX LW2B) -+ (- QQWHEIGHT (+ OFFSETY SIZEY))) -+ (XDRAWLINE *WINDOW-DISPLAY* PW GC OFFSETX -+ (- QQWHEIGHT (+ OFFSETY SIZEY LW2)) OFFSETX -+ (- QQWHEIGHT (+ OFFSETY LW2))) -+ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)))) -+ -+(DEFUN WINDOW-XOR-BOX-XY -+ (W OFFSETX OFFSETY SIZEX SIZEY &OPTIONAL LINEWIDTH) -+ (WINDOW-SET-XOR W) -+ (WINDOW-DRAW-BOX-XY W OFFSETX OFFSETY SIZEX SIZEY LINEWIDTH) -+ (WINDOW-UNSET W)) -+ -+(DEFUN WINDOW-DRAW-BOX-CORNERS (W XA YA XB YB &OPTIONAL LW) -+ (WINDOW-DRAW-BOX-XY W (MIN XA XB) (MIN YA YB) (ABS (- XA XB)) -+ (ABS (- YA YB)) LW)) -+ -+(DEFUN WINDOW-DRAW-RCBOX-XY -+ (W X Y WIDTH HEIGHT RADIUS &OPTIONAL LINEWIDTH) -+ (LET (X1 X2 Y1 Y2 R LW2 LW2B FUDGE) -+ (SETQ R -+ (MAX 0 -+ (MIN RADIUS (TRUNCATE (ABS WIDTH) 2) -+ (TRUNCATE (ABS HEIGHT) 2)))) -+ (IF (NOT (NUMBERP LINEWIDTH)) (SETQ LINEWIDTH 1)) -+ (SETQ LW2 (TRUNCATE LINEWIDTH 2)) -+ (SETQ LW2B (TRUNCATE (1+ LINEWIDTH) 2)) -+ (SETQ FUDGE (IF (ODDP LINEWIDTH) 0 1)) -+ (SETQ X1 (+ X R)) -+ (SETQ X2 (- (+ X WIDTH) R)) -+ (SETQ Y1 (+ Y R)) -+ (SETQ Y2 (- (+ Y HEIGHT) R)) -+ (LET ((QQWHEIGHT (CADDDR W))) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) -+ (OR LINEWIDTH 1) 0 1 0)) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (- (1- X1) LW2) -+ (- QQWHEIGHT Y) X2 (- QQWHEIGHT Y)) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) -+ (LET ((QQWHEIGHT (CADDDR W))) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) -+ (OR LINEWIDTH 1) 0 1 0)) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ X WIDTH) -+ (- QQWHEIGHT (- Y1 LW2B)) (+ X WIDTH) (- QQWHEIGHT (1+ Y2))) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) -+ (LET ((QQWHEIGHT (CADDDR W))) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) -+ (OR LINEWIDTH 1) 0 1 0)) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (1- X1) -+ (- QQWHEIGHT (+ Y HEIGHT)) (+ X2 LW2) -+ (- QQWHEIGHT (+ Y HEIGHT))) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) -+ (LET ((QQWHEIGHT (CADDDR W))) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) -+ (OR LINEWIDTH 1) 0 1 0)) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) X (- QQWHEIGHT Y1) -+ X (- QQWHEIGHT (1+ Y2))) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) -+ 0 1 0)) -+ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- (- X1 FUDGE) R) -+ (- (CADDDR W) (+ Y1 R)) (* 2 R) (* 2 R) 11520 5760) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) -+ 0 1 0)) -+ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- X2 R) -+ (- (CADDDR W) (+ Y1 R)) (* 2 R) (* 2 R) 17280 5760) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) -+ 0 1 0)) -+ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- X2 R) -+ (- (CADDDR W) (+ (+ Y2 FUDGE) R)) (* 2 R) (* 2 R) 0 5760) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) -+ 0 1 0)) -+ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- (- X1 FUDGE) R) -+ (- (CADDDR W) (+ (+ Y2 FUDGE) R)) (* 2 R) (* 2 R) 5760 5760) -+ (IF (AND LINEWIDTH (/= LINEWIDTH 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)))) -+ -+(DEFUN WINDOW-DRAW-ARC-XY -+ (W X Y RADIUSX RADIUSY ANGLEA ANGLEB &OPTIONAL LINEWIDTH) -+ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) 0 -+ 1 0)) -+ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- X RADIUSX) -+ (- (CADDDR W) (+ Y RADIUSY)) (* 2 RADIUSX) (* 2 RADIUSY) -+ (TRUNCATE (* 64 ANGLEA)) (TRUNCATE (* 64 ANGLEB))) -+ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) -+ -+(DEFUN WINDOW-DRAW-CIRCLE-XY (W X Y RADIUS &OPTIONAL LINEWIDTH) -+ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LINEWIDTH 1) 0 -+ 1 0)) -+ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- X RADIUS) -+ (- (CADDDR W) (+ Y RADIUS)) (* 2 RADIUS) (* 2 RADIUS) 0 23040) -+ (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1))) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) -+ -+(DEFUN WINDOW-DRAW-CIRCLE (W POS RADIUS &OPTIONAL LINEWIDTH) -+ (WINDOW-DRAW-CIRCLE-XY W (CAR POS) (CADR POS) RADIUS LINEWIDTH)) -+ -+(DEFUN WINDOW-ERASE-AREA (W OFFSET SIZE) -+ (WINDOW-ERASE-AREA-XY W (CAR OFFSET) (CADR OFFSET) (CAR SIZE) -+ (CADR SIZE))) -+ -+(DEFUN WINDOW-ERASE-AREA-XY (W XOFF YOFF XSIZE YSIZE) -+ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) XOFF -+ (- (CADDDR W) (1- (+ YOFF YSIZE))) XSIZE YSIZE 0)) -+ -+(DEFUN WINDOW-ERASE-BOX-XY -+ (W XOFF YOFF XSIZE YSIZE &OPTIONAL LINEWIDTH) -+ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) -+ (- XOFF (TRUNCATE (OR LINEWIDTH 1) 2)) -+ (- (CADDDR W) (+ YOFF YSIZE (TRUNCATE (OR LINEWIDTH 1) 2))) -+ (+ XSIZE (OR LINEWIDTH 1)) (+ YSIZE (OR LINEWIDTH 1)) 0)) -+ -+(DEFUN WINDOW-DRAW-ELLIPSE-XY (W X Y RX RY &OPTIONAL LW) -+ (IF (AND LW (NOT (EQL LW 1))) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) (OR LW 1) 0 1 0)) -+ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (- X RX) -+ (- (CADDDR W) (+ Y RY)) (* 2 RX) (* 2 RY) 0 23040) -+ (IF (AND LW (NOT (EQL LW 1))) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))) -+ -+(DEFUN WINDOW-COPY-AREA-XY (W FROMX FROMY TOX TOY WIDTH HEIGHT) -+ (LET ((QQWHEIGHT (CADDDR W))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* (CADDR W) 3) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XCOPYAREA *WINDOW-DISPLAY* (CADR W) (CADR W) (CADDR W) FROMX -+ (- QQWHEIGHT (+ FROMY HEIGHT)) WIDTH HEIGHT TOX -+ (- QQWHEIGHT (+ TOY HEIGHT))) -+ (LET ((GC (CADDR W))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)))) -+ -+(DEFUN WINDOW-INVERTAREA (W AREA) -+ (WINDOW-INVERT-AREA-XY W (CAAR AREA) (CADAR AREA) (CAADR AREA) -+ (CADADR AREA))) -+ -+(DEFUN WINDOW-INVERT-AREA (W OFFSET SIZE) -+ (WINDOW-INVERT-AREA-XY W (CAR OFFSET) (CADR OFFSET) (CAR SIZE) -+ (CADR SIZE))) -+ -+(DEFUN WINDOW-INVERT-AREA-XY (W LEFT BOTTOM WIDTH HEIGHT) -+ (LET ((GC (CADDR W))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (LOGXOR *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 -+ *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*))))) -+ (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR W) (CADDR W) LEFT -+ (- (CADDDR W) (1- (+ BOTTOM HEIGHT))) WIDTH HEIGHT) -+ (LET ((GC (CADDR W))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) -+ -+(DEFUN WINDOW-PRETTYPRINTAT (W S POS) -+ (LET ((SSTR (STRINGIFY S))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) (CAR POS) -+ (- (CADDDR W) (CADR POS)) (GET-C-STRING SSTR) (LENGTH SSTR)))) -+ -+(DEFUN WINDOW-PRETTYPRINTAT-XY (W S X Y) -+ (LET ((SSTR (STRINGIFY S))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) X -+ (- (CADDDR W) Y) (GET-C-STRING SSTR) (LENGTH SSTR)))) -+ -+(DEFUN WINDOW-PRINTAT (W S POS) -+ (LET ((SSTR (STRINGIFY S))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) (CAR POS) -+ (- (CADDDR W) (CADR POS)) (GET-C-STRING SSTR) (LENGTH SSTR)))) -+ -+(DEFUN WINDOW-PRINTAT-XY (W S X Y) -+ (LET ((SSTR (STRINGIFY S))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) X -+ (- (CADDDR W) Y) (GET-C-STRING SSTR) (LENGTH SSTR)))) -+ -+(DEFUN WINDOW-PRINT-LINE (W STR X Y &OPTIONAL DELTAY) -+ (LET ((N 0) END STRB DONE) -+ (WHILE (NOT DONE) -+ (SETQ END (POSITION #\Newline STR :TEST #'CHAR= :START N)) -+ (SETQ STRB (SUBSEQ STR N END)) -+ (LET ((SSTR (STRINGIFY STRB))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) X -+ (- (CADDDR W) Y) (GET-C-STRING SSTR) (LENGTH SSTR))) -+ (IF (NUMBERP END) (SETQ N (1+ END)) (SETQ DONE T)) -+ (DECF Y (OR DELTAY 16)) (IF (MINUSP Y) (SETQ DONE T))) -+ (XFLUSH *WINDOW-DISPLAY*))) -+ -+(DEFUN WINDOW-PRINT-LINES (W LINES X Y &OPTIONAL DELTAY) -+ (DOLIST (STR LINES) -+ (WHEN (PLUSP Y) -+ (LET ((SSTR (STRINGIFY STR))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) X -+ (- (CADDDR W) Y) (GET-C-STRING SSTR) (LENGTH SSTR))) -+ (DECF Y (OR DELTAY 16))))) -+ -+(DEFUN WINDOW-STRING-WIDTH (W S) -+ (LET ((SSTR (STRINGIFY S))) -+ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) -+ -+(DEFUN WINDOW-STRING-EXTENTS (W S) -+ (LET ((SSTR (STRINGIFY S))) -+ (XTEXTEXTENTS (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR) -+ *DIRECTION-RETURN* *ASCENT-RETURN* *DESCENT-RETURN* -+ *OVERALL-RETURN*) -+ (LIST (INT-POS *ASCENT-RETURN* 0) (INT-POS *DESCENT-RETURN* 0)))) -+ -+(DEFUN WINDOW-STRING-HEIGHT (W S) -+ (LET ((SSTR (STRINGIFY S))) -+ (XTEXTEXTENTS (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR) -+ *DIRECTION-RETURN* *ASCENT-RETURN* *DESCENT-RETURN* -+ *OVERALL-RETURN*) -+ (+ (INT-POS *ASCENT-RETURN* 0) (INT-POS *DESCENT-RETURN* 0)))) -+ -+(DEFUN WINDOW-FONT-STRING-WIDTH (FONT S) -+ (LET ((SSTR (STRINGIFY S))) -+ (XTEXTWIDTH FONT (GET-C-STRING SSTR) (LENGTH SSTR)))) -+ -+(DEFUN WINDOW-YPOSITION (W) -+ (WINDOW-GET-MOUSE-POSITION) -+ (- (CADDDR W) -+ (- *MOUSE-Y* -+ (PROGN -+ (WINDOW-GET-GEOMETRY-B (CADR W)) -+ (INT-POS *Y-RETURN* 0))))) -+ -+(DEFUN WINDOW-CENTEROFFSET (W V) -+ (LIST (TRUNCATE (- (FIFTH W) (CAR V)) 2) -+ (TRUNCATE (- (CADDDR W) (CADR V)) 2))) -+ -+(DEFUN DOWINDOWCOM (W) -+ (LET (COMM) -+ (SETQ COMM (MENU-SELECT (WINDOW-MENU))) -+ (CASE COMM -+ (CLOSE (XUNMAPWINDOW *WINDOW-DISPLAY* (CADR W)) -+ (XFLUSH *WINDOW-DISPLAY*) (WINDOW-WAIT-UNMAP W)) -+ (PAINT (WINDOW-PAINT W)) -+ (CLEAR (XCLEARWINDOW *WINDOW-DISPLAY* (CADR W)) -+ (XFLUSH *WINDOW-DISPLAY*)) -+ (MOVE (WINDOW-MOVE W)) -+ (T (WHEN COMM (PRINC "This command not implemented.") (TERPRI)))))) -+ -+(DEFUN WINDOW-MENU () -+ (OR *WINDOW-MENU* -+ (SETQ *WINDOW-MENU* -+ (LIST 'MENU (COPY-LIST '(WINDOW NIL NIL 0 0 "" NIL)) NIL -+ NIL 0 0 0 0 "" NIL NIL 0 '(CLOSE PAINT CLEAR MOVE))))) -+ -+(DEFUN WINDOW-CLOSE (W) -+ (XUNMAPWINDOW *WINDOW-DISPLAY* (CADR W)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (WINDOW-WAIT-UNMAP W)) -+ -+(DEFUN WINDOW-UNMAP (W) (XUNMAPWINDOW *WINDOW-DISPLAY* (CADR W))) -+ -+(DEFUN WINDOW-OPEN (W) -+ (XMAPWINDOW *WINDOW-DISPLAY* (CADR W)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (WINDOW-WAIT-EXPOSURE W)) -+ -+(DEFUN WINDOW-MAP (W) (XMAPWINDOW *WINDOW-DISPLAY* (CADR W))) -+ -+(DEFUN WINDOW-DESTROY (W) -+ (XDESTROYWINDOW *WINDOW-DISPLAY* (CADR W)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (SETF (CADR W) NIL) -+ (XFREEGC *WINDOW-DISPLAY* (CADDR W)) -+ (SETF (CADDR W) NIL)) -+ -+(DEFUN WINDOW-DESTROY-SELECTED-WINDOW () -+ (PROG (WW CHILD) -+ (SLEEP 3) -+ (SETQ WW *ROOT-WINDOW*) -+ LP -+ (WINDOW-QUERY-POINTER-B WW) -+ (SETQ CHILD (FIXNUM-POS *CHILD-RETURN* 0)) -+ (IF (> CHILD 0) (PROGN (SETQ WW CHILD) (GO LP))) -+ (IF (/= WW *ROOT-WINDOW*) -+ (PROGN -+ (XDESTROYWINDOW *WINDOW-DISPLAY* WW) -+ (XFLUSH *WINDOW-DISPLAY*))))) -+ -+(DEFUN WINDOW-CLEAR (W) -+ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR W)) -+ (XFLUSH *WINDOW-DISPLAY*)) -+ -+(DEFUN WINDOW-MOVETO-XY (W X Y) -+ (XMOVEWINDOW *WINDOW-DISPLAY* (CADR W) X -+ (- (WINDOW-SCREEN-HEIGHT) Y))) -+ -+(DEFUN WINDOW-PAINT (WINDOW) -+ (LET (STATE) -+ (WINDOW-TRACK-MOUSE WINDOW -+ #'(LAMBDA (X Y CODE) -+ (IF (= CODE 1) -+ (IF (= STATE 1) (SETQ STATE 0) (SETQ STATE 1)) -+ (IF (= CODE 2) -+ (IF (= STATE 2) (SETQ STATE 0) (SETQ STATE 2)))) -+ (IF (= STATE 1) -+ (WINDOW-DRAW-LINE-XY WINDOW X Y X Y 1 'PAINT) -+ (IF (= STATE 2) -+ (WINDOW-DRAW-LINE-XY WINDOW X Y X Y 1 'ERASE))) -+ (= CODE 3))))) -+ -+(DEFUN WINDOW-MOVE (W) -+ (WINDOW-GET-MOUSE-POSITION) -+ (XMOVEWINDOW *WINDOW-DISPLAY* (CADR W) *MOUSE-X* -+ (- (WINDOW-SCREEN-HEIGHT) *MOUSE-Y*))) -+ -+(DEFUN WINDOW-DRAW-BORDER (W) -+ (WINDOW-DRAW-BOX-XY W 0 1 (1- (CAR (WINDOW-SIZE W))) -+ (1- (CADR (WINDOW-SIZE W)))) -+ (XFLUSH *WINDOW-DISPLAY*)) -+ -+(DEFUN WINDOW-TRACK-MOUSE (W FN &OPTIONAL OUTFLG) -+ (LET (WIN H) -+ (SETQ WIN (WINDOW-PARENT W)) -+ (SETQ H (WINDOW-DRAWABLE-HEIGHT W)) -+ (XSYNC *WINDOW-DISPLAY* 1) -+ (XSELECTINPUT *WINDOW-DISPLAY* WIN -+ (+ BUTTONPRESSMASK POINTERMOTIONMASK)) -+ (DO ((RES NIL)) (RES RES) -+ (XNEXTEVENT *WINDOW-DISPLAY* *WINDOW-EVENT*) -+ (LET ((TYPE (XANYEVENT-TYPE *WINDOW-EVENT*)) -+ (EVENTWINDOW (XANYEVENT-WINDOW *WINDOW-EVENT*))) -+ (WHEN (OR (AND (EQL EVENTWINDOW WIN) -+ (OR (EQL TYPE MOTIONNOTIFY) -+ (EQL TYPE BUTTONPRESS))) -+ (AND OUTFLG (EQL TYPE BUTTONPRESS))) -+ (LET ((X (XMOTIONEVENT-X *WINDOW-EVENT*)) -+ (Y (XMOTIONEVENT-Y *WINDOW-EVENT*)) -+ (CODE (IF (EQL TYPE BUTTONPRESS) -+ (XBUTTONEVENT-BUTTON *WINDOW-EVENT*) 0))) -+ (SETQ RES -+ (IF (EQL EVENTWINDOW WIN) (FUNCALL FN X (- H Y) CODE) -+ (FUNCALL FN -1 -1 CODE))))))))) -+ -+(DEFUN WINDOW-WAIT-EXPOSURE (W) -+ (PROG (WIN START-TIME MAX-TIME EVENTWINDOW TYPE) -+ (SETQ WIN (WINDOW-PARENT W)) -+ (XGETWINDOWATTRIBUTES *WINDOW-DISPLAY* WIN *WINDOW-ATTR*) -+ (UNLESS (EQL (XWINDOWATTRIBUTES-MAP_STATE *WINDOW-ATTR*) -+ ISUNMAPPED) -+ (RETURN T)) -+ (SETQ START-TIME (GET-INTERNAL-REAL-TIME)) -+ (SETQ MAX-TIME INTERNAL-TIME-UNITS-PER-SECOND) -+ (XSELECTINPUT *WINDOW-DISPLAY* WIN (+ EXPOSUREMASK)) -+ LP -+ (COND -+ ((> (XPENDING *WINDOW-DISPLAY*) 0) -+ (XNEXTEVENT *WINDOW-DISPLAY* *WINDOW-EVENT*) -+ (SETQ TYPE (XANYEVENT-TYPE *WINDOW-EVENT*)) -+ (SETQ EVENTWINDOW (XANYEVENT-WINDOW *WINDOW-EVENT*)) -+ (IF (AND (EQL EVENTWINDOW WIN) (EQL TYPE EXPOSE)) (RETURN T))) -+ ((> (- (GET-INTERNAL-REAL-TIME) START-TIME) MAX-TIME) -+ (RETURN NIL))) -+ (GO LP))) -+ -+(DEFUN WINDOW-WAIT-UNMAP (W) -+ (PROG (WIN START-TIME MAX-TIME) -+ (SETQ WIN (WINDOW-PARENT W)) -+ (SETQ START-TIME (GET-INTERNAL-REAL-TIME)) -+ (SETQ MAX-TIME INTERNAL-TIME-UNITS-PER-SECOND) -+ LP -+ (XGETWINDOWATTRIBUTES *WINDOW-DISPLAY* WIN *WINDOW-ATTR*) -+ (IF (EQL (XWINDOWATTRIBUTES-MAP_STATE *WINDOW-ATTR*) ISUNMAPPED) -+ (RETURN T) -+ (IF (> (- (GET-INTERNAL-REAL-TIME) START-TIME) MAX-TIME) -+ (RETURN NIL))) -+ (GO LP))) -+ -+(DEFUN WINDOW-INIT-MOUSE-POLL (W) -+ (LET (WIN) -+ (SETQ WIN (WINDOW-PARENT W)) -+ (XSYNC *WINDOW-DISPLAY* 1) -+ (XSELECTINPUT *WINDOW-DISPLAY* WIN -+ (+ BUTTONPRESSMASK POINTERMOTIONMASK)))) -+ -+(DEFUN WINDOW-POLL-MOUSE (W) -+ (LET (WIN H EVENTTYPE EVENTWINDOW X Y CD (CODE 0)) -+ (SETQ WIN (WINDOW-PARENT W)) -+ (SETQ H (WINDOW-DRAWABLE-HEIGHT W)) -+ (WHILE (> (XPENDING *WINDOW-DISPLAY*) 0) -+ (XNEXTEVENT *WINDOW-DISPLAY* *WINDOW-EVENT*) -+ (SETQ EVENTTYPE (XANYEVENT-TYPE *WINDOW-EVENT*)) -+ (SETQ EVENTWINDOW (XANYEVENT-WINDOW *WINDOW-EVENT*)) -+ (IF (EQL EVENTWINDOW WIN) -+ (IF (EQL EVENTTYPE MOTIONNOTIFY) -+ (PROGN -+ (SETQ X (XMOTIONEVENT-X *WINDOW-EVENT*)) -+ (SETQ Y (XMOTIONEVENT-Y *WINDOW-EVENT*))) -+ (IF (EQL EVENTTYPE BUTTONPRESS) -+ (IF (> (SETQ CD -+ (XBUTTONEVENT-BUTTON -+ *WINDOW-EVENT*)) -+ 0) -+ (SETQ CODE CD)))))) -+ (IF (OR X (> CODE 0)) (LIST X (IF Y (- H Y)) CODE)))) -+ -+(DEFUN MENU-INIT (M) -+ (OR *WINDOW-DISPLAY* (WINDOW-XINIT)) -+ (MENU-CALCULATE-SIZE M) -+ (IF (NOT (CADDR M)) -+ (SETF (CADR M) -+ (WINDOW-CREATE (SEVENTH M) (EIGHTH M) (OR (NINTH M) "") -+ (CADDDR M) (FIFTH M) (SIXTH M) (NTH 10 M))))) -+ -+(DEFUN MENU-CALCULATE-SIZE (M) -+ (LET (MAXWIDTH TOTALHEIGHT NITEMS) -+ (OR (NTH 10 M) (SETF (NTH 10 M) '9X15)) -+ (SETQ MAXWIDTH -+ (+ (MENU-FIND-ITEM-WIDTH M (NINTH M)) -+ (IF (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*) 0 -+ *MENU-TITLE-PAD*))) -+ (SETQ NITEMS -+ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) -+ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) -+ 1 0)) -+ (SETQ TOTALHEIGHT (* 13 NITEMS)) -+ (DOLIST (ITEM (NTH 12 M)) -+ (INCF NITEMS) -+ (SETQ MAXWIDTH (MAX MAXWIDTH (MENU-FIND-ITEM-WIDTH M ITEM))) -+ (INCF TOTALHEIGHT (MENU-FIND-ITEM-HEIGHT M ITEM))) -+ (SETF (NTH 11 M) (+ 6 MAXWIDTH)) -+ (SETF (SEVENTH M) (1+ (NTH 11 M))) -+ (SETF (EIGHTH M) (+ 2 TOTALHEIGHT)) -+ (MENU-ADJUST-OFFSET M))) -+ -+(DEFUN MENU-ADJUST-OFFSET (M) -+ (LET (XBASE YBASE WBASE HBASE XOFF YOFF WGM WIDTH HEIGHT) -+ (SETQ WIDTH (SEVENTH M)) -+ (SETQ HEIGHT (EIGHTH M)) -+ (WHEN (NOT (CADDDR M)) -+ (WINDOW-GET-MOUSE-POSITION) -+ (SETQ WGM T) -+ (SETF (CADDDR M) *ROOT-WINDOW*)) -+ (WINDOW-GET-GEOMETRY-B (CADDDR M)) -+ (SETQ XBASE (INT-POS *X-RETURN* 0)) -+ (SETQ YBASE (INT-POS *Y-RETURN* 0)) -+ (SETQ WBASE (INT-POS *WIDTH-RETURN* 0)) -+ (SETQ HBASE (INT-POS *HEIGHT-RETURN* 0)) -+ (IF (OR (NOT (FIFTH M)) (ZEROP (FIFTH M))) -+ (PROGN -+ (OR WGM (WINDOW-GET-MOUSE-POSITION)) -+ (SETQ XOFF (+ -4 (- (- *MOUSE-X* XBASE) (TRUNCATE WIDTH 2)))) -+ (SETQ YOFF -+ (- (- HBASE (- *MOUSE-Y* YBASE)) (TRUNCATE HEIGHT 2)))) -+ (PROGN (SETQ XOFF (FIFTH M)) (SETQ YOFF (SIXTH M)))) -+ (SETF (FIFTH M) (MAX 0 (MIN XOFF (- WBASE WIDTH)))) -+ (SETF (SIXTH M) (MAX 0 (MIN YOFF (- HBASE HEIGHT)))))) -+ -+(DEFUN MENU-DRAW (M) -+ (LET (MW XZERO YZERO BOTTOM) -+ (OR (AND (CADR M) (PLUSP (EIGHTH M))) (MENU-INIT M)) -+ (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) -+ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) -+ (SETQ MW (CADR M)) -+ (XMAPWINDOW *WINDOW-DISPLAY* (CADR MW)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (WINDOW-WAIT-EXPOSURE MW) -+ (MENU-CLEAR M) -+ (IF (CADDR M) -+ (WINDOW-DRAW-BOX-XY MW (1- XZERO) YZERO (+ 2 (SEVENTH M)) -+ (1+ (EIGHTH M)) 1)) -+ (SETQ BOTTOM (+ 3 (+ YZERO (EIGHTH M)))) -+ (WHEN (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) -+ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) -+ (INCF BOTTOM -15) -+ (LET ((SSTR (STRINGIFY (STRINGIFY (NINTH M))))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) (CADDR MW) -+ (+ 3 XZERO) (- (CADDDR MW) BOTTOM) (GET-C-STRING SSTR) -+ (LENGTH SSTR))) -+ (LET ((GC (CADDR MW))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 -+ *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 -+ *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (LOGXOR *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 -+ *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*))))) -+ (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR MW) (CADDR MW) XZERO -+ (+ -12 (- (CADDDR MW) BOTTOM)) (1+ (SEVENTH M)) 15) -+ (LET ((GC (CADDR MW))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) -+ (DOLIST (ITEM (NTH 12 M)) -+ (DECF BOTTOM (MENU-FIND-ITEM-HEIGHT M ITEM)) -+ (MENU-DISPLAY-ITEM M ITEM (+ 3 XZERO) BOTTOM)) -+ (XFLUSH *WINDOW-DISPLAY*))) -+ -+(DEFUN MENU-ITEM-VALUE (SELF ITEM) (declare (ignore self)) (IF (CONSP ITEM) (CDR ITEM) ITEM)) -+ -+(DEFUN MENU-FIND-ITEM-WIDTH (SELF ITEM) -+ (LET (TMP) -+ (IF (AND (CONSP ITEM) (SYMBOLP (CAR ITEM)) (FBOUNDP (CAR ITEM))) -+ (OR (AND (SETQ TMP (GET (CAR ITEM) 'DISPLAY-SIZE)) (CAR TMP)) -+ 40) -+ (WINDOW-FONT-STRING-WIDTH -+ (OR (AND (CADDR SELF) (CADR SELF) (SEVENTH (CADR SELF))) -+ (WINDOW-FONT-INFO (NTH 10 SELF))) -+ (STRINGIFY (IF (CONSP ITEM) (CAR ITEM) ITEM)))))) -+ -+(DEFUN MENU-FIND-ITEM-HEIGHT (SELF ITEM) -+ (declare (ignore self)) -+ (LET (TMP) -+ (IF (AND (CONSP ITEM) (SYMBOLP (CAR ITEM)) -+ (SETQ TMP (GET (CAR ITEM) 'DISPLAY-SIZE))) -+ (+ 3 (CADR TMP)) 15))) -+ -+(DEFUN MENU-CLEAR (M) -+ (IF (CADDR M) -+ (LET ((GLVAR386 (+ 3 (EIGHTH M)))) -+ (XCLEARAREA *WINDOW-DISPLAY* (CADADR M) -+ (1- (IF (CADDR M) (FIFTH M) 0)) -+ (- (CADDDR (CADR M)) -+ (1- (+ (1- (IF (CADDR M) (SIXTH M) 0)) GLVAR386))) -+ (+ 3 (SEVENTH M)) GLVAR386 0)) -+ (PROGN -+ (XCLEARWINDOW *WINDOW-DISPLAY* (CADADR M)) -+ (XFLUSH *WINDOW-DISPLAY*)))) -+ -+(DEFUN MENU-DISPLAY-ITEM (SELF ITEM X Y) -+ (LET ((MW (CADR SELF))) -+ (IF (CONSP ITEM) -+ (IF (AND (SYMBOLP (CAR ITEM)) (FBOUNDP (CAR ITEM))) -+ (FUNCALL (CAR ITEM) MW X Y) -+ (IF (OR (STRINGP (CAR ITEM)) (SYMBOLP (CAR ITEM)) -+ (NUMBERP (CAR ITEM))) -+ (LET ((SSTR (STRINGIFY (CAR ITEM)))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) -+ (CADDR MW) X (- (CADDDR MW) Y) -+ (GET-C-STRING SSTR) (LENGTH SSTR))) -+ (LET ((SSTR (STRINGIFY (STRINGIFY ITEM)))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) -+ (CADDR MW) X (- (CADDDR MW) Y) -+ (GET-C-STRING SSTR) (LENGTH SSTR))))) -+ (LET ((SSTR (STRINGIFY (STRINGIFY ITEM)))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) (CADDR MW) X -+ (- (CADDDR MW) Y) (GET-C-STRING SSTR) (LENGTH SSTR)))))) -+ -+(DEFUN MENU-CHOOSE (M INSIDE) -+ (LET (MW CURRENT-ITEM YBASE ITEMH VAL MAXX MAXY XZERO YZERO) -+ (OR (AND (CADR M) (PLUSP (EIGHTH M))) (MENU-INIT M)) -+ (SETQ MW (CADR M)) -+ (MENU-DRAW M) -+ (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) -+ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) -+ (SETQ MAXX (+ XZERO (SEVENTH M))) -+ (SETQ MAXY (+ YZERO (EIGHTH M))) -+ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) -+ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) -+ (INCF MAXY -15)) -+ (WINDOW-TRACK-MOUSE MW -+ #'(LAMBDA (X Y CODE) -+ (SETQ *WINDOW-MENU-CODE* CODE) -+ (IF (AND (>= X XZERO) (<= X MAXX) (>= Y YZERO) (<= Y MAXY)) -+ (IF (OR (NULL CURRENT-ITEM) (< Y YBASE) -+ (> Y (+ YBASE ITEMH))) -+ (PROGN -+ (IF CURRENT-ITEM -+ (MENU-BOX-ITEM M CURRENT-ITEM YBASE)) -+ (SETQ CURRENT-ITEM -+ (MENU-FIND-ITEM-Y M (- Y YZERO))) -+ (WHEN CURRENT-ITEM -+ (SETQ YBASE (MENU-ITEM-Y M CURRENT-ITEM)) -+ (SETQ ITEMH -+ (MENU-FIND-ITEM-HEIGHT M CURRENT-ITEM)) -+ (MENU-BOX-ITEM M CURRENT-ITEM YBASE) -+ (SETQ INSIDE T)) -+ (WHEN (PLUSP CODE) -+ (MENU-BOX-ITEM M CURRENT-ITEM YBASE) -+ (SETQ VAL 1))) -+ (WHEN (PLUSP CODE) -+ (MENU-BOX-ITEM M CURRENT-ITEM YBASE) -+ (SETQ VAL 1))) -+ (PROGN -+ (WHEN CURRENT-ITEM -+ (MENU-BOX-ITEM M CURRENT-ITEM YBASE) -+ (SETQ CURRENT-ITEM NIL)) -+ (IF (OR (PLUSP CODE) -+ (AND INSIDE -+ (OR (< X XZERO) (> X MAXX) (< Y YZERO) -+ (> Y MAXY)))) -+ (SETQ VAL -777))))) -+ T) -+ (IF (NOT (EQL VAL -777)) -+ (IF (CONSP CURRENT-ITEM) (CDR CURRENT-ITEM) CURRENT-ITEM)))) -+ -+(DEFUN MENU-BOX-ITEM (M ITEM YBASE) -+ (LET ((MW (OR (CADR M) (MENU-INIT M)))) -+ (LET ((GC (CADDR MW))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (LOGXOR *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 -+ *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*))))) -+ (WINDOW-DRAW-BOX-XY MW (1+ (IF (CADDR M) (FIFTH M) 0)) -+ (+ 2 (+ (IF (CADDR M) (SIXTH M) 0) YBASE)) (+ -2 (NTH 11 M)) -+ (MENU-FIND-ITEM-HEIGHT M ITEM) 1) -+ (LET ((GC (CADDR MW))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)))) -+ -+(DEFUN MENU-UNBOX-ITEM (M ITEM YBASE) (MENU-BOX-ITEM M ITEM YBASE)) -+ -+(DEFUN MENU-ITEM-POSITION (M ITEMNAME &OPTIONAL PLACE) -+ (LET ((XSIZE (NTH 11 M)) YBASE ITEM YSIZE) -+ (SETQ ITEM (MENU-FIND-ITEM M ITEMNAME)) -+ (SETQ YSIZE (MENU-FIND-ITEM-HEIGHT M ITEM)) -+ (SETQ YBASE (MENU-ITEM-Y M ITEM)) -+ (LIST (+ (IF (CADDR M) (FIFTH M) 0) -+ (CASE PLACE -+ ((CENTER TOP BOTTOM) (TRUNCATE XSIZE 2)) -+ (LEFT -1) -+ (RIGHT (+ 2 XSIZE)) -+ (T 0))) -+ (+ (+ (IF (CADDR M) (SIXTH M) 0) YBASE) -+ (CASE PLACE -+ ((CENTER RIGHT LEFT) (TRUNCATE YSIZE 2)) -+ (BOTTOM 0) -+ (TOP YSIZE) -+ (T 0)))))) -+ -+(DEFUN MENU-FIND-ITEM (M ITEMNAME) -+ (LET (FOUND ITMS ITEM) -+ (SETQ ITMS (NTH 12 M)) -+ (SETQ FOUND (NULL ITEMNAME)) -+ (WHILE (AND ITMS (NOT FOUND)) (SETQ ITEM (POP ITMS)) -+ (IF (OR (EQ ITEM ITEMNAME) -+ (AND (CONSP ITEM) -+ (OR (EQ ITEMNAME (CAR ITEM)) -+ (AND (STRINGP (CAR ITEM)) -+ (STRING= (STRINGIFY ITEMNAME) -+ (CAR ITEM))) -+ (EQ (CDR ITEM) ITEMNAME) -+ (AND (CONSP (CDR ITEM)) -+ (EQ (CADR ITEM) ITEMNAME))))) -+ (SETQ FOUND T))) -+ ITEM)) -+ -+(DEFUN MENU-ITEM-Y (M ITEM) -+ (LET (FOUND ITMS ITM YBASE) -+ (SETQ YBASE (1- (EIGHTH M))) -+ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) -+ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) -+ (INCF YBASE -15)) -+ (SETQ ITMS (NTH 12 M)) -+ (WHILE (AND ITMS (NOT FOUND)) (SETQ ITM (POP ITMS)) -+ (DECF YBASE (MENU-FIND-ITEM-HEIGHT M ITM)) -+ (SETQ FOUND (EQ ITEM ITM))) -+ YBASE)) -+ -+(DEFUN MENU-FIND-ITEM-Y (M Y) -+ (LET (FOUND ITMS ITM YBASE) -+ (SETQ YBASE (1- (EIGHTH M))) -+ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) -+ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) -+ (INCF YBASE -15)) -+ (SETQ ITMS (NTH 12 M)) -+ (WHILE (AND ITMS (NOT FOUND)) (SETQ ITM (POP ITMS)) -+ (DECF YBASE (MENU-FIND-ITEM-HEIGHT M ITM)) -+ (SETQ FOUND -+ (AND (>= Y YBASE) -+ (<= Y (+ YBASE (MENU-FIND-ITEM-HEIGHT M ITM)))))) -+ (AND FOUND ITM))) -+ -+(DEFUN MENU-SELECT (M &OPTIONAL INSIDE) (MENU-SELECT-B M NIL INSIDE)) -+ -+(DEFUN MENU-SELECT! (M) (MENU-SELECT-B M T NIL)) -+ -+(DEFUN MENU-SELECT-B (M FLG INSIDE) -+ (PROG (RES) -+ LP -+ (SETQ RES (MENU-CHOOSE M INSIDE)) -+ (IF (AND FLG (NOT RES)) (GO LP)) -+ (IF (NOT (TENTH M)) -+ (IF (CADDR M) (PROGN (MENU-CLEAR M) (XFLUSH *WINDOW-DISPLAY*)) -+ (PROGN -+ (XUNMAPWINDOW *WINDOW-DISPLAY* (CADADR M)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (WINDOW-WAIT-UNMAP (CADR M))))) -+ (RETURN RES))) -+ -+(DEFUN MENU-DESTROY (M) -+ (WHEN (NOT (CADDR M)) -+ (XDESTROYWINDOW *WINDOW-DISPLAY* (CADADR M)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (SETF (CADADR M) NIL) -+ (XFREEGC *WINDOW-DISPLAY* (CADDR (CADR M))) -+ (SETF (CADDR (CADR M)) NIL) -+ (SETF (CADR M) NIL))) -+ -+(DEFUN MENU (ITEMS &OPTIONAL TITLE) -+ (LET (M RES) -+ (SETQ M (MENU-CREATE ITEMS TITLE)) -+ (SETQ RES (MENU-SELECT M)) -+ (MENU-DESTROY M) -+ RES)) -+ -+ -+ -+(DEFUN MENU-CREATE (ITEMS &OPTIONAL TITLE PARENTW X Y PERM FLAT FONT) -+ (LIST 'MENU (IF FLAT PARENTW) FLAT (CADR PARENTW) X Y 0 0 -+ (IF TITLE (STRINGIFY TITLE) "") PERM FONT 0 ITEMS)) -+ -+(DEFUN MENU-OFFSET (M) -+ (LIST (IF (CADDR M) (FIFTH M) 0) (IF (CADDR M) (SIXTH M) 0))) -+ -+(DEFUN MENU-SIZE (M) -+ (IF (<= (SEVENTH M) 0) -+ (CASE (FIRST M) -+ (PICMENU (PICMENU-CALCULATE-SIZE M)) -+ (BARMENU (BARMENU-CALCULATE-SIZE M)) -+ (TEXTMENU (TEXTMENU-CALCULATE-SIZE M)) -+ (EDITMENU (EDITMENU-CALCULATE-SIZE M)) -+ (T (MENU-CALCULATE-SIZE M)))) -+ (LIST (SEVENTH M) (EIGHTH M))) -+ -+(DEFUN MENU-MOVETO-XY (M X Y) -+ (WHEN (CADDR M) -+ (SETF (FIFTH M) X) -+ (SETF (SIXTH M) Y) -+ (MENU-ADJUST-OFFSET M))) -+ -+(DEFUN MENU-REPOSITION (M) -+ (LET (SIZEV POS) -+ (WHEN (CADDR M) -+ (SETQ SIZEV (MENU-SIZE M)) -+ (SETQ POS -+ (WINDOW-GET-BOX-POSITION (CADR M) (CAR SIZEV) (CADR SIZEV))) -+ (MENU-MOVETO-XY M (CAR POS) (CADR POS))))) -+ -+(DEFUN MENU-REPOSITION-LINE (M OFFSET TARGET) -+ (LET (SIZEV POS) -+ (WHEN (CADDR M) -+ (SETQ SIZEV (MENU-SIZE M)) -+ (SETQ POS -+ (WINDOW-GET-BOX-LINE-POSITION (CADR M) (CAR SIZEV) -+ (CADR SIZEV) (CAR OFFSET) (CADR OFFSET) (CAR TARGET) -+ (CADR TARGET))) -+ (MENU-MOVETO-XY M (CAR POS) (CADR POS))))) -+ -+ -+ -+(DEFUN PICMENU-CREATE -+ (BUTTONS WIDTH HEIGHT DRAWFN &OPTIONAL TITLE DOTFLG PARENTW X Y -+ PERM FLAT FONT BOXFLG) -+ (PICMENU-CREATE-FROM-SPEC -+ (PICMENU-CREATE-SPEC BUTTONS WIDTH HEIGHT DRAWFN DOTFLG FONT) -+ TITLE PARENTW X Y PERM FLAT BOXFLG)) -+ -+ -+ -+(DEFUN PICMENU-CREATE-SPEC -+ (BUTTONS WIDTH HEIGHT DRAWFN &OPTIONAL DOTFLG FONT) -+ (LIST 'PICMENU-SPEC WIDTH HEIGHT BUTTONS DOTFLG DRAWFN -+ (OR FONT '9X15))) -+ -+ -+ -+(DEFUN PICMENU-CREATE-FROM-SPEC -+ (SPEC &OPTIONAL TITLE PARENTW X Y PERM FLAT BOXFLG) -+ (LIST 'PICMENU (IF FLAT PARENTW) FLAT (IF PARENTW (CADR PARENTW)) X Y -+ 0 0 (IF TITLE (STRINGIFY TITLE) "") PERM SPEC BOXFLG NIL NIL)) -+ -+(DEFUN PICMENU-CALCULATE-SIZE (M) -+ (LET (MAXWIDTH MAXHEIGHT) -+ (SETQ MAXWIDTH -+ (MAX (IF (NINTH M) (+ 6 (* 9 (LENGTH (NINTH M)))) 0) -+ (CADR (NTH 10 M)))) -+ (SETQ MAXHEIGHT -+ (+ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) -+ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) -+ 15 0) -+ (CADDR (NTH 10 M)))) -+ (SETF (SEVENTH M) MAXWIDTH) -+ (SETF (EIGHTH M) MAXHEIGHT))) -+ -+(DEFUN PICMENU-INIT (M) -+ (PICMENU-CALCULATE-SIZE M) -+ (MENU-ADJUST-OFFSET M) -+ (IF (NOT (CADDR M)) -+ (SETF (CADR M) -+ (WINDOW-CREATE (SEVENTH M) (EIGHTH M) (OR (NINTH M) "") -+ (CADDDR M) (FIFTH M) (SIXTH M) (SEVENTH (NTH 10 M)))))) -+ -+(DEFUN PICMENU-DRAW (M) -+ (LET (MW BOTTOM XZERO YZERO) -+ (OR (AND (CADR M) (PLUSP (EIGHTH M))) (PICMENU-INIT M)) -+ (SETQ MW (CADR M)) -+ (XMAPWINDOW *WINDOW-DISPLAY* (CADR MW)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (WINDOW-WAIT-EXPOSURE MW) -+ (MENU-CLEAR M) -+ (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) -+ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) -+ (SETQ BOTTOM (+ YZERO (EIGHTH M))) -+ (WHEN (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) -+ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) -+ (LET ((SSTR (STRINGIFY (STRINGIFY (NINTH M))))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) (CADDR MW) -+ (+ 3 XZERO) (+ 13 (- (CADDDR MW) BOTTOM)) -+ (GET-C-STRING SSTR) (LENGTH SSTR))) -+ (LET ((GC (CADDR MW))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 -+ *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 -+ *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (LOGXOR *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 -+ *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*))))) -+ (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR MW) (CADDR MW) XZERO -+ (- (CADDDR MW) BOTTOM) (SEVENTH M) 16) -+ (LET ((GC (CADDR MW))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) -+ (FUNCALL (SIXTH (NTH 10 M)) MW XZERO YZERO) -+ (IF (NTH 11 M) -+ (WINDOW-DRAW-BOX-XY MW XZERO YZERO (SEVENTH M) (EIGHTH M) 1)) -+ (IF (FIFTH (NTH 10 M)) -+ (DOLIST (B (CADDDR (NTH 10 M))) (PICMENU-DRAW-BUTTON M B))) -+ (SETF (NTH 12 M) NIL) -+ (XFLUSH *WINDOW-DISPLAY*))) -+ -+(DEFUN PICMENU-DRAW-NAMED-BUTTON (M NM) -+ (PICMENU-DRAW-BUTTON M (ASSOC NM (CADDDR (NTH 10 M))))) -+ -+(DEFUN PICMENU-SET-NAMED-BUTTON-COLOR (M NM COLOR) -+ (LET (LST) -+ (IF (SETQ LST (ASSOC NM (NTH 13 M))) (SETF (CADR LST) COLOR) -+ (PUSH (LIST NM COLOR) (NTH 13 M))))) -+ -+(DEFUN PICMENU-DRAW-BUTTON (M B) -+ (LET ((MW (CADR M)) COL) -+ (LET ((GC (CADDR MW))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (LOGXOR *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 -+ *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*))))) -+ (WINDOW-DRAW-BOX-XY MW -+ (+ -2 (+ (IF (CADDR M) (FIFTH M) 0) (CAADR B))) -+ (+ -2 (+ (IF (CADDR M) (SIXTH M) 0) (CADADR B))) 4 4 1) -+ (LET ((GC (CADDR MW))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)) -+ (WHEN (SETQ COL (ASSOC (CAR B) (NTH 13 M))) -+ (WINDOW-SET-COLOR-RGB MW (CAADR COL) (CADADR COL) -+ (CADDR (CADR COL))) -+ (WINDOW-DRAW-BOX-XY MW -+ (1- (+ (IF (CADDR M) (FIFTH M) 0) (CAADR B))) -+ (1- (+ (IF (CADDR M) (SIXTH M) 0) (CADADR B))) 3 3 2) -+ (WINDOW-RESET-COLOR MW)))) -+ -+(DEFUN PICMENU-DELETE-NAMED-BUTTON (M NAME) -+ (LET (B) -+ (WHEN (AND (SETQ B (ASSOC NAME (CADDDR (NTH 10 M)))) -+ (NOT (MEMBER NAME (NTH 12 M) :TEST #'EQUAL))) -+ (IF (FIFTH (NTH 10 M)) (PICMENU-DRAW-BUTTON M B)) -+ (PUSH NAME (NTH 12 M))) -+ (XFLUSH *WINDOW-DISPLAY*))) -+ -+(DEFUN PICMENU-SELECT (M &OPTIONAL INSIDE ANYCLICK) -+ (LET (MW CURRENT-BUTTON ITEM ITEMS VAL XZERO YZERO CODEVAL) -+ (SETQ MW (OR (CADR M) (PICMENU-INIT M))) -+ (IF (NOT (TENTH M)) (PICMENU-DRAW M)) -+ (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) -+ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) -+ (WINDOW-TRACK-MOUSE MW -+ #'(LAMBDA (X Y CODE) -+ (SETQ *WINDOW-MENU-CODE* CODE) -+ (DECF X XZERO) -+ (DECF Y YZERO) -+ (IF (AND (>= X 0) (<= X (SEVENTH M)) (>= Y 0) -+ (<= Y (EIGHTH M))) -+ (SETQ INSIDE T)) -+ (IF CURRENT-BUTTON -+ (WHEN (NOT (PICMENU-BUTTON-CONTAINSXY? CURRENT-BUTTON X -+ Y)) -+ (PICMENU-UNBOX-ITEM M CURRENT-BUTTON) -+ (SETQ CURRENT-BUTTON NIL))) -+ (WHEN (NOT CURRENT-BUTTON) -+ (SETQ ITEMS (CADDDR (NTH 10 M))) -+ (WHILE (AND (NOT CURRENT-BUTTON) (SETQ ITEM (POP ITEMS))) -+ (WHEN (AND (PICMENU-BUTTON-CONTAINSXY? ITEM X Y) -+ (NOT (MEMBER (CAR ITEM) (NTH 12 M) -+ :TEST #'EQUAL))) -+ (PICMENU-BOX-ITEM M ITEM) -+ (SETQ CURRENT-BUTTON ITEM)))) -+ (WHEN (OR (PLUSP CODE) -+ (AND INSIDE -+ (OR (MINUSP X) (> X (SEVENTH M)) (MINUSP Y) -+ (> Y (EIGHTH M))))) -+ (IF CURRENT-BUTTON (PICMENU-UNBOX-ITEM M CURRENT-BUTTON)) -+ (SETQ CODEVAL CODE) -+ (SETQ VAL -+ (IF (AND (PLUSP CODE) CURRENT-BUTTON) -+ CURRENT-BUTTON *PICMENU-NO-SELECTION*)))) -+ T) -+ (IF (NOT (TENTH M)) -+ (IF (CADDR M) (PROGN (MENU-CLEAR M) (XFLUSH *WINDOW-DISPLAY*)) -+ (PROGN -+ (XUNMAPWINDOW *WINDOW-DISPLAY* (CADADR M)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (WINDOW-WAIT-UNMAP (CADR M))))) -+ (IF (EQUAL VAL *PICMENU-NO-SELECTION*) -+ (AND (PLUSP CODEVAL) ANYCLICK) (CAR VAL)))) -+ -+(DEFUN PICMENU-BOX-ITEM (M ITEM) -+ (LET ((MW (OR (CADR M) (PICMENU-INIT M))) XOFF YOFF SIZ) -+ (SETQ XOFF (+ (IF (CADDR M) (FIFTH M) 0) (CAADR ITEM))) -+ (SETQ YOFF (+ (IF (CADDR M) (SIXTH M) 0) (CADADR ITEM))) -+ (IF (CADDDR ITEM) -+ (FUNCALL (CADDDR ITEM) (OR (CADR M) (PICMENU-INIT M)) XOFF -+ YOFF) -+ (PROGN -+ (LET ((GC (CADDR MW))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 -+ *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 -+ *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (LOGXOR *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 -+ *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*))))) -+ (IF (SETQ SIZ (CADDR ITEM)) -+ (WINDOW-DRAW-BOX-XY MW (- XOFF (TRUNCATE (CAR SIZ) 2)) -+ (- YOFF (TRUNCATE (CADR SIZ) 2)) (CAR SIZ) (CADR SIZ) -+ 1) -+ (WINDOW-DRAW-BOX-XY MW (+ -6 XOFF) (+ -6 YOFF) 12 12 1)) -+ (LET ((GC (CADDR MW))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ *WINDOW-SAVE-FOREGROUND*)) -+ (XFLUSH *WINDOW-DISPLAY*))))) -+ -+(DEFUN PICMENU-UNBOX-ITEM (M ITEM) -+ (IF (FIFTH ITEM) -+ (PROGN -+ (FUNCALL (FIFTH ITEM) (OR (CADR M) (PICMENU-INIT M)) -+ (CAADR ITEM) (CADADR ITEM)) -+ (XFLUSH *WINDOW-DISPLAY*)) -+ (PICMENU-BOX-ITEM M ITEM))) -+ -+(DEFUN PICMENU-DESTROY (M) (MENU-DESTROY M)) -+ -+(DEFUN PICMENU-BUTTON-CONTAINSXY? (B X Y) -+ (LET ((XSIZE 6) (YSIZE 6)) -+ (WHEN (CADDR B) -+ (SETQ XSIZE (TRUNCATE (CAADDR B) 2)) -+ (SETQ YSIZE (TRUNCATE (CADR (CADDR B)) 2))) -+ (AND (>= X (- (CAADR B) XSIZE)) (<= X (+ (CAADR B) XSIZE)) -+ (>= Y (- (CADADR B) YSIZE)) (<= Y (+ (CADADR B) YSIZE))))) -+ -+(DEFUN PICMENU-ITEM-POSITION (M ITEMNAME &OPTIONAL PLACE) -+ (LET (B (XSIZE 0) (YSIZE 0) XOFF YOFF) -+ (IF (NULL ITEMNAME) -+ (PROGN -+ (SETQ XSIZE (SEVENTH M)) -+ (SETQ YSIZE (TRUNCATE (- (EIGHTH M) (CADDR (NTH 10 M))) 2)) -+ (SETQ XOFF (TRUNCATE XSIZE 2)) -+ (SETQ YOFF (+ (CADDR (NTH 10 M)) (TRUNCATE YSIZE 2)))) -+ (WHEN (SETQ B (ASSOC ITEMNAME (CADDDR (NTH 10 M)))) -+ (WHEN (CADDR B) -+ (SETQ XSIZE (CAADDR B)) -+ (SETQ YSIZE (CADR (CADDR B)))) -+ (SETQ XOFF (CAADR B)) -+ (SETQ YOFF (CADADR B)))) -+ (IF XOFF -+ (LIST (+ (+ (IF (CADDR M) (FIFTH M) 0) XOFF) -+ (CASE PLACE -+ ((CENTER TOP BOTTOM) 0) -+ (LEFT (- (TRUNCATE XSIZE 2))) -+ (RIGHT (TRUNCATE XSIZE 2)) -+ (T 0))) -+ (+ (+ (IF (CADDR M) (SIXTH M) 0) YOFF) -+ (CASE PLACE -+ ((CENTER RIGHT LEFT) 0) -+ (BOTTOM (- (TRUNCATE YSIZE 2))) -+ (TOP (TRUNCATE YSIZE 2)) -+ (T 0))))))) -+ -+ -+ -+(DEFUN BARMENU-CREATE -+ (MAXVAL INITVAL BARWIDTH &OPTIONAL TITLE HORIZONTAL SUBTRACKFN -+ SUBTRACKPARMS PARENTW X Y PERM FLAT COLOR) -+ (LIST 'BARMENU (IF FLAT PARENTW) FLAT (IF PARENTW (CADR PARENTW)) -+ (OR X 0) (OR Y 0) 0 0 (IF TITLE (STRINGIFY TITLE) "") PERM -+ COLOR INITVAL MAXVAL BARWIDTH HORIZONTAL SUBTRACKFN -+ SUBTRACKPARMS)) -+ -+(DEFUN BARMENU-CALCULATE-SIZE (M) -+ (LET (MAXWIDTH MAXHEIGHT) -+ (SETQ MAXWIDTH -+ (MAX (IF (NINTH M) (+ 6 (* 9 (LENGTH (NINTH M)))) 0) -+ (NTH 13 M))) -+ (SETQ MAXHEIGHT -+ (+ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) -+ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) -+ 15 0) -+ (NTH 12 M))) -+ (SETF (SEVENTH M) MAXWIDTH) -+ (SETF (EIGHTH M) MAXHEIGHT))) -+ -+(DEFUN BARMENU-INIT (M) -+ (BARMENU-CALCULATE-SIZE M) -+ (MENU-ADJUST-OFFSET M) -+ (IF (NOT (CADDR M)) -+ (SETF (CADR M) -+ (WINDOW-CREATE (SEVENTH M) (EIGHTH M) (OR (NINTH M) "") -+ (CADDDR M) (FIFTH M) (SIXTH M))))) -+ -+(DEFUN BARMENU-DRAW (M) -+ (LET (MW XZERO YZERO) -+ (OR (AND (CADR M) (PLUSP (EIGHTH M))) (BARMENU-INIT M)) -+ (SETQ MW (CADR M)) -+ (XMAPWINDOW *WINDOW-DISPLAY* (CADR MW)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (WINDOW-WAIT-EXPOSURE MW) -+ (MENU-CLEAR M) -+ (SETQ XZERO -+ (+ (IF (CADDR M) (FIFTH M) 0) (TRUNCATE (SEVENTH M) 2))) -+ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) -+ (IF (NTH 10 M) (WINDOW-SET-COLOR MW (NTH 10 M))) -+ (IF (NTH 14 M) -+ (LET ((QQWHEIGHT (CADDDR (CADR M)))) -+ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) -+ (OR (NTH 13 M) 1) 0 1 0)) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADADR M) (CADDR (CADR M)) XZERO -+ (- QQWHEIGHT YZERO) (+ XZERO (NTH 11 M)) -+ (- QQWHEIGHT YZERO)) -+ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) 1 0 -+ 1 0))) -+ (LET ((QQWHEIGHT (CADDDR (CADR M)))) -+ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) -+ (OR (NTH 13 M) 1) 0 1 0)) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADADR M) (CADDR (CADR M)) XZERO -+ (- QQWHEIGHT YZERO) XZERO -+ (- QQWHEIGHT (+ YZERO (NTH 11 M)))) -+ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) 1 0 -+ 1 0)))) -+ (IF (NTH 10 M) (WINDOW-RESET-COLOR MW)) -+ (XFLUSH *WINDOW-DISPLAY*))) -+ -+(DEFUN BARMENU-SELECT (M &OPTIONAL INSIDE) -+ (declare (ignore inside)) -+ (LET (MW XZERO YZERO VAL) -+ (SETQ MW (OR (CADR M) (BARMENU-INIT M))) -+ (IF (NOT (TENTH M)) (BARMENU-DRAW M)) -+ (SETQ XZERO -+ (+ (IF (CADDR M) (FIFTH M) 0) (TRUNCATE (SEVENTH M) 2))) -+ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) -+ (WHEN (WINDOW-TRACK-MOUSE-IN-REGION MW (IF (CADDR M) (FIFTH M) 0) -+ YZERO (SEVENTH M) (EIGHTH M) T T) -+ (WINDOW-TRACK-MOUSE MW -+ #'(LAMBDA (X Y CODE) -+ (SETQ *WINDOW-MENU-CODE* CODE) -+ (SETQ VAL (IF (NTH 14 M) (- X XZERO) (- Y YZERO))) -+ (BARMENU-UPDATE-VALUE M VAL) -+ (IF (PLUSP CODE) CODE))) -+ VAL))) -+ -+(DEFVAR *BARMENU-UPDATE-VALUE-CONS* (CONS NIL NIL)) -+ -+(DEFUN BARMENU-UPDATE-VALUE (M VAL) -+ (LET ((MW (OR (CADR M) (BARMENU-INIT M))) XZERO YZERO) -+ (SETQ VAL (MAX 0 (MIN VAL (NTH 12 M)))) -+ (WHEN (/= VAL (NTH 11 M)) -+ (IF (< VAL (NTH 11 M)) -+ (LET ((GC (CADDR MW))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 -+ *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 3) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 -+ *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 -+ *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*)))) -+ (IF (NTH 10 M) (WINDOW-SET-COLOR MW (NTH 10 M)))) -+ (SETQ XZERO -+ (+ (IF (CADDR M) (FIFTH M) 0) (TRUNCATE (SEVENTH M) 2))) -+ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) -+ (IF (NTH 14 M) -+ (LET ((QQWHEIGHT (CADDDR (CADR M)))) -+ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) -+ (OR (NTH 13 M) 1) 0 1 0)) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADADR M) (CADDR (CADR M)) -+ (+ XZERO (NTH 11 M)) (- QQWHEIGHT YZERO) (+ XZERO VAL) -+ (- QQWHEIGHT YZERO)) -+ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) 1 -+ 0 1 0))) -+ (LET ((QQWHEIGHT (CADDDR (CADR M)))) -+ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) -+ (OR (NTH 13 M) 1) 0 1 0)) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADADR M) (CADDR (CADR M)) -+ XZERO (- QQWHEIGHT (+ YZERO (NTH 11 M))) XZERO -+ (- QQWHEIGHT (+ YZERO VAL))) -+ (IF (AND (NTH 13 M) (/= (NTH 13 M) 1)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR (CADR M)) 1 -+ 0 1 0)))) -+ (IF (< VAL (NTH 11 M)) -+ (LET ((GC (CADDR MW))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ *WINDOW-SAVE-FOREGROUND*)) -+ (IF (NTH 10 M) (WINDOW-RESET-COLOR MW))) -+ (SETF (NTH 11 M) VAL) -+ (WHEN (NTH 15 M) -+ (SETF (CAR *BARMENU-UPDATE-VALUE-CONS*) VAL) -+ (SETF (CDR *BARMENU-UPDATE-VALUE-CONS*) (NTH 16 M)) -+ (APPLY (NTH 15 M) *BARMENU-UPDATE-VALUE-CONS*)) -+ (XFLUSH *WINDOW-DISPLAY*)))) -+ -+ -+ -+(DEFUN TEXTMENU-CREATE -+ (WIDTH HEIGHT &OPTIONAL TITLE PARENTW X Y PERM FLAT FONT BOXFLG -+ INITIAL-TEXT) -+ (LIST 'TEXTMENU (IF FLAT PARENTW) FLAT (IF PARENTW (CADR PARENTW)) -+ (OR X 0) (OR Y 0) 0 0 (IF TITLE (STRINGIFY TITLE) "") PERM -+ INITIAL-TEXT WIDTH HEIGHT BOXFLG (OR FONT '9X15))) -+ -+(DEFUN TEXTMENU-CALCULATE-SIZE (M) -+ (LET (MAXWIDTH MAXHEIGHT) -+ (SETQ MAXWIDTH -+ (MAX (IF (NINTH M) (+ 6 (* 9 (LENGTH (NINTH M)))) 0) -+ (NTH 11 M))) -+ (SETQ MAXHEIGHT -+ (+ (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) -+ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) -+ 15 0) -+ (NTH 12 M))) -+ (SETF (SEVENTH M) MAXWIDTH) -+ (SETF (EIGHTH M) MAXHEIGHT))) -+ -+(DEFUN TEXTMENU-INIT (M) -+ (TEXTMENU-CALCULATE-SIZE M) -+ (MENU-ADJUST-OFFSET M) -+ (IF (NOT (CADDR M)) -+ (SETF (CADR M) -+ (WINDOW-CREATE (SEVENTH M) (EIGHTH M) (OR (NINTH M) "") -+ (CADDDR M) (FIFTH M) (SIXTH M) (NTH 14 M))))) -+ -+(DEFUN TEXTMENU-DRAW (M) -+ (LET (MW BOTTOM XZERO YZERO) -+ (OR (AND (CADR M) (PLUSP (EIGHTH M))) (TEXTMENU-INIT M)) -+ (SETQ MW (CADR M)) -+ (XMAPWINDOW *WINDOW-DISPLAY* (CADR MW)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (WINDOW-WAIT-EXPOSURE MW) -+ (MENU-CLEAR M) -+ (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) -+ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) -+ (SETQ BOTTOM (+ YZERO (EIGHTH M))) -+ (WHEN (AND (NINTH M) (PLUSP (LENGTH (NINTH M))) -+ (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*)) -+ (LET ((SSTR (STRINGIFY (STRINGIFY (NINTH M))))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) (CADDR MW) -+ (+ 3 XZERO) (+ 13 (- (CADDDR MW) BOTTOM)) -+ (GET-C-STRING SSTR) (LENGTH SSTR))) -+ (LET ((GC (CADDR MW))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 1 -+ *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 4 -+ *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (LOGXOR *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR MW) 8 -+ *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*))))) -+ (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR MW) (CADDR MW) XZERO -+ (- (CADDDR MW) BOTTOM) (SEVENTH M) 16) -+ (LET ((GC (CADDR MW))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) -+ (IF (NTH 10 M) -+ (LET ((SSTR (STRINGIFY (NTH 10 M)))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR MW) (CADDR MW) -+ (+ 10 XZERO) -+ (+ 8 (- (CADDDR MW) (+ YZERO (TRUNCATE (EIGHTH M) 2)))) -+ (GET-C-STRING SSTR) (LENGTH SSTR)))) -+ (IF (NTH 13 M) -+ (WINDOW-DRAW-BOX-XY MW XZERO YZERO (SEVENTH M) (EIGHTH M) 1)) -+ (XFLUSH *WINDOW-DISPLAY*))) -+ -+(DEFUN TEXTMENU-SELECT (M &OPTIONAL INSIDE) -+ (declare (ignore inside)) -+ (LET (MW XZERO YZERO CODEVAL) -+ (SETQ MW (OR (CADR M) (TEXTMENU-INIT M))) -+ (IF (NOT (TENTH M)) (TEXTMENU-DRAW M)) -+ (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) -+ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) -+ (WINDOW-TRACK-MOUSE MW -+ #'(LAMBDA (X Y CODE) -+ (SETQ *WINDOW-MENU-CODE* CODE) -+ (DECF X XZERO) -+ (DECF Y YZERO) -+ (IF (OR (PLUSP CODE) (MINUSP X) (> X (SEVENTH M)) -+ (MINUSP Y) (> Y (EIGHTH M))) -+ (SETQ CODEVAL CODE))) -+ T) -+ (WHEN (AND (NOT (TENTH M)) (NOT (CADDR M))) -+ (XUNMAPWINDOW *WINDOW-DISPLAY* (CADADR M)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (WINDOW-WAIT-UNMAP (CADR M))) -+ (WHEN (PLUSP CODEVAL) -+ (TEXTMENU-DRAW M) -+ (WINDOW-INPUT-STRING MW (NTH 10 M) (+ 10 XZERO) -+ (+ -8 (+ YZERO (TRUNCATE (EIGHTH M) 2))) (+ -12 (SEVENTH M)))))) -+ -+(DEFUN TEXTMENU-SET-TEXT (M &OPTIONAL S) (SETF (NTH 10 M) (OR S ""))) -+ -+ -+ -+(DEFUN WINDOW-GET-POINT (W) -+ (LET (ORGX ORGY) -+ (WINDOW-TRACK-MOUSE W -+ #'(LAMBDA (X Y CODE) -+ (WHEN (NOT (ZEROP CODE)) (SETQ ORGX X) (SETQ ORGY Y)))) -+ (LIST ORGX ORGY))) -+ -+ -+ -+(DEFUN WINDOW-GET-CLICK (W) -+ (LET (ORGX ORGY BUTTON) -+ (WINDOW-TRACK-MOUSE W -+ #'(LAMBDA (X Y CODE) -+ (WHEN (NOT (ZEROP CODE)) -+ (SETQ BUTTON CODE) -+ (SETQ ORGX X) -+ (SETQ ORGY Y)))) -+ (LIST BUTTON (LIST ORGX ORGY)))) -+ -+ -+ -+(DEFUN WINDOW-GET-LINE-POSITION (W ORGX ORGY) -+ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-LINE-XY -+ (LIST ORGX ORGY 1 'PAINT))) -+ -+ -+ -+(DEFUN WINDOW-GET-LATEX-POSITION (W ORGX ORGY &OPTIONAL FLG) -+ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-LATEX-XY -+ (LIST ORGX ORGY FLG))) -+ -+ -+ -+(DEFUN WINDOW-GET-BOX-POSITION (W WIDTH HEIGHT &OPTIONAL (DX 0) (DY 0)) -+ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-BOX-XY -+ (LIST WIDTH HEIGHT 1) DX DY)) -+ -+ -+ -+(DEFUN WINDOW-GET-BOX-LINE-POSITION -+ (W WIDTH HEIGHT OFFX OFFY TOX TOY &OPTIONAL (DX 0) (DY 0)) -+ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-BOX-LINE-XY -+ (LIST WIDTH HEIGHT OFFX OFFY TOX TOY) DX DY)) -+ -+(DEFUN WINDOW-DRAW-BOX-LINE-XY (W X Y WIDTH HEIGHT OFFX OFFY TOX TOY) -+ (WINDOW-DRAW-BOX-XY W X Y WIDTH HEIGHT) -+ (WINDOW-DRAW-LINE-XY W (+ X OFFX) (+ Y OFFY) TOX TOY)) -+ -+ -+ -+(DEFUN WINDOW-GET-ICON-POSITION (W FN ARGS &OPTIONAL (DX 0) (DY 0)) -+ (LET (LASTX LASTY ARGL) -+ (SETQ ARGL (CONS W (CONS 0 (CONS 0 ARGS)))) -+ (WINDOW-SET-XOR W) -+ (WINDOW-TRACK-MOUSE W -+ #'(LAMBDA (X Y CODE) -+ (WHEN (OR (NULL LASTX) (/= X LASTX) (/= Y LASTY)) -+ (IF LASTX (APPLY FN ARGL)) -+ (RPLACA (CDR ARGL) (+ X DX)) -+ (RPLACA (CDDR ARGL) (+ Y DY)) -+ (APPLY FN ARGL) -+ (SETQ LASTX X) -+ (SETQ LASTY Y)) -+ (NOT (ZEROP CODE)))) -+ (APPLY FN ARGL) -+ (WINDOW-UNSET W) -+ (WINDOW-FORCE-OUTPUT W) -+ (LIST LASTX LASTY))) -+ -+ -+ -+(DEFUN WINDOW-GET-REGION (W &OPTIONAL WID HT) -+ (LET (LASTX LASTY START END WIDTH HEIGHT PLACE OFFX OFFY STX STY) -+ (IF (AND (NUMBERP WID) (NUMBERP HT)) -+ (PROGN -+ (SETQ START -+ (WINDOW-GET-BOX-POSITION W WID HT (- WID) (- HT))) -+ (SETQ STX (- (CAR START) WID)) -+ (SETQ STY (- (CADR START) HT))) -+ (PROGN -+ (SETQ START (WINDOW-GET-POINT W)) -+ (SETQ STX (CAR START)) -+ (SETQ STY (CADR START)))) -+ (SETQ END -+ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-BOX-CORNERS -+ (LIST STX STY 1))) -+ (SETQ LASTX (CAR END)) -+ (SETQ LASTY (CADR END)) -+ (SETQ WIDTH (ABS (- STX LASTX))) -+ (SETQ HEIGHT (ABS (- STY LASTY))) -+ (SETQ OFFX (- (MIN STX LASTX) LASTX)) -+ (SETQ OFFY (- (MIN STY LASTY) LASTY)) -+ (SETQ PLACE (WINDOW-GET-BOX-POSITION W WIDTH HEIGHT OFFX OFFY)) -+ (LIST (LIST (+ OFFX (FIRST PLACE)) (+ OFFY (SECOND PLACE))) -+ (LIST WIDTH HEIGHT)))) -+ -+ -+ -+(DEFUN WINDOW-GET-BOX-SIZE (W OFFSETX OFFSETY) -+ (LET (LEGENDY LASTX LASTY DX DY) -+ (SETQ OFFSETY (MAX OFFSETY 30)) -+ (SETQ LEGENDY (- OFFSETY 25)) -+ (WINDOW-ERASE-AREA-XY W OFFSETX LEGENDY 71 21) -+ (WINDOW-DRAW-BOX-XY W OFFSETX LEGENDY 70 20) -+ (WINDOW-TRACK-MOUSE W -+ #'(LAMBDA (X Y CODE) -+ (WHEN (OR (NULL LASTX) (/= X LASTX) (/= Y LASTY)) -+ (IF LASTX -+ (WINDOW-XOR-BOX-XY W OFFSETX OFFSETY -+ (- LASTX OFFSETX) (- LASTY OFFSETY))) -+ (SETQ LASTX NIL) -+ (SETQ DX (- X OFFSETX)) -+ (SETQ DY (- Y OFFSETY)) -+ (WHEN (AND (> DX 0) (> DY 0)) -+ (WINDOW-XOR-BOX-XY W OFFSETX OFFSETY DX DY) -+ (WINDOW-PRINTAT-XY W (FORMAT NIL "~3D x ~3D" DX DY) -+ (+ OFFSETX 3) (+ LEGENDY 5)) -+ (SETQ LASTX X) -+ (SETQ LASTY Y))) -+ (NOT (ZEROP CODE)))) -+ (IF LASTX -+ (WINDOW-XOR-BOX-XY W OFFSETX OFFSETY (- LASTX OFFSETX) -+ (- LASTY OFFSETY))) -+ (WINDOW-ERASE-AREA-XY W OFFSETX LEGENDY 71 21) -+ (WINDOW-FORCE-OUTPUT W) -+ (LIST DX DY))) -+ -+ -+ -+(DEFUN WINDOW-TRACK-MOUSE-IN-REGION -+ (W OFFSETX OFFSETY SIZEX SIZEY &OPTIONAL BOXFLG INSIDE) -+ (LET (RES) -+ (WHEN BOXFLG -+ (WINDOW-SET-XOR W) -+ (WINDOW-DRAW-BOX-XY W (- OFFSETX 4) (- OFFSETY 4) (+ SIZEX 8) -+ (+ SIZEY 8)) -+ (WINDOW-UNSET W) -+ (WINDOW-FORCE-OUTPUT W)) -+ (SETQ RES -+ (WINDOW-TRACK-MOUSE W -+ #'(LAMBDA (X Y CODE) -+ (IF (> CODE 0) (IF INSIDE (LIST CODE (LIST X Y)) T) -+ (IF (OR (< X OFFSETX) (> X (+ OFFSETX SIZEX)) -+ (< Y OFFSETY) (> Y (+ OFFSETY SIZEY))) -+ INSIDE (AND (SETQ INSIDE T) NIL)))))) -+ (WHEN BOXFLG -+ (WINDOW-SET-XOR W) -+ (WINDOW-DRAW-BOX-XY W (- OFFSETX 4) (- OFFSETY 4) (+ SIZEX 8) -+ (+ SIZEY 8)) -+ (WINDOW-UNSET W) -+ (WINDOW-FORCE-OUTPUT W)) -+ (IF (CONSP RES) RES))) -+ -+ -+ -+(DEFUN WINDOW-ADJUST-BOX-SIDE (W ORGX ORGY WIDTH HEIGHT SIDE) -+ (LET (NEW (XX ORGX) (YY ORGY) (WW WIDTH) (HH HEIGHT)) -+ (SETQ NEW -+ (WINDOW-GET-ICON-POSITION W #'WINDOW-ADJ-BOX-XY -+ (LIST ORGX ORGY WIDTH HEIGHT SIDE))) -+ (CASE SIDE -+ (LEFT (SETQ XX (CAR NEW)) (SETQ WW (+ WIDTH (- ORGX (CAR NEW))))) -+ (RIGHT (SETQ WW (- (CAR NEW) ORGX))) -+ (TOP (SETQ HH (- (CADR NEW) ORGY))) -+ (BOTTOM (SETQ YY (CADR NEW)) -+ (SETQ HH (+ HEIGHT (- ORGY (CADR NEW)))))) -+ (LIST (LIST XX YY) (LIST WW HH)))) -+ -+(DEFUN WINDOW-ADJ-BOX-XY (W X Y ORGX ORGY WIDTH HEIGHT SIDE) -+ (LET ((XX ORGX) (YY ORGY) (WW WIDTH) (HH HEIGHT)) -+ (CASE SIDE -+ (LEFT (SETQ XX X) (SETQ WW (+ WIDTH (- ORGX X)))) -+ (RIGHT (SETQ WW (- X ORGX))) -+ (TOP (SETQ HH (- Y ORGY))) -+ (BOTTOM (SETQ YY Y) (SETQ HH (+ HEIGHT (- ORGY Y))))) -+ (WINDOW-DRAW-BOX-XY W XX YY WW HH))) -+ -+ -+ -+(DEFUN WINDOW-GET-CIRCLE (W &OPTIONAL CENTER) -+ (LET (PT) -+ (OR CENTER (SETQ CENTER (WINDOW-GET-CROSSHAIRS W))) -+ (SETQ PT -+ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-CIRCLE-PT -+ (LIST CENTER))) -+ (LIST CENTER (WINDOW-CIRCLE-RADIUS (CAR PT) (CADR PT) CENTER)))) -+ -+(DEFUN WINDOW-CIRCLE-RADIUS (X Y CENTER) -+ (LET ((DX (- X (CAR CENTER))) (DY (- Y (CADR CENTER)))) -+ (TRUNCATE (+ 0.5 (SQRT (+ (* DX DX) (* DY DY))))))) -+ -+(DEFUN WINDOW-DRAW-CIRCLE-PT (W X Y CENTER) -+ (WINDOW-DRAW-CIRCLE W CENTER (WINDOW-CIRCLE-RADIUS X Y CENTER) 1)) -+ -+ -+ -+(DEFUN WINDOW-GET-ELLIPSE (W &OPTIONAL CENTER) -+ (LET (CIR RADIUSX PT) -+ (SETQ CIR (WINDOW-GET-CIRCLE W CENTER)) -+ (SETQ CENTER (CAR CIR)) -+ (SETQ RADIUSX (CADR CIR)) -+ (SETQ PT -+ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-ELLIPSE-PT -+ (LIST CENTER RADIUSX))) -+ (LIST CENTER (LIST RADIUSX (ABS (- (CADR PT) (CADR CENTER))))))) -+ -+(DEFUN WINDOW-DRAW-ELLIPSE-PT (W X Y CENTER RADIUSX) -+ (declare (ignore x)) -+ (WINDOW-DRAW-ELLIPSE-XY W (CAR CENTER) (CADR CENTER) RADIUSX -+ (ABS (- Y (CADR CENTER))))) -+ -+(DEFUN WINDOW-DRAW-VECTOR-PT (W X Y CENTER RADIUS) -+ (LET (DX DY THETA) -+ (SETQ DY (- Y (CADR CENTER))) -+ (SETQ DX (- X (CAR CENTER))) -+ (WHEN (OR (/= DX 0) (/= DY 0)) -+ (SETQ THETA (ATAN (- Y (CADR CENTER)) (- X (CAR CENTER)))) -+ (WINDOW-DRAW-LINE-XY W (CAR CENTER) (CADR CENTER) -+ (+ (CAR CENTER) (* RADIUS (COS THETA))) -+ (+ (CADR CENTER) (* RADIUS (SIN THETA))))))) -+ -+ -+ -+(DEFUN WINDOW-GET-VECTOR-END (W CENTER RADIUS) -+ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-VECTOR-PT -+ (LIST CENTER RADIUS))) -+ -+ -+ -+(DEFUN WINDOW-GET-CROSSHAIRS (W) -+ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-CROSSHAIRS-XY NIL)) -+ -+(DEFUN WINDOW-DRAW-CROSSHAIRS-XY (W X Y) -+ (WINDOW-DRAW-LINE-XY W (- X 12) Y (- X 3) Y) -+ (WINDOW-DRAW-LINE-XY W (+ X 3) Y (+ X 12) Y) -+ (WINDOW-DRAW-LINE-XY W X (- Y 12) X (- Y 3)) -+ (WINDOW-DRAW-LINE-XY W X (+ Y 3) X (+ Y 12))) -+ -+ -+ -+(DEFUN WINDOW-GET-CROSS (W) -+ (WINDOW-GET-ICON-POSITION W #'WINDOW-DRAW-CROSS-XY NIL)) -+ -+(DEFUN WINDOW-DRAW-CROSS-XY (W X Y) -+ (WINDOW-DRAW-LINE-XY W (- X 10) (- Y 10) (+ X 10) (+ Y 10) 2) -+ (WINDOW-DRAW-LINE-XY W (+ X 10) (- Y 10) (- X 10) (+ Y 10) 2)) -+ -+(DEFUN WINDOW-DRAW-DOT-XY (W X Y) -+ (WINDOW-DRAW-CIRCLE-XY W X Y 1) -+ (WINDOW-DRAW-CIRCLE-XY W X Y 2) -+ (WINDOW-DRAW-LINE-XY W X Y (+ X 1) Y 1)) -+ -+(DEFUN WINDOW-DRAW-LATEX-XY (W X Y ORGX ORGY FLG) -+ (LET (DX DY DELX DELY N RATIO CD NRAT) -+ (SETQ DX (- X ORGX)) -+ (SETQ DY (- Y ORGY)) -+ (IF (OR (= DX 0) (= DY 0)) (WINDOW-DRAW-LINE-XY W X Y ORGX ORGY) -+ (PROGN -+ (SETQ N (IF FLG 4 6)) -+ (IF (> (ABS DY) (ABS DX)) -+ (PROGN -+ (SETQ RATIO (ROUND (/ (* (ABS DX) N) (ABS DY)))) -+ (SETQ CD (GCD N RATIO)) -+ (SETQ N (/ N CD)) -+ (SETQ RATIO (/ RATIO CD)) -+ (SETQ NRAT (ROUND (/ (ABS DY) N))) -+ (SETQ DELY (* (SIGNUM DY) NRAT N)) -+ (SETQ DELX (* (SIGNUM DX) NRAT RATIO))) -+ (PROGN -+ (SETQ RATIO (ROUND (/ (* (ABS DY) N) (ABS DX)))) -+ (SETQ CD (GCD N RATIO)) -+ (SETQ N (/ N CD)) -+ (SETQ RATIO (/ RATIO CD)) -+ (SETQ NRAT (ROUND (/ (ABS DX) N))) -+ (SETQ DELX (* (SIGNUM DX) NRAT N)) -+ (SETQ DELY (* (SIGNUM DY) NRAT RATIO)))) -+ (WINDOW-DRAW-LINE-XY W (+ ORGX DELX) (+ ORGY DELY) ORGX ORGY))))) -+ -+(DEFUN WINDOW-RESET-COLOR (W) -+ (XSETFOREGROUND *WINDOW-DISPLAY* (CADDR W) *DEFAULT-FG-COLOR*) -+ (XSETBACKGROUND *WINDOW-DISPLAY* (CADDR W) *DEFAULT-BG-COLOR*)) -+ -+(DEFUN WINDOW-SET-COLOR-RGB (W R G B &OPTIONAL BACKGROUND) -+ (LET (RET) -+ (OR *WINDOW-XCOLOR* (SETQ *WINDOW-XCOLOR* (MAKE-XCOLOR))) -+ (SET-XCOLOR-RED *WINDOW-XCOLOR* (+ R 0)) -+ (SET-XCOLOR-GREEN *WINDOW-XCOLOR* (+ G 0)) -+ (SET-XCOLOR-BLUE *WINDOW-XCOLOR* (+ B 0)) -+ (SETQ RET -+ (XALLOCCOLOR *WINDOW-DISPLAY* *DEFAULT-COLORMAP* -+ *WINDOW-XCOLOR*)) -+ (IF (NOT (EQL RET 0)) -+ (WINDOW-SET-XCOLOR W *WINDOW-XCOLOR* BACKGROUND)))) -+ -+(DEFUN WINDOW-SET-XCOLOR (W &OPTIONAL XCOLOR BACKGROUND) -+ (IF BACKGROUND (WINDOW-SET-BACKGROUND W (XCOLOR-PIXEL XCOLOR)) -+ (WINDOW-SET-FOREGROUND W (XCOLOR-PIXEL XCOLOR))) -+ XCOLOR) -+ -+(DEFUN WINDOW-SET-COLOR (W RGB &OPTIONAL BACKGROUND) -+ (WINDOW-SET-COLOR-RGB W (FIRST RGB) (SECOND RGB) (THIRD RGB) -+ BACKGROUND)) -+ -+(DEFUN WINDOW-FREE-COLOR (W &OPTIONAL XCOLOR) -+ (declare (ignore w)) -+ (OR XCOLOR (SETQ XCOLOR *WINDOW-XCOLOR*)) -+ (IF XCOLOR -+ (UNLESS (OR (EQL XCOLOR *DEFAULT-FG-COLOR*) -+ (EQL XCOLOR *DEFAULT-BG-COLOR*)) -+ (XFREECOLORS *WINDOW-DISPLAY* *DEFAULT-COLORMAP* XCOLOR 1 0)))) -+ -+(DEFUN WINDOW-GET-CHARS (W FN &OPTIONAL ARGS) -+ (LET (WIN RES) -+ (OR *WINDOW-KEYINIT* (WINDOW-INIT-KEYMAP)) -+ (SETQ *WINDOW-SHIFT* NIL) -+ (SETQ *WINDOW-CTRL* NIL) -+ (SETQ *WINDOW-META* NIL) -+ (SETQ WIN (WINDOW-PARENT W)) -+ (XSYNC *WINDOW-DISPLAY* 1) -+ (XSELECTINPUT *WINDOW-DISPLAY* WIN -+ (+ KEYPRESSMASK KEYRELEASEMASK BUTTONPRESSMASK)) -+ (WHILE (NULL RES) (XNEXTEVENT *WINDOW-DISPLAY* *WINDOW-EVENT*) -+ (LET ((TYPE (XANYEVENT-TYPE *WINDOW-EVENT*)) -+ (EVENTWINDOW (XANYEVENT-WINDOW *WINDOW-EVENT*))) -+ (IF (EQL EVENTWINDOW WIN) -+ (SETQ RES (WINDOW-PROCESS-CHAR-EVENT W TYPE FN ARGS))))) -+ RES)) -+ -+(DEFUN WINDOW-PROCESS-CHAR-EVENT (W TYPE FN ARGS) -+ (LET (CODE) -+ (IF (EQL TYPE KEYRELEASE) -+ (PROGN -+ (SETQ CODE (XBUTTONEVENT-BUTTON *WINDOW-EVENT*)) -+ (IF (MEMBER CODE *WINDOW-SHIFT-KEYS*) -+ (SETQ *WINDOW-SHIFT* NIL) -+ (IF (MEMBER CODE *WINDOW-CONTROL-KEYS*) -+ (SETQ *WINDOW-CTRL* NIL) -+ (IF (MEMBER CODE *WINDOW-META-KEYS*) -+ (SETQ *WINDOW-META* NIL))))) -+ (IF (EQL TYPE KEYPRESS) -+ (PROGN -+ (SETQ CODE (XBUTTONEVENT-BUTTON *WINDOW-EVENT*)) -+ (IF (MEMBER CODE *WINDOW-SHIFT-KEYS*) -+ (PROGN (SETQ *WINDOW-SHIFT* T) NIL) -+ (IF (MEMBER CODE *WINDOW-CONTROL-KEYS*) -+ (PROGN (SETQ *WINDOW-CTRL* T) NIL) -+ (IF (MEMBER CODE *WINDOW-META-KEYS*) -+ (PROGN (SETQ *WINDOW-META* T) NIL) -+ (FUNCALL FN W (WINDOW-CHAR-DECODE CODE) 0 0 0 -+ ARGS))))) -+ (IF (EQL TYPE BUTTONPRESS) -+ (FUNCALL FN W 0 (XBUTTONEVENT-BUTTON *WINDOW-EVENT*) -+ (XMOTIONEVENT-X *WINDOW-EVENT*) -+ (- (WINDOW-DRAWABLE-HEIGHT W) -+ (XMOTIONEVENT-Y *WINDOW-EVENT*)) -+ ARGS)))))) -+ -+(DEFUN WINDOW-CHAR-DECODE (CODE) -+ (LET (CHAR) -+ (SETQ CHAR -+ (AREF (IF *WINDOW-SHIFT* *WINDOW-SHIFTKEYMAP* -+ *WINDOW-KEYMAP*) -+ CODE)) -+ (IF (AND CHAR *WINDOW-CTRL*) -+ (SETQ CHAR (CODE-CHAR (- (CHAR-CODE (CHAR-UPCASE CHAR)) 64)))) -+ (IF (AND CHAR *WINDOW-META*) -+ (SETQ CHAR (CODE-CHAR (+ (CHAR-CODE (CHAR-UPCASE CHAR)) 128)))) -+ (OR CHAR #\Space))) -+ -+(DEFUN WINDOW-GET-RAW-CHAR (W) -+ (LET (WIN RES) -+ (OR *WINDOW-KEYINIT* (WINDOW-INIT-KEYMAP)) -+ (SETQ *WINDOW-SHIFT* NIL) -+ (SETQ *WINDOW-CTRL* NIL) -+ (SETQ *WINDOW-META* NIL) -+ (SETQ WIN (WINDOW-PARENT W)) -+ (XSYNC *WINDOW-DISPLAY* 1) -+ (XSELECTINPUT *WINDOW-DISPLAY* WIN (+ KEYPRESSMASK KEYRELEASEMASK)) -+ (WHILE (NULL RES) (XNEXTEVENT *WINDOW-DISPLAY* *WINDOW-EVENT*) -+ (LET ((TYPE (XANYEVENT-TYPE *WINDOW-EVENT*)) -+ (EVENTWINDOW (XANYEVENT-WINDOW *WINDOW-EVENT*))) -+ (IF (AND (EQL EVENTWINDOW WIN) (EQL TYPE KEYPRESS)) -+ (SETQ RES (XBUTTONEVENT-BUTTON *WINDOW-EVENT*))))) -+ RES)) -+ -+(DEFUN WINDOW-INPUT-STRING (W STR X Y &OPTIONAL SIZE) -+ (CAR (WINDOW-EDIT W X Y (OR SIZE 100) 16 (LIST (OR STR "")) NIL T T))) -+ -+(DEFUN WINDOW-EDIT -+ (W X Y WIDTH HEIGHT &OPTIONAL STRINGS BOXFLG SCROLL ENDP) -+ (LET (EM) -+ (SETQ EM -+ (EDITMENU-CREATE WIDTH HEIGHT NIL W X Y NIL T '9X15 BOXFLG -+ STRINGS SCROLL ENDP)) -+ (EDITMENU-EDIT EM) -+ (EDITMENU-CARAT EM) -+ (NTH 10 EM))) -+ -+ -+ -+(DEFUN EDITMENU-CREATE -+ (WIDTH HEIGHT &OPTIONAL TITLE PARENTW X Y PERM FLAT FONT BOXFLG -+ INITIAL-TEXT SCROLLVAL ENDP) -+ (LIST 'EDITMENU (IF FLAT PARENTW) FLAT (IF PARENTW (CADR PARENTW)) -+ (OR X 0) (OR Y 0) 0 0 (IF TITLE (STRINGIFY TITLE) "") PERM -+ (OR INITIAL-TEXT (LIST "")) WIDTH HEIGHT BOXFLG (OR FONT '9X15) -+ (IF ENDP -+ (LENGTH (NTH (IF (NUMBERP SCROLLVAL) SCROLLVAL 0) -+ INITIAL-TEXT)) -+ 0) -+ (IF (NUMBERP SCROLLVAL) SCROLLVAL 0) (OR SCROLLVAL 0))) -+ -+(DEFUN EDITMENU-CALCULATE-SIZE (M) -+ (SETF (SEVENTH M) (NTH 11 M)) -+ (SETF (EIGHTH M) (NTH 12 M))) -+ -+(DEFUN EDITMENU-INIT (M) -+ (EDITMENU-CALCULATE-SIZE M) -+ (MENU-ADJUST-OFFSET M) -+ (IF (NOT (CADDR M)) -+ (SETF (CADR M) -+ (WINDOW-CREATE (SEVENTH M) (EIGHTH M) (OR (NINTH M) "") -+ (CADDDR M) (FIFTH M) (SIXTH M) (NTH 14 M))))) -+ -+(DEFUN EDITMENU-DRAW (M) -+ (LET (MW XZERO YZERO) -+ (OR (AND (CADR M) (PLUSP (EIGHTH M))) (EDITMENU-INIT M)) -+ (SETQ MW (CADR M)) -+ (XMAPWINDOW *WINDOW-DISPLAY* (CADR MW)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (WINDOW-WAIT-EXPOSURE MW) -+ (MENU-CLEAR M) -+ (SETQ XZERO (IF (CADDR M) (FIFTH M) 0)) -+ (SETQ YZERO (IF (CADDR M) (SIXTH M) 0)) -+ (IF (NTH 13 M) -+ (WINDOW-DRAW-BOX-XY MW XZERO YZERO (SEVENTH M) (EIGHTH M) 1)) -+ (EDITMENU-DISPLAY M 0 0 (NOT (NUMBERP (NTH 17 M)))))) -+ -+(DEFUN EDITMENU-DISPLAY (M LINE CHAR ONLY) -+ (LET (LINES Y MAXWIDTH LINEWIDTH (W (OR (CADR M) (EDITMENU-INIT M)))) -+ (SETQ LINES (NTHCDR LINE (NTH 10 M))) -+ (SETQ Y -+ (+ (IF (CADDR M) (SIXTH M) 0) -+ (- (EIGHTH M) -+ (1- (* (WINDOW-STRING-HEIGHT -+ (OR (CADR M) (EDITMENU-INIT M)) "Tg") -+ (1+ (- (- LINE -+ (IF (NUMBERP (NTH 17 M)) (NTH 17 M) 0)) -+ (IF (NUMBERP (NTH 17 M)) (NTH 17 M) 0)))))))) -+ (SETQ MAXWIDTH -+ (TRUNCATE (+ -6 (SEVENTH M)) -+ (LET ((SSTR (STRINGIFY "W"))) -+ (XTEXTWIDTH (SEVENTH (OR (CADR M) (EDITMENU-INIT M))) -+ (GET-C-STRING SSTR) (LENGTH SSTR))))) -+ (WHILE (AND LINES (>= Y (+ 4 (IF (CADDR M) (SIXTH M) 0)))) -+ (IF (< CHAR MAXWIDTH) -+ (IF (PLUSP CHAR) -+ (LET ((SSTR (STRINGIFY -+ (SUBSEQ (FIRST LINES) CHAR -+ (MIN MAXWIDTH -+ (LENGTH (FIRST LINES))))))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) -+ (CADDR W) -+ (+ (IF (CADDR M) (FIFTH M) 0) -+ (+ 2 -+ (* CHAR -+ (LET ((SSTR (STRINGIFY "W"))) -+ (XTEXTWIDTH -+ (SEVENTH -+ (OR (CADR M) (EDITMENU-INIT M))) -+ (GET-C-STRING SSTR) (LENGTH SSTR)))))) -+ (- (CADDDR W) Y) (GET-C-STRING SSTR) -+ (LENGTH SSTR))) -+ (LET ((SSTR (STRINGIFY -+ (IF -+ (<= (LENGTH (FIRST LINES)) -+ MAXWIDTH) -+ (FIRST LINES) -+ (SUBSEQ (FIRST LINES) 0 MAXWIDTH))))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) -+ (CADDR W) (+ 2 (IF (CADDR M) (FIFTH M) 0)) -+ (- (CADDDR W) Y) (GET-C-STRING SSTR) -+ (LENGTH SSTR))))) -+ (SETQ LINEWIDTH -+ (+ 2 -+ (* (LET ((SSTR (STRINGIFY "W"))) -+ (XTEXTWIDTH -+ (SEVENTH (OR (CADR M) (EDITMENU-INIT M))) -+ (GET-C-STRING SSTR) (LENGTH SSTR))) -+ (LENGTH (FIRST LINES))))) -+ (WINDOW-ERASE-AREA-XY W -+ (+ (IF (CADDR M) (FIFTH M) 0) LINEWIDTH) (+ -2 Y) -+ (+ -2 (- (SEVENTH M) LINEWIDTH)) -+ (WINDOW-STRING-HEIGHT (OR (CADR M) (EDITMENU-INIT M)) -+ "Tg")) -+ (DECF Y -+ (WINDOW-STRING-HEIGHT (OR (CADR M) (EDITMENU-INIT M)) -+ "Tg")) -+ (IF ONLY (SETQ LINES NIL) -+ (PROGN -+ (POP LINES) -+ (IF (AND (NULL LINES) -+ (>= Y (+ 4 (IF (CADDR M) (SIXTH M) 0)))) -+ (WINDOW-ERASE-AREA-XY W -+ (+ 2 (IF (CADDR M) (FIFTH M) 0)) (+ -2 Y) -+ (+ -4 (SEVENTH M)) -+ (WINDOW-STRING-HEIGHT -+ (OR (CADR M) (EDITMENU-INIT M)) "Tg"))))) -+ (SETQ CHAR 0)) -+ (XFLUSH *WINDOW-DISPLAY*))) -+ -+(DEFUN EDITMENU-CARAT (M) -+ (WINDOW-DRAW-CARAT (OR (CADR M) (EDITMENU-INIT M)) -+ (+ (IF (CADDR M) (FIFTH M) 0) -+ (+ 2 -+ (* (NTH 15 M) -+ (LET ((SSTR (STRINGIFY "W"))) -+ (XTEXTWIDTH (SEVENTH (OR (CADR M) (EDITMENU-INIT M))) -+ (GET-C-STRING SSTR) (LENGTH SSTR)))))) -+ (+ -2 -+ (+ (IF (CADDR M) (SIXTH M) 0) -+ (- (EIGHTH M) -+ (1- (* (WINDOW-STRING-HEIGHT -+ (OR (CADR M) (EDITMENU-INIT M)) "Tg") -+ (1+ (- (NTH 16 M) -+ (IF (NUMBERP (NTH 17 M)) (NTH 17 M) 0))))))))) -+ (XFLUSH *WINDOW-DISPLAY*)) -+ -+(DEFUN EDITMENU-ERASE (M ONEP) -+ (LET ((W (OR (CADR M) (EDITMENU-INIT M))) XW) -+ (SETQ XW -+ (+ 2 -+ (* (LET ((SSTR (STRINGIFY "W"))) -+ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) -+ (LENGTH SSTR))) -+ (NTH 15 M)))) -+ (LET ((GLVAR423 (WINDOW-STRING-HEIGHT W "Tg"))) -+ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) -+ (+ (IF (CADDR M) (FIFTH M) 0) XW) -+ (- (CADDDR W) -+ (1- (+ (- (+ (IF (CADDR M) (SIXTH M) 0) -+ (- (EIGHTH M) -+ (1- (* (WINDOW-STRING-HEIGHT -+ (OR (CADR M) (EDITMENU-INIT M)) -+ "Tg") -+ (1+ -+ (- (NTH 16 M) -+ (IF (NUMBERP (NTH 17 M)) -+ (NTH 17 M) 0))))))) -+ (CADR (LET ((SSTR (STRINGIFY "Tg"))) -+ (XTEXTEXTENTS (SEVENTH W) -+ (GET-C-STRING SSTR) (LENGTH SSTR) -+ *DIRECTION-RETURN* *ASCENT-RETURN* -+ *DESCENT-RETURN* *OVERALL-RETURN*) -+ (LIST (INT-POS *ASCENT-RETURN* 0) -+ (INT-POS *DESCENT-RETURN* 0))))) -+ GLVAR423))) -+ (IF ONEP -+ (LET ((SSTR (STRINGIFY "W"))) -+ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) -+ (LENGTH SSTR))) -+ (- (SEVENTH M) XW)) -+ GLVAR423 0)) -+ (XFLUSH *WINDOW-DISPLAY*))) -+ -+(DEFUN EDITMENU-LINE-Y (M LINE) -+ (+ (IF (CADDR M) (SIXTH M) 0) -+ (- (EIGHTH M) -+ (1- (* (WINDOW-STRING-HEIGHT (OR (CADR M) (EDITMENU-INIT M)) -+ "Tg") -+ (1+ (- LINE (IF (NUMBERP (NTH 17 M)) (NTH 17 M) 0)))))))) -+ -+(DEFUN EDITMENU-SELECT (M &OPTIONAL INSIDE) -+ (declare (ignore inside)) -+ (LET (MW CODEVAL XVAL YVAL) -+ (SETQ MW (OR (CADR M) (EDITMENU-INIT M))) -+ (IF (NOT (TENTH M)) (EDITMENU-DRAW M)) -+ (WINDOW-TRACK-MOUSE MW -+ #'(LAMBDA (X Y CODE) -+ (SETQ *WINDOW-MENU-CODE* CODE) -+ (WHEN (OR (PLUSP CODE) (< X (FIFTH M)) -+ (> X (+ (FIFTH M) (SEVENTH M))) (< Y (SIXTH M)) -+ (> Y (+ (SIXTH M) (EIGHTH M)))) -+ (SETQ CODEVAL CODE) -+ (SETQ XVAL X) -+ (SETQ YVAL Y))) -+ T) -+ (IF (PLUSP CODEVAL) (EDITMENU-EDIT M CODEVAL XVAL YVAL)))) -+ -+(DEFVAR *WINDOW-EDITMENU-KILL-STRINGS* NIL) -+ -+(DEFUN EDITMENU-EDIT (M &OPTIONAL CODE X Y) -+ (LET ((MW (OR (CADR M) (EDITMENU-INIT M)))) -+ (EDITMENU-DRAW M) -+ (EDITMENU-CARAT M) -+ (IF CODE (EDITMENU-EDIT-FN MW NIL CODE X Y (LIST M))) -+ (SETQ *WINDOW-EDITMENU-KILL-STRINGS* NIL) -+ (WINDOW-GET-CHARS MW #'EDITMENU-EDIT-FN (LIST M)) -+ (NTH 10 M))) -+ -+(DEFUN EDITMENU-EDIT-FN (W CHAR BUTTON BUTTONX BUTTONY ARGS) -+ (declare (ignore w)) -+ (LET (M INSIDE DONE) -+ (SETQ M (CAR ARGS)) -+ (EDITMENU-CARAT M) -+ (IF (AND (NUMBERP BUTTON) (NOT (ZEROP BUTTON))) -+ (PROGN -+ (SETQ INSIDE (EDITMENU-SETXY M BUTTONX BUTTONY)) -+ (CASE BUTTON -+ (1 (IF INSIDE (PROGN (EDITMENU-CARAT M) NIL) T)) -+ (2 (WHEN INSIDE (EDITMENU-YANK M) (EDITMENU-CARAT M) NIL)))) -+ (PROGN -+ (IF (< (CHAR-CODE CHAR) 32) -+ (CASE CHAR -+ (#\Return -+ (IF (NUMBERP (NTH 17 M)) (EDITMENU-RETURN M) -+ (SETQ DONE T))) -+ (#\Backspace (EDITMENU-BACKSPACE M)) -+ (#\^D (EDITMENU-DELETE M)) -+ (#\^N (IF (NUMBERP (NTH 17 M)) (EDITMENU-NEXT M))) -+ (#\^P (EDITMENU-PREVIOUS M)) -+ (#\^F (EDITMENU-FORWARD M)) -+ (#\^B (EDITMENU-BACKWARD M)) -+ (#\^A (EDITMENU-BEGINNING M)) -+ (#\^E (EDITMENU-END M)) -+ (#\^K (EDITMENU-KILL M)) -+ (#\^Y (EDITMENU-YANK M)) -+ (T NIL)) -+ (IF (> (CHAR-CODE CHAR) 128) -+ (PROGN -+ (SETQ CHAR (CODE-CHAR (+ -128 (CHAR-CODE CHAR)))) -+ (CASE CHAR -+ (#\B (EDITMENU-META-B M)) -+ (#\F (EDITMENU-META-F M)) -+ (T NIL))) -+ (EDITMENU-CHAR M CHAR))) -+ (EDITMENU-CARAT M) -+ DONE)))) -+ -+(DEFUN EDITMENU-SETXY (M BUTTONX BUTTONY) -+ (LET (LINECONS OKAY) -+ (SETQ OKAY -+ (AND (>= BUTTONX (FIFTH M)) -+ (<= BUTTONX (+ (FIFTH M) (SEVENTH M))) -+ (>= BUTTONY (SIXTH M)) -+ (<= BUTTONY (+ (SIXTH M) (EIGHTH M))))) -+ (WHEN OKAY -+ (SETF (NTH 16 M) -+ (MIN (1- (LENGTH (NTH 10 M))) -+ (+ (IF (NUMBERP (NTH 17 M)) (NTH 17 M) 0) -+ (TRUNCATE -+ (- (+ (IF (CADDR M) (SIXTH M) 0) -+ (+ -6 (EIGHTH M))) -+ BUTTONY) -+ (WINDOW-STRING-HEIGHT -+ (OR (CADR M) (EDITMENU-INIT M)) "Tg"))))) -+ (SETQ LINECONS (NTHCDR (NTH 16 M) (NTH 10 M))) -+ (SETF (NTH 15 M) -+ (MIN (LENGTH (CAR LINECONS)) -+ (TRUNCATE -+ (+ -2 (- BUTTONX (IF (CADDR M) (FIFTH M) 0))) -+ (LET ((SSTR (STRINGIFY "W"))) -+ (XTEXTWIDTH -+ (SEVENTH (OR (CADR M) (EDITMENU-INIT M))) -+ (GET-C-STRING SSTR) (LENGTH SSTR))))))) -+ OKAY)) -+ -+(DEFUN EDITMENU-CHAR (M CHAR) -+ (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) -+ (IF (<= (LENGTH (CAR LINECONS)) (NTH 15 M)) -+ (SETF (CAR LINECONS) -+ (CONCATENATE 'STRING (CAR LINECONS) (STRING CHAR))) -+ (SETF (CAR LINECONS) -+ (CONCATENATE 'STRING (SUBSEQ (CAR LINECONS) 0 (NTH 15 M)) -+ (STRING CHAR) (SUBSEQ (CAR LINECONS) (NTH 15 M))))) -+ (EDITMENU-DISPLAY M (NTH 16 M) (NTH 15 M) T) -+ (INCF (NTH 15 M)))) -+ -+(DEFUN EDITMENU-CURRENT-CHAR (M) -+ (CHAR (NTH (NTH 16 M) (NTH 10 M)) (NTH 15 M))) -+ -+(DEFUN EDITMENU-RETURN (M) -+ (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) -+ (IF (<= (LENGTH (CAR LINECONS)) (NTH 15 M)) -+ (PUSH "" (CDR LINECONS)) -+ (PROGN -+ (PUSH (SUBSEQ (CAR LINECONS) (NTH 15 M)) (CDR LINECONS)) -+ (SETF (CAR LINECONS) (SUBSEQ (CAR LINECONS) 0 (NTH 15 M))))) -+ (EDITMENU-DISPLAY M (NTH 16 M) 0 NIL) -+ (INCF (NTH 16 M)) -+ (SETF (NTH 15 M) 0))) -+ -+(DEFUN EDITMENU-BACKSPACE (M) -+ (LET (TMP LINEDEL (LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) -+ (IF (PLUSP (NTH 15 M)) -+ (PROGN -+ (DECF (NTH 15 M)) -+ (SETF (CAR LINECONS) -+ (CONCATENATE 'STRING -+ (SUBSEQ (CAR LINECONS) 0 (NTH 15 M)) -+ (SUBSEQ (CAR LINECONS) (1+ (NTH 15 M)))))) -+ (WHEN (PLUSP (NTH 16 M)) -+ (DECF (NTH 16 M)) -+ (SETQ LINEDEL T) -+ (SETQ LINECONS (NTHCDR (NTH 16 M) (NTH 10 M))) -+ (SETF (NTH 15 M) (LENGTH (CAR LINECONS))) -+ (SETQ TMP -+ (CONCATENATE 'STRING (CAR LINECONS) (CADR LINECONS))) -+ (SETF (CDR LINECONS) (CDDR LINECONS)) -+ (SETF (CAR LINECONS) TMP))) -+ (EDITMENU-DISPLAY M (NTH 16 M) (NTH 15 M) (NOT LINEDEL)))) -+ -+(DEFUN EDITMENU-END (M) -+ (SETF (NTH 15 M) (LENGTH (NTH (NTH 16 M) (NTH 10 M))))) -+ -+(DEFUN EDITMENU-BEGINNING (M) (SETF (NTH 15 M) 0)) -+ -+(DEFUN EDITMENU-FORWARD (M) -+ (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) -+ (IF (< (NTH 15 M) (LENGTH (CAR LINECONS))) (INCF (NTH 15 M)) -+ (WHEN (NUMBERP (NTH 17 M)) -+ (INCF (NTH 16 M)) -+ (IF (NULL (CDR LINECONS)) (SETF (CDR LINECONS) (LIST ""))) -+ (SETF (NTH 15 M) 0))))) -+ -+(DEFUN EDITMENU-META-F (M) -+ (LET (FOUND DONE) -+ (WHILE (AND (OR (< (NTH 16 M) (1- (LENGTH (NTH 10 M)))) -+ (< (NTH 15 M) (LENGTH (NTH (NTH 16 M) (NTH 10 M))))) -+ (NOT FOUND)) -+ (IF (EDITMENU-ALPHANUMBERICP (EDITMENU-CURRENT-CHAR M)) -+ (SETQ FOUND T) (EDITMENU-FORWARD M))) -+ (IF FOUND -+ (WHILE (AND (OR (< (NTH 16 M) (1- (LENGTH (NTH 10 M)))) -+ (< (NTH 15 M) -+ (LENGTH (NTH (NTH 16 M) (NTH 10 M))))) -+ (NOT DONE)) -+ (IF (EDITMENU-ALPHANUMBERICP (EDITMENU-CURRENT-CHAR M)) -+ (EDITMENU-FORWARD M) (SETQ DONE T)))))) -+ -+(DEFUN EDITMENU-ALPHANUMBERICP (X) -+ (OR (ALPHA-CHAR-P X) (NOT (NULL (DIGIT-CHAR-P X))))) -+ -+(DEFUN EDITMENU-NEXT (M) -+ (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) -+ (INCF (NTH 16 M)) -+ (IF (NULL (CDR LINECONS)) (SETF (CDR LINECONS) (LIST ""))) -+ (SETQ LINECONS (CDR LINECONS)) -+ (SETF (NTH 15 M) (MIN (NTH 15 M) (LENGTH (CAR LINECONS)))))) -+ -+(DEFUN EDITMENU-BACKWARD (M) -+ (IF (PLUSP (NTH 15 M)) (DECF (NTH 15 M)) -+ (WHEN (PLUSP (NTH 16 M)) -+ (DECF (NTH 16 M)) -+ (SETF (NTH 15 M) (LENGTH (NTH (NTH 16 M) (NTH 10 M))))))) -+ -+(DEFUN EDITMENU-META-B (M) -+ (LET (FOUND DONE) -+ (WHILE (AND (OR (PLUSP (NTH 15 M)) (PLUSP (NTH 16 M))) (NOT FOUND)) -+ (EDITMENU-BACKWARD M) -+ (IF (EDITMENU-ALPHANUMBERICP (EDITMENU-CURRENT-CHAR M)) -+ (SETQ FOUND T))) -+ (WHEN FOUND -+ (WHILE (AND (OR (PLUSP (NTH 15 M)) (PLUSP (NTH 16 M))) -+ (NOT DONE)) -+ (IF (EDITMENU-ALPHANUMBERICP (EDITMENU-CURRENT-CHAR M)) -+ (EDITMENU-BACKWARD M) (SETQ DONE T))) -+ (UNLESS (EDITMENU-ALPHANUMBERICP (EDITMENU-CURRENT-CHAR M)) -+ (EDITMENU-FORWARD M))))) -+ -+(DEFUN EDITMENU-PREVIOUS (M) -+ (WHEN (PLUSP (NTH 16 M)) -+ (DECF (NTH 16 M)) -+ (SETF (NTH 15 M) -+ (MIN (NTH 15 M) (LENGTH (NTH (NTH 16 M) (NTH 10 M))))))) -+ -+(DEFUN EDITMENU-DELETE (M) -+ (EDITMENU-FORWARD M) -+ (EDITMENU-BACKSPACE M)) -+ -+(DEFUN EDITMENU-KILL (M) -+ (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M)))) -+ (IF (< (NTH 15 M) (LENGTH (CAR LINECONS))) -+ (PROGN -+ (SETQ *WINDOW-EDITMENU-KILL-STRINGS* -+ (LIST (SUBSEQ (CAR LINECONS) (NTH 15 M)))) -+ (SETF (CAR LINECONS) (SUBSEQ (CAR LINECONS) 0 (NTH 15 M))) -+ (EDITMENU-DISPLAY M (NTH 16 M) (NTH 15 M) T)) -+ (EDITMENU-DELETE M)))) -+ -+(DEFUN EDITMENU-YANK (M) -+ (LET ((LINECONS (NTHCDR (NTH 16 M) (NTH 10 M))) (COL (NTH 15 M))) -+ (WHEN *WINDOW-EDITMENU-KILL-STRINGS* -+ (IF (<= (LENGTH (CAR LINECONS)) (NTH 15 M)) -+ (PROGN -+ (SETF (CAR LINECONS) -+ (CONCATENATE 'STRING (CAR LINECONS) -+ (CAR *WINDOW-EDITMENU-KILL-STRINGS*))) -+ (SETF (NTH 15 M) (LENGTH (CAR LINECONS)))) -+ (PROGN -+ (SETF (CAR LINECONS) -+ (CONCATENATE 'STRING (SUBSEQ (CAR LINECONS) 0 COL) -+ (CAR *WINDOW-EDITMENU-KILL-STRINGS*) -+ (SUBSEQ (CAR LINECONS) COL))) -+ (INCF (NTH 15 M) -+ (LENGTH (CAR *WINDOW-EDITMENU-KILL-STRINGS*))))) -+ (EDITMENU-DISPLAY M (NTH 16 M) COL T)))) -+ -+(DEFUN WINDOW-DRAW-CARAT (W X Y) -+ (WINDOW-SET-XOR W) -+ (WINDOW-DRAW-LINE-XY W (- X 5) (- Y 2) X Y) -+ (WINDOW-DRAW-LINE-XY W X Y (+ X 5) (- Y 2)) -+ (WINDOW-UNSET W) -+ (WINDOW-FORCE-OUTPUT W)) -+ -+(DEFUN WINDOW-INIT-KEYMAP () -+ (LET (MINCODE MAXCODE KEYCODE KEYSYM KEYNUM SHIFTKEYNUM CHAR) -+ (XDISPLAYKEYCODES *WINDOW-DISPLAY* *MIN-KEYCODES-RETURN* -+ *MAX-KEYCODES-RETURN*) -+ (SETQ MINCODE (INT-POS *MIN-KEYCODES-RETURN* 0)) -+ (SETQ MAXCODE (INT-POS *MAX-KEYCODES-RETURN* 0)) -+ (SETQ *WINDOW-KEYMAP* -+ (MAKE-ARRAY (1+ MAXCODE) :INITIAL-ELEMENT NIL)) -+ (SETQ *WINDOW-SHIFTKEYMAP* -+ (MAKE-ARRAY (1+ MAXCODE) :INITIAL-ELEMENT NIL)) -+ (SETQ *WINDOW-SHIFT-KEYS* NIL) -+ (SETQ *WINDOW-CONTROL-KEYS* NIL) -+ (SETQ *WINDOW-META-KEYS* NIL) -+ (DOTIMES (I (1+ (- MAXCODE MINCODE))) -+ (SETQ KEYCODE (+ I MINCODE)) -+ (SETQ KEYSYM -+ (XGETKEYBOARDMAPPING *WINDOW-DISPLAY* KEYCODE 1 -+ *KEYCODES-RETURN*)) -+ (SETQ KEYNUM (FIXNUM-POS KEYSYM 0)) -+ (SETQ SHIFTKEYNUM (FIXNUM-POS KEYSYM 1)) -+ (IF (AND (>= KEYNUM 65) (<= KEYNUM 90) -+ (EQL SHIFTKEYNUM NOSYMBOL)) -+ (PROGN -+ (SETQ SHIFTKEYNUM KEYNUM) -+ (SETQ KEYNUM (+ KEYNUM 32)))) -+ (IF (> KEYNUM 0) -+ (IF (SETQ CHAR (WINDOW-CODE-CHAR KEYNUM)) -+ (SETF (AREF *WINDOW-KEYMAP* KEYCODE) CHAR) -+ (IF (> KEYNUM 256) -+ (COND -+ ((OR (EQL KEYNUM XK_SHIFT_R) -+ (EQL KEYNUM XK_SHIFT_L)) -+ (PUSH KEYCODE *WINDOW-SHIFT-KEYS*)) -+ ((OR (EQL KEYNUM XK_CONTROL_L) -+ (EQL KEYNUM XK_CONTROL_R)) -+ (PUSH KEYCODE *WINDOW-CONTROL-KEYS*)) -+ ((OR (EQL KEYNUM XK_ALT_R) (EQL KEYNUM XK_ALT_L)) -+ (PUSH KEYCODE *WINDOW-META-KEYS*)))))) -+ (IF (> SHIFTKEYNUM 0) -+ (IF (SETQ CHAR (WINDOW-CODE-CHAR SHIFTKEYNUM)) -+ (SETF (AREF *WINDOW-SHIFTKEYMAP* KEYCODE) CHAR)))) -+ (SETQ *WINDOW-KEYINIT* T))) -+ -+(DEFUN WINDOW-CODE-CHAR (CODE) -+ (IF (> CODE 0) -+ (IF (< CODE 256) (CODE-CHAR CODE) -+ (COND -+ ((EQL CODE XK_RETURN) #\Return) -+ ((EQL CODE XK_TAB) #\Tab) -+ ((EQL CODE XK_BACKSPACE) #\Backspace))))) -+ -+ -+ -+ ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_imports.lsp -@@ -0,0 +1,728 @@ -+; From: Bill Schelter imports.lsp 16 Nov 94 -+ -+; Copyright (c) 1994 William Schelter and The University of Texas at Austin. -+ -+; See the file gnu.license . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+ -+; The following will make ALL currently defined functions and special variables -+; in the xlib package be imported into user. -+ -+(in-package :XLIB) -+ -+(import '(SET-XGCVALUES-SUBWINDOW_MODE SET-XGCVALUES-ARC_MODE WINDOW-SET-CURSOR -+ MAKE-XVISUALINFO XCOLORMAPEVENT-SERIAL XGCVALUES-LINE_WIDTH -+ WINDOW-CIRCLE-RADIUS XVISIBILITYEVENT-SERIAL XCOLOR-GREEN -+ XTEXTPROPERTY-VALUE XCREATEREGION XGCVALUES-SUBWINDOW_MODE -+ MAKE-XTEXTPROPERTY PICMENU-CREATE XDISPLAYKEYCODES XGCVALUES-DASHES -+ WINDOW-CLOSE SET-XGCVALUES-BACKGROUND SET-XGCVALUES-FOREGROUND -+ XUNIONRECTWITHREGION XTEXTITEM-DELTA XCONNECTIONNUMBER -+ MAKE-XEXTCODES SCREENFORMAT-SCANLINE_PAD XFREEGC XARC-HEIGHT -+ XPARSECOLOR XKEYCODETOKEYSYM XBUTTONEVENT-TIME WINDOW-SET-INVERT -+ XPROTOCOLREVISION XPROTOCOLVERSION SET-XFOCUSCHANGEEVENT-TYPE -+ BARMENU-INIT XSTANDARDCOLORMAP-BLUE_MULT -+ XSTANDARDCOLORMAP-GREEN_MULT XSTANDARDCOLORMAP-RED_MULT -+ SET-XCOLOR-FLAGS XQUERYTREE XQUERYCOLOR MAKE-DEPTH XCHANGESAVESET -+ XCOLORMAPEVENT-COLORMAP SET-XRECTANGLE-HEIGHT XBUTTONEVENT-TYPE -+ XALLOWEVENTS XDRAWRECTANGLES XSETFILLRULE -+ XGCVALUES-GRAPHICS_EXPOSURES XSETFILLSTYLE XCOLOR-FLAGS -+ SET-XKEYBOARDCONTROL-LED_MODE XSETSTATE XBUTTONEVENT-STATE -+ XQUERYTEXTEXTENTS SCREEN-DEPTHS SCREEN-NDEPTHS MENU-INIT -+ SET-XGCVALUES-LINE_WIDTH SCREENFORMAT-DEPTH XINSTALLCOLORMAP XARC-Y -+ SET-XFOCUSCHANGEEVENT-SERIAL XOFFSETREGION SET-XFONTPROP-CARD32 -+ XIMAGE-BITMAP_BIT_ORDER SET-XWMHINTS-INITIAL_STATE XSTORECOLOR -+ MAKE-XMAPEVENT XBUTTONEVENT-SERIAL SET-XKEYBOARDCONTROL-BELL_PITCH -+ SET-XKEYBOARDSTATE-BELL_PITCH SET-XKEYEVENT-KEYCODE -+ SCREENFORMAT-BITS_PER_PIXEL XKEYSYMTOSTRING -+ SET-XCLIENTMESSAGEEVENT-FORMAT SET-XRESIZEREQUESTEVENT-WIDTH -+ WINDOW-DRAW-LINE XGCVALUES-PLANE_MASK XFILLRECTANGLES XDRAWSEGMENTS -+ WINDOW-DRAW-CIRCLE SET-XUNMAPEVENT-TYPE XEXPOSEEVENT-HEIGHT -+ XSTANDARDCOLORMAP-BLUE_MAX XSTANDARDCOLORMAP-GREEN_MAX -+ XSTANDARDCOLORMAP-RED_MAX XSETWMSIZEHINTS XKEYEVENT-KEYCODE -+ WINDOW-FORCE-OUTPUT WINDOW-UNMAP XCHARSTRUCT-WIDTH -+ XDEFAULTCOLORMAPOFSCREEN SET-XFOCUSCHANGEEVENT-DETAIL XSEGMENT-X1 -+ SCREEN-ROOT XEDATAOBJECT-SCREEN XSEGMENT-Y1 -+ SET-XMODIFIERKEYMAP-MAX_KEYPERMOD SET-XGCVALUES-CLIP_Y_ORIGIN -+ SET-XGCVALUES-CLIP_X_ORIGIN SET-XGCVALUES-TS_Y_ORIGIN -+ SET-XGCVALUES-TS_X_ORIGIN SET-XGCVALUES-CLIP_MASK -+ SET-XGCVALUES-PLANE_MASK XCHECKMASKEVENT XDEFAULTCOLORMAP -+ XSEGMENT-X2 SCREEN-DISPLAY XBUTTONEVENT-SAME_SCREEN XSEGMENT-Y2 -+ XCREATEWINDOWEVENT-BORDER_WIDTH XCREATEWINDOWEVENT-WIDTH -+ WINDOW-CLEAR SET-SCREEN-EXT_DATA XEXPOSEEVENT-COUNT -+ SET-XUNMAPEVENT-SERIAL SET-XCLIENTMESSAGEEVENT-SEND_EVENT -+ XGCVALUES-TS_Y_ORIGIN XGCVALUES-TS_X_ORIGIN XDRAWARCS -+ XDEFAULTGCOFSCREEN XIMAGE-XOFFSET SET-SCREEN-DEFAULT_GC -+ SET-XCLIENTMESSAGEEVENT-DISPLAY XCOLORMAPEVENT-SEND_EVENT -+ XHOSTADDRESS-FAMILY XPROPERTYEVENT-ATOM XMAPPINGEVENT-TYPE -+ WINDOW-PRINTAT XVISIBILITYEVENT-SEND_EVENT XCOLORMAPEVENT-DISPLAY -+ XCHANGEPROPERTY XDEFAULTDEPTHOFSCREEN XBUTTONEVENT-BUTTON -+ XSETWINDOWATTRIBUTES-BACKING_STORE SET-XCLIENTMESSAGEEVENT-WINDOW -+ XIMAGE-FORMAT XVISIBILITYEVENT-DISPLAY WINDOW-LEFT WINDOW-UNSET -+ VERTEX-ARRAY XCOLORMAPEVENT-WINDOW XBUTTONEVENT-X -+ SET-XWMHINTS-ICON_PIXMAP XEDATAOBJECT-PIXMAP_FORMAT -+ XSELECTIONEVENT-REQUESTOR WINDOW-FONT PICMENU-INIT WINDOW-SET-FONT -+ XEDATAOBJECT-GC XVISIBILITYEVENT-WINDOW XDELETEPROPERTY -+ XFINDONEXTENSIONLIST XGETFONTPATH XBUTTONEVENT-Y -+ WINDOW-CENTEROFFSET SET-XKEYBOARDSTATE-LED_MASK XEDATAOBJECT-FONT -+ XREBINDKEYSYM SCREEN-SAVE_UNDERS SET-XGCVALUES-DASHES -+ XMAPPINGEVENT-SERIAL SET-XARC-Y SET-XARC-X WINDOW-INPUT-STRING -+ SET-XGCVALUES-GRAPHICS_EXPOSURES SET-XCOLOR-BLUE -+ XDEFAULTVISUALOFSCREEN SET-XWMHINTS-FLAGS VISUAL-CLASS -+ SET-XRESIZEREQUESTEVENT-HEIGHT WINDOW-PARENT XMATCHVISUALINFO -+ SET-SCREEN-BACKING_STORE WINDOW-XOR-BOX-XY XFONTSTRUCT-PER_CHAR -+ XFONTSTRUCT-DEFAULT_CHAR SET-XMODIFIERKEYMAP-MODIFIERMAP -+ SET-XWMHINTS-WINDOW_GROUP FREE -+ SET-XSETWINDOWATTRIBUTES-BACKING_PIXEL -+ SET-XSETWINDOWATTRIBUTES-BORDER_PIXEL -+ SET-XSETWINDOWATTRIBUTES-BACKGROUND_PIXEL XMOTIONEVENT-TIME -+ XCHARSTRUCT-DESCENT XCHARSTRUCT-ASCENT SET-XNOEXPOSEEVENT-TYPE -+ XCHARSTRUCT-ATTRIBUTES XARC-WIDTH SET-XFOCUSCHANGEEVENT-SEND_EVENT -+ WINDOW-INIT-MOUSE-POLL XBUTTONEVENT-ROOT XBUTTONEVENT-X_ROOT -+ XBUTTONEVENT-Y_ROOT XMOTIONEVENT-TYPE XCOPYCOLORMAPANDFREE -+ SET-XFOCUSCHANGEEVENT-DISPLAY XBUTTONEVENT-SEND_EVENT -+ XCREATEWINDOWEVENT-HEIGHT XSETWINDOWATTRIBUTES-COLORMAP -+ SET-XKEYBOARDCONTROL-KEY XCHANGEWINDOWATTRIBUTES WINDOW-GCONTEXT -+ WINDOW-DRAW-BORDER XBUTTONEVENT-DISPLAY XSELECTIONEVENT-PROPERTY -+ XNOOP XERROREVENT-MINOR_CODE XERROREVENT-REQUEST_CODE -+ XERROREVENT-ERROR_CODE XMOTIONEVENT-STATE XERROREVENT-RESOURCEID -+ XFREEMODIFIERMAP SET-XFOCUSCHANGEEVENT-WINDOW XGETATOMNAME -+ XGETICONNAME SET-XCONFIGUREEVENT-ABOVE -+ SET-XCONFIGUREREQUESTEVENT-ABOVE WINDOW-INPUT-CHAR-FN -+ WINDOW-PROCESS-CHAR-EVENT XSETWINDOWATTRIBUTES-BORDER_PIXMAP -+ XSETWINDOWATTRIBUTES-BACKGROUND_PIXMAP MAKE-XMOTIONEVENT -+ SET-XKEYBOARDCONTROL-BELL_PERCENT -+ SET-XKEYBOARDCONTROL-KEY_CLICK_PERCENT -+ SET-XKEYBOARDSTATE-BELL_PERCENT -+ SET-XKEYBOARDSTATE-KEY_CLICK_PERCENT XBUTTONEVENT-WINDOW -+ XBUTTONEVENT-SUBWINDOW SET-XWMHINTS-INPUT SET-XNOEXPOSEEVENT-SERIAL -+ SET-XSETWINDOWATTRIBUTES-DO_NOT_PROPAGATE_MASK -+ SET-XSETWINDOWATTRIBUTES-EVENT_MASK SET-XTEXTITEM-DELTA -+ SET-XTEXTITEM16-DELTA XSETWINDOWCOLORMAP XSETWINDOWBACKGROUNDPIXMAP -+ XSETWINDOWBORDERPIXMAP XSETWINDOWATTRIBUTES-SAVE_UNDER -+ XVISUALINFO-SCREEN SET-XKEYBOARDSTATE-AUTO_REPEATS -+ XMOTIONEVENT-SERIAL XGETDEFAULT XQUERYEXTENSION DEPTH-VISUALS -+ SET-XSELECTIONREQUESTEVENT-OWNER XMAPWINDOW WINDOW-DESTROY -+ SET-XCONFIGUREEVENT-TYPE SET-XCONFIGUREREQUESTEVENT-TYPE -+ XCELLSOFSCREEN SET-XWMHINTS-ICON_WINDOW XFONTSTRUCT-MAX_BOUNDS -+ XFONTSTRUCT-MIN_BOUNDS XDEFAULTROOTWINDOW XFONTSTRUCT-DESCENT -+ XFONTSTRUCT-ASCENT SET-XTEXTPROPERTY-VALUE WINDOW-DRAW-BOX-CORNERS -+ SET-XUNMAPEVENT-EVENT SET-XUNMAPEVENT-SEND_EVENT -+ WINDOW-DESTROY-SELECTED-WINDOW WINDOW-POSITIVE-Y XFREEFONTPATH -+ XSETWINDOWBORDER SET-XSETWINDOWATTRIBUTES-BACKING_PLANES -+ XWMHINTS-ICON_MASK SET-XSELECTIONREQUESTEVENT-REQUESTOR -+ SET-XSELECTIONEVENT-REQUESTOR SET-XUNMAPEVENT-DISPLAY XGETWMNAME -+ XSETWINDOWATTRIBUTES-OVERRIDE_REDIRECT WINDOW-DRAW-VECTOR-PT -+ SET-XANYEVENT-TYPE XREMOVEFROMSAVESET XSETWMNAME -+ XDEFAULTSCREENOFDISPLAY XMOTIONEVENT-SAME_SCREEN -+ SET-XUNMAPEVENT-WINDOW XSETWINDOWATTRIBUTES-CURSOR -+ SET-XCONFIGUREEVENT-SERIAL SET-XCONFIGUREREQUESTEVENT-SERIAL -+ WINDOW-DRAW-ARROW2-XY XSELECTIONREQUESTEVENT-OWNER -+ SET-XCOLORMAPEVENT-TYPE MAKE-XPIXMAPFORMATVALUES XNEXTREQUEST -+ MAKE-XWMHINTS SET-XCOLORMAPEVENT-STATE XALLOCWMHINTS SET-XPOINT-X -+ XFREECOLORMAP SET-XANYEVENT-SERIAL XSELECTIONREQUESTEVENT-REQUESTOR -+ XMAPPINGEVENT-SEND_EVENT SET-XCONFIGUREREQUESTEVENT-DETAIL -+ SET-SCREEN-DEPTHS SET-SCREEN-NDEPTHS XFONTPROP-CARD32 -+ SET-SCREEN-SAVE_UNDERS XMAPPINGEVENT-DISPLAY SET-XPOINT-Y -+ SET-XCOLORMAPEVENT-SERIAL XMOTIONEVENT-X WINDOW-DRAW-ARROWHEAD-XY -+ SET-XHOSTADDRESS-LENGTH XMAPPINGEVENT-WINDOW XVISUALINFO-CLASS -+ XREMOVEHOSTS SET-XFONTSTRUCT-EXT_DATA -+ SET-XSELECTIONREQUESTEVENT-PROPERTY SET-XSELECTIONEVENT-PROPERTY -+ XMOTIONEVENT-Y WINDOW-ERASE-BOX-XY MENU-CHOOSE -+ XCONFIGUREEVENT-BORDER_WIDTH XCONFIGUREEVENT-WIDTH XGRABPOINTER -+ SET-XCHARSTRUCT-WIDTH XSETFONTPATH MAKE-XWINDOWATTRIBUTES -+ WINDOW-QUERY-POINTER XMOTIONEVENT-IS_HINT MAKE-XIMAGE -+ SET-XCONFIGUREEVENT-X SET-XCONFIGUREREQUESTEVENT-X -+ SET-XFONTPROP-NAME WINDOW-DRAW-DOT-XY XCOPYAREA SET-SCREEN-DISPLAY -+ SET-XEXTCODES-MAJOR_OPCODE WINDOW-DRAW-RCBOX-XY -+ WINDOW-DRAW-LATEX-XY WINDOW-DRAW-BOX-XY SET-XCONFIGUREEVENT-Y -+ SET-XCONFIGUREREQUESTEVENT-Y SET-XCOLORMAPEVENT-COLORMAP -+ MAKE-XNOEXPOSEEVENT XDRAWLINE XDRAWLINES XSCREENNUMBEROFSCREEN -+ WINDOW-PRETTYPRINTAT XSELECTIONREQUESTEVENT-PROPERTY -+ XWMHINTS-ICON_X SET-XNOEXPOSEEVENT-SEND_EVENT XFREECOLORS -+ XMOTIONEVENT-ROOT XMOTIONEVENT-X_ROOT XMOTIONEVENT-Y_ROOT -+ SET-XCONFIGUREEVENT-OVERRIDE_REDIRECT XMOTIONEVENT-SEND_EVENT -+ SET-XNOEXPOSEEVENT-DISPLAY XWMHINTS-ICON_Y -+ XSETWINDOWATTRIBUTES-WIN_GRAVITY XSETWINDOWATTRIBUTES-BIT_GRAVITY -+ XBLACKPIXELOFSCREEN XRECTANGLE-X XMOTIONEVENT-DISPLAY -+ XDESTROYWINDOW WINDOW-WFUNCTION XRECTANGLE-Y XADDPIXEL -+ SET-SCREENFORMAT-EXT_DATA XGETPIXEL XMOTIONEVENT-WINDOW -+ XMOTIONEVENT-SUBWINDOW SET-XEXPOSEEVENT-WIDTH -+ XWINDOWCHANGES-STACK_MODE XPUTPIXEL XBITMAPBITORDER -+ XDOESBACKINGSTORE XSETFUNCTION XSETICONNAME -+ SET-XCONFIGUREREQUESTEVENT-PARENT SET-XMOTIONEVENT-TIME -+ MAKE-XICONSIZE SET-XCONFIGUREEVENT-EVENT -+ SET-XCONFIGUREEVENT-SEND_EVENT -+ SET-XCONFIGUREREQUESTEVENT-SEND_EVENT SET-XMOTIONEVENT-TYPE -+ XALLOCICONSIZE XDISPLAYNAME XFINDCONTEXT XSIZEHINTS-HEIGHT_INC -+ XSIZEHINTS-WIDTH_INC SET-XCONFIGUREEVENT-DISPLAY -+ SET-XCONFIGUREREQUESTEVENT-DISPLAY XKEYMAPEVENT-TYPE MAKE-VISUAL -+ WINDOW-WAIT-UNMAP SET-XMOTIONEVENT-STATE XTIMECOORD-TIME -+ WINDOW-PRINTAT-XY SET-XCONFIGUREEVENT-WINDOW -+ SET-XCONFIGUREREQUESTEVENT-WINDOW SET-XGRAPHICSEXPOSEEVENT-TYPE -+ SET-XANYEVENT-SEND_EVENT XCONFIGUREEVENT-HEIGHT -+ SET-XANYEVENT-DISPLAY SET-XCHARSTRUCT-DESCENT -+ SET-XCHARSTRUCT-ASCENT XEHEADOFEXTENSIONLIST -+ SET-XCHARSTRUCT-ATTRIBUTES XSIZEHINTS-BASE_WIDTH -+ XSIZEHINTS-MAX_WIDTH XSIZEHINTS-MIN_WIDTH XSIZEHINTS-WIDTH -+ SET-XMOTIONEVENT-SERIAL SET-XIMAGE-BITMAP_PAD XBELL -+ SET-XCREATEWINDOWEVENT-TYPE SET-XHOSTADDRESS-ADDRESS XLOOKUPSTRING -+ XDISPLAYSTRING SET-XCOLORMAPEVENT-SEND_EVENT XKEYMAPEVENT-SERIAL -+ SET-XANYEVENT-WINDOW XRESIZEREQUESTEVENT-WIDTH -+ SET-XCOLORMAPEVENT-DISPLAY VISUAL-MAP_ENTRIES -+ SET-XGRAPHICSEXPOSEEVENT-SERIAL XWINDOWCHANGES-BORDER_WIDTH -+ XWINDOWCHANGES-WIDTH SET-XCOLORMAPEVENT-WINDOW SET-VISUAL-EXT_DATA -+ ISPFKEY WINDOW-YPOSITION XWIDTHMMOFSCREEN XWINDOWATTRIBUTES-DEPTH -+ SET-XCREATEWINDOWEVENT-SERIAL SET-XMOTIONEVENT-SAME_SCREEN -+ XGRAPHICSEXPOSEEVENT-MINOR_CODE XGRAPHICSEXPOSEEVENT-MAJOR_CODE -+ XCONFIGUREREQUESTEVENT-BORDER_WIDTH XCONFIGUREREQUESTEVENT-WIDTH -+ XWINDOWATTRIBUTES-BORDER_WIDTH XWINDOWATTRIBUTES-WIDTH -+ MAKE-XRECTANGLE XWINDOWATTRIBUTES-BACKING_PIXEL XINITEXTENSION -+ SET-XFONTSTRUCT-DIRECTION SET-XIMAGE-DEPTH SET-XMAPEVENT-TYPE -+ XDESTROYWINDOWEVENT-TYPE XWINDOWATTRIBUTES-VISUAL -+ SET-XEXPOSEEVENT-HEIGHT WINDOW-PRETTYPRINTAT-XY -+ XGRAPHICSEXPOSEEVENT-DRAWABLE SET-XIMAGE-WIDTH XDESTROYSUBWINDOWS -+ SET-XIMAGE-BITS_PER_PIXEL XUNMAPEVENT-FROM_CONFIGURE XGETWMHINTS -+ GET_C_STRING_2 XGETIMAGE SET-XMOTIONEVENT-X -+ SET-XFONTSTRUCT-PROPERTIES SET-XFONTSTRUCT-N_PROPERTIES -+ XDISPLAYWIDTHMM SET-XEXTCODES-EXTENSION XPUTIMAGE -+ XCONFIGUREREQUESTEVENT-VALUE_MASK XDRAWSTRING16 XSUBIMAGE -+ XWINDOWATTRIBUTES-DO_NOT_PROPAGATE_MASK -+ XWINDOWATTRIBUTES-YOUR_EVENT_MASK MAKE-XPROPERTYEVENT -+ SET-XMAPEVENT-SERIAL XDESTROYWINDOWEVENT-SERIAL -+ SET-XEXPOSEEVENT-COUNT SET-XMOTIONEVENT-Y XWINDOWCHANGES-X -+ SET-XSTANDARDCOLORMAP-KILLID SET-XGRAPHICSEXPOSEEVENT-X -+ WINDOW-GET-VECTOR-END SET-XIMAGE-BLUE_MASK SET-XIMAGE-GREEN_MASK -+ SET-XIMAGE-RED_MASK _XQEVENT-EVENT XRECOLORCURSOR XWINDOWCHANGES-Y -+ XWIDTHOFSCREEN XWINDOWATTRIBUTES-X SET-XVISUALINFO-VISUALID -+ XTIMECOORD-X XSIZEHINTS-BASE_HEIGHT XSIZEHINTS-MAX_HEIGHT -+ XSIZEHINTS-MIN_HEIGHT XSIZEHINTS-HEIGHT MENU-DISPLAY-ITEM -+ LISP-STRING-2 SET-XGRAPHICSEXPOSEEVENT-Y -+ XWINDOWATTRIBUTES-BACKING_PLANES MENU-FIND-ITEM-WIDTH -+ XSTRINGTOKEYSYM _XQEVENT-NEXT SET-XCREATEWINDOWEVENT-X -+ SET-XMOTIONEVENT-IS_HINT MAKE-XANYEVENT XWINDOWATTRIBUTES-Y -+ SET-XGRAVITYEVENT-TYPE XTIMECOORD-Y XRESIZEREQUESTEVENT-HEIGHT -+ XDOESSAVEUNDERS SET-XCREATEWINDOWEVENT-Y -+ XWINDOWATTRIBUTES-ALL_EVENT_MASKS XFONTPROP-NAME XSCREENOFDISPLAY -+ XLISTEXTENSIONS XWINDOWCHANGES-HEIGHT XGRAPHICSEXPOSEEVENT-WIDTH -+ SET-XCREATEWINDOWEVENT-OVERRIDE_REDIRECT XPARSEGEOMETRY -+ SET-XMOTIONEVENT-ROOT SET-XMOTIONEVENT-X_ROOT -+ SET-XMOTIONEVENT-Y_ROOT PICMENU-DRAW-BUTTON -+ SET-XFONTSTRUCT-ALL_CHARS_EXIST SET-XVISUALINFO-BITS_PER_RGB -+ SET-VERTEX-ARRAY SET-XMOTIONEVENT-SEND_EVENT -+ XCONFIGUREREQUESTEVENT-HEIGHT XWINDOWATTRIBUTES-HEIGHT XWARPPOINTER -+ XKEYMAPEVENT-SEND_EVENT SET-XMOTIONEVENT-DISPLAY -+ SET-XGRAVITYEVENT-SERIAL XCROSSINGEVENT-MODE SET-XMAPPINGEVENT-TYPE -+ XKEYMAPEVENT-DISPLAY SET-_XQEVENT-EVENT XRESOURCEMANAGERSTRING -+ SET-XIMAGE-HEIGHT SET-XGRAPHICSEXPOSEEVENT-SEND_EVENT -+ SET-XMOTIONEVENT-WINDOW SET-XMOTIONEVENT-SUBWINDOW -+ SET-XCREATEWINDOWEVENT-PARENT XKEYMAPEVENT-WINDOW -+ SET-XGRAPHICSEXPOSEEVENT-DISPLAY SET-_XQEVENT-NEXT XQUERYPOINTER -+ SET-CHAR-ARRAY ISCURSORKEY SET-XCREATEWINDOWEVENT-SEND_EVENT -+ XSAVECONTEXT SET-XWINDOWCHANGES-STACK_MODE -+ SET-XMAPEVENT-OVERRIDE_REDIRECT XGETCLASSHINT WINDOW-GET-ELLIPSE -+ PICMENU-ITEM-POSITION SET-XCREATEWINDOWEVENT-DISPLAY -+ XQUERYTEXTEXTENTS16 SET-XMAPPINGEVENT-SERIAL -+ SET-XMAPREQUESTEVENT-TYPE SET-XIMAGE-BITMAP_UNIT -+ SET-XVISUALINFO-DEPTH SET-XCROSSINGEVENT-TIME -+ SET-XCREATEWINDOWEVENT-WINDOW XNOEXPOSEEVENT-TYPE -+ SET-XVISUALINFO-COLORMAP_SIZE SET-XCROSSINGEVENT-TYPE -+ SET-XERROREVENT-TYPE XSIZEHINTS-MAX_ASPECT_X -+ XSIZEHINTS-MIN_ASPECT_X XGETTRANSIENTFORHINT MENU-FIND-ITEM-HEIGHT -+ XADDHOSTS SET-XVISUALINFO-VISUAL SET-XCROSSINGEVENT-STATE -+ XSIZEHINTS-MAX_ASPECT_Y XSIZEHINTS-MIN_ASPECT_Y SET-XMAPEVENT-EVENT -+ SET-XMAPEVENT-SEND_EVENT SET-XMAPREQUESTEVENT-SERIAL -+ XDESTROYWINDOWEVENT-EVENT XDESTROYWINDOWEVENT-SEND_EVENT -+ SET-XGRAVITYEVENT-X XFOCUSCHANGEEVENT-TYPE -+ SET-XSTANDARDCOLORMAP-COLORMAP SET-VISUAL-MAP_ENTRIES XDRAWTEXT16 -+ WINDOW-GET-BOX-SIZE MAKE-XSELECTIONCLEAREVENT -+ MAKE-XSELECTIONREQUESTEVENT MAKE-XSELECTIONEVENT -+ SET-XMAPEVENT-DISPLAY XDESTROYWINDOWEVENT-DISPLAY -+ XNOEXPOSEEVENT-SERIAL SET-XGRAVITYEVENT-Y XFETCHBUFFER -+ XGRAPHICSEXPOSEEVENT-HEIGHT WINDOW-SET-COLOR-RGB -+ SET-XCROSSINGEVENT-SERIAL SET-XERROREVENT-SERIAL -+ SET-XVISUALINFO-BLUE_MASK SET-XVISUALINFO-GREEN_MASK -+ SET-XVISUALINFO-RED_MASK SET-XWINDOWATTRIBUTES-DEPTH -+ SET-XMAPEVENT-WINDOW XDESTROYWINDOWEVENT-WINDOW -+ SET-XSIZEHINTS-HEIGHT_INC SET-XSIZEHINTS-WIDTH_INC XPOINTINREGION -+ GET-ST-POINT2 SET-XWINDOWATTRIBUTES-BORDER_WIDTH -+ SET-XWINDOWATTRIBUTES-WIDTH SET-XWINDOWCHANGES-BORDER_WIDTH -+ SET-XWINDOWCHANGES-WIDTH SET-VISUAL-CLASS GET-C-STRING XSETWMHINTS -+ SET-XWINDOWATTRIBUTES-BACKING_PIXEL MAKE-SCREEN SET-XEDATAOBJECT-GC -+ XFOCUSCHANGEEVENT-SERIAL XWHITEPIXELOFSCREEN XTEXTEXTENTS -+ SET-XWINDOWATTRIBUTES-VISUAL PICMENU-DELETE-NAMED-BUTTON -+ XARC-ANGLE1 SET-XCROSSINGEVENT-DETAIL XGRAPHICSEXPOSEEVENT-COUNT -+ XWRITEBITMAPFILE XMINCMAPSOFSCREEN -+ SET-XPIXMAPFORMATVALUES-SCANLINE_PAD WINDOW-GET-REGION -+ SET-XCROSSINGEVENT-SAME_SCREEN XMAXCMAPSOFSCREEN -+ SET-XSIZEHINTS-BASE_WIDTH SET-XSIZEHINTS-MAX_WIDTH -+ SET-XSIZEHINTS-MIN_WIDTH SET-XSIZEHINTS-WIDTH SET-XSEGMENT-X1 -+ XARC-ANGLE2 MAKE-XREPARENTEVENT SET-XSEGMENT-Y1 SET-SCREEN-ROOT -+ XFOCUSCHANGEEVENT-DETAIL XSETCLIPORIGIN SET-XSEGMENT-X2 -+ SET-XGRAVITYEVENT-EVENT SET-XGRAVITYEVENT-SEND_EVENT XPOINT-Y -+ XSETCLIPMASK SET-XSEGMENT-Y2 -+ SET-XWINDOWATTRIBUTES-DO_NOT_PROPAGATE_MASK -+ SET-XWINDOWATTRIBUTES-YOUR_EVENT_MASK XFILLARCS XDISPLAYHEIGHTMM -+ SET-XGRAVITYEVENT-DISPLAY XGETSTANDARDCOLORMAP XQUERYBESTTILE -+ XIMAGEBYTEORDER SET-XPROPERTYEVENT-TIME SCREEN-BLACK_PIXEL -+ SET-XGRAVITYEVENT-WINDOW SET-XPROPERTYEVENT-TYPE -+ SET-XCROSSINGEVENT-X XICONSIZE-HEIGHT_INC SET-XWINDOWATTRIBUTES-X -+ SET-XWINDOWCHANGES-X SET-XPIXMAPFORMATVALUES-DEPTH XGETSIZEHINTS -+ SET-XWINDOWATTRIBUTES-BACKING_PLANES XQUERYBESTCURSOR -+ SET-XPROPERTYEVENT-STATE SET-XCROSSINGEVENT-Y XSETWMPROPERTIES -+ WINDOW-GET-CROSSHAIRS SET-XWINDOWATTRIBUTES-Y SET-XWINDOWCHANGES-Y -+ SET-XMAPPINGEVENT-SEND_EVENT SET-XPIXMAPFORMATVALUES-BITS_PER_PIXEL -+ MAKE-XCLASSHINT XCREATEBITMAPFROMDATA XALLOCCLASSHINT -+ SET-XMAPPINGEVENT-DISPLAY SET-XWINDOWATTRIBUTES-ALL_EVENT_MASKS -+ XQUERYBESTSTIPPLE SET-XPROPERTYEVENT-SERIAL -+ SET-XMAPPINGEVENT-WINDOW SET-XMAPREQUESTEVENT-PARENT -+ WINDOW-SET-FOREGROUND WINDOW-SET-BACKGROUND WINDOW-GET-POINT -+ SET-XWINDOWATTRIBUTES-HEIGHT SET-XWINDOWCHANGES-HEIGHT -+ XGETWMCLIENTMACHINE XGETERRORDATABASETEXT XSTRINGLISTTOTEXTPROPERTY -+ SET-XMAPREQUESTEVENT-SEND_EVENT XGETERRORTEXT XSETCLIPRECTANGLES -+ XGETTEXTPROPERTY XSETCLASSHINT XCROSSINGEVENT-FOCUS -+ SET-XMAPREQUESTEVENT-DISPLAY XDRAWSTRING XNOEXPOSEEVENT-SEND_EVENT -+ MAKE-XRESIZEREQUESTEVENT XGETMODIFIERMAPPING XDEFAULTDEPTH -+ SET-XCROSSINGEVENT-ROOT SET-XCROSSINGEVENT-X_ROOT -+ SET-XCROSSINGEVENT-Y_ROOT XLISTPROPERTIES SET-XEDATAOBJECT-SCREEN -+ XSTANDARDCOLORMAP-KILLID MAKE-XEDATAOBJECT XNOEXPOSEEVENT-DISPLAY -+ SET-XSIZEHINTS-BASE_HEIGHT SET-XSIZEHINTS-MAX_HEIGHT -+ SET-XSIZEHINTS-MIN_HEIGHT SET-XSIZEHINTS-HEIGHT -+ SET-XCROSSINGEVENT-SEND_EVENT MAKE-XSTANDARDCOLORMAP -+ XALLOCSTANDARDCOLORMAP SET-XMAPREQUESTEVENT-WINDOW CALLOC -+ XNEXTEVENT ISKEYPADKEY XSENDEVENT SET-XCROSSINGEVENT-DISPLAY -+ SET-XERROREVENT-DISPLAY WINDOW-INVERT-AREA WINDOW-INVERTAREA -+ XADDHOST XSETFONT XGCVALUES-CAP_STYLE XDEFAULTVISUAL -+ XFOCUSCHANGEEVENT-SEND_EVENT XSETTRANSIENTFORHINT MENU -+ SET-XCROSSINGEVENT-WINDOW SET-XCROSSINGEVENT-SUBWINDOW -+ XICONSIZE-MAX_WIDTH XICONSIZE-MIN_WIDTH XENABLEACCESSCONTROL -+ XMAPSUBWINDOWS XFOCUSCHANGEEVENT-DISPLAY WINDOW-GET-GEOMETRY -+ XCONVERTSELECTION WINDOW-SET-LINE-WIDTH MENU-CLEAR -+ XKEYBOARDCONTROL-BELL_DURATION XFOCUSCHANGEEVENT-WINDOW -+ XSETACCESSCONTROL MAKE-XCHARSTRUCT XCHANGEKEYBOARDMAPPING -+ XDISPLAYOFSCREEN XGCVALUES-FILL_RULE XAUTOREPEATOFF -+ XEXTCODES-FIRST_ERROR XGCVALUES-FILL_STYLE -+ SET-XEDATAOBJECT-PIXMAP_FORMAT WINDOW-FOREGROUND XSETERRORHANDLER -+ XSTOREBUFFER XFILLARC WINDOW-BACKGROUND SET-XEDATAOBJECT-FONT -+ XMAPREQUESTEVENT-TYPE XANYEVENT-TYPE MENU-DRAW MAKE-XCONFIGUREEVENT -+ MAKE-XCONFIGUREREQUESTEVENT XEXTCODES-FIRST_EVENT LISP-STRING -+ XDRAWRECTANGLE XIMAGE-BITMAP_PAD XIMAGE-BLUE_MASK -+ MAKE-XCLIENTMESSAGEEVENT XTEXTITEM16-FONT VISUAL-BLUE_MASK -+ XKEYBOARDSTATE-BELL_DURATION XGCVALUES-JOIN_STYLE -+ XGETSELECTIONOWNER XTEXTITEM16-NCHARS XTEXTITEM16-CHARS -+ XUNGRABBUTTON XMAPREQUESTEVENT-SERIAL SET-XCOLOR-PIXEL -+ SET-XSIZEHINTS-MAX_ASPECT_X SET-XSIZEHINTS-MIN_ASPECT_X -+ XUNGRABPOINTER SET-XPROPERTYEVENT-SEND_EVENT XSETSTANDARDCOLORMAP -+ XSERVERVENDOR XRECTANGLE-WIDTH XCLASSHINT-RES_NAME SCREEN-MWIDTH -+ SCREEN-WIDTH XICONSIZE-WIDTH_INC XPLANESOFSCREEN -+ XCIRCULATESUBWINDOWSUP WINDOW-ERASE-AREA XUNGRABSERVER -+ MAKE-XBUTTONEVENT XCHANGEKEYBOARDCONTROL -+ SET-XSIZEHINTS-MAX_ASPECT_Y SET-XSIZEHINTS-MIN_ASPECT_Y -+ SET-XPROPERTYEVENT-DISPLAY XKEYBOARDSTATE-GLOBAL_AUTO_REPEAT -+ VISUAL-VISUALID XFILLRECTANGLE XHEIGHTOFSCREEN XCOLOR-PIXEL -+ XLOADFONT XLISTFONTS XHOSTADDRESS-LENGTH XEXPOSEEVENT-TYPE -+ XGCVALUES-LINE_STYLE WINDOW-TOP-NEG-Y MAKE-XCIRCULATEEVENT -+ MAKE-XCIRCULATEREQUESTEVENT XTRANSLATECOORDINATES -+ MENU-ITEM-POSITION XSETSIZEHINTS XSTANDARDCOLORMAP-COLORMAP -+ SET-XPROPERTYEVENT-WINDOW XICONSIZE-MAX_HEIGHT XICONSIZE-MIN_HEIGHT -+ XGETCOMMAND WINDOW-STD-LINE-ATTR WINDOW-SET-LINE-ATTR -+ XUNINSTALLCOLORMAP MAKE-SCREENFORMAT XGRAVITYEVENT-X SCREEN-CMAP -+ XSELECTIONCLEAREVENT-TIME XALLOCNAMEDCOLOR XHEIGHTMMOFSCREEN -+ XQUERYFONT SCREENFORMAT-EXT_DATA SET-XFOCUSCHANGEEVENT-MODE -+ WINDOW-SET-XCOLOR WINDOW-SET-COLOR XBITMAPPAD -+ XCLIENTMESSAGEEVENT-MESSAGE_TYPE XCLIENTMESSAGEEVENT-TYPE -+ XGRAVITYEVENT-Y XSELECTIONCLEAREVENT-TYPE MAKE-XDESTROYWINDOWEVENT -+ WINDOW-SYNC XGCVALUES-TILE XCLOSEDISPLAY XGCVALUES-DASH_OFFSET -+ XEXPOSEEVENT-SERIAL XQUERYKEYMAP WINDOW-ADJUST-BOX-SIDE -+ VISUAL-BITS_PER_RGB WINDOW-CREATE XSETSTANDARDPROPERTIES -+ XSELECTIONEVENT-TIME XIMAGE-GREEN_MASK XGCVALUES-FUNCTION -+ XSETWMCLIENTMACHINE SET-XREPARENTEVENT-TYPE XSELECTIONEVENT-TYPE -+ XTEXTPROPERTY-ENCODING XCREATECOLORMAP XSHRINKREGION SET-INT-ARRAY -+ VISUAL-GREEN_MASK XCREATEPIXMAPFROMBITMAPDATA CHAR-ARRAY -+ SET-XRECTANGLE-X XSETTEXTPROPERTY XCLIENTMESSAGEEVENT-SERIAL -+ MAKE-XCOLORMAPEVENT SET-XGCVALUES-STIPPLE XFREESTRINGLIST -+ XSELECTIONCLEAREVENT-SERIAL XSETMODIFIERMAPPING WINDOW-MOVE -+ XCREATEPIXMAP BARMENU-SELECT SET-XGCVALUES-FILL_RULE -+ SET-XRECTANGLE-Y WINDOW-LABEL SET-XGCVALUES-TILE -+ SET-XGCVALUES-FILL_STYLE SET-XGCVALUES-JOIN_STYLE -+ SET-XGCVALUES-CAP_STYLE SET-XGCVALUES-LINE_STYLE XPENDING -+ XIMAGE-DEPTH XGCVALUES-STIPPLE BARMENU-DRAW XSYNC XIMAGE-WIDTH -+ SET-XREPARENTEVENT-SERIAL XSELECTIONEVENT-SERIAL WINDOW-SIZE -+ XLISTHOSTS XIMAGE-BITS_PER_PIXEL XQUERYCOLORS MAKE-XMODIFIERKEYMAP -+ XCOLORMAPEVENT-NEW XLISTPIXMAPFORMATS XFONTSTRUCT-EXT_DATA -+ XRMINITIALIZE XRECTANGLE-HEIGHT XKEYEVENT-TIME SCREEN-MHEIGHT -+ SCREEN-HEIGHT SET-XRESIZEREQUESTEVENT-TYPE SET-XKEYEVENT-X -+ SET-XCOLOR-PAD WINDOW-FREE-COLOR XEDATAOBJECT-VISUAL -+ XMAPPINGEVENT-FIRST_KEYCODE XARC-X XPUTBACKEVENT XKEYEVENT-TYPE -+ SET-XUNMAPEVENT-FROM_CONFIGURE XNEWMODIFIERMAP XGRAVITYEVENT-TYPE -+ SET-XKEYEVENT-Y SET-XCOLOR-RED XRESTACKWINDOWS XWITHDRAWWINDOW -+ XCHANGEGC MENU-REPOSITION XMAPREQUESTEVENT-PARENT MAKE-XEVENT -+ XEXPOSEEVENT-X VERTEX-POS-X SCREEN-MIN_MAPS SCREEN-MAX_MAPS -+ XKEYEVENT-STATE XPROPERTYEVENT-TIME WINDOW-QUERY-POINTER-B -+ MAKE-XCROSSINGEVENT XFREEFONT XKILLCLIENT -+ XMAPREQUESTEVENT-SEND_EVENT WINDOW-OPEN XIMAGE-RED_MASK -+ WINDOW-SET-XOR XCHARSTRUCT-RBEARING XCHARSTRUCT-LBEARING -+ XGETWINDOWATTRIBUTES XEXPOSEEVENT-Y XPROPERTYEVENT-TYPE -+ VERTEX-POS-Y XSTORECOLORS XCREATEWINDOWEVENT-TYPE -+ XMAPREQUESTEVENT-DISPLAY MENU-SELECT XSELECTIONCLEAREVENT-SELECTION -+ MAKE-XCREATEWINDOWEVENT SET-XRESIZEREQUESTEVENT-SERIAL -+ XDEFINECURSOR XMAPEVENT-TYPE VISUAL-RED_MASK XTEXTWIDTH XGRABBUTTON -+ XREFRESHKEYBOARDMAPPING XHOSTADDRESS-ADDRESS XGETWMCOLORMAPWINDOWS -+ XPROPERTYEVENT-STATE MENU-ADJUST-OFFSET XGRAVITYEVENT-SERIAL -+ XMAPREQUESTEVENT-WINDOW XVISUALINFO-VISUALID GET-ST-POINT -+ XGRABSERVER XANYEVENT-DISPLAY XIMAGE-BITMAP_UNIT -+ XCLIENTMESSAGEEVENT-FORMAT XSELECTIONEVENT-SELECTION -+ SET-XSELECTIONCLEAREVENT-TIME SET-XSELECTIONREQUESTEVENT-TIME -+ SET-XSELECTIONEVENT-TIME MAKE-XVISIBILITYEVENT XKEYSYMTOKEYCODE -+ SET-XREPARENTEVENT-X WINDOW-TRACK-MOUSE XPROPERTYEVENT-SERIAL -+ XCREATEWINDOWEVENT-SERIAL XSETWINDOWBACKGROUND -+ SET-XSELECTIONCLEAREVENT-TYPE SET-XSELECTIONREQUESTEVENT-TYPE -+ SET-XSELECTIONEVENT-TYPE WINDOW-FONT-STRING-WIDTH XFREECURSOR -+ XCREATEGLYPHCURSOR XSETSELECTIONOWNER SET-XWMHINTS-ICON_MASK -+ XCREATEWINDOW WINDOW-DRAWABLE-WIDTH STRINGIFY XCLASSHINT-RES_CLASS -+ SET-XREPARENTEVENT-Y XQLENGTH WINDOW-RESET MENU-UNBOX-ITEM -+ SET-XNOEXPOSEEVENT-MINOR_CODE SET-XNOEXPOSEEVENT-MAJOR_CODE -+ XEXPOSEEVENT-SEND_EVENT XANYEVENT-SERIAL XGEOMETRY -+ XVISUALINFO-BITS_PER_RGB MAKE-XFONTPROP XGCVALUES-FONT -+ SET-XKEYEVENT-TIME XEXPOSEEVENT-DISPLAY -+ SET-XREPARENTEVENT-OVERRIDE_REDIRECT SET-XGCVALUES-FUNCTION -+ XIMAGE-HEIGHT XDELETECONTEXT PICMENU-SELECT WINDOW-PAINT -+ SET-XFONTSTRUCT-MAX_BYTE1 SET-XFONTSTRUCT-MIN_BYTE1 -+ XSELECTIONEVENT-TARGET SET-XKEYEVENT-TYPE WINDOW-XINIT -+ SET-XNOEXPOSEEVENT-DRAWABLE SET-XGCVALUES-DASH_OFFSET -+ XSELECTIONREQUESTEVENT-TIME XCREATEFONTCURSOR WINDOW-DRAW-BOX -+ XSETCOMMAND XEXPOSEEVENT-WINDOW XTEXTPROPERTY-FORMAT -+ SET-XSELECTIONCLEAREVENT-SERIAL SET-XSELECTIONREQUESTEVENT-SERIAL -+ SET-XSELECTIONEVENT-SERIAL XCLIENTMESSAGEEVENT-SEND_EVENT -+ WINDOW-POLL-MOUSE PICMENU-DRAW SET-XFONTSTRUCT-MAX_CHAR_OR_BYTE2 -+ SET-XFONTSTRUCT-MIN_CHAR_OR_BYTE2 XDESTROYIMAGE -+ XSELECTIONCLEAREVENT-SEND_EVENT SET-XKEYEVENT-STATE -+ XSELECTIONREQUESTEVENT-TYPE WINDOW-FONT-INFO -+ XSETWINDOWATTRIBUTES-BACKING_PIXEL -+ XSETWINDOWATTRIBUTES-BORDER_PIXEL -+ XSETWINDOWATTRIBUTES-BACKGROUND_PIXEL XCLIENTMESSAGEEVENT-DISPLAY -+ XSELECTIONCLEAREVENT-DISPLAY XCHECKTYPEDEVENT -+ XCHECKTYPEDWINDOWEVENT SET-XBUTTONEVENT-TIME XKEYEVENT-X -+ XCHANGEPOINTERCONTROL XSETWINDOWBORDERWIDTH -+ SET-XDESTROYWINDOWEVENT-TYPE SET-XREPARENTEVENT-PARENT -+ SET-XBUTTONEVENT-TYPE SET-XGCVALUES-FONT XCLIENTMESSAGEEVENT-WINDOW -+ XSELECTIONCLEAREVENT-WINDOW SET-XSETWINDOWATTRIBUTES-BACKING_STORE -+ XKEYEVENT-Y XTEXTPROPERTY-NITEMS SET-XREPARENTEVENT-EVENT -+ SET-XREPARENTEVENT-SEND_EVENT SET-XKEYEVENT-SERIAL -+ XSELECTIONEVENT-SEND_EVENT WINDOW-MENU WINDOW-INVERT-AREA-XY -+ SET-XBUTTONEVENT-STATE XVISUALINFO-DEPTH SET-XREPARENTEVENT-DISPLAY -+ XSELECTIONEVENT-DISPLAY WINDOW-TRACK-MOUSE-IN-REGION -+ XINSERTMODIFIERMAPENTRY WINDOW-DRAW-CARAT XCREATEWINDOWEVENT-X -+ XTEXTPROPERTYTOSTRINGLIST SET-SCREEN-ROOT_DEPTH -+ XSELECTIONREQUESTEVENT-SERIAL WINDOW-STRING-WIDTH MENU-DESTROY -+ XSETWINDOWATTRIBUTES-DO_NOT_PROPAGATE_MASK -+ XSETWINDOWATTRIBUTES-EVENT_MASK SET-XREPARENTEVENT-WINDOW -+ XVISUALINFO-COLORMAP_SIZE SET-SCREEN-MWIDTH SET-SCREEN-WIDTH -+ XINTERNATOM SET-XKEYBOARDCONTROL-BELL_DURATION -+ SET-XKEYBOARDSTATE-BELL_DURATION XCREATEWINDOWEVENT-Y MENU-OFFSET -+ SET-XDESTROYWINDOWEVENT-SERIAL SET-SCREEN-BLACK_PIXEL -+ SET-SCREEN-WHITE_PIXEL SCREEN-ROOT_DEPTH XLISTDEPTHS XLOADQUERYFONT -+ SET-XBUTTONEVENT-SERIAL XVISUALINFO-VISUAL XFREE WINDOW-SET-COPY -+ SET-SCREEN-ROOT_VISUAL XTEXTITEM-NCHARS SET-XKEYEVENT-SAME_SCREEN -+ XTEXTITEM-FONT XCREATEWINDOWEVENT-OVERRIDE_REDIRECT XTEXTITEM-CHARS -+ SET-XSELECTIONCLEAREVENT-SELECTION -+ SET-XSELECTIONREQUESTEVENT-SELECTION SET-XSELECTIONEVENT-SELECTION -+ SET-XKEYBOARDSTATE-GLOBAL_AUTO_REPEAT XFONTSTRUCT-DIRECTION -+ WINDOW-GEOMETRY XCREATEPIXMAPCURSOR -+ XSETWINDOWATTRIBUTES-BACKING_PLANES XUNLOADFONT SCREEN-ROOT_VISUAL -+ SET-XRESIZEREQUESTEVENT-SEND_EVENT MAKE-XUNMAPEVENT -+ WINDOW-DRAWABLE-HEIGHT XKEYEVENT-ROOT XDELETEMODIFIERMAPENTRY -+ XSELECTINPUT SET-XRESIZEREQUESTEVENT-DISPLAY XWMHINTS-FLAGS -+ XGETGCVALUES XVISUALINFO-BLUE_MASK XVISUALINFO-GREEN_MASK -+ XVISUALINFO-RED_MASK XGRAVITYEVENT-EVENT XGRAVITYEVENT-SEND_EVENT -+ CHAR-POS WINDOW-INIT-KEYMAP SET-SCREEN-ROOT_INPUT_MASK -+ WINDOW-DRAW-ELLIPSE-PT WINDOW-DRAW-CIRCLE-PT -+ SET-XBUTTONEVENT-SAME_SCREEN XVISUALIDFROMVISUAL DEPTH-NVISUALS -+ XGRAVITYEVENT-DISPLAY WINDOW-RESET-COLOR -+ SET-XRESIZEREQUESTEVENT-WINDOW ISFUNCTIONKEY -+ XCREATEWINDOWEVENT-PARENT WINDOW-SCREEN-HEIGHT -+ XFONTSTRUCT-PROPERTIES XFONTSTRUCT-N_PROPERTIES MENU-BOX-ITEM -+ SET-XSETWINDOWATTRIBUTES-COLORMAP SCREEN-ROOT_INPUT_MASK -+ PICMENU-DESTROY XPROPERTYEVENT-SEND_EVENT -+ XCREATEWINDOWEVENT-SEND_EVENT SET-XSELECTIONREQUESTEVENT-TARGET -+ SET-XSELECTIONEVENT-TARGET XGRAVITYEVENT-WINDOW XSTORENAMEDCOLOR -+ MAKE-XGCVALUES XKEYEVENT-DISPLAY XSELECTIONREQUESTEVENT-SELECTION -+ XMAPEVENT-EVENT XPROPERTYEVENT-DISPLAY SET-XTEXTPROPERTY-ENCODING -+ XCREATEWINDOWEVENT-DISPLAY SET-XSETWINDOWATTRIBUTES-BORDER_PIXMAP -+ SET-XSETWINDOWATTRIBUTES-BACKGROUND_PIXMAP XGETWMNORMALHINTS -+ SET-XCONFIGUREEVENT-BORDER_WIDTH SET-XCONFIGUREEVENT-WIDTH -+ SET-XCONFIGUREREQUESTEVENT-BORDER_WIDTH -+ SET-XCONFIGUREREQUESTEVENT-WIDTH XANYEVENT-SEND_EVENT -+ XDESTROYREGION SET-XKEYMAPEVENT-TYPE SET-XARC-ANGLE1 -+ WINDOW-MOVETO-XY XPROPERTYEVENT-WINDOW SET-XBUTTONEVENT-BUTTON -+ XCREATEWINDOWEVENT-WINDOW XSETWMCOLORMAPWINDOWS -+ SET-XSETWINDOWATTRIBUTES-SAVE_UNDER SET-XBUTTONEVENT-X -+ SET-XFONTSTRUCT-FID WINDOW-ERASE-AREA-XY XMAPEVENT-DISPLAY -+ XKEYEVENT-SERIAL XFREEFONTINFO SET-XARC-ANGLE2 XMAPPINGEVENT-COUNT -+ SET-XCOMPOSESTATUS-CHARS_MATCHED XCHAR2B-BYTE1 -+ SET-XSELECTIONCLEAREVENT-SEND_EVENT -+ SET-XSELECTIONREQUESTEVENT-SEND_EVENT -+ SET-XSELECTIONEVENT-SEND_EVENT XERROREVENT-TYPE SET-XBUTTONEVENT-Y -+ XWMHINTS-INPUT XWMHINTS-ICON_PIXMAP SCREEN-WHITE_PIXEL -+ XCONFIGUREEVENT-ABOVE XUNMAPSUBWINDOWS -+ XSELECTIONREQUESTEVENT-TARGET SET-XSELECTIONCLEAREVENT-DISPLAY -+ SET-XSELECTIONREQUESTEVENT-DISPLAY SET-XSELECTIONEVENT-DISPLAY -+ XCHAR2B-BYTE2 SET-SCREEN-MHEIGHT SET-SCREEN-HEIGHT -+ SET-XSETWINDOWATTRIBUTES-OVERRIDE_REDIRECT XROTATEBUFFERS -+ SET-XKEYMAPEVENT-SERIAL XBLACKPIXEL XTEXTEXTENTS16 -+ SET-XCONFIGUREREQUESTEVENT-VALUE_MASK SET-XWMHINTS-ICON_X -+ MAKE-XERROREVENT COMPILE-DWINDOW WINDOW-STRING-EXTENTS -+ SET-XSELECTIONCLEAREVENT-WINDOW XFREEFONTNAMES -+ XFONTSTRUCT-ALL_CHARS_EXIST XMAPEVENT-SERIAL SET-XKEYEVENT-ROOT -+ SET-XKEYEVENT-X_ROOT SET-XKEYEVENT-Y_ROOT WINDOW-RESET-GEOMETRY -+ SET-XSETWINDOWATTRIBUTES-CURSOR XCONFIGUREEVENT-TYPE -+ XMAPPINGEVENT-REQUEST SET-XKEYEVENT-SEND_EVENT XFLUSH -+ WINDOW-DRAW-ARC-XY MAKE-XARC XREMOVEHOST XKEYEVENT-SAME_SCREEN -+ WINDOW-COPY-AREA-XY SET-XWMHINTS-ICON_Y WINDOW-DRAW-ELLIPSE-XY -+ WINDOW-DRAW-CIRCLE-XY WINDOW-DRAW-LINE-XY XERROREVENT-SERIAL -+ SET-SCREEN-MIN_MAPS SET-SCREEN-MAX_MAPS SET-XKEYEVENT-DISPLAY -+ MAKE-XWINDOWCHANGES XSELECTIONREQUESTEVENT-SEND_EVENT -+ SET-DEPTH-DEPTH SET-XCHARSTRUCT-RBEARING SET-XCHARSTRUCT-LBEARING -+ XGETWINDOWPROPERTY XANYEVENT-WINDOW XFILLPOLYGON -+ XSELECTIONREQUESTEVENT-DISPLAY XWMHINTS-INITIAL_STATE -+ SET-XKEYEVENT-WINDOW SET-XKEYEVENT-SUBWINDOW XDRAWPOINTS INT-POS -+ SET-XBUTTONEVENT-ROOT SET-XBUTTONEVENT-X_ROOT -+ SET-XBUTTONEVENT-Y_ROOT SET-XDESTROYWINDOWEVENT-EVENT -+ SET-XDESTROYWINDOWEVENT-SEND_EVENT XICONIFYWINDOW -+ SET-XBUTTONEVENT-SEND_EVENT XLASTKNOWNREQUESTPROCESSED -+ SET-XDESTROYWINDOWEVENT-DISPLAY XADDTOEXTENSIONLIST -+ XCONFIGUREEVENT-SERIAL XGETICONSIZES WINDOW-DRAW-CROSS-XY -+ WINDOW-DRAW-CROSSHAIRS-XY XCREATESIMPLEWINDOW -+ SET-XBUTTONEVENT-DISPLAY XRECTINREGION XREPARENTWINDOW -+ MAKE-XFONTSTRUCT XRESIZEWINDOW SET-XDESTROYWINDOWEVENT-WINDOW -+ WINDOW-DRAW-ARROW-XY WINDOW-WAIT-EXPOSURE MENU-SIZE -+ XMAPEVENT-OVERRIDE_REDIRECT SET-XBUTTONEVENT-WINDOW -+ SET-XBUTTONEVENT-SUBWINDOW SET-XGRAPHICSEXPOSEEVENT-MINOR_CODE -+ SET-XGRAPHICSEXPOSEEVENT-MAJOR_CODE XCLEARWINDOW -+ BARMENU-UPDATE-VALUE SET-XCONFIGUREEVENT-HEIGHT -+ SET-XCONFIGUREREQUESTEVENT-HEIGHT SET-XCOLORMAPEVENT-NEW -+ SET-XEXPOSEEVENT-TYPE SET-XGRAPHICSEXPOSEEVENT-DRAWABLE -+ XMOVERESIZEWINDOW XREPARENTEVENT-TYPE XCOLOR-PAD -+ XWMHINTS-ICON_WINDOW XGETZOOMHINTS MAKE-XFOCUSCHANGEEVENT -+ MAKE-XTEXTITEM16 XUNIQUECONTEXT XWMHINTS-WINDOW_GROUP -+ SET-XTEXTPROPERTY-FORMAT XWINDOWATTRIBUTES-MAP_INSTALLED XDRAWPOINT -+ XCOPYGC SET-XEXPOSEEVENT-SERIAL MAKE-XEXPOSEEVENT SET-XIMAGE-OBDATA -+ XCHECKWINDOWEVENT SET-XSETWINDOWATTRIBUTES-WIN_GRAVITY -+ SET-XSETWINDOWATTRIBUTES-BIT_GRAVITY XCONFIGUREEVENT-X XCOLOR-RED -+ XREPARENTEVENT-SERIAL XKEYEVENT-SEND_EVENT MAKE-XPOINT XTEXTWIDTH16 -+ MAKE-XHOSTADDRESS XCONFIGUREEVENT-Y SET-XTEXTPROPERTY-NITEMS -+ SET-SCREENFORMAT-SCANLINE_PAD WINDOW-MAP -+ XCOMPOSESTATUS-CHARS_MATCHED MAKE-_XQEVENT SET-XTEXTITEM-FONT -+ SET-XTEXTITEM16-FONT MAKE-XGRAPHICSEXPOSEEVENT -+ XRESIZEREQUESTEVENT-TYPE XWMGEOMETRY XKEYEVENT-SUBWINDOW -+ XCONFIGUREREQUESTEVENT-ABOVE SET-XKEYMAPEVENT-SEND_EVENT -+ SET-XTEXTITEM-NCHARS SET-XTEXTITEM-CHARS SET-XTEXTITEM16-NCHARS -+ SET-XTEXTITEM16-CHARS XMODIFIERKEYMAP-MAX_KEYPERMOD XBITMAPUNIT -+ XCONFIGUREEVENT-OVERRIDE_REDIRECT XGETGEOMETRY XMAPEVENT-SEND_EVENT -+ XWINDOWCHANGES-SIBLING SET-XKEYMAPEVENT-DISPLAY XPOLYGONREGION -+ XROTATEWINDOWPROPERTIES MAKE-XGRAVITYEVENT XSETWMNORMALHINTS -+ MENU-MOVETO-XY DOWINDOWCOM SET-XGRAPHICSEXPOSEEVENT-WIDTH -+ SET-XIMAGE-BYTES_PER_LINE XSCREENCOUNT XALLPLANES -+ SET-XKEYMAPEVENT-WINDOW XDISPLAYWIDTH XCONFIGUREREQUESTEVENT-TYPE -+ SET-XFONTSTRUCT-PER_CHAR SET-XFONTSTRUCT-DEFAULT_CHAR -+ XGETWMICONNAME XERROREVENT-DISPLAY XWINDOWATTRIBUTES-BACKING_STORE -+ MAKE-XCHAR2B SET-VISUAL-VISUALID PICMENU-CREATE-FROM-SPEC -+ PICMENU-CREATE-SPEC XRESIZEREQUESTEVENT-SERIAL -+ XPIXMAPFORMATVALUES-SCANLINE_PAD XKEYEVENT-X_ROOT -+ SET-XCREATEWINDOWEVENT-BORDER_WIDTH SET-XCREATEWINDOWEVENT-WIDTH -+ XWINDOWATTRIBUTES-MAP_STATE SET-SCREENFORMAT-DEPTH XGETWMPROTOCOLS -+ SET-XEXPOSEEVENT-X XKEYEVENT-Y_ROOT XCONFIGUREEVENT-EVENT -+ XCONFIGUREEVENT-SEND_EVENT XSETTSORIGIN XKEYEVENT-WINDOW -+ SET-SCREENFORMAT-BITS_PER_PIXEL SET-XHOSTADDRESS-FAMILY -+ XGETKEYBOARDMAPPING XCONFIGUREEVENT-DISPLAY XREPARENTEVENT-X -+ SET-XEXPOSEEVENT-Y ISMODIFIERKEY XCONFIGUREREQUESTEVENT-SERIAL -+ XSETLINEATTRIBUTES XSETIOERRORHANDLER WINDOW-GET-GEOMETRY-B -+ XREPARENTEVENT-Y XCONFIGUREEVENT-WINDOW SET-VISUAL-BITS_PER_RGB -+ MENU-SELECT! BARMENU-CALCULATE-SIZE XLOWERWINDOW XSTORENAME -+ XMAPEVENT-WINDOW XUNGRABKEY XPIXMAPFORMATVALUES-DEPTH -+ SET-XSTANDARDCOLORMAP-VISUALID XREPARENTEVENT-OVERRIDE_REDIRECT -+ SET-XFONTSTRUCT-MAX_BOUNDS SET-XFONTSTRUCT-MIN_BOUNDS -+ XCONFIGUREREQUESTEVENT-DETAIL SET-XFONTSTRUCT-DESCENT -+ SET-XFONTSTRUCT-ASCENT XLISTINSTALLEDCOLORMAPS -+ XPIXMAPFORMATVALUES-BITS_PER_PIXEL XDISPLAYPLANES -+ SET-XMAPPINGEVENT-FIRST_KEYCODE XGETINPUTFOCUS PICMENU-UNBOX-ITEM -+ XUNMAPEVENT-TYPE XWINDOWATTRIBUTES-SCREEN XSETICONSIZES -+ XMODIFIERKEYMAP-MODIFIERMAP XWINDOWATTRIBUTES-COLORMAP -+ XSIZEHINTS-FLAGS XINIT SET-XEXPOSEEVENT-SEND_EVENT XCOPYPLANE -+ XREPARENTEVENT-PARENT SET-XCOMPOSESTATUS-COMPOSE_PTR -+ SET-XCIRCULATEEVENT-PLACE SET-XCIRCULATEREQUESTEVENT-PLACE -+ SET-XEXPOSEEVENT-DISPLAY XGRAPHICSEXPOSEEVENT-TYPE XFREEPIXMAP -+ XDISPLAYCELLS SET-XTIMECOORD-TIME XREPARENTEVENT-EVENT -+ XREPARENTEVENT-SEND_EVENT MENU-CREATE XGETKEYBOARDCONTROL -+ MENU-CALCULATE-SIZE SET-XGRAPHICSEXPOSEEVENT-HEIGHT -+ XGETFONTPROPERTY XUNMAPEVENT-SERIAL XREPARENTEVENT-DISPLAY -+ XDISPLAYHEIGHT SET-XEXPOSEEVENT-WINDOW XCIRCULATEEVENT-PLACE -+ SET-XEXTCODES-FIRST_ERROR XCONFIGUREREQUESTEVENT-X XGETSUBIMAGE -+ XLOOKUPKEYSYM XACTIVATESCREENSAVER XWINDOWATTRIBUTES-SAVE_UNDER -+ XNOEXPOSEEVENT-MINOR_CODE XNOEXPOSEEVENT-MAJOR_CODE -+ XRECONFIGUREWMWINDOW XLOOKUPCOLOR XSETZOOMHINTS -+ SET-XCREATEWINDOWEVENT-HEIGHT XREPARENTEVENT-WINDOW -+ XCONFIGUREREQUESTEVENT-Y SET-XERROREVENT-MINOR_CODE -+ SET-XERROREVENT-REQUEST_CODE SET-XERROREVENT-ERROR_CODE -+ SET-XERROREVENT-RESOURCEID SET-XARC-WIDTH XSETREGION -+ SET-XVISIBILITYEVENT-TYPE XGRAPHICSEXPOSEEVENT-SERIAL -+ XNOEXPOSEEVENT-DRAWABLE XXORREGION SET-XGRAPHICSEXPOSEEVENT-COUNT -+ SET-XIMAGE-XOFFSET SET-XIMAGE-BITMAP_BIT_ORDER -+ SET-XIMAGE-BYTE_ORDER XWINDOWATTRIBUTES-OVERRIDE_REDIRECT -+ SET-XEXTCODES-FIRST_EVENT XSETCLOSEDOWNMODE XRAISEWINDOW -+ SET-XVISIBILITYEVENT-STATE SET-XCROSSINGEVENT-MODE XREADBITMAPFILE -+ SET-VISUAL-BLUE_MASK SET-VISUAL-GREEN_MASK SET-VISUAL-RED_MASK -+ SET-XIMAGE-FORMAT SET-SCREEN-CMAP SET-XCIRCULATEEVENT-TYPE -+ SET-XCIRCULATEREQUESTEVENT-TYPE XMAXREQUESTSIZE -+ XRESIZEREQUESTEVENT-SEND_EVENT XGRABKEY -+ SET-XWINDOWATTRIBUTES-MAP_INSTALLED -+ SET-XSTANDARDCOLORMAP-BASE_PIXEL XWINDOWATTRIBUTES-CLASS -+ XLISTFONTSWITHINFO XRESIZEREQUESTEVENT-DISPLAY -+ XFOCUSCHANGEEVENT-MODE XEVENTSQUEUED SET-XVISIBILITYEVENT-SERIAL -+ XDRAWTEXT XCIRCULATEEVENT-TYPE INT-ARRAY XMAPRAISED -+ XCONFIGUREREQUESTEVENT-PARENT WINDOW-GET-CIRCLE -+ XKEYBOARDCONTROL-LED XWINDOWATTRIBUTES-ROOT -+ XRESIZEREQUESTEVENT-WINDOW XWHITEPIXEL XCREATEGC -+ XCONFIGUREREQUESTEVENT-SEND_EVENT PICMENU-CALCULATE-SIZE -+ XDRAWIMAGESTRING16 XCROSSINGEVENT-TIME -+ XCONFIGUREREQUESTEVENT-DISPLAY SET-XCIRCULATEEVENT-SERIAL -+ SET-XCIRCULATEREQUESTEVENT-SERIAL XUNMAPWINDOW XCROSSINGEVENT-TYPE -+ SET-XCLASSHINT-RES_NAME MAKE-XKEYMAPEVENT XSETWMICONNAME -+ MAKE-XKEYBOARDSTATE XEMPTYREGION XCLIPBOX XSETSTIPPLE XEQUALREGION -+ XFORCESCREENSAVER XCONFIGUREREQUESTEVENT-WINDOW -+ XCIRCULATEEVENT-SERIAL PICMENU-BUTTON-CONTAINSXY? XWINDOWEVENT -+ WINDOW-GET-CLICK XCROSSINGEVENT-STATE XGRAPHICSEXPOSEEVENT-X -+ XSETWMPROTOCOLS XSIZEHINTS-WIN_GRAVITY XGRAPHICSEXPOSEEVENT-Y -+ SET-XWINDOWCHANGES-SIBLING XGETPOINTERMAPPING XFETCHNAME -+ XCHANGEACTIVEPOINTERGRAB SET-XWINDOWATTRIBUTES-BACKING_STORE -+ SET-XTIMECOORD-X XCROSSINGEVENT-SERIAL -+ SET-XWINDOWATTRIBUTES-MAP_STATE SCREEN-DEFAULT_GC SET-XARC-HEIGHT -+ XGETSCREENSAVER SET-XVISUALINFO-SCREEN SET-XTIMECOORD-Y -+ SET-DEPTH-NVISUALS XCOMPOSESTATUS-COMPOSE_PTR -+ MAKE-XSETWINDOWATTRIBUTES XUNMAPEVENT-EVENT XUNMAPEVENT-SEND_EVENT -+ XMASKEVENT XPEEKEVENT XKEYBOARDCONTROL-AUTO_REPEAT_MODE -+ XKEYBOARDCONTROL-LED_MODE XCROSSINGEVENT-DETAIL XTEXTITEM16-DELTA -+ XUNMAPEVENT-DISPLAY XWINDOWATTRIBUTES-WIN_GRAVITY -+ XWINDOWATTRIBUTES-BIT_GRAVITY XCONFIGUREWINDOW XSETINPUTFOCUS -+ XCROSSINGEVENT-SAME_SCREEN MAKE-XKEYBOARDCONTROL -+ XCIRCULATEREQUESTEVENT-PLACE XCLEARAREA XFONTSTRUCT-FID -+ XUNMAPEVENT-WINDOW XGRAPHICSEXPOSEEVENT-SEND_EVENT -+ XKEYBOARDCONTROL-BELL_PITCH XGETRGBCOLORMAPS XPOINT-X XSETPLANEMASK -+ XFETCHBYTES XGRAPHICSEXPOSEEVENT-DISPLAY XSUBTRACTREGION -+ XEXTCODES-MAJOR_OPCODE SET-XSTANDARDCOLORMAP-BLUE_MULT -+ SET-XSTANDARDCOLORMAP-GREEN_MULT SET-XSTANDARDCOLORMAP-RED_MULT -+ MAKE-XTIMECOORD SET-XWINDOWATTRIBUTES-SCREEN XADDTOSAVESET -+ XGETPOINTERCONTROL WINDOW-GET-LATEX-POSITION -+ WINDOW-GET-LINE-POSITION WINDOW-GET-ICON-POSITION -+ WINDOW-GET-BOX-POSITION WINDOW-GET-MOUSE-POSITION -+ SET-XWINDOWATTRIBUTES-COLORMAP XCROSSINGEVENT-X -+ XDISABLEACCESSCONTROL SET-XMAPPINGEVENT-COUNT XGETNORMALHINTS -+ SET-XVISIBILITYEVENT-SEND_EVENT XCROSSINGEVENT-Y XSETFOREGROUND -+ SET-XVISIBILITYEVENT-DISPLAY SET-XICONSIZE-HEIGHT_INC -+ SET-XICONSIZE-WIDTH_INC MAKE-XCOLOR -+ SET-XCIRCULATEREQUESTEVENT-PARENT XMOVEWINDOW -+ XCIRCULATEREQUESTEVENT-TYPE XALLOCCOLOR XSETDASHES -+ XGCVALUES-ARC_MODE XDRAWARC MENU-SELECT-B SET-XVISUALINFO-CLASS -+ SET-XWINDOWATTRIBUTES-SAVE_UNDER SET-XCIRCULATEEVENT-EVENT -+ SET-XCIRCULATEEVENT-SEND_EVENT -+ SET-XCIRCULATEREQUESTEVENT-SEND_EVENT SET-XVISIBILITYEVENT-WINDOW -+ XOPENDISPLAY XQUERYBESTSIZE MAKE-XSIZEHINTS -+ SET-XMAPPINGEVENT-REQUEST PICMENU-BOX-ITEM SET-DEPTH-VISUALS -+ WINDOW-GET-CHARS SET-XEDATAOBJECT-VISUAL XKEYBOARDSTATE-BELL_PITCH -+ MAKE-XSEGMENT XALLOCSIZEHINTS SET-XCIRCULATEEVENT-DISPLAY -+ SET-XCIRCULATEREQUESTEVENT-DISPLAY XFREEEXTENSIONLIST -+ SET-XSTANDARDCOLORMAP-BLUE_MAX SET-XSTANDARDCOLORMAP-GREEN_MAX -+ SET-XSTANDARDCOLORMAP-RED_MAX ISMISCFUNCTIONKEY XSIZEHINTS-X -+ XCIRCULATEEVENT-EVENT XCIRCULATEEVENT-SEND_EVENT -+ XSTANDARDCOLORMAP-VISUALID MAKE-XTEXTITEM SET-XICONSIZE-MAX_WIDTH -+ SET-XICONSIZE-MIN_WIDTH XGETVISUALINFO MENU-ITEM-VALUE -+ SET-XCIRCULATEEVENT-WINDOW SET-XCIRCULATEREQUESTEVENT-WINDOW -+ XCIRCULATEEVENT-DISPLAY XUNGRABKEYBOARD SET-XPROPERTYEVENT-ATOM -+ XSIZEHINTS-Y SET-XWINDOWATTRIBUTES-OVERRIDE_REDIRECT MAKE-XKEYEVENT -+ XCIRCULATEREQUESTEVENT-SERIAL XGCVALUES-BACKGROUND WINDOW-GET-CROSS -+ WINDOW-ADJ-BOX-XY XEXTCODES-EXTENSION XCROSSINGEVENT-ROOT -+ XCROSSINGEVENT-X_ROOT XCROSSINGEVENT-Y_ROOT XCIRCULATEEVENT-WINDOW -+ OPEN-WINDOW XVENDORRELEASE SET-XSIZEHINTS-X SET-XSIZEHINTS-FLAGS -+ SET-XCROSSINGEVENT-FOCUS XIMAGE-BYTES_PER_LINE -+ XCROSSINGEVENT-SEND_EVENT SET-XCLASSHINT-RES_CLASS -+ SCREEN-BACKING_STORE XCROSSINGEVENT-DISPLAY SET-XSIZEHINTS-Y -+ SET-XWINDOWATTRIBUTES-CLASS XDEFAULTGC WINDOW-SET-ERASE -+ XDISPLAYMOTIONBUFFERSIZE XUNDEFINECURSOR DEPTH-DEPTH -+ SCREEN-EXT_DATA XRESETSCREENSAVER XSETGRAPHICSEXPOSURES -+ SET-XWINDOWATTRIBUTES-ROOT XCROSSINGEVENT-WINDOW -+ XCROSSINGEVENT-SUBWINDOW SET-XCHAR2B-BYTE1 XROOTWINDOW -+ XFONTSTRUCT-MAX_BYTE1 XFONTSTRUCT-MIN_BYTE1 SET-XCHAR2B-BYTE2 -+ XGCVALUES-FOREGROUND XADDEXTENSION XSTRINGTOCONTEXT -+ XSETPOINTERMAPPING SET-XIMAGE-DATA XFONTSTRUCT-MAX_CHAR_OR_BYTE2 -+ XFONTSTRUCT-MIN_CHAR_OR_BYTE2 BARMENU-CREATE XSETARCMODE -+ XCREATEIMAGE XKEYBOARDCONTROL-KEY XDEFAULTSCREEN XSETSCREENSAVER -+ XCIRCULATESUBWINDOWSDOWN XKEYBOARDSTATE-LED_MASK XINTERSECTREGION -+ MAKE-XMAPREQUESTEVENT XGETWMSIZEHINTS XKEYBOARDCONTROL-BELL_PERCENT -+ XKEYBOARDCONTROL-KEY_CLICK_PERCENT XCOLOR-BLUE XSETBACKGROUND -+ XSTANDARDCOLORMAP-BASE_PIXEL XUNIONREGION VERTEX-POS-FLAG -+ SET-XICONSIZE-MAX_HEIGHT SET-XICONSIZE-MIN_HEIGHT XSETSUBWINDOWMODE -+ XGCVALUES-CLIP_Y_ORIGIN XGCVALUES-CLIP_X_ORIGIN XGCVALUES-CLIP_MASK -+ SET-XRECTANGLE-WIDTH XSETRGBCOLORMAPS XGCONTEXTFROMGC -+ XALLOCCOLORPLANES SET-XWINDOWATTRIBUTES-WIN_GRAVITY -+ SET-XWINDOWATTRIBUTES-BIT_GRAVITY MAKE-XMAPPINGEVENT -+ XDRAWIMAGESTRING MAKE-XCOMPOSESTATUS XIMAGE-OBDATA XIMAGE-DATA -+ XCIRCULATESUBWINDOWS SET-XCLIENTMESSAGEEVENT-MESSAGE_TYPE -+ SET-XCLIENTMESSAGEEVENT-TYPE XSTOREBYTES -+ XCIRCULATEREQUESTEVENT-PARENT XCOLORMAPEVENT-TYPE VISUAL-EXT_DATA -+ SET-XSIZEHINTS-WIN_GRAVITY XCIRCULATEREQUESTEVENT-SEND_EVENT -+ XKEYBOARDSTATE-BELL_PERCENT XKEYBOARDSTATE-KEY_CLICK_PERCENT -+ XSETNORMALHINTS XVISIBILITYEVENT-TYPE XSETTILE XAUTOREPEATON -+ XALLOCCOLORCELLS XGETMOTIONEVENTS XCOLORMAPEVENT-STATE PICMENU-SPEC -+ XCIRCULATEREQUESTEVENT-DISPLAY XEVENTMASKOFSCREEN -+ SET-XKEYBOARDCONTROL-LED XGRABKEYBOARD XKEYBOARDSTATE-AUTO_REPEATS -+ XIMAGE-BYTE_ORDER XVISIBILITYEVENT-STATE XROOTWINDOWOFSCREEN -+ XEXPOSEEVENT-WIDTH XCIRCULATEREQUESTEVENT-WINDOW -+ SET-XCLIENTMESSAGEEVENT-SERIAL SET-XCOLOR-GREEN window-code-char -+ gcfunction gcforeground gcbackground GXxor GXcopy LineSolid CapButt -+ JoinMiter XK_Shift_R XK_Shift_L XK_Control_L XK_Control_R XK_Alt_R -+ XK_Alt_L XK_Return XK_Tab XK_BackSpace window-get-raw-char -+ ) :user) -+ -+(import '(*WINDOW-META* *TEXT-WIDTH-RETURN* *WINDOW-STRING* *WINDOW-SCREEN* -+ *WINDOW-EVENT* *WINDOW-MENU* *WINDOW-KEYMAP* *WINDOW-SHIFT* -+ *BORDER-WIDTH* *ROOT-X-RETURN* *POS-X* *ROOT-Y-RETURN* *DEFAULT-GC* -+ *DEFAULT-EVENT* *GC-VALUES* *MENU-TITLE-PAD* *DEFAULT-SCREEN* -+ *CHILD-RETURN* *DEPTH-RETURN* *WINDOW-ADD-MENU-TITLE* -+ *OVERALL-RETURN* *WINDOW-DEFAULT-BORDER* -+ *BORDER-WIDTH-RETURN* *DEFAULT-COLORMAP* *MOUSE-X* *MOUSE-Y* -+ *WINDOW-INPUT-STRING-CHARWIDTH* A-WINDOW *WINDOW-DISPLAY* -+ *WINDOW-ATTRIBUTES* *DESCENT-RETURN* -+ *WIDTH-RETURN* *WIN-Y-RETURN* *WIN-X-RETURN* *WINDOW-KEYINIT* -+ *BARMENU-UPDATE-VALUE-CONS* *ROOT-WINDOW* *PICMENU-NO-SELECTION* -+ *WINDOW-CTRL* *WINDOW-XCOLOR* *DIRECTION-RETURN* *WINDOW-FONTS* -+ *WINDOW-ATTR* *POS-Y* *X-RETURN* *Y-RETURN* *WIN-WIDTH* -+ *MASK-RETURN* *ASCENT-RETURN* *ROOT-RETURN* *HEIGHT-RETURN* -+ *BLACK-PIXEL* *WINDOW-DEFAULT-FONT-NAME* *DEFAULT-BG-COLOR* -+ *DEFAULT-FG-COLOR* *DEFAULT-SIZE-HINTS* *DEFAULT-DISPLAY* -+ *WINDOW-DEFAULT-CURSOR* *WINDOW-SHIFTKEYMAP* *WINDOW-DEFAULT-POS-X* -+ *WINDOW-DEFAULT-POS-Y* *WINDOW-MENU-CODE* *MOUSE-WINDOW* -+ *WINDOW-INPUT-STRING-X* *WINDOW-INPUT-STRING-Y* *WINDOW-STRING-MAX* -+ *WINDOW-STRING-COUNT* *WINDOW-SAVE-FOREGROUND* -+ *WINDOW-SAVE-FUNCTION* *WIN-HEIGHT* *WHITE-PIXEL* -+ *min-keycodes-return* *max-keycodes-return* *keycodes-return* -+ *window-shift-keys* *window-control-keys* *window-meta-keys* -+ ) :user) -+ -+(import '(courier-bold-12 8x10 9x15 top bottom -+ left right center paint xor erase -+ copy close move clear display-size -+ menu window picmenu picmenu-spec barmenu -+ picmenu-button) :user) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_lispservertrans.lsp -@@ -0,0 +1,110 @@ -+; 27 Jan 2006 14:38:08 CST -+; This program 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 program 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 program; if not, write to the Free Software -+; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -+ -+ -+(DEFVAR *WIO-WINDOW* NIL) -+ -+(DEFVAR *WIO-WINDOW-WIDTH* 500) -+ -+(DEFVAR *WIO-WINDOW-HEIGHT* 300) -+ -+(DEFVAR *WIO-MENU-SET* NIL) -+ -+(DEFVAR *WIO-FONT* '8X13) -+ -+(DEFVAR *WIO-WINDOW*) -+(SETF (GET '*WIO-WINDOW* 'GLISPGLOBALVAR) T) -+(SETF (GET '*WIO-WINDOW* 'GLISPGLOBALVARTYPE) 'WINDOW) -+(DEFVAR *WIO-WINDOW-WIDTH*) -+(SETF (GET '*WIO-WINDOW-WIDTH* 'GLISPGLOBALVAR) T) -+(SETF (GET '*WIO-WINDOW-WIDTH* 'GLISPGLOBALVARTYPE) 'INTEGER) -+(DEFVAR *WIO-WINDOW-HEIGHT*) -+(SETF (GET '*WIO-WINDOW-HEIGHT* 'GLISPGLOBALVAR) T) -+(SETF (GET '*WIO-WINDOW-HEIGHT* 'GLISPGLOBALVARTYPE) 'INTEGER) -+(DEFVAR *WIO-MENU-SET*) -+(SETF (GET '*WIO-MENU-SET* 'GLISPGLOBALVAR) T) -+(SETF (GET '*WIO-MENU-SET* 'GLISPGLOBALVARTYPE) 'MENU-SET) -+ -+ -+(DEFMACRO WHILE (TEST &REST FORMS) -+ (LIST* 'LOOP (LIST 'UNLESS TEST '(RETURN)) FORMS)) -+ -+(SETF (GET 'WIO-WINDOW 'GLFNRESULTTYPE) 'WINDOW) -+ -+(DEFUN WIO-WINDOW (&OPTIONAL TITLE WIDTH HEIGHT (POSX 0) (POSY 0) FONT) -+ (IF WIDTH (SETQ *WIO-WINDOW-WIDTH* WIDTH)) -+ (IF HEIGHT (SETQ *WIO-WINDOW-HEIGHT* HEIGHT)) -+ (OR *WIO-WINDOW* -+ (SETQ *WIO-WINDOW* -+ (WINDOW-CREATE *WIO-WINDOW-WIDTH* *WIO-WINDOW-HEIGHT* TITLE -+ NIL POSX POSY FONT)))) -+ -+(DEFUN WIO-INIT-MENUS (W COMMANDS) -+ (LET () -+ (WINDOW-CLEAR W) -+ (SETQ *WIO-MENU-SET* (MENU-SET-CREATE W NIL)) -+ (MENU-SET-ADD-MENU *WIO-MENU-SET* 'COMMAND NIL "Commands" COMMANDS -+ (LIST 0 0)) -+ (MENU-SET-ADJUST *WIO-MENU-SET* 'COMMAND 'TOP NIL 2) -+ (MENU-SET-ADJUST *WIO-MENU-SET* 'COMMAND 'RIGHT NIL 2))) -+ -+(DEFUN LISP-SERVER () -+ (LET (W INPUTM DONE SEL (REDRAW T) STR RESULT) -+ (SETQ W (WIO-WINDOW "Lisp Server")) -+ (WINDOW-OPEN W) -+ (WINDOW-CLEAR W) -+ (WINDOW-SET-FONT W *WIO-FONT*) -+ (WIO-INIT-MENUS W '(("Quit" . QUIT))) -+ (WINDOW-PRINT-LINES W -+ '("Click mouse in the input box, then enter" -+ "a Lisp expression followed by Return." "" -+ "Input: e.g. (+ 3 4) or (sqrt 2)") -+ 10 (+ -20 *WIO-WINDOW-HEIGHT*)) -+ (WINDOW-PRINTAT-XY W "Result:" 10 (+ -150 *WIO-WINDOW-HEIGHT*)) -+ (SETQ INPUTM -+ (TEXTMENU-CREATE (+ -100 *WIO-WINDOW-WIDTH*) 30 NIL W 20 -+ (+ -110 *WIO-WINDOW-HEIGHT*) T T '9X15 T)) -+ (MENU-SET-ADD-ITEM *WIO-MENU-SET* 'INPUT NIL INPUTM) -+ (WHILE (NOT DONE) -+ (SETQ SEL (MENU-SET-SELECT *WIO-MENU-SET* REDRAW)) -+ (SETQ REDRAW NIL) -+ (CASE (CADR SEL) -+ (COMMAND (CASE (CAR SEL) (QUIT (SETQ DONE T)))) -+ (INPUT (SETQ STR (CAR SEL)) -+ (SETQ RESULT -+ (CATCH 'ERROR -+ (EVAL (SAFE-READ-FROM-STRING STR)))) -+ (WINDOW-ERASE-AREA-XY W 20 2 -+ (+ -20 *WIO-WINDOW-WIDTH*) -+ (+ -160 *WIO-WINDOW-HEIGHT*)) -+ (WINDOW-PRINT-LINE W -+ (WRITE-TO-STRING RESULT :PRETTY T) 20 -+ (+ -170 *WIO-WINDOW-HEIGHT*))))) -+ (WINDOW-CLOSE W))) -+ -+(DEFUN SAFE-READ-FROM-STRING (STR) -+ (IF (AND (STRINGP STR) (> (LENGTH STR) 0)) -+ (READ-FROM-STRING STR NIL 'READ-ERROR))) -+ -+(DEFUN COMPILE-LISPSERVER () -+ (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp") -+ '("glisp/lispserver.lsp") "glisp/lispservertrans.lsp" -+ "glisp/gpl.txt")) -+ -+(DEFUN COMPILE-LISPSERVERB () -+ (GLCOMPFILES *DIRECTORY* -+ '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") -+ '("glisp/lispserver.lsp") "glisp/lispservertrans.lsp" -+ "glisp/gpl.txt")) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_dwindow.lsp -@@ -0,0 +1,3020 @@ -+; dwindow.lsp Gordon S. Novak Jr. ; 13 Jan 10 -+ -+; Window types and interface functions for using X windows from GNU Common Lisp -+ -+; Copyright (c) 2010 Gordon S. Novak Jr. and The University of Texas at Austin. -+ -+; 08 Jan 97; 17 May 02; 17 May 04; 18 May 04; 01 Jun 04; 18 Aug 04; 21 Jan 06 -+; 24 Jan 06; 24 Jun 06; 25 Jun 06; 17 Jul 06; 23 Aug 06; 08 Sep 06; 21 May 09 -+; 28 Aug 09; 31 Aug 09; 28 Oct 09; 07 Nov 09; 12 Jan 10 -+ -+; See the files gnu.license and dec.copyright . -+ -+; This program 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 program 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 program; if not, write to the Free Software -+; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -+ -+; Some of the files that interface to the Xlib are adapted from DEC/MIT files. -+; See the file dec.copyright for details. -+ -+; Written by: Gordon S. Novak Jr., Department of Computer Sciences, -+; University of Texas at Austin 78712. novak@cs.utexas.edu -+ -+; These functions use the convention that positive y is upwards, -+; (0 0) is the lower-left corner of a window. -+ -+; derived from {DSK}DWINDOW.CL;1 1-Mar-89 13:16:20 -+; Modified for AKCL/X using Hiep Huu Nguyen's interfaces from AKCL -> C -> X. -+; Parts of Nguyen's file Xinit.lsp are included. -+ -+ -+(defvar *window-add-menu-title* nil) ; t to add title bar within menu area -+(defvar *window-menu* nil) -+(defvar *mouse-x* nil) -+(defvar *mouse-y* nil) -+(defvar *mouse-window* nil) -+ -+(defvar *window-fonts* (list -+ (list 'courier-bold-12 -+ "*-*-courier-bold-r-*-*-12-*-*-*-*-*-iso8859-1") -+ (list 'courier-medium-12 -+ "*-*-courier-medium-r-*-*-12-*-*-*-*-*-iso8859-1") -+ (list '6x12 "6x12") -+ (list '8x13 "8x13") -+ (list '9x15 "9x15"))) -+ -+(glispglobals (*window-menu* menu) -+ (*mouse-x* integer) -+ (*mouse-y* integer) -+ (*mouse-window* window) -+ (*picmenu-no-selection* picmenu-button) ) -+ -+(defvar *window-display* nil) -+(defvar *window-screen* nil) -+(defvar *root-window*) -+(defvar *black-pixel*) -+(defvar *white-pixel*) -+(defvar *default-fg-color*) -+(defvar *default-bg-color*) -+(defvar *default-size-hints*) -+(defvar *default-GC*) -+(defvar *default-colormap*) -+(defvar *window-event*) -+(defvar *window-default-pos-x* 10) -+(defvar *window-default-pos-y* 20) -+(defvar *window-default-border* 1) -+(defvar *window-default-font-name* 'courier-bold-12) -+(defvar *window-default-cursor* 68) -+(defvar *window-save-foreground*) -+(defvar *window-save-function*) -+(defvar *window-attributes*) -+(defvar *window-attr*) -+(defvar *menu-title-pad* 30) ; extra space for title bar of menu -+; The following -return globals are used in calls to Xlib -+; routines. -+; Where the Xlib parameter is int*, the parameter must be -+; initialized to (int-array 1) and is accessed with -+; (int-pos param 0). -+; The following X types are CARD32: (from Xproto.h) -+; Window Drawable Font Pixmap Cursor Colormap GContext -+; Atom VisualID Time KeySym -+; KeyCode = CARD8 -+(defvar *root-return* (fixnum-array 1)) -+(defvar *child-return* (fixnum-array 1)) -+(defvar *root-x-return* (int-array 1)) -+(defvar *root-y-return* (int-array 1)) -+(defvar *win-x-return* (int-array 1)) -+(defvar *win-y-return* (int-array 1)) -+(defvar *mask-return* (int-array 1)) -+(defvar *x-return* (int-array 1)) -+(defvar *y-return* (int-array 1)) -+(defvar *width-return* (int-array 1)) -+(defvar *height-return* (int-array 1)) -+(defvar *depth-return* (int-array 1)) -+(defvar *border-width-return* (int-array 1)) -+(defvar *text-width-return* (int-array 1)) -+(defvar *direction-return* (int-array 1)) -+(defvar *ascent-return* (int-array 1)) -+(defvar *descent-return* (int-array 1)) -+(defvar *overall-return* (int-array 1)) -+(defvar *GC-Values*) -+(defvar *window-xcolor* nil) -+(defvar *window-menu-code* nil) -+ -+(defvar *window-keymap* (make-array 256)) -+(defvar *window-shiftkeymap* (make-array 256)) -+(defvar *window-keyinit* nil) -+(defvar *window-meta*) ; set if meta down when char is pressed -+(defvar *window-ctrl*) ; set if ctrl down when char is pressed -+(defvar *window-shift*) ; set if shift down when char is pressed -+ -+(defvar *window-shift-keys* nil) -+(defvar *window-control-keys* nil) -+(defvar *window-meta-keys* nil) -+(defvar *min-keycodes-return* (int-array 1)) -+(defvar *max-keycodes-return* (int-array 1)) -+(defvar *keycodes-return* (int-array 1)) -+ -+(setq *window-keyinit* nil) -+ -+(defmacro picmenu-spec (symbol) `(get ,symbol 'picmenu-spec)) -+ -+(glispobjects -+ -+(drawable anything) -+ -+(menu (listobject (menu-window window) -+ (flat boolean) -+ (parent-window drawable) -+ (parent-offset-x integer) -+ (parent-offset-y integer) -+ (picture-width integer) -+ (picture-height integer) -+ (title string) -+ (permanent boolean) -+ (menu-font symbol) -+ (item-width integer) -+ (items (listof symbol)) ) -+ prop ((menuw (menu-window or (menu-init self)) result window) -+ (title-present (title and ((length title) > 0))) -+ (width (picture-width)) -+ (height (picture-height)) -+ (base-x ((if flat parent-offset-x 0))) -+ (base-y ((if flat parent-offset-y 0))) -+ (offset menu-offset) -+ (size menu-size) -+ (region ((virtual region with start = voffset size = vsize))) -+ (voffset ((virtual vector with x = base-x y = base-y))) -+ (vsize ((virtual vector with x = picture-width -+ y = picture-height))) ) -+ msg ((init menu-init) -+ (init? ((menu-window and (picture-height > 0)) or (init self))) -+ (contains? (glambda (m p) (contains? (region m) p))) -+ (create menu-create result menu) -+ (clear menu-clear) -+ (select menu-select) -+ (select! menu-select!) -+ (choose menu-choose) -+ (draw menu-draw) -+ (destroy menu-destroy) -+ (moveto-xy menu-moveto-xy) -+ (reposition menu-reposition) -+ (reposition-line menu-reposition-line) -+ (box-item menu-box-item) -+ (unbox-item menu-box-item) ; same since it uses xor -+ (display-item menu-display-item) -+ (item-value menu-item-value open t) -+ (item-position menu-item-position result vector) -+ (find-item-width menu-find-item-width) -+ (find-item-height menu-find-item-height) -+ (adjust-offset menu-adjust-offset) -+ (calculate-size menu-calculate-size) -+ (menu-x (glambda (m x) ((base-x m) + x))) -+ (menu-y (glambda (m y) ((base-y m) + y))) ) ) -+ -+; picture menu: a drawn object with "hot buttons" at certain points. -+; note: the first 10 data items of picmenu must be the same as in menu. -+(picmenu (listobject (menu-window window) -+ (flat boolean) -+ (parent-window drawable) -+ (parent-offset-x integer) -+ (parent-offset-y integer) -+ (picture-width integer) -+ (picture-height integer) -+ (title string) -+ (permanent boolean) -+ (spec (transparent picmenu-spec)) -+ (boxflg boolean) -+ (deleted-buttons (listof symbol)) -+ (button-colors (listof (list (name symbol) (color rgb)))) -+ ) -+ prop ((menuw (menu-window or (picmenu-init self)) result window) ) -+ msg ((init picmenu-init) -+ (init? ((menu-window and (picture-height > 0)) or (init self))) -+ (create picmenu-create result picmenu) -+ (select picmenu-select) -+ (draw picmenu-draw) -+ (draw-button picmenu-draw-button) -+ (draw-named-button picmenu-draw-named-button) -+ (set-named-button-color picmenu-set-named-button-color) -+ (delete-named-button picmenu-delete-named-button) -+ (box-item picmenu-box-item) -+ (unbox-item picmenu-unbox-item) -+ (calculate-size picmenu-calculate-size) -+ (item-position picmenu-item-position result vector) ) -+ supers (menu) ) -+ -+(picmenu-spec (listobject (drawing-width integer) -+ (drawing-height integer) -+ (buttons (listof picmenu-button)) -+ (dotflg boolean) -+ (drawfn anything) -+ (menu-font symbol) )) -+ -+(picmenu-button (list (buttonname symbol) -+ (offset vector) -+ (size vector) -+ (highlightfn anything) -+ (unhighlightfn anything)) -+ msg ((containsxy? picmenu-button-containsxy?)) ) -+ -+(barmenu (listobject (menu-window window) -+ (flat boolean) -+ (parent-window drawable) -+ (parent-offset-x integer) -+ (parent-offset-y integer) -+ (picture-width integer) -+ (picture-height integer) -+ (title string) -+ (permanent boolean) -+ (color rgb) -+ (value integer) -+ (maxval integer) -+ (barwidth integer) -+ (horizontal boolean) -+ (subtrackfn anything) -+ (subtrackparms (listof anything))) -+ prop ((menuw (menu-window or (barmenu-init self)) result window) -+ (picture-width ((if (horizontal m) (maxval m) -+ (barwidth m)) )) -+ (picture-height ((if (horizontal m) (barwidth m) -+ (maxval m)) )) ) -+ msg ((init barmenu-init) -+ (init? ((menu-window and (picture-height > 0)) -+ or (init self))) -+ (create barmenu-create result barmenu) -+ (select barmenu-select) -+ (draw barmenu-draw) -+ (update-value barmenu-update-value) -+ (calculate-size barmenu-calculate-size) ) -+supers (menu)) -+ -+; Note: data through 'permanent' must be same as in menu. -+(textmenu (listobject (menu-window window) -+ (flat boolean) -+ (parent-window drawable) -+ (parent-offset-x integer) -+ (parent-offset-y integer) -+ (picture-width integer) -+ (picture-height integer) -+ (title string) -+ (permanent boolean) -+ (text string) -+ (drawing-width integer) -+ (drawing-height integer) -+ (boxflg boolean) -+ (menu-font symbol) ) -+ -+ prop ((menuw (menu-window or (textmenu-init self)) result window) ) -+ msg ((init textmenu-init) -+ (init? ((menu-window and (picture-height > 0)) or (init self))) -+ (create textmenu-create result textmenu) -+ (select textmenu-select) -+ (draw textmenu-draw) -+ (calculate-size textmenu-calculate-size) -+ (set-text textmenu-set-text open t) ) -+ supers (menu) ) -+ -+; Note: data through 'permanent' must be same as in menu. -+(editmenu (listobject (menu-window window) -+ (flat boolean) -+ (parent-window drawable) -+ (parent-offset-x integer) -+ (parent-offset-y integer) -+ (picture-width integer) -+ (picture-height integer) -+ (title string) -+ (permanent boolean) -+ (text (listof string)) -+ (drawing-width integer) -+ (drawing-height integer) -+ (boxflg boolean) -+ (menu-font symbol) -+ (column integer) -+ (line integer) -+ (scrollval integer) ) -+ prop ((menuw (menu-window or (editmenu-init self)) result window) -+ (scroll ((if (numberp scrollval) -+ scrollval -+ 0))) ) -+ -+ msg ((init editmenu-init) -+ (init? ((menu-window and (picture-height > 0)) or (init self))) -+ (create editmenu-create result editmenu) -+ (select editmenu-select) -+ (draw editmenu-draw) -+ (edit editmenu-edit) -+ (carat editmenu-carat) -+ (display editmenu-display) -+ (calculate-size editmenu-calculate-size) -+ (line-y editmenu-line-y open t) ) -+ supers (menu) ) -+ -+(window (listobject (parent drawable) -+ (gcontext anything) -+ (drawable-height integer) -+ (drawable-width integer) -+ (label string) -+ (font anything) ) -+default ((self nil)) -+prop ((width (drawable-width)) -+ (height (drawable-height)) -+ (left window-left open t result integer) -+ (right (left + width)) -+ (top-neg-y window-top-neg-y open t result integer) -+ (leftmargin (1)) -+ (rightmargin (width - 1)) -+ (yposition window-yposition result integer open t) -+ (wfunction window-wfunction open t) -+ (foreground window-foreground open t) -+ (background window-background open t) -+ (font-width ((string-width self "W"))) -+ (font-height ((string-height self "Tg"))) ) -+msg ((force-output window-force-output open t) -+ (set-font window-set-font) -+ (set-foreground window-set-foreground open t) -+ (set-background window-set-background open t) -+ (set-cursor window-set-cursor open t) -+ (set-erase window-set-erase open t) -+ (set-xor window-set-xor open t) -+ (set-invert window-set-invert open t) -+ (set-copy window-set-copy open t) -+ (set-line-width window-set-line-width open t) -+ (set-line-attr window-set-line-attr open t) -+ (std-line-attr window-std-line-attr open t) -+ (unset window-unset open t) -+ (reset window-reset open t) -+ (sync window-sync open t) -+ (geometry window-geometry open t) -+ (size window-size) -+ (get-geometry window-get-geometry open t) -+ (reset-geometry window-reset-geometry open t) -+ (query-pointer window-query-pointer open t) -+ (wait-exposure window-wait-exposure) -+ (wait-unmap window-wait-unmap) -+ (clear window-clear open t) -+ (mapw window-map open t) -+ (unmap window-unmap open t) -+ (open window-open open t) -+ (close window-close open t) -+ (destroy window-destroy open t) -+ (positive-y window-positive-y open t) -+ (drawline window-draw-line open t) -+ (draw-line window-draw-line open t) -+ (draw-line-xy window-draw-line-xy open t) -+ (draw-latex-xy window-draw-latex-xy) -+ (draw-arrow-xy window-draw-arrow-xy ) -+ (draw-arrow2-xy window-draw-arrow2-xy ) -+ (draw-arrowhead-xy window-draw-arrowhead-xy ) -+ (draw-box window-draw-box open t) -+ (draw-box-xy window-draw-box-xy) -+ (draw-box-corners window-draw-box-corners open t) -+ (draw-rcbox-xy window-draw-rcbox-xy) -+ (draw-box-line-xy window-draw-box-line-xy) -+ (xor-box-xy window-xor-box-xy open t) -+ (draw-circle window-draw-circle open t) -+ (draw-circle-xy window-draw-circle-xy open t) -+ (draw-ellipse-xy window-draw-ellipse-xy open t) -+ (draw-arc-xy window-draw-arc-xy open t) -+ (invertarea window-invertarea open t) -+ (invert-area window-invert-area open t) -+ (invert-area-xy window-invert-area-xy open t) -+ (copy-area-xy window-copy-area-xy open t) -+ (printat window-printat open t) -+ (printat-xy window-printat-xy open t) -+ (print-line window-print-line) -+ (print-lines window-print-lines) -+ (prettyprintat window-prettyprintat open t) -+ (prettyprintat-xy window-prettyprintat-xy open t) -+ (string-width window-string-width open t) -+ (string-extents window-string-extents open t) -+ (erase-area window-erase-area open t) -+ (erase-area-xy window-erase-area-xy open t) -+ (erase-box-xy window-erase-box-xy open t) -+ (moveto-xy window-moveto-xy) -+ (move window-move) -+ (paint window-paint) -+ (centeroffset window-centeroffset open t) -+ (draw-border window-draw-border open t) -+ (track-mouse window-track-mouse) -+ (track-mouse-in-region window-track-mouse-in-region) -+ (init-mouse-poll window-init-mouse-poll) -+ (poll-mouse window-poll-mouse) -+ (get-point window-get-point) -+ (get-click window-get-click) -+ (get-line-position window-get-line-position) -+ (get-latex-position window-get-latex-position) -+ (get-icon-position window-get-icon-position) -+ (get-box-position window-get-box-position) -+ (get-box-line-position window-get-box-line-position) -+ (get-box-size window-get-box-size) -+ (get-region window-get-region) -+ (adjust-box-side window-adjust-box-side) -+ (get-mouse-position window-get-mouse-position) -+ (get-circle window-get-circle) -+ (get-ellipse window-get-ellipse) -+ (get-crosshairs window-get-crosshairs) -+ (draw-crosshairs-xy window-draw-crosshairs-xy) -+ (get-cross window-get-cross) -+ (draw-cross-xy window-draw-cross-xy) -+ (draw-dot-xy window-draw-dot-xy) -+ (draw-vector-pt window-draw-vector-pt) -+ (get-vector-end window-get-vector-end) -+ (reset-color window-reset-color) -+ (set-color-rgb window-set-color-rgb) -+ (set-color window-set-color) -+ (set-xcolor window-set-xcolor) -+ (free-color window-free-color) -+ (get-chars window-get-chars) -+ (input-string window-input-string) -+ (string-width window-string-width) -+ (string-extents window-string-extents) -+ (string-height window-string-height) -+ (draw-carat window-draw-carat) -+ )) -+ -+(rgb (list (red integer) (green integer) (blue integer))) -+ -+ ) ; glispobjects -+ -+(glispconstants ; used by GEV -+ (windowcharwidth 9 integer) -+ (windowlineyspacing 17 integer) -+) -+ -+(defvar *picmenu-no-selection* '(no-selection (0 0) (0 0) nil nil)) -+ -+; 14 Mar 95 -+; Make something into a string. -+; The copy-seq avoids an error with get-c-string on Sun. -+(defun stringify (x) -+ (cond ((stringp x) x) -+ ((symbolp x) (copy-seq (symbol-name x))) -+ (t (princ-to-string x)))) -+ -+; 24 Jun 06 -+; This function initializes variables needed by most applications. -+; It uses all defaults inherited from the root window, and screen. ; H. Nguyen -+(defun window-Xinit () -+ (setq *window-display* (XOpenDisplay (get-c-string ""))) -+ (if (or (not (numberp *window-display*)) ; 22 Jun 06 -+ (< *window-display* 10000)) -+ (error "DISPLAY did not open: return value ~A~%" *window-display*)) -+ (setq *window-screen* (XdefaultScreen *window-display*)) -+ (setq *root-window* (XRootWindow *window-display* *window-screen*)) -+ (setq *black-pixel* (XBlackPixel *window-display* *window-screen*)) -+ (setq *white-pixel* (XWhitePixel *window-display* *window-screen*)) -+ (setq *default-fg-color* *black-pixel*) -+ (setq *default-bg-color* *white-pixel*) -+ (setq *default-GC* (XDefaultGC *window-display* *window-screen*)) -+ (setq *default-colormap* (XDefaultColormap *window-display* -+ *window-screen*)) -+ (setq *window-attributes* (make-XsetWindowAttributes)) -+ (set-XsetWindowAttributes-backing_store *window-attributes* -+ WhenMapped) -+ (set-XsetWindowAttributes-save_under *window-attributes* 1) ; True -+ (setq *window-attr* (make-XWindowAttributes)) -+ (Xflush *window-display*) -+ (setq *default-size-hints* (make-XsizeHints)) -+ (setq *window-event* (make-XEvent)) -+ (setq *GC-Values* (make-XGCValues)) ) -+ -+(defun window-get-mouse-position () -+ (XQueryPointer *window-display* *root-window* -+ *root-return* *child-return* *root-x-return* *root-y-return* -+ *win-x-return* *win-y-return* *mask-return*) -+ (setq *mouse-x* (int-pos *root-x-return* 0)) -+ (setq *mouse-y* (int-pos *root-y-return* 0)) -+ (setq *mouse-window* (fixnum-pos *child-return* 0)) ) ; 22 Jun 06 -+ -+; 13 Aug 91; 14 Aug 91; 06 Sep 91; 12 Sep 91; 06 Dec 91; 01 May 92; 01 Sep 92 -+; 08 Sep 06 -+(setf (glfnresulttype 'window-create) 'window) -+(gldefun window-create (width height &optional str parentw pos-x pos-y font) -+ (let (w pw fg-color bg-color (null 0)) -+ (or *window-display* (window-Xinit)) -+ (setq fg-color *default-fg-color*) -+ (setq bg-color *default-bg-color*) -+ (unless pos-x (pos-x = *window-default-pos-x*)) -+ (unless pos-y (pos-y = *window-default-pos-y*)) -+ (w = (a window with -+ drawable-width = width -+ drawable-height = height -+ label = (if str (stringify str) " ") )) -+ (pw = (or parentw *root-window*)) -+ (window-get-geometry-b pw) -+ ((parent w) = -+ (XCreateSimpleWindow *window-display* pw -+ pos-x -+ ((int-pos *height-return* 0) -+ - pos-y - height) -+ width height -+ *window-default-border* -+ fg-color bg-color)) -+ (set-xsizehints-x *default-size-hints* pos-x) -+ (set-xsizehints-y *default-size-hints* pos-y) -+ (set-xsizehints-width *default-size-hints* (width w)) -+ (set-xsizehints-height *default-size-hints* (height w)) -+ (set-xsizehints-flags *default-size-hints* -+ (+ Psize Pposition)) -+ (XsetStandardProperties *window-display* (parent w) -+ (get-c-string (label w)) -+ (get-c-string (label w)) ; icon name -+ none null null -+ *default-size-hints*) -+ ((gcontext w) = (XCreateGC *window-display* (parent w) 0 null)) -+ (set-foreground w fg-color) -+ (set-background w bg-color) -+ (set-font w (or font *window-default-font-name*)) -+ (set-cursor w *window-default-cursor*) -+ (set-line-width w 1) -+ (XChangeWindowAttributes *window-display* (parent w) -+ (+ CWSaveUnder CWBackingStore) -+ *window-attributes*) -+ (Xselectinput *window-display* (parent w) -+ (+ leavewindowmask buttonpressmask -+ buttonreleasemask -+ pointermotionmask exposuremask)) -+ (open w) -+ w )) -+ -+; 06 Aug 91; 17 May 04 -+; Set the font for a window to the one specified by fontsymbol. -+; derived from Nguyen's my-load-font. -+(gldefun window-set-font ((w window) (fontsymbol symbol)) -+ (let (fontstring font-info (display *window-display*)) -+ (fontstring = (or (cadr (assoc fontsymbol *window-fonts*)) -+ (stringify fontsymbol))) -+ (font-info = (XloadQueryFont display -+ (get-c-string fontstring))) -+ (if (eql 0 font-info) -+ (format t "~%can't open font ~a ~a~%" fontsymbol fontstring) -+ (progn (XsetFont display (gcontext w) (Xfontstruct-fid font-info)) -+ ((font w) = font-info)) ) )) -+ -+; 15 Oct 91 -+(defun window-font-info (fontsymbol) -+ (XloadQueryFont *window-display* -+ (get-c-string -+ (or (cadr (assoc fontsymbol *window-fonts*)) -+ (stringify fontsymbol))))) -+ -+ -+; Functions to allow access to window properties from plain Lisp -+(gldefun window-gcontext ((w window)) (gcontext w)) -+(gldefun window-parent ((w window)) (parent w)) -+(gldefun window-drawable-height ((w window)) (drawable-height w)) -+(gldefun window-drawable-width ((w window)) (drawable-width w)) -+(gldefun window-label ((w window)) (label w)) -+(gldefun window-font ((w window)) (font w)) -+ -+; 07 Aug 91; 14 Aug 91 -+(gldefun window-foreground ((w window)) -+ (XGetGCValues *window-display* (gcontext w) GCForeground -+ *GC-Values*) -+ (XGCValues-foreground *GC-Values*) ) -+ -+(gldefun window-set-foreground ((w window) (fg-color integer)) -+ (XsetForeground *window-display* (gcontext w) fg-color)) -+ -+(gldefun window-background ((w window)) -+ (XGetGCValues *window-display* (gcontext w) GCBackground -+ *GC-Values*) -+ (XGCValues-Background *GC-Values*) ) -+ -+(gldefun window-set-background ((w window) (bg-color integer)) -+ (XsetBackground *window-display* (gcontext w) bg-color)) -+ -+; 08 Aug 91 -+(gldefun window-wfunction ((w window)) -+ (XGetGCValues *window-display* (gcontext w) GCFunction -+ *GC-Values*) -+ (XGCValues-function *GC-Values*) ) -+ -+; 08 Aug 91 -+; Get the geometry parameters of a window into global variables -+(gldefun window-get-geometry ((w window)) (window-get-geometry-b (parent w))) -+ -+; 06 Dec 91 -+; Set cursor to a selected cursor number -+(gldefun window-set-cursor ((w window) (n integer)) -+ (let (c) -+ (c = (XCreateFontCursor *window-display* n) ) -+ (XDefineCursor *window-display* (parent w) c) )) -+ -+(defun window-get-geometry-b (w) -+ (XGetGeometry *window-display* w -+ *root-return* *x-return* *y-return* *width-return* -+ *height-return* *border-width-return* *depth-return*) ) -+ -+; 15 Aug 91 -+; clear event queue of previous motion events -+(gldefun window-sync ((w window)) -+ (Xsync *window-display* 1) ) -+ -+; 03 Oct 91; 06 Oct 94 -+(gldefun window-screen-height () -+ (window-get-geometry-b *root-window*) -+ (int-pos *height-return* 0) ) -+ -+; 08 Aug 91; 12 Sep 91; 28 Oct 91 -+; Make a list of window geometry, (x y width height border-width). -+(gldefun window-geometry ((w window)) -+ (let (sh) -+ (sh = (window-screen-height)) -+ (get-geometry w) -+ ((drawable-width w) = (int-pos *width-return* 0)) -+ ((drawable-height w) = (int-pos *height-return* 0)) -+ (list (int-pos *x-return* 0) -+ (sh - (int-pos *y-return* 0) -+ - (int-pos *height-return* 0)) -+ (int-pos *width-return* 0) -+ (int-pos *height-return* 0) -+ (int-pos *border-width-return* 0)) )) -+ -+; 27 Nov 91 -+(gldefun window-size ((w window)) (result vector) -+ (get-geometry w) -+ (list ((drawable-width w) = (int-pos *width-return* 0)) -+ ((drawable-height w) = (int-pos *height-return* 0)) ) ) -+ -+(gldefun window-left ((w window)) -+ (get-geometry w) -+ (int-pos *x-return* 0)) -+ -+; Get top of window in X (y increasing downwards) coordinates. -+(gldefun window-top-neg-y ((w window)) -+ (get-geometry w) -+ (int-pos *y-return* 0)) -+ -+; 08 Aug 91 -+; Reset the local geometry parameters of a window from its X values. -+; Needed, for example, if the user resizes the window by mouse command. -+(gldefun window-reset-geometry ((w window)) -+ (get-geometry w) -+ ((drawable-width w) = (int-pos *width-return* 0)) -+ ((drawable-height w) = (int-pos *height-return* 0)) ) -+ -+(gldefun window-force-output (&optional (w window)) -+ (Xflush *window-display*)) -+ -+(gldefun window-query-pointer ((w window)) -+ (window-query-pointer-b (parent w)) ) -+ -+(defun window-query-pointer-b (w) -+ (XQueryPointer *window-display* w -+ *root-return* *child-return* *root-x-return* *root-y-return* -+ *win-x-return* *win-y-return* *mask-return*) ) -+ -+(gldefun window-positive-y ((w window) (y integer)) ((height w) - y)) -+ -+; 08 Aug 91 -+; Set parameters of a window for drawing by XOR, saving old values. -+(gldefun window-set-xor ((w window)) -+ (let ((gc (gcontext w)) ) -+ (setq *window-save-function* (wfunction w)) -+ (XsetFunction *window-display* gc GXxor) -+ (setq *window-save-foreground* (foreground w)) -+ (XsetForeground *window-display* gc -+ (logxor *window-save-foreground* (background w))) )) -+ -+; 08 Aug 91 -+; Reset parameters of a window after change, using saved values. -+(gldefun window-unset ((w window)) -+ (let ((gc (gcontext w)) ) -+ (XsetFunction *window-display* gc *window-save-function*) -+ (XsetForeground *window-display* gc *window-save-foreground*) )) -+ -+; 04 Sep 91 -+; Reset parameters of a window, using default values. -+(gldefun window-reset ((w window)) -+ (let ((gc (gcontext w)) ) -+ (XsetFunction *window-display* gc GXcopy) -+ (XsetForeground *window-display* gc *default-fg-color*) -+ (XsetBackground *window-display* gc *default-bg-color*) )) -+ -+; 09 Aug 91; 03 Sep 92 -+; Set parameters of a window for erasing, saving old values. -+(gldefun window-set-erase ((w window)) -+ (let ((gc (gcontext w)) ) -+ (setq *window-save-function* (wfunction w)) -+ (XsetFunction *window-display* gc GXcopy) -+ (setq *window-save-foreground* (foreground w)) -+ (XsetForeground *window-display* gc (background w)) )) -+ -+(gldefun window-set-copy ((w window)) -+ (let ((gc (gcontext w)) ) -+ (setq *window-save-function* (wfunction w)) -+ (XsetFunction *window-display* gc GXcopy) -+ (setq *window-save-foreground* (foreground w)) )) -+ -+; 12 Aug 91 -+; Set parameters of a window for inversion, saving old values. -+(gldefun window-set-invert ((w window)) -+ (let ((gc (gcontext w)) ) -+ (setq *window-save-function* (wfunction w)) -+ (XsetFunction *window-display* gc GXxor) -+ (setq *window-save-foreground* (foreground w)) -+ (XsetForeground *window-display* gc -+ (logxor *window-save-foreground* (background w))) )) -+ -+; 13 Aug 91 -+(gldefun window-set-line-width ((w window) (width integer)) -+ (set-line-attr w width nil nil nil)) -+ -+; 13 Aug 91; 12 Sep 91 -+(gldefun window-set-line-attr -+ (w\:window width &optional line-style cap-style join-style) -+ (XsetLineAttributes *window-display* (gcontext w) -+ (or width 1) -+ (or line-style LineSolid) -+ (or cap-style CapButt) -+ (or join-style JoinMiter) ) ) -+ -+; 13 Aug 91 -+; Set standard line attributes -+(gldefun window-std-line-attr ((w window)) -+ (XsetLineAttributes *window-display* (gcontext w) -+ 1 LineSolid CapButt JoinMiter) ) -+ -+; 06 Aug 91; 08 Aug 91; 12 Sep 91 -+(gldefun window-draw-line ((w window) (from vector) (to vector) -+ &optional linewidth) -+ (window-draw-line-xy w (x from) (y from) (x to) (y to) linewidth) ) -+ -+; 19 Dec 90; 07 Aug 91; 08 Aug 91; 09 Aug 91; 13 Aug 91; 12 Sep 91; 28 Sep 94 -+(gldefun window-draw-line-xy ((w window) (fromx integer) -+ (fromy integer) -+ (tox integer) (toy integer) -+ &optional linewidth -+ (operation atom)) -+ (let ( (qqwheight (drawable-height w)) ) -+ (if (linewidth and (linewidth <> 1)) (set-line-width w linewidth)) -+ (case operation -+ (xor (set-xor w)) -+ (erase (set-erase w)) -+ (t nil)) -+ (XDrawLine *window-display* (parent w) (gcontext w) -+ fromx (- qqwheight fromy) tox (- qqwheight toy) ) -+ (case operation -+ ((xor erase) (unset w)) -+ (t nil)) -+ (if (linewidth and (linewidth <> 1)) (set-line-width w 1)) )) -+ -+; 09 Oct 91 -+(defun window-draw-arrowhead-xy (w x1 y1 x2 y2 &optional (linewidth 1) size) -+ (let (th theta ysth ycth (y2dela 0) (y2delb 0) (x2dela 0) (x2delb 0)) -+ (or size (setq size (+ 20 (* linewidth 5)))) -+ (setq th (atan (- y2 y1) (- x2 x1))) -+ (setq theta (* th (/ 180.0 pi))) -+ (setq ysth (round (* (1+ size) (sin th)))) -+ (setq ycth (round (* (1+ size) (cos th)))) -+ (if (and (eql y1 y2) (evenp linewidth)) ; correct for even-size lines -+ (if (> x2 x1) (setq y2delb 1) (setq y2dela 1))) -+ (if (and (eql x1 x2) (evenp linewidth)) ; correct for even-size lines -+ (if (> y2 y1) (setq x2delb 1) (setq x2dela 1))) -+ (window-draw-arc-xy w (- (- x2 ysth) x2dela) -+ (+ (+ y2 ycth) y2dela) size size -+ (+ 240 theta) 30 linewidth) -+ (window-draw-arc-xy w (- (+ x2 ysth) x2delb) -+ (+ (- y2 ycth) y2delb) size size -+ (+ 90 theta) 30 linewidth) )) -+ -+(defun window-draw-arrow-xy (w x1 y1 x2 y2 -+ &optional (linewidth 1) size) -+ (window-draw-line-xy w x1 y1 x2 y2 linewidth) -+ (window-draw-arrowhead-xy w x1 y1 x2 y2 linewidth size) ) -+ -+(defun window-draw-arrow2-xy (w x1 y1 x2 y2 -+ &optional (linewidth 1) size) -+ (window-draw-line-xy w x1 y1 x2 y2 linewidth) -+ (window-draw-arrowhead-xy w x1 y1 x2 y2 linewidth size) -+ (window-draw-arrowhead-xy w x2 y2 x1 y1 linewidth size) ) -+ -+; 08 Aug 91; 14 Aug 91; 12 Sep 91 -+(gldefun window-draw-box -+ ((w window) (offset vector) (size vector) &optional linewidth) -+ (window-draw-box-xy w (x offset) (y offset) (x size) (y size) linewidth) ) -+ -+; 08 Aug 91; 12 Sep 91; 11 Dec 91; 01 Sep 92; 02 Sep 92; 17 Jul 06 -+; New version avoids XDrawRectangle, which messes up when used with XOR. -+; was (XDrawRectangle *window-display* (parent w) (gcontext w) -+; offsetx (- qqwheight (offsety + sizey)) sizex sizey) -+(gldefun window-draw-box-xy -+ ((w window) (offsetx integer) (offsety integer) -+ (sizex integer) (sizey integer) &optional linewidth) -+ (let ((qqwheight (drawable-height w)) lw lw2 lw2b (pw (parent w)) -+ (gc (gcontext w))) -+ (if (linewidth and (linewidth <> 1)) (set-line-width w linewidth)) -+ (lw = (or linewidth 1)) -+ (lw2 = (truncate lw 2)) -+ (lw2b = (truncate (lw + 1) 2)) -+ (XdrawLine *window-display* pw gc -+ (- offsetx lw2) (- qqwheight offsety) -+ (- (+ offsetx sizex) lw2) (- qqwheight offsety)) -+ (XdrawLine *window-display* pw gc -+ (+ offsetx sizex) (- qqwheight (- offsety lw2b)) -+ (+ offsetx sizex) (- qqwheight (+ sizey (- offsety lw2b)))) -+ (XdrawLine *window-display* pw gc -+ (+ offsetx sizex lw2b) (- qqwheight (+ offsety sizey)) -+ (+ offsetx lw2b) (- qqwheight (+ offsety sizey))) -+ (XdrawLine *window-display* pw gc -+ offsetx (- qqwheight (+ offsety sizey lw2)) -+ offsetx (- qqwheight (+ offsety lw2)) ) -+ (if (linewidth and (linewidth <> 1)) (set-line-width w 1)) )) -+ -+; 26 Nov 91 -+(gldefun window-xor-box-xy -+ ((w window) (offsetx integer) (offsety integer) -+ (sizex integer) (sizey integer) -+ &optional linewidth) -+ (window-set-xor w) -+ (window-draw-box-xy w offsetx offsety sizex sizey linewidth) -+ (window-unset w)) -+ -+; 15 Aug 91; 12 Sep 91 -+; Draw a box whose corners are specified -+(gldefun window-draw-box-corners ((w window) (xa integer) (ya integer) -+ (xb integer) (yb integer) -+ &optional lw) -+ (draw-box-xy w (min xa xb) (min ya yb) (abs (- xa xb)) (abs (- ya yb)) lw) ) -+ -+; 13 Sep 91; 17 Jul 06 -+; Draw a box with round corners -+(gldefun window-draw-rcbox-xy ((w window) (x integer) (y integer) -+ (width integer) -+ (height integer) (radius integer) -+ &optional linewidth) -+ (let (x1 x2 y1 y2 r lw2 lw2b fudge) -+ (r = (max 0 (min radius (truncate (abs width) 2) -+ (truncate (abs height) 2)))) -+ (if (not (numberp linewidth)) (linewidth = 1)) -+ (lw2 = (truncate linewidth 2)) -+ (lw2b = (truncate (1+ linewidth) 2)) -+ (fudge = (if (oddp linewidth) 0 1)) -+ (x1 = x + r) -+ (x2 = x + width - r) -+ (y1 = y + r) -+ (y2 = y + height - r) -+ (draw-line-xy w (- (- x1 1) lw2) y x2 y linewidth) ; bottom -+ (draw-line-xy w (x + width) (- y1 lw2b) (x + width) (+ y2 1) -+ linewidth) ; right -+ (draw-line-xy w (- x1 1) (+ y height) (+ x2 lw2) (+ y height) linewidth) -+ (draw-line-xy w x y1 x (+ y2 1) linewidth) ; left -+ (draw-arc-xy w (- x1 fudge) y1 r r 180 90 linewidth) -+ (draw-arc-xy w x2 y1 r r 270 90 linewidth) -+ (draw-arc-xy w x2 (+ y2 fudge) r r 0 90 linewidth) -+ (draw-arc-xy w (- x1 fudge) (+ y2 fudge) r r 90 90 linewidth) )) -+ -+; 13 Aug 91; 15 Aug 91; 12 Sep 91 -+(gldefun window-draw-arc-xy ((w window) (x integer) (y integer) -+ (radiusx integer) (radiusy integer) -+ (anglea number) (angleb number) -+ &optional linewidth) -+ (if (linewidth and (linewidth <> 1)) (set-line-width w linewidth)) -+ (XdrawArc *window-display* (parent w) (gcontext w) -+ (x - radiusx) (positive-y w (y + radiusy)) -+ (radiusx * 2) (radiusy * 2) -+ (truncate (* anglea 64)) (truncate (* angleb 64))) -+ (if (linewidth and (linewidth <> 1)) (set-line-width w 1)) ) -+ -+; 08 Aug 91; 12 Sep 91 -+(gldefun window-draw-circle-xy ((w window) (x integer) (y integer) -+ (radius integer) -+ &optional linewidth) -+ (if (linewidth and (linewidth <> 1)) (set-line-width w linewidth)) -+ (XdrawArc *window-display* (parent w) (gcontext w) -+ (x - radius) (positive-y w (y + radius)) -+ (radius * 2) (radius * 2) 0 (* 360 64)) -+ (if (linewidth and (linewidth <> 1)) (set-line-width w 1)) ) -+ -+; 06 Aug 91; 14 Aug 91; 12 Sep 91 -+(gldefun window-draw-circle ((w window) (pos vector) (radius integer) -+ &optional linewidth) -+ (window-draw-circle-xy w (x pos) (y pos) radius linewidth) ) -+ -+; 08 Aug 91; 09 Sep 91 -+(gldefun window-erase-area ((w window) (offset vector) (size vector)) -+ (window-erase-area-xy w (x offset) (y offset) (x size) (y size))) -+ -+; 09 Sep 91; 11 Dec 91 -+(gldefun window-erase-area-xy ((w window) (xoff integer) (yoff integer) -+ (xsize integer) (ysize integer)) -+ (XClearArea *window-display* (parent w) -+ xoff (positive-y w (yoff + ysize - 1)) -+ xsize ysize -+ 0 )) ; exposures -+ -+; 21 Dec 93; 08 Sep 06 -+(gldefun window-erase-box-xy ((w window) (xoff integer) (yoff integer) -+ (xsize integer) (ysize integer) -+ &optional (linewidth integer)) -+ (XClearArea *window-display* (parent w) -+ (xoff - (truncate (or linewidth 1) 2)) -+ (positive-y w (+ yoff ysize (truncate (or linewidth 1) 2))) -+ (xsize + (or linewidth 1)) -+ (ysize + (or linewidth 1)) -+ 0 )) ; exposures -+ -+; 15 Aug 91; 12 Sep 91 -+(gldefun window-draw-ellipse-xy ((w window) (x integer) (y integer) -+ (rx integer) (ry integer) &optional lw) -+ (draw-arc-xy w x y rx ry 0 360 lw)) -+ -+; 09 Aug 91 -+(gldefun window-copy-area-xy ((w window) fromx (fromy integer) -+ tox (toy integer) width height) -+ (let ((qqwheight (drawable-height w))) -+ (set-copy w) -+ (XCopyArea *window-display* (parent w) (parent w) (gcontext w) -+ fromx (- qqwheight (+ fromy height)) -+ width height -+ tox (- qqwheight (+ toy height))) -+ (unset w) )) -+ -+; 07 Dec 90; 09 Aug 91; 12 Sep 91 -+(gldefun window-invertarea ((w window) (area region)) -+ (window-invert-area-xy w (left area) (bottom area) -+ (width area) (height area))) -+ -+; 07 Dec 90; 09 Aug 91; 12 Sep 91 -+(gldefun window-invert-area ((w window) (offset vector) (size vector)) -+ (window-invert-area-xy w (x offset) (y offset) (x size) (y size)) ) -+ -+; 12 Aug 91; 15 Aug 91; 13 Dec 91 -+(gldefun window-invert-area-xy ((w window) left (bottom integer) width height) -+ (set-invert w) -+ (XFillRectangle *window-display* (parent w) (gcontext w) -+ left (- (drawable-height w) (bottom + height - 1)) -+ width height) -+ (unset w) ) -+ -+; 05 Dec 90; 15 Aug 91 -+(gldefun window-prettyprintat ((w window) (s string) (pos vector)) -+ (printat w s pos) ) -+ -+(gldefun window-prettyprintat-xy ((w window) (s string) (x integer) -+ (y integer)) -+ (printat-xy w s x y)) -+ -+; 06 Aug 91; 08 Aug 91; 15 Aug 91 -+(gldefun window-printat ((w window) (s string) (pos vector)) -+ (printat-xy w s (x pos) (y pos)) ) -+ -+; 06 Aug 91; 08 Aug 91; 12 Aug 91 -+(gldefun window-printat-xy ((w window) (s string) (x integer) (y integer)) -+ (let ( (sstr (stringify s)) ) -+ (XdrawImageString *window-display* (parent w) (gcontext w) -+ x (- (drawable-height w) y) -+ (get-c-string sstr) (length sstr)) )) -+ -+; 19 Apr 95; 02 May 95; 17 May 04 -+; Print a string that may contain #\Newline characters in a window. -+(gldefun window-print-line ((w window) (str string) (x integer) (y integer) -+ &optional (deltay integer)) -+ (let ((lng (length str)) (n 0) end strb done) -+ (while ~done -+ (end = (position #\Newline str :test #'char= :start n)) -+ (strb = (subseq str n end)) -+ (printat-xy w strb x y) -+ (if (numberp end) -+ (n = (1+ end)) -+ (done = t)) -+ (y _- (or deltay 16)) -+ (if (y < 0) (done = t))) -+ (force-output w) )) -+ -+; 02 May 95; 08 May 95 -+; Print a list of strings in a window. -+(gldefun window-print-lines ((w window) (lines (listof string)) -+ (x integer) (y integer) -+ &optional (deltay integer)) -+ (for str in lines when (y > 0) (printat-xy w str x y) (y _- (or deltay 16))) ) -+ -+; 08 Aug 91 -+; Find the width of a string when printed in a given window -+(gldefun window-string-width ((w window) (s string)) -+ (let ((sstr (stringify s))) -+ (XTextWidth (font w) (get-c-string sstr) (length sstr)) )) -+ -+; 01 Dec 93 -+; Find the ascent and descent of a string when printed in a given window -+(gldefun window-string-extents ((w window) (s string)) -+ (let ((sstr (stringify s))) -+ (XTextExtents (font w) (get-c-string sstr) (length sstr) -+ *direction-return* *ascent-return* *descent-return* *overall-return*) -+ (list (int-pos *ascent-return* 0) -+ (int-pos *descent-return* 0)) )) -+ -+; Find the height (ascent + descent) of a string when printed in a given window -+(gldefun window-string-height ((w window) (s string)) -+ (let ((sstr (stringify s))) -+ (XTextExtents (font w) (get-c-string sstr) (length sstr) -+ *direction-return* *ascent-return* *descent-return* *overall-return*) -+ (+ (int-pos *ascent-return* 0) -+ (int-pos *descent-return* 0)) )) -+ -+; 15 Oct 91 -+(gldefun window-font-string-width (font (s string)) -+ (let ((sstr (stringify s))) -+ (XTextWidth font (get-c-string sstr) (length sstr)) )) -+ -+(gldefun window-yposition ((w window)) -+ (window-get-mouse-position) -+ (positive-y w (- *mouse-y* (top-neg-y w))) ) -+ -+(gldefun window-centeroffset ((w window) (v vector)) -+ (a vector with x = (truncate ((width w) - (x v)) 2) -+ y = (truncate ((height w) - (y v)) 2))) -+ -+; 18 Aug 89; 15 Aug 91 -+; Command to a window display manager -+(gldefun dowindowcom ((w window)) -+ (let (comm) -+ (comm = (select (window-menu)) ) -+ (case comm -+ (close (close w)) -+ (paint (paint w)) -+ (clear (clear w)) -+ (move (move w)) -+ (t (when comm -+ (princ "This command not implemented.") (terpri))) ) )) -+ -+(gldefun window-menu () -+ (result menu) -+ (or *window-menu* -+ (setq *window-menu* -+ (a menu with items = '(close paint clear move)))) ) -+ -+; 06 Dec 90; 11 Mar 93 -+(gldefun window-close ((w window)) -+ (unmap w) -+ (force-output w) -+ (window-wait-unmap w)) -+ -+(gldefun window-unmap ((w window)) -+ (XUnMapWindow *window-display* (parent w)) ) -+ -+; 06 Aug 91; 22 Aug 91 -+(gldefun window-open ((w window)) -+ (mapw w) -+ (force-output w) -+ (wait-exposure w) ) -+ -+(gldefun window-map ((w window)) -+ (XMapWindow *window-display* (parent w)) ) -+ -+; 08 Aug 91; 02 Sep 91 -+(gldefun window-destroy ((w window)) -+ (XDestroyWindow *window-display* (parent w)) -+ (force-output w) -+ ((parent w) = nil) -+ (XFreeGC *window-display* (gcontext w)) -+ ((gcontext w) = nil) ) -+ -+; 09 Sep 91 -+; Wait 3 seconds, then destroy the window where the mouse is. Use with care. -+(defun window-destroy-selected-window () -+ (prog (ww child) -+ (sleep 3) -+ (setq ww *root-window*) -+ lp (window-query-pointer-b ww) -+ (setq child (fixnum-pos *child-return* 0)) ; 22 Jun 06 -+ (if (> child 0) -+ (progn (setq ww child) (go lp))) -+ (if (/= ww *root-window*) -+ (progn (XDestroyWindow *window-display* ww) -+ (Xflush *window-display*))) )) -+ -+; 07 Aug 91 -+(gldefun window-clear ((w window)) -+ (XClearWindow *window-display* (parent w)) -+ (force-output w) ) -+ -+; 08 Aug 91 -+(gldefun window-moveto-xy ((w window) (x integer) (y integer)) -+ (XMoveWindow *window-display* (parent w) -+ x (- (window-screen-height) y)) ) -+ -+; 15 Aug 91; 05 Sep 91 -+; Paint in window with mouse: Left paints, Middle erases, Right quits. -+(defun window-paint (window) -+ (let (state) -+ (window-track-mouse window -+ #'(lambda (x y code) -+ (if (= code 1) (if (= state 1) (setq state 0) (setq state 1)) -+ (if (= code 2) (if (= state 2) (setq state 0) (setq state 2)))) -+ (if (= state 1) (window-draw-line-xy window x y x y 1 'paint) -+ (if (= state 2) (window-draw-line-xy window x y x y 1 'erase))) -+ (= code 3)) ) )) -+ -+; 15 Aug 91; 06 May 93 -+; Move a window. -+(gldefun window-move ((w window)) -+ (window-get-mouse-position) -+ (XMoveWindow *window-display* (parent w) -+ *mouse-x* (- (window-screen-height) *mouse-y*)) ) -+ -+; 15 Sep 93; 06 Jan 94 -+(gldefun window-draw-border ((w window)) -+ (draw-box-xy w 0 1 ((x (size w)) - 1) ((y (size w)) - 1)) -+ (force-output w) ) -+ -+; 13 Aug 91; 22 Aug 91; 27 Aug 91; 14 Oct 91 -+; Track the mouse within a window, calling function fn with args (x y event). -+; event is 0 = no button, 1 = left button, 2 = middle, 3 = right button. -+; Tracking continues until fn returns non-nil; result is that value. -+; Partly adapted from Hiep Nguyen's code. -+(defun window-track-mouse (w fn &optional outflg) -+ (let (win h) -+ (setq win (window-parent w)) -+ (setq h (window-drawable-height w)) -+ (Xsync *window-display* 1) ; clear event queue of prev motion events -+ (Xselectinput *window-display* win -+ (+ ButtonPressMask PointerMotionMask)) -+ ;; Event processing loop: stop when function returns non-nil. -+ (do ((res nil)) (res res) -+ (XNextEvent *window-display* *window-event*) -+ (let ((type (XAnyEvent-type *window-event*)) -+ (eventwindow (XAnyEvent-window *window-event*))) -+ (when (or (and (eql eventwindow win) -+ (or (eql type MotionNotify) -+ (eql type ButtonPress))) -+ (and outflg (eql type ButtonPress))) -+ (let ((x (XMotionEvent-x *window-event*)) -+ (y (XMotionEvent-y *window-event*)) -+ (code (if (eql type ButtonPress) -+ (XButtonEvent-button *window-event*) -+ 0))) -+ (setq res (if (eql eventwindow win) -+ (funcall fn x (- h y) code) -+ (funcall fn -1 -1 code))) ) ) ) ) )) -+ -+; 22 Aug 91; 23 Aug 91; 27 Aug 91; 04 Sep 92; 11 Mar 93 -+; Wait for a window to become exposed, but not more than 1 second. -+(defun window-wait-exposure (w) -+ (prog (win start-time max-time eventwindow type) -+ (setq win (window-parent w)) -+ (XGetWindowAttributes *window-display* win *window-attr*) -+ (unless (eql (XWindowAttributes-map_state *window-attr*) -+ ISUnmapped) -+ (return t)) -+ (setq start-time (get-internal-real-time)) -+ (setq max-time internal-time-units-per-second) -+ (Xselectinput *window-display* win (+ ExposureMask)) -+ ; Event processing loop: stop when exposure is seen or time out -+ lp (cond ((> (XPending *window-display*) 0) -+ (XNextEvent *window-display* *window-event*) -+ (setq type (XAnyEvent-type *window-event*)) -+ (setq eventwindow (XAnyEvent-window *window-event*)) -+ (if (and (eql eventwindow win) -+ (eql type Expose)) -+ (return t))) -+ ((> (- (get-internal-real-time) start-time) -+ max-time) -+ (return nil)) ) -+ (go lp) )) -+ -+; 11 Mar 93; 06 May 93 -+; Wait for a window to become unmapped, but not more than 1 second. -+(defun window-wait-unmap (w) -+ (prog (win start-time max-time) -+ (setq win (window-parent w)) -+ (setq start-time (get-internal-real-time)) -+ (setq max-time internal-time-units-per-second) -+lp (XGetWindowAttributes *window-display* win *window-attr*) -+ (if (eql (XWindowAttributes-map_state *window-attr*) -+ ISUnmapped) -+ (return t) -+ (if (> (- (get-internal-real-time) start-time) max-time) -+ (return nil))) -+ (go lp) )) -+ -+; 07 Oct 93 -+; Initialize to poll the mouse for a specified window -+(defun window-init-mouse-poll (w) -+ (let (win) -+ (setq win (window-parent w)) -+ (Xsync *window-display* 1) ; clear event queue of prev motion events -+ (Xselectinput *window-display* win -+ (+ ButtonPressMask PointerMotionMask)) )) -+ -+; 07 Oct 93 -+; Poll the mouse for a position change or button push -+; Returns nil if no mouse activity, -+; else (x y code), where x and y are positions, or nil if no movement, -+; and code is 0 if no button else button number -+(defun window-poll-mouse (w) -+ (let (win h eventtype eventwindow x y cd (code 0)) -+ (setq win (window-parent w)) -+ (setq h (window-drawable-height w)) -+ (while (> (XPending *window-display*) 0) -+ (XNextEvent *window-display* *window-event*) -+ (setq eventtype (XAnyEvent-type *window-event*)) -+ (setq eventwindow (XAnyEvent-window *window-event*)) -+ (if (eql eventwindow win) -+ (if (eql eventtype MotionNotify) -+ (progn (setq x (XMotionEvent-x *window-event*)) -+ (setq y (XMotionEvent-y *window-event*))) -+ (if (eql eventtype ButtonPress) -+ (if (> (setq cd (XButtonEvent-button *window-event*)) -+ 0) -+ (setq code cd))))) ) -+ (if (or x (> code 0)) (list x (if y (- h y)) code)) )) -+ -+; 14 Dec 90; 17 Dec 90; 13 Aug 91; 20 Aug 91; 30 Aug 91; 09 Sep 91; 11 Sep 91 -+; 15 Oct 91; 16 Oct 91; 10 Feb 92; 25 Sep 92; 26 Sep 92 -+; Initialize a menu -+(gldefun menu-init ((m menu)) -+ (let () -+ (or *window-display* (window-Xinit)) ; init windows if necessary -+ (calculate-size m) -+ (if ~ (flat m) -+ ((menu-window m) = (window-create (picture-width m) -+ (picture-height m) -+ ((title m) or "") -+ (parent-window m) -+ (parent-offset-x m) -+ (parent-offset-y m) -+ (menu-font m) )) ) )) -+ -+; 25 Sep 92; 26 Sep 92; 11 Mar 93; 05 Oct 93; 08 Oct 93; 17 May 04; 12 Jan 10 -+; Calculate the displayed size of a menu -+(gldefun menu-calculate-size ((m menu)) -+ (let (maxwidth totalheight nitems) -+ (or (menu-font m) ((menu-font m) = '9x15)) -+ (maxwidth = (find-item-width m (title m)) -+ + (if (or (flat m) *window-add-menu-title*) -+ 0 -+ *menu-title-pad*)) -+ (nitems = (if (and (title-present m) -+ (or (flat m) *window-add-menu-title*)) -+ 1 0)) -+ (totalheight = (* nitems 13)) ; ***** fix for font -+ (for item in (items m) do -+ (nitems _+ 1) -+ (maxwidth = (max maxwidth (find-item-width m item))) -+ (totalheight =+ (menu-find-item-height m item)) ) -+ ((item-width m) = maxwidth + 6) -+ ((picture-width m) = (item-width m) + 1) -+ ((picture-height m) = totalheight + 2) -+ (adjust-offset m) )) -+ -+; 06 Sep 91; 09 Sep 91; 10 Sep 91; 21 May 93; 30 May 02; 17 May 04; 08 Sep 06 -+; Adjust a menu's offset position if necessary to keep it in parent window. -+(gldefun menu-adjust-offset ((m menu)) -+ (let (xbase ybase wbase hbase xoff yoff wgm width height) -+ (width = (picture-width m)) -+ (height = (picture-height m)) -+ (if ~ (parent-window m) -+ (progn (window-get-mouse-position) ; put it where the mouse is -+ (wgm = t) ; set flag that we got mouse position -+ ((parent-window m) = *root-window*))) ; 21 May 93 was *mouse-window* -+ (window-get-geometry-b (parent-window m)) -+ (setq xbase (int-pos *x-return* 0)) -+ (setq ybase (int-pos *y-return* 0)) -+ (setq wbase (int-pos *width-return* 0)) -+ (setq hbase (int-pos *height-return* 0)) -+ (if (~ (parent-offset-x m) or (parent-offset-x m) == 0) -+ (progn (or wgm (window-get-mouse-position)) -+ (xoff = ((*mouse-x* - xbase) - (truncate width 2) - 4)) -+ (yoff = ((hbase - (*mouse-y* - ybase)) - (truncate height 2)))) -+ (progn (xoff = (parent-offset-x m)) -+ (yoff = (parent-offset-y m)))) -+ ((parent-offset-x m) = (max 0 (min xoff (wbase - width)))) -+ ((parent-offset-y m) = (max 0 (min yoff (hbase - height)))) )) -+ -+; 07 Dec 90; 14 Dec 90; 12 Aug 91; 22 Aug 91; 09 Sep 91; 10 Sep 91; 28 Jan 92; -+; 10 Feb 92; 26 Sep 92; 11 Mar 93; 08 Oct 93; 17 May 04; 12 Jan 10 -+(gldefun menu-draw ((m menu)) -+ (let (mw xzero yzero bottom) -+ (init? m) -+ (xzero = (menu-x m 0)) -+ (yzero = (menu-y m 0)) -+ (mw = (menu-window m)) -+ (open mw) -+ (clear m) -+ (if (flat m) (draw-box-xy mw (xzero - 1) yzero ((picture-width m) + 2) -+ ((picture-height m) + 1) 1)) -+ (bottom = (yzero + (picture-height m) + 3)) -+ (if (and (title-present m) -+ (or (flat m) *window-add-menu-title*)) -+ (progn (bottom _- 15) ; ***** fix for font -+ (printat-xy mw (stringify (title m)) (+ xzero 3) bottom) -+ (invert-area-xy mw xzero (bottom - 2) -+ ((picture-width m) + 1) 15))) -+ (for item in (items m) do -+ (bottom _- (menu-find-item-height m item)) -+ (display-item m item (+ xzero 3) bottom) ) -+ (force-output mw) )) -+ -+; 17 May 04 -+(gldefun menu-item-value (self item) -+ (if (consp item) (cdr item) item)) -+ -+; 06 Sep 91; 11 Sep 91; 15 Oct 91; 16 Oct 91; 23 Oct 91; 17 May 04 -+(gldefun menu-find-item-width ((self menu) item) -+ (let ((tmp vector)) -+ (if (and (consp item) -+ (symbolp (car item)) -+ (fboundp (car item))) -+ (or (and (tmp = (get (car item) 'display-size)) -+ (x tmp)) -+ 40) -+ (window-font-string-width -+ (or (and (flat self) -+ (menu-window self) -+ (font (menu-window self))) -+ (window-font-info (menu-font self))) -+ (stringify (if (consp item) (car item) item)))) )) -+ -+ -+; 09 Sep 91; 10 Sep 91; 11 Sep 91; 17 mAY 04 -+(gldefun menu-find-item-height ((self menu) item) ; ***** fix for font -+ (let ((tmp vector)) -+ (if (and (consp item) -+ (symbolp (car item)) -+ (tmp = (get (car item) 'display-size))) -+ ((y tmp) + 3) -+ 15) )) -+ -+; 09 Sep 91; 10 Sep 91; 10 Feb 92; 17 May 04 -+(gldefun menu-clear ((m menu)) -+ (if (flat m) -+ (erase-area-xy (menu-window m) ((base-x m) - 1) ((base-y m) - 1) -+ ((picture-width m) + 3) ((picture-height m) + 3)) -+ (clear (menu-window m))) ) -+ -+; 06 Sep 91; 04 Dec 91; 17 May 04 -+(gldefun menu-display-item ((self menu) item x y) -+ (let ((mw (menu-window self))) -+ (if (consp item) -+ (if (and (symbolp (car item)) -+ (fboundp (car item))) -+ (funcall (car item) mw x y) -+ (if (or (stringp (car item)) (symbolp (car item)) -+ (numberp (car item))) -+ (printat-xy mw (car item) x y) -+ (printat-xy mw (stringify item) x y))) -+ (printat-xy mw (stringify item) x y)) )) -+ -+; 07 Dec 90; 18 Dec 90; 15 Aug 91; 27 Aug 91; 06 Sep 91; 10 Sep 91; 29 Sep 92 -+; 04 Aug 93; 07 Jan 94; 17 May 04; 18 May 04; 12 Jan 10; 13 Jan 10 -+(gldefun menu-choose ((m menu) (inside boolean)) -+ (let (mw current-item ybase itemh val maxx maxy xzero yzero) -+ (init? m) -+ (mw = (menu-window m)) -+ (draw m) -+ (xzero = (menu-x m 0)) -+ (yzero = (menu-y m 0)) -+ (maxx = (+ xzero (picture-width m))) -+ (maxy = (+ yzero (picture-height m))) -+ (if (and (title-present m) -+ (or (flat m) *window-add-menu-title*)) -+ (maxy =- 15)) -+ (track-mouse mw -+ #'(lambda (x y code) -+ (setq *window-menu-code* code) -+ (if (and (>= x xzero) (<= x maxx) ; is mouse in menu area? -+ (>= y yzero) (<= y maxy)) -+ (if (or (null current-item) ; is mouse in a new item? -+ (< y ybase) -+ (> y (+ ybase itemh)) ) -+ (progn -+ (if current-item -+ (unbox-item m current-item ybase)) -+ (current-item = (menu-find-item-y m (- y yzero))) -+ (if current-item -+ (progn (ybase = (menu-item-y m current-item)) -+ (itemh = (menu-find-item-height -+ m current-item)) -+ (box-item m current-item ybase) -+ (inside = t))) -+ (if (> code 0) ; same item: click? -+ (progn (unbox-item m current-item ybase) -+ (val = 1)))) -+ (if (> code 0) ; same item: click? -+ (progn (unbox-item m current-item ybase) -+ (val = 1)))) -+ (progn (if current-item ; mouse outside area -+ (progn (unbox-item m current-item ybase) -+ (current-item = nil))) -+ (if (or (> code 0) -+ (and inside -+ (or (< x xzero) (> x maxx) -+ (< y yzero) (> y maxy)))) -+ (val = -777))))) -+ t) -+ (if (not (eql val -777)) (item-value m current-item)) )) -+ -+; 07 Dec 90; 12 Aug 91; 10 Sep 91; 05 Oct 92; 12 Jan 10 -+(gldefun menu-box-item ((m menu) (item menu-item) (ybase integer)) -+ (let ( (mw (menuw m)) ) -+ (set-xor mw) -+ (draw-box-xy mw (menu-x m 1) ((menu-y m ybase) + 2) -+ ((item-width m) - 2) -+ (menu-find-item-height m item) -+ 1) -+ (unset mw) )) -+ -+; 07 Dec 90; 12 Aug 91; 14 Aug 91; 15 Aug 91; 05 Oct 92; 12 Jan 10 -+(gldefun menu-unbox-item ((m menu) (item menu-item) (ybase integer)) -+ (box-item m item ybase) ) -+ -+; 11 Sep 91; 08 Sep 92; 28 Sep 92; 18 Jan 94; 08 Sep 06; 12 Jan 10; 13 Jan 10 -+(gldefun menu-item-position ((m menu) (itemname symbol) -+ &optional (place symbol)) -+ (let ( (xsize (item-width m)) ybase item ysize) -+ (item = (menu-find-item m itemname)) -+ (ysize = (menu-find-item-height m item)) -+ (ybase = (menu-item-y m item)) -+ (a vector with -+ x = ((menu-x m 0) + -+ (case place -+ ((center top bottom) (truncate xsize 2)) -+ (left -1) -+ (right xsize + 2) -+ else 0)) -+ y = ((menu-y m ybase) + -+ (case place -+ ((center right left) (truncate ysize 2)) -+ (bottom 0) -+ (top ysize) -+ else 0)) ) )) -+ -+; 13 Jan 10 -+; find the y position of bottom of item with given name -+(gldefun menu-find-item ((m menu) (itemname symbol)) -+ (let (found itms item) -+ (itms = (items m)) -+ (found = (null itemname)) -+ (while (and itms (not found)) -+ (item -_ itms) -+ (if (or (eq item itemname) -+ (and (consp item) -+ (or (eq itemname (car item)) -+ (and (stringp (car item)) -+ (string= (stringify itemname) (car item))) -+ (eq (cdr item) itemname) -+ (and (consp (cdr item)) -+ (eq (cadr item) itemname))))) -+ (found = t))) -+ item)) -+ -+; 12 Jan 10 -+; find the y position of bottom of a given item -+(gldefun menu-item-y ((m menu) (item menu-item)) -+ (let (found itms itm ybase) -+ (ybase = (picture-height m) - 1) -+ (if (and (title-present m) -+ (or (flat m) *window-add-menu-title*)) -+ (ybase =- 15)) -+ (itms = (items m)) -+ (while (and itms (not found)) -+ (itm -_ itms) -+ (ybase =- (menu-find-item-height m itm)) -+ (found = (eq item itm)) ) -+ ybase)) -+ -+; 12 Jan 10 -+; find item based on y position -+(gldefun menu-find-item-y ((m menu) (y integer)) -+ (let (found itms itm ybase) -+ (ybase = (picture-height m) - 1) -+ (if (and (title-present m) -+ (or (flat m) *window-add-menu-title*)) -+ (ybase =- 15)) -+ (itms = (items m)) -+ (while (and itms (not found)) -+ (itm -_ itms) -+ (ybase =- (menu-find-item-height m itm)) -+ (found = (and (>= y ybase) -+ (<= y (+ ybase (menu-find-item-height m itm)))))) -+ (and found itm))) -+ -+; 10 Dec 90; 13 Dec 90; 10 Sep 91; 29 Sep 92; 17 May 04 -+; Choose from menu, then close it -+(gldefun menu-select ((m menu) &optional inside) (menu-select-b m nil inside)) -+(gldefun menu-select! ((m menu)) (menu-select-b m t nil)) -+(gldefun menu-select-b ((m menu) (flg boolean) (inside boolean)) -+ (prog (res) -+lp (res = (choose m inside)) -+ (if (flg and ~res) (go lp)) -+ (if ~(permanent m) -+ (if (flat m) -+ (progn (clear m) -+ (force-output (menu-window m))) -+ (close (menu-window m)))) -+ (return res))) -+ -+; 12 Aug 91; 17 May 04 -+(gldefun menu-destroy ((m menu)) -+ (if ~ (flat m) -+ (progn (destroy (menu-window m)) -+ ((menu-window m) = nil) ))) -+ -+; 19 Aug 91; 02 Sep 91 -+; Easy interface to make a menu, select from it, and destroy it. -+(defun menu (items &optional title) -+ (let (m res) -+ (setq m (menu-create items title)) -+ (setq res (menu-select m)) -+ (menu-destroy m) -+ res )) -+ -+; 12 Aug 91; 15 Aug 91; 06 Sep 91; 09 Sep 91; 12 Sep 91; 23 Oct 91; 17 May 04 -+; Simple call from plain Lisp to make a menu. -+(setf (glfnresulttype 'menu-create) 'menu) -+(gldefun menu-create (items &optional title (parentw window) x y -+ (perm boolean) (flat boolean) (font symbol)) -+ (a menu with title = (if title (stringify title) "") -+ menu-window = (if flat parentw) -+ items = items -+ parent-window = (parent parentw) -+ parent-offset-x = x -+ parent-offset-y = y -+ permanent = perm -+ flat = flat -+ menu-font = font )) -+ -+; 15 Oct 91; 30 Oct 91 -+(gldefun menu-offset ((m menu)) -+ (result vector) -+ (a vector with x = (base-x m) y = (base-y m))) -+ -+; 15 Oct 91; 30 Oct 91; 25 Sep 92; 29 Sep 92; 18 Apr 95; 25 Jul 96 -+(gldefun menu-size ((m menu)) -+ (result vector) -+ (if ((picture-width m) <= 0) -+ (case (first m) -+ (picmenu (picmenu-calculate-size m)) -+ (barmenu (barmenu-calculate-size m)) -+ (textmenu (textmenu-calculate-size m)) -+ (editmenu (editmenu-calculate-size m)) -+ (t (menu-calculate-size m)))) -+ (a vector with x = (picture-width m) y = (picture-height m)) ) -+ -+; 15 Oct 91; 17 May 04 -+(gldefun menu-moveto-xy ((m menu) (x integer) (y integer)) -+ (if (flat m) -+ (progn ((parent-offset-x m) = x) -+ ((parent-offset-y m) = y) -+ (adjust-offset m)) )) -+ -+; 27 Nov 92; 17 May 04 -+; Reposition a menu to a position specified by the user by mouse click -+(gldefun menu-reposition ((m menu)) -+ (let (sizev pos) -+ (if (flat m) -+ (progn (sizev = (size m)) -+ (pos = (get-box-position (menu-window m) (x sizev) (y sizev))) -+ (moveto-xy m (x pos) (y pos)) ) ))) -+ -+; 31 Aug 09 -+; Reposition a menu to a position specified by the user by mouse click -+(gldefun menu-reposition-line ((m menu) (offset vector) (target vector)) -+ (let (sizev pos) -+ (if (flat m) -+ (progn (sizev = (size m)) -+ (pos = (get-box-line-position (menu-window m) -+ (x sizev) (y sizev) (x offset) (y offset) -+ (x target) (y target))) -+ (moveto-xy m (x pos) (y pos)) ) ))) -+ -+; 09 Sep 91; 11 Sep 91; 12 Sep 91; 14 Sep 91 -+; Simple call from plain Lisp to make a picture menu. -+(setf (glfnresulttype 'picmenu-create) 'picmenu) -+(gldefun picmenu-create -+ (buttons (width integer) (height integer) drawfn -+ &optional title (dotflg boolean) (parentw window) x y (perm boolean) -+ (flat boolean) (font symbol) (boxflg boolean)) -+ (picmenu-create-from-spec -+ (picmenu-create-spec buttons width height drawfn dotflg font) -+ title parentw x y perm flat boxflg)) -+ -+; 14 Sep 91 -+(setf (glfnresulttype 'picmenu-create-spec) 'picmenu-spec) -+(gldefun picmenu-create-spec (buttons (width integer) (height integer) drawfn -+ &optional (dotflg boolean) (font symbol)) -+ (a picmenu-spec with drawing-width = width -+ drawing-height = height -+ buttons = buttons -+ dotflg = dotflg -+ drawfn = drawfn -+ menu-font = (font or '9x15))) -+ -+; 14 Sep 91; 17 May 04 -+(setf (glfnresulttype 'picmenu-create-from-spec) 'picmenu) -+(gldefun picmenu-create-from-spec -+ ((spec picmenu-spec) &optional title (parentw window) x y -+ (perm boolean) (flat boolean) (boxflg boolean)) -+ (a picmenu with title = (if title (stringify title) "") -+ menu-window = (if flat parentw) -+ parent-window = (if parentw (parent parentw)) -+ parent-offset-x = x -+ parent-offset-y = y -+ permanent = perm -+ flat = flat -+ spec = spec -+ boxflg = boxflg -+)) -+ -+; 29 Sep 92; 13 Oct 93; 17 May 04 -+(gldefun picmenu-calculate-size ((m picmenu)) -+ (let (maxwidth maxheight) -+ (maxwidth = (max (if (title m) ((* 9 (length (title m))) + 6) -+ 0) -+ (drawing-width m))) -+ (maxheight = (if (and (title-present m) -+ (or (flat m) *window-add-menu-title*)) -+ 15 0) -+ + (drawing-height m)) -+ ((picture-width m) = maxwidth) -+ ((picture-height m) = maxheight) )) -+ -+; 09 Sep 91; 10 Sep 91; 29 Sep 92 -+; Initialize a picture menu -+(gldefun picmenu-init ((m picmenu)) -+ (let () -+ (calculate-size m) -+ (adjust-offset m) -+ (if ~ (flat m) -+ ((menu-window m) = (window-create (picture-width m) -+ (picture-height m) -+ ((title m) or "") -+ (parent-window m) -+ (parent-offset-x m) -+ (parent-offset-y m) -+ (menu-font m) )) ) )) -+ -+; 09 Sep 91; 10 Sep 91; 11 Sep 91; 10 Feb 92; 05 Oct 92; 30 Oct 92; 13 Oct 93 -+; 17 May 04 -+; Draw a picture menu -+(gldefun picmenu-draw ((m picmenu)) -+ (let (mw bottom xzero yzero) -+ (init? m) -+ (mw = (menu-window m)) -+ (open mw) -+ (clear m) -+ (xzero = (menu-x m 0)) -+ (yzero = (menu-y m 0)) -+ (bottom = yzero + (picture-height m)) -+ (if (and (title-present m) -+ (or (flat m) *window-add-menu-title*)) -+ (progn (printat-xy mw (stringify (title m)) (xzero + 3) (bottom - 13)) -+ (invert-area-xy mw xzero (bottom - 15) (picture-width m) 16))) -+ (funcall (drawfn m) mw xzero yzero) -+ (if (boxflg m) (draw-box-xy mw xzero yzero -+ (picture-width m) (picture-height m) 1)) -+ (if (dotflg m) -+ (for b in (buttons m) do (draw-button m b)) ) -+ ((deleted-buttons m) = nil) -+ (force-output mw) )) -+ -+; 28 Oct 09 -+(gldefun picmenu-draw-named-button ((m picmenu) (nm symbol)) -+ (draw-button m (assoc nm (buttons m)))) -+ -+; 28 Oct 09 -+(gldefun picmenu-set-named-button-color ((m picmenu) (nm symbol) (color rgb)) -+ (let (lst) -+ (if (lst = (assoc nm (button-colors m))) -+ ((color lst) = color) -+ ((button-colors m) +_ (list nm color)) ) )) -+ -+; 05 Oct 92; 28 Oct 09 -+(gldefun picmenu-draw-button ((m picmenu) (b picmenu-button)) -+ (let ((mw (menu-window m)) col) -+ (set-invert mw) -+ (draw-box-xy mw ((menu-x m 0) + (x (offset b)) - 2) -+ ((menu-y m 0) + (y (offset b)) - 2) -+ 4 4 1) -+ (unset mw) -+ (if (setq col (assoc (buttonname b) (button-colors m))) -+ (progn (window-set-color-rgb mw (red (color col)) (green (color col)) -+ (blue (color col))) -+ (draw-box-xy mw ((menu-x m 0) + (x (offset b)) - 1) -+ ((menu-y m 0) + (y (offset b)) - 1) -+ 3 3 2) -+ (window-reset-color mw)) ) )) -+ -+; 05 Oct 92; 30 Oct 92; 17 May 04 -+; Delete a button and erase it from the display -+(gldefun picmenu-delete-named-button ((m picmenu) (name symbol)) -+ (let (b) -+ (if (and (b = (assoc name (buttons m))) -+ ~ (name <= (deleted-buttons m))) -+ (progn (if (dotflg m) (draw-button m b)) -+ ((deleted-buttons m) +_ name) )) -+ (force-output (menu-window m)) )) -+ -+; 09 Sep 91; 10 Sep 91; 18 Sep 91; 29 Sep 92; 26 Oct 92; 30 Oct 92; 06 May 93 -+; 04 Aug 93; 07 Jan 94; 30 May 02; 17 May 04; 18 May 04; 01 Jun 04; 24 Jan 06 -+; inside = t if the mouse is already inside the menu area -+; anyclick = value to return for a mouse click that is not on a button. -+(gldefun picmenu-select ((m picmenu) &optional inside anyclick) -+ (let (mw (current-button picmenu-button) item items (val picmenu-button) -+ xzero yzero codeval) -+ (mw = (menuw m)) -+ (if ~ (permanent m) (draw m)) -+ (xzero = (menu-x m 0)) -+ (yzero = (menu-y m 0)) -+ (track-mouse mw -+ #'(lambda (x y code) -+ (setq *window-menu-code* code) -+ (x = (x - xzero)) -+ (y = (y - yzero)) -+ (if ((x >= 0) and (x <= (picture-width m)) -+ and (y >= 0) and (y <= (picture-height m))) -+ (inside = t)) -+ (if current-button -+ (if ~ (containsxy? current-button x y) -+ (progn (unbox-item m current-button) -+ (current-button = nil)))) -+ (if ~ current-button -+ (progn (items = (buttons m)) -+ (while ~ current-button and (item -_ items) do -+ (if (and (containsxy? item x y) -+ (not ((buttonname item) <= -+ (deleted-buttons m)))) -+ (progn (box-item m item) -+ (current-button = item)))))) -+ (if (or (> code 0) -+ (and inside (or (x < 0) (x > (picture-width m)) -+ (y < 0) (y > (picture-height m))))) -+ (progn (if current-button (unbox-item m current-button)) -+ (codeval = code) -+ (val = (if (and (> code 0) current-button) -+ current-button -+ *picmenu-no-selection*)) ))) -+ t) -+ (if ~(permanent m) -+ (if (flat m) (progn (clear m) -+ (force-output (menu-window m))) -+ (close (menu-window m)))) -+ (if (val == *picmenu-no-selection*) -+ (and (> codeval 0) anyclick) -+ (buttonname val)) )) -+ -+ -+; 09 Sep 91; 10 Sep 91; 17 May 04; 08 Sep 06 -+(gldefun picmenu-box-item ((m picmenu) (item picmenu-button)) -+ (let ((mw (menuw m)) xoff yoff siz) -+ (xoff = (menu-x m (x (offset item)))) -+ (yoff = (menu-y m (y (offset item)))) -+ (if (highlightfn item) -+ (funcall (highlightfn item) (menuw m) xoff yoff) -+ (progn (set-xor mw) -+ (if (siz = (size item)) -+ (draw-box-xy mw (xoff - (truncate (x siz) 2)) -+ (yoff - (truncate (y siz) 2)) -+ (x siz) (y siz) 1) -+ (draw-box-xy mw (xoff - 6) (yoff - 6) 12 12 1)) -+ (unset mw) -+ (force-output mw) ) ))) -+ -+; 09 Sep 91; 06 May 93; 17 May 04 -+(gldefun picmenu-unbox-item ((m picmenu) (item picmenu-button)) -+ (let ((mw (menuw m))) -+ (if (unhighlightfn item) -+ (progn (funcall (unhighlightfn item) (menuw m) -+ (x (offset item)) (y (offset item))) -+ (force-output mw)) -+ (box-item m item) ) )) -+ -+(defun picmenu-destroy (m) (menu-destroy m)) -+ -+; 09 Sep 91; 10 Sep 91; 11 Sep 91; 08 Sep 06 -+(gldefun picmenu-button-containsxy? ((b picmenu-button) (x integer) -+ (y integer)) -+ (let ((xsize 6) (ysize 6)) -+ (if (size b) (progn (xsize = (truncate (x (size b)) 2)) -+ (ysize = (truncate (y (size b)) 2)))) -+ ((x >= ((x (offset b)) - xsize)) and (x <= ((x (offset b)) + xsize)) and -+ (y >= ((y (offset b)) - ysize)) and (y <= ((y (offset b)) + ysize)) ) )) -+ -+; 11 Sep 91; 08 Sep 92; 18 Jan 94; 30 May 02; 17 May 04; 24 Jan 06; 08 Sep 06 -+(gldefun picmenu-item-position ((m picmenu) (itemname symbol) -+ &optional (place symbol)) -+ (let ((b picmenu-button) (xsize 0) (ysize 0) xoff yoff) -+ (if (null itemname) -+ (progn (xsize = (picture-width m)) -+ (ysize = (truncate ((picture-height m) - (drawing-height m)) 2)) -+ (xoff = (truncate xsize 2)) -+ (yoff = (drawing-height m) + (truncate ysize 2))) -+ (if (b = (that (buttons m) with buttonname == itemname)) -+ (progn (if (size b) -+ (progn (xsize = (x (size b))) -+ (ysize = (y (size b))))) -+ (xoff = (x (offset b))) -+ (yoff = (y (offset b))) ) )) -+ (if xoff (a vector with -+ x = ((menu-x m xoff) + (case place -+ ((center top bottom) 0) -+ (left (- (truncate xsize 2))) -+ (right (truncate xsize 2)) -+ else 0)) -+ y = ((menu-y m yoff) + (case place -+ ((center right left) 0) -+ (bottom (- (truncate ysize 2))) -+ (top (truncate ysize 2)) -+ else 0))) ) )) -+ -+; 03 Jan 94; 18 Jan 94; 17 May 04 -+; Simple call from plain Lisp to make a picture menu. -+(setf (glfnresulttype 'barmenu-create) 'barmenu) -+(gldefun barmenu-create -+ ((maxval integer) (initval integer) (barwidth integer) -+ &optional title (horizontal boolean) subtrackfn subtrackparms -+ (parentw window) x y (perm boolean) (flat boolean) (color rgb)) -+ (a barmenu with title = (if title (stringify title) "") -+ menu-window = (if flat parentw) -+ parent-window = (if parentw (parent parentw)) -+ parent-offset-x = (or x 0) -+ parent-offset-y = (or y 0) -+ permanent = perm -+ flat = flat -+ value = initval -+ maxval = maxval -+ barwidth = barwidth -+ horizontal = horizontal -+ subtrackfn = subtrackfn -+ subtrackparms = subtrackparms -+ color = color) ) -+ -+; 03 Jan 94; 17 May 04 -+(gldefun barmenu-calculate-size ((m barmenu)) -+ (let (maxwidth maxheight) -+ (maxwidth = (max (if (title m) ((* 9 (length (title m))) + 6) -+ 0) -+ (barwidth m))) -+ (maxheight = (if (and (title-present m) -+ (or (flat m) *window-add-menu-title*)) -+ 15 0) -+ + (maxval m)) -+ ((picture-width m) = maxwidth) -+ ((picture-height m) = maxheight) )) -+ -+; 03 Jan 94 -+; Initialize a picture menu -+(gldefun barmenu-init ((m barmenu)) -+ (let () -+ (calculate-size m) -+ (adjust-offset m) -+ (if ~ (flat m) -+ ((menu-window m) = (window-create (picture-width m) -+ (picture-height m) -+ ((title m) or "") -+ (parent-window m) -+ (parent-offset-x m) -+ (parent-offset-y m) )) ) )) -+ -+; 03 Jan 94; 18 Jan 94; 17 May 04; 18 May 04; 08 Sep 06 -+; Draw a picture menu -+(gldefun barmenu-draw ((m barmenu)) -+ (let (mw xzero yzero) -+ (init? m) -+ (mw = (menu-window m)) -+ (open mw) -+ (clear m) -+ (xzero = (menu-x m (truncate (picture-width m) 2))) -+ (yzero = (menu-y m 0)) -+ (if (color m) (window-set-color mw (color m))) -+ (if (horizontal m) -+ (draw-line-xy (menu-window m) xzero yzero -+ (xzero + (value m)) yzero (barwidth m)) -+ (draw-line-xy (menu-window m) xzero yzero -+ xzero (+ yzero (value m)) (barwidth m)) ) -+ (if (color m) (window-reset-color mw)) -+ (force-output mw) )) -+ -+; 03 Jan 94; 04 Jan 94; 07 Jan 94; 18 Jan 94; 08 Sep 06 -+; inside = t if the mouse is already inside the menu area -+(gldefun barmenu-select ((m barmenu) &optional inside) -+ (let (mw xzero yzero val) -+ (mw = (menuw m)) -+ (if ~ (permanent m) (draw m)) -+ (xzero = (menu-x m (truncate (picture-width m) 2))) -+ (yzero = (menu-y m 0)) -+ (when (window-track-mouse-in-region mw (menu-x m 0) yzero -+ (picture-width m) (picture-height m) t t) -+ (track-mouse mw -+ #'(lambda (x y code) -+ (setq *window-menu-code* code) -+ (val = (if (horizontal m) (x - xzero) (y - yzero))) -+ (update-value m val) -+ (if (> code 0) code) )) -+ val) )) -+ -+; 03 Jan 93; 17 May 04; 08 Sep 06 -+(defvar *barmenu-update-value-cons* (cons nil nil)) ; reusable cons -+(gldefun barmenu-update-value ((m barmenu) (val integer)) -+ (let ((mw (menuw m)) xzero yzero) -+ (val = (max 0 (min val (maxval m)))) -+ (if (val <> (value m)) -+ (progn (if (val < (value m)) -+ (set-erase mw) -+ (if (color m) (window-set-color mw (color m)))) -+ (xzero = (menu-x m (truncate (picture-width m) 2))) -+ (yzero = (menu-y m 0)) -+ (if (horizontal m) -+ (draw-line-xy (menu-window m) -+ (+ xzero (value m)) yzero -+ (+ xzero val) yzero (barwidth m)) -+ (draw-line-xy (menu-window m) -+ xzero (+ yzero (value m)) -+ xzero (+ yzero val) (barwidth m)) ) -+ (if (val < (value m)) -+ (unset mw) -+ (if (color m) (window-reset-color mw)) ) -+ ((value m) = val) -+ (if (subtrackfn m) -+ (progn ((car *barmenu-update-value-cons*) = val) -+ ((cdr *barmenu-update-value-cons*) = (subtrackparms m)) -+ (apply (subtrackfn m) *barmenu-update-value-cons*))) -+ (force-output mw) ) ))) -+ -+; Functions for text input "menus". Derived from picmenu code. -+; Making text input analogous to menus allows use with menu-sets. -+ -+; 18 Apr 95; 17 May 04 -+; (setq tm (textmenu-create 200 30 nil myw 50 50 t t '9x15 t "Rutabagas")) -+; Simple call from plain Lisp to make a text menu. -+(setf (glfnresulttype 'textmenu-create) 'textmenu) -+(gldefun textmenu-create ((width integer) (height integer) -+ &optional title (parentw window) x y -+ (perm boolean) (flat boolean) -+ (font symbol) (boxflg boolean) -+ (initial-text string)) -+ (a textmenu with title = (if title (stringify title) "") -+ menu-window = (if flat parentw) -+ parent-window = (if parentw (parent parentw)) -+ parent-offset-x = (or x 0) -+ parent-offset-y = (or y 0) -+ permanent = perm -+ flat = flat -+ drawing-width = width -+ drawing-height = height -+ menu-font = (font or '9x15) -+ boxflg = boxflg -+ text = initial-text) ) -+ -+; 18 Apr 95; 17 May 04 -+(gldefun textmenu-calculate-size ((m textmenu)) -+ (let (maxwidth maxheight) -+ (maxwidth = (max (if (title m) ((* 9 (length (title m))) + 6) -+ 0) -+ (drawing-width m))) -+ (maxheight = (if (and (title-present m) -+ (or (flat m) *window-add-menu-title*)) -+ 15 0) -+ + (drawing-height m)) -+ ((picture-width m) = maxwidth) -+ ((picture-height m) = maxheight) )) -+ -+; 18 Apr 95 -+; Initialize a picture menu -+(gldefun textmenu-init ((m textmenu)) -+ (let () -+ (calculate-size m) -+ (adjust-offset m) -+ (if ~ (flat m) -+ ((menu-window m) = -+ (window-create (picture-width m) (picture-height m) -+ ((title m) or "") (parent-window m) -+ (parent-offset-x m) (parent-offset-y m) -+ (menu-font m) )) ) )) -+ -+; 18 Apr 95; 14 Aug 96; 17 May 04; 08 Sep 06 -+; Draw a picture menu -+(gldefun textmenu-draw ((m textmenu)) -+ (let (mw bottom xzero yzero) -+ (init? m) -+ (mw = (menu-window m)) -+ (open mw) -+ (clear m) -+ (xzero = (menu-x m 0)) -+ (yzero = (menu-y m 0)) -+ (bottom = yzero + (picture-height m)) -+ (if (and (title-present m) -+ (or (flat m) *window-add-menu-title*)) -+ (progn (printat-xy mw (stringify (title m)) (xzero + 3) (bottom - 13)) -+ (invert-area-xy mw xzero (bottom - 15) (picture-width m) 16))) -+ (if (text m) -+ (printat-xy mw (text m) (xzero + 10) -+ (yzero + (truncate (picture-height m) 2) - 8))) -+ (if (boxflg m) (draw-box-xy mw xzero yzero -+ (picture-width m) (picture-height m) 1)) -+ (force-output mw) )) -+ -+; 18 Apr 95; 20 Apr 95; 21 Apr 95; 14 Aug 96; 17 May 04; 01 Jun 04; 08 Sep 06 -+(gldefun textmenu-select ((m textmenu) &optional inside) -+ (let (mw xzero yzero codeval res) -+ (mw = (menuw m)) -+ (if ~ (permanent m) (draw m)) -+ (xzero = (menu-x m 0)) -+ (yzero = (menu-y m 0)) -+ (track-mouse mw -+ #'(lambda (x y code) -+ (setq *window-menu-code* code) -+ (x = (x - xzero)) -+ (y = (y - yzero)) -+ (if (or (> code 0) -+ (or (x < 0) (x > (picture-width m)) -+ (y < 0) (y > (picture-height m)))) -+ (codeval = code)) ) -+ t) -+ (if (and (not (permanent m)) (not (flat m))) -+ (close (menu-window m))) -+ (if (codeval > 0) -+ (progn (draw m) -+ (input-string mw (text m) (xzero + 10) -+ (yzero + (truncate (picture-height m) 2) - 8) -+ ((picture-width m) - 12)) ) ))) -+ -+(gldefun textmenu-set-text ((m textmenu) &optional (s string)) -+ ((text m) = (or s ""))) -+ -+; 15 Aug 91 -+; Get a point position by mouse click. Returns (x y). -+(setf (glfnresulttype 'window-get-point) 'vector) -+(defun window-get-point (w) -+ (let (orgx orgy) -+ (window-track-mouse w ; get one point -+ #'(lambda (x y code) -+ (when (not (zerop code)) -+ (setq orgx x) -+ (setq orgy y)))) -+ (list orgx orgy) )) -+ -+; 23 Aug 91 -+; Get a point position by mouse click. Returns (button (x y)). -+(setf (glfnresulttype 'window-get-click) -+ '(list (button integer) (pos vector))) -+(defun window-get-click (w) -+ (let (orgx orgy button) -+ (window-track-mouse w ; get one point -+ #'(lambda (x y code) -+ (when (not (zerop code)) -+ (setq button code) -+ (setq orgx x) -+ (setq orgy y)))) -+ (list button (list orgx orgy)) )) -+ -+; 13 Aug 91; 06 Aug 91 -+; Get a position indicated by a line from a specified origin position. -+; Returns (x y) at end of line. -+(setf (glfnresulttype 'window-get-line-position) 'vector) -+(defun window-get-line-position (w orgx orgy) -+ (window-get-icon-position w #'window-draw-line-xy (list orgx orgy 1 'paint))) -+ -+; 17 Dec 93 -+; Get a position indicated by a line from a specified origin position. -+; The visual feedback is restricted to lines that LaTex can draw. -+; Returns (x y) at end of line. flg is T for a vector position, nil for line. -+(setf (glfnresulttype 'window-get-latex-position) 'vector) -+(defun window-get-latex-position (w orgx orgy &optional flg) -+ (window-get-icon-position w #'window-draw-latex-xy (list orgx orgy flg))) -+ -+; 13 Aug 91; 15 Aug 91; 05 Sep 91 -+; Get a position indicated by a box of a specified size. -+; (dx dy) is offset of lower-left corner of box from mouse -+; Returns (x y) of lower-left corner of box. -+(setf (glfnresulttype 'window-get-box-position) 'vector) -+(defun window-get-box-position (w width height &optional (dx 0) (dy 0)) -+ (window-get-icon-position w #'window-draw-box-xy -+ (list width height 1) dx dy)) -+ -+; 28 Aug 09 -+; Get a position indicated by a box and line to a specified point -+(setf (glfnresulttype 'window-get-box-line-position) 'vector) -+(defun window-get-box-line-position (w width height offx offy tox toy -+ &optional (dx 0) (dy 0)) -+ (window-get-icon-position w #'window-draw-box-line-xy -+ (list width height offx offy tox toy) dx dy)) -+ -+; 01 Sep 09 -+(defun window-draw-box-line-xy (w x y width height offx offy tox toy) -+ (window-draw-box-xy w x y width height) -+ (window-draw-line-xy w (+ x offx) (+ y offy) tox toy)) -+ -+; 05 Sep 91 -+; Get a position indicated by an icon. -+; fn is the function to draw the icon: (fn w x y . args) . -+; fn must simply draw the icon, not set window parameters. -+; (dx dy) is offset of lower-left corner of icon (x y) from mouse. -+; Returns (x y) of mouse. -+(setf (glfnresulttype 'window-get-icon-position) 'vector) -+(defun window-get-icon-position (w fn args &optional (dx 0) (dy 0)) -+ (let (lastx lasty argl) -+ (setq argl (cons w (cons 0 (cons 0 args)))) ; arg list for fn -+ (window-set-xor w) -+ (window-track-mouse w -+ #'(lambda (x y code) -+ (when (or (null lastx) (/= x lastx) (/= y lasty)) -+ (if lastx (apply fn argl)) ; undraw -+ (rplaca (cdr argl) (+ x dx)) -+ (rplaca (cddr argl) (+ y dy)) -+ (apply fn argl) ; draw -+ (setq lastx x) -+ (setq lasty y)) -+ (not (zerop code)) )) -+ (apply fn argl) ; undraw -+ (window-unset w) -+ (window-force-output w) -+ (list lastx lasty) )) -+ -+; 13 Aug 91; 06 Sep 91; 06 Nov 91 -+; Get a box size and position. -+; Click for top right, then click for bottom left, then move it. -+; Returns ((x y) (width height)) where (x y) is lower-left corner of box. -+(setf (glfnresulttype 'window-get-region) 'region) -+(defun window-get-region (w &optional wid ht) -+ (let (lastx lasty start end width height place offx offy stx sty) -+ (if (and (numberp wid) (numberp ht)) -+ (progn (setq start (window-get-box-position w wid ht (- wid) (- ht))) -+ (setq stx (- (car start) wid)) -+ (setq sty (- (cadr start) ht)) ) -+ (progn (setq start (window-get-point w)) -+ (setq stx (car start)) -+ (setq sty (cadr start)))) -+ (setq end (window-get-icon-position w #'window-draw-box-corners -+ (list stx sty 1))) -+ (setq lastx (car end)) -+ (setq lasty (cadr end)) -+ (setq width (abs (- stx lastx))) -+ (setq height (abs (- sty lasty))) -+ (setq offx (- (min stx lastx) lastx)) -+ (setq offy (- (min sty lasty) lasty)) -+ (setq place (window-get-box-position w width height offx offy)) -+ (list (list (+ offx (first place)) -+ (+ offy (second place))) -+ (list width height)) )) -+ -+; 27 Nov 91; 10 Sep 92 -+; Get box size and echo the size in pixels. Click for top right. -+; Returns (width height) of box. -+(setf (glfnresulttype 'window-get-box-size) 'vector) -+(defun window-get-box-size (w offsetx offsety) -+ (let (legendy lastx lasty dx dy) -+ (setq offsety (max offsety 30)) -+ (setq legendy (- offsety 25)) -+ (window-erase-area-xy w offsetx legendy 71 21) -+ (window-draw-box-xy w offsetx legendy 70 20) -+ (window-track-mouse w -+ #'(lambda (x y code) -+ (when (or (null lastx) (/= x lastx) (/= y lasty)) -+ (if lastx (window-xor-box-xy w offsetx offsety -+ (- lastx offsetx) -+ (- lasty offsety))) -+ (setq lastx nil) -+ (setq dx (- x offsetx)) -+ (setq dy (- y offsety)) -+ (when (and (> dx 0) (> dy 0)) -+ (window-xor-box-xy w offsetx offsety dx dy) -+ (window-printat-xy w (format nil "~3D x ~3D" dx dy) -+ (+ offsetx 3) (+ legendy 5)) -+ (setq lastx x) -+ (setq lasty y))) -+ (not (zerop code)) )) -+ (if lastx (window-xor-box-xy w offsetx offsety (- lastx offsetx) -+ (- lasty offsety))) -+ (window-erase-area-xy w offsetx legendy 71 21) -+ (window-force-output w) -+ (list dx dy) )) -+ -+; 29 Oct 91; 30 Oct 91; 04 Jan 94 -+; Track mouse until a button is pressed or it leaves specified region. -+; Returns (x y code) or nil. boxflg is T to box the region. -+(setf (glfnresulttype 'window-track-mouse-in-region) -+ '(list (code integer) -+ (position (transparent vector)))) -+(defun window-track-mouse-in-region (w offsetx offsety sizex sizey -+ &optional boxflg inside) -+ (let (res) -+ (when boxflg -+ (window-set-xor w) -+ (window-draw-box-xy w (- offsetx 4) (- offsety 4) -+ (+ sizex 8) (+ sizey 8)) -+ (window-unset w) -+ (window-force-output w) ) -+ (setq res (window-track-mouse w -+ #'(lambda (x y code) -+ (if (> code 0) -+ (if inside (list code (list x y)) t) -+ (if (or (< x offsetx) -+ (> x (+ offsetx sizex)) -+ (< y offsety) -+ (> y (+ offsety sizey))) -+ inside -+ (and (setq inside t) nil)))) ) ) -+ (when boxflg -+ (window-set-xor w) -+ (window-draw-box-xy w (- offsetx 4) (- offsety 4) -+ (+ sizex 8) (+ sizey 8)) -+ (window-unset w) -+ (window-force-output w) ) -+ (if (consp res) res) )) -+ -+; 04 Nov 91 -+; Adjust one side of a box by mouse movement. Returns ((x y) (width height)). -+(setf (glfnresulttype 'window-adjust-box-side) 'region) -+(defun window-adjust-box-side (w orgx orgy width height side) -+ (let (new (xx orgx) (yy orgy) (ww width) (hh height)) -+ (setq new (window-get-icon-position w #'window-adj-box-xy -+ (list orgx orgy width height side))) -+ (case side (left (setq xx (car new)) -+ (setq ww (+ width (- orgx (car new))))) -+ (right (setq ww (- (car new) orgx))) -+ (top (setq hh (- (cadr new) orgy))) -+ (bottom (setq yy (cadr new)) -+ (setq hh (+ height (- orgy (cadr new))))) ) -+ (list (list xx yy) (list ww hh)) )) -+ -+; 04 Nov 91 -+(defun window-adj-box-xy (w x y orgx orgy width height side) -+ (let ((xx orgx) (yy orgy) (ww width) (hh height)) -+ (case side (left (setq xx x) (setq ww (+ width (- orgx x)))) -+ (right (setq ww (- x orgx))) -+ (top (setq hh (- y orgy))) -+ (bottom (setq yy y) (setq hh (+ height (- orgy y)))) ) -+ (window-draw-box-xy w xx yy ww hh) )) -+ -+ -+; 10 Sep 92 -+; Get a circle with a specified center and size. -+; center is initial center position, if specified. -+; Returns ((x y) radius) -+(setf (glfnresulttype 'window-get-circle) -+ '(list (center vector) (radius integer))) -+(defun window-get-circle (w &optional center) -+ (let (pt) -+ (or center (setq center (window-get-crosshairs w))) -+ (setq pt (window-get-icon-position w #'window-draw-circle-pt -+ (list center))) -+ (list center (window-circle-radius (car pt) (cadr pt) center)) )) -+ -+; 10 Sep 92 -+(defun window-circle-radius (x y center) -+ (let ((dx (- x (car center))) (dy (- y (cadr center)))) -+ (truncate (+ 0.5 (sqrt (+ (* dx dx) (* dy dy))))) )) -+ -+; 10 Sep 92 -+(defun window-draw-circle-pt (w x y center) -+ (window-draw-circle w center (window-circle-radius x y center) 1)) -+ -+; 10 Sep 92; 15 Sep 92; 06 Nov 92 -+; Get an ellipse with a specified center and sizes. -+; center is initial center position, if specified. -+; First gets a circle whose radius is x size, then adjusts it. -+; Returns ((x y) (radiusx radiusy)) -+(setf (glfnresulttype 'window-get-ellipse) -+ '(list (center vector) (halfsize vector))) -+(defun window-get-ellipse (w &optional center) -+ (let (cir radiusx pt) -+ (setq cir (window-get-circle w center)) -+ (setq center (car cir)) -+ (setq radiusx (cadr cir)) -+ (setq pt (window-get-icon-position w #'window-draw-ellipse-pt -+ (list center radiusx))) -+ (list center (list radiusx (abs (- (cadr pt) (cadr center))))) )) -+ -+; 10 Sep 92 -+(defun window-draw-ellipse-pt (w x y center radiusx) -+ (window-draw-ellipse-xy w (car center) (cadr center) -+ radiusx (abs (- y (cadr center)))) ) -+ -+; 30 Dec 93 -+(defun window-draw-vector-pt (w x y center radius) -+ (let (dx dy theta) -+ (setq dy (- y (cadr center))) -+ (setq dx (- x (car center))) -+ (when (or (/= dx 0) (/= dy 0)) -+ (setq theta (atan (- y (cadr center)) (- x (car center)))) -+ (window-draw-line-xy w (car center) (cadr center) -+ (+ (car center) (* radius (cos theta))) -+ (+ (cadr center) (* radius (sin theta))) ) ) )) -+ -+; 30 Dec 93 -+(setf (glfnresulttype 'window-get-vector-end) 'vector) -+(defun window-get-vector-end (w center radius) -+ (window-get-icon-position w #'window-draw-vector-pt (list center radius)) ) -+ -+; 12 Sep 92 -+(setf (glfnresulttype 'window-get-crosshairs) 'vector) -+(defun window-get-crosshairs (w) -+ (window-get-icon-position w #'window-draw-crosshairs-xy nil) ) -+ -+; 12 Sep 92 -+(defun window-draw-crosshairs-xy (w x y) -+ (window-draw-line-xy w (- x 12) y (- x 3) y) -+ (window-draw-line-xy w (+ x 3) y (+ x 12) y) -+ (window-draw-line-xy w x (- y 12) x (- y 3)) -+ (window-draw-line-xy w x (+ y 3) x (+ y 12)) ) -+ -+; 12 Sep 92 -+(setf (glfnresulttype 'window-get-cross) 'vector) -+(defun window-get-cross (w) -+ (window-get-icon-position w #'window-draw-cross-xy nil) ) -+ -+; 12 Sep 92 -+(defun window-draw-cross-xy (w x y) -+ (window-draw-line-xy w (- x 10) (- y 10) (+ x 10) (+ y 10) 2) -+ (window-draw-line-xy w (+ x 10) (- y 10) (- x 10) (+ y 10) 2) ) -+ -+; 11 Sep 92; 14 Sep 92 -+; Draw a dot whose center is at (x y) -+(defun window-draw-dot-xy (w x y) -+ (window-draw-circle-xy w x y 1) -+ (window-draw-circle-xy w x y 2) -+ (window-draw-line-xy w x y (+ x 1) y 1) ) -+ -+; 17 Dec 93; 19 Dec 93 -+; Draw a line close to the specified coordinates, but restricted to slopes -+; that can be drawn by LaTex. flg = T to restrict slopes for vector. -+(defun window-draw-latex-xy (w x y orgx orgy flg) -+ (let (dx dy delx dely n ratio cd nrat) -+ (setq dx (- x orgx)) -+ (setq dy (- y orgy)) -+ (if (or (= dx 0) (= dy 0)) -+ (window-draw-line-xy w x y orgx orgy) -+ (progn (setq n (if flg 4 6)) -+ (if (> (abs dy) (abs dx)) -+ (progn (setq ratio (round (/ (* (abs dx) n) (abs dy)))) -+ (setq cd (gcd n ratio)) -+ (setq n (/ n cd)) -+ (setq ratio (/ ratio cd)) -+ (setq nrat (round (/ (abs dy) n))) -+ (setq dely (* (signum dy) nrat n)) -+ (setq delx (* (signum dx) nrat ratio)) ) -+ (progn (setq ratio (round (/ (* (abs dy) n) (abs dx)))) -+ (setq cd (gcd n ratio)) -+ (setq n (/ n cd)) -+ (setq ratio (/ ratio cd)) -+ (setq nrat (round (/ (abs dx) n))) -+ (setq delx (* (signum dx) nrat n)) -+ (setq dely (* (signum dy) nrat ratio)) )) -+ (window-draw-line-xy w (+ orgx delx) (+ orgy dely) orgx orgy)) ) -+ )) -+ -+; 31 Dec 93 -+; Reset window colors to default foreground and background. -+(gldefun window-reset-color ((w window)) -+ (XSetForeground *window-display* (gcontext w) *default-fg-color*) -+ (XSetBackground *window-display* (gcontext w) *default-bg-color*) ) -+ -+; 31 Dec 93; 04 Jan 94; 05 Jan 94 -+; Set color to be used in a window to specified red/green/blue values. -+; Values of r, g, b are integers on scale of 65535. -+; Background is t if the background color is to be set, else foreground is set. -+; Returns an xcolor. -+(defun window-set-color-rgb (w r g b &optional background) -+ (let (ret) -+ (or *window-xcolor* (setq *window-xcolor* (Make-Xcolor))) -+ (set-Xcolor-red *window-xcolor* (+ r 0)) -+ (set-Xcolor-green *window-xcolor* (+ g 0)) -+ (set-Xcolor-blue *window-xcolor* (+ b 0)) -+ (setq ret (XAllocColor *window-display* -+ *default-colormap* *window-xcolor*)) -+ (if (not (eql ret 0)) -+ (window-set-xcolor w *window-xcolor* background)) )) -+ -+; 05 Jan 94 -+(defun window-set-xcolor (w &optional xcolor background) -+ (if background -+ (window-set-background w (XColor-Pixel xcolor)) -+ (window-set-foreground w (XColor-Pixel xcolor))) -+ xcolor) -+ -+; 03 Jan 94 -+(defun window-set-color (w rgb &optional background) -+ (window-set-color-rgb w (first rgb) (second rgb) (third rgb) background) ) -+ -+; 31 Dec 93; 03 Jan 94; 05 Jan 94 -+; Free the last xcolor used -+(defun window-free-color (w &optional xcolor) -+ (or xcolor (setq xcolor *window-xcolor*)) -+ (if xcolor -+ (unless (or (eql xcolor *default-fg-color*) -+ (eql xcolor *default-bg-color*)) -+ (XFreeColors *window-display* -+ *default-colormap* xcolor 1 0)) ) ) -+ -+; 31 Dec 93; 18 Jul 96; 25 Jul 96 -+; Get characters or mouse clicks within a window, calling function fn -+; with arguments (char button x y args). -+; Tracking continues until fn returns non-nil; result is that value. -+(defun window-get-chars (w fn &optional args) -+ (let (win res) -+ (or *window-keyinit* (window-init-keymap)) -+ (setq *window-shift* nil) -+ (setq *window-ctrl* nil) -+ (setq *window-meta* nil) -+ (setq win (window-parent w)) -+ (Xsync *window-display* 1) ; clear event queue of prev motion events -+ (Xselectinput *window-display* win -+ (+ KeyPressMask KeyReleaseMask ButtonPressMask)) -+ ;; Event processing loop: stop when function returns non-nil. -+ (while (null res) -+ (XNextEvent *window-display* *window-event*) -+ (let ((type (XAnyEvent-type *window-event*)) -+ (eventwindow (XAnyEvent-window *window-event*))) -+ (if (eql eventwindow win) -+ (setq res (window-process-char-event w type fn args))) )) -+ res)) -+ -+; 31 Dec 93; 18 Jan 94; 04 Oct 94; 18 Jul 96; 19 Jul 96; 22 Jul 96; 23 Jul 96 -+; 25 Jul 96; 08 Sep 06 -+; Process a character event. type is event type. -+; For Control, Shift, and Meta, global flags are set. -+; (fn char button x y) is called for other characters. -+(defun window-process-char-event (w type fn args) -+ (let (code) -+ (if (eql type KeyRelease) -+ (progn -+ (setq code (XButtonEvent-button *window-event*)) -+ (if (member code *window-shift-keys*) -+ (setq *window-shift* nil) -+ (if (member code *window-control-keys*) -+ (setq *window-ctrl* nil) -+ (if (member code *window-meta-keys*) -+ (setq *window-meta* nil))))) -+ (if (eql type KeyPress ) -+ (progn -+ (setq code (XButtonEvent-button *window-event*)) -+ (if (member code *window-shift-keys*) -+ (progn (setq *window-shift* t) nil) -+ (if (member code *window-control-keys*) -+ (progn (setq *window-ctrl* t) nil) -+ (if (member code *window-meta-keys*) -+ (progn (setq *window-meta* t) nil) -+ (funcall fn w (window-char-decode code) 0 0 0 -+ args) )))) -+ (if (eql type ButtonPress) -+ (funcall fn w 0 (XButtonEvent-button *window-event*) -+ (XMotionEvent-x *window-event*) -+ (- (window-drawable-height w) -+ (XMotionEvent-y *window-event*)) -+ args)) ) ) )) -+ -+; 23 Jul 96; 23 Dec 96 -+; Change keyboard code into character; assumes ASCII for control chars -+(defun window-char-decode (code) -+ (let (char) -+ (setq char (aref (if *window-shift* *window-shiftkeymap* *window-keymap*) -+ code)) -+ (if (and char *window-ctrl*) -+ (setq char (code-char (- (char-code (char-upcase char)) 64)))) -+ (if (and char *window-meta*) ; simulate meta using 128 -+ (setq char (code-char (+ (char-code (char-upcase char)) 128)))) -+ (or char #\Space) )) -+ -+; 31 Dec 93; 04 Oct 94; 16 Nov 94 -+; Get character within a window, calling function fn with arg (char). -+; Tracking continues until fn returns non-nil; result is that value. -+(defun window-get-raw-char (w) -+ (let (win res) -+ (or *window-keyinit* (window-init-keymap)) -+ (setq *window-shift* nil) -+ (setq *window-ctrl* nil) -+ (setq *window-meta* nil) -+ (setq win (window-parent w)) -+ (Xsync *window-display* 1) ; clear event queue of prev motion events -+ (Xselectinput *window-display* win -+ (+ KeyPressMask KeyReleaseMask)) -+ ;; Event processing loop: stop when function returns non-nil. -+ (while (null res) -+ (XNextEvent *window-display* *window-event*) -+ (let ((type (XAnyEvent-type *window-event*)) -+ (eventwindow (XAnyEvent-window *window-event*))) -+ (if (and (eql eventwindow win) -+ (eql type KeyPress)) -+ (setq res (XButtonEvent-button *window-event*)) ) )) -+ res)) -+ -+; 31 Dec 93; 19 Jul 96; 12 Aug 96; 13 Aug 96 -+; Input a string from keyboard, echo in window. str is initial string. -+; Backspace is handled; terminate with return. Size is max width in pixels. -+(defun window-input-string (w str x y &optional size) -+ (car (window-edit w x y (or size 100) 16 (list (or str "")) nil t t) ) ) -+ -+; 19 Jul 96; 22 Jul 96; 12 Aug 96; 13 Aug 96 -+; Edit strings in a window area with Emacs-subset editor -+; strings is a list of strings, which is the return value -+; scroll is number of lines to scroll down before displaying text, -+; or t to have one line only and terminate on return. -+; endp is T to begin edit at end of first line -+; e.g. (window-draw-box-xy myw 48 48 204 204) -+; (window-edit myw 50 50 200 200 '("Now is the time" "for all" "good")) -+(gldefun window-edit (w x y width height &optional strings boxflg scroll endp) -+ (let (em) -+ (em = (editmenu-create width height nil w x y nil t '9x15 boxflg -+ strings scroll endp)) -+ (edit em) -+ (carat em) ; erase the carat -+ (text em) )) -+ -+; 25 Jul 96; 26 Jul 96; 12 Aug 96; 13 Aug 96; 15 Aug 96; 17 May 04 -+; (setq em (editmenu-create 200 30 nil myw 50 50 t t '9x15 t ("Rutabagas"))) -+; Simple call from plain Lisp to make an edit menu. -+(setf (glfnresulttype 'editmenu-create) 'editmenu) -+(gldefun editmenu-create ((width integer) (height integer) -+ &optional title (parentw window) x y -+ (perm boolean) (flat boolean) -+ (font symbol) (boxflg boolean) -+ (initial-text (listof string)) -+ scrollval (endp boolean)) -+ (an editmenu with title = (if title (stringify title) "") -+ menu-window = (if flat parentw) -+ parent-window = (if parentw (parent parentw)) -+ parent-offset-x = (or x 0) -+ parent-offset-y = (or y 0) -+ permanent = perm -+ flat = flat -+ drawing-width = width -+ drawing-height = height -+ menu-font = (font or '9x15) -+ boxflg = boxflg -+ text = (or initial-text (list "")) -+ scrollval = (or scrollval 0) -+ line = (if (numberp scrollval) -+ scrollval -+ 0) -+ column = (if endp -+ (length (car (nthcdr -+ (if (numberp scrollval) -+ scrollval -+ 0) -+ initial-text))) -+ 0)) ) -+ -+; 25 Jul 96 -+(gldefun editmenu-calculate-size ((m editmenu)) -+ ((picture-width m) = (drawing-width m)) -+ ((picture-height m) = (drawing-height m)) ) -+ -+; 18 Apr 95 -+; Initialize a picture menu -+(gldefun editmenu-init ((m editmenu)) -+ (let () -+ (calculate-size m) -+ (adjust-offset m) -+ (if ~ (flat m) -+ ((menu-window m) = -+ (window-create (picture-width m) (picture-height m) -+ ((title m) or "") (parent-window m) -+ (parent-offset-x m) (parent-offset-y m) -+ (menu-font m) )) ) )) -+ -+; 25 Jul 96; 31 July 96; 14 Aug 96 -+(gldefun editmenu-draw ((m editmenu)) -+ (let (mw xzero yzero) -+ (init? m) -+ (mw = (menu-window m)) -+ (open mw) -+ (clear m) -+ (xzero = (menu-x m 0)) -+ (yzero = (menu-y m 0)) -+ (if (boxflg m) (draw-box-xy mw xzero yzero -+ (picture-width m) (picture-height m) 1)) -+ (display m 0 0 (not (numberp scrollval))) )) -+ -+; 19 Jul 96; 22 Jul 96; 23 Jul 96; 25 Jul 96; 31 July 96; 01 Aug 96; 17 May 04 -+; 18 Aug 04; 27 Jan 06 -+; Display contents of edit area -+; Begin with the specified line and char number; one line only if only is T. -+(gldefun editmenu-display ((m editmenu) line char only) -+ (let (lines y maxwidth linewidth (w (menuw m))) -+ (setq lines (nthcdr line (text m))) -+ (setq y (line-y m (- line (scroll m)))) -+ (setq maxwidth (truncate (- (picture-width m) 6) (font-width (menuw m)))) -+ (while (and lines (>= y (menu-y m 4))) -+ (when (< char maxwidth) -+ (if (> char 0) -+ (printat-xy w (subseq (first lines) char -+ (min maxwidth (length (first lines)))) -+ (menu-x m (+ 2 (* char (font-width (menuw m))))) -+ y) -+ (printat-xy w (if (<= (length (first lines)) maxwidth) -+ (first lines) -+ (subseq (first lines) 0 maxwidth)) -+ (menu-x m 2) y))) -+ (setq linewidth (+ 2 (* (font-width (menuw m)) (length (first lines))))) -+ (window-erase-area-xy w (menu-x m linewidth) -+ (- y 2) -+ (- (picture-width m) (+ linewidth 2)) -+ (font-height (menuw m))) -+ (y _- (font-height (menuw m))) -+ (if only (setq lines nil) -+ (progn (pop lines) -+ (if (and (null lines) (>= y (menu-y m 4))) -+ ; erase an extra line at the end -+ (window-erase-area-xy w (menu-x m 2) -+ (- y 2) -+ (- (picture-width m) 4) -+ (font-height (menuw m))) ) )) -+ (setq char 0) ) -+ (force-output w) )) -+ -+; 19 Jul 96; 22 Jul 96; 25 Jul 96; 31 Jul 96; 01 Aug 96 -+; draw/erase carat at the specified position -+(gldefun editmenu-carat ((m editmenu)) -+ (let ((w (menuw m))) -+ (draw-carat w (menu-x m (+ 2 (* (column m) (font-width (menuw m))))) -+ (- (line-y m (line m)) 2)) -+ (force-output w) )) -+ -+; 19 Jul 96; 25 Jul 96; 31 Jul 96; 01 Aug 96; 17 May 04 -+; erase at the current position. onep = t to erase only one char -+(gldefun editmenu-erase ((m editmenu) onep) -+ (let ((w (menuw m)) xw) -+ (xw = (+ 2 (* (font-width w) (column m)))) -+ (erase-area-xy w (menu-x m xw) -+ (- (line-y m (line m)) (cadr (string-extents w "Tg"))) -+ (if onep (font-width w) -+ (- (picture-width m) xw)) -+ (font-height w)) -+ (force-output w) )) -+ -+; 01 Aug 96 -+; Calculate the y position of the current line -+(gldefun editmenu-line-y ((m editmenu) (line integer)) -+ (menu-y m (- (picture-height m) -+ (+ -1 (* (font-height (menuw m)) -+ (1+ (- line (scroll m))))))) ) -+ -+; 25 Jul 96; 30 Jul 96; 31 Jul 96; 01 Aug 96; 13 Aug 96; 24 Sep 96; 08 Jan 97 -+; 17 May 04 -+(gldefun editmenu-select ((m editmenu) &optional inside) -+ (let (mw codeval res xval yval) -+ (mw = (menuw m)) -+ (if ~ (permanent m) (draw m)) -+ (track-mouse mw -+ #'(lambda (x y code) -+ (setq *window-menu-code* code) -+ (if (or (> code 0) -+ (x < (parent-offset-x m)) -+ (x > (+ (parent-offset-x m) (picture-width m))) -+ (y < (parent-offset-y m)) -+ (y > (+ (parent-offset-y m) (picture-height m)))) -+ (progn (codeval = code) -+ (xval = x) -+ (yval = y)) )) -+ t) -+; (if (and (not (permanent m)) (not (flat m)) (close (menu-window m)))) ; ?? -+ (if (codeval > 0) -+ (editmenu-edit m codeval xval yval)) )) -+ -+(defvar *window-editmenu-kill-strings* nil) -+ -+; 13 Aug 96; 15 Aug 96 -+; begin active editing of an editmenu. -+; (code x y), if present, represent a mouse click in the window. -+(gldefun editmenu-edit ((m editmenu) &optional code x y) -+ (let ((mw (menuw m))) -+ (draw m) -+ (carat m) -+ (if code (editmenu-edit-fn mw nil code x y (list m)) ) -+ (setq *window-editmenu-kill-strings* nil) -+ (window-get-chars mw #'editmenu-edit-fn (list m)) -+ (text m) )) -+ -+ -+; 31 Dec 93; 18 Jul 96; 19 Jul 96; 22 Jul 96; 23 Jul 96; 25 Jul 96; 26 Jul 96 -+; 30 Jul 96; 13 Aug 96; 14 Aug 96; 23 Dec 96; 17 May 04; 18 May 04 -+; Process input characters and mouse clicks for editmenu eidting -+(gldefun editmenu-edit-fn ((w window) char (button integer) (buttonx integer) -+ (buttony integer) args) -+ (let (m\:editmenu inside done) -+ (m = (car args)) -+ (carat m) ; erase carat -+ (if (and (numberp button) -+ (not (zerop button))) -+ (progn (inside = (editmenu-setxy m buttonx buttony)) -+ (case button -+ (1 (if inside -+ (progn (carat m) nil) ; return nil to continue input -+ t)) ; quit on click outside the editing area -+ (2 (if inside -+ (progn (editmenu-yank m) -+ (carat m) -+ nil)) ))) -+ (progn (if (< (char-code char) 32) -+ (case char of -+ (#\Return (if (numberp (scrollval m)) -+ (editmenu-return m) -+ (done = t)) ) -+ (#\Backspace (editmenu-backspace m)) -+ (#\^D (editmenu-delete m)) -+ (#\^N (if (numberp (scrollval m)) -+ (editmenu-next m))) -+ (#\^P (editmenu-previous m)) -+ (#\^F (editmenu-forward m)) -+ (#\^B (editmenu-backward m)) -+ (#\^A (editmenu-beginning m)) -+ (#\^E (editmenu-end m)) -+ (#\^K (editmenu-kill m)) -+ (#\^Y (editmenu-yank m)) -+ else nil) -+ (if (> (char-code char) 128) -+ (progn (setq char (code-char -+ (- (char-code char) 128))) -+ (case char of -+ (#\B (editmenu-meta-b m)) -+ (#\F (editmenu-meta-f m)) -+ else nil)) -+ (editmenu-char m char))) -+ (carat m) -+ done) ))) ; return nil to continue input -+ -+; 31 Jul 96; 15 Aug 96; 17 May 04 -+; Set cursor location based on mouse click; returns T if inside menu region -+(gldefun editmenu-setxy ((m editmenu) (buttonx integer) (buttony integer)) -+ (let (linecons okay) -+ (setq okay -+ (and (>= buttonx (parent-offset-x m)) -+ (<= buttonx (+ (parent-offset-x m) (picture-width m))) -+ (>= buttony (parent-offset-y m)) -+ (<= buttony (+ (parent-offset-y m) (picture-height m))) )) -+ (if okay -+ (progn ((line m) = (min (1- (length (text m))) -+ (+ (scroll m) -+ (truncate (- (menu-y m (- (picture-height m) 6)) -+ buttony) -+ (font-height (menuw m)))))) -+ (linecons = (nthcdr (line m) (text m))) -+ ((column m) = (min (length (car linecons)) -+ (truncate (- buttonx (menu-x m 2)) -+ (font-width (menuw m))))) )) -+ okay)) -+ -+; 19 Jul 96; 22 Jul 96; 25 Jul 96; 17 May 04 -+; Process an ordinary input character -+(gldefun editmenu-char ((m editmenu) char) -+ (let ((linecons (nthcdr (line m) (text m))) ) -+ (if (<= (length (car linecons)) (column m)) -+ ((car linecons) = ; insert char at end of line -+ (concatenate 'string (car linecons) (string char))) -+ ((car linecons) = ; insert char in middle of line -+ (concatenate 'string -+ (subseq (car linecons) 0 (column m)) -+ (string char) -+ (subseq (car linecons) (column m)))) ) -+ (display m (line m) (column m) t) -+ ((column m) _+ 1) )) -+ -+; 23 Dec 96 -+; Get the current character in an editment -+(gldefun editmenu-current-char ((m editmenu)) -+ (let ((linecons (nthcdr (line m) (text m))) ) -+ (char (car linecons) (column m)) )) -+ -+; 19 Jul 96; 22 Jul 96; 25 Jul 96; 17 May 04 -+; Process a Return character -+(gldefun editmenu-return ((m editmenu)) -+ (let ((linecons (nthcdr (line m) (text m)))) -+ (if (<= (length (car linecons)) (column m)) -+ ((cdr linecons) = (cons "" (cdr linecons))) ; end of line -+ (progn ((cdr linecons) = (cons (subseq (car linecons) (column m)) -+ (cdr linecons))) -+ ((car linecons) = (subseq (car linecons) 0 (column m))))) -+ (display m (line m) 0 nil) -+ ((line m) _+ 1) -+ ((column m) = 0) )) -+ -+; 19 Jul 96; 22 Jul 96; 25 Jul 96; 30 Jul 96; 31 Jul 96; 17 May 04 -+; Process a backspace -+(gldefun editmenu-backspace ((m editmenu)) -+ (let (tmp linedel (linecons (nthcdr (line m) (text m)))) -+ (if (> (column m) 0) -+ (progn ((column m) _- 1) ; middle/end of line -+ ((car linecons) = -+ (concatenate 'string -+ (subseq (car linecons) 0 (column m)) -+ (subseq (car linecons) -+ (1+ (column m)))))) -+ (if (> (line m) 0) -+ (progn ((line m) _- 1) -+ (linedel = t) -+ (linecons = (nthcdr (line m) (text m))) -+ ((column m) = (length (car linecons))) -+ (tmp = (concatenate 'string (car linecons) -+ (cadr linecons))) -+ ((cdr linecons) = (cddr linecons)) -+ ((car linecons) = tmp) ) )) -+ (display m (line m) (column m) (not linedel)) )) -+ -+; 23 Jul 96; 25 Jul 96 -+; Move cursor to end of line: C-E -+(gldefun editmenu-end ((m editmenu)) -+ (let ((linecons (nthcdr (line m) (text m))) ) -+ ((column m) = (length (car linecons))) )) -+ -+; 23 Jul 96; 25 Jul 96 -+; Move cursor to beginning of line: C-A -+(gldefun editmenu-beginning ((m editmenu)) -+ ((column m) = 0)) -+ -+; 22 Jul 96; 25 Jul 96; 14 Aug 96; 17 May 04 -+; Move cursor forward: C-F -+(gldefun editmenu-forward ((m editmenu)) -+ (let ((linecons (nthcdr (line m) (text m)))) -+ (if (< (column m) (length (car linecons))) -+ ((column m) _+ 1) -+ (if (numberp (scrollval m)) -+ (progn ((line m) _+ 1) -+ (if (null (cdr linecons)) -+ ((cdr linecons) = (list ""))) -+ ((column m) = 0)) ) ))) -+ -+; 23 Dec 96; 17 May 04 -+; Move cursor forward over a word: M-F -+(gldefun editmenu-meta-f ((m editmenu)) -+ (let (found done) -+ (while (and (or (< (line m) (1- (length (text m)))) -+ (< (column m) (length (nth (line m) (text m))))) -+ (not found)) -+ (if (editmenu-alphanumbericp (editmenu-current-char m)) -+ (found = t) -+ (editmenu-forward m) ) ) -+ (if found -+ (while (and (or (< (line m) (1- (length (text m)))) -+ (< (column m) (length (nth (line m) (text m))))) -+ (not done)) -+ (if (editmenu-alphanumbericp (editmenu-current-char m)) -+ (editmenu-forward m) -+ (done = t) )) ) )) -+ -+; 23 Dec 96 -+; alphanumbericp not defined in gcl -+(defun editmenu-alphanumbericp (x) -+ (or (alpha-char-p x) (not (null (digit-char-p x)))) ) -+ -+; 22 Jul 96; 25 Jul 96 -+; Move cursor to next line: C-N -+(gldefun editmenu-next ((m editmenu)) -+ (let ((linecons (nthcdr (line m) (text m)))) -+ ((line m)_+ 1) -+ (if (null (cdr linecons)) -+ ((cdr linecons) = (list ""))) -+ (setq linecons (cdr linecons)) -+ ((column m) = (min (column m) (length (car linecons)))) )) -+ -+; 22 Jul 96; 23 Jul 96; 25 Jul 96; 30 Jul 96; 17 May 04 -+; Move cursor backward: C-B -+(gldefun editmenu-backward ((m editmenu)) -+ (if (> (column m) 0) -+ ((column m) _- 1) -+ (if (> (line m) 0) -+ (progn ((line m) _- 1) -+ ((column m) = (length (nth (line m) (text m)))) ) ) )) -+ -+; 23 Dec 96; 17 May 04 -+; Move cursor backward over a word: M-B -+(gldefun editmenu-meta-b ((m editmenu)) -+ (let (found done) -+ (while (and (or (> (column m) 0) (> (line m) 0)) -+ (not found)) -+ (editmenu-backward m) -+ (if (editmenu-alphanumbericp (editmenu-current-char m)) -+ (found = t))) -+ (if found -+ (progn (while (and (or (> (column m) 0) (> (line m) 0)) -+ (not done)) -+ (if (editmenu-alphanumbericp (editmenu-current-char m)) -+ (editmenu-backward m) -+ (done = t) )) -+ (unless (editmenu-alphanumbericp (editmenu-current-char m)) -+ (editmenu-forward m)) ) ))) -+ -+; 22 Jul 96; 23 Jul 96; 25 Jul 96; 17 May 04 -+; Move cursor to previous line: C-P -+(gldefun editmenu-previous ((m editmenu)) -+ (if (> (line m) 0) -+ (progn ((line m) _- 1) -+ ((column m) = (min (column m) -+ (length (nth (line m) (text m)))))))) -+ -+; 23 Jul 96; 25 Jul 96 -+; Delete character ahead of cursor: C-D -+(gldefun editmenu-delete ((m editmenu)) -+ (editmenu-forward m) -+ (editmenu-backspace m)) -+ -+; 31 Jul 96; 17 May 04 -+(gldefun editmenu-kill ((m editmenu)) -+ (let ((linecons (nthcdr (line m) (text m)))) -+ (if ((column m) < (length (car linecons))) -+ (progn (setq *window-editmenu-kill-strings* -+ (list (subseq (car linecons) (column m)))) -+ ((car linecons) = (subseq (car linecons) 0 (column m))) -+ (display m (line m) (column m) t)) -+ (editmenu-delete m) ) )) -+ -+; 31 Jul 96; 01 Aug 96; 17 May 04 -+(gldefun editmenu-yank ((m editmenu)) -+ (let ((linecons (nthcdr (line m) (text m))) (col (column m))) -+ (when *window-editmenu-kill-strings* -+ (if (<= (length (car linecons)) (column m)) -+ (progn ((car linecons) = ; insert at end of line -+ (concatenate 'string (car linecons) -+ (car *window-editmenu-kill-strings*))) -+ ((column m) = (length (car linecons)))) -+ (progn ((car linecons) = ; insert in middle of line -+ (concatenate 'string -+ (subseq (car linecons) 0 col) -+ (car *window-editmenu-kill-strings*) -+ (subseq (car linecons) col))) -+ ((column m) _+ (length (car *window-editmenu-kill-strings*))) )) -+ (display m (line m) col t) ) )) -+ -+; 31 Dec 93; 19 Jul 96 -+; Draw a carat symbol /\ centered at x and with top at y. -+(defun window-draw-carat (w x y) -+ (window-set-xor w) -+ (window-draw-line-xy w (- x 5) (- y 2) x y) -+ (window-draw-line-xy w x y (+ x 5) (- y 2)) -+ (window-unset w) -+ (window-force-output w) ) -+ -+; 31 Dec 93; 04 Oct 94; 15 Nov 94; 16 Nov 94; 14 Mar 95; 25 Jun 06 -+; Initialize mapping between keys and ASCII. -+(defun window-init-keymap () -+ (let (mincode maxcode keycode keysym keynum shiftkeynum char) -+ ; Get the min and max keycodes for this keyboard -+ (XDisplayKeycodes *window-display* *min-keycodes-return* -+ *max-keycodes-return*) -+ (setq mincode (int-pos *min-keycodes-return* 0)) -+ (setq maxcode (int-pos *max-keycodes-return* 0)) -+ (setq *window-keymap* (make-array (1+ maxcode) :initial-element nil)) -+ (setq *window-shiftkeymap* (make-array (1+ maxcode) :initial-element nil)) -+ (setq *window-shift-keys* nil) -+ (setq *window-control-keys* nil) -+ (setq *window-meta-keys* nil) -+ ; Get the ASCII corresponding to these keycodes -+ (dotimes (i (1+ (- maxcode mincode))) -+ (setq keycode (+ i mincode)) -+ (setq keysym (XGetKeyboardMapping *window-display* keycode 1 -+ *keycodes-return*)) -+ (setq keynum (fixnum-pos keysym 0)) ; ascii integer code -+ (setq shiftkeynum (fixnum-pos keysym 1)) -+ ; (XFree keysym) ; ***** commented out -- causes error on Sun -+ ; Following is a Kludge (TM) for Sun keyboard -+ (if (and (>= keynum 65) (<= keynum 90) (eql shiftkeynum NoSymbol)) -+ (progn (setq shiftkeynum keynum) -+ (setq keynum (+ keynum 32)))) -+ (if (> keynum 0) -+ (if (setq char (window-code-char keynum)) -+ (setf (aref *window-keymap* keycode) char) -+ (if (> keynum 256) -+ (cond ((or (eql keynum XK_Shift_R) (eql keynum XK_Shift_L)) -+ (push keycode *window-shift-keys*)) -+ ((or (eql keynum XK_Control_L) (eql keynum XK_Control_R)) -+ (push keycode *window-control-keys*)) -+ ((or (eql keynum XK_Alt_R) (eql keynum XK_Alt_L)) -+ (push keycode *window-meta-keys*)))))) -+ (if (> shiftkeynum 0) -+ (if (setq char (window-code-char shiftkeynum)) -+ (setf (aref *window-shiftkeymap* keycode) char) -+ )) ) -+ (setq *window-keyinit* t) )) ; signify initialization done -+ -+; 15 Nov 94 -+(defun window-code-char (code) -+ (if (> code 0) -+ (if (< code 256) -+ (code-char code) -+ (cond ((eql code XK_Return) #\Return) -+ ((eql code XK_Tab) #\Tab) -+ ((eql code XK_BackSpace) #\Backspace)) ) ) ) -+ -+; 14 Dec 90; 12 Aug 91; 09 Oct 91; 09 Sep 92; 04 Aug 93; 06 Oct 94 -+; Compile the dwindow file into a plain Lisp file -+(defun compile-dwindow () -+ (glcompfiles *directory* -+ '("glisp/vector.lsp") ; auxiliary files -+ '("X/dwindow.lsp") ; translated files -+ "X/dwtrans.lsp" ; output file -+ "X/dwhead.lsp" ; header file -+ '(glfnresulttype glmacro glispobjects -+ glispconstants glispglobals compile-dwindow compile-dwindowb)) -+ (compile-file (concatenate 'string *directory* "X/dwtrans.lsp")) ) -+ -+(defun compile-dwindowb () -+ (glcompfiles *directory* -+ '("glisp/vector.lsp") ; auxiliary files -+ '("X/dwindow.lsp") ; translated files -+ "X/dwtransb.lsp") ; output file -+ (compile-file (concatenate 'string *directory* "X/dwtransb.lsp")) ) -+ -+; Note: when compiling dwtrans.lsp, be sure glmacros.lsp is loaded. ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_X.lsp -@@ -0,0 +1,689 @@ -+(in-package :XLIB) -+; X.lsp modified by Hiep Huu Nguyen 27 Aug 92 -+ -+; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. -+ -+; See the files gnu.license and dec.copyright . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Some of the files that interface to the Xlib are adapted from DEC/MIT files. -+; See the file dec.copyright for details. -+ -+;; -+;; $XConsortium: X.h,v 1.66 88/09/06 15:55:56 jim Exp $ -+ -+ -+;; Definitions for the X window system likely to be used by applications -+ -+ -+;;********************************************************** -+;;Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts, -+;;and the Massachusetts Institute of Technology, Cambridge, Massachusetts. -+ -+;;modified by Hiep H Nguyen 28 Jul 91 -+ -+;; All Rights Reserved -+ -+;;Permission to use, copy, modify, and distribute this software and its -+;;documentation for any purpose and without fee is hereby granted, -+;;provided that the above copyright notice appear in all copies and that -+;;both that copyright notice and this permission notice appear in -+;;supporting documentation, and that the names of Digital or MIT not be -+;;used in advertising or publicity pertaining to distribution of the -+;;software without specific, written prior permission. -+ -+;;DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -+;;ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL -+;;DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -+;;ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -+;;WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, -+;;ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -+;;SOFTWARE. -+ -+;;***************************************************************** -+(defconstant X_PROTOCOL 11 ) ;; current protocol version -+(defconstant X_PROTOCOL_REVISION 0 ) ;; current minor version -+ -+(defconstant True 1) -+(defconstant False 0) -+ -+;; Resources -+ -+;;typedef unsigned long XID) ; -+ -+;;typedef XID Window) ; -+;;typedef XID Drawable) ; -+;;typedef XID Font) ; -+;;typedef XID Pixmap) ; -+;;typedef XID Cursor) ; -+;;typedef XID Colormap) ; -+;;typedef XID GContext) ; -+;;typedef XID KeySym) ; -+ -+;;typedef unsigned long Mask) ; -+ -+;;typedef unsigned long Atom) ; -+ -+;;typedef unsigned long VisualID) ; -+ -+;;typedef unsigned long Time) ; -+ -+;;typedef unsigned char KeyCode) ; -+ -+;;**************************************************************** -+;; * RESERVED RESOURCE AND CONSTANT DEFINITIONS -+;; **************************************************************** -+ -+(defconstant None 0 ) ;; universal null resource or null atom -+ -+(defconstant ParentRelative 1 ) ;; background pixmap in CreateWindow -+ ;;and ChangeWindowAttributes -+ -+(defconstant CopyFromParent 0 ) ;; border pixmap in CreateWindow -+ ;;and ChangeWindowAttributes -+ ;;special VisualID and special window -+ ;; class passed to CreateWindow -+ -+(defconstant PointerWindow 0 ) ;; destination window in SendEvent -+(defconstant InputFocus 1 ) ;; destination window in SendEvent -+ -+(defconstant PointerRoot 1 ) ;; focus window in SetInputFocus -+ -+(defconstant AnyPropertyType 0 ) ;; special Atom, passed to GetProperty -+ -+(defconstant AnyKey 0 ) ;; special Key Code, passed to GrabKey -+ -+(defconstant AnyButton 0 ) ;; special Button Code, passed to GrabButton -+ -+(defconstant AllTemporary 0 ) ;; special Resource ID passed to KillClient -+ -+(defconstant CurrentTime 0 ) ;; special Time -+ -+(defconstant NoSymbol 0 ) ;; special KeySym -+ -+;;**************************************************************** -+;; * EVENT DEFINITIONS -+;; **************************************************************** -+ -+;; Input Event Masks. Used as event-mask window attribute and as arguments -+;; to Grab requests. Not to be confused with event names. -+ -+(defconstant NoEventMask 0) -+(defconstant KeyPressMask (expt 2 0) ) -+(defconstant KeyReleaseMask (expt 2 1) ) -+(defconstant ButtonPressMask (expt 2 2) ) -+(defconstant ButtonReleaseMask (expt 2 3) ) -+(defconstant EnterWindowMask (expt 2 4) ) -+(defconstant LeaveWindowMask (expt 2 5) ) -+(defconstant PointerMotionMask (expt 2 6) ) -+(defconstant PointerMotionHintMask (expt 2 7) ) -+(defconstant Button1MotionMask (expt 2 8) ) -+(defconstant Button2MotionMask (expt 2 9) ) -+(defconstant Button3MotionMask (expt 2 10) ) -+(defconstant Button4MotionMask (expt 2 11) ) -+(defconstant Button5MotionMask (expt 2 12) ) -+(defconstant ButtonMotionMask (expt 2 13) ) -+(defconstant KeymapStateMask (expt 2 14)) -+(defconstant ExposureMask (expt 2 15) ) -+(defconstant VisibilityChangeMask (expt 2 16) ) -+(defconstant StructureNotifyMask (expt 2 17) ) -+(defconstant ResizeRedirectMask (expt 2 18) ) -+(defconstant SubstructureNotifyMask (expt 2 19) ) -+(defconstant SubstructureRedirectMask (expt 2 20) ) -+(defconstant FocusChangeMask (expt 2 21) ) -+(defconstant PropertyChangeMask (expt 2 22) ) -+(defconstant ColormapChangeMask (expt 2 23) ) -+(defconstant OwnerGrabButtonMask (expt 2 24) ) -+ -+;; Event names. Used in "type" field in XEvent structures. Not to be -+;;confused with event masks above. They start from 2 because 0 and 1 -+;;are reserved in the protocol for errors and replies. -+ -+(defconstant KeyPress 2) -+(defconstant KeyRelease 3) -+(defconstant ButtonPress 4) -+(defconstant ButtonRelease 5) -+(defconstant MotionNotify 6) -+(defconstant EnterNotify 7) -+(defconstant LeaveNotify 8) -+(defconstant FocusIn 9) -+(defconstant FocusOut 10) -+(defconstant KeymapNotify 11) -+(defconstant Expose 12) -+(defconstant GraphicsExpose 13) -+(defconstant NoExpose 14) -+(defconstant VisibilityNotify 15) -+(defconstant CreateNotify 16) -+(defconstant DestroyNotify 17) -+(defconstant UnmapNotify 18) -+(defconstant MapNotify 19) -+(defconstant MapRequest 20) -+(defconstant ReparentNotify 21) -+(defconstant ConfigureNotify 22) -+(defconstant ConfigureRequest 23) -+(defconstant GravityNotify 24) -+(defconstant ResizeRequest 25) -+(defconstant CirculateNotify 26) -+(defconstant CirculateRequest 27) -+(defconstant PropertyNotify 28) -+(defconstant SelectionClear 29) -+(defconstant SelectionRequest 30) -+(defconstant SelectionNotify 31) -+(defconstant ColormapNotify 32) -+(defconstant ClientMessage 33) -+(defconstant MappingNotify 34) -+(defconstant LASTEvent 35 ) ;; must be bigger than any event # -+ -+ -+;; Key masks. Used as modifiers to GrabButton and GrabKey, results of QueryPointer, -+;; state in various key-, mouse-, and button-related events. -+ -+(defconstant ShiftMask (expt 2 0)) -+(defconstant LockMask (expt 2 1)) -+(defconstant ControlMask (expt 2 2)) -+(defconstant Mod1Mask (expt 2 3)) -+(defconstant Mod2Mask (expt 2 4)) -+(defconstant Mod3Mask (expt 2 5)) -+(defconstant Mod4Mask (expt 2 6)) -+(defconstant Mod5Mask (expt 2 7)) -+ -+;; modifier names. Used to build a SetModifierMapping request or -+;; to read a GetModifierMapping request. These correspond to the -+;; masks defined above. -+(defconstant ShiftMapIndex 0) -+(defconstant LockMapIndex 1) -+(defconstant ControlMapIndex 2) -+(defconstant Mod1MapIndex 3) -+(defconstant Mod2MapIndex 4) -+(defconstant Mod3MapIndex 5) -+(defconstant Mod4MapIndex 6) -+(defconstant Mod5MapIndex 7) -+ -+ -+;; button masks. Used in same manner as Key masks above. Not to be confused -+;; with button names below. -+ -+(defconstant Button1Mask (expt 2 8)) -+(defconstant Button2Mask (expt 2 9)) -+(defconstant Button3Mask (expt 2 10)) -+(defconstant Button4Mask (expt 2 11)) -+(defconstant Button5Mask (expt 2 12)) -+ -+(defconstant AnyModifier (expt 2 15) ) ;; used in GrabButton, GrabKey -+ -+ -+;; button names. Used as arguments to GrabButton and as detail in ButtonPress -+;; and ButtonRelease events. Not to be confused with button masks above. -+;; Note that 0 is already defined above as "AnyButton". -+ -+(defconstant Button1 1) -+(defconstant Button2 2) -+(defconstant Button3 3) -+(defconstant Button4 4) -+(defconstant Button5 5) -+ -+;; Notify modes -+ -+(defconstant NotifyNormal 0) -+(defconstant NotifyGrab 1) -+(defconstant NotifyUngrab 2) -+(defconstant NotifyWhileGrabbed 3) -+ -+(defconstant NotifyHint 1 ) ;; for MotionNotify events -+ -+;; Notify detail -+ -+(defconstant NotifyAncestor 0) -+(defconstant NotifyVirtual 1) -+(defconstant NotifyInferior 2) -+(defconstant NotifyNonlinear 3) -+(defconstant NotifyNonlinearVirtual 4) -+(defconstant NotifyPointer 5) -+(defconstant NotifyPointerRoot 6) -+(defconstant NotifyDetailNone 7) -+ -+;; Visibility notify -+ -+(defconstant VisibilityUnobscured 0) -+(defconstant VisibilityPartiallyObscured 1) -+(defconstant VisibilityFullyObscured 2) -+ -+;; Circulation request -+ -+(defconstant PlaceOnTop 0) -+(defconstant PlaceOnBottom 1) -+ -+;; protocol families -+ -+(defconstant FamilyInternet 0) -+(defconstant FamilyDECnet 1) -+(defconstant FamilyChaos 2) -+ -+;; Property notification -+ -+(defconstant PropertyNewValue 0) -+(defconstant PropertyDelete 1) -+ -+;; Color Map notification -+ -+(defconstant ColormapUninstalled 0) -+(defconstant ColormapInstalled 1) -+ -+;; GrabPointer, GrabButton, GrabKeyboard, GrabKey Modes -+ -+(defconstant GrabModeSync 0) -+(defconstant GrabModeAsync 1) -+ -+;; GrabPointer, GrabKeyboard reply status -+ -+(defconstant GrabSuccess 0) -+(defconstant AlreadyGrabbed 1) -+(defconstant GrabInvalidTime 2) -+(defconstant GrabNotViewable 3) -+(defconstant GrabFrozen 4) -+ -+;; AllowEvents modes -+ -+(defconstant AsyncPointer 0) -+(defconstant SyncPointer 1) -+(defconstant ReplayPointer 2) -+(defconstant AsyncKeyboard 3) -+(defconstant SyncKeyboard 4) -+(defconstant ReplayKeyboard 5) -+(defconstant AsyncBoth 6) -+(defconstant SyncBoth 7) -+ -+;; Used in SetInputFocus, GetInputFocus -+ -+(defconstant RevertToNone None) -+(defconstant RevertToPointerRoot PointerRoot) -+(defconstant RevertToParent 2) -+ -+;;**************************************************************** -+;; * ERROR CODES -+;; **************************************************************** -+ -+(defconstant Success 0 ) ;; everything's okay -+(defconstant BadRequest 1 ) ;; bad request code -+(defconstant BadValue 2 ) ;; int parameter out of range -+(defconstant BadWindow 3 ) ;; parameter not a Window -+(defconstant BadPixmap 4 ) ;; parameter not a Pixmap -+(defconstant BadAtom 5 ) ;; parameter not an Atom -+(defconstant BadCursor 6 ) ;; parameter not a Cursor -+(defconstant BadFont 7 ) ;; parameter not a Font -+(defconstant BadMatch 8 ) ;; parameter mismatch -+(defconstant BadDrawable 9 ) ;; parameter not a Pixmap or Window -+(defconstant BadAccess 10 ) ;; depending on context: -+ ;;- key/button already grabbed -+ ;;- attempt to free an illegal -+ ;; cmap entry -+ ;;- attempt to store into a read-only -+ ;; color map entry. -+ ;;- attempt to modify the access control -+ ;; list from other than the local host. -+ -+(defconstant BadAlloc 11 ) ;; insufficient resources -+(defconstant BadColor 12 ) ;; no such colormap -+(defconstant BadGC 13 ) ;; parameter not a GC -+(defconstant BadIDChoice 14 ) ;; choice not in range or already used -+(defconstant BadName 15 ) ;; font or color name doesn't exist -+(defconstant BadLength 16 ) ;; Request length incorrect -+(defconstant BadImplementation 17 ) ;; server is defective -+ -+(defconstant FirstExtensionError 128) -+(defconstant LastExtensionError 255) -+ -+;;**************************************************************** -+;; * WINDOW DEFINITIONS -+;; **************************************************************** -+ -+;; Window classes used by CreateWindow -+;; Note that CopyFromParent is already defined as 0 above -+ -+(defconstant InputOutput 1) -+(defconstant InputOnly 2) -+ -+;; Window attributes for CreateWindow and ChangeWindowAttributes -+ -+(defconstant CWBackPixmap (expt 2 0)) -+(defconstant CWBackPixel (expt 2 1)) -+(defconstant CWBorderPixmap (expt 2 2)) -+(defconstant CWBorderPixel (expt 2 3)) -+(defconstant CWBitGravity (expt 2 4)) -+(defconstant CWWinGravity (expt 2 5)) -+(defconstant CWBackingStore (expt 2 6)) -+(defconstant CWBackingPlanes (expt 2 7)) -+(defconstant CWBackingPixel (expt 2 8)) -+(defconstant CWOverrideRedirect (expt 2 9)) -+(defconstant CWSaveUnder (expt 2 10)) -+(defconstant CWEventMask (expt 2 11)) -+(defconstant CWDontPropagate (expt 2 12)) -+(defconstant CWColormap (expt 2 13)) -+(defconstant CWCursor (expt 2 14)) -+ -+;; ConfigureWindow structure -+ -+(defconstant CWX (expt 2 0)) -+(defconstant CWY (expt 2 1)) -+(defconstant CWWidth (expt 2 2)) -+(defconstant CWHeight (expt 2 3)) -+(defconstant CWBorderWidth (expt 2 4)) -+(defconstant CWSibling (expt 2 5)) -+(defconstant CWStackMode (expt 2 6)) -+ -+ -+;; Bit Gravity -+ -+(defconstant ForgetGravity 0) -+(defconstant NorthWestGravity 1) -+(defconstant NorthGravity 2) -+(defconstant NorthEastGravity 3) -+(defconstant WestGravity 4) -+(defconstant CenterGravity 5) -+(defconstant EastGravity 6) -+(defconstant SouthWestGravity 7) -+(defconstant SouthGravity 8) -+(defconstant SouthEastGravity 9) -+(defconstant StaticGravity 10) -+ -+;; Window gravity + bit gravity above -+ -+(defconstant UnmapGravity 0) -+ -+;; Used in CreateWindow for backing-store hint -+ -+(defconstant NotUseful 0) -+(defconstant WhenMapped 1) -+(defconstant Always 2) -+ -+;; Used in GetWindowAttributes reply -+ -+(defconstant IsUnmapped 0) -+(defconstant IsUnviewable 1) -+(defconstant IsViewable 2) -+ -+;; Used in ChangeSaveSet -+ -+(defconstant SetModeInsert 0) -+(defconstant SetModeDelete 1) -+ -+;; Used in ChangeCloseDownMode -+ -+(defconstant DestroyAll 0) -+(defconstant RetainPermanent 1) -+(defconstant RetainTemporary 2) -+ -+;; Window stacking method (in configureWindow) -+ -+(defconstant Above 0) -+(defconstant Below 1) -+(defconstant TopIf 2) -+(defconstant BottomIf 3) -+(defconstant Opposite 4) -+ -+;; Circulation direction -+ -+(defconstant RaiseLowest 0) -+(defconstant LowerHighest 1) -+ -+;; Property modes -+ -+(defconstant PropModeReplace 0) -+(defconstant PropModePrepend 1) -+(defconstant PropModeAppend 2) -+ -+;;**************************************************************** -+;; * GRAPHICS DEFINITIONS -+;; **************************************************************** -+ -+;; graphics functions, as in GC.alu -+ -+(defconstant GXclear 0 ) ;; 0 -+(defconstant GXand 1 ) ;; src AND dst -+(defconstant GXandReverse 2 ) ;; src AND NOT dst -+(defconstant GXcopy 3 ) ;; src -+(defconstant GXandInverted 4 ) ;; NOT src AND dst -+(defconstant GXnoop 5 ) ;; dst -+(defconstant GXxor 6 ) ;; src XOR dst -+(defconstant GXor 7 ) ;; src OR dst -+(defconstant GXnor 8 ) ;; NOT src AND NOT dst -+(defconstant GXequiv 9 ) ;; NOT src XOR dst -+(defconstant GXinvert 10 ) ;; NOT dst -+(defconstant GXorReverse 11 ) ;; src OR NOT dst -+(defconstant GXcopyInverted 12 ) ;; NOT src -+(defconstant GXorInverted 13 ) ;; NOT src OR dst -+(defconstant GXnand 14 ) ;; NOT src OR NOT dst -+(defconstant GXset 15 ) ;; 1 -+ -+;; LineStyle -+ -+(defconstant LineSolid 0) -+(defconstant LineOnOffDash 1) -+(defconstant LineDoubleDash 2) -+ -+;; capStyle -+ -+(defconstant CapNotLast 0) -+(defconstant CapButt 1) -+(defconstant CapRound 2) -+(defconstant CapProjecting 3) -+ -+;; joinStyle -+ -+(defconstant JoinMiter 0) -+(defconstant JoinRound 1) -+(defconstant JoinBevel 2) -+ -+;; fillStyle -+ -+(defconstant FillSolid 0) -+(defconstant FillTiled 1) -+(defconstant FillStippled 2) -+(defconstant FillOpaqueStippled 3) -+ -+;; fillRule -+ -+(defconstant EvenOddRule 0) -+(defconstant WindingRule 1) -+ -+;; subwindow mode -+ -+(defconstant ClipByChildren 0) -+(defconstant IncludeInferiors 1) -+ -+;; SetClipRectangles ordering -+ -+(defconstant Unsorted 0) -+(defconstant YSorted 1) -+(defconstant YXSorted 2) -+(defconstant YXBanded 3) -+ -+;; CoordinateMode for drawing routines -+ -+(defconstant CoordModeOrigin 0 ) ;; relative to the origin -+(defconstant CoordModePrevious 1 ) ;; relative to previous point -+ -+;; Polygon shapes -+ -+;(defconstant Complex 0 ) ;; paths may intersect -+(defconstant Nonconvex 1 ) ;; no paths intersect, but not convex -+(defconstant Convex 2 ) ;; wholly convex -+ -+;; Arc modes for PolyFillArc -+ -+(defconstant ArcChord 0 ) ;; join endpoints of arc -+(defconstant ArcPieSlice 1 ) ;; join endpoints to center of arc -+ -+;; GC components: masks used in CreateGC, CopyGC, ChangeGC, OR'ed into -+;; GC.stateChanges -+ -+(defconstant GCFunction (expt 2 0)) -+(defconstant GCPlaneMask (expt 2 1)) -+(defconstant GCForeground (expt 2 2)) -+(defconstant GCBackground (expt 2 3)) -+(defconstant GCLineWidth (expt 2 4)) -+(defconstant GCLineStyle (expt 2 5)) -+(defconstant GCCapStyle (expt 2 6)) -+(defconstant GCJoinStyle (expt 2 7)) -+(defconstant GCFillStyle (expt 2 8)) -+(defconstant GCFillRule (expt 2 9) ) -+(defconstant GCTile (expt 2 10)) -+(defconstant GCStipple (expt 2 11)) -+(defconstant GCTileStipXOrigin (expt 2 12)) -+(defconstant GCTileStipYOrigin (expt 2 13)) -+(defconstant GCFont (expt 2 14)) -+(defconstant GCSubwindowMode (expt 2 15)) -+(defconstant GCGraphicsExposures (expt 2 16)) -+(defconstant GCClipXOrigin (expt 2 17)) -+(defconstant GCClipYOrigin (expt 2 18)) -+(defconstant GCClipMask (expt 2 19)) -+(defconstant GCDashOffset (expt 2 20)) -+(defconstant GCDashList (expt 2 21)) -+(defconstant GCArcMode (expt 2 22)) -+ -+(defconstant GCLastBit 22) -+;;**************************************************************** -+;; * FONTS -+;; **************************************************************** -+ -+;; used in QueryFont -- draw direction -+ -+(defconstant FontLeftToRight 0) -+(defconstant FontRightToLeft 1) -+ -+(defconstant FontChange 255) -+ -+;;**************************************************************** -+;; * IMAGING -+;; **************************************************************** -+ -+;; ImageFormat -- PutImage, GetImage -+ -+(defconstant XYBitmap 0 ) ;; depth 1, XYFormat -+(defconstant XYPixmap 1 ) ;; depth == drawable depth -+(defconstant ZPixmap 2 ) ;; depth == drawable depth -+ -+;;**************************************************************** -+;; * COLOR MAP STUFF -+;; **************************************************************** -+ -+;; For CreateColormap -+ -+(defconstant AllocNone 0 ) ;; create map with no entries -+(defconstant AllocAll 1 ) ;; allocate entire map writeable -+ -+ -+;; Flags used in StoreNamedColor, StoreColors -+ -+(defconstant DoRed (expt 2 0)) -+(defconstant DoGreen (expt 2 1)) -+(defconstant DoBlue (expt 2 2)) -+ -+;;**************************************************************** -+;; * CURSOR STUFF -+;; **************************************************************** -+ -+;; QueryBestSize Class -+ -+(defconstant CursorShape 0 ) ;; largest size that can be displayed -+(defconstant TileShape 1 ) ;; size tiled fastest -+(defconstant StippleShape 2 ) ;; size stippled fastest -+ -+;;**************************************************************** -+;; * KEYBOARD/POINTER STUFF -+;; **************************************************************** -+ -+(defconstant AutoRepeatModeOff 0) -+(defconstant AutoRepeatModeOn 1) -+(defconstant AutoRepeatModeDefault 2) -+ -+(defconstant LedModeOff 0) -+(defconstant LedModeOn 1) -+ -+;; masks for ChangeKeyboardControl -+ -+(defconstant KBKeyClickPercent (expt 2 0)) -+(defconstant KBBellPercent (expt 2 1)) -+(defconstant KBBellPitch (expt 2 2)) -+(defconstant KBBellDuration (expt 2 3)) -+(defconstant KBLed (expt 2 4)) -+(defconstant KBLedMode (expt 2 5)) -+(defconstant KBKey (expt 2 6)) -+(defconstant KBAutoRepeatMode (expt 2 7)) -+ -+(defconstant MappingSuccess 0) -+(defconstant MappingBusy 1) -+(defconstant MappingFailed 2) -+ -+(defconstant MappingModifier 0) -+(defconstant MappingKeyboard 1) -+(defconstant MappingPointer 2) -+ -+;;**************************************************************** -+;; * SCREEN SAVER STUFF -+;; **************************************************************** -+ -+(defconstant DontPreferBlanking 0) -+(defconstant PreferBlanking 1) -+(defconstant DefaultBlanking 2) -+ -+(defconstant DisableScreenSaver 0) -+(defconstant DisableScreenInterval 0) -+ -+(defconstant DontAllowExposures 0) -+(defconstant AllowExposures 1) -+(defconstant DefaultExposures 2) -+ -+;; for ForceScreenSaver -+ -+(defconstant ScreenSaverReset 0) -+(defconstant ScreenSaverActive 1) -+ -+;;**************************************************************** -+;; * HOSTS AND CONNECTIONS -+;; **************************************************************** -+ -+;; for ChangeHosts -+ -+(defconstant HostInsert 0) -+(defconstant HostDelete 1) -+ -+;; for ChangeAccessControl -+ -+(defconstant EnableAccess 1 ) -+(defconstant DisableAccess 0) -+ -+;; Display classes used in opening the connection -+;; * Note that the statically allocated ones are even numbered and the -+;; * dynamically changeable ones are odd numbered -+ -+(defconstant StaticGray 0) -+(defconstant GrayScale 1) -+(defconstant StaticColor 2) -+(defconstant PseudoColor 3) -+(defconstant TrueColor 4) -+(defconstant DirectColor 5) -+ -+ -+;; Byte order used in imageByteOrder and bitmapBitOrder -+ -+(defconstant LSBFirst 0) -+(defconstant MSBFirst 1) -+ -+ -+;(defconstant NULL 0) -+ -+ ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_XStruct_l_3.lsp -@@ -0,0 +1,491 @@ -+(in-package :XLIB) -+; XStruct-l-3.lsp modified by Hiep Huu Nguyen 27 Aug 92 -+ -+; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. -+ -+; See the files gnu.license and dec.copyright . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Some of the files that interface to the Xlib are adapted from DEC/MIT files. -+; See the file dec.copyright for details. -+ -+ -+ -+ -+;;;;;; XExtCodes funcions ;;;;;; -+ -+(defentry make-XExtCodes () ( fixnum "make_XExtCodes" )) -+(defentry XExtCodes-first_error (fixnum) ( fixnum "XExtCodes_first_error" )) -+(defentry set-XExtCodes-first_error (fixnum fixnum) ( void "set_XExtCodes_first_error" )) -+(defentry XExtCodes-first_event (fixnum) ( fixnum "XExtCodes_first_event" )) -+(defentry set-XExtCodes-first_event (fixnum fixnum) ( void "set_XExtCodes_first_event" )) -+(defentry XExtCodes-major_opcode (fixnum) ( fixnum "XExtCodes_major_opcode" )) -+(defentry set-XExtCodes-major_opcode (fixnum fixnum) ( void "set_XExtCodes_major_opcode" )) -+(defentry XExtCodes-extension (fixnum) ( fixnum "XExtCodes_extension" )) -+(defentry set-XExtCodes-extension (fixnum fixnum) ( void "set_XExtCodes_extension" )) -+ -+ -+;;;;;; XPixmapFormatValues funcions ;;;;;; -+ -+(defentry make-XPixmapFormatValues () ( fixnum "make_XPixmapFormatValues" )) -+(defentry XPixmapFormatValues-scanline_pad (fixnum) ( fixnum "XPixmapFormatValues_scanline_pad" )) -+(defentry set-XPixmapFormatValues-scanline_pad (fixnum fixnum) ( void "set_XPixmapFormatValues_scanline_pad" )) -+(defentry XPixmapFormatValues-bits_per_pixel (fixnum) ( fixnum "XPixmapFormatValues_bits_per_pixel" )) -+(defentry set-XPixmapFormatValues-bits_per_pixel (fixnum fixnum) ( void "set_XPixmapFormatValues_bits_per_pixel" )) -+(defentry XPixmapFormatValues-depth (fixnum) ( fixnum "XPixmapFormatValues_depth" )) -+(defentry set-XPixmapFormatValues-depth (fixnum fixnum) ( void "set_XPixmapFormatValues_depth" )) -+ -+ -+;;;;;; XGCValues funcions ;;;;;; -+ -+(defentry make-XGCValues () ( fixnum "make_XGCValues" )) -+(defentry XGCValues-dashes (fixnum) ( char "XGCValues_dashes" )) -+(defentry set-XGCValues-dashes (fixnum char) ( void "set_XGCValues_dashes" )) -+(defentry XGCValues-dash_offset (fixnum) ( fixnum "XGCValues_dash_offset" )) -+(defentry set-XGCValues-dash_offset (fixnum fixnum) ( void "set_XGCValues_dash_offset" )) -+(defentry XGCValues-clip_mask (fixnum) ( fixnum "XGCValues_clip_mask" )) -+(defentry set-XGCValues-clip_mask (fixnum fixnum) ( void "set_XGCValues_clip_mask" )) -+(defentry XGCValues-clip_y_origin (fixnum) ( fixnum "XGCValues_clip_y_origin" )) -+(defentry set-XGCValues-clip_y_origin (fixnum fixnum) ( void "set_XGCValues_clip_y_origin" )) -+(defentry XGCValues-clip_x_origin (fixnum) ( fixnum "XGCValues_clip_x_origin" )) -+(defentry set-XGCValues-clip_x_origin (fixnum fixnum) ( void "set_XGCValues_clip_x_origin" )) -+(defentry XGCValues-graphics_exposures (fixnum) ( fixnum "XGCValues_graphics_exposures" )) -+(defentry set-XGCValues-graphics_exposures (fixnum fixnum) ( void "set_XGCValues_graphics_exposures" )) -+(defentry XGCValues-subwindow_mode (fixnum) ( fixnum "XGCValues_subwindow_mode" )) -+(defentry set-XGCValues-subwindow_mode (fixnum fixnum) ( void "set_XGCValues_subwindow_mode" )) -+(defentry XGCValues-font (fixnum) ( fixnum "XGCValues_font" )) -+(defentry set-XGCValues-font (fixnum fixnum) ( void "set_XGCValues_font" )) -+(defentry XGCValues-ts_y_origin (fixnum) ( fixnum "XGCValues_ts_y_origin" )) -+(defentry set-XGCValues-ts_y_origin (fixnum fixnum) ( void "set_XGCValues_ts_y_origin" )) -+(defentry XGCValues-ts_x_origin (fixnum) ( fixnum "XGCValues_ts_x_origin" )) -+(defentry set-XGCValues-ts_x_origin (fixnum fixnum) ( void "set_XGCValues_ts_x_origin" )) -+(defentry XGCValues-stipple (fixnum) ( fixnum "XGCValues_stipple" )) -+(defentry set-XGCValues-stipple (fixnum fixnum) ( void "set_XGCValues_stipple" )) -+(defentry XGCValues-tile (fixnum) ( fixnum "XGCValues_tile" )) -+(defentry set-XGCValues-tile (fixnum fixnum) ( void "set_XGCValues_tile" )) -+(defentry XGCValues-arc_mode (fixnum) ( fixnum "XGCValues_arc_mode" )) -+(defentry set-XGCValues-arc_mode (fixnum fixnum) ( void "set_XGCValues_arc_mode" )) -+(defentry XGCValues-fill_rule (fixnum) ( fixnum "XGCValues_fill_rule" )) -+(defentry set-XGCValues-fill_rule (fixnum fixnum) ( void "set_XGCValues_fill_rule" )) -+(defentry XGCValues-fill_style (fixnum) ( fixnum "XGCValues_fill_style" )) -+(defentry set-XGCValues-fill_style (fixnum fixnum) ( void "set_XGCValues_fill_style" )) -+(defentry XGCValues-join_style (fixnum) ( fixnum "XGCValues_join_style" )) -+(defentry set-XGCValues-join_style (fixnum fixnum) ( void "set_XGCValues_join_style" )) -+(defentry XGCValues-cap_style (fixnum) ( fixnum "XGCValues_cap_style" )) -+(defentry set-XGCValues-cap_style (fixnum fixnum) ( void "set_XGCValues_cap_style" )) -+(defentry XGCValues-line_style (fixnum) ( fixnum "XGCValues_line_style" )) -+(defentry set-XGCValues-line_style (fixnum fixnum) ( void "set_XGCValues_line_style" )) -+(defentry XGCValues-line_width (fixnum) ( fixnum "XGCValues_line_width" )) -+(defentry set-XGCValues-line_width (fixnum fixnum) ( void "set_XGCValues_line_width" )) -+(defentry XGCValues-background (fixnum) ( fixnum "XGCValues_background" )) -+(defentry set-XGCValues-background (fixnum fixnum) ( void "set_XGCValues_background" )) -+(defentry XGCValues-foreground (fixnum) ( fixnum "XGCValues_foreground" )) -+(defentry set-XGCValues-foreground (fixnum fixnum) ( void "set_XGCValues_foreground" )) -+(defentry XGCValues-plane_mask (fixnum) ( fixnum "XGCValues_plane_mask" )) -+(defentry set-XGCValues-plane_mask (fixnum fixnum) ( void "set_XGCValues_plane_mask" )) -+(defentry XGCValues-function (fixnum) ( fixnum "XGCValues_function" )) -+(defentry set-XGCValues-function (fixnum fixnum) ( void "set_XGCValues_function" )) -+ -+ -+;;;;;; *GC funcions ;;;;;; -+ -+;;(defentry make-*GC () ( fixnum "make_*GC" )) -+;;(defentry *GC-values (fixnum) ( fixnum "*GC_values" )) -+;;(defentry set-*GC-values (fixnum fixnum) ( void "set_*GC_values" )) -+;;(defentry *GC-dirty (fixnum) ( fixnum "*GC_dirty" )) -+;;(defentry set-*GC-dirty (fixnum fixnum) ( void "set_*GC_dirty" )) -+;;(defentry *GC-dashes (fixnum) ( fixnum "*GC_dashes" )) -+;;(defentry set-*GC-dashes (fixnum fixnum) ( void "set_*GC_dashes" )) -+;;(defentry *GC-rects (fixnum) ( fixnum "*GC_rects" )) -+;;(defentry set-*GC-rects (fixnum fixnum) ( void "set_*GC_rects" )) -+;;(defentry *GC-gid (fixnum) ( fixnum "*GC_gid" )) -+;;(defentry set-*GC-gid (fixnum fixnum) ( void "set_*GC_gid" )) -+;;(defentry *GC-ext_data (fixnum) ( fixnum "*GC_ext_data" )) -+;;(defentry set-*GC-ext_data (fixnum fixnum) ( void "set_*GC_ext_data" )) -+ -+ -+;;;;;; Visual funcions ;;;;;; -+ -+(defentry make-Visual () ( fixnum "make_Visual" )) -+(defentry Visual-map_entries (fixnum) ( fixnum "Visual_map_entries" )) -+(defentry set-Visual-map_entries (fixnum fixnum) ( void "set_Visual_map_entries" )) -+(defentry Visual-bits_per_rgb (fixnum) ( fixnum "Visual_bits_per_rgb" )) -+(defentry set-Visual-bits_per_rgb (fixnum fixnum) ( void "set_Visual_bits_per_rgb" )) -+(defentry Visual-blue_mask (fixnum) ( fixnum "Visual_blue_mask" )) -+(defentry set-Visual-blue_mask (fixnum fixnum) ( void "set_Visual_blue_mask" )) -+(defentry Visual-green_mask (fixnum) ( fixnum "Visual_green_mask" )) -+(defentry set-Visual-green_mask (fixnum fixnum) ( void "set_Visual_green_mask" )) -+(defentry Visual-red_mask (fixnum) ( fixnum "Visual_red_mask" )) -+(defentry set-Visual-red_mask (fixnum fixnum) ( void "set_Visual_red_mask" )) -+(defentry Visual-class (fixnum) ( fixnum "Visual_class" )) -+(defentry set-Visual-class (fixnum fixnum) ( void "set_Visual_class" )) -+(defentry Visual-visualid (fixnum) ( fixnum "Visual_visualid" )) -+(defentry set-Visual-visualid (fixnum fixnum) ( void "set_Visual_visualid" )) -+(defentry Visual-ext_data (fixnum) ( fixnum "Visual_ext_data" )) -+(defentry set-Visual-ext_data (fixnum fixnum) ( void "set_Visual_ext_data" )) -+ -+ -+;;;;;; Depth funcions ;;;;;; -+ -+(defentry make-Depth () ( fixnum "make_Depth" )) -+(defentry Depth-visuals (fixnum) ( fixnum "Depth_visuals" )) -+(defentry set-Depth-visuals (fixnum fixnum) ( void "set_Depth_visuals" )) -+(defentry Depth-nvisuals (fixnum) ( fixnum "Depth_nvisuals" )) -+(defentry set-Depth-nvisuals (fixnum fixnum) ( void "set_Depth_nvisuals" )) -+(defentry Depth-depth (fixnum) ( fixnum "Depth_depth" )) -+(defentry set-Depth-depth (fixnum fixnum) ( void "set_Depth_depth" )) -+ -+ -+;;;;;; Screen funcions ;;;;;; -+ -+(defentry make-Screen () ( fixnum "make_Screen" )) -+(defentry Screen-root_input_mask (fixnum) ( fixnum "Screen_root_input_mask" )) -+(defentry set-Screen-root_input_mask (fixnum fixnum) ( void "set_Screen_root_input_mask" )) -+(defentry Screen-save_unders (fixnum) ( fixnum "Screen_save_unders" )) -+(defentry set-Screen-save_unders (fixnum fixnum) ( void "set_Screen_save_unders" )) -+(defentry Screen-backing_store (fixnum) ( fixnum "Screen_backing_store" )) -+(defentry set-Screen-backing_store (fixnum fixnum) ( void "set_Screen_backing_store" )) -+(defentry Screen-min_maps (fixnum) ( fixnum "Screen_min_maps" )) -+(defentry set-Screen-min_maps (fixnum fixnum) ( void "set_Screen_min_maps" )) -+(defentry Screen-max_maps (fixnum) ( fixnum "Screen_max_maps" )) -+(defentry set-Screen-max_maps (fixnum fixnum) ( void "set_Screen_max_maps" )) -+(defentry Screen-black_pixel (fixnum) ( fixnum "Screen_black_pixel" )) -+(defentry set-Screen-black_pixel (fixnum fixnum) ( void "set_Screen_black_pixel" )) -+(defentry Screen-white_pixel (fixnum) ( fixnum "Screen_white_pixel" )) -+(defentry set-Screen-white_pixel (fixnum fixnum) ( void "set_Screen_white_pixel" )) -+(defentry Screen-cmap (fixnum) ( fixnum "Screen_cmap" )) -+(defentry set-Screen-cmap (fixnum fixnum) ( void "set_Screen_cmap" )) -+(defentry Screen-default_gc (fixnum) ( fixnum "Screen_default_gc" )) -+(defentry set-Screen-default_gc (fixnum fixnum) ( void "set_Screen_default_gc" )) -+(defentry Screen-root_visual (fixnum) ( fixnum "Screen_root_visual" )) -+(defentry set-Screen-root_visual (fixnum fixnum) ( void "set_Screen_root_visual" )) -+(defentry Screen-root_depth (fixnum) ( fixnum "Screen_root_depth" )) -+(defentry set-Screen-root_depth (fixnum fixnum) ( void "set_Screen_root_depth" )) -+(defentry Screen-depths (fixnum) ( fixnum "Screen_depths" )) -+(defentry set-Screen-depths (fixnum fixnum) ( void "set_Screen_depths" )) -+(defentry Screen-ndepths (fixnum) ( fixnum "Screen_ndepths" )) -+(defentry set-Screen-ndepths (fixnum fixnum) ( void "set_Screen_ndepths" )) -+(defentry Screen-mheight (fixnum) ( fixnum "Screen_mheight" )) -+(defentry set-Screen-mheight (fixnum fixnum) ( void "set_Screen_mheight" )) -+(defentry Screen-mwidth (fixnum) ( fixnum "Screen_mwidth" )) -+(defentry set-Screen-mwidth (fixnum fixnum) ( void "set_Screen_mwidth" )) -+(defentry Screen-height (fixnum) ( fixnum "Screen_height" )) -+(defentry set-Screen-height (fixnum fixnum) ( void "set_Screen_height" )) -+(defentry Screen-width (fixnum) ( fixnum "Screen_width" )) -+(defentry set-Screen-width (fixnum fixnum) ( void "set_Screen_width" )) -+(defentry Screen-root (fixnum) ( fixnum "Screen_root" )) -+(defentry set-Screen-root (fixnum fixnum) ( void "set_Screen_root" )) -+(defentry Screen-display (fixnum) ( fixnum "Screen_display" )) -+(defentry set-Screen-display (fixnum fixnum) ( void "set_Screen_display" )) -+(defentry Screen-ext_data (fixnum) ( fixnum "Screen_ext_data" )) -+(defentry set-Screen-ext_data (fixnum fixnum) ( void "set_Screen_ext_data" )) -+ -+ -+;;;;;; ScreenFormat funcions ;;;;;; -+ -+(defentry make-ScreenFormat () ( fixnum "make_ScreenFormat" )) -+(defentry ScreenFormat-scanline_pad (fixnum) ( fixnum "ScreenFormat_scanline_pad" )) -+(defentry set-ScreenFormat-scanline_pad (fixnum fixnum) ( void "set_ScreenFormat_scanline_pad" )) -+(defentry ScreenFormat-bits_per_pixel (fixnum) ( fixnum "ScreenFormat_bits_per_pixel" )) -+(defentry set-ScreenFormat-bits_per_pixel (fixnum fixnum) ( void "set_ScreenFormat_bits_per_pixel" )) -+(defentry ScreenFormat-depth (fixnum) ( fixnum "ScreenFormat_depth" )) -+(defentry set-ScreenFormat-depth (fixnum fixnum) ( void "set_ScreenFormat_depth" )) -+(defentry ScreenFormat-ext_data (fixnum) ( fixnum "ScreenFormat_ext_data" )) -+(defentry set-ScreenFormat-ext_data (fixnum fixnum) ( void "set_ScreenFormat_ext_data" )) -+ -+ -+;;;;;; XSetWindowAttributes funcions ;;;;;; -+ -+(defentry make-XSetWindowAttributes () ( fixnum "make_XSetWindowAttributes" )) -+(defentry XSetWindowAttributes-cursor (fixnum) ( fixnum "XSetWindowAttributes_cursor" )) -+(defentry set-XSetWindowAttributes-cursor (fixnum fixnum) ( void "set_XSetWindowAttributes_cursor" )) -+(defentry XSetWindowAttributes-colormap (fixnum) ( fixnum "XSetWindowAttributes_colormap" )) -+(defentry set-XSetWindowAttributes-colormap (fixnum fixnum) ( void "set_XSetWindowAttributes_colormap" )) -+(defentry XSetWindowAttributes-override_redirect (fixnum) ( fixnum "XSetWindowAttributes_override_redirect" )) -+(defentry set-XSetWindowAttributes-override_redirect (fixnum fixnum) ( void "set_XSetWindowAttributes_override_redirect" )) -+(defentry XSetWindowAttributes-do_not_propagate_mask (fixnum) ( fixnum "XSetWindowAttributes_do_not_propagate_mask" )) -+(defentry set-XSetWindowAttributes-do_not_propagate_mask (fixnum fixnum) ( void "set_XSetWindowAttributes_do_not_propagate_mask" )) -+(defentry XSetWindowAttributes-event_mask (fixnum) ( fixnum "XSetWindowAttributes_event_mask" )) -+(defentry set-XSetWindowAttributes-event_mask (fixnum fixnum) ( void "set_XSetWindowAttributes_event_mask" )) -+(defentry XSetWindowAttributes-save_under (fixnum) ( fixnum "XSetWindowAttributes_save_under" )) -+(defentry set-XSetWindowAttributes-save_under (fixnum fixnum) ( void "set_XSetWindowAttributes_save_under" )) -+(defentry XSetWindowAttributes-backing_pixel (fixnum) ( fixnum "XSetWindowAttributes_backing_pixel" )) -+(defentry set-XSetWindowAttributes-backing_pixel (fixnum fixnum) ( void "set_XSetWindowAttributes_backing_pixel" )) -+(defentry XSetWindowAttributes-backing_planes (fixnum) ( fixnum "XSetWindowAttributes_backing_planes" )) -+(defentry set-XSetWindowAttributes-backing_planes (fixnum fixnum) ( void "set_XSetWindowAttributes_backing_planes" )) -+(defentry XSetWindowAttributes-backing_store (fixnum) ( fixnum "XSetWindowAttributes_backing_store" )) -+(defentry set-XSetWindowAttributes-backing_store (fixnum fixnum) ( void "set_XSetWindowAttributes_backing_store" )) -+(defentry XSetWindowAttributes-win_gravity (fixnum) ( fixnum "XSetWindowAttributes_win_gravity" )) -+(defentry set-XSetWindowAttributes-win_gravity (fixnum fixnum) ( void "set_XSetWindowAttributes_win_gravity" )) -+(defentry XSetWindowAttributes-bit_gravity (fixnum) ( fixnum "XSetWindowAttributes_bit_gravity" )) -+(defentry set-XSetWindowAttributes-bit_gravity (fixnum fixnum) ( void "set_XSetWindowAttributes_bit_gravity" )) -+(defentry XSetWindowAttributes-border_pixel (fixnum) ( fixnum "XSetWindowAttributes_border_pixel" )) -+(defentry set-XSetWindowAttributes-border_pixel (fixnum fixnum) ( void "set_XSetWindowAttributes_border_pixel" )) -+(defentry XSetWindowAttributes-border_pixmap (fixnum) ( fixnum "XSetWindowAttributes_border_pixmap" )) -+(defentry set-XSetWindowAttributes-border_pixmap (fixnum fixnum) ( void "set_XSetWindowAttributes_border_pixmap" )) -+(defentry XSetWindowAttributes-background_pixel (fixnum) ( fixnum "XSetWindowAttributes_background_pixel" )) -+(defentry set-XSetWindowAttributes-background_pixel (fixnum fixnum) ( void "set_XSetWindowAttributes_background_pixel" )) -+(defentry XSetWindowAttributes-background_pixmap (fixnum) ( fixnum "XSetWindowAttributes_background_pixmap" )) -+(defentry set-XSetWindowAttributes-background_pixmap (fixnum fixnum) ( void "set_XSetWindowAttributes_background_pixmap" )) -+ -+ -+;;;;;; XWindowAttributes funcions ;;;;;; -+ -+(defentry make-XWindowAttributes () ( fixnum "make_XWindowAttributes" )) -+(defentry XWindowAttributes-screen (fixnum) ( fixnum "XWindowAttributes_screen" )) -+(defentry set-XWindowAttributes-screen (fixnum fixnum) ( void "set_XWindowAttributes_screen" )) -+(defentry XWindowAttributes-override_redirect (fixnum) ( fixnum "XWindowAttributes_override_redirect" )) -+(defentry set-XWindowAttributes-override_redirect (fixnum fixnum) ( void "set_XWindowAttributes_override_redirect" )) -+(defentry XWindowAttributes-do_not_propagate_mask (fixnum) ( fixnum "XWindowAttributes_do_not_propagate_mask" )) -+(defentry set-XWindowAttributes-do_not_propagate_mask (fixnum fixnum) ( void "set_XWindowAttributes_do_not_propagate_mask" )) -+(defentry XWindowAttributes-your_event_mask (fixnum) ( fixnum "XWindowAttributes_your_event_mask" )) -+(defentry set-XWindowAttributes-your_event_mask (fixnum fixnum) ( void "set_XWindowAttributes_your_event_mask" )) -+(defentry XWindowAttributes-all_event_masks (fixnum) ( fixnum "XWindowAttributes_all_event_masks" )) -+(defentry set-XWindowAttributes-all_event_masks (fixnum fixnum) ( void "set_XWindowAttributes_all_event_masks" )) -+(defentry XWindowAttributes-map_state (fixnum) ( fixnum "XWindowAttributes_map_state" )) -+(defentry set-XWindowAttributes-map_state (fixnum fixnum) ( void "set_XWindowAttributes_map_state" )) -+(defentry XWindowAttributes-map_installed (fixnum) ( fixnum "XWindowAttributes_map_installed" )) -+(defentry set-XWindowAttributes-map_installed (fixnum fixnum) ( void "set_XWindowAttributes_map_installed" )) -+(defentry XWindowAttributes-colormap (fixnum) ( fixnum "XWindowAttributes_colormap" )) -+(defentry set-XWindowAttributes-colormap (fixnum fixnum) ( void "set_XWindowAttributes_colormap" )) -+(defentry XWindowAttributes-save_under (fixnum) ( fixnum "XWindowAttributes_save_under" )) -+(defentry set-XWindowAttributes-save_under (fixnum fixnum) ( void "set_XWindowAttributes_save_under" )) -+(defentry XWindowAttributes-backing_pixel (fixnum) ( fixnum "XWindowAttributes_backing_pixel" )) -+(defentry set-XWindowAttributes-backing_pixel (fixnum fixnum) ( void "set_XWindowAttributes_backing_pixel" )) -+(defentry XWindowAttributes-backing_planes (fixnum) ( fixnum "XWindowAttributes_backing_planes" )) -+(defentry set-XWindowAttributes-backing_planes (fixnum fixnum) ( void "set_XWindowAttributes_backing_planes" )) -+(defentry XWindowAttributes-backing_store (fixnum) ( fixnum "XWindowAttributes_backing_store" )) -+(defentry set-XWindowAttributes-backing_store (fixnum fixnum) ( void "set_XWindowAttributes_backing_store" )) -+(defentry XWindowAttributes-win_gravity (fixnum) ( fixnum "XWindowAttributes_win_gravity" )) -+(defentry set-XWindowAttributes-win_gravity (fixnum fixnum) ( void "set_XWindowAttributes_win_gravity" )) -+(defentry XWindowAttributes-bit_gravity (fixnum) ( fixnum "XWindowAttributes_bit_gravity" )) -+(defentry set-XWindowAttributes-bit_gravity (fixnum fixnum) ( void "set_XWindowAttributes_bit_gravity" )) -+(defentry XWindowAttributes-class (fixnum) ( fixnum "XWindowAttributes_class" )) -+(defentry set-XWindowAttributes-class (fixnum fixnum) ( void "set_XWindowAttributes_class" )) -+(defentry XWindowAttributes-root (fixnum) ( fixnum "XWindowAttributes_root" )) -+(defentry set-XWindowAttributes-root (fixnum fixnum) ( void "set_XWindowAttributes_root" )) -+(defentry XWindowAttributes-visual (fixnum) ( fixnum "XWindowAttributes_visual" )) -+(defentry set-XWindowAttributes-visual (fixnum fixnum) ( void "set_XWindowAttributes_visual" )) -+(defentry XWindowAttributes-depth (fixnum) ( fixnum "XWindowAttributes_depth" )) -+(defentry set-XWindowAttributes-depth (fixnum fixnum) ( void "set_XWindowAttributes_depth" )) -+(defentry XWindowAttributes-border_width (fixnum) ( fixnum "XWindowAttributes_border_width" )) -+(defentry set-XWindowAttributes-border_width (fixnum fixnum) ( void "set_XWindowAttributes_border_width" )) -+(defentry XWindowAttributes-height (fixnum) ( fixnum "XWindowAttributes_height" )) -+(defentry set-XWindowAttributes-height (fixnum fixnum) ( void "set_XWindowAttributes_height" )) -+(defentry XWindowAttributes-width (fixnum) ( fixnum "XWindowAttributes_width" )) -+(defentry set-XWindowAttributes-width (fixnum fixnum) ( void "set_XWindowAttributes_width" )) -+(defentry XWindowAttributes-y (fixnum) ( fixnum "XWindowAttributes_y" )) -+(defentry set-XWindowAttributes-y (fixnum fixnum) ( void "set_XWindowAttributes_y" )) -+(defentry XWindowAttributes-x (fixnum) ( fixnum "XWindowAttributes_x" )) -+(defentry set-XWindowAttributes-x (fixnum fixnum) ( void "set_XWindowAttributes_x" )) -+ -+ -+;;;;;; XHostAddress funcions ;;;;;; -+ -+(defentry make-XHostAddress () ( fixnum "make_XHostAddress" )) -+(defentry XHostAddress-address (fixnum) ( fixnum "XHostAddress_address" )) -+(defentry set-XHostAddress-address (fixnum fixnum) ( void "set_XHostAddress_address" )) -+(defentry XHostAddress-length (fixnum) ( fixnum "XHostAddress_length" )) -+(defentry set-XHostAddress-length (fixnum fixnum) ( void "set_XHostAddress_length" )) -+(defentry XHostAddress-family (fixnum) ( fixnum "XHostAddress_family" )) -+(defentry set-XHostAddress-family (fixnum fixnum) ( void "set_XHostAddress_family" )) -+ -+ -+;;;;;; XImage funcions ;;;;;; -+ -+(defentry make-XImage () ( fixnum "make_XImage" )) -+;;(defentry XImage-f (fixnum) ( fixnum "XImage_f" )) -+;;(defentry set-XImage-f (fixnum fixnum) ( void "set_XImage_f" )) -+(defentry XImage-obdata (fixnum) ( fixnum "XImage_obdata" )) -+(defentry set-XImage-obdata (fixnum fixnum) ( void "set_XImage_obdata" )) -+(defentry XImage-blue_mask (fixnum) ( fixnum "XImage_blue_mask" )) -+(defentry set-XImage-blue_mask (fixnum fixnum) ( void "set_XImage_blue_mask" )) -+(defentry XImage-green_mask (fixnum) ( fixnum "XImage_green_mask" )) -+(defentry set-XImage-green_mask (fixnum fixnum) ( void "set_XImage_green_mask" )) -+(defentry XImage-red_mask (fixnum) ( fixnum "XImage_red_mask" )) -+(defentry set-XImage-red_mask (fixnum fixnum) ( void "set_XImage_red_mask" )) -+(defentry XImage-bits_per_pixel (fixnum) ( fixnum "XImage_bits_per_pixel" )) -+(defentry set-XImage-bits_per_pixel (fixnum fixnum) ( void "set_XImage_bits_per_pixel" )) -+(defentry XImage-bytes_per_line (fixnum) ( fixnum "XImage_bytes_per_line" )) -+(defentry set-XImage-bytes_per_line (fixnum fixnum) ( void "set_XImage_bytes_per_line" )) -+(defentry XImage-depth (fixnum) ( fixnum "XImage_depth" )) -+(defentry set-XImage-depth (fixnum fixnum) ( void "set_XImage_depth" )) -+(defentry XImage-bitmap_pad (fixnum) ( fixnum "XImage_bitmap_pad" )) -+(defentry set-XImage-bitmap_pad (fixnum fixnum) ( void "set_XImage_bitmap_pad" )) -+(defentry XImage-bitmap_bit_order (fixnum) ( fixnum "XImage_bitmap_bit_order" )) -+(defentry set-XImage-bitmap_bit_order (fixnum fixnum) ( void "set_XImage_bitmap_bit_order" )) -+(defentry XImage-bitmap_unit (fixnum) ( fixnum "XImage_bitmap_unit" )) -+(defentry set-XImage-bitmap_unit (fixnum fixnum) ( void "set_XImage_bitmap_unit" )) -+(defentry XImage-byte_order (fixnum) ( fixnum "XImage_byte_order" )) -+(defentry set-XImage-byte_order (fixnum fixnum) ( void "set_XImage_byte_order" )) -+(defentry XImage-data (fixnum) ( fixnum "XImage_data" )) -+(defentry set-XImage-data (fixnum fixnum) ( void "set_XImage_data" )) -+(defentry XImage-format (fixnum) ( fixnum "XImage_format" )) -+(defentry set-XImage-format (fixnum fixnum) ( void "set_XImage_format" )) -+(defentry XImage-xoffset (fixnum) ( fixnum "XImage_xoffset" )) -+(defentry set-XImage-xoffset (fixnum fixnum) ( void "set_XImage_xoffset" )) -+(defentry XImage-height (fixnum) ( fixnum "XImage_height" )) -+(defentry set-XImage-height (fixnum fixnum) ( void "set_XImage_height" )) -+(defentry XImage-width (fixnum) ( fixnum "XImage_width" )) -+(defentry set-XImage-width (fixnum fixnum) ( void "set_XImage_width" )) -+ -+ -+;;;;;; XWindowChanges funcions ;;;;;; -+ -+(defentry make-XWindowChanges () ( fixnum "make_XWindowChanges" )) -+(defentry XWindowChanges-stack_mode (fixnum) ( fixnum "XWindowChanges_stack_mode" )) -+(defentry set-XWindowChanges-stack_mode (fixnum fixnum) ( void "set_XWindowChanges_stack_mode" )) -+(defentry XWindowChanges-sibling (fixnum) ( fixnum "XWindowChanges_sibling" )) -+(defentry set-XWindowChanges-sibling (fixnum fixnum) ( void "set_XWindowChanges_sibling" )) -+(defentry XWindowChanges-border_width (fixnum) ( fixnum "XWindowChanges_border_width" )) -+(defentry set-XWindowChanges-border_width (fixnum fixnum) ( void "set_XWindowChanges_border_width" )) -+(defentry XWindowChanges-height (fixnum) ( fixnum "XWindowChanges_height" )) -+(defentry set-XWindowChanges-height (fixnum fixnum) ( void "set_XWindowChanges_height" )) -+(defentry XWindowChanges-width (fixnum) ( fixnum "XWindowChanges_width" )) -+(defentry set-XWindowChanges-width (fixnum fixnum) ( void "set_XWindowChanges_width" )) -+(defentry XWindowChanges-y (fixnum) ( fixnum "XWindowChanges_y" )) -+(defentry set-XWindowChanges-y (fixnum fixnum) ( void "set_XWindowChanges_y" )) -+(defentry XWindowChanges-x (fixnum) ( fixnum "XWindowChanges_x" )) -+(defentry set-XWindowChanges-x (fixnum fixnum) ( void "set_XWindowChanges_x" )) -+ -+ -+;;;;;; XColor funcions ;;;;;; -+ -+(defentry make-XColor () ( fixnum "make_XColor" )) -+(defentry XColor-pad (fixnum) ( char "XColor_pad" )) -+(defentry set-XColor-pad (fixnum char) ( void "set_XColor_pad" )) -+(defentry XColor-flags (fixnum) ( char "XColor_flags" )) -+(defentry set-XColor-flags (fixnum char) ( void "set_XColor_flags" )) -+(defentry XColor-blue (fixnum) ( fixnum "XColor_blue" )) -+(defentry set-XColor-blue (fixnum fixnum) ( void "set_XColor_blue" )) -+(defentry XColor-green (fixnum) ( fixnum "XColor_green" )) -+(defentry set-XColor-green (fixnum fixnum) ( void "set_XColor_green" )) -+(defentry XColor-red (fixnum) ( fixnum "XColor_red" )) -+(defentry set-XColor-red (fixnum fixnum) ( void "set_XColor_red" )) -+(defentry XColor-pixel (fixnum) ( fixnum "XColor_pixel" )) -+(defentry set-XColor-pixel (fixnum fixnum) ( void "set_XColor_pixel" )) -+ -+ -+;;;;;; XSegment funcions ;;;;;; -+ -+(defentry make-XSegment () ( fixnum "make_XSegment" )) -+(defentry XSegment-y2 (fixnum) ( fixnum "XSegment_y2" )) -+(defentry set-XSegment-y2 (fixnum fixnum) ( void "set_XSegment_y2" )) -+(defentry XSegment-x2 (fixnum) ( fixnum "XSegment_x2" )) -+(defentry set-XSegment-x2 (fixnum fixnum) ( void "set_XSegment_x2" )) -+(defentry XSegment-y1 (fixnum) ( fixnum "XSegment_y1" )) -+(defentry set-XSegment-y1 (fixnum fixnum) ( void "set_XSegment_y1" )) -+(defentry XSegment-x1 (fixnum) ( fixnum "XSegment_x1" )) -+(defentry set-XSegment-x1 (fixnum fixnum) ( void "set_XSegment_x1" )) -+ -+ -+;;;;;; XPoint funcions ;;;;;; -+ -+(defentry make-XPoint () ( fixnum "make_XPoint" )) -+(defentry XPoint-y (fixnum) ( fixnum "XPoint_y" )) -+(defentry set-XPoint-y (fixnum fixnum) ( void "set_XPoint_y" )) -+(defentry XPoint-x (fixnum) ( fixnum "XPoint_x" )) -+(defentry set-XPoint-x (fixnum fixnum) ( void "set_XPoint_x" )) -+ -+ -+;;;;;; XRectangle funcions ;;;;;; -+ -+(defentry make-XRectangle () ( fixnum "make_XRectangle" )) -+(defentry XRectangle-height (fixnum) ( fixnum "XRectangle_height" )) -+(defentry set-XRectangle-height (fixnum fixnum) ( void "set_XRectangle_height" )) -+(defentry XRectangle-width (fixnum) ( fixnum "XRectangle_width" )) -+(defentry set-XRectangle-width (fixnum fixnum) ( void "set_XRectangle_width" )) -+(defentry XRectangle-y (fixnum) ( fixnum "XRectangle_y" )) -+(defentry set-XRectangle-y (fixnum fixnum) ( void "set_XRectangle_y" )) -+(defentry XRectangle-x (fixnum) ( fixnum "XRectangle_x" )) -+(defentry set-XRectangle-x (fixnum fixnum) ( void "set_XRectangle_x" )) -+ -+ -+;;;;;; XArc funcions ;;;;;; -+ -+(defentry make-XArc () ( fixnum "make_XArc" )) -+(defentry XArc-angle2 (fixnum) ( fixnum "XArc_angle2" )) -+(defentry set-XArc-angle2 (fixnum fixnum) ( void "set_XArc_angle2" )) -+(defentry XArc-angle1 (fixnum) ( fixnum "XArc_angle1" )) -+(defentry set-XArc-angle1 (fixnum fixnum) ( void "set_XArc_angle1" )) -+(defentry XArc-height (fixnum) ( fixnum "XArc_height" )) -+(defentry set-XArc-height (fixnum fixnum) ( void "set_XArc_height" )) -+(defentry XArc-width (fixnum) ( fixnum "XArc_width" )) -+(defentry set-XArc-width (fixnum fixnum) ( void "set_XArc_width" )) -+(defentry XArc-y (fixnum) ( fixnum "XArc_y" )) -+(defentry set-XArc-y (fixnum fixnum) ( void "set_XArc_y" )) -+(defentry XArc-x (fixnum) ( fixnum "XArc_x" )) -+(defentry set-XArc-x (fixnum fixnum) ( void "set_XArc_x" )) -+ -+ -+;;;;;; XKeyboardControl funcions ;;;;;; -+ -+(defentry make-XKeyboardControl () ( fixnum "make_XKeyboardControl" )) -+(defentry XKeyboardControl-auto_repeat_mode (fixnum) ( fixnum "XKeyboardControl_auto_repeat_mode" )) -+;;(defentry set-XKeyboardControl-auto_repeat_mode (fixnum fixnum) ( void "set_XKeyboardControl_auto_repeat_mode" )) -+(defentry XKeyboardControl-key (fixnum) ( fixnum "XKeyboardControl_key" )) -+(defentry set-XKeyboardControl-key (fixnum fixnum) ( void "set_XKeyboardControl_key" )) -+(defentry XKeyboardControl-led_mode (fixnum) ( fixnum "XKeyboardControl_led_mode" )) -+(defentry set-XKeyboardControl-led_mode (fixnum fixnum) ( void "set_XKeyboardControl_led_mode" )) -+(defentry XKeyboardControl-led (fixnum) ( fixnum "XKeyboardControl_led" )) -+(defentry set-XKeyboardControl-led (fixnum fixnum) ( void "set_XKeyboardControl_led" )) -+(defentry XKeyboardControl-bell_duration (fixnum) ( fixnum "XKeyboardControl_bell_duration" )) -+(defentry set-XKeyboardControl-bell_duration (fixnum fixnum) ( void "set_XKeyboardControl_bell_duration" )) -+(defentry XKeyboardControl-bell_pitch (fixnum) ( fixnum "XKeyboardControl_bell_pitch" )) -+(defentry set-XKeyboardControl-bell_pitch (fixnum fixnum) ( void "set_XKeyboardControl_bell_pitch" )) -+(defentry XKeyboardControl-bell_percent (fixnum) ( fixnum "XKeyboardControl_bell_percent" )) -+(defentry set-XKeyboardControl-bell_percent (fixnum fixnum) ( void "set_XKeyboardControl_bell_percent" )) -+(defentry XKeyboardControl-key_click_percent (fixnum) ( fixnum "XKeyboardControl_key_click_percent" )) -+(defentry set-XKeyboardControl-key_click_percent (fixnum fixnum) ( void "set_XKeyboardControl_key_click_percent" )) -+ -+ -+;;;;;; XKeyboardState funcions ;;;;;; -+ -+(defentry make-XKeyboardState () ( fixnum "make_XKeyboardState" )) -+(defentry XKeyboardState-auto_repeats (fixnum) ( fixnum "XKeyboardState_auto_repeats" )) -+(defentry set-XKeyboardState-auto_repeats (fixnum object) ( void "set_XKeyboardState_auto_repeats" )) -+(defentry XKeyboardState-global_auto_repeat (fixnum) ( fixnum "XKeyboardState_global_auto_repeat" )) -+(defentry set-XKeyboardState-global_auto_repeat (fixnum fixnum) ( void "set_XKeyboardState_global_auto_repeat" )) -+(defentry XKeyboardState-led_mask (fixnum) ( fixnum "XKeyboardState_led_mask" )) -+(defentry set-XKeyboardState-led_mask (fixnum fixnum) ( void "set_XKeyboardState_led_mask" )) -+(defentry XKeyboardState-bell_duration (fixnum) ( fixnum "XKeyboardState_bell_duration" )) -+(defentry set-XKeyboardState-bell_duration (fixnum fixnum) ( void "set_XKeyboardState_bell_duration" )) -+(defentry XKeyboardState-bell_pitch (fixnum) ( fixnum "XKeyboardState_bell_pitch" )) -+(defentry set-XKeyboardState-bell_pitch (fixnum fixnum) ( void "set_XKeyboardState_bell_pitch" )) -+(defentry XKeyboardState-bell_percent (fixnum) ( fixnum "XKeyboardState_bell_percent" )) -+(defentry set-XKeyboardState-bell_percent (fixnum fixnum) ( void "set_XKeyboardState_bell_percent" )) -+(defentry XKeyboardState-key_click_percent (fixnum) ( fixnum "XKeyboardState_key_click_percent" )) -+(defentry set-XKeyboardState-key_click_percent (fixnum fixnum) ( void "set_XKeyboardState_key_click_percent" )) -+ -+ -+;;;;;; XTimeCoord funcions ;;;;;; -+ -+(defentry make-XTimeCoord () ( fixnum "make_XTimeCoord" )) -+(defentry XTimeCoord-y (fixnum) ( fixnum "XTimeCoord_y" )) -+(defentry set-XTimeCoord-y (fixnum fixnum) ( void "set_XTimeCoord_y" )) -+(defentry XTimeCoord-x (fixnum) ( fixnum "XTimeCoord_x" )) -+(defentry set-XTimeCoord-x (fixnum fixnum) ( void "set_XTimeCoord_x" )) -+(defentry XTimeCoord-time (fixnum) ( fixnum "XTimeCoord_time" )) -+(defentry set-XTimeCoord-time (fixnum fixnum) ( void "set_XTimeCoord_time" )) -+ -+ -+;;;;;; XModifierKeymap funcions ;;;;;; -+ -+(defentry make-XModifierKeymap () ( fixnum "make_XModifierKeymap" )) -+(defentry XModifierKeymap-modifiermap (fixnum) ( fixnum "XModifierKeymap_modifiermap" )) -+(defentry set-XModifierKeymap-modifiermap (fixnum fixnum) ( void "set_XModifierKeymap_modifiermap" )) -+(defentry XModifierKeymap-max_keypermod (fixnum) ( fixnum "XModifierKeymap_max_keypermod" )) -+(defentry set-XModifierKeymap-max_keypermod (fixnum fixnum) ( void "set_XModifierKeymap_max_keypermod" )) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_sysinit.lsp -@@ -0,0 +1,69 @@ -+; Copyright (c) 1994 William F. Schelter -+ -+; See the files gnu.license and dec.copyright . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Some of the files that interface to the Xlib are adapted from DEC/MIT files. -+; See the file dec.copyright for details. -+ -+(in-package :XLIB) -+ -+;; This file is used for defining the C function user_init, to run the -+;; initialization code from a list of files in *files*. These files -+;; should have been compiled with (compile-file "foo.lsp" :system-p t) -+;; and have been linked into the image. It presumes the .o files -+;; are in the current directory, and the files *files* are in the proper -+;; order to be loaded. -+ -+;;define a function USER::USER-INIT, which will run the init code for a set -+;;of files which are linked into an image. -+ -+(clines "#define init_or_load(fn,file) do {extern void fn(void); gcl_init_or_load1(fn,file);} while(0)") -+(clines "static void") -+(clines "load1(char *x) {") -+(clines "printf(\"loading %s\\n\",x);") -+(clines "fflush(stdout);") -+(clines "load(x);") -+(clines "}") -+ -+#. -+(let ((files *files*)) -+ (declare (special object-path)) -+ (with-open-file (st "maxobjs" :direction :output) -+ `(progn -+ (clines "object user_init() {") -+ (clines "load1(\"../xgcl-2/sysdef.lisp\");") -+ ,@(sloop::sloop for x in files -+ for f = (substitute #\_ #\- x) -+ for ff = (namestring (merge-pathnames (make-pathname :type "o") (pathname (format nil "~a.lsp" x)))) -+ do (princ ff st) (princ " " st) -+ collect -+ `(clines ,(Format nil "init_or_load(init_~a,\"~a\");" (string-downcase f) ff)) -+ finally (terpri st) -+ )) -+ -+ )) -+ -+(clines "return Cnil;}") -+ -+;; invoke this to initialize maxima. -+ -+;; make this if you dont want the invocation done automatically. -+;(defentry user::user-init () "user_init") -+ -+ -+ -+ ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_menu-set.lsp -@@ -0,0 +1,521 @@ -+; menu-set.lsp Gordon S. Novak Jr. ; 17 Jan 08 -+ -+; Functions to handle a set of menus within a single window. -+ -+; Copyright (c) 2008 Gordon S. Novak Jr. and The University of Texas at Austin. -+ -+; See the file gnu.license . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Written by: Gordon S. Novak Jr., Department of Computer Sciences, -+; University of Texas at Austin 78712. novak@cs.utexas.edu -+ -+; 12 Aug 96; 04 Nov 97; 28 Feb 02; 05 Jan 04; 03 Mar 04; 30 Jul 04; 02 Aug 04 -+; 27 Jan 06 -+ -+; (wtesta) ; in dwtest.lsp, to create window myw -+; (setq ms (menu-set-create myw nil)) -+; (menu-set-add-menu ms 'flag1 nil "Colors" '(red white blue)) -+; position w/mouse -+; (menu-set-add-menu ms 'Test1 nil "Choice" '(yes no)) -+; position w/mouse -+; do (wteste) to create the square picmenu -+; (menu-set-add-picmenu ms 'square1 nil "Square" mypms) -+; following is alternative -- window is too small to hold both square and cone -+; create cone with draw -+; (menu-set-add-picmenu ms 'cone1 'cone "Cone" 'cone) -+; (menu-set-add-component ms 'nand) ; load draw-gates for nand and cone -+; -+; (menu-set-draw ms) -+; (menu-set-select ms) ; click a menu or background -+; (setq mc (menu-conns-create ms)) ; make a menu-conns object from menu set -+; (menu-conns-add-conn mc) ; click two buttons/menu items -+; repeat above as desired -+; (menu-conns-move mc) ; click a menu and move it -+ -+(glispobjects -+ -+(menu-set (listobject (window window) -+ (menu-items (listof menu-set-item)) -+ (commandfn anything)) -+ msg ((draw menu-set-draw) -+ (select menu-set-select) -+ (named-menu menu-set-named-menu) -+ (named-item menu-set-named-item) -+ (add-menu menu-set-add-menu) -+ (add-picmenu menu-set-add-picmenu) -+ (add-component menu-set-add-component) -+ (add-barmenu menu-set-add-barmenu) -+ (add-item menu-set-add-item) -+ (find-item menu-set-find-item) -+ (delete-item menu-set-delete-item) -+ (remove-items menu-set-remove-items) -+ (item-position menu-set-item-position) -+ (itemp menu-set-itemp) -+ (adjust menu-set-adjust) -+ (move menu-set-move) -+ (draw-conn menu-set-draw-conn) ) ) -+ -+(menu-set-item (list (menu-name symbol) -+ (sym anything) ; extra info -+ (menu menu-set-menu) ) -+ prop ((left ((parent-offset-x menu))) -+ (bottom ((parent-offset-y menu))) -+ (width ((picture-width menu))) -+ (height ((picture-height menu))) ) -+ supers (region) ) -+ -+(menu-set-menu (transparent menu) ; menu or picmenu -+ msg ((draw menu-mdraw)) ) -+ -+(menu-port (list (port symbol) (menu-name symbol)) ) -+ -+(menu-selection (list (port symbol) (menu-name symbol) (button integer)) ) -+ -+(menu-set-conn (list (from menu-port) -+ (to menu-port))) -+ -+(menu-conns (listobject (menu-set menu-set) -+ (connections (listof menu-set-conn))) -+ prop ((window ((window (menu-set self))))) -+ msg ((draw menu-conns-draw) -+ (redraw menu-conns-redraw) -+ (move menu-conns-move) -+ (add-conn menu-conns-add-conn) -+ (add-item menu-conns-add-item open t) -+ (find-conn menu-conns-find-conn) -+ (find-item menu-conns-find-item) -+ (delete-item menu-conns-delete-item) -+ (delete-conn menu-conns-delete-conn) -+ (remove-items menu-conns-remove-items) -+ (find-conns menu-conns-find-conns) -+ (connected-ports menu-conns-connected-ports) -+ (new-conn menu-conns-new-conn) -+ (named-menu menu-conns-named-menu) -+ (named-item menu-conns-named-item) ) ) -+ -+ ) ; glispobjects -+ -+; 04 Sep 92; 09 Feb 94; 12 Oct 94 -+(gldefun menu-set-create ((w window) &optional fn) -+ (a menu-set with window = w commandfn = fn)) -+ -+; 05 Sep 92; 09 Sep 92; 10 Sep 92; 02 Nov 92; 05 May 93; 07 May 93; 04 Aug 93 -+; 03 Jan 94; 07 Jan 94; 03 May 94; 05 Jan 95; 11 Apr 95; 03 Nov 97; 05 Jan 04 -+; Select from multiple menu-like regions within a window. -+; Result is a menu-selection, i.e., a list of the value selected, -+; menu name, and button used, -+; e.g., (QUIT COMMAND 1) for selecting the QUIT item from the COMMAND menu. -+; A click outside any menu returns ((x y) BACKGROUND button-code). -+; enabled, if specified, is a list of names of menus enabled for selection. -+(gldefun menu-set-select ((ms menu-set) &optional (redraw boolean) -+ (enabled (listof symbol))) -+ (result menu-selection) -+ (let ((res menu-selection) resb (itm menu-set-item) (sel symbol) lastx lasty) -+ (if redraw (draw ms)) -+ (while ~ (or res resb) -+ (setq itm (window-track-mouse (window ms) -+ #'(lambda (x y code) -+ (or (and (> code 0) -+ (setq lastx x) -+ (setq lasty y) -+ code) -+ (that menu-item with -+ (contains-xy (that menu-item) x y)))))) -+ (if (numberp itm) -+ (resb = (a menu-selection with -+ port (a vector with x = lastx y = lasty) -+ menu-name 'background -+ button itm)) -+ (if (or (atom enabled) -+ (member (menu-name itm) enabled)) -+ (progn (sel = (menu-mselect (menu itm) (eq enabled t))) -+ (if sel -+ (res = (a menu-selection with -+ menu-name (menu-name itm) -+ port sel -+ button *window-menu-code*)) -+ (if (and *window-menu-code* -+ (*window-menu-code* <> 0)) -+ (res = (a menu-selection with -+ menu-name (menu-name itm) -+ port nil -+ button *window-menu-code*)))) ) ) )) -+ (force-output (window ms)) -+ (or res resb) )) -+ -+; 05 Sep 92; 25 Sep 92; 29 Sep 92 -+; Add a menu to a menu set. -+; name is the name of the menu. sym is extra info such as data type. -+(gldefun menu-set-add-menu ((ms menu-set) (name symbol) (sym symbol) -+ (title string) items -+ &optional (offset vector)) -+ (let (menu) -+ (menu = (menu-create items title (window ms) (x offset) (y offset) t t)) -+ (init menu) -+ (if ~ offset (offset = (get-box-position (window ms) -+ (picture-width menu) -+ (picture-height menu)))) -+ ((parent-offset-x menu) = (x offset)) -+ ((parent-offset-y menu) = (y offset)) -+ (add-item ms name sym menu) )) -+ -+; 25 Sep 92; 29 Sep 92; 07 May 93 -+(gldefun menu-set-add-item ((ms menu-set) (name symbol) (sym symbol) -+ (menu menu)) -+ ((menu-items ms) _+ (a menu-set-item with menu-name = name sym = sym -+ menu = menu)) ) -+ -+; 25 Sep 92 -+(gldefun menu-set-remove-items ((ms menu-set)) -+ ((menu-items ms) = nil) ) -+ -+; 06 Sep 92; 08 Sep 92; 14 Sep 92; 25 Sep 92; 29 Sep 92; 05 Jan 04; 23 Jun 04 -+(gldefun menu-set-add-picmenu ((ms menu-set) (name symbol) (sym symbol) -+ (title string) -+ (spec picmenu-spec) -+ &optional (offset vector) -+ (nobox boolean)) -+ (let (menu maxwidth maxheight) -+ (if (and spec (symbolp spec)) -+ (spec = (get spec 'picmenu-spec)) ) -+ (menu = (picmenu-create-from-spec spec title (window ms) -+ (x offset) (y offset) t t (not nobox))) -+ (maxwidth = (max (if title ((* 9 (length title)) + 6) 0) -+ (drawing-width spec))) -+ (maxheight = (if title 15 0) + (drawing-height spec)) -+ (if ~ offset (offset = (get-box-position (window ms) maxwidth maxheight))) -+ ((parent-offset-x menu) = (x offset)) -+ ((parent-offset-y menu) = (y offset)) -+ (add-item ms name sym menu) )) -+ -+; 11 Oct 93 -+(gldefun menu-set-add-component ((ms menu-set) (name symbol) -+ &optional (offset vector)) -+ (menu-set-add-picmenu ms (menu-set-name name) name nil name offset t)) -+ -+; 03 Jan 94; 05 Jan 04 -+; Add a barmenu to a menu set. -+(gldefun menu-set-add-barmenu ((ms menu-set) (name symbol) (sym symbol) -+ (menu barmenu) -+ (title string) &optional (offset vector)) -+ (let () -+ (init menu) -+ (if ~ offset -+ (offset = (get-box-position (window ms) -+ (picture-width menu) (picture-height menu)))) -+ ((parent-offset-x menu) = (x offset)) -+ ((parent-offset-y menu) = (y offset)) -+ (add-item ms name sym menu) )) -+ -+; 11 Oct 93 -+(gldefun menu-set-name ((nm symbol)) (result symbol) -+ (intern (symbol-name (gensym (symbol-name nm)))) ) -+ -+; 29 Sep 92; 07 May 93; 28 Feb 02 -+(gldefun menu-set-named-item ((ms menu-set) (name symbol)) -+ (result menu-set-item) -+ (that menu-item with (menu-name (that menu-item)) == name) ) -+ -+; 08 Sep 92; 29 Sep 92 -+(gldefun menu-set-named-menu ((ms menu-set) (name symbol)) -+ (result menu-set-menu) -+ (menu (named-item ms name))) -+ -+; 17 Jan 08 -+(gldefun menu-set-itemp ((ms menu-set) (name symbol) (itemname symbol)) -+ (let ((thismenu (named-menu ms name))) -+ (if thismenu is a menu -+ (some #'(lambda (x) (or (eq x itemname) -+ (and (consp x) (eq (car x) itemname)))) -+ (items thismenu)) -+ (if thismenu is a picmenu -+ (assoc itemname (buttons thismenu)) ) ) )) -+ -+; 30 Jul 04 -+(gldefun menu-conns-named-item ((mc menu-conns) (name symbol)) -+ (result menu-set-item) -+ (named-item (menu-set mc) name) ) -+ -+; 01 Feb 94 -+(gldefun menu-conns-named-menu ((mc menu-conns) (name symbol)) -+ (result menu-set-menu) -+ (named-menu (menu-set mc) name) ) -+ -+; 29 Apr 93; 30 Apr 93; 05 Jan 04 -+; Find the item at specified position, if any -+(gldefun menu-set-find-item ((ms menu-set) (pos vector)) -+ (result menu-set-item) -+ (let (mitem) -+ (for mi in (menu-items ms) do -+ (if (contains? (menu mi) pos) -+ (mitem = mi))) -+ mitem)) -+ -+; 29 Apr 93 -+; Delete an item -+(gldefun menu-set-delete-item ((ms menu-set) (mi menu-set-item)) -+ ((menu-items ms) _- mi)) -+ -+; 08 Sep 92; 10 Sep 92; 05 May 93; 06 May 93; 07 May 93 -+(gldefun menu-set-move ((ms menu-set)) -+ (let (sel m) -+ (sel = (menu-set-select ms nil t)) -+ (m = (named-menu ms (menu-name sel))) -+ (menu-reposition m) )) -+ -+; 10 Sep 92; 05 Jan 94; 06 Jan 94; 20 Apr 95; 12 Aug 96 -+; Draw either a menu or picmenu -+(gldefun menu-mdraw (m) -+ (case (first m) -+ (menu (menu-draw m)) -+ (picmenu (picmenu-draw m)) -+ (barmenu (barmenu-draw m)) -+ (textmenu (textmenu-draw m)) -+ (editmenu (editmenu-draw m)) -+ (t (glsend m draw)) ) ) -+ -+; 10 Sep 92; 29 Sep 92; 05 May 93; 03 Jan 94; 06 Jan 94; 20 Apr 95; 21 Apr 95 -+; 12 Aug 96 -+; Select from either a menu or picmenu -+(gldefun menu-mselect (m &optional anyclick) -+ (case (first m) -+ (menu (menu-select m t)) -+ (picmenu (picmenu-select m t anyclick)) -+ (barmenu (barmenu-select m)) -+ (textmenu (textmenu-select m t)) -+ (editmenu (editmenu-select m t)) -+ (t (glsend m select)) ) ) -+ -+; 10 Sep 92; 06 Jan 94 -+; Get item position from either a menu or picmenu; 20 Apr 95 -+(gldefun menu-mitem-position (m name loc) -+ (case (first m) -+ (menu (menu-item-position m name loc)) -+ (picmenu (picmenu-item-position m name loc)) -+ (t (glsend m item-position name loc)) ) ) -+ -+; 05 Sep 92; 08 Sep 92 -+(gldefun menu-set-draw ((ms menu-set)) -+ (let () -+ (open (window ms)) -+ (for item in (menu-items ms) do (draw (menu item))) )) -+ -+; 08 Sep 92; 28 Sep 92; 07 May 93; 25 Jan 94 -+(gldefun menu-set-item-position ((ms menu-set) (desc menu-port) -+ &optional (loc symbol)) -+ (result vector) -+ (let (m) -+ (m = (named-menu ms (menu-name desc))) -+ (or (menu-mitem-position m (port desc) loc) -+ (menu-mitem-position m nil loc)) )) ; header if it cannot be found -+ -+; 08 Sep 92; 05 Jan 04 -+(gldefun menu-set-draw-conn ((ms menu-set) (conn menu-set-conn)) -+ (let (pa pb tmp (desca (from conn)) (descb (to conn))) -+ (pa = (menu-set-item-position ms desca 'center)) -+ (pb = (menu-set-item-position ms descb 'center)) -+ (if ((x pa) > (x pb)) -+ (progn (tmp = desca) -+ (desca = descb) -+ (descb = tmp))) -+ (pa = (menu-set-item-position ms desca 'right)) -+ (pb = (menu-set-item-position ms descb 'left)) -+ (draw-circle (window ms) pa 3) -+ (draw-line (window ms) pa pb) -+ (draw-circle (window ms) pb 3) -+ (force-output (window ms)) )) -+ -+; 02 Dec 93; 07 Jan 94; 05 Jan 04 -+(gldefun menu-set-adjust ((ms menu-set) (name symbol) (edge symbol) -+ (from symbol) (offset integer)) -+ (let (m fromm place) -+ (if (m = (named-item ms name)) -+ (progn -+ (if from -+ (progn (fromm = (named-item ms from)) -+ (place = (case edge -+ (top (bottom fromm)) -+ (bottom (top fromm)) -+ (left (right fromm)) -+ (right (left fromm))))) -+ (place = (case edge -+ (top (height (window ms))) -+ ((bottom left) 0) -+ (right (width (window ms))) )) ) -+ (case edge (top ((bottom m) = place - (height m) - offset)) -+ (bottom ((bottom m) = place + offset)) -+ (left ((left m) = place + offset)) -+ (right ((left m) = place - (width m) - offset)))) ) )) -+ -+; 21 Nov 08 -+; align the vector approx with the vector fixed if within tolerance -+(gldefun vector-snap ((fixed vector) (approx vector) -+ &optional tolerance) -+ (let () -+ (or tolerance (tolerance = 10)) -+ (if (< (abs (- (x fixed) (x approx))) tolerance) -+ (a vector x = (x fixed) y = (y approx)) -+ (if (< (abs (- (y fixed) (y approx))) tolerance) -+ (a vector x = (x approx) y = (y fixed)) -+ approx) ) )) -+ -+; 12 Oct 94; 28 Feb 02 -+(gldefun menu-conns-create ((ms menu-set)) -+ (a menu-conns with menu-set = ms)) -+ -+; 08 Sep 92 -+(gldefun menu-conns-draw ((mc menu-conns)) -+ (let () -+ (draw (menu-set mc)) -+ (for c in (connections mc) (draw-conn (menu-set mc) c)) )) -+ -+; 08 Sep 92 -+(gldefun menu-conns-move ((mc menu-conns)) -+ (let () -+ (menu-set-move (menu-set mc)) -+ (clear (window mc)) -+ (draw mc) )) -+ -+; 29 Apr 93 -+(gldefun menu-conns-redraw ((mc menu-conns)) -+ (let () -+ (clear (window mc)) -+ (draw mc) )) -+ -+; 08 Sep 92; 07 May 93; 21 Oct 93; 05 Jan 95; 28 Feb 02; 05 Jan 04 -+(gldefun menu-conns-add-conn ((mc menu-conns)) -+ (let (sel selb conn) -+ (sel = (select (menu-set mc))) -+ (if ((menu-name sel) == 'background) -+ sel -+ (progn (selb = (select (menu-set mc))) -+ (if ((menu-name selb) <> 'background) -+ (progn (conn = (a menu-set-conn with from = sel to = selb)) -+ (draw-conn (menu-set mc) conn) -+ ((connections mc) _+ conn))) -+ nil) ) )) -+ -+; 02 Aug 04 -+(gldefun menu-conns-new-conn ((mc menu-conns) (fromname symbol) -+ (fromport symbol) (toname symbol) -+ (toport symbol)) -+ (let (conn) -+ (conn = (a menu-set-conn with -+ from = (a menu-port with menu-name = fromname port = fromport) -+ to = (a menu-port with menu-name = toname port = toport))) -+ ((connections mc) _+ conn) )) -+ -+; 30 Apr 93 -+(gldefun menu-conns-add-item -+ ((mc menu-conns) (name symbol) (sym symbol) (menu menu)) -+ (add-item (menu-set mc) name sym menu)) -+ -+; 29 Apr 93; 05 Jan 04 -+; Find the connection that is selected by the given point, if any. -+(gldefun menu-conns-find-conn ((mc menu-conns) (pt vector)) -+ (result menu-set-conn) -+ (let (ms ls found res pa pb tmp desca descb) -+ (ls = (a line-segment)) -+ (ms = (menu-set mc)) -+ (for conn in (connections mc) when (not found) do -+ (desca = (from conn)) -+ (descb = (to conn)) -+ (pa = (menu-set-item-position ms desca 'center)) -+ (pb = (menu-set-item-position ms descb 'center)) -+ (if ((x pa) > (x pb)) -+ (progn (tmp = desca) -+ (desca = descb) -+ (descb = tmp))) -+ ((p1 ls) = (menu-set-item-position ms desca 'right)) -+ ((p2 ls) = (menu-set-item-position ms descb 'left)) -+ (if (< (distance ls pt) 5) -+ (progn (found = t) -+ (res = conn)) )) -+ res)) -+ -+; 29 Apr 93; 30 Apr 93 -+; Find the menu item that is selected by the given point, if any. -+(gldefun menu-conns-find-item ((mc menu-conns) (pt vector)) -+ (result menu-set-item) -+ (find-item (menu-set mc) pt)) -+ -+; 29 Apr 93 -+; Delete a connection -+(gldefun menu-conns-delete-conn ((mc menu-conns) (conn menu-set-conn)) -+ ((connections mc) _- conn)) -+ -+; 29 Apr 93; 07 May 93; 28 Feb 02; 05 Jan 04 -+; Delete a menu item and all its connections -+(gldefun menu-conns-delete-item ((mc menu-conns) (mi menu-set-item)) -+ (let (ms) -+ (ms = (menu-set mc)) -+ (delete-item ms mi) -+ (for conn in (connections mc) do -+ (if (or ((menu-name (from conn)) == (menu-name mi)) -+ ((menu-name (to conn)) == (menu-name mi))) -+ (delete-conn mc conn))) )) -+ -+; 30 Apr 93 -+(gldefun menu-conns-remove-items ((mc menu-conns)) -+ (remove-items (menu-set mc)) -+ ((connections mc) = nil)) -+ -+; 30 Apr 93; 07 May 93; 28 Feb 02; 05 Jan 04 -+; find all ports of a given named menu that are connected to something -+(gldefun menu-conns-connected-ports ((mc menu-conns) (boxname symbol)) -+ (let (ports) -+ (for conn in (connections mc) do -+ (if (boxname == (menu-name (to conn))) -+ (pushnew (port (to conn)) ports) -+ (if (boxname == (menu-name (from conn))) -+ (pushnew (port (from conn)) ports)))) -+ ports)) -+ -+; 30 Apr 93; 07 May 93; 28 Feb 02 -+; Find connections of a given port of a named box -+(gldefun menu-conns-find-conns ((mc menu-conns) (boxname symbol) (port symbol)) -+ (result (listof menu-port)) -+ (let (res) -+ (for conn in (connections mc) do -+ (if (and (boxname == (menu-name (to conn))) -+ (port == (port (to conn)))) -+ (res _+ (from conn))) -+ (if (and (boxname == (menu-name (from conn))) -+ (port == (port (from conn)))) -+ (res _+ (to conn))) ) -+ res)) -+ -+; 03 May 94 -+; Compile menu-set.lsp into a plain Lisp file -+(defun compile-menu-set () -+ (glcompfiles *directory* -+ '("glisp/vector.lsp" ; auxiliary files -+ "X/dwindow.lsp") -+ '("glisp/menu-set.lsp") ; translated files -+ "glisp/menu-settrans.lsp" ; output file -+ "glisp/menu-set-header.lsp") ; header file -+ (compile-file "glisp/menu-settrans.lsp") ) -+ -+; Compile menu-set.lsp into a plain Lisp file for XGCL distribution -+(defun compile-menu-setb () -+ (glcompfiles *directory* -+ '("glisp/vector.lsp" ; auxiliary files -+ "X/dwindow.lsp" "X/dwnoopen.lsp") -+ '("glisp/menu-set.lsp") ; translated files -+ "glisp/menu-settrans.lsp" ; output file -+ "glisp/menu-set-header.lsp") ; header file -+ ) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_X10.lsp -@@ -0,0 +1,30 @@ -+(in-package :XLIB) -+; X10.lsp modified by Hiep Huu Nguyen 27 Aug 92 -+ -+; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. -+ -+; See the files gnu.license and dec.copyright . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Some of the files that interface to the Xlib are adapted from DEC/MIT files. -+; See the file dec.copyright for details. -+ -+ -+(defconstant VertexRelative #x01 ) ;; else absolute -+(defconstant VertexDontDraw #x02 ) ;; else draw -+(defconstant VertexCurved #x04 ) ;; else straight -+(defconstant VertexStartClosed #x08 ) ;; else not -+(defconstant VertexEndClosed #x10 ) ;; else not ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_dwsyms.lsp -@@ -0,0 +1,148 @@ -+; dwsyms.lsp Gordon S. Novak Jr. 14 Mar 95 -+ -+; Copyright (c) 1995 Gordon S. Novak Jr. and The University of Texas at Austin. -+ -+; See the file gnu.license . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; This file imports symbols from the X library (in XLIB: package) -+; to the current package (such as the :USER package). -+; This will allow these symbols to be accessed by just their -+; names and without any package qualifier. -+; This file may be useful if you wish to modify dwindow.lsp or dwtrans.lsp . -+ -+; This file should be loaded immediately after starting Lisp: -+; If Lisp has seen any of these symbols, loading this file will cause an error. -+ -+(import '( -+xlib::BUTTONPRESS -+xlib::BUTTONPRESSMASK -+xlib::BUTTONRELEASEMASK -+xlib::CAPBUTT -+xlib::CWBACKINGSTORE -+xlib::CWSAVEUNDER -+xlib::EXPOSE -+xlib::EXPOSUREMASK -+xlib::GCBACKGROUND -+xlib::GCFOREGROUND -+xlib::GCFUNCTION -+xlib::GET-C-STRING -+xlib::GXCOPY -+xlib::GXXOR -+xlib::INT-ARRAY -+xlib::INT-POS -+xlib::ISUNMAPPED -+xlib::JOINMITER -+xlib::KEYPRESS -+xlib::KEYPRESSMASK -+xlib::KEYRELEASE -+xlib::KEYRELEASEMASK -+xlib::LEAVEWINDOWMASK -+xlib::LINESOLID -+xlib::MAKE-XCOLOR -+xlib::MAKE-XEVENT -+xlib::MAKE-XGCVALUES -+xlib::MAKE-XSETWINDOWATTRIBUTES -+xlib::MAKE-XSIZEHINTS -+xlib::MAKE-XWINDOWATTRIBUTES -+xlib::MOTIONNOTIFY -+xlib::NONE -+xlib::NoSymbol -+xlib::POINTERMOTIONMASK -+xlib::PPOSITION -+xlib::PSIZE -+xlib::SET-XCOLOR-BLUE -+xlib::SET-XCOLOR-GREEN -+xlib::SET-XCOLOR-RED -+xlib::SET-XSETWINDOWATTRIBUTES-BACKING_STORE -+xlib::SET-XSETWINDOWATTRIBUTES-SAVE_UNDER -+xlib::SET-XSIZEHINTS-HEIGHT -+xlib::SET-XSIZEHINTS-FLAGS -+xlib::SET-XSIZEHINTS-WIDTH -+xlib::SET-XSIZEHINTS-X -+xlib::SET-XSIZEHINTS-Y -+xlib::WHENMAPPED -+xlib::XALLOCCOLOR -+xlib::XANYEVENT-TYPE -+xlib::XANYEVENT-WINDOW -+xlib::XBLACKPIXEL -+xlib::XBUTTONEVENT-BUTTON -+xlib::XCHANGEWINDOWATTRIBUTES -+xlib::XCLEARAREA -+xlib::XCLEARWINDOW -+xlib::XCOLOR-PIXEL -+xlib::XCOPYAREA -+xlib::XCREATEFONTCURSOR -+xlib::XCREATEGC -+xlib::XCREATESIMPLEWINDOW -+xlib::XDEFAULTCOLORMAP -+xlib::XDEFAULTGC -+xlib::XDEFAULTSCREEN -+xlib::XDEFINECURSOR -+xlib::XDESTROYWINDOW -+xlib::XDRAWARC -+xlib::XDRAWIMAGESTRING -+xlib::XDRAWLINE -+xlib::XFILLRECTANGLE -+xlib::XFONTSTRUCT-FID -+xlib::XFLUSH -+xlib::XFREECOLORS -+xlib::XFREEGC -+xlib::XGCVALUES-BACKGROUND -+xlib::XGCVALUES-FOREGROUND -+xlib::XGCVALUES-FUNCTION -+xlib::XGETGCVALUES -+xlib::XGETGEOMETRY -+xlib::XGETWINDOWATTRIBUTES -+xlib::XLOADQUERYFONT -+xlib::XMAPWINDOW -+xlib::XMOTIONEVENT-X -+xlib::XMOTIONEVENT-Y -+xlib::XMOVEWINDOW -+xlib::XNEXTEVENT -+xlib::XOPENDISPLAY -+xlib::XPENDING -+xlib::XQUERYPOINTER -+xlib::XRECOLORCURSOR -+xlib::XROOTWINDOW -+xlib::XSELECTINPUT -+xlib::XSETBACKGROUND -+xlib::XSETFONT -+xlib::XSETFOREGROUND -+xlib::XSETFUNCTION -+xlib::XSETLINEATTRIBUTES -+xlib::XSETSTANDARDPROPERTIES -+xlib::XSYNC -+xlib::XTEXTEXTENTS -+xlib::XTEXTWIDTH -+xlib::XUNMAPWINDOW -+xlib::XWHITEPIXEL -+xlib::XWINDOWATTRIBUTES-MAP_STATE -+xlib::XDisplayKeycodes -+xlib::XGetKeyboardMapping -+xlib::XFree -+xlib::XK_Shift_R -+xlib::XK_Shift_L -+xlib::XK_Control_L -+xlib::XK_Control_R -+xlib::XK_Alt_R -+xlib::XK_Alt_L -+xlib::XK_Return -+xlib::XK_Tab -+xlib::XK_BackSpace -+)) -+ -+(setf (get 'xlib::int-pos 'glfnresulttype) 'integer) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_dispatch-events.lsp -@@ -0,0 +1,50 @@ -+(in-package :XLIB) -+; dispatch-events.lsp Hiep Huu Nguyen 27 Aug 92 -+ -+; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. -+ -+; See the files gnu.license and dec.copyright . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Some of the files that interface to the Xlib are adapted from DEC/MIT files. -+; See the file dec.copyright for details. -+ -+ -+;;have to make each type have it's own eventlist -+;;and eventmask -+(defun dispatch-events () -+ (setq *exit* nil) -+ (mapcar #'(lambda (x) -+ (Xsync x 1)) -+ *display-list*) -+ (do ((window nil) -+ (call-back-fn nil) -+ (type nil)) -+ (*exit*) -+ (dolist (a-display *display-list*) -+ (unless (= (XPending a-display) 0) -+ (XNextEvent a-display *default-event*) -+ (setq type (XAnyEvent-type *default-event*)) -+ (setq window -+ (gethash (XAnyEvent-window *default-event*) -+ *window-table*)) -+ (setq call-back-fns -+ (rest (assoc type (slot-value window 'eventlist)))) -+ (if call-back-fns -+ (dolist (call-back-fn call-back-fns) -+ (eval `(,call-back-fn ',window)))))))) -+ -+ ---- gcl-2.6.7.orig/xgcl-2/general-c.c -+++ gcl-2.6.7/xgcl-2/general-c.c -@@ -1,5 +1,5 @@ --/* general-c.c Hiep Huu Nguyen 27 Aug 92 */ -- -+/* general-c.c Hiep Huu Nguyen 24 Jun 06 */ -+/* 27 Aug 92; 24 Jan 06; 22 Jun 06 */ - /* ; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. - - ; See the files gnu.license and dec.copyright . -@@ -21,101 +21,45 @@ - ; Some of the files that interface to the Xlib are adapted from DEC/MIT files. - ; See the file dec.copyright for details. */ - --#include --#include --#include --#include --#include -- -- --int char_array(size) --int size; --{ -- return ((int) calloc (size, sizeof(char))); --} -- --char char_pos (array, pos) --char* array; --int pos; --{ -- return (array[pos]); --} -- -+/* 24 Jan 06: edited by G. Novak to remove vertex_array functions, -+ remove includes, change function arg lists to new form */ -+/* 22 Jun 06: edited by G. Novak to be compatible with 64-bit machines */ - --int int_array(size) --int size; --{ -- return ((int) calloc (size, sizeof(int))); -+#include -+#define fixnum long -+fixnum char_array(int size) { -+ return ((fixnum) calloc (size, sizeof(char))); - } - -- -- --int int_pos (array, pos) --int* array; --int pos; --{ -+char char_pos (char* array, int pos) { - return (array[pos]); - } - -- --void set_char_array (array, pos, val) --char* array; --int pos; --char val; --{ --array[pos] = val; -+void set_char_array (char* array, int pos, char val) { -+ array[pos] = val; - } - --void set_int_array (array, pos, val) --int* array; --int pos; --int val; --{ --array[pos] = val; -+fixnum int_array(int size) { -+ return ((fixnum) calloc (size, sizeof(int))); - } - -- -- -- --int vertex_array (size) --int size; --{ -- return ((int) calloc (size, sizeof(Vertex))); -- -+int int_pos (int* array, int pos) { -+ return (array[pos]); - } - --int vertex_pos_x (array, pos) --Vertex* array; --int pos; --{ -- return ((int) array[pos].x); -+void set_int_array (int* array, int pos, int val) { -+ array[pos] = val; - } - --int vertex_pos_y (array, pos) --Vertex* array; --int pos; --{ -- return ((int) array[pos].y); -+fixnum fixnum_array(int size) { -+ return ((fixnum) calloc (size, sizeof(fixnum))); - } - --int vertex_pos_flag (array, pos) --Vertex* array; --int pos; --{ -- return ((int) array[pos].flags); -+fixnum fixnum_pos (fixnum* array, int pos) { -+ return (array[pos]); - } - -- -- -- --void set_vertex_array (array, pos, x, y, flag) --Vertex* array; --int pos; --int x, y; --int flag; --{ -- array[pos].x = x; -- array[pos].y = y; -- array[pos].flags = flag; -- -+void set_fixnum_array (fixnum* array, int pos, fixnum val) { -+ array[pos] = val; - } -+ ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_dwimportsb.lsp -@@ -0,0 +1,76 @@ -+; dwimportsb.lsp Gordon S. Novak Jr. 11 Sep 06 -+ -+; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. -+ -+; This file imports symbols of the XGCL package; these symbols may be -+; needed by a hard-core user of the Xlib functions. -+ -+; See the file gnu.license . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; This file imports symbols from the dwindow.lsp file (in XLIB: package) -+; to the current package (such as the :USER package). -+; This will allow the dwindow.lsp functions to be called by just their -+; names and without any package qualifier. -+ -+; This file should be loaded immediately after starting Lisp: -+; If Lisp has seen any of these symbols, loading this file will cause an error. -+ -+(dolist (x '(xlib::XRecolorCursor -+xlib::XFlush xlib::XUnMapWindow xlib::XClearWindow xlib::XMapWindow -+xlib::XTextWidth xlib::XOpenDisplay xlib::XdefaultScreen xlib::XRootWindow -+xlib::XBlackPixel xlib::XWhitePixel xlib::XDefaultGC xlib::XDefaultColormap -+xlib::make-XsetWindowAttributes xlib::set-XsetWindowAttributes-backing_store -+xlib::set-XsetWindowAttributes-save_under xlib::make-XWindowAttributes -+xlib::make-XsizeHints xlib::make-XEvent xlib::make-XGCValues -+xlib::XQueryPointer xlib::XCreateSimpleWindow xlib::XsetStandardProperties -+xlib::XCreateGC xlib::CWSaveUnder xlib::CWBackingStore -+xlib::XloadQueryFont xlib::XsetFont xlib::XGetGCValues -+xlib::XGCValues-foreground xlib::XsetForeground xlib::XGCValues-Background -+xlib::XsetBackground xlib::XGCValues-function xlib::XCreateFontCursor -+xlib::XDefineCursor xlib::XGetGeometry -+xlib::Xsync xlib::XsetFunction xlib::GXxor xlib::GXcopy -+xlib::XsetLineAttributes xlib::LineSolid xlib::CapButt xlib::JoinMiter -+xlib::XDrawLine xlib::XdrawArc xlib::XClearArea xlib::XCopyArea -+xlib::XFillRectangle xlib::XdrawImageString xlib::XTextExtents -+xlib::XDestroyWindow xlib::XFreeGC xlib::XMoveWindow xlib::Xsync -+xlib::Xselectinput xlib::ButtonPressMask xlib::PointerMotionMask -+xlib::XNextEvent xlib::XAnyEvent-type xlib::XAnyEvent-window -+xlib::MotionNotify xlib::ButtonPress -+xlib::XMotionEvent-x xlib::XMotionEvent-y xlib::XButtonEvent-button -+xlib::XAnyEvent-window -+xlib::XButtonEvent-button xlib::XWindowAttributes-map_state -+xlib::ISUnmapped xlib::XPending -+xlib::Expose xlib::XAllocColor xlib::XColor-Pixel xlib::XFreeColors -+xlib::KeyPressMask xlib::KeyReleaseMask xlib::KeyRelease -+xlib::KeyPress xlib::ButtonPress xlib::XDisplayKeycodes -+xlib::XGetKeyboardMapping -+xlib::XFree xlib::XK_Shift_R xlib::XK_Shift_L xlib::XK_Control_L -+xlib::XK_Control_R xlib::XK_Alt_R xlib::XK_Alt_L xlib::XK_Return -+xlib::XK_Tab xlib::XK_BackSpace xlib::get-c-string xlib::int-pos -+xlib::fixnum-array xlib::int-array xlib::fixnum-pos -+xlib::set-xsizehints-x xlib::set-xsizehints-y xlib::set-xsizehints-width -+xlib::set-xsizehints-height xlib::set-xsizehints-flags xlib::set-foreground -+xlib::set-background xlib::set-font -+xlib::set-cursor xlib::set-line-width xlib::set-line-attr -+xlib::set-Xcolor-red xlib::set-Xcolor-green xlib::set-Xcolor-blue -+xlib::WhenMapped xlib::Psize xlib::Pposition xlib::CWSaveUnder -+xlib::CWBackingStore xlib::NoSymbol -+xlib::leavewindowmask xlib::buttonreleasemask xlib::exposuremask -+xlib::GCForeground xlib::GCBackground xlib::GCFunction -+xlib::None xlib::Xfontstruct-fid xlib::XChangeWindowAttributes -+xlib::XGetWindowAttributes lisp::null xlib::Make-Xcolor -+ )) (import x) ) ---- gcl-2.6.7.orig/xgcl-2/dwdoc.tex -+++ gcl-2.6.7/xgcl-2/dwdoc.tex -@@ -1,5 +1,5 @@ - % dwdoc.tex Gordon S. Novak Jr. --% 08 Oct 92; 08 Oct 93; 16 Nov 94; 05 Jan 95 -+% 08 Oct 92; 08 Oct 93; 16 Nov 94; 05 Jan 95; 25 Jan 06; 26 Jan 06; 08 Dec 08 - - \documentstyle[12pt]{article} - \setlength{\oddsidemargin}{0 in} -@@ -12,17 +12,21 @@ - - \begin{document} - --\begin{center}\Large{{\bf Interface from GCL to X Windows}} \\ -+\Large -+\begin{center} {\bf Interface from GCL to X Windows} \\ \end{center} -+ -+\normalsize - - \vspace*{0.1in} - -+\begin{center} - \large{Gordon S. Novak Jr. \\ - Department of Computer Sciences \\ - University of Texas at Austin \\ - Austin, TX 78712} \\ - \end{center} - --Software copyright \copyright 1994 by Gordon S. Novak Jr. and -+Software copyright \copyright \/ by Gordon S. Novak Jr. and - The University of Texas at Austin. Distribution and use are allowed - under the Gnu Public License. Also see the copyright section at the end - of this document for the copyright on X Consortium software. -@@ -33,7 +37,7 @@ of this document for the copyright on X - - This document describes a relatively easy-to-use interface between - XGCL (X version of Gnu Common Lisp) and X windows. The interface --consists of two parts: -+consists of several parts: - \begin{enumerate} - \item Hiep Huu Nguyen has written (and adapted from X Consortium software) - an interface between GCL and Xlib, the X library in C. -@@ -44,6 +48,9 @@ the {\tt dwindow} functions can be exami - - \item The {\tt dwindow} functions described in this document, which call - the Xlib functions and provide an easier interface for Lisp programs. -+ -+\item It is possible to make an interactive graphical interface -+within a web page; this is described in a section below. - \end{enumerate} - The source file for the interface (written in GLISP) is - {\tt dwindow.lsp}; this file is compiled into a file in plain Lisp, -@@ -62,8 +69,8 @@ The type {\tt vector} is a list {\tt (x - ({\tt window} is a Lisp data structure used by the {\tt dwindow} functions). - - Both the Xlib and {\tt dwindow} functions are in the package {\tt xlib:}. --The file {\tt imports.lsp} may be used to import the {\tt dwindow} symbols --to the {\tt :user} package. -+In order to use these functions, the Lisp command {\tt (use-package 'xlib)} -+should be used to import the {\tt dwindow} symbols. - - - \section{Examples and Utilities} -@@ -93,6 +100,16 @@ recreate the drawing; use {\tt origin to - {\tt (draw-out file names)} will write definitions of drawings in the - list {\tt names} to the file {\tt file}. - -+\subsection{{\tt editors}} -+ -+The file {\tt editorstrans.lsp} contains some interactive editing programs; -+it is a translation of the file {\tt editors.lsp} . -+One useful editor is the color editor; after entering {\tt (wtesta)} -+(in file {\tt dwtest.lsp}), enter {\tt (edit-color myw)} to edit a -+color. The result is an {\tt rgb} list as used in {\tt window-set-color}. -+ -+A simple line editor and an Emacs-like text editor are described in sections -+\ref{texted} and \ref{emacsed} below. - - \section{Menus} - -@@ -227,10 +244,10 @@ The remaining arguments are as described - Each of the {\tt buttons} in a picmenu is a list: \\ - - \vspace{-0.1in} --{\tt \hspace*{0.5in} (name offset size highlightfn unhighlightfn)} \\ -+{\tt \hspace*{0.5in} (buttonname offset size highlightfn unhighlightfn)} \\ - - \vspace{-0.1in} --{\tt name} is the name of the button; it is the value returned when that -+{\tt buttonname} is the name of the button; it is the value returned when that - button is selected. - {\tt offset} is a vector {\tt (x y)} that gives the offset of the center - of the button from the lower-left corner of the picture. -@@ -535,11 +552,15 @@ The color of the foreground (things that - characters) is set by: - - {\tt \hspace*{0.5in} (window-set-color w rgb \&optional background)} \\ -+{\tt \hspace*{0.5in} (window-set-color-rgb w r g b \&optional background)} \\ - - {\tt rgb} is a list {\tt (red green blue)} of 16-bit unsigned integers in - the range {\tt 0} to {\tt 65535}. {\tt background} is non-{\tt nil} - to set the background color rather than the foreground color. - -+{\tt \hspace*{0.5in} (window-reset-color w)} \\ -+{\tt window-reset-color} resets a window's colors to the default values. -+ - Colors are a scarce resource; there is only a finite number of - available colors, such as 256 colors. If you only use a small, fixed set - of colors, the finite set of colors will not be a problem. However, -@@ -556,7 +577,7 @@ the color after it is no longer needed. - {\tt *window-xcolor*}, or the specified color. - - --\subsection{Character Input} -+\subsection{Character Input} \label{texted} - - Characters can be input within a window by the call: - -@@ -572,6 +593,27 @@ including those from the initial string - {\tt size} (default 100) is erased to the right of the initial caret. - - -+\subsection{Emacs-like Editing} \label{emacsed} -+ -+{\tt window-edit} allows editing of text using an Emacs-subset editor. -+Only a few simple Emacs commands are implemented. -+\begin{verbatim} -+ (window-edit w x y width height &optional strings boxflg scroll endp) -+\end{verbatim} -+{\tt x y width height} specify the offset and size of the editing -+area; it is a good idea to draw a box around this area first. -+{\tt strings} is an initial list of strings; the return value is a list -+of strings. -+{\tt scroll} is number of lines to scroll down before displaying text, -+ or {\tt T} to have one line only and terminate on return. -+{\tt endp} is {\tt T} to begin editing at the end of the first line. -+Example: -+\begin{verbatim} -+ (window-draw-box-xy myw 48 48 204 204) -+ (window-edit myw 50 50 200 200 '("Now is the time" "for all" "good")) -+\end{verbatim} -+ -+ - \section{Mouse Interaction} - - {\tt \hspace*{0.5in} (window-get-point w)} \\ -@@ -676,7 +718,7 @@ the implementation of menus and the mous - this section. - - {\tt \hspace*{0.5in} (window-track-mouse w fn \&optional outflg)} -- -+ - \vspace{-0.05in} - Each time the mouse position changes or a mouse button is pressed, - the function {\tt fn} is called with -@@ -703,6 +745,22 @@ should be used with care; it can destroy - processes associated with the window to be destroyed. It is useful - primarily in debugging, to get rid of a window that is left on the screen - due to an error. -+ -+ -+\section{Examples} -+ -+Several interactive programs using this software for their graphical -+interface can be found at {\tt http://www.cs.utexas.edu/users/novak/} -+under the heading Software Demos. -+ -+ -+\section{Web Interface} -+ -+This software allows a Lisp program to be used interactively within -+a web page. There are two approaches, either using an X server on -+the computer of the person viewing the web page, or using WeirdX, a -+Java program that emulates an X server. Details can be found at: -+{\tt http://www.cs.utexas.edu/users/novak/dwindow.html} - - - \section{Files} -@@ -713,13 +771,19 @@ due to an error. - {\tt drawtrans.lsp} & {\tt draw.lsp} translated into plain Lisp \\ - {\tt draw-gates.lsp} & Code to draw {\tt nand} gates etc. \\ - {\tt dwdoc.tex} & \LaTeX \ source for this document \\ -+{\tt dwexports.lsp} & exported symbols \\ -+{\tt dwimportsb.lsp} & imported symbols \\ - {\tt dwindow.lsp} & GLISP source code for {\tt dwindow} functions \\ - {\tt dwtest.lsp} & Examples of use of {\tt dwindow} functions \\ - {\tt dwtrans.lsp} & {\tt dwindow.lsp} translated into plain Lisp \\ -+{\tt editors.lsp} & Editors for colors etc. \\ -+{\tt editorstrans.lsp} & translation of {\tt editors.lsp} \\ - {\tt gnu.license} & GNU General Public License \\ - {\tt ice-cream.lsp} & Drawing of an ice cream cone made with {\tt draw} \\ --{\tt imports.lsp} & file to import symbols to {\tt :user} package \\ -+{\tt lispserver.lsp} & Example web demo: a Lisp server \\ -+{\tt lispservertrans.lsp} & translation of {\tt lispserver.lsp} \\ - {\tt menu-set.lsp} & GLISP source code for menu-set functions \\ -+{\tt menu-settrans.lsp} & translation of {\tt menu-set.lsp} \\ - {\tt pcalc.lsp} & Pocket calculator implemented as a {\tt picmenu} \\ - \end{tabular} - -@@ -786,7 +850,7 @@ due to an error. - \vspace*{-.2in} - - \begin{verbatim} --(picmenu-button (list (name symbol) -+(picmenu-button (list (buttonname symbol) - (offset vector) - (size vector) - (highlightfn anything) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_Xakcl.example.lsp -@@ -0,0 +1,326 @@ -+(in-package :XLIB) -+; Xakcl.example.lsp Hiep Huu Nguyen 27 Aug 92 -+ -+; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. -+ -+; See the files gnu.license and dec.copyright . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Some of the files that interface to the Xlib are adapted from DEC/MIT files. -+; See the file dec.copyright for details. -+ -+;;;;;;;;;;;;;;;;;;;;;; -+;;this is an example of getting a geometry feature of a drawable there -+;;is also XGetWindowAttributes for just windows. See reference manual -+;;on X lib. it is probably more efficient to use XGetGeometry function -+;;once when a lot of geometry information is needed since, XGetGeometry -+;;returns many values. also as can be noticed, XGetGeometry needs C -+;;Pointers, so it is best to allocate these pointers as globals so that -+;;they won't have to be created and destroyed all the time, taking time -+;;and fragmenting memory -+ -+(defun drawable-height (a-drawable &key (display *default-display*)) -+ (XGetGeometry display a-drawable *root-return* *x-return* *y-return* *width-return* -+ *height-return* *border-width-return* *depth-return*) -+ (int-pos *height-return* 0)) -+ -+ -+ -+;;;;;;;;;;;;;;;;;;;;;; -+;;this function is a simple application of line drawing. it uses the -+;;drawable-height function and the default globals like -+;;*default-display* and *default-GC* -+ -+(defun graph-x-y (info &key (test #'first) (scale 10) (displ 0) (invert t)) -+ -+ (let* ((info (sort info #'< :key test)) -+ (first-x-y (first info)) -+ (prev-x (* (first first-x-y) scale)) -+ (mid-height ( / (drawable-height a-window) 2)) -+ (prev-y (if invert -+ (- mid-height (* (+ (second first-x-y) displ) scale)) -+ (* (+ (second first-x-y) displ) scale)))) -+ (print info) -+ (dolist (next-x-y (rest info)) -+ (let ((pres-x (* (first next-x-y) scale)) -+ (pres-y (if invert -+ (- mid-height (* (+ (second next-x-y) displ) scale)) -+ (* (+ (second next-x-y) displ) scale)))) -+ -+ ;; (format t "~%prev-x : ~a prev-y: ~a pres-x: ~a pres-y: ~a" prev-x prev-y pres-x pres-y) -+ (Xdrawline *default-display* a-window *default-GC* -+ prev-x prev-y pres-x pres-y) -+ (Xflush *default-display*) -+ (setq prev-x pres-x) -+ (setq prev-y pres-y))))) -+ -+ -+ -+;;;;;;;;;;;;;;;;;;;;;; -+;; here's an example of getting values stored in a certain GC -+;; the structure XGCValues contain values for a GC -+(defun get-foreground-of-gc (display GC) -+ (XGetGCValues display GC (+ GCForeground) *GC-Values*) -+ (XGCValues-foreground *GC-Values*)) -+ -+ -+;;;;;;;;;;;;;;;;;;;;;; -+;;this is an example of changing the graphics context and allocating a -+;;color for drawing. this is also an example of setting the line -+;;attributes this function changes the graphics context so becareful. -+;;also notice that c-types Xcolor is created and freed. again it is -+;;possible to make them global, because they could be used often. this -+;;function was fixed to have no side effects. Side effects are a danger -+;;with passing C structures. the structures could be changed as a side -+;;effect if you're not careful -+ -+(defun my-draw-line (&key (display *default-display*) (GC *default-GC*) x1 y1 x2 y2 (width 0) (color "BLACK") -+ (line-style LineSolid) (cap-style CapRound) (join-style JoinRound) (colormap *default-colormap*) -+ window) -+ -+ (let ((pixel-xcolor (make-Xcolor)) -+ (exact-rgb (make-Xcolor)) -+ (prev-fore-pixel (get-foreground-of-gc display GC))) -+ (XSetLineAttributes display GC width line-style cap-style join-style) -+ (XAllocNamedColor display colormap (get-c-string color) pixel-xcolor exact-rgb) -+ (Xsetforeground display GC (Xcolor-pixel pixel-xcolor)) -+ (XDrawLine display window GC x1 y1 x2 y2) -+ (Xflush display) -+ (free pixel-xcolor) -+ (free exact-rgb) -+ (XSetForeground display GC prev-fore-pixel))) -+ -+ -+ -+(defun colors () -+ (let ((pixel-xcolor (make-Xcolor)) -+ (y 0) -+ (r 0) -+ (b 0) -+ (g 0)) -+ (dotimes (g 65535) -+;; (format t "~% ~a ~a ~a" r b g) -+ (set-Xcolor-red pixel-xcolor r) -+ (set-Xcolor-blue pixel-xcolor b) -+ (set-Xcolor-green pixel-xcolor g) -+ (if (not (eql 0 (XallocColor *default-display* *default-colormap* pixel-xcolor))) -+ (progn (Xsetforeground *default-display* *default-GC* (Xcolor-pixel pixel-xcolor)) -+ (XDrawLine *default-display* a-window *default-GC* 0 0 200 y) -+ (Xflush *default-display*) -+ (incf y 1)) -+ ;; (format t "~%error in reading color") -+ )))) -+ -+ -+(defun return-r-b-g (color &key (display *default-display*) (GC *default-GC*) (colormap *default-colormap*) -+ ) -+ (let ((pixel-xcolor (make-Xcolor)) -+ (exact-rgb (make-Xcolor))) -+ (XAllocNamedColor display colormap (get-c-string color) pixel-xcolor pixel-xcolor) -+ (format t "~% red: ~a blue: ~a green: ~a" (Xcolor-red pixel-xcolor) -+ (Xcolor-blue pixel-xcolor) (Xcolor-green pixel-xcolor)))) -+ -+;;;;;;;;;;;;;;;;;;;;;; -+;;this function tracks the mouse. when the mouse button is pressed a -+;;line is drawn from the previous position to the current position. -+;;this funciton also shows a way of handling exposure events. the -+;;positions are remebered in order to redraw the contents of the window -+;;when it is exposed. this function handles events in two windows, the -+;;quit window and the draw window. there is an example of setting the -+;;input for a window. the draw window can have button press events, -+;;pointer motion events and exposure events, while the quit window -+;;(button) only needs button press events, and exposure events. notice -+;;that the event queue is actually flushed at the beginng of the -+;;functions. There is also an example of drawing and inverting text. -+;;and handling sub windows. the sub windows are destroyed at the end of -+;;the function. -+ -+(defun track-mouse (a-window) -+ (Xsync *default-display* 1) ;; this clears the event queue so that previous -+ ;; motion events won't show up -+ (XClearWindow *default-display* a-window) -+ -+ ;; create two sub window -+ -+ (let ((quit-window (XCreateSimpleWindow -+ *default-display* a-window -+ 2 2 50 20 1 *black-pixel* *white-pixel*)) -+ (draw-window (XCreateSimpleWindow -+ *default-display* a-window -+ 2 32 220 350 1 *black-pixel* *white-pixel*))) -+ (Xselectinput *default-display* quit-window (+ ButtonpressMask ExposureMask)) -+ (Xselectinput *default-display* draw-window -+ (+ ButtonpressMask PointerMotionMask ExposureMask)) -+ -+ (XMapWindow *default-display* quit-window) -+ (XMapWindow *default-display* draw-window) -+ (Xflush *default-display* ) -+ (XDrawString *default-display* quit-window *default-GC* 10 15 (get-c-string "Quit") 4) -+ (Xflush *default-display* ) -+ (do ((exit nil) -+ (lines-list nil) -+ (prev-x nil) -+ (prev-y nil)) -+ (exit) -+ (XNextEvent *default-display* *default-event*) -+ (let ((type (XAnyEvent-type *default-event*)) -+ (active-window (XAnyevent-window *default-event*))) -+ (cond ((eql draw-window active-window) -+ (cond -+;;; draw a line -+ ((eql type ButtonPress) -+ (let ((x (XButtonEvent-x *default-event*)) -+ (y (XButtonEvent-y *default-event*))) -+ (if prev-x -+ (XDrawLine *default-display* draw-window *default-GC* prev-x prev-y x y)) -+ (setq prev-x x) -+ (setq prev-y y) -+ (push (list x y) lines-list))) -+;;; track the mouse -+ ((eql type MotionNotify) -+ (let ((x (XMotionEvent-x *default-event*)) -+ (y (XMotionEvent-y *default-event*)) -+ (time (XmotionEvent-time *default-event*))) -+ ;;trace the mouse -+ ;;(format t "~% pos-x: ~a pos-y: ~a" x y) -+ ;;(format t "~%time: ~a" time) -+ )) -+ -+;;;; redraw window after expose event -+ -+ ((eql type Expose) -+ (let* ((first-xy (first lines-list)) -+ (prev-x (first first-xy)) -+ (prev-y (second first-xy))) -+ (dolist (an-xy (rest lines-list)) -+ (let ((x (first an-xy)) -+ (y (second an-xy))) -+ (XDrawLine *default-display* draw-window *default-GC* prev-x prev-y x y) -+ (setq prev-x x) -+ (setq prev-y y))))))) -+ -+ ;; exit if the quit button is pressed -+ -+ ((eql quit-window active-window) -+ (cond ((eql type ButtonPress) -+ (setq exit t) -+ (XSetForeground *default-display* -+ *default-GC* *white-pixel*) -+ (XSetBackground *default-display* -+ *default-GC* *black-pixel*) -+ (XDrawImageString *default-display* quit-window *default-GC* 10 15 (get-c-string "Quit") 4) -+ (Xflush *default-display*) -+ -+;;the drawing goes so fast that you can't see the text invert, so the -+;;function wiats for for about .2 seconds. but it would be better to -+;;keep the text inverted until the button is released this is done by -+;;setting the quit window to have buton release events as well and -+;;handling it appropriately -+ -+ (dotimes (i 1500)) -+ -+ -+ (XSetForeground *default-display* -+ *default-GC* *black-pixel*) -+ (XSetBackground *default-display* -+ *default-GC* *white-pixel*) -+ (XDrawImageString *default-display* quit-window *default-GC* 10 15 (get-c-string "Quit") 4) -+ (Xflush *default-display*)) -+ -+;; do quit window expose event -+ ((eql type Expose) -+ (XDrawString *default-display* quit-window *default-GC* 10 15 (get-c-string "Quit") 4))))))) -+ (XDestroySubWindows *default-display* a-window) -+ (Xflush *default-display*))) -+ -+ -+;;;;;;;;;;;;;;;;;;;;;; -+;;this function demonstrtes using different fonts of text -+ -+(defun basic-text (a-window &key (display *default-display*) (GC *default-GC* )) -+ (my-load-font "9x15" :display display :GC GC) -+ (Xdrawstring display a-window GC 50 100 (get-c-string "hello") 5) -+ (my-load-font "*-*-courier-bold-r-*-*-12-*-*-*-*-*-iso8859-1" :display display :GC GC) -+ (Xdrawstring display a-window GC 50 150 (get-c-string "hello") 5) -+ (Xflush display)) -+ -+ -+;;;;;;;;;;;;;;;;;;;;;; -+;;this function demonstartes getting different fonts and setting them in a GC -+ -+(defun my-load-font (a-string &key (display *default-display*) (GC *default-GC* )) -+ (let ((font-info (XloadQueryFont display (get-c-string a-string)))) -+ (if (not (eql 0 font-info)) -+ (XsetFont display GC (Xfontstruct-fid font-info)) -+ (format t "~%can't open font ~a" a-string)))) -+ -+ -+;;;;;;;;;;;;;;;;;;;;;; -+;;this function draws a ghst line by setting the X function to GXXor. and the -+;;foreground color to th logxor of the back and foreground pixel -+;;this function actually changes the graphics context. and does not change it back -+;;to use the ghost method and switch back to regular drawing. set the funciton -+;;back to GXcopy and the foregorund pixel appropriately -+ -+(defun do-ghost-line-1 (a-window) -+ (Xsync *default-display* 1);; this clears the event queue so that previous -+ ;; motion events won't show up -+ (XClearWindow *default-display* a-window) -+ -+ (XdrawRectangle *default-display* a-window *default-GC* -+ 0 0 100 100) -+ (Xdrawarc *default-display* a-window *default-GC* 100 200 100 100 0 (* 360 64)) -+ -+ (Xsetfunction *default-display* *default-GC* GXxor) -+ (Xsetforeground *default-display* *default-GC* (logxor *black-pixel* *white-pixel*)) -+ (Xselectinput *default-display* a-window PointerMotionMask ) -+ (do ((exit nil) -+ (prev-x 0) -+ (prev-y 0)) -+ (exit) -+ (XNextEvent *default-display* *default-event*) -+ (let ((type (XAnyEvent-type *default-event*))) -+ (cond -+ -+ ;;draw ghost line -+ ((eql type MotionNotify) -+ (let ((x (XMotionEvent-x *default-event*)) -+ (y (XMotionEvent-y *default-event*)) -+ (time (XmotionEvent-time *default-event*))) -+ (Xdrawline *default-display* a-window *default-GC* 0 0 prev-x prev-y) -+ (Xdrawline *default-display* a-window *default-GC* 0 0 x y) -+ (setq prev-x x) -+ (setq prev-y y) -+ )))))) -+ -+ -+ -+ -+ -+ ;;example of a circle -+ ;;position 100 100 diameter 100 -+ -+ ;;(XdrawArc *default-display* a-window *default-GC* 100 100 100 100 0 (* 360 64)) -+ -+ ;;example of font -+ -+ ;;(XloadFont *default-display* (get-c-string "8x10")) -+ -+ -+ -+ ;; set a pixel -+ -+ ;;(XallocNamedColor *default-display* *default-colormap* (get-c-string "aquamarine") a b) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_drawtrans.lsp -@@ -0,0 +1,1890 @@ -+; 07 Jan 2010 16:40:19 EST -+; drawtrans.lsp -- translation of draw.lsp Gordon S. Novak Jr. -+ -+; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. -+ -+; This program 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 program 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 program; if not, write to the Free Software -+; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -+ -+; Written by: Gordon S. Novak Jr., Department of Computer Sciences, -+; University of Texas at Austin 78712. novak@cs.utexas.edu -+ -+(IN-PACKAGE :USER) -+ -+(defmacro while (test &rest forms) `(loop (unless ,test (return)) ,@forms) ) -+ -+(defmacro nconc1 (lst x) `(nconc ,lst (cons ,x nil))) -+ -+(defmacro glmethod (class selector) -+ `(cadr (assoc ,selector (getf (cdr (get ,class 'glstructure)) 'msg))) ) -+ -+(SETF (GET 'MENU-SET 'GLSTRUCTURE) -+ '((LISTOBJECT (WINDOW WINDOW) (MENU-ITEMS (LISTOF MENU-SET-ITEM)) -+ (COMMANDFN ANYTHING)) -+ MSG -+ ((DRAW MENU-SET-DRAW) (SELECT MENU-SET-SELECT) -+ (NAMED-MENU MENU-SET-NAMED-MENU) -+ (NAMED-ITEM MENU-SET-NAMED-ITEM) (ADD-MENU MENU-SET-ADD-MENU) -+ (ADD-PICMENU MENU-SET-ADD-PICMENU) -+ (ADD-COMPONENT MENU-SET-ADD-COMPONENT) -+ (ADD-BARMENU MENU-SET-ADD-BARMENU) -+ (ADD-ITEM MENU-SET-ADD-ITEM) (FIND-ITEM MENU-SET-FIND-ITEM) -+ (DELETE-ITEM MENU-SET-DELETE-ITEM) -+ (REMOVE-ITEMS MENU-SET-REMOVE-ITEMS) -+ (ITEM-POSITION MENU-SET-ITEM-POSITION) (ITEMP MENU-SET-ITEMP) -+ (ADJUST MENU-SET-ADJUST) (MOVE MENU-SET-MOVE) -+ (DRAW-CONN MENU-SET-DRAW-CONN)))) -+(SETF (GET 'MENU-SET-ITEM 'GLSTRUCTURE) -+ '((LIST (MENU-NAME SYMBOL) (SYM ANYTHING) (MENU MENU-SET-MENU)) -+ PROP -+ ((LEFT ((PARENT-OFFSET-X MENU))) -+ (BOTTOM ((PARENT-OFFSET-Y MENU))) -+ (WIDTH ((PICTURE-WIDTH MENU))) -+ (HEIGHT ((PICTURE-HEIGHT MENU)))) -+ SUPERS (REGION))) -+(SETF (GET 'MENU-SET-MENU 'GLSTRUCTURE) -+ '((TRANSPARENT MENU) MSG ((DRAW MENU-MDRAW)))) -+(SETF (GET 'MENU-PORT 'GLSTRUCTURE) -+ '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL)))) -+(SETF (GET 'MENU-SELECTION 'GLSTRUCTURE) -+ '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL) (BUTTON INTEGER)))) -+(SETF (GET 'MENU-SET-CONN 'GLSTRUCTURE) -+ '((LIST (FROM MENU-PORT) (TO MENU-PORT)))) -+(SETF (GET 'MENU-CONNS 'GLSTRUCTURE) -+ '((LISTOBJECT (MENU-SET MENU-SET) -+ (CONNECTIONS (LISTOF MENU-SET-CONN))) -+ PROP ((WINDOW ((WINDOW (MENU-SET SELF))))) MSG -+ ((DRAW MENU-CONNS-DRAW) (REDRAW MENU-CONNS-REDRAW) -+ (MOVE MENU-CONNS-MOVE) (ADD-CONN MENU-CONNS-ADD-CONN) -+ (ADD-ITEM MENU-CONNS-ADD-ITEM OPEN T) -+ (FIND-CONN MENU-CONNS-FIND-CONN) -+ (FIND-ITEM MENU-CONNS-FIND-ITEM) -+ (DELETE-ITEM MENU-CONNS-DELETE-ITEM) -+ (DELETE-CONN MENU-CONNS-DELETE-CONN) -+ (REMOVE-ITEMS MENU-CONNS-REMOVE-ITEMS) -+ (FIND-CONNS MENU-CONNS-FIND-CONNS) -+ (CONNECTED-PORTS MENU-CONNS-CONNECTED-PORTS) -+ (NEW-CONN MENU-CONNS-NEW-CONN) -+ (NAMED-MENU MENU-CONNS-NAMED-MENU) -+ (NAMED-ITEM MENU-CONNS-NAMED-ITEM)))) -+ -+ -+(DEFUN MENU-SET-CREATE (W &OPTIONAL FN) (LIST 'MENU-SET W NIL FN)) -+(SETF (GET 'MENU-SET-CREATE 'GLARGUMENTS) -+ '((W WINDOW) (&OPTIONAL NIL))) -+(SETF (GET 'MENU-SET-CREATE 'GLFNRESULTTYPE) 'MENU-SET) -+ -+ -+(DEFUN MENU-SET-SELECT (MS &OPTIONAL REDRAW ENABLED) -+ (LET (RES RESB ITM SEL LASTX LASTY) -+ (IF REDRAW (MENU-SET-DRAW MS)) -+ (WHILE (NOT (OR RES RESB)) -+ (SETQ ITM -+ (WINDOW-TRACK-MOUSE (CADR MS) -+ #'(LAMBDA (X Y CODE) -+ (OR (AND (PLUSP CODE) (SETQ LASTX X) -+ (SETQ LASTY Y) CODE) -+ (SOME #'(LAMBDA (GLVAR128) -+ (IF -+ (AND -+ (BETWEEN X -+ (FIFTH (CADDR GLVAR128)) -+ (+ (FIFTH (CADDR GLVAR128)) -+ (SEVENTH (CADDR GLVAR128)))) -+ (BETWEEN Y -+ (SIXTH (CADDR GLVAR128)) -+ (+ (SIXTH (CADDR GLVAR128)) -+ (EIGHTH (CADDR GLVAR128))))) -+ GLVAR128)) -+ (CADDR MS)))))) -+ (IF (NUMBERP ITM) -+ (SETQ RESB (LIST (LIST LASTX LASTY) 'BACKGROUND ITM)) -+ (WHEN (OR (ATOM ENABLED) (MEMBER (CAR ITM) ENABLED)) -+ (SETQ SEL (MENU-MSELECT (CADDR ITM) (EQ ENABLED T))) -+ (IF SEL -+ (SETQ RES (LIST SEL (CAR ITM) *WINDOW-MENU-CODE*)) -+ (IF (AND *WINDOW-MENU-CODE* -+ (NOT (ZEROP *WINDOW-MENU-CODE*))) -+ (SETQ RES -+ (LIST NIL (CAR ITM) *WINDOW-MENU-CODE*))))))) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (OR RES RESB))) -+(SETF (GET 'MENU-SET-SELECT 'GLARGUMENTS) -+ '((MS MENU-SET) (&OPTIONAL BOOLEAN) (REDRAW (LISTOF SYMBOL)))) -+(SETF (GET 'MENU-SET-SELECT 'GLFNRESULTTYPE) 'MENU-SELECTION) -+ -+ -+(DEFUN MENU-SET-ADD-MENU (MS NAME SYM TITLE ITEMS &OPTIONAL OFFSET) -+ (LET (MENU) -+ (SETQ MENU -+ (MENU-CREATE ITEMS TITLE (CADR MS) (CAR OFFSET) (CADR OFFSET) -+ T T)) -+ (MENU-INIT MENU) -+ (IF (NOT OFFSET) -+ (SETQ OFFSET -+ (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) -+ (EIGHTH MENU)))) -+ (SETF (FIFTH MENU) (CAR OFFSET)) -+ (SETF (SIXTH MENU) (CADR OFFSET)) -+ (MENU-SET-ADD-ITEM MS NAME SYM MENU))) -+(SETF (GET 'MENU-SET-ADD-MENU 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) -+ (ITEMS NIL) (&OPTIONAL VECTOR))) -+(SETF (GET 'MENU-SET-ADD-MENU 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-SET-ADD-ITEM (MS NAME SYM MENU) -+ (SETF (CADDR MS) (NCONC (CADDR MS) (CONS (LIST NAME SYM MENU) NIL)))) -+(SETF (GET 'MENU-SET-ADD-ITEM 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) -+(SETF (GET 'MENU-SET-ADD-ITEM 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-SET-REMOVE-ITEMS (MS) (SETF (CADDR MS) NIL)) -+(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLARGUMENTS) '((MS MENU-SET))) -+(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-SET-ADD-PICMENU -+ (MS NAME SYM TITLE SPEC &OPTIONAL OFFSET NOBOX) -+ (LET (MENU MAXWIDTH MAXHEIGHT) -+ (IF (AND SPEC (SYMBOLP SPEC)) (SETQ SPEC (GET SPEC 'PICMENU-SPEC))) -+ (SETQ MENU -+ (PICMENU-CREATE-FROM-SPEC SPEC TITLE (CADR MS) (CAR OFFSET) -+ (CADR OFFSET) T T (NOT NOBOX))) -+ (SETQ MAXWIDTH -+ (MAX (IF TITLE (+ 6 (* 9 (LENGTH TITLE))) 0) (CADR SPEC))) -+ (SETQ MAXHEIGHT (+ (IF TITLE 15 0) (CADDR SPEC))) -+ (IF (NOT OFFSET) -+ (SETQ OFFSET -+ (WINDOW-GET-BOX-POSITION (CADR MS) MAXWIDTH MAXHEIGHT))) -+ (SETF (FIFTH MENU) (CAR OFFSET)) -+ (SETF (SIXTH MENU) (CADR OFFSET)) -+ (MENU-SET-ADD-ITEM MS NAME SYM MENU))) -+(SETF (GET 'MENU-SET-ADD-PICMENU 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) -+ (SPEC PICMENU-SPEC) (&OPTIONAL VECTOR) (OFFSET BOOLEAN))) -+(SETF (GET 'MENU-SET-ADD-PICMENU 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-SET-ADD-COMPONENT (MS NAME &OPTIONAL OFFSET) -+ (MENU-SET-ADD-PICMENU MS (MENU-SET-NAME NAME) NAME NIL NAME OFFSET T)) -+(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL) (&OPTIONAL VECTOR))) -+(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-SET-ADD-BARMENU (MS NAME SYM MENU TITLE &OPTIONAL OFFSET) -+ (BARMENU-INIT MENU) -+ (IF (NOT OFFSET) -+ (SETQ OFFSET -+ (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) -+ (EIGHTH MENU)))) -+ (SETF (FIFTH MENU) (CAR OFFSET)) -+ (SETF (SIXTH MENU) (CADR OFFSET)) -+ (MENU-SET-ADD-ITEM MS NAME SYM MENU)) -+(SETF (GET 'MENU-SET-ADD-BARMENU 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU BARMENU) -+ (TITLE STRING) (&OPTIONAL VECTOR))) -+(SETF (GET 'MENU-SET-ADD-BARMENU 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-SET-NAME (NM) -+ (INTERN (SYMBOL-NAME (GENSYM (SYMBOL-NAME NM))))) -+(SETF (GET 'MENU-SET-NAME 'GLARGUMENTS) '((NM SYMBOL))) -+(SETF (GET 'MENU-SET-NAME 'GLFNRESULTTYPE) 'SYMBOL) -+ -+ -+(DEFUN MENU-SET-NAMED-ITEM (MS NAME) (ASSOC NAME (CADDR MS))) -+(SETF (GET 'MENU-SET-NAMED-ITEM 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL))) -+(SETF (GET 'MENU-SET-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) -+ -+ -+(DEFUN MENU-SET-NAMED-MENU (MS NAME) -+ (CADDR (MENU-SET-NAMED-ITEM MS NAME))) -+(SETF (GET 'MENU-SET-NAMED-MENU 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL))) -+(SETF (GET 'MENU-SET-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) -+ -+ -+(DEFUN MENU-SET-ITEMP (MS NAME ITEMNAME) -+ (LET ((THISMENU (MENU-SET-NAMED-MENU MS NAME))) -+ (IF (EQ (FIRST THISMENU) 'MENU) -+ (SOME #'(LAMBDA (X) -+ (OR (EQ X ITEMNAME) -+ (AND (CONSP X) (EQ (CAR X) ITEMNAME)))) -+ (NTH 13 THISMENU)) -+ (IF (EQ (FIRST THISMENU) 'PICMENU) -+ (ASSOC ITEMNAME (CADDDR (NTH 10 THISMENU))))))) -+(SETF (GET 'MENU-SET-ITEMP 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL) (ITEMNAME SYMBOL))) -+(SETF (GET 'MENU-SET-ITEMP 'GLFNRESULTTYPE) 'BOOLEAN) -+ -+ -+(DEFUN MENU-CONNS-NAMED-ITEM (MC NAME) -+ (MENU-SET-NAMED-ITEM (CADR MC) NAME)) -+(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLARGUMENTS) -+ '((MC MENU-CONNS) (NAME SYMBOL))) -+(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) -+ -+ -+(DEFUN MENU-CONNS-NAMED-MENU (MC NAME) -+ (MENU-SET-NAMED-MENU (CADR MC) NAME)) -+(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLARGUMENTS) -+ '((MC MENU-CONNS) (NAME SYMBOL))) -+(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) -+ -+ -+(DEFUN MENU-SET-FIND-ITEM (MS POS) -+ (LET (MITEM) -+ (DOLIST (MI (CADDR MS)) -+ (IF (AND (BETWEEN (CAR POS) -+ (LET ((SELF (CADDR MI))) -+ (IF (CADDR SELF) (FIFTH SELF) 0)) -+ (+ (LET ((SELF (CADDR MI))) -+ (IF (CADDR SELF) (FIFTH SELF) 0)) -+ (SEVENTH (CADDR MI)))) -+ (BETWEEN (CADR POS) -+ (LET ((SELF (CADDR MI))) -+ (IF (CADDR SELF) (SIXTH SELF) 0)) -+ (+ (LET ((SELF (CADDR MI))) -+ (IF (CADDR SELF) (SIXTH SELF) 0)) -+ (EIGHTH (CADDR MI))))) -+ (SETQ MITEM MI))) -+ MITEM)) -+(SETF (GET 'MENU-SET-FIND-ITEM 'GLARGUMENTS) -+ '((MS MENU-SET) (POS VECTOR))) -+(SETF (GET 'MENU-SET-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) -+ -+ -+(DEFUN MENU-SET-DELETE-ITEM (MS MI) -+ (SETF (CADDR MS) (REMOVE MI (CADDR MS)))) -+(SETF (GET 'MENU-SET-DELETE-ITEM 'GLARGUMENTS) -+ '((MS MENU-SET) (MI MENU-SET-ITEM))) -+(SETF (GET 'MENU-SET-DELETE-ITEM 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-SET-MOVE (MS) -+ (LET (SEL M) -+ (SETQ SEL (MENU-SET-SELECT MS NIL T)) -+ (SETQ M (MENU-SET-NAMED-MENU MS (CADR SEL))) -+ (MENU-REPOSITION M))) -+ -+(DEFUN MENU-MDRAW (M) -+ (CASE (FIRST M) -+ (MENU (MENU-DRAW M)) -+ (PICMENU (PICMENU-DRAW M)) -+ (BARMENU (BARMENU-DRAW M)) -+ (TEXTMENU (TEXTMENU-DRAW M)) -+ (EDITMENU (EDITMENU-DRAW M)) -+ (T (GLSEND M DRAW)))) -+ -+(DEFUN MENU-MSELECT (M &OPTIONAL ANYCLICK) -+ (CASE (FIRST M) -+ (MENU (MENU-SELECT M T)) -+ (PICMENU (PICMENU-SELECT M T ANYCLICK)) -+ (BARMENU (BARMENU-SELECT M)) -+ (TEXTMENU (TEXTMENU-SELECT M T)) -+ (EDITMENU (EDITMENU-SELECT M T)) -+ (T (GLSEND M SELECT)))) -+ -+(DEFUN MENU-MITEM-POSITION (M NAME LOC) -+ (CASE (FIRST M) -+ (MENU (MENU-ITEM-POSITION M NAME LOC)) -+ (PICMENU (PICMENU-ITEM-POSITION M NAME LOC)) -+ (T (GLSEND M ITEM-POSITION NAME LOC)))) -+ -+(DEFUN MENU-SET-DRAW (MS) -+ (XMAPWINDOW *WINDOW-DISPLAY* (CADADR MS)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (WINDOW-WAIT-EXPOSURE (CADR MS)) -+ (DOLIST (ITEM (CADDR MS)) (MENU-MDRAW (CADDR ITEM)))) -+ -+(DEFUN MENU-SET-ITEM-POSITION (MS DESC &OPTIONAL LOC) -+ (LET (M) -+ (SETQ M (MENU-SET-NAMED-MENU MS (CADR DESC))) -+ (OR (MENU-MITEM-POSITION M (CAR DESC) LOC) -+ (MENU-MITEM-POSITION M NIL LOC)))) -+(SETF (GET 'MENU-SET-ITEM-POSITION 'GLARGUMENTS) -+ '((MS MENU-SET) (DESC MENU-PORT) (&OPTIONAL SYMBOL))) -+(SETF (GET 'MENU-SET-ITEM-POSITION 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN MENU-SET-DRAW-CONN (MS CONN) -+ (LET (PA PB TMP (DESCA (CAR CONN)) (DESCB (CADR CONN))) -+ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) -+ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) -+ (WHEN (> (CAR PA) (CAR PB)) -+ (SETQ TMP DESCA) -+ (SETQ DESCA DESCB) -+ (SETQ DESCB TMP)) -+ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) -+ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) -+ (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PA) (CADR PA) 3 NIL) -+ (WINDOW-DRAW-LINE-XY (CADR MS) (CAR PA) (CADR PA) (CAR PB) -+ (CADR PB) NIL) -+ (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PB) (CADR PB) 3 NIL) -+ (XFLUSH *WINDOW-DISPLAY*))) -+ -+(DEFUN MENU-SET-ADJUST (MS NAME EDGE FROM OFFSET) -+ (LET (M FROMM PLACE) -+ (WHEN (SETQ M (MENU-SET-NAMED-ITEM MS NAME)) -+ (IF FROM -+ (PROGN -+ (SETQ FROMM (MENU-SET-NAMED-ITEM MS FROM)) -+ (SETQ PLACE -+ (CASE EDGE -+ (TOP (SIXTH (CADDR FROMM))) -+ (BOTTOM (+ (SIXTH (CADDR FROMM)) -+ (EIGHTH (CADDR FROMM)))) -+ (LEFT (+ (FIFTH (CADDR FROMM)) -+ (SEVENTH (CADDR FROMM)))) -+ (RIGHT (FIFTH (CADDR FROMM)))))) -+ (SETQ PLACE -+ (CASE EDGE -+ (TOP (CADDDR (CADR MS))) -+ ((BOTTOM LEFT) 0) -+ (RIGHT (FIFTH (CADR MS)))))) -+ (CASE EDGE -+ (TOP (SETF (SIXTH (CADDR M)) -+ (- (- PLACE (EIGHTH (CADDR M))) OFFSET))) -+ (BOTTOM (SETF (SIXTH (CADDR M)) (+ PLACE OFFSET))) -+ (LEFT (SETF (FIFTH (CADDR M)) (+ PLACE OFFSET))) -+ (RIGHT (SETF (FIFTH (CADDR M)) -+ (- (- PLACE (SEVENTH (CADDR M))) OFFSET))))))) -+(SETF (GET 'MENU-SET-ADJUST 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL) (EDGE SYMBOL) (FROM SYMBOL) -+ (OFFSET INTEGER))) -+(SETF (GET 'MENU-SET-ADJUST 'GLFNRESULTTYPE) 'INTEGER) -+ -+ -+(DEFUN VECTOR-SNAP (FIXED APPROX &OPTIONAL TOLERANCE) -+ (OR TOLERANCE (SETQ TOLERANCE 10)) -+ (IF (< (ABS (- (CAR FIXED) (CAR APPROX))) TOLERANCE) -+ (LIST (CAR FIXED) (CADR APPROX)) -+ (IF (< (ABS (- (CADR FIXED) (CADR APPROX))) TOLERANCE) -+ (LIST (CAR APPROX) (CADR FIXED)) APPROX))) -+(SETF (GET 'VECTOR-SNAP 'GLARGUMENTS) -+ '((FIXED VECTOR) (APPROX VECTOR) (&OPTIONAL NIL))) -+(SETF (GET 'VECTOR-SNAP 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN MENU-CONNS-CREATE (MS) (LIST 'MENU-CONNS MS NIL)) -+(SETF (GET 'MENU-CONNS-CREATE 'GLARGUMENTS) '((MS MENU-SET))) -+(SETF (GET 'MENU-CONNS-CREATE 'GLFNRESULTTYPE) 'MENU-CONNS) -+ -+ -+(DEFUN MENU-CONNS-DRAW (MC) -+ (MENU-SET-DRAW (CADR MC)) -+ (DOLIST (C (CADDR MC)) (MENU-SET-DRAW-CONN (CADR MC) C))) -+ -+(DEFUN MENU-CONNS-MOVE (MC) -+ (MENU-SET-MOVE (CADR MC)) -+ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (MENU-CONNS-DRAW MC)) -+ -+(DEFUN MENU-CONNS-REDRAW (MC) -+ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (MENU-CONNS-DRAW MC)) -+ -+(DEFUN MENU-CONNS-ADD-CONN (MC) -+ (LET (SEL SELB CONN) -+ (SETQ SEL (MENU-SET-SELECT (CADR MC))) -+ (IF (EQ (CADR SEL) 'BACKGROUND) SEL -+ (PROGN -+ (SETQ SELB (MENU-SET-SELECT (CADR MC))) -+ (WHEN (NOT (EQ (CADR SELB) 'BACKGROUND)) -+ (SETQ CONN (LIST SEL SELB)) -+ (MENU-SET-DRAW-CONN (CADR MC) CONN) -+ (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL)))) -+ NIL)))) -+(SETF (GET 'MENU-CONNS-ADD-CONN 'GLARGUMENTS) '((MC MENU-CONNS))) -+(SETF (GET 'MENU-CONNS-ADD-CONN 'GLFNRESULTTYPE) 'MENU-SELECTION) -+ -+ -+(DEFUN MENU-CONNS-NEW-CONN (MC FROMNAME FROMPORT TONAME TOPORT) -+ (LET (CONN) -+ (SETQ CONN (LIST (LIST FROMPORT FROMNAME) (LIST TOPORT TONAME))) -+ (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL))))) -+(SETF (GET 'MENU-CONNS-NEW-CONN 'GLARGUMENTS) -+ '((MC MENU-CONNS) (FROMNAME SYMBOL) (FROMPORT SYMBOL) -+ (TONAME SYMBOL) (TOPORT SYMBOL))) -+(SETF (GET 'MENU-CONNS-NEW-CONN 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-CONN)) -+ -+ -+(DEFUN MENU-CONNS-ADD-ITEM (MC NAME SYM MENU) -+ (MENU-SET-ADD-ITEM (CADR MC) NAME SYM MENU)) -+(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLARGUMENTS) -+ '((MC MENU-CONNS) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) -+(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-CONNS-FIND-CONN (MC PT) -+ (LET (MS LS FOUND RES PA PB TMP DESCA DESCB) -+ (SETQ LS (LIST (COPY-LIST '(0 0)) (COPY-LIST '(0 0)))) -+ (SETQ MS (CADR MC)) -+ (DOLIST (CONN (CADDR MC)) -+ (UNLESS FOUND -+ (SETQ DESCA (CAR CONN)) -+ (SETQ DESCB (CADR CONN)) -+ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) -+ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) -+ (WHEN (> (CAR PA) (CAR PB)) -+ (SETQ TMP DESCA) -+ (SETQ DESCA DESCB) -+ (SETQ DESCB TMP)) -+ (SETF (CAR LS) (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) -+ (SETF (CADR LS) (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) -+ (WHEN (< (ABS (/ (- (* (- (CAADR LS) (CAAR LS)) -+ (- (CADR PT) (CADAR LS))) -+ (* (- (CADADR LS) (CADAR LS)) -+ (- (CAR PT) (CAAR LS)))) -+ (SQRT (+ (EXPT (- (CAADR LS) (CAAR LS)) 2) -+ (EXPT (- (CADADR LS) (CADAR LS)) 2))))) -+ 5) -+ (SETQ FOUND T) -+ (SETQ RES CONN)))) -+ RES)) -+(SETF (GET 'MENU-CONNS-FIND-CONN 'GLARGUMENTS) -+ '((MC MENU-CONNS) (PT VECTOR))) -+(SETF (GET 'MENU-CONNS-FIND-CONN 'GLFNRESULTTYPE) 'MENU-SET-CONN) -+ -+ -+(DEFUN MENU-CONNS-FIND-ITEM (MC PT) (MENU-SET-FIND-ITEM (CADR MC) PT)) -+(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLARGUMENTS) -+ '((MC MENU-CONNS) (PT VECTOR))) -+(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) -+ -+ -+(DEFUN MENU-CONNS-DELETE-CONN (MC CONN) -+ (SETF (CADDR MC) (REMOVE CONN (CADDR MC)))) -+(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLARGUMENTS) -+ '((MC MENU-CONNS) (CONN MENU-SET-CONN))) -+(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-CONN)) -+ -+ -+(DEFUN MENU-CONNS-DELETE-ITEM (MC MI) -+ (LET (MS) -+ (SETQ MS (CADR MC)) -+ (MENU-SET-DELETE-ITEM MS MI) -+ (DOLIST (CONN (CADDR MC)) -+ (IF (OR (EQ (CADAR CONN) (CAR MI)) (EQ (CADADR CONN) (CAR MI))) -+ (MENU-CONNS-DELETE-CONN MC CONN))))) -+ -+(DEFUN MENU-CONNS-REMOVE-ITEMS (MC) -+ (MENU-SET-REMOVE-ITEMS (CADR MC)) -+ (SETF (CADDR MC) NIL)) -+(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLARGUMENTS) '((MC MENU-CONNS))) -+(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-CONN)) -+ -+ -+(DEFUN MENU-CONNS-CONNECTED-PORTS (MC BOXNAME) -+ (LET (PORTS) -+ (DOLIST (CONN (CADDR MC)) -+ (IF (EQ BOXNAME (CADADR CONN)) (PUSHNEW (CAADR CONN) PORTS) -+ (IF (EQ BOXNAME (CADAR CONN)) (PUSHNEW (CAAR CONN) PORTS)))) -+ PORTS)) -+ -+(DEFUN MENU-CONNS-FIND-CONNS (MC BOXNAME PORT) -+ (LET (RES) -+ (DOLIST (CONN (CADDR MC)) -+ (IF (AND (EQ BOXNAME (CADADR CONN)) (EQ PORT (CAADR CONN))) -+ (SETQ RES (NCONC RES (CONS (CAR CONN) NIL)))) -+ (IF (AND (EQ BOXNAME (CADAR CONN)) (EQ PORT (CAAR CONN))) -+ (SETQ RES (NCONC RES (CONS (CADR CONN) NIL))))) -+ RES)) -+(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLARGUMENTS) -+ '((MC MENU-CONNS) (BOXNAME SYMBOL) (PORT SYMBOL))) -+(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLFNRESULTTYPE) '(LISTOF MENU-PORT)) -+ -+ -+(DEFUN COMPILE-MENU-SET () -+ (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") -+ '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" -+ "glisp/menu-set-header.lsp") -+ (COMPILE-FILE "glisp/menu-settrans.lsp")) -+ -+(DEFUN COMPILE-MENU-SETB () -+ (GLCOMPFILES *DIRECTORY* -+ '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") -+ '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" -+ "glisp/menu-set-header.lsp")) -+ -+(DEFVAR *DRAW-WINDOW* NIL) -+ -+(DEFVAR *DRAW-WINDOW-WIDTH* 600) -+ -+(DEFVAR *DRAW-WINDOW-HEIGHT* 600) -+ -+(DEFVAR *DRAW-LEAVE-WINDOW* NIL) -+ -+(DEFVAR *DRAW-MENU-SET* NIL) -+ -+(DEFVAR *DRAW-ZERO-VECTOR* '(0 0)) -+ -+(DEFVAR *DRAW-LATEX-FACTOR* 1) -+ -+(DEFVAR *DRAW-SNAP-FLAG* T) -+ -+(DEFVAR *DRAW-OBJECTS* NIL) -+ -+(DEFVAR *DRAW-LATEX-MODE* NIL) -+ -+(DEFVAR *DRAW-WINDOW*) -+(SETF (GET '*DRAW-WINDOW* 'GLISPGLOBALVAR) T) -+(SETF (GET '*DRAW-WINDOW* 'GLISPGLOBALVARTYPE) 'WINDOW) -+ -+ -+(DEFMACRO DRAW-DESCR (NAME) (LIST 'GET NAME ''DRAW-DESCR)) -+ -+(SETF (GET 'DRAW-DESC 'GLSTRUCTURE) -+ '((LISTOBJECT (NAME SYMBOL) (OBJECTS (LISTOF DRAW-OBJECT)) -+ (OFFSET VECTOR) (SIZE VECTOR)) -+ PROP ((FNNAME DRAW-DESC-FNNAME) (REFPT DRAW-DESC-REFPT)) MSG -+ ((DRAW DRAW-DESC-DRAW) (SNAP DRAW-DESC-SNAP) -+ (FIND DRAW-DESC-FIND) (DELETE DRAW-DESC-DELETE)))) -+(SETF (GET 'DRAW-OBJECT 'GLSTRUCTURE) -+ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) -+ (LINEWIDTH INTEGER)) -+ DEFAULT ((LINEWIDTH 1)) PROP -+ ((REGION ((VIRTUAL REGION WITH START = OFFSET SIZE = SIZE))) -+ (VREGION ((VIRTUAL REGION WITH START = VSTART SIZE = VSIZE))) -+ (VSTART ((VIRTUAL VECTOR WITH X = -+ (MIN (X OFFSET) ((X OFFSET) + (X SIZE))) - 2 -+ Y = (MIN (Y OFFSET) ((Y OFFSET) + (Y SIZE))) -+ - 2))) -+ (VSIZE ((VIRTUAL VECTOR WITH X = (ABS (X SIZE)) + 4 Y = -+ (ABS (Y SIZE)) + 4)))) -+ MSG -+ ((ERASE DRAW-OBJECT-ERASE) (DRAW DRAW-OBJECT-DRAW) -+ (SNAP DRAW-OBJECT-SNAP) (SELECTEDP DRAW-OBJECT-SELECTEDP) -+ (MOVE DRAW-OBJECT-MOVE)))) -+(SETF (GET 'DRAW-LINE 'GLSTRUCTURE) -+ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) -+ (LINEWIDTH INTEGER)) -+ PROP -+ ((LINE ((VIRTUAL LINE-SEGMENT WITH P1 = OFFSET P2 = -+ (OFFSET + SIZE))))) -+ MSG -+ ((DRAW DRAW-LINE-DRAW) (SNAP DRAW-LINE-SNAP) -+ (SELECTEDP DRAW-LINE-SELECTEDP)) -+ SUPERS (DRAW-OBJECT))) -+(SETF (GET 'DRAW-ARROW 'GLSTRUCTURE) -+ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) -+ (LINEWIDTH INTEGER)) -+ PROP -+ ((LINE ((VIRTUAL LINE-SEGMENT WITH P1 = OFFSET P2 = -+ (OFFSET + SIZE))))) -+ MSG -+ ((DRAW DRAW-ARROW-DRAW) (SNAP DRAW-LINE-SNAP) -+ (SELECTEDP DRAW-LINE-SELECTEDP)) -+ SUPERS (DRAW-OBJECT))) -+(SETF (GET 'DRAW-BOX 'GLSTRUCTURE) -+ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) -+ (LINEWIDTH INTEGER)) -+ MSG -+ ((DRAW DRAW-BOX-DRAW) (SNAP DRAW-BOX-SNAP) -+ (SELECTEDP DRAW-BOX-SELECTEDP)) -+ SUPERS (DRAW-OBJECT))) -+(SETF (GET 'DRAW-RCBOX 'GLSTRUCTURE) -+ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) -+ (LINEWIDTH INTEGER)) -+ MSG -+ ((DRAW DRAW-RCBOX-DRAW) (SNAP DRAW-RCBOX-SNAP) -+ (SELECTEDP DRAW-RCBOX-SELECTEDP)) -+ SUPERS (DRAW-OBJECT))) -+(SETF (GET 'DRAW-ERASE 'GLSTRUCTURE) -+ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) -+ (LINEWIDTH INTEGER)) -+ MSG -+ ((DRAW DRAW-ERASE-DRAW) (SNAP DRAW-NO-SNAP) -+ (SELECTEDP DRAW-ERASE-SELECTEDP)) -+ SUPERS (DRAW-OBJECT))) -+(SETF (GET 'DRAW-CIRCLE 'GLSTRUCTURE) -+ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) -+ (LINEWIDTH INTEGER)) -+ PROP ((RADIUS ((X SIZE) / 2)) (CENTER (OFFSET + SIZE / 2))) MSG -+ ((DRAW DRAW-CIRCLE-DRAW) (SNAP DRAW-CIRCLE-SNAP) -+ (SELECTEDP DRAW-CIRCLE-SELECTEDP)) -+ SUPERS (DRAW-OBJECT))) -+(SETF (GET 'DRAW-ELLIPSE 'GLSTRUCTURE) -+ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) -+ (LINEWIDTH INTEGER)) -+ PROP -+ ((RADIUSX ((X SIZE) / 2)) (RADIUSY ((Y SIZE) / 2)) -+ (RADIUS ((MAX RADIUSX RADIUSY))) (CENTER (OFFSET + SIZE / 2)) -+ (DELTA ((SQRT (ABS (RADIUSX ^ 2 - RADIUSY ^ 2))))) -+ (P1 ((IF (RADIUSX > RADIUSY) -+ (A VECTOR X = (X CENTER) - DELTA Y = (Y CENTER)) -+ (A VECTOR X = (X CENTER) Y = (Y CENTER) - DELTA)))) -+ (P2 ((IF (RADIUSX > RADIUSY) -+ (A VECTOR X = (X CENTER) + DELTA Y = (Y CENTER)) -+ (A VECTOR X = (X CENTER) Y = (Y CENTER) + DELTA))))) -+ MSG -+ ((DRAW DRAW-ELLIPSE-DRAW) (SNAP DRAW-ELLIPSE-SNAP) -+ (SELECTEDP DRAW-ELLIPSE-SELECTEDP)) -+ SUPERS (DRAW-OBJECT))) -+(SETF (GET 'DRAW-DOT 'GLSTRUCTURE) -+ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) -+ (LINEWIDTH INTEGER)) -+ MSG -+ ((DRAW DRAW-DOT-DRAW) (SNAP DRAW-DOT-SNAP) -+ (SELECTEDP DRAW-BUTTON-SELECTEDP)) -+ SUPERS (DRAW-OBJECT))) -+(SETF (GET 'DRAW-BUTTON 'GLSTRUCTURE) -+ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) -+ (LINEWIDTH INTEGER)) -+ MSG -+ ((DRAW DRAW-BUTTON-DRAW) (SNAP DRAW-DOT-SNAP) -+ (SELECTEDP DRAW-BUTTON-SELECTEDP)) -+ SUPERS (DRAW-OBJECT))) -+(SETF (GET 'DRAW-TEXT 'GLSTRUCTURE) -+ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) -+ (LINEWIDTH INTEGER)) -+ MSG -+ ((DRAW DRAW-TEXT-DRAW) (SNAP DRAW-NO-SNAP) -+ (SELECTEDP DRAW-TEXT-SELECTEDP)) -+ SUPERS (DRAW-OBJECT))) -+(SETF (GET 'DRAW-NULL 'GLSTRUCTURE) -+ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) -+ (LINEWIDTH INTEGER)) -+ MSG -+ ((DRAW DRAW-NULL-DRAW) (SNAP DRAW-NO-SNAP) -+ (SELECTEDP DRAW-NULL-SELECTEDP)) -+ SUPERS (DRAW-OBJECT))) -+(SETF (GET 'DRAW-REFPT 'GLSTRUCTURE) -+ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) (CONTENTS ANYTHING) -+ (LINEWIDTH INTEGER)) -+ MSG -+ ((DRAW DRAW-REFPT-DRAW) (SNAP DRAW-REFPT-SNAP) -+ (SELECTEDP DRAW-REFPT-SELECTEDP)) -+ SUPERS (DRAW-OBJECT))) -+(SETF (GET 'DRAW-MULTI 'GLSTRUCTURE) -+ '((LISTOBJECT (OFFSET VECTOR) (SIZE VECTOR) -+ (CONTENTS (LISTOF DRAW-OBJECT)) (LINEWIDTH INTEGER)) -+ MSG -+ ((DRAW DRAW-MULTI-DRAW) (SNAP DRAW-NO-SNAP) -+ (SELECTEDP DRAW-MULTI-SELECTEDP)) -+ SUPERS (DRAW-OBJECT))) -+ -+ -+(DEFUN DRAW-DESC (NAME) -+ (LET (DD) -+ (SETQ DD (DRAW-DESCR NAME)) -+ (WHEN (NOT DD) -+ (SETQ DD -+ (LIST 'DRAW-DESC NAME NIL (COPY-LIST '(0 0)) -+ (COPY-LIST '(0 0)))) -+ (SETF (DRAW-DESCR NAME) DD)) -+ DD)) -+(SETF (GET 'DRAW-DESC 'GLARGUMENTS) '((NAME SYMBOL))) -+(SETF (GET 'DRAW-DESC 'GLFNRESULTTYPE) 'DRAW-DESC) -+ -+ -+(SETF (GET 'DRAW-WINDOW 'GLFNRESULTTYPE) 'WINDOW) -+ -+(DEFUN DRAW-WINDOW () -+ (OR *DRAW-WINDOW* -+ (SETQ *DRAW-WINDOW* -+ (WINDOW-CREATE *DRAW-WINDOW-WIDTH* *DRAW-WINDOW-HEIGHT* -+ "Draw window")))) -+ -+(DEFUN DRAW (NAME) -+ (LET (W DD DONE SEL (REDRAW T) NEW) -+ (SETQ W (DRAW-WINDOW)) -+ (XMAPWINDOW *WINDOW-DISPLAY* (CADR W)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (WINDOW-WAIT-EXPOSURE W) -+ (OR *DRAW-MENU-SET* (DRAW-INIT-MENUS)) -+ (SETQ DD (DRAW-DESC NAME)) -+ (UNLESS (MEMBER NAME *DRAW-OBJECTS*) -+ (SETQ *DRAW-OBJECTS* (NCONC *DRAW-OBJECTS* (LIST NAME)))) -+ (DRAW-DESC-DRAW DD W) -+ (WHILE (NOT DONE) -+ (SETQ SEL (MENU-SET-SELECT *DRAW-MENU-SET* REDRAW)) -+ (SETQ REDRAW NIL) -+ (CASE (CADR SEL) -+ (COMMAND (CASE (CAR SEL) -+ (DONE (SETQ DONE T)) -+ (MOVE (DRAW-DESC-MOVE DD W)) -+ (DELETE (DRAW-DESC-DELETE DD W)) -+ (COPY (DRAW-DESC-COPY DD W)) -+ (REDRAW (XCLEARWINDOW *WINDOW-DISPLAY* -+ (CADR W)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (SETQ REDRAW T) (DRAW-DESC-DRAW DD W)) -+ (ORIGIN (DRAW-DESC-ORIGIN DD W) -+ (XCLEARWINDOW *WINDOW-DISPLAY* -+ (CADR W)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (SETQ REDRAW T) (DRAW-DESC-DRAW DD W)) -+ (PROGRAM (DRAW-DESC-PROGRAM DD)) -+ (LATEX (DRAW-DESC-LATEX DD)) -+ (LATEXMODE -+ (SETQ *DRAW-LATEX-MODE* -+ (NOT *DRAW-LATEX-MODE*)) -+ (FORMAT T "Latex Mode is now ~A~%" -+ *DRAW-LATEX-MODE*)))) -+ (DRAW (SETQ NEW NIL) -+ (CASE (CAR SEL) -+ (RECTANGLE (SETQ NEW (DRAW-BOX-GET DD W))) -+ (RCBOX (SETQ NEW (DRAW-RCBOX-GET DD W))) -+ (CIRCLE (SETQ NEW (DRAW-CIRCLE-GET DD W))) -+ (ELLIPSE (SETQ NEW (DRAW-ELLIPSE-GET DD W))) -+ (LINE (SETQ NEW (DRAW-LINE-GET DD W))) -+ (ARROW (SETQ NEW (DRAW-ARROW-GET DD W))) -+ (DOT (SETQ NEW (DRAW-DOT-GET DD W))) -+ (ERASE (SETQ NEW (DRAW-ERASE-GET DD W))) -+ (BUTTON (SETQ NEW (DRAW-BUTTON-GET DD W))) -+ (TEXT (SETQ NEW (DRAW-TEXT-GET DD W))) -+ (REFPT (SETQ NEW (DRAW-REFPT-GET DD W)))) -+ (WHEN NEW -+ (SETF (CADR NEW) -+ (LIST (- (CAADR NEW) (CAR (CADDDR DD))) -+ (- (CADADR NEW) (CADR (CADDDR DD))))) -+ (SETF (CADDR DD) -+ (NCONC (CADDR DD) (CONS NEW NIL))) -+ (DRAW-OBJECT-DRAW NEW W (CADDDR DD)))) -+ (BACKGROUND))) -+ (SETF (DRAW-DESCR NAME) DD) -+ (UNLESS *DRAW-LEAVE-WINDOW* -+ (PROGN -+ (XUNMAPWINDOW *WINDOW-DISPLAY* (CADR W)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (WINDOW-WAIT-UNMAP W))) -+ NAME)) -+(SETF (GET 'DRAW 'GLARGUMENTS) '((NAME SYMBOL))) -+(SETF (GET 'DRAW 'GLFNRESULTTYPE) 'SYMBOL) -+ -+ -+(DEFUN COPY-DRAW-DESC (FROM TO) -+ (LET (OLD) -+ (SETQ OLD (COPY-TREE (GET FROM 'DRAW-DESCR))) -+ (SETF (GET TO 'DRAW-DESCR) (CONS (CAR OLD) (CONS TO (CDDR OLD)))))) -+ -+(DEFUN DRAW-DESC-DRAW (DD W) -+ (LET ((OFF (CADDDR DD))) -+ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR W)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (DOLIST (OBJ (CADDR DD)) (DRAW-OBJECT-DRAW OBJ W OFF)) -+ (XFLUSH *WINDOW-DISPLAY*))) -+ -+(DEFUN DRAW-DESC-SELECTED (DD P) -+ (LET (OBJS OBJSB OBJ) -+ (SETQ OBJS -+ (MAPCAN #'(LAMBDA (OBJ) -+ (AND (DRAW-OBJECT-SELECTEDP OBJ P (CADDDR DD)) -+ (CONS OBJ NIL))) -+ (CADDR DD))) -+ (IF OBJS -+ (IF (NULL (REST OBJS)) (SETQ OBJ (FIRST OBJS)) -+ (PROGN -+ (SETQ OBJSB -+ (MAPCAN #'(LAMBDA (Z) -+ (AND (MEMBER (FIRST Z) -+ '(DRAW-BUTTON DRAW-DOT)) -+ (CONS Z NIL))) -+ OBJS)) -+ (IF (AND OBJSB (NULL (REST OBJSB))) -+ (SETQ OBJ (FIRST OBJSB)))))) -+ OBJ)) -+(SETF (GET 'DRAW-DESC-SELECTED 'GLARGUMENTS) -+ '((DD DRAW-DESC) (P VECTOR))) -+(SETF (GET 'DRAW-DESC-SELECTED 'GLFNRESULTTYPE) 'DRAW-OBJECT) -+ -+ -+(DEFUN DRAW-DESC-FIND (DD W &OPTIONAL CROSSFLG) -+ (LET (P OBJ) -+ (WHILE (NOT OBJ) -+ (SETQ P -+ (IF CROSSFLG (DRAW-GET-CROSS DD W) -+ (DRAW-GET-CROSSHAIRS DD W))) -+ (SETQ OBJ (DRAW-DESC-SELECTED DD P))) -+ OBJ)) -+(SETF (GET 'DRAW-DESC-FIND 'GLARGUMENTS) -+ '((DD DRAW-DESC) (W WINDOW) (&OPTIONAL BOOLEAN))) -+(SETF (GET 'DRAW-DESC-FIND 'GLFNRESULTTYPE) 'DRAW-OBJECT) -+ -+ -+(DEFUN DRAW-GET-CROSS (DD W) (DRAW-DESC-SNAP DD (WINDOW-GET-CROSS W))) -+(SETF (GET 'DRAW-GET-CROSS 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-GET-CROSS 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN DRAW-GET-CROSSHAIRS (DD W) -+ (DRAW-DESC-SNAP DD (WINDOW-GET-CROSSHAIRS W))) -+(SETF (GET 'DRAW-GET-CROSSHAIRS 'GLARGUMENTS) -+ '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-GET-CROSSHAIRS 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN DRAW-DESC-DELETE (DD W) -+ (LET (OBJ) -+ (SETQ OBJ (DRAW-DESC-FIND DD W T)) -+ (DRAW-OBJECT-ERASE OBJ W (CADDDR DD)) -+ (SETF (CADDR DD) (REMOVE OBJ (CADDR DD))))) -+(SETF (GET 'DRAW-DESC-DELETE 'GLARGUMENTS) -+ '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-DESC-DELETE 'GLFNRESULTTYPE) '(LISTOF DRAW-OBJECT)) -+ -+ -+(DEFUN DRAW-DESC-COPY (DD W) -+ (LET (OBJ OBJB) -+ (SETQ OBJ (DRAW-DESC-FIND DD W)) -+ (SETQ OBJB (COPY-TREE OBJ)) -+ (DRAW-GET-OBJECT-POS OBJB W) -+ (SETF (CADR OBJB) -+ (LIST (- (CAADR OBJB) (CAR (CADDDR DD))) -+ (- (CADADR OBJB) (CADR (CADDDR DD))))) -+ (DRAW-OBJECT-DRAW OBJB W (CADDDR DD)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (SETF (CADDR DD) (NCONC (CADDR DD) (CONS OBJB NIL))))) -+(SETF (GET 'DRAW-DESC-COPY 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-DESC-COPY 'GLFNRESULTTYPE) '(LISTOF DRAW-OBJECT)) -+ -+ -+(DEFUN DRAW-DESC-MOVE (DD W) -+ (LET (OBJ) -+ (IF (SETQ OBJ (DRAW-DESC-FIND DD W)) -+ (DRAW-OBJECT-MOVE OBJ W (CADDDR DD))))) -+ -+(DEFUN DRAW-DESC-ORIGIN (DD W) -+ (LET (SEL) -+ (DRAW-DESC-BOUNDS DD) -+ (SETQ SEL (MENU '(("To zero" . TOZERO) ("Select" . SELECT)))) -+ (IF (EQ SEL 'SELECT) -+ (SETF (CADDDR DD) -+ (WINDOW-GET-BOX-POSITION W (CAR (FIFTH DD)) -+ (CADR (FIFTH DD)))) -+ (IF (EQ SEL 'TOZERO) (SETF (CADDDR DD) (COPY-LIST '(0 0))))))) -+(SETF (GET 'DRAW-DESC-ORIGIN 'GLARGUMENTS) -+ '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-DESC-ORIGIN 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN DRAW-DESC-BOUNDS (DD) -+ (LET ((XMIN 9999) (YMIN 9999) (XMAX 0) (YMAX 0) BASEV) -+ (DOLIST (OBJ (CADDR DD)) -+ (SETQ XMIN (MIN XMIN (CAADR OBJ) (+ (CAADR OBJ) (CAADDR OBJ)))) -+ (SETQ YMIN -+ (MIN YMIN (CADADR OBJ) (+ (CADADR OBJ) (CADR (CADDR OBJ))))) -+ (SETQ XMAX (MAX XMAX (CAADR OBJ) (+ (CAADR OBJ) (CAADDR OBJ)))) -+ (SETQ YMAX -+ (MAX YMAX (CADADR OBJ) (+ (CADADR OBJ) (CADR (CADDR OBJ)))))) -+ (SETF (CAR (FIFTH DD)) (- XMAX XMIN)) -+ (SETF (CADR (FIFTH DD)) (- YMAX YMIN)) -+ (SETQ BASEV (LIST XMIN YMIN)) -+ (SETF (CADDDR DD) BASEV) -+ (DOLIST (OBJ (CADDR DD)) -+ (SETF (CADR OBJ) -+ (LIST (- (CAADR OBJ) (CAR BASEV)) -+ (- (CADADR OBJ) (CADR BASEV))))))) -+ -+(DEFUN DRAW-DESC-LATEX (DD) -+ (LET (BASE BX BY SX SY) -+ (FORMAT T " \\begin{picture}(~5,0F,~5,0F)(0,0)~%" -+ (* (CAR (FIFTH DD)) *DRAW-LATEX-FACTOR*) -+ (* (CADR (FIFTH DD)) *DRAW-LATEX-FACTOR*)) -+ (DOLIST (OBJ (CADDR DD)) -+ (SETQ BASE -+ (LIST (+ (CAR (CADDDR DD)) (CAADR OBJ)) -+ (+ (CADR (CADDDR DD)) (CADADR OBJ)))) -+ (SETQ BX (* (CAR BASE) *DRAW-LATEX-FACTOR*)) -+ (SETQ BY (* (CADR BASE) *DRAW-LATEX-FACTOR*)) -+ (SETQ SX (* (CAADDR OBJ) *DRAW-LATEX-FACTOR*)) -+ (SETQ SY (* (CADR (CADDR OBJ)) *DRAW-LATEX-FACTOR*)) -+ (CASE (FIRST OBJ) -+ (DRAW-LINE -+ (LATEX-LINE (CAR BASE) (CADR BASE) (+ (CAR BASE) SX) -+ (+ (CADR BASE) SY))) -+ (DRAW-ARROW -+ (LATEX-LINE (CAR BASE) (CADR BASE) (+ (CAR BASE) SX) -+ (+ (CADR BASE) SY) T)) -+ (DRAW-BOX -+ (FORMAT T -+ " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" -+ BX BY SX SY)) -+ (DRAW-RCBOX -+ (FORMAT T " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" -+ (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX SY)) -+ (DRAW-CIRCLE -+ (FORMAT T " \\put(~5,0F,~5,0F) {\\circle{~5,0F}}~%" -+ (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX)) -+ (DRAW-ELLIPSE -+ (FORMAT T " \\put(~5,0F,~5,0F) {\\oval(~5,0F,~5,0F)}~%" -+ (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX SY)) -+ (DRAW-BUTTON -+ (FORMAT T -+ " \\put(~5,0F,~5,0F) {\\framebox(~5,0F,~5,0F)}~%" -+ BX BY SX SY)) -+ (DRAW-ERASE) -+ (DRAW-DOT -+ (FORMAT T " \\put(~5,0F,~5,0F) {\\circle*{~5,0F}}~%" -+ (+ BX (* 1/2 SX)) (+ BY (* 1/2 SY)) SX)) -+ (DRAW-TEXT -+ (FORMAT T " \\put(~5,0F,~5,0F) {~A}~%" BX -+ (+ BY (* 4 *DRAW-LATEX-FACTOR*)) (CADDDR OBJ))))) -+ (FORMAT T " \\end{picture}~%"))) -+ -+(DEFUN DRAW-DESC-PROGRAM (DD) -+ (LET (BASE BX BY SX SY TOX TOY R RX RY S CODE FNCODE FNNAME CD) -+ (SETQ CODE -+ (MAPCAN #'(LAMBDA (OBJ) -+ (AND (SETQ CD -+ (PROGN -+ (SETQ BASE -+ (LET -+ ((GLVAR133 -+ (LIST -+ (+ (CAR (CADDDR DD)) -+ (CAADR OBJ)) -+ (+ (CADR (CADDDR DD)) -+ (CADADR OBJ)))) -+ (GLVAR134 (DRAW-DESC-REFPT DD))) -+ (LIST -+ (- (CAR GLVAR133) -+ (CAR GLVAR134)) -+ (- (CADR GLVAR133) -+ (CADR GLVAR134))))) -+ (SETQ BX (CAR BASE)) -+ (SETQ BY (CADR BASE)) -+ (SETQ SX (CAADDR OBJ)) -+ (SETQ SY (CADR (CADDR OBJ))) -+ (SETQ TOX (+ BX SX)) -+ (SETQ TOY (+ BY SY)) -+ (IF (EQ (CAR OBJ) 'DRAW-CIRCLE) -+ (SETQ R (* 1/2 (CAADDR OBJ)))) -+ (WHEN (EQ (CAR OBJ) 'DRAW-ELLIPSE) -+ (SETQ RX (* 1/2 (CAADDR OBJ))) -+ (SETQ RY -+ (* 1/2 (CADR (CADDR OBJ))))) -+ (DRAW-OPTIMIZE -+ (CASE (FIRST OBJ) -+ (DRAW-LINE -+ (LIST 'WINDOW-DRAW-LINE-XY 'W -+ (LIST '+ 'X BX) (LIST '+ 'Y BY) -+ (LIST '+ 'X TOX) -+ (LIST '+ 'Y TOY))) -+ (DRAW-ARROW -+ (LIST 'WINDOW-DRAW-ARROW-XY 'W -+ (LIST '+ 'X BX) (LIST '+ 'Y BY) -+ (LIST '+ 'X TOX) -+ (LIST '+ 'Y TOY))) -+ (DRAW-BOX -+ (LIST 'WINDOW-DRAW-BOX-XY 'W -+ (LIST '+ 'X BX) (LIST '+ 'Y BY) -+ SX SY)) -+ (DRAW-RCBOX -+ (LIST 'WINDOW-DRAW-RCBOX-XY 'W -+ (LIST '+ 'X BX) (LIST '+ 'Y BY) -+ SX SY 8)) -+ (DRAW-CIRCLE -+ (LIST 'WINDOW-DRAW-CIRCLE-XY 'W -+ (LIST '+ 'X (+ R BX)) -+ (LIST '+ 'Y (+ R BY)) R)) -+ (DRAW-ELLIPSE -+ (LIST 'WINDOW-DRAW-ELLIPSE-XY 'W -+ (LIST '+ 'X (+ RX BX)) -+ (LIST '+ 'Y (+ RY BY)) RX RY)) -+ ((DRAW-BUTTON DRAW-REFPT) NIL) -+ (DRAW-ERASE -+ (LIST 'WINDOW-ERASE-AREA-XY 'W -+ (LIST '+ 'X BX) (LIST '+ 'Y BY) -+ SX SY)) -+ (DRAW-DOT -+ (LIST 'WINDOW-DRAW-DOT-XY 'W -+ (LIST '+ 'X (+ 2 BX)) -+ (LIST '+ 'Y (+ 2 BY)))) -+ (DRAW-TEXT -+ (SETQ S -+ (STRINGIFY (CADDDR OBJ))) -+ (LIST 'WINDOW-PRINTAT-XY 'W S -+ (LIST '+ 'X BX) -+ (LIST '+ 'Y BY))))))) -+ (CONS CD NIL))) -+ (CADDR DD))) -+ (SETQ FNCODE -+ (CONS 'LAMBDA -+ (CONS (LIST 'W 'X 'Y) -+ (NCONC CODE -+ (LIST (LIST 'WINDOW-FORCE-OUTPUT 'W)))))) -+ (SETQ FNNAME (DRAW-DESC-FNNAME DD)) -+ (SETF (SYMBOL-FUNCTION FNNAME) FNCODE) -+ (FORMAT T "Constructed program (~A w x y)~%" FNNAME) -+ (DRAW-DESC-PICMENU DD))) -+ -+(DEFUN DRAW-OPTIMIZE (X) (IF (FBOUNDP 'GLUNWRAP) (GLUNWRAP X NIL) X)) -+ -+(DEFUN DRAW-DESC-FNNAME (DD) -+ (INTERN (CONCATENATE 'STRING "DRAW-" (SYMBOL-NAME (CADR DD))))) -+(SETF (GET 'DRAW-DESC-FNNAME 'GLARGUMENTS) '((DD DRAW-DESC))) -+(SETF (GET 'DRAW-DESC-FNNAME 'GLFNRESULTTYPE) 'SYMBOL) -+ -+ -+(DEFUN DRAW-DESC-PICMENU (DD) -+ (LET (BUTTONS) -+ (SETQ BUTTONS -+ (MAPCAN #'(LAMBDA (OBJ) -+ (AND (EQ (FIRST OBJ) 'DRAW-BUTTON) -+ (CONS (LIST (CADDDR OBJ) -+ (LET -+ ((GLVAR136 -+ (LET -+ ((GLVAR135 -+ (COPY-LIST '(2 2)))) -+ (LIST -+ (+ (CAR GLVAR135) -+ (CAADR OBJ)) -+ (+ (CADR GLVAR135) -+ (CADADR OBJ)))))) -+ (LIST -+ (+ (CAR GLVAR136) -+ (CAR (CADDDR DD))) -+ (+ (CADR GLVAR136) -+ (CADR (CADDDR DD)))))) -+ NIL))) -+ (CADDR DD))) -+ (IF BUTTONS -+ (SETF (GET (CADR DD) 'PICMENU-SPEC) -+ (LIST 'PICMENU-SPEC (CAR (FIFTH DD)) (CADR (FIFTH DD)) -+ BUTTONS T (DRAW-DESC-FNNAME DD) '9X15))))) -+(SETF (GET 'DRAW-DESC-PICMENU 'GLARGUMENTS) '((DD DRAW-DESC))) -+(SETF (GET 'DRAW-DESC-PICMENU 'GLFNRESULTTYPE) -+ '(LIST GLTYPE INTEGER INTEGER (LISTOF (LIST ANYTHING VECTOR)) -+ BOOLEAN SYMBOL SYMBOL)) -+ -+ -+(DEFUN DRAW-DESC-SNAP (DD P) -+ (LET (PSNAP OBJ (OBJS (CADDR DD))) -+ (IF *DRAW-SNAP-FLAG* -+ (WHILE (AND OBJS (NOT PSNAP)) (SETQ OBJ (POP OBJS)) -+ (SETQ PSNAP (DRAW-OBJECT-SNAP OBJ P (CADDDR DD))))) -+ (OR PSNAP P))) -+(SETF (GET 'DRAW-DESC-SNAP 'GLARGUMENTS) '((DD DRAW-DESC) (P VECTOR))) -+(SETF (GET 'DRAW-DESC-SNAP 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN DRAW-OBJECT-MOVE (D W OFF) -+ (DRAW-OBJECT-ERASE D W OFF) -+ (DRAW-GET-OBJECT-POS D W) -+ (SETF (CADR D) -+ (LIST (- (CAADR D) (CAR OFF)) (- (CADADR D) (CADR OFF)))) -+ (DRAW-OBJECT-DRAW D W OFF) -+ (XFLUSH *WINDOW-DISPLAY*)) -+ -+(DEFUN DRAW-OBJECT-DRAW-AT (W X Y D) -+ (SETF (SECOND D) (LIST X Y)) -+ (DRAW-OBJECT-DRAW D W *DRAW-ZERO-VECTOR*)) -+ -+(DEFUN DRAW-OBJECT-DRAW (D W OFF) -+ (FUNCALL (GLMETHOD (CAR D) 'DRAW) D W OFF)) -+ -+(DEFUN DRAW-OBJECT-SNAP (D P OFF) -+ (FUNCALL (GLMETHOD (CAR D) 'SNAP) D P OFF)) -+ -+(DEFUN DRAW-OBJECT-SELECTEDP (D W OFF) -+ (FUNCALL (GLMETHOD (CAR D) 'SELECTEDP) D W OFF)) -+ -+(DEFUN DRAW-GET-OBJECT-POS (D W) -+ (WINDOW-GET-ICON-POSITION W -+ (IF (EQ (FIRST D) 'DRAW-TEXT) #'DRAW-TEXT-DRAW-OUTLINE -+ #'DRAW-OBJECT-DRAW-AT) -+ (LIST D))) -+(SETF (GET 'DRAW-GET-OBJECT-POS 'GLARGUMENTS) -+ '((D DRAW-OBJECT) (W WINDOW))) -+(SETF (GET 'DRAW-GET-OBJECT-POS 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN DRAW-OBJECT-ERASE (D W OFF) -+ (WHEN (NOT (EQ (FIRST D) 'DRAW-ERASE)) -+ (LET ((GC (CADDR W))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (LOGXOR *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 -+ *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*))))) -+ (DRAW-OBJECT-DRAW D W OFF) -+ (LET ((GC (CADDR W))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)))) -+ -+(DEFUN DRAW-LINE-DRAW (D W OFF) -+ (LET ((FROM (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D)))) -+ (TO (LET ((GLVAR137 -+ (LIST (+ (CAR OFF) (CAADR D)) -+ (+ (CADR OFF) (CADADR D))))) -+ (LIST (+ (CAR GLVAR137) (CAADDR D)) -+ (+ (CADR GLVAR137) (CADR (CADDR D))))))) -+ (LET ((QQWHEIGHT (CADDDR W))) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (CAR FROM) -+ (- QQWHEIGHT (CADR FROM)) (CAR TO) (- QQWHEIGHT (CADR TO))) -+ NIL))) -+ -+(DEFUN DRAW-ARROW-DRAW (D W OFF) -+ (LET ((FROM (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D)))) -+ (TO (LET ((GLVAR138 -+ (LIST (+ (CAR OFF) (CAADR D)) -+ (+ (CADR OFF) (CADADR D))))) -+ (LIST (+ (CAR GLVAR138) (CAADDR D)) -+ (+ (CADR GLVAR138) (CADR (CADDR D))))))) -+ (WINDOW-DRAW-ARROW-XY W (CAR FROM) (CADR FROM) (CAR TO) (CADR TO)))) -+ -+(DEFUN DRAW-LINE-SELECTEDP (D PT OFF) -+ (LET ((PTP (LIST (- (CAR PT) (CAR OFF)) (- (CADR PT) (CADR OFF))))) -+ (AND (BETWEEN (CAR PTP) (+ -2 (+ (CAADR D) (MIN 0 (CAADDR D)))) -+ (+ 2 -+ (+ (+ (CAADR D) (MIN 0 (CAADDR D))) -+ (ABS (CAADDR D))))) -+ (BETWEEN (CADR PTP) -+ (+ -2 (+ (CADADR D) (MIN 0 (CADR (CADDR D))))) -+ (+ 2 -+ (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) -+ (ABS (CADR (CADDR D)))))) -+ (< (ABS (/ (- (* (CAADDR D) (- (CADR PTP) (CADADR D))) -+ (* (CADR (CADDR D)) (- (CAR PTP) (CAADR D)))) -+ (SQRT (+ (EXPT (CAADDR D) 2) -+ (EXPT (CADR (CADDR D)) 2))))) -+ 5)))) -+(SETF (GET 'DRAW-LINE-SELECTEDP 'GLARGUMENTS) -+ '((D DRAW-LINE) (PT VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-LINE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) -+ -+ -+(DEFUN DRAW-LINE-GET (DD W) -+ (LET (FROM TO) -+ (SETQ FROM (DRAW-GET-CROSSHAIRS DD W)) -+ (SETQ TO -+ (IF *DRAW-LATEX-MODE* -+ (WINDOW-GET-LATEX-POSITION W (CAR FROM) (CADR FROM) NIL) -+ (DRAW-DESC-SNAP DD -+ (WINDOW-GET-LINE-POSITION W (CAR FROM) (CADR FROM))))) -+ (LIST 'DRAW-LINE FROM -+ (LIST (- (CAR TO) (CAR FROM)) (- (CADR TO) (CADR FROM))) NIL -+ 1))) -+(SETF (GET 'DRAW-LINE-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-LINE-GET 'GLFNRESULTTYPE) 'DRAW-LINE) -+ -+ -+(DEFUN DRAW-ARROW-GET (DD W) -+ (LET (FROM TO) -+ (SETQ FROM (DRAW-GET-CROSSHAIRS DD W)) -+ (SETQ TO -+ (IF *DRAW-LATEX-MODE* -+ (WINDOW-GET-LATEX-POSITION W (CAR FROM) (CADR FROM) NIL) -+ (DRAW-DESC-SNAP DD -+ (WINDOW-GET-LINE-POSITION W (CAR FROM) (CADR FROM))))) -+ (LIST 'DRAW-ARROW FROM -+ (LIST (- (CAR TO) (CAR FROM)) (- (CADR TO) (CADR FROM))) NIL -+ 1))) -+(SETF (GET 'DRAW-ARROW-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-ARROW-GET 'GLFNRESULTTYPE) 'DRAW-ARROW) -+ -+ -+(DEFUN DRAW-BOX-DRAW (D W OFF) -+ (LET ((GLVAR139 -+ (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D))))) -+ (WINDOW-DRAW-BOX-XY W (CAR GLVAR139) (CADR GLVAR139) (CAADDR D) -+ (CADR (CADDR D)) NIL))) -+ -+(DEFUN DRAW-BOX-SELECTEDP (D P OFF) -+ (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) -+ (OR (AND (< (CADR PT) -+ (+ 7 -+ (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) -+ (ABS (CADR (CADDR D)))))) -+ (> (CADR PT) -+ (+ -7 (+ (CADADR D) (MIN 0 (CADR (CADDR D)))))) -+ (OR (< (ABS (+ 2 -+ (- (CAR PT) -+ (+ (CAADR D) (MIN 0 (CAADDR D)))))) -+ 5) -+ (< (ABS (+ -2 -+ (- (CAR PT) -+ (+ (+ (CAADR D) (MIN 0 (CAADDR D))) -+ (ABS (CAADDR D)))))) -+ 5))) -+ (AND (< (CAR PT) -+ (+ 7 -+ (+ (+ (CAADR D) (MIN 0 (CAADDR D))) -+ (ABS (CAADDR D))))) -+ (> (CAR PT) (+ -7 (+ (CAADR D) (MIN 0 (CAADDR D))))) -+ (OR (< (ABS (+ -2 -+ (- (CADR PT) -+ (+ (+ (CADADR D) -+ (MIN 0 (CADR (CADDR D)))) -+ (ABS (CADR (CADDR D))))))) -+ 5) -+ (< (ABS (+ 2 -+ (- (CADR PT) -+ (+ (CADADR D) (MIN 0 (CADR (CADDR D))))))) -+ 5)))))) -+(SETF (GET 'DRAW-BOX-SELECTEDP 'GLARGUMENTS) -+ '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-BOX-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) -+ -+ -+(DEFUN DRAW-BOX-GET (DD W) -+ (LET (BOX) -+ (SETQ BOX (WINDOW-GET-REGION W)) -+ (LIST 'DRAW-BOX (CAR BOX) (CADR BOX) NIL 1))) -+(SETF (GET 'DRAW-BOX-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-BOX-GET 'GLFNRESULTTYPE) 'DRAW-BOX) -+ -+ -+(DEFUN DRAW-RCBOX-DRAW (D W OFF) -+ (WINDOW-DRAW-RCBOX-XY W (+ (CAR OFF) (CAADR D)) -+ (+ (CADR OFF) (CADADR D)) (CAADDR D) (CADR (CADDR D)) 8)) -+ -+(DEFUN DRAW-RCBOX-SELECTEDP (D P OFF) -+ (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) -+ (OR (AND (< (CADR PT) -+ (1- (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) -+ (ABS (CADR (CADDR D)))))) -+ (> (CADR PT) (1+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))))) -+ (OR (< (ABS (+ 2 -+ (- (CAR PT) -+ (+ (CAADR D) (MIN 0 (CAADDR D)))))) -+ 5) -+ (< (ABS (+ -2 -+ (- (CAR PT) -+ (+ (+ (CAADR D) (MIN 0 (CAADDR D))) -+ (ABS (CAADDR D)))))) -+ 5))) -+ (AND (< (CAR PT) -+ (1- (+ (+ (CAADR D) (MIN 0 (CAADDR D))) -+ (ABS (CAADDR D))))) -+ (> (CAR PT) (1+ (+ (CAADR D) (MIN 0 (CAADDR D))))) -+ (OR (< (ABS (+ -2 -+ (- (CADR PT) -+ (+ (+ (CADADR D) -+ (MIN 0 (CADR (CADDR D)))) -+ (ABS (CADR (CADDR D))))))) -+ 5) -+ (< (ABS (+ 2 -+ (- (CADR PT) -+ (+ (CADADR D) (MIN 0 (CADR (CADDR D))))))) -+ 5)))))) -+(SETF (GET 'DRAW-RCBOX-SELECTEDP 'GLARGUMENTS) -+ '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-RCBOX-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) -+ -+ -+(DEFUN DRAW-RCBOX-GET (DD W) -+ (LET (BOX) -+ (SETQ BOX (WINDOW-GET-REGION W)) -+ (LIST 'DRAW-RCBOX (CAR BOX) (CADR BOX) NIL 1))) -+(SETF (GET 'DRAW-RCBOX-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-RCBOX-GET 'GLFNRESULTTYPE) 'DRAW-RCBOX) -+ -+ -+(DEFUN DRAW-CIRCLE-DRAW (D W OFF) -+ (LET ((GLVAR142 -+ (LET ((GLVAR141 -+ (LET ((GLVAR140 -+ (LIST (* 1/2 (CAADDR D)) -+ (* 1/2 (CADR (CADDR D)))))) -+ (LIST (+ (CAADR D) (CAR GLVAR140)) -+ (+ (CADADR D) (CADR GLVAR140)))))) -+ (LIST (+ (CAR OFF) (CAR GLVAR141)) -+ (+ (CADR OFF) (CADR GLVAR141)))))) -+ (WINDOW-DRAW-CIRCLE-XY W (CAR GLVAR142) (CADR GLVAR142) -+ (* 1/2 (CAADDR D)) NIL))) -+ -+(DEFUN DRAW-CIRCLE-SELECTEDP (D P OFF) -+ (< (ABS (- (* 1/2 (CAADDR D)) -+ (LET ((SELF (LET ((GLVAR146 -+ (LET -+ ((GLVAR145 -+ (LET -+ ((GLVAR144 -+ (LIST (* 1/2 (CAADDR D)) -+ (* 1/2 (CADR (CADDR D)))))) -+ (LIST -+ (+ (CAADR D) (CAR GLVAR144)) -+ (+ (CADADR D) (CADR GLVAR144)))))) -+ (LIST (+ (CAR GLVAR145) (CAR OFF)) -+ (+ (CADR GLVAR145) (CADR OFF)))))) -+ (LIST (- (CAR GLVAR146) (CAR P)) -+ (- (CADR GLVAR146) (CADR P)))))) -+ (SQRT (+ (EXPT (CAR SELF) 2) (EXPT (CADR SELF) 2)))))) -+ 5)) -+(SETF (GET 'DRAW-CIRCLE-SELECTEDP 'GLARGUMENTS) -+ '((D DRAW-CIRCLE) (P VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-CIRCLE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) -+ -+ -+(DEFUN DRAW-CIRCLE-GET (DD W) -+ (LET (CIR CENT) -+ (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) -+ (SETQ CIR (WINDOW-GET-CIRCLE W CENT)) -+ (LIST 'DRAW-CIRCLE -+ (LIST (- (CAAR CIR) (CADR CIR)) (- (CADAR CIR) (CADR CIR))) -+ (LIST (* 2 (CADR CIR)) (* 2 (CADR CIR))) NIL 1))) -+(SETF (GET 'DRAW-CIRCLE-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-CIRCLE-GET 'GLFNRESULTTYPE) 'DRAW-CIRCLE) -+ -+ -+(DEFUN DRAW-ELLIPSE-DRAW (D W OFF) -+ (LET ((C (LET ((GLVAR148 -+ (LET ((GLVAR147 -+ (LIST (* 1/2 (CAADDR D)) -+ (* 1/2 (CADR (CADDR D)))))) -+ (LIST (+ (CAADR D) (CAR GLVAR147)) -+ (+ (CADADR D) (CADR GLVAR147)))))) -+ (LIST (+ (CAR OFF) (CAR GLVAR148)) -+ (+ (CADR OFF) (CADR GLVAR148)))))) -+ (LET ((GLVAR149 (* 1/2 (CAADDR D))) -+ (GLVAR150 (* 1/2 (CADR (CADDR D))))) -+ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) -+ (- (CAR C) GLVAR149) (- (CADDDR W) (+ (CADR C) GLVAR150)) -+ (* 2 GLVAR149) (* 2 GLVAR150) 0 23040) -+ NIL))) -+ -+(DEFUN DRAW-ELLIPSE-SELECTEDP (D P OFF) -+ (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) -+ (< (ABS (- (+ (LET ((SELF (LET ((GLVAR156 -+ (IF -+ (> (CAADDR D) (CADR (CADDR D))) -+ (LIST -+ (ROUND -+ (- -+ (+ (CAADR D) -+ (* 1/2 (CAADDR D))) -+ (SQRT -+ (ABS -+ (* 1/4 -+ (- (EXPT (CAADDR D) 2) -+ (EXPT (CADR (CADDR D)) 2))))))) -+ (+ (CADADR D) -+ (* 1/2 (CADR (CADDR D))))) -+ (LIST -+ (+ (CAADR D) (* 1/2 (CAADDR D))) -+ (ROUND -+ (- -+ (+ (CADADR D) -+ (* 1/2 (CADR (CADDR D)))) -+ (SQRT -+ (ABS -+ (* 1/4 -+ (- (EXPT (CAADDR D) 2) -+ (EXPT (CADR (CADDR D)) 2))))))))))) -+ (LIST (- (CAR GLVAR156) (CAR PT)) -+ (- (CADR GLVAR156) (CADR PT)))))) -+ (SQRT (+ (EXPT (CAR SELF) 2) (EXPT (CADR SELF) 2)))) -+ (LET ((SELF (LET ((GLVAR161 -+ (IF -+ (> (CAADDR D) (CADR (CADDR D))) -+ (LIST -+ (ROUND -+ (+ -+ (+ (CAADR D) -+ (* 1/2 (CAADDR D))) -+ (SQRT -+ (ABS -+ (* 1/4 -+ (- (EXPT (CAADDR D) 2) -+ (EXPT (CADR (CADDR D)) 2))))))) -+ (+ (CADADR D) -+ (* 1/2 (CADR (CADDR D))))) -+ (LIST -+ (+ (CAADR D) (* 1/2 (CAADDR D))) -+ (ROUND -+ (+ -+ (+ (CADADR D) -+ (* 1/2 (CADR (CADDR D)))) -+ (SQRT -+ (ABS -+ (* 1/4 -+ (- (EXPT (CAADDR D) 2) -+ (EXPT (CADR (CADDR D)) 2))))))))))) -+ (LIST (- (CAR GLVAR161) (CAR PT)) -+ (- (CADR GLVAR161) (CADR PT)))))) -+ (SQRT (+ (EXPT (CAR SELF) 2) (EXPT (CADR SELF) 2))))) -+ (* 2 (MAX (* 1/2 (CAADDR D)) (* 1/2 (CADR (CADDR D))))))) -+ 2))) -+(SETF (GET 'DRAW-ELLIPSE-SELECTEDP 'GLARGUMENTS) -+ '((D DRAW-ELLIPSE) (P VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-ELLIPSE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) -+ -+ -+(DEFUN DRAW-TEST-ELLIPSE-SELECTEDP (E) -+ (LET ((SIZE (THIRD E)) (OFFSET (SECOND E))) -+ (DOTIMES (Y (+ (CADR SIZE) 10)) -+ (DOTIMES (X (+ (CAR SIZE) 10)) -+ (PRINC (IF (DRAW-ELLIPSE-SELECTEDP E -+ (LIST (+ X (CAR OFFSET) -5) -+ (+ Y (CADR OFFSET) -5)) -+ (LIST 0 0)) -+ "T" " "))) -+ (TERPRI)))) -+ -+(DEFUN DRAW-ELLIPSE-GET (DD W) -+ (LET (ELL CENT) -+ (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) -+ (SETQ ELL (WINDOW-GET-ELLIPSE W CENT)) -+ (LIST 'DRAW-ELLIPSE -+ (LIST (- (CAAR ELL) (CAADR ELL)) -+ (- (CADAR ELL) (CADADR ELL))) -+ (LIST (* 2 (CAADR ELL)) (* 2 (CADADR ELL))) NIL 1))) -+(SETF (GET 'DRAW-ELLIPSE-GET 'GLARGUMENTS) -+ '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-ELLIPSE-GET 'GLFNRESULTTYPE) 'DRAW-ELLIPSE) -+ -+ -+(DEFUN DRAW-NULL-DRAW (D W OFF) NIL) -+ -+(DEFUN DRAW-NULL-SELECTEDP (D PT OFF) NIL) -+ -+(DEFUN DRAW-BUTTON-DRAW (D W OFF) -+ (LET ((GLVAR162 -+ (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D)))) -+ (GLVAR163 (COPY-LIST '(4 4)))) -+ (WINDOW-DRAW-BOX-XY W (CAR GLVAR162) (CADR GLVAR162) (CAR GLVAR163) -+ (CADR GLVAR163) NIL))) -+ -+(DEFUN DRAW-BUTTON-SELECTEDP (D P OFF) -+ (LET ((PTX (- (- (CAR P) (CAR OFF)) (CAADR D))) -+ (PTY (- (- (CADR P) (CADR OFF)) (CADADR D)))) -+ (AND (> PTX -2) (< PTX 6) (> PTY -2) (< PTY 6)))) -+(SETF (GET 'DRAW-BUTTON-SELECTEDP 'GLARGUMENTS) -+ '((D DRAW-BUTTON) (P VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-BUTTON-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) -+ -+ -+(DEFUN DRAW-BUTTON-GET (DD W) -+ (LET (CENT VAR) -+ (PRINC "Enter button name: ") -+ (SETQ VAR (READ)) -+ (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) -+ (LIST 'DRAW-BUTTON (LIST (+ -2 (CAR CENT)) (+ -2 (CADR CENT))) -+ (COPY-LIST '(4 4)) VAR 1))) -+(SETF (GET 'DRAW-BUTTON-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-BUTTON-GET 'GLFNRESULTTYPE) 'DRAW-BUTTON) -+ -+ -+(DEFUN DRAW-ERASE-DRAW (D W OFF) -+ (LET ((GLVAR164 -+ (LIST (+ (CAR OFF) (CAADR D)) (+ (CADR OFF) (CADADR D))))) -+ (WINDOW-ERASE-AREA-XY W (CAR GLVAR164) (CADR GLVAR164) (CAADDR D) -+ (CADR (CADDR D))))) -+ -+(DEFUN DRAW-ERASE-SELECTEDP (D P OFF) -+ (LET ((PT (LIST (- (CAR P) (CAR OFF)) (- (CADR P) (CADR OFF))))) -+ (AND (BETWEEN (CAR PT) (CAADR D) (+ (CAADR D) (CAADDR D))) -+ (BETWEEN (CADR PT) (CADADR D) (+ (CADADR D) (CADR (CADDR D))))))) -+(SETF (GET 'DRAW-ERASE-SELECTEDP 'GLARGUMENTS) -+ '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-ERASE-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) -+ -+ -+(DEFUN DRAW-ERASE-GET (DD W) -+ (LET (BOX) -+ (SETQ BOX (WINDOW-GET-REGION W)) -+ (LIST 'DRAW-ERASE (CAR BOX) (CADR BOX) NIL 1))) -+(SETF (GET 'DRAW-ERASE-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-ERASE-GET 'GLFNRESULTTYPE) 'DRAW-ERASE) -+ -+ -+(DEFUN DRAW-DOT-DRAW (D W OFF) -+ (WINDOW-DRAW-DOT-XY W (+ 2 (+ (CAR OFF) (CAADR D))) -+ (+ 2 (+ (CADR OFF) (CADADR D))))) -+ -+(DEFUN DRAW-DOT-GET (DD W) -+ (LET (CENT) -+ (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) -+ (LIST 'DRAW-DOT (LIST (+ -2 (CAR CENT)) (+ -2 (CADR CENT))) -+ (COPY-LIST '(4 4)) NIL 1))) -+(SETF (GET 'DRAW-DOT-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-DOT-GET 'GLFNRESULTTYPE) 'DRAW-DOT) -+ -+ -+(DEFUN DRAW-REFPT-DRAW (D W OFF) -+ (WINDOW-DRAW-CROSSHAIRS-XY W (+ (CAR OFF) (CAADR D)) -+ (+ (CADR OFF) (CADADR D)))) -+ -+(DEFUN DRAW-REFPT-SELECTEDP (D P OFF) -+ (LET ((PTX (- (- (CAR P) (CAR OFF)) (CAADR D))) -+ (PTY (- (- (CADR P) (CADR OFF)) (CADADR D)))) -+ (AND (> PTX -3) (< PTX 3) (> PTY -3) (< PTY 3)))) -+(SETF (GET 'DRAW-REFPT-SELECTEDP 'GLARGUMENTS) -+ '((D DRAW-BUTTON) (P VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-REFPT-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) -+ -+ -+(DEFUN DRAW-REFPT-GET (DD W) -+ (LET (CENT REFPT) -+ (WHEN (SETQ REFPT (ASSOC 'DRAW-REFPT (CADDR DD))) -+ (LET ((GC (CADDR *DRAW-WINDOW*))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR *DRAW-WINDOW*) 1 -+ *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 3) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR *DRAW-WINDOW*) 4 -+ *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR *DRAW-WINDOW*) 8 -+ *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*)))) -+ (DRAW-OBJECT-DRAW REFPT *DRAW-WINDOW* (COPY-LIST '(0 0))) -+ (LET ((GC (CADDR *DRAW-WINDOW*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*)) -+ (SETF (CADDR DD) (REMOVE REFPT (CADDR DD)))) -+ (SETQ CENT (DRAW-GET-CROSSHAIRS DD W)) -+ (LIST 'DRAW-REFPT CENT (COPY-LIST '(0 0)) NIL 1))) -+(SETF (GET 'DRAW-REFPT-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-REFPT-GET 'GLFNRESULTTYPE) 'DRAW-REFPT) -+ -+ -+(DEFUN DRAW-DESC-REFPT (DD) -+ (LET (REFPT) -+ (SETQ REFPT (ASSOC 'DRAW-REFPT (CADDR DD))) -+ (IF REFPT (CADR REFPT) (COPY-LIST '(0 0))))) -+(SETF (GET 'DRAW-DESC-REFPT 'GLARGUMENTS) '((DD DRAW-DESC))) -+(SETF (GET 'DRAW-DESC-REFPT 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN DRAW-TEXT-DRAW (D W OFF) -+ (LET ((SSTR (STRINGIFY (CADDDR D)))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) -+ (+ (CAR OFF) (CAADR D)) -+ (- (CADDDR W) (+ (CADR OFF) (CADADR D))) (GET-C-STRING SSTR) -+ (LENGTH SSTR)))) -+ -+(DEFUN DRAW-TEXT-DRAW-OUTLINE (W X Y D) -+ (SETF (SECOND D) (LIST X Y)) -+ (WINDOW-DRAW-BOX-XY W X (+ 2 Y) (CAADDR D) (CADR (CADDR D)))) -+ -+(DEFUN DRAW-TEXT-DRAW-OUTLINE (W X Y D) -+ (SETF (SECOND D) (LIST X Y)) -+ (WINDOW-DRAW-BOX-XY W X (+ 2 Y) (CAADDR D) (CADR (CADDR D)))) -+ -+(DEFUN DRAW-TEXT-SELECTEDP (D PT OFF) -+ (LET ((PTP (LIST (- (CAR PT) (CAR OFF)) (- (CADR PT) (CADR OFF))))) -+ (AND (BETWEEN (CAR PTP) (+ -2 (+ (CAADR D) (MIN 0 (CAADDR D)))) -+ (+ 2 -+ (+ (+ (CAADR D) (MIN 0 (CAADDR D))) -+ (ABS (CAADDR D))))) -+ (BETWEEN (CADR PTP) -+ (+ -2 (+ (CADADR D) (MIN 0 (CADR (CADDR D))))) -+ (+ 2 -+ (+ (+ (CADADR D) (MIN 0 (CADR (CADDR D)))) -+ (ABS (CADR (CADDR D))))))))) -+(SETF (GET 'DRAW-TEXT-SELECTEDP 'GLARGUMENTS) -+ '((D DRAW-TEXT) (PT VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-TEXT-SELECTEDP 'GLFNRESULTTYPE) 'BOOLEAN) -+ -+ -+(DEFUN DRAW-TEXT-GET (DD W) -+ (LET (TXT LNG OFF) -+ (PRINC "Enter text string: ") -+ (SETQ TXT (STRINGIFY (READ))) -+ (SETQ LNG -+ (LET ((SSTR (STRINGIFY TXT))) -+ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) -+ (SETQ OFF (WINDOW-GET-BOX-POSITION W LNG 14)) -+ (LIST 'DRAW-TEXT -+ (LET ((GLVAR167 (COPY-LIST '(0 4)))) -+ (LIST (+ (CAR OFF) (CAR GLVAR167)) -+ (+ (CADR OFF) (CADR GLVAR167)))) -+ (LIST LNG 14) TXT 1))) -+(SETF (GET 'DRAW-TEXT-GET 'GLARGUMENTS) '((DD DRAW-DESC) (W WINDOW))) -+(SETF (GET 'DRAW-TEXT-GET 'GLFNRESULTTYPE) 'DRAW-TEXT) -+ -+ -+(DEFUN DRAW-SNAPP (P1 OFF P2X P2Y) -+ (IF (AND (< (ABS (- (- (CAR P1) (CAR OFF)) P2X)) 4) -+ (< (ABS (- (- (CADR P1) (CADR OFF)) P2Y)) 4)) -+ (LIST (+ (CAR OFF) P2X) (+ (CADR OFF) P2Y)))) -+(SETF (GET 'DRAW-SNAPP 'GLARGUMENTS) -+ '((P1 VECTOR) (OFF VECTOR) (P2X INTEGER) (P2Y INTEGER))) -+(SETF (GET 'DRAW-SNAPP 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN DRAW-DOT-SNAP (D P OFF) -+ (DRAW-SNAPP P OFF (+ 2 (CAADR D)) (+ 2 (CADADR D)))) -+(SETF (GET 'DRAW-DOT-SNAP 'GLARGUMENTS) -+ '((D DRAW-DOT) (P VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-DOT-SNAP 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN DRAW-REFPT-SNAP (D P OFF) -+ (DRAW-SNAPP P OFF (CAADR D) (CADADR D))) -+(SETF (GET 'DRAW-REFPT-SNAP 'GLARGUMENTS) -+ '((D DRAW-REFPT) (P VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-REFPT-SNAP 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN DRAW-LINE-SNAP (D P OFF) -+ (OR (DRAW-SNAPP P OFF (CAADR D) (CADADR D)) -+ (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) -+ (+ (CADADR D) (CADR (CADDR D)))))) -+(SETF (GET 'DRAW-LINE-SNAP 'GLARGUMENTS) -+ '((D DRAW-LINE) (P VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-LINE-SNAP 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN DRAW-BOX-SNAP (D P OFF) -+ (LET ((XOFF (CAADR D)) (YOFF (CADADR D)) (XSIZE (CAADDR D)) -+ (YSIZE (CADR (CADDR D)))) -+ (OR (DRAW-SNAPP P OFF XOFF YOFF) -+ (DRAW-SNAPP P OFF (+ XOFF XSIZE) (+ YOFF YSIZE)) -+ (DRAW-SNAPP P OFF (+ XOFF XSIZE) YOFF) -+ (DRAW-SNAPP P OFF XOFF (+ YOFF YSIZE)) -+ (DRAW-SNAPP P OFF (+ XOFF (* 1/2 XSIZE)) YOFF) -+ (DRAW-SNAPP P OFF XOFF (+ YOFF (* 1/2 YSIZE))) -+ (DRAW-SNAPP P OFF (+ XOFF (* 1/2 XSIZE)) (+ YOFF YSIZE)) -+ (DRAW-SNAPP P OFF (+ XOFF XSIZE) (+ YOFF (* 1/2 YSIZE)))))) -+(SETF (GET 'DRAW-BOX-SNAP 'GLARGUMENTS) -+ '((D DRAW-BOX) (P VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-BOX-SNAP 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN DRAW-CIRCLE-SNAP (D P OFF) -+ (OR (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) -+ (+ (CADADR D) (* 1/2 (CAADDR D)))) -+ (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) (CADADR D)) -+ (DRAW-SNAPP P OFF (CAADR D) (+ (CADADR D) (* 1/2 (CAADDR D)))) -+ (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) -+ (+ (CADADR D) (CADR (CADDR D)))) -+ (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) -+ (+ (CADADR D) (* 1/2 (CAADDR D)))))) -+(SETF (GET 'DRAW-CIRCLE-SNAP 'GLARGUMENTS) -+ '((D DRAW-CIRCLE) (P VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-CIRCLE-SNAP 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN DRAW-ELLIPSE-SNAP (D P OFF) -+ (OR (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) -+ (+ (CADADR D) (* 1/2 (CADR (CADDR D))))) -+ (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) (CADADR D)) -+ (DRAW-SNAPP P OFF (CAADR D) -+ (+ (CADADR D) (* 1/2 (CADR (CADDR D))))) -+ (DRAW-SNAPP P OFF (+ (CAADR D) (* 1/2 (CAADDR D))) -+ (+ (CADADR D) (CADR (CADDR D)))) -+ (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) -+ (+ (CADADR D) (* 1/2 (CADR (CADDR D))))))) -+(SETF (GET 'DRAW-ELLIPSE-SNAP 'GLARGUMENTS) -+ '((D DRAW-ELLIPSE) (P VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-ELLIPSE-SNAP 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN DRAW-RCBOX-SNAP (D P OFF) -+ (LET ((RX (* 1/2 (CAADDR D))) (RY (* 1/2 (CADR (CADDR D))))) -+ (OR (DRAW-SNAPP P OFF (+ (CAADR D) RX) (CADADR D)) -+ (DRAW-SNAPP P OFF (CAADR D) (+ (CADADR D) RY)) -+ (DRAW-SNAPP P OFF (+ (CAADR D) RX) -+ (+ (CADADR D) (CADR (CADDR D)))) -+ (DRAW-SNAPP P OFF (+ (CAADR D) (CAADDR D)) (+ (CADADR D) RY))))) -+(SETF (GET 'DRAW-RCBOX-SNAP 'GLARGUMENTS) -+ '((D DRAW-RCBOX) (P VECTOR) (OFF VECTOR))) -+(SETF (GET 'DRAW-RCBOX-SNAP 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN DRAW-NO-SNAP (D P OFF) NIL) -+ -+(DEFUN DRAW-MULTI-DRAW (D W OFF) -+ (LET ((TOTALOFF -+ (LIST (+ (CAADR D) (CAR OFF)) (+ (CADADR D) (CADR OFF))))) -+ (DOLIST (SUBD (CADDDR D)) (DRAW-OBJECT-DRAW SUBD W TOTALOFF)))) -+ -+(DEFUN DRAW-INIT-MENUS () -+ (LET ((W (DRAW-WINDOW))) -+ (WINDOW-CLEAR W) -+ (DOLIST (FN '(DRAW-MENU-RECTANGLE DRAW-MENU-CIRCLE -+ DRAW-MENU-ELLIPSE DRAW-MENU-LINE DRAW-MENU-ARROW -+ DRAW-MENU-DOT DRAW-MENU-BUTTON DRAW-MENU-TEXT)) -+ (SETF (GET FN 'DISPLAY-SIZE) '(30 20))) -+ (SETQ *DRAW-MENU-SET* (MENU-SET-CREATE W NIL)) -+ (MENU-SET-ADD-MENU *DRAW-MENU-SET* 'DRAW NIL "Draw" -+ '((DRAW-MENU-RECTANGLE . RECTANGLE) (DRAW-MENU-RCBOX . RCBOX) -+ (DRAW-MENU-CIRCLE . CIRCLE) (DRAW-MENU-ELLIPSE . ELLIPSE) -+ (DRAW-MENU-LINE . LINE) (DRAW-MENU-ARROW . ARROW) -+ (DRAW-MENU-DOT . DOT) (" " . ERASE) -+ (DRAW-MENU-BUTTON . BUTTON) (DRAW-MENU-TEXT . TEXT) -+ (DRAW-MENU-REFPT . REFPT)) -+ (LIST 0 0)) -+ (MENU-SET-ADJUST *DRAW-MENU-SET* 'DRAW 'TOP NIL 1) -+ (MENU-SET-ADJUST *DRAW-MENU-SET* 'DRAW 'RIGHT NIL 2) -+ (MENU-SET-ADD-MENU *DRAW-MENU-SET* 'COMMAND NIL "Commands" -+ '(("Done" . DONE) ("Move" . MOVE) ("Delete" . DELETE) -+ ("Copy" . COPY) ("Redraw" . REDRAW) ("Origin" . ORIGIN) -+ ("LaTex Mode" . LATEXMODE) ("Make Program" . PROGRAM) -+ ("Make LaTex" . LATEX)) -+ (LIST 0 0)) -+ (MENU-SET-ADJUST *DRAW-MENU-SET* 'COMMAND 'TOP 'DRAW 5) -+ (MENU-SET-ADJUST *DRAW-MENU-SET* 'COMMAND 'RIGHT NIL 2))) -+ -+(DEFUN DRAW-MENU-RECTANGLE (W X Y) -+ (WINDOW-DRAW-BOX-XY W (+ X 3) (+ Y 3) 24 14 1)) -+ -+(DEFUN DRAW-MENU-RCBOX (W X Y) -+ (WINDOW-DRAW-RCBOX-XY W (+ X 3) (+ Y 3) 24 14 3 1)) -+ -+(DEFUN DRAW-MENU-CIRCLE (W X Y) -+ (WINDOW-DRAW-CIRCLE-XY W (+ X 15) (+ Y 10) 8 1)) -+ -+(DEFUN DRAW-MENU-ELLIPSE (W X Y) -+ (WINDOW-DRAW-ELLIPSE-XY W (+ X 15) (+ Y 10) 12 8 1)) -+ -+(DEFUN DRAW-MENU-LINE (W X Y) -+ (WINDOW-DRAW-LINE-XY W (+ X 4) (+ Y 4) (+ X 26) (+ Y 16) 1)) -+ -+(DEFUN DRAW-MENU-ARROW (W X Y) -+ (WINDOW-DRAW-ARROW-XY W (+ X 4) (+ Y 4) (+ X 26) (+ Y 16) 1)) -+ -+(DEFUN DRAW-MENU-DOT (W X Y) (WINDOW-DRAW-DOT-XY W (+ X 15) (+ Y 10))) -+ -+(DEFUN DRAW-MENU-BUTTON (W X Y) -+ (WINDOW-DRAW-BOX-XY W (+ X 14) (+ Y 5) 4 4 1)) -+ -+(DEFUN DRAW-MENU-TEXT (W X Y) -+ (WINDOW-PRINTAT-XY W "A" (+ X 12) (+ Y 5))) -+ -+(DEFUN DRAW-MENU-REFPT (W X Y) -+ (WINDOW-DRAW-CROSSHAIRS-XY W (+ X 15) (+ Y 9)) -+ (WINDOW-DRAW-CIRCLE-XY W (+ X 15) (+ Y 9) 2)) -+ -+(DEFUN LATEX-LINE (FROMX FROMY X Y &OPTIONAL ARROWFLG) -+ (LET (DX DY SX SY SIZ ERR ERRB) -+ (SETQ DX (- X FROMX)) -+ (SETQ DY (- Y FROMY)) -+ (IF (= DX 0) -+ (PROGN -+ (SETQ SX 0) -+ (SETQ SY (IF (>= DY 0) 1 -1)) -+ (SETQ SIZ (* (ABS DY) *DRAW-LATEX-FACTOR*))) -+ (IF (= DY 0) -+ (PROGN -+ (SETQ SX (IF (>= DX 0) 1 -1)) -+ (SETQ SY 0) -+ (SETQ SIZ (* (ABS DX) *DRAW-LATEX-FACTOR*))) -+ (PROGN -+ (SETQ ERR 9999) -+ (SETQ SIZ (* (ABS DX) *DRAW-LATEX-FACTOR*)) -+ (DOTIMES (I (IF ARROWFLG 4 6)) -+ (DOTIMES (J (IF ARROWFLG 4 6)) -+ (SETQ ERRB -+ (ABS (- (/ (FLOAT (1+ I)) (FLOAT (1+ J))) -+ (ABS (/ (FLOAT DX) (FLOAT DY)))))) -+ (IF (AND (= (GCD (1+ I) (1+ J)) 1) (< ERRB ERR)) -+ (PROGN -+ (SETQ ERR ERRB) -+ (SETQ SX (1+ I)) -+ (SETQ SY (1+ J)))))) -+ (SETQ SX (* SX (LATEX-SIGN DX))) -+ (SETQ SY (* SY (LATEX-SIGN DY)))))) -+ (FORMAT T " \\put(~5,0F,~5,0F) {\\~A(~D,~D){~5,0F}}~%" -+ (* FROMX *DRAW-LATEX-FACTOR*) (* FROMY *DRAW-LATEX-FACTOR*) -+ (IF ARROWFLG "vector" "line") SX SY SIZ))) -+ -+(DEFUN LATEX-SIGN (X) (IF (>= X 0) 1 -1)) -+ -+(DEFUN DRAW-OUTPUT (OUTFILENAME &OPTIONAL NAMES) -+ (PROG (PRETTYSAVE LENGTHSAVE D FNNAME CODE) -+ (OR NAMES (SETQ NAMES *DRAW-OBJECTS*)) -+ (IF (SYMBOLP NAMES) (SETQ NAMES (LIST NAMES))) -+ (WITH-OPEN-FILE -+ (OUTFILE OUTFILENAME :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE) -+ (SETQ PRETTYSAVE *PRINT-PRETTY*) -+ (SETQ LENGTHSAVE *PRINT-LENGTH*) -+ (SETQ *PRINT-PRETTY* T) -+ (SETQ *PRINT-LENGTH* 80) -+ (FORMAT OUTFILE "; ~A ~A~%" OUTFILENAME (DRAW-GET-TIME-STRING)) -+ (DOLIST (NAME NAMES) -+ (IF (SETQ D (GET NAME 'DRAW-DESCR)) -+ (PROGN -+ (TERPRI OUTFILE) -+ (PRINT (LIST 'SETF -+ (LIST 'GET (LIST 'QUOTE NAME) ''DRAW-DESCR) -+ (LIST 'QUOTE D)) -+ OUTFILE) -+ (IF (AND (SETQ FNNAME (DRAW-DESC-FNNAME D)) -+ (SETQ CODE (SYMBOL-FUNCTION FNNAME))) -+ (PROGN -+ (TERPRI OUTFILE) -+ (PRINT (CONS 'DEFUN -+ (IF (EQ (CAR CODE) 'LAMBDA-BLOCK) -+ (CDR CODE) -+ (CONS FNNAME (CDR CODE)))) -+ OUTFILE))))) -+ (IF (SETQ D (GET NAME 'PICMENU-SPEC)) -+ (PROGN -+ (TERPRI OUTFILE) -+ (PRINT (LIST 'SETF -+ (LIST 'GET (LIST 'QUOTE NAME) -+ ''PICMENU-SPEC) -+ (LIST 'QUOTE D)) -+ OUTFILE)))) -+ (TERPRI OUTFILE) -+ (SETQ *PRINT-PRETTY* PRETTYSAVE) -+ (SETQ *PRINT-LENGTH* LENGTHSAVE)) -+ (RETURN OUTFILENAME))) -+ -+(DEFUN DRAW-GET-TIME-STRING () -+ (LET (SECOND MINUTE HOUR DATE MONTH YEAR) -+ (MULTIPLE-VALUE-SETQ (SECOND MINUTE HOUR DATE MONTH YEAR) -+ (GET-DECODED-TIME)) -+ (FORMAT NIL "~2D ~A ~4D ~2D:~2D:~2D" DATE -+ (NTH (1- MONTH) -+ '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" -+ "Sep" "Oct" "Nov" "Dec")) -+ YEAR HOUR MINUTE SECOND))) -+ -+(DEFUN COMPILE-DRAW () -+ (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") -+ '("glisp/menu-set.lsp" "glisp/draw.lsp") "glisp/drawtrans.lsp" -+ "glisp/draw-header.lsp") -+ (CF DRAWTRANS)) -+ -+(DEFUN COMPILE-DRAWB () -+ (GLCOMPFILES *DIRECTORY* -+ '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") -+ '("glisp/menu-set.lsp" "glisp/draw.lsp") "glisp/drawtrans.lsp" -+ "glisp/draw-header.lsp")) -+ -+(DEFUN DRAW-OUT (&OPTIONAL NAMES FILE) -+ (OR NAMES (SETQ NAMES *DRAW-OBJECTS*)) -+ (IF (NOT (CONSP NAMES)) (SETQ NAMES (LIST NAMES))) -+ (DRAW-OUTPUT (OR FILE "glisp/draw.del") NAMES) -+ (SETQ *DRAW-OBJECTS* (SET-DIFFERENCE *DRAW-OBJECTS* NAMES)) -+ NAMES) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_editorstrans.lsp -@@ -0,0 +1,589 @@ -+; 07 Jan 2010 16:43:40 EST -+; This program 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 program 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 program; if not, see . -+ -+ -+(DEFUN EDIT-THERMOM (NUM W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) -+ (PROG (NMIN NDEL NDIV RANGE PTEN DRANGE PAIR NEWW (RES NUM) OFF) -+ (WHEN (NOT SIZEX) (SETQ SIZEX 150) (SETQ SIZEY 250)) -+ (WHEN (NOT OFFSETX) -+ (SETQ OFF -+ (LET ((GLVAR168 (LIST SIZEX SIZEY))) -+ (LIST (TRUNCATE (- (FIFTH W) (CAR GLVAR168)) 2) -+ (TRUNCATE (- (CADDDR W) (CADR GLVAR168)) 2)))) -+ (SETQ OFFSETX (CAR OFF)) -+ (SETQ OFFSETY (CADR OFF))) -+ (SETQ NEWW -+ (WINDOW-CREATE SIZEX SIZEY NIL (CADR W) OFFSETX OFFSETY)) -+ (WINDOW-DRAW-BUTTON NEWW "Typein" 80 20 50 25) -+ (WINDOW-DRAW-BUTTON NEWW "Adjust" 80 70 50 25) -+ (WINDOW-DRAW-BUTTON NEWW "Done" 80 120 50 25) -+ RN -+ (SETQ RANGE (* 2 (ABS RES))) -+ (IF (ZEROP RANGE) (SETQ RANGE 50)) -+ (IF (AND (< RANGE 8) (INTEGERP NUM)) (SETQ RANGE 10)) -+ (SETQ PTEN (EXPT 10 (TRUNCATE (LOG RANGE 10)))) -+ (SETQ DRANGE (/ (* 10 RANGE) PTEN)) -+ (SETQ PAIR -+ (CAR (SOME #'(LAMBDA (X) (> (CAR X) DRANGE)) -+ '((14 2) (20 4) (40 5) (70 10) (101 20))))) -+ (SETQ NDEL (* 1/10 (* (CADR PAIR) PTEN))) -+ (SETQ NDIV (CEILING (/ RANGE NDEL))) -+ (SETQ NMIN (IF (>= RES 0) 0 (- (* NDEL NDIV)))) -+ (WINDOW-DRAW-THERMOMETER NEWW NMIN NDEL NDIV RES 10 10 -+ (+ -20 SIZEY)) -+ LP -+ (CASE (BUTTON-SELECT NEWW -+ '((DONE (84 124) (42 17)) (ADJUST (84 74) (42 17)) -+ (TYPEIN (84 24) (42 17)))) -+ (DONE (XDESTROYWINDOW *WINDOW-DISPLAY* (CADR NEWW)) -+ (XFLUSH *WINDOW-DISPLAY*) (SETF (CADR NEWW) NIL) -+ (XFREEGC *WINDOW-DISPLAY* (CADDR NEWW)) -+ (SETF (CADDR NEWW) NIL) (RETURN RES)) -+ (ADJUST (SETQ RES -+ (WINDOW-ADJUST-THERMOMETER NEWW NMIN NDEL NDIV RES -+ 10 10 (+ -20 SIZEY))) -+ (GO LP)) -+ (TYPEIN (PRINC "Enter new value: ") (SETQ RES (READ)) -+ (IF (AND (>= RES NMIN) (<= RES (+ NMIN (* NDEL NDIV)))) -+ (PROGN -+ (WINDOW-SET-THERMOMETER NEWW NMIN NDEL NDIV RES 10 -+ 10 (+ -20 SIZEY)) -+ (GO LP)) -+ (GO RN)))))) -+(SETF (GET 'EDIT-THERMOM 'GLARGUMENTS) -+ '((NUM NUMBER) (W WINDOW) (&OPTIONAL INTEGER) (OFFSETX INTEGER) -+ (OFFSETY INTEGER) (SIZEX INTEGER))) -+(SETF (GET 'EDIT-THERMOM 'GLFNRESULTTYPE) 'NUMBER) -+ -+ -+(DEFUN WINDOW-DRAW-BUTTON (W S OFFSETX OFFSETY SIZEX SIZEY) -+ (LET (SW) -+ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX -+ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) -+ (WINDOW-DRAW-RCBOX-XY W OFFSETX OFFSETY SIZEX SIZEY 8) -+ (SETQ SW -+ (LET ((SSTR (STRINGIFY S))) -+ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) -+ (LET ((SSTR (STRINGIFY S))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) -+ (+ OFFSETX (* 1/2 (- SIZEX SW))) -+ (+ -8 (- (CADDDR W) OFFSETY)) (GET-C-STRING SSTR) -+ (LENGTH SSTR))) -+ (XFLUSH *WINDOW-DISPLAY*))) -+ -+(DEFUN WINDOW-CENTER-PRINT (W S OFFSETX OFFSETY SIZEX SIZEY) -+ (LET (SW) -+ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX -+ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) -+ (SETQ SW -+ (LET ((SSTR (STRINGIFY S))) -+ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) -+ (LET ((SSTR (STRINGIFY S))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) -+ (+ OFFSETX (* 1/2 (- SIZEX SW))) -+ (- (CADDDR W) (+ OFFSETY (+ -5 (* 1/2 SIZEY)))) -+ (GET-C-STRING SSTR) (LENGTH SSTR))) -+ (XFLUSH *WINDOW-DISPLAY*))) -+ -+(DEFUN WINDOW-DRAW-THERMOMETER -+ (W NMIN NDEL NDIV VAL OFFSETX OFFSETY SIZEY) -+ (LET (HDEL MARKY) -+ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX -+ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) 66 SIZEY 0) -+ (EDITORS-PRINT-IN-BOX VAL W OFFSETX OFFSETY 40 20) -+ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) OFFSETX -+ (+ -48 (- (CADDDR W) OFFSETY)) 24 24 8448 17664) -+ (LET ((QQWHEIGHT (CADDDR W))) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) -+ (+ -44 (- QQWHEIGHT OFFSETY)) (+ 4 OFFSETX) -+ (+ 8 (- QQWHEIGHT (+ OFFSETY SIZEY))))) -+ (LET ((QQWHEIGHT (CADDDR W))) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 20 OFFSETX) -+ (+ -44 (- QQWHEIGHT OFFSETY)) (+ 20 OFFSETX) -+ (+ 8 (- QQWHEIGHT (+ OFFSETY SIZEY))))) -+ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) -+ (- (CADDDR W) (+ OFFSETY SIZEY)) 16 16 0 11520) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 1 0) -+ (XDRAWARC *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 8 OFFSETX) -+ (+ -40 (- (CADDDR W) OFFSETY)) 8 8 0 23040) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0) -+ (SETQ HDEL (/ (+ -56 SIZEY) NDIV)) -+ (LET ((QQWHEIGHT (CADDDR W))) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 1 0) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 12 OFFSETX) -+ (+ -35 (- QQWHEIGHT OFFSETY)) (+ 12 OFFSETX) -+ (- QQWHEIGHT -+ (+ (+ 48 OFFSETY) (* HDEL (/ (- VAL NMIN) NDEL))))) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) -+ (DOTIMES (I (1+ NDIV)) -+ (SETQ MARKY (+ (+ 48 OFFSETY) (* I HDEL))) -+ (LET ((QQWHEIGHT (CADDDR W))) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 24 OFFSETX) -+ (- QQWHEIGHT MARKY) (+ 34 OFFSETX) (- QQWHEIGHT MARKY)) -+ NIL) -+ (LET ((SSTR (STRINGIFY (+ NMIN (* I NDEL))))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) -+ (+ 36 OFFSETX) (+ 6 (- (CADDDR W) MARKY)) -+ (GET-C-STRING SSTR) (LENGTH SSTR)))) -+ (XFLUSH *WINDOW-DISPLAY*))) -+ -+(DEFUN WINDOW-SET-THERMOMETER -+ (W NMIN NDEL NDIV VAL OFFSETX OFFSETY SIZEY) -+ (LET (HDEL) -+ (SETQ HDEL (/ (+ -56 SIZEY) NDIV)) -+ (LET ((GLVAR204 (+ -56 SIZEY))) -+ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) (+ 7 OFFSETX) -+ (- (CADDDR W) (1- (+ (+ 48 OFFSETY) GLVAR204))) 10 GLVAR204 -+ 0)) -+ (LET ((QQWHEIGHT (CADDDR W))) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 1 0) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 12 OFFSETX) -+ (+ -35 (- QQWHEIGHT OFFSETY)) (+ 12 OFFSETX) -+ (- QQWHEIGHT -+ (+ (+ 48 OFFSETY) (* HDEL (/ (- VAL NMIN) NDEL))))) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)) -+ (EDITORS-UPDATE-IN-BOX VAL W OFFSETX OFFSETY 40 20))) -+ -+(DEFUN WINDOW-ADJUST-THERMOMETER -+ (W NMIN NDEL NDIV VAL OFFSETX OFFSETY SIZEY) -+ (LET (HDEL LASTY XMIN XMAX YMIN YMAX INSIDE NEWVAL) -+ (SETQ HDEL (/ (+ -56 SIZEY) NDIV)) -+ (SETQ LASTY -+ (TRUNCATE (+ (+ 48 OFFSETY) (* HDEL (/ (- VAL NMIN) NDEL))))) -+ (SETQ XMIN (+ 4 OFFSETX)) -+ (SETQ XMAX (+ 20 OFFSETX)) -+ (SETQ YMIN (+ 48 OFFSETY)) -+ (SETQ YMAX (+ -8 (+ OFFSETY SIZEY))) -+ (WINDOW-TRACK-MOUSE W -+ #'(LAMBDA (X Y CODE) -+ (SETQ INSIDE -+ (AND (>= X XMIN) (<= X XMAX) (>= Y YMIN) (<= Y YMAX))) -+ (WHEN (AND INSIDE (/= Y LASTY)) -+ (IF (> Y LASTY) -+ (LET ((QQWHEIGHT (CADDDR W))) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 7 0 -+ 1 0) -+ (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) -+ (+ 12 OFFSETX) (- QQWHEIGHT LASTY) -+ (+ 12 OFFSETX) (- QQWHEIGHT Y)) -+ (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 -+ 1 0)) -+ (LET ((GLVAR214 (- LASTY Y))) -+ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) (+ 7 OFFSETX) -+ (- (CADDDR W) (1- (+ (1+ Y) GLVAR214))) 10 -+ GLVAR214 0))) -+ (SETQ LASTY Y) -+ (SETQ NEWVAL -+ (+ (* (/ (+ -48 (- LASTY OFFSETY)) (FLOAT HDEL)) -+ NDEL) -+ NMIN)) -+ (IF (INTEGERP VAL) (SETQ NEWVAL (TRUNCATE NEWVAL))) -+ (EDITORS-UPDATE-IN-BOX NEWVAL W OFFSETX OFFSETY 40 20)) -+ (NOT (ZEROP CODE)))) -+ (IF INSIDE NEWVAL VAL))) -+(SETF (GET 'WINDOW-ADJUST-THERMOMETER 'GLARGUMENTS) -+ '((W WINDOW) (NMIN INTEGER) (NDEL INTEGER) (NDIV INTEGER) -+ (VAL NUMBER) (OFFSETX INTEGER) (OFFSETY INTEGER) -+ (SIZEY INTEGER))) -+(SETF (GET 'WINDOW-ADJUST-THERMOMETER 'GLFNRESULTTYPE) 'NUMBER) -+ -+ -+(DEFUN BUTTON-SELECT (MW BUTTONS) -+ (LET (CURRENT-BUTTON ITEM ITEMS VAL XZERO YZERO) -+ (SETQ XZERO 0) -+ (SETQ YZERO 0) -+ (WINDOW-TRACK-MOUSE MW -+ #'(LAMBDA (X Y CODE) -+ (DECF X XZERO) -+ (DECF Y YZERO) -+ (AND (>= X 0) (>= Y 0)) -+ (IF CURRENT-BUTTON -+ (WHEN (NOT (BUTTON-CONTAINSXY? CURRENT-BUTTON X Y)) -+ (BUTTON-INVERT MW CURRENT-BUTTON) -+ (SETQ CURRENT-BUTTON NIL))) -+ (WHEN (NOT CURRENT-BUTTON) -+ (SETQ ITEMS BUTTONS) -+ (WHILE (AND (NOT CURRENT-BUTTON) (SETQ ITEM (POP ITEMS))) -+ (WHEN (BUTTON-CONTAINSXY? ITEM X Y) -+ (SETQ CURRENT-BUTTON ITEM) -+ (BUTTON-INVERT MW CURRENT-BUTTON)))) -+ (WHEN (PLUSP CODE) -+ (IF CURRENT-BUTTON (BUTTON-INVERT MW CURRENT-BUTTON)) -+ (SETQ VAL (OR CURRENT-BUTTON *PICMENU-NO-SELECTION*)))) -+ T) -+ (IF (NOT (EQUAL VAL *PICMENU-NO-SELECTION*)) (CAR VAL)))) -+(SETF (GET 'BUTTON-SELECT 'GLARGUMENTS) -+ '((MW WINDOW) (BUTTONS (LISTOF PICMENU-BUTTON)))) -+(SETF (GET 'BUTTON-SELECT 'GLFNRESULTTYPE) 'SYMBOL) -+ -+ -+(DEFUN BUTTON-INVERT (W BUTTON) -+ (WINDOW-INVERT-AREA W (CADR BUTTON) (CADDR BUTTON))) -+ -+(DEFUN WINDOW-UNDRAW-BOX (W OFFSET SIZE &OPTIONAL LW) -+ (LET ((GC (CADDR W))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 3) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*)))) -+ (WINDOW-DRAW-BOX W OFFSET SIZE LW) -+ (LET ((GC (CADDR W))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))) -+ -+(DEFUN BUTTON-CONTAINSXY? (B X Y) -+ (LET ((XSIZE 6) (YSIZE 6)) -+ (WHEN (CADDR B) -+ (SETQ XSIZE (CAADDR B)) -+ (SETQ YSIZE (CADR (CADDR B)))) -+ (AND (>= X (CAADR B)) (<= X (+ (CAADR B) XSIZE)) (>= Y (CADADR B)) -+ (<= Y (+ (CADADR B) YSIZE))))) -+(SETF (GET 'BUTTON-CONTAINSXY? 'GLARGUMENTS) -+ '((B PICMENU-BUTTON) (X INTEGER) (Y INTEGER))) -+(SETF (GET 'BUTTON-CONTAINSXY? 'GLFNRESULTTYPE) 'BOOLEAN) -+ -+ -+(SETF (GET 'MENU-ITEM 'GLSTRUCTURE) -+ '((Z ANYTHING) PROP ((VALUE ((IF Z IS ATOMIC Z (CDR Z))))) MSG -+ ((PRINT-SIZE MENU-ITEM-PRINT-SIZE) (DRAW MENU-ITEM-DRAW)))) -+ -+ -+(DEFUN MENU-ITEM-PRINT-SIZE (ITEM W) -+ (LET (SIZ) -+ (IF (ATOM ITEM) -+ (LIST (LET ((SSTR (STRINGIFY ITEM))) -+ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) -+ (LENGTH SSTR))) -+ 11) -+ (IF (STRINGP (CAR ITEM)) -+ (LIST (LET ((SSTR (STRINGIFY (CAR ITEM)))) -+ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) -+ (LENGTH SSTR))) -+ 11) -+ (IF (AND (SYMBOLP (CAR ITEM)) -+ (SETQ SIZ (GET (CAR ITEM) 'DISPLAY-SIZE))) -+ SIZ (COPY-LIST '(50 11))))))) -+(SETF (GET 'MENU-ITEM-PRINT-SIZE 'GLARGUMENTS) -+ '((ITEM MENU-ITEM) (W WINDOW))) -+(SETF (GET 'MENU-ITEM-PRINT-SIZE 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN MENU-ITEM-DRAW (ITEM W OFFSETX OFFSETY SIZEX SIZEY) -+ (IF (ATOM ITEM) -+ (WINDOW-CENTER-PRINT W ITEM OFFSETX OFFSETY SIZEX SIZEY) -+ (IF (AND (SYMBOLP (CAR ITEM)) (FBOUNDP (CAR ITEM))) -+ (FUNCALL (CAR ITEM) W OFFSETX OFFSETY) -+ (WINDOW-CENTER-PRINT W (CAR ITEM) OFFSETX OFFSETY SIZEX -+ SIZEY)))) -+ -+(DEFUN PICK-ONE-SIZE (ITEMS W) -+ (LET (WID) -+ (DOLIST (ITEM ITEMS) -+ (SETQ WID -+ (IF WID (MAX WID (CAR (MENU-ITEM-PRINT-SIZE ITEM W))) -+ (CAR (MENU-ITEM-PRINT-SIZE ITEM W))))) -+ (LIST WID 11))) -+(SETF (GET 'PICK-ONE-SIZE 'GLARGUMENTS) -+ '((ITEMS (LISTOF MENU-ITEM)) (W WINDOW))) -+(SETF (GET 'PICK-ONE-SIZE 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN DRAW-PICK-ONE -+ (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) -+ (LET (ITM) -+ (IF (SETQ ITM -+ (SOME #'(LAMBDA (GLVAR216) -+ (IF (EQUAL (IF (ATOM GLVAR216) GLVAR216 -+ (CDR GLVAR216)) -+ VAL) -+ GLVAR216)) -+ ITEMS)) -+ (MENU-ITEM-DRAW ITM W OFFSETX OFFSETY SIZEX SIZEY)))) -+ -+(DEFUN EDIT-PICK-ONE -+ (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) -+ (LET (NEWVAL) -+ (IF (<= (LENGTH ITEMS) 3) -+ (IF (EQUAL VAL -+ (LET ((SELF (FIRST ITEMS))) -+ (IF (ATOM SELF) SELF (CDR SELF)))) -+ (SETQ NEWVAL -+ (LET ((SELF (SECOND ITEMS))) -+ (IF (ATOM SELF) SELF (CDR SELF)))) -+ (IF (EQUAL VAL -+ (LET ((SELF (SECOND ITEMS))) -+ (IF (ATOM SELF) SELF (CDR SELF)))) -+ (SETQ NEWVAL -+ (IF (THIRD ITEMS) -+ (LET ((SELF (THIRD ITEMS))) -+ (IF (ATOM SELF) SELF (CDR SELF))) -+ (LET ((SELF (FIRST ITEMS))) -+ (IF (ATOM SELF) SELF (CDR SELF))))) -+ (SETQ NEWVAL -+ (LET ((SELF (FIRST ITEMS))) -+ (IF (ATOM SELF) SELF (CDR SELF)))))) -+ (SETQ NEWVAL (MENU ITEMS))) -+ (DRAW-PICK-ONE NEWVAL W ITEMS OFFSETX OFFSETY SIZEX SIZEY) -+ NEWVAL)) -+ -+(DEFUN DRAW-BLACK-WHITE -+ (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) -+ (LET (ITM) -+ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX -+ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) -+ (IF (SETQ ITM -+ (SOME #'(LAMBDA (GLVAR218) -+ (IF (EQUAL (IF (ATOM GLVAR218) GLVAR218 -+ (CDR GLVAR218)) -+ VAL) -+ GLVAR218)) -+ ITEMS)) -+ (WHEN (EQL (IF (CONSP ITM) (CAR ITM) ITM) 1) -+ (LET ((GC (CADDR W))) -+ (SETQ *WINDOW-SAVE-FUNCTION* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 1 -+ *GC-VALUES*) -+ (XGCVALUES-FUNCTION *GC-VALUES*))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC 6) -+ (SETQ *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 4 -+ *GC-VALUES*) -+ (XGCVALUES-FOREGROUND *GC-VALUES*))) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ (LOGXOR *WINDOW-SAVE-FOREGROUND* -+ (PROGN -+ (XGETGCVALUES *WINDOW-DISPLAY* (CADDR W) 8 -+ *GC-VALUES*) -+ (XGCVALUES-BACKGROUND *GC-VALUES*))))) -+ (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR W) (CADDR W) OFFSETX -+ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY) -+ (LET ((GC (CADDR W))) -+ (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*) -+ (XSETFOREGROUND *WINDOW-DISPLAY* GC -+ *WINDOW-SAVE-FOREGROUND*)))))) -+ -+(DEFUN EDIT-BLACK-WHITE -+ (ITEMS VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) -+ (LET (NEWVAL) -+ (IF (EQUAL VAL -+ (LET ((SELF (FIRST ITEMS))) -+ (IF (ATOM SELF) SELF (CDR SELF)))) -+ (SETQ NEWVAL -+ (LET ((SELF (SECOND ITEMS))) -+ (IF (ATOM SELF) SELF (CDR SELF)))) -+ (IF (EQUAL VAL -+ (LET ((SELF (SECOND ITEMS))) -+ (IF (ATOM SELF) SELF (CDR SELF)))) -+ (SETQ NEWVAL -+ (LET ((SELF (FIRST ITEMS))) -+ (IF (ATOM SELF) SELF (CDR SELF)))))) -+ (DRAW-BLACK-WHITE ITEMS NEWVAL W OFFSETX OFFSETY SIZEX SIZEY) -+ NEWVAL)) -+ -+(DEFUN DRAW-INTEGER (VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) -+ (EDITORS-ANYTHING-PRINT VAL W OFFSETX OFFSETY SIZEX SIZEY)) -+ -+(DEFUN DRAW-REAL (VAL W &OPTIONAL OFFSETX OFFSETY SIZEX SIZEY) -+ (LET (STR NC LNG FMT) -+ (IF (NULL SIZEX) (SETQ SIZEX 50)) -+ (SETQ NC (MAX 1 (TRUNCATE SIZEX 7))) -+ (SETQ STR (PRINC-TO-STRING VAL)) -+ (SETQ LNG (LENGTH STR)) -+ (IF (> LNG NC) -+ (IF (OR (FIND #\. STR :START NC) (FIND #\E STR) (FIND #\L STR)) -+ (IF (>= NC 8) -+ (PROGN -+ (SETQ FMT -+ (CADR (OR (ASSOC NC -+ '((8 "~8,2E") (9 "~9,2E") -+ (10 "~10,2E") (11 "~11,2E") -+ (12 "~12,2E") (13 "~13,2E") -+ (14 "~14,2E"))) -+ '(15 "~15,2E")))) -+ (SETQ STR (FORMAT NIL FMT VAL))) -+ (SETQ STR "*******")) -+ (SETQ STR (SUBSEQ STR 0 NC)))) -+ (EDITORS-ANYTHING-PRINT W STR OFFSETX OFFSETY SIZEX SIZEY))) -+ -+(DEFUN EDITORS-ANYTHING-PRINT (OBJ W OFFSETX OFFSETY SIZEX SIZEY) -+ (LET (SWIDTH SMAX DX DY) -+ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) OFFSETX -+ (- (CADDDR W) (1- (+ OFFSETY SIZEY))) SIZEX SIZEY 0) -+ (SETQ SWIDTH -+ (LET ((SSTR (STRINGIFY (STRINGIFY OBJ)))) -+ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) -+ (SETQ SMAX (MIN SWIDTH SIZEX)) -+ (SETQ DX (* 1/2 (- SIZEX SMAX))) -+ (SETQ DY (MAX 0 (+ -5 (* 1/2 SIZEY)))) -+ (LET ((SSTR (STRINGIFY (EDITORS-STRING-LIMIT OBJ W SMAX)))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) -+ (+ OFFSETX DX) (- (CADDDR W) (+ OFFSETY DY)) -+ (GET-C-STRING SSTR) (LENGTH SSTR))))) -+ -+(DEFUN EDITORS-PRINT-IN-BOX (OBJ W OFFSETX OFFSETY SIZEX SIZEY) -+ (LET ((SSTR (STRINGIFY (EDITORS-STRING-LIMIT OBJ W SIZEX)))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) -+ (- (CADDDR W) (+ OFFSETY (+ -5 (* 1/2 SIZEY)))) -+ (GET-C-STRING SSTR) (LENGTH SSTR))) -+ (WINDOW-DRAW-BOX-XY W OFFSETX OFFSETY SIZEX SIZEY)) -+ -+(DEFUN EDITORS-UPDATE-IN-BOX (OBJ W OFFSETX OFFSETY SIZEX SIZEY) -+ (LET ((GLVAR229 (+ -6 SIZEY))) -+ (XCLEARAREA *WINDOW-DISPLAY* (CADR W) (+ 3 OFFSETX) -+ (- (CADDDR W) (1- (+ (+ 3 OFFSETY) GLVAR229))) (+ -6 SIZEX) -+ GLVAR229 0)) -+ (LET ((SSTR (STRINGIFY (EDITORS-STRING-LIMIT OBJ W SIZEX)))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ 4 OFFSETX) -+ (- (CADDDR W) (+ OFFSETY (+ -5 (* 1/2 SIZEY)))) -+ (GET-C-STRING SSTR) (LENGTH SSTR)))) -+ -+(DEFUN EDITORS-STRING-LIMIT (S W MAX) -+ (LET ((STR (STRINGIFY S)) LNG NC) -+ (SETQ LNG -+ (LET ((SSTR (STRINGIFY STR))) -+ (XTEXTWIDTH (SEVENTH W) (GET-C-STRING SSTR) (LENGTH SSTR)))) -+ (IF (> LNG MAX) -+ (PROGN -+ (SETQ NC (/ (* (LENGTH STR) MAX) LNG)) -+ (SUBSEQ STR 0 NC)) -+ STR))) -+(SETF (GET 'EDITORS-STRING-LIMIT 'GLARGUMENTS) -+ '((S STRING) (W WINDOW) (MAX INTEGER))) -+(SETF (GET 'EDITORS-STRING-LIMIT 'GLFNRESULTTYPE) 'STRING) -+ -+ -+(DEFVAR *EDIT-COLOR-MENU-SET* NIL) -+ -+(DEFVAR *EDIT-COLOR-RMENU* NIL) -+ -+(DEFVAR *EDIT-COLOR-OLD-COLOR* NIL) -+ -+(DEFVAR *EDIT-COLOR-MENU-SET*) -+(SETF (GET '*EDIT-COLOR-MENU-SET* 'GLISPGLOBALVAR) T) -+(SETF (GET '*EDIT-COLOR-MENU-SET* 'GLISPGLOBALVARTYPE) 'MENU-SET) -+(DEFVAR *EDIT-COLOR-RMENU*) -+(SETF (GET '*EDIT-COLOR-RMENU* 'GLISPGLOBALVAR) T) -+(SETF (GET '*EDIT-COLOR-RMENU* 'GLISPGLOBALVARTYPE) 'BARMENU) -+ -+ -+(DEFUN EDIT-COLOR-INIT (W) -+ (LET (RM GM BM RGB) -+ (SETQ RGB (COPY-LIST '(0 0 0))) -+ (GLCC 'EDIT-COLOR-RED) -+ (GLCC 'EDIT-COLOR-GREEN) -+ (GLCC 'EDIT-COLOR-BLUE) -+ (SETQ *EDIT-COLOR-MENU-SET* (MENU-SET-CREATE W NIL)) -+ (SETQ RM -+ (BARMENU-CREATE 256 200 10 "" NIL #'EDIT-COLOR-RED (LIST RGB) -+ W 120 40 NIL T (COPY-LIST '(65535 0 0)))) -+ (SETQ *EDIT-COLOR-RMENU* RM) -+ (SETQ GM -+ (BARMENU-CREATE 256 50 10 "" NIL #'EDIT-COLOR-GREEN -+ (LIST RGB) W 170 40 NIL T (COPY-LIST '(0 65535 0)))) -+ (SETQ BM -+ (BARMENU-CREATE 256 250 10 "" NIL #'EDIT-COLOR-BLUE -+ (LIST RGB) W 220 40 NIL T (COPY-LIST '(0 0 65535)))) -+ (MENU-SET-ADD-BARMENU *EDIT-COLOR-MENU-SET* 'RED NIL RM "Red" -+ '(120 40)) -+ (MENU-SET-ADD-BARMENU *EDIT-COLOR-MENU-SET* 'GREEN NIL GM "Green" -+ '(170 40)) -+ (MENU-SET-ADD-BARMENU *EDIT-COLOR-MENU-SET* 'BLUE NIL BM "Blue" -+ '(220 40)) -+ (MENU-SET-ADD-MENU *EDIT-COLOR-MENU-SET* 'DONE NIL "" -+ '(("Done" . DONE)) '(30 150)) -+ (EDIT-COLOR-RED 200 RGB) -+ (EDIT-COLOR-GREEN 50 RGB) -+ (EDIT-COLOR-BLUE 250 RGB))) -+ -+(DEFUN EDIT-COLOR-RED (VAL COLOR) -+ (LET ((W (CADR *EDIT-COLOR-MENU-SET*))) -+ (LET ((SSTR (STRINGIFY (FORMAT NIL "~3D" VAL)))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) 113 -+ (+ -20 (CADDDR W)) (GET-C-STRING SSTR) (LENGTH SSTR))) -+ (SETF (CAR COLOR) (MAX 0 (1- (* 256 VAL)))) -+ (EDIT-DISPLAY-COLOR W COLOR))) -+ -+(DEFUN EDIT-COLOR-GREEN (VAL COLOR) -+ (LET ((W (CADR *EDIT-COLOR-MENU-SET*))) -+ (LET ((SSTR (STRINGIFY (FORMAT NIL "~3D" VAL)))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) 163 -+ (+ -20 (CADDDR W)) (GET-C-STRING SSTR) (LENGTH SSTR))) -+ (SETF (CADR COLOR) (MAX 0 (1- (* 256 VAL)))) -+ (EDIT-DISPLAY-COLOR W COLOR))) -+ -+(DEFUN EDIT-COLOR-BLUE (VAL COLOR) -+ (LET ((W (CADR *EDIT-COLOR-MENU-SET*))) -+ (LET ((SSTR (STRINGIFY (FORMAT NIL "~3D" VAL)))) -+ (XDRAWIMAGESTRING *WINDOW-DISPLAY* (CADR W) (CADDR W) 213 -+ (+ -20 (CADDDR W)) (GET-C-STRING SSTR) (LENGTH SSTR))) -+ (SETF (CADDR COLOR) (MAX 0 (1- (* 256 VAL)))) -+ (EDIT-DISPLAY-COLOR W COLOR))) -+ -+(DEFUN EDIT-DISPLAY-COLOR (W COLOR) -+ (WINDOW-SET-COLOR W COLOR) -+ (WINDOW-DRAW-LINE-XY W 50 40 50 100 60) -+ (WINDOW-RESET-COLOR W) -+ (IF *EDIT-COLOR-OLD-COLOR* -+ (WINDOW-FREE-COLOR W *EDIT-COLOR-OLD-COLOR*)) -+ (SETQ *EDIT-COLOR-OLD-COLOR* *WINDOW-XCOLOR*)) -+ -+(DEFUN EDIT-COLOR (W) -+ (LET (DONE COLOR SEL) -+ (IF (OR (NULL *EDIT-COLOR-MENU-SET*) -+ (NOT (EQ W (CADR (CADDR (CAADDR *EDIT-COLOR-MENU-SET*)))))) -+ (EDIT-COLOR-INIT W)) -+ (SETQ COLOR (FIRST (NTH 16 *EDIT-COLOR-RMENU*))) -+ (MENU-SET-DRAW *EDIT-COLOR-MENU-SET*) -+ (EDIT-COLOR-RED (TRUNCATE (1+ (CAR COLOR)) 256) COLOR) -+ (EDIT-COLOR-GREEN (TRUNCATE (1+ (CADR COLOR)) 256) COLOR) -+ (EDIT-COLOR-BLUE (TRUNCATE (1+ (CADDR COLOR)) 256) COLOR) -+ (WHILE (NOT DONE) -+ (SETQ SEL (MENU-SET-SELECT *EDIT-COLOR-MENU-SET*)) -+ (SETQ DONE (AND SEL (EQ (FIRST SEL) 'DONE)))) -+ COLOR)) -+(SETF (GET 'EDIT-COLOR 'GLARGUMENTS) '((W WINDOW))) -+(SETF (GET 'EDIT-COLOR 'GLFNRESULTTYPE) 'RGB) -+ -+ -+(DEFUN COLOR-DOT (W X Y COLOR) -+ (LET (RGB) -+ (SETQ RGB -+ (CDR (ASSOC COLOR -+ '((RED 65535 0 0) (YELLOW 65535 57600 0) -+ (GREEN 0 50175 12287) (BLUE 0 0 65535))))) -+ (OR RGB (SETQ RGB '(30000 30000 30000))) -+ (WINDOW-SET-COLOR W RGB) -+ (WINDOW-DRAW-DOT-XY W X Y) -+ (WINDOW-RESET-COLOR W))) -+ -+(DEFUN COMPILE-EDITORS () -+ (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") -+ '("glisp/editors.lsp") "glisp/editorstrans.lsp" "glisp/gpl.txt") -+ (CF EDITORSTRANS)) -+ -+(DEFUN COMPILE-EDITORSB () -+ (GLCOMPFILES *DIRECTORY* -+ '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") -+ '("glisp/editors.lsp") "glisp/editorstrans.lsp" "glisp/gpl.txt")) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_general.lsp -@@ -0,0 +1,85 @@ -+(in-package :XLIB) -+; general.lsp Hiep Huu Nguyen ; 24 Jun 06 -+; 15 Sep 05; 24 Jan 06 -+ -+; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. -+ -+; See the files gnu.license and dec.copyright . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Some of the files that interface to the Xlib are adapted from DEC/MIT files. -+; See the file dec.copyright for details. -+ -+; 27 Aug 92 -+; 15 Sep 05: Edited by G. Novak to change C function headers to new form -+; 24 Jan 06: Edited by G. Novak to remove vertex-array entries. -+; 22 Jun 06: Edited by G. Novak to fix entry types -+ -+;(defentry free (string) (void free)) -+;(defentry calloc(fixnum fixnum) (string calloc)) -+(defentry char-array (int) (fixnum char_array)) -+(defentry char-pos (fixnum int) (char char_pos)) -+(defentry set-char-array (fixnum int char) (void set_char_array)) -+ -+(defentry int-array (int) (fixnum int_array)) -+(defentry int-pos (fixnum int) (int int_pos)) -+(defentry set-int-array (fixnum int int) (void set_int_array)) -+ -+(defentry fixnum-array (int) (fixnum fixnum_array)) -+(defentry fixnum-pos (fixnum int) (fixnum fixnum_pos)) -+(defentry set-fixnum-array (fixnum int fixnum) (void set_fixnum_array)) -+ -+;;from mark ring's function -+;; General routines. -+(defCfun "object get_c_string(object s)" 0 -+ " return((object)s->st.st_self);" -+ ) -+(defCfun "object get_c_string1(object s)" 0 -+ " return((object)object_to_string(s));" -+ ) -+(defCfun "fixnum get_c_string2(object s)" 0 -+ " return((fixnum)get_c_string(s));" -+ ) -+(defentry get_c_string_2 (object) (object get_c_string)) -+ -+;; make sure string is null terminated -+ -+(defentry get-c-string (object) (object get_c_string1));"(object)object_to_string")) -+ -+;; General routines. -+(defCfun "object lisp_string(object a_string, fixnum c_string) " 0 -+ "fixnum len = strlen((void *)c_string);" -+ "a_string->st.st_dim = len;" -+ "a_string->st.st_fillp = len;" -+ "a_string->st.st_self = (void *)c_string;" -+ "return(a_string);" -+ ) -+ -+(defentry lisp-string-2 (object fixnum ) (object lisp_string)) -+(defun lisp-string (a-string ) -+ (lisp-string-2 "" a-string )) -+ -+;;modified from mark ring's function -+;; General routines. -+(defCfun "fixnum get_st_point(object s)" 0 -+ " return((fixnum) s->st.st_self);" -+ ) -+(defentry get-st-point2 (object) (fixnum get_c_string2));"(fixnum)get_c_string")) -+ -+;; make sure string is null terminated -+(defun get-st-point (string) -+ ( get-st-point2 (concatenate 'string string ""))) -+ ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_editors.lsp -@@ -0,0 +1,483 @@ -+; editors.lsp Gordon S. Novak Jr. ; 08 Dec 08 -+ -+; Copyright (c) 2008 Gordon S. Novak Jr. and The University of Texas at Austin. -+ -+; 13 Apr 95; 02 Jan 97; 28 Feb 02; 08 Jan 04; 03 Mar 04; 26 Jan 06; 27 Jan 06 -+ -+; This program 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 program 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 program; if not, write to the Free Software -+; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -+ -+; Graphical editor functions -+ -+; (edit-thermom 75 myw 20 20 150 250) -+; (window-draw-thermometer myw 0 20 5 50 50 50 232) -+; (window-adjust-thermometer myw 0 20 5 50 50 50 232) -+ -+; 20 Nov 91; 03 Dec 91; 27 Dec 91; 26 Dec 93; 28 Feb 02; 08 Jan 04 -+; Edit an integer with a thermometer-like display -+(gldefun edit-thermom ((num number) (w window) -+ &optional (offsetx integer) (offsety integer) -+ (sizex integer) (sizey integer)) -+ (prog (nmin ndel ndiv range pten drange pair neww (res num) off) -+ (if ~ sizex (progn (sizex = 150) (sizey = 250))) -+ (if ~ offsetx -+ (progn (off = (centeroffset w (a vector with x = sizex y = sizey))) -+ (offsetx = (x off)) -+ (offsety = (y off)))) -+ (neww = (window-create sizex sizey nil (parent w) offsetx offsety)) -+ (window-draw-button neww "Typein" 80 20 50 25) -+ (window-draw-button neww "Adjust" 80 70 50 25) -+ (window-draw-button neww "Done" 80 120 50 25) -+ rn (range = (abs res) * 2) -+ (if (range == 0) (range = 50)) -+ (if ((range < 8) and (integerp num)) (range = 10)) -+ (pten = (expt 10 (truncate (log range 10)))) -+ (drange = (range * 10) / pten) -+ (setq pair (car (some #'(lambda (x) (> (car x) drange)) -+ '((14 2) (20 4) (40 5) (70 10) (101 20))))) -+ (setq ndel ((cadr pair) * pten / 10)) -+ (setq ndiv (ceiling (range / ndel))) -+ (setq nmin (if (>= res 0) -+ 0 -+ (- ndel * ndiv))) -+ (window-draw-thermometer neww nmin ndel ndiv res 10 10 (sizey - 20)) -+ lp (case (button-select neww '((done (84 124) (42 17)) -+ (adjust (84 74) (42 17)) -+ (typein (84 24) (42 17)))) -+ (done (destroy neww) (return res)) -+ (adjust (setq res (window-adjust-thermometer neww nmin ndel ndiv res -+ 10 10 (sizey - 20))) -+ (go lp)) -+ (typein (princ "Enter new value: ") -+ (setq res (read)) -+ (if ((res >= nmin) and (res <= (nmin + ndel * ndiv))) -+ (progn (window-set-thermometer neww nmin ndel ndiv res -+ 10 10 (sizey - 20)) -+ (go lp)) -+ (go rn)) ) ) )) -+ -+; 20 Nov 91; 04 Dec 91 -+; Draw a button-like icon -+(gldefun window-draw-button ((w window) (s string) -+ (offsetx integer) (offsety integer) -+ (sizex integer) (sizey integer)) -+ (let (sw) -+ (erase-area-xy w offsetx offsety sizex sizey 8) -+ (draw-rcbox-xy w offsetx offsety sizex sizey 8) -+ (sw = (string-width w s)) -+ (printat-xy w s (offsetx + (sizex - sw) / 2) (offsety + 8)) -+ (force-output w))) -+ -+; 17 Dec 91 -+; Print in the center of a specified region -+(gldefun window-center-print ((w window) (s string) -+ (offsetx integer) (offsety integer) -+ (sizex integer) (sizey integer)) -+ (let (sw) -+ (erase-area-xy w offsetx offsety sizex sizey 8) -+ (sw = (string-width w s)) -+ (printat-xy w s (offsetx + (sizex - sw) / 2) -+ (offsety + (sizey - 10) / 2) ) -+ (force-output w))) -+ -+; 20 Nov 91; 03 Dec 91; 26 Dec 93 -+; Draw a thermometer-like icon -+(gldefun window-draw-thermometer ((w window) (nmin integer) (ndel integer) -+ (ndiv integer) (val number) -+ (offsetx integer) (offsety integer) -+ (sizey integer)) -+ (let (hdel marky) -+ (erase-area-xy w offsetx offsety 66 sizey) -+ (editors-print-in-box val w offsetx offsety 40 20) -+ (draw-arc-xy w (offsetx + 12) (offsety + 36) 12 12 132 276) -+ (draw-line-xy w (offsetx + 4) (offsety + 44) -+ (offsetx + 4) (offsety + sizey - 8) ) -+ (draw-line-xy w (offsetx + 20) (offsety + 44) -+ (offsetx + 20) (offsety + sizey - 8) ) -+ (draw-arc-xy w (offsetx + 12) (offsety + sizey - 8) 8 8 0 180) -+ (draw-circle-xy w (offsetx + 12) (offsety + 36) 4 7) -+ (hdel = (sizey - 56) / ndiv) -+ (draw-line-xy w (offsetx + 12) (offsety + 35) -+ (offsetx + 12) -+ (offsety + 48 + hdel * ((val - nmin) / ndel)) 7) -+ (dotimes (i (1+ ndiv)) -+ (marky = (offsety + 48 + i * hdel)) -+ (draw-line-xy w (offsetx + 24) marky (offsetx + 34) marky) -+ (printat-xy w (nmin + i * ndel) (offsetx + 36) (marky - 6)) ) -+ (force-output w))) -+ -+ -+; 20 Nov 91; 03 Dec 91; 13 Apr 95 -+; Draw value for a thermometer-like icon -+(gldefun window-set-thermometer ((w window) (nmin integer) (ndel integer) -+ (ndiv integer) (val number) -+ (offsetx integer) (offsety integer) -+ (sizey integer)) -+ (let (hdel) -+ (hdel = (sizey - 56) / ndiv) -+ (erase-area-xy w (offsetx + 7) (offsety + 48) -+ 10 (sizey - 56)) -+ (draw-line-xy w (offsetx + 12) (offsety + 35) -+ (offsetx + 12) -+ (offsety + 48 + hdel * ((val - nmin) / ndel)) 7) -+ (editors-update-in-box val w offsetx offsety 40 20)))) -+ -+ -+; 20 Nov 91; 03 Dec 91; 15 Oct 93; 02 Dec 93; 08 Jan 04 -+; Adjust a thermometer-like icon with the mouse. Returns new value. -+(gldefun window-adjust-thermometer ((w window) (nmin integer) (ndel integer) -+ (ndiv integer) (val number) -+ (offsetx integer) (offsety integer) -+ (sizey integer)) -+ (let (hdel (lasty integer) xmin xmax ymin ymax inside (newval number)) -+ (hdel = (sizey - 56) / ndiv) -+ (lasty = (truncate (offsety + 48 + hdel * ((val - nmin) / ndel)))) -+ (xmin = offsetx + 4) -+ (xmax = offsetx + 20) -+ (ymin = offsety + 48) -+ (ymax = offsety + sizey - 8) -+ (window-track-mouse w -+ #'(lambda (x y code) -+ (inside = (and (>= x xmin) (<= x xmax) -+ (>= y ymin) (<= y ymax))) -+ (when (and inside (/= y lasty)) -+ (if (> y lasty) -+ (draw-line-xy w (offsetx + 12) lasty (offsetx + 12) y 7) -+ (erase-area-xy w (offsetx + 7) (y + 1) -+ 10 (- lasty y))) -+ (lasty = y) -+ (newval = ( ( (lasty - (offsety + 48)) -+ / (float hdel)) * ndel) + nmin) -+ (if (integerp val) (newval = (truncate newval))) -+ (editors-update-in-box newval w offsetx offsety 40 20)) -+ (not (zerop code)))) -+ (if inside -+ newval -+ val) )) -+ -+; 20 Nov 91; 15 Oct 93; 08 Jan 04; 26 Jan 06 -+; Get a mouse selection from a button area. cf. picmenu-select -+(gldefun button-select ((mw window) (buttons (listof picmenu-button))) -+ (let ((current-button picmenu-button) item items (val picmenu-button) -+ xzero yzero inside) -+ (xzero = 0) ; (menu-x m 0) -+ (yzero = 0) ; (menu-y m 0) -+ (track-mouse mw -+ #'(lambda (x y code) -+ (x = (x - xzero)) -+ (y = (y - yzero)) -+ (if ((x >= 0) and (y >= 0)) -+ (inside = t)) -+ (if current-button -+ (if ~ (button-containsxy? current-button x y) -+ (progn (button-invert mw current-button) -+ (current-button = nil)))) -+ (if ~ current-button -+ (progn (items = buttons) -+ (while ~ current-button and (item -_ items) do -+ (if (button-containsxy? item x y) -+ (progn (current-button = item) -+ (button-invert mw current-button) ))))) -+ (if (> code 0) -+ (progn (if current-button -+ (button-invert mw current-button) ) -+ (val = (or current-button *picmenu-no-selection*)) ))) -+ t) -+ (if (val <> *picmenu-no-selection*) (buttonname val)) )) -+ -+; 03 Dec 91 -+(gldefun button-invert ((w window) (button picmenu-button)) -+ (window-invert-area w (offset button) (size button)) ) -+ -+(gldefun window-undraw-box ((w window) offset size &optional lw) -+ (set-erase w) -+ (window-draw-box w offset size lw) -+ (unset w) ) -+ -+; 20 Nov 91; 08 Jan 04 -+(gldefun button-containsxy? ((b picmenu-button) (x integer) (y integer)) -+ (let ((xsize 6) (ysize 6)) -+ (if (size b) -+ (progn (xsize = (x (size b))) -+ (ysize = (y (size b))))) -+ ((x >= (x (offset b))) and (x <= ((x (offset b)) + xsize)) and -+ (y >= (y (offset b))) and (y <= ((y (offset b)) + ysize)) ) )) -+ -+ -+(glispobjects -+ -+(menu-item (z anything) -+ prop ((value ((if z is atomic -+ z -+ (cdr z)))) ) -+ msg ((print-size menu-item-print-size) -+ (draw menu-item-draw)) ) -+ -+) ; glispobjects -+ -+(gldefun menu-item-print-size ((item menu-item) (w window)) -+ (result vector) -+ (let (siz) -+ (if item is atomic -+ (a vector with x = (string-width w item) y = 11) -+ (if (car item) is a string -+ (a vector with x = (string-width w (car item)) y = 11) -+ (if ((symbolp (car item)) -+ and (siz = (get (car item) 'display-size))) -+ siz -+ (a vector with x = 50 y = 11)))) )) -+ -+; 17 Dec 91; 08 Jan 04 -+(gldefun menu-item-draw ((item menu-item) (w window) -+ (offsetx integer) (offsety integer) -+ (sizex integer) (sizey integer)) -+ (if item is atomic -+ (window-center-print w item offsetx offsety sizex sizey) -+ (if ((symbolp (car item)) and (fboundp (car item))) -+ (funcall (car item) w offsetx offsety) -+ (window-center-print w (car item) offsetx offsety -+ sizex sizey))) ) -+ -+; 03 Dec 91; 26 Dec 93; 08 Jan 04 -+(gldefun pick-one-size ((items (listof menu-item)) (w window)) -+ (let (wid) -+ (for item in items do -+ (wid = (if wid -+ (max wid (x (print-size item w))) -+ (x (print-size item w))) ) ) -+ (a vector with x = wid y = 11) )) -+ -+; 03 Dec 91; 26 Dec 93; 29 Jul 94; 28 Feb 02 -+(gldefun draw-pick-one ((items (listof menu-item)) (val anything) (w window) -+ &optional (offsetx integer) (offsety integer) -+ (sizex integer) (sizey integer)) -+ (let (itm) -+ (if (itm = (that item with (value (that item)) == val)) -+ (draw itm w offsetx offsety sizex sizey)))) -+ -+; 04 Dec 91; 26 Dec 93; 29 Jul 94; 08 Jan 04 -+(gldefun edit-pick-one ((items (listof menu-item)) (val anything) (w window) -+ &optional (offsetx integer) (offsety integer) -+ (sizex integer) (sizey integer)) -+ (let (newval) -+ (if ((length items) <= 3) -+ (if (equal val (value (first items))) -+ (newval = (value (second items))) -+ (if (equal val (value (second items))) -+ (newval = (if (third items) -+ (value (third items)) -+ (value (first items)))) -+ (newval = (value (first items))))) -+ (newval = (menu items)) ) -+ (draw-pick-one newval w items offsetx offsety sizex sizey) -+ newval )) -+ -+ -+; 13 Dec 91; 26 Dec 93; 28 Jul 94; 28 Feb 02; 08 Jan 04 -+(gldefun draw-black-white ((items (listof menu-item)) (val anything) (w window) -+ &optional (offsetx integer) (offsety integer) -+ (sizex integer) (sizey integer)) -+ (let (itm) -+ (erase-area-xy w offsetx offsety sizex sizey) -+ (if (itm = (that item with (value (that item)) == val)) -+ (if (eql (if (consp itm) -+ (car itm) -+ itm) -+ 1) -+ (invert-area-xy w offsetx offsety sizex sizey)) ) )) -+ -+; 13 Dec 91; 15 Dec 91; 26 Dec 93; 28 Jul 94; 08 Jan 04 -+(gldefun edit-black-white ((items (listof menu-item)) (val anything) (w window) -+ &optional (offsetx integer) (offsety integer) -+ (sizex integer) (sizey integer)) -+ (let (newval) -+ (if (equal val (value (first items))) -+ (newval = (value (second items))) -+ (if (equal val (value (second items))) -+ (newval = (value (first items))))) -+ (draw-black-white items newval w offsetx offsety sizex sizey) -+ newval )) -+ -+; 23 Dec 91; 26 Dec 93 -+(gldefun draw-integer ((val integer) (w window) -+ &optional (offsetx integer) (offsety integer) -+ (sizex integer) (sizey integer)) -+ (editors-anything-print val w offsetx offsety sizex sizey) ) -+ -+; 24 Dec 91; 26 Dec 93 -+(defun draw-real (val w &optional offsetx offsety sizex sizey) -+ (let (str nc lng fmt) -+ (if (null sizex) (setq sizex 50)) -+ (setq nc (max 1 (truncate sizex 7))) -+ (setq str (princ-to-string val)) -+ (setq lng (length str)) -+ (if (> lng nc) -+ (if (or (find #\. str :start nc) -+ (find #\E str) -+ (find #\L str)) -+ (if (>= nc 8) -+ (progn (setq fmt (cadr (or (assoc nc '((8 "~8,2E") -+ (9 "~9,2E") (10 "~10,2E") -+ (11 "~11,2E") (12 "~12,2E") -+ (13 "~13,2E") (14 "~14,2E"))) -+ '(15 "~15,2E")))) -+ (setq str (format nil fmt val))) -+ (setq str "*******")) -+ (setq str (subseq str 0 nc)) )) -+ (editors-anything-print w str offsetx offsety sizex sizey) )) -+ -+; 09 Dec 91; 10 Dec 91; 23 Dec 91; 26 Dec 93; 22 Jul 94 -+; Display function for use when a more specific one is not found. -+(gldefun editors-anything-print (obj (w window) offsetx offsety sizex sizey) -+ (let ((s (stringify obj)) swidth smax dx dy) -+ (erase-area-xy w offsetx offsety sizex sizey) -+ (swidth = (string-width w s)) -+ (smax = (min swidth sizex)) -+ (dx = (sizex - smax) / 2) -+ (dy = (max 0 ((sizey - 10) / 2))) -+ (printat-xy w (editors-string-limit obj w smax) -+ (offsetx + dx) (offsety + dy)) -+ )) -+ -+; 26 Dec 93 -+(gldefun editors-print-in-box (obj (w window) offsetx offsety sizex sizey) -+ (printat-xy w (editors-string-limit obj w sizex) -+ (offsetx + 4) (offsety + (sizey - 10) / 2)) -+ (draw-box-xy w offsetx offsety sizex sizey) ) -+ -+; 26 Dec 93 -+(gldefun editors-update-in-box (obj (w window) offsetx offsety sizex sizey) -+ (erase-area-xy w (offsetx + 3) (offsety + 3) (sizex - 6) (sizey - 6)) -+ (printat-xy w (editors-string-limit obj w sizex) -+ (offsetx + 4) (offsety + (sizey - 10) / 2)) ) -+ -+; 28 Oct 91; 26 Dec 93; 08 Jan 04 -+; Limit string to a specified number of pixels -+(gldefun editors-string-limit ((s string) (w window) (max integer)) -+ (result string) -+ (let ((str (stringify s)) (lng integer) (nc integer)) -+ (lng = (string-width w str)) -+ (if (lng > max) -+ (progn (nc = (((length str) * max) / lng)) -+ (subseq str 0 nc)) -+ str) )) -+ -+(defvar *edit-color-menu-set* nil) -+(defvar *edit-color-rmenu* nil) -+(defvar *edit-color-old-color* nil) -+(glispglobals (*edit-color-menu-set* menu-set) -+ (*edit-color-rmenu* barmenu)) -+ -+; 03 Jan 94; 04 Jan 94; 05 Jan 94; 08 Dec 08 -+(gldefun edit-color-init ((w window)) -+ (let (rm gm bm rgb) -+ (rgb = (a rgb)) -+ (glcc 'edit-color-red) -+ (glcc 'edit-color-green) -+ (glcc 'edit-color-blue) -+ (*edit-color-menu-set* = (menu-set-create w nil)) -+ (rm = (barmenu-create 256 200 10 "" nil #'edit-color-red (list rgb) w -+ 120 40 nil t (a rgb with red = 65535))) -+ (*edit-color-rmenu* = rm) -+ (gm = (barmenu-create 256 50 10 "" nil #'edit-color-green (list rgb) w -+ 170 40 nil t (a rgb with green = 65535))) -+ (bm = (barmenu-create 256 250 10 "" nil #'edit-color-blue (list rgb) w -+ 220 40 nil t (a rgb with blue = 65535))) -+ (add-barmenu *edit-color-menu-set* 'red nil rm "Red" '(120 40)) -+ (add-barmenu *edit-color-menu-set* 'green nil gm "Green" '(170 40)) -+ (add-barmenu *edit-color-menu-set* 'blue nil bm "Blue" '(220 40)) -+ (add-menu *edit-color-menu-set* 'done nil "" '(("Done" . done)) '(30 150)) -+ (edit-color-red 200 rgb) -+ (edit-color-green 50 rgb) -+ (edit-color-blue 250 rgb) -+ )) -+ -+; 03 Jan 94; 04 Jan 94 -+(gldefun edit-color-red ((val integer) (color rgb)) -+ (let ((w (window *edit-color-menu-set*))) -+ (printat-xy w (format nil "~3D" val) 113 20) -+ ((red color) = (max 0 (val * 256 - 1))) -+ (edit-display-color w color) )) -+ -+; 03 Jan 94; 04 Jan 94 -+(gldefun edit-color-green ((val integer) (color rgb)) -+ (let ((w (window *edit-color-menu-set*))) -+ (printat-xy w (format nil "~3D" val) 163 20) -+ ((green color) = (max 0 (val * 256 - 1))) -+ (edit-display-color w color) )) -+ -+; 03 Jan 94; 04 Jan 94 -+(gldefun edit-color-blue ((val integer) (color rgb)) -+ (let ((w (window *edit-color-menu-set*))) -+ (printat-xy w (format nil "~3D" val) 213 20) -+ ((blue color) = (max 0 (val * 256 - 1))) -+ (edit-display-color w color) )) -+ -+; 03 Jan 94 -+(gldefun edit-display-color ((w window) (color rgb)) -+ (window-set-color w color) -+ (window-draw-line-xy w 50 40 50 100 60) -+ (window-reset-color w) -+ (if *edit-color-old-color* (window-free-color w *edit-color-old-color*)) -+ (*edit-color-old-color* = *window-xcolor*) ) -+ -+; 03 Jan 94; 04 Jan 94; 05 Jan 94; 28 Feb 02 -+(gldefun edit-color ((w window)) -+ (let (done (color rgb) sel) -+ (if (or (null *edit-color-menu-set*) -+ (not (eq w (menu-window (menu (first (menu-items -+ *edit-color-menu-set*))))))) -+ (edit-color-init w)) -+ (color = (first (subtrackparms *edit-color-rmenu*))) -+ (draw *edit-color-menu-set*) -+ (edit-color-red (truncate (1+ (red color)) 256) color) -+ (edit-color-green (truncate (1+ (green color)) 256) color) -+ (edit-color-blue (truncate (1+ (blue color)) 256) color) -+ (while ~ done -+ (sel = (select *edit-color-menu-set*)) -+ (done = (and sel ((first sel) == 'done))) ) -+ color)) -+ -+; 08 Dec 08 -+(gldefun color-dot ((w window) (x integer) (y integer) (color symbol)) -+ (let (rgb) -+ (setq rgb (cdr (assoc color '((red 65535 0 0) -+ (yellow 65535 57600 0) -+ (green 0 50175 12287) -+ (blue 0 0 65535))))) -+ (or rgb (setq rgb '(30000 30000 30000))) -+ (set-color w rgb) -+ (draw-dot-xy w x y) -+ (reset-color w) )) -+ -+; 15 Oct 93; 26 Jan 06 -+; Compile the editors.lsp file into a plain Lisp file -+(defun compile-editors () -+ (glcompfiles *directory* -+ '("glisp/vector.lsp" ; auxiliary files -+ "X/dwindow.lsp") -+ '("glisp/editors.lsp") ; translated files -+ "glisp/editorstrans.lsp" ; output file -+ "glisp/gpl.txt") ; header file -+ (cf editorstrans) ) -+ -+; Compile the editors.lsp file into a plain Lisp file for XGCL -+(defun compile-editorsb () -+ (glcompfiles *directory* -+ '("glisp/vector.lsp" ; auxiliary files -+ "X/dwindow.lsp" "X/dwnoopen.lsp") -+ '("glisp/editors.lsp") ; translated files -+ "glisp/editorstrans.lsp" ; output file -+ "glisp/gpl.txt") ; header file -+ ) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_dwtest.lsp -@@ -0,0 +1,192 @@ -+; dwtest.lsp Gordon S. Novak Jr. 10 Jan 96 -+ -+; Some examples for testing the window interface in dwindow.lsp / dwtrans.lsp -+ -+; Copyright (c) 1996 Gordon S. Novak Jr. and The University of Texas at Austin. -+ -+; See the file gnu.license . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Written by: Gordon S. Novak Jr., Department of Computer Sciences, -+; University of Texas at Austin 78712. novak@cs.utexas.edu -+ -+(use-package :xlib) -+(defun user::xgcl-demo nil -+ (wtesta) -+ (wtestb) -+ (format t "Try (wtestc) ... (wtestk) for more examples.")) -+ -+(defmacro while (test &rest forms) -+ `(loop (unless ,test (return)) ,@forms) ) -+ -+(defvar *myw*) ; my window -+(defvar myw) -+ -+; Make a window to play in. -+(defun wtesta () -+ (setq myw (setq *myw* (window-create 300 300 "test window"))) ) -+ -+; 15 Aug 91; 12 Sep 91; 05 Oct 94; 06 Oct 94 -+; Draw some basic things in the window -+(defun wtestb () -+ (window-clear *myw*) -+ (window-draw-box-xy *myw* 50 50 50 20 1) -+ (window-printat *myw* "howdy" '(58 55)) -+ (window-draw-line *myw* '(100 70) '(200 170)) -+ (window-draw-arrow-xy *myw* 200 170 165 205) -+ (window-draw-circle-xy *myw* 200 170 50 2) -+ (window-draw-ellipse-xy *myw* 100 170 40 20 1) -+ (window-printat-xy *myw* "ellipse" 70 165) -+ (window-draw-arc-xy *myw* 100 250 20 20 0 90 1) -+ (window-draw-arc-xy *myw* 100 250 20 20 0 -90 1) -+ (window-printat-xy *myw* "arcs" 80 244) -+ (window-printat-xy *myw* "invert" 54 200) -+ (window-invert-area-xy *myw* 50 160 60 60) -+ (window-copy-area-xy *myw* 40 150 200 50 60 40) -+ (window-printat-xy *myw* "copy" 210 100) -+ (window-set-color-rgb *myw* 65535 0 0) ; red foreground -+ (window-printat-xy *myw* "Red" 20 20) -+ (window-draw-rcbox-xy *myw* 15 15 32 20 5) -+ (window-set-color-rgb *myw* 0 0 65535 t) ; blue background -+ (window-set-color-rgb *myw* 0 65535 0) ; green foreground -+ (window-printat-xy *myw* "Green" 120 20) -+ (window-set-color-rgb *myw* 0 65535 0 t) ; green background -+ (window-set-color-rgb *myw* 0 0 65535) ; blue foreground -+ (window-printat-xy *myw* "Blue" 220 20) -+ (window-reset-color *myw*) -+ (window-force-output *myw*) ) -+ -+; 15 Aug 91; 19 Aug 91; 03 Sep 91; 21 Apr 95 -+; Illustrate mouse interaction: -+; click in window *myw* (2 times for line, 3 times for region). -+(defun wtestc () -+ (let (mymenu result start done) -+ (setq mymenu (menu-create '(quit point line box region) "Choose One:")) -+ (while (not done) -+ (setq result -+ (case (menu-select mymenu) -+ (quit (setq done t)) -+ (point (window-get-point *myw*)) -+ (line (setq start (window-get-point *myw*)) -+ (list start -+ (window-get-line-position *myw* (car start) -+ (cadr start)))) -+ (box (window-get-box-position *myw* 40 20)) -+ (region (window-get-region *myw*)) )) -+ (format t "Result: ~A~%" result) ) -+ (menu-destroy mymenu) )) -+ -+; 09 Sep 91 -+; Illustrate icons in menus -+(defun wtestd () -+ (menu '(("Triangle" . triangle) -+ (dwtest-square . square) -+ (dwtest-circle . circle) -+ hexagon) -+ "Icons in Menu") ) -+ -+(defun dwtest-square (w x y) (window-draw-box-xy w x y 20 20 1)) -+(setf (get 'dwtest-square 'display-size) '(20 20)) -+ -+(defun dwtest-circle (w x y) (window-draw-circle-xy w (+ x 10) (+ y 10) 10 1)) -+(setf (get 'dwtest-circle 'display-size) '(20 20)) -+ -+(defvar mypms nil) -+; 09 Sep 91; 11 Sep 91; 12 Sep 91; 14 Sep 91 -+; Illustrate a diagrammatic menu-like object: square with sensitive spots -+(defun wteste () -+ (let (pm val) -+ (or mypms (mypms-init)) -+ (setq pm (picmenu-create-from-spec mypms "Points on Square")) -+ (setq val (picmenu-select pm)) -+ (picmenu-destroy pm) -+ val )) -+ -+; 14 Sep 91 -+(defun mypms-init () -+ (setq mypms (picmenu-create-spec -+ '((bottom-left ( 20 20)) -+ (center-left ( 20 70)) -+ (top-left ( 20 120)) -+ (bottom-center ( 70 20)) -+ (center ( 70 70) (20 20)) ; larger -+ (top-center ( 70 120)) -+ (bottom-right (120 20)) -+ (center-right (120 70)) -+ (top-right (120 120))) -+ 140 140 'wteste-draw-square t)) ) -+ -+(defvar mypm nil) -+; 10 Sep 91; 11 Sep 91; 12 Sep 91; 14 Sep 91; 17 Sep 91 -+; A picmenu that is "flat" within another window, in this case *myw*. -+; Must do (wtesta) first. -+(defun wtestf () -+ (or mypms (mypms-init)) -+ (or mypm (setq mypm (picmenu-create-from-spec mypms "Points on Square" -+ *myw* 50 50 nil t t))) -+ (picmenu-select mypm)) -+ -+(defun wteste-draw-square (w x y) -+ (window-draw-box-xy w (+ x 20) (+ y 20) 100 100 1)) -+ -+(defvar mym nil) -+; 10 Sep 91; 17 Sep 91 -+; A menu that is "flat" within another window, in this case *myw*. -+; Must do (wtesta) first. -+(defun wtestg () -+ (or mym (setq mym (menu-create '(red white blue) "Flag" *myw* 50 50 nil t))) -+ (menu-select mym)) -+ -+; 09 Oct 91 -+; Demonstrate arrows. Optional arg is line width. -+(defun wtesth ( &optional (lw 1)) -+ (window-clear *myw*) -+ (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 (+ 40 (* i 30)) 160 lw)) -+ (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 (+ 40 (* i 30)) 40 lw)) -+ (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 40 (+ 40 (* i 30)) lw)) -+ (dotimes (i 5) (window-draw-arrow-xy *myw* 100 100 160 (+ 40 (* i 30)) lw)) -+ (dotimes (i 5) (window-draw-arrow-xy *myw* 200 (+ 40 (* i 30)) -+ 240 (+ 40 (* i 30)) -+ (1+ i) )) -+ (window-force-output *myw*) ) -+ -+; 04 Jan 94 -+; Redo some of the arrows from wtesth in color -+(defun wtesti () -+ (window-set-color-rgb *myw* 65535 0 0) -+ (window-draw-arrow-xy *myw* 200 70 240 70 2) -+ (window-set-color-rgb *myw* 0 65535 0) -+ (window-draw-arrow-xy *myw* 200 100 240 100 3) -+ (window-set-color-rgb *myw* 0 0 65535) -+ (window-draw-arrow-xy *myw* 200 130 240 130 4) -+ (window-reset-color *myw*) -+ (window-force-output *myw*) ) -+ -+; 04 Jan 94 -+; Get text from a window. Move mouse pointer into test window. -+; Add characters and/or backspace, Return. -+; Note: it might be necessary to change the keyboard mapping, using -+; (window-init-keyboard-mapping *myw*) and (window-print-keyboard-mapping) -+(defun wtestj () (window-input-string *myw* "Foo" 50 200 200)) -+ -+; 04 Jan 94 -+; Change foreground and background colors and input a string -+(defun wtestk () -+ (window-set-color-rgb *myw* 0 65535 0) ; green foreground -+ (window-set-color-rgb *myw* 0 0 65535 t) ; blue background -+ (prog1 (window-input-string *myw* "Foo" 50 200 200) -+ (window-reset-color *myw*) -+ (window-force-output *myw*) ) ) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_pcalc.lsp -@@ -0,0 +1,133 @@ -+; pcalc.lsp Gordon S. Novak Jr. 20 Oct 94 -+ -+; Pocket calculator implemented using a picmenu. Entry is (pcalc) . -+ -+; Copyright (c) 1994 Gordon S. Novak Jr. and The University of Texas at Austin. -+ -+; See the file gnu.license . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Written by: Gordon S. Novak Jr., Department of Computer Sciences, -+; University of Texas at Austin 78712. novak@cs.utexas.edu -+ -+ -+(defvar *pcalcw* nil) ; window -+(defvar *pcalcm* nil) ; picmenu -+ -+(defun pcalc-draw (w x y) -+ (let (items item over up) -+ (window-open w) -+ (window-clear w) -+ (window-draw-rcbox-xy *pcalcw* 0 0 170 215 10 2) -+ (window-draw-rcbox-xy *pcalcw* 10 180 150 25 6) -+ (setq items '(0 \. = + 1 2 3 - 4 5 6 * 7 8 9 / off ac ce +-)) -+ (dotimes (i 5) -+ (setq up (+ 10 (* i 35))) -+ (dotimes (j 4) -+ (setq over (+ 10 (* j 40))) -+ (setq item (pop items)) -+ (window-printat-xy *pcalcw* item -+ (+ over 15 (* (if (numberp item) 1 -+ (length (stringify item))) -+ -5)) (+ up 3)) -+ (window-draw-rcbox-xy *pcalcw* over up 28 20 6) )) -+ (window-force-output) )) -+ -+(defun pcalc-init () -+ (prog ((n 15)) -+ (setq *pcalcw* (window-create 170 215 "pcalc" nil nil nil '9x15)) -+ lp (when (and (> n 0) (null (window-wait-exposure *pcalcw*))) -+ (sleep 1.0) (decf n) (go lp)) -+ (setq *pcalcm* -+ (picmenu-create -+ '((0 (24 20) (24 16)) -+ (\. (64 20) (24 16)) -+ (= (104 20) (24 16)) -+ (+ (144 20) (24 16)) -+ (1 (24 55) (24 16)) -+ (2 (64 55) (24 16)) -+ (3 (104 55) (24 16)) -+ (- (144 55) (24 16)) -+ (4 (24 90) (24 16)) -+ (5 (64 90) (24 16)) -+ (6 (104 90) (24 16)) -+ (* (144 90) (24 16)) -+ (7 (24 125) (24 16)) -+ (8 (64 125) (24 16)) -+ (9 (104 125) (24 16)) -+ (/ (144 125) (24 16)) -+ (off (24 160) (24 16)) -+ (ac (64 160) (24 16)) -+ (ce (104 160) (24 16)) -+ (+- (144 160) (24 16))) -+ 170 215 'pcalc-draw nil nil *pcalcw* 0 0 t t)) )) -+ -+(defun pcalc-display (val) -+ (let (str) -+ (window-erase-area-xy *pcalcw* 15 182 140 20) -+ (setq str (if (integerp val) -+ (princ-to-string val) -+ (format nil "~8,4F" val))) -+ (window-printat-xy *pcalcw* str (- 131 (* 9 (length str))) 185) -+ (window-force-output) )) -+ -+ -+(defun pcalc () -+ (prog (key (ent 0) (ac 0) decpt lastop lastkey) -+ (or *pcalcw* (pcalc-init)) -+ (pcalc-draw *pcalcw* 0 0) -+ (pcalc-display ent) -+ lp (setq key (picmenu-select *pcalcm*)) -+ (if (numberp key) -+ (progn (when (eq lastkey '=) -+ (setq ent 0) (setq decpt nil) (setq ac 0) (setq lastop nil)) -+ (if decpt -+ (progn (setq ent (+ ent (* key decpt))) -+ (setq decpt (/ decpt 10.0)) ) -+ (setq ent (+ key (* ent 10))) ) -+ (pcalc-display ent)) -+ (case key -+ ((+ - * /) -+ (if lastop -+ (progn (setq ac (if (eq lastop '/) -+ (/ (float ac) ent) -+ (funcall lastop ac ent))) -+ (pcalc-display ac)) -+ (setq ac ent)) -+ (setq lastop key) -+ (setq ent 0) -+ (setq decpt nil)) -+ (= (if lastop -+ (progn (setq ent (if (eq lastop '/) -+ (/ (float ac) ent) -+ (funcall lastop ac ent))) -+ (pcalc-display ent))) -+ (setq lastop nil)) -+ (\. (when (eq lastkey '=) -+ (setq ent 0) (setq ac 0) (setq lastop nil)) -+ (setq decpt 0.1) -+ (setq ent (float ent)) -+ (pcalc-display ent)) -+ (+- (setq ent (- ent)) -+ (pcalc-display ent)) -+ (ce (setq ent 0) (setq decpt nil) (pcalc-display ent)) -+ (ac (setq ent 0) (setq decpt nil) (setq ac 0) (setq lastop nil) -+ (pcalc-display ent)) -+ (off (window-close *pcalcw*) -+ (return nil)) ) ) -+ (setq lastkey key) -+ (go lp) )) -+ ---- gcl-2.6.7.orig/xgcl-2/README -+++ gcl-2.6.7/xgcl-2/README -@@ -1,7 +1,88 @@ --README for Xgcl: Gnu Common Lisp with interface to X windows. 15 Mar 95 -+README for xgcl: Gnu Common Lisp interface to X windows. 28 Aug 2006 - --Copyright (c) 1995 Gordon S. Novak Jr., Hiep Huu Nguyen, William F. Schelter, --and The University of Texas at Austin. -+Distributed under GNU Public License; copyright notices at the bottom. -+ -+xgcl is an interface from Gnu Common Lisp to the X library, Xlib. -+ -+This software provides a lightweight and fairy easy-to-use way to: -+ * Draw diagrams from Lisp -+ * Create interactive graphical interfaces -+ * Make the interactive Lisp interfaces available via the Web -+ -+Beginning with release 2.6.8, xgcl is built into the make of GCL. -+ -+There is a "raw" interface to the Xlib, and an "easy-to-use" -+interface built on top of it; we will only discuss the "easy-to-use" -+version. -+ -+To use xgcl, start GCL and enter: (xgcl) -+This will load xgcl and print a message inviting you to try (xgcl-demo). -+(xgcl-demo) will create a small window and draw some examples in it. -+You can try (wtestc), (wtestd), ... (wtestk) to try some other things. -+ -+The xgcl files are located in the directory xgcl-2/ relative to the -+GCL directory. -+ -+The file gcl_dwtest.lsp contains the test examples; one way to -+get started quickly is by using this file for examples. -+ -+There is also documentation: -+ dwdoc.tex -+ dwdoc.dvi -+ dwdoc.html http://www.cs.utexas.edu/users/novak/dwdoc.html -+ dwdoc.pdf -+ dwdoc.ps -+ -+To use the basic xgcl, you only need to invoke (xgcl). -+To use some of the more advanced features such as menu-set, described -+below, also load the file gcl_dwimportsb.lsp immediately after -+invoking (xgcl), to import symbols. -+ -+Additional files that may be useful: -+ -+ gcl_menu-set.lsp Source and some comments for menu-set -+ gcl_menu-settrans.lsp menu-set translated to Common Lisp -+ gcl_pcalc.lsp Pocket calculator example -+ gcl_draw-gates.lsp Draw boolean gate symbols -+ gcl_draw.lsp Interactive drawing program source -+ gcl_drawtrans.lsp Drawing program translated to Common Lisp -+ gcl_dwindow.lsp Easy-to-use interface source with comments -+ gcl_dwtrans.lsp Easy-to-use interface translated to Common Lisp -+ gcl_editors.lsp Editors for colors etc. -+ gcl_editorstrans.lsp Editors translated to Common Lisp -+ gcl_ice-cream.lsp Example created using Draw -+ lispserver.lsp Example web demo: a Lisp server -+ lispservertrans.lsp Lisp server translated to Common Lisp -+ Xakcl.paper Documentation on the "raw" Xlib interface -+ Xakcl.example.lsp some PRIMITIVE examples -+ -+ -+This software provides a way to interface Lisp programs to the Web; see: -+ -+ http://www.cs.utexas.edu/users/novak/dwindow.html -+ -+There are two ways to accomplish a Web interface. -+ -+The first uses X directly, and requires that the user have an X server; -+this is reliable and fast, but it only works for the Linux/Mac/Cygwin -+subset of the world. There can also be firewall issues. -+ -+The other option uses WeirdX, an X server written in Java. -+The WeirdX interface is often slow, and sometimes doesn't work at all, -+but when it works, it works with any web browser, even on Windows. -+The WeirdX interface tends to leave "mouse droppings" on interactive -+drawings. -+ -+There are numerous examples of these web interfaces at: -+ -+ http://www.cs.utexas.edu/users/novak/ -+ -+The Draw demo is a good one to try. -+ -+--------------------------------------------------------------------------- -+ -+Copyright (c) 2006 Gordon S. Novak Jr., Hiep Huu Nguyen, -+William F. Schelter, Camm Maguire, and The University of Texas at Austin. - - Copyright 1987 by Digital Equipment Corporation and Massachusetts Institute - of Technology. -@@ -10,8 +91,8 @@ See the files gnu.license and dec.copyri - - This program 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 1, or (at your option) --any later version. -+the Free Software Foundation; either version 2 of the License, or -+(at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of -@@ -20,193 +101,19 @@ GNU General Public License for more deta - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software --Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -+ -+Some of the files that interface to the Xlib are adapted from DEC/MIT files. -+See the file dec.copyright for details. - - Written by: Gordon S. Novak Jr., Hiep Huu Nguyen, and William F. Schelter, --Department of Computer Sciences, University of Texas at Austin 78712. -+Department of Computer Sciences, University of Texas at Austin 78712, -+and Camm Maguire. - --Xgcl contains an interface from Gnu Common Lisp to the X library, Xlib, -+Xgcl is an interface from Gnu Common Lisp to the X library, Xlib, - adapted from X Consortium code by Hiep Huu Nguyen (hiep@cs.utexas.edu). --Xgcl has been tested on the HP9000, SUN4, and IBM RS/6000. --It has been modified by W. Schelter to make on machines that do not --support the faslink. In order to compile it you must have gcl sources. - - dwindow.lsp is an "easy to use" interface from Lisp to the Xlib, - written by Gordon S. Novak Jr. (novak@cs.utexas.edu) It is written in - GLISP and has been translated into the Common Lisp file dwtrans.lsp, --which is incorporated into the make of Xgcl. Documentation is --provided in the LaTeX file dwdoc.tex . Test files are dwtest.lsp, --pcalc.lsp , and drawtrans.lsp . -- -- --This software and GCL can be ftp'ed from: -- math.utexas.edu /pub/gcl/ -- cli.com 192.31.85.1 /pub/gcl/ -- --The file is called xgcl-2.tgz . ftp it to your site and uncompress it: -- gzip -dc xgcl-2.tgz | tar xvf - -- --The directory xgcl-2 will then contain the files: -- --Events.c --README --X.lsp --X10.lsp --XAtom.lsp --XStruct-2.c --XStruct-4.c --XStruct-l-3.lsp --Xakcl.example.lsp --Xakcl.paper --Xinit.lsp --Xlib.lsp --Xstruct.lsp --Xutil-2.c --Xutil.lsp --dec.copyright --defentry-events.lsp --dispatch-events.lsp --draw-gates.lsp --draw.lsp --drawtrans.lsp --dwdoc.tex --dwimports.lsp --dwindow.lsp --dwsyms.lsp --dwtest.lsp --dwtrans.lsp --general-c.c --general.lsp --gnu.license --ice-cream.lsp --imports.lsp --init_xgcl.lsp --keysymdef.lsp --makefile --menu-set.lsp --pcalc.lsp --sysdef.lisp --sysinit.lsp --version -- -- --These files contain: -- --c code necesary for some general facilities and interface into X, in the files: -- --Events.c --XStruct-4.c --XStruct-2.c --Xutil-2.c --general-c.c -- -- --The shell makefile that compiles and creates Xgcl is: -- --makefile -- -- --For reference the lisp interfaces to functions reside in: -- --Xlib.lsp --Xstruct.lsp --general.lsp --Xutil.lsp --XStruct-l-3.lsp --defentry-events.lsp -- -- --Constant declarations are in: -- --X.lsp --XAtom.lsp --keysymdef.lsp --X10.lsp -- -- --These files correspond to C header files for X windows: -- --Xlib.lsp --Xutil.lsp --X.lsp --XAtom.lsp --keysymdef.lsp --X10.lsp -- --What little documentation there is: Xakcl.paper --Also see Xakcl.example.lsp for some PRIMITIVE examples. -- --The dwindow files are as follows: -- --dwindow.lsp source code, written in GLISP ("documentation" of dwtrans.lsp) --dwtrans.lsp dwindow.lsp translated to plain Common Lisp --dwdoc.tex documentation in LaTeX --dwtest.lsp examples of use of dwindow --pcalc.lsp pocket calculator --menu-set.lsp multiple active menus in a single window (GLISP) --draw.lsp interactive drawing program (GLISP) --draw-gates.lsp draw nand gates etc. --drawtrans.lsp draw.lsp and menu-set.lsp translated to plain Common Lisp --imports.lsp imports the window symbols into the :user package --dwimports.lsp a shorter set of imports used by the dwindow package --dwsyms.lsp imports symbols needed to run dwtrans from Lisp source -- --To make Xgcl: -- --1. Make GCL first. A running GCL is required to make Xgcl. -- --2. Put the xgcl-2.tgz file in the gcl-1.1 directory. -- --3. Uncompress it with: gzip -dc xgcl-2.tgz | tar xvf - -- --4. cd xgcl-2 -- --5. edit the makefile and change the variables GCLDIR and SYSDIR -- to point to the gcl-1.1 and xgcl-2 directories, respectively. -- If needed, edit the X library paths. -- --6. make -- This makes an image saved_xgcl in the GCLDIR/unixport directory. -- It will also make a one-line command Xgcl that will execute it. -- --7. You can try out the basic system as follows (where % is the Unix prompt): -- % Xgcl -- -- GCL (GNU Common Lisp) Version(1.1) Tue Sep 27 19:37:50 CDT 1994 -- Contains Enhancements by W. Schelter -- >(in-package "XLIB") -- -- XLIB>(Xinit) -- NIL -- -- XLIB>(open-window) -- 10485761 -- -- >(bye) -- Bye. -- --As you can see, all that happened was that a simple window appeared. --Read the paper Xakcl.paper for more details. -- -- --To try the dwindow package, do the following (in xgcl-2 directory): -- --% Xgcl --(load "imports.lsp") ; import window symbols -- do this before anything else --(load "dwtest.lsp") ; load the test functions --(wtesta) ; make a window --(wtestb) ; draw some stuff --(wtestc) ; choose from menu, then click in window --(wtestd) ; a menu with icons --(wteste) ; a picture menu with sensitive points --(wtesth) ; arrows --(wtesti) ; arrows in color --(wtestj) ; character input: type with cursor in the window --(wtestk) ; character input in color --(load "pcalc.lsp") --(pcalc) ; pocket calculator --(load "drawtrans.lsp") --(load "ice-cream.lsp"); an existing drawing --(draw 'ice-cream) ; examine / edit the drawing --(draw 'foo) ; make a drawing named foo. -- ; when done, do Origin (to Zero), Program, LaTex -+which is incorporated into the make of Xgcl. ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_menu-settrans.lsp -@@ -0,0 +1,531 @@ -+; 07 Jan 2010 16:46:11 EST -+ -+; menu-settrans.lsp -- translation of menu-set.lsp Gordon S. Novak Jr. -+ -+; Copyright 2006 Gordon S. Novak Jr. and The University of Texas at Austin. -+ -+; This program 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 program 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 program; if not, write to the Free Software -+; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -+ -+; Written by: Gordon S. Novak Jr., Department of Computer Sciences, -+; University of Texas at Austin 78712. novak@cs.utexas.edu -+ -+(defmacro nconc1 (lst x) `(nconc ,lst (cons ,x nil))) -+ -+(defmacro glmethod (class selector) -+ `(cadr (assoc ,selector (getf (cdr (get ,class 'glstructure)) 'msg))) ) -+ -+(SETF (GET 'MENU-SET 'GLSTRUCTURE) -+ '((LISTOBJECT (WINDOW WINDOW) (MENU-ITEMS (LISTOF MENU-SET-ITEM)) -+ (COMMANDFN ANYTHING)) -+ MSG -+ ((DRAW MENU-SET-DRAW) (SELECT MENU-SET-SELECT) -+ (NAMED-MENU MENU-SET-NAMED-MENU) -+ (NAMED-ITEM MENU-SET-NAMED-ITEM) (ADD-MENU MENU-SET-ADD-MENU) -+ (ADD-PICMENU MENU-SET-ADD-PICMENU) -+ (ADD-COMPONENT MENU-SET-ADD-COMPONENT) -+ (ADD-BARMENU MENU-SET-ADD-BARMENU) -+ (ADD-ITEM MENU-SET-ADD-ITEM) (FIND-ITEM MENU-SET-FIND-ITEM) -+ (DELETE-ITEM MENU-SET-DELETE-ITEM) -+ (REMOVE-ITEMS MENU-SET-REMOVE-ITEMS) -+ (ITEM-POSITION MENU-SET-ITEM-POSITION) (ITEMP MENU-SET-ITEMP) -+ (ADJUST MENU-SET-ADJUST) (MOVE MENU-SET-MOVE) -+ (DRAW-CONN MENU-SET-DRAW-CONN)))) -+(SETF (GET 'MENU-SET-ITEM 'GLSTRUCTURE) -+ '((LIST (MENU-NAME SYMBOL) (SYM ANYTHING) (MENU MENU-SET-MENU)) -+ PROP -+ ((LEFT ((PARENT-OFFSET-X MENU))) -+ (BOTTOM ((PARENT-OFFSET-Y MENU))) -+ (WIDTH ((PICTURE-WIDTH MENU))) -+ (HEIGHT ((PICTURE-HEIGHT MENU)))) -+ SUPERS (REGION))) -+(SETF (GET 'MENU-SET-MENU 'GLSTRUCTURE) -+ '((TRANSPARENT MENU) MSG ((DRAW MENU-MDRAW)))) -+(SETF (GET 'MENU-PORT 'GLSTRUCTURE) -+ '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL)))) -+(SETF (GET 'MENU-SELECTION 'GLSTRUCTURE) -+ '((LIST (PORT SYMBOL) (MENU-NAME SYMBOL) (BUTTON INTEGER)))) -+(SETF (GET 'MENU-SET-CONN 'GLSTRUCTURE) -+ '((LIST (FROM MENU-PORT) (TO MENU-PORT)))) -+(SETF (GET 'MENU-CONNS 'GLSTRUCTURE) -+ '((LISTOBJECT (MENU-SET MENU-SET) -+ (CONNECTIONS (LISTOF MENU-SET-CONN))) -+ PROP ((WINDOW ((WINDOW (MENU-SET SELF))))) MSG -+ ((DRAW MENU-CONNS-DRAW) (REDRAW MENU-CONNS-REDRAW) -+ (MOVE MENU-CONNS-MOVE) (ADD-CONN MENU-CONNS-ADD-CONN) -+ (ADD-ITEM MENU-CONNS-ADD-ITEM OPEN T) -+ (FIND-CONN MENU-CONNS-FIND-CONN) -+ (FIND-ITEM MENU-CONNS-FIND-ITEM) -+ (DELETE-ITEM MENU-CONNS-DELETE-ITEM) -+ (DELETE-CONN MENU-CONNS-DELETE-CONN) -+ (REMOVE-ITEMS MENU-CONNS-REMOVE-ITEMS) -+ (FIND-CONNS MENU-CONNS-FIND-CONNS) -+ (CONNECTED-PORTS MENU-CONNS-CONNECTED-PORTS) -+ (NEW-CONN MENU-CONNS-NEW-CONN) -+ (NAMED-MENU MENU-CONNS-NAMED-MENU) -+ (NAMED-ITEM MENU-CONNS-NAMED-ITEM)))) -+ -+ -+(DEFUN MENU-SET-CREATE (W &OPTIONAL FN) (LIST 'MENU-SET W NIL FN)) -+(SETF (GET 'MENU-SET-CREATE 'GLARGUMENTS) -+ '((W WINDOW) (&OPTIONAL NIL))) -+(SETF (GET 'MENU-SET-CREATE 'GLFNRESULTTYPE) 'MENU-SET) -+ -+ -+(DEFUN MENU-SET-SELECT (MS &OPTIONAL REDRAW ENABLED) -+ (LET (RES RESB ITM SEL LASTX LASTY) -+ (IF REDRAW (MENU-SET-DRAW MS)) -+ (WHILE (NOT (OR RES RESB)) -+ (SETQ ITM -+ (WINDOW-TRACK-MOUSE (CADR MS) -+ #'(LAMBDA (X Y CODE) -+ (OR (AND (PLUSP CODE) (SETQ LASTX X) -+ (SETQ LASTY Y) CODE) -+ (SOME #'(LAMBDA (GLVAR237) -+ (IF -+ (AND -+ (BETWEEN X -+ (FIFTH (CADDR GLVAR237)) -+ (+ (FIFTH (CADDR GLVAR237)) -+ (SEVENTH (CADDR GLVAR237)))) -+ (BETWEEN Y -+ (SIXTH (CADDR GLVAR237)) -+ (+ (SIXTH (CADDR GLVAR237)) -+ (EIGHTH (CADDR GLVAR237))))) -+ GLVAR237)) -+ (CADDR MS)))))) -+ (IF (NUMBERP ITM) -+ (SETQ RESB (LIST (LIST LASTX LASTY) 'BACKGROUND ITM)) -+ (WHEN (OR (ATOM ENABLED) (MEMBER (CAR ITM) ENABLED)) -+ (SETQ SEL (MENU-MSELECT (CADDR ITM) (EQ ENABLED T))) -+ (IF SEL -+ (SETQ RES (LIST SEL (CAR ITM) *WINDOW-MENU-CODE*)) -+ (IF (AND *WINDOW-MENU-CODE* -+ (NOT (ZEROP *WINDOW-MENU-CODE*))) -+ (SETQ RES -+ (LIST NIL (CAR ITM) *WINDOW-MENU-CODE*))))))) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (OR RES RESB))) -+(SETF (GET 'MENU-SET-SELECT 'GLARGUMENTS) -+ '((MS MENU-SET) (&OPTIONAL BOOLEAN) (REDRAW (LISTOF SYMBOL)))) -+(SETF (GET 'MENU-SET-SELECT 'GLFNRESULTTYPE) 'MENU-SELECTION) -+ -+ -+(DEFUN MENU-SET-ADD-MENU (MS NAME SYM TITLE ITEMS &OPTIONAL OFFSET) -+ (LET (MENU) -+ (SETQ MENU -+ (MENU-CREATE ITEMS TITLE (CADR MS) (CAR OFFSET) (CADR OFFSET) -+ T T)) -+ (MENU-INIT MENU) -+ (IF (NOT OFFSET) -+ (SETQ OFFSET -+ (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) -+ (EIGHTH MENU)))) -+ (SETF (FIFTH MENU) (CAR OFFSET)) -+ (SETF (SIXTH MENU) (CADR OFFSET)) -+ (MENU-SET-ADD-ITEM MS NAME SYM MENU))) -+(SETF (GET 'MENU-SET-ADD-MENU 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) -+ (ITEMS NIL) (&OPTIONAL VECTOR))) -+(SETF (GET 'MENU-SET-ADD-MENU 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-SET-ADD-ITEM (MS NAME SYM MENU) -+ (SETF (CADDR MS) (NCONC (CADDR MS) (CONS (LIST NAME SYM MENU) NIL)))) -+(SETF (GET 'MENU-SET-ADD-ITEM 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) -+(SETF (GET 'MENU-SET-ADD-ITEM 'GLFNRESULTTYPE) '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-SET-REMOVE-ITEMS (MS) (SETF (CADDR MS) NIL)) -+(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLARGUMENTS) '((MS MENU-SET))) -+(SETF (GET 'MENU-SET-REMOVE-ITEMS 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-SET-ADD-PICMENU -+ (MS NAME SYM TITLE SPEC &OPTIONAL OFFSET NOBOX) -+ (LET (MENU MAXWIDTH MAXHEIGHT) -+ (IF (AND SPEC (SYMBOLP SPEC)) (SETQ SPEC (GET SPEC 'PICMENU-SPEC))) -+ (SETQ MENU -+ (PICMENU-CREATE-FROM-SPEC SPEC TITLE (CADR MS) (CAR OFFSET) -+ (CADR OFFSET) T T (NOT NOBOX))) -+ (SETQ MAXWIDTH -+ (MAX (IF TITLE (+ 6 (* 9 (LENGTH TITLE))) 0) (CADR SPEC))) -+ (SETQ MAXHEIGHT (+ (IF TITLE 15 0) (CADDR SPEC))) -+ (IF (NOT OFFSET) -+ (SETQ OFFSET -+ (WINDOW-GET-BOX-POSITION (CADR MS) MAXWIDTH MAXHEIGHT))) -+ (SETF (FIFTH MENU) (CAR OFFSET)) -+ (SETF (SIXTH MENU) (CADR OFFSET)) -+ (MENU-SET-ADD-ITEM MS NAME SYM MENU))) -+(SETF (GET 'MENU-SET-ADD-PICMENU 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (TITLE STRING) -+ (SPEC PICMENU-SPEC) (&OPTIONAL VECTOR) (OFFSET BOOLEAN))) -+(SETF (GET 'MENU-SET-ADD-PICMENU 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-SET-ADD-COMPONENT (MS NAME &OPTIONAL OFFSET) -+ (MENU-SET-ADD-PICMENU MS (MENU-SET-NAME NAME) NAME NIL NAME OFFSET T)) -+(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL) (&OPTIONAL VECTOR))) -+(SETF (GET 'MENU-SET-ADD-COMPONENT 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-SET-ADD-BARMENU (MS NAME SYM MENU TITLE &OPTIONAL OFFSET) -+ (BARMENU-INIT MENU) -+ (IF (NOT OFFSET) -+ (SETQ OFFSET -+ (WINDOW-GET-BOX-POSITION (CADR MS) (SEVENTH MENU) -+ (EIGHTH MENU)))) -+ (SETF (FIFTH MENU) (CAR OFFSET)) -+ (SETF (SIXTH MENU) (CADR OFFSET)) -+ (MENU-SET-ADD-ITEM MS NAME SYM MENU)) -+(SETF (GET 'MENU-SET-ADD-BARMENU 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL) (SYM SYMBOL) (MENU BARMENU) -+ (TITLE STRING) (&OPTIONAL VECTOR))) -+(SETF (GET 'MENU-SET-ADD-BARMENU 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-SET-NAME (NM) -+ (INTERN (SYMBOL-NAME (GENSYM (SYMBOL-NAME NM))))) -+(SETF (GET 'MENU-SET-NAME 'GLARGUMENTS) '((NM SYMBOL))) -+(SETF (GET 'MENU-SET-NAME 'GLFNRESULTTYPE) 'SYMBOL) -+ -+ -+(DEFUN MENU-SET-NAMED-ITEM (MS NAME) (ASSOC NAME (CADDR MS))) -+(SETF (GET 'MENU-SET-NAMED-ITEM 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL))) -+(SETF (GET 'MENU-SET-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) -+ -+ -+(DEFUN MENU-SET-NAMED-MENU (MS NAME) -+ (CADDR (MENU-SET-NAMED-ITEM MS NAME))) -+(SETF (GET 'MENU-SET-NAMED-MENU 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL))) -+(SETF (GET 'MENU-SET-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) -+ -+ -+(DEFUN MENU-SET-ITEMP (MS NAME ITEMNAME) -+ (LET ((THISMENU (MENU-SET-NAMED-MENU MS NAME))) -+ (IF (EQ (FIRST THISMENU) 'MENU) -+ (SOME #'(LAMBDA (X) -+ (OR (EQ X ITEMNAME) -+ (AND (CONSP X) (EQ (CAR X) ITEMNAME)))) -+ (NTH 13 THISMENU)) -+ (IF (EQ (FIRST THISMENU) 'PICMENU) -+ (ASSOC ITEMNAME (CADDDR (NTH 10 THISMENU))))))) -+(SETF (GET 'MENU-SET-ITEMP 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL) (ITEMNAME SYMBOL))) -+(SETF (GET 'MENU-SET-ITEMP 'GLFNRESULTTYPE) 'BOOLEAN) -+ -+ -+(DEFUN MENU-CONNS-NAMED-ITEM (MC NAME) -+ (MENU-SET-NAMED-ITEM (CADR MC) NAME)) -+(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLARGUMENTS) -+ '((MC MENU-CONNS) (NAME SYMBOL))) -+(SETF (GET 'MENU-CONNS-NAMED-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) -+ -+ -+(DEFUN MENU-CONNS-NAMED-MENU (MC NAME) -+ (MENU-SET-NAMED-MENU (CADR MC) NAME)) -+(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLARGUMENTS) -+ '((MC MENU-CONNS) (NAME SYMBOL))) -+(SETF (GET 'MENU-CONNS-NAMED-MENU 'GLFNRESULTTYPE) 'MENU-SET-MENU) -+ -+ -+(DEFUN MENU-SET-FIND-ITEM (MS POS) -+ (LET (MITEM) -+ (DOLIST (MI (CADDR MS)) -+ (IF (AND (BETWEEN (CAR POS) -+ (LET ((SELF (CADDR MI))) -+ (IF (CADDR SELF) (FIFTH SELF) 0)) -+ (+ (LET ((SELF (CADDR MI))) -+ (IF (CADDR SELF) (FIFTH SELF) 0)) -+ (SEVENTH (CADDR MI)))) -+ (BETWEEN (CADR POS) -+ (LET ((SELF (CADDR MI))) -+ (IF (CADDR SELF) (SIXTH SELF) 0)) -+ (+ (LET ((SELF (CADDR MI))) -+ (IF (CADDR SELF) (SIXTH SELF) 0)) -+ (EIGHTH (CADDR MI))))) -+ (SETQ MITEM MI))) -+ MITEM)) -+(SETF (GET 'MENU-SET-FIND-ITEM 'GLARGUMENTS) -+ '((MS MENU-SET) (POS VECTOR))) -+(SETF (GET 'MENU-SET-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) -+ -+ -+(DEFUN MENU-SET-DELETE-ITEM (MS MI) -+ (SETF (CADDR MS) (REMOVE MI (CADDR MS)))) -+(SETF (GET 'MENU-SET-DELETE-ITEM 'GLARGUMENTS) -+ '((MS MENU-SET) (MI MENU-SET-ITEM))) -+(SETF (GET 'MENU-SET-DELETE-ITEM 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-SET-MOVE (MS) -+ (LET (SEL M) -+ (SETQ SEL (MENU-SET-SELECT MS NIL T)) -+ (SETQ M (MENU-SET-NAMED-MENU MS (CADR SEL))) -+ (MENU-REPOSITION M))) -+ -+(DEFUN MENU-MDRAW (M) -+ (CASE (FIRST M) -+ (MENU (MENU-DRAW M)) -+ (PICMENU (PICMENU-DRAW M)) -+ (BARMENU (BARMENU-DRAW M)) -+ (TEXTMENU (TEXTMENU-DRAW M)) -+ (EDITMENU (EDITMENU-DRAW M)) -+ (T (GLSEND M DRAW)))) -+ -+(DEFUN MENU-MSELECT (M &OPTIONAL ANYCLICK) -+ (CASE (FIRST M) -+ (MENU (MENU-SELECT M T)) -+ (PICMENU (PICMENU-SELECT M T ANYCLICK)) -+ (BARMENU (BARMENU-SELECT M)) -+ (TEXTMENU (TEXTMENU-SELECT M T)) -+ (EDITMENU (EDITMENU-SELECT M T)) -+ (T (GLSEND M SELECT)))) -+ -+(DEFUN MENU-MITEM-POSITION (M NAME LOC) -+ (CASE (FIRST M) -+ (MENU (MENU-ITEM-POSITION M NAME LOC)) -+ (PICMENU (PICMENU-ITEM-POSITION M NAME LOC)) -+ (T (GLSEND M ITEM-POSITION NAME LOC)))) -+ -+(DEFUN MENU-SET-DRAW (MS) -+ (XMAPWINDOW *WINDOW-DISPLAY* (CADADR MS)) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (WINDOW-WAIT-EXPOSURE (CADR MS)) -+ (DOLIST (ITEM (CADDR MS)) (MENU-MDRAW (CADDR ITEM)))) -+ -+(DEFUN MENU-SET-ITEM-POSITION (MS DESC &OPTIONAL LOC) -+ (LET (M) -+ (SETQ M (MENU-SET-NAMED-MENU MS (CADR DESC))) -+ (OR (MENU-MITEM-POSITION M (CAR DESC) LOC) -+ (MENU-MITEM-POSITION M NIL LOC)))) -+(SETF (GET 'MENU-SET-ITEM-POSITION 'GLARGUMENTS) -+ '((MS MENU-SET) (DESC MENU-PORT) (&OPTIONAL SYMBOL))) -+(SETF (GET 'MENU-SET-ITEM-POSITION 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN MENU-SET-DRAW-CONN (MS CONN) -+ (LET (PA PB TMP (DESCA (CAR CONN)) (DESCB (CADR CONN))) -+ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) -+ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) -+ (WHEN (> (CAR PA) (CAR PB)) -+ (SETQ TMP DESCA) -+ (SETQ DESCA DESCB) -+ (SETQ DESCB TMP)) -+ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) -+ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) -+ (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PA) (CADR PA) 3 NIL) -+ (WINDOW-DRAW-LINE-XY (CADR MS) (CAR PA) (CADR PA) (CAR PB) -+ (CADR PB) NIL) -+ (WINDOW-DRAW-CIRCLE-XY (CADR MS) (CAR PB) (CADR PB) 3 NIL) -+ (XFLUSH *WINDOW-DISPLAY*))) -+ -+(DEFUN MENU-SET-ADJUST (MS NAME EDGE FROM OFFSET) -+ (LET (M FROMM PLACE) -+ (WHEN (SETQ M (MENU-SET-NAMED-ITEM MS NAME)) -+ (IF FROM -+ (PROGN -+ (SETQ FROMM (MENU-SET-NAMED-ITEM MS FROM)) -+ (SETQ PLACE -+ (CASE EDGE -+ (TOP (SIXTH (CADDR FROMM))) -+ (BOTTOM (+ (SIXTH (CADDR FROMM)) -+ (EIGHTH (CADDR FROMM)))) -+ (LEFT (+ (FIFTH (CADDR FROMM)) -+ (SEVENTH (CADDR FROMM)))) -+ (RIGHT (FIFTH (CADDR FROMM)))))) -+ (SETQ PLACE -+ (CASE EDGE -+ (TOP (CADDDR (CADR MS))) -+ ((BOTTOM LEFT) 0) -+ (RIGHT (FIFTH (CADR MS)))))) -+ (CASE EDGE -+ (TOP (SETF (SIXTH (CADDR M)) -+ (- (- PLACE (EIGHTH (CADDR M))) OFFSET))) -+ (BOTTOM (SETF (SIXTH (CADDR M)) (+ PLACE OFFSET))) -+ (LEFT (SETF (FIFTH (CADDR M)) (+ PLACE OFFSET))) -+ (RIGHT (SETF (FIFTH (CADDR M)) -+ (- (- PLACE (SEVENTH (CADDR M))) OFFSET))))))) -+(SETF (GET 'MENU-SET-ADJUST 'GLARGUMENTS) -+ '((MS MENU-SET) (NAME SYMBOL) (EDGE SYMBOL) (FROM SYMBOL) -+ (OFFSET INTEGER))) -+(SETF (GET 'MENU-SET-ADJUST 'GLFNRESULTTYPE) 'INTEGER) -+ -+ -+(DEFUN VECTOR-SNAP (FIXED APPROX &OPTIONAL TOLERANCE) -+ (OR TOLERANCE (SETQ TOLERANCE 10)) -+ (IF (< (ABS (- (CAR FIXED) (CAR APPROX))) TOLERANCE) -+ (LIST (CAR FIXED) (CADR APPROX)) -+ (IF (< (ABS (- (CADR FIXED) (CADR APPROX))) TOLERANCE) -+ (LIST (CAR APPROX) (CADR FIXED)) APPROX))) -+(SETF (GET 'VECTOR-SNAP 'GLARGUMENTS) -+ '((FIXED VECTOR) (APPROX VECTOR) (&OPTIONAL NIL))) -+(SETF (GET 'VECTOR-SNAP 'GLFNRESULTTYPE) 'VECTOR) -+ -+ -+(DEFUN MENU-CONNS-CREATE (MS) (LIST 'MENU-CONNS MS NIL)) -+(SETF (GET 'MENU-CONNS-CREATE 'GLARGUMENTS) '((MS MENU-SET))) -+(SETF (GET 'MENU-CONNS-CREATE 'GLFNRESULTTYPE) 'MENU-CONNS) -+ -+ -+(DEFUN MENU-CONNS-DRAW (MC) -+ (MENU-SET-DRAW (CADR MC)) -+ (DOLIST (C (CADDR MC)) (MENU-SET-DRAW-CONN (CADR MC) C))) -+ -+(DEFUN MENU-CONNS-MOVE (MC) -+ (MENU-SET-MOVE (CADR MC)) -+ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (MENU-CONNS-DRAW MC)) -+ -+(DEFUN MENU-CONNS-REDRAW (MC) -+ (XCLEARWINDOW *WINDOW-DISPLAY* (CADR (CADADR MC))) -+ (XFLUSH *WINDOW-DISPLAY*) -+ (MENU-CONNS-DRAW MC)) -+ -+(DEFUN MENU-CONNS-ADD-CONN (MC) -+ (LET (SEL SELB CONN) -+ (SETQ SEL (MENU-SET-SELECT (CADR MC))) -+ (IF (EQ (CADR SEL) 'BACKGROUND) SEL -+ (PROGN -+ (SETQ SELB (MENU-SET-SELECT (CADR MC))) -+ (WHEN (NOT (EQ (CADR SELB) 'BACKGROUND)) -+ (SETQ CONN (LIST SEL SELB)) -+ (MENU-SET-DRAW-CONN (CADR MC) CONN) -+ (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL)))) -+ NIL)))) -+(SETF (GET 'MENU-CONNS-ADD-CONN 'GLARGUMENTS) '((MC MENU-CONNS))) -+(SETF (GET 'MENU-CONNS-ADD-CONN 'GLFNRESULTTYPE) 'MENU-SELECTION) -+ -+ -+(DEFUN MENU-CONNS-NEW-CONN (MC FROMNAME FROMPORT TONAME TOPORT) -+ (LET (CONN) -+ (SETQ CONN (LIST (LIST FROMPORT FROMNAME) (LIST TOPORT TONAME))) -+ (SETF (CADDR MC) (NCONC (CADDR MC) (CONS CONN NIL))))) -+(SETF (GET 'MENU-CONNS-NEW-CONN 'GLARGUMENTS) -+ '((MC MENU-CONNS) (FROMNAME SYMBOL) (FROMPORT SYMBOL) -+ (TONAME SYMBOL) (TOPORT SYMBOL))) -+(SETF (GET 'MENU-CONNS-NEW-CONN 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-CONN)) -+ -+ -+(DEFUN MENU-CONNS-ADD-ITEM (MC NAME SYM MENU) -+ (MENU-SET-ADD-ITEM (CADR MC) NAME SYM MENU)) -+(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLARGUMENTS) -+ '((MC MENU-CONNS) (NAME SYMBOL) (SYM SYMBOL) (MENU MENU))) -+(SETF (GET 'MENU-CONNS-ADD-ITEM 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-ITEM)) -+ -+ -+(DEFUN MENU-CONNS-FIND-CONN (MC PT) -+ (LET (MS LS FOUND RES PA PB TMP DESCA DESCB) -+ (SETQ LS (LIST (COPY-LIST '(0 0)) (COPY-LIST '(0 0)))) -+ (SETQ MS (CADR MC)) -+ (DOLIST (CONN (CADDR MC)) -+ (UNLESS FOUND -+ (SETQ DESCA (CAR CONN)) -+ (SETQ DESCB (CADR CONN)) -+ (SETQ PA (MENU-SET-ITEM-POSITION MS DESCA 'CENTER)) -+ (SETQ PB (MENU-SET-ITEM-POSITION MS DESCB 'CENTER)) -+ (WHEN (> (CAR PA) (CAR PB)) -+ (SETQ TMP DESCA) -+ (SETQ DESCA DESCB) -+ (SETQ DESCB TMP)) -+ (SETF (CAR LS) (MENU-SET-ITEM-POSITION MS DESCA 'RIGHT)) -+ (SETF (CADR LS) (MENU-SET-ITEM-POSITION MS DESCB 'LEFT)) -+ (WHEN (< (ABS (/ (- (* (- (CAADR LS) (CAAR LS)) -+ (- (CADR PT) (CADAR LS))) -+ (* (- (CADADR LS) (CADAR LS)) -+ (- (CAR PT) (CAAR LS)))) -+ (SQRT (+ (EXPT (- (CAADR LS) (CAAR LS)) 2) -+ (EXPT (- (CADADR LS) (CADAR LS)) 2))))) -+ 5) -+ (SETQ FOUND T) -+ (SETQ RES CONN)))) -+ RES)) -+(SETF (GET 'MENU-CONNS-FIND-CONN 'GLARGUMENTS) -+ '((MC MENU-CONNS) (PT VECTOR))) -+(SETF (GET 'MENU-CONNS-FIND-CONN 'GLFNRESULTTYPE) 'MENU-SET-CONN) -+ -+ -+(DEFUN MENU-CONNS-FIND-ITEM (MC PT) (MENU-SET-FIND-ITEM (CADR MC) PT)) -+(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLARGUMENTS) -+ '((MC MENU-CONNS) (PT VECTOR))) -+(SETF (GET 'MENU-CONNS-FIND-ITEM 'GLFNRESULTTYPE) 'MENU-SET-ITEM) -+ -+ -+(DEFUN MENU-CONNS-DELETE-CONN (MC CONN) -+ (SETF (CADDR MC) (REMOVE CONN (CADDR MC)))) -+(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLARGUMENTS) -+ '((MC MENU-CONNS) (CONN MENU-SET-CONN))) -+(SETF (GET 'MENU-CONNS-DELETE-CONN 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-CONN)) -+ -+ -+(DEFUN MENU-CONNS-DELETE-ITEM (MC MI) -+ (LET (MS) -+ (SETQ MS (CADR MC)) -+ (MENU-SET-DELETE-ITEM MS MI) -+ (DOLIST (CONN (CADDR MC)) -+ (IF (OR (EQ (CADAR CONN) (CAR MI)) (EQ (CADADR CONN) (CAR MI))) -+ (MENU-CONNS-DELETE-CONN MC CONN))))) -+ -+(DEFUN MENU-CONNS-REMOVE-ITEMS (MC) -+ (MENU-SET-REMOVE-ITEMS (CADR MC)) -+ (SETF (CADDR MC) NIL)) -+(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLARGUMENTS) '((MC MENU-CONNS))) -+(SETF (GET 'MENU-CONNS-REMOVE-ITEMS 'GLFNRESULTTYPE) -+ '(LISTOF MENU-SET-CONN)) -+ -+ -+(DEFUN MENU-CONNS-CONNECTED-PORTS (MC BOXNAME) -+ (LET (PORTS) -+ (DOLIST (CONN (CADDR MC)) -+ (IF (EQ BOXNAME (CADADR CONN)) (PUSHNEW (CAADR CONN) PORTS) -+ (IF (EQ BOXNAME (CADAR CONN)) (PUSHNEW (CAAR CONN) PORTS)))) -+ PORTS)) -+ -+(DEFUN MENU-CONNS-FIND-CONNS (MC BOXNAME PORT) -+ (LET (RES) -+ (DOLIST (CONN (CADDR MC)) -+ (IF (AND (EQ BOXNAME (CADADR CONN)) (EQ PORT (CAADR CONN))) -+ (SETQ RES (NCONC RES (CONS (CAR CONN) NIL)))) -+ (IF (AND (EQ BOXNAME (CADAR CONN)) (EQ PORT (CAAR CONN))) -+ (SETQ RES (NCONC RES (CONS (CADR CONN) NIL))))) -+ RES)) -+(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLARGUMENTS) -+ '((MC MENU-CONNS) (BOXNAME SYMBOL) (PORT SYMBOL))) -+(SETF (GET 'MENU-CONNS-FIND-CONNS 'GLFNRESULTTYPE) '(LISTOF MENU-PORT)) -+ -+ -+(DEFUN COMPILE-MENU-SET () -+ (GLCOMPFILES *DIRECTORY* '("glisp/vector.lsp" "X/dwindow.lsp") -+ '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" -+ "glisp/menu-set-header.lsp") -+ (COMPILE-FILE "glisp/menu-settrans.lsp")) -+ -+(DEFUN COMPILE-MENU-SETB () -+ (GLCOMPFILES *DIRECTORY* -+ '("glisp/vector.lsp" "X/dwindow.lsp" "X/dwnoopen.lsp") -+ '("glisp/menu-set.lsp") "glisp/menu-settrans.lsp" -+ "glisp/menu-set-header.lsp")) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_ice-cream.lsp -@@ -0,0 +1,37 @@ -+; ice-cream.lsp 14 Nov 1994 16:16:15 -+ -+ -+(SETF (GET 'ICE-CREAM 'DRAW-DESCR) -+ '(DRAW-DESC ICE-CREAM -+ ((DRAW-DOT (79 294) (4 4) NIL 0) -+ (DRAW-CIRCLE (7 222) (148 148) NIL 0) -+ (DRAW-ELLIPSE (7 274) (148 44) NIL 0) -+ (DRAW-LINE (81 296) (0 -278) NIL 0) -+ (DRAW-LINE (81 18) (74 278) NIL 0) -+ (DRAW-LINE (81 18) (-74 278) NIL 0) -+ (DRAW-ELLIPSE (0 269) (162 54) NIL 0) -+ (DRAW-ARROW (154 391) (-27 -35) NIL 0) -+ (DRAW-TEXT (140 395) (63 14) "Ice Cream" 0) -+ (DRAW-ARROW (81 296) (-74 0) NIL 0) -+ (DRAW-TEXT (47 299) (7 14) "r" 0) -+ (DRAW-TEXT (86 186) (7 14) "h" 0) -+ (DRAW-LINE (81 0) (81 296) NIL 0) -+ (DRAW-LINE (81 0) (-81 296) NIL 0)) -+ (0 0) (203 409))) -+ -+(DEFUN DRAW-ICE-CREAM (W X Y) -+ (WINDOW-DRAW-DOT-XY W (+ 81 X) (+ 296 Y)) -+ (WINDOW-DRAW-CIRCLE-XY W (+ 81 X) (+ 296 Y) 74) -+ (WINDOW-DRAW-ELLIPSE-XY W (+ 81 X) (+ 296 Y) 74 22) -+ (WINDOW-DRAW-LINE-XY W (+ 81 X) (+ 296 Y) (+ 81 X) (+ 18 Y)) -+ (WINDOW-DRAW-LINE-XY W (+ 81 X) (+ 18 Y) (+ 155 X) (+ 296 Y)) -+ (WINDOW-DRAW-LINE-XY W (+ 81 X) (+ 18 Y) (+ 7 X) (+ 296 Y)) -+ (WINDOW-DRAW-ELLIPSE-XY W (+ 81 X) (+ 296 Y) 81 27) -+ (WINDOW-DRAW-ARROW-XY W (+ 154 X) (+ 391 Y) (+ 127 X) (+ 356 Y)) -+ (WINDOW-PRINTAT-XY W "Ice Cream" (+ 140 X) (+ 395 Y)) -+ (WINDOW-DRAW-ARROW-XY W (+ 81 X) (+ 296 Y) (+ 7 X) (+ 296 Y)) -+ (WINDOW-PRINTAT-XY W "r" (+ 47 X) (+ 299 Y)) -+ (WINDOW-PRINTAT-XY W "h" (+ 86 X) (+ 186 Y)) -+ (WINDOW-DRAW-LINE-XY W (+ 81 X) Y (+ 162 X) (+ 296 Y)) -+ (WINDOW-DRAW-LINE-XY W (+ 81 X) Y X (+ 296 Y)) -+ (WINDOW-FORCE-OUTPUT W)) ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_Xinit.lsp -@@ -0,0 +1,147 @@ -+(in-package :XLIB) -+; Xinit.lsp Hiep Huu Nguyen 27 Aug 92; GSN 07 Mar 95 -+ -+; Copyright (c) 1994 Hiep Huu Nguyen and The University of Texas at Austin. -+ -+; See the files gnu.license and dec.copyright . -+ -+; This program 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 1, or (at your option) -+; any later version. -+ -+; This program 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 program; if not, write to the Free Software -+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -+ -+; Some of the files that interface to the Xlib are adapted from DEC/MIT files. -+; See the file dec.copyright for details. -+ -+;;a word about Xakcl: -+;;Since Xakcl is a direct translation of the X library in C to lisp to a -+;;large extent. it would be beneficial to use a X 11 version 4, manual -+;;in order to look up functions. the only unique functions of Xakcl are those -+;;that involove manipulating C structs. all functions involved in creating -+;;a C struct in X starts with a 'make' followed by the structure name. all -+;;functions involved in getting a field of a C struct strats with the -+;;name of the C struct followed by the name of the field. the -+;;parameters it excepts is the varaible contaning the structure. all -+;;functions to set a field of a C struct starts with 'set' followed by -+;;the C struct name followed by the field name. these functions accept -+;;as parameter, the varaible containing the struct and the value to be -+;;put in the field. -+ -+;;;; -+;;contents of this file: -+;;;; -+;;this files has examples of initializing the display, screen, -+;;root-window, pixel value, gc, and colormap. -+;;;; -+;;gives an example of opening windows, setting size's and sizehints for -+;;the window manager getting drawbles' geometry -+;;;; -+;;drawing lines , drawing in color, changing line, attributes -+;;;; -+;;tracking the mouse and handling events and manipulating the event -+;;queue -+;;;; -+;;there is also some basic text handling stuff -+;;;; -+ -+;;globals -+(defvar *default-display* ) -+(defvar *default-screen* ) -+(defvar *default-colormap*) -+(defvar *root-window* ) -+(defvar *black-pixel* ) -+(defvar *white-pixel* ) -+(defvar *default-size-hints* (make-XsizeHints) ) -+(defvar *default-GC* ) -+(defvar *default-event* (make-XEvent)) -+(defvar *pos-x* 10) -+(defvar *pos-y* 20) -+(defvar *win-width* 225) -+(defvar *win-height* 400) -+(defvar *border-width* 1) -+(defvar *root-return* (int-array 1)) -+(defvar *x-return* (int-array 1)) -+(defvar *y-return* (int-array 1) ) -+(defvar *width-return* (int-array 1)) -+(defvar *height-return* (int-array 1)) -+(defvar *border-width-return* (int-array 1)) -+(defvar *depth-return* (int-array 1)) -+(defvar *GC-Values* (make-XGCValues)) -+ -+;;an example window -+(defvar a-window) -+ -+ -+;;;;;;;;;;;;;;;;;;;;;; -+;;this function initializes all varaibles needed by most applications. -+;;it uses all defaults which is inherited from the root window, and -+;;screen. -+ -+(defun Xinit() -+ (setq *default-display* (XOpenDisplay (get-c-string ""))) -+ (setq *default-screen* (XdefaultScreen *default-display*)) -+ (setq *root-window* (XRootWindow *default-display* *default-screen*)) -+ (setq *black-pixel* (XBlackPixel *default-display* -+ *default-screen*)) -+ (setq *white-pixel* (XWhitePixel *default-display* -+ *default-screen*)) -+ (setq *default-GC* (XDefaultGC *default-display* *default-screen*)) -+ (setq *default-colormap* ( XDefaultColormap *default-display* *default-screen*)) -+ (Xflush *default-display* )) -+ -+ -+ -+ -+;;;;;;;;;;;;;;;;;;;;;; -+;;this is an example of creating a window. this function takes care of -+;;positioning, size and other attirbutes of the window. -+ -+(defun open-window(&key (pos-x *pos-x* ) (pos-y *pos-y*) (win-width *win-width*) -+ (win-height *win-height* ) -+ (border-width *border-width*) (window-name "My Window") -+ (icon-name "My Icon")) -+;;create the window -+ -+ (let (( a-window (XCreateSimpleWindow -+ *default-display* *root-window* -+ pos-x pos-y win-width win-height border-width *black-pixel* *white-pixel*))) -+ -+;; all children of the root window needs a XSizeHints to tell the window manager -+;; how to position it, etc -+ -+ (set-Xsizehints-x *default-size-hints* pos-x) -+ (set-xsizehints-y *default-size-hints* pos-y) -+ (set-xsizehints-width *default-size-hints* win-width) -+ (set-xsizehints-height *default-size-hints* win-height) -+ (set-xsizehints-flags *default-size-hints* (+ Psize Pposition)) -+ (XsetStandardProperties *default-display* a-window (get-c-string window-name) -+ (get-c-string icon-name) none 0 0 *default-size-hints*) -+ -+;; the events or input a window can have are set with Xselectinput -+;; (Xselectinput *default-display* a-window -+;; (+ ButtonpressMask PointerMotionMask ExposureMask)) -+ -+;; the window needs to be mapped -+ (Xmapwindow *default-display* a-window) -+ -+;;the X server needs to have the output buffer sent to it before it can -+;;process requests. this is acomplished with XFlush or functions that -+;;read and manipulate the event queue. remember to do this after -+;;operations that won't be calling an eventhandling function -+ -+ (Xflush *default-display* ) -+ -+;;after flushing the request buffer the X server draws window as requested -+ -+ a-window)) -+ -+ ---- /dev/null -+++ gcl-2.6.7/xgcl-2/gcl_index.lsp -@@ -0,0 +1,88 @@ -+; index.lsp Gordon S. Novak Jr. 08 Dec 00; 18 May 06 -+ -+; This program processes LaTeX index entries, printing an index in -+; either LaTeX or HTML form. -+ -+; Copyright (c) 2006 Gordon S. Novak Jr. and The University of Texas at Austin. -+ -+; This program 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 program 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 program; if not, write to the Free Software -+; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -+ -+ -+; To use: Gather the LaTeX index data: use \index{foo} within the -+; text and include a \makeindex command at the top of the file, -+; producing a file .idx when the file is run through LaTeX. -+; Use an editor to change the index data from LaTeX form to Lisp: -+; \indexentry{combination}{37} LaTeX -+; ((combination) 37) Lisp -+ -+; We assume that indexdata is a list of such entries, as illustrated -+; at the end of this file. -+ -+; Warning: quote characters or apostrophes within the indexed -+; entries will not read into Lisp as expected. -+; Get rid of ' or change it to \' -+ -+; Start /p/bin/gcl -+; (load "index.lsp") -+; (printindex indexdata) ; for LaTeX output -+; (printindex indexdata "prefix") ; for HTML output -+; where "prefix" is the file name prefix for HTML files. -+ -+; Print index for LaTeX given a list of items ((words ...) page-number) -+(in-package 'xlib) -+(defun printindex (origlst &optional html) -+ (let (lst top) -+ (setq lst -+ (sort origlst -+ #'(lambda (x y) (or (wordlist< (car x) (car y)) -+ (and (equal (car x) (car y)) -+ (< (cadr x) (cadr y))))))) -+ (terpri) -+ (while lst -+ (setq top (pop lst)) -+ (if (not html) -+ (princ "\\item ")) -+ (dolist (word (car top)) -+ (princ (string-downcase (symbol-name word))) (princ " ")) -+ (printindexn (cadr top) html nil) -+ (while (equal (caar lst) (car top)) -+ (setq top (pop lst)) -+ (printindexn (cadr top) html t) ) -+ (if html -+ (format t "

    ~%") -+ (terpri)) ) )) -+ -+(defun wordlist< (x y) -+ (and (consp x) (consp y) -+ (or (string< (symbol-name (car x)) -+ (symbol-name (car y))) -+ (and (eq (car x) (car y)) -+ (or (and (null (cdr x)) (cdr y)) -+ (and (cdr x) (cdr y) -+ (wordlist< (cdr x) (cdr y)))))))) -+ -+(defun printindexn (n html comma) -+ (if comma (princ ", ")) -+ (if html -+ (format t "~D" html n n) -+ (princ n)) ) -+ -+(setq indexdata '( -+ -+; Insert index entry data here. Data should look like: -+; ((isomorphism) 20) -+; ((artificial intelligence) 30) -+ -+)) ---- gcl-2.6.7.orig/pcl/gcl_pcl_fin.lisp -+++ gcl-2.6.7/pcl/gcl_pcl_fin.lisp -@@ -1413,7 +1413,7 @@ make_turbo_trampoline_internal(base0) - - ") - --(defentry make-trampoline (object) (object make_trampoline)) -+(defentry make-trampoline (object) (compiler::static object make_trampoline)) - ) - - #+IBCL ---- gcl-2.6.7.orig/pcl/makefile -+++ gcl-2.6.7/pcl/makefile -@@ -19,11 +19,11 @@ SETUP='(load "sys-package.lisp")' \ - '(setq compiler::*default-c-file* t)'\ - '(setq compiler::*default-data-file* t)'\ - '(setq compiler::*default-system-p* t)' \ -- '(setq compiler::*keep-gaz* t)' -+ '(setq compiler::*keep-gaz* t compiler::*tmp-dir* "")' - - all: $(addsuffix .c,$(AFILES)) $(addsuffix .o,$(AFILES)) - --saved_gcl_pcl: ../unixport/saved_gcl -+saved_gcl_pcl: ../unixport/saved_gcl$(EXE) - cp ../h/cmpinclude.h . - echo $(SETUP) '(pcl::compile-pcl)' | $< - echo $(SETUP) '(pcl::load-pcl)(si::save-system "$@")' | $< -@@ -33,21 +33,19 @@ $(addsuffix .c,$(AFILES)) $(addsuffix .d - $(addsuffix .lisp,$(subst gcl_pcl_impl_low,impl/gcl/gcl_pcl_impl_low,$(FILES))) - rm -f *.o *gazonk* - cp ../h/cmpinclude.h . -- echo ${SETUP} '(pcl::compile-pcl)' | ../unixport/saved_gcl ../unixport/ --# FIXME -- small compiler setjmp/volatile detection bug -- CM --# doesn't seem to be needed now, but investigate more later --# patch -p0 gcl_pcl_$$i && rm $$i; done -+ echo ${SETUP} '(pcl::compile-pcl)' | ../unixport/saved_gcl$(EXE) -+ for i in gazonk* ; do \ -+ j=$$(echo $$i | sed 's,\..*$$,,1');k="gazonk$$(echo $$j | cut -f3 -d\_)";\ -+ l=$$(echo $$i | sed 's,^.*\.,,1');\ -+ cat $$i | sed -e "s,$$j\.h,gcl_pcl_$$k.h,1" \ -+ -e "s,init_.*$$j,init_gcl_pcl_$$k,g" >gcl_pcl_$$k.$$l && rm $$i; done - - %.o: %.c %.h %.data - $(CC) $(CFLAGS) -c $< -o $@ - ../xbin/append $*.data $@ - - clean: -- rm -f *.o *.fn *.exe *.dll saved_gcl_pcl cmpinclude.h *.c *.h *.data *gazonk* -+ rm -f *.o *.fn *.exe *.dll saved_gcl_pcl$(EXE) cmpinclude.h *.c *.h *.data *gazonk* - - - # remake the sys-package.lisp and sys-proclaim.lisp files -@@ -56,10 +54,10 @@ remake-sys-files: - rm -f *.o *gazonk* - cp ../h/cmpinclude.h . - echo ${SETUP} '(load "../cmpnew/gcl_collectfn.lsp")(compiler::emit-fn t)' \ -- '(pcl::compile-pcl)' | ../unixport/saved_gcl ../unixport/ -+ '(pcl::compile-pcl)' | ../unixport/saved_gcl$(EXE) ../unixport/ - echo ${SETUP} '(load "../cmpnew/gcl_collectfn.lsp") '\ - '(pcl::load-pcl)(in-package "PCL")(renew-sys-files)' | \ -- ../unixport/saved_gcl ../unixport/ -+ ../unixport/saved_gcl$(EXE) ../unixport/ - cp sys-proclaim.lisp xxx - cat xxx | sed -e "s/COMPILER::CMP-ANON//g" > sys-proclaim.lisp - rm xxx ---- gcl-2.6.7.orig/pcl/impl/gcl/gcl_pcl_impl_low.lisp -+++ gcl-2.6.7/pcl/impl/gcl/gcl_pcl_impl_low.lisp -@@ -73,10 +73,8 @@ - - ;#+turbo-closure-env-size - (clines " --static --object cclosure_env_nthcdr (n,cc) --int n; object cc; --{ object env,*turbo; -+static object cclosure_env_nthcdr (fixnum n,object cc) { -+ object env,*turbo; - if(n<0)return Cnil; - if(type_of(cc)!=t_cclosure)return Cnil; - if((turbo=cc->cc.cc_turbo)==NULL) -@@ -90,9 +88,9 @@ int n; object cc; - return turbo[n];} - }") - --(defentry cclosure-env-nthcdr (int object) (object cclosure_env_nthcdr)) -+(defentry cclosure-env-nthcdr (fixnum object) (compiler::static object cclosure_env_nthcdr)) - ;; This is the unsafe but fast version. --(defentry %cclosure-env-nthcdr (int object) (object cclosure_env_nthcdr)) -+(defentry %cclosure-env-nthcdr (fixnum object) (compiler::static object cclosure_env_nthcdr)) - - (eval-when (compile eval load) - (defparameter *gcl-function-inlines* -@@ -121,8 +119,7 @@ int n; object cc; - (if (eq (car inline) 'logxor) - 8 0)) ;result type from args - (fifth opt))) -- (cdr inline))))) --) -+ (cdr inline)))))) - - - (defmacro define-inlines () -@@ -170,14 +167,8 @@ int n; object cc; - - - (clines " -- -- -- - object fSuse_fast_links_2(object,object); --static --object set_cclosure (result_cc,value_cc,available_size) -- object result_cc,value_cc; int available_size; --{ -+static object set_cclosure (object result_cc,object value_cc,fixnum available_size) { - object result_env_tail,value_env_tail; int i; - - /* If we are currently using fast linking, */ -@@ -196,11 +187,10 @@ object set_cclosure (result_cc,value_cc, - result_cc->cc.cc_self=value_cc->cc.cc_self; - result_cc->cc.cc_data=value_cc->cc.cc_data; - -- - return result_cc; - }") - --(defentry %set-cclosure (object object int) (object set_cclosure)) -+(defentry %set-cclosure (object object fixnum) (compiler::static object set_cclosure)) - - - (defun structure-functions-exist-p () ---- gcl-2.6.7.orig/elisp/makefile -+++ gcl-2.6.7/elisp/makefile -@@ -7,11 +7,11 @@ install: - cp *.el $(DESTDIR)$(EMACS_SITE_LISP) - if [ "$(EMACS_DEFAULT_EL)" != "" ] ; then \ - if test -f "$(DESTDIR)${EMACS_DEFAULT_EL}" ; then \ -- cat $(DESTDIR)${EMACS_DEFAULT_EL} | sed -e '/BEGIN gcl/,/END gcl/d' > $(DESTDIR)/temp_emacs_default ; \ -+ cat $(DESTDIR)${EMACS_DEFAULT_EL} | sed -e '/BEGIN gcl/,/END gcl/d' > $(DESTDIR)$(EMACS_SITE_LISP)/temp_emacs_default ; \ - mv $(DESTDIR)${EMACS_DEFAULT_EL} $(DESTDIR)${EMACS_DEFAULT_EL}.prev ; \ - rm -f $(DESTDIR)${EMACS_DEFAULT_EL}c ; \ -- cat add-default.el >> $(DESTDIR)/temp_emacs_default ; cp $(DESTDIR)/temp_emacs_default $(DESTDIR)${EMACS_DEFAULT_EL} ; \ -- rm -f $(DESTDIR)/temp_emacs_default ; else \ -+ cat add-default.el >> $(DESTDIR)$(EMACS_SITE_LISP)/temp_emacs_default ; cp $(DESTDIR)$(EMACS_SITE_LISP)/temp_emacs_default $(DESTDIR)${EMACS_DEFAULT_EL} ; \ -+ rm -f $(DESTDIR)$(EMACS_SITE_LISP)/temp_emacs_default ; else \ - cp add-default.el $(DESTDIR)${EMACS_DEFAULT_EL} ; fi ; \ - chmod a+r $(DESTDIR)${EMACS_DEFAULT_EL} ; fi - ---- gcl-2.6.7.orig/clcs/makefile -+++ gcl-2.6.7/clcs/makefile -@@ -1,13 +1,13 @@ - -include ../makedefs - --COMPILE_FILE=./saved_clcs_gcl ./ -system-p -c-file -data-file \ -+COMPILE_FILE=./saved_clcs_gcl$(EXE) ./ -system-p -c-file -data-file \ - -o-file nil -h-file -compile - - FILES:=$(shell ls -1 gcl_clcs_*.lisp | sed 's,\.lisp,,1') - - all: $(addsuffix .c,$(FILES)) $(addsuffix .o,$(FILES)) - --saved_clcs_gcl: ../unixport/saved_pcl_gcl -+saved_clcs_gcl: ../unixport/saved_pcl_gcl$(EXE) - echo '(load "package.lisp")(load "myload.lisp")(si::save-system "$@")' | $< $( $2 -+#!/bin/sh -ef -+ -+# Copy a file so that it ends up with dos line endings so that for example, -+# batch files will run properly under Windows 98. -+ -+cat $1 | awk '{sub(/$/,"\r");print}' > $2 ---- gcl-2.6.7.orig/windows/sysdir.bat.in -+++ gcl-2.6.7/windows/sysdir.bat.in -@@ -1,5 +1,5 @@ --cd %1 --echo (setq si::*system-directory* (namestring(truename (make-pathname :name nil :type nil :defaults (si::argv 0))))) (si::save-system "modified.exe") | @FLISP@.exe --del @FLISP@.exe --ren modified.exe @FLISP@.exe --pause -+cd %1 -+echo (setq si::*system-directory* (namestring(truename (make-pathname :name nil :type nil :defaults (si::argv 0))))) (si::save-system "modified.exe") | @FLISP@.exe -+del @FLISP@.exe -+ren modified.exe @FLISP@.exe -+pause ---- gcl-2.6.7.orig/h/notcomp.h -+++ gcl-2.6.7/h/notcomp.h -@@ -287,3 +287,5 @@ gcl_init_cmp_anon(void); - #endif - - #include "gmp_wrappers.h" -+ -+#define massert(a_) if (!(a_)) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__) ---- gcl-2.6.7.orig/h/object.h -+++ gcl-2.6.7/h/object.h -@@ -89,7 +89,7 @@ typedef unsigned short fatchar; - typedef union lispunion *object; - - typedef union int_object iobject; --union int_object {object o; int i;}; -+union int_object {object o; fixnum i;}; - - /* - OBJect NULL value. -@@ -110,11 +110,11 @@ struct fixnum_struct { - - #define SMALL_FIXNUM_LIMIT 1024 - --EXTER --struct fixnum_struct small_fixnum_table[2*SMALL_FIXNUM_LIMIT]; -+/* EXTER */ -+/* struct fixnum_struct small_fixnum_table[2*SMALL_FIXNUM_LIMIT]; */ - --#define small_fixnum(i) \ -- (object)(small_fixnum_table+SMALL_FIXNUM_LIMIT+(i)) -+/* #define small_fixnum(i) \ */ -+/* (object)(small_fixnum_table+SMALL_FIXNUM_LIMIT+(i)) */ - - struct shortfloat_struct { - FIRSTWORD; -@@ -181,13 +181,14 @@ struct character { - - - --EXTER --struct character character_table1[256+128]; --#define character_table (character_table1+128) --#define code_char(c) (object)(character_table+(c)) --#define char_code(obje) (obje)->ch.ch_code --#define char_font(obje) (obje)->ch.ch_font --#define char_bits(obje) (obje)->ch.ch_bits -+/* struct character character_table1[256+128]; */ -+/* EXTER */ -+/* union lispunion character_table1[256+128]; */ -+/* #define character_table (character_table1+128) */ -+/* #define code_char(c) (object)(character_table+(c)) */ -+/* #define char_code(obje) ((object)obje)->ch.ch_code */ -+/* #define char_font(obje) ((object)obje)->ch.ch_font */ -+/* #define char_bits(obje) ((object)obje)->ch.ch_bits */ - - enum stype { /* symbol type */ - stp_ordinary, /* ordinary */ -@@ -226,7 +227,8 @@ struct symbol { - short s_mflag; /* macro flag */ - }; - EXTER --struct symbol Cnil_body, Ct_body; -+/* struct symbol Cnil_body, Ct_body; */ -+union lispunion Cnil_body, Ct_body; - - struct package { - FIRSTWORD; -@@ -441,7 +443,7 @@ struct structure { /* structure header - }; - - struct s_data {object name; -- int length; -+ fixnum length; - object raw; - object included; - object includes; -@@ -449,7 +451,7 @@ struct s_data {object name; - object print_function; - object slot_descriptions; - object slot_position; -- int size; -+ fixnum size; - object has_holes; - }; - -@@ -514,9 +516,7 @@ struct stream { - }; - /* flags */ - #define GET_STREAM_FLAG(strm,name) ((strm)->sm.sm_flags & (1<<(name))) --#define SET_STREAM_FLAG(strm,name,val) (val ? \ -- ((strm)->sm.sm_flags |= (1<<(name))) : \ -- ((strm)->sm.sm_flags &= ~(1<<(name)))) -+#define SET_STREAM_FLAG(strm,name,val) {if (val) (strm)->sm.sm_flags |= (1<<(name)); else (strm)->sm.sm_flags &= ~(1<<(name));} - - #define GCL_MODE_BLOCKING 1 - #define GCL_MODE_NON_BLOCKING 0 -@@ -707,6 +707,24 @@ union lispunion { - struct lfarray lfa; /* plong-float array */ - }; - -+ -+/* struct character character_table1[256+128]; */ -+EXTER -+union lispunion character_table1[256+128]; -+#define character_table (character_table1+128) -+#define code_char(c) (object)(character_table+(c)) -+#define char_code(obje) ((object)obje)->ch.ch_code -+#define char_font(obje) ((object)obje)->ch.ch_font -+#define char_bits(obje) ((object)obje)->ch.ch_bits -+ -+EXTER -+union lispunion small_fixnum_table[2*SMALL_FIXNUM_LIMIT]; -+ -+#define small_fixnum(i) \ -+ (object)(small_fixnum_table+SMALL_FIXNUM_LIMIT+(i)) -+ -+ -+ - #define address_int unsigned long - - /* -@@ -868,8 +886,8 @@ char *tmp_alloc; - #endif - - #define TIME_ZONE (-9) --EXTER --fixnum FIXtemp; -+/* EXTER */ -+/* fixnum FIXtemp; */ - - /* For IEEEFLOAT, the double may have exponent in the second word - (little endian) or first word.*/ -@@ -1029,20 +1047,20 @@ EXTER struct symbol Dotnil_body; - #define Dotnil ((object)&Dotnil_body) - - #define endp(x) ({\ -- static struct cons s_my_dot={t_cons,0,0,0,Dotnil,Dotnil};\ -+ static union lispunion s_my_dot={.c={t_cons,0,0,0,Dotnil,Dotnil}}; \ - object _x=(x);\ - bool _b=FALSE;\ - \ - if (type_of(_x)==t_cons) {\ - if (type_of(_x->c.c_cdr)!=t_cons && _x->c.c_cdr!=Cnil)\ -- s_my_dot.c_car=_x->c.c_cdr;\ -+ s_my_dot.c.c_car=_x->c.c_cdr;\ - else \ -- s_my_dot.c_car=Dotnil;\ -+ s_my_dot.c.c_car=Dotnil;\ - } else {\ -- if (_x==s_my_dot.c_car)\ -- x=(object)&s_my_dot;\ -+ if (_x==s_my_dot.c.c_car)\ -+ x=&s_my_dot;\ - else {\ -- s_my_dot.c_car=Dotnil;\ -+ s_my_dot.c.c_car=Dotnil;\ - if (_x==Cnil || _x==Dotnil)\ - _b=TRUE;\ - else\ ---- /dev/null -+++ gcl-2.6.7/h/elf32_arm_reloc.h -@@ -0,0 +1,11 @@ -+#define R_ARM_CALL 28 -+#define R_ARM_V4BX 40 -+ case R_ARM_CALL: -+ add_vals(where,MASK(24),((long)(s+a-p))>>2); -+ break; -+ case R_ARM_ABS32: -+ add_val(where,~0L,s+a); -+ break; -+ case R_ARM_V4BX: -+ add_val(where,~0L,s+a); -+ break; ---- /dev/null -+++ gcl-2.6.7/h/elf64_mips_reloc.h -@@ -0,0 +1,47 @@ -+ case R_MIPS_JALR: -+ break; -+ case R_MIPS_64: -+ add_val(where,~0L,s+a); -+ break; -+ case R_MIPS_GPREL32: -+ add_val(where,MASK(32),s+a-(ul)got); -+ break; -+ case R_MIPS_32: -+ add_val(where,MASK(32),s+a); -+ break; -+ case R_MIPS_GOT_DISP: -+ case R_MIPS_CALL16: -+ case R_MIPS_GOT_PAGE: -+ gote=got+(a>>32)-1; -+ a&=MASK(32); -+ store_val(where,MASK(16),((void *)gote-(void *)got)); -+ if (s>=ggot && sr_info)==R_MIPS_GPREL16) s=(ul)got-s; -+ if (!hr) hr=(void *)r; -+ if (a&(1L<<32)) add_vals(where,MASK(16),(s+(a>>32))>>16); -+ break; -+ case R_MIPS_LO16: -+ s+=a; -+ if (ELF_R_FTYPE(r->r_info)==R_MIPS_GPREL16) s=(ul)got-s; -+ a=*where&MASK(16); -+ if (a&0x8000) a|=0xffffffffffff0000; -+ a+=s&MASK(16); -+ a+=(a&0x8000)<<1; -+ store_val(where,MASK(16),a); -+ a&=~MASK(16); -+ { -+ Rela *ra=(void *)r; -+ for (hr=hr ? hr : (void *)ra;--ra>=hr && ELF_R_TYPE(ra->r_info)==R_MIPS_HI16;) -+ relocate(sym1,ra,ra->r_addend|(1L<<32)|(a<<32),start,got,gote); -+ } -+ hr=NULL; -+ break; ---- gcl-2.6.7.orig/h/solaris-i386.h -+++ gcl-2.6.7/h/solaris-i386.h -@@ -0,0 +1,37 @@ -+#define I386 -+#define LITTLE_END -+ -+#define ElfW(a) Elf32_ ## a -+#if !defined(HAVE_LIBBFD) && !defined(USE_DLOPEN) -+#define __ELF_NATIVE_CLASS 32 -+#include -+#endif -+#include "linux.h" -+ -+#ifdef IN_GBC -+#undef MPROTECT_ACTION_FLAGS -+#define MPROTECT_ACTION_FLAGS SA_RESTART|SA_SIGINFO -+#define GET_FAULT_ADDR(sig,code,sv,a) \ -+ ((siginfo_t *)code)->si_addr -+/* #define GET_FAULT_ADDR(sig,code,sv,a) \ */ -+/* ((void *)(*((char ***)(&code)))[44]) */ -+#endif -+ -+#define ADDITIONAL_FEATURES \ -+ ADD_FEATURE("SUN"); \ -+ ADD_FEATURE("SPARC") -+ -+#define SPARC -+#define SGC -+ -+#define PTR_ALIGN 8 -+ -+#undef LISTEN_FOR_INPUT -+#undef SIG_UNBLOCK_SIGNALS -+#define NO_SYSTEM_TIME_ZONE -+ -+void bcopy (const void *,void *,size_t); -+void bzero(void *,size_t); -+int bcmp(const void *,const void *,size_t); -+ -+#define NULL_OR_ON_C_STACK(x) ((unsigned long)x>40)&0xff) ? ((a_>>40)&0xff) : ((a_>>56)&0xff)) -+#define ELF_R_FTYPE(a_) ((a_>>56)&0xff) -+ -+static int -+write_stub(ul s,ul *got,ul *gote) { -+ -+ int *goti; -+ -+ -+ *gote=(ul)(goti=(void *)(gote+2)); -+ *++gote=s; -+ s=((void *)gote-(void *)got); -+ *goti++=(0x37<<26)|(0x1c<<21)|(0x19<<16)|s; -+ *goti++=(0x37<<26)|(0x19<<21)|(0x19<<16)|0; -+ *goti++=0x03200008; -+ *goti++=0x00200825; -+ -+ return 0; -+ -+} -+ -+static int -+make_got_room_for_stub(Shdr *sec1,Shdr *sece,Sym *sym,const char *st1,ul *gs) { -+ -+ Shdr *ssec=sec1+sym->st_shndx; -+ struct node *a; -+ if ((ssec>=sece || !ALLOC_SEC(ssec)) && -+ (a=find_sym_ptable(st1+sym->st_name)) && -+ a->address>=ggot && a->addresssh_addr,pe=p+sec->sh_size;psh_entsize) { -+ q=p; -+ if (q[0]==DT_MIPS_GOTSYM) -+ gotsym=q[1]; -+ if (q[0]==DT_MIPS_LOCAL_GOTNO) -+ locgotno=q[1]; -+ -+ } -+ massert(gotsym && locgotno); -+ -+ massert(sec=get_section(".MIPS.stubs",sec1,sece,sn)); -+ stub=sec->sh_addr; -+ stube=sec->sh_addr+sec->sh_size; -+ -+ massert(sec=get_section(".got",sec1,sece,sn)); -+ ggot=sec->sh_addr+locgotno*sec->sh_entsize; -+ ggote=sec->sh_addr+sec->sh_size; -+ -+ for (ds1+=gotsym,sym=ds1;symst_value || (sym->st_value>=stub && sym->st_valuest_value=ggot+(sym-ds1)*sec->sh_entsize; -+ -+ return 0; -+ -+} -+ -+static int -+label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,ul *gs) { -+ -+ Rela *r; -+ Sym *sym; -+ Shdr *sec; -+ void *v,*ve; -+ ul q=0,a,b; -+ -+ for (sym=sym1;symst_size=0; -+ -+ for (*gs=0,sec=sec1;secsh_type==SHT_RELA) -+ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) -+ if (ELF_R_TYPE(r->r_info)==R_MIPS_CALL16|| -+ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_DISP|| -+ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_PAGE) { -+ -+ sym=sym1+ELF_R_SYM(r->r_info); -+ -+ a=r->r_addend>>15; -+ -+ if (2*a>=sizeof(sym->st_size) || !((sym->st_size>>(a*16))&0xffff)) { -+ -+ q=++*gs; -+ if (2*ast_size)) { -+ massert(q<=0xffff); -+ sym->st_size|=(q<<(a*16)); -+ } -+ -+ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); -+ -+ } -+ -+ b=sizeof(r->r_addend)*4; -+ massert(!(r->r_addend>>b)); -+ q=2*a>=sizeof(sym->st_size) ? q : (sym->st_size>>(a*16))&0xffff; -+ r->r_addend|=(q<<=b); -+ -+ } -+ -+ return 0; -+ -+} ---- /dev/null -+++ gcl-2.6.7/h/ld_bind_now.h -@@ -0,0 +1,27 @@ -+#include -+#include -+#include -+#include -+#include -+ -+ -+if (!getenv("LD_BIND_NOW")) { -+ -+ int i; -+ char **n; -+ -+ for (i=0;envp[i];i++); -+ n=alloca((i+2)*sizeof(*n)); -+ n[i+1]=0; -+ n[i--]="LD_BIND_NOW=t"; -+ for (;i>=0;i--) -+ n[i]=envp[i]; -+#ifdef GCL_GPROF -+ gprof_cleanup(); -+#endif -+ errno=0; -+ execve(*argv,argv,n); -+ printf("execve failure %d\n",errno); -+ exit(-1); -+ -+} ---- /dev/null -+++ gcl-2.6.7/h/elf64_alpha_reloc_special.h -@@ -0,0 +1,95 @@ -+static ul ggot1,ggote; -+ -+static int -+write_stub(ul s,ul *got,ul *gote) { -+ -+ unsigned int *goti; -+ -+ *gote=(ul)(goti=(void *)(gote+2)); -+ *++gote=s; -+ *goti++=(0x29<<26)|(0x1b<<21)|(0x1d<<16)|((void *)gote-(void *)got); -+ *goti++=(0x29<<26)|(0x1b<<21)|(0x1b<<16)|0; -+ *goti++=(0x1a<<26)|(0x1f<<21)|(0x1b<<16)|0x4000; -+ *goti++=0; -+ -+ return 0; -+ -+} -+ -+static int -+make_got_room_for_stub(Shdr *sec1,Shdr *sece,Sym *sym,const char *st1,ul *gs) { -+ -+ Shdr *ssec=sec1+sym->st_shndx; -+ struct node *a; -+ -+ if ((ssec>=sece || !ALLOC_SEC(ssec)) && -+ (a=find_sym_ptable(st1+sym->st_name)) && -+ a->address>=ggot1 && a->addresssh_addr; -+ ggote=ggot1+sec->sh_size; -+ -+ massert((sec=get_section(".rel.dyn",sec1,sece,sn))|| -+ (sec=get_section(".rela.dyn",sec1,sece,sn))); -+ -+ v+=sec->sh_offset; -+ ve=v+sec->sh_size; -+ -+ for (r=v;vsh_entsize,r=v) -+ if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) -+ ds1[ELF_R_SYM(r->r_info)].st_value=r->r_offset; -+ -+ return 0; -+ -+} -+ -+static int -+label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,ul *gs) { -+ -+ Rela *r; -+ Sym *sym; -+ Shdr *sec; -+ void *v,*ve; -+ ul q=0,b; -+ -+ for (sym=sym1;symst_size=0; -+ -+ for (*gs=0,sec=sec1;secsh_type==SHT_RELA) -+ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) -+ if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { -+ -+ sym=sym1+ELF_R_SYM(r->r_info); -+ -+ if (!sym->st_size || r->r_addend) { -+ q=++*gs; -+ if (!r->r_addend) sym->st_size=q; -+ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); -+ } -+ -+ b=sizeof(r->r_addend)*4; -+ massert(!(r->r_addend>>b)); -+ q=r->r_addend ? q : sym->st_size; -+ r->r_addend|=(q<<=b); -+ -+ } -+ -+ return 0; -+ -+} ---- gcl-2.6.7.orig/h/gnuwin95.h -+++ gcl-2.6.7/h/gnuwin95.h -@@ -64,7 +64,7 @@ - #endif - - #define brk(x) printf("not doing break\n"); --#include -+#include - #include - #define UNIXSAVE "unexnt.c" - ---- /dev/null -+++ gcl-2.6.7/h/elf32_hppa_reloc.h -@@ -0,0 +1,35 @@ -+ case R_PARISC_PCREL17F: -+ s+=a-pltgot; -+ s=((long)s)>>2; -+ massert(ovchks(s,~MASK(17))); -+ s&=MASK(17); -+ *where=(0x39<<26)|(0x13<<21)|ASM17(s); /* b,l -> be,l */ -+ break; -+ case R_PARISC_PCREL21L: -+ s+=a; -+ s-=p+11; -+ s>>=11; -+ store_valu(where,MASK(21),ASM21(s)); -+ break; -+ case R_PARISC_PCREL14R: -+ s+=a; -+ s-=p+11; -+ s&=MASK(11); -+ store_valu(where,MASK(14),s<<1); -+ break; -+ case R_PARISC_LTOFF21L: -+ s-=pltgot; -+ s>>=11; -+ store_valu(where,MASK(21),ASM21(s)); -+ break; -+ case R_PARISC_LTOFF14R: -+ s-=pltgot; -+ s&=MASK(11); -+ store_valu(where,MASK(14),s<<1); -+ store_valu(where,MASK(6)<<26,0xd<<26); /*ldw -> ldo*/ -+ break; -+ case R_PARISC_PLABEL32: -+ case R_PARISC_SEGREL32: -+ case R_PARISC_DIR32: -+ store_val(where,~0L,s+a); -+ break; ---- /dev/null -+++ gcl-2.6.7/h/386-kfreebsd.defs -@@ -0,0 +1,63 @@ -+ -+# notes for redhat 6.0 -+# the configure should select the compiler GCC=/usr/bin/i386-glibc20-linux-gcc -+# However for the gcl-tk directory, you must use plain 'gcc' since -+# that must link with the tcl tk libs which have been compiled with it. -+# so after configure change to GCC=gcc in the gcl-tk/makefile -+ -+ -+# Machine dependent makefile definitions for intel 386,486 running linux -+ -+LBINDIR=/usr/local/bin -+ -+#OFLAG = -g -Wall -+#OFLAG = -g -Wall -fomit-frame-pointer -Werror -+#LIBS = -lm -+ -+#ODIR_DEBUG= -g -Wall -fomit-frame-pointer -Werror -+#ODIR_DEBUG= -g -Wall -+ -+# This CC string will be used for compilation of the system, -+# and also in the compiler::*cc* variable for later compilation of -+# lisp files. -+# (the -pipe is just since our file system is slow..) -+#CC = ${GCC} -pipe -fwritable-strings -DVOL=volatile -I$(GCLDIR)/o -fsigned-char -Wall $(EXTRA_CFLAGS) -fomit-frame-pointer -Werror -g -+ -+# under redhat 6.1 and slackware 7.0 we needed to have this -+# link be static, but should be ok with the fix to unixport/rsym_elf.c -+LDCC=${CC} -static -+LDCC=${CC} -+ -+# note for linuxaout on an elf machine add -b i486-linuxaout -+# CC = gcc -pipe -fwritable-strings -DVOL=volatile -I$(GCLDIR)/o -fsigned-char -b i486-linuxaout -+ -+# Enable the fastloading mechanism which does not use ld -A -+# requires c/rel_.. machine dependent code. -+ -+RSYM = rsym -+ifneq ($(findstring bfd,$(LIBS)),) -+RSYM = -+endif -+ifneq ($(BUILD_BFD),) -+RSYM = -+endif -+#ifneq ($(findstring -ldl,$(LIBS)),) -+#RSYM = -+#endif -+ -+SFASL = $(ODIR)/sfasl.o -+ -+ -+#MPFILES= $(MPDIR)/mpi-386d.o $(MPDIR)/libmport.a -+ -+ -+# When using SFASL it is good to have (si::build-symbol-table) -+INITFORM=(si::build-symbol-table) -+ -+# Use symbolic links -+SYMB=-s -+ -+LIBFILES=bsearch.o -+ -+# the make to use for saved_kcp the profiler. -+KCP=kcp-bsd ---- gcl-2.6.7.orig/h/bds.h -+++ gcl-2.6.7/h/bds.h -@@ -59,8 +59,8 @@ EXTER bds_ptr bds_save_top; - #define bds_bind(sym, val) \ - do {bds_ptr _b = bds_top+1; \ - (_b)->bds_sym = (sym); \ -- _b->bds_val = (sym)->s.s_dbind; \ -- (sym)->s.s_dbind = (val); bds_top=_b;} while (0) -+ _b->bds_val = ((object)sym)->s.s_dbind; \ -+ ((object)sym)->s.s_dbind = (val); bds_top=_b;} while (0) - - #define bds_unwind1 \ - ((bds_top->bds_sym)->s.s_dbind = bds_top->bds_val, --bds_top) ---- gcl-2.6.7.orig/h/powerpc-macosx.defs -+++ gcl-2.6.7/h/powerpc-macosx.defs -@@ -6,7 +6,7 @@ CC = gcc $(CPPFLAGS) - - # Set this to avoid warnings when linking against libncurses. - # This is due to the requirements of the two level namespace. --LIBS := `echo $(LIBS) | sed -e 's/-lncurses/ /'` /sw/lib/libintl.dylib -+LIBS := `echo $(LIBS) | sed -e 's/-lncurses/ /'` - - # Set this for the linker to operate correctly. - MACOSX_DEPLOYMENT_TARGET = 10.2 -@@ -32,4 +32,4 @@ INITFORM = (si::build-symbol-table) - # This appears to be no longer necessary on Panther. - ARRS = libtool -static -o - --FINAL_CFLAGS := `echo $(FINAL_CFLAGS) | sed -e 's:-g::g'` -\ No newline at end of file -+FINAL_CFLAGS := `echo $(FINAL_CFLAGS) | sed -e 's:-g::g'` ---- /dev/null -+++ gcl-2.6.7/h/elf64_sparc_reloc_special.h -@@ -0,0 +1,85 @@ -+#undef ELF_R_TYPE -+#define ELF_R_TYPE(a) (ELF64_R_TYPE(a)&0xff) -+#define ELF_R_ADDEND(a) (((ELF64_R_TYPE(a)>>8)^0x800000)-0x800000) -+ -+static int -+label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,ul *gs) { -+ -+ return 0; -+ -+} -+ -+static int -+find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, -+ const char *st1,Sym *ds1,Sym *dse,Sym *sym1,Sym *syme) { -+ -+ return 0; -+ -+} -+ -+ -+int -+store_ival(int *w,ul m,ul v) { -+ -+ *w=(v&m)|(*w&~m); -+ -+ return 0; -+ -+} -+ -+int -+store_ivals(int *w,ul m,ul v) { -+ -+ massert(ovchks(v,~m)); -+ return store_ival(w,m,v); -+ -+} -+ -+int -+store_ivalu(int *w,ul m,ul v) { -+ -+ massert(ovchku(v,~m)); -+ return store_ival(w,m,v); -+ -+} -+ -+ -+int -+add_ival(int *w,ul m,ul v) { -+ -+ return store_ival(w,m,v+(*w&m)); -+ -+} -+ -+int -+add_ivalu(int *w,ul m,ul v) { -+ -+ return store_ivalu(w,m,v+(*w&m)); -+ -+} -+ -+int -+add_ivals(int *w,ul m,ul v) { -+ -+ ul l=*w&m,mm; -+ -+ mm=~m; -+ mm|=mm>>1; -+ if (l&mm) l|=mm; -+ -+ return store_ival(w,m,v+l); -+ -+} -+ -+int -+add_ivalsc(int *w,ul m,ul v) { -+ -+ ul l=*w&m,mm; -+ -+ mm=~m; -+ mm|=mm>>1; -+ if (l&mm) l|=mm; -+ -+ return store_ivals(w,m,v+l); -+ -+} ---- /dev/null -+++ gcl-2.6.7/h/mach64_i386_reloc.h -@@ -0,0 +1,26 @@ -+#include -+ -+#define GOT_RELOC(ri) ri->r_type==X86_64_RELOC_GOT_LOAD||ri->r_type==X86_64_RELOC_GOT -+ -+ -+ case X86_64_RELOC_UNSIGNED: // for absolute addresses -+ -+ if (ri->r_extern || !ri->r_pcrel) -+ add_val(q,~0L,ri->r_pcrel ? a-rel : a); -+ -+ break; -+ case X86_64_RELOC_GOT_LOAD: // a MOVQ load of a GOT entry -+ case X86_64_RELOC_GOT: // a MOVQ load of a GOT entry -+ -+ got+=n1[ri->r_symbolnum].n_desc-1; -+ *got=a; -+ a=(ul)got; -+ -+ case X86_64_RELOC_SIGNED: // for signed 32-bit displacement -+ case X86_64_RELOC_BRANCH: // a CALL/JMP instruction with 32-bit displacement -+ -+ if (ri->r_extern || !ri->r_pcrel) -+ add_val(q,MASK(32),ri->r_pcrel ? a-((ul)q+4) : a); -+ -+ break; -+ ---- gcl-2.6.7.orig/h/hppa-linux.h -+++ gcl-2.6.7/h/hppa-linux.h -@@ -1,29 +1,25 @@ - #include "linux.h" - --/* #ifdef IN_GBC */ --/* #define GET_FAULT_ADDR(sig,code,sv,a) \ */ --/* ((void *)(*((char ***)(&code)))[17]) */ --/* #endif */ -- --/*#define NULL_OR_ON_C_STACK(x) ((x)==0 || ((unsigned int)x) > (unsigned int)(pagetochar(MAXPAGE+1)))*/ -- --/* #define ADDITIONAL_FEATURES \ */ --/* ADD_FEATURE("BSD386"); \ */ --/* ADD_FEATURE("MC68020") */ -- -- --/* #define I386 */ --/* #define SGC */ -- --/* #define CLEAR_CACHE do {void *v=memory->cfd.cfd_start,*ve=v+memory->cfd.cfd_size; for (;vsi_addr --/* #define GET_FAULT_ADDR(sig,code,sv,a) \ */ --/* ((void *)(*((char ***)(&code)))[44]) */ -+#define GET_FAULT_ADDR(sig,code,sv,a) ((siginfo_t *)code)->si_addr - #endif - - #define SGC -+#define STATIC_FUNCTION_POINTERS -+ -+#ifdef IN_SFASL -+#include -+#define CLEAR_CACHE_LINE_SIZE 32 -+#define CLEAR_CACHE {\ -+ void *v1=memory->cfd.cfd_start,*v,*ve=v1+memory->cfd.cfd_size+CLEAR_CACHE_LINE_SIZE; \ -+ v1=(void *)((unsigned long)v1 & ~(CLEAR_CACHE_LINE_SIZE - 1));\ -+ for (v=v1;v and it should be used (not on Ultrix). */ --#undef HAVE_ALLOCA_H -+#define DBEGIN 0 - --/* Define if the X Window System is missing or not being used. */ --#undef X_DISPLAY_MISSING - --#define DBEGIN 0 -+/* the size of the page tables for gcl. Each page is PAGESIZE which -+is usually 4K or 8K bytes. From 1 to 3 bytes per page are -+preallocated in a table at compile time. this must be a power of 2 if -+SGC is enabled. */ - --#define MAXPAGE 128*1024 -+#define MAXPAGE (128*1024*(SIZEOF_LONG>>2)/(1<<(PAGEWIDTH-12))) - #define VSSIZE 128*1024 - #define BDSSIZE 2*1024 - #define IHSSIZE 4*1024 -@@ -19,11 +19,33 @@ - - #define HOLEPAGE (MAXPAGE/10) - -+/* check to see if getcwd exists -+*/ -+#define HAVE_GETCWD 0 -+ -+ -+/* if we dont have USEGETCWD, we will use GETWD unless following defined -+*/ -+#undef HAVE_GETWD -+ -+ -+/* no gettimeofday function */ -+ - #undef NO_GETTOD - -+/* define if have */ -+#undef HAVE_ASM_SIGNAL_H -+ -+/* define if have */ -+#undef HAVE_ASM_SIGCONTEXT_H -+ - /* define if have struct sigcontext in one of above */ - #undef HAVE_SIGCONTEXT - -+ -+/* define if have */ -+#undef HAVE_SYS_IOCTL_H -+ - /* define if we can use the file nsocket.c */ - #undef HAVE_NSOCKET - -@@ -32,6 +54,7 @@ - #undef HAVE_ALLOCA - #endif - -+ - /* define if need alloca.h */ - #undef NEED_ALLOCA_H - -@@ -39,19 +62,23 @@ - #include - #endif - -+ - /* define LISTEN_USE_FCNTL if we can check for input using fcntl */ - #undef LISTEN_USE_FCNTL - - /* if signal.h alone contains the stuff necessary for sgc */ - #undef SIGNAL_H_HAS_SIGCONTEXT - -+ - /* define if the profil system call is not defined in libc */ - #undef NO_PROFILE - -+ - /* define if the _cleanup() function exists and should be called - before saving */ - /* #define USE_CLEANUP */ - -+ - /* define if BIG_ENDIAN or LITTLE_ENDIAN is defined by including - the standard includes */ - /* #define ENDIAN_ALREADY_DEFINED */ -@@ -59,18 +86,34 @@ - /* define if SV_ONSTACK is defined in signal.h */ - #undef HAVE_SV_ONSTACK - -+ -+/* -+ define to be a typical stack address. We use this to decide -+ whether we can use a cheap test for NULL_OR_ON_C_STACK, or whether -+ it has to be more complex.. -+ -+*/ -+ - #define CSTACK_ADDRESS 0 - -+/* define if SIGSYS is defined in signal.h */ -+ - #undef HAVE_SIGSYS - -+/* define if SIGEMT is defined in signal.h */ -+ - #undef HAVE_SIGEMT - -+ - /* define if setenv is define */ - #undef HAVE_SETENV - - /* define if putenv is define */ - #undef HAVE_PUTENV - -+ -+/* define if long long int works to multiply to ints, */ -+ - #undef HAVE_LONG_LONG - - /* define if want to use GMP */ -@@ -98,7 +141,7 @@ - /* bfd support */ - #undef HAVE_LIBBFD - #undef NEED_CONST --#undef HAVE_BFD_BOOLEAN -+#define HAVE_BFD_BOOLEAN - - #ifdef HAVE_BFD_BOOLEAN - #define MY_BFD_BOOLEAN bfd_boolean -@@ -126,8 +169,8 @@ - #else - #include - #define ISNORMAL(a) ((sizeof (a) == sizeof (float)) ? \ -- gcl_isnormal_float(a) : \ -- gcl_isnormal_double(a)) -+ gcl_isnormal_float(a) : \ -+ gcl_isnormal_double(a)) - #endif - #endif - #endif -@@ -163,6 +206,8 @@ - #endif - #endif - -+ -+ - /* math.h for definitions in generated C code */ - #undef HAVE_MATH_H - -@@ -179,6 +224,8 @@ - /* #define PAGESIZE (1< header file. */ -+/* Define to 1 if you have the header file. */ - #undef HAVE_ASM_SIGCONTEXT_H - --/* Define if you have the header file. */ -+/* Define to 1 if you have the header file. */ - #undef HAVE_ASM_SIGNAL_H - --/* Define if you have the header file. */ --#undef HAVE_ELF_H -- --/* Define if you have the header file. */ -+/* Define to 1 if you have the header file. */ - #undef HAVE_ELF_ABI_H - --/* Define if you have the header file. */ --#undef HAVE_ENDIAN_H -+/* Define to 1 if you have the header file. */ -+#undef HAVE_ELF_H -+ -+/* Have finite function */ -+#undef HAVE_FINITE - --/* Define if you have the header file. */ -+/* Define to 1 if you have the header file. */ - #undef HAVE_FLOAT_H - --/* Define if you have the header file. */ -+/* Define to 1 if you have the `getcwd' function. */ -+#undef HAVE_GETCWD -+ -+/* Define to 1 if you have the `getwd' function. */ -+#undef HAVE_GETWD -+ -+/* Have ieeefp fpclass function */ -+#undef HAVE_IEEEFP -+ -+/* Define to 1 if you have the header file. */ -+#undef HAVE_INTTYPES_H -+ -+/* Have isfinite function */ -+#undef HAVE_ISFINITE -+ -+/* Have isnormal function */ -+#undef HAVE_ISNORMAL -+ -+/* Define to 1 if you have the header file. */ - #undef HAVE_JAPI_H - --/* Define if you have the header file. */ -+/* memalign element present */ -+#undef HAVE_MALLOC_ZONE_MEMALIGN -+ -+/* Define to 1 if you have the header file. */ - #undef HAVE_MATH_H - --/* Define if you have the header file. */ -+/* Define to 1 if you have the header file. */ -+#undef HAVE_MEMORY_H -+ -+/* Define to 1 if you have the header file. */ - #undef HAVE_READLINE_READLINE_H - --/* Define if you have the header file. */ -+/* Define to 1 if you have the header file. */ - #undef HAVE_RPC_RPC_H - --/* Define if you have the header file. */ -+/* Define to 1 if you have the header file. */ -+#undef HAVE_STDINT_H -+ -+/* Define to 1 if you have the header file. */ -+#undef HAVE_STDLIB_H -+ -+/* Define to 1 if you have the header file. */ -+#undef HAVE_STRINGS_H -+ -+/* Define to 1 if you have the header file. */ -+#undef HAVE_STRING_H -+ -+/* Define to 1 if you have the header file. */ - #undef HAVE_SYS_IOCTL_H - --/* Define if you have the header file. */ -+/* Define to 1 if you have the header file. */ -+#undef HAVE_SYS_SOCKIO_H -+ -+/* Define to 1 if you have the header file. */ -+#undef HAVE_SYS_STAT_H -+ -+/* Define to 1 if you have the header file. */ -+#undef HAVE_SYS_TYPES_H -+ -+/* Define to 1 if you have the header file. */ -+#undef HAVE_UNISTD_H -+ -+/* Define to 1 if you have the header file. */ - #undef HAVE_VALUES_H -+ -+/* Define to the address where bug reports for this package should be sent. */ -+#undef PACKAGE_BUGREPORT -+ -+/* Define to the full name of this package. */ -+#undef PACKAGE_NAME -+ -+/* Define to the full name and version of this package. */ -+#undef PACKAGE_STRING -+ -+/* Define to the one symbol short name of this package. */ -+#undef PACKAGE_TARNAME -+ -+/* Define to the home page for this package. */ -+#undef PACKAGE_URL -+ -+/* Define to the version of this package. */ -+#undef PACKAGE_VERSION -+ -+/* The size of `long', as computed by sizeof. */ -+#undef SIZEOF_LONG -+ -+/* staticly linked images */ -+#undef STATIC_LINKING -+ -+/* Define to 1 if you have the ANSI C header files. */ -+#undef STDC_HEADERS ---- gcl-2.6.7.orig/h/alpha-linux.h -+++ gcl-2.6.7/h/alpha-linux.h -@@ -1,22 +1,5 @@ - #include "linux.h" - --/* #ifdef IN_GBC */ --/* #define GET_FAULT_ADDR(sig,code,sv,a) \ */ --/* ((void *)(*((char ***)(&code)))[17]) */ --/* #endif */ -- --/*#define NULL_OR_ON_C_STACK(x) ((x)==0 || ((unsigned int)x) > (unsigned int)(pagetochar(MAXPAGE+1)))*/ -- --/* #define ADDITIONAL_FEATURES \ */ --/* ADD_FEATURE("BSD386"); \ */ --/* ADD_FEATURE("MC68020") */ -- -- --/* #define I386 */ --/* #define SGC */ -- --/* #define CLEAR_CACHE do {void *v=memory->cfd.cfd_start,*ve=v+memory->cfd.cfd_size; for (;v 0x100000000) && ((unsigned long)x) < 0x120000000)) - -@@ -28,3 +11,10 @@ - (char *)((struct ucontext *)scp )->uc_mcontext.sc_traparg_a0 - #endif - #define SGC -+ -+#define RELOC_H "elf64_alpha_reloc.h" -+#define SPECIAL_RELOC_H "elf64_alpha_reloc_special.h" -+#define PAL_imb 134 -+#define imb() \ -+__asm__ __volatile__ ("call_pal %0 #imb" : : "i" (PAL_imb) : "memory") -+#define CLEAR_CACHE imb() ---- /dev/null -+++ gcl-2.6.7/h/tsgc.h -@@ -0,0 +1,6 @@ -+#include "config.h" -+#ifdef SGC -+"#define SGC" -+#else -+"#undef SGC" -+#endif ---- gcl-2.6.7.orig/h/solaris-i386.defs -+++ gcl-2.6.7/h/solaris-i386.defs -@@ -1,55 +1,65 @@ - --OFLAG = -O --LIBS = -lm -lsocket -lnsl -+# notes for redhat 6.0 -+# the configure should select the compiler GCC=/usr/bin/i386-glibc20-linux-gcc -+# However for the gcl-tk directory, you must use plain 'gcc' since -+# that must link with the tcl tk libs which have been compiled with it. -+# so after configure change to GCC=gcc in the gcl-tk/makefile - --# tell linker to remember where it got the shared object... --# should have the same for TCL/TK if you used shared libs.. --X11_LIBS=-Xlinker -R${X11_LIBS_DIR} -L${X11_LIBS_DIR} -lX11 - --ODIR_DEBUG=-O4 -+# Machine dependent makefile definitions for intel 386,486 running linux - --#gcc 2.1 and 2.2 compile akcl correctly as far as I have been able to determine. --#gcc 2.3.3 does not compile akcl correctly --#gcc 2.4.5 does compile akcl, but does fail on some subsequent tests. --#gcc 2.5.3 does compile gcl correctly however it has a known bug. --#gcc 2.6.3 appears to compile gcl ok -+LBINDIR=/usr/local/bin - --CC = gcc -I${GCLDIR}/o -DVOL=volatile -fsigned-char --# static doesn't work with gcl on solaris 2.5 x86 --# LDCC= ${CC} -static --ODIR_DEBUG= -O -+#OFLAG = -g -Wall -+#OFLAG = -g -Wall -fomit-frame-pointer -Werror -+#LIBS = -lm - --#The new optional for money compiler has not been tested recently. --# it used to fail to compile o/format.o correctly. --#CC = /usr/local/lang/cc -DVOL= -I$(GCLDIR)/o -Bstatic -temp=. -pipe --ODIR_DEBUG= -O4 -+#ODIR_DEBUG= -g -Wall -fomit-frame-pointer -Werror -+#ODIR_DEBUG= -g -Wall - --AS=/usr/ccs/bin/as -P -D__svr4__ -+# This CC string will be used for compilation of the system, -+# and also in the compiler::*cc* variable for later compilation of -+# lisp files. -+# (the -pipe is just since our file system is slow..) -+#CC = ${GCC} -pipe -fwritable-strings -DVOL=volatile -I$(GCLDIR)/o -fsigned-char -Wall $(EXTRA_CFLAGS) -fomit-frame-pointer -Werror -g - --CFLAGS = -c $(DEFS) -I../h -+# under redhat 6.1 and slackware 7.0 we needed to have this -+# link be static, but should be ok with the fix to unixport/rsym_elf.c -+LDCC=${CC} -static -+LDCC=${CC} - --MAIN = ../o/main.o -+# note for linuxaout on an elf machine add -b i486-linuxaout -+# CC = gcc -pipe -fwritable-strings -DVOL=volatile -I$(GCLDIR)/o -fsigned-char -b i486-linuxaout - --MPFILES=$(MPDIR)/mpi-sol-sparc.o $(MPDIR)/sparcdivul3.o $(MPDIR)/libmport.a --MPFILES=${MPDIR}/mpi.o $(MPDIR)/libmport.a -+# Enable the fastloading mechanism which does not use ld -A -+# requires c/rel_.. machine dependent code. -+ -+RSYM = rsym -+ifneq ($(findstring bfd,$(LIBS)),) -+RSYM = -+endif -+ifneq ($(BUILD_BFD),) -+RSYM = -+endif -+#ifneq ($(findstring -ldl,$(LIBS)),) -+#RSYM = -+#endif -+ -+SFASL = $(ODIR)/sfasl.o -+ -+ -+#MPFILES= $(MPDIR)/mpi-386d.o $(MPDIR)/libmport.a - --RSYM = rsym --SFASL = $(ODIR)/sfasl.o - --# This function will be run before dumping. - # When using SFASL it is good to have (si::build-symbol-table) - INITFORM=(si::build-symbol-table) - --GNULIB1= -- - # Use symbolic links - SYMB=-s --# the make to use for saved_kcp the profiler. --KCP=kcp-sun - --NULLFILE = ../h/secondary_sun_magic --# no ranlib so use dummy --RANLIB=true --# use the sun ar --AR=/usr/ccs/bin/ar qc -+LIBFILES=bsearch.o -+ -+# the make to use for saved_kcp the profiler. -+KCP=kcp-bsd - -+SHELL=/bin/bash ---- /dev/null -+++ gcl-2.6.7/h/elf64_alpha_reloc.h -@@ -0,0 +1,46 @@ -+ case R_ALPHA_GPDISP: -+ s=(ul)got; -+ s-=p; -+ s+=(s&0x8000)<<1; -+ store_val(where,MASK(16),s>>16); -+ where=(void *)where+a; -+ store_val(where,MASK(16),s); -+ break; -+ case R_ALPHA_SREL32: -+ store_val(where,MASK(32),s+a-p); -+ break; -+ case R_ALPHA_GPREL32: -+ store_val(where,MASK(32),s+a-(ul)got); -+ break; -+ case R_ALPHA_LITUSE: -+ case R_ALPHA_HINT: -+ break; -+ case R_ALPHA_REFQUAD: -+ store_val(where,~0L,s+a); -+ break; -+ case R_ALPHA_REFLONG: -+ store_val(where,MASK(32),s+a); -+ break; -+ case R_ALPHA_LITERAL: -+ s+=a&MASK(32); -+ gote=got+(a>>32)-1; -+ massert(s); -+ if (s>=ggot1 && s>16); -+ break; -+ case R_ALPHA_GPRELLOW: -+ store_val(where,MASK(16),s+a-(ul)got); -+ break; -+ case R_ALPHA_TLS_GD_HI: -+ store_vals(where,MASK(21),((long)(s+a-(p+4)))>>2); -+ break; ---- /dev/null -+++ gcl-2.6.7/h/386-macosx.h -@@ -0,0 +1,220 @@ -+/* -+ GCL config file for Mac OS X. -+ -+ To be used with the following configure switches : -+ --enable-debug (optional) -+ --enable-machine=powerpc-macosx -+ --disable-statsysbfd -+ --enable-custreloc -+ -+ Aurelien Chanudet -+*/ -+ -+/* For those who are using ACL2, please remember to enlarge your shell stack (ulimit -s 8192). */ -+ -+#include "bsd.h" -+ -+#define DARWIN -+ -+/* Mac OS X has its own executable file format (Mach-O). */ -+#undef HAVE_AOUT -+#undef HAVE_ELF -+ -+ -+/** sbrk(2) emulation */ -+ -+/* Alternatively, we could use the global variable vm_page_size. */ -+#define PAGEWIDTH 12 -+ -+/* The following value determines the running process heap size. */ -+/* #define BIG_HEAP_SIZE 0x50000000 */ -+ -+extern char *mach_mapstart; -+extern char *mach_maplimit; -+extern char *mach_brkpt; -+ -+extern char *get_dbegin (); -+ -+#undef SET_REAL_MAXPAGE -+#define SET_REAL_MAXPAGE real_maxpage = MAXPAGE -+ -+#include /* to get sbrk defined */ -+extern void *my_sbrk(int incr); -+#define sbrk my_sbrk -+ -+ -+/** (si::save-system "...") a.k.a. unexec implementation */ -+ -+/* The implementation of unexec for GCL is based on Andrew Choi's work for Emacs. -+ Previous pioneering implementation of unexec for Mac OS X by Steve Nygard. */ -+#define UNIXSAVE "unexmacosx.c" -+ -+#undef malloc -+#define malloc my_malloc -+ -+#undef free -+#define free my_free -+ -+#undef realloc -+#define realloc my_realloc -+ -+#undef valloc -+#define valloc my_valloc -+ -+#undef calloc -+#define calloc my_calloc -+ -+ -+/** Dynamic loading implementation */ -+ -+/* The sfasl{bfd,macosx,macho}.c files are included from sfasl.c. */ -+#ifdef HAVE_LIBBFD -+#define SEPARATE_SFASL_FILE "sfaslbfd.c" -+#else -+#define SPECIAL_RSYM "rsym_macosx.c" -+#define SEPARATE_SFASL_FILE "sfaslmacho.c" -+#endif -+ -+/* The file has non Mach-O stuff appended. We need to know where the Mach-O stuff ends. */ -+#include -+extern int seek_to_end_ofile (FILE *); -+#define SEEK_TO_END_OFILE(fp) seek_to_end_ofile(fp) -+ -+#ifdef IN_SFASL -+#include -+#define CLEAR_CACHE {\ -+ void *p,*pe; \ -+ p=(void *)((unsigned long)memory->cfd.cfd_start & ~(PAGESIZE-1)); \ -+ pe=(void *)((unsigned long)(memory->cfd.cfd_start+memory->cfd.cfd_size) & ~(PAGESIZE-1)) + PAGESIZE-1; \ -+ if (mprotect(p,pe-p,PROT_READ|PROT_WRITE|PROT_EXEC)) {\ -+ fprintf(stderr,"%p %p\n",p,pe);\ -+ perror("");\ -+ FEerror("Cannot mprotect", 0);\ -+ }\ -+} -+#endif -+ -+ -+/* Processor cache synchronization code. This is based on powerpc-linux.h (Debian ppc). -+ See equivalent code in dyld. See also vm_msync declared in . */ -+/* #define CLEAR_CACHE_LINE_SIZE 32 */ -+/* #define CLEAR_CACHE \ */ -+/* do { \ */ -+/* void *v=memory->cfd.cfd_start,*ve=v+memory->cfd.cfd_size; \ */ -+/* v=(void *)((unsigned long)v & ~(CLEAR_CACHE_LINE_SIZE - 1)); \ */ -+/* for (;vsi_addr -+/* #define GET_FAULT_ADDR(sig,code,scp,addr) ((char *) (((ucontext_t *) scp)->uc_mcontext->es.dar)) */ -+ -+/* -+#include -+#include -+#include -+#include -+ -+void handler (int sig, siginfo_t *info, void *scp) -+{ -+ ucontext_t *uc = (ucontext_t *)scp; -+ fprintf(stderr, "addr = 0x%08lx\n", uc->uc_mcontext->es.dar); -+ _exit(99); -+} -+ -+int main(void) -+{ -+ struct sigaction sact; -+ int ret; -+ -+ sigfillset(&(sact.sa_mask)); -+ sact.sa_flags = SA_SIGINFO; -+ sact.sa_sigaction = (void (*)())handler; -+ ret = sigaction (SIGBUS, &sact, 0); -+ return *(int *)0x43; -+} -+*/ -+ -+ -+/** Misc stuff */ -+ -+#define IEEEFLOAT -+ -+/* Mac OS X does not have _fileno as in linux.h. Nor does it have _cnt as in bsd.h. -+ Let's see what we can do with this declaration found in {Net,Free,Open}BSD.h. */ -+#undef LISTEN_FOR_INPUT -+#define LISTEN_FOR_INPUT(fp) \ -+do {int c=0; \ -+ if ((fp)->_r <=0 && (c=0, ioctl((fp)->_file, FIONREAD, &c), c<=0)) \ -+ return(FALSE); \ -+} while (0) -+ -+/* We (hopefully) dont need to worry about zeroing fp->_base. */ -+#define FCLOSE_SETBUF_OK -+ -+#define GET_FULL_PATH_SELF(a_) \ -+do { \ -+extern int _NSGetExecutablePath (char *, unsigned long *); \ -+unsigned long bufsize = 1024; \ -+static char buf [1024]; \ -+static char fub [1024]; \ -+if (_NSGetExecutablePath (buf, &bufsize) != 0) { \ -+ error ("_NSGetExecutablePath failed"); \ -+} \ -+if (realpath (buf, fub) == 0) { \ -+ error ("realpath failed"); \ -+} \ -+(a_) = fub; \ -+} while (0) -+ -+#ifdef _LP64 -+#define C_GC_OFFSET 4 -+#include -+#define RELOC_H "mach64_i386_reloc.h" -+#else -+#define RELOC_H "mach32_i386_reloc.h" -+#endif ---- /dev/null -+++ gcl-2.6.7/h/elf32_s390_reloc.h -@@ -0,0 +1,7 @@ -+ case R_390_32: -+ add_val(where,~0L,s+a); -+ break; -+ -+ case R_390_PC32: -+ add_val(where,~0L,s+a-p); -+ break; ---- gcl-2.6.7.orig/h/page.h -+++ gcl-2.6.7/h/page.h -@@ -1,5 +1,3 @@ -- -- - #define MAYBE_DATA_P(pp) ((char *)(pp)>= (char *) DBEGIN) - - #ifndef DBEGIN -@@ -59,14 +57,14 @@ char sgc_type_map[MAXPAGE]; - #define SGC_WRITABLE (SGC_PERM_WRITABLE | SGC_TEMP_WRITABLE) - #define SGC_PAGE (SGC_TEMP_WRITABLE | SGC_PAGE_FLAG) - --#define SGC_PAGE_P(p) ((unsigned long)p>2); -+ break; -+ -+ case R_SPARC_HI22: -+ /* t-sim22 */ -+ store_val(where,MASK(22),(s+a)>>10); -+ break; -+ -+ case R_SPARC_LO10: -+ /* val = (s+a) & MASK(10); */ -+ store_val(where,MASK(10),s+a); -+ break; -+ -+ case R_SPARC_32: -+ case R_SPARC_UA32: -+ store_valu(where,~0L,s+a); -+ break; ---- /dev/null -+++ gcl-2.6.7/h/elf32_i386_reloc.h -@@ -0,0 +1,8 @@ -+ case R_386_32: -+ add_val(where,~0L,s+a); -+ break; -+ -+ case R_386_PC32: -+ add_val(where,~0L,s+a-p); -+ break; -+ ---- /dev/null -+++ gcl-2.6.7/h/elf32_mips_reloc.h -@@ -0,0 +1,43 @@ -+ case R_MIPS_JALR: -+ break; -+ case R_MIPS_GPREL32: -+ add_val(where,~0L,s+a-(ul)got); -+ break; -+ case R_MIPS_26: -+ add_val(where,MASK(26),(s+a)>>2); -+ break; -+ case R_MIPS_32: -+ add_val(where,~0L,s+a); -+ break; -+ case R_MIPS_GOT16: -+ if (sym->st_shndx) { /* this should be followed by a LO16 */ -+ store_val(where,0xffe00000,0x3c000000); -+ r->r_info=ELF_R_INFO(ELF_R_SYM(r->r_info),R_MIPS_HI16); -+ relocate(sym1,r,a,start,got,gote); -+ break; -+ } -+ case R_MIPS_CALL16: -+ gote=got+sym->st_size-1; -+ store_val(where,MASK(16),((void *)gote-(void *)got)); -+ if (s>=ggot && sst_other) s=gpd=(ul)got-(sym->st_other==2 ? 0 : (ul)where); -+ if (!hr) hr=r; -+ if (a) add_vals(where,MASK(16),(s>>16)+a); -+ break; -+ case R_MIPS_LO16: -+ if (sym->st_other) s=gpd; -+ a=*where&MASK(16); -+ if (a&0x8000) a|=0xffff0000; -+ a+=s&MASK(16); -+ a+=(a&0x8000)<<1; -+ store_val(where,MASK(16),a); -+ a=0x10000|(a>>16); -+ for (hr=hr ? hr : r;--r>=hr && ELF_R_TYPE(r->r_info)==R_MIPS_HI16;) -+ relocate(sym1,r,a,start,got,gote); -+ hr=NULL;gpd=0; -+ break; ---- gcl-2.6.7.orig/h/s390-linux.h -+++ gcl-2.6.7/h/s390-linux.h -@@ -12,3 +12,5 @@ - #endif - - #define SGC -+ -+#define RELOC_H "elf32_s390_reloc.h" ---- gcl-2.6.7.orig/h/linux.h -+++ gcl-2.6.7/h/linux.h -@@ -54,7 +54,7 @@ do {static struct sigaction action; \ - extern char etext; \ - real_maxpage = MAXPAGE ;\ - getrlimit(RLIMIT_DATA, &data_rlimit); \ -- real_maxpage = ((unsigned int)&etext/PAGESIZE \ -+ real_maxpage = ((unsigned long)&etext/PAGESIZE \ - + data_rlimit.rlim_cur/PAGESIZE - ELF_TEXT_BASE/PAGESIZE); \ - if (real_maxpage > MAXPAGE) \ - real_maxpage = MAXPAGE ; } while(0) -@@ -66,9 +66,9 @@ do {static struct sigaction action; \ - #ifdef HAVE_LIBBFD - #define SEPARATE_SFASL_FILE "sfaslbfd.c" - #else --#if !defined(__i386__) && !defined(__sparc__) --#error Can only do non-bfd relocs for i386 and sparc --#endif -+/* #if !defined(__i386__) && !defined(__sparc__) */ -+/* #error Can only do non-bfd relocs for i386 and sparc */ -+/* #endif */ - #define SPECIAL_RSYM "rsym_elf.c" - #define SEPARATE_SFASL_FILE "sfaslelf.c" - #endif -@@ -80,18 +80,18 @@ do {static struct sigaction action; \ - #undef HAVE_SIGVEC - #define HAVE_SIGACTION - /* make this a noop */ --#define SETUP_SIG_STACK -+/* #define SETUP_SIG_STACK */ - #ifndef HAVE_SV_ONSTACK - #define SV_ONSTACK 0 - #endif - - /* unblock signals m and n, and set val to signal_mask(m) | signal_mask(n) - if they were set */ --#define SIG_UNBLOCK_SIGNALS(val,m,n) \ -- current_mask = sigblock(0); \ -- sigsetmask(~(sigmask(m)) & ~(sigmask(n)) & current_mask); \ -- result = (current_mask & sigmask(m) ? signal_mask(m) : 0) \ -- | (current_mask & sigmask(n) ? signal_mask(n) : 0); -+/* #define SIG_UNBLOCK_SIGNALS(val,m,n) \ */ -+/* current_mask = sigblock(0); \ */ -+/* sigsetmask(~(sigmask(m)) & ~(sigmask(n)) & current_mask); \ */ -+/* result = (current_mask & sigmask(m) ? signal_mask(m) : 0) \ */ -+/* | (current_mask & sigmask(n) ? signal_mask(n) : 0); */ - - #define RUN_PROCESS - -@@ -125,7 +125,7 @@ do { int c = 0; \ - - - #define INSTALL_SEGMENTATION_CATCHER \ -- (void) signal(SIGSEGV,segmentation_catcher) -+ (void) gcl_signal(SIGSEGV,segmentation_catcher) - - - /* get the fileno of a FILE* */ ---- gcl-2.6.7.orig/h/ptable.h -+++ gcl-2.6.7/h/ptable.h -@@ -15,7 +15,7 @@ there are tab.n_symbols pairs occurring. - typedef unsigned long addr; - - struct node{ -- char *string; -+ const char *string; - addr address; - #ifdef AIX3 - unsigned short tc_offset; -@@ -26,8 +26,8 @@ struct lsymbol_table{ - unsigned int n_symbols ; - unsigned int tot_leng;}; - --#define SYM_ADDRESS(table,i) ((*(table).ptable))[i].address --#define SYM_STRING(table,i) ((*(table).ptable))[i].string -+#define SYM_ADDRESS(table,i) table.ptable[i].address -+#define SYM_STRING(table,i) table.ptable[i].string - #define SYM_TC_OFF(table,i) ((*(table).ptable))[i].tc_offset - - /* typedef struct node *TABL; */ -@@ -35,10 +35,8 @@ struct lsymbol_table{ - - typedef struct node TABL[]; - --struct node * find_sym_ptable(); -- - struct string_address_table --{ TABL *ptable; -+{ struct node *ptable; - unsigned int length; - unsigned int alloc_length; - }; ---- /dev/null -+++ gcl-2.6.7/h/elf32_m68k_reloc.h -@@ -0,0 +1,6 @@ -+ case R_68K_32: -+ add_val(where,~0L,s+a); -+ break; -+ case R_68K_PC32: -+ add_val(where,~0L,s+a-p); -+ break; ---- gcl-2.6.7.orig/h/powerpc-linux.h -+++ gcl-2.6.7/h/powerpc-linux.h -@@ -15,3 +15,5 @@ - for (;vsi_addr */ -+/* the following two files have changed back -+ and forth in recent versions of linux... -+ Include both if they both exist, otherwise -+ include whatever one exists... -+ basically one wants the -+ struct sigcontext_struct { ... } ; -+ so as to get the fault address. -+ */ -+ -+#if !defined(SIGNAL_H_HAS_SIGCONTEXT) && !defined(HAVE_SIGCONTEXT) -+#error Need sigcontext on 386 linux -+#else -+#include -+#ifndef SIGNAL_H_HAS_SIGCONTEXT -+#ifdef HAVE_ASM_SIGCONTEXT_H -+#include -+#endif -+#ifdef HAVE_ASM_SIGNAL_H -+#include -+#endif -+#endif -+#endif -+ -+#undef MPROTECT_ACTION_FLAGS -+#define MPROTECT_ACTION_FLAGS SA_RESTART|SA_SIGINFO -+#define GET_FAULT_ADDR(sig,code,sv,a) ((siginfo_t *)code)->si_addr -+#endif -+ -+/*#define NULL_OR_ON_C_STACK(x) ((x)==0 || ((unsigned int)x) > (unsigned int)(pagetochar(MAXPAGE+1)))*/ -+ -+#define ADDITIONAL_FEATURES \ -+ ADD_FEATURE("BSD386"); \ -+ ADD_FEATURE("MC68020") -+ -+ -+#define I386 -+#define SGC -+ -+ -+#ifdef IN_SFASL -+#include -+#define CLEAR_CACHE {\ -+ void *p,*pe; \ -+ p=(void *)((unsigned long)memory->cfd.cfd_start & ~(PAGESIZE-1)); \ -+ pe=(void *)((unsigned long)(memory->cfd.cfd_start+memory->cfd.cfd_size) & ~(PAGESIZE-1)) + PAGESIZE-1; \ -+ if (mprotect(p,pe-p,PROT_READ|PROT_WRITE|PROT_EXEC)) {\ -+ fprintf(stderr,"%p %p\n",p,pe);\ -+ perror("");\ -+ FEerror("Cannot mprotect", 0);\ -+ }\ -+} -+#endif -+ -+#define RELOC_H "elf32_i386_reloc.h" ---- gcl-2.6.7.orig/h/arm-linux.h -+++ gcl-2.6.7/h/arm-linux.h -@@ -11,15 +11,19 @@ - /* : "a1"); \*/ - /* } while (0) */ - --#define CLEAR_CACHE do {\ -- void *v=memory->cfd.cfd_start,*ve=v+memory->cfd.cfd_size; \ -- register unsigned long _beg __asm ("a1") = (unsigned long)(v); \ -- register unsigned long _end __asm ("a2") = (unsigned long)(ve);\ -- register unsigned long _flg __asm ("a3") = 0; \ -- __asm __volatile ("swi 0x9f0002 @ sys_cacheflush" \ -- : "=r" (_beg) \ -- : "0" (_beg), "r" (_end), "r"(_flg)); \ --} while (0) -+/* #define CLEAR_CACHE do {\ */ -+/* void *v=memory->cfd.cfd_start,*ve=v+memory->cfd.cfd_size; \ */ -+/* register unsigned long _beg __asm ("a1") = (unsigned long)(v); \ */ -+/* register unsigned long _end __asm ("a2") = (unsigned long)(ve);\ */ -+/* register unsigned long _flg __asm ("a3") = 0; \ */ -+/* __asm __volatile ("swi 0x9f0002 @ sys_cacheflush" \ */ -+/* : "=r" (_beg) \ */ -+/* : "0" (_beg), "r" (_end), "r"(_flg)); \ */ -+/* } while (0) */ -+ -+#define CLEAR_CACHE \ -+ __builtin___clear_cache((void *)memory->cfd.cfd_start,\ -+ (void *)memory->cfd.cfd_start+memory->cfd.cfd_size) - - #ifdef IN_GBC - #undef MPROTECT_ACTION_FLAGS -@@ -31,3 +35,5 @@ - #endif - - #define SGC -+ -+#define RELOC_H "elf32_arm_reloc.h" ---- gcl-2.6.7.orig/h/m68k-linux.h -+++ gcl-2.6.7/h/m68k-linux.h -@@ -74,3 +74,5 @@ int cacheflush(void *,int,int,int); - } while(0) - - #define C_GC_OFFSET 2 -+ -+#define RELOC_H "elf32_m68k_reloc.h" ---- /dev/null -+++ gcl-2.6.7/h/elf64_sparc_reloc.h -@@ -0,0 +1,30 @@ -+ case R_SPARC_WDISP30: -+ store_ivals((int *)where,MASK(30),((long)(s+a-p))>>2); -+ break; -+ -+ case R_SPARC_HI22: -+ store_ival((int *)where,MASK(22),(s+a)>>10); -+ break; -+ -+ case R_SPARC_LO10: -+ store_ival((int *)where,MASK(10),s+a); -+ break; -+ -+ case R_SPARC_OLO10: -+ store_ival((int *)where,MASK(10),s+a); -+ add_ival((int *)where,MASK(13),ELF_R_ADDEND(r->r_info)); -+ break; -+ -+ case R_SPARC_13: -+ store_ivalu((int *)where,MASK(13),s+a); -+ break; -+ -+ case R_SPARC_32: -+ case R_SPARC_UA32: -+ store_ivalu((int *)where,MASK(32),s+a); -+ break; -+ -+ case R_SPARC_64: -+ case R_SPARC_UA64: -+ store_valu(where,~0L,s+a); -+ break; ---- gcl-2.6.7.orig/h/386-linux.h -+++ gcl-2.6.7/h/386-linux.h -@@ -28,8 +28,10 @@ - #endif - #endif - --#define GET_FAULT_ADDR(sig,code,sv,a) \ -- ((void *)(((struct sigcontext *)(&code))->cr2)) -+#undef MPROTECT_ACTION_FLAGS -+#define MPROTECT_ACTION_FLAGS SA_RESTART|SA_SIGINFO -+#define GET_FAULT_ADDR(sig,code,sv,a) ((siginfo_t *)code)->si_addr -+/* #define GET_FAULT_ADDR(sig,code,sv,a) ((void *)(((struct sigcontext *)(&code))->cr2)) */ - #endif - - /*#define NULL_OR_ON_C_STACK(x) ((x)==0 || ((unsigned int)x) > (unsigned int)(pagetochar(MAXPAGE+1)))*/ -@@ -56,3 +58,5 @@ - }\ - } - #endif -+ -+#define RELOC_H "elf32_i386_reloc.h" ---- /dev/null -+++ gcl-2.6.7/h/386-gnu.h -@@ -0,0 +1,74 @@ -+#include "linux.h" -+ -+#ifdef IN_GBC -+/* #undef MPROTECT_ACTION_FLAGS */ -+/* #define MPROTECT_ACTION_FLAGS SA_RESTART|SA_SIGINFO */ -+/* #define GET_FAULT_ADDR(sig,code,sv,a) \ */ -+/* ((siginfo_t *)code)->si_addr */ -+/* the following two files have changed back -+ and forth in recent versions of linux... -+ Include both if they both exist, otherwise -+ include whatever one exists... -+ basically one wants the -+ struct sigcontext_struct { ... } ; -+ so as to get the fault address. -+ */ -+ -+#if !defined(SIGNAL_H_HAS_SIGCONTEXT) && !defined(HAVE_SIGCONTEXT) -+#error Need sigcontext on 386 linux -+#else -+#include -+#ifndef SIGNAL_H_HAS_SIGCONTEXT -+#ifdef HAVE_ASM_SIGCONTEXT_H -+#include -+#endif -+#ifdef HAVE_ASM_SIGNAL_H -+#include -+#endif -+#endif -+#endif -+ -+#undef MPROTECT_ACTION_FLAGS -+#define MPROTECT_ACTION_FLAGS SA_RESTART|SA_SIGINFO -+#ifndef SA_SIGINFO -+#define GET_FAULT_ADDR(sig,code,sv,a) ((char *)code) -+#define SA_SIGINFO 0 -+#else -+#define GET_FAULT_ADDR(sig,code,sv,a) ((siginfo_t *)code)->si_addr -+#endif -+/* #define GET_FAULT_ADDR(sig,code,sv,a) ((void *)(((struct sigcontext *)(&code))->cr2)) */ -+#endif -+ -+/*#define NULL_OR_ON_C_STACK(x) ((x)==0 || ((unsigned int)x) > (unsigned int)(pagetochar(MAXPAGE+1)))*/ -+ -+#define ADDITIONAL_FEATURES \ -+ ADD_FEATURE("BSD386"); \ -+ ADD_FEATURE("MC68020") -+ -+ -+#define I386 -+#define SGC -+ -+ -+#ifdef IN_SFASL -+#include -+#define CLEAR_CACHE {\ -+ void *p,*pe; \ -+ p=(void *)((unsigned long)memory->cfd.cfd_start & ~(PAGESIZE-1)); \ -+ pe=(void *)((unsigned long)(memory->cfd.cfd_start+memory->cfd.cfd_size) & ~(PAGESIZE-1)) + PAGESIZE-1; \ -+ if (mprotect(p,pe-p,PROT_READ|PROT_WRITE|PROT_EXEC)) {\ -+ fprintf(stderr,"%p %p\n",p,pe);\ -+ perror("");\ -+ FEerror("Cannot mprotect", 0);\ -+ }\ -+} -+#endif -+ -+#ifndef SA_NOCLDWAIT -+#define SA_NOCLDWAIT 0 /*fixme handler does waitpid(-1, ..., WNOHANG)*/ -+#endif -+#define NULL_OR_ON_C_STACK(x) ((unsigned long)x <= DBEGIN)/*fixme configure detect*/ -+#define PATH_MAX 4096 /*fixme dynamic*/ -+#define MAXPATHLEN 4096 /*fixme dynamic*/ -+ -+#define RELOC_H "elf32_i386_reloc.h" ---- gcl-2.6.7.orig/h/powerpc-macosx.h -+++ gcl-2.6.7/h/powerpc-macosx.h -@@ -36,10 +36,11 @@ extern char *mach_brkpt; - extern char *get_dbegin (); - - #undef SET_REAL_MAXPAGE --#define SET_REAL_MAXPAGE { my_sbrk(0); real_maxpage = (int) mach_maplimit/PAGESIZE; } -+#define SET_REAL_MAXPAGE real_maxpage = MAXPAGE - -+#include /* to get sbrk defined */ -+extern void *my_sbrk(int incr); - #define sbrk my_sbrk --extern char *my_sbrk(int incr); - - - /** (si::save-system "...") a.k.a. unexec implementation */ -@@ -71,7 +72,7 @@ extern char *my_sbrk(int incr); - #define SEPARATE_SFASL_FILE "sfaslbfd.c" - #else - #define SPECIAL_RSYM "rsym_macosx.c" --#define SEPARATE_SFASL_FILE "sfaslmacosx.c" -+#define SEPARATE_SFASL_FILE "sfaslmacho.c" - #endif - - /* The file has non Mach-O stuff appended. We need to know where the Mach-O stuff ends. */ -@@ -193,3 +194,5 @@ if (realpath (buf, fub) == 0) { - } \ - (a_) = fub; \ - } while (0) -+ -+#define RELOC_H "mach32_ppc_reloc.h" ---- gcl-2.6.7.orig/h/att_ext.h -+++ gcl-2.6.7/h/att_ext.h -@@ -313,7 +313,7 @@ EXTER object sLblock; - /* number.c */ - EXTER object shortfloat_zero; - EXTER object longfloat_zero; --#define make_fixnum(a) ((((FIXtemp=(a))+SMALL_FIXNUM_LIMIT)&(-2*SMALL_FIXNUM_LIMIT))==0?small_fixnum(FIXtemp):make_fixnum1(FIXtemp)) -+#define make_fixnum(a) ({fixnum _a=(a);((_a+SMALL_FIXNUM_LIMIT)&(-2*SMALL_FIXNUM_LIMIT))==0?small_fixnum(_a):make_fixnum1(_a);}) - object make_fixnum1(long); - object make_ratio(); - object make_shortfloat(); -@@ -461,7 +461,7 @@ EXTER object sLAread_default_float_forma - EXTER object sLAread_baseA; - EXTER object sLAread_suppressA; - EXTER object READtable; --/* EXTER object read_byte1(); */ -+EXTER object read_byte1(); - EXTER int READdefault_float_format; - EXTER int READbase; - EXTER bool READsuppress; ---- /dev/null -+++ gcl-2.6.7/h/elf32_ppc_reloc.h -@@ -0,0 +1,22 @@ -+ case R_PPC_REL24: /*FIXME, this is just for mcount, why longcall doesn't work is unknown */ -+ s+=a; -+ if (ovchks(s,~MASK(26))) -+ store_val(where,MASK(26),s|0x3); -+ else if (ovchks(s-p,~MASK(26))) -+ store_val(where,MASK(26),(s-p)|0x1); -+ else massert(!"REL24 overflow"); -+ break; -+ case R_PPC_REL32: -+ store_val(where,~0L,s+a-p); -+ break; -+ case R_PPC_ADDR16_HA: -+ s+=a; -+ s+=s&0x8000 ? 1<<16 : 0; -+ store_val(where,~MASK(16),s&0xffff0000); -+ break; -+ case R_PPC_ADDR16_LO: -+ store_val(where,~MASK(16),(s+a)<<16); -+ break; -+ case R_PPC_ADDR32: -+ store_val(where,~0L,s+a); -+ break; ---- gcl-2.6.7.orig/h/sparc-linux.h -+++ gcl-2.6.7/h/sparc-linux.h -@@ -18,3 +18,9 @@ - - #define PTR_ALIGN 8 - -+#if SIZEOF_LONG==4 -+#define RELOC_H "elf32_sparc_reloc.h" -+#else -+#define RELOC_H "elf64_sparc_reloc.h" -+#define SPECIAL_RELOC_H "elf64_sparc_reloc_special.h" -+#endif ---- /dev/null -+++ gcl-2.6.7/h/unrandomize.h -@@ -0,0 +1,39 @@ -+#include -+#include -+#include -+#include -+#include -+ -+ -+{ -+ errno=0; -+ -+ { -+ -+ long pers = personality(0xffffffffUL); -+ if (pers==-1) {printf("personality failure %d\n",errno);exit(-1);} -+ if (!(pers & ADDR_NO_RANDOMIZE) && !getenv("GCL_UNRANDOMIZE")) { -+ errno=0; -+ if (personality(pers | ADDR_NO_RANDOMIZE) != -1 && personality(0xffffffffUL) & ADDR_NO_RANDOMIZE) { -+ int i; -+ char **n; -+ for (i=0;envp[i];i++); -+ n=alloca((i+2)*sizeof(*n)); -+ n[i+1]=0; -+ n[i--]="GCL_UNRANDOMIZE=t"; -+ for (;i>=0;i--) -+ n[i]=envp[i]; -+#ifdef GCL_GPROF -+ gprof_cleanup(); -+#endif -+ errno=0; -+ execve(*argv,argv,n); -+ printf("execve failure %d\n",errno); -+ exit(-1); -+ } else { -+ printf("personality change failure %d\n",errno); -+ exit(-1); -+ } -+ } -+ } -+} ---- /dev/null -+++ gcl-2.6.7/h/elf32_hppa_reloc_special.h -@@ -0,0 +1,41 @@ -+static ul pltgot; -+ -+#define ASM21(x) ((x>>20)|(((x>>9)&0x7ff)<<1)|(((x>>7)&0x3)<<14)|(((x>>2)&0x1f)<<16)|(((x>>0)&0x3)<<12)) -+/* be,l off(sr4,r19),sr0,r31 ; linux userspace sr4-7 const, sr0-3 used by kernel */ -+#define ASM17(x) ((x>>16)|(((x>>11)&0x1f)<<16)|((x&0x3ff)<<3)|(((x>>10)&0x1)<<2)|(1<<13)) -+ -+static int -+find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, -+ const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { -+ -+ Rela *r; -+ Shdr *sec; -+ ul *q; -+ void *p,*pe; -+ -+ massert(sec=get_section(".dynamic",sec1,sece,sn)); -+ for (p=(void *)sec->sh_addr,pe=p+sec->sh_size;psh_entsize) { -+ q=p; -+ if (q[0]==DT_PLTGOT) -+ pltgot=q[1]; -+ -+ } -+ massert(pltgot); -+ -+ massert(sec=get_section(".rela.plt",sec1,sece,sn)); -+ p=v+sec->sh_offset; -+ pe=p+sec->sh_size; -+ for (r=p;psh_entsize,r=p) -+ if (!ds1[ELF_R_SYM(r->r_info)].st_value) -+ ds1[ELF_R_SYM(r->r_info)].st_value=r->r_offset|0x2; -+ -+ return 0; -+ -+} -+ -+static int -+label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,ul *gs) { -+ -+ return 0; -+ -+} ---- gcl-2.6.7.orig/h/mingw.h -+++ gcl-2.6.7/h/mingw.h -@@ -7,7 +7,7 @@ - # undef RSYM_COMMAND - # define SEPARATE_SFASL_FILE "sfaslbfd.c" - #else --# undef SEPARATE_SFASL_FILE -+# define SEPARATE_SFASL_FILE "sfaslcoff.c" - # define SPECIAL_RSYM "rsym_nt.c" - # define RSYM_COMMAND(command,system_directory,kcl_self,tmpfile1) \ - sprintf(command,"rsym %s %s",kcl_self,tmpfile1); -@@ -103,9 +103,10 @@ extern DBEGIN_TY _stacktop, _stackbottom - if the pointe/r is on the C stack or the 0 pointer - in winnt our heap starts at DBEGIN - */ --#define NULL_OR_ON_C_STACK(y) \ -- (((unsigned int)(y)) == 0 || \ -- (((unsigned int)(y)) > _stacktop && ((unsigned int)(y)) < _stackbottom)) -+/* #define NULL_OR_ON_C_STACK(y) \ */ -+/* (((unsigned int)(y)) == 0 || \ */ -+/* (((unsigned int)(y)) > _stacktop && ((unsigned int)(y)) < _stackbottom)) */ -+#define NULL_OR_ON_C_STACK(x) (!(int *)x || ((int *)x>cs_limit && (int *)x<=cs_org)) - - #if defined ( IN_FILE ) || defined ( IN_SOCKETS ) - # define HAVE_NSOCKET -@@ -118,7 +119,8 @@ extern DBEGIN_TY _stacktop, _stackbottom - - #define RECREATE_HEAP if (initflag) { recreate_heap1(); \ - terminal_io->sm.sm_object1->sm.sm_fp=stdout; \ -- terminal_io->sm.sm_object0->sm.sm_fp=stdin; } -+ terminal_io->sm.sm_object0->sm.sm_fp=stdin; \ -+ init_shared_memory();} - - #define HAVE_AOUT "wincoff.h" - /* we dont need to worry about zeroing fp->_base , to prevent */ -@@ -144,8 +146,7 @@ extern DBEGIN_TY _stacktop, _stackbottom - #define I386 - - #undef SET_REAL_MAXPAGE --#define SET_REAL_MAXPAGE \ -- init_shared_memory(); real_maxpage=MAXPAGE; -+#define SET_REAL_MAXPAGE {init_shared_memory(); real_maxpage=MAXPAGE;} - - /* include some low level routines for maxima */ - #define CMAC -@@ -213,3 +214,8 @@ extern char *GCLExeName ( void ); - - /* End for cmpinclude */ - -+extern int mingwlisten(FILE *); -+#undef LISTEN_FOR_INPUT -+#define LISTEN_FOR_INPUT(fp) do {if (mingwlisten(fp)) return 0;} while (0) -+ -+#define socklen_t int ---- /dev/null -+++ gcl-2.6.7/h/386-macosx.defs -@@ -0,0 +1,35 @@ -+# powerpc-macosx.defs -+ -+# Disable Apple's custom C preprocessor which gets confused when -+# preprocessing some of the *.d files in the o/ subdirectory. -+CC = gcc $(CPPFLAGS) -+ -+# Set this to avoid warnings when linking against libncurses. -+# This is due to the requirements of the two level namespace. -+LIBS := `echo $(LIBS) | sed -e 's/-lncurses/ /'` -+ -+# Set this for the linker to operate correctly. -+MACOSX_DEPLOYMENT_TARGET = 10.2 -+ -+# Define this to build an executable rsym. -+RSYM = rsym -+ifneq ($(findstring bfd,$(LIBS)),) -+RSYM = -+endif -+ifneq ($(BUILD_BFD),) -+RSYM = -+endif -+ -+# Define this in order to compile sfasl.c. -+SFASL = $(ODIR)/sfasl.o -+ -+# When using SFASL it is good to have (si::build-symbol-table). -+# (However, I'm not sure this init form will ever get called.) -+INITFORM = (si::build-symbol-table) -+ -+# This is Apple's libtool, completely unrelated to GNU libtool. -+# Other plateforms define this to be `ar rs`. -+# This appears to be no longer necessary on Panther. -+ARRS = libtool -static -o -+ -+FINAL_CFLAGS := `echo $(FINAL_CFLAGS) | sed -e 's:-g::g'` ---- /dev/null -+++ gcl-2.6.7/h/mach32_i386_reloc.h -@@ -0,0 +1,15 @@ -+ case GENERIC_RELOC_VANILLA: -+ -+ redirect_trampoline(ri,*q,rel,sec1,io1,n1,&a); -+ if (ri->r_extern) -+ store_val(q,~0L,ri->r_pcrel ? a-rel : a); -+ else if (!ri->r_pcrel) -+ add_val(q,~0L,a); -+ -+ break; -+ -+ case GENERIC_RELOC_LOCAL_SECTDIFF: -+ case GENERIC_RELOC_SECTDIFF: -+ case GENERIC_RELOC_PAIR: -+ break; -+ ---- /dev/null -+++ gcl-2.6.7/h/elf64_i386_reloc.h -@@ -0,0 +1,12 @@ -+ case R_X86_64_32: -+ add_val(where,MASK(32),s+a); -+ break; -+ case R_X86_64_32S: -+ add_vals(where,MASK(32),s+a); -+ break; -+ case R_X86_64_64: -+ add_val(where,~0L,s+a); -+ break; -+ case R_X86_64_PC32: -+ add_val(where,MASK(32),s+a-p); -+ break; ---- /dev/null -+++ gcl-2.6.7/h/sh4-linux.h -@@ -0,0 +1,57 @@ -+#include "linux.h" -+ -+#ifdef IN_GBC -+/* #undef MPROTECT_ACTION_FLAGS */ -+/* #define MPROTECT_ACTION_FLAGS SA_RESTART|SA_SIGINFO */ -+/* #define GET_FAULT_ADDR(sig,code,sv,a) \ */ -+/* ((siginfo_t *)code)->si_addr */ -+/* the following two files have changed back -+ and forth in recent versions of linux... -+ Include both if they both exist, otherwise -+ include whatever one exists... -+ basically one wants the -+ struct sigcontext_struct { ... } ; -+ so as to get the fault address. -+ */ -+ -+#if !defined(SIGNAL_H_HAS_SIGCONTEXT) && !defined(HAVE_SIGCONTEXT) -+#error Need sigcontext on 386 linux -+#else -+#include -+#ifndef SIGNAL_H_HAS_SIGCONTEXT -+#ifdef HAVE_ASM_SIGCONTEXT_H -+#include -+#endif -+#ifdef HAVE_ASM_SIGNAL_H -+#include -+#endif -+#endif -+#endif -+ -+#undef MPROTECT_ACTION_FLAGS -+#define MPROTECT_ACTION_FLAGS SA_RESTART|SA_SIGINFO -+#define GET_FAULT_ADDR(sig,code,sv,a) ((siginfo_t *)code)->si_addr -+/* #define GET_FAULT_ADDR(sig,code,sv,a) ((void *)(((struct sigcontext *)(&code))->cr2)) */ -+#endif -+ -+/*#define NULL_OR_ON_C_STACK(x) ((x)==0 || ((unsigned int)x) > (unsigned int)(pagetochar(MAXPAGE+1)))*/ -+ -+#define ADDITIONAL_FEATURES \ -+ ADD_FEATURE("SH4"); \ -+ ADD_FEATURE("") -+ -+ -+#define SH4 -+#define SGC -+ -+ -+#ifdef IN_SFASL -+#include -+#define CLEAR_CACHE {\ -+ void *p,*pe; \ -+ p=(void *)((unsigned long)memory->cfd.cfd_start & ~(PAGESIZE-1)); \ -+ pe=(void *)((unsigned long)(memory->cfd.cfd_start+memory->cfd.cfd_size) & ~(PAGESIZE-1)) + PAGESIZE-1; \ -+ for (;p -+int cacheflush(void *,int,int); -+#define CLEAR_CACHE_LINE_SIZE 32 -+#define CLEAR_CACHE do {void *v=memory->cfd.cfd_start,*ve=v+memory->cfd.cfd_size; \ -+ v=(void *)((unsigned long)v & ~(CLEAR_CACHE_LINE_SIZE - 1));\ -+ cacheflush(v,ve-v,BCACHE);\ -+ } while(0) - --/*#define NULL_OR_ON_C_STACK(x) ((x)==0 || ((unsigned int)x) > (unsigned int)(pagetochar(MAXPAGE+1)))*/ -- --/* #define ADDITIONAL_FEATURES \ */ --/* ADD_FEATURE("BSD386"); \ */ --/* ADD_FEATURE("MC68020") */ -- -- --/* #define I386 */ --/* #define SGC */ -- --/* #define CLEAR_CACHE do {void *v=memory->cfd.cfd_start,*ve=v+memory->cfd.cfd_size; for (;vsi_addr - #endif --#define SGC -+ -+/* Reenable when recent mips kernel bug fixed -- SIGBUS passed on -+ occasion instead of SIGSEGV with no address passed in siginfo_t*/ -+/* kernel bug now fixed, but likely not everywhere. Add additional -+ memprotect test in sgbc.c to ensure we have a working kernel */ -+#define SGC -+ -+#if SIZEOF_LONG==4 -+#define RELOC_H "elf32_mips_reloc.h" -+#define SPECIAL_RELOC_H "elf32_mips_reloc_special.h" -+#else -+#define RELOC_H "elf64_mips_reloc.h" -+#define SPECIAL_RELOC_H "elf64_mips_reloc_special.h" -+#endif -+ -+/*Remove when .MIPS.stubs are replaced with callable .plt entries*/ -+#define LD_BIND_NOW ---- gcl-2.6.7.orig/h/gmp_wrappers.h -+++ gcl-2.6.7/h/gmp_wrappers.h -@@ -6,7 +6,7 @@ - #endif - - GMP_EXTERN jmp_buf gmp_jmp; --GMP_EXTERN int jmp_gmp; -+GMP_EXTERN int jmp_gmp,gmp_relocatable; - - #define join(a_,b_) a_ ## b_ - #define Join(a_,b_) join(a_,b_) -@@ -98,13 +98,17 @@ GMP_EXTERN int jmp_gmp; - GMP_EXTERN_INLINE Join(RF_,rt_) Join(m,a_)(Join(P,n_)(b_)) { \ - int j;\ - Join(RD_,rt_);\ -- jmp_gmp=0;\ -- if ((j=setjmp(gmp_jmp)))\ -- GBC(j);\ -- if (Join(Join(E,n_),s_)) jmp_gmp=-1 ; else jmp_gmp++;\ -+ if (gmp_relocatable) {\ -+ jmp_gmp=0;\ -+ if ((j=setjmp(gmp_jmp))) \ -+ GBC(j);\ -+ if (Join(Join(E,n_),s_)) jmp_gmp=-1 ; else jmp_gmp++;\ -+ }\ - Join(RA_,rt_) a_(Join(A,n_));\ -- if (jmp_gmp<-1) GBC(-jmp_gmp);\ -- jmp_gmp=0;\ -+ if (gmp_relocatable) {\ -+ if (jmp_gmp<-1) GBC(-jmp_gmp);\ -+ jmp_gmp=0;\ -+ }\ - return Join(RR_,rt_);\ - } - ---- /dev/null -+++ gcl-2.6.7/h/elf32_mips_reloc_special.h -@@ -0,0 +1,107 @@ -+static ul gpd,ggot,ggote; static Rel *hr; -+ -+static int -+write_stub(ul s,ul *got,ul *gote) { -+ -+ *gote=(ul)(gote+2); -+ *++gote=s; -+ s=((void *)gote-(void *)got); -+ *++gote=(0x23<<26)|(0x1c<<21)|(0x19<<16)|s; -+ *++gote=(0x23<<26)|(0x19<<21)|(0x19<<16)|0; -+ *++gote=0x03200008; -+ *++gote=0x00200825; -+ -+ return 0; -+ -+} -+ -+static int -+make_got_room_for_stub(Shdr *sec1,Shdr *sece,Sym *sym,const char *st1,ul *gs) { -+ -+ Shdr *ssec=sec1+sym->st_shndx; -+ struct node *a; -+ if ((ssec>=sece || !ALLOC_SEC(ssec)) && -+ (a=find_sym_ptable(st1+sym->st_name)) && -+ a->address>=ggot && a->addresssh_addr,pe=p+sec->sh_size;psh_entsize) { -+ q=p; -+ if (q[0]==DT_MIPS_GOTSYM) -+ gotsym=q[1]; -+ if (q[0]==DT_MIPS_LOCAL_GOTNO) -+ locgotno=q[1]; -+ -+ } -+ massert(gotsym && locgotno); -+ -+ massert(sec=get_section(".MIPS.stubs",sec1,sece,sn)); -+ stub=sec->sh_addr; -+ stube=sec->sh_addr+sec->sh_size; -+ -+ massert(sec=get_section(".got",sec1,sece,sn)); -+ ggot=sec->sh_addr+locgotno*sec->sh_entsize; -+ ggote=sec->sh_addr+sec->sh_size; -+ -+ for (ds1+=gotsym,sym=ds1;symst_value || (sym->st_value>=stub && sym->st_valuest_value=ggot+(sym-ds1)*sec->sh_entsize; -+ -+ return 0; -+ -+} -+ -+static int -+label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,ul *gs) { -+ -+ Rel *r; -+ Sym *sym; -+ Shdr *sec; -+ void *v,*ve; -+ ul q; -+ -+ for (q=0,sym=sym1;symst_name,"_gp_disp")) { -+ sym->st_other=1; -+ q++; -+ } else if (!strcmp(st1+sym->st_name,"__gnu_local_gp")) { -+ sym->st_other=2; -+ q++; -+ } -+ massert(q<=1); -+ -+ for (sym=sym1;symst_size=0; -+ -+ for (*gs=0,sec=sec1;secsh_type==SHT_REL) -+ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) -+ -+ if (ELF_R_TYPE(r->r_info)==R_MIPS_CALL16|| -+ ELF_R_TYPE(r->r_info)==R_MIPS_GOT16) { -+ -+ sym=sym1+ELF_R_SYM(r->r_info); -+ -+ if (!sym->st_size) { -+ sym->st_size=++*gs; -+ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); -+ } -+ -+ } -+ -+ return 0; -+ -+} ---- /dev/null -+++ gcl-2.6.7/h/mach32_ppc_reloc.h -@@ -0,0 +1,29 @@ -+#include -+ -+ case PPC_RELOC_VANILLA: -+ -+ add_val(q,~0L,ri->r_pcrel ? a-rel : a); -+ -+ break; -+ -+ case PPC_RELOC_JBSR: -+ -+ redirect_trampoline(ri,sec1->addr+ri[1].r_address,rel,sec1,io1,n1,&a); -+ if (!ri->r_extern) -+ return 0; -+ -+ if (ovchk(a,~MASK(26))) -+ store_val(q,MASK(26),a|0x3); -+ else if (ovchk(a-(ul)q,~MASK(26))) -+ store_val(q,MASK(26),(a-(ul)q)|0x1); -+ -+ break; -+ -+ case PPC_RELOC_SECTDIFF: -+ case PPC_RELOC_HI16_SECTDIFF: -+ case PPC_RELOC_LO16_SECTDIFF: -+ case PPC_RELOC_HA16_SECTDIFF: -+ case PPC_RELOC_LO14_SECTDIFF: -+ case PPC_RELOC_LOCAL_SECTDIFF: -+ case PPC_RELOC_PAIR: -+ break; ---- gcl-2.6.7.orig/gcl-tk/tkMain.c -+++ gcl-2.6.7/gcl-tk/tkMain.c -@@ -495,8 +495,8 @@ StdinProc(clientData, mask) - if (msg->type == m_tcl_command_wait_response - || code) - { -- unsigned char buf[4]; -- unsigned char *p = buf; -+ char buf[4]; -+ char *p = buf; - /*header */ - *p++ = (code ? '1' : '0'); - bcopy(msg->msg_id,p,3); ---- gcl-2.6.7.orig/gcl-tk/makefile -+++ gcl-2.6.7/gcl-tk/makefile -@@ -44,7 +44,7 @@ clean:: - # for some reason -lieee is on various linux systems in the list of requireds.. - - gcltkaux: $(GUIOS) -- $(LD_ORDINARY_CC) $(GUIOS) -o gcltkaux ${TK_LIB_SPEC} ${TK_BUILD_LIB_SPEC} ${TK_XLIBSW} ${TK_XINCLUDES} ${TCL_LIB_SPEC} `echo ${TCL_LIBS} | sed -e s:-lieee::g` ${LIBS} ${GCLIB} -+ $(LD_ORDINARY_CC) $(GUIOS) $(LDFLAGS) -o gcltkaux ${TK_LIB_SPEC} ${TK_BUILD_LIB_SPEC} ${TK_XLIBSW} ${TK_XINCLUDES} ${TCL_LIB_SPEC} `echo ${TCL_LIBS} | sed -e s:-lieee::g` ${LIBS} ${GCLIB} - - gcltksrv: makefile - cat gcltksrv.in | sed -e "s!TK_LIBRARY=.*!TK_LIBRARY=${TK_LIBRARY}!g" \ ---- gcl-2.6.7.orig/gcl-tk/guis.c -+++ gcl-2.6.7/gcl-tk/guis.c -@@ -84,11 +84,11 @@ extern char *inet_ntoa ( struct in_addr - FILE *pstreamDebug; - int fDebugSockets; - --#ifdef PLATFORM_SUNOS --static void notice_input( ); --#else --static void notice_input(); --#endif -+/* #ifdef PLATFORM_SUNOS */ -+/* static void notice_input( ); */ -+/* #else */ -+/* static void notice_input(); */ -+/* #endif */ - - int hdl = -1; - -@@ -285,7 +285,7 @@ char *envp[]; - #define SET_SESSION_ID() setsid() - #else - #ifdef BSD --#define SET_SESSION_ID() (setpgrp(0,0) ? -1 : 0) -+#define SET_SESSION_ID() (setpgrp() ? -1 : 0) - #endif - #endif - #endif -@@ -369,19 +369,19 @@ struct connection_state *sfd; - } - - --#ifdef PLATFORM_SUNOS --static void --notice_input( int sig, int code, struct sigcontext *s, char *a ) --#else --static void --notice_input( sig ) -- int sig; --#endif --{ -- signal( SIGIO, notice_input ); -- dfprintf(stderr, "\nNoticed input!\n" ); -+/* #ifdef PLATFORM_SUNOS */ -+/* static void */ -+/* notice_input( int sig, int code, struct sigcontext *s, char *a ) */ -+/* #else */ -+/* static void */ -+/* notice_input( sig ) */ -+/* int sig; */ -+/* #endif */ -+/* { */ -+/* signal( SIGIO, notice_input ); */ -+/* dfprintf(stderr, "\nNoticed input!\n" ); */ - --} -+/* } */ - - static int message_id; - ---- gcl-2.6.7.orig/o/fasldlsym.c -+++ gcl-2.6.7/o/fasldlsym.c -@@ -34,163 +34,87 @@ Foundation, 675 Mass Ave, Cambridge, MA - #include - #endif - --#include "ptable.h" -- --/* cc -DVOL=volatile -G 0 -c foo.c ; ld -shared foo.o -o jim.o ; cat foo.data >> jim.o */ --int did_a_dynamic_load; -- --struct name_list --{ struct name_list *next; -+struct name_list { -+ struct name_list *next; - char name[1]; --} ; -+}; - static struct name_list *loaded_files; - --/* void */ --/* get_init_name(faslfile,init_fun) */ --/* object faslfile; */ --/* char *init_fun; */ --/* { */ --/* object path = coerce_to_pathname(faslfile); */ --/* char *p; */ --/* strcpy(init_fun,"init_"); */ --/* coerce_to_filename(path->pn.pn_name,init_fun+5); */ --/* p = init_fun +5; */ --/* while(*p) */ --/* {if (*p == '-') *p = '_'; */ --/* p++;} */ --/* } */ -- --static void * --get_init_fptr(void *dlp,char *fn) { -+int -+fasload(object faslfile) { - -- static object inf; -- struct string st; -+ void *dlp ; -+ int (*fptr)(); -+ char buf[MAXPATHLEN],b[MAXPATHLEN],filename[MAXPATHLEN]; -+ static int count; -+ object memory,data,faslstream; -+ struct name_list *nl; - object x; -- char ib[MAXPATHLEN+1]; -- void *v; -- -- if (!inf) { -- -- object x; -- struct string st; -- st.t=t_string; -- st.st_self="COMPILER"; -- st.st_dim=st.st_fillp=strlen(st.st_self); -- if ((x=find_package((object)&st))==Cnil) -- FEerror("Cannot find compiler package", 0); -- st.st_self="INIT-NAME"; -- st.st_dim=st.st_fillp=strlen(st.st_self); -- if ((inf=find_symbol((object)&st,x))==Cnil) { -- inf=NULL; -- FEerror("Cannot find function COMPILER::INIT-NAME", 0); -- } -- -- } -- -- st.t=t_string; -- st.st_self=fn; -- st.st_dim=st.st_fillp=strlen(st.st_self); -- x=ifuncall1(inf,(object)&st); -- if (x->d.t!=t_string) -- FEerror("INIT-NAME error", 0); -- assert(snprintf(ib,sizeof(ib),"init_%-.*s",x->st.st_dim,x->st.st_self)>0); -- -- if (!(v=dlsym(dlp, ib))) { -- x=ifuncall2(inf,(object)&st,Ct); -- if (x->d.t!=t_string) -- FEerror("INIT-NAME error", 0); -- assert(snprintf(ib,sizeof(ib),"init_%-.*s",x->st.st_dim,x->st.st_self)>0); -- if (!(v=dlsym(dlp, ib))) -- FEerror("Cannot lookup init-name ~a",1,make_simple_string(ib)); -- } -- -- return v; - --} -+ bzero(buf,sizeof(buf)); /*GC partial stack hole closing*/ -+ bzero(b,sizeof(b)); -+ bzero(filename,sizeof(filename)); - --int --fasload(faslfile) -- object faslfile; --{ void *dlp ; -- int (*fptr)(); -- char buf[200]; -- static int count=0; -- object memory; -- object data; -- char filename[MAXPATHLEN]; -- object faslstream; -- coerce_to_filename(truename(faslfile), filename); -- if (count == 0) -- count = time(0); -- snprintf(buf,sizeof(buf),"/tmp/ufas%dxXXXXXX",count++); - /* this is just to allow reloading in the same file twice. - */ -- mkstemp(buf); -- symlink(filename,buf); -- { struct name_list *nl= -- (void *) malloc(strlen(buf)+sizeof(struct name_list)); -- nl->next = loaded_files; -- loaded_files = nl; -- strcpy(nl->name,buf); -- } -+ coerce_to_filename(truename(faslfile), filename); -+ if (!count) -+ count=time(0); -+ massert(snprintf(buf,sizeof(buf),"/tmp/ufas%dxXXXXXX",count++)>0); -+ massert(mkstemp(buf)>=0); -+ -+ massert((nl=(void *) malloc(strlen(buf)+1+sizeof(nl)))); -+ nl->next = loaded_files; -+ loaded_files = nl; -+ strcpy(nl->name,buf); -+ - faslstream = open_stream(faslfile, smm_input, Cnil, sKerror); --/* #define MAKE_SHARED_LIB */ --#undef MAKE_SHARED_LIB --#ifdef MAKE_SHARED_LIB -- { struct filehdr fhdr; -- fread(&fhdr,1,sizeof(fhdr),faslstream->sm.sm_fp); -- fseek(faslstream->sm.sm_fp,0,0); -- if (IS_NOT_SHARED_OBJECT(fhdr,faslstream)) -- { char com[600]; -- unlink(buf); -- LD_SHARED(filename,buf); -- system(com); -- } -- } --#endif -- { -- char com[600]; -- snprintf(com,sizeof(com),"cc -shared %s -o %s",filename,buf); -- system(com); -- } -+ massert(snprintf(b,sizeof(b),"cc -shared %s -o %s",filename,buf)>0); -+ massert(!system(b)); - -- dlp = dlopen(buf,RTLD_NOW); -- if (dlp ==0) { -+ if (!(dlp = dlopen(buf,RTLD_NOW))) { - fputs(dlerror(),stderr); -- FEerror("Cant open for dynamic link ~a",1,make_simple_string(faslfile)); -+ FEerror("Cannot open for dynamic link ~a",1,make_simple_string(faslfile)); - } - -- fptr=get_init_fptr(dlp,filename); --/* fptr = (int (*)())dlsym(dlp, "init_code"); */ --/* if (fptr == 0) */ --/* { /\* maybe system-p compiled so init_filename *\/ */ --/* char init_fun[200]; */ --/* get_init_name(faslfile,init_fun); */ --/* fptr = (int (*)())dlsym(dlp, init_fun); */ --/* if (fptr == 0) */ --/* FEerror("Cant find init_code in ~a",1,make_simple_string(faslfile));} */ -- -+ -+ x=find_init_name1(buf,0); -+ massert(x->st.st_fillp+1st.st_self,x->st.st_fillp); -+ b[x->st.st_fillp]=0; -+ if (!(fptr=dlsym(dlp,b))) { -+ fputs(dlerror(),stderr); -+ FEerror("Cannot lookup ~a in ~a",2,make_simple_string(b),make_simple_string(faslfile)); -+ } -+ - SEEK_TO_END_OFILE(faslstream->sm.sm_fp); -+ - data = read_fasl_vector(faslstream); - memory = alloc_object(t_cfdata); - memory->cfd.cfd_self = NULL; - memory->cfd.cfd_start = NULL; - memory->cfd.cfd_size = 0; -+ - if(symbol_value(sLAload_verboseA)!=Cnil) - printf(" start address (dynamic) %p ",fptr); -+ - call_init(0,memory,data,fptr); -+ - unlink(buf); - close_stream(faslstream); -- did_a_dynamic_load = 1; -+ - return memory->cfd.cfd_size; -+ - } - - void --unlink_loaded_files(void) --{ while(loaded_files) -- { unlink(loaded_files->name); -- loaded_files= loaded_files->next; -- } -+unlink_loaded_files(void) { -+ -+ while(loaded_files) { -+ unlink(loaded_files->name); -+ loaded_files= loaded_files->next; -+ } -+ - } - - #include "sfasli.c" ---- gcl-2.6.7.orig/o/sgbc.c -+++ gcl-2.6.7/o/sgbc.c -@@ -226,8 +226,10 @@ sgc_mark_object1(object x) { - if (x->ht.ht_self == NULL) - break; - for (i = 0, j = x->ht.ht_size; i < j; i++) { -- sgc_mark_object(x->ht.ht_self[i].hte_key); -- sgc_mark_object(x->ht.ht_self[i].hte_value); -+ if (ON_WRITABLE_PAGE(&x->ht.ht_self[i])) { -+ sgc_mark_object(x->ht.ht_self[i].hte_key); -+ sgc_mark_object(x->ht.ht_self[i].hte_value); -+ } - } - if ((short)what_to_collect >= (short)t_contiguous) { - if (inheap(x->ht.ht_self)) { -@@ -435,12 +437,10 @@ sgc_mark_object1(object x) { - break; - { - object def=x->str.str_def; -- unsigned char * s_type = &SLOT_TYPE(def,0); -- unsigned short *s_pos= & SLOT_POS(def,0); -+ unsigned char *s_type = &SLOT_TYPE(def,0); -+ unsigned short *s_pos = &SLOT_POS (def,0); - for (i = 0, j = S_DATA(def)->length; i < j; i++) -- if (s_type[i]==0 && -- ON_WRITABLE_PAGE(& STREF(object,x,s_pos[i])) -- ) -+ if (s_type[i]==0 && ON_WRITABLE_PAGE(&STREF(object,x,s_pos[i]))) - sgc_mark_object(STREF(object,x,s_pos[i])); - if ((int)what_to_collect >= (int)t_contiguous) { - if (inheap(x->str.str_self)) { -@@ -845,6 +845,15 @@ sgc_sweep_phase(void) { - mpz_clear(MP(x)); - #endif - -+ if (sLAlink_arrayA->s.s_dbind!=Cnil) -+ if (x->d.t == t_cfdata) { -+ unsigned long *p=(void *)sLAlink_arrayA->s.s_dbind->st.st_self; -+ unsigned long *pe=(void *)p+sLAlink_arrayA->s.s_dbind->st.st_fillp; -+ for (;p=(unsigned long)x->cfd.cfd_start && *p<(unsigned long)x->cfd.cfd_start+x->cfd.cfd_size) -+ *p=0; -+ } -+ - SET_LINK(x,f); - x->d.m = FREE; - x->d.s = (int)SGC_RECENT; -@@ -1106,14 +1115,15 @@ memprotect_handler_test(int sig, long co - memprotect_result=memprotect_bad_fault_address; - else - memprotect_result=memprotect_none; -- mprotect(memprotect_test_address,PAGESIZE,PROT_READ_WRITE_EXEC); -+ mprotect(memprotect_test_address,page_multiple*PAGESIZE,PROT_READ_WRITE_EXEC); - - } - - static int - memprotect_test(void) { - -- char b1[2*PAGESIZE],b2[PAGESIZE]; -+ char *b1,*b2; -+ unsigned long p=PAGESIZE*page_multiple; - struct sigaction sa,sao,saob; - - if (memprotect_result!=memprotect_none) -@@ -1123,13 +1133,19 @@ memprotect_test(void) { - exit(-1); - } - -- memset(b1,32,sizeof(b1)); -- memset(b2,0,sizeof(b2)); -- memprotect_test_address=(void *)(((unsigned long)b1+PAGESIZE-1) & ~(PAGESIZE-1)); -- if (mprotect(memprotect_test_address,PAGESIZE,PROT_READ_EXEC)) { -+ if (!(b1=alloca(2*p))) { - memprotect_result=memprotect_cannot_protect; - return -1; - } -+ -+ if (!(b2=alloca(p))) { -+ memprotect_result=memprotect_cannot_protect; -+ return -1; -+ } -+ -+ memset(b1,32,2*p); -+ memset(b2,0,p); -+ memprotect_test_address=(void *)(((unsigned long)b1+p-1) & ~(p-1)); - sa.sa_sigaction=(void *)memprotect_handler_test; - sa.sa_flags=MPROTECT_ACTION_FLAGS; - if (sigaction(SIGSEGV,&sa,&sao)) { -@@ -1141,8 +1157,31 @@ memprotect_test(void) { - memprotect_result=memprotect_sigaction; - return -1; - } -+ { /* mips kernel bug test -- SIGBUS with no faddr when floating point is emulated. */ -+ float *f1=(void *)memprotect_test_address,*f2=(void *)b2; -+ -+ if (mprotect(memprotect_test_address,p,PROT_READ_EXEC)) { -+ memprotect_result=memprotect_cannot_protect; -+ return -1; -+ } -+ memprotect_result=memprotect_bad_return; -+ *f1=*f2; -+ if (memprotect_result==memprotect_bad_return) -+ memprotect_result=memprotect_no_signal; -+ if (memprotect_result!=memprotect_none) { -+ sigaction(SIGSEGV,&sao,NULL); -+ sigaction(SIGBUS,&saob,NULL); -+ return -1; -+ } -+ memprotect_handler_invocations=0; -+ -+ } -+ if (mprotect(memprotect_test_address,p,PROT_READ_EXEC)) { -+ memprotect_result=memprotect_cannot_protect; -+ return -1; -+ } - memprotect_result=memprotect_bad_return; -- memset(memprotect_test_address,0,PAGESIZE); -+ memset(memprotect_test_address,0,p); - if (memprotect_result==memprotect_bad_return) - memprotect_result=memprotect_no_signal; - if (memprotect_result!=memprotect_none) { -@@ -1150,7 +1189,7 @@ memprotect_test(void) { - sigaction(SIGBUS,&saob,NULL); - return -1; - } -- if (memcmp(memprotect_test_address,b2,PAGESIZE)) { -+ if (memcmp(memprotect_test_address,b2,p)) { - memprotect_result=memprotect_no_restart; - sigaction(SIGSEGV,&sao,NULL); - sigaction(SIGBUS,&saob,NULL); -@@ -1380,7 +1419,7 @@ sgc_start(void) { - if (i>=MAXPAGE || k>MAXPAGE) - error("Pages out of range in sgc_start"); - for (;i=MAXPAGE || i>MAXPAGE) - error("Pages out of range in sgc_start"); - for (;j= 0 ) -+ while (j--) - (*p++) |= SGC_WRITABLE; - } - } -@@ -1720,25 +1764,26 @@ memory_protect(int on) { - unsigned long i,beg,end= page(core_end); - int writable=1; - extern void install_segmentation_catcher(void); -+ static unsigned long first_data_page; - -- if (first_protectable_page==0) { -- for (i=page_multiple; i< maxpage ; i++) -- if (type_map[i]!=t_other) -- break; -- else { -- /* We want page(0) to be non writable since that -- is the only check for 0 pointer in sgc */ -- sgc_type_map[i] = SGC_PERM_WRITABLE; -- } -- first_protectable_page= ROUND_DOWN_PAGE_NO(i); -+ if (!first_data_page) { -+ for (i=1;i 1) - fix_for_page_multiple(first_protectable_page,end); - /* turning it off */ -- if (on==0) {sgc_mprotect((first_protectable_page), -- (end - first_protectable_page), SGC_WRITABLE); -- install_segmentation_catcher(); -- return; -+ if (on==0) { -+ sgc_mprotect(first_protectable_page,end-first_protectable_page,SGC_WRITABLE); -+ install_segmentation_catcher(); -+ return; - } - /* write protect some pages by first write protecting them - all and then selectively disabling */ ---- gcl-2.6.7.orig/o/alloc.c -+++ gcl-2.6.7/o/alloc.c -@@ -225,7 +225,7 @@ call_after_gbc_hook(t) - #define PERCENT_FREE(tm) ((tm->tm_percent_free ? tm->tm_percent_free : 30)/100.0) - - static int --grow_linear(int old, int fract, int grow_min, int grow_max) { -+grow_linear(int old, int fract, int grow_min, int grow_max,int max_delt) { - - int delt; - if (fract==0) -@@ -241,6 +241,9 @@ grow_linear(int old, int fract, int grow - delt > grow_max ? grow_max: - delt); - -+ /* if (delt>max_delt) */ -+ /* fprintf(stderr,"Grow_linear: %d %d\n", delt, max_delt); */ -+ delt=delt>max_delt ? max_delt : delt; - return old + delt; - - } -@@ -380,7 +383,7 @@ CALL_GBC: - int j; - - tm->tm_maxpage=grow_linear((j=tm->tm_maxpage),tm->tm_growth_percent, -- tm->tm_min_grow,tm->tm_max_grow); -+ tm->tm_min_grow,tm->tm_max_grow,available_pages); - tm->tm_adjgbccnt*=(double)j/tm->tm_maxpage; - } - } -@@ -408,7 +411,7 @@ make_cons(object a, object d) - { - object obj; - char *p; -- struct typemanager *tm=(&tm_table[(int)t_cons]); -+ struct typemanager *tm=tm_of(t_cons); - int must_have_more_pages; - - ONCE_MORE: -@@ -449,7 +452,7 @@ CALL_GBC: - int j; - - tm->tm_maxpage=grow_linear((j=tm->tm_maxpage),tm->tm_growth_percent, -- tm->tm_min_grow,tm->tm_max_grow); -+ tm->tm_min_grow,tm->tm_max_grow,available_pages); - tm->tm_adjgbccnt*=(double)j/tm->tm_maxpage; - } - } -@@ -581,7 +584,7 @@ ONCE_MORE: - struct typemanager *tm = &tm_table[(int)t_contiguous]; - if ((!OPTIMIZE_MAX_PAGES || !opt_maxpage(tm)) && g) { - maxcbpage=grow_linear(maxcbpage,tm->tm_growth_percent, -- tm->tm_min_grow, tm->tm_max_grow); -+ tm->tm_min_grow, tm->tm_max_grow,available_pages); - tm->tm_adjgbccnt*=(double)j/maxcbpage; - } - } -@@ -611,8 +614,14 @@ Use ALLOCATE-CONTIGUOUS-PAGES to expand - swept when SGC was on. Here we follow the behavior - for other pages in add_to_freelist. CM 20030827 */ - #ifdef SGC -+ -+ if (sgc_enabled) -+ if (!WRITABLE_PAGE_P(page(p)+i)) -+ make_writable(page(p)+i,page(p)+i+1); -+ - if (SGC_CONT_ENABLED) -- sgc_type_map[page(p)+i]|= SGC_PAGE_FLAG; -+ sgc_type_map[page(p)+i]|= (SGC_PAGE_FLAG|SGC_TEMP_WRITABLE); -+ - #endif - } - ncbpage += m; -@@ -734,7 +743,7 @@ ONCE_MORE: - struct typemanager *tm = &tm_table[(int)t_relocatable]; - if ((!OPTIMIZE_MAX_PAGES || !opt_maxpage(tm)) && (g || must_have_more_pages)) { - nrbpage=grow_linear(nrbpage,tm->tm_growth_percent, -- tm->tm_min_grow, tm->tm_max_grow); -+ tm->tm_min_grow, tm->tm_max_grow,available_pages/2); - tm->tm_adjgbccnt*=(double)i/nrbpage; - } - if (available_pages < 0) { -@@ -840,13 +849,13 @@ set_maxpage(void) { - maxpage are here */ - #ifdef SGC - page_multiple=getpagesize()/PAGESIZE; -- if (page_multiple==0) error("PAGESIZE must be factor of getpagesize()"); -+ if (page_multiple==0) page_multiple=1;/* error("PAGESIZE must be factor of getpagesize()"); */ - if (gcl_alloc_initialized) { - extern long maxpage; - maxpage=page(heap_end); - memory_protect(sgc_enabled ? 1 : 0); - } -- if (~(-MAXPAGE) != MAXPAGE-1) error("MAXPAGE must be power of 2"); -+/* if (~(-MAXPAGE) != MAXPAGE-1) error("MAXPAGE must be power of 2"); */ - /* FIXME ensure core_end in range for type_map reference below. CM */ - if (core_end) - bzero(&sgc_type_map[ page(core_end)],MAXPAGE- page(core_end)); -@@ -858,14 +867,30 @@ set_maxpage(void) { - - } - -+#ifdef GCL_GPROF -+static unsigned long textstart,textend,textpage; -+static void init_textpage() { -+ -+ extern void *GCL_GPROF_START; -+ unsigned long s=(unsigned long)GCL_GPROF_START; -+ -+ textstart=(unsigned long)&GCL_GPROF_START; -+ textend=(unsigned long)&etext; -+ if (stextend || s>textstart)) -+ textstart=s; -+ -+ textpage=2*(textend-textstart)/PAGESIZE; -+ -+} -+#endif - - void - gcl_init_alloc(void) { - - long i; -+ - #ifdef GCL_GPROF -- extern void *GCL_GPROF_START; -- unsigned textpage=2*((void *)&etext-(void *)&GCL_GPROF_START)/PAGESIZE; -+ init_textpage(); - #endif - - if (gcl_alloc_initialized) return; -@@ -1116,7 +1141,7 @@ DEFUN_NEW("ALLOCATE-CONTIGUOUS-PAGES",ob - for other pages in add_to_freelist. CM 20030827 */ - #ifdef SGC - if (SGC_CONT_ENABLED) -- sgc_type_map[page(p)+i]|= SGC_PAGE_FLAG; -+ sgc_type_map[page(p)+i]|= (SGC_PAGE_FLAG|SGC_TEMP_WRITABLE); - #endif - } - -@@ -1261,7 +1286,7 @@ gprof_cleanup(void) { - - char b[PATH_MAX],b1[PATH_MAX]; - -- if (!getwd(b)) -+ if (!getcwd(b,sizeof(b))) - FEerror("Cannot get working directory", 0); - if (chdir(P_tmpdir)) - FEerror("Cannot change directory to tmpdir", 0); -@@ -1288,7 +1313,7 @@ DEFUN_NEW("GPROF-START",object,fSgprof_s - static int n; - - if (!gprof_on) { -- start=start ? start : (unsigned long)&GCL_GPROF_START; -+ start=start ? start : textstart; - end=end ? end : (unsigned long)core_end; - monstartup(start,end); - gprof_on=1; -@@ -1324,7 +1349,7 @@ DEFUN_NEW("GPROF-QUIT",object,fSgprof_qu - if (!gprof_on) - return Cnil; - -- if (!getwd(b)) -+ if (!getcwd(b,sizeof(b))) - FEerror("Cannot get working directory", 0); - if (chdir(P_tmpdir)) - FEerror("Cannot change directory to tmpdir", 0); -@@ -1468,73 +1493,54 @@ static char *baby_malloc(n) - - void * - malloc(size_t size) { -- static int in_malloc; - -- if (in_malloc) -- return NULL; -- in_malloc=1; -+ static int in_malloc; - --/* #ifdef HAVE_LIBBFD */ --/* if (in_bfd_init) */ --/* return bfd_malloc(size); */ --/* #endif */ -+ if (in_malloc) -+ return NULL; -+ in_malloc=1; -+ -+ if (!GBC_enable) { - - #ifdef BABY_MALLOC_SIZE -- if (GBC_enable == 0) { -- in_malloc = 0; -- return baby_malloc(size); -- } -+ in_malloc=0; -+ return baby_malloc(size); - #else -- if (GBC_enable==0) { -- if ( initflag ==0) -- gcl_init_alloc(); -- else { --#ifdef RECREATE_HEAP -- RECREATE_HEAP --#endif -- ; --#ifdef __MINGW32__ -- /* If malloc() gets called by the C runtime before -- * main starts and the shared memory is not yet -- * initialised causing boofo. -- * SET_REAL_MAXPAGE calls init_shared_memory(). -- * This problem arose with gcc 3.4.2 and new libs. -- */ -- SET_REAL_MAXPAGE -- ; --#endif -- } -- } -+ -+ if (!initflag) -+ gcl_init_alloc(); -+#ifdef RECREATE_HEAP -+ else RECREATE_HEAP -+#endif - - #endif -- -- malloc_list = make_cons(Cnil, malloc_list); - -- malloc_list->c.c_car = alloc_simple_string(size); -+ } - -- malloc_list->c.c_car->st.st_self = alloc_contblock(size); -+ CHECK_INTERRUPT; - -- /* FIXME: this is just to handle clean freeing of the -- monstartup memory allocated automatically on raw image -- startup. In saved images, monstartup memory is only -- allocated with gprof-start. 20040804 CM*/ -+ malloc_list = make_cons(Cnil, malloc_list); -+ -+ malloc_list->c.c_car = alloc_simple_string(size); -+ -+ malloc_list->c.c_car->st.st_self = alloc_contblock(size); -+ -+ /* FIXME: this is just to handle clean freeing of the -+ monstartup memory allocated automatically on raw image -+ startup. In saved images, monstartup memory is only -+ allocated with gprof-start. 20040804 CM*/ - #ifdef GCL_GPROF -- { -- extern void *GCL_GPROF_START; -- -- if (!initflag && size > ((void *)&etext-(void *)&GCL_GPROF_START) -- && !initial_monstartup_pointer) -- initial_monstartup_pointer=malloc_list->c.c_car->st.st_self; -- -- } -+ if (!initflag && size>(textend-textstart) && !initial_monstartup_pointer) -+ initial_monstartup_pointer=malloc_list->c.c_car->st.st_self; - #endif -- -+ - #ifdef SGC -- perm_writable(malloc_list->c.c_car->st.st_self,size); -+ perm_writable(malloc_list->c.c_car->st.st_self,size); - #endif -+ -+ in_malloc=0; -+ return(malloc_list->c.c_car->st.st_self); - -- in_malloc=0; -- return(malloc_list->c.c_car->st.st_self); - } - - -@@ -1578,8 +1584,12 @@ free(void *ptr) - #ifdef NOFREE_ERR - return ; - #else -- if (raw_image==FALSE || core_end-heap_endst.st_self; - } --#ifdef WANT_VALLOC - void * - valloc(size_t size) - { return memalign(getpagesize(),size);} ---- gcl-2.6.7.orig/o/prog.c -+++ gcl-2.6.7/o/prog.c -@@ -48,12 +48,12 @@ FFD(Ftagbody)(object body) - { - - object *old_top = vs_top; -- object *new_top; -- VOL object *tinf; -- VOL object *tinf_base; -+ object * VOL new_top; -+ object *tinf; -+ object * VOL tinf_base; - object *env = lex_env; - object id = alloc_frame_id(); -- object bodysv = body; -+ VOL object bodysv = body; - object label; - enum type item_type; - ---- gcl-2.6.7.orig/o/plttest.c -+++ gcl-2.6.7/o/plttest.c -@@ -1,3 +1,5 @@ -+#include -+#include - #include - #include - #include -@@ -5,6 +7,15 @@ - /* We try here to compile in function addresses to which it is known - that the compiler will make *direct* reference. 20040308 CM */ - -+#if defined (__APPLE__) && defined (__MACH__) -+#define DARWIN -+#endif -+ -+#ifndef DARWIN -+extern int _mcount(); -+#define mmcount _mcount -+extern void sincos(double,double *,double *); -+#endif - - int - main(int argc,char * argv[],char *envp[]) { -@@ -13,33 +24,63 @@ main(int argc,char * argv[],char *envp[] - char ch=0; - jmp_buf env; - double d=0.1; -+ long l; -+ unsigned long ul; -+ -+ sscanf(argv[1],"%lf",&d); -+ bzero(&env,sizeof(env)); -+ memset(&env,0,sizeof(env)); -+ -+ ul=*(unsigned long *)envp; -+ ul=ul%(ul>>(ul & 0x3)); -+ l=*(long *)argv; -+ l=l%(l<<(l & 0x7)); -+ l/=ul/l; -+ l/=((long)ul)/l; -+ -+ ch=getc(f); -+ ch&=putc(ch,f); -+ ch&=feof(f); -+ -+ f=fdopen(l,"r"); -+ l=read(l,&l,sizeof(l)); -+ l=write(l,&l,sizeof(l)); - -- getc(f); -- putc(ch,f); -+#ifndef DARWIN -+ ch&=mmcount(); -+#endif - - setjmp(env); - -- cos(d); -- sin(d); -- tan(d); -- -- acos(d); -- asin(d); -- atan(d); -- -- cosh(d); -- sinh(d); -- tanh(d); -+ d=cos(d); -+ d=sin(d); -+#ifndef DARWIN -+ sincos(d,&d,&d); -+#endif -+ d=tan(d); -+ -+ d=acos(d); -+ d=asin(d); -+ d=atan(d); -+ -+ d=cosh(d); -+ d=sinh(d); -+ d=tanh(d); - - #ifndef _WIN32 -- acosh(d); -- asinh(d); -- atanh(d); -+ d=acosh(d); -+ d=asinh(d); -+ d=atanh(d); -+#endif -+ -+ d=exp(d); -+ d=log(d); -+#ifdef __i386__/*FIXME*/ -+ d=logl(d); - #endif - -- exp(d); -- log(d); -+ d=sqrt(d); - -- return 0; -+ return ul & l & ((unsigned long)d) & ch; - - } ---- gcl-2.6.7.orig/o/unixfsys.c -+++ gcl-2.6.7/o/unixfsys.c -@@ -22,6 +22,7 @@ Foundation, 675 Mass Ave, Cambridge, MA - #include - #include - #include -+#include - - #define IN_UNIXFSYS - #include "include.h" -@@ -33,6 +34,10 @@ Foundation, 675 Mass Ave, Cambridge, MA - - #ifdef __MINGW32__ - # include -+/* Windows has no symlink, therefore no lstat. Without symlinks lstat -+ is equivalent to stat anyway. */ -+# define S_ISLNK(a) 0 -+# define lstat stat - #endif - - #ifdef BSD -@@ -147,111 +152,75 @@ DEV_FOUND: - - #ifdef HAVE_GETCWD - char * --getwd(char *buffer) --{ -+getwd(char *buffer) { - #ifndef _WIN32 -- char *getcwd(char *, size_t); -+ char *getcwd(char *, size_t); - #endif -- return(getcwd(buffer, MAXPATHLEN)); -+ return(getcwd(buffer, MAXPATHLEN)); - } - #endif - --#ifdef DGUX -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- - -+#define pcopy(a_,b_,c_,d_) ({\ -+ unsigned _c=c_,_d=d_;\ -+ if (_c+_d>=MAXPATHLEN-16) FEerror("Can't expand pathname ~a",1,namestring);\ -+ bcopy(a_,b_+_c,_d);\ -+ b_[_c+_d]=0;\ -+ }) - -+void -+coerce_to_filename(object pathname,char *p) { - -+ object namestring = coerce_to_namestring(pathname); -+ unsigned e=namestring->st.st_fillp; -+ char *q=namestring->st.st_self,*qe=q+e;; - -+ if (pathname==Cnil) -+ FEerror ( "NIL argument.", 1, pathname ); -+ -+ if (*q=='~') { - --#endif -+ unsigned m=0; -+ char *s=++q; - --void --coerce_to_filename(object pathname, char *p) --{ -- object namestring; -- namestring = coerce_to_namestring(pathname); -- if ( pathname == Cnil ) { -- FEerror ( "NIL argument.", 1, pathname ); -- } -+ for (;sst.st_self[0]=='~') -- {char name[20]; -- int n; -- char *q = namestring->st.st_self; -+#if !defined(NO_PWD_H) && !defined(STATIC_LINKING) -+ { - #ifndef __STDC__ -- extern struct passwd *getpwuid(); -- extern struct passwd *getpwnam(); -+ extern struct passwd *getpwuid(); -+ extern struct passwd *getpwnam(); - #endif -- -- struct passwd *pwent; -- int m=0; -- q=namestring->st.st_self; -- for (n=0; n< namestring->st.st_fillp; n++) -- if (q[n]=='/') break; -- bcopy(q+1,name,n-1); -- name[n-1]= 0; -- pwent = (n==1 ? getpwuid(getuid()) : getpwnam(name)); -- if (pwent==0 || ((m = strlen(pwent->pw_dir)) -- && (m + namestring->st.st_fillp -n) >= MAXPATHLEN -16)) -- {FEerror("Can't expand pathname ~a", 1,namestring);} -- bcopy(pwent->pw_dir,p,m); -- bcopy(namestring->st.st_self+n,p+m,namestring->st.st_fillp-n); -- p[m+namestring->st.st_fillp-n]=0;} -- else -+ struct passwd *pwent; -+ -+ if (s==q) -+ pwent=getpwuid(getuid()); -+ else { -+ *s=0; -+ pwent=getpwnam(q); -+ *s='/'; -+ } -+ -+ if (!pwent) -+ FEerror("Can't expand pathname ~a",1,namestring); -+ pcopy(pwent->pw_dir,p,0,m=strlen(pwent->pw_dir)); -+ -+ } -+#else -+ { -+ char *c=getenv("HOME"); -+ if (!c || s>q) -+ FEerror("Can't expand pathname ~a",1,namestring); -+ pcopy(c,p,0,m=strlen(c)); -+ } - #endif -- {if (namestring->st.st_fillp >= MAXPATHLEN - 16) { -- vs_push(namestring); -- FEerror("Too long filename: ~S.", 1, namestring);} -- bcopy(namestring->st.st_self,p,namestring->st.st_fillp); -- p[namestring->st.st_fillp]=0;} -+ pcopy(s,p,m,qe-s); -+ -+ } else -+ pcopy(q,p,0,e); -+ - #ifdef FIX_FILENAME -- FIX_FILENAME(pathname,p); -+ FIX_FILENAME(pathname,p); - #endif - - } -@@ -274,7 +243,7 @@ truename(object pathname) - FEerror ( "truename could not determine the current directory.", 1, "" ); - } - #else -- getwd(current_directory); -+ getcwd(current_directory,sizeof(current_directory)); - #endif - - coerce_to_filename(pathname, filename); -@@ -357,7 +326,7 @@ truename(object pathname) - } - p = directory; - #else -- p = getwd(directory); -+ p = getcwd(directory,sizeof(directory)); - #endif - } - if (p[0] == '/' && p[1] == '\0') { -@@ -447,7 +416,7 @@ backup_fopen(char *filename, char *optio - - strcat(strcpy(backupfilename, filename), ".BAK"); - sprintf(command, "mv %s %s", filename, backupfilename); -- system(command); -+ msystem(command); - return(fopen(filename, option)); - } - -@@ -487,7 +456,7 @@ LFD(Lrename_file)(void) - 2, vs_base[0], vs_base[1]); - #else - sprintf(command, "mv %s %s", filename, newfilename); -- system(command); -+ msystem(command); - #endif - vs_push(vs_base[1]); - vs_push(truename(vs_base[0])); -@@ -496,6 +465,34 @@ LFD(Lrename_file)(void) - } - - -+DEF_ORDINARY("DIRECTORY",sKdirectory,KEYWORD,""); -+DEF_ORDINARY("LINK",sKlink,KEYWORD,""); -+DEF_ORDINARY("FILE",sKfile,KEYWORD,""); -+ -+/* extern char *ctime_r(const time_t *,char *); */ -+ -+DEFUN_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object path),"") { -+ -+ char filename[4096]; -+ struct stat ss; -+ -+ -+ bzero(filename,sizeof(filename)); -+ coerce_to_filename(path,filename); -+ if (lstat(filename,&ss)) -+ RETURN1(Cnil); -+ else {/* ctime_r insufficiently portable */ -+ /* int j; -+ ctime_r(&ss.st_ctime,filename); -+ j=strlen(filename); -+ if (isspace(filename[j-1])) -+ filename[j-1]=0;*/ -+ RETURN1(list(3,S_ISDIR(ss.st_mode) ? sKdirectory : -+ (S_ISLNK(ss.st_mode) ? sKlink : sKfile), -+ make_fixnum(ss.st_size),make_fixnum(ss.st_ctime))); -+ } -+} -+ - DEFUN_NEW("SETENV",object,fSsetenv,SI,2,2,NONE,OO,OO,OO,OO,(object variable,object value),"Set environment VARIABLE to VALUE") - - { -@@ -527,8 +524,8 @@ DEFUNO_NEW("DELETE-FILE",object,fLdelete - /* 1 args */ - check_type_or_pathname_string_symbol_stream(&path); - coerce_to_filename(path, filename); -- if (unlink(filename) < 0) -- FEerror("Cannot delete the file ~S.", 1, path); -+ if (unlink(filename) < 0 && rmdir(filename) < 0) -+ FEerror("Cannot delete the file ~S: ~s.", 2, path, make_simple_string(strerror(errno))); - path = Ct; - RETURN1(path); - } -@@ -565,7 +562,7 @@ LFD(Lfile_write_date)(void) - - LFD(Lfile_author)(void) - { --#ifndef NO_PWD_H -+#if !defined(NO_PWD_H) && !defined(STATIC_LINKING) - char filename[MAXPATHLEN]; - struct stat filestatus; - struct passwd *pwent; -@@ -589,7 +586,7 @@ LFD(Lfile_author)(void) - static void - FFN(Luser_homedir_pathname)(void) - { --#ifndef NO_PWD_H -+#if !defined(NO_PWD_H) && !defined(STATIC_LINKING) - struct passwd *pwent; - char filename[MAXPATHLEN]; - register int i; ---- gcl-2.6.7.orig/o/funlink.c -+++ gcl-2.6.7/o/funlink.c -@@ -222,19 +222,22 @@ fSuse_fast_links_2(object flag,object re - - - object --clear_compiler_properties(object sym, object code) --{ object tem; -+clear_compiler_properties(object sym, object code) { -+ object tem; - extern object sSclear_compiler_properties; -- VFUN_NARGS=2; FFN(fSuse_fast_links)(Cnil,sym); -+ -+ if (sSclear_compiler_properties && sSclear_compiler_properties->s.s_gfdef!=OBJNULL) -+ if ((sSAinhibit_macro_specialA && sSAinhibit_macro_specialA->s.s_dbind != Cnil) || -+ sym->s.s_sfdef == NOT_SPECIAL) -+ (void)ifuncall2(sSclear_compiler_properties,sym,code); - tem = getf(sym->s.s_plist,sStraced,Cnil); -- if (sSAinhibit_macro_specialA && sSAinhibit_macro_specialA->s.s_dbind != Cnil) -- (void)ifuncall2(sSclear_compiler_properties, sym,code); -- if (tem != Cnil) return tem; -- return sym; -+ -+ VFUN_NARGS=2; -+ FFN(fSuse_fast_links)(Cnil,sym); -+ return tem!=Cnil ? tem : sym; - - } - -- - static int - clean_link_array(object *ar, object *ar_end) - {int i=0; ---- gcl-2.6.7.orig/o/fat_string.c -+++ gcl-2.6.7/o/fat_string.c -@@ -44,13 +44,15 @@ DEFUN_NEW("PROFILE",object,fSprofile,SI - { /* 2 args */ - - object ar=sSAprofile_arrayA->s.s_dbind; -+ void *x; -+ - if (type_of(ar)!=t_string) - FEerror("si:*Profile-array* not a string",0); - if( type_of(start_address)!=t_fixnum || type_of(scale)!=t_fixnum) - FEerror("Needs start address and scale as args",0); - -- profil(!(fix(start_address)*fix(scale)) ? NULL : (void *) (ar->ust.ust_self), (ar->ust.ust_dim), -- fix(start_address),fix(scale) << 8); -+ x=!(fix(start_address)*fix(scale)) ? NULL : (void *) (ar->ust.ust_self); -+ profil(x, (ar->ust.ust_dim),fix(start_address),fix(scale) << 8); - RETURN1(start_address); - } - -@@ -77,83 +79,6 @@ DEFUN_NEW("FUNCTION-START",object,fSfunc - char *data_load_addr =0; - #endif - -- --#ifdef SPECIAL_RSYM --void --read_special_symbols(symfile) --char *symfile; --{FILE *symin; -- char *symbols; -- int i; -- unsigned long jj; -- struct lsymbol_table tab; --#ifdef AIX3 -- {char buf[500]; -- struct ld_info * ld; -- loadquery(L_GETINFO,buf,sizeof(buf)); -- ld = (struct ld_info *)buf; -- data_load_addr = ld->ldinfo_dataorg ;} --#endif -- if (!(symin=fopen(symfile,"r"))) -- {perror(symfile);exit(1);}; -- if(!fread((char *)&tab,sizeof(tab),1,symin)) -- FEerror("No header",0); -- symbols=malloc(tab.tot_leng); -- c_table.alloc_length=( (PTABLE_EXTRA+ tab.n_symbols)); -- (c_table.ptable) = (TABL *) malloc(sizeof(struct node) * c_table.alloc_length); -- if (!(c_table.ptable)) {perror("could not allocate"); exit(1);}; -- i=0; c_table.length=tab.n_symbols; -- while(i < tab.n_symbols) -- { fread((char *)&jj,sizeof(jj),1,symin); --#ifdef FIX_ADDRESS -- FIX_ADDRESS(jj); --#endif -- (SYM_ADDRESS(c_table,i))=jj; -- SYM_STRING(c_table,i)=symbols; -- -- while((*(symbols++) = getc(symin))) -- {;} --/* dprintf( name %s , SYM_STRING(c_table,i)); -- dprintf( addr %d , jj); --*/ -- i++; -- } -- -- /* -- for(i=0;i< 5;i++) -- {printf("Symbol: %d %s %d \n",i,SYM_STRINGN(c_table,i), -- SYM_ADDRESS(*ptable,i));} -- */ -- if (symin) fclose(symin); --} -- --int --node_compare(const void *node1,const void *node2) --{ return(strcmp( ((struct node *)node1)->string, -- ((struct node *)node2)->string));} -- -- -- --DEFUNO_NEW("READ-EXTERNALS",object,fSread_externals,SI -- ,1,1,NONE,OO,OO,OO,OO,void,siLread_externals,(object x0),"") --{/* 1 args */ -- {object x=x0; -- unsigned int n; -- char *str; -- n=x->st.st_fillp; -- check_type_string(&x); -- str=malloc(n+1); -- str[n]=0; -- (void) strncpy(str,x->st.st_self,n); -- read_special_symbols(str); -- /* we sort them since these are used by the sfasl loader too */ -- qsort((char*)(c_table.ptable),(int)(c_table.length),sizeof(struct node),node_compare); -- free(str);} -- RETURN1(x0); --} -- --#endif /* special_rsym */ -- - #define CFUN_LIM 10000 - - int maxpage; -@@ -173,7 +98,7 @@ cfuns_to_combined_table(unsigned int n) - if (n && combined_table.alloc_length < n) - { - (combined_table.ptable)=NULL; -- (combined_table.ptable)= (TABL *)malloc(n* sizeof(struct node)); -+ (combined_table.ptable)= (struct node *)malloc(n* sizeof(struct node)); - if(!combined_table.ptable) - FEerror("unable to allocate",0); - combined_table.alloc_length=n;} -@@ -280,17 +205,19 @@ DEFUN_NEW("SET-UP-COMBINED",object,fSset - - int j,k; - -- if((k=combined_table.length)+c_table.length >= -- combined_table.alloc_length) -- cfuns_to_combined_table(combined_table.length+c_table.length +20); -- -+ if((k=combined_table.length)+c_table.length >= combined_table.alloc_length) -+ cfuns_to_combined_table(combined_table.length+c_table.length+20); -+ - for(j = 0; j < c_table.length;) { - SYM_ADDRESS(combined_table,k) =SYM_ADDRESS(c_table,j); - SYM_STRING(combined_table,k) =SYM_STRING(c_table,j); - k++; - j++; - } -- combined_table.length += c_table.length ;} -+ -+ combined_table.length += c_table.length ; -+ -+ } - - #else - #if defined(HAVE_LIBBFD) -@@ -298,22 +225,22 @@ DEFUN_NEW("SET-UP-COMBINED",object,fSset - - bfd_update=0; - bfd_link_hash_traverse(link_info.hash, -- bfd_combined_table_update,&combined_table); -- -+ bfd_combined_table_update,&combined_table); -+ - if (combined_table.length >=combined_table.alloc_length) - cfuns_to_combined_table(combined_table.length); -- -+ - bfd_update=1; - bfd_link_hash_traverse(link_info.hash, -- bfd_combined_table_update,&combined_table); -+ bfd_combined_table_update,&combined_table); - bfd_update=0; - - } - #endif - #endif - -- qsort((char*)combined_table.ptable,(int)combined_table.length, -- sizeof(struct node),address_node_compare); -+ qsort(combined_table.ptable,combined_table.length,sizeof(*combined_table.ptable),address_node_compare); -+ - RETURN1(siz); - - } -@@ -367,7 +294,7 @@ DEFUN_NEW("DISPLAY-PROFILE",object,fSdis - if ( prev < prof_start) continue; - upto=prof_ind(next,scale); - if (upto >= dim) upto=dim; -- {char *name; unsigned long uname; -+ {const char *name; unsigned long uname; - count=0; - for( ; j - #include - #include -@@ -36,688 +23,546 @@ License for more details. - #include - #include - #include -- - #include - - #include "gclincl.h" --/* #ifdef HAVE_LIBBFD */ --/* #include */ --/* #endif */ - --#ifdef STAND --#include "include.h" - --#define FEerror(a...) do {fprintf(stderr,##a);exit(1);} while (0) -+#if SIZEOF_LONG == 4 -+#define Elfw 32 -+#else -+#define Elfw 64 - #endif - --static void relocate_symbols(Elf32_Sym *sym,int nsyms,int nscns, int *init_address_ptr); --static void relocate(Elf32_Sym *symbol_table,Elf32_Rela --*reloc_info,Elf32_Word sh_type); -- -- --#ifdef STAND --char *kcl_self,*system_directory; --main(argc,argv) -- char *argv[]; --{char *file ; -- file = argv[1]; -- kcl_self = argv[2]; -- system_directory = argv[3]; --/* _fmode = O_BINARY; */ -- fasload(file); -- return 0; --} -- --node_compare(node1,node2) --char *node1, *node2; --{ return(strcmp( ((struct node *)node1)->string, -- ((struct node *)node2)->string));} -+#define Elf Mjoin(Elf,Elfw) -+#define ELF Mjoin(ELF,Elfw) -+#define Ehdr Mjoin(Elf,_Ehdr) -+#define Shdr Mjoin(Elf,_Shdr) -+#define Sym Mjoin(Elf,_Sym) -+#define Rel Mjoin(Elf,_Rel) -+#define Rela Mjoin(Elf,_Rela) -+#define Word Elf32_Word - -+#define ELF_R_SYM(a) Mjoin(ELF,_R_SYM)(a) -+#define ELF_R_TYPE(a) Mjoin(ELF,_R_TYPE)(a) -+#define ELF_R_INFO(a,b) Mjoin(ELF,_R_INFO)(a,b) -+#define ELF_ST_BIND(a) Mjoin(ELF,_ST_BIND)(a) -+#define ELF_ST_TYPE(a) Mjoin(ELF,_ST_TYPE)(a) -+ -+ -+#define ulmax(a_,b_) ({ul _a=a_,_b=b_;_a<_b ? _b : _a;}) -+#define ALLOC_SEC(sec) (sec->sh_flags&SHF_ALLOC && (sec->sh_type==SHT_PROGBITS || sec->sh_type==SHT_NOBITS)) -+#define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC && sec->sh_type==SHT_PROGBITS) -+#define LOAD_SYM(sym) ({ul _b=ELF_ST_BIND(sym->st_info),_t=ELF_ST_TYPE(sym->st_info); \ -+ sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK || (_t>=STT_LOPROC && _t<=STT_HIPROC));}) -+ -+#define MASK(n) (~(~0L << (n))) -+ -+ -+ -+typedef unsigned long ul; - - --read_special_symbols(symfile) --char *symfile; --{FILE *symin; -- char *symbols; -- int i -- unsigned long jj; -- struct lsymbol_table tab; -- if (!(symin=fopen(symfile,"r"))) -- {perror(symfile);exit(1);}; -- if(!fread((char *)&tab,sizeof(tab),1,symin)) -- FEerror("No header",0); -- symbols=malloc(tab.tot_leng); -- c_table.alloc_length=( (PTABLE_EXTRA+ tab.n_symbols)); -- (c_table.ptable) = (TABL *) malloc(sizeof(struct node) * c_table.alloc_length); -- if (!(c_table.ptable)) {perror("could not allocate"); exit(1);}; -- i=0; c_table.length=tab.n_symbols; -- while(i < tab.n_symbols) -- { fread((char *)&jj,sizeof(jj),1,symin); -- (SYM_ADDRESS(c_table,i))=jj; -- SYM_STRING(c_table,i)=symbols; -- -- while( *(symbols++) = getc(symin)) -- {;} --/* dprintf( name %s , SYM_STRING(c_table,i)); -- dprintf( addr %d , jj); --*/ -- i++; -- } - -- /* -- for(i=0;i< 5;i++) -- {printf("Symbol: %d %s %d \n",i,SYM_STRINGN(c_table,i), -- SYM_ADDRESS(*ptable,i));} -- */ -+static Shdr * -+get_section(char *s,Shdr *sec,Shdr *sece,const char *sn) { -+ -+ for (;secsh_name,s);sec++); -+ return sec>1; -+ v&=m; -+ -+ return (!v || v==m); -+ -+} -+ -+static int -+ovchku(ul v,ul m) { -+ -+ return !(v&=m); -+ - } - -+#ifdef SPECIAL_RELOC_H -+#include SPECIAL_RELOC_H - #endif - --static Elf32_Ehdr *file_h; --static Elf32_Shdr *section_h; -+int -+store_val(ul *w,ul m,ul v) { - --static struct sect *section; --static char *string_table; --static char *section_names; --static int text_index; --struct sect {int start; -- }; -+ *w=(v&m)|(*w&~m); - --static int symsize; -+ return 0; - --char *the_start,*start_address; -+} -+ -+int -+store_vals(ul *w,ul m,ul v) { - -+ massert(ovchks(v,~m)); -+ return store_val(w,m,v); - --#define SECTION_H(n) \ -- (*(Elf32_Shdr *) ((char *) section_h + file_h->e_shentsize * (n))) -+} -+ -+int -+store_valu(ul *w,ul m,ul v) { - -+ massert(ovchku(v,~m)); -+ return store_val(w,m,v); - --/* align for power of two n */ --/* static void * */ --/* round_up(unsigned long address,unsigned long n) { */ --/* { */ --/* return (void *)((address + n -1) & ~(n-1)) ; */ --/* } */ --#define ROUND_UP(_addr,_ps) ((void *)(((unsigned long)_addr + (unsigned long)_ps -1) & ~((unsigned long)_ps-1))) -+} - --int use_mmap; - - int --get_section_number(name) -- char *name; -- --{int k ; -- for (k = 1; k < file_h->e_shnum; -- k++) -- { -- if (!strcmp (section_names + SECTION_H(k).sh_name, -- name)) -- return k; -- } --/* fprintf(stderr,"could not find section %s\n", name); */ -- return 0; -+add_val(ul *w,ul m,ul v) { -+ -+ return store_val(w,m,v+(*w&m)); -+ - } - - int --fasload(faslfile) -- object faslfile; --{ FILE *fp; -- object data; -- char filename[256]; -- Elf32_Shdr *shp; -- int file; -- struct stat stat_buf; --#ifndef STAND -- object * old_vs_base = vs_base ; -- object * old_vs_top = vs_top ; --#endif -- int symtab_index,j; -- int nsyms; -- int init_address=-1; -- int extra_bss=0; -- object memory; -- caddr_t base; -- -- int current = 0,max_align = 0; -- struct sect section_org[40]; -- Elf32_Sym *symbol_table; -- -- section = section_org; -- --#ifdef STAND -- strcpy(filename,(char *)faslfile); -- fp=fopen(filename,RDONLY); --#else -- coerce_to_filename(faslfile, filename); -- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); -- fp = faslfile->sm.sm_fp; --#endif -- -- -- file = fileno(fp); -- -- if (fstat (file, &stat_buf) == -1) -- FEerror ("Can't fstat(~a): errno %d\n", 1,faslfile); -- -- -- if (use_mmap) { -- base = mmap (0, stat_buf.st_size,PROT_READ|PROT_WRITE, MAP_PRIVATE, file, 0); } else { -- -- base = malloc(stat_buf.st_size); -- SAFE_FREAD(base,1,stat_buf.st_size,fp); -- fseek(fp,0,SEEK_CUR); -- } -- -- -- -- if (base == (caddr_t) -1) -- FEerror ("Can't mmap(~a):",1,faslfile); -- -- file_h = (Elf32_Ehdr *) base; -- -- section_h = (Elf32_Shdr *) ((char *) base + file_h->e_shoff); -- -- /* The file has non-ELF stuff appended. We need to know -- where the ELF stuff ends. To do this we must look at all -- sections because there is no guaranteed order in an ELF -- file. -- */ -- -- section_names = (char *) base -- + SECTION_H(file_h->e_shstrndx).sh_offset; -- -- symtab_index = get_section_number(".symtab"); -- text_index = get_section_number(".text"); -- -- /* calculate how much room is needed to align all the sections -- appropriately, and at what offsets they will be read in, presuming -- that the begin of the memory is aligned on max_align */ -- for (j=1 ; j < file_h->e_shnum ; j++) -- { -- if ((SECTION_H(j).sh_flags & SHF_ALLOC) -- && (SECTION_H(j).sh_type == SHT_PROGBITS -- || SECTION_H(j).sh_type == SHT_NOBITS) -- ) -- -- { if (SECTION_H(j).sh_addralign > max_align) -- max_align = SECTION_H(j).sh_addralign; -- current = (int) ROUND_UP(current,SECTION_H(j).sh_addralign); -- section[j].start = current; -- current += SECTION_H(j).sh_size; -- } -- else section[j].start=0; -- } -- -- -- shp = &SECTION_H(symtab_index); -- symbol_table = (void *) base + shp->sh_offset; -- nsyms = shp->sh_size/shp->sh_entsize; -- symsize = shp->sh_entsize; -- -- string_table = base + SECTION_H(get_section_number(".strtab")).sh_offset; -- -- /* seek to end of old file */ -- SEEK_TO_END_OFILE(fp); -- -- if (!((c_table.ptable) && *(c_table.ptable))) -- build_symbol_table(); -- -- extra_bss = 0; -- -- --#ifndef STAND -- memory = alloc_object(t_cfdata); -- memory->cfd.cfd_self = 0; -- memory->cfd.cfd_start = 0; -- memory->cfd.cfd_size = current + (max_align > sizeof(char *) ? -- max_align :0); -- -- the_start=start_address= -- memory->cfd.cfd_start = -- alloc_contblock(memory->cfd.cfd_size); --#else -- memory=(object)malloc(sizeof(*memory)); -- memory->cfd.cfd_self = 0; -- memory->cfd.cfd_start = 0; -- memory->cfd.cfd_size = current + (max_align > sizeof(char *) ? -- max_align :0); -- the_start=start_address=memory->cfd.cfd_start= -- malloc(memory->cfd.cfd_size + 0x80000); -- the_start=start_address= (char *)(0x1000 * -- ((((int)the_start + 0x70000) + 0x1000)/0x1000)); --#endif -+add_valu(ul *w,ul m,ul v) { -+ -+ return store_valu(w,m,v+(*w&m)); -+ -+} -+ -+int -+add_vals(ul *w,ul m,ul v) { - -- /* make sure the memory is aligned */ -- start_address = ROUND_UP(start_address,max_align); -- memory->cfd.cfd_size = memory->cfd.cfd_size - (start_address - the_start); -- memory->cfd.cfd_start = start_address; -- -- for (j=1 ; j < file_h->e_shnum ; j++) -- { if ((SECTION_H(j).sh_flags & SHF_ALLOC) -- && (SECTION_H(j).sh_type == SHT_PROGBITS -- )) -- { -- bcopy(base + SECTION_H(j).sh_offset,start_address + section[j].start, -- SECTION_H(j).sh_size); -- } -- } -- -- relocate_symbols(symbol_table,nsyms,file_h->e_shnum,&init_address); -- if (init_address < 0) -- { FEerror("Init address not found ",0); -- } -- -- { -- int j; -- -- for (j=1 ; j < file_h->e_shnum ; j++) { -- -- shp = &SECTION_H(j); -- if ((shp->sh_type == SHT_RELA || shp->sh_type == SHT_REL) && -- shp->sh_infoe_shnum && -- (SECTION_H(shp->sh_info).sh_flags & SHF_ALLOC) -- && (SECTION_H(shp->sh_info).sh_type == SHT_PROGBITS -- || SECTION_H(shp->sh_info).sh_type == SHT_NOBITS)) { -- -- int k; -- char *rel = (char *) base + shp->sh_offset; -- -- if (symtab_index != shp->sh_link) -- FEerror("unexpected symbol table used",0); -- the_start = start_address + section[shp->sh_info].start; -- -- for (k= 0; k< shp->sh_size ; k+= shp->sh_entsize) -- relocate(symbol_table,(Elf32_Rela *)(rel + k),shp->sh_type); -- -- } -- -- } -- -- } -- --#ifdef STAND -- {FILE *out;char pad=0; -- out=fopen("/tmp/sfasltest","wb"); -- for (j=1 ; j < file_h->e_shnum ; j++) -- if ((SECTION_H(j).sh_flags & SHF_ALLOC) && (SECTION_H(j).sh_type == SHT_PROGBITS)) -- memcpy(base+SECTION_H(j).sh_offset,start_address+section[j].start,SECTION_H(j).sh_size); -- fwrite((char *)base, stat_buf.st_size, 1, out); -- fclose(out);} -- printf("\n(start %x)\n",start_address); --#else -- -- SEEK_TO_END_OFILE(fp); -- -- /* init_address += section[text_index].start ; */ -- -- if (feof(fp)) -- data=0; -- else -- /* after hear any of the 'static' variables must not be -- referred to any more */ -- data = read_fasl_vector(faslfile); -- -- if (use_mmap) -- munmap(base, stat_buf.st_size); -- else -- free(base); -+ ul l=*w&m,mm; - -- close_stream(faslfile); -+ mm=~m; -+ mm|=mm>>1; -+ if (l&mm) l|=mm; - --#ifdef CLEAR_CACHE -- CLEAR_CACHE; --#endif -+ return store_val(w,m,v+l); - -- call_init(init_address,memory,data,0); -- -- vs_base = old_vs_base; -- vs_top = old_vs_top; -+} - -- if(symbol_value(sLAload_verboseA)!=Cnil) -- printf("start address -T %p ",memory->cfd.cfd_start); -- return(memory->cfd.cfd_size); -- --#endif /* STAND */ -- -- } -- -- --/* #ifdef HAVE_LIBBFD */ -- --/* typedef struct { */ --/* unsigned int type; */ --/* reloc_howto_type *h; */ --/* } mtbl; */ -- --/* static void */ --/* do_bfd_reloc(unsigned int oc,unsigned int val, */ --/* unsigned int *where) { */ -- --/* static bfd *dum; */ --/* static reloc_howto_type * m[BFD_RELOC_UNUSED]; */ --/* reloc_howto_type *h; */ -- --/* if (!m[0]) { */ -- --/* extern int in_bfd_init; */ -- --/* bfd_reloc_code_real_type t; */ -- --/* in_bfd_init=1; */ -- --/* bfd_init(); */ -- --/* if (!(dum=bfd_openr("/dev/null",NULL))) */ --/* FEerror("Cannot open dummy bfd\n"); */ -- --/* for (t=BFD_RELOC_UNUSED;t>_dummy_first_bfd_reloc_code_real;t--) */ --/* if ((h=bfd_reloc_type_lookup(dum,t))) */ --/* m[h->type]=h; */ -- --/* in_bfd_init=0; */ -- --/* } */ -- --/* if (oc>=BFD_RELOC_UNUSED || !m[oc]) */ --/* FEerror("Cannot lookup type %u\n",oc); */ --/* h=m[oc]; */ -- --/* if (h->pc_relative) */ --/* val-=(unsigned int)where; */ -- --/* val>>=h->rightshift; */ --/* val<<=h->bitpos; */ -- --/* #define DOIT(x) \ */ --/* x = ( (x & ~h->dst_mask) | (((x & h->src_mask) + val) & h->dst_mask)) */ -- --/* switch (h->size) { */ --/* case 0: */ --/* { */ --/* char x = bfd_get_8 (dum, (char *) where); */ --/* DOIT (x); */ --/* bfd_put_8 (dum, x, (unsigned char *) where); */ --/* } */ --/* break; */ -- --/* case 1: */ --/* { */ --/* short x = bfd_get_16 (dum, (bfd_byte *) where); */ --/* DOIT (x); */ --/* bfd_put_16 (dum, (bfd_vma) x, (unsigned char *) where); */ --/* } */ --/* break; */ --/* case 2: */ --/* { */ --/* long x = bfd_get_32 (dum, (bfd_byte *) where); */ --/* DOIT (x); */ --/* bfd_put_32 (dum, (bfd_vma) x, (bfd_byte *) where); */ --/* } */ --/* break; */ --/* case -2: */ --/* { */ --/* long x = bfd_get_32 (dum, (bfd_byte *) where); */ --/* val = -val; */ --/* DOIT (x); */ --/* bfd_put_32 (dum, (bfd_vma) x, (bfd_byte *) where); */ --/* } */ --/* break; */ -- --/* case -1: */ --/* { */ --/* long x = bfd_get_16 (dum, (bfd_byte *) where); */ --/* val = -val; */ --/* DOIT (x); */ --/* bfd_put_16 (dum, (bfd_vma) x, (bfd_byte *) where); */ --/* } */ --/* break; */ -+int -+add_valsc(ul *w,ul m,ul v) { -+ -+ ul l=*w&m,mm; -+ -+ mm=~m; -+ mm|=mm>>1; -+ if (l&mm) l|=mm; -+ -+ return store_vals(w,m,v+l); -+ -+} -+ -+static void -+relocate(Sym *sym1,void *v,ul a,ul start,ul *got,ul *gote) { -+ -+ Rel *r=v; -+ Sym *sym; -+ ul *where,p,s,tp; -+ -+ where=(void *)start+r->r_offset; -+ p=(ul)where; -+ -+ sym=sym1+ELF_R_SYM(r->r_info); -+ s=sym->st_value; -+ -+ switch((tp=ELF_R_TYPE(r->r_info))) { -+ -+#include RELOC_H -+ -+ default: -+ massert(tp&~tp); -+ -+ } -+ -+} -+ -+static int -+find_init_address(Sym *sym,Sym *syme,Shdr *sec1,Shdr *sece, -+ const char *sn,const char *st1,ul *init) { -+ -+ Shdr *sec; -+ -+ for (;symst_shndx; -+ -+ if (sec=sece) -+ continue; -+ -+ if (strcmp(sn+sec->sh_name,".text")) -+ continue; -+ -+ if (memcmp("init_",st1+sym->st_name,4)) -+ continue; -+ -+ *init=sym->st_value; -+ -+ return 0; -+ -+ } -+ -+ return -1; -+ -+} -+ -+static int -+relocate_symbols(Sym *sym,Sym *syme,Shdr *sec1,Shdr *sece,const char *st1) { -+ -+ Shdr *sec; -+ struct node *a; -+ -+ for (;symsize); */ --/* #endif */ --/* break; */ --/* default: */ --/* FEerror("Bad howto size %u\n",h->size); */ --/* break; */ --/* } */ -+ sec=sec1+sym->st_shndx; -+ -+ if (secst_value+=sec->sh_addr; -+ -+ else if ((a=find_sym_ptable(st1+sym->st_name))) -+ sym->st_value=a->address; -+ -+ } -+ -+ return 0; - --/* } */ -+} - --/* #endif HAVE_LIBBFD */ -+static object -+load_memory(Shdr *sec1,Shdr *sece,void *v1,ul **got,ul **gote) { -+ -+ object memory; -+ Shdr *sec; -+ ul gsz,sz,a,ma; -+ -+ BEGIN_NO_INTERRUPT; -+ -+ for (sec=sec1,ma=sz=0;secsh_addralign; -+ ma=ma ? ma : a; -+ sz=(sz+a-1)&~(a-1); -+ sec->sh_addr=sz; -+ sz+=sec->sh_size; - --static void --relocate(symbol_table,reloc_info,sh_type) --Elf32_Rela *reloc_info; --Elf32_Sym *symbol_table; --Elf32_Word sh_type; --{ -- char *where ; -- { -- unsigned int a,b,p,s,val; -- -- if (sh_type == SHT_RELA) -- a = reloc_info->r_addend; -- else if (sh_type == SHT_REL) -- a = 0; -- else { -- FEerror("relocate() error: unknown sh_type in ELF object",0); -- a=0; - } -- b = (unsigned int) the_start; -- s = symbol_table[ELF32_R_SYM(reloc_info->r_info)].st_value; --/* printf("Doing %s\n",string_table + symbol_table[ELF32_R_SYM(reloc_info->r_info)].st_name); */ -- where = the_start + reloc_info->r_offset; -- p = (unsigned int) where; -- -- --#define MASK(n) (~(~0 << (n))) --#define STORE_VAL(where, mask, val) \ -- *(unsigned int *)where = ((val & mask) | ((*(unsigned int *)where) & ~mask)) --#define ADD_VAL(where, mask, val) \ -- *(unsigned int *)where += ((val & mask) | ((*(unsigned int *)where) & ~mask)) -- --/* #ifdef HAVE_LIBBFD */ --/* do_bfd_reloc(ELF32_R_TYPE(reloc_info->r_info),s+a,(unsigned int *)where); */ --/* #else */ -- switch(ELF32_R_TYPE(reloc_info->r_info)){ --#if (defined(__svr4__) || defined(__linux__) || defined(__FreeBSD__)) && defined(__i386__) -- case R_386_NONE: -- FEerror("Unsupported ELF type R_386_NONE",0); -- break; -- -- case R_386_32: -- val = (s+a); -- ADD_VAL(where,~0,val); -- break; -- -- case R_386_PC32: -- val = (s+a) - (unsigned int)where /* - 4 */; -- ADD_VAL(where,~0,val); -- break; -- -- case R_386_GOT32: -- FEerror("Unsupported ELF type R_386_GOY32",0); -- break; -- -- case R_386_PLT32: -- FEerror("Unsupported ELF type R_386_PLT32",0); -- break; -- -- case R_386_COPY: -- FEerror("Unsupported ELF type R_386_COPY",0); -- break; -- -- case R_386_GLOB_DAT: -- FEerror("Unsupported ELF type R_386_GLOB_DAT",0); -- break; -- -- case R_386_JMP_SLOT: -- FEerror("Unsupported ELF type R_386_JMP_SLOT",0); -- break; -- -- case R_386_RELATIVE: -- FEerror("Unsupported ELF type R_386_RELATIVE",0); -- break; -- -- case R_386_GOTOFF: -- FEerror("Unsupported ELF type R_386_GOTOFF",0); -- break; -- -- case R_386_GOTPC: -- FEerror("Unsupported ELF type R_386_GOTPC",0); -- break; -- --#ifdef R_386_NUM -- case R_386_NUM: -- FEerror("Unsupported ELF type R_386_NUM",0); -- break; --#endif - --#else /* (defined(__svr4__) || defined(__linux__)) && defined(__i386__) */ -- case R_SPARC_WDISP30: -- /* v-disp30*/ -- val=(s+a-p) >> 2; -- STORE_VAL(where,MASK(30),val); -- break; -- -- case R_SPARC_HI22: -- /* t-sim22 */ -- val = (s+a)>>10; -- STORE_VAL(where,MASK(22),val); -- break; -- -- case R_SPARC_32: -- /* */ -- val = (s+a) ; -- STORE_VAL(where,~0,val); -- break; -- -- case R_SPARC_UA32: -- /* */ -- val = (s+a) ; -- STORE_VAL(where,0xffffffff,val); -- break; -- -- case R_SPARC_LO10: -- /* T-simm13 */ -- val = (s+a) & MASK(10); -- *(short *)(where +2) |= val; -- break; --#endif /* (defined(__svr4__) || defined(__linux__)) && defined(__i386__) */ -- default: -- printf("(non supported relocation type %d)\n", -- ELF32_R_TYPE(reloc_info->r_info)); -+ ma=ma>sizeof(struct contblock) ? ma-1 : 0; -+ sz+=ma; -+ -+ gsz=0; -+ if (**got) { -+ gsz=(**got+1)*sizeof(**got)-1; -+ sz+=gsz; -+ } -+ -+ memory=alloc_object(t_cfdata); -+ memory->cfd.cfd_size=sz; -+ memory->cfd.cfd_self=0; -+ memory->cfd.cfd_start=0; -+ memory->cfd.cfd_start=alloc_contblock(sz); -+ -+ a=(ul)memory->cfd.cfd_start; -+ a=(a+ma)&~ma; -+ for (sec=sec1;secsh_addr+=a; -+ if (LOAD_SEC(sec)) -+ memcpy((void *)sec->sh_addr,v1+sec->sh_offset,sec->sh_size); - } --/* #endif HAVE_LIBBFD */ -+ -+ if (**got) { -+ sz=**got; -+ *got=(void *)memory->cfd.cfd_start+memory->cfd.cfd_size-gsz; -+ gsz=sizeof(**got)-1; -+ *got=(void *)(((ul)*got+gsz)&~gsz); -+ *gote=*got+sz; - } -+ -+ END_NO_INTERRUPT; -+ -+ return memory; -+ - } - - -+static int -+relocate_code(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,ul *got,ul *gote) { - --#include "sfasli.c" -+ Shdr *jsec,*sec; -+ void *v,*ve; -+ Rela *ra; -+ -+ for (sec=sec1;secsh_info; -+ -+ if (jsec=sece) -+ continue; -+ if (!ALLOC_SEC(jsec)) -+ continue; -+ -+ if (sec->sh_type!=SHT_REL && sec->sh_type!=SHT_RELA) -+ continue; -+ -+ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,ra=v;vsh_entsize,ra=v) -+ relocate(sym1,ra,sec->sh_type==SHT_RELA ? ra->r_addend : 0,jsec->sh_addr,got,gote); -+ -+ } -+ -+ return 0; -+ -+} -+ -+static int -+parse_map(void *v1,Shdr **sec1,Shdr **sece, -+ char **sn,Sym **sym1,Sym **syme,char **st1,ul *end, -+ Sym **dsym1,Sym **dsyme,char **dst1) { -+ -+ Ehdr *fhp; -+ Shdr *sec; -+ -+ fhp=v1; -+ *sec1=v1+fhp->e_shoff; -+ *sece=*sec1+fhp->e_shnum; -+ -+ *sn=v1+(*sec1)[fhp->e_shstrndx].sh_offset; -+ -+ massert(sec=get_section(".symtab",*sec1,*sece,*sn)); -+ *sym1=v1+sec->sh_offset; -+ *syme=*sym1+sec->sh_size/sec->sh_entsize; -+ -+ massert(sec=get_section(".strtab",*sec1,*sece,*sn)); -+ *st1=v1+sec->sh_offset; -+ -+ *dsym1=*dsyme=NULL; -+ *dst1=NULL; -+ if ((sec=get_section(".dynsym",*sec1,*sece,*sn))) { -+ *dsym1=v1+sec->sh_offset; -+ *dsyme=*dsym1+sec->sh_size/sec->sh_entsize; -+ massert(sec=get_section(".dynstr",*sec1,*sece,*sn)); -+ *dst1=v1+sec->sh_offset; -+ } -+ -+ for (*end=0,sec=*sec1;sec<*sece;sec++) -+ *end=ulmax(*end,sec->sh_offset+sec->sh_size); -+ -+ return 0; -+ -+} -+ -+ -+static int -+set_symbol_stubs(void *v,Shdr *sec1,Shdr *sece,const char *sn, -+ Sym *ds1,Sym *dse,const char *dst1, -+ Sym *sym1,Sym *syme,const char *st1) { -+ -+ Shdr *sec,*psec; -+ Rel *r; -+ ul np,ps,p; -+ void *ve; -+ -+#ifdef SPECIAL_RELOC_H -+ massert(!find_special_params(v,sec1,sece,sn,st1,ds1,dse,sym1,syme)); -+#endif - --void --set_symbol_address(sym,string) --Elf32_Sym *sym; --char *string; --{ -- struct node *answ; -- if (c_table.ptable) -- { -- answ = find_sym_ptable(string); -- if(answ) -- { -- /* the old value of sym->n_value is the length of the common area -- starting at this address */ -- sym->st_value = answ->address; -- } -- else -- { -- fprintf(stdout,"symbol \"%s\" is not in base image",string); -- fflush(stdout); -- } -+ if (!(psec=get_section(".plt",sec1,sece,sn))) -+ return 0; -+ -+ massert((sec=get_section( ".rel.plt",sec1,sece,sn)) || -+ (sec=get_section(".rela.plt",sec1,sece,sn))); -+ -+ np=sec->sh_size/sec->sh_entsize; -+ ps=psec->sh_size/np; -+ -+ v+=sec->sh_offset; -+ ve=v+np*sec->sh_entsize; -+ -+ p=psec->sh_addr+psec->sh_size%np; -+ -+ for (r=v;vsh_entsize,p+=ps,r=v) -+ if (!ds1[ELF_R_SYM(r->r_info)].st_value) -+ ds1[ELF_R_SYM(r->r_info)].st_value=p; -+ -+ -+ return 0; -+ -+} -+ -+static int -+calc_space(ul *ns,ul *sl,Sym *sym1,Sym *syme,const char *st1,Sym *d1,Sym *de,const char *ds1) { -+ -+ Sym *sym,*d; -+ -+ for (sym=sym1;symst_name,ds1+d->st_name);d++); -+ if (dst_name)+1; -+ -+ } -+ -+ return 0; -+ - } - --static void --relocate_symbols(sym,nsyms,nscns,init_address_ptr) -- Elf32_Sym *sym; -- int nsyms; -- int nscns; -- int *init_address_ptr; /* offset of init_address */ --{ int siz = symsize; -- while (--nsyms >= 0) -- { switch(ELF32_ST_BIND(sym->st_info)) -- { case STB_LOCAL: -- if (sym->st_shndx == SHN_ABS || sym->st_shndx >= nscns) break; -- -- if ((SECTION_H(sym->st_shndx).sh_flags & SHF_ALLOC) == 0) -- { -- switch (SECTION_H(sym->st_shndx).sh_type) -- { -- case SHT_NULL: -- case SHT_PROGBITS: -- case SHT_NOTE: -- case SHT_STRTAB: -- /* These occur in Linux. -- Ignore symbols for such sections. */ -- break; -- default: -- printf("[unknown rel secn %d type=%d]", -- sym->st_shndx, -- (int)SECTION_H(sym->st_shndx).sh_type); -- } -- } -- else -- sym->st_value += (int) (start_address + section[sym->st_shndx].start); -- break; -- case STB_GLOBAL: -- if (sym->st_shndx == SHN_UNDEF -- || sym->st_shndx == SHN_COMMON -- ) -- { set_symbol_address(sym,string_table + sym->st_name); -- } -- else -- if (sym->st_shndx == text_index && -- bcmp("init_",string_table + sym->st_name,4) == 0) -- { -- *init_address_ptr = sym->st_value+section[sym->st_shndx].start; -- -- } -- else -- {printf("[unknown global sym %s]",string_table + sym->st_name);} -- break; -- default: -- {printf("[unknown bind type %d]",ELF32_ST_BIND(sym->st_info));} -- } -- sym = (void *)sym + siz; -+static int -+load_ptable(struct node **a,char **s,Sym *sym1,Sym *syme,const char *st1, -+ Sym *d1,Sym *de,const char *ds1) { -+ -+ Sym *sym,*d; -+ -+ for (sym=sym1;symst_name,ds1+d->st_name);d++); -+ if (daddress=sym->st_value; -+ (*a)->string=(*s); -+ strcpy((*s),st1+sym->st_name); -+ -+ (*a)++; -+ (*s)+=strlen(*s)+1; -+ -+ } -+ -+ return 0; -+ - } - --#define STRUCT_SYMENT Elf32_Sym - --/* dont try to add extra bss stuff here. It is not really --common so other files can't reference it, so we really --should use static. --*/ -+static int -+load_self_symbols() { -+ -+ FILE *f; -+ char *sn,*st1,*s,*dst1; -+ Shdr *sec1,*sece; -+ Sym *sym1,*syme,*dsym1,*dsyme; -+ void *v1,*ve; -+ ul ns,sl,end; -+ struct node *a; -+ -+ massert(f=fopen(kcl_self,"r")); -+ massert(v1=get_mmap(f,&ve)); -+ -+ massert(!parse_map(v1,&sec1,&sece,&sn,&sym1,&syme,&st1,&end,&dsym1,&dsyme,&dst1)); -+ -+#ifndef STATIC_LINKING -+ massert(!set_symbol_stubs(v1,sec1,sece,sn,dsym1,dsyme,dst1,sym1,syme,st1)); -+#endif -+ -+ ns=sl=0; -+ massert(!calc_space(&ns,&sl,dsym1,dsyme,dst1,NULL,NULL,NULL)); -+ massert(!calc_space(&ns,&sl,sym1,syme,st1,dsym1,dsyme,dst1)); -+ -+ c_table.alloc_length=c_table.length=ns; -+ massert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length)); -+ massert(s=malloc(sl)); -+ -+ a=c_table.ptable; -+ massert(!load_ptable(&a,&s,dsym1,dsyme,dst1,NULL,NULL,NULL)); -+ massert(!load_ptable(&a,&s,sym1,syme,st1,dsym1,dsyme,dst1)); -+ -+ qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare); -+ -+ massert(!un_mmap(v1,ve)); -+ massert(!fclose(f)); -+ -+ return 0; -+ -+} - - int --get_extra_bss(symbol_table,length,start,ptr,bsssize) --int length,bsssize,start; --STRUCT_SYMENT *symbol_table; --int *ptr; /* store init address offset here */ --{ return 0; -+seek_to_end_ofile(FILE *fp) { -+ -+ void *v1,*ve; -+ Shdr *sec1,*sece; -+ Sym *sym1,*syme,*dsym1,*dsyme; -+ char *sn,*st1,*dst1; -+ ul end; -+ -+ massert(v1=get_mmap(fp,&ve)); -+ -+ massert(!parse_map(v1,&sec1,&sece,&sn,&sym1,&syme,&st1,&end,&dsym1,&dsyme,&dst1)); -+ -+ massert(!fseek(fp,end,SEEK_SET)); -+ -+ massert(!un_mmap(v1,ve)); -+ -+ return 0; -+ - } - -+int -+fasload(object faslfile) { -+ -+ FILE *fp; -+ char filename[256],*sn,*st1,*dst1; -+ ul init_address=0,end,gs=0,*got=&gs,*gote=got+1; -+ object memory,data; -+ Shdr *sec1,*sece; -+ Sym *sym1,*syme,*dsym1,*dsyme; -+ void *v1,*ve; -+ -+ coerce_to_filename(faslfile, filename); -+ faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); -+ fp = faslfile->sm.sm_fp; -+ -+ massert(v1=get_mmap(fp,&ve)); -+ -+ massert(!parse_map(v1,&sec1,&sece,&sn,&sym1,&syme,&st1,&end,&dsym1,&dsyme,&dst1)); -+ -+#ifdef SPECIAL_RELOC_H -+ massert(!label_got_symbols(v1,sec1,sece,sym1,syme,st1,got)); -+#endif -+ -+ massert(memory=load_memory(sec1,sece,v1,&got,&gote)); -+ -+ massert(!relocate_symbols(sym1,syme,sec1,sece,st1)); -+ -+ massert(!find_init_address(sym1,syme,sec1,sece,sn,st1,&init_address)); -+ -+ massert(!relocate_code(v1,sec1,sece,sym1,got,gote)); -+ -+ massert(!fseek(fp,end,SEEK_SET)); -+ data=feof(fp) ? 0 : read_fasl_vector(faslfile); -+ -+ massert(!un_mmap(v1,ve)); -+ close_stream(faslfile); -+ -+#ifdef CLEAR_CACHE -+ CLEAR_CACHE; -+#endif -+ -+ init_address-=(ul)memory->cfd.cfd_start; -+ call_init(init_address,memory,data,0); -+ -+ if(symbol_value(sLAload_verboseA)!=Cnil) -+ printf("start address -T %p ",memory->cfd.cfd_start); -+ -+ return(memory->cfd.cfd_size); -+ -+} - -+#include "sfasli.c" ---- gcl-2.6.7.orig/o/character.d -+++ gcl-2.6.7/o/character.d -@@ -581,17 +581,17 @@ gcl_init_character() - int i; - - for (i = 0; i < CHCODELIM; i++) { -- character_table[i].t = (short)t_character; -- character_table[i].ch_code = i; -- character_table[i].ch_font = 0; -- character_table[i].ch_bits = 0; -+ character_table[i].ch.t = (short)t_character; -+ character_table[i].ch.ch_code = i; -+ character_table[i].ch.ch_font = 0; -+ character_table[i].ch.ch_bits = 0; - } - #ifdef AV - for (i = -128; i < 0; i++) { -- character_table[i].t = (short)t_character; -- character_table[i].ch_code = i+CHCODELIM; -- character_table[i].ch_font = 0; -- character_table[i].ch_bits = 0; -+ character_table[i].ch.t = (short)t_character; -+ character_table[i].ch.ch_code = i+CHCODELIM; -+ character_table[i].ch.ch_font = 0; -+ character_table[i].ch.ch_bits = 0; - } - #endif - ---- gcl-2.6.7.orig/o/sfasl.c -+++ gcl-2.6.7/o/sfasl.c -@@ -36,6 +36,32 @@ via #include "../c/sfasl.c" - #undef S_DATA - /* #endif */ - -+ -+#ifdef SPECIAL_RSYM -+ -+#include -+ -+#include "ptable.h" -+ -+static int -+node_compare(const void *v1,const void *v2) { -+ const struct node *a1=v1,*a2=v2; -+ -+ return strcmp(a1->string,a2->string); -+ -+} -+ -+static struct node * -+find_sym_ptable(const char *name) { -+ -+ struct node joe; -+ joe.string=name; -+ return bsearch(&joe,c_table.ptable,c_table.length,sizeof(joe),node_compare); -+ -+} -+ -+#endif -+ - #ifdef SEPARATE_SFASL_FILE - #include SEPARATE_SFASL_FILE - #else ---- gcl-2.6.7.orig/o/list.d -+++ gcl-2.6.7/o/list.d -@@ -842,20 +842,20 @@ LFD(LlistA)() - while (vs_top > vs_base + 1) - stack_cons(); - } --static object copy_off_stack_tree(x) --object x; --{object *p; -- p = &x; -- TOP: -- if (type_of(*p) ==t_cons) -- { if(!inheap(*p)) -- *p=make_cons(copy_off_stack_tree((*p)->c.c_car),(*p)->c.c_cdr); -- else -- (*p)->c.c_car = copy_off_stack_tree((*p)->c.c_car); -- p = &((*p)->c.c_cdr); -- goto TOP;} -- return x; --} -+/* static object copy_off_stack_tree(x) */ -+/* object x; */ -+/* {object *p; */ -+/* p = &x; */ -+/* TOP: */ -+/* if (type_of(*p) ==t_cons) */ -+/* { if(!inheap(*p)) */ -+/* *p=make_cons(copy_off_stack_tree((*p)->c.c_car),(*p)->c.c_cdr); */ -+/* else */ -+/* (*p)->c.c_car = copy_off_stack_tree((*p)->c.c_car); */ -+/* p = &((*p)->c.c_cdr); */ -+/* goto TOP;} */ -+/* return x; */ -+/* } */ - - - ---- gcl-2.6.7.orig/o/xdrfuns.c -+++ gcl-2.6.7/o/xdrfuns.c -@@ -47,7 +47,7 @@ FFN(siGxdr_write)(object str,object elt) - - switch (type_of(elt)) { - case t_fixnum: -- if(!xdr_long(xdrp,&fix(elt))) goto error; -+ if(!xdr_long(xdrp,(long *)&fix(elt))) goto error; - break; - case t_longfloat: - if(!xdr_double(xdrp,&lf(elt))) goto error; -@@ -79,7 +79,7 @@ FFN(siGxdr_write)(object str,object elt) - u_int tmp=elt->v.v_fillp; - if (tmp!=elt->v.v_fillp) - goto error; -- if(!xdr_array(xdrp,(char **)&elt->v.v_self, -+ if(!xdr_array(xdrp,(void *)&elt->v.v_self, - &tmp, - elt->v.v_dim, - aet_sizes[elt->v.v_elttype], -@@ -106,7 +106,7 @@ FFN(siGxdr_read)(object str,object elt) - switch (type_of(elt)) { - case t_fixnum: - {fixnum l; -- if(!xdr_long(xdrp,&l)) goto error; -+ if(!xdr_long(xdrp,(long *)&l)) goto error; - return make_fixnum(l);} - break; - case t_longfloat: -@@ -141,7 +141,7 @@ FFN(siGxdr_read)(object str,object elt) - u_int tmp=elt->v.v_fillp; - if (tmp!=elt->v.v_fillp) - goto error; -- if(!xdr_array(xdrp,(char **)&elt->v.v_self, -+ if(!xdr_array(xdrp,(void *)&elt->v.v_self, - &tmp, - elt->v.v_dim, - aet_sizes[elt->v.v_elttype], ---- gcl-2.6.7.orig/o/mingwin.c -+++ gcl-2.6.7/o/mingwin.c -@@ -584,7 +584,7 @@ error: - int - TcpOutputProc ( int fd, char *buf, int toWrite, int *errorCodePtr, int block ) - { -- int bytesWritten; -+ int bytesWritten=0; - int error; - int count=1000*30; - -@@ -705,8 +705,8 @@ int getCharGclSocket(strm,block) - if (high > 0) - { object bufp = SOCKET_STREAM_BUFFER(strm); - int n; -- n = (*winSock.recv)(fd,bufp->ust.ust_self ,bufp->ust.ust_dim,0); -- doReverse(bufp->ust.ust_self,n); -+ n = (*winSock.recv)(fd,bufp->st.st_self ,bufp->ust.ust_dim,0); -+ doReverse(bufp->st.st_self,n); - bufp->ust.ust_fillp=n; - if (n > 0) - { -@@ -823,54 +823,63 @@ void sigkill() - } - - -+static void -+init_signals_pendingPtr() { - --static void init_signals_pendingPtr() --{ static int where; -- if (sharedMemory.address) { -- signalsPendingPtr = sharedMemory.address; -- } else { -- signalsPendingPtr = &where; -- } -- gcl_signal(SIGKILL,sigkill); -- gcl_signal(SIGTERM,sigterm); -+ static unsigned int where; -+ if (sharedMemory.address) { -+ signalsPendingPtr = sharedMemory.address; -+ } else { -+ signalsPendingPtr = &where; -+ } -+ gcl_signal(SIGKILL,sigkill); -+ gcl_signal(SIGTERM,sigterm); - #ifdef SIGABRT -- gcl_signal(SIGABRT,sigabrt); -+ gcl_signal(SIGABRT,sigabrt); - #endif -- -- -- -+ - } - -+void -+close_shared_memory() { - -- -- -- --void close_shared_memory() --{ -- if (sharedMemory.handle) CloseHandle(sharedMemory.handle); -+ if (sharedMemory.handle) -+ CloseHandle(sharedMemory.handle); - sharedMemory.handle = NULL; -- if (sharedMemory.address) UnmapViewOfFile(sharedMemory.address); -+ if (sharedMemory.address) -+ UnmapViewOfFile(sharedMemory.address); - sharedMemory.address = NULL; - init_signals_pendingPtr(); -+ - } - --void init_shared_memory (void) --{ -+void -+init_shared_memory (void) { -+ static int n; -+ -+ if (n) return; -+ n=1; -+ -+ sharedMemory.address=0; -+ init_signals_pendingPtr(); -+ return; -+ - sprintf(sharedMemory.name,"gcl-%d",getpid()); - sharedMemory.handle = -- CreateFileMapping((HANDLE)-1, NULL, PAGE_READWRITE, 0, sharedMemory.length , TEXT (sharedMemory.name)); -+ CreateFileMapping((HANDLE)-1,NULL,PAGE_READWRITE,0,sharedMemory.length ,TEXT(sharedMemory.name)); - if (sharedMemory.handle == NULL) - error("CreateFileMapping failed"); -- sharedMemory.address = -- MapViewOfFile(sharedMemory.handle, /* Handle to mapping object. */ -- FILE_MAP_WRITE, /* Read/write permission */ -- 0, /* Max. object size. */ -- 0, /* Size of hFile. */ -- 0); /* Map entire file. */ -- if (sharedMemory.address == NULL) -- { error("MapViewOfFile failed");} -- init_signals_pendingPtr(); -- atexit(close_shared_memory); -+ sharedMemory.address = -+ MapViewOfFile(sharedMemory.handle, /* Handle to mapping object. */ -+ FILE_MAP_WRITE, /* Read/write permission */ -+ 0, /* Max. object size. */ -+ 0, /* Size of hFile. */ -+ 0); /* Map entire file. */ -+ if (sharedMemory.address == NULL) -+ error("MapViewOfFile failed"); -+ init_signals_pendingPtr(); -+ atexit(close_shared_memory); -+ - } - - /* The only signal REALLY handled somewhat under mingw is the -@@ -922,19 +931,16 @@ sigprocmask (int how , const sigset_t *s - } - - void --fix_filename(object pathname, char *filename1) --{ -- char current_directory[MAXPATHLEN]; -- char directory[MAXPATHLEN]; -- char *filename = filename1; -- char *p; -- extern char *getwd(); -- /* fprintf ( stderr, "fix_filename: At start %s\n", filename1 );*/ -- p = filename; -- while ( *p ) { -- if (*p=='\\') *p='/'; -- p++; -- } -+fix_filename(object pathname, char *filename1) { -+ -+ char *filename=filename1,*p=filename; -+ extern char *getwd(); -+ -+ while (*p) { -+ if (*p=='\\') *p='/'; -+ p++; -+ } -+ - } - - -@@ -949,4 +955,3 @@ char *GCLExeName ( void ) - } - return ( (char *) rv ); - } -- ---- gcl-2.6.7.orig/o/makefile -+++ gcl-2.6.7/o/makefile -@@ -30,7 +30,19 @@ DECL := $(HDIR)/new_decl.h - rm $*.c - - CPP= --%.ini: %.c grab_defs plt.h -+ -+PLT= -+PLTH= -+ifneq ($(findstring bfd,$(LIBS)),) -+PLT = plt.o -+PLTH = plt.h -+endif -+ifneq ($(BUILD_BFD),) -+PLT = plt.o -+PLTH = plt.h -+endif -+ -+%.ini: %.c grab_defs $(PLTH) - [ -e $(DECL) ] || touch $(DECL) - $(CC) -DNO_DEFUN $(CFLAGS) $(DEFS) -E $*.c | sed -e 's:\"[ ]*):\"):g' | ./grab_defs > $*.ini - -@@ -77,7 +89,7 @@ OBJS = $(OD)main.o $(OD)alloc.o $(OD)gbc - $(OD)print.o $(OD)format.o $(OD)pathname.o \ - $(OD)unixfsys.o $(OD)unixfasl.o $(OD)error.o \ - $(OD)unixtime.o $(OD)unixsys.o $(OD)unixsave.o \ -- $(OD)funlink.o $(OD)plt.o \ -+ $(OD)funlink.o $(OD)$(PLT) \ - $(OD)fat_string.o ${ODIR}/run_process.o \ - $(OD)nfunlink.o $(OD)usig.o $(OD)usig2.o $(OD)utils.o \ - $(OD)makefun.o $(OD)sockets.o $(OD)gmp_wrappers.o $(OD)clxsocket.o \ -@@ -132,33 +144,19 @@ grab_defs: grab_defs.c - # CM 20040227 - # - --#def: $(OBJECTS) --# nm $^ | awk '/ [TBCD] / {print $$3}' | sort |uniq >def -- --#undef: $(OBJECTS) --# nm $^ | awk '/ [U] / {print $$2}' | sort |uniq >undef -- --#undef.h: undef def --# join -v1 $^ | \ --# awk '{if (i++) printf("MY_PLT(%s),\n",a);a=$$1} END {printf("MY_PLT(%s)\n",a)}'>$@ -- --#void.h: undef def --# join -v1 $^ | \ --# awk '/my_plt/ {next} {printf("extern void *%s;\n",$$1);}'>$@ -- - plttest.o: plttest.c - $(CC) -c $(CFLAGS) $(DEFS) $*.c $(AUX_INFO) - - plt.h: plttest.o -- nm $< | awk '/ U / {a=$$2;if (k) sub("^_","",a);\ -- b=a;gsub("_","",b);\ -- if (match(j,b)) printf("MY_PLT(%s)\n",a)}' \ -- j="$$(awk '/main/ {i=1;next} {if (!i) next} \ -- /^ *[a-zA-Z_]*\(/ {sub("\\(.*$$","",$$1);print $$1}' plttest.c)" \ -+ nm $< | $(AWK) '/ U / {if (NF!=2) next;a=$$2;if (k) sub("^_","",a);\ -+ print a}' \ - k=$(LEADING_UNDERSCORE) |\ - sort | \ -- awk '{A[++k]=$$0} END {for (i=1;i<=k;i++) \ -- printf("%s%s\n",A[i],i==k ? "" : ",");}' >$@ -+ grep -v 'restFP' | grep -v 'saveFP' | \ -+ grep -v '[^ \t_]_' |\ -+ sed 's,\([a-z]\)\$$.*,\1,g' |\ -+ $(AWK) '{A[++k]=$$0} END {for (i=1;i<=k;i++) \ -+ printf("MY_PLT(%s)%s\n",A[i],i==k ? "" : ",");}' >$@ - - plt.o: plt.c plt.h - $(CC) -c $(CFLAGS) $(DEFS) $*.c $(AUX_INFO) -@@ -171,7 +169,7 @@ $(GCLIB): ${ALIB} - $(AR) gcllib.a ${ALIB} - ${RANLIB} gcllib.a - clean: -- rm -f $(OBJS) ${ALIB} new_init.o $(LAST_FILE) $(FIRST_FILE) *.a grab_defs$(EXE) *.ini tmpx foo.c cmpinclude.h new_init.c $(DECL) def undef udef.h void.h plt.h plttest.o -+ rm -f $(OBJS) ${ALIB} new_init.o $(LAST_FILE) $(FIRST_FILE) *.a grab_defs$(EXE) *.ini tmpx foo.c cmpinclude.h new_init.c $(DECL) def undef udef.h void.h plt.h plttest.o grab_defs - - fsavres.o: /lib/libc.a - ar xv /lib/libc.a fsavres.o ---- gcl-2.6.7.orig/o/nsocket.c -+++ gcl-2.6.7/o/nsocket.c -@@ -154,7 +154,12 @@ CreateSocketAddress(struct sockaddr_in * - } else { - addr.s_addr = inet_addr(host); - if (addr.s_addr == -1) { -- hostent = gethostbyname(host); -+ hostent = /* gethostbyname(host); */ -+#ifdef STATIC_LINKING -+ NULL; -+#else -+ gethostbyname(host); -+#endif - if (hostent != NULL) { - memcpy((VOID *) &addr, - (VOID *) hostent->h_addr_list[0], -@@ -336,8 +341,15 @@ DEFUN_NEW("GETPEERNAME",object,fSgetpeer - if (getpeername(SOCKET_FD(sock), (struct sockaddr *) &peername, &size) - >= 0) { - address=make_simple_string(inet_ntoa(peername.sin_addr)); -- hostEntPtr = gethostbyaddr((char *) &(peername.sin_addr), -- sizeof(peername.sin_addr), AF_INET); -+ hostEntPtr = /* gethostbyaddr((char *) &(peername.sin_addr), */ -+ /* sizeof(peername.sin_addr), AF_INET); */ -+#ifdef STATIC_LINKING -+ NULL; -+#else -+ gethostbyaddr((char *) &(peername.sin_addr), -+ sizeof(peername.sin_addr), AF_INET); -+#endif -+ - if (hostEntPtr != (struct hostent *) NULL) - host = make_simple_string(hostEntPtr->h_name); - else host = address; -@@ -359,8 +371,14 @@ DEFUN_NEW("GETSOCKNAME",object,fSgetsock - if (getsockname(SOCKET_FD(sock), (struct sockaddr *) &sockname, &size) - >= 0) { - address= make_simple_string(inet_ntoa(sockname.sin_addr)); -- hostEntPtr = gethostbyaddr((char *) &(sockname.sin_addr), -- sizeof(sockname.sin_addr), AF_INET); -+ hostEntPtr = /* gethostbyaddr((char *) &(sockname.sin_addr), */ -+ /* sizeof(sockname.sin_addr), AF_INET); */ -+#ifdef STATIC_LINKING -+ NULL; -+#else -+ gethostbyaddr((char *) &(sockname.sin_addr), -+ sizeof(sockname.sin_addr), AF_INET); -+#endif - if (hostEntPtr != (struct hostent *) NULL) - host = make_simple_string(hostEntPtr->h_name); - else host=address; -@@ -645,8 +663,9 @@ getCharGclSocket(object strm, object blo - } - else - { -- return EOF; -- FEerror("select said there was stuff there but there was not",0); -+ SOCKET_STREAM_FD(strm)=-1; -+ return EOF; -+ FEerror("select said there was stuff there but there was not",0); - } - } - /* probably a signal interrupted us.. */ ---- gcl-2.6.7.orig/o/run_process.c -+++ gcl-2.6.7/o/run_process.c -@@ -20,6 +20,11 @@ License for more details. - - #define IN_RUN_PROCESS - #include "include.h" -+ -+#ifdef HAVE_SYS_SOCKIO_H -+#include -+#endif -+ - #ifdef RUN_PROCESS - - void setup_stream_buffer(object); -@@ -152,9 +157,9 @@ void run_process ( char *name ) - - - /* Connect up the Lisp objects with the pipes. */ -- ofd = _open_osfhandle ( hChildStdoutRead, _O_RDONLY | _O_TEXT ); -+ ofd = _open_osfhandle ( (int)hChildStdoutRead, _O_RDONLY | _O_TEXT ); - ofp = _fdopen ( ofd, "r" ); -- ifd = _open_osfhandle ( hChildStdinWrite, _O_WRONLY | _O_TEXT ); -+ ifd = _open_osfhandle ( (int)hChildStdinWrite, _O_WRONLY | _O_TEXT ); - ifp = _fdopen ( ifd, "w" ); - - #if 0 -@@ -353,7 +358,9 @@ int server; - struct hostent *hp; - struct sockaddr_in sock_add; /* Address of socket */ - -+#ifndef STATIC_LINKING - if((hp = gethostbyname(host)) == NULL) -+#endif - { - FEerror("No such host.",0); - } -@@ -452,7 +459,7 @@ FFN(siLmake_socket_stream)() - { - check_arg(2); - vs_base[0] = make_socket_stream(vs_base[0], vs_base[1]); -- vs_pop; -+ vs_popp; - } - - /* ---- gcl-2.6.7.orig/o/structure.c -+++ gcl-2.6.7/o/structure.c -@@ -189,10 +189,9 @@ LFD(siLmake_structure)(void) - x = alloc_object(t_structure); - name=base[0]; - COERCE_DEF(name); -- if (type_of(name)!=t_structure || -+ if (type_of(name)!=t_structure || - (def=S_DATA(name))->length != --narg) -- FEerror("Bad make_structure args for type ~a",1, -- base[0]); -+ FEerror("Bad make_structure args for type ~a",1,base[0]); - x->str.str_def = name; - x->str.str_self = NULL; - size=S_DATA(name)->size; ---- gcl-2.6.7.orig/o/plt.c -+++ gcl-2.6.7/o/plt.c -@@ -9,12 +9,17 @@ - - #include "include.h" - -- - typedef struct { - const char *n; - unsigned long ad; - } Plt; - -+#ifdef LEADING_UNDERSCORE -+#define stn(a_) (*(a_)=='_' ? (a_)+1 : (a_)) -+#else -+#define stn(a_) a_ -+#endif -+ - static int - pltcomp(const void *v1,const void *v2) { - const Plt *p1=v1,*p2=v2; -@@ -23,6 +28,26 @@ pltcomp(const void *v1,const void *v2) { - - } - -+extern int mcount(); -+extern int _mcount(); -+extern int __divdi3(); -+extern int __moddi3(); -+extern int __udivdi3(); -+extern int __umoddi3(); -+extern void sincos(double,double *,double *); -+extern int __divsi3(); -+extern int __modsi3(); -+extern int __udivsi3(); -+extern int __umodsi3(); -+extern int $$divI(); -+extern int $$divU(); -+extern int $$remI(); -+extern int $$remU(); -+extern int __divq(); -+extern int __divqu(); -+extern int __remq(); -+extern int __remqu(); -+ - #define MY_PLT(a_) {#a_,(unsigned long)(void *)a_} - static Plt mplt[]={ - /* This is an attempt to at least capture the addresses to -@@ -38,7 +63,9 @@ static Plt mplt[]={ - in sfasli.c. FIXME -- this should be made synchronous with - compiler changes; sort the list automatically. SORT THIS - LIST BY HAND FOR THE TIME BEING. */ --#include "plt.h" -+#ifndef _WIN32 -+# include "plt.h" -+#endif - }; - - object sSAplt_tableA; -@@ -108,16 +135,14 @@ parse_plt() { - for (i=j=0,li=Cnil;fgets(b,sizeof(b),f);) { - if (!memchr(b,10,sizeof(b)-1)) - FEerror("plt buffer too small", 0); -- if (memcmp(b," .plt",4) && !i) -+ if (!memcmp(b," .plt",4)) { -+ i=1; - continue; -- if (*b=='\r' || *b=='\n') { -+ } -+ if (*b!=' ' || b[1]!=' ' || !i) { - i=0; - continue; -- } else -- if (!i) { -- i=1; -- continue; -- } -+ } - if (sscanf(b,"%lx%n",&u,&n)!=1) - FEerror("Cannot read address", 0); - for (c=b+n;*c==32;c++); -@@ -166,7 +191,7 @@ my_plt(const char *s,unsigned long *v) { - return 0; - } - -- tp.n=s; -+ tp.n=stn(s); - if ((p=bsearch(&tp,p,pe-p,sizeof(*p),pltcomp))) { - *v=p->ad; - return 0; ---- /dev/null -+++ gcl-2.6.7/o/sfaslmacho.c -@@ -0,0 +1,560 @@ -+#include -+#include -+#include -+#include -+#include -+#include -+#include -+#include -+#include -+#include -+ -+#ifdef _LP64 -+#define mach_header mach_header_64 -+#define nlist nlist_64 -+#define segment_command segment_command_64 -+#undef LC_SEGMENT -+#define LC_SEGMENT LC_SEGMENT_64 -+#define section section_64 -+#undef MH_MAGIC -+#define MH_MAGIC MH_MAGIC_64 -+#endif -+ -+#ifndef S_16BYTE_LITERALS -+#define S_16BYTE_LITERALS 0 -+#endif -+ -+#define ALLOC_SEC(sec) ({ul _fl=sec->flags&SECTION_TYPE;\ -+ _fl<=S_SYMBOL_STUBS || _fl==S_16BYTE_LITERALS;}) -+ -+#define LOAD_SEC(sec) ({ul _fl=sec->flags&SECTION_TYPE;\ -+ (_fl<=S_SYMBOL_STUBS || _fl==S_16BYTE_LITERALS) && _fl!=S_ZEROFILL;}) -+ -+ -+#define MASK(n) (~(~0L << (n))) -+ -+ -+ -+typedef unsigned long ul; -+ -+ -+ -+#ifdef STATIC_RELOC_VARS -+STATIC_RELOC_VARS -+#endif -+ -+ -+ -+static int -+ovchk(ul v,ul m) { -+ -+ m|=m>>1; -+ v&=m; -+ -+ return (!v || v==m); -+ -+} -+ -+static int -+store_val(ul *w,ul m,ul v) { -+ -+ massert(ovchk(v,~m)); -+ *w=(v&m)|(*w&~m); -+ -+ return 0; -+ -+} -+ -+static int -+add_val(ul *w,ul m,ul v) { -+ -+ return store_val(w,m,v+(*w&m)); -+ -+} -+ -+ -+/*redirect trampolines gcc-4.0 gives no reloc for stub sections on x86 only*/ -+static int -+redirect_trampoline(struct relocation_info *ri,ul o,ul rel, -+ struct section *sec1,ul *io1,struct nlist *n1,ul *a) { -+ -+ struct section *js=sec1+ri->r_symbolnum-1; -+ -+ if (ri->r_extern) -+ return 0; -+ -+ if ((js->flags&SECTION_TYPE)!=S_SYMBOL_STUBS) -+ return 0; -+ -+ if (ri->r_pcrel) o+=rel; -+ o-=js->addr; -+ -+ massert(!(o%js->reserved2)); -+ o/=js->reserved2; -+ massert(o>=0 && osize/js->reserved2); -+ -+ *a=n1[io1[js->reserved1+o]].n_value; -+ ri->r_extern=1; -+ -+ return 0; -+ -+} -+ -+static int -+relocate(struct relocation_info *ri,struct section *sec, -+ struct section *sec1,ul start,ul *io1,struct nlist *n1,ul *got,ul *gote) { -+ -+ struct scattered_relocation_info *sri=(void *)ri; -+ ul *q=(void *)(sec->addr+(sri->r_scattered ? sri->r_address : ri->r_address)); -+ ul a,rel=(ul)(q+1); -+ -+ if (sri->r_scattered) -+ a=sri->r_value; -+ else if (ri->r_extern) -+ a=n1[ri->r_symbolnum].n_value; -+ else -+ a=start; -+ -+ switch(sri->r_scattered ? sri->r_type : ri->r_type) { -+ -+#include RELOC_H -+ -+ default: -+ FEerror("Unknown reloc type\n",0); -+ break; -+ -+ } -+ -+ return 0; -+ -+} -+ -+static int -+relocate_symbols(struct nlist *n1,struct nlist *ne,char *st1,ul start) { -+ -+ struct nlist *n; -+ struct node *nd; -+ -+ for (n=n1;nn_sect) -+ n->n_value+=start; -+ else if ((nd=find_sym_ptable(st1+n->n_un.n_strx))) -+ n->n_value=nd->address; -+ -+ return 0; -+ -+} -+ -+static int -+find_init_address(struct nlist *n1,struct nlist *ne,const char *st1,ul *init) { -+ -+ struct nlist *n; -+ -+ for (n=n1;nn_un.n_strx,5);n++); -+ massert(nn_value; -+ -+ return 0; -+ -+} -+ -+ -+ -+static object -+load_memory(struct section *sec1,struct section *sece,void *v1, -+ ul *p,ul **got,ul **gote,ul *start) { -+ -+ ul sz,gsz,sa,ma,a,fl; -+ struct section *sec; -+ object memory; -+ -+ BEGIN_NO_INTERRUPT; -+ -+ for (*p=sz=ma=0,sa=-1,sec=sec1;secaddraddr; -+ ma=1<align; -+ } -+ -+ a=sec->addr+sec->size; -+ if (szflags&SECTION_TYPE; -+ if (fl==S_NON_LAZY_SYMBOL_POINTERS || fl==S_LAZY_SYMBOL_POINTERS) -+ *p+=sec->size*sizeof(struct relocation_info)/sizeof(void *); -+ -+ } -+ -+ ma=ma>sizeof(struct contblock) ? ma-1 : 0; -+ sz+=ma; -+ -+ gsz=0; -+ if (**got) { -+ gsz=(**got+1)*sizeof(**got)-1; -+ sz+=gsz; -+ } -+ -+ memory=alloc_object(t_cfdata); -+ memory->cfd.cfd_size=sz; -+ memory->cfd.cfd_self=0; -+ memory->cfd.cfd_start=0; -+ memory->cfd.cfd_start=alloc_contblock(sz); -+ -+ a=(ul)memory->cfd.cfd_start; -+ a=(a+ma)&~ma; -+ for (sec=sec1;secaddr+=a; -+ if (LOAD_SEC(sec)) -+ memcpy((void *)sec->addr,v1+sec->offset,sec->size); -+ } -+ -+ if (**got) { -+ sz=**got; -+ *got=(void *)memory->cfd.cfd_start+memory->cfd.cfd_size-gsz; -+ gsz=sizeof(**got)-1; -+ *got=(void *)(((ul)*got+gsz)&~gsz); -+ *gote=*got+sz; -+ } -+ -+ *start=a; -+ -+ END_NO_INTERRUPT; -+ -+ return memory; -+ -+} -+ -+ -+static int -+parse_file(void *v1, -+ struct section **sec1,struct section **sece, -+ struct nlist **n1,struct nlist **ne, -+ char **st1,char **ste,ul **io1) { -+ -+ struct mach_header *mh; -+ struct load_command *lc; -+ struct symtab_command *sym=NULL; -+ struct dysymtab_command *dsym=NULL; -+ struct segment_command *seg; -+ ul i; -+ void *v=v1; -+ -+ mh=v; -+ v+=sizeof(*mh); -+ -+ for (i=0,*sec1=NULL;(lc=v) && incmds;i++,v+=lc->cmdsize) -+ -+ switch(lc->cmd) { -+ -+ case LC_SEGMENT: -+ -+ if (*sec1 && *sece>*sec1) continue; -+ -+ seg=v; -+ *sec1=(void *)(seg+1); -+ *sece=*sec1+seg->nsects; -+ -+ break; -+ case LC_SYMTAB: -+ massert(!sym); -+ sym=v; -+ *n1=v1+sym->symoff; -+ *ne=*n1+sym->nsyms; -+ *st1=v1+sym->stroff; -+ *ste=*st1+sym->strsize; -+ break; -+ case LC_DYSYMTAB: -+ massert(!dsym); -+ dsym=v; -+ *io1=v1+dsym->indirectsymoff; -+ break; -+ } -+ -+ return 0; -+ -+} -+ -+ -+static int -+set_symbol_stubs(void *v1,struct nlist *n1,struct nlist *ne,ul *uio,const char *st1) { -+ -+ struct mach_header *mh; -+ struct load_command *lc; -+ struct segment_command *seg; -+ struct section *sec1,*sec,*sece; -+ ul i,ns; -+ void *v=v1,*vv; -+ int *io1,*io,*ioe; -+ -+ mh=v; -+ v+=sizeof(*mh); -+ -+ for (i=0;(lc=v) && incmds;i++,v+=lc->cmdsize) -+ -+ switch(lc->cmd) { -+ -+ case LC_SEGMENT: -+ -+ for (seg=v,sec1=sec=(void *)(seg+1),sece=sec1+seg->nsects;secflags&SECTION_TYPE; -+ if (ns!=S_SYMBOL_STUBS && -+ ns!=S_LAZY_SYMBOL_POINTERS && -+ ns!=S_NON_LAZY_SYMBOL_POINTERS) -+ continue; -+ -+ io1=(void *)uio; -+ io1+=sec->reserved1; -+ if (!sec->reserved2) sec->reserved2=sizeof(void *); -+ ioe=io1+sec->size/sec->reserved2; -+ -+ for (io=io1,vv=(void *)sec->addr;ioreserved2,io++) -+ if (*io>=0 && *ioflags&SECTION_TYPE,*io; -+ struct relocation_info *ri,*re; -+ struct scattered_relocation_info *sri; -+ -+ if (fl!=S_NON_LAZY_SYMBOL_POINTERS && fl!=S_LAZY_SYMBOL_POINTERS) -+ return 0; -+ -+ sec->nreloc=sec->size/sizeof(void *); -+ sec->reloff=*p-v1; -+ ri=*p; -+ re=ri+sec->nreloc; -+ *p=re; -+ -+ io1+=sec->reserved1; -+ for (io=io1;rir_symbolnum=*io; -+ ri->r_extern=1; -+ ri->r_address=(io-io1)*sizeof(void *); -+ ri->r_type=GENERIC_RELOC_VANILLA; -+ ri->r_pcrel=0; -+ sri=(void *)ri; -+ sri->r_scattered=0; -+ -+ } -+ -+ return 0; -+ -+} -+ -+ -+static int -+relocate_code(void *v1,struct section *sec1,struct section *sece, -+ void **p,ul *io1,struct nlist *n1,ul *got,ul *gote,ul start) { -+ -+ struct section *sec; -+ struct relocation_info *ri,*re; -+ -+ for (sec=sec1;secreloff,re=ri+sec->nreloc;rin_type & N_STAB) -+ continue; -+ if (!(sym->n_type & N_EXT)) -+ continue; -+ -+ ns++; -+ sl+=strlen(sym->n_un.n_strx+strtab)+1; -+ -+ } -+ -+ c_table.alloc_length=c_table.length=ns; -+ assert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length)); -+ assert(s=malloc(sl)); -+ -+ for (a=c_table.ptable,sym=sym1;symn_type & N_STAB) -+ continue; -+ if (!(sym->n_type & N_EXT)) -+ continue; -+ -+ a->address=sym->n_value; -+ a->string=s; -+ strcpy(s,sym->n_un.n_strx+strtab); -+ -+ a++; -+ s+=strlen(s)+1; -+ -+ } -+ -+ qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare); -+ -+ massert(!un_mmap(addr,addre)); -+ massert(!fclose(f)); -+ -+ return 0; -+ -+} -+ -+int -+seek_to_end_ofile(FILE *f) { -+ -+ struct mach_header *mh; -+ struct load_command *lc; -+ struct symtab_command *st=NULL; -+ void *addr,*addre; -+ int i; -+ -+ massert(addr=get_mmap(f,&addre)); -+ -+ mh=addr; -+ lc=addr+sizeof(*mh); -+ -+ for (i=0;incmds;i++,lc=(void *)lc+lc->cmdsize) -+ if (lc->cmd==LC_SYMTAB) { -+ st=(void *) lc; -+ break; -+ } -+ massert(st); -+ -+ fseek(f,st->stroff+st->strsize,SEEK_SET); -+ -+ massert(!un_mmap(addr,addre)); -+ -+ return 0; -+ -+} -+ -+#ifndef GOT_RELOC -+#define GOT_RELOC(a) 0 -+#endif -+ -+static int -+label_got_symbols(void *v1,struct section *sec,struct nlist *n1,struct nlist *ne,ul *gs) { -+ -+ struct relocation_info *ri,*re; -+ struct nlist *n; -+ -+ *gs=0; -+ for (n=n1;nn_desc=0; -+ -+ for (ri=v1+sec->reloff,re=ri+sec->nreloc;rir_extern); -+ n=n1+ri->r_symbolnum; -+ if (!n->n_desc) -+ n->n_desc=++*gs; -+ -+ } -+ -+ return 0; -+ -+} -+ -+ -+int -+fasload(object faslfile) { -+ -+ FILE *fp; -+ object data; -+ char filename[256]; -+ ul init_address=-1; -+ object memory; -+ void *v1,*ve,*p; -+ struct section *sec1,*sece=NULL; -+ struct nlist *n1=NULL,*ne=NULL; -+ char *st1=NULL,*ste=NULL; -+ ul gs,*got=&gs,*gote,*io1=NULL,rls,start; -+ -+ coerce_to_filename(faslfile, filename); -+ faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); -+ fp = faslfile->sm.sm_fp; -+ -+ massert(v1=get_mmap(fp,&ve)); -+ -+ parse_file(v1,&sec1,&sece,&n1,&ne,&st1,&ste,&io1); -+ -+ label_got_symbols(v1,sec1,n1,ne,got); -+ -+ massert(memory=load_memory(sec1,sece,v1,&rls,&got,&gote,&start)); -+ -+ massert(p=alloca(rls)); -+ -+ relocate_symbols(n1,ne,st1,start); -+ -+ find_init_address(n1,ne,st1,&init_address); -+ -+ relocate_code(v1,sec1,sece,&p,io1,n1,got,gote,start); -+ -+ fseek(fp,(void *)ste-v1,SEEK_SET); -+ data = feof(fp) ? 0 : read_fasl_vector(faslfile); -+ -+#ifdef CLEAR_CACHE -+ CLEAR_CACHE; -+#endif -+ -+ massert(!un_mmap(v1,ve)); -+ close_stream(faslfile); -+ -+ init_address-=(ul)memory->cfd.cfd_start; -+ call_init(init_address,memory,data,0); -+ -+ if(symbol_value(sLAload_verboseA)!=Cnil) -+ printf("start address -T %p ",memory->cfd.cfd_start); -+ -+ return(memory->cfd.cfd_size); -+ -+ } -+ -+#include "sfasli.c" ---- gcl-2.6.7.orig/o/sfasli.c -+++ gcl-2.6.7/o/sfasli.c -@@ -5,25 +5,7 @@ Copyright William Schelter. All rights r - #error Need either BFD or SPECIAL_RSYM - #endif - --#ifdef SPECIAL_RSYM -- --int node_compare(); -- -- --struct node * --find_sym_ptable(name) -- char *name; -- {struct node joe,*answ; -- joe.string=name; -- answ = (struct node *) bsearch((char *)(&joe),(char*) (c_table.ptable), -- c_table.length, -- sizeof(struct node), node_compare); -- -- return answ; -- } -- -- --#else -+#ifndef SPECIAL_RSYM - - /* Replace this with gcl's own hash structure at some point */ - static int -@@ -40,6 +22,9 @@ build_symbol_table_bfd(void) { - FEerror("I'm not an object",0); - /* if (link_info.hash) */ - /* bfd_link_hash_table_free(bself,link_info.hash); */ -+#ifdef HAVE_OUTPUT_BFD -+ link_info.output_bfd = bfd_openw("/dev/null", bfd_get_target(bself)); -+#endif - if (!(link_info.hash = bfd_link_hash_table_create (bself))) - FEerror("Cannot make hash table",0); - if (!bfd_link_add_symbols(bself,&link_info)) -@@ -110,57 +95,58 @@ build_symbol_table_bfd(void) { - - LFD(build_symbol_table)(void) { - -- - printf("Building symbol table for %s ..\n",kcl_self);fflush(stdout); - - #ifdef SPECIAL_RSYM -- { -- -- char tmpfile1[80],command[300]; - -- snprintf(tmpfile1,sizeof(tmpfile1),"rsym%d",(int)getpid()); --#ifndef STAND -- coerce_to_filename(symbol_value(sSAsystem_directoryA), -- system_directory); -+#ifndef USE_DLOPEN -+ load_self_symbols(); - #endif --#ifndef RSYM_COMMAND -- snprintf(command,sizeof(command),"%srsym %s %s",system_directory,kcl_self,tmpfile1); --#else -- RSYM_COMMAND(command,system_directory,kcl_self,tmpfile1); --#endif -- if (system(command) != 0) --#ifdef STAND -- FEerror("The rsym command %s failed .",1,command); -+ - #else -- FEerror("The rsym command ~a failed .",1, -- make_simple_string(command)); -+ -+ build_symbol_table_bfd(); -+ - #endif -- read_special_symbols(tmpfile1); -- unlink(tmpfile1); -- qsort((char*)(c_table.ptable),(int)(c_table.length),sizeof(struct node),node_compare); -- -- { -- struct node *p,*pe; -- for (p=*c_table.ptable,pe=p+c_table.length;pstring,&pa)) { --/* printf("my_plt %s %p %p\n",p->string,(void *)pa,(void *)p->address); */ -- if (p->address && p->address!=pa) -- FEerror("plt address mismatch",0); -- else -- p->address=pa; -- } -- } -- } - -- } --#else /* special_rsym */ -+} - -- build_symbol_table_bfd(); -+extern int mcount(); -+extern int _mcount(); -+extern int __divdi3(); -+extern int __moddi3(); -+extern int __udivdi3(); -+extern int __umoddi3(); -+extern void sincos(double,double *,double *); -+extern int __divsi3(); -+extern int __modsi3(); -+extern int __udivsi3(); -+extern int __umodsi3(); -+extern int $$divI(); -+extern int $$divU(); -+extern int $$remI(); -+extern int $$remU(); -+extern int __divq(); -+extern int __divqu(); -+extern int __remq(); -+extern int __remqu(); -+ -+#ifndef DARWIN -+#ifndef _WIN32 -+int -+use_symbols(double d,...) { -+ -+ sincos(d,&d,&d); - -+#ifdef GCL_GPROF -+ _mcount(); - #endif -+ -+ return (int)d; - - } -+#endif -+#endif - - void - gcl_init_sfasl() { ---- gcl-2.6.7.orig/o/gbc.c -+++ gcl-2.6.7/o/gbc.c -@@ -991,6 +991,16 @@ sweep_phase(void) { - mpz_clear(MP(x)); - } - #endif -+ -+ if (sLAlink_arrayA->s.s_dbind!=Cnil) -+ if (x->d.t == t_cfdata) { -+ unsigned long *p=(void *)sLAlink_arrayA->s.s_dbind->st.st_self; -+ unsigned long *pe=(void *)p+sLAlink_arrayA->s.s_dbind->st.st_fillp; -+ for (;p=(unsigned long)x->cfd.cfd_start && *p<(unsigned long)x->cfd.cfd_start+x->cfd.cfd_size) -+ *p=0; -+ } -+ - SET_LINK(x,f); - x->d.m = FREE; - f = x; -@@ -1286,8 +1296,7 @@ GBC(enum type t) { - #ifdef SGC - /* we don't know which pages have relblock on them */ - if(sgc_enabled) -- make_writable(page(rb_start), -- (rb_pointer-rb_start + PAGESIZE - 1)/PAGESIZE); -+ make_writable(page(rb_start),page(rb_pointer+PAGESIZE-1)); - - #endif - rb_limit = rb_end - 2*RB_GETA; -@@ -1519,22 +1528,8 @@ gcl_init_GBC(void) { - make_si_function("ROOM-REPORT", siLroom_report); - make_si_function("RESET-GBC-COUNT", siLreset_gbc_count); - make_si_function("GBC-TIME",siLgbc_time); -- - #ifdef SGC -- /* we use that maxpage is a power of 2 in this -- case, to quickly be able to look in our table */ -- { -- long i,j; -- -- for(i=j=1 ; i< 32 ; i++) -- if (MAXPAGE == (1 < -+ -+#include "windows.h" -+ -+typedef unsigned char uc; -+typedef unsigned short us; -+typedef unsigned long ul; -+ -+struct filehdr { -+ us f_magic; /* magic number */ -+ us f_nscns; /* number of sections */ -+ ul f_timdat; /* time & date stamp */ -+ ul f_ptrsym; /* file pointer to symtab */ -+ ul f_symnum; /* number of symtab entries */ -+ us f_opthdr; /* sizeof(optional hdr) */ -+ us f_flags; /* flags */ -+}; -+ -+struct opthdr { -+ us h_magic; -+ uc h_mlv; -+ uc h_nlv; -+ ul h_tsize; -+ ul h_dsize; -+ ul h_bsize; -+ ul h_maddr; -+ ul h_tbase; -+ ul h_dbase; /* = high 32 bits of ibase for PE32+, magic 0x20b*/ -+ ul h_ibase; -+}; -+ -+struct scnhdr { -+ uc s_name[8]; /* section name */ -+ ul s_paddr; /* physical address, aliased s_nlib */ -+ ul s_vaddr; /* virtual address */ -+ ul s_size; /* section size */ -+ ul s_scnptr; /* file ptr to raw data for section */ -+ ul s_relptr; /* file ptr to relocation */ -+ ul s_lnnoptr; /* file ptr to line numbers */ -+ us s_nreloc; /* number of relocation entries */ -+ us s_nlnno; /* number of line number entries*/ -+ ul s_flags; /* flags */ -+}; -+#define SEC_CODE 0x20 -+#define SEC_DATA 0x40 -+#define SEC_BSS 0x80 -+#define ALLOC_SEC(sec) (sec->s_flags&(SEC_CODE|SEC_DATA|SEC_BSS)) -+#define LOAD_SEC(sec) (sec->s_flags&(SEC_CODE|SEC_DATA)) -+ -+#define STOP(s_,op_) ({char *_s=s_,_c=_s[8];_s[8]=0;op_;_s[8]=_c;}) -+ -+struct reloc { -+ union { -+ ul r_vaddr; -+ ul r_count; /* Set to the real count when IMAGE_SCN_LNK_NRELOC_OVFL is set */ -+ } r; -+ ul r_symndx; -+ us r_type; -+} __attribute__ ((packed)); -+#define R_ABS 0x0000 /* absolute, no relocation is necessary */ -+#define R_DIR32 0x0006 /* Direct 32-bit reference to the symbols virtual address */ -+#define R_PCRLONG 0x0014 /* 32-bit reference pc relative to the symbols virtual address */ -+ -+struct syment { -+ union { -+ char n_name[8]; -+ struct { -+ int n_zeroes; -+ int n_offset; -+ } n; -+ } n; -+ ul n_value; -+ short n_scnum; -+ us n_type; -+ uc n_sclass; -+ uc n_numaux; -+} __attribute__ ((packed)); -+ -+ -+static int -+ovchk(ul v,ul m) { -+ -+ m|=m>>1; -+ v&=m; -+ -+ return (!v || v==m); -+ -+} -+ -+static int -+store_val(ul *w,ul m,ul v) { -+ -+ massert(ovchk(v,~m)); -+ *w=(v&m)|(*w&~m); -+ -+ return 0; -+ -+} -+ -+static int -+add_val(ul *w,ul m,ul v) { -+ -+ return store_val(w,m,v+(*w&m)); -+ -+} -+ -+ -+static void -+relocate(struct scnhdr *sec,struct reloc *rel,struct syment *sym) { -+ -+ ul *where=(void *)(sec->s_paddr+rel->r.r_vaddr); -+ -+ switch(rel->r_type) { -+ -+ case R_ABS: -+ break; -+ -+ case R_DIR32: -+ add_val(where,~0L,sym->n_value); -+ /* *where+=sym->n_value; */ -+ break; -+ -+ case R_PCRLONG: -+ store_val(where,~0L,sym->n_value-(ul)(where+1)); -+ /* *where=sym->n_value-(ul)(where+1); */ -+ break; -+ -+ default: -+ fprintf(stdout, "%d: unsupported relocation type.", rel->r_type); -+ FEerror("The relocation type was unknown",0); -+ -+ } -+ -+} -+ -+ -+static void -+find_init_address(struct syment *sym,struct syment *sye,ul *ptr,char *st1) { -+ -+ for(;symn_scnum == 1 && sym->n_value) -+ if (!strncmp(sym->n.n.n_zeroes ? sym->n.n_name : st1+sym->n.n.n_offset,"_init_",6)) -+ *ptr=sym->n_value; -+ -+ sym += (sym)->n_numaux; -+ -+ } -+ -+} -+ -+static void -+relocate_symbols(struct syment *sym,struct syment *sye,struct scnhdr *sec1,char *st1) { -+ -+ struct node *answ; -+ -+ for (;symn_scnum>0) -+ sym->n_value = sec1[sym->n_scnum-1].s_paddr; -+ -+ else if (!sym->n_scnum) { -+ -+ if (sym->n.n.n_zeroes) -+ STOP(sym->n.n_name,answ=find_sym_ptable(sym->n.n_name)); -+ else -+ answ=find_sym_ptable(st1+sym->n.n.n_offset); -+ -+ if (answ) sym->n_value=answ->address; -+ -+ } -+ -+ sym += (sym)->n_numaux; -+ -+ } -+ -+} -+ -+static object -+load_memory(struct scnhdr *sec1,struct scnhdr *sece,void *st) { -+ -+ object memory; -+ struct scnhdr *sec; -+ ul sz; -+ -+ BEGIN_NO_INTERRUPT; -+ -+ for (sec=sec1,sz=0;secs_size,sec++) -+ if (ALLOC_SEC(sec)) -+ sec->s_paddr=sz; -+ -+ memory = alloc_object(t_cfdata); -+ memory->cfd.cfd_size=sz; -+ memory->cfd.cfd_self=0; -+ memory->cfd.cfd_start=0; -+ memory->cfd.cfd_start=alloc_contblock(sz); -+ -+ for (sec=sec1;secs_paddr+=(ul)memory->cfd.cfd_start; -+ if (LOAD_SEC(sec)) -+ memcpy((void *)sec->s_paddr,st+sec->s_scnptr,sec->s_size); -+ } -+ -+ END_NO_INTERRUPT; -+ -+ return memory; -+ -+} -+ -+static int -+load_self_symbols() { -+ -+ FILE *f; -+ void *v1,*v,*ve; -+ struct filehdr *fhp; -+ struct syment *sy1,*sye,*sym; -+ struct scnhdr *sec1,*sec,*sece; -+ struct opthdr *h; -+ struct node *a; -+ char *st1,*st; -+ ul ns,sl,jj; -+ -+ massert(f=fopen(kcl_self,"r")); -+ massert(v1=get_mmap(f,&ve)); -+ -+ v=v1+*(ul *)(v1+0x3c); -+ massert(!memcmp("PE\0\0",v,4)); -+ -+ fhp=v+4; -+ h=(void *)(fhp+1); -+ massert(h->h_magic==0x10b || h->h_magic==0x20b); -+ massert(h->h_magic==0x10b || !h->h_dbase); /*We cannot handle a 64bit load address*/ -+ -+ sec1=(void *)(fhp+1)+fhp->f_opthdr; -+ sece=sec1+fhp->f_nscns; -+ -+ sy1=v1+fhp->f_ptrsym; -+ sye=sy1+fhp->f_symnum; -+ -+ st1=(char *)sye; -+ -+ for (ns=sl=0,sym=sy1;symn_sclass!=2 || sym->n_scnum<1) -+ continue; -+ -+ ns++; -+ -+ if (sym->n.n.n_zeroes) -+ STOP(sym->n.n_name,sl+=strlen(sym->n.n_name)+1); -+ else -+ sl+=strlen(st1+sym->n.n.n_offset)+1; -+ -+ sym+=sym->n_numaux; -+ -+ } -+ -+ c_table.alloc_length=c_table.length=ns; -+ assert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length)); -+ assert(st=malloc(sl)); -+ -+ for (a=c_table.ptable,sym=sy1;symn_sclass!=2 || sym->n_scnum<1) -+ continue; -+ -+ if (sym->n.n.n_zeroes) -+ STOP(sym->n.n_name,strcpy(st,sym->n.n_name)); -+ else -+ strcpy(st,st1+sym->n.n.n_offset); -+ -+ sec=sec1+sym->n_scnum-1; -+ jj=sym->n_value+sec->s_vaddr+h->h_ibase; -+ -+#ifdef FIX_ADDRESS -+ FIX_ADDRESS(jj); -+#endif -+ -+ a->address=jj; -+ a->string=st; -+ -+ a++; -+ st+=strlen(st)+1; -+ sym+=sym->n_numaux; -+ -+ } -+ -+ qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare); -+ -+ massert(!un_mmap(v1,ve)); -+ massert(!fclose(f)); -+ -+ return 0; -+ -+} -+ -+int -+seek_to_end_ofile(FILE *fp) { -+ -+ void *st,*ve; -+ struct filehdr *fhp; -+ struct scnhdr *sec1,*sece; -+ struct syment *sy1,*sye; -+ const char *st1,*ste; -+ int i; -+ -+ massert(st=get_mmap(fp,&ve)); -+ -+ fhp=st; -+ sec1=(void *)(fhp+1)+fhp->f_opthdr; -+ sece=sec1+fhp->f_nscns; -+ sy1=st+fhp->f_ptrsym; -+ sye=sy1+fhp->f_symnum; -+ st1=(void *)sye; -+ ste=st1+*(ul *)st1; -+ -+ fseek(fp,(void *)ste-st,0); -+ while (!(i=getc(fp))); -+ ungetc(i, fp); -+ -+ massert(!un_mmap(st,ve)); -+ -+ return 0; -+ -+} -+ -+object -+find_init_string(const char *s) { -+ -+ FILE *f; -+ struct filehdr *fhp; -+ struct scnhdr *sec1,*sece; -+ struct syment *sy1,*sym,*sye; -+ char *st1,*ste; -+ void *st,*est; -+ object o; -+ -+ massert(f=fopen(s,"r")); -+ massert(st=get_mmap(f,&est)); -+ -+ fhp=st; -+ sec1=(void *)(fhp+1)+fhp->f_opthdr; -+ sece=sec1+fhp->f_nscns; -+ sy1=st+fhp->f_ptrsym; -+ sye=sy1+fhp->f_symnum; -+ st1=(void *)sye; -+ ste=st1+*(ul *)st1; -+ -+ for (sym=sy1;symn.n.n_zeroes ? sym->n.n_name : st1+sym->n.n.n_offset; -+ -+ if (!strncmp(s,"_init_",6)) { -+ if (sym->n.n.n_zeroes) -+ STOP((char *)s,o=make_simple_string(s)); -+ else -+ o=make_simple_string(s); -+ massert(!un_mmap(st,&est)); -+ massert(!fclose(f)); -+ return o; -+ } -+ -+ } -+ -+ massert(!un_mmap(st,&est)); -+ massert(!fclose(f)); -+ massert(!"init not found"); -+ -+ return NULL; -+ -+} -+ -+int -+fasload(object faslfile) { -+ -+ struct filehdr *fhp; -+ struct scnhdr *sec1,*sec,*sece; -+ struct syment *sy1,*sye; -+ struct reloc *rel,*rele; -+ object memory, data; -+ FILE *fp; -+ char filename[MAXPATHLEN],*st1,*ste; -+ int i; -+ ul init_address=0; -+ void *st,*est; -+ -+ coerce_to_filename(faslfile, filename); -+ faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); -+ fp = faslfile->sm.sm_fp; -+ -+ massert(st=get_mmap(fp,&est)); -+ -+ fhp=st; -+ sec1=(void *)(fhp+1)+fhp->f_opthdr; -+ sece=sec1+fhp->f_nscns; -+ sy1=st+fhp->f_ptrsym; -+ sye=sy1+fhp->f_symnum; -+ st1=(void *)sye; -+ ste=st1+*(ul *)st1; -+ -+ find_init_address(sy1,sye,&init_address,st1); -+ -+ memory=load_memory(sec1,sece,st); -+ -+ relocate_symbols(sy1,sye,sec1,st1); -+ -+ for (sec=sec1;secs_flags&0xe0) -+ for (rel=st+sec->s_relptr,rele=rel+sec->s_nreloc;relr_symndx); -+ -+ fseek(fp,(void *)ste-st,0); -+ while ((i = getc(fp)) == 0); -+ ungetc(i, fp); -+ data = read_fasl_vector(faslfile); -+ -+ massert(!un_mmap(st,est)); -+ close_stream(faslfile); -+ -+#ifdef CLEAR_CACHE -+ CLEAR_CACHE; -+#endif -+ -+ call_init(init_address,memory,data,0); -+ -+ if(symbol_value(sLAload_verboseA)!=Cnil) -+ printf("start address -T %p ", memory->cfd.cfd_start); -+ -+ return(memory->cfd.cfd_size); -+ -+} -+ -+#include "sfasli.c" ---- gcl-2.6.7.orig/o/hash.d -+++ gcl-2.6.7/o/hash.d -@@ -31,6 +31,16 @@ object sKsize; - object sKrehash_size; - object sKrehash_threshold; - -+typedef union { -+ float f; -+ int i; -+} F2i; -+ -+typedef union { -+ double d; -+ int i[2]; -+} D2i; -+ - - static unsigned int - hash_eql(x) -@@ -69,11 +79,18 @@ object x; - return(hash_eql(x->rat.rat_num) + hash_eql(x->rat.rat_den)); - - case t_shortfloat: -- return(*((int *) &(sf(x)))); -+ { -+ F2i u; -+ u.f=sf(x); -+ return(u.i); -+ } - - case t_longfloat: -- {int *y = (int *) &lf(x); -- return( *y + *(y+1));} -+ { -+ D2i u; -+ u.d=lf(x); -+ return(u.i[0]+u.i[1]); -+ } - - case t_complex: - return(hash_eql(x->cmp.cmp_real) + hash_eql(x->cmp.cmp_imag)); ---- gcl-2.6.7.orig/o/unexnt.c -+++ gcl-2.6.7/o/unexnt.c -@@ -273,8 +273,8 @@ unexec (char *new_name, char *old_name, - if (strcmp (ptr, ".exe") && strcmp (ptr, ".EXE") ) - strcat (out_filename, ".exe"); - #endif -- printf ("Dumping from %s\n", in_filename); -- printf (" to %s\n", out_filename); -+ /* printf ("Dumping from %s\n", in_filename); */ -+ /* printf (" to %s\n", out_filename); */ - - /* We need to round off our heap to NT's allocation unit (64KB). */ - round_heap (get_allocation_unit ()); -@@ -292,11 +292,12 @@ unexec (char *new_name, char *old_name, - - /* The size of the dumped executable is the size of the original - executable plus the size of the heap and the size of the .bss section. */ -- heap_index_in_executable = (unsigned long) -- round_to_next ((unsigned char *) in_file.size, get_allocation_unit ()); -+ if (heap_index_in_executable==UNINIT_LONG) -+ heap_index_in_executable = (unsigned long) -+ round_to_next ((unsigned char *) in_file.size, get_allocation_unit ()); - /* from lisp we know what to use */ - #ifdef IN_UNIXSAVE -- data_region_end = round_to_next(core_end,0x10000); -+ data_region_end = round_to_next((unsigned char *)core_end,0x10000); - real_data_region_end = data_region_end; - #endif - size = heap_index_in_executable + get_committed_heap_size () + bss_size; -@@ -487,7 +488,7 @@ find_section (char * name, IMAGE_NT_HEAD - - for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) - { -- if (strcmp (section->Name, name) == 0) -+ if (strcmp ((char *)section->Name, name) == 0) - return section; - section++; - } -@@ -586,11 +587,11 @@ get_section_info (file_data *p_infile) - #else - #define DATA_SECTION ".data" - #endif -- if (!strcmp (section->Name, DATA_SECTION)) -+ if (!strcmp ((char *)section->Name, DATA_SECTION)) - { - /* The Emacs initialized data section. */ - data_section = section; -- ptr = (char *) nt_header->OptionalHeader.ImageBase + -+ ptr = (unsigned char *) nt_header->OptionalHeader.ImageBase + - section->VirtualAddress; - data_start_va = ptr; - data_start_file = section->PointerToRawData; -@@ -630,7 +631,7 @@ get_section_info (file_data *p_infile) - bss system data on the Alpha). However, in practice this doesn't - seem to matter, since presumably the system libraries always - reinitialize their bss variables. */ -- bss_start = min (my_begbss, my_begbss_static); -+ bss_start = (unsigned char *)min (my_begbss, my_begbss_static); - bss_size = max ((char *)my_endbss, (char *) my_endbss_static) - (char *) bss_start; - - #endif -@@ -647,32 +648,32 @@ copy_executable_and_dump_data_section (f - unsigned long size, index; - - /* Get a pointer to where the raw data should go in the executable file. */ -- data_file = (char *) p_outfile->file_base + data_start_file; -+ data_file = (unsigned char *) p_outfile->file_base + data_start_file; - - /* Get a pointer to the raw data in our address space. */ - data_va = data_start_va; - - size = (DWORD) data_file - (DWORD) p_outfile->file_base; -- printf ("Copying executable up to data section...\n"); -- printf ("\t0x%08x Offset in input file.\n", 0); -- printf ("\t0x%08x Offset in output file.\n", 0); -- printf ("\t0x%08lx Size in bytes.\n", size); -+ /* printf ("Copying executable up to data section...\n"); */ -+ /* printf ("\t0x%08x Offset in input file.\n", 0); */ -+ /* printf ("\t0x%08x Offset in output file.\n", 0); */ -+ /* printf ("\t0x%08lx Size in bytes.\n", size); */ - memcpy (p_outfile->file_base, p_infile->file_base, size); - - size = data_size; -- printf ("Dumping .data section...\n"); -- printf ("\t0x%p Address in process.\n", data_va); -- printf ("\t0x%08x Offset in output file.\n", -- data_file - p_outfile->file_base); -- printf ("\t0x%08lx Size in bytes.\n", size); -+ /* printf ("Dumping .data section...\n"); */ -+ /* printf ("\t0x%p Address in process.\n", data_va); */ -+ /* printf ("\t0x%08x Offset in output file.\n", */ -+ /* data_file - p_outfile->file_base); */ -+ /* printf ("\t0x%08lx Size in bytes.\n", size); */ - memcpy (data_file, data_va, size); - - index = (DWORD) data_file + size - (DWORD) p_outfile->file_base; - size = p_infile->size - index; -- printf ("Copying rest of executable...\n"); -- printf ("\t0x%08lx Offset in input file.\n", index); -- printf ("\t0x%08lx Offset in output file.\n", index); -- printf ("\t0x%08lx Size in bytes.\n", size); -+ /* printf ("Copying rest of executable...\n"); */ -+ /* printf ("\t0x%08lx Offset in input file.\n", index); */ -+ /* printf ("\t0x%08lx Offset in output file.\n", index); */ -+ /* printf ("\t0x%08lx Size in bytes.\n", size); */ - memcpy ((char *) p_outfile->file_base + index, - (char *) p_infile->file_base + index, size); - } -@@ -683,27 +684,27 @@ dump_bss_and_heap (file_data *p_infile, - unsigned char *heap_data, *bss_data; - unsigned long size, index; - -- printf ("Dumping heap into executable...\n"); -+ /* printf ("Dumping heap into executable...\n"); */ - - index = heap_index_in_executable; - size = get_committed_heap_size (); - heap_data = get_heap_start (); - -- printf ("\t0x%p Heap start in process.\n", heap_data); -- printf ("\t0x%08lx Heap offset in executable.\n", index); -- printf ("\t0x%08lx Heap size in bytes.\n", size); -+ /* printf ("\t0x%p Heap start in process.\n", heap_data); */ -+ /* printf ("\t0x%08lx Heap offset in executable.\n", index); */ -+ /* printf ("\t0x%08lx Heap size in bytes.\n", size); */ - - memcpy ((PUCHAR) p_outfile->file_base + index, heap_data, size); - -- printf ("Dumping .bss into executable...\n"); -+ /* printf ("Dumping .bss into executable...\n"); */ - - index += size; - size = bss_size; - bss_data = bss_start; - -- printf ("\t0x%p BSS start in process.\n", bss_data); -- printf ("\t0x%08lx BSS offset in executable.\n", index); -- printf ("\t0x%08lx BSS size in bytes.\n", size); -+ /* printf ("\t0x%p BSS start in process.\n", bss_data); */ -+ /* printf ("\t0x%08lx BSS offset in executable.\n", index); */ -+ /* printf ("\t0x%08lx BSS size in bytes.\n", size); */ - memcpy ((char *) p_outfile->file_base + index, bss_data, size); - } - -@@ -998,7 +999,7 @@ sbrk (unsigned long increment) - /* Allocate our heap if we haven't done so already. */ - if (data_region_base == UNINIT_PTR) - { -- data_region_base = allocate_heap (); -+ data_region_base = (unsigned char *)allocate_heap (); - if (!data_region_base) - return NULL; - -@@ -1136,6 +1137,7 @@ _heap_term (void) - #ifdef UNIXSAVE - BOOL ctrl_c_handler (unsigned long type) - { -+ extern void sigint(void); - sigint(); - return 0; - ---- gcl-2.6.7.orig/o/format.c -+++ gcl-2.6.7/o/format.c -@@ -1020,13 +1020,16 @@ fmt_fix_float(bool colon, bool atsign) - int w=0, d=0, k=0, overflowchar=0, padchar=0; - double f; - int sign; -- char buff[256], *b, buff1[256]; -+ char *buff, *b, *buff1; - int exp; - int i, j; - object x; - int n, m; - vs_mark; - -+ massert(buff=alloca(256)); /*from automatic array -- work around for persistent gcc alpha bug*/ -+ massert(buff1=alloca(256)); -+ - b = buff1 + 1; - - fmt_not_colon(colon); ---- gcl-2.6.7.orig/o/mingfile.c -+++ gcl-2.6.7/o/mingfile.c -@@ -1,5 +1,6 @@ - #include "include.h" - #include "windows.h" -+#include "winsock2.h" - - extern object truename(object); - extern object make_pathname(); -@@ -52,3 +53,12 @@ void Ldirectory ( void ) - } - } - -+int -+mingwlisten(FILE *fp) { -+ -+ int c = 0; -+ ioctlsocket(fileno(fp), FIONREAD, (void *)&c); -+ if (c<=0) -+ return 1; -+ return 0; -+} ---- gcl-2.6.7.orig/o/unixtime.c -+++ gcl-2.6.7/o/unixtime.c -@@ -176,6 +176,35 @@ LFD(Lget_internal_run_time)(void) - } - - -+DEFUN_NEW("GETTIMEOFDAY",object,fSgettimeofday,SI,0,0,NONE,OO,OO,OO,OO,(void),"Return time with maximum resolution") { -+#ifdef __MINGW32__ -+ LARGE_INTEGER uu,ticks; -+ if (QueryPerformanceFrequency(&ticks)) { -+ QueryPerformanceCounter(&uu); -+ return make_longfloat((longfloat)uu.QuadPart/ticks.QuadPart); -+ } else { -+ FEerror("microsecond timing not available",0); -+ return Cnil; -+ /* static struct timeb t0; */ -+ /* static unsigned u; */ -+ /* struct timeb t; */ -+ /* ftime(&t); */ -+ /* if (t.time!=t0.time || t.millitm!=t0.millitm) {t0=t;u=0;} */ -+ /* u++; */ -+ /* return make_longfloat(((longfloat)t.time+1.0e-3*t.millitm+1.0e-6*(u%1000))); */ -+ } -+#endif -+#ifdef BSD -+ struct timeval tzp; -+ gettimeofday(&tzp,0); -+ return make_longfloat((longfloat)tzp.tv_sec+1.0e-6*tzp.tv_usec); -+#endif -+#ifdef ATT -+ return make_longfloat((longfloat)time(0)); -+#endif -+} -+ -+ - DEFUN_NEW("GET-INTERNAL-REAL-TIME",object,fLget_internal_real_time,LISP,0,0,NONE,OO,OO,OO,OO,(void),"Run time relative to beginning") - - { ---- gcl-2.6.7.orig/o/usig2_aux.c -+++ gcl-2.6.7/o/usig2_aux.c -@@ -11,7 +11,6 @@ XS(CMPtemp); - XS(CMPtemp1); - XS(CMPtemp2); - XS(CMPtemp3); --XSI(FIXtemp); - XSI(PRINTarray); - XSI(PRINTbase); - XS(PRINTcase); ---- gcl-2.6.7.orig/o/array.c -+++ gcl-2.6.7/o/array.c -@@ -1491,15 +1491,15 @@ DEFUN_NEW("ASET-BY-CURSOR",object,fSaset - ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], - ind[50],ind[51],ind[52],ind[53],ind[54],ind[55],ind[56], - ind[57],ind[58],ind[59],ind[60],ind[61],ind[62]);break; -- case 64: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], -- ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], -- ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], -- ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], -- ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], -- ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], -- ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], -- ind[50],ind[51],ind[52],ind[53],ind[54],ind[55],ind[56], -- ind[57],ind[58],ind[59],ind[60],ind[61],ind[62],ind[63]);break; -+/* case 64: (*FFN(fSaset))(ind[0],ind[1],ind[2],ind[3],ind[4],ind[5],ind[6],ind[7], */ -+/* ind[8],ind[9],ind[10],ind[11],ind[12],ind[13],ind[14], */ -+/* ind[15],ind[16],ind[17],ind[18],ind[19],ind[20],ind[21], */ -+/* ind[22],ind[23],ind[24],ind[25],ind[26],ind[27],ind[28], */ -+/* ind[29],ind[30],ind[31],ind[32],ind[33],ind[34],ind[35], */ -+/* ind[36],ind[37],ind[38],ind[39],ind[40],ind[41],ind[42], */ -+/* ind[43],ind[44],ind[45],ind[46],ind[47],ind[48],ind[49], */ -+/* ind[50],ind[51],ind[52],ind[53],ind[54],ind[55],ind[56], */ -+/* ind[57],ind[58],ind[59],ind[60],ind[61],ind[62],ind[63]);break; */ - default: FEerror("Exceeded call-arguments-limit ",0); - } - ---- gcl-2.6.7.orig/o/error.c -+++ gcl-2.6.7/o/error.c -@@ -35,6 +35,21 @@ static object null_string; - object sSterminal_interrupt; - - void -+assert_error(const char *a,unsigned l,const char *f,const char *n) { -+ -+ if (initflag) -+ FEerror("The assertion ~a on line ~a of ~a in function ~a failed",4, -+ make_simple_string(a),make_fixnum(l), -+ make_simple_string(f),make_simple_string(n)); -+ else { -+ fprintf(stderr,"The assertion %s on line %d of %s in function %s failed",a,l,f,n); -+ exit(-1); -+ } -+ -+} -+ -+ -+void - terminal_interrupt(int correctable) - { - signals_allowed = sig_normal; -@@ -233,9 +248,9 @@ DEFUNO_NEW("CERROR",object,fLcerror,LISP - va_list ap; - - b[0]=sKerror; -- b[1]=Cnil; -+ b[1]=Ct; - b[2]=ihs_top_function_name(ihs_top-1); -- b[3]=null_string; -+ b[3]=continue_fmt_string; - b[4]=fmt_string; - i=4; - n--; ---- gcl-2.6.7.orig/o/big.c -+++ gcl-2.6.7/o/big.c -@@ -48,15 +48,24 @@ read.d: normalize_big_to_object - #include - #include "include.h" - --static void* (*gcl_gmp_allocfun)(size_t) = alloc_relblock; -+#ifdef STATIC_FUNCTION_POINTERS -+static void* alloc_relblock_static (size_t n) {return alloc_relblock (n);} -+static void* alloc_contblock_static(size_t n) {return alloc_contblock(n);} -+#endif -+ -+void* (*gcl_gmp_allocfun)(size_t)=FFN(alloc_relblock); -+int gmp_relocatable=1; -+ - - DEFUN_NEW("SET-GMP-ALLOCATE-RELOCATABLE",object,fSset_gmp_allocate_relocatable,SI,1,1,NONE,OO,OO,OO,OO, - (object flag),"Set the allocation to be relocatble ") - { - if (flag == Ct) { -- gcl_gmp_allocfun = alloc_relblock; -+ gcl_gmp_allocfun = FFN(alloc_relblock); -+ gmp_relocatable=1; - } else { -- gcl_gmp_allocfun = alloc_contblock; -+ gcl_gmp_allocfun = FFN(alloc_contblock); -+ gmp_relocatable=0; - } - RETURN1(flag); - } ---- gcl-2.6.7.orig/o/gmp_big.c -+++ gcl-2.6.7/o/gmp_big.c -@@ -302,10 +302,56 @@ big_minus(object x) - /* } */ - - -+#ifndef IEEEFLOAT -+#error big_to_double requires IEEEFLOAT -+#endif -+ -+ -+static int -+double_exponent(double d) { -+ -+ union {double d;int i[2];} u; -+ -+ if (d == 0.0) -+ return(0); -+ -+ u.d=d; -+ return (((u.i[HIND] & 0x7ff00000) >> 20) - 1022); -+ -+} -+ -+static double -+set_exponent(double d, int e) { -+ -+ union {double d;int i[2];} u; -+ -+ if (d == 0.0) -+ return(0.0); -+ -+ u.d=d; -+ u.i[HIND]= (u.i[HIND] & 0x800fffff) | (((e + 1022) << 20) & 0x7ff00000); -+ return(u.d); -+ -+} -+ - double --big_to_double(object x) --{ -- return mpz_get_d(MP(x)); -+big_to_double(object x) { -+ -+ double d=mpz_get_d(MP(x)); -+ int s=mpz_sizeinbase(MP(x),2); -+ if (s>=54 && mpz_tstbit(MP(x),s-54)) { -+ -+ union {double d;int i[2];} u; -+ -+ u.i[HIND]=0; -+ u.i[LIND]=1; -+ -+ d+=(d>0.0 ? 1.0 : -1.0)*set_exponent(u.d,double_exponent(d)-53); -+ -+ } -+ -+ return d; -+ - } - - -@@ -438,8 +484,7 @@ maybe_replace_big(object x) - if (MP_SIZE(x) == 0) return small_fixnum(0); - if (mpz_fits_sint_p(MP(x))) { - MP_INT *u = MP(x); -- signed long int xx = mpz_get_si(u); -- return make_fixnum(xx); -+ return make_fixnum(mpz_get_si(u)); - } - return make_bignum(MP(x)); - } ---- gcl-2.6.7.orig/o/sockets.c -+++ gcl-2.6.7/o/sockets.c -@@ -213,7 +213,7 @@ DEFUN_NEW("ACCEPT-SOCKET-CONNECTION",obj - and returns (list* named_socket fd name1) when one is established") - - { -- unsigned n; -+ socklen_t n; - int fd; - struct sockaddr_in addr; - object x; -@@ -262,7 +262,12 @@ DEFUN_NEW("HOSTNAME-TO-HOSTID",object,fS - char buf[300]; - char *p; - p = lisp_copy_to_null_terminated(host,buf,sizeof(buf)); -- h = gethostbyname(p); -+ h = /* gethostbyname(p); */ -+#ifdef STATIC_LINKING -+ NULL; -+#else -+ gethostbyname(p); -+#endif - if (p != buf) free (p); - if (h && h->h_addr_list[0]) - return -@@ -288,7 +293,12 @@ DEFUN_NEW("HOSTID-TO-HOSTNAME",object,fS - char buf[300]; - hostid = lisp_copy_to_null_terminated(host_id,buf,sizeof(buf)); - addr.s_addr = inet_addr(hostid); -- h = gethostbyaddr((char *)&addr, 4, AF_INET); -+ h = /* gethostbyaddr((char *)&addr, 4, AF_INET); */ -+#ifdef STATIC_LINKING -+ NULL; -+#else -+ gethostbyaddr((char *)&addr, 4, AF_INET); -+#endif - if (h && h->h_name && *h->h_name) - return make_simple_string(h->h_name); - else ---- gcl-2.6.7.orig/o/file.d -+++ gcl-2.6.7/o/file.d -@@ -742,16 +742,16 @@ BEGIN: - #else - c = getOneChar(strm->sm.sm_fp); - #endif -- if (c == EOF) { -- if (xkclfeof(c,strm->sm.sm_fp)) -- end_of_stream(strm); -- else c = getOneChar(strm->sm.sm_fp); -- if (c == EOF) end_of_stream(strm); -- } -+/* if (c == EOF) { */ -+/* if (xkclfeof(c,strm->sm.sm_fp)) */ -+/* end_of_stream(strm); */ -+/* else c = getOneChar(strm->sm.sm_fp); */ -+/* if (c == EOF) end_of_stream(strm); */ -+/* } */ - -- c &= 0377; -+/* c &= 0377; */ - /* strm->sm.sm_int0++; */ -- return(c); -+ return(c==EOF ? c : (c&0377)); - - case smm_synonym: - strm = symbol_value(strm->sm.sm_object0); -@@ -1119,6 +1119,7 @@ stream_at_end(object strm) { - BEGIN: - switch (strm->sm.sm_mode) { - case smm_socket: -+ listen_stream(strm); - if (SOCKET_STREAM_FD(strm)>=0) - return(FALSE); - else return(TRUE); -@@ -1126,6 +1127,8 @@ BEGIN: - case smm_input: - if (strm->sm.sm_fp == NULL) - closed_stream(strm); -+ if (isatty(fileno(strm->sm.sm_fp)) && !listen_stream(strm)) -+ return(feof(strm->sm.sm_fp) ? TRUE : FALSE); - {int prev_signals_allowed = signals_allowed; - AGAIN: - signals_allowed= sig_at_read; -@@ -1219,19 +1222,22 @@ BEGIN: - switch (strm->sm.sm_mode) { - #ifdef HAVE_NSOCKET - case smm_socket: -- { -- fd_set fds; -- struct timeval tv; -- FD_ZERO(&fds); -- FD_SET(SOCKET_STREAM_FD(strm),&fds); -- memset(&tv,0,sizeof(tv)); -- return select(SOCKET_STREAM_FD(strm)+1,&fds,NULL,NULL,&tv)>0 ? TRUE : FALSE; -- } --/* { int ch = getCharGclSocket(strm,Cnil); */ --/* if (ch == EOF) return FALSE; */ --/* else unreadc_stream(ch,strm); */ --/* return TRUE; */ --/* } */ -+ -+ if (SOCKET_STREAM_BUFFER(strm)->ust.ust_fillp>0) return TRUE; -+ -+ /* { */ -+ /* fd_set fds; */ -+ /* struct timeval tv; */ -+ /* FD_ZERO(&fds); */ -+ /* FD_SET(SOCKET_STREAM_FD(strm),&fds); */ -+ /* memset(&tv,0,sizeof(tv)); */ -+ /* return select(SOCKET_STREAM_FD(strm)+1,&fds,NULL,NULL,&tv)>0 ? TRUE : FALSE; */ -+ /* } */ -+ { int ch = getCharGclSocket(strm,Cnil); -+ if (ch == EOF) return FALSE; -+ else unreadc_stream(ch,strm); -+ return TRUE; -+ } - #endif - - case smm_input: -@@ -1490,30 +1496,30 @@ BEGIN: - } - - void --load(s) --char *s; --{ -- object filename, strm, x; -- vs_mark; -+load(const char *s) { -+ -+ object filename, strm, x; -+ vs_mark; -+ -+ if (user_match(s,strlen(s))) -+ return; -+ filename = make_simple_string(s); -+ vs_push(filename); -+ strm = open_stream(filename, smm_input, Cnil, sKerror); -+ vs_push(strm); -+ for (;;) { -+ preserving_whitespace_flag = FALSE; -+ detect_eos_flag = TRUE; -+ x = read_object_non_recursive(strm); -+ if (x == OBJNULL) -+ break; -+ vs_push(x); -+ ieval(x); -+ vs_popp; -+ } -+ close_stream(strm); -+ vs_reset; - -- if (user_match(s,strlen(s))) -- return; -- filename = make_simple_string(s); -- vs_push(filename); -- strm = open_stream(filename, smm_input, Cnil, sKerror); -- vs_push(strm); -- for (;;) { -- preserving_whitespace_flag = FALSE; -- detect_eos_flag = TRUE; -- x = read_object_non_recursive(strm); -- if (x == OBJNULL) -- break; -- vs_push(x); -- ieval(x); -- vs_popp; -- } -- close_stream(strm); -- vs_reset; - } - - -@@ -1754,6 +1760,8 @@ LFD(Lstream_element_type)() - FEerror("~S is an illegal DIRECTION for OPEN.", - 1, direction); - strm = open_stream(filename, smm, if_exists, if_does_not_exist); -+ if (type_of(strm) == t_stream) -+ strm->sm.sm_object0 = element_type; - @(return strm) - @) - -@@ -2288,7 +2296,7 @@ static object - maccept(object x) { - - int fd; -- unsigned n; -+ socklen_t n; - struct sockaddr_in addr; - object server,host,port; - -@@ -2296,7 +2304,7 @@ maccept(object x) { - FEerror("~S is not a steam~%",1,x); - if (x->sm.sm_mode!=smm_two_way) - FEerror("~S is not a two-way steam~%",1,x); -- fd=accept(SOCKET_STREAM_FD(STREAM_INPUT_STREAM(x)),(struct sockaddr *)&addr, &n); -+ fd=accept(SOCKET_STREAM_FD(STREAM_INPUT_STREAM(x)),(struct sockaddr *)&addr,&n); - if (fd <0) { - FEerror("Error ~S on accepting connection to ~S~%",2,make_simple_string(strerror(errno)),x); - x=Cnil; -@@ -2323,7 +2331,7 @@ maccept(object x) { - static void - rmc(int e,void *pid) { - -- kill((int)pid,SIGTERM); -+ kill((long)pid,SIGTERM); - - } - #endif -@@ -2369,7 +2377,7 @@ object x=Cnil; - #ifdef BSD - if (isServer && daemon != Cnil) { - -- int pid,i; -+ long pid,i; - struct rlimit r; - struct sigaction sa; - -@@ -2659,9 +2667,8 @@ gcl_init_file_function() - - - object --read_fasl_data(str) --char *str; --{ -+read_fasl_data(const char *str) { -+ - object faslfile, data; - #ifndef SEEK_TO_END_OFILE - #if defined(BSD) && defined(UNIX) ---- gcl-2.6.7.orig/o/symbol.d -+++ gcl-2.6.7/o/symbol.d -@@ -489,16 +489,15 @@ DEFVAR("*GENSYM-COUNTER*",sLgensym_count - object this_gensym_prefix,big; - object this_gensym_counter; - @ -- this_gensym_prefix=gensym_prefix; -- this_gensym_counter=sLgensym_counter->s.s_dbind; -- if (type_of(x) == t_string) -+ if (type_of(x) == t_string) { - this_gensym_prefix = x; -- else { -+ this_gensym_counter=sLgensym_counter->s.s_dbind; -+ sLgensym_counter->s.s_dbind=number_plus(sLgensym_counter->s.s_dbind,small_fixnum(1)); -+ } else { - check_type_non_negative_integer(&x); - this_gensym_counter=x; -+ this_gensym_prefix=gensym_prefix; - } -- if (x==gensym_prefix) -- sLgensym_counter->s.s_dbind=number_plus(sLgensym_counter->s.s_dbind,small_fixnum(1)); - - switch (type_of(this_gensym_counter)) { - case t_bignum: ---- gcl-2.6.7.orig/o/regexpr.c -+++ gcl-2.6.7/o/regexpr.c -@@ -152,7 +152,7 @@ be over written. \ - - else if (case_fold != case_fold_search || len != strlen(buf) || memcmp(pattern->ust.ust_self,buf,len)) - -- compiled_regexp=saved_compiled_regexp=(regexp *)fScompile_regexp(pattern)->v.v_self; -+ compiled_regexp=saved_compiled_regexp=(regexp *)FFN(fScompile_regexp)(pattern)->v.v_self; - - - str=string->st.st_self; ---- gcl-2.6.7.orig/o/main.c -+++ gcl-2.6.7/o/main.c -@@ -98,7 +98,6 @@ static object stack_space; - - #ifdef _WIN32 - unsigned int _dbegin = 0x10100000; --unsigned int _stacktop, _stackbottom; - #endif - - int cssize; -@@ -117,12 +116,6 @@ void install_segmentation_catcher(void); - #endif - #endif - --#ifdef NEED_NONRANDOM_SBRK --#include --#include --#include --#endif -- - int - main(int argc, char **argv, char **envp) { - #ifdef BSD -@@ -131,33 +124,47 @@ main(int argc, char **argv, char **envp) - #endif - #endif - --#ifdef NEED_NONRANDOM_SBRK --#if SIZEOF_LONG == 4 -- if (!syscall(SYS_personality,PER_LINUX32)) --#else -- if (!syscall(SYS_personality,PER_LINUX)) -+#ifdef RECREATE_HEAP -+ RECREATE_HEAP - #endif -- execvp(argv[0],argv); -+ -+#ifdef UNIX -+/* -+ if (argv[0][0] != '/') -+ error("can't get the program name"); -+*/ -+#ifdef GET_FULL_PATH_SELF -+ GET_FULL_PATH_SELF(kcl_self); -+#else -+ kcl_self = argv[0]; - #endif -+#ifdef FIX_FILENAME -+ { int n = strlen(kcl_self); -+ FIX_FILENAME(Cnil,kcl_self); -+ if (strlen(kcl_self)> n) error("name grew"); -+ } -+#endif -+ *argv=kcl_self; - --#if defined(DARWIN) -- extern void init_darwin_zone_compat (); -- init_darwin_zone_compat (); -+#ifdef CAN_UNRANDOMIZE_SBRK -+#include -+#include -+#include "unrandomize.h" - #endif - --#ifdef RECREATE_HEAP -- RECREATE_HEAP -+#ifdef LD_BIND_NOW -+#include -+#include -+#include "ld_bind_now.h" - #endif -- --#ifdef _WIN32 -- { -- unsigned int dummy; -- -- _stackbottom = (unsigned int ) &dummy; -- _stacktop = _stackbottom - 0x10000; // ??? - -- } -+#if defined(DARWIN) -+ { -+ extern void init_darwin_zone_compat (); -+ init_darwin_zone_compat (); -+ } - #endif -+ - setbuf(stdin, stdin_buf); - setbuf(stdout, stdout_buf); - #ifdef _WIN32 -@@ -172,22 +179,6 @@ main(int argc, char **argv, char **envp) - ENVP = envp; - #endif - --#ifdef UNIX --/* -- if (argv[0][0] != '/') -- error("can't get the program name"); --*/ --#ifdef GET_FULL_PATH_SELF -- GET_FULL_PATH_SELF(kcl_self); --#else -- kcl_self = argv[0]; --#endif --#ifdef FIX_FILENAME -- { int n = strlen(kcl_self); -- FIX_FILENAME(Cnil,kcl_self); -- if (strlen(kcl_self)> n) error("name grew"); -- } --#endif - if (!initflag) { - - system_directory= (char *) malloc(strlen(argv[1])+3); -@@ -265,7 +256,7 @@ main(int argc, char **argv, char **envp) - #ifdef RLIMIT_STACK - { - unsigned long mss; -- mss=16*sizeof(short)*MAXPAGE; /* i.e. short foo[MAXPAGE] on stack in sgc_start */ -+ mss=(MAXPAGE/64)<sm.sm_object0->sm.sm_fp = stdin; -@@ -373,9 +370,8 @@ main(int argc, char **argv, char **envp) - } - - #ifdef USE_DLOPEN -- unlink_loaded_files(); -+ unlink_loaded_files(); - #endif -- - exit(0); - } - -@@ -385,6 +381,9 @@ main(int argc, char **argv, char **envp) - fflush(stdout); - - initlisp(); -+#ifdef _WIN32 -+ detect_wine(); -+#endif - - vs_base = vs_top; - ihs_push(Cnil); -@@ -394,7 +393,9 @@ main(int argc, char **argv, char **envp) - - CMPtemp = CMPtemp1 = CMPtemp2 = CMPtemp3 = OBJNULL; - -+#ifdef HAVE_LIBBFD - parse_plt(); -+#endif - gcl_init_init(); - - sLApackageA->s.s_dbind = user_package; -@@ -448,15 +449,15 @@ error(char *s) - static void - initlisp(void) { - -- int j; -+ void *v=&v,*vv=Cnil; - -- if (NULL_OR_ON_C_STACK(&j) == 0 -- || NULL_OR_ON_C_STACK(Cnil) != 0 -- || (((unsigned long )core_end) !=0 -+ if (NULL_OR_ON_C_STACK(v) == 0 -+ || NULL_OR_ON_C_STACK(vv) != 0 -+ || (((unsigned long)core_end) !=0 - && NULL_OR_ON_C_STACK(core_end) != 0)) -- { /* check person has correct definition of above */ -- error("NULL_OR_ON_C_STACK macro invalid"); -- } -+ /* check person has correct definition of above */ -+ error("NULL_OR_ON_C_STACK macro invalid"); -+ - gcl_init_alloc(); - - Dotnil_body.t = (short)t_symbol; -@@ -470,27 +471,27 @@ initlisp(void) { - Dotnil_body.s_stype = (short)stp_constant; - Dotnil_body.s_mflag = FALSE; - -- Cnil_body.t = (short)t_symbol; -- Cnil_body.s_dbind = Cnil; -- Cnil_body.s_sfdef = NOT_SPECIAL; -- Cnil_body.s_fillp = 3; -- Cnil_body.s_self = "NIL"; -- Cnil_body.s_gfdef = OBJNULL; -- Cnil_body.s_plist = Cnil; -- Cnil_body.s_hpack = Cnil; -- Cnil_body.s_stype = (short)stp_constant; -- Cnil_body.s_mflag = FALSE; -+ Cnil_body.s.t = (short)t_symbol; -+ Cnil_body.s.s_dbind = Cnil; -+ Cnil_body.s.s_sfdef = NOT_SPECIAL; -+ Cnil_body.s.s_fillp = 3; -+ Cnil_body.s.s_self = "NIL"; -+ Cnil_body.s.s_gfdef = OBJNULL; -+ Cnil_body.s.s_plist = Cnil; -+ Cnil_body.s.s_hpack = Cnil; -+ Cnil_body.s.s_stype = (short)stp_constant; -+ Cnil_body.s.s_mflag = FALSE; - -- Ct_body.t = (short)t_symbol; -- Ct_body.s_dbind = Ct; -- Ct_body.s_sfdef = NOT_SPECIAL; -- Ct_body.s_fillp = 1; -- Ct_body.s_self = "T"; -- Ct_body.s_gfdef = OBJNULL; -- Ct_body.s_plist = Cnil; -- Ct_body.s_hpack = Cnil; -- Ct_body.s_stype = (short)stp_constant; -- Ct_body.s_mflag = FALSE; -+ Ct_body.s.t = (short)t_symbol; -+ Ct_body.s.s_dbind = Ct; -+ Ct_body.s.s_sfdef = NOT_SPECIAL; -+ Ct_body.s.s_fillp = 1; -+ Ct_body.s.s_self = "T"; -+ Ct_body.s.s_gfdef = OBJNULL; -+ Ct_body.s.s_plist = Cnil; -+ Ct_body.s.s_hpack = Cnil; -+ Ct_body.s.s_stype = (short)stp_constant; -+ Ct_body.s.s_mflag = FALSE; - - gcl_init_symbol(); - -@@ -686,6 +687,7 @@ DEFUNO_NEW("BYE",object,fLbye,LISP - - } - -+ - DEFUN_NEW("QUIT",object,fLquit,LISP - ,0,1,NONE,OI,OO,OO,OO,(fixnum exitc),"") - { return FFN(fLbye)(exitc); } -@@ -813,20 +815,17 @@ LFD(siLreset_stack_limits)(void) - } - - #define COPYSTACK(org,p,typ,lim,top,geta,size) \ -- do{int leng,topl; \ -- bcopy(org,p,leng=(stack_multiple*size*sizeof(typ))); \ -- topl= top - org; \ -- org=(typ *)p; top = org +topl;\ -- p=p+leng+(STACK_OVER+1)*geta*sizeof(typ); \ -- lim = ((typ *)p) - (STACK_OVER+1)*geta; \ -- }while (0) -+ {unsigned long topl=top-org;\ -+ bcopy(org,p,(lim-org)*sizeof(typ));\ -+ org=p;\ -+ top=org+topl;\ -+ lim=org+stack_multiple*size;\ -+ p=lim+(STACK_OVER+1)*geta;\ -+ } - - static int - multiply_stacks(int m) { --/* int n; */ --/* object x; */ --/* object gc_pro=stack_space; */ -- char *p; -+ void *p; - int vs,bd,frs,ihs; - stack_multiple=stack_multiple*m; - #define ELTSIZE(x) (((char *)((x)+1)) - ((char *) x)) -@@ -872,7 +871,22 @@ FFN(siLaddress)(void) { - static void - FFN(siLnani)(void) { - check_arg(1); -- vs_base[0] = (object)fixint(vs_base[0]); -+ -+ /*This is temporary, 2.6.x does not have 64bit fixnums on 64bit machines*/ -+ switch (type_of(vs_base[0])) { -+ case t_fixnum: -+ vs_base[0]=(object)fix(vs_base[0]); -+ break; -+ case t_bignum: -+ if (mpz_fits_slong_p(MP(vs_base[0]))) { -+ MP_INT *u = MP(vs_base[0]); -+ vs_base[0]=(object)mpz_get_si(u); -+ break; -+ } -+ default: -+ FEerror("Cannot coerce ~s to an address",1,vs_base[0]); -+ } -+ - } - - static void -@@ -1072,11 +1086,18 @@ init_main(void) { - #endif - #endif - ADD_FEATURE("UNEXEC"); -+#ifdef HAVE_XGCL -+ ADD_FEATURE("XGCL"); -+#endif - - #ifdef HAVE_GNU_LD - ADD_FEATURE("GNU-LD"); - #endif - -+#ifdef STATIC_LINKING -+ ADD_FEATURE("STATIC"); -+#endif -+ - make_special("*FEATURES*",features);} - - make_si_function("SAVE-SYSTEM", siLsave_system); ---- gcl-2.6.7.orig/o/unexmacosx.c -+++ gcl-2.6.7/o/unexmacosx.c -@@ -1,42 +1,21 @@ --/* Dump Emacs in Mach-O format for use on Mac OS X. -- Copyright (C) 2001, 2002 Free Software Foundation, Inc. -+/* Dump Gcl in Mach-O format for use on Mac OS X. -+ Copyright (C) 2001, 2002, 2003, 2004, 2005, -+ 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - --This file is part of GNU Emacs. -+This file is part of GNU Gcl. - --GNU Emacs is free software; you can redistribute it and/or modify -+GNU Gcl 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, or (at your option) --any later version. -+the Free Software Foundation, either version 3 of the License, or -+(at your option) any later version. - --GNU Emacs is distributed in the hope that it will be useful, -+GNU Gcl 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 GNU Emacs; see the file COPYING. If not, write to --the Free Software Foundation, Inc., 59 Temple Place - Suite 330, --Boston, MA 02111-1307, USA. */ -- --/* -- --This file is part of GNU Common Lisp, herein referred to as GCL -- --GCL is free software; you can redistribute it and/or modify it under --the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by --the Free Software Foundation; either version 2, or (at your option) --any later version. -- --GCL 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 Library General Public --License for more details. -- --You should have received a copy of the GNU Library General Public License --along with GCL; see the file COPYING. If not, write to the Free Software --Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -- --*/ -+along with GNU Gcl. If not, see . */ - - /* Contributed by Andrew Choi (akochoi@mac.com). */ - -@@ -48,24 +27,24 @@ Foundation, 675 Mass Ave, Cambridge, MA - mach header (-h option) and the load commands (-l option) in a - Mach-O file. The tool nm on Mac OS X displays the symbol table in - a Mach-O file. For examples of unexec for the Mach-O format, see -- the file unexnext.c in the GNU Emacs distribution, the file -- unexdyld.c in the Darwin port of GNU Emacs 20.7, and unexdyld.c in -- the Darwin port of XEmacs 21.1. Also the Darwin Libc source -+ the file unexnext.c in the GNU Gcl distribution, the file -+ unexdyld.c in the Darwin port of GNU Gcl 20.7, and unexdyld.c in -+ the Darwin port of XGcl 21.1. Also the Darwin Libc source - contains the source code for malloc_freezedry and malloc_jumpstart. - Read that to see what they do. This file was written completely - from scratch, making use of information from the above sources. */ - - /* The Mac OS X implementation of unexec makes use of Darwin's `zone' -- memory allocator. All calls to malloc, realloc, and free in Emacs -+ memory allocator. All calls to malloc, realloc, and free in Gcl - are redirected to unexec_malloc, unexec_realloc, and unexec_free in -- this file. When temacs is run, all memory requests are handled in -- the zone EmacsZone. The Darwin memory allocator library calls -+ this file. When tgcl is run, all memory requests are handled in -+ the zone GclZone. The Darwin memory allocator library calls - maintain the data structures to manage this zone. Dumping writes -- its contents to data segments of the executable file. When emacs -+ its contents to data segments of the executable file. When gcl - is run, the loader recreates the contents of the zone in memory. - However since the initialization routine of the zone memory - allocator is run again, this `zone' can no longer be used as a -- heap. That is why emacs uses the ordinary malloc system call to -+ heap. That is why gcl uses the ordinary malloc system call to - allocate memory. Also, when a block of memory needs to be - reallocated and the new size is larger than the old one, a new - block must be obtained by malloc and the old contents copied to -@@ -88,10 +67,10 @@ Foundation, 675 Mass Ave, Cambridge, MA - fact, the earliest one starts a few hundred bytes beyond the end of - the last load command. The linker option -headerpad controls the - minimum size of this padding. Its setting can be changed in -- s/darwin.h. A value of 0x300, e.g., leaves room for about 15 -- additional load commands for the newly created __DATA segments (at -- 56 bytes each). Unexec fails if there is not enough room for these -- new segments. -+ s/darwin.h. A value of 0x690, e.g., leaves room for 30 additional -+ load commands for the newly created __DATA segments (at 56 bytes -+ each). Unexec fails if there is not enough room for these new -+ segments. - - The __TEXT segment contains the sections __text, __cstring, - __picsymbol_stub, and __const and the __DATA segment contains the -@@ -110,28 +89,41 @@ Foundation, 675 Mass Ave, Cambridge, MA - #include - #include - #include --#include - #include - #include - #include - #include - #include --#include - #include - #include --#if defined(__ppc__) -+#if defined (__ppc__) - #include - #endif - #include - #include --#include -- --#include -- --#define VERBOSE 1 -+#undef malloc -+#undef realloc -+#undef free -+#include -+ -+#include -+ -+#ifdef _LP64 -+#define mach_header mach_header_64 -+#define segment_command segment_command_64 -+#undef VM_REGION_BASIC_INFO_COUNT -+#define VM_REGION_BASIC_INFO_COUNT VM_REGION_BASIC_INFO_COUNT_64 -+#undef VM_REGION_BASIC_INFO -+#define VM_REGION_BASIC_INFO VM_REGION_BASIC_INFO_64 -+#undef LC_SEGMENT -+#define LC_SEGMENT LC_SEGMENT_64 -+#define vm_region vm_region_64 -+#define section section_64 -+#undef MH_MAGIC -+#define MH_MAGIC MH_MAGIC_64 -+#endif - --/* This used to be the size of the heap, but this is no longer used. */ --#define BIG_HEAP_SIZE 0x50000000 -+#define VERBOSE 0 - - /* Size of buffer used to copy data from the input file to the output - file in function unexec_copy. */ -@@ -141,66 +133,77 @@ Foundation, 675 Mass Ave, Cambridge, MA - mapped to dynamically loaded libraries and will not be dumped. */ - #define VM_DATA_TOP (20 * 1024 * 1024) - --/* Used by malloc_freezedry and malloc_jumpstart. */ --extern int malloc_cookie; -- - /* Type of an element on the list of regions to be dumped. */ - struct region_t { - vm_address_t address; - vm_size_t size; - vm_prot_t protection; - vm_prot_t max_protection; -- const char *zone_name; -- -+ - struct region_t *next; - }; - - /* Head and tail of the list of regions to be dumped. */ --struct region_t *region_list_head; --struct region_t *region_list_tail; -+static struct region_t *region_list_head = 0; -+static struct region_t *region_list_tail = 0; - - /* Pointer to array of load commands. */ --struct load_command **lca; -+static struct load_command **lca; - - /* Number of load commands. */ --int nlc; -+static int nlc; - - /* The highest VM address of segments loaded by the input file. - Regions with addresses beyond this are assumed to be allocated - dynamically and thus require dumping. */ --vm_address_t infile_lc_highest_addr; -+static vm_address_t infile_lc_highest_addr = 0; - - /* The lowest file offset used by the all sections in the __TEXT - segments. This leaves room at the beginning of the file to store - the Mach-O header. Check this value against header size to ensure - the added load commands for the new __DATA segments did not - overwrite any of the sections in the __TEXT segment. */ --unsigned long text_seg_lowest_offset; -+static unsigned long text_seg_lowest_offset = 0x10000000; - - /* Mach header. */ --struct mach_header mh; -+static struct mach_header mh; - - /* Offset at which the next load command should be written. */ --unsigned long curr_header_offset; -- --/* Current adjustment that needs to be made to offset values because -- of additional data segments. */ --unsigned long delta; -+static unsigned long curr_header_offset = sizeof (struct mach_header); - --/* Adjustment that needs to be made to the vmaddr of the link-edit -- segment due to the insertion of a data segment. */ --unsigned long linkedit_delta; -+/* Offset at which the next segment should be written. */ -+static unsigned long curr_file_offset = 0; - --int infd, outfd; -+static unsigned long pagesize; -+#define ROUNDUP_TO_PAGE_BOUNDARY(x) (((x) + pagesize - 1) & ~(pagesize - 1)) - --int in_dumped_exec = 0; -+static int infd, outfd; - --malloc_zone_t *gcl_zone = 0L; -+static malloc_zone_t *gcl_zone; - - /* file offset of input file's data segment */ --off_t data_segment_old_fileoff; -+static off_t data_segment_old_fileoff = 0; - --struct segment_command *data_segment_scp; -+static struct segment_command *data_segment_scp; -+ -+void -+reset_unexec_globals() { -+ region_list_head=NULL; -+ region_list_tail=NULL; -+ lca=NULL; -+ nlc=0; -+ infile_lc_highest_addr=0; -+ text_seg_lowest_offset=0x10000000; -+ memset(&mh,0,sizeof(mh)); -+ curr_header_offset=sizeof (struct mach_header); -+ curr_file_offset=0; -+ pagesize=0; -+ infd=0; -+ outfd=0; -+ gcl_zone=NULL; -+ data_segment_old_fileoff=0; -+ data_segment_scp=NULL; -+} - - #define MAX_MARKED_REGIONS 1024 - -@@ -209,6 +212,8 @@ vm_range_t marked_regions [MAX_MARKED_RE - unsigned num_marked_regions; - - /* Size of the heap. */ -+/* #define BIG_HEAP_SIZE 0x50000000 */ -+#define BIG_HEAP_SIZE MAXPAGE*PAGESIZE - int big_heap = BIG_HEAP_SIZE; - - /* Start of the heap. */ -@@ -220,7 +225,7 @@ char *mach_maplimit = 0; - /* Position ot the break within the heap. */ - char *mach_brkpt = 0; - --/* Read n bytes from infd into memory starting at address dest. -+/* Read N bytes from infd into memory starting at address DEST. - Return true if successful, false otherwise. */ - static int - unexec_read (void *dest, size_t n) -@@ -228,8 +233,9 @@ unexec_read (void *dest, size_t n) - return n == read (infd, dest, n); - } - --/* Write n bytes from memory starting at address src to outfd starting -- at offset dest. Return true if successful, false otherwise. */ -+/* Write COUNT bytes from memory starting at address SRC to outfd -+ starting at offset DEST. Return true if successful, false -+ otherwise. */ - static int - unexec_write (off_t dest, const void *src, size_t count) - { -@@ -239,8 +245,32 @@ unexec_write (off_t dest, const void *sr - return write (outfd, src, count) == count; - } - --/* Copy n bytes from starting offset src in infd to starting offset -- dest in outfd. Return true if successful, false otherwise. */ -+/* Write COUNT bytes of zeros to outfd starting at offset DEST. -+ Return true if successful, false otherwise. */ -+static int -+unexec_write_zero (off_t dest, size_t count) -+{ -+ char buf[UNEXEC_COPY_BUFSZ]; -+ ssize_t bytes; -+ -+ bzero (buf, UNEXEC_COPY_BUFSZ); -+ if (lseek (outfd, dest, SEEK_SET) != dest) -+ return 0; -+ -+ while (count > 0) -+ { -+ bytes = count > UNEXEC_COPY_BUFSZ ? UNEXEC_COPY_BUFSZ : count; -+ if (write (outfd, buf, bytes) != bytes) -+ return 0; -+ count -= bytes; -+ } -+ -+ return 1; -+} -+ -+/* Copy COUNT bytes from starting offset SRC in infd to starting -+ offset DEST in outfd. Return true if successful, false -+ otherwise. */ - static int - unexec_copy (off_t dest, off_t src, ssize_t count) - { -@@ -260,9 +290,9 @@ unexec_copy (off_t dest, off_t src, ssiz - bytes_to_read = count > UNEXEC_COPY_BUFSZ ? UNEXEC_COPY_BUFSZ : count; - bytes_read = read (infd, buf, bytes_to_read); - if (bytes_read <= 0) -- return 0; -+ return 0; - if (write (outfd, buf, bytes_read) != bytes_read) -- return 0; -+ return 0; - count -= bytes_read; - } - -@@ -284,219 +314,20 @@ unexec_error (char *format, ...) - exit (1); - } - --static void --print_prot (vm_prot_t prot) --{ -- if (prot == VM_PROT_NONE) -- printf ("none"); -- else -- { -- putchar (prot & VM_PROT_READ ? 'r' : ' '); -- putchar (prot & VM_PROT_WRITE ? 'w' : ' '); -- putchar (prot & VM_PROT_EXECUTE ? 'x' : ' '); -- putchar (' '); -- } --} -- --static void --print_region (vm_address_t address, vm_size_t size, vm_prot_t prot, -- vm_prot_t max_prot, const char *zone_name) --{ -- printf ("%#10x %#10x ", address, size); -- print_prot (prot); -- putchar (' '); -- print_prot (max_prot); -- putchar (' '); -- printf (zone_name ? zone_name : "n/a"); -- putchar ('\n'); --} -- --static void --print_region_list () --{ -- struct region_t *r; -- -- printf (" address size prot maxp zone_name\n"); -- -- for (r = region_list_head; r; r = r->next) -- print_region (r->address, r->size, r->protection, -- r->max_protection, r->zone_name); --} -- --void --print_regions () --{ -- task_t target_task = mach_task_self (); -- vm_address_t address = (vm_address_t) 0; -- vm_size_t size; -- struct vm_region_basic_info info; -- mach_msg_type_number_t info_count = VM_REGION_BASIC_INFO_COUNT; -- mach_port_t object_name; -- malloc_zone_t *zone; -- -- printf (" address size prot maxp zone_name\n"); -- -- while (vm_region (target_task, &address, &size, VM_REGION_BASIC_INFO, -- (vm_region_info_t) &info, &info_count, &object_name) -- == KERN_SUCCESS && info_count == VM_REGION_BASIC_INFO_COUNT) -- { -- zone = malloc_zone_from_ptr ((void *) address); -- -- print_region (address, size, info.protection, info.max_protection, -- zone ? zone->zone_name : "(no zone)"); -- -- if (object_name != MACH_PORT_NULL) -- mach_port_deallocate (target_task, object_name); -- -- address += size; -- } -- -- fflush (stdout); --} -- -- --/* Build the list of regions that need to be dumped. Regions with -- addresses above VM_DATA_TOP are omitted. Adjacent regions with -- identical protection are merged. Note that non-writable regions -- cannot be omitted because they some regions created at run time are -- read-only. */ --static void --build_region_list () --{ -- task_t target_task = mach_task_self (); -- vm_address_t address = (vm_address_t) 0; -- vm_size_t size; -- struct vm_region_basic_info info; -- mach_msg_type_number_t info_count = VM_REGION_BASIC_INFO_COUNT; -- mach_port_t object_name; -- struct region_t *r; -- malloc_zone_t *zone; -- const char *zone_name; -- --#if VERBOSE -- printf ("--- List of All Regions ---\n"); -- printf (" address size prot maxp zone_name\n"); --#endif -- -- while (vm_region (target_task, &address, &size, VM_REGION_BASIC_INFO, -- (vm_region_info_t) &info, &info_count, &object_name) -- == KERN_SUCCESS && info_count == VM_REGION_BASIC_INFO_COUNT) -- { -- /* Done when we reach addresses of shared libraries, -- which are loaded in high memory. */ -- if (address >= VM_DATA_TOP) -- break; -- -- zone = malloc_zone_from_ptr ((void *) address); -- zone_name = zone ? (zone->zone_name ? zone->zone_name : "(no zone name)") -- : "(no zone)"; -- --#if VERBOSE -- print_region (address, size, info.protection, -- info.max_protection, zone_name); --#endif -- -- /* If a region immediately follows the previous one (the one -- most recently added to the list) and has identical -- protection, merge it with the latter. Otherwise create a -- new list element for it. */ -- -- if (region_list_tail -- && info.protection == region_list_tail->protection -- && info.max_protection == region_list_tail->max_protection -- && region_list_tail->address + region_list_tail->size == address -- && (!zone || zone_name == region_list_tail->zone_name)) -- { -- region_list_tail->size += size; -- } -- else -- { -- r = (struct region_t *) -- malloc_zone_malloc (malloc_default_zone (), sizeof (struct region_t)); -- -- if (!r) -- unexec_error ("cannot allocate region structure"); -- -- r->address = address; -- r->size = size; -- r->protection = info.protection; -- r->max_protection = info.max_protection; -- r->zone_name = zone_name; -- -- r->next = 0; -- if (region_list_head == 0) -- { -- region_list_head = r; -- region_list_tail = r; -- } -- else -- { -- region_list_tail->next = r; -- region_list_tail = r; -- } -- -- /* Deallocate (unused) object name returned by vm_region. */ -- if (object_name != MACH_PORT_NULL) -- mach_port_deallocate (target_task, object_name); -- } -- -- address += size; -- } -- -- printf ("--- List of Regions to be Dumped ---\n"); -- print_region_list (); --} -- -- --#define MAX_UNEXEC_REGIONS 256 -- --int num_unexec_regions; --vm_range_t unexec_regions[MAX_UNEXEC_REGIONS]; -- --static void --unexec_regions_recorder (task_t task, void *rr, unsigned type, -- vm_range_t *ranges, unsigned num) --{ -- while (num && num_unexec_regions < MAX_UNEXEC_REGIONS) -- { -- unexec_regions[num_unexec_regions++] = *ranges; -- printf ("%#8x (sz: %#8x)\n", ranges->address, ranges->size); -- ranges++; num--; -- } -- if (num_unexec_regions == MAX_UNEXEC_REGIONS) -- fprintf (stderr, "malloc_freezedry_recorder: too many regions\n"); --} -- --static kern_return_t --unexec_reader (task_t task, vm_address_t address, vm_size_t size, void **ptr) --{ -- *ptr = (void *) address; -- return KERN_SUCCESS; --} -- --void --find_gcl_zone_regions () --{ -- num_unexec_regions = 0; -- -- gcl_zone->introspect->enumerator (mach_task_self(), 0, -- MALLOC_PTR_REGION_RANGE_TYPE | -- MALLOC_ADMIN_REGION_RANGE_TYPE, -- (vm_address_t) gcl_zone, -- unexec_reader, -- unexec_regions_recorder); --} -- -- - /* More informational messages routines. */ - -+#if VERBOSE - static void - print_load_command_name (int lc) - { - switch (lc) - { - case LC_SEGMENT: -+#ifndef _LP64 - printf ("LC_SEGMENT "); -+#else -+ printf ("LC_SEGMENT_64 "); -+#endif - break; - case LC_LOAD_DYLINKER: - printf ("LC_LOAD_DYLINKER "); -@@ -519,6 +350,19 @@ print_load_command_name (int lc) - case LC_TWOLEVEL_HINTS: - printf ("LC_TWOLEVEL_HINTS"); - break; -+#ifdef LC_UUID -+ case LC_UUID: -+ printf ("LC_UUID "); -+ break; -+#endif -+#ifdef LC_DYLD_INFO -+ case LC_DYLD_INFO: -+ printf ("LC_DYLD_INFO "); -+ break; -+ case LC_DYLD_INFO_ONLY: -+ printf ("LC_DYLD_INFO_ONLY"); -+ break; -+#endif - default: - printf ("unknown "); - } -@@ -528,7 +372,7 @@ static void - print_load_command (struct load_command *lc) - { - print_load_command_name (lc->cmd); -- printf ("%#10lx", lc->cmdsize); -+ printf ("%8d", lc->cmdsize); - - if (lc->cmd == LC_SEGMENT) - { -@@ -537,101 +381,22 @@ print_load_command (struct load_command - int j; - - scp = (struct segment_command *) lc; -- printf (" %-16.16s %#10lx %#10lx\n", -- scp->segname, scp->vmaddr, scp->vmsize); -+ printf (" %-16.16s %#10lx %#8lx\n", -+ scp->segname, (long) (scp->vmaddr), (long) (scp->vmsize)); - - sectp = (struct section *) (scp + 1); - for (j = 0; j < scp->nsects; j++) -- { -- printf (" %-16.16s %#10lx %#10lx\n", -- sectp->sectname, sectp->addr, sectp->size); -- sectp++; -- } -+ { -+ printf (" %-16.16s %#10lx %#8lx\n", -+ sectp->sectname, (long) (sectp->addr), (long) (sectp->size)); -+ sectp++; -+ } - } - else - printf ("\n"); - } -- --/* Read header and load commands from input file. Store the latter in -- the global array lca. Store the total number of load commands in -- global variable nlc. */ --static void --read_load_commands () --{ -- int i; -- -- if (!unexec_read (&mh, sizeof (struct mach_header))) -- unexec_error ("cannot read mach-o header"); -- -- if (mh.magic != MH_MAGIC) -- unexec_error ("input file not in Mach-O format"); -- -- if (mh.filetype != MH_EXECUTE) -- unexec_error ("input Mach-O file is not an executable object file"); -- --#if VERBOSE -- printf ("--- Header Information ---\n"); -- printf ("Magic = 0x%08lx\n", mh.magic); -- printf ("CPUType = %d\n", mh.cputype); -- printf ("CPUSubType = %d\n", mh.cpusubtype); -- printf ("FileType = 0x%lx\n", mh.filetype); -- printf ("NCmds = %ld\n", mh.ncmds); -- printf ("SizeOfCmds = %ld\n", mh.sizeofcmds); -- printf ("Flags = 0x%08lx\n", mh.flags); - #endif - -- nlc = mh.ncmds; -- lca = (struct load_command **) malloc_zone_malloc -- (malloc_default_zone (), nlc * sizeof (struct load_command *)); -- -- for (i = 0; i < nlc; i++) -- { -- struct load_command lc; -- /* Load commands are variable-size: so read the command type and -- size first and then read the rest. */ -- if (!unexec_read (&lc, sizeof (struct load_command))) -- unexec_error ("cannot read load command"); -- lca[i] = (struct load_command *) -- malloc_zone_malloc (malloc_default_zone (), lc.cmdsize); -- memcpy (lca[i], &lc, sizeof (struct load_command)); -- if (!unexec_read (lca[i] + 1, lc.cmdsize - sizeof (struct load_command))) -- unexec_error ("cannot read content of load command"); -- if (lc.cmd == LC_SEGMENT) -- { -- struct segment_command *scp = (struct segment_command *) lca[i]; -- -- if (scp->vmaddr + scp->vmsize > infile_lc_highest_addr) -- infile_lc_highest_addr = scp->vmaddr + scp->vmsize; -- -- if (strncmp (scp->segname, SEG_TEXT, 16) == 0) -- { -- struct section *sectp = (struct section *) (scp + 1); -- int j; -- -- for (j = 0; j < scp->nsects; j++) -- if (sectp->offset < text_seg_lowest_offset) -- text_seg_lowest_offset = sectp->offset; -- } -- } -- } -- -- printf ("Highest address of load commands in input file: %#10x\n", -- infile_lc_highest_addr); -- -- printf ("Lowest offset of all sections in __TEXT segment: %#10lx\n", -- text_seg_lowest_offset); -- -- printf ("--- List of Load Commands in Input File ---\n"); -- printf -- ("no cmd cmdsize name address size\n"); -- -- for (i = 0; i < nlc; i++) -- { -- printf ("%2d ", i); -- print_load_command (lca[i]); -- } --} -- - /* Copy a LC_SEGMENT load command other than the __DATA segment from - the input file to the output file, adjusting the file offset of the - segment and the file offsets of sections contained in it. */ -@@ -643,24 +408,25 @@ copy_segment (struct load_command *lc) - struct section *sectp; - int j; - -- scp->fileoff += delta; -+ scp->fileoff = curr_file_offset; - - sectp = (struct section *) (scp + 1); - for (j = 0; j < scp->nsects; j++) - { -- sectp->offset += delta; -+ sectp->offset += curr_file_offset - old_fileoff; - sectp++; - } - -- if (strncmp (scp->segname, SEG_LINKEDIT, 16) == 0) -- scp->vmaddr += linkedit_delta; -- -- printf ("Writing segment %-16.16s at %#10lx - %#10lx (sz: %#10lx)\n", -- scp->segname, scp->fileoff, scp->fileoff + scp->filesize, -- scp->filesize); -+#if VERBOSE -+ printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n", -+ scp->segname, (long) (scp->fileoff), (long) (scp->filesize), -+ (long) (scp->vmsize), (long) (scp->vmaddr)); -+#endif - - if (!unexec_copy (scp->fileoff, old_fileoff, scp->filesize)) - unexec_error ("cannot copy segment from input to output file"); -+ curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (scp->filesize); -+ - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write load command to header"); - -@@ -685,18 +451,21 @@ copy_data_segment (struct load_command * - struct segment_command *scp = (struct segment_command *) lc; - struct section *sectp; - int j; -- unsigned long header_offset, file_offset, old_file_offset; -- /*struct region_t *r;*/ -+ unsigned long header_offset, old_file_offset; - -- if (delta != 0) { -- mh.ncmds--; -- return; -- } -+ /* The new filesize of the segment is set to its vmsize because data -+ blocks for segments must start at region boundaries. Note that -+ this may leave unused locations at the end of the segment data -+ block because the total of the sizes of all sections in the -+ segment is generally smaller than vmsize. */ -+ scp->filesize = scp->vmsize; -+ -+#if VERBOSE -+ printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n", -+ scp->segname, curr_file_offset, (long)(scp->filesize), -+ (long)(scp->vmsize), (long) (scp->vmaddr)); -+#endif - -- printf ("Writing segment %-16.16s at %#10lx - %#10lx (sz: %#10lx)\n", -- scp->segname, scp->fileoff, scp->fileoff + scp->filesize, -- scp->filesize); -- - /* Offsets in the output file for writing the next section structure - and segment data block, respectively. */ - header_offset = curr_header_offset + sizeof (struct segment_command); -@@ -705,147 +474,121 @@ copy_data_segment (struct load_command * - for (j = 0; j < scp->nsects; j++) - { - old_file_offset = sectp->offset; -- sectp->offset = sectp->addr - scp->vmaddr + scp->fileoff; -+ sectp->offset = sectp->addr - scp->vmaddr + curr_file_offset; - /* The __data section is dumped from memory. The __bss and -- __common sections are also dumped from memory but their flag -- fields require changing (from S_ZEROFILL to S_REGULAR). The -- other three kinds of sections are just copied from the input -- file. */ -+ __common sections are also dumped from memory but their flag -+ fields require changing (from S_ZEROFILL to S_REGULAR). The -+ other three kinds of sections are just copied from the input -+ file. */ - if (strncmp (sectp->sectname, SECT_DATA, 16) == 0) -- { -- if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size)) -- unexec_error ("cannot write section %s", SECT_DATA); -- if (!unexec_write (header_offset, sectp, sizeof (struct section))) -- unexec_error ("cannot write section %s's header", SECT_DATA); -- } -- else if (strncmp (sectp->sectname, SECT_BSS, 16) == 0 -- || strncmp (sectp->sectname, SECT_COMMON, 16) == 0) -- { -- sectp->flags = S_REGULAR; -- if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size)) -- unexec_error ("cannot write section %s", SECT_DATA); -- if (!unexec_write (header_offset, sectp, sizeof (struct section))) -- unexec_error ("cannot write section %s's header", SECT_DATA); -- } -+ { -+ if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size)) -+ unexec_error ("cannot write section %s", SECT_DATA); -+ if (!unexec_write (header_offset, sectp, sizeof (struct section))) -+ unexec_error ("cannot write section %s's header", SECT_DATA); -+ } -+ else if (strncmp (sectp->sectname, SECT_COMMON, 16) == 0) -+ { -+ sectp->flags = S_REGULAR; -+ if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size)) -+ unexec_error ("cannot write section %s", sectp->sectname); -+ if (!unexec_write (header_offset, sectp, sizeof (struct section))) -+ unexec_error ("cannot write section %s's header", sectp->sectname); -+ } -+ else if (strncmp (sectp->sectname, SECT_BSS, 16) == 0) -+ { -+ /* extern char *my_endbss_static; */ -+ unsigned long my_size; -+ -+ sectp->flags = S_REGULAR; -+ -+ /* Clear uninitialized local variables in statically linked -+ libraries. In particular, function pointers stored by -+ libSystemStub.a, which is introduced in Mac OS X 10.4 for -+ binary compatibility with respect to long double, are -+ cleared so that they will be reinitialized when the -+ dumped binary is executed on other versions of OS. */ -+ my_size = sectp->size;/* (unsigned long)my_endbss_static - sectp->addr; */ -+ /* if (!(sectp->addr <= (unsigned long)my_endbss_static */ -+ /* && my_size <= sectp->size)) */ -+ /* unexec_error ("my_endbss_static is not in section %s", */ -+ /* sectp->sectname); */ -+ if (!unexec_write (sectp->offset, (void *) sectp->addr, my_size)) -+ unexec_error ("cannot write section %s", sectp->sectname); -+ if (!unexec_write_zero (sectp->offset + my_size, -+ sectp->size - my_size)) -+ unexec_error ("cannot write section %s", sectp->sectname); -+ if (!unexec_write (header_offset, sectp, sizeof (struct section))) -+ unexec_error ("cannot write section %s's header", sectp->sectname); -+ } - else if (strncmp (sectp->sectname, "__la_symbol_ptr", 16) == 0 -- || strncmp (sectp->sectname, "__nl_symbol_ptr", 16) == 0 -- || strncmp (sectp->sectname, "__dyld", 16) == 0 -- || strncmp (sectp->sectname, "__const", 16) == 0 -- || strncmp (sectp->sectname, "__cfstring", 16) == 0) -- { -- if (!unexec_copy (sectp->offset, old_file_offset, sectp->size)) -- unexec_error ("cannot copy section %s", sectp->sectname); -- if (!unexec_write (header_offset, sectp, sizeof (struct section))) -- unexec_error ("cannot write section %s's header", sectp->sectname); -- } -+ || strncmp (sectp->sectname, "__nl_symbol_ptr", 16) == 0 -+ || strncmp (sectp->sectname, "__la_sym_ptr2", 16) == 0 -+ || strncmp (sectp->sectname, "__dyld", 16) == 0 -+ || strncmp (sectp->sectname, "__const", 16) == 0 -+ || strncmp (sectp->sectname, "__cfstring", 16) == 0 -+ || strncmp (sectp->sectname, "__gcc_except_tab", 16) == 0 -+ || strncmp (sectp->sectname, "__program_vars", 16) == 0 -+ || strncmp (sectp->sectname, "__objc_", 7) == 0) -+ { -+ if (!unexec_copy (sectp->offset, old_file_offset, sectp->size)) -+ unexec_error ("cannot copy section %s", sectp->sectname); -+ if (!unexec_write (header_offset, sectp, sizeof (struct section))) -+ unexec_error ("cannot write section %s's header", sectp->sectname); -+ } - else -- unexec_error ("unrecognized section name in __DATA segment"); -+ unexec_error ("unrecognized section name in __DATA segment"); - -- printf (" section %-16.16s at %#10lx - %#10lx (sz: %#10lx)\n", -- sectp->sectname, sectp->offset, sectp->offset + sectp->size, -- sectp->size); -+#if VERBOSE -+ printf (" section %-16.16s at %#8lx - %#8lx (sz: %#8lx)\n", -+ sectp->sectname, (long) (sectp->offset), -+ (long) (sectp->offset + sectp->size), (long) (sectp->size)); -+#endif - - header_offset += sizeof (struct section); - sectp++; - } - -- /* Make sure that the size of the default __DATA segment does not exceed -- the size of our heap. */ -- if (scp->vmsize > MAXPAGE*PAGESIZE) { -- fprintf (stderr, "copy_data_segment(): data segment is too large\n"); -- exit (1); -- } -- -- /* This will make do for a second __DATA segment inserted before the -- __LINKEDIT segment and contiguous to the default __DATA segment. -- For this reason, the __LINKEDIT segment is shifted towards highest -- memory addresses (linkedit_delta = MAXPAGE*PAGESIZE - scp->vmsize). -- This memory layout mimics that on Linux. The cumulated size of -- the two __DATA segment is MAXPAGE*PAGESIZE. If fasload()'ing is -- ever to happen, the code will get loaded in this second __DATA -- segment if BFD is used. Otherwise, if the NSModule(3) API is -- used, it will get allocated god knows where, after the -- __LINKEDIT segment. Special care must be taken to store those -- pieces of code in the dumped executable. Although the vmsize -- of the heap is MAXPAGE*PAGESIZE, only the area ranging from -- mach_mapstart to core_end contains meaningful information and -- needs to be saved to the file. This drastically reduces the -- size of the dumped executable. We should always have: -- mach_mapstart <= heap_end <= core_end <= mach_brkpt <= mach_maplimit. */ -- unexec_regions[0].address = scp->vmaddr + scp->vmsize; -- unexec_regions[0].size = MAXPAGE*PAGESIZE - scp->vmsize; -- -- /* The new filesize of the segment is set to its vmsize because data -- blocks for segments must start at region boundaries. Note that -- this may leave unused locations at the end of the segment data -- block because the total of the sizes of all sections in the -- segment is generally smaller than vmsize. */ -- delta = scp->vmsize - scp->filesize; -- scp->filesize = scp->vmsize; -+ curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (scp->filesize); -+ - if (!unexec_write (curr_header_offset, scp, sizeof (struct segment_command))) - unexec_error ("cannot write header of __DATA segment"); - curr_header_offset += lc->cmdsize; - - /* Create new __DATA segment load commands for regions on the region -- list that do not correspond to any segment load commands in the -- input file. -+ list that do not corresponding to any segment load commands in -+ the input file. - */ -- file_offset = scp->fileoff + scp->filesize; -- for (j = 0; j < num_unexec_regions; j++) -+ /* for (j = 0; j < num_unexec_regions; j++) */ - { - struct segment_command sc; -- struct section section; -- -- extern char *mach_maplimit; -- extern char *core_end; -- -+ - sc.cmd = LC_SEGMENT; -- sc.cmdsize = sizeof (struct segment_command) + sizeof(struct section); -- strncpy (sc.segname, SEG_DATA, 16); -- sc.vmaddr = unexec_regions[j].address; -- sc.vmsize = unexec_regions[j].size; -- sc.fileoff = file_offset; -- sc.filesize = sc.vmsize; -- /* the heap will contain executable code, -- so promote maxprot to allow execution */ -+ sc.cmdsize = sizeof (struct segment_command); -+ /* strncpy (sc.segname, SEG_DATA, 16); */ -+ strncpy (sc.segname, "__HEAP", 16); -+ sc.vmaddr = (long)mach_mapstart; -+ sc.vmsize = mach_maplimit-mach_mapstart; -+ sc.fileoff = curr_file_offset; -+ sc.filesize = core_end-mach_mapstart; - sc.maxprot = VM_PROT_READ | VM_PROT_WRITE | VM_PROT_EXECUTE; - sc.initprot = VM_PROT_READ | VM_PROT_WRITE | VM_PROT_EXECUTE; -- sc.nsects = 1; -+ sc.nsects = 0; - sc.flags = 0; - -- if (j == 0) { -- sc.filesize -= mach_maplimit - core_end; -- linkedit_delta = sc.vmsize; -- } -- -- strncpy (section.sectname,SECT_DATA,sizeof(section.sectname)); -- strncpy (section.segname,SEG_DATA,sizeof(section.segname)); -- section.addr = sc.vmaddr; -- section.size = sc.filesize; -- section.offset = file_offset; -- section.align = 4; -- section.reloff = 0; -- section.nreloc = 0; -- section.flags = S_ATTR_PURE_INSTRUCTIONS | S_REGULAR; -- section.reserved1 = 0; -- section.reserved2 = 0; -- -- printf ("Writing segment %-16.16s at %#10lx - %#10lx (sz: %#10lx)\n", -- sc.segname, sc.fileoff, sc.fileoff + sc.filesize, sc.filesize); -+#if VERBOSE -+ printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n", -+ sc.segname, (long) (sc.fileoff), (long) (sc.filesize), -+ (long) (sc.vmsize), (long) (sc.vmaddr)); -+#endif - - if (!unexec_write (sc.fileoff, (void *) sc.vmaddr, sc.filesize)) -- unexec_error ("cannot write new __DATA segment"); -- delta += sc.filesize; -- file_offset += sc.filesize; -- -- if (!unexec_write (curr_header_offset, &sc, sizeof(sc))) -- unexec_error ("cannot write new __DATA segment's header"); -- curr_header_offset += sizeof(sc); -- -- if (!unexec_write (curr_header_offset, §ion, sizeof(section))) -- unexec_error ("cannot write new __data section's header"); -- curr_header_offset += sizeof(section); -+ unexec_error ("cannot write new __DATA segment"); -+ curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (sc.filesize); - -+ if (!unexec_write (curr_header_offset, &sc, sc.cmdsize)) -+ unexec_error ("cannot write new __DATA segment's header"); -+ curr_header_offset += sc.cmdsize; - mh.ncmds++; - } - } -@@ -853,14 +596,16 @@ copy_data_segment (struct load_command * - /* Copy a LC_SYMTAB load command from the input file to the output - file, adjusting the file offset fields. */ - static void --copy_symtab (struct load_command *lc) -+copy_symtab (struct load_command *lc, long delta) - { - struct symtab_command *stp = (struct symtab_command *) lc; - - stp->symoff += delta; - stp->stroff += delta; - -- printf ("Writing LC_SYMTAB command\n"); -+#if VERBOSE -+ printf ("Writing LC_SYMTAB command\n"); -+#endif - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write symtab command to header"); -@@ -870,78 +615,136 @@ copy_symtab (struct load_command *lc) - - /* Fix up relocation entries. */ - static void --unrelocate (const char *name, off_t reloff, int nrel) -+unrelocate (const char *name, off_t reloff, int nrel, vm_address_t base) - { - int i, unreloc_count; - struct relocation_info reloc_info; - struct scattered_relocation_info *sc_reloc_info - = (struct scattered_relocation_info *) &reloc_info; -+ vm_address_t location; - - for (unreloc_count = 0, i = 0; i < nrel; i++) - { - if (lseek (infd, reloff, L_SET) != reloff) -- unexec_error ("unrelocate: %s:%d cannot seek to reloc_info", name, i); -+ unexec_error ("unrelocate: %s:%d cannot seek to reloc_info", name, i); - if (!unexec_read (&reloc_info, sizeof (reloc_info))) -- unexec_error ("unrelocate: %s:%d cannot read reloc_info", name, i); -+ unexec_error ("unrelocate: %s:%d cannot read reloc_info", name, i); - reloff += sizeof (reloc_info); - - if (sc_reloc_info->r_scattered == 0) -- switch (reloc_info.r_type) -- { -- case GENERIC_RELOC_VANILLA: -- if (reloc_info.r_address >= data_segment_scp->vmaddr -- && reloc_info.r_address < (data_segment_scp->vmaddr -- + data_segment_scp->vmsize)) -- { -- off_t src_off = data_segment_old_fileoff -- + reloc_info.r_address - data_segment_scp->vmaddr; -- off_t dst_off = data_segment_scp->fileoff -- + reloc_info.r_address - data_segment_scp->vmaddr; -- -- if (!unexec_copy (dst_off, src_off, 1 << reloc_info.r_length)) -- unexec_error ("unrelocate: %s:%d cannot copy original value", -- name, i); -- unreloc_count++; -- } -- break; -- default: -- unexec_error ("unrelocate: %s:%d cannot handle type = %d", -- name, i, reloc_info.r_type); -- } -+ switch (reloc_info.r_type) -+ { -+ case GENERIC_RELOC_VANILLA: -+ location = base + reloc_info.r_address; -+ if (location >= data_segment_scp->vmaddr -+ && location < (data_segment_scp->vmaddr -+ + data_segment_scp->vmsize)) -+ { -+ off_t src_off = data_segment_old_fileoff -+ + (location - data_segment_scp->vmaddr); -+ off_t dst_off = data_segment_scp->fileoff -+ + (location - data_segment_scp->vmaddr); -+ -+ if (!unexec_copy (dst_off, src_off, 1 << reloc_info.r_length)) -+ unexec_error ("unrelocate: %s:%d cannot copy original value", -+ name, i); -+ unreloc_count++; -+ } -+ break; -+ default: -+ unexec_error ("unrelocate: %s:%d cannot handle type = %d", -+ name, i, reloc_info.r_type); -+ } - else -- switch (sc_reloc_info->r_type) -- { -+ switch (sc_reloc_info->r_type) -+ { - #if defined (__ppc__) -- case PPC_RELOC_PB_LA_PTR: -- /* nothing to do for prebound lazy pointer */ -- break; --#endif -- default: -- unexec_error ("unrelocate: %s:%d cannot handle scattered type = %d", -- name, i, sc_reloc_info->r_type); -- } -+ case PPC_RELOC_PB_LA_PTR: -+ /* nothing to do for prebound lazy pointer */ -+ break; -+#endif -+ default: -+ unexec_error ("unrelocate: %s:%d cannot handle scattered type = %d", -+ name, i, sc_reloc_info->r_type); -+ } - } - -+#if VERBOSE - if (nrel > 0) - printf ("Fixed up %d/%d %s relocation entries in data segment.\n", -- unreloc_count, nrel, name); -+ unreloc_count, nrel, name); -+#endif -+ -+} -+ -+#if __ppc64__ -+/* Rebase r_address in the relocation table. */ -+static void -+rebase_reloc_address (off_t reloff, int nrel, long linkedit_delta, long diff) -+{ -+ int i; -+ struct relocation_info reloc_info; -+ struct scattered_relocation_info *sc_reloc_info -+ = (struct scattered_relocation_info *) &reloc_info; -+ -+ for (i = 0; i < nrel; i++, reloff += sizeof (reloc_info)) -+ { -+ if (lseek (infd, reloff - linkedit_delta, L_SET) -+ != reloff - linkedit_delta) -+ unexec_error ("rebase_reloc_table: cannot seek to reloc_info"); -+ if (!unexec_read (&reloc_info, sizeof (reloc_info))) -+ unexec_error ("rebase_reloc_table: cannot read reloc_info"); -+ -+ if (sc_reloc_info->r_scattered == 0 -+ && reloc_info.r_type == GENERIC_RELOC_VANILLA) -+ { -+ reloc_info.r_address -= diff; -+ if (!unexec_write (reloff, &reloc_info, sizeof (reloc_info))) -+ unexec_error ("rebase_reloc_table: cannot write reloc_info"); -+ } -+ } - } -+#endif - - /* Copy a LC_DYSYMTAB load command from the input file to the output - file, adjusting the file offset fields. */ - static void --copy_dysymtab (struct load_command *lc) -+copy_dysymtab (struct load_command *lc, long delta) - { - struct dysymtab_command *dstp = (struct dysymtab_command *) lc; -+ vm_address_t base; -+ -+#ifdef _LP64 -+#if __ppc64__ -+ { -+ int i; -+ -+ base = 0; -+ for (i = 0; i < nlc; i++) -+ if (lca[i]->cmd == LC_SEGMENT) -+ { -+ struct segment_command *scp = (struct segment_command *) lca[i]; -+ -+ if (scp->vmaddr + scp->vmsize > 0x100000000 -+ && (scp->initprot & VM_PROT_WRITE) != 0) -+ { -+ base = data_segment_scp->vmaddr; -+ break; -+ } -+ } -+ } -+#else -+ /* First writable segment address. */ -+ base = data_segment_scp->vmaddr; -+#endif -+#else -+ /* First segment address in the file (unless MH_SPLIT_SEGS set). */ -+ base = 0; -+#endif - -- /* If Mach-O executable is not prebound, relocation entries need -- fixing up. This is not supported currently. */ -- /* if (!(mh.flags & MH_PREBOUND) && (dstp->nextrel != 0 || dstp->nlocrel != 0)) -- unexec_error ("cannot handle LC_DYSYMTAB with relocation entries"); */ -+ unrelocate ("local", dstp->locreloff, dstp->nlocrel, base); -+ unrelocate ("external", dstp->extreloff, dstp->nextrel, base); - -- unrelocate ("local", dstp->locreloff, dstp->nlocrel); -- unrelocate ("external", dstp->extreloff, dstp->nextrel); -- - if (dstp->nextrel > 0) { - dstp->extreloff += delta; - } -@@ -952,19 +755,44 @@ copy_dysymtab (struct load_command *lc) - - if (dstp->nindirectsyms > 0) - dstp->indirectsymoff += delta; -- -- printf ("Writing LC_DYSYMTAB command\n"); -+ -+#if VERBOSE -+ printf ("Writing LC_DYSYMTAB command\n"); -+#endif - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write symtab command to header"); - - curr_header_offset += lc->cmdsize; -+ -+#if __ppc64__ -+ /* Check if the relocation base needs to be changed. */ -+ if (base == 0) -+ { -+ vm_address_t newbase = 0; -+ int i; -+ -+ for (i = 0; i < num_unexec_regions; i++) -+ if (unexec_regions[i].range.address + unexec_regions[i].range.size -+ > 0x100000000) -+ { -+ newbase = data_segment_scp->vmaddr; -+ break; -+ } -+ -+ if (newbase) -+ { -+ rebase_reloc_address (dstp->locreloff, dstp->nlocrel, delta, newbase); -+ rebase_reloc_address (dstp->extreloff, dstp->nextrel, delta, newbase); -+ } -+ } -+#endif - } - - /* Copy a LC_TWOLEVEL_HINTS load command from the input file to the output - file, adjusting the file offset fields. */ - static void --copy_twolevelhints (struct load_command *lc) -+copy_twolevelhints (struct load_command *lc, long delta) - { - struct twolevel_hints_command *tlhp = (struct twolevel_hints_command *) lc; - -@@ -972,7 +800,9 @@ copy_twolevelhints (struct load_command - tlhp->offset += delta; - } - -+#if VERBOSE - printf ("Writing LC_TWOLEVEL_HINTS command\n"); -+#endif - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write two level hint command to header"); -@@ -980,14 +810,48 @@ copy_twolevelhints (struct load_command - curr_header_offset += lc->cmdsize; - } - -+#ifdef LC_DYLD_INFO -+/* Copy a LC_DYLD_INFO(_ONLY) load command from the input file to the output -+ file, adjusting the file offset fields. */ -+static void -+copy_dyld_info (struct load_command *lc, long delta) -+{ -+ struct dyld_info_command *dip = (struct dyld_info_command *) lc; -+ -+ if (dip->rebase_off > 0) -+ dip->rebase_off += delta; -+ if (dip->bind_off > 0) -+ dip->bind_off += delta; -+ if (dip->weak_bind_off > 0) -+ dip->weak_bind_off += delta; -+ if (dip->lazy_bind_off > 0) -+ dip->lazy_bind_off += delta; -+ if (dip->export_off > 0) -+ dip->export_off += delta; -+ -+#if VERBOSE -+ printf ("Writing "); -+ print_load_command_name (lc->cmd); -+ printf (" command\n"); -+#endif -+ -+ if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) -+ unexec_error ("cannot write dyld info command to header"); -+ -+ curr_header_offset += lc->cmdsize; -+} -+#endif -+ - /* Copy other kinds of load commands from the input file to the output - file, ones that do not require adjustments of file offsets. */ - static void - copy_other (struct load_command *lc) - { -+#if VERBOSE - printf ("Writing "); - print_load_command_name (lc->cmd); - printf (" command\n"); -+#endif - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write symtab command to header"); -@@ -998,283 +862,194 @@ copy_other (struct load_command *lc) - /* Loop through all load commands and dump them. Then write the Mach - header. */ - static void --dump_it () --{ -- int i; -+dump_it () { - -- printf ("--- Load Commands written to Output File ---\n"); -+ int i; -+ long linkedit_delta = 0; - -- curr_header_offset = sizeof (struct mach_header); -- delta = 0; -+#if VERBOSE -+ printf ("--- Load Commands written to Output File ---\n"); -+#endif - - for (i = 0; i < nlc; i++) -- switch (lca[i]->cmd) -+ switch (lca[i]->cmd) { -+ -+ case LC_SEGMENT: - { -- case LC_SEGMENT: -- { -- struct segment_command *scp = (struct segment_command *) lca[i]; -- if (strncmp (scp->segname, SEG_DATA, 16) == 0) -- { -- /* save data segment file offset and segment_command for unrelocate */ -- data_segment_old_fileoff = scp->fileoff; -- data_segment_scp = scp; -- copy_data_segment (lca[i]); -- } -- else -- { -- copy_segment (lca[i]); -- } -- } -- break; -- case LC_SYMTAB: -- copy_symtab (lca[i]); -- break; -- case LC_DYSYMTAB: -- copy_dysymtab (lca[i]); -- break; -- case LC_TWOLEVEL_HINTS: -- copy_twolevelhints (lca[i]); -- break; -- default: -- copy_other (lca[i]); -- break; -+ struct segment_command *scp = (struct segment_command *) lca[i]; -+ if (strncmp (scp->segname, SEG_DATA, 16) == 0) { -+ -+ /* save data segment file offset and segment_command for -+ unrelocate */ -+ -+ if (data_segment_old_fileoff) -+ unexec_error ("cannot handle multiple DATA segments in input file"); -+ -+ data_segment_old_fileoff = scp->fileoff; -+ data_segment_scp = scp; -+ -+ copy_data_segment (lca[i]); -+ -+ } else { -+ -+ if (strncmp (scp->segname, SEG_LINKEDIT, 16) == 0) { -+ if (linkedit_delta) -+ unexec_error ("cannot handle multiple LINKEDIT segments in input file"); -+ linkedit_delta = curr_file_offset - scp->fileoff; -+ } -+ -+ if (strncmp (scp->segname, "__HEAP", 16) != 0) copy_segment (lca[i]); else mh.ncmds--; -+ -+ } - } -- -+ break; -+ case LC_SYMTAB: -+ copy_symtab (lca[i], linkedit_delta); -+ break; -+ case LC_DYSYMTAB: -+ copy_dysymtab (lca[i], linkedit_delta); -+ break; -+ case LC_TWOLEVEL_HINTS: -+ copy_twolevelhints (lca[i], linkedit_delta); -+ break; -+#ifdef LC_DYLD_INFO -+ case LC_DYLD_INFO: -+ case LC_DYLD_INFO_ONLY: -+ copy_dyld_info (lca[i], linkedit_delta); -+ break; -+#endif -+ default: -+ copy_other (lca[i]); -+ break; -+ } -+ - if (curr_header_offset > text_seg_lowest_offset) - unexec_error ("not enough room for load commands for new __DATA segments"); -- -- printf ("%d unused bytes follow Mach-O header\n", -- (int) (text_seg_lowest_offset - curr_header_offset)); -- -+ -+#if VERBOSE -+ printf ("%ld unused bytes follow Mach-O header\n", -+ text_seg_lowest_offset - curr_header_offset); -+#endif -+ - mh.sizeofcmds = curr_header_offset - sizeof (struct mach_header); - if (!unexec_write (0, &mh, sizeof (struct mach_header))) - unexec_error ("cannot write final header contents"); --} - --/* Mark a range of virtual memory to be dumped upon unexec()'ing. */ -- --void --mark_region (unsigned long address, unsigned long size) --{ -- if (num_marked_regions < MAX_MARKED_REGIONS) -- { -- marked_regions[num_marked_regions].address = address; -- marked_regions[num_marked_regions].size = size; -- -- num_marked_regions++; -- } -- else { -- fprintf (stderr, "warning: too many marked regions\n"); -- fflush (stderr); -- } - } - -+/* Read header and load commands from input file. Store the latter in -+ the global array lca. Store the total number of load commands in -+ global variable nlc. */ - static void --add_marked_regions () --{ -- unsigned n; -- -- num_unexec_regions = 0; -- -- for (n=0 ; n < num_marked_regions ; n++) { -- if (num_marked_regions < MAX_UNEXEC_REGIONS) { -- unexec_regions[num_unexec_regions++] = marked_regions[n]; -- } else { -- fprintf (stderr, "warning: too many unexec regions\n"); -- fflush (stderr); -- } -- } --} -+read_load_commands_and_dump () { - --/* Take a snapshot of Emacs and make a Mach-O format executable file -- from it. The file names of the output and input files are outfile -- and infile, respectively. The three other parameters are -- ignored. */ --void --unexec (char *outfile, char *infile, void *start_data, void *start_bss, -- void *entry_address) --{ -- infd = open (infile, O_RDONLY, 0); -- if (infd < 0) -- { -- unexec_error ("cannot open input file `%s'", infile); -- } -+ int i; - -- outfd = open (outfile, O_WRONLY | O_TRUNC | O_CREAT, 0755); -- if (outfd < 0) -- { -- close (infd); -- unexec_error ("cannot open output file `%s'", outfile); -- } -- -- region_list_head = 0L; -- region_list_tail = 0L; -- -- infile_lc_highest_addr = 0; -- text_seg_lowest_offset = 0x10000000; -- -- curr_header_offset = sizeof (struct mach_header); -- delta = 0; -- linkedit_delta = 0; -- --#ifdef VERBOSE -- printf ("DBEGIN: %#10lx\n", (unsigned long) DBEGIN); -- printf ("mach_mapstart: %#10lx\n", (unsigned long) mach_mapstart); -- printf ("heap_end: %#10lx\n", (unsigned long) heap_end); -- printf ("core_end: %#10lx\n", (unsigned long) core_end); -- printf ("mach_brkpt: %#10lx\n", (unsigned long) mach_brkpt); -- printf ("mach_maplimit: %#10lx\n", (unsigned long) mach_maplimit); --#endif -- -- build_region_list (); -- read_load_commands (); -- --/*find_gcl_zone_regions ();*/ -- add_marked_regions (); -- -- in_dumped_exec = 1; -+ if (!unexec_read (&mh, sizeof (struct mach_header))) -+ unexec_error ("cannot read mach-o header"); - -- dump_it (); -+ if (mh.magic != MH_MAGIC) -+ unexec_error ("input file not in Mach-O format"); - -- close (outfd); --} -+ if (mh.filetype != MH_EXECUTE) -+ unexec_error ("input Mach-O file is not an executable object file"); - --static size_t stub_size (malloc_zone_t *zone, const void *ptr) --{ -- extern object malloc_list; -- object *p; -- -- for (p = &malloc_list ; *p && !endp(*p) ; p = &((*p)->c.c_cdr)) { -- size_t size = (*p)->c.c_car->st.st_dim; -- void *base = (*p)->c.c_car->st.st_self; -- if (ptr >= base && ptr < base + size) { -- return (size); -- } -- } -- return (0); --} -+#if VERBOSE -+ printf ("--- Header Information ---\n"); -+ printf ("Magic = 0x%08x\n", mh.magic); -+ printf ("CPUType = %d\n", mh.cputype); -+ printf ("CPUSubType = %d\n", mh.cpusubtype); -+ printf ("FileType = 0x%x\n", mh.filetype); -+ printf ("NCmds = %d\n", mh.ncmds); -+ printf ("SizeOfCmds = %d\n", mh.sizeofcmds); -+ printf ("Flags = 0x%08x\n", mh.flags); -+#endif - --static void *stub_malloc (malloc_zone_t *zone, size_t size) --{ -- extern void *my_malloc (size_t); -- return my_malloc (size); --} -+ nlc = mh.ncmds; -+ lca=alloca(nlc*sizeof(struct load_command *)); - --static void *stub_calloc (malloc_zone_t *zone, size_t num_items, size_t size) --{ -- extern void *my_calloc (size_t, size_t); -- return my_calloc (num_items, size); --} -+ for (i = 0; i < nlc; i++) { - --static void *stub_valloc (malloc_zone_t *zone, size_t size) --{ -- extern void *my_valloc (size_t); -- return my_valloc (size); --} -+ struct load_command lc; - --static void *stub_realloc (malloc_zone_t *zone, void *ptr, size_t size) --{ -- extern void *my_realloc (void *, size_t); -- return my_realloc (ptr, size); --} -+ /* Load commands are variable-size: so read the command type and -+ size first and then read the rest. */ - --static void stub_free (malloc_zone_t *zone, void *ptr) --{ -- extern void my_free (void *ptr); -- my_free (ptr); --} -+ if (!unexec_read (&lc, sizeof (struct load_command))) -+ unexec_error ("cannot read load command"); - --/* Create a new zone to accommodate GCL's heap and make it the default zone. */ -+ lca[i]=(struct load_command *)alloca(lc.cmdsize); -+ memcpy (lca[i], &lc, sizeof (struct load_command)); - --void init_darwin_zone_compat () --{ -- extern unsigned malloc_num_zones; -- extern malloc_zone_t **malloc_zones; -- unsigned malloc_num_zones_copy; -- malloc_zone_t **malloc_zones_copy; -- malloc_zone_t *default_zone; -- kern_return_t rtn; -- vm_map_t tself; -- vm_size_t s; -- unsigned i; -- -- if (mach_mapstart == 0) -- { -- unsigned long get_dsize (); -- char *get_dbegin (); -- -- char *self_name, *clone_name; -- char *dbegin = get_dbegin (); -- unsigned long dsize = get_dsize (); -- -- mach_mapstart = dbegin + dsize; -- heap_end = mach_mapstart; -- core_end = mach_mapstart; -- mach_brkpt = mach_mapstart; -- mach_maplimit = dbegin + MAXPAGE*PAGESIZE; -- -- GET_FULL_PATH_SELF (self_name); -+ if (!unexec_read (lca[i] + 1, lc.cmdsize - sizeof (struct load_command))) -+ unexec_error ("cannot read content of load command"); -+ if (lc.cmd == LC_SEGMENT) { -+ -+ struct segment_command *scp = (struct segment_command *) lca[i]; - -- GET_FULL_PATH_SELF (clone_name); -- strcat (clone_name, ".tmp"); -- -- mark_region (0,0); /* Just reserve space. */ -+ if (scp->vmaddr + scp->vmsize > infile_lc_highest_addr) -+ infile_lc_highest_addr = scp->vmaddr + scp->vmsize; - -- unexec (clone_name, self_name, 0, 0, 0); -- execv (clone_name, *_NSGetArgv ()); -- -- fprintf (stderr, "init_darwin_zone_compat(): execv() failed\n"); -- exit (1); -+ if (strncmp (scp->segname, SEG_TEXT, 16) == 0) { -+ -+ struct section *sectp = (struct section *) (scp + 1); -+ int j; -+ -+ for (j = 0; j < scp->nsects; j++) -+ if (sectp->offset < text_seg_lowest_offset) -+ text_seg_lowest_offset = sectp->offset; -+ } - } -- -- default_zone = malloc_default_zone (); -- -- if ((gcl_zone = malloc_create_zone (0,0)) == NULL) { -- fprintf (stderr, "init_darwin_zone_compat(): malloc_create_zone() failed\n"); -- exit (1); - } -- -- gcl_zone->size = (void *) stub_size; -- gcl_zone->malloc = (void *) stub_malloc; -- gcl_zone->calloc = (void *) stub_calloc; -- gcl_zone->valloc = (void *) stub_valloc; -- gcl_zone->realloc = (void *) stub_realloc; -- gcl_zone->free = (void *) stub_free; - -- /* Maybe we'll want to implement the zone introspector some day. */ -- -- malloc_num_zones_copy = malloc_num_zones; -- s = malloc_num_zones * sizeof (malloc_zone_t *); -- -- tself = mach_task_self (); -- -- rtn = vm_allocate (tself, (vm_address_t *) &malloc_zones_copy, s, 1); -- -- if (rtn != KERN_SUCCESS) { -- mach_error ("init_darwin_zone_compat(): vm_allocate() failed", rtn); -- exit (1); -- } -+#if VERBOSE -+ printf ("Highest address of load commands in input file: %#8x\n", -+ infile_lc_highest_addr); -+ -+ printf ("Lowest offset of all sections in __TEXT segment: %#8lx\n", -+ text_seg_lowest_offset); - -- memcpy (malloc_zones_copy, malloc_zones, s); -+ printf ("--- List of Load Commands in Input File ---\n"); -+ printf ("# cmd cmdsize name address size\n"); - -- for (i=0 ; i < malloc_num_zones_copy ; i++) { -- malloc_zone_unregister (malloc_zones_copy [i]); -+ for (i = 0; i < nlc; i++) { -+ printf ("%1d ", i); -+ print_load_command (lca[i]); - } -+#endif - -- /* Make our zone the default zone. */ -- malloc_zone_register (gcl_zone); -+ dump_it (); -+ -+} -+ -+/* Take a snapshot of Gcl and make a Mach-O format executable file -+ from it. The file names of the output and input files are outfile -+ and infile, respectively. The three other parameters are -+ ignored. */ -+void -+unexec (char *outfile, char *infile, void *start_data, void *start_bss, -+ void *entry_address) { -+ -+ reset_unexec_globals(); - -- for (i=0 ; i < malloc_num_zones_copy ; i++) { -- if (malloc_zones_copy [i] != gcl_zone) -- malloc_zone_register (malloc_zones_copy [i]); -+ pagesize = getpagesize (); -+ if ((infd = open (infile, O_RDONLY, 0)) < 0) -+ unexec_error ("cannot open input file `%s'", infile); -+ -+ if ((outfd = open (outfile, O_WRONLY | O_TRUNC | O_CREAT, 0755)) < 0) { -+ close (infd); -+ unexec_error ("cannot open output file `%s'", outfile); - } - -- vm_deallocate (tself, (vm_address_t) malloc_zones_copy, s); -+ read_load_commands_and_dump(); -+ -+ close (outfd); -+ - } - - /* Replacement for broken sbrk(2). */ - --char *my_sbrk (int incr) -+void *my_sbrk (int incr) - { - char *temp, *ptr; - kern_return_t rtn; -@@ -1282,19 +1057,18 @@ char *my_sbrk (int incr) - if (mach_brkpt == 0) { - if ((rtn = vm_allocate (mach_task_self (), (vm_address_t *) &mach_brkpt, - big_heap, 1)) != KERN_SUCCESS) { -- malloc_printf ("my_sbrk(): vm_allocate() failed\n"); -- abort (); -+ unexec_error("my_sbrk(): vm_allocate() failed\n"); - return ((char *)-1); - } - if (!mach_brkpt) { - /* Call this instead of fprintf() because no allocation is performed. */ -- malloc_printf ("my_sbrk(): cannot allocate heap\n"); -+ unexec_error("my_sbrk(): cannot allocate heap\n"); - return ((char *)-1); - } -- mark_region ((unsigned long) mach_brkpt, (unsigned long) big_heap); - - mach_mapstart = mach_brkpt; - mach_maplimit = mach_brkpt + big_heap; -+ - } - if (incr == 0) { - return (mach_brkpt); -@@ -1305,120 +1079,119 @@ char *my_sbrk (int incr) - mach_brkpt = ptr; - return (temp); - } else { -- malloc_printf ("my_sbrk(): no more memory\n"); -+ unexec_error("my_sbrk(): no more memory\n"); - return ((char *)-1); - } - } - } - --/* The file has non Mach-O stuff appended. We need to now where the Mach-O -- stuff ends. Put this here, although it pertains to fasload()'ing, because -- we'll stop using sfaslmacosx.c. */ -- --int seek_to_end_ofile (FILE *fp) -+static size_t stub_size (malloc_zone_t *zone, const void *ptr) - { -- struct mach_header mach_header; -- char *hdrbuf; -- struct load_command *load_command; -- struct segment_command *segment_command; -- struct section *section; -- struct symtab_command *symtab_command; -- struct symseg_command *symseg_command; -- int len, cmd, seg; -- int end_sec, end_ofile; -- malloc_zone_t *dzone = malloc_default_zone (); -- -- end_ofile = 0; -- fseek (fp, 0L, 0); -- len = fread ((char *)&mach_header, sizeof(struct mach_header), 1, fp); -- -- if (len == 1 && mach_header.magic == MH_MAGIC) -- { -- hdrbuf = (char *) malloc_zone_malloc (dzone, mach_header.sizeofcmds); -- len = fread(hdrbuf, mach_header.sizeofcmds, 1, fp); -- -- if (len != 1) -- { -- fprintf(stderr, "seek_to_end_ofile(): " -- "failure reading Mach-O load commands\n"); -- return 0; -- } -+ extern object malloc_list; -+ object *p; - -- load_command = (struct load_command *) hdrbuf; -- for (cmd = 0; cmd < mach_header.ncmds; ++cmd) -- { -- switch (load_command->cmd) -- { -- case LC_SEGMENT: -- segment_command = (struct segment_command *) load_command; -- section = (struct section *) ((char *)(segment_command + 1)); -- for (seg = 0; seg < segment_command->nsects; ++seg, ++section) -- { -- end_sec = section->offset + section->size; -- if (end_sec > end_ofile) -- end_ofile = end_sec; -- } -- break; -- -- case LC_SYMTAB: -- symtab_command = (struct symtab_command *) load_command; -- end_sec = symtab_command->symoff -- + symtab_command->nsyms * sizeof(struct nlist); -- if (end_sec > end_ofile) -- end_ofile = end_sec; -- end_sec = symtab_command->stroff + symtab_command->strsize; -- if (end_sec > end_ofile) -- end_ofile = end_sec; -- break; -- -- case LC_SYMSEG: -- symseg_command = (struct symseg_command *) load_command; -- end_sec = symseg_command->offset + symseg_command->size; -- if (end_sec > end_ofile) -- end_ofile = end_sec; -- break; -- } -- load_command = (struct load_command *) -- ((char *)load_command + load_command->cmdsize); -+ for (p = &malloc_list ; *p && !endp(*p) ; p = &((*p)->c.c_cdr)) { -+ size_t size = (*p)->c.c_car->st.st_dim; -+ void *base = (*p)->c.c_car->st.st_self; -+ if (ptr >= base && ptr < base + size) { -+ return (size); - } -- -- malloc_zone_free (dzone, hdrbuf); -- fseek(fp, end_ofile, 0); -- -- return 1; - } -- -- return 0; -+ return (0); - } - --/* Return where the first __DATA segment starts in memory. */ -+#ifdef HAVE_MALLOC_ZONE_MEMALIGN -+static void * -+stub_memalign(size_t boundary, size_t size) { -+ -+ extern void *my_malloc (size_t); -+ void *v=my_malloc(size+boundary-1); -+ return (void *)(((unsigned long)v+boundary-1)&~(boundary-1)); - --char *get_dbegin () --{ -- static char *dbegin = 0; -- if (dbegin == 0) { -- const struct segment_command *data = getsegbyname (SEG_DATA); -- if (data != NULL) -- dbegin = (char *) data->vmaddr; -- } -- return dbegin; - } -+#endif - --/* Return the size of the first __DATA segment. */ -+static void * -+stub_malloc(malloc_zone_t *zone, size_t size) { -+ -+ extern void *my_malloc (size_t); -+ return my_malloc (size); -+ -+} -+ -+static void * -+stub_calloc(malloc_zone_t *zone, size_t num_items, size_t size) { -+ -+ extern void *my_calloc (size_t, size_t); -+ return my_calloc (num_items, size); -+ -+} -+ -+static void * -+stub_valloc(malloc_zone_t *zone, size_t size) { -+ -+ extern void *my_valloc (size_t); -+ return my_valloc (size); -+ -+} -+ -+static void * -+stub_realloc(malloc_zone_t *zone, void *ptr, size_t size) { -+ -+ extern void *my_realloc (void *, size_t); -+ return my_realloc (ptr, size); -+ -+} -+ -+static void stub_free (malloc_zone_t *zone, void *ptr) { -+ -+ extern void my_free (void *ptr); -+ my_free (ptr); -+ -+} -+ -+void init_darwin_zone_compat () { -+ -+ extern unsigned malloc_num_zones; -+ extern malloc_zone_t **malloc_zones; -+ unsigned nmzc; -+ malloc_zone_t *mzc[10]; -+ unsigned i; -+ -+ nmzc=malloc_num_zones; -+ assert(nmzc<=sizeof(mzc)/sizeof(*mzc)); -+ memcpy(mzc,malloc_zones,nmzc*sizeof(*mzc)); -+ -+ gcl_zone = malloc_create_zone (0, 0); -+ malloc_set_zone_name (gcl_zone, "GclZone"); -+ -+ gcl_zone->size = (void *) stub_size; -+ gcl_zone->malloc = (void *) stub_malloc; -+ gcl_zone->calloc = (void *) stub_calloc; -+ gcl_zone->valloc = (void *) stub_valloc; -+ gcl_zone->realloc = (void *) stub_realloc; -+ gcl_zone->free = (void *) stub_free; -+ gcl_zone->destroy = (void *) stub_free; -+ gcl_zone->batch_malloc = (void *) stub_malloc; -+ gcl_zone->batch_free = (void *) stub_free; -+ -+#ifdef HAVE_MALLOC_ZONE_MEMALIGN -+ gcl_zone->free_definite_size = (void *) stub_free; -+ gcl_zone->memalign = (void *) stub_memalign; -+#endif -+ -+ malloc_zone_unregister(gcl_zone); -+ for (i=0;ivmsize; -- } -- return dsize; - } - - #ifdef UNIXSAVE - #include "save.c" - #endif - -- ---- gcl-2.6.7.orig/o/usig.c -+++ gcl-2.6.7/o/usig.c -@@ -61,7 +61,7 @@ gcl_signal(int signo, void (*handler) (/ - struct sigaction action; - action.sa_handler = handler; - /* action.sa_flags = SA_RESTART | ((signo == SIGSEGV || signo == SIGBUS) ? SV_ONSTACK : 0) */ -- action.sa_flags = SA_RESTART | ((signo == SIGSEGV || signo == SIGBUS) ? SV_ONSTACK : 0) -+ action.sa_flags = SA_RESTART | ((signo == SIGSEGV || signo == SIGBUS) ? SA_ONSTACK : 0) - #ifdef SA_SIGINFO - | SA_SIGINFO - #endif ---- gcl-2.6.7.orig/o/number.c -+++ gcl-2.6.7/o/number.c -@@ -245,6 +245,12 @@ number_to_double(object x) - - case t_ratio: - -+ /* vs_base=vs_top; */ -+ /* vs_push(x); */ -+ /* Lround(); */ -+ /* if (vs_base[0]!=small_fixnum(0)) */ -+ /* return number_to_double(vs_base[0])+number_to_double(vs_base[1]); */ -+ /* else */ - { - double dx,dy; - object xx,yy; -@@ -289,9 +295,9 @@ gcl_init_number(void) - int i; - - for (i = -SMALL_FIXNUM_LIMIT; i < SMALL_FIXNUM_LIMIT; i++) { -- small_fixnum_table[i + SMALL_FIXNUM_LIMIT].t -+ small_fixnum_table[i + SMALL_FIXNUM_LIMIT].FIX.t - = (short)t_fixnum; -- small_fixnum_table[i + SMALL_FIXNUM_LIMIT].FIXVAL = i; -+ small_fixnum_table[i + SMALL_FIXNUM_LIMIT].FIX.FIXVAL = i; - } - - shortfloat_zero = alloc_object(t_shortfloat); ---- gcl-2.6.7.orig/o/usig2.c -+++ gcl-2.6.7/o/usig2.c -@@ -228,13 +228,13 @@ before_interrupt(struct save_for_interru - SS1(p->free2[i],OBJ_LINK(p->free1[i])); - ad->tm_nfree --; - bcopy(beg ,&(p->buf[i]), amt); -- bzero(beg+8,amt-8); -+ bzero(beg+sizeof(struct freelist),amt-sizeof(struct freelist)); - x->d.m = 0; - if (p->free2[i]) - { x = (object) p->free2[i]; - beg = (char *)x; - x->d.m = 0; -- bzero(beg+8,amt-8); -+ bzero(beg+sizeof(struct freelist),amt-sizeof(struct freelist)); - SS1(ad->tm_free,OBJ_LINK(p->free2[i])); - ad->tm_nfree --; - } ---- gcl-2.6.7.orig/o/unixsys.c -+++ gcl-2.6.7/o/unixsys.c -@@ -21,8 +21,18 @@ Foundation, 675 Mass Ave, Cambridge, MA - - #include - #include -+#include -+#include -+#include -+ -+ - #include "include.h" - -+#ifdef _WIN32 -+#include -+#define sleep(n) Sleep(1000 * n) -+#endif -+ - #ifdef ATT3B2 - #include - int -@@ -57,6 +67,106 @@ char *command; - } - #endif - -+#ifdef _WIN32 -+ -+DEFVAR("*WINE-DETECTED*",sSAwine_detectedA,SI,Cnil,""); -+ -+#include "windows.h" -+ -+static int mpid; -+ -+void -+close_msys() { -+ -+ msystem(""); -+ -+} -+ -+void -+detect_wine() { -+ -+ char b[4096]; -+ struct stat ss; -+ const char *s="/proc/self/status"; -+ FILE *f; -+ object o; -+ -+ sSAwine_detectedA->s.s_dbind=Cnil; -+ -+ if (stat(s,&ss)) -+ return; -+ -+ massert(f=fopen(s,"r")); -+ massert(fscanf(f,"%s",b)==1); -+ massert(fscanf(f,"%s",b)==1); -+ massert(!fclose(f)); -+ -+ if (strncmp("wineserver",b,9)) -+ return; -+ -+ massert(o=sSAsystem_directoryA->s.s_dbind); -+ massert(o!=Cnil); -+ mpid=getpid(); -+ -+ massert(snprintf(b,sizeof(b),"%-.*smsys /tmp/ out%0d tmp%0d log%0d", -+ o->st.st_fillp,o->st.st_self,mpid,mpid,mpid)>0); -+ massert(!system(b)); -+ -+ sSAwine_detectedA->s.s_dbind=Ct; -+ -+ massert(!atexit(close_msys)); -+ -+} -+#endif -+ -+int -+msystem(const char *s) { -+ -+ int r; -+ -+#ifdef _WIN32 -+ -+ if (sSAwine_detectedA->s.s_dbind==Ct) { -+ -+ char b[4096],b1[4096],c; -+ FILE *fp; -+ -+ massert(snprintf(b,sizeof(b),"/tmp/out%0d",mpid)>0); -+ massert(snprintf(b1,sizeof(b1),"%s1",b)>0); -+ -+ massert(fp=fopen(b1,"w")); -+ massert(fprintf(fp,"%s",s)>=0); -+ massert(!fclose(fp)); -+ -+ massert(MoveFileEx(b1,b,MOVEFILE_REPLACE_EXISTING)); -+ -+ if (!*s) -+ return 0; -+ -+ for (;;Sleep(100)) { -+ -+ massert(fp=fopen(b,"r")); -+ massert((c=fgetc(fp))!=EOF); -+ if (c!=s[0]) { -+ massert(ungetc(c,fp)!=EOF); -+ break; -+ } -+ massert(!fclose(fp)); -+ -+ } -+ -+ massert(fscanf(fp,"%d",&r)==1); -+ massert(!fclose(fp)); -+ -+ } else -+ -+#endif -+ r=system(s); -+ -+ return r; -+ -+} -+ - static void - FFN(Lsystem)(void) - { -@@ -73,7 +183,7 @@ FFN(Lsystem)(void) - {int old = signals_allowed; - int res; - signals_allowed = sig_at_read; -- res = system(command) ; -+ res = msystem(command) ; - signals_allowed = old; - vs_base[0] = make_fixnum(res >> 8); - vs_base[1] = make_fixnum((res & 0xff)); -@@ -86,8 +196,93 @@ DEFUN_NEW("GETPID",object,fSgetpid,SI,0, - { return make_fixnum(getpid()); - } - -+ -+DEFVAR("*LOAD-WITH-FREAD*",sSAload_with_freadA,SI,Cnil,""); -+ -+#ifdef _WIN32 -+ -+void * -+get_mmap(FILE *fp,void **ve) { -+ -+ int n; -+ void *st; -+ size_t sz; -+ HANDLE handle; -+ -+ massert((sz=file_len(fp))>0); -+ if (sSAload_with_freadA->s.s_dbind==Cnil) { -+ n=fileno(fp); -+ massert((n=fileno(fp))>2); -+ massert(handle = CreateFileMapping((HANDLE)_get_osfhandle(n), NULL, PAGE_WRITECOPY, 0, 0, NULL)); -+ massert(st=MapViewOfFile(handle,FILE_MAP_COPY,0,0,sz)); -+ CloseHandle(handle); -+ } else { -+ massert(st=malloc(sz)); -+ massert(fread(st,sz,1,fp)==1); -+ } -+ -+ *ve=st+sz; -+ -+ return st; -+ -+} -+ -+int -+un_mmap(void *v1,void *ve) { -+ -+ if (sSAload_with_freadA->s.s_dbind==Cnil) -+ return UnmapViewOfFile(v1) ? 0 : -1; -+ else { -+ free(v1); -+ return 0; -+ } -+ -+} -+ -+ -+#else -+ -+#include -+ -+void * -+get_mmap(FILE *fp,void **ve) { -+ -+ int n; -+ void *v1; -+ struct stat ss; -+ -+ massert((n=fileno(fp))>2); -+ massert(!fstat(n,&ss)); -+ if (sSAload_with_freadA==Cnil) { -+ massert((v1=mmap(0,ss.st_size,PROT_READ|PROT_WRITE,MAP_PRIVATE,n,0))!=(void *)-1); -+ } else { -+ massert(v1=malloc(ss.st_size)); -+ massert(fread(v1,ss.st_size,1,fp)==1); -+ } -+ -+ *ve=v1+ss.st_size; -+ return v1; -+ -+} -+ -+ -+int -+un_mmap(void *v1,void *ve) { -+ -+ if (sSAload_with_freadA==Cnil) -+ return munmap(v1,ve-v1); -+ else { -+ free(v1); -+ return 0; -+ } -+ -+} -+ -+#endif -+ - void --gcl_init_unixsys(void) --{ -- make_function("SYSTEM", Lsystem); -+gcl_init_unixsys(void) { -+ -+ make_function("SYSTEM", Lsystem); -+ - } ---- gcl-2.6.7.orig/o/read.d -+++ gcl-2.6.7/o/read.d -@@ -22,9 +22,12 @@ Foundation, 675 Mass Ave, Cambridge, MA - read.d - */ - -+ - #define NEED_ISFINITE - #include "include.h" -+ - #include -+#include - - static object - current_readtable(void); -@@ -256,7 +259,15 @@ object in; - - x = read_object(in); - vs_push(x); -- -+#ifndef _WIN32 -+ while (listen_stream(in)) { -+ object c=read_char(in); -+ if (cat(c)!=cat_whitespace) { -+ unread_char(c,in); -+ break; -+ } -+ } -+#endif - if (sharp_eq_context_max > 0) - x = vs_head = patch_sharp(x); - -@@ -553,17 +564,17 @@ M: - dot_flag = TRUE; - vs_reset; - return(Cnil); -- } else if (!escape_flag && length > 0) { -- for (i = 0; i < length; i++) -- if (token->st.st_self[i] != '.') -- goto N; -- FEerror("Dots appeared illegally.", 0); -+ } else if (!escape_flag && length > 0) { -+ for (i = 0; i < length; i++) -+ if (token->st.st_self[i] != '.') -+ goto N; -+ FEerror("Dots appeared illegally.", 0); - } - --N: -+N: - token->st.st_fillp = length; - if (escape_flag || (READbase<=10 && token_buffer[0]>'9')) -- goto SYMBOL; -+ goto SYMBOL; - x = parse_number(token_buffer, length, &i, READbase); - if (x != OBJNULL && length == i) { - vs_reset; -@@ -638,7 +649,7 @@ SYMBOL: - static void - Lleft_parenthesis_reader() - { -- object in, c, x; -+ object in, x; - object *p; - - check_arg(2); -@@ -654,18 +665,17 @@ Lleft_parenthesis_reader() - if (dot_flag) { - if (p == &vs_head) - FEerror("A dot appeared after a left parenthesis.", 0); -+ delimiting_char = code_char(')'); - in_list_flag = TRUE; - *p = read_object(in); - if (dot_flag) - FEerror("Two dots appeared consecutively.", 0); -- c = read_char(in); -- while (cat(c) == cat_whitespace) -- c = read_char(in); -- if (char_code(c) != ')') -- FEerror("A dot appeared before a right parenthesis.", 0); -- else if (PP0>P0) PP0--; /* should be the only other place -- outside of read_object where -- closing parens are read */ -+ if (*p==OBJNULL) -+ FEerror("Object missing after dot.", 0); -+ delimiting_char = code_char(')'); -+ in_list_flag = TRUE; -+ if (read_object(in)!=OBJNULL) -+ FEerror("Two objects after dot.",0); - goto ENDUP; - } - vs_push(x); -@@ -686,6 +696,28 @@ ENDUP: - (i) == 'b' || (i) == 'B') - - double pow(); -+ -+static double -+new_fraction(char *s,int end,int exp_pos,int *err) { -+ -+ char ch,ch1=0,*p; -+ double fraction; -+ -+ ch=s[end]; -+ s[end]=0; -+ if (exp_pos>=0) {ch1=s[exp_pos];s[exp_pos]='E';} -+/* sscanf(s,"%lf",&fraction);*/ -+ errno=0; -+ fraction=strtod(s,&p); -+ *err=errno || *p; -+ s[end]=ch; -+ if (exp_pos>=0) s[exp_pos]=ch1; -+ -+ return fraction; -+ -+} -+ -+ - /* - Parse_number(s, end, ep, radix) parses C string s - up to (but not including) s[end] -@@ -697,264 +729,259 @@ double pow(); - If not, OBJNULL is returned. - */ - static object --parse_number(s, end, ep, radix) --char *s; --int end, *ep, radix; --{ -- object x=Cnil; -- fixnum sign; -- object integer_part; -- double fraction, fraction_unit, f; -- char exponent_marker; -- int exponent; -- int i, j, k; -- int d; -- vs_mark; -- -- if (s[end-1] == '.') -- radix = 10; -- /* -- DIRTY CODE!! -- */ --BEGIN: -- exponent_marker = 'E'; -- i = 0; -- sign = 1; -- if (s[i] == '+') -- i++; -- else if (s[i] == '-') { -- sign = -1; -- i++; -- } -- integer_part = (object) big_register_0; -- zero_big(big_register_0); -- vs_push((object)integer_part); -- if (i >= end) -- goto NO_NUMBER; -- if (s[i] == '.') { -- if (radix != 10) { -- radix = 10; -- goto BEGIN; -- } -- i++; -- goto FRACTION; -- } -- if ((d = digitp(s[i], radix)) < 0) -- goto NO_NUMBER; --#define MOST_POSITIVE_FIX (((unsigned int) (~0) ) /2) --#define TEN_EXPT_9 1000000000 -- -- if (radix == 10 && TEN_EXPT_9 = 0); -- if (chunk) { -- int fac=10; -- while(--chunk> 0) {fac *=10;} -- mul_int_big(fac,integer_part); -- add_int_big(sum,integer_part); -- } -- -- } else { -- -- -- do { -- mul_int_big(radix, integer_part); -- add_int_big(d, integer_part); -- i++; -- } while (i < end && (d = digitp(s[i], radix)) >= 0); -- } -+parse_number(char *s, int end, int *ep, int radix) { - -+ object x=Cnil; -+ fixnum sign; -+ object integer_part; -+ double fraction, fraction_unit, f; -+ char exponent_marker; -+ int exponent,exp_pos=-1; -+ int i, j, k; -+ int d; -+ vs_mark; -+ -+ BEGIN: -+ exponent_marker = 'E'; -+ i = 0; -+ sign = 1; -+ if (s[i] == '+') -+ i++; -+ else if (s[i] == '-') { -+ sign = -1; -+ i++; -+ } -+ integer_part = (object) big_register_0; -+ zero_big(big_register_0); -+ vs_push((object)integer_part); -+ if (i >= end) -+ goto NO_NUMBER; - -- if (i >= end) -- goto MAKE_INTEGER; -- if (s[i] == '.') { -- if (radix != 10) { -- radix = 10; -- goto BEGIN; -- } -- if (++i >= end) -- goto MAKE_INTEGER; -- else if (digitp(s[i], radix) >= 0) -- goto FRACTION; -- else if (is_exponent_marker(s[i])) { -- fraction -- = (double)sign * big_to_double(integer_part); -- goto EXPONENT; -- } else -- goto MAKE_INTEGER; -- } -- if (s[i] == '/') { -- i++; -- goto DENOMINATOR; -- } -- if (is_exponent_marker(s[i])) { -- fraction = (double)sign * big_to_double(integer_part); -- goto EXPONENT; -- } --/* -- goto NO_NUMBER; --*/ -- --MAKE_INTEGER: -- if (sign < 0 && signe(MP(integer_part))) -- set_big_sign(integer_part,-1); -- x = normalize_big_to_object(integer_part); --/**/ -- if (x == big_register_0) -- big_register_0 = alloc_object(t_bignum); -- zero_big(big_register_0); -- --/**/ -- goto END; -- --FRACTION: --/* -- if (radix != 10) -- goto NO_NUMBER; --*/ -- radix = 10; -- if ((d = digitp(s[i], radix)) < 0) -- goto NO_NUMBER; -- fraction = 0.0; -- fraction_unit = 1000000000.0; -- for (;;) { -- k = j = 0; -- do { -- j = 10*j + d; -- i++; -- k++; -- if (i < end) -- d = digitp(s[i], radix); -- else -- break; -- } while (k < 9 && d >= 0); -- while (k++ < 9) -- j *= 10; -- fraction += ((double)j /fraction_unit); -- if (i >= end || d < 0) -- break; -- fraction_unit *= 1000000000.0; -- } -- fraction += big_to_double(integer_part); -- fraction *= (double)sign; -- if (i >= end) -- goto MAKE_FLOAT; -- if (is_exponent_marker(s[i])) -- goto EXPONENT; -- goto MAKE_FLOAT; -- --EXPONENT: --/* -- if (radix != 10) -- goto NO_NUMBER; --*/ -- radix = 10; -- exponent_marker = s[i]; -- i++; -- if (i >= end) -- goto NO_NUMBER; -- sign = 1; -- if (s[i] == '+') -- i++; -- else if (s[i] == '-') { -- sign = -1; -- i++; -- } -- if (i >= end) -- goto NO_NUMBER; -- if ((d = digitp(s[i], radix)) < 0) -- goto NO_NUMBER; -- exponent = 0; -- do { -- exponent = 10 * exponent + d; -- i++; -- } while (i < end && (d = digitp(s[i], radix)) >= 0); -- d = exponent; -- f = 10.0; -- /* Use pow because it is more accurate */ -- { double po = pow(10.0,(double)(sign * d)); -- if (po == 0.0) -- { fraction = fraction *pow(10.0,(double)(sign * (d-1))); -- fraction /= 10.0;} -- else -- fraction = fraction * po;} -+ j=i; - --MAKE_FLOAT: -+#define MOST_POSITIVE_FIX (((unsigned long) (~0) ) /2) -+/*FIXME 64!!!*/ -+#define TEN_EXPT_9 1000000000 -+ -+ if (radix == 10 && TEN_EXPT_9 = 0) { -+ sum = 10*sum+d; -+ chunk++; -+ if (chunk == 9) { -+ mul_int_big(1000000000, integer_part); -+ add_int_big(sum, integer_part); -+ chunk=0; sum=0; -+ } -+ i++; -+ } -+ -+ if (chunk) { -+ -+ int fac=10; -+ -+ while(--chunk> 0) -+ fac *=10; -+ -+ mul_int_big(fac,integer_part); -+ add_int_big(sum,integer_part); -+ -+ } -+ -+ } else -+ -+ while (i < end && (d = digitp(s[i], radix)) >= 0) { -+ mul_int_big(radix, integer_part); -+ add_int_big(d, integer_part); -+ i++; -+ } -+ -+ if (i >= end) -+ goto MAKE_INTEGER; -+ if (s[i] == '/') { -+ if (i==j || ++i >= end || (d = digitp(s[i], radix)) < 0) -+ goto NO_NUMBER; -+ goto DENOMINATOR; -+ } -+ -+ if (radix!=10) -+ for (j=i;j= end) -+ goto MAKE_INTEGER; -+ else if ((d=digitp(s[i], radix)) >= 0) -+ goto FRACTION; -+ else if (is_exponent_marker(s[i])) { -+ fraction -+ = (double)sign * big_to_double(integer_part); -+ goto EXPONENT; -+ } else -+ goto MAKE_INTEGER; -+ } -+ if (is_exponent_marker(s[i])) { -+ fraction = (double)sign * big_to_double(integer_part); -+ goto EXPONENT; -+ } -+ -+ /* -+ goto NO_NUMBER; -+ */ -+ -+ MAKE_INTEGER: -+ if (sign < 0 && signe(MP(integer_part))) -+ set_big_sign(integer_part,-1); -+ x = normalize_big_to_object(integer_part); -+ if (x == big_register_0) -+ big_register_0 = alloc_object(t_bignum); -+ zero_big(big_register_0); -+ -+ goto END; -+ -+ FRACTION: -+ if (radix!=10) -+ FEerror("Parse_number radix error", 0); -+/* if ((d = digitp(s[i], radix)) < 0) */ -+/* goto NO_NUMBER; */ -+ fraction = 0.0; -+ fraction_unit = 1000000000.0; -+ for (;;) { -+ k = j = 0; -+ do { -+ j = 10*j + d; -+ i++; -+ k++; -+ if (i < end) -+ d = digitp(s[i], radix); -+ else -+ break; -+ } while (k < 9 && d >= 0); -+ while (k++ < 9) -+ j *= 10; -+ fraction += ((double)j /fraction_unit); -+ if (i >= end || d < 0) -+ break; -+ fraction_unit *= 1000000000.0; -+ } -+ fraction += big_to_double(integer_part); -+ fraction *= (double)sign; -+ if (i >= end) -+ goto MAKE_FLOAT; -+ if (is_exponent_marker(s[i])) -+ goto EXPONENT; -+ goto MAKE_FLOAT; -+ -+ EXPONENT: -+ if (radix!=10) -+ FEerror("Parse_number radix error", 0); -+ exponent_marker = s[i]; -+ exp_pos=i; -+ i++; -+ if (i >= end) -+ goto NO_NUMBER; -+ sign = 1; -+ if (s[i] == '+') -+ i++; -+ else if (s[i] == '-') { -+ sign = -1; -+ i++; -+ } -+ if (i >= end) -+ goto NO_NUMBER; -+ if ((d = digitp(s[i], radix)) < 0) -+ goto NO_NUMBER; -+ exponent = 0; -+ do { -+ exponent = 10 * exponent + d; -+ i++; -+ } while (i < end && (d = digitp(s[i], radix)) >= 0); -+ d = exponent; -+ f = 10.0; -+ /* Use pow because it is more accurate */ -+ { double po = pow(10.0,(double)(sign * d)); -+ if (po == 0.0) -+ { fraction = fraction *pow(10.0,(double)(sign * (d-1))); -+ fraction /= 10.0;} -+ else -+ fraction = fraction * po;} -+ -+ MAKE_FLOAT: - #ifdef IEEEFLOAT --/* if ((*((int *)&fraction +HIND) & 0x7ff00000) == 0x7ff00000)*/ -- if (!ISFINITE(fraction)) -- FEerror("Floating-point overflow.", 0); -+ if (!ISFINITE(fraction)) -+ FEerror("Floating-point overflow.", 0); - #endif -- switch (exponent_marker) { -- -- case 'e': case 'E': -- exponent_marker = READdefault_float_format; -- goto MAKE_FLOAT; -- -- case 's': case 'S': -- x = make_shortfloat((shortfloat)fraction); -- break; -- -- case 'f': case 'F': case 'd': case 'D': case 'l': case 'L': -- x = make_longfloat((longfloat)fraction); -- break; -- -- case 'b': case 'B': -- goto NO_NUMBER; -- } --/**/ -- zero_big(big_register_0); -- -- --/**/ -- goto END; -- --DENOMINATOR: -- if (sign < 0) -- set_big_sign(integer_part,-1); -- vs_push(normalize_big_to_object(integer_part)); --/**/ -- if (vs_head == big_register_0) -- big_register_0 = new_bignum(); -- zero_big(big_register_0); -- --/**/ -- if ((d = digitp(s[i], radix)) < 0) -- goto NO_NUMBER; -- integer_part = big_register_0; -- /* zero_big(integer_part); */ -- do { -- mul_int_big(radix, integer_part); -- add_int_big(d, integer_part); -- i++; -- } while (i < end && (d = digitp(s[i], radix)) >= 0); -- vs_push(normalize_big_to_object(integer_part)); -- x = make_ratio(vs_top[-2], vs_top[-1]); -- goto END; -- --END: -- *ep = i; -- vs_reset; -- return(x); -- --NO_NUMBER: -- *ep = i; -- vs_reset; --/**/ -- zero_big(big_register_0); -+ switch (exponent_marker) { -+ -+ case 'e': case 'E': -+ exponent_marker = READdefault_float_format; -+ goto MAKE_FLOAT; -+ -+ case 's': case 'S': -+ { -+ int err; -+ /*FIXME code above cannot re-read denormalized numbers accurately*/ -+ x = make_shortfloat((shortfloat)new_fraction(s,end,exp_pos,&err)); -+ if (err) goto NO_NUMBER; -+ } -+ break; -+ -+ case 'f': case 'F': case 'd': case 'D': case 'l': case 'L': -+ { -+ int err; -+ x = make_longfloat((longfloat)new_fraction(s,end,exp_pos,&err)); -+ if (err) goto NO_NUMBER; -+ } -+ break; -+ -+ case 'b': case 'B': -+ goto NO_NUMBER; -+ } - -+ zero_big(big_register_0); -+ -+ goto END; -+ -+ DENOMINATOR: -+ if (sign < 0) -+ set_big_sign(integer_part,-1); -+ vs_push(normalize_big_to_object(integer_part)); -+ -+ if (vs_head == big_register_0) -+ big_register_0 = new_bignum(); -+ zero_big(big_register_0); -+ -+/* if ((d = digitp(s[i], radix)) < 0) */ -+/* goto NO_NUMBER; */ -+ integer_part = big_register_0; -+ /* zero_big(integer_part); */ -+ do { -+ mul_int_big(radix, integer_part); -+ add_int_big(d, integer_part); -+ i++; -+ } while (i < end && (d = digitp(s[i], radix)) >= 0); -+ vs_push(normalize_big_to_object(integer_part)); -+ x = make_ratio(vs_top[-2], vs_top[-1]); -+ goto END; -+ -+ END: -+ *ep = i; -+ vs_reset; -+ return(x); -+ -+ NO_NUMBER: -+ *ep = i; -+ vs_reset; -+ zero_big(big_register_0); -+ -+ return(OBJNULL); - -- /**/ -- return(OBJNULL); - } - - static object -@@ -1011,7 +1038,7 @@ NO_NUMBER: - /**/ - return(OBJNULL); - } -- -+ - - static void - too_long_string(void); -@@ -2259,9 +2286,13 @@ READ: - else if (strm == Ct) - strm = symbol_value(sLAterminal_ioA); - check_type_stream(&strm); -- if (!listen_stream(strm)) -- /* Incomplete! */ -- @(return Cnil) -+ if (stream_at_end(strm)) { -+ if (eof_errorp == Cnil) -+ @(return eof_value) -+ else -+ end_of_stream(strm); -+ } -+ if (!listen_stream(strm)) @(return Cnil) - @(return `read_char(strm)`) - @) - ---- gcl-2.6.7.orig/o/bind.c -+++ gcl-2.6.7/o/bind.c -@@ -708,7 +708,7 @@ letA_bind(object body, struct bind_temp - #define NOT_KEYWORD 1 - - void --parse_key(object *base, bool rest, bool allow_other_keys, register int n, ...) -+parse_key(object *base, bool rest, bool allow_other_keys,int n, ...) - { - object temporary; - va_list ap; -@@ -1072,8 +1072,8 @@ set_key_struct(struct key *ks, object da - {int i=ks->n; - while (--i >=0) - {ks->keys[i].o = data->cfd.cfd_self[ ks->keys[i].i ]; -- if (ks->defaults != (iobject *)Cstd_key_defaults) -- {int m=ks->defaults[i].i; -+ if (ks->defaults != (void *)Cstd_key_defaults) -+ {fixnum m=ks->defaults[i].i; - ks->defaults[i].o= - (m==-2 ? Cnil : - m==-1 ? (object)0 : ---- gcl-2.6.7.orig/o/print.d -+++ gcl-2.6.7/o/print.d -@@ -482,11 +482,11 @@ int level; - */ - short ois[IS_SIZE]; - -- int oqh; -- int oqt; -- int oqc; -- int oisp; -- int oiisp; -+ VOL int oqh; -+ VOL int oqt; -+ VOL int oqc; -+ VOL int oisp; -+ VOL int oiisp; - - ONCE_MORE: - if (interrupt_flag) { ---- gcl-2.6.7.orig/o/cmpaux.c -+++ gcl-2.6.7/o/cmpaux.c -@@ -24,6 +24,9 @@ Foundation, 675 Mass Ave, Cambridge, MA - cmpaux.c - */ - -+#include -+#include -+ - #include - #include - #include -@@ -31,6 +34,8 @@ Foundation, 675 Mass Ave, Cambridge, MA - #include "include.h" - #define dcheck_type(a,b) check_type(a,b) - -+#include "page.h" -+ - DEFUNO_NEW("SPECIALP",object,fSspecialp,SI - ,1,1,NONE,OO,OO,OO,OO,void,siLspecialp,(object sym),"") - { -@@ -202,6 +207,31 @@ object_to_int(object x) - return(i); - } - -+fixnum -+object_to_fixnum(object x) -+{ -+ fixnum i=0; -+ -+ switch (type_of(x)) { -+ case t_character: -+ i = char_code(x); break; -+ case t_fixnum: -+ i = fix(x); break; -+ case t_bignum: -+ i = number_to_double(x); -+ break; -+ case t_ratio: -+ i = number_to_double(x); break; -+ case t_shortfloat: -+ i = sf(x); break; -+ case t_longfloat: -+ i = lf(x); break; -+ default: -+ FEerror("~S cannot be coerce to a C int.", 1, x); -+ } -+ return(i); -+} -+ - float - object_to_float(object x) - { -@@ -253,26 +283,31 @@ object_to_double(object x) - have a null character in the fillpointer position. */ - - char * --object_to_string(object x) --{ unsigned int leng; -+object_to_string(object x) { -+ -+ unsigned int leng; -+ long np; -+ char *res; -+ - if (type_of(x)!=t_string) FEwrong_type_argument(sLstring,x); - leng= x->st.st_fillp; - /* user has thoughtfully provided a null terminated string ! */ -- if (leng > 0 && leng < x->st.st_dim && x->st.st_self[leng]==0) -+ if (leng > 0 && leng < x->st.st_dim && x->st.st_self[leng]==0) - return x->st.st_self; -- if (x->st.st_dim == leng -- && ( leng % sizeof(object)) -- ) -- { x->st.st_self[leng] = 0; -- return x->st.st_self; -- } -- else -- {char *res=malloc(leng+1); -- bcopy(x->st.st_self,res,leng); -- res[leng]=0; -- return res; -- }} - -+ np=page(x->st.st_self); -+ if (x->st.st_dim == leng && leng % sizeof(object) -+ && npst.st_self[leng] = 0; -+ return x->st.st_self; -+ } -+ -+ res=malloc(leng+1); -+ bcopy(x->st.st_self,res,leng); -+ res[leng]=0; -+ return res; -+ -+} - - /* typedef int (*FUNC)(); */ - -@@ -436,24 +471,29 @@ char *s; - #endif - - void --gcl_init_or_load1(void (*fn)(void),char *file) --{int n=strlen(file); -- if (file[n-1]=='o') -- { object memory; -- object fasl_data; -- file=FIX_PATH_STRING(file); -- -- memory=alloc_object(t_cfdata); -- memory->cfd.cfd_self=0; -- memory->cfd.cfd_fillp=0; -- memory->cfd.cfd_size = 0; -- printf("Initializing %s\n",file); fflush(stdout); -- fasl_data = read_fasl_data(file); -- memory->cfd.cfd_start= (char *)fn; -- call_init(0,memory,fasl_data,0); -+gcl_init_or_load1(void (*fn)(void),const char *file) { -+ -+ if (file[strlen(file)-1]=='o') { -+ -+ object memory; -+ object fasl_data; -+ file=FIX_PATH_STRING(file); -+ -+ memory=alloc_object(t_cfdata); -+ memory->cfd.cfd_self=0; -+ memory->cfd.cfd_fillp=0; -+ memory->cfd.cfd_size = 0; -+ printf("Initializing %s\n",file); fflush(stdout); -+ fasl_data = read_fasl_data(file); -+ memory->cfd.cfd_start= (char *)fn; -+ call_init(0,memory,fasl_data,0); -+ -+ } else { -+ printf("loading %s\n",file); -+ fflush(stdout); -+ load(file); - } -- else -- {printf("loading %s\n",file); fflush(stdout); load(file);} -+ - } - - DEFUN_NEW("INIT-CMP-ANON", object, fSinit_cmp_anon, SI, 0, 0, -@@ -480,3 +520,60 @@ function.") - return i ? Cnil : Ct; - - } -+ -+object -+find_init_name1(char *s,unsigned len) { -+ -+#ifdef _WIN32 -+ -+ char *tmp; -+ -+ if (len) { -+ tmp=alloca(len+1); -+ memcpy(tmp,s,len); -+ tmp[len]=0; -+ } else -+ tmp=s; -+ -+ return find_init_string(tmp); -+ -+#else -+/* These functions have no relevance on Windows -+ * as dlopen and friends don't exist in that part of Cyberspace. */ -+ -+ struct stat ss; -+ char *tmp,*q; -+ FILE *f; -+ -+ if (len) { -+ tmp=alloca(len+1); -+ memcpy(tmp,s,len); -+ tmp[len]=0; -+ } else -+ tmp=s; -+ if (stat(tmp,&ss)) -+ FEerror("File ~a does not exist",1,make_simple_string(tmp)); -+ if (!(f=fopen(tmp,"rb"))) -+ FEerror("Cannot open ~a for binary reading",1,make_simple_string(tmp)); -+ tmp=alloca(ss.st_size+1); -+ if (fread(tmp,1,ss.st_size,f)!=ss.st_size) -+ FEerror("Error reading binary file",0); -+ fclose(f); -+ for (s=tmp;sst.st_self,namestring->st.st_dim); -+ -+} -+ ---- gcl-2.6.7.orig/o/fasdump.c -+++ gcl-2.6.7/o/fasdump.c -@@ -382,6 +382,9 @@ getd(str) - #define MASK ~(~0 << 8) - #define WRITE_BYTEI(x,i) putc((((x) >> (i*SIZE_BYTE)) & MASK),fas_stream) - -+#define PUTFIX(v_) Join(PUT,SIZEOF_LONG)(v_) -+#define GETFIX(v_) Join(GET,SIZEOF_LONG)(v_) -+ - #define PUT8(varx ) \ - do{unsigned long var= varx ; \ - DPRINTF("{8byte:varx= %ld}", var); \ -@@ -665,7 +668,7 @@ FFN(close_fasd)(object ar) - - static void - write_fasd(object obj) --{ int j,leng; -+{ fixnum j,leng; - - /* hook for writing other data in fasd file */ - -@@ -778,7 +781,7 @@ write_fasd(object obj) - else - {PUT_OP(d_fixnum); - j=leng; -- PUT4(j);} -+ PUTFIX(j);} - break; - case DP(t_character:) - PUT_OP(d_standard_character); -@@ -1264,8 +1267,8 @@ read_fasd1(int i, object *loc) - return;} - - case DP(d_fixnum:) -- {int j; -- GET4(j); -+ {fixnum j; -+ GETFIX(j); - *loc=make_fixnum(j); - return;} - case DP( d_bignum:) ---- gcl-2.6.7.orig/unixport/init_ansi_gcl.lsp.in -+++ gcl-2.6.7/unixport/init_ansi_gcl.lsp.in -@@ -44,7 +44,7 @@ - (dolist (d (list lsp cmpnew pcl clcs)) - (load (make-pathname :name "sys-proclaim" :type "lisp" :directory d))) - (load (make-pathname :name "tk-package" :type "lsp" :directory gtk)) -- (load (make-pathname :name "gcl_cmpmain" :type "lsp" :directory cmpnew)) -+; (load (make-pathname :name "gcl_cmpmain" :type "lsp" :directory cmpnew)) - (load (make-pathname :name "gcl_lfun_list" :type "lsp" :directory cmpnew)) - (load (make-pathname :name "gcl_cmpopt" :type "lsp" :directory cmpnew)) - (load (make-pathname :name "gcl_auto_new" :type "lsp" :directory lsp)) -@@ -98,7 +98,8 @@ - (cond ((si::get-command-arg "-batch") - (setq si::*top-level-hook* 'bye)) - ((si::get-command-arg "-f")) -- (t (format t si::*system-banner*))) -+ (t (format t si::*system-banner*) -+ (format t "Temporary directory for compiler files set to ~a~%" *tmp-dir*))) - (setq si::*ihs-top* 1) - (in-package 'system::user) (incf system::*ihs-top* 2) - (funcall system::*old-top-level*)) -@@ -243,7 +244,7 @@ - pprint-dispatch pprint-exit-if-list-exhausted pprint-fill - pprint-indent pprint-linear pprint-logical-block pprint-newline - pprint-pop pprint-tab pprint-tabular print-not-readable-object -- print-unreadable-object read-sequence readtable-case row-major-aref -+ print-unreadable-object readtable-case row-major-aref - set-pprint-dispatch simple-condition-format-control - stream-external-format synonym-stream-symbol - translate-logical-pathname translate-pathname -@@ -251,7 +252,7 @@ - unbound-slot-instance - upgraded-complex-part-type wild-pathname-p with-compilation-unit - with-condition-restarts with-package-iterator with-standard-io-syntax -- write-sequence )) -+ )) - (shadowing-import (list s) "COMMON-LISP")) - - (use-package "ANSI-LOOP" "COMMON-LISP") ---- gcl-2.6.7.orig/unixport/rsym_macosx.c -+++ gcl-2.6.7/unixport/rsym_macosx.c -@@ -14,212 +14,86 @@ - - #include - #include -- - #include - --#ifdef STANDALONE - #include --#define SPECIAL_RSYM --#endif -- - #include - #include - #include - #include - #include -+#include - - #define IN_RSYM 1 - --/* #include "config.h" */ - #include "ext_sym.h" - --int verbose = 0; -+#define massert(a_) if (!(a_)) {fprintf(stderr,"The assertion %s on line %d of %s in function %s failed", \ -+ #a_,__LINE__,__FILE__,__FUNCTION__);exit(-1);} - --void rsym_error (char *format, ...) --{ -- va_list ap; -- -- va_start (ap, format); -- fprintf (stderr, "rsym: "); -- vfprintf (stderr, format, ap); -- /* fprintf (stderr, " (%s)", strerror(errno)); */ -- fprintf (stderr, "\n"); -- va_end (ap); -- exit (1); --} -+int -+main(int argc,char * argv[],char **envp) { - --int rsym_select_symbol(struct nlist *symbol) --{ -- if (symbol->n_type & N_STAB) { -- return (FALSE); -- } -- if (!(symbol->n_type & N_EXT)) { -- return (FALSE); -- } -- /* if (symbol->n_type == N_UNDF) { -- return (FALSE); -- } -- if (symbol->n_sect == NO_SECT) { -- return (FALSE); -- } -- */ -- return (TRUE); --} -+ struct stat ss; -+ struct mach_header *mh; -+ struct load_command *lc; -+ struct symtab_command *st=NULL; -+ struct nlist *sym1,*sym,*syme; -+ struct lsymbol_table tab; -+ char *strtab; -+ void *addr; -+ int i,l; -+ FILE *f; -+ -+ massert(!stat(argv[1],&ss)); -+ massert((l=open(argv[1],O_RDONLY,0))>0); -+ massert((addr=mmap(0,ss.st_size,PROT_READ|PROT_WRITE,MAP_PRIVATE,l,0))!=(void *)-1); -+ -+ mh=addr; -+ lc=addr+sizeof(*mh); -+ -+ for (i=0;incmds;i++,lc=(void *)lc+lc->cmdsize) -+ if (lc->cmd==LC_SYMTAB) { -+ st=(void *) lc; -+ break; -+ } -+ -+ massert(st); -+ sym1=addr+st->symoff; -+ syme=sym1+st->nsyms; -+ strtab=addr+st->stroff; -+ -+ tab.n_symbols=0; -+ tab.tot_leng=0; -+ -+ massert(f=fopen (argv[2], "wb")); -+ fseek(f,sizeof(tab),0); -+ -+ for (sym=sym1;symn_un.n_strx + strtab; -+ -+ if (sym->n_type & N_STAB) -+ continue; -+ if (!(sym->n_type & N_EXT)) -+ continue; -+ -+ fwrite (&sym->n_value,sizeof(sym->n_value),1,f); -+ tab.n_symbols++; -+ -+ fprintf(f,"%s",name); -+ putc (0, f); -+ tab.tot_leng+=strlen(name)+1; -+ -+ } -+ -+ fseek (f, 0, 0); -+ fwrite (&tab, sizeof(tab), 1, f); -+ fclose (f); - --void rsym_doit2 (struct nlist *symbols, unsigned long nsyms, char *outfile) --{ -- unsigned long i; -- struct lsymbol_table tab; -- FILE *symout; -- -- if (!(symout = fopen (outfile, "wb"))) { -- rsym_error ("cannot open file for writing: %s", outfile); -- } -+ munmap(addr,ss.st_size); -+ close (l); - -- tab.n_symbols=0; -- tab.tot_leng=0; -- -- fseek (symout, sizeof(tab), 0); -- -- for (i=0 ; i < nsyms ; i++) -- { -- int addr = (int) symbols[i].n_value; -- char *name = symbols[i].n_un.n_name; -- -- if (name) -- { -- tab.n_symbols++; -- fwrite (&addr, sizeof (int), 1, symout); -- while (tab.tot_leng++, *name) -- putc (*name++, symout); -- putc (0, symout); -- } -- else { -- fprintf (stderr, "warning: malformed symbol\n"); -- } -- } -- -- if (verbose) { -- fprintf (stdout, "%d/%ld symbol(s) reviewed\n", tab.n_symbols, nsyms); -- } -- -- fseek (symout, 0, 0); -- fwrite (&tab, sizeof(tab), 1, symout); -- -- fclose (symout); --} -+ return 0; - --void rsym_doit1 (char *infile, char *outfile) --{ -- struct stat stat_buf; -- struct mach_header *mh; -- struct load_command *lc; -- struct symtab_command *st; -- struct dysymtab_command *dyst; -- unsigned long nsyms, i, size; -- unsigned long strsize; -- struct nlist *symtab, *selected_symbols; -- kern_return_t r; -- char *strtab; -- vm_size_t s; -- char *addr; -- int fd; -- -- if ((fd = open (infile, O_RDONLY, 0)) < 0) { -- rsym_error ("cannot open input file: %s", infile); -- } -- -- if (fstat (fd, &stat_buf) == -1) { -- rsym_error ("cannot fstat file: %s", infile); -- } -- -- size = stat_buf.st_size; -- -- if ((r = map_fd (fd, (vm_offset_t) 0, (vm_offset_t *) &addr, -- (boolean_t) TRUE, (vm_size_t) size)) != KERN_SUCCESS) { -- rsym_error ("cannot map file in memory: %s", infile); -- } -- -- mh = (struct mach_header *) addr; -- lc = (struct load_command *) ((char *) addr + sizeof(struct mach_header)); -- -- for (i=0 ; i < mh->ncmds ; i++) { -- if (lc->cmd == LC_SYMTAB) { -- st = (struct symtab_command *) lc; -- } -- else if (lc->cmd == LC_DYSYMTAB) { -- dyst = (struct dysymtab_command *) lc; -- } -- lc = (struct load_command *) ((char *) lc + lc->cmdsize); -- } -- -- if (!st) { -- rsym_error ("no symbol table information"); -- } -- -- symtab = (struct nlist *) ((char *) addr + st->symoff); -- -- s = sizeof(struct nlist) * st->nsyms; -- if (vm_allocate (mach_task_self (), (vm_address_t *) &selected_symbols, s, 1) != KERN_SUCCESS) { -- rsym_error ("could not vm_allocate"); -- } -- -- nsyms = 0; -- -- for (i = 0 ; i < st->nsyms ; i++) { -- if (rsym_select_symbol (symtab + i)) -- selected_symbols[nsyms++] = symtab[i]; -- } -- -- strtab = addr + st->stroff; -- strsize = st->strsize; -- -- for (i = 0 ; i < nsyms ; i++) { -- if (selected_symbols[i].n_un.n_strx == 0) -- selected_symbols[i].n_un.n_name = ""; -- else if (selected_symbols[i].n_un.n_strx < 0 || -- selected_symbols[i].n_un.n_strx > strsize) -- selected_symbols[i].n_un.n_name = "bad string index"; -- else -- selected_symbols[i].n_un.n_name = selected_symbols[i].n_un.n_strx + strtab; -- -- if (verbose) { -- fprintf (stdout, "%8x %s\n", (unsigned int) selected_symbols[i].n_value, -- selected_symbols[i].n_un.n_name); -- } -- } -- -- rsym_doit2 (selected_symbols, nsyms, outfile); -- -- if (vm_deallocate (mach_task_self (), (vm_address_t) selected_symbols, s) != KERN_SUCCESS) { -- fprintf (stderr, "warning: failed to free memory\n"); -- } -- -- if (vm_deallocate (mach_task_self (), (vm_address_t) addr, (vm_size_t) size) != KERN_SUCCESS) { -- fprintf (stderr, "warning: failed to deallocate mapped file\n"); -- } -- -- close (fd); --} -- --int main (int argc, char **argv, char **envp) --{ -- int ch; -- -- while ((ch = getopt (argc, argv, "-v")) != -1) { -- if (ch == 'v') -- verbose = 1; -- } -- -- argc -= optind; -- argv += optind; -- -- if (argc < 2) { -- fprintf (stderr, "usage: rsym [-v(erbose)] \n"); -- exit (1); -- } -- -- rsym_doit1 (argv[0], argv[1]); -- -- return 0; - } ---- /dev/null -+++ gcl-2.6.7/unixport/sys.c -@@ -0,0 +1,64 @@ -+#include -+#include -+#include -+#include -+#include "../h/include.h" -+ -+static void -+ar_init_fn(void (fn)(void),const char *s) { -+ -+ char b[200]; -+ struct stat ss; -+ object sysd=sSAsystem_directoryA->s.s_dbind; -+ -+ if (stat(s,&ss)) { -+ assert(snprintf(b,sizeof(b),"ar x %-.*slib%sgcl.a %s",sysd->st.st_fillp,sysd->st.st_self,FLAVOR,s)>0); -+ assert(!msystem(b)); -+#ifdef _WIN32 -+ if (sSAwine_detectedA->s.s_dbind!=Cnil) { -+ char *n; -+ unsigned l; -+ l=strlen(s)+6; -+ n=alloca(l); -+ snprintf(n,l,"/tmp/%s",s); -+ s=(void *)n; -+ } -+#endif -+ } -+ gcl_init_or_load1(fn,s); -+ assert(!unlink(s)); -+ -+} -+ -+static void -+ar_check_init_fn(void (fn)(void),char *s,object b,char *o) { -+ -+ object t; -+ -+ for (t=b->s.s_dbind; -+ !endp(t) && -+ type_of(t->c.c_car)==t_string && -+ strcmp(s,t->c.c_car->st.st_self);t=t->c.c_cdr); -+ if (endp(t)) -+ ar_init_fn(fn,o); -+ -+} -+ -+#define proc(init,fn,args...) {extern void init(void);fn(init,##args);} -+ -+#define ar_init(a) proc(Mjoin(init_,a),ar_init_fn,#a ".o") -+#define ar_check_init(a,b) proc(Mjoin(init_,a),ar_check_init_fn,#a,b,#a ".o") -+ -+ -+static void -+lsp_init(const char *a) { -+ -+ char b[200]; -+ object sysd=sSAsystem_directoryA->s.s_dbind; -+ -+ assert(snprintf(b,sizeof(b),"%-.*s%s",sysd->st.st_fillp,sysd->st.st_self,a)>0) -+ printf("loading %s\n",b); -+ fflush(stdout); -+ load(b); -+ -+} ---- gcl-2.6.7.orig/unixport/init_pcl_gcl.lsp.in -+++ gcl-2.6.7/unixport/init_pcl_gcl.lsp.in -@@ -39,7 +39,7 @@ - (dolist (d (list lsp cmpnew pcl)) - (load (make-pathname :name "sys-proclaim" :type "lisp" :directory d))) - (load (make-pathname :name "tk-package" :type "lsp" :directory gtk)) -- (load (make-pathname :name "gcl_cmpmain" :type "lsp" :directory cmpnew)) -+; (load (make-pathname :name "gcl_cmpmain" :type "lsp" :directory cmpnew)) - (load (make-pathname :name "gcl_lfun_list" :type "lsp" :directory cmpnew)) - (load (make-pathname :name "gcl_cmpopt" :type "lsp" :directory cmpnew)) - (load (make-pathname :name "gcl_auto_new" :type "lsp" :directory lsp)) -@@ -93,7 +93,8 @@ - (cond ((si::get-command-arg "-batch") - (setq si::*top-level-hook* 'bye)) - ((si::get-command-arg "-f")) -- (t (format t si::*system-banner*))) -+ (t (format t si::*system-banner*) -+ (format t "Temporary directory for compiler files set to ~a~%" *tmp-dir*))) - (setq si::*ihs-top* 1) - (in-package 'system::user) (incf system::*ihs-top* 2) - (funcall system::*old-top-level*)) ---- gcl-2.6.7.orig/unixport/ansi_cl.lisp -+++ gcl-2.6.7/unixport/ansi_cl.lisp -@@ -126,7 +126,7 @@ make-load-form-saving-slots make-method - pprint-dispatch pprint-exit-if-list-exhausted pprint-fill - pprint-indent pprint-linear pprint-logical-block pprint-newline - pprint-pop pprint-tab pprint-tabular print-not-readable-object --print-unreadable-object read-sequence readtable-case row-major-aref -+print-unreadable-object readtable-case row-major-aref - set-pprint-dispatch simple-condition-format-control - stream-external-format synonym-stream-symbol - translate-logical-pathname translate-pathname -@@ -134,7 +134,7 @@ two-way-stream-input-stream two-way-stre - unbound-slot-instance - upgraded-complex-part-type wild-pathname-p with-compilation-unit - with-condition-restarts with-package-iterator with-standard-io-syntax --write-sequence )) -+ )) - (shadowing-import (list s) "COMMON-LISP")) - - (use-package "ANSI-LOOP" "COMMON-LISP") ---- gcl-2.6.7.orig/unixport/makefile -+++ gcl-2.6.7/unixport/makefile -@@ -4,16 +4,20 @@ LIBC = -lc - - -include ../makedefs - -+RSYM= -+ - HDIR = ../h - ODIR = ../o - MDIR = ../mod - LSPDIR = ../lsp - CMPDIR = ../cmpnew -+XDIR = ../xgcl-2 - CLCSDIR = ../clcs - PCLDIR = ../pcl - PORTDIR = $(shell pwd) - --LD_LIBS_PRE=$(FIRST_FILE) $(addprefix -u ,$(PATCHED_SYMBOLS)) -+LD_FLAGS=$(LDFLAGS) $(FIRST_FILE) -+LD_LIBS_PRE=$(addprefix -u ,$(PATCHED_SYMBOLS)) - LD_LIBS_POST=$(LIBS) $(LIBC) -lgclp $(LAST_FILE) - - ifeq ($(ARRS),) -@@ -24,7 +28,7 @@ libgclp.a: $(ODIR)/gcllib.a - cp $< $@ - ranlib $@ - --gmpfiles: $(shell find ../$(GMPDIR) -name "*.o" |grep -v '\.lib') -+gmpfiles: $(shell [ -z "$(GMPDIR)" ] || find ../$(GMPDIR) -name "*.o" |grep -v '\.lib') - rm -rf gmp - mkdir gmp - a="$^" ; \ -@@ -33,7 +37,7 @@ gmpfiles: $(shell find ../$(GMPDIR) -nam - done - touch $@ - --bfdfiles: $(shell find ../binutils -name "*.o") -+bfdfiles: $(shell ! [ -d ../binutils ] || find ../binutils -name "*.o") - rm -rf bfd - mkdir bfd - a="$^" ; \ -@@ -42,16 +46,17 @@ bfdfiles: $(shell find ../binutils -name - done - touch $@ - --OOBJS:=$(shell j=$$(ar t $(ODIR)/gcllib.a) ; for i in $$(ls -1 $(ODIR)/*.o) ; do if ! echo $$j |grep $$(basename $$i) >/dev/null 2>&1 ; then echo $$i ; fi ; done) -+OOBJS:=$(shell j=$$(ar t $(ODIR)/gcllib.a) ; for i in $$(find $(ODIR) -name "*.o") ; do if ! echo $$j |grep $$(basename $$i) >/dev/null 2>&1 ; then echo $$i ; fi ; done) - OOBJS:=$(filter-out $(FIRST_FILE),$(OOBJS)) - OOBJS:=$(filter-out $(LAST_FILE),$(OOBJS)) - OOBJS:=$(filter-out $(ODIR)/plttest.o,$(OOBJS)) --OBJS:=$(OOBJS) $(shell ls -1 $(LSPDIR)/*.o) --OBJS:=$(OBJS) $(shell ls -1 $(CMPDIR)/*.o | grep -v collectfn.o) -- --MODOBJS:=$(shell ls -1 $(MDIR)/*.o) --PCLOBJS:=$(MODOBJS) $(shell ls -1 $(PCLDIR)/*.o) --ANSIOBJS:=$(PCLOBJS) $(shell ls -1 $(CLCSDIR)/*.o) -+OBJS:=$(OOBJS) $(shell find $(LSPDIR) -name "*.o") -+OBJS:=$(OBJS) $(shell find $(XDIR) -name "*.o") -+OBJS:=$(OBJS) $(shell find $(CMPDIR) -name "*.o" | grep -v collectfn.o) -+ -+#MODOBJS:=$(shell find $(MDIR) -name "*.o") -+PCLOBJS:=$(shell find $(PCLDIR) -name "*.o") -+ANSIOBJS:=$(PCLOBJS) $(shell find $(CLCSDIR) -name "*.o") - - $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.lsp - cp $< $@ -@@ -72,10 +77,10 @@ init_xgcl.lsp.tmp: init_gcl.lsp.tmp - - init_pcl_gcl.lsp.tmp: init_pcl_gcl.lsp.in ../cmpnew/gcl_cmpmain.lsp \ - ../pcl/sys-package.lisp ../clcs/package.lisp \ -- $(shell ls -1 ../clcs/clcs_*.lisp) -+ $(shell find ../clcs/ -name "clcs_*.lisp") - - awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} {if (i==0) print}' $< >$@ -- cat ../cmpnew/gcl_cmpmain.lsp >>$@ -+# cat ../cmpnew/gcl_cmpmain.lsp >>$@ - cat ../pcl/sys-package.lisp >>$@ - awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} {if (i==1) print}' $< >>$@ - -@@ -84,7 +89,7 @@ init_ansi_gcl.lsp.tmp: init_ansi_gcl.lsp - - awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \ - /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==0) print}' $< >$@ -- cat ../cmpnew/gcl_cmpmain.lsp >>$@ -+# cat ../cmpnew/gcl_cmpmain.lsp >>$@ - cat ../pcl/sys-package.lisp >>$@ - awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \ - /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==1) print}' $< >>$@ -@@ -101,13 +106,13 @@ init_%.lsp: init_%.lsp.tmp - -e "s#@LI-MINVERS@#`cat ../minvers | cut -f1 -d.`#1" \ - -e "s#@LI-MAJVERS@#`cat ../majvers`#1" \ - -e "s#@LI-CC@#\"$(CC) -c $(FINAL_CFLAGS)\"#1" \ -- -e "s#@LI-LD@#\"$(CC) -o \"#1" \ -+ -e "s#@LI-LD@#\"$(CC) $(LD_FLAGS) -o \"#1" \ - -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST)\"#1" \ - -e "s#@LI-OPT-THREE@#\"$(O3FLAGS)\"#1" \ - -e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \ - -e "s#@LI-INIT-LSP@#\"$@\"#1" >$@ - --saved_%:raw_% $(RSYM) init_%.lsp raw_%_map \ -+saved_%:raw_% $(RSYM) init_%.lsp raw_%_map msys \ - $(CMPDIR)/gcl_cmpmain.lsp \ - $(CMPDIR)/gcl_lfun_list.lsp \ - $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \ -@@ -115,10 +120,14 @@ saved_%:raw_% $(RSYM) init_%.lsp raw_%_m - - cp init_$*.lsp foo - echo " (in-package \"USER\")(system:save-system \"$@\")" >>foo -+ ar x lib$*.a $$(ar t lib$*.a |grep ^gcl_) - $(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo - - $(RSYM): $(SPECIAL_RSYM) $(HDIR)/mdefs.h -- $(CC) $(CFLAGS) -I$(HDIR) -I$(ODIR) -o $(RSYM) $(SPECIAL_RSYM) -+ $(CC) $(LD_FLAGS) $(CFLAGS) -I$(HDIR) -I$(ODIR) -o $(RSYM) $(SPECIAL_RSYM) -+ -+msys: msys.c -+ PATH=/usr/bin:$$PATH gcc $< -o $@ # Unix binary if running wine - - $(HDIR)/mdefs.h: $(HDIR)/include.h - cat $(HDIR)/include.h | sed -e "/include/d" > $(HDIR)/mdefs.h -@@ -131,9 +140,9 @@ libpre_gcl.a: $(OOBJS) sys_pre_gcl.o gmp - rm -rf $@ - $(ARRS) $@ $(filter %.o,$^) $(shell find gmp bfd -name "*.o") - --libmod_gcl.a: $(OBJS) $(MODOBJS) sys_mod_gcl.o gmpfiles bfdfiles # plt_mod_gcl.o -- rm -rf $@ -- $(ARRS) $@ $(filter %.o,$^) $(shell find gmp bfd -name "*.o") -+#libmod_gcl.a: $(OBJS) $(MODOBJS) sys_mod_gcl.o gmpfiles bfdfiles # plt_mod_gcl.o -+# rm -rf $@ -+# $(ARRS) $@ $(filter %.o,$^) $(shell find gmp bfd -name "*.o") - - libxgcl.a: libgcl.a - ln -snf $< $@ -@@ -146,14 +155,12 @@ libpcl_gcl.a: $(OBJS) $(PCLOBJS) sys_pcl - rm -rf $@ - $(ARRS) $@ $(filter %.o,$^) $(shell find gmp bfd -name "*.o") - --raw_%_map raw_%: lib%.a libgclp.a $(SYSTEM_OBJS) $(EXTRAS) -+raw_%_map raw_%: lib%.a libgclp.a $(SYSTEM_OBJS) #$(EXTRAS) - touch raw_$*_map - ifeq ($(GNU_LD),1) -- $(CC) -o raw_$*$(EXE) $(filter %.o,$^) \ -- -L. $(EXTRA_LD_LIBS) -Wl,-Map raw_$*_map $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST) -+ $(CC) $(LD_FLAGS) -o raw_$*$(EXE) $(filter %.o,$^) -L. $(EXTRA_LD_LIBS) -Wl,-Map raw_$*_map $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST) - else -- $(CC) -o raw_$*$(EXE) $(filter %.o,$^) \ -- -L. $(EXTRA_LD_LIBS) $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST) -+ $(CC) $(LD_FLAGS) -o raw_$*$(EXE) $(filter %.o,$^) -L. $(EXTRA_LD_LIBS) $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST) - endif - # diff map_$* map_$*.old >/dev/null || (cp map_$* map_$*.old && rm -f $@ && $(MAKE) $@) - # cp map_$*.old map_$* -@@ -161,21 +168,21 @@ endif - map_%: - touch $@ - --plt_%.h: map_% -- cat $< | awk '/^ .plt/ {if (NF==4) i=1;next;} \ -- {if (!NF) i=0; if (!i) next; } \ -- {b=$$2; sub("@.*$$","",b);print "{\"" b "\"," $$1 "}"}' | \ -- sort | awk '{A[++k]=$$0} END {for (i=1;i<=k;i++) \ -+#plt_%.h: map_% -+# cat $< | awk '/^ .plt/ {if (NF==4) i=1;next;} \ -+# {if (!NF) i=0; if (!i) next; } \ -+# {b=$$2; sub("@.*$$","",b);print "{\"" b "\"," $$1 "}"}' | \ -+# sort | awk '{A[++k]=$$0} END {for (i=1;i<=k;i++) \ - printf("%s%s\n",A[i],i==k ? "" : ",")}' >$@ - --plt_%.o: plt_%.h plt.c -- ln -snf $< plt.h -- $(CC) -c -o $@ plt.c $(CFLAGS) -I$(HDIR) -I$(ODIR) -+#plt_%.o: plt_%.h plt.c -+# ln -snf $< plt.h -+# $(CC) $(LD_FLAGS) -c -o $@ plt.c $(CFLAGS) -I$(HDIR) -I$(ODIR) - - clean: - rm -rf saved_*$(EXE) raw_*$(EXE) *.o core a.out $(RSYM) \ - $(LSPDIR)/auto_new.lsp foo *maxima* init_*.lsp lib*.a gmp* bfd* *.lsp.tmp \ -- gazonk*.lsp plt*h *_map saved_* lib* raw_* -+ gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* - - .INTERMEDIATE: init_ansi_gcl.lsp.tmp init_gcl.lsp.tmp raw_gcl raw_ansi_gcl --.PRECIOUS: init_gcl.lsp init_ansi_gcl.lsp -+.PRECIOUS: init_pre_gcl.lsp init_gcl.lsp init_ansi_gcl.lsp ---- gcl-2.6.7.orig/unixport/init_pre_gcl.lsp.in -+++ gcl-2.6.7/unixport/init_pre_gcl.lsp.in -@@ -86,7 +86,8 @@ - (cond ((si::get-command-arg "-batch") - (setq si::*top-level-hook* 'bye)) - ((si::get-command-arg "-f")) -- (t (format t si::*system-banner*))) -+ (t (format t si::*system-banner*) -+ (format t "Temporary directory for compiler files set to ~a~%" *tmp-dir*))) - (setq si::*ihs-top* 1) - (in-package 'system::user) (incf system::*ihs-top* 2) - (funcall system::*old-top-level*)) ---- gcl-2.6.7.orig/unixport/sys_gcl.c -+++ gcl-2.6.7/unixport/sys_gcl.c -@@ -1,62 +1,9 @@ --#include --#include --#include "../h/include.h" -- --extern object user_init(); -- -- --void gcl_init_or_load1 (void (*)(void),char *); --#define init_or_load(fn,file) do {extern void fn(void); gcl_init_or_load1(fn,file);} \ -- while(0) -- --/* #define mjoin(a,b) a ## b */ --/* #define Mjoin(a,b) mjoin(a,b) */ -- --#define ar_init(a) do {\ -- char b[200];\ -- \ -- if (snprintf(b,sizeof(b),"ar x %-*.*slibgcl.a %s.o",\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_self,#a)<=0)\ -- error("Cannot unpack module " #a "o\n");\ -- if (system(b)) \ -- error("Cannot run ar command to unpack module " #a ".o\n");\ -- init_or_load(Mjoin(init_,a),#a ".o");\ -- if (unlink(#a ".o"))\ -- error("Cannot unlink " #a ".o\n");\ --} while(0) -- --#define ar_check_init(a,b) do {\ -- object t;\ -- \ -- for (t=b->s.s_dbind;!endp(t) && type_of(t->c.c_car)==t_string && strcmp(#a,t->c.c_car->st.st_self);t=t->c.c_cdr);\ -- if (endp(t))\ -- ar_init(a);\ --} while(0) -- -- --static void --load1(x) -- char *x; --{printf("loading %s\n",x); -- fflush(stdout); -- load(x);} -- --#define lsp_init(a) do {\ -- char b[200];\ -- \ -- if (snprintf(b,sizeof(b),"%-*.*s%s",\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_self,a)<=0)\ -- error("Cannot append system directory\n");\ -- load1(b);\ --} while(0) -+#define FLAVOR "" -+ -+#include "sys.c" - - void --gcl_init_init() --{ -+gcl_init_init() { - - build_symbol_table(); - -@@ -72,8 +19,7 @@ gcl_init_init() - } - - void --gcl_init_system(object no_init) --{ -+gcl_init_system(object no_init) { - - if (type_of(no_init)!=t_symbol) - error("Supplied no_init is not of type symbol\n"); -@@ -131,7 +77,25 @@ gcl_init_system(object no_init) - ar_check_init(gcl_cmpvar,no_init); - ar_check_init(gcl_cmpvs,no_init); - ar_check_init(gcl_cmpwt,no_init); -+ ar_check_init(gcl_cmpmain,no_init); - -+#ifdef HAVE_XGCL -+ lsp_init("../xgcl-2/sysdef.lisp"); -+ ar_check_init(gcl_Xlib,no_init); -+ ar_check_init(gcl_Xutil,no_init); -+ ar_check_init(gcl_X,no_init); -+ ar_check_init(gcl_XAtom,no_init); -+ ar_check_init(gcl_defentry_events,no_init); -+ ar_check_init(gcl_Xstruct,no_init); -+ ar_check_init(gcl_XStruct_l_3,no_init); -+ ar_check_init(gcl_general,no_init); -+ ar_check_init(gcl_keysymdef,no_init); -+ ar_check_init(gcl_X10,no_init); -+ ar_check_init(gcl_Xinit,no_init); -+ ar_check_init(gcl_dwtrans,no_init); -+ ar_check_init(gcl_tohtml,no_init); -+ ar_check_init(gcl_index,no_init); -+#endif - - } - ---- /dev/null -+++ gcl-2.6.7/unixport/msys.c -@@ -0,0 +1,85 @@ -+#include -+#include -+#include -+ -+#define massert(a_) if (!(a_)) msys_err(l,#a_,__LINE__,__FILE__,__FUNCTION__) -+ -+static int -+msys_err(FILE *l,const char *a,unsigned n,const char *f,const char *fn) { -+ -+ if (l) { -+ fprintf(l,"The assertion %s on line %d of %s in function %s failed", a,n,f,fn); -+ fflush(l); -+ fclose(l); -+ } -+ -+ exit(-1); -+ -+} -+ -+int -+main(int argc,char * argv[]) { -+ -+#ifdef _WIN32 -+ return 0; -+#else -+ -+ char b[4096]; -+ FILE *f,*l=NULL; -+ char *n=argv[2],*t=argv[3],*ln=argc>4 ? argv[4] : NULL,c,c1; -+ int r=0; -+ -+ if (fork()) return 0; -+ -+ if (chdir(argv[1])) exit(-1); -+ -+ if (ln) -+ l=fopen(ln,"w"); -+ -+ massert(f=fopen(n,"w")); -+ massert(fprintf(f,"%c\n",c=c1='0')==2); -+ massert(!fclose(f)); -+ -+ for (;;usleep(10000)) { -+ -+ massert(f=fopen(n,"r")); -+ c=fgetc(f); -+ massert(!fclose(f)); -+ -+ if (c==EOF) { -+ if (l) -+ fclose(l); -+ exit(0); -+ } -+ -+ if (c==c1) -+ continue; -+ -+ massert(f=fopen(n,"r")); -+ massert(fgets(b,sizeof(b),f)==b); -+ massert(!fclose(f)); -+ -+ r=system(b); -+ -+ if (l) { -+ fprintf(l,"%d %s\n",r,b); -+ fflush(l); -+ } -+ -+ massert(f=fopen(t,"w")); -+ massert(fprintf(f,"%d\n",r)>0); -+ massert(!fclose(f)); -+ -+ massert(f=fopen(t,"r")); -+ c1=fgetc(f); -+ massert(!fclose(f)); -+ -+ massert(!rename(t,n)); -+ -+ } -+ -+ return 0; -+ -+#endif -+ -+} ---- gcl-2.6.7.orig/unixport/sys_pre_gcl.c -+++ gcl-2.6.7/unixport/sys_pre_gcl.c -@@ -1,58 +1,6 @@ --#include --#include --#include "../h/include.h" -- --extern object user_init(); -- -- --void gcl_init_or_load1 (void (*)(void),char *); --#define init_or_load(fn,file) do {extern void fn(void); gcl_init_or_load1(fn,file);} \ -- while(0) -- --/* #define mjoin(a,b) a ## b */ --/* #define Mjoin(a,b) mjoin(a,b) */ -- --#define ar_init(a) do {\ -- char b[200];\ -- \ -- if (snprintf(b,sizeof(b),"ar x %-*.*slibpre_gcl.a %s.o",\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_self,#a)<=0)\ -- error("Cannot unpack module " #a "o\n");\ -- if (system(b)) \ -- error("Cannot run ar command to unpack module " #a ".o\n");\ -- init_or_load(Mjoin(init_,a),#a ".o");\ -- if (unlink(#a ".o"))\ -- error("Cannot unlink " #a ".o\n");\ --} while(0) -- --#define ar_check_init(a,b) do {\ -- object t;\ -- \ -- for (t=b->s.s_dbind;!endp(t) && type_of(t->c.c_car)==t_string && strcmp(#a,t->c.c_car->st.st_self);t=t->c.c_cdr);\ -- if (endp(t))\ -- ar_init(a);\ --} while(0) -- -- --static void --load1(x) -- char *x; --{printf("loading %s\n",x); -- fflush(stdout); -- load(x);} -- --#define lsp_init(a) do {\ -- char b[200];\ -- \ -- if (snprintf(b,sizeof(b),"%-*.*s%s",\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_self,a)<=0)\ -- error("Cannot append system directory\n");\ -- load1(b);\ --} while(0) -+#define FLAVOR "" -+ -+#include "sys.c" - - void - gcl_init_init() -@@ -78,6 +26,7 @@ gcl_init_system(object no_init) - if (type_of(no_init)!=t_symbol) - error("Supplied no_init is not of type symbol\n"); - -+ lsp_init("../lsp/gcl_listlib.lsp"); - lsp_init("../lsp/gcl_predlib.lsp"); - lsp_init("../lsp/gcl_setf.lsp"); - lsp_init("../lsp/gcl_arraylib.lsp"); -@@ -88,7 +37,7 @@ gcl_init_system(object no_init) - lsp_init("../lsp/gcl_japi.lsp"); - #endif - lsp_init("../lsp/gcl_iolib.lsp"); -- lsp_init("../lsp/gcl_listlib.lsp"); -+/* lsp_init("../lsp/gcl_listlib.lsp"); */ - lsp_init("../lsp/gcl_mislib.lsp"); - lsp_init("../lsp/gcl_numlib.lsp"); - lsp_init("../lsp/gcl_packlib.lsp"); ---- gcl-2.6.7.orig/unixport/sys_ansi_gcl.c -+++ gcl-2.6.7/unixport/sys_ansi_gcl.c -@@ -1,58 +1,7 @@ --#include --#include --#include "../h/include.h" -- --extern object user_init(); -- -- --void gcl_init_or_load1 (void (*)(void),char *); --#define init_or_load(fn,file) do {extern void fn(void); gcl_init_or_load1(fn,file);} \ -- while(0) -- --/* #define mjoin(a,b) a ## b */ --/* #define Mjoin(a,b) mjoin(a,b) */ -- --#define ar_init(a) do {\ -- char b[200];\ -- \ -- if (snprintf(b,sizeof(b),"ar x %-*.*slibansi_gcl.a %s.o",\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_self,#a)<=0)\ -- error("Cannot unpack module " #a "o\n");\ -- if (system(b)) \ -- error("Cannot run ar command to unpack module " #a ".o\n");\ -- init_or_load(Mjoin(init_,a),#a ".o");\ -- if (unlink(#a ".o"))\ -- error("Cannot unlink " #a ".o\n");\ --} while(0) -- --#define ar_check_init(a,b) do {\ -- object t;\ -- \ -- for (t=b->s.s_dbind;!endp(t) && type_of(t->c.c_car)==t_string && strcmp(#a,t->c.c_car->st.st_self);t=t->c.c_cdr);\ -- if (endp(t))\ -- ar_init(a);\ --} while(0) -- -- --static void --load1(x) -- char *x; --{printf("loading %s\n",x); -- fflush(stdout); -- load(x);} -- --#define lsp_init(a) do {\ -- char b[200];\ -- \ -- if (snprintf(b,sizeof(b),"%-*.*s%s",\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_self,a)<=0)\ -- error("Cannot append system directory\n");\ -- load1(b);\ --} while(0) -+#define FLAVOR "ansi_" -+ -+#include "sys.c" -+ - - void - gcl_init_init() -@@ -131,7 +80,26 @@ gcl_init_system(object no_init) - ar_check_init(gcl_cmpvar,no_init); - ar_check_init(gcl_cmpvs,no_init); - ar_check_init(gcl_cmpwt,no_init); -+ ar_check_init(gcl_cmpmain,no_init); - -+#ifdef HAVE_XGCL -+ lsp_init("../xgcl-2/sysdef.lisp"); -+ ar_check_init(gcl_Xlib,no_init); -+ ar_check_init(gcl_Xutil,no_init); -+ ar_check_init(gcl_X,no_init); -+ ar_check_init(gcl_XAtom,no_init); -+ ar_check_init(gcl_defentry_events,no_init); -+ ar_check_init(gcl_Xstruct,no_init); -+ ar_check_init(gcl_XStruct_l_3,no_init); -+ ar_check_init(gcl_general,no_init); -+ ar_check_init(gcl_keysymdef,no_init); -+ ar_check_init(gcl_X10,no_init); -+ ar_check_init(gcl_Xinit,no_init); -+ ar_check_init(gcl_dwtrans,no_init); -+ ar_check_init(gcl_tohtml,no_init); -+ ar_check_init(gcl_index,no_init); -+#endif -+ - ar_check_init(gcl_pcl_pkg,no_init); - ar_check_init(gcl_pcl_walk,no_init); - ar_check_init(gcl_pcl_iterate,no_init); ---- gcl-2.6.7.orig/unixport/init_gcl.lsp.in -+++ gcl-2.6.7/unixport/init_gcl.lsp.in -@@ -31,7 +31,7 @@ - (dolist (d (list lsp cmpnew)) - (load (make-pathname :name "sys-proclaim" :type "lisp" :directory d))) - (load (make-pathname :name "tk-package" :type "lsp" :directory gtk)) -- (load (make-pathname :name "gcl_cmpmain" :type "lsp" :directory cmpnew)) -+; (load (make-pathname :name "gcl_cmpmain" :type "lsp" :directory cmpnew)) - (load (make-pathname :name "gcl_lfun_list" :type "lsp" :directory cmpnew)) - (load (make-pathname :name "gcl_cmpopt" :type "lsp" :directory cmpnew)) - (load (make-pathname :name "gcl_auto_new" :type "lsp" :directory lsp)) -@@ -85,7 +85,8 @@ - (cond ((si::get-command-arg "-batch") - (setq si::*top-level-hook* 'bye)) - ((si::get-command-arg "-f")) -- (t (format t si::*system-banner*))) -+ (t (format t si::*system-banner*) -+ (format t "Temporary directory for compiler files set to ~a~%" *tmp-dir*))) - (setq si::*ihs-top* 1) - (in-package 'system::user) (incf system::*ihs-top* 2) - (funcall system::*old-top-level*)) ---- gcl-2.6.7.orig/unixport/sys_pcl_gcl.c -+++ gcl-2.6.7/unixport/sys_pcl_gcl.c -@@ -1,58 +1,7 @@ --#include --#include --#include "../h/include.h" -- --extern object user_init(); -- -- --void gcl_init_or_load1 (void (*)(void),char *); --#define init_or_load(fn,file) do {extern void fn(void); gcl_init_or_load1(fn,file);} \ -- while(0) -- --/* #define mjoin(a,b) a ## b */ --/* #define Mjoin(a,b) mjoin(a,b) */ -- --#define ar_init(a) do {\ -- char b[200];\ -- \ -- if (snprintf(b,sizeof(b),"ar x %-*.*slibpcl_gcl.a %s.o",\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_self,#a)<=0)\ -- error("Cannot unpack module " #a "o\n");\ -- if (system(b)) \ -- error("Cannot run ar command to unpack module " #a ".o\n");\ -- init_or_load(Mjoin(init_,a),#a ".o");\ -- if (unlink(#a ".o"))\ -- error("Cannot unlink " #a ".o\n");\ --} while(0) -- --#define ar_check_init(a,b) do {\ -- object t;\ -- \ -- for (t=b->s.s_dbind;!endp(t) && type_of(t->c.c_car)==t_string && strcmp(#a,t->c.c_car->st.st_self);t=t->c.c_cdr);\ -- if (endp(t))\ -- ar_init(a);\ --} while(0) -- -- --static void --load1(x) -- char *x; --{printf("loading %s\n",x); -- fflush(stdout); -- load(x);} -- --#define lsp_init(a) do {\ -- char b[200];\ -- \ -- if (snprintf(b,sizeof(b),"%-*.*s%s",\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_fillp,\ -- sSAsystem_directoryA->s.s_dbind->st.st_self,a)<=0)\ -- error("Cannot append system directory\n");\ -- load1(b);\ --} while(0) -+#define FLAVOR "pcl_" -+ -+#include "sys.c" -+ - - void - gcl_init_init() -@@ -131,7 +80,26 @@ gcl_init_system(object no_init) - ar_check_init(gcl_cmpvar,no_init); - ar_check_init(gcl_cmpvs,no_init); - ar_check_init(gcl_cmpwt,no_init); -+ ar_check_init(gcl_cmpmain,no_init); - -+#ifdef HAVE_XGCL -+ lsp_init("../xgcl-2/sysdef.lisp"); -+ ar_check_init(gcl_Xlib,no_init); -+ ar_check_init(gcl_Xutil,no_init); -+ ar_check_init(gcl_X,no_init); -+ ar_check_init(gcl_XAtom,no_init); -+ ar_check_init(gcl_defentry_events,no_init); -+ ar_check_init(gcl_Xstruct,no_init); -+ ar_check_init(gcl_XStruct_l_3,no_init); -+ ar_check_init(gcl_general,no_init); -+ ar_check_init(gcl_keysymdef,no_init); -+ ar_check_init(gcl_X10,no_init); -+ ar_check_init(gcl_Xinit,no_init); -+ ar_check_init(gcl_dwtrans,no_init); -+ ar_check_init(gcl_tohtml,no_init); -+ ar_check_init(gcl_index,no_init); -+#endif -+ - ar_check_init(gcl_pcl_pkg,no_init); - ar_check_init(gcl_pcl_walk,no_init); - ar_check_init(gcl_pcl_iterate,no_init); diff -Nru gcl-2.6.7/debian/patches/make-array gcl-2.6.7/debian/patches/make-array --- gcl-2.6.7/debian/patches/make-array 1970-01-01 00:00:00.000000000 +0000 +++ gcl-2.6.7/debian/patches/make-array 2012-01-20 05:14:49.000000000 +0000 @@ -0,0 +1,500 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.7-97) unstable; urgency=low + . + * evade __builtin___clear_cache on hppa + * make-array;make-sequence;replace;coerce +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: http://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.7.orig/configure ++++ gcl-2.6.7/configure +@@ -5825,6 +5825,7 @@ fi + + case $use in + sh4*) ;; #FIXME ++ hppa*) ;; #FIXME + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking __builtin___clear_cache" >&5 + $as_echo_n "checking __builtin___clear_cache... " >&6; } +--- gcl-2.6.7.orig/configure.in ++++ gcl-2.6.7/configure.in +@@ -1055,6 +1055,7 @@ fi + + case $use in + sh4*) ;; #FIXME ++ hppa*) ;; #FIXME + *) + AC_MSG_CHECKING(__builtin___clear_cache) + AC_TRY_COMPILE([], +--- gcl-2.6.7.orig/lsp/gcl_seq.lsp ++++ gcl-2.6.7/lsp/gcl_seq.lsp +@@ -32,48 +32,65 @@ + (proclaim '(optimize (safety 2) (space 3))) + + +-(defun make-sequence (type size &key (initial-element nil iesp) +- &aux element-type sequence) +- (setq element-type +- (cond ((eq type 'list) +- (return-from make-sequence +- (if iesp +- (make-list size :initial-element initial-element) +- (make-list size)))) +- ((or (eq type 'simple-string) (eq type 'string)) 'string-char) +- ((or (eq type 'simple-bit-vector) (eq type 'bit-vector)) 'bit) +- ((or (eq type 'simple-vector) (eq type 'vector)) t) +- (t +- (setq type (normalize-type type)) +- (when (subtypep (car type) 'list) +- (if (or (and (eq 'null (car type)) (not (equal size 0))) +- (and (eq 'cons (car type)) (equal size 0))) +- (specific-error :wrong-type-argument "~S is not of type ~S." +- type (format nil "list (size ~S)" size))) +- (return-from make-sequence +- (if iesp +- (make-list size :initial-element initial-element) +- (make-list size)))) +- (unless (or (eq (car type) 'array) +- (eq (car type) 'simple-array)) +- (specific-error :wrong-type-argument "~S is not of type ~S." +- type 'sequence)) +- (let ((ssize (caddr type))) +- (if (listp ssize) (setq ssize (car ssize))) +- (if (not (si::fixnump ssize)) (setq ssize size)) +- (unless (equal ssize size) +- (specific-error :wrong-type-argument "~S is not of type ~S." +- type (format nil "~S (size ~S)" type size)))) +- (or (cadr type) t)))) +- (setq element-type (si::best-array-element-type element-type)) +- (setq sequence (si:make-vector element-type size nil nil nil nil nil)) +- (when iesp +- (do ((i 0 (1+ i)) +- (size size)) +- ((>= i size)) +- (declare (fixnum i size)) +- (setf (elt sequence i) initial-element))) +- sequence) ++(defun make-sequence (type size &key initial-element ++ &aux ntype (atp (listp type)) (ctp (if atp (car type) type)) (tp (when atp (cdr type)))) ++ (declare (optimize (safety 1))) ++ (let ((res ++ (case ctp ++ ((list cons member) (make-list size :initial-element initial-element)) ++ ((vector array) (make-vector (upgraded-array-element-type (car tp)) size nil nil nil 0 nil initial-element)) ++ (otherwise 'none)))) ++ (cond ((not (eq res 'none)) (check-type-eval res type) res) ++ ((classp ctp) (make-sequence (class-name ctp) size :initial-element initial-element)) ++ ((let ((tem (get ctp 'deftype-definition))) ++ (when tem ++ (setq ntype (apply tem tp)) ++ (not (eq ctp (if (listp ntype) (car ntype) ntype))))) ++ (make-sequence ntype size :initial-element initial-element)) ++ ((check-type-eval type '(member list vector)))))) ++ ++;; (defun make-sequence (type size &key (initial-element nil iesp) ++;; &aux element-type sequence) ++;; (setq element-type ++;; (cond ((eq type 'list) ++;; (return-from make-sequence ++;; (if iesp ++;; (make-list size :initial-element initial-element) ++;; (make-list size)))) ++;; ((or (eq type 'simple-string) (eq type 'string)) 'string-char) ++;; ((or (eq type 'simple-bit-vector) (eq type 'bit-vector)) 'bit) ++;; ((or (eq type 'simple-vector) (eq type 'vector)) t) ++;; (t ++;; (setq type (normalize-type type)) ++;; (when (subtypep (car type) 'list) ++;; (if (or (and (eq 'null (car type)) (not (equal size 0))) ++;; (and (eq 'cons (car type)) (equal size 0))) ++;; (specific-error :wrong-type-argument "~S is not of type ~S." ++;; type (format nil "list (size ~S)" size))) ++;; (return-from make-sequence ++;; (if iesp ++;; (make-list size :initial-element initial-element) ++;; (make-list size)))) ++;; (unless (or (eq (car type) 'array) ++;; (eq (car type) 'simple-array)) ++;; (specific-error :wrong-type-argument "~S is not of type ~S." ++;; type 'sequence)) ++;; (let ((ssize (caddr type))) ++;; (if (listp ssize) (setq ssize (car ssize))) ++;; (if (not (si::fixnump ssize)) (setq ssize size)) ++;; (unless (equal ssize size) ++;; (specific-error :wrong-type-argument "~S is not of type ~S." ++;; type (format nil "~S (size ~S)" type size)))) ++;; (or (cadr type) t)))) ++;; (setq element-type (si::best-array-element-type element-type)) ++;; (setq sequence (si:make-vector element-type size nil nil nil nil nil)) ++;; (when iesp ++;; (do ((i 0 (1+ i)) ++;; (size size)) ++;; ((>= i size)) ++;; (declare (fixnum i size)) ++;; (setf (elt sequence i) initial-element))) ++;; sequence) + + + (defun concatenate (result-type &rest sequences) +--- gcl-2.6.7.orig/lsp/gcl_arraylib.lsp ++++ gcl-2.6.7/lsp/gcl_arraylib.lsp +@@ -73,48 +73,108 @@ + ; ) + + (defun make-array (dimensions +- &key (element-type t) +- (initial-element nil) +- (initial-contents nil initial-contents-supplied-p) ++ &key element-type ++ initial-element ++ (initial-contents nil icsp) + adjustable fill-pointer + displaced-to (displaced-index-offset 0) +- static) +- (when (integerp dimensions) (setq dimensions (list dimensions))) +- (setq element-type (best-array-element-type element-type)) +- (cond ((= (length dimensions) 1) +- (let ((x (si:make-vector element-type (car dimensions) +- adjustable fill-pointer +- displaced-to displaced-index-offset +- static initial-element))) +- (when initial-contents-supplied-p +- (do ((n (car dimensions)) +- (i 0 (1+ i))) +- ((>= i n)) +- (declare (fixnum n i)) +- (si:aset x i (elt initial-contents i)))) +- x)) +- (t +- (let ((x +- (make-array1 +- (the fixnum(get-aelttype element-type)) +- static initial-element +- displaced-to (the fixnum displaced-index-offset) +- dimensions))) +- (if fill-pointer (error "fill pointer for 1 dimensional arrays only")) +- (unless (member 0 dimensions) +- (when initial-contents-supplied-p +- (do ((cursor +- (make-list (length dimensions) +- :initial-element 0))) +- (nil) +- (declare (:dynamic-extent cursor)) +- (aset-by-cursor x +- (sequence-cursor initial-contents +- cursor) +- cursor) +- (when (increment-cursor cursor dimensions) +- (return nil))))) +- x)))) ++ static ++ &aux ++ (dimensions (if (and (listp dimensions) (not (cdr dimensions))) (car dimensions) dimensions)) ++ (element-type (upgraded-array-element-type element-type))) ++ (declare (optimize (safety 1))) ++ (check-type fill-pointer (or boolean integer)) ++ (check-type displaced-to (or null array)) ++ (check-type displaced-index-offset integer) ++ (etypecase ++ dimensions ++ (list ++ (let ((dimensions (dolist (d dimensions dimensions) (check-type d integer))) ++ (x (make-array1 (get-aelttype element-type) static initial-element displaced-to displaced-index-offset dimensions))) ++ (assert (not fill-pointer)) ++ (unless (member 0 dimensions) ++ (when icsp ++ (do ((j nil t)(cursor (make-list (length dimensions) :initial-element 0))) ++ ((when j (increment-cursor cursor dimensions))) ++ (declare (:dynamic-extent cursor)) ++ (aset-by-cursor x (sequence-cursor initial-contents cursor) cursor)))) ++ x)) ++ (integer ++ (let ((x (make-vector element-type dimensions adjustable (when fill-pointer dimensions) ++ displaced-to displaced-index-offset static initial-element))) ++ (when icsp (replace x initial-contents)) ++ (when (and fill-pointer (not (eq t fill-pointer))) (setf (fill-pointer x) fill-pointer)) ++ x)))) ++ ++;; (defun make-array (dimensions ++;; &key (element-type t) ++;; initial-element ++;; (initial-contents nil initial-contents-supplied-p) ++;; adjustable fill-pointer ++;; displaced-to (displaced-index-offset 0) ++;; static) ++;; (when (integerp dimensions) (setq dimensions (list dimensions))) ++;; (setq element-type (or (upgraded-array-element-type element-type) 'character)) ++;; (if (= (length dimensions) 1) ++;; (let ((x (si:make-vector element-type (car dimensions) adjustable (when fill-pointer (car dimensions)) ++;; displaced-to displaced-index-offset static initial-element))) ++;; (when initial-contents-supplied-p ++;; (replace x initial-contents)) ++;; (when (and fill-pointer (not (eq t fill-pointer))) (setf (fill-pointer x) fill-pointer)) ++;; x) ++;; (let ((x (make-array1 (get-aelttype element-type) static initial-element displaced-to displaced-index-offset dimensions))) ++;; (if fill-pointer (error "fill pointer for 1 dimensional arrays only")) ++;; (unless (member 0 dimensions) ++;; (when initial-contents-supplied-p ++;; (do ((j nil t)(cursor (make-list (length dimensions) :initial-element 0))) ++;; ((when j (increment-cursor cursor dimensions))) ++;; (declare (:dynamic-extent cursor)) ++;; (aset-by-cursor x (sequence-cursor initial-contents cursor) cursor)))) ++;; x))) ++ ++;; (defun make-array (dimensions ++;; &key (element-type t) ++;; (initial-element nil) ++;; (initial-contents nil initial-contents-supplied-p) ++;; adjustable fill-pointer ++;; displaced-to (displaced-index-offset 0) ++;; static) ++;; (when (integerp dimensions) (setq dimensions (list dimensions))) ++;; (setq element-type (best-array-element-type element-type)) ++;; (cond ((= (length dimensions) 1) ++;; (let ((x (si:make-vector element-type (car dimensions) ++;; adjustable fill-pointer ++;; displaced-to displaced-index-offset ++;; static initial-element))) ++;; (when initial-contents-supplied-p ++;; (do ((n (car dimensions)) ++;; (i 0 (1+ i))) ++;; ((>= i n)) ++;; (declare (fixnum n i)) ++;; (si:aset x i (elt initial-contents i)))) ++;; x)) ++;; (t ++;; (let ((x ++;; (make-array1 ++;; (the fixnum(get-aelttype element-type)) ++;; static initial-element ++;; displaced-to (the fixnum displaced-index-offset) ++;; dimensions))) ++;; (if fill-pointer (error "fill pointer for 1 dimensional arrays only")) ++;; (unless (member 0 dimensions) ++;; (when initial-contents-supplied-p ++;; (do ((cursor ++;; (make-list (length dimensions) ++;; :initial-element 0))) ++;; (nil) ++;; (declare (:dynamic-extent cursor)) ++;; (aset-by-cursor x ++;; (sequence-cursor initial-contents ++;; cursor) ++;; cursor) ++;; (when (increment-cursor cursor dimensions) ++;; (return nil))))) ++;; x)))) + + + (defun increment-cursor (cursor dimensions) +--- gcl-2.6.7.orig/lsp/gcl_predlib.lsp ++++ gcl-2.6.7/lsp/gcl_predlib.lsp +@@ -715,41 +715,73 @@ + (match-dimensions (cdr dim) (cdr pat))))) + + ++(defmacro check-type-eval (place type) ++ `(values (assert (typep ,place ,type) (,place) 'type-error :datum ,place :expected-type ,type))) + +-;;; COERCE function. +-(defun coerce (object type) ++(deftype simple-array (&optional (et '*) (dims '*)) `(array ,et ,(if (not dims) 0 dims))) ++(deftype null nil `(member nil)) ++(deftype single-float (&optional (low '*) (high '*)) `(long-float ,low ,high)) ++(deftype double-float (&optional (low '*) (high '*)) `(long-float ,low ,high)) ++ ++(defun coerce (object type &aux ntype (atp (listp type)) (ctp (if atp (car type) type)) (tp (when atp (cdr type)))) ++ (declare (optimize (safety 2))) ++ (check-type type (or symbol class structure cons)) + (when (typep object type) +- ;; Just return as it is. +- (return-from coerce object)) +- (when (classp type) +- (specific-error :wrong-type-argument "Cannot coerce ~S to class ~S~%" object type)) +- (setq type (normalize-type type)) +- (case (car type) +- (list +- (do ((l nil (cons (elt object i) l)) +- (i (1- (length object)) (1- i))) +- ((< i 0) l))) +- ((array simple-array) +- (unless (or (endp (cdr type)) +- (endp (cddr type)) +- (eq (caddr type) '*) +- (endp (cdr (caddr type)))) +- (error "Cannot coerce to an multi-dimensional array.")) +- (do ((seq (make-sequence type (length object))) +- (i 0 (1+ i)) +- (l (length object))) +- ((>= i l) seq) +- (setf (elt seq i) (elt object i)))) +- (character (character object)) +- (float (float object)) +- ((short-float) (float object 0.0S0)) +- ((single-float double-float long-float) (float object 0.0L0)) +- (complex +- (if (or (null (cdr type)) (null (cadr type)) (eq (cadr type) '*)) +- (complex (realpart object) (imagpart object)) +- (complex (coerce (realpart object) (cadr type)) +- (coerce (imagpart object) (cadr type))))) +- (t (error "Cannot coerce ~S to ~S." object type)))) ++ (return-from coerce object)) ++ (case ctp ++ (function (values (eval `(function ,object))));FIXME ++ ((list cons vector array member) (replace (make-sequence type (length object)) object)) ++ (character (character object)) ++ (short-float (float object 0.0S0)) ++ (long-float (float object 0.0L0)) ++ (float (float object)) ++ (complex ++ (let ((rtp (or (car tp) t))) ++ (complex (coerce (realpart object) rtp) (coerce (imagpart object) rtp)))) ++ (otherwise ++ (cond ((classp ctp) (coerce object (class-name ctp))) ++ ((let ((tem (get ctp 'deftype-definition))) ++ (when tem ++ (setq ntype (apply tem tp)) ++ (not (eq ctp (if (listp ntype) (car ntype) ntype))))) ++ (coerce object ntype)) ++ ((check-type-eval object type)))))) ++ ++ ++;; ;;; COERCE function. ++;; (defun coerce (object type) ++;; (when (typep object type) ++;; ;; Just return as it is. ++;; (return-from coerce object)) ++;; (when (classp type) ++;; (specific-error :wrong-type-argument "Cannot coerce ~S to class ~S~%" object type)) ++;; (setq type (normalize-type type)) ++;; (case (car type) ++;; (list ++;; (do ((l nil (cons (elt object i) l)) ++;; (i (1- (length object)) (1- i))) ++;; ((< i 0) l))) ++;; ((array simple-array) ++;; (unless (or (endp (cdr type)) ++;; (endp (cddr type)) ++;; (eq (caddr type) '*) ++;; (endp (cdr (caddr type)))) ++;; (error "Cannot coerce to an multi-dimensional array.")) ++;; (do ((seq (make-sequence type (length object))) ++;; (i 0 (1+ i)) ++;; (l (length object))) ++;; ((>= i l) seq) ++;; (setf (elt seq i) (elt object i)))) ++;; (character (character object)) ++;; (float (float object)) ++;; ((short-float) (float object 0.0S0)) ++;; ((single-float double-float long-float) (float object 0.0L0)) ++;; (complex ++;; (if (or (null (cdr type)) (null (cadr type)) (eq (cadr type) '*)) ++;; (complex (realpart object) (imagpart object)) ++;; (complex (coerce (realpart object) (cadr type)) ++;; (coerce (imagpart object) (cadr type))))) ++;; (t (error "Cannot coerce ~S to ~S." object type)))) + + ;; set by unixport/init_kcl.lsp + ;; warn if a file was comopiled in another version +--- gcl-2.6.7.orig/lsp/gcl_seqlib.lsp ++++ gcl-2.6.7/lsp/gcl_seqlib.lsp +@@ -148,34 +148,54 @@ + (declare (fixnum i)) + (setf (elt sequence i) item)))) + ++(deftype seqind nil `(integer 0 ,array-dimension-limit)) ++(defun replace (s1 s2 &key (start1 0) end1 (start2 0) end2 &aux (os1 s1) s3) ++ (declare (optimize (safety 1))(notinline make-list)(:dynamic-extent s3)) ++ (check-type s1 sequence) ++ (check-type s2 sequence) ++ (check-type start1 seqind) ++ (check-type start2 seqind) ++ (check-type end1 (or null seqind)) ++ (check-type end2 (or null seqind)) ++ (when (and (eq s1 s2) (> start1 start2)) ++ (setq s3 (make-list (length s2)) s2 (replace s3 s2))) ++ (let* ((lp1 (listp s1)) (lp2 (listp s2)) ++ (e1 (or end1 (if lp1 array-dimension-limit (length s1)))) ++ (e2 (or end2 (if lp2 array-dimension-limit (length s2))))) ++ (do ((i1 start1 (1+ i1))(i2 start2 (1+ i2)) ++ (s1 (if lp1 (nthcdr start1 s1) s1) (if lp1 (cdr s1) s1)) ++ (s2 (if lp2 (nthcdr start2 s2) s2) (if lp2 (cdr s2) s2))) ++ ((or (not s1) (>= i1 e1) (not s2) (>= i2 e2)) os1) ++ (let ((e2 (if lp2 (car s2) (aref s2 i2)))) ++ (if lp1 (setf (car s1) e2) (setf (aref s1 i1) e2)))))) + +-(defun replace (sequence1 sequence2 +- &key start1 end1 +- start2 end2 ) +- (with-start-end start1 end1 sequence1 +- (with-start-end start2 end2 sequence2 +- (if (and (eq sequence1 sequence2) +- (> start1 start2)) +- (do* ((i 0 (f+ 1 i)) +- (l (if (< (f- end1 start1) +- (f- end2 start2)) +- (f- end1 start1) +- (f- end2 start2))) +- (s1 (f+ start1 (f+ -1 l)) (f+ -1 s1)) +- (s2 (f+ start2 (f+ -1 l)) (f+ -1 s2))) +- ((>= i l) sequence1) +- (declare (fixnum i l s1 s2)) +- (setf (elt sequence1 s1) (elt sequence2 s2))) +- (do ((i 0 (f+ 1 i)) +- (l (if (< (f- end1 start1) +- (f- end2 start2)) +- (f- end1 start1) +- (f- end2 start2))) +- (s1 start1 (f+ 1 s1)) +- (s2 start2 (f+ 1 s2))) +- ((>= i l) sequence1) +- (declare (fixnum i l s1 s2)) +- (setf (elt sequence1 s1) (elt sequence2 s2))))))) ++;; (defun replace (sequence1 sequence2 ++;; &key start1 end1 ++;; start2 end2 ) ++;; (with-start-end start1 end1 sequence1 ++;; (with-start-end start2 end2 sequence2 ++;; (if (and (eq sequence1 sequence2) ++;; (> start1 start2)) ++;; (do* ((i 0 (f+ 1 i)) ++;; (l (if (< (f- end1 start1) ++;; (f- end2 start2)) ++;; (f- end1 start1) ++;; (f- end2 start2))) ++;; (s1 (f+ start1 (f+ -1 l)) (f+ -1 s1)) ++;; (s2 (f+ start2 (f+ -1 l)) (f+ -1 s2))) ++;; ((>= i l) sequence1) ++;; (declare (fixnum i l s1 s2)) ++;; (setf (elt sequence1 s1) (elt sequence2 s2))) ++;; (do ((i 0 (f+ 1 i)) ++;; (l (if (< (f- end1 start1) ++;; (f- end2 start2)) ++;; (f- end1 start1) ++;; (f- end2 start2))) ++;; (s1 start1 (f+ 1 s1)) ++;; (s2 start2 (f+ 1 s2))) ++;; ((>= i l) sequence1) ++;; (declare (fixnum i l s1 s2)) ++;; (setf (elt sequence1 s1) (elt sequence2 s2))))))) + + + ;;; DEFSEQ macro. diff -Nru gcl-2.6.7/debian/patches/revert-make-array gcl-2.6.7/debian/patches/revert-make-array --- gcl-2.6.7/debian/patches/revert-make-array 1970-01-01 00:00:00.000000000 +0000 +++ gcl-2.6.7/debian/patches/revert-make-array 2012-01-20 19:57:18.000000000 +0000 @@ -0,0 +1,497 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.7-98) unstable; urgency=low + . + * restore traditional make-sequence,make-array, and coerce, and + optimize replace, as 2.6.8 compiler is still too weak re: inlines +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: http://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.7.orig/lsp/sys-proclaim.lisp ++++ gcl-2.6.7/lsp/sys-proclaim.lisp +@@ -17,7 +17,7 @@ + (PROCLAIM '(FTYPE (FUNCTION (FIXNUM) FIXNUM) DBL-WHAT-FRAME)) + (PROCLAIM '(FTYPE (FUNCTION (STRING FIXNUM) FIXNUM) ATOI)) + (PROCLAIM +- '(FTYPE (FUNCTION (T T *) *) SUBTYPEP TYPEP LISP::PARSE-BODY ++ '(FTYPE (FUNCTION (T T *) *) SUBTYPEP LISP::PARSE-BODY + SLOOP::FIND-IN-ORDERED-LIST REDUCE SORT STABLE-SORT)) + (PROCLAIM + '(FTYPE (FUNCTION (T T T) *) LISP::VERIFY-KEYWORDS +@@ -45,7 +45,7 @@ + ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE DEFMACRO* + ANSI-LOOP::LOOP-TRANSLATE)) + (PROCLAIM +- '(FTYPE (FUNCTION (T T *) T) INTERNAL-COUNT-IF-NOT COUNT-IF SUBSETP ++ '(FTYPE (FUNCTION (T T *) T) TYPEP INTERNAL-COUNT-IF-NOT COUNT-IF SUBSETP + SLOOP::IN-ARRAY-SLOOP-FOR COUNT-IF-NOT UNION DELETE + DELETE-IF VECTOR-PUSH-EXTEND DELETE-IF-NOT EVERY FILL FIND + FIND-IF FIND-IF-NOT INTERSECTION SLOOP::PARSE-LOOP-MACRO +--- gcl-2.6.7.orig/lsp/gcl_seq.lsp ++++ gcl-2.6.7/lsp/gcl_seq.lsp +@@ -32,65 +32,48 @@ + (proclaim '(optimize (safety 2) (space 3))) + + +-(defun make-sequence (type size &key initial-element +- &aux ntype (atp (listp type)) (ctp (if atp (car type) type)) (tp (when atp (cdr type)))) +- (declare (optimize (safety 1))) +- (let ((res +- (case ctp +- ((list cons member) (make-list size :initial-element initial-element)) +- ((vector array) (make-vector (upgraded-array-element-type (car tp)) size nil nil nil 0 nil initial-element)) +- (otherwise 'none)))) +- (cond ((not (eq res 'none)) (check-type-eval res type) res) +- ((classp ctp) (make-sequence (class-name ctp) size :initial-element initial-element)) +- ((let ((tem (get ctp 'deftype-definition))) +- (when tem +- (setq ntype (apply tem tp)) +- (not (eq ctp (if (listp ntype) (car ntype) ntype))))) +- (make-sequence ntype size :initial-element initial-element)) +- ((check-type-eval type '(member list vector)))))) +- +-;; (defun make-sequence (type size &key (initial-element nil iesp) +-;; &aux element-type sequence) +-;; (setq element-type +-;; (cond ((eq type 'list) +-;; (return-from make-sequence +-;; (if iesp +-;; (make-list size :initial-element initial-element) +-;; (make-list size)))) +-;; ((or (eq type 'simple-string) (eq type 'string)) 'string-char) +-;; ((or (eq type 'simple-bit-vector) (eq type 'bit-vector)) 'bit) +-;; ((or (eq type 'simple-vector) (eq type 'vector)) t) +-;; (t +-;; (setq type (normalize-type type)) +-;; (when (subtypep (car type) 'list) +-;; (if (or (and (eq 'null (car type)) (not (equal size 0))) +-;; (and (eq 'cons (car type)) (equal size 0))) +-;; (specific-error :wrong-type-argument "~S is not of type ~S." +-;; type (format nil "list (size ~S)" size))) +-;; (return-from make-sequence +-;; (if iesp +-;; (make-list size :initial-element initial-element) +-;; (make-list size)))) +-;; (unless (or (eq (car type) 'array) +-;; (eq (car type) 'simple-array)) +-;; (specific-error :wrong-type-argument "~S is not of type ~S." +-;; type 'sequence)) +-;; (let ((ssize (caddr type))) +-;; (if (listp ssize) (setq ssize (car ssize))) +-;; (if (not (si::fixnump ssize)) (setq ssize size)) +-;; (unless (equal ssize size) +-;; (specific-error :wrong-type-argument "~S is not of type ~S." +-;; type (format nil "~S (size ~S)" type size)))) +-;; (or (cadr type) t)))) +-;; (setq element-type (si::best-array-element-type element-type)) +-;; (setq sequence (si:make-vector element-type size nil nil nil nil nil)) +-;; (when iesp +-;; (do ((i 0 (1+ i)) +-;; (size size)) +-;; ((>= i size)) +-;; (declare (fixnum i size)) +-;; (setf (elt sequence i) initial-element))) +-;; sequence) ++(defun make-sequence (type size &key (initial-element nil iesp) ++ &aux element-type sequence) ++ (setq element-type ++ (cond ((eq type 'list) ++ (return-from make-sequence ++ (if iesp ++ (make-list size :initial-element initial-element) ++ (make-list size)))) ++ ((or (eq type 'simple-string) (eq type 'string)) 'string-char) ++ ((or (eq type 'simple-bit-vector) (eq type 'bit-vector)) 'bit) ++ ((or (eq type 'simple-vector) (eq type 'vector)) t) ++ (t ++ (setq type (normalize-type type)) ++ (when (subtypep (car type) 'list) ++ (if (or (and (eq 'null (car type)) (not (equal size 0))) ++ (and (eq 'cons (car type)) (equal size 0))) ++ (specific-error :wrong-type-argument "~S is not of type ~S." ++ type (format nil "list (size ~S)" size))) ++ (return-from make-sequence ++ (if iesp ++ (make-list size :initial-element initial-element) ++ (make-list size)))) ++ (unless (or (eq (car type) 'array) ++ (eq (car type) 'simple-array)) ++ (specific-error :wrong-type-argument "~S is not of type ~S." ++ type 'sequence)) ++ (let ((ssize (caddr type))) ++ (if (listp ssize) (setq ssize (car ssize))) ++ (if (not (si::fixnump ssize)) (setq ssize size)) ++ (unless (equal ssize size) ++ (specific-error :wrong-type-argument "~S is not of type ~S." ++ type (format nil "~S (size ~S)" type size)))) ++ (or (cadr type) t)))) ++ (setq element-type (si::best-array-element-type element-type)) ++ (setq sequence (si:make-vector element-type size nil nil nil nil nil)) ++ (when iesp ++ (do ((i 0 (1+ i)) ++ (size size)) ++ ((>= i size)) ++ (declare (fixnum i size)) ++ (setf (elt sequence i) initial-element))) ++ sequence) + + + (defun concatenate (result-type &rest sequences) +--- gcl-2.6.7.orig/lsp/gcl_arraylib.lsp ++++ gcl-2.6.7/lsp/gcl_arraylib.lsp +@@ -73,109 +73,50 @@ + ; ) + + (defun make-array (dimensions +- &key element-type +- initial-element +- (initial-contents nil icsp) ++ &key (element-type t) ++ (initial-element nil) ++ (initial-contents nil initial-contents-supplied-p) + adjustable fill-pointer + displaced-to (displaced-index-offset 0) +- static +- &aux +- (dimensions (if (and (listp dimensions) (not (cdr dimensions))) (car dimensions) dimensions)) +- (element-type (upgraded-array-element-type element-type))) +- (declare (optimize (safety 1))) +- (check-type fill-pointer (or boolean integer)) +- (check-type displaced-to (or null array)) +- (check-type displaced-index-offset integer) +- (etypecase +- dimensions +- (list +- (let ((dimensions (dolist (d dimensions dimensions) (check-type d integer))) +- (x (make-array1 (get-aelttype element-type) static initial-element displaced-to displaced-index-offset dimensions))) +- (assert (not fill-pointer)) +- (unless (member 0 dimensions) +- (when icsp +- (do ((j nil t)(cursor (make-list (length dimensions) :initial-element 0))) +- ((when j (increment-cursor cursor dimensions))) +- (declare (:dynamic-extent cursor)) +- (aset-by-cursor x (sequence-cursor initial-contents cursor) cursor)))) +- x)) +- (integer +- (let ((x (make-vector element-type dimensions adjustable (when fill-pointer dimensions) +- displaced-to displaced-index-offset static initial-element))) +- (when icsp (replace x initial-contents)) +- (when (and fill-pointer (not (eq t fill-pointer))) (setf (fill-pointer x) fill-pointer)) +- x)))) +- +-;; (defun make-array (dimensions +-;; &key (element-type t) +-;; initial-element +-;; (initial-contents nil initial-contents-supplied-p) +-;; adjustable fill-pointer +-;; displaced-to (displaced-index-offset 0) +-;; static) +-;; (when (integerp dimensions) (setq dimensions (list dimensions))) +-;; (setq element-type (or (upgraded-array-element-type element-type) 'character)) +-;; (if (= (length dimensions) 1) +-;; (let ((x (si:make-vector element-type (car dimensions) adjustable (when fill-pointer (car dimensions)) +-;; displaced-to displaced-index-offset static initial-element))) +-;; (when initial-contents-supplied-p +-;; (replace x initial-contents)) +-;; (when (and fill-pointer (not (eq t fill-pointer))) (setf (fill-pointer x) fill-pointer)) +-;; x) +-;; (let ((x (make-array1 (get-aelttype element-type) static initial-element displaced-to displaced-index-offset dimensions))) +-;; (if fill-pointer (error "fill pointer for 1 dimensional arrays only")) +-;; (unless (member 0 dimensions) +-;; (when initial-contents-supplied-p +-;; (do ((j nil t)(cursor (make-list (length dimensions) :initial-element 0))) +-;; ((when j (increment-cursor cursor dimensions))) +-;; (declare (:dynamic-extent cursor)) +-;; (aset-by-cursor x (sequence-cursor initial-contents cursor) cursor)))) +-;; x))) +- +-;; (defun make-array (dimensions +-;; &key (element-type t) +-;; (initial-element nil) +-;; (initial-contents nil initial-contents-supplied-p) +-;; adjustable fill-pointer +-;; displaced-to (displaced-index-offset 0) +-;; static) +-;; (when (integerp dimensions) (setq dimensions (list dimensions))) +-;; (setq element-type (best-array-element-type element-type)) +-;; (cond ((= (length dimensions) 1) +-;; (let ((x (si:make-vector element-type (car dimensions) +-;; adjustable fill-pointer +-;; displaced-to displaced-index-offset +-;; static initial-element))) +-;; (when initial-contents-supplied-p +-;; (do ((n (car dimensions)) +-;; (i 0 (1+ i))) +-;; ((>= i n)) +-;; (declare (fixnum n i)) +-;; (si:aset x i (elt initial-contents i)))) +-;; x)) +-;; (t +-;; (let ((x +-;; (make-array1 +-;; (the fixnum(get-aelttype element-type)) +-;; static initial-element +-;; displaced-to (the fixnum displaced-index-offset) +-;; dimensions))) +-;; (if fill-pointer (error "fill pointer for 1 dimensional arrays only")) +-;; (unless (member 0 dimensions) +-;; (when initial-contents-supplied-p +-;; (do ((cursor +-;; (make-list (length dimensions) +-;; :initial-element 0))) +-;; (nil) +-;; (declare (:dynamic-extent cursor)) +-;; (aset-by-cursor x +-;; (sequence-cursor initial-contents +-;; cursor) +-;; cursor) +-;; (when (increment-cursor cursor dimensions) +-;; (return nil))))) +-;; x)))) +- ++ static) ++ (when (integerp dimensions) (setq dimensions (list dimensions))) ++ (setq element-type (best-array-element-type element-type)) ++ (cond ((= (length dimensions) 1) ++ (let ((x (si:make-vector element-type (car dimensions) ++ adjustable fill-pointer ++ displaced-to displaced-index-offset ++ static initial-element))) ++ (when initial-contents-supplied-p ++ (do ((n (car dimensions)) ++ (lic (listp initial-contents) lic) ++ (ic initial-contents (if lic (cdr ic) ic)) ++ (i 0 (1+ i))) ++ ((>= i n)) ++ (declare (fixnum n i)) ++ (si:aset x i (if lic (car ic) (aref ic i))))) ++ x)) ++ (t ++ (let ((x ++ (make-array1 ++ (the fixnum(get-aelttype element-type)) ++ static initial-element ++ displaced-to (the fixnum displaced-index-offset) ++ dimensions))) ++ (if fill-pointer (error "fill pointer for 1 dimensional arrays only")) ++ (unless (member 0 dimensions) ++ (when initial-contents-supplied-p ++ (do ((cursor ++ (make-list (length dimensions) ++ :initial-element 0))) ++ (nil) ++ (declare (:dynamic-extent cursor)) ++ (aset-by-cursor x ++ (sequence-cursor initial-contents ++ cursor) ++ cursor) ++ (when (increment-cursor cursor dimensions) ++ (return nil))))) ++ x)))) + + (defun increment-cursor (cursor dimensions) + (if (null cursor) +--- gcl-2.6.7.orig/lsp/gcl_predlib.lsp ++++ gcl-2.6.7/lsp/gcl_predlib.lsp +@@ -723,65 +723,43 @@ + (deftype single-float (&optional (low '*) (high '*)) `(long-float ,low ,high)) + (deftype double-float (&optional (low '*) (high '*)) `(long-float ,low ,high)) + +-(defun coerce (object type &aux ntype (atp (listp type)) (ctp (if atp (car type) type)) (tp (when atp (cdr type)))) +- (declare (optimize (safety 2))) +- (check-type type (or symbol class structure cons)) ++(defun coerce (object type &aux (ot type)) + (when (typep object type) +- (return-from coerce object)) +- (case ctp +- (function (values (eval `(function ,object))));FIXME +- ((list cons vector array member) (replace (make-sequence type (length object)) object)) +- (character (character object)) +- (short-float (float object 0.0S0)) +- (long-float (float object 0.0L0)) +- (float (float object)) +- (complex +- (let ((rtp (or (car tp) t))) +- (complex (coerce (realpart object) rtp) (coerce (imagpart object) rtp)))) +- (otherwise +- (cond ((classp ctp) (coerce object (class-name ctp))) +- ((let ((tem (get ctp 'deftype-definition))) +- (when tem +- (setq ntype (apply tem tp)) +- (not (eq ctp (if (listp ntype) (car ntype) ntype))))) +- (coerce object ntype)) +- ((check-type-eval object type)))))) +- +- +-;; ;;; COERCE function. +-;; (defun coerce (object type) +-;; (when (typep object type) +-;; ;; Just return as it is. +-;; (return-from coerce object)) +-;; (when (classp type) +-;; (specific-error :wrong-type-argument "Cannot coerce ~S to class ~S~%" object type)) +-;; (setq type (normalize-type type)) +-;; (case (car type) +-;; (list +-;; (do ((l nil (cons (elt object i) l)) +-;; (i (1- (length object)) (1- i))) +-;; ((< i 0) l))) +-;; ((array simple-array) +-;; (unless (or (endp (cdr type)) +-;; (endp (cddr type)) +-;; (eq (caddr type) '*) +-;; (endp (cdr (caddr type)))) +-;; (error "Cannot coerce to an multi-dimensional array.")) +-;; (do ((seq (make-sequence type (length object))) +-;; (i 0 (1+ i)) +-;; (l (length object))) +-;; ((>= i l) seq) +-;; (setf (elt seq i) (elt object i)))) +-;; (character (character object)) +-;; (float (float object)) +-;; ((short-float) (float object 0.0S0)) +-;; ((single-float double-float long-float) (float object 0.0L0)) +-;; (complex +-;; (if (or (null (cdr type)) (null (cadr type)) (eq (cadr type) '*)) +-;; (complex (realpart object) (imagpart object)) +-;; (complex (coerce (realpart object) (cadr type)) +-;; (coerce (imagpart object) (cadr type))))) +-;; (t (error "Cannot coerce ~S to ~S." object type)))) ++ ;; Just return as it is. ++ (return-from coerce object)) ++; (when (classp type) ++; (specific-error :wrong-type-argument "Cannot coerce ~S to class ~S~%" object type)) ++ (setq type (normalize-type type)) ++ (case (car type) ++ (list ++ (do ((l nil (cons (aref object i) l)) ++ (i (1- (length object)) (1- i))) ++ ((< i 0) l) ++ (declare (fixnum i)))) ++ ((array simple-array) ++ (unless (or (endp (cdr type)) ++ (endp (cddr type)) ++ (eq (caddr type) '*) ++ (endp (cdr (caddr type)))) ++ (error "Cannot coerce to an multi-dimensional array.")) ++ (do ((seq (make-sequence ot (length object))) ++ (i 0 (1+ i)) ++ (lo (listp object)) ++ (o object (if lo (cdr o) o)) ++ (l (length object))) ++ ((>= i l) seq) ++ (declare (fixnum i l)) ++ (setf (aref seq i) (if lo (car o) (aref o i))))) ++ (character (character object)) ++ (float (float object)) ++ ((short-float) (float object 0.0S0)) ++ ((single-float double-float long-float) (float object 0.0L0)) ++ (complex ++ (if (or (null (cdr type)) (null (cadr type)) (eq (cadr type) '*)) ++ (complex (realpart object) (imagpart object)) ++ (complex (coerce (realpart object) (cadr type)) ++ (coerce (imagpart object) (cadr type))))) ++ (t (error "Cannot coerce ~S to ~S." object type)))) + + ;; set by unixport/init_kcl.lsp + ;; warn if a file was comopiled in another version +--- gcl-2.6.7.orig/lsp/gcl_seqlib.lsp ++++ gcl-2.6.7/lsp/gcl_seqlib.lsp +@@ -148,24 +148,19 @@ + (declare (fixnum i)) + (setf (elt sequence i) item)))) + +-(deftype seqind nil `(integer 0 ,array-dimension-limit)) + (defun replace (s1 s2 &key (start1 0) end1 (start2 0) end2 &aux (os1 s1) s3) +- (declare (optimize (safety 1))(notinline make-list)(:dynamic-extent s3)) +- (check-type s1 sequence) +- (check-type s2 sequence) +- (check-type start1 seqind) +- (check-type start2 seqind) +- (check-type end1 (or null seqind)) +- (check-type end2 (or null seqind)) ++ (declare (optimize (safety 1))(:dynamic-extent s3)) + (when (and (eq s1 s2) (> start1 start2)) + (setq s3 (make-list (length s2)) s2 (replace s3 s2))) +- (let* ((lp1 (listp s1)) (lp2 (listp s2)) ++ (let* ((lp1 (listp s1)) (lp2 (listp s2))(start1 start1)(start2 start2) + (e1 (or end1 (if lp1 array-dimension-limit (length s1)))) + (e2 (or end2 (if lp2 array-dimension-limit (length s2))))) ++ (declare (fixnum start1 start2 e1 e2)) + (do ((i1 start1 (1+ i1))(i2 start2 (1+ i2)) +- (s1 (if lp1 (nthcdr start1 s1) s1) (if lp1 (cdr s1) s1)) +- (s2 (if lp2 (nthcdr start2 s2) s2) (if lp2 (cdr s2) s2))) ++ (s1 (if (when lp1 (> start1 0)) (nthcdr start1 s1) s1) (if lp1 (cdr s1) s1)) ++ (s2 (if (when lp2 (> start2 0)) (nthcdr start2 s2) s2) (if lp2 (cdr s2) s2))) + ((or (not s1) (>= i1 e1) (not s2) (>= i2 e2)) os1) ++ (declare (fixnum i1 i2)) + (let ((e2 (if lp2 (car s2) (aref s2 i2)))) + (if lp1 (setf (car s1) e2) (setf (aref s1 i1) e2)))))) + +--- gcl-2.6.7.orig/cmpnew/gcl_cmpopt.lsp ++++ gcl-2.6.7/cmpnew/gcl_cmpopt.lsp +@@ -110,6 +110,8 @@ + (get 'system:aset 'inline-always)) + (push '((t t t) t #.(flags set)"aset1(#0,fix(#1),#2)") + (get 'system:aset 'inline-unsafe)) ++(push '((t fixnum t) t #.(flags set)"aset1(#0,#1,#2)") ++ (get 'system:aset 'inline-unsafe)) + (push '(((array t) fixnum t) t #.(flags set)"(#0)->v.v_self[#1]= (#2)") + (get 'system:aset 'inline-unsafe)) + (push '(((array string-char) fixnum character) character #.(flags rfa set)"(#0)->ust.ust_self[#1]= (#2)") +@@ -167,6 +169,8 @@ + (get 'system:elt-set 'inline-always)) + (push '((t t t) t #.(flags set)"elt_set(#0,fix(#1),#2)") + (get 'system:elt-set 'inline-unsafe)) ++(push '((t fixnum t) t #.(flags set)"elt_set(#0,#1,#2)") ++ (get 'system:elt-set 'inline-unsafe)) + + ;;SYSTEM:FILL-POINTER-SET + (push '((t fixnum) fixnum #.(flags rfa set)"((#0)->st.st_fillp)=(#1)") +@@ -371,12 +375,14 @@ + (get 'append 'inline-always)) + + ;;AREF +-;; (push '((t t) t #.(flags ans)"aref1(#0,fixint(#1))") +-;; (get 'aref 'inline-always)) +-;; (push '((t fixnum) t #.(flags ans)"aref1(#0,#1)") +-;; (get 'aref 'inline-always)) +-;; (push '((t t) t #.(flags ans)"aref1(#0,fix(#1))") +-;; (get 'aref 'inline-unsafe)) ++(push '((t t) t #.(flags ans)"fLrow_major_aref(#0,fixint(#1))") ++ (get 'aref 'inline-always)) ++(push '((t fixnum) t #.(flags ans)"fLrow_major_aref(#0,#1)") ++ (get 'aref 'inline-always)) ++(push '((t t) t #.(flags ans)"fLrow_major_aref(#0,fix(#1))") ++ (get 'aref 'inline-unsafe)) ++(push '((t fixnum) t #.(flags ans)"fLrow_major_aref(#0,#1)") ++ (get 'aref 'inline-unsafe)) + (push '(((array t) fixnum) t #.(flags)"(#0)->v.v_self[#1]") + (get 'aref 'inline-unsafe)) + (push '(((array string-char) fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]") +@@ -698,6 +704,8 @@ type_of(#0)==t_bitvector") + (get 'elt 'inline-always)) + (push '((t t) t #.(flags ans)"elt(#0,fix(#1))") + (get 'elt 'inline-unsafe)) ++(push '((t fixnum) t #.(flags ans)"elt(#0,#1)") ++ (get 'elt 'inline-unsafe)) + + ;;ENDP + ;;Must use endp_prop here as generic lisp code containing (endp diff -Nru gcl-2.6.7/debian/patches/series gcl-2.6.7/debian/patches/series --- gcl-2.6.7/debian/patches/series 2011-05-11 20:08:17.000000000 +0000 +++ gcl-2.6.7/debian/patches/series 2012-01-20 19:57:18.000000000 +0000 @@ -1 +1,10 @@ -debian-changes-2.6.7-89 +2.6.8 +2.6.8a +2.6.8b +sparc +armsparc64 +armsparca +armbb +sh4xdr +make-array +revert-make-array diff -Nru gcl-2.6.7/debian/patches/sh4xdr gcl-2.6.7/debian/patches/sh4xdr --- gcl-2.6.7/debian/patches/sh4xdr 1970-01-01 00:00:00.000000000 +0000 +++ gcl-2.6.7/debian/patches/sh4xdr 2012-01-18 01:33:13.000000000 +0000 @@ -0,0 +1,413 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.7-96) unstable; urgency=low + . + * better XDR detection; no __builtin_clear_cache on sh4 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: http://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.7.orig/configure ++++ gcl-2.6.7/configure +@@ -2547,9 +2547,9 @@ fi + + # Check whether --enable-xdr was given. + if test "${enable_xdr+set}" = set; then : +- enableval=$enable_xdr; try_xdr=$enableval ++ enableval=$enable_xdr; enable_xdr=$enableval + else +- try_xdr="no" ++ enable_xdr="yes" + fi + + +@@ -5688,8 +5688,10 @@ if test "$enable_locbfd" = "yes" ; then + fi + + +-ac_fn_c_check_func "$LINENO" "xdr_double" "ac_cv_func_xdr_double" ++if test "$enable_xdr" = "yes" ; then ++ ac_fn_c_check_func "$LINENO" "xdr_double" "ac_cv_func_xdr_double" + if test "x$ac_cv_func_xdr_double" = xyes; then : ++ $as_echo "#define HAVE_XDR 1" >>confdefs.h + + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -ltirpc" >&5 +@@ -5729,24 +5731,111 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tirpc_xdr_double" >&5 + $as_echo "$ac_cv_lib_tirpc_xdr_double" >&6; } + if test "x$ac_cv_lib_tirpc_xdr_double" = xyes; then : +- TLIBS="$TLIBS -ltirpc" ++ $as_echo "#define HAVE_XDR 1" >>confdefs.h ++ TLIBS="$TLIBS -ltirpc" + else +- as_fn_error $? "Need xdr_double" "$LINENO" 5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lrpc" >&5 ++$as_echo_n "checking for xdr_double in -lrpc... " >&6; } ++if ${ac_cv_lib_rpc_xdr_double+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ ac_check_lib_save_LIBS=$LIBS ++LIBS="-lrpc $LIBS" ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++/* Override any GCC internal prototype to avoid an error. ++ Use char because int might match the return type of a GCC ++ builtin and then its argument prototype would still apply. */ ++#ifdef __cplusplus ++extern "C" ++#endif ++char xdr_double (); ++int ++main () ++{ ++return xdr_double (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_rpc_xdr_double=yes ++else ++ ac_cv_lib_rpc_xdr_double=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_rpc_xdr_double" >&5 ++$as_echo "$ac_cv_lib_rpc_xdr_double" >&6; } ++if test "x$ac_cv_lib_rpc_xdr_double" = xyes; then : ++ $as_echo "#define HAVE_XDR 1" >>confdefs.h ++ TLIBS="$TLIBS -lrpc" ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -loncrpc" >&5 ++$as_echo_n "checking for xdr_double in -loncrpc... " >&6; } ++if ${ac_cv_lib_oncrpc_xdr_double+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ ac_check_lib_save_LIBS=$LIBS ++LIBS="-loncrpc $LIBS" ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++/* Override any GCC internal prototype to avoid an error. ++ Use char because int might match the return type of a GCC ++ builtin and then its argument prototype would still apply. */ ++#ifdef __cplusplus ++extern "C" ++#endif ++char xdr_double (); ++int ++main () ++{ ++return xdr_double (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_oncrpc_xdr_double=yes ++else ++ ac_cv_lib_oncrpc_xdr_double=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_oncrpc_xdr_double" >&5 ++$as_echo "$ac_cv_lib_oncrpc_xdr_double" >&6; } ++if test "x$ac_cv_lib_oncrpc_xdr_double" = xyes; then : ++ $as_echo "#define HAVE_XDR 1" >>confdefs.h ++ TLIBS="$TLIBS -loncrpc" ++fi ++ + fi + + fi + ++fi ++ ++fi + +-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking __builtin___clear_cache" >&5 ++case $use in ++ sh4*) ;; #FIXME ++ *) ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking __builtin___clear_cache" >&5 + $as_echo_n "checking __builtin___clear_cache... " >&6; } +-cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + + int + main () + { + void *v,*ve; +- __builtin___clear_cache(v,ve); ++ __builtin___clear_cache(v,ve); + + ; + return 0; +@@ -5755,13 +5844,14 @@ _ACEOF + if ac_fn_c_try_compile "$LINENO"; then : + $as_echo "#define HAVE_BUILTIN_CLEAR_CACHE 1" >>confdefs.h + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } + fi +-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext;; ++esac + + #AC_CONFIG_SUBDIRS($MY_SUBDIRS) + +@@ -6520,41 +6610,6 @@ fi + done + + fi +-if test "$use" = "mingw" ; then +- if test "$try_xdr" = "yes" ; then +- for ac_header in rpc/rpc.h +-do : +- ac_fn_c_check_header_mongrel "$LINENO" "rpc/rpc.h" "ac_cv_header_rpc_rpc_h" "$ac_includes_default" +-if test "x$ac_cv_header_rpc_rpc_h" = xyes; then : +- cat >>confdefs.h <<_ACEOF +-#define HAVE_RPC_RPC_H 1 +-_ACEOF +- $as_echo "#define HAVE_XDR 1" >>confdefs.h +- +- LIBS="${LIBS} -loncrpc" +-fi +- +-done +- +- fi +-else +- if test "$try_xdr" = "yes" ; then +- for ac_header in rpc/rpc.h +-do : +- ac_fn_c_check_header_mongrel "$LINENO" "rpc/rpc.h" "ac_cv_header_rpc_rpc_h" "$ac_includes_default" +-if test "x$ac_cv_header_rpc_rpc_h" = xyes; then : +- cat >>confdefs.h <<_ACEOF +-#define HAVE_RPC_RPC_H 1 +-_ACEOF +- $as_echo "#define HAVE_XDR 1" >>confdefs.h +- +- LIBS="${LIBS} -lrpc" +-fi +- +-done +- +- fi +-fi + + # Should really find a way to check for prototypes, but this + # basically works for now. CM +--- gcl-2.6.7.orig/configure.in ++++ gcl-2.6.7/configure.in +@@ -66,7 +66,7 @@ AC_ARG_ENABLE(japi,[ --enable-japi=yes w + [try_japi=$enableval],[try_japi="no"]) + + AC_ARG_ENABLE(xdr,[ --enable-xdr=yes will compile in support for XDR], +-[try_xdr=$enableval],[try_xdr="no"]) ++[enable_xdr=$enableval],[enable_xdr="yes"]) + + AC_ARG_ENABLE(xgcl,[ --enable-xgcl=yes will compile in support for XGCL], + [enable_xgcl=$enableval],[enable_xgcl="yes"]) +@@ -1046,17 +1046,25 @@ if test "$enable_locbfd" = "yes" ; then + fi + + +-AC_CHECK_FUNC(xdr_double,, +- AC_CHECK_LIB(tirpc,xdr_double,TLIBS="$TLIBS -ltirpc",AC_MSG_ERROR([Need xdr_double]))) ++if test "$enable_xdr" = "yes" ; then ++ AC_CHECK_FUNC(xdr_double,AC_DEFINE(HAVE_XDR), ++ AC_CHECK_LIB(tirpc,xdr_double,AC_DEFINE(HAVE_XDR) TLIBS="$TLIBS -ltirpc", ++ AC_CHECK_LIB(rpc,xdr_double,AC_DEFINE(HAVE_XDR) TLIBS="$TLIBS -lrpc", ++ AC_CHECK_LIB(oncrpc,xdr_double,AC_DEFINE(HAVE_XDR) TLIBS="$TLIBS -loncrpc")))) ++fi + +-AC_MSG_CHECKING(__builtin___clear_cache) +-AC_TRY_COMPILE([], +-[void *v,*ve; +- __builtin___clear_cache(v,ve); +-], +-[AC_DEFINE(HAVE_BUILTIN_CLEAR_CACHE) +- AC_MSG_RESULT(yes)], +-AC_MSG_RESULT(no)) ++case $use in ++ sh4*) ;; #FIXME ++ *) ++ AC_MSG_CHECKING(__builtin___clear_cache) ++ AC_TRY_COMPILE([], ++ [void *v,*ve; ++ __builtin___clear_cache(v,ve); ++ ], ++ [AC_DEFINE(HAVE_BUILTIN_CLEAR_CACHE) ++ AC_MSG_RESULT(yes)], ++ AC_MSG_RESULT(no));; ++esac + + #AC_CONFIG_SUBDIRS($MY_SUBDIRS) + +@@ -1373,17 +1381,17 @@ if test "$try_japi" = "yes" ; then + EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" + LIBS="${LIBS} -ljapi -lwsock32"] ) + fi +-if test "$use" = "mingw" ; then +- if test "$try_xdr" = "yes" ; then +- AC_CHECK_HEADERS(rpc/rpc.h,[AC_DEFINE(HAVE_XDR) +- LIBS="${LIBS} -loncrpc"] ) +- fi +-else +- if test "$try_xdr" = "yes" ; then +- AC_CHECK_HEADERS(rpc/rpc.h,[AC_DEFINE(HAVE_XDR) +- LIBS="${LIBS} -lrpc"] ) +- fi +-fi ++dnl if test "$use" = "mingw" ; then ++dnl if test "$try_xdr" = "yes" ; then ++dnl AC_CHECK_HEADERS(rpc/rpc.h,[AC_DEFINE(HAVE_XDR) ++dnl LIBS="${LIBS} -loncrpc"] ) ++dnl fi ++dnl else ++dnl if test "$try_xdr" = "yes" ; then ++dnl AC_CHECK_HEADERS(rpc/rpc.h,[AC_DEFINE(HAVE_XDR) ++dnl LIBS="${LIBS} -lrpc"] ) ++dnl fi ++dnl fi + + # Should really find a way to check for prototypes, but this + # basically works for now. CM +--- gcl-2.6.7.orig/h/mac2.h ++++ gcl-2.6.7/h/mac2.h +@@ -162,7 +162,7 @@ do {char *x=sbrk(0); \ + and get a stream connection with it */ + #define RUN_PROCESS + +-#define HAVE_XDR ++/* #define HAVE_XDR */ + + /* if there is no input there return false */ + #define LISTEN_FOR_INPUT(fp) \ +--- gcl-2.6.7.orig/h/linux.h ++++ gcl-2.6.7/h/linux.h +@@ -97,7 +97,7 @@ do {static struct sigaction action; \ + + #define IEEEFLOAT + +-#define HAVE_XDR ++/* #define HAVE_XDR */ + + #define USE_ULONG_ + +--- gcl-2.6.7.orig/h/rios-aix3.h ++++ gcl-2.6.7/h/rios-aix3.h +@@ -219,7 +219,7 @@ for the kernel. See aix3_mprotect dire + #define HAVE_IOCTL + #define HAVE_SIGACTION + +-#define HAVE_XDR ++/* #define HAVE_XDR */ + + #define SHARP_EQ_CONTEXT_SIZE 1024 + #undef VSSIZE +--- gcl-2.6.7.orig/h/rios.h ++++ gcl-2.6.7/h/rios.h +@@ -228,7 +228,7 @@ for the kernel. See aix3_mprotect dire + #define HAVE_IOCTL + #define HAVE_SIGACTION + +-#define HAVE_XDR ++/* #define HAVE_XDR */ + + #define SHARP_EQ_CONTEXT_SIZE 1024 + #undef VSSIZE +--- gcl-2.6.7.orig/h/dos-go32.h ++++ gcl-2.6.7/h/dos-go32.h +@@ -63,7 +63,7 @@ struct rlimit { int i; } ; + /* some regular bsd bells and whistles which aren't here */ + + #undef HAVE_SIGVEC +-#undef HAVE_XDR ++/* #undef HAVE_XDR */ + #undef RUN_PROCESS + + +--- gcl-2.6.7.orig/h/bsd.h ++++ gcl-2.6.7/h/bsd.h +@@ -86,7 +86,7 @@ do {char *x=sbrk(0); \ + and get a stream connection with it */ + #define RUN_PROCESS + +-#define HAVE_XDR ++/* #define HAVE_XDR */ + + #define WANT_VALLOC + +--- gcl-2.6.7.orig/h/386-bsd.h ++++ gcl-2.6.7/h/386-bsd.h +@@ -26,7 +26,7 @@ + #define I386 /* ?? this is apparently not used anywhere */ + #define IEEEFLOAT + +-#undef HAVE_XDR ++/* #undef HAVE_XDR */ + + #define USE_ATT_TIME + +--- gcl-2.6.7.orig/h/OpenBSD.h ++++ gcl-2.6.7/h/OpenBSD.h +@@ -22,7 +22,7 @@ + /* we don't need to worry about zeroing fp->_base, to prevent what??? */ + #define FCLOSE_SETBUF_OK + +-#undef HAVE_XDR ++/* #undef HAVE_XDR */ + + #define USE_ATT_TIME + +--- gcl-2.6.7.orig/h/u370_aix.h ++++ gcl-2.6.7/h/u370_aix.h +@@ -176,7 +176,7 @@ when they fix it + #define SAFE_INC(u,amt) do{volatile unsigned int xTmp = u; xTmp += amt; u = (int) xTmp;}while(0) + #define SAFE_DEC(u,amt) do{volatile unsigned int xTmp = u; xTmp -= amt; u = (int) xTmp;}while(0) + +-#define HAVE_XDR ++/* #define HAVE_XDR */ + + + /* Begin for cmpinclude */ +--- gcl-2.6.7.orig/h/NetBSD.h ++++ gcl-2.6.7/h/NetBSD.h +@@ -47,7 +47,7 @@ + #define deallocate_stream_buffer(x) + + +-#undef HAVE_XDR ++/* #undef HAVE_XDR */ + + #define USE_ATT_TIME + diff -Nru gcl-2.6.7/debian/patches/sparc gcl-2.6.7/debian/patches/sparc --- gcl-2.6.7/debian/patches/sparc 1970-01-01 00:00:00.000000000 +0000 +++ gcl-2.6.7/debian/patches/sparc 2012-01-11 21:42:44.000000000 +0000 @@ -0,0 +1,117 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.7-93) unstable; urgency=low + . + * remove C_GC_OFFSET for sparc64 + * remove ncurses dependency for readline + * Bug fix: "FTBFS: dpkg-buildpackage: error: dpkg-source -b gcl-2.6.7 + gave error exit status 2", thanks to Didier Raboud (Closes: #643131). + * Bug fix: "drops readline support if rebuilt", thanks to Sven Joachim + (Closes: #646735). + * lower opts on sparc64 asof gcc 4.6.1 +Author: Camm Maguire +Bug-Debian: http://bugs.debian.org/643131 +Bug-Debian: http://bugs.debian.org/646735 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: http://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.7.orig/configure ++++ gcl-2.6.7/configure +@@ -4197,6 +4197,9 @@ case $use in + ia64*) + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.6.2 + ;; ++ sparc64*) ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.1 frame.c/longjmp, possible make/fork ++ ;; + arm*) + TCFLAGS="$TCFLAGS -mlong-calls -fdollars-in-identifiers -g " + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.6.2 +@@ -6870,7 +6873,7 @@ if ${ac_cv_lib_readline_rl_initialize+:} + $as_echo_n "(cached) " >&6 + else + ac_check_lib_save_LIBS=$LIBS +-LIBS="-lreadline -lncurses $LIBS" ++LIBS="-lreadline $LIBS" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +@@ -6903,7 +6906,7 @@ $as_echo "$ac_cv_lib_readline_rl_initial + if test "x$ac_cv_lib_readline_rl_initialize" = xyes; then : + $as_echo "#define HAVE_READLINE 1" >>confdefs.h + +- TLIBS="$TLIBS -lreadline -lncurses" #some machines don't link this, e.g. Slackware ++ TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware + RL_OBJS=gcl_readline.o + # Readline support now initialized automatically when compiled in, this lisp + # object no longer needed -- 20040102 CM +@@ -6923,7 +6926,7 @@ if ${ac_cv_lib_readline_rl_completion_ma + $as_echo_n "(cached) " >&6 + else + ac_check_lib_save_LIBS=$LIBS +-LIBS="-lreadline -lncurses $LIBS" ++LIBS="-lreadline $LIBS" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +--- gcl-2.6.7.orig/configure.in ++++ gcl-2.6.7/configure.in +@@ -558,6 +558,9 @@ case $use in + ia64*) + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.6.2 + ;; ++ sparc64*) ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.1 frame.c/longjmp, possible make/fork ++ ;; + arm*) + TCFLAGS="$TCFLAGS -mlong-calls -fdollars-in-identifiers -g " + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.6.2 +@@ -1471,17 +1474,17 @@ if test "$enable_readline" = "yes" ; the + AC_CHECK_HEADERS(readline/readline.h, + AC_CHECK_LIB(readline,rl_initialize, + AC_DEFINE(HAVE_READLINE) +- TLIBS="$TLIBS -lreadline -lncurses" #some machines don't link this, e.g. Slackware ++ TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware + RL_OBJS=gcl_readline.o + # Readline support now initialized automatically when compiled in, this lisp + # object no longer needed -- 20040102 CM + # RL_LIB=lsp/gcl_readline.o +- ,,-lncurses)) ++ )) + + # These tests discover differences between readline 4.1 and 4.3 + AC_CHECK_LIB(readline,rl_completion_matches, + AC_DEFINE(HAVE_DECL_RL_COMPLETION_MATCHES) +- AC_DEFINE(HAVE_RL_COMPENTRY_FUNC_T),,-lncurses) ++ AC_DEFINE(HAVE_RL_COMPENTRY_FUNC_T)) + fi + + AC_SUBST(RL_OBJS) +--- gcl-2.6.7.orig/h/sparc-linux.h ++++ gcl-2.6.7/h/sparc-linux.h +@@ -25,6 +25,6 @@ + #define SPECIAL_RELOC_H "elf64_sparc_reloc_special.h" + #endif + +-#if SIZEOF_LONG == 8 +-#define C_GC_OFFSET 4 +-#endif ++/* #if SIZEOF_LONG == 8 */ ++/* #define C_GC_OFFSET 4 */ ++/* #endif */