library/command.tcl

   1 #
   2 # command.tcl --
   3 #
   4 # This file defines the command dialog procedure.
   5 #
   6 # Copyright (c) 1995-1996 Christian Werner
   7 #
   8 # See the file "license.terms" for information on usage and redistribution
   9 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10
  11 # ckCommand --
  12 #    Create command window e.g. for interactive use of cwsh
  13
  14 proc ckCommand {{w .ckCommand}} {
  15     global ckPriv
  16     if [winfo exists $w] {
  17         raise $w
  18         return
  19     }
  20     toplevel $w -class CommandDialog \
  21         -border { ulcorner hline urcorner vline lrcorner hline llcorner vline }
  22     place $w -relx 0.5 -rely 0.5 -relwidth 0.5 -relheight 0.5 -anchor center
  23
  24     label $w.title -text "Command dialog"
  25     place $w.title -y 0 -relx 0.5 -bordermode ignore -anchor center
  26
  27     entry $w.entry
  28     frame $w.sep0 -border hline -height 1
  29     scrollbar $w.scroll -command "$w.output yview" -takefocus 0
  30     text $w.output -yscrollcommand "$w.scroll set"
  31     frame $w.sep1 -border hline -height 1
  32     button $w.close -command "lower $w" -text Dismiss
  33
  34     pack $w.entry -side top -fill x
  35     pack $w.sep0 -side top -fill x
  36     pack $w.close -side bottom -ipadx 1
  37     pack $w.sep1 -side bottom -fill x
  38     pack $w.scroll -side right -fill y
  39     pack $w.output -side left -fill both -expand 1
  40
  41     bind $w.entry <Return> "ckCommandRun $w"
  42     bind $w.entry <Linefeed> "ckCommandRun $w"
  43     bind $w.entry <Up> "ckCmdHist $w 1"
  44     bind $w.entry <Down> "ckCmdHist $w -1"
  45     bind $w.output <Tab> {focus [ck_focusNext %W] ; break}
  46     bind $w.output <Control-X> "ckCommandRun $w \[$w.output get 1.0 end\]"
  47     bind $w <Escape> "lower $w ; break"
  48     bind $w <Control-U> "ckCmdToggleSize $w"
  49     bind $w <Control-L> {update screen}
  50
  51     focus $w.entry
  52
  53     set ckPriv(cmdHistory) {}
  54     set ckPriv(cmdHistCnt) -1
  55     set ckPriv(cmdHistMax) 32
  56 }
  57
  58 proc ckCmdToggleSize w {
  59     if {[string first "-relwidth 1" [place info $w]] >= 0} {
  60         place $w -relx 0.5 -rely 0.5 -relwidth 0.5 -relheight 0.5 \
  61             -anchor center
  62     } else {
  63         place $w -relx 0.5 -rely 0.5 -relwidth 1.0 -relheight 1.0 \
  64             -anchor center
  65     }
  66 }
  67
  68 proc ckCmdHist {w dir} {
  69     global ckPriv
  70     incr ckPriv(cmdHistCnt) $dir
  71     if {$ckPriv(cmdHistCnt) < 0} {
  72         set cmd ""
  73         set ckPriv(cmdHistCnt) -1
  74     } else {
  75         if {$ckPriv(cmdHistCnt) >= [llength $ckPriv(cmdHistory)]} {
  76             set ckPriv(cmdHistCnt) [expr [llength $ckPriv(cmdHistory)] - 1]
  77             return
  78         }
  79         set cmd [lindex $ckPriv(cmdHistory) $ckPriv(cmdHistCnt)]
  80     }
  81     $w.entry delete 0 end
  82     $w.entry insert end $cmd
  83 }
  84
  85 proc ckCommandRun {w {cmd {}}} {
  86     global errorInfo ckPriv
  87     if {$cmd == ""} {
  88         set cmd [string trim [$w.entry get]]
  89         if {$cmd == ""} {
  90             return
  91         }
  92     }
  93     set code [catch {uplevel #0 $cmd} result]
  94     if {$code == 0} {
  95         set ckPriv(cmdHistory) [lrange [concat [list $cmd] \
  96             $ckPriv(cmdHistory)] 0 $ckPriv(cmdHistMax)]
  97         set ckPriv(cmdHistCnt) -1
  98     }
  99     $w.output delete 1.0 end
 100     $w.output insert 1.0 $result
 101     if $code { $w.output insert end "\n----\n$errorInfo" }
 102     $w.output mark set insert 1.0
 103     if {$code == 0} {
 104         $w.entry delete 0 end
 105     }
 106 }