Feed-Reader

Ein minimalistischer Feed-Reader, erster Funktionstest des Pakets XML. Erforderlich ist außerdem das Tool wget, das Internet-Quellen einliest. Bei Linux ist es im Lieferumfang, bei Windows müsste es besorgt werden.

Feeds sind auszuwählen mit Kontext-Menü. Durch Anklicken wird ein Browserfenster geöffnet.

Vegnügen!


#!/usr/bin/tclsh

# 
# file: rssreader.tcl
# 
# Minimalistic RSS reader
# Prerequisites: package XML by wdb
# external tools:
# wget
# Any web browser
# 
# Costomize feeds:
# see procedure setMenu below
# 
# caveats: tested on Linux
# should work on Windows as well if wget is present
# 

package require Tk

if {[info commands send] ne ""} then {
  if {[tk appname feedreader] ne "feedreader"} then {
    send feedreader {
      wm withdraw .
      wm deiconify .
    }
    exit
  }
}

::tcl::tm::path add ~/bin/TM

package require XML

namespace import ::tcl::mathop::*

# variable browserCommand opera
# variable browserCommand "chromium-browser -new-window"
variable browserCommand "firefox -new-window"

variable prefs {
  geometry {}
  links {}
  title {}
  font {Times 14}
  visited {}
}

variable visited {}

proc markVisited href {
  variable prefs
  dict set prefs visited $href [clock seconds]
}

proc linkColor href {
  variable prefs
  expr {
    $href in [dict keys [dict get $prefs visited]] ? "maroon" : ""
  }
}

if {[info script] eq ""} then {
  variable initFile ~/.rssreader.tcl
} else {
  variable initFile\
    [file normalize [file join ~ .[file tail [info script]]]]
}

proc cat file {
  set chan [open $file r]
  set result [read $chan]
  close $chan
  set result
}

proc wget url {
  exec wget -U google-chrome -q -O - $url
}

proc rssLinks tree {
  set paths [xml findElementsByName $tree item]
  foreach path $paths {
    set item [xml getElement $tree {*}$path]
    lassign [xml findElementsByName $item link] linkPath
    lassign [xml findElementsByName $item title] titlePath
    lappend result\
      [string trim [xml getText $item {*}$titlePath]]\
      [string map {{ } %20} [xml getText $item {*}$linkPath]]
  }
  lappend result
}

proc atomLinks tree {
  set paths [xml findElementsByName $tree entry]
  foreach path $paths {
    set entry [xml getElement $tree {*}$path]
    lassign [xml findElementsByName $entry title] titlePath
    lappend result\
      [string trim [xml getText $entry {*}$titlePath]]
    set paths [xml findElementsByName $entry link]
    foreach path $paths {
      set linkElement [xml getElement $entry {*}$path]
      if {[dict exists $linkElement attribute rel] &&
          [dict get $linkElement attribute rel] eq "alternate"} break
    }
    lappend result [string map {{ } %20} [dict get $linkElement attribute href]]   
  }
  lappend result
}

proc rdfLinks tree {
  foreach path [xml findElementsByName $tree item] {
    set item [xml getElement $tree {*}$path]
    lassign [xml findElementsByName $item title] titlePath
    lassign [xml findElementsByName $item link] linkPath
    lappend result\
      [xml getText $item {*}$titlePath]\
      [string map {{ } %20} [xml getText $item {*}$linkPath]]
  }
  lappend result
}

proc readLinks url {
  set tree [xml parse [wget $url]]
  switch -exact -- [dict get $tree name] {
    rss {
      rssLinks $tree
    }
    feed {
      atomLinks $tree
    }
    rdf - rdf:RDF {
      rdfLinks $tree
    }
    default {
      return -code error "[info level 0] -- unkown [dict get $tree name]"
    }
  }
}

# window

bind [winfo class .] <Destroy> exit

proc hideScrollBars {} {
  lassign [.v get] a b
  if {$b - $a == 1} then {
    place .t -width 0
    place .h -width 0
  } else {
    place .t -width -[winfo reqwidth .v]
    place .h -width -[winfo reqwidth .v]
  }
  lassign [.h get] c d
  if {$d - $c == 1} then {
    place .t -height 0
    place .v -height 0
  } else {
    place .t -height -[winfo reqheight .h]
    place .v -height -[winfo reqheight .h]
  }
}

