--- a/lisp/ChangeLog	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/ChangeLog	Thu Jun 20 21:19:10 2002 +0000
@@ -1,3 +1,188 @@
+2002-06-20  Ben Wing  <ben@xemacs.org>
+
+	* mule/mule-msw-init-late.el:
+	Specify charset->windows-registry conversion.
+	
+	* mule/mule-x-init.el:
+	* mule/mule-x-init.el (x-use-halfwidth-roman-font):
+	* mule/mule-x-init.el (init-mule-x-win):
+	Delete extra mule font additions here.  Put them in faces.c.
+
+2002-06-20  Ben Wing  <ben@xemacs.org>
+
+	* cl-macs.el (defun*):
+	* cl-macs.el (defmacro*):
+	* cl-macs.el (destructuring-bind):
+	Document better.
+	
+	* font-lock.el (lisp-font-lock-keywords-1):
+	Move Lisp function regexp to lisp-mode.el.
+
+	* lisp-mode.el:
+	* lisp-mode.el (lisp-function-and-type-regexp): New.
+	* lisp-mode.el (lisp-flet-regexp): New.
+	* lisp-mode.el (lisp-indent-function):
+	* lisp-mode.el (lisp-indent-quoteform): New.
+	Various indentation fixes:
+	
+	Handle flet functions better.
+	Handle argument lists in defuns and flets.
+	Handle quoted lists, e.g. property lists -- don't indent like
+	function calls.  Distinguish between lambdas and other lists.
+	
+	* lisp-mode.el (save-selected-device): Handle this form.
+
+	* faces.el:
+	* faces.el (face-property-instance):
+	* faces.el (face-property-matching-instance):
+	* faces.el (set-face-property):
+	* faces.el (set-face-display-table):
+	* faces.el (set-face-underline-p):
+	* faces.el (set-face-strikethru-p):
+	* faces.el (set-face-highlight-p):
+	* faces.el (set-face-blinking-p):
+	* faces.el (face-equal):
+	* faces.el (try-font-name):
+	* faces.el (face-frob-from-locale-first): New.
+	* faces.el (frob-face-property): Removed.
+	* faces.el (included): Removed.
+	* faces.el (frob-face-property-1): Removed.
+	* faces.el (frob-face-font-2): Removed.
+	* faces.el (Face-frob-property-device-considered-current): New.
+	* faces.el (Face-frob-property): New.
+	* faces.el (make-face-family):
+	* faces.el (make-face-bold):
+	* faces.el (make-face-italic):
+	* faces.el (NOTE): New.
+	* faces.el (functions): New.
+	* faces.el (make-face-bold-italic):
+	* faces.el (make-face-unbold):
+	* faces.el (make-face-unitalic):
+	* faces.el (make-face-size):
+	* faces.el (make-face-smaller):
+	* faces.el (make-face-larger):
+	* faces.el (get-frame-background-mode):
+	* faces.el (init-global-faces):
+	* font-menu.el:
+	* font-menu.el (font-menu-set-font):
+	* font-menu.el (font-menu-change-face):
+	* font.el:
+	* font.el (mswindows-font-weight-mappings):
+	* font.el (font-mswindows-font-regexp): Removed.
+	* font.el (mswindows-font-create-object):
+	* font.el (mswindows-font-create-name):
+	* gtk-faces.el (gtk-init-global-faces):
+	* msw-faces.el:
+	* msw-faces.el (mswindows-init-device-faces):
+	* msw-faces.el (mswindows-font-regexp): Removed.
+	* msw-faces.el (mswindows-font-canonicalize-name): Removed.
+	* msw-faces.el (mswindows-canonicalize-font-name): New.
+	* msw-faces.el (mswindows-parse-font-style): New.
+	* msw-faces.el (mswindows-construct-font-style): New.
+	* msw-faces.el (mswindows-frob-font-style): New.
+	* msw-faces.el (mswindows-frob-font-style-and-sizify): New.
+	* msw-faces.el (mswindows-nonbold-weight-regexp): New.
+	* msw-faces.el (mswindows-make-font-unbold):
+	* msw-faces.el (mswindows-bold-weight-regexp): New.
+	* msw-faces.el (mswindows-make-font-italic):
+	* msw-faces.el (mswindows-make-font-bold-mapper): New.
+	* msw-faces.el (mswindows-make-font-unitalic):
+	* msw-faces.el (mswindows-make-font-nonbold-mapper): New.
+	* msw-faces.el (mswindows-make-font-italic-mapper): New.
+	* msw-faces.el (mswindows-make-font-bold-italic):
+	* msw-faces.el (mswindows-make-font-unitalic-mapper): New.
+	* msw-faces.el (mswindows-make-font-bold-italic-mapper): New.
+	* msw-faces.el (mswindows-find-smaller-font):
+	* msw-faces.el (mswindows-find-larger-font):
+	* msw-faces.el (mswindows-available-font-sizes): New.
+	* msw-faces.el (mswindows-frob-font-size): New.
+	* msw-font-menu.el:
+	* msw-font-menu.el (mswindows-font-menu-junk-families):
+	* msw-font-menu.el (mswindows-font-menu-registry-encoding): Removed.
+	* msw-font-menu.el (mswindows-reset-device-font-menus):
+	* msw-font-menu.el (mswindows-font-menu-font-data):
+	* msw-font-menu.el (mswindows-font-menu-load-font):
+	* x-faces.el:
+	* x-faces.el (x-init-global-faces):
+	* x-faces.el (x-init-device-faces):
+	* x-init.el (init-x-win):
+	* x-init.el (init-post-x-win):
+
+	Major overhaul of face-handling code:
+
+	-- Fix lots of bogus code in msw-faces.el, msw-font-menu.el,
+	font-menu.el that was "truenaming" font specs -- i.e. in the
+	process of frobbing a particular field in a general user-specified
+	font spec with wildcarded fields, sticking in particular values
+	for all the remaining wildcarded fields.  This bug was rampant
+	everywhere except in x-faces.el (the oldest and only correctly
+	written code).  This also means that we need to work with font
+	names at all times and not font instances, because a font instance
+	is essentially a truenamed font.
+	
+	-- Total rewrite of extremely junky code in msw-faces.el.  Work
+	with names as well as font instances, and return names; stop
+	truenaming when canonicalizing and frobbing; fix handling of the
+	combined style field, i.e. weight/slant (also fixed in font.el).
+	
+	-- Totally rewrite the frobbing functions in faces.el.  This time,
+	we frob all the instantiators rather than just computing a single
+	instance value and working backwards.  That way, e.g., `bold' will
+	work for all charsets that have bold available, rather than only
+	for whatever charset was part of the computed font instance
+	(another example of the truename virus).  Also fix up code to look
+	at the fallbacks (all of them) when no global value present, so we
+	don't need to put something in the global value.  Intelligently
+	handle a request to frob a buffer locale, rather than signalling
+	an error.  When frobbing instantiators, try hard to figure out
+	what device type is associated with them, and frob each according
+	to its own proper device type.  Correctly handle inheritance
+	vectors given as instantiators.  Preserve existing tags when
+	putting back frobbed instantiators.  Extract out general
+	specifier-frobbing code into specifier.el.  Document everything
+	cleanly.  Do lots of other things better, etc.
+
+	-- Don't duplicatively set a global specification for the default
+	font -- it's already in the fallback and we no longer need a
+	default global specification present.  Delete various code in
+	x-faces.el and msw-faces.el that duplicated the lists of fonts in
+	faces.c.
+
+	-- init-global-faces was not being called at all under MS Windows!
+	Major bogosity. That caused device-specific values to get stuck
+	into all the fonts, making it very hard to change them -- setting
+	global specs caused nothing to happen.
+
+	-- Correct weight names in font.el.
+
+	-- Lots more font fixups in objects*.c.
+	
+	* Printer.el (generic-print-region):
+	Warning fix.
+	
+	* specifier.el:
+	* specifier.el (map-specifier):
+	* specifier.el (modify-specifier-instances):
+	* specifier.el (instance-to-instantiator): New.
+	* specifier.el (device-type-matches-spec): New.
+	* specifier.el (add-tag-to-inst-list): New.
+	* specifier.el (derive-domain-from-locale): New.
+	* specifier.el (derive-device-type-from-tag-set): New.
+	* specifier.el (Specifically): New.
+	* specifier.el (derive-device-type-from-locale-and-tag-set): New.
+	* specifier.el (derive-specifier-specs-from-locale): New.
+	Add more args to map-specifier.
+
+	Add various "heuristic" specifier functions to aid in creation of
+	specifier-munging code such as in faces.el.
+
+	* subr.el:
+	* subr.el (args-out-of-range): New.
+	* subr.el (argument-in-range-p): New.
+	* subr.el (check-argument-range): New.
+	New functions.
+	
+
 2002-06-04  Andy Piper  <andy@xemacs.org>
 
 	* startup.el (normal-top-level): Fix bad merge.

--- a/lisp/cl-macs.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/cl-macs.el	Thu Jun 20 21:19:10 2002 +0000
@@ -113,7 +113,31 @@
 (defmacro defun* (name args &rest body)
   "(defun* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.
 Like normal `defun', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...)."
