Skip to content

Commit 2dcfac5

Browse files
authored
Rmk12: Lispusers packages of general utility, but especially for git compare (#634)
* TEXTOFD: Property OBJECTBYTE returned instead of image objects This allows COMPARETEXT to work on TEDIT files * ATBL: Default reader environment uses *DEFAULT-EXTERNALFORMAT* instead of :XCCS constant * CMLEXEC: Fix FILETYPE property It had CL:COMPILE-FILE, but the directory had LCOMs. Changed to :FAKE-COMPILE-FILE. * FILEIO: single place for EOL specification Now only in SETFILEINFO, not separately in \DO.PARAMS.AT.OPEN * WINDOWOBJ: COPYINSERT now uniformly allows lists of objects It was incomplete. * COMPARETEXT: Now works for TEDIT files * EXAMINEDEFS: side-by-side attached SEDIT windows for comparing alternative definitions * OBJECTWINDOW: container for arbitrary image objects
1 parent dcd83c3 commit 2dcfac5

File tree

18 files changed

+2681
-996
lines changed

18 files changed

+2681
-996
lines changed

library/TEXTOFD

Lines changed: 382 additions & 328 deletions
Large diffs are not rendered by default.

library/TEXTOFD.LCOM

318 Bytes
Binary file not shown.

lispusers/COMPARETEXT.LCOM

111 Bytes
Binary file not shown.

lispusers/EXAMINEDEFS

Lines changed: 120 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,120 @@
1+
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
2+
3+
(FILECREATED "20-Dec-2021 11:06:33" 
4+
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;7 6367
5+
6+
:CHANGES-TO (FNS EXAMINEDEFS)
7+
8+
:PREVIOUS-DATE "19-Dec-2021 22:45:48"
9+
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;5)
10+
11+
12+
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
13+
14+
(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEDEFS-REGION)
15+
(INITVARS (EXAMINEDEFS-PROCESS-LIST))))
16+
(DEFINEQ
17+
18+
(EXAMINEDEFS
19+
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 20-Dec-2021 11:06 by rmk")
20+
21+
(* ;; "This provides for side-by-side examination of separate but presumably related expressions. The (LISTP) expressions can be provided directly as SOURCE1 and SOURCE2 or, if NAME is given the copies of the definitions of NAME as TYPE on the two sources are examined.")
22+
23+
(* ;; "")
24+
25+
(* ;; "Examination is in side-by-side attached SEDIT windows if SEDIT is the EDITMODE. You can use SEDIT operations to zoom in on the location of any changes, deleting common stuff for example. But you are always working on a copy, so that changes are safe and ephemeral. This is an examination, not an edit.")
26+
27+
(CL:UNLESS NAME
28+
(CL:UNLESS (LISTP SOURCE1)
29+
(ERROR SOURCE1 " cannot be examined"))
30+
(CL:UNLESS (LISTP SOURCE2)
31+
(ERROR SOURCE2 " cannot be examined")))
32+
33+
(* ;; "TITLE1 and TITLE2 are optional strings that will be used to construct the titles of the SEDIT windows. We would like to know where GETDEF got the definition so we can use that, but there isn't an interface that provides that information (extended WHEREIS?)")
34+
35+
(LET (DEF1 DEF2)
36+
(SETQ DEF1 (IF (LISTP SOURCE1)
37+
THEN
38+
(* ;; "Copy to simulate READONLY")
39+
40+
(SETQ DEF1 (COPY SOURCE1))
41+
ELSEIF (GETDEF NAME TYPE SOURCE1)
42+
ELSE (ERROR NAME " not found on " SOURCE1)))
43+
(SETQ DEF2 (IF (LISTP SOURCE2)
44+
THEN (COPY SOURCE2)
45+
ELSEIF (GETDEF NAME TYPE SOURCE2)
46+
ELSE (ERROR NAME " not found on " SOURCE2)))
47+
(CL:UNLESS TITLE1
48+
(SETQ TITLE1 (OR SOURCE1 "File 1")))
49+
(CL:UNLESS TITLE2
50+
(SETQ TITLE2 (OR SOURCE2 "File 2")))
51+
(SELECTQ (EDITMODE)
52+
(SEDIT:SEDIT
53+
(* ;;
54+
 "A kludge to eliminate dangling SEDIT processes from previous examinations")
55+
56+
[SETQ EXAMINEDEFS-PROCESS-LIST
57+
(FOR PAIR IN EXAMINEDEFS-PROCESS-LIST
58+
COLLECT (IF (OPENWP (CAR PAIR))
59+
THEN PAIR
60+
ELSE (DEL.PROCESS (CDR PAIR))
61+
(GO $$ITERATE]
62+
63+
(* ;; "Set it up for new side-by-side regions that are forgotten when the window is closed. Their shape is usually not that useful for regular edits.")
64+
65+
(* ;;
66+
 "Crude suggestions for height, width, position. Suggest shorter window for smaller structures")
67+
68+
(CL:UNLESS (REGIONP REGION)
69+
(SETQ REGION (GETREGION)))
70+
(LET (W1 W2 HALFWIDTH)
71+
(SETQ HALFWIDTH (IQUOTIENT (FETCH (REGION WIDTH) OF REGION)
72+
2))
73+
[SETQ W1
74+
(SEDIT:GET-WINDOW (SEDIT:SEDIT DEF1
75+
`(:NAME ,(CONCAT NAME " from " TITLE1)
76+
:REGION
77+
,(CREATE REGION
78+
USING REGION WIDTH _ HALFWIDTH)
79+
:DONT-KEEP-WINDOW-REGION T]
80+
[SETQ W2
81+
(SEDIT:GET-WINDOW
82+
(SEDIT:SEDIT DEF2
83+
`(:NAME ,(CONCAT NAME " from " TITLE2)
84+
:REGION
85+
,(CREATE REGION USING REGION LEFT _
86+
(IPLUS (FETCH (REGION LEFT)
87+
OF REGION)
88+
HALFWIDTH)
89+
WIDTH _ HALFWIDTH)
90+
:DONT-KEEP-WINDOW-REGION T]
91+
92+
(* ;;
93+
 "So we can kill the processes on the next call, if they still exist after the windows are closed.")
94+
95+
[PUSH EXAMINEDEFS-PROCESS-LIST (CONS W1 (WINDOWPROP W1 'PROCESS))
96+
(CONS W2 (WINDOWPROP W2 'PROCESS]
97+
(ATTACHWINDOW W2 W1 'RIGHT 'JUSTIFY)
98+
(MODERNWINDOW W2)))
99+
(PROGN (EDITE DEF1)
100+
(EDITE DEF2])
101+
102+
(EXAMINEDEFS-REGION
103+
[LAMBDA (WIDTH HEIGHT) (* ; "Edited 10-Dec-2021 10:15 by rmk")
104+
105+
(* ;; "Prompts for a WIDTH-HEIGHT region with the top-left corner positioned at the initial cursor but the cursor then moved to the bottom-right for size adjustments. Thus the default behavior is that the upper left corner is fixed.")
106+
107+
(GETMOUSESTATE)
108+
(LET* ((LEFT LASTMOUSEX)
109+
(RIGHT (IPLUS LEFT WIDTH))
110+
(TOP LASTMOUSEY)
111+
(BOTTOM (IDIFFERENCE TOP HEIGHT)))
112+
(\CURSORPOSITION RIGHT BOTTOM)
113+
(GETREGION NIL NIL (CREATEREGION LEFT BOTTOM WIDTH HEIGHT)
114+
NIL NIL (LIST LEFT TOP RIGHT BOTTOM])
115+
)
116+
117+
(RPAQ? EXAMINEDEFS-PROCESS-LIST )
118+
(DECLARE%: DONTCOPY
119+
(FILEMAP (NIL (513 6305 (EXAMINEDEFS 523 . 5601) (EXAMINEDEFS-REGION 5603 . 6303)))))
120+
STOP

lispusers/EXAMINEDEFS.LCOM

2.18 KB
Binary file not shown.

lispusers/EXAMINEDEFS.TEDIT

4.27 KB
Binary file not shown.

0 commit comments

Comments
 (0)