changeset 111231:d66d04803828

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.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Fri, 29 Oct 2010 13:51:15 +0000
parents bf96ffd54855
children a9904c1962db
files lisp/gnus/ChangeLog lisp/gnus/gnus-ems.el lisp/gnus/gnus-start.el lisp/gnus/gnus.el
diffstat 4 files changed, 52 insertions(+), 158 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Fri Oct 29 11:24:23 2010 +0000
+++ b/lisp/gnus/ChangeLog	Fri Oct 29 13:51:15 2010 +0000
@@ -1,5 +1,11 @@
 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
--- a/lisp/gnus/gnus-ems.el	Fri Oct 29 11:24:23 2010 +0000
+++ b/lisp/gnus/gnus-ems.el	Fri Oct 29 13:51:15 2010 +0000
@@ -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)
--- a/lisp/gnus/gnus-start.el	Fri Oct 29 11:24:23 2010 +0000
+++ b/lisp/gnus/gnus-start.el	Fri Oct 29 13:51:15 2010 +0000
@@ -775,14 +775,6 @@
     (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
--- a/lisp/gnus/gnus.el	Fri Oct 29 11:24:23 2010 +0000
+++ b/lisp/gnus/gnus.el	Fri Oct 29 13:51:15 2010 +0000
@@ -350,7 +350,6 @@
 		     (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 @@
 ;;; 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 @@
 
 ;;; 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 @@
 	(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 @@
   "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 @@
 	    _
 	  __
 
-"
-	     ""))
+"))
     ;; And then hack it.
     (gnus-indent-rigidly (point-min) (point-max)
 			 (/ (max (- (window-width) (or x 46)) 0) 2))
@@ -1105,10 +1098,9 @@
       (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)))