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:
Vorgabetext löschen
Gegenderten Text in die Zwischenablage kopieren
Zwischenablage im Arbeitsfenster einfügen
Schrift vergrößern, verkleinern mit Ctrl-plus, Ctrl-minus.
Ggf. Arbeitsfenster in die Zwischenablage kopieren.
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
    Forschende Forscher
    Forschenden Forschern
    Teilnehmende Teilnehmer
    Gastarbeitende Gastarbeiter
    Gastarbeitenden Gastarbeitern
  } {
    # 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