(FILECREATED " 5-Jun-86 12:53:25" {QV}<NOTECARDS>1.3K>FGHPATCH055.;1
 2667   

      changes to:  (VARS FGHPATCH055COMS)
		   (FNS NC.GetFontFromUser))


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

(PRETTYCOMPRINT FGHPATCH055COMS)

(RPAQQ FGHPATCH055COMS
 ((* * fix to bug %# 43 NC dies when given bogus font in parameter inspector)
			  (FNS NC.GetFontFromUser)))
(* * fix to bug %# 43 NC dies when given bogus font in parameter inspector)


(DEFINEQ

(NC.GetFontFromUser

  (LAMBDA (CurrentFont)                                      (* fgh: " 5-Jun-86 12:51")


          (* * Get a font from the user. Current font characteristics serve as the default.)




          (* * fgh 6/5/86 Fixed so that never returns a font it cannot find. If font is not found, returns old font.)



    (LET (Answer InspectWindow)
         (
SETQ
 Answer (
STYLESHEET
 (
CREATE.STYLE
 (
QUOTE
 TITLE)
						      "Please select a font:"
						      (
QUOTE
 ITEM.TITLES)
						      (
QUOTE
 (Family Size Face))
						      (
QUOTE
 ITEM.TITLE.FONT)
						      (
QUOTE
 (TIMESROMAN 12 BOLD))
						      (
QUOTE
 ITEMS)
						      (
LIST
 (create
 MENU
									ITEMS _(
QUOTE
 (TIMESROMAN
											  HELVETICA 
											  GACHA 
											  CLASSIC 
											  MODERN 
											 TERMINAL)))
							      (create
 MENU
									ITEMS _(
QUOTE
 (8 9 10 11 12 
											   14)))
							      (create
 MENU
									ITEMS _(
QUOTE
 (STANDARD
											  BOLD ITALIC 
										       BOLDITALIC))))
						      (
QUOTE
 SELECTIONS)
						      (
LIST
 (
FONTPROP
 CurrentFont (
QUOTE
 FAMILY)
									  )
							      (
FONTPROP
 CurrentFont (
QUOTE
 SIZE))
							      (
NC.FontFaceShorthand

								(
FONTPROP
 CurrentFont (
QUOTE

									      FACE))))
						      (
QUOTE
 NEED.NOT.FILL.IN)
						      NIL)))
         (
RESETLST
 (
RESETSAVE
 (
SETQ
 HELPFLAG NIL)
				  (
BQUOTE
 (
SETQ
 HELPFLAG , (
KWOTE
 HELPFLAG))))
		     (if
 (
CAR
 (
NLSETQ
 (
APPLY
 (
FUNCTION
 FONTCREATE)
						     Answer)))
		       else
 (
NC.PrintMsg
 (if
 (
SETQ
 InspectWindow (for
 Window
									    in
 (
OPENWINDOWS
)
									    when

									     (
WINDOWPROP

									       Window
									       (
QUOTE
 
									       NoteCardsInspector))
									    do
 (
RETURN
 Window)))
						 then
 (
GETPROMPTWINDOW
 InspectWindow 1)
					       else
 NIL)
					     T "Cannot find font: " Answer)
			      CurrentFont)))))
)
(PUTPROPS FGHPATCH055 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (478 2585 (NC.GetFontFromUser 488 . 2583)))))
STOP