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 ;; Maintainer: Mikio Nakajima <minakaji@osaka.email.ne.jp>
   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