; 15 Mar 1995 15:50:07
; dwtrans.lsp  -- translation of dwindow.lsp

; Copyright (c) 1995 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 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.

; 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) )

(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 '8X10 "8x10") (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* (INT-ARRAY 1))

(DEFVAR *CHILD-RETURN* (INT-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-STRING* (MAKE-STRING 100))

(DEFVAR *WINDOW-STRING-COUNT*)

(DEFVAR *WINDOW-STRING-MAX*)

(DEFVAR *WINDOW-INPUT-STRING-X*)

(DEFVAR *WINDOW-INPUT-STRING-Y*)

(DEFVAR *WINDOW-INPUT-STRING-CHARWIDTH*)

(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 "")))
  (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* (INT-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 (DISPLAY *WINDOW-DISPLAY*))
    (SETQ FONTSTRING
          (OR (CADR (ASSOC FONTSYMBOL *WINDOW-FONTS*))
              (STRINGIFY FONTSYMBOL)))
    (SETQ FONT-INFO (XLOADQUERYFONT DISPLAY (GET-C-STRING FONTSTRING)))
    (IF (ZEROP FONT-INFO)
        (FORMAT T "~%can't open font ~a ~a~%" FONTSYMBOL FONTSTRING)
        (PROGN
          (XSETFONT 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) (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) (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)) MINY 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))
    (SETQ MINY (- OFFSETY LW2B))
    (XDRAWLINE *WINDOW-DISPLAY* PW GC OFFSETX (- QQWHEIGHT MINY)
        OFFSETX (- QQWHEIGHT (+ (+ MINY SIZEY) LW)))
    (XDRAWLINE *WINDOW-DISPLAY* PW GC (+ OFFSETX SIZEX)
        (- QQWHEIGHT MINY) (+ OFFSETX SIZEX)
        (- QQWHEIGHT (+ (+ MINY SIZEY) LW)))
    (XDRAWLINE *WINDOW-DISPLAY* PW GC (+ OFFSETX LW2B)
        (- QQWHEIGHT OFFSETY) (- (+ OFFSETX SIZEX) LW2)
        (- QQWHEIGHT OFFSETY))
    (XDRAWLINE *WINDOW-DISPLAY* PW GC (+ OFFSETX LW2B)
        (- QQWHEIGHT (+ OFFSETY SIZEY)) (- (+ OFFSETX SIZEX) LW2)
        (- QQWHEIGHT (+ OFFSETY SIZEY)))
    (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)
    (SETQ R
          (MAX 0
               (MIN RADIUS (TRUNCATE (ABS WIDTH) 2)
                    (TRUNCATE (ABS HEIGHT) 2))))
    (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 (NOT (EQL LINEWIDTH 1)))
          (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W)
              (OR LINEWIDTH 1) 0 1 0))
      (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) X1 (- QQWHEIGHT Y)
          X2 (- QQWHEIGHT Y))
      (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1)))
          (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)))
    (LET ((QQWHEIGHT (CADDDR W)))
      (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1)))
          (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W)
              (OR LINEWIDTH 1) 0 1 0))
      (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) (+ X WIDTH)
          (- QQWHEIGHT Y1) (+ X WIDTH) (- QQWHEIGHT Y2))
      (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1)))
          (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)))
    (LET ((QQWHEIGHT (CADDDR W)))
      (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1)))
          (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W)
              (OR LINEWIDTH 1) 0 1 0))
      (XDRAWLINE *WINDOW-DISPLAY* (CADR W) (CADDR W) X1
          (- QQWHEIGHT (+ Y HEIGHT)) X2 (- QQWHEIGHT (+ Y HEIGHT)))
      (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1)))
          (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)))
    (LET ((QQWHEIGHT (CADDDR W)))
      (IF (AND LINEWIDTH (NOT (EQL 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 Y2))
      (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1)))
          (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0)))
    (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) (- X1 R)
        (- (CADDDR W) (+ Y1 R)) (* 2 R) (* 2 R) 11520 5760)
    (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1)))
        (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))
    (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) (- X2 R)
        (- (CADDDR W) (+ Y1 R)) (* 2 R) (* 2 R) 17280 5760)
    (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1)))
        (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))
    (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) (- X2 R)
        (- (CADDDR W) (+ Y2 R)) (* 2 R) (* 2 R) 0 5760)
    (IF (AND LINEWIDTH (NOT (EQL LINEWIDTH 1)))
        (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR W) 1 0 1 0))
    (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) (- X1 R)
        (- (CADDDR W) (+ Y2 R)) (* 2 R) (* 2 R) 5760 5760)
    (IF (AND LINEWIDTH (NOT (EQL 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-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-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 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 (INT-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)
  (UNLESS (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 MAXHEIGHT 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 MAXHEIGHT 13)
    (SETQ NITEMS
          (IF (AND (NINTH M) (PLUSP (LENGTH (NINTH M)))
                   (OR (CADDR M) *WINDOW-ADD-MENU-TITLE*))
              1 0))
    (DOLIST (ITEM (NTH 13 M))
      (INCF NITEMS)
      (SETQ MAXWIDTH (MAX MAXWIDTH (MENU-FIND-ITEM-WIDTH M ITEM)))
      (SETQ MAXHEIGHT (MAX MAXHEIGHT (MENU-FIND-ITEM-HEIGHT M ITEM))))
    (SETF (NTH 11 M) (+ 6 MAXWIDTH))
    (SETF (SEVENTH M) (1+ (NTH 11 M)))
    (SETF (NTH 12 M) (+ 2 MAXHEIGHT))
    (SETF (EIGHTH M) (+ 2 (* (NTH 12 M) NITEMS)))
    (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))
    (UNLESS (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 (NTH 12 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*))
      (DECF BOTTOM (NTH 12 M))
      (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 ((GLVAR1420 (NTH 12 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*)))))
        (XFILLRECTANGLE *WINDOW-DISPLAY* (CADR MW) (CADDR MW) XZERO
            (- (CADDDR MW) (1- (+ (+ -2 BOTTOM) GLVAR1420)))
            (1+ (SEVENTH M)) GLVAR1420)
        (LET ((GC (CADDR MW)))
          (XSETFUNCTION *WINDOW-DISPLAY* GC *WINDOW-SAVE-FUNCTION*)
          (XSETFOREGROUND *WINDOW-DISPLAY* GC *WINDOW-SAVE-FOREGROUND*))))
    (DOLIST (ITEM (NTH 13 M))
      (DECF BOTTOM (NTH 12 M))
      (MENU-DISPLAY-ITEM M ITEM (+ 3 XZERO) BOTTOM))
    (XFLUSH *WINDOW-DISPLAY*)))

