;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.121
;;; Reason:
;;;  ZWEI commands that make a tag table "current" (the one to do subsequent
;;;  searches in) call a function MAKE-TAG-TABLE-CURRENT to do so.  When
;;;  there is a current search context for the new current tag table, this
;;;  function will select the buffer and move to the point of the search
;;;  context (where the search left off before).
;;;  
;;;  Now, before selecting a buffer and moving there, push the previous point
;;;  on the point-pdl so the user can go back, e.g. with Control-Meta-Space.
;;; Written 29-Jun-88 12:38:23 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 1
;;; with Experimental System 124.119, 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, Tiger 28.0, microcode 1761, SDU Boot Tape 3.14, SDU ROM 103, Beta 3 plus patches.



; From modified file DJ: L.ZWEI; SECTIO.LISP#310 at 29-Jun-88 12:38:24
#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
	  (point-pdl-push (point) *window* nil t)
	  (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))))))

))