(FILECREATED "10-Feb-87 12:06:04" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH196.;3
 4188   

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

      previous date: " 7-Feb-87 14:34:29" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH196.;1)


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

(PRETTYCOMPRINT RHTPATCH196COMS)

(RPAQQ RHTPATCH196COMS
 ((* * Fixes bug #411: now works when font stylesheet is aborted. Also does 
			     nicer things with prompt window in case of bad font choice. Lists of 
			     font families, sizes, and faces are now in global vars so users can 
			     change them in their init files.)
			  (* * New stuff for NCPARAMETERS)
			  (GLOBALVARS NC.ListOfFontFamilies NC.ListOfFontSizes NC.ListOfFontFaces)
			  (INITVARS (NC.ListOfFontFamilies (QUOTE (TIMESROMAN HELVETICA GACHA CLASSIC 
									      MODERN TERMINAL TITAN 
									      CREAM OLDENGLISH)))
				    (NC.ListOfFontSizes (QUOTE (8 9 10 11 12 14 18 24 30 36)))
				    (NC.ListOfFontFaces (QUOTE (STANDARD BOLD ITALIC BOLDITALIC))))
			  (* * Change to NCPARAMETERS)
			  (FNS NC.GetFontFromUser)))
(* * Fixes bug #411: now works when font stylesheet is aborted. Also does nicer things with 
prompt window in case of bad font choice. Lists of font families, sizes, and faces are now in 
global vars so users can change them in their init files.)


(* * New stuff for NCPARAMETERS)


(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS NC.ListOfFontFamilies NC.ListOfFontSizes NC.ListOfFontFaces)
)

(RPAQ? NC.ListOfFontFamilies
 (QUOTE (TIMESROMAN HELVETICA GACHA CLASSIC MODERN TERMINAL TITAN CREAM 
						  OLDENGLISH)))

(RPAQ? NC.ListOfFontSizes
 (QUOTE (8 9 10 11 12 14 18 24 30 36)))

(RPAQ? NC.ListOfFontFaces
 (QUOTE (STANDARD BOLD ITALIC BOLDITALIC)))
(* * Change to NCPARAMETERS)


(DEFINEQ

(NC.GetFontFromUser

  (LAMBDA (CurrentFont)                                      (* rht: " 7-Feb-87 14:38")


          (* * 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.)




          (* * rht 2/7/87: Fixed bug #411: now returns NIL when stylesheet was aborted. Also does nicer things with prompt 

	  window in case of bad font choice. Lists of font families, sizes, and faces are now in global vars so users can 

	  change them in their init files.)



    (DECLARE
 (
GLOBALVARS
 NC.ListOfFontFamilies NC.ListOfFontSizes NC.ListOfFontFaces))
    (LET ((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 ← NC.ListOfFontFamilies)
							(create
 MENU
								  ITEMS ←(
SORT
 NC.ListOfFontSizes))
							(create
 MENU
								  ITEMS ← NC.ListOfFontFaces))
						(
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))))
		     (
COND

		       ((
NULL
 Answer)
			 NIL)
		       ((
CAR
 (
NLSETQ
 (
APPLY
 (
FUNCTION
 FONTCREATE)
						  Answer))))
		       (T (
NC.PrintMsg
 (LET ((InspectWindow (for
 Window in
 (
OPENWINDOWS
)
								 when
 (
WINDOWPROP
 Window
										      (
QUOTE
 
									       NoteCardsInspector))
								 do
 (
RETURN
 Window)))
					       PromptWin)
					      (if
 (
AND
 InspectWindow (
SETQ
 PromptWin
							     (
GETPROMPTWINDOW
 InspectWindow)))
						  then
 (
FLASHW
 PromptWin)
							 PromptWin
						else
 NIL))
					 T "Cannot find font: " Answer)
			  NIL))))))
)
(PUTPROPS RHTPATCH196 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1833 4106 (NC.GetFontFromUser 1843 . 4104)))))
STOP