diff lisp/custom/custom.el @ 28:1917ad0d78d7 r19-15b97

Import from CVS: tag r19-15b97
author cvs
date Mon, 13 Aug 2007 08:51:55 +0200
parents 441bb1e64a06
children ec9a17fef872
line wrap: on
line diff
--- a/lisp/custom/custom.el	Mon Aug 13 08:51:34 2007 +0200
+++ b/lisp/custom/custom.el	Mon Aug 13 08:51:55 2007 +0200
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 1.46
+;; Version: 1.50
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
@@ -13,7 +13,9 @@
 ;;
 ;; This file only contain the code needed to declare and initialize
 ;; user options.  The code to customize options is autoloaded from
-;; `custom-edit.el'. 
+;; `cus-edit.el'. 
+
+;; The code implementing face declarations is in `cus-face.el'
 
 ;;; Code:
 
@@ -24,57 +26,18 @@
 ;; These autoloads should be deleted when the file is added to Emacs
 
 (unless (fboundp 'load-gc)
-  (autoload 'customize "custom-edit" nil t)
-  (autoload 'customize-variable "custom-edit" nil t)
-  (autoload 'customize-face "custom-edit" nil t)
-  (autoload 'customize-apropos "custom-edit" nil t)
-  (autoload 'customize-customized "custom-edit" nil t)
-  (autoload 'custom-buffer-create "custom-edit")
-  (autoload 'custom-menu-update "custom-edit")
-  (autoload 'custom-make-dependencies "custom-edit"))
-
-;;; Compatibility.
-
-(unless (fboundp 'frame-property)
-  ;; XEmacs function missing in Emacs 19.34.
-  (defun frame-property (frame property &optional default)
-    "Return FRAME's value for property PROPERTY."
-    (or (cdr (assq property (frame-parameters frame)))
-	default)))
-
-(defun custom-background-mode ()
-  "Kludge to detect background mode."
-  (let* ((bg-resource 
-	  (condition-case ()
-	      (x-get-resource ".backgroundMode" "BackgroundMode" 'string)
-	    (error nil)))
-	 color
-	 (mode (cond (bg-resource
-		      (intern (downcase bg-resource)))
-		     ((and (setq color (condition-case ()
-					   (or (frame-property
-						(selected-frame)
-						'background-color)
-					       (color-instance-name
-						(specifier-instance
-						 (face-background 'default))))
-					 (error nil)))
-			   (< (apply '+ (x-color-values color))
-			      (/ (apply '+ (x-color-values "white"))
-				 3)))
-		      'dark)
-		     (t 'light))))
-    (modify-frame-parameters (selected-frame)
-			     (list (cons 'background-mode mode)))
-    mode))
-
-;; XEmacs and Emacs have different definitions of `facep'.  
-;; The Emacs definition is the useful one, so emulate that. 
-(if (fboundp 'facep)
-    (defalias 'custom-facep 'facep)
-  (defun custom-facep (face) 
-    "No faces"
-    nil))
+  ;; From cus-edit.el
+  (autoload 'customize "cus-edit" nil t)
+  (autoload 'customize-variable "cus-edit" nil t)
+  (autoload 'customize-face "cus-edit" nil t)
+  (autoload 'customize-apropos "cus-edit" nil t)
+  (autoload 'customize-customized "cus-edit" nil t)
+  (autoload 'custom-buffer-create "cus-edit")
+  (autoload 'custom-menu-update "cus-edit")
+  (autoload 'custom-make-dependencies "cus-edit")
+  ;; From cus-face.el
+  (autoload 'custom-declare-face "cus-face")
+  (autoload 'custom-set-faces "cus-face"))
 
 ;;; The `defcustom' Macro.
 
@@ -138,30 +101,6 @@
 
 ;;; The `defface' Macro.
 
-
-;(defun get-face-documentation (face)
-;  "Get the documentation string for FACE."
-;  (get face 'face-documentation))
-
-;(defun set-face-documentation (face string)
-;  "Set the documentation string for FACE to STRING."
-;  (put face 'face-documentation string))
-
-(defun custom-declare-face (face spec doc &rest args)
-  "Like `defface', but FACE is evaluated as a normal argument."
-  (put face 'factory-face spec)
-  (when (fboundp 'facep)
-    (unless (and (custom-facep face)
-		 (not (get face 'saved-face)))
-      ;; If the user has already created the face, respect that.
-      (let ((value (or (get face 'saved-face) spec)))
-	(custom-face-display-set face value))))
-  (when (and doc (null (get-face-documentation face)))
-    (set-face-documentation face doc))
-  (custom-handle-all-keywords face args 'custom-face)
-  (run-hooks 'custom-define-hook)
-  face)
-
 (defmacro defface (face spec doc &rest args)
   "Declare FACE as a customizable face that defaults to SPEC.
 FACE does not need to be quoted.
@@ -320,122 +259,6 @@
     (unless (member load loads)
       (put symbol 'custom-loads (cons load loads)))))
 
-;;; Face Utilities.
-
-(and (fboundp 'make-face)
-     (make-face 'custom-face-empty))
-
-(defun custom-face-display-set (face spec &optional frame)
-  "Set FACE to the attributes to the first matching entry in SPEC.
-Iff optional FRAME is non-nil, set it for that frame only.
-See `defface' for information about SPEC."
-  (when (fboundp 'copy-face)
-    (copy-face 'custom-face-empty face frame)
-    (while spec 
-      (let* ((entry (car spec))
-	     (display (nth 0 entry))
-	     (atts (nth 1 entry)))
-	(setq spec (cdr spec))
-	(when (custom-display-match-frame display frame)
-	  (apply 'custom-face-attribites-set face frame atts)
-	  (setq spec nil))))))
-
-(defcustom custom-background-mode nil
-  "The brightness of the background.
-Set this to the symbol dark if your background color is dark, light if
-your background is light, or nil (default) if you want Emacs to
-examine the brightness for you."
-  :group 'customize
-  :type '(choice (choice-item dark) 
-		 (choice-item light)
-		 (choice-item :tag "default" nil)))
-
-(defun custom-display-match-frame (display frame)
-  "Non-nil iff DISPLAY matches FRAME.
-If FRAME is nil, the current FRAME is used."
-  ;; This is a kludge to get started, we really should use specifiers!
-  (unless frame 
-    (setq frame (selected-frame)))
-  (if (eq display t)
-      t
-    (let ((match t))
-      (while (and display match)
-	(let* ((entry (car display))
-	       (req (car entry))
-	       (options (cdr entry)))
-	  (setq display (cdr display))
-	  (cond ((eq req 'type)
-		 (let ((type (if (fboundp 'device-type)
-				 (device-type (frame-device frame))
-			       window-system)))
-		   (setq match (memq type options))))
-		((eq req 'class)
-		 (let ((class (if (fboundp 'device-class)
-				  (device-class (frame-device frame))
-				(frame-property frame 'display-type))))
-		   (setq match (memq class options))))
-		((eq req 'background)
-		 (let ((background (or custom-background-mode
-				       (frame-property frame 'background-mode)
-				       (custom-background-mode))))
-		   (setq match (memq background options))))
-		(t
-		 (error "Unknown req `%S' with options `%S'" req options)))))
-      match)))
-
-(defconst custom-face-attributes
-  '((:bold (toggle :format "Bold: %[%v%]\n") custom-set-face-bold)
-    (:italic (toggle :format "Italic: %[%v%]\n") custom-set-face-italic)
-    (:underline
-     (toggle :format "Underline: %[%v%]\n") set-face-underline-p)
-    (:foreground (color :tag "Foreground") set-face-foreground)
-    (:background (color :tag "Background") set-face-background)
-    (:stipple (editable-field :format "Stipple: %v") set-face-stipple))
-  "Alist of face attributes. 
-
-The elements are of the form (KEY TYPE SET) where KEY is a symbol
-identifying the attribute, TYPE is a widget type for editing the
-attibute, SET is a function for setting the attribute value.
-
-The SET function should take three arguments, the face to modify, the
-value of the attribute, and optionally the frame where the face should
-be changed.")
-
-(defun custom-face-attribites-set (face frame &rest atts)
-  "For FACE on FRAME set the attributes [KEYWORD VALUE]....
-Each keyword should be listed in `custom-face-attributes'.
-
-If FRAME is nil, set the default face."
-  (while atts 
-    (let* ((name (nth 0 atts))
-	   (value (nth 1 atts))
-	   (fun (nth 2 (assq name custom-face-attributes))))
-      (setq atts (cdr (cdr atts)))
-      (condition-case nil
-	  (funcall fun face value frame)
-	(error nil)))))
-
-(defun custom-set-face-bold (face value &optional frame)
-  "Set the bold property of FACE to VALUE."
-  (if value
-      (make-face-bold face frame)
-    (make-face-unbold face frame)))
-
-(defun custom-set-face-italic (face value &optional frame)
-  "Set the italic property of FACE to VALUE."
-  (if value
-      (make-face-italic face frame)
-    (make-face-unitalic face frame)))
-
-(defun custom-initialize-faces (&optional frame)
-  "Initialize all custom faces for FRAME.
-If FRAME is nil or omitted, initialize them for all frames."
-  (mapatoms (lambda (symbol)
-	      (let ((spec (or (get symbol 'saved-face)
-			      (get symbol 'factory-face))))
-		(when spec 
-		  (custom-face-display-set symbol spec frame))))))
-
 ;;; Initializing.
 
 (defun custom-set-variables (&rest args)
@@ -465,33 +288,6 @@
 	  (put symbol 'saved-value (list value)))
 	(setq args (cdr (cdr args)))))))
 
-(defun custom-set-faces (&rest args)
-  "Initialize faces according to user preferences.
-The arguments should be a list where each entry has the form:
-
-  (FACE SPEC [NOW])
-
-SPEC will be stored as the saved value for FACE.  If NOW is present
-and non-nil, FACE will also be created according to SPEC.
-
-See `defface' for the format of SPEC."
-  (while args
-    (let ((entry (car args)))
-      (if (listp entry)
-	  (let ((face (nth 0 entry))
-		(spec (nth 1 entry))
-		(now (nth 2 entry)))
-	    (put face 'saved-face spec)
-	    (when now
-	      (put face 'force-face t)
-	      (custom-face-display-set face spec))
-	    (setq args (cdr args)))
-	;; Old format, a plist of FACE SPEC pairs.
-	(let ((face (nth 0 args))
-	      (spec (nth 1 args)))
-	  (put face 'saved-face spec))
-	(setq args (cdr (cdr args)))))))
-
 ;;; Meta Customization
 
 (defcustom custom-define-hook nil
@@ -510,24 +306,19 @@
 			     ["Apropos..." customize-apropos t])
   "Customize menu")
 
-;(defun custom-menu-reset ()
-;  "Reset customize menu."
-;  (remove-hook 'custom-define-hook 'custom-menu-reset)
-;  (define-key global-map [menu-bar help-menu customize-menu]
-;    (cons (car custom-help-menu)
-;	  (easy-menu-create-keymaps (car custom-help-menu)
-;				    (cdr custom-help-menu)))))
+(defun custom-menu-reset ()
+  "Reset customize menu."
+  (remove-hook 'custom-define-hook 'custom-menu-reset)
+  (if (string-match "XEmacs" emacs-version)
+      (when (fboundp 'add-submenu)
+	(add-submenu '("Help") custom-help-menu))
+    (define-key global-map [menu-bar help-menu customize-menu]
+      (cons (car custom-help-menu)
+	    (easy-menu-create-keymaps (car custom-help-menu)
+				      (cdr custom-help-menu))))))
 
 ;;; The End.
 
 (provide 'custom)
 
-(when (and (not (fboundp 'load-gc))
-	   (string-match "XEmacs" emacs-version))
-  ;; Overwrite definitions for XEmacs.
-  (load-library "custom-xmas"))
-
-(unless (fboundp 'load-gc)
-  (custom-menu-reset))
-
 ;; custom.el ends here