1
0
mirror of synced 2026-03-09 20:48:19 +00:00

Fix ShellOpen, add UNIX-TMP-FILE-NAME

ShellOpen was calling SLASHIT before calling INFILEP, which would fail on files with spaces in their names.
This commit is contained in:
rmkaplan
2025-12-28 21:24:48 -08:00
parent d2f08479aa
commit 15667c2101
2 changed files with 47 additions and 32 deletions

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Nov-2025 14:21:13" {WMEDLEY}<library>UNIXUTILS.;35 18084
(FILECREATED "28-Dec-2025 18:26:10" {WMEDLEY}<library>UNIXUTILS.;43 18632
:EDIT-BY rmk
:CHANGES-TO (VARS UNIXUTILSCOMS)
:CHANGES-TO (FNS ShellOpen)
:PREVIOUS-DATE " 4-Nov-2025 10:11:10" {WMEDLEY}<library>UNIXUTILS.;34)
:PREVIOUS-DATE "27-Dec-2025 21:25:11" {WMEDLEY}<library>UNIXUTILS.;42)
(PRETTYCOMPRINT UNIXUTILSCOMS)
@@ -21,7 +21,8 @@
(FUNCTIONS ShellCommand ShellWhich)
(ADDVARS (MEDLEY-INIT-VARS (ShellBrowser NIL RESET)
(ShellOpener NIL RESET)))
(FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME)
(FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME
UNIX-TMP-FILE-NAME)
(PROPS (UNIXUTILS FILETYPE))))
(DECLARE%: EVAL@COMPILE DONTCOPY
@@ -147,7 +148,8 @@
"true"])
(ShellOpen
[LAMBDA (FilenameOrURL) (* ; "Edited 10-Sep-2025 15:29 by rmk")
[LAMBDA (FilenameOrURL) (* ; "Edited 28-Dec-2025 18:26 by rmk")
(* ; "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.")
@@ -184,7 +186,11 @@
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))
else (SETQ FilenameOrURL (TRUEFILENAME FilenameOrURL))
(* ;; "RMK: UNVERSIONED is in the Lisp space, I removed the SLASHIT there because it adds \ in front of spaces which screws up the following INFILEP.")
(LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION))
(UNPACKED (UNPACKFILENAME.STRING FULLNAME))
(NEWNAME (CONCAT (LISTGET UNPACKED 'NAME)
"~"
@@ -197,8 +203,7 @@
(SETQ FN (PACKFILENAME.STRING UNPACKED))
(if (STREQUAL (SUBSTRING FN -1)
".")
then (SETQ FN (SUBSTRING UNIXFILE 1 -2)))
(SETQ FN (SLASHIT FN]
then (SETQ FN (SUBSTRING UNIXFILE 1 -2]
(UNVERSIONED.EXISTS (INFILEP (CONCAT "{UNIX}" UNVERSIONED)))
(TMPDIR (CONCAT "/tmp/" (RAND 1000 9999)))
(TARGETFILE.LISP (PACKFILENAME.STRING 'HOST "{UNIX}" 'DIRECTORY TMPDIR
@@ -274,15 +279,15 @@
SLASHED))])
(UNIX-FILE-NAME
[LAMBDA (FILE ACCESS COPY) (* ; "Edited 27-Sep-2025 16:24 by rmk")
[LAMBDA (FILE ACCESS COPY EXTENSION) (* ; "Edited 27-Dec-2025 21:24 by rmk")
(* ; "Edited 26-Dec-2025 10:58 by rmk")
(* ; "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 doesn't have the Medley version convention. If FILE does not have a corresponding Unix name (e.g. NODIRCORE), 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.")
(* ;; "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.")
(* ; "Might catch NODIRCORE")
(CL:WHEN FILE
(SETQ FILE (TRUEFILENAME FILE))
(CL:UNLESS (STREAMP FILE)
@@ -299,35 +304,45 @@
(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]
(SETQ UNAME (UNIX-TMP-FILE-NAME (CL:IF COPY
(L-CASE COPY)
"")
EXTENSION))
(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)))])
(SLASHIT UNAME NIL T)))])
(UNIX-TMP-FILE-NAME
[LAMBDA (NAME EXT HOST) (* ; "Edited 26-Dec-2025 17:37 by rmk")
(* ;;
 "Returns a unique {UNIX}/tmp/ name that includes NAME as a hint and perhaps a useful extension ")
(* ;; "Let DSK pick a new version, rather than RAND")
(LET* [[UNAME (OUTFILEP (CONCAT "{DSK}/tmp/medley-" NAME "-" (IDATE]
(VERSION (FILENAMEFIELD UNAME 'VERSION]
(SETQ UNAME (PACKFILENAME 'HOST (OR HOST 'UNIX)
'VERSION NIL 'BODY UNAME))
(CL:IF (EQ (CHARCODE %.)
(NTHCHARCODE UNAME -1))
(SETQ UNAME (SUBSTRING UNAME 1 -2)))
(CL:IF (AND VERSION (IGREATERP VERSION 1))
(SETQ UNAME (CONCAT UNAME ".~" VERSION "~")))
(CL:IF EXT
(SETQ UNAME (CONCAT UNAME "." (L-CASE EXT))))
UNAME])
)
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1137 1510 (ShellCommand 1137 . 1510)) (1512 1909 (ShellWhich 1512 . 1909)) (2019 18006
(ShellBrowser 2029 . 3801) (ShellBrowse 3803 . 4488) (ShellOpener 4490 . 6178) (ShellOpen 6180 . 11659
) (PROCESS-COMMAND 11661 . 12274) (SLASHIT 12276 . 14731) (UNIX-FILE-NAME 14733 . 18004)))))
(FILEMAP (NIL (1165 1538 (ShellCommand 1165 . 1538)) (1540 1937 (ShellWhich 1540 . 1937)) (2047 18554
(ShellBrowser 2057 . 3829) (ShellBrowse 3831 . 4516) (ShellOpener 4518 . 6206) (ShellOpen 6208 . 11977
) (PROCESS-COMMAND 11979 . 12592) (SLASHIT 12594 . 15049) (UNIX-FILE-NAME 15051 . 17651) (
UNIX-TMP-FILE-NAME 17653 . 18552)))))
STOP

Binary file not shown.