-(defun gnus-x-splash ()
- "Show a splash screen using a pixmap in the current buffer."
- (interactive)
- (unless window-system
- (error "`gnus-x-splash' requires running on the window system"))
- (switch-to-buffer (gnus-get-buffer-create (if (or (gnus-alive-p)
- (interactive-p))
- "*gnus-x-splash*"
- gnus-group-buffer)))
- (let ((inhibit-read-only t)
- (file (nnheader-find-etc-directory "images/gnus/x-splash" t))
- pixmap fcw fch width height fringes sbars left yoffset top ls)
- (erase-buffer)
- (sit-for 0) ;; Necessary for measuring the window size correctly.
- (when (and file
- (ignore-errors
- (let ((coding-system-for-read 'raw-text)
- default-enable-multibyte-characters)
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (setq pixmap (read (current-buffer)))))))
- (setq fcw (float (frame-char-width))
- fch (float (frame-char-height))
- width (/ (car pixmap) fcw)
- height (/ (cadr pixmap) fch)
- fringes (if (fboundp 'window-fringes)
- (eval '(window-fringes))
- '(10 11 nil))
- sbars (frame-parameter nil 'vertical-scroll-bars))
- (cond ((eq sbars 'right)
- (setq sbars
- (cons 0 (/ (or (frame-parameter nil 'scroll-bar-width) 14)
- fcw))))
- (sbars
- (setq sbars
- (cons (/ (or (frame-parameter nil 'scroll-bar-width) 14)
- fcw)
- 0)))
- (t
- (setq sbars '(0 . 0))))
- (setq left (- (* (round (/ (1- (/ (+ (window-width)
- (car sbars) (cdr sbars)
- (/ (+ (or (car fringes) 0)
- (or (cadr fringes) 0))
- fcw))
- width))
- 2))
- width)
- (car sbars)
- (/ (or (car fringes) 0) fcw))
- yoffset (cadr (window-edges))
- top (max 0 (- (* (max (if (and tool-bar-mode
- (not (featurep 'gtk))
- (eq (frame-first-window)
- (selected-window)))
- 1 0)
- (round (/ (1- (/ (+ (1- (window-height))
- (* 2 yoffset))
- height))
- 2)))
- height)
- yoffset))
- ls (/ (or line-spacing 0) fch)
- height (max 0 (- height ls)))
- (cond ((>= (- top ls) 1)
- (insert
- (propertize
- " "
- 'display `(space :width 0 :ascent 100))
- "\n"
- (propertize
- " "
- 'display `(space :width 0 :height ,(- top ls 1) :ascent 100))
- "\n"))
- ((> (- top ls) 0)
- (insert
- (propertize
- " "
- 'display `(space :width 0 :height ,(- top ls) :ascent 100))
- "\n")))
- (if (and (> width 0) (> left 0))
- (insert (propertize
- " "
- 'display `(space :width ,left :height ,height :ascent 0)))
- (setq width (+ width left)))
- (when (> width 0)
- (insert (propertize
- " "
- 'display `(space :width ,width :height ,height :ascent 0)
- 'face `(gnus-splash :stipple ,pixmap))))
- (goto-char (if (<= (- top ls) 0) (1- (point)) (point-min)))
- (redraw-frame (selected-frame))
- (sit-for 0))))