;; -*- Mode:LISP; Package:(BOXER GLOBAL 1000); Base:8.; Fonts:CPTFONT -*-

;;; (C) Copyright 1983-1985 Massachusetts Institute of Technology
;;;
;;; Permission to use, copy, modify, distribute, and sell this software
;;; and its documentation for any purpose is hereby granted without fee,
;;; provided that the above copyright notice appear in all copies and that
;;; both that copyright notice and this permission notice appear in
;;; supporting documentation, and that the name of M.I.T. not be used in
;;; advertising or publicity pertaining to distribution of the software
;;; without specific, written prior permission.  M.I.T. makes no
;;; representations about the suitability of this software for any
;;; purpose.  It is provided "as is" without express or implied warranty.
;;;


;;; Defines all the "normal" (no ctrl- or meta- or super- or...) keys to be self inserting
#.
(LET ((VANILLA-KEY-CODES-NOT-TO-DEFINE '(#/| #/[ #/] #/{ #/})))
    `(PROGN 'COMPILE
      . ,(LOOP FOR KEY-CODE FROM 0 TO #O177
	       UNLESS  (OR (MEMQ KEY-CODE VANILLA-KEY-CODES-NOT-TO-DEFINE)
			   (AND (>= KEY-CODE 141) (<= KEY-CODE 172)))
	       COLLECT `(DEFBOXER-FUNCTION ,(LOOKUP-KEY-NAME KEY-CODE) COM-SELF-INSERT))))

;;; Defines all the "control" (ctrl-, meta-, or ctrl-meta- ) number keys to act as a numeric
;;; argument

#.
`(PROGN 'COMPILE
	. ,(LOOP FOR CONTROL-BITS FROM 1 TO 3
		 APPEND (LOOP FOR KEY-CODE FROM (DPB CONTROL-BITS %%KBD-CONTROL-META 60)
			                   TO   (DPB CONTROL-BITS %%KBD-CONTROL-META 71)
			      COLLECT `(DEFBOXER-FUNCTION ,(LOOKUP-KEY-NAME KEY-CODE) 
					 COM-INCREMENT-NUMERIC-ARG))))


(DEFBOXER-FUNCTION BU:CTRL-G-KEY COM-ABORT)

(DEFBOXER-FUNCTION BU:SPACE-KEY COM-SPACE)

(DEFBOXER-FUNCTION BU:RETURN-KEY COM-RETURN)

(DEFBOXER-FUNCTION BU:QUOTE-KEY COM-QUOTE-SELF-INSERT)

(DEFBOXER-FUNCTION BU:CTRL-Q-KEY COM-QUOTE-SELF-INSERT)

(DEFBOXER-FUNCTION BU:CTRL-O-KEY COM-OPEN-LINE)
						
(DEFBOXER-FUNCTION BU:RUBOUT-KEY COM-RUBOUT)

(DEFBOXER-FUNCTION BU:CTRL-D-KEY COM-DELETE)

(DEFBOXER-FUNCTION BU:CTRL-F-KEY COM-FORWARD-CHA)

(DEFBOXER-FUNCTION BU:CTRL-B-KEY COM-BACKWARD-CHA)

(DEFBOXER-FUNCTION BU:META-F-KEY COM-FORWARD-WORD)

(DEFBOXER-FUNCTION BU:META-B-KEY COM-BACKWARD-WORD)

(DEFBOXER-FUNCTION BU:CTRL-N-KEY COM-NEXT-ROW)

(DEFBOXER-FUNCTION BU:CTRL-P-KEY COM-PREVIOUS-ROW)

(DEFBOXER-FUNCTION BU:CTRL-A-KEY COM-BEGINNING-OF-ROW)

(DEFBOXER-FUNCTION BU:CTRL-E-KEY COM-END-OF-ROW)

(DEFBOXER-FUNCTION BU:META-<-KEY COM-BEGINNING-OF-BOX)

(DEFBOXER-FUNCTION BU:META->-KEY COM-END-OF-BOX)

(DEFBOXER-FUNCTION BU:CTRL-V-KEY COM-SCROLL-DN-ONE-SCREEN-BOX)

(DEFBOXER-FUNCTION BU:META-V-KEY COM-SCROLL-UP-ONE-SCREEN-BOX)

(DEFBOXER-FUNCTION BU:CTRL-K-KEY COM-KILL-TO-END-OF-ROW)

;;; fonts
(DEFBOXER-FUNCTION BU:CTRL-I-KEY COM-ITALICS-FONT-CHA)

