Sites off current Safari page

Scripting Forums Code Exchange
,
#1

I’m having Fun with Safari again, this is another for Safari Script menu

Call it ‘Sites off this page’

Like my site from Safari history, this one does site from links off current page

Brings up a list to choose from, then opens that site

Simple but fun

here some site to try from

http://www.aatravel.co.nz
http://en.wikipedia.org
http://www.macscripter.net

Its interesting who linking to who

property TheURL : "http://www.macscripter.net/"
property SuffixOptions : {".com", ".net", ".org", ".info", ".us", ".biz", ".tv", ".mobi", ".cc", ".ws", ".bz", ".tc", ".vg", ".ms", ".gs", ".name", ".co.uk", ".de", ".be", ".eu", ".at", ".com.mx", "org.uk", ".me.uk", ".co.nz", ".net.nz", ".org.nz", ".cn", ".tw"}
set LinkList to {}
tell application "Safari"
	activate
	set the LinkCount to (do JavaScript "document.links.length" in document 1)
	repeat with i from 0 to (the LinkCount - 1)
		set TheLink to (do JavaScript "document.links[" & (i as string) & "].href" in document 1)
		copy TheLink to the end of LinkList
	end repeat
end tell

set TheSites to {}
repeat with TheOption in LinkList
	set ThisURL to FindDomainName(TheOption)
	if not ThisURL = "Misc" then
		set GotoURL to "www." & ThisURL
		if TheSites does not contain GotoURL then
			copy GotoURL to end of TheSites
		end if
	end if
end repeat

if TheSites = {} then
	display dialog "There is no websites off this page" buttons {"Cancel"} default button "Cancel" with icon stop
else
	set TheSites to mergeSort(TheSites)
	set ChoosenSite to choose from list TheSites OK button name "Surf" without empty selection allowed and multiple selections allowed
	if not ChoosenSite is false then
		try
			tell application "Safari"
				activate
				if document 1 exists then
					tell document 1
						set URL to ("http://" & ChoosenSite)
					end tell
				else
					make new document
					tell document 1
						set URL to ("http://" & ChoosenSite)
					end tell
				end if
			end tell
		end try
	end if
end if


on FindDomainName(TheURL)
	set TheSuffix to ""
	repeat with CurrentSuffix in SuffixOptions
		if TheURL contains (CurrentSuffix & "/") then
			set TheSuffix to CurrentSuffix
			exit repeat
		end if
	end repeat
	if TheSuffix = "" then
		return "Misc"
	else
		set SuffixOffset to offset of (CurrentSuffix & "/") in TheURL
		set JustDomain to (characters 1 thru (SuffixOffset - 1) of TheURL) as string
		set PointOffSet to 0
		repeat with NegOffSet from (length of JustDomain) to 1 by -1
			if character NegOffSet of JustDomain is "." or character NegOffSet of JustDomain is "/" then
				set PointOffSet to NegOffSet
				exit repeat
			end if
		end repeat
		try
			set JustDomain to (characters (PointOffSet + 1) thru (length of JustDomain) of JustDomain as string) & CurrentSuffix
		on error
			set JustDomain to "Misc"
		end try
		return JustDomain
	end if
end FindDomainName

on mergeSort(theList)
	--the public routine, to be called from your script
	script bs
		property alist : theList
		
		on merge(leftSide, rightSide)
			--private routine called by mergeSort. 
			--do not call from your script!
			set newList to {}
			set theLeft to leftSide
			set theRight to rightSide
			set leftLength to length of theLeft
			set rightLength to length of theRight
			repeat while leftLength > 0 and rightLength > 0
				if first item of theLeft ≤ first item of theRight then
					set newList to newList & first item of theLeft
					set theLeft to (rest of theLeft)
				else
					set newList to newList & first item of theRight
					set theRight to rest of theRight
				end if
				set leftLength to length of theLeft
				set rightLength to length of theRight
			end repeat
			if leftLength > 0 then set newList to newList & theLeft
			if rightLength > 0 then set newList to newList & theRight
			return newList
		end merge
	end script
	
	set midList to 0
	set leftList to {}
	set rightList to {}
	set listLength to length of bs's alist
	if listLength ≤ 1 then
		return bs's alist
	else
		set midList to listLength div 2
		repeat with pointer from 1 to midList
			set leftList to leftList & item pointer of bs's alist
		end repeat
		repeat with pointer from (midList + 1) to listLength
			set rightList to rightList & item pointer of bs's alist
		end repeat
		set leftList to mergeSort(leftList)
		set rightList to mergeSort(rightList)
	end if
	return bs's merge(leftList, rightList)
end mergeSort

Thanks this site for the sort handler, I made the domain name handler :slight_smile:

Make fun