[emacs] Rename mastorg to fediorg

Now that the package handles fedi posts in general, it no longer makes
sense to use mastodon-specific naming.

Also updated ytdl infobox formatting chapters and removal of extra
queries in urls

3 files changed, 123 insertions, 97 deletions

diff --git a/emacs/.emacs.d/lisp/my/mastorg.el b/emacs/.emacs.d/lisp/my/fediorg.el
index d0db3a0..123545b 100644
--- a/emacs/.emacs.d/lisp/my/mastorg.el
+++ b/emacs/.emacs.d/lisp/my/fediorg.el
@@ -1,4 +1,4 @@
-;;; mastorg.el -- Read or archive mastodon toot context in org mode -*- lexical-binding: t -*-
+;;; fediorg.el -- Read and archive fedi post context in org mode -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2023  Free Software Foundation, Inc.
 
@@ -22,20 +22,21 @@
 
 ;;; Commentary:
 
-;; Read or archive mastodon toot context in org mode. This is a
+;; Read or archive a fedi thread context in org mode. This is a
 ;; standalone library, and can be used without any other files in this
 ;; project.
 
 ;; Usage:
-;; M-x mastorg-open <RET> https://mastodon.instance/@user/12345678901234 <RET>
+;; M-x fediorg-open <RET> https://pleroma.instance/notice/... <RET>
+;; M-x fediorg-open <RET> https://mastodon.instance/@user/... <RET>
 ;;
-;; The toot, together with its ancestors and descendants, subject to
-;; mastodon API depth limit, are displayed in an org buffer.
+;; The post, together with its ancestors and descendants, subject to
+;; the API depth limit, are displayed in an org buffer.
 
 ;; TODO:
 ;;
 ;; To be able to refresh the org buffer at an org entry, which would
-;; re-fetch the context of the corresponding toot and upsert them in
+;; re-fetch the context of the corresponding post and upsert them in
 ;; the buffer.
 ;;; Code:
 
