Commit 2ec4c966 authored by Julien Danjou's avatar Julien Danjou Committed by Katsumi Yamaoka
Browse files

gnus.el (gnus-buffers, gnus-group-buffer): Add docstrings.

gnus.el (gnus-group-startup-message): Simplify/update code.
gnus-ems.el (gnus-x-splash): Remove.
gnus-start.el (gnus-1): Remove x-splash calls.
parent 86741733
2010-10-29 Julien Danjou <julien@danjou.info>
 
* gnus-start.el (gnus-1): Remove x-splash calls.
* gnus-ems.el (gnus-x-splash): Remove.
* gnus.el (gnus-group-startup-message): Simplify/update code.
* gnus-group.el (gnus-group-make-tool-bar): Check for display graphic
capability before doing anything.
(gnus-group-insert-group-line): Remove useless
......
......@@ -162,102 +162,6 @@
(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)
......
......@@ -775,14 +775,6 @@ prompt the user for the name of an NNTP server to use."
(if gnus-agent
(gnus-agentize))
(when gnus-simple-splash
(setq gnus-simple-splash nil)
(cond
((featurep 'xemacs)
(gnus-xmas-splash))
(window-system
(gnus-x-splash))))
(let ((level (and (numberp arg) (> arg 0) arg))
did-connect)
(unwind-protect
......
......@@ -350,7 +350,6 @@ be set in `.emacs' instead."
(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)
......@@ -918,7 +917,8 @@ be set in `.emacs' instead."
;;; 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."
......@@ -950,7 +950,8 @@ be set in `.emacs' instead."
;;; Splash screen.
(defvar gnus-group-buffer "*Group*")
(defvar gnus-group-buffer "*Group*"
"Name of the Gnus group buffer.")
(defface gnus-splash
'((((class color)
......@@ -989,8 +990,6 @@ be set in `.emacs' instead."
(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
......@@ -1030,50 +1029,45 @@ be set in `.emacs' instead."
"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 "
_ ___ _ _
_ ___ __ ___ __ _ ___
__ _ ___ __ ___
......@@ -1092,8 +1086,7 @@ be set in `.emacs' instead."
_
__
"
""))
"))
;; And then hack it.
(gnus-indent-rigidly (point-min) (point-max)
(/ (max (- (window-width) (or x 46)) 0) 2))
......@@ -1105,10 +1098,9 @@ be set in `.emacs' instead."
(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)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment