API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jul 20th, 2017
83
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
TCL 18.26 KB | None | 0 0
raw download clone embed print report
  1. namespace eval vimage {
  2. global auto_path
  3. global configdir
  4. variable Config
  5. variable System
  6. variable toolbar_button
  7. variable useTkImageTools
  8.  
  9.     set System(script_dir) [file dirname [info script]]
  10.    
  11.     set auto_path [linsert $auto_path 0 [file join $System(script_dir) lib]]
  12.    
  13.     package require http
  14.     package require msgcat
  15.     package require viewer
  16.     package require BWidget
  17.     package require Img
  18.    
  19.     ::msgcat::mcload [file join $System(script_dir) msgs]
  20.    
  21.     set System(extensions) {gif|pixmap}
  22.     append System(extensions) {|bmp|ico|jpeg|jpg|pcx|}
  23.     append System(extensions) {png|ppm|postscript|sgi|sun|}
  24.     append System(extensions) {tga|tiff|xbm|xpm}
  25.    
  26.     # Hidden Group
  27.     custom::defvar toolbar_button(index) {-1} \
  28.     [::msgcat::mc "Last button index"] \
  29.     -type string -group Hidden
  30.     custom::defvar toolbar_button(state) {1} \
  31.     [::msgcat::mc "Button (and plugin) state"] \
  32.     -type string -group Hidden
  33.  
  34.     set Config(ignore_history_urls) 1
  35.     set Config(validate_urls) 0
  36.     set Config(auto_show_viewer) 1
  37.     set Config(show_progressbar) 1
  38.     set Config(max_size) 100
  39.     set Config(add_toolbar_button) 1
  40.     set Config(show_tooltip) 1
  41.     set Config(image_width) 200
  42.     set Config(show_label) 1
  43.     set Config(auto_getting) 0
  44.    
  45.     set Config(viewer,position) center
  46.     set Config(viewer,alpha) -1
  47.     set Config(viewer,topmost) 0
  48.     set Config(viewer,size) default
  49.     set Config(viewer,scroller_gain) sticky_mouse
  50.     set Config(viewer,startup_history_state) 1
  51.    
  52.     image create photo vimage/toolbar -file [file join $System(script_dir) pixmaps toolbar.png]
  53.     image create photo vimage/normal -file [file join $System(script_dir) pixmaps normal.gif]
  54.     image create photo vimage/image -file [file join $System(script_dir) pixmaps image.gif]
  55.     image create photo vimage/process -file [file join $System(script_dir) pixmaps process.gif]
  56.     image create photo vimage/error -file [file join $System(script_dir) pixmaps error.gif]
  57.     image create photo vimage/large -file [file join $System(script_dir) pixmaps large.gif]
  58.     image create photo vimage/no_image_available -file [file join $System(script_dir) pixmaps no_image_available.gif]
  59. }
  60.  
  61. proc vimage::add_toolbar_button {} {
  62. variable toolbar_button
  63.    
  64.     catch {.mainframe gettoolbar 0} toolbar
  65.     set bbox $toolbar.bbox
  66.    
  67.     if {[winfo exist $toolbar.bbox] && ![ButtonBox::exist $toolbar.bbox $toolbar_button(index)]} {
  68.         set toolbar_button(index) [ifacetk::add_toolbar_button \
  69.             vimage/toolbar \
  70.                 [list [namespace origin see_image_in_viewer] {}] \
  71.                     [::msgcat::mc "Show vimage history"]]
  72.     }
  73. }
  74.  
  75. proc vimage::delete_toolbar_button {} {
  76. variable toolbar_button
  77.    
  78.     catch {.mainframe gettoolbar 0} toolbar
  79.     set bbox $toolbar.bbox
  80.    
  81.     if {[winfo exist $toolbar.bbox] && [ButtonBox::exist $toolbar.bbox $toolbar_button(index)]} {
  82.         ButtonBox::delete $toolbar.bbox $toolbar_button(index)
  83.         set toolbar_button(index) -1
  84.     }
  85. }
  86.  
  87. proc vimage::add_or_delete_toolbar_button {args} {
  88. variable Config
  89.    
  90.     switch -- $Config(add_toolbar_button) {
  91.         1 add_toolbar_button
  92.         0 delete_toolbar_button
  93.     }
  94. }
  95.  
  96. proc vimage::add_to_located {nurl lurl} {
  97. variable ImagesData
  98.  
  99.     lappend ImagesData(located,$lurl) $nurl
  100.     set  ImagesData(located,$lurl) \
  101.         [lsort -unique $ImagesData(located,$lurl)]
  102. }
  103.  
  104. proc vimage::draw_message {chatid from type body extras} {
  105. variable Config
  106.  
  107.     if {$Config(ignore_history_urls) &&
  108.         [::xmpp::delay::exists $extras]} \
  109.             {return}
  110.    
  111.     foreach iUrl [get_image_urls $body] {
  112.         update_icon_on_chatwin $iUrl $chatid image
  113.         if { ! [image_getted $iUrl] && $Config(auto_getting)} {
  114.         schedule [namespace origin getting] $iUrl $chatid
  115.         } else {
  116.         show_process $iUrl $chatid
  117.         }
  118.     }
  119. }
  120.  
  121. proc vimage::comp_getting {iUrl chatid} {
  122. variable Config
  123.  
  124.     set old_msize $Config(max_size)
  125.     set Config(max_size) 1000000
  126.    
  127.     getting $iUrl $chatid -reload
  128.    
  129.     set Config(max_size) $old_msize
  130. }
  131.  
  132. proc vimage::getting {iUrl chatid {type -get}} {
  133.  
  134.     if {[string equal $type "-reload"]} \
  135.         {set_state_getting $iUrl reload}
  136.    
  137.     update_icon_on_chatwin $iUrl $chatid process
  138.        
  139.     if { ! [image_getted $iUrl]} {
  140.     get_image_from_url $iUrl $chatid
  141.     }
  142.    
  143.     show_process $iUrl $chatid
  144.     clean_process_update $iUrl $chatid
  145. }
  146.  
  147. proc vimage::show_process {iUrl chatid} {
  148.  
  149.     switch -exact -- [image_state $iUrl] {
  150.         -1 {
  151.             update_icon_on_chatwin $iUrl $chatid image
  152.         }
  153.         0 {
  154.             update_icon_on_chatwin $iUrl $chatid normal
  155.             show_process_normal $iUrl $chatid
  156.         }
  157.         1 {
  158.             update_icon_on_chatwin $iUrl $chatid large
  159.         }
  160.         2 {
  161.             update_icon_on_chatwin $iUrl $chatid error
  162.         }
  163.     }
  164. }
  165.  
  166. proc vimage::show_process_normal {iUrl chatid} {
  167. variable Config
  168.  
  169.     add_image_in_viewer \
  170.             [image_id $iUrl] [::chat::get_jid $chatid] $iUrl
  171.            
  172.     if {$Config(auto_show_viewer) && ![image_showed $iUrl]} {
  173.     after idle [list [namespace origin see_image_in_viewer] $iUrl]
  174.     }
  175.    
  176.     if {$Config(show_tooltip)} {
  177.         addResized $iUrl
  178.     }
  179. }
  180.  
  181. proc vimage::get_image_from_url {iUrl chatid} {
  182. variable Config
  183.    
  184.     if {$Config(validate_urls)} {
  185.     set iUrl [location $iUrl]
  186.     }
  187.    
  188.     if {[catch {set token [http::geturl $iUrl -binary 1 -blocksize 1024 \
  189.         -command [list [namespace origin image_get_end] $iUrl $chatid] \
  190.         -progress [list [namespace origin image_get_process] $iUrl $chatid]]
  191.     }]} {return [set_state_getting $iUrl error]}
  192.    
  193.     http::wait $token
  194. }
  195.  
  196. proc vimage::location {iUrl} {
  197.     if {[catch {set token [http::geturl $iUrl -validate 1]} err]} \
  198.         {return $iUrl}
  199.    
  200.     foreach {type value} [http::meta $token] {
  201.         if {[string equal $type "Location"]} \
  202.             {set iUrl $value}
  203.     }
  204.    
  205.     return $iUrl
  206. }
  207.  
  208. proc vimage::image_get_end {iUrl chatid token} {
  209.     if {[catch {image create photo vimage/$iUrl -data [http::data $token]}]} {
  210.     set_state_getting $iUrl error
  211.     } else {set_state_getting $iUrl normal vimage/$iUrl}
  212.  
  213.    
  214.     http::cleanup $token
  215. }
  216.  
  217. proc vimage::image_get_process {iUrl chatid token total current} {
  218. variable Config
  219.    
  220.     setImageSize $iUrl $total
  221.    
  222.     set max_size [expr {$Config(max_size)*1024}]
  223.     if {$current > $max_size || $total > $max_size} {
  224.         http::reset $token
  225.         set_state_getting $iUrl large
  226.     }
  227.    
  228.     update_url_getting_on_chatwin $iUrl $chatid $total $current
  229.    
  230.     return
  231. }
  232.  
  233. proc vimage::setImageSize {iUrl total} {
  234. variable ImagesData
  235.  
  236.     set ImagesData(total,$iUrl) $total
  237. }
  238.  
  239. proc vimage::getImageSize {iUrl} {
  240. variable ImagesData
  241.  
  242.     if {[info exist ImagesData(total,$iUrl)]} {
  243.         return $ImagesData(total,$iUrl)
  244.     }
  245.    
  246.     return 0
  247. }
  248.  
  249. proc vimage::clean_process_update {iUrl chatid} {
  250.     catch {destroy .mainframe.status.prgf.prb}
  251.     catch {destroy .mainframe.status.prgf.lab}
  252. }
  253.  
  254. proc vimage::update_url_getting_on_chatwin {iUrl chatid total current} {
  255. variable Config
  256.  
  257.     set current [expr {round($current / 1024)}]
  258.     set total [expr {round($total / 1024)}]
  259.  
  260.     set [namespace current]::progress-$iUrl $current
  261.     progressbar [namespace current]::progress-$iUrl $total $current [::chat::get_jid $chatid]
  262.  
  263.  
  264.     return
  265. }
  266.  
  267. proc vimage::update_icon_on_chatwin {iUrl chatid type} {
  268. variable Config
  269.    
  270.     set chatwin [::chat::chat_win $chatid]
  271.  
  272.     foreach {sind eind} [$chatwin tag range [list uri $iUrl]] {
  273.         set tag icon/$iUrl
  274.         if {[lsearch [$chatwin tag names $eind] $tag] < 0} {
  275.             $chatwin image create $eind -image vimage/$type -padx 2
  276.             $chatwin tag add $tag $eind
  277.         }
  278.         $chatwin image configure $eind -image vimage/$type
  279.     }
  280.    
  281.     bind_set $chatid $tag $iUrl $type
  282.    
  283.     update idletasks
  284. }
  285.  
  286. proc vimage::bind_set {chatid tag iUrl type} {
  287. variable Config
  288.    
  289.     set chatwin [::chat::chat_win $chatid]
  290.    
  291.     if {$Config(show_tooltip)} {
  292.     $chatwin tag bind $tag <Any-Enter> [list [namespace origin showTooltip] %W $tag $iUrl]
  293.     $chatwin tag bind $tag <Any-Motion> [list [namespace origin motionTooltip] %W]
  294.     $chatwin tag bind $tag <Any-Leave> [list destroy %W.tooltip]
  295.     $chatwin tag bind $tag <Any-KeyPress> [list destroy %W.tooltip]
  296.     $chatwin tag bind $tag <Any-Button> [list destroy %W.tooltip]
  297.     }
  298.    
  299.     # Change a cursor
  300.     $chatwin tag bind $tag  <Any-Enter> +[list [namespace origin on_icon] Any-Enter $iUrl $chatid]
  301.     $chatwin tag bind $tag <Any-Leave> +[list [namespace origin on_icon] Any-Leave $iUrl $chatid]
  302.    
  303.     # View image
  304.     $chatwin tag bind $tag <Button-1><ButtonRelease-1> [list [namespace origin on_icon] 1 $iUrl $chatid $type]
  305. }
  306.  
  307. proc vimage::on_icon {button iUrl chatid {type ""}} {
  308.     set chatwin [::chat::chat_win $chatid]
  309.    
  310.     switch -exact -- $button {
  311.         1 {
  312.             switch -exact -- $type {
  313.                 normal {
  314.                     see_image_in_viewer $iUrl
  315.                 }
  316.                 large {
  317.                     comp_getting $iUrl $chatid
  318.                 }
  319.                 image -
  320.                 error {
  321.                     getting $iUrl $chatid -reload
  322.                 }
  323.             }
  324.         }
  325.         2 {
  326.             getting $iUrl $chatid -reload
  327.         }
  328.         Any-Enter {
  329.             $chatwin configure -cursor [option get $chatwin urlcursor Text]
  330.         }
  331.         Any-Leave {
  332.             $chatwin configure -cursor [get_conf $chatwin -cursor]
  333.         }
  334.     }
  335. }
  336.  
  337. proc vimage::menu_draw {iUrl chatid} {
  338.  
  339.     set m .menu_vimage
  340.    
  341.     if {[winfo exist $m]} {
  342.     destroy $m
  343.     }
  344.    
  345.     menu $m -tearoff 0
  346.    
  347.     $m add command \
  348.         -label [::msgcat::mc "View"] \
  349.         -command [list [namespace origin see_image_in_viewer] $iUrl]
  350.    
  351.     $m add command \
  352.         -label [::msgcat::mc "Reload"] \
  353.         -command [list [namespace origin getting] $iUrl $chatid -reload]
  354.    
  355.     $m add command \
  356.         -label [::msgcat::mc "View without size limit"] \
  357.         -command [list [namespace origin comp_getting] $iUrl $chatid]
  358.        
  359.     tk_popup $m [winfo pointerx .] [winfo pointery .]
  360. }
  361.  
  362. proc vimage::progressbar { varname max current jid } {
  363. variable Config
  364.  
  365.     set win .mainframe.status.prgf
  366.    
  367.     if {[winfo exist $win] && [winfo exist $win.prb]} {
  368.         if {$max > 0} {
  369.             if {$Config(show_progressbar)} {
  370.                 $win.prb configure -maximum $max -variable $varname
  371.             }
  372.             if {$Config(show_label)} {
  373.                 $win.lab configure -text "$jid ($current/$max)"
  374.             }
  375.         }
  376.         return
  377.     }
  378.    
  379.     if {$Config(show_label)} {
  380.     label $win.lab -text $jid -background [$win cget -background]
  381.     }
  382.    
  383.     if {$Config(show_progressbar)} {
  384.     ProgressBar $win.prb -type nonincremental_infinite \
  385.         -variable $varname -relief groove
  386.     }
  387.        
  388.     if {$max > 0} {
  389.         if {$Config(show_progressbar)} {
  390.             $win.prb configure -maximum $max -type normal
  391.         }
  392.         if {$Config(show_label)} {
  393.             $win.lab configure -text "$jid ($current/$max)"
  394.         }
  395.     }
  396.    
  397.     if {$Config(show_progressbar) && $Config(show_label)} {
  398.         pack $win.lab $win.prb -padx 2 -side left
  399.     } elseif {$Config(show_progressbar)} {
  400.         pack $win.prb -padx 2 -side left
  401.     } else {
  402.         pack $win.lab -padx 2 -side left
  403.     }
  404. }
  405.  
  406. proc vimage::see_image_in_viewer {iUrl} {
  407. variable System
  408.    
  409.     add_to_showed $iUrl
  410.    
  411.     if {[info exist System(viewer)] &&
  412.         [winfo exist $System(viewer)]} {
  413.             $System(viewer) see $iUrl text
  414.             $System(viewer) show
  415.     }
  416. }
  417.  
  418. proc vimage::add_image_in_viewer {image_id jid iUrl} {
  419. variable System
  420. variable Config
  421.  
  422.     if { ! [info exist System(viewer)] || ! [winfo exist $System(viewer)]} {
  423.         set System(viewer) .viewer_screen
  424.         ::viewer::viewer .viewer_screen -position $Config(viewer,position) \
  425.             -alpha $Config(viewer,alpha) -topmost $Config(viewer,topmost) \
  426.             -size $Config(viewer,size) -scroller_gain $Config(viewer,scroller_gain) \
  427.             -startup_history_state $Config(viewer,startup_history_state)
  428.     }
  429.    
  430.     $System(viewer) add $jid $iUrl $image_id
  431. }
  432.  
  433. proc vimage::set_state_getting {iUrl type {image_id ""}} {
  434.     variable ImagesData
  435.    
  436.     switch -exact -- $type {
  437.         error {
  438.             set ImagesData(getted,$iUrl) 0
  439.             set ImagesData(state,$iUrl) 2
  440.             set ImagesData(image,$iUrl) {}
  441.             set ImagesData(image_resized,$iUrl) {}
  442.         }
  443.         normal {
  444.             set ImagesData(getted,$iUrl) 1
  445.             set ImagesData(state,$iUrl) 0
  446.             set ImagesData(image,$iUrl) $image_id
  447.             set ImagesData(image_resized,$iUrl) {}
  448.         }
  449.         large {
  450.             set ImagesData(getted,$iUrl) 0
  451.             set ImagesData(state,$iUrl) 1
  452.             set ImagesData(image,$iUrl) {}
  453.             set ImagesData(image_resized,$iUrl) {}
  454.         }
  455.         init {
  456.             set ImagesData(getted,$iUrl) 0
  457.             set ImagesData(state,$iUrl) -1
  458.             set ImagesData(image,$iUrl) {}
  459.             set ImagesData(image_resized,$iUrl) {}
  460.         }
  461.         reload {
  462.             array unset ImagesData *,$iUrl
  463.         }
  464.     }
  465. }
  466.    
  467. proc vimage::image_getted {iUrl} {
  468. variable ImagesData
  469.  
  470.     expr {[info exist ImagesData(getted,$iUrl)] &&
  471.             $ImagesData(getted,$iUrl)}
  472. }
  473.  
  474. proc vimage::image_state {iUrl} {
  475. variable ImagesData
  476.  
  477.     expr {[info exist ImagesData(state,$iUrl)] ? \
  478.         $ImagesData(state,$iUrl) : -1}
  479. }
  480.  
  481. proc vimage::image_id {iUrl} {
  482. variable ImagesData
  483.     expr {[info exist ImagesData(image,$iUrl)] ? \
  484.         $ImagesData(image,$iUrl) : ""}
  485. }
  486.  
  487. proc vimage::addResized {iUrl {image_id ""}} {
  488. variable ImagesData
  489. variable Config
  490.    
  491.     if { ! $::useTkImageTools} {
  492.     return
  493.     }
  494.    
  495.     if {[string length $image_id] == 0} {
  496.     set image_id [image_id $iUrl]
  497.     }
  498.    
  499.     set iw [image width $image_id]
  500.     set ih [image height $image_id]
  501.     set mw $Config(image_width)
  502.     set mh [expr {round( $ih / ( $iw / $mw + 1))}]
  503.    
  504.     if {$iw <= $mw || $ih <= $mh} {
  505.     return [set ImagesData(image_resized,$iUrl) $image_id]
  506.     }
  507.    
  508.     set dest [image create photo]
  509.     tkImageTools::resize $image_id $dest $mw $mh
  510.     set ImagesData(image_resized,$iUrl) $dest
  511.    
  512.     return
  513. }
  514.  
  515. proc vimage::getResized {iUrl} {
  516. variable ImagesData
  517.  
  518.     if {[info exist ImagesData(image_resized,$iUrl)] &&
  519.         [string length $ImagesData(image_resized,$iUrl)] > 0} {
  520.             return $ImagesData(image_resized,$iUrl)
  521.     }
  522.    
  523.     return vimage/no_image_available
  524. }
  525.  
  526. proc vimage::get_image_urls {str} {
  527. variable System
  528.    
  529.     set regUrls {(https?://[a-zA-Z0-9\-\.]+\.[a-zA-Z]{2,4}(?:\/\S*)?(?:[a-zA-Z0-9_])+\.(?:@INSERT@))}
  530.     regsub -all @INSERT@ $regUrls $System(extensions) regularString
  531.     lsort -unique [regexp -inline -nocase -all -- "$regularString" $str]
  532. }
  533.  
  534. proc vimage::get_all_urls {str} {
  535.     set regUrls {(https?://[a-z0-9\-]+\.[a-z0-9\-\.]+(?:/|(?:/[a-zA-Z0-9!#\$%&'\*\+,\-\.:;=\?@\[\]_~]+)*))}
  536.     lsort -unique [regexp -inline -nocase -all -- $regUrls $str]
  537. }
  538.  
  539. proc vimage::image_showed {iUrl} {
  540. variable ImagesData
  541.  
  542.     if {[info exist ImagesData(showed,$iUrl)]} {
  543.         return $ImagesData(showed,$iUrl)
  544.     }
  545.    
  546.     return 0
  547. }
  548.  
  549. proc vimage::add_to_showed {iUrl} {
  550. variable ImagesData
  551.     set ImagesData(showed,$iUrl) 1
  552. }
  553.  
  554. proc vimage::schedule {args} {
  555.     after idle [list after 0 $args]
  556. }
  557.  
  558. proc vimage::init_menu {m chatwin X Y x y} {
  559.     set tags [$chatwin tag names "@$x,$y"] 
  560.     set idx [lsearch $tags href_*]
  561.     set idx1 [lsearch $tags uri*]
  562.    
  563.      if { $idx < 0 } {
  564.         return
  565.     }
  566.    
  567.     if { $idx1 >= 0 } {
  568.         set url [lindex [lindex $tags $idx1] 1]
  569.     } else {
  570.         lassign [$w tag prevrange url "@$x,$y"] a b
  571.         set url [$w get $a $b]
  572.     }
  573.    
  574.     if {[llength [get_image_urls $url]] == 0} {
  575.     return
  576.     }
  577.    
  578.     set iUrl [lindex [get_image_urls $url] 0]
  579.     set winid [chatwin_to_winid $chatwin]
  580.     set chatid [::chat::winid_to_chatid $winid]
  581.     create_menu $iUrl $m $chatid
  582. }
  583.  
  584. proc vimage::create_menu {iUrl m chatid} {
  585.    
  586.     set text [::msgcat::mc "View"]
  587.     if { ! [image_getted $iUrl]} {
  588.     set text [::msgcat::mc "Get"]
  589.     }
  590.  
  591.     $m add command \
  592.         -label $text \
  593.         -command [list [namespace origin getting] $iUrl $chatid]
  594.    
  595.     set state normal
  596.     if { ! [image_getted $iUrl]} {
  597.     set state disabled
  598.     }
  599.    
  600.     $m add command \
  601.         -label [::msgcat::mc "Reload"] \
  602.         -command [list [namespace origin comp_getting] $iUrl $chatid -reload] \
  603.         -state $state
  604.        
  605.     $m add separator
  606. }
  607.  
  608. proc vimage::chatwin_to_winid {w} {
  609.     set last $w
  610.     if {[winfo parent $w] == "."} {return $last}
  611.     return [chatwin_to_winid [winfo parent $w]]
  612. }
  613.  
  614. ###########
  615. # HACK: create new procedures in ButtonBox for
  616. # adding and deleting toolbar button
  617. #
  618.  
  619. proc ::ButtonBox::exist {path index} {
  620.     variable $path
  621.     upvar 0 $path data
  622.    
  623.     return [expr {[lsearch -exact $data(buttons) $index] > 0}] 
  624. }
  625.  
  626. proc ::ButtonBox::delete {path idx} {
  627.     variable $path
  628.     upvar 0  $path data
  629.  
  630.     set i [lsearch -exact $data(buttons) $idx]
  631.     set data(buttons) [lreplace $data(buttons) $i $i]
  632.     destroy $path.b$idx
  633. }
  634.  
  635. proc vimage::showTooltip {widget tag iUrl} {
  636.     if {[string match $widget* [winfo containing  \
  637.         [winfo pointerx .] [winfo pointery .]]] == 0 } {
  638.             return
  639.     }
  640.  
  641.     if {[winfo exist $widget.tooltip]} {
  642.     destroy $widget.tooltip
  643.     }
  644.  
  645.     set img_id [getResized $iUrl]
  646.    
  647.     set scrh [winfo screenheight $widget]
  648.     set scrw [winfo screenwidth $widget]
  649.     set tooltip [toplevel $widget.tooltip]
  650.  
  651.     wm geometry $tooltip +$scrh+$scrw
  652.  
  653.     catch {wm overrideredirect $tooltip 1}
  654.  
  655.     if {[lsearch -exact [wm attributes $tooltip] "-topmost"] >= 0} {
  656.     wm attributes $tooltip -topmost 1
  657.     }
  658.  
  659.     pack [label $tooltip.label -image $img_id -justify left]
  660.  
  661.     update idletasks
  662.  
  663.     set width [winfo reqwidth $tooltip.label]
  664.     set height [winfo reqheight $tooltip.label]
  665.  
  666.     set x [winfo pointerx .]
  667.     set y [winfo pointery .]
  668.  
  669.     set pbm [expr {$y > ([winfo screenheight .] / 2.0)}]
  670.  
  671.     set positionX [expr {$x + 10}]
  672.     set positionY [expr {$y+ round($height / 2.0) * ($pbm * -2 + 1) - round($height / 2.0)}]
  673.  
  674.     if  {$positionX > [expr {round([winfo screenwidth .] / 2)}]} {
  675.     set positionX [expr {$positionX - $width - 20}]
  676.     }
  677.  
  678.     wm geometry $tooltip +[join  "$positionX + $positionY" {}]
  679.  
  680.     raise $tooltip
  681.  
  682.     bind $widget.tooltip <Any-Enter> {destroy %W}
  683.     bind $widget.tooltip <Any-Leave> {destroy %W}
  684. }
  685.  
  686. proc vimage::motionTooltip {widget} {
  687.     if { ! [winfo exist $widget.tooltip]} {
  688.     return
  689.     }
  690.    
  691.     if {[string match $widget* [winfo containing  \
  692.         [winfo pointerx .] [winfo pointery .]]] == 0 } {
  693.             return
  694.     }
  695.    
  696.     set width [winfo reqwidth $widget.tooltip.label]
  697.     set height [winfo reqheight $widget.tooltip.label]
  698.  
  699.     set x [winfo pointerx .]
  700.     set y [winfo pointery .]
  701.  
  702.     set pbm [expr {$y > ([winfo screenheight .] / 2.0)}]
  703.  
  704.     set positionX [expr {$x + 10}]
  705.     set positionY [expr {$y+ round($height / 2.0) * ($pbm * -2 + 1) - round($height / 2.0)}]
  706.  
  707.     if  {$positionX > [expr {round([winfo screenwidth .] / 2)}]} {
  708.     set positionX [expr {$positionX - $width - 20}]
  709.     }
  710.  
  711.     wm geometry $widget.tooltip +[join  "$positionX + $positionY" {}]
  712. }
  713.  
  714. namespace eval vimage {
  715.    
  716.     if {[catch {package require TkImageTools} result]} {
  717.         set ::useTkImageTools 0
  718.         hook::add finload_hook {
  719.             tk_messageBox -icon warning -title [::msgcat::mc "Load package: error"] \
  720.             -message [::msgcat::mc "Can't find TkImageTools package.\
  721.                     \nBalloon suspended.\n\n$result"] \
  722.             -detail [::msgcat::mc "See doc/TkImageTools for detals."]
  723.         }
  724.     } else {set ::useTkImageTools 1}
  725.    
  726.     hook::add draw_message_post_hook [namespace origin draw_message] 80
  727.     hook::add chat_win_popup_menu_hook [namespace origin init_menu] 1
  728.     hook::add finload_hook [namespace origin add_toolbar_button]
  729. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!