;;;  -*- Mode:LISP; Package:FED; Readtable:ZL; Base:8; Patch-File:T -*-

;;; THIS PATCH MAKES COM-READ-FILE EXTENSIBLE BY PUSHING ONTO THIS ALIST.

(DEFVAR COM-READ-FILE-TYPES
	'(("KST" KST-COM-READ-FILE)
	  (:QFASL QFASL-COM-READ-FILE)
	  ("AC" READ-AC-INTO-FONT)
	  ("AL" READ-AL-INTO-FONT)
	  ("KS" READ-KS-INTO-FONT)
	  ("AST" AST-COM-READ-FILE)))

(DEFUN KST-COM-READ-FILE (FILENAME FONTNAME &AUX FD)
  (SETQ FD (READ-KST-INTO-FONT-DESCRIPTOR FILENAME FONTNAME))
  (PUTPROP FONTNAME FILENAME 'KST-FILE)
  (FONT-NAME-SET-FONT-AND-DESCRIPTOR FONTNAME FD))

(DEFUN AST-COM-READ-FILE (FILENAME FONTNAME &AUX FD)
  (SETQ FD (READ-AST-INTO-FONT-DESCRIPTOR FILENAME FONTNAME))
  (PUTPROP FONTNAME FILENAME 'AST-FILE)
  (FONT-NAME-SET-FONT-AND-DESCRIPTOR FONTNAME FD))

(DEFUN QFASL-COM-READ-FILE (FILENAME FONTNAME)
  FONTNAME
  (LOAD FILENAME "FONTS"))

(DEFUN COM-READ-FILE (&AUX FILENAME TYPE)
  (DECLARE (:SELF-FLAVOR FED))
  (SETQ TYPE (FED-CHOOSE (MAPCAR #'(LAMBDA (X) (LIST (CAR X))) COM-READ-FILE-TYPES)
			 "Read which format of font file"))
  (COND ((NULL TYPE))
	('ELSE
	 (SETQ FILENAME (READ-DEFAULTED-FILENAME CURRENT-FONT "Read" TYPE))
	 (SETQ CURRENT-FONT (INTERN (SEND FILENAME :NAME) 'FONTS))))
  (FUNCALL (CADR (ASS #'STRING-EQUAL TYPE COM-READ-FILE-TYPES)) FILENAME CURRENT-FONT)
  (SEND SELF :REDEFINE-MARGINS)
  (SELECT-FONT CURRENT-FONT))