mir/sharkey-el
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

initialize repo and add sharkey.el file

Browse Source
This commit is contained in:
Miranda Marquez 2024-09-14 15:41:24 -08:00
commit e38e4e9595
1 changed files with 355 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

355
sharkey.el Normal file
View 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))))