SBCL+ASDF+Windows

ASDF(Another System Definition Facility)というのはCommon Lisp版パッケージ管理ライブラリ(http://www.cliki.net/asdf)。

Windowsではどうにも動いてくれないなーと思っていたが。
http://f34.aaa.livedoor.jp/~kumadasu/pukiwiki/index.php?Maxima#w69d9142

これを参考にインストールしたらできた。

.sbclrcもよそからのほぼコピーでできる。
ただ、リンク先では「MSYS」とだけ書かれているが、
実際MSYSはMinGWの中に入っているのでその点だけ注意。

(require :asdf)
(in-package :asdf)

(defvar *win-central-registry*
  `((,(user-homedir-pathname) ".sbcl/site/")
    (,(sb-ext:posix-getenv "SBCL_HOME") "site/")))

(defun win-sysdef-search (system)
  (dolist (dir *win-central-registry*)
    (let ((files (directory
                  (merge-pathnames
                   (make-pathname :directory '(:relative :wild)
                                  :name (coerce-name system)
                                  :type "asd"
                                  :case :local)
                   (merge-pathnames (cadr dir) (truename (car dir)))))))
      (when files
        (return (car (sort files #'string> :key #'namestring)))))))

(pushnew `win-sysdef-search asdf:*system-definition-search-functions*)


(require :asdf-install)
(in-package :asdf-install)
(setq *tar-program* "C:/MinGW/msys/1.0/bin/tar.exe")

(labels ((pathstr (win-path)
		  (cl:concatenate 'string "/c" 
				  (cl:substitute #\/ #\\ 
						 (cl:subseq (namestring win-path) 2))))
         (tar (args)
	      (with-output-to-string (o)
				     (let ((process (sb-ext:run-program *tar-program*
									args
									:search t
									:wait nil
									:output :stream)))
				       (prog1 (loop for l = (read-line (process-output process) nil nil)
						    while l
						    do (write-line l o))
					 (process-wait process)
					 (process-close process))))))
  
  (defun get-tar-directory (packagename)
    (let* ((tar (tar (list "-tzf" (pathstr packagename))))
           (first-line (subseq tar 0 (position #\newline tar))))
      (if (find #\/ first-line)
          (subseq first-line 0 (position #\/ first-line))
	first-line)))
  
  (defun untar-package (source packagename)
    (tar (list "-C" (pathstr source)
               "-xzvf" (pathstr packagename)))))


(in-package :cl-user)