;**
;**		BRIEF -- Basic Reconfigurable Interactive Editing Facility
;**
;**		Written by Dave Nanian and Michael Strickman.
;**

;**
;**		language.m:
;**
;**		This file contains the support modules for BRIEF's language package
;**	system.
;**
;**		Revision history:
;**		-----------------

(extern	escape_re)

(macro _init
	(
		(string	_curr_active)

		(int		_package_buf)

		(global	_curr_active
					_package_buf
		)
		(register_macro 1 "_call_on_packages")
		(register_macro 6 "_call_first_packages")
		(= _package_buf (create_buffer "Packages" NULL 1))
	)
)

(macro _call_on_packages
	(_call_packages "_on")
)

(macro _call_first_packages
	(
		(string	filename)

		(inq_names NULL NULL filename)

		(if (== (inq_message) (+ "New file (unable to open " (+ filename ").")))
			(_call_packages "_new")
		)
		(_call_packages "_first")
	)
)

;**
;**		_call_packages:
;**
;**		This macro is the main event parser and dispatcher for the BRIEF
;**	language package system.  It calls packages specified in the BPACKAGES
;**	environment variable in response to events generated by the system or
;**	by the user.  It then maintains some housekeeping information that allows
;**	rapid access to these pacakages in the future.
;**

(macro _call_packages
	(
		(string	bpackages
					to_call
					mac_name
					file_ext
					escaped_ext
					event_name
					pattern
		)
		(int	loc
				pass
				file_buf
				already_parsed
		)
		;**
		;**		First, we get the event type and the extension of the file.  If
		;**	there are any "off" macro to call (saved in the _curr_active global
		;**	string), we reset them before continuing.
		;**

		(get_parm 0 event_name)
		(inq_names NULL file_ext)
		(= escaped_ext (escape_re file_ext))
		(_reset_packages)

		;**
		;**		The global _package_buf contains housekeeping information that
		;**	allows the language system to keep parsed event information around
		;**	for the duration of the editing session.  Each event occupies one
		;**	line in the buffer (per extension), and one additional line is
		;**	taken per extension to save the pre-parsed packages and arguments.
		;**
		;**		Extensions are always found together in the package buffer; the
		;**	events come first, followed by the pre-parsed information.  This
		;**	allows the search pattern to fall through to the pre-parsed
		;**	information if the event hasn't occurred yet.
		;**
		;**		The format of the strings is:
		;**
		;**		.[extension][event name, or nothing if pre_parse];[information]
		;**

		(= file_buf (inq_buffer))
		(set_buffer _package_buf)
		(top_of_buffer)

		;**
		;**		This search locates any string in the buffer that corresponds
		;**	to the current extension.  If the event is in the buffer, the length
		;**	returned by search will include the event name length (which is always
		;**	non-0).  Otherwise, search will return 2 -- this indicates the string
		;**	contains pre-parse information.
		;**

		(if (= already_parsed (search_fwd (+ "<." (+ escaped_ext (+ "\\c{" (+ event_name "}@;"))))))
			(
				(next_char (-- already_parsed))
				(= to_call (trim (read)))
			)
		;else
			(
				;**
				;**		If no information is present in the buffer for the given
				;**	extension, the BPACKAGES string must be retrieved from the
				;**	environment and parsed.  Note that this will only happen
				;**	once per extension.
				;**
				;**		Since the BPACKAGES string is quite complex, and a given
				;**	extension can appear more than once (and with a number of
				;**	different packages), the parser loops and search for the
				;**	extension until it can't be located any more.
				;**
				;**		If the extension isn't found at all, the "default" extension
				;**	is used and a second pass is made over the BPACKAGES string.
				;**
				;**		If neither the extension nor the "default" extension is
				;**	found, no events are generated for this extension.
				;**

				(int	located)

				(= pattern (+ (+ "<|[,;] @" escaped_ext) " @{,[~,;]@}@:\\c[~:\n;]@[\n;]"))
				(= bpackages (+ (trim (ltrim (compress (inq_environment "BPACKAGES")))) "\n"))

				(while (!= pass 2)
					(
						(while (= loc (search_string pattern bpackages NULL NULL 0))
							(
								(++ located)
								(= bpackages (substr bpackages loc))

								(if (! (= loc (index bpackages ";")))
									(= loc (strlen bpackages))
								)
								;**
								;**		All of the pre-expansion packages for the current
								;**	extension are combined together in the to_call string
								;**	separated by commas.  This string is used later to
								;**	expand and call the individual package macros, and
								;**	is inserted into the buffer as pre-parse information
								;**	once the parse has been completed.
								;**

								(+= to_call (+ (if (strlen to_call) "," "") (substr bpackages 1 (- loc 1))))
								(= bpackages (substr bpackages (+ loc 1)))
							)
						)
						;**
						;**		If we can't find the extension any more and we've located
						;**	some packages to call, then the parse is over.  Otherwise,
						;**	we use "default" as the extension and try one more time.
						;**

						(if located
							(break)
						;else
							(
								(= pattern "<|[,;] @default @{,[~,;]@}@:\\c[~:\n;]+[\n;]")
								(++ pass)
							)
						)
					)
				)
			)
		)
		(= file_ext (+ "." file_ext))

		;**
		;**		If the package buffer didn't contain any information about
		;**	the current file extension, we insert the pre-parse information
		;**	at the top of the buffer.  This information can be used later
		;**	to avoid doing an additional BPACKAGES parse.
		;**

		(beginning_of_line)

		(if (! already_parsed)
			(
				(insert (+ file_ext (+ ";" (+ to_call "\n"))))

				;**
				;**		We move up here because the event information must
				;**	appear before the pre-parse information, and the "\n"
				;**	that was inserted moves us down a line.
				;**

				(up)
			)
		;else

			;**
			;**		As you may recall, locating the pre-parse information will
			;**	set already_parsed to 2, and locating specific event information
			;**	will set it to some number above that (depending on the length
			;**	of the event name).  Decrementing already_parsed at this point
			;**	will force the insertion of event-specific information if only
			;**	pre-parse information had been located in the package buffer search.
			;**

			(-- already_parsed)
		)
		(set_buffer file_buf)
		(= bpackages "")

		;**
		;**		At this point, we've got a list of pre-expanded package
		;**	names that look something like "s,pvcs,wp".  These have to
		;**	be expanded and converted into the event and extension
		;**	specific variety.  Each individual package is separated and
		;**	passed to process_package, which expands the name (if
		;**	necessary), handles extension-specific and generic naming
		;**	convensions, deals with parameters, and the like.  Once
		;**	completed, the expanded package name (if any) is returned
		;**	and saved in another string that will be inserted as the
		;**	event-specific information in the package buffer.
		;**

		(while (strlen to_call)
			(
				(if (! (= loc (index to_call ",")))
					(= loc (+ (strlen to_call) 1))
				)
				(= mac_name (process_package event_name (ltrim (trim (substr to_call 1 (- loc 1)))) already_parsed))

				(if (strlen mac_name)
					(+= bpackages (+ (if (strlen bpackages) "," "") mac_name))
				)
				(= to_call (substr to_call (+ loc 1)))
			)
		)
		;**
		;**		If the event-specific information wasn't found in the buffer,
		;**	it's inserted here.
		;**

		(if (! already_parsed)
			(
				(= file_buf (inq_buffer))
				(set_buffer _package_buf)
				(insert (+ file_ext (+ event_name (+ ";" (+ bpackages "\n")))))
				(set_buffer file_buf)
			)
		)
	)
)

