]>
Commit | Line | Data |
---|---|---|
1 | # | |
2 | # edprocs.tcl -- | |
3 | # | |
4 | # Tools for Tcl developers. Procedures to save procs to a file and to edit | |
5 | # a proc in memory. | |
6 | #------------------------------------------------------------------------------ | |
7 | # Copyright 1992 Karl Lehenbauer and Mark Diekhans. | |
8 | # | |
9 | # Permission to use, copy, modify, and distribute this software and its | |
10 | # documentation for any purpose and without fee is hereby granted, provided | |
11 | # that the above copyright notice appear in all copies. Karl Lehenbauer and | |
12 | # Mark Diekhans make no representations about the suitability of this | |
13 | # software for any purpose. It is provided "as is" without express or | |
14 | # implied warranty. | |
15 | #------------------------------------------------------------------------------ | |
16 | # $Id: edprocs.tcl,v 2.0 1992/10/16 04:51:57 markd Rel $ | |
17 | #------------------------------------------------------------------------------ | |
18 | # | |
19 | ||
20 | #@package: TclX-developer_utils saveprocs edprocs | |
21 | ||
22 | proc saveprocs {fileName args} { | |
23 | set fp [open $fileName w] | |
24 | puts $fp "# tcl procs saved on [fmtclock [getclock]]\n" | |
25 | puts $fp [eval "showprocs $args"] | |
26 | close $fp | |
27 | } | |
28 | ||
29 | proc edprocs {args} { | |
30 | global env | |
31 | ||
32 | set tmpFilename /tmp/tcldev.[id process] | |
33 | ||
34 | set fp [open $tmpFilename w] | |
35 | puts $fp "\n# TEMP EDIT BUFFER -- YOUR CHANGES ARE FOR THIS SESSION ONLY\n" | |
36 | puts $fp [eval "showprocs $args"] | |
37 | close $fp | |
38 | ||
39 | if [info exists env(EDITOR)] { | |
40 | set editor $env(EDITOR) | |
41 | } else { | |
42 | set editor vi | |
43 | } | |
44 | ||
45 | set startMtime [file mtime $tmpFilename] | |
46 | system "$editor $tmpFilename" | |
47 | ||
48 | if {[file mtime $tmpFilename] != $startMtime} { | |
49 | source $tmpFilename | |
50 | echo "Procedures were reloaded." | |
51 | } else { | |
52 | echo "No changes were made." | |
53 | } | |
54 | unlink $tmpFilename | |
55 | return | |
56 | } |