;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;         The Garnet User Interface Development Environment.      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This code was written as part of the Garnet project at          ;;;
;;; Carnegie Mellon University, and has been placed in the public   ;;;
;;; domain.  If you are using this code or any part of Garnet,      ;;;
;;; please contact garnet@cs.cmu.edu to be put on the mailing list. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Changes:
;;;
;;; 16-Mar-94 Mickish Added Mac version
;;; 23-Aug-93 Mickish Added CLISP switches
;;; 15-Apr-92 Pervin  Adopted code from opal/defs.lisp to find display-name.
;;;

(in-package :USER)

#-apple
(let* ((display-name #+cmu (cdr (assoc :DISPLAY lisp::*environment-list*))
                     #+(or allegro lispworks kcl clisp) (sys::getenv "DISPLAY")
                     #+(and lucid lcl3.0)
		     (lucid-common-lisp:environment-variable "DISPLAY")
                     #+(and lucid (not lcl3.0))
		     (system:environment-variable "DISPLAY"))
       (colon-posn (position #\: display-name)))
  (when colon-posn (setq display-name (subseq display-name 0 colon-posn)))
  (setq display-name (or display-name #-(or allegro clisp) (machine-instance)
			 #+clisp ""
			 #+allegro (short-site-name)))
  (let* ((display (xlib:open-display display-name))
         (screen (xlib:display-default-screen display))
         (root (xlib:screen-root screen))
         (black (xlib:screen-black-pixel screen))
         (white (xlib:screen-white-pixel screen))
         (window (xlib:create-window :parent root :x 500 :y 100
				     :width 400 :height 400
				     :background white :border black
				     :event-mask '(:button-press :key-press)
				     :border-width 2 :override-redirect :off)))
    (xlib:map-window window)
    (xlib:display-force-output display)
    (format t "~%A window should appear on your screen.~%")
    (format t "Place your cursor inside the window and start typing.~%")
    (format t "Each time you hit a key, two numbers will be printed.~%")
    (format t "The first number is the keysym associated with the key you hit.~%")
    (format t "The second number is the keysym associated with the~%")
    (format t "       shift of the key you hit.~%")
    (format t "Those number is used in the file x-define-keys.lisp~%")
    (format t "       to map keysyms to keys.~%")
    (format t "~%")
    (format t "Get out of this by clicking any mouse button while in the window.~%")
    (format t "~%")
    (xlib:event-case (display :discard-p t)
		     (:key-press (code)
				 (format t "keysym = ~a  ~a~%"
					 (xlib:keycode->keysym display code 0)
					 (xlib:keycode->keysym display code 1))
				 nil)
		     (:button-press () t)
		     (t () nil))
    (xlib:unmap-window window)
    (xlib:display-force-output display)))

#+apple
(let ((drawable-class (defclass FIND-KEY-WINDOW (ccl:window) ()))
      (drawable (make-instance 'FIND-KEY-WINDOW
                  :view-position (ccl:make-point 20 50)
                  :view-size (ccl:make-point 300 150)
                  :close-box-p T
                  :window-type :document-with-zoom
                  :window-show T
                  :window-title "Find key codes")))

  (format t "~%A window should appear on your screen.~%")
  (format t "Click inside the window to activate it and start typing.~%")
  (format t "Each time you hit a key, a key-code corresponding to the~%")
  (format t "physical key on the keyboard will be printed, along with the~%")
  (format t "character that the unmodified key generates (modifier keys like~%")
  (format t "SHIFT are ignored by this utility).~%~%")
  (format t "You can change the character generated by the key by modifying~%")
  (format t "the line in inter/mac-define-keys.lisp that corresponds to the~%")
  (format t "key-code.  You can also change the keys reserved for leftdown,~%")
  (format t "middledown, and rightdown mouse events by setting the variables~%")
  (format t "inter::*leftdown-key*, inter::*middledown-key*, and inter::*rightdown-key*~%")
  (format t "or by editing the appropriate variable declarations in~%")
  (format t "inter/mac-define-keys.lisp.~%")

  (defmethod ccl:view-key-event-handler ((event-window FIND-KEY-WINDOW) char)
    (declare (ignore char))
    (let* ((message (ccl:rref ccl:*current-event* :EventRecord.message))
           ;; CODE contains the "key code" in the high-order word, and the
           ;; "character code" in the low-order word.
           ;; See gem::MAC-translate-character for more details.
           (code (logand message #xFFFF))
           (key-code (ash code -8)))
      (format t "key-code = ~A   char = ~A~%"
              key-code (gethash key-code inter::*keysym-translations*))))
  T)