;;; -*- Mode:Common-Lisp; Package:USER; 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.

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

;;; The package in which all of the imap client code resides.
(eval-when (compile load eval)
  (Defpackage Yes-Way
    (:Use TICL Lisp)
    (:Nicknames "YW")
    (:import clos:slot-value
	     clos:call-next-method
	     clos:symbol-macrolet
    )
  )
)

(eval-when (compile load eval)
  (Defpackage YW-ZWEI
    (:Shadowing-Import zwei:search)
    (:Use ZWEI TICL Lisp)
    (:Import 
	     zwei:*font*
	     zwei:*interval*
	     zwei:*last-command-char*
	     zwei:*numeric-arg*
	     zwei:*numeric-arg-p*
	     zwei:*standard-comtab*
	     zwei:*window*
	     zwei:bp-index
	     zwei:bp-line
	     zwei:bp-node
	     zwei:com-beginning-of-line
	     zwei:com-delete-forward
	     zwei:com-forward
	     zwei:com-kill-region
	     zwei:com-self-insert
	     zwei:com-untabify
	     zwei:completing-read-from-mini-buffer
	     zwei:create-bp
	     zwei:defcom
	     zwei:defun-interval
	     zwei:fill-interval
	     zwei:make-command-alist
	     zwei:move-bp
	     zwei:region-lines
	     zwei:set-comtab
	     zwei:section-node-name
	     zwei:*mark-stays*
	     zwei:beg-line
	     zwei:forward-over
	     zwei:define-mail-template-1
	     zwei:discard-undo-information
	     zwei:dis-text
	     zwei:preserve-buffer-point
	     zwei:with-read-only-suppressed
	     zwei:not-modified
	     zwei:make-buffer-current
	     zwei:interval-stream-into-bp
	     zwei:set-buffer-fonts
	     zwei:buffer-file-read-tick
	     zwei:*batch-undo-save*
	     zwei:*completing-alist*
	     zwei:*completing-impossible-is-ok-p*
	     zwei:*completing-reader-comtab*
	     zwei:*forwarded-message-begin*
	     zwei:*forwarded-message-end*
	     zwei:*mail-mode-hook*
	     zwei:*mail-template-header-body-goal-column*
	     zwei:*mode-comtab*
	     zwei:*mode-line-list*
	     zwei:*mode-line-window*
	     zwei:*msg*
	     zwei:*reformat-headers-body-goal-column*
	     zwei:*sent-message-list*
	     zwei:*tick*
	     zwei:*unsent-message-list*
	     zwei:assure-message-parsed
	     zwei:bp-char
	     zwei:buffer-major-mode
	     zwei:buffer-modified-p
	     zwei:buffer-subsequences
	     zwei:buffer-version-string
	     zwei:collect-message-addresses
	     zwei:com-backward
	     zwei:com-down-real-line
	     zwei:com-goto-end
	     zwei:com-mail-mode-exit
	     zwei:com-one-window
	     zwei:com-rubout
	     zwei:com-send-mail
	     zwei:com-up-real-line
	     zwei:count-lines-buffer
	     zwei:defminor
	     zwei:delete-interval
	     zwei:dired-mode
	     zwei:document-key
	     zwei:edit-in-mini-buffer
	     zwei:eval-undo-list
	     zwei:find-length-of-mode-line
	     zwei:find-maximum-buffer-name-length
	     zwei:forward-char
	     zwei:get-mail-template-function
	     zwei:get-message-header
	     zwei:hide-mail-buffer
	     zwei:history-list
	     zwei:initialize-buffer-package
	     zwei:insert-address-list
	     zwei:insert-default-header-fields
	     zwei:insert-header-field
	     zwei:insert-in-reply-to-field
	     zwei:insert-interval-moving
	     zwei:insert-moving
	     zwei:kill-buffer
	     zwei:mail-file-buffer-p
	     zwei:mail-mode
	     zwei:make-buffer-not-read-only
	     zwei:make-buffer-read-only
	     zwei:mode
	     zwei:mode-line-list
	     zwei:name-for-display
	     zwei:node-read-only-p
	     zwei:previous-buffer
	     zwei:print-doc
	     zwei:print-formatted-message
	     zwei:read-defaulted-pathname
	     zwei:read-message
	     zwei:redisplay
	     zwei:sent-messages
	     zwei:set-mode-line-list
	     zwei:switch-windows
	     zwei:total-messages
	     zwei:turn-on-mode
	     zwei:unsent-messages
	     zwei:window-n-plines
	     zwei:zmacs-buffer
    )
  )
)

;;; Do these imports so that sectionising works ok in zwei and tv.
(eval-when (compile load eval)
  (import (list (read-from-string "yw:defadvise")) 'zwei)
)

(eval-when (compile load eval)
  (import (list (read-from-string "yw:defadvise")) 'yw-zwei)
)


(eval-when (compile load eval)
  (import (list (read-from-string "yw:defadvise")) 'tv)
)


;;; Make sure that the profile stuff works ok in YW.
(eval-when (compile load eval)
  (import 'profile:defprofile 'Yw)
  (import 'profile:defprofile-class 'Yw)
)


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

;;; This is the package used for the definition of variables read from 
;;; .mminit files of primary mail servers.  If you have an entry such as
;;; "define foo bar" then a variable called YW-Variables::foo will have
;;; the value '(YW-Variables::bar).
(eval-when (compile load eval)
  (Defpackage YW-Variables)  ;;; Use nothing.  Just for vars.
)



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



(defun yw:coerce-to-host (host)
"Coerces HOST into a physical host object."
  (etypecase host
    (net:host
     (if (send host :Host-Translation)
	 (yw:coerce-to-host (send host :Host-Translation))
	 host
     )
    )
    (null nil)
    (string (yw:coerce-to-host (net:parse-host host t)))
  )
)

(defun yw:loading-yw-p ()
"Is true if we are loading YW as opposed to New-YW."
  (equal (yw:coerce-to-host "Yes-Way")
	 (yw:Coerce-To-Host
	   (send (first (zwei:source-file-names 'user:yes-way)) :Host)
	 )
  )
)


(defun yw:loading-new-yw-p ()
"Is true if we are loading New-YW as opposed to YW."
  (equal (yw:coerce-to-host "New-Yes-Way")
	 (yw:Coerce-To-Host
	   (send (first (zwei:source-file-names 'user:yes-way)) :Host)
	 )
  )
)

(defun yw:processor-type ()
  "Returns the processor type we are on."
  (sys:processor-type)
)

(defun yw:for-processor-type (explorer-1-value explorer-2-value mx-value)
"Returns one of its arg values dependig on what machine we are running on.
This is useful for inits that are likely to depend on processor speed, such
as message preemptions.
"
  (case (yw:processor-type)
    (:MicroExplorer mx-value)
    (:Explorer-Ii explorer-2-value)
    (otherwise explorer-1-value)
  )
)

(defvar yw:*all-reset-vars* nil
"A list of all of the reset vars.  A reset var is a var that YW resets
on start-up and shutdown.
"
)

(defmacro yw:defreset-var (name default doc-string)
"Defines a reset-var called NAME with default value default.
A reset var is a var that YW resets on start-up and shutdown.
"
 `(progn (pushnew (list ',name ',default) yw:*all-reset-vars* :Test #'equalp)
	 (defvar ,name ,default ,doc-string)
  )
)