proc vScrollbarSet {a b} {
  .v set $a $b
  after cancel hideScrollBars
  after idle hideScrollBars
}

proc hScrollbarSet {a b} {
  .h set $a $b
  after cancel hideScrollBars
  after idle hideScrollBars
}

destroy .h .v .t
text .t\
  -font [dict get $prefs font]\
  -cursor ""\
  -wrap none\
  -highlightthickness 0\
  -foreground navy\
  -background LightYellow1\
  -yscrollcommand vScrollbarSet\
  -xscrollcommand hScrollbarSet
scrollbar .v\
  -orient vertical\
  -command {.t yview}
scrollbar .h\
  -orient horizontal\
  -command {.t xview}

frame .t.destroy
bind .t.destroy <Destroy> [list apply {
  {} {
    variable prefs
    variable initFile
    dict set prefs geometry [wm geometry .]
    dict set prefs font [.t cget -font]
    set chan [open $initFile w]
    puts $chan $prefs
    close $chan
  }
}]

place .t\
  -anchor nw\
  -relheight 1.0\
  -height -[winfo reqheight .h]\
  -relwidth 1.0\
  -width -[winfo reqwidth .v]
place .v\
  -relx 1.0\
  -anchor ne\
  -relheight 1.0\
  -height -[winfo reqheight .h]
place .h\
  -rely 1.0\
  -anchor sw\
  -relwidth 1.0\
  -width -[winfo reqwidth .v]

raise .t

bind . <FocusIn> {focus .t}
bind .t <Control-plus> {
  apply {
    win {
      set font [$win cget -font]
      lassign $font family size
      if {$size < 18} then {
        $win configure -font [list $family [incr size]]
      }
    }
  } %W
}
bind .t <Control-minus> {
  apply {
    win {
      set font [$win cget -font]
      lassign $font family size
      if {$size > 8} then {
        $win configure -font [list $family [incr size -1]]
      }
    }
  } %W
}
bind .t <Control-0> {
  %W configure -font "Times 14"
}

wm title . RSS-Reader
wm geometry . 400x300
.t replace 1.0 end " RSS-Feed mit Kontextmenü auswählen!

 Choose RSS feed with context menu!"
.t configure -state disabled

