;+
; NAME:
;	www_help_get_header
; PURPOSE:
;	The input file is searched for headers. The file may contain more than one header.
; CATEGORY:
;	www_help
; CALLING SEQUENCE:
	PRO www_help_get_header, source, header, origin, style, section, add_corpses=add_corpses
; INPUTS:
;	source			scalar; type: string
;						fully qualified file name
;	header			array; type: structure
;						all the headers. New headers will be added to the list.
;	origin			array[2]; type: string
;						string array describing location of source code
;						origin[0] : full name of the source file or text library
;						origin[1] : the module name when processing a library
;	style			scalar; type: string
;						comment character
;	section			array; type: string
;						list of valid section headings
;	/add_corpses
; OPTIONAL INPUT PARAMETERS:
;	/add_corpses	if set then files containing no headers are added with a dummy header
;					(this only makes sense if the cgi-script www_help.cgi is working to provide
;					access to the source code).
; OUTPUTS:
;	header		array; type: structure
;					updated array of headers
; INCLUDE:
	@compile_opt.pro		; On error, return to caller
; CALLS:
;	SetFileSpec, GetFileSpec,www_help_change_tabs, www_help_verify_name
;	www_help_is_section, www_help_is_text, www_help_add_header
;	hide_env
; SIDE EFFECTS:
;	When processing a library module (origin[1] ne '')
;	the source file 'source' is deleted after processing.
; RESTRICTIONS:
;	Include files are detected by their extension .h or by the
;	string _common in the name. This is weak.
; PROCEDURE:
; >	A header is defined as all lines between an opening line start_char 
;	and a closing line stop_char
;
; >	The name field is filled by searching for the section string 'NAME:'.
;	The procedure name follows this section heading.
;
;	Unless style.anycase is set 'NAME:' must be in uppercase with no
;	whitespace preceeding the colon, and the procedure name must be on the
;	line following the line containing 'NAME:
;
;	If style.anycase is set then 'NAME:' can be lower-, upper- or mixed case;
;	whitespace preceding the colon is permitted, and the procedure name can
;	be on the same line as 'NAME:'. Also one extra empty line after NAME: may
;	be included.
;
;	If no procedure name is found, then the file name is used instead.
; MODIFICATION HISTORY:
;	JAN-2001, Paul Hick (UCSD/CASS)
;	JUN-2001, Paul Hick (UCSD/CASS)
;		added style.anycase keyword to handle SSW code Setting style.anycase
;		handles several variations of the ways the procedure name is specified:
;		- NAME: can be lower, upper or mixed case (default: uppercase only)
;		- There can be whitespace between NAME and : (default: no whitespace)
;		- The name of the procedure can be on the same line with NAME: (default: next line)
;	MAY-2003, Paul Hick (UCSD/CASS; pphick@ucsd.edu)
;		Moved call to www_help_change_tabs down one line (after removal of comment char
;		from header line). This improves processing of headers with code in it.
;-

IF source EQ '' THEN RETURN

SetFileSpec, source
defname = GetFileSpec(part='name')
is_incl = strlowcase(GetFileSpec(part='type')) EQ '.h' OR	$		; Works for Fortran include files
	  	(defname NE 'where_common' AND strpos(defname,'_common') NE -1)	; Works for (most) IDL include files

no_header   = 1								; Set to 0 if at least one header is found.
InitVar, add_corpses, /key

on_ioerror, DONE

openr, iu, /get_lun, source, delete=origin[1] NE ''

char  = style.commentchar
nchar = strlen(char)

lead  = style.start_char 
nlead = strlen(lead)

trail = style.stop_char
ntrail= strlen(trail)

find_lead = 1

