Mercurial > hg > xemacs-beta
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