home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / Modes / HTML and CSS Modes / htmlCharTrans.tcl < prev    next >
Encoding:
Text File  |  2001-01-12  |  7.0 KB  |  247 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlCharTrans.tcl"
  6.  #                                    created: 99-07-20 17.51.05 
  7.  #                                last update: 00-12-27 23.32.33 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <alpha_www_tools@go.to>
  10.  #     www: <http://go.to/alpha_www_tools>
  11.  #  
  12.  # Version: 3.0
  13.  # 
  14.  # Copyright 1996-2001 by Johan Linde
  15.  #  
  16.  # This program is free software; you can redistribute it and/or modify
  17.  # it under the terms of the GNU General Public License as published by
  18.  # the Free Software Foundation; either version 2 of the License, or
  19.  # (at your option) any later version.
  20.  # 
  21.  # This program is distributed in the hope that it will be useful,
  22.  # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23.  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24.  # GNU General Public License for more details.
  25.  # 
  26.  # You should have received a copy of the GNU General Public License
  27.  # along with this program; if not, write to the Free Software
  28.  # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  29.  # 
  30.  # ###################################################################
  31.  ##
  32.  
  33. #===============================================================================
  34. # This file contains the procs for the Character Translation submenu.
  35. #===============================================================================
  36.  
  37. #
  38. # Converting  characters to HTML entities.
  39. #
  40. # 1 = < > &
  41. # 0 = áé etc.
  42. proc html::Characterstohtml {ltgtamp} {
  43.     global html::SpecialCharacter
  44.     
  45.     if {$ltgtamp} {
  46.         set charlist {& < >}
  47.     } else {
  48.         set charlist [array names html::SpecialCharacter]
  49.     }
  50.     
  51.     set subs1 0;  set lett 0
  52.     set upos1 [getPos]
  53.     if {[set start $upos1] == [set end [selEnd]]} {
  54.         if {$ltgtamp && \
  55.         [askyesno "There is no selection. Really translate < > & in whole document?"] == "no"} {return}
  56.         set messageString "document"
  57.         set start [minPos]
  58.         set end [maxPos]
  59.         set isDoc 1
  60.     } else {
  61.         set messageString "selection"
  62.         set isDoc 0
  63.     }
  64.     message "Translating…"
  65.     set tmp [getText $start $end]
  66.     set text ""
  67.     set pos [set upos [pos::diff $upos1 [minPos]]]
  68.     set st [set st0 [pos::diff $start [minPos]]]
  69.     if {!$ltgtamp} {
  70.         while {[regexp -indices "<!--" $tmp str] && [regexp -indices -- "-->" $tmp str1]} {
  71.             if {[lindex $str1 0] > [lindex $str 1]} {
  72.                 set sv [string range $tmp [lindex $str 0] [lindex $str1 1]]
  73.                 if {[expr {$st + [lindex $str1 1]}] < $upos} {
  74.                     incr pos [expr {6 - [string length $sv]}]
  75.                 } elseif {[expr {$st + [lindex $str 0]}] < $upos} {
  76.                     incr pos [expr {$st + [lindex $str 0] - $upos}]
  77.                 }
  78.                 lappend savestr $sv
  79.                 append text [string range $tmp 0 [expr {[lindex $str 0] - 1}]] ""
  80.             } else {
  81.                 append text [string range $tmp 0 [lindex $str1 1]]
  82.             }
  83.             set tmp [string range $tmp [expr {[lindex $str1 1] + 1}] end]
  84.             incr st [expr {[lindex $str1 1] + 1}]
  85.         }
  86.         append text $tmp
  87.     } else {
  88.         set text $tmp
  89.     }
  90.     if {$isDoc} {    
  91.         set text1 [string range $text 0 [expr {$pos - $st0 - 1}]]
  92.         set text2 [string range $text [expr {$pos - $st0}] end]
  93.     } else {
  94.         set text1 $text
  95.     }
  96.     foreach char $charlist {
  97.         if {[info exists html::SpecialCharacter($char)]} {
  98.             set rtext "\\&[set html::SpecialCharacter($char)];"
  99.         } elseif {$char == ">"} {
  100.             set rtext "\\>" 
  101.         } elseif {$char == "<"} {
  102.             set rtext "\\<"
  103.         } elseif {$char == "&"} {
  104.             set rtext "\\&"
  105.         }
  106.         
  107.         set subNum [regsub -all $char $text1 [set rtext] text1]
  108.         incr subs1 [expr {$subNum * ([string length $rtext] - 2)}]
  109.         incr lett $subNum
  110.         if {$isDoc} {
  111.             incr lett [regsub -all $char $text2 [set rtext] text2]
  112.         }
  113.         
  114.     }
  115.     set text $text1
  116.     if {$isDoc} {append text $text2}
  117.     if {$lett} {
  118.         if {[info exists savestr]} {
  119.             set i 0
  120.             set tmp ""
  121.             while {[regexp -indices -nocase {} $text str]} {
  122.                 append tmp [string range $text 0 [expr {[lindex $str 0] - 1}]]
  123.                 append tmp [lindex $savestr $i]
  124.                 set text [string range $text [expr {[lindex $str 1] + 1}] end]
  125.                 incr i
  126.             }
  127.             set text "$tmp$text"
  128.         }
  129.         replaceText $start $end $text
  130.         if {$isDoc} {
  131.             goto [pos::math $upos1 + $subs1]
  132.         } else {
  133.             select $start [getPos]
  134.         }
  135.     }
  136.     message "$lett characters translated in $messageString."
  137. }
  138.  
  139.  
  140.  
  141. #
  142. # Converting HTML entities to characters.
  143. #
  144. # 1 = < > &
  145. # 0 = áé etc.
  146. proc html::htmltoCharacters {ltgtamp} {
  147.     global html::CharacterSpecial
  148.     
  149.     message "Translating…"
  150.     
  151.     if {$ltgtamp} {
  152.         set entitylist {"&" "<" ">"} 
  153.     } else {
  154.         foreach a [array names html::CharacterSpecial] {
  155.             lappend entitylist "&$a;"
  156.         }
  157.     }
  158.     set subs1 0;  set lett 0
  159.     set upos1 [getPos]
  160.     if {[set start $upos1] == [set end [selEnd]]} {
  161.         # Move position to linestart to make sure no letter is split.
  162.         set upos1 [lineStart $upos1]
  163.         set messageString "document"
  164.         set start [minPos]
  165.         set end [maxPos]
  166.         set isDoc 1
  167.     } else {
  168.         set messageString "selection"
  169.         set isDoc 0
  170.     }
  171.  
  172.     set tmp [getText $start $end]
  173.     set text ""
  174.     set pos [set upos [pos::diff $upos1 [minPos]]]
  175.     set st [set st0 [pos::diff $start [minPos]]]
  176.     if {!$ltgtamp} {
  177.         while {[regexp -indices "<!--" $tmp str] && [regexp -indices -- "-->" $tmp str1]} {
  178.             if {[lindex $str1 0] > [lindex $str 1]} {
  179.                 set sv [string range $tmp [lindex $str 0] [lindex $str1 1]]
  180.                 if {[expr {$st + [lindex $str1 1]}] < $upos} {
  181.                     incr pos [expr {6 - [string length $sv]}]
  182.                 } elseif {[expr {$st + [lindex $str 0]}] < $upos} {
  183.                     incr pos [expr {$st + [lindex $str 0] - $upos}]
  184.                 }
  185.                 lappend savestr $sv
  186.                 append text [string range $tmp 0 [expr {[lindex $str 0] - 1}]] ""
  187.             } else {
  188.                 append text [string range $tmp 0 [lindex $str1 1]]
  189.             }
  190.             set tmp [string range $tmp [expr {[lindex $str1 1] + 1}] end]
  191.             incr st [expr {[lindex $str1 1] + 1}]
  192.         }
  193.         append text $tmp
  194.     } else {
  195.         set text $tmp
  196.     }
  197.     if {$isDoc} {
  198.         set text1 [string range $text 0 [expr {$pos - $st0 - 1}]]
  199.         set text2 [string range $text [expr {$pos - $st0}] end]
  200.     } else {
  201.         set text1 $text
  202.     }        
  203.     foreach char $entitylist {
  204.         set schar [string range $char 1 [expr {[string length $char] - 2}]]
  205.         if {[info exists html::CharacterSpecial($schar)]} {
  206.             set rtext [set html::CharacterSpecial($schar)]
  207.         } elseif {$schar == "amp"} {
  208.             set rtext "\\&"
  209.         } elseif {$schar == "lt"} {
  210.             set rtext "<"
  211.         } elseif {$schar == "gt"} {
  212.             set rtext ">"
  213.         }
  214.         
  215.         set subNum [regsub -all $char $text1 $rtext text1]
  216.         incr subs1 [expr {$subNum * ([string length $char] - 1)}]
  217.         incr lett $subNum
  218.         if {$isDoc} {
  219.             incr lett [regsub -all $char $text2 $rtext text2]
  220.         }
  221.         
  222.     }
  223.     set text $text1
  224.     if {$isDoc} {append text $text2}
  225.     if {$lett} {
  226.         if {[info exists savestr]} {
  227.             set i 0
  228.             set tmp ""
  229.             while {[regexp -indices -nocase {} $text str]} {
  230.                 append tmp [string range $text 0 [expr {[lindex $str 0] - 1}]]
  231.                 append tmp [lindex $savestr $i]
  232.                 set text [string range $text [expr {[lindex $str 1] + 1}] end]
  233.                 incr i
  234.             }
  235.             set text "$tmp$text"
  236.         }
  237.         replaceText $start $end $text
  238.         if {$isDoc} {
  239.             goto [pos::math $upos1 - $subs1]
  240.         } else {
  241.             select $start [getPos]
  242.         }
  243.     }
  244.     message "$lett characters translated in $messageString."
  245. }
  246.  
  247.