Fortran · 12590 bytes Raw Blame History
1 program fortress_clean
2 use iso_fortran_env, only: output_unit, error_unit
3 implicit none
4
5 ! Constants
6 integer, parameter :: MAX_PATH = 512
7 integer, parameter :: MAX_FILES = 500
8
9 character(len=*), parameter :: ESC = char(27)
10 character(len=*), parameter :: CLEAR = ESC // "[2J" // ESC // "[H"
11 character(len=*), parameter :: BOLD = ESC // "[1m"
12 character(len=*), parameter :: DIM = ESC // "[2m"
13 character(len=*), parameter :: REVERSE = ESC // "[7m"
14 character(len=*), parameter :: RESET = ESC // "[0m"
15 character(len=*), parameter :: BLUE = ESC // "[34m"
16 character(len=*), parameter :: GREEN = ESC // "[32m"
17 character(len=*), parameter :: GREY = ESC // "[90m"
18 character(len=*), parameter :: WHITE = ESC // "[37m"
19
20 ! Variables
21 character(len=MAX_PATH) :: current_dir, parent_dir, temp_dir
22 character(len=MAX_PATH), dimension(MAX_FILES) :: current_files, parent_files
23 logical, dimension(MAX_FILES) :: current_is_dir, parent_is_dir
24 logical, dimension(MAX_FILES) :: current_is_exec, parent_is_exec
25 integer :: current_count, parent_count
26 integer :: selected = 1
27 integer :: parent_selected = -1
28 character(len=1) :: key
29 logical :: running = .true.
30 logical :: cd_on_exit = .false.
31 character(len=MAX_PATH) :: exit_dir
32 integer :: i, rows, cols
33
34 ! Initialize
35 current_dir = get_pwd()
36 parent_dir = get_parent_path(current_dir)
37
38 ! Setup terminal
39 call execute_command_line("stty -icanon -echo min 1 time 0 2>/dev/null")
40
41 ! Main loop
42 do while (running)
43 ! Get files
44 call get_file_list(current_dir, current_files, current_is_dir, current_is_exec, current_count)
45 call get_file_list(parent_dir, parent_files, parent_is_dir, parent_is_exec, parent_count)
46
47 ! Find current dir in parent
48 parent_selected = find_in_parent(current_dir, parent_files, parent_count)
49
50 ! Get terminal size
51 call get_term_size(rows, cols)
52
53 ! Draw interface
54 write(output_unit, '(a)', advance='no') CLEAR
55 call draw_interface(rows, cols)
56
57 ! Get input
58 read(*, '(a1)', advance='no') key
59
60 ! Handle input
61 select case(ichar(key))
62 case(27) ! ESC sequence
63 call read_arrow_key(key)
64 select case(key)
65 case('A') ! Up
66 if (selected > 1) selected = selected - 1
67 case('B') ! Down
68 if (selected < current_count) selected = selected + 1
69 case('C') ! Right - enter
70 if (current_is_dir(selected)) then
71 if (trim(current_files(selected)) == "..") then
72 temp_dir = current_dir
73 current_dir = parent_dir
74 parent_dir = get_parent_path(current_dir)
75 selected = max(1, find_in_parent(temp_dir, current_files, MAX_FILES))
76 else if (trim(current_files(selected)) /= ".") then
77 parent_dir = current_dir
78 current_dir = join_path(current_dir, current_files(selected))
79 selected = 1
80 end if
81 end if
82 case('D') ! Left - back
83 if (current_dir /= "/") then
84 temp_dir = current_dir
85 current_dir = parent_dir
86 parent_dir = get_parent_path(current_dir)
87 selected = max(1, find_in_parent(temp_dir, current_files, MAX_FILES))
88 end if
89 end select
90 case(113, 81) ! 'q' or 'Q'
91 running = .false.
92 case(99, 67) ! 'c' or 'C' - cd to directory on exit
93 if (current_is_dir(selected)) then
94 if (trim(current_files(selected)) == "..") then
95 exit_dir = parent_dir
96 else if (trim(current_files(selected)) == ".") then
97 exit_dir = current_dir
98 else
99 exit_dir = join_path(current_dir, current_files(selected))
100 end if
101 cd_on_exit = .true.
102 running = .false.
103 end if
104 end select
105 end do
106
107 ! Cleanup
108 call execute_command_line("stty icanon echo 2>/dev/null")
109 write(output_unit, '(a)', advance='no') CLEAR
110
111 ! If cd_on_exit is set, write the directory to a temp file
112 if (cd_on_exit) then
113 call write_exit_dir(exit_dir)
114 else
115 write(output_unit, '(a)') "Thanks for using FORTRESS!"
116 end if
117
118 contains
119
120 function get_pwd() result(path)
121 character(len=MAX_PATH) :: path
122 integer :: unit, ios
123
124 call execute_command_line("pwd > .fortress_pwd 2>/dev/null", wait=.true.)
125 open(newunit=unit, file=".fortress_pwd", status='old', iostat=ios)
126 if (ios == 0) then
127 read(unit, '(a)') path
128 close(unit)
129 else
130 path = "."
131 end if
132 call execute_command_line("rm -f .fortress_pwd 2>/dev/null")
133 end function get_pwd
134
135 function get_parent_path(path) result(parent)
136 character(len=*), intent(in) :: path
137 character(len=MAX_PATH) :: parent
138 integer :: pos
139
140 pos = index(path, "/", back=.true.)
141 if (pos > 1) then
142 parent = path(1:pos-1)
143 else if (pos == 1) then
144 parent = "/"
145 else
146 parent = "."
147 end if
148 end function get_parent_path
149
150 function join_path(base, name) result(full)
151 character(len=*), intent(in) :: base, name
152 character(len=MAX_PATH) :: full
153
154 if (base == "/") then
155 full = "/" // trim(name)
156 else
157 full = trim(base) // "/" // trim(name)
158 end if
159 end function join_path
160
161 function find_in_parent(dir, files, count) result(idx)
162 character(len=*), intent(in) :: dir
163 character(len=*), dimension(*), intent(in) :: files
164 integer, intent(in) :: count
165 integer :: idx, pos
166 character(len=256) :: basename
167
168 pos = index(dir, "/", back=.true.)
169 if (pos > 0) then
170 basename = dir(pos+1:)
171 else
172 basename = dir
173 end if
174
175 do idx = 1, count
176 if (trim(files(idx)) == trim(basename)) return
177 end do
178 idx = 1
179 end function find_in_parent
180
181 subroutine get_file_list(dir, files, is_dir, is_exec, count)
182 character(len=*), intent(in) :: dir
183 character(len=*), dimension(*), intent(out) :: files
184 logical, dimension(*), intent(out) :: is_dir, is_exec
185 integer, intent(out) :: count
186 integer :: unit, ios, stat
187 character(len=MAX_PATH) :: fullpath
188
189 call execute_command_line("ls -1a '" // trim(dir) // "' > .fortress_ls 2>/dev/null", wait=.true.)
190
191 open(newunit=unit, file=".fortress_ls", status='old', iostat=ios)
192 if (ios /= 0) then
193 count = 0
194 return
195 end if
196
197 count = 0
198 do
199 count = count + 1
200 if (count > MAX_FILES) exit
201 read(unit, '(a)', iostat=ios) files(count)
202 if (ios /= 0) then
203 count = count - 1
204 exit
205 end if
206
207 fullpath = join_path(dir, files(count))
208 call execute_command_line("test -d '" // trim(fullpath) // "'", exitstat=stat, wait=.true.)
209 is_dir(count) = (stat == 0)
210
211 ! Check if executable (but not directories)
212 if (.not. is_dir(count)) then
213 call execute_command_line("test -x '" // trim(fullpath) // "'", exitstat=stat, wait=.true.)
214 is_exec(count) = (stat == 0)
215 else
216 is_exec(count) = .false.
217 end if
218 end do
219
220 close(unit)
221 call execute_command_line("rm -f .fortress_ls 2>/dev/null")
222 end subroutine get_file_list
223
224 subroutine get_term_size(r, c)
225 integer, intent(out) :: r, c
226 integer :: unit, ios
227
228 call execute_command_line("tput lines > .fortress_size 2>/dev/null", wait=.true.)
229 open(newunit=unit, file=".fortress_size", status='old', iostat=ios)
230 if (ios == 0) then
231 read(unit, *) r
232 close(unit)
233 else
234 r = 24
235 end if
236
237 call execute_command_line("tput cols > .fortress_size 2>/dev/null", wait=.true.)
238 open(newunit=unit, file=".fortress_size", status='old', iostat=ios)
239 if (ios == 0) then
240 read(unit, *) c
241 close(unit)
242 else
243 c = 80
244 end if
245
246 call execute_command_line("rm -f .fortress_size 2>/dev/null")
247 end subroutine get_term_size
248
249 subroutine draw_interface(r, c)
250 integer, intent(in) :: r, c
251 integer :: left_w, i
252 character(len=256) :: fname
253 character(len=20) :: color_code
254
255 left_w = c * 3 / 10
256
257 ! Header
258 write(output_unit, '(a)') BOLD // "FORTRESS" // RESET // " - " // trim(current_dir)
259
260 ! Files
261 do i = 1, min(r-3, max(parent_count, current_count))
262 ! Parent pane
263 if (i <= parent_count) then
264 fname = parent_files(i)
265 if (parent_is_dir(i) .and. fname /= "." .and. fname /= "..") then
266 fname = trim(fname) // "/"
267 end if
268
269 ! Get color for parent file
270 color_code = get_file_color(parent_files(i), parent_is_dir(i), parent_is_exec(i))
271
272 if (i == parent_selected) then
273 write(output_unit, '(a)', advance='no') DIM // BOLD // trim(color_code) // &
274 fname(1:min(len_trim(fname),left_w)) // RESET
275 else
276 write(output_unit, '(a)', advance='no') DIM // trim(color_code) // &
277 fname(1:min(len_trim(fname),left_w)) // RESET
278 end if
279 write(output_unit, '(a)', advance='no') repeat(" ", max(0, left_w - len_trim(fname)))
280 else
281 write(output_unit, '(a)', advance='no') repeat(" ", left_w)
282 end if
283
284 ! Separator
285 write(output_unit, '(a)', advance='no') " │ "
286
287 ! Current pane
288 if (i <= current_count) then
289 fname = current_files(i)
290 if (current_is_dir(i) .and. fname /= "." .and. fname /= "..") then
291 fname = trim(fname) // "/"
292 end if
293
294 ! Get color for current file
295 color_code = get_file_color(current_files(i), current_is_dir(i), current_is_exec(i))
296
297 if (i == selected) then
298 write(output_unit, '(a)') REVERSE // trim(color_code) // trim(fname) // RESET
299 else
300 write(output_unit, '(a)') trim(color_code) // trim(fname) // RESET
301 end if
302 else
303 write(output_unit, *)
304 end if
305 end do
306
307 ! Footer
308 write(output_unit, '(a)') DIM // "↑↓:nav →:enter ←:back c:cd q:quit" // RESET
309 end subroutine draw_interface
310
311 subroutine read_arrow_key(k)
312 character(len=1), intent(out) :: k
313 character(len=1) :: ch
314
315 read(*, '(a1)', advance='no') ch
316 if (ch == '[') then
317 read(*, '(a1)', advance='no') k
318 else
319 k = ch
320 end if
321 end subroutine read_arrow_key
322
323 function get_file_color(filename, is_dir, is_exec) result(color)
324 character(len=*), intent(in) :: filename
325 logical, intent(in) :: is_dir, is_exec
326 character(len=20) :: color
327
328 ! Directories: Blue and bold
329 if (is_dir) then
330 color = BOLD // BLUE
331 ! Dotfiles: Grey
332 else if (filename(1:1) == '.') then
333 color = GREY
334 ! Executable files: Green
335 else if (is_exec) then
336 color = GREEN
337 ! All other files: White
338 else
339 color = WHITE
340 end if
341 end function get_file_color
342
343 subroutine write_exit_dir(dir)
344 character(len=*), intent(in) :: dir
345 character(len=MAX_PATH) :: temp_file
346 integer :: unit, ios
347
348 ! Create temp file in HOME directory
349 call get_environment_variable("HOME", temp_file)
350 temp_file = trim(temp_file) // "/.fortress_cd"
351
352 open(newunit=unit, file=temp_file, status='replace', action='write', iostat=ios)
353 if (ios == 0) then
354 write(unit, '(a)') trim(dir)
355 close(unit)
356 end if
357 end subroutine write_exit_dir
358
359 end program fortress_clean
360