(FILECREATED "10-Jan-85 16:32:33" {ERIS}<LISPNEW>SOURCES>FONTUNPARSEPATCH.;1
 3367   

      changes to:  (VARS FONTUNPARSEPATCHCOMS)

      previous date: "10-Jan-85 10:17:06" {ERIS}<LISPCORE>DIG>FONTUNPARSEPATCH.;1)


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

(PRETTYCOMPRINT FONTUNPARSEPATCHCOMS)

(RPAQQ FONTUNPARSEPATCHCOMS
 ((FNS \FONTFACE FONTUNPARSE)))
(DEFINEQ

(\FONTFACE

  [LAMBDA (FACE NOERRORFLG)                                  (* rmk: "10-Jan-85 16:31")

                                                             (* Takes a variety of user specifications and converts 

							     them to a standard FONTFACE record.)

    (
PROG
 NIL
          [
RETURN
 (
COND

		    ((type?
 FONTFACE FACE)
		      FACE)
		    [(
LITATOM
 FACE)
		      (
OR
 (
U-CASEP
 FACE)
			  (
SETQ
 FACE (
U-CASE
 FACE)))
		      (
SELECTQ
 FACE
			       ((NIL MRR STANDARD NNN)       (* NNN is to compensate for Harmony bug in FONTUNPARSE)

				 (
CONSTANT
 (create
 FONTFACE)))
			       [(ITALIC MIR)
				 (
CONSTANT
 (create
 FONTFACE
						   SLOPE ←(
QUOTE
 ITALIC]
			       [(BOLD BRR)
				 (
CONSTANT
 (create
 FONTFACE
						   WEIGHT ←(
QUOTE
 BOLD]
			       [(BOLDITALIC BIR)
				 (
CONSTANT
 (create
 FONTFACE
						   WEIGHT ←(
QUOTE
 BOLD)
						   SLOPE ←(
QUOTE
 ITALIC]
			       (create
 FONTFACE
				       WEIGHT ←(
SELCHARQ
 (
NTHCHARCODE
 FACE 1)
							 (M (
QUOTE
 MEDIUM))
							 (B (
QUOTE
 BOLD))
							 (L (
QUOTE
 LIGHT))
							 (
GO
 ERROR))
				       SLOPE ←(
SELCHARQ
 (
NTHCHARCODE
 FACE 2)
							(R (
QUOTE
 REGULAR))
							(I (
QUOTE
 ITALIC))
							(
GO
 ERROR))
				       EXPANSION ←(
SELCHARQ
 (
NTHCHARCODE
 FACE 3)
							    (R (
QUOTE
 REGULAR))
							    (C (
QUOTE
 COMPRESSED))
							    (E (
QUOTE
 EXPANDED))
							    (
GO
 ERROR]
		    (T (
GO
 ERROR]
      ERROR
          (
COND

	    (NOERRORFLG (
RETURN
 NIL))
	    (T (
\ILLEGAL.ARG
 FACE])

(FONTUNPARSE

  [LAMBDA (FONT)                                             (* rmk: "10-Jan-85 10:13")

                                                             (* Used by TEDIT, should be flushed after Harmony)

    (
PROG
 [FACE (SPEC (
COND

			((type?
 FONTDESCRIPTOR FONT)
			  (
FONTPROP
 FONT (
QUOTE
 SPEC)))
			(T                                   (* Could be a non-instantiated specification of a 

							     fontclass, just use it as the spec without creating the

							     font.)

			   FONT]
          (
OR
 SPEC (
RETURN
))
          (
SETQ
 FACE (
CADDR
 SPEC))
          [
SETQ
 FACE (if
 [
AND
 FACE (
NOT
 (
EQUAL
 FACE (
QUOTE
 (MEDIUM REGULAR REGULAR]
			 then
 (
PACK*
 (
NTHCHAR
 (
CAR
 FACE)
					      1)
				     (
NTHCHAR
 (
CADR
 FACE)
					      1)
				     (
NTHCHAR
 (
CADDR
 FACE)
					      1]             (* Don't return device, or any trailing defaults)

          (
RETURN
 (
CONS
 (
CAR
 SPEC)
			(
CONS
 (
CADR
 SPEC)
			      (if
 (
AND
 (
CADDDR
 SPEC)
				       (
NEQ
 0 (
CADDDR
 SPEC)))
				  then
 (
LIST
 FACE (
CADDDR
 SPEC))
				elseif
 FACE
				  then
 (
CONS
 FACE])
)
(PUTPROPS FONTUNPARSEPATCH COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (394 3280 (\FONTFACE 404 . 2047) (FONTUNPARSE 2049 . 3278)))))
STOP