;**
;**		process_package:
;**
;**		This macro converts generic package names into their generic or
;**	extension-specific macro name counterparts.
;**

(macro process_package
	(
		(string	file_ext
					event_name
					mac_name
					initial_mac
					parms
		)
		(int	loc
				length
				processed
		)
		(get_parm 0 event_name)
		(get_parm 1 mac_name)
		(get_parm 2 processed)

		;**
		;**		If the names haven't already been parsed and expanded by
		;**	this routine, we have a lot of work to do.  This work is
		;**	skipped once it has been done once.
		;**

		(if (! processed)
			(
				(inq_names NULL file_ext)
				(= file_ext (+ "." file_ext))

				(if (= loc (index mac_name " "))
					(
						(= parms (substr mac_name (+ loc 1)))
						(= mac_name (substr mac_name 1 (- loc 1)))
					)
				)
				;**
				;**		If part of the package name is found in the
				;**	abbreviation list, the full name is retrieved and used
				;**	instead.  Note that the macros in the abbreviation list
				;**	could be demotable groups (separated by commas).
				;**

				(= initial_mac (_package_abbrev))

				(if (= loc (search_string (+ "[,;]" (+ mac_name "*;")) initial_mac length))
					(= initial_mac (substr initial_mac (+ loc 1) (- length 2)))
				;else
					(= initial_mac mac_name)
				)

				;**
				;**		This loop searches for specific and generic event
				;**	handler macros.  First, specific macros are searched
				;**	for.  If none are found, the last member of the
				;**	demotable group is searched for generically.  This is
				;**	because generic higher level demotion macros don't
				;**	make any sense (they'd override anything else, and
				;**	wouldn't leave anything to demote to).
				;**

				(while (! processed)
					(
						(if (! (= loc (index initial_mac ",")))
							(= loc (+ (strlen initial_mac) 1))
						)
						(= mac_name (substr initial_mac 1 (- loc 1)))
						(= initial_mac (substr initial_mac (+ loc 1)))

						(= mac_name (+ "_" (+ mac_name event_name)))

						(if (= processed (inq_macro (+ file_ext mac_name)))
							(= mac_name (+ file_ext mac_name))
						;else
							(if (! (strlen initial_mac))
								(
									(= processed (inq_macro mac_name))
									(break)
								)
							)
						)
					)
				)
			)
		)
		;**
		;**		If the macro has been processed & located, we call it with its
		;**	parameters.
		;**

		(if processed
			(
				(if (strlen parms)
					(+= mac_name (+ " " parms))
				)
				;**
				;**		If current event is an "on" event, we retain the return
				;**	value (if non-null) as an "off" event macro name.
				;**

				(if (&& (!= (= initial_mac (execute_macro mac_name)) "") (== event_name "_on"))
					(+= _curr_active (+ (if (strlen _curr_active) ";" "") initial_mac))
				)
				(returns mac_name)
			)
		;else
			(returns "")
		)
	)
)

;**
;**		_reset_packages:
;**
;**		This macro processes the "off" event.  Any macros that returned
;**	"off" event macros from their event handles have those strings kept
;**	in the _curr_active global variable.  These macros are called here.
;**
;**		Note that "off" macro strings should never contain semicolons.
;**

(macro _reset_packages
	(
		(int	loc)

		(while (strlen _curr_active)
			(
				(if (! (= loc (index _curr_active ";")))
					(= loc (+ (strlen _curr_active) 1))
				)
				(execute_macro (substr _curr_active 1 (- loc 1)))
				(= _curr_active (substr _curr_active (+ loc 1)))
			)
		)
	)
)

;**
;**		_package_abbrev:
;**
;**		This macro is at the terminus of the chain.  It returns a string
;**	consisting of the abbreviations and demotable groups for the built-in
;**	BRIEF packages (indenting, word processing and pvcs).
;**

(macro _package_abbrev
	(returns ";template,smart,regular;pvcs;wp;")
)