-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathTEDIT-PF-SEE
218 lines (186 loc) · 11.6 KB
/
TEDIT-PF-SEE
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
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "14-Apr-2025 22:00:54" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;141 11757
:EDIT-BY rmk
:CHANGES-TO (FNS PF-TEDIT PF-TEDIT-FROM-TEXT)
:PREVIOUS-DATE " 7-Apr-2025 23:03:54" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;140)
(PRETTYCOMPRINT TEDIT-PF-SEECOMS)
(RPAQQ TEDIT-PF-SEECOMS
[(FNS PF-TEDIT PF-TEDIT-FROM-TEXT)
(COMMANDS ts tf)
(FILES (SYSLOAD)
REGIONMANAGER VERSIONDEFS)
(ALISTS (TEDIT.CHARACTIONS TEDIT-PF)
(TEDIT.CHARBINDINGS TEDIT-PF))
(P (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
(MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION))
(TEDIT.INSTALL.CHARBINDINGS))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(DEFINEQ
(PF-TEDIT
[LAMBDA (FN IFILES VERSION REPRINT) (* ; "Edited 14-Apr-2025 22:00 by rmk")
(* ; "Edited 26-Mar-2025 10:08 by rmk")
(* ; "Edited 18-Feb-2025 23:39 by rmk")
(* ; "Edited 6-Dec-2024 19:15 by rmk")
(* ; "Edited 27-Aug-2024 13:03 by rmk")
(* ; "Edited 27-Mar-2024 23:45 by rmk")
(* ; "Edited 25-Dec-2023 12:24 by rmk")
(* ; "Edited 5-Dec-2023 23:50 by rmk")
(* ; "Edited 12-Oct-2023 00:19 by rmk")
(* ; "Edited 14-Sep-2023 22:33 by rmk")
(* ; "Edited 14-Jul-2023 00:14 by rmk")
(* ; "Edited 5-May-2022 23:11 by rmk")
(* ; "Edited 12-Jan-2022 13:15 by rmk")
(* ; "Edited 30-Dec-2021 23:17 by rmk")
(* ;; "PF* to a read-only TEDIT window. First argument is the function name, second if given is the input file.")
(* ;; "This uses PFCOPYBYTES so we see what it looks like on the file. But some functions were not prettyprinted, so they appear as useless garbage.")
(* ;; "In that case, calling again with REPRINT=T will read and reprint. And, invoking tf again with no arguments at all will also reprint the last function in the same window")
(SETQ IFILES (MKLIST IFILES))
(CL:WHEN (LISTP FN)
(SETQ FN (CAR FN)))
(SELECTQ FN
((t T NIL)
(SETQ REPRINT T)
(SETQ FN LASTWORD))
(if (VERSIONP FN)
then (SETQ IFILES (CONS FN))
(SETQ FN LASTWORD)
else (SETQ LASTWORD FN)))
(CL:UNLESS FN (ERROR "No function to print"))
(CL:WHEN (AND (VERSIONP IFILES)
(NULL VERSION))
(SETQ VERSION IFILES)
(SETQ IFILES NIL))
(CL:WHEN (INTERSECTION '(T t)
IFILES)
(SETQ REPRINT T)
[SETQ IFILES (LDIFFERENCE IFILES '(t T])
(CL:UNLESS IFILES
(SETQ IFILES (WHEREIS FN '(FNS FUNCTIONS)
T)))
(IF IFILES
THEN (* ; "skip compiled files")
(* ;; "Since we are creating readonly Tedits, try to keep the TTY where it is.")
(FOR IFILE LOC TSTREAM ENV EXPR TFPROP WINDOW INSIDE IFILES
EACHTIME (CL:IF (VERSIONP IFILE)
(SETQ IFILE (FINDFILEVERSION (CAR (WHEREIS FN NIL T))
IFILE))) UNLESS (MEMB (FILENAMEFIELD IFILE 'EXTENSION)
*COMPILED-EXTENSIONS*)
DO
(SETQ LOC (FINDFNDEF FN IFILE))
(IF (LISTP LOC)
THEN (SETQ TFPROP (LIST FN (CAR LOC)))
[SETQ WINDOW (FIND W IN (OPENWINDOWS)
SUCHTHAT (AND (EQUAL TFPROP (WINDOWPROP W 'TF))
(fetch (TEXTWINDOW WTEXTSTREAM) of W]
(IF (AND WINDOW (NOT REPRINT))
THEN
(* ;;
"If already an open PF window on this function in this file, just raise it to the top")
(TOTOPW WINDOW)
(RETURN)
ELSE (CL:WITH-OPEN-FILE
(ISTREAM (POP LOC)
:DIRECTION :INPUT)
(SETQ ENV (LISPSOURCEFILEP ISTREAM))
(SETFILEINFO ISTREAM 'FORMAT ENV)
[SETQ TSTREAM (OPENTEXTSTREAM
NIL NIL `(PARABREAKCHARS NIL OPENWIDTH
,(TIMES TEDIT.SOURCE.LINELENGTH
(CHARWIDTH (CHARCODE SPACE)
DEFAULTFONT]
(DSPFONT DEFAULTFONT TSTREAM)
(PRINTOUT TSTREAM 5 "[From " (FULLNAME ISTREAM)
"]" T)
(PRINT-READER-ENVIRONMENT ENV TSTREAM)
(IF REPRINT
THEN (SETFILEPTR ISTREAM (POP LOC))
(SETQ EXPR (WITH-READER-ENVIRONMENT ENV (READ ISTREAM)))
(WITH-READER-ENVIRONMENT ENV
(IF (EQ FN (CAR EXPR))
THEN (DSPFONT BOLDFONT TSTREAM)
(PRINT FN TSTREAM)
(DSPFONT DEFAULTFONT TSTREAM)
(SETQ EXPR (CADR EXPR))
(PRINTDEF EXPR 3 T NIL NIL TSTREAM)
ELSEIF (EQ FN (CADR EXPR))
THEN
(* ;;
"Presumably a DEFUN. Print the CAR, boldface the cadr")
(PRINTOUT TSTREAM "(" .P2 (CAR EXPR)
" " .FONT BOLDFONT .P2 (CADR EXPR)
.FONT DEFAULTFONT " " .P2 (CADDR EXPR)
T 3)
(PRINTDEF (CDDDR EXPR)
3 T T NIL TSTREAM)
(PRIN3 ")" TSTREAM)
ELSE (PRINTDEF EXPR 3 NIL NIL NIL TSTREAM)))
ELSE (PFI.MAYBE.PP.DEFINITION ISTREAM TSTREAM (POP LOC)
(POP LOC)))
(TERPRI TSTREAM)
[TEDIT TSTREAM (OR WINDOW 'TF)
NIL
`(READONLY T LEAVETTY T TITLE ,(CONCAT FN " from " (FULLNAME
ISTREAM))
ITEM-NAME
,FN BOUNDTABLE ,(TEDIT.ATOMBOUND.READTABLE *READTABLE*]
(* ;; "The windowprop allows for reprinting as a window action, or reprinting from a command that can find and reuse the previous (presumably unprettied) window.")
(WINDOWPROP (WFROMDS TSTREAM)
'TF TFPROP)))
ELSEIF (EQ LOC 'FILE.NOT.FOUND)
THEN (printout T "file " IFILE " not found." T)
ELSE (printout T FN " not found on " LOC "." T)))
(SETQ *LAST-DF* FN)
ELSE (PRINTOUT T FN " has no function definition" T])
(PF-TEDIT-FROM-TEXT
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 14-Apr-2025 21:59 by rmk")
(* ; "Edited 7-Apr-2025 23:03 by rmk")
(* ; "Edited 5-Dec-2024 22:20 by rmk")
(* ; "Edited 26-Aug-2024 23:13 by rmk")
(* ;; "The function key for the meta,T and meta,t keys. This shows in a separate Tedit window the definition in TSTREAM of the function named by the selection SEL. If this TEDIT is open on a source file that contains the selected function, that definition is used. Otherwise, the first file that WHEREIS returns.")
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
(CL:UNLESS SEL
(SETQ SEL (TEDIT.GETSEL TSTREAM)))
(LET ([THISFILE (OR (TEXTPROP TSTREAM 'FILENAME)
(AND (\TEDIT.PRIMARYPANE TSTREAM)
(CADR (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM TSTREAM)
'TF]
(FN (MKATOM (TEDIT.SEL.AS.STRING TSTREAM SEL)))
ALLFILES)
(if (EQ 0 (NCHARS FN))
then (TEDIT.PROMPTPRINT TSTREAM "Please select a function to display" T)
elseif (SETQ ALLFILES (WHEREIS FN '(FNS FUNCTIONS)
T))
then (PF-TEDIT FN (CAR (OR (MEMB (FILENAMEFIELD THISFILE)
ALLFILES)
ALLFILES)))
else (TEDIT.PROMPTPRINT TSTREAM (CONCAT FN " not found")
T])
)
(DEFCOMMAND ts (FILE VERSION WINDOW FORMAT) (CL:WHEN (WINDOWP VERSION)
(SETQ WINDOW VERSION)
(SETQ VERSION -1))
(CL:UNLESS VERSION (SETQ VERSION -1))
(TEDIT-SEE (FINDFILEVERSION (OR (FINDFILE-WITH-EXTENSIONS FILE NIL
'(NIL TEDIT TED TXT TEXT TEX))
(ERROR "FILE NOT FOUND" FILE))
VERSION)
(OR WINDOW 'SEE)
FORMAT))
(DEFCOMMAND tf (FN FILE VERSION) (PF-TEDIT FN FILE VERSION))
(FILESLOAD (SYSLOAD)
REGIONMANAGER VERSIONDEFS)
(ADDTOVAR TEDIT.CHARACTIONS (TEDIT-PF PF-TEDIT-FROM-TEXT))
(ADDTOVAR TEDIT.CHARBINDINGS (TEDIT-PF "Meta,t" "Meta,T"))
(MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
(MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION))
(TEDIT.INSTALL.CHARBINDINGS)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1017 10695 (PF-TEDIT 1027 . 8961) (PF-TEDIT-FROM-TEXT 8963 . 10693)))))
STOP