sbron 2023-04-12 The 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.