Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Cutting and pasting text with formatting tagging.

6 views
Skip to first unread message

William J Giddings

unread,
Feb 18, 2003, 10:51:42 AM2/18/03
to
Has anyone got any good ideas on coding a 'quick-n-easy' way of cutting and
pasting text, tags and markers en block from one tk text widget to another?

Will

Chengye Mao

unread,
Feb 18, 2003, 9:33:34 PM2/18/03
to
"William J Giddings" <wgdl...@blueyonder.co.uk> wrote in message news:<zCs4a.13934$NJ4....@news-binary.blueyonder.co.uk>...

> Has anyone got any good ideas on coding a 'quick-n-easy' way of cutting and
> pasting text, tags and markers en block from one tk text widget to another?
>
> Will

I implemented cutting and pasting text with tags in a Tk text editor
included into the XBit package. But I have not found a 'quick-n-easy'
way of doing it.

Chengye Mao

http://www.geocities.com/~chengye

William J Giddings

unread,
Feb 19, 2003, 6:17:20 AM2/19/03
to
Chengye,

Thanks for the info. I'll have a hack at it some other time.

Will

Bryan Oakley

unread,
Feb 20, 2003, 9:32:31 AM2/20/03
to
William J Giddings wrote:
> Has anyone got any good ideas on coding a 'quick-n-easy' way of cutting and
> pasting text, tags and markers en block from one tk text widget to another?

Back in the last century :-) I wrote a package named "ttd" (tagged text
dump) which does this. I never polished it, but I think it might do what
you want.

see http://www.purl.org/net/oakley/tcl/ttd.html

You can use it like this:

text .t1
text .t2
....
set data [::ttd::get .t1 1.0 end]
::ttd::insert .t2 $data

I haven't played with this code in years, but my recollection is that it
worked pretty darn good.

Digging through my disk I see I have an updated version (sprinkled with
some debugging output) that lets you specify an index for the insert
command, and also attempts to preserve tag bingings, and maybe some
other features. I'll be glad to email a copy to anyone who wants to play
with it. I have no idea if this newer version works, or if it is an
aborted work in progress.

William J Giddings

unread,
Feb 20, 2003, 4:56:24 PM2/20/03
to
Brian,

Thanks for the reply. I have a copy of ttd and it is in regular use with
some of my code. As you say, it does work pretty darn good. Mmmm, the
question is: for the sake of expediency should I scrap my existing
formatting code and opt entirely for ttd?

I obtained ttd through Vtcl. If you have a version later than the one
shipped with Vtcl then I'd be chuffed to have a copy.

Regards

Will

David McClamrock

unread,
Feb 21, 2003, 6:19:26 AM2/21/03
to
William J Giddings wrote:

Here's some code I've just written that does the job, at least with tags.
(Marks should be easy to add.) Thanks for inducing me to do some work on my
biggest and most daunting project to date, a simple but (I hope) fairly
powerful word processor written entirely in Tcl/Tk.

This code requires Tcl 8.4 because it uses the "lsearch -start" option, a
big improvement over repeatedly specifying different ranges of a list of
tags to search. To cut or copy text with tags, just set the variable "t" to
hold the name of the text widget; then select the text and invoke
"formaclip copy" to copy or "formaclip cut" to cut. To paste the text with
tags, set "t" to hold the name of the target text widget and put the cursor
where you want the text; then invoke "formapaste." Bindings and other tag
attributes can be preserved by preconfiguring identically named tags for
each text widget.

Let me know what you think if you give this code a try, especially if you
find any bugs.

David McClamrock
____________________________________

# Procedure to cut or copy text plus tags