(DEFUN MENU-ITEM-VALUE (SELF ITEM) (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)
  (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 ((GLVAR1421 (CADR M)) (GLVAR1425 (+ 3 (EIGHTH M))))
        (XCLEARAREA *WINDOW-DISPLAY* (CADR GLVAR1421)
            (1- (IF (CADDR M) (FIFTH M) 0))
            (- (CADDDR GLVAR1421)
               (1- (+ (1- (IF (CADDR M) (SIXTH M) 0)) GLVAR1425)))
            (+ 3 (SEVENTH M)) GLVAR1425 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)
        (COND
          ((AND (SYMBOLP (CAR ITEM)) (FBOUNDP (CAR ITEM)))
           (FUNCALL (CAR ITEM) MW X Y))
          ((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))))
          (T (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-N NEWN ITEMH ITMS NITEMS VAL MAXX XZERO YZERO)
    (OR (AND (CADR M) (PLUSP (NTH 12 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 ITEMH (NTH 12 M))
    (SETQ ITMS (NTH 13 M))
    (SETQ NITEMS (LENGTH ITMS))
    (WINDOW-TRACK-MOUSE MW
        #'(LAMBDA (X Y CODE)
            (SETQ *WINDOW-MENU-CODE* CODE)
            (SETQ NEWN
                  (1- (- NITEMS (TRUNCATE (+ -3 (- Y YZERO)) ITEMH))))
            (IF (AND (>= X XZERO) (<= X MAXX) (>= NEWN 0)
                     (< NEWN NITEMS))
                (PROGN
                  (IF CURRENT-ITEM-N
                      (WHEN (/= NEWN CURRENT-ITEM-N)
                        (MENU-BOX-ITEM M CURRENT-ITEM-N)
                        (MENU-BOX-ITEM M NEWN)
                        (SETQ CURRENT-ITEM-N NEWN))
                      (PROGN
                        (SETQ INSIDE T)
                        (MENU-BOX-ITEM M NEWN)
                        (SETQ CURRENT-ITEM-N NEWN)))
                  (WHEN (AND CURRENT-ITEM-N (PLUSP CODE))
                    (MENU-BOX-ITEM M CURRENT-ITEM-N)
                    (SETQ VAL CURRENT-ITEM-N)))
                (PROGN
                  (WHEN CURRENT-ITEM-N
                    (MENU-BOX-ITEM M CURRENT-ITEM-N)
                    (SETQ CURRENT-ITEM-N NIL))
                  (IF (OR (PLUSP CODE)
                          (AND INSIDE
                               (OR (< X XZERO) (> X MAXX) (< Y YZERO)
                                   (> Y (+ YZERO (EIGHTH M))))))
                      (SETQ VAL -777)))))
        T)
    (IF (/= VAL -777)
        (LET ((GLVAR1433 (NTH VAL ITMS)))
          (IF (CONSP GLVAR1433) (CDR GLVAR1433) GLVAR1433)))))

(DEFUN MENU-BOX-ITEM (M ITEM)
  (LET (ITEMH NITEMS (MW (OR (CADR M) (MENU-INIT M))))
    (SETQ ITEMH (NTH 12 M))
    (SETQ NITEMS (LENGTH (NTH 13 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))
        (+ (IF (CADDR M) (SIXTH M) 0)
           (+ 2 (* (1- (- NITEMS ITEM)) ITEMH)))
        (+ -2 (NTH 11 M)) ITEMH 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) (MENU-BOX-ITEM M ITEM))

(DEFUN MENU-ITEM-POSITION (M ITEMNAME &OPTIONAL PLACE)
  (LET ((N 0) FOUND ITMS ITEM (XSIZE (NTH 11 M)) (YSIZE (NTH 12 M)))
    (SETQ ITMS (NTH 13 M))
    (SETQ FOUND (NULL ITEMNAME))
    (TAGBODY
      GLLABEL1437
      (WHEN (AND ITMS (NOT FOUND))
        (INCF N)
        (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))
        (GO GLLABEL1437)))
    (IF FOUND
        (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)
                    (* (- (LENGTH (NTH 13 M)) N) YSIZE))
                 (CASE PLACE
                   ((CENTER RIGHT LEFT) (TRUNCATE YSIZE 2))
                   (BOTTOM 0)
                   (TOP YSIZE)
                   (T 0)))))))

