[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-142-g880b850

[Philippe Brochard]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, test has been updated
       via  880b850e6e493cb658617a3a63133ccc9b8c7734 (commit)
      from  b70ba53d6adfb212f261bf8bb54abf5f3846b0f1 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 880b850e6e493cb658617a3a63133ccc9b8c7734
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Mon Oct 15 23:11:38 2012 +0200

    load.lisp: Dump image after loading system

diff --git a/load.lisp b/load.lisp
index 826997d..ef9af08 100644
--- a/load.lisp
+++ b/load.lisp
@@ -24,39 +24,43 @@
 ;;; --------------------------------------------------------------------------
 
 (pushnew :clfswm-build *features*)
-(pushnew :clfswm-dump *features*)
 (pushnew :clfswm-start *features*)
+(pushnew :clfswm-make-exec *features*)
 (pushnew :clfswm-install *features*)
 
+(defparameter *install-dir* "/tmp/local")
+
+(defparameter *binary-name* "clfswm")
+
+
 ;;;;;; Uncomment lines above to build the default documentation.
 ;;(pushnew :clfswm-build-doc *features*)
 
+;;;; Uncomment the line above if you want to follow the
+;;;; handle event mecanism.
+;;(pushnew :event-debug *features*)
 
-(defparameter *base-dir* (directory-namestring *load-truename*))
-(export '*base-dir*)
+;;;;; Uncomment the line below if you want to see all ignored X errors
+;;(pushnew :xlib-debug *features*)
 
 
-#+CMU
-(setf ext:*gc-verbose* nil)
 
 
-;;;; Loading ASDF
-#+(or SBCL ECL)
-(require :asdf)
 
 
-#-ASDF
-(load (make-pathname :host (pathname-host *base-dir*)
-		     :device (pathname-device *base-dir*)
-		     :directory (append (pathname-directory *base-dir*) (list "contrib"))
-		     :name "asdf" :type "lisp"))
+;;;;;; End of configuration part ;;;;;;;;;;
 
-(push *base-dir* asdf:*central-registry*)
 
 
 
+(defparameter *base-dir* (directory-namestring *load-truename*))
+(export '*base-dir*)
+(export '*binary-name*)
+
 
+#+CMU (setf ext:*gc-verbose* nil)
 
+;;; Loading CLX
 #+(or CMU ECL)
 (require :clx)
 
@@ -64,6 +68,12 @@
 (when (fboundp 'require)
   (require "clx.lisp"))
 
+
+;;;; Loading ASDF
+#+(or SBCL ECL)
+(require :asdf)
+
+
 #-ASDF
 (load (make-pathname :host (pathname-host *base-dir*)
 		     :device (pathname-device *base-dir*)
@@ -72,17 +82,16 @@
 
 (push *base-dir* asdf:*central-registry*)
 
-;;(setf asdf:*verbose-out* t)
 
-;;;; Uncomment the line above if you want to follow the
-;;;; handle event mecanism.
-;;(pushnew :event-debug *features*)
 
+;;(setf asdf:*verbose-out* t)
+
+#+:clfswm-build
 (asdf:oos 'asdf:load-op :clfswm)
 
 (in-package :clfswm)
 
-#-:clfswm-build-doc
+#+(and :clfswm-start (not :clfswm-build-doc))
 (ignore-errors
   (main :read-conf-file-p t))
 
@@ -93,14 +102,8 @@
   (produce-all-docs))
 
 
-;;; For debuging: start another sever (for example: 'startx -- :1'), Xnest
-;;; or Zephyr and add the lines above in a dot-clfswmrc-debug file
-;;; mod-2 is the numlock key on some keyboards.
-;;(setf *default-modifiers* '(:mod-2))
-;;
-;;(defun my-add-escape ()
-;;  (define-main-key ("Escape" :mod-2) 'exit-clfswm))
-;;
-;;(add-hook *binding-hook* 'my-add-escape)
-;;
-;;(clfswm:main :display ":1" :alternate-conf #P"/where/is/dot-clfswmrc-debug")
+
+
+
+#+:clfswm-make-exec
+(dump-image cl-user:*binary-name*)
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 841cbed..f1cedf6 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -47,6 +47,17 @@
 
 
 
+(defun dump-image (filename)
+  (format t "Dumping image in ~A~%" filename)
+  #+:CLISP (ext:saveinitmem filename :init-function (lambda () (clfswm:main) (ext:quit)) :executable t :norc t)
+  #+SBCL (sb-ext:save-lisp-and-die filename :toplevel 'clfswm:main :executable t)
+  #+CMU (ext:save-lisp filename :init-function (lambda () (clfswm:main) (quit)) :executable t)
+  #+CCL (ccl:save-application filename :toplevel-function (lambda () (clfswm:main) (ccl:quit)) :prepend-kernel t)
+  #+ECL (progn
+          (asdf:make-build :clfswm :type :program :monolithic t :move-here "."
+                           :prologue-code '(progn (require :asdf) (require :clx)))
+          (ushell (format nil "mv ./clfswm-mono ~A" filename))))
+
 
 (defun load-contrib (file)
   "Load a file in the contrib directory"
diff --git a/src/tools.lisp b/src/tools.lisp
index d930362..ecf8f73 100644
--- a/src/tools.lisp
+++ b/src/tools.lisp
@@ -404,6 +404,7 @@ Return the result of the last hook"
 
 
 
+
 (defun in-rectangle (x y rectangle)
   (and rectangle
        (<= (rectangle-x rectangle) x (+ (rectangle-x rectangle) (rectangle-width rectangle)))

-----------------------------------------------------------------------

Summary of changes:
 load.lisp            |   63 ++++++++++++++++++++++++++-----------------------
 src/clfswm-util.lisp |   11 ++++++++
 src/tools.lisp       |    1 +
 3 files changed, 45 insertions(+), 30 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager