;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 124.93
;;; Reason:
;;;  For Zwei's Meta-X Finish Patch: "Release this patch?" minibuffer query
;;;  now parenthetically tells you to:
;;;  "answer N if you are not completely sure that it works", rather than
;;;  "answer N if you have not completely sure that it works".
;;; Written 23-Jun-88 11:43:32 by saz (David M.J. Saslav) at site Gigamos Cambridge
;;; while running on Brahms' First from band 1
;;; with Experimental System 124.90, Experimental Local-File 74.2, 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 for in-house.



; From modified file DJ: L.ZWEI; PATED.LISP#39 at 23-Jun-88 11:43:33
#10R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; PATED  "

(DEFUN FINISH-PATCH (&OPTIONAL (RELEASE-FLAG NIL SPECIFIEDP))
  (VALIDATE-PATCH-BUFFER)
  (COND ((NULL *PATCH-BUFFER*)
	 (BARF "There is no current patch buffer"))
	((NOT SPECIFIEDP)
	 (SETQ RELEASE-FLAG
	       (FQUERY ()
		       "Release this patch? (answer N if you are not completely sure that it works) "))))
  (LET ((DESCRIPTION (TYPEIN-LINE-MULTI-LINE-READLINE
		       "Description of changes (end with ~C)" #\END)))
    (SETQ DESCRIPTION (STRING-TRIM '(#\NEWLINE) DESCRIPTION))
    (LET ((BP (FORWARD-LINE (INTERVAL-FIRST-BP *PATCH-BUFFER*) 2)))
      (INSERT-MOVING BP ";;; Reason:")
      (INSERT-MOVING BP #\NEWLINE)
      (DO ((START 0 (1+ NEXT-LINE))
	   NEXT-LINE)
	  (())
	(SETQ NEXT-LINE (STRING-SEARCH-CHAR #\NEWLINE DESCRIPTION START))
	(INSERT-MOVING BP ";;;  ")
	(INSERT-MOVING BP DESCRIPTION START NEXT-LINE)
	(INSERT-MOVING BP #\NEWLINE)
	(OR NEXT-LINE (RETURN))))
    (SAVE-BUFFER-IF-NECESSARY *PATCH-BUFFER*)
    (WHEN (EQ *PATCH-BUFFER* *INTERVAL*)
      (MUST-REDISPLAY *WINDOW* DIS-TEXT))
    (LET ((ERROR-MESSAGE (IF *PATCH-SYSTEM*
			     (SI::CONSUMMATE-PATCH *PATCH-SYSTEM* *PATCH-NUMBER*
						   DESCRIPTION RELEASE-FLAG)
			   (progn
			     (si::compile-patch-file *patch-system* (buffer-pathname *patch-buffer*))
			     NIL))))
      (cond ((ERRORP ERROR-MESSAGE)
	     (BARF "~A" ERROR-MESSAGE))
	    (t
	     (FORMAT *QUERY-IO* "~&~:[Patch completed.~;Don't forget to save your files!~]"
		     (LOOP FOR BUFFER IN *ZMACS-BUFFER-LIST*
			   THEREIS (BUFFER-NEEDS-SAVING-P BUFFER)))
	     (SETQ *PATCH-BUFFER* NIL
		   *PATCH-SYSTEM* NIL))))))

))