(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