344 lines
13 KiB
EmacsLisp
344 lines
13 KiB
EmacsLisp
;;; sharkey.el --- mir playing around with mastodon.el and sharkey and stuff
|
|
|
|
(use-package mastodon
|
|
:ensure t
|
|
:custom
|
|
(mastodon-active-user "@mir")
|
|
(mastodon-instance-url "https://talk.marq42.xyz")
|
|
(mastodon-tl--show-avatars t)
|
|
(mastodon-toot--enable-custom-instance-emoji t)
|
|
(mastodon-use-emojify t)
|
|
(image-use-external-converter t)
|
|
:demand)
|
|
|
|
;; 日本語
|
|
|
|
(require 'shr)
|
|
(require 'mastodon)
|
|
|
|
(load-file "./mfm/emoji.el")
|
|
(load-file "./mfm/small.el")
|
|
(defun mir/remove-all-overlays (&optional overlay nyl beg end)
|
|
"Delete all overlays resting on current line."
|
|
;; (message "%s" throwaway)
|
|
;; ^^^--> list of overlay, nil, bounds
|
|
(let* ((start-bound (or beg (pos-bol)))
|
|
(end-bound (or end (pos-eol))))
|
|
(--map
|
|
(mapcar #'delete-overlay (overlays-at it))
|
|
(number-sequence start-bound end-bound)))
|
|
nil)
|
|
(defun mir/overlay-bounds (overlay)
|
|
"Return a cons of `(start . end)' for OVERLAY."
|
|
(cons
|
|
(overlay-start overlay)
|
|
(overlay-end overlay)))
|
|
(defun mir/overlay-already-at-p (start-bound end-bound)
|
|
"Return t if there is an overlay from START-BOUND to END-BOUND."
|
|
(remove nil
|
|
(mapcar (lambda (bounds) (equal bounds (cons start-bound end-bound)))
|
|
(mapcar #'mir/overlay-bounds (overlays-at
|
|
(+ start-bound
|
|
(/ (- end-bound start-bound)
|
|
2)))))))
|
|
|
|
(defface mfm-delimiter-invis-face
|
|
'((t (:string "")))
|
|
"Face for misskey markdown elements such as <small\> type stuff.")
|
|
|
|
;; the fact is, <small>this :neofox: is <small>extra</small> smol</small> <-- she should render double small
|
|
;; <small>this :neocat: is also smol</small apparently
|
|
|
|
(font-lock-add-keywords
|
|
nil ; this must needs be nil
|
|
;; 'fedimoji-mode
|
|
`((next-emoji-overlay (0 'font-lock-keyword-face t))
|
|
(next-small-overlay (0 'font-lock-keyword-face t))
|
|
;; (,sharkey/small-rx 1 'mfm-delimiter-invis-face t)
|
|
;; (,sharkey/small-rx 3 'mfm-delimiter-invis-face t)
|
|
) t)
|
|
;; (defun )
|
|
(defvar fedimoji-mode nil)
|
|
(define-minor-mode fedimoji-mode
|
|
"Display colon-delimited fediverse emoji properly."
|
|
;; buffer local
|
|
(if fedimoji-mode
|
|
(progn
|
|
(font-lock-remove-keywords nil
|
|
`(,sharkey/emoji-rx))
|
|
(mir/remove-all-overlays))
|
|
(font-lock-add-keywords
|
|
nil ; this must needs be nil
|
|
`((,sharkey/emoji-rx (0 'font-lock-keyword-face t))
|
|
(next-small-overlay (0 'font-lock-keyword-face t))
|
|
;; (,sharkey/small-rx 1 'mfm-delimiter-invis-face t)
|
|
;; (,sharkey/small-rx 3 'mfm-delimiter-invis-face t)
|
|
) t))
|
|
)
|
|
|
|
(add-hook 'mastodon-mode #'fedimoji-mode)
|
|
(add-hook 'mastodon-toot-mode-hook #'fedimoji-mode)
|
|
;; ":neofox:" <-- this fucking fox is breaking my syntax highlighting
|
|
;; can we do animated? :nixos-3d:
|
|
;; apparently so... :silvervale_waves:
|
|
;; :megumin_bakuretsu: la la la :3
|
|
|
|
;; (defun mfm-render (input)
|
|
;; "Convert INPUT plain text to propertized rich text using the implemented set of misskey flavored markdown."
|
|
;; (--> input
|
|
;; (string-replace )))
|
|
|
|
(defun mir/pixel-string-padjustify (string length &optional throwaway start)
|
|
"Drop-in replacement for `string-pad'.
|
|
|
|
Pad STRING to LENGTH. THROWAWAY is unused. The space character is always used.
|
|
|
|
If STRING is longer than the absolute value of LENGTH, who cares?
|
|
|
|
If START is nil (or not present), the padding is done to the end
|
|
of the string, and if non-nil, padding is done to the start of
|
|
the string."
|
|
(let* ((strlen (length string))
|
|
)
|
|
(concat string
|
|
(propertize " " 'display
|
|
`(space :align-to (- ,length ,strlen))))))
|
|
(mir/pixel-string-padjustify "1234" 7)
|
|
(defun mir/box-around-body (body width)
|
|
"Return BODY in a text box WIDTH wide."
|
|
(let* ((innerwidth (- width 2))
|
|
(wide-horiz
|
|
;; (propertize "━" 'display
|
|
;; `(space :align-to ,(- width 1)))
|
|
(make-string innerwidth ?━)
|
|
)
|
|
)
|
|
(concat
|
|
"┏" wide-horiz "┓\n"
|
|
(let ((linefun (lambda (line)
|
|
(concat "┃" (string-pad line innerwidth) "┃\n"))))
|
|
(mapconcat linefun
|
|
(split-string (string-fill body innerwidth)
|
|
"\n")))
|
|
"┗" wide-horiz "┛\n"
|
|
)))
|
|
;; default from mastodon.el - how can we destroy it?
|
|
(defun mastodon-tl--insert-status (toot body author-byline action-byline
|
|
&optional id base-toot detailed-p
|
|
thread domain unfolded no-byline)
|
|
"Display the content and byline of timeline element TOOT.
|
|
BODY will form the section of the toot above the byline.
|
|
AUTHOR-BYLINE is an optional function for adding the author
|
|
portion of the byline that takes one variable. By default it is
|
|
`mastodon-tl--byline-author'.
|
|
ACTION-BYLINE is also an optional function for adding an action,
|
|
such as boosting favouriting and following to the byline. It also
|
|
takes a single function. By default it is
|
|
`mastodon-tl--byline-boosted'.
|
|
ID is that of the status if it is a notification, which is
|
|
attached as a `item-id' property if provided. If the
|
|
status is a favourite or boost notification, BASE-TOOT is the
|
|
JSON of the toot responded to.
|
|
DETAILED-P means display more detailed info. For now
|
|
this just means displaying toot client.
|
|
THREAD means the status will be displayed in a thread view.
|
|
When DOMAIN, force inclusion of user's domain in their handle.
|
|
UNFOLDED is a boolean meaning whether to unfold or fold item if foldable.
|
|
NO-BYLINE means just insert toot body, used for folding."
|
|
;; (message "toot: %s" (pp toot)) ; good for debug?
|
|
(let* ((start-pos (point))
|
|
(reply-to-id (alist-get 'in_reply_to_id toot))
|
|
(after-reply-status-p
|
|
(when (and thread reply-to-id)
|
|
(mastodon-tl--after-reply-status reply-to-id)))
|
|
(type (alist-get 'type toot))
|
|
(toot-foldable
|
|
(and mastodon-tl--fold-toots-at-length
|
|
(length> body mastodon-tl--fold-toots-at-length)))
|
|
;; a mir addition:
|
|
(toot-char-width
|
|
(min
|
|
;; (max
|
|
;; (apply #'max (--map (length it)
|
|
;; (split-string body "\n")))
|
|
;; ;; o thank gosh, max can take one arg
|
|
;; ;; want to add image width when figure out how
|
|
;; ;; image height is `mastodon-media--preview-max-height', so multiply/divide (?) by aspect ratio for width
|
|
;; ;; also can we use height to generate taller box chars?
|
|
;; )
|
|
(window-width nil 'remap)))
|
|
)
|
|
(insert
|
|
(propertize
|
|
(concat
|
|
;; byline:
|
|
"\n"
|
|
(if no-byline
|
|
""
|
|
(mastodon-tl--byline toot author-byline action-byline
|
|
detailed-p domain))
|
|
(propertize
|
|
(concat
|
|
;; relpy symbol (broken):
|
|
(if (and after-reply-status-p thread)
|
|
(concat (mastodon-tl--symbol 'replied)
|
|
"\n")
|
|
"")
|
|
;; actual body:
|
|
(let* ((bar (mastodon-tl--symbol 'reply-bar))
|
|
;; mir addition: we need emoji processing
|
|
(simplified-emoji-alist
|
|
(--map (cons (alist-get 'shortcode it)
|
|
(alist-get 'url it))
|
|
(alist-get 'emojis toot)) )
|
|
(body
|
|
(if (and toot-foldable (not unfolded))
|
|
(mastodon-tl--fold-body body)
|
|
body)))
|
|
(if (and after-reply-status-p thread)
|
|
(propertize body
|
|
'line-prefix bar
|
|
'wrap-prefix bar)
|
|
;; (message "%s" simplified-emoji-alist)
|
|
(mir/box-around-body
|
|
body toot-char-width)))
|
|
)
|
|
'toot-body t) ;; includes newlines etc. for folding
|
|
)
|
|
'item-type 'toot
|
|
'item-id (or id ; notification's own id
|
|
(alist-get 'id toot)) ; toot id
|
|
'base-item-id (mastodon-tl--item-id
|
|
;; if status is a notif, get id from base-toot
|
|
;; (-tl--item-id toot) will not work here:
|
|
(or base-toot
|
|
toot)) ; else normal toot with reblog check
|
|
'item-json toot
|
|
'base-toot base-toot
|
|
'cursor-face 'mastodon-cursor-highlight-face
|
|
'notification-type type
|
|
'toot-foldable toot-foldable
|
|
'toot-folded (and toot-foldable (not unfolded)))
|
|
(if no-byline "" "\n"))
|
|
(when mastodon-tl--display-media-p
|
|
(mastodon-media--inline-images start-pos (point)))
|
|
))
|
|
|
|
;; stolen and modified from the placey thing :3
|
|
(defun mastodon-tl--byline (toot author-byline action-byline &optional detailed-p domain)
|
|
"Generate byline for TOOT.
|
|
AUTHOR-BYLINE is a function for adding the author portion of
|
|
the byline that takes one variable.
|
|
ACTION-BYLINE is a function for adding an action, such as boosting,
|
|
favouriting and following to the byline. It also takes a single function.
|
|
By default it is `mastodon-tl--byline-boosted'.
|
|
DETAILED-P means display more detailed info. For now
|
|
this just means displaying toot client.
|
|
When DOMAIN, force inclusion of user's domain in their handle."
|
|
(let* ((created-time
|
|
;; bosts and faves in notifs view
|
|
;; (makes timestamps be for the original toot not the boost/fave):
|
|
(or (mastodon-tl--field 'created_at
|
|
(mastodon-tl--field 'status toot))
|
|
;; all other toots, inc. boosts/faves in timelines:
|
|
;; (mastodon-tl--field auto fetches from reblogs if needed):
|
|
(mastodon-tl--field 'created_at toot)))
|
|
(parsed-time (date-to-time created-time))
|
|
(faved (equal 't (mastodon-tl--field 'favourited toot)))
|
|
(boosted (equal 't (mastodon-tl--field 'reblogged toot)))
|
|
(bookmarked (equal 't (mastodon-tl--field 'bookmarked toot)))
|
|
(visibility (mastodon-tl--field 'visibility toot))
|
|
(account (alist-get 'account toot))
|
|
(avatar-url (alist-get 'avatar account))
|
|
(type (alist-get 'type toot))
|
|
(edited-time (alist-get 'edited_at toot))
|
|
(edited-parsed (when edited-time (date-to-time edited-time))))
|
|
(concat
|
|
;; Boosted/favourited markers are not technically part of the byline, so
|
|
;; we don't propertize them with 'byline t', as per the rest. This
|
|
;; ensures that `mastodon-tl--goto-next-item' puts point on
|
|
;; author-byline, not before the (F) or (B) marker. Not propertizing like
|
|
;; this makes the behaviour of these markers consistent whether they are
|
|
;; displayed for an already boosted/favourited toot or as the result of
|
|
;; the toot having just been favourited/boosted.
|
|
(concat (when boosted
|
|
(mastodon-tl--format-faved-or-boosted-byline
|
|
(mastodon-tl--symbol 'boost)))
|
|
(when faved
|
|
(mastodon-tl--format-faved-or-boosted-byline
|
|
(mastodon-tl--symbol 'favourite)))
|
|
(when bookmarked
|
|
(mastodon-tl--format-faved-or-boosted-byline
|
|
(mastodon-tl--symbol 'bookmark))))
|
|
;; we remove avatars from the byline also, so that they also do not mess
|
|
;; with `mastodon-tl--goto-next-item':
|
|
(when (and mastodon-tl--show-avatars
|
|
mastodon-tl--display-media-p
|
|
(if (version< emacs-version "27.1")
|
|
(image-type-available-p 'imagemagick)
|
|
(image-transforms-p)))
|
|
(mastodon-media--get-avatar-rendering avatar-url))
|
|
(propertize
|
|
(concat
|
|
;; we propertize help-echo format faves for author name
|
|
;; in `mastodon-tl--byline-author'
|
|
(funcall author-byline toot nil domain)
|
|
;; visibility:
|
|
(cond ((equal visibility "direct")
|
|
(propertize (concat " " (mastodon-tl--symbol 'direct))
|
|
'help-echo visibility))
|
|
((equal visibility "private")
|
|
(propertize (concat " " (mastodon-tl--symbol 'private))
|
|
'help-echo visibility)))
|
|
(funcall action-byline toot)
|
|
" "
|
|
(propertize
|
|
(format-time-string mastodon-toot-timestamp-format parsed-time)
|
|
'timestamp parsed-time
|
|
'display (if mastodon-tl--enable-relative-timestamps
|
|
(mastodon-tl--relative-time-description parsed-time)
|
|
parsed-time))
|
|
(when detailed-p
|
|
(let* ((app (alist-get 'application toot))
|
|
(app-name (alist-get 'name app))
|
|
(app-url (alist-get 'website app)))
|
|
(when app
|
|
(concat
|
|
(propertize " via " 'face 'default)
|
|
(propertize app-name
|
|
'face 'mastodon-display-name-face
|
|
'follow-link t
|
|
'mouse-face 'highlight
|
|
'mastodon-tab-stop 'shr-url
|
|
'shr-url app-url
|
|
'help-echo app-url
|
|
'keymap mastodon-tl--shr-map-replacement)))))
|
|
(if edited-time
|
|
(concat
|
|
" "
|
|
(mastodon-tl--symbol 'edited)
|
|
" "
|
|
(propertize
|
|
(format-time-string mastodon-toot-timestamp-format
|
|
edited-parsed)
|
|
'face 'font-lock-comment-face
|
|
'timestamp edited-parsed
|
|
'display (if mastodon-tl--enable-relative-timestamps
|
|
(mastodon-tl--relative-time-description edited-parsed)
|
|
edited-parsed)))
|
|
"")
|
|
;; (propertize (concat "\n " mastodon-tl--horiz-bar)
|
|
;; 'face 'default)
|
|
(if (and mastodon-tl--show-stats
|
|
(not (member type '("follow" "follow_request"))))
|
|
(mastodon-tl--toot-stats toot)
|
|
"")
|
|
"\n")
|
|
'favourited-p faved
|
|
'boosted-p boosted
|
|
'bookmarked-p bookmarked
|
|
'edited edited-time
|
|
'edit-history (when edited-time
|
|
(mastodon-toot--get-toot-edits (alist-get 'id toot)))
|
|
'byline t))))
|