;;; Lisp Machine mail reader -*- Mode:LISP; Package:ZWEI -*- 
;;; Command loop and primitives for ZMail
;;; Definitions are in DEFS
;;; ** (c) Copyright 1980 Massachusetts Institute of Technology **

;;; A process with a few communication cells.
(DEFFLAVOR ZMAIL-BACKGROUND-PROCESS
	((REQUEST-CELL NIL)
	 (LOCK NIL)
	 (PRELOAD-QUEUE NIL))
	(SI:PROCESS)
  :OUTSIDE-ACCESSIBLE-INSTANCE-VARIABLES)

;;; The command loops
(DEFFLAVOR ZMAIL-FRAME-MIXIN
	(*GLOBAL-MODE-LINE-WINDOW*)		;Local version of mode line
	()
  (:INCLUDED-FLAVORS TOP-LEVEL-EDITOR TV:CONSTRAINT-FRAME-WITH-SHARED-IO-BUFFER))

(DEFMETHOD (ZMAIL-FRAME-MIXIN :AFTER :INIT) (IGNORE)
  (SETQ *GLOBAL-MODE-LINE-WINDOW* (FUNCALL-SELF ':GET-PANE 'MODE-LINE-WINDOW)))

(DEFMETHOD (ZMAIL-FRAME-MIXIN :MODE-LINE-WINDOW) ()
  *GLOBAL-MODE-LINE-WINDOW*)

(DEFMETHOD (ZMAIL-FRAME-MIXIN :PRINT-NOTIFICATION) (TIME STRING WINDOW-OF-INTEREST)
  WINDOW-OF-INTEREST  ;ignored
  (WINDOW-TYPEIN-NOTIFICATION *WINDOW* TIME STRING))

(DEFFLAVOR ZMAIL-COMMAND-LOOP-MIXIN
	((*COMTAB* *STANDARD-COMTAB*)		;For the mode comtab to indirect to
	 )
	()
  (:REQUIRED-METHODS :TOP-LEVEL-TAG :PROCESS-COMMAND-CHAR :PROCESS-SPECIAL-COMMAND)
  (:INCLUDED-FLAVORS TOP-LEVEL-EDITOR))

(DEFVAR *CURRENT-COMMAND-LOOP*)

