-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathCOMMENTHACKS
284 lines (251 loc) · 14.3 KB
/
COMMENTHACKS
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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "11-Dec-87 13:33:22" {DSK}<XAVIER>COMMENTHACKS.;7 14426
changes to%: (FNS MYSUPERPRINT/COMMENT2 MYSUPERPRINT/COMMENT EDITDEF.FUNCTIONS
FIXDEFUNEDITDATE COMMENT2 MYEDITDATE? EDITDATE?)
(VARS COMMENTHACKSCOMS)
(FUNCTIONS FOOFUNCTIONS)
(PROPS (COMMENTHACKS MAKEFILE-ENVIRONMENT))
previous date%: "10-Dec-87 10:58:48" {DSK}<XAVIER>COMMENTHACKS.;1)
(* "
Copyright (c) 1987 by Unisys Corp.. All rights reserved.
")
(PRETTYCOMPRINT COMMENTHACKSCOMS)
(RPAQQ COMMENTHACKSCOMS ((FNS EDITDEF.FUNCTIONS FIXDEFUNEDITDATE MYEDITDATE? MYSUPERPRINT/COMMENT
MYSUPERPRINT/COMMENT2)
(P (MOVD 'MYEDITDATE? 'EDITDATE?)
(MOVD 'MYSUPERPRINT/COMMENT 'SUPERPRINT/COMMENT))
(PROP EDITDEF FUNCTIONS)
(PROP (MAKEFILE-ENVIRONMENT FILETYPE)
COMMENTHACKS)
(EDITHIST COMMENTHACKS)))
(DEFINEQ
(EDITDEF.FUNCTIONS
[LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 10-Dec-87 10:37 by DJVB")
(LET [(DEF (GETDEF NAME TYPE SOURCE '(EDIT NOCOPY]
(SETQ RETRY NIL)
(EDITE DEF EDITCOMS NAME TYPE [FUNCTION (LAMBDA (NAME DEF TYPE EXITFLG)
(MARKASCHANGED NAME TYPE 'CHANGED)
(FIXDEFUNEDITDATE DEF)
(PUTDEF NAME TYPE DEF]
OPTIONS) (* ; "AND SAY WE EDITED IT")
T])
(FIXDEFUNEDITDATE
[LAMBDA (EXPR) (* ; "Edited 10-Dec-87 10:42 by DJVB")
(* ;; "Inserts or replaces previous edit date in a (DEFUN f (args) (DECLARE --)... %"doc string%" EDITDATE body")
(AND INITIALS (LISTP EXPR)
(FMEMB (CAR EXPR)
'(CL:DEFUN DEFMACRO )
)
(LISTP (CDDR EXPR))
(PROG ((E (CDDDR EXPR)))
RETRY
(COND
((NLISTP E)
(RETURN))
((LISTP (CAR E))
(SELECTQ (CAAR E)
((DECLARE)
(SETQ E (CDR E))
(GO RETRY))
(BREAK1 (COND
((EQ (CAR (CADAR E))
'PROGN)
(SETQ E (CDR (CADAR E)))
(GO RETRY))))
(ADV-PROG
(* No easy way to mark cleanly the date of an advised function)
(RETURN))
NIL))
((STRINGP (CAR E)) (* ; "DOC STRING")
(SETQ E (CDR E))
(GO RETRY)))
(COND
((AND (LISTP (CDR E))
(EDITDATE? (CAR E)))
(/RPLACA E (EDITDATE (CAR E)
INITIALS)))
(T (/ATTACH (EDITDATE NIL INITIALS)
E)))
(RETURN EXPR])
(MYEDITDATE?
[LAMBDA (COMMENT) (* ; "Edited 10-Dec-87 13:50 by DJVB")
(AND *REPLACE-OLD-EDIT-DATES* (LISTP COMMENT)
(SUPERPRINTEQ (CAR COMMENT)
COMMENTFLG)
(LISTP (CDR COMMENT))
(LISTP (CDDR COMMENT))
(NULL (CDDDR COMMENT))
(STRINGP (CADDR COMMENT))
(LET ((C2 (CADR COMMENT)))
(AND (NOT (SUPERPRINTEQ C2 COMMENTFLG))
(OR (EQ C2 INITIALS)
(COND
[(LITATOM C2)
(COND
[(EQ C2 ';)
(AND (STRPOS "Edited " (CADDR COMMENT)
1 NIL T)
(GREATERP (CL:LENGTH (CADDR COMMENT))
(CONSTANT (CL:LENGTH "Edited 01-jan-86 00:00 by X"]
(T (NOT (for PC from 1 to (NCHARS C2)
always (EQ (NTHCHARCODE C2 PC)
(CHARCODE ;]
(T (AND (STRINGP C2)
(IGREATERP 12 (NCHARS C2])
(MYSUPERPRINT/COMMENT
[LAMBDA (L FILE) (* ; "Edited 11-Dec-87 13:32 by DJVB")
(COND
((AND **COMMENT**FLG (NOT FILEFLG)
(NOT MAKEMAP))
(AND (GREATERP (PLUS (DSPXPOSITION NIL FILE)
(STRINGWIDTH **COMMENT**FLG FILE))
(DSPRIGHTMARGIN NIL FILE))
(PRINENDLINE 0 FILE))
(PRIN1S **COMMENT**FLG NIL FILE))
(T (LET (COMMENT-LMARGIN COMMENT-RMARGIN RIGHTFLG FLUSH-LEFTP SEMIP BODY)
(DECLARE (SPECVARS RIGHTFLG))
[SETQ RIGHTFLG (NOT (if (SUPERPRINTEQ (CADR L)
COMMENTFLG)
elseif (SETQ SEMIP (SEMI-COLON-COMMENT-P L))
then (NEQ SEMIP 1)
else (GREATERP (LENGTH L)
10]
[COND
(RIGHTFLG (SETQ COMMENT-LMARGIN (OR COMMENTCOL (SUPERPRINT/COMMENT1 L RMARGIN FILE)
))
(SETQ COMMENT-RMARGIN RMARGIN))
((AND (EQ SEMIP 3)
(NOT MAKEMAP))
(SETQ COMMENT-LMARGIN 0)
(SETQ COMMENT-RMARGIN RMARGIN))
(T (SETQ COMMENT-LMARGIN (FIXR (TIMES RMARGIN 0.1)))
(SETQ COMMENT-RMARGIN (DIFFERENCE RMARGIN COMMENT-LMARGIN))
(CL:IF (EQ COMMENT-LMARGIN (DSPXPOSITION NIL FILE))
(SETQ RIGHTFLG T]
(CL:IF (GREATERP (DSPXPOSITION NIL FILE)
COMMENT-LMARGIN)
(PRINENDLINE COMMENT-LMARGIN FILE)
(DSPXPOSITION COMMENT-LMARGIN FILE))
(OR RIGHTFLG (PRINENDLINE COMMENT-LMARGIN FILE))
(SETFONT (PROG1 (SETFONT COMMENTFONT FILE)
(CL:IF (AND SEMIP (NOT MAKEMAP)
[STRINGP (SETQ BODY
(CAR (LISTP (CDR (LISTP (CDR L]
(NULL (CDDDR L))
(OR (IMAGESTREAMP FILE)
*PRINT-SEMICOLON-COMMENTS*))
(PRIN2-LONG-STRING BODY FILE NIL NIL COMMENT-LMARGIN
COMMENT-RMARGIN T SEMIP)
(MYSUPERPRINT/COMMENT2 L COMMENT-LMARGIN
(IQUOTIENT (PLUS COMMENT-LMARGIN COMMENT-RMARGIN)
2)
COMMENT-RMARGIN FILE)))
FILE)
(CL:IF (OR (AND SEMIP (NOT MAKEMAP))
(NOT RIGHTFLG))
(PRINENDLINE 0 FILE))
L])
(MYSUPERPRINT/COMMENT2
[LAMBDA (CMT COMMENT-LMARGIN COMMENT-MIDPOINT COMMENT-RMARGIN FILE SEMIN)
(* ; "Edited 11-Dec-87 13:31 by DJVB")
(* ;
"SEMIN USED IN RECURSIVE CALLS TO PASS DOWN SEMI LEVEL")
(if (EQ *PRINT-SEMICOLON-COMMENTS* 'ALL)
then
(* ;; "Print comment between given margins. Use 2 semis if (* * --) or (* --) over 10 long, otherwise use one semi.")
(LET*
((SEMI (OR SEMIN (if (OR (AND (SUPERPRINTEQ (CADR CMT)
COMMENTFLG)
(SETQ CMT (CDR CMT)))
(GREATERP (LENGTH CMT)
10))
then 2
else 1)))
(SEMIS (if (EQ SEMI 2)
then ";;"
else ";")))
(OR SEMIN (SETQ CMT (CDR CMT))) (* ; "IF TOP LEVEL, SKIP *")
(SETQ FILE (\GETSTREAM FILE 'OUTPUT))
(AND (EQ (DSPXPOSITION NIL FILE)
COMMENT-LMARGIN)
(PRINOPEN TAIL SEMIS FILE)) (* ;
"does PRIN3, but only do if still at left")
(for TAIL on CMT bind LASTITEM THISITEM finally (if TAIL
then (PRINDOTP TAIL FILE))
do (SETQ THISITEM (CAR TAIL))
[if (OR (EQ LASTITEM '-)
(AND (GEQ (DSPXPOSITION NIL FILE)
COMMENT-MIDPOINT)
(NOT (LISTP THISITEM))
(LITATOM LASTITEM)
(SELCHARQ (NTHCHARCODE LASTITEM -1)
((; %. -)
T)
NIL)))
then (PRINENDLINE COMMENT-LMARGIN FILE)
(PRINOPEN TAIL SEMIS FILE)
else (if [AND (NEQ CMT TAIL)
(OR (LISTP LASTITEM)
(NOT (MEMB THISITEM '(%. %, ; %:]
then (SUPERPRINT/SPACE FILE))
(OR (LISTP THISITEM)
(STRINGP THISITEM)
(if (GEQ (PLUS (DSPXPOSITION NIL FILE)
(STRINGWIDTH THISITEM (OR FILE *STANDARD-OUTPUT*)
T)
(STRINGWIDTH (if (CDR TAIL)
then " "
else ")")
(OR FILE *STANDARD-OUTPUT*)))
COMMENT-RMARGIN)
then (PRINENDLINE COMMENT-LMARGIN FILE)
(PRINOPEN TAIL SEMIS FILE]
(SETQ LASTITEM THISITEM)
(if (LISTP LASTITEM)
then (MYSUPERPRINT/COMMENT2 LASTITEM COMMENT-LMARGIN COMMENT-MIDPOINT
COMMENT-RMARGIN FILE SEMI)
elseif (STRINGP LASTITEM)
then (PRIN2-LONG-STRING LASTITEM FILE NIL TAIL COMMENT-LMARGIN COMMENT-RMARGIN T
SEMI)
else (PRIN2S LASTITEM TAIL FILE)))
(PRINSHUT TAIL NIL FILE) (* ; "IN CASE MAKING MAP")
(* ;
"AND FORCE NEWLINE IN MYSUPERPRINT/COMMENT")
(SETQ RIGHTFLG NIL))
else (* ; "Do it the old way as (* --)")
(SUPERPRINT/COMMENT2 CMT COMMENT-LMARGIN COMMENT-MIDPOINT COMMENT-RMARGIN FILE])
)
(MOVD 'MYEDITDATE? 'EDITDATE?)
(MOVD 'MYSUPERPRINT/COMMENT 'SUPERPRINT/COMMENT)
(PUTPROPS FUNCTIONS EDITDEF EDITDEF.FUNCTIONS)
(PUTPROPS COMMENTHACKS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
(PUTPROPS COMMENTHACKS FILETYPE :TCOMPL)
(DECLARE%: DONTCOPY
(ADDTOVAR EDITHISTALIST (COMMENTHACKS ("10-Dec-87 10:59:27" DJVB {DSK}<XAVIER>COMMENTHACKS.;1
(COMMENT2 EDITDATE? MYEDITDATE? MYSUPERPRINT/COMMENT
EDITDEF.FUNCTIONS FIXDEFUNEDITDATE))
("10-Dec-87 17:09:35" DJVB {DSK}<XAVIER>COMMENTHACKS.;3
(MYSUPERPRINT/COMMENT COMMENT2 MYSUPERPRINT/COMMENT2
MYEDITDATE?)
(STUFF TO GET EDITDATE INTO FUNCTIONS AND PRINT SEMICOLON
COMMENTS FOR EVERYTHING))
("11-Dec-87 12:49:30" DJVB {DSK}<XAVIER>COMMENTHACKS.;4 (
MYSUPERPRINT/COMMENT2
))
("11-Dec-87 12:52:55" DJVB {DSK}<XAVIER>COMMENTHACKS.;6 (
EDITDEF.FUNCTIONS
FIXDEFUNEDITDATE
)
(FIXED DETAILS))
("11-Dec-87 13:33:43" DJVB {DSK}<XAVIER>COMMENTHACKS.;7 (
MYSUPERPRINT/COMMENT2
MYSUPERPRINT/COMMENT
)
(FIXING DETAILS))))
)
(PUTPROPS COMMENTHACKS COPYRIGHT ("Unisys Corp." 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1135 12019 (EDITDEF.FUNCTIONS 1145 . 1784) (FIXDEFUNEDITDATE 1786 . 3426) (MYEDITDATE?
3428 . 4692) (MYSUPERPRINT/COMMENT 4694 . 7753) (MYSUPERPRINT/COMMENT2 7755 . 12017)))))
STOP
ÿ