(welcome "Protext 6.1 Hard Disk Installation")

(procedure nothing (set dummy 0))

(set progdisk "Protext6-Program"
ppddisk "Protext6-Printers"
dictdisk "Protext6-Dictionary"
thesdisk "Protext6-Thesaurus"
m_plsinsert "\n\nPlease insert %s Disk" 
)

; Need to init u-destpath and u-srcpath for this code

(procedure arnorcopydisk (
	(foreach u-srcpath "#?"
		(set u-docopy 0)
		(if (< @each-type 0)
			( ; file, not a directory
				(set u-srcname (tackon u-srcpath @each-name))
				(if (patmatch "#?.((gpd)|(ppd))" @each-name)
					(set u-destname (tackon (tackon u-destpath "ppd") @each-name))
					(if (patmatch "#?.((lex)|(qic)|(exl)|(env)|(hyp)|(ths))" @each-name)
						(set u-destname (tackon (tackon u-destpath "lex") @each-name))
						(set u-destname (tackon u-destpath @each-name))
					)
				)
				(if (or
						(or (patmatch "((install#?)|(#?.bak))" @each-name)
							(patmatch "((disk.info)|(.backdrop))" @each-name))
						(and (patmatch "protext.cfg" @each-name)
							(exists u-destname))
					)
					(set u-docopy 0)
					(
						(if (or (not g-update) (not (exists u-destname)))
							(set u-docopy 1)
							( ; else dest does exist
								(if (earlier u-srcname u-destname)
									(set u-docopy 0)
									(
										(if (<> (getsize u-destname)
												(getsize u-srcname)
											)
											(set u-docopy 2)
										)
									)
								)
							)
						)
					)
				)
			)
		)
		(if u-docopy
			(
				(copyfiles
					(source u-srcname)
					(dest (pathonly u-destname))
				)
				(if (patmatch "#?.info" @each-name)
					(tooltype
						(dest u-destname)
						(noposition)
					)
				)
			)
		)
	)
))


(procedure oldfilestuff (
	(set tmp (tackon @default-dest "ppd"))
	(if (exists tmp)
		(
			(delete (tackon tmp "#?.cpd"))
			(rename tmp (tackon @default-dest "ppd.old"))
		)
	)
))

(if
	(askbool
		(prompt "\nDo you want to carry out a full installation\n"
				"or update an existing version of Protext?\n\n"
		        "Selecting `Full Installation' will copy all files.\n\n"
				"Selecting `Update' will only copy newer files on top of older files.\n\n"
				"Both options will preserve your configuration settings.")
		(help "No more help here")
		(choices "Full Installation" "Update Only")
	)
	(set g-update 0 g-msg "install")
	(set g-update 1 g-msg "update")
)

(set @default-dest (tackon @default-dest "Protext"))
(if (= 1 (exists @default-dest))
	(rename @default-dest (cat @default-dest ".old"))
)

(until doneprompt
	(if
		(askbool
			(prompt
				("\nSuggested installation drawer is %s" @default-dest)
			)
			(help "Select `Proceed' if this drawer is OK and has at least 3Mb of free disk space, otherwise select `Change' or `Abort'.")
			(choices "Proceed" "Change")
		)
		(nothing)
		(
			(set tmp
				(askdir
					(prompt "Which drawer do you wish to install into?")
					(help @askdir-help)
					(default @default-dest) 
					(newpath)
				)
			)
			(if (= (substr tmp (- (strlen tmp) 1)) ":")
				(set tmp (tackon tmp "Protext"))
			)
			(set @default-dest tmp)
		)
	)
	(set ds (getdiskspace @default-dest))
	(set doneprompt 1)
	(if (and (< ds 3000000) (<> ds -1))
		(
			(if
				(askbool
					(prompt "\n " (pathonly @default-dest)
							" does not have 3Mb of free space on it.\n\n" 
							"If you are installing on top of an existing copy of Protext, "
							"there may be enough disk space to proceed; "
							"otherwise select `Change' and choose another drive "
							"or delete some files." )
					(help "No more help here")
					(choices "Proceed" "Change")
				)
				(nothing)
				(set doneprompt 0)
			)
		)
	)
)

(message ("\n\nAbout to %s files to %s" g-msg @default-dest))

(if (not (exists @default-dest))
	(makedir @default-dest
		(infos)
	)
)

(set tmp ("Assign >NIL: PROTEXT: %s" @default-dest))
(startup "Protext" 
	(prompt "\nAdding the following line to S:user-startup\n\n" tmp)	
	(help @startup-help)
	(command tmp)
)

(set tmp (tackon @default-dest "Protext"))
(if (exists tmp)
	(
		(set xx (getversion tmp))
		(set hi (/ xx 65536))
		(if (<> hi 6)
			( ; copy old ppds if exists non v6 protext 
				(oldfilestuff)
			)
		)
	)
)

(set u-destpath @default-dest)

(askdisk
	(prompt (m_plsinsert progdisk))
	(help @askdisk-help)
	(dest progdisk)
)
(set u-srcpath (cat progdisk ":"))
(arnorcopydisk)
(copylib
	(source (cat progdisk ":libs/asl.library"))
	(dest "LIBS:")
)

(askdisk
	(prompt (m_plsinsert ppddisk))
	(help @askdisk-help)
	(dest ppddisk)
)
(set u-srcpath (cat ppddisk ":"))
(arnorcopydisk)

(askdisk
	(prompt (m_plsinsert dictdisk))
	(help @askdisk-help)
	(dest dictdisk)
)
(set u-srcpath (cat dictdisk ":"))
(arnorcopydisk)

(askdisk
	(prompt (m_plsinsert thesdisk))
	(help @askdisk-help)
	(dest thesdisk)
)
(set u-srcpath (cat thesdisk ":"))
(arnorcopydisk)

(if (getassign "CFG")
	(nothing) 
	(makeassign "CFG" @default-dest)
)
(set tail ("-i%s" @default-dest))
(run (tackon @default-dest "config") tail)
(makeassign "PROTEXT" @default-dest) ; for icons
