[sbron] 2023-04-12 The https://flatpak.github.io/xdg-desktop-portal%|%flatpak xdg-desktop-portal%|% provides APIs to several desktop facilities. With this portal and a suitable backend installed on your linux system, many native desktop dialogs can be accessed via the D-Bus. By using the Tcl dbus library ([dbus-tcl]), it is not hard to incorporate such dialogs in your Tcl/Tk program.

One example is to present a native file dialog for the user to choose a file to open or save. The code below can be used as an alternative to the rather limited built-in dialogs.

'''xdm/filechooser-0.1.tm''' (somewhere in the tcl::tm::path):
======
namespace eval xdg::filechooser {
    if {![catch {package require dbus} err]} {
        variable dbus [dbus connect]
        if {[dbus call $dbus -dest [dbus info $dbus service] \
          [dbus info $dbus path] [dbus info $dbus service] NameHasOwner \
          org.freedesktop.portal.Desktop]} {
            namespace export tk_getOpenFile tk_getSaveFile
            variable sender \
              [string map {. _} [string trimleft [dbus info $dbus name] :]]
            if {[dbus call $dbus -dest org.freedesktop.portal.Desktop \
              /org/freedesktop/portal/desktop \
              org.freedesktop.DBus.Properties Get \
              org.freedesktop.portal.FileChooser version] >= 3} {
                namespace export tk_chooseDirectory
            }
        }
    }

    variable titles {
        open    "Open"
        save    "Save As"
        dir     "Choose Directory"
    }

    proc tk_getOpenFile {args} {
        tailcall filechooser open $args
    }

    proc tk_getSaveFile {args} {
        tailcall filechooser save $args
    }

    proc tk_chooseDirectory {args} {
        tailcall filechooser dir $args
    }

    proc filechooser {mode argv} {
        variable dbus
        variable sender
        variable titles
        set token [format tcl%d [info cmdcount]]
        set xid ""
        set title [dict get $titles $mode]
        set multiple 0
        set typevar ""
        set options [dict create handle_token [list s $token]]
        if {$mode eq "save"} {
            set method SaveFile
        } else {
            set method OpenFile
            dict set options directory [list b [expr {$mode eq "dir"}]]
        }
        # Parse the options
        foreach {opt val} $argv {
            switch -- $opt {
                -confirmoverwrite {
                    # Not supported by xdg-desktop-portal
                }
                -defaultextension {
                    # Not supported by xdg-desktop-portal
                }
                -filetypes {
                    set filetypes $val
                    dict set options filters [list a(sa(us)) [filters $val]]
                }
                -initialdir {
                    # Only works for tk_getSaveFile
                    dict set options current_folder [list ay [cstring $val]]
                }
                -initialfile {
                    # Only works for tk_getSaveFile
                    dict set options current_file [list ay [cstring $val]]
                }
                -multiple {
                    # Only works for tk_getOpenFile
                    set multiple $val
                    dict set options multiple [list b $val]
                }
                -parent {
                    set xid [format %s:%x [tk windowingsystem] [winfo id $val]]
                }
                -title {
                    set title $val
                }
                -typevariable {
                    set typevar $val
                }
                -command - -message {
                    # Only used on Mac OS
                }
                -choices {
                    dict set options choices [list a(ssa(ss)s) $val]
                }
            }
        }
        if {$typevar ne ""} {
            upvar #0 $typevar var
            if {[info exists var]} {
                set x [lsearch -index 0 $filetypes $var]
                if {$x >= 0} {
                    set initial [lindex [dict get $options filters] 1 $x]
                    dict set options current_filter [list (sa(us)) $initial]
                }
            }
        }
        # Set up a callback for the result
        set callback [list [namespace which response] $typevar]
        set path /org/freedesktop/portal/desktop/request/$sender/$token
        dbus filter $dbus add -sender org.freedesktop.portal.Desktop \
           -type signal -interface org.freedesktop.portal.Request \
           -path $path -member Response
        dbus listen $dbus \
          $path org.freedesktop.portal.Request.Response $callback
        # Bring up the dialog
        set handle [dbus call $dbus -dest org.freedesktop.portal.Desktop \
          -signature ssa{sv} /org/freedesktop/portal/desktop \
          org.freedesktop.portal.FileChooser $method $xid $title $options]
        # Support older versions of xdg-desktop-portal
        if {$handle ne $path} {
            # Install a different handler
            dbus filter $dbus add -sender org.freedesktop.portal.Desktop \
              -type signal -interface org.freedesktop.portal.Request \
              -path $handle -member Response
            dbus listen $dbus \
              $handle org.freedesktop.portal.Request.Response $callback
            # Remove the incorrect handler
            dbus filter $dbus remove -sender org.freedesktop.portal.Desktop \
              -type signal -interface org.freedesktop.portal.Request \
              -path $path -member Response
            dbus listen $dbus $path org.freedesktop.portal.Request.Response {}
            set path $handle
        }
        variable result
        vwait [namespace which -variable result]($path)
        # Remove the handler
        dbus filter $dbus remove -sender org.freedesktop.portal.Desktop \
          -type signal -interface org.freedesktop.portal.Request \
          -path $path -member Response
        dbus listen $dbus $path org.freedesktop.portal.Request.Response {}
        # Return the result
        if {$multiple} {
            set rc $result($path)
        } else {
            set rc [lindex $result($path) 0]
        }
        unset result($path)
        return $rc
    }

    proc filters {types} {
        set rc {}
        foreach type $types {
            lassign $type name exts mimetype
            if {[string match */* $mimetype]} {
                set filter [list [list 1 $mimetype]]
            } else {
                set hint {}
                set filter [lmap ext $exts {
                    if {$ext ne "*"} {set ext "*$ext"}
                    lappend hint $ext
                    list 0 $ext
                }]
                if {[llength $hint]} {
                    append name " ([join $hint {, }])"
                }
            }
            lappend rc [list $name $filter]
        }
        return $rc
    }

    proc cstring {str} {
        binary scan [encoding convertto [encoding system] $str]\0 cu* bytes
        return $bytes
    }

    proc response {var info rc results} {
        variable result
        set path [dict get $info path]
        set files [lmap n [dict get $results uris] {regsub {^file:///} $n /}]
        if {$var ne "" && [dict exists $results current_filter]} {
            upvar #0 $var typevar
            set filter [lindex [dict get $results current_filter] 0]
            regsub {(.*) +\(.*\)} $filter {\1} typevar
        }
        if {[dict exists $results choices]} {
            foreach choice [dict get $results choices] {
                lassign $choice func value
                if {[catch {{*}$func $value $files} err]} {
                    puts stderr $err
                }
            }
        }
        set result($path) $files
    }
}

======

To replace the standard file dialog commands, use it as follows:

======
package require xdg::filechooser
namespace import -force xdg::filechooser::*
======

There are some limitations. For example, it is not possible to specify an initial directory or file name when opening a file. The dialog will just use the directory that was last selected. There is also no option to prevent a confirmation box when selecting an existing file to save.

On the other hand, the dialog does provide the possibility to add a combobox or checkbutton to the dialog for additional settings the user can make. This is supported in the code above via the -choices option. This option takes a list of specifications, similar to the -filetypes option. Each entry is a list of: cmdprefix, label, choices, default. Where choices is a list of choices, each in turn a 2-element list of id and label. When an empty list of choices is passed, the setting will be shown as a checkbutton, rather than a combobox. When the user completes the file selection, the cmdprefix for each of the -choices entries is invoked with two additional arguments: The selected combobox entry, or true/false for a checkbox, and a list of selected files.

<<categories>>File | Dialog