proc formaclip {how} {

# Variables "textclips" and "tagclips"
# will hold selected text and tags:
global t textclips tagclips
set tagclips ""

# Get text and tags:
set textclips [$t get sel.first sel.last]
set gottags [$t dump -tag sel.first sel.last]

# Calculate offsets for line and character settings:
set offset [$t index sel.first]
set offers [split $offset .]
set offling [expr [lindex $offers 0] -1]
set offchug [lindex $offers end]
set oggset [$t index sel.last]
set oggers [split $oggset .]
set oggling [expr [lindex $oggers 0] -1]
set oggchug [lindex $oggers end]

# List on/off, name, and position for each tag
# beginning or ending within selection:
set taglist ""
for { set d 0 } { $d < [llength $gottags] } { incr d 3 } {
set onoroff [lindex $gottags $d]
set tagname [lindex $gottags [expr $d+1]]
set tagloc [lindex $gottags [expr $d+2]]
if { $tagname != "sel" } {
lappend taglist [list $onoroff $tagname $tagloc]
}
}

# Specify tags that begin before the
# beginning of the selection:
set firsttags [$t tag names sel.first]
foreach taggo $firsttags {
if { $taggo == "sel" } {
continue
}
set online 0
set onchar 0
set offtag [lsearch $taglist "tagoff $taggo*"]
if { $offtag != -1 } {
set offum [lindex $taglist $offtag]
set offnum [lindex $offum end]
set offoo [split $offnum .]
set offline [expr [lindex $offoo 0] - $offling - 1]
} else {
set offline $oggling
}
if { $offtag != -1 } {
if { $offline == 0 } {
set offchar [expr [lindex \
$offoo end] - $offchug]
} else {
set offchar [lindex $offoo end]
}
} else {
if { $offline == 0 } {
set offchar [expr $oggchug - $offchug]
} else {
set offchar $oggchug
}
}
lappend tagclips [list $taggo $online \
$onchar $offline $offchar]
}

# Specify tags that begin within the selection:
for { set a 0 } { $a < [llength $taglist] } { incr a } {
set taggie [lindex $taglist $a]
if { [lindex $taggie 0] == "tagon" } {
set tagnew $a
set tagger [lindex $taggie 1]
set tigger [lindex $taggie 2]
set tugger [split $tigger .]
set rugger [lindex $tugger 0]
set online [expr $rugger - $offling -1]
if { $online == 0 } {
set onchar [expr [lindex \
$tugger end] - $offchug]
} else {
set onchar [lindex $tugger end]
}
set offtag [lsearch -start $a \
$taglist "tagoff $tagger*"]
if { $offtag != -1 } {
set offum [lindex $taglist $offtag]
set offnum [lindex $offum end]
set offoo [split $offnum .]
set offline [expr [lindex \
$offoo 0] - $offling - 1]
if { $offline == 0 } {
set offchar [expr [lindex \
$offoo end] - $offchug]
} else {
set offchar [lindex $offoo end]
}
} else {
set offline $oggling
if { $offline == 0 } {
set offchar [expr $oggchug - $offchug]
} else {
set offchar $oggchug
}
}
lappend tagclips [list $tagger $online \
$onchar $offline $offchar]
}
}

# Delete copied text, and tags it contains,
# if "cut" not "copy" is requested:
if { $how == "cut" } {
$t delete sel.first sel.last
}
}

# Procedure to paste text plus tags:

proc formapaste {} {
global t textclips tagclips
set inpoint [$t index insert]
$t insert $inpoint $textclips
set ingroup [split $inpoint .]
set inline [lindex $ingroup 0]
set inchar [lindex $ingroup end]
foreach taggum $tagclips {
set tagnom [lindex $taggum 0]
set input [expr [lindex $taggum 1] + $inline]
if { $input == $inline } {
set inpunt [expr [lindex $taggum 2] + $inchar]
} else {
set inpunt [lindex $taggum 2]
}
set output [expr [lindex $taggum 3] +$inline]
if { $input == $inline } {
set outpunt [expr [lindex $taggum 4] + $inchar]
} else {
set outpunt [lindex $taggum 4]
}
$t tag add $tagnom $input.$inpunt $output.$outpunt
}
}


Jeffrey Hobbs

unread,
Feb 22, 2003, 1:01:22 PM2/22/03
to
David McClamrock wrote:
> set offling [expr [lindex $offers 0] -1]

Don't forget to always {} your expr's, unless you really mean not to.
It will always speed up your code.

--
Jeff Hobbs The Tcl Guy
Senior Developer http://www.ActiveState.com/
Tcl Support and Productivity Solutions

0 new messages