[STUMP] OpenMCL

[Vitaly Mayatskikh]

Hi!

I've added basic support for OpenMCL. Btw, wrappers.lisp is a good
idea.

diff -up stumpwm-mcl/configure.ac.orig stumpwm-mcl/configure.ac
--- stumpwm-mcl/configure.ac.orig       2008-05-02 10:28:56.000000000 +0200
+++ stumpwm-mcl/configure.ac    2008-05-28 22:11:35.000000000 +0200
@@ -12,6 +12,7 @@ AC_SUBST(PPCRE_PATH)
 AC_ARG_WITH(lisp, [ --with-lisp=IMPL      use the specified lisp (either sbcl 
or clisp)], LISP=$withval, LISP="sbcl")
 AC_ARG_WITH(sbcl, [ --with-sbcl=PATH      specify location of sbcl], 
SBCL_PATH=$withval, SBCL_PATH="")
 AC_ARG_WITH(clisp, [ --with-clisp=PATH     specify location of clisp], 
CLISP_PATH=$withval, CLISP_PATH="")
+AC_ARG_WITH(openmcl, [ --with-openmcl=PATH     specify location of openmcl], 
OPENMCL_PATH=$withval, OPENMCL_PATH="")
 AC_ARG_WITH(ppcre, [ --with-ppcre=PATH     specify location of cl-ppcre], 
PPCRE_PATH=$withval, PPCRE_PATH="`pwd`/cl-ppcre")
 
 if test -x "$SBCL_PATH"; then
@@ -30,6 +31,14 @@ else
    AC_PATH_PROG([CLISP],clisp,"")
 fi
 
+if test -x "$OPENMCL_PATH"; then
+   OPENMCL=$OPENMCL_PATH
+   AC_MSG_CHECKING([for openmcl])
+   AC_MSG_RESULT($OPENMCL)
+else
+   AC_PATH_PROG([OPENMCL],openmcl,"")
+fi
+
 if test "x$LISP" = "xclisp"; then
    if test "x$CLISP" = "x"; then
       LISP=sbcl
@@ -44,6 +53,14 @@ elif test "x$LISP" = "xsbcl"; then
    else
       LISP_PROGRAM=$SBCL
    fi
+elif test "x$LISP" = "xopenmcl"; then
+   if test "x$OPENMCL" = "x"; then
+      LISP=sbcl
+      LISP_PROGRAM=$SBCL
+   else
+      LISP_PROGRAM=$OPENMCL
+   fi
+
 fi
 
 if test "x$LISP_PROGRAM" = "x"; then
diff -up stumpwm-mcl/Makefile.in.orig stumpwm-mcl/Makefile.in
--- stumpwm-mcl/Makefile.in.orig        2008-05-27 09:47:16.000000000 +0200
+++ stumpwm-mcl/Makefile.in     2008-05-28 22:15:46.000000000 +0200
@@ -2,9 +2,11 @@ address@hidden@
 
 clisp_BUILDOPTS=-K full -on-error exit ./make-image.lisp
 sbcl_BUILDOPTS=--load ./make-image.lisp
+openmcl_BUILDOPTS=--load ./make-image.lisp
 
 clisp_INFOOPTS=-K full -on-error exit -x "(load \"asdf.lisp\") (load 
\"stumpwm.asd\") (load \"@PPCRE_PATH@/cl-ppcre.asd\") (asdf:operate 
'asdf:load-op :stumpwm) (load (compile-file \"manual.lisp\")) 
(stumpwm::generate-manual) (ext:exit)"
 sbcl_INFOOPTS=--eval "(progn (require 'asdf) (require 'stumpwm) (load 
