diff -Naurtwb --exclude '*~' --exclude '*.png' --exclude '*.fas' --exclude '*.fasl' --exclude '*.lib' slime-FAIRLYSTABLE/slime.el slime/slime.el --- slime-FAIRLYSTABLE/slime.el 2004-06-19 20:58:59.000000000 +0200 +++ slime/slime.el 2004-06-19 23:41:12.000000000 +0200 @@ -135,6 +135,10 @@ (defvar slime-kill-without-query-p t "If non-nil, kill Slime processes without query when quitting Emacs.") +(defvar *slime-load-verbose* nil + "load nomessage argument. See also swank-loader:*swank-load-verbose*.") + + ;;; Customize group @@ -1098,16 +1102,105 @@ (rename-buffer (buffer-name) t) t))) + +(defun slime-find-file (file) + "Looking for file in the load-path." + (dolist (dpath load-path) + (let ((fpath (concat dpath "/" file))) + (when (file-exists-p fpath) (return fpath)))) + file) + +(defconstant slime-version "SLIME 0.0") + +(defun slime-splash (&optional x y) + "Insert startup message in current buffer." + ;; PJB: Shamelessly copied and slightly adapted from gnu-splash. + ;; I should have had generalized it :-( + (interactive) + ;; Insert the message. + (erase-buffer) + (cond + ((and + (fboundp 'find-image) + (display-graphic-p) + (let ((image (find-image + `((:type png :file ,(slime-find-file "slime-splash.png")) + (:type pbm :file ,(slime-find-file "slime-splash.pbm") + ;; Account for the pbm's blackground. + :background ,(face-foreground 'gnus-splash-face) + :foreground ,(face-background 'default)) + (:type xbm :file ,(slime-find-file "slime-splash.xbm") + ;; Account for the xbm's blackground. + :background ,(face-foreground 'gnus-splash-face) + :foreground ,(face-background 'default)))))) + (when image + (let ((size (image-size image))) + (insert-char ?\n 3) + ;; (insert-char ?\n (max 0 (round (- (window-height) + ;; (or y (cdr size)) 1) 2))) + (insert-char ?\ (max 0 (round (- (window-width) + (or x (car size))) 2))) + (insert-image image)) + (insert-char ?\n 3) + ;;(setq slime-simple-splash nil) + t)))) + (t + (insert + (format " %s + .,,. ........ . .... .,. ..:+=?~,,,~+~. + ,=~::,=+,..~==~. .~:~~~~~::,=, .~~=~, :~+~: .~~+++++++++++. + .=~+++=+++:,.~==~. .=~==+I+==+~=..,,+?~=. .+=?+=. .::+:=7~~II++~ + ,:++~I+=IIII..~==~. ~~?I:+~I=I?, .~~+I=~. ,:+7+:. ::+,.?..????: + .+=+~I?~~??I? .~==~. ~:?I:+:I~??, .+=?7+:,.==?$+~, .~~+,,?.,IIII: + ::++===~~:=I..~+==. ~::+:I~?~, ,,+?++~=,~++=+==. ~~++~===+++:~ + .I7::::~=++=+,~+==. ~::+:I~?~,.=~+:?+==+~+,?=+=..=~?=~~~::,,I: + .??.??~~I7=+::~+== ~::+:I~?~,.,++~I~+~~+~=I~+:,.===?....???~: + +::?.??~~.7=+~~:+~+ ... ::+::.?~ :~+~I.~+II+~.I,+==.===?. ..??? : + ,++:+~I=~~+?==::+~+:~=~~~:~~~==?=:::~:==+,I.I=++~~.II=+~,=~+=,,,,III.: + I:=++++++=~~I?::++=+++++=:==++======~==+=~?.I:+==..II:+~~::++=====++:. + ?.?I=++++I+I??.I~~~~+?I:.?~=III,??=+=,:?~.?.??II~.. .I~?.,??=~::::~~I. + ?.+? ?~~~I+I?? ?.~~????..?:~?I?.??~+~,:?..~.????: . .???.,???.?..??~? + ?.?? ?~~~I+ ??.?.~~????..?.~?I?.??~+~.:?....?~??: . .??? ,??? ?..??~~ + I.?. ~~.~ + I? ~.~~.I... ?. ?I..II~.= :I .?~??: . .??~ ,?I? I..?~~~ + + Superior Lisp Interaction Mode for Emacs + +" ;; sorry for the crappy ascii-art. Human Artists may apply! + "")) + ;; And then hack it. + ;; (slime-indent-rigidly (point-min) (point-max) + ;; (/ (max (- (window-width) (or x 46)) 0) 2)) + (goto-char (point-min)) + (forward-line 1) + (let* ((pheight (count-lines (point-min) (point-max))) + (wheight (window-height)) + (rest (- wheight pheight))) + (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) + ;; Fontify some. + (put-text-property (point-min) (point-max) 'face 'slime-highlight-face) + ;; (setq slime-simple-splash t) + )) + (goto-char (point-max)) + (setq mode-line-buffer-identification (concat " " slime-version)) + (set-buffer-modified-p t));;slime-splash + + (defun slime-maybe-start-lisp () "Start an inferior lisp unless one is already running." (unless (get-buffer-process (get-buffer "*inferior-lisp*")) + (switch-to-buffer (get-buffer-create + (or (get-buffer "*inferior-lisp*") "*inferior-lisp*"))) + (slime-splash) (call-interactively 'inferior-lisp) (when slime-kill-without-query-p (process-kill-without-query (inferior-lisp-proc))) + (goto-char (point-max)) + (comint-set-process-mark) (comint-send-string (inferior-lisp-proc) - (format "(load %S)\n" + (format "(load %S :verbose %S)\n" (slime-to-lisp-filename - (concat slime-path slime-backend)))) + (concat slime-path slime-backend)) + *slime-load-verbose*)) (slime-maybe-start-multiprocessing))) (defun slime-maybe-start-multiprocessing () @@ -1186,7 +1279,8 @@ (let* ((process (slime-net-connect host port)) (slime-dispatching-connection process)) (message "Initial handshake..." port) - (slime-init-connection process))) + (slime-init-connection process) + )) (defun slime-changelog-date () "Return the datestring of the latest entry in the ChangeLog file. diff -Naurtwb --exclude '*~' --exclude '*.png' --exclude '*.fas' --exclude '*.fasl' --exclude '*.lib' slime-FAIRLYSTABLE/swank-clisp.lisp slime/swank-clisp.lisp --- slime-FAIRLYSTABLE/swank-clisp.lisp 2004-06-19 20:58:59.000000000 +0200 +++ slime/swank-clisp.lisp 2004-06-19 23:34:44.000000000 +0200 @@ -347,7 +347,7 @@ (with-compilation-unit () (let ((fasl-file (compile-file filename))) (when (and load-p fasl-file) - (load fasl-file)) + (load fasl-file :verbose swank-loader:*swank-load-verbose*)) nil)))) (defimplementation swank-compile-string (string &key buffer position) @@ -387,8 +387,9 @@ (namestring (truename home))))))))) ;; Don't set *debugger-hook* to nil on break. -(ext:without-package-lock () - (defun break (&optional (format-string "Break") &rest args) +(ext:without-package-lock ("COMMON-LISP") + (fmakunbound 'COMMON-LISP:BREAK) + (defun COMMON-LISP:break (&optional (format-string "Break") &rest args) (if (not sys::*use-clcs*) (progn (terpri *error-output*) @@ -444,4 +445,5 @@ ;;; Local Variables: ;;; eval: (put 'compile-file-frobbing-notes 'lisp-indent-function 1) ;;; eval: (put 'dynamic-flet 'common-lisp-indent-function 1) +;;; eval: (put 'with-compilation-hooks 'lisp-indent-function 1) ;;; End: diff -Naurtwb --exclude '*~' --exclude '*.png' --exclude '*.fas' --exclude '*.fasl' --exclude '*.lib' slime-FAIRLYSTABLE/swank-loader.lisp slime/swank-loader.lisp --- slime-FAIRLYSTABLE/swank-loader.lisp 2004-06-19 20:58:59.000000000 +0200 +++ slime/swank-loader.lisp 2004-06-19 23:28:31.000000000 +0200 @@ -9,10 +9,15 @@ ;;; (cl:defpackage :swank-loader + (:export "*SWANK-LOAD-VERBOSE*") (:use :common-lisp)) (in-package :swank-loader) +(defvar *swank-load-verbose* nil + "LOAD :VERBOSE argument. Seek also *slime-load-verbose*") + + (defun make-swank-pathname (name &optional (type "lisp")) "Return a pathname with name component NAME in the Slime directory." (merge-pathnames name @@ -77,12 +82,12 @@ (ensure-directories-exist binary-pathname) (compile-file source-pathname :output-file binary-pathname) (setq needs-recompile t)) - (load binary-pathname)) + (load binary-pathname :verbose *swank-load-verbose*)) #+(or) (error () ;; If an error occurs compiling, load the source instead ;; so we can try to debug it. - (load source-pathname)) + (load source-pathname :verbose *swank-load-verbose*)) )))))) (defun user-init-file () @@ -100,5 +105,5 @@ (funcall (intern (string :warn-unimplemented-interfaces) :swank-backend)) (when (user-init-file) - (load (user-init-file))) + (load (user-init-file) :verbose *swank-load-verbose*)) diff -Naurtwb --exclude '*~' --exclude '*.png' --exclude '*.fas' --exclude '*.fasl' --exclude '*.lib' slime-FAIRLYSTABLE/swank-sbcl.lisp slime/swank-sbcl.lisp --- slime-FAIRLYSTABLE/swank-sbcl.lisp 2004-06-19 20:58:59.000000000 +0200 +++ slime/swank-sbcl.lisp 2004-06-19 23:24:04.000000000 +0200 @@ -272,7 +272,7 @@ (with-compilation-hooks () (let ((fasl-file (compile-file filename))) (when (and load-p fasl-file) - (load fasl-file))))) + (load fasl-file :verbose swank-loader:*swank-load-verbose*))))) (defimplementation swank-compile-string (string &key buffer position) (with-compilation-hooks () diff -Naurtwb --exclude '*~' --exclude '*.png' --exclude '*.fas' --exclude '*.fasl' --exclude '*.lib' slime-FAIRLYSTABLE/swank.lisp slime/swank.lisp --- slime-FAIRLYSTABLE/swank.lisp 2004-06-19 20:58:59.000000000 +0200 +++ slime/swank.lisp 2004-06-19 23:22:54.000000000 +0200 @@ -1854,7 +1854,7 @@ (format nil "~S" (fmakunbound fname)))) (defslimefun load-file (filename) - (to-string (load filename))) + (to-string (load filename :verbose swank-loader:*swank-load-verbose*))) (defun requires-compile-p (pathname) (let ((compile-file-truename (probe-file (compile-file-pathname pathname))))