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

Adjustments to GITFNS (#2321)

Browse Source 
prc status is C if changes requested, prc comparison runs in its own process, initial changes for gwc to treat the clone as UNIX, not DSK, so branch-switching doesn't cause files from other branches to pile up.

* COMPAREDIRECTORIES: don't fail on empty directory

* Bug in slashit

* gwc copies to UNIX--doesn't track Medley version numbers when it copies to the clone
This commit is contained in:
rmkaplan
2025-10-27 12:12:20 -07:00
committed by GitHub
parent 54f8b889b9
commit aae53a700f
8 changed files with 436 additions and 393 deletions
Download Patch File Download Diff File Expand all files Collapse all files

210
library/UNIXUTILS
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-Nov-2023 12:57:10" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;26 16663
(FILECREATED "22-Oct-2025 13:05:51" {WMEDLEY}<library>UNIXUTILS.;33 17919
:CHANGES-TO (FNS ShellBrowser)
:EDIT-BY rmk
:PREVIOUS-DATE "11-Nov-2023 09:06:39" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;25
)
:CHANGES-TO (FNS SLASHIT)
:PREVIOUS-DATE "27-Sep-2025 16:25:07" {WMEDLEY}<library>UNIXUTILS.;32)
(PRETTYCOMPRINT UNIXUTILSCOMS)
@@ -146,7 +147,8 @@
"true"])
(ShellOpen
[LAMBDA (FilenameOrURL)
[LAMBDA (FilenameOrURL) (* ; "Edited 10-Sep-2025 15:29 by rmk")
(* ; "Edited 4-May-2025 11:14 by rmk")
(* ;; "Open the file or URL using the generic %"opener%" for this machine via a shell call.")
@@ -176,62 +178,56 @@
" >>/tmp/ShellBrowser-warnings-$$.txt"))
T)
else (CONCAT "Unable to find a browser to open: " FilenameOrURL)))
else
(LET*
((OPENER (ShellOpener))
(FULLNAME (FULLNAME FilenameOrURL)))
(if (NOT FULLNAME)
then (CONCAT "File not found: " FilenameOrURL)
elseif (STREQUAL OPENER "true")
then (CONCAT "Unable to find a file opener to open: " FilenameOrURL)
else (LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION))
(UNPACKED (UNPACKFILENAME.STRING FULLNAME))
(NEWNAME (CONCAT (LISTGET UNPACKED 'NAME)
"~"
(LISTGET UNPACKED 'VERSION)
"~"))
(EXTENSION (LISTGET UNPACKED 'EXTENSION))
[UNVERSIONED (LET (FN (UNPACKED (COPY UNPACKED)))
(LISTPUT UNPACKED 'VERSION NIL)
(LISTPUT UNPACKED 'HOST NIL)
(SETQ FN (PACKFILENAME.STRING UNPACKED))
(if (STREQUAL (SUBSTRING FN -1)
".")
then (SETQ FN (SUBSTRING UNIXFILE 1 -2)))
(SETQ FN (SLASHIT FN]
(UNVERSIONED.EXISTS (INFILEP (CONCAT "{UNIX}" UNVERSIONED)))
(TMPDIR (CONCAT "/tmp/" (RAND 1000 9999)))
(TARGETFILE.LISP (PACKFILENAME.STRING 'HOST "{UNIX}" 'DIRECTORY TMPDIR
'NAME NEWNAME 'EXTENSION EXTENSION))
(TARGETFILE.UNIX (SLASHIT (PACKFILENAME.STRING 'HOST NIL 'DIRECTORY TMPDIR
'NAME NEWNAME 'EXTENSION EXTENSION)))
(UNIXFILE NIL))
(DECLARE (SPECVARS UNIXFILE))
(if (OR VERSION.SPECIFIED (NOT UNVERSIONED.EXISTS))
then (COPYFILE FULLNAME TARGETFILE.LISP)
(SETQ UNIXFILE TARGETFILE.UNIX)
else (SETQ UNIXFILE UNVERSIONED))
(CL:WITH-OPEN-STREAM
(SHELLSTREAM (OPENSTREAM (CONCAT "{CORE}SHELLOUT" (RAND 1000 9999))
'BOTH))
(ShellCommand (CONCAT OPENER " '" UNIXFILE "'"
" >>/tmp/ShellOpener-warnings-$$.txt")
SHELLSTREAM)
(if (EQ (GETFILEPTR SHELLSTREAM)
0)
then T
else (LET* ((OUTSTRING (ALLOCSTRING (GETFILEPTR SHELLSTREAM)
" ")))
(CL:WITH-OPEN-STREAM (STRINGSTREAM (OPENSTRINGSTREAM OUTSTRING
'OUTPUT))
(SETFILEPTR SHELLSTREAM 0)
(CL:TAGBODY [SETFILEINFO SHELLSTREAM 'ENDOFSTREAMOP
#'(CL:LAMBDA (s)
(GO OUT]
(CL:LOOP (PRINTCCODE (READCCODE SHELLSTREAM)
STRINGSTREAM))
OUT))
OUTSTRING])
else (LET* ((OPENER (ShellOpener))
(FULLNAME (FULLNAME FilenameOrURL)))
(if (NOT FULLNAME)
then (CONCAT "File not found: " FilenameOrURL)
elseif (STREQUAL OPENER "true")
then (CONCAT "Unable to find a file opener to open: " FilenameOrURL)
else (LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION))
(UNPACKED (UNPACKFILENAME.STRING FULLNAME))
(NEWNAME (CONCAT (LISTGET UNPACKED 'NAME)
"~"
(LISTGET UNPACKED 'VERSION)
"~"))
(EXTENSION (LISTGET UNPACKED 'EXTENSION))
[UNVERSIONED (LET (FN (UNPACKED (COPY UNPACKED)))
(LISTPUT UNPACKED 'VERSION NIL)
(LISTPUT UNPACKED 'HOST NIL)
(SETQ FN (PACKFILENAME.STRING UNPACKED))
(if (STREQUAL (SUBSTRING FN -1)
".")
then (SETQ FN (SUBSTRING UNIXFILE 1 -2)))
(SETQ FN (SLASHIT FN]
(UNVERSIONED.EXISTS (INFILEP (CONCAT "{UNIX}" UNVERSIONED)))
(TMPDIR (CONCAT "/tmp/" (RAND 1000 9999)))
(TARGETFILE.LISP (PACKFILENAME.STRING 'HOST "{UNIX}" 'DIRECTORY TMPDIR
'NAME NEWNAME 'EXTENSION EXTENSION))
(TARGETFILE.UNIX (SLASHIT (PACKFILENAME.STRING 'HOST NIL 'DIRECTORY
TMPDIR 'NAME NEWNAME 'EXTENSION
EXTENSION)))
(UNIXFILE NIL))
(DECLARE (SPECVARS UNIXFILE))
(if (OR VERSION.SPECIFIED (NOT UNVERSIONED.EXISTS))
then (COPYFILE FULLNAME TARGETFILE.LISP)
(SETQ UNIXFILE TARGETFILE.UNIX)
else (SETQ UNIXFILE UNVERSIONED))
(CL:WITH-OPEN-STREAM
(SHELLSTREAM (OPENSTREAM (CONCAT "{CORE}SHELLOUT" (RAND 1000 9999))
'BOTH))
(ShellCommand (CONCAT OPENER " '" UNIXFILE "'"
" >>/tmp/ShellOpener-warnings-$$.txt")
SHELLSTREAM)
(if (EQ (GETFILEPTR SHELLSTREAM)
0)
then T
else (LET ((OUTSTRING (ALLOCSTRING (GETFILEPTR SHELLSTREAM)
" ")))
(CL:WITH-OPEN-STREAM (STRINGSTREAM (OPENSTRINGSTREAM
OUTSTRING
'OUTPUT))
(COPYCHARS SHELLSTREAM STRINGSTREAM 0 -1))
OUTSTRING])
(PROCESS-COMMAND
[LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk")
@@ -244,7 +240,9 @@
0))) DO (BLOCK) FINALLY (RETURN CODE])
(SLASHIT
[LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 23-Sep-2023 15:27 by rmk")
[LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 22-Oct-2025 13:05 by rmk")
(* ; "Edited 25-Sep-2025 09:57 by rmk")
(* ; "Edited 23-Sep-2023 15:27 by rmk")
(* ;; "It would also be nice to use the generic unpackfilename/packfilename tools. But packfilename sticks in brackets again, and sticks a dot on when removing the version.")
@@ -255,13 +253,14 @@
(LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X)
0]
[SETQ SLASHED (CONCATCODES (for I C from DIRPOS while (SETQ C (NTHCHARCODE X I))
collect (SELCHARQ C
((< >)
(SETQ LASTDIRPOS I)
(CHARCODE /))
(/ (SETQ LASTDIRPOS I)
C)
C]
join (SELCHARQ C
((< >)
(SETQ LASTDIRPOS I)
(CONS (CHARCODE /)))
(/ (SETQ LASTDIRPOS I)
(CONS C))
(SPACE (CHARCODE (\ SPACE)))
(CONS C]
(CL:WHEN (AND LCASEDIRS LASTDIRPOS)
(SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS)))
(SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS))
@@ -274,13 +273,15 @@
SLASHED))])
(UNIX-FILE-NAME
[LAMBDA (FILE ACCESS COPY) (* ; "Edited 1-Oct-2023 20:52 by rmk")
[LAMBDA (FILE ACCESS COPY) (* ; "Edited 27-Sep-2025 16:24 by rmk")
(* ; "Edited 19-Sep-2025 07:29 by rmk")
(* ; "Edited 13-Sep-2025 18:37 by rmk")
(* ; "Edited 1-Oct-2023 20:52 by rmk")
(* ;; "Forces an extension %"ufn%" if there isn't one already, to avoid the dot/no-dot question")
(* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file is doesn't have the Medley version convention. If FILE does not have a corresponding Unix name, COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.")
(CL:WHEN (\GETSTREAM FILE ACCESS T)
(SETQ FILE (OR (FULLNAME FILE)
FILE))) (* ; "Might catch NODIRCORE")
(* ; "Might catch NODIRCORE")
(CL:WHEN FILE
(SETQ FILE (TRUEFILENAME FILE))
(CL:UNLESS (STREAMP FILE)
@@ -290,35 +291,42 @@
(NIL (SETQ ACCESS 'INPUT)
'OLD)
(\ILLEGAL.ARG ACCESS])
[SELECTQ (FILENAMEFIELD FILE 'HOST)
(UNIX [SUBSTRING FILE (ADD1 (CONSTANT (NCHARS "{UNIX}"])
(DSK (LET [(VERSION (FILENAMEFIELD FILE 'VERSION]
(SETQ FILE (SLASHIT (PACKFILENAME 'HOST NIL 'VERSION NIL 'BODY FILE)))
(CL:IF (AND VERSION (IGREATERP VERSION 1))
(CONCAT FILE (CL:IF (FILENAMEFIELD FILE 'EXTENSION)
"."
"")
"~" VERSION "~")
FILE)))
(CL:WHEN (AND COPY (EQ ACCESS 'INPUT)
FILE)
(RESETLST
(CL:WHEN (\GETSTREAM FILE 'INPUT T) (* ; "Hope is randaccess")
[RESETSAVE (GETFILEPTR FILE)
`(PROGN (SETFILEPTR ,FILE OLDVALUE])
(COPYFILE FILE (CONCAT "{UNIX}/tmp/medley-" (L-CASE COPY)
"-"
(IDATE)
"-"
(RAND)
(CL:IF (FILENAMEFIELD FILE 'EXTENSION)
(CONCAT "." (FILENAMEFIELD FILE 'EXTENSION))
"")))))])])
(LET (UNAME VERSION)
[SELECTQ (FILENAMEFIELD FILE 'HOST)
((UNIX DSK)
(SETQ UNAME FILE))
(PROGN
(* ;; "Catch the streams as well as other devices (CORE, servers)")
[SETQ UNAME (OUTFILEP (CONCAT "{DSK}/tmp/medley-" (CL:IF COPY
(CONCAT (L-CASE COPY)
"-")
"")
(IDATE]
(CL:WHEN (AND COPY FILE)
(RESETLST
(CL:WHEN (\GETSTREAM FILE 'INPUT T)
(* ; "Hope it's randaccess")
[RESETSAVE (GETFILEPTR FILE)
`(PROGN (SETFILEPTR ,FILE OLDVALUE])
(* ;; "Let DSK pick a new version number, rather than RAND")
(COPYFILE FILE UNAME)))]
(SETQ VERSION (FILENAMEFIELD UNAME 'VERSION)) (* ; "Convert to Unix version. ")
(SETQ UNAME (PACKFILENAME 'VERSION NIL 'BODY UNAME))
(CL:WHEN (AND VERSION (IGREATERP VERSION 1))
(SETQ UNAME (CONCAT UNAME ".~" VERSION "~")))
(SETQ UNAME (SLASHIT UNAME NIL T))
(CL:IF (EQ (CHARCODE %.)
(NTHCHARCODE UNAME -1))
(SUBSTRING UNAME 1 -2)
UNAME)))])
)
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1146 1519 (ShellCommand 1146 . 1519)) (1521 1918 (ShellWhich 1521 . 1918)) (2008 16585
(ShellBrowser 2018 . 3790) (ShellBrowse 3792 . 4477) (ShellOpener 4479 . 6167) (ShellOpen 6169 . 11324
) (PROCESS-COMMAND 11326 . 11939) (SLASHIT 11941 . 13983) (UNIX-FILE-NAME 13985 . 16583)))))
(FILEMAP (NIL (1110 1483 (ShellCommand 1110 . 1483)) (1485 1882 (ShellWhich 1485 . 1882)) (1972 17841
(ShellBrowser 1982 . 3754) (ShellBrowse 3756 . 4441) (ShellOpener 4443 . 6131) (ShellOpen 6133 . 11612
) (PROCESS-COMMAND 11614 . 12227) (SLASHIT 12229 . 14566) (UNIX-FILE-NAME 14568 . 17839)))))
STOP

BIN
library/UNIXUTILS.DFASL
View File

Binary file not shown.