github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-25 20:01:51 +00:00
Code Issues Projects Releases Wiki Activity

Rmk27 GITFNS for renaming, minor other convenience adjustments (#728)

Browse Source 
* GITFNS, COMPAREDIRECTORIES: more on renaming and copying

* MODERNIZE: use Wborder for the top for windows without titles

* DIRECTORY:  DEPTH as a parameter

* FILEPKG:  EDITCALLERS does FILDIR if FILES contains *

* GITFNS: Don't error on a non-existent "deleted" file
This commit is contained in:
rmkaplan
2022-03-07 12:38:35 -08:00
committed by GitHub
parent 74dc52b73f
commit 831aa94cb4
11 changed files with 408 additions and 362 deletions
Download Patch File Download Diff File Expand all files Collapse all files

130
sources/DIRECTORY
View File

@@ -1,13 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Apr-92 15:04:56" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>DIRECTORY.;5| 26134
changes to%: (FNS DIRECTORY DODIRCOMMANDS)
(FILECREATED " 5-Mar-2022 09:04:27" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DIRECTORY.;8 27503
previous date%: "31-May-90 12:25:29" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>DIRECTORY.;4|)
:CHANGES-TO (FNS DIRECTORY FILDIR)
:PREVIOUS-DATE " 5-Mar-2022 08:46:23"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DIRECTORY.;7)
(* ; "
Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT DIRECTORYCOMS)
@@ -31,9 +33,9 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
(ADDTOVAR LISPXMACROS (DIR (DODIR (NLAMBDA.ARGS LISPXLINE)))
(NDIR (DODIR (NLAMBDA.ARGS LISPXLINE)
'(P COLUMNS 20)
'* "")))
(NDIR (DODIR (NLAMBDA.ARGS LISPXLINE)
'(P COLUMNS 20)
'* "")))
(DEFINEQ
(DODIR
@@ -41,15 +43,19 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
)
(FILDIR
(LAMBDA (FILEGROUP) (* lmm " 4-OCT-83 03:27") (DIRECTORY FILEGROUP)))
[LAMBDA (FILEGROUP DEPTH) (* ; "Edited 5-Mar-2022 09:03 by rmk")
(* lmm " 4-OCT-83 03:27")
(DIRECTORY FILEGROUP (AND DEPTH `(COLLECT DEPTH ,DEPTH])
(DIRECTORY
[LAMBDA (FILES COMMANDS DEFAULTEXT DEFAULTVERS)
(DECLARE (SPECVARS COMMANDS DEFAULTEXT DEFAULTVERS))
(DECLARE (SPECVARS COMMANDS DEFAULTEXT DEFAULTVERS)) (* ; "Edited 4-Mar-2022 23:17 by rmk")
(* ; "Edited 30-Apr-92 14:55 by jds")
(PROG (VALUE COLUMNS NAMEFLG DELETEDONLY FILEGROUP PRINTFLG OUTFILE PROMPTFLG LASTHOST&DIR
DESIREDPROPS PFLG HEADINGS VALUES-WANTED)
(DECLARE (SPECVARS VALUE COLUMNS NAMEFLG FILEGROUP DESIREDPROPS LASTHOST&DIR))
DESIREDPROPS PFLG HEADINGS VALUES-WANTED (FILING.ENUMERATION.DEPTH
FILING.ENUMERATION.DEPTH))
(DECLARE (SPECVARS VALUE COLUMNS NAMEFLG FILEGROUP DESIREDPROPS LASTHOST&DIR
FILING.ENUMERATION.DEPTH))
(PROG ([COMTAIL (SETQ COMMANDS (COND
((LISTP COMMANDS)
(APPEND COMMANDS))
@@ -78,7 +84,7 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
(@ (SETQ COMTAIL (CDR COMTAIL))
(if (FNTYP (SETQ COM (CAR COMTAIL)))
then [RPLACA COMTAIL (CONS COM '(FILENAME]
(SETQ NAMEFLG T)
(SETQ NAMEFLG T)
elseif (FMEMB 'FILENAME (FREEVARS COM))
then (SETQ NAMEFLG T)))
(COLUMNS (SETQ COLUMNS (CADR COMTAIL))
@@ -95,17 +101,26 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
then (push DESIREDPROPS 'IREADDATE))
(RPLACA (SETQ COMTAIL (CDR COMTAIL))
(if (NUMBERP (SETQ COM (CAR COMTAIL)))
then (* ; "A number of days")
[IDIFFERENCE (IDATE)
(TIMES COM (DEFERREDCONSTANT (IDIFFERENCE
(IDATE
"2-JAN-77 00:00"
)
(IDATE
"1-JAN-77 00:00"
]
then (* ; "A number of days")
[IDIFFERENCE (IDATE)
(TIMES COM (DEFERREDCONSTANT (IDIFFERENCE
(IDATE "2-JAN-77 00:00"
)
(IDATE "1-JAN-77 00:00"
]
elseif (IDATE COM)
else (\ILLEGAL.ARG COM))))
(DEPTH [SETQ FILING.ENUMERATION.DEPTH (IF (AND (SMALLP (CADR COMTAIL))
(IGEQ (CADR COMTAIL)
0))
THEN (CADR COMTAIL)
ELSEIF (EQ T (CADR COMTAIL))
THEN MAX.SMALLP
ELSE (\ILLEGAL.ARG (CADR COMTAIL]
(* ;; "We remove the depth number from the list, leaving just the DEPTH, to be removed below. Otherwise we have to have a trailing pointer.")
(RPLACD COMTAIL (CDDR COMTAIL)))
(COND
((STRINGP COM)
(RPLNODE COMTAIL 'PRINT (CONS (MKSTRING COM)
@@ -128,6 +143,7 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
(T (ERROR "invalid DIRECTORY command" COM]
(AND (SETQ COMTAIL (CDR COMTAIL))
(GO COMLP)))
(SETQ COMMANDS (DREMOVE 'DEPTH COMMANDS))
(RESETLST
(* ;; "RESETLST is here, among other reasons, to clean up after any file generators that worry about the DIR being aborted")
@@ -136,12 +152,12 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
PATTERN _ (DIRECTORY.PARSE FILES)
FILEGENERATORS _ FILEGROUP))
(* ;
 "DIRECTORY.PARSE smashes generators on FILEGROUP for each atomic file specification it finds.")
 "DIRECTORY.PARSE smashes generators on FILEGROUP for each atomic file specification it finds.")
[COND
((EQL \MACHINETYPE \MAIKO)
(RESETSAVE NIL '(AND RESETSTATE (\UFS.ABORT.DIRECTORY]
(* ;
 "Make sure all instances of UFSGENFILESTATE will be released.")
 "Make sure all instances of UFSGENFILESTATE will be released.")
(COND
((OR PRINTFLG OUTFILE PROMPTFLG)
[COND
@@ -157,39 +173,36 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
[COND
((AND PFLG (NEQ (CAR PFLG)
'PAUSE)) (* ;
 "Postpone print commands until after predicate commands")
 "Postpone print commands until after predicate commands")
(SETQ COMTAIL COMMANDS)
(bind SEENP PREVTAIL
do (SELECTQ (CAR COMTAIL)
((P PP)
(SETQ SEENP (OR PREVTAIL T)))
((BY COLUMNS @ OUT OLDERTHAN NEWERTHAN)
(pop COMTAIL))
(PROGN [COND
((AND SEENP (NEQ COMTAIL (CDR PFLG)))
(bind SEENP PREVTAIL do (SELECTQ (CAR COMTAIL)
((P PP)
(SETQ SEENP (OR PREVTAIL T)))
((BY COLUMNS @ OUT OLDERTHAN NEWERTHAN)
(pop COMTAIL))
(PROGN [COND
((AND SEENP (NEQ COMTAIL (CDR PFLG)))
(* ;
 "Move the P or PP to before COMTAIL")
(RPLACD PREVTAIL (CONS (CAR PFLG)
COMTAIL))
(COND
((NEQ SEENP T)
(RPLACD SEENP (CDDR SEENP)))
(T (pop COMMANDS]
(RETURN)))
(SETQ COMTAIL (CDR (SETQ PREVTAIL COMTAIL]
 "Move the P or PP to before COMTAIL")
(RPLACD PREVTAIL (CONS (CAR PFLG)
COMTAIL))
(COND
((NEQ SEENP T)
(RPLACD SEENP (CDDR SEENP)))
(T (pop COMMANDS]
(RETURN)))
(SETQ COMTAIL (CDR (SETQ PREVTAIL COMTAIL]
[COND
((AND HEADINGS (for X in HEADINGS thereis (CAR X)))
(TERPRI)
(for X in (REVERSE HEADINGS) bind (I _ 22)
do (TAB I)
[COND
((CAR X)
(PRIN1 (CAR X]
(add I (CADR X]
(for X in (REVERSE HEADINGS) bind (I _ 22) do (TAB I)
[COND
((CAR X)
(PRIN1 (CAR X]
(add I (CADR X]
(SETQ PRINTFLG T)
(TAB 0 0)))
(while (DIRECTORY.NEXTFILE FILEGROUP) do (DODIRCOMMANDS COMMANDS
FILEGROUP))
(while (DIRECTORY.NEXTFILE FILEGROUP) do (DODIRCOMMANDS COMMANDS FILEGROUP))
(COND
(PRINTFLG (TAB 0 0))))
(RETURN (OR VALUE (COND
@@ -370,7 +383,8 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
UNDELETE
(VERBOSE AUTHOR CREATIONDATE SIZE READDATE WRITEDATE)
TRIMTO
(DELVER OLDVERSIONS DELETE)))
(DELVER OLDVERSIONS DELETE)
DEPTH))
(RPAQQ FILEINFOTYPES
((WRITEDATE 22)
@@ -393,8 +407,8 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
(DECLARE%: EVAL@COMPILE
(PUTPROPS DTAB DMACRO ((N)
(TAB (PROG1 I (add I N 1))
0)))
(TAB (PROG1 I (add I N 1))
0)))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -404,10 +418,10 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
)
(PUTPROPS DIRECTORY COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1992))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1339 24611 (DODIR 1349 . 1896) (FILDIR 1898 . 1979) (DIRECTORY 1981 . 11071) (
DIRECTORY.PARSE 11073 . 11781) (DIRECTORY.FILL.PATTERN 11783 . 12167) (DIRCONJ 12169 . 12389) (
DIRECTORY.NEXTFILE 12391 . 12984) (DMATCH 12986 . 13361) (DIRECTORY.MATCH.SETUP 13363 . 13897) (
DIRECTORY.MATCH 13899 . 14316) (DIRECTORY.MATCH1 14318 . 16431) (DODIRCOMMANDS 16433 . 22206) (
DIRPRINTNAME 22208 . 23624) (DPRIN1 23626 . 23711) (DIRFILENAME 23713 . 24142) (DIRGETFILEINFO 24144
. 24296) (DREAD 24298 . 24609)))))
(FILEMAP (NIL (1330 25982 (DODIR 1340 . 1887) (FILDIR 1889 . 2169) (DIRECTORY 2171 . 12442) (
DIRECTORY.PARSE 12444 . 13152) (DIRECTORY.FILL.PATTERN 13154 . 13538) (DIRCONJ 13540 . 13760) (
DIRECTORY.NEXTFILE 13762 . 14355) (DMATCH 14357 . 14732) (DIRECTORY.MATCH.SETUP 14734 . 15268) (
DIRECTORY.MATCH 15270 . 15687) (DIRECTORY.MATCH1 15689 . 17802) (DODIRCOMMANDS 17804 . 23577) (
DIRPRINTNAME 23579 . 24995) (DPRIN1 24997 . 25082) (DIRFILENAME 25084 . 25513) (DIRGETFILEINFO 25515
. 25667) (DREAD 25669 . 25980)))))
STOP