github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-12 00:42:56 +00:00
Code Issues Projects Releases Wiki Activity

Manipulate versions of definitions by their ordinal file numbers (#1931)

Browse Source
This commit is contained in:
rmkaplan 2025-01-20 12:40:46 -08:00 committed by GitHub
parent 9e6eba2cd9
commit d737f7ec93
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
9 changed files with 265 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
lispusers/EXAMINEDEFS
View File

@ -1,29 +1,31 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-Oct-2023 11:18:04" {WMEDLEY}<lispusers>EXAMINEDEFS.;48 14244
(FILECREATED "12-Dec-2024 15:09:08" {WMEDLEY}<lispusers>EXAMINEDEFS.;53 16442
:EDIT-BY rmk
:CHANGES-TO (FNS EXAMINEDEFS TEDITDEF)
:CHANGES-TO (FNS EXVV)
(VARS EXAMINEDEFSCOMS)
:PREVIOUS-DATE "19-Jul-2023 13:59:26" {WMEDLEY}<lispusers>EXAMINEDEFS.;44)
:PREVIOUS-DATE " 6-Dec-2024 21:30:42" {WMEDLEY}<lispusers>EXAMINEDEFS.;51)
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEFILES TEDITDEF)
(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEFILES TEDITDEF EXV EXVV)
(INITVARS (EXAMINEDEFS-PROCESS-LIST)
(EXAMINEWITH 'COMPARETEXT))
(FILES (SYSLOAD)
COMPARETEXT)))
COMPARETEXT VERSIONDEFS)))
(DEFINEQ
(EXAMINEDEFS
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 13-Oct-2023 11:11 by rmk")
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 6-Dec-2024 20:51 by rmk")
(* ; "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 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")
(* ;; "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 defintion, NIL is the existing in-memory definition")
(* ;; "")
@ -231,6 +233,54 @@
(PRIN3 ")" TSTREAM)
ELSE (PRINTDEF DEF 3 NIL NIL NIL TSTREAM)))
TSTREAM])
(EXV
[LAMBDA (NAME TYPE FILE VERSION) (* ; "Edited 6-Dec-2024 21:24 by rmk")
(* ;; "Compares the current incore version with the definition on version VERSION of FILE. TYPE defaults to functions, FILE defaults to (CAR (WHEREIS)), VERSION defaults to newest.")
(CL:WHEN (VERSIONP TYPE)
(SETQ VERSION TYPE)
(SETQ TYPE NIL))
(* ;; "NAME (VARS) (SOURCE1) (V1) (SOURCE2) (V2) ")
(CL:UNLESS FILE
(CL:WHEN (AND (VERSIONP FILE)
(NOT (VERSIONP VERSION)))
(SETQ VERSION FILE))
(SETQ FILE (OR (CAR (WHEREIS NAME TYPE T))
(ERROR "Can't find " FILE " definition of " NAME))))
(CL:UNLESS VERSION
(SETQ VERSION 'NEWEST))
(SETQ FILE (FINDFILEVERSION FILE VERSION))
(EXAMINEDEFS NAME TYPE NIL FILE])
(EXVV
[LAMBDA (NAME TYPE FILE VERSION1 VERSION2) (* ; "Edited 12-Dec-2024 15:09 by rmk")
(* ;; "Compares the definitions of NAME as TYPE on 2 different versions of FILE. TYPE and FILE can be elided, defaulting to NIL and WHEREIS respectively. Versions default to newest.")
(* ;; "(EXVV 'FOO -1 -2) will compare the newest and second-newest function definitions of FOO")
(if (AND (VERSIONP VERSION1)
(VERSIONP VERSION2))
elseif (VERSIONP TYPE)
then (SETQ VERSION1 TYPE)
(SETQ TYPE NIL)
(CL:WHEN (VERSIONP FILE)
(SETQ VERSION2 FILE)
(SETQ FILE NIL))
elseif (VERSIONP FILE)
then (CL:WHEN (VERSIONP VERSION1)
(SETQ VERSION2 VERSION1))
(SETQ VERSION1 FILE)
(SETQ FILE NIL))
(CL:UNLESS FILE
(SETQ FILE (OR (CAR (WHEREIS NAME TYPE T))
(ERROR "Can't find " FILE " definition of " NAME))))
(EXAMINEDEFS NAME TYPE (FINDFILEVERSION FILE (OR VERSION1 -1))
(FINDFILEVERSION FILE (OR VERSION2 -1])
)
(RPAQ? EXAMINEDEFS-PROCESS-LIST )
@ -238,8 +288,8 @@
(RPAQ? EXAMINEWITH 'COMPARETEXT)
(FILESLOAD (SYSLOAD)
COMPARETEXT)
COMPARETEXT VERSIONDEFS)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (618 14102 (EXAMINEDEFS 628 . 10448) (EXAMINEFILES 10450 . 11932) (TEDITDEF 11934 .
14100)))))
(FILEMAP (NIL (664 16288 (EXAMINEDEFS 674 . 10603) (EXAMINEFILES 10605 . 12087) (TEDITDEF 12089 .
14255) (EXV 14257 . 15125) (EXVV 15127 . 16286)))))
STOP

BIN
lispusers/EXAMINEDEFS.LCOM
View File

Binary file not shown.

BIN
lispusers/EXAMINEDEFS.TEDIT
View File

Binary file not shown.

77
lispusers/TEDIT-PF-SEE
View File

@ -1,32 +1,31 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "31-Oct-2024 17:27:44" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;124 10208
(FILECREATED "23-Dec-2024 19:26:20" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;133 11059
:EDIT-BY rmk
:CHANGES-TO (VARS TEDIT-PF-SEECOMS)
:PREVIOUS-DATE "31-Oct-2024 17:25:56" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;123)
:PREVIOUS-DATE " 7-Dec-2024 18:00:39" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;132)
(PRETTYCOMPRINT TEDIT-PF-SEECOMS)
(RPAQQ TEDIT-PF-SEECOMS [(FNS PF-TEDIT PF-TEDIT-FROM-TEXT)
(COMMANDS ts tf)
(FILES (SYSLOAD)
REGIONMANAGER)
(P (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
(MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION))
(TEDIT.SETFUNCTION "Meta,T" (FUNCTION PF-TEDIT-FROM-TEXT))
(TEDIT.SETFUNCTION "Meta,t" (FUNCTION PF-TEDIT-FROM-TEXT)))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS
(NLAMA)
(NLAML)
(LAMA])
(RPAQQ TEDIT-PF-SEECOMS
[(FNS PF-TEDIT PF-TEDIT-FROM-TEXT)
(COMMANDS ts tf)
(FILES (SYSLOAD)
REGIONMANAGER VERSIONDEFS)
(P (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
(MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION))
(TEDIT.SETFUNCTION "Meta,T" (FUNCTION PF-TEDIT-FROM-TEXT))
(TEDIT.SETFUNCTION "Meta,t" (FUNCTION PF-TEDIT-FROM-TEXT)))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(DEFINEQ
(PF-TEDIT
[LAMBDA (FN IFILES REPRINT) (* ; "Edited 27-Aug-2024 13:03 by rmk")
[LAMBDA (FN IFILES VERSION REPRINT) (* ; "Edited 6-Dec-2024 19:15 by rmk")
(* ; "Edited 27-Aug-2024 13:03 by rmk")
(* ; "Edited 27-Mar-2024 23:45 by rmk")
(* ; "Edited 25-Dec-2023 12:24 by rmk")
(* ; "Edited 5-Dec-2023 23:50 by rmk")
@ -50,21 +49,32 @@
((t T NIL)
(SETQ REPRINT T)
(SETQ FN LASTWORD))
(SETQ LASTWORD FN))
(if (VERSIONP FN)
then (SETQ IFILES (CONS FN))
(SETQ FN LASTWORD)
else (SETQ LASTWORD FN)))
(CL:UNLESS FN (ERROR "No function to print"))
(CL:WHEN (AND (VERSIONP IFILES)
(NULL VERSION))
(SETQ VERSION IFILES)
(SETQ IFILES NIL))
(CL:WHEN (INTERSECTION '(T t)
IFILES)
(SETQ REPRINT T)
[SETQ IFILES (LDIFFERENCE IFILES '(t T])
(IF [OR IFILES (SETQ IFILES (APPEND (WHEREIS FN 'FNS T)
(WHEREIS FN 'FUNCTIONS T]
(CL:UNLESS IFILES
(SETQ IFILES (APPEND (WHEREIS FN 'FNS T)
(WHEREIS FN 'FUNCTIONS T))))
(IF IFILES
THEN (* ; "skip compiled files")
(* ;; "Since we are creating readonly Tedits, try to keep the TTY where it is.")
(FOR IFILE LOC TSTREAM ENV EXPR TFPROP WINDOW INSIDE IFILES
UNLESS (MEMB (FILENAMEFIELD IFILE 'EXTENSION)
*COMPILED-EXTENSIONS*)
EACHTIME (CL:IF (VERSIONP IFILE)
(SETQ IFILE (FINDFILEVERSION (CAR (WHEREIS FN NIL T))
IFILE))) UNLESS (MEMB (FILENAMEFIELD IFILE 'EXTENSION)
*COMPILED-EXTENSIONS*)
DO (SETQ LOC (FINDFNDEF FN IFILE))
(IF (LISTP LOC)
THEN (SETQ TFPROP (LIST FN (CAR LOC)))
@ -134,7 +144,8 @@
ELSE (PRINTOUT T FN " has no function definition" T])
(PF-TEDIT-FROM-TEXT
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 26-Aug-2024 23:13 by rmk")
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 5-Dec-2024 22:20 by rmk")
(* ; "Edited 26-Aug-2024 23:13 by rmk")
(* ;; "The function key for the meta,T and meta,t keys. This shows in a separate Tedit window the definition in TSTREAM of the function named by the selection SEL.")
@ -149,21 +160,27 @@
(if (EQ 0 (NCHARS FN))
then (TEDIT.PROMPTPRINT TSTREAM "Please select a function to display" T)
elseif FILENAME
then (PF-TEDIT FN FILENAME)
then [PF-TEDIT FN (CAR (MEMB (FILENAMEFIELD FILENAME)
(WHEREIS FN NIL T]
else (TEDIT.PROMPTPRINT TSTREAM (CONCAT FN " not found")
T])
)
(DEFCOMMAND ts (FILE WINDOW FORMAT)
(TEDIT-SEE (OR (FINDFILE-WITH-EXTENSIONS FILE NIL '(NIL TEDIT TED TXT TEXT TEX))
(ERROR "FILE NOT FOUND" FILE))
(DEFCOMMAND ts (FILE VERSION WINDOW FORMAT) (CL:WHEN (WINDOWP VERSION)
(SETQ WINDOW VERSION)
(SETQ VERSION -1))
(CL:UNLESS VERSION (SETQ VERSION -1))
(TEDIT-SEE (FINDFILEVERSION (OR (FINDFILE-WITH-EXTENSIONS FILE NIL
'(NIL TEDIT TED TXT TEXT TEX))
(ERROR "FILE NOT FOUND" FILE))
VERSION)
(OR WINDOW 'SEE)
FORMAT))
(DEFCOMMAND tf (FN . IFILES) (PF-TEDIT FN IFILES))
(DEFCOMMAND tf (FN FILE VERSION) (PF-TEDIT FN FILE VERSION))
(FILESLOAD (SYSLOAD)
REGIONMANAGER)
REGIONMANAGER VERSIONDEFS)
(MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
@ -181,5 +198,5 @@
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1243 9524 (PF-TEDIT 1253 . 8506) (PF-TEDIT-FROM-TEXT 8508 . 9522)))))
(FILEMAP (NIL (973 10035 (PF-TEDIT 983 . 8821) (PF-TEDIT-FROM-TEXT 8823 . 10033)))))
STOP

BIN
lispusers/TEDIT-PF-SEE.LCOM
View File

Binary file not shown.

BIN
lispusers/TEDIT-PF-SEE.TEDIT
View File

Binary file not shown.

158
lispusers/VERSIONDEFS Normal file
View File

@ -0,0 +1,158 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "12-Dec-2024 15:07:45" {WMEDLEY}<lispusers>VERSIONDEFS.;11 6270
:EDIT-BY rmk
:CHANGES-TO (VARS VERSIONDEFSCOMS)
:PREVIOUS-DATE " 6-Dec-2024 22:12:48" {WMEDLEY}<lispusers>VERSIONDEFS.;10)
(PRETTYCOMPRINT VERSIONDEFSCOMS)
(RPAQQ VERSIONDEFSCOMS [(FNS FINDFILEVERSION GETVINFO VERSIONP)
(FNS EDV DFV)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA DVV DFV EDV)
(NLAML)
(LAMA])
(DEFINEQ
(FINDFILEVERSION
[LAMBDA (FILE VERSION DIRLIST NOERROR) (* ; "Edited 6-Dec-2024 22:12 by rmk")
(* ; "Edited 1-Dec-2024 23:01 by rmk")
(* ; "Edited 4-Oct-2024 15:23 by rmk")
(* ;; "Returns the version of FILE in DIRLIST that correspond to the relative version specifier VERSION. Negative version count backwrd from the newest (=-1), positive count forward from the oldest (=1). F, FIRST,OLDEST are equivalent to 1 (= oldest), N NEWEST are equivalent to -1 (newest).")
(LET (FILES)
(SETQ VERSION (VERSIONP VERSION))
(if (EQ VERSION -1)
then (FINDFILE FILE T DIRLIST)
elseif [SETQ FILES (FILDIR (PACKFILENAME 'VERSION '* 'BODY (FINDFILE FILE T DIRLIST]
then (CAR (if (ILESSP VERSION 0)
then
(* ;; "-2 is the second newest version")
(NTH FILES (IMINUS VERSION))
else
(* ;; "2 is the second oldest")
(NTH (DREVERSE FILES)
VERSION)))
elseif (NOT NOERROR)
then (ERROR (CONCAT "Version " VERSION " of " FILE " not found"])
(GETVINFO
[LAMBDA (NAME TYPE FILE VERSION DIRLIST) (* ; "Edited 6-Dec-2024 21:37 by rmk")
(* ; "Edited 1-Dec-2024 23:50 by rmk")
(* ;; "Gets the TYPE definition of NAME from version VERSION of FILE, returns the definition after storing it under an annotated name that the filepkg doesn't see. ")
(CL:WHEN (VERSIONP TYPE)
(SETQ VERSION TYPE)
(SETQ TYPE NIL))
(CL:WHEN (VERSIONP FILE)
(SETQ VERSION FILE)
(SETQ FILE NIL))
(CL:UNLESS [OR FILE (SETQ FILE (CAR (WHEREIS NAME TYPE T]
(ERROR (CONCAT "File for " NAME " not found")))
(CL:UNLESS VERSION
(SETQ VERSION 'NEWEST))
(LET ((VFILE (FINDFILEVERSION FILE VERSION DIRLIST))
(CONNECTED (DIRECTORYNAME T T))
DEF VNAME HOST DIR) (* ; "Don't include the whole path if it's the connected one. Perhaps we should create/return both a short name and a long name")
(SETQ DEF (GETDEF NAME TYPE FILE))
(SETQ HOST (FILENAMEFIELD VFILE 'HOST))
(SETQ DIR (FILENAMEFIELD VFILE 'DIRECTORY))
(CL:WHEN (STRING.EQUAL HOST (FILENAMEFIELD CONNECTED 'HOST))
(SETQ HOST NIL))
(CL:WHEN (STRING.EQUAL DIR (FILENAMEFIELD CONNECTED 'DIRECTORY))
(SETQ DIR NIL))
(SETQ VNAME (PACK* (CL:IF HOST
(CONCAT "{" HOST "}")
"")
(CL:IF DIR
(CONCAT "<" (L-CASE DIR)
">")
"")
NAME ";" (FILENAMEFIELD VFILE 'VERSION)
(SELECTQ VERSION
(1 " (F)")
(-1 " (N)")
"")))
(LIST VNAME TYPE DEF])
(VERSIONP
[LAMBDA (X) (* ; "Edited 6-Dec-2024 20:26 by rmk")
(* ;; "Normalize X if X is a version designator, otherwise NIL")
(SELECTQ X
((F FIRST OLDEST)
1)
((N NEWEST 0)
-1)
(FIXP X])
)
(DEFINEQ
(EDV
[NLAMBDA ARGS (* ; "Edited 6-Dec-2024 21:30 by rmk")
(* ; "Edited 2-Dec-2024 00:14 by rmk")
(SETQ ARGS (MKLIST ARGS))
(PROG ((NAME (POP ARGS))
(TYPE (POP ARGS))
(FILE (POP ARGS))
(VERSION (POP ARGS))
(DIRLIST (POP ARGS))
VINFO)
(SETQ VINFO (GETVINFO NAME TYPE FILE VERSION DIRLIST))
(EDITE (CADDR VINFO)
NIL
(CAR VINFO)
(CADR VINFO)
NIL
'(:DONTWAIT))
(CAR VINFO])
(DFV
[NLAMBDA ARGS (* ; "Edited 6-Dec-2024 21:29 by rmk")
(* ; "Edited 2-Dec-2024 00:08 by rmk")
(SETQ ARGS (MKLIST ARGS))
(APPLY (FUNCTION EDV)
(LIST (POP ARGS)
NIL
(POP ARGS)
(POP ARGS)
(POP ARGS])
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA DVV DFV EDV)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PRETTYCOMPRINT VERSIONDEFSCOMS)
(RPAQQ VERSIONDEFSCOMS [(FNS FINDFILEVERSION GETVINFO VERSIONP)
(FNS EDV DFV)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA DFV EDV)
(NLAML)
(LAMA])
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA DFV EDV)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (683 4442 (FINDFILEVERSION 693 . 2140) (GETVINFO 2142 . 4125) (VERSIONP 4127 . 4440)) (
4443 5589 (EDV 4453 . 5153) (DFV 5155 . 5587)))))
STOP

BIN
lispusers/VERSIONDEFS.LCOM Normal file
View File

Binary file not shown.

BIN
lispusers/VERSIONDEFS.TEDIT Normal file
View File

Binary file not shown.