(FILECREATED "15-Dec-86 10:01:06" {INDIGO}<GSLWS>BASICS>MAILSHARE.;3
 11423  

      changes to:  (FNS MASH.MakeIconWindow)

      previous date: "12-Dec-86 18:54:12" {INDIGO}<GSLWS>BASICS>MAILSHARE.;2)


(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT MAILSHARECOMS)

(RPAQQ MAILSHARECOMS
 ((* Menu Functions)
			(FNS MASH.TopLevel MASH.CreateFreeMenu MASH.GetMail MASH.Quit MASH.Consistent 
			     MASH.MakeDirectoryName MASH.MakeProfileName MASH.MakeIconWindow)
			(* Icon bitmaps)
			(BITMAPS MASH.Icon MASH.IconMask)
			(* VARS)
			(INITVARS (MASH.VALID-HOSTS (QUOTE (IVY INDIGO PHYLUM ERIS QV CHERRY))))
			(GLOBALVARS MASH.VALID-HOSTS)
			(ADDVARS (BackgroundMenuCommands (Mail% Share (QUOTE (MASH.TopLevel))
								      "Start the Mail Share menu")))
			(VARS (BackgroundMenu NIL))))



(* Menu Functions)


(DEFINEQ

(MASH.TopLevel

  (LAMBDA NIL                                                (* DSB " 5-Nov-86 09:55")

                                                             (* Start the Mail Share Process)

    (
PROG
 (menuWindow)
	    (
SETQ
 menuWindow (MASH.CreateFreeMenu
))

          (* * initialize to GV)



	    (
FM.CHANGESTATE
 (
FM.ITEMFROMID
 menuWindow (
QUOTE
 NETMODE))
			      menuWindow)

          (* * set up menu window)



	    (
WINDOWPROP
 menuWindow (
QUOTE
 ICONFN)
			  (
FUNCTION
 MASH.MakeIconWindow))
	    (
SHAPEW
 menuWindow (
QUOTE
 (200 200 275 82)))
	    (
SHAPEW
 (
GETPROMPTWINDOW
 menuWindow)
		      (
QUOTE
 (200 282 275 35))))))

(MASH.CreateFreeMenu

  (LAMBDA (LEFT BOTTOM)                                      (* DSB " 5-Nov-86 09:37")

                                                             (* returns a free menu window at specified position)

    (
FM.FORMATMENU
 (
BQUOTE
 (((TYPE TITLE LABEL Commands: FONT (MODERN 12 BOLD))
				 (LABEL GetMail SELECTEDFN MASH.GetMail)
				 (LABEL Quit SELECTEDFN MASH.Quit))
				((TYPE EDITSTART LABEL Name: FONT (MODERN 12 BOLD)
				       ITEMS
				       (NAME))
				 (TYPE EDIT ID NAME LABEL ""))
				((TYPE EDITSTART LABEL Mail% Directory: FONT (MODERN 12 BOLD)
				       ITEMS
				       (
DIRECTORY
))
				 (TYPE EDIT ID DIRECTORY LABEL ""))
				((TYPE TITLE LABEL NetworkMode: FONT (MODERN 12 BOLD))
				 (TYPE NWAY ID NETMODE LABEL GV)
				 (TYPE NWAY ID NETMODE LABEL NS))
				(WINDOWPROPS TITLE "Mail Share" LEFT , LEFT BOTTOM , BOTTOM))))))

(MASH.GetMail

  (LAMBDA (ITEM WINDOW BUTTONS)                              (* DSB " 5-Nov-86 10:05")

                                                             (* Gets the mail)

    (
PROG
 ((state (
FM.READSTATE
 WINDOW))
	     (promptW (
GETPROMPTWINDOW
 WINDOW))
	     name mailDirectory networkMode consistent mailProfile (locatedDirectory NIL))
	    (
CLEARW
 promptW)

          (* * check that name is specified)



	    (
SETQ
 name (
U-CASE
 (
LISTGET
 state (
QUOTE
 NAME))))
	    (
COND

	      ((
EQUAL
 name "")
		(
PRIN1
 "Enter your name" promptW)
		(
RETURN
)))

          (* * check if mail directory is both entered and consistent)




          (* * If consistent, check if the mail directory is legitimate; otherwise, use mail directory host list)



	    (
SETQ
 mailDirectory (
U-CASE
 (
LISTGET
 state (
QUOTE
 DIRECTORY))))
	    (
COND

	      ((
NOT
 (
EQUAL
 mailDirectory ""))
		(
COND

		  ((
NOT
 (
UNPACKFILENAME
 mailDirectory (
QUOTE
 HOST)))
		    (
RETURN
 (
PRIN1
 "Include file server name (e.g., {ivy})" promptW))))
		(
SETQ
 consistent (MASH.Consistent
 name mailDirectory))
		(
COND

		  ((
EQ
 consistent (
QUOTE
 ERROR))
		    (
CLEARW
 promptW)
		    (
PRIN1
 "Badly formed directory name" promptW)
		    (
RETURN
)))
		(
COND

		  (consistent (
SETQ
 mailProfile (MASH.MakeProfileName
 mailDirectory))
			      (
COND

				((
INFILEP
 mailProfile)
				  (
SETQ
 locatedDirectory T))
				(T (
PRIN1
 "Can't find that mail directory.  Searching..." promptW)))
			      ))))

          (* * look for default mail directory using mail directory host list)



	    (for
 host in
 MASH.VALID-HOSTS while
 (
NOT
 locatedDirectory)
	       do
 (
SETQ
 mailDirectory (MASH.MakeDirectoryName
 host name))
		    (
SETQ
 mailProfile (MASH.MakeProfileName
 mailDirectory))
		    (
COND

		      ((
INFILEP
 mailProfile)
			(
SETQ
 locatedDirectory T))))

          (* * if unable to find valid mail directory, return)



	    (
COND

	      ((
NOT
 locatedDirectory)
		(
CLEARW
 promptW)
		(
PRIN1
 "Please enter correct default mail directory name" promptW)
		(
PRIN1
 "e.g., {IVY}<your-name>MAIL>" promptW)
		(
RETURN
)))

          (* * profile exists, so do it!)



	    (
CLEARW
 promptW)
	    (
FM.CHANGELABEL
 (
FM.ITEMFROMID
 WINDOW (
QUOTE
 DIRECTORY))
			      WINDOW mailDirectory)
	    (
PRIN1
 "Quitting previous Lafite..." promptW)
	    (
LAFITE
 (
QUOTE
 OFF))
	    (
PRIN1
 "Done" promptW)
	    (
TERPRI
 promptW)
	    (
LOGIN
)
	    (
COND

	      ((
NOT
 (
EQ
 USERNAME (
MKATOM
 name)))
		(
RETURN
 (
PRIN1
 "Mail and Login names inconsistent" promptW))))
	    (
CLEARW
 promptW)
	    (
PRIN1
 "Mail is coming..." promptW)
	    (
SETQ
 networkMode (
U-CASE
 (
LISTGET
 state (
QUOTE
 NETMODE))))
	    (
COND

	      ((
EQ
 networkMode (
QUOTE
 GV))
		(
LAFITEMODE
 (
QUOTE
 GV)))
	      (T (
LAFITEMODE
 (
QUOTE
 NS))))
	    (
SETQ
 LAFITEDEFAULTHOST&DIR mailDirectory)
	    (
LAFITE
 (
QUOTE
 ON)))))

(MASH.Quit

  (LAMBDA (ITEM WINDOW BUTTONS)                              (* DSB " 5-Nov-86 10:11")


          (* * Quits LAFITE, clears menu, etc.)



    (
PROG
 ((promptW (
GETPROMPTWINDOW
 WINDOW)))
	    (
CLEARW
 promptW)
	    (
PRIN1
 "Quitting Lafite..." promptW)
	    (
FM.CHANGELABEL
 (
FM.ITEMFROMID
 WINDOW (
QUOTE
 NAME))
			      WINDOW "")
	    (
FM.CHANGELABEL
 (
FM.ITEMFROMID
 WINDOW (
QUOTE
 DIRECTORY))
			      WINDOW "")
	    (
LAFITE
 (
QUOTE
 OFF))
	    (
SETQ
 LAFITEDEFAULTHOST&DIR NIL)
	    (
LAFITEMODE
 (
QUOTE
 GV))
	    (
FM.CHANGESTATE
 (
FM.ITEMFROMID
 WINDOW (
QUOTE
 NETMODE))
			      WINDOW)
	    (
PRIN1
 "Done" promptW))))

(MASH.Consistent

  (LAMBDA (name mailDirectory)                               (* DSB " 4-Nov-86 09:21")


          (* * returns T if name is the root directory of mailDirectory)



    (
PROG
 ((nameString (
MKSTRING
 name))
	     (mailDirectoryString (
MKSTRING
 mailDirectory))
	     startPosition length before after)
	    (
SETQ
 startPosition (
STRPOS
 nameString mailDirectoryString))
	    (
COND

	      ((
NOT
 startPosition)
		(
RETURN
 NIL)))
	    (
SETQ
 length (
NCHARS
 nameString))
	    (
SETQ
 before (
STRPOS
 "<" mailDirectoryString))
	    (
SETQ
 after (
STRPOS
 ">" mailDirectoryString))
	    (
COND

	      ((
AND
 (
NUMBERP
 before)
		      (
NUMBERP
 after))
		(
RETURN
 (
EQP
 length (
DIFFERENCE
 (
DIFFERENCE
 after before)
						      1))))
	      (T (
RETURN
 (
QUOTE
 ERROR)))))))

(MASH.MakeDirectoryName

  (LAMBDA (host userName)                                    (* DSB " 2-Nov-86 15:43")

    (
PROG
 (directoryName)
	    (
SETQ
 directoryName (
CONCAT
 userName ">MAIL>"))
	    (
RETURN
 (
PACKFILENAME
 (
QUOTE
 HOST)
				      host
				      (
QUOTE
 DIRECTORY)
				      directoryName)))))

(MASH.MakeProfileName

  (LAMBDA (directory)                                        (* DSB " 2-Nov-86 15:37")


          (* * returns the Lafite.Profile name)



    (
PROG
 (profileName)
	    (
SETQ
 profileName (
PACKFILENAME
 (
QUOTE
 DIRECTORY)
						directory
						(
QUOTE
 NAME)
						(
QUOTE
 LAFITE)
						(
QUOTE
 EXTENSION)
						(
QUOTE
 PROFILE)))
	    (
RETURN
 profileName))))

(MASH.MakeIconWindow

  (LAMBDA (WINDOW OLDICON)                                   (* DSB "15-Dec-86 09:58")


          (* * Creates a window with an icon formed by two bit maps.)



    (
OR
 OLDICON (
ICONW
 MASH.Icon MASH.IconMask))))
)