@@ -44,39 +45,39 @@
 (require 'json)
 (require 'url-parse)
 
-(defvar mastorg-buffer "*mastorg*" "Buffer name for mastorg buffers.")
+(defvar fediorg-buffer "*fediorg*" "Buffer name for fediorg buffers.")
 
 ;;; Fetching utilities
-(defvar mastorg-client-buffer-name "*mastorg-api*"
+(defvar fediorg-client-buffer-name "*fediorg-api*"
   "Buffer name for logging API requests.")
 
-(defun mastorg-url-fetch-json (url &optional decompression with-header)
+(defun fediorg-url-fetch-json (url &optional decompression with-header)
   "Fetch and parse json from URL.
 
 With nonnil DECOMPRESSION, gunzip the response first.
 With nonnil WITH-HEADER, include the response headers in the return value."
-  (mastorg-url-fetch-internal
+  (fediorg-url-fetch-internal
    url
    (lambda ()
      (json-read-from-string (decode-coding-string (buffer-string) 'utf-8)))
    decompression
    with-header))
 
-(defun mastorg-url-fetch-internal (url buffer-processor decompression with-header)
+(defun fediorg-url-fetch-internal (url buffer-processor decompression with-header)
   "Fetch from URL and process the response with BUFFER-PROCESSOR.
 
 With nonnil DECOMPRESSION, gunzip the response first.
 With nonnil WITH-HEADER, include the response headers in the return value."
-  (with-current-buffer (get-buffer-create mastorg-client-buffer-name)
+  (with-current-buffer (get-buffer-create fediorg-client-buffer-name)
     (goto-char (point-max))
     (insert "[" (current-time-string) "] Request: " url "\n"))
   (with-current-buffer (url-retrieve-synchronously url t)
-    (let ((header (mastorg-kill-http-header)) (status) (fields))
+    (let ((header (fediorg-kill-http-header)) (status) (fields))
       (goto-char (point-min))
-      (setq header (mastorg-parse-http-header header)
+      (setq header (fediorg-parse-http-header header)
             status (alist-get 'status header)
             fields (alist-get 'fields header))
-      (with-current-buffer mastorg-client-buffer-name
+      (with-current-buffer fediorg-client-buffer-name
         (insert "[" (current-time-string) "] Response: " status "\n"))
       (when decompression
         (call-process-region (point) (point-max) "gunzip" t t t)
@@ -91,19 +92,19 @@ With nonnil WITH-HEADER, include the response headers in the return value."
               (funcall buffer-processor)))
         (error "HTTP error: %s" (buffer-substring (point) (point-max)))))))
 
-(defun mastorg-kill-http-header ()
+(defun fediorg-kill-http-header ()
   "Kill http headers in the current buffer."
-  (mastorg-skip-http-header)
+  (fediorg-skip-http-header)
   (let ((killed (buffer-substring-no-properties (point-min) (point))))
     (delete-region (point-min) (point))
     killed))
 
-(defun mastorg-skip-http-header ()
+(defun fediorg-skip-http-header ()
   "Skip http headers in the current buffer."
   (goto-char (point-min))
   (re-search-forward "\r?\n\r?\n"))
 
-(defun mastorg-parse-http-header (text)
+(defun fediorg-parse-http-header (text)
   "Parse http headers from TEXT in the current buffer."
   (let ((status) (fields))
     (with-temp-buffer
@@ -115,101 +116,111 @@ With nonnil WITH-HEADER, include the response headers in the return value."
         (push (cons (intern (match-string 1)) (match-string 2)) fields)))
     (list (cons 'status status) (cons 'fields fields))))
 
-;;; mastodon utilities
-(defun mastorg-api-search (host url)
-  (mastorg-url-fetch-json
+;;; utilities
+(defun fediorg-api-search (host url)
+  (fediorg-url-fetch-json
    (format "https://%s/api/v2/search/?q=%s&resolve=true" host url)))
 
-(defun mastorg-canonical-post-url-by-search (host url)
-  (let-alist (mastorg-api-search host url)
+(defun fediorg-canonical-post-url-by-search (host url)
+  (let-alist (fediorg-api-search host url)
     (if (seq-empty-p .statuses)
         (error "No statuses associated with URL %s" url)
-      (mastorg-canonical-post-url (alist-get 'url (elt .statuses 0)) t))))
+      (fediorg-canonical-post-url (alist-get 'url (elt .statuses 0)) t))))
 
-(defun mastorg-canonical-post-url (url &optional no-fetch)
+(defun fediorg-post-url-p (url &optional no-fetch)
+  (pcase-let* ((urlobj (url-generic-parse-url url))
+               (`(,path . _) (url-path-and-query urlobj))
+               (host (url-host urlobj)))
+    (or (string-match-p "^/objects/[-a-f0-9]+$" path)
+        (string-match-p
+         "^/user[s]?/[[:alnum:]_]+/statuses/[[:digit:]]+$" path)
+        (string-match-p "^/@[^/]+/\\([0-9]+\\)$" path)
+        (string-match-p "^/notice/\\([[:alnum:]]+\\)$" path))))
+
+(defun fediorg-canonical-post-url (url &optional no-fetch)
   (pcase-let* ((urlobj (url-generic-parse-url url))
                (`(,path . _) (url-path-and-query urlobj))
                (host (url-host urlobj)))
     (cond ((or (string-match-p "^/objects/[-a-f0-9]+$" path)
                (string-match-p
                 "^/user[s]?/[[:alnum:]_]+/statuses/[[:digit:]]+$" path))
-           (unless no-fetch (mastorg-canonical-post-url-by-search host url)))
+           (unless no-fetch (fediorg-canonical-post-url-by-search host url)))
           ((or (string-match-p "^/@[^/]+/\\([0-9]+\\)$" path)
                (string-match-p "^/notice/\\([[:alnum:]]+\\)$" path))
            url)
           (t (error "Unrecognisable URL: %s" url)))))
 
-(defun mastorg-parse-url (url)
-  "Parse mastodon post URL."
+(defun fediorg-parse-url (url)
+  "Parse fedi post URL."
   (pcase-let* ((urlobj (url-generic-parse-url url))
                (`(,path . _) (url-path-and-query urlobj))
                (host (url-host urlobj)))
     (cons host (caddr (split-string path "/")))))
 
-(defun mastorg-api-status (url)
+(defun fediorg-api-status (url)
   "Get the status given URL."
-  (pcase-let ((`(,host . ,post-id) (mastorg-parse-url url)))
-    (mastorg-url-fetch-json
+  (pcase-let ((`(,host . ,post-id) (fediorg-parse-url url)))
+    (fediorg-url-fetch-json
      (format "https://%s/api/v1/statuses/%s" host post-id))))
 
-(defun mastorg-api-status-context (url)
+(defun fediorg-api-status-context (url)
   "Get the status context given URL."
-  (pcase-let ((`(,host . ,post-id) (mastorg-parse-url url)))
-    (mastorg-url-fetch-json
+  (pcase-let ((`(,host . ,post-id) (fediorg-parse-url url)))
+    (fediorg-url-fetch-json
      (format "https://%s/api/v1/statuses/%s/context" host post-id))))
 
-(defun mastorg-get-first-ancestor (url)
-  "Given a mastodon URL, return the url of its first ancestor."
+(defun fediorg-get-first-ancestor (url)
+  "Given a fedi post URL, return the url of its first ancestor."
   (let ((ancestors
-         (alist-get 'ancestors (mastorg-api-status-context url))))
+         (alist-get 'ancestors (fediorg-api-status-context url))))
     (if (length> ancestors 0)
         (alist-get 'url (elt ancestors 0))
       url)))
 
-(defun mastorg-toot-make-parent-fn (toots)
-  "Given a collection of TOOTS, return a function that find the parent toot."
-  (lambda (toot)
-    (let ((id (alist-get 'in_reply_to_id toot)))
+(defun fediorg-post-make-parent-fn (posts)
+  "Given a collection of POSTS, return a function that find the parent post."
+  (lambda (post)
+    (let ((id (alist-get 'in_reply_to_id post)))
       (seq-find
        (lambda (candidate)
          (equal (alist-get 'id candidate) id))
-       toots))))
+       posts))))
 
 ;;; Formatting functions
-(defun mastorg-format-toot-tree (url)
-  "Format a toot tree of toot located at URL.
+(defun fediorg-format-post-tree (url)
+  "Format a post tree of post located at URL.
 
 Including ancestors and descendants, if any."
-  (let* ((toots-hier (hierarchy-new))
-         (context-toots (mastorg-api-status-context url))
-         (toots (vconcat
-                 (alist-get 'ancestors context-toots)
-                 (vector (mastorg-api-status url))
-                 (alist-get 'descendants context-toots))))
+  (let* ((posts-hier (hierarchy-new))
+         (context-posts (fediorg-api-status-context url))
+         (posts (vconcat
+                 (alist-get 'ancestors context-posts)
+                 (vector (fediorg-api-status url))
+                 (alist-get 'descendants context-posts))))
     (hierarchy-add-trees
-     toots-hier
-     toots
-     (mastorg-toot-make-parent-fn toots))
+     posts-hier
+     posts
+     (fediorg-post-make-parent-fn posts))
     (string-join
-     (hierarchy-map 'mastorg-format-toot toots-hier 1)
+     (hierarchy-map 'fediorg-format-post posts-hier 1)
      "\n")))
 
-(defun mastorg-make-org-link (link desc)
+(defun fediorg-make-org-link (link desc)
   (format "[[%s][%s]]" link desc))
 
-(defun mastorg-format-attached (attachments host)
+(defun fediorg-format-attached (attachments host)
   (mapconcat
    (lambda (attachment)
      (let-alist attachment
        (with-temp-buffer
          (insert
-          (mastorg-make-org-link .url .type))
+          (fediorg-make-org-link .url .type))
          (if .description
              (insert ": " .description))
          (when .preview_url
            (let ((thumb-file-name
                   (file-name-concat
-                   mastorg-dir
+                   fediorg-dir
                    (format "%s.%s.%s" host .id
                            (file-name-extension .preview_url)))))
              (ignore-error 'file-already-exists
@@ -221,29 +232,29 @@ Including ancestors and descendants, if any."
    attachments
    "\n"))
 
-(defun mastorg-format-toot (toot level)
-  "Format a TOOT with indent LEVEL."
-  (let-alist toot
-    (let ((host (car (mastorg-parse-url .url))))
+(defun fediorg-format-post (post level)
+  "Format a POST with indent LEVEL."
+  (let-alist post
+    (let ((host (car (fediorg-parse-url .url))))
       (format "%s %s (@%s@%s) %s\n\n%s%s\n\n⤷%d ⇆%d ★%d\n"
               (make-string level ?*)
               (if (string-empty-p .account.display_name)
                   .account.username .account.display_name)
               .account.username
               host
-              (mastorg-make-org-link
+              (fediorg-make-org-link
                .url
-               (mastorg--relative-time-description .created_at))
+               (fediorg--relative-time-description .created_at))
               (with-temp-buffer
                 (insert .content)
                 (shr-render-region (point-min) (point-max))
                 (buffer-substring-no-properties (point-min) (point-max)))
-              (mastorg-format-attached .media_attachments host)
+              (fediorg-format-attached .media_attachments host)
               .replies_count
               .reblogs_count
               .favourites_count))))
 
-(defun mastorg-save-text-and-switch-to-buffer (text file-name)
+(defun fediorg-save-text-and-switch-to-buffer (text file-name)
   "Save TEXT to FILE-NAME and switch to buffer."
   (let ((buffer (find-file-noselect file-name))
         (coding-system-for-write 'utf-8))
@@ -256,26 +267,26 @@ Including ancestors and descendants, if any."
       (revert-buffer t t))
     (switch-to-buffer buffer)))
 
-(defvar mastorg-dir (locate-user-emacs-file "mastorg")
+(defvar fediorg-dir (locate-user-emacs-file "fediorg")
   "Path to local directory of saved threads.")
 
-(defun mastorg-make-filename (url)
-  (pcase-let ((`(,host . ,post-id) (mastorg-parse-url url)))
+(defun fediorg-make-post-file-name (url)
+  (pcase-let ((`(,host . ,post-id) (fediorg-parse-url url)))
     (format "%s.%s.org" host post-id)))
 
 ;;;###autoload
-(defun mastorg-open (url)
-  "Given a mastodon toot URL, open an org buffer rendering the toot.
+(defun fediorg-open (url)
+  "Given a fedi post URL, open an org buffer rendering the post.
 
-Including the context, i.e. ancestors and descendant toots."
-  (interactive "sToot URL: ")
-  (setq url (mastorg-canonical-post-url url))
-  (mastorg-save-text-and-switch-to-buffer
-   (mastorg-format-toot-tree url)
-   (file-name-concat mastorg-dir (mastorg-make-filename url))))
+Including the context, i.e. ancestors and descendant posts."
+  (interactive "sPost URL: ")
+  (setq url (fediorg-canonical-post-url url))
+  (fediorg-save-text-and-switch-to-buffer
+   (fediorg-format-post-tree url)
+   (file-name-concat fediorg-dir (fediorg-make-post-file-name url))))
 
 ;;; code adapted from mastodon.el
-(defun mastorg--human-duration (seconds &optional resolution)
+(defun fediorg--human-duration (seconds &optional resolution)
   "Return a string describing SECONDS in a more human-friendly way.
 The return format is (STRING . RES) where RES is the resolution of
 this string, in seconds.
@@ -284,7 +295,7 @@ second part of the output (defaults to 60, so that seconds are only
 displayed when the duration is smaller than a minute)."
   (cl-assert (>= seconds 0))
   (unless resolution (setq resolution 60))
-  (let* ((units mastorg--time-units)
+  (let* ((units fediorg--time-units)
          (n1 seconds) (unit1 (pop units)) (res1 1)
          n2 unit2 res2
          next)
@@ -319,7 +330,7 @@ displayed when the duration is smaller than a minute)."
                     n2 unit2 (if (> n2 1) "s" ""))
             (max res2 resolution))))))
 
-(defconst mastorg--time-units
+(defconst fediorg--time-units
   '("sec"   60.0 ;; Use a float to convert `n' to float.
     "min"   60
     "hour"  24
@@ -328,7 +339,7 @@ displayed when the duration is smaller than a minute)."
     "month" 12
     "year"))
 
-(defun mastorg--relative-time-details (timestamp &optional current-time)
+(defun fediorg--relative-time-details (timestamp &optional current-time)
   "Return cons of (DESCRIPTIVE STRING . NEXT-CHANGE) for the TIMESTAMP.
 Use the optional CURRENT-TIME as the current time (only used for
 reliable testing).
@@ -338,19 +349,19 @@ time that this description will change in the future.
 TIMESTAMP is assumed to be in the past."
   (let* ((time-difference (time-subtract current-time timestamp))
          (seconds-difference (float-time time-difference))
-         (tmp (mastorg--human-duration (max 0 seconds-difference))))
+         (tmp (fediorg--human-duration (max 0 seconds-difference))))
     ;; revert to old just now style for < 1 min
     (cons (concat (car tmp) (if (string= "just now" (car tmp)) "" " ago"))
           (time-add current-time (cdr tmp)))))
 
-(defun mastorg--relative-time-description (time-string &optional current-time)
+(defun fediorg--relative-time-description (time-string &optional current-time)
   "Return a string with a human readable TIME-STRING relative to the current time.
 Use the optional CURRENT-TIME as the current time (only used for
 reliable testing).
 E.g. this could return something like \"1 min ago\", \"yesterday\", etc.
 TIME-STAMP is assumed to be in the past."
-  (car (mastorg--relative-time-details
+  (car (fediorg--relative-time-details
         (encode-time (parse-time-string time-string)) current-time)))
 
-(provide 'mastorg)
-;;; mastorg.el ends here
+(provide 'fediorg)
+;;; fediorg.el ends here
diff --git a/emacs/.emacs.d/lisp/my/my-web.el b/emacs/.emacs.d/lisp/my/my-web.el
index 6c3cd92..aeb5a6d 100644
--- a/emacs/.emacs.d/lisp/my/my-web.el
+++ b/emacs/.emacs.d/lisp/my/my-web.el
@@ -164,14 +164,6 @@ Useful for bypassing some paywalls."
 (require 'hmm)
 (defvar my-url-context-function 'hmm-url "Context function for urls.")
 
-(defun my-mastodon-url-p (url)
-  "Guess if a url is a mastodon post.
-e.g. https://hostux.social/@fsf/113709722998924141
-"
-  (pcase-let* ((urlobj (url-generic-parse-url url))
-               (`(,path . _) (url-path-and-query urlobj)))
-    (string-match-p "^/@[^/]+/[0-9]\\{18\\}$" path)))
-
 (defun my-hacker-news-url-p (url)
   "Check if a url is a hacker news post.
 e.g. https://news.ycombinator.com/item?id=42505454"
diff --git a/emacs/.emacs.d/lisp/my/my-ytdl.el b/emacs/.emacs.d/lisp/my/my-ytdl.el
index bf917ce..b3b1cf7 100644
--- a/emacs/.emacs.d/lisp/my/my-ytdl.el
+++ b/emacs/.emacs.d/lisp/my/my-ytdl.el
@@ -90,13 +90,32 @@
 
 (defun my-ytdl-video-url-p (url)
   (let ((urlobj (url-generic-parse-url url)))
-    (or (and (string-match-p "^\\(www\\.\\)?youtube.com" (url-host urlobj))
+    (or (and (string-match-p
+              "^\\(www\\.\\)?\\(youtube\\.com\\|yewtu\\.be\\)"
+              (url-host urlobj))
              (string-match-p "^/watch\\?v=.*" (url-filename urlobj)))
         (equal "youtu.be" (url-host urlobj)))))
 
 (require 'hmm)
 (defvar my-ytdl-player 'hmm-external-mpv "Function to play ytdl urls.")
 
+(defun my-ytdl-video-format-seconds (secs)
+  (setq secs (floor secs))
+  (if (>= secs 3600)
+      (format "%d:%02d:%02d"
+              (/ secs 3600) (/ (% secs 3600) 60) (% secs 60))
+    (format "%d:%02d"
+            (/ secs 60) (% secs 60))))
+
+(defun my-ytdl-video-format-chapters (chapters)
+  (mapconcat
+   (lambda (chapter)
+     (let-alist chapter
+       (format "%s: %s-%s" .title (my-ytdl-video-format-seconds .start_time)
+               (my-ytdl-video-format-seconds .end_time))))
+   chapters
+   "; "))
+
 (defun my-ytdl-video-render-info (info url)
   (setf (alist-get 'webpage_url info)
         (concat (alist-get 'webpage_url info)
@@ -104,7 +123,9 @@
                                            (funcall my-ytdl-player url)))
                 " " (buttonize "context"
                                (lambda (_)
-                                 (funcall my-url-context-function url)))))
+                                 (funcall my-url-context-function url))))
+        (alist-get 'chapters info)
+        (my-ytdl-video-format-chapters (alist-get 'chapters info)))
   (infobox-render
    (infobox-translate info (infobox-default-specs info))
    `(my-ytdl-video-infobox ,url)
@@ -112,6 +133,8 @@
 
 (defun my-ytdl-video-infobox (url)
   (interactive "sytdl video url: ")
+  ;; Remove any extra queries from the URL
+  (setq url (replace-regexp-in-string "&.*" "" url))
   (my-ytdl-video-render-info (my-ytdl-video-info url) url))
 
 ;;; fixme: autoload