! getline.f90 - コマンド行読み取りモジュール
! Copyright (C) GFD Dennou Club, 2000.  All rights reserved
! vi: set sw=4:

module getline

    use dc_string
    use varying_string_list
    implicit none
    private
    public:: ask, prompt, set_prompt, ask_tokens, get_tokens

    interface set_prompt
	module procedure set_prompt_chars
	module procedure set_prompt_string
    end interface

    type(VSTRING), save:: prompt_string
    logical, save:: first = .TRUE.

contains

    ! private
    subroutine initialize
	if (.not. first) return
	first = .FALSE.
	prompt_string = '> '
    end subroutine

    subroutine set_prompt_string(prompt)
	type(VSTRING), intent(in):: prompt
    continue
	call initialize
	prompt_string = prompt
    end subroutine

    subroutine set_prompt_chars(prompt)
	character(len=*), intent(in):: prompt
    continue
	call initialize
	prompt_string = prompt
    end subroutine

    type(VSTRING) function prompt()
	call initialize
	prompt = prompt_string
    end function

    subroutine ask(line, iostat, prompt)
	type(VSTRING), intent(out):: line
	integer, intent(out), optional:: iostat
	type(VSTRING), intent(in), optional:: prompt
    continue
	call initialize
	if (present(prompt)) then
	    call put(prompt)
	else
	    call put(prompt_string)
	endif
	call get(line, iostat=iostat)
    end subroutine

    subroutine get_tokens(line, tokens)
	type(VSTRING), intent(in):: line
	type(STRING_LIST), intent(inout):: tokens
	type(VSTRING):: buffer, word, sep
	character, parameter:: HT = char(8)
	character, parameter:: CR = char(13)
	character, parameter:: APOSTROPHE = "'"
	character, parameter:: DOUBLE_QUOTE = '"'
	character(len = *), parameter:: WHITESPACE = " " // HT // CR
	character(len = *), parameter:: DELIMITERS &
	    & = WHITESPACE // APOSTROPHE // DOUBLE_QUOTE
	integer:: start
    continue
	call clear(tokens)

	! 行頭が空白の場合読み飛ばす
	start = verify(char(line), set=WHITESPACE)
	! 空行に対しては何もしない
	if (start == 0) return

	! 字句解析開始
	buffer = extract(line, start)
	do
	    call split(buffer, set=DELIMITERS, word=word, separator=sep)
	    if (sep == APOSTROPHE) then
		call split(buffer, set=APOSTROPHE, word=word)
		call push(tokens, word)
		cycle
	    else if (sep == DOUBLE_QUOTE) then
		call split(buffer, set=DOUBLE_QUOTE, word=word)
		call push(tokens, word)
		cycle
	    endif
	    if (word /= "") call push(tokens, word)
	    start = verify(char(buffer), set=WHITESPACE)
	    if (start == 0) exit
	    buffer = extract(buffer, start)
	enddo
    end subroutine

    subroutine ask_tokens(tokens, iostat, prompt)
	type(STRING_LIST), intent(inout):: tokens
	integer, intent(out), optional:: iostat
	type(VSTRING), intent(in), optional:: prompt
	type(VSTRING):: line
    continue
	call ask(line, iostat=iostat, prompt=prompt)
	call get_tokens(line, tokens)
    end subroutine

end module