;;; -*- Mode:Lisp; Readtable:T; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.101
;;; Reason:
;;;  Fix problems with behaviour of ZWEI command SET PACKAGE.  
;;;  Mostly, improve chances of finding a default package (take from global *PACKAGE*
;;;  if Zwei's *DEFAULT-PACKAGE* is NIL, or USER as a last resort which should
;;;  never occur).  This solves problem when user hit Return and Zwei offered to
;;;  create the NIL package.  (That is strangeness, indeed.) Also rationalize
;;;  prompts, error exits, and documentation string, which now says:
;;;  
;;;    Change the package associated with buffer or file.
;;;    Specify a new package to be used when interning symbols read from this buffer;
;;;    for example, evaluating or compiling parts of the buffer.
;;;    This much does not affect operations on the file itself, only this ZMACS buffer.
;;;    
;;;    To specify a package that doesn't already exist, you must exit the first
;;;    prompt with Control-Return, or type Return twice.  Then you must confirm
;;;    with /"Yes/".
;;;    
;;;    If you answer the first prompt with just Return, you will be asked
;;;    whether to use a package chosen by default based on the current
;;;    environment.  Then you must confirm whether to use the default.
;;;    
;;;    You will also be asked whether to change the attribute list in the text.
;;;    If you answer yes, the buffer's first line is modified to say that
;;;    it belongs in the new package.  This will affect all operations on the
;;;    file, once you save the buffer.
;;;    
;;;    Then you will be asked whether to resectionize the buffer.
;;;    If you say yes, all the functions definitions in the buffer
;;;    will be recorded under symbols in the new package."
;;; Written 24-Jun-88 12:08:08 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 1
;;; with Experimental System 124.94, 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; ZMNEW.LISP#55 at 24-Jun-88 12:08:09
#8R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; ZMNEW  "

(DEFCOM COM-SET-PACKAGE "Change the package associated with buffer or file.
Specify a new package to be used when interning symbols read from this buffer;
for example, evaluating or compiling parts of the buffer.
This much does not affect operations on the file itself, only this ZMACS buffer.

To specify a package that doesn't already exist, you must exit the first
prompt with Control-Return, or type Return twice.  Then you must confirm
with /"Yes/".

If you answer the first prompt with just Return, you will be asked
whether to use a package chosen by default based on the current
environment.  Then you must confirm whether to use the default.

You will also be asked whether to change the attribute list in the text.
If you answer yes, the buffer's first line is modified to say that
it belongs in the new package.  This will affect all operations on the
file, once you save the buffer.

Then you will be asked whether to resectionize the buffer.
If you say yes, all the functions definitions in the buffer
will be recorded under symbols in the new package." ()
  (LET (ALIST)
    (DOLIST (PKG *ALL-PACKAGES*)
      (PUSH (CONS (PACKAGE-NAME PKG) PKG) ALIST)
      (DOLIST (N (PACKAGE-NICKNAMES PKG))
        (PUSH (CONS N PKG) ALIST)))
    (LET ((PKG (COMPLETING-READ-FROM-MINI-BUFFER
                 "Set package:" ALIST 'MAYBE)))
      (OR (STRINGP PKG) (SETQ PKG (CAR PKG)))
      (cond
        ((not (EQUAL PKG "")))
        ((and (SETQ PKG (or *DEFAULT-PACKAGE* *package* (find-package "USER")))
              (or (YES-OR-NO-P (format nil "Use package ~A by default? " pkg))
                  (barf "You must specify a package or take the default."))))
        (t (barf "There is no default package; cannot Set Package in this context.")))
      (IF (FIND-PACKAGE PKG)
          (PKG-GOTO PKG)
	(progn
	  (SETQ PKG (STRING-UPCASE PKG))
	  (IF (YES-OR-NO-P (FORMAT NIL "Package ~A does not exist.  Create? " PKG))
	      (PKG-GOTO (MAKE-PACKAGE PKG))
	    (BARF))))))
  (SETF (BUFFER-PACKAGE *INTERVAL*) *PACKAGE*)
  (SEND *INTERVAL* ':SET-ATTRIBUTE ':PACKAGE (PACKAGE-NAME *PACKAGE*) ':QUERY)
  (WHEN (FQUERY NIL "Resectionize the buffer? ")
    (SEND *INTERVAL* ':REMPROP ':DONT-SECTIONIZE)
    (SECTIONIZE-BUFFER *INTERVAL*))
  DIS-NONE)

))