;;; -*- Mode:LISP; Package:ZWEI; Patch-File:T; Base:8; Readtable:ZL -*-
;;; Private patches made by saz
;;; Reason:
;;;  ZMAIL modifications.  Will it ever work right?
;;; Reason:
;;;  middle mouse on jump begins to work, not quite done...
;;; Written 12-May-88 17:35:56 by saz (David M.J. Saslav) at site Gigamos Cambridge
;;; while running on Fowl food from band 1
;;; with Experimental System 123.278, Experimental Local-File 73.6,
;;; Experimental FILE-Server 22.5, Experimental Unix-Interface 11.0,
;;; Experimental KERMIT 34.3, Experimental ZMail 71.2, Experimental
;;; Lambda-Diag 15.0, Experimental Tape 22.4, microcode 1756, SDU Boot Tape
;;; 3.14, SDU ROM 103, patch/experimental.


(DEFINE-ZMAIL-TOP-LEVEL-COMMAND COM-ZMAIL-MOUSE-POINT-PDL "Give menu of message point pdl" ()
  (LET (*TYPEOUT-WINDOW*)
    (IF (TV:SHEET-EXPOSED-P *SUMMARY-WINDOW*)
	(SETQ *TYPEOUT-WINDOW* (SEND *SUMMARY-WINDOW* :TYPEOUT-WINDOW))
	(SETQ *TYPEOUT-WINDOW* (WINDOW-TYPEOUT-WINDOW *WINDOW*))
	(SEND *TYPEOUT-WINDOW* :LINE-OUT *SUMMARY-WINDOW-LABEL*))
    (DOLIST (ELEM *MSG-POINT-PDL*)
      (LET* ((MSG (CAR ELEM))
	     (STATUS (ASSURE-MSG-PARSED MSG)))
	(SEND *TYPEOUT-WINDOW* :TRUNCATED-ITEM 'POINT-PDL-ELEMENT ELEM "~~3D~C~A~"
;How could this have ever worked with this arg plugged in here???
;	      (EQ MSG *MSG*)
	      (INCF (msg-displayed-index msg)) (STATUS-LETTER STATUS) (MSG-SUMMARY-LINE MSG))
	(SEND *TYPEOUT-WINDOW* :TYO #/CR)))
    (CHECK-FOR-TYPEOUT-WINDOW-TYPEOUT))
  DIS-ALL)


(DEFUN CHOOSE-MAIL-FILE-OPTIONS-1 (PATHNAME FLAVOR OPTIONS &OPTIONAL (NEAR-MODE '(:MOUSE))
							   &AUX VARS VALS)
  (DECLARE (RETURN-LIST FLAVOR OPTIONS))
  (SETQ VARS (NCONS 'FLAVOR)
	VALS (NCONS FLAVOR))
  (LOOP FOR POSS IN *ZMAIL-BUFFER-OPTION-ALIST*
	AS VAR = (CAR POSS)
	AS TEM = (NCONS VAR)
	WITH PLIST = (LOCF OPTIONS)
	DO (SETQ VARS (NCONC VARS TEM))
	   (SETQ VALS (NCONC VALS (NCONS (GET PLIST (CAR TEM) (GET VAR 'TV:DEFAULT-VALUE))))))
  (LET ((*POSSIBLE-FLAVORS*
	  (LOOP FOR FLAVOR IN (SEND PATHNAME :POSSIBLE-MAIL-FILE-BUFFER-FLAVORS)
		COLLECT (RASSQ FLAVOR *ZMAIL-BUFFER-FLAVOR-ALIST*) INTO FOO
		FINALLY (RETURN (NCONC FOO (NCONS (RASSQ 'TEXT-MAIL-FILE-BUFFER
							 *ZMAIL-BUFFER-FLAVOR-ALIST*)))))))
    (DECLARE (SPECIAL *POSSIBLE-FLAVORS*))
    (PROGV VARS VALS
      (TV:CHOOSE-VARIABLE-VALUES (COMPUTE-ZMAIL-BUFFER-CHOICES FLAVOR)
				 :LABEL (FORMAT NIL "Options for ~A:" PATHNAME)
				 :NEAR-MODE '(:point 712 512)	;'(:mouse) tended to bomb when choosing the first option!
				 :MARGIN-CHOICES '("Do It"
						    ("Abort" (ABORT-CURRENT-COMMAND)))
				 :FUNCTION 'CHOOSE-MAIL-FILE-OPTIONS-FUNCTION)
      (SETQ FLAVOR (SYMEVAL 'FLAVOR))
      ;; Somewhat of a kludge
      (AND (MEMQ :MAIL VARS)
	   (DO L (SYMEVAL :MAIL) (CDR L) (NULL L)
	       (LET ((FS:*ALWAYS-MERGE-TYPE-AND-VERSION* T))
		 (SETF (CAR L) (FS:MERGE-PATHNAME-DEFAULTS (CAR L) *ZMAIL-PATHNAME-DEFAULTS*)))))
      (SETQ OPTIONS
	    (LOOP FOR VAR IN (LET (SELF)
			       (SEND (SI:GET-FLAVOR-HANDLER-FOR FLAVOR :POSSIBLE-OPTIONS)
					:POSSIBLE-OPTIONS))
		  NCONC `(,VAR ,(SYMEVAL VAR))))))
  (VALUES FLAVOR OPTIONS))