! Copyright (c) 2020 Jeffrey Armstrong ! ! Permission is hereby granted, free of charge, to any person obtaining a copy ! of this software and associated documentation files (the "Software"), to deal ! in the Software without restriction, including without limitation the rights ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ! copies of the Software, and to permit persons to whom the Software is ! furnished to do so, subject to the following conditions: ! ! The above copyright notice and this permission notice shall be included in ! all copies or substantial portions of the Software. ! ! The Software shall be used for Good, not Evil. ! ! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ! SOFTWARE. module file_handling integer, parameter::file_type_plain_text = 1 integer, parameter::file_type_gemini = 2 character(17), parameter::end_indicator = "** END OF FILE **" contains subroutine mark_file_end(unit_number) implicit none integer, intent(in)::unit_number Write(unit_number, '(A1)', advance='no') new_line('a') Write(unit_number, '(A17)') end_indicator end subroutine mark_file_end function is_file_end_marker(text) implicit none character(*), intent(in)::text logical::is_file_end_marker is_file_end_marker = (index(text, end_indicator) > 0) end function is_file_end_marker subroutine skip_line(unit_number) implicit none integer, intent(in)::unit_number character::c integer::iostatus read(unit_number, '(A1)', advance='no', iostat=iostatus) c do while(c /= CHAR(10) .AND. iostatus == 0) read(unit_number, '(A1)', advance='no', iostat=iostatus) c end do end subroutine skip_line subroutine read_line_text(unit_number, res, iostatus) implicit none character(len=:), allocatable, intent(out)::res integer, intent(in)::unit_number integer, intent(out)::iostatus integer::startpos, endpos, length, i character::c inquire(unit=unit_number, pos=startpos) endpos = startpos read(unit_number, '(A1)', advance='no', iostat=iostatus) c do while(c /= CHAR(10) .AND. iostatus == 0) endpos = endpos + 1 read(unit_number, '(A1)', advance='no', iostat=iostatus) c end do length = (endpos - startpos + 1) !print '(A10, I8)', "allocated", length allocate(character(len=length) :: res) res = repeat(' ', length) ! Rewind seems necessary, especially on non-Windows... rewind(unit_number) read(unit_number, '(A1)', pos=startpos, advance='no', iostat=iostatus) c if(iostatus == 0) then res(1:1) = c do i=2, length read(unit_number, '(A1)', advance='no', iostat=iostatus) c if(iostatus /= 0) then exit end if res(i:i) = c end do end if end subroutine read_line_text subroutine replace_tabs(text) implicit none character(*), intent(inout)::text integer::i i = index(text, char(9)) do while(i > 0) text(i:i) = ' ' i = index(text, char(9)) end do end subroutine replace_tabs subroutine process_line(single_line, file_type, preformatted_on) use layout implicit none type(line), intent(inout)::single_line integer, intent(in)::file_type logical, intent(inout)::preformatted_on integer::line_length if(file_type == file_type_plain_text) then single_line%line_type = line_type_preformatted preformatted_on = .TRUE. else if(file_type == file_type_gemini) then line_length = len_trim(single_line%text) if((.not. preformatted_on) .AND. line_length > 2 .AND. & single_line%text(1:2) == "=>") then single_line%line_type = line_type_link single_line%text(1:2) = " " call replace_tabs(single_line%text) single_line%text = adjustl(single_line%text) else if(line_length >= 3 .AND. single_line%text(1:3) == "```") then preformatted_on = .not. preformatted_on single_line%line_type = line_type_indicator else if(preformatted_on) then single_line%line_type = line_type_preformatted else single_line%line_type = line_type_text end if end if end subroutine process_line function load_unit(unit_number, file_type) result(first_line) use layout implicit none integer, intent(in)::unit_number, file_type type(line), pointer::first_line type(line), pointer::walker, next_line integer::iostatus logical::preformatted_on preformatted_on = .FALSE. allocate(first_line) ! Skip the first line - it has the status code rewind(unit_number) call skip_line(unit_number) call read_line_text(unit_number, first_line%text, iostatus) first_line%next => null() first_line%breaks => null() walker=>first_line do while(iostatus /= -1 .and. .not. is_file_end_marker(walker%text)) ! -1 should be end of file call process_line(walker, file_type, preformatted_on) allocate(next_line) next_line%next => null() next_line%breaks => null() walker%next => next_line next_line => null() walker => walker%next call read_line_text(unit_number, walker%text, iostatus) end do end function load_unit function load_filename(filename, iostatus, mimetype) result(first_line) use layout, only: line implicit none character(*), intent(in)::filename integer, intent(out)::iostatus character(*), intent(in), optional::mimetype type(line), pointer::first_line integer::filetype open(unit=1097, file=filename, access='stream', iostat=iostatus, form='FORMATTED') if(iostatus == 0) then if(present(mimetype)) then if(trim(mimetype) == 'text/gemini') then filetype = file_type_gemini else filetype = file_type_plain_text end if else filetype = file_type_plain_text end if first_line => load_unit(1097, filetype) end if end function load_filename end module file_handling