Mercurial > hg > xemacs-beta

comparison lisp/custom/custom-xmas.el @ 100:4be1180a9e89 r20-1b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b2
author cvs
date Mon, 13 Aug 2007 09:15:11 +0200
parents 4103f0995bd7
children 441bb1e64a06
comparison
equal deleted inserted replaced
99:2d83cbd90d8d 100:4be1180a9e89
1 ;;; custom-xmas.el -- XEmacs specific custom support.
2 ;;
3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
4 ;;
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6 ;; Keywords: help, faces
7 ;; Version: 1.44
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9
10 ;;; Commentary:
11 ;;
12 ;; See `custom.el'.
13
14 ;;; Code:
15
16 (unless (featurep 'custom)
17 (error "Load `custom.el' instead"))
18
19 ;; Emacs function missing in XEmacs 19.14.
20 (unless (fboundp 'x-color-values)
21 (defun x-color-values (color &optional frame)
22 "Return a description of the color named COLOR on frame FRAME.
23 The value is a list of integer RGB values--(RED GREEN BLUE).
24 These values appear to range from 0 to 65280 or 65535, depending
25 on the system; white is (65280 65280 65280) or (65535 65535 65535).
26 If FRAME is omitted or nil, use the selected frame."
27 (color-instance-rgb-components (make-color-instance color))))
28
29 ;; Overwrite Emacs definition.
30 (defun custom-facep (face)
31 "Face symbol or object."
32 (or (facep face)
33 (find-face face)))
34
35 ;; Support for special XEmacs font attributes.
36 (autoload 'font-create-object "font" nil)
37
38 (unless (fboundp 'face-font-name)
39 (defun face-font-name (face &rest args)
40 (apply 'face-font face args)))
41
42 (defun custom-set-face-font-size (face size &rest args)
43 "Set the font of FACE to SIZE"
44 (let* ((font (apply 'face-font-name face args))
45 (fontobj (font-create-object font)))
46 (set-font-size fontobj size)
47 (apply 'set-face-font face fontobj args)))
48
49 (defun custom-set-face-font-family (face family &rest args)
50 "Set the font of FACE to FAMILY"
51 (let* ((font (apply 'face-font-name face args))
52 (fontobj (font-create-object font)))
53 (set-font-family fontobj family)
54 (apply 'set-face-font face fontobj args)))
55
56 (nconc custom-face-attributes
57 '((:family (editable-field :format "Family: %v")
58 custom-set-face-font-family)
59 (:size (editable-field :format "Size: %v")
60 custom-set-face-font-size)))
61
62 ;; Overwrite Emacs definition.
63 (defun custom-menu-reset ()
64 "Reset customize menu."
65 (remove-hook 'custom-define-hook 'custom-menu-reset)
66 (when (fboundp 'add-submenu)
67 ;; XEmacs with menus.
68 (add-submenu '("Help") custom-help-menu)))
69
70 (defun get-face-documentation (face)
71 "Get the documentation string for FACE."
72 (face-property face 'doc-string))
73
74 (defun set-face-documentation (face string)
75 "Set the documentation string for FACE to STRING."
76 (set-face-property face 'doc-string string))
77
78 ;; custom-xmas.el ends here