[emacs] Improve mastorg

auto-save threads in an org file; show image thumbnails; linkify
timestamp; show like/repeat/fav stats

1 files changed, 147 insertions, 22 deletions

diff --git a/emacs/.emacs.d/lisp/my/mastorg.el b/emacs/.emacs.d/lisp/my/mastorg.el
index 3544b2e..17b50c0 100644
--- a/emacs/.emacs.d/lisp/my/mastorg.el
+++ b/emacs/.emacs.d/lisp/my/mastorg.el
@@ -171,23 +171,74 @@ Including ancestors and descendants, if any."
      (hierarchy-map 'mastorg-format-toot toots-hier 1)
      "\n")))
 
+(defun mastorg-make-org-link (link desc)
+  (format "[[%s][%s]]" link desc))
+
+(defun mastorg-format-attached (attachments host)
+  (mapconcat
+   (lambda (attachment)
+     (let-alist attachment
+       (with-temp-buffer
+         (insert
+          (mastorg-make-org-link .url .type))
+         (if .description
+             (insert ": " .description))
+         (when .preview_url
+           (let ((thumb-file-name
+                  (file-name-concat
+                   mastorg-dir
+                   (format "%s.%s.%s" host .id
+                           (file-name-extension .preview_url)))))
+             (ignore-error 'file-already-exists
+               (url-copy-file .preview_url thumb-file-name))
+             (insert "\n")
+             (insert-image (create-image thumb-file-name))
+             ))
+         (buffer-string))))
+   attachments
+   "\n"))
+
 (defun mastorg-format-toot (toot level)
   "Format a TOOT with indent LEVEL."
-  (pcase-let* ((url (alist-get 'url toot))
-               (account (alist-get 'account toot))
-               (display-name (alist-get 'display_name account))
-               (username (alist-get 'username account))
-               (`(,host . _) (mastorg-parse-url url)))
-    (format "%s %s @%s@%s %s\n%s"
-            (make-string level ?*)
-            (if (string-empty-p display-name) username display-name)
-            username
-            host
-            (alist-get 'created_at toot)
-            (with-temp-buffer
-              (insert (alist-get 'content toot))
-              (shr-render-region (point-min) (point-max))
-              (buffer-substring-no-properties (point-min) (point-max))))))
+  (let-alist toot
+    (let ((host (car (mastorg-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
+               .url
+               (mastorg--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)
+              .replies_count
+              .reblogs_count
+              .favourites_count))))
+
+(defun mastorg-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))
+    (with-current-buffer buffer
+      (let ((inhibit-read-only t))
+        (erase-buffer)
+        (insert text))
+      (goto-char (point-min))
+      (save-buffer)
+      (revert-buffer t t))
+    (switch-to-buffer buffer)))
+
+(defvar mastorg-dir (locate-user-emacs-file "mastorg")
+  "Path to local directory of saved threads.")
+
+(defun mastorg-make-filename (url)
+  (pcase-let ((`(,host . ,post-id) (mastorg-parse-url url)))
+    (format "%s.%s.org" host post-id)))
 
 ;;;###autoload
 (defun mastorg-open (url)
@@ -195,13 +246,87 @@ Including ancestors and descendants, if any."
 
 Including the context, i.e. ancestors and descendant toots."
   (interactive "sToot URL: ")
-  (with-current-buffer (get-buffer-create mastorg-buffer)
-    (let ((inhibit-read-only t))
-      (erase-buffer)
-      (insert (mastorg-format-toot-tree url))
-      (org-mode)
-      (goto-char (point-min))))
-  (switch-to-buffer mastorg-buffer))
+  (mastorg-save-text-and-switch-to-buffer
+   (mastorg-format-toot-tree url)
+   (file-name-concat mastorg-dir (mastorg-make-filename url))))
+
+;;; code adapted from mastodon.el
+(defun mastorg--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.
+RESOLUTION is the finest resolution, in seconds, to use for the
+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)
+         (n1 seconds) (unit1 (pop units)) (res1 1)
+         n2 unit2 res2
+         next)
+    (while (and units (> (truncate (setq next (/ n1 (car units)))) 0))
+      (setq unit2 unit1)
+      (setq res2 res1)
+      (setq n2 (- n1 (* (car units) (truncate n1 (car units)))))
+      (setq n1 next)
+      (setq res1 (truncate (* res1 (car units))))
+      (pop units)
+      (setq unit1 (pop units)))
+    (setq n1 (truncate n1))
+    (if n2 (setq n2 (truncate n2)))
+    (cond
+     ((null n2)
+      ;; revert to old just now style for < 1 min:
+      (cons "just now" 60))
+     ;; (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" ""))
+     ;;       (max resolution res1)))
+     ((< (* res2 n2) resolution)
+      (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" ""))
+            (max resolution res2)))
+     ((< res2 resolution)
+      (let ((n2 (/ (* resolution (/ (* n2 res2) resolution)) res2)))
+        (cons (format "%d %s%s, %d %s%s"
+                      n1 unit1 (if (> n1 1) "s" "")
+                      n2 unit2 (if (> n2 1) "s" ""))
+              resolution)))
+     (t
+      (cons (format "%d %s%s, %d %s%s"
+                    n1 unit1 (if (> n1 1) "s" "")
+                    n2 unit2 (if (> n2 1) "s" ""))
+            (max res2 resolution))))))
+
+(defconst mastorg--time-units
+  '("sec"   60.0 ;; Use a float to convert `n' to float.
+    "min"   60
+    "hour"  24
+    "day"   7
+    "week"  4.345
+    "month" 12
+    "year"))
+
+(defun mastorg--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).
+The descriptive string is a human readable version relative to
+the current time while the next change timestamp give the first
+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))))
+    ;; 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)
+  "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
+        (encode-time (parse-time-string time-string)) current-time)))
 
 (provide 'mastorg)
 ;;; mastorg.el ends here