;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-
;;; Written 05/27/88 15:37:33 by ALEX,
;;; Reason: Fix screwed up temporary scroll window.
;;; while running on armstrong from band LOD2
;;; With IO 3.46, PATHNAME 3.17, FILE 3.16, SYSTEM 3.114, METER 3.7, SERIAL 3.2, CHAOSNET 3.25,
;;;  ETHERNET 3.4, GC 3.24, IMAGEN 3.0, MAIL-DAEMON 3.8, NETWORK-SUPPORT 3.21, PROFILE 3.6,
;;;  SUGGESTIONS 3.7, UCL 3.4, ZWEI 3.34, STREAMER-TAPE 3.17, DEBUG-TOOLS 3.6, FONT-EDITOR 3.1,
;;;  GLOSSARY 3.1, INPUT-EDITOR 3.0, MAIL-READER 3.23, NAMESPACE-EDITOR 3.7, NVRAM 3.6,
;;;  TELNET 3.7, TV 3.33, NAMESPACE 3.15, COMPILER 3.35, PRINTER 3.10, SYSLOG 3.1,
;;;  VT100 3.14, VISIDOC 1.0, IP 2.76, Experimental BUG 8.0, Experimental GRAPHICS-WINDOW 4.0,
;;;  Experimental TREE 4.0,  microcode 464, Band Name: R3.2(10/22)+TREE+SCRIBE


#!C
; From file WINDOW-DEFINITIONS.LISP#> TREE-EDITOR; sys:
#10R TREE#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "TREE"))
                          (SI:*LISP-MODE* :Common-lisp)
                          (*READTABLE* Sys:Common-lisp-readtable)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* Sys::*common-lisp-symbol-substitutions*))
  (COMPILER#:PATCH-SOURCE-FILE "sys: TREE-EDITOR; WINDOW-DEFINITIONS.#"


(DEFFLAVOR temporary-scroll-window ()
	   (w:hysteretic-window-mixin
	    w:temporary-window-mixin
	    w:function-text-scroll-window
	    w:box-label-mixin
	    w:margin-region-mixin
	    w:window)
  (:default-init-plist :hysteresis		30
		       :label			fonts:cptfontb
		       :print-function          'print-item)
		       
  (:documentation "The pop-up scrollable window used to display items that are clicked
on single right."))

))

#!C
; From file WINDOW-DEFINITIONS.LISP#> TREE-EDITOR; sys:
#10R TREE#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "TREE"))
                          (SI:*LISP-MODE* :Common-lisp)
                          (*READTABLE* Sys:Common-lisp-readtable)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* Sys::*common-lisp-symbol-substitutions*))
  (COMPILER#:PATCH-SOURCE-FILE "sys: TREE-EDITOR; WINDOW-DEFINITIONS.#"


(DEFUN print-item (item ignore window &optional ignore)
  (IF (STRINGP item)
      (SEND window :string-out item)
      (FORMAT window "~s" item)))

))

#!Z
; From file FUNCTIONS-FOR-ACCESSORS.LISP#> TREE-EDITOR; SYS:
#10R TREE#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "TREE"))
                          (SI:*LISP-MODE* :Zetalisp)
                          (*READTABLE* Sys::Standard-readtable)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* Sys::*zetalisp-symbol-substitutions*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: TREE-EDITOR; FUNCTIONS-FOR-ACCESSORS.#"


(DEFUN string-item (value &optional (format-string "~A"))
  "Creates an item that is acceptable for use by the flavor
TV:TEMPORARY-SCROLL-WINDOW which uses TV:BASIC-SCROLL-WINDOW as a mixin.
Items are documented in the window system manual.  This function can be used when
value is either a string or something that can be coerced into a string, i.e. (string value)
does not cause an error.  This cannot be used on lists.  This function also eliminates any
imbedded RETURNs because the RETURN character confuses the scrolling mechanism."
;  (CONS nil (LOOP for one-line-string in
;		  (string-eliminate-returns (FORMAT nil format-string value))
;		  collect (w:scroll-parse-item one-line-string))))

	(LOOP for one-line-string in
		  (string-eliminate-returns (FORMAT nil format-string value))
		  collect one-line-string))

))

#!Z
; From file FUNCTIONS-FOR-ACCESSORS.LISP#> TREE-EDITOR; SYS:
#10R TREE#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "TREE"))
                          (SI:*LISP-MODE* :Zetalisp)
                          (*READTABLE* Sys::Standard-readtable)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* Sys::*zetalisp-symbol-substitutions*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: TREE-EDITOR; FUNCTIONS-FOR-ACCESSORS.#"


(DEFUN grind-item (form)
  "Creates a string item from an arbitrary Lisp form by grinding it to fit in the scroll
window."
  (string-item (format:output nil (GRIND-TOP-LEVEL form *scroll-window-width*))))

))