-
-
Notifications
You must be signed in to change notification settings - Fork 25
/
Copy pathLAYOUT-SEDIT
128 lines (94 loc) · 7.05 KB
/
LAYOUT-SEDIT
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
(DEFINE-FILE-INFO §READTABLE "XCL" §PACKAGE (DEFPACKAGE "LAYOUT-SEDIT" (§NICKNAMES "L-S")))
(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)
; Copyright (c) 1986, 1987 by Pavel Curtis. All rights reserved.
(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 'il:sedit.get.window.region 'old-get-region)
(il:movd 'il:sedit.save.window.region 'old-save-region)
(il:movd 'get-region 'il:sedit.get.window.region)
(il:movd 'save-region '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 'old-get-region 'il:sedit.get.window.region)
(il:movd 'old-save-region '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
'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 '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 'null *region-alist* :key 'cdr))))
(il:declare\: il:donteval@load il:donteval@compile il:docopy
(user::use-l-s-regions)
)
(il:* il:|;;| "Arrange to use the proper compiler and makefile environment ")
(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))
(il:declare\: il:dontcopy
(il:filemap (nil)))
il:stop