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