Add ShellOpen (and ShellOpener) to UNIXUTILS; fix small bug in UNIX-FILE-NAME (#1341)
* Add ShellOpener and ShellOpen to UNIXUTILS - used to open a file using the generic opener on this machine. Adapted ShellBrowse and ShellBrowser accordingly; fixed bug in UNIX-FILE-NAME where it fails if file does not exist and COPY is non-NIL and access is INPUT * Add return of error strings to ShellOpen
This commit is contained in:
Frank Halasz
GitHub
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Oct-2023 12:54:58" {WMEDLEY}<library>UNIXUTILS.;10 10535
|
||||
(FILECREATED " 8-Oct-2023 15:06:52" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;15 14696
|
||||
|
||||
:EDIT-BY rmk
|
||||
:CHANGES-TO (FNS ShellOpen UNIX-FILE-NAME ShellBrowser ShellBrowse ShellOpener)
|
||||
(VARS UNIXUTILSCOMS)
|
||||
|
||||
:CHANGES-TO (FUNCTIONS ShellWhich)
|
||||
|
||||
:PREVIOUS-DATE " 1-Oct-2023 20:52:23" {WMEDLEY}<library>UNIXUTILS.;9)
|
||||
:PREVIOUS-DATE " 8-Oct-2023 02:35:47" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;14
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UNIXUTILSCOMS)
|
||||
@@ -15,10 +15,11 @@
|
||||
((DECLARE%: EVAL@COMPILE DONTCOPY (* ; "For PROCESS-COMMAND")
|
||||
(FILES (FROM LOADUPS)
|
||||
EXPORTS.ALL))
|
||||
(GLOBALVARS ShellBrowser)
|
||||
(INITVARS (ShellBrowser))
|
||||
(GLOBALVARS ShellBrowser ShellOpener)
|
||||
(INITVARS (ShellBrowser)
|
||||
(ShellOpener))
|
||||
(FUNCTIONS ShellCommand ShellWhich)
|
||||
(FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT UNIX-FILE-NAME)
|
||||
(FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME)
|
||||
(PROPS (UNIXUTILS FILETYPE))))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -27,11 +28,13 @@
|
||||
)
|
||||
(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)
|
||||
@@ -55,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.")
|
||||
|
||||
@@ -106,15 +103,102 @@
|
||||
(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")
|
||||
@@ -183,7 +267,8 @@
|
||||
"")
|
||||
"~" VERSION "~")
|
||||
FILE)))
|
||||
(CL:WHEN (AND COPY (EQ ACCESS 'INPUT))
|
||||
(CL:WHEN (AND COPY (EQ ACCESS 'INPUT)
|
||||
FILE)
|
||||
(RESETLST
|
||||
(CL:WHEN (\GETSTREAM FILE 'INPUT T) (* ; "Hope is randaccess")
|
||||
[RESETSAVE (GETFILEPTR FILE)
|
||||
@@ -200,7 +285,7 @@
|
||||
|
||||
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (927 1300 (ShellCommand 927 . 1300)) (1302 1699 (ShellWhich 1302 . 1699)) (1700 10457 (
|
||||
ShellBrowser 1710 . 4233) (ShellBrowse 4235 . 5227) (PROCESS-COMMAND 5229 . 5842) (SLASHIT 5844 . 7886
|
||||
) (UNIX-FILE-NAME 7888 . 10455)))))
|
||||
(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