File: undo.tcl

package info (click to toggle)
cbb 0.73-4
  • links: PTS
  • area: main
  • in suites: hamm
  • size: 1,620 kB
  • ctags: 650
  • sloc: tcl: 4,388; perl: 3,843; makefile: 140; sh: 2
file content (128 lines) | stat: -rw-r--r-- 3,808 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
#
#  'CBB' -- Check Book Balancer
#
#   undo.tcl -- Undo routines.
#
#  Written by Curtis Olson.  Started December 7, 1996.
#
#  Copyright (C) 1994 - 1997  Curtis L. Olson  - curt@sledge.mn.org
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# $Id: undo.tcl,v 2.5 1997/04/11 20:26:52 curt Exp $
# (Log is kept at end of this file)


#------------------------------------------------------------------------------
# Procedures to handle undo functionality
#------------------------------------------------------------------------------

proc undoInit {} {
    global undo

    set undo(command) ""
    set undo(data) ""
}

proc undoRegister arg {
    global undo

    set pos [string first " " $arg]
    set undo(command) [string range $arg 0 [expr $pos - 1]]
    set undo(data) [string range $arg [expr $pos + 1] end]
}

proc undoAction {} {
    global cbb key eng undo

    if { $cbb(debug) } { puts "un$undo(command) $undo(data)" }

    if { "$undo(command)" == "delete" } {
    	# reinsert

        update_globals $undo(data)
        set key ""
        done_entering
    } elseif { "$undo(command)" == "insert" } {
        # delete

    	set pos [string first "\t" $undo(data)]
        set key [string range $undo(data) 0 [expr $pos - 1]]

        puts $eng "delete_trans $key"; flush $eng
        gets $eng result
        if { $cbb(debug) } { puts "deleting:  $result" }

        set cbb(index1) [find_index_from_key [listGetSize] $key]
        if { [expr $cbb(index1) < 0] } {
            set cbb(index1) 0
        }
        update_rest $cbb(index1) $key
    } elseif { "$undo(command)" == "edit" } {
        # change back

	set newkey [string range $undo(data) 0 10]
	if { $cbb(debug) } { puts "first need to delete $newkey" }
	puts $eng "delete_trans $newkey"; flush $eng
	gets $eng result
	if { $cbb(debug) } { puts "deleting:  $result" }

	set cbb(index1) [find_index_from_key [listGetSize] $newkey]
	if { [expr $cbb(index1) < 0] } {
	    set cbb(index1) 0
	}
	update_rest $cbb(index1) $newkey

	if { $cbb(debug) } {
	    puts "-> [string range $undo(data) 12 end]"
	}

        update_globals [string range $undo(data) 12 end]
        done_entering
    } else {
        cbbWindow.ok "Nothing to undo  :-("
        tkwait window .ok
    }

    undoInit
    clear_entry_area
}


# ----------------------------------------------------------------------------
# $Log: undo.tcl,v $
# Revision 2.5  1997/04/11 20:26:52  curt
# $index1, $index2 wrapped up so they are now $cbb(index1), and $cbb(index2)
#
# Revision 2.4  1997/01/02 04:38:39  curt
# Changes over the 1996 holidays:
#   - Converted listbox to text widget.  This allows us to do nice
#     things with alternating background colors, highliting, red
#     negative numbers, etc.
#   - Negative transactions are now drawn in red.
#   - Added a Goto <Today> option.
#   - <Home> & <End> were double bound.  Now, listbox can be traversed with
#     <Meta-Home> and <Meta-End>
#
# Revision 2.3  1996/12/17 14:54:03  curt
# Updated copyright date.
#
# Revision 2.2  1996/12/14 17:15:26  curt
# The great overhaul of December '96.
#
# Revision 2.1  1996/12/08 07:37:50  curt
# Initial revision.
#