Rework splash code, clean old stuff
authorJulien Danjou <julien@danjou.info>
Fri, 29 Oct 2010 12:44:49 +0000 (14:44 +0200)
committerJulien Danjou <julien@danjou.info>
Fri, 29 Oct 2010 12:45:12 +0000 (14:45 +0200)
Signed-off-by: Julien Danjou <julien@danjou.info>
etc/Makefile.in
etc/images/gnus/x-splash [deleted file]
lisp/ChangeLog
lisp/gnus-ems.el
lisp/gnus-start.el
lisp/gnus-xmas.el
lisp/gnus.el

index 2555002..243f524 100644 (file)
@@ -24,7 +24,7 @@ install:
        $(SHELL) $(top_srcdir)/mkinstalldirs "$(etcdir)/images/gnus" "$(etcdir)/images/mail"
        @cd $(srcdir) \
        && for p in images/gnus/*.pbm images/gnus/*.png images/gnus/*.svg \
-                   images/gnus/*.xbm images/gnus/*.xpm images/gnus/x-splash \
+                   images/gnus/*.xbm images/gnus/*.xpm \
                    images/mail/*.pbm images/mail/*.png images/mail/*.svg \
                    images/mail/*.xbm images/mail/*.xpm \
                    images/*.pbm images/*.png images/*.svg images/*.xbm \
@@ -58,7 +58,7 @@ uninstall:
        rm -f "$(etcdir)/gnus-tut.txt"
        @cd $(srcdir) \
        && for p in images/gnus/*.pbm images/gnus/*.png images/gnus/*.svg \
-                   images/gnus/*.xbm images/gnus/*.xpm images/gnus/x-splash \
+                   images/gnus/*.xbm images/gnus/*.xpm \
                    images/mail/*.pbm images/mail/*.png images/mail/*.svg \
                    images/mail/*.xbm images/mail/*.xpm \
                    images/*.pbm images/*.png images/*.svg images/*.xbm \
diff --git a/etc/images/gnus/x-splash b/etc/images/gnus/x-splash
deleted file mode 100644 (file)
index cbd1c2c..0000000
Binary files a/etc/images/gnus/x-splash and /dev/null differ
index 1f89b2e..3c4346b 100644 (file)
@@ -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-xmas.el (gnus-xmas-define): Remove unused gnus-characterp
        definition.
 
index e1e37eb..3a79e67 100644 (file)
 (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)
index dafcd64..857c7d5 100644 (file)
@@ -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
index 3d7dd0c..2acced2 100644 (file)
@@ -526,8 +526,7 @@ FRONT-ADVANCE and REAR-ADVANCE are ignored."
       (while (not (eobp))
        (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2)
                             ?\ ))
-       (forward-line 1))
-      (setq gnus-simple-splash nil))
+       (forward-line 1)))
     (goto-char (point-min))
     (let* ((pheight (+ 20 (count-lines (point-min) (point-max))))
           (wheight (window-height))
@@ -812,10 +811,6 @@ XEmacs compatibility workaround."
         (cons gnus-xmas-modeline-left-extent (substring line 0 chop)))
        (cons gnus-xmas-modeline-right-extent (substring line chop)))))))
 
-(defun gnus-xmas-splash ()
-  (when (eq (device-type) 'x)
-    (gnus-splash)))
-
 (defun gnus-xmas-annotation-in-region-p (b e)
   (or (map-extents (lambda (e u) t) nil b e nil nil 'mm t)
       (if (= b e)
index 9df0632..e0f30cb 100644 (file)
@@ -989,8 +989,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 +1028,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 +1085,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 +1097,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)))