common-lisp/roswell.roswell
1
0
Fork 0
mirror of https://github.com/roswell/roswell.git synced 2026-09-10 07:16:17 -04:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

Ensure that path is checked for in update-hg and update-git.

Browse source
This commit is contained in:
Johan Sjölén 2019-01-03 21:53:29 +01:00
parent 32e380a288
commit 1ff35d0fc2
2 changed files with 42 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
lisp/update-git.lisp
View file

@ -3,21 +3,24 @@
(:use :cl :roswell.util))
(in-package :roswell.update.git)
(defun git (path)
(unless (pathnamep path)
(setf path (make-pathname
:type nil :name nil
:defaults (asdf:system-source-file (asdf:find-system path)))))
(when (probe-file (merge-pathnames ".git/" path))
(format *error-output* "git pull on ~A~%" path)
(unless (roswell.util:which "git")
(format *error-output* "git command not found~%")
(ros:quit 1))
(multiple-value-bind (o e exit-code)
(uiop/run-program:run-program
`(,(sh) "-lc" ,(format nil "cd ~S;git pull" (uiop:native-namestring path)))
:output t :error-output t :ignore-error-status t)
(declare (ignore o e))
(unless (zerop exit-code)
(ros:quit exit-code)))
t))
(defun git (&rest args)
(if (car args)
(let ((path (car args)))
(unless (pathnamep path)
(setf path (make-pathname
:type nil :name nil
:defaults (asdf:system-source-file (asdf:find-system path)))))
(when (probe-file (merge-pathnames ".git/" path))
(format *error-output* "git pull on ~A~%" path)
(unless (roswell.util:which "git")
(format *error-output* "git command not found~%")
(ros:quit 1))
(multiple-value-bind (o e exit-code)
(uiop/run-program:run-program
`(,(sh) "-lc" ,(format nil "cd ~S;git pull" (uiop:native-namestring path)))
:output t :error-output t :ignore-error-status t)
(declare (ignore o e))
(unless (zerop exit-code)
(ros:quit exit-code)))
t))
(format *error-output* "No path supplied")))

39
lisp/update-hg.lisp
View file

@ -3,21 +3,24 @@
(:use :cl :roswell.util))
(in-package :roswell.update.hg)
(defun hg (path)
(unless (pathnamep path)
(setf path (make-pathname
:type nil :name nil
:defaults (asdf:system-source-file (asdf:find-system path)))))
(when (probe-file (merge-pathnames ".hg/" path))
(format *error-output* "hg pull and update on ~A~%" path)
(unless (roswell.util:which "hg")
(format *error-output* "hg command not found~%")
(ros:quit 1))
(multiple-value-bind (o e exit-code)
(uiop/run-program:run-program
`(,(sh) "-lc" ,(format nil "cd ~S;hg pull && hg update" (uiop:native-namestring path)))
:output t :error-output t :ignore-error-status t)
(declare (ignore o e))
(unless (zerop exit-code)
(ros:quit exit-code)))
t))
(defun hg (&rest args)
(if (car args)
(let ((path (car args)))
(unless (pathnamep path)
(setf path (make-pathname
:type nil :name nil
:defaults (asdf:system-source-file (asdf:find-system path)))))
(when (probe-file (merge-pathnames ".hg/" path))
(format *error-output* "hg pull and update on ~A~%" path)
(unless (roswell.util:which "hg")
(format *error-output* "hg command not found~%")
(ros:quit 1))
(multiple-value-bind (o e exit-code)
(uiop/run-program:run-program
`(,(sh) "-lc" ,(format nil "cd ~S;hg pull && hg update" (uiop:native-namestring path)))
:output t :error-output t :ignore-error-status t)
(declare (ignore o e))
(unless (zerop exit-code)
(ros:quit exit-code)))
t))
(format *error-output* "No path supplied")))