chiark / gitweb /
dot/lisp-init.lisp: Add missing Emacs header.
[profile] / dot / lisp-init.lisp
1 ;;; -*-lisp-*-
2
3 (cl:defpackage #:mdw-hacks
4   (:use #:cl))
5 (cl:defparameter mdw-hacks::*previous-package* cl:*package*)
6 (cl:in-package #:mdw-hacks)
7
8 ;; Shut up.
9 (setf *load-verbose* nil)
10 (setf *compile-verbose* nil)
11
12 #+cmu
13 (setf *gc-verbose* nil)
14
15 ;; Obtain ASDF from somewhere.
16 (require "asdf")
17
18 ;; Tell SBCL where to find its source source.
19 #+sbcl
20 (sb-ext:set-sbcl-source-location #p"/usr/share/sbcl-source/")
21
22 ;; Tell some Lisps about my home directory.
23 #+(and unix (or sbcl clisp))
24 (let* ((homestring (or #+sbcl (sb-ext:posix-getenv "HOME")
25                        #+clisp (ext:getenv "HOME")
26                        #+cmu (unix:unix-getenv "HOME")
27                        "/home/mdw"))
28        (home (pathname (concatenate 'string homestring "/"))))
29   (setf (logical-pathname-translations "HOME")
30         `(("HOME:**;*.*.*" ,(merge-pathnames "**/*.*" home nil)))
31         (logical-pathname-translations "CL")
32         '(("CL:SOURCE;**;*.*.*" #p"/usr/share/common-lisp/source/**/*.*")
33           ("CL:SYSTEMS;**;*.*.*" #p"/usr/share/common-lisp/systems/**/*.*"))))
34
35 ;; Various fixings.
36 #+clisp
37 (setf custom:*parse-namestring-ansi* t)
38
39 ;; Shebang.
40 (set-dispatch-macro-character
41  #\# #\!
42  (lambda (stream char arg)
43    (declare (ignore char arg))
44    (values (read-line stream))))
45
46 ;; Start up swank.
47 (export 'crank-swank)
48 (defun crank-swank (&rest args)
49   (let ((swank (find-package "SWANK")))
50     (unless swank
51       (load "/usr/share/common-lisp/source/slime/swank-loader.lisp")
52       (funcall (find-symbol "INIT" (find-package "SWANK-LOADER")))
53       (setf swank (find-package "SWANK")))
54     (set (find-symbol "*GLOBAL-DEBUGGER*" swank) nil)
55     (apply (find-symbol "CREATE-SERVER" swank) args)))
56
57 ;; Treat warnings as, err, warnings.
58 #+asdf
59 (setf asdf:*compile-file-failure-behaviour* :warn)
60
61 ;; Done.
62 (pushnew :mdw *features*)
63 ;;#+(and cmu mp) (mp::startup-idle-and-top-level-loops)
64 (setf *package* *previous-package*)