(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