;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.97
;;; Reason:
;;;  When you select a new tag table in ZWEI, retain the old search string
;;;  if no tags search had been in progress for that table.  Compatible
;;;  with behavior before parallel tags search feature added...
;;; Written 23-Jun-88 19:49:26 by pld (Peter L. DeWolf) at site Gigamos Cambridge
;;; while running on Cthulhu from band 1
;;; with Experimental System 124.95, Experimental Local-File 74.3, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.1, Experimental Tape 23.6, Experimental Lambda-Diag 16.2, microcode 1761, SDU Boot Tape 3.14, SDU ROM 8, the old ones.



; From modified file DJ: L.ZWEI; SECTIO.LISP#302 at 23-Jun-88 19:55:38
#8R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; SECTIO  "

(defun make-tag-table-current (name-or-tag-table)
  (let ((elt (typecase name-or-tag-table
	       (tag-table-dummy-file
		name-or-tag-table)
	       (string
		 (cdr (ass #'string-equal name-or-tag-table *zmacs-tag-table-alist*)))
	       (otherwise
		nil))))
    (when elt
      (when *zmacs-current-tag-table*
	;;Save current search values....
	(send *zmacs-current-tag-table* :putprop *zmacs-tags-search-key-string* 'search-key-string)
	(send *zmacs-current-tag-table* :putprop *zmacs-last-tags-file-list* 'tags-file-list)
	(if (boundp '*zmacs-tags-search-function*)
	    (send *zmacs-current-tag-table* :putprop *zmacs-tags-search-function* 'search-function)
	  (send *zmacs-current-tag-table* :remprop 'search-function))
	(if (boundp '*zmacs-tags-search-key*)
	    (send *zmacs-current-tag-table* :putprop *zmacs-tags-search-key* 'search-key)
	  (send *zmacs-current-tag-table* :remprop 'search-key)))
      (setq *zmacs-current-tag-table* elt)
      ;;Restore saved search values
      (setq *zmacs-last-tags-file-list* (send *zmacs-current-tag-table* :get 'tags-file-list))
      (let ((buffer (send *zmacs-current-tag-table* :get 'current-pathname)))
	(when buffer
	  (make-buffer-current buffer)
	  (move-bp (point) (send *zmacs-current-tag-table* :get 'current-point))))
      (let ((function (send *zmacs-current-tag-table* :get 'search-function)))
	(when function
	  (setq *zmacs-tags-search-function* function)))
      (let ((key (send *zmacs-current-tag-table* :get 'search-key)))
	(when key
	  (setq *zmacs-tags-search-key* key))))))

))