| 1 | module clipboard_module |
| 2 | use iso_fortran_env, only: int32, error_unit |
| 3 | use platform_module, only: is_windows, get_temp_dir, & |
| 4 | platform_copy_to_clipboard, platform_paste_from_clipboard |
| 5 | implicit none |
| 6 | private |
| 7 | |
| 8 | public :: copy_to_clipboard, paste_from_clipboard, cut_to_clipboard |
| 9 | |
| 10 | ! Internal clipboard for when system clipboard is unavailable |
| 11 | character(len=:), allocatable :: internal_clipboard |
| 12 | |
| 13 | contains |
| 14 | |
| 15 | subroutine copy_to_clipboard(text) |
| 16 | character(len=*), intent(in) :: text |
| 17 | integer :: unit, ios |
| 18 | character(len=512) :: command |
| 19 | character(len=:), allocatable :: temp_dir, temp_file |
| 20 | |
| 21 | ! Guard against empty or invalid text |
| 22 | if (len_trim(text) == 0) return |
| 23 | |
| 24 | ! Always store in internal clipboard as fallback |
| 25 | if (allocated(internal_clipboard)) deallocate(internal_clipboard) |
| 26 | allocate(character(len=len_trim(text)) :: internal_clipboard) |
| 27 | internal_clipboard = trim(text) |
| 28 | |
| 29 | ! On Windows, use native clipboard API |
| 30 | if (is_windows()) then |
| 31 | if (platform_copy_to_clipboard(trim(text))) return |
| 32 | ! Fall through to internal clipboard only |
| 33 | return |
| 34 | end if |
| 35 | |
| 36 | ! Unix: Try to also copy to system clipboard |
| 37 | ! Write text to temp file first (avoids shell escaping issues) |
| 38 | temp_dir = get_temp_dir() |
| 39 | temp_file = temp_dir // 'facsimile_clipboard.tmp' |
| 40 | |
| 41 | open(newunit=unit, file=temp_file, & |
| 42 | status='replace', action='write', access='stream', iostat=ios) |
| 43 | |
| 44 | if (ios /= 0) return |
| 45 | |
| 46 | write(unit, iostat=ios) trim(text) |
| 47 | close(unit) |
| 48 | |
| 49 | if (ios /= 0) return |
| 50 | |
| 51 | ! Send to system clipboard using temp file |
| 52 | ! Try multiple clipboard tools via sh -c, suppress all output |
| 53 | command = "sh -c 'cat " // temp_file // " | xsel -b -i 2>/dev/null || " // & |
| 54 | "cat " // temp_file // " | xclip -sel c 2>/dev/null || " // & |
| 55 | "cat " // temp_file // " | pbcopy 2>/dev/null || " // & |
| 56 | "cat " // temp_file // " | wl-copy 2>/dev/null || true'" |
| 57 | call execute_command_line(trim(command), wait=.true., exitstat=ios) |
| 58 | |
| 59 | ! Clean up temp file |
| 60 | command = 'rm -f ' // temp_file // ' 2>/dev/null' |
| 61 | call execute_command_line(trim(command), wait=.true.) |
| 62 | end subroutine copy_to_clipboard |
| 63 | |
| 64 | function paste_from_clipboard() result(text) |
| 65 | character(len=:), allocatable :: text |
| 66 | integer :: unit, ios, file_size |
| 67 | character(len=512) :: command |
| 68 | character(len=:), allocatable :: buffer, temp_dir, temp_file |
| 69 | |
| 70 | text = '' |
| 71 | |
| 72 | ! On Windows, use native clipboard API |
| 73 | if (is_windows()) then |
| 74 | text = platform_paste_from_clipboard() |
| 75 | if (len_trim(text) > 0) return |
| 76 | ! Fall through to internal clipboard |
| 77 | goto 100 |
| 78 | end if |
| 79 | |
| 80 | ! Unix: Try system clipboard first |
| 81 | temp_dir = get_temp_dir() |
| 82 | temp_file = temp_dir // 'facsimile_clipboard.tmp' |
| 83 | |
| 84 | command = "sh -c 'xsel -b -o > " // temp_file // " 2>/dev/null || " // & |
| 85 | "xclip -sel c -o > " // temp_file // " 2>/dev/null || " // & |
| 86 | "pbpaste > " // temp_file // " 2>/dev/null || " // & |
| 87 | "wl-paste > " // temp_file // " 2>/dev/null || true'" |
| 88 | call execute_command_line(trim(command), wait=.true., exitstat=ios) |
| 89 | |
| 90 | if (ios == 0) then |
| 91 | ! Try to read the clipboard content |
| 92 | open(newunit=unit, file=temp_file, & |
| 93 | status='old', action='read', access='stream', iostat=ios) |
| 94 | |
| 95 | if (ios == 0) then |
| 96 | inquire(unit=unit, size=file_size) |
| 97 | if (file_size > 0 .and. file_size < 1000000) then |
| 98 | allocate(character(len=file_size) :: buffer) |
| 99 | read(unit, iostat=ios) buffer |
| 100 | if (ios == 0) then |
| 101 | allocate(character(len=file_size) :: text) |
| 102 | text = buffer |
| 103 | end if |
| 104 | if (allocated(buffer)) deallocate(buffer) |
| 105 | end if |
| 106 | close(unit) |
| 107 | end if |
| 108 | |
| 109 | ! Clean up temp file |
| 110 | command = 'rm -f ' // temp_file // ' 2>/dev/null' |
| 111 | call execute_command_line(trim(command), wait=.true.) |
| 112 | end if |
| 113 | |
| 114 | 100 continue |
| 115 | ! Fall back to internal clipboard if system clipboard failed or was empty |
| 116 | if (len_trim(text) == 0 .and. allocated(internal_clipboard)) then |
| 117 | if (len(internal_clipboard) > 0) then |
| 118 | if (allocated(text)) deallocate(text) |
| 119 | allocate(character(len=len(internal_clipboard)) :: text) |
| 120 | text = internal_clipboard |
| 121 | end if |
| 122 | end if |
| 123 | end function paste_from_clipboard |
| 124 | |
| 125 | subroutine cut_to_clipboard(text) |
| 126 | character(len=*), intent(in) :: text |
| 127 | ! Cut is just copy (caller handles deletion) |
| 128 | call copy_to_clipboard(text) |
| 129 | end subroutine cut_to_clipboard |
| 130 | |
| 131 | end module clipboard_module |