WHILE 1 DO BEGIN							; Get next header
	lines = ''
	tmp   = ''

	IF find_lead THEN			$
		REPEAT readf, iu, tmp	$			; Find opening line
			UNTIL strmid(tmp,0,nlead) EQ lead

	readf, iu, tmp							; Find closing line

	WHILE strmid(tmp,0,ntrail) NE trail DO BEGIN
		IF strmid(tmp,0,nchar) EQ char THEN tmp = strmid(tmp,nchar); Drop comment char in 1st pos
		IF style.tabsize NE 8 THEN	$
			tmp = www_help_change_tabs(tmp,style.tabsize,8)
		lines = [lines, tmp]

		readf, iu, tmp
	ENDWHILE

	nline = n_elements(lines)-1				; # lines in header (could be zero)

	IF nline GT 0 THEN BEGIN
		lines = lines[1:*]					; Remove leading blank line

		; Search for procedure name; look for string NAME:. If style.anycase is set then case is ignored.
		; Also strcompress is used to allow for whitespace between 'NAME' and ':'.
		; In SSW some code uses ROUTINE instead of NAME. Test for both if style.anycase is set.

		name = ''
		tst  = 'NAME'
		IF style.anycase THEN tst = [tst, 'ROUTINE','FILE','PROGRAM','FUNCTION','TITLE']

		itst = -1
		ntst = n_elements(tst)

		WHILE name EQ '' AND itst LT ntst-1 DO BEGIN
			itst = itst+1

			tmp = www_help_is_section(style, tst[itst]+':', lines)

			; For SolarSoft we also tolerate occurences of tst[itst] without a colon
			; provided it is on the first line of the header.

			IF tmp EQ -1 AND style.anycase THEN BEGIN
				tmp = www_help_is_section(style, tst[itst], lines)
				IF tmp EQ 0 THEN BEGIN
					pos = strpos(strupcase(lines[tmp]),tst[itst])
					lines[tmp] = strmid(lines[tmp],0,pos)+tst[itst]+':'+strmid(lines[tmp],pos+strlen(tst[itst]))
				ENDIF ELSE	$
					tmp = -1
			ENDIF

			; If NAME: is found then the procedure name usually is on the next line.
			; If style.anycase is set then the line containing NAME: also can have the name on it.

			IF tmp EQ -1 THEN BEGIN			; No name found; use file name

				IF itst EQ ntst-1 THEN BEGIN
					print, source
					print, 'No sections '+strjoin(tst,' or ')+' found; first lines in header are: '
					FOR i=0L,(nline < 5)-1 DO print, lines[i]

					name = defname
					message, /info, 'no name, using filename: '+name
				ENDIF

			ENDIF ELSE IF style.anycase THEN BEGIN
				name = strupcase(lines[tmp])
				pos  = strpos(name,':',strpos(name,tst[itst]))	; First ':' after 'NAME'
				name = strtrim(strmid(lines[tmp],pos+1),2)	; Extract part following ':'

			ENDIF

			; If name is still blank then check the line following the line containing NAME:
			; (after making sure that there is a next line).

			IF tmp NE -1 AND name EQ '' THEN BEGIN

				IF style.anycase AND tmp LE nline-2 THEN $	; Allow for one empty line after NAME:
					tmp = tmp + (strtrim(lines[tmp+1],2) EQ '')

				; The next line (tmp+1), if it's there and is a text line (rather than
				; a section heading) then use it for as name.

				pos = tmp LT nline-1
				IF pos THEN pos = www_help_is_text(style,lines[tmp+1],section)

				IF pos THEN	$
					name = strtrim(lines[tmp+1], 2)	$

				ELSE BEGIN					; No next line
					print, source
					print, 'No name found near '+tst[itst]+':, preceding lines in header are: '
					FOR i=((nline-5L) > 0),nline-1 DO print, lines[i]

					IF itst EQ ntst-1 THEN BEGIN
						name = defname
						message, /info, 'no name, using filename: '+name
					ENDIF
				ENDELSE
			ENDIF

			; Check the name to make sure it makes sense. If it doesn't then 'name'
			; set to the null string.

			 www_help_verify_name, name, source

		ENDWHILE

		; If name is still blank, then something unexpected happened.

		IF name EQ '' THEN BEGIN
			print, source
			print, 'No name found, header is: '
			FOR i=0L,(nline < 5)-1 DO print, lines[i]

			name = defname
			message, /info, 'no name, using filename: '+name
		ENDIF

		no_header = www_help_add_header(name, header, origin, style, section, is_incl, lines)

	ENDIF

ENDWHILE

DONE:

on_ioerror, NULL

IF n_elements(iu) NE 0 THEN free_lun, iu

IF no_header THEN BEGIN
	message, /info, 'no header, '+hide_env(source,/silent)

	IF add_corpses THEN no_header = www_help_add_header(header, defname, origin, is_incl,	$
		[' No help available',' ',' Good luck figuring this one out'])

ENDIF

RETURN  &  END