Skip to content
Snippets Groups Projects
asdf.lisp 38.1 KiB
Newer Older
    (sysdef-error-component ":in-order-to must be NIL or a list of components."
Kevin Rosenberg's avatar
Kevin Rosenberg committed
			   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))
Daniel Barlow's avatar
Daniel Barlow committed

(defun resolve-symlinks (path)
  #-allegro (truename path)
  #+allegro (excl:pathname-resolve-symbolic-links path)
  )
Daniel Barlow's avatar
Daniel Barlow committed
;;; optional extras

;;; 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

Daniel Barlow's avatar
Daniel Barlow committed
(defun run-shell-command (control-string &rest args)
  "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
synchronously execute the result using a Bourne-compatible shell, with
output to *verbose-out*.  Returns the shell's exit code."
Daniel Barlow's avatar
Daniel Barlow committed
  (let ((command (apply #'format nil control-string args)))
    (format *verbose-out* "; $ ~A~%" command)
Daniel Barlow's avatar
Daniel Barlow committed
    (sb-impl::process-exit-code
     (sb-ext:run-program  
      "/bin/sh"
      (list  "-c" command)
Daniel Barlow's avatar
Daniel Barlow committed
    (ext:process-exit-code
     (ext:run-program  
      "/bin/sh"
      (list  "-c" command)
    (excl:run-shell-command command :input nil :output *verbose-out*)
    
    #+lispworks
    (system:call-system-showing-output
     command
     :shell-type "/bin/sh"
    #+clisp				;XXX not exactly *verbose-out*, I know
    (ext:run-shell-command  command :output :terminal :wait t)

    #+openmcl
	       (ccl:external-process-status
		(ccl:run-program "/bin/sh" (list "-c" command)
				 :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))


Daniel Barlow's avatar
Daniel Barlow committed
(pushnew :asdf *features*)

#+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)
    (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))))
   '(merge-pathnames "systems/"
     (truename (sb-ext:posix-getenv "SBCL_HOME")))
   '(merge-pathnames "site-systems/"
     (truename (sb-ext:posix-getenv "SBCL_HOME")))
   *central-registry*)
  
  (pushnew
   '(merge-pathnames ".sbcl/systems/"
     (user-homedir-pathname))
   *central-registry*)
  
  (pushnew 'module-provide-asdf sb-ext:*module-provider-functions*))