-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathLAYOUT-SEDIT.LCOM
52 lines (52 loc) · 4.52 KB
/
LAYOUT-SEDIT.LCOM
1
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "LAYOUT-SEDIT" (NICKNAMES "L-S")))(IL:FILECREATED " 9-Sep-94 13:47:35" ("compiled on " IL:|{DSK}<lispcore>lispusers>LAYOUT-SEDIT.;1|) "28-Jul-94 17:28:46" IL:|bcompl'd| IL:|in| "Medley 25-Aug-94 ..." IL:|dated| "25-Aug-94 10:02:49")(IL:FILECREATED " 9-Jan-87 19:55:25" IL:{ERIS}<LISPUSERS>LISPCORE>LAYOUT-SEDIT.\;2 7190 IL:|changes| IL:|to:| (IL:VARIABLES USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA* USER::*L-S-REUSE-EARLIER-REGIONS*) (IL:FUNCTIONS GET-REGION SAVE-REGION USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS) (IL:VARS IL:LAYOUT-SEDITCOMS) IL:|previous| IL:|date:| "26-Dec-86 19:42:46" IL:{ERIS}<PAVEL>LISP>LAYOUT-SEDIT.\;2)(IL:PRETTYCOMPRINT IL:LAYOUT-SEDITCOMS)(IL:RPAQQ IL:LAYOUT-SEDITCOMS ((IL:FUNCTIONS USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS) (IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA* USER::*L-S-REUSE-EARLIER-REGIONS*) (IL:FUNCTIONS REGION-PLUS) (IL:FUNCTIONS GET-REGION SAVE-REGION) (IL:DECLARE\: IL:DONTEVAL@LOAD IL:DONTEVAL@COMPILE IL:DOCOPY (IL:P (USER::USE-L-S-REGIONS))) (IL:* IL:|;;| "Arrange to use the proper compiler and makefile environment ") (IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT) IL:LAYOUT-SEDIT)))(DEFUN USER::USE-L-S-REGIONS NIL (ASSERT (NULL IL:|\\\\contexts|) NIL "Close all open SEdit windows") (IL:SEDIT.RESET) (IL:MOVD (QUOTE IL:SEDIT.GET.WINDOW.REGION) (QUOTE OLD-GET-REGION)) (IL:MOVD (QUOTE IL:SEDIT.SAVE.WINDOW.REGION) (QUOTE OLD-SAVE-REGION)) (IL:MOVD (QUOTE GET-REGION) (QUOTE IL:SEDIT.GET.WINDOW.REGION)) (IL:MOVD (QUOTE SAVE-REGION) (QUOTE IL:SEDIT.SAVE.WINDOW.REGION)))(DEFUN USER::STOP-USING-L-S-REGIONS NIL (ASSERT (NULL IL:|\\\\contexts|) NIL "Close all open SEdit windows") (IL:SEDIT.RESET) (IL:MOVD (QUOTE OLD-GET-REGION) (QUOTE IL:SEDIT.GET.WINDOW.REGION)) (IL:MOVD (QUOTE OLD-SAVE-REGION) (QUOTE IL:SEDIT.SAVE.WINDOW.REGION)))(DEFVAR *REGION-ALIST* NIL (IL:* IL:|;;;| "An AList mapping a region to the SEdit context that currently owns it. The associations of regions no longer in use should have a CDR of NIL. The list is kept in reverse order, with the farthest region from *REGION-ZERO* at the front of the list. So as to allow experimentation by users, we maintain the invariant that the first association on the list never has a CDR of NIL. To reestablish that invariant, we sometimes POP the AList rather than set the CDR to NIL."))(DEFVAR USER::*L-S-REGION-ZERO* (IL:CREATEREGION 25 (- (TRUNCATE IL:SCREENHEIGHT 2) 19) (TRUNCATE IL:SCREENWIDTH 2) (TRUNCATE IL:SCREENHEIGHT 2)) (IL:* IL:|;;;| "The region to be used by the first SEdit window. This works in conjunction with USER::*L-S-REGION-DELTA* to specify the region for each new SEdit window."))(DEFVAR USER::*L-S-REGION-DELTA* (IL:CREATEREGION 11 -44 0 0))(DEFVAR USER::*L-S-REUSE-EARLIER-REGIONS* NIL (IL:* IL:|;;;| "If non-NIL, then earlier regions (i.e., those closer to USER::*L-S-REGION-ZERO* will get reused when free. Otherwise, new regions, farther from USER::*L-S-REGION-ZERO* than any currently in use, will be created."))(DEFUN REGION-PLUS (ONE TWO) (IL:CREATEREGION (+ (IL:FETCH (IL:REGION IL:LEFT) IL:OF ONE) (IL:FETCH (IL:REGION IL:LEFT) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:BOTTOM) IL:OF ONE) (IL:FETCH (IL:REGION IL:BOTTOM) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:WIDTH) IL:OF ONE) (IL:FETCH (IL:REGION IL:WIDTH) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF ONE) (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF TWO))))(DEFUN GET-REGION (CONTEXT) (LET ((PAIR (AND USER::*L-S-REUSE-EARLIER-REGIONS* (FIND NIL *REGION-ALIST* :KEY (QUOTE CDR))))) (COND ((NULL PAIR) (COND ((NULL *REGION-ALIST*) (SETQ *REGION-ALIST* (LIST (CONS USER::*L-S-REGION-ZERO* CONTEXT))) USER::*L-S-REGION-ZERO*) (T (LET ((NEW-REGION (REGION-PLUS (CAR (FIRST *REGION-ALIST*)) USER::*L-S-REGION-DELTA*))) (PUSH (CONS NEW-REGION CONTEXT) *REGION-ALIST*) NEW-REGION)))) (T (SETF (CDR PAIR) CONTEXT) (CAR PAIR)))))(DEFUN SAVE-REGION (CONTEXT) (IL:* IL:|;;;| "The context is done with its region. Deallocate it.") (LET ((PAIR (FIND CONTEXT *REGION-ALIST* :KEY (QUOTE CDR)))) (IF (NULL PAIR) (WARN "An SEdit context is trying to give up an unallocated region.") (SETF (CDR PAIR) NIL)) (SETQ *REGION-ALIST* (MEMBER-IF-NOT (QUOTE NULL) *REGION-ALIST* :KEY (QUOTE CDR)))))(USER::USE-L-S-REGIONS)(IL:PUTPROPS IL:LAYOUT-SEDIT IL:FILETYPE COMPILE-FILE)(IL:PUTPROPS IL:LAYOUT-SEDIT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE (XCL:DEFPACKAGE "LAYOUT-SEDIT" (:NICKNAMES "L-S"))))(IL:PUTPROPS IL:LAYOUT-SEDIT IL:COPYRIGHT ("Pavel Curtis" 1986 1987))NIL