diff lisp/gnus/gnus-xmas.el @ 155:43dd3413c7c7 r20-3b4

Import from CVS: tag r20-3b4
author cvs
date Mon, 13 Aug 2007 09:39:39 +0200
parents b980b6286996
children 0132846995bd
line wrap: on
line diff
--- a/lisp/gnus/gnus-xmas.el	Mon Aug 13 09:38:27 2007 +0200
+++ b/lisp/gnus/gnus-xmas.el	Mon Aug 13 09:39:39 2007 +0200
@@ -508,21 +508,8 @@
   (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar)
   (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar)
 
-  (add-hook 'gnus-summary-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off)
-
-  (when (and (<= emacs-major-version 19)
-	     (<= emacs-minor-version 13))
-    (setq gnus-article-x-face-too-ugly (when (eq (device-type) 'tty)
-					 "."))
-    (fset 'gnus-highlight-selected-summary
-	  'gnus-xmas-highlight-selected-summary)
-    (fset 'gnus-group-remove-excess-properties
-	  'gnus-xmas-group-remove-excess-properties)
-    (fset 'gnus-topic-remove-excess-properties
-	  'gnus-xmas-topic-remove-excess-properties)
-    (fset 'gnus-mode-line-buffer-identification 'identity)
-    (unless (boundp 'shell-command-switch)
-      (setq shell-command-switch "-c"))))
+  (add-hook 'gnus-summary-mode-hook
+	    'gnus-xmas-switch-horizontal-scrollbar-off))
 
 
 ;;; XEmacs logo and toolbar.
@@ -532,37 +519,37 @@
   ;; Insert the message.
   (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus"))
   (erase-buffer)
-  (let ((logo (and gnus-xmas-glyph-directory
-		   (concat
-		    (file-name-as-directory gnus-xmas-glyph-directory)
-		    "gnus."
-		    (if (featurep 'xpm) "xpm" "xbm"))))
-	(xpm-color-symbols
-	 (and (featurep 'xpm)
-	      (append `(("thing" ,(car gnus-xmas-logo-colors))
-			("shadow" ,(cadr gnus-xmas-logo-colors)))
-		      xpm-color-symbols))))
-    (if (and (featurep 'xpm)
-	     (not (equal (device-type) 'tty))
-	     logo
-	     (file-exists-p logo))
-	(progn
-	  (setq logo (make-glyph logo))
-	  (insert " ")
-	  (set-extent-begin-glyph (make-extent (point) (point)) logo)
-	  (goto-char (point-min))
-	  (while (not (eobp))
-	    (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2)
-				 ? ))
-	    (forward-line 1))
-	  (goto-char (point-min))
-	  (let* ((pheight (+ 20 (count-lines (point-min) (point-max))))
-		 (wheight (window-height))
-		 (rest (- wheight pheight)))
-	    (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))))
-
-      (insert
-       (format "              %s
+  (cond
+   ((and (console-on-window-system-p)
+	 (or (featurep 'xpm)
+	     (featurep 'xbm)))
+    (let* ((logo-xpm (expand-file-name "gnus.xpm" gnus-xmas-glyph-directory))
+	   (logo-xbm (expand-file-name "gnus.xbm" gnus-xmas-glyph-directory))
+	   (glyph (make-glyph
+		   (list
+		    (vector 'xpm
+			    ':file logo-xpm
+			    ':color-symbols
+			    `(("thing" . ,(car gnus-xmas-logo-colors))
+			      ("shadow" . ,(cadr gnus-xmas-logo-colors))
+			      ("background" . ,(face-background 'default))))
+		    (vector 'xbm :file logo-xbm)
+		    (vector 'nothing)))))
+      (insert " ")
+      (set-extent-begin-glyph (make-extent (point) (point)) glyph)
+      (goto-char (point-min))
+      (while (not (eobp))
+	(insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2)
+			     ?\ ))
+	(forward-line 1)))
+    (goto-char (point-min))
+    (let* ((pheight (+ 20 (count-lines (point-min) (point-max))))
+	   (wheight (window-height))
+	   (rest (- wheight pheight)))
+      (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))))
+   (t
+    (insert
+     (format "              %s
           _    ___ _             _
           _ ___ __ ___  __    _ ___
           __   _     ___    __  ___
@@ -582,23 +569,21 @@
           __
 
 "
-	       ""))
-      ;; And then hack it.
-      (gnus-indent-rigidly (point-min) (point-max)
-			   (/ (max (- (window-width) (or x 46)) 0) 2))
-      (goto-char (point-min))
-      (forward-line 1)
-      (let* ((pheight (count-lines (point-min) (point-max)))
-	     (wheight (window-height))
-	     (rest (- wheight pheight)))
-	(insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))))
-    ;; Fontify some.
+	     ""))
+    ;; And then hack it.
+    (gnus-indent-rigidly (point-min) (point-max)
+			 (/ (max (- (window-width) (or x 46)) 0) 2))
     (goto-char (point-min))
-    (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
-    (goto-char (point-min))
-    (setq modeline-buffer-identification
-	  (list (concat gnus-version ": *Group*")))
-    (set-buffer-modified-p t)))
+    (forward-line 1)
+    (let* ((pheight (count-lines (point-min) (point-max)))
+	   (wheight (window-height))
+	   (rest (- wheight pheight)))
+      (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
+    ;; Paint it.
+    (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)))
+  (setq modeline-buffer-identification
+	(list (concat gnus-version ": *Group*")))
+  (set-buffer-modified-p t))
 
 
 ;;; The toolbar.
@@ -753,33 +738,45 @@
       (set-extent-begin-glyph
        (make-extent (point) (1+ (point))) xface-glyph))))
 
-(defvar gnus-xmas-pointer-glyph
-  (progn
-    (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus"))
-    (make-pointer-glyph (concat gnus-xmas-glyph-directory "gnus-pointer."
-				(if (featurep 'xpm) "xpm" "xbm")))))
+;;(defvar gnus-xmas-pointer-glyph
+;;  (progn
+;;    (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory
+;;                                     "gnus"))
+;;    (let ((file-xpm (expand-file-name "gnus-pointer.xpm"
+;;				      gnus-xmas-glyph-directory))
+;;	  (file-xbm (expand-file-name "gnus-pointer.xbm"
+;;				      gnus-xmas-glyph-directory)))
+;;      (make-pointer-glyph
+;;       (list (vector 'xpm ':file file-xpm)
+;;	     (vector 'xbm ':file file-xbm))))))
 
 (defvar gnus-xmas-modeline-left-extent
   (let ((ext (copy-extent modeline-buffer-id-left-extent)))
-    ;(set-extent-property ext 'pointer gnus-xmas-pointer-glyph)
+;    (set-extent-property ext 'pointer gnus-xmas-pointer-glyph)
     ext))
 
 (defvar gnus-xmas-modeline-right-extent
   (let ((ext (copy-extent modeline-buffer-id-right-extent)))
-    ;(set-extent-property ext 'pointer gnus-xmas-pointer-glyph)
+;    (set-extent-property ext 'pointer gnus-xmas-pointer-glyph)
     ext))
 
 (defvar gnus-xmas-modeline-glyph
   (progn
     (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus"))
-    (let* ((file (concat gnus-xmas-glyph-directory "gnus-pointer."
-			 (if (featurep 'xpm) "xpm" "xbm")))
-	   (glyph (make-glyph file)))
-      (when (and (featurep 'x)
-		 (file-exists-p file))
-	(set-glyph-face glyph 'modeline-buffer-id)
-	(set-glyph-property glyph 'image (cons 'tty "Gnus:"))
-	glyph))))
+    (let* ((file-xpm (expand-file-name "gnus-pointer.xpm"
+				    gnus-xmas-glyph-directory))
+	   (file-xbm (expand-file-name "gnus-pointer.xbm"
+				    gnus-xmas-glyph-directory))
+	   (glyph (make-glyph
+		   (list
+		    ;; Let's try a nifty XPM
+		    (vector 'xpm ':file file-xpm)
+		    ;; Then a not-so-nifty XBM
+		    (vector 'xbm ':file file-xbm)
+		    ;; Then the simple string
+		    (vector 'string ':data "Gnus:")))))
+      (set-glyph-face glyph 'modeline-buffer-id)
+      glyph)))
 
 (defun gnus-xmas-mode-line-buffer-identification (line)
   (let ((line (car line))