[emacs] Adding traclicker and url-rewrite, as well as customizations

5 files changed, 147 insertions, 2 deletions

diff --git a/emacs/.emacs.d/init/ycp-gnus.el b/emacs/.emacs.d/init/ycp-gnus.el
index f344cfc..b15dac9 100644
--- a/emacs/.emacs.d/init/ycp-gnus.el
+++ b/emacs/.emacs.d/init/ycp-gnus.el
@@ -183,8 +183,9 @@
   (setq gnus-inhibit-images t)
   (setq gnus-treat-display-smileys nil)
   (setq gnus-article-x-face-too-ugly ".*")
-  (my-keybind gnus-article-mode-map
-    "M-w" #'my-gnus-article-copy-region)
+  ;; shows a radio button in a multipart article to choose which part
+  ;; to display
+  (setq gnus-buttonized-mime-types '("multipart/alternative"))
   (setq gnus-visible-headers
         "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^In-Reply-To"))
 ;;; gnus-desktop-notify
@@ -233,4 +234,10 @@
   (bbdb-vcard-default-keybindings)
   (my-setq-from-local bbdb-vcard-default-dir))
 
+(my-package traclicker
+  (:delay 60)
+  (my-setq-from-local tracli-senders tracli-maildirs)
+  (my-server-timer my-tracli-timer nil 3600 #'tracli-scan)
+  (setq tracli-url-rewriter 'my-url-strip-drw-tracking-params))
+
 (provide 'ycp-gnus)
diff --git a/emacs/.emacs.d/init/ycp-web.el b/emacs/.emacs.d/init/ycp-web.el
index a81c2b0..f6da859 100644
--- a/emacs/.emacs.d/init/ycp-web.el
+++ b/emacs/.emacs.d/init/ycp-web.el
@@ -61,6 +61,100 @@
   (require 'osm-ol)
   )
 
+(my-package url-rewrite
+  (setq my-nitter-hosts
+        '("nitter.net"
+          "nitter.nixnet.services"
+          "nitter.unixfox.eu"
+          "nitter.mint.lgbt"
+          "nitter.esmailelbob.xyz"
+          "nitter.poast.org"
+          "nitter.cz"
+          "nitter.privacydev.net"
+          "nitter.projectsegfau.lt"
+          "nitter.eu.projectsegfau.lt"
+          "nitter.in.projectsegfau.lt"
+          "nitter.us.projectsegfau.lt"
+          "nitter.soopy.moe"
+          "nitter.rawbit.ninja"
+          "nitter.d420.de"
+          "bird.habedieeh.re"
+          "nitter.x86-64-unknown-linux-gnu.zip"
+          "nitter.woodland.cafe"
+          "nitter.dafriser.be"
+          "nitter.catsarch.com"
+          "nitter.perennialte.ch"
+          "nitter.salastil.com"
+          "n.populas.no"
+          "nt.ggtyler.dev"
+          "nitter.uni-sonia.com"
+          "n.opnxng.com"
+          "nitter.ktachibana.party"
+          "nitter.tinfoil-hat.net"))
+  (setq my-invidious-hosts
+        '("yewtu.be"
+          "invidious.io.lol"
+          "invidious.slipfox.xyz"
+          "invidious.drgns.space"
+          "invidious.protokolla.fi"
+          "invidious.flokinet.to"
+          "iv.ggtyler.dev"
+          "yt.drgnz.club"
+          "invidious.lunar.icu"
+          "invidious.private.coffee"
+          "invidious.fdn.fr"
+          "vid.puffyan.us"
+          "invidious.asir.dev"
+          "onion.tube"
+          "iv.melmac.space"
+          "invidious.projectsegfau.lt"
+          "inv.in.projectsegfau.lt"
+          "invidious.privacydev.net"
+          "iv.datura.network"
+          "inv.tux.pizza"
+          "iv.nboeck.de"
+          "invidious.perennialte.ch"
+          "yt.oelrichsgarcia.de"
+          "inv.citw.lgbt"
+          "inv.zzls.xyz"
+          "invidious.einfachzocken.eu"
+          "yt.cdaut.de"
+          "yt.artemislena.eu"
+          "vid.priv.au"
+          "anontube.lvkaszus.pl"
+          "invidious.no-logs.com"))
+  (setq url-rw-rules
+        '((:name ddg-result
+                 :description "duckduckgo result transform."
+                 :match (concat url-rw-www-re (rx "duckduckgo.com/l/?uddg="))
+                 :actions ((replace-by-redirect "uddg")))
+          (:name google-to-ddg
+                 :description "Google search to duckduckgo html."
+                 :match (concat url-rw-www-re (rx "google.com/search?q="))
+                 :actions ((replace-host "html.duckduckgo.com")
+                           (replace-path "/html")))
+          (:name reddit-to-old
+                 :description "Reddit to old Reddit"
+                 :match (concat url-rw-www-re (rx "reddit.com"))
+                 :actions ((replace-host "old.reddit.com")))
+          (:name strip-utm
+                 :description "Strip utm_* queries."
+                 :match "\\<utm_[a-z_]+="
+                 :actions ((remove-query "utm_.*")))
+          (:name twitter-to-nitter
+                 :description "Twitter to a random nitter instance."
+                 :match (concat url-rw-www-re (rx "twitter.com"))
+                 :actions ((replace-random-host my-nitter-hosts)))
+          (:name youtube-to-invidious
+                 :description "YouTube to a random invidious instance."
+                 :match (concat url-rw-www-re (rx (or "youtube.com"
+                                                      "youtu.be"
+                                                      "m.youtube.com")))
+                 :actions ((replace-random-host my-invidious-hosts)))))
+  (setq url-rw-extra-rewriters '(url-rewrite-example-zoom-to-dial))
+  (url-rw-refresh)
+  )
+
 (my-package hnreader
   (:delay 30)
   (require 'my-hnreader)
diff --git a/emacs/.emacs.d/lisp/my/my-url-rewrite.el b/emacs/.emacs.d/lisp/my/my-url-rewrite.el
new file mode 100644
index 0000000..c98b1f3
--- /dev/null
+++ b/emacs/.emacs.d/lisp/my/my-url-rewrite.el
@@ -0,0 +1,44 @@
+;;; my-url-rewrite.el -- My customisation of url-rewrite -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023  Free Software Foundation, Inc.
+
+;; Author: Yuchen Pei <id@ypei.org>
+;; Package-Requires: ((emacs "28.2") (url-rewrite))
+
+;; This file is part of dotted.
+
+;; dotted is free software: you can redistribute it and/or modify it under
+;; the terms of the GNU Affero General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; dotted is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General
+;; Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public
+;; License along with dotted.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; My customisation of url-rewrite.
+
+;;; Code:
+
+(require 'url-rewrite)
+
+(defun my-url-strip-drw-tracking-params (url)
+  "Strip tracking params in a DRW's email newsletter URL.
+
+For use in `tracli-url-rewriter'."
+  (let ((urlobj (url-generic-parse-url url)))
+    (url-rw-remove-query
+     urlobj
+     (regexp-opt
+      '("can_id" "source" "email_referrer" "email_subject" "link_id"
+        "utm_source" "utm_medium" "utm_campaign" "utm_content" "utm_term")))
+    (url-recreate-url urlobj)))
+
+(provide 'my-url-rewrite)
+;;; my-url-rewrite.el ends here
diff --git a/emacs/.emacs.d/lisp/traclicker b/emacs/.emacs.d/lisp/traclicker
new file mode 160000
+Subproject 4b6733188057bdaada89b841303e387108e0dc0
diff --git a/emacs/.emacs.d/lisp/url-rewrite b/emacs/.emacs.d/lisp/url-rewrite
new file mode 160000
+Subproject 871c39fcf3a6b35e8df4013d60e43a8bccadb67