Frank Halasz
GitHub
@@ -1,26 +1,40 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-Jun-2023 13:30:18" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;11 4989
|
||||
(FILECREATED " 8-Oct-2023 15:06:52" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;15 14696
|
||||
|
||||
:CHANGES-TO (FUNCTIONS ShellWhich)
|
||||
:CHANGES-TO (FNS ShellOpen UNIX-FILE-NAME ShellBrowser ShellBrowse ShellOpener)
|
||||
(VARS UNIXUTILSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "18-Jan-2023 20:36:10" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;8
|
||||
:PREVIOUS-DATE " 8-Oct-2023 02:35:47" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;14
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UNIXUTILSCOMS)
|
||||
|
||||
(RPAQQ UNIXUTILSCOMS ((GLOBALVARS ShellBrowser)
|
||||
(INITVARS (ShellBrowser))
|
||||
(FUNCTIONS ShellCommand ShellWhich)
|
||||
(FNS ShellBrowser ShellBrowse)))
|
||||
(RPAQQ UNIXUTILSCOMS
|
||||
((DECLARE%: EVAL@COMPILE DONTCOPY (* ; "For PROCESS-COMMAND")
|
||||
(FILES (FROM LOADUPS)
|
||||
EXPORTS.ALL))
|
||||
(GLOBALVARS ShellBrowser ShellOpener)
|
||||
(INITVARS (ShellBrowser)
|
||||
(ShellOpener))
|
||||
(FUNCTIONS ShellCommand ShellWhich)
|
||||
(FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME)
|
||||
(PROPS (UNIXUTILS FILETYPE))))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(FILESLOAD (FROM LOADUPS)
|
||||
EXPORTS.ALL)
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS ShellBrowser)
|
||||
(GLOBALVARS ShellBrowser ShellOpener)
|
||||
)
|
||||
|
||||
(RPAQ? ShellBrowser )
|
||||
|
||||
(RPAQ? ShellOpener )
|
||||
|
||||
(CL:DEFUN ShellCommand (Cmd &OPTIONAL (Output T))
|
||||
(CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM Cmd))
|
||||
(CL:TAGBODY [SETFILEINFO s 'ENDOFSTREAMOP #'(CL:LAMBDA (s)
|
||||
@@ -44,50 +58,44 @@
|
||||
|
||||
(ShellBrowser
|
||||
[LAMBDA NIL (* ; "Edited 18-Jan-2023 20:30 by FGH")
|
||||
(OR ShellBrowser (SETQ ShellBrowser (LET (CMDPATH)
|
||||
(if (STRPOS "darwin" (OR (UNIX-GETENV "OSTYPE")
|
||||
(UNIX-GETENV "PATH")))
|
||||
then
|
||||
(* ;; " MacOS")
|
||||
|
||||
"open"
|
||||
elseif (SETQ CMDPATH (ShellWhich "wslview"))
|
||||
then
|
||||
(* ;; "windows with WSL")
|
||||
(* ;; "Figure out the browser to use for the ShellOpen/ShellBrowse functions. ")
|
||||
|
||||
CMDPATH
|
||||
elseif (SETQ CMDPATH (ShellWhich "xdg-open"))
|
||||
then
|
||||
(* ;; "Linux systems with xdg-utils installed ")
|
||||
(* ;; " Ordinarily, this would be the same as the generic ShellOpener.")
|
||||
|
||||
CMDPATH
|
||||
elseif (SETQ CMDPATH (ShellWhich "git"))
|
||||
then
|
||||
(* ;; " Systems with git installed")
|
||||
(* ;; " But if a generic ShellOpener is not found, then there are some additional")
|
||||
|
||||
(CONCAT CMDPATH " web--browse")
|
||||
(* ; "")
|
||||
elseif (SETQ CMDPATH (ShellWhich "lynx"))
|
||||
then
|
||||
(* ;; " Systems with lynx installed")
|
||||
(* ;; " possibilities that will work for http/https URLs. If one of these exists return it.")
|
||||
|
||||
(LET (CMDPATH2)
|
||||
(if (SETQ CMDPATH2 (ShellWhich "xterm"))
|
||||
then (CONCAT CMDPATH2 " -e " CMDPATH)
|
||||
else (LIST CMDPATH)))
|
||||
else
|
||||
(* ;;
|
||||
" Out of ideas - just return a dummy function")
|
||||
(OR ShellBrowser (SETQ ShellBrowser
|
||||
(if (NOT (STREQUAL (ShellOpener)
|
||||
"true"))
|
||||
then ShellOpener
|
||||
else (LET (CMDPATH)
|
||||
(if (SETQ CMDPATH (ShellWhich "git"))
|
||||
then
|
||||
(* ;; " Systems with git installed")
|
||||
|
||||
"true"])
|
||||
CMDPATH
|
||||
elseif (SETQ CMDPATH (ShellWhich "lynx"))
|
||||
then
|
||||
(* ;; " Systems with lynx installed")
|
||||
|
||||
(LET (CMDPATH2)
|
||||
(if (SETQ CMDPATH2 (ShellWhich "xterm"))
|
||||
then (CONCAT CMDPATH2 " -e " CMDPATH)
|
||||
else (LIST CMDPATH)))
|
||||
else
|
||||
(* ;; " Out of ideas - just return a dummy function")
|
||||
|
||||
"true"])
|
||||
|
||||
(ShellBrowse
|
||||
[LAMBDA (URL) (* ; "Edited 18-Jan-2023 20:32 by FGH")
|
||||
|
||||
(* ;; " Open the web page specified by URL using an external browser via shell call")
|
||||
|
||||
(* ;;
|
||||
" URL must start with http:// or https:// (case ireelevant) or this function will just return NIL.")
|
||||
(* ;; " URL must start with http:// or https:// or file:/// (case ireelevant) or this function will just return NIL.")
|
||||
|
||||
(* ;; " Returns T otherwise.")
|
||||
|
||||
@@ -95,17 +103,189 @@
|
||||
(if (OR (EQ (STRPOS "http://" (L-CASE URL))
|
||||
1)
|
||||
(EQ (STRPOS "https://" (L-CASE URL))
|
||||
1)
|
||||
(EQ (STRPOS "file:///" (L-CASE URL))
|
||||
1))
|
||||
then (ShellOpen URL)
|
||||
else NIL])
|
||||
|
||||
(ShellOpener
|
||||
[LAMBDA NIL
|
||||
|
||||
(* ;; "Find an %"opener%" that will open files (and URLs) using the appropriate/default app on this machine")
|
||||
|
||||
(OR ShellOpener (SETQ ShellOpener (LET (CMDPATH)
|
||||
(if (SETQ CMDPATH (ShellWhich "wslview"))
|
||||
then
|
||||
(* ;; "windows with WSL")
|
||||
|
||||
CMDPATH
|
||||
elseif (SETQ CMDPATH (ShellWhich "cygstart"))
|
||||
then
|
||||
(* ;; "windows with cygwin")
|
||||
|
||||
CMDPATH
|
||||
elseif (SETQ CMDPATH (ShellWhich "xdg-open"))
|
||||
then
|
||||
(* ;; "Linux systems with xdg-utils installed ")
|
||||
|
||||
CMDPATH
|
||||
elseif (SETQ CMDPATH (ShellWhich "open"))
|
||||
then
|
||||
(* ;; " MacOS open")
|
||||
|
||||
CMDPATH
|
||||
else
|
||||
(* ;;
|
||||
" Out of ideas - just return a dummy function")
|
||||
|
||||
"true"])
|
||||
|
||||
(ShellOpen
|
||||
[LAMBDA (FilenameOrURL)
|
||||
|
||||
(* ;; "Open the file or URL using the generic %"opener%" for this machine via a shell call.")
|
||||
|
||||
(* ;; " If FilenameOrURL starts with %"http://%" or %"https://%" or %"file:///%", then we use (ShellBrowser) as")
|
||||
|
||||
(* ;; " the %"opener%" (which includes some browsers on a machine without a generic opener).")
|
||||
|
||||
(* ;;
|
||||
" Otherwise FilenameOrURL is assumed to be a filename and will be opened using (ShellOpener).")
|
||||
|
||||
(* ;; " Returns T is all goes well; returns an error string if all does not go well")
|
||||
|
||||
(SETQ FilenameOrURL (MKSTRING FilenameOrURL))
|
||||
(if (OR (EQ (STRPOS "http://" (L-CASE FilenameOrURL))
|
||||
1)
|
||||
(EQ (STRPOS "https://" (L-CASE FilenameOrURL))
|
||||
1)
|
||||
(EQ (STRPOS "file://" (L-CASE FilenameOrURL))
|
||||
1))
|
||||
then (LET ((BROWSER (ShellBrowser)))
|
||||
(if (LISTP BROWSER)
|
||||
then (CHAT 'SHELL NIL (CONCAT (CAR BROWSER)
|
||||
" '" URL "'"))
|
||||
else (ShellCommand (CONCAT BROWSER " '" URL "'"
|
||||
" >>/tmp/ShellBrowser-warnings-$$.txt")))
|
||||
T)
|
||||
else NIL])
|
||||
(if (NOT (STREQUAL BROWSER "true"))
|
||||
then (if (LISTP BROWSER)
|
||||
then (CHAT 'SHELL NIL (CONCAT (CAR BROWSER)
|
||||
" '" FilenameOrURL "'"))
|
||||
else (ShellCommand (CONCAT BROWSER " '" FilenameOrURL "'"
|
||||
" >>/tmp/ShellBrowser-warnings-$$.txt"))
|
||||
T)
|
||||
else (CONCAT "Unable to find a browser to open: " FilenameOrURL)))
|
||||
else
|
||||
(LET ((OPENER (ShellOpener))
|
||||
(UNIXFILE (UNIX-FILE-NAME FilenameOrURL 'INPUT T)))
|
||||
(if (NOT UNIXFILE)
|
||||
then (CONCAT "File not found: " FilenameOrURL)
|
||||
elseif (NOT (STREQUAL OPENER "true"))
|
||||
then (CL:WITH-OPEN-STREAM
|
||||
(SHELLSTREAM (OPENSTREAM (CONCAT "{CORE}SHELLOUT" (RAND))
|
||||
'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 (CONCAT "Unable to find a file opener to open: " FilenameOrURL])
|
||||
|
||||
(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)
|
||||
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))
|
||||
"")))))])])
|
||||
)
|
||||
|
||||
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (664 1037 (ShellCommand 664 . 1037)) (1039 1436 (ShellWhich 1039 . 1436)) (1437 4966 (
|
||||
ShellBrowser 1447 . 3970) (ShellBrowse 3972 . 4964)))))
|
||||
(FILEMAP (NIL (1144 1517 (ShellCommand 1144 . 1517)) (1519 1916 (ShellWhich 1519 . 1916)) (1917 14618
|
||||
(ShellBrowser 1927 . 3675) (ShellBrowse 3677 . 4362) (ShellOpener 4364 . 6052) (ShellOpen 6054 . 9357)
|
||||
(PROCESS-COMMAND 9359 . 9972) (SLASHIT 9974 . 12016) (UNIX-FILE-NAME 12018 . 14616)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user