\"manual.lisp\"))" --eval "(progn (stumpwm::generate-manual) (sb-ext:quit))"
+openmcl_INFOOPTS=--eval "(require 'asdf) (require 'stumpwm) (load 
(compile-file \"manual.lisp\")) (stumpwm::generate-manual) (quit)"
 
 
 # You shouldn't have to edit past this
@@ -45,4 +47,4 @@ upload-release:
        echo -e ln address@hidden@.tgz stumpwm-latest.tgz\\nln 
address@hidden@.tgz.sig stumpwm-latest.tgz.sig | sftp -b - 
address@hidden:/releases/stumpwm/
 
 clean:
-       rm -f *.fasl *.fas *.lib stumpwm
+       rm -f *.fasl *.fas *.lib *.*fsl stumpwm
diff -up stumpwm-mcl/make-image.lisp.in.orig stumpwm-mcl/make-image.lisp.in
--- stumpwm-mcl/make-image.lisp.in.orig 2008-05-27 10:05:24.000000000 +0200
+++ stumpwm-mcl/make-image.lisp.in      2008-05-28 22:37:38.000000000 +0200
@@ -32,4 +32,20 @@
                    :executable t :keep-global-handlers t :norc t 
:documentation "The StumpWM Executable"))
 
 
-#-(or sbcl clisp) (error "This lisp implementation is not supported.")
+;;; OPENMCL
+
+;; Is there a better way to use asdf.lisp than including it with stumpwm?
+#+openmcl
+(progn
+  (require 'asdf)
+  (load "stumpwm.asd"))
+#+openmcl
+(progn
+  (asdf:oos 'asdf:load-op 'stumpwm))
+#+openmcl
+(progn
+  (ccl:save-application "stumpwm" :toplevel-function (lambda ()
+                                              (stumpwm:stumpwm)
+                                              (ccl:quit))))
+
+#-(or sbcl clisp openmcl) (error "This lisp implementation is not supported.")
diff -up stumpwm-mcl/wrappers.lisp.orig stumpwm-mcl/wrappers.lisp
--- stumpwm-mcl/wrappers.lisp.orig      2008-05-13 09:42:48.000000000 +0200
+++ stumpwm-mcl/wrappers.lisp   2008-05-28 23:08:54.000000000 +0200
@@ -63,7 +63,8 @@
                                                 (string= "DISPLAY=" str :end2 
(min 8 (length str))))
                                               (sb-ext:posix-environ)))
                 opts)
-  #-(or allegro clisp cmu gcl liquid lispworks lucid sbcl)
+  #+openmcl (apply #'ccl:run-program prog args :wait wait :output t :error t)
+  #-(or allegro clisp cmu gcl liquid lispworks lucid sbcl openmcl)
   (error 'not-implemented :proc (list 'run-prog prog opts)))
 
 ;;; XXX: DISPLAY isn't set for cmucl
@@ -93,7 +94,9 @@
                                                   (remove-if (lambda (str)
                                                                (string= 
"DISPLAY=" str :end2 (min 8 (length str))))
                                                              
(sb-ext:posix-environ)))))
-  #-(or allegro clisp cmu sbcl)
+  #+openmcl (with-output-to-string (s)
+              (ccl:run-program prog args :wait t :output s :error t))
+  #-(or allegro clisp cmu sbcl openmcl)
   (error 'not-implemented :proc (list 'pipe-input prog args)))
 
 (defun getenv (var)
@@ -108,7 +111,8 @@
   #+lucid (lcl:environment-variable (string var))
   #+mcl (ccl::getenv var)
   #+sbcl (sb-posix:getenv (string var))
-  #-(or allegro clisp cmu gcl lispworks lucid mcl sbcl scl)
+  #+openmcl (ccl:getenv (string var))
+  #-(or allegro clisp cmu gcl lispworks lucid mcl sbcl scl openmcl)
   (error 'not-implemented :proc (list 'getenv var)))
 
 (defun (setf getenv) (val var)
@@ -126,7 +130,8 @@
   #+lispworks (setf (lw:environment-variable (string var)) (string val))
   #+lucid (setf (lcl:environment-variable (string var)) (string val))
   #+sbcl (sb-posix:putenv (format nil "~A=~A" (string var) (string val)))
-  #-(or allegro clisp cmu gcl lispworks lucid sbcl scl)
+  #+openmcl (ccl:setenv (string var) (string val))
+  #-(or allegro clisp cmu gcl lispworks lucid sbcl scl openmcl)
   (error 'not-implemented :proc (list '(setf getenv) var)))
 
 (defun pathname-is-executable-p (pathname)
@@ -167,8 +172,9 @@
   "print a backtrace of FRAMES number of frames to standard-output"
   #+sbcl (sb-debug:backtrace frames *standard-output*)
   #+clisp (ext:show-stack 1 frames (sys::the-frame))
+  #+openmcl (ccl:print-call-history :count frames)
 
-  #-(or sbcl clisp) (write-line "Sorry, no backtrace for you."))
+  #-(or sbcl clisp openmcl) (write-line "Sorry, no backtrace for you."))
 
 (defun bytes-to-string (data)
   "Convert a list of bytes into a string."

-- 
wbr, Vitaly