| 1 | ! ============================================================================== |
| 2 | ! Module: directory_builtin |
| 3 | ! Purpose: Directory stack operations (pushd/popd/dirs) |
| 4 | ! ============================================================================== |
| 5 | module directory_builtin |
| 6 | use shell_types |
| 7 | use variables |
| 8 | use iso_fortran_env, only: output_unit, error_unit |
| 9 | use iso_c_binding, only: c_int, c_char, c_null_char, c_ptr, c_associated |
| 10 | implicit none |
| 11 | |
| 12 | integer, parameter :: MAX_DIR_STACK = 32 |
| 13 | |
| 14 | type :: dir_stack_t |
| 15 | character(len=MAX_PATH_LEN) :: directories(MAX_DIR_STACK) |
| 16 | integer :: top |
| 17 | end type |
| 18 | |
| 19 | type(dir_stack_t), save :: dir_stack = dir_stack_t(directories=repeat(' ', MAX_PATH_LEN), top=0) |
| 20 | |
| 21 | interface |
| 22 | function chdir_c(path) bind(c, name='chdir') result(status) |
| 23 | import :: c_int, c_char |
| 24 | character(kind=c_char), intent(in) :: path(*) |
| 25 | integer(c_int) :: status |
| 26 | end function |
| 27 | |
| 28 | function getcwd_c(buf, size) bind(c, name='getcwd') result(ptr) |
| 29 | import :: c_int, c_char, c_ptr |
| 30 | character(kind=c_char), intent(out) :: buf(*) |
| 31 | integer(c_int), value :: size |
| 32 | type(c_ptr) :: ptr |
| 33 | end function |
| 34 | end interface |
| 35 | |
| 36 | contains |
| 37 | |
| 38 | ! Replace $HOME prefix with ~ for display |
| 39 | function tilde_abbreviate(path) result(abbreviated) |
| 40 | character(len=*), intent(in) :: path |
| 41 | character(len=MAX_PATH_LEN) :: abbreviated |
| 42 | character(len=:), allocatable :: home_dir |
| 43 | character(len=MAX_PATH_LEN) :: home_buf |
| 44 | integer :: home_len, path_len |
| 45 | |
| 46 | call get_environment_variable('HOME', home_buf) |
| 47 | home_dir = trim(home_buf) |
| 48 | home_len = len_trim(home_dir) |
| 49 | path_len = len_trim(path) |
| 50 | |
| 51 | if (home_len > 0 .and. path_len >= home_len .and. path(1:home_len) == trim(home_dir)) then |
| 52 | if (path_len == home_len) then |
| 53 | abbreviated = '~' |
| 54 | else if (path(home_len+1:home_len+1) == '/') then |
| 55 | abbreviated = '~' // path(home_len+1:path_len) |
| 56 | else |
| 57 | abbreviated = path |
| 58 | end if |
| 59 | else |
| 60 | abbreviated = path |
| 61 | end if |
| 62 | end function |
| 63 | |
| 64 | subroutine builtin_pushd(cmd, shell) |
| 65 | type(command_t), intent(in) :: cmd |
| 66 | type(shell_state_t), intent(inout) :: shell |
| 67 | |
| 68 | character(len=:), allocatable :: new_dir |
| 69 | character(len=MAX_PATH_LEN) :: current_dir |
| 70 | integer :: arg_index, status |
| 71 | logical :: no_change, swap_top |
| 72 | |
| 73 | no_change = .false. |
| 74 | swap_top = .false. |
| 75 | arg_index = 2 |
| 76 | |
| 77 | ! Parse options |
| 78 | do while (arg_index <= cmd%num_tokens) |
| 79 | if (cmd%tokens(arg_index)(1:1) == '-') then |
| 80 | select case (trim(cmd%tokens(arg_index))) |
| 81 | case ('-n') |
| 82 | no_change = .true. |
| 83 | arg_index = arg_index + 1 |
| 84 | case default |
| 85 | write(error_unit, '(a,a)') 'pushd: unknown option: ', trim(cmd%tokens(arg_index)) |
| 86 | shell%last_exit_status = 1 |
| 87 | return |
| 88 | end select |
| 89 | else |
| 90 | exit |
| 91 | end if |
| 92 | end do |
| 93 | |
| 94 | ! Use logical path (shell%cwd) instead of physical path (getcwd) |
| 95 | current_dir = trim(shell%cwd) |
| 96 | |
| 97 | if (arg_index > cmd%num_tokens) then |
| 98 | ! No directory specified - swap top two directories |
| 99 | if (dir_stack%top < 1) then |
| 100 | write(error_unit, '(a)') 'pushd: no other directory' |
| 101 | shell%last_exit_status = 1 |
| 102 | return |
| 103 | end if |
| 104 | |
| 105 | new_dir = dir_stack%directories(dir_stack%top) |
| 106 | dir_stack%directories(dir_stack%top) = current_dir |
| 107 | |
| 108 | if (.not. no_change) then |
| 109 | call change_dir(new_dir, status) |
| 110 | if (status /= 0) then |
| 111 | ! Restore original state |
| 112 | dir_stack%directories(dir_stack%top) = new_dir |
| 113 | shell%last_exit_status = 1 |
| 114 | return |
| 115 | end if |
| 116 | ! Update shell cwd with logical path from the target directory |
| 117 | shell%cwd = trim(new_dir) |
| 118 | end if |
| 119 | |
| 120 | call print_directory_stack(shell=shell) |
| 121 | else |
| 122 | ! Directory specified |
| 123 | new_dir = cmd%tokens(arg_index) |
| 124 | |
| 125 | ! Handle special cases |
| 126 | if (new_dir == '~') then |
| 127 | new_dir = get_shell_variable(shell, 'HOME') |
| 128 | if (len_trim(new_dir) == 0) new_dir = '/' |
| 129 | end if |
| 130 | |
| 131 | ! Push current directory onto stack |
| 132 | if (dir_stack%top >= MAX_DIR_STACK) then |
| 133 | write(error_unit, '(a)') 'pushd: directory stack full' |
| 134 | shell%last_exit_status = 1 |
| 135 | return |
| 136 | end if |
| 137 | |
| 138 | dir_stack%top = dir_stack%top + 1 |
| 139 | if (no_change) then |
| 140 | ! -n: push the target dir onto stack without cd-ing |
| 141 | dir_stack%directories(dir_stack%top) = new_dir |
| 142 | else |
| 143 | dir_stack%directories(dir_stack%top) = current_dir |
| 144 | end if |
| 145 | |
| 146 | if (.not. no_change) then |
| 147 | call change_dir(new_dir, status) |
| 148 | if (status /= 0) then |
| 149 | ! Remove from stack on failure |
| 150 | dir_stack%top = dir_stack%top - 1 |
| 151 | shell%last_exit_status = 1 |
| 152 | return |
| 153 | end if |
| 154 | |
| 155 | ! Update PWD and shell cwd with logical path |
| 156 | if (new_dir(1:1) == '/') then |
| 157 | shell%cwd = trim(new_dir) |
| 158 | else |
| 159 | shell%cwd = trim(current_dir) // '/' // trim(new_dir) |
| 160 | end if |
| 161 | call set_shell_variable(shell, 'PWD', trim(shell%cwd)) |
| 162 | end if |
| 163 | |
| 164 | call print_directory_stack(shell=shell) |
| 165 | end if |
| 166 | |
| 167 | shell%last_exit_status = 0 |
| 168 | end subroutine |
| 169 | |
| 170 | subroutine builtin_popd(cmd, shell) |
| 171 | type(command_t), intent(in) :: cmd |
| 172 | type(shell_state_t), intent(inout) :: shell |
| 173 | |
| 174 | character(len=:), allocatable :: new_dir |
| 175 | character(len=MAX_PATH_LEN) :: current_dir |
| 176 | integer :: arg_index, status, n |
| 177 | logical :: no_change |
| 178 | character(len=16) :: n_str |
| 179 | |
| 180 | no_change = .false. |
| 181 | n = 0 |
| 182 | arg_index = 2 |
| 183 | |
| 184 | ! Parse options |
| 185 | do while (arg_index <= cmd%num_tokens) |
| 186 | if (cmd%tokens(arg_index)(1:1) == '-') then |
| 187 | select case (trim(cmd%tokens(arg_index))) |
| 188 | case ('-n') |
| 189 | no_change = .true. |
| 190 | arg_index = arg_index + 1 |
| 191 | case default |
| 192 | write(error_unit, '(a,a)') 'popd: unknown option: ', trim(cmd%tokens(arg_index)) |
| 193 | shell%last_exit_status = 1 |
| 194 | return |
| 195 | end select |
| 196 | else |
| 197 | ! Numeric argument |
| 198 | if (cmd%tokens(arg_index)(1:1) == '+' .or. cmd%tokens(arg_index)(1:1) == '-' .or. & |
| 199 | (cmd%tokens(arg_index)(1:1) >= '0' .and. cmd%tokens(arg_index)(1:1) <= '9')) then |
| 200 | n_str = cmd%tokens(arg_index) |
| 201 | read(n_str, *, iostat=status) n |
| 202 | if (status /= 0) then |
| 203 | write(error_unit, '(a,a)') 'popd: invalid number: ', trim(cmd%tokens(arg_index)) |
| 204 | shell%last_exit_status = 1 |
| 205 | return |
| 206 | end if |
| 207 | end if |
| 208 | arg_index = arg_index + 1 |
| 209 | end if |
| 210 | end do |
| 211 | |
| 212 | if (dir_stack%top < 1) then |
| 213 | write(error_unit, '(a)') 'popd: directory stack empty' |
| 214 | shell%last_exit_status = 1 |
| 215 | return |
| 216 | end if |
| 217 | |
| 218 | if (n == 0) then |
| 219 | ! Pop top directory |
| 220 | new_dir = dir_stack%directories(dir_stack%top) |
| 221 | dir_stack%top = dir_stack%top - 1 |
| 222 | |
| 223 | if (.not. no_change) then |
| 224 | call change_dir(new_dir, status) |
| 225 | if (status /= 0) then |
| 226 | ! Restore stack on failure |
| 227 | dir_stack%top = dir_stack%top + 1 |
| 228 | shell%last_exit_status = 1 |
| 229 | return |
| 230 | end if |
| 231 | |
| 232 | ! Update PWD and shell cwd with logical path |
| 233 | if (new_dir(1:1) == '/') then |
| 234 | shell%cwd = trim(new_dir) |
| 235 | else |
| 236 | shell%cwd = trim(current_dir) // '/' // trim(new_dir) |
| 237 | end if |
| 238 | call set_shell_variable(shell, 'PWD', trim(shell%cwd)) |
| 239 | end if |
| 240 | else |
| 241 | ! Remove specific entry from stack |
| 242 | if (n > 0) then |
| 243 | n = dir_stack%top - n + 1 |
| 244 | else |
| 245 | n = -n + 1 |
| 246 | end if |
| 247 | |
| 248 | if (n < 1 .or. n > dir_stack%top) then |
| 249 | write(error_unit, '(a)') 'popd: directory stack index out of range' |
| 250 | shell%last_exit_status = 1 |
| 251 | return |
| 252 | end if |
| 253 | |
| 254 | ! Shift directories down |
| 255 | do status = n, dir_stack%top - 1 |
| 256 | dir_stack%directories(status) = dir_stack%directories(status + 1) |
| 257 | end do |
| 258 | dir_stack%top = dir_stack%top - 1 |
| 259 | end if |
| 260 | |
| 261 | call print_directory_stack(shell=shell) |
| 262 | shell%last_exit_status = 0 |
| 263 | end subroutine |
| 264 | |
| 265 | subroutine builtin_dirs(cmd, shell) |
| 266 | type(command_t), intent(in) :: cmd |
| 267 | type(shell_state_t), intent(inout) :: shell |
| 268 | |
| 269 | integer :: arg_index |
| 270 | logical :: clear_stack, long_format, one_per_line |
| 271 | |
| 272 | clear_stack = .false. |
| 273 | long_format = .false. |
| 274 | one_per_line = .false. |
| 275 | arg_index = 2 |
| 276 | |
| 277 | ! Parse options |
| 278 | do while (arg_index <= cmd%num_tokens) |
| 279 | select case (trim(cmd%tokens(arg_index))) |
| 280 | case ('-c') |
| 281 | clear_stack = .true. |
| 282 | case ('-l') |
| 283 | long_format = .true. |
| 284 | case ('-p') |
| 285 | one_per_line = .true. |
| 286 | case ('-v') |
| 287 | ! Verbose (numbered) output |
| 288 | call print_directory_stack_verbose(shell) |
| 289 | shell%last_exit_status = 0 |
| 290 | return |
| 291 | case default |
| 292 | write(error_unit, '(a,a)') 'dirs: unknown option: ', trim(cmd%tokens(arg_index)) |
| 293 | shell%last_exit_status = 1 |
| 294 | return |
| 295 | end select |
| 296 | arg_index = arg_index + 1 |
| 297 | end do |
| 298 | |
| 299 | if (clear_stack) then |
| 300 | dir_stack%top = 0 |
| 301 | else if (one_per_line) then |
| 302 | call print_directory_stack_lines(long_format, shell) |
| 303 | else |
| 304 | call print_directory_stack(long_format, shell) |
| 305 | end if |
| 306 | |
| 307 | shell%last_exit_status = 0 |
| 308 | end subroutine |
| 309 | |
| 310 | subroutine print_directory_stack(long_fmt, shell) |
| 311 | use io_helpers, only: write_stdout, write_stdout_nonl |
| 312 | logical, intent(in), optional :: long_fmt |
| 313 | type(shell_state_t), intent(in), optional :: shell |
| 314 | character(len=MAX_PATH_LEN) :: current_dir |
| 315 | character(len=:), allocatable :: display_dir, line |
| 316 | integer :: i, status |
| 317 | logical :: use_long |
| 318 | |
| 319 | use_long = .false. |
| 320 | if (present(long_fmt)) use_long = long_fmt |
| 321 | |
| 322 | ! Use logical path from shell state if available, else fall back to getcwd |
| 323 | if (present(shell)) then |
| 324 | current_dir = trim(shell%cwd) |
| 325 | else |
| 326 | call get_current_dir(current_dir, status) |
| 327 | end if |
| 328 | |
| 329 | if (use_long) then |
| 330 | display_dir = trim(current_dir) |
| 331 | else |
| 332 | display_dir = tilde_abbreviate(current_dir) |
| 333 | end if |
| 334 | line = trim(display_dir) |
| 335 | |
| 336 | do i = dir_stack%top, 1, -1 |
| 337 | if (use_long) then |
| 338 | display_dir = trim(dir_stack%directories(i)) |
| 339 | else |
| 340 | display_dir = tilde_abbreviate(dir_stack%directories(i)) |
| 341 | end if |
| 342 | line = trim(line) // ' ' // trim(display_dir) |
| 343 | end do |
| 344 | |
| 345 | ! Use write_stdout so output respects fd redirections (>/dev/null) |
| 346 | call write_stdout(trim(line)) |
| 347 | end subroutine |
| 348 | |
| 349 | subroutine print_directory_stack_lines(long_fmt, shell) |
| 350 | use io_helpers, only: write_stdout |
| 351 | logical, intent(in), optional :: long_fmt |
| 352 | type(shell_state_t), intent(in), optional :: shell |
| 353 | character(len=MAX_PATH_LEN) :: current_dir |
| 354 | character(len=:), allocatable :: display_dir |
| 355 | integer :: i, status |
| 356 | logical :: use_long |
| 357 | |
| 358 | use_long = .false. |
| 359 | if (present(long_fmt)) use_long = long_fmt |
| 360 | |
| 361 | if (present(shell)) then |
| 362 | current_dir = trim(shell%cwd) |
| 363 | else |
| 364 | call get_current_dir(current_dir, status) |
| 365 | end if |
| 366 | |
| 367 | if (use_long) then |
| 368 | display_dir = trim(current_dir) |
| 369 | else |
| 370 | display_dir = tilde_abbreviate(current_dir) |
| 371 | end if |
| 372 | call write_stdout(trim(display_dir)) |
| 373 | |
| 374 | do i = dir_stack%top, 1, -1 |
| 375 | if (use_long) then |
| 376 | display_dir = trim(dir_stack%directories(i)) |
| 377 | else |
| 378 | display_dir = tilde_abbreviate(dir_stack%directories(i)) |
| 379 | end if |
| 380 | call write_stdout(trim(display_dir)) |
| 381 | end do |
| 382 | end subroutine |
| 383 | |
| 384 | subroutine print_directory_stack_verbose(shell) |
| 385 | use io_helpers, only: write_stdout |
| 386 | type(shell_state_t), intent(in), optional :: shell |
| 387 | character(len=MAX_PATH_LEN) :: current_dir |
| 388 | character(len=20) :: num_str |
| 389 | integer :: i, status |
| 390 | |
| 391 | if (present(shell)) then |
| 392 | current_dir = trim(shell%cwd) |
| 393 | else |
| 394 | call get_current_dir(current_dir, status) |
| 395 | end if |
| 396 | |
| 397 | call write_stdout(' 0 ' // trim(tilde_abbreviate(current_dir))) |
| 398 | |
| 399 | do i = dir_stack%top, 1, -1 |
| 400 | write(num_str, '(I2)') dir_stack%top - i + 1 |
| 401 | call write_stdout(trim(num_str) // ' ' // trim(tilde_abbreviate(dir_stack%directories(i)))) |
| 402 | end do |
| 403 | end subroutine |
| 404 | |
| 405 | subroutine get_current_dir(dir, status) |
| 406 | character(len=*), intent(out) :: dir |
| 407 | integer, intent(out) :: status |
| 408 | |
| 409 | character(kind=c_char) :: c_dir(1024) |
| 410 | type(c_ptr) :: result |
| 411 | integer :: i |
| 412 | |
| 413 | result = getcwd_c(c_dir, 1024) |
| 414 | if (c_associated(result)) then |
| 415 | status = 0 |
| 416 | dir = '' |
| 417 | do i = 1, 1023 |
| 418 | if (c_dir(i) == c_null_char) exit |
| 419 | dir(i:i) = c_dir(i) |
| 420 | end do |
| 421 | else |
| 422 | status = 1 |
| 423 | dir = '' |
| 424 | end if |
| 425 | end subroutine |
| 426 | |
| 427 | subroutine change_dir(path, status) |
| 428 | character(len=*), intent(in) :: path |
| 429 | integer, intent(out) :: status |
| 430 | |
| 431 | character(kind=c_char) :: c_path(len_trim(path) + 1) |
| 432 | integer :: i |
| 433 | |
| 434 | ! Convert to C string |
| 435 | do i = 1, len_trim(path) |
| 436 | c_path(i) = path(i:i) |
| 437 | end do |
| 438 | c_path(len_trim(path) + 1) = c_null_char |
| 439 | |
| 440 | status = chdir_c(c_path) |
| 441 | end subroutine |
| 442 | |
| 443 | end module directory_builtin |