X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tinycustom.el;h=54a6678231bc9f78e2f5a11fa8c518b0193ba82a;hb=519b2fe2cba7f7802851bad94e6fa85cee378cfb;hp=a91210386369a7f30b040d7f87587361b540c668;hpb=ab53c9eeb511a944145391851b5499f5f294c65f;p=elisp%2Fapel.git

diff --git a/tinycustom.el b/tinycustom.el
index a912103..54a6678 100644
--- a/tinycustom.el
+++ b/tinycustom.el
@@ -25,10 +25,12 @@
 
 ;;; 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.
-;; DEFGROUP and DEFFACE below are just nop macro.
+;; DEFFACE below interprets almost of all arguments.
+;; DEFGROUP and DEFINE-WIDGET below are just nop macro.
 
 ;;; Code:
 
@@ -39,8 +41,8 @@
 SYMBOL does not need to be quoted.
 Third arg DOC is the group documentation.
 
-This is a nop defgroup only for emulating purpose.."
-  nil )
+This is a nop defgroup only for emulating purpose."
+  nil)
     
 (defmacro-maybe defcustom (symbol value doc &rest args) 
   "Declare SYMBOL as a customizable variable that defaults to VALUE.
@@ -48,16 +50,114 @@ 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))) )
+  (` (defvar (, symbol) (, value) (, doc))))
     
-(defmacro-maybe defface (symbol value doc &rest args) 
+(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 nop defface only for emulating purpose."
-  nil )
+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'.
+
+\[custom emulating macro]"
+  ((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)
 
 (provide 'tinycustom)
 (provide 'custom)
 
-;; end of tinycustom.el
+;;; tinycustom.el ends here.