;;; Inertly recovered online-help source contexts.
;;; Original System 46 file: moon/44_3.0
;;; Exact source bytes follow each generated provenance comment.

;;; Source bytes 1134:6745; lines 32-152; sha256 e51db65f5cdb0d95f46cde83ae53c30ca66f95e95d5687b6650a6671e6dd6460
TV:
(LOCAL-DECLARE ((SPECIAL *USE-FRAME* *FRAME-NAME* *SYSTEM-KEY*))
(DEFUN SYSTEM-MENU-SPLIT-SCREEN-VIA-MENUS (&OPTIONAL (SUP MOUSE-SHEET))
  ;; This has to be done here rather than at top level due to order of loading files
  (OR (ASSQ 'SPLIT-SCREEN-CHOOSE-VALUES SYSTEM-WINDOWS)
      (SYSTEM-WINDOW-ADD-TYPE 'SPLIT-SCREEN-CHOOSE-VALUES 
	#'(LAMBDA (SUP)
	    (WINDOW-CREATE 'TEMPORARY-CHOOSE-VARIABLE-VALUES-WINDOW
			   ':NAME "Split Screen Choose Values"
			   ':LABEL "Frame characteristics:"
			   ':SUPERIOR SUP
			   ':CHARACTER-WIDTH 40.
			   ':MARGIN-CHOICES NIL
			   ':IO-BUFFER NIL
			   ':VARIABLES '((*USE-FRAME* "Put windows inside a frame" :BOOLEAN)
					 (*FRAME-NAME* "Name of frame" :STRING)
					 (*SYSTEM-KEY* "[SYSTEM] <char> selects it"
						       :CHARACTER-OR-NIL))))
			T ':DEEXPOSED))
  (LET ((SCVM-MENU (GET-A-SYSTEM-WINDOW 'SPLIT-SCREEN-MENU SUP))
	(LAYWIN (GET-A-SYSTEM-WINDOW 'SPLIT-SCREEN-LAYOUT-WINDOW SUP))
	(EDGES (LIST (SHEET-INSIDE-LEFT SUP) (SHEET-INSIDE-TOP SUP)
		     (SHEET-INSIDE-RIGHT SUP) (SHEET-INSIDE-BOTTOM SUP)))
	(INTERACTION-WINDOWS NIL) (CVVW NIL)
	(*USE-FRAME* NIL) (*FRAME-NAME* "Split-screen frame") (*SYSTEM-KEY* NIL)
	(IO-BUFFER) (ITEM))
    (FUNCALL LAYWIN ':CLEAR-FROBS)
    (SETQ IO-BUFFER (FUNCALL SCVM-MENU ':IO-BUFFER))
    (IO-BUFFER-CLEAR IO-BUFFER)
    (EXPOSE-WINDOW-NEAR SCVM-MENU '(:MOUSE))
    (PUSH SCVM-MENU INTERACTION-WINDOWS)
    (UNWIND-PROTECT
      (DO ((WINDOW-TYPE-LIST NIL)
	   (N-WINDOWS 0)
	   (RES))
	  (NIL)
	(COND ((AND (PLUSP N-WINDOWS) (NOT (MEMQ LAYWIN INTERACTION-WINDOWS)))
	       (AND CVVW (FUNCALL CVVW ':DEEXPOSE))		;May need to be moved
	       (FUNCALL LAYWIN ':MOVE-NEAR-WINDOW SCVM-MENU
			(CONS (- (THIRD EDGES) (FIRST EDGES))
			      (- (FOURTH EDGES) (SECOND EDGES))))
	       (PUSH LAYWIN INTERACTION-WINDOWS)
	       (AND CVVW (EXPOSE-WINDOW-NEAR CVVW (CONS ':WINDOW
							(REMQ CVVW INTERACTION-WINDOWS))))))
	(PROCESS-WAIT "Choose" #'(LAMBDA (B) (NOT (IO-BUFFER-EMPTY-P B))) IO-BUFFER)
	(SETQ RES (IO-BUFFER-GET IO-BUFFER))
	(COND ((AND (EQ (FIRST RES) ':MENU) (EQ (FOURTH RES) SCVM-MENU))
	       (SETQ RES (FUNCALL SCVM-MENU ':EXECUTE (SETQ ITEM (SECOND RES))))
	       (AND (EQ RES T)		;"Any"
		    (SETQ RES (GET-WINDOW-TYPE-FROM-KEYBOARD SUP ':EDGES-FROM
						(CONS ':WINDOW INTERACTION-WINDOWS))))
	       (COND ((NULL RES))	;Maybe failed getting type from keyboard
		     ((EQUAL RES "Abort") (RETURN NIL))
		     ((EQUAL RES "Mouse Corners")
		      (SETQ EDGES (MULTIPLE-VALUE-LIST
				    (MOUSE-SPECIFY-RECTANGLE NIL NIL NIL NIL SUP)))
		      ;; Next line causes shape of LAYWIN to be recomputed
		      (SETQ INTERACTION-WINDOWS (DELQ LAYWIN INTERACTION-WINDOWS)))
		     ((EQUAL RES "Undo")
		      (COND ((PLUSP N-WINDOWS)
			     (SETQ N-WINDOWS (1- N-WINDOWS)
				   WINDOW-TYPE-LIST (CDR WINDOW-TYPE-LIST))
			     (FUNCALL LAYWIN ':REMOVE-LAST-FROB))))			     
		     ((EQUAL RES "Frame")
		      (SETQ *USE-FRAME* T)
		      (COND ((NULL CVVW)
			     (SETQ CVVW (GET-A-SYSTEM-WINDOW 'SPLIT-SCREEN-CHOOSE-VALUES SUP))
			     (FUNCALL CVVW ':SET-IO-BUFFER IO-BUFFER)
			     (FUNCALL CVVW ':SET-STACK-GROUP %CURRENT-STACK-GROUP)
			     (EXPOSE-WINDOW-NEAR CVVW (CONS ':WINDOW INTERACTION-WINDOWS))
			     (PUSH CVVW INTERACTION-WINDOWS))))
		     ((EQUAL RES "Existing Window")
		      (LET ((AW-MENU (GET-A-SYSTEM-WINDOW 'SELECTABLE-WINDOWS-MENU SUP)))
			(EXPOSE-WINDOW-NEAR AW-MENU (CONS ':WINDOW INTERACTION-WINDOWS))
			(COND ((SETQ RES (FUNCALL AW-MENU ':CHOOSE))
			       (FUNCALL LAYWIN ':ADD-FROB (FUNCALL RES ':NAME-FOR-SELECTION))
			       (PUSH RES WINDOW-TYPE-LIST)
			       (SETQ N-WINDOWS (1+ N-WINDOWS)))))
		      (LEXPR-FUNCALL SCVM-MENU ':SET-MOUSE-CURSORPOS
				     (MULTIPLE-VALUE-LIST
				       (FUNCALL SCVM-MENU ':ITEM-CURSORPOS ITEM))))
		     ((NOT (EQUAL RES "Done"))
		      (PUSH RES WINDOW-TYPE-LIST)
		      (FUNCALL LAYWIN ':ADD-FROB (OR (CAR (RASSOC RES WINDOW-TYPES-ITEM-LIST))
						     (STRING RES)))
		      (SETQ N-WINDOWS (1+ N-WINDOWS)))
		     (T (DELAYING-SCREEN-MANAGEMENT
			  (DOLIST (W INTERACTION-WINDOWS)	;Done with these now
			    (FUNCALL W ':DEACTIVATE))
			  (IF (NOT *USE-FRAME*)
			      (SPLIT-SCREEN-VIA-MENUS-SETUP-WINDOW SUP EDGES
				WINDOW-TYPE-LIST N-WINDOWS LAYWIN)
			      ;; BASIC-FRAME isn't necessarily the right flavor.  Maybe ask
			      ;; user whether it should be a constraint-frame.  Maybe put
			      ;; borders around it, but need a way for them to appear when
			      ;; partially exposed even though it doesn't have a
			      ;; bit-save array.
			      (LET ((FRAME (WINDOW-CREATE 'BASIC-FRAME
							  ':SUPERIOR SUP
							  ':EDGES-FROM EDGES
							  ':NAME *FRAME-NAME*
							  ':EXPOSE-P T)))
				(AND *SYSTEM-KEY*
				     (SETQ *SYSTEM-KEYS*
					   (CONS (LIST *SYSTEM-KEY* FRAME *FRAME-NAME* NIL)
						 (DELQ (ASSQ *SYSTEM-KEY* *SYSTEM-KEYS*)
						       *SYSTEM-KEYS*))))
				(SPLIT-SCREEN-VIA-MENUS-SETUP-WINDOW FRAME
				 (LIST (SHEET-INSIDE-LEFT FRAME) (SHEET-INSIDE-TOP FRAME)
				       (SHEET-INSIDE-RIGHT FRAME) (SHEET-INSIDE-BOTTOM FRAME))
				 WINDOW-TYPE-LIST N-WINDOWS LAYWIN)
				;; This wouldn't be needed if frames weren't broken
				(AND (MEMQ SELECTED-WINDOW (SHEET-EXPOSED-INFERIORS FRAME))
				     (FUNCALL FRAME ':SELECT-PANE SELECTED-WINDOW)))))
			(RETURN))))
	      ((EQ (FIRST RES) ':VARIABLE-CHOICE)
	       (APPLY #'CHOOSE-VARIABLE-VALUES-CHOICE (CDR RES)))
	      (T (FERROR NIL "Garbage from i//o buffer: ~S" RES))))
      (DELAYING-SCREEN-MANAGEMENT
       (DOLIST (W INTERACTION-WINDOWS)	;Done with these now
	 (FUNCALL W ':DEACTIVATE)))))))