-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathTEDIT-DEBUG
2454 lines (2181 loc) · 129 KB
/
TEDIT-DEBUG
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
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Mar-2025 11:07:01" {WMEDLEY}<internal>TEDIT-DEBUG.;138 129322
:EDIT-BY rmk
:CHANGES-TO (FNS TESTACTION)
(VARS TEDIT-DEBUGCOMS)
:PREVIOUS-DATE " 6-Mar-2025 11:29:26" {WMEDLEY}<internal>TEDIT-DEBUG.;136)
(PRETTYCOMPRINT TEDIT-DEBUGCOMS)
(RPAQQ TEDIT-DEBUGCOMS
[
(* ;; "This is an internal/ file containing a hodge-podge of functions for use in Tedit debugging. To start working on TEDIT, (LOAD 'TEDIT-DEBUG.LCOM) and then run (TEDIT--DEBUG). That will load TEDIT-EXPORTS.ALL and EXPORTS.ALL, load the fuller database if available, and analyze the functions on TEDITFILES. And leave you connected to {MEDLEYDIR}/library/tedit/.")
(* ;; "This has functions for accessing,showing, inspecting and manipulating a variety of internal Tedit data structures (textobj, piece, line, selection, thisline), and other random bits of code. It has grown as different issues have been addressed, at some point it should be cleaned up and documented.")
(* ;;
"This is stored in internal/ so that it remains compatible with the commits/branches/PRs/releases.")
(VARS (\TEDIT.THELPFLG T))
(COMS (* ;
"Get/set (default) object, stream, window, selection")
(FNS GTO GTS GTW GSEL)
(INITVARS (LASTTEXTSTREAM NIL)))
(FNS TESTACTION)
(COMS (* ; "Inspect")
(FNS IPC ILINES ISEL ITS IPANES ITL IHIST IPCTB IMB ICL IPL ICARET INSPECTPIECES))
(COMS (* ; "Show")
(FNS SP SL SSP SPF SLF SHOWLINE SLL STBYTES SSEL)
(FNS STL CLEARTHISLINE))
(COMS (FNS NTHPIECE NPIECES NTHPIECECHAR SELPIECE PIECENUM PCBYTES))
(COMS (FNS FILEBYTES TFILEBYTES))
(FNS TRELMOVE TSCROLL TSCROLL*)
(FNS TRY TEDITCLOSEW PARALASTWITHOUTEOL FIXPARALAST)
(FNS SPPRINT SPPRINT.CHAR SPPRINT.OBJ SHOWPIECEBYTES CHECKPLENGTHS SBT COPYPCHAIN)
(FNS POSLINE)
(FNS PRESPLIT)
(FNS ALLTL NTHCHARSLOT)
(* ; "THISLINE")
(FNS PLCHAIN PRINTLINE SL.GETLINES CHECKLINES COLLECTLINES NTHLINE HEIGHT LINEBOTS)
(FNS IPC.DECODEARGS)
(FNS SPF1)
(* ; "Page frames")
(FNS SLF.FATPLEN FILEPIECE)
(* ; "Show looks file")
(FNS SELTEDIT)
(* ; "New editor on an old selection")
(COMS (* ; "Bravo")
(FNS PPARA PRUN ADDLINEPOSITIONS SBR SBC))
(INITVARS (LASTTS NIL))
(VARS (OK.TO.MODIFY.FNS T))
(FNS OLDWI COMP DFR)
(FNS DFGV GDIRECTORIES)
(COMS (FNS TTEST LTEST THC)
(INITVARS (LASTTTESTFILE))
(VARS * TTESTREGIONS))
(COMS (FNS SHOWSAFE)
(INITVARS SAFESHOW SAFEHELP))
(FNS MYH)
(VARS VTDIR VTF TF)
(FNS DFVENUE VSEE)
(FNS PTT)
(* ; "Plain text")
(MACROS DEBUGOUTPUT)
(FNS TEDIT-DEBUG)
(FNS TRENAME)
(FILES (NOERROR)
VERSIONDEFS)
(* ; "Until this is release")
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA VSEE DFGV)
(NLAML DFVENUE DFR)
(LAMA])
(* ;;
"This is an internal/ file containing a hodge-podge of functions for use in Tedit debugging. To start working on TEDIT, (LOAD 'TEDIT-DEBUG.LCOM) and then run (TEDIT--DEBUG). That will load TEDIT-EXPORTS.ALL and EXPORTS.ALL, load the fuller database if available, and analyze the functions on TEDITFILES. And leave you connected to {MEDLEYDIR}/library/tedit/."
)
(* ;;
"This has functions for accessing,showing, inspecting and manipulating a variety of internal Tedit data structures (textobj, piece, line, selection, thisline), and other random bits of code. It has grown as different issues have been addressed, at some point it should be cleaned up and documented."
)
(* ;;
"This is stored in internal/ so that it remains compatible with the commits/branches/PRs/releases.")
(RPAQQ \TEDIT.THELPFLG T)
(* ; "Get/set (default) object, stream, window, selection")
(DEFINEQ
(GTO
[LAMBDA (ARG NOERROR) (* ; "Edited 9-Aug-2024 13:14 by rmk")
(LET ((TSTREAM (GTS ARG NOERROR)))
(CL:WHEN TSTREAM
(fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))])
(GTS
[LAMBDA (ARG NOERROR) (* ; "Edited 1-Feb-2025 08:25 by rmk")
(* ; "Edited 23-Nov-2024 11:38 by rmk")
(* ; "Edited 4-Oct-2024 22:13 by rmk")
(* ; "Edited 21-Sep-2024 21:51 by rmk")
(* ; "Edited 11-Aug-2024 21:53 by rmk")
(CL:UNLESS (AND (TEXTSTREAM LASTTEXTSTREAM T)
(OPENWP (\TEDIT.PRIMARYPANE LASTTEXTSTREAM)))
(SETQ LASTTEXTSTREAM NIL))
(LET* ((TWINDOWS (for W in (OPENWINDOWS) when (WINDOWPROP W 'TEDITCREATED)
unless (WINDOWPROP W 'TEDIT-DEBUG) collect W))
(TSTREAM (TEXTSTREAM (OR ARG (CL:IF (CDR TWINDOWS)
(WHICHW)
(CAR TWINDOWS)))
T)))
(if TSTREAM
then (if (EQ TSTREAM LASTTEXTSTREAM)
elseif (NULL LASTTEXTSTREAM)
then (SETQ LASTTEXTSTREAM TSTREAM)
elseif (AND (NOT (OR (type? TEXTOBJ ARG)
(STREAMP ARG)))
(EQ 'Y (ASKUSER NIL 'Y " Switch default textstream? ")))
then (SETQ LASTTEXTSTREAM TSTREAM))
TSTREAM
elseif (AND (NULL ARG)
LASTTEXTSTREAM)
elseif NOERROR
then NIL
else (TEXTSTREAM ARG])
(GTW
[LAMBDA (ARG) (* ; "Edited 5-Nov-2024 13:50 by rmk")
(\TEDIT.PRIMARYPANE (GTO ARG])
(GSEL
[LAMBDA (WHICH ARG) (* ; "Edited 25-Nov-2024 14:19 by rmk")
(* ; "Edited 11-Feb-2024 09:07 by rmk")
(* ; "Edited 23-May-2023 00:03 by rmk")
(TEXTSEL (GTO ARG])
)
(RPAQ? LASTTEXTSTREAM NIL)
(DEFINEQ
(TESTACTION
[LAMBDA (CHAR TSTREAM) (* ; "Edited 23-Mar-2025 11:06 by rmk")
(* ;; "If CHAR is bound to an action in TSTREAM's read table, execute it.")
(SETQ TSTREAM (GTS TSTREAM))
(\TEDIT.COMMAND.FUNCTION? TSTREAM (if (CHARCODEP CHAR)
then CHAR
elseif (CHARCODEP CHAR T)
elseif (CAR (TEDIT.GET.CHARBINDING CHAR TSTREAM))
then (SETQ CHAR (CAR (TEDIT.GET.CHARBINDING CHAR TSTREAM)))
(CL:IF (CHARCODEP CHAR)
CHAR
(CHARCODE.DECODE CHAR))
else (ERROR CHAR "is not a keybinding"])
)
(* ; "Inspect")
(DEFINEQ
(IPC
[LAMBDA (PC TOBJ) (* ; "Edited 3-Dec-2024 16:51 by rmk")
(* ; "Edited 4-Oct-2024 11:03 by rmk")
(* ; "Edited 29-Sep-2024 15:03 by rmk")
(* ; "Edited 22-Aug-2024 23:14 by rmk")
(* ; "Edited 25-Jul-2024 17:47 by rmk")
(* ;; "Inspects the piece specified by decoding PC and TOBJ")
(* ; "Edited 6-Nov-2023 08:03 by rmk")
(LET (PCWINDOW OBJWINDOW TAG (DECODED (IPC.DECODEARGS PC TOBJ)))
(SETQ PC (POP DECODED))
(if PC
then (SETQ TAG (POP DECODED))
(SETQ PCWINDOW (INSPECT PC NIL NIL TAG))
(CL:WHEN (POBJ PC)
(SETQ OBJWINDOW (INSPECT (POBJ PC)
NIL
(RELCREATEPOSITION (LIST PCWINDOW 'RIGHT -2)
(LIST PCWINDOW 'BOTTOM))
TAG))
(CLOSEWITH OBJWINDOW PCWINDOW)
(MOVEWITH OBJWINDOW PCWINDOW))
else (PRINTOUT T "No such piece"))
PC])
(ILINES
[LAMBDA (LINES TAG WHERE) (* ; "Edited 28-Jun-2024 15:22 by rmk")
(* ; "Edited 25-Jun-2024 11:59 by rmk")
(* ; "Edited 27-Apr-2024 13:48 by rmk")
(* ; "Edited 27-Nov-2023 12:52 by rmk")
(* ; "Edited 21-Oct-2023 10:22 by rmk")
(* ; "Edited 9-May-2023 15:45 by rmk")
(* ; "Edited 28-Mar-2023 22:02 by rmk")
(* ; "Edited 25-Mar-2023 15:26 by rmk")
(* ; "Edited 22-Feb-2023 11:08 by rmk")
(* ; "Edited 21-Feb-2023 00:11 by rmk")
(* ; "Edited 9-Oct-2022 08:36 by rmk")
(DECLARE (USEDFREE TEXTOBJ)) (* ; "Edited 17-Sep-2022 11:50 by rmk")
(if (type? SELECTION LINES)
then [LET (WINDOW)
(CL:WHEN (type? LINEDESCRIPTOR (CAR (fetch L1 of LINES)))
(SETQ WINDOW (ILINES (fetch L1 of LINES)
'L2)))
(CL:WHEN (type? LINEDESCRIPTOR (CAR (fetch LN of LINES)))
(if WINDOW
then (ATTACHWINDOW (ILINES (fetch LN of LINES)
'LN)
WINDOW
'RIGHT
'TOP)
else (ILINES (fetch LN of LINES)
'LN)))]
else [SETQ LINES (if (type? LINEDESCRIPTOR LINES)
then LINES
elseif (type? LINEDESCRIPTOR (CAR (LISTP LINES)))
then (CAR LINES)
else (PANEPREFIX (\TEDIT.PRIMARYPANE (GTO LINES]
(INSPECT/TOP/LEVEL/LIST (COLLECTLINES LINES)
WHERE TAG])
(ISEL
[LAMBDA (ARG TAG) (* ; "Edited 3-Oct-2024 14:51 by rmk")
(* ; "Edited 6-Sep-2024 10:36 by rmk")
(* ; "Edited 4-Jun-2023 13:02 by rmk")
(* ; "Edited 27-Apr-2023 10:29 by rmk")
(LET [(SEL (CL:IF (type? SELECTION ARG)
ARG
(TEXTSEL (GTO ARG)))]
(INSPECT SEL NIL NIL TAG)
SEL])
(ITS
[LAMBDA (TS NPIECES) (* ; "Edited 25-Nov-2024 18:27 by rmk")
(* ; "Edited 26-Nov-2023 20:46 by rmk")
(* ; "Edited 31-Oct-2023 19:44 by rmk")
(* ; "Edited 21-Oct-2023 17:04 by rmk")
(* ; "Edited 9-Oct-2022 13:01 by rmk")
(* ; "Edited 14-Sep-2022 08:33 by rmk")
(* ;; "Inspect the key components of a Text stream TS")
(SETQ TS (GTS TS))
(LET (TSW WS)
(SETQ TSW (INSPECT TS 'TEXTSTREAM (RELCREATEPOSITION 'TTY 5)))
(* ; "The text stream fields")
(push WS (INSPECT TS 'STREAM (RELCREATEPOSITION (LIST TSW 'RIGHT 2)
5))) (* ; "All stream fields")
(push WS (INSPECT (TEXTOBJ TS)
'TEXTOBJ
(RELCREATEPOSITION (LIST (CAR WS)
'RIGHT 2)
5)))
(push WS (INSPECT (GETTOBJ (TEXTOBJ TS)
PCTB)
'LIST
(RELCREATEPOSITION (LIST (CAR WS)
'RIGHT 2)
5)))
(CLOSEWITH WS TSW)
(MOVEWITH WS TSW))
(SP TS (OR NPIECES 10))
TS])
(IPANES
[LAMBDA (ARG TAG WHERE) (* ; "Edited 28-Jun-2024 21:21 by rmk")
(INSPECT/ALIST (for P inpanes (GTO ARG) collect (CONS P (PANEPROPS P)))
WHERE TAG])
(ITL
[LAMBDA (THISLINE) (* ; "Edited 29-Jul-2024 09:42 by rmk")
(* ;; "Inspect THISLINE")
(CL:UNLESS (type? THISLINE THISLINE)
(CL:WHEN (EQ THISLINE T)
(SETQ THISLINE NIL)
(SETQ LASTCS CHARSLOT))
(SETQ THISLINE (fetch (TEXTOBJ THISLINE) of (GTO THISLINE))))
(INSPECT THISLINE)
THISLINE])
(IHIST
[LAMBDA (LAST ARG) (* ; "Edited 8-Dec-2024 20:33 by rmk")
(* ; "Edited 21-Jun-2023 14:24 by rmk")
(* ; "Edited 1-Jun-2023 22:31 by rmk")
(* ; "Edited 31-May-2023 11:35 by rmk")
(* ; "Edited 4-May-2023 20:25 by rmk")
(LET* ((TEXTOBJ (GTO ARG))
(EVENTS (GETTOBJ TEXTOBJ TXTHISTORY))
(UNDONEEVENTS (GETTOBJ (GTO ARG)
TXTHISTORYUNDONE))
HISTW HISTUNDOW HISTUNDOWHERE)
(CL:WHEN EVENTS
[SETQ HISTW (if LAST
then (INSPECT (CAR EVENTS)
'LIST NIL 'HIST)
else (INSPECT EVENTS 'LIST NIL 'HIST])
(CL:WHEN UNDONEEVENTS
(CL:WHEN HISTW
[SETQ HISTUNDOWHERE (RELCREATEPOSITION (LIST HISTW 'RIGHT)
(LIST HISTW 'BOTTOM]
(* ;; "Make it wide so the undo events show up")
[SETQ HISTUNDOWHERE (CREATEW (CREATEREGION (fetch (POSITION XCOORD) of
HISTUNDOWHERE
)
(fetch (POSITION YCOORD) of HISTUNDOWHERE)
600
(TIMES (FONTPROP (DSPFONT DEFAULTFONT)
'HEIGHT)
(IPLUS 1 (LENGTH UNDONEEVENTS])
[SETQ HISTUNDOW (if LAST
then (INSPECT (CAR UNDONEEVENTS)
(AND (LIST (CAR UNDONEEVENTS))
'LIST)
HISTUNDOWHERE
'HISTUNDO)
else (INSPECT UNDONEEVENTS 'LIST HISTUNDOWHERE 'HISTUNDO]
(CL:WHEN HISTW
(CLOSEWITH HISTUNDOW HISTW)
(MOVEWITH HISTUNDOW HISTW)))
(LIST (LENGTH EVENTS)
(LENGTH UNDONEEVENTS])
(IPCTB
[LAMBDA (ARG) (* ; "Edited 31-Oct-2023 19:45 by rmk")
(* ; "Edited 4-May-2023 20:28 by rmk")
(INSPECT (FETCH (TEXTOBJ PCTB) of (GTO ARG))
'LIST])
(IMB
[LAMBDA (KEY ARG) (* ; "Edited 22-Aug-2024 16:34 by rmk")
(* ; "Edited 21-Aug-2024 10:00 by rmk")
(* ; "Edited 8-Aug-2024 09:08 by rmk")
(* ; "Edited 4-Aug-2024 09:05 by rmk")
(* ;; "Inspect the menu button for KEY")
(LET [(OBJ (MB.FIND KEY (GTO ARG)
'OBJECT]
(CL:IF OBJ (INSPECT OBJ NIL NIL KEY])
(ICL
[LAMBDA (PC ARG) (* ; "Edited 25-Nov-2024 17:01 by rmk")
(* ; "Edited 4-Oct-2024 13:33 by rmk")
(* ;; "Inspect the character looks of PC")
(* ; "Edited 11-Apr-2023 11:42 by rmk")
(LET ((DECODED (IPC.DECODEARGS PC ARG)))
(SETQ PC (POP DECODED))
(INSPECT (PCHARLOOKS PC)
NIL NIL (CONCAT PC " " (POP DECODED])
(IPL
[LAMBDA (PC ARG) (* ; "Edited 25-Nov-2024 17:01 by rmk")
(* ; "Edited 11-Apr-2023 11:42 by rmk")
(LET ((DECODED (IPC.DECODEARGS PC ARG)))
(SETQ PC (POP DECODED))
(INSPECT (PPARALOOKS PC)
NIL NIL (CONCAT PC " " (POP DECODED])
(ICARET
[LAMBDA (ARG) (* ; "Edited 27-Nov-2024 13:48 by rmk")
(* ; "Edited 4-Oct-2024 13:33 by rmk")
(* ; "Edited 11-Apr-2023 11:42 by rmk")
(INSPECT (PANECARET (GTW ARG])
(INSPECTPIECES
[LAMBDA (PIECE N TAG WHERE) (* ; "Edited 16-Mar-2024 10:07 by rmk")
(* ; "Edited 30-Dec-2023 14:47 by rmk")
(* ; "Edited 1-Dec-2023 21:34 by rmk")
(* ; "Edited 27-Nov-2023 12:51 by rmk")
(CL:UNLESS (type? PIECE PIECE)
[SETQ PIECE (if (FIXP PIECE)
then (NTHPIECE (GTO)
PIECE)
elseif (type? SELECTION PIECE)
then (SELPIECE PIECE)
else (\TEDIT.FIRSTPIECE (GTO PIECE])
(CL:UNLESS (FIXP N)
(SETQ WHERE TAG)
(SETQ TAG N)
(SETQ N 20))
(LET (W PIECES)
(SETQ PIECES (for PC inpieces PIECE as I from 1 to N collect PC))
(SETQ W (INSPECT/TOP/LEVEL/LIST PIECES))
(WINDOWPROP W 'TITLE PIECE)
PIECE])
)
(* ; "Show")
(DEFINEQ
(SP
[LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "Edited 6-Jan-2025 22:18 by rmk")
(* ; "Edited 16-Dec-2024 15:50 by rmk")
(* ; "Edited 30-Nov-2024 19:34 by rmk")
(* ; "Edited 9-Sep-2024 14:53 by rmk")
(* ; "Edited 11-Aug-2024 21:06 by rmk")
(* ; "Edited 15-Jun-2024 11:52 by rmk")
(* ; "Edited 21-May-2024 11:29 by rmk")
(* ; "Edited 17-Mar-2024 12:58 by rmk")
(* ; "Edited 11-Jan-2024 22:19 by rmk")
(* ; "Edited 3-Jan-2024 00:41 by rmk")
(* ; "Edited 21-Oct-2023 10:56 by rmk")
(* ;; "PC is the starting piece, NP is the number of pieces including it.")
(* ;; "OFILE=T or TEDIT means Tedit stream. NIL means primary output (usually T)")
(PROG ((TEXTOBJ (CL:IF (type? TEXTOBJ PC)
PC
(GTO TOBJ)))
WTYPE)
(if OFILE
then (CL:WHEN (MEMB OFILE '(T TEDIT))
(SETQ WTYPE 'SP)
(SETQ OFILE NIL))
elseif (AND NP (LITATOM NP))
then (SETQ WTYPE (CL:IF (EQ NP T)
'SP
NP))
(SETQ NP NIL))
(CL:WHEN (EQ 0 (TEXTLEN TEXTOBJ))
(PRINTOUT T "Document is empty" T)
(RETURN))
[if (type? PIECE PC)
elseif (NULL PC)
then [SETQ PC (\TEDIT.FIRSTPIECE (OR TEXTOBJ (GTO]
elseif [AND (FIXP PC)
(OR TEXTOBJ (AND TOBJ (SETQ TEXTOBJ (GTO]
then (SETQ PC (NTHPIECE TEXTOBJ PC))
elseif [OR (type? SELECTION PC)
(MEMB PC '(SEL T]
then (CL:UNLESS TEXTOBJ
(SETQ TEXTOBJ (TEXTOBJ PC)))
(SETQ PC (SELPIECE TEXTOBJ))
elseif (OR (EQ PC TEXTOBJ)
(SETQ TEXTOBJ (GTO PC T)))
then (SETQ PC (\TEDIT.FIRSTPIECE TEXTOBJ))
elseif (type? LINEDESCRIPTOR (CAR (MKLIST PC)))
then
(* ;; "Assume it's from the current TEXTOBJ")
(SETQ PC (\TEDIT.CHTOPC (GETLD (CAR (MKLIST PC))
LCHAR1)
(GTO TEXTOBJ]
(CL:UNLESS (SMALLP NP)
(SETQ NP (CL:IF NP
20
MAX.SMALLP)))
(DEBUGOUTPUT OFILE WTYPE (DSPFONT (OR FONT '(TERMINAL 8))
OFILE)
(for P PFILES inpieces PC as I from 1 to NP as PCNO
from (OR (PIECENUM PC TEXTOBJ)
1) do
(* ;; "Put the fileptrs back where they were.")
(CL:WHEN (AND (MEMB (PTYPE PC)
FILE.PTYPES)
(NOT (MEMB (PCONTENTS PC)
PFILES)))
(CL:UNLESS (GETSTREAM (PCONTENTS PC)
'INPUT T)
(\TEDIT.REOPEN.STREAM TEXTOBJ))
[RESETSAVE (GETFILEPTR (PCONTENTS PC))
`(PROGN (SETFILEPTR ,(PCONTENTS PC)
OLDVALUE])
(PRINTOUT OFILE .I3 PCNO "/")
(SPPRINT P OFILE TEXTOBJ NOCR))
(TERPRI OFILE))
(RETURN PC])
(SL
[LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE) (* ; "Edited 21-Jan-2025 15:39 by rmk")
(* ; "Edited 6-Jan-2025 22:58 by rmk")
(* ; "Edited 7-Dec-2024 16:34 by rmk")
(* ; "Edited 3-Dec-2024 10:29 by rmk")
(* ; "Edited 25-Nov-2024 21:42 by rmk")
(* ; "Edited 18-Nov-2024 21:28 by rmk")
(* ; "Edited 9-Nov-2024 23:22 by rmk")
(* ; "Edited 28-Oct-2024 22:25 by rmk")
(* ; "Edited 27-Oct-2024 18:38 by rmk")
(* ; "Edited 25-Oct-2024 22:25 by rmk")
(* ; "Edited 21-Oct-2024 23:08 by rmk")
(* ;; "Shows a selection of the lines backing the display in PANE")
(LET (LINES WTYPE PNO)
(if OFILE
then (CL:WHEN (MEMB OFILE '(T TEDIT))
(SETQ WTYPE 'SL)
(SETQ OFILE NIL))
elseif (MEMB LASTLINE '(T TEDIT))
then (SETQ WTYPE 'SL)
(SETQ LASTLINE NIL))
(CL:WHEN [AND (type? LINEDESCRIPTOR (CAR (LISTP FIRSTLINE)))
(NULL LASTLINE)
(OR (NULL (CDR FIRSTLINE))
(type? LINEDESCRIPTOR (CDR FIRSTLINE]
(SETQ LASTLINE (CDR FIRSTLINE)) (* ; "BITMAPLINES ?")
(SETQ FIRSTLINE (CAR FIRSTLINE)))
(SETQ LINES (SL.GETLINES FIRSTLINE LASTLINE PANE TOBJ))
(SETQ FIRSTLINE (pop LINES))
(SETQ LASTLINE (pop LINES))
(SETQ TOBJ (pop LINES))
(SETQ PANE (pop LINES))
(SETQ PNO (pop LINES))
(DEBUGOUTPUT OFILE WTYPE (PRINTOUT OFILE .FONT '(TERMINAL 8)
"Pane " PNO " = " PANE T)
(PRINTOUT OFILE .FONT '(TERMINAL 8)
15 "HT" -3 "BOT" 27 .FONT '(TERMINAL 8 BOLD)
"C1" 36 "CN" .FONT '(TERMINAL 8)
40 "LN/*=PARALAST" T)
(for L inlines FIRSTLINE do (SHOWLINE L OFILE TOBJ) repeatuntil (EQ L LASTLINE)
finally (CL:WHEN (EQ LASTLINE (PANEBOTTOMLINE PANE))
(SHOWLINE (PANESUFFIX PANE)
OFILE TOBJ)))
(TERPRI OFILE)
(CL:WHEN (EQ FIRSTLINE LASTLINE)
(printout OFILE (for L inlines (FGETLD LASTLINE NEXTLINE) sum 1)
" lines below LASTLINE" T T)))
FIRSTLINE])
(SSP
[LAMBDA (SELPIECES NP OFILE TEXTOBJ) (* ; "Edited 30-Jan-2025 11:25 by rmk")
(* ; "Edited 26-Nov-2024 20:54 by rmk")
(* ; "Edited 3-Mar-2024 12:58 by rmk")
(* ; "Edited 12-Feb-2024 12:33 by rmk")
(* ; "Edited 22-Nov-2023 20:23 by rmk")
(* ; "Edited 21-Oct-2023 10:52 by rmk")
(* ; "Edited 9-May-2023 13:50 by rmk")
(* ; "Edited 7-May-2023 20:47 by rmk")
(* ;; "Prints up to NP pieces from SELPIECES.")
(if (TEXTOBJ NP T)
then (SETQ TEXTOBJ (TEXTOBJ NP))
(SETQ NP NIL)
elseif (TEXTOBJ OFILE T)
then (SETQ TEXTOBJ (TEXTOBJ OFILE))
(SETQ OFILE NIL)
else (GTO TEXTOBJ))
(DEBUGOUTPUT OFILE (CL:UNLESS OFILE 'SSP)
(for PC inselpieces SELPIECES as I from 1 to (OR NP 50)
do (PRINTOUT OFILE .I3 I "/")
(SPPRINT PC OFILE TEXTOBJ)))
SELPIECES])
(SPF
[LAMBDA (ARG TITLE OFILE) (* ; "Edited 30-Aug-2024 21:25 by rmk")
(* ; "Edited 15-Aug-2024 22:39 by rmk")
(* ; "Edited 13-Aug-2024 10:45 by rmk")
(* ; "Edited 11-Jul-2024 10:34 by rmk")
(* ; "Edited 19-Jan-2024 22:32 by rmk")
(* ; "Edited 6-Nov-2023 21:24 by rmk")
(* ;;
"PAGEFRAMES can be one or more PAGEREGIONs. ARG can be a TEXTOBJ or one of the PAGEREGIONS.")
(LET (TEXTOBJ PAGEREGIONS)
(if (AND ARG (for PF inside ARG always (type? PAGEREGION PF)))
then (SETQ PAGEREGIONS ARG)
else (SETQ TEXTOBJ (GTO ARG))
(CL:WHEN (FGETTOBJ TEXTOBJ MENUFLG)
(SETQ TEXTOBJ (TEXTOBJ (\TEDIT.MAINW TEXTOBJ))))
(SETQ PAGEREGIONS (GETTOBJ TEXTOBJ TXTPAGEFRAMES)))
(SETQ TITLE (CONCAT "Page regions for " (OR TITLE TEXTOBJ PAGEREGIONS)))
(DEBUGOUTPUT OFILE 'SPF (PRINTOUT OFILE .FONT '(TERMINAL 8 BOLD)
TITLE .FONT '(TERMINAL 8)
T)
(for TYPE PF (FIRSTPF _ (TEDIT.GET.PAGEFORMAT PAGEREGIONS 'FIRST/DEFAULT))
in '(FIRST/DEFAULT LEFT RIGHT)
collect (SETQ PF (TEDIT.GET.PAGEFORMAT PAGEREGIONS TYPE))
(PRINTOUT OFILE T .FONT '(TERMINAL 8 BOLD)
(L-CASE TYPE T)
" region " PF .FONT '(TERMINAL 8))
(if (AND (EQ PF FIRSTPF)
(NEQ TYPE 'FIRST/DEFAULT))
then (PRINTOUT OFILE " defaults to first" T)
else (TERPRI OFILE)
(PRINTDEF (SPF1 PF)
NIL NIL NIL NIL OFILE))
(TERPRI OFILE)
PF])
(SLF
[LAMBDA (FORMATSTREAM OUTFILE TITLE SHOWPAGEFRAMES) (* ; "Edited 14-Dec-2024 12:38 by rmk")
(* ; "Edited 24-Nov-2024 22:28 by rmk")
(* ; "Edited 23-Nov-2024 13:21 by rmk")
(* ; "Edited 14-Jan-2024 13:14 by rmk")
(* ; "Edited 19-Dec-2023 10:20 by rmk")
(* ; "Edited 28-Aug-2023 21:58 by rmk")
(* ; "Edited 26-Aug-2023 20:07 by rmk")
(RESETLST
[if (GTS FORMATSTREAM T)
then (SETQ FORMATSTREAM (TXTFILE (GTS FORMATSTREAM)))
else (RESETSAVE (SETQ FORMATSTREAM (\TEDIT.OPENTEXTFILE FORMATSTREAM))
'(PROGN (CLOSEF? OLDVALUE]
[RESETSAVE (GETFILEPTR FORMATSTREAM)
'(PROGN (SETFILEPTR FORMATSTREAM OLDVALUE]
[SELECTQ OUTFILE
(NIL)
((T TEDIT)
[SETQ OUTFILE (OPENTEXTSTREAM NIL NIL NIL NIL '(APPEND QUIET FONT DEFAULTFONT])
(RESETSAVE (SETQ OUTFILE (OPENSTREAM OUTFILE 'OUTPUT 'NEW))
`(PROGN (CLOSEF? OUTFILE OLDVALUE)
(AND (EQ RESETSTATE 'ERROR)
(DELFILE OLDVALUE]
(PROG* ((TRAILER (\TEDIT.GET.TRAILER FORMATSTREAM))
(PCCOUNT (CADDDR TRAILER)))
(CL:UNLESS TRAILER
(PRINTOUT T FORMATSTREAM " is not a Tedit looks file" T)
(RETURN))
(for PCNO BYTELEN LTYPE LOOKSMAP PLOOKSMAP LASTCHARLOOKNO (PFPOS _ 0)
(CHNO _ 0)
(TEXTPCNO _ 0)
(START _ (CAR TRAILER))
(TYPETAB _ 13)
(FPOSTAB _ 28)
(BYTESTAB _ 38) from 1 to PCCOUNT
first (PRINTOUT OUTFILE "Starting FILEPTR = " START " " "PCCOUNT = " PCCOUNT T)
(SETFILEPTR FORMATSTREAM START)
do (SETQ BYTELEN (\DWIN FORMATSTREAM))
(SETQ LTYPE (\WIN FORMATSTREAM))
(if (EQ \PieceDescriptorPARA LTYPE)
then (TERPRI OUTFILE)
else (PRINTOUT OUTFILE PCNO "|" (IDIFFERENCE (GETFILEPTR FORMATSTREAM)
6)))
(SELECTC LTYPE
(\PieceDescriptorPARA
(LET ((PLOOKNO (\WIN FORMATSTREAM))
PLOOK)
(SETQ PLOOK (ELT PARAMAP PLOOKNO))
(PRINTOUT OUTFILE .TAB TYPETAB "Paragraph looks " PLOOKNO ": "
(SUBSTRING PLOOK (ADD1 (STRPOS ":" PLOOK 6))
-2)
T)))
(\PieceDescriptorLOOKS
(LET ((FLAGS (BIN FORMATSTREAM))
LOOKNO FAT CLOOK)
(SETQ FAT (EQ 2 (LOGAND FLAGS 2)))
(SETQ LOOKNO (\WIN FORMATSTREAM))
(SETQ CLOOK (ELT LOOKSMAP LOOKNO))
(SETQ LASTCHARLOOKNO LOOKNO)
(ADD TEXTPCNO 1)
(PRINTOUT OUTFILE .TAB TYPETAB "Char piece #" TEXTPCNO " " .I3
PFPOS "-" (CL:IF FAT
(SLF.FATPLEN FORMATSTREAM PFPOS BYTELEN)
BYTELEN)
(CL:IF FAT
" fat"
"")
.TAB BYTESTAB .I4 BYTELEN " bytes")
(CL:IF (EQ 1 (LOGAND FLAGS 1))
" New"
"")
(PRINTOUT OUTFILE " " "Looks " LOOKNO ": ")
(PRIN3 (CAR (\TEDIT.CHARLOOKS.DEFPRINT CLOOK NIL NIL T))
OUTFILE)
(TERPRI OUTFILE)
(ADD PFPOS BYTELEN)))
(\PieceDescriptorOBJECT
(ADD TEXTPCNO 1)
(PRINTOUT OUTFILE .TAB TYPETAB "Objt piece #" TEXTPCNO " " PFPOS "-1"
-1 .I4 BYTELEN " bytes")
(PRINTOUT OUTFILE " " (\ATMIN FORMATSTREAM)
" ")
(LET (CLOOK INDEX)
(SELECTQ (BIN FORMATSTREAM)
(0 (SETQ CLOOK (ELT LOOKSMAP LASTCHARLOOKNO))
(PRINTOUT OUTFILE "Previous looks " LASTCHARLOOKNO " "))
(1 (SETQ CLOOK (\TEDIT.GET.SINGLE.CHARLOOKS FORMATSTREAM))
(PRINTOUT OUTFILE "Inline looks "))
(SHOULDNT))
(PRIN3 (CAR (\TEDIT.CHARLOOKS.DEFPRINT CLOOK NIL NIL T))
OUTFILE)
(TERPRI OUTFILE))
(ADD PFPOS BYTELEN))
(\PieceDescriptorPAGEFRAME
(LET ((PFS (READ FORMATSTREAM)))
(PRINTOUT OUTFILE .TAB TYPETAB "Pageframes")
(if SHOWPAGEFRAMES
then (PRINTOUT OUTFILE .TAB (IPLUS TYPETAB 4)
.PPV PFS)
else (PRINTOUT OUTFILE "..." T))
(TERPRI OUTFILE)))
(\PieceDescriptorCHARLOOKSLIST
(PRINTOUT OUTFILE .TAB TYPETAB "Charlooks list")
(add PCNO -1) (* ; "Lists don't count in this format")
(LET ((CHARLOOKLIST (\TEDIT.GET.CHARLOOKS.LIST FORMATSTREAM)))
(SETQ LOOKSMAP (ARRAY (LENGTH CHARLOOKLIST)))
(for I from 1 as CSLOOKS IN CHARLOOKLIST
do (PRINTOUT OUTFILE .TAB (IPLUS TYPETAB 2)
.I2 I ": " (CL:IF (type? FONTCLASS
(fetch (CHARLOOKS CLFONT)
of CSLOOKS))
(fetch (FONTCLASS FONTCLASSNAME)
of (fetch (CHARLOOKS CLFONT)
of CSLOOKS))
CSLOOKS)
T)
(SETA LOOKSMAP I CSLOOKS))))
(\PieceDescriptorPARALOOKSLIST
(PRINTOUT OUTFILE .TAB TYPETAB "Paralooks list")
(add PCNO -1) (* ; "Lists don't count in this format")
(LET ((PARALOOKS (\TEDIT.GET.PARALOOKS.LIST FORMATSTREAM)))
(SETQ PARAMAP (ARRAY (LENGTH PARALOOKS)))
(for I from 1 as PLOOKS in PARALOOKS
do (PRINTOUT OUTFILE .TAB (IPLUS TYPETAB 2)
.I2 I ": " PLOOKS T)
(SETA PARAMAP I PLOOKS))
(TERPRI OUTFILE)))
"Unknown type"))
(if (TEXTSTREAMP OUTFILE)
then
(* ;;
"Don't return the text stream, let it be collected when the window closes")
[TEDIT OUTFILE 'Looks% File NIL
`(LEAVE TTY TITLE ,(OR TITLE (CONCAT "SLF for " (FULLNAME FORMATSTREAM
]
else (RETURN OUTFILE))))])
(SHOWLINE
[LAMBDA (LINE FILE TEXTOBJ) (* ; "Edited 20-Nov-2024 00:31 by rmk")
(* ; "Edited 17-Nov-2024 15:56 by rmk")
(* ; "Edited 9-Nov-2024 10:37 by rmk")
(* ; "Edited 1-Sep-2024 16:49 by rmk")
(* ; "Edited 10-May-2024 00:27 by rmk")
(* ; "Edited 2-Dec-2023 23:07 by rmk")
(* ; "Edited 29-Sep-2023 12:37 by rmk")
(* ; "Edited 26-Sep-2023 17:22 by rmk")
(* ; "Edited 15-Jul-2023 21:19 by rmk")
(* ; "Edited 2-Jul-2023 23:55 by rmk")
(LET ((LOC (LOC LINE)))
(PRINTOUT FILE .FONT '(TERMINAL 8)
"L"
(CAR LOC)
"/"
(CDR LOC)
": " 13 .I4 (GETLD LINE LHEIGHT)
" " %# (CL:IF (GETLD LINE YBOT)
(PRINTOUT NIL .I5 (GETLD LINE YBOT))
(PRINTOUT T "---"))
" " .FONT '(TERMINAL 8 BOLD)
.I5
(GETLD LINE LCHAR1)
" -> " .I5 (GETLD LINE LCHARLAST)
.FONT
'(TERMINAL 8)
" " .I3 (GETLD LINE LNCH)
(CL:IF (GETLD LINE LSTLN)
"*"
" ")
.FONT
'(TERMINAL 6)
" ")
(if (GETLD LINE LDUMMY)
then (PRINTOUT FILE -8 (CL:IF (GETLD LINE LDUMMY)
"l"
"")
"dummy" T)
else (for CNO C LASTC (TSTREAM _ (TEXTSTREAM TEXTOBJ)) from (GETLD LINE LCHAR1)
to (GETLD LINE LCHARLAST) first (SETFILEPTR TSTREAM (SUB1 (GETLD LINE LCHAR1)))
(PRINTOUT FILE " %"") until (EOFP TSTREAM)
do (SETQ C (BIN TSTREAM)) (* ;
"This may read LF if that's what's on the file")
(if (SMALLP C)
then (SETQ LASTC C)
(SELCHARQ C
(TAB (PRIN3 "[TAB]" FILE))
((EOL CR)
(PRIN3 "[EOL]" FILE))
(LF (PRIN3 "[LF]" FILE))
(FORM (PRIN3 "[FORM]" FILE))
(meta,EOL (PRIN3 "[MLB]" FILE))
(PRINTCCODE C FILE))
elseif (IMAGEOBJP C)
then (printout FILE " " C " ")) finally (PRIN3 "%"" FILE)
(TERPRI FILE)
(CL:WHEN (GETLD LINE FORCED-END)
(TERPRI FILE])
(SLL
[LAMBDA (LINELIST FILE TEXTOBJ) (* ; "Edited 2-Jul-2023 23:48 by rmk")
(* ;; "Show a list of lines.")
(SETQ TEXTOBJ (GTO TEXTOBJ))
(RESETLST
[RESETSAVE (DSPFONT '(TERMINAL 8)
FILE)
'(PROGN (DSPFONT OLDVALUE FILE]
(for L inside LINELIST do (if (LISTP L)
then (PRINTOUT FILE T "SUBLIST:" T)
(SLL L FILE TEXTOBJ)
elseif L
then (SHOWLINE L FILE TEXTOBJ)
else (PRINTOUT FILE "(NIL LINE)" T))))])
(STBYTES
[LAMBDA (FILE OUTFILE) (* ; "Edited 12-Dec-2024 16:44 by rmk")
(* ;; "Shows the bytes that ought to make up the trailer for FILE as a Tedit formatted file.")
(SETQ FILE (FINDFILE-WITH-EXTENSIONS FILE NIL *TEDIT-EXTENSIONS*))
(CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
(LET (VERSION)
(SETFILEPTR STREAM (IDIFFERENCE (GETEOFPTR STREAM)
8))
(PRINTOUT OUTFILE "Piece start: " (BIN STREAM)
" "
(BIN STREAM)
" "
(BIN STREAM)
" "
(BIN STREAM)
" = ")
(SETFILEPTR STREAM (IDIFFERENCE (GETEOFPTR STREAM)
8))
(PRINTOUT OUTFILE (\DWIN STREAM)
T)
(PRINTOUT OUTFILE "Piece count: " (BIN STREAM)
" "
(BIN STREAM)
" = ")
(SETFILEPTR STREAM (IDIFFERENCE (GETEOFPTR STREAM)
4))
(PRINTOUT OUTFILE (\WIN STREAM)
T)
(PRINTOUT OUTFILE "Version: " (BIN STREAM)
" "
(BIN STREAM)
" = ")
(SETFILEPTR STREAM (IDIFFERENCE (GETEOFPTR STREAM)
2))
(SETQ VERSION (\SMALLPIN STREAM))
(PRINTOUT OUTFILE VERSION " (" (IDIFFERENCE VERSION 31415)
")" T])
(SSEL
[LAMBDA (SEL TEXTOBJ OFILE) (* ; "Edited 3-Feb-2025 23:05 by rmk")
(SETQ TEXTOBJ (GTO TEXTOBJ))
(CL:UNLESS SEL
(SETQ SEL (TEXTSEL TEXTOBJ)))
(for I from (GETSEL SEL CH#) to (GETSEL SEL CHLAST) do (PRINTOUT OFILE (TEDIT.NTHCHAR TEXTOBJ I))
)
(TERPRI OFILE])
)
(DEFINEQ
(STL
[LAMBDA (THISLINE LASTCS LCHAR1 OFILE) (* ; "Edited 22-Aug-2024 23:51 by rmk")
(* ; "Edited 4-Aug-2024 12:08 by rmk")
(* ; "Edited 31-Jul-2024 19:55 by rmk")
(* ; "Edited 29-Jul-2024 09:20 by rmk")
(* ; "Edited 1-Feb-2024 17:00 by rmk")
(* ; "Edited 25-Nov-2023 10:50 by rmk")
(* ; "Edited 23-Nov-2023 11:41 by rmk")
(* ; "Edited 23-Mar-2023 23:00 by rmk")
(* ;; "Debugging tool while \FORMATLINE is creating THISLINE, or when it's done. During creation the NEXTAVAILABLECHARSLOT is at the very end, so bad slots are visible. When complete, they shouldn't appear.")
(* ;; "If OFILE isn't given, this goes to a textstream")
(DECLARE (USEDFREE PREVSP CHARSLOT))
(CL:UNLESS (type? THISLINE THISLINE)
(CL:WHEN (EQ THISLINE T)
(SETQ THISLINE NIL)
(SETQ LASTCS CHARSLOT))
(SETQ THISLINE (fetch (TEXTOBJ THISLINE) of (GTO THISLINE))))
(\DTEST THISLINE 'THISLINE)
(DEBUGOUTPUT OFILE (CL:IF OFILE
NIL
'STL)
(for CSLOT EXPANDSPACES CHNO TX LENGTH CHAR CHARW (SPACEFACTOR _ (FETCH TLSPACEFACTOR
OF THISLINE))
(FIRSTSPACESLOT _ (fetch TLFIRSTSPACE of THISLINE))
(LINE _ (fetch (THISLINE DESC) of THISLINE))
(NSPACES _ 0)
(NCHARS _ 0)
(SPACETOTAL _ 0)
(PSP _ (AND (BOUNDP 'PREVSP)
(NEQ PREVSP (GETATOMVAL 'PREVSP))
PREVSP)) incharslots THISLINE as NSLOTS from 0
first (if (NULL LINE)
then (printout OFILE THISLINE ":" T 5
"No line parameters, start at CHNO = 1 LX1 = 0" T)
(SETQ CHNO 1)
(SETQ TX 0)
elseif (type? LINEDESCRIPTOR LINE)
then (SETQ CHNO (GETLD LINE LCHAR1))
(SETQ TX (GETLD LINE LX1))
(printout OFILE THISLINE " for " LINE ":" T 5 "Start at CHNO = " CHNO
" LX1 = " TX ", LXLIM = " (GETLD LINE LXLIM)
T))
(CL:WHEN LCHAR1
(SETQ CHNO (OR LCHAR1 1)))
(SETQ LENGTH TX)
(printout OFILE 29 "XLIM" T) eachtime (SETQ CHAR (CHAR CSLOT))
(SETQ CHARW (CHARW CSLOT))
(CL:UNLESS (CHARSLOTP CSLOT THISLINE)
(HELP "THISLINE RUNS OFF THE EDGE"
THISLINE))
repeatuntil [OR (EQ CSLOT (OR LASTCS (LASTCHARSLOT THISLINE]
do (printout OFILE .I4 NSLOTS)
[if (IMAGEOBJP CHAR)
then (add NCHARS 1)
(printout OFILE " " .I5 CHNO ": ")
(add TX CHARW)
(printout OFILE "Imobj" .FR 28 CHARW " " .I4 TX 35 CSLOT " " CHAR " ")
(SPPRINT.OBJ CHAR OFILE)
(add LENGTH CHARW)
(ADD CHNO 1)
elseif (SMALLP CHAR)
then (add NCHARS 1)
(printout OFILE " " .I5 CHNO ": ")
(printout OFILE .I3 CHAR " "
(SELCHARQ CHAR
((EOL CR LF)
(add TX CHARW)
(add LENGTH CHARW)
"EOL")
(FORM "FORM")
(SPACE (CL:WHEN (EQ CSLOT FIRSTSPACESLOT)
(SETQ EXPANDSPACES T))
(if EXPANDSPACES
then (add LENGTH (SCALEUP SPACEFACTOR CHARW))
(add TX (SCALEUP SPACEFACTOR CHARW))
else (add LENGTH CHARW)
(add TX CHARW))
(ADD NSPACES 1)
" ")
(TAB (add LENGTH CHARW)
(add TX CHARW)
"TAB")
(Meta,TAB (add LENGTH CHARW)
(add TX CHARW)
"MTAB")
(PROGN (add LENGTH CHARW)
(add TX CHARW)
(CHARACTER CHAR)))
.FR 28 CHARW " " .I4 TX 35 CSLOT)
(ADD CHNO 1)
elseif [AND [OR (CHARSLOTP CHAR THISLINE)
(AND (NULL CHAR)
(NOT (TYPE? CHARLOOKS CHARW]
(OR (EQ CSLOT PSP)
(find CS incharslots (NEXTCHARSLOT CSLOT)
while (CHARSLOTP CS THISLINE) suchthat (EQ CSLOT CHAR]
then (* ; "Presumably a PREVSP")
(ADD NSPACES 1)
(printout OFILE " " .I5 CHNO ":")
(ADD LENGTH CHARW)
(ADD TX CHARW)
(PRINTOUT OFILE " " (OR CHAR "[ENDSP]")
.FR 28 CHARW " " .I4 TX 35 CSLOT)
(ADD CHNO 1)
elseif (SMALLP CHARW)
then (if (EQ CSLOT FIRSTSPACESLOT)
then (PRINTOUT OFILE "First space")
else (PRINTOUT OFILE .FR 11 "Invis" .FR 38 CHARW)
(add CHNO CHARW))
elseif (type? CHARLOOKS CHARW)
then (printout OFILE 7 CHARW 35 CSLOT)
else (printout OFILE " BAD CHARSLOT " 28 CSLOT " CHAR = " CHAR " CHARW = " CHARW T
)
(TERPRI OFILE)
(GO $$OUT)
(AND NIL (CL:UNLESS (EQ 'Y (ASKUSER NIL NIL "Bad charslot, continue? "))
(TERPRI OFILE)
(GO $$OUT))]
(TERPRI OFILE)
finally (printout OFILE NSLOTS " slots" -2 NCHARS " characters" -2 NSPACES " spaces" -2
"next avail = " (fetch (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE)