(defcommand ql-origin
  ((system quicklisp-system-designator
    :help "System to show the origin of."))
  :accepts '(arg-quicklisp-system-designator)
  (when (not (or system *input*))
    (error "Please supply a system."))
  (when (not system)
    (setf system (ql-dist:system-file-name *input*)))
  (let* ((project-name (string-downcase system))
	 (ql-system (ql-dist:find-system project-name))
	 (project-file (glob:expand-tilde
			(nos:path-append
			 "~/stuff/lispy/quicklisp-projects/projects"
			 (if ql-system
			     (ql-dist:project-name (ql-dist:release ql-system))
			     project-name)
			 "source.txt"))))
  (when (not (nos:file-exists project-file))
    (error "The system isn't in quicklisp. Maybe you should update ~
            quicklisp-projects?"))
  (setf *output*
	(write-string
	 (slurp project-file)))))