diff options
Diffstat (limited to 'library/tk.tcl')
-rw-r--r-- | library/tk.tcl | 34 |
1 files changed, 33 insertions, 1 deletions
diff --git a/library/tk.tcl b/library/tk.tcl index daba5d6..64afbe7 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -3,7 +3,7 @@ # Initialization script normally executed in the interpreter for each # Tk-based application. Arranges class bindings for widgets. # -# RCS: @(#) $Id: tk.tcl,v 1.29 2001/03/31 05:46:10 hobbs Exp $ +# RCS: @(#) $Id: tk.tcl,v 1.30 2001/07/03 01:03:16 hobbs Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -151,6 +151,38 @@ proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} { } } +# ::tk::GetSelection -- +# This tries to obtain the default selection. On Unix, we first try +# and get a UTF8_STRING, a type supported by modern Unix apps for +# passing Unicode data safely. We fall back on the default STRING +# type otherwise. On Windows, only the STRING type is necessary. +# Arguments: +# w The widget for which the selection will be retrieved. +# Important for the -displayof property. +# sel The source of the selection (PRIMARY or CLIPBOARD) +# Results: +# Returns the selection, or an error if none could be found +# +if {[string equal $tcl_platform(platform) "unix"]} { + proc ::tk::GetSelection {w {sel PRIMARY}} { + if {[catch {selection get -displayof $w -selection $sel \ + -type UTF8_STRING} txt] \ + && [catch {selection get -displayof $w -selection $sel} txt]} { + return -code error "could not find default selection" + } else { + return $txt + } + } +} else { + proc ::tk::GetSelection {w {sel PRIMARY}} { + if {[catch {selection get -displayof $w -selection $sel} txt]} { + return -code error "could not find default selection" + } else { + return $txt + } + } +} + # tkScreenChanged -- # This procedure is invoked by the binding mechanism whenever the # "current" screen is changing. The procedure does two things. |