home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / history.tcl < prev    next >
Text File  |  2003-09-01  |  9KB  |  377 lines
  1. # history.tcl --
  2. #
  3. # Implementation of the history command.
  4. #
  5. # RCS: @(#) $Id: history.tcl,v 1.5 2001/05/17 08:18:56 hobbs Exp $
  6. #
  7. # Copyright (c) 1997 Sun Microsystems, Inc.
  8. #
  9. # See the file "license.terms" for information on usage and redistribution
  10. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11. #
  12.  
  13. # The tcl::history array holds the history list and
  14. # some additional bookkeeping variables.
  15. #
  16. # nextid    the index used for the next history list item.
  17. # keep        the max size of the history list
  18. # oldest    the index of the oldest item in the history.
  19.  
  20. namespace eval tcl {
  21.     variable history
  22.     if {![info exists history]} {
  23.     array set history {
  24.         nextid    0
  25.         keep    20
  26.         oldest    -20
  27.     }
  28.     }
  29. }
  30.  
  31. # history --
  32. #
  33. #    This is the main history command.  See the man page for its interface.
  34. #    This does argument checking and calls helper procedures in the
  35. #    history namespace.
  36.  
  37. proc history {args} {
  38.     set len [llength $args]
  39.     if {$len == 0} {
  40.     return [tcl::HistInfo]
  41.     }
  42.     set key [lindex $args 0]
  43.     set options "add, change, clear, event, info, keep, nextid, or redo"
  44.     switch -glob -- $key {
  45.     a* { # history add
  46.  
  47.         if {$len > 3} {
  48.         return -code error "wrong # args: should be \"history add event ?exec?\""
  49.         }
  50.         if {![string match $key* add]} {
  51.         return -code error "bad option \"$key\": must be $options"
  52.         }
  53.         if {$len == 3} {
  54.         set arg [lindex $args 2]
  55.         if {! ([string match e* $arg] && [string match $arg* exec])} {
  56.             return -code error "bad argument \"$arg\": should be \"exec\""
  57.         }
  58.         }
  59.         return [tcl::HistAdd [lindex $args 1] [lindex $args 2]]
  60.     }
  61.     ch* { # history change
  62.  
  63.         if {($len > 3) || ($len < 2)} {
  64.         return -code error "wrong # args: should be \"history change newValue ?event?\""
  65.         }
  66.         if {![string match $key* change]} {
  67.         return -code error "bad option \"$key\": must be $options"
  68.         }
  69.         if {$len == 2} {
  70.         set event 0
  71.         } else {
  72.         set event [lindex $args 2]
  73.         }
  74.  
  75.         return [tcl::HistChange [lindex $args 1] $event]
  76.     }
  77.     cl* { # history clear
  78.  
  79.         if {($len > 1)} {
  80.         return -code error "wrong # args: should be \"history clear\""
  81.         }
  82.         if {![string match $key* clear]} {
  83.         return -code error "bad option \"$key\": must be $options"
  84.         }
  85.         return [tcl::HistClear]
  86.     }
  87.     e* { # history event
  88.  
  89.         if {$len > 2} {
  90.         return -code error "wrong # args: should be \"history event ?event?\""
  91.         }
  92.         if {![string match $key* event]} {
  93.         return -code error "bad option \"$key\": must be $options"
  94.         }
  95.         if {$len == 1} {
  96.         set event -1
  97.         } else {
  98.         set event [lindex $args 1]
  99.         }
  100.         return [tcl::HistEvent $event]
  101.     }
  102.     i* { # history info
  103.  
  104.         if {$len > 2} {
  105.         return -code error "wrong # args: should be \"history info ?count?\""
  106.         }
  107.         if {![string match $key* info]} {
  108.         return -code error "bad option \"$key\": must be $options"
  109.         }
  110.         return [tcl::HistInfo [lindex $args 1]]
  111.     }
  112.     k* { # history keep
  113.  
  114.         if {$len > 2} {
  115.         return -code error "wrong # args: should be \"history keep ?count?\""
  116.         }
  117.         if {$len == 1} {
  118.         return [tcl::HistKeep]
  119.         } else {
  120.         set limit [lindex $args 1]
  121.         if {[catch {expr {~$limit}}] || ($limit < 0)} {
  122.             return -code error "illegal keep count \"$limit\""
  123.         }
  124.         return [tcl::HistKeep $limit]
  125.         }
  126.     }
  127.     n* { # history nextid
  128.  
  129.         if {$len > 1} {
  130.         return -code error "wrong # args: should be \"history nextid\""
  131.         }
  132.         if {![string match $key* nextid]} {
  133.         return -code error "bad option \"$key\": must be $options"
  134.         }
  135.         return [expr {$tcl::history(nextid) + 1}]
  136.     }
  137.     r* { # history redo
  138.  
  139.         if {$len > 2} {
  140.         return -code error "wrong # args: should be \"history redo ?event?\""
  141.         }
  142.         if {![string match $key* redo]} {
  143.         return -code error "bad option \"$key\": must be $options"
  144.         }
  145.         return [tcl::HistRedo [lindex $args 1]]
  146.     }
  147.     default {
  148.         return -code error "bad option \"$key\": must be $options"
  149.     }
  150.     }
  151. }
  152.  
  153. # tcl::HistAdd --
  154. #
  155. #    Add an item to the history, and optionally eval it at the global scope
  156. #
  157. # Parameters:
  158. #    command        the command to add
  159. #    exec        (optional) a substring of "exec" causes the
  160. #            command to be evaled.
  161. # Results:
  162. #     If executing, then the results of the command are returned
  163. #
  164. # Side Effects:
  165. #    Adds to the history list
  166.  
  167.  proc tcl::HistAdd {command {exec {}}} {
  168.     variable history
  169.  
  170.     # Do not add empty commands to the history
  171.     if {[string trim $command] == ""} {
  172.     return ""
  173.     }
  174.  
  175.     set i [incr history(nextid)]
  176.     set history($i) $command
  177.     set j [incr history(oldest)]
  178.     if {[info exists history($j)]} {unset history($j)}
  179.     if {[string match e* $exec]} {
  180.     return [uplevel #0 $command]
  181.     } else {
  182.     return {}
  183.     }
  184. }
  185.  
  186. # tcl::HistKeep --
  187. #
  188. #    Set or query the limit on the length of the history list
  189. #
  190. # Parameters:
  191. #    limit    (optional) the length of the history list
  192. #
  193. # Results:
  194. #    If no limit is specified, the current limit is returned
  195. #
  196. # Side Effects:
  197. #    Updates history(keep) if a limit is specified
  198.  
  199.  proc tcl::HistKeep {{limit {}}} {
  200.     variable history
  201.     if {[string length $limit] == 0} {
  202.     return $history(keep)
  203.     } else {
  204.     set oldold $history(oldest)
  205.     set history(oldest) [expr {$history(nextid) - $limit}]
  206.     for {} {$oldold <= $history(oldest)} {incr oldold} {
  207.         if {[info exists history($oldold)]} {unset history($oldold)}
  208.     }
  209.     set history(keep) $limit
  210.     }
  211. }
  212.  
  213. # tcl::HistClear --
  214. #
  215. #    Erase the history list
  216. #
  217. # Parameters:
  218. #    none
  219. #
  220. # Results:
  221. #    none
  222. #
  223. # Side Effects:
  224. #    Resets the history array, except for the keep limit
  225.  
  226.  proc tcl::HistClear {} {
  227.     variable history
  228.     set keep $history(keep)
  229.     unset history
  230.     array set history [list \
  231.     nextid    0    \
  232.     keep    $keep    \
  233.     oldest    -$keep    \
  234.     ]
  235. }
  236.  
  237. # tcl::HistInfo --
  238. #
  239. #    Return a pretty-printed version of the history list
  240. #
  241. # Parameters:
  242. #    num    (optional) the length of the history list to return
  243. #
  244. # Results:
  245. #    A formatted history list
  246.  
  247.  proc tcl::HistInfo {{num {}}} {
  248.     variable history
  249.     if {$num == {}} {
  250.     set num [expr {$history(keep) + 1}]
  251.     }
  252.     set result {}
  253.     set newline ""
  254.     for {set i [expr {$history(nextid) - $num + 1}]} \
  255.         {$i <= $history(nextid)} {incr i} {
  256.     if {![info exists history($i)]} {
  257.         continue
  258.     }
  259.     set cmd [string trimright $history($i) \ \n]
  260.     regsub -all \n $cmd "\n\t" cmd
  261.     append result $newline[format "%6d  %s" $i $cmd]
  262.     set newline \n
  263.     }
  264.     return $result
  265. }
  266.  
  267. # tcl::HistRedo --
  268. #
  269. #    Fetch the previous or specified event, execute it, and then
  270. #    replace the current history item with that event.
  271. #
  272. # Parameters:
  273. #    event    (optional) index of history item to redo.  Defaults to -1,
  274. #        which means the previous event.
  275. #
  276. # Results:
  277. #    Those of the command being redone.
  278. #
  279. # Side Effects:
  280. #    Replaces the current history list item with the one being redone.
  281.  
  282.  proc tcl::HistRedo {{event -1}} {
  283.     variable history
  284.     if {[string length $event] == 0} {
  285.     set event -1
  286.     }
  287.     set i [HistIndex $event]
  288.     if {$i == $history(nextid)} {
  289.     return -code error "cannot redo the current event"
  290.     }
  291.     set cmd $history($i)
  292.     HistChange $cmd 0
  293.     uplevel #0 $cmd
  294. }
  295.  
  296. # tcl::HistIndex --
  297. #
  298. #    Map from an event specifier to an index in the history list.
  299. #
  300. # Parameters:
  301. #    event    index of history item to redo.
  302. #        If this is a positive number, it is used directly.
  303. #        If it is a negative number, then it counts back to a previous
  304. #        event, where -1 is the most recent event.
  305. #        A string can be matched, either by being the prefix of
  306. #        a command or by matching a command with string match.
  307. #
  308. # Results:
  309. #    The index into history, or an error if the index didn't match.
  310.  
  311.  proc tcl::HistIndex {event} {
  312.     variable history
  313.     if {[catch {expr {~$event}}]} {
  314.     for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \
  315.         {incr i -1} {
  316.         if {[string match $event* $history($i)]} {
  317.         return $i;
  318.         }
  319.         if {[string match $event $history($i)]} {
  320.         return $i;
  321.         }
  322.     }
  323.     return -code error "no event matches \"$event\""
  324.     } elseif {$event <= 0} {
  325.     set i [expr {$history(nextid) + $event}]
  326.     } else {
  327.     set i $event
  328.     }
  329.     if {$i <= $history(oldest)} {
  330.     return -code error "event \"$event\" is too far in the past"
  331.     }
  332.     if {$i > $history(nextid)} {
  333.     return -code error "event \"$event\" hasn't occured yet"
  334.     }
  335.     return $i
  336. }
  337.  
  338. # tcl::HistEvent --
  339. #
  340. #    Map from an event specifier to the value in the history list.
  341. #
  342. # Parameters:
  343. #    event    index of history item to redo.  See index for a
  344. #        description of possible event patterns.
  345. #
  346. # Results:
  347. #    The value from the history list.
  348.  
  349.  proc tcl::HistEvent {event} {
  350.     variable history
  351.     set i [HistIndex $event]
  352.     if {[info exists history($i)]} {
  353.     return [string trimright $history($i) \ \n]
  354.     } else {
  355.     return "";
  356.     }
  357. }
  358.  
  359. # tcl::HistChange --
  360. #
  361. #    Replace a value in the history list.
  362. #
  363. # Parameters:
  364. #    cmd    The new value to put into the history list.
  365. #    event    (optional) index of history item to redo.  See index for a
  366. #        description of possible event patterns.  This defaults
  367. #        to 0, which specifies the current event.
  368. #
  369. # Side Effects:
  370. #    Changes the history list.
  371.  
  372.  proc tcl::HistChange {cmd {event 0}} {
  373.     variable history
  374.     set i [HistIndex $event]
  375.     set history($i) $cmd
  376. }
  377.