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     ! 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.