;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-

;;; Reason: Changed tv:find-window to understand objects returned from TYPE-OF
;;; when it used to always expect a symbol.

;;;                           RESTRICTED RIGHTS LEGEND
;;;
;;; Use, duplication, or disclosure by the Government is subject to
;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;; Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;   TEXAS INSTRUMENTS INCORPORATED      
;;;   P.O. BOX 2909, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Written 06/21/89 08:56:42 by MARKY,
;;; while running on LIBRA from band LODA
;;; With SYSTEM 6.7, VIRTUAL-MEMORY 6.1, EH 6.3, MAKE-SYSTEM 6.0, MICRONET 6.0, LOCAL-FILE 6.0,
;;;  BASIC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.1, NETWORK-NAMESPACE 6.0,
;;;  DISK-IO 6.0, DISK-LABEL 6.0, BASIC-FILE 6.2, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.4, TV 6.10, DATALINK 6.0, CHAOSNET 6.0, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.0,
;;;  SYSLOG 6.0, STREAMER-TAPE 6.3, UCL 6.0, INPUT-EDITOR 6.0, METER 6.0, ZWEI 6.3,
;;;  Experimental DEBUG-TOOLS 6.2, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.0, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.1, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.0,
;;;  IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.0, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.0, PROFILE 6.1, VISIDOC 6.2, TI-CLOS 6.8, CLEH 6.4, IP 3.46,
;;;  Experimental BUG 11.10, Experimental CLX 6.1, CLUE 6.5, X11M 6.1,  microcode 429,
;;;  Band Name: Release 6.0 + SLE 6/5

;;; SPR 10102
;;; (SYMBOL-NAME (TYPE-OF WINDOW)) will fail when w:lisp-listener flavor is changed incompatibly
;;; and (type-of tv:initial-lisp-listener) returns the object #<FLAVOR-CLASS W::LISP-LISTENER 7616164>
;;; instead of the symbol 'W::LISP-LISTENER ...

#!C
; From file BASSTR.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; BASSTR.#"


(DEFUN find-window (&optional (SUBSTRING ""))
  "Find a window whose name has SUBSTRING in it.
If more than one window matches SUBSTRING, pop up a menu to choose one.
Note that SUBSTRING can be either a string or a symbol."
  (LET (result
	(search-function (IF (ATOM substring)
                             #'si:simple-string-search
                             ;;ELSE
                             #'si:search-and-or)))
    (map-over-sheets
      #'(lambda (window)
	  (LET ((name (STRING (SEND window :name))))
	    (IF (FUNCALL search-function substring name)        ; Look at name
		(PUSH (LIST name window) result)
                ;;ELSE
                (SETQ name (SEND window :send-if-handles :name-for-selection))
                (IF (AND name (FUNCALL search-function substring name)) ; Then name for selection
                    (PUSH (LIST name window) result)
                    ;;ELSE
		    ;; may 06/20/89 START PATCH ... allow clos window types
		    ;; that may be an object ( not a symbol ) when flavor is
		    ;; changed incompatibly.
		    ;; ;; (SETQ NAME (SYMBOL-NAME (TYPE-OF WINDOW)))  
		    (let ((type-specifier (TYPE-OF window)))
		      (SETQ name (cond ((symbolp type-specifier)
					(symbol-name type-specifier))
				       ((typep type-specifier 'ticlos:class)
					(string (or (ticlos:class-name type-specifier)
						    ""))) ;; rare but possible to have nil name
				       (t "")))) ;; punt, I don't know what the name is
		    ;; may 06/20/89 ... END PATCH
                    (IF (FUNCALL search-function substring name)        ; Finally flavor name
                        (PUSH (LIST name window) result)))))))
    (IF (CDR result)
        ;; If more than one, let user choose.
	(VALUES (w:menu-choose result :label "Pick a window"))  
        ;;ELSE
        (SECOND (FIRST result)))))
))