Mercurial > hg > xemacs-beta
diff lisp/custom/custom.el @ 24:4103f0995bd7 r19-15b95
Import from CVS: tag r19-15b95
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:51:03 +0200 |
parents | 8fc7fe29b841 |
children | 441bb1e64a06 |
line wrap: on
line diff
--- a/lisp/custom/custom.el Mon Aug 13 08:50:31 2007 +0200 +++ b/lisp/custom/custom.el Mon Aug 13 08:51:03 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.40 +;; Version: 1.44 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -35,16 +35,6 @@ ;;; Compatibility. -(unless (fboundp 'x-color-values) - ;; Emacs function missing in XEmacs 19.14. - (defun x-color-values (color) - "Return a description of the color named COLOR on frame FRAME. -The value is a list of integer RGB values--(RED GREEN BLUE). -These values appear to range from 0 to 65280 or 65535, depending -on the system; white is (65280 65280 65280) or (65535 65535 65535). -If FRAME is omitted or nil, use the selected frame." - (color-instance-rgb-components (make-color-instance color)))) - (unless (fboundp 'frame-property) ;; XEmacs function missing in Emacs 19.34. (defun frame-property (frame property &optional default) @@ -53,7 +43,7 @@ default))) (defun custom-background-mode () - "Kludge to detext background mode." + "Kludge to detect background mode." (let* ((bg-resource (condition-case () (x-get-resource ".backgroundMode" "BackgroundMode" 'string) @@ -80,22 +70,16 @@ ;; XEmacs and Emacs have different definitions of `facep'. ;; The Emacs definition is the useful one, so emulate that. -(cond ((not (fboundp 'facep)) - (defun custom-facep (face) - "No faces" - nil)) - ((string-match "XEmacs" emacs-version) - (defun custom-facep (face) - "Face symbol or object." - (or (facep face) - (find-face face)))) - (t - (defalias 'custom-facep 'facep))) +(if (fboundp 'facep) + (defalias 'custom-facep 'facep) + (defun custom-facep (face) + "No faces" + nil)) ;;; The `defcustom' Macro. (defun custom-declare-variable (symbol value doc &rest args) - "Like `defcustom', but SYMBOL and VALUE are evaluated as notmal arguments." + "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments." (unless (and (default-boundp symbol) (not (get symbol 'saved-value))) (set-default symbol (if (get symbol 'saved-value) @@ -154,6 +138,15 @@ ;;; 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) @@ -163,8 +156,8 @@ ;; 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 doc - (put face 'face-documentation doc)) + (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) @@ -337,7 +330,7 @@ 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) + (copy-face 'custom-face-empty face frame) (while spec (let* ((entry (car spec)) (display (nth 0 entry)) @@ -408,34 +401,6 @@ value of the attribute, and optionally the frame where the face should be changed.") -(when (string-match "XEmacs" emacs-version) - ;; Support for special XEmacs font attributes. - (require 'font) - - (unless (fboundp 'face-font-name) - (defun face-font-name (face &rest args) - (apply 'face-font face args))) - - (defun set-face-font-size (face size &rest args) - "Set the font of FACE to SIZE" - (let* ((font (apply 'face-font-name face args)) - (fontobj (font-create-object font))) - (set-font-size fontobj size) - (apply 'set-face-font face fontobj args))) - - (defun set-face-font-family (face family &rest args) - "Set the font of FACE to FAMILY" - (let* ((font (apply 'face-font-name face args)) - (fontobj (font-create-object font))) - (set-font-family fontobj family) - (apply 'set-face-font face fontobj args))) - - (nconc custom-face-attributes - '((:family (editable-field :format "Family: %v") - set-face-font-family) - (:size (editable-field :format "Size: %v") - set-face-font-size)))) - (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'. @@ -447,7 +412,7 @@ (fun (nth 2 (assq name custom-face-attributes)))) (setq atts (cdr (cdr atts))) (condition-case nil - (funcall fun face value) + (funcall fun face value frame) (error nil))))) (defun custom-set-face-bold (face value &optional frame) @@ -557,27 +522,24 @@ ["Apropos..." customize-apropos t]) "Customize menu") -(defun custom-menu-reset () - "Reset customize menu." - (remove-hook 'custom-define-hook 'custom-menu-reset) - (cond ((fboundp 'add-submenu) - ;; XEmacs with menus. - (add-submenu '("Help") custom-help-menu)) - ((string-match "XEmacs" emacs-version) - ;; XEmacs without menus. - ) - (t - ;; Emacs. - (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))))))) - -(unless (fboundp 'load-gc) - (custom-menu-reset)) +;(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))))) ;;; 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