Anti-Gender

Ein Textfenster, das gegenderte Sprache auf normal umschaltet. Das normalisierte Wort erscheint in Grün.

Ein Control-Klick ins Grüne macht den ursprünglich gegenderten Begriff rot unterstrichen sichtbar.

gegenderter Text

Wem das weh tut (etwa mir): Control-Klick ins Rot.

ungegenderter Text

Deutschlandfahne, wehend

Ein Hilfsmittel zur Wahrung der geistigen Gesundheit – bis der Gender-Wahn (hoffentlich bald) ein Klopapier der Geschichte ist.

Gebrauchsanweisung:

Vergnügen bzw. contenance, mon cher.


#!/usr/bin/tclsh
package require Tcl 8.6.1

proc findGenderSternSingular txt {
  regexp -inline -all\
    {\m[[:alpha:]]+[*:_/]in\M}\
    $txt
}
proc findGenderStern txt {
  regexp -inline -all\
    {\m[[:alpha:]]+[*:_/]innen[[:alpha:]]*\M}\
    $txt
}
proc findKreativStern txt {
  set result {}
  foreach hit [regexp -inline -all\
    {\m[[:alpha:]]+[*:_][[:alpha:]*_]*?\M}\
    $txt] {
    if {![string match *innen* $hit]} then {
      lappend result $hit
    }
  }
  set result
}
proc findGenderBinnenMajuskel txt {
  regexp -inline -all\
    {\m[[:upper:]][[:lower:]]+I[[:lower:]]+\M}\
    $txt
}

proc findGenderWeiblichFolgt txt {
  regexp -inline -all\
    {\m([[:alpha:]]+)\s+(?:und|oder|&|\+)\s+-?\1innen\M}\
    $txt
}
proc findGenderWeiblichFuehrt txt {
  regexp -inline -all\
    {\m([[:alpha:]]+)innen\s+(?:und|oder|&|\+)\s+-?\1\M}\
    $txt
}

proc findGenderWeiblichFolgtMitE txt {
  set result {}
  foreach {a b} [regexp -inline -all\
    {\m([[:alpha:]]+)e\s+(?:und|oder|&|\+)\s+-?\1innen\M}\
    $txt] {
    lappend result $a [append b e]
  }
  set result
}
proc findGenderWeiblichFuehrtMitE txt {
  set result {}
  foreach {a b} [regexp -inline -all\
    {\m([[:alpha:]]+)innen\s+(?:und|oder|&|\+)\s+-?\1e\M}\
    $txt] {
    lappend result $a [append b e]
  }
  set result
}

proc findGenderWeiblichFolgtMitN txt {
  set result {}
  foreach {a b} [regexp -inline -all\
    {\m([[:alpha:]]+)n\s+(?:und|oder|&|\+)\s+-?\1innen\M}\
    $txt] {
    lappend result $a [append b n]
  }
  set result
}
proc findGenderWeiblichFuehrtMitN txt {
  set result {}
  foreach {a b} [regexp -inline -all\
    {\m([[:alpha:]]+)innen\s+(?:und|oder|&|\+)\s+-?\1n\M}\
    $txt] {
    lappend result $a [append b n]
  }
  set result
}

proc findGenderWeiblichFolgtMitEn txt {
  set result {}
  foreach {a b} [regexp -inline -all\
    {\m([[:alpha:]]+)en\s+(?:und|oder|&|\+)\s+-?\1innen\M}\
    $txt] {
    lappend result $a [append b en]
  }
  set result
}
proc findGenderWeiblichFuehrtMitEn txt {
  set result {}
  foreach {a b} [regexp -inline -all\
    {\m([[:alpha:]]+)innen\s+(?:und|oder|&|\+)\s+-?\1en\M}\
    $txt] {
    lappend result $a [append b en]
  }
  set result
}

proc findGenderWeiblichFolgtMitS txt {
  set result {}
  foreach {a b} [regexp -inline -all\
    {\m([[:alpha:]]+)s\s+(?:und|oder|&|\+)\s+-?\1innen\M}\
    $txt] {
    lappend result $a [append b s]
  }
  set result
}
proc findGenderWeiblichFuehrtMitS txt {
  set result {}
  foreach {a b} [regexp -inline -all\
    {\m([[:alpha:]]+)innen\s+(?:und|oder|&|\+)\s+-?\1s\M}\
    $txt] {
    lappend result $a [append b s]
  }
  set result
}

