[STUMP] [PATCH] Use exclusively ASDF to load StumpWM modules

[Diogo F. S. Ramos]

A StumpWM module is a loadable ASDF system.  Typically, it consists of
an `.asd' file (which defines an ASDF system) and one or more Lisp
source files.

By using ASDF, StumpWM doesn't need to worry how to look for files or
resolve dependencies.  This is all done by ASDF.  StumpWM modules can
also be more easily integrated with the Lisp system, describing
dependencies which are automatically resolved and loaded by ASDF.

This patch aims at ASDF 3.0, which was released on January 31st 2013.

For backward compatibility, the function `load-module' was kept, so
code that uses it continues to work, but when used as a command, it
does not complete on module names.

By getting rid of `*contrib-dir*' and `*load-path*', the user has to
instruct ASDF where it should look for `.asd' files, as they would for
any other Common Lisp system.
---

With the transition to ASDF based modules, it might be better if
StumpWM relies entirely on it to load, compile and resolve
dependencies, instead of adding an layer of abstraction.

This patch mostly removes code that are not needed if the above vision
is accepted.

So, how should the user now proceed to load and use modules?

According to ASDF manual:

     The default location for a user to install Common Lisp software
  is under '~/.local/share/common-lisp/source/'.  If you install
  software there (it can be a symlink), you don't need further
  configuration.  If you're installing software yourself at a location
  that isn't standard, you have to tell ASDF where you installed it.

The same manual lists various other places and mechanism that an user
can use.

This patch is not finished.  It needs to update the manual, for one.
But it intents to initiate a conversation about this possible change.

 configure.ac       |   5 ---
 make-image.lisp.in |   2 -
 module.lisp        | 110 ++++-------------------------------------------------
 3 files changed, 7 insertions(+), 110 deletions(-)

diff --git a/configure.ac b/configure.ac
index b08c947..fb19d39 100644
--- a/configure.ac
+++ b/configure.ac
@@ -4,7 +4,6 @@
 AC_PREREQ(2.59)
 AC_INIT(Stump Window Manager, esyscmd(grep :version stumpwm.asd | cut -d\" -f2 
| tr -d \\n), address@hidden)

-AC_SUBST(CONTRIB_DIR)
 AC_SUBST(LISP_PROGRAM)
 AC_SUBST(LISP)
 AC_SUBST(STUMPWM_ASDF_DIR)
@@ -17,10 +16,6 @@ AC_ARG_WITH(ccl,     [  --with-ccl=PATH         specify 
location of ccl], CCL_PA
 AC_ARG_WITH(ecl,     [  --with-ecl=PATH         specify location of ecl], 
ECL_PATH=$withval, ECL_PATH="")
 AC_ARG_WITH(lw,      [  --with-lw=PATH          specify location of 
lispworks], LW_PATH=$withval, LW_PATH="")

-AC_ARG_WITH(contrib-dir,
-                     [  --with-contrib-dir=PATH specify location of contrib 
modules],
-                     CONTRIB_DIR=$withval, CONTRIB_DIR="`pwd`/contrib")
-
 STUMPWM_ASDF_DIR="`pwd`"

 if test -x "$SBCL_PATH"; then
diff --git a/make-image.lisp.in b/make-image.lisp.in
index fc1afec..373a6f7 100644
--- a/make-image.lisp.in
+++ b/make-image.lisp.in
@@ -2,8 +2,6 @@

 (load "load-stumpwm.lisp")

-#-ecl (stumpwm:set-contrib-dir "@CONTRIB_DIR@")
-
 #+sbcl
 (sb-ext:save-lisp-and-die "stumpwm" :toplevel (lambda ()
                                                 ;; asdf requires sbcl_home to 
be set, so set it to the value when the image was built
diff --git a/module.lisp b/module.lisp
index 7dbe1ef..52ce3f6 100644
--- a/module.lisp
+++ b/module.lisp
@@ -18,116 +18,20 @@

 ;; Commentary:
 ;;
-;; Use `set-contrib-dir' to set the location stumpwm searches for modules.
+;; A Module must be an ASDF loadable system.

 ;; Code:

 (in-package #:stumpwm)

 (export '(load-module
-          list-modules
-          *load-path*
-          init-load-path
-         set-contrib-dir
-          find-module
-          add-to-load-path))
+          ))

