aboutsummaryrefslogtreecommitdiff
path: root/favorites.f90
diff options
context:
space:
mode:
Diffstat (limited to 'favorites.f90')
-rw-r--r--favorites.f9036
1 files changed, 32 insertions, 4 deletions
diff --git a/favorites.f90 b/favorites.f90
index 90cd2d1..425930d 100644
--- a/favorites.f90
+++ b/favorites.f90
@@ -4,7 +4,8 @@ implicit none
private
public :: favorite, sort_added, sort_alpha, read_favorites, &
- write_favorites, add_favorite, remove_favorite
+ write_favorites, add_favorite, remove_favorite, &
+ is_favorite
type :: favorite
@@ -195,14 +196,22 @@ contains
character(80)::temp
integer::n, i, ios
+ faves => null()
+
! Title
- read(unit_number, *) temp
+ read(unit_number, *, iostat=ios) temp
+ if(ios /= 0) then
+ return
+ end if
! Blank
!read(unit_number, *) temp
! Count
- read(unit_number, *) n
+ read(unit_number, *, iostat=ios) n
+ if(ios /= 0) then
+ return
+ end if
! Blank
!read(unit_number, *) temp
@@ -234,7 +243,7 @@ contains
implicit none
integer, intent(in)::unit_number
- type(favorite), dimension(:), intent(in)::faves
+ type(favorite), dimension(:), intent(in), pointer::faves
logical, intent(in), optional::skip_heading
integer::i
@@ -250,6 +259,10 @@ contains
write(unit_number, *)
end if
+ if(.not.associated(faves)) then
+ return
+ end if
+
write(n_text, '(I8)') size(faves)
write(unit_number, *) trim(adjustl(n_text))//" Links Are Marked As Favorites"
@@ -367,4 +380,19 @@ contains
end subroutine remove_favorite
+ function is_favorite(faves, link)
+ implicit none
+
+ type(favorite), dimension(:), intent(in), pointer::faves
+ character(*), intent(in)::link
+ logical::is_favorite
+
+ is_favorite = .false.
+
+ if(associated(faves)) then
+ is_favorite = (find_favorite(faves, link) > 0)
+ end if
+
+ end function is_favorite
+
end module favorite_handling \ No newline at end of file