(* Icon bitmaps)



(RPAQ MASH.Icon (READBITMAP))
(90 50
"@@@@@@@@@@@@@@@@@@@@@@@@"
"COOOOOOOOOOOOOOOOOOOO@@@"
"COOOOOOOOOOOOOOOOOOOO@@@"
"COOOOOOOOOOOOOOOOOOOO@@@"
"CH@@@@@@@@@@@@@@@@@@G@@@"
"CH@@@@@@@@@@@@@@@@@@G@@@"
"CH@@@@@@@@@@@@@@@@@@G@@@"
"CH@@@@@@@@@@@@@@@@@@G@@@"
"CH@@@@@@@@@@@@@@@@@@G@@@"
"CH@@@@@@@@@@@@@@@@@@G@@@"
"CH@@@@@@@@@@@@@@@@@@G@@@"
"CH@@GON@@@@@@@@OOH@@G@@@"
"CH@@GON@@@@@@@@OOH@@G@@@"
"CHAOOOOOOOOOOOOOOOL@G@@@"
"CHA@@@@@@@@@@@@@@@D@G@@@"
"CHA@@@@@@@@@@@@@@@D@G@@@"
"CHA@@@@@@@@@@@@@@@D@G@@@"
"CHA@@@LAH@O@A@H@@@D@G@@@"
"CHA@@@OGH@I@A@H@@@D@G@@@"
"CHA@@@ILHAIHA@H@@@D@G@@@"
"CHA@@@HHHA@HA@H@@@D@G@@@"
"CHA@@@H@HCOLA@H@@@D@G@@@"
"CHA@@@H@HB@DA@H@@@D@G@@@"
"CHA@@@H@HF@FA@OL@@D@G@@@"
"CHA@@@@@@@@@@@@@@@D@G@@@"
"CHA@@@@@G@@@@N@@@@D@G@@@"
"CHA@@@@@G@@@@N@@@@D@G@@@"
"CHA@@@@@B@@@@D@@@@D@G@@@"
"CHAOOOOOOOOOOOOOOOL@G@@@"
"CH@@@@@@B@@@@D@@@@@@G@@@"
"CH@@@@@@COOOOL@@@@@@G@@@"
"CH@@@@@@@@@@@@@@@@@@G@@@"
"CH@@@@@@@@@@@@@@@@@@G@@@"
"CH@@@@@@@@@@@@@@@@@@G@@@"
"CH@@@@@@@@@@@@@@@@@@G@@@"
"CH@@@@@@@@@@@@@@@@@@G@@@"
"CH@@@@@@@@@@@@@@@@@@G@@@"
"CH@@@@GLHHCLAOCN@@@@G@@@"
"CH@@@@DDHHBDAABB@@@@G@@@"
"CH@@@@D@HHFFAAB@@@@@G@@@"
"CH@@@@CHOHDBAOCH@@@@G@@@"
"CH@@@@@DHHOOAHB@@@@@G@@@"
"CH@@@@DDHHHAAFBB@@@@G@@@"
"CH@@@@GLHIHAICCN@@@@G@@@"
"CH@@@@@@@@@@@@@@@@@@G@@@"
"COOOOOOOOOOOOOOOOOOOO@@@"
"COOOOOOOOOOOOOOOOOOOO@@@"
"COOOOOOOOOOOOOOOOOOOO@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@")

(RPAQ MASH.IconMask (READBITMAP))
(90 50
"@@@@@@@@@@@@@@@@@@@@@@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"AOOOOOOOOOOOOOOOOOOOL@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@@@@@")



(* VARS)



(RPAQ? MASH.VALID-HOSTS
 (QUOTE (IVY INDIGO PHYLUM ERIS QV CHERRY)))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS MASH.VALID-HOSTS)
)

(ADDTOVAR BackgroundMenuCommands
 (Mail% Share (QUOTE (MASH.TopLevel))
						"Start the Mail Share menu"))

(RPAQQ BackgroundMenu
 NIL)
(PUTPROPS MAILSHARE COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (865 8236 (MASH.TopLevel 875 . 1582) (MASH.CreateFreeMenu 1584 . 2471) (MASH.GetMail 
2473 . 5643) (MASH.Quit 5645 . 6352) (MASH.Consistent 6354 . 7221) (MASH.MakeDirectoryName 7223 . 7560
) (MASH.MakeProfileName 7562 . 7981) (MASH.MakeIconWindow 7983 . 8234)))))
STOP