;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 124.53
;;; Reason:
;;;  When you Finish Patch with ZMACS, dpn't tell user not to forget to save
;;;  files unless there really are unsaved buffers in ZMACS.
;;; Written 13-Jun-88 17:04:49 by pld (Peter L. DeWolf) at site Gigamos Cambridge
;;; while running on Azathoth from band 1
;;; with Experimental System 124.49, Experimental Local-File 74.1, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.0, Experimental Tape 23.6, Experimental Lambda-Diag 16.1, microcode 1758, SDU Boot Tape 3.14, SDU ROM 8.



; From modified file DJ: L.ZWEI; PATED.LISP#38 at 13-Jun-88 17:04:58
#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 have 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))))))

))