+and BODY is implicitly surrounded by (block NAME ...).
+
+\"Full Common Lisp conventions\" means that:
+
+-- In addition to &optional and &rest, the lambda-list keywords &key,
+   &allow-other-keys, and &aux are allowed.
+
+-- The format of the arguments to &optional is expanded: As well as simple
+   variables, they can be lists of the form (VAR [INITFORM [SVAR]]); when
+   no argument is available for VAR, INITFORM is evaluated (or nil, if
+   INITFORM is omitted) and stored as VAR's value, and SVAR is bound to t.
+   If an arguent is available for VAR, and INITFORM is unused, SVAR is
+   bound to nil.
+
+-- &key specifies keyword arguments.  The format of each argument is
+   VAR || ( { VAR || (KEYWORD VAR) } [INITFORM [SVAR]])  -- #### document me.
+
+-- &allow-other-keys means that if other keyword arguments are given that are
+   not specifically list in the arg list, they are allowed, rather than an
+   error being signalled.  They can be retrieved with an &rest form.
+
+-- &aux specifies extra bindings, exactly like a `let*' enclosing the body.
+   The format of each binding is VAR || (VAR [INITFORM]) -- exactly like the
+   format of `let'/`let*' bindings.
+"
   (let* ((res (cl-transform-lambda (cons args body) name))
 	 (form (list* 'defun name (cdr res))))
     (if (car res) (list 'progn (car res) form) form)))
@@ -122,7 +146,43 @@
 (defmacro defmacro* (name args &rest body)
   "(defmacro* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro.
 Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...)."
+and BODY is implicitly surrounded by (block NAME ...).
+
+\"Full Common Lisp conventions\" means that:
+
+-- The lambda-list keywords &optional, &rest, &key, &allow-other-keys, and
+   &aux are allowed, as in `defun*'.
+
+-- Three additional lambda-list keywords are allowed: &body, &whole, and
+   &environment.  #### Document me.
+
+-- The macro arg list syntax allows for \"destructuring\" -- see also
+   `destructuring-bind', which destructures exactly like `defmacro*', and
+   `loop', which does a rather different way of destructuring.  Anywhere
+   that a simple argument may appear, and (if following a lambda-list
+   keyword) a list may not normally appear, an embedded lambda list can be
+   substituted.  (The format of the embedded lambda list is exactly the
+   same as for a top-level list except that &environment is not allowed.)
+   When matching this lambda list against a caller-specified argument, that
+   argument is treated as a list and normal lambda-list processing occurs,
+   just as if the entire operation were happening at top level.
+   Furthermore, any lambda list, embedded or top-level, can be dotted at its
+   end, and this will cause matching with an appropriate dotted list given
+   as an argument.
+
+   See `loop' for practical examples of destructuring, but
+   keep in mind that `loop' destructuring is somewhat different from macro
+   destructuring in that
+
+   (a) Macro destructuring has extra features in the various lambda-list
+       keywords, allowing for special processing of a list other than just
+       simple matching.
+   (b) Macro destructuring is strict, in that an error is signalled if the
+       actual structure does not match the expected structure.  On the
+       other hand, loop destructuring is lax -- extra arguments in a list
+       are ignored, not enough arguments cause the remaining parameters to
+       receive a value of nil, etc.
+"
   (let* ((res (cl-transform-lambda (cons args body) name))
 	 (form (list* 'defmacro name (cdr res))))
     (if (car res) (list 'progn (car res) form) form)))
@@ -370,6 +430,26 @@
 
 ;;;###autoload
 (defmacro destructuring-bind (args expr &rest body)
+  "Bind the arguments in ARGS to EXPR then eval BODY.
+This is similar to `let' but it does \"destructuring\", in that it matches
+the structure of ARGS to the structure of EXPR and binds corresponding
+arguments in ARGS to their values in EXPR.  The format of ARGS, and the
+way the destructuring works, is exactly like the destructuring that occurs
+in `defmacro*'; see that for more information.
+
+An alternative means of destructuring is using the `loop' macro. `loop'
+gives practical examples of destructuring.  `defmacro*' describes the
+differences between loop and macro-style destructuring.
+
+You can rewrite a call to (destructuring-bind ARGS EXPR &rest BODY) using
+`loop', approximately like this:
+
+  (loop for ARGS = EXPR
+    return (progn BODY))
+
+I say \"approximately\" because the destructuring works in a somewhat
+different fashion, although for most reasonably simple constructs the
+results will be the same."
   (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil)
 	 (bind-defs nil) (bind-block 'cl-none))
     (cl-do-arglist (or args '(&aux)) expr)

--- a/lisp/faces.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/faces.el	Thu Jun 20 21:19:10 2002 +0000
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Board of Trustees, University of Illinois
-;; Copyright (C) 1995, 1996 Ben Wing
+;; Copyright (C) 1995, 1996, 2002 Ben Wing
 
 ;; Author: Ben Wing <ben@xemacs.org>
 ;; Keywords: faces, internal, dumped
@@ -166,7 +166,7 @@
 	(put face property specifier)))))
 
 (defun face-property-instance (face property
-				    &optional domain default no-fallback)
+			       &optional domain default no-fallback)
   "Return the instance of FACE's PROPERTY in the specified DOMAIN.
 
 Under most circumstances, DOMAIN will be a particular window,
@@ -216,8 +216,8 @@
     value))
 
 (defun face-property-matching-instance (face property matchspec
-					     &optional domain default
-					     no-fallback)
+					&optional domain default
+					no-fallback)
   "Return the instance of FACE's PROPERTY matching MATCHSPEC in DOMAIN.
 Currently the only useful value for MATCHSPEC is a charset, when used
 in conjunction with the face's font; this allows you to retrieve a
@@ -231,12 +231,22 @@
   (setq face (get-face face))
   (let ((value (get face property)))
     (if (specifierp value)
-	(setq value (specifier-matching-instance value matchspec domain
-						 default no-fallback)))
+	(setq value (if (or (charsetp matchspec)
+			    (and (symbolp matchspec)
+				 (find-charset matchspec)))
+			(or 
+			 (specifier-matching-instance
+			  value (cons matchspec nil) domain default
+			  no-fallback)
+			 (specifier-matching-instance
+			  value (cons matchspec t) domain default
+			  no-fallback))
+		      (specifier-matching-instance value matchspec domain
+						   default no-fallback))))
     value))
 
 (defun set-face-property (face property value &optional locale tag-set
-			       how-to-add)
+			  how-to-add)
   "Change a property of FACE.
 
 NOTE: If you want to remove a property from a face, use `remove-face-property'
@@ -636,7 +646,7 @@
   (face-property-instance face 'display-table domain default no-fallback))
 
 (defun set-face-display-table (face display-table &optional locale tag-set
-				    how-to-add)
+			       how-to-add)
   "Change the display table of FACE to DISPLAY-TABLE in LOCALE.
 DISPLAY-TABLE should be a vector as returned by `make-display-table'.
 
@@ -655,7 +665,7 @@
   (face-property-instance face 'underline domain default no-fallback))
 
 (defun set-face-underline-p (face underline-p &optional locale tag-set
-				  how-to-add)
+			     how-to-add)
   "Change the underline property of FACE to UNDERLINE-P.
 UNDERLINE-P is normally a face-boolean instantiator; see
  `make-face-boolean-specifier'.
@@ -670,7 +680,7 @@
   (face-property-instance face 'strikethru domain default no-fallback))
 
 (defun set-face-strikethru-p (face strikethru-p &optional locale tag-set
-				  how-to-add)
+			      how-to-add)
   "Change whether FACE is strikethru-d (i.e. struck through) in LOCALE.
 STRIKETHRU-P is normally a face-boolean instantiator; see
  `make-face-boolean-specifier'.
@@ -685,7 +695,7 @@
   (face-property-instance face 'highlight domain default no-fallback))
 
 (defun set-face-highlight-p (face highlight-p &optional locale tag-set
-				  how-to-add)
+			     how-to-add)
   "Change whether FACE is highlighted in LOCALE (TTY locales only).
 HIGHLIGHT-P is normally a face-boolean instantiator; see
  `make-face-boolean-specifier'.
@@ -714,7 +724,7 @@
   (face-property-instance face 'blinking domain default no-fallback))
 
 (defun set-face-blinking-p (face blinking-p &optional locale tag-set
-				 how-to-add)
+			    how-to-add)
   "Change whether FACE is blinking in LOCALE (TTY locales only).
 BLINKING-P is normally a face-boolean instantiator; see
  `make-face-boolean-specifier'.
@@ -766,11 +776,7 @@
     (and (face-equal-loop common-props face1 face2 domain)
 	 (cond ((eq 'tty (device-type device))
 		(face-equal-loop tty-props face1 face2 domain))
- 	       ;; #### Why isn't this (console-on-window-system-p (device-console device))?
- 	       ;; #### FIXME!
-	       ((or (eq 'x (device-type device))
-		    (eq 'gtk (device-type device))
-		    (eq 'mswindows (device-type device)))
+	       ((console-on-window-system-p (device-console device))
 		(face-equal-loop win-props face1 face2 domain))
 	       (t t)))))
 
@@ -779,12 +785,19 @@
 See `face-property-instance' for the semantics of the DOMAIN argument."
   (not (face-equal face 'default domain)))
 
-; moved from x-faces.el
 (defun try-font-name (name &optional device)
+  "Return NAME if it's a valid font name on DEVICE, else nil."
   ;; yes, name really should be here twice.
   (and name (make-font-instance name device t) name))
 
 
+
+(defcustom face-frob-from-locale-first nil
+  "*If non nil, use kludgy way of frobbing fonts suitable for non-mule
+multi-charset environments."
+  :group 'faces
+  :type 'boolean)
+
 ;; This function is a terrible, disgusting hack!!!!  Need to
 ;; separate out the font elements as separate face properties!
 
@@ -803,204 +816,263 @@
 ;; WE DEMAND LEXICAL SCOPING!!!
 ;; WE DEMAND LEXICAL SCOPING!!!
 ;; WE DEMAND LEXICAL SCOPING!!!
-(defun frob-face-property (face property func device-tags &optional
-locale tags)
-  "Change the specifier for FACE's PROPERTY according to FUNC, in LOCALE.
-This function is ugly and messy and is primarily used as an internal
-helper function for `make-face-bold' et al., so you probably don't
-want to use it or read the rest of the documentation.  But if you do ...
+
+;; When we are initializing a device, it won't be selected; we communicate
+;; the device to consider as selected using this variable.
+(defvar Face-frob-property-device-considered-current nil)
 
-FUNC should be a function of two arguments (an instance and a device)
-that returns a modified name that is valid for the given device.
-If LOCALE specifies a valid domain (i.e. a window, frame, or device),
-this function instantiates the specifier over that domain, applies FUNC
-to the resulting instance, and adds the result back as an instantiator
-for that locale.  Otherwise, LOCALE should be a locale, locale type, or
-'all (defaults to 'all if omitted).  For each specification thusly
-included: if the locale given is a valid domain, FUNC will be
-iterated over all valid instantiators for the device of the domain
-until a non-nil result is found (if there is no such result, the
-first valid instantiator is used), and that result substituted for
-the specification; otherwise, the process just outlined is
-iterated over each existing device and the concatenated results
-substituted for the specification.
+(defun Face-frob-property (face locale tag-set exact-p
+			   unfrobbed-face frobbed-face
+			   win-prop tty-props
+			   frob-mapping standard-face-mapping)
+  ;; implement the semantics of `make-face-bold' et al.  FACE, LOCALE, TAG-SET
+  ;; and EXACT-P are as in that call.  UNFROBBED-FACE and FROBBED-FACE are
+  ;; what we expect the original face and the result to look like,
+  ;; respectively.  TTY-PROPS is a list of face properties to frob in place
+  ;; of `font' for TTY's.  FROB-MAPPING is either a plist mapping device
+  ;; types to functions of two args (NAME DEVICE) that will frob the
+  ;; instantiator as appropriate for the device type (this includes TTY's),
+  ;; or a function to handle the mapping for all device types.
+  ;; STANDARD-FACE-MAPPING is an alist of mappings of inheritance
+  ;; instantiators to be replaced with other inheritance instantiators, meant
+  ;; for e.g. converting [bold] into [bold-italic].
+
+  ;; #### it would be nice if this function could be generalized to be
+  ;; a general specifier frobber.  but so much of what it does is specific
+  ;; to faces -- e.g. handling of inheritance, standard faces,
+  ;; special-casing in various ways for tty's, etc.  i've already extracted
+  ;; as much of the functionality as i can into subfunctions in the
+  ;; heuristic section of specifier.el.
 
-DEVICE-TAGS is a list of tags that each device must match in order for
-the function to be called on it."
-  (let ((sp (face-property face property))
-	temp-sp)
-    (if (valid-specifier-domain-p locale)
-	;; this is easy.
-	(let* ((inst (face-property-instance face property locale))
-	       (name (and inst
-			  (device-matches-specifier-tag-set-p
-			   (dfw-device locale) device-tags)
-			  (funcall func inst (dfw-device locale)))))
-	  (when name
-	    (add-spec-to-specifier sp name locale tags)))
-      ;; otherwise, map over all specifications ...
-      ;; but first, some further kludging:
-      ;; (1) if we're frobbing the global property, make sure
-      ;;     that something is there (copy from the default face,
-      ;;     if necessary).  Otherwise, something like
-      ;;     (make-face-larger 'modeline)
-      ;;     won't do anything at all if the modeline simply
-      ;;     inherits its font from 'default.
-      ;; (2) if we're frobbing a particular locale, nothing would
-      ;;     happen if that locale has no instantiators.  So signal
-      ;;     an error to indicate this.
+  ;; #### Note: The old code was totally different (and there was much less
+  ;; of it).  It didn't bother with trying to frob all the instantiators,
+  ;; or handle inheritance vectors as instantiators, or do something
+  ;; sensible with buffer locales, or many other things. (It always, or
+  ;; usually, did a specifier-instance and frobbed the result.) But it did
+  ;; do three things we don't:
+  ;;
+  ;; (1) Map over all devices when processing global or buffer locales.
+  ;;     Should we be doing this in stages 2 and/or 3?  The fact that we
+  ;;     now process all fallback instantiators seems to make this less
+  ;;     necessary, at least for global locales.
+  ;;
+  ;; (2) Remove all instantiators tagged with `default' when putting the
+  ;;     instantiators back.  I don't see why this is necessary, but maybe
+  ;;     it is.
+  ;;
+  ;; (3) Pay attention to the face-frob-from-locale-first variable. ####
+  ;;     I don't understand its purpose.  Undocumented hacks like this,
+  ;;     clearly added after-the-fact, don't deserve to live.  DOCUMENT
+  ;;     THIS SHIT!
 
+  (flet
+      (
+
+       ;; non-nil if either instantiator non-nil, or nil instantiators allowed.
+       (nil-instantiator-ok (inst devtype-spec)
+	 (or inst (eq devtype-spec 'tty)))
+
+       ;; if LOCALE is a global locale (all, nil, global), return 'global,
+       ;; else nil.
+       (global-locale (locale)
+	 (and (memq locale '(all nil global)) 'global))
 
-      (setq temp-sp (copy-specifier sp))
-      (if (or (eq locale 'global) (eq locale 'all) (not locale))
-	  (when (not (specifier-specs temp-sp 'global))
-	    ;; Try fallback via the official ways and then do it "by hand"
-	    (let* ((fallback (specifier-fallback sp))
-		   (fallback-sp 
-		    (cond ((specifierp fallback) fallback)
-			  ;; just an inst list
-			  (fallback
-			   (make-specifier-and-init (specifier-type sp)
-						    fallback))
-			  ((eq (get-face face) (get-face 'default))
-			   (error "Unable to find global specification"))
-			  ;; If no fallback we snoop from default
-			  (t (face-property 'default property)))))
-	      (copy-specifier fallback-sp temp-sp 'global))))
-      (if (and (valid-specifier-locale-p locale)
-	       (not (specifier-specs temp-sp locale)))
-	  (error "Property must have a specification in locale %S" locale))
-      (map-specifier
-       temp-sp
-       (lambda (sp-arg locale inst-list func)
-	 (let* ((device (dfw-device locale))
-		;; if a device can be derived from the locale,
-		;; call frob-face-property-1 for that device.
-		;; Otherwise map frob-face-property-1 over each device.
-		(result
-		 (if device
-		     (list (and (device-matches-specifier-tag-set-p
-				 device device-tags)
-				(frob-face-property-1 sp-arg device inst-list
-						      func)))
-		   (mapcar (lambda (device)
-			     (and (device-matches-specifier-tag-set-p
-				   device device-tags)
-				  (frob-face-property-1 sp-arg device
-							inst-list func)))
-			   (device-list))))
-		new-result)
-	   ;; remove duplicates and nils from the obtained list of
-	   ;; instantiators. Also add tags amd remove 'defaults'.
-	   (mapcar (lambda (arg)
-		     (when arg
-		       (if (not (consp arg))
-			   (setq arg (cons tags arg))
-			 (setcar arg (append tags (delete 'default
-							  (car arg))))))
-		     (when (and arg (not (member arg new-result)))
-		       (setq new-result (cons arg new-result))))
-		   result)
-	   ;; add back in.
-	   (add-spec-list-to-specifier sp (list (cons locale new-result)))
-	   ;; tell map-specifier to keep going.
-	   nil))
-       locale
-       func))))
+       ;; Given a locale and the inst-list from that locale, frob the
+       ;; instantiators according to FROB-MAPPING, a plist mapping device
+       ;; types to functions that frob instantiators of that device type.
+       ;; NOTE: TAG-SET and FROB-MAPPING from environment.
+       (frob-face-inst-list (locale inst-list prop devtype-spec)
+	 (let* ((ffpdev Face-frob-property-device-considered-current)
+		(results
+		 ;; for each inst-pair, frob it (the result will be 0 or
+		 ;; more inst-pairs; we may get more than one if, e.g. the
+		 ;; instantiator specifies inheritance and we expand the
+		 ;; inheritance); then nconc the results together
+		 (loop for (tag-set . x) in inst-list
+		   for devtype = (derive-device-type-from-locale-and-tag-set
+				  locale tag-set devtype-spec ffpdev)
+		   ;; devtype may be nil if it fails to match DEVTYPE-SPEC
+		   if devtype
+		   if (let* ((mapper (if (functionp frob-mapping) frob-mapping
+				       (plist-get frob-mapping devtype)))
+			     (result
+			      (cond
+			       ;; if a vector ...
+			       ((vectorp x)
+				(let ((change-to
+				       (cdr (assoc x standard-face-mapping))))
+				  (cond
+				   ;; (1) handle standard mappings/null vectors
+				   ((or change-to (null (length x)))
+				    (list (cons tag-set
+						(cond ((eq change-to t) x)
+						      (change-to)
+						      (t x)))))
+				   ;; (2) inheritance vectors.  retrieve the
+				   ;; inherited value and recursively frob.
+				   ;; stick the tag-set into the result.
+				   (t (let*
+					  ((subprop
+					    (if (> (length x) 1) (elt x 1)
+					      prop))
+					   (subinsts
+					    (frob-face-inst-list
+					     locale
+					     (cdar
+					      (specifier-spec-list
+					       (face-property (elt x 0)
+							      subprop)))
+					     subprop devtype-spec)))
+					;; #### we don't currently handle
+					;; the "reverse the sense" flag on
+					;; tty inheritance vectors.
+					(add-tag-to-inst-list subinsts
+							      tag-set))))))
+			       ;; (3) not a vector.  just process it.
+			       (t
+				(let ((value
+				       (if (eq devtype-spec 'tty)
+					   (funcall mapper x)
+					 (funcall mapper x
+						  (derive-domain-from-locale
+						   locale devtype-spec
+						   ffpdev)))))
+				  (and (nil-instantiator-ok value devtype-spec)
+				       (list (cons tag-set value))))))))
+			;; if we're adding to a tty, we need to tag our
+			;; additions with `tty'; see [note 1] below.  we leave
+			;; the old spec in place, however -- if e.g. we're
+			;; italicizing a font that was always set to be
+			;; underlined, even on window systems, then we still
+			;; want the underline there.  unless we put the old
+			;; spec back, the underline will disappear, since
+			;; the new specs are all tagged with `tty'.  this
+			;; doesn't apply to the [note 1] situations below
+			;; because there we're just adding, not substituting.
+			(if (and (eq 'tty devtype-spec)
+				 (not (or (eq 'tty tag-set)
+					  (memq 'tty tag-set))))
+			    (nconc (add-tag-to-inst-list result 'tty)
+				   (list (cons tag-set x)))
+			  result))
+		   nconc it)))
+	   (delete-duplicates results :test #'equal)))
 
-(defun frob-face-property-1 (sp device inst-list func)
-  (let
-      (first-valid result)
-    (while (and inst-list (not result))
-      (let* ((inst-pair (car inst-list))
-	     (tag-set (car inst-pair))
-	     (sp-inst (specifier-instance-from-inst-list
-		       sp device (list inst-pair))))
-	(if sp-inst
-	    (progn
-	      (if (not first-valid)
-		  (setq first-valid inst-pair))
-	      (setq result (funcall func sp-inst device))
-              (if result
-                  (setq result (cons tag-set result))))))
-      (setq inst-list (cdr inst-list)))
-    (or result first-valid)))
+       ;; Frob INST-LIST, which came from LOCALE, and put the new value back
+       ;; into SP at LOCALE.  THUNK is a cons of (PROP . DEVTYPE-SPEC), the
+       ;; property being processed and whether this is a TTY property or a
+       ;; win property.
+       (frob-locale (sp locale inst-list thunk)
+	 (let ((newinst (frob-face-inst-list locale inst-list
+					     (car thunk) (cdr thunk))))
+	   (remove-specifier sp locale tag-set exact-p)
+	   (add-spec-list-to-specifier sp (list (cons locale newinst))))
+	 ;; map-specifier should keep going
+	 nil)
 
-(defcustom face-frob-from-locale-first nil
-  "*If non nil, use kludgy way of frobbing fonts suitable for non-mule
-multi-charset environments."
-  :group 'faces
-  :type 'boolean)
+       ;; map over all specified locales in LOCALE; for each locale,
+       ;; frob the instantiators in that locale in the specifier in both
+       ;; WIN-PROP and TTY-PROPS in FACE.  Takes values from environment.
+       (map-over-locales (locale)
+	 (map-specifier (get face win-prop) #'frob-locale locale
+			(cons win-prop 'window-system)
+			tag-set exact-p)
+	 (loop for prop in tty-props do
+	   (map-specifier (get face prop) #'frob-locale locale
+			  (cons prop 'tty)
+			  tag-set exact-p)))
+
+       ;; end of flets
+       )
+
+    ;; the function itself
 
-(defun frob-face-font-2 (face locale tags unfrobbed-face frobbed-face
-			      tty-thunk ws-thunk standard-face-mapping)
-  ;; another kludge to make things more intuitive.  If we're
-  ;; inheriting from a standard face in this locale, frob the
-  ;; inheritance as appropriate.  Else, if, after the first
-  ;; window-system frobbing pass, the face hasn't changed and still
-  ;; looks like the standard unfrobbed face (e.g. 'default), make it
-  ;; inherit from the standard frobbed face (e.g. 'bold).  Regardless
-  ;; of things, do the TTY frobbing.
+    (let* ((ffpdev Face-frob-property-device-considered-current)
+	   (do-later-stages
+	    (or (global-locale locale)
+		(valid-specifier-domain-p locale)
+		(bufferp locale)))
+	   (domain (and do-later-stages
+			(derive-domain-from-locale locale 'window-system
+						   ffpdev)))
+	   (check-differences
+	    (and unfrobbed-face frobbed-face domain
+		 (not (memq (face-name face)
+			    '(default bold italic bold-italic)))))
+	   (orig-instance
+	    (and check-differences
+		 (face-property-instance face win-prop domain))))
+
+      ;; first do the frobbing
+      (setq face (get-face face))
+      (map-over-locales locale)
+
+      (when do-later-stages
+
+	(if (global-locale locale) (setq locale 'global))
 
-  ;; yuck -- The LOCALE argument to make-face-bold is not actually a locale,
-  ;; but is a "locale, locale-type, or nil for all".  So ...  do our extra
-  ;; frobbing only if it's actually a locale; or for nil, do the frobbing
-  ;; on 'global.  This specifier stuff needs some rethinking.
-  (let* ((the-locale (cond ((null locale) 'global)
-			   ((valid-specifier-locale-p locale) locale)
-			   (t nil)))
-	 (spec-list
-	  (and
-	   the-locale
-	   (specifier-spec-list (get (get-face face) 'font) the-locale tags t)))
-	 (change-it
-	  (and
-	   spec-list
-	   (cdr (assoc (cdadar spec-list) standard-face-mapping)))))
-    (if (and change-it
-	     (not (memq (face-name (find-face face))
-			'(default bold italic bold-italic))))
-	(progn
-	  (or (equal change-it t)
-	      (set-face-property face 'font change-it the-locale tags))
-	  (funcall tty-thunk))
-      (let* ((domain (cond ((null the-locale) nil)
-			   ((valid-specifier-domain-p the-locale) the-locale)
-			   ;; OK, this next one is truly a kludge, but
-			   ;; it results in more intuitive behavior most
-			   ;; of the time. (really!)
-			   ((or (eq the-locale 'global) (eq the-locale 'all))
-			    (selected-device))
-			   (t nil)))
-	     (inst (and domain (face-property-instance face 'font domain))))
-	;; If it's reasonable to do the inherit-from-standard-face trick,
-	;; and it's called for, then do it now.
-	(if (and
-	     face-frob-from-locale-first
-	     (eq the-locale 'global)
-	     domain
-	     (equal inst (face-property-instance face 'font domain))
-	     ;; don't do it for standard faces, or you'll get inheritance loops.
-	     ;; #### This makes XEmacs seg fault! fix this bug.
-	     (not (memq (face-name (find-face face))
-			'(default bold italic bold-italic)))
-	     (equal (face-property-instance face 'font domain)
-		    (face-property-instance unfrobbed-face 'font domain)))
-	    (set-face-property face 'font (vector frobbed-face)
-			       the-locale tags)
-	  ;; and only otherwise try to build new property value artificially
-	  (funcall tty-thunk)
-	  (funcall ws-thunk)
-	  (and
-	   domain
-	   (equal inst (face-property-instance face 'font domain))
-	   ;; don't do it for standard faces, or you'll get inheritance loops.
-	   ;; #### This makes XEmacs seg fault! fix this bug.
-	   (not (memq (face-name (find-face face))
-		      '(default bold italic bold-italic)))
-	   (equal (face-property-instance face 'font domain)
-		  (face-property-instance unfrobbed-face 'font domain))
-	   (set-face-property face 'font (vector frobbed-face) the-locale tags)))))))
+	;; now do the second stage -- if there's nothing there, try
+	;; harder to find an instantiator, and frob it.
+	(let (do-something)
+	  (loop for prop in (cons win-prop tty-props)
+	    for propspec = (get face prop)
+	    for devtype-spec = (if (eq prop win-prop) 'window-system 'tty)
+	    if propspec
+	    do
+	    (or (specifier-spec-list propspec locale)
+		(let ((doit (derive-specifier-specs-from-locale
+			     propspec locale devtype-spec ffpdev
+			     ;; #### does this make sense?  When no tags
+			     ;; given, frob the whole list of fallbacks when
+			     ;; global, else just retrieve a current-device
+			     ;; value.  this tries to mirror normal practices,
+			     ;; where with no tags you want everything frobbed,
+			     ;; but with a tag you want only the tag frobbed
+			     ;; and hence you probably don't want lots and lots
+			     ;; of items there. (#### Perhaps the best way --
+			     ;; or at least a way with some theoretical
+			     ;; justifiability -- is to fetch the fallbacks
+			     ;; that match the TAG-SET/EXACT-P, and if none,
+			     ;; fall back onto doing the selected-device
+			     ;; trick.)
+			     (and (not tag-set) (not exact-p)))))
+		  (if (and (not doit) (eq locale 'global))
+		      (error
+		       "No fallback for specifier property %s in face %s???"
+		       prop face))
+		  ;; [note 1] whenever we add to a tty property,
+		  ;; make sure we tag our additions with `tty' to
+		  ;; avoid accidentally messing things up on window
+		  ;; systems (e.g. when making things italic we
+		  ;; don't want to set the underline property on
+		  ;; window systems)
+		  (when doit
+		    (add-spec-list-to-specifier
+		     propspec
+		     (list (cons locale
+				 (add-tag-to-inst-list
+				  doit
+				  (append (if (listp tag-set) tag-set
+					    (list tag-set))
+					  (if (eq devtype-spec 'tty) '(tty)))
+				  ))))
+		    (setq do-something t)))))
+	  (when do-something
+	    (map-over-locales (or (global-locale locale) locale))))
+
+	;; then do the third stage -- check for whether we have to do
+	;; the inheritance trick.
+
+	(when (and check-differences
+		   (let ((new-instance
+			  (face-property-instance face win-prop domain)))
+		     (and
+		      (equal orig-instance new-instance)
+		      (equal orig-instance
+			     (face-property-instance unfrobbed-face win-prop
+						     domain)))))
+	  (set-face-property face win-prop (vector frobbed-face)
+			     (or (global-locale locale) locale) tag-set))))))
 
 ;; WE DEMAND FOUNDRY FROBBING!
 
@@ -1008,253 +1080,263 @@
 ;; Thx Jan Vroonhof, Ref xemacs-beta <87oflypbum.fsf@petteflet.ntlworld.com>
 ;; Brainlessly derived from make-face-size by Stephen; don't blame Jan.
 ;; I'm long since flown to Rio, it does you little good to blame me, either.
-(defun make-face-family (face family &optional locale tags)
-  "Set FACE's family to FAMILY in LOCALE, if possible.
+(defun make-face-family (face family &optional locale tags exact-p)
+  "Set FACE's family to FAMILY in LOCALE, if possible."
+  (interactive (list (read-face-name "Set family of which face: ")
+		     (read-string "Family to set: ")))
 
-Add/replace settings specified by TAGS only."
-  (frob-face-property face 'font
-		      ;; uses dynamic scope of family
-		      #'(lambda (f d)
+  (Face-frob-property face locale tags exact-p
+		      nil nil 'font nil
+		      `(lambda (f d)
 			  ;; keep the dependency on font.el for now
-			  (let ((fo (font-create-object (font-instance-name f)
-							d)))
-			    (set-font-family fo family)
+			  (let ((fo (font-create-object f d)))
+			    (set-font-family fo ,family)
 			    (font-create-name fo d)))
-		      nil locale tags))
+		      nil))
 
 ;; Style (ie, typographical face) frobbing
-(defun make-face-bold (face &optional locale tags)
+(defun make-face-bold (face &optional locale tags exact-p)
   "Make FACE bold in LOCALE, if possible.
-This will attempt to make the font bold for X/MSW locales and will set the
-highlight flag for TTY locales.
+This will attempt to make the font bold for window-system locales and will
+set the highlight flag for TTY locales.
+
+The actual behavior of this function is somewhat messy, in an attempt to
+get more intuitive behavior in quite a lot of different circumstances. (You
+might view this as indicative of design failures with specifiers, but in
+fact almost all code that attempts to interface to humans and produce
+\"intuitive\" results gets messy, particularly with a system as complicated
+as specifiers, whose complexity results from an attempt to work well in
+many different circumstances.)
+
+The meaning of LOCALE is the same as for `specifier-spec-list', i.e.:
+
+-- If LOCALE is nil, omitted, or `all', this will attempt to \"frob\" all
+   font specifications for FACE to make them appear bold (i.e. the
+   specifications are replaced with equivalent specifications, where the
+   font names have been changed to the closest bold font).
+
+-- If LOCALE is a locale type \(`buffer', `window', etc.), this frobs all
+   font specifications for locales of that type.
+
+-- If LOCALE is a particular locale, this frobs all font specifications for
+   that locale.
 
-If LOCALE is nil, omitted, or `all', this will attempt to frob all
-font specifications for FACE to make them appear bold.  Similarly, if
-LOCALE is a locale type, this frobs all font specifications for locales
-of that type.  If LOCALE is a particular locale, what happens depends on
-what sort of locale is given.  If you gave a device, frame, or window,
-then it's always possible to determine what the font actually will be,
-so this is determined and the resulting font is frobbed and added back as a
-specification for this locale.  If LOCALE is a buffer, however, you can't
-determine what the font will actually be unless there's actually a
-specification given for that particular buffer (otherwise, it depends
-on what window and frame the buffer appears in, and might not even be
-well-defined if the buffer appears multiple times in different places);
-therefore you will get an error unless there's a specification for the
-buffer.
+If TAGS is given, this only processes instantiators whose tag set includes
+all tags mentioned in TAGS.  In addition, if EXACT-P is non-nil, only
+instantiators whose tag set exactly matches TAGS are processed; otherwise,
+additional tags may be present in the instantiator's tag set.
+
+This function proceeeds in three stages.
+
+STAGE 1: Frob the settings that are already present.
+STAGE 2: (if called for) Ensure that *some* setting exists in the locale
+         that was given, finding it in various ways and frobbing it as in
+         stage 1.  This ensures that there is an actual setting for
+         the locale, so you will get the expected buffer-local/frame-local
+         behavior -- changes to the global value, to other locales, won't
+         affect this locale, (b) the face will actually look bold in
+         the locale.
+STAGE 3: (if called for) 
+
+The way the frobbing works depends on the device type -- first on whether
+or not it's TTY, and second, if it's a window-system device type, on which
+particular window-system device type.  For locales with a specific device
+type, we do the frobbing in the context of that device type -- this means
+that for TTY device types we set the highlight flag, and for window-system
+device types we modify the font spec according to the rules for font specs
+of that device type.  For global locales, we may process both the highlight
+flag and the font specs (depending on the device types compiled into this
+XEmacs).  When processing font specs, we check the tag set associated with
+each font spec to see if it's specific to a particular device type; if so,
+we frob it in the context of that type, else we use the type of the current
+device. (A hack, but works well in practice -- and if a new device is
+created, we will automatically frob all the standard fonts to make sure
+they display OK on that device.)
+
+If LOCALE is not a locale type, and both TAGS and EXACT-P are omitted, we
+do further frobbing in an attempt to give more intuitive behavior.
 
-Finally, in some cases (specifically, when LOCALE is not a locale type),
-if the frobbing didn't actually make the font look any different
-\(this happens, for example, if your font specification is already bold
-or has no bold equivalent), and currently looks like the font of the
-'default face, it is set to inherit from the 'bold face.  This is kludgy
-but it makes `make-face-bold' have more intuitive behavior in many
-circumstances."
+First, if there are no specifications in LOCALE (if LOCALE is `all', we act
+as if it were `global' for this step), we do our utmost to put a
+specification there; otherwise, this function will have no effect.  For
+device, frame, or window locales, the face's font is instantiated using the
+locale as a domain, and the resulting font is frobbed and added back as a
+specification for this locale.  If LOCALE is `global', we retrieve the
+fallback specs and frob them.  If LOCALE is a buffer, things get tricky
+since you can't instantiate a specifier in a buffer domain \(the buffer can
+appear in multiple places, or in different places over time, so this
+operation is not well-defined).  We used to signal an error in this case,
+but now we instead try to do something logical so that we work somewhat
+similarly to buffer-local variables.  Specifically, we use
+`get-buffer-window' to find a window viewing the buffer, and if there is
+one, use this as a domain to instantiate the font, and frob the resulting
+value.  Otherwise, we use the selected window for the same purpose.
+
+Finally, if the frobbing didn't actually make the font look any different
+in whatever domain we instantiated the font in (this happens, for example,
+if your font specification is already bold or has no bold equivalent; note
+that in this step, we use the selected device in place of `global' or `all'
+-- another hack, but works well in practice since there's usually only one
+device), and the font currently looks like the font of the `default' face,
+it is set to inherit from the `bold' face.
+
+NOTE: For the other functions defined below, the identity of these two
+standard faces mentioned in the previous paragraph, and the TTY properties
+that are modified, may be different, and whether the TTY property or
+properties are set or unset may be different.  For example, for
+`make-face-unitalic', the last sentence in the previous paragraph would
+read \"... and the font currently looks like the font of the `italic' face,
+it is set to inherit from the `default' face.\", and the second sentence in
+the first paragraph would read \"This will attempt to make the font
+non-italic for window-system locales and will unset the underline flag for
+TTY locales.\"
+
+Here's a table indicating the behavior differences with the different
+functions:
+
+function                face1     face2         tty-props            tty-val
+----------------------------------------------------------------------------
+make-face-bold          default   bold          highlight            t
+make-face-italic        default   italic        underline            t
+make-face-bold-italic   default   bold-italic   highlight,underline  t
+make-face-unbold        bold      default       highlight            nil
+make-face-unitalic      italic    default       underline            nil
+"
   (interactive (list (read-face-name "Make which face bold: ")))
-  (frob-face-font-2
-   face locale tags 'default 'bold
-   (lambda ()
-     ;; handle TTY specific entries
-     (when (featurep 'tty)
-       (set-face-highlight-p face t locale (cons 'tty tags))))
-   (lambda ()
-     ;; handle window-system specific entries
-     (when (featurep 'gtk)
-       (frob-face-property face 'font 'gtk-make-font-bold
-			   '(gtk) locale tags))
-     (when (featurep 'x)
-       (frob-face-property face 'font 'x-make-font-bold
-			   '(x) locale tags))
-     (when (featurep 'mswindows)
-       (frob-face-property face 'font 'mswindows-make-font-bold
-			   '(mswindows) locale tags)
-       (frob-face-property face 'font 'mswindows-make-font-bold
-			   '(msprinter) locale tags))
-     )
-   '(([default] . [bold])
-     ([bold] . t)
-     ([italic] . [bold-italic])
-     ([bold-italic] . t))))
+  (Face-frob-property face locale tags exact-p
+		      'default 'bold 'font '(highlight)
+		      '(tty		(lambda (x) t)
+			x		x-make-font-bold
+			gtk		gtk-make-font-bold
+			mswindows	mswindows-make-font-bold
+			msprinter	mswindows-make-font-bold)
+		      '(([default] . [bold])
+			([bold] . t)
+			([italic] . [bold-italic])
+			([bold-italic] . t))))
 
-(defun make-face-italic (face &optional locale tags)
+(defun make-face-italic (face &optional locale tags exact-p)
   "Make FACE italic in LOCALE, if possible.
 This will attempt to make the font italic for X/MS Windows locales and
 will set the underline flag for TTY locales.  See `make-face-bold' for
 the semantics of the LOCALE argument and for more specifics on exactly
 how this function works."
   (interactive (list (read-face-name "Make which face italic: ")))
-  (frob-face-font-2
-   face locale tags 'default 'italic
-   (lambda ()
-     ;; handle TTY specific entries
-     (when (featurep 'tty)
-       (set-face-underline-p face t locale (cons 'tty tags))))
-   (lambda ()
-     ;; handle window-system specific entries
-     (when (featurep 'gtk)
-       (frob-face-property face 'font 'gtk-make-font-italic
-			   '(gtk) locale tags))
-     (when (featurep 'x)
-       (frob-face-property face 'font 'x-make-font-italic
-			   '(x) locale tags))
-     (when (featurep 'mswindows)
-       (frob-face-property face 'font 'mswindows-make-font-italic
-			   '(mswindows) locale tags)
-       (frob-face-property face 'font 'mswindows-make-font-italic
-			   '(msprinter) locale tags))
-     )
-   '(([default] . [italic])
-     ([bold] . [bold-italic])
-     ([italic] . t)
-     ([bold-italic] . t))))
+  (Face-frob-property face locale tags exact-p
+		      'default 'italic 'font '(underline)
+		      '(tty		(lambda (x) t)
+			x		x-make-font-italic
+			gtk		gtk-make-font-italic
+			mswindows	mswindows-make-font-italic
+			msprinter	mswindows-make-font-italic)
+		      '(([default] . [italic])
+			([bold] . [bold-italic])
+			([italic] . t)
+			([bold-italic] . t))))
 
-(defun make-face-bold-italic (face &optional locale tags)
+(defun make-face-bold-italic (face &optional locale tags exact-p)
   "Make FACE bold and italic in LOCALE, if possible.
 This will attempt to make the font bold-italic for X/MS Windows
 locales and will set the highlight and underline flags for TTY
 locales.  See `make-face-bold' for the semantics of the LOCALE
 argument and for more specifics on exactly how this function works."
   (interactive (list (read-face-name "Make which face bold-italic: ")))
-  (frob-face-font-2
-   face locale tags 'default 'bold-italic
-   (lambda ()
-     ;; handle TTY specific entries
-     (when (featurep 'tty)
-       (set-face-highlight-p face t locale (cons 'tty tags))
-       (set-face-underline-p face t locale (cons 'tty tags))))
-   (lambda ()
-     ;; handle window-system specific entries
-     (when (featurep 'gtk)
-       (frob-face-property face 'font 'gtk-make-font-bold-italic
-			   '(gtk) locale tags))
-     (when (featurep 'x)
-       (frob-face-property face 'font 'x-make-font-bold-italic
-			   '(x) locale tags))
-     (when (featurep 'mswindows)
-       (frob-face-property face 'font 'mswindows-make-font-bold-italic
-			   '(mswindows) locale tags)
-       (frob-face-property face 'font 'mswindows-make-font-bold-italic
-			   '(msprinter) locale tags))
-     )
-   '(([default] . [italic])
-     ([bold] . [bold-italic])
-     ([italic] . [bold-italic])
-     ([bold-italic] . t))))
+  (Face-frob-property face locale tags exact-p
+		      'default 'bold-italic 'font '(underline highlight)
+		      '(tty		(lambda (x) t)
+			x		x-make-font-bold-italic
+			gtk		gtk-make-font-bold-italic
+			mswindows	mswindows-make-font-bold-italic
+			msprinter	mswindows-make-font-bold-italic)
+		      '(([default] . [italic])
+			([bold] . [bold-italic])
+			([italic] . [bold-italic])
+			([bold-italic] . t))))
 
-(defun make-face-unbold (face &optional locale tags)
+
+(defun make-face-unbold (face &optional locale tags exact-p)
   "Make FACE non-bold in LOCALE, if possible.
 This will attempt to make the font non-bold for X/MS Windows locales
 and will unset the highlight flag for TTY locales.  See
 `make-face-bold' for the semantics of the LOCALE argument and for more
 specifics on exactly how this function works."
   (interactive (list (read-face-name "Make which face non-bold: ")))
-  (frob-face-font-2
-   face locale tags 'bold 'default
-   (lambda ()
-     ;; handle TTY specific entries
-     (when (featurep 'tty)
-       (set-face-highlight-p face nil locale (cons 'tty tags))))
-   (lambda ()
-     ;; handle window-system specific entries
-     (when (featurep 'gtk)
-       (frob-face-property face 'font 'gtk-make-font-unbold
-			   '(gtk) locale tags))
-     (when (featurep 'x)
-       (frob-face-property face 'font 'x-make-font-unbold
-			   '(x) locale tags))
-     (when (featurep 'mswindows)
-       (frob-face-property face 'font 'mswindows-make-font-unbold
-			   '(mswindows) locale tags)
-       (frob-face-property face 'font 'mswindows-make-font-unbold
-			   '(msprinter) locale tags))
-     )
-   '(([default] . t)
-     ([bold] . [default])
-     ([italic] . t)
-     ([bold-italic] . [italic]))))
+  (Face-frob-property face locale tags exact-p
+		      'bold 'default 'font '(highlight)
+		      '(tty		(lambda (x) nil)
+			x		x-make-font-unbold
+			gtk		gtk-make-font-unbold
+			mswindows	mswindows-make-font-unbold
+			msprinter	mswindows-make-font-unbold)
+		      '(([default] . t)
+			([bold] . [default])
+			([italic] . t)
+			([bold-italic] . [italic]))))
 
-(defun make-face-unitalic (face &optional locale tags)
+(defun make-face-unitalic (face &optional locale tags exact-p)
   "Make FACE non-italic in LOCALE, if possible.
 This will attempt to make the font non-italic for X/MS Windows locales
 and will unset the underline flag for TTY locales.  See
 `make-face-bold' for the semantics of the LOCALE argument and for more
 specifics on exactly how this function works."
   (interactive (list (read-face-name "Make which face non-italic: ")))
-  (frob-face-font-2
-   face locale tags 'italic 'default
-   (lambda ()
-     ;; handle TTY specific entries
-     (when (featurep 'tty)
-       (set-face-underline-p face nil locale (cons 'tty tags))))
-   (lambda ()
-     ;; handle window-system specific entries
-     (when (featurep 'gtk)
-       (frob-face-property face 'font 'gtk-make-font-unitalic
-			   '(gtk) locale tags))
-     (when (featurep 'x)
-       (frob-face-property face 'font 'x-make-font-unitalic
-			   '(x) locale tags))
-     (when (featurep 'mswindows)
-       (frob-face-property face 'font 'mswindows-make-font-unitalic
-			   '(mswindows) locale tags)
-       (frob-face-property face 'font 'mswindows-make-font-unitalic
-			   '(msprinter) locale tags))
-     )
-   '(([default] . t)
-     ([bold] . t)
-     ([italic] . [default])
-     ([bold-italic] . [bold]))))
+  (Face-frob-property face locale tags exact-p
+		      'italic 'default 'font '(underline)
+		      '(tty		(lambda (x) nil)
+			x		x-make-font-unitalic
+			gtk		gtk-make-font-unitalic
+			mswindows	mswindows-make-font-unitalic
+			msprinter	mswindows-make-font-unitalic)
+		      '(([default] . t)
+			([bold] . t)
+			([italic] . [default])
+			([bold-italic] . [bold]))))
 
 
 ;; Size frobbing
 ;; Thx Jan Vroonhof, Ref xemacs-beta <87oflypbum.fsf@petteflet.ntlworld.com>
 ;; Jan had a separate helper function 
-(defun make-face-size (face size &optional locale tags)
-  "Adjust FACE to SIZE in LOCALE, if possible.
-
-Add/replace settings specified by TAGS only."
-  (frob-face-property face 'font
-		      ;; uses dynamic scope of size
-		      #'(lambda (f d)
-			  ;; keep the dependency on font.el for now
-			  (let ((fo (font-create-object (font-instance-name f)
-							d)))
-			    (set-font-size fo size)
-			    (font-create-name fo d)))
-		      nil locale tags))
+(defun make-face-size (face size &optional locale tags exact-p)
+  "Adjust FACE to SIZE in LOCALE, if possible."
+  (interactive (list (read-face-name "Set size of which face: ")
+		     (read-number "Size to set: " t 10)))
+  (Face-frob-property face locale tags exact-p
+		      nil nil 'font nil
+		      `(lambda (f d)
+			 ;; keep the dependency on font.el for now
+			 (let ((fo (font-create-object f d)))
+			   (set-font-size fo ,size)
+			   (font-create-name fo d)))
+		      nil))
 
 ;; Why do the following two functions lose so badly in so many
 ;; circumstances?
 
-(defun make-face-smaller (face &optional locale)
+(defun make-face-smaller (face &optional locale tags exact-p)
   "Make the font of FACE be smaller, if possible.
 LOCALE works as in `make-face-bold' et al., but the ``inheriting-
 from-the-bold-face'' operations described there are not done
 because they don't make sense in this context."
   (interactive (list (read-face-name "Shrink which face: ")))
-  ;; handle X specific entries
-  (when (featurep 'x)
-    (frob-face-property face 'font 'x-find-smaller-font
-			'(x) locale))
-  (when (featurep 'mswindows)
-    (frob-face-property face 'font 'mswindows-find-smaller-font
-			'(mswindows) locale)
-    (frob-face-property face 'font 'mswindows-find-smaller-font
-			'(msprinter) locale)))
+  (Face-frob-property face locale tags exact-p
+		      nil nil 'font nil
+		      '(x		x-find-smaller-font
+			gtk		gtk-find-smaller-font
+			mswindows	mswindows-find-smaller-font
+			msprinter	mswindows-find-smaller-font)
+		      nil))
 
-(defun make-face-larger (face &optional locale)
+(defun make-face-larger (face &optional locale tags exact-p)
   "Make the font of FACE be larger, if possible.
 See `make-face-smaller' for the semantics of the LOCALE argument."
   (interactive (list (read-face-name "Enlarge which face: ")))
-  ;; handle X specific entries
-  (when (featurep 'x)
-    (frob-face-property face 'font 'x-find-larger-font
-			'(x) locale))
-  (when (featurep 'mswindows)
-    (frob-face-property face 'font 'mswindows-find-larger-font
-			'(mswindows) locale)
-    (frob-face-property face 'font 'mswindows-find-larger-font
-			'(msprinter) locale)))
+  (Face-frob-property face locale tags exact-p
+		      nil nil 'font nil
+		      '(x		x-find-larger-font
+			gtk		gtk-find-larger-font
+			mswindows	mswindows-find-larger-font
+			msprinter	mswindows-find-larger-font)
+		      nil))
 
 (defun invert-face (face &optional locale)
   "Swap the foreground and background colors of the face."
@@ -1320,9 +1402,12 @@
 		   (if (< (apply '+ (color-instance-rgb-components
 				     color-instance)) 65536)
 		       'dark 'light)
-		 ;; Here, we get an error on a TTY.  As we don't have
-		 ;; a good way of detecting whether a TTY is light or
-		 ;; dark, we'll guess it's dark.
+		 ;; Here, we get an error on a TTY (Return value from
+		 ;; color-instance-rgb-components is nil), and on the
+		 ;; initial stream device (Return value from
+		 ;; face-background-instance is nil).  As we don't have a
+		 ;; good way of detecting whether a TTY is light or dark,
+		 ;; we'll guess it's dark.
 		 (error 'dark))))
     (set-frame-property frame 'background-mode mode)
     mode))
@@ -1587,42 +1672,36 @@
 	  ;; Is there anything which should be done for TTY's?
 	  )))
 
-;; #### This is somewhat X-specific, and is called when the first
-;; X device is created (even if there were TTY devices created
-;; beforehand).  The concept of resources has not been generalized
-;; outside of X-specificness, so we have to live with this
-;; breach of device-independence.
+;; Called when the first device created.
 
-(defun init-global-faces ()
-  ;; Look for global face resources.
-  (loop for face in (face-list) do
-	(init-face-from-resources face 'global))
-  ;; Further X frobbing.
-  (and (featurep 'x) (declare-fboundp (x-init-global-faces)))
-  (and (featurep 'gtk) (declare-fboundp (gtk-init-global-faces)))
-  (and (featurep 'mswindows) (declare-fboundp (mswindows-init-global-faces)))
+(defun init-global-faces (device)
+  (let ((Face-frob-property-device-considered-current device))
+    ;; Look for global face resources.
+    (loop for face in (face-list) do
+      (init-face-from-resources face 'global))
+    ;; Further frobbing.
+    (and (featurep 'x) (declare-fboundp (x-init-global-faces)))
+    (and (featurep 'gtk) (declare-fboundp (gtk-init-global-faces)))
+    (and (featurep 'mswindows) (declare-fboundp (mswindows-init-global-faces)))
 
-  ;; for bold and the like, make the global specification be bold etc.
-  ;; if the user didn't already specify a value.  These will also be
-  ;; frobbed further in init-other-random-faces.
-  (unless (face-font 'bold 'global)
-    (make-face-bold 'bold 'global))
-  ;;
-  (unless (face-font 'italic 'global)
-    (make-face-italic 'italic 'global))
-  ;;
-  (unless (face-font 'bold-italic 'global)
-    (make-face-bold-italic 'bold-italic 'global)
+    ;; for bold and the like, make the global specification be bold etc.
+    ;; if the user didn't already specify a value.  These will also be
+    ;; frobbed further in init-other-random-faces.
+    (unless (face-font 'bold 'global)
+      (make-face-bold 'bold 'global))
+    ;;
+    (unless (face-font 'italic 'global)
+      (make-face-italic 'italic 'global))
+    ;;
     (unless (face-font 'bold-italic 'global)
-      (copy-face 'bold 'bold-italic)
-      (make-face-italic 'bold-italic)))
+      (make-face-bold-italic 'bold-italic 'global)
+      (unless (face-font 'bold-italic 'global)
+	(copy-face 'bold 'bold-italic)
+	(make-face-italic 'bold-italic)))
 
-  (when (face-equal 'bold 'bold-italic)
-    (copy-face 'italic 'bold-italic)
-    (make-face-bold 'bold-italic))
-  ;;
-  ;; Nothing more to be done for X or TTY's?
-  )
+    (when (face-equal 'bold 'bold-italic device)
+      (copy-face 'italic 'bold-italic)
+      (make-face-bold 'bold-italic))))
 
 
 ;; These warnings are there for a reason.  Just specify your fonts

--- a/lisp/font-lock.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/font-lock.el	Thu Jun 20 21:19:10 2002 +0000
@@ -1944,30 +1944,28 @@
    ;; generally more like variables (no parameters), and the function and
    ;; keyword colors are currently the same, while the variable color is
    ;; different, which looks better.
-   (list (concat "^(\\(def\\("
-		  ;; Function declarations.
-		 "\\(un\\|advice\\|alias\\|macro\\|macro\\*\\|setf\\|subst\\|"
-		 "subst\\*\\|-edebug-spec\\|"
-		 "ine-\\(ccl-program\\|compatible-function-alias\\|"
-		 "compiler-macro\\|device-method\\|device-method\\*\\|"
-		 "function\\|function-when-void\\|modify-macro\\|"
-		 "obsolete-function-alias\\|prefix-command\\|setf-method\\|"
-		 "skeleton\\)\\)\\|"
-		  ;; Structure declarations.
-		  "\\(class\\|struct\\|type\\)\\|"
-		  ;; Former variable declarations, but woefully inadequate.
-		  ;"\\(const\\(\\|ant\\)\\|ine-key\\(\\|-after\\)\\|var\\|custom\\)\\|"
-		  ;; Everything else is a function declaration.
-		  "\\([^ \t\n\(\)]+\\)"
-		  "\\)\\)\\>"
-		  ;; Any whitespace and declared object.
-		  "[ \t'\(]*"
-		  "\\([^ \t\n\)]+\\)?")
-	  '(1 font-lock-keyword-face)
-	  '(7 (cond ((match-beginning 3) 'font-lock-function-name-face)
-		    ((match-beginning 5) 'font-lock-type-face)
-		    (t 'font-lock-variable-name-face))
-	      nil t))
+   (list (concat
+	  "^(\\(" lisp-function-and-type-regexp
+	  ;; Former variable declarations, but woefully inadequate.
+	  ;; "\\|def\\(const\\(\\|ant\\)\\|ine-key\\(\\|-after\\)\\|"
+	  ;; "var\\|custom\\)"
+	  ;; Everything else is a variable declaration.
+	  ;; anything else is a variable
+	  "\\|def\\([^ \t\n\(\)]+\\)"
+	  ;; make sure we are at end of word.
+	  "\\)\\>"
+	  ;; Any whitespace following and declared object.
+	  "[ \t'\(]*"
+	  "\\([^ \t\n\)]+\\)?")
+	 ;; Note about numbering:  #1 is the grouping around the whole
+	 ;; keyword.  #2 - #4 are in lisp-function-and-type-regexp.
+	 ;; #5 is for variables. (Must be set if neither #3 nor #4 are.)
+	 ;; #6 for the following object.
+	 '(1 font-lock-keyword-face)
+	 '(6 (cond ((match-beginning 3) 'font-lock-function-name-face)
+		   ((match-beginning 4) 'font-lock-type-face)
+		   (t 'font-lock-variable-name-face))
+	   nil t))
    )
  "Subdued level highlighting Lisp modes.")
 

--- a/lisp/font-menu.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/font-menu.el	Thu Jun 20 21:19:10 2002 +0000
@@ -64,10 +64,6 @@
 ;;; `reset-device-font-menus' to rebuild the menus from all currently
 ;;; available fonts.
 ;;;
-;;; There is knowledge here about the regexp match numbers in
-;;; `mswindows-font-regexp' and `mswindows-font-regexp-foundry-and-family' defined in
-;;; mswindows-faces.el.
-;;;
 ;;; There are at least three kinds of fonts under X11r5:
 ;;;
 ;;; - bitmap fonts, which can be assumed to look as good as possible;
@@ -297,14 +293,15 @@
     (when weight
       (signal 'error '("Setting weight currently not supported")))
     (setq new-default-face-font
-	  (font-menu-load-font
-	   (or family from-family)
-	   (or weight from-weight)
-	   (or size   from-size)
-	   from-slant
-	   (specifier-instance
-	    font-menu-preferred-resolution (selected-device))))
-    ;; This is such a gross hack. The border-glyph face under
+	  (font-instance-name
+	   (font-menu-load-font
+	    (or family from-family)
+	    (or weight from-weight)
+	    (or size   from-size)
+	    from-slant
+	    (specifier-instance
+	     font-menu-preferred-resolution (selected-device)))))
+    ;; #### This is such a gross hack. The border-glyph face under
     ;; mswindows is in a symbol font. Thus it will not appear in the
     ;; cache - being a junk family.  What we should do is change the
     ;; size but not the family, but this is more work than I care to
@@ -368,13 +365,14 @@
 		(to-weight (string-equal face-weight from-weight))
 		(to-size   (=            face-size   from-size))))
       (set-face-font face
-		     (font-menu-load-font (or to-family face-family)
-					  (or to-weight face-weight)
-					  (or to-size   face-size)
-					  face-slant
-					  (specifier-instance
-					   font-menu-preferred-resolution
-					   (selected-device)))
+		     (font-instance-name
+		      (font-menu-load-font (or to-family face-family)
+					   (or to-weight face-weight)
+					   (or to-size   face-size)
+					   face-slant
+					   (specifier-instance
+					    font-menu-preferred-resolution
+					    (selected-device))))
 		     (and font-menu-this-frame-only-p
 			  (selected-frame))))))
 

--- a/lisp/font.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/font.el	Thu Jun 20 21:19:10 2002 +0000
@@ -2,6 +2,7 @@
 
 ;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
 ;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 2002 Ben Wing.
 
 ;; Author: wmperry
 ;; Maintainer: XEmacs Development Team
@@ -11,7 +12,7 @@
 
 ;; 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 1, or (at your option)
+;; 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
@@ -34,6 +35,8 @@
  '(x-list-fonts
    mswindows-list-fonts ns-list-fonts internal-facep fontsetp get-font-info
    get-fontset-info mswindows-define-rgb-color cancel-function-timers
+   mswindows-font-regexp mswindows-canonicalize-font-name
+   mswindows-parse-font-style mswindows-construct-font-style
    ;; #### perhaps we should rewrite font-warn to avoid the warning
    font-warn))
 
@@ -780,40 +783,20 @@
 ;;; The window-system dependent code (mswindows-style)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;;; mswindows fonts look like:
-;;;	fontname[:[weight][ style][:pointsize[:effects]]][:charset]
-;;; A minimal mswindows font spec looks like:
-;;;	Courier New
-;;; A maximal mswindows font spec looks like:
-;;;	Courier New:Bold Italic:10:underline strikeout:western
-;;; Missing parts of the font spec should be filled in with these values:
-;;;	Courier New:Regular:10::western
-;;  "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*:[a-zA-Z 0-9]*$"
-(defvar font-mswindows-font-regexp
-  (let
-      ((- 		":")
-       (fontname	"\\([a-zA-Z ]+\\)")
-       (weight		"\\([a-zA-Z]*\\)")
-       (style		"\\( [a-zA-Z]*\\)?")
-       (pointsize	"\\([0-9]+\\)")
-       (effects		"\\([a-zA-Z ]*\\)")
-       (charset		"\\([a-zA-Z 0-9]*\\)")
-       )
-    (concat "^"
-	    fontname - weight style - pointsize - effects - charset "$")))
-
 (defconst mswindows-font-weight-mappings
-  '((:extra-light . "Extralight")
+  '((:thin        . "Thin")
+    (:extra-light . "Extra Light")
     (:light       . "Light")
-    (:demi-light  . "Demilight")
-    (:demi        . "Demi")
-    (:book        . "Book")
+    (:demi-light  . "Light")
+    (:demi        . "Light")
+    (:book        . "Medium")
     (:medium      . "Medium")
     (:normal      . "Normal")
-    (:demi-bold   . "Demibold")
+    (:demi-bold   . "Demi Bold")
     (:bold        . "Bold")
     (:regular	  . "Regular")
-    (:extra-bold  . "Extrabold"))
+    (:extra-bold  . "Extra Bold")
+    (:heavy       . "Heavy"))
   "An assoc list mapping keywords to actual mswindows specific strings
 for use in the 'weight' field of an mswindows font string.")
 
@@ -838,41 +821,46 @@
 (defun mswindows-font-create-object (fontname &optional device)
   "Return a font descriptor object for FONTNAME, appropriate for MS Windows devices."
   (let ((case-fold-search t)
-	(font (declare-fboundp (mswindows-font-canonicalize-name fontname))))
+	(font (declare-fboundp (mswindows-canonicalize-font-name fontname))))
     (if (or (not (stringp font))
-	    (not (string-match font-mswindows-font-regexp font)))
+	    (not (string-match mswindows-font-regexp font)))
 	(make-font)
       (let ((family	(match-string 1 font))
-	    (weight	(match-string 2 font))
-	    (style	(match-string 3 font))
-	    (pointsize	(match-string 4 font))
-	    (effects	(match-string 5 font))
-	    (charset	(match-string 6 font))
+	    (style	(match-string 2 font))
+	    (pointsize	(match-string 3 font))
+	    (effects	(match-string 4 font))
+	    (charset	(match-string 5 font))
 	    (retval nil)
 	    (size nil)
 	    (case-fold-search t)
 	    )
-	(if pointsize (setq size (concat pointsize "pt")))
-	(if weight (setq weight (intern-soft (concat ":" (downcase weight)))))
-	(setq retval (make-font :family family
-				:weight weight
-				:size size
-				:encoding charset))
-	(set-font-bold-p retval (eq :bold weight))
-	(cond
-	 ((null style) nil)
-	 ((string-match "^ *[iI]talic" style)
-	  (set-font-italic-p retval t)))
-	(cond
-	 ((null effects) nil)
-	 ((string-match "^[uU]nderline [sS]trikeout" effects)
-	  (set-font-underline-p retval t)
-	  (set-font-strikethru-p retval t))
-	 ((string-match "[uU]nderline" effects)
-	  (set-font-underline-p retval t))
-	 ((string-match "[sS]trikeout" effects)
-	  (set-font-strikethru-p retval t)))
-	retval))))
+	(destructuring-bind (weight . slant)
+	    (mswindows-parse-font-style style)
+	  (if (equal pointsize "") (setq pointsize nil))
+	  (if pointsize (setq size (concat pointsize "pt")))
+	  (if weight (setq weight
+			   (intern-soft
+			    (concat ":" (downcase (replace-in-string
+						   weight " " "-"))))))
+	  (setq retval (make-font :family family
+				  :weight weight
+				  :size size
+				  :encoding charset))
+	  (set-font-bold-p retval (eq :bold weight))
+	  (cond
+	   ((null slant) nil)
+	   ((string-match "[iI]talic" slant)
+	    (set-font-italic-p retval t)))
+	  (cond
+	   ((null effects) nil)
+	   ((string-match "^[uU]nderline [sS]trikeout" effects)
+	    (set-font-underline-p retval t)
+	    (set-font-strikethru-p retval t))
+	   ((string-match "[uU]nderline" effects)
+	    (set-font-underline-p retval t))
+	   ((string-match "[sS]trikeout" effects)
+	    (set-font-strikethru-p retval t)))
+	  retval)))))
 
 (defun mswindows-font-create-name (fontobj &optional device)
   "Return a font name constructed from FONTOBJ, appropriate for MS Windows devices."
@@ -893,8 +881,7 @@
 		     (font-size default)))
 	   (underline-p (font-underline-p fontobj))
 	   (strikeout-p (font-strikethru-p fontobj))
-	   (encoding (or (font-encoding fontobj)
-			 (font-encoding default))))
+	   (encoding (font-encoding fontobj)))
       (if (stringp family)
 	  (setq family (list family)))
       (setq weight (font-higher-weight weight
@@ -920,10 +907,12 @@
 			    family))
 	    ;; We treat oblique and italic as equivalent.  Don't ask.
             ;; Courier New:Bold Italic:10:underline strikeout:western
-	    (setq font-name (format "%s:%s%s:%s:%s:%s"
-				    cur-family weight
-				    (if (font-italic-p fontobj)
-					" Italic" "")
+	    (setq font-name (format "%s:%s:%s:%s:%s"
+				    cur-family
+				    (mswindows-construct-font-style
+				     weight
+				     (if (font-italic-p fontobj)
+					 "Italic" ""))
 				    (if size
 					(int-to-string size) "10")
 				    (if underline-p

--- a/lisp/gtk-faces.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/gtk-faces.el	Thu Jun 20 21:19:10 2002 +0000
@@ -86,30 +86,8 @@
 (defun gtk-init-frame-faces (frame)
   )
 
-;;; gtk-init-global-faces is responsible for ensuring that the
-;;; default face has some reasonable fallbacks if nothing else is
-;;; specified.
-;;;
 (defun gtk-init-global-faces ()
-  (let* ((dev nil)
-	 (default-font (or (face-font 'default 'global)
-			   ;;(plist-get (gtk-style-info dev) 'font)
-			   "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*"))
-	 (italic-font (or (gtk-make-font-italic default-font dev) default-font))
-	 (bold-font (or (gtk-make-font-bold default-font dev) default-font))
-	 (bi-font (or (gtk-make-font-bold-italic default-font dev) default-font)))
-
-    (or (face-font 'default 'global)
-	(set-face-font 'default default-font 'global '(gtk default)))
-
-    (or (face-font 'bold 'global)
-	(set-face-font 'bold bold-font 'global '(gtk default)))
-
-    (or (face-font 'bold-italic 'global)
-	(set-face-font 'bold-italic bi-font 'global '(gtk default)))
-
-    (or (face-font 'italic 'global)
-	(set-face-font 'italic italic-font 'global '(gtk default)))))
+  )
 
 
 ;;; Lots of this stolen from x-faces.el - I'm not sure if this will

--- a/lisp/lisp-mode.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/lisp-mode.el	Thu Jun 20 21:19:10 2002 +0000
@@ -675,6 +675,40 @@
               (t
                normal-indent))))))
 
+(defvar lisp-function-and-type-regexp
+  (concat "def\\("
+	  ;; def but not define-.
+	  "\\(un\\|advice\\|alias\\|macro\\*?\\|setf\\|subst\\*?\\|"
+	  "-edebug-spec\\|"
+	  ;; CLOS
+	  "method\\|generic\\|"
+	  ;; define-*
+	  "ine-\\(?:"
+	  ;; basic Lisp stuff
+	  "compiler-macro\\|function\\|function-when-void\\|modify-macro\\|"
+	  "setf-method\\|"
+	  ;; obsolete/compatible support, XEmacs-specific
+	  "compatible-function-alias\\|obsolete-function-alias\\|"
+	  ;; XEmacs-specific, supporting stuff inside of XEmacs
+	  "ccl-program\\|device-method\\*?\\|prefix-command\\|skeleton"
+          "\\)\\)\\|"
+	  ;; Structure declarations.
+	  "\\(class\\|struct\\|type\\)\\)\\>")
+  "Regular expression to match the function and type keywords used in Lisp.
+This matches, for example, the string \"defun\", as well as defsetf,
+defsubst*, define-prefix-command, etc.  Match string 1 matches everything
+but the three-letter \"def\" string at the beginning.  Match string 2
+matches everything after that, when it's *NOT* a \"type\" declaration --
+which includes defclass, defstruct, and deftype.  Match string 3 is similar
+to match string 2 in that it matches everything after the \"def\", when
+\(and only when) the keyword matched *IS* a type declaration.  You can use
+match strings 2 and 3 to easily determine whether a function or type was
+matched.  The regex is terminated with a \\\> so that there must be a
+word-end; i.e. defunbbb won't match.")
+
+(defvar lisp-flet-regexp
+  "(\\(flet\\|macrolet\\|labels\\)\\(\\s-\\|\n\\)")
+
 (defun lisp-indent-function (indent-point state)
   ;; free reference to `calculate-lisp-indent-last-sexp'
   ;; in #'calculate-lisp-indent
@@ -697,19 +731,91 @@
           ;; inside the innermost containing sexp.
           (backward-prefix-chars)
           (current-column))
-      (let ((function (buffer-substring (point)
+
+      ;; Now come a bunch of ad-hoc checks to see if we're in particular
+      ;; places (defining an flet function, in the argument list of a
+      ;; regular or flet function, in a quoted list, etc.) where the
+      ;; regular indenting doesn't work well.
+
+      ;; #### All this stuff here should be generalized so that
+      ;; you can specify, for various functions, how you want
+      ;; particular arguments handled -- in some way that works
+      ;; recursively, so it can handle flet and such.
+      
+      (let* ((function (buffer-substring (point)
 					(progn (forward-sexp 1) (point))))
-	    method)
-	(if (condition-case nil
+	     (quote (condition-case nil
+			(save-excursion
+			  (backward-up-list 1)
+			  (memq (char-before (point)) '(?' ?`)))))
+	     method)
+	(cond
+	 ;; if we're indenting a quoted list, and the first word is not
+	 ;; lambda, line up second line below first with no indentation,
+	 ;; so that property lists indent correctly.
+	 ((and quote (not (equal function "lambda")))
+	  (setq method 'lisp-indent-quoteform))
+	 ;; do the same if we're indenting the arg list of a def* form.
+	 ((let ((p (point)))
+	    (condition-case nil
 		(save-excursion
-		  (backward-up-list 1)
-		  (backward-up-list 1)
-		  (backward-up-list 1)
-		  (looking-at "(\\(flet\\|macrolet\\|labels\\)\\s-"))
-	      (error nil))
-	    (setq method 'defun)
-	  (setq method (or (get (intern-soft function) 'lisp-indent-function)
-			   (get (intern-soft function) 'lisp-indent-hook))))
+		  (backward-up-list 2)
+		  ;; make sure we're indeed the second argument of the
+		  ;; def* form.
+		  (and (eq (point) (save-excursion
+				     (goto-char p)
+				     (backward-up-list 1)
+				     (backward-sexp 2)
+				     (1- (point))))
+		       ;; check to see that the function is a def* type
+		       (eq (char-after) ?\()
+		       (progn (forward-char 1) t)
+		       (looking-at lisp-function-and-type-regexp)
+		       ;; defstruct may have slot option specs, which
+		       ;; should probably be reverse-indented like
+		       ;; normal, because the slot name is the first
+		       ;; in the list. #### Review this.
+		       (not (equal (match-string 0) "defstruct"))))
+	      (error nil)))
+	  (setq method 'lisp-indent-quoteform))
+
+	 ;; handle functions in flet forms
+	 ((let ((p (point)))
+	    (condition-case nil
+		(save-excursion
+		  (backward-up-list 3)
+		  ;; make sure we're indeed a function, i.e. inside the
+		  ;; first form after the flet.
+		  (and (eq (point) (save-excursion
+				     (goto-char p)
+				     (backward-up-list 2)
+				     (backward-sexp 1)
+				     (1- (point))))
+		       (looking-at lisp-flet-regexp)))
+	      (error nil)))
+	  (setq method 'defun))
+
+	 ;; handle the arg lists in functions in flet forms
+	 ((let ((p (point)))
+	    (condition-case nil
+		(save-excursion
+		  (backward-up-list 2)
+		  ;; make sure we're indeed the arg list -- i.e. the first
+		  ;; element after the function name.
+		  (and (eq (point) (save-excursion
+				     (goto-char p)
+				     (backward-up-list 1)
+				     (backward-sexp 1)
+				     (1- (point))))
+		       (progn
+			 (backward-up-list 2)
+			 (looking-at lisp-flet-regexp))))
+	      (error nil)))
+	  (setq method 'lisp-indent-quoteform))
+	 (t
+	  (setq method
+		(or (get (intern-soft function) 'lisp-indent-function)
+		    (get (intern-soft function) 'lisp-indent-hook)))))
 	(cond ((or (eq method 'defun)
 		   (and (null method)
 			(> (length function) 3)
@@ -721,6 +827,14 @@
 	      (method
 		(funcall method state indent-point)))))))
 
+(defun lisp-indent-quoteform (state indent-point)
+  (goto-char (car (cdr state)))
+  (forward-line 1)
+  (if (> (point) (car (cdr (cdr state))))
+      (progn
+	(goto-char (car (cdr state)))
+	(+ 1 (current-column)))))
+
 (defvar lisp-body-indent 2
   "Number of columns to indent the second line of a `(def...)' form.")
 
@@ -796,6 +910,8 @@
 (put 'with-selected-window 'lisp-indent-function 1)
 (put 'save-selected-frame 'lisp-indent-function 0)
 (put 'with-selected-frame 'lisp-indent-function 1)
+(put 'save-selected-device 'lisp-indent-function 0)
+(put 'with-selected-device 'lisp-indent-function 1)
 (put 'save-restriction 'lisp-indent-function 0)
 (put 'save-match-data 'lisp-indent-function 0)
 (put 'let 'lisp-indent-function 1)

--- a/lisp/msw-faces.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/msw-faces.el	Thu Jun 20 21:19:10 2002 +0000
@@ -39,167 +39,275 @@
     ; an error now instead of a crash at frame creation.
     (unless (face-font-instance 'default device)
       (error "Can't find a suitable default font"))
-    
+
+    ;; Don't set them on the device because then the global setting won't
+    ;; override them.
+    ;; #### Use device tags if we have multiple msprinter devices. (can we?)
     (if (car color-default)
-	(set-face-foreground 'default (car color-default)) device)
+	(set-face-foreground 'default (car color-default) nil
+			     (device-type device)))
     (if (cdr color-default)
-	(set-face-background 'default (cdr color-default)) device)
+	(set-face-background 'default (cdr color-default) nil
+			     (device-type device)))
     (if (car color-3d-face)
-	(set-face-foreground 'gui-element (car color-3d-face)) device)
+	(set-face-foreground 'gui-element (car color-3d-face) nil
+			     (device-type device)))
     (if (cdr color-3d-face)
-	(set-face-background 'gui-element (cdr color-3d-face)) device)
+	(set-face-background 'gui-element (cdr color-3d-face) nil
+			     (device-type device)))
     ))
 
 (defun mswindows-init-frame-faces (frame)
   )
 
 ;; Other functions expect these regexps
-(defconst mswindows-font-regexp
-  (let
-      ((- 		":")
-       (fontname	"\\([a-zA-Z ]+\\)")
-       (weight	"\\([a-zA-Z]*\\)?")
-       (style	"\\( [a-zA-Z]*\\)?")
-       (pointsize	"\\([0-9]+\\)?")
-       (effects	"\\([a-zA-Z ]*\\)?")
-       (charset	"\\([a-zA-Z 0-9]*\\)")
-       )
-    (concat "^"
-	    fontname - weight style - pointsize - effects - charset "$")))
+(let
+    ((- 		":")
+     (fontname	"\\([a-zA-Z ]*\\)")				; 1
+     (style	"\\(\\(?:[a-zA-Z]+\\(?: +[a-zA-Z]+\\)*\\)?\\)") ; 2
+     (pointsize	"\\([0-9]*\\)")					; 3
+     (effects	"\\(\\(?:[a-zA-Z]+\\(?: +[a-zA-Z]+\\)*\\)?\\)")	; 4
+     ;; must match "OEM/DOS"
+     (charset	"\\([a-zA-Z/ ]*\\)")				; 5
+     )
+  (defconst mswindows-font-regexp
+    (concat "^" fontname - style - pointsize - effects - charset "$"))
+  (defconst mswindows-font-regexp-missing-1
+    (concat "^" fontname - style - pointsize - effects "$"))
+  (defconst mswindows-font-regexp-missing-2
+    (concat "^" fontname - style - pointsize "$"))
+  (defconst mswindows-font-regexp-missing-3
+    (concat "^" fontname - style "$"))
+  (defconst mswindows-font-regexp-missing-4
+    (concat "^" fontname "$"))
+)
 
 ;;; Fill in missing parts of a font spec. This is primarily intended as a
 ;;; helper function for the functions below.
 ;;; mswindows fonts look like:
-;;;	fontname[:[weight][ style][:pointsize[:effects]]][:charset]
+;;;	fontname[:[weight][ slant][:pointsize[:effects]]][:charset]
 ;;; A minimal mswindows font spec looks like:
 ;;;	Courier New
 ;;; A maximal mswindows font spec looks like:
 ;;;	Courier New:Bold Italic:10:underline strikeout:Western
-;;; Missing parts of the font spec should be filled in with these values:
-;;;	Courier New:Regular:10::Western
-(defun mswindows-font-canonicalize-name (font)
-  "Given a mswindows font or font name, this returns its name in
-canonical form."
-  (if (or (font-instance-p font)
-	  (stringp font))
-      (let ((name (if (font-instance-p font) 
-		      (font-instance-name font)
-		    font)))
-	(cond ((string-match
-		"^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*:[a-zA-Z 0-9]*$"
-		name) name)
-	      ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*$"
-			     name) (concat name ":Western"))
-	      ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+$" name)
-	       (concat name "::Western"))
-	      ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*$" name)
-	       (concat name ":10::Western"))
-	      ((string-match "^[a-zA-Z ]+$" name)
-	       (concat name ":Regular:10::Western"))
-	      (t "Courier New:Regular:10::Western")))))
+(defun mswindows-canonicalize-font-name (font)
+  "Given a mswindows font or font name, return its name in canonical form.
+This adds missing colons and fills in the style field with \"Regular\".
+This does *NOT* fill in the point size or charset fields, because in those
+cases an empty field is not equivalent to any particular field value, but a
+wildcard allowing for any possible value (charset Western and point size 10
+are chosen first, if they exist)."
+  (if (font-instance-p font) (setq font (font-instance-name font)))
+  ;; fill in missing colons
+  (setq font
+	(cond ((string-match mswindows-font-regexp font) font)
+	      ((string-match mswindows-font-regexp-missing-1 font)
+	       (concat font ":"))
+	      ((string-match mswindows-font-regexp-missing-2 font)
+	       (concat font "::"))
+	      ((string-match mswindows-font-regexp-missing-3 font)
+	       (concat font ":::"))
+	      ((string-match mswindows-font-regexp-missing-4 font)
+	       (concat font "::::"))
+	      (t "::::")))
+  (or (string-match mswindows-font-regexp font) (error "can't parse %S" font))
+  (if (equal "" (match-string 2 font))
+      (concat (substring font 0 (match-beginning 2)) "Regular"
+	      (substring font (match-beginning 2)))
+    font))
+
+(defun mswindows-parse-font-style (style)
+  ;; Parse a style into a cons (WEIGHT . SLANT).  WEIGHT will never be the
+  ;; empty string (it may be "Regular"), but SLANT will be empty for
+  ;; non-italic.
+  (save-match-data
+    (let ((case-fold-search t))
+      (cond ((equalp style "Italic") '("Regular" . "Italic"))
+	    ((string-match "^\\([a-zA-Z ]+?\\) +Italic$" style)
+	     (cons (match-string 1 style) "Italic"))
+	    (t (cons style ""))))))
+
+(defun mswindows-construct-font-style (weight slant)
+  ;; Construct the style from WEIGHT and SLANT.  Opposite of
+  ;; mswindows-parse-font-style.
+  (cond ((and (equal slant "") (equal weight "")) "Regular")
+	((equal slant "") weight)
+	((or (equalp weight "Regular") (equal weight "")) slant)
+	(t (concat weight " " slant))))
+
+(defun mswindows-frob-font-style (font which)
+  ;; Given a font name or font instance, return a name with the style field
+  ;; (which includes weight and/or slant) changed according to WHICH, a plist.
+  ;; If no entry found, don't change.
+  (if (null font) nil
+    (setq font (mswindows-canonicalize-font-name font))
+    (or (string-match mswindows-font-regexp font)
+	(error "can't parse %S" font))
+    (let* ((style (match-string 2 font))
+	   (style-rep
+	    (save-match-data
+	      (or (loop for (x y) on which by #'cddr
+		    if (string-match (concat "^" x "$") style)
+		    return (replace-match y nil nil style))
+		  style))))
+      (concat (substring font 0 (match-beginning 2))
+	      style-rep
+	      (substring font (match-end 2))))))
+
+(defun mswindows-frob-font-style-and-sizify (font which &optional device)
+  (if (null font) nil
+    (let* ((oldwidth (if (font-instance-p font) (font-instance-width font)
+		       (let ((fi (make-font-instance font device t)))
+			 (and fi (font-instance-width fi)))))
+	   (newname (mswindows-frob-font-style font which))
+	   (newfont (make-font-instance newname device t)))
+      ;; Hack!  On MS Windows, bold fonts (even monospaced) are often wider
+      ;; than the equivalent non-bold font.  Making the bold font one point
+      ;; smaller usually makes it the same width (maybe at the expense of
+      ;; making it one pixel shorter).  Do the same trick in both directions.
+      (when (font-instance-p newfont)
+	(let ((newerfont newfont))
+	   (block nil
+	     (while (and newerfont oldwidth)
+	       (setq newfont newerfont)
+	       (cond ((< (font-instance-width newfont) oldwidth)
+		      (setq newerfont
+			    (make-font-instance
+			     (mswindows-find-larger-font newfont device)
+			     device t))
+		      (if (and newerfont
+			       (> (font-instance-width newerfont) oldwidth))
+			  (return nil)))
+		     ((> (font-instance-width newfont) oldwidth)
+		      (setq newerfont
+			    (make-font-instance
+			     (mswindows-find-smaller-font newfont device)
+			     device t))
+		      (if (and newerfont
+			       (< (font-instance-width newerfont) oldwidth))
+			  (return nil)))
+		     (t (return nil))))))
+	(if (font-instance-p newfont) (font-instance-name newfont) newfont)))))
+
+(defconst mswindows-nonbold-weight-regexp
+  ;; He looked so, so cool with the ultra light dangling from his mouth as
+  ;; his fingers spun out demisemiquavers from the keyboard ...
+  "\\(Regular\\|Thin\\|Extra Light\\|Ultra Light\\|Light\\|Normal\\|Medium\\|Semi Bold\\|Demi Bold\\)"
+  )
+(defconst mswindows-bold-weight-regexp
+  "\\(Semi Bold\\|Demi Bold\\|Bold\\|Extra Bold\\|Ultra Bold\\|Heavy\\|Black\\)"
+  )
+
+(defconst mswindows-make-font-bold-mapper
+  `(,mswindows-nonbold-weight-regexp "Bold"
+    "Italic" "Bold Italic"
+    ,(concat mswindows-nonbold-weight-regexp " Italic") "Bold Italic"))
+
+(defconst mswindows-make-font-nonbold-mapper
+  `(,mswindows-bold-weight-regexp "Regular"
+    ,(concat mswindows-bold-weight-regexp " Italic") "Italic"))
+
+(defconst mswindows-make-font-italic-mapper
+  '("\\(.*\\)Italic" "\\1Italic"
+    "\\(.*\\)" "\\1 Italic"))
+
+(defconst mswindows-make-font-unitalic-mapper
+  '("Italic" "Regular"
+    "\\(.*\\) Italic" "\\1"))
+
+(defconst mswindows-make-font-bold-italic-mapper
+  `(,mswindows-nonbold-weight-regexp "Bold Italic"
+    ,(concat mswindows-nonbold-weight-regexp " Italic") "Bold Italic"
+    "Italic" "Bold Italic"
+    ,mswindows-bold-weight-regexp "\\1 Italic"))
 
 (defun mswindows-make-font-bold (font &optional device)
   "Given a mswindows font specification, this attempts to make a bold font.
 If it fails, it returns nil."
-  (if (font-instance-p font)
-      (let ((name (mswindows-font-canonicalize-name font))
-	    (oldwidth (font-instance-width font)))
-	(string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
-	(let ((newfont (make-font-instance
-			(concat (substring name 0 (match-beginning 1))
-				"Bold" (substring name (match-end 1)))
-		       device t)))
-; Hack! on mswindows, bold fonts (even monospaced) are often wider than the
-; equivalent non-bold font. Making the bold font one point smaller usually
-; makes it the same width (maybe at the expense of making it one pixel shorter)
-	  (if (font-instance-p newfont)
-	      (if (> (font-instance-width newfont) oldwidth)
-		  (mswindows-find-smaller-font newfont device)
-		newfont))))))
+  (mswindows-frob-font-style-and-sizify font mswindows-make-font-bold-mapper
+					device))
 
 (defun mswindows-make-font-unbold (font &optional device)
   "Given a mswindows font specification, this attempts to make a non-bold font.
 If it fails, it returns nil."
-  (if (font-instance-p font)
-      (let ((name (mswindows-font-canonicalize-name font)))
-	(string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
-	(make-font-instance (concat
-			     (substring name 0 (match-beginning 1))
-			     "Regular" (substring name (match-end 1)))
-			    device t))))
+  (mswindows-frob-font-style-and-sizify font mswindows-make-font-nonbold-mapper
+					device))
 
 (defun mswindows-make-font-italic (font &optional device)
   "Given a mswindows font specification, this attempts to make an `italic'
 font. If it fails, it returns nil."
-  (if (font-instance-p font)
-      (let ((name (mswindows-font-canonicalize-name font)))
-	(string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
-	(make-font-instance (concat
-			     (substring name 0 (match-beginning 1))
-			     "Italic" (substring name (match-end 1)))
-			    device t))))
+  (try-font-name (mswindows-frob-font-style
+		  font mswindows-make-font-italic-mapper) device))
 
 (defun mswindows-make-font-unitalic (font &optional device)
   "Given a mswindows font specification, this attempts to make a non-italic
 font. If it fails, it returns nil."
-  (if (font-instance-p font)
-      (let ((name (mswindows-font-canonicalize-name font)))
-	(string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
-	(make-font-instance (concat
-			     (substring name 0 (match-beginning 1))
-			     "Regular" (substring name (match-end 1)))
-			    device t))))
+  (try-font-name (mswindows-frob-font-style
+		  font mswindows-make-font-unitalic-mapper) device))
 
 (defun mswindows-make-font-bold-italic (font &optional device)
   "Given a mswindows font specification, this attempts to make a `bold-italic'
 font. If it fails, it returns nil."
-  (if (font-instance-p font)
-      (let ((name (mswindows-font-canonicalize-name font))
-	    (oldwidth (font-instance-width font)))
-	(string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
-	(let ((newfont (make-font-instance
-			(concat (substring name 0 (match-beginning 1))
-				"Bold Italic" (substring name (match-end 1)))
-		       device t)))
-; Hack! on mswindows, bold fonts (even monospaced) are often wider than the
-; equivalent non-bold font. Making the bold font one point smaller usually
-; makes it the same width (maybe at the expense of making it one pixel shorter)
-	  (if (font-instance-p newfont)
-	      (if (> (font-instance-width newfont) oldwidth)
-		  (mswindows-find-smaller-font newfont device)
-		newfont))))))
+  (mswindows-frob-font-style-and-sizify font
+					mswindows-make-font-bold-italic-mapper
+					device))
+
+(defun mswindows-available-font-sizes (font device)
+  (if (font-instance-p font) (setq font (font-instance-name font)))
+  (setq font (mswindows-canonicalize-font-name font))
+  (or (string-match mswindows-font-regexp font) (error "Can't parse %S" font))
+  ;; turn pointsize into wildcard
+  (setq font
+	(concat (substring font 0 (match-beginning 3))
+		(substring font (match-end 3) (match-end 0))))
+  (sort
+   (delq nil
+	 (mapcar #'(lambda (name)
+		     (and (string-match mswindows-font-regexp name)
+			  (string-to-int (substring name (match-beginning 3)
+						    (match-end 3)))))
+		 (list-fonts font device)))
+   #'<))
+
+(defun mswindows-frob-font-size (font up-p device)
+  (if (stringp font) (setq font (make-font-instance font device)))
+  (let* ((name (font-instance-name font))
+	 (truename (font-instance-truename font))
+	 (available (and truename
+			 (mswindows-available-font-sizes truename device))))
+    (if (null available) nil
+      (or (string-match mswindows-font-regexp truename)
+	  (error "can't parse %S" truename))
+      (let ((old-size (string-to-int
+		       (substring truename
+				  (match-beginning 3) (match-end 3)))))
+	(or (> old-size 0) (error "font truename has 0 pointsize?"))
+	(or (string-match mswindows-font-regexp name)
+	    (error "can't parse %S" name))
+	(let ((newsize
+	       ;; scalable fonts: change size by 1 point.
+	       (if (= 0 (car available))
+		   (if (and (not up-p) (= 1 old-size)) nil
+		     (if up-p (1+ old-size) (1- old-size)))
+		 ;; non-scalable fonts: take the next available size.
+		 (if up-p
+		     (loop for tail on available
+		       if (eql (car tail) old-size)
+		       return (cadr tail))
+		   (loop for tail on available
+		     if (eql (cadr tail) old-size)
+		     return (car tail))))))
+	    (and newsize
+	      (concat (substring name 0 (match-beginning 3))
+		      (int-to-string newsize)
+		      (substring name (match-end 3) (match-end 0)))))))))
 
 (defun mswindows-find-smaller-font (font &optional device)
   "Loads a new version of the given font (or font name) 1 point smaller.
 Returns the font if it succeeds, nil otherwise."
-  (if (stringp font) (setq font (make-font-instance font device)))
-  (if (font-instance-p font) (setq font (font-instance-truename font)))
-  (if (stringp font) (setq font (make-font-instance font device)))
-  (if (font-instance-p font)
-      (let (old-size (name (mswindows-font-canonicalize-name font)))
-	(string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name)
-	(setq old-size (string-to-int
-			(substring name (match-beginning 1) (match-end 1))))
-	(if (> old-size 0)
-	    (make-font-instance (concat
-				 (substring name 0 (match-beginning 1))
-				 (int-to-string (- old-size 1))
-				 (substring name (match-end 1)))
-				device t)))))
+  (mswindows-frob-font-size font nil device))
 
 (defun mswindows-find-larger-font (font &optional device)
   "Loads a new version of the given font (or font name) 1 point larger.
 Returns the font if it succeeds, nil otherwise."
-  (if (stringp font) (setq font (make-font-instance font device)))
-  (if (font-instance-p font) (setq font (font-instance-truename font)))
-  (if (stringp font) (setq font (make-font-instance font device)))
-  (if (font-instance-p font)
-      (let (old-size (name (mswindows-font-canonicalize-name font)))
-	(string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name)
-	(setq old-size (string-to-int
-			(substring name (match-beginning 1) (match-end 1))))
-	(make-font-instance (concat
-			     (substring name 0 (match-beginning 1))
-			     (int-to-string (+ old-size 1))
-			     (substring name (match-end 1)))
-			    device t))))
+  (mswindows-frob-font-size font t device))

--- a/lisp/msw-font-menu.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/msw-font-menu.el	Thu Jun 20 21:19:10 2002 +0000
@@ -1,6 +1,7 @@
 ;; msw-font-menu.el --- Managing menus of mswindows fonts.
 
 ;; Copyright (C) 1999 Free Software Foundation, Inc.
+;; Copyright (C) 2002 Ben Wing.
 
 ;; Adapted from x-font-menu.el by Andy Piper <andy@xemacs.org>
 
@@ -21,6 +22,13 @@
 ;; Free Software Foundation, 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
+;;; Known Problems:
+;;; ===============
+;;; There is knowledge here about the regexp match numbers in
+;;; `mswindows-font-regexp' and `mswindows-font-regexp-foundry-and-family' defined in
+;;; mswindows-faces.el.
+;;;
+
 ;;; mswindows fonts look like:
 ;;;	fontname[:[weight][ style][:pointsize[:effects]]][:charset]
 ;;; ie:
@@ -40,9 +48,6 @@
 (require 'font-menu)
 (globally-declare-boundp 'mswindows-font-regexp)
 
-(defvar mswindows-font-menu-registry-encoding nil
-  "Registry and encoding to use with font menu fonts.")
-
 (defvar mswindows-font-menu-junk-families
   (mapconcat
    #'identity
@@ -65,7 +70,6 @@
 or if you change your font path, you can call this to re-initialize the menus."
   (unless mswindows-font-regexp-ascii
     (setq mswindows-font-regexp-ascii "Western"))
-  (setq mswindows-font-menu-registry-encoding "Western")
   (let ((case-fold-search t)
 	family size weight entry
 	dev-cache cache families sizes weights)
@@ -75,8 +79,9 @@
 			(t debug)))
       (when (and (string-match mswindows-font-regexp-ascii name)
 		 (string-match mswindows-font-regexp name))
-	(setq weight (capitalize (match-string 2 name))
-	      size   (string-to-int (or (match-string 4 name) "0"))
+	(setq weight (capitalize (car (mswindows-parse-font-style
+				       (match-string 2 name))))
+	      size   (string-to-int (match-string 3 name))
 	      family (match-string 1 name))
 	(unless (string-match mswindows-font-menu-junk-families family)
 	  (setq entry (or (vassoc name cache)
@@ -174,15 +179,16 @@
       (return-from mswindows-font-menu-font-data (make-vector 5 nil)))
     
     (when (string-match mswindows-font-regexp name)
-      (setq weight (match-string 2 name))
-      (setq size   (string-to-int (or (match-string 4 name) "0"))))
+      (setq weight (car (mswindows-parse-font-style (match-string 2 name))))
+      (setq size   (string-to-int (match-string 3 name))))
       
     (when (string-match mswindows-font-regexp truename)
-      (when (not (member weight (aref entry 1)))
-	(setq weight (match-string 2 truename)))
-      (when (not (member size   (aref entry 2)))
-	(setq size (string-to-int (or (match-string 4 truename) "0"))))
-      (setq slant (match-string 5 truename)))
+      (destructuring-bind (newweight . slant)
+	  (mswindows-parse-font-style (match-string 2 truename))
+	(when (not (member weight (aref entry 1)))
+	  (setq weight newweight))
+	(when (not (member size   (aref entry 2)))
+	  (setq size (string-to-int (match-string 3 truename))))))
       
     (vector entry family size weight slant)))
 
@@ -195,14 +201,15 @@
       (dolist (weight (list weight ""))
 	(dolist (slant
 		 ;; oblique is not currently implemented
-		 (cond ((string-equal slant "Oblique") '(" Italic" ""))
-		       ((string-equal slant "Italic") '(" Italic" ""))
+		 (cond ((string-equal slant "Oblique") '("Italic" ""))
+		       ((string-equal slant "Italic") '("Italic" ""))
 		       (t (list slant ""))))
 	  (when (setq font
 		      (make-font-instance
-		       (concat  family ":" weight slant ":"
-				size "::"
-				mswindows-font-menu-registry-encoding)
+		       (concat
+			family ":"
+			(mswindows-construct-font-style weight slant) ":"
+			size "::")
 		       nil t))
 	    (throw 'got-font font)))))))
 

--- a/lisp/mule/mule-msw-init-late.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/mule/mule-msw-init-late.el	Thu Jun 20 21:19:10 2002 +0000
@@ -30,6 +30,33 @@
 ;; guess we're supposed to query the font for what ranges it supports, and
 ;; what its preferred range is.)
 
+(let ((l '((ascii . "Western")
+	   (latin-iso8859-2 . "Central European")
+	   (cyrillic-iso8859-5 . "Cyrillic")
+	   (latin-iso8859-1 . "Western")
+	   (greek-iso8859-7 . "Greek") 
+	   (latin-iso8859-9 . "Turkish")
+	   (hebrew-iso8859-8 . "Hebrew")
+	   (arabic-iso8859-6 . "Arabic")
+	   (latin-iso8859-4 . "Baltic")
+	   (vietnamese-viscii-lower . "Viet Nam")
+	   (vietnamese-viscii-upper . "Viet Nam")
+	   (thai-tis620 . "Thai")
+	   (latin-jisx0201 . "Japanese")
+	   (katakana-jisx0201 . "Japanese")
+	   ;; (japanese-jisx0208-1978 . "Japanese")
+	   (japanese-jisx0208 . "Japanese")
+	   (japanese-jisx0212 . "Japanese")
+	   (chinese-gb2312 . "Simplified Chinese")
+	   (korean-ksc5601 . "Korean")
+	   (chinese-big5-1 . "Traditional Chinese")
+	   (chinese-big5-2 . "Traditional Chinese"))))
+  (while l
+    (let ((charset (car (car l)))
+	  (registry (cdr (car l))))
+    (mswindows-set-charset-registry charset registry)
+    (setq l (cdr l)))))
+
 (let ((l '((ascii . 1252)
 	   (latin-iso8859-2 . 1250)
 	   (cyrillic-iso8859-5 . 1251)

--- a/lisp/mule/mule-x-init.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/mule/mule-x-init.el	Thu Jun 20 21:19:10 2002 +0000
@@ -1,6 +1,6 @@
 ;;; mule-x-init.el --- initialization code for X Windows under MULE -*- coding: iso-2022-7bit; -*-
 ;; Copyright (C) 1994 Free Software Foundation, Inc.
-;; Copyright (C) 1996 Ben Wing <ben@xemacs.org>
+;; Copyright (C) 1996, 2002 Ben Wing <ben@xemacs.org>
 
 ;; Author: various
 ;; Keywords: mule X11
@@ -40,22 +40,20 @@
 occupy exactly twice the screen space of ASCII (`halfwidth')
 characters.  On many systems, e.g. Sun CDE systems, this can only be
 achieved by using a national variant roman font to display ASCII."
-  (let* ((charset-font-width
-	  (lambda (charset)
-	    (font-instance-width
-	     (face-font-instance 'default (selected-device) charset))))
-
-	 (twice-as-wide
-	  (lambda (cs1 cs2)
-	    (let ((width1 (funcall charset-font-width cs1))
-		  (width2 (funcall charset-font-width cs2)))
-	      (and width1 width2 (eq (+ width1 width1) width2))))))
+  (flet ((charset-font-width (charset)
+	   (font-instance-width
+	    (face-font-instance 'default (selected-device) charset)))
+	 
+	 (twice-as-wide (cs1 cs2)
+	   (let ((width1 (charset-font-width cs1))
+		 (width2 (charset-font-width cs2)))
+	     (and width1 width2 (eq (+ width1 width1) width2)))))
 
     (when (eq 'x (device-type))
       (condition-case nil
-	  (unless (funcall twice-as-wide 'ascii fullwidth-charset)
+	  (unless (twice-as-wide 'ascii fullwidth-charset)
 	    (set-charset-registry 'ascii roman-registry)
-	    (unless (funcall twice-as-wide 'ascii fullwidth-charset)
+	    (unless (twice-as-wide 'ascii fullwidth-charset)
 	      ;; Restore if roman-registry didn't help
 	      (set-charset-registry 'ascii "iso8859-1")))
 	(error (set-charset-registry 'ascii "iso8859-1"))))))
@@ -66,61 +64,4 @@
 
 (defun init-mule-x-win ()
   "Initialize X Windows for MULE at startup.  Don't call this."
-  (when (not mule-x-win-initted)
-    (define-specifier-tag 'mule-fonts
-      (lambda (device) (eq 'x (device-type device))))
-
-    (set-face-font
-     'default
-     '("-*-fixed-medium-r-*--16-*-iso8859-1"
-       "-*-fixed-medium-r-*--*-iso8859-1"
-       "-*-fixed-medium-r-*--*-iso8859-2"
-       "-*-fixed-medium-r-*--*-iso8859-3"
-       "-*-fixed-medium-r-*--*-iso8859-4"
-       "-*-fixed-medium-r-*--*-iso8859-7"
-       "-*-fixed-medium-r-*--*-iso8859-8"
-       "-*-fixed-medium-r-*--*-iso8859-5"
-       "-*-fixed-medium-r-*--*-iso8859-9"
-
-       ;; Following 3 fonts proposed by Teruhiko.Kurosaka@Japan.eng.sun
-       "-sun-gothic-medium-r-normal--14-120-75-75-c-60-jisx0201.1976-0"
-       "-sun-gothic-medium-r-normal--14-120-75-75-c-120-jisx0208.1983-0"
-       "-wadalab-gothic-medium-r-normal--14-120-75-75-c-120-jisx0212.1990-0"
-       ;; Other Japanese fonts
-       "-*-fixed-medium-r-*--*-jisx0201.1976-*"
-       "-*-fixed-medium-r-*--*-jisx0208.1983-*"
-       "-*-fixed-medium-r-*--*-jisx0212*-*"
-
-       ;; Chinese fonts
-       "-*-*-medium-r-*--*-gb2312.1980-*"
-       
-       ;; Use One font specification for CNS chinese
-       ;; Too many variations in font naming
-       "-*-fixed-medium-r-*--*-cns11643*-*"
-       ;; "-*-fixed-medium-r-*--*-cns11643*2"
-       ;; "-*-fixed-medium-r-*--*-cns11643*3"
-       ;; "-*-fixed-medium-r-*--*-cns11643*4"
-       ;; "-*-fixed-medium-r-*--*-cns11643.5-0"
-       ;; "-*-fixed-medium-r-*--*-cns11643.6-0"
-       ;; "-*-fixed-medium-r-*--*-cns11643.7-0"
-       
-       "-*-fixed-medium-r-*--*-big5*-*"
-       "-*-fixed-medium-r-*--*-sisheng_cwnn-0"
-
-       ;; Other fonts
-       
-       ;; "-*-fixed-medium-r-*--*-viscii1.1-1"
-       
-       ;; "-*-fixed-medium-r-*--*-mulearabic-0"
-       ;; "-*-fixed-medium-r-*--*-mulearabic-1"
-       ;; "-*-fixed-medium-r-*--*-mulearabic-2"
-
-       ;; "-*-fixed-medium-r-*--*-muleipa-1"
-       ;; "-*-fixed-medium-r-*--*-ethio-*"
-
-       "-*-mincho-medium-r-*--*-ksc5601.1987-*" ; Korean
-       "-*-fixed-medium-r-*--*-tis620.2529-1"   ; Thai
-       )
-     'global '(mule-fonts) 'append)
-
-    (setq mule-x-win-initted t)))
+  )

--- a/lisp/printer.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/printer.el	Thu Jun 20 21:19:10 2002 +0000
@@ -451,5 +451,5 @@
 	     (setq copies (1- copies)))))
 	((and (not (eq system-type 'windows-nt))
 	      (fboundp 'lpr-region))
-	 (lpr-region start end))
+	 (declare-fboundp (lpr-region start end)))
 	(t (error "No print support available"))))

--- a/lisp/specifier.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/specifier.el	Thu Jun 20 21:19:10 2002 +0000
@@ -1,7 +1,7 @@
 ;;; specifier.el --- Lisp interface to specifiers
 
 ;; Copyright (C) 1997 Free Software Foundation, Inc.
-;; Copyright (C) 1995, 1996, 2000 Ben Wing.
+;; Copyright (C) 1995, 1996, 2000, 2002 Ben Wing.
 
 ;; Author: Ben Wing <ben@xemacs.org>
 ;; Keywords: internal, dumped
@@ -50,7 +50,8 @@
 
 ;; God damn, do I hate dynamic scoping.
 
-(defun map-specifier (ms-specifier ms-func &optional ms-locale ms-maparg)
+(defun map-specifier (ms-specifier ms-func &optional ms-locale ms-maparg
+		      ms-tag-set ms-exact-p)
   "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.
@@ -58,13 +59,16 @@
 of that type.  If MS-LOCALE is 'all or nil, MS-FUNC will be mapped
 over all locales in MS-SPECIFIER.
 
+MS-TAG-SET and MS-EXACT-P are as in `specifier-spec-list'.
+
 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))
+  (let ((ms-specs (specifier-spec-list ms-specifier ms-locale ms-tag-set
+				       ms-exact-p))
 	ms-result)
     (while (and ms-specs (not ms-result))
       (let ((ms-this-spec (car ms-specs)))
@@ -408,7 +412,7 @@
   value)
 
 (defun modify-specifier-instances (specifier func &optional args force default
-					     locale tag-set)
+				   locale tag-set)
   "Modify all specifications that match LOCALE and TAG-SET by FUNC.
 
 For each specification that exists for SPECIFIER, in locale LOCALE
@@ -613,4 +617,358 @@
 
 (define-specifier-tag 'default)
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;                    "Heuristic" specifier functions                ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; "Heuristic" is a euphemism for kludge.  This stuff works well in
+;;; practice, though.
+
+;;; You might view all the contortions we do here and in Face-frob-property
+;;; as indicative of design failures with specifiers, and perhaps you're
+;;; right.  But in fact almost all code that attempts to interface to
+;;; humans and produce "intuitive" results gets messy, particularly with a
+;;; system as complicated as specifiers, whose complexity results from an
+;;; attempt to work well in many different circumstances.  We could create
+;;; a much simpler system, but the tradeoff would be that you'd have to
+;;; programmatically control all the stuff that gets handled automatically
+;;; by setting the right specifiers -- and then things wouldn't "just work"
+;;; if the user simultaneously creates a TTY and X device, or X devices on
+;;; different types of machines, or wants some buffers to display
+;;; differently from others, etc. without a lot of hook functions and other
+;;; glue machinery to set everything up.  The result would be just as much
+;;; complexity, but worse, and much harder to control, since there wouldn't
+;;; be any standard framework for managing all these hook functions and the
+;;; user would have to be able to write lots of Lisp code to get things
+;;; working.
+
+;;; The problem is that we have no high-level code, e.g. custom, to make it
+;;; easy for the user to control specifiers nicely.  The following
+;;; lower-level code, though, should make it easier to implement the
+;;; high-level code.
+
+;;; #### Something like Face-frob-property, but more general, should be
+;;; created for general specifier frobbing.
+
+;;; #### Other possible extensions to specifiers would be
+;;;
+;;; (a) the ability to create specifications for particular types of
+;;;     buffers, e.g. all C-mode buffers one way, all text-mode buffers
+;;;     another way, etc.  Perhaps this should be implemented through hook
+;;;     functions; but that wouldn't easily allow you to `make-face-bold'
+;;;     and have it work on these other kinds of specifications.  Probably
+;;;     a better way is to extend the tag mechanism so that it can specify
+;;;     things other than device types.  One way would be to simply allow
+;;;     tags to have arbitrary elisp attached to them -- a function that
+;;;     takes a domain and returns whether the attached instantiator
+;;;     applies.  This should be doable given (a) that we now have code to
+;;;     allow elisp to be run inside a "sandbox", sufficiently protected
+;;;     that it can even be called from redisplay, and (b) the large amount
+;;;     of caching we already have, which would minimize the speed hit.
+;;;     However, this still runs into problems -- (a) it requires
+;;;     programming to get anything at all done, and (b) you'll get
+;;;     horrible namespace clashes very quickly.  Another possibility to be
+;;;     used in conjunction with this would be vector tags, with an
+;;;     extendable mechanism to control their syntax.  For example,
+;;;
+;;;     [tag :mode 'c] (buffer in c-mode)
+;;;     [tag :buffer-name "\\*Help: function"] (help-on-function buffers)
+;;;     [tag :buffer-coding-system 'japanese-euc] (buffer's coding system is
+;;;	     		                   EUC-JP)
+;;;     [tag :buffer-file-name "^#.*#$"] (autosave files)
+;;;     [tag :language-environment "French"] (whenever the global language
+;;;                                           environment is French)
+;;;     [tag :font-height-minimum '(default 12)] (if the height of the default
+;;;						  font is at least 12 pixels
+;;;						  in this domain)
+;;;                                                         
+;;;     The general idea is that the properties allowable in a tag vector
+;;;     are extendable, just by specifying the property name and a function
+;;;     of two arguments, the property value and the domain, which should
+;;;     return whether the tag applies.  You could imagine very complex
+;;;     behavior (e.g. combining two tags in a single tag set makes an
+;;;     `and', and putting the two tags separately with separate (perhaps
+;;;     identical) instantiators makes an `or'.  You could effectively do a
+;;;     lot of what you might want to do with hooks, but in a much more
+;;;     controllable fashion.  Obviously, much of this complexity wouldn't
+;;;     necessarily be directly set by the user -- they wouldn't probably
+;;;     do more than simple tags based on mode, buffer or file name, etc.
+;;;     But a higher-level interface could easily have various possible
+;;;     "behaviors" to choose from, implemented using this mechanism.
+;;;
+;;;     #### WE NEED CUSTOM SUPPORT!
+;;;
+;;; (b) Another possibility is "partial" inheritance.  For example --
+;;;     toolbars and menubars are complex specifications.  Currently the
+;;;     only way to make a change is to copy the entire value and make the
+;;;     necessary modifications.  What we would like instead is to be able
+;;;     to construct a mini-menubar that says something like "add this menu
+;;;     here" and combine with everything else.  That would require a
+;;;     slightly different approach to instantiation.  Currently it just
+;;;     searches up the tree from specific to general, looking for a match;
+;;;     from this match, it generates the instance.  Instead, it would
+;;;     potentially have to record all the matches it found and pass a list
+;;;     of them to the instantiation function.  To implement this, we would
+;;;     create another specifier method "instantiator_inherits_up", which
+;;;     looks at the instantiator to determine if it calls for combining
+;;;     itself with the value higher up.  this tells the specifier code
+;;;     whether to stop now or keep going.  It would then pass a Dynarr of
+;;;     the instantiators to the instantiate method, which might be a
+;;;     special version, e.g. "instantiate_multi".
+
+(defun instance-to-instantiator (inst)
+  "Convert an instance to an instantiator.
+If we have an instance object, we fetch the instantiator that generated the object.  Otherwise, we just return the instance."
+  (cond ((font-instance-p inst)
+	 (setq inst (font-instance-name inst)))
+	((color-instance-p inst)
+	 (setq inst (color-instance-name inst)))
+	((image-instance-p inst)
+	 (setq inst (image-instance-instantiator inst)))
+	(t inst)))
+
+(defun device-type-matches-spec (devtype devtype-spec)
+  ;; Return DEVTYPE (a devtype) if it matches DEVTYPE-SPEC, else nil.
+  ;; DEVTYPE-SPEC can be nil (all types OK), a device type (only that type
+  ;; OK), or `window-system' -- window system device types OK.
+  (cond ((not devtype-spec) devtype)
+	((eq devtype-spec 'window-system)
+	 (and (not (memq devtype '(tty stream))) devtype))
+	(t (and (eq devtype devtype-spec) devtype))))
+
+(defun add-tag-to-inst-list (inst-list tag-set)
+  "Add TAG-SET (tag or tag-set) to all tags in INST-LIST."
+  ;; Ah, all is sweetness and light with `loop'
+  (if (null tag-set) inst-list
+    (loop for (t2 . x2) in inst-list
+      for newt2 = (delete-duplicates
+		   (append (if (listp tag-set) tag-set (list tag-set))
+			   (if (listp t2) t2 (list t2))))
+      collect (cons newt2 x2))))
+
+(defun derive-domain-from-locale (locale &optional devtype-spec current-device)
+  "Given a locale, try to derive the \"most reasonable\" domain.
+
+This is a heuristic \(\"works most of the time\") algorithm.
+
+\[Remember that, in specifiers, locales are what you attach specifications or
+\"instantiators\" to, and domains are the contexts in which you can
+retrieve the value or \"instance\" of the specifier.  Not all locales are
+domains.  In particular, buffers are locales but not domains because
+buffers may be displayed in different windows on different frames, and thus
+end up with different values if the frames each have a frame-local
+instantiator and the instantiators are different.  However, we may well
+find ourselves in a situation where we want to figure out the most likely
+value of a specifier in a buffer -- for example we might conceptually want
+to make a buffer's modeline face be bold, so we need to figure out what the
+current face is.  If the buffer already has an instantiator, it's easy; but
+if it doesn't, we want to do something reasonable rather than just issue an
+error, even though technically the value is not well-defined.  We want
+something that gives the right answer most of the time.]
+
+LOCALE is a specifier locale -- i.e. a buffer, window, frame, device, the
+symbol `global', or nil, meaning the same as `global'.
+
+DEVTYPE-SPEC, if given, can restrict the possible return values to domains
+on devices of that device type; or if it's `window-system', to domains on
+window-system devices.
+
+CURRENT-DEVICE is what should be considered as the \"selected device\" when
+this value is needed.  It defaults to the currently selected device.
+
+-- If LOCALE is a domain, it's simply returned.
+-- If LOCALE is `all', `global', or nil, we return CURRENT-DEVICE.
+-- If LOCALE is a buffer, we use `get-buffer-window' to find a window viewing
+   the buffer, and return it if there is one; otherwise we return the selected
+   window on CURRENT-DEVICE.
+
+The return value may be nil if the only possible values don't agree with
+DEVTYPE-SPEC."
+  ;; DEVICE aims to be the selected device, but picks some other
+  ;; device if that won't work.  may be nil.
+  (let* ((device (or current-device (selected-device)))
+	 (device (if (device-type-matches-spec (device-type device)
+					       devtype-spec)
+		     device
+		   (first
+		    (delete-if-not
+		     #'(lambda (x)
+			 (device-type-matches-spec (device-type x)
+						   devtype-spec))
+		     (device-list))))))
+    (cond ((memq locale '(all nil global)) device)
+	  ((valid-specifier-domain-p locale)
+	   (and (device-type-matches-spec (device-type (dfw-device locale))
+					  devtype-spec)
+		locale))
+	  ((bufferp locale)
+	   (let ((win (get-buffer-window locale t devtype-spec)))
+	     (or win (and device (selected-window device))))))))
+
+(defun derive-device-type-from-tag-set (tag-set &optional try-stages
+					devtype-spec current-device)
+  "Given a tag set, try (heuristically) to get a device type from it.
+
+There are three stages that this function proceeds through, each one trying
+harder than the previous to get a value.  TRY-STAGES controls how many
+stages to try.  If nil or 1, only stage 1 is done; if 2; stages 1 and 2 are
+done; if 3, stages 1-3 are done; if t, all stages are done (currently 1-3).
+
+Stage 1 looks at the tags themselves to see if any of them are device-type
+tags.  If so, it returns the device type.  If there is more than one device
+type, this tag can never match anything, but we go ahead and return one of
+them.  If no device types in the tags, we fail.
+
+Stage 2 runs all devices through the tag set to see if any match, and
+accumulate a list of device types of all matching devices.  If there is
+exactly one device type in the list, we return it, else fail.
+
+Stage 3 picks up from where stage 2 left off, and tries hard to return
+*SOME* device type in all possible situations, modulo the DEVTYPE-SPEC
+flag. \(DEVTYPE-SPEC and CURRENT-DEVICE are the same as in
+`derive-domain-from-locale'.)
+
+Specifically:
+
+\(a) if no matching devices, return the selected device's type.
+\(b) if more than device type and the selected device's type is
+     listed, use it.
+\(c) else, pick one of the device types (currently the first).
+
+This will never return a device type that's incompatible with the
+DEVTYPE-SPEC flag; thus, it may return nil."
+  (or try-stages (setq try-stages 1))
+  (if (eq try-stages t) (setq try-stages 3))
+  (check-argument-range try-stages 1 3)
+  (flet ((delete-wrong-type (x)
+	   (delete-if-not
+	    #'(lambda (y)
+		(device-type-matches-spec y devtype-spec))
+	    x)))
+    (let ((both (intersection (device-type-list)
+			      (canonicalize-tag-set tag-set))))
+      ;; shouldn't be more than one (will fail), but whatever
+      (if both (first (delete-wrong-type both))
+	(and (>= try-stages 2)
+	     ;; no device types mentioned.  try the hard way,
+	     ;; i.e. check each existing device to see if it will
+	     ;; pass muster.
+	     (let ((okdevs
+		    (delete-wrong-type
+		     (delete-duplicates
+		      (mapcan
+		       #'(lambda (dev)
+			   (and (device-matches-specifier-tag-set-p
+				 dev tag-set)
+				(list (device-type dev))))
+		       (device-list)))))
+		   (devtype (cond ((or (null devtype-spec)
+				       (eq devtype-spec 'window-system))
+				   (let ((dev (derive-domain-from-locale
+					       'global devtype-spec
+					       current-device)))
+				     (and dev (device-type dev))))
+				  (t devtype-spec))))
+	       (cond ((= 1 (length okdevs)) (car okdevs))
+		     ((< try-stages 3) nil)
+		     ((null okdevs) devtype)
+		     ((memq devtype okdevs) devtype)
+		     (t (car okdevs)))))))))
+
+;; Sheesh, the things you do to get "intuitive" behavior.
+(defun derive-device-type-from-locale-and-tag-set (locale tag-set
+						   &optional devtype-spec
+						   current-device)
+  "Try to derive a device type from a locale and tag set.
+
+If the locale is a domain, use the domain's device type.  Else, if the tag
+set uniquely specifies a device type, use it.  Else, if a buffer is given,
+find a window visiting the buffer, and if any, use its device type.
+Finally, go back to the tag set and \"try harder\" -- if the selected
+device matches the tag set, use its device type, else use some valid device
+type from the tag set.
+
+DEVTYPE-SPEC and CURRENT-DEVICE as in `derive-domain-from-locale'."
+
+  (cond ((valid-specifier-domain-p locale)
+	 ;; if locale is a domain, then it must match DEVTYPE-SPEC,
+	 ;; or we exit immediately with nil.
+	 (device-type-matches-spec (device-type (dfw-device locale))
+				   devtype-spec))
+	((derive-device-type-from-tag-set tag-set 2 devtype-spec
+					  current-device))
+	((and (bufferp locale)
+	      (let ((win (get-buffer-window locale t devtype-spec)))
+		(and win (device-type (dfw-device win))))))
+	((derive-device-type-from-tag-set tag-set t devtype-spec
+					  current-device))))
+
+(defun derive-specifier-specs-from-locale (specifier locale
+					   &optional devtype-spec
+					   current-device
+					   global-use-fallback)
+  "Heuristically find the specs of a specifier in a locale.
+
+This tries to find some reasonable instantiators that are most likely to
+correspond to the specifier's \"value\" (i.e. instance) in a particular
+locale, even when the user has not specifically set any such instantiators.
+This is useful for functions that want to modify the instance of a
+specifier in a particular locale, and only in that locale.
+
+Keep in mind that this is a heuristic (i.e. kludge) function, and that it
+may not always give the right results, since the operation is not
+technically well-defined in many cases! (See `derive-domain-from-locale'.)
+
+DEVTYPE-SPEC and CURRENT-DEVICE are as in `derive-domain-from-locale'.
+
+The return value is an inst-list, i.e.
+
+   ((TAG-SET . INSTANTIATOR) ...)
+
+More specifically, if there is already a spec in the locale, it's just
+returned.  Otherwise, if LOCALE is `global', `all', or nil: If
+GLOBAL-USE-FALLBACK is non-nil, the fallback is fetched, and returned, with
+`default' added to the tag set; else, we use CURRENT-DEVICE (defaulting to
+the selected device) as a domain and proceed as in the following.  If
+LOCALE is a domain (window, frame, device), the specifier's instance in
+that domain is computed, and converted back to an instantiator
+\(`instance-to-instantiator').  Else, if LOCALE is a buffer, we use
+`derive-domain-from-locale' to heuristically get a likely domain, and
+proceed as if LOCALE were a domain."
+  (if (memq locale '(all nil)) (setq locale 'global))
+  (let ((current (specifier-spec-list specifier locale)))
+    (if current (cdar current)
+      ;; case 1: a global locale, fallbacks
+      (cond ((and (eq locale 'global) global-use-fallback)
+	     ;; if nothing there globally, retrieve the fallback.
+	     ;; this is either an inst-list or a specifier.  in the
+	     ;; latter case, we need to recursively retrieve its
+	     ;; fallback.
+	     (let (sofar
+		   (fallback (specifier-fallback specifier)))
+	       (while (specifierp fallback)
+		 (setq sofar (nconc sofar
+				    (cdar (specifier-spec-list fallback
+							       'global))))
+		 (setq fallback (specifier-fallback fallback)))
+	       (add-tag-to-inst-list (nconc sofar fallback) 'default)))
+	    (t
+	     (let (domain)
+	       ;; case 2: window, frame, device locale
+	       (cond ((eq locale 'global)
+		      (setq domain (or current-device (selected-device))))
+		     ((valid-specifier-domain-p locale)
+		      (setq domain locale))
+		     ;; case 3: buffer locale
+		     ((bufferp locale)
+		      (setq domain (derive-domain-from-locale
+				    locale devtype-spec current-device)))
+		     (t nil))
+	       ;; retrieve an instance, convert back to instantiator
+	       (when domain
+		 (let ((inst
+			(instance-to-instantiator
+			 (specifier-instance specifier domain))))
+		   (list (cons nil inst))))))))))
+
 ;;; specifier.el ends here

--- a/lisp/subr.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/subr.el	Thu Jun 20 21:19:10 2002 +0000
@@ -914,6 +914,41 @@
     `(if (not (,(eval predicate) ,argument))
 	 (signal-error 'wrong-type-argument (list ,predicate ,argument)))))
 
+(defun args-out-of-range (value min max)
+  "Signal an error until the correct in-range value is given by the user.
+This function loops, signalling a continuable `args-out-of-range' error
+with VALUE, MIN and MAX as the data associated with the error and then
+checking the returned value to make sure it's not outside the given
+boundaries \(nil for either means no boundary on that side).  At that
+point, the gotten value is returned."
+  (loop
+    for newval = (signal 'args-out-of-range (list value min max))
+    do (setq value newval)
+    finally return value
+    while (not (argument-in-range-p value min max))))
+
+(defun argument-in-range-p (argument min max)
+  "Return true if ARGUMENT is within the range of [MIN, MAX].
+This includes boundaries.  nil for either value means no limit on that side."
+  (and (or (not min) (<= min argument))
+       (or (not max) (<= argument max))))
+
+(defmacro check-argument-range (argument min max)
+  "Check that ARGUMENT is within the range [MIN, MAX].
+This is a macro, and ARGUMENT is not evaluated.  If ARGUMENT is an lvalue,
+this function signals a continuable `args-out-of-range' error until the
+returned value is within range, and assigns the returned value
+to ARGUMENT.  Otherwise, this function signals a non-continuable
+`args-out-of-range' error if the returned value is out of range."
+  (if (symbolp argument)
+      `(if (not (argument-in-range-p ,argument ,min ,max))
+	(setq ,argument
+	      (args-out-of-range ,argument ,min ,max)))
+    (let ((newsym (gensym)))
+      `(let ((,newsym ,argument))
+	(if (not (argument-in-range-p ,newsym ,min ,max))
+	    (signal-error 'args-out-of-range ,newsym ,min ,max))))))
+
 (defun signal-error (error-symbol data)
   "Signal a non-continuable error.  Args are ERROR-SYMBOL, and associated DATA.
 An error symbol is a symbol defined using `define-error'.

--- a/lisp/x-faces.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/x-faces.el	Thu Jun 20 21:19:10 2002 +0000
@@ -1,7 +1,7 @@
 ;;; x-faces.el --- X-specific face frobnication, aka black magic.
 
 ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
-;; Copyright (C) 1995, 1996 Ben Wing.
+;; Copyright (C) 1995, 1996, 2002 Ben Wing.
 
 ;; Author: Jamie Zawinski <jwz@jwz.org>
 ;; Maintainer: XEmacs Development Team
@@ -617,10 +617,6 @@
 ;;; specified.
 ;;;
 (defun x-init-global-faces ()
-  (or (face-font 'default 'global)
-      (set-face-font 'default
-		     "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*"
-		     'global '(x default)))
   (or (face-foreground 'default 'global)
       (set-face-foreground 'default "black" 'global '(x default)))
   (or (face-background 'default 'global)
@@ -633,67 +629,43 @@
   ;;
   ;; If the "default" face didn't have a font specified, try to pick one.
   ;;
-  (or
-   (face-font-instance 'default device)
-   ;;
-   ;; No font specified in the resource database; try to cope.
-   ;;
-   ;; At first I wanted to do this by just putting a font-spec in the
-   ;; fallback resources passed to XtAppInitialize(), but that fails
-   ;; if there is an Emacs app-defaults file which doesn't specify a
-   ;; font: apparently the fallback resources are not consulted when
-   ;; there is an app-defaults file, which seems pretty bogus to me.
-   ;;
-   ;; We should also probably try "*xtDefaultFont", but I think that it
-   ;; might be legal to specify that as "xtDefaultFont:", that is, at
-   ;; top level, instead of "*xtDefaultFont:", that is, applicable to
-   ;; every application.  `x-get-resource' can't handle that right now.
-   ;; Anyway, xtDefaultFont is probably variable-width.
-   ;;
-   ;; Some who have LucidaTypewriter think it's a better font than Courier,
-   ;; but it has the bug that there are no italic and bold italic versions.
-   ;; We could hair this code up to try and mix-and-match fonts to get a
-   ;; full complement, but really, why bother.  It's just a default.
-   ;;
-   (let (new-x-font)
-     (setq new-x-font (or
-      ;;
-      ;; We default to looking for iso8859 fonts.  Using a wildcard for the
-      ;; encoding would be bad, because that can cause English speakers to get
-      ;; Kanji fonts by default.  It is safe to assume that people using a
-      ;; language other than English have both set $LANG, and have specified
-      ;; their `font' and `fontList' resources.  In any event, it's better to
-      ;; err on the side of the English speaker in this case because they are
-      ;; much less likely to have encountered this problem, and are thus less
-      ;; likely to know what to do about it.
+  ;; (or
+  ;; (face-font-instance 'default device)
+  ;;
+  ;; [[ No font specified in the resource database; try to cope. ]]
+  ;;
+  ;; NOTE: In reality, this will never happen.  The fallbacks will always
+  ;; be tried, and the last fallback is "*", which should get any font.  No
+  ;; need to put the same checks here as in the fallbacks.  These comments
+  ;; appear to be pre-19.12. --ben
 
-      ;; Try for Courier.  Almost everyone has that.  (Does anyone not?)
-      (make-font-instance
-       "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*" device t)
-      (make-font-instance
-       "-*-courier-*-r-*-*-*-120-*-*-*-*-iso8859-*" device t)
-      ;; Next try for any "medium" charcell or monospaced iso8859 font.
-      (make-font-instance "-*-*-medium-r-*-*-*-120-*-*-m-*-iso8859-*" device t)
-      (make-font-instance "-*-*-medium-r-*-*-*-120-*-*-c-*-iso8859-*" device t)
-      ;; Next try for any charcell or monospaced iso8859 font.
-      (make-font-instance "-*-*-*-r-*-*-*-120-*-*-m-*-iso8859-*" device t)
-      (make-font-instance "-*-*-*-r-*-*-*-120-*-*-c-*-iso8859-*" device t)
-      ;; Ok, let's at least try to stay in 8859...
-      (make-font-instance "-*-*-*-r-*-*-*-120-*-*-*-*-iso8859-*" device t)
-      ;; Boy, we sure are losing now.  Try the above, but in any encoding.
-      (make-font-instance "-*-*-medium-r-*-*-*-120-*-*-m-*-*-*" device t)
-      (make-font-instance "-*-*-medium-r-*-*-*-120-*-*-c-*-*-*" device t)
-      (make-font-instance "-*-*-*-r-*-*-*-120-*-*-m-*-*-*" device t)
-      (make-font-instance "-*-*-*-r-*-*-*-120-*-*-c-*-*-*" device t)
-      (make-font-instance "-*-*-*-r-*-*-*-120-*-*-*-*-*-*" device t)
-      ;; Hello?  Please?
-      (make-font-instance "-*-*-*-*-*-*-*-120-*-*-*-*-*-*" device t)
-      (make-font-instance "*" device t)
-      ;; if we get to here we're screwed, and faces.c will fatal()...
-      ))
-     (if (not (face-font 'default 'global))
-	 (set-face-font 'default new-x-font)
-       (set-face-font 'default new-x-font device))))
+  ;; [[ At first I wanted to do this by just putting a font-spec in the
+  ;; fallback resources passed to XtAppInitialize(), but that fails
+  ;; if there is an Emacs app-defaults file which doesn't specify a
+  ;; font: apparently the fallback resources are not consulted when
+  ;; there is an app-defaults file, which seems pretty bogus to me.
+  ;;
+  ;; We should also probably try "*xtDefaultFont", but I think that it
+  ;; might be legal to specify that as "xtDefaultFont:", that is, at
+  ;; top level, instead of "*xtDefaultFont:", that is, applicable to
+  ;; every application.  `x-get-resource' can't handle that right now.
+  ;; Anyway, xtDefaultFont is probably variable-width.
+  ;;
+  ;; Some who have LucidaTypewriter think it's a better font than Courier,
+  ;; but it has the bug that there are no italic and bold italic versions.
+  ;; We could hair this code up to try and mix-and-match fonts to get a
+  ;; full complement, but really, why bother.  It's just a default. ]]
+  ;;
+  ;; [[ We default to looking for iso8859 fonts.  Using a wildcard for the
+  ;; encoding would be bad, because that can cause English speakers to get
+  ;; Kanji fonts by default.  It is safe to assume that people using a
+  ;; language other than English have both set $LANG, and have specified
+  ;; their `font' and `fontList' resources.  In any event, it's better to
+  ;; err on the side of the English speaker in this case because they are
+  ;; much less likely to have encountered this problem, and are thus less
+  ;; likely to know what to do about it. ]]
+
+
   ;;
   ;; If the "default" face didn't have both colors specified, then pick
   ;; some, taking into account whether one of the colors was specified.

--- a/lisp/x-init.el	Tue Jun 11 19:28:22 2002 +0000
+++ b/lisp/x-init.el	Thu Jun 20 21:19:10 2002 +0000
@@ -269,6 +269,7 @@
   (when (not x-win-initted)
     (defvar x-app-defaults-directory)
     (init-pre-x-win)
+    (if (featurep 'mule) (init-mule-x-win))
 
     ;; Open the X display when this file is loaded
     ;; (Note that the first frame is created later.)
@@ -288,7 +289,7 @@
 (defun init-post-x-win ()
   "Initialize X Windows at startup (post).  Don't call this."
   (when (not post-x-win-initted)
-    (if (featurep 'mule) (init-mule-x-win))
+    ;(if (featurep 'mule) (init-mule-x-win))
     ;; Motif-ish bindings
     ;; The following two were generally unliked.
     ;;(define-key global-map '(shift delete)   'kill-primary-selection)

--- a/lwlib/ChangeLog	Tue Jun 11 19:28:22 2002 +0000
+++ b/lwlib/ChangeLog	Thu Jun 20 21:19:10 2002 +0000
@@ -1,3 +1,8 @@
+2002-06-20  Ben Wing  <ben@xemacs.org>
+
+	* lwlib.c:
+	* lwlib.c (dialog_spec_p): Fix warning.
+
 2002-02-13  Stephen J. Turnbull  <stephen@xemacs.org>
 
 	* lwlib-Xm.c (make_dialog): Fix XmProcessTraversal crash.

--- a/lwlib/lwlib.c	Tue Jun 11 19:28:22 2002 +0000
+++ b/lwlib/lwlib.c	Thu Jun 20 21:19:10 2002 +0000
@@ -852,6 +852,8 @@
     }
 }
 
+#if defined (NEED_LUCID) || defined (NEED_ATHENA) || defined (NEED_MOTIF)
+
 static widget_creation_function
 find_in_table (const char *type, const widget_creation_entry table[])
 {
@@ -862,6 +864,8 @@
   return NULL;
 }
 
+#endif
+
 static Boolean
 dialog_spec_p (const char *name)
 {

--- a/nt/ChangeLog	Tue Jun 11 19:28:22 2002 +0000
+++ b/nt/ChangeLog	Thu Jun 20 21:19:10 2002 +0000
@@ -1,3 +1,86 @@
+2002-06-20  Ben Wing  <ben@xemacs.org>
+
+	* config.inc.samp (OPTIMIZED_BUILD):
+	* config.inc.samp (USE_FASTCALL): New.
+	* config.inc.samp (PROFILE_SUPPORT): New.
+	* config.inc.samp (DEBUG_XEMACS):
+	* config.inc.samp (HAVE_VC6): New.
+	* config.inc.samp (USE_PORTABLE_DUMPER):
+	Clean up, add args to control fastcall (not yet supported!  the
+	changes needed are in another ws of mine), profile support, vc6
+	support, union-type.
+	
+	* xemacs.dsp (CFG):
+	* xemacs.mak (HAVE_DIALOGS):
+	* xemacs.mak (HAVE_MSW_C_DIRED): Removed.
+	* xemacs.mak (USE_FASTCALL): New.
+	* xemacs.mak (PROFILE_SUPPORT): New.
+	* xemacs.mak (HAVE_VC6): New.
+	* xemacs.mak (QUICK_BUILD):
+	* xemacs.mak (VERBOSECC): New.
+	* xemacs.mak (DEPEND): New.
+	* xemacs.mak (CONFIG_ERROR):
+	* xemacs.mak (CCV):
+	* xemacs.mak (DEBUGFLAGS): Removed.
+	* xemacs.mak (OPTFLAGS): Removed.
+	* xemacs.mak (DEBUG_FLAGS_COMPILE): New.
+	* xemacs.mak (DEBUG_FLAGS_LINK): New.
+	* xemacs.mak (DEBUG_DEFINES): New.
+	* xemacs.mak (BROWSERFLAGS): New.
+	* xemacs.mak (LIBC_LIB):
+	* xemacs.mak (OPTFLAGS_FASTCALL): New.
+	* xemacs.mak (OPTFLAGS_CDECL): New.
+	* xemacs.mak (PROFILE_FLAGS): New.
+	* xemacs.mak (CFLAGS_NO_OPT): New.
+	* xemacs.mak (CFLAGS_CDECL_NO_LIB): New.
+	* xemacs.mak (CFLAGS_CDECL): New.
+	* xemacs.mak (MSW_LIBS):
+	* xemacs.mak (MSW_DEFINES): Removed.
+	* xemacs.mak (MSW_C_DIRED_OBJ): Removed.
+	* xemacs.mak (MULE_DEFINES):
+	* xemacs.mak (DEBUG_FLAGS): Removed.
+	* xemacs.mak (LINK_DEPENDENCY_ARGS):
+	* xemacs.mak (ETAGS_DEPS):
+	* xemacs.mak (LIB_SRC_TOOLS):
+	* xemacs.mak (TEMACS_LFLAGS):
+	* xemacs.mak (TEMACS_CPP_FLAGS): Removed.
+	* xemacs.mak (TEMACS_CPP_FLAGS_NO_CFLAGS): New.
+	* xemacs.mak (TEMACS_CPP_CDECL_FLAGS): New.
+	* xemacs.mak (TEMACS_MSW_OBJS):
+	* xemacs.mak (TEMACS_OBJS):
+	* xemacs.mak (.SUFFIXES):
+	* xemacs.mak (create-list-file): New.
+	* xemacs.mak (compile-list-file): New.
+	* xemacs.mak (TEMACS_DUMP_ID_OBJ): New.
+	* xemacs.mak (PROGNAME):
+	* xemacs.mak (temacs_loadup):
+	* xemacs.mak (check):
+	* xemacs.mak (check-temacs):
+	* xemacs.mak (make-docargs):
+	* xemacs.mak (update-elc):
+	* xemacs.mak (install):
+	* xemacs.mak (mostlyclean):
+	* xemacs.mak (versionclean):
+	* xemacs.mak (OS):
+	Semi-major overhaul.
+
+	Fix bug where dump-id was always getting recomputed, forcing a
+	redump even when nothing changed.
+
+	Add support for fastcall.  Support edit-and-continue (on by
+	default) with vc6.  Use incremental linking when doing a debug
+	compilation.  Add support for profiling.
+
+	Consolidate the various debug flags.
+
+	Partial support for "batch-compiling" -- compiling many files on a
+	single invocation of the compiler.  Doesn't seem to help that much
+	for me, so it's not finished or enabled by default.
+
+	Remove HAVE_MSW_C_DIRED, we always do.
+
+	Correct some sloppy use of directories.
+	
 2002-03-29  Jonathan Harris  <jonathan@xemacs.org>
 
 	* xemacs.mak: Define STACK_TRACE_EYE_CATCHER.