;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-
;;; Patch file for TV version 6.1
;;; Reason: Fixed  CHOOSE-VARIABLE-VALUES-RUBOUT-HANDLER-FUNCTION to handle line that extend past the window boundary. It was writing over itself.
;;; Written 05/15/89 12:21:34 by BERGER,
;;; while running on ARIES from band LOD1
;;; With SYSTEM 6.0, VIRTUAL-MEMORY 6.0, EH 6.0, MAKE-SYSTEM 6.0, MICRONET 6.0, LOCAL-FILE 6.0,
;;;  BASIC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.0, NETWORK-NAMESPACE 6.0,
;;;  DISK-IO 6.0, DISK-LABEL 6.0, BASIC-FILE 6.0, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.0, TV 6.0, DATALINK 6.0, CHAOSNET 6.0, GC 6.0, MEMORY-AUX 6.0, NVRAM 6.0,
;;;  SYSLOG 6.0, STREAMER-TAPE 6.0, UCL 6.0, INPUT-EDITOR 6.0, METER 6.0, ZWEI 6.0,
;;;  DEBUG-TOOLS 6.0, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.0, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.0, SERIAL 6.0, PRINTER 6.0, MAC-PRINTER-TYPES 6.0, PRINTER-TYPES 6.0,
;;;  IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.0, MAIL-READER 6.0, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.0, PROFILE 6.0, VISIDOC 6.0, TI-CLOS 6.0, CLEH 6.0, IP 3.45,
;;;  Experimental BUG 11.4, Experimental CLX 6.0, Experimental CLUE 21.0, Experimental X11M 4.0,
;;;  Experimental RPC 6.0, NFS 3.0,  microcode 427, Band Name: Rel 6.0 + SLE 5/12

#!C
; From file CHOICE.LISP#> window; SYS:
#10R TV#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "TV"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: window; CHOICE.#"


(DEFUN CHOOSE-VARIABLE-VALUES-RUBOUT-HANDLER-FUNCTION
       (RF PF EDIT STREAM &AUX SAVE-RHB WIN LEN)
  "Function called by rubout handler within CHOOSE-VARIABLE-VALUES-CHOICE."
  (DECLARE (SPECIAL REDISPLAY-FLAG))
  (LET ((STRING (MAKE-ARRAY 32. :ELEMENT-TYPE :STRING-CHAR :FILL-POINTER 0)))
    (WITH-OUTPUT-TO-STRING (STREAM STRING)
      ;; ITEM-VALUE-FOR-SET is the variable's value
      (FUNCALL PF ITEM-VALUE-FOR-SET STREAM))
    (WHEN (AND EDIT
	       ;; Sometimes the rubout handler buffer isn't a string but is an
	       ;; array.  Need to handle both cases.
	       (OR (ZEROP (LENGTH (SETQ SAVE-RHB (SEND STREAM :SAVE-RUBOUT-HANDLER-BUFFER))))
		   (EQUAL "" SAVE-RHB)))
      (SETQ LEN (LENGTH STRING))
      ;; The following two lines set up the cursor position properly.
      ;; The :INCREMENT-CURSORPOS will set the cursor to the start of
      ;; the variable's value.  The SETQ ensures that the rubout
      ;; handler's X position is the same as the cursor.  This is
      ;; necessary because the :RESTORE-RUBOUT-HANDLER-BUFFER redisplays
      ;; the STRING on the STREAM.  The redisplay needs to start at the
      ;; proper X position.
      (if (>= (send stream :read-cursorpos)  ; DAB 05-09-89
	      (send stream :inside-width))  ; DAB 05-09-89
	  (SEND STREAM :INCREMENT-CURSORPOS (* LEN (SHEET-CHAR-WIDTH STREAM)) 0)	      ; DAB 05-09-89
	  (SEND STREAM :INCREMENT-CURSORPOS (- (* LEN (SHEET-CHAR-WIDTH STREAM))) 0))

      (SETQ RUBOUT-HANDLER-STARTING-X (SEND STREAM :READ-CURSORPOS)
	    PROMPT-STARTING-X RUBOUT-HANDLER-STARTING-X)
      (SEND STREAM :RESTORE-RUBOUT-HANDLER-BUFFER STRING LEN)))
  (UNWIND-PROTECT
      (PROG1
        (FUNCALL RF STREAM)
        (SETQ WIN T))
    (UNLESS WIN
      (SETQ REDISPLAY-FLAG T))))
))