Fortran · 22658 bytes Raw Blame History
1 ! Progressive Scanner Module for Sniffly
2 ! Implements breadth-first scanning with idle callbacks for real-time treemap updates
3 module progressive_scanner
4 use, intrinsic :: iso_c_binding
5 use iso_fortran_env, only: int64
6 use types, only: file_node, rgb_color
7 implicit none
8 private
9
10 public :: start_progressive_scan, stop_progressive_scan, is_scan_active, &
11 get_scan_progress, register_scan_update_callback, register_scan_complete_callback, &
12 register_initial_level_complete_callback, set_show_hidden_files
13
14 ! Hidden files visibility setting
15 logical, save :: show_hidden_files = .true.
16
17 ! Scan queue entry
18 type :: queue_entry
19 character(len=512) :: path
20 integer :: node_index ! Index in parent's children array
21 integer :: parent_id ! ID to track parent (for tree building)
22 integer :: depth
23 end type queue_entry
24
25 ! Scan state
26 type :: scan_state_type
27 logical :: active
28 integer :: total_dirs_found
29 integer :: dirs_scanned
30 real :: progress ! 0.0 to 1.0
31
32 ! Queue for breadth-first scanning
33 type(queue_entry), dimension(10000) :: queue
34 integer :: queue_head
35 integer :: queue_tail
36 integer :: queue_size
37
38 ! Root node being built
39 type(file_node), pointer :: root => null()
40 character(len=512) :: root_path
41 end type scan_state_type
42
43 type(scan_state_type), save :: scan_state
44
45 ! Idle callback ID for cancellation
46 integer(c_int), save :: scan_idle_id = 0_c_int
47
48 ! Callback for scan updates (called after each directory is scanned)
49 abstract interface
50 subroutine scan_update_callback()
51 end subroutine scan_update_callback
52 end interface
53
54 ! Callback for scan completion
55 abstract interface
56 subroutine scan_complete_callback()
57 end subroutine scan_complete_callback
58 end interface
59
60 ! Callback for initial level (depth 0) completion
61 abstract interface
62 subroutine initial_level_callback()
63 end subroutine initial_level_callback
64 end interface
65
66 procedure(scan_update_callback), pointer, save :: update_callback => null()
67 procedure(scan_complete_callback), pointer, save :: complete_callback => null()
68 procedure(initial_level_callback), pointer, save :: initial_level_cb => null()
69
70 contains
71
72 ! Get current time in milliseconds (for flash timing)
73 function get_time_ms() result(time_ms)
74 integer(int64) :: time_ms
75 integer :: count, count_rate, count_max
76
77 call system_clock(count, count_rate, count_max)
78 ! Convert to milliseconds
79 time_ms = int(count * 1000_int64 / count_rate, int64)
80 end function get_time_ms
81
82 ! Register callback to be called after each scan update
83 subroutine register_scan_update_callback(callback)
84 procedure(scan_update_callback) :: callback
85 update_callback => callback
86 end subroutine register_scan_update_callback
87
88 ! Register callback to be called when scan completes
89 subroutine register_scan_complete_callback(callback)
90 procedure(scan_complete_callback) :: callback
91 complete_callback => callback
92 end subroutine register_scan_complete_callback
93
94 ! Register callback to be called when initial level (depth 0) completes
95 subroutine register_initial_level_complete_callback(callback)
96 procedure(initial_level_callback) :: callback
97 initial_level_cb => callback
98 end subroutine register_initial_level_complete_callback
99
100 ! Start progressive scan of a directory
101 subroutine start_progressive_scan(root_node, path)
102 use g, only: g_idle_add
103 type(file_node), target, intent(inout) :: root_node
104 character(len=*), intent(in) :: path
105 integer(c_int) :: idle_id
106
107 print *, "=== STARTING PROGRESSIVE SCAN ==="
108 print *, "Path: ", trim(path)
109
110 ! Initialize scan state
111 scan_state%active = .true.
112 scan_state%total_dirs_found = 1
113 scan_state%dirs_scanned = 0
114 scan_state%progress = 0.0
115 scan_state%queue_head = 1
116 scan_state%queue_tail = 0
117 scan_state%queue_size = 0
118 scan_state%root => root_node
119 scan_state%root_path = trim(path)
120
121 ! Initialize root node
122 root_node%path = trim(path)
123 root_node%name = extract_filename(path)
124 root_node%is_directory = .true.
125 root_node%scan_complete = .false.
126 root_node%is_scanning = .true.
127 root_node%estimated_size = 0_int64
128 root_node%size = 0_int64
129 root_node%num_children = 0
130
131 ! Enqueue root directory
132 call enqueue(path, 0, 0, 0)
133
134 ! Register idle callback to process queue
135 print *, "Registering idle callback for progressive scanning"
136 idle_id = g_idle_add(c_funloc(scan_one_directory_idle), c_null_ptr)
137 scan_idle_id = idle_id
138 print *, "Idle callback registered with ID:", scan_idle_id
139 end subroutine start_progressive_scan
140
141 ! Stop the current scan
142 subroutine stop_progressive_scan()
143 use g, only: g_source_remove
144 integer(c_int) :: result
145 print *, "=== STOPPING PROGRESSIVE SCAN ==="
146 scan_state%active = .false.
147 scan_state%queue_size = 0
148 scan_state%root => null()
149
150 ! Cancel the idle callback if it's still registered
151 if (scan_idle_id /= 0) then
152 print *, "Canceling idle callback ID:", scan_idle_id
153 result = g_source_remove(scan_idle_id)
154 if (result == 1_c_int) then
155 print *, "Successfully canceled idle callback"
156 else
157 print *, "Failed to cancel idle callback (may have already completed)"
158 end if
159 scan_idle_id = 0_c_int
160 else
161 print *, "No idle callback to cancel (ID was 0)"
162 end if
163 end subroutine stop_progressive_scan
164
165 ! Check if a scan is currently active
166 function is_scan_active() result(active)
167 logical :: active
168 active = scan_state%active
169 end function is_scan_active
170
171 ! Get current scan progress (0.0 to 1.0)
172 function get_scan_progress() result(progress)
173 real :: progress
174 if (scan_state%total_dirs_found > 0) then
175 progress = real(scan_state%dirs_scanned) / real(scan_state%total_dirs_found)
176 else
177 progress = 0.0
178 end if
179 end function get_scan_progress
180
181 ! Idle callback - scan one directory per call
182 function scan_one_directory_idle(user_data) bind(c) result(continue)
183 type(c_ptr), value :: user_data
184 integer(c_int) :: continue
185 type(queue_entry) :: entry
186
187 ! Check if we should stop
188 if (.not. scan_state%active .or. scan_state%queue_size == 0) then
189 print *, "Progressive scan complete or stopped"
190 scan_state%active = .false.
191 scan_idle_id = 0_c_int ! Clear idle ID since callback is stopping
192 if (associated(scan_state%root)) then
193 scan_state%root%scan_complete = .true.
194 scan_state%root%is_scanning = .false.
195 end if
196 ! Call completion callback
197 if (associated(complete_callback)) then
198 call complete_callback()
199 end if
200 continue = 0_c_int ! Stop calling
201 return
202 end if
203
204 ! Dequeue next directory
205 entry = dequeue()
206
207 ! Scan the directory (pass the parent_id which tracks the root child index)
208 call scan_single_directory(entry%path, entry%depth, entry%parent_id)
209
210 scan_state%dirs_scanned = scan_state%dirs_scanned + 1
211 scan_state%progress = get_scan_progress()
212
213 ! Check if we should stop before calling UI update callback
214 if (.not. scan_state%active) then
215 print *, "Progressive scan stopped - skipping callback"
216 scan_idle_id = 0_c_int
217 continue = 0_c_int
218 return
219 end if
220
221 ! Trigger update callback (only if still active)
222 if (associated(update_callback)) then
223 call update_callback()
224 end if
225
226 ! Check again if we should stop (app might have closed during callback)
227 if (.not. scan_state%active) then
228 print *, "Progressive scan stopped mid-callback"
229 scan_idle_id = 0_c_int
230 continue = 0_c_int
231 return
232 end if
233
234 ! Continue if there are more directories
235 if (scan_state%queue_size > 0) then
236 continue = 1_c_int ! Keep calling
237 else
238 print *, "Progressive scan complete!"
239 scan_state%active = .false.
240 scan_idle_id = 0_c_int ! Clear idle ID since scan is done
241 if (associated(scan_state%root)) then
242 scan_state%root%scan_complete = .true.
243 scan_state%root%is_scanning = .false.
244
245 ! Now that all sizes have been accumulated, group small files
246 print *, "Grouping small files after scan completion..."
247 call group_small_files_root()
248 end if
249 ! Call completion callback
250 if (associated(complete_callback)) then
251 call complete_callback()
252 end if
253 continue = 0_c_int ! Stop calling
254 end if
255 end function scan_one_directory_idle
256
257 ! Scan a single directory and enqueue its subdirectories
258 subroutine scan_single_directory(path, depth, root_child_index)
259 use file_system, only: list_directory, is_directory, get_file_size, is_symlink
260 character(len=*), intent(in) :: path
261 integer, intent(in) :: depth, root_child_index
262 character(len=256), dimension(10000) :: entries
263 character(len=512) :: child_path
264 integer :: num_entries, i, child_count
265 integer(int64) :: file_size
266 type(file_node), dimension(:), allocatable :: temp_children
267
268 ! Check if scan has been stopped before doing any work
269 if (.not. scan_state%active) return
270
271 print *, "Scanning: ", trim(path), " (depth=", depth, ")"
272
273 ! List directory contents
274 num_entries = list_directory(path, entries, 10000)
275 print *, " Found ", num_entries, " entries"
276
277 ! Check again after potentially slow list_directory call
278 if (.not. scan_state%active) return
279 if (.not. associated(scan_state%root)) return
280
281 ! For root directory (depth 0), build the children array
282 if (depth == 0) then
283 ! Count valid entries (non-symlinks, respect hidden file setting)
284 child_count = 0
285 do i = 1, num_entries
286 ! Check if scan was stopped (allows quick exit)
287 if (.not. scan_state%active) return
288 if (len_trim(entries(i)) == 0) cycle
289 ! Skip hidden files if show_hidden_files is false
290 if (.not. show_hidden_files .and. is_hidden_file(entries(i))) cycle
291 child_path = trim(path) // "/" // trim(entries(i))
292 if (.not. is_symlink(child_path)) then
293 child_count = child_count + 1
294 end if
295 end do
296
297 print *, " Creating ", child_count, " child nodes for root"
298
299 ! Allocate children array for root
300 if (child_count > 0) then
301 allocate(temp_children(child_count))
302 child_count = 0
303
304 ! Create child nodes and track which array index each child gets
305 do i = 1, num_entries
306 ! Check if scan was stopped (allows quick exit)
307 if (.not. scan_state%active) then
308 if (allocated(temp_children)) deallocate(temp_children)
309 return
310 end if
311 if (len_trim(entries(i)) == 0) cycle
312 ! Skip hidden files if show_hidden_files is false
313 if (.not. show_hidden_files .and. is_hidden_file(entries(i))) cycle
314 child_path = trim(path) // "/" // trim(entries(i))
315 if (is_symlink(child_path)) cycle
316
317 child_count = child_count + 1
318 temp_children(child_count)%name = trim(entries(i))
319 temp_children(child_count)%path = trim(child_path)
320 temp_children(child_count)%is_directory = is_directory(child_path)
321
322 if (temp_children(child_count)%is_directory) then
323 ! Directory - will be scanned later
324 temp_children(child_count)%size = 0_int64
325 temp_children(child_count)%num_children = 0
326 temp_children(child_count)%scan_complete = .false.
327 temp_children(child_count)%is_scanning = .true.
328 ! Enqueue subdirectory - pass the ACTUAL array index (child_count) as root_child_index
329 print *, " Enqueueing ", trim(entries(i)), " as root child index ", child_count
330 call enqueue(child_path, child_count, child_count, depth + 1)
331 scan_state%total_dirs_found = scan_state%total_dirs_found + 1
332 else
333 ! File - get size immediately
334 file_size = get_file_size(child_path)
335 temp_children(child_count)%size = file_size
336 temp_children(child_count)%num_children = 0
337 temp_children(child_count)%scan_complete = .true.
338 temp_children(child_count)%is_scanning = .false.
339 ! Add to root's total
340 scan_state%root%estimated_size = scan_state%root%estimated_size + file_size
341 scan_state%root%size = scan_state%root%estimated_size
342 end if
343 end do
344
345 ! Assign children to root
346 if (allocated(scan_state%root%children)) deallocate(scan_state%root%children)
347 allocate(scan_state%root%children(child_count))
348 scan_state%root%children = temp_children
349 scan_state%root%num_children = child_count
350 deallocate(temp_children)
351
352 print *, " Root now has ", scan_state%root%num_children, " children"
353
354 ! DEBUG: Print first 10 directory children to verify indexing
355 do i = 1, min(20, scan_state%root%num_children)
356 if (scan_state%root%children(i)%is_directory) then
357 print *, " Child ", i, ": ", trim(scan_state%root%children(i)%name), " (directory)"
358 end if
359 end do
360
361 ! Color the tree before showing it (don't group yet - sizes are still accumulating)
362 call color_root_children()
363
364 ! Call initial level callback (so UI can start rendering)
365 if (associated(initial_level_cb)) then
366 print *, "Initial level scan complete - notifying callback"
367 call initial_level_cb()
368 end if
369 end if
370 else
371 ! For subdirectories (depth > 0), accumulate sizes by matching path prefixes
372 do i = 1, num_entries
373 ! Check if scan was stopped (allows quick exit)
374 if (.not. scan_state%active) return
375 if (len_trim(entries(i)) == 0) cycle
376 ! Skip hidden files if show_hidden_files is false
377 if (.not. show_hidden_files .and. is_hidden_file(entries(i))) cycle
378 child_path = trim(path) // "/" // trim(entries(i))
379 if (is_symlink(child_path)) cycle
380
381 if (is_directory(child_path)) then
382 ! Enqueue subdirectory for later scanning - propagate root child index
383 call enqueue(child_path, 0, root_child_index, depth + 1)
384 scan_state%total_dirs_found = scan_state%total_dirs_found + 1
385 else
386 ! It's a file - find which root child it belongs to by path matching
387 file_size = get_file_size(child_path)
388
389 ! Find the root child whose path is a prefix of this file's path
390 call find_and_update_root_child(child_path, file_size)
391
392 ! Also update root total
393 scan_state%root%estimated_size = scan_state%root%estimated_size + file_size
394 scan_state%root%size = scan_state%root%estimated_size
395 end if
396 end do
397 end if
398 end subroutine scan_single_directory
399
400 ! Find which root child a file belongs to and update its size
401 subroutine find_and_update_root_child(file_path, file_size)
402 character(len=*), intent(in) :: file_path
403 integer(int64), intent(in) :: file_size
404 integer :: root_idx
405 integer :: path_len, child_path_len
406 logical :: found
407
408 if (.not. associated(scan_state%root)) return
409 if (scan_state%root%num_children == 0) return
410
411 found = .false.
412
413 ! Try to find a root child whose path is a prefix of this file's path
414 do root_idx = 1, scan_state%root%num_children
415 if (.not. scan_state%root%children(root_idx)%is_directory) cycle
416
417 child_path_len = len_trim(scan_state%root%children(root_idx)%path)
418 path_len = len_trim(file_path)
419
420 ! Check if child path is a prefix of file path
421 ! Also ensure we match directory boundaries (check for '/' after the prefix)
422 if (path_len > child_path_len) then
423 if (file_path(1:child_path_len) == scan_state%root%children(root_idx)%path(1:child_path_len)) then
424 ! Ensure we're matching at a directory boundary
425 if (file_path(child_path_len+1:child_path_len+1) == '/') then
426 ! Found the matching root child!
427 scan_state%root%children(root_idx)%size = &
428 scan_state%root%children(root_idx)%size + file_size
429
430 ! Mark node for flash highlighting
431 scan_state%root%children(root_idx)%flash_intensity = 1.0d0
432 scan_state%root%children(root_idx)%last_update_time = get_time_ms()
433
434 if (scan_state%dirs_scanned < 5) then
435 print *, " Path-matched: ", trim(file_path), " -> root child ", root_idx, &
436 " (", trim(scan_state%root%children(root_idx)%name), ")"
437 end if
438 found = .true.
439 exit
440 end if
441 end if
442 end if
443 end do
444
445 if (.not. found .and. scan_state%dirs_scanned < 5) then
446 print *, " WARNING: No root child found for: ", trim(file_path)
447 end if
448 end subroutine find_and_update_root_child
449
450 ! Enqueue a directory for scanning
451 subroutine enqueue(path, node_index, parent_id, depth)
452 character(len=*), intent(in) :: path
453 integer, intent(in) :: node_index, parent_id, depth
454
455 if (scan_state%queue_size >= 10000) then
456 print *, "WARNING: Queue full! Skipping: ", trim(path)
457 return
458 end if
459
460 scan_state%queue_tail = scan_state%queue_tail + 1
461 if (scan_state%queue_tail > 10000) scan_state%queue_tail = 1
462
463 scan_state%queue(scan_state%queue_tail)%path = trim(path)
464 scan_state%queue(scan_state%queue_tail)%node_index = node_index
465 scan_state%queue(scan_state%queue_tail)%parent_id = parent_id
466 scan_state%queue(scan_state%queue_tail)%depth = depth
467 scan_state%queue_size = scan_state%queue_size + 1
468 end subroutine enqueue
469
470 ! Dequeue next directory
471 function dequeue() result(entry)
472 type(queue_entry) :: entry
473
474 if (scan_state%queue_size == 0) then
475 entry%path = ""
476 return
477 end if
478
479 entry = scan_state%queue(scan_state%queue_head)
480 scan_state%queue_head = scan_state%queue_head + 1
481 if (scan_state%queue_head > 10000) scan_state%queue_head = 1
482 scan_state%queue_size = scan_state%queue_size - 1
483 end function dequeue
484
485 ! Extract filename from path
486 pure function extract_filename(path) result(filename)
487 character(len=*), intent(in) :: path
488 character(len=:), allocatable :: filename
489 integer :: i, last_slash
490
491 last_slash = 0
492 do i = len_trim(path), 1, -1
493 if (path(i:i) == '/' .or. path(i:i) == '\') then
494 last_slash = i
495 exit
496 end if
497 end do
498
499 if (last_slash > 0) then
500 filename = trim(path(last_slash+1:))
501 else
502 filename = trim(path)
503 end if
504 end function extract_filename
505
506 ! Apply colors to root's children based on file type
507 subroutine color_root_children()
508 use iso_fortran_env, only: real64
509 integer :: i, dot_pos
510 character(len=256) :: extension
511 real(real64) :: hue
512 integer :: j
513
514 if (.not. associated(scan_state%root)) return
515 if (.not. allocated(scan_state%root%children)) return
516
517 do i = 1, scan_state%root%num_children
518 if (scan_state%root%children(i)%is_directory) then
519 ! Directory - use blue
520 scan_state%root%children(i)%color%r = 0.4d0
521 scan_state%root%children(i)%color%g = 0.6d0
522 scan_state%root%children(i)%color%b = 0.9d0
523 else
524 ! File - determine color by extension
525 extension = ""
526 dot_pos = 0
527 do j = len_trim(scan_state%root%children(i)%name), 1, -1
528 if (scan_state%root%children(i)%name(j:j) == '.') then
529 dot_pos = j
530 exit
531 end if
532 end do
533
534 if (dot_pos > 0) then
535 extension = scan_state%root%children(i)%name(dot_pos+1:)
536 end if
537
538 ! Color by file type
539 select case (trim(extension))
540 case ('jpg', 'jpeg', 'png', 'gif', 'bmp', 'svg', 'ico', 'webp')
541 hue = 300.0d0 ! Magenta for images
542 case ('mp3', 'wav', 'flac', 'ogg', 'aac', 'm4a')
543 hue = 180.0d0 ! Cyan for audio
544 case ('mp4', 'avi', 'mkv', 'mov', 'wmv', 'flv')
545 hue = 270.0d0 ! Purple for video
546 case ('pdf', 'doc', 'docx', 'txt', 'odt', 'rtf')
547 hue = 30.0d0 ! Orange for documents
548 case ('zip', 'tar', 'gz', 'rar', '7z', 'bz2', 'xz')
549 hue = 60.0d0 ! Yellow for archives
550 case ('exe', 'dll', 'so', 'app', 'dmg', 'pkg')
551 hue = 0.0d0 ! Red for executables
552 case ('c', 'cpp', 'h', 'hpp', 'f90', 'f95', 'py', 'java', 'js')
553 hue = 120.0d0 ! Green for source code
554 case ('iso', 'img')
555 hue = 330.0d0 ! Pink for disk images
556 case default
557 hue = 200.0d0 ! Light blue for other files
558 end select
559
560 call set_color_from_hsv(scan_state%root%children(i)%color, hue, 0.7d0, 0.9d0)
561 end if
562 end do
563 end subroutine color_root_children
564
565 ! Convert HSV to RGB and set color
566 subroutine set_color_from_hsv(color, h, s, v)
567 use iso_fortran_env, only: real64
568 type(rgb_color), intent(out) :: color
569 real(real64), intent(in) :: h, s, v
570 real(real64) :: c, x, m, h_prime
571 integer :: h_i
572
573 c = v * s
574 h_prime = h / 60.0d0
575 h_i = int(h_prime)
576 x = c * (1.0d0 - abs(mod(h_prime, 2.0d0) - 1.0d0))
577 m = v - c
578
579 select case (h_i)
580 case (0)
581 color%r = c + m; color%g = x + m; color%b = m
582 case (1)
583 color%r = x + m; color%g = c + m; color%b = m
584 case (2)
585 color%r = m; color%g = c + m; color%b = x + m
586 case (3)
587 color%r = m; color%g = x + m; color%b = c + m
588 case (4)
589 color%r = x + m; color%g = m; color%b = c + m
590 case default
591 color%r = c + m; color%g = m; color%b = x + m
592 end select
593 end subroutine set_color_from_hsv
594
595 ! Group small files at root level
596 subroutine group_small_files_root()
597 use disk_scanner, only: group_small_files
598
599 if (.not. associated(scan_state%root)) return
600 call group_small_files(scan_state%root)
601 end subroutine group_small_files_root
602
603 ! Set whether to show hidden files (dotfiles)
604 subroutine set_show_hidden_files(show)
605 logical, intent(in) :: show
606 show_hidden_files = show
607 print *, "Progressive scanner: show_hidden_files = ", show_hidden_files
608 end subroutine set_show_hidden_files
609
610 ! Check if a filename is hidden (starts with '.')
611 pure function is_hidden_file(filename) result(is_hidden)
612 character(len=*), intent(in) :: filename
613 logical :: is_hidden
614
615 is_hidden = .false.
616 if (len_trim(filename) > 0) then
617 if (filename(1:1) == '.') then
618 is_hidden = .true.
619 end if
620 end if
621 end function is_hidden_file
622
623 end module progressive_scanner
624