mirror of
https://github.com/roswell/roswell.git
synced 2026-09-10 07:16:17 -04:00
69 lines
2.8 KiB
Common Lisp
69 lines
2.8 KiB
Common Lisp
#!/bin/sh
|
|
#|-*- mode:lisp -*-|#
|
|
#|Delete installed implementations
|
|
exec ros -Q -m roswell -L sbcl-bin -- $0 "$@"
|
|
|#
|
|
|
|
(progn
|
|
(ros:include "util")
|
|
(ros:quicklisp :environment nil)
|
|
(unless (find-package :uiop)
|
|
(ql:quickload :uiop :silent t)))
|
|
|
|
(defpackage :ros.script.delete.3672011943
|
|
(:use :cl :ros.util))
|
|
(in-package :ros.script.delete.3672011943)
|
|
|
|
(defun delete-dump (params)
|
|
(declare (ignorable params))
|
|
(let* ((impl (and (second params) (parse-version-spec (second params))))
|
|
(name (first params))
|
|
path)
|
|
(let ((lisp (or (first impl) (config "default.lisp"))))
|
|
(setf impl (format nil "~A/~A" lisp
|
|
(or (second impl) (config (format nil "~A.version" lisp))))))
|
|
(setf path (make-pathname :name name
|
|
:type (core-extention impl)
|
|
:defaults
|
|
(merge-pathnames (format nil "impls/~A/~A/~A/dump/"
|
|
(uname-m) (uname) impl)
|
|
(homedir))))
|
|
(if (probe-file path)
|
|
(delete-file path)
|
|
(format *error-output* "The specified image doesn't exist \"~A ~A\"~%" name impl))))
|
|
|
|
(defun main (&rest r)
|
|
(let* ((default (config "default.lisp"))
|
|
(verstring (format nil "~A.version" default))
|
|
(config (format nil "~A/~A" default (config verstring))))
|
|
(cond
|
|
((null r)
|
|
(format *error-output* "Usage: ros delete dump [IMAGES...]~%")
|
|
(format *error-output* "Usage: ros delete [IMPLS...]~2%")
|
|
(format *error-output* "Possible subcommands:~%")
|
|
(finish-output *error-output*)
|
|
(format t "dump~%")
|
|
(finish-output)
|
|
(format *error-output* "~%Possible candidates of installed impls for deletion:~2%")
|
|
(finish-output *error-output*)
|
|
(ros:roswell '("list" "installed") *standard-output*))
|
|
((equal (first r) "dump")
|
|
(delete-dump (rest r)))
|
|
((let ((func (module "delete" (first r))))
|
|
(when func
|
|
(apply func (rest r)))))
|
|
(t
|
|
(let* ((impl-name (first r))
|
|
(path (merge-pathnames (format nil "impls/~A/~A/~A/"
|
|
(uname-m) (uname) impl-name)
|
|
(homedir))))
|
|
(unless (position :up (pathname-directory path))
|
|
(cond ((probe-file path)
|
|
(uiop/filesystem:delete-directory-tree path :validate t)
|
|
(format t "~&~A was deleted successfully.~%" impl-name)
|
|
(when (equal impl-name config)
|
|
(format t "~&clear config ~S~%" verstring)
|
|
(setf (config verstring) "")))
|
|
(t (format *error-output* "~&~A is not installed yet.~%" impl-name)))))))))
|
|
;;; vim: set ft=lisp lisp:
|