tinycustom.el

   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., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, 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 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 (defun-maybe-cond custom-declare-face (face spec doc &rest args)
  63   "Like `defface', but FACE is evaluated as a normal argument.
  64 Note that this function does not have the full specification; DOC or
  65 ARGS are ignored and some keywords are ignored in SPEC except for
  66 `:foreground', `:background', `:bold', `:italic' and `:underline'.
  67 It does nothing if FACE has been defined."
  68   ((fboundp 'make-face)
  69    (or (find-face face)
  70        (let ((colorp (and window-system (x-display-color-p)))
  71              display atts req item match done)
  72          (make-face face)
  73          (while (and spec (not done))
  74            (setq display (car (car spec))
  75                  atts (car (cdr (car spec)))
  76                  spec (cdr spec))
  77            (cond ((consp display)
  78                   (setq match t)
  79                   (while (and display match)
  80                     (setq req (car (car display))
  81                           item (car (cdr (car display)))
  82                           display (cdr display))
  83                     (cond ((eq 'type req)
  84                            (setq match (or (eq window-system item)
  85                                            (and (not window-system)
  86                                                 (eq 'tty item)))))
  87                           ((eq 'class req)
  88                            (setq match (or (and colorp
  89                                                 (eq 'color item))
  90                                            (and (not colorp)
  91                                                 (memq item
  92                                                       '(grayscale mono))))))
  93                           ((eq 'background req)
  94                            (setq match (eq (or frame-background-mode 'light)
  95                                            item)))))
  96                   (setq done match))
  97                  ((eq t display)
  98                   (setq done t))))
  99          (if done
 100              (let ((alist
 101                     '((:foreground . set-face-foreground)
 102                       (:background . set-face-background)
 103                       (:bold . set-face-bold-p)
 104                       (:italic . set-face-italic-p)
 105                       (:underline . set-face-underline-p)))
 106                    function)
 107                (while atts
 108                  (if (setq function (cdr (assq (car atts) alist)))
 109                      (funcall function face (car (cdr atts))))
 110                  (setq atts (cdr (cdr atts))))))
 111          face)))
 112   (t
 113    nil))
 114
 115 (defmacro-maybe defface (face spec doc &rest args)
 116   "Declare FACE as a customizable face that defaults to SPEC.
 117 FACE does not need to be quoted.
 118
 119 Third argument DOC is the face documentation.
 120
 121 If FACE has been set with `custom-set-face', set the face attributes
 122 as specified by that function, otherwise set the face attributes
 123 according to SPEC.
 124
 125 The remaining arguments should have the form
 126
 127    [KEYWORD VALUE]...
 128
 129 The following KEYWORDs are defined:
 130
 131 :group  VALUE should be a customization group.
 132         Add FACE to that group.
 133
 134 SPEC should be an alist of the form ((DISPLAY ATTS)...).
 135
 136 ATTS is a list of face attributes and their values.  The possible
 137 attributes are defined in the variable `custom-face-attributes'.
 138
 139 The ATTS of the first entry in SPEC where the DISPLAY matches the
 140 frame should take effect in that frame.  DISPLAY can either be the
 141 symbol t, which will match all frames, or an alist of the form
 142 \((REQ ITEM...)...)
 143
 144 For the DISPLAY to match a FRAME, the REQ property of the frame must
 145 match one of the ITEM.  The following REQ are defined:
 146
 147 `type' (the value of `window-system')
 148   Should be one of `x' or `tty'.
 149
 150 `class' (the frame's color support)
 151   Should be one of `color', `grayscale', or `mono'.
 152
 153 `background' (what color is used for the background text)
 154   Should be one of `light' or `dark'.
 155
 156 Read the section about customization in the Emacs Lisp manual for more
 157 information."
 158   (nconc (list 'custom-declare-face (list 'quote face) spec doc)
 159          ;; Quote colon keywords.
 160          (let (rest)
 161            (while args
 162              (setq rest (cons (list 'quote (car args)) rest)
 163                    args (cdr args)
 164                    rest (cons (car args) rest)
 165                    args (cdr args)))
 166            (nreverse rest))))
 167
 168 (defmacro-maybe define-widget (name class doc &rest args)
 169   "Define a new widget type named NAME from CLASS.
 170 The third argument DOC is a documentation string for the widget.
 171
 172 This is a nop define-widget only for emulating purpose."
 173   nil)
 174
 175 (provide 'custom)
 176
 177 (require 'product)
 178 (product-provide (provide 'tinycustom) (require 'apel-ver))
 179
 180 ;;; tinycustom.el ends here