X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tinycustom.el;h=9113768870954d138d35dc702edf1e6fdf20d935;hb=777322df3df8e8dd0b321b31a4ef045ad438537e;hp=921bdbe6dd6bc0b514d855f65a8b1557103a41f9;hpb=fbcf20b160239af2b3eb72ac2b49101f25001457;p=elisp%2Fapel.git diff --git a/tinycustom.el b/tinycustom.el index 921bdbe..9113768 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). @@ -20,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -29,7 +29,7 @@ ;; (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 all arguments. ;; DEFGROUP and DEFINE-WIDGET below are just nop macro. ;;; Code: @@ -43,62 +43,127 @@ 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) + +(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-cond defface (face spec doc &rest args) - "Declare FACE as a customizable face that defaults to SPEC. -FACE does not need to be quoted. [custom emulating macro]" + +(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.") + +(defun-maybe-cond custom-declare-face (face spec doc &rest args) + "Like `defface', but FACE is evaluated as a normal argument. +Note that this function does not have the full specification; DOC or +ARGS are ignored and some keywords are ignored in SPEC except for +`:foreground', `:background', `:bold', `:italic' and `:underline'. +It does nothing if FACE has been defined." ((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 '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))))) + (or (find-face face) + (let ((colorp (and window-system (x-display-color-p))) + display atts req item match done) + (make-face face) + (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 (or frame-background-mode 'light) + 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 - ;; do nothing. - )) + nil)) + +(defmacro-maybe defface (face spec doc &rest args) + "Declare FACE as a customizable face that defaults to SPEC. +FACE does not need to be quoted. + +Third argument DOC is the face documentation. + +If FACE has been set with `custom-set-face', set the face attributes +as specified by that function, 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. + Add FACE to that group. + +SPEC should be an alist of the form ((DISPLAY ATTS)...). + +ATTS is a list of face attributes and their values. The possible +attributes are defined in the variable `custom-face-attributes'. + +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' (what color is used for the background text) + Should be one of `light' or `dark'. + +Read the section about customization in the Emacs Lisp manual for more +information." + (nconc (list 'custom-declare-face (list 'quote face) spec doc) + ;; Quote colon keywords. + (let (rest) + (while args + (setq rest (cons (list 'quote (car args)) rest) + args (cdr args) + rest (cons (car args) rest) + args (cdr args))) + (nreverse rest)))) (defmacro-maybe define-widget (name class doc &rest args) "Define a new widget type named NAME from CLASS. @@ -107,7 +172,9 @@ The third argument DOC is a documentation string for the widget. This is a nop define-widget only for emulating purpose." nil) -(provide 'tinycustom) (provide 'custom) -;;; tinycustom.el ends here. +(require 'product) +(product-provide (provide 'tinycustom) (require 'apel-ver)) + +;;; tinycustom.el ends here