proc GenderStringIsShorter {a b} {
  expr {[string length [lindex $a 0]] < [string length [lindex $b 0]]}
}

proc setMapList txt {
  lappend map\
    {*}[lmap {a b} [findGenderWeiblichFolgt $txt] {list $a $b}]\
    {*}[lmap {a b} [findGenderWeiblichFuehrt $txt] {list $a $b}]\
    {*}[lmap {a b} [findGenderWeiblichFolgtMitE $txt] {list $a $b}]\
    {*}[lmap {a b} [findGenderWeiblichFuehrtMitE $txt] {list $a $b}]\
    {*}[lmap {a b} [findGenderWeiblichFolgtMitN $txt] {list $a $b}]\
    {*}[lmap {a b} [findGenderWeiblichFuehrtMitN $txt] {list $a $b}]\
    {*}[lmap {a b} [findGenderWeiblichFolgtMitEn $txt] {list $a $b}]\
    {*}[lmap {a b} [findGenderWeiblichFuehrtMitEn $txt] {list $a $b}]\
    {*}[lmap {a b} [findGenderWeiblichFuehrtMitS $txt] {list $a $b}]\
    {*}[lmap x [findKreativStern $txt] {
      list $x [string totitle [regsub -all {[*_]} $x ""]]
    }]\
    {*}[lmap x [findGenderSternSingular $txt] {
      list $x [string range $x 0 end-3]
    }]\
    {*}[lmap x [findGenderStern $txt] {
      set n [regsub {[*:_/].*$} $x ""]
      if {![string match *er $n]} then {
        append n en
      }
      if {[regexp {[*:_/]innen(.*)$} $x - appendix]} then {
        append n $appendix
      }
      list $x $n
    }]\
    {*}[lmap x [findGenderBinnenMajuskel $txt] {
      set n [regsub {[[:upper:]][[:lower:]]+$} $x ""]
      if {![string match *:er $n]} then {
        append n en
      }
      list $x $n
    }]\
    [list "der oder die" der]
  # behördlich verordnet
  foreach {genderForm normalForm} {
    Studierende Studenten
    Studierenden Studenten
    "zu Fuß gehende" Fußgänger
    Besuchende Besucher
    Besuchenden Besuchern
    Demonstrierende Demonstranten
    Demonstrierenden Demonstranten
    Arbeitende Arbeiter
    Arbeitenden Arbeitern
    Geflüchtete Flüchtlinge
    Geflüchteten Flüchtlingen
    Geflüchteten- Flüchtlings-
    "geflüchtete Person" Flüchtling
    "eine geflüchtete Person" "ein Flüchtling"
    "geflüchtete Personen" Flüchtlinge
    Helfende Helfer
    Wählenden Wähler
    Wählende Wähler
    Briefwählende Briefwähler
    Kandidierende Kandidaten
    Lernende Schüler
    Mitarbeitende Mitarbeiter
    Mitarbeitenden Mitarbeitern
    Teilnehmende Teilnehmer
  } {
    # falsch erkannt: "... arbeitende ..."
    if {[regexp \\m$genderForm $txt]} then {
      lappend map [list $genderForm $normalForm]
    }
# if {[regexp [string tolower $genderForm] $txt]} then {
# lappend map [string tolower [list $genderForm $normalForm]]
# }
  }
  set map [lsort -index 0 -unique $map]
  set map [lsort -command GenderStringIsShorter $map]
  concat {*}[lmap {key val} [concat {*}$map] {
      if {[string match *erInnen $key] && [string match *eren $val]} then {
        list $key [string range $val 0 end-2]
      } else {
        list $key $val
      }
    }]
}

proc escapeText {word {back ""}} {
  set map [list \\ \\\\ \u007b \\\u007b \u007d \\\u007d]
  if {$back eq ""} then {
    string map $map $word
  } else {
    string map [lreverse $map] $word
  }
}

proc txtToList txt {
  set txt [string map [list \uad ""] $txt]
  set txt [regsub -all {[ \t]{2,}} $txt " "]
  set txt "{[escapeText $txt]} {} {}"
  set map [setMapList $txt]
  if {[llength $map] > 0} then {
    foreach {a b} $map {
      set repl \}
      append repl " {$a} {$b} "
      append repl \{
      lappend map1 $a $repl
    }
    lmap x [string map $map1 $txt] {
      escapeText $x back
    }
  } else {
    set txt
  }
}

#
# text window
#