(DEFWRAPPER (ZMAIL-COMMAND-LOOP-MIXIN :COMMAND-LOOP) (IGNORE . BODY)
  `(MULTIPLE-VALUE-BIND (TERMINAL-IO STANDARD-INPUT STANDARD-OUTPUT QUERY-IO)
       (FUNCALL-SELF ':TERMINAL-STREAMS)
     (CONDITION-BIND ((UNKNOWN-SPECIAL-COMMAND #'ZMAIL-COMMAND-LOOP-UNKNOWN-SPECIAL-COMMAND))
       (LET ((*CURRENT-COMMAND-LOOP* SELF))
	 . ,BODY))))

(DEFMETHOD (ZMAIL-COMMAND-LOOP-MIXIN :BEFORE :COMMAND-LOOP) ()
  (TV:PROCESS-TYPEAHEAD TV:IO-BUFFER
			#'(LAMBDA (CH)
			    (IF (AND (LISTP CH)
				     (MEMQ (CAR CH) '(REDISPLAY SELECT-WINDOW
						      CONFIGURATION-CHANGED)))
				NIL CH))))

(DEFMETHOD (ZMAIL-COMMAND-LOOP-MIXIN :COMMAND-LOOP) ()
  (*CATCH (FUNCALL-SELF ':TOP-LEVEL-TAG)
    (DO ((*NUMERIC-ARG-P* NIL)
	 (*NUMERIC-ARG* 0)
	 (*CURRENT-COMMAND* NIL)
	 (*LAST-COMMAND-CHAR*))
	(NIL)
      (*CATCH 'RETURN-TO-COMMAND-LOOP
	(*CATCH 'SYS:COMMAND-LEVEL
	  (COND ((*CATCH 'TOP-LEVEL
		   (*CATCH 'ZWEI-COMMAND-LOOP
		     (PROG1 NIL
			    (FUNCALL-SELF ':REDISPLAY)
			    (TICK)
			    (SETQ *LAST-COMMAND-CHAR* (WITHOUT-IO-BUFFER-OUTPUT-FUNCTION
							(FUNCALL STANDARD-INPUT ':ANY-TYI)))
			    (COND ((NULL *LAST-COMMAND-CHAR*)	;EOF
				   (RETURN T))
				  ((LISTP *LAST-COMMAND-CHAR*)
				   (LEXPR-FUNCALL-SELF ':PROCESS-SPECIAL-COMMAND
						       *LAST-COMMAND-CHAR*))
				  (T
				   (FUNCALL-SELF ':PROCESS-COMMAND-CHAR
						 *LAST-COMMAND-CHAR*))))))
		 (FUNCALL *TYPEOUT-WINDOW* ':MAKE-COMPLETE))))))))

(DEFUN ZMAIL-COMMAND-LOOP-UNKNOWN-SPECIAL-COMMAND (&REST IGNORE)
  (COND ((MEMQ (CAR *LAST-COMMAND-CHAR*)
	       (FUNCALL *CURRENT-COMMAND-LOOP* ':PROCESS-SPECIAL-COMMAND ':WHICH-OPERATIONS))
	 (FUNCALL STANDARD-INPUT ':UNTYI *LAST-COMMAND-CHAR*)
	 (*THROW 'RETURN-TO-COMMAND-LOOP NIL))))

(DEFMETHOD (ZMAIL-COMMAND-LOOP-MIXIN :REDISPLAY) ()
  (REDISPLAY-ALL-WINDOWS)
  (FUNCALL *TYPEIN-WINDOW* ':COMMAND-LOOP-REDISPLAY))

(DEFSELECT ZMAIL-COMMAND-LIST-DEFAULT
  ((SUMMARY-EXECUTE :TYPEOUT-EXECUTE :EXECUTE) (FUNCTION &REST ARGS)
    (APPLY FUNCTION ARGS))			;Request from typeout or summary menus
  ((REDISPLAY CONFIGURATION-CHANGED) (&OPTIONAL IGNORE)
    DIS-NONE)
  (SCROLL (WINDOW NLINES TYPE)			;Scroll bar command
    (OR (EQ TYPE ':RELATIVE)
	(SETQ TYPE ':START
	      NLINES (FORWARD-LINE (INTERVAL-FIRST-BP (WINDOW-INTERVAL WINDOW))
				   NLINES T)))
    (REDISPLAY WINDOW TYPE NLINES)
    DIS-NONE)
  (SELECT-WINDOW (WINDOW)			;Moused a window, edit there
    (MAKE-WINDOW-CURRENT WINDOW)
    (UNWIND-PROTECT
      (LET* ((*TYPEOUT-WINDOW* (WINDOW-TYPEOUT-WINDOW *WINDOW*))
	     (TERMINAL-IO *TYPEOUT-WINDOW*))
	(FUNCALL-SELF ':EDIT))
      (FUNCALL-SELF ':SELECT NIL)))
  (:MOUSE (&REST IGNORE)			;Mouse char, edit that window
    (FUNCALL STANDARD-INPUT ':UNTYI *LAST-COMMAND-CHAR*)
    (FUNCALL-SELF ':PROCESS-SPECIAL-COMMAND 'SELECT-WINDOW *WINDOW*))
  ) 

(DEFMETHOD (ZMAIL-COMMAND-LOOP-MIXIN :PROCESS-COMMAND-CHAR) (CHAR)
  (SELECTQ CHAR
    (#\CLEAR-SCREEN
     (FUNCALL-SELF ':REFRESH))
    (#/R
     (FUNCALL-SELF ':PROCESS-SPECIAL-COMMAND 'SELECT-WINDOW *WINDOW*))
    (#\BREAK
     (COM-ZMAIL-BREAK))
    (#\ABORT
     (*THROW (FUNCALL-SELF ':TOP-LEVEL-TAG) NIL))
    (OTHERWISE
     (BARF))))

(DEFFLAVOR ZMAIL-COMMAND-LOOP-MIXIN-WITH-SUMMARY () ()
  (:INCLUDED-FLAVORS ZMAIL-COMMAND-LOOP-MIXIN))

(DEFMETHOD (ZMAIL-COMMAND-LOOP-MIXIN-WITH-SUMMARY :REDISPLAY) (&AUX REDISPLAY-SUPPRESSED)
  (SETQ REDISPLAY-SUPPRESSED (REDISPLAY-ALL-WINDOWS))
  (AND (NOT REDISPLAY-SUPPRESSED)
       (FUNCALL *TYPEIN-WINDOW* ':COMMAND-LOOP-REDISPLAY))
  (AND (TV:SHEET-EXPOSED-P *SUMMARY-WINDOW*) (NOT REDISPLAY-SUPPRESSED)
       (FUNCALL *SUMMARY-WINDOW* ':REDISPLAY-AS-NECESSARY)))

;;; This is the flavor that does it all, really, instance variables here should just change
;;; defaults.
(DEFFLAVOR ZMAIL-FRAME 
       ((*MODE-LINE-LIST* '("ZMail " *ZMAIL-FILE-NAME* *CURRENT-MSG-NAME*
			    (*CURRENT-MSG-KEYWORDS-STRING* "  " *CURRENT-MSG-KEYWORDS-STRING*)
			    (*MACRO-LEVEL* "  Macro-level: " *MACRO-LEVEL*)
			    (*MSG-MORE-STRING* "  " *MSG-MORE-STRING*)))
	(*MAJOR-MODE* 'TEXT-MODE)		;The default inside ZMAIL
	)
       (OWN-STANDARD-INPUT-EDITOR-MIXIN TOP-LEVEL-EDITOR BASIC-ZMAIL
	ZMAIL-FRAME-MIXIN ZMAIL-COMMAND-LOOP-MIXIN-WITH-SUMMARY ZMAIL-COMMAND-LOOP-MIXIN
	TV:ANY-TYI-MIXIN TV:PROCESS-MIXIN TV:SELECT-MIXIN TV:INITIALLY-INVISIBLE-MIXIN
	TV:CONSTRAINT-FRAME-WITH-SHARED-IO-BUFFER TV:BORDERS-MIXIN ZWEI-MACRO-MIXIN)
  (:DEFAULT-INIT-PLIST :BORDER-MARGIN-WIDTH 0))

(DEFVAR *EDITOR-MODE-LINE-CONFIGURATIONS* '(:SEND :REPLY :PROFILE))
(DEFVAR *MSG-WINDOW-CONFIGURATIONS* '(:MSG :BOTH :NEW))
(DEFVAR *SUMMARY-WINDOW-CONFIGURATIONS* '(:BOTH :SUMMARY :NEW :FILTER))
(DEFVAR *MULTI-WINDOW-SENDING-CONFIGURATIONS* '(:REPLY :SEND))
(DEFVAR *MSG-AND-SUMMARY-CONFIGURATIONS* '(:BOTH :NEW))

(DEFMETHOD (ZMAIL-FRAME :BEFORE :INIT) (PLIST &AUX SUPERIOR-LINE-HEIGHT
						   MODE-LINE-HEIGHT EDITOR-MODE-LINE-HEIGHT)
  (PUTPROP PLIST T ':SAVE-BITS)			;Things depend on working like this
  (SETQ TV:PROCESS '(ZMAIL-PROCESS-TOP-LEVEL :SPECIAL-PDL-SIZE 4000
					     :REGULAR-PDL-SIZE 4000.))
  (SETQ SUPERIOR-LINE-HEIGHT TV:(SHEET-LINE-HEIGHT SUPERIOR)
	MODE-LINE-HEIGHT (+ 10 (* 2 SUPERIOR-LINE-HEIGHT))
	EDITOR-MODE-LINE-HEIGHT (+ MODE-LINE-HEIGHT SUPERIOR-LINE-HEIGHT))
  (SETQ TV:PANES `((MODE-LINE-WINDOW ZMAIL-MOUSE-SENSITIVE-MODE-LINE-PANE
				     :HEIGHT ,MODE-LINE-HEIGHT
				     :SELECTABLE-ELEMENTS-LOCATION
				       ,(LOCATE-IN-INSTANCE SELF
							    '*SELECTABLE-MODE-LINE-ELEMENTS*)
				     :BLINKER-DESELECTED-VISIBILITY :OFF)
		   (MSG-WINDOW ZMAIL-WINDOW :LABEL "Message"
					    :BLINKER-DESELECTED-VISIBILITY :OFF
					    :WHO-LINE-OVERRIDE-DOCUMENTATION-STRING
					      ,*EDIT-MSG-DOCUMENTATION*)
		   (HEADER-WINDOW ZMAIL-WINDOW :LABEL "Headers")
		   (REPLY-WINDOW ZMAIL-WINDOW :LABEL "Mail")
		   (SUMMARY-WINDOW ZMAIL-SUMMARY-SCROLL-WINDOW)
		   (FILTER-WINDOW ZMAIL-FILTER-FRAME)
		   (PROFILE-WINDOW ZMAIL-PROFILE-FRAME)
		   (PROFILE-EDITOR-WINDOW ZMAIL-WINDOW :LABEL "Profile"
					  :WHO-LINE-OVERRIDE-DOCUMENTATION-STRING
					    "L: edit profile buffer.")
		   (COMMAND-MENU ZMAIL-MAIN-COMMAND-MENU-PANE
				 :COLUMNS 5 :ITEM-LIST ,*ZMAIL-COMMAND-ALIST*)
		   (NO-FILTER-COMMAND-MENU ZMAIL-MAIN-COMMAND-MENU-PANE
					   :COLUMNS 6
					   :ITEM-LIST ,*ZMAIL-NO-FILTER-COMMAND-ALIST*)
		   (FILTER-COMMAND-MENU ZMAIL-MAIN-COMMAND-MENU-PANE
					:COLUMNS 5
					:ITEM-LIST ,*ZMAIL-FILTER-COMMAND-ALIST*)
		   (BUTTONS-FRAME TV:BUTTONS-FRAME
				  :PANES ((UNIVERSE-BUTTON TV:MEDIUM-BUTTON-PANE
					   :NAME "Just current message"
					   :DOCUMENTATION ,*UNIVERSE-BUTTON-DOCUMENTATION*)
					  (FILTER-BUTTON TV:MEDIUM-BUTTON-PANE
					   :NAME "All"
					   :DOCUMENTATION ,*FILTER-BUTTON-DOCUMENTATION*)))
		   (EDITOR-MODE-LINE-WINDOW MODE-LINE-PANE
					    :HEIGHT ,EDITOR-MODE-LINE-HEIGHT
					    :MORE-P NIL
					    :BLINKER-DESELECTED-VISIBILITY :OFF))

	TV:SUBSTITUTIONS `((STANDARD-MODE-LINE . (MODE-LINE-WINDOW ,MODE-LINE-HEIGHT))
			   (STANDARD-EDITOR-MODE-LINE
			     . (EDITOR-MODE-LINE-WINDOW ,EDITOR-MODE-LINE-HEIGHT))
			   (STANDARD-HEADER . (HEADER-WINDOW :LIMIT (1 3 :LINES)
							     0.20s0 :LINES))
			   (STANDARD-COMMAND-MENU . (COMMAND-MENU :ASK :PANE-SIZE)))

	TV:CONSTRAINTS '((:MSG . ((MSG-WINDOW COMMAND-MENU MODE-LINE-WINDOW)
				  (STANDARD-MODE-LINE
				   STANDARD-COMMAND-MENU)
				  ((MSG-WINDOW :EVEN))))
			 (:BOTH . ((SUMMARY-WINDOW COMMAND-MENU MSG-WINDOW MODE-LINE-WINDOW)
				   (STANDARD-MODE-LINE
				    STANDARD-COMMAND-MENU
				    (SUMMARY-WINDOW :EVAL (TV:CONSTRAINT-ROUND
							    (* *SUMMARY-WINDOW-FRACTION*
							       TV:**CONSTRAINT-TOTAL-HEIGHT**)
							    '(NIL :LINES)
							    TV:**CONSTRAINT-NODE**)))
				   ((MSG-WINDOW :EVEN))))
			 (:SUMMARY . ((SUMMARY-WINDOW MODE-LINE-WINDOW)
				      (STANDARD-MODE-LINE)
				      ((SUMMARY-WINDOW :EVEN))))
			 (:SEND . ((HEADER-WINDOW REPLY-WINDOW EDITOR-MODE-LINE-WINDOW)
				   (STANDARD-EDITOR-MODE-LINE
				    STANDARD-HEADER)
				   ((REPLY-WINDOW :EVEN))))
			 (:REPLY . ((MSG-WINDOW HEADER-WINDOW REPLY-WINDOW
				     EDITOR-MODE-LINE-WINDOW)
				    (STANDARD-EDITOR-MODE-LINE
				     (MSG-WINDOW 0.50s0 :LINES)
				     STANDARD-HEADER)
				    ((REPLY-WINDOW :EVEN))))
			 (:NEW . ((SUMMARY-WINDOW NO-FILTER-COMMAND-MENU BUTTONS-FRAME
				   FILTER-COMMAND-MENU MSG-WINDOW MODE-LINE-WINDOW)
				  (STANDARD-MODE-LINE
				   (NO-FILTER-COMMAND-MENU :ASK :PANE-SIZE)
				   (FILTER-COMMAND-MENU :ASK :PANE-SIZE)
				   (SUMMARY-WINDOW :EVAL (TV:CONSTRAINT-ROUND
							   (* *SUMMARY-WINDOW-FRACTION*
							      TV:**CONSTRAINT-TOTAL-HEIGHT**)
							   '(NIL :LINES)
							   TV:**CONSTRAINT-NODE**)))
				  ((BUTTONS-FRAME :ASK :PANE-SIZE))
				  ((MSG-WINDOW :EVEN))))
			 (:FILTER . ((SUMMARY-WINDOW FILTER-WINDOW)
				     ((SUMMARY-WINDOW
					:EVAL (TV:CONSTRAINT-ROUND
						(* (OR *FILTER-SUMMARY-WINDOW-FRACTION*
						       *SUMMARY-WINDOW-FRACTION*)
						   TV:**CONSTRAINT-TOTAL-HEIGHT**)
						'(NIL :LINES)
						TV:**CONSTRAINT-NODE**)))
				     ((FILTER-WINDOW :EVEN))))
			 (:PROFILE . ((PROFILE-WINDOW
				       PROFILE-EDITOR-WINDOW EDITOR-MODE-LINE-WINDOW)
				      (STANDARD-EDITOR-MODE-LINE
				       (PROFILE-WINDOW 0.425s0))
				      ((PROFILE-EDITOR-WINDOW :EVEN)))))
	TV:CONFIGURATION *DEFAULT-INITIAL-WINDOW-CONFIGURATION*))

;;; This must go off before TOP-LEVEL-EDITOR or EDITOR, which require that there be a window
(DEFMETHOD (BASIC-ZMAIL :AFTER :INIT) (IGNORE)
  (MULTIPLE-VALUE (*MSG-WINDOW* *MSG-INTERVAL*)
    (CREATE-ZMAIL-WINDOW 'MSG-WINDOW))
  (SETQ *WINDOW* *MSG-WINDOW*))

(DEFMETHOD (ZMAIL-FRAME :AFTER :INIT) (IGNORE)
  (SETQ STANDARD-INPUT (MAKE-MACRO-STREAM SELF))
  (SETQ *HEADER-WINDOW* (FUNCALL (FUNCALL-SELF ':GET-PANE 'HEADER-WINDOW) ':ZWEI-WINDOW))
  (SETQ *REPLY-WINDOW* (FUNCALL (FUNCALL-SELF ':GET-PANE 'REPLY-WINDOW) ':ZWEI-WINDOW))
  (SETQ *PROFILE-EDITOR-WINDOW* (CREATE-ZMAIL-WINDOW 'PROFILE-EDITOR-WINDOW T)
	*PROFILE-EDITOR* (CREATE-PROFILE-EDITOR *PROFILE-EDITOR-WINDOW*))
  (SETQ *SUMMARY-WINDOW* (FUNCALL-SELF ':GET-PANE 'SUMMARY-WINDOW)
	*FILTER-WINDOW* (FUNCALL-SELF ':GET-PANE 'FILTER-WINDOW)
	*PROFILE-WINDOW* (FUNCALL-SELF ':GET-PANE 'PROFILE-WINDOW)
	*COMMAND-MENU* (FUNCALL-SELF ':GET-PANE 'COMMAND-MENU)
	*KEYWORD-WINDOW* (TV:MAKE-WINDOW 'POP-UP-ZMAIL-MULTIPLE-MENU
					 ':NEW-FUNCTION 'MULTIPLE-MENU-NEW-KEYWORD
					 ':SUPERIOR SELF)
	*MOVE-MAIL-FILE-MENU* (TV:MAKE-WINDOW 'CLICK-REMEMBERING-POP-UP-MENU
					      ':COLUMNS 2 ':ITEM-LIST NIL
					      ':FONT-MAP '(FONTS:MEDFNT FONTS:HL12I)
					      ':SUPERIOR SELF)
	*ZMAIL-MAP-COMMAND-MENU* (TV:MAKE-WINDOW 'ZMAIL-DYNAMIC-MOMENTARY-COMMAND-MENU
						 ':COLUMNS 2
						 ':ITEM-LIST-POINTER
						 '*ZMAIL-MAP-COMMAND-ALIST*
						 ':SUPERIOR SELF)
	*SELECT-MAIL-FILE-MENU* (TV:MAKE-WINDOW 'CLICK-REMEMBERING-POP-UP-MENU
						':COLUMNS 2 ':ITEM-LIST NIL
						':FONT-MAP '(FONTS:MEDFNT FONTS:HL12I)
						':SUPERIOR SELF)
	*FILTER-SELECTION-FRAME* (TV:MAKE-WINDOW 'FILTER-SELECTION-FRAME
						 ':SAVE-BITS T
						 ':SUPERIOR SELF)
	*UNIVERSE-SELECTION-MENU* (TV:MAKE-WINDOW 'TV:MOMENTARY-MULTIPLE-ITEM-LIST-MENU
						  ':FONT-MAP '(FONTS:MEDFNT FONTS:HL12I)
						  ':LABEL "Universe:"
						  ':SUPERIOR SELF)
	*UNIVERSE-DEFINITION-FRAME* (TV:MAKE-WINDOW 'UNIVERSE-DEFINITION-FRAME
						    ':SAVE-BITS T
						    ':SUPERIOR SELF)
	*OVERLYING-WINDOW* (TV:MAKE-WINDOW 'ZMAIL-OVERLYING-WINDOW
					   ':LABEL "" ':SUPERIOR SELF)
	*POP-UP-MINI-BUFFER-EDITOR* (MAKE-EDITOR-FOR-TEMPORARY-MINI-BUFFER SELF TV:IO-BUFFER)
	)
  (SETQ *WINDOW-LIST* (LIST *REPLY-WINDOW* *MSG-WINDOW* *HEADER-WINDOW* *MINI-BUFFER-WINDOW*))
  (SETQ *SELECTABLE-MODE-LINE-ELEMENTS* '((*CURRENT-MSG-KEYWORDS-STRING* . COM-ZMAIL-KEYWORDS)
					  (*MSG-MORE-STRING* . COM-ZMAIL-MODE-LINE-SCROLL)
					  ))
  (SETQ *ZMAIL-BACKGROUND-PROCESS* (SI:MAKE-PROCESS "Zmail background"
						    ':FLAVOR 'ZMAIL-BACKGROUND-PROCESS
						    ':SPECIAL-PDL-SIZE 4000
						    ':REGULAR-PDL-SIZE 4000.))
  (SETQ *ZMAIL-BACKGROUND-REQUEST-CELL*
	(LOCF (ZMAIL-BACKGROUND-PROCESS-REQUEST-CELL *ZMAIL-BACKGROUND-PROCESS*))
	*ZMAIL-BACKGROUND-PROCESS-LOCK*
	(LOCF (ZMAIL-BACKGROUND-PROCESS-LOCK *ZMAIL-BACKGROUND-PROCESS*)))
  (PROCESS-PRESET *ZMAIL-BACKGROUND-PROCESS* 'ZMAIL-BACKGROUND TV:IO-BUFFER))

;;; Position all the needed windows for this operation
(DEFMETHOD (ZMAIL-FRAME :SET-WINDOW-CONFIGURATION)
	   (NEW-CONFIGURATION &OPTIONAL STARTING-WINDOW
			      &AUX LEFT RIGHT TOP BOTTOM EXPOSE-P SELECT-P
				   OLD-MODE-LINE-WINDOW)
  (SETQ *WINDOW-CONFIGURATION* NEW-CONFIGURATION)
  (SETQ OLD-MODE-LINE-WINDOW *GLOBAL-MODE-LINE-WINDOW*
	*GLOBAL-MODE-LINE-WINDOW* (FUNCALL-SELF ':GET-PANE
						(IF (MEMQ NEW-CONFIGURATION
							  *EDITOR-MODE-LINE-CONFIGURATIONS*)
						    'EDITOR-MODE-LINE-WINDOW
						    'MODE-LINE-WINDOW)))
  ;; Remember if selected window is anywhere in our hierarchy
  (SETQ SELECT-P (DO SHEET TV:SELECTED-WINDOW (TV:SHEET-SUPERIOR SHEET) (NULL SHEET)
		   (AND (EQ SELF SHEET) (RETURN T))))
  (TV:DELAYING-SCREEN-MANAGEMENT
    (AND (SETQ EXPOSE-P TV:EXPOSED-P)		;Make things look less spastic
	 (FUNCALL-SELF ':DEEXPOSE ':DEFAULT ':NOOP))
    (SI:PAGE-IN-ARRAY TV:SCREEN-ARRAY)
    (COND ((NEQ *GLOBAL-MODE-LINE-WINDOW* OLD-MODE-LINE-WINDOW)
	   (FUNCALL OLD-MODE-LINE-WINDOW ':DEACTIVATE)
	   (FUNCALL (WINDOW-SHEET (FUNCALL OLD-MODE-LINE-WINDOW ':MINI-BUFFER-WINDOW))
		    ':DEACTIVATE)
	   (FUNCALL (WINDOW-SHEET (FUNCALL OLD-MODE-LINE-WINDOW ':SEARCH-MINI-BUFFER-WINDOW))
		    ':DEACTIVATE)
	   (FUNCALL (FUNCALL OLD-MODE-LINE-WINDOW ':TYPEIN-WINDOW) ':DEACTIVATE)))
    (FUNCALL-SELF ':SET-CONFIGURATION NEW-CONFIGURATION)
    (SETQ LEFT (TV:SHEET-INSIDE-LEFT)
	  TOP (TV:SHEET-INSIDE-TOP)
	  RIGHT (TV:SHEET-INSIDE-RIGHT)
	  BOTTOM (- (TV:SHEET-INSIDE-BOTTOM) (TV:SHEET-HEIGHT *GLOBAL-MODE-LINE-WINDOW*)))
    (COND ((MEMQ NEW-CONFIGURATION *MSG-WINDOW-CONFIGURATIONS*)
	   (SETQ STARTING-WINDOW *MSG-WINDOW*))
	  ((EQ NEW-CONFIGURATION ':FILTER)
	   (FUNCALL *FILTER-WINDOW* ':INITIALIZE))
	  ((EQ NEW-CONFIGURATION ':PROFILE)
	   (FUNCALL *PROFILE-WINDOW* ':INITIALIZE)
	   (SETQ STARTING-WINDOW *PROFILE-EDITOR-WINDOW*)))
    (AND (MEMQ NEW-CONFIGURATION *SUMMARY-WINDOW-CONFIGURATIONS*)
	 (NOT (STRING-EQUAL (TV:LABEL-STRING (FUNCALL *SUMMARY-WINDOW* ':LABEL))
			    *SUMMARY-WINDOW-LABEL*))
	 (FUNCALL *SUMMARY-WINDOW* ':SET-LABEL (STRING-APPEND *SUMMARY-WINDOW-LABEL*)))
    (AND EXPOSE-P (IF SELECT-P (FUNCALL-SELF ':SELECT NIL) (FUNCALL-SELF ':EXPOSE))))
  (COND (STARTING-WINDOW
	 ;;This won't happen in MAKE-WINDOW-CURRENT, but they may have changed due to a
	 ;;different *GLOBAL-MODE-LINE-WINDOW*.
	 (AND (EQ STARTING-WINDOW *WINDOW*)
	      (MULTIPLE-VALUE (*MODE-LINE-WINDOW* *TYPEIN-WINDOW* *MINI-BUFFER-WINDOW*)
		(WINDOW-MODE-LINE-WINDOWS STARTING-WINDOW)))
	 (MAKE-WINDOW-CURRENT STARTING-WINDOW)
	 (AND SELECT-P
	      (OR (EQ STARTING-WINDOW *MSG-WINDOW*)
		  (EQ STARTING-WINDOW *PROFILE-EDITOR-WINDOW*))
	      (FUNCALL-SELF ':SELECT NIL)))
	((EQ NEW-CONFIGURATION ':SUMMARY)
	 (SETQ *MODE-LINE-WINDOW* *GLOBAL-MODE-LINE-WINDOW*
	       *TYPEIN-WINDOW* (FUNCALL *MODE-LINE-WINDOW* ':TYPEIN-WINDOW)
	       *MINI-BUFFER-WINDOW* (FUNCALL *MODE-LINE-WINDOW* ':MINI-BUFFER-WINDOW)
	       *TYPEOUT-WINDOW* (FUNCALL *SUMMARY-WINDOW* ':TYPEOUT-WINDOW)
	       TERMINAL-IO *TYPEOUT-WINDOW*))
	(T
	 (MULTIPLE-VALUE (*MODE-LINE-WINDOW* *TYPEIN-WINDOW* *MINI-BUFFER-WINDOW*)
	   (WINDOW-MODE-LINE-WINDOWS *WINDOW*)))))

(DEFMETHOD (ZMAIL-FRAME :AFTER :CHANGE-OF-SIZE-OR-MARGINS) (&REST IGNORE)
  (FUNCALL *OVERLYING-WINDOW* ':FULL-SCREEN))

;;; Make the mode line correct when inside reply edit
(DEFMETHOD (ZMAIL-FRAME :AFTER :SET-INTERVAL) (INTERVAL)
  (AND (ZMAIL-INTERVAL-P INTERVAL)
       (SETQ *ZMAIL-INTERVAL-NAME* (BUFFER-NAME INTERVAL)))
  (AND (MEMQ *WINDOW-CONFIGURATION* *MULTI-WINDOW-SENDING-CONFIGURATIONS*)
       (SETQ *END-SENDS-MESSAGE-P* (NEQ *WINDOW* *HEADER-WINDOW*))))

;;; Called by the macro stream system
(DEFMETHOD (ZMAIL-FRAME :READ-MACRO-LINE) (PROMPT &AUX (*CURRENT-COMMAND* 'READ-MACRO-LINE))
  (TYPEIN-LINE-READLINE PROMPT))

;;; Initialization and outside functions
(DEFVAR *ZMAIL-USER*)				;USER-ID that last ran this

(DEFUN INITIALIZE-ZMAIL ()
  (AND (BOUNDP '*ZMAIL-WINDOW*) (FUNCALL *ZMAIL-WINDOW* ':KILL))
  (SETQ *ZMAIL-WINDOW* (TV:MAKE-WINDOW 'ZMAIL-FRAME ':NAME "MAIN-ZMAIL-WINDOW"))
  (INITIALIZE-ZMAIL-COMTABS (SYMEVAL-IN-INSTANCE *ZMAIL-WINDOW* '*MODE-COMTAB*))
  (OR (ASSQ #/M TV:*SYSTEM-KEYS*)
      (SETQ TV:*SYSTEM-KEYS* (NCONC TV:*SYSTEM-KEYS* '((#/M ZMAIL-FRAME "ZMail" NIL)))))
  (TV:ADD-TO-SYSTEM-MENU-PROGRAMS-COLUMN "Mail"
    '(TV:SELECT-OR-CREATE-WINDOW-OF-FLAVOR 'ZMAIL-FRAME)
    "Select ZMail, to send or receive mail."
    "Inspect")
  (SETQ *ZMAIL-PATHNAME-DEFAULTS* (FS:MAKE-PATHNAME-DEFAULTS))
  (RESET-ZMAIL-USER)
  (FUNCALL *ZMAIL-WINDOW* ':SET-WINDOW-CONFIGURATION *DEFAULT-INITIAL-WINDOW-CONFIGURATION*)
  (FUNCALL *ZMAIL-WINDOW* ':ACTIVATE))		;Now ok to call it up

;;; Top level function
(DEFUN ZMAIL (&OPTIONAL PATHNAME)
  (COND ((EQ PATHNAME 'RELOAD)
	 (INITIALIZE-ZMAIL)
	 (SETQ PATHNAME NIL)))
  (FS:FORCE-USER-TO-LOGIN)
  (FUNCALL *ZMAIL-WINDOW* ':SET-MAIL-FILE PATHNAME)
  (FUNCALL *ZMAIL-WINDOW* ':SELECT)
  (TV:AWAIT-WINDOW-EXPOSURE)
  T)

;;; This is the initial function for the zmail window
(DEFUN ZMAIL-PROCESS-TOP-LEVEL (WINDOW)
  (PROCESS-WAIT "Select"
		#'(LAMBDA (WINDOW)
		    (DO W TV:SELECTED-WINDOW (TV:SHEET-SUPERIOR W) (NULL W)
			(AND (EQ WINDOW W) (RETURN T))))
		WINDOW)
  (FUNCALL WINDOW ':SELECT)
  (AND (STRING-EQUAL USER-ID "")
       (LET ((TERMINAL-IO (FUNCALL (FUNCALL WINDOW ':GET-PANE 'MSG-WINDOW) ':TYPEOUT-WINDOW)))
	 (FUNCALL TERMINAL-IO ':OUTPUT-HOLD-EXCEPTION)
	 (TV:WINDOW-CALL (TERMINAL-IO)
	   (FS:FORCE-USER-TO-LOGIN))))
  (AND (NULL *ZMAIL-USER*)
       (FUNCALL WINDOW ':NULL-STARTUP-SETUP))
  (FUNCALL WINDOW ':COMMAND-LOOP)
  (TV:DESELECT-AND-MAYBE-BURY-WINDOW WINDOW)
  (SI:PROCESS-WAIT-FOREVER))

(DEFVAR *NULL-STARTUP-MSG-INTERVAL* (CREATE-INTERVAL "Type the HELP key for help.
To read your new mail, click Left on /"Get new mail/".
To send a message, click Left on /"Mail/".
To send a bug report, click Middle on /"Mail/"."))

(DEFMETHOD (ZMAIL-FRAME :NULL-STARTUP-SETUP) ()
  (LET ((BP (INTERVAL-FIRST-BP *NULL-STARTUP-MSG-INTERVAL*)))
    (MOVE-BP (POINT) BP)
    (MOVE-BP (MARK) BP)
    (MOVE-BP (WINDOW-START-BP *MSG-WINDOW*) BP)
    (SETF (INTERVAL-FIRST-BP *MSG-INTERVAL*) BP))
  (SETF (INTERVAL-LAST-BP *MSG-INTERVAL*) (INTERVAL-LAST-BP *NULL-STARTUP-MSG-INTERVAL*))
  (MUST-REDISPLAY *WINDOW* DIS-ALL)
  (SETQ *ZMAIL-FILE-NAME* "No current mail file"
	*CURRENT-MSG-NAME* NIL
	*CURRENT-MSG-KEYWORDS-STRING* NIL))

(DEFUN RESET-ZMAIL-USER (&AUX (OLD-FRACT *SUMMARY-WINDOW-FRACTION*))
  (RESET-USER-OPTIONS *ZMAIL-USER-OPTION-ALIST*)
  (DOLIST (VAR *ZMAIL-GLOBAL-INITIALIZATION-LIST*)
    (SET (CAR VAR) (CDR VAR)))
  (FUNCALL *ZMAIL-WINDOW* ':FUNCALL-INSIDE-YOURSELF
	   #'(LAMBDA (LIST OLD-FRACT)
	       (SELECT-MAIL-FILE NIL T)
	       (ZMAIL-BACKGROUND-REQUEST-PUSH
		 '(ZMAIL-BACKGROUND-SET-NEW-MAIL-MAIL-FILE NIL))
	       (DOLIST (COM LIST)
		 (UPDATE-COMMAND-WHO-LINE-DOCUMENTATION COM NIL))
	       (FUNCALL *PROFILE-EDITOR* ':RESET-PROFILE)
	       (SET-MAIN-WINDOW-CONFIGURATION *DEFAULT-INITIAL-WINDOW-CONFIGURATION*
					      ( *SUMMARY-WINDOW-FRACTION* OLD-FRACT)))
	   *ZMAIL-WHO-LINE-DOCUMENTATION-SYMBOLS* OLD-FRACT)
  (SETQ *ZMAIL-USER* NIL))

(ADD-INITIALIZATION "RESET-ZMAIL-USER" '(RESET-ZMAIL-USER) '(LOGOUT))

(DEFVAR *ZMAIL-PROFILE-LOADING-LOCK-CELL* ()
  "Lock cell to prevent two loadings of the ZMAIL profile")

(DEFUN SET-ZMAIL-USER (&OPTIONAL SILENT &AUX (OLD-FRACT *SUMMARY-WINDOW-FRACTION*))
  (LET ((LOCK (LOCF *ZMAIL-PROFILE-LOADING-LOCK-CELL*)))
    (UNWIND-PROTECT
      (PROGN (PROCESS-LOCK LOCK)
	     (COND ((NOT (EQUAL *ZMAIL-USER* USER-ID))
		    (WITH-OPEN-FILE (STREAM (ZMAIL-INIT-FILE-PATHNAME)
					    ':ERROR NIL ':CHARACTERS ':DEFAULT)
		      (COND ((NOT (STRINGP STREAM))
			     (IF (NOT SILENT)
				 (TYPEIN-LINE "Loading init file ~A"
					      (FUNCALL STREAM ':TRUENAME)))
			     (FUNCALL (IF (FUNCALL STREAM ':CHARACTERS)
					  #'SI:READFILE-INTERNAL #'SI:FASLOAD-INTERNAL)
				      STREAM "ZWEI" T))))
		    (TURN-ON-USER-MODES)
		    (UPDATE-ALL-COMMANDS-ASSOCIATED-WITH-OPTIONS-DOCUMENTATION)
		    (SET-MAIN-WINDOW-CONFIGURATION *DEFAULT-INITIAL-WINDOW-CONFIGURATION*
						   ( *SUMMARY-WINDOW-FRACTION* OLD-FRACT))
		    (SETQ *ZMAIL-USER* USER-ID))))
      (PROCESS-UNLOCK LOCK))))

(DEFUN UPDATE-ALL-COMMANDS-ASSOCIATED-WITH-OPTIONS-DOCUMENTATION ()
  (DO L *ZMAIL-USER-OPTION-ALIST* (CDR L) (NULL L)
    (DOLIST (COM (GET (CAAR L) 'DOCUMENTATION-ASSOCIATED-COMMANDS))
      (UPDATE-COMMAND-WHO-LINE-DOCUMENTATION COM)))
  (DOLIST (OPT *OPTIONS-NOT-IN-ALIST*)
    (DOLIST (COM (GET OPT 'DOCUMENTATION-ASSOCIATED-COMMANDS))
      (UPDATE-COMMAND-WHO-LINE-DOCUMENTATION COM))))

(DEFVAR *ZMAIL-INIT-FILE-HOST* NIL)

(DEFUN ZMAIL-INIT-FILE-PATHNAME (&OPTIONAL (HOST *ZMAIL-INIT-FILE-HOST*))
  (FS:INIT-FILE-PATHNAME "ZMail" (OR HOST FS:USER-LOGIN-MACHINE)))

;;; This is the main command loop for the program
(DEFMETHOD (ZMAIL-FRAME :COMMAND-LOOP) ()
  (*CATCH (FUNCALL-SELF ':TOP-LEVEL-TAG)
    (DO ((*NUMERIC-ARG-P* NIL NIL)
	 (*NUMERIC-ARG* 1 1)
	 (*ZMAIL-COMMAND-BUTTON* NIL NIL)
	 (*CURRENT-COMMAND* NIL)
	 (*LAST-COMMAND-CHAR*))
	(NIL)
      (*CATCH 'RETURN-TO-COMMAND-LOOP
	(COND ((*CATCH 'TOP-LEVEL
		 (*CATCH 'SYS:COMMAND-LEVEL
		   (*CATCH 'ZWEI-COMMAND-LOOP
		     (PROG ()
			   (FUNCALL-SELF ':REDISPLAY)
			   (TICK)
			GETCHAR
			   (SETQ *LAST-COMMAND-CHAR* (WITHOUT-IO-BUFFER-OUTPUT-FUNCTION
						       (FUNCALL STANDARD-INPUT ':ANY-TYI)))
			   (AND (NULL *LAST-COMMAND-CHAR*)	;EOF
				(*THROW 'EXIT-TOP-LEVEL T))
			   (LET ((DEGREE (IF (LISTP *LAST-COMMAND-CHAR*)
					     (LEXPR-FUNCALL-SELF ':PROCESS-SPECIAL-COMMAND
								 *LAST-COMMAND-CHAR*)
					     (FUNCALL-SELF ':PROCESS-COMMAND-CHAR
							   *LAST-COMMAND-CHAR*))))
			     (AND (EQ DEGREE ':ARGUMENT) (GO GETCHAR))
			     (MUST-REDISPLAY *WINDOW* DEGREE))
			   (CHECK-FOR-TYPEOUT-WINDOW-TYPEOUT)
			NIL))))
	       (FUNCALL *TYPEOUT-WINDOW* ':MAKE-COMPLETE)))))))

;;; Process a top-level ZMAIL command
(DEFMETHOD (ZMAIL-FRAME :PROCESS-COMMAND-CHAR) (CH)
  (SETQ *ZMAIL-COMMAND-BUTTON* ':KBD)
  (ZMAIL-COMMAND-EXECUTE (COMMAND-LOOKUP CH *ZMAIL-COMTAB*)))

(DEFUN ZMAIL-COMMAND-EXECUTE (*CURRENT-COMMAND*)
  (COMMAND-EXECUTE *CURRENT-COMMAND* *LAST-COMMAND-CHAR*))

(DEFMETHOD (ZMAIL-FRAME :TOP-LEVEL-TAG) () 'EXIT-TOP-LEVEL)

(DEFMETHOD (ZMAIL-FRAME :PROCESS-SPECIAL-COMMAND) (&REST ARGS)
  (APPLY #'ZMAIL-COMMAND-LIST ARGS))

(DEFSELECT (ZMAIL-COMMAND-LIST ZMAIL-COMMAND-LIST-DEFAULT)
  (:MENU (ITEM CH WINDOW)			;Request from the main menu
    (SET-COMMAND-BUTTON CH)
    (ZMAIL-COMMAND-EXECUTE (FUNCALL WINDOW ':EXECUTE-NO-SIDE-EFFECTS ITEM)))
  (:MOUSE-BUTTON (&REST IGNORE)
    (FUNCALL STANDARD-INPUT ':UNTYI *LAST-COMMAND-CHAR*)
    (COMMAND-WITH-UNIVERSE-OR-FILTER))
  (SUMMARY-MOUSE (ITEM IGNORE CHAR &AUX (MSG (CADR ITEM)))
    (SET-COMMAND-BUTTON CHAR)			;Clicking on mouse in summary window
    (ZMAIL-SUMMARY-MOUSE MSG))
  (SELECT-WINDOW (WINDOW)			;Moused a window, edit it
    (OR *MSG* (FUNCALL STANDARD-INPUT ':CLEAR-INPUT))	;There is something UNTYI'ed
    (MAKE-WINDOW-CURRENT WINDOW)
    (ZMAIL-COMMAND-EXECUTE 'COM-EDIT-CURRENT-MSG))
  (GET-NEW-MAIL ()				;Clicked on the new mail ***
    (COM-GET-NEW-MAIL))
  (MODE-LINE (COMMAND BUTTON)
    (SET-COMMAND-BUTTON BUTTON)
    (ZMAIL-COMMAND-EXECUTE COMMAND))
  (BACKGROUND (&REST ARGS)
    (APPLY #'ZMAIL-BACKGROUND-REQUEST ARGS)
    DIS-NONE))

;;; Parse message, this is called whenever we first care about a message, it returns a pointer
;;; to the status plist
(DEFUN ASSURE-MSG-PARSED (MSG &AUX PARSED-P STATUS)
  (SETQ PARSED-P (LOCF (MSG-PARSED-P MSG))
	STATUS (LOCF (MSG-STATUS MSG)))
  (LET ((DONE-P NIL))
    (%STORE-CONDITIONAL PARSED-P CURRENT-PROCESS NIL)
    (UNWIND-PROTECT
      (COND ((%STORE-CONDITIONAL PARSED-P NIL CURRENT-PROCESS)
	     (LET ((*INTERVAL* (MSG-REAL-INTERVAL MSG)))
	       (FUNCALL (MSG-MAIL-FILE MSG) ':PARSE-MSG MSG STATUS)
	       (SETQ DONE-P T)))
	    ((EQ (CDR PARSED-P) ':KILLED)
	     (FERROR NIL "Attempt to parse a dead message."))
	    (T
	     (PROCESS-WAIT "Parse" #'(LAMBDA (PARSED-P)
				       (EQ (CDR PARSED-P) T))
			   PARSED-P)))
      (IF (EQ (CDR PARSED-P) SI:CURRENT-PROCESS)
	  (RPLACD PARSED-P DONE-P))))
  STATUS)

(DEFUN SET-PARSED-MSG-HEADERS (MSG &OPTIONAL (STATUS (ASSURE-MSG-PARSED MSG))
				   &AUX (START-BP (MSG-START-BP MSG))
					(END-BP (MSG-END-BP MSG))
					NEWSTAT)
  (CATCH-ERROR
    (UNWIND-PROTECT
      (LET (HEADERS-END-BP)
	(MULTIPLE-VALUE (NEWSTAT HEADERS-END-BP)
	  (PARSE-MSG-HEADERS START-BP END-BP T (GET STATUS 'REFORMATTED)))
	(PUTPROP (LOCF NEWSTAT) HEADERS-END-BP 'HEADERS-END-BP))
      (OR NEWSTAT (SETQ NEWSTAT '(LOSING-HEADERS "Error during parsing"))))
    NIL)
  (SETF (MSG-STATUS MSG) (APPEND (CAR STATUS) NEWSTAT))
  (MSG-PARSE-HOOK MSG STATUS)
  (SET-MSG-SUMMARY-LINE MSG STATUS))

;;; This function exists so that it can be advised
(DEFUN MSG-PARSE-HOOK (MSG STATUS)
  MSG STATUS)

(DEFUN ADD-HEADER-TO-MSG (MSG TYPE PROP &AUX STATUS HEADERS-END-BP LOSE-P STREAM)
  (SETQ STATUS (ASSURE-MSG-PARSED MSG))
  (OR (SETQ HEADERS-END-BP (GET STATUS 'HEADERS-END-BP))
      (BARF "Cannot find end of headers"))
  (COND ((GET STATUS 'ITS-HEADER-P)
	 ;;Need to reformat
	 (AND (SETQ LOSE-P (GET STATUS 'LOSING-HEADERS))
	      (BARF "Cannot parse headers: ~A" LOSE-P))
	 (DELETE-INTERVAL (MSG-START-BP MSG) HEADERS-END-BP)
	 (SETQ STREAM (INTERVAL-STREAM-INTO-BP HEADERS-END-BP))
	 (OUTPUT-HEADER STREAM STATUS '(:DATE :FROM :SENDER :SUBJECT :TO :CC) NIL)
	 (SETQ HEADERS-END-BP (FUNCALL STREAM ':READ-BP))))
  ;; Move back over blank lines
  (DO ((LINE (BP-LINE HEADERS-END-BP) PREV)
       (PREV)
       (BEG-LINE (BP-LINE (MSG-START-BP MSG))))
      ((OR (EQ LINE BEG-LINE)
	   (NOT (LINE-BLANK-P (SETQ PREV (LINE-PREVIOUS LINE)))))
       (SETQ HEADERS-END-BP (CREATE-BP LINE 0))))
  ;; Delete any instances of the old header
  (DO ((LINE (BP-LINE (MSG-START-BP MSG)) (LINE-NEXT LINE))
       (END-LINE (BP-LINE HEADERS-END-BP))
       (START-LINE NIL)
       (TEM))
      (NIL)
    (IF (SETQ TEM (AND (NEQ LINE END-LINE)
		       (LET ((PH (GET (LOCF (LINE-CONTENTS-PLIST LINE)) 'PARSED-HEADERS)))
			 (GET (LOCF PH) TYPE))))
	(OR START-LINE (SETQ START-LINE LINE))
	(COND (START-LINE
	       (DELETE-INTERVAL (CREATE-BP START-LINE 0) (CREATE-BP LINE 0) T)
	       (SETQ START-LINE NIL))))
    (AND (EQ LINE END-LINE) (RETURN)))
  (IF STREAM
      (FUNCALL STREAM ':SET-BP HEADERS-END-BP)
      (SETQ STREAM (INTERVAL-STREAM-INTO-BP HEADERS-END-BP)))
  (PRINT-HEADER STREAM PROP TYPE)
  (SET-PARSED-MSG-HEADERS MSG))

;;; Shuffle the headers around
;;; (SOMEDAY)
(DEFUN REFORMAT-HEADERS (MSG STATUS)
  MSG STATUS
  )

;;; Change a property
(DEFUN MSG-PUT (MSG PROP INDICATOR)
  (PUTPROP (ASSURE-MSG-PARSED MSG) PROP INDICATOR)
  (FUNCALL *SUMMARY-WINDOW* ':NEED-TO-REDISPLAY-MSG MSG)
  (SETF (MSG-TICK MSG) (TICK)))

;;; Background stuff
(DEFMETHOD (ZMAIL-FRAME :AFTER :SELECT) (&OPTIONAL IGNORE)
  (MAYBE-RESET-ZMAIL-BACKGROUND-PROCESS SELF))

(DEFUN MAYBE-RESET-ZMAIL-BACKGROUND-PROCESS (REASON)
  (AND (EQ (PROCESS-WAIT-FUNCTION *ZMAIL-BACKGROUND-PROCESS*) #'FALSE)
       (FUNCALL *ZMAIL-BACKGROUND-PROCESS* ':RESET))
  (FUNCALL *ZMAIL-BACKGROUND-PROCESS* ':RUN-REASON REASON))

;;; Information from the background process
(DEFSELECT ZMAIL-BACKGROUND-REQUEST
  (NEW-MAIL (&REST ARGS)
    (APPLY #'TYPEIN-LINE ARGS))
  (FILE-LOADED (MAIL-FILE)
    (FUNCALL MAIL-FILE ':LOADING-DONE))
  (MSGS-LOADED (MAIL-FILE START END)
    MAIL-FILE START END
    (FUNCALL *SUMMARY-WINDOW* ':NEED-FULL-REDISPLAY T))
  (FILE-SAVED (MAIL-FILE)
    (FUNCALL MAIL-FILE ':SAVING-DONE)))

(DEFVAR *BACKGROUND-MOUSE-SPEED-THRESHOLD* 2.5s0)
(DEFVAR *MAIL-CHECK-PERIOD* 1800.)
(DEFVAR *LAST-MAIL-CHECK-TIME*)
(DEFVAR *BACKGROUND-NEW-MAIL-MAIL-FILE*)

;;; This is the top level of the background process
(LOCAL-DECLARE ((SPECIAL TV:IO-BUFFER))
(DEFUN ZMAIL-BACKGROUND (TV:IO-BUFFER)
  (DO ((*ZMAIL-BACKGROUND-P* T)
       (*BACKGROUND-NEW-MAIL-MAIL-FILE* NIL)
       (*LAST-MAIL-CHECK-TIME* (TIME))
       (LOCK (LOCF (ZMAIL-BACKGROUND-PROCESS-LOCK CURRENT-PROCESS)))
       (COMMAND-BUFFER-POINTER (LOCF (ZMAIL-BACKGROUND-PROCESS-REQUEST-CELL CURRENT-PROCESS)))
       (PRELOAD-QUEUE-POINTER (LOCF (ZMAIL-BACKGROUND-PROCESS-PRELOAD-QUEUE CURRENT-PROCESS)))
       (PRELOAD-FILE))
      (NIL)
    (DO () ((< TV:MOUSE-SPEED *BACKGROUND-MOUSE-SPEED-THRESHOLD*))
      (PROCESS-SLEEP 600.))			;Try not to interfere with mousing commands
    ;; Only run when main window exposed or preload requested
    (AND *HANG-BACKGROUND-PROCESS-WHEN-DEEXPOSED*
	 (NULL PRELOAD-FILE)			;In the middle of preloading
	 (ZMAIL-BACKGROUND-WAIT-FOR-EXPOSURE))
    (UNWIND-PROTECT
      (LET ((CURRENT-REQUEST (CAAR COMMAND-BUFFER-POINTER)))
	(PROCESS-LOCK LOCK)
	(ZMAIL-BACKGROUND-PERFORM CURRENT-REQUEST PRELOAD-FILE)	;Perform one step
	(OR *INHIBIT-BACKGROUND-MAIL-CHECKS*
	    (ZMAIL-BACKGROUND-CHECK-FOR-NEW-MAIL)))
      (PROCESS-UNLOCK LOCK))
    (LET ((CURRENT-STATE (CDR COMMAND-BUFFER-POINTER))
	  (PRELOAD-STATE (CDR PRELOAD-QUEUE-POINTER)))
      (PROCESS-WAIT "Zmail Background"
		    #'ZMAIL-BACKGROUND-PAUSE
		    (TIME) (IF (OR CURRENT-STATE PRELOAD-FILE (CDR PRELOAD-QUEUE-POINTER))
			       60. 1800.)
		    CURRENT-STATE COMMAND-BUFFER-POINTER
		    PRELOAD-STATE PRELOAD-QUEUE-POINTER)))))

(DEFUN ZMAIL-BACKGROUND-PAUSE (START-TIME INTERVAL OLD-CONTENTS POINTER
			       PRELOAD-OLD PRELOAD-POINTER)
  (OR ( (TIME-DIFFERENCE (TIME) START-TIME) INTERVAL)
      (NEQ (CAR POINTER) OLD-CONTENTS)
      (NEQ (CDR PRELOAD-POINTER) PRELOAD-OLD)))


;; Wait for exposure or preload request
(DEFUN ZMAIL-BACKGROUND-WAIT-FOR-EXPOSURE ()
  (DO ((CELL (LOCF (TV:SHEET-EXPOSED-P *ZMAIL-WINDOW*)))
       (PRELOAD-QUEUE-POINTER
	 (LOCF (ZMAIL-BACKGROUND-PROCESS-PRELOAD-QUEUE CURRENT-PROCESS))))
	((OR (CAR CELL) (CDR PRELOAD-QUEUE-POINTER)))
      (PROCESS-WAIT "Expose" #'(LAMBDA (CELL PRELOAD-QUEUE-POINTER)
			       (OR (CAR CELL)
				   (CDR PRELOAD-QUEUE-POINTER)))
		  CELL PRELOAD-QUEUE-POINTER)))

(DEFUN ZMAIL-BACKGROUND-PERFORM (CURRENT-REQUEST PRELOAD-FILE)
  (LET ((COMMAND-BUFFER-POINTER
	  (LOCF (ZMAIL-BACKGROUND-PROCESS-REQUEST-CELL CURRENT-PROCESS)))
	(PRELOAD-QUEUE-POINTER
	  (LOCF (ZMAIL-BACKGROUND-PROCESS-PRELOAD-QUEUE CURRENT-PROCESS)))
	(PRELOAD-FILENAME))
	  (COND (CURRENT-REQUEST
		 (AND (FUNCALL (CAR CURRENT-REQUEST) CURRENT-REQUEST)	   
		      (WITHOUT-INTERRUPTS
			(SETF (CAR COMMAND-BUFFER-POINTER)
			      (DELQ CURRENT-REQUEST (CAR COMMAND-BUFFER-POINTER))))))
		(PRELOAD-FILE (AND (NOT (FUNCALL PRELOAD-FILE ':READ-NEXT-MSG 5))
				   (SETQ PRELOAD-FILE NIL)))
		((SETQ PRELOAD-FILENAME
		       (ZMAIL-BACKGROUND-PRELOAD-POP PRELOAD-QUEUE-POINTER))
		 (IF (LISTP PRELOAD-FILENAME)
		     (APPLY #'ZMAIL-PRELOAD-PERFORM PRELOAD-FILENAME)
		     (*CATCH 'PRELOAD-ERROR
		       (SETQ PRELOAD-FILE (BACKGROUND-OPEN-ZMAIL-FILE PRELOAD-FILENAME))))))))

(DEFSELECT ZMAIL-PRELOAD-PERFORM
  (:SET-ZMAIL-USER ()
    (FUNCALL *ZMAIL-WINDOW* ':SET-ZMAIL-USER T)))	;Be sure we're logged in


(DEFUN ZMAIL-BACKGROUND-CHECK-FOR-NEW-MAIL ()
  (COND (( (TIME-DIFFERENCE (TIME) *LAST-MAIL-CHECK-TIME*)
	    *MAIL-CHECK-PERIOD*)
	 (AND *BACKGROUND-NEW-MAIL-MAIL-FILE*
	      (FUNCALL *BACKGROUND-NEW-MAIL-MAIL-FILE* ':BACKGROUND-CHECK-FOR-NEW-MAIL))
	 (SETQ *LAST-MAIL-CHECK-TIME* (TIME)))))

(DEFUN ZMAIL-BACKGROUND-LOAD-FILE (REQUEST &AUX (MAIL-FILE (SECOND REQUEST))
						(START (MAIL-FILE-NMSGS MAIL-FILE)))
  (PROG1 (NOT (FUNCALL MAIL-FILE ':READ-NEXT-MSG 5))
	 (ZMAIL-BACKGROUND-RESPONSE-PUSH
	   `(MSGS-LOADED ,MAIL-FILE ,START ,(MAIL-FILE-NMSGS MAIL-FILE)))))

