Pretty print any AppleScript object

The code below defines a pp() handler that returns a textual description of any AppleScript object. The handler is part of ASUnit’s output routines (https://github.com/lifepillar/ASUnit), but I thought that it might be interesting by itself (the code below is completely self-contained). It has been carefully crafted with the following design goals in mind:

  1. provide a description as accurate as possible (in particular, distinguish between objects and references to objects);
  2. never throw an error;
  3. always terminate (see the demo below for an edge case).

Wrt 1, there are some limitations: first, records are represented as «record {value1, value2, .}» rather than {key1: value1, key2: value2, .}. Second, handlers are represented as «handler» instead of the more descriptive «handler name»; third, all Cocoa references are represented simply as «class ocid» (without the details of the reference itself). But this code is pure AppleScript, and I don’t think that there is a way to overcome such limitations. Maybe, using Cocoa one can do something along the lines of what osascript -s s does (if you know how, please tell me!).

I have tested this code thoroughly, but if you find a case where it does not produce the expected result, please let me know! I need this to be as robust as possible for ASUnit :slight_smile:


(*!
	@abstract
		Determines whether invisible characters should be made visible.
	@discussion
		When this property is set to true (which is the default), invisible characters
		(spaces, tabulations, linefeeds, and returns) are printed as visible characters.
*)
property showInvisibles : true

(*! @abstract The maximum recursion depth for @link pp() @/link. *)
property maxRecursionDepth : 10

(*!
	@abstract
		Returns a textual representation of an object.
	@param
		anObject <em>[anything]</em> An expression.
*)
on pp(anObject)
	_pp(anObject, 0)
end pp

on _pp(anObject, depth)
	local res, klass, referencedObject
	
	if depth > my maxRecursionDepth then return "..."
	
	try -- Is it a reference?
		anObject as reference
		
		try
			set referencedObject to contents of anObject
		on error
			return "«undefined reference»"
		end try
		
		if anObject is not equal to referencedObject then
			return "a reference to" & space & _pp(contents of anObject, depth + 1)
		end if
		
		-- Is it an Objective-C reference?
		if isCocoaRef(anObject) then return "«class ocid»"
		
		-- Is it a file reference?
		try
			if class of anObject is alias then
				return "alias" & space & asText(anObject)
			end if
		end try
		try
			anObject as «class furl»
			return "file" & space & asText(anObject)
		end try
		
		-- Is it a date?
		try
			if class of anObject is date then return asText(anObject)
		end try
		
		-- Is it a unit type?
		try
			set klass to class of anObject
			if klass is in {centimeters, feet, inches, kilometers, meters, miles, yards, square feet, square kilometers, square meters, square miles, square yards, cubic centimeters, cubic feet, cubic inches, cubic meters, cubic yards, gallons, liters, quarts, grams, kilograms, ounces, pounds, degrees Celsius, degrees Fahrenheit, degrees Kelvin} then
				return asText(anObject) & space & asText(klass)
			end if
		end try
		
		try
			return "a reference of class" & space & _pp(klass, depth + 1)
		on error
			return "Unrecognized reference [please report as ASUnit bug]" -- We should never get here
		end try
	end try
	
	-- Ok, not a reference. Let's try to get anObject's class
	try
		set klass to class of anObject
	on error
		try
			return "«" & asText(anObject's name) & "»"
		end try
		try
			return "«" & asText(anObject's id) & "'»"
		end try
		try
			return "«" & asText(anObject's description) & "»"
		end try
		try
			return asText(anObject)
		on error -- Give up
			return "«object»"
		end try
	end try
	
	if klass is list or class is RGB color then
		local s, n
		
		set n to anObject's length
		if n = 0 then return "{}"
		set s to "{"
		repeat with i from 1 to n - 1
			set s to s & _pp(item i of anObject, depth + 1) & "," & space
		end repeat
		return s & _pp(item n of anObject, depth + 1) & "}"
	end if
	
	if klass is record then
		return "«record " & _pp(anObject as list, depth + 1) & "»"
	end if -- list, RGB color
	
	if klass is script or klass is application or klass is null then
		if anObject is AppleScript then return "AppleScript"
		try
			set res to anObject's id
			if res is missing value then error
			set res to asText(res)
		on error
			try
				set res to anObject's name
				if res is missing value then error
				set res to asText(res)
			on error
				set res to ""
			end try
		end try
		
		if klass is script then
			return "«script" & space & res & "»"
		else
			return "«application" & space & res & "»"
		end if
	end if -- script, application, null
	
	if klass is handler then return "«handler»"
	
	try
		set res to asText(anObject)
	on error
		if klass is anObject then return "«object of class self»"
		try
			return "«object of class" & space & _pp(klass, depth + 1) & "»"
		on error errMsg
			return "ERROR:" & errMsg -- We should never get here
		end try
	end try
	
	if klass is text then
		if my showInvisibles then -- show invisible characters
			local tid, x
			set tid to AppleScript's text item delimiters
			set AppleScript's text item delimiters to space
			set x to text items of res
			set AppleScript's text item delimiters to «data utxtFF65» as Unicode text -- small bullet
			set res to x as text
			set AppleScript's text item delimiters to tab
			set x to text items of res
			set AppleScript's text item delimiters to «data utxt21A6» as Unicode text -- rightwards arrow from bar
			set res to x as text
			set AppleScript's text item delimiters to linefeed
			set x to text items of res
			set AppleScript's text item delimiters to «data utxt00AC» as Unicode text -- not sign
			set res to x as text
			set AppleScript's text item delimiters to return
			set x to text items of res
			set AppleScript's text item delimiters to «data utxt21A9» as Unicode text -- hook arrow
			set res to x as text
			set AppleScript's text item delimiters to tid
		end if
		return res
	end if
	
	return res
end _pp

(*! @abstract Utility handler to coerce an object to <code>text</code>. *)
on asText(s)
	local ss, tid
	set {tid, AppleScript's text item delimiters} to {AppleScript's text item delimiters, ""}
	try
		set ss to s as text
		set AppleScript's text item delimiters to tid
		return ss
	on error errMsg number errNum
		set AppleScript's text item delimiters to tid
		error errMsg number errNum
	end try
end asText

(*!
	@abstract
		Utility handler to check whether a given expression is a reference to a Cocoa object.
	@discussion
		See <a href="http://macscripter.net/viewtopic.php?pid=177998">this MacScripter's thread</a>.
*)
on isCocoaRef(x)
	try
		(class of x) as reference
		(contents of class of x is class of x)
	on error
		false
	end try
end isCocoaRef

script demo
	property x : POSIX file "/some/path"
	property y : a reference to x
	property z : a reference to y
	property tweedledee : a reference to tweedledum
	property tweedledum : a reference to tweedledee
	property doc : missing value
	
	display dialog pp(my parent's class)
	display dialog pp({1, "a", {"nested", {"list"}}, {x:7, y:"abc"}, me})
	display dialog pp(path to home folder)
	tell application "Script Editor" to set doc to get some document
	display dialog pp(doc)
	display dialog pp(a reference to z)
	display dialog pp(linefeed & space & tab & space & return)
	display dialog pp(tweedledee)
end script

property class : me -- Weird, but legal
run demo

Edited: make pp() recognize more references, e.g., references to Finder windows.

An alternative approach lets Applescript do all the heavy lifting. It is admittedly a hack but an effective one that has worked robustly for me for many years. Few objects escape its grasp. When a problematic object occasionally pops up (a rare event nowadays), the script can usually be adjusted to handle the object. The trick is to force an error and then parse Applescript’s error message. The details are described in the comments.

on textValue(inputRecord)
    -- Returns the value of an object of virtually any class as a text string
	(*
	INPUT:
		a record of the form {theObject:xxx, includeQuotes:xxx, showInvisibles:xxx}
			theObject
				an object of virtually any class
			includeQuotes
				true
					if the input object is a text string, it will be returned with enclosing literal double-quote characters
				-or-
				false
					if the input object is a text string, it will be returned without enclosing literal double-quote characters
				NOTE:
					- This argument is ignored if the input object is not a text string
			showInvisibles
				true
					if the input object is a text string, whitespace characters will be replaced with visible tokens
				-or-
				false
					if the input object is a text string, whitespace characters will not be replaced
				NOTE:
					- This argument is ignored if the input object is not a text string
	OUTPUT:
		text representation of the object
	*)
	-- Process the handler argument
	tell inputRecord to set {theObject, includeQuotes, showInvisibles} to {its theObject, its includeQuotes, its showInvisibles}
	-- Handle the special case of an empty string
	if theObject = "" then
		if includeQuotes then
			return "\"\""
		else
			return ""
		end if
	end if
	-- Get the object's text representation
	if (theObject's class = text) and not includeQuotes then
		-- Handle the case of a non-empty string whose enclosing literal double-quote characters are not to be displayed
		set objectAsText to theObject
		repeat while (objectAsText starts with "\"") and (objectAsText ends with "\"")
			-- "run script" reduces a text string with enclosing literal double-quote characters by one quote level
			set objectAsText to run script objectAsText
		end repeat
	else
		-- Handle all other cases
		try
			-- If theObject is a text string that is to be returned with enclosing literal double-quote characters, the "|| of theObject" algorithm will automatically enquote the text string
			|| of theObject --> always generates an error message; almost always, the message contains a displayable version of "theObject" (doesn't work when theObject is a script reference)
		on error plannedErrorMessage
			try
				set o1 to 0
				repeat with i in {"Can't get || of ", "Can't get || of ", "Can't make || of ", "Can't make || of "}
					tell (offset of i's contents in plannedErrorMessage)
						if it > 0 then
							set o1 to it + (i's contents's length)
							exit repeat
						end if
					end tell
				end repeat
				if o1 = 0 then error
				set o2 to 0
				tell plannedErrorMessage
					repeat with i in {" into type specifier.", " into type reference.", "."}
						if it ends with i's contents then
							set o2 to -1 * ((i's contents's length) + 1)
							exit repeat
						end if
					end repeat
					if o2 = 0 then error
					set objectAsText to text o1 thru o2
				end tell
			on error
				try
					theObject as null --> always generates an error message; almost always, the message contains a displayable version of "theObject" (sometimes doesn't work when theObject is from an application-derived class, such as a Finder file reference)
				on error plannedErrorMessage
					try
						set o1 to 0
						repeat with i in {"Can't make ", "Can't make "}
							tell (offset of i's contents in plannedErrorMessage)
								if it > 0 then
									set o1 to it + (i's contents's length)
									exit repeat
								end if
							end tell
						end repeat
						if o1 = 0 then error
						set o2 to 0
						tell plannedErrorMessage
							repeat with i in {" into type null.", " into type «class null»."}
								if it ends with i's contents then
									set o2 to -1 * ((i's contents's length) + 1)
									exit repeat
								end if
							end repeat
							if o2 = 0 then error
							set objectAsText to text o1 thru o2
						end tell
					on error
						try
							script plannedErrorScript
								error theObject --> always generates an error message containing a displayable version of "theObject" for all objects (used as a last resort, since it executes more slowly than the "|| of" and "as null" techniques)
							end script
							run script plannedErrorScript
						on error plannedErrorMessage
							set objectAsText to plannedErrorMessage
						end try
					end try
				end try
			end try
		end try
	end if
	-- Show invisibles if specified by the showInvisibles argument
	if (theObject's class = text) and showInvisibles then
		set {nonbreakingSpace, bulletOperator, rightwardsArrowFromBar, notSign, leftwardsArrowWithHook} to {character id 160, character id 8729, character id 8614, character id 172, character id 8617}
		set tid to AppleScript's text item delimiters
		try
			set AppleScript's text item delimiters to {space, nonbreakingSpace}
			tell objectAsText's text items
				set AppleScript's text item delimiters to bulletOperator
				set objectAsText to it as text
			end tell
			set AppleScript's text item delimiters to tab
			tell objectAsText's text items
				set AppleScript's text item delimiters to rightwardsArrowFromBar
				set objectAsText to it as text
			end tell
			set AppleScript's text item delimiters to linefeed
			tell objectAsText's text items
				set AppleScript's text item delimiters to notSign
				set objectAsText to it as text
			end tell
			set AppleScript's text item delimiters to return
			tell objectAsText's text items
				set AppleScript's text item delimiters to leftwardsArrowWithHook
				set objectAsText to it as text
			end tell
		end try
		set AppleScript's text item delimiters to tid
	end if
	-- Transform any "«class null»" entries (generated when a value = Applescript's null value) to "null"
	set tid to AppleScript's text item delimiters
	try
		set AppleScript's text item delimiters to "«class null»"
		tell objectAsText's text items
			set AppleScript's text item delimiters to "null"
			set objectAsText to it as text
		end tell
	end try
	set AppleScript's text item delimiters to tid
	-- Return the text version of the input object
	return objectAsText
end textValue

I made the following two edits to my original submission:
- Your “show invisibles” feature has been incorporated
- The code in the “offset of…” sections has been streamlined