(FILECREATED " 7-Dec-84 18:01:18" {ERIS}<LISPNEW>PATCHES>COERCEFONTPATCH.;2
 3878   

      changes to:  (FNS \COERCEFONTDESC)

      previous date: " 7-Dec-84 17:52:15" {ERIS}<LISPNEW>PATCHES>COERCEFONTPATCH.;1)


(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT COERCEFONTPATCHCOMS)

(RPAQQ COERCEFONTPATCHCOMS
 ((FNS \COERCEFONTDESC)))
(DEFINEQ

(\COERCEFONTDESC

  [LAMBDA (SPEC DEVICE NOERRORFLG)                           (* rmk: " 7-Dec-84 18:00")

                                                             (* Coerces SPEC to a fontdescriptor.

							     Go back thru FONTCREATE for various coercions in order 

							     to make sure that the cache gets set up)

                                                             (* Maybe all callers guarantee proper device?)

    (
PROG
 (FONT)
          [
COND

	    ((type?
 FONTDESCRIPTOR SPEC)
	      (
SETQ
 FONT SPEC))
	    [(type?
 FONTCLASS SPEC)
	      (
OR
 DEVICE (
SETQ
 DEVICE (
QUOTE
 DISPLAY)))
	      [
SETQ
 FONT (
SELECTQ
 DEVICE
				  (DISPLAY (ffetch
 (
FONTCLASS
 DISPLAYFD) of
 SPEC))
				  (INTERPRESS (ffetch
 (
FONTCLASS
 INTERPRESSFD) of
 SPEC))
				  (PRESS (ffetch
 (
FONTCLASS
 PRESSFD) of
 SPEC))
				  (
CDR
 (
ASSOC
 DEVICE (fetch
 (
FONTCLASS
 OTHERFDS) of
 SPEC]
	      (
RETURN
 (
COND

			((type?
 FONTDESCRIPTOR FONT)         (* We don't always create FD's for devices before they 

							     are needed, so do it now and save result)

			  FONT)
			[(
NULL
 FONT)                         (* NIL means defaultfont, but don't cache in this 

							     particular font descriptor)

			  (
COND

			    [(
EQ
 SPEC DEFAULTFONT)           (* Break cycles with NIL in the defaultfont)

			      (
COND

				(NOERRORFLG NIL)
				((
EQ
 DEVICE (
QUOTE
 DISPLAY))
                                                             (* Function DEFAULTFONT guarantees system integrity)

				  (
DEFAULTFONT
 (
QUOTE
 DISPLAY)))
				(T (
ERROR
 (
CONCAT
 DEVICE " component for DEFAULTFONT undefined"]
			    (T (
FONTCREATE
 DEFAULTFONT NIL NIL NIL DEVICE NOERRORFLG]
			((
SETQ
 FONT (
FONTCREATE
 FONT NIL NIL NIL DEVICE NOERRORFLG))
                                                             (* Might get NIL if NOERRORFLG)

			  (
SETFONTCLASSCOMPONENT
 SPEC DEVICE FONT]
	    ((
NULL
 SPEC)
	      (
RETURN
 (\COERCEFONTDESC
 DEFAULTFONT DEVICE NOERRORFLG)))
	    ((
OR
 (
IMAGESTREAMP
 SPEC)
		 (type?
 WINDOW SPEC))
	      (
SETQ
 FONT (
DSPFONT
 NIL SPEC)))
	    (T 

          (* If called with NOERRORFLG=T (e.g. from DSPFONT) we want to suppress invalid arg errors as well as font not found,

	  so we can move on to other possible coercions.)



	       (
RETURN
 (
FONTCREATE
 SPEC NIL NIL NIL DEVICE NOERRORFLG]
                                                             (* Here if arg was a fontdescriptor or imagestream)

          (
RETURN
 (
COND

		    ((
NULL
 DEVICE)                           (* NIL device doesn't default to display if a 

							     fully-specified font was found)

		      FONT)
		    ([
OR
 (
EQ
 DEVICE (ffetch
 FONTDEVICE of
 FONT))
			 (
AND
 (type?
 STREAM DEVICE)
			      (
EQ
 (ffetch
 IMFONTCREATE of
 (ffetch
 IMAGEOPS of
 DEVICE))
				  (ffetch
 FONTDEVICE of
 FONT]
		      FONT)
		    (T                                       (* Here if doesn't match or if DEVICE is not explicitly

							     a stream. Presumably, FONTCOPY contains the slow 

							     stream-coercion code.)

		       (
FONTCOPY
 FONT (
QUOTE
 DEVICE)
				 DEVICE
				 (
QUOTE
 NOERROR)
				 NOERRORFLG])
)
(PUTPROPS COERCEFONTPATCH COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (381 3792 (\COERCEFONTDESC 391 . 3790)))))
STOP