(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))
    (UNLESS (TENTH M)
      (IF (CADDR M) (PROGN (MENU-CLEAR M) (XFLUSH *WINDOW-DISPLAY*))
          (LET ((GLVAR1440 (CADR M)))
            (XUNMAPWINDOW *WINDOW-DISPLAY* (CADR GLVAR1440))
            (XFLUSH *WINDOW-DISPLAY*)
            (WINDOW-WAIT-UNMAP GLVAR1440))))
    (RETURN RES)))

(DEFUN MENU-DESTROY (M)
  (UNLESS (CADDR M)
    (LET ((GLVAR1441 (CADR M)))
      (XDESTROYWINDOW *WINDOW-DISPLAY* (CADR GLVAR1441))
      (XFLUSH *WINDOW-DISPLAY*)
      (SETF (CADR GLVAR1441) NIL)
      (XFREEGC *WINDOW-DISPLAY* (CADDR GLVAR1441))
      (SETF (CADDR GLVAR1441) 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 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)
      (IF (EQ (FIRST M) 'PICMENU) (PICMENU-CALCULATE-SIZE M)
          (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 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))

(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)
  (UNLESS (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-BUTTON (M B)
  (LET ((MW (CADR 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
        (+ -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*))))

(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)))
    (UNLESS (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
                (UNLESS (PICMENU-BUTTON-CONTAINSXY? CURRENT-BUTTON X Y)
                  (PICMENU-UNBOX-ITEM M CURRENT-BUTTON)
                  (SETQ CURRENT-BUTTON NIL)))
            (UNLESS CURRENT-BUTTON
              (SETQ ITEMS (CADDDR (NTH 10 M)))
              (TAGBODY
                GLLABEL1454
                (WHEN (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))
                  (GO GLLABEL1454))))
            (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)
    (UNLESS (TENTH M)
      (IF (CADDR M) (PROGN (MENU-CLEAR M) (XFLUSH *WINDOW-DISPLAY*))
          (LET ((GLVAR1456 (CADR M)))
            (XUNMAPWINDOW *WINDOW-DISPLAY* (CADR GLVAR1456))
            (XFLUSH *WINDOW-DISPLAY*)
            (WINDOW-WAIT-UNMAP GLVAR1456))))
    (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 ITEMNAME
        (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)))
        (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)))))
    (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)
  (UNLESS (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 ((GLVAR1493 (CADR M)) (GLVAR1495 (NTH 13 M)))
          (LET ((QQWHEIGHT (CADDDR GLVAR1493)))
            (IF (AND GLVAR1495 (/= GLVAR1495 1))
                (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR GLVAR1493)
                    (OR GLVAR1495 1) 0 1 0))
            (XDRAWLINE *WINDOW-DISPLAY* (CADR GLVAR1493)
                (CADDR GLVAR1493) XZERO (- QQWHEIGHT YZERO)
                (+ XZERO (NTH 11 M)) (- QQWHEIGHT YZERO))
            (IF (AND GLVAR1495 (/= GLVAR1495 1))
                (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR GLVAR1493)
                    1 0 1 0))))
        (LET ((GLVAR1496 (CADR M)) (GLVAR1498 (NTH 13 M)))
          (LET ((QQWHEIGHT (CADDDR GLVAR1496)))
            (IF (AND GLVAR1498 (/= GLVAR1498 1))
                (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR GLVAR1496)
                    (OR GLVAR1498 1) 0 1 0))
            (XDRAWLINE *WINDOW-DISPLAY* (CADR GLVAR1496)
                (CADDR GLVAR1496) XZERO (- QQWHEIGHT YZERO) XZERO
                (- QQWHEIGHT (+ YZERO (NTH 11 M))))
            (IF (AND GLVAR1498 (/= GLVAR1498 1))
                (XSETLINEATTRIBUTES *WINDOW-DISPLAY* (CADDR GLVAR1496)
                    1 0 1 0)))))
    (IF (NTH 10 M) (WINDOW-RESET-COLOR MW))
    (XFLUSH *WINDOW-DISPLAY*)))

