;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.120
;;; Reason:
;;;  Zwei's List-Tag-Table-Buffers now prints the search string context, if
;;;  any, for the tag table.  Carefully calculate buffer name string length
;;;  and search string length to display! Misc. other logical and cosmetic
;;;  improvements.
;;; Written 29-Jun-88 11:34:15 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; ZMACS.LISP#576 at 29-Jun-88 11:35:10
#8R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; ZMACS  "


(DEFUN FIND-MAXIMUM-BUFFER-NAME-LENGTH (MAX-SIZE &optional (buffer-list *zmacs-buffer-list*))
  (LOOP FOR BUFFER IN buffer-list
	FOR SIZE = (STRING-LENGTH (BUFFER-NAME BUFFER)) 
	MAXIMIZE (MIN MAX-SIZE (STRING-LENGTH (BUFFER-NAME BUFFER)))))

))

; From modified file DJ: L.ZWEI; SECTIO.LISP#308 at 29-Jun-88 11:35:41
#8R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; SECTIO  "

(defcom com-list-tag-buffers "Display buffers and search context associated with a tag table.
  If there is numeric (or universal) arg, use current tag table.
  Else, ask which tag table to select buffers for.
  Displays item-list of buffer names you can select." ()
  (let ((output *query-io*)
	tag-table tag-table-name
	buffers current-buffer
	search-key-p)
    (multiple-value (buffers tag-table) (tag-table-buffers nil *numeric-arg-p*))
    (if (null buffers) (BARF "No buffers."))
    (setq output *standard-output*)
    (setq tag-table-name (or (car (rassq tag-table *zmacs-tag-table-alist*))
			     (format nil "~S" tag-table)))
    (setq current-buffer (send tag-table :get 'current-pathname))
    (setq search-key-p   (and current-buffer (zmacs-tags-search-key-string)))
    (format output "~&Tag table~@[ ~A~]~@[ ~*(the current tag table)~]~@[ - ~*search context is established.~]~2&"
	    tag-table-name
	    (eq tag-table *zmacs-current-tag-table*)
	    search-key-p)
    (format output "~&Buffers read in:")
    (let* ((current-buffer-mark-char #/+)
	   (max-size (- (send output :size-in-characters) 6.))
	   (max-buffer-string-len (- max-size 6))
	   (max-buffer-name-len (find-maximum-buffer-name-length max-buffer-string-len buffers)))
      (format output "~%   ~a" (make-string max-buffer-name-len :initial-element #\-))
      (when search-key-p
	(format output "  Search string:"))
      (dolist (buffer buffers)
	(let*((currentp  (eq buffer current-buffer))
	      (buffer-mark-char (if currentp current-buffer-mark-char #/space))
	      (buffer-string (name-for-display buffer max-buffer-name-len)))
	  (format output "~& ~c " buffer-mark-char)
	  (send output :item 'zmacs-buffer buffer "~A" buffer-string)
	  (when (and search-key-p currentp)
	    (let*((extra (+ 2 (- max-buffer-name-len (string-length buffer-string))))
		  (leftover (- max-size max-buffer-name-len extra))
		  (search-string (and (plusp leftover)
				      (zmacs-tags-search-key-string-for-display leftover))))
	      (when search-string (format output "~V,@T{~A}" extra search-string))))
	  (terpri output)))
      (terpri output)
      (when current-buffer
	(format output "~& ~c  means current search buffer." current-buffer-mark-char))
      (when search-key-p
	(format output "~&{ } shows current search string."))
      (when (or current-buffer search-key-p) (terpri output))))
  dis-none)

))

; From modified file DJ: L.ZWEI; SECTIO.LISP#308 at 29-Jun-88 11:36:19
#8R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; SECTIO  "


(defun zmacs-tags-search-key-string (&optional firstonly)
  ;;Because the search key can be a list, use this to snarf out
  ;;the string or just the first part of it.
  (if firstonly
      (or (car-safe *zmacs-tags-search-key*) *zmacs-tags-search-key-string*)
    (or *zmacs-tags-search-key-string*
	(car-safe *zmacs-tags-search-key*)
	*zmacs-tags-search-key*)))

))

; From modified file DJ: L.ZWEI; SECTIO.LISP#308 at 29-Jun-88 11:36:29
#8R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; SECTIO  "


(defun zmacs-tags-search-key-string-for-display (max-size &optional firstonly)
  (declare (values search-key substring))
  (let ((search-key (zmacs-tags-search-key-string firstonly)))
    (if (<= (string-length search-key) max-size)
	(values search-key nil)
      (values (string-append (substring search-key 0 (max (- max-size 2) 0)) " ") t))))

))