Newer
Older
(sysdef-error-component ":in-order-to must be NIL or a list of components."
type name in-order-to)))
(defun sysdef-error-component (msg type name value)
(sysdef-error (concatenate 'string msg
"~&The value specified for ~(~A~) ~A is ~W")
type name value))
(defun resolve-symlinks (path)
#-allegro (truename path)
#+allegro (excl:pathname-resolve-symbolic-links path)
)
;;; run-shell-command functions for other lisp implementations will be
;;; gratefully accepted, if they do the same thing. If the docstring
;;; is ambiguous, send a bug report
"Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
synchronously execute the result using a Bourne-compatible shell, with

Daniel Barlow
committed
output to *verbose-out*. Returns the shell's exit code."
(let ((command (apply #'format nil control-string args)))

Daniel Barlow
committed
(format *verbose-out* "; $ ~A~%" command)
#+sbcl
(sb-impl::process-exit-code
(sb-ext:run-program
"/bin/sh"
(list "-c" command)

Daniel Barlow
committed
:input nil :output *verbose-out*))
#+(or cmu scl)
(ext:process-exit-code
(ext:run-program
"/bin/sh"
(list "-c" command)

Daniel Barlow
committed
:input nil :output *verbose-out*))
#+allegro

Daniel Barlow
committed
(excl:run-shell-command command :input nil :output *verbose-out*)
#+lispworks
(system:call-system-showing-output
command
:shell-type "/bin/sh"

Daniel Barlow
committed
:output-stream *verbose-out*)

Daniel Barlow
committed
#+clisp ;XXX not exactly *verbose-out*, I know
(ext:run-shell-command command :output :terminal :wait t)
#+openmcl
(nth-value 1
(ccl:external-process-status
(ccl:run-program "/bin/sh" (list "-c" command)

Daniel Barlow
committed
:input nil :output *verbose-out*
:wait t)))
#-(or openmcl clisp lispworks allegro scl cmu sbcl)
(error "RUN-SHELL-PROGRAM not implemented for this Lisp")
))
(defgeneric hyperdocumentation (package name doc-type))
(defmethod hyperdocumentation ((package symbol) name doc-type)
(hyperdocumentation (find-package package) name doc-type))
(defun hyperdoc (name doc-type)
(hyperdocumentation (symbol-package name) name doc-type))
#+sbcl
(eval-when (:compile-toplevel :load-toplevel :execute)
(when (sb-ext:posix-getenv "SBCL_BUILDING_CONTRIB")
(pushnew :sbcl-hooks-require *features*)))
#+(and sbcl sbcl-hooks-require)
(progn
(defun module-provide-asdf (name)

Daniel Barlow
committed
(handler-bind ((style-warning #'muffle-warning))
(let* ((*verbose-out* (make-broadcast-stream))
(system (asdf:find-system name nil)))
(when system
(asdf:operate 'asdf:load-op name)
t))))
(pushnew

Daniel Barlow
committed
'(merge-pathnames "systems/"
(truename (sb-ext:posix-getenv "SBCL_HOME")))
*central-registry*)

Daniel Barlow
committed
'(merge-pathnames "site-systems/"
(truename (sb-ext:posix-getenv "SBCL_HOME")))
*central-registry*)
(pushnew

Daniel Barlow
committed
'(merge-pathnames ".sbcl/systems/"
(user-homedir-pathname))
(pushnew 'module-provide-asdf sb-ext:*module-provider-functions*))
(provide 'asdf)