;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: DICT; Base: 10; Patch-file: T -*-
;;; Patch file for DICTIONARY version 1.2
;;; Reason: CLWIN (Common Lisp Window) definitions
;;; Written by jrd, 4/25/86 13:10:31
;;; while running on Xevious from FEP0:>Inc-6-1-D.load.1
;;; with Release 6.1, Netrender (DS) 1.12, COLOR 135.55, COLOR-DEMO 68.10, Paint (DS) 8.0,
;;; Menu 6.1, Experimental Color Editor 5.1, IMAGES 56.25, COLOR-EXTENSIONS 4.6,
;;; BS-FONTS 4.2, Tablet (DS) 3.7, Live Window 272.0, Dynamics (DS) 7.15,
;;; Render (DS) 15.6, COLOR-PALETTE 2.1, Geometry (DS) 7.40, Demo-Band 63.0,
;;; Experimental TMC 3d Image Toolkit 71.0, IP-TCP 29.13, DECTALK 1.1,
;;; Experimental PROSE 1.0, Japanese 24.1, Versatec 9.0, Spire 17.2,
;;; Experimental SYLPAR 1.0, DICTIONARY 1.0, Experimental SPELL 1.1,
;;; microcode TMC5-COLOR-MIC 336, FEP 127, FEP0:>v127-lisp.flod(2),
;;; FEP0:>v127-loaders.flod(3), FEP0:>v127-debug.flod(1), FEP0:>v127-info.flod(2), Bug Report Recipient.



; From file clwin.lisp /projects/speech/utility/ AMT:
#10R CLWIN::(GLOBAL:COMPILER-LET ((GLOBAL:PACKAGE (GLOBAL:PKG-FIND-PACKAGE "CLWIN")))

;;; -*- Mode: LISP; Package: CLWIN; Base: 10; Syntax: Common-lisp -*-

;; Common Lisp access to Lisp Machine windows

(export '(font-p current-font with-font font-map string-width cursor-position window-width))

(defun font-p (thing)
  "Is thing a Lisp Machine Font"
  (eq (zl:typep thing) 'zl:font))

(defun current-font (&optional (window *standard-output*))
  (zl:send window :current-font))

(defsetf current-font (&optional (window (symbol-function *standard-output*))) (font)
  `(zl:send ,window :set-current-font ,font))

(defmacro with-font (window font &body body)
  `(let ((old (current-font ,window)))
     (unwind-protect
	 (progn
	   (setf (current-font ,window) ,font)
	   ,@body)
       (setf (current-font ,window) old))))


(defun font-map (&optional (window *standard-output*))
  (zl:send window :font-map))

(defsetf font-map (&optional (window (symbol-function *standard-output*))) (new-map)
  `(zl:send ,window :set-font-map ,new-map))

(defun string-width (string  window)
  (zl:send window :string-length (zl:string string)))

(defun cursor-position (window)
  (declare (values x y))
  (zl:send window :read-cursorpos))

(defun window-width (window)
  (zl:send window :inside-width))


)