diff options
Diffstat (limited to 'emacs/.emacs.d/lisp/my/mastorg.el')
| -rw-r--r-- | emacs/.emacs.d/lisp/my/mastorg.el | 169 |
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 |