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-1999 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 1.2 2004/11/23 00:35:20 hobbs Exp $
17#------------------------------------------------------------------------------
18#
19
20#@package: TclX-developer_utils saveprocs edprocs
21
22proc saveprocs {fileName args} {
23    set fp [open $fileName w]
24    try_eval {
25        puts $fp "# tcl procs saved on [fmtclock [getclock]]\n"
26        puts $fp [eval "showproc $args"]
27    } {} {
28        close $fp
29    }
30}
31
32proc edprocs {args} {
33    global env
34
35    set tmpFilename /tmp/tcldev.[pid].[clock seconds]
36    set access [list RDWR CREAT EXCL TRUNC]
37    set perm 0600
38    if {[catch {open $tmpFilename $access $perm} fp]} {
39	# something went wrong
40	return -code error "Could not open temporary file:\n$fp"
41    }
42
43    try_eval {
44        puts $fp "\n# TEMP EDIT BUFFER -- YOUR CHANGES ARE FOR THIS SESSION ONLY\n"
45        puts $fp [eval [linsert $args 0 showproc]]
46    } {} {
47        close $fp
48    }
49
50    if {[info exists env(EDITOR)]} {
51        set editor $env(EDITOR)
52    } else {
53	set editor vi
54    }
55
56    set startMtime [file mtime $tmpFilename]
57    system "$editor $tmpFilename"
58
59    if {[file mtime $tmpFilename] != $startMtime} {
60	source $tmpFilename
61	echo "Procedures were reloaded."
62    } else {
63	echo "No changes were made."
64    }
65    unlink $tmpFilename
66    return
67}
68
69
70