--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/prim/specifier.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,400 @@
+;;; specifier.el --- Lisp interface to specifiers
+
+;; Copyright (C) 1995, 1996 Ben Wing.
+
+;; Author: Ben Wing <wing@666.com>
+;; Keywords: internal
+
+;; first appeared in 19.12.
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Synched up with: Not in FSF.
+
+(defun make-specifier-and-init (type spec-list &optional dont-canonicalize)
+  "Create and initialize a new specifier.
+
+This is a front-end onto `make-specifier' that allows you to create a
+specifier and add specs to it at the same time.  TYPE specifies the
+specifier type.  SPEC-LIST supplies the specification(s) to be added
+to the specifier. Normally, almost any reasonable abbreviation of the
+full spec-list form is accepted, and is converted to the full form;
+however, if optional argument DONT-CANONICALIZE is non-nil, this
+conversion is not performed, and the SPEC-LIST must already be in full
+form.  See `canonicalize-spec-list'."
+  (let ((sp (make-specifier type)))
+    (if (not dont-canonicalize)
+	(setq spec-list (canonicalize-spec-list spec-list type)))
+    (add-spec-list-to-specifier sp spec-list)
+    sp))
+
+;; God damn, do I hate dynamic scoping.
+
+(defun map-specifier (ms-specifier ms-func &optional ms-locale ms-maparg)
+  "Apply MS-FUNC to the specification(s) for MS-LOCALE in MS-SPECIFIER.
+
+If MS-LOCALE is a locale, MS-FUNC will be called for that locale.
+If MS-LOCALE is a locale type, MS-FUNC will be mapped over all locales
+of that type.  If MS-LOCALE is 'all or nil, MS-FUNC will be mapped
+over all locales in MS-SPECIFIER.
+
+MS-FUNC is called with four arguments: the MS-SPECIFIER, the locale
+being mapped over, the inst-list for that locale, and the
+optional MS-MAPARG.  If any invocation of MS-FUNC returns non-nil,
+the mapping will stop and the returned value becomes the
+value returned from `map-specifier'.  Otherwise, `map-specifier'
+returns nil."
+  (let ((ms-specs (specifier-spec-list ms-specifier ms-locale))
+	ms-result)
+    (while (and ms-specs (not ms-result))
+      (let ((ms-this-spec (car ms-specs)))
+	(setq ms-result (funcall ms-func ms-specifier (car ms-this-spec)
+			      (cdr ms-this-spec) ms-maparg))
+	(setq ms-specs (cdr ms-specs))))
+    ms-result))
+
+(defun canonicalize-inst-pair (inst-pair specifier-type &optional noerror)
+  "Canonicalize the given INST-PAIR.
+
+SPECIFIER-TYPE specifies the type of specifier that this SPEC-LIST
+will be used for.
+
+Canonicalizing means converting to the full form for an inst-pair, i.e.
+`(TAG-SET . INSTANTIATOR)'.  A single, untagged instantiator is given
+a tag set of nil (the empty set), and a single tag is converted into
+a tag set consisting only of that tag.
+
+If NOERROR is non-nil, signal an error if the inst-pair is invalid;
+otherwise return t."
+  ;; OK, the possibilities are:
+  ;;
+  ;; a) a single instantiator
+  ;; b) a cons of a tag and an instantiator
+  ;; c) a cons of a tag set and an instantiator
+  (cond ((valid-instantiator-p inst-pair specifier-type)
+	 ;; case (a)
+	 (cons nil inst-pair))
+
+	((not (consp inst-pair))
+	 ;; not an inst-pair
+	 (if noerror t
+	   ;; this will signal an appropriate error.
+	   (check-valid-instantiator inst-pair specifier-type)))
+
+	((and (valid-specifier-tag-p (car inst-pair))
+	      (valid-instantiator-p (cdr inst-pair) specifier-type))
+	 ;; case (b)
+	 (cons (list (car inst-pair)) (cdr inst-pair)))
+
+	((and (valid-specifier-tag-set-p (car inst-pair))
+	      (valid-instantiator-p (cdr inst-pair) specifier-type))
+	 ;; case (c)
+	 inst-pair)
+	 
+	(t
+	 (if noerror t
+	   (signal 'error (list "Invalid specifier tag set"
+				(car inst-pair)))))))
+
+(defun canonicalize-inst-list (inst-list specifier-type &optional noerror)
+  "Canonicalize the given INST-LIST (a list of inst-pairs).
+
+SPECIFIER-TYPE specifies the type of specifier that this INST-LIST
+will be used for.
+
+Canonicalizing means converting to the full form for an inst-list, i.e.
+`((TAG-SET . INSTANTIATOR) ...)'.  This function accepts a single
+inst-pair or any abbrevation thereof or a list of (possibly
+abbreviated) inst-pairs. (See `canonicalize-inst-pair'.)
+
+If NOERROR is non-nil, signal an error if the inst-list is invalid;
+otherwise return t."
+
+  ;; OK, the possibilities are:
+  ;;
+  ;; a) an inst-pair or various abbrevations thereof
+  ;; b) a list of (a)
+  (let ((result (canonicalize-inst-pair inst-list specifier-type t)))
+    (if (not (eq result t))
+	;; case (a)
+	(list result)
+
+      (if (not (consp inst-list))
+	  ;; not an inst-list.
+	  (if noerror t
+	   ;; this will signal an appropriate error.
+	    (check-valid-instantiator inst-list specifier-type))
+
+	;; case (b)
+	(catch 'cann-inst-list
+	  ;; don't use mapcar here; we need to catch the case of
+	  ;; an invalid list.
+	  (let ((rest inst-list)
+		(result nil))
+	    (while rest
+	      (if (not (consp rest))
+		  (if noerror (throw 'cann-inst-list t)
+		    (signal 'error (list "Invalid list format" inst-list)))
+		(let ((res2 (canonicalize-inst-pair (car rest) specifier-type
+						    noerror)))
+		  (if (eq res2 t)
+		      ;; at this point, we know we're noerror because
+		      ;; otherwise canonicalize-inst-pair would have
+		      ;; signalled an error.
+		      (throw 'cann-inst-list t)
+		    (setq result (cons res2 result)))))
+	      (setq rest (cdr rest)))
+	    (nreverse result)))))))
+
+(defun canonicalize-spec (spec specifier-type &optional noerror)
+  "Canonicalize the given SPEC (a specification).
+
+SPECIFIER-TYPE specifies the type of specifier that this SPEC-LIST
+will be used for.
+
+Canonicalizing means converting to the full form for a spec, i.e.
+`(LOCALE (TAG-SET . INSTANTIATOR) ...)'.  This function accepts a
+possibly abbreviated inst-list or a cons of a locale and a possibly
+abbreviated inst-list. (See `canonicalize-inst-list'.)
+
+If NOERROR is nil, signal an error if the specification is invalid;
+otherwise return t."
+  ;; OK, the possibilities are:
+  ;;
+  ;; a) an inst-list or some abbrevation thereof
+  ;; b) a cons of a locale and an inst-list
+  (let ((result (canonicalize-inst-list spec specifier-type t)))
+    (if (not (eq result t))
+	;; case (a)
+	(cons 'global result)
+
+      (if (not (consp spec))
+	  ;; not a spec.
+	  (if noerror t
+	    ;; this will signal an appropriate error.
+	    (check-valid-instantiator spec specifier-type))
+
+	(if (not (valid-specifier-locale-p (car spec)))
+	    ;; invalid locale.
+	    (if noerror t
+	      (signal 'error (list "Invalid specifier locale" (car spec))))
+
+	  ;; case (b)
+	  (let ((result (canonicalize-inst-list (cdr spec) specifier-type
+						noerror)))
+	    (if (eq result t)
+		;; at this point, we know we're noerror because
+		;; otherwise canonicalize-inst-list would have
+		;; signalled an error.
+		t
+	      (cons (car spec) result))))))))
+
+(defun canonicalize-spec-list (spec-list specifier-type &optional noerror)
+  "Canonicalize the given SPEC-LIST (a list of specifications).
+
+SPECIFIER-TYPE specifies the type of specifier that this SPEC-LIST
+will be used for.
+
+Canonicalizing means converting to the full form for a spec-list, i.e.
+`((LOCALE (TAG-SET . INSTANTIATOR) ...) ...)'.  This function accepts
+a possibly abbreviated specification or a list of such things. (See
+`canonicalize-spec'.) This is the function used to convert spec-lists
+accepted by `set-specifier' and such into a form suitable for
+`add-spec-list-to-specifier'.
+
+This function tries extremely hard to resolve any ambiguities,
+and the built-in specifier types (font, image, toolbar, etc.) are
+designed so that there won't be any ambiguities.
+
+If NOERROR is nil, signal an error if the spec-list is invalid;
+otherwise return t."
+  ;; OK, the possibilities are:
+  ;;
+  ;; a) a spec or various abbreviations thereof
+  ;; b) a list of (a)
+  (let ((result (canonicalize-spec spec-list specifier-type t)))
+    (if (not (eq result t))
+	;; case (a)
+	(list result)
+
+      (if (not (consp spec-list))
+	  ;; not a spec-list.
+	  (if noerror t
+	   ;; this will signal an appropriate error.
+	    (check-valid-instantiator spec-list specifier-type))
+
+	;; case (b)
+	(catch 'cann-spec-list
+	  ;; don't use mapcar here; we need to catch the case of
+	  ;; an invalid list.
+	  (let ((rest spec-list)
+		(result nil))
+	    (while rest
+	      (if (not (consp rest))
+		  (if noerror (throw 'cann-spec-list t)
+		    (signal 'error (list "Invalid list format" spec-list)))
+		(let ((res2 (canonicalize-spec (car rest) specifier-type
+					       noerror)))
+		  (if (eq res2 t)
+		      ;; at this point, we know we're noerror because
+		      ;; otherwise canonicalize-spec would have
+		      ;; signalled an error.
+		      (throw 'cann-spec-list t)
+		    (setq result (cons res2 result)))))
+	      (setq rest (cdr rest)))
+	    (nreverse result)))))))
+
+(defun set-specifier (specifier value &optional locale tag-set how-to-add)
+  "Add a specification or specifications to SPECIFIER.
+
+This function adds a specification of VALUE in locale LOCALE.
+LOCALE indicates where this specification is active, and should be
+a buffer, a window, a frame, a device, or the symbol `global' to
+indicate that it applies everywhere.  LOCALE usually defaults to
+`global' if omitted.
+
+VALUE is usually what is called an \"instantiator\" (which, roughly
+speaking, corresponds to the \"value\" of the property governed by
+SPECIFIER).  The valid instantiators for SPECIFIER depend on the
+type of SPECIFIER (which you can determine using `specifier-type').
+The specifier `scrollbar-width', for example, is of type `integer',
+meaning its valid instantiators are integers.  The specifier
+governing the background color of the `default' face (you can
+retrieve this specifier using `(face-foreground 'default)') is
+of type `color', meaning its valid instantiators are strings naming
+colors and color-instance objects.  For some types of specifiers,
+such as `image' and `toolbar', the instantiators can be very
+complex.  Generally this is documented in the appropriate predicate
+function -- `color-specifier-p', `image-specifier-p',
+`toolbar-specifier-p', etc.
+
+NOTE: It does *not* work to give a VALUE of nil as a way of
+removing the specifications for a locale.  Use `remove-specifier'
+instead. (And keep in mind that, if you omit the LOCALE argument
+to `remove-specifier', it removes *all* specifications!  If you
+want to remove just the `global' specification, make sure to
+specify a LOCALE of `global'.)
+
+VALUE can also be a list of instantiators.  This means basically,
+\"try each one in turn until you get one that works\".  This allows
+you to give funky instantiators that may only work in some cases,
+and provide more normal backups for the other cases. (For example,
+you might like the color \"darkseagreen2\", but some X servers
+don't recognize this color, so you could provide a backup
+\"forest green\".  Color TTY devices probably won't recognize this
+either, so you could provide a second backup \"green\".  You'd
+do this by specifying an instantiator
+
+'(\"darkseagreen2\" \"forest green\" \"green\")
+
+VALUE can also be various more complicated forms; see below.
+
+Optional argument TAG-SET is a tag or a list of tags, to be associated
+with the VALUE.  Tags are symbols (usually naming device types, such
+as `x' and `tty', or device classes, such as `color', `mono', and
+`grayscale'); specifying a TAG-SET restricts the scope of VALUE to
+devices that match all specified tags. (You can also create your
+own tags using `define-specifier-tag', and use them to identify
+specifications added by you, so you can remove them later.)
+
+Optional argument HOW-TO-ADD should be either nil or one of the
+symbols `prepend', `append', `remove-tag-set-prepend',
+`remove-tag-set-append', `remove-locale', `remove-locale-type',
+or `remove-all'.  This specifies what to do with existing
+specifications in LOCALE (and possibly elsewhere in the specifier).
+Most of the time, you do not need to worry about this argument;
+the default behavior of `remove-tag-set-prepend' is usually fine.
+See `copy-specifier' and `add-spec-to-specifier' for a full
+description of what each of these means.
+
+VALUE can actually be anything acceptable to `canonicalize-spec-list';
+this includes, among other things:
+
+-- a cons of a locale and an instantiator (or list of instantiators)
+-- a cons of a tag or tag-set and an instantiator (or list of
+   instantiators)
+-- a cons of a locale and the previous type of item
+-- a list of one or more of any of the previous types of items
+
+However, in these cases, you cannot give a LOCALE or TAG-SET,
+because they do not make sense. (You will probably get an error if
+you try this.)
+
+Finally, VALUE can itself be a specifier (of the same type as
+SPECIFIER), if you want to copy specifications from one specifier
+to another; this is equivalent to calling `copy-specifier', and
+LOCALE, TAG-SET, and HOW-TO-ADD have the same semantics as that
+function.
+
+Note that `set-specifier' is exactly complementary to `specifier-specs'
+except in the case where SPECIFIER has no specs at all in it but nil
+is a valid instantiator (in that case, `specifier-specs' will return
+nil (meaning no specs) and `set-specifier' will interpret the `nil'
+as meaning \"I'm adding a global instantiator and its value is `nil'\"),
+or in strange cases where there is an ambiguity between a spec-list
+and an inst-list, etc. (The built-in specifier types are designed
+in such a way as to avoid any such ambiguities.)
+
+NOTE: If you want to to work with spec-lists, you should probably not
+use either `set-specifier' or `specifier-specs', but should use the
+lower-level functions `add-spec-list-to-specifier' and `specifier-spec-list'.
+These functions always work with fully-qualified spec-lists; thus, there
+is no possibility for ambiguity and no need to go through the function
+`canonicalize-spec-list', which is potentially time-consuming."
+
+  ;; backward compatibility: the old function had HOW-TO-ADD as the
+  ;; third argument and no arguments after that.
+  ;; #### this should disappear at some point.
+  (if (and (null how-to-add)
+	   (memq locale '(prepend append remove-tag-set-prepend
+				  remove-tag-set-append remove-locale
+				  remove-locale-type remove-all)))
+      (progn
+	(setq how-to-add locale)
+	(setq locale nil)))
+
+  ;; proper beginning of the function.
+  (let ((is-valid (valid-instantiator-p value (specifier-type specifier)))
+	(nval value))
+    (cond ((and (not is-valid) (specifierp nval))
+	   (copy-specifier nval specifier locale tag-set nil how-to-add))
+	  (t
+	   (if tag-set
+	       (progn
+		 (if (not (listp tag-set))
+		     (setq tag-set (list tag-set)))
+		 ;; You tend to get more accurate errors
+		 ;; for a variety of cases if you call
+		 ;; canonicalize-tag-set here.
+		 (setq tag-set (canonicalize-tag-set tag-set))
+		 (if (and (not is-valid) (consp nval))
+		     (setq nval
+			   (mapcar #'(lambda (x)
+				       (check-valid-instantiator
+					x (specifier-type specifier))
+				       (cons tag-set x))
+				   nval))
+		   (setq nval (cons tag-set nval)))))
+	   (if locale
+	       (setq nval (cons locale nval)))
+	   (add-spec-list-to-specifier
+	    specifier
+	    (canonicalize-spec-list nval (specifier-type specifier))
+	    how-to-add))))
+  value)
+
+(define-specifier-tag 'win 'device-on-window-system-p)