UNIXUTILS: Added UNIX-FILE-NAME
Produces a Unix filename corresponding to a Medley file name (slashes, version number). For use in ShellCommand an PROCESS-COMMAND.
This commit is contained in:
@@ -1,12 +1,13 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "23-Sep-2023 15:30:26" {WMEDLEY}<library>UNIXUTILS.;7 7943
|
(FILECREATED " 1-Oct-2023 20:52:23" {WMEDLEY}<library>UNIXUTILS.;9 10573
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS SLASHIT)
|
:CHANGES-TO (FNS UNIX-FILE-NAME)
|
||||||
|
(VARS UNIXUTILSCOMS)
|
||||||
|
|
||||||
:PREVIOUS-DATE "22-Sep-2023 15:28:19" {WMEDLEY}<library>UNIXUTILS.;6)
|
:PREVIOUS-DATE "23-Sep-2023 15:30:26" {WMEDLEY}<library>UNIXUTILS.;7)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT UNIXUTILSCOMS)
|
(PRETTYCOMPRINT UNIXUTILSCOMS)
|
||||||
@@ -18,7 +19,7 @@
|
|||||||
(GLOBALVARS ShellBrowser)
|
(GLOBALVARS ShellBrowser)
|
||||||
(INITVARS (ShellBrowser))
|
(INITVARS (ShellBrowser))
|
||||||
(FUNCTIONS ShellCommand ShellWhich)
|
(FUNCTIONS ShellCommand ShellWhich)
|
||||||
(FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT)
|
(FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT UNIX-FILE-NAME)
|
||||||
(PROPS (UNIXUTILS FILETYPE))))
|
(PROPS (UNIXUTILS FILETYPE))))
|
||||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||||
|
|
||||||
@@ -155,11 +156,52 @@
|
|||||||
SLASHED
|
SLASHED
|
||||||
(CONCAT (SUBSTRING X 1 (SUB1 DIRPOS))
|
(CONCAT (SUBSTRING X 1 (SUB1 DIRPOS))
|
||||||
SLASHED))])
|
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)
|
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (902 1275 (ShellCommand 902 . 1275)) (1277 1676 (ShellWhich 1277 . 1676)) (1677 7865 (
|
(FILEMAP (NIL (963 1336 (ShellCommand 963 . 1336)) (1338 1737 (ShellWhich 1338 . 1737)) (1738 10495 (
|
||||||
ShellBrowser 1687 . 4210) (ShellBrowse 4212 . 5204) (PROCESS-COMMAND 5206 . 5819) (SLASHIT 5821 . 7863
|
ShellBrowser 1748 . 4271) (ShellBrowse 4273 . 5265) (PROCESS-COMMAND 5267 . 5880) (SLASHIT 5882 . 7924
|
||||||
)))))
|
) (UNIX-FILE-NAME 7926 . 10493)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
Reference in New Issue
Block a user