home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / clickUtils.tcl < prev    next >
Encoding:
Text File  |  1999-03-16  |  6.3 KB  |  268 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  # 
  4.  #  FILE: "clickUtils.tcl"
  5.  #                                    created: 11/2/96 {9:17:08 am} 
  6.  #                                last update: 16/3/1999 {11:07:20 pm} 
  7.  ##
  8.  
  9. # ◊◊◊◊ Option click in titlebar ◊◊◊◊ #
  10.  
  11. # Now doesn't add anything extra for windows which are not saved to disk. 
  12. # To deal with shells and other similar windows.  More general than only
  13. # doing this for shell mode.
  14. proc optClickTB_List {} {
  15.     global minItemsInTitlePopup
  16.     set lines [mode::proc OptionTitlebar]
  17.     if {[llength $lines] < $minItemsInTitlePopup} {
  18.     return [::OptionTitlebar $lines]
  19.     } else {
  20.     return $lines
  21.     }
  22. }
  23.  
  24. proc ::OptionTitlebar {{lines ""}} {
  25.     if {[file exists [stripNameCount [win::Current]]]} {
  26.     pushd [file dirname [win::Current]]
  27.     if {[llength $lines]} {
  28.         eval lappend lines "-" [glob -nocomplain *]
  29.     } else {
  30.         set lines [glob -nocomplain *]
  31.     }
  32.     popd
  33.     }
  34.     return $lines
  35. }
  36.  
  37. ## 
  38.  # -------------------------------------------------------------------------
  39.  #     
  40.  # "optClickTB_Pick" --
  41.  #    
  42.  #  Called when you select an item from the option-click pop-up.  Call a
  43.  #  mode-specific procedure if possible, else assume it's a file in the
  44.  #  same directory as the current window, and open it.  If the mode
  45.  #  specific procedure ends in an error, we use the default version. 
  46.  # -------------------------------------------------------------------------
  47.  ##
  48. proc optClickTB_Pick {item} {
  49.     if {[catch {mode::proc OptionTitlebarSelect $item}]} {
  50.     ::OptionTitlebarSelect $item
  51.     }
  52. }
  53.  
  54. proc ::OptionTitlebarSelect {item} {
  55.     if {[file isdirectory [file join [file dirname [win::Current]] $item]]} {
  56.     file::showInFinder [file join [file dirname [win::Current]] $item]
  57.     } else {
  58.     file::tryToOpen $item
  59.     }
  60. }
  61.  
  62. # ◊◊◊◊ Command click on window title ◊◊◊◊ #
  63.  
  64. # Called from Alpha when titlebar "title" menu selected (command-mouse).
  65. proc getTitleBarPath {} {
  66.     global fetched
  67.     
  68.     set f [win::Current]
  69.     if {[info exists fetched($f)]} {
  70.     set nm "[lindex $fetched($f) 0]/[lindex $fetched($f) 1]/[file tail $f]"
  71.     regsub -all {//} $nm {/} nm
  72.     regsub -all {/} $nm {:} nm
  73.     return $nm
  74.     } else {
  75.     return $f
  76.     }
  77. }
  78.  
  79. proc titlebar {name} {
  80.     global fetched
  81.     
  82.     if {[info exists fetched([win::Current])]} {
  83.     set specs $fetched([win::Current])
  84.     # add type of link to end of specs for backwards compatibility
  85.     if {[lindex $specs 4] == ""} {
  86.         lappend specs "ftp"
  87.         set fetched([win::Current]) $specs
  88.     }
  89.     if {$name == [getTitleBarPath]} {
  90.         set user ""
  91.         if {[key::shiftPressed]} {
  92.         set user [lindex $specs 2]
  93.         if {[key::controlPressed]} {
  94.             append user ":" [lindex $specs 3]
  95.         } 
  96.         append user "@"
  97.         }
  98.         putScrap "<[lindex $specs 4]://${user}[lindex $specs 0]/[lindex $specs 1]/[file tail $name]>"
  99.         message "Copied URL of '[file tail $name]' to the Clipboard."        
  100.     } else {
  101.         regexp {[^:]*:(.*)} $name dummy dir
  102.         if {[regexp {:} $dir]} {
  103.         regexp {(.*):([^:]*)} $dir dummy dir fname
  104.         } else {
  105.         set fname ""
  106.         }
  107.         regsub -all {:} $dir {/} dir
  108.         eval ftpBrowse [list [lindex $specs 0] $dir] [lrange $specs 2 4] [list $fname]
  109.     }
  110.     } else {
  111.     if {$name == [win::Current]} {
  112.         if {[key::shiftPressed]} {
  113.         file::showInFinder
  114.         } else {
  115.         putScrap $name
  116.         message "Copied full path of '[file tail $name]' to the Clipboard."
  117.         }
  118.     } else {
  119.         if {[key::shiftPressed]} {
  120.         openFolder $name
  121.         } else {
  122.         findFile $name
  123.         }
  124.     }
  125.     }
  126. }
  127.  
  128. # ◊◊◊◊ Command Double Click ◊◊◊◊ #
  129.  
  130. proc cmdDoubleClick {{from -1} {to -1} {shift 0} {option 0} {control 0}} {
  131.     global mode
  132.     
  133.     if {[expandURL] != ""} {
  134.     sendUrl [getSelect]
  135.     } else {
  136.     if {$from < 0} {
  137.         set from [getPos]
  138.         set to [selEnd]
  139.         if {[pos::compare $from == $to]} {
  140.         hiliteWord
  141.         set from [getPos]
  142.         set to [selEnd]
  143.         }
  144.     }
  145.     if {[set proc [mode::getProc DblClick]] != ""} {
  146.         if {[llength [info args $proc]] == 2} {
  147.         $proc $from $to
  148.         } else {
  149.         $proc $from $to $shift $option $control
  150.         }
  151.     } else {
  152.         message "No docs"
  153.     }
  154.     }    
  155. }
  156.  
  157. proc commandClick {from to url} {
  158.     select $from
  159.     for {set i 0} {$i < 200} {incr i} {}
  160.     select $from $to
  161.     for {set i 0} {$i < 200} {incr i} {}
  162.     select $from
  163.     for {set i 0} {$i < 200} {incr i} {}
  164.     select $from $to
  165.     icURL $url
  166. }    
  167.  
  168. # ◊◊◊◊ URL handling ◊◊◊◊ #
  169.  
  170. # (WTP 7/30/95) Slightly improved 'sendUrl'.
  171. # By accepting a text arg, this can now be used to make sendUrl 
  172. # hypertext links (useful for "mailto" links in documentation, f'rinstance) 
  173. #===============================================================================
  174.  
  175. proc sendUrl {{text {}}} {
  176.     if {$text == {}} { catch {set text [getSelect]} }
  177.     if {$text == {}} { set text [prompt {URL?} {}] }
  178.     if {[string length $text] == 0} { return }
  179.     icURL $text
  180. }
  181.  
  182. proc expandURL {} {
  183.     set pos [getPos]
  184.     set beg [lineStart $pos]
  185.     if {[string length [set whe [search -s -n -f 1 -r 1 -i 1 -m 0 -l [nextLineStart $pos] {[a-zA-Z0-9]+://[a-zA-Z/._0-9~-]+} $beg]]]} {
  186.     if {([pos::compare $pos >= [lindex $whe 0]]) \
  187.       && ([pos::compare $pos < [lindex $whe 1]])} {
  188.         eval select $whe
  189.         return $whe
  190.     }
  191.     }
  192. }
  193.  
  194.  
  195.  
  196. # ◊◊◊◊ Printing helpers ◊◊◊◊ #
  197.  
  198. proc printLeftHeader {pg {f ""}} {
  199.     global printHeader printHeaderTime printHeaderFullPath
  200.     
  201.     if {!$printHeader} return
  202.     
  203.     if {$f == ""} {set f [win::Current]}
  204.     if {$printHeaderFullPath} {
  205.     set text $f
  206.     } else {
  207.     set text [file tail $f]
  208.     }
  209.     
  210.     if {$printHeaderTime} {
  211.     append text "      [join [mtime [now] short]]"
  212.     }
  213.     return $text
  214. }
  215.  
  216. proc printRightHeader {pg {f ""}} {
  217.     global printHeader
  218.     if {!$printHeader} return
  219.     return "Page $pg"
  220. }
  221.  
  222. proc printAll {} {
  223.     foreach f [winNames -f] {
  224.     print $f
  225.     }
  226. }
  227.  
  228. # ◊◊◊◊ Spellcheck helpers ◊◊◊◊ #
  229.  
  230. #================================================================================
  231. # Excalibur is the only Mac spell-checker that I know of which will handle 
  232. # LaTeX as well as ordinary text.
  233.  
  234.  
  235. proc spellcheckWindow {} {
  236.     global resumeRevert
  237.  
  238.     set name [app::launchFore XCLB]
  239.     
  240.     if {[winDirty]} {
  241.     if {[dialog::yesno "Save '[win::CurrentTail]'?"]} {
  242.         save
  243.     }
  244.     }
  245.     sendOpenEvent noReply [file tail $name] [stripNameCount [win::Current]]
  246.     set resumeRevert 1
  247. }
  248.  
  249. proc spellcheckSelection {} {
  250.     if {[pos::compare [getPos] == [selEnd]]} {
  251.     beep
  252.     message "No selection"
  253.     return;
  254.     }
  255.     set name [app::launchBack XCLB]
  256.     copy
  257.     switchTo $name
  258. }
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.