;;; -*- Mode:Common-Lisp; Package:Yes-Way; Base:10 -*-

;;; **********************************************************************
;;; Copyright (c) 1990 Stanford University.
;;; This code was written by James Rice.
;;; Copyright is held by Stanford University except where code has been
;;; modified from TI source code.  In these cases TI code is marked with
;;; a suitable comment.

;;; All Stanford Copyright code is in the public domain.  This code may be
;;; distributed and used without restriction as long as this copyright
;;; notice is included and no fee is charged.  This can be thought of as
;;; being equivalent to the Free Software Foundation's Copyleft policy.

;;; TI source code may only be distributed to users who hold valid TI
;;; software licenses.

;;; The development of this software was assisted by the following grants:
;;; Biomedical Research Technology Program of the National Institutes
;;; of Health under grant RR-00785
;;; Information Systems Technologies office of the Defense Advanced
;;; Research Projects Agency under contract N00039-86-C0033.

;;; **********************************************************************

(defvar *top-level-mouse-blip-methods*
  (list (Make-Top-Level-Blip
	  :Mouse-Char #\mouse-l-1
	  :Starter-Method :Read-Type-Command-With-Selection
	  :Task-Daemon-Method :Read-Sequence
	  :Doc-String "Read/Select relevant field from message"
	  :Mouse-Key :mouse-l-1
	  :Applicable-If
	    #'(lambda (mcw &rest ignore)
		(not (symeval-in-stack-group
		       '*reading-a-sequence*
		       (send (send mcw :Process) :Stack-Group)
		     )
		)
	      )
	)
	(Make-Top-Level-Blip
	  :Mouse-Char #\mouse-l-2
	  :Starter-Method :Mouse-L-2-Click
	  :Task-Daemon-Method nil
	  :Doc-String "Use as prefix argument"
	  :Mouse-Key :mouse-l-2
	)
	(Make-Top-Level-Blip
	  :Mouse-Char #\mouse-m-1
	  :Starter-Method :Read-Type-Command-With-Selection
	  :Task-Daemon-Method :Reply-To-Sequence
	  :Doc-String "Reply to this message"
	  :Mouse-Key :mouse-m-1
	)
	(Make-Top-Level-Blip
	  :Mouse-Char #\mouse-m-2
	  :Starter-Method :Copy-from-address-to-kill-ring
	  :Task-Daemon-Method nil
	  :Doc-String "Copy \"From Address\" to kill ring"
	  :Mouse-Key :mouse-m-2
	)
	(Make-Top-Level-Blip
	  :Mouse-Char #\mouse-r-1
	  :Starter-Method :Menu-of-top-level-operations
	  :Task-Daemon-Method nil
	  :Doc-String "Menu of operations"
	  :Mouse-Key :mouse-r-1
	)
	(Make-Top-Level-Blip
	  :Mouse-Char #\mouse-l-1
	  :Starter-Method :mouse-l-hold
	  :Task-Daemon-Method nil
	  :Doc-String "Drag Selection"
	  :Mouse-Key :Mouse-L-Hold
	  :Undo-Method :unselect-prefix-argument
	  :Applicable-If
	    #'(lambda (&rest ignore) *mouse-l-hold-drag-selection-enabled*)
	)
  )
"A list of mouse blip structs that specify the actions for different mouse
gestures on messages in headers windows.
"
)

(defvar *background-mouse-blip-methods*
  (list (make-background-blip
	  :Mouse-Char #\mouse-l
	  :Method :Select-me
	  :Doc-String "Select this mailbox/sequence"
	  :Mouse-Key :Mouse-L-1
	)
	(make-background-blip
	  :Mouse-Char #\mouse-l-2
	  :Method :Read-me
	  :Doc-String "Read this sequence"
	  :Mouse-Key :Mouse-L-2
;;; Removed because Gruber thinks that this is reasonable.
;;; I don't care one way or another.
;	  :Applicable-If
;	    #'(lambda (ignore summary-window) (send summary-window :Filter))
	)
	(make-background-blip
	  :Mouse-Char #\mouse-m
	  :Method :Forget-Me
	  :Doc-String "Kill this window"
	  :Mouse-Key :Mouse-M-1
	)
	(make-background-blip
	  :Mouse-Char #\mouse-r-1
	  :Method :Right-Button-Menu
	  :Doc-String "Menu of operations"
	  :Mouse-Key :Mouse-r-1
	)
  )
"The blip method list for the background of summary windows and for the items
in the mailbox selector.
"
)


(defvar *mailbox-selector-background-mouse-blip-methods* nil
"A list of background blip structures to specify what to do when we click on
 the background in the mailbox selector."
)


(defvar *selected-message-display-stipple-alist*
  (list (make-message-highlight-spec
	  :Name :Prefix-Arg
	  :Stipple tv:75%-gray
	  :End '(:chars 1)
	)
	(make-message-highlight-spec
	  :Name :I-Search
	  :Stipple tv:75%-gray
	  :End '(:chars 4)
	)
	(make-message-highlight-spec
	  :name :Read
	  :Stipple tv:100%-black
        )
	(make-message-highlight-spec
	  :name :otherwise
	  :Stipple tv:100%-black
        )
  )
"A list of the different message highlighting specifications."
)


(defvar *Right-Button-Options-Menu* (make-yw-right-button-menu)
"The menu that you get when you right button on a message."
)

(defvar *address-database-lock* (make-an-imap-lock)
"The lock to make sure that we only read/write it one at a time."
)

(defvar *rule-base-lock* (make-an-imap-lock)
"The lock to make sure that we only read/write it one at a time."
)

(defvar *global-imap-lock* (make-an-imap-lock)
"A global lock for IMAP things."
)

;-------------------------------------------------------------------------------

;;; This goes right at the end so that all of the mailer has been loaded when
;;; the daemons start up.

(defvar *yw-daemon*      (make-instance 'Yw-daemon)
"The daemon that does mailbox checks and such."
)

(defvar *edit-server*    (make-instance 'task-server)
"The server process that serialises requests from ZMacs and from the mailer
window.
"
)

(defvar *Address-Server* (Make-instance 'task-server)
"The process that parses addresses and headers, maintining the
address database.
"
)
;;; Set the address process nice and low.
(let ((process (send *Address-Server* :Process)))
     (send process :Set-Priority -2)
     (setf (get process :Initial-Priority) (send process :Priority))
)

(defvar *rule-processor* (Make-instance 'rule-processor)
"The process for the rule system."
)
;;; Set the rule system's priority really low.
(let ((process (send *rule-processor* :Process)))
     (send process :Set-Priority -4)
     (setf (get process :Initial-Priority) (send process :Priority))
)

(defun fully-unarrest-daemons ()
  (loop for daemon in *all-daemons*
	for process = (send daemon :Process)
	for arrest-reasons = (si:process-arrest-reasons process)
	do (loop for reason in arrest-reasons
		 do (send process :Revoke-Arrest-Reason reason)
	   )
  )
)

(Defun reset-daemon-processes ()
"Resets all of the daemon processes."
  (loop for daemon in *all-daemons* do
	(send daemon :Send-If-Handles :Set-Task-Stream nil)
  )
  (Fully-Unarrest-Daemons)
  (loop for daemon in *all-daemons*
	do (Tv:process-reset-and-enable (send daemon :Process))
  )
)

;;; Reset the processes now that we have created them.
(reset-daemon-processes)