diff options
| -rw-r--r-- | .gitmodules | 3 | ||||
| -rw-r--r-- | emacs/.emacs.d/init/ycp-web.el | 3 | ||||
| m--------- | emacs/.emacs.d/lisp/lem.el | 0 | ||||
| -rw-r--r-- | emacs/.emacs.d/lisp/my/lem-org.el | 171 |
4 files changed, 177 insertions, 0 deletions
diff --git a/.gitmodules b/.gitmodules index 2df6db0..508b847 100644 --- a/.gitmodules +++ b/.gitmodules @@ -103,3 +103,6 @@ [submodule "firefox/extensions/uBlock"] path = firefox/extensions/uBlock url = https://github.com/gorhill/uBlock +[submodule "emacs/.emacs.d/lisp/lem.el"] + path = emacs/.emacs.d/lisp/lem.el + url = https://codeberg.org/martianh/lem.el diff --git a/emacs/.emacs.d/init/ycp-web.el b/emacs/.emacs.d/init/ycp-web.el index dcaa3eb..1f15c74 100644 --- a/emacs/.emacs.d/init/ycp-web.el +++ b/emacs/.emacs.d/init/ycp-web.el @@ -69,6 +69,9 @@ (my-override hnreader--print-comments) (my-override hnreader--get-title)) +(my-package lem-org + (:delay 30)) + (my-package buildbot (:delay 30) (setq buildbot-default-host "https://buildbot.mariadb.org") 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 |