X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tinycustom.el;h=3d32c000de0c638864ad2e3f6ff22229503021fa;hb=afac0fed5c056349dc2625e6006743506cdbcdb9;hp=8c996b54a49ad8ff97d4cc1ef72afc94f5d97e95;hpb=6a1b186ed9d5f3b8f46e695f014c95bdfbee121c;p=elisp%2Fapel.git diff --git a/tinycustom.el b/tinycustom.el index 8c996b5..3d32c00 100644 --- a/tinycustom.el +++ b/tinycustom.el @@ -2,8 +2,8 @@ ;; Copyright (C) 1999 Mikio Nakajima -;; Author: Mikio Nakajima -;; Maintainer: Mikio Nakajima +;; Author: Mikio Nakajima +;; Katsumi Yamaoka ;; Keywords: emulating, custom ;; This file is part of APEL (A Portable Emacs Library). @@ -25,11 +25,11 @@ ;;; Commentary: -;; Purpose of this program is emulating for who does not have -;; `custom.el'. +;; Purpose of this program is emulating for who does not have "custom". +;; (custom.el bundled with v19 is old; does not have following macros.) ;; ;; DEFCUSTOM below has the same effect as the original DEFVAR has. -;; DEFFACE only makes a face. +;; DEFFACE below interprets almost of all arguments. ;; DEFGROUP and DEFINE-WIDGET below are just nop macro. ;;; Code: @@ -42,31 +42,122 @@ SYMBOL does not need to be quoted. Third arg DOC is the group documentation. This is a nop defgroup only for emulating purpose." - nil ) - -(defmacro-maybe defcustom (symbol value doc &rest args) + nil) + +(defmacro-maybe defcustom (symbol value doc &rest args) "Declare SYMBOL as a customizable variable that defaults to VALUE. DOC is the variable documentation. This is a defcustom only for emulating purpose. Its effect is just as same as that of defvar." - (` (defvar (, symbol) (, value) (, doc))) ) - -(defmacro-maybe defface (face value doc &rest args) + (` (defvar (, symbol) (, value) (, doc)))) + +(defvar-maybe frame-background-mode nil + "*The brightness of the background. +Set this to the symbol dark if your background color is dark, light if +your background is light, or nil (default) if you want Emacs to +examine the brightness for you. However, the old Emacsen might not +examine the brightness, so you should set this value definitely.") + +(defmacro-maybe-cond defface (face spec doc &rest args) "Declare FACE as a customizable face that defaults to SPEC. FACE does not need to be quoted. -This is a defface which only makes face FACE for emulating purpose." - (` (make-face (, face))) ) - -(defmacro-maybe define-widget (name class doc) +Third argument DOC is the face documentation, it is ignored. + +It does nothing if FACE has been bound, otherwise set the face +attributes according to SPEC. + +The remaining arguments should have the form + + [KEYWORD VALUE]... + +The following KEYWORDs are defined: + +:group VALUE should be a customization group, but it is ignored. + +SPEC should be an alist of the form ((DISPLAY ATTS)...). + +ATTS is of the form (KEY VALUE) where KEY is a symbol of `:foreground', +`:background', `:bold', `:italic' or `:underline'. The other KEYs are +ignored. + +The ATTS of the first entry in SPEC where the DISPLAY matches the +frame should take effect in that frame. DISPLAY can either be the +symbol t, which will match all frames, or an alist of the form +\((REQ ITEM...)...) + +For the DISPLAY to match a FRAME, the REQ property of the frame must +match one of the ITEM. The following REQ are defined: + +`type' (the value of `window-system') + Should be one of `x' or `tty'. + +`class' (the frame's color support) + Should be one of `color', `grayscale', or `mono'. + +`background' (the value of `frame-background-mode', what color is used +for the background text) + Should be one of `light' or `dark'." + ((fboundp 'make-face) + (` (let ((name (quote (, face)))) + (or + (find-face name) + (let ((face (make-face name)) + (spec (, spec)) + (colorp (and window-system (x-display-color-p))) + display atts req item match done) + (while (and spec (not done)) + (setq display (car (car spec)) + atts (car (cdr (car spec))) + spec (cdr spec)) + (cond + ((consp display) + (setq match t) + (while (and display match) + (setq req (car (car display)) + item (car (cdr (car display))) + display (cdr display)) + (cond + ((eq 'type req) + (setq match (or (eq window-system item) + (and (not window-system) + (eq 'tty item))))) + ((eq 'class req) + (setq match (or (and colorp (eq 'color item)) + (and (not colorp) + (memq item '(grayscale mono)))))) + ((eq 'background req) + (setq match (eq frame-background-mode item))))) + (setq done match)) + ((eq t display) + (setq done t)))) + (if done + (let ((alist '((:foreground . set-face-foreground) + (:background . set-face-background) + (:bold . set-face-bold-p) + (:italic . set-face-italic-p) + (:underline . set-face-underline-p))) + function) + (while atts + (if (setq function (cdr (assq (car atts) alist))) + (funcall function face (car (cdr atts)))) + (setq atts (cdr (cdr atts)))))) + face))))) + (t + nil ;; do nothing. + )) + +(defmacro-maybe define-widget (name class doc &rest args) "Define a new widget type named NAME from CLASS. The third argument DOC is a documentation string for the widget. This is a nop define-widget only for emulating purpose." - nil ) + nil) -(provide 'tinycustom) (provide 'custom) -;; end of tinycustom.el +(require 'product) +(product-provide (provide 'tinycustom) (require 'apel-ver)) + +;;; tinycustom.el ends here