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:
@@ -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.
Reference in New Issue
Block a user