load.lisp can download ASDF and CLX if needed
authorPhilippe Brochard <pbrochard@common-lisp.net>
Sun, 21 Oct 2012 19:46:54 +0000 (21 21:46 +0200)
committerPhilippe Brochard <pbrochard@common-lisp.net>
Sun, 21 Oct 2012 19:46:54 +0000 (21 21:46 +0200)
contrib/wallpaper.lisp
load.lisp
src/tools.lisp

index cccb982..8ffa75f 100644 (file)
                        (setf ind (if (< ind len) (1+ ind) 0))))
                    (format str "~A" filename))))
     (format t "~A~%" command)
-    (let ((output (do-shell command nil t)))
-      (loop for line = (read-line output nil nil)
-         while line
-         do (format t "~A~%" line)))))
+    (do-shell-output command)))
+
 
 (defun create-wallpaper (filename &rest images)
   (format t "Creating wallpaper ~A from ~{~A ~}~%" filename images)
index 2ab8436..916f8c2 100644 (file)
--- a/load.lisp
+++ b/load.lisp
 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 ;;;
 ;;; --------------------------------------------------------------------------
+;;;
+;;; Edit this file (or its copy) and load it with your lisp implementation.
+;;; If you want, it can download ASDF and CLX for you. You'll need wget and
+;;; git program.
+;;;
+;;; Here are command line reference:
+;;;
+;;; clisp -E iso-8859-1 load.lisp
+;;; sbcl --load load.lisp
+;;; cmucl -load load.lisp
+;;; ccl -l load.lisp
+;;; ecl -load load.lisp
+;;;
+;;; --------------------------------------------------------------------------
 
 ;;;------------------
 ;;; Customization part
 ;;;------------------
+(defparameter *interactive* t)
+
+;;; Comment or uncomment the lines above to fit your needs.
 (pushnew :clfswm-compile *features*)
 (pushnew :clfswm-run *features*)
 (pushnew :clfswm-build-image *features*)
-
 ;;(pushnew :clfswm-install *features*)
-
-;;;;;; Uncomment lines above to build the default documentation.
 ;;(pushnew :clfswm-build-doc *features*)
 
-;;;;; Uncomment the line below if you want to see all ignored X errors
-;;(pushnew :xlib-debug *features*)
-
-;;;;; Uncomment the line below if you want to see all event debug messages
-;;(pushnew :event-debug *features*)
-
-
 (defparameter *binary-name* "clfswm")
 
 (defparameter *install-prefix* "/tmp/usr/local")
 (defparameter *install-man*     (with-prefix "/share/man/man1/"))
 
 
+;;;;; Uncomment the line below if you want to see all ignored X errors
+;;(pushnew :xlib-debug *features*)
+
+;;;;; Uncomment the line below if you want to see all event debug messages
+;;(pushnew :event-debug *features*)
+
+
 
 #+:CMU (setf ext:*gc-verbose* nil)
 
+#+:SBCL
+(require :sb-posix)
+
+(load (compile-file "src/tools.lisp"))
+
+(defun load-info (formatter &rest args)
+  (format t "~&  ==> ~A~%" (apply #'format nil formatter args))
+  (force-output))
+
+(defun interactive-ask (formatter &rest args)
+  (when *interactive*
+    (y-or-n-p (apply #'format nil formatter args))))
+
 ;;;------------------
 ;;; XLib part 1
 ;;;------------------
 ;;; ASDF part
 ;;;------------------
 ;;;; Loading ASDF
+(load-info "Requiring ASDF")
+
 #+(or :SBCL :CMUCL :CCL :ECL)
 (require :asdf)
 
+#-ASDF
+(when (probe-file "asdf.lisp")
+  (load "asdf.lisp"))
+
 #-:ASDF
-(load "contrib/asdf.lisp")
+(let ((asdf-url "http://common-lisp.net/project/asdf/asdf.lisp"))
+  (when (interactive-ask "ASDF not found. Do you want to download it from ~A ?" asdf-url)
+    (tools:do-shell-output "wget ~A" asdf-url)
+    (load "asdf.lisp")))
 
+(format t "ASDF version: ~A~%" (asdf:asdf-version))
 
 ;;;------------------
 ;;; XLib part 2
 ;;;------------------
+(load-info "Requiring CLX")
+
 ;;; Loading clisp dynamic module. This part needs clisp >= 2.50
 ;;#+(AND CLISP (not CLX))
 ;;(when (fboundp 'require)
 ;;  (require "clx.lisp"))
+#-CLX
+(progn
+  (when (probe-file "clx/clx.asd")
+    (load "clx/clx.asd")
+    (asdf:oos 'asdf:load-op :clx)))
+
+#-CLX
+(progn
+  (let ((clx-url "git://github.com/sharplispers/clx.git"))
+    (when (interactive-ask "CLX not found. Do you want to download it from ~A ?" clx-url)
+      (unless (probe-file "clx/clx.asd")
+        (tools:do-shell-output "git clone ~A" clx-url))
+      (load "clx/clx.asd")
+      (asdf:oos 'asdf:load-op :clx))))
 
 ;;;------------------
 ;;; CLFSWM loading
 ;;;------------------
 #+:clfswm-compile
-(asdf:oos 'asdf:load-op :clfswm)
+(progn
+  (load-info "Compiling CLFSWM")
+  (asdf:oos 'asdf:load-op :clfswm))
 
 
 ;;;-------------------------
 (in-package :clfswm)
 
 #+:clfswm-run
-(ignore-errors
-  (main :read-conf-file-p t))
+(progn
+  (cl-user::load-info "Running CLFSWM")
+  (ignore-errors
+    (main :read-conf-file-p t)))
 
 
 ;;;-------------------------
 ;;; Building documentation
 ;;;-------------------------
 #+:clfswm-build-doc
-(produce-all-docs)
+(progn
+  (cl-user::load-info "Building documentation")
+  (produce-all-docs))
 
 ;;;-----------------------
 ;;; Building image part
 ;;;-----------------------
 #+:clfswm-build-image
-(build-lisp-image "clfswm")
+(progn
+  (cl-user::load-info "Building CLFSWM executable image")
+   (build-lisp-image "clfswm"))
 
 ;;;-----------------------
 ;;; Installation part
 #+:clfswm-install
 (in-package :cl-user)
 
-#+:SBCL
-(require :sb-posix)
-
-#+:clfswm-install
-(load (compile-file "src/tools.lisp"))
-
 #+:clfswm-install
 (defun check-directory (dir)
   (format t "Checking ~A~%" dir)
 
 #+:clfswm-install
 (defun move-file (file where)
-  (format t "cp -R ~A ~A~%" file where)
-  (tools:fdo-shell "cp -R ~A ~A" file where))
+  (format t "cp -Rf ~A ~A~%" file where)
+  (tools:do-shell-output "cp -Rf ~A ~A" file where))
 
 
 
 #+:clfswm-install
 (progn
+  (load-info "Installing CLFSWM")
   (check-directory *install-prefix*)
   (check-directory *install-bin*)
   (check-directory *install-contrib*)
   (move-file "clfswm.1" *install-man*)
   (format t "Please, adjust *contrib-dir* variable to ~A in your configuration file.~%" *install-contrib*)
   (format t "Something like: (setf *contrib-dir* ~S)~%" *install-contrib*)
-  (sleep 0.5)
-  (tools:fdo-shell "rm -f ~A/clfswm.1.gz && gzip ~A/clfswm.1" *install-man* *install-man*)
+  (tools:do-shell-output "rm -f ~A/clfswm.1.gz && gzip ~A/clfswm.1" *install-man* *install-man*)
   (tools:uquit))
 
index 85252b8..f3920f7 100644 (file)
@@ -95,7 +95,7 @@
           :date-string
            :write-backtrace
           :do-execute
-          :do-shell :fdo-shell
+          :do-shell :fdo-shell :do-shell-output
           :getenv
           :uquit
           :urun-prog
@@ -730,7 +730,11 @@ of the program to return.
 (defun fdo-shell (formatter &rest args)
   (do-shell (apply #'format nil formatter args)))
 
-
+(defun do-shell-output (formatter &rest args)
+  (let ((output (do-shell (apply #'format nil formatter args) nil t)))
+    (loop for line = (read-line output nil nil)
+       while line
+       collect line)))