(autoload 'gnus-alive-p "gnus-util")
(autoload 'mm-disable-multibyte "mm-util")
-(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))
- (with-temp-buffer
- (mm-disable-multibyte)
- (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 (boundp 'tool-bar-mode)
- 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))))
-
;;; Image functions.
(defun gnus-image-type-available-p (type)
(list str))
line)))
(defalias 'gnus-mode-line-buffer-identification 'identity))
- (defalias 'gnus-characterp 'numberp)
(defalias 'gnus-deactivate-mark 'deactivate-mark)
(defalias 'gnus-window-edges 'window-edges)
(defalias 'gnus-key-press-event-p 'numberp)
;;; Gnus buffers
;;;
-(defvar gnus-buffers nil)
+(defvar gnus-buffers nil
+ "List of buffers handled by Gnus.")
(defun gnus-get-buffer-create (name)
"Do the same as `get-buffer-create', but store the created buffer."
;;; Splash screen.
-(defvar gnus-group-buffer "*Group*")
+(defvar gnus-group-buffer "*Group*"
+ "Name of the Gnus group buffer.")
(defface gnus-splash
'((((class color)
(while (search-forward "\t" nil t)
(replace-match " " t t))))))
-(defvar gnus-simple-splash nil)
-
;;(format "%02x%02x%02x" 114 66 20) "724214"
(defvar gnus-logo-color-alist
"Insert startup message in current buffer."
;; Insert the message.
(erase-buffer)
- (cond
- ((and
- (fboundp 'find-image)
- (display-graphic-p)
- ;; Make sure the library defining `image-load-path' is loaded
- ;; (`find-image' is autoloaded) (and discard the result). Else, we may
- ;; get "defvar ignored because image-load-path is let-bound" when calling
- ;; `find-image' below.
- (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t)
- (let* ((data-directory (nnheader-find-etc-directory "images/gnus"))
- (image-load-path (cond (data-directory
- (list data-directory))
- ((boundp 'image-load-path)
- (symbol-value 'image-load-path))
- (t load-path)))
- (image (find-image
- `((:type xpm :file "gnus.xpm"
- :color-symbols
- (("thing" . ,(car gnus-logo-colors))
- ("shadow" . ,(cadr gnus-logo-colors))
- ("oort" . "#eeeeee")
- ("background" . ,(face-background 'default))))
- (:type svg :file "gnus.svg")
- (:type png :file "gnus.png")
- (:type pbm :file "gnus.pbm"
- ;; Account for the pbm's blackground.
- :background ,(face-foreground 'gnus-splash)
- :foreground ,(face-background 'default))
- (:type xbm :file "gnus.xbm"
- ;; Account for the xbm's blackground.
- :background ,(face-foreground 'gnus-splash)
- :foreground ,(face-background 'default))))))
- (when image
- (let ((size (image-size image)))
- (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))
- (setq gnus-simple-splash nil)
- t))))
- (t
+ (unless (and
+ (fboundp 'find-image)
+ (display-graphic-p)
+ ;; Make sure the library defining `image-load-path' is loaded
+ ;; (`find-image' is autoloaded) (and discard the result). Else, we may
+ ;; get "defvar ignored because image-load-path is let-bound" when calling
+ ;; `find-image' below.
+ (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t)
+ (let* ((data-directory (nnheader-find-etc-directory "images/gnus"))
+ (image-load-path (cond (data-directory
+ (list data-directory))
+ ((boundp 'image-load-path)
+ (symbol-value 'image-load-path))
+ (t load-path)))
+ (image (find-image
+ `((:type xpm :file "gnus.xpm"
+ :color-symbols
+ (("thing" . ,(car gnus-logo-colors))
+ ("shadow" . ,(cadr gnus-logo-colors))))
+ (:type svg :file "gnus.svg")
+ (:type png :file "gnus.png")
+ (:type pbm :file "gnus.pbm"
+ ;; Account for the pbm's background.
+ :background ,(face-foreground 'gnus-splash)
+ :foreground ,(face-background 'default))
+ (:type xbm :file "gnus.xbm"
+ ;; Account for the xbm's background.
+ :background ,(face-foreground 'gnus-splash)
+ :foreground ,(face-background 'default))))))
+ (when image
+ (let ((size (image-size image)))
+ (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))
+ t)))
(insert
- (format " %s
+ (format "
_ ___ _ _
_ ___ __ ___ __ _ ___
__ _ ___ __ ___
_
__
-"
- ""))
+"))
;; And then hack it.
(gnus-indent-rigidly (point-min) (point-max)
(/ (max (- (window-width) (or x 46)) 0) 2))
(insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
;; Fontify some.
(put-text-property (point-min) (point-max) 'face 'gnus-splash)
- (setq gnus-simple-splash t)))
- (goto-char (point-min))
- (setq mode-line-buffer-identification (concat " " gnus-version))
- (set-buffer-modified-p t))
+ (goto-char (point-min))
+ (setq mode-line-buffer-identification (concat " " gnus-version))
+ (set-buffer-modified-p t)))
(eval-when (load)
(let ((command (format "%s" this-command)))
projects / emacs.git / commitdiff