COMPAREDIRECTORIES, COMPARESOURCES, COMPARETEXT, EXAMINEDEFS (#1329)
* COMPAREDIRECTORIES, COMPARESOURCES, COMPARETEXT, EXAMINEDEFS Relatively minor cleanups, little or no functionality improvements * COMPAREDIRECTORIES: Get AUTHOR only if selected This may provide a little speed up. But of more importance, almost all the array crashes I am seeing are underneath (GETFILEINFO xxx 'AUTHOR). The UFS implementation may be smashing array space, or maybe it is just detecting the corruption. For now, I'm eliminating this potential source of bad behavior. * EXAMINEDEFS: Better interpretation of TYPE NIL = (FNS FUNCTIONS) with better formatting * COMPARETEXT: fixed to avoid EOF error if EOL gets confused
This commit is contained in:
rmkaplan
GitHub
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Jul-2022 11:05:08"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>EXAMINEDEFS.;40 12957
|
||||
(FILECREATED "13-Oct-2023 11:18:04" {WMEDLEY}<lispusers>EXAMINEDEFS.;48 14244
|
||||
|
||||
:CHANGES-TO (FNS EXAMINEDEFS)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "24-Jun-2022 18:52:03"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>EXAMINEDEFS.;39)
|
||||
:CHANGES-TO (FNS EXAMINEDEFS TEDITDEF)
|
||||
|
||||
:PREVIOUS-DATE "19-Jul-2023 13:59:26" {WMEDLEY}<lispusers>EXAMINEDEFS.;44)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
|
||||
@@ -19,49 +19,66 @@
|
||||
(DEFINEQ
|
||||
|
||||
(EXAMINEDEFS
|
||||
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 9-Jul-2022 11:04 by rmk")
|
||||
(* ; "Edited 24-Jun-2022 18:51 by rmk")
|
||||
(* ; "Edited 23-Jun-2022 17:58 by rmk")
|
||||
(* ; "Edited 25-Feb-2022 15:01 by rmk")
|
||||
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 13-Oct-2023 11:11 by rmk")
|
||||
(* ; "Edited 18-May-2023 22:35 by rmk")
|
||||
(* ; "Edited 21-Apr-2023 14:42 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.")
|
||||
(* ;; "This provides for side-by-side examination of separate but presumably related expressions. The (LISTP) expressions can be provided directly as the definitions SOURCE1 and SOURCE2 or, if NAME is given the copies of the definitions of NAME as TYPE on the two sources are examined. If both SOURCE1 and SOURCE2 are NIL, then SOURCE1 is the existing file defintions, NIL is the existing in-memory definition")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "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))
|
||||
(if NAME
|
||||
then (CL:UNLESS [OR SOURCE1 SOURCE2 (SETQ SOURCE2 (CAR (WHEREIS NAME
|
||||
(OR TYPE '(FNS FUNCTIONS))
|
||||
T]
|
||||
(ERROR (CONCAT "Can't find " NAME " definitions to examine")))
|
||||
else (CL:UNLESS (LISTP SOURCE1)
|
||||
(ERROR SOURCE1 " cannot be examined"))
|
||||
(CL:UNLESS (LISTP SOURCE2)
|
||||
(ERROR SOURCE2 " cannot be examined")))
|
||||
|
||||
(* ;; "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)))
|
||||
(* ;; "If SOURCE1 and SOURCE2 are both NIL, SOURCE1 defaults to the current (in memory) definition, SOURCE2 defaults to the definition on the current file.")
|
||||
|
||||
(LET (DEF1 DEF2)
|
||||
(if (SETQ DEF1 (LISTP SOURCE1))
|
||||
elseif TYPE
|
||||
then (NEQ (SETQ DEF1 (GETDEF NAME TYPE SOURCE1 'NOERROR))
|
||||
(FILEPKGTYPE TYPE 'NULLDEF))
|
||||
elseif (NEQ (SETQ DEF1 (GETDEF NAME (SETQ TYPE 'FNS)
|
||||
SOURCE1
|
||||
'NOERROR))
|
||||
(FILEPKGTYPE TYPE 'NULLDEF))
|
||||
elseif (NEQ (SETQ DEF1 (GETDEF NAME (SETQ TYPE 'FUNCTIONS)
|
||||
SOURCE1
|
||||
'NOERROR))
|
||||
(FILEPKGTYPE TYPE 'NULLDEF))
|
||||
else (ERROR NAME (CONCAT "not found on " SOURCE1)))
|
||||
(if (SETQ DEF2 (LISTP SOURCE2))
|
||||
elseif (NEQ (SETQ DEF2 (GETDEF NAME TYPE SOURCE2 'NOERROR))
|
||||
(FILEPKGTYPE TYPE 'NULLDEF))
|
||||
else (ERROR NAME (CONCAT "not found on " SOURCE2)))
|
||||
(CL:UNLESS TITLE1
|
||||
(SETQ TITLE1 (CL:IF (AND SOURCE1 (ILEQ (COUNT SOURCE1)
|
||||
5))
|
||||
SOURCE1
|
||||
"File 1")))
|
||||
(SETQ TITLE1 (OR (AND (OR (LISTP SOURCE1)
|
||||
(NULL SOURCE1))
|
||||
'Current)
|
||||
(AND (MEMB (U-CASE SOURCE1)
|
||||
'(PROP SAVED))
|
||||
'Saved)
|
||||
(FINDFILE SOURCE1)
|
||||
SOURCE1)))
|
||||
(CL:UNLESS TITLE2
|
||||
(SETQ TITLE2 (CL:IF (AND SOURCE2 (ILEQ (COUNT SOURCE2)
|
||||
5))
|
||||
SOURCE2
|
||||
"File 2")))
|
||||
(SETQ TITLE2 (OR (AND (OR (LISTP SOURCE2)
|
||||
(NULL SOURCE2))
|
||||
'Current)
|
||||
(AND (MEMB (U-CASE SOURCE2)
|
||||
'(PROP SAVED))
|
||||
'Saved)
|
||||
(FINDFILE SOURCE2)
|
||||
SOURCE2)))
|
||||
(SELECTQ (EDITMODE)
|
||||
(SEDIT:SEDIT
|
||||
(* ;;
|
||||
@@ -80,7 +97,9 @@
|
||||
"Crude suggestions for height, width, position. Suggest shorter window for smaller structures")
|
||||
|
||||
(SELECTQ EXAMINEWITH
|
||||
(SEDIT (CL:UNLESS (REGIONP REGION)
|
||||
(SEDIT (SETQ DEF1 (COPY DEF1)) (* ; "Copy to simulate read-only")
|
||||
(SETQ DEF2 (COPY DEF2))
|
||||
(CL:UNLESS (REGIONP REGION)
|
||||
(SETQ REGION (GETREGION)))
|
||||
[LET (R1 R2 HALFWIDTH W1 W2)
|
||||
(SETQ HALFWIDTH (IQUOTIENT (FETCH (REGION WIDTH)
|
||||
@@ -139,15 +158,14 @@
|
||||
(CONCAT "Compare sources of " NAME
|
||||
" as " TYPE)
|
||||
TEXTWIDTH TEXTHEIGHT))
|
||||
(WINDOWPROP CTWINDOW 'EXAMINEDEFS
|
||||
(LIST NAME TYPE SOURCE1 SOURCE2 TITLE1
|
||||
TITLE2)))])
|
||||
(WINDOWPROP CTWINDOW 'EXAMINEDEFS KEY))])
|
||||
(SHOULDNT)))
|
||||
(PROGN (EDITE DEF1)
|
||||
(EDITE DEF2])
|
||||
|
||||
(EXAMINEFILES
|
||||
[LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 1-Feb-2022 23:15 by rmk")
|
||||
[LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 19-Jul-2023 13:48 by rmk")
|
||||
(* ; "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")
|
||||
@@ -156,23 +174,26 @@
|
||||
|
||||
(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])
|
||||
(LIST (AND (INFILEP FILE1)
|
||||
(TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1)
|
||||
REGION
|
||||
'RIGHT
|
||||
'TOP
|
||||
`(,REGION 0.5)
|
||||
(FETCH (REGION TOP) OF REGION))
|
||||
NIL TITLE1))
|
||||
(AND (INFILEP 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 WIDTH) (* ; "Edited 23-Jun-2022 17:27 by rmk")
|
||||
[LAMBDA (NAME DEF TYPE READERENVIRONMENT WIDTH) (* ; "Edited 13-Oct-2023 00:23 by rmk")
|
||||
(* ; "Edited 23-Jun-2022 17:27 by rmk")
|
||||
(* ; "Edited 28-Jan-2022 23:36 by rmk")
|
||||
(* ; "Edited 12-Jan-2022 17:27 by rmk")
|
||||
(LET ((TSTREAM (OPENTEXTSTREAM)))
|
||||
@@ -182,11 +203,14 @@
|
||||
TSTREAM))
|
||||
TSTREAM))
|
||||
(SELECTQ (CAR DEF)
|
||||
([LAMBDA NLAMBDA OPENLAMBDA]
|
||||
(PRINTOUT TSTREAM .FONT BOLDFONT .P2 NAME T .FONT DEFAULTFONT 2)
|
||||
(PRINTDEF DEF 2 T NIL NIL TSTREAM))
|
||||
(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")
|
||||
((DEFMACRO DEFUN DEFMACRO CL:DEFUN) (* ; "Has args after name")
|
||||
(PRINTOUT TSTREAM "(" .P2 (CAR DEF)
|
||||
" " .FONT BOLDFONT .P2 (CADR DEF)
|
||||
.FONT DEFAULTFONT " " .P2 (CADDR DEF)
|
||||
@@ -216,6 +240,6 @@
|
||||
(FILESLOAD (SYSLOAD)
|
||||
COMPARETEXT)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (671 12815 (EXAMINEDEFS 681 . 9537) (EXAMINEFILES 9539 . 10934) (TEDITDEF 10936 . 12813)
|
||||
))))
|
||||
(FILEMAP (NIL (618 14102 (EXAMINEDEFS 628 . 10448) (EXAMINEFILES 10450 . 11932) (TEDITDEF 11934 .
|
||||
14100)))))
|
||||
STOP
|
||||
|
||||
Reference in New Issue
Block a user