-(defvar *contrib-dir*
-  #.(asdf:system-relative-pathname (asdf:find-system :stumpwm)
-                                   (make-pathname :directory
-                                                  '(:relative "contrib")))
-  "The location of the contrib modules on your system.")
-
-(defun flatten (ls)
-  (labels ( (mklist (x) (if (listp x) x (list x))) )
-    (mapcan #'(lambda (x) (if (atom x) (mklist x) (flatten x))) ls)))
-
-(defun build-load-path (path)
-  "Maps subdirectories of path, returning a list of all subdirs in the
-  first two levels which contain any files ending in .asd"
-  (flatten
-   (mapcar (lambda (dir)
-             (let ((asd-file (car (directory
-                                   (make-pathname :directory 
(directory-namestring dir)
-                                                  :name :wild
-                                                  :type "asd")))))
-               (when asd-file
-                 (directory (directory-namestring asd-file)))))
-           ;; TODO, make this truely recursive
-           (directory (concat (if (stringp path) path
-                                  (directory-namestring path))
-                              "*/*")))))
-
-(defvar *load-path* nil
-  "A list of paths in which modules can be found, by default it is
-  populated by any asdf systems found in the first two levels of
-  `*contrib-dir*' set from the configure script when StumpWM was built, or
-  later by the user using `set-contrib-dir'")
-
-(defun sync-asdf-central-registry (load-path)
-  "Sync `LOAD-PATH' with `ASDF:*CENTRAL-REGISTRY*'"
-  (setf asdf:*central-registry*
-        (union load-path asdf:*central-registry*)))
-
-(defun init-load-path (path)
-  (let ((load-path (build-load-path path)))
-    (setf *load-path* load-path)
-    ;(format t "~{~a ~%~}" *load-path*)
-    (sync-asdf-central-registry load-path)))
-
-(init-load-path *contrib-dir*)
-
-(defcommand set-contrib-dir (dir) ((:string "Directory: "))
-  "Sets the location of the contrib modules"
-  (when (stringp dir)
-    (setf dir (pathname (concat dir "/"))))
-  (setf *contrib-dir* dir)
-  (init-load-path *contrib-dir*))
-
-(define-stumpwm-type :module (input prompt)
-  (or (argument-pop-rest input)
-      (completing-read (current-screen) prompt (list-modules) :require-match 
t)))
-
-(defun list-modules ()
-  "Return a list of the available modules."
-  (flet ((list-module (dir)
-           (mapcar 'pathname-name
-                   (directory (make-pathname :defaults dir
-                                             :name :wild
-                                             :type "asd")))))
-    (flatten (mapcar #'list-module *load-path*))))
-
-(defun find-module (name)
-  (if name
-      (find name (list-modules) :test #'string=)
-      nil))
-
-(defun ensure-pathname (path)
-  (if (stringp path) (first (directory path))
-      path))
-
-(defun add-to-load-path (path)
-  "If `PATH' is not in `*LOAD-PATH*' add it, check if `PATH' contains
-an asdf system, and if so add it to the central registry"
-  (let* ((pathspec (find (ensure-pathname path)  *load-path*))
-         (in-central-registry (find pathspec asdf:*central-registry*))
-         (is-asdf-path (directory (make-pathname :defaults path
-                                                 :name :wild
-                                                 :type "asd"))))
-    (cond ((and pathspec in-central-registry is-asdf-path) *load-path*)
-          ((and pathspec is-asdf-path (not in-central-registry))
-           (setf asdf:*central-registry* (append (list pathspec) 
asdf:*central-registry*)))
-          ((and is-asdf-path (not pathspec))
-           (setf asdf:*central-registry*
-                 (append (list (ensure-pathname path)) 
asdf:*central-registry*))
-           (setf *load-path* (append (list (ensure-pathname path)) 
*load-path*)))
-          (T *load-path*))))
-
-(defcommand load-module (name) ((:module "Load Module: "))
+(defcommand load-module (name) ((:string "Load Module: "))
   "Loads the contributed module with the given NAME."
-  (let ((module (find-module name)))
-      (when module
-        (asdf:operate 'asdf:load-op module))))
-
+  (when name
+    (handler-case (asdf:load-system name)
+      (asdf:SYSTEM-DEFINITION-ERROR (err)
+        (message "~a" err)))))

 ;; End of file
--
2.0.0