package require Tk
bind [winfo class .] <Destroy> exit

wm title . {Nie wieder Gender-Texte!}
wm geometry . 500x350

proc -- args #

text .t\
  -font {Times 14}\
  -wrap word\
  -spacing1 5\
  -spacing2 5\
  -yscrollcommand {.s set}\
  -highlightthickness 0\
  -padx 10\
  -cursor ""
scrollbar .s -orient vertical -command {.t yview}

place .t -anchor nw -relheight 1.0 -relwidth 1.0 -width -[winfo reqwidth .s]
place .s -anchor ne -relheight 1 -relx 1.0

catch {
  tcl::tm::path add ~/bin/TM
  package require DoubleClick
  bindDoubleClick .t
}

bind . <FocusIn> {focus .t}

bind .t <Control-plus> [list apply {
  text {
    set font [$text cget -font]
    lassign $font family size
    if {$size < 24} then {
      $text configure -font [list $family [incr size 2]]
      $text tag configure normal -font [list $family $size bold]
    }
  }
} %W]
bind .t <Control-minus> [list apply {
  text {
    set font [$text cget -font]
    lassign $font family size
    if {$size > 8} then {
      $text configure -font [list $family [incr size -2]]
      $text tag configure normal -font [list $family $size bold]
    }
  }
} %W]
bind .t <Control-0> {.t configure -font {Times 14}}

bind .t <Key> {
  if {[string is print -strict %A] &&
      ("normal" in [%W tag names insert-1chars] ||
       "normal" in [%W tag names insert])} then {
    %W insert insert %A normal
    break
  }
}

bind .t <Control-Button-1> break

.t tag configure gender -foreground red -underline yes
.t tag configure normal -foreground green\
  -font [concat [.t cget -font] bold]
.t tag configure hidden -elide yes

menu .t.contextmenu -tearoff no
.t.contextmenu add command -label Copy -command {event generate .t <<Copy>>}
.t.contextmenu add command -label Paste -command {event generate .t <<Paste>>}
.t.contextmenu add separator
.t.contextmenu add command -label "Select all" -command {
  .t tag add sel 1.0 end-1chars
}

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

proc genderTextToWin {txt win} {
  foreach {norm gender repl} [txtToList [string trim $txt]] {
    $win insert insert\
      $norm {}\
      $gender {gender hidden}\
      $repl normal
  }
}

proc showGender {text index} {
  set hiddenRange [$text tag prevrange hidden $index+1chars]
  set normalRange [$text tag prevrange normal $index+1chars]
  set genderRange [$text tag prevrange gender $index+1chars]
  $text tag remove hidden {*}$hiddenRange
  $text tag add hidden {*}$normalRange
  $text tag remove sel 1.0 end
}

proc hideGender {text index} {
  set hiddenRange [$text tag nextrange hidden $index-1chars]
  set normalRange [$text tag nextrange normal $index-1chars]
  set genderRange [$text tag prevrange gender $index+1chars]
  $text tag remove hidden {*}$hiddenRange
  $text tag add hidden {*}$genderRange
  $text tag remove sel 1.0 end
}

.t tag bind normal <Control-1> {
  showGender %W @%x,%y
  update
  %W mark set insert @%x,%y
}
.t tag bind gender <Control-1> {
  hideGender %W @%x,%y
  update
  %W mark set insert @%x,%y
}

bind .t <<Copy>> {
  clipboard clear
  clipboard append [%W get -displaychars {*}[%W tag ranges sel]]
  break
}

bind .t <<Paste>> {
  apply {
    win {
      if {[$win tag ranges sel] ne ""} then {
        $win mark set insert sel.first
        $win delete sel.first sel.last
      }
      set index [$win index insert]
      tk_textPaste $win
      set txt [regsub -all {\n+} [$win get $index insert] \n\n]
      $win delete $index insert
      genderTextToWin $txt $win
      indentWindow $win
    }
  } %W
  break
}

proc indentWindow {{win .t}} {
  $win tag configure indent -lmargin1 30 -lmargin2 30
  $win tag remove indent 1.0 end
  lassign [split [$win index end-1c] .] numOfLines
  for {set i 1} {$i < $numOfLines} {incr i} {
    if {[$win get $i.0] eq " "} then {
      $win tag add indent $i.0 "$i.0 lineend"
      $win delete $i.0
    }
  }
}


after 100 "event generate .t <<Paste>>"


9.10.2022