cl-init.lisp

cl-init.lisp

;;;;; -*- common-lisp -*-
;;;;;
;;;;; cl-init.lisp
;;;;;
;;;;; CL initialization file. Works for CCL, Allegro, CLISP, and
;;;;; probably SBCL.
;;;;;
;;;;; Time-stamp: <2013-01-27 01:35:53 dhl>
;;;;;


(defpackage #:cl-init
  (:documentation "CL init package.")
  (:use #:common-lisp)
  (:export #:serve))


#+clisp (setq custom:*parse-namestring-ansi* t)

(setf (logical-pathname-translations "dhl")
      `(("lisp;**;*.*.*" "dhl:coding;lisp;**;*.*")
        ("site;**;*.*.*" "dhl:asdf;site;**;*.*")
        ("config" "dhl:lisp;ccl-init.lisp")
        #+(or windows win32 win64 mswindows)
        ,@'(("emacsd;**;*.*.*" "C:/Users/dhl/.emacs.d/**/*.*")
            ("tmp;**;*.*.*" "C:/Users/dhl/tmp/**/*.*")
            ("**;*.*.*" "C:/Users/dhl/**/*.*"))
        #+(or linux cygwin unix)
        ,@'(("emacsd;**;*.*.*" "/home/dhl/.emacs.d/**/*.*")
            ("tmp;**;*.*.*" "/tmp/**/*.*")
            ("**;*.*.*" "/home/dhl/**/*.*"))))


(defparameter ccl::fasl-version (ccl::target-fasl-version))

(load "dhl:asdf;asdf;asdf")

(in-package #:asdf)

(defparameter *subdir-search-registry* '("dhl:site;" "dhl:emacsd;")
  "List of directories to search subdirectories within.")

(defvar *subdir-search-wildcard* :wild)

(defun sysdef-subdir-search (system)
  (let ((latter-path (make-pathname :name (coerce-name system)
                                    :directory (list :relative
                                                     *subdir-search-wildcard*)
                                    :type "asd"
                                    :version nil
                                    :case :local)))
    (dolist (d *subdir-search-registry*)
      (let* ((wild-path (merge-pathnames latter-path d))
             (files (directory wild-path)))
        (when files
          (return (first files)))))))

(pushnew 'sysdef-subdir-search *system-definition-search-functions*)


(in-package #:cl-init)

(asdf:oos 'asdf:load-op 'dhl-utils)
(asdf:oos 'asdf:load-op 'swank)

(defpackage dhl
    (:use cl
          #+ccl ccl
          #+allegro excl
          #+sbcl sb-ext
          #+clisp ext
          dhl-utils)
    #+clisp
    (:shadowing-import-from dhl-utils with-gensyms))

(defun serve (port)
  (swank:create-server :port port
                       :dont-close t
                       :coding-system "utf-8-unix"))