(DEFUN BARMENU-SELECT (M &OPTIONAL INSIDE)
  (LET (MW XZERO YZERO VAL)
    (SETQ MW (OR (CADR M) (BARMENU-INIT M)))
    (UNLESS (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 ((GLVAR1503 (CADR M)) (GLVAR1506 (NTH 13 M)))
            (LET ((QQWHEIGHT (CADDDR GLVAR1503)))
              (IF (AND GLVAR1506 (/= GLVAR1506 1))
                  (XSETLINEATTRIBUTES *WINDOW-DISPLAY*
                      (CADDR GLVAR1503) (OR GLVAR1506 1) 0 1 0))
              (XDRAWLINE *WINDOW-DISPLAY* (CADR GLVAR1503)
                  (CADDR GLVAR1503) (+ XZERO (NTH 11 M))
                  (- QQWHEIGHT YZERO) (+ XZERO VAL)
                  (- QQWHEIGHT YZERO))
              (IF (AND GLVAR1506 (/= GLVAR1506 1))
                  (XSETLINEATTRIBUTES *WINDOW-DISPLAY*
                      (CADDR GLVAR1503) 1 0 1 0))))
          (LET ((GLVAR1507 (CADR M)) (GLVAR1510 (NTH 13 M)))
            (LET ((QQWHEIGHT (CADDDR GLVAR1507)))
              (IF (AND GLVAR1510 (/= GLVAR1510 1))
                  (XSETLINEATTRIBUTES *WINDOW-DISPLAY*
                      (CADDR GLVAR1507) (OR GLVAR1510 1) 0 1 0))
              (XDRAWLINE *WINDOW-DISPLAY* (CADR GLVAR1507)
                  (CADDR GLVAR1507) XZERO
                  (- QQWHEIGHT (+ YZERO (NTH 11 M))) XZERO
                  (- QQWHEIGHT (+ YZERO VAL)))
              (IF (AND GLVAR1510 (/= GLVAR1510 1))
                  (XSETLINEATTRIBUTES *WINDOW-DISPLAY*
                      (CADDR GLVAR1507) 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 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-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)
  (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)
  (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)
  (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 (EQL EVENTWINDOW WIN)
                 (SETQ RES (WINDOW-PROCESS-CHAR-EVENT W TYPE FN)))))
    RES))

(DEFUN WINDOW-PROCESS-CHAR-EVENT (W TYPE FN)
  (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
                                   (OR
                                    (AREF
                                     (IF *WINDOW-SHIFT*
                                      *WINDOW-SHIFTKEYMAP*
                                      *WINDOW-KEYMAP*)
                                     CODE)
                                    #\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)
  (LET ()
    (SETQ *WINDOW-INPUT-STRING-X* X)
    (SETQ *WINDOW-INPUT-STRING-Y* Y)
    (SETQ *WINDOW-INPUT-STRING-CHARWIDTH* (WINDOW-STRING-WIDTH W "M"))
    (SETQ *WINDOW-STRING-MAX*
          (IF SIZE (/ SIZE *WINDOW-INPUT-STRING-CHARWIDTH*) 100))
    (SETQ *WINDOW-STRING-COUNT*
          (IF STR (MIN (LENGTH STR) *WINDOW-STRING-MAX*) 0))
    (WINDOW-ERASE-AREA-XY W X (- Y 2) (OR SIZE 100) 14)
    (IF (> *WINDOW-STRING-COUNT* 0)
        (PROGN
          (DOTIMES (I *WINDOW-STRING-COUNT*)
            (SETF (CHAR *WINDOW-STRING* I) (CHAR STR I)))
          (WINDOW-PRINTAT-XY W STR X Y)))
    (WINDOW-DRAW-CARAT W)
    (WINDOW-GET-CHARS W #'WINDOW-INPUT-CHAR-FN)))

(DEFUN WINDOW-INPUT-CHAR-FN (W CHAR)
  (LET ((TMPSTRING "Z"))
    (WINDOW-DRAW-CARAT W)
    (IF (CHAR= CHAR #\Return)
        (SUBSEQ *WINDOW-STRING* 0 *WINDOW-STRING-COUNT*)
        (PROGN
          (IF (CHAR= CHAR #\Backspace)
              (IF (> *WINDOW-STRING-COUNT* 0)
                  (PROGN
                    (DECF *WINDOW-STRING-COUNT*)
                    (WINDOW-PRINTAT-XY W " "
                        (+ *WINDOW-INPUT-STRING-X*
                           (* *WINDOW-STRING-COUNT*
                              *WINDOW-INPUT-STRING-CHARWIDTH*))
                        *WINDOW-INPUT-STRING-Y*)
                    (WINDOW-DRAW-CARAT W)))
              (IF (< *WINDOW-STRING-COUNT* *WINDOW-STRING-MAX*)
                  (PROGN
                    (SETF (CHAR *WINDOW-STRING* *WINDOW-STRING-COUNT*)
                          CHAR)
                    (INCF *WINDOW-STRING-COUNT*)
                    (SETF (CHAR TMPSTRING 0) CHAR)
                    (WINDOW-PRINTAT-XY W TMPSTRING
                        (+ *WINDOW-INPUT-STRING-X*
                           (* (1- *WINDOW-STRING-COUNT*)
                              *WINDOW-INPUT-STRING-CHARWIDTH*))
                        *WINDOW-INPUT-STRING-Y*)
                    (WINDOW-DRAW-CARAT W))))
          NIL))))

(DEFUN WINDOW-DRAW-CARAT (W)
  (LET ((ORIGX *WINDOW-INPUT-STRING-X*) (Y *WINDOW-INPUT-STRING-Y*) X)
    (SETQ X
          (+ ORIGX
             (* *WINDOW-INPUT-STRING-CHARWIDTH* *WINDOW-STRING-COUNT*)))
    (WINDOW-SET-XOR W)
    (WINDOW-DRAW-LINE-XY W (- X 2) (- Y 2) (+ X 3) Y)
    (WINDOW-DRAW-LINE-XY W (+ X 3) Y (+ X 8) (- 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 (INT-POS KEYSYM 0))
      (SETQ SHIFTKEYNUM (INT-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)))))