(DEFBOXER-FUNCTION BU:META-I-KEY COM-ITALICS-FONT-WORD)

(DEFBOXER-FUNCTION BU:CTRL-M-KEY COM-BOLDFACE-FONT-CHA)

(DEFBOXER-FUNCTION BU:META-M-KEY COM-BOLDFACE-FONT-WORD)

;;; and case
(DEFBOXER-FUNCTION META-U-KEY COM-UPPERCASE-WORD)

(DEFBOXER-FUNCTION META-L-KEY COM-LOWERCASE-WORD)

;;; search

(DEFBOXER-FUNCTION CTRL-S-KEY COM-FORWARD-FLAT-SEARCH)

(DEFBOXER-FUNCTION CTRL-R-KEY COM-BACKWARD-FLAT-SEARCH)

(DEFBOXER-FUNCTION META-S-KEY COM-FORWARD-DEEP-SEARCH)

(DEFBOXER-FUNCTION META-R-KEY COM-BACKWARD-DEEP-SEARCH)

;temporarily removed until it does saving
;(DEFBOXER-FUNCTION BU:META-K-KEY ()
;  (COM-KILL-TO-END-OF-BOX))

(DEFBOXER-FUNCTION BU:CTRL-Y-KEY COM-YANK)

(defboxer-function bu:ctrl-meta-y-key com-yank-no-copy)

;doesn't put the stuff on the screen -- just rotates it.
(DEFBOXER-FUNCTION BU:META-Y-KEY COM-ROTATE-KILL-BUFFER)
				     
(DEFBOXER-FUNCTION BU:CTRL-META-B-KEY COM-BOXIFY-REGION)

(DEFBOXER-FUNCTION BU:CTRL-L-KEY COM-FORCE-REDISPLAY)

(DEFBOXER-FUNCTION BU:BREAK-KEY COM-BREAK)

;;;Regions
(DEFBOXER-FUNCTION BU:CTRL-@-KEY COM-DEFINE-REGION)

(DEFBOXER-FUNCTION BU:META-@-KEY COM-INSTALL-REGION)

(DEFBOXER-FUNCTION BU:CTRL-W-KEY COM-KILL-REGION)

#+3600
(DEFBOXER-FUNCTION BU:CIRCLE-KEY COM-NAME-BOX)
#+EXPLORER
(DEFBOXER-FUNCTION BU:F3-KEY     COM-NAME-BOX)

#+CADR
(DEFBOXER-FUNCTION BU:HAND-DOWN-KEY COM-BUG)
#+3600
(DEFBOXER-FUNCTION BU:SCROLL-KEY    COM-BUG)
#+EXPLORER
(DEFBOXER-FUNCTION BU:F4-KEY        COM-BUG)

(DEFBOXER-FUNCTION BU:CLEAR-INPUT-KEY COM-TOGGLE-BOX-TYPE)

(DEFBOXER-FUNCTION BU:{-KEY COM-MAKE-AND-ENTER-DATA-BOX)

(DEFBOXER-FUNCTION BU:}-KEY COM-EXIT-BOX)

(DEFBOXER-FUNCTION BU:CTRL-{-KEY COM-ENTER-BOX)

(DEFBOXER-FUNCTION BU:CTRL-}-KEY COM-EXIT-BOX)

(DEFBOXER-FUNCTION BU:[-KEY COM-MAKE-AND-ENTER-BOX)

(DEFBOXER-FUNCTION BU:]-KEY COM-EXIT-BOX)

(DEFBOXER-FUNCTION BU:/(-KEY COM-MAKE-AND-ENTER-BOX)

(DEFBOXER-FUNCTION BU:/)-KEY COM-EXIT-BOX)

(DEFBOXER-FUNCTION BU:CTRL-/(-KEY COM-ENTER-BOX)

(DEFBOXER-FUNCTION BU:CTRL-/)-KEY COM-EXIT-BOX)

(DEFBOXER-FUNCTION BU:CTRL-[-KEY COM-ENTER-BOX)

(DEFBOXER-FUNCTION BU:CTRL-]-KEY COM-EXIT-BOX)

(DEFBOXER-FUNCTION BU:CTRL-<-KEY COM-COLLAPSE-BOX)

(DEFBOXER-FUNCTION BU:CTRL->-KEY COM-EXPAND-BOX)

(DEFBOXER-FUNCTION BU:CTRL-META-<-KEY COM-GOTO-TOP-LEVEL)

(DEFBOXER-FUNCTION CTRL-=-KEY COM-FIX-BOX-SIZE)

