[emacs] Adding lem-org, a package to read lemmy posts in org mode.

Also adding the submodule lem.el it depends on.

2 files changed, 171 insertions, 0 deletions

diff --git a/emacs/.emacs.d/lisp/lem.el b/emacs/.emacs.d/lisp/lem.el
new file mode 160000
+Subproject 8d7484f819f47861fa5c5ca831f9dcc4db9fabc
diff --git a/emacs/.emacs.d/lisp/my/lem-org.el b/emacs/.emacs.d/lisp/my/lem-org.el
new file mode 100644
index 0000000..37a7bfb
--- /dev/null
+++ b/emacs/.emacs.d/lisp/my/lem-org.el
@@ -0,0 +1,171 @@
+;;; lem-org.el -- Read lemmy posts in org mode -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023  Free Software Foundation, Inc.
+
+;; Author: Yuchen Pei <id@ypei.org>
+;; Package-Requires: ((emacs "28.2") (lem "0.1"))
+;; Keywords: web, fediverse, org
+;; Version: 0
+
+;; 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:
+
+;; Read lemmy posts in org mode. The entry point is `lem-org-open',
+;; which takes the url of a lemmy post, and displays it in an org
+;; buffer.
+
+;; Note this package depends on lem.el:
+;; <https://codeberg.org/martianh/lem.el>.
+
+;; A major limitation is that it currently only fetches a set number
+;; of comments `lem-org-comment-limit'.
+
+;;; Code:
+
+(require 'lem-api)
+
+(defvar lem-org-comment-limit 50
+  "Number of comments to fetch for a post.")
+
+(defun lem-org-parse-post-url (url)
+  "Parse a post URL into (host . post-id)."
+  (when (string-match "\\(.*\\)/post/\\(.*\\)" url)
+    `(,(match-string 1 url) . ,(match-string 2 url))))
+
+(defun lem-org-get-post-and-comments (url)
+  "Get post and comments info from URL."
+  (when-let ((host-and-id (lem-org-parse-post-url url)))
+    ;; The (local) binding of `lem-instance-url' and `lem-api-version'
+    ;; are required by `lem-get-post' and `lem-api-get-post-comments'.
+    (let ((lem-instance-url (car host-and-id))
+          (lem-api-version "v3")
+          (post-id (cdr host-and-id)))
+      (cons `(post . ,(lem-get-post post-id))
+            (lem-api-get-post-comments post-id "All" nil 50)))))
+
+(defun lem-org-format-post (post)
+  "Format a POST."
+  (let* ((post-view (alist-get 'post_view post))
+         (post (alist-get 'post post-view))
+         (creator (alist-get 'creator post-view)))
+    (format
+     "%s\n\n%s"
+     (string-join
+      (list
+       "-*- org -*-"
+       (format "#+title: [[%s][%s]]"
+               (or (alist-get 'url post) (alist-get 'ap_id post))
+               (alist-get 'name post))
+       (format "#+date: %s" (alist-get 'published post))
+       (format "#+author: %s"
+               (or (alist-get 'display_name creator)
+                   (alist-get 'name creator)))
+       (format "#+url: %s" (alist-get 'ap_id post)))
+      "\n")
+     (alist-get 'body post))))
+
+(defun lem-org-comment-parent (comment)
+  "Get the id of the parent to COMMENT."
+  (let ((path (alist-get 'path (alist-get 'comment comment))))
+    (when (string-match ".*\\<\\(.*\\)\\..*" path)
+      (string-to-number (match-string 1 path)))))
+
+(defun lem-org-sort-comments (comments)
+  "Annotate the lineage of COMMENTS.
+
+For each comment, we look for its parent, and add the comment id
+to the parent's children field."
+  (cl-loop
+   for comment in comments do
+   (when-let*
+       ((target-id (lem-org-comment-parent comment))
+        (parent-idx (cl-position-if
+                     (lambda (candidate)
+                       (= (alist-get 'id (alist-get 'comment candidate))
+                          target-id))
+                     comments)))
+     (cl-pushnew
+      (alist-get 'id (alist-get 'comment comment))
+      (alist-get 'children (nth parent-idx comments))))))
+
+(defun lem-org-format-heading (text level)
+  "Format a org heading of LEVEL with TEXT."
+  (format "%s %s"
+          (make-string level ?*) text))
+
+(defun lem-org-format-comment (comment comments)
+  "Format all comments in a COMMENT tree recursively.
+
+COMMENTS is the list of all comments for lookup of child
+comments."
+  (let ((children (alist-get 'children comment))
+        (creator (alist-get 'creator comment))
+        (counts (alist-get 'counts comment))
+        (comment (alist-get 'comment comment)))
+    (cons
+     (format
+      "%s\n%s"
+      (lem-org-format-heading
+       (format "%s (+%d/-%d)"
+               (or (alist-get 'display_name creator)
+                   (alist-get 'name creator))
+               (alist-get 'upvotes counts)
+               (alist-get 'downvotes counts))
+       (1- (length (split-string (alist-get 'path comment) "\\."))))
+      (alist-get 'content comment))
+     (mapcar
+      (lambda (child-id)
+        (lem-org-format-comment
+         (cl-find-if
+          (lambda (comment)
+            (= child-id (alist-get 'id (alist-get 'comment comment))))
+          comments)
+         comments))
+      children))))
+
+(defun lem-org-format-comments (comments)
+  "Format COMMENTS.
+
+Iterate over all comments and call `lem-org-format-comment' on
+those at the top level."
+  (lem-org-sort-comments comments)
+  (string-join
+   (flatten-list
+    (mapcar
+     (lambda (comment)
+       (lem-org-format-comment comment comments))
+     (seq-filter
+      (lambda (comment)
+        (= 0 (lem-org-comment-parent comment)))
+      comments)))
+   "\n\n"))
+
+(defun lem-org-open (url)
+  "Open a lemmy post at URL and display the result in an org buffer."
+  (interactive "sURL: ")
+  (let* ((post-and-comments (lem-org-get-post-and-comments url))
+         (post (lem-org-format-post (alist-get 'post post-and-comments)))
+         (comments (lem-org-format-comments
+                    (alist-get 'comments post-and-comments))))
+    (with-current-buffer (get-buffer-create "*lem-org*")
+      (erase-buffer)
+      (insert post "\n\n" comments)
+      (goto-char (point-min)))
+    (display-buffer "*lem-org*")))
+
+(provide 'lem-org)
+;;; lem-org.el ends here