Gänsefüßchenkorrektur

In Zeiten des verschärften Schwindelns in der Politik und Opportunismus des Mainstream fällt mein Blick verschärft auf alternative Informationsquellen. Private, aber engagierte Blogs. Und dort fallen – leider – gelegentlich falsch gesetzte Gänsefüßchen auf. Trivial aber unschön. Schätzungsweise fehlerhafte Automatik der Textverarbeitung.

Statt sich rumzuärgern hier ein Script, das die Gänsefüßchen auf Vordermann bringt. So installieren Sie es:

So nutzen Sie es:

Alles ok? Klasse! Mit Copy&Paste zurück in den Artikel!


#!/usr/bin/wish

package require Tk

destroy .t .s

pack\
  [text .t -foreground navy\
    -yscrollcommand {.s set}\
    -font "Serif -16"\
    -width 30\
    -height 20\
    -wrap word\
    -undo yes]\
  -expand yes -fill both -side left

pack [scrollbar .s -command {.t yview}]\
  -side right -fill y -in .

.t tag configure yellow -background yellow
.t tag configure maroon\
 -foreground maroon -underline yes -underlinefg wheat3
.t tag configure red -underline yes -foreground red
.t tag raise sel

. configure -menu [menu .t.m]

.t.m add cascade -label File -menu [menu .t.m.f -tearoff no]
.t.m.f add command -label cut -command {event generate .t <<Cut>>}

.t.m.f add cascade -label Copy -menu [menu .t.m.f.c -tearoff no]
.t.m.f.c add command -label Normal -command {
  event generate .t <<Copy>>
}
.t.m.f.c add command -label command -label Entities -command {
  apply {
    {} {
      lassign [.t tag ranges sel] from to
      if {$from ne {}} then {
        clipboard clear
        clipboard append [txtToEntities [.t get $from $to]]
      }
    }
  }
}

.t.m.f add command -label paste -command {event generate .t <<Paste>>}
.t.m.f add separator
.t.m.f add command -label "Select all" -command {.t tag add sel 1.0 end}

.t.m add cascade -label Show -menu [menu .t.m.s]
.t.m.s add command -label Quotes -command showQuotes
.t.m.s add command -label Clear -command [list apply {
    win {
      foreach tag [$win tag names] {
        $win tag remove $tag 1.0 end
      }
    }
  } .t]

.t.m add cascade -label Language -menu [menu .t.m.l]
.t.m.l add command -label Deutsch -command {setQuotes de}
.t.m.l add command -label English -command {setQuotes en}
.t.m.l add command -label Français -command {setQuotes fr}
.t.m.l add command -label Suisse -command {setQuotes ch}

bind .t <3> {tk_popup .t.m.f %X %Y}

variable dQuotPat {[„“”»«"]([^„“”»«"]*)[„“”»«"]}
variable sQuotPat {[‚‘’›‹']([^‚‘’›‹']*)[‚‘’›‹']}

proc showQuotes {} {
  variable dQuotPat
  variable sQuotPat
  .t tag remove yellow 1.0 end
  .t tag remove maroon 1.0 end
  set l [.t search -regexp -all -count c $dQuotPat 1.0 end]
  if {$l ne ""} then {
    foreach from $l to $c {
      .t tag add yellow $from "$from + $to indices"
    }
  }
  set l [.t search -regexp -all -count c $sQuotPat 1.0 end]
  if {$l ne ""} then {
    foreach from $l to $c {
      .t tag add maroon $from "$from + $to indices"
    }
  }
}

proc setQuotes {{lang de}} {
  variable dQuotPat
  variable sQuotPat
  set index [.t index insert]
  lassign [.t yview] fraction
  set txt [.t get 1.0 end]
  switch -exact -- $lang {
    en {
      # englische Gänsefüßchen
      set txt [regsub -all $dQuotPat $txt {“\1”}]
      set txt [regsub -all $sQuotPat $txt {‘\1’}]
    }
    ch {
      # Schweizer Gänsefüßchen (einklammernd)
      set txt [regsub -all $dQuotPat $txt {«\1»}]
      set txt [regsub -all $sQuotPat $txt {‹\1›}]
    }
    fr {
      # französische Gänsefüßchen
      set txt [regsub -all $dQuotPat $txt {»\1«}]
      set txt [regsub -all $sQuotPat $txt {›\1‹}]
    }
    default {
      # deutsche Gänsefüßchen
      set txt [regsub -all $dQuotPat $txt {„\1“}]
      set txt [regsub -all $sQuotPat $txt {‚\1‘}]
    }
  }
  .t replace 1.0 end [string trim $txt]
  .t mark set insert $index
  after idle ".t yview moveto $fraction"
}

proc txtToEntities txt {
  set nonAsciiChars [regexp -inline -all {[^[:ascii:]]} $txt]
  set l [lsort -unique $nonAsciiChars]
  set map [concat {*}[lmap x $l {list $x "&#[scan $x %c];"}]]
  string map $map $txt
}

Vergnügen!

13.3.2022