;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.17
;;; Reason:
;;;  Certain redisplay degrees caused an error when using variable width
;;;  fonts; the reason was a call (in zwei:window-redisplay-dis-line) to an
;;;  extinct function in the FED package, fed:font-char-min-raster-width.
;;;  Replaced with GLOBAL:FONT-RASTER-WIDTH.				--saz
;;; Written 1-Jun-88 19:13:43 by saz at site Gigamos Cambridge
;;; while running on Brahms' First from band 3
;;; with Experimental System 124.16, Experimental Local-File 74.0, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.0, Experimental Tape 23.6, Experimental Lambda-Diag 16.0, microcode 1756, SDU Boot Tape 3.14, SDU ROM 103.



; From modified file DJ: L.ZWEI; DISPLA.LISP#176 at 1-Jun-88 19:14:24
#8R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; DISPLA  "


(defun window-redisplay-dis-line (now)
  (declare (:self-flavor displayer)
	   (special point-pline))
  (macrolet ((punt-if (cond) `(when ,cond
				(setq redisplay-degree dis-text point-pline nil)
				(return-from window-redisplay-dis-line nil))))
    (let* ((lh (send self :line-height))
	   (last-bp (interval-last-bp interval))
	   (line redisplay-line)
	   (index redisplay-index)
	   (p (find-bp-in-window self line index))
	   ;; Temporary.  Move these three instance variables from flavor WINDOW to flavor DISPLAYER
	   ;; and then these three bindings will not be needed.
	   (pline-marking-left-array (send self :pline-marking-left-array))
	   (pline-marking-width-array (send self :pline-marking-width-array))
	   (pline-text-width-array (send self :pline-text-width-array)))
      (punt-if (null p))
      (let* ((line-length (if (eq line (bp-line last-bp))
			      (bp-index last-bp)
			    (line-length line)))
	     ;; LEN gets the raster position in the pline P
	     ;; of the character in LINE at position INDEX.
	     (len (without-interrupts
		    (if (and (eq (pline-line self p) *last-redisplay-line*)
			     (= index *last-redisplay-index*)
			     (eq self *last-redisplay-sheet*))
			*last-redisplay-cursor-x*
		        (string-width line (pline-from-index self p) index self))))
	     dwid)
	;; If P and LEN say we are at the start of a continuation line,
	;; then maybe they are wrong
	;; (if the contin line has been exactly deleted).
	(punt-if (and (zerop len) (not (zerop index))))
	;; Reverse-video region marking must be removed before updating.
	(when (and (eq *region-marking-mode* ':reverse-video)
		   (or (pline-marking-left self p)
		       (pline-marking-left self (min (1+ p) (1- n-plines)))))
	  (region-unmark-pline p))
	;; Go to the place in the line where changes start. Clear from there.
	;; This means that any region marking from there on is gone now.
	(cond ((and (pline-marking-left self p)
		    (< (pline-marking-left self p) len))
	       (setf (pline-marking-width self p)
		     (min (- len (pline-marking-left self p))
			  (pline-marking-width self p))))
	      (t (setf (pline-marking-left self p) nil)
		 (setf (pline-marking-width self p) nil)))
	;; If the character is wider than it claims to be, draw an extra
	;; character, since the clear-eol will erase data.
	(unless (zerop index)
	  (let ((ch (aref line (1- index))))
	    (when (< (char-code ch) #o200)
	      (let ((fmap (send self :font-map)))
		(when fmap
		  (let* ((font (aref fmap (char-font ch)))
			 (cwt (font-char-width-table font)))
		    (when cwt
		      (let ((cwid (aref cwt (setq ch (char-code ch))))
			    (rwid (font-raster-width font)))	;was (fed:font-char-min-raster-width font char)
								;which no longer exists.
			(when (> rwid cwid)
			  (setq dwid cwid))))))))))
	(multiple-value-bind (i tw)
	    ;; Neither displayers nor diagrams can get here.
	    (tv:sheet-line-out self line index line-length len (* lh p) dwid)
	  ;; Save cursor x to avoid calls to STRING-WIDTH while inserting text.
	  (without-interrupts ; Don't confuse other zmacs processes
	    (setq *last-redisplay-sheet* self
		  *last-redisplay-line* line
		  *last-redisplay-index* line-length
		  *last-redisplay-cursor-x* tw))
	  ;; We have output the first PLINE of this line
	  (setf (pline-to-index self p) i)
	  (setf (pline-text-width self p)
		(if ( i line-length) tw	;Continuation needed
		  (+ tw (send self :char-width))))	;Allow for CR
	  (setf (pline-tick self p) now)
	  ;; See if plines below this need to be redisplayed, due
	  ;; to line-continuation issues
	  (when (and (< (1+ p) n-plines)
		     (or ( i line-length)
			 ( tw (send self :inside-width))
			 (eq (pline-line self (1+ p)) line)))
	    (setq redisplay-degree dis-text point-pline nil)
	    ;; If we are just creating a new continuation line, make it
	    ;; still look munged, so REDISPLAY-BLT can understand.
	    (or (eq (pline-line self (1+ p)) line)
		(setf (pline-tick self p) -1)))))))
  nil)

))