github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-03-02 18:14:44 +00:00
Code Issues Projects Releases Wiki Activity

Pick up master changes

Browse Source
This commit is contained in:
Larry Masinter
2023-10-02 12:36:39 -07:00
parent 97b19f1b96
commit 877c6fbf17
2 changed files with 12 additions and 108 deletions
Download Patch File Download Diff File Expand all files Collapse all files

120
library/UNIXUTILS
View File

@@ -1,31 +1,19 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 1-Oct-2023 20:52:23" {WMEDLEY}<library>UNIXUTILS.;9 10573
(FILECREATED "16-Jun-2023 13:30:18" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;11 4989
:EDIT-BY rmk
:CHANGES-TO (FUNCTIONS ShellWhich)
:CHANGES-TO (FNS UNIX-FILE-NAME)
(VARS UNIXUTILSCOMS)
:PREVIOUS-DATE "23-Sep-2023 15:30:26" {WMEDLEY}<library>UNIXUTILS.;7)
:PREVIOUS-DATE "18-Jan-2023 20:36:10" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;8
)
(PRETTYCOMPRINT UNIXUTILSCOMS)
(RPAQQ UNIXUTILSCOMS
((DECLARE%: EVAL@COMPILE DONTCOPY (* ; "For PROCESS-COMMAND")
(FILES (FROM LOADUPS)
EXPORTS.ALL))
(GLOBALVARS ShellBrowser)
(INITVARS (ShellBrowser))
(FUNCTIONS ShellCommand ShellWhich)
(FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT UNIX-FILE-NAME)
(PROPS (UNIXUTILS FILETYPE))))
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (FROM LOADUPS)
EXPORTS.ALL)
)
(RPAQQ UNIXUTILSCOMS ((GLOBALVARS ShellBrowser)
(INITVARS (ShellBrowser))
(FUNCTIONS ShellCommand ShellWhich)
(FNS ShellBrowser ShellBrowse)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS ShellBrowser)
@@ -44,14 +32,14 @@
(CL:DEFUN ShellWhich (Cmd) (* ; "Edited 18-Jan-2023 13:19 by FGH")
[CL:WITH-OPEN-STREAM (S (OPENSTREAM '{NODIRCORE} 'BOTH))
(ShellCommand (CONCAT "which " Cmd)
(ShellCommand (CONCAT "command -v " Cmd)
S)
(COND
((EQ (GETEOFPTR S)
0)
NIL)
(T (SETFILEPTR S 0)
(MKSTRING (READ S])
(RSTRING S])
(DEFINEQ
(ShellBrowser
@@ -116,92 +104,8 @@
" >>/tmp/ShellBrowser-warnings-$$.txt")))
T)
else NIL])
(PROCESS-COMMAND
[LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk")
(* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.")
(CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD))
(BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1)
of PS))
0))) DO (BLOCK) FINALLY (RETURN CODE])
(SLASHIT
[LAMBDA (X LCASEDIRS NOHOST) (* ; "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.")
(* ;; "Perhaps this should be a per file-device operation that maps device names into the local file system.")
(* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, and perhaps lower-casing the directory. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ")
(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]
(CL:WHEN (AND LCASEDIRS LASTDIRPOS)
(SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS)))
(SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS))
(OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS))
""))))
(CL:IF (OR (EQ DIRPOS 1)
NOHOST)
SLASHED
(CONCAT (SUBSTRING X 1 (SUB1 DIRPOS))
SLASHED))])
(UNIX-FILE-NAME
[LAMBDA (FILE ACCESS COPY) (* ; "Edited 1-Oct-2023 20:52 by rmk")
(* ;; "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")
(CL:WHEN FILE
(SETQ FILE (TRUEFILENAME FILE))
(CL:UNLESS (STREAMP FILE)
[SETQ FILE (\GETFILENAME FILE (SELECTQ ACCESS
(OUTPUT 'NEW)
(INPUT 'OLD)
(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))
(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))
"")))))])])
)
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (963 1336 (ShellCommand 963 . 1336)) (1338 1737 (ShellWhich 1338 . 1737)) (1738 10495 (
ShellBrowser 1748 . 4271) (ShellBrowse 4273 . 5265) (PROCESS-COMMAND 5267 . 5880) (SLASHIT 5882 . 7924
) (UNIX-FILE-NAME 7926 . 10493)))))
(FILEMAP (NIL (664 1037 (ShellCommand 664 . 1037)) (1039 1436 (ShellWhich 1039 . 1436)) (1437 4966 (
ShellBrowser 1447 . 3970) (ShellBrowse 3972 . 4964)))))
STOP

BIN
library/UNIXUTILS.DFASL
View File

Binary file not shown.