(FILECREATED "11-Dec-87 13:57:15" {ICE}<KOOMEN>LISPUSERS>KOTO>TILED-SEDIT.;4 11196  

      changes to:  (FNS POST.TILED.SEDIT.GET.WINDOW.REGION)

      previous date: "13-Nov-87 15:37:50" {ICE}<KOOMEN>LISPUSERS>KOTO>TILED-SEDIT.;3)


(* Copyright (c) 1987 by Johannes A. G. M. Koomen. All rights reserved.)

(PRETTYCOMPRINT TILED-SEDITCOMS)

(RPAQQ TILED-SEDITCOMS ((* ;;; 
"Provides a similar facility for SEdit as the LispUsers package TILEDEDIT provides for DEdit, i.e., instead of prompting the user for regions, generates successive regions in a circular fashion, eachtime throught the full window loop offsetting the next window by 12,-12.  Users can select their preference through the TILING-ORDER  argument to the function TILED.SEDIT.RESET, which must be either NIL (no tiling), T (default tiling order) or a list of the symbols TL (top-left) TR (top-right) BL (bottom-left) and BR (bottom-right)"
			     )
			  (* ;; "User Interface")
			  (FNS TILED.SEDIT.RESET)
			  (* ;; "Support ")
			  (LOCALVARS . T)
			  (INITVARS (*TiledSEditMargin* 25)
				    (*TiledSEditXShift* 15)
				    (*TiledSEditYShift* 15)
				    (*TiledSEditRegions* NIL))
			  (RECORDS TILED.SEDIT.REGION)
			  (FNS POST.TILED.SEDIT.GET.WINDOW.REGION POST.TILED.SEDIT.SAVE.WINDOW.REGION 
			       TILED.SEDIT.NEW.REGION TILED.SEDIT.SWITCHFN)
			  (GLOBALVARS *TiledSEditXShift* *TiledSEditYShift* *TiledSEditRegions* 
				      *TiledSEditRegionWidth* *TiledSEditRegionHeight* 
				      *TiledSEditCorners* *TiledSEditNextCornerPtr* 
				      *TiledSEditNextTopLeftRegion* *TiledSEditNextBottomLeftRegion* 
				      *TiledSEditNextTopRightRegion* 
				      *TiledSEditNextBottomRightRegion*)
			  [COMS (* ;; "KOTO compatibility")
				(FILES SEDIT-PATCHES)
				(* ;; "Fake keywords for Koto")
				(FNS MKKEYWORD)
				(P (MKKEYWORD (QUOTE ((:TL :TOPLEFT :TOP-LEFT :TOP.LEFT)
						      (:BL :BOTTOMLEFT :BOTTOM-LEFT :BOTTOM.LEFT)
						      (:TR :TOPRIGHT :TOP-RIGHT :TOP.RIGHT)
						      (:BR :BOTTOMRIGHT :BOTTOM-RIGHT :BOTTOM.RIGHT]
			  (* ;; "Set up the world")
			  (P (TILED.SEDIT.RESET T))))



(* ;;; 
"Provides a similar facility for SEdit as the LispUsers package TILEDEDIT provides for DEdit, i.e., instead of prompting the user for regions, generates successive regions in a circular fashion, eachtime throught the full window loop offsetting the next window by 12,-12.  Users can select their preference through the TILING-ORDER  argument to the function TILED.SEDIT.RESET, which must be either NIL (no tiling), T (default tiling order) or a list of the symbols TL (top-left) TR (top-right) BL (bottom-left) and BR (bottom-right)"
)




(* ;; "User Interface")

(DEFINEQ

(TILED.SEDIT.RESET
  [LAMBDA (TILING-ORDER XSHIFT YSHIFT SCREEN)                (* Koomen "13-Nov-87 14:57")
                                                             (* ; "Edited 22-Oct-87 11:35 by Koomen")
    [if (NULL TILING-ORDER)
	then                                               (* ;; "Reset the world")
	       (SETQ *TiledSEditRegions*)
      else                                                 (* ;; "Determine new order")
                                                             (* ; "BEWARE!!! INFINITE LIST!!!")
	     [LET [(ORDER (if (EQ TILING-ORDER T)
			      then (LIST :TL :BL :TR :BR)
			    else (for CORNER inside TILING-ORDER
				      collect (SELECTQ CORNER
							   ((:TL :TOPLEFT :TOP-LEFT :TOP.LEFT)
							     :TL)
							   ((:BL :BOTTOMLEFT :BOTTOM-LEFT 
								 :BOTTOM.LEFT)
							     :BL)
							   ((:TR :TOPRIGHT :TOP-RIGHT :TOP.RIGHT)
							     :TR)
							   ((:BR :BOTTOMRIGHT :BOTTOM-RIGHT 
								 :BOTTOM.RIGHT)
							     :BR)
							   (ERROR "Unsupported TILING-ORDER spec:" 
								    CORNER]
	          (SETQ TILING-ORDER (COPY ORDER))
	          (SETQ *TiledSEditNextCornerPtr* (SETQ *TiledSEditCorners* (NCONC ORDER ORDER]
                                                             (* ;; "Determine starting placements")
	     (SETQ *TiledSEditXShift* (OR (FIXP XSHIFT)
					      15))
	     (SETQ *TiledSEditYShift* (OR (FIXP YSHIFT)
					      15))
	     [if (NOT (REGIONP SCREEN))
		 then (SETQ SCREEN (LET ((MARGIN (OR (FIXP SCREEN)
							   25)))
					    (CREATEREGION MARGIN MARGIN (IDIFFERENCE SCREENWIDTH 
											 MARGIN)
							    (IDIFFERENCE SCREENHEIGHT MARGIN]
	     (LET* ((WIDTH (LRSH (IDIFFERENCE (fetch (REGION WIDTH) of SCREEN)
						  (LLSH *TiledSEditXShift* 2))
				   1))
		    (HEIGHT (LRSH (IDIFFERENCE (fetch (REGION HEIGHT) of SCREEN)
						   (LLSH *TiledSEditYShift* 2))
				    1))
		    (TL-LEFT (fetch (REGION LEFT) of SCREEN))
		    (BL-LEFT TL-LEFT)
		    (BL-BOTTOM (IPLUS *TiledSEditYShift* *TiledSEditYShift* (fetch (REGION BOTTOM)
										 of SCREEN)))
		    (BR-BOTTOM BL-BOTTOM)
		    (TL-BOTTOM (IPLUS BL-BOTTOM HEIGHT *TiledSEditYShift* *TiledSEditYShift*))
		    (TR-BOTTOM TL-BOTTOM)
		    (TR-LEFT (IPLUS TL-LEFT WIDTH *TiledSEditXShift* *TiledSEditXShift*))
		    (BR-LEFT TR-LEFT))
	           (SETQ *TiledSEditNextTopLeftRegion* (CREATEREGION TL-LEFT TL-BOTTOM WIDTH 
									 HEIGHT))
	           (SETQ *TiledSEditNextBottomLeftRegion* (CREATEREGION BL-LEFT BL-BOTTOM WIDTH 
									    HEIGHT))
	           (SETQ *TiledSEditNextTopRightRegion* (CREATEREGION TR-LEFT TR-BOTTOM WIDTH 
									  HEIGHT))
	           (SETQ *TiledSEditNextBottomRightRegion* (CREATEREGION BR-LEFT BR-BOTTOM WIDTH 
									     HEIGHT)))
                                                             (* ;; 
							     
"Move currently open SEdit windows (keep relative order), and recompute Tiled SEdit  regions")
	     (LET ((OLDREGIONS (CAR *TiledSEditRegions*))
		   CONTEXT OTHERS)
	          (SETQ *TiledSEditRegions* (CONS))
	          [for W in (OPENWINDOWS) when (SETQ CONTEXT (WINDOWPROP W (QUOTE
										       EditContext)))
		     do (for TSR in OLDREGIONS when (EQ (fetch TSR.CONTEXT of TSR)
								  CONTEXT)
			     do (replace TSR.REGION of TSR with W)
				  (RETURN)
			     finally (push OTHERS (CONS W CONTEXT]
	          (for TSR in OLDREGIONS when (WINDOWP (fetch TSR.REGION of TSR))
		     do (SHAPEW (fetch TSR.REGION of TSR)
				    (POST.TILED.SEDIT.GET.WINDOW.REGION (fetch TSR.CONTEXT
									     of TSR)
									  :CREATE)))
	          (for PAIR in OTHERS do (SHAPEW (CAR PAIR)
							 (POST.TILED.SEDIT.GET.WINDOW.REGION
							   (CDR PAIR)
							   :CREATE]
    (TILED.SEDIT.SWITCHFN (NULL TILING-ORDER)
			    (QUOTE SEDIT.GET.WINDOW.REGION)
			    (QUOTE PRE.TILED.SEDIT.GET.WINDOW.REGION)
			    (QUOTE POST.TILED.SEDIT.GET.WINDOW.REGION))
    (TILED.SEDIT.SWITCHFN (NULL TILING-ORDER)
			    (QUOTE SEDIT.SAVE.WINDOW.REGION)
			    (QUOTE PRE.TILED.SEDIT.SAVE.WINDOW.REGION)
			    (QUOTE POST.TILED.SEDIT.SAVE.WINDOW.REGION))
    TILING-ORDER])
)



(* ;; "Support ")

(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)

(RPAQ? *TiledSEditMargin* 25)

(RPAQ? *TiledSEditXShift* 15)

(RPAQ? *TiledSEditYShift* 15)

(RPAQ? *TiledSEditRegions* NIL)
[DECLARE: EVAL@COMPILE 

(RECORD TILED.SEDIT.REGION (TSR.CONTEXT . TSR.REGION))
]
(DEFINEQ

(POST.TILED.SEDIT.GET.WINDOW.REGION
  [LAMBDA (CONTEXT REASON)                                   (* Koomen "11-Dec-87 13:56")
                                                             (* ; "Edited 16-Sep-87 14:19 by Koomen")
                                                             (* ;; "REASON ignored")
    (COPY (for TSR in (CAR *TiledSEditRegions*) unless (fetch TSR.CONTEXT of TSR)
	       do (replace TSR.CONTEXT of TSR with CONTEXT)
		    (RETURN (fetch TSR.REGION of TSR))
	       finally (SETQ TSR (TILED.SEDIT.NEW.REGION CONTEXT))
			 (TCONC *TiledSEditRegions* TSR)
			 (RETURN (fetch TSR.REGION of TSR])

(POST.TILED.SEDIT.SAVE.WINDOW.REGION
  [LAMBDA (CONTEXT REASON)                                   (* ; "Edited 16-Sep-87 15:15 by Koomen")
                                                             (* ;; "REASON ignored")
    (for TSR in (CAR *TiledSEditRegions*) when (EQ (fetch TSR.CONTEXT of TSR)
							     CONTEXT)
       do (RETURN (replace TSR.CONTEXT of TSR with NIL])

(TILED.SEDIT.NEW.REGION
  [LAMBDA (CONTEXT)                                          (* ; "Edited 17-Sep-87 12:51 by Koomen")
    (LET* ((NEXTREGION (SELECTQ (pop *TiledSEditNextCornerPtr*)
				  (:TL *TiledSEditNextTopLeftRegion*)
				  (:BL *TiledSEditNextBottomLeftRegion*)
				  (:TR *TiledSEditNextTopRightRegion*)
				  (:BR *TiledSEditNextBottomRightRegion*)
				  (SHOULDNT "Bad corner spec!")))
	   (THISREGION (COPY NEXTREGION)))
          (replace (REGION LEFT) of NEXTREGION with (IPLUS (fetch (REGION LEFT)
								      of NEXTREGION)
								   *TiledSEditXShift*))
          (replace (REGION BOTTOM) of NEXTREGION with (IDIFFERENCE (fetch (REGION BOTTOM)
									      of NEXTREGION)
									   *TiledSEditYShift*))
          (create TILED.SEDIT.REGION
		    TSR.CONTEXT ← CONTEXT
		    TSR.REGION ← THISREGION])

(TILED.SEDIT.SWITCHFN
  [LAMBDA (RESTOREFLG FN SAVEFN REPLFN)                      (* ; "Edited 16-Sep-87 11:18 by Koomen")
    (if (NOT (DEFINEDP SAVEFN))
	then (PUTD SAVEFN (GETD FN)))
    (PUTD FN (GETD (if (OR RESTOREFLG (NOT (DEFINEDP REPLFN)))
			   then SAVEFN
			 else REPLFN])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS *TiledSEditXShift* *TiledSEditYShift* *TiledSEditRegions* *TiledSEditRegionWidth* 
	    *TiledSEditRegionHeight* *TiledSEditCorners* *TiledSEditNextCornerPtr* 
	    *TiledSEditNextTopLeftRegion* *TiledSEditNextBottomLeftRegion* 
	    *TiledSEditNextTopRightRegion* *TiledSEditNextBottomRightRegion*)
)



(* ;; "KOTO compatibility")

(FILESLOAD SEDIT-PATCHES)



(* ;; "Fake keywords for Koto")

(DEFINEQ

(MKKEYWORD
  [LAMBDA (X)                                                (* Koomen "13-Nov-87 15:13")
    (if (LISTP X)
	then (for Y in X collect (MKKEYWORD Y))
      else (if (NEQ (CHCON1 X)
			  (CHARCODE ":"))
		 then (SETQ X (PACK* ":" X)))
	     (SETTOPVAL X X])
)
[MKKEYWORD (QUOTE ((:TL :TOPLEFT :TOP-LEFT :TOP.LEFT)
		   (:BL :BOTTOMLEFT :BOTTOM-LEFT :BOTTOM.LEFT)
		   (:TR :TOPRIGHT :TOP-RIGHT :TOP.RIGHT)
		   (:BR :BOTTOMRIGHT :BOTTOM-RIGHT :BOTTOM.RIGHT]



(* ;; "Set up the world")

(TILED.SEDIT.RESET T)
(PUTPROPS TILED-SEDIT COPYRIGHT ("Johannes A. G. M. Koomen" 1987))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2689 7300 (TILED.SEDIT.RESET 2699 . 7298)) (7608 10051 (
POST.TILED.SEDIT.GET.WINDOW.REGION 7618 . 8341) (POST.TILED.SEDIT.SAVE.WINDOW.REGION 8343 . 8782) (
TILED.SEDIT.NEW.REGION 8784 . 9698) (TILED.SEDIT.SWITCHFN 9700 . 10049)) (10503 10853 (MKKEYWORD 10513
 . 10851)))))
STOP