(DEFBOXER-FUNCTION META-=-KEY COM-UNFIX-BOX-SIZE)

(DEFBOXER-FUNCTION CTRL-+-KEY COM-MAKE-SHRINK-PROOF-SCREEN)

(DEFBOXER-FUNCTION META-+-KEY COM-UNSHRINK-PROOF-SCREEN)

(DEFBOXER-FUNCTION CTRL-SPACE-KEY COM-MAKE-PORT)

(DEFBOXER-FUNCTION META-SPACE-KEY COM-PLACE-PORT)

(DEFBOXER-FUNCTION META-RUBOUT-KEY COM-RUBOUT-WORD)

(DEFBOXER-FUNCTION META-D-KEY COM-DELETE-WORD)

#+CADR
(DEFBOXER-FUNCTION BU:ALTMODE-KEY  COM-PROMPT)
#+3600
(DEFBOXER-FUNCTION BU:COMPLETE-KEY COM-PROMPT)
#+(OR 3600 EXPLORER)
(DEFBOXER-FUNCTION BU:ESCAPE-KEY   COM-PROMPT)

;The 3600 lacks a status key, but has a LOCAL key which generates #\QUOTE
#+3600
(DEFBOXER-FUNCTION BU:CTRL-CIRCLE-KEY COM-EDIT-LOCAL-LIBRARY)
#-3600 
(DEFBOXER-FUNCTION BU:STATUS-KEY      COM-EDIT-LOCAL-LIBRARY)
#+EXPLORER  
(DEFBOXER-FUNCTION BU:CTRL-F3-KEY     COM-EDIT-LOCAL-LIBRARY)

(DEFBOXER-FUNCTION BU:HELP-KEY COM-HELP)

(DEFBOXER-FUNCTION CTRL-HELP-KEY COM-COMMAND-HELP)

(DEFBOXER-FUNCTION META-HELP-KEY COM-APROPOS-HELP)

(DEFBOXER-FUNCTION BU:END-KEY COM-DOIT)

(DEFBOXER-FUNCTION BU:CTRL-END-KEY COM-DOIT-NOW)

(DEFBOXER-FUNCTION BU:META-END-KEY COM-UNMARK-REGION)

(defboxer-function bu:line-key com-doit-now)

(DEFBOXER-FUNCTION BU:META-LINE-KEY com-doit-now-give-lispm-errors)

