|
| 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 |
0 commit comments