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.
Wem das weh tut (etwa mir): Control-Klick ins Rot.
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
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