aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--emacs/.emacs.d/init/ycp-web.el6
-rw-r--r--emacs/.emacs.d/lisp/my/fediorg.el (renamed from emacs/.emacs.d/lisp/my/mastorg.el)185
-rw-r--r--emacs/.emacs.d/lisp/my/my-web.el8
-rw-r--r--emacs/.emacs.d/lisp/my/my-ytdl.el27
4 files changed, 126 insertions, 100 deletions
diff --git a/emacs/.emacs.d/init/ycp-web.el b/emacs/.emacs.d/init/ycp-web.el
index 6083b35..3c033ad 100644
--- a/emacs/.emacs.d/init/ycp-web.el
+++ b/emacs/.emacs.d/init/ycp-web.el
@@ -335,12 +335,12 @@
(add-hook 'mastodon-toot-mode-hook (lambda () (turn-off-auto-fill)))
(mastodon))
-(my-package mastorg
+(my-package fediorg
(:delay 60)
(require 'my-web)
(add-to-list 'browse-url-handlers
- `(my-mastodon-url-p
- . ,(lambda (url &rest _) (mastorg-open url))))
+ `(fediorg-post-url-p
+ . ,(lambda (url &rest _) (fediorg-open url))))
)
(add-to-list 'load-path (locate-user-emacs-file "lisp/servall/lisp"))
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
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-24 06:40:26 +0000