diff options
| -rw-r--r-- | dumb_render.f90 | 101 | ||||
| -rw-r--r-- | favicon.f90 | 111 | ||||
| -rw-r--r-- | gemini.prj | 10 | ||||
| -rw-r--r-- | main.F90 | 11 | ||||
| -rw-r--r-- | platform.F90 | 8 | ||||
| -rw-r--r-- | protocol.f90 | 11 | ||||
| -rw-r--r-- | render.f90 | 22 | ||||
| -rw-r--r-- | request.f90 | 16 | ||||
| -rw-r--r-- | snap/snapcraft.yaml | 2 |
9 files changed, 265 insertions, 27 deletions
diff --git a/dumb_render.f90 b/dumb_render.f90 index 64a3c40..31e7b9c 100644 --- a/dumb_render.f90 +++ b/dumb_render.f90 @@ -37,6 +37,8 @@ implicit none character(len=1024), dimension(height)::link_urls integer::first_line + + logical::is_utf8 contains @@ -76,14 +78,41 @@ implicit none procedure :: report_displayed_page => dumb_displayed_page + procedure :: prompt_user + procedure :: prompt_user_more + end type dumb_renderer contains + function len_trim_utf8(s) result(r) + use iso_c_binding + implicit none + + character(*), intent(in)::s + integer::r + + integer::cs + type(c_ptr)::cstr + + integer::i + + r = 0 + do i = 1,len_trim(s) + cs = ichar(s(i:i)) + if(iand(cs, 192) /= 128) then + r = r + 1 + end if + end do + + end function len_trim_utf8 + subroutine dumb_initialize(self) implicit none class(dumb_renderer)::self + character(len=32)::lang + integer::iostatus self%max_width = width self%y = 0 @@ -92,6 +121,15 @@ contains self%link_index = 0 self%link_urls = " " + self%is_utf8 = .FALSE. + call get_environment_variable("LANG", lang, status=iostatus) + if(iostatus == 0) then + self%is_utf8 = (index(lang, "utf-8") > 0 .or. & + index(lang, "UTF-8") > 0 .or. & + index(lang, "utf8") > 0 .or. & + index(lang, "UTF8") > 0) + end if + end subroutine dumb_initialize subroutine dumb_new_page(self) @@ -145,7 +183,11 @@ contains integer, intent(in), optional::text_type integer::dumb_text_width - dumb_text_width = len_trim(text) + if(self%is_utf8) then + dumb_text_width = len_trim_utf8(text) + else + dumb_text_width = len_trim(text) + end if if(present(text_type)) then if(text_type == proportional_type_list_item) then @@ -182,7 +224,11 @@ contains character(*), intent(in)::text integer::dumb_simple_width - dumb_simple_width = len_trim(text) + if(self%is_utf8) then + dumb_simple_width = len_trim_utf8(text) + else + dumb_simple_width = len_trim(text) + end if end function dumb_simple_width @@ -215,17 +261,34 @@ contains class(dumb_renderer)::self character(*), intent(in)::text - integer::limit_x - character(5)::formatting + integer::limit_x, w + character(6)::formatting + + if(self%is_utf8) then + w = len_trim_utf8(text) + else + w = len_trim(text) + end if + limit_x = len_trim(text) + + do while(w > self%max_width) + limit_x = limit_x - 1 + if(self%is_utf8) then + w = len_trim_utf8(text(1:limit_x)) + else + w = limit_x + end if + end do - limit_x = min(len_trim(text), self%max_width) if(limit_x == 0) then write(*,*) " " else if(limit_x < 10) then write(formatting, '(A2, I1, A1)') '(A', limit_x, ')' - else + else if(limit_x < 100) then write(formatting, '(A2, I2, A1)') '(A', limit_x, ')' + else + write(formatting, '(A2, I3, A1)') '(A', limit_x, ')' end if write(*, formatting) text(1:limit_x) @@ -389,22 +452,36 @@ contains end subroutine dumb_ready_status - subroutine prompt_user(input) + subroutine prompt_user(self, input) implicit none + class(dumb_renderer)::self character(*), intent(out)::input + + if(len_trim(self%favicon) > 0 .and. self%is_utf8) then + write(*, '(A4)', advance='no') self%favicon + else + write(*, '(A3)', advance='no') "***" + end if - write(*, '(A67)', advance='no') "*** [A]/[Z] PgUp/Dn | [#] Link | [B] Back | [M] More | [Q] Quit => " + write(*, '(1X, A63)', advance='no') "[A]/[Z] PgUp/Dn | [#] Link | [B] Back | [M] More | [Q] Quit => " read(*, *) input end subroutine prompt_user - subroutine prompt_user_more(input) + subroutine prompt_user_more(self, input) implicit none + class(dumb_renderer)::self character(*), intent(out)::input - write(*, '(A60)', advance='no') "*** [U] URL | [!] Save/Remove Fave | [L] Menu | [Q] Quit => " + if(len_trim(self%favicon) > 0 .and. self%is_utf8) then + write(*, '(A4)', advance='no') self%favicon + else + write(*, '(A3)', advance='no') "***" + end if + + write(*, '(1X, A56)', advance='no') "[U] URL | [!] Save/Remove Fave | [L] Menu | [Q] Quit => " read(*, *) input end subroutine prompt_user_more @@ -421,9 +498,9 @@ contains character(256)::input integer::link_id, iostatus - call prompt_user(input) + call prompt_user(self, input) if(trim(input) == 'M' .or. trim(input) == 'm') then - call prompt_user_more(input) + call prompt_user_more(self, input) end if if(len_trim(input) == 0) then diff --git a/favicon.f90 b/favicon.f90 new file mode 100644 index 0000000..6f800db --- /dev/null +++ b/favicon.f90 @@ -0,0 +1,111 @@ +module favicon +implicit none + + private + + public::get_favicon + +contains + + + subroutine get_server_favicon_file(server, filename) + use platform, only: dir_sep, get_settings_directory + implicit none + + character(*), intent(in)::server + character(*), intent(out)::filename + + character(len=256)::dir + + call get_settings_directory(dir) + filename = trim(dir)//dir_sep//trim(server)//".favicon.txt" + + end subroutine get_server_favicon_file + + function get_favicon_from_cache(server) result(f) + implicit none + + character(len=4)::f + character(*), intent(in)::server + character(len=384)::filename + + integer::unumber, iostatus + + call get_server_favicon_file(server, filename) + + f = ' ' + + open(newunit=unumber, file=filename, & + action="read", iostat=iostatus) + + if(iostatus == 0) then + ! second line + read(unumber, '(A)') f + if(trim(f) /= "NA") then + read(unumber, '(A)') f + end if + close(unumber) + end if + + end function get_favicon_from_cache + + function request_favicon(server) result(f) + use gemini_protocol, only: request_url, is_failure_code + implicit none + + character(len=4)::f + character(*), intent(in)::server + character(len=1024)::url + character(len=128)::return_type + + character(len=384)::cache_filename + + integer::return_code, unum, ios + + call get_server_favicon_file(server, cache_filename) + open(newunit=unum, file=cache_filename, action="write", iostat=ios) + if(ios == 0) then + + ! Per gemini://mozz.us/files/rfc_gemini_favicon.gmi + url = "gemini://"//trim(server)//"/favicon.txt" + + return_code = request_url(url, unum, return_type) + close(unum) + + if(is_failure_code(return_code)) then + open(newunit=unum, file=cache_filename, action="write", iostat=ios) + write(unum, '(A2,2X)') "NA" + close(unum) + end if + + f = get_favicon_from_cache(server) + + else + + f = ' ' + + end if + + end function request_favicon + + function get_favicon(server) result(f) + implicit none + + character(len=4)::f + character(*), intent(in)::server + + f = get_favicon_from_cache(server) + + ! Blank - request it + if(len_trim(f) == 0) then + f = request_favicon(server) + end if + + ! NA - server said no at some point + if(trim(f) == "NA") then + f = ' ' + end if + + end function get_favicon + +end module favicon @@ -35,6 +35,9 @@ "filename":"escape.f90", "enabled":"1" },{ + "filename":"favicon.f90", + "enabled":"1" + },{ "filename":"favorites.f90", "enabled":"1" },{ @@ -102,6 +105,7 @@ "Fortran Options":{ "Use C Preprocessor":"false", "Runtime Diagnostics":"false", + "Floating Point Exception Trap":0, "Cray Pointers":"false", "Enable Coarrays":"false", "Enable OpenMP":"false", @@ -114,18 +118,16 @@ "Aggressive Loops":"false", "Debugging":"true", "Optimization Mode":0, - "Floating Point Trap":"false", "Profiling":"false" }, "Build Dependencies":1, "Launch Options":{ - "Build Before Launch":"true", "Working Directory":"", "Launch Using MPI":"false", "Keep Console":"true", - "Executable":"", + "External Console":"false", "Command Line Arguments":"", - "External Console":"false" + "Build Before Launch":"true" }, "Build Options":{ "Makefile":"Makefile", @@ -48,11 +48,15 @@ use wsa_network, only: windows_network_startup => startup use favorite_handling +use favicon + implicit none character(256)::initial_site character(1024)::current_url, desired_url, input + character(1024)::server + #ifdef WINDOWS_GUI type(appgraphics_renderer)::r type(appgraphics_binary_handler)::bh @@ -150,6 +154,8 @@ implicit none if(.not. loaded) then + call r%clear_favicon() + call r%report_status("Requesting "//trim(desired_url)) return_code = request_url(desired_url, io, return_type, bh) @@ -179,6 +185,9 @@ implicit none desired_url = " " locations_visited => add_location(locations_visited, current_url) + + call get_server_from_url(current_url, server) + call r%set_favicon(get_favicon(server)) if(r%type_supported(return_type)) then @@ -260,6 +269,8 @@ implicit none call handle_relative_url(desired_url, input) end if + call r%clear_favicon() + loaded = .false. case (render_action_favorite) diff --git a/platform.F90 b/platform.F90 index 73200d2..a04b902 100644 --- a/platform.F90 +++ b/platform.F90 @@ -30,6 +30,8 @@ implicit none #endif character(*), parameter::favorites_file = "favorites.gmi" + + logical::first_pass_makedir = .false. contains @@ -38,6 +40,7 @@ contains implicit none character(*), intent(in)::dir + character(256)::cmd #ifdef WINDOWS character(kind=c_char, len=:), allocatable, target::passdir @@ -113,7 +116,10 @@ contains #endif ! Harmless - call make_directory(dir) + if(.not. first_pass_makedir) then + call make_directory(dir) + first_pass_makedir = .true. + end if end subroutine get_settings_directory diff --git a/protocol.f90 b/protocol.f90 index 613ca9f..d06d901 100644 --- a/protocol.f90 +++ b/protocol.f90 @@ -114,7 +114,7 @@ contains character(*), intent(inout)::url integer, intent(in)::unit_number character(*), intent(out)::return_type - class(binary_handler)::bh + class(binary_handler), optional::bh character(*), intent(in), optional::server_name integer::port @@ -144,6 +144,7 @@ contains server = server_name port = gemini_default_port else + allocate(character(len=len_trim(url)) :: server) call get_server_from_url(url, server, port) if(port < 0) then port = gemini_default_port @@ -185,8 +186,12 @@ contains call get_mimetype(response_line, return_type) binary_file = is_binary_file(return_type) - if(binary_file) then - binary_unit = bh%handle_binary(return_type, trim(url), binary_status) + if(binary_file ) then + if(present(bh)) then + binary_unit = bh%handle_binary(return_type, trim(url), binary_status) + else + binary_status = binary_ignore + end if end if else @@ -48,6 +48,7 @@ implicit none integer::y integer::max_width + character(4)::favicon contains @@ -55,6 +56,8 @@ implicit none procedure::type_supported procedure::status_ready procedure::report_unsupported_protocol + procedure::set_favicon + procedure::clear_favicon procedure(initialize), deferred::initialize procedure(prepare_for_layout), deferred::prepare_for_layout @@ -267,6 +270,25 @@ contains end function report_unsupported_protocol + subroutine set_favicon(self, f) + implicit none + + class(renderer)::self + character(*), intent(in)::f + + self%favicon = f + + end subroutine set_favicon + + subroutine clear_favicon(self) + implicit none + + class(renderer)::self + + self%favicon = " " + + end subroutine clear_favicon + function width_of_line(r, text, startpos, endpos, proportional_type) implicit none diff --git a/request.f90 b/request.f90 index 139b368..e9043c0 100644 --- a/request.f90 +++ b/request.f90 @@ -173,13 +173,14 @@ contains implicit none character(*), intent(in)::url - character(:), allocatable, intent(out)::server - integer, intent(out)::port + character(*), intent(out)::server + integer, intent(out), optional::port integer::start_server, end_server, length integer::start_port, iostatus + integer::myport - port = -1 + myport = -1 start_server = index(url, "://") if(start_server > 0) then @@ -194,7 +195,6 @@ contains end if length = end_server - start_server + 1 - allocate(character(len=length) :: server) server = url(start_server:end_server) end if @@ -203,14 +203,18 @@ contains start_port = index(server, ":") if(start_port > 0) then - read(server(start_port+1:len_trim(server)), *, iostat=iostatus) port + read(server(start_port+1:len_trim(server)), *, iostat=iostatus) myport if(iostatus /= 0) then - port = -1 + myport = -1 end if server = server(1:start_port-1) end if + + if(present(port)) then + port = myport + end if end subroutine get_server_from_url diff --git a/snap/snapcraft.yaml b/snap/snapcraft.yaml index 86da76c..9882b83 100644 --- a/snap/snapcraft.yaml +++ b/snap/snapcraft.yaml @@ -1,6 +1,6 @@ name: lr87 base: core18 -version: '0.11' +version: '0.12' summary: LR-87 is a overly simple dumb-terminal gemini client description: | LR-87 is a simple implementation of a client for launching into the world of the |