1 | ;; tinycustom.el -- a tiny custom.el for emulating purpose. |
---|
2 | |
---|
3 | ;; Copyright (C) 1999 Mikio Nakajima <minakaji@osaka.email.ne.jp> |
---|
4 | |
---|
5 | ;; Author: Mikio Nakajima <minakaji@osaka.email.ne.jp> |
---|
6 | ;; Katsumi Yamaoka <yamaoka@jpl.org> |
---|
7 | ;; Keywords: emulating, custom |
---|
8 | |
---|
9 | ;; This file is part of APEL (A Portable Emacs Library). |
---|
10 | |
---|
11 | ;; This program is free software; you can redistribute it and/or |
---|
12 | ;; modify it under the terms of the GNU General Public License as |
---|
13 | ;; published by the Free Software Foundation; either version 2, or (at |
---|
14 | ;; your option) any later version. |
---|
15 | |
---|
16 | ;; This program is distributed in the hope that it will be useful, but |
---|
17 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
---|
19 | ;; General Public License for more details. |
---|
20 | |
---|
21 | ;; You should have received a copy of the GNU General Public License |
---|
22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
---|
23 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
---|
24 | ;; Boston, MA 02111-1307, USA. |
---|
25 | |
---|
26 | ;;; Commentary: |
---|
27 | |
---|
28 | ;; Purpose of this program is emulating for who does not have "custom". |
---|
29 | ;; (custom.el bundled with v19 is old; does not have following macros.) |
---|
30 | ;; |
---|
31 | ;; DEFCUSTOM below has the same effect as the original DEFVAR has. |
---|
32 | ;; DEFFACE below interprets almost of all arguments. |
---|
33 | ;; DEFGROUP and DEFINE-WIDGET below are just nop macro. |
---|
34 | |
---|
35 | ;;; Code: |
---|
36 | |
---|
37 | (require 'poe) |
---|
38 | |
---|
39 | (defmacro-maybe defgroup (symbol members doc &rest args) |
---|
40 | "Declare SYMBOL as a customization group containing MEMBERS. |
---|
41 | SYMBOL does not need to be quoted. |
---|
42 | Third arg DOC is the group documentation. |
---|
43 | |
---|
44 | This is a nop defgroup only for emulating purpose." |
---|
45 | nil) |
---|
46 | |
---|
47 | (defmacro-maybe defcustom (symbol value doc &rest args) |
---|
48 | "Declare SYMBOL as a customizable variable that defaults to VALUE. |
---|
49 | DOC is the variable documentation. |
---|
50 | |
---|
51 | This is a defcustom only for emulating purpose. |
---|
52 | Its effect is just as same as that of defvar." |
---|
53 | (` (defvar (, symbol) (, value) (, doc)))) |
---|
54 | |
---|
55 | (defvar-maybe frame-background-mode nil |
---|
56 | "*The brightness of the background. |
---|
57 | Set this to the symbol dark if your background color is dark, light if |
---|
58 | your background is light, or nil (default) if you want Emacs to |
---|
59 | examine the brightness for you. However, the old Emacsen might not |
---|
60 | examine the brightness, so you should set this value definitely.") |
---|
61 | |
---|
62 | (defmacro-maybe-cond defface (face spec doc &rest args) |
---|
63 | "Declare FACE as a customizable face that defaults to SPEC. |
---|
64 | FACE does not need to be quoted. |
---|
65 | |
---|
66 | Third argument DOC is the face documentation, it is ignored. |
---|
67 | |
---|
68 | It does nothing if FACE has been bound, otherwise set the face |
---|
69 | attributes according to SPEC. |
---|
70 | |
---|
71 | The remaining arguments should have the form |
---|
72 | |
---|
73 | [KEYWORD VALUE]... |
---|
74 | |
---|
75 | The following KEYWORDs are defined: |
---|
76 | |
---|
77 | :group VALUE should be a customization group, but it is ignored. |
---|
78 | |
---|
79 | SPEC should be an alist of the form ((DISPLAY ATTS)...). |
---|
80 | |
---|
81 | ATTS is of the form (KEY VALUE) where KEY is a symbol of `:foreground', |
---|
82 | `:background', `:bold', `:italic' or `:underline'. The other KEYs are |
---|
83 | ignored. |
---|
84 | |
---|
85 | The ATTS of the first entry in SPEC where the DISPLAY matches the |
---|
86 | frame should take effect in that frame. DISPLAY can either be the |
---|
87 | symbol t, which will match all frames, or an alist of the form |
---|
88 | \((REQ ITEM...)...) |
---|
89 | |
---|
90 | For the DISPLAY to match a FRAME, the REQ property of the frame must |
---|
91 | match one of the ITEM. The following REQ are defined: |
---|
92 | |
---|
93 | `type' (the value of `window-system') |
---|
94 | Should be one of `x' or `tty'. |
---|
95 | |
---|
96 | `class' (the frame's color support) |
---|
97 | Should be one of `color', `grayscale', or `mono'. |
---|
98 | |
---|
99 | `background' (the value of `frame-background-mode', what color is used |
---|
100 | for the background text) |
---|
101 | Should be one of `light' or `dark'." |
---|
102 | ((fboundp 'make-face) |
---|
103 | (` (let ((name (quote (, face)))) |
---|
104 | (or |
---|
105 | (find-face name) |
---|
106 | (let ((face (make-face name)) |
---|
107 | (spec (, spec)) |
---|
108 | (colorp (and window-system (x-display-color-p))) |
---|
109 | display atts req item match done) |
---|
110 | (while (and spec (not done)) |
---|
111 | (setq display (car (car spec)) |
---|
112 | atts (car (cdr (car spec))) |
---|
113 | spec (cdr spec)) |
---|
114 | (cond |
---|
115 | ((consp display) |
---|
116 | (setq match t) |
---|
117 | (while (and display match) |
---|
118 | (setq req (car (car display)) |
---|
119 | item (car (cdr (car display))) |
---|
120 | display (cdr display)) |
---|
121 | (cond |
---|
122 | ((eq 'type req) |
---|
123 | (setq match (or (eq window-system item) |
---|
124 | (and (not window-system) |
---|
125 | (eq 'tty item))))) |
---|
126 | ((eq 'class req) |
---|
127 | (setq match (or (and colorp (eq 'color item)) |
---|
128 | (and (not colorp) |
---|
129 | (memq item '(grayscale mono)))))) |
---|
130 | ((eq 'background req) |
---|
131 | (setq match (eq frame-background-mode item))))) |
---|
132 | (setq done match)) |
---|
133 | ((eq t display) |
---|
134 | (setq done t)))) |
---|
135 | (if done |
---|
136 | (let ((alist '((:foreground . set-face-foreground) |
---|
137 | (:background . set-face-background) |
---|
138 | (:bold . set-face-bold-p) |
---|
139 | (:italic . set-face-italic-p) |
---|
140 | (:underline . set-face-underline-p))) |
---|
141 | function) |
---|
142 | (while atts |
---|
143 | (if (setq function (cdr (assq (car atts) alist))) |
---|
144 | (funcall function face (car (cdr atts)))) |
---|
145 | (setq atts (cdr (cdr atts)))))) |
---|
146 | face))))) |
---|
147 | (t |
---|
148 | nil ;; do nothing. |
---|
149 | )) |
---|
150 | |
---|
151 | (defmacro-maybe define-widget (name class doc &rest args) |
---|
152 | "Define a new widget type named NAME from CLASS. |
---|
153 | The third argument DOC is a documentation string for the widget. |
---|
154 | |
---|
155 | This is a nop define-widget only for emulating purpose." |
---|
156 | nil) |
---|
157 | |
---|
158 | (provide 'custom) |
---|
159 | |
---|
160 | (require 'product) |
---|
161 | (product-provide (provide 'tinycustom) (require 'apel-ver)) |
---|
162 | |
---|
163 | ;;; tinycustom.el ends here |
---|