(DEFUN ZMAIL-BACKGROUND-SAVE-FILE (REQUEST &AUX (MAIL-FILE (SECOND REQUEST)))
  (LOCK-MAIL-FILE (MAIL-FILE)
    (AND ;; Prevent timing problems
         (MEMQ REQUEST (ZMAIL-BACKGROUND-PROCESS-REQUEST-CELL CURRENT-PROCESS))
	 (DO ((I 0 (1+ I))
	      (INTERVAL-STREAM (THIRD REQUEST))
	      (FILE-STREAM (DISK-MAIL-FILE-STREAM MAIL-FILE))
	      (LINE)
	      (EOF))
	     (( I 50.) NIL)
	   (MULTIPLE-VALUE (LINE EOF)
	     (FUNCALL INTERVAL-STREAM ':LINE-IN))
	   (IF (NOT EOF)
	       (FUNCALL FILE-STREAM ':LINE-OUT LINE)
	       (FUNCALL FILE-STREAM ':STRING-OUT LINE)
	       (FUNCALL MAIL-FILE ':SAVING-DONE)
	       (RETURN T))))))

(DEFUN ZMAIL-BACKGROUND-SET-NEW-MAIL-MAIL-FILE (REQUEST)
  (SETQ *BACKGROUND-NEW-MAIL-MAIL-FILE* (SECOND REQUEST))
  (SETQ *LAST-MAIL-CHECK-TIME* (TIME-DIFFERENCE (TIME) (1+ *MAIL-CHECK-PERIOD*)))
  T)

(DEFUN ZMAIL-BACKGROUND-PARSE-MSGS (REQUEST &AUX (MAIL-FILE (SECOND REQUEST))
						 (START (THIRD REQUEST))
						 (ARRAY (MAIL-FILE-ARRAY MAIL-FILE)))
  (LOCK-MAIL-FILE (MAIL-FILE)
    (DO ((INDEX START (1+ INDEX))
	 (MAX (ARRAY-ACTIVE-LENGTH ARRAY))
	 (COUNT 0)
	 MSG)
	((OR ( INDEX MAX) ( COUNT 5))
	 (COND (( INDEX MAX)
		T)
	       (T
		(SETF (THIRD REQUEST) INDEX)
		NIL)))
      (SETQ MSG (AREF ARRAY INDEX))
      (COND ((NULL (MSG-PARSED-P MSG))
	     (ASSURE-MSG-PARSED MSG)
	     (INCF COUNT))))))

;; Add things to the request queue as a background request.
;; This can be used to request things be preloaded, but not until
;; the ZMAIL window is selected.

(DEFUN ZMAIL-BACKGROUND-PRELOAD-FILES (REQUEST)
  (LET ((QUEUE (LOCF (ZMAIL-BACKGROUND-PROCESS-PRELOAD-QUEUE CURRENT-PROCESS))))
    (WITHOUT-INTERRUPTS
      (SETF (CDR QUEUE)
	    (APPEND (CDR QUEUE)
		    (CDR REQUEST)
		    NIL)))))			;Copy the request list

(DEFUN LOCK-BACKGROUND-PROCESS ()
  (COND ((NEQ CURRENT-PROCESS (CAR *ZMAIL-BACKGROUND-PROCESS-LOCK*))
	 (PROCESS-LOCK *ZMAIL-BACKGROUND-PROCESS-LOCK*)
	 ;; There may be some junk from it in the io-buffer already
	 (LOCAL-DECLARE ((SPECIAL TV:IO-BUFFER))
	   (TV:PROCESS-TYPEAHEAD TV:IO-BUFFER #'(LAMBDA (CH)
						  (IF (NOT (AND (LISTP CH)
								(EQ (CAR CH) 'BACKGROUND)))
						      CH
						      (APPLY #'ZMAIL-BACKGROUND-REQUEST
							     (CDR CH))
						      NIL))))
	 T)))


;;; Setup for loading a mail file from stream, does not actually read any messages.
;;; Notifies if error, throwing to PRELOAD-ERROR, otherwise returning a newly consed
;;; mail file, or a mail file already associated with this file.
(DEFUN BACKGROUND-OPEN-ZMAIL-FILE (PATHNAME)
  (SETQ PATHNAME
	(FS:MERGE-PATHNAME-DEFAULTS PATHNAME *ZMAIL-PATHNAME-DEFAULTS*))
  (LET ((STREAM (OPEN PATHNAME '(:IN :NOERROR)))
	INFO MAIL-FILE)
    (COND ((STRINGP STREAM)
	   (TV:CAREFUL-NOTIFY NIL T "Could not pre-load ZMAIL file ~A:  ~A"
			      (FUNCALL PATHNAME ':STRING-FOR-PRINTING) STREAM)
	   (*THROW 'PRELOAD-ERROR ())))
    (SETQ INFO (FUNCALL STREAM ':INFO))
    (SETQ MAIL-FILE (FUNCALL *ZMAIL-WINDOW* ':GET-MAIL-FILE-FROM-PATHNAME PATHNAME))
    (COND (MAIL-FILE
	   (CLOSE STREAM)
	   (COND ((NOT (EQUAL INFO (DISK-MAIL-FILE-ID MAIL-FILE)))
		  (TV:CAREFUL-NOTIFY NIL T "ZMAIL File ~A has changed, you will lose"
				     PATHNAME)
		  (*THROW 'PRELOAD-ERROR ()))
		 (T MAIL-FILE)))
	  (T (MULTIPLE-VALUE-BIND (FLAVOR APPEND-P)
		 (FUNCALL PATHNAME ':MAIL-FILE-FORMAT-COMPUTER STREAM)
	       (FUNCALL *ZMAIL-WINDOW* ':MAKE-MAIL-FILE FLAVOR
			':PATHNAME PATHNAME ':STREAM STREAM ':ID INFO
			':APPEND-P APPEND-P))))))

(DEFUN ZMAIL-BACKGROUND-PRELOAD-POP (POINTER)
  (PROG1 (CADR POINTER)
	 (SETF (CDR POINTER)
	       (CDDR POINTER))))

(DEFMETHOD (BASIC-ZMAIL :BACKGROUND-PRELOAD) (FILES)
  (LET ((POINTER (LOCF (ZMAIL-BACKGROUND-PROCESS-PRELOAD-QUEUE *ZMAIL-BACKGROUND-PROCESS*))))
    (WITHOUT-INTERRUPTS
      (SETF (CDR POINTER)
	    (APPEND (CDR POINTER) FILES NIL)))))

(DEFMETHOD (BASIC-ZMAIL :AFTER :BACKGROUND-PRELOAD) (&OPTIONAL IGNORE)
  (MAYBE-RESET-ZMAIL-BACKGROUND-PROCESS CURRENT-PROCESS))

(DEFMETHOD (BASIC-ZMAIL :SET-ZMAIL-USER) (&OPTIONAL SILENT)
  (SET-ZMAIL-USER SILENT))

(DEFMETHOD (BASIC-ZMAIL :GET-MAIL-FILE-FROM-PATHNAME) (PATHNAME &OPTIONAL CREATE-P)
  (GET-MAIL-FILE-FROM-PATHNAME PATHNAME CREATE-P))

(DEFMETHOD (BASIC-ZMAIL :MAKE-MAIL-FILE) (TYPE &REST OPTIONS)
  (LEXPR-FUNCALL #'MAKE-MAIL-FILE TYPE OPTIONS))

(DEFUN PRELOAD-ZMAIL (&REST FILES)
  (FUNCALL *ZMAIL-WINDOW* ':BACKGROUND-PRELOAD `((:SET-ZMAIL-USER) . ,FILES)))