proc decode str {
  lappend map \ufffd {} {*}{
    &lt; < &gt; >  &amp; &
    "&nbsp; " " "
    &nbsp; " "
    &apos; ʼ
    &auml; ä &ouml; ö &uuml; ü
    &szlig; ß
    "\n" " "
    &Auml; Ä &Ouml; Ö &Uuml; Ü
  }
  set decEnt [regexp -inline -all {&#[0-9]+;} $str]
  foreach ent [lsort -unique $decEnt] {
    regexp {[[:digit:]]+} $ent dec
    lappend map $ent [format %c $dec]
  }
  string map $map $str
}

proc setLinks url {
  variable browserCommand
  variable prefs
  if {$url ne ""} then {
    dict set prefs links [readLinks $url]
    dict set prefs geometry [wm geometry .]
    dict set prefs font [.t cget -font]
  }
  .t delete 1.0 end
  foreach {text href} [dict get $prefs links] {
    .t insert insert " [string trim [decode $text]] " href[incr i] \n {}
    .t tag configure href$i\
      -borderwidth 2 -background [.t cget -background] -foreground [linkColor $href]
    .t tag bind href$i <Enter> "
      .t tag configure href$i -foreground red
      .t configure -cursor hand1
    "
    .t tag bind href$i <Leave>\
      [subst -nocommand {
      .t tag configure href$i -background {} -relief flat -foreground [linkColor $href]
      .t configure -cursor ""
    }]
    .t tag bind href$i <1> "
      .t tag configure href$i\
        -relief sunken -background LightYellow2 -foreground {}
      update
    "
    .t tag bind href$i <1><ButtonRelease> "
      after 1500 [list .t configure -cursor [.t cget -cursor]]
      exec {*}$browserCommand [string map {&amp; & % %%} $href] &
      .t tag configure href$i\
        -relief flat -background [.t cget -background] -foreground red
      .t tag remove sel 1.0 end
      .t configure -cursor watch
      markVisited $href      
    "
  }
  .t delete end-1chars
  .t configure -state disabled
}

proc setRSS {name url} {  
  variable prefs
  dict set prefs title "Feed: [join $name { ⇨ }]"
  wm title . [dict get $prefs title]
  .t configure -state normal
  .t replace 1.0 end " $url"
  tk busy .t
  update
  tk busy forget .t
  setLinks $url
}

menu .m

bind .t <3><ButtonRelease> {after idle "tk_popup .m %X %Y" 0}

# bind Menu <Map> {wm title %W Feed}

bind Menu <Map> [list apply {
  win {
    if {[string match tearoff* [wm title $win]]} then {
      after idle [list wm title $win Feed]
    } 
  }
} %W]

proc checkVisited {} {
  variable prefs
  set now [clock seconds]
  dict for {href date} [dict get $prefs visited] {
    if {$now - $date > (3600 * 24 * 7)} then {
      dict unset prefs visited $href
    }
  }
  after cancel [info level 0]
  after 600000 [info level 0]
}

proc setMenu {l {menu .m} {leading {}}} {
  destroy $menu
  menu $menu
  foreach {action label what} $l {
    switch -exact -- $action {
      command {
        $menu add command\
          -label $label\
          -command [list setRSS [concat $leading [list $label]] $what]
      }
      menu {        
        $menu add cascade\
          -label $label\
          -menu [setMenu $what $menu.[incr i] [concat $leading [list $label]]]
      }
      default {
        $menu add separator
      }
    }
  }
  set menu
}

setMenu {
  menu Polit {
    command Burks https://www.burks.de/burksblog/feed
    command Rubikon https://www.rubikon.news/artikel.atom
    command Kenfm https://kenfm.de/feed/
    - - -
    command ScienceFiles https://sciencefiles.org/feed/
    command Deutschland-Kurier https://www.deutschland-kurier.org/feed/
    command "Achse der Guten" https://www.achgut.com/rss2
    command German-foreign-policy https://www.german-foreign-policy.com/feed.rss
    command "Alles Schall und Rauch"\
      http://alles-schallundrauch.blogspot.com/feeds/posts/default
    command PI http://www.pi-news.net/feed/
    command "Jürgen Fritz" https://juergenfritz.com/feed/
    command Publico https://www.publicomag.com/feed/
    command Danisch http://www.danisch.de/blog/feed/
    - - -
    command "Norbert Häring"\
      http://norberthaering.de/de/?format=feed&type=rss
    command Fassadenkratzer https://fassadenkratzer.wordpress.com/feed/
    command Voltaire\
      http://www.voltairenet.org/spip.php?page=backend&id_secteur=1110&lang=de
    menu "Philosophia Perennis" {
      command "Alle Themen" https://philosophia-perennis.com/?feed=rss2
      command "APO 2018" https://philosophia-perennis.com/category/apo-2018/?feed=rss2
      command Islamisierung\
        https://philosophia-perennis.com/category/islamisierung/?feed=rss2
      command Gender\
        https://philosophia-perennis.com/category/genderwahnsinn/?feed=rss2
    }
    command Anti-Spiegel https://www.anti-spiegel.ru/feed/
    command Tichy https://www.tichyseinblick.de/feed
  }
  menu Law {
    command Lawblog http://www.lawblog.de/index.php/feed/
    command Richtersicht http://www.richtersicht.de/feed/
    command Kompa https://kanzleikompa.de/feed/
    command WBS https://www.wbs-law.de/feed/
    command Verfassungsblog https://verfassungsblog.de/feed/
    command LTO https://www.lto.de/nachrichten-rss/rss/feed.xml
    command "De Legibus" https://blog.delegibus.com/feed/
    command "Wilfried Schmitz" https://www.rechtsanwalt-wilfried-schmitz.de/feed/
  }
  menu Zeitung {
    menu NOZ {
      command Samtgemeinde https://www.noz.de/rss/ressort/Samtgemeinde Artland
      command Bramsche https://www.noz.de/rss/ressort/Bramsche
      command Bersenbrück https://www.noz.de/rss/ressort/Samtgemeinde Bersenbrück
      command Osnabrück https://www.noz.de/rss/ressort/Osnabrück
      command Niedersachsen https://www.noz.de/rss/ressort/Niedersachsen
      command Politik https://www.noz.de/rss/ressort/Politik
      command Sport https://www.noz.de/rss/ressort/Sport
      command Wirtschaft https://www.noz.de/rss/ressort/Wirtschaft
      command Kultur https://www.noz.de/rss/ressort/Kultur
      command Medien https://www.noz.de/rss/ressort/Medien
      command Vermischtes https://www.noz.de/rss/ressort/Vermischtes
    }
    menu NZZ {
      command "Neuste Artikel" http://www.nzz.ch/recent.rss
      command "Topthemen der Startseite" http://www.nzz.ch/startseite.rss
      command International http://www.nzz.ch/international.rss
      command Schweiz http://www.nzz.ch/schweiz.rss
      command Wirtschaft http://www.nzz.ch/wirtschaft.rss
      command Finanznachrichten http://www.nzz.ch/finanzen.rss
      command Kultur http://www.nzz.ch/feuilleton.rss
      command Sport http://www.nzz.ch/sport.rss
      command Zürich http://www.nzz.ch/zuerich.rss
      command Panorama http://www.nzz.ch/panorama.rss
      command Wissenschaft http://www.nzz.ch/wissenschaft.rss
      command Auto http://www.nzz.ch/mobilitaet/auto-mobil.rss
      command Digital http://www.nzz.ch/mehr/digital.rss
      command Lebensart http://www.nzz.ch/lebensart.rss
    }
    menu taz {
      command "Alle Artikel" https://taz.de/!s=&ExportStatus=Intern&SuchRahmen=Online;rss/
      command Politik https://taz.de/!p4615;rss/
      command Deutschland https://taz.de/!p4616;rss/
      command Öko https://taz.de/!p4610;rss/
      command Gesellschaft https://taz.de/!p4611;rss/
      command Kultur https://taz.de/!p4639;rss/
      command Berlin https://taz.de/!p4649;rss/
      command Nord https://taz.de/!p4650;rss/
      command Wahrheit https://taz.de/!p4644;rss/
      command Sport https://taz.de/!p4646;rss/
    }
    menu Spiegel {
      command Schlagzeilen https://www.spiegel.de/schlagzeilen/index.rss
      command Kultur https://www.spiegel.de/kultur/index.rss
      command Gesellschaft https://www.spiegel.de/kultur/gesellschaft/index.rss
      command "Slavoj Zizek" https://www.spiegel.de/thema/slavoj_zizek/dossier.rss
    }
    menu Welt {
      command Neu https://www.welt.de/feeds/latest.rss
      command Nachrichten https://www.welt.de/feeds/topnews.rss
      command Mediathek https://www.welt.de/feeds/section/mediathek.rss
      command Videos https://www.welt.de/feeds/section/videos.rss
      command Politik https://www.welt.de/feeds/section/politik.rss
      command Wirtschaft https://www.welt.de/feeds/section/wirtschaft.rss
      command Bilanz https://www.welt.de/feeds/section/wirtschaft/bilanz.rss
      command Geld https://www.welt.de/feeds/section/finanzen.rss
      command Digital https://www.welt.de/feeds/section/wirtschaft/webwelt.rss
      command Wissen https://www.welt.de/feeds/section/wissenschaft.rss
      command Kultur https://www.welt.de/feeds/section/kultur.rss
      command Sport https://www.welt.de/feeds/section/sport.rss
      command Icon https://www.welt.de/feeds/section/icon.rss
      command Gesundheit https://www.welt.de/feeds/section/gesundheit.rss
      command Panorama https://www.welt.de/feeds/section/vermischtes.rss
      command Motor https://www.welt.de/feeds/section/motor.rss
      command Reise https://www.welt.de/feeds/section/reise.rss
      command Regional https://www.welt.de/feeds/section/regionales.rss
      command Meinung https://www.welt.de/feeds/section/debatte.rss
    }
    menu Hessenschau {
      command Alle https://www.hessenschau.de/index.rss
      menu Hessen {
        command Rhein-Main https://www.hessenschau.de/rheinmain/index.rss
        command Nordhessen https://www.hessenschau.de/nordhessen/index.rss
        command Mittelhessen https://www.hessenschau.de/mittelhessen/index.rss
        command Osthessen https://www.hessenschau.de/osthessen/index.rss
        command Südhessen https://www.hessenschau.de/suedhessen/index.rss
      }
      command Politik https://www.hessenschau.de/politik/index.rss
      command Gesellschaft https://www.hessenschau.de/gesellschaft/index.rss
      command Wirtschaft https://www.hessenschau.de/wirtschaft/index.rss
      command Kultur https://www.hessenschau.de/kultur/index.rss
      command Sport https://www.hessenschau.de/sport/index.rss
      command Panorama https://www.hessenschau.de/panorama/index.rss
      command Freizeit https://www.hessenschau.de/freizeit/index.rss
    }
    command Meedia https://meedia.de/feed/
    command Süddeutsche https://rss.sueddeutsche.de/rss/Topthemen
    command Cicero https://www.cicero.de/rss.xml
    command Epoch https://www.epochtimes.de/?feed=rss
    command RT-Deutsch https://deutsch.rt.com/feeds/news/
    command Wochenblick https://www.wochenblick.at/feed/
    command tz http://www.tz.de/rssfeed.rdf
  }
  menu Gender {
    command Genderama http://genderama.blogspot.com/feeds/posts/default
    command Auschfrei https://auschfrei.wordpress.com/feed/
    menu Frauen {
      command PinkStinks https://pinkstinks.de/feed/
      command "Antje Schrupp" https://antjeschrupp.com/feed/
      command Störenfriedas https://diestoerenfriedas.de/feed/
      command IfGbsG https://ifgbsg.org/feed/
      command Missy https://missy-magazine.de/feed/
      command Mädchenmannschaft https://maedchenmannschaft.net/feed/
      command "Andreas Kemper" https://andreaskemper.org/feed/
    }
    menu Männer {
      command "Maskulismus für Anfänger"\
        https://maninthmiddle.blogspot.com/feeds/posts/default
      command "man tau" https://man-tau.com/feed/
      command uepsiloniks https://uepsilonniks.wordpress.com/feed/
      command "Jungs und Mädchen" https://jungsundmaedchen.wordpress.com/feed/
      command Männermagazin https://das-maennermagazin.com/blog/feed
      command Stapelchips https://stapelchipsblog.wordpress.com/feed/
      command "Alles Evolution" https://allesevolution.wordpress.com/feed/
      command Alternativlos-Aquarium https://alternativlos-aquarium.blogspot.com/feeds/posts/default
      
    }
    menu Prostitution {
      command Ella https://netzwerk-ella.de/index.php/feed/
      command Streetgirl https://streetgirl.twoday.net/index.rdf
    }
    command Cuncti http://cuncti.net/?format=feed&type=rss
    command "Philosophia Perennis"\
      https://philosophia-perennis.com/category/genderwahnsinn/?feed=rss2
    command Apokolokynthose https://apokolokynthose.wordpress.com/feed/
  }
  menu Left {
    command Nachdenkseiten https://www.nachdenkseiten.de/?feed=rss2
    command Feynsinn https://feynsinn.org/?feed=rss2
    command Neulandrebellen https://www.neulandrebellen.de/feed/
    command ND https://www.neues-deutschland.de/rss/aktuell.php
    command Rubikon https://www.rubikon.news/artikel.atom
    command "Ad Sinistram" https://ad-sinistram.blogspot.com/feeds/posts/default
  }
  menu Science {
    command Scinexx https://www.scinexx.de/feed/
    menu "Wissenschaft aktuell" {
      command Allgemein https://www.wissenschaft-aktuell.de/onTEAM/Wissenschaft-Aktuell.xml
      command Mensch https://www.wissenschaft-aktuell.de/onTEAM/WSA-Mensch.xml
      command Technik https://www.wissenschaft-aktuell.de/onTEAM/WSA-Technik.xml
      command Natur https://www.wissenschaft-aktuell.de/onTEAM/WSA-Natur.xml
      command Weltraum https://www.wissenschaft-aktuell.de/onTEAM/WSA-Weltraum.xml
      command Geist https://www.wissenschaft-aktuell.de/onTEAM/WSA-Geist.xml
      command Energie https://www.wissenschaft-aktuell.de/onTEAM/WSA-Energie.xml
    }
    command Spiegel https://www.spiegel.de/wissenschaft/index.rss
    command Astrodictium http://scienceblogs.de/astrodicticum-simplex/feed/
    command "Forschung und Wissen" https://www.forschung-und-wissen.de/feed.rss
  }
  menu Verschiedenes {
    command "Gott und die Welt" http://gottunddiewelt.net/feed/
    command "Mathias Broeckers" https://www.broeckers.com/feed/
    command Neusprech https://neusprech.org/feed/
    command Saftpresse https://diesaftpressederleutevomortundderjunge.com/feed/
    command Salonkolumnisten https://www.salonkolumnisten.com/feed/
    command "Ina Eff" https://nachdenklichekrankenschwester.blog/feed/
    command "Neue Debatte" https://neue-debatte.com/feed/
  }
  - - -
  menu Heise {
    command Telepolis https://www.heise.de/tp/news-atom.xml
    menu IT {
      command Newsticker https://www.heise.de/rss/heise-atom.xml
      command Developer https://www.heise.de/developer/rss/news-atom.xml
      command Netze https://www.heise.de/thema/netze?view=atom
      command "Open Source" https://www.heise.de/thema/linux-und-open-source?view=atom
      command Security https://www.heise.de/security/rss/news-atom.xml
    }
    command "Technology Review" https://www.heise.de/tr/rss/news-atom.xml
    command Autos http://www.heise.de/autos/rss/news-atom.xml
    command TechStage http://www.techstage.de/rss.xml
    command cʼt https://www.heise.de/ct/rss/artikel-atom.xml
    command iX http://www.heise.de/ix/rss/news-atom.xml
    command Fotografie https://www.heise.de/foto/rss/news-atom.xml
    command Mac&i https://www.heise.de/mac-and-i/news-atom.xml
    command Make https://www.heise.de/make/rss/hardware-hacks-atom.xml
  }
  command Newsticker https://www.heise.de/rss/heise-atom.xml
  command Golem https://rss.golem.de/rss.php?feed=RSS1.0
  command Gulli https://www.gulli.com/feed/
  - - -
  command Pornoanwalt https://pornoanwalt.de/?feed=rss2
  command Schockwellenreiter http://blog.schockwellenreiter.de/feed/rss.xml
  command Rebellmarkt https://rebellmarkt.blogger.de/rss
  menu Pollmer {
    command EU.L.E https://euleev.de/?format=feed&type=rss
    command Podcast https://podcast.euleev.de/eule.xml
  }
  command "Acta Diurna" https://michael-klonovsky.de/acta-diurna?format=feed&type=rss
  command Tagebuch http://wolf-dieter-busch.de/blog/rss.xml
  command "Russland aktuell" https://www.fit4russland.com/?format=feed&type=rss
  command Sputnik https://de.sputniknews.com/export/rss2/archive/index.xml
  command "Der kleine Akif" https://der-kleine-akif.de/feed/
  command fefe http://blog.fefe.de/rss.xml?html
  command Parnassos http://www.felix-bartels.de/feed/
  command Jouwatch https://www.journalistenwatch.com/feed/
  command PinkKosherNostra https://pinkkoshernostra.org/feed/
  command Prinzessinnenreporter https://www.prinzessinnenreporter.de/feed/
  menu underdogs {
    command deliberationdaily http://www.deliberationdaily.de/feed/
    command "Fliegende Bretter" https://fliegende-bretter.blogspot.com/feeds/posts/default
    command "Tante Jay" https://tantejay.com/feed/
  }
}

apply {
  script {
    set state [.t cget -state]
    .t configure -state normal
    variable prefs
    variable initFile
    if {[catch {
        if [file exists $initFile] then {
          set prefs [dict replace $prefs {*}[cat $initFile]]
          .t configure -font [dict get $prefs font]
          wm geometry . [dict get $prefs geometry]
          wm title . [dict get $prefs title]
          after 100 checkVisited
          setLinks ""
        }
      } err]} then {
      puts $err
    }
    .t configure -state $state
  }
} [info script]

Um den Browser einzustellen, Quelltext anpassen (suche „variable browserCommand“).

Um eigene Feed-Quellen einzutragen, Quelltext anpassen (suche „Hier Feeds erstellen“). Die Voreinstellung zeigt beispielhaft, wie es geht.

Einige Quellen laden grottig langsam – da bleibt nichts übrig, als sich in Geduld zu fassen. Einige Quellen werfen die Fehlermeldung „Zugriff verweigert“.

31.5.2022