initialize repo and add sharkey.el file
This commit is contained in:
commit
e38e4e9595
355
sharkey.el
Normal file
355
sharkey.el
Normal file
@ -0,0 +1,355 @@
|
|||||||
|
;;; sharkey.el --- mir playing around with mastodon.el and sharkey and stuff
|
||||||
|
;; do not upload yet please!
|
||||||
|
|
||||||
|
(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)
|
||||||
|
:demand)
|
||||||
|
|
||||||
|
;; 日本語
|
||||||
|
|
||||||
|
;; need to figure out custom emoji resolution
|
||||||
|
|
||||||
|
;; let's start by making :rena: render as the rena.webp image...
|
||||||
|
|
||||||
|
:neocat_pat_floof:
|
||||||
|
(defvar sharkey/emoji-cache-dir "~/.emoji"
|
||||||
|
"Directory under which to store fedi emoji cache.")
|
||||||
|
(defun sharkey--emoji-cache (name &optional instance)
|
||||||
|
"Given remote emoji called NAME, return its local path.
|
||||||
|
INSTANCE defaults to `mastodon-instance-url'.
|
||||||
|
|
||||||
|
returns nil if such an emoji does not exist."
|
||||||
|
(let* ((instance (or instance mastodon-instance-url))
|
||||||
|
(plain-instance (string-trim instance "https://"))
|
||||||
|
(plain-name ; should start in colons, remove those
|
||||||
|
(string-trim name ":" ":"))
|
||||||
|
(url (format "%s/emoji/%s.webp" instance plain-name))
|
||||||
|
(local-path (format "%s/%s/%s.webp"
|
||||||
|
sharkey/emoji-cache-dir
|
||||||
|
plain-instance
|
||||||
|
plain-name)))
|
||||||
|
(unless (file-exists-p local-path)
|
||||||
|
;; can we do this lazy, like with timers or sth? ehh it's plenty fast as is...
|
||||||
|
(mkdir (file-name-directory local-path) 'p)
|
||||||
|
(url-copy-file url local-path))
|
||||||
|
(if (eq 'webp (image-type-from-file-header local-path))
|
||||||
|
local-path
|
||||||
|
nil)))
|
||||||
|
;; (image-type-from-file-header "~/rena.webp")
|
||||||
|
:skull:
|
||||||
|
;; (sharkey--emoji-cache ":rena:")
|
||||||
|
;; (window-font-height)
|
||||||
|
;; (insert-image (create-image (sharkey--emoji-cache ":rena:") nil nil
|
||||||
|
;; :height (window-font-height)
|
||||||
|
;; :ascent 'center))
|
||||||
|
|
||||||
|
(defvar sharkey/emoji-rx (rx (group-n 1 ":" (+ (or alnum "-" "_")) ":")))
|
||||||
|
(defun next-emoji-overlay (&optional limit)
|
||||||
|
;; adapted from https://kitchingroup.cheme.cmu.edu/blog/2016/03/21/Displaying-image-overlays-on-image-filenames-in-Emacs/ -- specifically the latter section on overlays
|
||||||
|
"Turn the next occurence of a colon-delimited emoji name (within LIMIT) into the emoji itself, using an overlay."
|
||||||
|
(ignore-errors
|
||||||
|
;; needs to be `while'. it was `when' and that caused problems.
|
||||||
|
(while (re-search-forward sharkey/emoji-rx limit t)
|
||||||
|
(let* ((beg (match-beginning 0))
|
||||||
|
(end (match-end 0))
|
||||||
|
(emoj (match-string 1))
|
||||||
|
(img (create-image (sharkey--emoji-cache emoj) nil nil
|
||||||
|
:height (window-font-height)
|
||||||
|
:ascent 'center))
|
||||||
|
(ov (make-overlay beg end)))
|
||||||
|
(overlay-put ov 'display img)
|
||||||
|
(overlay-put ov 'face 'default)
|
||||||
|
(overlay-put ov 'help-echo emoj)
|
||||||
|
(overlay-put ov 'org-image-overlay t)
|
||||||
|
(overlay-put ov 'modification-hooks
|
||||||
|
(list 'org-display-inline-remove-overlay))))))
|
||||||
|
(defvar sharkey/small-rx
|
||||||
|
(rx (group-n 1 "<small>")
|
||||||
|
(group-n 2 (+ any))
|
||||||
|
(group-n 3 "</small>")))
|
||||||
|
(defun next-small-overlay (&optional limit)
|
||||||
|
"logic from `next-emoji-overlay' but for mfm <small></small> tag."
|
||||||
|
(while (re-search-forward sharkey/small-rx limit t)
|
||||||
|
(let* ((openr-beg (match-beginning 1))
|
||||||
|
(openr-end (match-end 1))
|
||||||
|
(text-beg (match-beginning 2))
|
||||||
|
(text-end (match-end 2))
|
||||||
|
(close-beg (match-beginning 3))
|
||||||
|
(close-end (match-end 3))
|
||||||
|
(placehoverlay (make-overlay openr-beg close-end))
|
||||||
|
(openr-ov (make-overlay openr-beg openr-end))
|
||||||
|
(close-ov (make-overlay close-beg close-end))
|
||||||
|
(text (buffer-substring text-beg text-end))
|
||||||
|
(text-ov (make-overlay text-beg text-end))
|
||||||
|
)
|
||||||
|
;; (overlay-put openr-ov 'display "")
|
||||||
|
;; (overlay-put close-ov 'display "")
|
||||||
|
(put-text-property openr-beg openr-end 'invisible t)
|
||||||
|
(put-text-property close-beg close-end 'invisible t)
|
||||||
|
(overlay-put text-ov 'help-echo text)
|
||||||
|
(overlay-put text-ov 'display '(height 0.8))
|
||||||
|
(overlay-put placehoverlay 'modification-hooks
|
||||||
|
(list 'org-display-inline-remove-overlay))
|
||||||
|
;; (overlay-put openr-ov 'org-image-overlay t)
|
||||||
|
;; (overlay-put close-ov 'org-image-overlay t)
|
||||||
|
;; (overlay-put text-ov 'org-image-overlay t)
|
||||||
|
)))
|
||||||
|
(defface mfm-delimiter-invis-face
|
||||||
|
'((t (:string "")))
|
||||||
|
"Face for misskey markdown elements such as <small> type stuff.")
|
||||||
|
|
||||||
|
;; <small>this :neofox is smol</small>
|
||||||
|
|
||||||
|
(font-lock-add-keywords
|
||||||
|
nil ; this must needs be nil
|
||||||
|
`((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)
|
||||||
|
|
||||||
|
(define-minor-mode fedimoji-mode
|
||||||
|
"Display colon-delimited fediverse emoji properly."
|
||||||
|
(font-lock-add-keywords
|
||||||
|
nil ; no really, it has to be nil
|
||||||
|
'((next-emoji-overlay
|
||||||
|
(0 'font-lock-keyword-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
|
||||||
|
|
||||||
|
;; (defun mfm-render (input)
|
||||||
|
;; "Convert INPUT plain text to propertized rich text using the implemented set of misskey flavored markdown."
|
||||||
|
;; (--> input
|
||||||
|
;; (string-replace )))
|
||||||
|
|
||||||
|
;; 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
|
||||||
|
)
|
||||||
|
(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
|
||||||
|
;; mir: box draw at top of post
|
||||||
|
"┏"
|
||||||
|
(make-string (- toot-char-width 2) ?━)
|
||||||
|
"┓"
|
||||||
|
"\n"
|
||||||
|
;; 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)
|
||||||
|
body))
|
||||||
|
(concat "\n┗" (make-string (- toot-char-width 2) ?━) "┛")
|
||||||
|
)
|
||||||
|
'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))))
|
||||||
Loading…
Reference in New Issue
Block a user