diff lisp/gnus/gnus-xmas.el @ 163:0132846995bd r20-3b8

Import from CVS: tag r20-3b8
author cvs
date Mon, 13 Aug 2007 09:43:35 +0200
parents 43dd3413c7c7
children 8eaf7971accc
line wrap: on
line diff
--- a/lisp/gnus/gnus-xmas.el	Mon Aug 13 09:42:28 2007 +0200
+++ b/lisp/gnus/gnus-xmas.el	Mon Aug 13 09:43:35 2007 +0200
@@ -69,7 +69,8 @@
   "Colors used for the Gnus logo.")
 
 (defcustom gnus-article-x-face-command
-  (if (featurep 'xface)
+  (if (or (featurep 'xface)
+	  (featurep 'xpm))
       'gnus-xmas-article-display-xface
     "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -")
   "String or function to be executed to display an X-Face header.
@@ -133,11 +134,12 @@
   (if (stringp buffer)
       nil
     (map-extents (lambda (extent ignored)
-		   (remove-text-properties
-		    start end
-		    (list (extent-property extent 'text-prop) nil)
-		    buffer))
-		 buffer start end nil nil 'text-prop)
+                   (remove-text-properties
+                    start end
+                    (list (extent-property extent 'text-prop) nil)
+                    buffer)
+		   nil)
+                 buffer start end nil nil 'text-prop)
     (gnus-add-text-properties start end props buffer)))
 
 (defun gnus-xmas-highlight-selected-summary ()
@@ -211,7 +213,8 @@
     ;; We nix out any glyphs over 126 below ctl-arrow.
     (let ((i (if (integerp ctl-arrow) ctl-arrow 160)))
       (while (>= (setq i (1- i)) 127)
-	(aset table i [??])))
+	(unless (aref table i)
+	  (aset table i [??]))))
     ;; Can't use `set-specifier' because of a bug in 19.14 and earlier
     (add-spec-to-specifier current-display-table table (current-buffer) nil)))
 
@@ -509,7 +512,8 @@
   (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar)
 
   (add-hook 'gnus-summary-mode-hook
-	    'gnus-xmas-switch-horizontal-scrollbar-off))
+	    'gnus-xmas-switch-horizontal-scrollbar-off)
+  (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off))
 
 
 ;;; XEmacs logo and toolbar.
@@ -526,15 +530,16 @@
     (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)))))
+		   `(,@(if (featurep 'xpm)
+			   (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))
@@ -717,21 +722,24 @@
   "Display any XFace headers in the current article."
   (save-excursion
     (let ((xface-glyph
-	   (if (featurep 'xface)
-	       (make-glyph (vector 'xface :data
-				   (concat "X-Face: "
-					   (buffer-substring beg end))))
-	     (let ((cur (current-buffer)))
-	       (save-excursion
-		 (gnus-set-work-buffer)
-		 (insert (format "%s" (buffer-substring beg end cur)))
-		 (gnus-xmas-call-region "uncompface")
-		 (goto-char (point-min))
-		 (insert "/* Width=48, Height=48 */\n")
-		 (gnus-xmas-call-region "icontopbm")
-		 (gnus-xmas-call-region "ppmtoxpm")
-		 (make-glyph
-		  (vector 'xpm :data (buffer-string))))))))
+	   (cond ((featurep 'xface)
+		  (make-glyph (vector 'xface :data
+				      (concat "X-Face: "
+					      (buffer-substring beg end)))))
+		 ((featurep 'xpm)
+		  (let ((cur (current-buffer)))
+		    (save-excursion
+		      (gnus-set-work-buffer)
+		      (insert (format "%s" (buffer-substring beg end cur)))
+		      (gnus-xmas-call-region "uncompface")
+		      (goto-char (point-min))
+		      (insert "/* Width=48, Height=48 */\n")
+		      (gnus-xmas-call-region "icontopbm")
+		      (gnus-xmas-call-region "ppmtoxpm")
+		      (make-glyph
+		       (vector 'xpm :data (buffer-string))))))
+		 (t
+		  (make-glyph [nothing])))))
       (set-glyph-face xface-glyph 'gnus-x-face)
       (goto-char (point-min))
       (re-search-forward "^From:" nil t)
@@ -768,13 +776,15 @@
 	   (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:")))))
+		   ;; Gag gag gag.
+		   `(
+		     ,@(if (featurep 'xpm)
+			   ;; Let's try a nifty XPM
+			   (list (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)))