(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "25-Feb-2022 18:04:08"  {DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;37 12345 :CHANGES-TO (FNS EXAMINEDEFS) :PREVIOUS-DATE " 1-Feb-2022 23:15:24" {DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;36) (PRETTYCOMPRINT EXAMINEDEFSCOMS) (RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEFILES TEDITDEF) (INITVARS (EXAMINEDEFS-PROCESS-LIST) (EXAMINEWITH 'COMPARETEXT)) (FILES (SYSLOAD) COMPARETEXT))) (DEFINEQ (EXAMINEDEFS [LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 25-Feb-2022 15:01 by rmk") (* ; "Edited 1-Feb-2022 15:42 by rmk") (* ; "Edited 23-Jan-2022 17:40 by rmk") (* ; "Edited 18-Jan-2022 22:40 by rmk") (* ; "Edited 12-Jan-2022 17:29 by rmk") (* ; "Edited 24-Dec-2021 22:39 by rmk") (* ; "Edited 20-Dec-2021 11:06 by rmk") (* ;; "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.") (* ;; "") (* ;; "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.") (CL:UNLESS NAME (CL:UNLESS (LISTP SOURCE1) (ERROR SOURCE1 " cannot be examined")) (CL:UNLESS (LISTP SOURCE2) (ERROR SOURCE2 " cannot be examined"))) (CL:UNLESS TYPE (SETQ TYPE 'FNS)) (* ;; "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?)") (LET (DEF1 DEF2) (SETQ DEF1 (IF (LISTP SOURCE1) THEN (* ;; "Copy to simulate READONLY") (SETQ DEF1 (COPY SOURCE1)) ELSEIF (GETDEF NAME TYPE SOURCE1) ELSE (ERROR NAME " not found on " SOURCE1))) (SETQ DEF2 (IF (LISTP SOURCE2) THEN (COPY SOURCE2) ELSEIF (GETDEF NAME TYPE SOURCE2) ELSE (ERROR NAME " not found on " SOURCE2))) (CL:UNLESS TITLE1 (SETQ TITLE1 (CL:IF (AND SOURCE1 (ILEQ (COUNT SOURCE1) 5)) SOURCE1 "File 1"))) (CL:UNLESS TITLE2 (SETQ TITLE2 (CL:IF (AND SOURCE2 (ILEQ (COUNT SOURCE2) 5)) SOURCE12 "File 2"))) (SELECTQ (EDITMODE) (SEDIT:SEDIT (* ;;  "A kludge to eliminate dangling SEDIT processes from previous examinations") [SETQ EXAMINEDEFS-PROCESS-LIST (FOR PAIR IN EXAMINEDEFS-PROCESS-LIST COLLECT (IF (OPENWP (CAR PAIR)) THEN PAIR ELSE (DEL.PROCESS (CDR PAIR)) (GO $$ITERATE] (* ;; "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.") (* ;;  "Crude suggestions for height, width, position. Suggest shorter window for smaller structures") (SELECTQ EXAMINEWITH (SEDIT (CL:UNLESS (REGIONP REGION) (SETQ REGION (GETREGION))) [LET (R1 R2 HALFWIDTH W1 W2) (SETQ HALFWIDTH (IQUOTIENT (FETCH (REGION WIDTH) OF REGION) 2)) (SETQ R1 (CREATE REGION USING REGION WIDTH _ HALFWIDTH)) (SETQ R2 (CREATE REGION USING REGION LEFT _ (IPLUS (FETCH (REGION LEFT) OF REGION) HALFWIDTH) WIDTH _ HALFWIDTH)) [SETQ W1 (SEDIT:GET-WINDOW (SEDIT:SEDIT DEF1 `(:NAME ,(CONCAT NAME " from " TITLE1) :REGION ,(CREATE REGION USING REGION WIDTH _ HALFWIDTH) R1 :DONT-KEEP-WINDOW-REGION T] [SETQ W2 (SEDIT:GET-WINDOW (SEDIT:SEDIT DEF2 `(:NAME ,(CONCAT NAME " from " TITLE2) :REGION ,R2 :DONT-KEEP-WINDOW-REGION T] (ATTACHWINDOW W2 W1 'RIGHT 'JUSTIFY) (MODERNWINDOW W2) (* ;;  "So we can kill the processes on the next call, if they still exist after the windows are closed.") (PUSH EXAMINEDEFS-PROCESS-LIST (CONS W1 (WINDOWPROP W1 'PROCESS)) (CONS W2 (WINDOWPROP W2 'PROCESS]) (COMPARETEXT [LET (COMPARETEXT.ALLCHUNKS CTWINDOW (KEY (LIST NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2))) (DECLARE (SPECVARS COMPARETEXT.ALLCHUNKS)) (* ; "Reuse an existing CT graph window") (OR [FIND W IN (OPENWINDOWS) SUCHTHAT (EQUAL KEY (WINDOWPROP W 'EXAMINEDEFS] (PROG1 (SETQ CTWINDOW (COMPARETEXT (TEDITDEF NAME DEF1 TYPE) (TEDITDEF NAME DEF2 TYPE) 'LINE REGION (LIST TITLE1 TITLE2) (CONCAT "Compare sources of " NAME " as " TYPE))) (WINDOWPROP CTWINDOW 'EXAMINEDEFS (LIST NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2)))]) (SHOULDNT))) (PROGN (EDITE DEF1) (EDITE DEF2]) (EXAMINEFILES [LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 1-Feb-2022 23:15 by rmk") (* ; "Edited 25-Jan-2022 10:08 by rmk") (* ; "Edited 2-Jan-2022 23:15 by rmk") (* ; "Edited 30-Dec-2021 21:49 by rmk") (* ;; "We get a region, then split it in half. ") (CL:UNLESS REGION (SETQ REGION (GETREGION))) (LIST (AND FILE1 (TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1) REGION 'RIGHT 'TOP `(,REGION 0.5) (FETCH (REGION TOP) OF REGION)) NIL TITLE1)) (AND FILE2 (TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1) REGION 'LEFT 'TOP `(,REGION 0.5) (FETCH (REGION TOP) OF REGION)) NIL TITLE2]) (TEDITDEF [LAMBDA (NAME DEF TYPE READERENVIRONMENT) (* ; "Edited 28-Jan-2022 23:36 by rmk") (* ; "Edited 12-Jan-2022 17:27 by rmk") (LET ((TSTREAM (OPENTEXTSTREAM))) (DSPFONT DEFAULTFONT TSTREAM) (SELECTQ (CAR DEF) (DEFINEQ (SETQ DEF (CADR DEF)) (PRINTOUT TSTREAM .FONT BOLDFONT .P2 NAME T .FONT DEFAULTFONT 2) (PRINTDEF (CADR DEF) 2 T NIL NIL TSTREAM)) ((DEFMACRO DEFUN) (* ; "Has args after name") (PRINTOUT TSTREAM "(" .P2 (CAR DEF) " " .FONT BOLDFONT .P2 (CADR DEF) .FONT DEFAULTFONT " " .P2 (CADDR DEF) T) (PRINTDEF (CDDDR DEF) 3 T T NIL TSTREAM) (PRIN3 ")" TSTREAM)) (IF (EQ NAME (CADR DEF)) THEN (* ;; "Like RPAQQ, bold the name") [PRINTOUT TSTREAM "(" .P2 (CAR DEF) " " .FONT BOLDFONT .P2 (CADR DEF) .FONT DEFAULTFONT T .TAB (IPLUS 2 (NCHARS (CAR DEF] (PRINTDEF (CDDR DEF) (IPLUS 2 (NCHARS (CAR DEF))) T T NIL TSTREAM) (PRIN3 ")" TSTREAM) ELSE (PRINTDEF DEF 3 NIL NIL NIL TSTREAM))) TSTREAM]) ) (RPAQ? EXAMINEDEFS-PROCESS-LIST ) (RPAQ? EXAMINEWITH 'COMPARETEXT) (FILESLOAD (SYSLOAD) COMPARETEXT) (DECLARE%: DONTCOPY (FILEMAP (NIL (661 12203 (EXAMINEDEFS 671 . 9217) (EXAMINEFILES 9219 . 10614) (TEDITDEF 10616 . 12201) )))) STOP