开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
font.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：44k
源码类别：

通讯编程

开发平台：

Visual C++

font.test：源码内容
  1. # This file is a Tcl script to test out Tk's "font" command
  2. # plus the procedures in tkFont.c.  It is organized in the
  3. # standard white-box fashion for Tcl tests.
  4. #
  5. # Copyright (c) 1996-1998 Sun Microsystems, Inc.
  6. # Copyright (c) 1998-1999 by Scriptics Corporation.
  7. # All rights reserved.
  8. #
  9. # RCS: @(#) $Id: font.test,v 1.8 2002/07/14 05:48:46 dgp Exp $
  11. package require tcltest 2.1
  12. namespace import -force tcltest::configure
  13. namespace import -force tcltest::testsDirectory
  14. configure -testdir [file join [pwd] [file dirname [info script]]]
  15. configure -loadfile [file join [testsDirectory] constraints.tcl]
  16. tcltest::loadTestedCommands
  18. catch {destroy .b}
  19. toplevel .b
  20. wm geom .b +0+0
  21. update idletasks
  23. proc setup {} {
  24.     catch {destroy .b.f}
  25.     catch {eval font delete [font names]}
  26.     label .b.f 
  27.     pack .b.f
  28.     update
  29. }
  31. label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Courier -12"
  32. pack .b.l
  33. canvas .b.c -closeenough 0 
  34. .b.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12"
  35. pack .b.c
  36. update
  38. set ax [winfo reqwidth .b.l]
  39. set ay [winfo reqheight .b.l]
  40. proc getsize {} {
  41.     update
  42.     return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
  43. }
  45. proc csetup {{str ""}} {
  46.     focus -force .b.c
  47.     .b.c dchars text 0 end
  48.     .b.c insert text 0 $str
  49.     .b.c focus text
  50. }
  52. setup
  54. case $tcl_platform(platform) {
  55.     unix {set fixed "fixed"}
  56.     windows {set fixed "courier 12"}
  57.     macintosh {set fixed "monaco 9"}
  58. }
  59. set times [font actual {times 0} -family]
  61. test font-1.1 {TkFontPkgInit} {
  62.     catch {interp delete foo}
  63.     interp create foo
  64.     foo eval {
  65. load {} Tk
  66. wm geometry . +0+0
  67. update
  68.     }
  69.     interp delete foo
  70. } {}
  72. test font-2.1 {TkFontPkgFree} {
  73.     catch {interp delete foo}
  74.     interp create foo
  75.     set x {}
  77.     # Makes sure that named font was visible only to child interp.
  79.     foo eval {
  80. load {} Tk
  81. wm geometry . +0+0
  82. button .b -font {times 16} -text "hi"
  83. pack .b
  84. font create wiggles -family courier -underline 1
  85. update
  86.     }
  87.     lappend x [catch {font configure wiggles} msg; set msg]
  89.     # Tests cancelling the idle handler for TheWorldHasChanged,
  90.     # because app goes away before idle serviced.
  91.     
  92.     foo eval {
  93. .b config -font wiggles
  94. font config wiggles -size 24
  95. destroy .
  96.     }
  97.     lappend x [foo eval {catch {font families} msg; set msg}]
  99.     interp delete foo
  100.     set x
  101. } {{named font "wiggles" doesn't exist} {can't invoke "font" command:  application has been destroyed}}
  104. test font-3.1 {font command: general} {
  105.     list [catch {font} msg] $msg
  106. } {1 {wrong # args: should be "font option ?arg?"}}
  107. test font-3.2 {font command: general} {
  108.     list [catch {font xyz} msg] $msg
  109. } {1 {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names}}
  111. test font-4.1 {font command: actual: arguments} {
  112.     # (skip < 0)
  113.     list [catch {font actual xyz -displayof} msg] $msg
  114. } {1 {value for "-displayof" missing}}
  115. test font-4.2 {font command: actual: arguments} {
  116.     # (objc < 3) 
  117.     list [catch {font actual} msg] $msg
  118. } {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
  119. test font-4.3 {font command: actual: arguments} {
  120.     # (objc - skip > 4) when skip == 0
  121.     list [catch {font actual xyz abc def} msg] $msg
  122. } {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
  123. test font-4.4 {font command: actual: displayof specified, so skip to next} {
  124.     catch {font actual xyz -displayof . -size}
  125. } {0}
  126. test font-4.5 {font command: actual: displayof specified, so skip to next} {
  127.     lindex [font actual xyz -displayof .] 0
  128. } {-family}
  129. test font-4.6 {font command: actual: arguments} {
  130.     # (objc - skip > 4) when skip == 2
  131.     list [catch {font actual xyz -displayof . abc def} msg] $msg
  132. } {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
  133. test font-4.7 {font command: actual: arguments} {noExceed} {
  134.     # (tkfont == NULL)
  135.     list [catch {font actual "{xyz"} msg] $msg
  136. } [list 1 "font "{xyz" doesn't exist"]
  137. test font-4.8 {font command: actual: all attributes} {
  138.     # not (objc > 3) so objPtr = NULL
  139.     lindex [font actual {-family times}] 0
  140. } {-family}
  141. test font-4.9 {font command: actual} {macOrUnix noExceed} {
  142.     # (objc > 3) so objPtr = objv[3 + skip]
  143.     string tolower [font actual {-family times} -family]
  144. } {times}
  145. test font-4.10 {font command: actual} {pcOnly} {
  146.     # (objc > 3) so objPtr = objv[3 + skip]
  147.     font actual {-family times} -family
  148. } {Times New Roman}
  149. test font-4.11 {font command: bad option} {
  150.     list [catch {font actual xyz -style} msg] $msg
  151. } {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
  153. test font-5.1 {font command: configure} {
  154.     # (objc < 3) 
  155.     list [catch {font configure} msg] $msg
  156. } {1 {wrong # args: should be "font configure fontname ?options?"}}
  157. test font-5.2 {font command: configure: non-existent font} {
  158.     # (namedHashPtr == NULL)
  159.     list [catch {font configure xyz} msg] $msg
  160. } {1 {named font "xyz" doesn't exist}}
  161. test font-5.3 {font command: configure: "deleted" font} {
  162.     # (nfPtr->deletePending != 0) 
  163.     setup
  164.     font create xyz
  165.     .b.f configure -font xyz
  166.     font delete xyz
  167.     list [catch {font configure xyz} msg] $msg
  168. } {1 {named font "xyz" doesn't exist}}
  169. test font-5.4 {font command: configure: get all options} {
  170.     # (objc == 3) so objPtr = NULL
  171.     setup
  172.     font create xyz -family xyz
  173.     lindex [font configure xyz] 1
  174. } xyz
  175. test font-5.5 {font command: configure: get one option} {
  176.     # (objc == 4) so objPtr = objv[3]
  177.     setup
  178.     font create xyz -family xyz
  179.     font configure xyz -family
  180. } xyz
  181. test font-5.6 {font command: configure: update existing font} {
  182.     # else result = ConfigAttributesObj()
  183.     setup
  184.     font create xyz
  185.     font configure xyz -family xyz
  186.     update
  187.     font configure xyz -family
  188. } xyz
  189. test font-5.7 {font command: configure: bad option} {
  190.     setup
  191.     font create xyz
  192.     list [catch {font configure xyz -style} msg] $msg
  193. } {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
  195. test font-6.1 {font command: create: make up name} {
  196.     # (objc < 3) so name = NULL
  197.     setup
  198.     font create
  199.     font names
  200. } {font1}
  201. test font-6.2 {font command: create: name specified} {
  202.     # not (objc < 3)
  203.     setup
  204.     font create xyz
  205.     font names
  206. } {xyz}
  207. test font-6.3 {font command: create: name not really specified} {
  208.     # (name[0] == '-') so name = NULL
  209.     setup
  210.     font create -family xyz
  211.     font names
  212. } {font1}
  213. test font-6.4 {font command: create: generate name} {
  214.     # (name == NULL)
  215.     setup
  216.     font create -family one
  217.     font create -family two
  218.     font create -family three
  219.     font delete font2
  220.     font create -family four
  221.     font configure font2 -family
  222. } {four}
  223. test font-6.5 {font command: create: bad option creating new font} {
  224.     # name was specified so skip = 3 
  225.     setup
  226.     list [catch {font create xyz -xyz times} msg] $msg
  227. } {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
  228. test font-6.6 {font command: create: bad option creating new font} {
  229.     # name was not specified so skip = 2 
  230.     setup
  231.     list [catch {font create -xyz times} msg] $msg
  232. } {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
  233. test font-6.7 {font command: create: already exists} {
  234.     # (CreateNamedFont() != TCL_OK)
  235.     setup
  236.     font create xyz
  237.     list [catch {font create xyz} msg] $msg
  238. } {1 {named font "xyz" already exists}}
  240. test font-7.1 {font command: delete: arguments} {
  241.     # (objc < 3) 
  242.     list [catch {font delete} msg] $msg
  243. } {1 {wrong # args: should be "font delete fontname ?fontname ...?"}}
  244. test font-7.2 {font command: delete: loop test} {
  245.     # for (i = 2; i < objc; i++) 
  246.     setup
  247.     set x {}
  248.     font create a -underline 1
  249.     font create b -underline 1
  250.     font create c -underline 1
  251.     font create d -underline 1
  252.     font create e -underline 1
  253.     lappend x [lsort [font names]]
  254.     font delete a e c b
  255.     lappend x [lsort [font names]]
  256. } {{a b c d e} d}
  257. test font-7.3 {font command: delete: loop test} {
  258.     # (namedHashPtr == NULL) in middle of loop
  259.     setup
  260.     set x {}
  261.     font create a -underline 1
  262.     font create b -underline 1
  263.     font create c -underline 1
  264.     font create d -underline 1
  265.     font create e -underline 1
  266.     lappend x [lsort [font names]]
  267.     catch {font delete a d q c e b}
  268.     lappend x [lsort [font names]]
  269. } {{a b c d e} {b c e}}
  270. test font-7.4 {font command: delete: non-existent} {
  271.     # (namedHashPtr == NULL) 
  272.     setup
  273.     list [catch {font delete xyz} msg] $msg
  274. } {1 {named font "xyz" doesn't exist}}
  275. test font-7.5 {font command: delete: mark for later deletion} {
  276.     # (nfPtr->refCount != 0)
  277.     setup
  278.     font create xyz
  279.     .b.f configure -font xyz
  280.     font delete xyz
  281.     font actual xyz
  282.     list [catch {font configure xyz} msg] $msg [.b.f cget -font]
  283. } {1 {named font "xyz" doesn't exist} xyz}
  284. test font-7.6 {font command: delete: actually delete} {
  285.     # not (nfPtr->refCount != 0)
  286.     setup
  287.     font create xyz -underline 1
  288.     font delete xyz
  289.     catch {font config xyz}
  290. } {1}
  291. setup
  293. test font-8.1 {font command: families: arguments} {
  294.     # (skip < 0)
  295.     list [catch {font families -displayof} msg] $msg
  296. } {1 {value for "-displayof" missing}}
  297. test font-8.2 {font command: families: arguments} {
  298.     # (objc - skip != 2) when skip == 0
  299.     list [catch {font families xyz} msg] $msg
  300. } {1 {wrong # args: should be "font families ?-displayof window?"}}
  301. test font-8.3 {font command: families: arguments} {
  302.     # (objc - skip != 2) when skip == 2
  303.     list [catch {font families -displayof . xyz} msg] $msg
  304. } {1 {wrong # args: should be "font families ?-displayof window?"}}
  305. test font-8.4 {font command: families} {
  306.     # TkpGetFontFamilies()
  307.     regexp -nocase times [font families]
  308. } {1}
  310. test font-9.1 {font command: measure: arguments} {
  311.     # (skip < 0)
  312.     list [catch {font measure xyz -displayof} msg] $msg
  313. } {1 {value for "-displayof" missing}}
  314. test font-9.2 {font command: measure: arguments} {
  315.     # (objc - skip != 4) 
  316.     list [catch {font measure} msg] $msg
  317. } {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
  318. test font-9.3 {font command: measure: arguments} {
  319.     # (objc - skip != 4) 
  320.     list [catch {font measure xyz abc def} msg] $msg
  321. } {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
  322. test font-9.4 {font command: measure: arguments} {noExceed} {
  323.     # (tkfont == NULL)
  324.     list [catch {font measure "{xyz" abc} msg] $msg
  325. } [list 1 "font "{xyz" doesn't exist"]
  326. test font-9.5 {font command: measure} {
  327.     # Tk_TextWidth()
  328.     expr [font measure $fixed "abcdefg"]==[font measure $fixed "a"]*7
  329. } {1}
  331. test font-10.1 {font command: metrics: arguments} {
  332.     list [catch {font metrics xyz -displayof} msg] $msg
  333. } {1 {value for "-displayof" missing}}
  334. test font-10.2 {font command: metrics: arguments} {
  335.     # (skip < 0)
  336.     list [catch {font metrics xyz -displayof} msg] $msg
  337. } {1 {value for "-displayof" missing}}
  338. test font-10.3 {font command: metrics: arguments} {
  339.     # (objc < 3) 
  340.     list [catch {font metrics} msg] $msg
  341. } {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}}
  342. test font-10.4 {font command: metrics: arguments} {
  343.     # (objc - skip) > 4) when skip == 0
  344.     list [catch {font metrics xyz abc def} msg] $msg
  345. } {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}}
  346. test font-10.5 {font command: metrics: arguments} {
  347.     # (objc - skip) > 4) when skip == 2
  348.     list [catch {font metrics xyz -displayof . abc} msg] $msg
  349. } {1 {bad metric "abc": must be -ascent, -descent, -linespace, or -fixed}}
  350. test font-10.6 {font command: metrics: bad font} {noExceed} {
  351.     # (tkfont == NULL)
  352.     list [catch {font metrics "{xyz"} msg] $msg
  353. } [list 1 "font "{xyz" doesn't exist"]
  354. test font-10.7 {font command: metrics: get all metrics} {
  355.     # (objc == 3)
  356.     catch {unset a}
  357.     array set a [font metrics {-family xyz}]
  358.     set x [lsort [array names a]]
  359.     unset a
  360.     set x    
  361. } {-ascent -descent -fixed -linespace}
  362. test font-10.8 {font command: metrics: bad metric} {
  363.     # (Tcl_GetIndexFromObj() != TCL_OK)
  364.     list [catch {font metrics $fixed -xyz} msg] $msg
  365. } {1 {bad metric "-xyz": must be -ascent, -descent, -linespace, or -fixed}}
  366. test font-10.9 {font command: metrics: get individual metrics} {
  367.     font metrics $fixed -ascent
  368.     font metrics $fixed -descent
  369.     font metrics $fixed -linespace
  370.     font metrics $fixed -fixed
  371. } {1}
  373. test font-11.1 {font command: names: arguments} {
  374.     # (objc != 2)
  375.     list [catch {font names xyz} msg] $msg
  376. } {1 {wrong # args: should be "font names"}}
  377. test font-11.2 {font command: names: loop test: no passes} {
  378.     setup
  379.     font names
  380. } {}
  381. test font-11.3 {font command: names: loop test: one pass} {
  382.     setup
  383.     font create
  384.     font names
  385. } {font1}
  386. test font-11.4 {font command: names: loop test: multiple passes} {
  387.     setup
  388.     font create xyz
  389.     font create abc
  390.     font create def
  391.     lsort [font names]
  392. } {abc def xyz}
  393. test font-11.5 {font command: names: skip deletePending fonts} {
  394.     # (nfPtr->deletePending == 0)
  395.     setup
  396.     set x {}
  397.     font create xyz
  398.     font create abc
  399.     lappend x [lsort [font names]]
  400.     .b.f config -font xyz
  401.     font delete xyz
  402.     lappend x [font names]
  403. } {{abc xyz} abc}
  405. test font-12.1 {UpdateDependantFonts procedure: no users} {
  406.     # (nfPtr->refCount == 0)
  407.     setup
  408.     font create xyz
  409.     font configure xyz -family times
  410. } {}
  411. test font-12.2 {UpdateDependantFonts procedure: pings the widgets} {
  412.     setup
  413.     font create xyz -family times -size 20
  414.     .b.f config -font xyz -text "abcd" -padx 0 -bd 0 -highlightthickness 0
  415.     set a1 [font measure xyz "abcd"]
  416.     update
  417.     set b1 [winfo reqwidth .b.f]
  418.     font configure xyz -family helvetica -size 20
  419.     set a2 [font measure xyz "abcd"]
  420.     update
  421.     set b2 [winfo reqwidth .b.f]
  422.     expr {$a1==$b1 && $a2==$b2}
  423. } {1}
  425. test font-13.1 {CreateNamedFont: new named font} {
  426.     # not (new == 0)
  427.     setup
  428.     set x {}
  429.     lappend x [font names]
  430.     font create xyz
  431.     lappend x [font names]
  432. } {{} xyz}
  433. test font-13.2 {CreateNamedFont: named font already exists} {
  434.     # (new == 0)
  435.     setup
  436.     font create xyz
  437.     list [catch {font create xyz} msg] $msg
  438. } {1 {named font "xyz" already exists}}
  439. test font-13.3 {CreateNamedFont: named font already exists} {
  440.     # (nfPtr->deletePending == 0)
  441.     setup
  442.     font create xyz
  443.     list [catch {font create xyz} msg] $msg
  444. } {1 {named font "xyz" already exists}}
  445. test font-13.4 {CreateNamedFont: recreate "deleted" font} {
  446.     # not (nfPtr->deletePending == 0)
  447.     setup
  448.     font create xyz -family times
  449.     .b.f configure -font xyz
  450.     font delete xyz
  451.     font create xyz -family courier
  452.     font configure xyz -family
  453. } {courier}
  455. test font-14.1 {Tk_GetFont procedure} {
  456. } {}
  458. test font-15.1 {Tk_AllocFontFromObj - converting internal reps} testfont {
  459.     set x {Times 16}
  460.     lindex $x 0
  461.     destroy .b1 .b2
  462.     button .b1 -font $x
  463.     lindex $x 0
  464.     testfont counts {Times 16}
  465. } {{1 0}}
  466. test font-15.2 {Tk_AllocFontFromObj - discard stale font} testfont {
  467.     set x {Times 16}
  468.     destroy .b1 .b2
  469.     button .b1 -font $x
  470.     destroy .b1
  471.     set result {}
  472.     lappend result [testfont counts {Times 16}]
  473.     button .b2 -font $x
  474.     lappend result [testfont counts {Times 16}]
  475. } {{} {{1 1}}}
  476. test font-15.3 {Tk_AllocFontFromObj - reuse existing font} testfont {
  477.     set x {Times 16}
  478.     destroy .b1 .b2
  479.     button .b1 -font $x
  480.     set result {}
  481.     lappend result [testfont counts {Times 16}]
  482.     button .b2 -font $x
  483.     pack .b1 .b2 -side top
  484.     lappend result [testfont counts {Times 16}]
  485. } {{{1 1}} {{2 1}}}
  486. test font-15.4 {Tk_AllocFontFromObj procedure: bump ref count} {
  487.     # (new == 0)
  488.     setup
  489.     .b.f config -font {-family fixed}
  490.     lindex [font actual {-family fixed}] 0
  491. } {-family}
  492. test font-15.5 {Tk_AllocFontFromObj procedure: get named font} {
  493.     # (namedHashPtr != NULL) 
  494.     setup
  495.     font create xyz 
  496.     .b.f config -font xyz 
  497. } {}
  498. test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} {
  499.     # not (namedHashPtr != NULL)
  500.     setup
  501.     .b.f config -font {times 20}
  502. } {}
  503. test font-15.7 {Tk_AllocFontFromObj procedure: get native font} {unixOnly} {
  504.     # not (fontPtr == NULL) 
  505.     setup
  506.     .b.f config -font fixed
  507. } {}
  508. test font-15.8 {Tk_AllocFontFromObj procedure: get native font} {pcOnly} {
  509.     # not (fontPtr == NULL) 
  510.     setup
  511.     .b.f config -font oemfixed
  512. } {}
  513. test font-15.9 {Tk_AllocFontFromObj procedure: get native font} {macOnly} {
  514.     # not (fontPtr == NULL) 
  515.     setup
  516.     .b.f config -font application
  517. } {}
  518. test font-15.10 {Tk_AllocFontFromObj procedure: get attribute font} {
  519.     # (fontPtr == NULL) 
  520.     list [catch {.b.f config -font {xxx yyy zzz}} msg] $msg
  521. } {1 {expected integer but got "yyy"}}
  522. test font-15.11 {Tk_AllocFontFromObj procedure: no match} {noExceed} {
  523.     # (ParseFontNameObj() != TCL_OK)
  524.     list [catch {font actual "{xyz"} msg] $msg
  525. } [list 1 "font "{xyz" doesn't exist"]
  526. test font-15.12 {Tk_AllocFontFromObj procedure: get attribute font} {
  527.     # not (ParseFontNameObj() != TCL_OK)
  528.     lindex [font actual {plan 9}] 0
  529. } {-family}
  530. test font-15.13 {Tk_AllocFontFromObj procedure: setup tab width} {
  531.     # Tk_MeasureChars(fontPtr, "0", ...)
  532.     label .l -bd 0 -padx 0  -highlightthickness 0 -font $fixed -text "atb"
  533.     update
  534.     set x [winfo reqwidth .l]
  535.     destroy .l
  536.     set x
  537. } [expr [font measure $fixed "0"]*9]
  538. test font-15.14 {Tk_AllocFontFromObj procedure: underline position} {
  539.     # (fontPtr->underlineHeight == 0) because size was < 10
  540.     setup
  541.     .b.f config -text "underline" -font "times -8 underline"
  542.     update
  543. } {}    
  545. test font-16.1 {Tk_NameOfFont procedure} {
  546.     setup
  547.     .b.f config -font -family fixed
  548.     .b.f cget -font
  549. } {-family fixed}
  551. test font-17.1 {Tk_FreeFontFromObj - reference counts} testfont {
  552.     set x {Courier 12}
  553.     destroy .b1 .b2 .b3
  554.     button .b1 -font $x
  555.     button .b3 -font $x
  556.     button .b2 -font $x
  557.     set result {}
  558.     lappend result [testfont counts {Courier 12}]
  559.     destroy .b1
  560.     lappend result [testfont counts {Courier 12}]
  561.     destroy .b2
  562.     lappend result [testfont counts {Courier 12}]
  563.     destroy .b3
  564.     lappend result [testfont counts {Courier 12}]
  565. } {{{3 1}} {{2 1}} {{1 1}} {}}
  566. test font-17.2 {Tk_FreeFont procedure: one ref} {
  567.     # (fontPtr->refCount == 0)
  568.     setup
  569.     .b.f config -font {-family fixed}
  570.     destroy .b.f
  571. } {}
  572. test font-17.3 {Tk_FreeFont procedure: multiple ref} {
  573.     # not (fontPtr->refCount == 0)
  574.     setup
  575.     .b.f config -font {-family fixed}
  576.     button .b.b -font {-family fixed}
  577.     destroy .b.f
  578.     set x [.b.b cget -font]
  579.     destroy .b.b
  580.     set x
  581. } {-family fixed}
  582. test font-17.4 {Tk_FreeFont procedure: named font} {
  583.     # (fontPtr->namedHashPtr != NULL) 
  584.     setup
  585.     font create xyz
  586.     .b.f config -font xyz
  587.     destroy .b.f
  588.     font names
  589. } {xyz}
  590. test font-17.5 {Tk_FreeFont procedure: named font} {
  591.     # not (fontPtr->refCount == 0) 
  592.     setup
  593.     font create xyz -underline 1
  594.     .b.f config -font xyz
  595.     font delete xyz
  596.     set x [font actual xyz -underline]
  597.     destroy .b.f
  598.     list [font actual xyz -underline] $x
  599. } {0 1}
  600. test font-17.6 {Tk_FreeFont procedure: named font not deleted yet} {
  601.     setup
  602.     font create xyz 
  603.     .b.f config -font xyz
  604.     button .b.b -font xyz
  605.     font delete xyz
  606.     set x [font actual xyz]
  607.     destroy .b.b
  608.     list [lindex [font actual xyz] 0] [lindex $x 0]
  609. } {-family -family}
  611. test font-18.1 {FreeFontObjProc} testfont {
  612.     destroy .b1
  613.     set x [format {Courier 12}]
  614.     button .b1 -font $x
  615.     set y [format {Courier 12}]
  616.     .b1 configure -font $y
  617.     set z [format {Courier 12}]
  618.     .b1 configure -font $z
  619.     set result {}
  620.     lappend result [testfont counts {Courier 12}]
  621.     set x red
  622.     lappend result [testfont counts {Courier 12}]
  623.     set z 32
  624.     lappend result [testfont counts {Courier 12}]
  625.     destroy .b1
  626.     lappend result [testfont counts {Courier 12}]
  627.     set y bogus
  628.     set result
  629. } {{{1 3}} {{1 2}} {{1 1}} {}}
  631. test font-19.1 {Tk_FontId} {
  632.     .b.f config -font "times 20"
  633.     update
  634. } {}
  636. test font-20.1 {Tk_GetFontMetrics procedure} {
  637.     button .b.w1 -text abc
  638.     entry .b.w2 -text abcd
  639.     update
  640.     destroy .b.w1 .b.w2
  641. } {}
  643. proc psfontname {name} {
  644.     set a [.b.c itemcget text -font]
  645.     .b.c itemconfig text -text "We need text" -font $name
  646.     set post [.b.c postscript]
  647.     .b.c itemconfig text -font $a
  648.     set end [string first "findfont" $post]
  649.     incr end -2
  650.     set post [string range $post [expr $end-70] $end]
  651.     set start [string first "gsave" $post]
  652.     return [string range $post [expr $start+7] end]
  653. }
  654. test font-21.1 {Tk_PostscriptFontName procedure: native} {unixOnly} {
  655.     set x [font actual {{itc avant garde} 10} -family]
  656.     if {[string match *avant*garde $x]} {
  657. psfontname "{itc avant garde} 10"
  658.     } else {
  659. set x {AvantGarde-Book}
  660.     }
  661. } {AvantGarde-Book}
  662. test font-21.2 {Tk_PostscriptFontName procedure: native} {pcOnly} {
  663.     psfontname "arial 10"
  664. } {Helvetica}
  665. test font-21.3 {Tk_PostscriptFontName procedure: native} {pcOnly} {
  666.     psfontname "{times new roman} 10"
  667. } {Times-Roman}
  668. test font-21.4 {Tk_PostscriptFontName procedure: native} {pcOnly} {
  669.     psfontname "{courier new} 10"
  670. } {Courier}
  671. test font-21.5 {Tk_PostscriptFontName procedure: native} {macOnly} {
  672.     psfontname "geneva 10"
  673. } {Helvetica}
  674. test font-21.6 {Tk_PostscriptFontName procedure: native} {macOnly} {
  675.     psfontname "{new york} 10"
  676. } {Times-Roman}
  677. test font-21.7 {Tk_PostscriptFontName procedure: native} {macOnly} {
  678.     psfontname "monaco 10"
  679. } {Courier}
  680. test font-21.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
  681.     set x [font actual {{lucida bright} 10} -family]
  682.     if {[string match lucida*bright $x]} {
  683. psfontname "{lucida bright} 10"
  684.     } else {
  685. set x {LucidaBright}
  686.     }
  687. } {LucidaBright}
  688. test font-21.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
  689.     psfontname "{new century schoolbook} 10"
  690. } {NewCenturySchlbk-Roman}
  691. set i 10
  692. foreach p {
  693.     {"avantgarde" AvantGarde-Book AvantGarde-Demi AvantGarde-BookOblique AvantGarde-DemiOblique}
  694.     {"bookman" Bookman-Light Bookman-Demi Bookman-LightItalic Bookman-DemiItalic}
  695.     {"courier" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
  696.     {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
  697.     {"new century schoolbook" NewCenturySchlbk-Roman NewCenturySchlbk-Bold NewCenturySchlbk-Italic NewCenturySchlbk-BoldItalic}
  698.     {"palatino" Palatino-Roman Palatino-Bold Palatino-Italic Palatino-BoldItalic}
  699.     {"symbol" Symbol Symbol Symbol Symbol}
  700.     {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
  701.     {"zapfchancery" ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic}
  702.     {"zapfdingbats" ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats}
  703. } {
  704.     test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} {
  705. set family [lindex $p 0]
  706. set x {}
  707. set i 1
  708. foreach slant {roman italic} {
  709.     foreach weight {normal bold} {
  710. set name [list $family 12 $slant $weight]
  711. if {[font actual $name -family] == $family} {
  712.     lappend x [psfontname $name]
  713. } else {
  714.     lappend x [lindex $p $i]
  715. }
  716. incr i
  717.     }
  718. }
  719.         incr i
  720. set x
  721.     } [lrange $p 1 end]
  722. }
  723. foreach p {
  724.     {"arial" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
  725.     {"courier new" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
  726.     {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
  727.     {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
  728.     {"times new roman" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
  729. } {
  730.     test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {pcOnly} {
  731. set family [lindex $p 0]
  732. set x {}
  733. foreach slant {roman italic} {
  734.     foreach weight {normal bold} {
  735. lappend x [psfontname [list $family 12 "$slant $weight"]]
  736.     }
  737. }
  738.         incr i
  739. set x
  740.     } [lrange $p 1 end]
  741. }
  742. foreach p {
  743.     {"courier" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
  744.     {"geneva" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
  745.     {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
  746.     {"monaco" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
  747.     {"new york" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
  748.     {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
  749.     {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
  750. } {
  751.     test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {macOnly} {
  752. set family [lindex $p 0]
  753. set x {}
  754. foreach slant {roman italic} {
  755.     foreach weight {normal bold} {
  756. lappend x [psfontname [list $family 12 $slant $weight]]
  757.     }
  758. }
  759. incr i
  760. set x
  761.     } [lrange $p 1 end]
  762. }
  764. test font-22.1 {Tk_TextWidth procedure} {
  765.     font measure [.b.l cget -font] "000"
  766. } [expr $ax*3]
  768. test font-23.1 {Tk_UnderlineChars procedure} {
  769.     text .b.t
  770.     .b.t insert 1.0 abctdefg
  771.     .b.t tag config sel -underline 1
  772.     .b.t tag add sel 1.0 end
  773.     update
  774. } {}
  776. setup
  777. test font-24.1 {Tk_ComputeTextLayout: empty string} {
  778.     .b.l config -text ""
  779. } {}
  780. test font-24.2 {Tk_ComputeTextLayout: simple string} {
  781.     .b.l config -text "000"
  782.     getsize
  783. } "[expr $ax*3] $ay"
  784. test font-24.3 {Tk_ComputeTextLayout: find special chars} {
  785.     .b.l config -text "000n000"
  786.     getsize
  787. } "[expr $ax*3] [expr $ay*2]"
  788. test font-24.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} {
  789.     .b.l config -text "000n000"
  790.     getsize
  791. } "[expr $ax*3] [expr $ay*2]"
  792. test font-24.5 {Tk_ComputeTextLayout: break line} {
  793.     .b.l config -text "000t00000" -wrap [expr 9*$ax]
  794.     set x [getsize]
  795.     .b.l config -wrap 0
  796.     set x
  797. } "[expr 8*$ax] [expr 2*$ay]"
  798. test font-24.6 {Tk_ComputeTextLayout: normal ended on special char} {
  799.     .b.l config -text "000n000"
  800. } {}
  801. test font-24.7 {Tk_ComputeTextLayout: special char was n} {
  802.     .b.l config -text "000n0000"
  803.     getsize
  804. } "[expr $ax*4] [expr $ay*2]"
  805. test font-24.8 {Tk_ComputeTextLayout: special char was t} {
  806.     .b.l config -text "000t00"
  807.     getsize
  808. } "[expr $ax*10] $ay"
  809. test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} {
  810.     set x {}
  811.     .b.l config -text "000t000"
  812.     lappend x [getsize]
  813.     .b.l config -text "000t000" -wrap [expr 100*$ax]
  814.     lappend x [getsize]
  815.     .b.l config -wrap 0
  816.     set x
  817. } "{[expr $ax*11] $ay} {[expr $ax*11] $ay}"
  818. test font-24.10 {Tk_ComputeTextLayout: tab caused break} {
  819.     set x {}
  820.     .b.l config -text "000t"
  821.     lappend x [getsize]
  822.     .b.l config -text "000t00" -wrap [expr $ax*6]
  823.     lappend x [getsize]
  824.     .b.l config -wrap 0
  825.     set x
  826. } "{[expr $ax*3] $ay} {[expr $ax*3] [expr $ay*2]}"
  827. test font-24.11 {Tk_ComputeTextLayout: absorb spaces at eol} {
  828.     set x {}
  829.     .b.l config -text "000            000" -wrap [expr $ax*5]
  830.     lappend x [getsize]
  831.     .b.l config -text "000            "
  832.     lappend x [getsize]
  833.     .b.l config -wrap 0
  834.     set x
  835. } "{[expr $ax*3] [expr $ay*2]} {[expr $ax*3] $ay}"
  836. test font-24.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} {
  837.     set x {}
  838.     .b.l config -text "000            0000" -wrap [expr $ax*5]
  839.     lappend x [getsize]
  840.     .b.l config -text "000t00            0000" -wrap [expr $ax*12]
  841.     lappend x [getsize]
  842.     .b.l config -wrap 0
  843.     set x
  844. } "{[expr $ax*4] [expr $ay*2]} {[expr $ax*10] [expr $ay*2]}"
  845. test font-24.13 {Tk_ComputeTextLayout: many lines -> realloc line array} {
  846.     .b.l config -text "nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn"
  847.     getsize
  848. } "1 [expr $ay*129]"
  849. test font-24.14 {Tk_ComputeTextLayout: text ended with n} {
  850.     list [.b.l config -text "0000"; getsize] [.b.l config -text "0000n"; getsize]
  851. } "{[expr $ax*4] $ay} {[expr $ax*4] [expr $ay*2]}"
  852. test font-24.15 {Tk_ComputeTextLayout: justification} {
  853.     csetup "000n00000"
  854.     set x {}
  855.     .b.c itemconfig text -just left
  856.     lappend x [.b.c index text @[expr $ax*2],0]
  857.     .b.c itemconfig text -just center
  858.     lappend x [.b.c index text @[expr $ax*2],0]
  859.     .b.c itemconfig text -just right
  860.     lappend x [.b.c index text @[expr $ax*2],0]
  861.     .b.c itemconfig text -just left
  862.     set x
  863. } {2 1 0}
  865. test font-25.1 {Tk_FreeTextLayout procedure} {
  866.     setup
  867.     .b.f config -text foo
  868.     .b.f config -text boo
  869. } {}
  870.     
  871. test font-26.1 {Tk_DrawTextLayout procedure: auto-detect last char} {
  872.     .b.f config -text foo
  873. } {}
  874. test font-26.2 {Tk_DrawTextLayout procedure: multiple chunks} {
  875.     csetup "000t00n000"
  876. } {}
  877. test font-26.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} {
  878.     csetup "000t00"
  879.     .b.c select from text 3
  880.     .b.c select to text 5
  881. } {}
  882. test font-26.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} {
  883.     .b.c select from text 3
  884.     .b.c select to text 5
  885. } {}
  886. test font-26.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} {
  887.     .b.c select from text 2
  888.     .b.c select to text 2
  889. } {}
  890. test font-26.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} {
  891.     .b.c select from text 4
  892.     .b.c select to text 4
  893. } {}
  895. test font-27.1 {Tk_UnderlineTextLayout procedure: no underline chosen} {
  896.     .b.f config -text "foo" -under -1
  897. } {}
  898. test font-27.2 {Tk_UnderlineTextLayout procedure: underline not visible} {
  899.     .b.f config -text "000          00000" -wrap [expr $ax*7] -under 10
  900. } {}
  901. test font-27.3 {Tk_UnderlineTextLayout procedure: underline is visible} {
  902.     .b.f config -text "000          00000" -wrap [expr $ax*7] -under 5
  903.     .b.f config -wrap -1 -under -1
  904. } {}
  905.     
  906. test font-28.1 {Tk_PointToChar procedure: above all lines} {
  907.     csetup "000"
  908.     .b.c index text @-1,0
  909. } {0}
  910. test font-28.2 {Tk_PointToChar procedure: no chars} {
  911.     # After fixing the following bug:
  912.     #
  913.     # In canvas text item, it was impossible to click to position the
  914.     # insertion point just after the last character.
  915.     #
  916.     # introduced another bug that Tk_PointToChar() would return a character
  917.     # index of 1 if TextLayout contained 0 characters.
  919.     csetup ""
  920.     .b.c index text @100,100
  921. } {0}
  922. test font-28.3 {Tk_PointToChar procedure: loop test} {
  923.     csetup "000n000n000n000"
  924.     .b.c index text @10000,0
  925. } {3}
  926. test font-28.4 {Tk_PointToChar procedure: intersect line} {
  927.     csetup "000n000n000"
  928.     .b.c index text @0,$ay
  929. } {4}
  930. test font-28.5 {Tk_PointToChar procedure: to the left of all chunks} {
  931.     .b.c index text @-100,$ay
  932. } {4}
  933. test font-28.6 {Tk_PointToChar procedure: past any possible chunk} {
  934.     .b.c index text @100000,$ay
  935. } {7}
  936. test font-28.7 {Tk_PointToChar procedure: which chunk on this line} {
  937.     csetup "000n000t000t000n000"
  938.     .b.c index text @[expr $ax*2],$ay
  939. } {6}
  940. test font-28.8 {Tk_PointToChar procedure: which chunk on this line} {
  941.     csetup "000n000t000t000n000"
  942.     .b.c index text @[expr $ax*10],$ay
  943. } {10}
  944. test font-28.9 {Tk_PointToChar procedure: in special chunk} {
  945.     csetup "000n000t000t000n000"
  946.     .b.c index text @[expr $ax*6],$ay
  947. } {7}
  948. test font-28.10 {Tk_PointToChar procedure: past all chars in chunk} {
  949.     csetup "000 0000000"
  950.     .b.c itemconfig text -width [expr $ax*5]
  951.     set x [.b.c index text @[expr $ax*5],0]
  952.     .b.c itemconfig text -width 0
  953.     set x
  954. } {3}
  955. test font-28.11 {Tk_PointToChar procedure: below all chunks} {
  956.     csetup "000 0000000"
  957.     .b.c index text @0,1000000
  958. } {11}
  959.     
  960. test font-29.1 {Tk_CharBBox procedure: index < 0} {
  961.     .b.f config -text "000" -underline -1
  962. } {}
  963. test font-29.2 {Tk_CharBBox procedure: loop} {
  964.     .b.f config -text "000t000t000t000" -underline 9
  965. } {}
  966. test font-29.3 {Tk_CharBBox procedure: special char} {
  967.     .b.f config -text "000t000t000" -underline 7
  968. } {}
  969. test font-29.4 {Tk_CharBBox procedure: normal char} {
  970.     .b.f config -text "000" -underline 1
  971. } {}
  972. test font-29.5 {Tk_CharBBox procedure: right edge of bbox truncated} {
  973.     .b.f config -text "0    0000" -wrap [expr $ax*4] -under 2
  974.     .b.f config -wrap 0
  975. } {}
  976. test font-29.6 {Tk_CharBBox procedure: bbox pegged to right edge} {
  977.     .b.f config -text "0    0000" -wrap [expr $ax*4] -under 3
  978.     .b.f config -wrap 0
  979. } {}
  981. .b.c bind all <Enter> {lappend x [.b.c index current @%x,%y]}
  983. test font-30.1 {Tk_DistanceToTextLayout procedure: loop once} {
  984.     csetup "000n000n000"
  985.     set x {}
  986.     event generate .b.c <Leave>
  987.     event generate .b.c <Enter> -x 0 -y 0
  988.     set x
  989. } {0}
  990. test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} {
  991.     csetup "000n000n000"
  992.     set x {}
  993.     event generate .b.c <Leave>
  994.     event generate .b.c <Enter> -x $ax -y $ay
  995.     set x
  996. } {5}
  997. test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} {
  998.     csetup "000n0n000"
  999.     set x {}
  1000.     event generate .b.c <Leave>
  1001.     event generate .b.c <Enter> -x [expr $ax*2] -y $ay
  1002.     set x
  1003. } {}
  1004. test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} {
  1005.     csetup "000t000n000"
  1006.     set x {}
  1007.     event generate .b.c <Leave>
  1008.     event generate .b.c <Enter> -x [expr $ax*6] -y 0
  1009.     set x
  1010. } {3}
  1011. test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} {
  1012.     csetup "000n0n000"
  1013.     set x {}
  1014.     event generate .b.c <Leave>
  1015.     event generate .b.c <Enter> -x [expr $ax*2] -y $ay
  1016.     set x
  1017. } {}
  1018. test font-30.6 {Tk_DistanceToTextLayout procedure: ignore spaces at eol} {
  1019.     csetup "000n000      000000000"
  1020.     .b.c itemconfig text -width [expr $ax*10]
  1021.     set x {}
  1022.     event generate .b.c <Leave>
  1023.     event generate .b.c <Enter> -x [expr $ax*5] -y $ay
  1024.     .b.c itemconfig text -width 0
  1025.     set x
  1026. } {}
  1027. .b.c itemconfig text -justify center
  1028. test font-30.7 {Tk_DistanceToTextLayout procedure: on left side} {
  1029.     csetup "0n000"
  1030.     set x {}
  1031.     event generate .b.c <Leave>
  1032.     event generate .b.c <Enter> -x 0 -y 0
  1033.     set x
  1034. } {}
  1035. test font-30.8 {Tk_DistanceToTextLayout procedure: on right side} {
  1036.     csetup "0n000"
  1037.     set x {}
  1038.     event generate .b.c <Leave>
  1039.     event generate .b.c <Enter> -x [expr $ax*2] -y 0
  1040.     set x
  1041. } {}
  1042. test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} {
  1043.     csetup "0n000"
  1044.     set x {}
  1045.     event generate .b.c <Leave>
  1046.     event generate .b.c <Enter> -x $ax -y 0
  1047.     set x
  1048. } {0}
  1049. test font-30.10 {Tk_DistanceToTextLayout procedure: above line} {
  1050.     csetup "0n000"
  1051.     set x {}
  1052.     event generate .b.c <Leave>
  1053.     event generate .b.c <Enter> -x 0 -y 0
  1054.     set x
  1055. } {}
  1056. test font-30.11 {Tk_DistanceToTextLayout procedure: below line} {
  1057.     csetup "000n0"
  1058.     set x {}
  1059.     event generate .b.c <Leave>
  1060.     event generate .b.c <Enter> -x 0 -y $ay
  1061.     set x
  1062. } {}
  1063. test font-30.12 {Tk_DistanceToTextLayout procedure: in line} {
  1064.     csetup "0n000"
  1065.     set x {}
  1066.     event generate .b.c <Leave>
  1067.     event generate .b.c <Enter> -x $ax -y $ay
  1068.     set x
  1069. } {3}
  1070. .b.c itemconfig text -justify left
  1071. test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} {
  1072.     csetup "000"
  1073.     set x {}
  1074.     event generate .b.c <Leave>
  1075.     event generate .b.c <Enter> -x $ax -y 0
  1076.     set x
  1077. } {1}
  1079. test font-31.1 {Tk_IntersectTextLayout procedure: loop once} {
  1080.     csetup "000n000n000"
  1081.     .b.c find overlapping 0 0 0 0
  1082. } [.b.c find withtag text]
  1083. test font-31.2 {Tk_IntersectTextLayout procedure: loop multiple} {
  1084.     csetup "000t000t000"
  1085.     .b.c find overlapping [expr $ax*10] 0 [expr $ax*10] 0
  1086. } [.b.c find withtag text]
  1087. test font-31.3 {Tk_IntersectTextLayout procedure: loop to end} {
  1088.     csetup "0n000"
  1089.     .b.c find overlapping [expr $ax*2] 0 [expr $ax*2] 0
  1090. } {}
  1091. test font-31.4 {Tk_IntersectTextLayout procedure: hit a special char (tab)} {
  1092.     csetup "000t000"
  1093.     .b.c find overlapping [expr $ax*6] 0 [expr $ax*6] 0
  1094. } [.b.c find withtag text]
  1095. test font-31.5 {Tk_IntersectTextLayout procedure: ignore newlines} {
  1096.     csetup "000n0n000"
  1097.     .b.c find overlapping $ax $ay $ax $ay
  1098. } {}
  1099. test font-31.6 {Tk_IntersectTextLayout procedure: ignore spaces at eol} {
  1100.     csetup "000n000      000000000"
  1101.     .b.c itemconfig text -width [expr $ax*10]
  1102.     set x [.b.c find overlapping [expr $ax*5] $ay [expr $ax*5] $ay]
  1103.     .b.c itemconfig text -width 0
  1104.     set x
  1105. } {}
  1107. test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
  1108.     # If there were a whole bunch of returns or tabs in a row, then the
  1109.     # temporary buffer could overflow and write on the stack.
  1110.     
  1111.     csetup "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnmn"
  1112.     .b.c itemconfig text -width 800
  1113.     .b.c insert text end "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnmn"
  1114.     .b.c insert text end "nnnnnnnnnnnnnnnnnnnnnnnnnnnnnn"
  1115.     .b.c insert text end "end"
  1116.     set x [.b.c postscript]
  1117.     set i [string first "(qwerty" $x] 
  1118.     string range $x $i [expr {$i + 278}]
  1119. } {(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)]
  1120. [(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)]
  1121. [()]
  1122. [()]
  1123. [()]
  1124. [()]
  1125. [()]
  1126. [()]
  1127. [()]
  1128. [()]
  1129. [()]
  1130. [()]
  1131. [()]
  1132. [()]
  1133. [()]
  1134. [()]
  1135. [()]
  1136. [()]
  1137. [()]
  1138. [()]
  1139. [()]
  1140. [()]
  1141. [()]
  1142. [()]
  1143. [()]
  1144. [()]
  1145. [()]
  1146. [()]
  1147. [()]
  1148. [()]
  1149. [()]
  1150. [()]
  1151. [(end)]
  1152. }
  1154. test font-33.1 {Tk_TextWidth procedure} {
  1155. } {}
  1157. test font-33.2 {ConfigAttributesObj procedure: arguments} {
  1158.     # (Tcl_GetIndexFromObj() != TCL_OK)
  1159.     setup
  1160.     list [catch {font create xyz -xyz} msg] $msg
  1161. } {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
  1162. test font-34.1 {ConfigAttributesObj procedure: arguments} {
  1163.     # (objc & 1)
  1164.     setup
  1165.     list [catch {font create xyz -family} msg] $msg
  1166. } {1 {value for "-family" option missing}}
  1167. set i 3
  1168. foreach p {
  1169.     {family xyz times}
  1170.     {size 20 40}
  1171.     {weight normal bold}
  1172.     {slant roman italic}
  1173.     {underline 0 1}
  1174.     {overstrike 0 1}
  1175. } {
  1176.     set opt [lindex $p 0]
  1177.     test font-34.$i "ConfigAttributesObj procedure: $opt" {
  1178. setup
  1179. set x {}
  1180. font create xyz -$opt [lindex $p 1]
  1181. lappend x [font config xyz -$opt]
  1182. font config xyz -$opt [lindex $p 2]
  1183. lappend x [font config xyz -$opt]
  1184.     } [lrange $p 1 2]
  1185.     incr i
  1186. }
  1187. foreach p {
  1188.     {size xyz {1 {expected integer but got "xyz"}}}
  1189.     {weight xyz {1 {bad -weight value "xyz": must be normal, or bold}}}
  1190.     {slant xyz {1 {bad -slant value "xyz": must be roman, or italic}}}
  1191.     {underline xyz {1 {expected boolean value but got "xyz"}}}
  1192.     {overstrike xyz {1 {expected boolean value but got "xyz"}}}
  1193. } {
  1194.     test font-34.$i "ConfigAttributesObj procedure: [lindex $p 0]" {
  1195. setup
  1196. list [catch {font create xyz -[lindex $p 0] [lindex $p 1]} msg] $msg
  1197.     } [lindex $p 2]
  1198.     incr i
  1199. }
  1201. test font-35.1 {GetAttributeInfoObj procedure: one attribute} {
  1202.     # (objPtr != NULL)
  1203.     setup
  1204.     font create xyz -family xyz
  1205.     font config xyz -family
  1206. } {xyz}
  1207. test font-36.1 {GetAttributeInfoObj procedure: unknown attribute} {
  1208.     # (Tcl_GetIndexFromObj() != TCL_OK)
  1209.     setup
  1210.     font create xyz
  1211.     list [catch {font config xyz -xyz} msg] $msg
  1212. } {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
  1213. test font-37.1 {GetAttributeInfoObj procedure: all attributes} {
  1214.     # not (objPtr != NULL) 
  1215.     setup
  1216.     font create xyz -family xyz
  1217.     font config xyz
  1218. } {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0}
  1219. set i 4
  1220. foreach p {
  1221.     {family xyz xyz}
  1222.     {size 20 20}
  1223.     {weight normal normal}
  1224.     {slant italic italic}
  1225.     {underline yes 1}
  1226.     {overstrike false 0}
  1227. } {
  1228.     test font-31.$i "GetAttributeInfo procedure: [lindex $p 0]" {
  1229. setup
  1230. font create xyz -[lindex $p 0] [lindex $p 1]
  1231. font config xyz -[lindex $p 0]
  1232.     } [lindex $p 2]
  1233.     incr i
  1234. }
  1236. # In tests below, one field is set to "xyz" so that font name doesn't
  1237. # look like a native X font, so that ParseFontNameObj or TkParseXLFD will
  1238. # be called.
  1240. setup
  1242. test font-38.1 {ParseFontNameObj procedure: begins with -} {
  1243.     lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
  1244. } $times
  1245. test font-38.2 {ParseFontNameObj procedure: begins with -*} {
  1246.     lindex [font actual -*-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
  1247. } $times
  1248. test font-38.3 {ParseFontNameObj procedure: begins with -, doesn't look like list} {
  1249.     lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
  1250. } $times
  1251. test font-38.4 {ParseFontNameObj procedure: begins with -, looks like list} {
  1252.     lindex [font actual {-family times}] 1
  1253. } $times
  1254. test font-38.5 {ParseFontNameObj procedure: begins with *} {
  1255.     lindex [font actual *-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
  1256. } $times
  1257. test font-38.6 {ParseFontNameObj procedure: begins with *} {
  1258.     font actual *-times-xyz -family
  1259. } $times
  1260. test font-38.7 {ParseFontNameObj procedure: arguments} {noExceed} {
  1261.     list [catch {font actual "{xyz"} msg] $msg
  1262. } [list 1 "font "{xyz" doesn't exist"]
  1263. test font-38.8 {ParseFontNameObj procedure: arguments} {noExceed} {
  1264.     list [catch {font actual ""} msg] $msg
  1265. } {1 {font "" doesn't exist}}
  1266. test font-38.9 {ParseFontNameObj procedure: arguments} {
  1267.     list [catch {font actual {times 20 xyz xyz}} msg] $msg
  1268. } {1 {unknown font style "xyz"}}
  1269. test font-38.10 {ParseFontNameObj procedure: arguments} {
  1270.     list [catch {font actual {times xyz xyz}} msg] $msg
  1271. } {1 {expected integer but got "xyz"}}
  1272. test font-38.11 {ParseFontNameObj procedure: stylelist loop} {macOnly} {
  1273.     lrange [font actual {times 12 bold italic overstrike underline}] 4 end
  1274. } {-weight bold -slant italic -underline 1 -overstrike 0}
  1275. test font-38.12 {ParseFontNameObj procedure: stylelist loop} {unixOrPc} {
  1276.     lrange [font actual {times 12 bold italic overstrike underline}] 4 end
  1277. } {-weight bold -slant italic -underline 1 -overstrike 1}
  1278. test font-38.13 {ParseFontNameObj procedure: stylelist error} {
  1279.     list [catch {font actual {times 12 bold xyz}} msg] $msg
  1280. } {1 {unknown font style "xyz"}}
  1282. test font-39.1 {NewChunk procedure: test realloc} {
  1283.     .b.f config -text "xxxnxxxtxxxnxxxttt"
  1284. } {}
  1286. test font-40.1 {TkFontParseXLFD procedure: initial dash} {
  1287.     font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-* -family
  1288. } $times
  1289. test font-40.2 {TkFontParseXLFD procedure: no initial dash} {
  1290.     font actual *-times-*-*-*-*-*-*-*-*-*-*-*-xyz -family
  1291. } $times
  1292. test font-40.3 {TkFontParseXLFD procedure: not enough fields} {
  1293.     font actual -xyz-times-*-*-* -family
  1294. } $times
  1295. test font-40.4 {TkFontParseXLFD procedure: all fields unspecified} {
  1296.     lindex [font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*] 0
  1297. } {-family}
  1298. test font-40.5 {TkFontParseXLFD procedure: all fields specified} {
  1299.     lindex [font actual -foundry-times-weight-slant-setwidth-addstyle-10-10-10-10-spacing-avgwidth-registry-encoding] 1
  1300. } $times
  1301. test font-41.1 {TkParseXLFD procedure: arguments} {
  1302.     # XLFD with bad pointsize: fallback to some system font.
  1303.     font actual -*-*-*-*-*-*-xyz-*-*-*-*-*-*-*
  1304.     set x {}
  1305. } {}
  1306. test font-42.1 {TkFontParseXLFD procedure: arguments} {
  1307.     # XLFD with bad pixelsize: fallback to some system font.
  1308.     font actual -*-*-*-*-*-*-*-xyz-*-*-*-*-*-*
  1309.     set x {}
  1310. } {}
  1311. test font-42.2 {TkFontParseXLFD procedure: pixelsize specified} {
  1312.     font metrics -xyz-times-*-*-*-*-12-*-*-*-*-*-*-* -linespace
  1313.     set x {}
  1314. } {}
  1315. test font-42.3 {TkFontParseXLFD procedure: weird pixelsize specified} {
  1316.     font metrics {-xyz-times-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*-*} -linespace
  1317.     set x {}
  1318. } {}
  1319. test font-42.4 {TkFontParseXLFD procedure: pointsize specified} {
  1320.     font metrics -xyz-times-*-*-*-*-*-120-*-*-*-*-*-* -linespace
  1321.     set x {}
  1322. } {}
  1323. test font-42.5 {TkFontParseXLFD procedure: weird pointsize specified} {
  1324.     font metrics {-xyz-times-*-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*} -linespace
  1325.     set x {}
  1326. } {}
  1328. test font-43.1 {FieldSpecified procedure: specified vs. non-specified} {
  1329.     font actual -xyz--*-*-*-*-*-*-*-*-*-*-*-*
  1330.     font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*
  1331.     font actual -xyz-?-*-*-*-*-*-*-*-*-*-*-*-*
  1332.     lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
  1333. } $times
  1335. set oldscale [tk scaling]
  1336. tk scaling 0.5
  1337. test font-44.1 {TkFontGetPixels: size < 0} {
  1338.     font actual {times -12} -size
  1339. } {24}
  1340. test font-44.2 {TkFontGetPoints: size >= 0} {noExceed} {
  1341.     font actual {times 12} -size
  1342. } {12}
  1344. tk scaling $oldscale
  1346. test font-45.1 {TkFontGetAliasList: no match} {
  1347.     font actual {snarky 10} -family
  1348. } [font actual {-size 10} -family]
  1349. test font-45.2 {TkFontGetAliasList: match} {macOnly} {
  1350.     # Result could be either "Times" or "New York"
  1351.     font actual {{times new roman} 10} -family
  1352. } [font actual {times 10} -family]
  1353. test font-45.3 {TkFontGetAliasList: match} {pcOnly} {
  1354.     font actual {times 10} -family
  1355. } {Times New Roman}
  1356. test font-45.4 {TkFontGetAliasList: match} {unixOnly noExceed} {
  1357.     # can fail on Unix systems that have a real "times new roman" font
  1358.     font actual {{times new roman} 10} -family
  1359. } [font actual {times 10} -family]
  1361. setup
  1363. destroy .b
  1365. # cleanup
  1366. ::tcltest::cleanupTests
  1367. return