[slime-devel] splash patch version 3

[Pascal J.Bourguignon]

Thanks to user feedback, here is the third release of the splash
screen for slime.

Added:

    - selection of splash-dark.png or splash-light.png depending on
      the dark/light status of the frame.

    - search the splash-*.png files first in ~/.slime/, then in load-paths.
      That should give each user an opportunity to have his own splash
      screen.

splash-3.patch, to be applied after the previous patch.

-- 
__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 '*.jpg' --exclude '*.orig' --exclude '*.rej' --exclude '*~' --exclude '*.png' --exclude '*.fas' --exclude '*.fasl' --exclude '*.lib' slime-splash-1/slime.el slime/slime.el
--- slime-splash-1/slime.el	2004-06-20 06:58:25.000000000 +0200
+++ slime/slime.el	2004-06-20 06:59:46.000000000 +0200
@@ -1105,12 +1105,16 @@
 
 (defun slime-find-file (file)
   "Looking for file in the load-path."
-  (dolist (dpath load-path)
+  (block :found
+    (dolist (dpath (cons (format "%s/.slime/" (getenv "HOME")) load-path))
     (let ((fpath (concat dpath "/"  file)))
-    (when (file-exists-p fpath) (return fpath))))
-  file)
+        (when (file-readable-p fpath) (return-from :found fpath))))
+    file))
+
+
+
+(defvar slime-version "SLIME 0.0")
 
-(defconstant slime-version "SLIME 0.0")
 
 (defun slime-splash (&optional x y)
   "Insert startup message in current buffer."
@@ -1123,13 +1127,44 @@
    ((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")
+     (let* ((frame (window-frame (window-at 0 0)))
+            ;; bg-* copied from frame-set-background-mode
+            (bg-resource
+             (and window-system
+                  (x-get-resource "backgroundMode" "BackgroundMode")))
+            (bg-color (frame-parameter frame 'background-color))
+            (bg-mode
+             (cond
+              (frame-background-mode)
+              (bg-resource
+               (intern (downcase bg-resource)))
+              ((and (null window-system) (null bg-color))
+               ;; No way to determine this automatically (?).
+               'dark)
+              ;; Unspecified frame background color can only happen
+              ;; on tty's.
+              ((member bg-color '(unspecified "unspecified-bg"))
+               'dark)
+              ((equal bg-color "unspecified-fg") ; inverted colors
+               'light)
+              ((>= (apply '+ (x-color-values bg-color frame))
+                   ;; Just looking at the screen, colors whose
+                   ;; values add up to .6 of the white total
+                   ;; still look dark to me.
+                   (* (apply '+ (x-color-values "white" frame)) .6))
+               'light)
+              (t 'dark)))
+            (image 
+             (find-image
+              `((:type png :file ,(slime-find-file 
+                                   (format "splash-%s.png" bg-mode)))
+                (:type pbm :file ,(slime-find-file 
+                                   (format "splash-%s.pbm" bg-mode))
                       ;; 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")
+                (:type xbm :file ,(slime-find-file 
+                                   (format "splash-%s.xbm" bg-mode))
                       ;; Account for the xbm's blackground.
                       :background ,(face-foreground 'gnus-splash-face)
                       :foreground ,(face-background 'default))))))