Ihor Radchenko <[email protected]> writes:
> See 43.17 Batch Mode section of Elisp manual. It is Emacs default to
> print message output to stderr.
OK, thanks for the information. This means that the warnings are finding a
needle in a haystack, though one can always grep for "Warning" in the stderr.
About warnings: I now issue a warning if a link description refers to the full
domain being replaced, like so:
Warning (emacs): Link description "Org-mode discussions on reddit.com" in
/home/rens/Projects/org/worg/index.org:87 refers to the full domain
"reddit.com", which we change. This is confusing, please change the description.
and I have also manually fixed all (3) cases where this happened.
>>>> +(push "./" load-path)
>>>> +(require 'rewrite-urls)
>>>
>>> We can simply use (load "rewrite-urls")
>>> Also, it is a good practice to use a non-generic prefix. Something like
>>> worg-urls.
>>
>> I can't get (load "...") to work, unless I do (push "./" load-path)
>> beforehand. From the docs of `load':
>>
>> ...
>> This function searches the directories in ‘load-path’.
>>
>> Am I missing something?
>
> Yeah. Need (load "./rewrite-urls") - path, not just file name.
This still does not work for me.
(load "./worg-urls-rewrite") gives the error
Error: file-missing ("Cannot open load file" "No such file or directory"
"./worg-urls-rewrite")
load("./worg-urls-rewrite")
#<subr F616e6f6e796d6f75732d6c616d626461_anonymous_lambda_101>(#<buffer
*load*> "/home/rens/Projects/org/worg/publish.sh")
load-with-code-conversion("/home/rens/Projects/org/worg/publish.sh"
"/home/rens/Projects/org/worg/publish.sh" nil t #<subr
F616e6f6e796d6f75732d6c616d626461_anonymous_lambda_101>)
command-line--load-script("/home/rens/Projects/org/worg/publish.sh")
command-line-1(("-scriptload" "./publish.sh" "--"))
command-line()
normal-top-level()
Cannot open load file: No such file or directory, ./worg-urls-rewrite
and adding the .el suffix with (load "./worg-urls-rewrite.el") gives the same
error. It works when I do (push "." load-path) beforehand, though.
> I will give some quick feedback on what you have below.
Thanks.
>> -Tony day [[http://mid.gmane.org/[email protected]][shared]]
>> [[https://gist.github.com/4343164][this gist]] to pick up a
>> +Tony day [[http://mid.gmane.org/[email protected]][shared]]
>> [[https://gist.github.com/tonyday567/4343164][this gist]] to pick up a
>> random task.
>
> Side note: gmane is down, so all links it gmane are broken.
I have ignored this for now since it's somewhat orthogonal to this, but I can
fix this up later.
>> +(defun -get-libredirect-data ()
>> + "Returns libredirect data from github"
>
> Here and in other places, should use prefix worg-urls-get-libredirect-data.
> Also, try M-x checkdoc on the file. You will see a lot of stylistic
> suggestions.
Have done so, see attached patch for the updated version. Again, you can see
the changes on https://files.rensoliemans.nl/worg, though the new changes have
been mostly internal.
Best,
Rens
>From 0fea07080ad58c0a8031409af34d6c414f57582f Mon Sep 17 00:00:00 2001
From: Rens Oliemans <[email protected]>
Date: Fri, 21 Nov 2025 20:13:58 +0100
Subject: [PATCH] Add alternative links for YouTube, GitHub and Reddit
This commit finds alternative links for the hosts mentioned above
since they rely on non-free JS. See
https://list.orgmode.org/orgmode/87pl9szmy6.fsf@localhost/ for
context.
---
.gitignore | 1 +
index.org | 2 +-
org-contrib/index.org | 2 +-
org-hacks.org | 2 +-
org-tests/index.org | 15 +-
org-tutorials/non-beamer-presentations.org | 4 +-
publish.sh | 59 ++---
rewrite-websites.js | 24 ++
worg-urls-rewrite.el | 251 +++++++++++++++++++++
9 files changed, 321 insertions(+), 39 deletions(-)
create mode 100644 rewrite-websites.js
create mode 100644 worg-urls-rewrite.el
diff --git a/.gitignore b/.gitignore
index c9dc5b62..c572b901 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,3 +4,4 @@
patches/
/.project
*patch
+*.eld
diff --git a/index.org b/index.org
index 9c14fa3e..237f7b0f 100644
--- a/index.org
+++ b/index.org
@@ -84,7 +84,7 @@ is maintained by a group of [[file:worgers.org][Worg contributors]], and maybe [
- [[file:org-irc.org][Org-mode IRC Channel]] : For live Q&A, go to =#org-mode= on Libera
- Check [[https://fosstodon.org/tags/OrgMode][#orgmode]] hashtag on Mastodon
- Check [[file:org-web-social.org][latest posts]] on reddit.com and stackoverflow.com
-- Browse [[https://www.reddit.com/r/orgmode/][Org-mode discussions on reddit.com]]
+- Browse [[https://www.reddit.com/r/orgmode/][Org-mode discussions on Reddit]]
- Browse [[https://stackoverflow.com/questions/tagged/org-mode][Org-mode questions on stackoverflow.com]]
- [[https://emacslife.com/calendar/][Emacs event calendar]] : Join virtual and in-person Emacs events
- [[file:orgmeetup.org][=[[bbb:OrgMeetup]]=]] : talk (online) with Org mode developers and users
diff --git a/org-contrib/index.org b/org-contrib/index.org
index 16b8c95d..89051927 100644
--- a/org-contrib/index.org
+++ b/org-contrib/index.org
@@ -430,7 +430,7 @@ See [[file:../exporters/index.org][Exporters]].
- [[https://github.com/eschulte/org-S5][org-S5]] from Eric Schulte
- [[https://github.com/relevance/org-html-slideshow.git][org-html-slideshow]] from Stuart Sierra
- - [[https://gist.github.com/509761][org-html5presentation.el]] from kinjo
+ - [[https://gist.github.com/takumikinjo/509761][org-html5presentation.el]] from kinjo
For use with the new exporter, /ox-s5.el/ ([[contribfile:lisp/ox-s5.el][link to raw file)]] and
/ox-deck.el/ ([[contribfile:lisp/ox-deck.el][link to raw file]]), both by Rick Frankel, are
diff --git a/org-hacks.org b/org-hacks.org
index 63b36d7e..62aa6094 100644
--- a/org-hacks.org
+++ b/org-hacks.org
@@ -67,7 +67,7 @@ Here is a hook function to use archive this effect:
*** Picking up a random task in the global TODO list
-Tony day [[http://mid.gmane.org/[email protected]][shared]] [[https://gist.github.com/4343164][this gist]] to pick up a
+Tony day [[http://mid.gmane.org/[email protected]][shared]] [[https://gist.github.com/tonyday567/4343164][this gist]] to pick up a
random task.
** Building and Managing Org
diff --git a/org-tests/index.org b/org-tests/index.org
index f1232ba2..ca6f2cf1 100644
--- a/org-tests/index.org
+++ b/org-tests/index.org
@@ -64,16 +64,17 @@ _ert.el_ and _ert-x.el_ to your testing directory. This may be
accomplished with the following commands entered on the command line.
: cd /path/to/org-mode/testing
-: curl -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert.el
-: curl -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert-x.el
+: curl -O https://cgit.git.savannah.gnu.org/cgit/emacs.git/plain/lisp/emacs-lisp/ert.el
+: curl -O https://cgit.git.savannah.gnu.org/cgit/emacs.git/plain/lisp/emacs-lisp/ert-x.el
Alternatively you may download the files within your browser.
- - browse to [[https://github.com/mirrors/emacs/tree/master/lisp/emacs-lisp][github.com/mirrors/emacs/lisp/emacs-lisp]]
- - right click ert.el link and select _download linked file_ (or
- equivalent) and save to org-mode/testing/ert.el
- - right click ert-x.el link and select _download linked file_ (or
- equivalent) and save to org-mode/testing/ert-x.el
+ - browse to [[https://cgit.git.savannah.gnu.org/cgit/emacs.git/plain/lisp/emacs-lisp/ert.el][ert.el in Emacs' source code]]
+ - Download this file with Ctrl+S, or via Right-click on the page and
+ "Save Page As" (or equivalent) and save to
+ =org-mode/testing/ert.el=.
+ - Do the same for the [[https://cgit.git.savannah.gnu.org/cgit/emacs.git/plain/lisp/emacs-lisp/ert-x.el][ert-x.el]] file, save to
+ =org-mode/testing/ert-x.el=.
That's it - you may now run the tests.
diff --git a/org-tutorials/non-beamer-presentations.org b/org-tutorials/non-beamer-presentations.org
index 33ea005e..ed1e346c 100644
--- a/org-tutorials/non-beamer-presentations.org
+++ b/org-tutorials/non-beamer-presentations.org
@@ -34,8 +34,8 @@ documents.
HTML export serves as the base of the presentation.
- org-html5presentation :: Is an Exporter of Org-mode documents to
- HTML5 slide show presentations.
- (see [[https://gist.github.com/509761][gist.github.com/509761]] for code and usage information)
+ HTML5 slide show presentations. (see
+ [[https://gist.github.com/takumikinjo/509761][this gist by takumikinjo]] for code and usage information)
- [[org-tree-slide]] :: is a simple tool to treat a tree of an org buffer as
a single slide. Since each slide is displayed by simple narrowing,
diff --git a/publish.sh b/publish.sh
index b499de3d..6a439655 100755
--- a/publish.sh
+++ b/publish.sh
@@ -14,6 +14,8 @@ This variable can be set when running publish.sh script:
(require 'htmlize)
(require 'org-inlinetask)
+(load "worg-urls-rewrite")
+
(setq make-backup-files nil
debug-on-error t)
@@ -58,30 +60,33 @@ This variable can be set when running publish.sh script:
(R . t)
(gnuplot . t)))
-(dolist (org-file (cl-remove-if
- (lambda (n) (string-match-p "worg/archive/" n))
- (directory-files-recursively default-directory "\\.org$")))
- (let ((html-file (concat (file-name-directory org-file)
- (file-name-base org-file) ".html")))
- (if (and (file-exists-p html-file)
- (file-newer-than-file-p html-file org-file)
- ;; If there are include files or code, we need to
- ;; re-generate the HTML just in case if the included
- ;; files are changed.
- (with-temp-buffer
- (insert-file-contents org-file)
- (and
- (save-excursion
- (goto-char (point-min))
- (not (re-search-forward "#\\+include:" nil t)))
- (save-excursion
- (goto-char (point-min))
- (not (re-search-forward "#\\+begin_src" nil t))))))
- (message " [skipping] unchanged %s" org-file)
- (message "[exporting] %s" (file-relative-name org-file default-directory))
- (with-current-buffer (find-file org-file)
- (if worg-publish-stop-on-error
- (org-html-export-to-html)
- (condition-case err
- (org-html-export-to-html)
- (error (message (error-message-string err)))))))))
+(add-hook 'org-export-before-parsing-functions #'worg-urls-add-alternative-links)
+(let ((export-all (worg-urls-libredirect-data-changed-p worg-urls-libredirect-data)))
+ (dolist (org-file (cl-remove-if
+ (lambda (n) (string-match-p "worg/archive/" n))
+ (directory-files-recursively default-directory "\\.org$")))
+ (let ((html-file (concat (file-name-directory org-file)
+ (file-name-base org-file) ".html")))
+ (if (and (not export-all)
+ (file-exists-p html-file)
+ (file-newer-than-file-p html-file org-file)
+ ;; If there are include files or code, we need to
+ ;; re-generate the HTML just in case if the included
+ ;; files are changed.
+ (with-temp-buffer
+ (insert-file-contents org-file)
+ (and
+ (save-excursion
+ (goto-char (point-min))
+ (not (re-search-forward "#\\+include:" nil t)))
+ (save-excursion
+ (goto-char (point-min))
+ (not (re-search-forward "#\\+begin_src" nil t))))))
+ (message " [skipping] unchanged %s" org-file)
+ (message "[exporting] %s" (file-relative-name org-file default-directory))
+ (with-current-buffer (find-file org-file)
+ (if worg-publish-stop-on-error
+ (org-html-export-to-html)
+ (condition-case err
+ (org-html-export-to-html)
+ (error (message (error-message-string err))))))))))
diff --git a/rewrite-websites.js b/rewrite-websites.js
new file mode 100644
index 00000000..be25cfc1
--- /dev/null
+++ b/rewrite-websites.js
@@ -0,0 +1,24 @@
+const nonfree_mappings = new Map();
+nonfree_mappings.set(/https?:\/\/(?:www\.)?(?:youtube\.com|youtu\.be)\/watch\?v(?:=|%3D)([a-zA-Z0-9\-_]{11})(?:&.+)?/, 'https://inv.nadeko.net/watch?v=');
+
+
+function rewriteLinks() {
+ const links = document.querySelectorAll("a");
+ links.forEach(replaceIfMatch);
+}
+
+function replaceIfMatch(a) {
+ nonfree_mappings.forEach((to, from) => {
+ const match = a.href.match(from);
+ if (match) insertReplacement(a, match, to);
+ });
+}
+
+function insertReplacement(a, match, to) {
+ element = document.createElement("a");
+ element.href = to + match[1];
+ element.innerText = "(alternative without non-free JS)";
+ a.after(" ", element);
+}
+
+window.addEventListener("load", rewriteLinks);
diff --git a/worg-urls-rewrite.el b/worg-urls-rewrite.el
new file mode 100644
index 00000000..0a164074
--- /dev/null
+++ b/worg-urls-rewrite.el
@@ -0,0 +1,251 @@
+;;; worg-urls-rewrite.el --- Rewrite URLs that refer to pages containing non-free JS to free alternatives
+
+;;; Commentary:
+;;
+;; Worg links to many external pages, some of which link to websites
+;; that rely on non-free JavaScript, such as GitHub or YouTube pages.
+;; This script contains the function `worg-urls-add-alternative-links'
+;; which converts these links to free alternatives, such as GotHub and
+;; Invidious.
+;;
+;; Since these alternatives occasionally go down, we use the
+;; alternative specified by libredirect, which checks whether these
+;; alternatives are live or not. This is seen in
+;; `worg-urls-libredirect-url'.
+;;
+;; This was discussed on the mailing list here:
+;; https://list.orgmode.org/87pl9szmy6.fsf@localhost.
+;;
+;;; Code:
+
+(defvar worg-urls-libredirect-url "https://raw.githubusercontent.com/libredirect/instances/main/data.json";
+ "Location where up-to-date libredirect data is found.")
+(defvar worg-urls-libredirect-data nil
+ "Contents of libredirect data, obtained from `worg-urls-libredirect-url'.")
+
+(defcustom worg-urls-free-alternatives '((youtube . invidious)
+ (github . gothub))
+ "Alist of alternative frontends to websites containing non-free JS.
+The CDR corresponds to a symbol that is known by libredirect, see
+https://codeberg.org/LibRedirect/instances.";)
+(defcustom worg-urls-redirect-save-filename "redirect-local-data.eld"
+ "Filename used to save the relevant output of libredirect's data.")
+
+
+(defun worg-urls-libredirect-data-changed-p (&optional data)
+ "Whether or not libredirect DATA changed since our last export."
+ (setq worg-urls-libredirect-data (or data (worg-urls--get-libredirect-data)))
+ (if (not (file-exists-p worg-urls-redirect-save-filename))
+ ;; We hadn't saved stuff from our previous export, do so now.
+ (progn
+ (worg-urls--save-redirect-data worg-urls-libredirect-data)
+ t)
+ ;; Compare results from stored file with data, overwrite stored data if newer
+ (let* ((stored-data (with-temp-buffer
+ (insert-file-contents worg-urls-redirect-save-filename)
+ (read (buffer-string))))
+ (data-equal (equal (worg-urls--relevant-redirect-data worg-urls-libredirect-data)
+ stored-data)))
+ (unless data-equal
+ (worg-urls--save-redirect-data worg-urls-libredirect-data))
+ (not data-equal))))
+
+
+(defun worg-urls--get-libredirect-data ()
+ "Return libredirect data from `worg-urls-libredirect-url'."
+ (condition-case _
+ (let ((response (with-current-buffer
+ (url-retrieve-synchronously worg-urls-libredirect-url nil nil 5)
+ (prog2
+ (re-search-forward "\n\n" nil t) ; skip HTTP headers
+ (buffer-substring-no-properties (point) (point-max))
+ (kill-buffer)))))
+ (json-parse-string response :object-type 'alist :array-type 'list))
+ (t
+ (message "Worg couldn't access libredirect data, using original URLs.")
+ nil)))
+
+
+(defun worg-urls--save-redirect-data (&optional data)
+ "Save redirect DATA in a file with filename `worg-urls-redirect-save-filename'."
+ (let ((tosave (or data worg-urls-libredirect-data)))
+ (with-temp-file worg-urls-redirect-save-filename
+ (prin1
+ (worg-urls--relevant-redirect-data data)
+ (current-buffer)))))
+
+
+(defun worg-urls--relevant-redirect-data (data)
+ "Extract relevant redirection DATA, defined in `worg-urls-free-alternatives'."
+ (seq-map (lambda (association)
+ (let ((from (car association)))
+ `(,from . ,(worg-urls--first-link-of-data data from))))
+ worg-urls-free-alternatives))
+
+(defun worg-urls--is-short-gist-path-p (link)
+ "Test whether LINK links to a gist without a user id.
+These redirect to a \"full\" gist.github.com/<user>/<id> link and at the
+moment have to be fixed manually - gothub does not support these short
+links."
+ (string-match (rx "//gist.github.com/" (1+ (in digit))) link))
+
+(defun worg-urls-add-alternative-links (&optional _)
+ "Add alternative links for websites containing non-free JS.
+For each link that has an alternative (currently YouTube and GitHub), we
+insert a link to the free alternative, and change the link text of the
+original link to to =(original URL)=. We also redirect reddit links to
+old.reddit.com.
+
+See https://list.orgmode.org/orgmode/87pl9szmy6.fsf@localhost/";
+ (unless worg-urls-libredirect-data
+ (setq worg-urls-libredirect-data (worg-urls--get-libredirect-data)))
+
+ (let ((links (org-element-map (org-element-parse-buffer) 'link #'identity)))
+ (dolist (link (nreverse links))
+ (when (string-prefix-p "http" (org-element-property :type link))
+ (let ((path (org-element-property :path link)))
+ (if-let* ((new-url (worg-urls--find-replacement path)))
+ (let* ((begin (org-element-property :begin link))
+ (contents-begin (org-element-property :contents-begin link))
+ (contents-end (org-element-property :contents-end link)))
+ (save-excursion
+ (if (and contents-begin contents-end)
+ ;; Link has description.
+ (let ((description (buffer-substring contents-begin contents-end)))
+ ;; If this description refers to the full
+ ;; domain, this description will be confusing,
+ ;; since we change the domain here. Warn
+ ;; about this.
+ (when (string-match
+ (rx (or "reddit.com"
+ "github.com"
+ "youtube.com"))
+ description)
+ (warn
+ (concat "Link description \"%s\" in %s:%s refers"
+ " to the full domain \"%s\", which we change."
+ " This is confusing, please change the description.")
+ description (buffer-file-name)
+ (line-number-at-pos (org-element-property :contents-begin link))
+ (match-string 0 description)))
+
+ ;; Change description to (original URL)
+ (goto-char contents-begin)
+ (delete-region contents-begin contents-end)
+ (insert "(original URL)")
+ ;; Insert new link with free alternative
+ (goto-char begin)
+ (insert (format "[[%s][%s]] " new-url description)))
+ ;; Else, "bare" link without description. We insert
+ ;; the original link as bare, and add the old one
+ ;; with (original URL) as description.
+ (let* ((end (org-element-property :end link))
+ (original (buffer-substring begin end))
+ ;; the URL might be in [[https://...]]
+ ;; format or "just" in https://... format.
+ (url (if (string-match (rx string-start
+ "[["
+ (group (seq "https://"; (* anything)))
+ "]]"
+ string-end)
+ original)
+ (match-string 1 original)
+ original))
+ (replacement (format "[[%s]] [[%s][(original URL)]]" new-url url)))
+ (delete-region begin end)
+ (goto-char begin)
+ (insert replacement)))))
+ ;; No replacement found. Check if the link is a short
+ ;; github gist, this can be fixed manually.
+ (when (worg-urls--is-short-gist-path-p path)
+ (error
+ (concat "Please replace URL %s in %s:%s with its redirect target,"
+ " we cannot convert this short Gist URL to a free alternative.")
+ path
+ (buffer-file-name)
+ (line-number-at-pos (org-element-property :begin link))))))))))
+
+
+(defun worg-urls--find-replacement (path)
+ "Take PATH and return an alternative link if known and nil otherwise."
+ (and worg-urls-libredirect-data
+ (pcase path
+ ;; See https://docs.invidious.io/redirector/
+ ;; This matches both
+ ;; - youtube.com/watch?v=<video-id>
+ ;; - youtube.com/playlist?list=<playlist-id>
+ ;; with optionally ? and = escaped
+ ((rx "//" (? "www\.")
+ "youtube.com"
+ (group
+ (or (and "/watch"
+ (or "?" "%3F")
+ "v"
+ (or "=" "%3D"))
+ (and "/playlist"
+ (or "?" "%3F")
+ "list"
+ (or "=" "%3D"))))
+ (group (+ not-newline)))
+ (let* ((route (match-string 1 path))
+ (id (match-string 2 path))
+ (host (worg-urls--first-link-of-data worg-urls-libredirect-data 'youtube)))
+ (concat host route id)))
+ ;; youtu.be/<video-id>
+ ((rx "//" (? "www\.")
+ "youtu.be"
+ "/"
+ (group (+ not-newline)))
+ (let* ((video-id (match-string 1 path))
+ (host (worg-urls--first-link-of-data worg-urls-libredirect-data 'youtube)))
+ (concat host "/watch?v=" video-id)))
+ ;; gothub supports all links currently used in Worg, except for
+ ;; /<user>/<repo>/<issues>, so we exclude those.
+ ((and
+ (rx "//" (? "www\.")
+ "github.com"
+ "/"
+ (group (+ not-newline)))
+ ;; Exclude issues path. This approach currently also would
+ ;; erroneously exclude a supported link if author or repo
+ ;; starts with "issues"
+ (guard (not (string-match-p "/issues" path))))
+ (let* ((url (match-string 1 path))
+ (host (worg-urls--first-link-of-data worg-urls-libredirect-data 'github)))
+ (concat host "/" url)))
+ ;; gist.github.com links can have the format
+ ;; gist.github.com/<user>/<id>, but also obsolete
+ ;; gist.github.com/<id>. These last links are automatically
+ ;; redirected on github.com, but we do not know where to
+ ;; redirect them to at this moment, so we cannot convert
+ ;; these. Therefore we currently only convert
+ ;; gist.github.com/<user>/<id> links.
+ ((rx "//" "gist.github.com/"
+ ;; user
+ (group (1+ (not (any "/$"))))
+ "/"
+ ;; id
+ (group (+ not-newline)))
+ (let* ((user (match-string 1 path))
+ (id (match-string 2 path))
+ (host (worg-urls--first-link-of-data worg-urls-libredirect-data 'github)))
+ (concat host "/gist/" user "/" id)))
+ ;; redirect reddit.com to old.reddit.com
+ ((rx "//" (? "www\.")
+ "reddit.com"
+ "/"
+ (group (+ not-newline)))
+ (let* ((url (match-string 1 path))
+ (host "https://old.reddit.com";))
+ (concat host "/" url))))))
+
+(defun worg-urls--first-link-of-data (data host)
+ "Get the first available link in DATA of the alternative links for HOST."
+ (let* ((alternative (cdr (assoc host worg-urls-free-alternatives)))
+ (object (cdr (assoc alternative data)))
+ (links (cdr (assoc 'clearnet object))))
+ (car links)))
+
+(provide 'worg-urls-rewrite)
+
+;;; worg-urls-rewrite.el ends here
--
2.51.2
