diff lisp/gnus/gnus-xmas.el @ 122:d2f30a177268 r20-1b14

Import from CVS: tag r20-1b14
author cvs
date Mon, 13 Aug 2007 09:26:03 +0200
parents cca96a509cfe
children b980b6286996
line wrap: on
line diff
--- a/lisp/gnus/gnus-xmas.el	Mon Aug 13 09:25:31 2007 +0200
+++ b/lisp/gnus/gnus-xmas.el	Mon Aug 13 09:26:03 2007 +0200
@@ -29,10 +29,17 @@
 (defvar menu-bar-mode (featurep 'menubar))
 (require 'messagexmas)
 
-(defvar gnus-xmas-glyph-directory nil
+(defgroup gnus-xmas nil
+  "XEmacsoid support for Gnus"
+  :group 'gnus)
+
+(defcustom gnus-xmas-glyph-directory nil
   "*Directory where Gnus logos and icons are located.
 If this variable is nil, Gnus will try to locate the directory
-automatically.")
+automatically."
+  :type '(choice (const :tag "autodetect" nil)
+		 directory)
+  :group 'gnus-xmas)
 
 (defvar gnus-xmas-logo-color-alist
   '((flame "#cc3300" "#ff2200")
@@ -49,20 +56,26 @@
     (september "#bf9900" "#ffcc00"))
   "Color alist used for the Gnus logo.")
 
-(defvar gnus-xmas-logo-color-style 'flame
-  "Color styles used for the Gnus logo.")
+(defcustom gnus-xmas-logo-color-style 'flame
+  "Color styles used for the Gnus logo."
+  :type '(choice (const flame) (const pine) (const moss)
+		 (const irish) (const sky) (const tin)
+		 (const velvet) (const grape) (const labia)
+		 (const berry) (const neutral) (const september))
+  :group 'gnus-xmas)
 
 (defvar gnus-xmas-logo-colors
   (cdr (assq gnus-xmas-logo-color-style gnus-xmas-logo-color-alist))
   "Colors used for the Gnus logo.")
 
-(defvar gnus-article-x-face-command
+(defcustom gnus-article-x-face-command
   (if (featurep 'xface)
       '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.
 If it is a string, the command will be executed in a sub-shell
-asynchronously.	 The compressed face will be piped to this command.")
+asynchronously.	 The compressed face will be piped to this command."
+  :type '(choice string function))
 
 ;;; Internal variables.
 
@@ -137,9 +150,11 @@
     (set-extent-face gnus-newsgroup-selected-overlay
 		     gnus-summary-selected-face)))
 
-(defvar gnus-xmas-force-redisplay nil
+(defcustom gnus-xmas-force-redisplay nil
   "If non-nil, force a redisplay before recentering the summary buffer.
-This is ugly, but it works around a bug in `window-displayed-height'.")
+This is ugly, but it works around a bug in `window-displayed-height'."
+  :type 'boolean
+  :group 'gnus-xmas)
 
 (defun gnus-xmas-switch-horizontal-scrollbar-off ()
   (when (featurep 'scrollbar)
@@ -195,18 +210,15 @@
     (aset table ?\n nil)
     (aset table ?\r nil)
     ;; We nix out any glyphs over 126 that are not set already.
-    (let ((i 256))
-      (while (>= (setq i (1- i)) 127)
-	;; Only modify if the default entry is nil.
-	(when (or (not default-table)
-		  (not (aref default-table i)))
-	  (aset table i [??]))))
+    (when default-table
+      (let ((i 256))
+	(while (>= (setq i (1- i)) 127)
+	  ;; Only modify if the default entry is nil.
+	  (unless (aref default-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)))
 
-(defun gnus-xmas-add-hook (hook function &optional append local)
-  (add-hook hook function))
-
 (defun gnus-xmas-add-text-properties (start end props &optional object)
   (add-text-properties start end props object)
   (put-text-property start end 'start-closed nil object))
@@ -478,7 +490,6 @@
   (fset 'gnus-appt-select-lowest-window
 	'gnus-xmas-appt-select-lowest-window)
   (fset 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names)
-  (fset 'gnus-add-hook 'gnus-xmas-add-hook)
   (fset 'gnus-character-to-event 'character-to-event)
   (fset 'gnus-mode-line-buffer-identification
 	'gnus-xmas-mode-line-buffer-identification)
@@ -596,13 +607,18 @@
 
 ;;; The toolbar.
 
-(defvar gnus-use-toolbar (if (featurep 'toolbar)
-			     'default-toolbar
-			   nil)
+(defcustom gnus-use-toolbar (if (featurep 'toolbar)
+				'default-toolbar
+			      nil)
   "*If nil, do not use a toolbar.
 If it is non-nil, it must be a toolbar.  The five legal values are
 `default-toolbar', `top-toolbar', `bottom-toolbar',
-`right-toolbar', and `left-toolbar'.")
+`right-toolbar', and `left-toolbar'."
+  :type '(choice (const default-toolbar)
+		 (const top-toolbar) (const bottom-toolbar)
+		 (const left-toolbar) (const right-toolbar)
+		 (const :tag "no toolbar" nil))
+  :group 'gnus-xmas)
 
 (defvar gnus-group-toolbar
   '([gnus-group-get-new-news gnus-group-get-new-news t "Get new news"]
@@ -712,10 +728,9 @@
    'call-process-region (point-min) (point-max) command t '(t nil) nil
    args))
 
-(unless (find-face 'gnus-x-face)
-  (copy-face 'default 'gnus-x-face)
-  (set-face-foreground 'gnus-x-face "black")
-  (set-face-background 'gnus-x-face "white"))
+(defface gnus-x-face '((t (:foreground "black" :background "white")))
+  "Face to show X face"
+  :group 'gnus-xmas)
 
 (defun gnus-xmas-article-display-xface (beg end)
   "Display any XFace headers in the current article."