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




