| 1 | ! ============================================================================== |
| 2 | ! Module: prompt_formatting |
| 3 | ! Purpose: Prompt escape sequence expansion (PS1-PS4 with bash-style escapes) |
| 4 | ! Also supports zsh-style color codes: %F{color}, %f, %B, %b, etc. |
| 5 | ! ============================================================================== |
| 6 | module prompt_formatting |
| 7 | use shell_types |
| 8 | use system_interface |
| 9 | use iso_fortran_env, only: output_unit |
| 10 | use substitution, only: enhanced_command_substitution |
| 11 | use variables, only: get_shell_variable |
| 12 | implicit none |
| 13 | |
| 14 | ! History counter for prompts |
| 15 | integer, save :: prompt_history_number = 1 |
| 16 | |
| 17 | ! Prompt element cache (valid for one prompt expansion cycle) |
| 18 | character(len=256), save :: cached_git_branch = '' |
| 19 | character(len=64), save :: cached_git_status = '' |
| 20 | character(len=64), save :: cached_git_ahead_behind = '' |
| 21 | character(len=256), save :: cached_venv_name = '' |
| 22 | logical, save :: cache_branch_valid = .false. |
| 23 | logical, save :: cache_status_valid = .false. |
| 24 | logical, save :: cache_ahead_behind_valid = .false. |
| 25 | logical, save :: cache_venv_valid = .false. |
| 26 | |
| 27 | ! Public interface |
| 28 | public :: expand_prompt, safe_expand_prompt, expand_zsh_colors |
| 29 | public :: get_ansi_color_code, get_epoch_seconds, increment_prompt_history |
| 30 | public :: get_git_branch, get_git_status_indicator, is_git_repo |
| 31 | public :: invalidate_prompt_cache, get_git_ahead_behind, get_venv_name |
| 32 | |
| 33 | contains |
| 34 | |
| 35 | ! Safe version that outputs to fixed-length buffer (no allocatable strings) |
| 36 | ! Avoids LLVM Flang heap corruption bugs |
| 37 | subroutine safe_expand_prompt(prompt_str, shell, stored_len, expanded) |
| 38 | use iso_fortran_env, only: error_unit |
| 39 | character(len=*), intent(in) :: prompt_str |
| 40 | type(shell_state_t), intent(inout) :: shell |
| 41 | integer, intent(in), optional :: stored_len |
| 42 | character(len=*), intent(out) :: expanded |
| 43 | |
| 44 | character(len=MAX_VAR_VALUE_LEN) :: result ! Fixed-length buffer (avoid flang-new allocatable string bugs) |
| 45 | character(len=MAX_VAR_VALUE_LEN) :: var_expanded ! Buffer for variable/command expansion |
| 46 | integer :: i, j, prompt_len |
| 47 | integer, parameter :: RESULT_CAPACITY = 1024 |
| 48 | character(len=256) :: replacement ! Fixed-length buffer (avoid flang-new allocatable string bugs) |
| 49 | |
| 50 | call invalidate_prompt_cache() |
| 51 | |
| 52 | result = '' |
| 53 | j = 1 |
| 54 | i = 1 |
| 55 | |
| 56 | ! Use stored length if provided |
| 57 | if (present(stored_len) .and. stored_len > 0) then |
| 58 | prompt_len = min(stored_len, len(prompt_str)) |
| 59 | else |
| 60 | prompt_len = len_trim(prompt_str) |
| 61 | end if |
| 62 | |
| 63 | |
| 64 | do |
| 65 | if (i > prompt_len .or. j > RESULT_CAPACITY) exit |
| 66 | if (prompt_str(i:i) == '\' .and. i < prompt_len) then |
| 67 | ! Process escape sequence |
| 68 | i = i + 1 |
| 69 | call process_escape_sequence(prompt_str(i:i), shell, replacement) |
| 70 | |
| 71 | if (len_trim(replacement) > 0) then |
| 72 | if (j + len_trim(replacement) - 1 <= RESULT_CAPACITY) then |
| 73 | result(j:j+len_trim(replacement)-1) = trim(replacement) |
| 74 | j = j + len_trim(replacement) |
| 75 | end if |
| 76 | end if |
| 77 | i = i + 1 |
| 78 | else |
| 79 | ! Regular character |
| 80 | if (j <= RESULT_CAPACITY) then |
| 81 | result(j:j) = prompt_str(i:i) |
| 82 | j = j + 1 |
| 83 | end if |
| 84 | i = i + 1 |
| 85 | end if |
| 86 | end do |
| 87 | |
| 88 | ! Copy to output |
| 89 | expanded = '' |
| 90 | if (j > 1) then |
| 91 | expanded = result(1:min(j-1, len(expanded))) |
| 92 | end if |
| 93 | |
| 94 | ! Now process zsh-style color escapes (%F{color}, %f, etc.) |
| 95 | if (index(expanded, '%') > 0) then |
| 96 | result = '' |
| 97 | call expand_zsh_colors(expanded, result, len_trim(expanded)) |
| 98 | expanded = result(1:min(len_trim(result), len(expanded))) |
| 99 | end if |
| 100 | |
| 101 | ! Expand variables and command substitutions ($VAR, ${VAR}, $(cmd)) |
| 102 | if (index(expanded, '$') > 0) then |
| 103 | call expand_prompt_variables(expanded, shell, var_expanded) |
| 104 | expanded = var_expanded(1:min(len_trim(var_expanded), len(expanded))) |
| 105 | end if |
| 106 | end subroutine |
| 107 | |
| 108 | ! Main function to expand prompt string with escape sequences |
| 109 | function expand_prompt(prompt_str, shell, stored_len) result(expanded) |
| 110 | character(len=*), intent(in) :: prompt_str |
| 111 | type(shell_state_t), intent(inout) :: shell |
| 112 | integer, intent(in), optional :: stored_len |
| 113 | character(len=:), allocatable :: expanded |
| 114 | |
| 115 | ! Use allocatable to avoid stack allocation |
| 116 | character(len=:), allocatable :: result |
| 117 | character(len=MAX_VAR_VALUE_LEN) :: var_expanded ! Buffer for variable/command expansion |
| 118 | integer :: i, j, prompt_len, result_capacity |
| 119 | character(len=:), allocatable :: replacement ! Heap allocation to avoid stack overflow |
| 120 | |
| 121 | call invalidate_prompt_cache() |
| 122 | |
| 123 | ! Allocate replacement buffer on heap |
| 124 | allocate(character(len=256) :: replacement) |
| 125 | |
| 126 | ! Start with reasonable capacity |
| 127 | result_capacity = len(prompt_str) * 2 + 256 |
| 128 | allocate(character(len=result_capacity) :: result) |
| 129 | result = '' |
| 130 | |
| 131 | j = 1 |
| 132 | i = 1 |
| 133 | ! Use stored length if provided (preserves intentional trailing spaces), |
| 134 | ! otherwise fall back to len_trim for backwards compatibility |
| 135 | if (present(stored_len) .and. stored_len > 0) then |
| 136 | prompt_len = min(stored_len, len(prompt_str)) |
| 137 | else |
| 138 | prompt_len = len_trim(prompt_str) |
| 139 | end if |
| 140 | |
| 141 | do while (i <= prompt_len) |
| 142 | if (prompt_str(i:i) == '\' .and. i < prompt_len) then |
| 143 | ! Process escape sequence |
| 144 | i = i + 1 |
| 145 | call process_escape_sequence(prompt_str(i:i), shell, replacement) |
| 146 | |
| 147 | if (len_trim(replacement) > 0) then |
| 148 | ! Grow buffer if needed |
| 149 | if (j + len_trim(replacement) > result_capacity) then |
| 150 | call grow_string_buffer(result, result_capacity, result_capacity * 2) |
| 151 | end if |
| 152 | result(j:j+len_trim(replacement)-1) = trim(replacement) |
| 153 | j = j + len_trim(replacement) |
| 154 | end if |
| 155 | i = i + 1 |
| 156 | else |
| 157 | ! Regular character |
| 158 | if (j > result_capacity) then |
| 159 | call grow_string_buffer(result, result_capacity, result_capacity * 2) |
| 160 | end if |
| 161 | result(j:j) = prompt_str(i:i) |
| 162 | i = i + 1 |
| 163 | j = j + 1 |
| 164 | end if |
| 165 | end do |
| 166 | |
| 167 | ! Allocate exact length to preserve trailing spaces |
| 168 | expanded = result(1:j-1) |
| 169 | deallocate(result) |
| 170 | if (allocated(replacement)) deallocate(replacement) |
| 171 | |
| 172 | ! Now process zsh-style color escapes (%F{color}, %f, etc.) |
| 173 | if (index(expanded, '%') > 0) then |
| 174 | allocate(character(len=len(expanded)*2) :: result) |
| 175 | call expand_zsh_colors(expanded, result, len(expanded)) |
| 176 | expanded = trim(result) |
| 177 | deallocate(result) |
| 178 | end if |
| 179 | |
| 180 | ! Expand variables and command substitutions ($VAR, ${VAR}, $(cmd)) |
| 181 | if (index(expanded, '$') > 0) then |
| 182 | call expand_prompt_variables(expanded, shell, var_expanded) |
| 183 | expanded = trim(var_expanded) |
| 184 | end if |
| 185 | end function |
| 186 | |
| 187 | ! Process individual escape sequence |
| 188 | subroutine process_escape_sequence(escape_char, shell, replacement) |
| 189 | character(len=1), intent(in) :: escape_char |
| 190 | type(shell_state_t), intent(in) :: shell |
| 191 | character(len=*), intent(out) :: replacement |
| 192 | |
| 193 | character(len=:), allocatable :: temp ! Heap allocation to avoid stack overflow |
| 194 | integer :: values(8), hour |
| 195 | character(len=3), dimension(7) :: day_names = & |
| 196 | ['Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'] |
| 197 | character(len=3), dimension(12) :: month_names = & |
| 198 | ['Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', & |
| 199 | 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'] |
| 200 | integer :: day_of_week |
| 201 | |
| 202 | ! Allocate temp buffer on heap (must come after all declarations) |
| 203 | allocate(character(len=256) :: temp) |
| 204 | |
| 205 | replacement = '' |
| 206 | |
| 207 | select case (escape_char) |
| 208 | ! User and host information |
| 209 | case ('u') |
| 210 | ! Username |
| 211 | replacement = trim(shell%username) |
| 212 | |
| 213 | case ('h') |
| 214 | ! Hostname (short - up to first '.') |
| 215 | replacement = get_short_hostname(shell%hostname) |
| 216 | |
| 217 | case ('H') |
| 218 | ! Hostname (full) |
| 219 | replacement = trim(shell%hostname) |
| 220 | |
| 221 | ! Directory information |
| 222 | case ('w') |
| 223 | ! Current working directory (full path, with ~ for HOME) |
| 224 | replacement = get_pretty_path(shell%cwd, shell) |
| 225 | |
| 226 | case ('W') |
| 227 | ! Basename of current working directory |
| 228 | replacement = get_basename(shell%cwd) |
| 229 | |
| 230 | ! Time and date |
| 231 | case ('t') |
| 232 | ! Time in 24-hour HH:MM:SS format |
| 233 | call date_and_time(values=values) |
| 234 | write(replacement, '(i2.2,a,i2.2,a,i2.2)') & |
| 235 | values(5), ':', values(6), ':', values(7) |
| 236 | |
| 237 | case ('T') |
| 238 | ! Time in 12-hour HH:MM:SS format |
| 239 | call date_and_time(values=values) |
| 240 | hour = values(5) |
| 241 | if (hour == 0) hour = 12 |
| 242 | if (hour > 12) hour = hour - 12 |
| 243 | write(replacement, '(i2.2,a,i2.2,a,i2.2)') & |
| 244 | hour, ':', values(6), ':', values(7) |
| 245 | |
| 246 | case ('@') |
| 247 | ! Time in 12-hour am/pm format |
| 248 | call date_and_time(values=values) |
| 249 | hour = values(5) |
| 250 | if (hour >= 12) then |
| 251 | if (hour > 12) hour = hour - 12 |
| 252 | write(replacement, '(i2.2,a,i2.2,a)') hour, ':', values(6), ' pm' |
| 253 | else |
| 254 | if (hour == 0) hour = 12 |
| 255 | write(replacement, '(i2.2,a,i2.2,a)') hour, ':', values(6), ' am' |
| 256 | end if |
| 257 | |
| 258 | case ('A') |
| 259 | ! Time in 24-hour HH:MM format |
| 260 | call date_and_time(values=values) |
| 261 | write(replacement, '(i2.2,a,i2.2)') values(5), ':', values(6) |
| 262 | |
| 263 | case ('d') |
| 264 | ! Date in "Day Mon DD" format |
| 265 | call date_and_time(values=values) |
| 266 | ! Calculate day of week (simplified - may not be exact) |
| 267 | day_of_week = mod(values(3) + 2, 7) + 1 ! Rough approximation |
| 268 | if (values(2) >= 1 .and. values(2) <= 12) then |
| 269 | write(replacement, '(a,1x,a,1x,i2)') & |
| 270 | day_names(day_of_week), month_names(values(2)), values(3) |
| 271 | else |
| 272 | write(replacement, '(a,1x,i2)') day_names(day_of_week), values(3) |
| 273 | end if |
| 274 | |
| 275 | case ('D') |
| 276 | ! Date in ISO format YYYY-MM-DD |
| 277 | call date_and_time(values=values) |
| 278 | write(replacement, '(i4,a,i2.2,a,i2.2)') values(1), '-', values(2), '-', values(3) |
| 279 | |
| 280 | ! Shell information |
| 281 | case ('s') |
| 282 | ! Shell name |
| 283 | replacement = trim(shell%shell_name) |
| 284 | |
| 285 | case ('v') |
| 286 | ! Shell version (short) |
| 287 | replacement = '2.0' |
| 288 | |
| 289 | case ('V') |
| 290 | ! Shell version + patch level |
| 291 | replacement = '2.0.0' |
| 292 | |
| 293 | ! History and command numbers |
| 294 | case ('!') |
| 295 | ! History number |
| 296 | write(replacement, '(i15)') prompt_history_number |
| 297 | |
| 298 | case ('#') |
| 299 | ! Command number |
| 300 | write(replacement, '(i15)') shell%command_number |
| 301 | |
| 302 | ! Special characters |
| 303 | case ('$') |
| 304 | ! '#' if UID=0, else '$' |
| 305 | if (shell%uid == 0 .or. shell%euid == 0) then |
| 306 | replacement = '#' |
| 307 | else |
| 308 | replacement = '$' |
| 309 | end if |
| 310 | |
| 311 | case ('n') |
| 312 | ! Newline - CR+LF for proper cursor positioning in terminal emulators |
| 313 | replacement = char(13) // char(10) |
| 314 | |
| 315 | case ('r') |
| 316 | ! Carriage return |
| 317 | replacement = char(13) |
| 318 | |
| 319 | case ('\') |
| 320 | ! Backslash |
| 321 | replacement = '\' |
| 322 | |
| 323 | case ('[') |
| 324 | ! Begin non-printing sequence (for color codes) |
| 325 | replacement = '' ! Don't print anything, just mark |
| 326 | |
| 327 | case (']') |
| 328 | ! End non-printing sequence |
| 329 | replacement = '' ! Don't print anything, just mark |
| 330 | |
| 331 | case ('e') |
| 332 | ! Escape character for ANSI codes |
| 333 | replacement = char(27) |
| 334 | |
| 335 | case ('a') |
| 336 | ! Bell/beep |
| 337 | replacement = char(7) |
| 338 | |
| 339 | case ('j') |
| 340 | ! Number of jobs |
| 341 | write(replacement, '(i15)') shell%num_jobs |
| 342 | |
| 343 | case ('g') |
| 344 | ! Git branch (if in git repo) |
| 345 | replacement = get_git_branch() |
| 346 | |
| 347 | case ('G') |
| 348 | ! Git status indicator (✓ clean, ✗ dirty, + staged, ± both) |
| 349 | replacement = get_git_status_indicator() |
| 350 | |
| 351 | case ('p') |
| 352 | ! Git ahead/behind upstream (e.g. ↑2↓1) |
| 353 | replacement = get_git_ahead_behind() |
| 354 | |
| 355 | case ('P') |
| 356 | ! Python virtual environment name (from VIRTUAL_ENV) |
| 357 | replacement = get_venv_name() |
| 358 | |
| 359 | case ('S') |
| 360 | ! Seconds since epoch (Unix timestamp) |
| 361 | replacement = get_epoch_seconds() |
| 362 | |
| 363 | case default |
| 364 | ! Unknown escape - just output the character |
| 365 | replacement = escape_char |
| 366 | end select |
| 367 | |
| 368 | ! Deallocate temp buffer |
| 369 | if (allocated(temp)) deallocate(temp) |
| 370 | end subroutine |
| 371 | |
| 372 | ! Get short hostname (up to first '.') |
| 373 | function get_short_hostname(hostname) result(short_name) |
| 374 | character(len=*), intent(in) :: hostname |
| 375 | character(len=256) :: short_name |
| 376 | integer :: dot_pos |
| 377 | |
| 378 | dot_pos = index(hostname, '.') |
| 379 | if (dot_pos > 0) then |
| 380 | short_name = hostname(:dot_pos-1) |
| 381 | else |
| 382 | short_name = trim(hostname) |
| 383 | end if |
| 384 | end function |
| 385 | |
| 386 | ! Get pretty path with ~ for home directory and intelligent shortening |
| 387 | function get_pretty_path(path, shell) result(pretty) |
| 388 | character(len=*), intent(in) :: path |
| 389 | type(shell_state_t), intent(in) :: shell |
| 390 | character(len=:), allocatable :: pretty, home_dir, temp_path |
| 391 | character(len=:), allocatable :: branch, status, ab, venv |
| 392 | character(len=:), allocatable :: rprompt_val |
| 393 | integer :: home_len, term_rows, term_cols, max_path_len, overhead |
| 394 | integer :: i, ps1_len, first_line_end, rprompt_width |
| 395 | logical :: got_term_size |
| 396 | |
| 397 | home_dir = get_environment_var('HOME') |
| 398 | |
| 399 | ! Replace HOME with ~ |
| 400 | if (allocated(home_dir) .and. len(home_dir) > 0) then |
| 401 | home_len = len(home_dir) |
| 402 | if (len_trim(path) >= home_len) then |
| 403 | if (path(:home_len) == home_dir(:home_len)) then |
| 404 | if (len_trim(path) == home_len) then |
| 405 | temp_path = '~' |
| 406 | else |
| 407 | temp_path = '~' // trim(path(home_len+1:)) |
| 408 | end if |
| 409 | else |
| 410 | temp_path = trim(path) |
| 411 | end if |
| 412 | else |
| 413 | temp_path = trim(path) |
| 414 | end if |
| 415 | else |
| 416 | temp_path = trim(path) |
| 417 | end if |
| 418 | |
| 419 | ! Get terminal size to determine max path length |
| 420 | got_term_size = get_terminal_size(term_rows, term_cols) |
| 421 | if (got_term_size .and. term_cols > 0) then |
| 422 | ps1_len = len_trim(shell%ps1) |
| 423 | if (ps1_len > 0) then |
| 424 | ! Find first line boundary in PS1 template |
| 425 | first_line_end = 0 |
| 426 | do i = 1, ps1_len |
| 427 | ! Check for literal newline |
| 428 | if (shell%ps1(i:i) == char(10) .or. shell%ps1(i:i) == char(13)) then |
| 429 | first_line_end = i - 1 |
| 430 | exit |
| 431 | end if |
| 432 | ! Check for \n escape sequence |
| 433 | if (i < ps1_len .and. shell%ps1(i:i) == '\' .and. shell%ps1(i+1:i+1) == 'n') then |
| 434 | first_line_end = i - 1 |
| 435 | exit |
| 436 | end if |
| 437 | end do |
| 438 | if (first_line_end <= 0) first_line_end = ps1_len |
| 439 | |
| 440 | ! Count literal visible chars (non-escape, non-color chars) |
| 441 | overhead = count_literal_chars(shell%ps1(1:first_line_end)) |
| 442 | |
| 443 | ! Add widths of detected escape sequences (excluding \w itself) |
| 444 | if (has_escape(shell%ps1(1:first_line_end), 'u')) & |
| 445 | overhead = overhead + len_trim(shell%username) |
| 446 | if (has_escape(shell%ps1(1:first_line_end), 'h')) & |
| 447 | overhead = overhead + len_trim(get_short_hostname(shell%hostname)) |
| 448 | if (has_escape(shell%ps1(1:first_line_end), 'H')) & |
| 449 | overhead = overhead + len_trim(shell%hostname) |
| 450 | if (has_escape(shell%ps1(1:first_line_end), 'g')) then |
| 451 | branch = get_git_branch() |
| 452 | overhead = overhead + utf8_visual_width(branch) |
| 453 | end if |
| 454 | if (has_escape(shell%ps1(1:first_line_end), 'G')) then |
| 455 | status = get_git_status_indicator() |
| 456 | overhead = overhead + utf8_visual_width(status) |
| 457 | end if |
| 458 | if (has_escape(shell%ps1(1:first_line_end), 'p')) then |
| 459 | ab = get_git_ahead_behind() |
| 460 | overhead = overhead + utf8_visual_width(ab) |
| 461 | end if |
| 462 | if (has_escape(shell%ps1(1:first_line_end), 'P')) then |
| 463 | venv = get_venv_name() |
| 464 | overhead = overhead + utf8_visual_width(venv) |
| 465 | end if |
| 466 | ! Time/date escapes |
| 467 | if (has_escape(shell%ps1(1:first_line_end), 't')) overhead = overhead + 8 |
| 468 | if (has_escape(shell%ps1(1:first_line_end), 'T')) overhead = overhead + 8 |
| 469 | if (has_escape(shell%ps1(1:first_line_end), 'A')) overhead = overhead + 5 |
| 470 | if (has_escape(shell%ps1(1:first_line_end), '@')) overhead = overhead + 8 |
| 471 | if (has_escape(shell%ps1(1:first_line_end), 'd')) overhead = overhead + 10 |
| 472 | if (has_escape(shell%ps1(1:first_line_end), 'D')) overhead = overhead + 10 |
| 473 | if (has_escape(shell%ps1(1:first_line_end), '$')) overhead = overhead + 1 |
| 474 | if (has_escape(shell%ps1(1:first_line_end), 's')) & |
| 475 | overhead = overhead + len_trim(shell%shell_name) |
| 476 | if (has_escape(shell%ps1(1:first_line_end), 'v')) overhead = overhead + 3 |
| 477 | if (has_escape(shell%ps1(1:first_line_end), 'V')) overhead = overhead + 5 |
| 478 | |
| 479 | ! Account for RPROMPT width + minimum gap (readline requires 4-char gap) |
| 480 | rprompt_val = get_shell_variable(shell, 'RPROMPT') |
| 481 | if (len_trim(rprompt_val) > 0) then |
| 482 | rprompt_width = count_literal_chars(rprompt_val) |
| 483 | if (has_escape(rprompt_val, 'S')) rprompt_width = rprompt_width + 10 |
| 484 | if (has_escape(rprompt_val, 't')) rprompt_width = rprompt_width + 8 |
| 485 | if (has_escape(rprompt_val, 'T')) rprompt_width = rprompt_width + 8 |
| 486 | if (has_escape(rprompt_val, 'A')) rprompt_width = rprompt_width + 5 |
| 487 | if (has_escape(rprompt_val, 'D')) rprompt_width = rprompt_width + 10 |
| 488 | overhead = overhead + rprompt_width + 4 ! 4 = minimum gap |
| 489 | end if |
| 490 | |
| 491 | max_path_len = term_cols - overhead |
| 492 | else |
| 493 | max_path_len = term_cols - 50 |
| 494 | end if |
| 495 | if (max_path_len < 15) max_path_len = 15 |
| 496 | else |
| 497 | max_path_len = 25 |
| 498 | end if |
| 499 | |
| 500 | ! Shorten path if needed |
| 501 | if (len_trim(temp_path) > max_path_len) then |
| 502 | pretty = shorten_path(temp_path, max_path_len) |
| 503 | else |
| 504 | pretty = temp_path |
| 505 | end if |
| 506 | end function |
| 507 | |
| 508 | ! Intelligently shorten a path by progressively abbreviating parent directories |
| 509 | ! Pass 1: ~/ver/lon/pat/to/project (3-char parents) |
| 510 | ! Pass 2: ~/v/l/p/t/project (1-char parents) |
| 511 | function shorten_path(path, max_length) result(shortened) |
| 512 | character(len=*), intent(in) :: path |
| 513 | integer, intent(in) :: max_length |
| 514 | character(len=:), allocatable :: shortened |
| 515 | character(len=256), allocatable :: components(:) |
| 516 | integer :: num_components, i, slash_pos, comp_start, components_capacity |
| 517 | character(len=:), allocatable :: result |
| 518 | integer :: result_len, result_capacity, abbrev_len, use_len, comp_len |
| 519 | |
| 520 | ! If path is already short enough, return as-is |
| 521 | if (len_trim(path) <= max_length) then |
| 522 | shortened = trim(path) |
| 523 | return |
| 524 | end if |
| 525 | |
| 526 | ! Allocate initial components array |
| 527 | components_capacity = 50 |
| 528 | allocate(components(components_capacity)) |
| 529 | |
| 530 | ! Allocate result buffer |
| 531 | result_capacity = 512 |
| 532 | allocate(character(len=result_capacity) :: result) |
| 533 | |
| 534 | ! Split path into components |
| 535 | num_components = 0 |
| 536 | comp_start = 1 |
| 537 | |
| 538 | do while (comp_start <= len_trim(path)) |
| 539 | slash_pos = index(path(comp_start:), '/') |
| 540 | if (slash_pos > 0) then |
| 541 | slash_pos = slash_pos + comp_start - 1 |
| 542 | if (slash_pos > comp_start) then |
| 543 | num_components = num_components + 1 |
| 544 | if (num_components > components_capacity) then |
| 545 | call grow_components_array(components, components_capacity) |
| 546 | end if |
| 547 | components(num_components) = path(comp_start:slash_pos-1) |
| 548 | end if |
| 549 | comp_start = slash_pos + 1 |
| 550 | else |
| 551 | if (comp_start <= len_trim(path)) then |
| 552 | num_components = num_components + 1 |
| 553 | if (num_components > components_capacity) then |
| 554 | call grow_components_array(components, components_capacity) |
| 555 | end if |
| 556 | components(num_components) = path(comp_start:) |
| 557 | end if |
| 558 | exit |
| 559 | end if |
| 560 | end do |
| 561 | |
| 562 | ! Determine component start index (skip ~ component) |
| 563 | if (len_trim(path) > 0 .and. path(1:1) == '~') then |
| 564 | comp_start = 2 |
| 565 | else |
| 566 | comp_start = 1 |
| 567 | end if |
| 568 | |
| 569 | ! Two-pass progressive shortening: 3-char parents, then 1-char parents |
| 570 | do abbrev_len = 3, 1, -2 |
| 571 | result = repeat(' ', result_capacity) |
| 572 | result_len = 0 |
| 573 | |
| 574 | ! Write leading prefix |
| 575 | if (len_trim(path) > 0 .and. path(1:1) == '~') then |
| 576 | result(1:1) = '~' |
| 577 | result_len = 1 |
| 578 | else if (len_trim(path) > 0 .and. path(1:1) == '/') then |
| 579 | result(1:1) = '/' |
| 580 | result_len = 1 |
| 581 | end if |
| 582 | |
| 583 | ! Build shortened parent components |
| 584 | do i = comp_start, num_components - 1 |
| 585 | comp_len = len_trim(components(i)) |
| 586 | if (comp_len > 0) then |
| 587 | if (result_len > 0 .and. result(result_len:result_len) /= '/') then |
| 588 | result_len = result_len + 1 |
| 589 | result(result_len:result_len) = '/' |
| 590 | end if |
| 591 | ! Abbreviate parent to abbrev_len chars |
| 592 | use_len = min(abbrev_len, comp_len) |
| 593 | result(result_len+1:result_len+use_len) = components(i)(1:use_len) |
| 594 | result_len = result_len + use_len |
| 595 | end if |
| 596 | end do |
| 597 | |
| 598 | ! Always show last component in full |
| 599 | if (num_components > 0) then |
| 600 | if (result_len > 0 .and. result(result_len:result_len) /= '/') then |
| 601 | result_len = result_len + 1 |
| 602 | result(result_len:result_len) = '/' |
| 603 | end if |
| 604 | comp_len = len_trim(components(num_components)) |
| 605 | result(result_len+1:result_len+comp_len) = trim(components(num_components)) |
| 606 | result_len = result_len + comp_len |
| 607 | end if |
| 608 | |
| 609 | ! If this pass fits or we're at minimum abbreviation, use it |
| 610 | if (result_len <= max_length .or. abbrev_len == 1) then |
| 611 | shortened = result(1:result_len) |
| 612 | if (allocated(components)) deallocate(components) |
| 613 | if (allocated(result)) deallocate(result) |
| 614 | return |
| 615 | end if |
| 616 | end do |
| 617 | |
| 618 | ! Fallback (should not reach here) |
| 619 | shortened = result(1:result_len) |
| 620 | if (allocated(components)) deallocate(components) |
| 621 | if (allocated(result)) deallocate(result) |
| 622 | end function |
| 623 | |
| 624 | ! Get basename of path |
| 625 | function get_basename(path) result(basename) |
| 626 | character(len=*), intent(in) :: path |
| 627 | character(len=256) :: basename |
| 628 | integer :: i, last_slash |
| 629 | |
| 630 | last_slash = 0 |
| 631 | do i = len_trim(path), 1, -1 |
| 632 | if (path(i:i) == '/') then |
| 633 | last_slash = i |
| 634 | exit |
| 635 | end if |
| 636 | end do |
| 637 | |
| 638 | if (last_slash > 0 .and. last_slash < len_trim(path)) then |
| 639 | basename = path(last_slash+1:) |
| 640 | else if (last_slash == 0) then |
| 641 | basename = trim(path) |
| 642 | else |
| 643 | basename = '/' |
| 644 | end if |
| 645 | end function |
| 646 | |
| 647 | ! Increment history number for next prompt |
| 648 | subroutine increment_prompt_history() |
| 649 | prompt_history_number = prompt_history_number + 1 |
| 650 | end subroutine |
| 651 | |
| 652 | ! Get current git branch name (returns empty string if not in git repo) |
| 653 | function get_git_branch() result(branch) |
| 654 | character(len=:), allocatable :: branch |
| 655 | character(len=256) :: output |
| 656 | |
| 657 | if (cache_branch_valid) then |
| 658 | branch = trim(cached_git_branch) |
| 659 | return |
| 660 | end if |
| 661 | |
| 662 | ! Try to get branch name using git command |
| 663 | ! Use git symbolic-ref for speed (faster than git branch) |
| 664 | output = execute_and_capture('git symbolic-ref --short HEAD 2>/dev/null') |
| 665 | |
| 666 | if (len_trim(output) > 0) then |
| 667 | branch = trim(output) |
| 668 | else |
| 669 | ! Not in a git repo or detached HEAD |
| 670 | branch = '' |
| 671 | end if |
| 672 | |
| 673 | cached_git_branch = branch |
| 674 | cache_branch_valid = .true. |
| 675 | end function |
| 676 | |
| 677 | ! Get git status indicator with Unicode symbols |
| 678 | ! Returns: '✓' if clean, '✗' if dirty (unstaged), '+' if staged, '±' if both |
| 679 | ! Returns '' if not in a git repo |
| 680 | function get_git_status_indicator() result(indicator) |
| 681 | character(len=:), allocatable :: indicator |
| 682 | character(len=4096) :: output |
| 683 | logical :: has_staged, has_unstaged |
| 684 | integer :: i, line_start |
| 685 | |
| 686 | if (cache_status_valid) then |
| 687 | indicator = trim(cached_git_status) |
| 688 | return |
| 689 | end if |
| 690 | |
| 691 | ! First check if we're in a git repo |
| 692 | output = execute_and_capture('git rev-parse --git-dir 2>/dev/null') |
| 693 | if (len_trim(output) == 0) then |
| 694 | indicator = '' |
| 695 | cached_git_status = '' |
| 696 | cache_status_valid = .true. |
| 697 | return |
| 698 | end if |
| 699 | |
| 700 | ! Check for uncommitted changes (both staged and unstaged) |
| 701 | output = execute_and_capture('git status --porcelain 2>/dev/null') |
| 702 | |
| 703 | if (len_trim(output) == 0) then |
| 704 | ! Clean working tree |
| 705 | indicator = char(226) // char(156) // char(147) ! ✓ (U+2713) |
| 706 | cached_git_status = indicator |
| 707 | cache_status_valid = .true. |
| 708 | return |
| 709 | end if |
| 710 | |
| 711 | ! Parse porcelain output: first column = index (staged), second = worktree |
| 712 | has_staged = .false. |
| 713 | has_unstaged = .false. |
| 714 | line_start = 1 |
| 715 | do i = 1, len_trim(output) |
| 716 | if (i == line_start .and. i + 1 <= len_trim(output)) then |
| 717 | ! First char: staged status (non-space and non-? means staged) |
| 718 | if (output(i:i) /= ' ' .and. output(i:i) /= '?') has_staged = .true. |
| 719 | ! Second char: unstaged status (non-space means unstaged) |
| 720 | if (output(i+1:i+1) /= ' ') has_unstaged = .true. |
| 721 | end if |
| 722 | if (output(i:i) == char(10)) line_start = i + 1 |
| 723 | end do |
| 724 | ! Handle untracked files (lines starting with ??) |
| 725 | if (index(output, '??') > 0) has_unstaged = .true. |
| 726 | |
| 727 | if (has_staged .and. has_unstaged) then |
| 728 | indicator = char(194) // char(177) ! ± (U+00B1) |
| 729 | else if (has_staged) then |
| 730 | indicator = '+' |
| 731 | else |
| 732 | indicator = char(226) // char(156) // char(151) ! ✗ (U+2717) |
| 733 | end if |
| 734 | |
| 735 | cached_git_status = indicator |
| 736 | cache_status_valid = .true. |
| 737 | end function |
| 738 | |
| 739 | ! Get git ahead/behind tracking info |
| 740 | ! Returns e.g. '↑2↓1' for 2 ahead, 1 behind; '↑3' for 3 ahead; '' if up to date or no upstream |
| 741 | function get_git_ahead_behind() result(info) |
| 742 | character(len=:), allocatable :: info |
| 743 | character(len=256) :: output |
| 744 | integer :: ahead, behind, dot_pos, space_pos, iostat |
| 745 | |
| 746 | if (cache_ahead_behind_valid) then |
| 747 | info = trim(cached_git_ahead_behind) |
| 748 | return |
| 749 | end if |
| 750 | |
| 751 | info = '' |
| 752 | |
| 753 | ! Get ahead/behind counts in one shot |
| 754 | output = execute_and_capture('git rev-list --left-right --count HEAD...@{upstream} 2>/dev/null') |
| 755 | if (len_trim(output) == 0) then |
| 756 | cached_git_ahead_behind = '' |
| 757 | cache_ahead_behind_valid = .true. |
| 758 | return |
| 759 | end if |
| 760 | |
| 761 | ! Output format: "ahead\tbehind" |
| 762 | ! Find the tab separator |
| 763 | space_pos = 0 |
| 764 | do dot_pos = 1, len_trim(output) |
| 765 | if (output(dot_pos:dot_pos) == char(9) .or. output(dot_pos:dot_pos) == ' ') then |
| 766 | space_pos = dot_pos |
| 767 | exit |
| 768 | end if |
| 769 | end do |
| 770 | if (space_pos == 0) then |
| 771 | cached_git_ahead_behind = '' |
| 772 | cache_ahead_behind_valid = .true. |
| 773 | return |
| 774 | end if |
| 775 | |
| 776 | read(output(1:space_pos-1), *, iostat=iostat) ahead |
| 777 | if (iostat /= 0) then |
| 778 | cached_git_ahead_behind = '' |
| 779 | cache_ahead_behind_valid = .true. |
| 780 | return |
| 781 | end if |
| 782 | read(output(space_pos+1:), *, iostat=iostat) behind |
| 783 | if (iostat /= 0) then |
| 784 | cached_git_ahead_behind = '' |
| 785 | cache_ahead_behind_valid = .true. |
| 786 | return |
| 787 | end if |
| 788 | |
| 789 | if (ahead == 0 .and. behind == 0) then |
| 790 | cached_git_ahead_behind = '' |
| 791 | cache_ahead_behind_valid = .true. |
| 792 | return |
| 793 | end if |
| 794 | |
| 795 | if (ahead > 0) then |
| 796 | block |
| 797 | character(len=16) :: num_str |
| 798 | write(num_str, '(i0)') ahead |
| 799 | ! ↑ = U+2191 = E2 86 91 |
| 800 | info = char(226) // char(134) // char(145) // trim(num_str) |
| 801 | end block |
| 802 | end if |
| 803 | if (behind > 0) then |
| 804 | block |
| 805 | character(len=16) :: num_str |
| 806 | write(num_str, '(i0)') behind |
| 807 | ! ↓ = U+2193 = E2 86 93 |
| 808 | info = info // char(226) // char(134) // char(147) // trim(num_str) |
| 809 | end block |
| 810 | end if |
| 811 | |
| 812 | cached_git_ahead_behind = info |
| 813 | cache_ahead_behind_valid = .true. |
| 814 | end function |
| 815 | |
| 816 | ! Get Python virtual environment name from VIRTUAL_ENV |
| 817 | ! Returns '(name)' if in a venv (e.g. '(.venv)'), '' if not |
| 818 | function get_venv_name() result(name) |
| 819 | character(len=:), allocatable :: name |
| 820 | character(len=4096) :: venv_path |
| 821 | integer :: i, last_sep, path_len |
| 822 | character(len=:), allocatable :: basename |
| 823 | |
| 824 | if (cache_venv_valid) then |
| 825 | name = trim(cached_venv_name) |
| 826 | return |
| 827 | end if |
| 828 | |
| 829 | call get_environment_variable('VIRTUAL_ENV', venv_path, status=i) |
| 830 | if (i /= 0 .or. len_trim(venv_path) == 0) then |
| 831 | name = '' |
| 832 | cached_venv_name = '' |
| 833 | cache_venv_valid = .true. |
| 834 | return |
| 835 | end if |
| 836 | |
| 837 | ! Extract basename (last component of path) |
| 838 | path_len = len_trim(venv_path) |
| 839 | ! Strip trailing slash if present |
| 840 | if (venv_path(path_len:path_len) == '/') path_len = path_len - 1 |
| 841 | |
| 842 | last_sep = 0 |
| 843 | do i = 1, path_len |
| 844 | if (venv_path(i:i) == '/') last_sep = i |
| 845 | end do |
| 846 | |
| 847 | if (last_sep > 0 .and. last_sep < path_len) then |
| 848 | basename = venv_path(last_sep+1:path_len) |
| 849 | else |
| 850 | basename = trim(venv_path(1:path_len)) |
| 851 | end if |
| 852 | |
| 853 | name = '(' // basename // ')' |
| 854 | cached_venv_name = name |
| 855 | cache_venv_valid = .true. |
| 856 | end function |
| 857 | |
| 858 | ! Check if current directory is in a git repository |
| 859 | function is_git_repo() result(in_git) |
| 860 | logical :: in_git |
| 861 | character(len=256) :: output |
| 862 | |
| 863 | output = execute_and_capture('git rev-parse --git-dir 2>/dev/null') |
| 864 | in_git = (len_trim(output) > 0) |
| 865 | end function |
| 866 | |
| 867 | ! Get seconds since Unix epoch (for \S escape) |
| 868 | function get_epoch_seconds() result(epoch_str) |
| 869 | character(len=20) :: epoch_str |
| 870 | integer(8) :: count, count_rate, count_max |
| 871 | integer(8) :: epoch_seconds |
| 872 | |
| 873 | ! Get system clock count |
| 874 | call system_clock(count, count_rate, count_max) |
| 875 | |
| 876 | ! Convert to seconds (this gives time since some system-defined epoch) |
| 877 | ! For a proper Unix epoch, we use date_and_time to calculate |
| 878 | epoch_seconds = get_unix_timestamp() |
| 879 | write(epoch_str, '(i20)') epoch_seconds |
| 880 | epoch_str = adjustl(epoch_str) |
| 881 | end function |
| 882 | |
| 883 | ! Calculate Unix timestamp from current date/time |
| 884 | function get_unix_timestamp() result(timestamp) |
| 885 | integer(8) :: timestamp |
| 886 | integer :: values(8) |
| 887 | integer :: year, month, day, hour, minute, second |
| 888 | integer :: days_since_epoch, y |
| 889 | |
| 890 | call date_and_time(values=values) |
| 891 | year = values(1) |
| 892 | month = values(2) |
| 893 | day = values(3) |
| 894 | hour = values(5) |
| 895 | minute = values(6) |
| 896 | second = values(7) |
| 897 | |
| 898 | ! Days from 1970 to start of current year |
| 899 | days_since_epoch = 0 |
| 900 | do y = 1970, year - 1 |
| 901 | if (is_leap_year(y)) then |
| 902 | days_since_epoch = days_since_epoch + 366 |
| 903 | else |
| 904 | days_since_epoch = days_since_epoch + 365 |
| 905 | end if |
| 906 | end do |
| 907 | |
| 908 | ! Days from start of year to start of current month |
| 909 | days_since_epoch = days_since_epoch + days_before_month(month, is_leap_year(year)) |
| 910 | |
| 911 | ! Add days in current month |
| 912 | days_since_epoch = days_since_epoch + day - 1 |
| 913 | |
| 914 | ! Convert to seconds and add time |
| 915 | timestamp = int(days_since_epoch, 8) * 86400_8 + & |
| 916 | int(hour, 8) * 3600_8 + int(minute, 8) * 60_8 + int(second, 8) |
| 917 | end function |
| 918 | |
| 919 | ! Check if year is a leap year |
| 920 | function is_leap_year(year) result(is_leap) |
| 921 | integer, intent(in) :: year |
| 922 | logical :: is_leap |
| 923 | |
| 924 | is_leap = (mod(year, 4) == 0 .and. mod(year, 100) /= 0) .or. (mod(year, 400) == 0) |
| 925 | end function |
| 926 | |
| 927 | ! Get days before a given month (1-12) |
| 928 | function days_before_month(month, leap) result(days) |
| 929 | integer, intent(in) :: month |
| 930 | logical, intent(in) :: leap |
| 931 | integer :: days |
| 932 | integer, dimension(12) :: days_in_month_normal = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] |
| 933 | integer, dimension(12) :: days_in_month_leap = [31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] |
| 934 | integer :: i |
| 935 | |
| 936 | days = 0 |
| 937 | if (leap) then |
| 938 | do i = 1, month - 1 |
| 939 | days = days + days_in_month_leap(i) |
| 940 | end do |
| 941 | else |
| 942 | do i = 1, month - 1 |
| 943 | days = days + days_in_month_normal(i) |
| 944 | end do |
| 945 | end if |
| 946 | end function |
| 947 | |
| 948 | ! Convert zsh-style color name or number to ANSI escape sequence |
| 949 | ! Supports: black, red, green, yellow, blue, magenta, cyan, white |
| 950 | ! Also supports 256-color numbers (0-255) |
| 951 | function get_ansi_color_code(color_name, is_foreground) result(ansi_code) |
| 952 | character(len=*), intent(in) :: color_name |
| 953 | logical, intent(in) :: is_foreground |
| 954 | character(len=16) :: ansi_code |
| 955 | integer :: color_num, base_code, iostat |
| 956 | character(len=32) :: lower_name |
| 957 | |
| 958 | ansi_code = '' |
| 959 | lower_name = to_lower(trim(color_name)) |
| 960 | |
| 961 | ! Try to parse as number first |
| 962 | read(color_name, *, iostat=iostat) color_num |
| 963 | if (iostat == 0) then |
| 964 | ! Valid number - use 256-color mode |
| 965 | if (color_num >= 0 .and. color_num <= 255) then |
| 966 | if (is_foreground) then |
| 967 | write(ansi_code, '(a,i0,a)') char(27)//'[38;5;', color_num, 'm' |
| 968 | else |
| 969 | write(ansi_code, '(a,i0,a)') char(27)//'[48;5;', color_num, 'm' |
| 970 | end if |
| 971 | end if |
| 972 | return |
| 973 | end if |
| 974 | |
| 975 | ! Named colors |
| 976 | base_code = 0 |
| 977 | select case (trim(lower_name)) |
| 978 | case ('black') |
| 979 | base_code = 0 |
| 980 | case ('red') |
| 981 | base_code = 1 |
| 982 | case ('green') |
| 983 | base_code = 2 |
| 984 | case ('yellow') |
| 985 | base_code = 3 |
| 986 | case ('blue') |
| 987 | base_code = 4 |
| 988 | case ('magenta') |
| 989 | base_code = 5 |
| 990 | case ('cyan') |
| 991 | base_code = 6 |
| 992 | case ('white') |
| 993 | base_code = 7 |
| 994 | case ('default') |
| 995 | if (is_foreground) then |
| 996 | ansi_code = char(27)//'[39m' |
| 997 | else |
| 998 | ansi_code = char(27)//'[49m' |
| 999 | end if |
| 1000 | return |
| 1001 | case default |
| 1002 | return ! Unknown color |
| 1003 | end select |
| 1004 | |
| 1005 | if (is_foreground) then |
| 1006 | write(ansi_code, '(a,i0,a)') char(27)//'[', 30 + base_code, 'm' |
| 1007 | else |
| 1008 | write(ansi_code, '(a,i0,a)') char(27)//'[', 40 + base_code, 'm' |
| 1009 | end if |
| 1010 | end function |
| 1011 | |
| 1012 | ! Convert string to lowercase |
| 1013 | function to_lower(str) result(lower) |
| 1014 | character(len=*), intent(in) :: str |
| 1015 | character(len=len(str)) :: lower |
| 1016 | integer :: i, ic |
| 1017 | |
| 1018 | lower = str |
| 1019 | do i = 1, len_trim(str) |
| 1020 | ic = iachar(str(i:i)) |
| 1021 | if (ic >= iachar('A') .and. ic <= iachar('Z')) then |
| 1022 | lower(i:i) = achar(ic + 32) |
| 1023 | end if |
| 1024 | end do |
| 1025 | end function |
| 1026 | |
| 1027 | ! Expand zsh-style color escapes in a string |
| 1028 | ! Supports: %F{color}, %f, %K{color}, %k, %B, %b, %U, %u |
| 1029 | subroutine expand_zsh_colors(input_str, output_str, input_len) |
| 1030 | character(len=*), intent(in) :: input_str |
| 1031 | character(len=*), intent(out) :: output_str |
| 1032 | integer, intent(in), optional :: input_len |
| 1033 | |
| 1034 | integer :: i, j, k, str_len, brace_end |
| 1035 | character(len=32) :: color_name |
| 1036 | character(len=16) :: ansi_code |
| 1037 | |
| 1038 | output_str = '' |
| 1039 | j = 1 |
| 1040 | i = 1 |
| 1041 | |
| 1042 | if (present(input_len)) then |
| 1043 | str_len = input_len |
| 1044 | else |
| 1045 | str_len = len_trim(input_str) |
| 1046 | end if |
| 1047 | |
| 1048 | do while (i <= str_len .and. j <= len(output_str)) |
| 1049 | if (input_str(i:i) == '%' .and. i < str_len) then |
| 1050 | select case (input_str(i+1:i+1)) |
| 1051 | case ('F') |
| 1052 | ! Foreground color: %F{color} |
| 1053 | if (i + 2 <= str_len .and. input_str(i+2:i+2) == '{') then |
| 1054 | brace_end = index(input_str(i+3:), '}') |
| 1055 | if (brace_end > 0) then |
| 1056 | color_name = input_str(i+3:i+2+brace_end-1) |
| 1057 | ansi_code = get_ansi_color_code(trim(color_name), .true.) |
| 1058 | if (len_trim(ansi_code) > 0) then |
| 1059 | k = len_trim(ansi_code) |
| 1060 | if (j + k - 1 <= len(output_str)) then |
| 1061 | output_str(j:j+k-1) = trim(ansi_code) |
| 1062 | j = j + k |
| 1063 | end if |
| 1064 | end if |
| 1065 | i = i + 3 + brace_end |
| 1066 | cycle |
| 1067 | end if |
| 1068 | end if |
| 1069 | ! Invalid format, output as-is |
| 1070 | output_str(j:j) = input_str(i:i) |
| 1071 | j = j + 1 |
| 1072 | i = i + 1 |
| 1073 | |
| 1074 | case ('f') |
| 1075 | ! Reset foreground color |
| 1076 | ansi_code = char(27)//'[39m' |
| 1077 | k = len_trim(ansi_code) |
| 1078 | if (j + k - 1 <= len(output_str)) then |
| 1079 | output_str(j:j+k-1) = trim(ansi_code) |
| 1080 | j = j + k |
| 1081 | end if |
| 1082 | i = i + 2 |
| 1083 | |
| 1084 | case ('K') |
| 1085 | ! Background color: %K{color} |
| 1086 | if (i + 2 <= str_len .and. input_str(i+2:i+2) == '{') then |
| 1087 | brace_end = index(input_str(i+3:), '}') |
| 1088 | if (brace_end > 0) then |
| 1089 | color_name = input_str(i+3:i+2+brace_end-1) |
| 1090 | ansi_code = get_ansi_color_code(trim(color_name), .false.) |
| 1091 | if (len_trim(ansi_code) > 0) then |
| 1092 | k = len_trim(ansi_code) |
| 1093 | if (j + k - 1 <= len(output_str)) then |
| 1094 | output_str(j:j+k-1) = trim(ansi_code) |
| 1095 | j = j + k |
| 1096 | end if |
| 1097 | end if |
| 1098 | i = i + 3 + brace_end |
| 1099 | cycle |
| 1100 | end if |
| 1101 | end if |
| 1102 | output_str(j:j) = input_str(i:i) |
| 1103 | j = j + 1 |
| 1104 | i = i + 1 |
| 1105 | |
| 1106 | case ('k') |
| 1107 | ! Reset background color |
| 1108 | ansi_code = char(27)//'[49m' |
| 1109 | k = len_trim(ansi_code) |
| 1110 | if (j + k - 1 <= len(output_str)) then |
| 1111 | output_str(j:j+k-1) = trim(ansi_code) |
| 1112 | j = j + k |
| 1113 | end if |
| 1114 | i = i + 2 |
| 1115 | |
| 1116 | case ('B') |
| 1117 | ! Bold on |
| 1118 | ansi_code = char(27)//'[1m' |
| 1119 | k = len_trim(ansi_code) |
| 1120 | if (j + k - 1 <= len(output_str)) then |
| 1121 | output_str(j:j+k-1) = trim(ansi_code) |
| 1122 | j = j + k |
| 1123 | end if |
| 1124 | i = i + 2 |
| 1125 | |
| 1126 | case ('b') |
| 1127 | ! Bold off |
| 1128 | ansi_code = char(27)//'[22m' |
| 1129 | k = len_trim(ansi_code) |
| 1130 | if (j + k - 1 <= len(output_str)) then |
| 1131 | output_str(j:j+k-1) = trim(ansi_code) |
| 1132 | j = j + k |
| 1133 | end if |
| 1134 | i = i + 2 |
| 1135 | |
| 1136 | case ('U') |
| 1137 | ! Underline on |
| 1138 | ansi_code = char(27)//'[4m' |
| 1139 | k = len_trim(ansi_code) |
| 1140 | if (j + k - 1 <= len(output_str)) then |
| 1141 | output_str(j:j+k-1) = trim(ansi_code) |
| 1142 | j = j + k |
| 1143 | end if |
| 1144 | i = i + 2 |
| 1145 | |
| 1146 | case ('u') |
| 1147 | ! Underline off |
| 1148 | ansi_code = char(27)//'[24m' |
| 1149 | k = len_trim(ansi_code) |
| 1150 | if (j + k - 1 <= len(output_str)) then |
| 1151 | output_str(j:j+k-1) = trim(ansi_code) |
| 1152 | j = j + k |
| 1153 | end if |
| 1154 | i = i + 2 |
| 1155 | |
| 1156 | case ('%') |
| 1157 | ! Literal % |
| 1158 | output_str(j:j) = '%' |
| 1159 | j = j + 1 |
| 1160 | i = i + 2 |
| 1161 | |
| 1162 | case default |
| 1163 | ! Unknown escape, output as-is |
| 1164 | output_str(j:j) = input_str(i:i) |
| 1165 | j = j + 1 |
| 1166 | i = i + 1 |
| 1167 | end select |
| 1168 | else |
| 1169 | ! Regular character |
| 1170 | output_str(j:j) = input_str(i:i) |
| 1171 | j = j + 1 |
| 1172 | i = i + 1 |
| 1173 | end if |
| 1174 | end do |
| 1175 | end subroutine |
| 1176 | |
| 1177 | ! Helper to grow an allocatable string buffer |
| 1178 | subroutine grow_string_buffer(buffer, old_capacity, new_capacity) |
| 1179 | character(len=:), allocatable, intent(inout) :: buffer |
| 1180 | integer, intent(inout) :: old_capacity |
| 1181 | integer, intent(in) :: new_capacity |
| 1182 | character(len=:), allocatable :: temp |
| 1183 | |
| 1184 | ! Save current content |
| 1185 | allocate(character(len=new_capacity) :: temp) |
| 1186 | temp = '' |
| 1187 | if (allocated(buffer)) then |
| 1188 | temp(1:old_capacity) = buffer |
| 1189 | deallocate(buffer) |
| 1190 | end if |
| 1191 | |
| 1192 | ! Allocate new larger buffer |
| 1193 | allocate(character(len=new_capacity) :: buffer) |
| 1194 | buffer = temp |
| 1195 | old_capacity = new_capacity |
| 1196 | |
| 1197 | deallocate(temp) |
| 1198 | end subroutine |
| 1199 | |
| 1200 | ! Helper to grow an allocatable components array |
| 1201 | subroutine grow_components_array(array, current_size) |
| 1202 | character(len=256), allocatable, intent(inout) :: array(:) |
| 1203 | integer, intent(inout) :: current_size |
| 1204 | character(len=256), allocatable :: new_array(:) |
| 1205 | integer :: new_size |
| 1206 | |
| 1207 | new_size = current_size * 2 |
| 1208 | allocate(new_array(new_size)) |
| 1209 | |
| 1210 | ! Copy existing data |
| 1211 | new_array(1:current_size) = array(1:current_size) |
| 1212 | |
| 1213 | ! Swap arrays |
| 1214 | call move_alloc(new_array, array) |
| 1215 | current_size = new_size |
| 1216 | end subroutine |
| 1217 | |
| 1218 | ! Expand variable references and command substitutions in prompt strings |
| 1219 | ! Handles: $VAR, ${VAR}, $(command) |
| 1220 | subroutine expand_prompt_variables(input, shell, output) |
| 1221 | character(len=*), intent(in) :: input |
| 1222 | type(shell_state_t), intent(inout) :: shell |
| 1223 | character(len=*), intent(out) :: output |
| 1224 | |
| 1225 | character(len=:), allocatable :: var_name, var_value |
| 1226 | character(len=4096) :: cmd_result |
| 1227 | integer :: i, j, start_pos, paren_count, brace_count, input_len |
| 1228 | character :: c |
| 1229 | |
| 1230 | output = '' |
| 1231 | j = 1 |
| 1232 | i = 1 |
| 1233 | input_len = len_trim(input) |
| 1234 | |
| 1235 | do while (i <= input_len .and. j < len(output)) |
| 1236 | c = input(i:i) |
| 1237 | |
| 1238 | if (c == '$' .and. i < input_len) then |
| 1239 | ! Check what follows $ |
| 1240 | if (input(i+1:i+1) == '(') then |
| 1241 | ! Command substitution $(...) |
| 1242 | start_pos = i + 2 |
| 1243 | paren_count = 1 |
| 1244 | i = i + 2 |
| 1245 | |
| 1246 | ! Find matching closing parenthesis |
| 1247 | do while (i <= input_len .and. paren_count > 0) |
| 1248 | if (input(i:i) == '(') paren_count = paren_count + 1 |
| 1249 | if (input(i:i) == ')') paren_count = paren_count - 1 |
| 1250 | i = i + 1 |
| 1251 | end do |
| 1252 | |
| 1253 | if (paren_count == 0) then |
| 1254 | ! Extract command and execute |
| 1255 | cmd_result = enhanced_command_substitution(shell, input(start_pos:i-2)) |
| 1256 | ! Copy result to output |
| 1257 | if (len_trim(cmd_result) > 0) then |
| 1258 | if (j + len_trim(cmd_result) - 1 < len(output)) then |
| 1259 | output(j:j+len_trim(cmd_result)-1) = trim(cmd_result) |
| 1260 | j = j + len_trim(cmd_result) |
| 1261 | end if |
| 1262 | end if |
| 1263 | end if |
| 1264 | |
| 1265 | else if (input(i+1:i+1) == '{') then |
| 1266 | ! Brace-enclosed variable ${VAR} |
| 1267 | start_pos = i + 2 |
| 1268 | brace_count = 1 |
| 1269 | i = i + 2 |
| 1270 | |
| 1271 | ! Find matching closing brace |
| 1272 | do while (i <= input_len .and. brace_count > 0) |
| 1273 | if (input(i:i) == '{') brace_count = brace_count + 1 |
| 1274 | if (input(i:i) == '}') brace_count = brace_count - 1 |
| 1275 | i = i + 1 |
| 1276 | end do |
| 1277 | |
| 1278 | if (brace_count == 0) then |
| 1279 | var_name = input(start_pos:i-2) |
| 1280 | var_value = get_shell_variable(shell, trim(var_name)) |
| 1281 | if (len_trim(var_value) > 0) then |
| 1282 | if (j + len_trim(var_value) - 1 < len(output)) then |
| 1283 | output(j:j+len_trim(var_value)-1) = trim(var_value) |
| 1284 | j = j + len_trim(var_value) |
| 1285 | end if |
| 1286 | end if |
| 1287 | end if |
| 1288 | |
| 1289 | else if (is_var_name_char(input(i+1:i+1))) then |
| 1290 | ! Simple variable $VAR |
| 1291 | start_pos = i + 1 |
| 1292 | i = i + 1 |
| 1293 | |
| 1294 | ! Read variable name (letters, digits, underscore) |
| 1295 | do while (i <= input_len .and. is_var_name_char(input(i:i))) |
| 1296 | i = i + 1 |
| 1297 | end do |
| 1298 | |
| 1299 | var_name = input(start_pos:i-1) |
| 1300 | var_value = get_shell_variable(shell, trim(var_name)) |
| 1301 | if (len_trim(var_value) > 0) then |
| 1302 | if (j + len_trim(var_value) - 1 < len(output)) then |
| 1303 | output(j:j+len_trim(var_value)-1) = trim(var_value) |
| 1304 | j = j + len_trim(var_value) |
| 1305 | end if |
| 1306 | end if |
| 1307 | |
| 1308 | else |
| 1309 | ! Lone $ or unrecognized pattern - copy as-is |
| 1310 | output(j:j) = c |
| 1311 | j = j + 1 |
| 1312 | i = i + 1 |
| 1313 | end if |
| 1314 | |
| 1315 | else |
| 1316 | ! Regular character |
| 1317 | output(j:j) = c |
| 1318 | j = j + 1 |
| 1319 | i = i + 1 |
| 1320 | end if |
| 1321 | end do |
| 1322 | end subroutine |
| 1323 | |
| 1324 | ! Check if character is valid in a variable name |
| 1325 | function is_var_name_char(c) result(valid) |
| 1326 | character(len=1), intent(in) :: c |
| 1327 | logical :: valid |
| 1328 | integer :: ic |
| 1329 | |
| 1330 | ic = iachar(c) |
| 1331 | valid = (ic >= iachar('a') .and. ic <= iachar('z')) .or. & |
| 1332 | (ic >= iachar('A') .and. ic <= iachar('Z')) .or. & |
| 1333 | (ic >= iachar('0') .and. ic <= iachar('9')) .or. & |
| 1334 | c == '_' |
| 1335 | end function |
| 1336 | |
| 1337 | ! Invalidate prompt element cache (call at start of each prompt expansion) |
| 1338 | subroutine invalidate_prompt_cache() |
| 1339 | cache_branch_valid = .false. |
| 1340 | cache_status_valid = .false. |
| 1341 | cache_ahead_behind_valid = .false. |
| 1342 | cache_venv_valid = .false. |
| 1343 | end subroutine |
| 1344 | |
| 1345 | ! Check if a prompt template contains a specific escape sequence (\char) |
| 1346 | function has_escape(template, esc_char) result(found) |
| 1347 | character(len=*), intent(in) :: template |
| 1348 | character(len=1), intent(in) :: esc_char |
| 1349 | logical :: found |
| 1350 | integer :: i, tlen |
| 1351 | |
| 1352 | found = .false. |
| 1353 | tlen = len_trim(template) |
| 1354 | |
| 1355 | do i = 1, tlen - 1 |
| 1356 | if (template(i:i) == '\' .and. template(i+1:i+1) == esc_char) then |
| 1357 | found = .true. |
| 1358 | return |
| 1359 | end if |
| 1360 | end do |
| 1361 | end function |
| 1362 | |
| 1363 | ! Count visible literal characters in a prompt template |
| 1364 | ! Skips: \x escape pairs, %F{...}, %K{...}, %f, %k, %B, %b, %U, %u |
| 1365 | function count_literal_chars(template) result(count) |
| 1366 | character(len=*), intent(in) :: template |
| 1367 | integer :: count |
| 1368 | integer :: i, tlen, brace_end |
| 1369 | |
| 1370 | count = 0 |
| 1371 | i = 1 |
| 1372 | tlen = len_trim(template) |
| 1373 | |
| 1374 | do while (i <= tlen) |
| 1375 | if (template(i:i) == '\' .and. i < tlen) then |
| 1376 | ! Skip \x escape pair (prompt escape, not a visible char) |
| 1377 | i = i + 2 |
| 1378 | else if (template(i:i) == '%' .and. i < tlen) then |
| 1379 | ! Skip zsh-style color sequences |
| 1380 | select case (template(i+1:i+1)) |
| 1381 | case ('F', 'K') |
| 1382 | ! %F{...} or %K{...} - skip to closing brace |
| 1383 | if (i + 2 <= tlen .and. template(i+2:i+2) == '{') then |
| 1384 | brace_end = index(template(i+3:), '}') |
| 1385 | if (brace_end > 0) then |
| 1386 | i = i + 3 + brace_end |
| 1387 | else |
| 1388 | i = i + 2 |
| 1389 | end if |
| 1390 | else |
| 1391 | i = i + 2 |
| 1392 | end if |
| 1393 | case ('f', 'k', 'B', 'b', 'U', 'u') |
| 1394 | ! Color/style resets - skip both chars |
| 1395 | i = i + 2 |
| 1396 | case ('%') |
| 1397 | ! %% = literal % |
| 1398 | count = count + 1 |
| 1399 | i = i + 2 |
| 1400 | case default |
| 1401 | count = count + 1 |
| 1402 | i = i + 1 |
| 1403 | end select |
| 1404 | else |
| 1405 | count = count + 1 |
| 1406 | i = i + 1 |
| 1407 | end if |
| 1408 | end do |
| 1409 | end function |
| 1410 | |
| 1411 | ! Calculate visual width of a UTF-8 string (counts characters, not bytes) |
| 1412 | function utf8_visual_width(str) result(width) |
| 1413 | character(len=*), intent(in) :: str |
| 1414 | integer :: width |
| 1415 | integer :: i, byte_val |
| 1416 | |
| 1417 | width = 0 |
| 1418 | do i = 1, len_trim(str) |
| 1419 | byte_val = iand(iachar(str(i:i)), 255) |
| 1420 | ! Skip UTF-8 continuation bytes (10xxxxxx = 128-191) |
| 1421 | if (byte_val < 128 .or. byte_val >= 192) then |
| 1422 | width = width + 1 |
| 1423 | end if |
| 1424 | end do |
| 1425 | end function |
| 1426 | |
| 1427 | end module prompt_formatting |
| 1428 |