home *** CD-ROM | disk | FTP | other *** search
- # Program: xf
- # Description: handle text widgets
- #
- # $Header: TkEmacs[2.3] Wed Mar 10 11:57:33 1993 garfield@garfield frozen $
-
- global xfDefaultConf
- set xfDefaultConf(tkemacs) 4
-
- ##########
- # Procedure: XFAdd.TkEmacs
- # Description: add a tkEmacs
- # Arguments: xfW - the widget
- # xfName - a optional name
- # xfType - add or config
- # Returns: none
- # Sideeffects: none
- ##########
- proc XFAdd.TkEmacs {xfW xfName xfType} {
- global xfFile
- global xfStatus
-
- XFEditSetStatus "Inserting TkEmacs..."
- set xfName [XFMiscGetUniqueName $xfName emacs]
- set xfTmpOptions ""
- if {"$xfFile(emacsCmd)" != ""} {
- append xfTmpOptions " -command $xfFile(emacsCmd)"
- }
- if {"$xfFile(emacsLisp)" != ""} {
- append xfTmpOptions " -lispfile $xfFile(emacsLisp)"
- }
- if {"$xfStatus(path)" == "."} {
- if {[catch "tkemacs .$xfName $xfTmpOptions" xfResult]} {
- XFProcError "$xfResult"
- XFEditSetStatus "Inserting TkEmacs...aborted"
- return
- }
-
- XFMiscPositionWidget .$xfName
- XFMiscBindWidgetTree .$xfName
- } {
- if {[catch "tkemacs $xfStatus(path).$xfName $xfTmpOptions" xfResult] != 0} {
- XFProcError "$xfResult"
- XFEditSetStatus "Inserting TkEmacs...aborted"
- return
- }
-
- XFMiscPositionWidget $xfStatus(path).$xfName
- XFMiscBindWidgetTree $xfStatus(path).$xfName
- }
-
- incr xfStatus(elementCounter)
- XFEditSetPath $xfStatus(path)
- XFEditSetStatus "Inserting TkEmacs...done"
- }
-
- ##########
- # Procedure: XFAddTmp.TkEmacs
- # Description: add a tmp tkEmacs
- # Arguments: none
- # Returns: none
- # Sideeffects: none
- ##########
- proc XFAddTmp.TkEmacs {} {
- }
-
- ##########
- # Procedure: XFConfig.TkEmacs4
- # Description: configure a tkEmacs
- # Arguments: xfW - the widget
- # xfType - config type (add config)
- # xfClass - the class we configure
- # xfLeader - the leading window
- # Returns: none
- # Sideeffects: none
- ##########
- proc XFConfig.TkEmacs4 {xfW xfType xfClass {xfLeader ""}} {
- global xfMisc
- global xfStatus
-
- if {"$xfType" == "add"} {
- set xfName emacs$xfStatus(elementCounter)
- } {
- set xfName [XFMiscPathName $xfW]
- }
- XFEditSetStatus "Calling parameter setting for TkEmacs..."
-
- # build widget structure
- XFTmpltToplevel .xf${xfClass}Config4 400x440 \
- "TkEmacs parameters:[XFMiscPathTail $xfW]" $xfLeader
-
- XFElementInit $xfW .xf${xfClass}Config4 $xfType $xfClass \
- XFTkEmacsSetTkEmacs4 parameters $xfName 4
- XFElementColor $xfW .xf${xfClass}Config4 $xfType $xfClass bg \
- background Background "Background" XFTkEmacsSetTkEmacs4
- XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
- command command Command "Emacs command" \
- XFTkEmacsSetTkEmacs4
- XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
- lispfile lispfile LispFile "Emacs lispfile" \
- XFTkEmacsSetTkEmacs4
- XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
- file file File "File" XFTkEmacsSetTkEmacs4
- XFElementFont $xfW .xf${xfClass}Config4 $xfType $xfClass \
- font font Font "Font" XFTkEmacsSetTkEmacs4
- XFElementColor $xfW .xf${xfClass}Config4 $xfType $xfClass fg \
- foreground Foreground "Foreground" XFTkEmacsSetTkEmacs4
- XFElementSize $xfW .xf${xfClass}Config4 $xfType $xfClass \
- XFTkEmacsSetTkEmacs4
- XFElementBoolean $xfW .xf${xfClass}Config4 $xfType $xfClass useAdvise \
- "Use advise" XFTkEmacsSetTkEmacs4
- XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
- xscrollcommand xscrollcommand XScrollCommand "X scroll command" \
- XFTkEmacsSetTkEmacs4
- XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass \
- yscrollcommand yscrollcommand YScrollCommand "Y scroll command" \
- XFTkEmacsSetTkEmacs4
- .xf${xfClass}Config4.params1.params2.size.size1.size1 conf -to 1000
- .xf${xfClass}Config4.params1.params2.size.size2.size2 conf -to 1000
-
- # save current parameter
- XFElementSave $xfW $xfClass {background command lispfile file font foreground height useadvise width xscrollcommand yscrollcommand}
-
- # packing
- pack append .xf${xfClass}Config4.params1 \
- .xf${xfClass}Config4.params1.params2 {left fill expand}
- pack append .xf${xfClass}Config4 \
- .xf${xfClass}Config4.pathname {top fill frame center} \
- .xf${xfClass}Config4.leave {bottom fill} \
- .xf${xfClass}Config4.additional {bottom fill} \
- .xf${xfClass}Config4.params1 {top fill expand}
-
- XFBindFormConnect .xf${xfClass}Config4.params1.params2 \
- "XFTkEmacsSetTkEmacs4 $xfW 0 $xfClass"
-
- XFEditSetStatus "Calling parameter setting for TkEmacs...done"
- }
-
- ##########
- # Procedure: XFSaveSpecial.TkEmacs
- # Description: save tkEmacs
- # Arguments: xfW - the widget
- # Returns: none
- # Sideeffects: none
- ##########
- proc XFSaveSpecial.TkEmacs {xfW} {
-
- # puts $xfOutFile ""
- # puts $xfOutFile " $xfW insert end \{[XFMiscGetText $xfW]\}"
- }
-
- ##########
- # Procedure: XFSaveWidget.TkEmacs
- # Description: save tkEmacs widget
- # Arguments: xfOutFile - the output file
- # xfW - the widget
- # Returns: none
- # Sideeffects: none
- ##########
- proc XFSaveWidget.TkEmacs {xfOutFile xfW} {
- global xfConf
- global xfFile
-
- set xfType [string tolower [winfo class $xfW]]
-
- # what are we doing here ?
- puts $xfOutFile "\n # build widget $xfW"
-
- set xfTmpEmacsCmd [lindex [$xfW config -command] 4]
- set xfTmpEmacsLisp [lindex [$xfW config -lispfile] 4]
- set xfTmpEmacsNameCmd ""
- if {![catch "lindex \[$xfW config -name\] 4" xfTmpEmacsName]} {
- set xfTmpEmacsNameCmd "-name \\\"$xfTmpEmacsName\\\""
- }
- if {"$xfTmpEmacsCmd" == ""} {
- set xfTmpEmacsCmd $xfFile(emacsCmd)
- }
- if {"$xfTmpEmacsLisp" == ""} {
- set xfTmpEmacsLisp $xfFile(emacsLisp)
- }
- puts $xfOutFile " if {\[catch \"tkemacs $xfW -command $xfTmpEmacsCmd -lispfile $xfTmpEmacsLisp $xfTmpEmacsNameCmd \"\]} {"
- puts $xfOutFile " if {\"\[info procs XFEdit\]\" != \"\"} {"
- puts $xfOutFile " XFProcError \"Unknown widget type: tkemacs\""
- puts $xfOutFile " return"
- puts $xfOutFile " } {"
- puts $xfOutFile " puts stderr \"Unknown widget type: tkemacs\""
- puts $xfOutFile " catch \"destroy .\""
- puts $xfOutFile " catch \"exit 0\""
- puts $xfOutFile " }"
- puts $xfOutFile " }"
-
- puts $xfOutFile " $xfW config" nonewline
- foreach xfCounter [$xfW config] {
- # only handle options with 5 items per option entry
- if {[llength $xfCounter] == 5} {
- if {"[lindex $xfCounter 0]" == "-command" ||
- "[lindex $xfCounter 0]" == "-lispfile" ||
- "[lindex $xfCounter 0]" == "-name"} {
- continue
- }
- if {("[lindex $xfCounter 0]" == "-scrollcommand" ||
- "[lindex $xfCounter 0]" == "-xscrollcommand" ||
- "[lindex $xfCounter 0]" == "-yscrollcommand") &&
- "[lindex $xfCounter 4]" == "NoFunction"} {
- continue
- }
- if {"[lindex $xfCounter 3]" != "[lindex $xfCounter 4]"} {
- if {$xfConf(encloseConfigure)} {
- puts $xfOutFile " \\\n [lindex $xfCounter 0] {[lindex $xfCounter 4]}" nonewline
- } {
- puts $xfOutFile " \\\n [lindex $xfCounter 0] \"[lindex $xfCounter 4]\"" nonewline
- }
- }
- }
- }
- puts $xfOutFile ""
- }
-
- ##########
- # Procedure: XFTkEmacsSetTkEmacs4
- # Description: set tkEmacs parameters
- # Arguments: xfW - the widget
- # xfType - the type of setting (1 = set always, 0 = set
- # only if permanent apply is on)
- # xfClass - the class we configure
- # xfParam1 - ignored parameter
- # Returns: none
- # Sideeffects: none
- ##########
- proc XFTkEmacsSetTkEmacs4 {xfW xfType xfClass {xfParam1 ""}} {
- global xfConf
- global xfMisc
-
- if {$xfType == 0 && !$xfConf(applyParameters)} {
- return
- }
- XFMiscSetSymbolicName $xfW \
- [.xf${xfClass}Config4.params1.params2.symname.symname get]
-
- set tmpOptions ""
- append tmpOptions \
- " -useadvise $xfMisc(useAdvise)"
- if {"[.xf${xfClass}Config4.params1.params2.bg.bg get]" != ""} {
- append tmpOptions \
- " -background \"[.xf${xfClass}Config4.params1.params2.bg.bg get]\""
- }
- append tmpOptions \
- " -command \"[.xf${xfClass}Config4.params1.params2.command.command get]\""
- if {"[.xf${xfClass}Config4.params1.params2.file.file get]" != ""} {
- append tmpOptions \
- " -file \"[.xf${xfClass}Config4.params1.params2.file.file get]\""
- }
- if {"[.xf${xfClass}Config4.params1.params2.font.font get]" != ""} {
- append tmpOptions \
- " -font \"[.xf${xfClass}Config4.params1.params2.font.font get]\""
- }
- if {"[.xf${xfClass}Config4.params1.params2.fg.fg get]" != ""} {
- append tmpOptions \
- " -foreground \"[.xf${xfClass}Config4.params1.params2.fg.fg get]\""
- }
- append tmpOptions \
- " -height \"[.xf${xfClass}Config4.params1.params2.size.size2.size2 get]\""
- append tmpOptions \
- " -width \"[.xf${xfClass}Config4.params1.params2.size.size1.size1 get]\""
- if {"[.xf${xfClass}Config4.params1.params2.xscrollcommand.xscrollcommand get]" != ""} {
- append tmpOptions \
- " -xscrollcommand \"[.xf${xfClass}Config4.params1.params2.xscrollcommand.xscrollcommand get]\""
- } {
- append tmpOptions \
- " -xscrollcommand NoFunction"
- }
- if {"[.xf${xfClass}Config4.params1.params2.yscrollcommand.yscrollcommand get]" != ""} {
- append tmpOptions \
- " -yscrollcommand \"[.xf${xfClass}Config4.params1.params2.yscrollcommand.yscrollcommand get]\""
- } {
- append tmpOptions \
- " -yscrollcommand NoFunction"
- }
- if {[catch "$xfW configure $tmpOptions" xfResult]} {
- XFProcError "$xfW\n$xfResult"
- }
- }
-
- # eof
-
-