(define-key-name 'bu:step-key #-3600 #\MACRO
		              #+3600 #\page)

(defboxer-function bu:step-key com-step-through-box)
 
#+3600
(DEFBOXER-FUNCTION BU:SQUARE-KEY COM-MAKE-GRAPHICS-BOX)
#+EXPLORER
(DEFBOXER-FUNCTION BU:F1-KEY     COM-MAKE-GRAPHICS-BOX)

#+3600
(DEFBOXER-FUNCTION BU:CTRL-SQUARE-KEY COM-MAKE-GRAPHICS-DATA-BOX)
#+EXPLORER
(DEFBOXER-FUNCTION BU:CTRL-F1-KEY     COM-MAKE-GRAPHICS-DATA-BOX) 

#+3600
(DEFBOXER-FUNCTION BU:TRIANGLE-KEY COM-MAKE-SPRITE-BOX)
#+EXPLORER
(DEFBOXER-FUNCTION BU:F2-KEY       COM-MAKE-SPRITE-BOX)

(DEFBOXER-FUNCTION BU:CTRL-CLEAR-INPUT-KEY ()	
  (COM-TOGGLE-INTO-GRAPHICS-BOX))

;;;strange lossage where CTRL-CLEAR-INPUT isn't being tyi'd
#+EXPLORER
(DEFBOXER-FUNCTION BU:META-F1-KEY COM-TOGGLE-INTO-GRAPHICS-BOX)

(setq WHO-LINE-DOCUMENTATION-STRING
"L:Make Box Smaller, L2:Make Box Tiny, M:Move To Box, R:Make Box Larger, R2:Make Box Full Screen")

(DEFBOXER-FUNCTION MOUSE-LEFT-ONCE (WINDOW X Y)
  (LET ((SPRITE (TELL *SPRITE-BLINKER* :SELECTED-SPRITE)))
    (IF (NOT (NULL SPRITE))
	(COM-SPRITE-LEFT-CLICK SPRITE)
	(COM-MOUSE-COLLAPSE-BOX WINDOW X Y))))

(DEFBOXER-FUNCTION MOUSE-RIGHT-ONCE (WINDOW X Y)
  (LET ((SPRITE (TELL *SPRITE-BLINKER* :SELECTED-SPRITE)))
    (IF (NOT (NULL SPRITE))
	(COM-SPRITE-RIGHT-CLICK SPRITE)
	(COM-MOUSE-EXPAND-BOX WINDOW X Y))))

(DEFBOXER-FUNCTION MOUSE-MIDDLE-ONCE (WINDOW X Y)
  (LET ((SPRITE (TELL *SPRITE-BLINKER* :SELECTED-SPRITE)))
    (IF (NOT (NULL SPRITE))
	(COM-SPRITE-MIDDLE-CLICK SPRITE)
	(COM-MOUSE-MOVE-POINT WINDOW X Y))))

(DEFBOXER-FUNCTION MOUSE-LEFT-TWICE (WINDOW X Y)
  (COM-MOUSE-SHRINK-BOX WINDOW X Y))

(DEFBOXER-FUNCTION MOUSE-RIGHT-TWICE (WINDOW X Y)
  (COM-MOUSE-SET-OUTERMOST-BOX WINDOW X Y))

(DEFBOXER-FUNCTION MOUSE-MIDDLE-DOWN (WINDOW X Y)
  (LET ((SPRITE (TELL *SPRITE-BLINKER* :SELECTED-SPRITE)))
	(IF (NOT (NULL SPRITE))
	    (COM-MOUSE-GRAB-SPRITE SPRITE)
	    (COM-MOUSE-DEFINE-REGION WINDOW X Y))))

(DEFBOXER-FUNCTION MOUSE-MIDDLE-UP (WINDOW X Y)
  (COM-MOUSE-RELEASE-REGION WINDOW X Y))

(COMMENT

(DEFBOXER-FUNCTION MOUSE-LEFT-ONCE (WINDOW X Y)
  (COM-MOUSE-FANCY-LEFT WINDOW X Y))

(DEFBOXER-FUNCTION MOUSE-RIGHT-ONCE (WINDOW X Y)
  (COM-MOUSE-FANCY-UP WINDOW X Y))

(DEFVAR MOUSE-FANCY-LEFT-DIRECTION -1)
(DEFVAR MOUSE-FANCY-UP-DIRECTION -1)

(DEFUN  MOUSE-FANCY-LEFT-COMPLEMENT-DIRECTION ()
  (IF (MINUSP MOUSE-FANCY-LEFT-DIRECTION)
      (SETQ MOUSE-FANCY-LEFT-DIRECTION 1)
      (SETQ MOUSE-FANCY-LEFT-DIRECTION -1)))

(DEFUN  MOUSE-FANCY-UP-COMPLEMENT-DIRECTION ()
  (IF (MINUSP MOUSE-FANCY-UP-DIRECTION)
      (SETQ MOUSE-FANCY-UP-DIRECTION 1)
      (SETQ MOUSE-FANCY-UP-DIRECTION -1)))

(DEFUN  COM-MOUSE-FANCY-LEFT (&REST IGNORE)
  (MOUSE-FANCY-MOVE)
  (MOUSE-FANCY-LEFT-COMPLEMENT-DIRECTION))

(DEFUN  COM-MOUSE-FANCY-UP (&REST IGNORE)
  (MOUSE-FANCY-MOVE)
  (MOUSE-FANCY-UP-COMPLEMENT-DIRECTION))

(DEFUN MOUSE-FANCY-MOVE (&REST IGNORE)
  (LET ((DELTA 2))
    (LOOP UNTIL (ZEROP TV:MOUSE-LAST-BUTTONS)
	  DO (TV:MOUSE-WARP (IF (BIT-TEST #O1 TV:MOUSE-LAST-BUTTONS)
				(FIX (+ TV:MOUSE-X (* MOUSE-FANCY-LEFT-DIRECTION DELTA)))
				TV:MOUSE-X)
			    (IF (BIT-TEST #O4 TV:MOUSE-LAST-BUTTONS)
				(FIX (+ TV:MOUSE-Y (* MOUSE-FANCY-UP-DIRECTION DELTA)))
				TV:MOUSE-Y))
	     (SETQ DELTA (MIN 24. (* 2 DELTA)))
	     (PROCESS-WAIT "Sleep"
			   #'(LAMBDA (WAKEUP) (OR (> (TIME) WAKEUP)
						  (ZEROP TV:MOUSE-LAST-BUTTONS)))
			   (+ (TIME) 20.)))))

)