Return to edprocs.tcl CVS log

Up to [Micropolis - Activity] / micropolis / src / tclx / tclsrc

Annotation of micropolis/src/tclx/tclsrc/edprocs.tcl, revision 1.1.1.1

1.1       root        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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.