[slime-devel] splash patch version 2
Pascal J.Bourguignon
pjb at informatimago.com
Sun Jun 20 03:59:01 UTC 2004
Pascal J.Bourguignon writes:
>
> Since I cannot go pass the Initial Handshake, here is some initial eye sugar:
> a splash screen for slime.
>
> The patch includes in addition for clisp:
> - specifying the package to unlock when redefining BREAK (COMMON-LISP),
> - *slime-load-verbose* and swank-loader:*swank-load-verbose* variables
> to avoid all these Loading/Loaded messages.
>
> (The diffs are from the FAIRLY_STABLE release. Just ask if you want
> them from HEAD).
So, now that I have removed what prevented slime to work in my emacs,
I moved the splash to slime-repl-update-banner. Here is the new
version of the patch.
(And remember the SLIME logo will always be one HOME key close).
--
__Pascal Bourguignon__ http://www.informatimago.com/
There is no worse tyranny than to force a man to pay for what he does not
want merely because you think it would be good for him. -- Robert Heinlein
-------------- next part --------------
diff -Naurtwb --exclude '*.orig' --exclude '*.rej' --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-20 05:45:32.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,102 @@
(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.
+ (goto-char (point-min))
+ (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*"))
(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 +1276,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.
@@ -1895,9 +1986,13 @@
(zerop (buffer-size)))))
(when use-header-p
(setq header-line-format banner))
+ (setf slime-version (format "SLIME %s" slime-changelog-date))
+ (erase-buffer)
+ (slime-splash)
(when animantep
(pop-to-buffer (current-buffer))
- (animate-string (format "; SLIME %s" slime-changelog-date) 0 0))
+ (animate-string (format "; %s" slime-version)
+ (count-lines (point-min) (point)) (current-column)))
(slime-repl-insert-prompt (if (or (not slime-reply-update-banner-p)
use-header-p)
""
diff -Naurtwb --exclude '*.orig' --exclude '*.rej' --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-20 05:27:53.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 '*.orig' --exclude '*.rej' --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-20 05:27:14.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 '*.orig' --exclude '*.rej' --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-20 05:27:14.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 '*.orig' --exclude '*.rej' --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-20 05:27:14.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))))
More information about the slime-devel
mailing list