Skip to content
Snippets Groups Projects
Commit c43c16b3 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Use os-cond in more places.

parent d32057a3
No related branches found
No related tags found
No related merge requests found
......@@ -174,14 +174,16 @@ Going forward, we recommend new users should be using the source-registry.
:truename truename))
(return file))
#-(or clisp genera) ; clisp doesn't need it, plain genera doesn't have read-sequence(!)
(when (and (os-windows-p) (physical-pathname-p defaults))
(let ((shortcut
(make-pathname
:defaults defaults :case :local
:name (strcat name ".asd")
:type "lnk")))
(when (probe-file* shortcut)
(ensure-pathname (parse-windows-shortcut shortcut) :namestring :native)))))))
(os-cond
((os-windows-p)
(when (physical-pathname-p defaults)
(let ((shortcut
(make-pathname
:defaults defaults :case :local
:name (strcat name ".asd")
:type "lnk")))
(when (probe-file* shortcut)
(ensure-pathname (parse-windows-shortcut shortcut) :namestring :native)))))))))
(defun sysdef-central-registry-search (system)
(let ((name (primary-system-name system))
......
......@@ -331,7 +331,8 @@ this function tries to locate the Windows FOLDER for one of
(defun config-system-pathnames (&optional app &rest more)
"Determine system user configuration directories"
(when (os-unix-p) (list (resolve-location `(,(parse-unix-namestring "/etc/") ,app ,more)))))
(os-cond
((os-unix-p) (list (resolve-location `(,(parse-unix-namestring "/etc/") ,app ,more))))))
(defun clean-search-pathnames (dirs)
"Parse strings as unix namestrings and remove duplicates and non absolute-pathnames in a list"
......
......@@ -37,8 +37,9 @@
#+(or cmu scl) (ext:unix-namestring p nil)
#+sbcl (sb-ext:native-namestring p)
#-(or clozure cmu sbcl scl)
(if (os-unix-p) (unix-namestring p)
(namestring p)))))
(os-cond
((os-unix-p) (unix-namestring p))
(t (namestring p))))))
(defun parse-native-namestring (string &rest constraints &key ensure-directory &allow-other-keys)
"From a native namestring suitable for use by the operating system, return
......@@ -50,9 +51,9 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
#+clozure (ccl:native-to-pathname string)
#+sbcl (sb-ext:parse-native-namestring string)
#-(or clozure sbcl)
(if (os-unix-p)
(parse-unix-namestring string :ensure-directory ensure-directory)
(parse-namestring string)))))
(os-cond
((os-unix-p) (parse-unix-namestring string :ensure-directory ensure-directory))
(t (parse-namestring string))))))
(pathname
(if ensure-directory
(and pathname (ensure-directory-pathname pathname))
......@@ -501,7 +502,7 @@ Note that this operation is usually NOT thread-safe."
(with-upgradability ()
(defun inter-directory-separator ()
"What character does the current OS conventionally uses to separate directories?"
(if (os-unix-p) #\: #\;))
(os-cond ((os-unix-p) #\:) (t #\;)))
(defun split-native-pathnames-string (string &rest constraints &key &allow-other-keys)
"Given a string of pathnames specified in native OS syntax, separate them in a list,
......
......@@ -656,9 +656,10 @@ given DEFAULTS-PATHNAME as a base pathname."
(defun directorize-pathname-host-device (pathname)
"Given a PATHNAME, return a pathname that has representations of its HOST and DEVICE components
added to its DIRECTORY component. This is useful for output translations."
#+(or unix abcl)
(when (and #+abcl (os-unix-p) (physical-pathname-p pathname))
(return-from directorize-pathname-host-device pathname))
(os-cond
((os-unix-p)
(when (physical-pathname-p pathname)
(return-from directorize-pathname-host-device pathname))))
(let* ((root (pathname-root pathname))
(wild-root (wilden root))
(absolute-pathname (merge-pathnames* pathname root))
......
......@@ -739,7 +739,9 @@ It returns a process-info plist with possible keys:
(etypecase command
(string command)
(list (escape-shell-command
(if (os-unix-p) (cons "exec" command) command)))))
(os-cond
((os-unix-p) (cons "exec" command))
(t command))))))
(defun %redirected-system-command (command in out err directory) ;; helper for %USE-SYSTEM
(flet ((redirect (spec operator)
......@@ -756,14 +758,16 @@ It returns a process-info plist with possible keys:
(escape-shell-token (native-namestring pathname)))))))
(multiple-value-bind (before after)
(let ((normalized (%normalize-system-command command)))
(if (os-unix-p)
(values '("exec") (list " ; " normalized))
(values (list normalized) ())))
(os-cond
((os-unix-p) (values '("exec") (list " ; " normalized)))
(t (values (list normalized) ()))))
(reduce/strcat
(append
before (redirect in " <") (redirect out " >") (redirect err " 2>")
(when (and directory (os-unix-p)) ;; NB: unless on Unix, %system uses with-current-directory
`(" ; cd " ,(escape-shell-token (native-namestring directory))))
(os-cond
((os-unix-p)
(when directory ;; NB: unless on Unix, %system uses with-current-directory
`(" ; cd " ,(escape-shell-token (native-namestring directory))))))
after)))))
(defun %system (command &rest keys
......@@ -782,7 +786,7 @@ It returns a process-info plist with possible keys:
(apply '%run-program %command :wait t
:input :interactive :output :interactive :error-output :interactive keys))
#-(or clisp (and lispworks os-windows))
(with-current-directory ((unless (os-unix-p) directory))
(with-current-directory ((os-cond ((not (os-unix-p)) directory)))
#+abcl (ext:run-shell-command %command)
#+cormanlisp (win32:system %command)
#+(or clasp ecl) (let ((*standard-input* *stdin*)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment